Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

2595 files changed, 437696 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/ada/acats/elabd.lst b/gcc-4.9/gcc/testsuite/ada/acats/elabd.lst
new file mode 100644
index 000000000..e7a7d25d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/elabd.lst
@@ -0,0 +1,5 @@
+c731001
+c854002
+ca11018
+ca11019
+ca5006a
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/floatstore.lst b/gcc-4.9/gcc/testsuite/ada/acats/floatstore.lst
new file mode 100644
index 000000000..fe1746983
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/floatstore.lst
@@ -0,0 +1 @@
+cxg2021
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/norun.lst b/gcc-4.9/gcc/testsuite/ada/acats/norun.lst
new file mode 100644
index 000000000..e9f64b4de
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/norun.lst
@@ -0,0 +1,2 @@
+# Tests must be sorted in alphabetical order
+templat
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/overflow.lst b/gcc-4.9/gcc/testsuite/ada/acats/overflow.lst
new file mode 100644
index 000000000..fb76ef177
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/overflow.lst
@@ -0,0 +1,17 @@
+c45632a
+c45632b
+c45632c
+c45504a
+c45504b
+c45504c
+c45613a
+c45613b
+c45613c
+c45304a
+c45304b
+c45304c
+c46014a
+c460008
+c460011
+c4a012b
+cb20004
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/run_acats b/gcc-4.9/gcc/testsuite/ada/acats/run_acats
new file mode 100755
index 000000000..c1ed39f85
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/run_acats
@@ -0,0 +1,73 @@
+#!/bin/sh
+
+if [ "$testdir" = "" ]; then
+   echo You must use make check or make check-ada
+   exit 1
+fi
+
+# Provide which replacement.
+#
+# type -p is missing from Solaris 2 /bin/sh and /bin/ksh (ksh88), but both
+# ksh93 and bash have it.
+# type output format differs between ksh88 and ksh93, so avoid it if
+# type -p is present.  Unfortunately, HP-UX /bin/sh ignores -p with type.
+# Fall back to whence which ksh88 and ksh93 provide, but bash does not.
+
+which () {
+    path=`type -p $* 2>/dev/null` && { echo $path | awk '{print $NF}'; return 0; }
+    path=`type $* 2>/dev/null` && { echo $path | awk '{print $NF}'; return 0; }
+    path=`whence $* 2>/dev/null` && { echo $path; return 0; }
+    return 1
+}
+
+# Set up environment to use the Ada compiler from the object tree
+
+host_gnatchop=`which gnatchop`
+host_gnatmake=`which gnatmake`
+ROOT=`${PWDCMD-pwd}`
+BASE=`cd $ROOT/../../..; ${PWDCMD-pwd}`
+
+PATH=$BASE:$ROOT:$PATH
+ADA_INCLUDE_PATH=$BASE/ada/rts
+LD_LIBRARY_PATH=$ADA_INCLUDE_PATH:$BASE:$LD_LIBRARY_PATH
+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 LD_LIBRARY_PATH
+
+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 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 gnatmake '"$@"' >> host_gnatmake
+
+chmod +x host_gnatmake
+
+# Limit the stack to 16MB for stack checking
+ulimit -s 16384
+
+exec $testdir/run_all.sh ${1+"$@"}
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/run_all.sh b/gcc-4.9/gcc/testsuite/ada/acats/run_all.sh
new file mode 100755
index 000000000..5ec3e1308
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/run_all.sh
@@ -0,0 +1,318 @@
+#!/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="-O2"
+gnatflags="-gnatws"
+
+target_run () {
+  eval $EXPECT -f $testdir/run_test.exp $*
+}
+
+# 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
+}
+
+find_main () {
+  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`
+}
+
+EXTERNAL_OBJECTS=""
+# Global variable to communicate external objects to link with.
+
+rm -f $dir/acats.sum $dir/acats.log
+
+display "Test Run By $USER on `date`"
+
+display "		=== acats configuration ==="
+
+target=`$GCC -dumpmachine`
+
+display target gcc is $GCC
+display `$GCC -v 2>&1`
+display host=`gcc -dumpmachine`
+display target=$target
+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
+
+# Find out the size in bit of an address on the target
+target_gnatmake $testdir/support/impbit.adb >> $dir/acats.log 2>&1
+target_run $dir/support/impbit > $dir/support/impbit.out 2>&1
+target_bit=`cat $dir/support/impbit.out`
+echo target_bit="$target_bit" >> $dir/acats.log
+
+# Find out a suitable asm statement
+# Adapted from configure.ac gcc_cv_as_dwarf2_debug_line
+case "$target" in
+  ia64*-*-* | s390*-*-*)
+    target_insn="nop 0"
+    ;;
+  mmix-*-*)
+    target_insn="swym 0"
+    ;;
+  *)
+    target_insn="nop"
+    ;;
+esac
+echo target_insn="$target_insn" >> $dir/acats.log
+
+sed -e "s,ACATS4GNATDIR,$dir,g" \
+  < $testdir/support/impdef.a > $dir/support/impdef.a
+sed -e "s,ACATS4GNATDIR,$dir,g" \
+  -e "s,ACATS4GNATBIT,$target_bit,g" \
+  -e "s,ACATS4GNATINSN,$target_insn,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
+grep -v '^#' $testdir/norun.lst | sort > $dir/support/norun.lst
+
+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 - $dir/support/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="-gnat95"
+      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
+      grep $i $testdir/floatstore.lst > /dev/null 2>&1
+      if [ $? -eq 0 ]; then
+         extraflags="$extraflags -ffloat-store"
+      fi
+      grep $i $testdir/stackcheck.lst > /dev/null 2>&1
+      if [ $? -eq 0 ]; then
+         extraflags="$extraflags -fstack-check"
+      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
+      main=""
+      find_main
+      if [ -z "$main" ]; then
+         sync
+         find_main
+      fi
+      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;;
+      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
+      if [ ! -x $dir/tests/$chapter/$i/$binmain ]; then
+         sync
+      fi
+      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
+
+display "$0 completed at `date`"
+
+exit 0
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/run_test.exp b/gcc-4.9/gcc/testsuite/ada/acats/run_test.exp
new file mode 100644
index 000000000..07dec2770
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/run_test.exp
@@ -0,0 +1,13 @@
+#!/usr/bin/expect -f
+
+if {[info exists env(DEJAGNU_TIMEOUT)]} {
+    set timeout $env(DEJAGNU_TIMEOUT)
+} else {
+    set timeout 300 
+}
+
+spawn -noecho $argv
+expect timeout {
+    send_user "Program timed out.\n"
+    exit 1
+}
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/stackcheck.lst b/gcc-4.9/gcc/testsuite/ada/acats/stackcheck.lst
new file mode 100644
index 000000000..1fdf5551a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/stackcheck.lst
@@ -0,0 +1,6 @@
+c52103x
+c52104x
+c52104y
+cb1010a
+cb1010c
+cb1010d
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/support/acats25.lst b/gcc-4.9/gcc/testsuite/ada/acats/support/acats25.lst
new file mode 100644
index 000000000..0133ed378
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/acats25.lst
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/checkfil.ada b/gcc-4.9/gcc/testsuite/ada/acats/support/checkfil.ada
new file mode 100644
index 000000000..cde0e5ca5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/checkfil.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/enumchek.ada b/gcc-4.9/gcc/testsuite/ada/acats/support/enumchek.ada
new file mode 100644
index 000000000..044c1a853
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/enumchek.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f340a000.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f340a000.a
new file mode 100644
index 000000000..a3daf96b5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f340a000.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f340a001.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f340a001.a
new file mode 100644
index 000000000..3fe027e59
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f340a001.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f341a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f341a00.a
new file mode 100644
index 000000000..b2e389f73
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f341a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f390a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f390a00.a
new file mode 100644
index 000000000..0230812e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f390a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f392a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f392a00.a
new file mode 100644
index 000000000..2d4f7a55a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f392a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f392c00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f392c00.a
new file mode 100644
index 000000000..8a470e7d4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f392c00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f392d00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f392d00.a
new file mode 100644
index 000000000..24f742739
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f392d00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f393a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f393a00.a
new file mode 100644
index 000000000..e85c3f49c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f393a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f393b00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f393b00.a
new file mode 100644
index 000000000..afabdd72f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f393b00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f3a2a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f3a2a00.a
new file mode 100644
index 000000000..c83908231
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f3a2a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f460a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f460a00.a
new file mode 100644
index 000000000..382f5c516
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f460a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f730a000.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f730a000.a
new file mode 100644
index 000000000..137f33306
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f730a000.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f730a001.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f730a001.a
new file mode 100644
index 000000000..18153b7eb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f730a001.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f731a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f731a00.a
new file mode 100644
index 000000000..5e29fbd96
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f731a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f940a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f940a00.a
new file mode 100644
index 000000000..ddc614f1b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f940a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/f954a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/f954a00.a
new file mode 100644
index 000000000..615aa9860
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/f954a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fa11a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fa11a00.a
new file mode 100644
index 000000000..b57a6b7f5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fa11a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fa11b00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fa11b00.a
new file mode 100644
index 000000000..161be8e17
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fa11b00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fa11c00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fa11c00.a
new file mode 100644
index 000000000..4b153b25e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fa11c00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fa11d00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fa11d00.a
new file mode 100644
index 000000000..9efe33be7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fa11d00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fa13a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fa13a00.a
new file mode 100644
index 000000000..be6ecde56
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fa13a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fa13b00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fa13b00.a
new file mode 100644
index 000000000..da555540f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fa13b00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fa21a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fa21a00.a
new file mode 100644
index 000000000..7af0da1d1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fa21a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fb20a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fb20a00.a
new file mode 100644
index 000000000..46184c954
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fb20a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fb40a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fb40a00.a
new file mode 100644
index 000000000..adffc69a3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fb40a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fc50a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fc50a00.a
new file mode 100644
index 000000000..4c3732813
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fc50a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fc51a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fc51a00.a
new file mode 100644
index 000000000..9b584d7f8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fc51a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fc51b00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fc51b00.a
new file mode 100644
index 000000000..1d2b57e32
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fc51b00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fc51c00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fc51c00.a
new file mode 100644
index 000000000..33364c952
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fc51c00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fc51d00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fc51d00.a
new file mode 100644
index 000000000..4d31bb134
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fc51d00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fc54a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fc54a00.a
new file mode 100644
index 000000000..16bf742de
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fc54a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fc70a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fc70a00.a
new file mode 100644
index 000000000..e903a13ad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fc70a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fc70b00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fc70b00.a
new file mode 100644
index 000000000..46b106e0b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fc70b00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fc70c00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fc70c00.a
new file mode 100644
index 000000000..140b24010
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fc70c00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fcndecl.ada b/gcc-4.9/gcc/testsuite/ada/acats/support/fcndecl.ada
new file mode 100644
index 000000000..53347a4ac
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fcndecl.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fd72a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fd72a00.a
new file mode 100644
index 000000000..fe662ca26
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fd72a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fdb0a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fdb0a00.a
new file mode 100644
index 000000000..4888c24aa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fdb0a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fdd2a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fdd2a00.a
new file mode 100644
index 000000000..43a11101d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fdd2a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fxa5a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fxa5a00.a
new file mode 100644
index 000000000..6b2fcef7d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fxa5a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fxaca00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fxaca00.a
new file mode 100644
index 000000000..d8aa5e592
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fxaca00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fxacb00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fxacb00.a
new file mode 100644
index 000000000..22b50efb0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fxacb00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fxacc00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fxacc00.a
new file mode 100644
index 000000000..64d63bed9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fxacc00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fxc6a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fxc6a00.a
new file mode 100644
index 000000000..1e51d2ab3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fxc6a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fxe2a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fxe2a00.a
new file mode 100644
index 000000000..ed943155e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fxe2a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fxf2a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fxf2a00.a
new file mode 100644
index 000000000..2471f5c59
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fxf2a00.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/fxf3a00.a b/gcc-4.9/gcc/testsuite/ada/acats/support/fxf3a00.a
new file mode 100644
index 000000000..645010ecf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/fxf3a00.a
@@ -0,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'("<CR"),
+                         7 => new String'("<db"),
+                         8 => new String'("<<BBBcr"),    
+                         9 => 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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/impbit.adb b/gcc-4.9/gcc/testsuite/ada/acats/support/impbit.adb
new file mode 100644
index 000000000..5e189b062
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/impbit.adb
@@ -0,0 +1,6 @@
+with System;
+with Ada.Text_IO;
+procedure Impbit is
+begin
+   Ada.Text_IO.Put_Line (System.Address'Size'Img);
+end Impbit;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/support/impdef.a b/gcc-4.9/gcc/testsuite/ada/acats/support/impdef.a
new file mode 100644
index 000000000..9c23d0b7f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/impdef.a
@@ -0,0 +1,376 @@
+-- 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
+
+   Long_Minimum_Task_Switch : constant Duration := 0.1;
+
+--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+
+   -- 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
+
+   Long_Switch_To_New_Task : constant Duration := 0.1;
+
+--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
+
+   -- 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 := 0.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;
+   One_Long_Second : constant Duration := 0.1;
+
+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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/impdefd.a b/gcc-4.9/gcc/testsuite/ada/acats/support/impdefd.a
new file mode 100644
index 000000000..85f6b7924
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/impdefd.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/impdefe.a b/gcc-4.9/gcc/testsuite/ada/acats/support/impdefe.a
new file mode 100644
index 000000000..ae9f651b9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/impdefe.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/impdefg.a b/gcc-4.9/gcc/testsuite/ada/acats/support/impdefg.a
new file mode 100644
index 000000000..459ba9c94
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/impdefg.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/impdefh.a b/gcc-4.9/gcc/testsuite/ada/acats/support/impdefh.a
new file mode 100644
index 000000000..e6cfda717
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/impdefh.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/lencheck.ada b/gcc-4.9/gcc/testsuite/ada/acats/support/lencheck.ada
new file mode 100644
index 000000000..f8ed1385b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/lencheck.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/macro.dfs b/gcc-4.9/gcc/testsuite/ada/acats/support/macro.dfs
new file mode 100644
index 000000000..8c3723348
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/macro.dfs
@@ -0,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                  ACATS4GNATBIT
+			
+-- $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 ("ACATS4GNATINSN"));       
+						
+-- $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                 ACATS4GNATBIT
+							
+-- $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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/macrodef.adb b/gcc-4.9/gcc/testsuite/ada/acats/support/macrodef.adb
new file mode 100644
index 000000000..8a9087dc1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/macrodef.adb
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/macrosub.ada b/gcc-4.9/gcc/testsuite/ada/acats/support/macrosub.ada
new file mode 100644
index 000000000..81204fb07
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/macrosub.ada
@@ -0,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 <LETTER>, <NUMBER>, 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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/repbody.ada b/gcc-4.9/gcc/testsuite/ada/acats/support/repbody.ada
new file mode 100644
index 000000000..dd5c53b90
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/repbody.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/repspec.ada b/gcc-4.9/gcc/testsuite/ada/acats/support/repspec.ada
new file mode 100644
index 000000000..19c371f9b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/repspec.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/spprt13s.tst b/gcc-4.9/gcc/testsuite/ada/acats/support/spprt13s.tst
new file mode 100644
index 000000000..64b47315a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/spprt13s.tst
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/tctouch.ada b/gcc-4.9/gcc/testsuite/ada/acats/support/tctouch.ada
new file mode 100644
index 000000000..8fd4f0014
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/tctouch.ada
@@ -0,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_<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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/tsttests.dat b/gcc-4.9/gcc/testsuite/ada/acats/support/tsttests.dat
new file mode 100644
index 000000000..60a8bf8c1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/tsttests.dat
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/support/widechr.a b/gcc-4.9/gcc/testsuite/ada/acats/support/widechr.a
new file mode 100644
index 000000000..2eac588b8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/widechr.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a22006b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a22006b.ada
new file mode 100644
index 000000000..250caf2d6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a22006b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a22006c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a22006c.ada
new file mode 100644
index 000000000..e04eb1223
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a22006c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a22006d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a22006d.ada
new file mode 100644
index 000000000..d19362c9d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a22006d.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a26007a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a26007a.tst
new file mode 100644
index 000000000..d40aa3d13
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a26007a.tst
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a27003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a27003a.ada
new file mode 100644
index 000000000..77234e57d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a27003a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a29003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a29003a.ada
new file mode 100644
index 000000000..e72de7959
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a29003a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a2a031a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a2a031a.ada
new file mode 100644
index 000000000..f89f904e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a2a031a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a33003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a33003a.ada
new file mode 100644
index 000000000..8fe513fbf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a33003a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a34017c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a34017c.ada
new file mode 100644
index 000000000..8884f46f6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a34017c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35101b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35101b.ada
new file mode 100644
index 000000000..a8e5d122b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35101b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35402a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35402a.ada
new file mode 100644
index 000000000..03df4428f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35402a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35801f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35801f.ada
new file mode 100644
index 000000000..bc50d2cb0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35801f.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35902c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35902c.ada
new file mode 100644
index 000000000..2dd0c9b26
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a35902c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a38106d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a38106d.ada
new file mode 100644
index 000000000..7db6aa6bb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a38106d.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a38106e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a38106e.ada
new file mode 100644
index 000000000..a0778acfd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a38106e.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a49027a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a49027a.ada
new file mode 100644
index 000000000..83e531b5e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a49027a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a49027b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a49027b.ada
new file mode 100644
index 000000000..a27956d74
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a49027b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a49027c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a49027c.ada
new file mode 100644
index 000000000..a10449e91
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a49027c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a54b01a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a54b01a.ada
new file mode 100644
index 000000000..6a7b1ac24
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a54b01a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a54b02a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a54b02a.ada
new file mode 100644
index 000000000..08d908ee9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a54b02a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a55b12a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a55b12a.ada
new file mode 100644
index 000000000..75458075b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a55b12a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a55b13a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a55b13a.ada
new file mode 100644
index 000000000..c2cc5acfd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a55b13a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a55b14a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a55b14a.ada
new file mode 100644
index 000000000..617d95b68
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a55b14a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a71004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a71004a.ada
new file mode 100644
index 000000000..da793a8b3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a71004a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a73001i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a73001i.ada
new file mode 100644
index 000000000..9595d0086
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a73001i.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a73001j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a73001j.ada
new file mode 100644
index 000000000..025e6db03
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a73001j.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74105b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74105b.ada
new file mode 100644
index 000000000..2bd4e09b4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74105b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74106a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74106a.ada
new file mode 100644
index 000000000..43afe5940
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74106a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74106b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74106b.ada
new file mode 100644
index 000000000..6f8963bff
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74106b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74106c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74106c.ada
new file mode 100644
index 000000000..fef020354
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74106c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74205e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74205e.ada
new file mode 100644
index 000000000..769e2e7e7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74205e.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74205f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74205f.ada
new file mode 100644
index 000000000..23eb301e5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a74205f.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83009a.ada
new file mode 100644
index 000000000..da64073b3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83009a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83009b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83009b.ada
new file mode 100644
index 000000000..ebd9412be
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83009b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a02a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a02a.ada
new file mode 100644
index 000000000..45bdfad04
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a02a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a02b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a02b.ada
new file mode 100644
index 000000000..7613f09ae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a02b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a06a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a06a.ada
new file mode 100644
index 000000000..3018fcd51
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a06a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a08a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a08a.ada
new file mode 100644
index 000000000..5cdc30ecd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83a08a.ada
@@ -0,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;
+
+     <<LBL>>
+
+     DECLARE
+          LBL : INTEGER := 1;
+     BEGIN
+          LBL := IDENT_INT (LBL);
+          PASSES := PASSES + 1;
+     END;
+
+     <<LBLS>>
+
+     BEGIN
+          DECLARE
+               TYPE STUFF IS (LBL, LBL_ONE, LBL_TWO);
+               ITEM : STUFF := LBL;
+
+               FUNCTION LBLS (ITEM : STUFF) RETURN BOOLEAN IS
+               BEGIN
+                    <<LBL_2>>
+                    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;
+
+     <<ENOUGH>>
+
+     RESULT;
+
+END A83A08A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83c01c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83c01c.ada
new file mode 100644
index 000000000..159f3cf86
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83c01c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83c01h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83c01h.ada
new file mode 100644
index 000000000..f50ce7761
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83c01h.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83c01i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83c01i.ada
new file mode 100644
index 000000000..3a2ec2d3a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a83c01i.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a85007d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a85007d.ada
new file mode 100644
index 000000000..d86761d7e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a85007d.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a85013b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a85013b.ada
new file mode 100644
index 000000000..6b77ada5e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a85013b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a87b59a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a87b59a.ada
new file mode 100644
index 000000000..3760e9180
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a87b59a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a95001c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a95001c.ada
new file mode 100644
index 000000000..3826e0be4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a95001c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a95074d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a95074d.ada
new file mode 100644
index 000000000..07c0032f0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a95074d.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a97106a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a97106a.ada
new file mode 100644
index 000000000..c25403296
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a97106a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a99006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a99006a.ada
new file mode 100644
index 000000000..d9822f462
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/a99006a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/aa2010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/aa2010a.ada
new file mode 100644
index 000000000..7feee2534
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/aa2010a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/aa2012a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/aa2012a.ada
new file mode 100644
index 000000000..0f72c307b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/aa2012a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac1015b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac1015b.ada
new file mode 100644
index 000000000..0e83ca556
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac1015b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac3106a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac3106a.ada
new file mode 100644
index 000000000..1b7099e85
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac3106a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac3206a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac3206a.ada
new file mode 100644
index 000000000..df535a945
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac3206a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac3207a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac3207a.ada
new file mode 100644
index 000000000..16057b9ad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ac3207a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001b.ada
new file mode 100644
index 000000000..7e14d18b7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada
new file mode 100644
index 000000000..7b4658317
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada
new file mode 100644
index 000000000..f7fd898a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada
new file mode 100644
index 000000000..0973e006c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada
new file mode 100644
index 000000000..fea236add
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7006a.ada
new file mode 100644
index 000000000..1154fe30f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7006a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7101a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7101a.ada
new file mode 100644
index 000000000..d0ee56872
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7101a.ada
@@ -0,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 <UNIVERSAL INTEGER>.
+
+-- 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 <UNIVERSAL INTEGER>");
+
+     RESULT;
+
+END AD7101A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7101c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7101c.ada
new file mode 100644
index 000000000..7b65d75a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7101c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7102a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7102a.ada
new file mode 100644
index 000000000..8f517fc20
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7102a.ada
@@ -0,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 <UNIVERSAL_INTEGER>, 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 <UNIVERSAL_INTEGER>, AND THAT ITS " &
+                      "VALUE IS STATIC");
+     RESULT;
+
+END AD7102A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7103a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7103a.ada
new file mode 100644
index 000000000..55fc0c154
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7103a.ada
@@ -0,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 <UNIVERSAL_INTEGER>, 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 <UNIVERSAL_INTEGER>, AND THAT ITS " &
+                      "VALUE IS STATIC");
+     RESULT;
+
+END AD7103A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7103c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7103c.ada
new file mode 100644
index 000000000..695eae3e2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7103c.ada
@@ -0,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 <UNIVERSAL_REAL>, 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 <UNIVERSAL_REAL>, AND THAT ITS " &
+                      "VALUE IS STATIC");
+     RESULT;
+
+END AD7103C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7104a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7104a.ada
new file mode 100644
index 000000000..204a6e0f5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7104a.ada
@@ -0,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 <UNIVERSAL_REAL>, 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 " &
+                      "<UNIVERSAL_REAL>, AND THAT ITS VALUE IS STATIC");
+
+     RESULT;
+
+END AD7104A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7201a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7201a.ada
new file mode 100644
index 000000000..e350277d8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7201a.ada
@@ -0,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
+<<G>>     G1 := (G'ADDRESS IN MY_ADDRESS);
+     END;
+
+     RESULT;
+END AD7201A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7203b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7203b.ada
new file mode 100644
index 000000000..47dd6b770
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7203b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7205b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7205b.ada
new file mode 100644
index 000000000..d619750d3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad7205b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad8011a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad8011a.tst
new file mode 100644
index 000000000..93f666c3c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ad8011a.tst
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ada101a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ada101a.ada
new file mode 100644
index 000000000..84b69d9b3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ada101a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae2113a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae2113a.ada
new file mode 100644
index 000000000..4630d39c7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae2113a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae2113b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae2113b.ada
new file mode 100644
index 000000000..969813179
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae2113b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3002g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3002g.ada
new file mode 100644
index 000000000..0a110cf14
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3002g.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3101a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3101a.ada
new file mode 100644
index 000000000..d050ee0e9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3101a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3702a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3702a.ada
new file mode 100644
index 000000000..a18b1a003
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3702a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3709a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3709a.ada
new file mode 100644
index 000000000..5866120b0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/a/ae3709a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23001a.ada
new file mode 100644
index 000000000..55fa97ce9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23001a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003a.tst
new file mode 100644
index 000000000..26fe9577c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003a.tst
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003b.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003b.tst
new file mode 100644
index 000000000..00249b68d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003b.tst
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003g.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003g.tst
new file mode 100644
index 000000000..5769937ad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003g.tst
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003i.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003i.tst
new file mode 100644
index 000000000..7439cf356
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23003i.tst
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006a.ada
new file mode 100644
index 000000000..bad6b4e3a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006b.ada
new file mode 100644
index 000000000..61ecb77b2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006c.ada
new file mode 100644
index 000000000..ddfe5a672
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006d.ada
new file mode 100644
index 000000000..0df360f82
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006d.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006e.ada
new file mode 100644
index 000000000..cd49ba586
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006e.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006f.ada
new file mode 100644
index 000000000..6848ce97e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006f.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006g.ada
new file mode 100644
index 000000000..ee3ad2896
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c23006g.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24002d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24002d.ada
new file mode 100644
index 000000000..5a9b06669
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24002d.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24003a.ada
new file mode 100644
index 000000000..61c6fa2a0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24003a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24003b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24003b.ada
new file mode 100644
index 000000000..c38597356
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24003b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24003c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24003c.ada
new file mode 100644
index 000000000..1eb8dd2c8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24003c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24106a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24106a.ada
new file mode 100644
index 000000000..fcecd0673
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24106a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24202d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24202d.ada
new file mode 100644
index 000000000..65c3d2186
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24202d.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24203a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24203a.ada
new file mode 100644
index 000000000..a97bb866d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24203a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24203b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24203b.ada
new file mode 100644
index 000000000..8a56bf1e5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24203b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24207a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24207a.ada
new file mode 100644
index 000000000..ca7e17f7c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24207a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24211a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24211a.ada
new file mode 100644
index 000000000..f04e0332c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c24211a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c250001.aw b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c250001.aw
new file mode 100644
index 000000000..fd5334359
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c250001.aw
@@ -0,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, (<xxxx>) 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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c250002.aw b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c250002.aw
new file mode 100644
index 000000000..fe2248155
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c250002.aw
@@ -0,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 (<xx>) 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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c25001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c25001a.ada
new file mode 100644
index 000000000..bb27be723
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c25001a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c25001b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c25001b.ada
new file mode 100644
index 000000000..d82547cc7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c25001b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c26006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c26006a.ada
new file mode 100644
index 000000000..b4e8ce6b2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c26006a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c26008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c26008a.ada
new file mode 100644
index 000000000..89bb549da
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c26008a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada
new file mode 100644
index 000000000..27b8fe0a2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada
new file mode 100644
index 000000000..ea1f1baae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada
new file mode 100644
index 000000000..db3c98d59
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada
new file mode 100644
index 000000000..cd7cd5998
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada
new file mode 100644
index 000000000..70690c7dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada
new file mode 100644
index 000000000..572e4ce55
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001a.ada
new file mode 100644
index 000000000..5d90b62b0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001b.ada
new file mode 100644
index 000000000..c4d5acc32
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001c.ada
new file mode 100644
index 000000000..bc70568a7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001d.ada
new file mode 100644
index 000000000..e8a6a20e0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001d.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001e.ada
new file mode 100644
index 000000000..253acc51f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32001e.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32107a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32107a.ada
new file mode 100644
index 000000000..fd4ed0926
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32107a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32107c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32107c.ada
new file mode 100644
index 000000000..31295356b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32107c.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32108a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32108a.ada
new file mode 100644
index 000000000..47423588e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32108a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32108b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32108b.ada
new file mode 100644
index 000000000..10895788d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32108b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32111a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32111a.ada
new file mode 100644
index 000000000..3cbce0940
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32111a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32111b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32111b.ada
new file mode 100644
index 000000000..85ff55e5d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32111b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32112b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32112b.ada
new file mode 100644
index 000000000..e2aeeb6d7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32112b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32113a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32113a.ada
new file mode 100644
index 000000000..60f8d6690
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32113a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32115a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32115a.ada
new file mode 100644
index 000000000..826bd2434
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32115a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32115b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32115b.ada
new file mode 100644
index 000000000..d1819c569
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c32115b.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c330001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c330001.a
new file mode 100644
index 000000000..218896d67
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c330001.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c330002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c330002.a
new file mode 100644
index 000000000..1403d5557
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c330002.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c332001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c332001.a
new file mode 100644
index 000000000..21d657373
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c332001.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c340001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c340001.a
new file mode 100644
index 000000000..dce98bdb0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c340001.a
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001a.ada
new file mode 100644
index 000000000..c66d7ddbc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001a.ada
@@ -0,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 --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001c.ada
new file mode 100644
index 000000000..a4509db4a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001c.ada
@@ -0,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 'BASE'FIRST OR 'BASE'LAST");
+     END IF;
+
+     IF T'PRED (E2) /= E1 OR T'SUCC (E1) /= E2 OR
+        S'PRED (E2) /= E1 OR S'SUCC (E1) /= E2 THEN
+          FAILED ("INCORRECT 'PRED OR 'SUCC");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'FIRST /= E3 OR T'LAST /= E4 OR
+        S'FIRST /= E3 OR S'LAST /= E4 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := E3;
+          Y := E3;
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+          END IF;
+          X := E4;
+          Y := E4;
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := E2;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := E2");
+          IF X = E2 THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := E2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := E2");
+     END;
+
+     BEGIN
+          X := E5;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := E5");
+          IF X = E5 THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := E5");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := E5");
+     END;
+
+     BEGIN
+          Y := E2;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := E2");
+          IF Y = E2 THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := E2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := E2");
+     END;
+
+     BEGIN
+          Y := E5;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := E5");
+          IF Y = E5 THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := E5");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := E5");
+     END;
+
+     RESULT;
+END C34001C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001d.ada
new file mode 100644
index 000000000..7b9832898
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001d.ada
@@ -0,0 +1,209 @@
+-- C34001D.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 BOOLEAN TYPES.
+
+-- JRK 8/20/86
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34001D IS
+
+     SUBTYPE PARENT IS BOOLEAN;
+
+     SUBTYPE SUBPARENT IS PARENT RANGE
+               PARENT'VAL (IDENT_INT (PARENT'POS (FALSE))) ..
+               PARENT'VAL (IDENT_INT (PARENT'POS (TRUE)));
+
+     TYPE T IS NEW SUBPARENT RANGE
+               PARENT'VAL (IDENT_INT (PARENT'POS (TRUE))) ..
+               PARENT'VAL (IDENT_INT (PARENT'POS (TRUE)));
+
+     X : T       := TRUE;
+     W : PARENT  := FALSE;
+     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 ("C34001D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "BOOLEAN TYPES");
+
+     X := IDENT (TRUE);
+     IF X /= TRUE THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= TRUE THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= TRUE THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := TRUE;
+     END IF;
+     IF T (W) /= TRUE THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF PARENT (X) /= TRUE OR PARENT (T'VAL (0)) /= FALSE THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF IDENT (TRUE) /= TRUE OR IDENT (TRUE) = FALSE THEN
+          FAILED ("INCORRECT ENUMERATION LITERAL");
+     END IF;
+
+     IF NOT X /= FALSE OR NOT FALSE /= X THEN
+          FAILED ("INCORRECT ""NOT""");
+     END IF;
+
+     IF (X AND IDENT (TRUE)) /= TRUE OR (X AND FALSE) /= FALSE THEN
+          FAILED ("INCORRECT ""AND""");
+     END IF;
+
+     IF (X OR IDENT (TRUE)) /= TRUE OR (FALSE OR X) /= TRUE THEN
+          FAILED ("INCORRECT ""OR""");
+     END IF;
+
+     IF (X XOR IDENT (TRUE)) /= FALSE OR (X XOR FALSE) /= TRUE THEN
+          FAILED ("INCORRECT ""XOR""");
+     END IF;
+
+     IF (X AND THEN IDENT (TRUE)) /= TRUE OR
+        (X AND THEN FALSE) /= FALSE THEN
+          FAILED ("INCORRECT ""AND THEN""");
+     END IF;
+
+     IF (X OR ELSE IDENT (TRUE)) /= TRUE OR
+        (FALSE OR ELSE X) /= TRUE THEN
+          FAILED ("INCORRECT ""OR ELSE""");
+     END IF;
+
+     IF NOT (X = IDENT (TRUE)) OR X = FALSE THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= IDENT (TRUE) OR NOT (X /= FALSE) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF X < IDENT (TRUE) OR X < FALSE THEN
+          FAILED ("INCORRECT <");
+     END IF;
+
+     IF X > IDENT (TRUE) OR FALSE > X THEN
+          FAILED ("INCORRECT >");
+     END IF;
+
+     IF NOT (X <= IDENT (TRUE)) OR X <= FALSE THEN
+          FAILED ("INCORRECT <=");
+     END IF;
+
+     IF NOT (X >= IDENT (TRUE)) OR FALSE >= X THEN
+          FAILED ("INCORRECT >=");
+     END IF;
+
+     IF NOT (X IN T) OR FALSE IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT (FALSE 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 < 1 THEN
+          FAILED ("INCORRECT 'BASE'SIZE");
+     END IF;
+
+     IF T'FIRST /= TRUE OR T'BASE'FIRST /= FALSE THEN
+          FAILED ("INCORRECT 'FIRST");
+     END IF;
+
+     IF T'IMAGE (X) /= "TRUE" OR T'IMAGE (FALSE) /= "FALSE" THEN
+          FAILED ("INCORRECT 'IMAGE");
+     END IF;
+
+     IF T'LAST /= TRUE OR T'BASE'LAST /= TRUE THEN
+          FAILED ("INCORRECT 'LAST");
+     END IF;
+
+     IF T'POS (X) /= 1 OR T'POS (FALSE) /= 0 THEN
+          FAILED ("INCORRECT 'POS");
+     END IF;
+
+     IF T'PRED (X) /= FALSE THEN
+          FAILED ("INCORRECT 'PRED");
+     END IF;
+
+     IF T'SIZE < 1 THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     IF X'SIZE < 1 THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     IF T'SUCC (T'VAL (IDENT_INT (0))) /= X THEN
+          FAILED ("INCORRECT 'SUCC");
+     END IF;
+
+     IF T'VAL (IDENT_INT (1)) /= X OR T'VAL (0) /= FALSE THEN
+          FAILED ("INCORRECT 'VAL");
+     END IF;
+
+     IF T'VALUE (IDENT_STR ("TRUE")) /= X OR
+        T'VALUE ("FALSE") /= FALSE THEN
+          FAILED ("INCORRECT 'VALUE");
+     END IF;
+
+     IF T'WIDTH /= 4 OR T'BASE'WIDTH /= 5 THEN
+          FAILED ("INCORRECT 'WIDTH");
+     END IF;
+
+     RESULT;
+END C34001D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001f.ada
new file mode 100644
index 000000000..6226e7291
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34001f.ada
@@ -0,0 +1,119 @@
+-- C34001F.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 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 C34001F IS
+
+     SUBTYPE PARENT IS BOOLEAN;
+
+     TYPE T IS NEW PARENT RANGE
+               PARENT'VAL (IDENT_INT (PARENT'POS (FALSE))) ..
+               PARENT'VAL (IDENT_INT (PARENT'POS (FALSE)));
+
+     SUBTYPE SUBPARENT IS PARENT RANGE TRUE .. TRUE;
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T;
+     Y : S;
+
+BEGIN
+     TEST ("C34001F", "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 " &
+                      "BOOLEAN TYPES");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     IF T'BASE'FIRST /= FALSE OR T'BASE'LAST /= TRUE OR
+        S'BASE'FIRST /= FALSE OR S'BASE'LAST /= TRUE THEN
+          FAILED ("INCORRECT 'BASE'FIRST OR 'BASE'LAST");
+     END IF;
+
+     IF T'PRED (TRUE) /= FALSE OR T'SUCC (FALSE) /= TRUE OR
+        S'PRED (TRUE) /= FALSE OR S'SUCC (FALSE) /= TRUE THEN
+          FAILED ("INCORRECT 'PRED OR 'SUCC");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'FIRST /= FALSE OR T'LAST /= FALSE OR
+        S'FIRST /= TRUE  OR S'LAST /= TRUE  THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := FALSE;
+          Y := TRUE;
+          IF NOT PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := TRUE;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := TRUE");
+          IF X = TRUE THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := TRUE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := TRUE");
+     END;
+
+     BEGIN
+          Y := FALSE;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := FALSE");
+          IF Y = FALSE THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := FALSE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := FALSE");
+     END;
+
+     RESULT;
+END C34001F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34002a.ada
new file mode 100644
index 000000000..8b5690e20
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34002a.ada
@@ -0,0 +1,265 @@
+-- C34002A.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 INTEGER TYPES.
+
+-- JRK 8/21/86
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34002A IS
+
+     TYPE PARENT IS RANGE -100 .. 100;
+
+     SUBTYPE SUBPARENT IS PARENT RANGE
+               PARENT'VAL (IDENT_INT (-50)) ..
+               PARENT'VAL (IDENT_INT ( 50));
+
+     TYPE T IS NEW SUBPARENT RANGE
+               PARENT'VAL (IDENT_INT (-30)) ..
+               PARENT'VAL (IDENT_INT ( 30));
+
+     TYPE FIXED IS DELTA 0.1 RANGE -1000.0 .. 1000.0;
+
+     X : T        := -30;
+     W : PARENT   := -100;
+     N : CONSTANT := 1;
+     M : CONSTANT := 100;
+     B : BOOLEAN  := FALSE;
+     F : FLOAT    := 0.0;
+     G : FIXED    := 0.0;
+
+     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 ("C34002A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "INTEGER TYPES");
+
+     X := IDENT (30);
+     IF X /= 30 THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= 30 THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= 30 THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := -30;
+     END IF;
+     IF T (W) /= -30 THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF PARENT (X) /= 30 OR PARENT (T'VAL (-100)) /= -100 THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF T (IDENT_INT (-30)) /= -30 THEN
+          FAILED ("INCORRECT CONVERSION FROM INTEGER");
+     END IF;
+
+     IF INTEGER (X) /= 30 OR INTEGER (T'VAL (-100)) /= -100 THEN
+          FAILED ("INCORRECT CONVERSION TO INTEGER");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          F := -30.0;
+     END IF;
+     IF T (F) /= -30 THEN
+          FAILED ("INCORRECT CONVERSION FROM FLOAT");
+     END IF;
+
+     IF FLOAT (X) /= 30.0 OR FLOAT (T'VAL (-100)) /= -100.0 THEN
+          FAILED ("INCORRECT CONVERSION TO FLOAT");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          G := -30.0;
+     END IF;
+     IF T (G) /= -30 THEN
+          FAILED ("INCORRECT CONVERSION FROM FIXED");
+     END IF;
+
+     IF FIXED (X) /= 30.0 OR FIXED (T'VAL (-100)) /= -100.0 THEN
+          FAILED ("INCORRECT CONVERSION TO FIXED");
+     END IF;
+
+     IF IDENT (N) /= 1 OR X = M THEN
+          FAILED ("INCORRECT IMPLICIT CONVERSION");
+     END IF;
+
+     IF IDENT (30) /= 30 OR X = 100 THEN
+          FAILED ("INCORRECT INTEGER LITERAL");
+     END IF;
+
+     IF X = IDENT (0) OR X = 100 THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= IDENT (30) OR NOT (X /= 100) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF X < IDENT (30) OR 100 < X THEN
+          FAILED ("INCORRECT <");
+     END IF;
+
+     IF X > IDENT (30) OR X > 100 THEN
+          FAILED ("INCORRECT >");
+     END IF;
+
+     IF X <= IDENT (0) OR 100 <= X THEN
+          FAILED ("INCORRECT <=");
+     END IF;
+
+     IF IDENT (0) >= X OR X >= 100 THEN
+          FAILED ("INCORRECT >=");
+     END IF;
+
+     IF NOT (X IN T) OR 100 IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT (100 NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     IF +X /= 30 OR +T'VAL(-100) /= -100 THEN
+          FAILED ("INCORRECT UNARY +");
+     END IF;
+
+     IF -X /= 0 - 30 OR -T'VAL(-100) /= 100 THEN
+          FAILED ("INCORRECT UNARY -");
+     END IF;
+
+     IF ABS X /= 30 OR ABS T'VAL (-100) /= 100 THEN
+          FAILED ("INCORRECT ABS");
+     END IF;
+
+     IF X + IDENT (-1) /= 29 OR X + 70 /= 100 THEN
+          FAILED ("INCORRECT BINARY +");
+     END IF;
+
+     IF X - IDENT (30) /= 0 OR X - 100 /= -70 THEN
+          FAILED ("INCORRECT BINARY -");
+     END IF;
+
+     IF X * IDENT (-1) /= -30 OR IDENT (2) * 50 /= 100 THEN
+          FAILED ("INCORRECT *");
+     END IF;
+
+     IF X / IDENT (3) /= 10 OR 90 / X /= 3 THEN
+          FAILED ("INCORRECT /");
+     END IF;
+
+     IF X MOD IDENT (7) /= 2 OR 100 MOD X /= 10 THEN
+          FAILED ("INCORRECT MOD");
+     END IF;
+
+     IF X REM IDENT (7) /= 2 OR 100 REM X /= 10 THEN
+          FAILED ("INCORRECT REM");
+     END IF;
+
+     IF X ** IDENT_INT (1) /= 30 OR
+        T'VAL (100) ** IDENT_INT (1) /= 100 THEN
+          FAILED ("INCORRECT **");
+     END IF;
+
+     B := FALSE;
+     A (X'ADDRESS);
+     IF NOT B THEN
+          FAILED ("INCORRECT 'ADDRESS");
+     END IF;
+
+     IF T'BASE'SIZE < 8 THEN
+          FAILED ("INCORRECT 'BASE'SIZE");
+     END IF;
+
+     IF T'FIRST /= -30 OR
+        T'POS (T'BASE'FIRST) /= PARENT'POS (PARENT'BASE'FIRST) THEN
+          FAILED ("INCORRECT 'FIRST");
+     END IF;
+
+     IF T'IMAGE (X) /= " 30" OR T'IMAGE (-100) /= "-100" THEN
+          FAILED ("INCORRECT 'IMAGE");
+     END IF;
+
+     IF T'LAST /= 30 OR
+        T'POS (T'BASE'LAST) /= PARENT'POS (PARENT'BASE'LAST) THEN
+          FAILED ("INCORRECT 'LAST");
+     END IF;
+
+     IF T'POS (X) /= 30 OR T'POS (-100) /= -100 THEN
+          FAILED ("INCORRECT 'POS");
+     END IF;
+
+     IF T'PRED (X) /= 29 OR T'PRED (100) /= 99 THEN
+          FAILED ("INCORRECT 'PRED");
+     END IF;
+
+     IF T'SIZE < 6 THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     IF X'SIZE < 6 THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     IF T'SUCC (IDENT (29)) /= X OR T'SUCC (99) /= 100 THEN
+          FAILED ("INCORRECT 'SUCC");
+     END IF;
+
+     IF T'VAL (IDENT_INT (30)) /= X OR T'VAL (100) /= 100 THEN
+          FAILED ("INCORRECT 'VAL");
+     END IF;
+
+     IF T'VALUE (IDENT_STR ("30")) /= X OR T'VALUE ("100") /= 100 THEN
+          FAILED ("INCORRECT 'VALUE");
+     END IF;
+
+     IF T'WIDTH /= 3 OR T'BASE'WIDTH < 4 THEN
+          FAILED ("INCORRECT 'WIDTH");
+     END IF;
+
+     RESULT;
+END C34002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34002c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34002c.ada
new file mode 100644
index 000000000..a14459d33
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34002c.ada
@@ -0,0 +1,152 @@
+-- C34002C.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 INTEGER 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/21/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34002C IS
+
+     TYPE PARENT IS RANGE -100 .. 100;
+
+     TYPE T IS NEW PARENT RANGE
+               PARENT'VAL (IDENT_INT (-30)) ..
+               PARENT'VAL (IDENT_INT ( 30));
+
+     SUBTYPE SUBPARENT IS PARENT RANGE -30 .. 30;
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T;
+     Y : S;
+
+BEGIN
+     TEST ("C34002C", "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 " &
+                      "INTEGER TYPES");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     IF T'POS (T'BASE'FIRST) /= PARENT'POS (PARENT'BASE'FIRST) OR
+        S'POS (S'BASE'FIRST) /= PARENT'POS (PARENT'BASE'FIRST) OR
+        T'POS (T'BASE'LAST)  /= PARENT'POS (PARENT'BASE'LAST)  OR
+        S'POS (S'BASE'LAST)  /= PARENT'POS (PARENT'BASE'LAST)  THEN
+          FAILED ("INCORRECT 'BASE'FIRST OR 'BASE'LAST");
+     END IF;
+
+     IF T'PRED (100) /= 99 OR T'SUCC (99) /= 100 OR
+        S'PRED (100) /= 99 OR S'SUCC (99) /= 100 THEN
+          FAILED ("INCORRECT 'PRED OR 'SUCC");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'FIRST /= -30 OR T'LAST /= 30 OR
+        S'FIRST /= -30 OR S'LAST /= 30 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := -30;
+          Y := -30;
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+          END IF;
+          X := 30;
+          Y := 30;
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := -31;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := -31");
+          IF X = -31 THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := -31");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := -31");
+     END;
+
+     BEGIN
+          X := 31;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := 31");
+          IF X = 31 THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := 31");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := 31");
+     END;
+
+     BEGIN
+          Y := -31;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := -31");
+          IF Y = -31 THEN -- USE Y.
+               COMMENT ("Y ALTERED -- Y := -31");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := -31");
+     END;
+
+     BEGIN
+          Y := 31;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := 31");
+          IF Y = 31 THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := 31");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := 31");
+     END;
+
+     RESULT;
+END C34002C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34003a.ada
new file mode 100644
index 000000000..ed37d0585
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34003a.ada
@@ -0,0 +1,260 @@
+-- C34003A.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 FLOATING POINT TYPES.
+
+-- JRK 9/4/86
+-- GJD 11/14/95  REMOVED USES OF OBSOLETE ADA 83 ATTRIBUTES.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34003A IS
+
+     TYPE PARENT IS DIGITS 5;
+
+     SUBTYPE SUBPARENT IS PARENT RANGE
+               PARENT (IDENT_INT (-50)) ..
+               PARENT (IDENT_INT ( 50));
+
+     TYPE T IS NEW SUBPARENT DIGITS 4 RANGE
+               PARENT (IDENT_INT (-30)) ..
+               PARENT (IDENT_INT ( 30));
+
+     TYPE FIXED IS DELTA 0.1 RANGE -1000.0 .. 1000.0;
+
+     X : T        := -30.0;
+     W : PARENT   := -100.0;
+     R : CONSTANT := 1.0;
+     M : CONSTANT := 100.0;
+     B : BOOLEAN  := FALSE;
+     F : FLOAT    := 0.0;
+     G : FIXED    := 0.0;
+
+     Z : CONSTANT T := 0.0;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN T'FIRST;
+     END IDENT;
+
+BEGIN
+     TEST ("C34003A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "FLOATING POINT TYPES");
+
+     X := IDENT (30.0);
+     IF X /= 30.0 THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= 30.0 THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= 30.0 THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := -30.0;
+     END IF;
+     IF T (W) /= -30.0 THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF PARENT (X) /= 30.0 OR PARENT (Z - 100.0) /= -100.0 THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF T (IDENT_INT (-30)) /= -30.0 THEN
+          FAILED ("INCORRECT CONVERSION FROM INTEGER");
+     END IF;
+
+     IF INTEGER (X) /= 30 OR INTEGER (Z - 100.0) /= -100 THEN
+          FAILED ("INCORRECT CONVERSION TO INTEGER");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          F := -30.0;
+     END IF;
+     IF T (F) /= -30.0 THEN
+          FAILED ("INCORRECT CONVERSION FROM FLOAT");
+     END IF;
+
+     IF FLOAT (X) /= 30.0 OR FLOAT (Z - 100.0) /= -100.0 THEN
+          FAILED ("INCORRECT CONVERSION TO FLOAT");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          G := -30.0;
+     END IF;
+     IF T (G) /= -30.0 THEN
+          FAILED ("INCORRECT CONVERSION FROM FIXED");
+     END IF;
+
+     IF FIXED (X) /= 30.0 OR FIXED (Z - 100.0) /= -100.0 THEN
+          FAILED ("INCORRECT CONVERSION TO FIXED");
+     END IF;
+
+     IF IDENT (R) /= 1.0 OR X = M THEN
+          FAILED ("INCORRECT IMPLICIT CONVERSION");
+     END IF;
+
+     IF IDENT (30.0) /= 30.0 OR X = 100.0 THEN
+          FAILED ("INCORRECT REAL LITERAL");
+     END IF;
+
+     IF X = IDENT (0.0) OR X = 100.0 THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= IDENT (30.0) OR NOT (X /= 100.0) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF X < IDENT (30.0) OR 100.0 < X THEN
+          FAILED ("INCORRECT <");
+     END IF;
+
+     IF X > IDENT (30.0) OR X > 100.0 THEN
+          FAILED ("INCORRECT >");
+     END IF;
+
+     IF X <= IDENT (0.0) OR 100.0 <= X THEN
+          FAILED ("INCORRECT <=");
+     END IF;
+
+     IF IDENT (0.0) >= X OR X >= 100.0 THEN
+          FAILED ("INCORRECT >=");
+     END IF;
+
+     IF NOT (X IN T) OR 100.0 IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT (100.0 NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     IF +X /= 30.0 OR +(Z - 100.0) /= -100.0 THEN
+          FAILED ("INCORRECT UNARY +");
+     END IF;
+
+     IF -X /= 0.0 - 30.0 OR -(Z - 100.0) /= 100.0 THEN
+          FAILED ("INCORRECT UNARY -");
+     END IF;
+
+     IF ABS X /= 30.0 OR ABS (Z - 100.0) /= 100.0 THEN
+          FAILED ("INCORRECT ABS");
+     END IF;
+
+     IF X + IDENT (-1.0) /= 29.0 OR X + 70.0 /= 100.0 THEN
+          FAILED ("INCORRECT BINARY +");
+     END IF;
+
+     IF X - IDENT (30.0) /= 0.0 OR X - 100.0 /= -70.0 THEN
+          FAILED ("INCORRECT BINARY -");
+     END IF;
+
+     IF X * IDENT (-1.0) /= -30.0 OR IDENT (2.0) * 50.0 /= 100.0 THEN
+          FAILED ("INCORRECT *");
+     END IF;
+
+     IF X / IDENT (3.0) /= 10.0 OR 90.0 / X /= 3.0 THEN
+          FAILED ("INCORRECT /");
+     END IF;
+
+     IF X ** IDENT_INT (1) /= 30.0 OR
+        (Z + 100.0) ** IDENT_INT (1) /= 100.0 THEN
+          FAILED ("INCORRECT **");
+     END IF;
+
+     B := FALSE;
+     A (X'ADDRESS);
+     IF NOT B THEN
+          FAILED ("INCORRECT 'ADDRESS");
+     END IF;
+
+     IF T'BASE'SIZE < 27 THEN
+          FAILED ("INCORRECT 'BASE'SIZE");
+     END IF;
+
+     IF T'DIGITS /= 4 OR T'BASE'DIGITS < 5 THEN
+          FAILED ("INCORRECT 'DIGITS");
+     END IF;
+
+     IF T'FIRST /= -30.0 THEN
+          FAILED ("INCORRECT 'FIRST");
+     END IF;
+
+     IF T'LAST /= 30.0 THEN
+          FAILED ("INCORRECT 'LAST");
+     END IF;
+
+     IF T'MACHINE_EMAX < 1 OR T'BASE'MACHINE_EMAX /= T'MACHINE_EMAX THEN
+          FAILED ("INCORRECT 'MACHINE_EMAX");
+     END IF;
+
+     IF T'MACHINE_EMIN > -1 OR T'BASE'MACHINE_EMIN /= T'MACHINE_EMIN THEN
+          FAILED ("INCORRECT 'MACHINE_EMIN");
+     END IF;
+
+     IF T'MACHINE_MANTISSA < 1 OR
+        T'BASE'MACHINE_MANTISSA /= T'MACHINE_MANTISSA THEN
+          FAILED ("INCORRECT 'MACHINE_MANTISSA");
+     END IF;
+
+     IF T'MACHINE_OVERFLOWS /= T'BASE'MACHINE_OVERFLOWS THEN
+          FAILED ("INCORRECT 'MACHINE_OVERFLOWS");
+     END IF;
+
+     IF T'MACHINE_RADIX < 2 OR
+        T'BASE'MACHINE_RADIX /= T'MACHINE_RADIX THEN
+          FAILED ("INCORRECT 'MACHINE_RADIX");
+     END IF;
+
+     IF T'MACHINE_ROUNDS /= T'BASE'MACHINE_ROUNDS THEN
+          FAILED ("INCORRECT 'MACHINE_ROUNDS");
+     END IF;
+
+     IF T'SIZE < 23 THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     IF X'SIZE < 23 THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     RESULT;
+END C34003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34003c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34003c.ada
new file mode 100644
index 000000000..9de3574af
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34003c.ada
@@ -0,0 +1,156 @@
+-- C34003C.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 FLOATING POINT 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 9/4/86
+-- GJD 11/15/95  REMOVED USES OF OBSOLETE ADA 83 ATTRIBUTE (SAFE_LARGE).
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34003C IS
+
+     TYPE PARENT IS DIGITS 5;
+
+     TYPE T IS NEW PARENT DIGITS 4 RANGE
+               PARENT (IDENT_INT (-30)) ..
+               PARENT (IDENT_INT ( 30));
+
+     SUBTYPE SUBPARENT IS PARENT DIGITS 4 RANGE -30.0 .. 30.0;
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T;
+     Y : S;
+
+BEGIN
+     TEST ("C34003C", "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 " &
+                      "FLOATING POINT TYPES");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     IF T'BASE'DIGITS < 5 OR S'BASE'DIGITS < 5 THEN
+          FAILED ("INCORRECT 'BASE'DIGITS");
+     END IF;
+
+     IF  12344.0 + T'(1.0) + 1.0 /=  12346.0 OR
+         12344.0 + S'(1.0) + 1.0 /=  12346.0 OR
+        -12344.0 - T'(1.0) - 1.0 /= -12346.0 OR
+        -12344.0 - S'(1.0) - 1.0 /= -12346.0 THEN
+          FAILED ("INCORRECT + OR -");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'DIGITS /= 4 OR S'DIGITS /= 4 THEN
+          FAILED ("INCORRECT 'DIGITS");
+     END IF;
+
+     IF T'FIRST /= -30.0 OR T'LAST /= 30.0 OR
+        S'FIRST /= -30.0 OR S'LAST /= 30.0 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := -30.0;
+          Y := -30.0;
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+          END IF;
+          X := 30.0;
+          Y := 30.0;
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := -31.0;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := -31.0");
+          IF X = -31.0 THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := -31.0");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := -31.0");
+     END;
+
+     BEGIN
+          X := 31.0;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := 31.0");
+          IF X = 31.0 THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := 31.0");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := 31.0");
+     END;
+
+     BEGIN
+          Y := -31.0;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := -31.0");
+          IF Y = -31.0 THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := -31.0");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := -31.0");
+     END;
+
+     BEGIN
+          Y := 31.0;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := 31.0");
+          IF Y = 31.0 THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := 31.0");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := 31.0");
+     END;
+
+     RESULT;
+END C34003C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34004a.ada
new file mode 100644
index 000000000..735776a19
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34004a.ada
@@ -0,0 +1,267 @@
+-- C34004A.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--      (IMPLICITLY) FOR DERIVED FIXED POINT TYPES.
+
+-- HISTORY:
+--      JRK 09/08/86  CREATED ORIGINAL TEST.
+--      JET 08/06/87  FIXED BUGS IN DELTAS AND RANGE ERROR.
+--      JET 09/22/88  CHANGED USAGE OF X'SIZE.
+--      RDH 04/16/90  ADDED TEST FOR REAL VARIABLE VALUES.
+--      THS 09/25/90  REMOVED ALL REFERENCES TO B, MODIFIED CHECK OF
+--                    '=', INITIALIZED Z NON-STATICALLY, MOVED BINARY
+--                    CHECKS.
+--      DTN 11/30/95  REMOVED NON ADA95 ATTRIBUTES.               
+--      KAS 03/04/96  REMOVED COMPARISON OF T'SMALL TO T'BASE'SMALL
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34004A IS
+
+     TYPE PARENT IS DELTA 2.0 ** (-7) RANGE -100.0 .. 100.0;
+
+     SUBTYPE SUBPARENT IS PARENT RANGE
+               IDENT_INT (1) * (-50.0) ..
+               IDENT_INT (1) * ( 50.0);
+
+     TYPE T IS NEW SUBPARENT DELTA 2.0 ** (-4) RANGE
+               IDENT_INT (1) * (-30.0) ..
+               IDENT_INT (1) * ( 30.0);
+
+     TYPE FIXED IS DELTA 2.0 ** (-4) RANGE -1000.0 .. 1000.0;
+
+     X : T        := -30.0;
+     I : INTEGER  := X'SIZE;  --CHECK FOR THE AVAILABILITY OF 'SIZE.
+     W : PARENT   := -100.0;
+     R : CONSTANT := 1.0;
+     M : CONSTANT := 100.0;
+     F : FLOAT    := 0.0;
+     G : FIXED    := 0.0;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          NULL;
+     END A;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN T'FIRST;
+     END IDENT;
+
+BEGIN
+
+     DECLARE
+          Z : CONSTANT T := IDENT(0.0);
+     BEGIN
+          TEST ("C34004A", "CHECK THAT THE REQUIRED PREDEFINED " &
+                           "OPERATIONS ARE DECLARED (IMPLICITLY) " &
+                           "FOR DERIVED FIXED POINT TYPES");
+
+          X := IDENT (30.0);
+          IF X /= 30.0 THEN
+               FAILED ("INCORRECT :=");
+          END IF;
+
+          IF X + IDENT (-1.0) /= 29.0 OR X + 70.0 /= 100.0 THEN
+               FAILED ("INCORRECT BINARY +");
+          END IF;
+
+          IF X - IDENT (30.0) /= 0.0 OR X - 100.0 /= -70.0 THEN
+               FAILED ("INCORRECT BINARY -");
+          END IF;
+
+          IF T'(X) /= 30.0 THEN
+               FAILED ("INCORRECT QUALIFICATION");
+          END IF;
+
+          IF T (X) /= 30.0 THEN
+               FAILED ("INCORRECT SELF CONVERSION");
+          END IF;
+
+          IF EQUAL (3, 3) THEN
+               W := -30.0;
+          END IF;
+          IF T (W) /= -30.0 THEN
+               FAILED ("INCORRECT CONVERSION FROM PARENT");
+          END IF;
+
+          IF PARENT (X) /= 30.0 OR PARENT (Z - 100.0) /= -100.0 THEN
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+
+          IF T (IDENT_INT (-30)) /= -30.0 THEN
+               FAILED ("INCORRECT CONVERSION FROM INTEGER");
+          END IF;
+
+          IF INTEGER (X) /= 30 OR INTEGER (Z - 100.0) /= -100 THEN
+               FAILED ("INCORRECT CONVERSION TO INTEGER");
+          END IF;
+
+          IF EQUAL (3, 3) THEN
+               F := -30.0;
+          END IF;
+          IF T (F) /= -30.0 THEN
+               FAILED ("INCORRECT CONVERSION FROM FLOAT");
+          END IF;
+
+          IF FLOAT (X) /= 30.0 OR FLOAT (Z - 100.0) /= -100.0 THEN
+               FAILED ("INCORRECT CONVERSION TO FLOAT");
+          END IF;
+
+          IF EQUAL (3, 3) THEN
+               G := -30.0;
+          END IF;
+          IF T (G) /= -30.0 THEN
+               FAILED ("INCORRECT CONVERSION FROM FIXED");
+          END IF;
+
+          IF FIXED (X) /= 30.0 OR FIXED (Z - 100.0) /= -100.0 THEN
+               FAILED ("INCORRECT CONVERSION TO FIXED");
+          END IF;
+
+          IF IDENT (R) /= 1.0 OR X = M THEN
+               FAILED ("INCORRECT IMPLICIT CONVERSION");
+          END IF;
+
+          IF IDENT (30.0) /= 30.0 OR X = 100.0 THEN
+               FAILED ("INCORRECT REAL LITERAL");
+          END IF;
+
+          IF NOT (X = IDENT (30.0)) THEN
+               FAILED ("INCORRECT =");
+          END IF;
+
+          IF X /= IDENT (30.0) OR NOT (X /= 100.0) THEN
+               FAILED ("INCORRECT /=");
+          END IF;
+
+          IF X < IDENT (30.0) OR 100.0 < X THEN
+               FAILED ("INCORRECT <");
+          END IF;
+
+          IF X > IDENT (30.0) OR X > 100.0 THEN
+               FAILED ("INCORRECT >");
+          END IF;
+
+          IF X <= IDENT (0.0) OR 100.0 <= X THEN
+               FAILED ("INCORRECT <=");
+          END IF;
+
+          IF IDENT (0.0) >= X OR X >= 100.0 THEN
+               FAILED ("INCORRECT >=");
+          END IF;
+
+          IF NOT (X IN T) OR 100.0 IN T THEN
+               FAILED ("INCORRECT ""IN""");
+          END IF;
+
+          IF X NOT IN T OR NOT (100.0 NOT IN T) THEN
+               FAILED ("INCORRECT ""NOT IN""");
+          END IF;
+
+          IF +X /= 30.0 OR +(Z - 100.0) /= -100.0 THEN
+               FAILED ("INCORRECT UNARY +");
+          END IF;
+
+          IF -X /= 0.0 - 30.0 OR -(Z - 100.0) /= 100.0 THEN
+               FAILED ("INCORRECT UNARY -");
+          END IF;
+
+          IF ABS X /= 30.0 OR ABS (Z - 100.0) /= 100.0 THEN
+               FAILED ("INCORRECT ABS");
+          END IF;
+
+          IF T (X * IDENT (-1.0)) /= -30.0 OR
+             T (IDENT (2.0) * (Z + 15.0)) /= 30.0 THEN
+               FAILED ("INCORRECT * (FIXED, FIXED)");
+          END IF;
+
+          IF X * IDENT_INT (-1) /= -30.0 OR
+             (Z + 50.0) * 2 /= 100.0 THEN
+               FAILED ("INCORRECT * (FIXED, INTEGER)");
+          END IF;
+
+          IF IDENT_INT (-1) * X /= -30.0 OR
+             2 * (Z + 50.0) /= 100.0 THEN
+               FAILED ("INCORRECT * (INTEGER, FIXED)");
+          END IF;
+
+          IF T (X / IDENT (3.0)) /= 10.0 OR
+             T ((Z + 90.0) / X) /= 3.0 THEN
+               FAILED ("INCORRECT / (FIXED, FIXED)");
+          END IF;
+
+          IF X / IDENT_INT (3) /= 10.0 OR (Z + 90.0) / 30 /= 3.0 THEN
+               FAILED ("INCORRECT / (FIXED, INTEGER)");
+          END IF;
+
+          A (X'ADDRESS);
+
+          IF T'AFT /= 2 OR T'BASE'AFT < 3 THEN
+               FAILED ("INCORRECT 'AFT");
+          END IF;
+
+          IF T'BASE'SIZE < 15 THEN
+               FAILED ("INCORRECT 'BASE'SIZE");
+          END IF;
+
+          IF T'DELTA /= 2.0 ** (-4) OR T'BASE'DELTA > 2.0 ** (-7) THEN
+               FAILED ("INCORRECT 'DELTA");
+          END IF;
+
+
+          IF T'FORE /= 3 OR T'BASE'FORE < 4 THEN
+               FAILED ("INCORRECT 'FORE");
+          END IF;
+
+
+
+          IF T'MACHINE_OVERFLOWS /= T'BASE'MACHINE_OVERFLOWS THEN
+               FAILED ("INCORRECT 'MACHINE_OVERFLOWS");
+          END IF;
+
+          IF T'MACHINE_ROUNDS /= T'BASE'MACHINE_ROUNDS THEN
+               FAILED ("INCORRECT 'MACHINE_ROUNDS");
+          END IF;
+
+
+
+
+          IF T'SIZE < 10 THEN
+               FAILED ("INCORRECT TYPE'SIZE");
+          END IF;
+
+          IF T'SMALL > 2.0 ** (-4) OR T'BASE'SMALL > 2.0 ** (-7) THEN
+               FAILED ("INCORRECT 'SMALL");
+          END IF;
+     END;
+
+     RESULT;
+END C34004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34004c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34004c.ada
new file mode 100644
index 000000000..d3b699f77
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34004c.ada
@@ -0,0 +1,191 @@
+-- C34004C.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:
+--     FOR DERIVED FIXED POINT 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.
+
+-- HISTORY:
+--     JRK 09/08/86
+--     JLH 09/25/87  REFORMATTED HEADER.
+--     JRL 03/13/92  MODIFIED TO DEFEAT OPTIMIZATION WHEN ATTEMPTING TO
+--                   RAISE CONSTRAINT_ERROR.
+--     JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+--     DTN 11/30/95  REMOVED NON ADA95 ATTRIBUTES.               
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34004C IS
+
+     TYPE PARENT IS DELTA 0.01 RANGE -100.0 .. 100.0;
+
+     TYPE T IS NEW PARENT DELTA 0.1 RANGE
+               IDENT_INT (1) * (-30.0) ..
+               IDENT_INT (1) * ( 30.0);
+
+     SUBTYPE SUBPARENT IS PARENT DELTA 0.1 RANGE -30.0 .. 30.0;
+
+     TYPE S IS NEW SUBPARENT;
+
+     X,XA : T;
+     Y,YA : S;
+
+
+     FUNCTION OUT_OF_BOUNDS ( VAR1 , VAR2 : T ) RETURN BOOLEAN IS
+     BEGIN
+        IF ( VAR1 + VAR2 ) IN T THEN
+           RETURN FALSE ;
+        ELSE
+           RETURN TRUE ;
+        END IF ;
+     EXCEPTION
+        WHEN CONSTRAINT_ERROR =>
+           RETURN TRUE ;
+     END OUT_OF_BOUNDS ;
+
+
+     FUNCTION OUT_OF_BOUNDS ( VAR1 , VAR2 : S ) RETURN BOOLEAN IS
+     BEGIN
+        IF ( VAR1 + VAR2 ) IN S THEN
+           RETURN FALSE ;
+        ELSE
+           RETURN TRUE ;
+        END IF ;
+     EXCEPTION
+        WHEN CONSTRAINT_ERROR =>
+           RETURN TRUE ;
+     END OUT_OF_BOUNDS ;
+
+
+BEGIN
+     TEST ("C34004C", "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 " &
+                      "FIXED POINT TYPES");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     DECLARE
+          TBD : CONSTANT := BOOLEAN'POS (T'BASE'DELTA <= 0.01);
+          SBD : CONSTANT := BOOLEAN'POS (S'BASE'DELTA <= 0.01);
+     BEGIN
+          IF TBD = 0 OR SBD = 0 THEN
+               FAILED ("INCORRECT 'BASE'DELTA");
+          END IF;
+     END;
+
+
+     DECLARE
+          N : INTEGER := IDENT_INT (8);
+     BEGIN
+          IF  98.0 + T'(1.0) + N * 0.0078125 /=  99.0625 OR
+              98.0 + S'(1.0) + 8 * 0.0078125 /=  99.0625 OR
+             -98.0 - T'(1.0) - N * 0.0078125 /= -99.0625 OR
+             -98.0 - S'(1.0) - 8 * 0.0078125 /= -99.0625 THEN
+               FAILED ("INCORRECT + OR -");
+          END IF;
+     END;
+
+
+     IF T'FIRST /= -30.0 OR T'LAST /= 30.0 OR
+        S'FIRST /= -30.0 OR S'LAST /= 30.0 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := -30.0;
+          Y := -30.0;
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+          END IF;
+          X := 30.0;
+          Y := 30.0;
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+
+     BEGIN
+          X  := -30.0 ;
+          XA := -0.0625 ;
+          IF NOT OUT_OF_BOUNDS ( X , XA ) THEN
+             FAILED ( "CONSTRAINT_ERROR NOT RAISED -- X := -30.0625" ) ;
+          END IF ;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := -30.0625");
+     END;
+
+
+     BEGIN
+          X  := 30.0 ;
+          XA := 0.0625 ;
+          IF NOT OUT_OF_BOUNDS ( X , XA ) THEN
+             FAILED ( "CONSTRAINT_ERROR NOT RAISED -- X := 30.0625" ) ;
+          END IF ;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := 30.0625");
+     END;
+
+
+     BEGIN
+          Y  := -30.0 ;
+          YA := -0.0625 ;
+          IF NOT OUT_OF_BOUNDS ( Y , YA ) THEN
+             FAILED ( "CONSTRAINT_ERROR NOT RAISED -- Y := -30.0625" ) ;
+          END IF ;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := -30.0625");
+     END;
+
+
+     BEGIN
+          Y  := 30.0 ;
+          YA := 0.0625 ;
+          IF NOT OUT_OF_BOUNDS ( Y , YA ) THEN
+             FAILED ( "CONSTRAINT_ERROR NOT RAISED -- Y := 30.0625" ) ;
+          END IF ;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := 30.0625");
+     END;
+
+     RESULT;
+END C34004C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005a.ada
new file mode 100644
index 000000000..5da6fc939
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005a.ada
@@ -0,0 +1,410 @@
+-- C34005A.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
+--     WHOSE COMPONENT TYPE IS A NON-LIMITED, NON-DISCRETE TYPE.
+
+-- HISTORY:
+--     JRK 9/10/86  CREATED ORIGINAL TEST.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005A IS
+
+     SUBTYPE COMPONENT IS FLOAT;
+
+     PACKAGE PKG IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 100;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+
+          FUNCTION CREATE ( F, L  : INDEX;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
+     SUBTYPE ARR IS ARRT (2 .. 4);
+
+     X : T               := (OTHERS => 2.0);
+     W : PARENT (5 .. 7) := (OTHERS => 2.0);
+     C : COMPONENT       := 1.0;
+     B : BOOLEAN         := FALSE;
+     U : ARR             := (OTHERS => C);
+     N : CONSTANT        := 1;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     FUNCTION V RETURN T IS
+     BEGIN
+          RETURN (OTHERS => C);
+     END V;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F, L  : INDEX;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F .. L);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F .. L LOOP
+                    A (I) := B;
+                    B := B + 1.0;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF EQUAL (X'LENGTH, X'LENGTH) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN (OTHERS => -1.0);
+     END IDENT;
+
+BEGIN
+     TEST ("C34005A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A NON-LIMITED, NON-DISCRETE TYPE");
+
+     X := IDENT ((1.0, 2.0, 3.0));
+     IF X /= (1.0, 2.0, 3.0) THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= (1.0, 2.0, 3.0) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= (1.0, 2.0, 3.0) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := (1.0, 2.0, 3.0);
+     END IF;
+     IF T (W) /= (1.0, 2.0, 3.0) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     BEGIN
+          IF PARENT (X) /= (1.0, 2.0, 3.0) OR
+             PARENT (CREATE (2, 3, 4.0, X)) /= (4.0, 5.0) THEN
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+     END;
+
+     IF EQUAL (3, 3) THEN
+          U := (1.0, 2.0, 3.0);
+     END IF;
+     IF T (U) /= (1.0, 2.0, 3.0) THEN
+          FAILED ("INCORRECT CONVERSION FROM ARRAY");
+     END IF;
+
+     BEGIN
+          IF ARR (X) /= (1.0, 2.0, 3.0) OR
+             ARRT (CREATE (1, 2, 3.0, X)) /= (3.0, 4.0) THEN
+               FAILED ("INCORRECT CONVERSION TO ARRAY");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+     END;
+
+     IF IDENT ((1.0, 2.0, 3.0)) /= (1.0, 2.0, 3.0) OR
+        X = (1.0, 2.0) THEN
+          FAILED ("INCORRECT AGGREGATE");
+     END IF;
+
+     BEGIN
+          IF X (IDENT_INT (5)) /= 1.0 OR
+             CREATE (2, 3, 4.0, X) (3) /= 5.0 THEN
+               FAILED ("INCORRECT INDEX (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+     END;
+
+     X (IDENT_INT (7)) := 4.0;
+     IF X /= (1.0, 2.0, 4.0) THEN
+          FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+     END IF;
+
+     BEGIN
+          X := IDENT ((1.0, 2.0, 3.0));
+          IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2.0, 3.0) OR
+             CREATE (1, 4, 4.0, X) (1 .. 3) /= (4.0, 5.0, 6.0) THEN
+               FAILED ("INCORRECT SLICE (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
+     END;
+
+     X (IDENT_INT (5) .. IDENT_INT (6)) := (4.0, 5.0);
+     IF X /= (4.0, 5.0, 3.0) THEN
+          FAILED ("INCORRECT SLICE (ASSIGNMENT)");
+     END IF;
+
+     X := IDENT ((1.0, 2.0, 3.0));
+     IF X = IDENT ((1.0, 2.0, 4.0)) OR X = (1.0, 2.0) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= IDENT ((1.0, 2.0, 3.0)) OR NOT (X /= (2.0, 3.0)) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) OR (1.0, 2.0) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT ((1.0, 2.0) NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     BEGIN
+          IF X & (4.0, 5.0, 6.0) /= (1.0, 2.0, 3.0, 4.0, 5.0, 6.0) OR
+             CREATE (2, 3, 2.0, X) & (4.0, 5.0) /=
+             (2.0, 3.0, 4.0, 5.0) THEN
+               FAILED ("INCORRECT & (ARRAY, ARRAY)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
+     END;
+
+     BEGIN
+          IF X & 4.0 /= (1.0, 2.0, 3.0, 4.0) OR
+             CREATE (2, 3, 2.0, X) & 4.0 /= (2.0, 3.0, 4.0) THEN
+               FAILED ("INCORRECT & (ARRAY, COMPONENT)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
+     END;
+
+     BEGIN
+          IF 4.0 & X /= (4.0, 1.0, 2.0, 3.0) OR
+             2.0 & CREATE (2, 3, 3.0, X) /= (2.0, 3.0, 4.0) THEN
+               FAILED ("INCORRECT & (COMPONENT, ARRAY)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
+     END;
+
+     IF EQUAL (3, 3) THEN
+          C := 2.0;
+     END IF;
+
+     BEGIN
+          IF C & 3.0 /= CREATE (2, 3, 2.0, X) THEN
+               FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
+     END;
+
+     B := FALSE;
+     A (X'ADDRESS);
+     IF NOT B THEN
+          FAILED ("INCORRECT 'ADDRESS");
+     END IF;
+
+     IF T'FIRST /= 5 THEN
+          FAILED ("INCORRECT TYPE'FIRST");
+     END IF;
+
+     IF X'FIRST /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST");
+     END IF;
+
+     IF V'FIRST /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST");
+     END IF;
+
+     IF T'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT TYPE'FIRST (N)");
+     END IF;
+
+     IF X'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST (N)");
+     END IF;
+
+     IF V'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST (N)");
+     END IF;
+
+     IF T'LAST /= 7 THEN
+          FAILED ("INCORRECT TYPE'LAST");
+     END IF;
+
+     IF X'LAST /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST");
+     END IF;
+
+     IF V'LAST /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST");
+     END IF;
+
+     IF T'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT TYPE'LAST (N)");
+     END IF;
+
+     IF X'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST (N)");
+     END IF;
+
+     IF V'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST (N)");
+     END IF;
+
+     IF T'LENGTH /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH");
+     END IF;
+
+     IF X'LENGTH /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH");
+     END IF;
+
+     IF V'LENGTH /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH");
+     END IF;
+
+     IF T'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH (N)");
+     END IF;
+
+     IF X'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH (N)");
+     END IF;
+
+     IF V'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH (N)");
+     END IF;
+
+     DECLARE
+          Y : PARENT (T'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT TYPE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (T'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT TYPE'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE (N)");
+          END IF;
+     END;
+
+     IF T'SIZE < T'LENGTH * COMPONENT'SIZE THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     IF X'SIZE < X'LENGTH * COMPONENT'SIZE THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     RESULT;
+END C34005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005c.ada
new file mode 100644
index 000000000..2af86afe1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005c.ada
@@ -0,0 +1,195 @@
+-- C34005C.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:
+--     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
+--     NON-LIMITED, NON-DISCRETE TYPE:
+--     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.
+
+-- HISTORY:
+--     JRK 9/10/86  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005C IS
+
+     SUBTYPE COMPONENT IS FLOAT;
+
+     PACKAGE PKG IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 100;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+
+          FUNCTION CREATE ( F, L  : INDEX;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T := (OTHERS => 2.0);
+     Y : S := (OTHERS => 2.0);
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F, L  : INDEX;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F .. L);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F .. L LOOP
+                    A (I) := B;
+                    B := B + 1.0;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34005C", "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 " &
+                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A NON-LIMITED, NON-DISCRETE TYPE");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     BEGIN
+          IF CREATE (2, 3, 4.0, X) /= (4.0, 5.0) OR
+             CREATE (2, 3, 4.0, Y) /= (4.0, 5.0) THEN
+               FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                       "SUBTYPE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION");
+     END;
+
+     IF X & (3.0, 4.0) /= (2.0, 2.0, 2.0, 3.0, 4.0) OR
+        Y & (3.0, 4.0) /= (2.0, 2.0, 2.0, 3.0, 4.0) THEN
+          FAILED ("INCORRECT &");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'FIRST /= 5 OR T'LAST /= 7 OR
+        S'FIRST /= 5 OR S'LAST /= 7 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := (1.0, 2.0, 3.0);
+          Y := (1.0, 2.0, 3.0);
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := (1.0, 2.0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := (1.0, 2.0)");
+          IF X = (1.0, 2.0) THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := (1.0, 2.0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := (1.0, 2.0)");
+     END;
+
+     BEGIN
+          X := (1.0, 2.0, 3.0, 4.0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := (1.0, 2.0, 3.0, 4.0)");
+          IF X = (1.0, 2.0, 3.0, 4.0) THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := (1.0, 2.0, 3.0, 4.0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := (1.0, 2.0, 3.0, 4.0)");
+     END;
+
+     BEGIN
+          Y := (1.0, 2.0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := (1.0, 2.0)");
+          IF Y = (1.0, 2.0) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := (1.0, 2.0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := (1.0, 2.0)");
+     END;
+
+     BEGIN
+          Y := (1.0, 2.0, 3.0, 4.0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := (1.0, 2.0, 3.0, 4.0)");
+          IF Y = (1.0, 2.0, 3.0, 4.0) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := (1.0, 2.0, 3.0, 4.0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := (1.0, 2.0, 3.0, 4.0)");
+     END;
+
+     RESULT;
+END C34005C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005d.ada
new file mode 100644
index 000000000..b549be35d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005d.ada
@@ -0,0 +1,425 @@
+-- C34005D.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
+--     WHOSE COMPONENT TYPE IS A DISCRETE TYPE.
+
+-- HISTORY:
+--     JRK 9/12/86  CREATED ORIGINAL TEST.
+--     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005D IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     PACKAGE PKG IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 100;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+
+          FUNCTION CREATE ( F, L  : INDEX;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
+     SUBTYPE ARR IS ARRT (2 .. 4);
+
+     X : T               := (OTHERS => 2);
+     W : PARENT (5 .. 7) := (OTHERS => 2);
+     C : COMPONENT       := 1;
+     B : BOOLEAN         := FALSE;
+     U : ARR             := (OTHERS => C);
+     N : CONSTANT        := 1;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     FUNCTION V RETURN T IS
+     BEGIN
+          RETURN (OTHERS => C);
+     END V;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F, L  : INDEX;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F .. L);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F .. L LOOP
+                    A (I) := B;
+                    B := B + 1;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF EQUAL (X'LENGTH, X'LENGTH) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN (OTHERS => -1);
+     END IDENT;
+
+BEGIN
+     TEST ("C34005D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A DISCRETE TYPE");
+
+     X := IDENT ((1, 2, 3));
+     IF X /= (1, 2, 3) THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= (1, 2, 3) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= (1, 2, 3) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := (1, 2, 3);
+     END IF;
+     IF T (W) /= (1, 2, 3) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     BEGIN
+          IF PARENT (X) /= (1, 2, 3) OR
+             PARENT (CREATE (2, 3, 4, X)) /= (4, 5) THEN
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+     END;
+
+     IF EQUAL (3, 3) THEN
+          U := (1, 2, 3);
+     END IF;
+     IF T (U) /= (1, 2, 3) THEN
+          FAILED ("INCORRECT CONVERSION FROM ARRAY");
+     END IF;
+
+     BEGIN
+          IF ARR (X) /= (1, 2, 3) OR
+             ARRT (CREATE (1, 2, 3, X)) /= (3, 4) THEN
+               FAILED ("INCORRECT CONVERSION TO ARRAY");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+     END;
+
+     IF IDENT ((1, 2, 3)) /= (1, 2, 3) OR
+        X = (1, 2) THEN
+          FAILED ("INCORRECT AGGREGATE");
+     END IF;
+
+     BEGIN
+          IF X (IDENT_INT (5)) /= 1 OR
+             CREATE (2, 3, 4, X) (3) /= 5 THEN
+               FAILED ("INCORRECT INDEX (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+     END;
+
+     X (IDENT_INT (7)) := 4;
+     IF X /= (1, 2, 4) THEN
+          FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+     END IF;
+
+     BEGIN
+          X := IDENT ((1, 2, 3));
+          IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2, 3) OR
+             CREATE (1, 4, 4, X) (1 .. 3) /= (4, 5, 6) THEN
+               FAILED ("INCORRECT SLICE (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
+     END;
+
+     X (IDENT_INT (5) .. IDENT_INT (6)) := (4, 5);
+     IF X /= (4, 5, 3) THEN
+          FAILED ("INCORRECT SLICE (ASSIGNMENT)");
+     END IF;
+
+     X := IDENT ((1, 2, 3));
+     IF X = IDENT ((1, 2, 4)) OR X = (1, 2) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= IDENT ((1, 2, 3)) OR NOT (X /= (2, 3)) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF X < IDENT ((1, 2, 3)) OR X < (1, 2) THEN
+          FAILED ("INCORRECT <");
+     END IF;
+
+     IF X > IDENT ((1, 2, 3)) OR X > (1, 3) THEN
+          FAILED ("INCORRECT >");
+     END IF;
+
+     IF X <= IDENT ((1, 2, 2)) OR X <= (1, 2, 2, 4) THEN
+          FAILED ("INCORRECT <=");
+     END IF;
+
+     IF X >= IDENT ((1, 2, 4)) OR X >= (1, 2, 3, 1) THEN
+          FAILED ("INCORRECT >=");
+     END IF;
+
+     IF NOT (X IN T) OR (1, 2) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT ((1, 2) NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     BEGIN
+          IF X & (4, 5, 6) /= (1, 2, 3, 4, 5, 6) OR
+             CREATE (2, 3, 2, X) & (4, 5) /= (2, 3, 4, 5) THEN
+               FAILED ("INCORRECT & (ARRAY, ARRAY)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
+     END;
+
+     BEGIN
+          IF X & 4 /= (1, 2, 3, 4) OR
+             CREATE (2, 3, 2, X) & 4 /= (2, 3, 4) THEN
+               FAILED ("INCORRECT & (ARRAY, COMPONENT)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
+     END;
+
+     BEGIN
+          IF 4 & X /= (4, 1, 2, 3) OR
+             2 & CREATE (2, 3, 3, X) /= (2, 3, 4) THEN
+               FAILED ("INCORRECT & (COMPONENT, ARRAY)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
+     END;
+
+     IF EQUAL (3, 3) THEN
+          C := 2;
+     END IF;
+
+     BEGIN
+          IF C & 3 /= CREATE (2, 3, 2, X) THEN
+               FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
+     END;
+
+     B := FALSE;
+     A (X'ADDRESS);
+     IF NOT B THEN
+          FAILED ("INCORRECT 'ADDRESS");
+     END IF;
+
+     IF T'FIRST /= 5 THEN
+          FAILED ("INCORRECT TYPE'FIRST");
+     END IF;
+
+     IF X'FIRST /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST");
+     END IF;
+
+     IF V'FIRST /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST");
+     END IF;
+
+     IF T'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT TYPE'FIRST (N)");
+     END IF;
+
+     IF X'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST (N)");
+     END IF;
+
+     IF V'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST (N)");
+     END IF;
+
+     IF T'LAST /= 7 THEN
+          FAILED ("INCORRECT TYPE'LAST");
+     END IF;
+
+     IF X'LAST /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST");
+     END IF;
+
+     IF V'LAST /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST");
+     END IF;
+
+     IF T'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT TYPE'LAST (N)");
+     END IF;
+
+     IF X'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST (N)");
+     END IF;
+
+     IF V'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST (N)");
+     END IF;
+
+     IF T'LENGTH /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH");
+     END IF;
+
+     IF X'LENGTH /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH");
+     END IF;
+
+     IF V'LENGTH /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH");
+     END IF;
+
+     IF T'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH (N)");
+     END IF;
+
+     IF X'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH (N)");
+     END IF;
+
+     IF V'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH (N)");
+     END IF;
+
+     DECLARE
+          Y : PARENT (T'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT TYPE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (T'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT TYPE'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE (N)");
+          END IF;
+     END;
+
+     IF T'SIZE < T'LENGTH * COMPONENT'SIZE THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     IF X'SIZE < X'LENGTH * COMPONENT'SIZE THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     RESULT;
+END C34005D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005f.ada
new file mode 100644
index 000000000..1971bf4e8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005f.ada
@@ -0,0 +1,195 @@
+-- C34005F.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:
+--     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
+--     DISCRETE TYPE:
+--     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.
+
+-- HISTORY:
+--     JRK 9/12/86  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005F IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     PACKAGE PKG IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 100;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+
+          FUNCTION CREATE ( F, L  : INDEX;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T := (OTHERS => 2);
+     Y : S := (OTHERS => 2);
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F, L  : INDEX;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F .. L);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F .. L LOOP
+                    A (I) := B;
+                    B := B + 1;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34005F", "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 " &
+                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A DISCRETE TYPE");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     BEGIN
+          IF CREATE (2, 3, 4, X) /= (4, 5) OR
+             CREATE (2, 3, 4, Y) /= (4, 5) THEN
+               FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                       "SUBTYPE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION");
+     END;
+
+     IF X & (3, 4) /= (2, 2, 2, 3, 4) OR
+        Y & (3, 4) /= (2, 2, 2, 3, 4) THEN
+          FAILED ("INCORRECT &");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'FIRST /= 5 OR T'LAST /= 7 OR
+        S'FIRST /= 5 OR S'LAST /= 7 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := (1, 2, 3);
+          Y := (1, 2, 3);
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := (1, 2);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := (1, 2)");
+          IF X = (1, 2) THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := (1, 2)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := (1, 2)");
+     END;
+
+     BEGIN
+          X := (1, 2, 3, 4);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := (1, 2, 3, 4)");
+          IF X = (1, 2, 3, 4) THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := (1, 2, 3, 4)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := (1, 2, 3, 4)");
+     END;
+
+     BEGIN
+          Y := (1, 2);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := (1, 2)");
+          IF Y = (1, 2) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := (1, 2)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := (1, 2)");
+     END;
+
+     BEGIN
+          Y := (1, 2, 3, 4);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := (1, 2, 3, 4)");
+          IF Y = (1, 2, 3, 4) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := (1, 2, 3, 4)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := (1, 2, 3, 4)");
+     END;
+
+     RESULT;
+END C34005F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005g.ada
new file mode 100644
index 000000000..fd8f8ffbf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005g.ada
@@ -0,0 +1,423 @@
+-- C34005G.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--    (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
+--    WHOSE COMPONENT TYPE IS A CHARACTER TYPE.
+
+-- HISTORY:
+--    JRK 9/15/86  CREATED ORIGINAL TEST.
+--    RJW 8/21/89  MODIFIED CHECKS FOR OBJECT AND TYPE SIZES.
+--    PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005G IS
+
+     TYPE COMPONENT IS NEW CHARACTER;
+
+     PACKAGE PKG IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 100;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+
+          FUNCTION CREATE ( F, L  : INDEX;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
+     SUBTYPE ARR IS ARRT (2 .. 4);
+
+     X : T               := (OTHERS => 'B');
+     W : PARENT (5 .. 7) := (OTHERS => 'B');
+     C : COMPONENT       := 'A';
+     B : BOOLEAN         := FALSE;
+     U : ARR             := (OTHERS => C);
+     N : CONSTANT        := 1;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     FUNCTION V RETURN T IS
+     BEGIN
+          RETURN (OTHERS => C);
+     END V;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F, L  : INDEX;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F .. L);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F .. L LOOP
+                    A (I) := B;
+                    B := COMPONENT'SUCC (B);
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF EQUAL (X'LENGTH, X'LENGTH) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN (OTHERS => '-');
+     END IDENT;
+
+BEGIN
+     TEST ("C34005G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A CHARACTER TYPE");
+
+     X := IDENT ("ABC");
+     IF X /= "ABC" THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= "ABC" THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= "ABC" THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := "ABC";
+     END IF;
+     IF T (W) /= "ABC" THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     BEGIN
+          IF PARENT (X) /= "ABC" OR
+             PARENT (CREATE (2, 3, 'D', X)) /= "DE" THEN
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+     END;
+
+     IF EQUAL (3, 3) THEN
+          U := "ABC";
+     END IF;
+     IF T (U) /= "ABC" THEN
+          FAILED ("INCORRECT CONVERSION FROM ARRAY");
+     END IF;
+
+     BEGIN
+          IF ARR (X) /= "ABC" OR
+             ARRT (CREATE (1, 2, 'C', X)) /= "CD" THEN
+               FAILED ("INCORRECT CONVERSION TO ARRAY");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+     END;
+
+     IF IDENT ("ABC") /= ('A', 'B', 'C') OR
+        X = "AB" THEN
+          FAILED ("INCORRECT STRING LITERAL");
+     END IF;
+
+     IF IDENT (('A', 'B', 'C')) /= "ABC" OR
+        X = ('A', 'B') THEN
+          FAILED ("INCORRECT AGGREGATE");
+     END IF;
+
+     BEGIN
+          IF X (IDENT_INT (5)) /= 'A' OR
+             CREATE (2, 3, 'D', X) (3) /= 'E' THEN
+               FAILED ("INCORRECT INDEX (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+     END;
+
+     X (IDENT_INT (7)) := 'D';
+     IF X /= "ABD" THEN
+          FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+     END IF;
+
+     BEGIN
+          X := IDENT ("ABC");
+          IF X (IDENT_INT (6) .. IDENT_INT (7)) /= "BC" OR
+             CREATE (1, 4, 'D', X) (1 .. 3) /= "DEF" THEN
+               FAILED ("INCORRECT SLICE (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
+     END;
+
+     X (IDENT_INT (5) .. IDENT_INT (6)) := "DE";
+     IF X /= "DEC" THEN
+          FAILED ("INCORRECT SLICE (ASSIGNMENT)");
+     END IF;
+
+     X := IDENT ("ABC");
+     IF X = IDENT ("ABD") OR X = "AB" THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= IDENT ("ABC") OR NOT (X /= "BC") THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF X < IDENT ("ABC") OR X < "AB" THEN
+          FAILED ("INCORRECT <");
+     END IF;
+
+     IF X > IDENT ("ABC") OR X > "AC" THEN
+          FAILED ("INCORRECT >");
+     END IF;
+
+     IF X <= IDENT ("ABB") OR X <= "ABBD" THEN
+          FAILED ("INCORRECT <=");
+     END IF;
+
+     IF X >= IDENT ("ABD") OR X >= "ABCA" THEN
+          FAILED ("INCORRECT >=");
+     END IF;
+
+     IF NOT (X IN T) OR "AB" IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT ("AB" NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     BEGIN
+          IF X & "DEF" /= "ABCDEF" OR
+             CREATE (2, 3, 'B', X) & "DE" /= "BCDE" THEN
+               FAILED ("INCORRECT & (ARRAY, ARRAY)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
+     END;
+
+     BEGIN
+          IF X & 'D' /= "ABCD" OR
+             CREATE (2, 3, 'B', X) & 'D' /= "BCD" THEN
+               FAILED ("INCORRECT & (ARRAY, COMPONENT)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
+     END;
+
+     BEGIN
+          IF 'D' & X /= "DABC" OR
+             'B' & CREATE (2, 3, 'C', X) /= "BCD" THEN
+               FAILED ("INCORRECT & (COMPONENT, ARRAY)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
+     END;
+
+     IF EQUAL (3, 3) THEN
+          C := 'B';
+     END IF;
+
+     BEGIN
+          IF C & 'C' /= CREATE (2, 3, 'B', X) THEN
+               FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
+     END;
+
+     B := FALSE;
+     A (X'ADDRESS);
+     IF NOT B THEN
+          FAILED ("INCORRECT 'ADDRESS");
+     END IF;
+
+     IF T'FIRST /= 5 THEN
+          FAILED ("INCORRECT TYPE'FIRST");
+     END IF;
+
+     IF X'FIRST /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST");
+     END IF;
+
+     IF V'FIRST /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST");
+     END IF;
+
+     IF T'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT TYPE'FIRST (N)");
+     END IF;
+
+     IF X'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST (N)");
+     END IF;
+
+     IF V'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST (N)");
+     END IF;
+
+     IF T'LAST /= 7 THEN
+          FAILED ("INCORRECT TYPE'LAST");
+     END IF;
+
+     IF X'LAST /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST");
+     END IF;
+
+     IF V'LAST /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST");
+     END IF;
+
+     IF T'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT TYPE'LAST (N)");
+     END IF;
+
+     IF X'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST (N)");
+     END IF;
+
+     IF V'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST (N)");
+     END IF;
+
+     IF T'LENGTH /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH");
+     END IF;
+
+     IF X'LENGTH /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH");
+     END IF;
+
+     IF V'LENGTH /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH");
+     END IF;
+
+     IF T'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH (N)");
+     END IF;
+
+     IF X'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH (N)");
+     END IF;
+
+     IF V'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH (N)");
+     END IF;
+
+     DECLARE
+          Y : PARENT (T'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT TYPE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (T'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT TYPE'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE (N)");
+          END IF;
+     END;
+
+     RESULT;
+END C34005G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005i.ada
new file mode 100644
index 000000000..580880e25
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005i.ada
@@ -0,0 +1,195 @@
+-- C34005I.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:
+--     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
+--     CHARACTER TYPE:
+--     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.
+
+-- HISTORY:
+--     JRK 9/15/86  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005I IS
+
+     TYPE COMPONENT IS NEW CHARACTER;
+
+     PACKAGE PKG IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 100;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+
+          FUNCTION CREATE ( F, L  : INDEX;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T := (OTHERS => 'B');
+     Y : S := (OTHERS => 'B');
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F, L  : INDEX;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F .. L);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F .. L LOOP
+                    A (I) := B;
+                    B := COMPONENT'SUCC (B);
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34005I", "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 " &
+                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A CHARACTER TYPE");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     BEGIN
+          IF CREATE (2, 3, 'D', X) /= "DE" OR
+             CREATE (2, 3, 'D', Y) /= "DE" THEN
+               FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                       "SUBTYPE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION");
+     END;
+
+     IF X & "CD" /= "BBBCD" OR
+        Y & "CD" /= "BBBCD" THEN
+          FAILED ("INCORRECT &");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'FIRST /= 5 OR T'LAST /= 7 OR
+        S'FIRST /= 5 OR S'LAST /= 7 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := "ABC";
+          Y := "ABC";
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := "AB";
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := ""AB""");
+          IF X = "AB" THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := ""AB""");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := ""AB""");
+     END;
+
+     BEGIN
+          X := "ABCD";
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := ""ABCD""");
+          IF X = "ABCD" THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := ""ABCD""");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := ""ABCD""");
+     END;
+
+     BEGIN
+          Y := "AB";
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := ""AB""");
+          IF Y = "AB" THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := ""AB""");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := ""AB""");
+     END;
+
+     BEGIN
+          Y := "ABCD";
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := ""ABCD""");
+          IF Y = "ABCD" THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := ""ABCD""");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := ""ABCD""");
+     END;
+
+     RESULT;
+END C34005I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005j.ada
new file mode 100644
index 000000000..67910aab8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005j.ada
@@ -0,0 +1,482 @@
+-- C34005J.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES
+--     WHOSE COMPONENT TYPE IS A BOOLEAN TYPE.
+
+-- HISTORY:
+--     JRK 9/16/86  CREATED ORIGINAL TEST.
+--     RJW 8/21/89  MODIFIED CHECKS FOR TYPE AND OBJECT SIZES.
+--     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005J IS
+
+     SUBTYPE COMPONENT IS BOOLEAN;
+
+     PACKAGE PKG IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 100;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+
+          FUNCTION CREATE ( F, L  : INDEX;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     TYPE ARRT IS ARRAY (INTEGER RANGE <>) OF COMPONENT;
+     SUBTYPE ARR IS ARRT (2 .. 4);
+
+     X : T               := (OTHERS => TRUE);
+     W : PARENT (5 .. 7) := (OTHERS => TRUE);
+     C : COMPONENT       := FALSE;
+     B : BOOLEAN         := FALSE;
+     U : ARR             := (OTHERS => C);
+     N : CONSTANT        := 1;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     FUNCTION V RETURN T IS
+     BEGIN
+          RETURN (OTHERS => C);
+     END V;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F, L  : INDEX;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F .. L);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F .. L LOOP
+                    A (I) := B;
+                    B := NOT B;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF EQUAL (X'LENGTH, X'LENGTH) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN (OTHERS => FALSE);
+     END IDENT;
+
+BEGIN
+     TEST ("C34005J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A BOOLEAN TYPE");
+
+     X := IDENT ((TRUE, FALSE, TRUE));
+     IF X /= (TRUE, FALSE, TRUE) THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= (TRUE, FALSE, TRUE) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= (TRUE, FALSE, TRUE) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := (TRUE, FALSE, TRUE);
+     END IF;
+     IF T (W) /= (TRUE, FALSE, TRUE) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     BEGIN
+          IF PARENT (X) /= (TRUE, FALSE, TRUE) OR
+             PARENT (CREATE (2, 3, FALSE, X)) /= (FALSE, TRUE) THEN
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+     END;
+
+     IF EQUAL (3, 3) THEN
+          U := (TRUE, FALSE, TRUE);
+     END IF;
+     IF T (U) /= (TRUE, FALSE, TRUE) THEN
+          FAILED ("INCORRECT CONVERSION FROM ARRAY");
+     END IF;
+
+     BEGIN
+          IF ARR (X) /= (TRUE, FALSE, TRUE) OR
+             ARRT (CREATE (1, 2, TRUE, X)) /= (TRUE, FALSE) THEN
+               FAILED ("INCORRECT CONVERSION TO ARRAY");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+     END;
+
+     IF IDENT ((TRUE, FALSE, TRUE)) /= (TRUE, FALSE, TRUE) OR
+        X = (TRUE, FALSE) THEN
+          FAILED ("INCORRECT AGGREGATE");
+     END IF;
+
+     BEGIN
+          IF X (IDENT_INT (5)) /= TRUE OR
+             CREATE (2, 3, FALSE, X) (3) /= TRUE THEN
+               FAILED ("INCORRECT INDEX (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+     END;
+
+     X (IDENT_INT (7)) := FALSE;
+     IF X /= (TRUE, FALSE, FALSE) THEN
+          FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+     END IF;
+
+     BEGIN
+          X := IDENT ((TRUE, FALSE, TRUE));
+          IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (FALSE, TRUE) OR
+             CREATE (1, 4, FALSE, X) (1 .. 3) /=
+             (FALSE, TRUE, FALSE) THEN
+               FAILED ("INCORRECT SLICE (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 4");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 4");
+     END;
+
+     X (IDENT_INT (5) .. IDENT_INT (6)) := (FALSE, TRUE);
+     IF X /= (FALSE, TRUE, TRUE) THEN
+          FAILED ("INCORRECT SLICE (ASSIGNMENT)");
+     END IF;
+
+     BEGIN
+          X := IDENT ((TRUE, FALSE, TRUE));
+          IF NOT X /= (FALSE, TRUE, FALSE) OR
+             NOT CREATE (2, 3, FALSE, X) /= (TRUE, FALSE) THEN
+               FAILED ("INCORRECT ""NOT""");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 5");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 5");
+     END;
+
+     BEGIN
+          IF (X AND IDENT ((TRUE, TRUE, FALSE))) /=
+             (TRUE, FALSE, FALSE) OR
+             (CREATE (1, 4, FALSE, X) AND
+             (FALSE, FALSE, TRUE, TRUE)) /=
+             (FALSE, FALSE, FALSE, TRUE) THEN
+               FAILED ("INCORRECT ""AND""");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 6");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 6");
+     END;
+
+     BEGIN
+          IF (X OR IDENT ((TRUE, FALSE, FALSE))) /=
+             (TRUE, FALSE, TRUE) OR
+             (CREATE (1, 4, FALSE, X) OR (FALSE, FALSE, TRUE, TRUE)) /=
+             (FALSE, TRUE, TRUE, TRUE) THEN
+               FAILED ("INCORRECT ""OR""");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 7");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 7");
+     END;
+
+     BEGIN
+          IF (X XOR IDENT ((TRUE, TRUE, FALSE))) /=
+             (FALSE, TRUE, TRUE) OR
+             (CREATE (1, 4, FALSE, X) XOR
+             (FALSE, FALSE, TRUE, TRUE)) /=
+             (FALSE, TRUE, TRUE, FALSE) THEN
+               FAILED ("INCORRECT ""XOR""");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 8");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 8");
+     END;
+
+     IF X = IDENT ((TRUE, FALSE, FALSE)) OR X = (TRUE, FALSE) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= IDENT ((TRUE, FALSE, TRUE)) OR
+        NOT (X /= (FALSE, TRUE)) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF X < IDENT ((TRUE, FALSE, TRUE)) OR X < (TRUE, FALSE) THEN
+          FAILED ("INCORRECT <");
+     END IF;
+
+     IF X > IDENT ((TRUE, FALSE, TRUE)) OR X > (TRUE, TRUE) THEN
+          FAILED ("INCORRECT >");
+     END IF;
+
+     IF X <= IDENT ((TRUE, FALSE, FALSE)) OR
+        X <= (TRUE, FALSE, FALSE, TRUE) THEN
+          FAILED ("INCORRECT <=");
+     END IF;
+
+     IF X >= IDENT ((TRUE, TRUE, FALSE)) OR
+        X >= (TRUE, FALSE, TRUE, FALSE) THEN
+          FAILED ("INCORRECT >=");
+     END IF;
+
+     IF NOT (X IN T) OR (TRUE, FALSE) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT ((TRUE, FALSE) NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     BEGIN
+          IF X & (FALSE, TRUE, FALSE) /=
+             (TRUE, FALSE, TRUE, FALSE, TRUE, FALSE) OR
+             CREATE (2, 3, FALSE, X) & (FALSE, TRUE) /=
+             (FALSE, TRUE, FALSE, TRUE) THEN
+               FAILED ("INCORRECT & (ARRAY, ARRAY)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 9");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 9");
+     END;
+
+     BEGIN
+          IF X & FALSE /= (TRUE, FALSE, TRUE, FALSE) OR
+             CREATE (2, 3, FALSE, X) & FALSE /=
+             (FALSE, TRUE, FALSE) THEN
+               FAILED ("INCORRECT & (ARRAY, COMPONENT)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 10");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 10");
+     END;
+
+     BEGIN
+          IF FALSE & X /= (FALSE, TRUE, FALSE, TRUE) OR
+             FALSE & CREATE (2, 3, TRUE, X) /=
+             (FALSE, TRUE, FALSE) THEN
+               FAILED ("INCORRECT & (COMPONENT, ARRAY)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 11");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 11");
+     END;
+
+     IF EQUAL (3, 3) THEN
+          C := FALSE;
+     END IF;
+
+     BEGIN
+          IF C & TRUE /= CREATE (2, 3, FALSE, X) THEN
+               FAILED ("INCORRECT & (COMPONENT, COMPONENT)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 12");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 12");
+     END;
+
+     B := FALSE;
+     A (X'ADDRESS);
+     IF NOT B THEN
+          FAILED ("INCORRECT 'ADDRESS");
+     END IF;
+
+     IF T'FIRST /= 5 THEN
+          FAILED ("INCORRECT TYPE'FIRST");
+     END IF;
+
+     IF X'FIRST /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST");
+     END IF;
+
+     IF V'FIRST /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST");
+     END IF;
+
+     IF T'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT TYPE'FIRST (N)");
+     END IF;
+
+     IF X'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST (N)");
+     END IF;
+
+     IF V'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST (N)");
+     END IF;
+
+     IF T'LAST /= 7 THEN
+          FAILED ("INCORRECT TYPE'LAST");
+     END IF;
+
+     IF X'LAST /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST");
+     END IF;
+
+     IF V'LAST /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST");
+     END IF;
+
+     IF T'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT TYPE'LAST (N)");
+     END IF;
+
+     IF X'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST (N)");
+     END IF;
+
+     IF V'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST (N)");
+     END IF;
+
+     IF T'LENGTH /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH");
+     END IF;
+
+     IF X'LENGTH /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH");
+     END IF;
+
+     IF V'LENGTH /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH");
+     END IF;
+
+     IF T'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH (N)");
+     END IF;
+
+     IF X'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH (N)");
+     END IF;
+
+     IF V'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH (N)");
+     END IF;
+
+     DECLARE
+          Y : PARENT (T'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT TYPE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (T'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT TYPE'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE (N)");
+          END IF;
+     END;
+
+     RESULT;
+END C34005J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005l.ada
new file mode 100644
index 000000000..2aba733f3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005l.ada
@@ -0,0 +1,195 @@
+-- C34005L.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:
+--     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
+--     BOOLEAN TYPE:
+--     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.
+
+-- HISTORY:
+--     JRK 9/16/86  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005L IS
+
+     SUBTYPE COMPONENT IS BOOLEAN;
+
+     PACKAGE PKG IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 100;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+
+          FUNCTION CREATE ( F, L  : INDEX;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T := (OTHERS => TRUE);
+     Y : S := (OTHERS => TRUE);
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F, L  : INDEX;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F .. L);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F .. L LOOP
+                    A (I) := B;
+                    B := NOT B;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34005L", "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 " &
+                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A BOOLEAN TYPE");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     BEGIN
+          IF CREATE (2, 3, FALSE, X) /= (FALSE, TRUE) OR
+             CREATE (2, 3, FALSE, Y) /= (FALSE, TRUE) THEN
+               FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                       "SUBTYPE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION");
+     END;
+
+     IF X & (FALSE, TRUE) /= (TRUE, TRUE, TRUE, FALSE, TRUE) OR
+        Y & (FALSE, TRUE) /= (TRUE, TRUE, TRUE, FALSE, TRUE) THEN
+          FAILED ("INCORRECT &");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'FIRST /= 5 OR T'LAST /= 7 OR
+        S'FIRST /= 5 OR S'LAST /= 7 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := (TRUE, FALSE, TRUE);
+          Y := (TRUE, FALSE, TRUE);
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := (TRUE, FALSE);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- X := (TRUE, FALSE)");
+          IF X = (TRUE, FALSE) THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := (TRUE, FALSE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- X := (TRUE, FALSE)");
+     END;
+
+     BEGIN
+          X := (TRUE, FALSE, TRUE, FALSE);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := (TRUE, FALSE, TRUE, FALSE)");
+          IF X = (TRUE, FALSE, TRUE, FALSE) THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := (TRUE, FALSE, TRUE, FALSE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := (TRUE, FALSE, TRUE, FALSE)");
+     END;
+
+     BEGIN
+          Y := (TRUE, FALSE);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- Y := (TRUE, FALSE)");
+          IF Y = (TRUE, FALSE) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := (TRUE, FALSE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- Y := (TRUE, FALSE)");
+     END;
+
+     BEGIN
+          Y := (TRUE, FALSE, TRUE, FALSE);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := (TRUE, FALSE, TRUE, FALSE)");
+          IF Y = (TRUE, FALSE, TRUE, FALSE) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := (TRUE, FALSE, TRUE, FALSE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := (TRUE, FALSE, TRUE, FALSE)");
+     END;
+
+     RESULT;
+END C34005L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005m.ada
new file mode 100644
index 000000000..51d319226
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005m.ada
@@ -0,0 +1,353 @@
+-- C34005M.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
+--     COMPONENT TYPE IS A NON-LIMITED TYPE.
+
+-- HISTORY:
+--     JRK 9/17/86  CREATED ORIGINAL TEST.
+--     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005M IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     PACKAGE PKG IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 10;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
+                               COMPONENT;
+
+          FUNCTION CREATE ( F1, L1 : INDEX;
+                            F2, L2 : INDEX;
+                            C      : COMPONENT;
+                            DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                           IDENT_INT (6) .. IDENT_INT (8));
+
+     TYPE ARRT IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF
+                        COMPONENT;
+
+     SUBTYPE ARR IS ARRT (8 .. 9, 2 .. 4);
+
+     X : T                       := (OTHERS => (OTHERS => 2));
+     W : PARENT (4 .. 5, 6 .. 8) := (OTHERS => (OTHERS => 2));
+     C : COMPONENT               := 1;
+     B : BOOLEAN                 := FALSE;
+     U : ARR                     := (OTHERS => (OTHERS => C));
+     N : CONSTANT                := 2;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     FUNCTION V RETURN T IS
+     BEGIN
+          RETURN (OTHERS => (OTHERS => C));
+     END V;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F1, L1 : INDEX;
+               F2, L2 : INDEX;
+               C      : COMPONENT;
+               DUMMY  : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F1 .. L1, F2 .. L2);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F1 .. L1 LOOP
+                    FOR J IN F2 .. L2 LOOP
+                         A (I, J) := B;
+                         B := B + 1;
+                    END LOOP;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF EQUAL (X'LENGTH, X'LENGTH) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN (OTHERS => (OTHERS => -1));
+     END IDENT;
+
+BEGIN
+     TEST ("C34005M", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A NON-LIMITED TYPE");
+
+     X := IDENT (((1, 2, 3), (4, 5, 6)));
+     IF X /= ((1, 2, 3), (4, 5, 6)) THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= ((1, 2, 3), (4, 5, 6)) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= ((1, 2, 3), (4, 5, 6)) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := ((1, 2, 3), (4, 5, 6));
+     END IF;
+     IF T (W) /= ((1, 2, 3), (4, 5, 6)) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     BEGIN
+          IF PARENT (X) /= ((1, 2, 3), (4, 5, 6)) OR
+             PARENT (CREATE (6, 9, 2, 3, 4, X)) /=
+             ((4, 5), (6, 7), (8, 9), (10, 11)) THEN
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+     END;
+
+     IF EQUAL (3, 3) THEN
+          U := ((1, 2, 3), (4, 5, 6));
+     END IF;
+     IF T (U) /= ((1, 2, 3), (4, 5, 6)) THEN
+          FAILED ("INCORRECT CONVERSION FROM ARRAY");
+     END IF;
+
+     BEGIN
+          IF ARR (X) /= ((1, 2, 3), (4, 5, 6)) OR
+             ARRT (CREATE (7, 9, 2, 5, 3, X)) /=
+             ((3, 4, 5, 6), (7, 8, 9, 10), (11, 12, 13, 14)) THEN
+               FAILED ("INCORRECT CONVERSION TO ARRAY");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+     END;
+
+     IF IDENT (((1, 2, 3), (4, 5, 6))) /= ((1, 2, 3), (4, 5, 6)) OR
+        X = ((1, 2), (3, 4), (5, 6)) THEN
+          FAILED ("INCORRECT AGGREGATE");
+     END IF;
+
+     BEGIN
+          IF X (IDENT_INT (4), IDENT_INT (6)) /= 1 OR
+             CREATE (6, 9, 2, 3, 4, X) (9, 3) /= 11 THEN
+               FAILED ("INCORRECT INDEX (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+     END;
+
+     X (IDENT_INT (5), IDENT_INT (8)) := 7;
+     IF X /= ((1, 2, 3), (4, 5, 7)) THEN
+          FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+     END IF;
+
+     X := IDENT (((1, 2, 3), (4, 5, 6)));
+     IF X = IDENT (((1, 2, 3), (4, 5, 7))) OR
+        X = ((1, 2), (4, 5)) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= IDENT (((1, 2, 3), (4, 5, 6))) OR
+        NOT (X /= ((1, 2, 3), (4, 5, 6), (7, 8, 9))) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) OR ((1, 2), (3, 4)) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR
+        NOT (((1, 2, 3), (4, 5, 6), (7, 8, 9)) 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'FIRST /= 4 THEN
+          FAILED ("INCORRECT TYPE'FIRST");
+     END IF;
+
+     IF X'FIRST /= 4 THEN
+          FAILED ("INCORRECT OBJECT'FIRST");
+     END IF;
+
+     IF V'FIRST /= 4 THEN
+          FAILED ("INCORRECT VALUE'FIRST");
+     END IF;
+
+     IF T'FIRST (N) /= 6 THEN
+          FAILED ("INCORRECT TYPE'FIRST (N)");
+     END IF;
+
+     IF X'FIRST (N) /= 6 THEN
+          FAILED ("INCORRECT OBJECT'FIRST (N)");
+     END IF;
+
+     IF V'FIRST (N) /= 6 THEN
+          FAILED ("INCORRECT VALUE'FIRST (N)");
+     END IF;
+
+     IF T'LAST /= 5 THEN
+          FAILED ("INCORRECT TYPE'LAST");
+     END IF;
+
+     IF X'LAST /= 5 THEN
+          FAILED ("INCORRECT OBJECT'LAST");
+     END IF;
+
+     IF V'LAST /= 5 THEN
+          FAILED ("INCORRECT VALUE'LAST");
+     END IF;
+
+     IF T'LAST (N) /= 8 THEN
+          FAILED ("INCORRECT TYPE'LAST (N)");
+     END IF;
+
+     IF X'LAST (N) /= 8 THEN
+          FAILED ("INCORRECT OBJECT'LAST (N)");
+     END IF;
+
+     IF V'LAST (N) /= 8 THEN
+          FAILED ("INCORRECT VALUE'LAST (N)");
+     END IF;
+
+     IF T'LENGTH /= 2 THEN
+          FAILED ("INCORRECT TYPE'LENGTH");
+     END IF;
+
+     IF X'LENGTH /= 2 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH");
+     END IF;
+
+     IF V'LENGTH /= 2 THEN
+          FAILED ("INCORRECT VALUE'LENGTH");
+     END IF;
+
+     IF T'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH (N)");
+     END IF;
+
+     IF X'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH (N)");
+     END IF;
+
+     IF V'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH (N)");
+     END IF;
+
+     DECLARE
+          Y : PARENT (T'RANGE, 1 .. 3);
+     BEGIN
+          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+               FAILED ("INCORRECT TYPE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE, 1 .. 3);
+     BEGIN
+          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+               FAILED ("INCORRECT OBJECT'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE, 1 .. 3);
+     BEGIN
+          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+               FAILED ("INCORRECT VALUE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (1 .. 2, T'RANGE (N));
+     BEGIN
+          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+               FAILED ("INCORRECT TYPE'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (1 .. 2, X'RANGE (N));
+     BEGIN
+          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+               FAILED ("INCORRECT OBJECT'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (1 .. 2, V'RANGE (N));
+     BEGIN
+          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+               FAILED ("INCORRECT VALUE'RANGE (N)");
+          END IF;
+     END;
+
+     IF T'SIZE < T'LENGTH * T'LENGTH (N) * COMPONENT'SIZE THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     IF X'SIZE < X'LENGTH * X'LENGTH (N) * COMPONENT'SIZE THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     RESULT;
+END C34005M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005o.ada
new file mode 100644
index 000000000..a45d5ddb2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005o.ada
@@ -0,0 +1,277 @@
+-- C34005O.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:
+--     FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE
+--     IS A NON-LIMITED TYPE:
+--     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.
+
+-- HISTORY:
+--     JRK 9/17/86  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005O IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     PACKAGE PKG IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 10;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
+                               COMPONENT;
+
+          FUNCTION CREATE ( F1, L1 : INDEX;
+                            F2, L2 : INDEX;
+                            C      : COMPONENT;
+                            DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                           IDENT_INT (6) .. IDENT_INT (8));
+
+     SUBTYPE SUBPARENT IS PARENT (4 .. 5, 6 .. 8);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T := (OTHERS => (OTHERS => 2));
+     Y : S := (OTHERS => (OTHERS => 2));
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F1, L1 : INDEX;
+               F2, L2 : INDEX;
+               C      : COMPONENT;
+               DUMMY  : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F1 .. L1, F2 .. L2);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F1 .. L1 LOOP
+                    FOR J IN F2 .. L2 LOOP
+                         A (I, J) := B;
+                         B := B + 1;
+                    END LOOP;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34005O", "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 " &
+                      "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A NON-LIMITED TYPE");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     BEGIN
+          IF CREATE (6, 9, 2, 3, 1, X) /=
+             ((1, 2), (3, 4), (5, 6), (7, 8)) OR
+             CREATE (6, 9, 2, 3, 1, Y) /=
+             ((1, 2), (3, 4), (5, 6), (7, 8)) THEN
+               FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                       "SUBTYPE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION");
+     END;
+
+     IF ((1, 2), (3, 4), (5, 6), (7, 8)) IN T OR
+        ((1, 2), (3, 4), (5, 6), (7, 8)) IN S THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'FIRST /= 4 OR T'LAST /= 5 OR
+        S'FIRST /= 4 OR S'LAST /= 5 OR
+        T'FIRST (2) /= 6 OR T'LAST (2) /= 8 OR
+        S'FIRST (2) /= 6 OR S'LAST (2) /= 8 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := ((1, 2, 3), (4, 5, 6));
+          Y := ((1, 2, 3), (4, 5, 6));
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := (4 => (6 .. 8 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := (4 => (6 .. 8 => 0))");
+          IF X = (4 => (6 .. 8 => 0)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := (4 => (6 .. 8 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := (4 => (6 .. 8 => 0))");
+     END;
+
+     BEGIN
+          X := (4 .. 6 => (6 .. 8 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := (4 .. 6 => (6 .. 8 => 0))");
+          IF X = (4 .. 6 => (6 .. 8 => 0)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := (4 .. 6 => (6 .. 8 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := (4 .. 6 => (6 .. 8 => 0))");
+     END;
+
+     BEGIN
+          X := (4 .. 5 => (6 .. 7 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := (4 .. 5 => (6 .. 7 => 0))");
+          IF X = (4 .. 5 => (6 .. 7 => 0)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := (4 .. 5 => (6 .. 7 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := (4 .. 5 => (6 .. 7 => 0))");
+     END;
+
+     BEGIN
+          X := (4 .. 5 => (6 .. 9 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := (4 .. 5 => (6 .. 9 => 0))");
+          IF X = (4 .. 5 => (6 .. 9 => 0)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := (4 .. 5 => (6 .. 9 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := (4 .. 5 => (6 .. 9 => 0))");
+     END;
+
+     BEGIN
+          Y := (4 => (6 .. 8 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := (4 => (6 .. 8 => 0))");
+          IF Y = (4 => (6 .. 8 => 0)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := (4 => (6 .. 8 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := (4 => (6 .. 8 => 0))");
+     END;
+
+     BEGIN
+          Y := (4 .. 6 => (6 .. 8 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := (4 .. 6 => (6 .. 8 => 0))");
+          IF Y = (4 .. 6 => (6 .. 8 => 0)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := (4 .. 6 => (6 .. 8 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := (4 .. 6 => (6 .. 8 => 0))");
+     END;
+
+     BEGIN
+          Y := (4 .. 5 => (6 .. 7 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := (4 .. 5 => (6 .. 7 => 0))");
+          IF Y = (4 .. 5 => (6 .. 7 => 0)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := (4 .. 5 => (6 .. 7 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := (4 .. 5 => (6 .. 7 => 0))");
+     END;
+
+     BEGIN
+          Y := (4 .. 5 => (6 .. 9 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := (4 .. 5 => (6 .. 9 => 0))");
+          IF Y = (4 .. 5 => (6 .. 9 => 0)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := (4 .. 5 => (6 .. 9 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := (4 .. 5 => (6 .. 9 => 0))");
+     END;
+
+     RESULT;
+END C34005O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005p.ada
new file mode 100644
index 000000000..31e67a72e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005p.ada
@@ -0,0 +1,405 @@
+-- C34005P.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE
+--     COMPONENT TYPE IS A LIMITED TYPE.
+
+-- HISTORY:
+--     JRK 08/17/87  CREATED ORIGINAL TEST.
+--     VCL 07/01/88  MODIFIED THE STATEMENTS INVOLVING THE 'SIZE
+--                   ATTRIBUTE TO REMOVE ANY ASSUMPTIONS ABOUT THE
+--                   SIZES.  ADDED EXCEPTION HANDLERS TO CATCH INCORRECT
+--                   TYPE CONVERSIONS TO DERIVED SUBTYPES.
+--     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+--     RLB 10/03/02  REMOVED ILLEGAL (BY AI-246) TYPE CONVERSIONS AND
+--                   SUPPORTING CODE.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005P IS
+
+     PACKAGE PKG_L IS
+
+          TYPE LP IS LIMITED PRIVATE;
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP;
+
+          FUNCTION VALUE (X : LP) RETURN INTEGER;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+
+          C1 : CONSTANT LP;
+          C2 : CONSTANT LP;
+          C3 : CONSTANT LP;
+          C4 : CONSTANT LP;
+          C5 : CONSTANT LP;
+          C6 : CONSTANT LP;
+
+     PRIVATE
+
+          TYPE LP IS NEW INTEGER;
+
+          C1 : CONSTANT LP := 1;
+          C2 : CONSTANT LP := 2;
+          C3 : CONSTANT LP := 3;
+          C4 : CONSTANT LP := 4;
+          C5 : CONSTANT LP := 5;
+          C6 : CONSTANT LP := 6;
+
+     END PKG_L;
+
+     USE PKG_L;
+
+     SUBTYPE COMPONENT IS LP;
+
+     PACKAGE PKG_P IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 100;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+
+          FUNCTION CREATE ( F, L  : INDEX;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+          FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT;
+
+          FUNCTION AGGR (X, Y, Z : COMPONENT) RETURN PARENT;
+
+     END PKG_P;
+
+     USE PKG_P;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     X : T;
+     W : PARENT (5 .. 7);
+     C : COMPONENT;
+     B : BOOLEAN := FALSE;
+     N : CONSTANT := 1;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     FUNCTION V RETURN T IS
+          RESULT : T;
+     BEGIN
+          FOR I IN RESULT'RANGE LOOP
+               ASSIGN (RESULT (I), C);
+          END LOOP;
+          RETURN RESULT;
+     END V;
+
+     PACKAGE BODY PKG_L IS
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP IS
+          BEGIN
+               RETURN LP (IDENT_INT (X));
+          END CREATE;
+
+          FUNCTION VALUE (X : LP) RETURN INTEGER IS
+          BEGIN
+               RETURN INTEGER (X);
+          END VALUE;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG_L;
+
+     PACKAGE BODY PKG_P IS
+
+          FUNCTION CREATE
+             ( F, L  : INDEX;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F .. L);
+               B : COMPONENT;
+          BEGIN
+               ASSIGN (B, C);
+               FOR I IN F .. L LOOP
+                    ASSIGN (A (I), B);
+                    ASSIGN (B, CREATE (VALUE (B) + 1));
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               IF X'LENGTH /= Y'LENGTH THEN
+                    RETURN FALSE;
+               ELSE FOR I IN X'RANGE LOOP
+                         IF NOT EQUAL (X (I),
+                                       Y (I - X'FIRST + Y'FIRST)) THEN
+                              RETURN FALSE;
+                         END IF;
+                    END LOOP;
+               END IF;
+               RETURN TRUE;
+          END EQUAL;
+
+          FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT IS
+               RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 1);
+          BEGIN
+               ASSIGN (RESULT (INDEX'FIRST    ), X);
+               ASSIGN (RESULT (INDEX'FIRST + 1), Y);
+               RETURN RESULT;
+          END AGGR;
+
+          FUNCTION AGGR (X, Y, Z : COMPONENT) RETURN PARENT IS
+               RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 2);
+          BEGIN
+               ASSIGN (RESULT (INDEX'FIRST    ), X);
+               ASSIGN (RESULT (INDEX'FIRST + 1), Y);
+               ASSIGN (RESULT (INDEX'FIRST + 2), Z);
+               RETURN RESULT;
+          END AGGR;
+
+     END PKG_P;
+
+BEGIN
+     TEST ("C34005P", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A LIMITED TYPE");
+
+     ASSIGN (X (IDENT_INT (5)), CREATE (1));
+     ASSIGN (X (IDENT_INT (6)), CREATE (2));
+     ASSIGN (X (IDENT_INT (7)), CREATE (3));
+
+     ASSIGN (W (5), CREATE (1));
+     ASSIGN (W (6), CREATE (2));
+     ASSIGN (W (7), CREATE (3));
+
+     ASSIGN (C, CREATE (2));
+
+     IF NOT EQUAL (T'(X), AGGR (C1, C2, C3)) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF NOT EQUAL (T(X), AGGR (C1, C2, C3)) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF NOT EQUAL (T(W), AGGR (C1, C2, C3)) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF NOT EQUAL (PARENT(X), AGGR (C1, C2, C3)) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+     END IF;
+
+     BEGIN
+          IF NOT EQUAL (PARENT(CREATE (2, 3, C4, X)),
+                        AGGR (C4, C5))                 THEN
+               FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED WHILE CHECKING BASE TYPE " &
+                       "VALUES OUTSIDE OF THE SUBTYPE T - 1");
+     END;
+
+     IF NOT EQUAL (X(IDENT_INT (5)), C1) THEN
+          FAILED ("INCORRECT INDEX (VALUE)");
+     END IF;
+
+     BEGIN
+          IF NOT EQUAL (X(IDENT_INT (6)..IDENT_INT (7)),
+                        AGGR (C2, C3))     OR
+             NOT EQUAL (CREATE (1, 4, C4, X)(1..3),
+                        AGGR (C4, C5, C6))           THEN
+               FAILED ("INCORRECT SLICE (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED WHILE CHECKING SLICES");
+     END;
+
+     IF NOT (X IN T) OR AGGR (C1, C2) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT (AGGR (C1, C2) 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'FIRST /= 5 THEN
+          FAILED ("INCORRECT TYPE'FIRST");
+     END IF;
+
+     IF X'FIRST /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST");
+     END IF;
+
+     IF V'FIRST /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST");
+     END IF;
+
+     IF T'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT TYPE'FIRST (N)");
+     END IF;
+
+     IF X'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST (N)");
+     END IF;
+
+     IF V'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST (N)");
+     END IF;
+
+     IF T'LAST /= 7 THEN
+          FAILED ("INCORRECT TYPE'LAST");
+     END IF;
+
+     IF X'LAST /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST");
+     END IF;
+
+     IF V'LAST /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST");
+     END IF;
+
+     IF T'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT TYPE'LAST (N)");
+     END IF;
+
+     IF X'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST (N)");
+     END IF;
+
+     IF V'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST (N)");
+     END IF;
+
+     IF T'LENGTH /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH");
+     END IF;
+
+     IF X'LENGTH /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH");
+     END IF;
+
+     IF V'LENGTH /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH");
+     END IF;
+
+     IF T'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH (N)");
+     END IF;
+
+     IF X'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH (N)");
+     END IF;
+
+     IF V'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH (N)");
+     END IF;
+
+     DECLARE
+          Y : PARENT (T'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT TYPE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (T'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT TYPE'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE (N)");
+          END IF;
+     END;
+
+     IF X'SIZE < T'SIZE THEN
+          COMMENT ("X'SIZE < T'SIZE");
+     ELSIF X'SIZE = T'SIZE THEN
+          COMMENT ("X'SIZE = T'SIZE");
+     ELSE
+          COMMENT ("X'SIZE > T'SIZE");
+     END IF;
+
+     RESULT;
+END C34005P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005r.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005r.ada
new file mode 100644
index 000000000..8b36d59a3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005r.ada
@@ -0,0 +1,346 @@
+-- C34005R.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:
+--     FOR DERIVED ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS A
+--     LIMITED TYPE:
+
+--        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.
+
+-- HISTORY:
+--     JRK 08/19/87  CREATED ORIGINAL TEST.
+--     VCL 07/01/88  ADDED EXCEPTION HANDLERS TO CATCH INCORRECT TYPE
+--                   CONVERSIONS TO DERIVED SUBTYPES.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005R IS
+
+     PACKAGE PKG_L IS
+
+          TYPE LP IS LIMITED PRIVATE;
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP;
+
+          FUNCTION VALUE (X : LP) RETURN INTEGER;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+
+          C1 : CONSTANT LP;
+          C2 : CONSTANT LP;
+          C3 : CONSTANT LP;
+          C4 : CONSTANT LP;
+          C5 : CONSTANT LP;
+
+     PRIVATE
+
+          TYPE LP IS NEW INTEGER;
+
+          C1 : CONSTANT LP := 1;
+          C2 : CONSTANT LP := 2;
+          C3 : CONSTANT LP := 3;
+          C4 : CONSTANT LP := 4;
+          C5 : CONSTANT LP := 5;
+
+     END PKG_L;
+
+     USE PKG_L;
+
+     SUBTYPE COMPONENT IS LP;
+
+     PACKAGE PKG_P IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 100;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>) OF COMPONENT;
+
+          FUNCTION CREATE ( F, L  : INDEX;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+          FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT;
+
+          FUNCTION AGGR (W, X, Y, Z : COMPONENT) RETURN PARENT;
+
+     END PKG_P;
+
+     USE PKG_P;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T;
+     Y : S;
+
+     PACKAGE BODY PKG_L IS
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP IS
+          BEGIN
+               RETURN LP (IDENT_INT (X));
+          END CREATE;
+
+          FUNCTION VALUE (X : LP) RETURN INTEGER IS
+          BEGIN
+               RETURN INTEGER (X);
+          END VALUE;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG_L;
+
+     PACKAGE BODY PKG_P IS
+
+          FUNCTION CREATE
+             ( F, L  : INDEX;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F .. L);
+               B : COMPONENT;
+          BEGIN
+               ASSIGN (B, C);
+               FOR I IN F .. L LOOP
+                    ASSIGN (A (I), B);
+                    ASSIGN (B, CREATE (VALUE (B) + 1));
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               IF X'LENGTH /= Y'LENGTH THEN
+                    RETURN FALSE;
+               ELSE FOR I IN X'RANGE LOOP
+                         IF NOT EQUAL (X (I),
+                                       Y (I - X'FIRST + Y'FIRST)) THEN
+                              RETURN FALSE;
+                         END IF;
+                    END LOOP;
+               END IF;
+               RETURN TRUE;
+          END EQUAL;
+
+          FUNCTION AGGR (X, Y : COMPONENT) RETURN PARENT IS
+               RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 1);
+          BEGIN
+               ASSIGN (RESULT (INDEX'FIRST    ), X);
+               ASSIGN (RESULT (INDEX'FIRST + 1), Y);
+               RETURN RESULT;
+          END AGGR;
+
+          FUNCTION AGGR (W, X, Y, Z : COMPONENT) RETURN PARENT IS
+               RESULT : PARENT (INDEX'FIRST .. INDEX'FIRST + 3);
+          BEGIN
+               ASSIGN (RESULT (INDEX'FIRST    ), W);
+               ASSIGN (RESULT (INDEX'FIRST + 1), X);
+               ASSIGN (RESULT (INDEX'FIRST + 2), Y);
+               ASSIGN (RESULT (INDEX'FIRST + 3), Z);
+               RETURN RESULT;
+          END AGGR;
+
+     END PKG_P;
+
+     PROCEDURE ASSIGN (X : IN OUT T; Y : T) IS
+     BEGIN
+          FOR I IN X'RANGE LOOP
+               ASSIGN (X (I), Y (I));
+          END LOOP;
+     END ASSIGN;
+
+     PROCEDURE ASSIGN (X : IN OUT S; Y : S) IS
+     BEGIN
+          FOR I IN X'RANGE LOOP
+               ASSIGN (X (I), Y (I));
+          END LOOP;
+     END ASSIGN;
+
+BEGIN
+     TEST ("C34005R", "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 " &
+                      "ONE-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A LIMITED TYPE");
+
+     ASSIGN (X (IDENT_INT (5)), CREATE (2));
+     ASSIGN (X (IDENT_INT (6)), CREATE (3));
+     ASSIGN (X (IDENT_INT (7)), CREATE (4));
+
+     ASSIGN (Y (5), C2);
+     ASSIGN (Y (6), C3);
+     ASSIGN (Y (7), C4);
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     BEGIN
+          IF NOT EQUAL (CREATE (2, 3, C4, X), AGGR (C4, C5)) THEN
+               FAILED ("CANNOT CREATE BASE TYPE VALUES OUTSIDE " &
+                       "OF THE SUBTYPE T");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED WHILE CHECKING BASE TYPE " &
+                       "VALUES OUTSIDE OF THE SUBTYPE T");
+     END;
+
+     BEGIN
+          IF NOT EQUAL (CREATE (2, 3, C4, Y), AGGR (C4, C5)) THEN
+               FAILED ("CANNOT CREATE BASE TYPE VALUES OUTSIDE " &
+                       "OF THE SUBTYPE S");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED WHILE CHECKING BASE TYPE " &
+                       "VALUES OUTSIDE OF THE SUBTYPE S");
+     END;
+
+     BEGIN
+          IF NOT EQUAL (X(IDENT_INT (6)..IDENT_INT (7)),
+                        AGGR (C3, C4))                     THEN
+               FAILED ("INCORRECT SLICE OF X (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED WHILE CHECKING SLICE OF X");
+     END;
+
+     BEGIN
+          IF NOT EQUAL (AGGR (C3, C4),
+                        Y(IDENT_INT (6)..IDENT_INT (7)))  THEN
+               FAILED ("INCORRECT SLICE OF Y (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED WHILE CHECKING SLICE OF Y");
+     END;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'FIRST /= 5 OR T'LAST /= 7 OR
+        S'FIRST /= 5 OR S'LAST /= 7 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          ASSIGN (X, CREATE (5, 7, C1, X));
+          ASSIGN (Y, CREATE (5, 7, C1, Y));
+          IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
+     END;
+
+     BEGIN
+          ASSIGN (X, AGGR (C1, C2));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (X, AGGR (C1, C2))");
+          IF EQUAL (X, AGGR (C1, C2)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- ASSIGN (X, AGGR (C1, C2))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (X, AGGR (C1, C2))");
+     END;
+
+     BEGIN
+          ASSIGN (X, AGGR (C1, C2, C3, C4));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (X, AGGR (C1, C2, C3, C4))");
+          IF EQUAL (X, AGGR (C1, C2, C3, C4)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "ASSIGN (X, AGGR (C1, C2, C3, C4))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (X, AGGR (C1, C2, C3, C4))");
+     END;
+
+     BEGIN
+          ASSIGN (Y, AGGR (C1, C2));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (Y, AGGR (C1, C2))");
+          IF EQUAL (Y, AGGR (C1, C2)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- ASSIGN (Y, AGGR (C1, C2))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (Y, AGGR (C1, C2))");
+     END;
+
+     BEGIN
+          ASSIGN (Y, AGGR (C1, C2, C3, C4));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (Y, AGGR (C1, C2, C3, C4))");
+          IF EQUAL (Y, AGGR (C1, C2, C3, C4)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "ASSIGN (Y, AGGR (C1, C2, C3, C4))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (Y, AGGR (C1, C2, C3, C4))");
+     END;
+
+     RESULT;
+END C34005R;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005s.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005s.ada
new file mode 100644
index 000000000..515816665
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005s.ada
@@ -0,0 +1,404 @@
+-- C34005S.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
+--     COMPONENT TYPE IS A LIMITED TYPE.  THIS TEST IS PART 1 OF 2
+--     TESTS WHICH COVER THE OBJECTIVE.  THE SECOND PART IS IN TEST
+--     C34005V.
+
+-- HISTORY:
+--     JRK 08/20/87  CREATED ORIGINAL TEST.
+--     BCB 04/12/90  SPLIT ORIGINAL TEST INTO C34005S.ADA AND
+--                   C34005V.ADA
+--     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005S IS
+
+     PACKAGE PKG_L IS
+
+          TYPE LP IS LIMITED PRIVATE;
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP;
+
+          FUNCTION VALUE (X : LP) RETURN INTEGER;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+
+          C1  : CONSTANT LP;
+          C2  : CONSTANT LP;
+          C3  : CONSTANT LP;
+          C4  : CONSTANT LP;
+          C5  : CONSTANT LP;
+          C6  : CONSTANT LP;
+          C7  : CONSTANT LP;
+          C8  : CONSTANT LP;
+          C9  : CONSTANT LP;
+          C10 : CONSTANT LP;
+          C11 : CONSTANT LP;
+          C12 : CONSTANT LP;
+          C13 : CONSTANT LP;
+          C14 : CONSTANT LP;
+
+     PRIVATE
+
+          TYPE LP IS NEW INTEGER;
+
+          C1  : CONSTANT LP :=  1;
+          C2  : CONSTANT LP :=  2;
+          C3  : CONSTANT LP :=  3;
+          C4  : CONSTANT LP :=  4;
+          C5  : CONSTANT LP :=  5;
+          C6  : CONSTANT LP :=  6;
+          C7  : CONSTANT LP :=  7;
+          C8  : CONSTANT LP :=  8;
+          C9  : CONSTANT LP :=  9;
+          C10 : CONSTANT LP := 10;
+          C11 : CONSTANT LP := 11;
+          C12 : CONSTANT LP := 12;
+          C13 : CONSTANT LP := 13;
+          C14 : CONSTANT LP := 14;
+
+     END PKG_L;
+
+     USE PKG_L;
+
+     SUBTYPE COMPONENT IS LP;
+
+     PACKAGE PKG_P IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 10;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
+                               COMPONENT;
+
+          FUNCTION CREATE ( F1, L1 : INDEX;
+                            F2, L2 : INDEX;
+                            C      : COMPONENT;
+                            DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+     END PKG_P;
+
+     USE PKG_P;
+
+     TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                           IDENT_INT (6) .. IDENT_INT (8));
+
+     TYPE ARRT IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF
+                        COMPONENT;
+
+     SUBTYPE ARR IS ARRT (8 .. 9, 2 .. 4);
+
+     X : T;
+     W : PARENT (4 .. 5, 6 .. 8);
+     C : COMPONENT;
+     B : BOOLEAN := FALSE;
+     U : ARR;
+     N : CONSTANT := 2;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     FUNCTION V RETURN T IS
+          RESULT : T;
+     BEGIN
+          FOR I IN RESULT'RANGE LOOP
+               FOR J IN RESULT'RANGE(2) LOOP
+                    ASSIGN (RESULT (I, J), C);
+               END LOOP;
+          END LOOP;
+          RETURN RESULT;
+     END V;
+
+     PACKAGE BODY PKG_L IS
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP IS
+          BEGIN
+               RETURN LP (IDENT_INT (X));
+          END CREATE;
+
+          FUNCTION VALUE (X : LP) RETURN INTEGER IS
+          BEGIN
+               RETURN INTEGER (X);
+          END VALUE;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG_L;
+
+     PACKAGE BODY PKG_P IS
+
+          FUNCTION CREATE
+             ( F1, L1 : INDEX;
+               F2, L2 : INDEX;
+               C      : COMPONENT;
+               DUMMY  : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F1 .. L1, F2 .. L2);
+               B : COMPONENT;
+          BEGIN
+               ASSIGN (B, C);
+               FOR I IN F1 .. L1 LOOP
+                    FOR J IN F2 .. L2 LOOP
+                         ASSIGN (A (I, J), B);
+                         ASSIGN (B, CREATE (VALUE (B) + 1));
+                    END LOOP;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               IF X'LENGTH /= Y'LENGTH OR
+                  X'LENGTH(2) /= Y'LENGTH(2) THEN
+                    RETURN FALSE;
+               ELSE FOR I IN X'RANGE LOOP
+                         FOR J IN X'RANGE(2) LOOP
+                              IF NOT EQUAL (X (I, J),
+                                            Y (I - X'FIRST + Y'FIRST,
+                                               J - X'FIRST(2) +
+                                                   Y'FIRST(2))) THEN
+                                   RETURN FALSE;
+                              END IF;
+                         END LOOP;
+                    END LOOP;
+               END IF;
+               RETURN TRUE;
+          END EQUAL;
+
+     END PKG_P;
+
+     FUNCTION EQUAL (X, Y : ARRT) RETURN BOOLEAN IS
+     BEGIN
+          IF X'LENGTH /= Y'LENGTH OR X'LENGTH(2) /= Y'LENGTH(2) THEN
+               RETURN FALSE;
+          ELSE FOR I IN X'RANGE LOOP
+                    FOR J IN X'RANGE(2) LOOP
+                         IF NOT EQUAL (X (I, J),
+                                       Y (I - X'FIRST + Y'FIRST,
+                                          J - X'FIRST(2) +
+                                              Y'FIRST(2))) THEN
+                              RETURN FALSE;
+                         END IF;
+                    END LOOP;
+               END LOOP;
+          END IF;
+          RETURN TRUE;
+     END EQUAL;
+
+BEGIN
+     TEST ("C34005S", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A LIMITED TYPE.    THIS TEST IS PART " &
+                      "1 OF 2 TESTS WHICH COVER THE OBJECTIVE.  THE " &
+                      "SECOND PART IS IN TEST C34005V");
+
+     ASSIGN (X (IDENT_INT (4), IDENT_INT (6)), CREATE (1));
+     ASSIGN (X (IDENT_INT (4), IDENT_INT (7)), CREATE (2));
+     ASSIGN (X (IDENT_INT (4), IDENT_INT (8)), CREATE (3));
+     ASSIGN (X (IDENT_INT (5), IDENT_INT (6)), CREATE (4));
+     ASSIGN (X (IDENT_INT (5), IDENT_INT (7)), CREATE (5));
+     ASSIGN (X (IDENT_INT (5), IDENT_INT (8)), CREATE (6));
+
+     ASSIGN (W (4, 6), CREATE (1));
+     ASSIGN (W (4, 7), CREATE (2));
+     ASSIGN (W (4, 8), CREATE (3));
+     ASSIGN (W (5, 6), CREATE (4));
+     ASSIGN (W (5, 7), CREATE (5));
+     ASSIGN (W (5, 8), CREATE (6));
+
+     ASSIGN (C, CREATE (2));
+
+     ASSIGN (U (8, 2), CREATE (1));
+     ASSIGN (U (8, 3), CREATE (2));
+     ASSIGN (U (8, 4), CREATE (3));
+     ASSIGN (U (9, 2), CREATE (4));
+     ASSIGN (U (9, 3), CREATE (5));
+     ASSIGN (U (9, 4), CREATE (6));
+
+     IF NOT EQUAL (X (IDENT_INT (4), IDENT_INT (6)), C1) OR
+        NOT EQUAL (CREATE (6, 9, 2, 3, C4, X) (9, 3), C11) THEN
+          FAILED ("INCORRECT INDEX (VALUE)");
+     END IF;
+
+     B := FALSE;
+     A (X'ADDRESS);
+     IF NOT B THEN
+          FAILED ("INCORRECT 'ADDRESS");
+     END IF;
+
+     IF T'FIRST /= 4 THEN
+          FAILED ("INCORRECT TYPE'FIRST");
+     END IF;
+
+     IF X'FIRST /= 4 THEN
+          FAILED ("INCORRECT OBJECT'FIRST");
+     END IF;
+
+     IF V'FIRST /= 4 THEN
+          FAILED ("INCORRECT VALUE'FIRST");
+     END IF;
+
+     IF T'FIRST (N) /= 6 THEN
+          FAILED ("INCORRECT TYPE'FIRST (N)");
+     END IF;
+
+     IF X'FIRST (N) /= 6 THEN
+          FAILED ("INCORRECT OBJECT'FIRST (N)");
+     END IF;
+
+     IF V'FIRST (N) /= 6 THEN
+          FAILED ("INCORRECT VALUE'FIRST (N)");
+     END IF;
+
+     IF T'LAST /= 5 THEN
+          FAILED ("INCORRECT TYPE'LAST");
+     END IF;
+
+     IF X'LAST /= 5 THEN
+          FAILED ("INCORRECT OBJECT'LAST");
+     END IF;
+
+     IF V'LAST /= 5 THEN
+          FAILED ("INCORRECT VALUE'LAST");
+     END IF;
+
+     IF T'LAST (N) /= 8 THEN
+          FAILED ("INCORRECT TYPE'LAST (N)");
+     END IF;
+
+     IF X'LAST (N) /= 8 THEN
+          FAILED ("INCORRECT OBJECT'LAST (N)");
+     END IF;
+
+     IF V'LAST (N) /= 8 THEN
+          FAILED ("INCORRECT VALUE'LAST (N)");
+     END IF;
+
+     IF T'LENGTH /= 2 THEN
+          FAILED ("INCORRECT TYPE'LENGTH");
+     END IF;
+
+     IF X'LENGTH /= 2 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH");
+     END IF;
+
+     IF V'LENGTH /= 2 THEN
+          FAILED ("INCORRECT VALUE'LENGTH");
+     END IF;
+
+     IF T'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT TYPE'LENGTH (N)");
+     END IF;
+
+     IF X'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH (N)");
+     END IF;
+
+     IF V'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH (N)");
+     END IF;
+
+     DECLARE
+          Y : PARENT (T'RANGE, 1 .. 3);
+     BEGIN
+          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+               FAILED ("INCORRECT TYPE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (X'RANGE, 1 .. 3);
+     BEGIN
+          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+               FAILED ("INCORRECT OBJECT'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (V'RANGE, 1 .. 3);
+     BEGIN
+          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+               FAILED ("INCORRECT VALUE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (1 .. 2, T'RANGE (N));
+     BEGIN
+          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+               FAILED ("INCORRECT TYPE'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (1 .. 2, X'RANGE (N));
+     BEGIN
+          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+               FAILED ("INCORRECT OBJECT'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : PARENT (1 .. 2, V'RANGE (N));
+     BEGIN
+          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+               FAILED ("INCORRECT VALUE'RANGE (N)");
+          END IF;
+     END;
+
+     IF T'SIZE < T'LENGTH * T'LENGTH (N) * COMPONENT'SIZE THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     IF X'SIZE < X'LENGTH * X'LENGTH (N) * COMPONENT'SIZE THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     RESULT;
+END C34005S;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005u.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005u.ada
new file mode 100644
index 000000000..ed77f3bfa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005u.ada
@@ -0,0 +1,408 @@
+-- C34005U.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:
+--     FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT TYPE IS
+--     A LIMITED TYPE:
+
+--        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.
+
+-- HISTORY:
+--     JRK 08/21/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005U IS
+
+     PACKAGE PKG_L IS
+
+          TYPE LP IS LIMITED PRIVATE;
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP;
+
+          FUNCTION VALUE (X : LP) RETURN INTEGER;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+
+          C1  : CONSTANT LP;
+          C2  : CONSTANT LP;
+          C3  : CONSTANT LP;
+          C4  : CONSTANT LP;
+          C5  : CONSTANT LP;
+          C6  : CONSTANT LP;
+          C7  : CONSTANT LP;
+          C8  : CONSTANT LP;
+
+     PRIVATE
+
+          TYPE LP IS NEW INTEGER;
+
+          C1  : CONSTANT LP :=  1;
+          C2  : CONSTANT LP :=  2;
+          C3  : CONSTANT LP :=  3;
+          C4  : CONSTANT LP :=  4;
+          C5  : CONSTANT LP :=  5;
+          C6  : CONSTANT LP :=  6;
+          C7  : CONSTANT LP :=  7;
+          C8  : CONSTANT LP :=  8;
+
+     END PKG_L;
+
+     USE PKG_L;
+
+     SUBTYPE COMPONENT IS LP;
+
+     PACKAGE PKG_P IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 10;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
+                               COMPONENT;
+
+          FUNCTION CREATE ( F1, L1 : INDEX;
+                            F2, L2 : INDEX;
+                            C      : COMPONENT;
+                            DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+          FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
+                        RETURN PARENT;
+
+     END PKG_P;
+
+     USE PKG_P;
+
+     TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                           IDENT_INT (6) .. IDENT_INT (8));
+
+     SUBTYPE SUBPARENT IS PARENT (4 .. 5, 6 .. 8);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T;
+     Y : S;
+
+     PACKAGE BODY PKG_L IS
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP IS
+          BEGIN
+               RETURN LP (IDENT_INT (X));
+          END CREATE;
+
+          FUNCTION VALUE (X : LP) RETURN INTEGER IS
+          BEGIN
+               RETURN INTEGER (X);
+          END VALUE;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG_L;
+
+     PACKAGE BODY PKG_P IS
+
+          FUNCTION CREATE
+             ( F1, L1 : INDEX;
+               F2, L2 : INDEX;
+               C      : COMPONENT;
+               DUMMY  : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F1 .. L1, F2 .. L2);
+               B : COMPONENT;
+          BEGIN
+               ASSIGN (B, C);
+               FOR I IN F1 .. L1 LOOP
+                    FOR J IN F2 .. L2 LOOP
+                         ASSIGN (A (I, J), B);
+                         ASSIGN (B, CREATE (VALUE (B) + 1));
+                    END LOOP;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               IF X'LENGTH /= Y'LENGTH OR
+                  X'LENGTH(2) /= Y'LENGTH(2) THEN
+                    RETURN FALSE;
+               ELSE FOR I IN X'RANGE LOOP
+                         FOR J IN X'RANGE(2) LOOP
+                              IF NOT EQUAL (X (I, J),
+                                            Y (I - X'FIRST + Y'FIRST,
+                                               J - X'FIRST(2) +
+                                                   Y'FIRST(2))) THEN
+                                   RETURN FALSE;
+                              END IF;
+                         END LOOP;
+                    END LOOP;
+               END IF;
+               RETURN TRUE;
+          END EQUAL;
+
+          FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
+                        RETURN PARENT IS
+               X : PARENT (INDEX'FIRST .. INDEX'FIRST + 3,
+                           INDEX'FIRST .. INDEX'FIRST + 1);
+          BEGIN
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), C);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), D);
+               ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST    ), E);
+               ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 1), F);
+               ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST    ), G);
+               ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST + 1), H);
+               RETURN X;
+          END AGGR;
+
+     END PKG_P;
+
+     PROCEDURE ASSIGN (X : IN OUT T; Y : T) IS
+     BEGIN
+          FOR I IN X'RANGE LOOP
+               FOR J IN X'RANGE(2) LOOP
+                    ASSIGN (X (I, J), Y (I, J));
+               END LOOP;
+          END LOOP;
+     END ASSIGN;
+
+     PROCEDURE ASSIGN (X : IN OUT S; Y : S) IS
+     BEGIN
+          FOR I IN X'RANGE LOOP
+               FOR J IN X'RANGE(2) LOOP
+                    ASSIGN (X (I, J), Y (I, J));
+               END LOOP;
+          END LOOP;
+     END ASSIGN;
+
+BEGIN
+     TEST ("C34005U", "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 " &
+                      "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A LIMITED TYPE");
+
+     FOR I IN X'RANGE LOOP
+          FOR J IN X'RANGE(2) LOOP
+               ASSIGN (X (I, J), C2);
+               ASSIGN (Y (I, J), C2);
+          END LOOP;
+     END LOOP;
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+     BEGIN
+          IF NOT EQUAL (CREATE (6, 9, 2, 3, C1, X),
+                        AGGR (C1, C2, C3, C4, C5, C6, C7, C8)) OR
+             NOT EQUAL (CREATE (6, 9, 2, 3, C1, Y),
+                        AGGR (C1, C2, C3, C4, C5, C6, C7, C8)) THEN
+               FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                       "SUBTYPE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR WHEN TRYING TO CREATE BASE " &
+                       "TYPE VALUES OUTSIDE THE SUBTYPE");
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION WHEN TRYING TO CREATE BASE TYPE " &
+                       "VALUES OUTSIDE THE SUBTYPE");
+     END;
+
+     IF AGGR (C1, C2, C3, C4, C5, C6, C7, C8) IN T OR
+        AGGR (C1, C2, C3, C4, C5, C6, C7, C8) IN S THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF T'FIRST /= 4 OR T'LAST /= 5 OR
+        S'FIRST /= 4 OR S'LAST /= 5 OR
+        T'FIRST (2) /= 6 OR T'LAST (2) /= 8 OR
+        S'FIRST (2) /= 6 OR S'LAST (2) /= 8 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          ASSIGN (X, CREATE (4, 5, 6, 8, C1, X));
+          ASSIGN (Y, CREATE (4, 5, 6, 8, C1, Y));
+          IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
+     END;
+
+     BEGIN
+          ASSIGN (X, CREATE (4, 4, 6, 8, C1, X));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (X, CREATE (4, 4, 6, 8, C1, X))");
+          IF EQUAL (X, CREATE (4, 4, 6, 8, C1, X)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "ASSIGN (X, CREATE (4, 4, 6, 8, C1, X))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (X, CREATE (4, 4, 6, 8, C1, X))");
+     END;
+
+     BEGIN
+          ASSIGN (X, CREATE (4, 6, 6, 8, C1, X));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (X, CREATE (4, 6, 6, 8, C1, X))");
+          IF EQUAL (X, CREATE (4, 6, 6, 8, C1, X)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "ASSIGN (X, CREATE (4, 6, 6, 8, C1, X))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (X, CREATE (4, 6, 6, 8, C1, X))");
+     END;
+
+     BEGIN
+          ASSIGN (X, CREATE (4, 5, 6, 7, C1, X));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (X, CREATE (4, 5, 6, 7, C1, X))");
+          IF EQUAL (X, CREATE (4, 5, 6, 7, C1, X)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "ASSIGN (X, CREATE (4, 5, 6, 7, C1, X))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (X, CREATE (4, 5, 6, 7, C1, X))");
+     END;
+
+     BEGIN
+          ASSIGN (X, CREATE (4, 5, 6, 9, C1, X));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (X, CREATE (4, 5, 6, 9, C1, X))");
+          IF EQUAL (X, CREATE (4, 5, 6, 9, C1, X)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "ASSIGN (X, CREATE (4, 5, 6, 9, C1, X))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (X, CREATE (4, 5, 6, 9, C1, X))");
+     END;
+
+     BEGIN
+          ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y))");
+          IF EQUAL (Y, CREATE (4, 4, 6, 8, C1, Y)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (Y, CREATE (4, 4, 6, 8, C1, Y))");
+     END;
+
+     BEGIN
+          ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y))");
+          IF EQUAL (Y, CREATE (4, 6, 6, 8, C1, Y)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (Y, CREATE (4, 6, 6, 8, C1, Y))");
+     END;
+
+     BEGIN
+          ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y))");
+          IF EQUAL (Y, CREATE (4, 5, 6, 7, C1, Y)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (Y, CREATE (4, 5, 6, 7, C1, Y))");
+     END;
+
+     BEGIN
+          ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y))");
+          IF EQUAL (Y, CREATE (4, 5, 6, 9, C1, Y)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (Y, CREATE (4, 5, 6, 9, C1, Y))");
+     END;
+
+     RESULT;
+END C34005U;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005v.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005v.ada
new file mode 100644
index 000000000..cb59125b4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34005v.ada
@@ -0,0 +1,336 @@
+-- C34005V.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED MULTI-DIMENSIONAL ARRAY TYPES WHOSE
+--     COMPONENT TYPE IS A LIMITED TYPE.  THIS TEST IS PART 2 OF 2
+--     TESTS WHICH COVER THE OBJECTIVE.  THE FIRST PART IS IN TEST
+--     C34005S.
+
+-- HISTORY:
+--     BCB 04/12/90  CREATED ORIGINAL TEST FROM SPLIT OF C34005S.ADA.
+--     RLB 10/03/02  REMOVED ILLEGAL (BY AI-246) TYPE CONVERSIONS AND
+--                   SUPPORTING CODE.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34005V IS
+
+     PACKAGE PKG_L IS
+
+          TYPE LP IS LIMITED PRIVATE;
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP;
+
+          FUNCTION VALUE (X : LP) RETURN INTEGER;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+
+          C1  : CONSTANT LP;
+          C2  : CONSTANT LP;
+          C3  : CONSTANT LP;
+          C4  : CONSTANT LP;
+          C5  : CONSTANT LP;
+          C6  : CONSTANT LP;
+          C7  : CONSTANT LP;
+          C8  : CONSTANT LP;
+          C9  : CONSTANT LP;
+          C10 : CONSTANT LP;
+          C11 : CONSTANT LP;
+          C12 : CONSTANT LP;
+          C13 : CONSTANT LP;
+          C14 : CONSTANT LP;
+
+     PRIVATE
+
+          TYPE LP IS NEW INTEGER;
+
+          C1  : CONSTANT LP :=  1;
+          C2  : CONSTANT LP :=  2;
+          C3  : CONSTANT LP :=  3;
+          C4  : CONSTANT LP :=  4;
+          C5  : CONSTANT LP :=  5;
+          C6  : CONSTANT LP :=  6;
+          C7  : CONSTANT LP :=  7;
+          C8  : CONSTANT LP :=  8;
+          C9  : CONSTANT LP :=  9;
+          C10 : CONSTANT LP := 10;
+          C11 : CONSTANT LP := 11;
+          C12 : CONSTANT LP := 12;
+          C13 : CONSTANT LP := 13;
+          C14 : CONSTANT LP := 14;
+
+     END PKG_L;
+
+     USE PKG_L;
+
+     SUBTYPE COMPONENT IS LP;
+
+     PACKAGE PKG_P IS
+
+          FIRST : CONSTANT := 0;
+          LAST  : CONSTANT := 10;
+
+          SUBTYPE INDEX IS INTEGER RANGE FIRST .. LAST;
+
+          TYPE PARENT IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF
+                               COMPONENT;
+
+          FUNCTION CREATE ( F1, L1 : INDEX;
+                            F2, L2 : INDEX;
+                            C      : COMPONENT;
+                            DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+          FUNCTION AGGR (A, B, C, D : COMPONENT) RETURN PARENT;
+
+          FUNCTION AGGR (A, B, C, D, E, F : COMPONENT) RETURN PARENT;
+
+          FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
+                        RETURN PARENT;
+
+          FUNCTION AGGR (A, B, C, D, E, F, G, H, I : COMPONENT)
+                        RETURN PARENT;
+
+     END PKG_P;
+
+     USE PKG_P;
+
+     TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                           IDENT_INT (6) .. IDENT_INT (8));
+
+     X : T;
+     W : PARENT (4 .. 5, 6 .. 8);
+     C : COMPONENT;
+     B : BOOLEAN := FALSE;
+     N : CONSTANT := 2;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     FUNCTION V RETURN T IS
+          RESULT : T;
+     BEGIN
+          FOR I IN RESULT'RANGE LOOP
+               FOR J IN RESULT'RANGE(2) LOOP
+                    ASSIGN (RESULT (I, J), C);
+               END LOOP;
+          END LOOP;
+          RETURN RESULT;
+     END V;
+
+     PACKAGE BODY PKG_L IS
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP IS
+          BEGIN
+               RETURN LP (IDENT_INT (X));
+          END CREATE;
+
+          FUNCTION VALUE (X : LP) RETURN INTEGER IS
+          BEGIN
+               RETURN INTEGER (X);
+          END VALUE;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG_L;
+
+     PACKAGE BODY PKG_P IS
+
+          FUNCTION CREATE
+             ( F1, L1 : INDEX;
+               F2, L2 : INDEX;
+               C      : COMPONENT;
+               DUMMY  : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (F1 .. L1, F2 .. L2);
+               B : COMPONENT;
+          BEGIN
+               ASSIGN (B, C);
+               FOR I IN F1 .. L1 LOOP
+                    FOR J IN F2 .. L2 LOOP
+                         ASSIGN (A (I, J), B);
+                         ASSIGN (B, CREATE (VALUE (B) + 1));
+                    END LOOP;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               IF X'LENGTH /= Y'LENGTH OR
+                  X'LENGTH(2) /= Y'LENGTH(2) THEN
+                    RETURN FALSE;
+               ELSE FOR I IN X'RANGE LOOP
+                         FOR J IN X'RANGE(2) LOOP
+                              IF NOT EQUAL (X (I, J),
+                                            Y (I - X'FIRST + Y'FIRST,
+                                               J - X'FIRST(2) +
+                                                   Y'FIRST(2))) THEN
+                                   RETURN FALSE;
+                              END IF;
+                         END LOOP;
+                    END LOOP;
+               END IF;
+               RETURN TRUE;
+          END EQUAL;
+
+          FUNCTION AGGR (A, B, C, D : COMPONENT) RETURN PARENT IS
+               X : PARENT (INDEX'FIRST .. INDEX'FIRST + 1,
+                           INDEX'FIRST .. INDEX'FIRST + 1);
+          BEGIN
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), C);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), D);
+               RETURN X;
+          END AGGR;
+
+          FUNCTION AGGR (A, B, C, D, E, F : COMPONENT) RETURN PARENT IS
+               X : PARENT (INDEX'FIRST .. INDEX'FIRST + 1,
+                           INDEX'FIRST .. INDEX'FIRST + 2);
+          BEGIN
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 2), C);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), D);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), E);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 2), F);
+               RETURN X;
+          END AGGR;
+
+          FUNCTION AGGR (A, B, C, D, E, F, G, H : COMPONENT)
+                        RETURN PARENT IS
+               X : PARENT (INDEX'FIRST .. INDEX'FIRST + 3,
+                           INDEX'FIRST .. INDEX'FIRST + 1);
+          BEGIN
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), C);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), D);
+               ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST    ), E);
+               ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 1), F);
+               ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST    ), G);
+               ASSIGN (X (INDEX'FIRST + 3, INDEX'FIRST + 1), H);
+               RETURN X;
+          END AGGR;
+
+          FUNCTION AGGR (A, B, C, D, E, F, G, H, I : COMPONENT)
+                        RETURN PARENT IS
+               X : PARENT (INDEX'FIRST .. INDEX'FIRST + 2,
+                           INDEX'FIRST .. INDEX'FIRST + 2);
+          BEGIN
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST    ), A);
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 1), B);
+               ASSIGN (X (INDEX'FIRST    , INDEX'FIRST + 2), C);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST    ), D);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 1), E);
+               ASSIGN (X (INDEX'FIRST + 1, INDEX'FIRST + 2), F);
+               ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST    ), G);
+               ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 1), H);
+               ASSIGN (X (INDEX'FIRST + 2, INDEX'FIRST + 2), I);
+               RETURN X;
+          END AGGR;
+
+     END PKG_P;
+
+BEGIN
+     TEST ("C34005V", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "MULTI-DIMENSIONAL ARRAY TYPES WHOSE COMPONENT " &
+                      "TYPE IS A LIMITED TYPE.  THIS TEST IS PART 2 " &
+                      "OF 2 TESTS WHICH COVER THE OBJECTIVE.  THE " &
+                      "FIRST PART IS IN TEST C34005S");
+
+     ASSIGN (X (IDENT_INT (4), IDENT_INT (6)), CREATE (1));
+     ASSIGN (X (IDENT_INT (4), IDENT_INT (7)), CREATE (2));
+     ASSIGN (X (IDENT_INT (4), IDENT_INT (8)), CREATE (3));
+     ASSIGN (X (IDENT_INT (5), IDENT_INT (6)), CREATE (4));
+     ASSIGN (X (IDENT_INT (5), IDENT_INT (7)), CREATE (5));
+     ASSIGN (X (IDENT_INT (5), IDENT_INT (8)), CREATE (6));
+
+     ASSIGN (W (4, 6), CREATE (1));
+     ASSIGN (W (4, 7), CREATE (2));
+     ASSIGN (W (4, 8), CREATE (3));
+     ASSIGN (W (5, 6), CREATE (4));
+     ASSIGN (W (5, 7), CREATE (5));
+     ASSIGN (W (5, 8), CREATE (6));
+
+     ASSIGN (C, CREATE (2));
+
+     IF NOT EQUAL (T'(X), AGGR (C1, C2, C3, C4, C5, C6)) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF NOT EQUAL (T (X), AGGR (C1, C2, C3, C4, C5, C6)) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF NOT EQUAL (T (W), AGGR (C1, C2, C3, C4, C5, C6)) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     BEGIN
+          IF NOT EQUAL (PARENT (X), AGGR (C1, C2, C3, C4, C5, C6)) OR
+             NOT EQUAL (PARENT (CREATE (6, 9, 2, 3, C4, X)),
+                        AGGR (C4, C5, C6, C7, C8, C9, C10, C11)) THEN
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR WHEN PREPARING TO CONVERT " &
+                       "TO PARENT");
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION WHEN PREPARING TO CONVERT " &
+                       "TO PARENT");
+     END;
+
+     IF NOT (X IN T) OR AGGR (C1, C2, C3, C4) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR
+        NOT (AGGR (C1, C2, C3, C4, C5, C6, C7, C8, C9) NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     RESULT;
+END C34005V;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006a.ada
new file mode 100644
index 000000000..c5d4675e2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006a.ada
@@ -0,0 +1,151 @@
+-- C34006A.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED RECORD TYPES WITHOUT DISCRIMINANTS
+--     AND WITH NON-LIMITED COMPONENT TYPES.
+
+-- HISTORY:
+--     JRK 09/22/86  CREATED ORIGINAL TEST.
+--     BCB 09/26/88  REMOVED COMPARISONS INVOLVING SIZE.
+--     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34006A IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     TYPE PARENT IS
+          RECORD
+               C : COMPONENT;
+               B : BOOLEAN := TRUE;
+          END RECORD;
+
+     TYPE T IS NEW PARENT;
+
+     X : T         := (2, FALSE);
+     K : INTEGER   := X'SIZE;
+     W : PARENT    := (2, FALSE);
+     C : COMPONENT := 1;
+     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 (X.C, X.C) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN (-1, FALSE);
+     END IDENT;
+
+BEGIN
+     TEST ("C34006A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "RECORD TYPES WITHOUT DISCRIMINANTS AND WITH " &
+                      "NON-LIMITED COMPONENT TYPES");
+
+     X := IDENT ((1, TRUE));
+     IF X /= (1, TRUE) THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= (1, TRUE) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= (1, TRUE) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := (1, TRUE);
+     END IF;
+     IF T (W) /= (1, TRUE) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF PARENT (X) /= (1, TRUE) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF IDENT ((1, TRUE)) /= (1, TRUE) THEN
+          FAILED ("INCORRECT AGGREGATE");
+     END IF;
+
+     IF X.C /= 1 OR X.B /= TRUE THEN
+          FAILED ("INCORRECT SELECTION (VALUE)");
+     END IF;
+
+     X.C := IDENT_INT (3);
+     X.B := IDENT_BOOL (FALSE);
+     IF X /= (3, FALSE) THEN
+          FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+     END IF;
+
+     X := IDENT ((1, TRUE));
+     IF X = IDENT ((1, FALSE)) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= IDENT ((1, TRUE)) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X 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 X.C'FIRST_BIT < 0 THEN
+          FAILED ("INCORRECT 'FIRST_BIT");
+     END IF;
+
+     IF X.C'LAST_BIT < 0 OR
+        X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
+          FAILED ("INCORRECT 'LAST_BIT");
+     END IF;
+
+     IF X.C'POSITION < 0 THEN
+          FAILED ("INCORRECT 'POSITION");
+     END IF;
+
+
+     RESULT;
+END C34006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006d.ada
new file mode 100644
index 000000000..614a830be
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006d.ada
@@ -0,0 +1,238 @@
+-- C34006D.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH
+--     NON-LIMITED COMPONENT TYPES.
+
+-- HISTORY:
+--     JRK 09/22/86  CREATED ORIGINAL TEST.
+--     BCB 11/13/87  CHANGED TEST SO AN OBJECT'S SIZE MAY BE LESS THAN
+--                   THAT OF ITS TYPE.
+--     RJW 08/21/89  MODIFIED CHECKS FOR SIZE.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34006D IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     PACKAGE PKG IS
+
+          MAX_LEN : CONSTANT := 10;
+
+          SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+               RECORD
+                    I : INTEGER;
+                    CASE B IS
+                         WHEN TRUE =>
+                              S : STRING (1 .. L);
+                              C : COMPONENT;
+                         WHEN FALSE =>
+                              F : FLOAT := 5.0;
+                    END CASE;
+               END RECORD;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            C : COMPONENT;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     X : T         := (TRUE, 3, 2, "AAA", 2);
+     W : PARENT    := (TRUE, 3, 2, "AAA", 2);
+     C : COMPONENT := 1;
+     B : BOOLEAN   := FALSE;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               CASE B IS
+                    WHEN TRUE =>
+                         RETURN (TRUE, L, I, S, C);
+                    WHEN FALSE =>
+                         RETURN (FALSE, L, I, F);
+               END CASE;
+          END CREATE;
+
+     END PKG;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF EQUAL (X.I, X.I) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN (TRUE, 3, -1, "---", -1);
+     END IDENT;
+
+BEGIN
+     TEST ("C34006D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "RECORD TYPES WITH DISCRIMINANTS AND WITH " &
+                      "NON-LIMITED COMPONENT TYPES");
+
+     X := IDENT ((TRUE, 3, 1, "ABC", 4));
+     IF X /= (TRUE, 3, 1, "ABC", 4) THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= (TRUE, 3, 1, "ABC", 4) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= (TRUE, 3, 1, "ABC", 4) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := (TRUE, 3, 1, "ABC", 4);
+     END IF;
+     IF T (W) /= (TRUE, 3, 1, "ABC", 4) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     BEGIN
+          IF PARENT (X) /= (TRUE, 3, 1, "ABC", 4) OR
+             PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) /=
+             (FALSE, 2, 3, 6.0) THEN
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+     END;
+
+     IF IDENT ((TRUE, 3, 1, "ABC", 4)) /= (TRUE, 3, 1, "ABC", 4) OR
+        X = (FALSE, 3, 1, 4.0) THEN
+          FAILED ("INCORRECT AGGREGATE");
+     END IF;
+
+     BEGIN
+          IF X.B /= TRUE OR X.L /= 3 OR
+             CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
+             CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
+               FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+     END;
+
+     BEGIN
+          IF X.I /= 1 OR X.S /= "ABC" OR X.C /= 4 OR
+             CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . I /= 3 OR
+             CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . F /= 6.0 THEN
+               FAILED ("INCORRECT SELECTION (VALUE)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 3");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 3");
+     END;
+
+     X.I := IDENT_INT (7);
+     X.S := IDENT_STR ("XYZ");
+     X.C := IDENT_INT (9);
+     IF X /= (TRUE, 3, 7, "XYZ", 9) THEN
+          FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+     END IF;
+
+     X := IDENT ((TRUE, 3, 1, "ABC", 4));
+     IF X = IDENT ((TRUE, 3, 1, "ABC", 5)) OR
+        X = (FALSE, 2, 3, 6.0) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= IDENT ((TRUE, 3, 1, "ABC", 4)) OR
+        NOT (X /= (FALSE, 2, 3, 6.0)) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) OR (FALSE, 2, 3, 6.0) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT ((FALSE, 2, 3, 6.0) 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 NOT X'CONSTRAINED THEN
+          FAILED ("INCORRECT 'CONSTRAINED");
+     END IF;
+
+     IF X.C'FIRST_BIT < 0 THEN
+          FAILED ("INCORRECT 'FIRST_BIT");
+     END IF;
+
+     IF X.C'LAST_BIT < 0 OR
+        X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
+          FAILED ("INCORRECT 'LAST_BIT");
+     END IF;
+
+     IF X.C'POSITION < 0 THEN
+          FAILED ("INCORRECT 'POSITION");
+     END IF;
+
+     RESULT;
+END C34006D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006f.ada
new file mode 100644
index 000000000..3ee3745ac
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006f.ada
@@ -0,0 +1,228 @@
+-- C34006F.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:
+--     FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH NON-LIMITED
+--     COMPONENT 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.
+
+-- HISTORY:
+--     JRK 9/22/86  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34006F IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     PACKAGE PKG IS
+
+          MAX_LEN : CONSTANT := 10;
+
+          SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+               RECORD
+                    I : INTEGER;
+                    CASE B IS
+                         WHEN TRUE =>
+                              S : STRING (1 .. L);
+                              C : COMPONENT;
+                         WHEN FALSE =>
+                              F : FLOAT := 5.0;
+                    END CASE;
+               END RECORD;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            C : COMPONENT;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T := (TRUE, 3, 2, "AAA", 2);
+     Y : S := (TRUE, 3, 2, "AAA", 2);
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               CASE B IS
+                    WHEN TRUE =>
+                         RETURN (TRUE, L, I, S, C);
+                    WHEN FALSE =>
+                         RETURN (FALSE, L, I, F);
+               END CASE;
+          END CREATE;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34006F", "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 " &
+                      "RECORD TYPES WITH DISCRIMINANTS AND WITH " &
+                      "NON-LIMITED COMPONENT TYPES");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     BEGIN
+          IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) /=
+             (FALSE, 2, 3, 6.0) OR
+             CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) /=
+             (FALSE, 2, 3, 6.0) THEN
+               FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE " &
+                       "SUBTYPE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 1");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 1");
+     END;
+
+     BEGIN
+          IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
+             CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
+               FAILED ("INCORRECT ""IN""");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CALL TO CREATE RAISED CONSTRAINT_ERROR - 2");
+          WHEN OTHERS =>
+               FAILED ("CALL TO CREATE RAISED EXCEPTION - 2");
+     END;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF X.B /= TRUE OR X.L /= 3 OR
+        Y.B /= TRUE OR Y.L /= 3 THEN
+          FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+     END IF;
+
+     IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
+          FAILED ("INCORRECT 'CONSTRAINED");
+     END IF;
+
+     BEGIN
+          X := (TRUE, 3, 1, "ABC", 4);
+          Y := (TRUE, 3, 1, "ABC", 4);
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := (FALSE, 3, 2, 6.0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := (FALSE, 3, 2, 6.0)");
+          IF X = (FALSE, 3, 2, 6.0) THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := (FALSE, 3, 2, 6.0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := (FALSE, 3, 2, 6.0)");
+     END;
+
+     BEGIN
+          X := (TRUE, 4, 2, "ZZZZ", 6);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := (TRUE, 4, 2, ""ZZZZ"", 6)");
+          IF X = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := (TRUE, 4, 2, ""ZZZZ"", 6)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := (TRUE, 4, 2, ""ZZZZ"", 6)");
+     END;
+
+     BEGIN
+          Y := (FALSE, 3, 2, 6.0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := (FALSE, 3, 2, 6.0)");
+          IF Y = (FALSE, 3, 2, 6.0) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := (FALSE, 3, 2, 6.0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := (FALSE, 3, 2, 6.0)");
+     END;
+
+     BEGIN
+          Y := (TRUE, 4, 2, "ZZZZ", 6);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := (TRUE, 4, 2, ""ZZZZ"", 6)");
+          IF Y = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := (TRUE, 4, 2, ""ZZZZ"", 6)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := (TRUE, 4, 2, ""ZZZZ"", 6)");
+     END;
+
+     RESULT;
+END C34006F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006g.ada
new file mode 100644
index 000000000..ebb6c51ed
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006g.ada
@@ -0,0 +1,199 @@
+-- C34006G.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED RECORD TYPES WITHOUT DISCRIMINANTS AND
+--     WITH A LIMITED COMPONENT TYPE.
+
+-- HISTORY:
+--     JRK 08/24/87  CREATED ORIGINAL TEST.
+--     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34006G IS
+
+     PACKAGE PKG_L IS
+
+          TYPE LP IS LIMITED PRIVATE;
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+
+          C1 : CONSTANT LP;
+
+     PRIVATE
+
+          TYPE LP IS NEW INTEGER;
+
+          C1 : CONSTANT LP := 1;
+
+     END PKG_L;
+
+     USE PKG_L;
+
+     SUBTYPE COMPONENT IS LP;
+
+     PACKAGE PKG_P IS
+
+          TYPE PARENT IS
+               RECORD
+                    C : COMPONENT;
+                    B : BOOLEAN := TRUE;
+               END RECORD;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+          FUNCTION AGGR (C : COMPONENT; B : BOOLEAN) RETURN PARENT;
+
+     END PKG_P;
+
+     USE PKG_P;
+
+     TYPE T IS NEW PARENT;
+
+     X : T;
+     W : PARENT;
+     B : BOOLEAN := FALSE;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     PACKAGE BODY PKG_L IS
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP IS
+          BEGIN
+               RETURN LP (IDENT_INT (X));
+          END CREATE;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG_L;
+
+     PACKAGE BODY PKG_P IS
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               RETURN EQUAL (X.C, Y.C) AND X.B = Y.B;
+          END EQUAL;
+
+          FUNCTION AGGR (C : COMPONENT; B : BOOLEAN) RETURN PARENT IS
+               RESULT : PARENT;
+          BEGIN
+               ASSIGN (RESULT.C, C);
+               RESULT.B := B;
+               RETURN RESULT;
+          END AGGR;
+
+     END PKG_P;
+
+BEGIN
+     TEST ("C34006G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "RECORD TYPES WITHOUT DISCRIMINANTS AND WITH A " &
+                      "LIMITED COMPONENT TYPE");
+
+     ASSIGN (X.C, CREATE (1));
+     X.B := IDENT_BOOL (TRUE);
+
+     ASSIGN (W.C, CREATE (1));
+     W.B := IDENT_BOOL (TRUE);
+
+     IF NOT EQUAL (T'(X), AGGR (C1, TRUE)) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF NOT EQUAL (T (X), AGGR (C1, TRUE)) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF NOT EQUAL (T (W), AGGR (C1, TRUE)) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF NOT EQUAL (PARENT (X), AGGR (C1, TRUE)) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF NOT EQUAL (X.C, C1) OR X.B /= TRUE THEN
+          FAILED ("INCORRECT SELECTION (VALUE)");
+     END IF;
+
+     X.B := IDENT_BOOL (FALSE);
+     IF NOT EQUAL (X, AGGR (C1, FALSE)) THEN
+          FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+     END IF;
+
+     X.B := IDENT_BOOL (TRUE);
+     IF NOT (X IN T) THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X 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 X.C'FIRST_BIT < 0 THEN
+          FAILED ("INCORRECT 'FIRST_BIT");
+     END IF;
+
+     IF X.C'LAST_BIT < 0 OR
+        X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
+          FAILED ("INCORRECT 'LAST_BIT");
+     END IF;
+
+     IF X.C'POSITION < 0 THEN
+          FAILED ("INCORRECT 'POSITION");
+     END IF;
+
+     IF X'SIZE   < T'SIZE OR
+        X.C'SIZE < COMPONENT'SIZE OR
+        X.B'SIZE < BOOLEAN'SIZE THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     RESULT;
+END C34006G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006j.ada
new file mode 100644
index 000000000..597bf63c5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006j.ada
@@ -0,0 +1,311 @@
+-- C34006J.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH
+--     A LIMITED COMPONENT TYPE.
+
+-- HISTORY:
+--     JRK 08/25/87  CREATED ORIGINAL TEST.
+--     VCL 06/28/88  MODIFIED THE STATEMENTS INVOLVING THE 'SIZE
+--                   ATTRIBUTE TO REMOVE ANY ASSUMPTIONS ABOUT THE
+--                   SIZES.
+--     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34006J IS
+
+     PACKAGE PKG_L IS
+
+          TYPE LP IS LIMITED PRIVATE;
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+
+          C4 : CONSTANT LP;
+          C5 : CONSTANT LP;
+
+     PRIVATE
+
+          TYPE LP IS NEW INTEGER;
+
+          C4 : CONSTANT LP := 4;
+          C5 : CONSTANT LP := 5;
+
+     END PKG_L;
+
+     USE PKG_L;
+
+     SUBTYPE COMPONENT IS LP;
+
+     PACKAGE PKG_P IS
+
+          MAX_LEN : CONSTANT := 10;
+
+          SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+               RECORD
+                    I : INTEGER := 2;
+                    CASE B IS
+                         WHEN TRUE =>
+                              S : STRING (1 .. L) := (1 .. L => 'A');
+                              C : COMPONENT;
+                         WHEN FALSE =>
+                              F : FLOAT := 5.0;
+                    END CASE;
+               END RECORD;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            C : COMPONENT;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+          FUNCTION AGGR ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          S : STRING;
+                          C : COMPONENT
+                        ) RETURN PARENT;
+
+          FUNCTION AGGR ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          F : FLOAT
+                        ) RETURN PARENT;
+
+     END PKG_P;
+
+     USE PKG_P;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     X : T;
+     W : PARENT;
+     B : BOOLEAN := FALSE;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     PACKAGE BODY PKG_L IS
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP IS
+          BEGIN
+               RETURN LP (IDENT_INT (X));
+          END CREATE;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG_L;
+
+     PACKAGE BODY PKG_P IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (B, L);
+          BEGIN
+               A.I := I;
+               CASE B IS
+                    WHEN TRUE =>
+                         A.S := S;
+                         ASSIGN (A.C, C);
+                    WHEN FALSE =>
+                         A.F := F;
+               END CASE;
+               RETURN A;
+          END CREATE;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               IF X.B /= Y.B OR X.L /= Y.L OR X.I /= Y.I THEN
+                    RETURN FALSE;
+               END IF;
+               CASE X.B IS
+                    WHEN TRUE =>
+                         RETURN X.S = Y.S AND EQUAL (X.C, Y.C);
+                    WHEN FALSE =>
+                         RETURN X.F = Y.F;
+               END CASE;
+          END EQUAL;
+
+          FUNCTION AGGR
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT
+             ) RETURN PARENT
+          IS
+               RESULT : PARENT (B, L);
+          BEGIN
+               RESULT.I := I;
+               RESULT.S := S;
+               ASSIGN (RESULT.C, C);
+               RETURN RESULT;
+          END AGGR;
+
+          FUNCTION AGGR
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               F : FLOAT
+             ) RETURN PARENT
+          IS
+               RESULT : PARENT (B, L);
+          BEGIN
+               RESULT.I := I;
+               RESULT.F := F;
+               RETURN RESULT;
+          END AGGR;
+
+     END PKG_P;
+
+BEGIN
+     TEST ("C34006J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "RECORD TYPES WITH DISCRIMINANTS AND WITH A " &
+                      "LIMITED COMPONENT TYPE");
+
+     X.I := IDENT_INT (1);
+     X.S := IDENT_STR ("ABC");
+     ASSIGN (X.C, CREATE (4));
+
+     W.I := IDENT_INT (1);
+     W.S := IDENT_STR ("ABC");
+     ASSIGN (W.C, CREATE (4));
+
+     IF NOT EQUAL (T'(X), AGGR (TRUE, 3, 1, "ABC", C4)) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF NOT EQUAL (T(X), AGGR (TRUE, 3, 1, "ABC", C4)) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF NOT EQUAL (T(W), AGGR (TRUE, 3, 1, "ABC", C4)) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF NOT EQUAL (PARENT(X), AGGR (TRUE, 3, 1, "ABC", C4))   OR
+        NOT EQUAL (PARENT(CREATE (FALSE, 2, 3, "XX", C5, 6.0, X)),
+                   AGGR (FALSE, 2, 3, 6.0))   THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF X.B /= TRUE OR X.L /= 3 OR
+        CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).B /= FALSE OR
+        CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).L /= 2 THEN
+          FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+     END IF;
+
+     IF X.I /= 1 OR X.S /= "ABC" OR NOT EQUAL (X.C, C4) OR
+        CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).I /= 3 OR
+        CREATE (FALSE, 2, 3, "XX", C5, 6.0, X).F /= 6.0 THEN
+          FAILED ("INCORRECT SELECTION (VALUE)");
+     END IF;
+
+     X.I := IDENT_INT (7);
+     X.S := IDENT_STR ("XYZ");
+     IF NOT EQUAL (X, AGGR (TRUE, 3, 7, "XYZ", C4)) THEN
+          FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+     END IF;
+
+     X.I := IDENT_INT (1);
+     X.S := IDENT_STR ("ABC");
+     IF NOT (X IN T) OR AGGR (FALSE, 2, 3, 6.0) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT (AGGR (FALSE, 2, 3, 6.0) 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 NOT X'CONSTRAINED THEN
+          FAILED ("INCORRECT 'CONSTRAINED");
+     END IF;
+
+     IF X.C'FIRST_BIT < 0 THEN
+          FAILED ("INCORRECT 'FIRST_BIT");
+     END IF;
+
+     IF X.C'LAST_BIT < 0 OR
+        X.C'LAST_BIT - X.C'FIRST_BIT + 1 /= X.C'SIZE THEN
+          FAILED ("INCORRECT 'LAST_BIT");
+     END IF;
+
+     IF X.C'POSITION < 0 THEN
+          FAILED ("INCORRECT 'POSITION");
+     END IF;
+
+     IF X'SIZE < T'SIZE THEN
+          COMMENT ("X'SIZE < T'SIZE");
+     ELSIF X'SIZE = T'SIZE THEN
+          COMMENT ("X'SIZE = T'SIZE");
+     ELSE
+          COMMENT ("X'SIZE > T'SIZE");
+     END IF;
+
+     RESULT;
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("UNEXPECTED EXCEPTION RAISED WHILE CHECKING BASIC " &
+                  "OPERATIONS");
+          RESULT;
+END C34006J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006l.ada
new file mode 100644
index 000000000..65a21f934
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34006l.ada
@@ -0,0 +1,345 @@
+-- C34006L.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:
+--     FOR DERIVED RECORD TYPES WITH DISCRIMINANTS AND WITH A LIMITED
+--     COMPONENT TYPE:
+
+--        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.
+
+-- HISTORY:
+--     JRK 08/26/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34006L IS
+
+     PACKAGE PKG_L IS
+
+          TYPE LP IS LIMITED PRIVATE;
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP);
+
+          C2 : CONSTANT LP;
+          C4 : CONSTANT LP;
+          C5 : CONSTANT LP;
+          C6 : CONSTANT LP;
+
+     PRIVATE
+
+          TYPE LP IS NEW INTEGER;
+
+          C2 : CONSTANT LP := 2;
+          C4 : CONSTANT LP := 4;
+          C5 : CONSTANT LP := 5;
+          C6 : CONSTANT LP := 6;
+
+     END PKG_L;
+
+     USE PKG_L;
+
+     SUBTYPE COMPONENT IS LP;
+
+     PACKAGE PKG_P IS
+
+          MAX_LEN : CONSTANT := 10;
+
+          SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+               RECORD
+                    I : INTEGER := 2;
+                    CASE B IS
+                         WHEN TRUE =>
+                              S : STRING (1 .. L) := (1 .. L => 'A');
+                              C : COMPONENT;
+                         WHEN FALSE =>
+                              F : FLOAT := 5.0;
+                    END CASE;
+               END RECORD;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            C : COMPONENT;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+          FUNCTION AGGR ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          S : STRING;
+                          C : COMPONENT
+                        ) RETURN PARENT;
+
+          FUNCTION AGGR ( B : BOOLEAN;
+                          L : LENGTH;
+                          I : INTEGER;
+                          F : FLOAT
+                        ) RETURN PARENT;
+
+     END PKG_P;
+
+     USE PKG_P;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T;
+     Y : S;
+
+     PACKAGE BODY PKG_L IS
+
+          FUNCTION CREATE (X : INTEGER) RETURN LP IS
+          BEGIN
+               RETURN LP (IDENT_INT (X));
+          END CREATE;
+
+          FUNCTION EQUAL (X, Y : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT LP; Y : LP) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG_L;
+
+     PACKAGE BODY PKG_P IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT (B, L);
+          BEGIN
+               A.I := I;
+               CASE B IS
+                    WHEN TRUE =>
+                         A.S := S;
+                         ASSIGN (A.C, C);
+                    WHEN FALSE =>
+                         A.F := F;
+               END CASE;
+               RETURN A;
+          END CREATE;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               IF X.B /= Y.B OR X.L /= Y.L OR X.I /= Y.I THEN
+                    RETURN FALSE;
+               END IF;
+               CASE X.B IS
+                    WHEN TRUE =>
+                         RETURN X.S = Y.S AND EQUAL (X.C, Y.C);
+                    WHEN FALSE =>
+                         RETURN X.F = Y.F;
+               END CASE;
+          END EQUAL;
+
+          FUNCTION AGGR
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT
+             ) RETURN PARENT
+          IS
+               RESULT : PARENT (B, L);
+          BEGIN
+               RESULT.I := I;
+               RESULT.S := S;
+               ASSIGN (RESULT.C, C);
+               RETURN RESULT;
+          END AGGR;
+
+          FUNCTION AGGR
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               F : FLOAT
+             ) RETURN PARENT
+          IS
+               RESULT : PARENT (B, L);
+          BEGIN
+               RESULT.I := I;
+               RESULT.F := F;
+               RETURN RESULT;
+          END AGGR;
+
+     END PKG_P;
+
+     PROCEDURE ASSIGN (X : IN OUT T; Y : T) IS
+     BEGIN
+          X.I := Y.I;
+          X.S := Y.S;
+          ASSIGN (X.C, Y.C);
+     END ASSIGN;
+
+     PROCEDURE ASSIGN (X : IN OUT S; Y : S) IS
+     BEGIN
+          X.I := Y.I;
+          X.S := Y.S;
+          ASSIGN (X.C, Y.C);
+     END ASSIGN;
+
+BEGIN
+     TEST ("C34006L", "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 " &
+                      "RECORD TYPES WITH DISCRIMINANTS AND WITH A " &
+                      "LIMITED COMPONENT TYPE");
+
+     ASSIGN (X.C, CREATE (2));
+     ASSIGN (Y.C, C2);
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     IF NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, X),
+                   AGGR (FALSE, 2, 3, 6.0)) OR
+        NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, Y),
+                   AGGR (FALSE, 2, 3, 6.0)) THEN
+          FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+     END IF;
+
+     IF CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, X) IN T OR
+        CREATE (FALSE, 2, 3, "ZZ", C5, 6.0, Y) IN S THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF X.B /= TRUE OR X.L /= 3 OR
+        Y.B /= TRUE OR Y.L /= 3 THEN
+          FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+     END IF;
+
+     IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
+          FAILED ("INCORRECT 'CONSTRAINED");
+     END IF;
+
+     BEGIN
+          ASSIGN (X, AGGR (TRUE, 3, 1, "ABC", C4));
+          ASSIGN (Y, AGGR (TRUE, 3, 1, "ABC", C4));
+          IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
+     END;
+
+     BEGIN
+          ASSIGN (X, AGGR (FALSE, 3, 2, 6.0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (X, AGGR (FALSE, 3, 2, 6.0))");
+          IF EQUAL (X, AGGR (FALSE, 3, 2, 6.0)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "ASSIGN (X, AGGR (FALSE, 3, 2, 6.0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (X, AGGR (FALSE, 3, 2, 6.0))");
+     END;
+
+     BEGIN
+          ASSIGN (X, AGGR (TRUE, 4, 2, "ZZZZ", C6));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (X, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+          IF EQUAL (X, AGGR (TRUE, 4, 2, "ZZZZ", C6)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "ASSIGN (X, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (X, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+     END;
+
+     BEGIN
+          ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0))");
+          IF EQUAL (Y, AGGR (FALSE, 3, 2, 6.0)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (Y, AGGR (FALSE, 3, 2, 6.0))");
+     END;
+
+     BEGIN
+          ASSIGN (Y, AGGR (TRUE, 4, 2, "ZZZZ", C6));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (Y, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+          IF EQUAL (Y, AGGR (TRUE, 4, 2, "ZZZZ", C6)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "ASSIGN (Y, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (Y, AGGR (TRUE, 4, 2, ""ZZZZ"", C6))");
+     END;
+
+     RESULT;
+END C34006L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007a.ada
new file mode 100644
index 000000000..d75c8cc45
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007a.ada
@@ -0,0 +1,181 @@
+-- C34007A.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS
+--     NOT AN ARRAY TYPE, A TASK TYPE, A RECORD TYPE, OR A TYPE WITH
+--     DISCRIMINANTS.
+
+-- HISTORY:
+--     JRK 09/24/86  CREATED ORIGINAL TEST.
+--     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+--                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+--     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+--     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+--     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+--                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007A IS
+
+     TYPE DESIGNATED IS RANGE -100 .. 100;
+
+     SUBTYPE SUBDESIGNATED IS DESIGNATED RANGE
+               DESIGNATED'VAL (IDENT_INT (-50)) ..
+               DESIGNATED'VAL (IDENT_INT ( 50));
+
+     TYPE PARENT IS ACCESS SUBDESIGNATED RANGE
+               DESIGNATED'VAL (IDENT_INT (-30)) ..
+               DESIGNATED'VAL (IDENT_INT ( 30));
+
+     TYPE T IS NEW PARENT;
+
+     X : T       := NEW DESIGNATED'(-30);
+     K : INTEGER := X'SIZE;
+     Y : T       := NEW DESIGNATED'( 30);
+     W : PARENT  := NEW DESIGNATED'( 30);
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          NULL;
+     END A;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF X = NULL OR ELSE
+             EQUAL (DESIGNATED'POS (X.ALL), DESIGNATED'POS (X.ALL)) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN NEW DESIGNATED;
+     END IDENT;
+
+BEGIN
+     TEST ("C34007A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS NOT AN " &
+                      "ARRAY TYPE, A TASK TYPE, A RECORD TYPE, OR A " &
+                      "TYPE WITH DISCRIMINANTS");
+
+     IF Y = NULL OR ELSE Y.ALL /= 30 THEN
+          FAILED ("INCORRECT INITIALIZATION");
+     END IF;
+
+     X := IDENT (Y);
+     IF X /= Y THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= Y THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= Y THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := NEW DESIGNATED'(-30);
+     END IF;
+     X := T (W);
+     IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= -30 THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     X := IDENT (Y);
+     W := PARENT (X);
+     IF W = NULL OR ELSE W.ALL /= 30 OR ELSE T (W) /= Y THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF IDENT (NULL) /= NULL OR X = NULL THEN
+          FAILED ("INCORRECT NULL");
+     END IF;
+
+     X := IDENT (NEW DESIGNATED'(30));
+     IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= 30 THEN
+          FAILED ("INCORRECT ALLOCATOR");
+     END IF;
+
+     X := IDENT (Y);
+     IF X.ALL /= 30 THEN
+          FAILED ("INCORRECT .ALL (VALUE)");
+     END IF;
+
+     X.ALL := DESIGNATED'VAL (IDENT_INT (10));
+     IF X /= Y OR Y.ALL /= 10 THEN
+          FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+     END IF;
+
+     Y.ALL := 30;
+     X := IDENT (NULL);
+     BEGIN
+          IF X.ALL = 0 THEN
+               FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+          ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+     END;
+
+     X := IDENT (Y);
+     IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= Y OR NOT (X /= NULL) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     A (X'ADDRESS);
+
+     BEGIN
+          IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+               FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                       "EQUAL OF COLLECTION SIZE OF PARENT TYPE");
+          END IF;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                        "UNDEFINED STORAGE_SIZE (AI-00608)");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C34007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007d.ada
new file mode 100644
index 000000000..9378a2bbc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007d.ada
@@ -0,0 +1,266 @@
+-- C34007D.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+--     ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS PART 1 OF 2 TESTS
+--     WHICH COVER THE OBJECTIVE.  THE SECOND PART IS IN TEST C34007V.
+
+-- HISTORY:
+--     JRK 09/25/86  CREATED ORIGINAL TEST.
+--     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+--                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+--     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+--     BCB 04/12/90  SPLIT ORIGINAL TEST INTO C34007D.ADA AND
+--                   C34007V.ADA.  PUT CHECK FOR 'STORAGE_SIZE IN
+--                   EXCEPTION HANDLER.
+--     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+--                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007D IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT;
+
+     SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_INT (5) ..
+                                          IDENT_INT (7));
+
+     PACKAGE PKG IS
+
+          TYPE PARENT IS ACCESS DESIGNATED;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     X : T         := NEW SUBDESIGNATED'(OTHERS => 2);
+     K : INTEGER   := X'SIZE;
+     Y : T         := NEW SUBDESIGNATED'(1, 2, 3);
+     W : PARENT    := NEW SUBDESIGNATED'(OTHERS => 2);
+     C : COMPONENT := 1;
+     N : CONSTANT  := 1;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          NULL;
+     END A;
+
+     FUNCTION V RETURN T IS
+     BEGIN
+          RETURN NEW SUBDESIGNATED'(OTHERS => C);
+     END V;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF X = NULL OR ELSE
+             EQUAL (X'LENGTH, X'LENGTH) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN NEW SUBDESIGNATED;
+     END IDENT;
+
+BEGIN
+     TEST ("C34007D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS " &
+                      "PART 1 OF 2 TESTS WHICH COVER THE OBJECTIVE.  " &
+                      "THE SECOND PART IS IN TEST C34007V");
+
+     IF Y = NULL OR ELSE Y.ALL /= (1, 2, 3) THEN
+          FAILED ("INCORRECT INITIALIZATION");
+     END IF;
+
+     X := IDENT (Y);
+     IF X /= Y THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= Y THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= Y THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := NEW SUBDESIGNATED'(1, 2, 3);
+     END IF;
+     X := T (W);
+     IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, 2, 3) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     X := IDENT (Y);
+     W := PARENT (X);
+     IF W = NULL OR ELSE W.ALL /= (1, 2, 3) OR ELSE T (W) /= Y THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+     END IF;
+
+     IF IDENT (NULL) /= NULL OR X = NULL THEN
+          FAILED ("INCORRECT NULL");
+     END IF;
+
+     X := IDENT (NEW SUBDESIGNATED'(1, 2, 3));
+     IF (X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, 2, 3)) OR
+        X = NEW DESIGNATED'(1, 2) THEN
+          FAILED ("INCORRECT ALLOCATOR");
+     END IF;
+
+     X := IDENT (NULL);
+     BEGIN
+          IF X.ALL = (0, 0, 0) THEN
+               FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+          ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+     END;
+
+     X := IDENT (Y);
+     X (IDENT_INT (7)) := 4;
+     IF X /= Y OR Y.ALL /= (1, 2, 4) THEN
+          FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+     END IF;
+
+     Y.ALL := (1, 2, 3);
+     X := IDENT (Y);
+     X (IDENT_INT (5) .. IDENT_INT (6)) := (4, 5);
+     IF X /= Y OR Y.ALL /= (4, 5, 3) THEN
+          FAILED ("INCORRECT SLICE (ASSIGNMENT)");
+     END IF;
+
+     A (X'ADDRESS);
+
+     IF X'FIRST /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST");
+     END IF;
+
+     IF V'FIRST /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST");
+     END IF;
+
+     IF X'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT OBJECT'FIRST (N)");
+     END IF;
+
+     IF V'FIRST (N) /= 5 THEN
+          FAILED ("INCORRECT VALUE'FIRST (N)");
+     END IF;
+
+     IF X'LAST /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST");
+     END IF;
+
+     IF V'LAST /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST");
+     END IF;
+
+     IF X'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT OBJECT'LAST (N)");
+     END IF;
+
+     IF V'LAST (N) /= 7 THEN
+          FAILED ("INCORRECT VALUE'LAST (N)");
+     END IF;
+
+     IF X'LENGTH /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH");
+     END IF;
+
+     IF V'LENGTH /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH");
+     END IF;
+
+     IF X'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH (N)");
+     END IF;
+
+     IF V'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH (N)");
+     END IF;
+
+     DECLARE
+          Y : DESIGNATED (X'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : DESIGNATED (V'RANGE);
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : DESIGNATED (X'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT OBJECT'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : DESIGNATED (V'RANGE (N));
+     BEGIN
+          IF Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+               FAILED ("INCORRECT VALUE'RANGE (N)");
+          END IF;
+     END;
+
+     IF T'SIZE < 1 THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     BEGIN
+          IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+               FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                       "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+          END IF;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                        "UNDEFINED STORAGE_SIZE (AI-00608)");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C34007D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007f.ada
new file mode 100644
index 000000000..0e9222b58
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007f.ada
@@ -0,0 +1,163 @@
+-- C34007F.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 ACCESS TYPES WHOSE DESIGNATED TYPE IS A ONE-DIMENSIONAL
+-- ARRAY TYPE:
+
+--   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 9/25/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007F IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT;
+
+     SUBTYPE SUBDESIGNATED IS DESIGNATED (5 .. 7);
+
+     PACKAGE PKG IS
+
+          TYPE PARENT IS ACCESS DESIGNATED;
+
+          FUNCTION CREATE ( F, L  : NATURAL;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     SUBTYPE SUBPARENT IS PARENT (5 .. 7);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T := NEW SUBDESIGNATED'(OTHERS => 2);
+     Y : S := NEW SUBDESIGNATED'(OTHERS => 2);
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F, L  : NATURAL;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT    := NEW DESIGNATED (F .. L);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F .. L LOOP
+                    A (I) := B;
+                    B := B + 1;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34007F", "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 " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "ONE-DIMENSIONAL ARRAY TYPE");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     IF CREATE (2, 3, 4, X) . ALL /= (4, 5) OR
+        CREATE (2, 3, 4, Y) . ALL /= (4, 5) THEN
+          FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+     END IF;
+
+     IF CREATE (2, 3, 4, X) IN T OR
+        CREATE (2, 3, 4, Y) IN S THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF X'FIRST /= 5 OR X'LAST /= 7 OR
+        Y'FIRST /= 5 OR Y'LAST /= 7 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := NEW SUBDESIGNATED'(1, 2, 3);
+          Y := NEW SUBDESIGNATED'(1, 2, 3);
+          IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
+             X.ALL /= Y.ALL THEN
+               FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := NEW DESIGNATED'(6 .. 8 => 0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := NEW DESIGNATED'(6 .. 8 => 0)");
+          IF X = NULL OR ELSE X.ALL = (0, 0, 0) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := NEW DESIGNATED'(6 .. 8 => 0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := NEW DESIGNATED'(6 .. 8 => 0)");
+     END;
+
+     BEGIN
+          Y := NEW DESIGNATED'(6 .. 8 => 0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := NEW DESIGNATED'(6 .. 8 => 0)");
+          IF Y = NULL OR ELSE Y.ALL = (0, 0, 0) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := NEW DESIGNATED'(6 .. 8 => 0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := NEW DESIGNATED'(6 .. 8 => 0)");
+     END;
+
+     RESULT;
+END C34007F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007g.ada
new file mode 100644
index 000000000..85c0f2ab9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007g.ada
@@ -0,0 +1,350 @@
+-- C34007G.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+--     MULTI-DIMENSIONAL ARRAY TYPE.
+
+-- HISTORY:
+--     JRK 09/25/86  CREATED ORIGINAL TEST.
+--     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+--                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+--     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+--     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+--                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007G IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) OF
+                              COMPONENT;
+
+     SUBTYPE SUBDESIGNATED IS DESIGNATED
+                                   (IDENT_INT (4) .. IDENT_INT (5),
+                                    IDENT_INT (6) .. IDENT_INT (8));
+
+     PACKAGE PKG IS
+
+          TYPE PARENT IS ACCESS DESIGNATED;
+
+          FUNCTION CREATE ( F1, L1 : NATURAL;
+                            F2, L2 : NATURAL;
+                            C      : COMPONENT;
+                            DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                           IDENT_INT (6) .. IDENT_INT (8));
+
+     X : T         := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
+     Y : T         := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
+     W : PARENT    := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
+     C : COMPONENT := 1;
+     N : CONSTANT  := 2;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          NULL;
+     END A;
+
+     FUNCTION V RETURN T IS
+     BEGIN
+          RETURN NEW SUBDESIGNATED'(OTHERS => (OTHERS => C));
+     END V;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F1, L1 : NATURAL;
+               F2, L2 : NATURAL;
+               C      : COMPONENT;
+               DUMMY  : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT    := NEW DESIGNATED (F1 .. L1, F2 .. L2);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F1 .. L1 LOOP
+                    FOR J IN F2 .. L2 LOOP
+                         A (I, J) := B;
+                         B := B + 1;
+                    END LOOP;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF X = NULL OR ELSE
+             EQUAL (X'LENGTH, X'LENGTH) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN NEW SUBDESIGNATED;
+     END IDENT;
+
+BEGIN
+     TEST ("C34007G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "MULTI-DIMENSIONAL ARRAY TYPE");
+
+     IF Y = NULL OR ELSE Y.ALL /= ((1, 2, 3), (4, 5, 6)) THEN
+          FAILED ("INCORRECT INITIALIZATION");
+     END IF;
+
+     X := IDENT (Y);
+     IF X /= Y THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= Y THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= Y THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
+     END IF;
+     X := T (W);
+     IF X = NULL OR ELSE X = Y OR ELSE
+        X.ALL /= ((1, 2, 3), (4, 5, 6)) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     X := IDENT (Y);
+     W := PARENT (X);
+     IF W = NULL OR ELSE W.ALL /= ((1, 2, 3), (4, 5, 6)) OR ELSE
+        T (W) /= Y THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+     END IF;
+
+     W := PARENT (CREATE (6, 9, 2, 3, 4, X));
+     IF W = NULL OR ELSE
+        W.ALL /= ((4, 5), (6, 7), (8, 9), (10, 11)) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+     END IF;
+
+     IF IDENT (NULL) /= NULL OR X = NULL THEN
+          FAILED ("INCORRECT NULL");
+     END IF;
+
+     X := IDENT (NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6)));
+     IF (X = NULL OR ELSE X = Y OR ELSE
+         X.ALL /= ((1, 2, 3), (4, 5, 6))) OR
+        X = NEW DESIGNATED'((1, 2), (3, 4), (5, 6)) THEN
+          FAILED ("INCORRECT ALLOCATOR");
+     END IF;
+
+     X := IDENT (Y);
+     IF X.ALL /= ((1, 2, 3), (4, 5, 6)) OR
+        CREATE (6, 9, 2, 3, 4, X) . ALL /=
+        ((4, 5), (6, 7), (8, 9), (10, 11)) THEN
+          FAILED ("INCORRECT .ALL (VALUE)");
+     END IF;
+
+     X.ALL := ((10, 11, 12), (13, 14, 15));
+     IF X /= Y OR Y.ALL /= ((10, 11, 12), (13, 14, 15)) THEN
+          FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+     END IF;
+
+     Y.ALL := ((1, 2, 3), (4, 5, 6));
+     BEGIN
+          CREATE (6, 9, 2, 3, 4, X) . ALL :=
+               ((20, 21), (22, 23), (24, 25), (26, 27));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
+     END;
+
+     X := IDENT (NULL);
+     BEGIN
+          IF X.ALL = ((0, 0, 0), (0, 0, 0)) THEN
+               FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+          ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+     END;
+
+     X := IDENT (Y);
+     IF X (IDENT_INT (4), IDENT_INT (6)) /= 1 OR
+        CREATE (6, 9, 2, 3, 4, X) (9, 3) /= 11 THEN
+          FAILED ("INCORRECT INDEX (VALUE)");
+     END IF;
+
+     X (IDENT_INT (5), IDENT_INT (8)) := 7;
+     IF X /= Y OR Y.ALL /= ((1, 2, 3), (4, 5, 7)) THEN
+          FAILED ("INCORRECT INDEX (ASSIGNMENT)");
+     END IF;
+
+     Y.ALL := ((1, 2, 3), (4, 5, 6));
+     X := IDENT (Y);
+     BEGIN
+          CREATE (6, 9, 2, 3, 4, X) (6, 2) := 15;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION FOR INDEX (ASSIGNMENT)");
+     END;
+
+     IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
+        X = CREATE (6, 9, 2, 3, 4, X) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= Y OR NOT (X /= NULL) OR
+        NOT (X /= CREATE (7, 9, 2, 4, 1, X)) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) OR CREATE (2, 3, 4, 5, 1, X) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT (CREATE (7, 9, 2, 4, 1, X) NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     A (X'ADDRESS);
+
+     IF X'FIRST /= 4 THEN
+          FAILED ("INCORRECT OBJECT'FIRST");
+     END IF;
+
+     IF V'FIRST /= 4 THEN
+          FAILED ("INCORRECT VALUE'FIRST");
+     END IF;
+
+     IF X'FIRST (N) /= 6 THEN
+          FAILED ("INCORRECT OBJECT'FIRST (N)");
+     END IF;
+
+     IF V'FIRST (N) /= 6 THEN
+          FAILED ("INCORRECT VALUE'FIRST (N)");
+     END IF;
+
+     IF X'LAST /= 5 THEN
+          FAILED ("INCORRECT OBJECT'LAST");
+     END IF;
+
+     IF V'LAST /= 5 THEN
+          FAILED ("INCORRECT VALUE'LAST");
+     END IF;
+
+     IF X'LAST (N) /= 8 THEN
+          FAILED ("INCORRECT OBJECT'LAST (N)");
+     END IF;
+
+     IF V'LAST (N) /= 8 THEN
+          FAILED ("INCORRECT VALUE'LAST (N)");
+     END IF;
+
+     IF X'LENGTH /= 2 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH");
+     END IF;
+
+     IF V'LENGTH /= 2 THEN
+          FAILED ("INCORRECT VALUE'LENGTH");
+     END IF;
+
+     IF X'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT OBJECT'LENGTH (N)");
+     END IF;
+
+     IF V'LENGTH (N) /= 3 THEN
+          FAILED ("INCORRECT VALUE'LENGTH (N)");
+     END IF;
+
+     DECLARE
+          Y : DESIGNATED (X'RANGE, 1 .. 3);
+     BEGIN
+          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+               FAILED ("INCORRECT OBJECT'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : DESIGNATED (V'RANGE, 1 .. 3);
+     BEGIN
+          IF Y'FIRST /= 4 OR Y'LAST /= 5 THEN
+               FAILED ("INCORRECT VALUE'RANGE");
+          END IF;
+     END;
+
+     DECLARE
+          Y : DESIGNATED (1 .. 2, X'RANGE (N));
+     BEGIN
+          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+               FAILED ("INCORRECT OBJECT'RANGE (N)");
+          END IF;
+     END;
+
+     DECLARE
+          Y : DESIGNATED (1 .. 2, V'RANGE (N));
+     BEGIN
+          IF Y'FIRST (N) /= 6 OR Y'LAST (N) /= 8 THEN
+               FAILED ("INCORRECT VALUE'RANGE (N)");
+          END IF;
+     END;
+
+     IF T'SIZE < 1 THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     IF X'SIZE < T'SIZE THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     BEGIN
+          IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+               FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                       "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+          END IF;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                        "UNDEFINED STORAGE_SIZE (AI-00608)");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C34007G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007i.ada
new file mode 100644
index 000000000..55bc2c494
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007i.ada
@@ -0,0 +1,213 @@
+-- C34007I.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 ACCESS TYPES WHOSE DESIGNATED TYPE IS A MULTI-DIMENSIONAL
+-- ARRAY TYPE:
+
+--   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 9/25/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007I IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) OF
+                              COMPONENT;
+
+     SUBTYPE SUBDESIGNATED IS DESIGNATED (4 .. 5, 6 .. 8);
+
+     PACKAGE PKG IS
+
+          TYPE PARENT IS ACCESS DESIGNATED;
+
+          FUNCTION CREATE ( F1, L1 : NATURAL;
+                            F2, L2 : NATURAL;
+                            C      : COMPONENT;
+                            DUMMY  : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (4) .. IDENT_INT (5),
+                           IDENT_INT (6) .. IDENT_INT (8));
+
+     SUBTYPE SUBPARENT IS PARENT (4 .. 5, 6 .. 8);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
+     Y : S := NEW SUBDESIGNATED'(OTHERS => (OTHERS => 2));
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F1, L1 : NATURAL;
+               F2, L2 : NATURAL;
+               C      : COMPONENT;
+               DUMMY  : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT    := NEW DESIGNATED (F1 .. L1, F2 .. L2);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F1 .. L1 LOOP
+                    FOR J IN F2 .. L2 LOOP
+                         A (I, J) := B;
+                         B := B + 1;
+                    END LOOP;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34007I", "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 " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "MULTI-DIMENSIONAL ARRAY TYPE");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     IF CREATE (6, 9, 2, 3, 1, X) . ALL /=
+        ((1, 2), (3, 4), (5, 6), (7, 8)) OR
+        CREATE (6, 9, 2, 3, 1, Y) . ALL /=
+        ((1, 2), (3, 4), (5, 6), (7, 8)) THEN
+          FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+     END IF;
+
+     IF CREATE (6, 9, 2, 3, 1, X) IN T OR
+        CREATE (6, 9, 2, 3, 1, Y) IN S THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF X'FIRST /= 4 OR X'LAST /= 5 OR
+        Y'FIRST /= 4 OR Y'LAST /= 5 OR
+        X'FIRST (2) /= 6 OR X'LAST (2) /= 8 OR
+        Y'FIRST (2) /= 6 OR Y'LAST (2) /= 8 THEN
+          FAILED ("INCORRECT 'FIRST OR 'LAST");
+     END IF;
+
+     BEGIN
+          X := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
+          Y := NEW SUBDESIGNATED'((1, 2, 3), (4, 5, 6));
+          IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
+             X.ALL /= Y.ALL THEN
+               FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
+          IF X = NULL OR ELSE
+             X.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := NEW DESIGNATED'(5 .. 6 => " &
+                        "(6 .. 8 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
+     END;
+
+     BEGIN
+          X := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
+          IF X = NULL OR ELSE
+             X.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := NEW DESIGNATED'(4 .. 5 => " &
+                        "(5 .. 7 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
+     END;
+
+     BEGIN
+          Y := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
+          IF Y = NULL OR ELSE
+             Y.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := NEW DESIGNATED'(5 .. 6 => " &
+                        "(6 .. 8 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := NEW DESIGNATED'(5 .. 6 => (6 .. 8 => 0))");
+     END;
+
+     BEGIN
+          Y := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
+          IF Y = NULL OR ELSE
+             Y.ALL = ((0, 0, 0), (0, 0, 0)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := NEW DESIGNATED'(4 .. 5 => " &
+                        "(5 .. 7 => 0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := NEW DESIGNATED'(4 .. 5 => (5 .. 7 => 0))");
+     END;
+
+     RESULT;
+END C34007I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007j.ada
new file mode 100644
index 000000000..1ce054cb7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007j.ada
@@ -0,0 +1,258 @@
+-- C34007J.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE
+--     IS A TASK TYPE.
+
+-- HISTORY:
+--     JRK 09/26/86  CREATED ORIGINAL TEST.
+--     JLH 09/25/87  REFORMATTED HEADER.
+--     BCB 09/26/88  REMOVED COMPARISION INVOLVING OBJECT SIZE.
+--     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+--     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+--                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007J IS
+
+     TASK TYPE DESIGNATED IS
+          ENTRY E (I : IN OUT INTEGER);
+          ENTRY F (1 .. 3) (I : INTEGER; J : OUT INTEGER);
+          ENTRY R (I : OUT INTEGER);
+          ENTRY W (I : INTEGER);
+     END DESIGNATED;
+
+     TYPE PARENT IS ACCESS DESIGNATED;
+
+     TYPE T IS NEW PARENT;
+
+     X : T;
+     K : INTEGER := X'SIZE;
+     Y : T;
+     W : PARENT;
+     I : INTEGER := 0;
+     J : INTEGER := 0;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          NULL;
+     END A;
+
+     FUNCTION V RETURN T IS
+     BEGIN
+          RETURN NEW DESIGNATED;
+     END V;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF (X = NULL OR ELSE X'CALLABLE) OR IDENT_BOOL (TRUE) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN NEW DESIGNATED;
+     END IDENT;
+
+     TASK BODY DESIGNATED IS
+          N : INTEGER := 1;
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT E (I : IN OUT INTEGER) DO
+                         I := I + N;
+                    END E;
+               OR
+                    ACCEPT F (2) (I : INTEGER; J : OUT INTEGER) DO
+                         J := I + N;
+                    END F;
+               OR
+                    ACCEPT R (I : OUT INTEGER) DO
+                         I := N;
+                    END R;
+               OR
+                    ACCEPT W (I : INTEGER) DO
+                         N := I;
+                    END W;
+               OR
+                    TERMINATE;
+               END SELECT;
+          END LOOP;
+     END DESIGNATED;
+
+BEGIN
+     TEST ("C34007J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "TASK TYPE");
+
+     X := NEW DESIGNATED;
+     Y := NEW DESIGNATED;
+     W := NEW DESIGNATED;
+
+     IF Y = NULL THEN
+          FAILED ("INCORRECT INITIALIZATION - 1");
+     ELSE Y.W (2);
+          Y.R (I);
+          IF I /= 2 THEN
+               FAILED ("INCORRECT INITIALIZATION - 2");
+          END IF;
+     END IF;
+
+     X := IDENT (Y);
+     IF X /= Y THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= Y THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= Y THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := NEW DESIGNATED;
+          W.W (3);
+     END IF;
+     X := T (W);
+     IF X = NULL OR X = Y THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT - 1");
+     ELSE I := 5;
+          X.E (I);
+          IF I /= 8 THEN
+               FAILED ("INCORRECT CONVERSION FROM PARENT - 2");
+          END IF;
+     END IF;
+
+     X := IDENT (Y);
+     W := PARENT (X);
+     IF W = NULL OR T (W) /= Y THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+     ELSE I := 5;
+          W.E (I);
+          IF I /= 7 THEN
+               FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+          END IF;
+     END IF;
+
+     IF IDENT (NULL) /= NULL OR X = NULL THEN
+          FAILED ("INCORRECT NULL");
+     END IF;
+
+     X := IDENT (NEW DESIGNATED);
+     IF X = NULL OR X = Y THEN
+          FAILED ("INCORRECT ALLOCATOR - 1");
+     ELSE I := 5;
+          X.E (I);
+          IF I /= 6 THEN
+               FAILED ("INCORRECT ALLOCATOR - 2");
+          END IF;
+     END IF;
+
+     X := IDENT (Y);
+     I := 5;
+     X.E (I);
+     IF I /= 7 THEN
+          FAILED ("INCORRECT SELECTION (ENTRY)");
+     END IF;
+
+     I := 5;
+     X.F (IDENT_INT (2)) (I, J);
+     IF J /= 7 THEN
+          FAILED ("INCORRECT SELECTION (FAMILY)");
+     END IF;
+
+     I := 5;
+     X.ALL.E (I);
+     IF I /= 7 THEN
+          FAILED ("INCORRECT .ALL");
+     END IF;
+
+     X := IDENT (NULL);
+     BEGIN
+          IF X.ALL'CALLABLE THEN
+               FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+          ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+     END;
+
+     X := IDENT (Y);
+     IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= Y OR NOT (X /= NULL) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     A (X'ADDRESS);
+
+     IF NOT X'CALLABLE THEN
+          FAILED ("INCORRECT OBJECT'CALLABLE");
+     END IF;
+
+     IF NOT V'CALLABLE THEN
+          FAILED ("INCORRECT VALUE'CALLABLE");
+     END IF;
+
+     BEGIN
+          IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+               FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                       "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+          END IF;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                        "UNDEFINED STORAGE_SIZE (AI-00608)");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     IF X'TERMINATED THEN
+          FAILED ("INCORRECT OBJECT'TERMINATED");
+     END IF;
+
+     IF V'TERMINATED THEN
+          FAILED ("INCORRECT VALUE'TERMINATED");
+     END IF;
+
+     RESULT;
+END C34007J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007m.ada
new file mode 100644
index 000000000..e266f575c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007m.ada
@@ -0,0 +1,191 @@
+-- C34007M.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+--     RECORD TYPE WITHOUT DISCRIMINANTS.
+
+-- HISTORY:
+--     JRK 09/29/86  CREATED ORIGINAL TEST.
+--     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+--                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+--     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+--     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+--     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+--                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007M IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     TYPE DESIGNATED IS
+          RECORD
+               C : COMPONENT;
+               B : BOOLEAN := TRUE;
+          END RECORD;
+
+     TYPE PARENT IS ACCESS DESIGNATED;
+
+     TYPE T IS NEW PARENT;
+
+     X : T       := NEW DESIGNATED'(2, FALSE);
+     K : INTEGER := X'SIZE;
+     Y : T       := NEW DESIGNATED'(1, TRUE);
+     W : PARENT  := NEW DESIGNATED'(2, FALSE);
+     C : COMPONENT := 1;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          NULL;
+     END A;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF X = NULL OR ELSE EQUAL (X.C, X.C) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN NEW DESIGNATED'(-1, FALSE);
+     END IDENT;
+
+BEGIN
+     TEST ("C34007M", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "RECORD TYPE WITHOUT DISCRIMINANTS");
+
+     IF Y = NULL OR ELSE Y.ALL /= (1, TRUE) THEN
+          FAILED ("INCORRECT INITIALIZATION");
+     END IF;
+
+     X := IDENT (Y);
+     IF X /= Y THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= Y THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= Y THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := NEW DESIGNATED'(1, TRUE);
+     END IF;
+     X := T (W);
+     IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, TRUE) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     X := IDENT (Y);
+     W := PARENT (X);
+     IF W = NULL OR ELSE W.ALL /= (1, TRUE) OR ELSE T (W) /= Y THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF IDENT (NULL) /= NULL OR X = NULL THEN
+          FAILED ("INCORRECT NULL");
+     END IF;
+
+     X := IDENT (NEW DESIGNATED'(1, TRUE));
+     IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, TRUE) THEN
+          FAILED ("INCORRECT ALLOCATOR");
+     END IF;
+
+     X := IDENT (Y);
+     IF X.C /= 1 OR X.B /= TRUE THEN
+          FAILED ("INCORRECT SELECTION (VALUE)");
+     END IF;
+
+     X.C := IDENT_INT (3);
+     X.B := IDENT_BOOL (FALSE);
+     IF X /= Y OR Y.ALL /= (3, FALSE) THEN
+          FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+     END IF;
+
+     Y.ALL := (1, TRUE);
+     X := IDENT (Y);
+     IF X.ALL /= (1, TRUE) THEN
+          FAILED ("INCORRECT .ALL (VALUE)");
+     END IF;
+
+     X.ALL := (10, FALSE);
+     IF X /= Y OR Y.ALL /= (10, FALSE) THEN
+          FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+     END IF;
+
+     Y.ALL := (1, TRUE);
+     X := IDENT (NULL);
+     BEGIN
+          IF X.ALL = (0, FALSE) THEN
+               FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+          ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+     END;
+
+     X := IDENT (Y);
+     IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= Y OR NOT (X /= NULL) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     A (X'ADDRESS);
+
+     BEGIN
+          IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+               FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                       "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+          END IF;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                        "UNDEFINED STORAGE_SIZE (AI-00608)");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C34007M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007p.ada
new file mode 100644
index 000000000..a6d85b0d6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007p.ada
@@ -0,0 +1,283 @@
+-- C34007P.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+--     RECORD TYPE WITH DISCRIMINANTS.
+
+-- HISTORY:
+--     JRK 09/29/86  CREATED ORIGINAL TEST.
+--     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+--                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+--     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+--     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+--     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+--                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007P IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
+
+     TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+          RECORD
+               I : INTEGER;
+               CASE B IS
+                    WHEN TRUE =>
+                         S : STRING (1 .. L);
+                         C : COMPONENT;
+                    WHEN FALSE =>
+                         F : FLOAT := 5.0;
+               END CASE;
+          END RECORD;
+
+     SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_BOOL (TRUE),
+                                          IDENT_INT (3));
+
+     PACKAGE PKG IS
+
+          TYPE PARENT IS ACCESS DESIGNATED;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            C : COMPONENT;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     X : T       := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
+     K : INTEGER := X'SIZE;
+     Y : T       := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
+     W : PARENT  := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
+     C : COMPONENT := 1;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          NULL;
+     END A;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               CASE B IS
+                    WHEN TRUE =>
+                         RETURN NEW DESIGNATED'(TRUE, L, I, S, C);
+                    WHEN FALSE =>
+                         RETURN NEW DESIGNATED'(FALSE, L, I, F);
+               END CASE;
+          END CREATE;
+
+     END PKG;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF X = NULL OR ELSE EQUAL (X.I, X.I) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN NEW DESIGNATED'(TRUE, 3, -1, "---", -1);
+     END IDENT;
+
+BEGIN
+     TEST ("C34007P", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "RECORD TYPE WITH DISCRIMINANTS");
+
+     IF Y = NULL OR ELSE Y.ALL /= (TRUE, 3, 1, "ABC", 4) THEN
+          FAILED ("INCORRECT INITIALIZATION");
+     END IF;
+
+     X := IDENT (Y);
+     IF X /= Y THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= Y THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= Y THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
+     END IF;
+     X := T (W);
+     IF X = NULL OR ELSE X = Y OR ELSE
+        X.ALL /= (TRUE, 3, 1, "ABC", 4) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     X := IDENT (Y);
+     W := PARENT (X);
+     IF W = NULL OR ELSE W.ALL /= (TRUE, 3, 1, "ABC", 4) OR ELSE
+        T (W) /= Y THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+     END IF;
+
+     W := PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X));
+     IF W = NULL OR ELSE W.ALL /= (FALSE, 2, 3, 6.0) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+     END IF;
+
+     IF IDENT (NULL) /= NULL OR X = NULL THEN
+          FAILED ("INCORRECT NULL");
+     END IF;
+
+     X := IDENT (NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4));
+     IF (X = NULL OR ELSE X = Y OR ELSE
+         X.ALL /= (TRUE, 3, 1, "ABC", 4)) OR
+        X = NEW DESIGNATED'(FALSE, 3, 1, 4.0) THEN
+          FAILED ("INCORRECT ALLOCATOR");
+     END IF;
+
+     X := IDENT (Y);
+     IF X.B /= TRUE OR X.L /= 3 OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
+          FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+     END IF;
+
+     IF X.I /= 1 OR X.S /= "ABC" OR X.C /= 4 OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . I /= 3 OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . F /= 6.0 THEN
+          FAILED ("INCORRECT SELECTION (VALUE)");
+     END IF;
+
+     X.I := IDENT_INT (7);
+     X.S := IDENT_STR ("XYZ");
+     X.C := IDENT_INT (9);
+     IF X /= Y OR Y.ALL /= (TRUE, 3, 7, "XYZ", 9) THEN
+          FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
+     END IF;
+
+     Y.ALL := (TRUE, 3, 1, "ABC", 4);
+     X := IDENT (Y);
+     BEGIN
+          CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . I := 10;
+          CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . F := 10.0;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION FOR SELECTION (ASSIGNMENT)");
+     END;
+
+     IF X.ALL /= (TRUE, 3, 1, "ABC", 4) OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL /=
+        (FALSE, 2, 3, 6.0) THEN
+          FAILED ("INCORRECT .ALL (VALUE)");
+     END IF;
+
+     X.ALL := (TRUE, 3, 10, "ZZZ", 15);
+     IF X /= Y OR Y.ALL /= (TRUE, 3, 10, "ZZZ", 15) THEN
+          FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+     END IF;
+
+     Y.ALL := (TRUE, 3, 1, "ABC", 4);
+     BEGIN
+          CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL :=
+               (FALSE, 2, 10, 15.0);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
+     END;
+
+     X := IDENT (NULL);
+     BEGIN
+          IF X.ALL = (FALSE, 0, 0, 0.0) THEN
+               FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+          ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+     END;
+
+     X := IDENT (Y);
+     IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
+        X = CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= Y OR NOT (X /= NULL) OR
+        NOT (X /= CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) OR CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR
+        NOT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     A (X'ADDRESS);
+
+     IF T'SIZE < 1 THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     BEGIN
+          IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+               FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                       "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+          END IF;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                        "UNDEFINED STORAGE_SIZE (AI-00608)");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C34007P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007r.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007r.ada
new file mode 100644
index 000000000..096d84527
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007r.ada
@@ -0,0 +1,218 @@
+-- C34007R.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 ACCESS TYPES WHOSE DESIGNATED TYPE IS A RECORD TYPE
+-- WITH DISCRIMINANTS:
+
+--   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 9/29/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007R IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
+
+     TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+          RECORD
+               I : INTEGER;
+               CASE B IS
+                    WHEN TRUE =>
+                         S : STRING (1 .. L);
+                         C : COMPONENT;
+                    WHEN FALSE =>
+                         F : FLOAT := 5.0;
+               END CASE;
+          END RECORD;
+
+     PACKAGE PKG IS
+
+          TYPE PARENT IS ACCESS DESIGNATED;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            C : COMPONENT;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
+     Y : S := NEW DESIGNATED'(TRUE, 3, 2, "AAA", 2);
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               CASE B IS
+                    WHEN TRUE =>
+                         RETURN NEW DESIGNATED'(TRUE, L, I, S, C);
+                    WHEN FALSE =>
+                         RETURN NEW DESIGNATED'(FALSE, L, I, F);
+               END CASE;
+          END CREATE;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34007R", "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 " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "RECORD TYPE WITH DISCRIMINANTS");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) . ALL /=
+        (FALSE, 2, 3, 6.0) OR
+        CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) . ALL /=
+        (FALSE, 2, 3, 6.0) THEN
+          FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+     END IF;
+
+     IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
+        CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF X.B /= TRUE OR X.L /= 3 OR
+        Y.B /= TRUE OR Y.L /= 3 THEN
+          FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+     END IF;
+
+     BEGIN
+          X := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
+          Y := NEW DESIGNATED'(TRUE, 3, 1, "ABC", 4);
+          IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
+             X.ALL /= Y.ALL THEN
+               FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := NEW DESIGNATED'(FALSE, 3, 2, 6.0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+          IF X = NULL OR ELSE X.ALL = (FALSE, 3, 2, 6.0) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+     END;
+
+     BEGIN
+          X := NEW DESIGNATED'(TRUE, 4, 2, "ZZZZ", 6);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
+          IF X = NULL OR ELSE
+             X.ALL = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := NEW DESIGNATED'" &
+                        "(TRUE, 4, 2, ""ZZZZ"", 6)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
+     END;
+
+     BEGIN
+          Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+          IF Y = NULL OR ELSE Y.ALL = (FALSE, 3, 2, 6.0) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := NEW DESIGNATED'(FALSE, 3, 2, 6.0)");
+     END;
+
+     BEGIN
+          Y := NEW DESIGNATED'(TRUE, 4, 2, "ZZZZ", 6);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
+          IF Y = NULL OR ELSE
+             Y.ALL = (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := NEW DESIGNATED'" &
+                        "(TRUE, 4, 2, ""ZZZZ"", 6)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := NEW DESIGNATED'(TRUE, 4, 2, ""ZZZZ"", 6)");
+     END;
+
+     RESULT;
+END C34007R;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007s.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007s.ada
new file mode 100644
index 000000000..54a2f3344
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007s.ada
@@ -0,0 +1,299 @@
+-- C34007S.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+--     PRIVATE TYPE WITH DISCRIMINANTS.
+
+-- HISTORY:
+--     JRK 09/30/86  CREATED ORIGINAL TEST.
+--     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  REVISED TEST SO
+--                   T'STORAGE_SIZE IS NOT REQUIRED TO BE > 1.
+--     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+--     BCB 03/07/90  PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER.
+--     THS 09/18/90  REMOVED DECLARATION OF B, MADE THE BODY OF
+--                   PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007S IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     PACKAGE PKG_D IS
+
+          SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
+
+          TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+                          PRIVATE;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            C : COMPONENT;
+                            F : FLOAT
+                          ) RETURN DESIGNATED;
+
+     PRIVATE
+
+          TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+               RECORD
+                    I : INTEGER := 2;
+                    CASE B IS
+                         WHEN TRUE =>
+                              S : STRING (1 .. L) := (1 .. L => 'A');
+                              C : COMPONENT := 2;
+                         WHEN FALSE =>
+                              F : FLOAT := 5.0;
+                    END CASE;
+               END RECORD;
+
+     END PKG_D;
+
+     USE PKG_D;
+
+     SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_BOOL (TRUE),
+                                          IDENT_INT (3));
+
+     PACKAGE PKG_P IS
+
+          TYPE PARENT IS ACCESS DESIGNATED;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            C : COMPONENT;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG_P;
+
+     USE PKG_P;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     X : T       := NEW DESIGNATED (TRUE, 3);
+     K : INTEGER := X'SIZE;
+     Y : T       := NEW DESIGNATED (TRUE, 3);
+     W : PARENT  := NEW DESIGNATED (TRUE, 3);
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          NULL;
+     END A;
+
+     PACKAGE BODY PKG_D IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT;
+               F : FLOAT
+             ) RETURN DESIGNATED
+          IS
+          BEGIN
+               CASE B IS
+                    WHEN TRUE =>
+                         RETURN (TRUE, L, I, S, C);
+                    WHEN FALSE =>
+                         RETURN (FALSE, L, I, F);
+               END CASE;
+          END CREATE;
+
+     END PKG_D;
+
+     PACKAGE BODY PKG_P IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               RETURN NEW DESIGNATED'(CREATE (B, L, I, S, C, F));
+          END CREATE;
+
+     END PKG_P;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF X = NULL OR ELSE EQUAL (X.L, X.L) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN NEW DESIGNATED'(CREATE (TRUE, 3, -1, "---", -1, -1.0));
+     END IDENT;
+
+BEGIN
+     TEST ("C34007S", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "PRIVATE TYPE WITH DISCRIMINANTS");
+
+     Y.ALL := CREATE (TRUE, 3, 1, "ABC", 4, 1.0);
+     IF Y = NULL OR ELSE
+        Y.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) THEN
+          FAILED ("INCORRECT INITIALIZATION");
+     END IF;
+
+     X := IDENT (Y);
+     IF X /= Y THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= Y THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= Y THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0));
+     END IF;
+     X := T (W);
+     IF X = NULL OR ELSE X = Y OR ELSE
+        X.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     X := IDENT (Y);
+     W := PARENT (X);
+     IF W = NULL OR ELSE
+        W.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) OR ELSE
+        T (W) /= Y THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT - 1");
+     END IF;
+
+     W := PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X));
+     IF W = NULL OR ELSE
+        W.ALL /= CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+     END IF;
+
+     IF IDENT (NULL) /= NULL OR X = NULL THEN
+          FAILED ("INCORRECT NULL");
+     END IF;
+
+     X := IDENT (NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0)));
+     IF (X = NULL OR ELSE X = Y OR ELSE
+         X.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0)) OR
+        X = NEW DESIGNATED'(CREATE (FALSE, 3, 1, "XXX", 5, 4.0)) THEN
+          FAILED ("INCORRECT ALLOCATOR");
+     END IF;
+
+     X := IDENT (Y);
+     IF X.B /= TRUE OR X.L /= 3 OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
+          FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+     END IF;
+
+     IF X.ALL /= CREATE (TRUE, 3, 1, "ABC", 4, 2.0) OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL /=
+        CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) THEN
+          FAILED ("INCORRECT .ALL (VALUE)");
+     END IF;
+
+     X.ALL := CREATE (TRUE, 3, 10, "ZZZ", 15, 1.0);
+     IF X /= Y OR Y.ALL /= CREATE (TRUE, 3, 10, "ZZZ", 15, 2.0) THEN
+          FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+     END IF;
+
+     Y.ALL := CREATE (TRUE, 3, 1, "ABC", 4, 1.0);
+     BEGIN
+          CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . ALL :=
+               CREATE (FALSE, 2, 10, "ZZ", 7, 15.0);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
+     END;
+
+     X := IDENT (NULL);
+     BEGIN
+          IF X.ALL = CREATE (FALSE, 0, 0, "", 0, 0.0) THEN
+               FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
+          ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION FOR NULL.ALL");
+     END;
+
+     X := IDENT (Y);
+     IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
+        X = CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= Y OR NOT (X /= NULL) OR
+        NOT (X /= CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) OR CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR
+        NOT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     A (X'ADDRESS);
+
+     IF T'SIZE < 1 THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     BEGIN
+          IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
+               FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
+                       "EQUAL TO COLLECTION SIZE OF PARENT TYPE");
+          END IF;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED FOR " &
+                        "UNDEFINED STORAGE_SIZE (AI-00608)");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C34007S;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007u.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007u.ada
new file mode 100644
index 000000000..05c699025
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007u.ada
@@ -0,0 +1,266 @@
+-- C34007U.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 ACCESS TYPES WHOSE DESIGNATED TYPE IS A PRIVATE TYPE
+-- WITH DISCRIMINANTS:
+
+--   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 9/30/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007U IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     PACKAGE PKG_D IS
+
+          SUBTYPE LENGTH IS NATURAL RANGE 0 .. 10;
+
+          TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+                          PRIVATE;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            C : COMPONENT;
+                            F : FLOAT
+                          ) RETURN DESIGNATED;
+
+     PRIVATE
+
+          TYPE DESIGNATED (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+               RECORD
+                    I : INTEGER := 2;
+                    CASE B IS
+                         WHEN TRUE =>
+                              S : STRING (1 .. L) := (1 .. L => 'A');
+                              C : COMPONENT := 2;
+                         WHEN FALSE =>
+                              F : FLOAT := 5.0;
+                    END CASE;
+               END RECORD;
+
+     END PKG_D;
+
+     USE PKG_D;
+
+     PACKAGE PKG_P IS
+
+          TYPE PARENT IS ACCESS DESIGNATED;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            C : COMPONENT;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG_P;
+
+     USE PKG_P;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T := NEW DESIGNATED (TRUE, 3);
+     Y : S := NEW DESIGNATED (TRUE, 3);
+
+     PACKAGE BODY PKG_D IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT;
+               F : FLOAT
+             ) RETURN DESIGNATED
+          IS
+          BEGIN
+               CASE B IS
+                    WHEN TRUE =>
+                         RETURN (TRUE, L, I, S, C);
+                    WHEN FALSE =>
+                         RETURN (FALSE, L, I, F);
+               END CASE;
+          END CREATE;
+
+     END PKG_D;
+
+     PACKAGE BODY PKG_P IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               C : COMPONENT;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               RETURN NEW DESIGNATED'(CREATE (B, L, I, S, C, F));
+          END CREATE;
+
+     END PKG_P;
+
+BEGIN
+     TEST ("C34007U", "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 " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "PRIVATE TYPE WITH DISCRIMINANTS");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     IF CREATE (FALSE, 2, 3, "WW", 5, 6.0, X) . ALL /=
+        CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) OR
+        CREATE (FALSE, 2, 3, "WW", 5, 6.0, Y) . ALL /=
+        CREATE (FALSE, 2, 3, "ZZ", 7, 6.0) THEN
+          FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+     END IF;
+
+     IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
+        CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF X.B /= TRUE OR X.L /= 3 OR
+        Y.B /= TRUE OR Y.L /= 3 THEN
+          FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+     END IF;
+
+     BEGIN
+          X := NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0));
+          Y := NEW DESIGNATED'(CREATE (TRUE, 3, 1, "ABC", 4, 1.0));
+          IF PARENT (X) = PARENT (Y) OR  -- USE X AND Y.
+             X.ALL /= Y.ALL THEN
+               FAILED ("INCORRECT ALLOCATOR OR CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := NEW DESIGNATED'(CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := NEW DESIGNATED'" &
+                  "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+          IF X = NULL OR ELSE
+             X.ALL = CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := NEW DESIGNATED'" &
+                        "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := NEW DESIGNATED'" &
+                       "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+     END;
+
+     BEGIN
+          X := NEW DESIGNATED'(CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := NEW DESIGNATED'" &
+                  "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+          IF X = NULL OR ELSE
+             X.ALL = CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := NEW DESIGNATED'" &
+                        "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := NEW DESIGNATED'" &
+                       "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+     END;
+
+     BEGIN
+          Y := NEW DESIGNATED'(CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := NEW DESIGNATED'" &
+                  "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+          IF Y = NULL OR ELSE
+             Y.ALL = CREATE (FALSE, 3, 2, "ZZZ", 5, 6.0) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := NEW DESIGNATED'" &
+                        "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := NEW DESIGNATED'" &
+                       "(CREATE (FALSE, 3, 2, ""ZZZ"", 5, 6.0))");
+     END;
+
+     BEGIN
+          Y := NEW DESIGNATED'(CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := NEW DESIGNATED'" &
+                  "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+          IF Y = NULL OR ELSE
+             Y.ALL = CREATE (TRUE, 4, 2, "ZZZZ", 6, 7.0) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := NEW DESIGNATED'" &
+                        "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := NEW DESIGNATED'" &
+                       "(CREATE (TRUE, 4, 2, ""ZZZZ"", 6, 7.0))");
+     END;
+
+     RESULT;
+END C34007U;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007v.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007v.ada
new file mode 100644
index 000000000..8ee4bf829
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34007v.ada
@@ -0,0 +1,183 @@
+-- C34007V.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED ACCESS TYPES WHOSE DESIGNATED TYPE IS A
+--     ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS PART 2 OF 2 TESTS
+--     WHICH COVER THE OBJECTIVE.  THE FIRST PART IS IN TEST C34007D.
+
+-- HISTORY:
+--     BCB 04/12/90  CREATED ORIGINAL TEST FROM SPLIT OF C34007D.ADA.
+--     THS 09/18/90  REMOVED DECLARATION OF B, DELETED PROCEDURE A,
+--                   AND REMOVED ALL REFERENCES TO B.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34007V IS
+
+     SUBTYPE COMPONENT IS INTEGER;
+
+     TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT;
+
+     SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_INT (5) ..
+                                          IDENT_INT (7));
+
+     PACKAGE PKG IS
+
+          TYPE PARENT IS ACCESS DESIGNATED;
+
+          FUNCTION CREATE ( F, L  : NATURAL;
+                            C     : COMPONENT;
+                            DUMMY : PARENT   -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
+
+     X : T         := NEW SUBDESIGNATED'(OTHERS => 2);
+     K : INTEGER   := X'SIZE;
+     Y : T         := NEW SUBDESIGNATED'(1, 2, 3);
+     W : PARENT    := NEW SUBDESIGNATED'(OTHERS => 2);
+     C : COMPONENT := 1;
+     N : CONSTANT  := 1;
+
+     FUNCTION V RETURN T IS
+     BEGIN
+          RETURN NEW SUBDESIGNATED'(OTHERS => C);
+     END V;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( F, L  : NATURAL;
+               C     : COMPONENT;
+               DUMMY : PARENT
+             ) RETURN PARENT
+          IS
+               A : PARENT    := NEW DESIGNATED (F .. L);
+               B : COMPONENT := C;
+          BEGIN
+               FOR I IN F .. L LOOP
+                    A (I) := B;
+                    B := B + 1;
+               END LOOP;
+               RETURN A;
+          END CREATE;
+
+     END PKG;
+
+     FUNCTION IDENT (X : T) RETURN T IS
+     BEGIN
+          IF X = NULL OR ELSE
+             EQUAL (X'LENGTH, X'LENGTH) THEN
+               RETURN X;                          -- ALWAYS EXECUTED.
+          END IF;
+          RETURN NEW SUBDESIGNATED;
+     END IDENT;
+
+BEGIN
+     TEST ("C34007V", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
+                      "ONE-DIMENSIONAL ARRAY TYPE.  THIS TEST IS " &
+                      "PART 2 OF 2 TESTS WHICH COVER THE OBJECTIVE.  " &
+                      "THE FIRST PART IS IN TEST C34007V");
+
+     W := PARENT (CREATE (2, 3, 4, X));
+     IF W = NULL OR ELSE W.ALL /= (4, 5) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT - 2");
+     END IF;
+
+     X := IDENT (Y);
+     IF X.ALL /= (1, 2, 3) OR CREATE (2, 3, 4, X) . ALL /= (4, 5) THEN
+          FAILED ("INCORRECT .ALL (VALUE)");
+     END IF;
+
+     X.ALL := (10, 11, 12);
+     IF X /= Y OR Y.ALL /= (10, 11, 12) THEN
+          FAILED ("INCORRECT .ALL (ASSIGNMENT)");
+     END IF;
+
+     Y.ALL := (1, 2, 3);
+     BEGIN
+          CREATE (2, 3, 4, X) . ALL := (10, 11);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
+     END;
+
+
+     X := IDENT (Y);
+     IF X (IDENT_INT (5)) /= 1 OR
+        CREATE (2, 3, 4, X) (3) /= 5 THEN
+          FAILED ("INCORRECT INDEX (VALUE)");
+     END IF;
+
+     Y.ALL := (1, 2, 3);
+     X := IDENT (Y);
+     BEGIN
+          CREATE (2, 3, 4, X) (2) := 10;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION FOR INDEX (ASSIGNMENT)");
+     END;
+
+     IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2, 3) OR
+        CREATE (1, 4, 4, X) (1 .. 3) /= (4, 5, 6) THEN
+          FAILED ("INCORRECT SLICE (VALUE)");
+     END IF;
+
+     Y.ALL := (1, 2, 3);
+     X := IDENT (Y);
+     BEGIN
+          CREATE (1, 4, 4, X) (2 .. 4) := (10, 11, 12);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION FOR SLICE (ASSIGNMENT)");
+     END;
+
+     IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
+        X = CREATE (2, 3, 4, X) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= Y OR NOT (X /= NULL) OR NOT (X /= CREATE (2, 3, 4, X)) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) OR CREATE (2, 3, 4, X) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT (CREATE (2, 3, 4, X) NOT IN T) THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     RESULT;
+END C34007V;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34008a.ada
new file mode 100644
index 000000000..5af4e3a56
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34008a.ada
@@ -0,0 +1,226 @@
+-- C34008A.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED TASK TYPES.
+
+-- HISTORY:
+--     JRK 08/27/87  CREATED ORIGINAL TEST.
+--     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+--     DTN 11/30/95  REMOVED ATTIBUTES OF NON-OBJECTS.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34008A IS
+
+     PACKAGE PKG IS
+
+          TASK TYPE PARENT IS
+               ENTRY E (I : IN OUT INTEGER);
+               ENTRY F (1 .. 3) (I : INTEGER; J : OUT INTEGER);
+               ENTRY G;
+               ENTRY H (1 .. 3);
+               ENTRY R (I : OUT INTEGER);
+               ENTRY W (I : INTEGER);
+          END PARENT;
+
+          FUNCTION ID (X : PARENT) RETURN INTEGER;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT;
+
+     TASK TYPE AUX;
+
+     X : T;
+     W : PARENT;
+     B : BOOLEAN := FALSE;
+     I : INTEGER := 0;
+     J : INTEGER := 0;
+     A1, A2 : AUX;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     FUNCTION V RETURN T IS
+     BEGIN
+          RETURN X;
+     END V;
+
+     PACKAGE BODY PKG IS
+
+          TASK BODY PARENT IS
+               N : INTEGER := 1;
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT E (I : IN OUT INTEGER) DO
+                              I := I + N;
+                         END E;
+                    OR
+                         ACCEPT F (2) (I : INTEGER; J : OUT INTEGER) DO
+                              J := I + N;
+                         END F;
+                    OR
+                         ACCEPT G DO
+                              WHILE H(2)'COUNT < 2 LOOP
+                                   DELAY 5.0;
+                              END LOOP;
+                              ACCEPT H (2) DO
+                                   IF E'COUNT    /= 0 OR
+                                      F(1)'COUNT /= 0 OR
+                                      F(2)'COUNT /= 0 OR
+                                      F(3)'COUNT /= 0 OR
+                                      G'COUNT    /= 0 OR
+                                      H(1)'COUNT /= 0 OR
+                                      H(2)'COUNT /= 1 OR
+                                      H(3)'COUNT /= 0 OR
+                                      R'COUNT    /= 0 OR
+                                      W'COUNT    /= 0 THEN
+                                        FAILED ("INCORRECT 'COUNT");
+                                   END IF;
+                              END H;
+                              ACCEPT H (2);
+                         END G;
+                    OR
+                         ACCEPT R (I : OUT INTEGER) DO
+                              I := N;
+                         END R;
+                    OR
+                         ACCEPT W (I : INTEGER) DO
+                              N := I;
+                         END W;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END PARENT;
+
+          FUNCTION ID (X : PARENT) RETURN INTEGER IS
+               I : INTEGER;
+          BEGIN
+               X.R (I);
+               RETURN I;
+          END ID;
+
+     END PKG;
+
+     TASK BODY AUX IS
+     BEGIN
+          X.H (2);
+     END AUX;
+
+BEGIN
+     TEST ("C34008A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED TASK " &
+                      "TYPES");
+
+     X.W (IDENT_INT (2));
+     IF ID (X) /= 2 THEN
+          FAILED ("INCORRECT INITIALIZATION");
+     END IF;
+
+     IF ID (T'(X)) /= 2 THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF ID (T (X)) /= 2 THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     W.W (IDENT_INT (3));
+     IF ID (T (W)) /= 3 THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF ID (PARENT (X)) /= 2 THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     I := 5;
+     X.E (I);
+     IF I /= 7 THEN
+          FAILED ("INCORRECT SELECTION (ENTRY)");
+     END IF;
+
+     I := 5;
+     X.F (IDENT_INT (2)) (I, J);
+     IF J /= 7 THEN
+          FAILED ("INCORRECT SELECTION (FAMILY)");
+     END IF;
+
+     IF NOT (X IN T) THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+
+     B := FALSE;
+     A (X'ADDRESS);
+     IF NOT B THEN
+          FAILED ("INCORRECT OBJECT'ADDRESS");
+     END IF;
+
+     IF NOT X'CALLABLE THEN
+          FAILED ("INCORRECT OBJECT'CALLABLE");
+     END IF;
+
+     IF NOT V'CALLABLE THEN
+          FAILED ("INCORRECT VALUE'CALLABLE");
+     END IF;
+
+     X.G;
+
+     IF X'SIZE < T'SIZE THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     IF T'STORAGE_SIZE < 0 THEN
+          FAILED ("INCORRECT TYPE'STORAGE_SIZE");
+     END IF;
+
+     IF X'STORAGE_SIZE < 0 THEN
+          FAILED ("INCORRECT OBJECT'STORAGE_SIZE");
+     END IF;
+
+     IF X'TERMINATED THEN
+          FAILED ("INCORRECT OBJECT'TERMINATED");
+     END IF;
+
+     IF V'TERMINATED THEN
+          FAILED ("INCORRECT VALUE'TERMINATED");
+     END IF;
+
+     RESULT;
+END C34008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009a.ada
new file mode 100644
index 000000000..6cda3277f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009a.ada
@@ -0,0 +1,134 @@
+-- C34009A.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED NON-LIMITED PRIVATE TYPES WITHOUT
+--     DISCRIMINANTS.
+
+-- HISTORY:
+--     JRK 08/28/87  CREATED ORIGINAL TEST.
+--     BCB 09/26/88  REMOVED COMPARISON INVOLVING OBJECT SIZE.
+--     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34009A IS
+
+     PACKAGE PKG IS
+
+          TYPE PARENT IS PRIVATE;
+
+          FUNCTION CREATE (X : INTEGER) RETURN PARENT;
+
+          FUNCTION CON (X : INTEGER) RETURN PARENT;
+
+     PRIVATE
+
+          TYPE PARENT IS NEW INTEGER;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT;
+
+     X : T;
+     K : INTEGER := X'SIZE;
+     W : PARENT;
+     B : BOOLEAN := FALSE;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE (X : INTEGER) RETURN PARENT IS
+          BEGIN
+               RETURN PARENT (IDENT_INT (X));
+          END CREATE;
+
+          FUNCTION CON (X : INTEGER) RETURN PARENT IS
+          BEGIN
+               RETURN PARENT (X);
+          END CON;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34009A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "NON-LIMITED PRIVATE TYPES WITHOUT " &
+                      "DISCRIMINANTS");
+
+     X := CREATE (30);
+     IF X /= CON (30) THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= CON (30) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= CON (30) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     W := CREATE (-30);
+     IF T (W) /= CON (-30) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF PARENT (X) /= CON (30) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF X = CON (0) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= CON (30) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T THEN
+          FAILED ("INCORRECT ""NOT IN""");
+     END IF;
+
+     B := FALSE;
+     A (X'ADDRESS);
+     IF NOT B THEN
+          FAILED ("INCORRECT 'ADDRESS");
+     END IF;
+
+     RESULT;
+END C34009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009d.ada
new file mode 100644
index 000000000..c65441f57
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009d.ada
@@ -0,0 +1,226 @@
+-- C34009D.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED NON-LIMITED PRIVATE TYPES WITH
+--     DISCRIMINANTS.
+
+-- HISTORY:
+--     JRK 08/31/87  CREATED ORIGINAL TEST.
+--     WMC 03/13/92  REVISED TYPE'SIZE CHECKS.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34009D IS
+
+     PACKAGE PKG IS
+
+          MAX_LEN : CONSTANT := 10;
+
+          SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS PRIVATE;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            J : INTEGER;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION CON ( B : BOOLEAN;
+                         L : LENGTH;
+                         I : INTEGER;
+                         S : STRING;
+                         J : INTEGER
+                       ) RETURN PARENT;
+
+          FUNCTION CON ( B : BOOLEAN;
+                         L : LENGTH;
+                         I : INTEGER;
+                         F : FLOAT
+                       ) RETURN PARENT;
+
+     PRIVATE
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+               RECORD
+                    I : INTEGER;
+                    CASE B IS
+                         WHEN TRUE =>
+                              S : STRING (1 .. L);
+                              J : INTEGER;
+                         WHEN FALSE =>
+                              F : FLOAT := 5.0;
+                    END CASE;
+               END RECORD;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     X : T;
+     W : PARENT;
+     B : BOOLEAN := FALSE;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               J : INTEGER;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               CASE B IS
+                    WHEN TRUE =>
+                         RETURN (TRUE, L, I, S, J);
+                    WHEN FALSE =>
+                         RETURN (FALSE, L, I, F);
+               END CASE;
+          END CREATE;
+
+          FUNCTION CON
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               J : INTEGER
+             ) RETURN PARENT
+          IS
+          BEGIN
+               RETURN (TRUE, L, I, S, J);
+          END CON;
+
+          FUNCTION CON
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               F : FLOAT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               RETURN (FALSE, L, I, F);
+          END CON;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34009D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
+
+     X := CON (TRUE, 3, 2, "AAA", 2);
+     W := CON (TRUE, 3, 2, "AAA", 2);
+
+     IF EQUAL (3, 3) THEN
+          X := CON (TRUE, 3, 1, "ABC", 4);
+     END IF;
+     IF X /= CON (TRUE, 3, 1, "ABC", 4) THEN
+          FAILED ("INCORRECT :=");
+     END IF;
+
+     IF T'(X) /= CON (TRUE, 3, 1, "ABC", 4) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF T (X) /= CON (TRUE, 3, 1, "ABC", 4) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          W := CON (TRUE, 3, 1, "ABC", 4);
+     END IF;
+     IF T (W) /= CON (TRUE, 3, 1, "ABC", 4) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF PARENT (X) /= CON (TRUE, 3, 1, "ABC", 4) OR
+        PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) /=
+        CON (FALSE, 2, 3, 6.0) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF X.B /= TRUE OR X.L /= 3 OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
+          FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+     END IF;
+
+     IF X = CON (TRUE, 3, 1, "ABC", 5) OR
+        X = CON (FALSE, 2, 3, 6.0) THEN
+          FAILED ("INCORRECT =");
+     END IF;
+
+     IF X /= CON (TRUE, 3, 1, "ABC", 4) OR
+        NOT (X /= CON (FALSE, 2, 3, 6.0)) THEN
+          FAILED ("INCORRECT /=");
+     END IF;
+
+     IF NOT (X IN T) OR CON (FALSE, 2, 3, 6.0) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT (CON (FALSE, 2, 3, 6.0) 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 NOT X'CONSTRAINED THEN
+          FAILED ("INCORRECT OBJECT'CONSTRAINED");
+     END IF;
+
+     IF T'SIZE <= 0 THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     IF X'SIZE   < T'SIZE OR
+        X.B'SIZE < BOOLEAN'SIZE OR
+        X.L'SIZE < LENGTH'SIZE THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     RESULT;
+END C34009D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009f.ada
new file mode 100644
index 000000000..63716c564
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009f.ada
@@ -0,0 +1,256 @@
+-- C34009F.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:
+--     FOR DERIVED NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS:
+
+--        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.
+
+-- HISTORY:
+--     JRK 08/31/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34009F IS
+
+     PACKAGE PKG IS
+
+          MAX_LEN : CONSTANT := 10;
+
+          SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS PRIVATE;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            J : INTEGER;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION CON ( B : BOOLEAN;
+                         L : LENGTH;
+                         I : INTEGER;
+                         S : STRING;
+                         J : INTEGER
+                       ) RETURN PARENT;
+
+          FUNCTION CON ( B : BOOLEAN;
+                         L : LENGTH;
+                         I : INTEGER;
+                         F : FLOAT
+                       ) RETURN PARENT;
+
+     PRIVATE
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
+               RECORD
+                    I : INTEGER;
+                    CASE B IS
+                         WHEN TRUE =>
+                              S : STRING (1 .. L);
+                              J : INTEGER;
+                         WHEN FALSE =>
+                              F : FLOAT := 5.0;
+                    END CASE;
+               END RECORD;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T;
+     Y : S;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               J : INTEGER;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               CASE B IS
+                    WHEN TRUE =>
+                         RETURN (TRUE, L, I, S, J);
+                    WHEN FALSE =>
+                         RETURN (FALSE, L, I, F);
+               END CASE;
+          END CREATE;
+
+          FUNCTION CON
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               J : INTEGER
+             ) RETURN PARENT
+          IS
+          BEGIN
+               RETURN (TRUE, L, I, S, J);
+          END CON;
+
+          FUNCTION CON
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               F : FLOAT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               RETURN (FALSE, L, I, F);
+          END CON;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34009F", "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 " &
+                      "NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
+
+     X := CON (TRUE, 3, 2, "AAA", 2);
+     Y := CON (TRUE, 3, 2, "AAA", 2);
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) /=
+        CON (FALSE, 2, 3, 6.0) OR
+        CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) /=
+        CON (FALSE, 2, 3, 6.0) THEN
+          FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+     END IF;
+
+     IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
+        CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF X.B /= TRUE OR X.L /= 3 OR
+        Y.B /= TRUE OR Y.L /= 3 THEN
+          FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+     END IF;
+
+     IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
+          FAILED ("INCORRECT 'CONSTRAINED");
+     END IF;
+
+     BEGIN
+          X := CON (TRUE, 3, 1, "ABC", 4);
+          Y := CON (TRUE, 3, 1, "ABC", 4);
+          IF PARENT (X) /= PARENT (Y) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGNMENT");
+     END;
+
+     BEGIN
+          X := CON (FALSE, 3, 2, 6.0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := CON (FALSE, 3, 2, 6.0)");
+          IF X = CON (FALSE, 3, 2, 6.0) THEN  -- USE X.
+               COMMENT ("X ALTERED -- X := CON (FALSE, 3, 2, 6.0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := CON (FALSE, 3, 2, 6.0)");
+     END;
+
+     BEGIN
+          X := CON (TRUE, 4, 2, "ZZZZ", 6);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "X := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+          IF X = CON (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "X := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "X := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+     END;
+
+     BEGIN
+          Y := CON (FALSE, 3, 2, 6.0);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := CON (FALSE, 3, 2, 6.0)");
+          IF Y = CON (FALSE, 3, 2, 6.0) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- Y := CON (FALSE, 3, 2, 6.0)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := CON (FALSE, 3, 2, 6.0)");
+     END;
+
+     BEGIN
+          Y := CON (TRUE, 4, 2, "ZZZZ", 6);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "Y := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+          IF Y = CON (TRUE, 4, 2, "ZZZZ", 6) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "Y := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "Y := CON (TRUE, 4, 2, ""ZZZZ"", 6)");
+     END;
+
+     RESULT;
+END C34009F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009g.ada
new file mode 100644
index 000000000..a225347a7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009g.ada
@@ -0,0 +1,137 @@
+-- C34009G.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED LIMITED PRIVATE TYPES WITHOUT
+--     DISCRIMINANTS.
+
+-- HISTORY:
+--     JRK 09/01/87  CREATED ORIGINAL TEST.
+--     PWN 11/30/94  REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34009G IS
+
+     PACKAGE PKG IS
+
+          TYPE PARENT IS LIMITED PRIVATE;
+
+          FUNCTION CREATE (X : INTEGER) RETURN PARENT;
+
+          FUNCTION CON (X : INTEGER) RETURN PARENT;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT);
+
+     PRIVATE
+
+          TYPE PARENT IS NEW INTEGER;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT;
+
+     X : T;
+     W : PARENT;
+     B : BOOLEAN := FALSE;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE (X : INTEGER) RETURN PARENT IS
+          BEGIN
+               RETURN PARENT (IDENT_INT (X));
+          END CREATE;
+
+          FUNCTION CON (X : INTEGER) RETURN PARENT IS
+          BEGIN
+               RETURN PARENT (X);
+          END CON;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34009G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS");
+
+     ASSIGN (X, CREATE (30));
+     IF NOT EQUAL (T'(X), CON (30)) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF NOT EQUAL (T (X), CON (30)) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     ASSIGN (W, CREATE (-30));
+     IF NOT EQUAL (T (W), CON (-30)) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF NOT EQUAL (PARENT (X), CON (30)) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF NOT (X IN T) THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X 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 X'SIZE < T'SIZE THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     RESULT;
+END C34009G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009j.ada
new file mode 100644
index 000000000..f095fad15
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009j.ada
@@ -0,0 +1,225 @@
+-- C34009J.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
+--     (IMPLICITLY) FOR DERIVED LIMITED PRIVATE TYPES WITH
+--     DISCRIMINANTS.
+
+-- HISTORY:
+--     JRK 09/01/87  CREATED ORIGINAL TEST.
+--     WMC 03/13/92  REVISED TYPE'SIZE CHECKS.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34009J IS
+
+     PACKAGE PKG IS
+
+          MAX_LEN : CONSTANT := 10;
+
+          SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+                      LIMITED PRIVATE;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            J : INTEGER;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION CON ( B : BOOLEAN;
+                         L : LENGTH;
+                         I : INTEGER;
+                         S : STRING;
+                         J : INTEGER
+                       ) RETURN PARENT;
+
+          FUNCTION CON ( B : BOOLEAN;
+                         L : LENGTH;
+                         I : INTEGER;
+                         F : FLOAT
+                       ) RETURN PARENT;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT);
+
+     PRIVATE
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+               RECORD
+                    I : INTEGER := 2;
+                    CASE B IS
+                         WHEN TRUE =>
+                              S : STRING (1 .. L) := (1 .. L => 'A');
+                              J : INTEGER := 2;
+                         WHEN FALSE =>
+                              F : FLOAT := 5.0;
+                    END CASE;
+               END RECORD;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     X : T;
+     W : PARENT;
+     B : BOOLEAN := FALSE;
+
+     PROCEDURE A (X : ADDRESS) IS
+     BEGIN
+          B := IDENT_BOOL (TRUE);
+     END A;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               J : INTEGER;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               CASE B IS
+                    WHEN TRUE =>
+                         RETURN (TRUE, L, I, S, J);
+                    WHEN FALSE =>
+                         RETURN (FALSE, L, I, F);
+               END CASE;
+          END CREATE;
+
+          FUNCTION CON
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               J : INTEGER
+             ) RETURN PARENT
+          IS
+          BEGIN
+               RETURN (TRUE, L, I, S, J);
+          END CON;
+
+          FUNCTION CON
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               F : FLOAT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               RETURN (FALSE, L, I, F);
+          END CON;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34009J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
+                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
+                      "LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
+
+     IF EQUAL (3, 3) THEN
+          ASSIGN (X, CON (TRUE, 3, 1, "ABC", 4));
+     END IF;
+     IF NOT EQUAL (T'(X), CON (TRUE, 3, 1, "ABC", 4)) THEN
+          FAILED ("INCORRECT QUALIFICATION");
+     END IF;
+
+     IF NOT EQUAL (T (X), CON (TRUE, 3, 1, "ABC", 4)) THEN
+          FAILED ("INCORRECT SELF CONVERSION");
+     END IF;
+
+     IF EQUAL (3, 3) THEN
+          ASSIGN (W, CON (TRUE, 3, 1, "ABC", 4));
+     END IF;
+     IF NOT EQUAL (T (W), CON (TRUE, 3, 1, "ABC", 4)) THEN
+          FAILED ("INCORRECT CONVERSION FROM PARENT");
+     END IF;
+
+     IF NOT EQUAL (PARENT (X), CON (TRUE, 3, 1, "ABC", 4)) OR
+        NOT EQUAL (PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)),
+                   CON (FALSE, 2, 3, 6.0)) THEN
+          FAILED ("INCORRECT CONVERSION TO PARENT");
+     END IF;
+
+     IF X.B /= TRUE OR X.L /= 3 OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
+        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
+          FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
+     END IF;
+
+     IF NOT (X IN T) OR CON (FALSE, 2, 3, 6.0) IN T THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     IF X NOT IN T OR NOT (CON (FALSE, 2, 3, 6.0) 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 NOT X'CONSTRAINED THEN
+          FAILED ("INCORRECT OBJECT'CONSTRAINED");
+     END IF;
+
+     IF T'SIZE <= 0 THEN
+          FAILED ("INCORRECT TYPE'SIZE");
+     END IF;
+
+     IF X'SIZE   < T'SIZE OR
+        X.B'SIZE < BOOLEAN'SIZE OR
+        X.L'SIZE < LENGTH'SIZE THEN
+          FAILED ("INCORRECT OBJECT'SIZE");
+     END IF;
+
+     RESULT;
+END C34009J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009l.ada
new file mode 100644
index 000000000..71a02f28b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34009l.ada
@@ -0,0 +1,270 @@
+-- C34009L.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:
+--     FOR DERIVED LIMITED PRIVATE TYPES WITH DISCRIMINANTS:
+
+--        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.
+
+-- HISTORY:
+--     JRK 09/01/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34009L IS
+
+     PACKAGE PKG IS
+
+          MAX_LEN : CONSTANT := 10;
+
+          SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+                      LIMITED PRIVATE;
+
+          FUNCTION CREATE ( B : BOOLEAN;
+                            L : LENGTH;
+                            I : INTEGER;
+                            S : STRING;
+                            J : INTEGER;
+                            F : FLOAT;
+                            X : PARENT  -- TO RESOLVE OVERLOADING.
+                          ) RETURN PARENT;
+
+          FUNCTION CON ( B : BOOLEAN;
+                         L : LENGTH;
+                         I : INTEGER;
+                         S : STRING;
+                         J : INTEGER
+                       ) RETURN PARENT;
+
+          FUNCTION CON ( B : BOOLEAN;
+                         L : LENGTH;
+                         I : INTEGER;
+                         F : FLOAT
+                       ) RETURN PARENT;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
+
+          PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT);
+
+     PRIVATE
+
+          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 3) IS
+               RECORD
+                    I : INTEGER := 2;
+                    CASE B IS
+                         WHEN TRUE =>
+                              S : STRING (1 .. L) := (1 .. L => 'A');
+                              J : INTEGER := 2;
+                         WHEN FALSE =>
+                              F : FLOAT := 5.0;
+                    END CASE;
+               END RECORD;
+
+     END PKG;
+
+     USE PKG;
+
+     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
+
+     SUBTYPE SUBPARENT IS PARENT (TRUE, 3);
+
+     TYPE S IS NEW SUBPARENT;
+
+     X : T;
+     Y : S;
+
+     PACKAGE BODY PKG IS
+
+          FUNCTION CREATE
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               J : INTEGER;
+               F : FLOAT;
+               X : PARENT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               CASE B IS
+                    WHEN TRUE =>
+                         RETURN (TRUE, L, I, S, J);
+                    WHEN FALSE =>
+                         RETURN (FALSE, L, I, F);
+               END CASE;
+          END CREATE;
+
+          FUNCTION CON
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               S : STRING;
+               J : INTEGER
+             ) RETURN PARENT
+          IS
+          BEGIN
+               RETURN (TRUE, L, I, S, J);
+          END CON;
+
+          FUNCTION CON
+             ( B : BOOLEAN;
+               L : LENGTH;
+               I : INTEGER;
+               F : FLOAT
+             ) RETURN PARENT
+          IS
+          BEGIN
+               RETURN (FALSE, L, I, F);
+          END CON;
+
+          FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END EQUAL;
+
+          PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT) IS
+          BEGIN
+               X := Y;
+          END ASSIGN;
+
+     END PKG;
+
+BEGIN
+     TEST ("C34009L", "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 " &
+                      "LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
+
+     -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT.
+
+     IF NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X),
+                   CON (FALSE, 2, 3, 6.0)) OR
+        NOT EQUAL (CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y),
+                   CON (FALSE, 2, 3, 6.0)) THEN
+          FAILED ("CAN'T CREATE BASE TYPE VALUES OUTSIDE THE SUBTYPE");
+     END IF;
+
+     IF CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, X) IN T OR
+        CREATE (FALSE, 2, 3, "ZZ", 5, 6.0, Y) IN S THEN
+          FAILED ("INCORRECT ""IN""");
+     END IF;
+
+     -- CHECK THE DERIVED SUBTYPE CONSTRAINT.
+
+     IF X.B /= TRUE OR X.L /= 3 OR
+        Y.B /= TRUE OR Y.L /= 3 THEN
+          FAILED ("INCORRECT SELECTION OF DISCRIMINANT VALUES");
+     END IF;
+
+     IF NOT X'CONSTRAINED OR NOT Y'CONSTRAINED THEN
+          FAILED ("INCORRECT 'CONSTRAINED");
+     END IF;
+
+     BEGIN
+          ASSIGN (X, CON (TRUE, 3, 1, "ABC", 4));
+          ASSIGN (Y, CON (TRUE, 3, 1, "ABC", 4));
+          IF NOT EQUAL (PARENT (X), PARENT (Y)) THEN  -- USE X AND Y.
+               FAILED ("INCORRECT CONVERSION TO PARENT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY OK ASSIGN CALL");
+     END;
+
+     BEGIN
+          ASSIGN (X, CON (FALSE, 3, 2, 6.0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (X, CON (FALSE, 3, 2, 6.0))");
+          IF EQUAL (X, CON (FALSE, 3, 2, 6.0)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "ASSIGN (X, CON (FALSE, 3, 2, 6.0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (X, CON (FALSE, 3, 2, 6.0))");
+     END;
+
+     BEGIN
+          ASSIGN (X, CON (TRUE, 4, 2, "ZZZZ", 6));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (X, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+          IF EQUAL (X, CON (TRUE, 4, 2, "ZZZZ", 6)) THEN  -- USE X.
+               COMMENT ("X ALTERED -- " &
+                        "ASSIGN (X, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (X, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+     END;
+
+     BEGIN
+          ASSIGN (Y, CON (FALSE, 3, 2, 6.0));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (Y, CON (FALSE, 3, 2, 6.0))");
+          IF EQUAL (Y, CON (FALSE, 3, 2, 6.0)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "ASSIGN (Y, CON (FALSE, 3, 2, 6.0))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (Y, CON (FALSE, 3, 2, 6.0))");
+     END;
+
+     BEGIN
+          ASSIGN (Y, CON (TRUE, 4, 2, "ZZZZ", 6));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED -- " &
+                  "ASSIGN (Y, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+          IF EQUAL (Y, CON (TRUE, 4, 2, "ZZZZ", 6)) THEN  -- USE Y.
+               COMMENT ("Y ALTERED -- " &
+                        "ASSIGN (Y, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED -- " &
+                       "ASSIGN (Y, CON (TRUE, 4, 2, ""ZZZZ"", 6))");
+     END;
+
+     RESULT;
+END C34009L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34011b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34011b.ada
new file mode 100644
index 000000000..47e260090
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34011b.ada
@@ -0,0 +1,343 @@
+-- C34011B.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 IS NOT CONSIDERED EXACTLY
+--     EQUIVALENT TO AN ANONYMOUS DECLARATION OF THE DERIVED TYPE
+--     FOLLOWED BY A SUBTYPE DECLARATION OF THE DERIVED SUBTYPE.  IN
+--     PARTICULAR, CHECK THAT CONSTRAINT_ERROR CAN BE RAISED WHEN THE
+--     SUBTYPE INDICATION OF THE DERIVED TYPE DECLARATION IS ELABORATED
+--     (EVEN THOUGH THE CONSTRAINT WOULD SATISFY THE DERIVED (BASE)
+--     TYPE).
+
+-- HISTORY:
+--     JRK 09/04/87  CREATED ORIGINAL TEST.
+--     EDS 07/29/98  AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34011B IS
+
+     SUBTYPE BOOL IS BOOLEAN RANGE FALSE .. FALSE;
+
+     SUBTYPE FLT IS FLOAT RANGE -10.0 .. 10.0;
+
+     SUBTYPE DUR IS DURATION RANGE 0.0 .. 10.0;
+
+     SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+
+     TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
+
+     TYPE REC (D : INT := 0) IS
+          RECORD
+               I : INTEGER;
+          END RECORD;
+
+     PACKAGE PT IS
+          TYPE PRIV (D : POSITIVE := 1) IS PRIVATE;
+     PRIVATE
+          TYPE PRIV (D : POSITIVE := 1) IS
+               RECORD
+                    I : INTEGER;
+               END RECORD;
+     END PT;
+
+     USE PT;
+
+     TYPE ACC_ARR IS ACCESS ARR;
+
+     TYPE ACC_REC IS ACCESS REC;
+
+BEGIN
+     TEST ("C34011B", "CHECK THAT CONSTRAINT_ERROR CAN BE RAISED " &
+                      "WHEN THE SUBTYPE INDICATION OF A DERIVED TYPE " &
+                      "DECLARATION IS ELABORATED");
+
+     BEGIN
+          DECLARE
+            TYPE T IS NEW BOOL RANGE FALSE .. BOOL(IDENT_BOOL(TRUE));
+
+          BEGIN
+            DECLARE
+               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+               T1 : T := T(IDENT_BOOL(TRUE));
+            BEGIN
+               FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+            EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
+                             " AT PROPER PLACE - BOOL " & 
+                             T'IMAGE(T1) );   --USE T1);
+            END;
+
+            FAILED ("EXCEPTION NOT RAISED - BOOL");
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER ENTERED - BOOL");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - BOOL");
+     END;
+
+     BEGIN
+          DECLARE
+            TYPE T IS NEW POSITIVE RANGE IDENT_INT (0) .. 10;
+
+          BEGIN
+            DECLARE
+               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+               T1 : T := T(IDENT_INT(1));
+            BEGIN
+                 FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+            EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR - POSITIVE " &
+                             T'IMAGE(T1)); --USE T1
+            END;
+            FAILED ("EXCEPTION NOT RAISED - POSITIVE" );
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER ENTERED - POSITIVE");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - POSITIVE");
+     END;
+
+     BEGIN
+          DECLARE
+            TYPE T IS NEW FLT RANGE 0.0 .. FLT(IDENT_INT(20));
+
+          BEGIN
+            DECLARE
+               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+               T1 : T := T(IDENT_INT(0));
+            BEGIN
+               FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
+                       " AT PROPER PLACE " &
+                       T'IMAGE(T1) ); --USE T1
+
+            EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
+                             " AT PROPER PLACE "); 
+            END;
+            FAILED ("EXCEPTION NOT RAISED - FLT" );
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER ENTERED - FLT");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - FLT");
+     END;
+
+     BEGIN
+          DECLARE
+            TYPE T IS NEW DUR RANGE DUR(IDENT_INT(-1)) .. 5.0;
+
+
+          BEGIN
+            DECLARE
+               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+               T1 : T := T(IDENT_INT(2));
+            BEGIN
+               FAILED ("DID NOT RAISE CONSTRAINT_ERROR" &
+                       " AT PROPER PLACE " &
+                       T'IMAGE(T1) );  -- USE T1
+            EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+            END;
+            FAILED ("EXCEPTION NOT RAISED - DUR " );
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER ENTERED - DUR");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - DUR");
+     END;
+
+     BEGIN
+          DECLARE
+            TYPE T IS NEW ARR (IDENT_INT (-1) .. 10);
+
+          BEGIN
+            DECLARE
+               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+               T1 : T := (OTHERS => IDENT_INT(3));
+            BEGIN
+               FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
+                       "AT PROPER PLACE " &
+                       INTEGER'IMAGE(T1(1)) ); --USE T1
+            EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+            END;
+            FAILED ("EXCEPTION NOT RAISED - ARR " );
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER ENTERED - ARR");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - ARR");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE T IS NEW REC (IDENT_INT (11));
+
+          BEGIN
+            DECLARE
+               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+               T1 : T;
+            BEGIN
+               FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+            EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
+                             "AT PROPER PLACE " &
+                             INTEGER'IMAGE(T1.D) ); --USE T1
+            END;
+            FAILED ("EXCEPTION NOT RAISED - REC " );
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER ENTERED - REC");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - REC");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE T IS NEW PRIV (IDENT_INT (0));  --RAISES C_E
+
+          BEGIN
+            DECLARE
+               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+               T1 : T;
+            BEGIN
+               FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+            EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 
+                             "AT PROPER PLACE " &
+                             INTEGER'IMAGE(T1.D) ); --USE T1
+            END;
+            FAILED ("EXCEPTION NOT RAISED - PRIV " ); 
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER ENTERED - PRIV");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - PRIV");
+     END;
+
+     BEGIN
+          DECLARE
+            TYPE T IS NEW ACC_ARR (0 .. IDENT_INT (11));  --RAISES C_E
+
+          BEGIN
+            DECLARE
+               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+               T1 : T;
+            BEGIN
+               FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+            EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR " &
+                             "AT PROPER PLACE " &
+                             INTEGER'IMAGE(T1(1)) ); --USE T1
+            END;
+            FAILED ("EXCEPTION NOT RAISED - ACC_ARR " );
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER ENTERED - ACC_ARR");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - ACC_ARR");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE T IS NEW ACC_REC (IDENT_INT (-1));  --RAISES C_E
+
+          BEGIN
+            DECLARE
+               -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION
+               T1 : T;
+            BEGIN
+               FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+            EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 
+                             "AT PROPER PLACE " &
+                             INTEGER'IMAGE(T1.D) ); --USE T1
+            END;
+                FAILED ("EXCEPTION NOT RAISED - ACC_REC " );
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER ENTERED - ACC_REC");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - ACC_REC");
+     END;
+
+     RESULT;
+END C34011B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34012a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34012a.ada
new file mode 100644
index 000000000..020b79b42
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34012a.ada
@@ -0,0 +1,136 @@
+-- C34012A.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 DEFAULT EXPRESSIONS IN DERIVED RECORD TYPES AND
+--     DERIVED SUBPROGRAMS ARE EVALUATED USING THE ENTITIES DENOTED BY
+--     THE EXPRESSIONS IN THE PARENT TYPE.
+
+-- HISTORY:
+--     RJW 06/19/86  CREATED ORIGINAL TEST.
+--     BCB 08/19/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  CHANGED
+--                   PACKAGE B SO WOULD HAVE ONE CASE WHERE DEFAULT IS
+--                   DECLARED BEFORE THE DERIVED TYPE DECLARATION.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34012A IS
+
+BEGIN
+     TEST ("C34012A", "CHECK THAT DEFAULT EXPRESSIONS IN DERIVED " &
+                      "RECORD TYPES AND DERIVED SUBPROGRAMS ARE " &
+                      "EVALUATED USING THE ENTITIES DENOTED BY THE " &
+                      "EXPRESSIONS IN THE PARENT TYPE" );
+
+     DECLARE
+          PACKAGE P IS
+               X : INTEGER := 5;
+               TYPE REC IS
+                    RECORD
+                         C : INTEGER := X;
+                    END RECORD;
+          END P;
+
+          PACKAGE Q IS
+               X : INTEGER := 6;
+               TYPE NEW_REC IS NEW P.REC;
+               QVAR : NEW_REC;
+          END Q;
+
+          PACKAGE R IS
+               X : INTEGER := 7;
+               TYPE BRAND_NEW_REC IS NEW Q.NEW_REC;
+               RVAR : BRAND_NEW_REC;
+          END R;
+
+          USE Q;
+          USE R;
+     BEGIN
+          IF QVAR.C = 5 THEN
+               NULL;
+          ELSE
+               FAILED ( "INCORRECT VALUE FOR QVAR" );
+          END IF;
+
+          IF RVAR.C = 5 THEN
+               NULL;
+          ELSE
+               FAILED ( "INCORRECT VALUE FOR RVAR" );
+          END IF;
+     END;
+
+     DECLARE
+          PACKAGE A IS
+               TYPE T IS RANGE 1 .. 10;
+               DEFAULT : T := 5;
+               FUNCTION F (X : T := DEFAULT) RETURN T;
+          END A;
+
+          PACKAGE BODY A IS
+               FUNCTION F (X : T := DEFAULT) RETURN T IS
+               BEGIN
+                    RETURN X;
+               END F;
+          END A;
+
+          PACKAGE B IS
+               DEFAULT : A.T:= 6;
+               TYPE NEW_T IS NEW A.T;
+               BVAR : NEW_T := F;
+          END B;
+
+          PACKAGE C IS
+               TYPE BRAND_NEW_T IS NEW B.NEW_T;
+               DEFAULT : BRAND_NEW_T := 7;
+               CVAR : BRAND_NEW_T :=F;
+          END C;
+
+          USE B;
+          USE C;
+     BEGIN
+          IF BVAR = 5 THEN
+               NULL;
+          ELSE
+               FAILED ( "INCORRECT VALUE FOR BVAR" );
+          END IF;
+
+          IF CVAR = 5 THEN
+               NULL;
+          ELSE
+               FAILED ( "INCORRECT VALUE FOR CVAR" );
+          END IF;
+
+          DECLARE
+               VAR : BRAND_NEW_T := F;
+          BEGIN
+               IF VAR = 5 THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INCORRECT VALUE FOR VAR" );
+               END IF;
+          END;
+     END;
+
+     RESULT;
+END C34012A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014a.ada
new file mode 100644
index 000000000..e2a917e6d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014a.ada
@@ -0,0 +1,256 @@
+-- C34014A.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 SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
+--     UNDER APPROPRIATE CIRCUMSTANCES.
+
+--     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
+--     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC SUBPROGRAM IS LATER
+--     DECLARED EXPLICITLY IN THE SAME VISIBLE PART.
+
+-- HISTORY:
+--     JRK 09/08/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34014A IS
+
+     PACKAGE P IS
+          TYPE T IS RANGE -100 .. 100;
+          FUNCTION F RETURN T;
+     END P;
+     USE P;
+
+     PACKAGE BODY P IS
+          FUNCTION F RETURN T IS
+          BEGIN
+               RETURN T (IDENT_INT (1));
+          END F;
+     END P;
+
+BEGIN
+     TEST ("C34014A", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
+                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                      "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
+                      "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                      "SUBPROGRAM IS LATER DECLARED EXPLICITLY IN " &
+                      "THE SAME VISIBLE PART");
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := F;
+               FUNCTION F RETURN QT;
+               TYPE QR IS
+                    RECORD
+                         C : QT := F;
+                    END RECORD;
+          PRIVATE
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION F RETURN QT IS
+               BEGIN
+                    RETURN QT (IDENT_INT (2));
+               END F;
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := F;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                            "DECL");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 2 THEN
+               FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 2");
+          END IF;
+
+          IF Z /= 2 THEN
+               FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := F;
+               FUNCTION G RETURN QT;
+               FUNCTION F RETURN QT RENAMES G;
+               TYPE QR IS
+                    RECORD
+                         C : QT := F;
+                    END RECORD;
+          PRIVATE
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION G RETURN QT IS
+               BEGIN
+                    RETURN QT (IDENT_INT (2));
+               END G;
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := F;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
+                            "1");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - " &
+                            "1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 2 THEN
+               FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - 2");
+          END IF;
+
+          IF Z /= 2 THEN
+               FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY GENERIC INSTANTIATION");
+
+     DECLARE
+
+          GENERIC
+               TYPE T IS RANGE <>;
+          FUNCTION G RETURN T;
+
+          FUNCTION G RETURN T IS
+          BEGIN
+               RETURN T (IDENT_INT (2));
+          END G;
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := F;
+               FUNCTION F IS NEW G (QT);
+               W : QT := F;
+          PRIVATE
+               TYPE QS IS NEW QT;
+               Z : QS := F;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - " &
+                            "INSTANTIATION");
+               END IF;
+
+               IF W /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - " &
+                            "INSTANTIATION - 1");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT DERIVED - " &
+                            "INSTANTIATION - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 2 THEN
+               FAILED ("NEW SUBPROGRAM NOT VISIBLE - INSTANTIATION - " &
+                       "2");
+          END IF;
+
+          IF Z /= 2 THEN
+               FAILED ("NEW SUBPROGRAM NOT DERIVED - INSTANTIATION - " &
+                       "2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     RESULT;
+END C34014A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014c.ada
new file mode 100644
index 000000000..9dd17e22f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014c.ada
@@ -0,0 +1,259 @@
+-- C34014C.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 SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
+--     UNDER APPROPRIATE CIRCUMSTANCES.
+
+--     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
+--     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC SUBPROGRAM IS LATER
+--     DECLARED EXPLICITLY IN THE PRIVATE PART.
+
+-- HISTORY:
+--     JRK 09/11/87  CREATED ORIGINAL TEST.
+--     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
+--     PWN 10/24/96  RESTORED CHECK WITH NEW ADA 95 RESULTS EXPECTED.
+--     PWB.CTA 02/20/97  Made failure messages unique.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34014C IS
+
+     PACKAGE P IS
+          TYPE T IS RANGE -100 .. 100;
+          FUNCTION F RETURN T;
+     END P;
+     USE P;
+
+     PACKAGE BODY P IS
+          FUNCTION F RETURN T IS
+          BEGIN
+               RETURN T (IDENT_INT (1));
+          END F;
+     END P;
+
+BEGIN
+     TEST ("C34014C", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
+                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                      "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
+                      "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                      "SUBPROGRAM IS LATER DECLARED EXPLICITLY IN " &
+                      "THE PRIVATE PART");
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := F;
+          PRIVATE
+               FUNCTION F RETURN QT;
+               TYPE QR IS
+                    RECORD
+                         C : QT := F;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION F RETURN QT IS
+               BEGIN
+                    RETURN QT (IDENT_INT (2));
+               END F;
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := F;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                            "DECL");
+               END IF;
+
+            IF Z /= 2 THEN
+                 FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG " &
+                            "DECL - 1");
+            END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := F;
+          PRIVATE
+               FUNCTION G RETURN QT;
+               FUNCTION F RETURN QT RENAMES G;
+               TYPE QR IS
+                    RECORD
+                         C : QT := F;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION G RETURN QT IS
+               BEGIN
+                    RETURN QT (IDENT_INT (2));
+               END G;
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := F;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - " &
+                            "1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING");
+               END IF;
+
+         IF Z /= 2 THEN
+              FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - " &
+                            "1");
+         END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - 2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY GENERIC INSTANTIATION");
+
+     DECLARE
+
+          GENERIC
+               TYPE T IS RANGE <>;
+          FUNCTION G RETURN T;
+
+          FUNCTION G RETURN T IS
+          BEGIN
+               RETURN T (IDENT_INT (2));
+          END G;
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := F;
+          PRIVATE
+               FUNCTION F IS NEW G (QT);
+               W : QT := F;
+               TYPE QS IS NEW QT;
+               Z : QS := F;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - " &
+                            "INSTANTIATION - 1");
+               END IF;
+
+               IF W /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - " &
+                            "INSTANTIATION");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("OLD SUBPROGRAM NOT DERIVED - " &
+                            "INSTANTIATION - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT VISIBLE - INSTANTIATION - " &
+                       "2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT DERIVED - INSTANTIATION - " &
+                       "2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     RESULT;
+END C34014C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014e.ada
new file mode 100644
index 000000000..0c7fea237
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014e.ada
@@ -0,0 +1,257 @@
+-- C34014E.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 SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
+--     UNDER APPROPRIATE CIRCUMSTANCES.
+
+--     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
+--     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC SUBPROGRAM IS LATER
+--     DECLARED EXPLICITLY IN THE PACKAGE BODY.
+
+-- HISTORY:
+--     JRK 09/15/87  CREATED ORIGINAL TEST.
+--     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
+--     PWN 04/11/96  Restored subtests in Ada95 legal format.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34014E IS
+
+     PACKAGE P IS
+          TYPE T IS RANGE -100 .. 100;
+          FUNCTION F RETURN T;
+     END P;
+     USE P;
+
+     PACKAGE BODY P IS
+          FUNCTION F RETURN T IS
+          BEGIN
+               RETURN T (IDENT_INT (1));
+          END F;
+     END P;
+
+BEGIN
+     TEST ("C34014E", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
+                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                      "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
+                      "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                      "SUBPROGRAM IS LATER DECLARED EXPLICITLY IN " &
+                      "THE PACKAGE BODY");
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := F;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION F RETURN QT;
+               TYPE QR IS
+                    RECORD
+                         C : QT := F;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+
+               FUNCTION F RETURN QT IS
+               BEGIN
+                    RETURN QT (IDENT_INT (2));
+               END F;
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := F;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                            "DECL");
+               END IF;
+
+            IF Z /= 2 THEN
+                 FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG " &
+                            "DECL - 1");
+            END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := F;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION G RETURN QT;
+               FUNCTION F RETURN QT RENAMES G;
+               TYPE QR IS
+                    RECORD
+                         C : QT := F;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+
+               FUNCTION G RETURN QT IS
+               BEGIN
+                    RETURN QT (IDENT_INT (2));
+               END G;
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := F;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - " &
+                            "1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - " &
+                            "1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT VISIBLE - RENAMING - 2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT DERIVED - RENAMING - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY GENERIC INSTANTIATION");
+
+     DECLARE
+
+          GENERIC
+               TYPE T IS RANGE <>;
+          FUNCTION G RETURN T;
+
+          FUNCTION G RETURN T IS
+          BEGIN
+               RETURN T (IDENT_INT (2));
+          END G;
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := F;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION F IS NEW G (QT);
+               W : QT := F;
+               TYPE QS IS NEW QT;
+               Z : QS := F;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - " &
+                            "INSTANTIATION - 1");
+               END IF;
+
+               IF W /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - " &
+                            "INSTANTIATION");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("OLD SUBPROGRAM NOT DERIVED - " &
+                            "INSTANTIATION - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT VISIBLE - INSTANTIATION - " &
+                       "2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT DERIVED - INSTANTIATION - " &
+                       "2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     RESULT;
+END C34014E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014g.ada
new file mode 100644
index 000000000..5be7f5008
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014g.ada
@@ -0,0 +1,107 @@
+-- C34014G.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 SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
+--     UNDER APPROPRIATE CIRCUMSTANCES.
+
+--     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
+--     VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC SUBPROGRAM IS LATER
+--     DECLARED EXPLICITLY.
+
+-- HISTORY:
+--     JRK 09/16/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34014G IS
+
+     PACKAGE P IS
+          TYPE T IS RANGE -100 .. 100;
+          FUNCTION F RETURN T;
+     END P;
+     USE P;
+
+     PACKAGE BODY P IS
+          FUNCTION F RETURN T IS
+          BEGIN
+               RETURN T (IDENT_INT (1));
+          END F;
+     END P;
+
+BEGIN
+     TEST ("C34014G", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
+                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                      "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
+                      "VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC " &
+                      "SUBPROGRAM IS LATER DECLARED EXPLICITLY");
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NO NEW SUBPROGRAM DECLARED EXPLICITLY");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := F;
+          PRIVATE
+               TYPE QS IS NEW QT;
+               Z : QS := F;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT VISIBLE - 1");
+               END IF;
+
+               IF Z /= 1 THEN
+                    FAILED ("OLD SUBPROGRAM NOT DERIVED - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT VISIBLE - 2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD SUBPROGRAM NOT DERIVED - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     RESULT;
+END C34014G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014h.ada
new file mode 100644
index 000000000..b1bf56c31
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014h.ada
@@ -0,0 +1,208 @@
+-- C34014H.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 SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
+--     UNDER APPROPRIATE CIRCUMSTANCES.
+
+--     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
+--     PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT DECLARATION OF A
+--     HOMOGRAPHIC SUBPROGRAM IN THE VISIBLE PART.
+
+-- HISTORY:
+--     JRK 09/16/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34014H IS
+
+     PACKAGE P IS
+          TYPE T IS RANGE -100 .. 100;
+          FUNCTION F RETURN T;
+     END P;
+     USE P;
+
+     PACKAGE BODY P IS
+          FUNCTION F RETURN T IS
+          BEGIN
+               RETURN T (IDENT_INT (1));
+          END F;
+     END P;
+
+BEGIN
+     TEST ("C34014H", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
+                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                      "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
+                      "PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT " &
+                      "DECLARATION OF A HOMOGRAPHIC SUBPROGRAM IN " &
+                      "THE VISIBLE PART");
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS PRIVATE;
+               C2 : CONSTANT QT;
+               FUNCTION F RETURN QT;
+               TYPE QR1 IS
+                    RECORD
+                         C : QT := F;
+                    END RECORD;
+          PRIVATE
+               TYPE QT IS NEW T;
+               C2 : CONSTANT QT := 2;
+               TYPE QR2 IS
+                    RECORD
+                         C : QT := F;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION F RETURN QT IS
+               BEGIN
+                    RETURN QT (IDENT_INT (2));
+               END F;
+
+               PACKAGE R IS
+                    X : QR1;
+                    Y : QR2;
+                    Z : QS := F;
+               END R;
+               USE R;
+          BEGIN
+               IF X.C /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
+                            "DECL - 2");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= C2 THEN
+               FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 3");
+          END IF;
+
+          IF Z /= RT (C2) THEN
+               FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS PRIVATE;
+               C2 : CONSTANT QT;
+               FUNCTION G RETURN QT;
+               FUNCTION F RETURN QT RENAMES G;
+               TYPE QR1 IS
+                    RECORD
+                         C : QT := F;
+                    END RECORD;
+          PRIVATE
+               TYPE QT IS NEW T;
+               C2 : CONSTANT QT := 2;
+               TYPE QR2 IS
+                    RECORD
+                         C : QT := F;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION G RETURN QT IS
+               BEGIN
+                    RETURN QT (IDENT_INT (2));
+               END G;
+
+               PACKAGE R IS
+                    X : QR1;
+                    Y : QR2;
+                    Z : QS := F;
+               END R;
+               USE R;
+          BEGIN
+               IF X.C /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
+                            "1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
+                            "2");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - " &
+                            "1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := F;
+               TYPE RT IS NEW QT;
+               Z : RT := F;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= C2 THEN
+               FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - 3");
+          END IF;
+
+          IF Z /= RT (C2) THEN
+               FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     RESULT;
+END C34014H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014n.ada
new file mode 100644
index 000000000..321a784e5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014n.ada
@@ -0,0 +1,256 @@
+-- C34014N.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 OPERATOR IS VISIBLE AND FURTHER DERIVABLE
+--     UNDER APPROPRIATE CIRCUMSTANCES.
+
+--     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
+--     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC OPERATOR IS LATER
+--     DECLARED EXPLICITLY IN THE SAME VISIBLE PART.
+
+-- HISTORY:
+--     JRK 09/21/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34014N IS
+
+     PACKAGE P IS
+          TYPE T IS RANGE -100 .. 100;
+          FUNCTION "+" (X : T) RETURN T;
+     END P;
+     USE P;
+
+     PACKAGE BODY P IS
+          FUNCTION "+" (X : T) RETURN T IS
+          BEGIN
+               RETURN X + T (IDENT_INT (1));
+          END "+";
+     END P;
+
+BEGIN
+     TEST ("C34014N", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
+                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                      "OPERATOR IS IMPLICITLY DECLARED IN THE " &
+                      "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                      "OPERATOR IS LATER DECLARED EXPLICITLY IN " &
+                      "THE SAME VISIBLE PART");
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := +0;
+               FUNCTION "+" (Y : QT) RETURN QT;
+               TYPE QR IS
+                    RECORD
+                         C : QT := +0;
+                    END RECORD;
+          PRIVATE
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION "+" (Y : QT) RETURN QT IS
+               BEGIN
+                    RETURN Y + QT (IDENT_INT (2));
+               END "+";
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := +0;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG " &
+                            "DECL");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +0;
+               TYPE RT IS NEW QT;
+               Z : RT := +0;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 2 THEN
+               FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG DECL - 2");
+          END IF;
+
+          IF Z /= 2 THEN
+               FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG DECL - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := +0;
+               FUNCTION G (X : QT) RETURN QT;
+               FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
+               TYPE QR IS
+                    RECORD
+                         C : QT := +0;
+                    END RECORD;
+          PRIVATE
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION G (X : QT) RETURN QT IS
+               BEGIN
+                    RETURN X + QT (IDENT_INT (2));
+               END G;
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := +0;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " &
+                            "1");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - " &
+                            "1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +0;
+               TYPE RT IS NEW QT;
+               Z : RT := +0;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 2 THEN
+               FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - 2");
+          END IF;
+
+          IF Z /= 2 THEN
+               FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY GENERIC INSTANTIATION");
+
+     DECLARE
+
+          GENERIC
+               TYPE T IS RANGE <>;
+          FUNCTION G (Y : T) RETURN T;
+
+          FUNCTION G (Y : T) RETURN T IS
+          BEGIN
+               RETURN Y + T (IDENT_INT (2));
+          END G;
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := +0;
+               FUNCTION "+" IS NEW G (QT);
+               W : QT := +0;
+          PRIVATE
+               TYPE QS IS NEW QT;
+               Z : QS := +0;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT VISIBLE - " &
+                            "INSTANTIATION");
+               END IF;
+
+               IF W /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - " &
+                            "INSTANTIATION - 1");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT DERIVED - " &
+                            "INSTANTIATION - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +0;
+               TYPE RT IS NEW QT;
+               Z : RT := +0;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 2 THEN
+               FAILED ("NEW OPERATOR NOT VISIBLE - INSTANTIATION - " &
+                       "2");
+          END IF;
+
+          IF Z /= 2 THEN
+               FAILED ("NEW OPERATOR NOT DERIVED - INSTANTIATION - " &
+                       "2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     RESULT;
+END C34014N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014p.ada
new file mode 100644
index 000000000..161fbbbff
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014p.ada
@@ -0,0 +1,258 @@
+-- C34014P.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 OPERATOR IS VISIBLE AND FURTHER DERIVABLE
+--     UNDER APPROPRIATE CIRCUMSTANCES.
+
+--     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
+--     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC OPERATOR IS LATER
+--     DECLARED EXPLICITLY IN THE PRIVATE PART.
+
+-- HISTORY:
+--     JRK 09/22/87  CREATED ORIGINAL TEST.
+--     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
+--     PWN 04/11/96  Restored subtests in Ada95 legal format.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34014P IS
+
+     PACKAGE P IS
+          TYPE T IS RANGE -100 .. 100;
+          FUNCTION "+" (X : T) RETURN T;
+     END P;
+     USE P;
+
+     PACKAGE BODY P IS
+          FUNCTION "+" (X : T) RETURN T IS
+          BEGIN
+               RETURN X + T (IDENT_INT (1));
+          END "+";
+     END P;
+
+BEGIN
+     TEST ("C34014P", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
+                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                      "OPERATOR IS IMPLICITLY DECLARED IN THE " &
+                      "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                      "OPERATOR IS LATER DECLARED EXPLICITLY IN " &
+                      "THE PRIVATE PART");
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := +0;
+          PRIVATE
+               FUNCTION "+" (Y : QT) RETURN QT;
+               TYPE QR IS
+                    RECORD
+                         C : QT := +0;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION "+" (Y : QT) RETURN QT IS
+               BEGIN
+                    RETURN Y + QT (IDENT_INT (2));
+               END "+";
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := +0;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
+                            "DECL");
+               END IF;
+
+               IF Z /= 2 THEN
+                   FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +0;
+               TYPE RT IS NEW QT;
+               Z : RT := +0;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG DECL - 2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG DECL - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := +0;
+          PRIVATE
+               FUNCTION G (X : QT) RETURN QT;
+               FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
+               TYPE QR IS
+                    RECORD
+                         C : QT := +0;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION G (X : QT) RETURN QT IS
+               BEGIN
+                    RETURN X + QT (IDENT_INT (2));
+               END G;
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := +0;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - " &
+                            "1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING");
+               END IF;
+
+           IF Z /= 2 THEN
+                FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - " &
+                            "1");
+           END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +0;
+               TYPE RT IS NEW QT;
+               Z : RT := +0;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - 2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY GENERIC INSTANTIATION");
+
+     DECLARE
+
+          GENERIC
+               TYPE T IS RANGE <>;
+          FUNCTION G (Y : T) RETURN T;
+
+          FUNCTION G (Y : T) RETURN T IS
+          BEGIN
+               RETURN Y + T (IDENT_INT (2));
+          END G;
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := +0;
+          PRIVATE
+               FUNCTION "+" IS NEW G (QT);
+               W : QT := +0;
+               TYPE QS IS NEW QT;
+               Z : QS := +0;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT VISIBLE - " &
+                            "INSTANTIATION - 1");
+               END IF;
+
+               IF W /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - " &
+                            "INSTANTIATION");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("OLD OPERATOR NOT DERIVED - " &
+                            "INSTANTIATION - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +0;
+               TYPE RT IS NEW QT;
+               Z : RT := +0;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD OPERATOR NOT VISIBLE - INSTANTIATION - " &
+                       "2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD OPERATOR NOT DERIVED - INSTANTIATION - " &
+                       "2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     RESULT;
+END C34014P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014r.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014r.ada
new file mode 100644
index 000000000..ab21b4842
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014r.ada
@@ -0,0 +1,257 @@
+-- C34014R.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 OPERATOR IS VISIBLE AND FURTHER DERIVABLE
+--     UNDER APPROPRIATE CIRCUMSTANCES.
+
+--     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
+--     VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC OPERATOR IS LATER
+--     DECLARED EXPLICITLY IN THE PACKAGE BODY.
+
+-- HISTORY:
+--     JRK 09/22/87  CREATED ORIGINAL TEST.
+--     GJD 11/15/95  REMOVED ADA 83 INCOMPATIBILITIES.
+--     PWN 04/11/96  Restored subtests in Ada95 legal format.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34014R IS
+
+     PACKAGE P IS
+          TYPE T IS RANGE -100 .. 100;
+          FUNCTION "+" (X : T) RETURN T;
+     END P;
+     USE P;
+
+     PACKAGE BODY P IS
+          FUNCTION "+" (X : T) RETURN T IS
+          BEGIN
+               RETURN X + T (IDENT_INT (1));
+          END "+";
+     END P;
+
+BEGIN
+     TEST ("C34014R", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
+                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                      "OPERATOR IS IMPLICITLY DECLARED IN THE " &
+                      "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " &
+                      "OPERATOR IS LATER DECLARED EXPLICITLY IN " &
+                      "THE PACKAGE BODY");
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := +0;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION "+" (Y : QT) RETURN QT;
+               TYPE QR IS
+                    RECORD
+                         C : QT := +0;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+
+               FUNCTION "+" (Y : QT) RETURN QT IS
+               BEGIN
+                    RETURN Y + QT (IDENT_INT (2));
+               END "+";
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := +0;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
+                            "DECL");
+               END IF;
+
+               IF Z /= 2 THEN
+                   FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +0;
+               TYPE RT IS NEW QT;
+               Z : RT := +0;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG DECL - 2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG DECL - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := +0;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION G (X : QT) RETURN QT;
+               FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
+               TYPE QR IS
+                    RECORD
+                         C : QT := +0;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+
+               FUNCTION G (X : QT) RETURN QT IS
+               BEGIN
+                    RETURN X + QT (IDENT_INT (2));
+               END G;
+
+               PACKAGE R IS
+                    Y : QR;
+                    Z : QS := +0;
+               END R;
+               USE R;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - " &
+                            "1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING");
+               END IF;
+
+            IF Z /= 2 THEN
+                FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - " &
+                            "1");
+            END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +0;
+               TYPE RT IS NEW QT;
+               Z : RT := +0;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - 2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY GENERIC INSTANTIATION");
+
+     DECLARE
+
+          GENERIC
+               TYPE T IS RANGE <>;
+          FUNCTION G (Y : T) RETURN T;
+
+          FUNCTION G (Y : T) RETURN T IS
+          BEGIN
+               RETURN Y + T (IDENT_INT (2));
+          END G;
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := +0;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION "+" IS NEW G (QT);
+               W : QT := +0;
+               TYPE QS IS NEW QT;
+               Z : QS := +0;
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT VISIBLE - " &
+                            "INSTANTIATION - 1");
+               END IF;
+
+               IF W /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - " &
+                            "INSTANTIATION");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("OLD OPERATOR NOT DERIVED - " &
+                            "INSTANTIATION - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +0;
+               TYPE RT IS NEW QT;
+               Z : RT := +0;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD OPERATOR NOT VISIBLE - INSTANTIATION - " &
+                       "2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD OPERATOR NOT DERIVED - INSTANTIATION - " &
+                       "2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     RESULT;
+END C34014R;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014t.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014t.ada
new file mode 100644
index 000000000..ddf22c6be
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014t.ada
@@ -0,0 +1,107 @@
+-- C34014T.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 OPERATOR IS VISIBLE AND FURTHER DERIVABLE
+--     UNDER APPROPRIATE CIRCUMSTANCES.
+
+--     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
+--     VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC OPERATOR IS LATER
+--     DECLARED EXPLICITLY.
+
+-- HISTORY:
+--     JRK 09/22/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34014T IS
+
+     PACKAGE P IS
+          TYPE T IS RANGE -100 .. 100;
+          FUNCTION "+" (X : T) RETURN T;
+     END P;
+     USE P;
+
+     PACKAGE BODY P IS
+          FUNCTION "+" (X : T) RETURN T IS
+          BEGIN
+               RETURN X + T (IDENT_INT (1));
+          END "+";
+     END P;
+
+BEGIN
+     TEST ("C34014T", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
+                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                      "OPERATOR IS IMPLICITLY DECLARED IN THE " &
+                      "VISIBLE PART OF A PACKAGE AND NO HOMOGRAPHIC " &
+                      "OPERATOR IS LATER DECLARED EXPLICITLY");
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NO NEW OPERATOR DECLARED EXPLICITLY");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS NEW T;
+               X : QT := +0;
+          PRIVATE
+               TYPE QS IS NEW QT;
+               Z : QS := +0;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT VISIBLE - 1");
+               END IF;
+
+               IF Z /= 1 THEN
+                    FAILED ("OLD OPERATOR NOT DERIVED - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +0;
+               TYPE RT IS NEW QT;
+               Z : RT := +0;
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= 1 THEN
+               FAILED ("OLD OPERATOR NOT VISIBLE - 2");
+          END IF;
+
+          IF Z /= 1 THEN
+               FAILED ("OLD OPERATOR NOT DERIVED - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     RESULT;
+END C34014T;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014u.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014u.ada
new file mode 100644
index 000000000..209b06d1f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34014u.ada
@@ -0,0 +1,212 @@
+-- C34014U.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 OPERATOR IS VISIBLE AND FURTHER DERIVABLE
+--     UNDER APPROPRIATE CIRCUMSTANCES.
+
+--     CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE
+--     PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT DECLARATION OF A
+--     HOMOGRAPHIC OPERATOR IN THE VISIBLE PART.
+
+-- HISTORY:
+--     JRK 09/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C34014U IS
+
+     PACKAGE P IS
+          TYPE T IS RANGE -100 .. 100;
+          FUNCTION "+" (X : T) RETURN T;
+     END P;
+     USE P;
+
+     PACKAGE BODY P IS
+          FUNCTION "+" (X : T) RETURN T IS
+          BEGIN
+               RETURN X + T (IDENT_INT (1));
+          END "+";
+     END P;
+
+BEGIN
+     TEST ("C34014U", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " &
+                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
+                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
+                      "OPERATOR IS IMPLICITLY DECLARED IN THE " &
+                      "PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT " &
+                      "DECLARATION OF A HOMOGRAPHIC OPERATOR IN " &
+                      "THE VISIBLE PART");
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS PRIVATE;
+               C0 : CONSTANT QT;
+               C2 : CONSTANT QT;
+               FUNCTION "+" (Y : QT) RETURN QT;
+               TYPE QR1 IS
+                    RECORD
+                         C : QT := +C0;
+                    END RECORD;
+          PRIVATE
+               TYPE QT IS NEW T;
+               C0 : CONSTANT QT := 0;
+               C2 : CONSTANT QT := 2;
+               TYPE QR2 IS
+                    RECORD
+                         C : QT := +0;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION "+" (Y : QT) RETURN QT IS
+               BEGIN
+                    RETURN Y + QT (IDENT_INT (2));
+               END "+";
+
+               PACKAGE R IS
+                    X : QR1;
+                    Y : QR2;
+                    Z : QS := +0;
+               END R;
+               USE R;
+          BEGIN
+               IF X.C /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " &
+                            "DECL - 2");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG " &
+                            "DECL - 1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +C0;
+               TYPE RT IS NEW QT;
+               Z : RT := +RT(C0);
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= C2 THEN
+               FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG DECL - 3");
+          END IF;
+
+          IF Z /= RT (C2) THEN
+               FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG DECL - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     COMMENT ("NEW OPERATOR DECLARED BY RENAMING");
+
+     DECLARE
+
+          PACKAGE Q IS
+               TYPE QT IS PRIVATE;
+               C0 : CONSTANT QT;
+               C2 : CONSTANT QT;
+               FUNCTION G (X : QT) RETURN QT;
+               FUNCTION "+" (Y : QT) RETURN QT RENAMES G;
+               TYPE QR1 IS
+                    RECORD
+                         C : QT := +C0;
+                    END RECORD;
+          PRIVATE
+               TYPE QT IS NEW T;
+               C0 : CONSTANT QT := 0;
+               C2 : CONSTANT QT := 2;
+               TYPE QR2 IS
+                    RECORD
+                         C : QT := +0;
+                    END RECORD;
+               TYPE QS IS NEW QT;
+          END Q;
+          USE Q;
+
+          PACKAGE BODY Q IS
+               FUNCTION G (X : QT) RETURN QT IS
+               BEGIN
+                    RETURN X + QT (IDENT_INT (2));
+               END G;
+
+               PACKAGE R IS
+                    X : QR1;
+                    Y : QR2;
+                    Z : QS := +0;
+               END R;
+               USE R;
+          BEGIN
+               IF X.C /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " &
+                            "1");
+               END IF;
+
+               IF Y.C /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " &
+                            "2");
+               END IF;
+
+               IF Z /= 2 THEN
+                    FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - " &
+                            "1");
+               END IF;
+          END Q;
+
+          PACKAGE R IS
+               Y : QT := +C0;
+               TYPE RT IS NEW QT;
+               Z : RT := +RT(C0);
+          END R;
+          USE R;
+
+     BEGIN
+          IF Y /= C2 THEN
+               FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - 3");
+          END IF;
+
+          IF Z /= RT (C2) THEN
+               FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - 2");
+          END IF;
+     END;
+
+     -----------------------------------------------------------------
+
+     RESULT;
+END C34014U;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34018a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34018a.ada
new file mode 100644
index 000000000..d039337fc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c34018a.ada
@@ -0,0 +1,154 @@
+-- C34018A.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 CALLS OF DERIVED SUBPROGRAMS CHECK CONSTRAINTS OF THE
+-- PARENT SUBPROGRAM, NOT THE CONSTRAINTS OF THE DERIVED SUBTYPE.
+
+-- JBG 11/15/85
+-- JRK 2/12/86   CORRECTED ERROR: RESOLVED AMBIGUOUS CALL G(41) TO
+--               TYPE NEW_INT.
+-- EDS 7/16/98   AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C34018A IS
+
+     PACKAGE P IS
+          TYPE INT IS RANGE 1..100;
+          SUBTYPE INT_50 IS INT RANGE 1..50;
+          SUBTYPE INT_51 IS INT RANGE 51..100;
+
+          FUNCTION "+" (L, R : INT) RETURN INT;
+          FUNCTION G (X : INT_50) RETURN INT_51;
+
+          TYPE STR IS ARRAY (1..10) OF CHARACTER;
+          FUNCTION F (X : STR) RETURN STR;
+     END P;
+
+     USE P;
+
+     TYPE NEW_STR IS NEW P.STR;
+     TYPE NEW_INT IS NEW P.INT RANGE 51..90;
+
+     PACKAGE BODY P IS
+
+          FUNCTION "+" (L, R : INT) RETURN INT IS
+          BEGIN
+               RETURN INT(INTEGER(L) + INTEGER(R));
+          END "+";
+
+          FUNCTION G (X : INT_50) RETURN INT_51 IS
+          BEGIN
+               RETURN X + 10;
+          END G;
+
+          FUNCTION F (X : STR) RETURN STR IS
+          BEGIN
+               RETURN X;
+          END F;
+
+     END P;
+
+BEGIN
+
+     TEST ("C34018A", "CHECK CONSTRAINTS PROCESSED CORRECTLY FOR " &
+                      "CALLS OF DERIVED SUBPROGRAMS");
+
+     DECLARE
+
+          Y : NEW_STR := F("1234567890");    -- UNAMBIGUOUS.
+
+     BEGIN
+          IF Y /= "1234567890" THEN
+               FAILED ("DERIVED F");
+          END IF;
+     END;
+
+     DECLARE
+
+          A : INT := 51;
+          B : NEW_INT := NEW_INT(IDENT_INT(90));
+
+     BEGIN
+
+          BEGIN
+               A := A + 0;
+               FAILED ("NO EXCEPTION - A + 0 = " & INT'IMAGE(A) ); --Use A
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 1");
+          END;
+
+          BEGIN
+               IF B + 2 /= 92 THEN      -- 92 IN INT.
+                    FAILED ("WRONG RESULT - B + 2");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("WRONG CONSTRAINT FOR DERIVED ""+""");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 2");
+          END;
+
+          BEGIN
+               IF B + 14 > 90 THEN      -- 104 NOT IN INT.
+                    FAILED ("NO EXCEPTION RAISED FOR DERIVED ""+""");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 3");
+          END;
+
+
+          BEGIN
+               IF G(B) > 90 THEN        -- 90 NOT IN INT_50.
+                    FAILED ("NO EXCEPTION RAISED FOR DERIVED G");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 4");
+          END;
+
+          BEGIN
+               IF C34018A.G(41) /= 51 THEN  -- 41 CONVERTED TO
+                                            --    NEW_INT'BASE.
+                                            -- 41 IN INT_50.
+                                            -- 51 IN INT_51.
+                    FAILED ("WRONG RESULT - G(41)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("C_E RAISED FOR LITERAL ARGUMENT");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 5");
+          END;
+     END;
+
+     RESULT;
+END C34018A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c340a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c340a01.a
new file mode 100644
index 000000000..108a30b5f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c340a01.a
@@ -0,0 +1,165 @@
+-- C340A01.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 tagged type declared in a package specification
+--      may be passed as a generic formal (tagged) private type to a generic
+--      package declaration. Check that the formal type may be extended with
+--      a record extension in the generic package.
+--
+--      Check that, in the instance, the record extension inherits the
+--      user-defined primitive subprograms of the tagged actual.
+--
+-- TEST DESCRIPTION:
+--      Declare a tagged type and an associated primitive subprogram in a
+--      package specification (foundation code). Declare a generic package
+--      which takes a tagged type as a formal parameter, and then extends
+--      it with a record extension (foundation code).
+--      
+--      Instantiate the generic package with the tagged type from the first
+--      package (the "generic" extension should now have inherited
+--      the primitive subprogram of the tagged type from the first
+--      package).
+-- 
+--      In the main program, call the primitive subprogram inherited by the
+--      "generic" extension, and verify the correctness of the components.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         F340A000.A
+--         F340A001.A
+--      => C340A01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      12 Jun 96   SAIC    ACVC 2.1: Modified prologue. Removed extraneous
+--                          comments.
+--
+--!
+
+with F340A001;        -- Book definitions.  
+package C340A01_0 is  -- Raw data to be used in creating book elements.
+
+
+   Book_Count : constant := 3;
+
+   subtype Number_Of_Books is Integer range 1 .. Book_Count;
+
+   type Data_List is array (Number_Of_Books) of F340A001.Text_Ptr;
+
+   Title_List  : Data_List := (new String'("Wuthering Heights"),
+                               new String'("Heart of Darkness"),
+                               new String'("Ulysses"));
+
+   Author_List : Data_List := (new String'("Bronte, Emily"),
+                               new String'("Conrad, Joseph"),
+                               new String'("Joyce, James"));
+
+end C340A01_0;
+
+
+     --==================================================================--
+
+
+-- Library-level instantiation. Actual parameter is tagged record.
+
+with F340A001;  -- Book definitions.
+with F340A000;  -- Singly-linked list abstraction.
+package C340A01_1 is new F340A000 (Parent_Type => F340A001.Book_Type);
+
+
+     --==================================================================--
+
+
+with Report;
+
+with F340A001;   -- Book definitions.
+with C340A01_0;  -- Raw book data.
+with C340A01_1;  -- Instance.
+
+use  F340A001;   -- Primitive operations of Book_Type directly visible.
+use  C340A01_1;  -- Operations inherited by Node_Type directly visible.
+
+procedure C340A01 is
+
+
+   List_Of_Books : Node_Ptr := null;  -- Head of linked list of books.
+
+
+          --========================================================--
+
+
+   procedure Create_List (Title, Author : in     C340A01_0.Data_List;
+                          Head          : in out Node_Ptr) is
+
+      Book     : Node_Type;  -- Object of extended type.
+      Book_Ptr : Node_Ptr;
+
+   begin
+      for I in C340A01_0.Number_Of_Books loop
+         Create_Book (Title (I), Author (I), Book);    -- Call inherited
+                                                       -- operation.
+         Book_Ptr := new Node_Type'(Book);
+         Add (Book_Ptr, Head);
+      end loop;
+   end Create_List;
+
+
+          --========================================================--
+
+
+   function Bad_List_Contents return Boolean is
+   begin
+      return (List_Of_Books.Title.all            /= "Ulysses"           or
+              List_Of_Books.Author.all           /= "Joyce, James"      or
+              List_Of_Books.Next.Title.all       /= "Heart of Darkness" or
+              List_Of_Books.Next.Author.all      /= "Conrad, Joseph"    or
+              List_Of_Books.Next.Next.Title.all  /= "Wuthering Heights" or
+              List_Of_Books.Next.Next.Author.all /= "Bronte, Emily");
+   end Bad_List_Contents;
+
+
+          --========================================================--
+
+
+begin  -- Main program.
+
+   Report.Test ("C340A01", "Inheritance of primitive operations: record " &
+                "extension of formal tagged private type; actual is " &
+                "an ultimate ancestor type");
+
+   -- Create linked list using inherited operation:
+   Create_List (C340A01_0.Title_List, C340A01_0.Author_List, List_Of_Books);
+
+   -- Verify results:
+   if Bad_List_Contents then
+      Report.Failed ("Wrong values after call to inherited operation");
+   end if;
+
+   Report.Result;
+
+end C340A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c340a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c340a02.a
new file mode 100644
index 000000000..2dd8f175c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c340a02.a
@@ -0,0 +1,221 @@
+-- C340A02.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 record extension (declared in a package specification) of
+--      a tagged type (declared in a different package specification) may be
+--      passed as a generic formal (tagged) private type to a generic package
+--      declaration. Check that the formal type may be further extended with a
+--      record extension in the generic package.
+--
+--      Check that, in the instance, the record extension inherits the
+--      user-defined primitive subprograms of the tagged actual, including
+--      those inherited by the actual from its parent.
+--
+-- TEST DESCRIPTION:
+--      Declare a tagged type and an associated primitive subprogram in a
+--      package specification (foundation code). Declare a record extension
+--      of the tagged type and an associated primitive subprogram in a second
+--      package specification. Declare a generic package which takes a tagged
+--      type as a formal parameter, and then extends it with a record
+--      extension (foundation code).
+--      
+--      Instantiate the generic package with the record extension from the
+--      second package (the "generic" extension should now have inherited
+--      the primitive subprograms of the record extension from the second
+--      package).
+-- 
+--      In the main program, call the primitive subprograms inherited by the
+--      "generic" extension. There are two: (1) Create_Book, declared for
+--      the root tagged type in the first package (inherited by the record
+--      extension of the second package, and then in turn by the "generic"
+--      extension), and (2) Update_Pages, declared for the record extension
+--      in the second package. Verify the correctness of the components.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         F340A000.A
+--         F340A001.A
+--      => C340A02.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      12 Jun 96   SAIC    ACVC 2.1: Modified prologue. Removed extraneous
+--                          comments.
+--
+--!
+
+with F340A001;        -- Book definitions.
+package C340A02_0 is  -- Extended book abstraction.
+
+
+   type Detailed_Book_Type is new F340A001.Book_Type with record
+      Pages : Natural;                                        -- Record ext.
+   end record;                                                -- of root tagged
+                                                              -- type.
+
+   -- Inherits Create_Book from Book_Type.
+
+   procedure Update_Pages (Book  : in out Detailed_Book_Type; -- Primitive op.
+                           Pages : in     Natural);           -- of extension.
+
+
+end C340A02_0;
+
+
+     --==================================================================--
+
+
+package body C340A02_0 is
+
+
+   procedure Update_Pages (Book  : in out Detailed_Book_Type;
+                           Pages : in     Natural) is
+   begin
+      Book.Pages := Pages;
+   end Update_Pages;
+
+
+end C340A02_0;
+
+
+     --==================================================================--
+
+
+with F340A001;        -- Book definitions.
+package C340A02_1 is  -- Raw data to be used in creating book elements.
+
+
+   Book_Count : constant := 3;
+
+   subtype Number_Of_Books is Integer range 1 .. Book_Count;
+
+   type Data_List   is array (Number_Of_Books) of F340A001.Text_Ptr;
+   type Page_Counts is array (Number_Of_Books) of Natural;
+
+   Title_List  : Data_List   := (new String'("Wuthering Heights"),
+                                 new String'("Heart of Darkness"),
+                                 new String'("Ulysses"));
+
+   Author_List : Data_List   := (new String'("Bronte, Emily"),
+                                 new String'("Conrad, Joseph"),
+                                 new String'("Joyce, James"));
+
+   Page_List   : Page_Counts := (237, 215, 456);
+
+end C340A02_1;
+
+
+     --==================================================================--
+
+
+-- Library-level instantiation. Actual parameter is record extension.
+
+with C340A02_0;  -- Extended book abstraction.
+with F340A000;   -- Singly-linked list abstraction.
+package C340A02_2 is new F340A000
+  (Parent_Type => C340A02_0.Detailed_Book_Type);
+
+
+     --==================================================================--
+
+
+with Report;
+
+with C340A02_0; -- Extended book abstraction.
+with C340A02_1; -- Raw book data.
+with C340A02_2; -- Instance.
+
+use  C340A02_0; -- Primitive operations of Detailed_Book_Type directly visible.
+use  C340A02_2; -- Operations inherited by Node_Type directly visible.
+
+procedure C340A02 is
+
+
+   List_Of_Books : Node_Ptr := null;  -- Head of linked list of books.
+
+
+          --========================================================--
+
+
+   procedure Create_List (Title, Author : in     C340A02_1.Data_List;
+                          Pages         : in     C340A02_1.Page_Counts;
+                          Head          : in out Node_Ptr) is
+
+      Book     : Node_Type;  -- Object of extended type.
+      Book_Ptr : Node_Ptr;
+
+   begin
+      for I in C340A02_1.Number_Of_Books loop
+         Create_Book (Title (I), Author (I), Book);    -- Call twice-inherited
+                                                       -- operation.
+         Update_Pages (Book, Pages (I));               -- Call inherited op.
+         Book_Ptr := new Node_Type'(Book);
+         Add (Book_Ptr, Head);
+      end loop;
+   end Create_List;
+
+
+          --========================================================--
+
+
+   function Bad_List_Contents return Boolean is
+   begin
+      return (List_Of_Books.Title.all            /= "Ulysses"           or
+              List_Of_Books.Author.all           /= "Joyce, James"      or
+              List_Of_Books.Pages                /= 456                 or
+              List_Of_Books.Next.Title.all       /= "Heart of Darkness" or
+              List_Of_Books.Next.Author.all      /= "Conrad, Joseph"    or
+              List_Of_Books.Next.Pages           /= 215                 or
+              List_Of_Books.Next.Next.Title.all  /= "Wuthering Heights" or
+              List_Of_Books.Next.Next.Author.all /= "Bronte, Emily"     or
+              List_Of_Books.Next.Next.Pages      /= 237);
+
+   end Bad_List_Contents;
+
+
+          --========================================================--
+
+
+begin  -- Main program.
+
+   Report.Test ("C340A02", "Inheritance of primitive operations: record " &
+                "extension of formal tagged private type; actual is " &
+                "a record extension");
+
+   -- Create linked list using inherited operation:
+   Create_List (C340A02_1.Title_List, C340A02_1.Author_List,
+                C340A02_1.Page_List,  List_Of_Books);
+
+   -- Verify results:
+   if Bad_List_Contents then
+      Report.Failed ("Wrong values after call to inherited operations");
+   end if;
+
+   Report.Result;
+
+end C340A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a01.a
new file mode 100644
index 000000000..34a1eeeaa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a01.a
@@ -0,0 +1,117 @@
+-- C341A01.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 formal parameters of a class-wide type can be passed 
+--      values of any specific type within the class.
+--
+-- TEST DESCRIPTION:
+--      Define an object of a root tagged type and of various types derived
+--      from the root.  Define objects of the root class, and initialize them
+--      by parameter association of objects of the specific types (root and 
+--      extended types) within the class.
+--
+--      The particular root and extended types used in this abstraction are
+--      defined in foundation code (F341A00.A), and are graphically displayed
+--      as follows:
+--
+--           package Bank
+--              type Account
+--                  |
+--                  |
+--                  |
+--               package Checking
+--                  type Account
+--                      |
+--                      |
+--                      | 
+--                   package Interest_Checking
+--                          type Account
+--
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         F341A00.A
+--
+--      The following files comprise this test:
+--
+--      => C341A01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with F341A00_0;            -- package Bank
+with F341A00_1;            -- package Checking
+with F341A00_2;            -- package Interest_Checking
+with Report;
+
+procedure C341A01 is
+
+   package Bank              renames F341A00_0;
+   use type Bank.Dollar_Amount;
+   package Checking          renames F341A00_1;
+   package Interest_Checking renames F341A00_2;
+
+   Max_Accts    : constant := 3;
+   Bank_Balance : Bank.Dollar_Amount := 0.00;
+
+   -- Initialize objects of specific tagged types.
+   B_Acct  : Bank.Account              := (Current_Balance => 10.00); 
+   C_Acct  : Checking.Account          := (100.00, 10.00); 
+   IC_Acct : Interest_Checking.Account := (1000.00, 10.00, 0.030);
+
+   -- Define and initialize (by parameter association) objects of class-wide 
+   -- type originating from the root type (Bank.Account).
+
+   -- Define an account auditing procedure with a class-wide
+   -- variable that can hold a value of any object within the class.
+   procedure Audit (Next_Account : Bank.Account'Class) is
+   begin
+      Bank_Balance := Bank_Balance + Next_Account.Current_Balance;
+   end Audit;
+
+
+begin  -- C341A01
+
+   Report.Test ("C341A01", "Check that objects of a class-wide type can " &
+                           "be initialized, by direct assignment, to a "  &
+                           "value of any specific type within the class" ); 
+
+   -- Perform nightly audit of total funds on deposit in bank.
+   Audit (B_Acct);
+   Audit (C_Acct);
+   Audit (IC_Acct);
+
+   if Bank_Balance /= 1110.00 then
+      Report.Failed ("Class-wide object processing failed");
+   end if;
+
+   Report.Result;
+
+end C341A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a02.a
new file mode 100644
index 000000000..4fa9842bf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a02.a
@@ -0,0 +1,145 @@
+-- C341A02.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 class-wide objects can be reassigned with objects from 
+ --      the same specific type used to initialize them.
+ --
+ -- TEST DESCRIPTION:
+ --      Define new objects of specific types from within a class. Reassign
+ --      previously declared class-wide objects with the new specific type 
+ --      objects. Check that new assignments were performed.
+ --
+ --      The particular root and extended types used in this abstraction are
+ --      defined in foundation code (F341A00.A), and are graphically displayed
+ --      as follows:
+ --
+ --           package Bank
+ --              type Account
+ --                  |
+ --                  |
+ --                  |
+ --               package Checking
+ --                  type Account
+ --                      |
+ --                      |
+ --                      | 
+ --                   package Interest_Checking
+ --                          type Account
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         F341A00.A
+ --
+ --      The following files comprise this test:
+ --
+ --      => C341A02.A
+ --
+ --
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+ --!
+ 
+ with F341A00_0;            -- package Bank
+ with F341A00_1;            -- package Checking
+ with F341A00_2;            -- package Interest_Checking
+ with Report;
+ 
+ procedure C341A02 is
+ 
+    package Bank              renames F341A00_0;
+    package Checking          renames F341A00_1;
+    package Interest_Checking renames F341A00_2;
+ 
+    Max_Accts    : constant := 3;
+    Bank_Balance : Bank.Dollar_Amount := 0.00;
+ 
+    -- Define and initialize objects of specific types.
+    B_Acct      : aliased Bank.Account := (Current_Balance => 10.00); 
+    C_Acct      : aliased Checking.Account          := (100.00, 10.00); 
+    IC_Acct     : aliased Interest_Checking.Account := (1000.00, 10.00, 0.030);
+    New_B_Acct  : aliased Bank.Account := (Current_Balance => 20.00);
+    New_C_Acct  : aliased Checking.Account          := (200.00,  20.00);
+    New_IC_Acct : aliased Interest_Checking.Account := (2000.00, 20.00, 0.060);
+ 
+ 
+    -- Define and initialize (by direct assignment) objects of a class-wide 
+    -- type originating from the root type (Bank.Account).
+    
+    type ATM_Card is access all Bank.Account'Class;
+ 
+    Accounts : array (1 .. Max_Accts) of ATM_Card := 
+      (1 => B_Acct'Access, 2 => C_Acct'Access, 3 => IC_Acct'Access);
+ 
+    New_Accounts : array (1 .. Max_Accts) of ATM_Card := 
+      (1 => New_B_Acct'Access,
+       2 => New_C_Acct'Access,
+       3 => New_IC_Acct'Access);
+ 
+    -- Define an account auditing procedure with a class-wide
+    -- variable that can hold a value of any object within the class,
+    -- and once initialized, can hold other values of the same specific type.
+ 
+    procedure Audit (Num : in     integer;
+                     Amt :    out Bank.Dollar_Amount) is
+       Account_Being_Audited : Bank.Account'Class := Accounts(Num).all;
+       use type Bank.Dollar_Amount;
+    begin
+       Amt := Account_Being_Audited.Current_Balance;
+       -- Reassign class-wide variable to another object of the type used to
+       -- initialize it.
+       Account_Being_Audited := New_Accounts(Num).all;
+       Amt := Amt + Account_Being_Audited.Current_Balance;  -- Reading OUT
+    end Audit;                                              -- parameter.
+ 
+ 
+ begin 
+ 
+    Report.Test ("C341A02", "Check that class-wide objects can be "  &
+                            "reassigned with objects from the same " &
+                            "specific type used to initialize them" );
+    Night_Audit:
+    declare
+       use type Bank.Dollar_Amount;
+       Acct_Value : Bank.Dollar_Amount := 0.00;
+    begin
+       -- Perform nightly audit of total funds on deposit in bank.
+       for i in 1 .. Max_Accts loop
+          Audit (i, Acct_Value);
+          Bank_Balance := Bank_Balance + Acct_Value;
+       end loop;
+ 
+       if Bank_Balance /= 3330.00 then
+          Report.Failed ("Class-wide object processing failed");
+       end if;
+ 
+    end Night_Audit;
+ 
+    Report.Result;
+ 
+ end C341A02;
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a03.a
new file mode 100644
index 000000000..0911e636d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a03.a
@@ -0,0 +1,140 @@
+-- C341A03.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 an object of one class-wide type can initialize a 
+--      class-wide object of a different type when the operation is embedded
+--      in a generic unit.
+--
+-- TEST DESCRIPTION:
+--      Declare specific-type objects of an extended type.  Declare an array
+--      of access values designating class-wide objects, initialized to point
+--      to the objects of the specific type.  Define a generic subprogram
+--      having a generic formal derived type parameter.  Within the generic,
+--      declare a class-wide variable of the formal parameter type.  Verify
+--      that the variable can be initialized with the value of an object
+--      of another class-wide type within the class.
+--
+--      The particular root and extended types used in this abstraction are
+--      defined in foundation code (F341A00.A), and are graphically displayed
+--      as follows:
+--
+--           package Bank
+--              type Account
+--                  |
+--                  |
+--                  |
+--               package Checking
+--                  type Account
+--                      |
+--                      |
+--                      | 
+--                   package Interest_Checking
+--                          type Account
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         F341A00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      16 Dec 94   SAIC    Changed level of 'Class for ATM_Card
+--
+--!
+
+with F341A00_0;            -- package Bank
+generic
+   type Account_Type is new F341A00_0.Account with private; -- new Bank.Account
+function C341A03_0 (The_Account : Account_Type'Class)       -- function Audit
+  return F341A00_0.Dollar_Amount;
+
+function C341A03_0 (The_Account : Account_Type'Class)
+  return F341A00_0.Dollar_Amount is
+   Acct : Account_Type'Class := The_Account;  -- Init. of class-wide with
+begin                                         -- another class-wide object.
+   return Acct.Current_Balance;
+end C341A03_0;
+
+
+     --=================================================================--
+
+
+with F341A00_0;            -- package Bank
+with F341A00_1;            -- package Checking
+with C341A03_0;            -- generic function Audit
+with Report;
+
+procedure C341A03 is
+
+   package Bank     renames F341A00_0;
+   package Checking renames F341A00_1;
+
+   Current_Checking_Accounts : constant := 3;
+
+   Checking_Acct1 : aliased Checking.Account := (Current_Balance => 10.00,
+                                                 Overdraft_Fee   =>  5.00);
+   Checking_Acct2 : aliased Checking.Account := (Current_Balance => 20.00,
+                                                 Overdraft_Fee   =>  5.00);
+   Checking_Acct3 : aliased Checking.Account := (Current_Balance => 30.00,
+                                                 Overdraft_Fee   =>  5.00);
+
+   type ATM_Card is access all Checking.Account'Class;
+
+   -- Declare array of accesses to class-wide objects.
+   Account_Array : array (1 .. Current_Checking_Accounts) of 
+     ATM_Card := (Checking_Acct1'Access, 
+                  Checking_Acct2'Access, 
+                  Checking_Acct3'Access);
+begin  -- C341A03
+
+   Report.Test ("C341A03",  "Check that an object of one class-wide type " &
+                            "can initialize a class-wide object of a "   &
+                            "different type when the operation is embedded " &
+                            "in a generic unit" );
+
+   Audit_Checking_Accounts:
+   declare
+      Balance_In_Checking_Accounts : Bank.Dollar_Amount := 0.00;
+      -- Instantiate with a specific extended type.
+      function Checking_Audit is new C341A03_0 (Checking.Account);
+      use type Bank.Dollar_Amount;
+   begin
+
+      for I in 1 .. Current_Checking_Accounts loop
+         Balance_In_Checking_Accounts := Balance_In_Checking_Accounts + 
+           Checking_Audit (Account_Array (I).all);
+      end loop;
+
+      if Balance_In_Checking_Accounts /= 60.00 then
+         Report.Failed ("Incorrect initialization of class-wide object");
+      end if;
+
+   end Audit_Checking_Accounts;
+
+   Report.Result;
+
+end C341A03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a04.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a04.a
new file mode 100644
index 000000000..d7392568e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c341a04.a
@@ -0,0 +1,141 @@
+-- C341A04.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 class-wide objects can be initialized using allocation. 
+ --
+ -- TEST DESCRIPTION:
+ --      Declare access types that refer to class-wide types, one with basis
+ --      of the root type, another with basis of a type extended from the root.
+ --      Declare objects of these access types, and allocate class-wide
+ --      objects, initialized to values of specific types within the particular
+ --      classes.
+ --
+ --      The particular root and extended types used in this abstraction are
+ --      defined in foundation code (F341A00.A), and are graphically displayed
+ --      as follows:
+ --
+ --           package Bank
+ --              type Account
+ --                  |
+ --                  |
+ --                  |
+ --               package Checking
+ --                  type Account
+ --                      |
+ --                      |
+ --                      | 
+ --                   package Interest_Checking
+ --                          type Account
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         F341A00.A
+ --
+ --      The following files comprise this test:
+ --
+ --      => C341A04.A
+ --
+ --
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+ --!
+ 
+ with F341A00_0;            -- package Bank
+ with F341A00_1;            -- package Checking
+ with F341A00_2;            -- package Interest_Checking
+ with Report;
+ 
+ procedure C341A04 is
+ 
+    package Bank              renames F341A00_0;
+    package Checking          renames F341A00_1;
+    package Interest_Checking renames F341A00_2;
+ 
+    use type Bank.Dollar_Amount;
+ 
+    Max_Accts    : constant := 3;
+    Bank_Balance : Bank.Dollar_Amount := 0.00;
+ 
+    -- Define access types referring to class of types rooted at 
+    -- Bank.Account (root). 
+ 
+    type Bank_Account_Pointer is access Bank.Account'Class;
+ 
+    --
+    -- Define class-wide objects, initializing them through allocation.
+    --
+ 
+    -- Initialized to specific type that is basis of class.
+    Bank_Acct : Bank_Account_Pointer :=
+      new Bank.Account'(Current_Balance => 10.00);
+ 
+    -- Initialized to specific type that has been extended from the basis
+    -- of the class.
+    Checking_Acct : Bank_Account_Pointer :=
+      new Checking.Account'(Current_Balance => 100.00,
+                            Overdraft_Fee   =>  10.00);
+ 
+    -- Initialized to specific type that has been twice extended from the
+    -- basis of the class.
+    IC_Acct : Bank_Account_Pointer := 
+      new Interest_Checking.Account'(Current_Balance => 1000.00,
+                                     Overdraft_Fee   =>   10.00,
+                                     Rate            =>    0.030);
+ 
+    -- Declare and initialize array of pointers to objects of
+    -- Bank.Account'Class.
+ 
+    Accounts : array (1 .. Max_Accts) of Bank_Account_Pointer :=
+      (Bank_Acct, Checking_Acct, IC_Acct);
+ 
+ 
+    -- Audit will process any account object within Bank.Account'Class.
+ 
+    function Audit (Ptr : Bank_Account_Pointer) return Bank.Dollar_Amount is
+    begin
+       return (Ptr.Current_Balance);
+    end Audit;
+ 
+ 
+ begin  -- C341A04
+ 
+    Report.Test ("C341A04", "Check that class-wide objects were " &
+                            "successfully initialized using allocation" );
+ 
+    for i in 1 .. Max_Accts loop
+       Bank_Balance := Bank_Balance + Audit (Accounts(i));
+    end loop;
+ 
+    if Bank_Balance /= 1110.00 then
+       Report.Failed ("Failed class-wide object allocation");
+    end if;
+ 
+    Report.Result;
+ 
+ end C341A04;
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35003a.ada
new file mode 100644
index 000000000..c384683fd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35003a.ada
@@ -0,0 +1,234 @@
+-- C35003A.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 CONSTRAINT_ERROR IS RAISED FOR AN INTEGER OR
+--     ENUMERATION SUBTYPE INDICATION WHEN THE LOWER OR UPPER BOUND
+--     OF A NON-NULL RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
+
+-- HISTORY:
+--     JET 01/25/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35003A IS
+
+     TYPE ENUM IS (ZERO, ONE, TWO, THREE);
+     SUBTYPE SUBENUM IS ENUM RANGE ONE..TWO;
+     TYPE INT IS RANGE 1..10;
+     SUBTYPE SUBINT IS INTEGER RANGE -10..10;
+     TYPE A1 IS ARRAY (0..11) OF INTEGER;
+     TYPE A2 IS ARRAY (INTEGER RANGE -11..10) OF INTEGER;
+
+BEGIN
+     TEST ("C35003A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR AN " &
+                      "INTEGER OR ENUMERATION SUBTYPE INDICATION " &
+                      "WHEN THE LOWER OR UPPER BOUND OF A NON-NULL " &
+                      "RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK");
+     BEGIN
+          DECLARE
+               SUBTYPE SUBSUBENUM IS SUBENUM RANGE ZERO..TWO;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED (E1)");
+               DECLARE
+                    Z : SUBSUBENUM := ONE;
+               BEGIN
+                    IF NOT EQUAL(SUBSUBENUM'POS(Z),SUBSUBENUM'POS(Z))
+                    THEN
+                         COMMENT ("DON'T OPTIMIZE Z");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN WRONG PLACE (E1)");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED (E1)");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (SUBENUM RANGE ONE..THREE) OF INTEGER;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED (E2)");
+               DECLARE
+                    Z : A := (OTHERS => 0);
+               BEGIN
+                    IF NOT EQUAL(Z(ONE),Z(ONE)) THEN
+                         COMMENT ("DON'T OPTIMIZE Z");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN WRONG PLACE (E2)");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED (E2)");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE I IS ACCESS INT RANGE INT(IDENT_INT(0))..10;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED (I1)");
+               DECLARE
+                    Z : I := NEW INT'(1);
+               BEGIN
+                    IF NOT EQUAL(INTEGER(Z.ALL),INTEGER(Z.ALL)) THEN
+                         COMMENT ("DON'T OPTIMIZE Z");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN WRONG PLACE (I1)");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED (I1)");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE I IS NEW INT RANGE 1..INT'SUCC(10);
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED (I2)");
+               DECLARE
+                    Z : I := 1;
+               BEGIN
+                    IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                         COMMENT ("DON'T OPTIMIZE Z");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN WRONG PLACE (I2)");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED (I2)");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE R IS RECORD
+                    A : SUBINT RANGE IDENT_INT(-11)..0;
+               END RECORD;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED (S1)");
+               DECLARE
+                    Z : R := (A => 1);
+               BEGIN
+                    IF NOT EQUAL(INTEGER(Z.A),INTEGER(Z.A)) THEN
+                         COMMENT ("DON'T OPTIMIZE Z");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN WRONG PLACE (S1)");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED (S1)");
+     END;
+
+     BEGIN
+          DECLARE
+               Z : SUBINT RANGE 0..IDENT_INT(11) := 0;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED (S2)");
+               IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                    COMMENT ("DON'T OPTIMIZE Z");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN WRONG PLACE (S2)");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED (S2)");
+     END;
+
+     BEGIN
+          DECLARE
+               SUBTYPE I IS SUBINT RANGE A1'RANGE;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED (R1)");
+               DECLARE
+                    Z : I := 1;
+               BEGIN
+                    IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                         COMMENT ("DON'T OPTIMIZE Z");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN WRONG PLACE (R1)");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED (R1)");
+     END;
+
+     BEGIN
+          DECLARE
+               SUBTYPE I IS SUBINT RANGE A2'RANGE;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED (R2)");
+               DECLARE
+                    Z : I := 1;
+               BEGIN
+                    IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                         COMMENT ("DON'T OPTIMIZE Z");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN WRONG PLACE (R2)");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED (R2)");
+     END;
+
+     RESULT;
+
+END C35003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35003b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35003b.ada
new file mode 100644
index 000000000..3eebde438
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35003b.ada
@@ -0,0 +1,217 @@
+-- C35003B.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 CONSTRAINT_ERROR IS RAISED FOR A SUBTYPE INDICATION
+--     OF A DISCRETE GENERIC FORMAL TYPE WHEN THE LOWER OR UPPER BOUND
+--     OF A NON-NULL RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
+
+-- HISTORY:
+--     JET 07/08/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35003B IS
+
+     TYPE ENUM IS (WE, LOVE, WRITING, TESTS);
+     TYPE INT IS RANGE -10..10;
+
+     GENERIC
+          TYPE GEN_ENUM IS (<>);
+          TYPE GEN_INT IS RANGE <>;
+     PACKAGE GEN_PACK IS
+          SUBTYPE SUBENUM IS GEN_ENUM RANGE
+               GEN_ENUM'SUCC(GEN_ENUM'FIRST) ..
+               GEN_ENUM'PRED(GEN_ENUM'LAST);
+          SUBTYPE SUBINT IS GEN_INT RANGE
+               GEN_INT'SUCC(GEN_INT'FIRST) ..
+               GEN_INT'PRED(GEN_INT'LAST);
+          TYPE A1 IS ARRAY (0..GEN_INT'LAST) OF INTEGER;
+          TYPE A2 IS ARRAY (GEN_INT RANGE GEN_INT'FIRST..0) OF INTEGER;
+     END GEN_PACK;
+
+     PACKAGE BODY GEN_PACK IS
+     BEGIN
+          TEST ("C35003B", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                           "FOR A SUBTYPE INDICATION OF A DISCRETE " &
+                           "GENERIC FORMAL TYPE WHEN THE LOWER OR " &
+                           "UPPER BOUND OF A NON-NULL RANGE LIES " &
+                           "OUTSIDE THE RANGE OF THE TYPE MARK");
+          BEGIN
+               DECLARE
+                    SUBTYPE SUBSUBENUM IS SUBENUM RANGE
+                         GEN_ENUM'FIRST..SUBENUM'LAST;
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED (E1)");
+                    DECLARE
+                         Z : SUBSUBENUM := SUBENUM'FIRST;
+                    BEGIN
+                         IF NOT EQUAL(SUBSUBENUM'POS(Z),
+                                      SUBSUBENUM'POS(Z)) THEN
+                              COMMENT ("DON'T OPTIMIZE Z");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN WRONG " &
+                                 "PLACE (E1)");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED (E1)");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE A IS ARRAY (SUBENUM RANGE SUBENUM'FIRST ..
+                         GEN_ENUM'LAST) OF INTEGER;
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED (E2)");
+                    DECLARE
+                         Z : A := (OTHERS => 0);
+                    BEGIN
+                         IF NOT EQUAL(Z(SUBENUM'FIRST),
+                                      Z(SUBENUM'FIRST)) THEN
+                              COMMENT ("DON'T OPTIMIZE Z");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
+                                 "(E2)");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED (E2)");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE I IS ACCESS SUBINT RANGE
+                         GEN_INT'FIRST..SUBINT'LAST;
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED (I1)");
+                    DECLARE
+                         Z : I := NEW SUBINT'(SUBINT'FIRST);
+                    BEGIN
+                         IF NOT EQUAL(INTEGER(Z.ALL),INTEGER(Z.ALL))
+                         THEN
+                              COMMENT ("DON'T OPTIMIZE Z");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
+                                 "(I1)");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED (I1)");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE I IS NEW
+                         SUBINT RANGE SUBINT'FIRST..GEN_INT'LAST;
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED (I2)");
+                    DECLARE
+                         Z : I := I'FIRST;
+                    BEGIN
+                         IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                              COMMENT ("DON'T OPTIMIZE Z");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
+                                 "(I2)");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED (I2)");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE I IS SUBINT RANGE A1'RANGE;
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED (R1)");
+                    DECLARE
+                         Z : I := SUBINT'FIRST;
+                    BEGIN
+                         IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                              COMMENT ("DON'T OPTIMIZE Z");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
+                                 "(R1)");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED (R1)");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE I IS SUBINT RANGE A2'RANGE;
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED (R2)");
+                    DECLARE
+                         Z : I := 1;
+                    BEGIN
+                         IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                              COMMENT ("DON'T OPTIMIZE Z");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
+                                 "(R2)");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED (R2)");
+          END;
+     END GEN_PACK;
+
+     PACKAGE ENUM_PACK IS NEW GEN_PACK(ENUM, INT);
+
+BEGIN
+     RESULT;
+END C35003B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35003d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35003d.ada
new file mode 100644
index 000000000..c5241ee80
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35003d.ada
@@ -0,0 +1,92 @@
+-- C35003D.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 CONSTRAINT_ERROR IS RAISED FOR A FLOATING-POINT
+--     SUBTYPE INDICATION WHEN THE LOWER OR UPPER BOUND OF A NON-NULL
+--     RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
+
+-- HISTORY:
+--     JET 07/11/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35003D IS
+
+     SUBTYPE FLT1 IS FLOAT RANGE -100.0 .. 100.0;
+
+BEGIN
+     TEST ("C35003D", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
+                      "FLOATING-POINT SUBTYPE INDICATION WHEN THE " &
+                      "LOWER OR UPPER BOUND OF A NON-NULL RANGE LIES " &
+                      "OUTSIDE THE RANGE OF THE TYPE MARK");
+     BEGIN
+          DECLARE
+               SUBTYPE F IS FLT1 RANGE 0.0..101.0+FLT1(IDENT_INT(0));
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED (F1)");
+               DECLARE
+                    Z : F := 1.0;
+               BEGIN
+                    IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                         COMMENT ("DON'T OPTIMIZE Z");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN WRONG PLACE (F1)");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED (F1)");
+     END;
+
+     BEGIN
+          DECLARE
+               SUBTYPE F IS FLT1 RANGE -101.0..0.0;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED (F2)");
+               DECLARE
+                    Z : F := -1.0;
+               BEGIN
+                    IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
+                         COMMENT ("DON'T OPTIMIZE Z");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN WRONG PLACE (F2)");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED (F2)");
+     END;
+
+     RESULT;
+
+END C35003D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35102a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35102a.ada
new file mode 100644
index 000000000..a5ca875e4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35102a.ada
@@ -0,0 +1,364 @@
+-- C35102A.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 ENUMERATION LITERAL BELONGING TO ONE ENUMERATION TYPE
+-- MAY BE DECLARED IN ANOTHER ENUMERATION TYPE DEFINITION IN THE SAME
+-- DECLARATIVE REGION.
+
+-- R.WILLIAMS 8/20/86
+-- GMT 6/30/87           MOVED THE CALL TO  REPORT.TEST INTO A NEWLY
+--                       CREATED PACKAGE NAMED SHOW_TEST_HEADER.
+--                       ADDED CODE FOR MY_PACK AND MY_FTN.
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35102A IS
+
+     TYPE E1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+     TYPE E2 IS ('A', 'C', RED, BLUE);
+
+     PACKAGE  SHOW_TEST_HEADER  IS
+              -- PURPOSE OF THIS PACKAGE:
+              -- WE WANT THE TEST HEADER INFORMATION TO BE
+              -- PRINTED  BEFORE  ANY OF THE  PASS/FAIL  MESSAGES.
+     END SHOW_TEST_HEADER;
+
+     PACKAGE  BODY  SHOW_TEST_HEADER  IS
+     BEGIN
+          TEST ( "C35102A",
+                 "CHECK THAT AN ENUMERATION LITERAL BELONGING "   &
+                 "TO ONE ENUMERATION TYPE MAY BE DECLARED IN "    &
+                 "ANOTHER ENUMERATION TYPE DEFINITION IN THE "    &
+                 "SAME DECLARATIVE REGION" );
+     END SHOW_TEST_HEADER;
+
+     FUNCTION  MY_FTN (  E : E1  ) RETURN  E2  IS
+          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+     BEGIN
+          IF ENUM2'SUCC ('A') /= 'C' THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN MY_FTN - 1" );
+          END IF;
+
+          IF ENUM1'POS (RED) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN MY_FTN - 1" );
+          END IF;
+
+          RETURN E2'VAL (  IDENT_INT ( E1'POS(E) )  );
+     END MY_FTN;
+
+
+     PACKAGE MY_PACK IS
+     END MY_PACK;
+
+     PACKAGE BODY MY_PACK IS
+          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+     BEGIN  -- MY_PACK
+          IF ENUM2'SUCC ('A') /= 'C' THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN MY_PACK - 1" );
+          END IF;
+
+          IF ENUM1'POS (RED) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN MY_PACK - 1" );
+          END IF;
+     END MY_PACK;
+
+     PACKAGE PKG IS
+          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF ENUM2'SUCC ('A') /= 'C' THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN PKG - 1" );
+          END IF;
+
+          IF ENUM1'POS (RED) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN PKG - 1" );
+          END IF;
+     END PKG;
+
+     PACKAGE PRIV IS
+          TYPE ENUM1 IS PRIVATE;
+          TYPE ENUM2 IS PRIVATE;
+
+          FUNCTION FE1 (E : E1) RETURN ENUM1;
+
+          FUNCTION FE2 (E : E2) RETURN ENUM2;
+
+     PRIVATE
+          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+
+     END PRIV;
+
+     PACKAGE BODY PRIV IS
+          FUNCTION FE1 (E : E1) RETURN ENUM1 IS
+          BEGIN
+               RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));
+          END FE1;
+
+          FUNCTION FE2 (E : E2) RETURN ENUM2 IS
+          BEGIN
+               RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));
+          END FE2;
+
+     BEGIN
+          IF ENUM2'SUCC ('A') /= 'C' THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN PRIV - 1" );
+          END IF;
+
+          IF ENUM1'POS (RED) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN PRIV - 1" );
+          END IF;
+     END PRIV;
+
+     PACKAGE LPRIV IS
+          TYPE ENUM1 IS LIMITED PRIVATE;
+          TYPE ENUM2 IS LIMITED PRIVATE;
+
+          FUNCTION FE1 (E : E1) RETURN ENUM1;
+
+          FUNCTION FE2 (E : E2) RETURN ENUM2;
+
+          FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN;
+
+          FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN;
+
+     PRIVATE
+          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+
+     END LPRIV;
+
+     PACKAGE BODY LPRIV IS
+          FUNCTION FE1 (E : E1) RETURN ENUM1 IS
+          BEGIN
+               RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));
+          END FE1;
+
+          FUNCTION FE2 (E : E2) RETURN ENUM2 IS
+          BEGIN
+               RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));
+          END FE2;
+
+          FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN IS
+          BEGIN
+               IF A = B THEN
+                    RETURN TRUE;
+               ELSE
+                    RETURN FALSE;
+               END IF;
+          END EQUALS;
+
+          FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN IS
+          BEGIN
+               IF A = B THEN
+                    RETURN TRUE;
+               ELSE
+                    RETURN FALSE;
+               END IF;
+          END EQUALS;
+     BEGIN
+          IF ENUM2'SUCC ('A') /= 'C' THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN LPRIV - 1" );
+          END IF;
+
+          IF ENUM1'POS (RED) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN LPRIV - 2" );
+          END IF;
+     END LPRIV;
+
+     TASK T1;
+
+     TASK BODY T1 IS
+          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+
+     BEGIN
+          IF ENUM2'SUCC ('A') /= 'C' THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN T1" );
+          END IF;
+
+          IF ENUM1'POS (RED) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN T1" );
+          END IF;
+     END T1;
+
+     TASK T2 IS
+          ENTRY E;
+     END T2;
+
+     TASK BODY T2 IS
+     BEGIN
+          ACCEPT E DO
+               DECLARE
+                    TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+                    TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+
+               BEGIN
+                    IF ENUM2'SUCC ('A') /= 'C' THEN
+                    FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                             "IN T2.E" );
+                    END IF;
+
+                    IF ENUM1'POS (RED) /= 3 THEN
+                         FAILED ( "RED NOT DECLARED CORRECTLY IN " &
+                                  "ENUM1 IN T2.E" );
+                    END IF;
+               END;
+          END E;
+     END T2;
+
+     GENERIC
+     PROCEDURE GP1;
+
+     PROCEDURE GP1 IS
+          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+
+     BEGIN
+          IF ENUM2'SUCC ('A') /= 'C' THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN GP1" );
+          END IF;
+
+          IF ENUM1'POS (RED) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN GP1" );
+          END IF;
+     END GP1;
+
+     GENERIC
+          TYPE E1 IS (<>);
+          TYPE E2 IS (<>);
+     PROCEDURE GP2;
+
+     PROCEDURE GP2 IS
+     BEGIN
+          IF E2'SUCC (E2'VALUE ("'A'")) /= E2'VALUE ("'C'") THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN E2 " &
+                        "IN GP2" );
+          END IF;
+
+          IF E1'POS (E1'VALUE ("RED")) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN E1 " &
+                        "IN GP2" );
+          END IF;
+     END GP2;
+
+     PROCEDURE NEWGP1 IS NEW GP1;
+     PROCEDURE NEWGP2 IS NEW GP2 (E1, E2);
+
+BEGIN
+
+     DECLARE
+          TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
+          TYPE ENUM2 IS ('A', 'C', RED, BLUE);
+
+     BEGIN
+          IF ENUM2'SUCC ('A') /= 'C' THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN BLOCK" );
+          END IF;
+
+          IF ENUM1'POS (RED) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN BLOCK" );
+          END IF;
+     END;
+
+     DECLARE
+          USE PKG;
+     BEGIN
+          IF ENUM2'SUCC ('A') /= 'C' THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN PKG - 2" );
+          END IF;
+
+          IF ENUM1'POS (RED) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN PKG - 2" );
+          END IF;
+     END;
+
+     DECLARE
+          USE PRIV;
+     BEGIN
+          IF FE2 (E2'SUCC('A')) /= FE2 ('C') THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN PRIV - 2" );
+          END IF;
+
+          IF FE1 (RED) /= FE1 (E1'VAL (3)) THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN PRIV - 2" );
+          END IF;
+     END;
+
+     DECLARE
+          USE LPRIV;
+     BEGIN
+          IF NOT EQUALS (FE2 (E2'SUCC('A')), FE2 ('C')) THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
+                        "IN LPRIV - 2" );
+          END IF;
+
+          IF NOT EQUALS (FE1 (RED), FE1 (E1'VAL (3))) THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
+                        "IN LPRIV - 2" );
+          END IF;
+     END;
+
+     BEGIN
+          IF E2'SUCC ('A') /= 'C' THEN
+               FAILED ( "'A' NOT DECLARED CORRECTLY IN E2" );
+          END IF;
+
+          IF E1'POS (RED) /= 3 THEN
+               FAILED ( "RED NOT DECLARED CORRECTLY IN E1" );
+          END IF;
+     END;
+
+     NEWGP1;
+     NEWGP2;
+     T2.E;
+
+     RESULT;
+END C35102A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c354002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c354002.a
new file mode 100644
index 000000000..3129182b7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c354002.a
@@ -0,0 +1,335 @@
+--
+-- C354002.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 attributes of modular types yield
+--      correct values/results.  The attributes checked are:
+--
+--      First, Last, Range, Base, Min, Max, Succ, Pred, 
+--      Image, Width, Value, Pos, and Val
+--
+-- TEST DESCRIPTION:
+--      This test defines several modular types.  One type defined at
+--      each of System.Max_Binary_Modulus, System.Max_Nonbinary_Modulus,
+--      a power of two half that of System.Max_Binary_Modulus, one less
+--      than that power of two; one more than that power of two, two
+--      less than a (large) power of two.  For each of these types,
+--      determine the correct operation of the following attributes:
+--
+--      First, Last, Range, Base, Min, Max, Succ, Pred, Image, Width,
+--      Value, Pos, Val, and Modulus
+--
+--      The attributes Wide_Image and Wide_Value are deferred to C354003.
+--
+--
+--
+-- CHANGE HISTORY:
+--      08 SEP 94   SAIC    Initial version
+--      17 NOV 94   SAIC    Revised version
+--      13 DEC 94   SAIC    split off Wide_String attributes into C354003
+--      06 JAN 95   SAIC    Promoted to next release
+--      19 APR 95   SAIC    Revised in accord with reviewer comments
+--      27 JAN 96   SAIC    Eliminated 32/64 bit potential conflict for 2.1
+--
+--!
+
+with Report;
+with System;
+with TCTouch;
+procedure C354002 is
+
+  function ID(Local_Value: Integer) return Integer renames Report.Ident_Int;
+  function ID(Local_Value: String)  return String renames  Report.Ident_Str;
+
+  Power_2_Bits          : constant := System.Storage_Unit;
+  Half_Max_Binary_Value : constant := System.Max_Binary_Modulus / 2;
+
+  type Max_Binary      is mod System.Max_Binary_Modulus;
+  type Max_NonBinary   is mod System.Max_Nonbinary_Modulus;
+  type Half_Max_Binary is mod Half_Max_Binary_Value;
+
+  type Medium          is mod 2048;
+  type Medium_Plus     is mod 2042;
+  type Medium_Minus    is mod 2111;
+
+  type Small  is mod 2;
+  type Finger is mod 5;
+
+  MBL  : constant := Max_NonBinary'Last;
+  MNBM : constant := Max_NonBinary'Modulus;
+
+  Ones_Complement_Permission : constant Boolean := MBL = MNBM;
+
+  type Finger_Id is (Thumb, Index, Middle, Ring, Pinkie);
+
+  subtype Midrange is Medium_Minus range 222 .. 1111;
+
+-- a few numbers for testing purposes
+  Max_Binary_Mod_Over_3      : constant := Max_Binary'Modulus / 3;
+  Max_NonBinary_Mod_Over_4   : constant := Max_NonBinary'Modulus / 4;
+  System_Max_Bin_Mod_Pred    : constant := System.Max_Binary_Modulus - 1;
+  System_Max_NonBin_Mod_Pred : constant := System.Max_Nonbinary_Modulus - 1;
+  Half_Max_Bin_Value_Pred    : constant := Half_Max_Binary_Value - 1;
+
+  AMB,   BMB   : Max_Binary;
+  AHMB,  BHMB  : Half_Max_Binary;
+  AM,    BM    : Medium;
+  AMP,   BMP   : Medium_Plus;
+  AMM,   BMM   : Medium_Minus;
+  AS,    BS    : Small;
+  AF,    BF    : Finger;
+
+  TC_Pass_Case : Boolean := True;
+
+  procedure Value_Fault( S: String ) is
+  -- check 'Value for failure modes
+  begin
+    -- the evaluation of the 'Value expression should raise C_E
+    TCTouch.Assert_Not( Midrange'Value(S) = 0, "Value_Fault" );
+    if Midrange'Value(S) not in Midrange'Base then
+      Report.Failed("'Value(" & S & ") raised no exception");
+    end if;
+  exception
+    when Constraint_Error => null; -- expected case
+    when others =>
+         Report.Failed("'Value(" & S & ") raised wrong exception");
+  end Value_Fault;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C354002", "Check attributes of modular types" );
+
+-- Base
+  TCTouch.Assert( Midrange'Base'First = 0, "Midrange'Base'First" );
+  TCTouch.Assert( Midrange'Base'Last  = Medium_Minus'Last,
+                  "Midrange'Base'Last" );
+
+-- First
+  TCTouch.Assert( Max_Binary'First = 0,         "Max_Binary'First" );
+  TCTouch.Assert( Max_NonBinary'First = 0,      "Max_NonBinary'First" );
+  TCTouch.Assert( Half_Max_Binary'First = 0,    "Half_Max_Binary'First" );
+
+  TCTouch.Assert( Medium'First = Medium(ID(0)), "Medium'First" );
+  TCTouch.Assert( Medium_Plus'First = Medium_Plus(ID(0)),
+                                                "Medium_Plus'First" );
+  TCTouch.Assert( Medium_Minus'First = Medium_Minus(ID(0)),
+                                                "Medium_Minus'First" );
+
+  TCTouch.Assert( Small'First = Small(ID(0)),   "Small'First" );
+  TCTouch.Assert( Finger'First = Finger(ID(0)), "Finger'First" );
+  TCTouch.Assert( Midrange'First = Midrange(ID(222)),
+                                                "Midrange'First" );
+
+-- Image
+  TCTouch.Assert( Half_Max_Binary'Image(255) = " 255",
+                 "Half_Max_Binary'Image" );
+  TCTouch.Assert( Medium'Image(0) = ID(" 0"),  "Medium'Image" );
+  TCTouch.Assert( Medium_Plus'Image(Medium_Plus'Last) = " 2041",
+                 "Medium_Plus'Image" );
+  TCTouch.Assert( Medium_Minus'Image(Medium_Minus(ID(1024))) = " 1024",
+                 "Medium_Minus'Image" );
+  TCTouch.Assert( Small'Image(Small(ID(1))) = " 1", "Small'Image" );
+  TCTouch.Assert( Midrange'Image(Midrange(ID(333))) = " 333",
+                  "Midrange'Image" );
+
+-- Last
+  TCTouch.Assert( Max_Binary'Last      = System_Max_Bin_Mod_Pred,
+                 "Max_Binary'Last");
+  if Ones_Complement_Permission then
+    TCTouch.Assert( Max_NonBinary'Last >= System_Max_NonBin_Mod_Pred,
+                   "Max_NonBinary'Last (ones comp)");
+  else
+    TCTouch.Assert( Max_NonBinary'Last   = System_Max_NonBin_Mod_Pred,
+                   "Max_NonBinary'Last");
+  end if;
+  TCTouch.Assert( Half_Max_Binary'Last = Half_Max_Bin_Value_Pred,
+                 "Half_Max_Binary'Last");
+
+  TCTouch.Assert( Medium'Last          = Medium(ID(2047)), "Medium'Last");
+  TCTouch.Assert( Medium_Plus'Last     = Medium_Plus(ID(2041)),
+                  "Medium_Plus'Last");
+  TCTouch.Assert( Medium_Minus'Last    = Medium_Minus(ID(2110)),
+                  "Medium_Minus'Last");
+  TCTouch.Assert( Small'Last    = Small(ID(1)), "Small'Last");
+  TCTouch.Assert( Finger'Last   = Finger(ID(4)), "Finger'Last");
+  TCTouch.Assert( Midrange'Last = Midrange(ID(1111)), "Midrange'Last");
+
+-- Max
+  TCTouch.Assert( Max_Binary'Max(Power_2_Bits, Max_Binary'Last)
+                  = Max_Binary'Last,                     "Max_Binary'Max");
+  TCTouch.Assert( Max_NonBinary'Max(100,2000) = 2000, "Max_NonBinary'Max");
+  TCTouch.Assert( Half_Max_Binary'Max(123,456) = 456,
+                                                    "Half_Max_Binary'Max");
+
+  TCTouch.Assert( Medium'Max(0,2040) = 2040,                 "Medium'Max");
+  TCTouch.Assert( Medium_Plus'Max(0,1) = 1,             "Medium_Plus'Max");
+  TCTouch.Assert( Medium_Minus'Max(2001,1995) = 2001,  "Medium_Minus'Max");
+  TCTouch.Assert( Small'Max(1,0) = 1,                         "Small'Max");
+  TCTouch.Assert( Finger'Max(Finger'Last+1,4) = 4,           "Finger'Max");
+  TCTouch.Assert( Midrange'Max(Midrange'First+1,222) = Midrange'First+1,
+                                                          "Midrange'Max");
+
+-- Min
+  TCTouch.Assert( Max_Binary'Min(Power_2_Bits, Max_Binary'Last)
+                  = Power_2_Bits,                        "Max_Binary'Min");
+  TCTouch.Assert( Max_NonBinary'Min(100,2000) = 100,  "Max_NonBinary'Min");
+  TCTouch.Assert( Half_Max_Binary'Min(123,456) = 123,
+                                                    "Half_Max_Binary'Min");
+
+  TCTouch.Assert( Medium'Min(0,Medium(ID(2040))) = 0,        "Medium'Min");
+  TCTouch.Assert( Medium_Plus'Min(0,1) = 0,             "Medium_Plus'Min");
+  TCTouch.Assert( Medium_Minus'Min(2001,1995) = 1995,  "Medium_Minus'Min");
+  TCTouch.Assert( Small'Min(1,0) = 0,                         "Small'Min");
+  TCTouch.Assert( Finger'Min(Finger'Last+1,4) /= 4,          "Finger'Min");
+  TCTouch.Assert( Midrange'Min(Midrange'First+1,222) = 222,
+                                                          "Midrange'Min");
+-- Modulus
+  TCTouch.Assert( Max_Binary'Modulus = System.Max_Binary_Modulus,
+                 "Max_Binary'Modulus");
+  TCTouch.Assert( Max_NonBinary'Modulus = System.Max_Nonbinary_Modulus,
+                 "Max_NonBinary'Modulus");
+  TCTouch.Assert( Half_Max_Binary'Modulus = Half_Max_Binary_Value,
+                 "Half_Max_Binary'Modulus");
+
+  TCTouch.Assert( Medium'Modulus       = 2048, "Medium'Modulus");
+  TCTouch.Assert( Medium_Plus'Modulus  = 2042, "Medium_Plus'Modulus");
+  TCTouch.Assert( Medium_Minus'Modulus = 2111, "Medium_Minus'Modulus");
+  TCTouch.Assert( Small'Modulus        =    2, "Small'Modulus");
+  TCTouch.Assert( Finger'Modulus       =    5, "Finger'Modulus");
+  TCTouch.Assert( Midrange'Modulus = ID(2111), "Midrange'Modulus");
+
+-- Pos
+  declare
+    Int : Natural := 222;
+  begin
+    for I in Midrange loop
+      TC_Pass_Case := TC_Pass_Case and Midrange'Pos(I) = Int;
+                    
+      Int := Int +1;
+    end loop;
+  end;
+
+  TCTouch.Assert( TC_Pass_Case, "Midrange'Pos");
+
+-- Pred
+  TCTouch.Assert( Max_Binary'Pred(0)      = System_Max_Bin_Mod_Pred,
+                 "Max_Binary'Pred(0)");
+  if Ones_Complement_Permission then
+    TCTouch.Assert( Max_NonBinary'Pred(0) >= System_Max_NonBin_Mod_Pred,
+                   "Max_NonBinary'Pred(0) (ones comp)");
+  else
+    TCTouch.Assert( Max_NonBinary'Pred(0)   = System_Max_NonBin_Mod_Pred,
+                   "Max_NonBinary'Pred(0)");
+  end if;
+  TCTouch.Assert( Half_Max_Binary'Pred(0) = Half_Max_Bin_Value_Pred,
+                 "Half_Max_Binary'Pred(0)");
+
+  TCTouch.Assert( Medium'Pred(Medium(ID(0))) = 2047, "Medium'Pred(0)");
+  TCTouch.Assert( Medium_Plus'Pred(0)     = 2041, "Medium_Plus'Pred(0)");
+  TCTouch.Assert( Medium_Minus'Pred(0)    = 2110, "Medium_Minus'Pred(0)");
+  TCTouch.Assert( Small'Pred(0)  = 1, "Small'Pred(0)");
+  TCTouch.Assert( Finger'Pred(Finger(ID(0))) = 4, "Finger'Pred(0)");
+  TCTouch.Assert( Midrange'Pred(222) = 221, "Midrange'Pred('First)");
+
+-- Range
+  for I in Midrange'Range loop
+    if I not in Midrange then
+      Report.Failed("Midrange loop test");
+    end if;
+  end loop;
+  for I in Medium'Range loop
+    if I not in Medium then
+      Report.Failed("Medium loop test");
+    end if;
+  end loop;
+  for I in Medium_Minus'Range loop
+    if I not in 0..2110 then
+      Report.Failed("Medium loop test");
+    end if;
+  end loop;
+
+-- Succ
+  TCTouch.Assert( Max_Binary'Succ(System_Max_Bin_Mod_Pred)         = 0,
+                 "Max_Binary'Succ('Last)");
+  if Ones_Complement_Permission then
+    TCTouch.Assert( (Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred) = 0)
+                or (Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred)
+                    = Max_NonBinary'Last),
+                   "Max_NonBinary'Succ('Last) (ones comp)");
+  else
+    TCTouch.Assert( Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred)   = 0,
+                   "Max_NonBinary'Succ('Last)");
+  end if;
+ TCTouch.Assert( Half_Max_Binary'Succ(Half_Max_Bin_Value_Pred)    = 0,
+                 "Half_Max_Binary'Succ('Last)");
+
+  TCTouch.Assert( Medium'Succ(2047)       = 0, "Medium'Succ('Last)");
+  TCTouch.Assert( Medium_Plus'Succ(2041)  = 0, "Medium_Plus'Succ('Last)");
+  TCTouch.Assert( Medium_Minus'Succ(2110) = 0, "Medium_Minus'Succ('Last)");
+  TCTouch.Assert( Small'Succ(1)           = 0, "Small'Succ('Last)");
+  TCTouch.Assert( Finger'Succ(4)          = 0, "Finger'Succ('Last)");
+  TCTouch.Assert( Midrange'Succ(Midrange(ID(1111))) = 1112,
+                  "Midrange'Succ('Last)");
+
+-- Val
+  for I in Natural range ID(222)..ID(1111) loop
+    TCTouch.Assert( Midrange'Val(I) = Medium_Minus(I), "Midrange'Val");
+  end loop;
+
+-- Value
+
+  TCTouch.Assert( Half_Max_Binary'Value("255") = 255,
+                 "Half_Max_Binary'Value" );
+
+  TCTouch.Assert( Medium'Value(" 1e2") = 100,   "Medium'Value(""1e2"")" );
+  TCTouch.Assert( Medium'Value(" 0 ")  =   0,   "Medium'Value" );
+  TCTouch.Assert( Medium_Plus'Value(ID("2041")) = 2041,
+                 "Medium_Plus'Value" );
+  TCTouch.Assert( Medium_Minus'Value(ID("+10_24")) = 1024,
+                 "Medium_Minus'Value" );
+
+  TCTouch.Assert( Small'Value("+1") = 1,            "Small'Value" );
+  TCTouch.Assert( Midrange'Value(ID("333")) = 333,  "Midrange'Value" );
+  TCTouch.Assert( Midrange'Value("1E3") = 1000,
+                 "Midrange'Value(""1E3"")" );
+
+  Value_Fault( "bad input" );
+  Value_Fault( "-333" );
+  Value_Fault( "9999" );
+  Value_Fault( ".1" );
+  Value_Fault( "1e-1" );
+
+-- Width
+  TCTouch.Assert( Medium'Width       = 5, "Medium'Width");
+  TCTouch.Assert( Medium_Plus'Width  = 5, "Medium_Plus'Width");
+  TCTouch.Assert( Medium_Minus'Width = 5, "Medium_Minus'Width");
+  TCTouch.Assert( Small'Width        = 2, "Small'Width");
+  TCTouch.Assert( Finger'Width       = 2, "Finger'Width");
+  TCTouch.Assert( Midrange'Width     = 5, "Midrange'Width");
+
+  Report.Result;
+
+end C354002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c354003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c354003.a
new file mode 100644
index 000000000..1f607a7e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c354003.a
@@ -0,0 +1,211 @@
+-- C354003.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 Wide_String attributes of modular types yield
+--      correct values/results.  The attributes checked are:
+--
+--      Wide_Image
+--      Wide_Value
+--
+-- TEST DESCRIPTION:
+--      This test is split from C354002.  It tests only the attributes:
+--
+--      Wide_Image, Wide_Value
+--
+--      This test defines several modular types.  One type defined at
+--      each of System.Max_Binary_Modulus, System.Max_Nonbinary_Modulus,
+--      a power of two half that of System.Max_Binary_Modulus, one less
+--      than that power of two; one more than that power of two, two
+--      less than a (large) power of two.  For each of these types,
+--      determine the correct operation of the Wide_String attributes.
+--
+--
+-- CHANGE HISTORY:
+--      13 DEC 94   SAIC    Initial version
+--      06 JAN 94   SAIC    Promoted to future release
+--      19 APR 95   SAIC    Revised in accord with reviewer comments
+--      01 DEC 95   SAIC    Corrected for 2.0.1
+--      27 JAN 96   SAIC    Eliminated potential 32/64 bit conflict for 2.1
+--      24 FEB 97   PWB.CTA Corrected out-of-range value
+--!
+
+with Report;
+with System;
+with TCTouch;
+with Ada.Characters.Handling;
+procedure C354003 is
+
+  function ID(Local_Value: Integer) return Integer renames Report.Ident_Int;
+  function ID(Local_Value: String)  return String renames  Report.Ident_Str;
+
+  function ID(Local_Value: String) return Wide_String is
+  begin
+    return Ada.Characters.Handling.To_Wide_String( ID( Local_Value ) );
+  end ID;
+
+  Half_Max_Binary_Value : constant := System.Max_Binary_Modulus / 2;
+
+  type Max_Binary      is mod System.Max_Binary_Modulus;
+  type Max_NonBinary   is mod System.Max_Nonbinary_Modulus;
+  type Half_Max_Binary is mod Half_Max_Binary_Value;
+
+  type Medium          is mod 2048;
+  type Medium_Plus     is mod 2042;
+  type Medium_Minus    is mod 2111;
+
+  type Small  is mod 2;
+  type Finger is mod 5;
+
+  type Finger_Id is (Thumb, Index, Middle, Ring, Pinkie);
+
+  subtype Midrange is Medium_Minus range 222 .. 1111;
+
+  AMB,   BMB   : Max_Binary;
+  AHMB,  BHMB  : Half_Max_Binary;
+  AM,    BM    : Medium;
+  AMP,   BMP   : Medium_Plus;
+  AMM,   BMM   : Medium_Minus;
+  AS,    BS    : Small;
+  AF,    BF    : Finger;
+
+  procedure Wide_Value_Fault( S: Wide_String ) is
+  -- check 'Wide_Value for failure modes
+  begin
+    -- the evaluation of the 'Wide_Value expression should raise C_E
+    TCTouch.Assert_Not( Midrange'Wide_Value(S) = 0, "Wide_Value_Fault" );
+    if Midrange'Wide_Value(S) not in Midrange'Base then
+      Report.Failed("'Wide_Value  raised no exception");
+    end if;
+  exception
+    when Constraint_Error => null; -- expected case
+    when others =>
+         Report.Failed("'Wide_Value raised wrong exception");
+  end Wide_Value_Fault;
+
+
+  The_Cap, The_Toe : Natural;
+
+  procedure Check_Non_Static_Cases( Lower_Bound,Upper_Bound : Medium ) is
+    subtype Non_Static is Medium range Lower_Bound..Upper_Bound;
+  begin
+  -- First, Last, Range, Min, Max, Succ, Pred, Pos, and Val
+
+    TCTouch.Assert( Non_Static'First = Medium(The_Toe), "Non_Static'First" );
+    TCTouch.Assert( Non_Static'Last = Non_Static(The_Cap),
+                    "Non_Static'Last" );
+    TCTouch.Assert( Non_Static(The_Cap/2) in Non_Static'Range,
+                    "Non_Static'Range" );
+    TCTouch.Assert( Non_Static'Min(Medium(Report.Ident_Int(100)),
+                                   Medium(Report.Ident_Int(200))) = 100,
+                    "Non_Static'Min" );
+    TCTouch.Assert( Non_Static'Max(Medium(Report.Ident_Int(100)),
+                                   Medium(Report.Ident_Int(200))) = 200,
+                    "Non_Static'Max" );
+    TCTouch.Assert( Non_Static'Succ(Non_Static(The_Cap))
+                    = Medium'Succ(Upper_Bound),
+                    "Non_Static'Succ" );
+    TCTouch.Assert( Non_Static'Pred(Medium(Report.Ident_Int(The_Cap)))
+                    = Non_Static(Report.Ident_Int(The_Cap-1)),
+                    "Non_Static'Pred" );
+    TCTouch.Assert( Non_Static'Pos(Upper_Bound) = Non_Static(The_Cap),
+                    "Non_Static'Pos" );
+    TCTouch.Assert( Non_Static'Val(Non_Static(The_Cap)) = Upper_Bound,
+                    "Non_Static'Val" );
+
+  end Check_Non_Static_Cases;
+
+
+begin  -- Main test procedure.
+
+  Report.Test ("C354003", "Check Wide_String attributes of modular types" );
+
+  Wide_Strings_Needed: declare
+
+    Max_Bin_Mod_Div_3 : constant := Max_Binary'Modulus/3;
+    Max_Non_Mod_Div_4 : constant := Max_NonBinary'Modulus/4;
+
+  begin
+
+-- Wide_Image
+
+    TCTouch.Assert( Half_Max_Binary'Wide_Image(255) = " 255",
+                   "Half_Max_Binary'Wide_Image" );
+
+    TCTouch.Assert( Medium'Wide_Image(0) = " 0",  "Medium'Wide_Image" );
+
+    TCTouch.Assert( Medium_Plus'Wide_Image(Medium_Plus'Last) = " 2041",
+                   "Medium_Plus'Wide_Image" );
+
+    TCTouch.Assert( Medium_Minus'Wide_Image(Medium_Minus(ID(1024))) = " 1024",
+                   "Medium_Minus'Wide_Image" );
+
+    TCTouch.Assert( Small'Wide_Image(1) = " 1",   "Small'Wide_Image" );
+
+    TCTouch.Assert( Midrange'Wide_Image(Midrange(ID(333))) = " 333",
+                   "Midrange'Wide_Image" );
+
+-- Wide_Value
+
+    TCTouch.Assert( Half_Max_Binary'Wide_Value("255") = 255,
+                   "Half_Max_Binary'Wide_Value" );
+
+    TCTouch.Assert( Medium'Wide_Value(" 0 ")  = 0,   "Medium'Wide_Value" );
+
+    TCTouch.Assert( Medium_Plus'Wide_Value(ID("2041")) = Medium_Plus'Last,
+                   "Medium_Plus'Wide_Value" );
+
+    TCTouch.Assert( Medium_Minus'Wide_Value("+1_4 ") = 14,
+                   "Medium_Minus'Wide_Value" );
+
+    TCTouch.Assert( Small'Wide_Value("+1") = 1,      "Small'Wide_Value" );
+
+    TCTouch.Assert( Midrange'Wide_Value(ID("333")) = 333,
+                   "Midrange'Wide_Value" );
+
+    TCTouch.Assert( Midrange'Wide_Value(ID("1E3")) = 1000,
+                   "Midrange'Wide_Value(""1E3"")" );
+
+    Wide_Value_Fault( "bad input" );
+    Wide_Value_Fault( "-333" );
+    Wide_Value_Fault( "9999" );
+    Wide_Value_Fault( ".1" );
+    Wide_Value_Fault( "1e-1" );
+
+  end Wide_Strings_Needed;
+
+  The_Toe := Report.Ident_Int(25);
+  The_Cap := Report.Ident_Int(256);
+  Check_Non_Static_Cases( Medium(Report.Ident_Int(The_Toe)),
+                          Medium(Report.Ident_Int(The_Cap)) );
+
+  The_Toe := Report.Ident_Int(40);
+  The_Cap := Report.Ident_Int(2047);
+  Check_Non_Static_Cases( Medium(Report.Ident_Int(The_Toe)),
+                          Medium(Report.Ident_Int(The_Cap)) );
+
+  Report.Result;
+
+end C354003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502a.ada
new file mode 100644
index 000000000..ffb819046
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502a.ada
@@ -0,0 +1,71 @@
+-- C35502A.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 ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
+-- WHEN THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR 
+-- A CHARACTER TYPE.   
+
+-- RJW 5/05/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35502A  IS
+
+BEGIN
+
+     TEST( "C35502A" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                       "THE CORRECT RESULTS WHEN THE PREFIX " &
+                       "IS AN ENUMERATION TYPE OTHER THAN " &
+                       "A BOOLEAN OR A CHARACTER TYPE" );
+
+     DECLARE
+          TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+
+          SUBTYPE SUBENUM IS ENUM RANGE A .. ABC;
+          SUBTYPE NOENUM IS ENUM RANGE ABC .. A;
+          
+          TYPE NEWENUM IS NEW ENUM;
+         
+     BEGIN
+
+          IF ENUM'WIDTH /= IDENT_INT(5) THEN
+               FAILED( "INCORRECT WIDTH FOR ENUM" );
+          END IF;
+
+          IF NEWENUM'WIDTH /= IDENT_INT(5) THEN
+               FAILED( "INCORRECT WIDTH FOR NEWENUM" );
+          END IF;
+
+          IF SUBENUM'WIDTH /= IDENT_INT(3) THEN
+               FAILED( "INCORRECT WIDTH FOR SUBENUM" );
+          END IF;
+
+          IF NOENUM'WIDTH /= IDENT_INT(0) THEN
+               FAILED( "INCORRECT WIDTH FOR NOENUM" );
+          END IF;
+
+     END;                    
+
+     RESULT;
+END C35502A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502b.ada
new file mode 100644
index 000000000..aff813514
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502b.ada
@@ -0,0 +1,81 @@
+-- C35502B.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 ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
+-- WHEN THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL 
+-- PARAMETER IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR CHARACTER 
+-- TYPE.   
+
+-- RJW 5/05/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35502B  IS
+
+BEGIN
+
+     TEST( "C35502B" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                       "THE CORRECT RESULTS WHEN THE PREFIX " &
+                       "IS A GENERIC FORMAL DISCRETE TYPE " &
+                       "WHOSE ACTUAL PARAMETER IS AN ENUMERATION " &
+                       "TYPE" );
+
+     DECLARE
+          TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+          SUBTYPE SUBENUM IS ENUM RANGE A .. ABC;
+          SUBTYPE NOENUM IS ENUM RANGE ABC .. A;
+          
+          TYPE NEWENUM IS NEW ENUM;
+
+          GENERIC
+               TYPE E IS (<>);
+               W : INTEGER;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+               SUBTYPE NOENUM IS E RANGE 
+                    E'VAL (IDENT_INT(2)) .. E'VAL (IDENT_INT(1));
+          BEGIN
+               IF E'WIDTH /= IDENT_INT(W) THEN 
+                    FAILED ( "INCORRECT E'WIDTH FOR " & STR );
+               END IF;
+               IF NOENUM'WIDTH /= IDENT_INT(0) THEN
+                    FAILED ( "INCORRECT NOENUM'WIDTH FOR " & STR );
+               END IF;
+          END P;
+
+          PROCEDURE PROC1 IS NEW P (ENUM, 5);
+          PROCEDURE PROC2 IS NEW P (SUBENUM, 3);
+          PROCEDURE PROC3 IS NEW P (NEWENUM, 5);
+          PROCEDURE PROC4 IS NEW P (NOENUM, 0);
+
+     BEGIN
+          PROC1 ( "ENUM" );
+          PROC2 ( "SUBENUM" );
+          PROC3 ( "NEWENUM" );
+          PROC4 ( "NOENUM" );
+     END;                    
+
+     RESULT;
+END C35502B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502c.ada
new file mode 100644
index 000000000..a635e68fb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502c.ada
@@ -0,0 +1,318 @@
+-- C35502C.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT 
+-- RESULTS WHEN THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN
+-- OR A CHARACTER TYPE.   
+-- SUBTESTS ARE:
+--     PART (A). TESTS FOR IMAGE.
+--     PART (B). TESTS FOR VALUE.
+
+-- RJW 5/07/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35502C  IS
+
+          TYPE ENUM IS (A, BC, ABC, A_B_C, abcd);
+          SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+
+          TYPE NEWENUM IS NEW ENUM;
+
+          FUNCTION IDENT (X : ENUM) RETURN ENUM IS
+               BEGIN
+                    IF EQUAL (ENUM'POS (X), ENUM'POS(X)) THEN
+                         RETURN X;
+                    END IF;
+                    RETURN ENUM'FIRST;
+               END IDENT;       
+
+BEGIN
+
+     TEST( "C35502C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
+                       "'VALUE' YIELD THE CORRECT RESULTS " &
+                       "WHEN THE PREFIX IS AN ENUMERATION TYPE " &
+                       "OTHER THAN A BOOLEAN OR A CHARACTER TYPE" );
+
+-- PART (A).
+
+     BEGIN  
+
+          IF ENUM'IMAGE ( IDENT(ABC) ) /= "ABC" THEN
+               FAILED ( "INCORRECT ENUM'IMAGE FOR ABC" );
+          END IF;
+          IF ENUM'IMAGE ( IDENT(ABC) )'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR ABC IN ENUM" );
+          END IF;
+
+          IF ENUM'IMAGE ( IDENT(A_B_C) ) /= "A_B_C" THEN
+               FAILED ( "INCORRECT ENUM'IMAGE FOR A_B_C" );
+          END IF;
+          IF ENUM'IMAGE ( IDENT(A_B_C) )'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR A_B_C IN ENUM" );
+          END IF;
+
+          IF SUBENUM'IMAGE ( IDENT(A_B_C) ) /= "A_B_C" THEN
+               FAILED ( "INCORRECT SUBENUM'IMAGE FOR A_B_C" );
+          END IF;          
+          IF SUBENUM'IMAGE ( IDENT(ABC) )'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR ABC " &
+                        "IN SUBENUM" );
+          END IF;          
+
+          IF NEWENUM'IMAGE ( ABC ) /= IDENT_STR("ABC") THEN
+               FAILED ( "INCORRECT NEWENUM'IMAGE FOR ABC" );
+          END IF;          
+          IF NEWENUM'IMAGE ( ABC )'FIRST /= IDENT_INT(1) THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR ABC" &
+                        "IN NEWENUM" );
+          END IF;          
+
+          IF ENUM'IMAGE ( IDENT(abcd) ) /= "ABCD" THEN
+               FAILED ( "INCORRECT ENUM'IMAGE FOR abcd" );
+          END IF;          
+          IF ENUM'IMAGE ( IDENT(abcd) )'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR abcd IN ENUM" );
+          END IF;          
+
+     END;
+
+-----------------------------------------------------------------------
+
+-- PART (B).
+
+     BEGIN  
+          IF ENUM'VALUE (IDENT_STR("ABC")) /= ABC THEN     
+               FAILED ( "INCORRECT VALUE FOR ""ABC""" );  
+          END IF;
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR ""ABC""" );  
+     END;
+
+     BEGIN
+          IF ENUM'VALUE (IDENT_STR("abc")) /= abc THEN     
+               FAILED ( "INCORRECT VALUE FOR ""abc""" );  
+          END IF;
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR ""abc""" );  
+     END;
+
+     BEGIN
+          IF ENUM'VALUE ("ABC") /= ABC THEN     
+               FAILED ( "INCORRECT VALUE FOR ABC" );  
+          END IF;
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR ABC" );  
+     END;
+
+     BEGIN
+          IF NEWENUM'VALUE (IDENT_STR("abcd")) /= abcd THEN
+               FAILED ( "INCORRECT VALUE FOR ""abcd""" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR ""abcd""" );
+     END;
+
+     BEGIN
+          IF NEWENUM'VALUE (IDENT_STR("ABCD")) /= abcd THEN
+               FAILED ( "INCORRECT VALUE FOR ""ABCD""" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR ""ABCD""" );
+     END;
+
+     BEGIN
+          IF NEWENUM'VALUE ("abcd") /= abcd THEN
+               FAILED ( "INCORRECT VALUE FOR abcd" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR abcd" );
+     END;
+
+     BEGIN
+          IF SUBENUM'VALUE (IDENT_STR("A_B_C")) /= A_B_C THEN
+               FAILED ( "INCORRECT VALUE FOR ""A_B_C""" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR ""A_B_C""" );
+     END;
+
+     BEGIN
+          IF ENUM'VALUE (IDENT_STR("ABC     ")) /= ABC THEN
+               FAILED ( "INCORRECT VALUE WITH TRAILING BLANKS" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE WITH " &
+                        "TRAILING BLANKS" );
+     END;
+
+     BEGIN          
+          IF NEWENUM'VALUE (IDENT_STR("  A_B_C")) /= A_B_C THEN
+               FAILED ( "INCORRECT VALUE WITH LEADING BLANKS" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE WITH LEADING " &
+                        "BLANKS" );
+     END;
+
+     BEGIN
+          IF ENUM'VALUE (IDENT_STR("A_BC")) /= ABC THEN
+               FAILED ( "NO EXCEPTION RAISED - ""A_BC"" - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - ""A_BC"" - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - ""A_BC""" );
+     END;
+
+     BEGIN
+          IF ENUM'VALUE (IDENT_STR("A BC")) /= ABC THEN
+               FAILED ( "NO EXCEPTION RAISED - ""A BC"" - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - ""A BC"" - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - ""A BC""" );
+     END;
+
+     BEGIN
+          IF ENUM'VALUE (IDENT_STR("A&BC")) /= ABC THEN
+               FAILED ( "NO EXCEPTION RAISED - ""A&BC"" - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - ""A&BC"" - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - ""A&BC""" );
+     END;
+
+     BEGIN
+          IF ENUM'VALUE (IDENT_CHAR(ASCII.HT) & "BC") /= BC THEN
+               FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
+     END;
+
+     BEGIN
+          IF NEWENUM'VALUE ("A" & (IDENT_CHAR(ASCII.HT))) /= A THEN
+               FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
+     END;
+
+     BEGIN
+          IF ENUM'VALUE (IDENT_STR("B__C")) /= BC THEN
+               FAILED ( "NO EXCEPTION RAISED - " &
+                        "CONSECUTIVE UNDERSCORES - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - " &
+                        "CONSECUTIVE UNDERSCORES - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - " &
+                        "CONSECUTIVE UNDERSCORES" );
+     END;
+
+     BEGIN
+          IF NEWENUM'VALUE (IDENT_STR("BC_")) /= BC THEN
+               FAILED ( "NO EXCEPTION RAISED - " & 
+                        "TRAILING UNDERSCORE - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - " & 
+                        "TRAILING UNDERSCORE - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - " & 
+                        "TRAILING UNDERSCORE" );
+     END;
+
+     BEGIN
+          IF SUBENUM'VALUE (IDENT_STR("_BC")) /= BC THEN
+               FAILED ( "NO EXCEPTION RAISED - " & 
+                        "LEADING UNDERSCORE - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - " & 
+                        "LEADING UNDERSCORE - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - " & 
+                        "LEADING UNDERSCORE" );
+     END;
+
+     BEGIN
+          IF SUBENUM'VALUE (IDENT_STR("0BC")) /= BC THEN
+               FAILED ( "NO EXCEPTION RAISED - " & 
+                        "FIRST CHARACTER IS A DIGIT - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - " & 
+                        "FIRST CHARACTER IS A DIGIT - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - " & 
+                        "FIRST CHARACTER IS A DIGIT" );
+     END;
+
+     RESULT;
+END C35502C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502d.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502d.tst
new file mode 100644
index 000000000..7da988197
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502d.tst
@@ -0,0 +1,84 @@
+-- C35502D.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULT FOR THE
+-- LONGEST POSSIBLE ENUMERATION LITERAL.
+
+-- RJW 2/21/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35502D IS
+
+BEGIN
+     TEST ("C35502D", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD " &
+                      "CORRECT RESULTS FOR THE LONGEST POSSIBLE " &
+                      "ENUMERATION LITERAL");
+
+     -- BIG_ID1 IS A MAXIMUM LENGTH IDENTIFIER. BIG_STRING1 AND 
+     -- BIG_STRING2 ARE TWO STRING LITERALS WHICH WHEN CONCATENATED 
+     -- FORM THE IMAGE OF BIG_ID1;
+
+
+     DECLARE
+          TYPE ENUM IS (
+$BIG_ID1
+                        );                             
+
+     BEGIN
+          BEGIN
+               IF ENUM'VALUE (
+$BIG_STRING1  
+&
+$BIG_STRING2
+) /= 
+$BIG_ID1
+                    THEN
+                    FAILED ( "INCORRECT RESULTS FOR 'VALUE'" );
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED FOR 'VALUE'" );
+          END;
+          BEGIN           
+               IF ENUM'IMAGE( 
+$BIG_ID1
+) /=
+(
+$BIG_STRING1
+&
+$BIG_STRING2
+)                   THEN
+                    FAILED ( "INCORRECT RESULTS FOR 'IMAGE'" );
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED FOR 'IMAGE'" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED FOR 'IMAGE'" );
+          END;
+     END;
+
+     RESULT;
+END C35502D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502e.ada
new file mode 100644
index 000000000..16e3cf098
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502e.ada
@@ -0,0 +1,155 @@
+-- C35502E.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT 
+-- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL 
+-- PARAMETER IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A 
+-- CHARACTER TYPE.   
+-- SUBTESTS ARE:
+--     PART (A). TESTS FOR IMAGE.
+--     PART (B). TESTS FOR VALUE.
+
+-- RJW 5/13/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35502E  IS
+
+          TYPE ENUM IS (A, BC, ABC, A_B_C, abcd);
+          SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+
+          TYPE NEWENUM IS NEW ENUM;
+
+BEGIN
+
+     TEST( "C35502E" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
+                       "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                       "ACTUAL PARAMETER IS AN ENUMERATION TYPE " &
+                       "OTHER THAN A BOOLEAN OR A CHARACTER TYPE" );
+
+-- PART (A).
+     DECLARE
+          GENERIC
+               TYPE E IS (<>);
+               STR1 : STRING;
+          PROCEDURE P ( E1 : E; STR2 : STRING );
+          
+          PROCEDURE P ( E1 : E; STR2 : STRING ) IS
+               SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+          BEGIN
+               IF SE'IMAGE ( E1 ) /= STR2 THEN
+                    FAILED ( "INCORRECT SE'IMAGE FOR " & STR2 & " IN "
+                              & STR1 );
+               END IF;
+               IF SE'IMAGE ( E1 )'FIRST /= 1 THEN
+                    FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 
+                              & " IN " & STR1 );
+               END IF;
+          END P;
+          
+          PROCEDURE PE IS NEW P ( ENUM , "ENUM" );
+          PROCEDURE PS IS NEW P ( SUBENUM, "SUBENUM" );
+          PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+
+     BEGIN
+          PE ( ABC, "ABC" );
+          PE ( A_B_C, "A_B_C" );
+          PS ( BC, "BC" );
+          PN ( ABC, "ABC" );
+          PE ( abcd, "ABCD" );
+     END;
+
+-----------------------------------------------------------------------
+
+-- PART (B).
+
+     DECLARE
+          GENERIC
+               TYPE E IS (<>);
+               STR1 : STRING;
+          PROCEDURE P ( STR2 : STRING ; E1 : E );
+          
+          PROCEDURE P ( STR2 : STRING ; E1 : E ) IS
+               SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+          BEGIN
+               IF E'VALUE ( STR2 ) /= E1 THEN     
+                    FAILED ( "INCORRECT " & STR1 & "'VALUE FOR """ & 
+                              STR2 & """" ); 
+               END IF;
+          EXCEPTION     
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED - " & STR1 & "'VALUE " &
+                             "FOR """ & STR2 & """" );  
+          END P;
+
+          PROCEDURE PE IS NEW P ( ENUM , "ENUM" );
+          PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+
+     BEGIN
+          PN ("abcd", abcd);
+          PN ("A_B_C", A_B_C);
+          PE ("ABC     ", ABC);
+          PE ("  A_B_C", A_B_C);
+     END;
+
+
+     DECLARE
+          GENERIC
+               TYPE E IS (<>);
+          PROCEDURE P ( STR : STRING );
+          
+          PROCEDURE P ( STR : STRING ) IS
+               SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+          BEGIN
+               IF SE'VALUE (STR) = SE'VAL (0) THEN
+                    FAILED ( "NO EXCEPTION RAISED - " & STR & " - 1" );
+               ELSE
+                    FAILED ( "NO EXCEPTION RAISED - " & STR & " - 2" );
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED - " & STR );
+          END P;
+
+          PROCEDURE PE IS NEW P ( ENUM );
+          PROCEDURE PS IS NEW P ( SUBENUM );
+          PROCEDURE PN IS NEW P ( NEWENUM );
+          
+     BEGIN
+          PS ("A BC");
+          PN ("A&BC");
+          PE (ASCII.HT & "BC");
+          PE ("A" & ASCII.HT);
+          PS ("_BC");
+          PN ("BC_");
+          PE ("B__C");
+          PE ("0BC");
+
+     END;
+
+     RESULT;
+END C35502E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502f.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502f.tst
new file mode 100644
index 000000000..30be23e47
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502f.tst
@@ -0,0 +1,89 @@
+-- C35502F.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 IMAGE AND VALUE ATTRIBUTES ARE CORRECT FOR A FORMAL
+-- DISCRETE TYPE WHOSE ACTUAL PARAMETER IS AN ENUMERATED TYPE
+-- WITH THE LONGEST POSSIBLE IDENTIFIER AS ONE CONSTANT.
+
+-- PWB  03/05/86
+-- DWC  07/22/87     -- ADDED THE CONSTANT STRING 'STR'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35502F IS
+
+     -- BIG_ID1 IS AN IDENTIFIER OF MAXIMUM LENGTH.
+     TYPE ENUM IS ( EVAL1,
+$BIG_ID1
+                  );
+
+     -- BIG_STRING1 & BIG_STRING2 YIELDS BIG_ID.
+     STR1 : CONSTANT STRING :=
+$BIG_STRING1;
+     STR2 : CONSTANT STRING :=
+$BIG_STRING2;
+     STR : CONSTANT STRING := STR1 & STR2;
+
+     GENERIC
+          TYPE FORMAL IS (<>);
+     PROCEDURE GEN_PROC;
+
+     PROCEDURE GEN_PROC IS
+     BEGIN
+          VALUE_CHECK:
+          BEGIN
+               IF FORMAL'VALUE (STR) /= FORMAL'LAST THEN
+                    FAILED ("VALUE OF LONG STRING NOT LONG IDENTIFIER");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN CHECKING " &
+                            "VALUE ATTRIBUTE");
+          END VALUE_CHECK;
+
+          IMAGE_CHECK:
+          BEGIN
+               IF FORMAL'IMAGE (FORMAL'LAST) /= STR
+               THEN
+                    FAILED ("IMAGE OF LONG IDENTIFIER NOT LONG STRING");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN CHECKING " &
+                            "IMAGE ATTRIBUTE");
+          END IMAGE_CHECK;
+
+     END GEN_PROC;
+
+     PROCEDURE TEST_PROC IS NEW GEN_PROC (ENUM);
+
+BEGIN   -- C35502F
+
+     TEST ("C35502F", "IMAGE AND VALUE ATTRIBUTES FOR A FORMAL " &
+                      "DISCRETE TYPE WITH ONE ACTUAL VALUE HAVING " &
+                      "LONGEST POSSIBLE IDENTIFIER");
+     TEST_PROC;
+     RESULT;
+
+END C35502F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502g.ada
new file mode 100644
index 000000000..aff9fb399
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502g.ada
@@ -0,0 +1,84 @@
+-- C35502G.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 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN 
+-- THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A 
+-- CHARACTER TYPE.
+
+-- RJW 5/27/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35502G IS
+
+          TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+          SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+
+          TYPE NEWENUM IS NEW ENUM;
+          SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+
+BEGIN
+     TEST ("C35502G", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                      "ENUMERATION TYPE OTHER THAN A CHARACTER " &
+                      "OR A BOOLEAN TYPE" );
+
+     BEGIN
+          FOR I IN ENUM'VAL (1) .. ENUM'VAL (4) LOOP
+               IF SUBENUM'PRED (I) /= 
+                  ENUM'VAL (ENUM'POS (I) - 1) THEN
+                    FAILED ("INCORRECT SUBENUM'PRED(" &
+                             ENUM'IMAGE (I) & ")" );
+               END IF;
+          END LOOP;
+
+          FOR I IN ENUM'VAL (0) .. ENUM'VAL (3) LOOP
+               IF SUBENUM'SUCC (I) /= 
+                  ENUM'VAL (ENUM'POS (I) + 1) THEN
+                    FAILED ("INCORRECT SUBENUM'SUCC(" &
+                             ENUM'IMAGE (I) & ")" );
+               END IF;
+          END LOOP;
+     END;
+
+     BEGIN
+          FOR I IN NEWENUM'VAL (1) .. NEWENUM'VAL (4) LOOP
+               IF SUBNEW'PRED (I) /= 
+                  NEWENUM'VAL (NEWENUM'POS (I) - 1) THEN
+                    FAILED ("INCORRECT SUBNEW'PRED(" &
+                             NEWENUM'IMAGE (I) & ")" );
+               END IF;
+          END LOOP;
+
+          FOR I IN NEWENUM'VAL (0) .. NEWENUM'VAL (3) LOOP
+               IF SUBNEW'SUCC (I) /= 
+                  NEWENUM'VAL (NEWENUM'POS (I) + 1) THEN
+                    FAILED ("INCORRECT SUBNEW'SUCC(" &
+                             NEWENUM'IMAGE (I) & ")" );
+               END IF;
+          END LOOP;
+     END;
+
+     RESULT;
+END C35502G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502h.ada
new file mode 100644
index 000000000..640e2e9de
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502h.ada
@@ -0,0 +1,82 @@
+-- C35502H.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 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN 
+-- THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
+-- AN ENUMERATION TYPE OTHER THAN A BOOLEAN OR A CHARACTER TYPE.
+
+-- RJW 5/27/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35502H IS
+
+          TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+
+          TYPE NEWENUM IS NEW ENUM;
+
+BEGIN
+     TEST ("C35502H", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                      "FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                      "ARGUMENT IS AN ENUMERATION TYPE OTHER THAN " &
+                      "A CHARACTER OR A BOOLEAN TYPE" );
+
+     DECLARE
+          GENERIC
+               TYPE E IS (<>);
+               STR : STRING;
+          PROCEDURE P;
+          
+          PROCEDURE P IS
+               SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+          BEGIN
+               FOR I IN E'VAL (1) .. E'VAL (4) LOOP
+                    IF SE'PRED (I) /= 
+                       E'VAL (E'POS (I) - 1) THEN
+                         FAILED ("INCORRECT " & STR & "'PRED(" &
+                                  E'IMAGE (I) & ")" );
+                    END IF;
+               END LOOP;
+
+               FOR I IN E'VAL (0) .. E'VAL (3) LOOP
+                    IF SE'SUCC (I) /= 
+                       E'VAL (E'POS (I) + 1) THEN
+                         FAILED ("INCORRECT " & STR & "'SUCC(" &
+                                  E'IMAGE (I) & ")" );
+                    END IF;
+               END LOOP;
+
+          END P;
+
+          PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
+          PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+
+     BEGIN
+          PE;
+          PN;
+     END;
+          
+     RESULT;
+END C35502H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502i.ada
new file mode 100644
index 000000000..a9116d60b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502i.ada
@@ -0,0 +1,91 @@
+-- C35502I.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 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN
+--     THE PREFIX IS AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A
+--     CHARACTER TYPE, WITH A REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 05/27/86  CREATED ORIGINAL TEST.
+--     BCB 01/04/88  MODIFIED HEADER.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35502I IS
+
+     TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+     FOR ENUM USE (A => 2, BC => 4, ABC => 6,
+                   A_B_C => 8, ABCD => 10);
+     SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+
+     TYPE NEWENUM IS NEW ENUM;
+     SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+
+BEGIN
+     TEST ("C35502I", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                      "ENUMERATION TYPE, OTHER THAN A CHARACTER " &
+                      "OR A BOOLEAN TYPE, WITH A REPRESENTATION " &
+                      "CLAUSE" );
+
+     BEGIN
+          FOR I IN ENUM'VAL (1) .. ENUM'VAL (4) LOOP
+               IF SUBENUM'PRED (I) /=
+                  ENUM'VAL (ENUM'POS (I) - 1) THEN
+                    FAILED ("INCORRECT SUBENUM'PRED(" &
+                             ENUM'IMAGE (I) & ")" );
+               END IF;
+          END LOOP;
+
+          FOR I IN ENUM'VAL (0) .. ENUM'VAL (3) LOOP
+               IF SUBENUM'SUCC (I) /=
+                  ENUM'VAL (ENUM'POS (I) + 1) THEN
+                    FAILED ("INCORRECT SUBENUM'SUCC(" &
+                             ENUM'IMAGE (I) & ")" );
+               END IF;
+          END LOOP;
+     END;
+
+     BEGIN
+          FOR I IN NEWENUM'VAL (1) .. NEWENUM'VAL (4) LOOP
+               IF SUBNEW'PRED (I) /=
+                  NEWENUM'VAL (NEWENUM'POS (I) - 1) THEN
+                    FAILED ("INCORRECT SUBNEW'PRED(" &
+                             NEWENUM'IMAGE (I) & ")" );
+               END IF;
+          END LOOP;
+
+          FOR I IN NEWENUM'VAL (0) .. NEWENUM'VAL (3) LOOP
+               IF SUBNEW'SUCC (I) /=
+                  NEWENUM'VAL (NEWENUM'POS (I) + 1) THEN
+                    FAILED ("INCORRECT SUBNEW'SUCC(" &
+                             NEWENUM'IMAGE (I) & ")" );
+               END IF;
+          END LOOP;
+     END;
+
+     RESULT;
+END C35502I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502j.ada
new file mode 100644
index 000000000..37d17b259
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502j.ada
@@ -0,0 +1,92 @@
+-- C35502J.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 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN
+--     THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
+--     AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A CHARACTER TYPE,
+--     WITH AN ENUMERATION REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 05/27/86  CREATED ORIGINAL TEST.
+--     BCB 01/04/88  MODIFIED HEADER.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35502J IS
+          TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+          FOR ENUM USE (A => 2, BC => 4, ABC => 6,
+                        A_B_C => 8, ABCD => 10);
+
+          TYPE NEWENUM IS NEW ENUM;
+
+BEGIN
+     TEST ("C35502J", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS " &
+                      "A FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                      "ARGUMENT IS AN ENUMERATION TYPE, OTHER THAN " &
+                      "A CHARACTER OR A BOOLEAN TYPE, WITH AN " &
+                      "ENUMERATION REPRESENTATION CLAUSE" );
+
+     DECLARE
+          GENERIC
+               TYPE E IS (<>);
+               STR : STRING;
+          PROCEDURE P;
+
+          PROCEDURE P IS
+               SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+
+          BEGIN
+               FOR I IN E'VAL (1) .. E'VAL (4)
+                    LOOP
+                         IF SE'PRED (I) /=
+                            E'VAL (E'POS (I) - 1) THEN
+                              FAILED ("INCORRECT " & STR & "'PRED(" &
+                                       E'IMAGE (I) & ")" );
+                         END IF;
+                    END LOOP;
+
+               FOR I IN E'VAL (0) .. E'VAL (3)
+                    LOOP
+                         IF SE'SUCC (I) /=
+                            E'VAL (E'POS (I) + 1) THEN
+                              FAILED ("INCORRECT " & STR & "'SUCC(" &
+                                       E'IMAGE (I) & ")" );
+                         END IF;
+                    END LOOP;
+
+     END P;
+
+     PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
+     PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+
+     BEGIN
+          PE;
+          PN;
+     END;
+
+     RESULT;
+END C35502J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502k.ada
new file mode 100644
index 000000000..716521ba9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502k.ada
@@ -0,0 +1,174 @@
+-- C35502K.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
+-- THE PREFIX IS AN ENUMERATION TYPE OTHER THAN  A BOOLEAN OR A
+-- CHARACTER TYPE.
+
+-- RJW 5/27/86
+-- GMT 7/02/87  ADDED ENUM'VAL(3) CHECK NEAR END OF 2ND BLOCK STATEMENT.
+
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35502K IS
+
+     TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+     SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+
+     TYPE NEWENUM IS NEW ENUM;
+     SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+
+BEGIN
+     TEST ("C35502K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                      "ENUMERATION TYPE OTHER THAN A CHARACTER " &
+                      "OR A BOOLEAN TYPE" );
+
+     DECLARE
+          POSITION : INTEGER;
+     BEGIN
+          POSITION := 0;
+
+          FOR E IN ENUM LOOP
+               IF SUBENUM'POS (E) /= POSITION THEN
+                    FAILED ( "INCORRECT SUBENUM'POS (" &
+                              ENUM'IMAGE (E) & ")" );
+               END IF;
+
+               IF SUBENUM'VAL (POSITION) /= E THEN
+                    FAILED ( "INCORRECT SUBENUM'VAL (" &
+                              INTEGER'IMAGE (POSITION) &
+                             ")" );
+               END IF;
+
+               POSITION := POSITION + 1;
+          END LOOP;
+
+          POSITION := 0;
+          FOR E IN NEWENUM LOOP
+               IF SUBNEW'POS (E) /= POSITION THEN
+                    FAILED ( "INCORRECT SUBNEW'POS (" &
+                              NEWENUM'IMAGE (E) & ")" );
+               END IF;
+
+               IF SUBNEW'VAL (POSITION) /= E THEN
+                    FAILED ( "INCORRECT SUBNEW'VAL (" &
+                              INTEGER'IMAGE (POSITION) &
+                             ")" );
+               END IF;
+
+               POSITION := POSITION + 1;
+          END LOOP;
+     END;
+
+     DECLARE
+          FUNCTION A_B_C RETURN ENUM IS
+          BEGIN
+               RETURN ENUM'VAL (IDENT_INT (0));
+          END A_B_C;
+
+     BEGIN
+          IF ENUM'VAL (0) /= A_B_C THEN
+               FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
+                        "BY FUNCTION - 1" );
+          END IF;
+
+          IF ENUM'VAL (0) = C35502K.A_B_C THEN
+               FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
+                        "BY FUNCTION - 2" );
+          END IF;
+
+          IF ENUM'VAL (3) /= C35502K.A_B_C THEN
+               FAILED ( "WRONG ENUM'VAL (3) WHEN HIDDEN " &
+                        "BY FUNCTION - 3" );
+          END IF;
+     END;
+
+     BEGIN
+          IF ENUM'VAL (IDENT_INT (-1)) = A THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR ENUM'VAL (IDENT_INT (-1)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR ENUM'VAL (IDENT_INT (-1)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR ENUM'VAL (IDENT_INT (-1))" );
+     END;
+
+     BEGIN
+          IF NEWENUM'VAL (IDENT_INT (-1)) = A THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (-1)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (-1)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (-1))" );
+     END;
+
+     BEGIN
+          IF ENUM'VAL (IDENT_INT (5)) = A THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR ENUM'VAL (IDENT_INT (5)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR ENUM'VAL (IDENT_INT (5)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR ENUM'VAL (IDENT_INT (5))" );
+     END;
+
+     BEGIN
+          IF NEWENUM'VAL (IDENT_INT (5)) = A THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (5)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (5)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (5))" );
+     END;
+
+     RESULT;
+END C35502K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502l.ada
new file mode 100644
index 000000000..768c1435a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502l.ada
@@ -0,0 +1,152 @@
+-- C35502L.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN 
+-- THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
+-- AN ENUMERATION TYPE OTHER THAN  A BOOLEAN OR A CHARACTER TYPE.
+
+-- RJW 5/27/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35502L IS
+     
+     TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+     SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+
+     TYPE NEWENUM IS NEW ENUM;
+     SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+
+BEGIN
+     TEST ("C35502L", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                      "FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT " &
+                      "IS AN ENUMERATION TYPE OTHER THAN A " &
+                      "CHARACTER OR A BOOLEAN TYPE" );
+
+     DECLARE
+
+          GENERIC
+               TYPE E IS (<>);
+               STR : STRING;
+          PROCEDURE P;
+          
+          PROCEDURE P IS
+               SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+               POSITION : INTEGER;
+          BEGIN
+     
+               POSITION := 0;
+
+               FOR E1 IN E
+                    LOOP
+                         IF SE'POS (E1) /= POSITION THEN
+                              FAILED ( "INCORRECT SE'POS (" &
+                                        E'IMAGE (E1) & ")" );
+                         END IF;
+                    
+                         IF SE'VAL (POSITION) /= E1 THEN 
+                              FAILED ( "INCORRECT " & STR & "'VAL (" &
+                                        INTEGER'IMAGE (POSITION) & 
+                                       ")" );
+                         END IF;
+     
+                         POSITION := POSITION + 1;
+                    END LOOP;
+          
+               BEGIN
+                    IF E'VAL (-1) = E'VAL (1) THEN
+                         FAILED ( "NO EXCEPTION RAISED FOR " & 
+                                   STR & "'VAL (-1) - 1" );
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED FOR " & 
+                                   STR & "'VAL (-1) - 2" );
+                    END IF;
+               EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                         NULL;
+               WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " & 
+                                   STR & "'VAL (-1)" );
+               END;
+
+               BEGIN
+                    IF E'VAL (5) = E'VAL (4) THEN
+                         FAILED ( "NO EXCEPTION RAISED FOR " & 
+                                   STR & "'VAL (5) - 1" );
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED FOR " & 
+                                   STR & "'VAL (5) - 2" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " & 
+                                   STR & "'VAL (5)" );
+               END;
+          END P;
+     
+          PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
+          PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+     BEGIN          
+          PE;          
+          PN;
+     END;
+     
+     DECLARE
+          GENERIC
+               TYPE E IS (<>);
+          FUNCTION F (E1 : E) RETURN BOOLEAN;
+
+          FUNCTION F (E1 : E) RETURN BOOLEAN IS
+          BEGIN
+               RETURN E'VAL (0) = E1;
+          END F;               
+     
+          FUNCTION FE IS NEW F (ENUM);
+
+     BEGIN
+
+          DECLARE
+               FUNCTION A_B_C RETURN ENUM IS
+               BEGIN
+                    RETURN ENUM'VAL (IDENT_INT (0));
+               END A_B_C;
+          BEGIN
+               IF FE (A_B_C) THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INCORRECT VAL FOR A_B_C WHEN HIDDEN " &
+                             "BY A FUNCTION" );
+               END IF;
+
+               IF FE (C35502L.A_B_C) THEN
+                    FAILED ( "INCORRECT VAL FOR C35502L.A_B_C" );
+               END IF;
+         END;
+     END;
+
+     RESULT;
+END C35502L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502m.ada
new file mode 100644
index 000000000..754ecc52c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502m.ada
@@ -0,0 +1,177 @@
+-- C35502M.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
+--     THE PREFIX IS AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A
+--     CHARACTER TYPE, WITH AN ENUMERATION REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 05/27/86  CREATED ORIGINAL TEST.
+--     BCB 01/04/88  MODIFIED HEADER.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35502M IS
+
+     TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+     FOR ENUM USE (A => 2, BC => 4, ABC => 6,
+                   A_B_C => 8, ABCD => 10);
+
+     SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+
+     TYPE NEWENUM IS NEW ENUM;
+     SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+
+BEGIN
+     TEST ("C35502M", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                      "ENUMERATION TYPE, OTHER THAN A CHARACTER " &
+                      "OR A BOOLEAN TYPE, WITH AN ENUMERATION " &
+                      "REPRESENTATION CLAUSE" );
+
+     DECLARE
+          POSITION : INTEGER;
+     BEGIN
+          POSITION := 0;
+
+          FOR E IN ENUM
+               LOOP
+                    IF SUBENUM'POS (E) /= POSITION THEN
+                         FAILED ( "INCORRECT SUBENUM'POS (" &
+                                   ENUM'IMAGE (E) & ")" );
+                    END IF;
+
+                    IF SUBENUM'VAL (POSITION) /= E THEN
+                         FAILED ( "INCORRECT SUBENUM'VAL (" &
+                                   INTEGER'IMAGE (POSITION) &
+                                  ")" );
+                    END IF;
+
+                    POSITION := POSITION + 1;
+               END LOOP;
+
+          POSITION := 0;
+          FOR E IN NEWENUM
+               LOOP
+                    IF SUBNEW'POS (E) /= POSITION THEN
+                         FAILED ( "INCORRECT SUBNEW'POS (" &
+                                   NEWENUM'IMAGE (E) & ")" );
+                    END IF;
+
+                    IF SUBNEW'VAL (POSITION) /= E THEN
+                         FAILED ( "INCORRECT SUBNEW'VAL (" &
+                                   INTEGER'IMAGE (POSITION) &
+                                  ")" );
+                    END IF;
+
+                    POSITION := POSITION + 1;
+               END LOOP;
+     END;
+
+     DECLARE
+          FUNCTION A_B_C RETURN ENUM IS
+          BEGIN
+               RETURN A;
+          END A_B_C;
+
+     BEGIN
+          IF ENUM'VAL (0) /= A_B_C THEN
+               FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
+                        "BY FUNCTION - 1" );
+          END IF;
+
+          IF ENUM'VAL (0) = C35502M.A_B_C THEN
+               FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
+                        "BY FUNCTION - 2" );
+          END IF;
+     END;
+
+     BEGIN
+          IF ENUM'VAL (IDENT_INT (-1)) = ENUM'FIRST THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "ENUM'VAL (IDENT_INT (-1)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "ENUM'VAL (IDENT_INT (-1)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "ENUM'VAL (IDENT_INT (-1))" );
+     END;
+
+     BEGIN
+          IF NEWENUM'VAL (IDENT_INT (-1)) = NEWENUM'LAST THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (-1)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (-1)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (-1))" );
+     END;
+
+     BEGIN
+          IF ENUM'VAL (IDENT_INT (5)) = ENUM'LAST THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "ENUM'VAL (IDENT_INT (5)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "ENUM'VAL (IDENT_INT (5)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "ENUM'VAL (IDENT_INT (5))" );
+     END;
+
+     BEGIN
+          IF NEWENUM'VAL (IDENT_INT (5)) = NEWENUM'LAST THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (5)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (5)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "NEWENUM'VAL (IDENT_INT (5))" );
+     END;
+
+     RESULT;
+END C35502M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502n.ada
new file mode 100644
index 000000000..780120dbb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502n.ada
@@ -0,0 +1,158 @@
+-- C35502N.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
+--     THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT IS
+--     AN ENUMERATION TYPE, OTHER THAN A BOOLEAN OR A CHARACTER TYPE,
+--     WITH AN ENUMERATION REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 05/27/86
+--     DWC 07/22/87  ADDED THE PARAMETER 'N' TO FUNCTION F.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35502N IS
+
+     TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+     FOR ENUM USE (A => 1, BC => 4, ABC => 5, A_B_C => 6,
+                   ABCD => 8);
+
+     SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
+
+     TYPE NEWENUM IS NEW ENUM;
+     SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
+
+BEGIN
+     TEST ("C35502N", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                      "FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT " &
+                      "IS AN ENUMERATION TYPE, OTHER THAN A " &
+                      "CHARACTER OR A BOOLEAN TYPE, WITH AN " &
+                      "ENUMERATION REPRESENTATION CLAUSE" );
+
+     DECLARE
+
+          GENERIC
+               TYPE E IS (<>);
+               STR : STRING;
+          PROCEDURE P;
+
+          PROCEDURE P IS
+               SUBTYPE SE IS E RANGE E'VAL(0) .. E'VAL(1);
+               POSITION : INTEGER;
+          BEGIN
+
+               POSITION := 0;
+
+               FOR E1 IN E LOOP
+                    IF SE'POS (E1) /= POSITION THEN
+                         FAILED ( "INCORRECT " & STR & "'POS (" &
+                                   E'IMAGE (E1) & ")" );
+                    END IF;
+
+                    IF SE'VAL (POSITION) /= E1 THEN
+                         FAILED ( "INCORRECT " & STR & "'VAL (" &
+                                   INTEGER'IMAGE (POSITION) &
+                                   ")" );
+                    END IF;
+
+                    POSITION := POSITION + 1;
+               END LOOP;
+
+               BEGIN
+                    IF E'VAL (-1) = E'VAL (1) THEN
+                         FAILED ( "NO EXCEPTION RAISED FOR " &
+                                   STR & "'VAL (-1) - 1" );
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED FOR " &
+                                   STR & "'VAL (-1) - 2" );
+                    END IF;
+               EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                         NULL;
+               WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                   STR & "'VAL (-1)" );
+               END;
+
+               BEGIN
+                    IF E'VAL (5) = E'VAL (4) THEN
+                         FAILED ( "NO EXCEPTION RAISED FOR " &
+                                   STR & "'VAL (5) - 1" );
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED FOR " &
+                                   STR & "'VAL (5) - 2" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                   STR & "'VAL (5)" );
+               END;
+          END P;
+
+          PROCEDURE PE IS NEW P ( ENUM, "ENUM" );
+          PROCEDURE PN IS NEW P ( NEWENUM, "NEWENUM" );
+     BEGIN
+          PE;
+          PN;
+     END;
+
+     DECLARE
+          FUNCTION A_B_C RETURN ENUM IS
+          BEGIN
+               RETURN ENUM'VAL (IDENT_INT (0));
+          END A_B_C;
+
+          GENERIC
+               TYPE E IS (<>);
+          FUNCTION F (N : INTEGER;
+                      E1 : E) RETURN BOOLEAN;
+
+          FUNCTION F (N : INTEGER;
+                      E1 : E) RETURN BOOLEAN IS
+          BEGIN
+               RETURN E'VAL (N) = E1;
+          END F;
+
+          FUNCTION FE IS NEW F (ENUM);
+
+     BEGIN
+
+     IF NOT FE (0, A_B_C) THEN
+          FAILED ( "INCORRECT VAL FOR A_B_C WHEN HIDDEN " &
+                   "BY A FUNCTION" );
+     END IF;
+
+     IF NOT FE (3, C35502N.A_B_C) THEN
+                    FAILED ( "INCORRECT VAL FOR C35502N.A_B_C" );
+     END IF;
+     END;
+
+     RESULT;
+END C35502N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502o.ada
new file mode 100644
index 000000000..561e1e9aa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502o.ada
@@ -0,0 +1,52 @@
+-- C35502O.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 AND 'LAST GIVE CORRECT RESULTS FOR TYPES
+-- AND SUBTYPES.
+
+-- DAT 3/17/81
+-- R. WILLIAMS 11/11/86      RENAMED FROM C35104A.ADA.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35502O IS
+
+     TYPE E IS (E1, E2, E3, E4, E5);
+
+     SUBTYPE S IS E RANGE E2 .. E4;
+
+BEGIN
+     TEST ("C35502O", "CHECK THAT 'FIRST AND 'LAST WORK FOR"
+          & " ENUMERATION TYPES AND SUBTYPES");
+
+     IF E'FIRST /= E1 OR E'LAST /= E5
+     OR E'BASE'FIRST /= E1 OR E'BASE'LAST /= E5
+     OR S'BASE'FIRST /= E1 OR S'BASE'LAST /= E5
+     OR S'FIRST /= E2 OR S'LAST /= E4
+     OR BOOLEAN'FIRST /= FALSE OR BOOLEAN'LAST /= TRUE
+     THEN
+          FAILED ("'FIRST OR 'LAST GIVES WRONG RESULTS");
+     END IF;
+
+     RESULT;
+END C35502O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502p.ada
new file mode 100644
index 000000000..1dfef9ab0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35502p.ada
@@ -0,0 +1,122 @@
+-- C35502P.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:
+--     FOR AN ENUMERATION TYPE OTHER THAN BOOLEAN OR CHARACTER TYPE,
+--     CHECK THAT THE RESULTS AND TYPE PRODUCED BY THE ATTRIBUTES
+--     ARE CORRECT.
+
+--     CHECK THAT 'FIRST AND 'LAST YIELD CORRECT RESULTS WHEN THE
+--     PREFIX DENOTES A NULL SUBTYPE.
+
+-- HISTORY:
+--     RJW 05/05/86  CREATED ORIGINAL TEST.
+--     CJJ 06/09/87  CHANGED "=" COMPARISONS IN GENERIC
+--                   PROCEDURE Q TO "/=".
+
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35502P  IS
+
+BEGIN
+
+     TEST( "C35502P" , "CHECK THAT THE ATTRIBUTES 'FIRST' AND " &
+                       "'LAST' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A GENERIC FORMAL DISCRETE TYPE " &
+                       "WHOSE ACTUAL PARAMETER IS AN ENUMERATION " &
+                       "TYPE OTHER THAN A CHARACTER OR A BOOLEAN " &
+                       "TYPE" );
+
+     DECLARE
+       -- FOR THESE DECLARATIONS, 'FIRST AND 'LAST REFER TO THE
+       -- SUBTYPE VALUES, BUT 'VAL AND 'POS ARE INHERITED FROM THE
+       -- BASE TYPE.
+
+          TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
+          SUBTYPE SUBENUM IS ENUM RANGE A .. ABC;
+
+          TYPE NEWENUM IS NEW ENUM RANGE BC .. A_B_C;
+          TYPE NONEWENUM IS NEW ENUM RANGE ABCD .. A;
+          GENERIC
+               TYPE E IS (<>);
+               F, L : E;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+               SUBTYPE NOENUM IS E RANGE
+                   E'VAL (IDENT_INT(2)) .. E'VAL (IDENT_INT(1));
+          BEGIN
+               IF E'FIRST /= F THEN
+                    FAILED ( "INCORRECT E'FIRST FOR " & STR );
+               END IF;
+               IF NOENUM'FIRST /= E'VAL (2) THEN
+                    FAILED ( "INCORRECT NOENUM'FIRST FOR " & STR );
+               END IF;
+
+               IF E'LAST /= L THEN
+                    FAILED ( "INCORRECT E'LAST FOR " & STR );
+               END IF;
+               IF NOENUM'LAST /= E'VAL (1) THEN
+                    FAILED ( "INCORRECT NOENUM'LAST FOR " & STR );
+               END IF;
+          END P;
+
+          GENERIC
+               TYPE E IS (<>);
+          PROCEDURE Q;
+
+          PROCEDURE Q IS
+               SUBTYPE NOENUM IS E RANGE
+                       E'VAL (IDENT_INT(2)) .. E'VAL (IDENT_INT(1));
+          BEGIN
+               IF E'FIRST /= E'VAL (IDENT_INT(4)) THEN
+                    FAILED ( "INCORRECT E'FIRST FOR NONEWENUM" );
+               END IF;
+               IF NOENUM'FIRST /= E'VAL (2) THEN
+                    FAILED ( "INCORRECT NOENUM'FIRST FOR NONEWENUM");
+               END IF;
+
+               IF E'LAST /= E'VAL (IDENT_INT(0)) THEN
+                    FAILED ( "INCORRECT E'LAST FOR NONEWENUM");
+               END IF;
+               IF NOENUM'LAST /= E'VAL (1) THEN
+                    FAILED ( "INCORRECT NOENUM'LAST FOR NONEWENUM");
+               END IF;
+          END Q;
+
+          PROCEDURE PROC1 IS NEW P (ENUM, A, ABCD);
+          PROCEDURE PROC2 IS NEW P (SUBENUM, A, ABC);
+          PROCEDURE PROC3 IS NEW P (NEWENUM, BC, A_B_C);
+          PROCEDURE PROC4 IS NEW Q (NONEWENUM);
+
+     BEGIN
+          PROC1 ( "ENUM" );
+          PROC2 ( "SUBENUM" );
+          PROC3 ( "NEWENUM" );
+          PROC4;
+     END;
+
+     RESULT;
+END C35502P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503a.ada
new file mode 100644
index 000000000..b9daf25f9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503a.ada
@@ -0,0 +1,80 @@
+-- C35503A.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 'WIDTH' YIELDS THE CORRECT RESULT WHEN THE PREFIX IS AN 
+-- INTEGER TYPE.
+
+-- RJW 3/12/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503A IS
+
+BEGIN
+     TEST ("C35503A", "CHECK THAT 'WIDTH' YIELDS THE CORRECT " &
+                      "RESULT WHEN THE PREFIX IS AN INTEGER TYPE" );
+
+     DECLARE
+          SUBTYPE SINTEGER IS INTEGER;
+          
+          TYPE INT IS RANGE -1000 .. 1000;
+          TYPE INT2 IS NEW INT RANGE 1E2 .. 1E2;
+
+          SUBTYPE SINT1 IS INT RANGE 00000 .. 100;
+          SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
+          SUBTYPE SINT3 IS INT RANGE -100 .. 9;
+          SUBTYPE NOINT IS INT RANGE 1 .. -1;
+
+     BEGIN
+          IF IDENT_INT(SINTEGER'WIDTH) /= INTEGER'WIDTH THEN
+               FAILED ( "WRONG WIDTH FOR 'SINTEGER'" );
+          END IF;
+
+          IF IDENT_INT(INT'WIDTH) /= 5 THEN
+               FAILED ( "WRONG WIDTH FOR 'INT'" );
+          END IF;
+
+          IF IDENT_INT(INT2'WIDTH) /= 4 THEN
+               FAILED ( "WRONG WIDTH FOR 'INT2'");
+          END IF;
+
+          IF IDENT_INT(SINT1'WIDTH) /= 4 THEN 
+               FAILED ( "WRONG WIDTH FOR 'SINT1'" );
+          END IF;
+
+          IF IDENT_INT(SINT2'WIDTH) /= 4 THEN 
+               FAILED ( "WRONG WIDTH FOR 'SINT2'" );
+          END IF;
+
+          IF IDENT_INT(SINT3'WIDTH) /= 4 THEN
+               FAILED ( "WRONG WIDTH FOR 'SINT3'" );
+          END IF;
+
+          IF IDENT_INT(NOINT'WIDTH) /= 0 THEN
+               FAILED ( "WRONG WIDTH FOR 'NOINT'" );
+          END IF;
+     END;
+
+     RESULT;
+END C35503A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503b.ada
new file mode 100644
index 000000000..f1bb5af0b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503b.ada
@@ -0,0 +1,87 @@
+-- C35503B.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 'WIDTH' YIELDS THE CORRECT RESULT WHEN THE PREFIX IS A
+-- GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS AN INTEGER 
+-- TYPE.
+
+-- RJW 3/17/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503B IS
+
+BEGIN
+     TEST ("C35503B", "CHECK THAT 'WIDTH' YIELDS THE CORRECT " &
+                      "RESULT WHEN THE PREFIX IS A GENERIC FORMAL "  &
+                      "DISCRETE TYPE WHOSE ACTUAL PARAMETER IS AN " &
+                      "INTEGER TYPE" );
+
+     DECLARE
+
+          TYPE INT IS RANGE -1000 .. 1000;
+          TYPE INT2 IS NEW INT RANGE 0E8 .. 1E3;
+          SUBTYPE SINT1 IS INT RANGE 00000 .. 300;
+          SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
+
+          GENERIC
+               TYPE I IS (<>);
+               W : INTEGER;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+               SUBTYPE SUBI IS I 
+                    RANGE I'VAL (IDENT_INT(224)) .. I'VAL (255);
+               SUBTYPE NORANGE IS I 
+                    RANGE I'VAL (255) .. I'VAL (IDENT_INT(224));
+          BEGIN
+               IF IDENT_INT(I'WIDTH) /= W THEN 
+                    FAILED ( "INCORRECT I'WIDTH FOR " & STR );
+               END IF;
+
+               IF IDENT_INT(SUBI'WIDTH) /= 4 THEN
+                    FAILED ( "INCORRECT SUBI'WIDTH FOR " & STR );
+               END IF;
+
+               IF IDENT_INT(NORANGE'WIDTH) /= 0 THEN
+                    FAILED ( "INCORRECT NORANGE'WIDTH FOR " & STR );
+               END IF;
+          END P;
+
+          PROCEDURE P_INTEGER IS NEW P (INTEGER, INTEGER'WIDTH);
+          PROCEDURE P_INT     IS NEW P (INT, 5);
+          PROCEDURE P_INT2    IS NEW P (INT2, 5);
+          PROCEDURE P_SINT1   IS NEW P (SINT1, 4);
+          PROCEDURE P_SINT2   IS NEW P (SINT2, 4);
+
+     BEGIN
+          P_INTEGER ("'INTEGER'");
+          P_INT     ("'INT'");
+          P_INT2    ("'INT2'");
+          P_SINT1   ("'SINT1'");
+          P_SINT2   ("'SINT2'");
+     END;
+
+     RESULT;
+END C35503B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503c.ada
new file mode 100644
index 000000000..331c76cc4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503c.ada
@@ -0,0 +1,543 @@
+-- C35503C.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULTS WHEN
+--     THE PREFIX IS AN INTEGER TYPE.
+--     SUBTESTS ARE :
+--         PART (A). TESTS FOR 'IMAGE'.
+--         PART (B). TESTS FOR 'VALUE'.
+
+-- HISTORY:
+--     RJW  03/17/86  CREATED ORIGINAL TEST.
+--     VCL  10/23/87  MODIFIED THIS HEADER, ADDED A CHECK THAT
+--                    CONSTRAINT_ERROR IS RAISED FOR THE ATTRIBUTE
+--                    'VALUE' IF THE FINAL SHARP OR COLON IS MISSING
+--                    FROM A BASED LITERAL.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35503C IS
+     TYPE NEWINT IS NEW INTEGER;
+     TYPE INT IS RANGE -1000 .. 1000;
+
+     FUNCTION IDENT (X : INT) RETURN INT IS
+     BEGIN
+          IF EQUAL (INT'POS (X), INT'POS(X)) THEN
+               RETURN X;
+          END IF;
+          RETURN INT'FIRST;
+     END IDENT;
+
+BEGIN
+     TEST ("C35503C", "THE ATTIBUTES 'IMAGE' AND 'VALUE' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                      "INTEGER TYPE" );
+-- PART (A).
+
+     BEGIN
+          IF INTEGER'IMAGE (-500) /= "-500" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '-500'" );
+          END IF;
+          IF INTEGER'IMAGE (-500)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '-500'" );
+          END IF;
+
+          IF NEWINT'IMAGE (2 ** 6) /= " 64" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '2 ** 6'" );
+          END IF;
+          IF NEWINT'IMAGE (2 ** 6)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '2 ** 6'" );
+          END IF;
+
+          IF NATURAL'IMAGE (-1E2) /= "-100" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '-1E2'" );
+          END IF;
+          IF NATURAL'IMAGE (-1E2)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '-1E2'" );
+          END IF;
+
+          IF NEWINT'IMAGE (3_45) /= " 345" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '3_45'" );
+          END IF;
+          IF NEWINT'IMAGE (3_45)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '3_45'" );
+          END IF;
+
+          IF INTEGER'IMAGE (-2#1111_1111#) /= "-255" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '-2#1111_1111#'" );
+          END IF;
+          IF INTEGER'IMAGE (-2#1111_1111#)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '-2#1111_1111#'" );
+          END IF;
+
+          IF NEWINT'IMAGE (16#FF#) /= " 255" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '16#FF#'" );
+          END IF;
+          IF NEWINT'IMAGE (16#FF#)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '16#FF#'" );
+          END IF;
+
+          IF INTEGER'IMAGE (-016#0FF#) /= "-255" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '-016#0FF#'" );
+          END IF;
+          IF INTEGER'IMAGE (-016#0FF#)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '-016#0FF#'" );
+          END IF;
+
+          IF NEWINT'IMAGE (2#1110_0000#) /= " 224" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '2#1110_0000#'" );
+          END IF;
+          IF NEWINT'IMAGE (2#1110_0000#)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '2#1110_0000#'" );
+          END IF;
+
+          IF POSITIVE'IMAGE (-16#E#E1) /= "-224" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '-16#E#E1'" );
+          END IF;
+          IF POSITIVE'IMAGE (-16#E#E1)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '-16#E#E1'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(-1000)) /= "-1000" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '-1000'" );
+          END IF;
+          IF INT'IMAGE (IDENT(-1000))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '-1000'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(-999)) /= "-999" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '-999'" );
+          END IF;
+          IF INT'IMAGE (IDENT(-999))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '-999'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(-10)) /= "-10" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '-1000'" );
+          END IF;
+          IF INT'IMAGE (IDENT(-10))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '-10'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(-9)) /= "-9" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '-9'" );
+          END IF;
+          IF INT'IMAGE (IDENT(-9))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '-9'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(-1)) /= "-1" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '-1'" );
+          END IF;
+          IF INT'IMAGE (IDENT(-1))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '-1'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(0)) /= " 0" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '0'" );
+          END IF;
+          IF INT'IMAGE (IDENT(0))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '0'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(1)) /= " 1" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '1'" );
+          END IF;
+          IF INT'IMAGE (IDENT(1))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '1'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(9)) /= " 9" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '9'" );
+          END IF;
+          IF INT'IMAGE (IDENT(9))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '9'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(10)) /= " 10" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '10'" );
+          END IF;
+          IF INT'IMAGE (IDENT(10))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '10'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(999)) /= " 999" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '999'" );
+          END IF;
+          IF INT'IMAGE (IDENT(999))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '999'" );
+          END IF;
+
+          IF INT'IMAGE (IDENT(1000)) /= " 1000" THEN
+               FAILED ( "INCORRECT 'IMAGE' OF '1000'" );
+          END IF;
+          IF INT'IMAGE (IDENT(1000))'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR '1000'" );
+          END IF;
+
+     END;
+
+-----------------------------------------------------------------------
+
+-- PART (B).
+
+     BEGIN
+          IF POSITIVE'VALUE (IDENT_STR("-500")) /= -500 THEN
+               FAILED ( "INCORRECT 'VALUE' OF ""-500""" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - 'VALUE' OF ""-500""" );
+     END;
+
+     BEGIN
+          IF NEWINT'VALUE (" -001E2") /= -100 THEN
+               FAILED ( "INCORRECT 'VALUE' OF "" -001E2""" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - 'VALUE' OF "" -001E2""" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE ("03_45") /= 345 THEN
+               FAILED ( "INCORRECT 'VALUE' OF ""03_45""" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - 'VALUE' OF ""03_45""" );
+     END;
+
+     BEGIN
+          IF NEWINT'VALUE ("-2#1111_1111#") /= -255 THEN
+               FAILED ( "INCORRECT 'VALUE' OF ""-2#1111_1111#""" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - 'VALUE' OF "&
+                        """-2#1111_1111#""" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("16#FF#")) /= 255 THEN
+               FAILED ( "INCORRECT 'VALUE' OF ""16#FF#""" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - 'VALUE' OF ""16#FF#""" );
+     END;
+
+     BEGIN
+          IF NATURAL'VALUE (IDENT_STR("-016#0FF#")) /= -255 THEN
+               FAILED ( "INCORRECT 'VALUE' OF ""-016#0FF#""" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - 'VALUE' OF " &
+                        """-016#0FF#""" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE ("2#1110_0000#     ") /= 224 THEN
+               FAILED ( "INCORRECT 'VALUE' OF " &
+                        """2#1110_0000#     """ );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - 'VALUE' OF " &
+                        """2#1110_0000#     """ );
+     END;
+
+     BEGIN
+          IF NEWINT'VALUE ("  -16#E#E1") /= -224 THEN
+               FAILED ( "INCORRECT 'VALUE' OF ""  -16#E#E1""" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - 'VALUE' OF " &
+                        """  -16#E#E1""" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE ("5/0") = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED - ""5/0"" - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - ""5/0"" - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - ""5/0""" );
+     END;
+
+     DECLARE
+          SUBTYPE SUBINT IS INTEGER RANGE 0 .. 10;
+     BEGIN
+          IF SUBINT'VALUE (IDENT_STR("-500")) /= -500 THEN
+               FAILED ( "INCORRECT VALUE WITH ""-500"" AND SUBINT" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - SUBINT" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("1.0")) = 1 THEN
+               FAILED ( "NO EXCEPTION RAISED - "" 1.0"" - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - ""1.0"" - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - ""1.0"" " );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_CHAR(ASCII.HT) & "244") /= 244 THEN
+               FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE ("244" & (IDENT_CHAR(ASCII.HT))) /= 244 THEN
+               FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("2__44")) /= 244 THEN
+               FAILED ( "NO EXCEPTION RAISED - CONSECUTIVE '_' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - CONSECUTIVE '_' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "WITH CONSECUTIVE '_'" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("_244")) /= 244 THEN
+               FAILED ( "NO EXCEPTION RAISED - LEADING '_' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - LEADING '_' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - LEADING '_'" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("244_")) /= 244 THEN
+               FAILED ( "NO EXCEPTION RAISED - TRAILING '_' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - TRAILING '_' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - TRAILING '_'" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("244_E1")) /= 2440 THEN
+               FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'E' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'E' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - '_' BEFORE 'E'" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("244E_1")) /= 2440 THEN
+               FAILED ( "NO EXCEPTION RAISED - '_' " &
+                        "FOLLOWING 'E' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - '_' FOLLOWING 'E' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "- '_' FOLLOWING 'E'" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("244_e1")) /= 2440 THEN
+               FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'e' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - '_' BEFORE 'e' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - '_' BEFORE 'e'" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("16#_FF#")) /= 255 THEN
+               FAILED ( "NO EXCEPTION RAISED - LEADING '_' IN BASED " &
+                        "LITERAL - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - LEADING '_' IN BASED " &
+                        "LITERAL - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "- LEADING '_' IN BASED LITERAL" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("1E-0")) /= 1 THEN
+               FAILED ( "NO EXCEPTION RAISED - NEGATIVE " &
+                        "EXPONENT - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - NEGATIVE EXPONENT - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "- NEGATIVE EXPONENT" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("244.")) /= 244 THEN
+               FAILED ( "NO EXCEPTION RAISED - TRAILING '.' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - TRAILING '.' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - TRAILING '.'" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("8#811#")) /= 0 THEN
+               FAILED ( "NO EXCEPTION RAISED - " &
+                        "DIGITS NOT IN CORRECT RANGE - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - " &
+                        "DIGITS NOT IN CORRECT RANGE - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - " &
+                        "DIGITS NOT IN CORRECT RANGE" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("1#000#")) /= 0 THEN
+               FAILED ( "NO EXCEPTION RAISED - BASE LESS THAN 2 - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - BASE LESS THAN 2 - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "- BASE LESS THAN 2" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("17#0#")) /= 0 THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "- BASE GREATER THAN 16 - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "- BASE GREATER THAN 16 - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "- BASE GREATER THAN 16" );
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("8#666")) /= 438 THEN
+               FAILED ("NO EXCEPTION RAISED - MISSING FINAL SHARP - 1");
+          ELSE
+               FAILED ("NO EXCEPTION RAISED - MISSING FINAL SHARP - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - MISSING FINAL SHARP");
+     END;
+
+     BEGIN
+          IF INTEGER'VALUE (IDENT_STR("16:FF")) /= 255 THEN
+               FAILED ("NO EXCEPTION RAISED - MISSING FINAL COLON - 1");
+          ELSE
+               FAILED ("NO EXCEPTION RAISED - MISSING FINAL COLON - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - MISSING FINAL COLON");
+     END;
+
+     RESULT;
+END C35503C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503d.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503d.tst
new file mode 100644
index 000000000..b15e1ab0f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503d.tst
@@ -0,0 +1,97 @@
+-- C35503D.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULT FOR THE
+--     LARGEST/SMALLEST INTEGER LITERAL FOR THE LONGEST INTEGER TYPE.
+
+-- HISTORY:
+--     RJW 02/26/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503D IS
+
+     TYPE INT IS RANGE MIN_INT .. MAX_INT;
+
+     FUNCTION IDENT (X:INT) RETURN INT IS
+          BEGIN
+               IF EQUAL (3,3) THEN
+                    RETURN X;
+               END IF;
+               RETURN 0;
+          END IDENT;
+
+BEGIN
+     TEST ("C35503D", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD " &
+                      "CORRECT RESULTS FOR THE LARGEST/SMALLEST "&
+                      "INTEGER LITERAL FOR THE LARGEST INTEGER TYPE");
+
+     -- MIN_INT IS THE DECIMAL LITERAL FOR SYSTEM.MIN_INT.
+     -- MAX_INT IS THE DECIMAL LITERAL FOR SYSTEM.MAX_INT.
+
+     BEGIN
+          IF INT'VALUE (IDENT_STR("$MIN_INT")) /= MIN_INT THEN
+               FAILED("INCORRECT RESULTS FOR 'VALUE' - MIN_INT");
+          END IF;
+     EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+               FAILED("CONSTRAINT_ERROR RAISED FOR 'VALUE' - MIN_INT");
+           WHEN OTHERS =>
+               FAILED("OTHER EXCEPTION RAISED FOR 'VALUE' - MIN_INT");
+     END;
+
+     BEGIN
+           IF INT'IMAGE (IDENT(MIN_INT)) /= "$MIN_INT" THEN
+                FAILED("INCORRECT RESULTS FOR 'IMAGE' - MIN_INT");
+           END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED("EXCEPTION RAISED FOR 'IMAGE' - MIN_INT");
+     END;
+
+     BEGIN
+           IF INT'VALUE (IDENT_STR("$MAX_INT")) /= MAX_INT THEN
+               FAILED("INCORRECT RESULTS FOR 'VALUE' - MAX_INT");
+           END IF;
+     EXCEPTION
+           WHEN CONSTRAINT_ERROR =>
+               FAILED("CONSTRAINT_ERROR RAISED FOR 'VALUE' - MAX_INT");
+           WHEN OTHERS =>
+               FAILED("OTHER EXCEPTION RAISED FOR 'VALUE' - MAX_INT");
+     END;
+
+     BEGIN
+           IF INT'IMAGE (IDENT(MAX_INT)) /= ' ' & "$MAX_INT" THEN
+               FAILED("INCORRECT RESULTS FOR 'IMAGE' - MAXINT");
+           END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED("EXCEPTION RAISED FOR 'IMAGE' - MAXINT");
+     END;
+
+     RESULT;
+END C35503D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503e.ada
new file mode 100644
index 000000000..0f326e1e5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503e.ada
@@ -0,0 +1,212 @@
+-- C35503E.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULTS WHEN
+--     THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL
+--     PARAMETER IS AN INTEGER TYPE.
+--     SUBTESTS ARE :
+--         PART (A). TESTS FOR 'IMAGE'.
+--         PART (B). TESTS FOR 'VALUE'.
+
+-- HISTORY:
+--     RJW 03/17/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503E IS
+
+BEGIN
+     TEST ("C35503E", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE " &
+                      "CORRECT RESULTS  WHEN THE PREFIX IS A " &
+                      "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                      "PARAMETER IS AN INTEGER TYPE" );
+-- PART (A).
+
+     DECLARE
+          TYPE NEWINT IS NEW INTEGER RANGE -2000 .. 2000;
+
+          GENERIC
+               TYPE INT IS (<>);
+          PROCEDURE P (I1 : INT; STR : STRING );
+
+          PROCEDURE P (I1 : INT; STR : STRING) IS
+               SUBTYPE SUBINT IS INT
+               RANGE INT'VAL (IDENT_INT(-1000)) ..
+                                              INT'VAL (IDENT_INT(1000));
+          BEGIN
+
+               IF INT'IMAGE (I1) /= STR THEN
+                    FAILED ( "INCORRECT INT'IMAGE OF " & STR );
+               END IF;
+               IF INT'IMAGE (I1)'FIRST /= 1 THEN
+                    FAILED ( "INCORRECT LOWER BOUND FOR INT'IMAGE OF " &
+                             STR );
+               END IF;
+
+               IF SUBINT'IMAGE (I1) /= STR THEN
+                    FAILED ( "INCORRECT SUBINT'IMAGE OF " & STR );
+               END IF;
+               IF SUBINT'IMAGE (I1)'FIRST /= 1 THEN
+                    FAILED ( "INCORRECT LOWER BOUND FOR SUBINT'IMAGE " &
+                             "OF " & STR );
+               END IF;
+
+          END P;
+
+          PROCEDURE PROC1 IS NEW P (INTEGER);
+          PROCEDURE PROC2 IS NEW P (NEWINT);
+
+     BEGIN
+          PROC1 (-500, "-500");
+          PROC2 (0, " 0");
+          PROC2 (99," 99");
+     END;
+
+-----------------------------------------------------------------------
+
+-- PART (B).
+
+     DECLARE
+          TYPE NEWINT IS NEW INTEGER;
+
+          GENERIC
+               TYPE INT IS (<>);
+          PROCEDURE P (STR : STRING; I1 : INT );
+
+          PROCEDURE P (STR : STRING; I1 : INT) IS
+               SUBTYPE SUBINT IS INT
+                    RANGE INT'VAL (IDENT_INT(0)) ..
+                                                INT'VAL (IDENT_INT(10));
+
+          BEGIN
+               BEGIN
+                    IF INT'VALUE (STR) /= I1 THEN
+                         FAILED ( "INCORRECT INT'VALUE OF """ &
+                                  STR & """");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED INT'VALUE OF """ &
+                                  STR & """");
+               END;
+               BEGIN
+                    IF SUBINT'VALUE (STR) /= I1 THEN
+                         FAILED ( "INCORRECT SUBINT'VALUE OF """ &
+                                  STR & """");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED SUBINT'VALUE " &
+                                  "OF """ & STR & """");
+               END;
+          END P;
+
+          PROCEDURE PROC1 IS NEW P (INTEGER);
+          PROCEDURE PROC2 IS NEW P (NEWINT);
+
+     BEGIN
+               PROC1 ("-500" , -500);
+               PROC2 (" -001E2 " , -100);
+               PROC1 ("3_45" , 345);
+               PROC2 ("-2#1111_1111#" , -255);
+               PROC1 ("16#FF#" , 255);
+               PROC2 ("-016#0FF#" , -255);
+               PROC1 ("2#1110_0000#     " , 224);
+               PROC2 ("-16#E#E1" , -224);
+
+     END;
+
+     DECLARE
+          TYPE NEWINT IS NEW INTEGER;
+
+          GENERIC
+               TYPE INT IS (<>);
+          PROCEDURE P (STR1 : STRING; I1 : INT; STR2 : STRING);
+
+          PROCEDURE P (STR1 : STRING; I1 : INT; STR2 : STRING) IS
+               SUBTYPE SUBINT IS INT
+                    RANGE INT'VAL (IDENT_INT(0)) ..
+                                                INT'VAL (IDENT_INT(10));
+
+          BEGIN
+               BEGIN
+                    IF INT'VALUE (STR1) = I1 THEN
+                         FAILED ( "NO EXCEPTION RAISED - INT'VALUE " &
+                                  "WITH " & STR2 & " - EQUAL");
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED " &
+                                  "- INT'VALUE WITH " &
+                                  STR2 & " - NOT EQUAL" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED - " &
+                                  "INT'VALUE WITH " & STR2 );
+               END;
+               BEGIN
+                    IF SUBINT'VALUE (STR1) = I1 THEN
+                         FAILED ( "NO EXCEPTION RAISED - " &
+                                  "SUBINT'VALUE WITH " & STR2
+                                   & " - EQUAL" );
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED - " &
+                                  "SUBINT'VALUE WITH " &
+                                   STR2 & " - NOT EQUAL" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED  - " &
+                                  "SUBINT'VALUE WITH " & STR2 );
+               END;
+          END P;
+
+          PROCEDURE PROC1 IS NEW P (INTEGER);
+          PROCEDURE PROC2 IS NEW P (NEWINT);
+
+     BEGIN
+          PROC1 ("1.0"           , 1,      "DECIMAL POINT");
+          PROC1 (ASCII.HT & "244", 244,    "LEADING 'HT'" );
+          PROC2 ("244" & ASCII.HT, 244,    "TRAILING 'HT'" );
+          PROC1 ("2__44"         , 244,    "CONSECUTIVE '_'" );
+          PROC2 ("_244"          , 244,    "LEADING '_'" );
+          PROC1 ("244_"          , 244,    "TRAILING '_'" );
+          PROC2 ("244_E1"        , 2440,   "'_' BEFORE 'E'" );
+          PROC1 ("244E_1"        , 2440,   "'_' FOLLOWING 'E'" );
+          PROC2 ("244_e1"        , 2440,   "'_' BEFORE 'e'" );
+          PROC1 ("16#_FF#"       , 255,    "'_' IN BASED LITERAL" );
+          PROC2 ("1E-0"          ,   0,    "NEGATIVE EXPONENT" );
+          PROC1 ("244."          , 244,    "TRAILING '.'" );
+          PROC2 ("8#811#"        , 0,      "DIGITS OUTSIDE OF RANGE" );
+          PROC1 ("1#000#"        , 0,      "BASE LESS THAN 2" );
+          PROC2 ("17#0#"         , 0,      "BASE GREATER THAN 16" );
+     END;
+
+     RESULT;
+END C35503E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503f.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503f.tst
new file mode 100644
index 000000000..f68669aaf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503f.tst
@@ -0,0 +1,132 @@
+-- C35503F.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULT FOR THE
+--     LARGEST/SMALLEST INTEGER LITERAL AND A FORMAL DISCRETE TYPE WHOSE
+--     ACTUAL PARAMETER IS AN INTEGER TYPE.
+
+-- HISTORY
+--     RJW 05/12/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503F IS
+
+TYPE LONGEST_INT IS RANGE MIN_INT .. MAX_INT;
+
+BEGIN
+     TEST ("C35503F", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD " &
+                      "CORRECT RESULTS FOR THE LARGEST/SMALLEST "&
+                      "INTEGER LITERAL AND A FORMAL DISCRETE TYPE " &
+                      "WHOSE ACTUAL PARAMETER IS AN INTEGER TYPE");
+
+     -- INTEGER_FIRST IS THE DECIMAL LITERAL IMAGE OF INTEGER'FIRST.
+     -- INTEGER_LAST IS THE DECIMAL LITERAL IMAGE OF INTEGER'LAST.
+     -- MIN_INT IS THE DECIMAL LITERAL IMAGE OF SYSTEM.MIN_INT.
+     -- MAX_INT IS THE DECIMAL LITERAL IMAGE OF SYSTEM.MAX_INT.
+
+     DECLARE
+          GENERIC
+               TYPE INT IS (<>);
+          PROCEDURE P ( FS, LS : STRING; FI, LI : INT );
+
+          PROCEDURE P ( FS, LS : STRING; FI, LI : INT ) IS
+          BEGIN
+               BEGIN
+                    IF INT'VALUE (FS) /= FI THEN
+                         FAILED ( "INCORRECT RESULTS FOR 'VALUE' OF " &
+                                  FS );
+                    END IF;
+               EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                         FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
+                                  "'VALUE' OF " & FS );
+                     WHEN OTHERS =>
+                         FAILED ( "OTHER EXCEPTION RAISED FOR " &
+                                  "'VALUE' OF " & FS );
+               END;
+
+               BEGIN
+                    IF INT'VALUE (LS) /= LI THEN
+                         FAILED ( "INCORRECT RESULTS FOR 'VALUE' OF " &
+                                  LS );
+                    END IF;
+               EXCEPTION
+                     WHEN CONSTRAINT_ERROR =>
+                         FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
+                                  "'VALUE' OF " & LS );
+                     WHEN OTHERS =>
+                         FAILED ( "OTHER EXCEPTION RAISED FOR " &
+                                  "'VALUE' OF " & LS );
+               END;
+          END P;
+
+          GENERIC
+               TYPE INT IS  (<>);
+          PROCEDURE Q ( FS, LS : STRING; FI, LI : INT );
+
+          PROCEDURE Q ( FS, LS : STRING; FI, LI : INT ) IS
+          BEGIN
+               BEGIN
+                     IF INT'IMAGE(FI) /= FS THEN
+                          FAILED ( "INCORRECT RESULTS FOR " &
+                                   "'IMAGE' WITH " & FS );
+                     END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED FOR 'IMAGE' " &
+                                   "WITH " & FS );
+               END;
+
+               BEGIN
+                     IF INT'IMAGE(LI) /= LS THEN
+                         FAILED ( "INCORRECT RESULTS FOR " &
+                                  "'IMAGE' WITH " & LS );
+                     END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED FOR 'IMAGE' " &
+                                  "WITH " & LS );
+               END;
+          END Q;
+
+          PROCEDURE P1 IS NEW P ( INTEGER );
+          PROCEDURE Q1 IS NEW Q ( INTEGER );
+          PROCEDURE P2 IS NEW P ( LONGEST_INT );
+          PROCEDURE Q2 IS NEW Q ( LONGEST_INT );
+     BEGIN
+          P1 ("$INTEGER_FIRST", "$INTEGER_LAST", INTEGER'FIRST,
+                                                         INTEGER'LAST);
+          P2 ("$MIN_INT", "$MAX_INT", MIN_INT, MAX_INT);
+          Q1 ("$INTEGER_FIRST"," $INTEGER_LAST", INTEGER'FIRST,
+                                                         INTEGER'LAST);
+          Q2 ("$MIN_INT", " $MAX_INT", MIN_INT, MAX_INT);
+
+     END;
+
+     RESULT;
+END C35503F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503g.ada
new file mode 100644
index 000000000..2004e457a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503g.ada
@@ -0,0 +1,113 @@
+-- C35503G.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 'PRED' AND 'SUCC' YIELD THE CORRECT RESULT WHEN THE
+--     PREFIX IS AN INTEGER TYPE.
+
+-- HISTORY:
+--     RJW 03/17/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503G IS
+
+BEGIN
+     TEST ("C35503G", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                      "CORRECT RESULT WHEN THE PREFIX IS AN " &
+                      "INTEGER TYPE" );
+
+     DECLARE
+          TYPE INT IS RANGE -6 .. 6;
+          SUBTYPE SINT IS INT RANGE -4 .. 4;
+
+     BEGIN
+
+          FOR I IN INT'FIRST + 1 .. INT'LAST LOOP
+               BEGIN
+                    IF SINT'PRED (I) /= I - 1 THEN
+                         FAILED ( "WRONG SINT'PRED FOR " &
+                                  INT'IMAGE (I));
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED FOR " &
+                                  "SINT'PRED OF " &
+                                  INT'IMAGE (I));
+               END;
+          END LOOP;
+
+          FOR I IN INT'FIRST .. INT'LAST - 1 LOOP
+               BEGIN
+                    IF SINT'SUCC (I) /= I + 1 THEN
+                         FAILED ( "WRONG SINT'SUCC FOR " &
+                                  INT'IMAGE (I));
+                         END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED FOR " &
+                                  "SINT'SUCC OF " &
+                                  INT'IMAGE (I));
+               END;
+          END LOOP;
+
+     END;
+
+     DECLARE
+          SUBTYPE INTRANGE IS INTEGER RANGE IDENT_INT(-6) ..
+                                                          IDENT_INT(6);
+          SUBTYPE SINTEGER IS INTEGER RANGE IDENT_INT(-4) ..
+                                                          IDENT_INT(4);
+
+     BEGIN
+          FOR I IN INTRANGE LOOP
+               BEGIN
+                    IF SINTEGER'PRED (I) /= I - IDENT_INT(1) THEN
+                         FAILED ( "WRONG SINTEGER'PRED FOR " &
+                                  INTEGER'IMAGE (I));
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED FOR " &
+                                  "SINTEGER'PRED OF " &
+                                  INTEGER'IMAGE (I));
+               END;
+               BEGIN
+                    IF SINTEGER'SUCC (I) /= I + IDENT_INT(1) THEN
+                         FAILED ( "WRONG SINTEGER'SUCC FOR " &
+                                  INTEGER'IMAGE (I));
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED FOR " &
+                                  "SINTEGER'SUCC OF " &
+                                  INTEGER'IMAGE (I));
+               END;
+          END LOOP;
+
+     END;
+
+     RESULT;
+END C35503G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503h.ada
new file mode 100644
index 000000000..e1410673d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503h.ada
@@ -0,0 +1,94 @@
+-- C35503H.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 'PRED' AND 'SUCC' YIELD THE CORRECT RESULT WHEN THE
+--     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER
+--     IS AN INTEGER TYPE.
+
+-- HISTORY:
+--     RJW 03/17/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503H IS
+
+BEGIN
+     TEST ("C35503H", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                      "CORRECT RESULT WHEN THE PREFIX IS A GENERIC " &
+                      "FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER " &
+                      "IS AN INTEGER TYPE" );
+
+     DECLARE
+          TYPE INTRANGE IS RANGE -6 .. 6;
+
+          GENERIC
+               TYPE INT IS (<>);
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+               SUBTYPE SINT IS INT
+                    RANGE INT'VAL (IDENT_INT(-4)) ..
+                                                INT'VAL (IDENT_INT(4));
+          BEGIN
+               FOR I IN INT'VAL (IDENT_INT(-6))  ..
+                                                INT'VAL (IDENT_INT(6))
+               LOOP
+                    BEGIN
+                         IF SINT'PRED (I) /=
+                            SINT'VAL (SINT'POS (I) - 1) THEN
+                              FAILED ( "WRONG " & STR & "'PRED " &
+                                       "FOR " & INT'IMAGE (I) );
+                         END IF;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ( "EXCEPTION RAISED FOR " &
+                                        STR & "'PRED OF " &
+                                        INT'IMAGE (I));
+                    END;
+                    BEGIN
+                         IF SINT'SUCC (I) /=
+                            SINT'VAL (SINT'POS (I) + 1) THEN
+                              FAILED ( "WRONG " & STR & "'SUCC " &
+                                       "FOR " &  INT'IMAGE (I));
+                         END IF;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ( "EXCEPTION RAISED FOR " &
+                                        STR & "'SUCC OF " &
+                                        INT'IMAGE (I));
+                    END;
+               END LOOP;
+          END P;
+
+          PROCEDURE PROC1 IS NEW P (INTRANGE);
+          PROCEDURE PROC2 IS NEW P (INTEGER);
+     BEGIN
+          PROC1 ("INTRANGE");
+          PROC2 ("INTEGER");
+     END;
+
+     RESULT;
+END C35503H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503k.ada
new file mode 100644
index 000000000..e05021c6b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503k.ada
@@ -0,0 +1,120 @@
+-- C35503K.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE
+--     PREFIX IS AN INTEGER TYPE.
+
+-- HISTORY:
+--     RJW 03/17/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+--     PWN 11/30/94 REMOVED ATTRIBUTE TESTS ILLEGAL IN ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503K IS
+
+BEGIN
+     TEST ("C35503K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                      "INTEGER TYPE" );
+
+     DECLARE
+          TYPE INT IS RANGE -6 .. 6;
+          SUBTYPE SINT IS INT RANGE -4 .. 4;
+
+          PROCEDURE P (I : INTEGER; STR : STRING) IS
+          BEGIN
+               BEGIN
+                    IF INTEGER'POS (I) /= I THEN
+                         FAILED ( "WRONG POS FOR " & STR);
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED FOR POS OF " &
+                                   STR);
+               END;
+               BEGIN
+                    IF INTEGER'VAL (I) /= I THEN
+                         FAILED ( "WRONG VAL FOR " & STR);
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED FOR VAL OF " &
+                                   STR);
+               END;
+          END P;
+
+     BEGIN
+          P ( INTEGER'FIRST, "INTEGER'FIRST");
+          P ( INTEGER'LAST,  "INTEGER'LAST");
+          P ( 0, "'0'");
+
+          FOR I IN INT'FIRST .. INT'LAST LOOP
+               BEGIN
+                    IF SINT'POS (I) /= I THEN
+                         FAILED ( "WRONG POS FOR "
+                                   & INT'IMAGE (I));
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED FOR POS OF "
+                                  & INT'IMAGE (I));
+               END;
+               BEGIN
+                    IF SINT'VAL (I) /= I THEN
+                         FAILED ( "WRONG VAL FOR "
+                                  & INT'IMAGE (I));
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED FOR VAL OF "
+                                  & INT'IMAGE (I));
+               END;
+          END LOOP;
+
+          BEGIN
+               IF INT'VAL (INTEGER'(0)) /= 0 THEN
+                    FAILED ( "WRONG VAL FOR INT WITH INTEGER" );
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED FOR VAL OF " &
+                             "INT WITH INTEGER" );
+          END;
+
+          BEGIN
+               IF INTEGER'VAL (INT'(0)) /= 0 THEN
+                    FAILED ( "WRONG VAL FOR INTEGER WITH INT" );
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED FOR VAL OF " &
+                             "INTEGER WITH INT" );
+          END;
+     END;
+
+     RESULT;
+END C35503K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503l.ada
new file mode 100644
index 000000000..33d571d9d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503l.ada
@@ -0,0 +1,98 @@
+-- C35503L.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE
+--     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER
+--     IS AN INTEGER TYPE.
+
+-- HISTORY:
+--     RJW 03/17/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503L IS
+
+BEGIN
+     TEST ("C35503L", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                      "GENERIC FORMAL DISCRETE TYPE WHOSE " &
+                      "ACTUAL PARAMETER IS AN INTEGER TYPE" );
+
+     DECLARE
+          TYPE INTRANGE IS RANGE -6 .. 6;
+
+          GENERIC
+               TYPE INT IS (<>);
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+               SUBTYPE SINT IS INT RANGE
+                   INT'VAL (IDENT_INT(-4)) .. INT'VAL (IDENT_INT(4));
+               I :INTEGER;
+          BEGIN
+               I := IDENT_INT(-6);
+               FOR S IN INT'VAL (IDENT_INT(-6)) ..
+                                                 INT'VAL (IDENT_INT(6))
+               LOOP
+                    BEGIN
+                         IF SINT'POS (S) /= I THEN
+                              FAILED ( "WRONG VALUE FOR " &
+                                        STR & "'POS OF "
+                                       & INT'IMAGE (S) );
+                         END IF;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ( "EXCEPTION RAISED FOR " &
+                                        STR & "'POS "
+                                       & "OF " & INT'IMAGE (S) );
+                    END;
+                    BEGIN
+                         IF SINT'VAL (I) /= S THEN
+                              FAILED ( "WRONG VALUE FOR " &
+                                        STR & "'VAL "
+                                       & "OF " & INT'IMAGE (S) );
+                         END IF;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ( "EXCEPTION RAISED FOR " &
+                                        STR & "'VAL "
+                                       & "OF " & INT'IMAGE (S) );
+                    END;
+                    I := I + 1;
+               END LOOP;
+          END P;
+
+          PROCEDURE P1 IS NEW P (INTRANGE);
+          PROCEDURE P2 IS NEW P (INTEGER);
+
+     BEGIN
+          P1 ("INTRANGE");
+          P2 ("INTEGER");
+     END;
+
+     RESULT;
+
+END C35503L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503o.ada
new file mode 100644
index 000000000..57d288f37
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503o.ada
@@ -0,0 +1,125 @@
+-- C35503O.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 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
+--     PREFIX IS AN INTEGER TYPE.
+
+-- HISTORY:
+--     RJW 03/17/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503O IS
+
+BEGIN
+     TEST ("C35503O", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS AN " &
+                      "INTEGER TYPE" );
+
+     DECLARE
+          SUBTYPE SINTEGER IS INTEGER;
+          SUBTYPE SMALL IS INTEGER RANGE IDENT_INT(-10) ..
+                                                         IDENT_INT(10);
+          SUBTYPE NOINTEGER IS INTEGER
+            RANGE IDENT_INT(5) .. IDENT_INT(-7);
+
+          TYPE INT IS RANGE -6 .. 6;
+          SUBTYPE SINT IS INT
+            RANGE INT(IDENT_INT(-4)) .. INT(IDENT_INT(4));
+          SUBTYPE NOINT IS INT
+            RANGE INT(IDENT_INT(1)) .. INT(IDENT_INT(-1));
+          TYPE NEWINT IS NEW INTEGER RANGE IDENT_INT(-9) ..
+                                                          IDENT_INT(-2);
+          SUBTYPE SNEWINT IS NEWINT RANGE -7 .. -5;
+          SUBTYPE NONEWINT IS NEWINT RANGE 3 .. -15;
+
+     BEGIN
+          IF SINTEGER'FIRST /= INTEGER'FIRST THEN
+               FAILED ( "WRONG VALUE FOR SINTEGER'FIRST" );
+          END IF;
+          IF SINTEGER'LAST /= INTEGER'LAST THEN
+               FAILED ( "WRONG VALUE FOR SINTEGER'LAST" );
+          END IF;
+
+          IF SMALL'FIRST /= -10 THEN
+               FAILED ( "WRONG VALUE FOR SMALL'FIRST" );
+          END IF;
+          IF SMALL'LAST /= 10 THEN
+               FAILED ( "WRONG VALUE FOR SMALL'LAST" );
+          END IF;
+
+          IF NOINTEGER'FIRST /= 5 THEN
+               FAILED ( "WRONG VALUE FOR NOINTEGER'FIRST" );
+          END IF;
+          IF NOINTEGER'LAST /= -7 THEN
+               FAILED ( "WRONG VALUE FOR NOINTEGER'LAST" );
+          END IF;
+
+          IF INT'FIRST /= -6 THEN
+               FAILED ( "WRONG VALUE FOR INT'FIRST" );
+          END IF;
+          IF INT'LAST /= 6 THEN
+               FAILED ( "WRONG VALUE FOR INT'LAST" );
+          END IF;
+
+          IF SINT'FIRST /= -4 THEN
+               FAILED ( "WRONG VALUE FOR SINT'FIRST" );
+          END IF;
+          IF SINT'LAST /= 4 THEN
+               FAILED ( "WRONG VALUE FOR SINT'LAST" );
+          END IF;
+
+          IF NOINT'FIRST /= 1 THEN
+               FAILED ( "WRONG VALUE FOR NOINT'FIRST" );
+          END IF;
+          IF NOINT'LAST /= -1 THEN
+               FAILED ( "WRONG VALUE FOR NOINT'LAST" );
+          END IF;
+
+          IF NEWINT'FIRST /= -9 THEN
+               FAILED ( "WRONG VALUE FOR NEWINT'FIRST" );
+          END IF;
+          IF NEWINT'LAST /= -2 THEN
+               FAILED ( "WRONG VALUE FOR NEWINT'LAST" );
+          END IF;
+
+          IF SNEWINT'FIRST /= -7 THEN
+               FAILED ( "WRONG VALUE FOR SNEWINT'FIRST" );
+          END IF;
+          IF SNEWINT'LAST /= -5 THEN
+               FAILED ( "WRONG VALUE FOR SNEWINT'LAST" );
+          END IF;
+
+          IF NONEWINT'FIRST /= 3 THEN
+               FAILED ( "WRONG VALUE FOR NONEWINT'FIRST" );
+          END IF;
+          IF NONEWINT'LAST /= -15 THEN
+               FAILED ( "WRONG VALUE FOR NONEWINT'LAST" );
+          END IF;
+     END;
+
+     RESULT;
+END C35503O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503p.ada
new file mode 100644
index 000000000..28ecac33b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35503p.ada
@@ -0,0 +1,113 @@
+-- C35503P.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 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
+--     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ARGUMENT IS AN
+--     INTEGER TYPE.
+
+-- HISTORY:
+--     RJW 03/24/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35503P IS
+
+BEGIN
+     TEST ("C35503P", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                      "GENERIC FORMAL DISCRETE TYPE WHOSE ARGUMENT " &
+                      "IS AN INTEGER TYPE" );
+
+
+     DECLARE
+
+          TYPE INT IS RANGE -6 .. 6;
+          SUBTYPE SINT IS INT RANGE INT(IDENT_INT(-4)) ..
+                                                     INT(IDENT_INT(4));
+          SUBTYPE NOINT IS INT RANGE INT(IDENT_INT(1)) ..
+                                                    INT(IDENT_INT(-1));
+
+          GENERIC
+               TYPE I IS (<>);
+               F, L : I;
+          PROCEDURE P ( STR : STRING );
+
+          PROCEDURE P ( STR : STRING ) IS
+          BEGIN
+               IF I'FIRST /= F THEN
+                    FAILED ( "INCORRECT 'FIRST' FOR " & STR );
+               END IF;
+               IF I'LAST /= L THEN
+                    FAILED ( "INCORRECT 'LAST' FOR " & STR );
+               END IF;
+          END P;
+
+          GENERIC
+               TYPE I IS (<>);
+               F, L : I;
+          PROCEDURE Q;
+
+          PROCEDURE Q IS
+               SUBTYPE SI IS I;
+          BEGIN
+               IF SI'FIRST /= F THEN
+                    FAILED ( "INCORRECT VALUE FOR INTEGER'FIRST" );
+               END IF;
+               IF SI'LAST /= L THEN
+                    FAILED ( "INCORRECT VALUE FOR INTEGER'LAST" );
+               END IF;
+          END Q;
+
+          GENERIC
+               TYPE I IS (<>);
+          PROCEDURE R;
+
+          PROCEDURE R IS
+               SUBTYPE SI IS I;
+          BEGIN
+               IF SI'FIRST /= SI'VAL (IDENT_INT(1)) THEN
+                    FAILED ( "INCORRECT VALUE FOR NOINT'FIRST" );
+               END IF;
+               IF SI'LAST /= SI'VAL (IDENT_INT(-1)) THEN
+                    FAILED ( "INCORRECT VALUE FOR NOINT'LAST" );
+               END IF;
+          END R;
+
+          PROCEDURE P1 IS NEW P ( I => INT, F => -6, L => 6 );
+          PROCEDURE P2 IS NEW P ( I => SINT, F => -4, L => 4 );
+          PROCEDURE Q1 IS NEW Q
+               ( I => INTEGER, F => INTEGER'FIRST, L => INTEGER'LAST );
+          PROCEDURE R1 IS NEW R ( I => NOINT);
+
+     BEGIN
+          P1 ( "INT" );
+          P2 ( "SINT" );
+          Q1;
+          R1;
+     END;
+
+     RESULT;
+END C35503P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35504a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35504a.ada
new file mode 100644
index 000000000..6c2c59a1d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35504a.ada
@@ -0,0 +1,63 @@
+-- C35504A.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 NOT RAISED WHEN THE USER-DEFINED 
+-- ENUMERATION ARGUMENT TO 'SUCC, 'PRED, 'POS, 'VAL, 'IMAGE, AND 'VALUE
+-- IS NOT IN THE ATTRIBUTED SUBTYPE'S RANGE CONSTRAINT.
+
+-- DAT 3/18/81
+-- SPS 01/13/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35504A IS
+
+     TYPE E IS (A, 'A', B, 'B', C, 'C', D, 'D', XYZ);
+
+     SUBTYPE S IS E RANGE B .. C;
+
+BEGIN
+     TEST ("C35504A", "CONSTRAINT_ERROR IS NOT RAISED IN T'SUCC(X),"
+          & " T'PRED(X), T'POS(X), T'VAL(X), T'IMAGE(X), AND"
+          & " T'VALUE(X) WHEN THE VALUES ARE NOT WITHIN T'S"
+          & " RANGE CONSTRAINT, FOR USER-DEFINED ENUMERATION TYPES");
+
+     BEGIN
+          FOR X IN E LOOP
+               IF (X /= A AND THEN S'SUCC(S'PRED(X)) /= X)
+               OR (X /= XYZ AND THEN S'PRED(S'SUCC(X)) /= X)
+               OR S'VAL(S'POS(X)) /= X
+               OR S'VALUE(S'IMAGE(X)) /= X
+               THEN
+                    FAILED ("WRONG ATTRIBUTE VALUE");
+               END IF;
+          END LOOP;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR RAISED"
+                    & " WHEN IT SHOULDN'T HAVE BEEN");
+          WHEN OTHERS => FAILED ("INCORRECT EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C35504A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35504b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35504b.ada
new file mode 100644
index 000000000..644b1d643
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35504b.ada
@@ -0,0 +1,85 @@
+-- C35504B.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 NOT RAISED FOR I'SUCC, I'PRED,
+-- I'POS, I'VAL, I'IMAGE, AND I'VALUE FOR INTEGER ARGUMENTS
+-- OUTSIDE THE RANGE OF I.
+
+-- DAT 3/30/81
+-- SPS 01/13/83
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE C35504B IS
+
+     SUBTYPE I IS INTEGER RANGE 0 .. 0;
+
+BEGIN
+     TEST ("C35504B", "CONSTRAINT_ERROR IS NOT RAISED FOR"
+          & " INTEGER SUBTYPE ATTRIBUTES 'SUCC, 'PRED, 'POS, 'VAL,"
+          & " 'IMAGE, AND 'VALUE WHOSE ARGUMENTS ARE OUTSIDE THE"
+          & " SUBTYPE");
+
+     BEGIN
+          IF I'SUCC(-1) /= I'PRED(1)
+          THEN
+               FAILED ("WRONG ATTRIBUTE VALUE - 1");
+          END IF;
+
+          IF I'SUCC (100) /= 101
+          THEN
+               FAILED ("WRONG ATTRIBUTE VALUE - 2");
+          END IF;
+
+          IF I'PRED (100) /= 99
+          THEN
+               FAILED ("WRONG ATTRIBUTE VALUE - 3");
+          END IF;
+
+          IF I'POS (-100) /= -100
+          THEN
+               FAILED ("WRONG ATTRIBUTE VALUE - 4");
+          END IF;
+
+          IF I'VAL(-100) /= -100
+          THEN
+               FAILED ("WRONG ATTRIBUTE VALUE - 5");
+          END IF;
+
+          IF I'IMAGE(1234) /= " 1234"
+          THEN
+               FAILED ("WRONG ATTRIBUTE VALUE - 6");
+          END IF;
+
+          IF I'VALUE("999") /= 999
+          THEN
+               FAILED ("WRONG ATTRIBUTE VALUE - 7");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C35504B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35505c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35505c.ada
new file mode 100644
index 000000000..52bf7f211
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35505c.ada
@@ -0,0 +1,102 @@
+-- C35505C.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 CONSTRAINT_ERROR IS RAISED FOR 'SUCC' AND 'PRED',
+--     IF THE RETURNED VALUES WOULD BE OUTSIDE OF THE BASE TYPE,
+--     WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT
+--     IS A USER-DEFINED ENUMERATION TYPE.
+
+-- HISTORY:
+--     RJW 06/05/86  CREATED ORIGINAL TEST.
+--     VCL 08/19/87  REMOVED THE FUNCTION 'IDENT' IN THE GENERIC
+--                   PROCEDURE 'P' AND REPLACED ALL CALLS TO 'IDENT'
+--                   WITH "T'VAL(IDENT_INT(T'POS(...)))".
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35505C IS
+
+     TYPE B IS ('Z', 'X', Z, X);
+
+     SUBTYPE C IS B RANGE 'X' .. Z;
+
+BEGIN
+     TEST ( "C35505C", "CHECK THAT 'SUCC' AND 'PRED' RAISE " &
+                       "CONSTRAINT_ERROR APPROPRIATELY WHEN THE " &
+                       "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                       "ARGUMENT IS A USER-DEFINED ENUMERATION TYPE" );
+
+     DECLARE
+          GENERIC
+               TYPE T IS (<>);
+               STR : STRING;
+          PROCEDURE P;
+
+          PROCEDURE P IS
+
+          BEGIN
+               BEGIN
+                    IF T'PRED (T'VAL (IDENT_INT (T'POS
+                              (T'BASE'FIRST)))) = T'FIRST THEN
+                         FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                   STR & "'PRED -  1" );
+                    ELSE
+                         FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                   STR & "'PRED -  2" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                   STR & "'PRED - 1" );
+               END;
+
+               BEGIN
+                    IF T'SUCC (T'VAL (IDENT_INT (T'POS
+                              (T'BASE'LAST)))) = T'LAST THEN
+                         FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                   STR & "'SUCC -  1" );
+                    ELSE
+                         FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                   STR & "'SUCC -  2" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                   STR & "'SUCC - 1" );
+               END;
+          END P;
+
+          PROCEDURE PB IS NEW P (B, "B");
+          PROCEDURE PC IS NEW P (C, "C");
+     BEGIN
+          PB;
+          PC;
+     END;
+RESULT;
+END C35505C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35505e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35505e.ada
new file mode 100644
index 000000000..0da82dae9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35505e.ada
@@ -0,0 +1,144 @@
+-- C35505E.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 CONSTRAINT_ERROR IS RAISED FOR 'SUCC' AND 'PRED',
+--     IF THE RESULT WOULD BE OUTSIDE THE RANGE OF THE BASE TYPE,
+--     WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL ARGUMENT
+--     IS TYPE CHARACTER OR A SUBTYPE OF TYPE CHARACTER.
+
+-- HISTORY:
+--     DWC 07/01/87
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35505E IS
+
+     TYPE CHAR IS ('A', B, C);
+     SUBTYPE NEWCHAR IS CHAR;
+
+BEGIN
+     TEST ( "C35505E", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                       "'SUCC' AND 'PRED', IF THE RESULT WOULD BE " &
+                       "OUTSIDE THE RANGE OF THE BASE TYPE, WHEN " &
+                       "THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                       "ACTUAL ARGUMENT IS A CHARACTER TYPE ");
+
+     DECLARE
+          GENERIC
+               TYPE SUBCH IS (<>);
+               STR : STRING;
+               I1, I2 : INTEGER;
+          PROCEDURE P;
+
+          PROCEDURE P IS
+
+               FUNCTION IDENT (C : SUBCH) RETURN SUBCH IS
+               BEGIN
+                    RETURN SUBCH'VAL (IDENT_INT (SUBCH'POS (C)));
+               END IDENT;
+
+          BEGIN
+               BEGIN
+                    IF SUBCH'PRED (SUBCH'BASE'FIRST) = SUBCH'VAL (0)
+                         THEN
+                         FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                   STR & "'PRED -  1" );
+                    ELSE
+                         FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                   STR & "'PRED -  2" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                   STR & "'PRED - 1" );
+               END;
+
+               BEGIN
+                    IF SUBCH'SUCC (SUBCH'BASE'LAST) = SUBCH'VAL (0) THEN
+                         FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                   STR & "'SUCC -  1" );
+                    ELSE
+                         FAILED ( "CONSTRAINT_ERROR NOT RAISED FOR " &
+                                   STR & "'SUCC -  2" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                   STR & "'SUCC - 1" );
+               END;
+
+               BEGIN
+                    IF SUBCH'PRED (IDENT (SUBCH'BASE'FIRST)) =
+                       SUBCH'VAL (I1) THEN
+                         FAILED ( "NO EXCEPTION RAISED " &
+                                  "FOR " & STR & "'PRED " &
+                                  "(IDENT (SUBCH'BASE'FIRST)) - 1" );
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED " &
+                                  "FOR " & STR & "'PRED " &
+                                  "(IDENT (SUBCH'BASE'FIRST)) - 2" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED " &
+                                  "FOR " & STR & "'PRED " &
+                                  "(IDENT (SUBCH'BASE'FIRST))" );
+               END;
+
+               BEGIN
+                    IF SUBCH'SUCC (IDENT(SUBCH'BASE'LAST)) =
+                       SUBCH'VAL (I2) THEN
+                         FAILED ( "NO EXCEPTION RAISED " &
+                                  "FOR " & STR & "'SUCC " &
+                                  "(IDENT (SUBCH'BASE'LAST)) - 1" );
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED " &
+                                  "FOR " & STR & "'SUCC " &
+                                  "(IDENT (SUBCH'BASE'LAST)) - 2" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED " &
+                                  "FOR " & STR & "'SUCC " &
+                                  "(IDENT (SUBCH'BASE'LAST))" );
+               END;
+          END P;
+
+          PROCEDURE PCHAR  IS NEW P (CHAR, "CHAR", 0, 1);
+          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 0, 1);
+     BEGIN
+          PCHAR;
+          PNCHAR;
+     END;
+RESULT;
+END C35505E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35505f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35505f.ada
new file mode 100644
index 000000000..b8d4acc1b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35505f.ada
@@ -0,0 +1,164 @@
+-- C35505F.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 CONSTRAINT ERROR IS RAISED BY THE ATTRIBUTES
+--     'PRED' AND 'SUCC' WHEN THE PREFIX IS A CHARACTER TYPE
+--     AND THE RESULT IS OUTSIDE OF THE BASE TYPE.
+
+-- HISTORY:
+--     JET 08/18/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35505F  IS
+
+     TYPE CHAR IS ('A', B);
+
+     TYPE NEWCHAR IS NEW CHAR;
+
+     FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+     BEGIN
+          RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
+     END;
+
+     FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+     BEGIN
+          RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
+     END;
+
+BEGIN
+
+     TEST( "C35505F" , "CHECK THAT CONSTRAINT ERROR IS RAISED BY " &
+                       "THE ATTRIBUTES 'PRED' AND 'SUCC' WHEN THE " &
+                       "PREFIX IS A CHARACTER TYPE AND THE RESULT " &
+                       "IS OUTSIDE OF THE BASE TYPE" );
+
+     BEGIN
+          IF CHAR'PRED (IDENT ('A')) = 'A' THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHAR'PRED (IDENT ('A')) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHAR'PRED (IDENT ('A')) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHAR'PRED (IDENT ('A'))" );
+     END;
+
+     BEGIN
+          IF CHAR'SUCC (IDENT (B)) = B THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHAR'SUCC (IDENT (B)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHAR'SUCC (IDENT (B)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHAR'SUCC (IDENT (B))" );
+     END;
+
+     BEGIN
+          IF NEWCHAR'PRED (IDENT ('A')) = 'A' THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR NEWCHAR'PRED (IDENT ('A')) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR NEWCHAR'PRED (IDENT ('A')) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR NEWCHAR'PRED (IDENT ('A'))" );
+     END;
+
+     BEGIN
+          IF NEWCHAR'SUCC (IDENT (B)) = 'A' THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR NEWCHAR'SUCC (IDENT (B)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR NEWCHAR'SUCC (IDENT (B)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR NEWCHAR'SUCC (IDENT (B))" );
+     END;
+
+     BEGIN
+          IF CHARACTER'PRED (IDENT_CHAR (CHARACTER'BASE'FIRST)) = 'A'
+             THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHARACTER'PRED " &
+                        "(IDENT_CHAR (CHARACTER'BASE'FIRST)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHARACTER'PRED " &
+                        "(IDENT_CHAR (CHARACTER'BASE'FIRST)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'PRED " &
+                        "(IDENT_CHAR (CHARACTER'BASE'FIRST))" );
+     END;
+
+     BEGIN
+          IF CHARACTER'SUCC (IDENT_CHAR (CHARACTER'BASE'LAST)) = 'Z'
+             THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHARACTER'SUCC " &
+                        "(IDENT_CHAR (CHARACTER'BASE'LAST)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHARACTER'SUCC " &
+                        "(IDENT_CHAR (CHARACTER'BASE'LAST)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'SUCC " &
+                        "(IDENT_CHAR (CHARACTER'BASE'LAST))" );
+     END;
+
+     RESULT;
+
+END C35505F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507a.ada
new file mode 100644
index 000000000..0a6776560
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507a.ada
@@ -0,0 +1,88 @@
+-- C35507A.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 ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
+-- WHEN THE PREFIX IS A CHARACTER TYPE.   
+
+-- RJW 5/29/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507A  IS
+
+BEGIN
+
+     TEST( "C35507A" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                       "THE CORRECT RESULTS WHEN THE PREFIX " &
+                       "IS A CHARACTER TYPE" );
+
+     DECLARE
+          TYPE CHAR1 IS (A, 'A');
+
+          SUBTYPE CHAR2 IS CHARACTER RANGE 'A' .. 'Z';
+
+          SUBTYPE NOCHAR IS CHARACTER RANGE 'Z' .. 'A';
+          
+          TYPE NEWCHAR IS NEW CHARACTER 
+                    RANGE 'A' .. 'Z';
+
+     BEGIN
+          IF CHAR1'WIDTH /= 3 THEN
+               FAILED( "INCORRECT WIDTH FOR CHAR1" );
+          END IF;
+
+          IF CHAR2'WIDTH /= 3 THEN
+               FAILED( "INCORRECT WIDTH FOR CHAR2" );
+          END IF;
+
+          IF NEWCHAR'WIDTH /= 3 THEN
+               FAILED( "INCORRECT WIDTH FOR NEWCHAR" );
+          END IF;
+
+          IF NOCHAR'WIDTH /= 0 THEN
+               FAILED( "INCORRECT WIDTH FOR NOCHAR" );
+          END IF;
+     END;
+
+     DECLARE
+          SUBTYPE NONGRAPH IS CHARACTER 
+                    RANGE CHARACTER'VAL (0) .. CHARACTER'VAL (31);
+
+          MAX : INTEGER := 0;
+
+     BEGIN
+          FOR CH IN NONGRAPH
+               LOOP
+                    IF CHARACTER'IMAGE (CH)'LENGTH > MAX THEN
+                         MAX := CHARACTER'IMAGE (CH)'LENGTH;
+                    END IF;
+          END LOOP;
+          
+          IF NONGRAPH'WIDTH /= MAX THEN
+               FAILED ( "INCORRECT WIDTH FOR NONGRAPH" );
+          END IF;
+     END;                    
+
+     RESULT;
+END C35507A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507b.ada
new file mode 100644
index 000000000..b50c4c0dc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507b.ada
@@ -0,0 +1,96 @@
+-- C35507B.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 ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS 
+-- WHEN THE PREFIX IS FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS
+-- A CHARACTER TYPE.   
+
+-- RJW 5/29/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507B  IS
+
+     GENERIC
+          TYPE CH IS (<>);
+     PROCEDURE P ( STR : STRING; W : INTEGER );
+
+     PROCEDURE P ( STR : STRING; W : INTEGER ) IS
+
+          SUBTYPE NOCHAR IS CH RANGE CH'VAL (1) .. CH'VAL(0);
+     BEGIN
+          IF CH'WIDTH /= W THEN
+               FAILED( "INCORRECT WIDTH FOR " & STR );
+          END IF;
+     
+          IF NOCHAR'WIDTH /= 0 THEN
+               FAILED( "INCORRECT WIDTH FOR NOCHAR WITH " & STR );
+          END IF;
+     END P;
+
+
+BEGIN
+
+     TEST( "C35507B" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                       "THE CORRECT RESULTS WHEN THE PREFIX " &
+                       "IS A FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                       "PARAMETER IS A CHARACTER TYPE" );
+
+     DECLARE
+          TYPE CHAR1 IS (A, 'A');
+
+          SUBTYPE CHAR2 IS CHARACTER RANGE 'A' .. 'Z';
+          
+          TYPE NEWCHAR IS NEW CHARACTER 
+                    RANGE 'A' .. 'Z';
+
+          PROCEDURE P1 IS NEW P (CHAR1);
+          PROCEDURE P2 IS NEW P (CHAR2);
+          PROCEDURE P3 IS NEW P (NEWCHAR);
+     BEGIN
+          P1 ("CHAR1", 3);
+          P2 ("CHAR2", 3);
+          P3 ("NEWCHAR", 3);
+     END;
+
+     DECLARE
+          SUBTYPE NONGRAPH IS CHARACTER 
+                    RANGE CHARACTER'VAL (0) .. CHARACTER'VAL (31);
+
+          MAX : INTEGER := 0;
+
+          PROCEDURE PN IS NEW P (NONGRAPH);
+     BEGIN
+          FOR CH IN NONGRAPH
+               LOOP
+                    IF CHARACTER'IMAGE (CH)'LENGTH > MAX THEN
+                         MAX := CHARACTER'IMAGE (CH)'LENGTH;
+                    END IF;
+          END LOOP;
+          
+          PN ("NONGRAPH", MAX);
+     END;                    
+
+     RESULT;
+END C35507B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507c.ada
new file mode 100644
index 000000000..386e5a36f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507c.ada
@@ -0,0 +1,360 @@
+-- C35507C.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 ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT
+--     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
+--     SUBTESTS ARE:
+--         (A). TESTS FOR IMAGE.
+--         (B). TESTS FOR VALUE.
+
+-- HISTORY:
+--     RJW 05/29/86  CREATED ORIGINAL TEST.
+--     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.
+--                   CORRECTED ERROR MESSAGES AND ADDED CALLS TO
+--                   IDENT_STR.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507C  IS
+
+     TYPE CHAR IS ('A', 'a');
+
+     TYPE NEWCHAR IS NEW CHAR;
+
+     FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+     BEGIN
+          RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
+     END IDENT;
+
+     FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+     BEGIN
+          RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
+     END IDENT;
+
+     PROCEDURE CHECK_BOUND (STR1, STR2 : STRING) IS
+     BEGIN
+          IF STR1'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 &
+                        "'IMAGE ('" & STR1 & "')" );
+          END IF;
+     END CHECK_BOUND;
+
+BEGIN
+
+     TEST( "C35507C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
+                       "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A CHARACTER TYPE" );
+
+     BEGIN  -- (A).
+          IF CHAR'IMAGE ('A') /= "'A'" THEN
+               FAILED ( "INCORRECT IMAGE FOR CHAR'('A')" );
+          END IF;
+
+          CHECK_BOUND (CHAR'IMAGE ('A'), "CHAR");
+
+          IF CHAR'IMAGE ('a') /= "'a'" THEN
+               FAILED ( "INCORRECT IMAGE FOR CHAR'('a')" );
+          END IF;
+
+          CHECK_BOUND (CHAR'IMAGE ('a'), "CHAR");
+
+          IF NEWCHAR'IMAGE ('A') /= "'A'" THEN
+               FAILED ( "INCORRECT IMAGE FOR NEWCHAR'('A')" );
+          END IF;
+
+          CHECK_BOUND (NEWCHAR'IMAGE ('A'), "NEWCHAR");
+
+          IF NEWCHAR'IMAGE ('a') /= "'a'" THEN
+               FAILED ( "INCORRECT IMAGE FOR NEWCHAR'('a')" );
+          END IF;
+
+          CHECK_BOUND (NEWCHAR'IMAGE ('a'), "NEWCHAR");
+
+          IF CHAR'IMAGE (IDENT ('A')) /= "'A'" THEN
+               FAILED ( "INCORRECT IMAGE FOR CHAR'( IDENT ('A'))" );
+          END IF;
+
+          CHECK_BOUND (CHAR'IMAGE (IDENT ('A')), "IDENT OF CHAR");
+
+          IF CHAR'IMAGE (IDENT ('a')) /= "'a'" THEN
+               FAILED ( "INCORRECT IMAGE FOR CHAR'( IDENT ('a'))" );
+          END IF;
+
+          CHECK_BOUND (CHAR'IMAGE (IDENT ('a')), "IDENT OF CHAR");
+
+          IF NEWCHAR'IMAGE (IDENT ('A')) /= "'A'" THEN
+               FAILED ( "INCORRECT IMAGE FOR NEWCHAR'( IDENT ('A'))" );
+          END IF;
+
+          CHECK_BOUND (NEWCHAR'IMAGE (IDENT ('A')), "IDENT OF NEWCHAR");
+
+          IF NEWCHAR'IMAGE (IDENT ('a')) /= "'a'" THEN
+               FAILED ( "INCORRECT IMAGE FOR NEWCHAR'( IDENT ('a'))" );
+          END IF;
+
+          CHECK_BOUND (NEWCHAR'IMAGE (IDENT ('a')), "IDENT OF NEWCHAR");
+
+          FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
+               IF CHARACTER'IMAGE (CH) /= ("'" & CH) & "'" THEN
+                    FAILED ( "INCORRECT IMAGE FOR CHARACTER'(" &
+                              CH & ")" );
+               END IF;
+
+               CHECK_BOUND (CHARACTER'IMAGE (CH), "CHARACTER");
+
+          END LOOP;
+
+          FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
+               CHECK_BOUND (CHARACTER'IMAGE (CH), "CHARACTER");
+          END LOOP;
+
+          CHECK_BOUND (CHARACTER'IMAGE (CHARACTER'VAL (127)),
+                       "CHARACTER");
+
+     END;
+
+     ---------------------------------------------------------------
+
+     DECLARE -- (B).
+
+          SUBTYPE SUBCHAR IS CHARACTER
+               RANGE CHARACTER'VAL (127) .. CHARACTER'VAL (127);
+     BEGIN
+          FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
+               IF SUBCHAR'VALUE (("'" & CH) & "'") /= CH THEN
+                    FAILED ( "INCORRECT SUBCHAR'VALUE FOR " & CH );
+               END IF;
+          END LOOP;
+
+          FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
+               IF SUBCHAR'VALUE (CHARACTER'IMAGE (CH)) /= CH THEN
+                    FAILED ( "INCORRECT SUBCHAR'VALUE FOR " &
+                              CHARACTER'IMAGE (CH) );
+               END IF;
+          END LOOP;
+
+          IF SUBCHAR'VALUE (CHARACTER'IMAGE (CHARACTER'VAL (127))) /=
+             CHARACTER'VAL (127) THEN
+               FAILED ( "INCORRECT SUBCHAR'VALUE FOR " &
+                        "CHARACTER'VAL (127)" );
+          END IF;
+     END;
+
+     BEGIN
+          IF CHAR'VALUE ("'A'") /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'(""'A'"")" );
+          END IF;
+
+          IF CHAR'VALUE ("'a'") /= 'a' THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'(""'a'"")" );
+          END IF;
+
+          IF NEWCHAR'VALUE ("'A'") /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'(""'A'"")" );
+          END IF;
+
+          IF NEWCHAR'VALUE ("'a'") /= 'a' THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'(""'a'"")" );
+          END IF;
+     END;
+
+     BEGIN
+          IF CHAR'VALUE (IDENT_STR("'A'")) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'(IDENT_STR" &
+                        "(""'A'""))" );
+          END IF;
+
+          IF CHAR'VALUE (IDENT_STR("'a'")) /= 'a' THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'(IDENT_STR" &
+                        "(""'a'""))" );
+          END IF;
+
+          IF NEWCHAR'VALUE (IDENT_STR("'A'")) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'(IDENT_STR" &
+                        "(""'A'""))" );
+          END IF;
+
+          IF NEWCHAR'VALUE (IDENT_STR("'a'")) /= 'a' THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'(IDENT_STR" &
+                        "(""'a'""))" );
+          END IF;
+     END;
+
+     BEGIN
+          IF CHAR'VALUE (IDENT_STR ("'B'")) = 'A' THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHAR'VALUE (IDENT_STR (""'B'"")) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHAR'VALUE (IDENT_STR (""'B'"")) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHAR'VALUE (IDENT_STR (""'B'""))" );
+     END;
+
+     BEGIN
+          IF CHARACTER'VALUE (IDENT_CHAR (ASCII.HT) & "'A'") = 'A' THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE " &
+                        "(IDENT_CHAR (ASCII.HT) & ""'A'"") - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE " &
+                        "(IDENT_CHAR (ASCII.HT) & ""'A'"") - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'VALUE " &
+                        "(IDENT_CHAR (ASCII.HT) & ""'A'"")" );
+     END;
+
+     BEGIN
+          IF CHARACTER'VALUE ("'B'" & IDENT_CHAR (ASCII.HT)) = 'B' THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (""'B'"" & " &
+                        "IDENT_CHAR (ASCII.HT)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (""'B'"" & " &
+                        "IDENT_CHAR (ASCII.HT)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'VALUE (""'B'"" & " &
+                        "IDENT_CHAR (ASCII.HT)) " );
+     END;
+
+     BEGIN
+          IF CHARACTER'VALUE ("'C'" & IDENT_CHAR (ASCII.BEL)) = 'C'
+             THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (""'C'"" & " &
+                        "IDENT_CHAR (ASCII.BEL)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (""'C'"" & " &
+                        "IDENT_CHAR (ASCII.BEL)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'VALUE (""'C'"" & " &
+                        "IDENT_CHAR (ASCII.BEL))" );
+     END;
+
+     BEGIN
+          IF CHARACTER'VALUE (IDENT_STR ("'")) = ''' THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (IDENT_STR (""'"")) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (IDENT_STR (""'"")) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'VALUE (IDENT_STR (""'""))" );
+     END;
+
+     BEGIN
+          IF CHARACTER'VALUE (IDENT_STR ("''")) = ''' THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (IDENT_STR (""''"")) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (IDENT_STR (""''"")) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'VALUE (IDENT_STR (""''""))" );
+     END;
+
+     BEGIN
+          IF CHARACTER'VALUE (IDENT_STR ("'A")) = 'A' THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (IDENT_STR (""'A"")) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (IDENT_STR (""'A"")) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'VALUE IDENT_STR (""'A""))" );
+     END;
+
+     BEGIN
+          IF CHARACTER'VALUE (IDENT_STR ("A'")) = 'A' THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (IDENT_STR (""A'"")) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (IDENT_STR (""A'"")) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'VALUE (IDENT_STR (""A'""))" );
+     END;
+
+     BEGIN
+          IF CHARACTER'VALUE (IDENT_STR ("'AB'")) = 'A' THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (IDENT_STR (""'AB'"")) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHARACTER'VALUE (IDENT_STR (""'AB'"")) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'VALUE IDENT_STR (""'AB'""))" );
+     END;
+
+     RESULT;
+END C35507C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507e.ada
new file mode 100644
index 000000000..93979902c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507e.ada
@@ -0,0 +1,194 @@
+-- C35507E.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 ATTRIBUTES 'IMAGE' AND 'VALUE YIELD THE CORRECT
+--     RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+--     PARAMETER IS A CHARACTER TYPE.
+--     SUBTESTS ARE:
+--         (A). TESTS FOR IMAGE.
+--         (B). TESTS FOR VALUE.
+
+-- HISTORY:
+--     RJW  05/29/86  CREATED ORIGINAL TEST.
+--     VCL  10/23/87  MODIFIED THIS HEADER, CHANGED THE CALLS TO
+--                    PROCEDURE 'PCH', IN THE SECOND PART OF SUBTEST B,
+--                    TO INCLUDE ANOTHER CALL TO PROCEDURE 'PCHAR' AND
+--                    CALLS TO PROCEDURE 'PNCHAR'.
+
+WITH REPORT; USE REPORT;
+PROCEDURE  C35507E  IS
+
+     TYPE CHAR IS ('A', 'a');
+
+     TYPE NEWCHAR IS NEW CHAR;
+
+     PROCEDURE CHECK_LOWER_BOUND (STR1, STR2 : STRING) IS
+     BEGIN
+          IF STR1'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 & "'(" &
+                        STR1 & ")" );
+          END IF;
+     END CHECK_LOWER_BOUND;
+
+BEGIN
+
+     TEST( "C35507E" , "THE ATTRIBUTES 'IMAGE' AND " &
+                       "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                       "ACTUAL PARAMETER IS A CHARACTER TYPE" );
+
+     DECLARE -- (A).
+          GENERIC
+               TYPE CHTYPE IS (<>);
+               STR1 : STRING;
+          PROCEDURE P (CH : CHTYPE; STR2 : STRING);
+
+          PROCEDURE P (CH : CHTYPE; STR2 : STRING) IS
+               SUBTYPE SUBCH IS CHTYPE;
+          BEGIN
+               IF SUBCH'IMAGE (CH) /= STR2 THEN
+                    FAILED ( "INCORRECT IMAGE FOR " & STR1 & "'(" &
+                              STR2 & ")" );
+               END IF;
+
+               CHECK_LOWER_BOUND (SUBCH'IMAGE (CH), STR1);
+          END P;
+
+          PROCEDURE PCHAR  IS NEW P (CHAR, "CHAR");
+          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
+          PROCEDURE PCH    IS NEW P (CHARACTER, "CHARACTER");
+
+     BEGIN
+          PCHAR ('A', "'A'");
+          PCHAR ('a', "'a'");
+          PNCHAR ('A', "'A'");
+          PNCHAR ('a', "'a'");
+
+          FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP
+               PCH (CH, ("'" & CH) & "'" );
+          END LOOP;
+     END;
+
+     DECLARE
+
+          GENERIC
+               TYPE CHTYPE IS (<>);
+          PROCEDURE P (CH : CHTYPE; STR : STRING);
+
+          PROCEDURE P (CH : CHTYPE; STR : STRING) IS
+               SUBTYPE SUBCH IS CHTYPE;
+          BEGIN
+               CHECK_LOWER_BOUND (CHTYPE'IMAGE (CH), "CHARACTER");
+          END P;
+
+          PROCEDURE PN IS NEW P (CHARACTER);
+
+     BEGIN
+
+          FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
+               PN (CH, CHARACTER'IMAGE (CH));
+          END LOOP;
+
+          PN (ASCII.DEL, CHARACTER'IMAGE (ASCII.DEL));
+     END;
+
+     ---------------------------------------------------------------
+
+     DECLARE -- (B).
+
+          GENERIC
+               TYPE CHTYPE IS (<>);
+               STR1 : STRING;
+          PROCEDURE P (STR2 : STRING; CH : CHTYPE);
+
+          PROCEDURE P (STR2 : STRING; CH : CHTYPE) IS
+               SUBTYPE SUBCH IS CHTYPE;
+          BEGIN
+               IF SUBCH'VALUE (STR2) /= CH THEN
+                    FAILED ( "INCORRECT " & STR1 & "'VALUE FOR " &
+                              STR2 );
+               END IF;
+          END P;
+
+          PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER");
+          PROCEDURE PCHAR IS NEW P (CHAR, "CHAR");
+          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
+
+     BEGIN
+          FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP
+                PCH (CHARACTER'IMAGE (CH), CH );
+          END LOOP;
+
+          PCH (CHARACTER'IMAGE (CHARACTER'VAL (127)),
+               CHARACTER'VAL (127));
+
+          PCHAR ("'A'", 'A');
+          PCHAR ("'a'", 'a' );
+          PNCHAR ("'A'", 'A');
+          PNCHAR ("'a'", 'a');
+     END;
+
+     DECLARE
+          GENERIC
+               TYPE CHTYPE IS (<>);
+               STR1 : STRING;
+          PROCEDURE P (STR2 : STRING);
+
+          PROCEDURE P (STR2 : STRING) IS
+               SUBTYPE SUBCH IS CHTYPE;
+          BEGIN
+               IF SUBCH'VALUE (STR2) = SUBCH'VAL (0) THEN
+                    FAILED ( "NO EXCEPTION RAISED FOR " &
+                              STR1 & "'VALUE (" & STR2 & ") - 1" );
+               ELSE
+                    FAILED ( "NO EXCEPTION RAISED FOR " &
+                              STR1 & "'VALUE (" & STR2 & ") - 2" );
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED " &
+                             "FOR " & STR1 & "'VALUE (" & STR2 & ")" );
+          END P;
+
+          PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER");
+          PROCEDURE PCHAR IS NEW P (CHAR, "CHAR");
+          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");
+
+     BEGIN
+          PCHAR ("'B'");
+          PCH (ASCII.HT & "'A'");
+          PCH ("'B'" & ASCII.HT);
+          PCH ("'C'" & ASCII.BEL);
+          PCH ("'");
+          PNCHAR ("''");
+          PCHAR ("'A");
+          PNCHAR ("A'");
+          PCH ("'AB'");
+     END;
+
+     RESULT;
+END C35507E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507g.ada
new file mode 100644
index 000000000..a1d8ecec4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507g.ada
@@ -0,0 +1,96 @@
+-- C35507G.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 ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
+--     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
+
+-- HISTORY:
+--     RJW 06/03/86  CREATED ORIGINAL TEST.
+--     JET 08/13/87  REMOVED TESTS INTENDED FOR C35505F.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507G  IS
+
+     TYPE CHAR IS ('A', B);
+
+     TYPE NEWCHAR IS NEW CHAR;
+
+     FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+     BEGIN
+          RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
+     END;
+
+     FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+     BEGIN
+          RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
+     END;
+
+BEGIN
+
+     TEST( "C35507G" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
+                       "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A CHARACTER TYPE" );
+
+     BEGIN
+          IF CHAR'SUCC ('A') /= B THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'SUCC('A')" );
+          END IF;
+
+          IF CHAR'PRED (IDENT (B)) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'PRED (IDENT (B))" );
+          END IF;
+     END;
+
+     BEGIN
+          IF NEWCHAR'SUCC (IDENT ('A')) /= B THEN
+               FAILED ( "INCORRECT VALUE FOR " &
+                        "IDENT (NEWCHAR'SUCC('A'))" );
+          END IF;
+
+          IF NEWCHAR'PRED (B) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'PRED(B)" );
+          END IF;
+     END;
+
+     FOR CH IN CHARACTER'VAL (1) .. CHARACTER'VAL (127) LOOP
+          IF CHARACTER'PRED (CH) /=
+             CHARACTER'VAL (CHARACTER'POS (CH) - 1) THEN
+               FAILED ( "INCORRECT VALUE FOR CHARACTER'PRED OF " &
+                         CHARACTER'IMAGE (CH) );
+          END IF;
+     END LOOP;
+
+     FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (126) LOOP
+          IF CHARACTER'SUCC (CH) /=
+             CHARACTER'VAL (CHARACTER'POS (CH) + 1) THEN
+               FAILED ( "INCORRECT VALUE FOR CHARACTER'SUCC OF " &
+                         CHARACTER'IMAGE (CH) );
+          END IF;
+     END LOOP;
+
+     RESULT;
+
+END C35507G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507h.ada
new file mode 100644
index 000000000..053b20c71
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507h.ada
@@ -0,0 +1,89 @@
+-- C35507H.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 'PRED' AND 'SUCC' YIELD THE CORRECT
+-- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+-- PARAMETER IS A CHARACTER TYPE.
+
+-- RJW 6/03/86
+-- DWC 7/01/87     -- ADDED THIRD VALUE TO CHAR TYPE.
+                   -- REMOVED SECTION OF CODE AND PLACED INTO
+                   -- C35505E.ADA.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507H  IS
+
+     TYPE CHAR IS ('A', B, C);
+
+     TYPE NEWCHAR IS NEW CHAR;
+
+BEGIN
+
+     TEST( "C35507H" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
+                       "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                       "ACTUAL PARAMETER IS A CHARACTER TYPE" );
+
+     DECLARE
+          GENERIC
+               TYPE CHTYPE IS (<>);
+               STR : STRING;
+               I1, I2 : INTEGER;
+          PROCEDURE P;
+
+          PROCEDURE P IS
+               SUBTYPE SUBCH IS CHTYPE
+                    RANGE CHTYPE'VAL (I1) .. CHTYPE'VAL (I2);
+
+          BEGIN
+               FOR CH IN SUBCH'VAL (I1 + 1) .. SUBCH'VAL (I2) LOOP
+                    IF SUBCH'PRED (CH) /=
+                       SUBCH'VAL (SUBCH'POS (CH) - 1) THEN
+                         FAILED ( "INCORRECT VALUE FOR " & STR &
+                                  "'PRED OF " & SUBCH'IMAGE (CH) );
+                    END IF;
+               END LOOP;
+
+               FOR CH IN SUBCH'VAL (I1) .. SUBCH'VAL (I2 - 1) LOOP
+                    IF SUBCH'SUCC (CH) /=
+                       SUBCH'VAL (SUBCH'POS (CH) + 1) THEN
+                         FAILED ( "INCORRECT VALUE FOR " & STR &
+                                  "'SUCC OF " & SUBCH'IMAGE (CH) );
+                    END IF;
+               END LOOP;
+
+          END P;
+
+          PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 0, 1);
+          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 0, 1);
+          PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER", 0, 127);
+     BEGIN
+          PCHAR;
+          PNCHAR;
+          PCH;
+     END;
+
+     RESULT;
+END C35507H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507i.ada
new file mode 100644
index 000000000..e2318d7b2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507i.ada
@@ -0,0 +1,84 @@
+-- C35507I.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 ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
+--     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE WITH AN ENUMERATION
+--     REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 06/03/86  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     DTN 11/26/91  DELETED CONSTRAINT_ERROR FOR ATTRIBUTES PRED AND
+--                   SUCC SUBTESTS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507I  IS
+
+     TYPE CHAR IS ('A', B);
+     FOR CHAR USE ('A' => 2, B => 5);
+
+     TYPE NEWCHAR IS NEW CHAR;
+
+     FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+     BEGIN
+          RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
+     END;
+
+     FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+     BEGIN
+          RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
+     END;
+
+BEGIN
+
+     TEST( "C35507I" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
+                       "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A CHARACTER TYPE WITH AN " &
+                       "ENUMERATION REPRESENTATION CLAUSE" );
+
+     BEGIN
+          IF CHAR'SUCC ('A') /= B THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'SUCC('A')" );
+          END IF;
+
+          IF CHAR'PRED (IDENT (B)) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'PRED (IDENT (B))" );
+          END IF;
+     END;
+
+     BEGIN
+          IF IDENT (NEWCHAR'SUCC ('A')) /= B THEN
+               FAILED ( "INCORRECT VALUE FOR " &
+                        "IDENT (NEWCHAR'SUCC('A'))" );
+          END IF;
+
+          IF NEWCHAR'PRED (B) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'PRED(B)" );
+          END IF;
+     END;
+
+     RESULT;
+END C35507I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507j.ada
new file mode 100644
index 000000000..9e9e89856
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507j.ada
@@ -0,0 +1,93 @@
+-- C35507J.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 ATTRIBUTES 'PRED' AND 'SUCC' YIELD THE CORRECT
+--     RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+--     PARAMETER IS A CHARACTER TYPE WITH AN ENUMERATION REPRESENTATION
+--     CLAUSE.
+
+-- HISTORY:
+--     RJW 06/03/86  CREATED ORIGINAL TEST.
+--     JET 09/22/87  MADE REPRESENTATION VALUES CONSECUTIVE.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507J  IS
+
+     TYPE CHAR IS ('A', B);
+     FOR CHAR USE ('A' => 4, B => 5);
+
+     TYPE NEWCHAR IS NEW CHAR;
+
+BEGIN
+
+     TEST( "C35507J" , "CHECK THAT THE ATTRIBUTES 'PRED' AND " &
+                       "'SUCC' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                       "ACTUAL PARAMETER IS A CHARACTER TYPE WITH " &
+                       "WITH AN ENUMERATION REPRESENTATION CLAUSE" );
+
+
+     DECLARE
+          GENERIC
+               TYPE CHTYPE IS (<>);
+               STR : STRING;
+               I1, I2 : INTEGER;
+          PROCEDURE P;
+
+          PROCEDURE P IS
+               SUBTYPE SUBCH IS CHTYPE
+                         RANGE CHTYPE'VAL (I1) .. CHTYPE'VAL (I2);
+          BEGIN
+               FOR CH IN SUBCH'VAL (I1 + 1) .. SUBCH'VAL (I2) LOOP
+                    IF SUBCH'PRED (CH) /=
+                       SUBCH'VAL (SUBCH'POS (CH) - 1) THEN
+                         FAILED ( "INCORRECT VALUE FOR " & STR &
+                                  "'PRED OF " & SUBCH'IMAGE (CH) );
+                    END IF;
+               END LOOP;
+
+               FOR CH IN SUBCH'VAL (I1) .. SUBCH'VAL (I2 - 1) LOOP
+                    IF SUBCH'SUCC (CH) /=
+                       SUBCH'VAL (SUBCH'POS (CH) + 1) THEN
+                         FAILED ( "INCORRECT VALUE FOR " & STR &
+                                  "'SUCC OF " & SUBCH'IMAGE (CH) );
+                    END IF;
+               END LOOP;
+
+          END P;
+
+          PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 0, 1);
+          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 0, 1);
+
+     BEGIN
+          PCHAR;
+          PNCHAR;
+
+     END;
+
+     RESULT;
+END C35507J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507k.ada
new file mode 100644
index 000000000..b26399234
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507k.ada
@@ -0,0 +1,224 @@
+-- C35507K.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 ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT
+--     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
+
+-- HISTORY:
+--     RJW 06/03/86
+--     JLH 07/28/87  MODIFIED FUNCTION IDENT.
+-- PWN 11/30/94 REMOVED PART OF TEST INVALID FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507K  IS
+
+     TYPE CHAR IS ('A', B);
+
+     TYPE NEWCHAR IS NEW CHAR;
+
+     SUBTYPE SCHAR IS CHARACTER
+             RANGE CHARACTER'VAL (127) .. CHARACTER'VAL (127);
+
+     BLANK : CONSTANT CHARACTER := ' ';
+
+     POSITION : INTEGER;
+
+     NONGRAPH : ARRAY (0 .. 31) OF CHARACTER :=
+          (ASCII.NUL, ASCII.SOH, ASCII.STX, ASCII.ETX,
+           ASCII.EOT, ASCII.ENQ, ASCII.ACK, ASCII.BEL,
+           ASCII.BS,  ASCII.HT,  ASCII.LF,  ASCII.VT,
+           ASCII.FF,  ASCII.CR,  ASCII.SO,  ASCII.SI,
+           ASCII.DLE, ASCII.DC1, ASCII.DC2, ASCII.DC3,
+           ASCII.DC4, ASCII.NAK, ASCII.SYN, ASCII.ETB,
+           ASCII.CAN, ASCII.EM,  ASCII.SUB, ASCII.ESC,
+           ASCII.FS,  ASCII.GS,  ASCII.RS,  ASCII.US);
+
+     FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+     BEGIN
+          IF EQUAL (CHAR'POS (CH), CHAR'POS (CH)) THEN
+               RETURN CH;
+          END IF;
+          RETURN CHAR'FIRST;
+     END IDENT;
+
+     FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+     BEGIN
+          IF EQUAL (NEWCHAR'POS (CH), NEWCHAR'POS (CH)) THEN
+               RETURN CH;
+          END IF;
+          RETURN NEWCHAR'FIRST;
+     END IDENT;
+
+BEGIN
+
+     TEST( "C35507K" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
+                       "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A CHARACTER TYPE" );
+
+     BEGIN
+          IF CHAR'POS ('A') /= 0 THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'POS('A') - 1" );
+          END IF;
+
+          IF CHAR'POS (B) /= 1 THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'POS(B) - 1" );
+          END IF;
+
+          IF CHAR'VAL (0) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'VAL(0)" );
+          END IF;
+
+          IF CHAR'VAL (1) /= B THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1)" );
+          END IF;
+
+          IF CHAR'POS (IDENT ('A')) /= 0 THEN
+               FAILED ( "INCORRECT VALUE " &
+                        "FOR CHAR'POS (IDENT ('A')) - 2" );
+          END IF;
+
+          IF CHAR'POS (IDENT (B)) /= 1 THEN
+               FAILED ( "INCORRECT VALUE " &
+                        "FOR CHAR'POS (IDENT (B)) - 2" );
+          END IF;
+
+     END;
+
+     BEGIN
+          IF NEWCHAR'POS ('A') /= 0 THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS('A')" );
+          END IF;
+
+          IF NEWCHAR'POS (B) /= 1 THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B) - 1" );
+          END IF;
+
+          IF NEWCHAR'VAL (0) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0) - 1" );
+          END IF;
+
+          IF NEWCHAR'VAL (1) /= B THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(1)" );
+          END IF;
+
+          IF NEWCHAR'VAL (IDENT_INT (1)) /= B THEN
+               FAILED ( "INCORRECT VALUE " &
+                        "FOR NEWCHAR'POS (IDENT (B)) - 2" );
+          END IF;
+
+          IF (NEWCHAR'VAL (IDENT_INT(0))) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE " &
+                        "FOR IDENT (NEWCHAR'VAL (0)) - 2" );
+          END IF;
+
+     END;
+
+     BEGIN
+          IF CHAR'VAL (IDENT_INT (2)) = B THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHAR'VAL (IDENT_INT (2)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHAR'VAL (IDENT_INT (2)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                         "FOR CHAR'VAL (IDENT_INT (2))" );
+     END;
+
+     BEGIN
+          IF NEWCHAR'VAL (IDENT_INT (-1)) = 'A' THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR NEWCHAR'VAL (IDENT_INT (-1))" );
+     END;
+
+     POSITION := 0;
+
+     FOR CH IN CHARACTER LOOP
+          IF SCHAR'POS (CH) /= POSITION THEN
+               FAILED ( "INCORRECT VALUE FOR SCHAR'POS OF " &
+                         CHARACTER'IMAGE (CH) );
+          END IF;
+
+          POSITION := POSITION + 1;
+     END LOOP;
+
+     FOR POSITION IN 0 .. 31 LOOP
+          IF CHARACTER'VAL (POSITION) /= NONGRAPH (POSITION) THEN
+               FAILED ( "INCORRECT VALUE FOR CHARACTER'VAL OF " &
+                        "NONGRAPHIC CHARACTER IN POSITION - " &
+                         INTEGER'IMAGE (POSITION) );
+          END IF;
+     END LOOP;
+
+     POSITION := 32;
+
+     FOR CH IN BLANK .. ASCII.TILDE LOOP
+          IF SCHAR'VAL (POSITION) /= CH THEN
+               FAILED ( "INCORRECT VALUE FOR SCHAR'VAL OF " &
+                        "GRAPHIC CHARACTER IN POSITION - " &
+                         INTEGER'IMAGE (POSITION) );
+          END IF;
+
+          POSITION := POSITION + 1;
+     END LOOP;
+
+     IF CHARACTER'VAL (127) /= ASCII.DEL THEN
+          FAILED ( "INCORRECT VALUE FOR CHARACTER'VAL OF " &
+                    "NONGRAPHIC CHARACTER IN POSITION - 127" );
+     END IF;
+
+     BEGIN
+          IF CHARACTER'VAL (IDENT_INT (-1)) = ASCII.NUL THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHARACTER'VAL (IDENT_INT (-1)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR CHARACTER'VAL (IDENT_INT (-1)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR CHARACTER'VAL (IDENT_INT (-1))" );
+     END;
+
+     RESULT;
+END C35507K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507l.ada
new file mode 100644
index 000000000..a259c74f9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507l.ada
@@ -0,0 +1,101 @@
+-- C35507L.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 'POS' AND 'VAL' YIELD THE CORRECT 
+-- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+-- PARAMETER IS A CHARACTER TYPE.   
+
+-- RJW 6/03/86
+-- PWN 11/30/94 REMOVED TESTS BASED ON 128 CHARACTERS FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507L  IS
+
+     TYPE CHAR IS ('A', B);
+
+     TYPE NEWCHAR IS NEW CHAR;     
+
+BEGIN
+
+     TEST( "C35507L" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
+                       "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " & 
+                       "ACTUAL PARAMETER IS A CHARACTER TYPE" );
+
+     DECLARE
+          GENERIC
+               TYPE CHTYPE IS (<>);
+               STR : STRING;
+               I1 : INTEGER;
+          PROCEDURE P;
+
+          PROCEDURE P IS
+               SUBTYPE SUBCH IS CHTYPE;               
+               CH : CHTYPE;
+               POSITION : INTEGER;
+          BEGIN
+               POSITION := 0;
+               FOR CH IN CHTYPE LOOP
+                    IF SUBCH'POS (CH) /= POSITION THEN 
+                         FAILED ( "INCORRECT VALUE FOR " & STR & 
+                                  "'POS OF " & CHTYPE'IMAGE (CH) );
+                    END IF;
+     
+                    IF SUBCH'VAL (POSITION) /= CH THEN
+                         FAILED ( "INCORRECT VALUE FOR " & STR & 
+                                  "'VAL OF CHARACTER IN POSITION - " &
+                                    INTEGER'IMAGE (POSITION) );
+                    END IF;
+                    POSITION := POSITION + 1;
+               END LOOP;
+     
+               BEGIN
+                    IF SUBCH'VAL (-1) = SUBCH'VAL (0) THEN
+                         FAILED ( "NO EXCEPTION RAISED " & 
+                                  "FOR " & STR & "'VAL (-1) - 1" );
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED " & 
+                                  "FOR " & STR & "'VAL (-1) - 2" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED " & 
+                                  "FOR " & STR & "'VAL (-1)" );
+               END;     
+          END P;
+          
+          PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 1);
+          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 1);
+          PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER", 127);
+     BEGIN
+          PCHAR;
+          PNCHAR;
+          PCH;
+     END;
+
+     RESULT;
+END C35507L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507m.ada
new file mode 100644
index 000000000..e76178c6c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507m.ada
@@ -0,0 +1,159 @@
+-- C35507M.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 ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT
+--     RESULTS WHEN THE PREFIX IS A CHARACTER TYPE WITH AN ENUMERATION
+--     REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 06/03/86  CREATED ORIGINAL TEST
+--     JLH 07/28/87  MODIFIED FUNCTION IDENT.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35507M  IS
+
+     TYPE CHAR IS ('A', B);
+     FOR CHAR USE ('A' => 4, B => 5);
+
+     TYPE NEWCHAR IS NEW CHAR;
+
+     FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN CH;
+          ELSE
+               RETURN 'A';
+          END IF;
+     END IDENT;
+
+     FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN CH;
+          ELSE
+               RETURN 'A';
+          END IF;
+     END IDENT;
+
+BEGIN
+
+     TEST( "C35507M" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
+                       "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A CHARACTER TYPE WITH AN " &
+                       "ENUMERATION REPESENTATION CLAUSE" );
+
+     BEGIN
+          IF CHAR'POS ('A') /= 0 THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'POS('A')" );
+          END IF;
+
+          IF CHAR'POS (B) /= 1 THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'POS(B)" );
+          END IF;
+
+          IF CHAR'VAL (0) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'VAL(0)" );
+          END IF;
+
+          IF CHAR'VAL (1) /= B THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1)" );
+          END IF;
+     END;
+
+     BEGIN
+          IF NEWCHAR'POS ('A') /= 0 THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS('A')" );
+          END IF;
+
+          IF NEWCHAR'POS (B) /= 1 THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B)" );
+          END IF;
+
+          IF NEWCHAR'VAL (0) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0)" );
+          END IF;
+
+          IF NEWCHAR'VAL (1) /= B THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(1)" );
+          END IF;
+     END;
+
+     BEGIN
+          IF CHAR'POS (IDENT ('A')) /= 0 THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'POS('A') WITH " &
+                        "IDENT" );
+          END IF;
+
+          IF NEWCHAR'POS (IDENT (B)) /= 1 THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B) WITH " &
+                        "IDENT" );
+          END IF;
+
+          IF IDENT (NEWCHAR'VAL (IDENT_INT(0))) /= 'A' THEN
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0) WITH " &
+                        "IDENT" );
+          END IF;
+
+          IF IDENT (CHAR'VAL (IDENT_INT(1))) /= B THEN
+               FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1) WITH IDENT" );
+          END IF;
+     END;
+
+     BEGIN
+          IF CHAR'VAL (IDENT_INT(2)) = B THEN
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHAR'VAL (IDENT_INT(2)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "CHAR'VAL (IDENT_INT(2)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "CHAR'VAL (IDENT_INT(2))" );
+     END;
+
+     BEGIN
+          IF NEWCHAR'VAL (IDENT_INT (-1)) = 'A' THEN
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED " &
+                        "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " &
+                        "FOR NEWCHAR'VAL (IDENT_INT (-1))" );
+     END;
+
+     RESULT;
+END C35507M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507n.ada
new file mode 100644
index 000000000..1e5e48a3a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507n.ada
@@ -0,0 +1,108 @@
+-- C35507N.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 ATTRIBUTES 'POS' AND 'VAL' YIELD THE CORRECT
+--     RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+--     PARAMETER IS A CHARACTER TYPE WITH AN ENUMERATION REPRESENTATION
+--     CLAUSE.
+
+-- HISTORY:
+--     RJW 06/03/86  CREATED ORIGINAL TEST.
+--     JET 09/22/87  MADE REPRESENTATION VALUES CONSECUTIVE.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     PWN 11/30/94  REMOVED TESTS BASED ON 128 CHARACTERS FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507N  IS
+
+     TYPE CHAR IS ('A', B);
+     FOR CHAR USE ('A' => 4, B => 5);
+
+     TYPE NEWCHAR IS NEW CHAR;
+
+BEGIN
+
+     TEST( "C35507N" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
+                       "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                       "ACTUAL PARAMETER IS A CHARACTER TYPE " &
+                       "WITH AN ENUMERATION REPRESENTATION CLAUSE" );
+
+     DECLARE
+          GENERIC
+               TYPE CHTYPE IS (<>);
+               STR : STRING;
+               I1 : INTEGER;
+          PROCEDURE P;
+
+          PROCEDURE P IS
+               SUBTYPE SUBCH IS CHTYPE;
+               CH : CHTYPE;
+               POSITION : INTEGER;
+          BEGIN
+               POSITION := 0;
+               FOR CH IN CHTYPE LOOP
+                    IF SUBCH'POS (CH) /= POSITION THEN
+                         FAILED ( "INCORRECT VALUE FOR " & STR &
+                                  "'POS OF " & CHTYPE'IMAGE (CH) );
+                    END IF;
+
+                    IF SUBCH'VAL (POSITION) /= CH THEN
+                         FAILED ( "INCORRECT VALUE FOR " & STR &
+                                  "'VAL OF CHARACTER IN POSITION - " &
+                                    INTEGER'IMAGE (POSITION) );
+                    END IF;
+                    POSITION := POSITION + 1;
+               END LOOP;
+
+               BEGIN
+                    IF SUBCH'VAL (-1) = SUBCH'VAL (0) THEN
+                         FAILED ( "NO EXCEPTION RAISED " &
+                                  "FOR " & STR & "'VAL (-1) - 1" );
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED " &
+                                  "FOR " & STR & "'VAL (-1) - 2" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED " &
+                                  "FOR " & STR & "'VAL (-1)" );
+               END;
+          END P;
+
+          PROCEDURE PCHAR IS NEW P (CHAR, "CHAR", 1);
+          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR", 1);
+          PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER", 127);
+     BEGIN
+          PCHAR;
+          PNCHAR;
+          PCH;
+     END;
+
+     RESULT;
+END C35507N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507o.ada
new file mode 100644
index 000000000..723a5ea11
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507o.ada
@@ -0,0 +1,120 @@
+-- C35507O.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' YIELD THE CORRECT 
+-- RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.   
+
+-- RJW 6/03/86
+-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+--              REMOVED PART OF TEST INVALID FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507O  IS
+
+     TYPE CHAR IS ('A', B);
+
+     TYPE NEWCHAR IS NEW CHAR;     
+
+     SPACE : CONSTANT CHARACTER := CHARACTER'(' ');
+
+     SUBTYPE NOCHAR IS CHARACTER RANGE CHARACTER'('Z') .. CHARACTER'('A');
+     SUBTYPE GRAPHIC IS CHARACTER RANGE SPACE .. ASCII.TILDE;
+     SUBTYPE NONGRAPHIC IS CHARACTER RANGE ASCII.NUL .. ASCII.US;
+
+     FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
+     BEGIN
+          RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH)));
+     END IDENT;
+
+     FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
+     BEGIN
+          RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH)));
+     END IDENT;
+
+BEGIN
+
+     TEST( "C35507O" , "CHECK THAT THE ATTRIBUTES 'FIRST' AND " &
+                       "'LAST' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A CHARACTER TYPE" );
+
+     BEGIN 
+          IF IDENT (CHAR'FIRST) /= 'A' THEN 
+               FAILED ( "INCORRECT VALUE FOR CHAR'FIRST" );
+          END IF;
+
+          IF CHAR'LAST /= B THEN 
+                FAILED ( "INCORRECT VALUE FOR CHAR'LAST" );
+          END IF;
+     END;
+
+     BEGIN 
+          IF NEWCHAR'FIRST /= 'A' THEN 
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'FIRST" );
+          END IF;
+
+          IF NEWCHAR'LAST /= IDENT (B) THEN 
+               FAILED ( "INCORRECT VALUE FOR NEWCHAR'LAST" );
+          END IF;
+     END;
+
+     BEGIN 
+          IF NOCHAR'FIRST /= CHARACTER'('Z') THEN 
+               FAILED ( "INCORRECT VALUE FOR NOCHAR'FIRST" );
+          END IF;
+
+          IF NOCHAR'LAST /= CHARACTER'('A') THEN 
+               FAILED ( "INCORRECT VALUE FOR NOCHAR'LAST" );
+          END IF;
+     END;
+
+     BEGIN 
+          IF CHARACTER'FIRST /= ASCII.NUL THEN 
+               FAILED ( "INCORRECT VALUE FOR CHARACTER'FIRST" );
+          END IF;
+
+     END;
+
+     BEGIN 
+          IF NONGRAPHIC'FIRST /= IDENT_CHAR (ASCII.NUL) THEN 
+               FAILED ( "INCORRECT VALUE FOR NONGRAPHIC'FIRST" );
+          END IF;
+
+          IF NONGRAPHIC'LAST /= ASCII.US THEN 
+               FAILED ( "INCORRECT VALUE FOR NONGRAPHIC'LAST" );
+          END IF;
+     END;
+
+     BEGIN 
+          IF GRAPHIC'FIRST /= SPACE THEN 
+               FAILED ( "INCORRECT VALUE FOR GRAPHIC'FIRST" );
+          END IF;
+
+          IF GRAPHIC'LAST /= ASCII.TILDE THEN 
+               FAILED ( "INCORRECT VALUE FOR GRAPHIC'LAST" );
+          END IF;
+     END;
+
+     RESULT;
+END C35507O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507p.ada
new file mode 100644
index 000000000..85c8c2781
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507p.ada
@@ -0,0 +1,94 @@
+-- C35507P.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' YIELD THE CORRECT 
+-- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL
+-- PARAMETER IS A CHARACTER TYPE.   
+
+-- RJW 6/03/86
+-- PWN 11/30/94 REMOVED TESTS BASED ON 128 CHARACTERS FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35507P  IS
+
+     TYPE CHAR IS ('A', B);
+
+     TYPE NEWCHAR IS NEW CHAR;     
+
+     SPACE : CONSTANT CHARACTER := ' ';
+
+     SUBTYPE GRAPHIC IS CHARACTER RANGE SPACE .. ASCII.TILDE;
+     SUBTYPE NONGRAPHIC IS CHARACTER RANGE ASCII.NUL .. ASCII.US;
+BEGIN
+
+     TEST( "C35507P" , "CHECK THAT THE ATTRIBUTES 'FIRST' AND " &
+                       "'LAST' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &
+                       "ACTUAL PARAMETER IS A CHARACTER TYPE" );
+
+     DECLARE
+          GENERIC
+               TYPE CHTYPE IS (<>);
+               STR : STRING;
+               F, L : CHTYPE;
+          PROCEDURE P;
+
+          PROCEDURE P IS 
+               SUBTYPE NOCHAR IS CHTYPE RANGE L .. F;
+          BEGIN 
+               IF CHTYPE'FIRST /= F THEN 
+                    FAILED ( "INCORRECT VALUE FOR " & STR & "'FIRST" );
+               END IF;
+
+               IF CHTYPE'LAST /= L THEN 
+                    FAILED ( "INCORRECT VALUE FOR " & STR & "'LAST" );
+               END IF;
+
+               IF NOCHAR'FIRST /= L THEN 
+                    FAILED ( "INCORRECT VALUE FOR NOCHAR'FIRST AS A " &
+                             "SUBTYPE OF " & STR );
+               END IF;
+
+               IF NOCHAR'LAST /= F THEN 
+                    FAILED ( "INCORRECT VALUE FOR NOCHAR'LAST AS A " &
+                             "SUBTYPE OF " & STR  );
+               END IF;
+          END P;
+          
+          PROCEDURE P1 IS NEW P (CHAR, "CHAR", 'A', B);          
+          PROCEDURE P2 IS NEW P (NEWCHAR, "NEWCHAR", 'A', B);          
+          PROCEDURE P3 IS NEW P 
+               (GRAPHIC, "GRAPHIC", SPACE, ASCII.TILDE);
+          PROCEDURE P4 IS NEW P 
+               (NONGRAPHIC, "NONGRAPHIC", ASCII.NUL, ASCII.US);
+     BEGIN
+          P1;
+          P2;
+          P3;
+          P4;
+     END;
+
+     RESULT;
+END C35507P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508a.ada
new file mode 100644
index 000000000..5e4f72da9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508a.ada
@@ -0,0 +1,74 @@
+-- C35508A.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 ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS WHEN 
+-- THE PREFIX IS A BOOLEAN TYPE.   
+
+-- RJW 3/14/86  COMPLETELY REVISED.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35508A  IS
+
+BEGIN
+
+     TEST( "C35508A" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                       "THE CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "BOOLEAN TYPE" );
+
+     DECLARE
+          TYPE NEWBOOL IS NEW BOOLEAN;
+          SUBTYPE FRANGE IS BOOLEAN 
+               RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
+          SUBTYPE TRANGE IS BOOLEAN 
+               RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE);
+          SUBTYPE NOBOOL IS BOOLEAN 
+               RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE);
+
+     BEGIN
+
+          IF BOOLEAN'WIDTH /= 5 THEN
+               FAILED( "INCORRECT WIDTH FOR BOOLEAN" );
+          END IF;
+
+          IF NEWBOOL'WIDTH /= 5 THEN
+               FAILED( "INCORRECT WIDTH FOR NEWBOOL" );
+          END IF;
+
+          IF FRANGE'WIDTH /= 5 THEN
+               FAILED( "INCORRECT WIDTH FOR FRANGE" );
+          END IF;
+
+          IF TRANGE'WIDTH /= 4 THEN
+               FAILED( "INCORRECT WIDTH FOR TRANGE" );
+          END IF;
+
+          IF NOBOOL'WIDTH /= 0 THEN
+               FAILED( "INCORRECT WIDTH FOR NOBOOL" );
+          END IF;
+     
+     END;                    
+
+     RESULT;
+END C35508A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508b.ada
new file mode 100644
index 000000000..b0339faec
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508b.ada
@@ -0,0 +1,79 @@
+-- C35508B.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 ATTRIBUTE 'WIDTH' YIELDS THE CORRECT RESULTS WHEN 
+-- THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL 
+-- PARAMETER IS A BOOLEAN TYPE.   
+
+-- RJW 3/19/86  COMPLETELY REVISED.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35508B  IS
+
+BEGIN
+
+     TEST( "C35508B" , "CHECK THAT THE ATTRIBUTE 'WIDTH' YIELDS " &
+                       "THE CORRECT RESULTS WHEN THE PREFIX IS A " &
+                       "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                       "PARAMETER IS A BOOLEAN TYPE" );
+
+     DECLARE
+          SUBTYPE FRANGE IS BOOLEAN 
+               RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
+          SUBTYPE TRANGE IS BOOLEAN 
+               RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE);
+          TYPE NEWBOOL IS NEW BOOLEAN;
+
+          GENERIC
+               TYPE B IS (<>);
+               W : INTEGER;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+               SUBTYPE NOBOOL IS B RANGE 
+                    B'VAL (IDENT_INT(1)) .. B'VAL (IDENT_INT(0));
+          BEGIN
+               IF B'WIDTH /= W THEN 
+                    FAILED ( "INCORRECT B'WIDTH FOR " & STR );
+               END IF;
+               IF NOBOOL'WIDTH /= 0 THEN
+                    FAILED ( "INCORRECT NOBOOL'WIDTH FOR " & STR );
+               END IF;
+          END P;
+
+          PROCEDURE PROC1 IS NEW P (BOOLEAN, 5);
+          PROCEDURE PROC2 IS NEW P (FRANGE, 5);
+          PROCEDURE PROC3 IS NEW P (TRANGE, 4);
+          PROCEDURE PROC4 IS NEW P (NEWBOOL, 5);
+
+     BEGIN
+          PROC1 ( "BOOLEAN" );
+          PROC2 ( "FRANGE" );
+          PROC3 ( "TRANGE");
+          PROC4 ( "NEWBOOL" );
+     END;                    
+
+     RESULT;
+END C35508B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508c.ada
new file mode 100644
index 000000000..88ca20ad2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508c.ada
@@ -0,0 +1,195 @@
+-- C35508C.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT 
+-- RESULTS WHEN THE PREFIX IS A BOOLEAN TYPE.   
+
+-- SUBTESTS ARE:
+--     (A). TESTS FOR IMAGE.
+--     (B). TESTS FOR VALUE.
+
+-- RJW 3/19/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35508C  IS     
+
+     TYPE NEWBOOL IS NEW BOOLEAN;
+
+BEGIN
+
+     TEST( "C35508C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
+                       "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
+                       "PREFIX IS A BOOLEAN TYPE" );
+-- PART (A).
+
+     DECLARE
+
+          A5, B5 : INTEGER := IDENT_INT(5);
+          C6     : INTEGER := IDENT_INT(6);
+     BEGIN  
+
+          IF BOOLEAN'IMAGE ( A5 = B5 ) /= "TRUE" THEN
+               FAILED ( "INCORRECT IMAGE FOR 'A5 = B5'" );
+          END IF;
+          IF BOOLEAN'IMAGE ( A5 = B5 )'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR 'A5 = B5'" );
+          END IF;
+
+          IF BOOLEAN'IMAGE ( C6 = A5 ) /= "FALSE" THEN
+               FAILED ( "INCORRECT IMAGE FOR 'C6 = A5'" );
+          END IF;          
+          IF BOOLEAN'IMAGE ( C6 = A5 )'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR 'C6 = A5'" );
+          END IF;          
+
+          IF BOOLEAN'IMAGE (TRUE) /= "TRUE" THEN
+               FAILED ( "INCORRECT IMAGE FOR 'TRUE'" );
+          END IF;          
+          IF BOOLEAN'IMAGE (TRUE)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR 'TRUE'" );
+          END IF;          
+
+          IF NEWBOOL'IMAGE (FALSE) /= "FALSE" THEN
+               FAILED ( "INCORRECT IMAGE FOR NEWBOOL'FALSE'" );
+          END IF;          
+          IF NEWBOOL'IMAGE (FALSE)'FIRST /= 1 THEN
+               FAILED ( "INCORRECT LOWER BOUND FOR NEWBOOL'FALSE'" );
+          END IF;          
+     END;
+
+-----------------------------------------------------------------------
+
+-- PART (B).
+
+     BEGIN  
+          IF BOOLEAN'VALUE (IDENT_STR("TRUE")) /= TRUE THEN     
+               FAILED ( "INCORRECT VALUE FOR ""TRUE""" );  
+          END IF;
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR ""TRUE""" );  
+     END;
+
+     BEGIN
+          IF NEWBOOL'VALUE (IDENT_STR("FALSE")) /= FALSE THEN
+               FAILED ( "INCORRECT VALUE FOR ""FALSE""" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR ""FALSE""" );
+     END;
+
+     BEGIN
+          IF BOOLEAN'VALUE ("true") /= TRUE THEN
+               FAILED ( "INCORRECT VALUE FOR ""true""" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR ""true""" );
+     END;
+
+     BEGIN
+          IF NEWBOOL'VALUE ("false") /= FALSE THEN
+               FAILED ( "INCORRECT VALUE FOR ""false""" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE FOR " &
+                        """false""" );
+     END;
+
+     BEGIN
+          IF BOOLEAN'VALUE (IDENT_STR("TRUE     ")) /= TRUE THEN
+               FAILED ( "INCORRECT VALUE WITH TRAILING BLANKS" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE - " &
+                        "TRAILING BLANKS" );
+     END;
+
+     BEGIN          
+          IF NEWBOOL'VALUE ("  FALSE") /= FALSE THEN
+               FAILED ( "INCORRECT VALUE WITH LEADING BLANKS" );
+          END IF;          
+     EXCEPTION     
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - VALUE - LEADING " &
+                        "BLANKS" );
+     END;
+
+     DECLARE 
+          SUBTYPE SUBBOOL IS BOOLEAN RANGE FALSE .. FALSE;
+     BEGIN
+          IF SUBBOOL'VALUE (IDENT_STR("TRUE")) /= TRUE THEN     
+               FAILED ( "INCORRECT VALUE - ""TRUE"" AND " & 
+                        "SUBBOOL" );  
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - SUBBOOL" );
+     END;
+     
+     BEGIN
+          IF BOOLEAN'VALUE (IDENT_STR("MAYBE")) = TRUE THEN
+               FAILED ( "NO EXCEPTION RAISED - ""MAYBE"" - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - ""MAYBE"" - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - ""MAYBE"" " );
+     END;
+
+     BEGIN
+          IF BOOLEAN'VALUE (IDENT_CHAR(ASCII.HT) & "TRUE") = TRUE THEN
+               FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
+     END;
+
+     BEGIN
+          IF NEWBOOL'VALUE ("FALSE" & ASCII.HT) = FALSE THEN
+               FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
+     END;
+
+     RESULT;
+END C35508C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508e.ada
new file mode 100644
index 000000000..584ccfec8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508e.ada
@@ -0,0 +1,192 @@
+-- C35508E.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 ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT
+--     RESULTS WHEN THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE
+--     ACTUAL ARGUMENT IS A BOOLEAN TYPE.
+
+--     SUBTESTS ARE:
+--         (A). TESTS FOR IMAGE.
+--         (B). TESTS FOR VALUE.
+
+-- HISTORY:
+--     RJW 03/19/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C35508E  IS
+
+BEGIN
+
+     TEST( "C35508E" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
+                       "'VALUE' YIELD THE CORRECT RESULTS  WHEN THE " &
+                       "PREFIX IS A GENERIC FORMAL DISCRETE TYPE " &
+                       "WHOSE ACTUAL ARGUMENT IS A BOOLEAN TYPE" );
+-- PART (A).
+
+     DECLARE
+          TYPE NEWBOOL IS NEW BOOLEAN;
+
+          GENERIC
+               TYPE BOOL IS (<>);
+          PROCEDURE P (B : BOOL; STR : STRING );
+
+          PROCEDURE P (B : BOOL; STR : STRING) IS
+               SUBTYPE SUBBOOL IS BOOL
+                    RANGE BOOL'VAL (IDENT_INT(0)) ..
+                                               BOOL'VAL (IDENT_INT(0));
+          BEGIN
+
+               IF BOOL'IMAGE (B) /= STR THEN
+                    FAILED ( "INCORRECT BOOL'IMAGE OF " & STR );
+               END IF;
+               IF BOOL'IMAGE (B)'FIRST /= 1 THEN
+                    FAILED ( "INCORRECT BOOL'FIRST FOR " & STR );
+               END IF;
+
+               IF SUBBOOL'IMAGE (B) /= STR THEN
+                    FAILED ( "INCORRECT SUBBOOL'IMAGE OF " & STR );
+               END IF;
+               IF SUBBOOL'IMAGE (B)'FIRST /= 1 THEN
+                    FAILED ( "INCORRECT SUBBOOL'FIRST FOR " & STR );
+               END IF;
+          END P;
+
+          PROCEDURE NP1 IS NEW P ( BOOLEAN );
+          PROCEDURE NP2 IS NEW P ( NEWBOOL );
+     BEGIN
+          NP1 ( TRUE, "TRUE" );
+          NP2 ( FALSE, "FALSE" );
+
+     END;
+
+-----------------------------------------------------------------------
+
+-- PART (B).
+
+     DECLARE
+          TYPE NEWBOOL IS NEW BOOLEAN;
+
+          GENERIC
+               TYPE BOOL IS (<>);
+          PROCEDURE P (STR : STRING; B : BOOL );
+
+          PROCEDURE P (STR : STRING; B : BOOL) IS
+               SUBTYPE SUBBOOL IS BOOL
+                    RANGE BOOL'VAL (IDENT_INT(0)) ..
+                                               BOOL'VAL (IDENT_INT(0));
+
+          BEGIN
+               BEGIN
+                    IF BOOL'VALUE (STR) /= B THEN
+                         FAILED ( "INCORRECT BOOL'VALUE OF """ &
+                                  STR & """" );
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED BOOL'VALUE OF """ &
+                                  STR & """" );
+               END;
+               BEGIN
+                    IF SUBBOOL'VALUE (STR) /= B THEN
+                         FAILED ( "INCORRECT SUBBOOL'VALUE OF """ &
+                                  STR & """" );
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED SUBBOOL'VALUE " &
+                                  "OF """ & STR & """" );
+               END;
+          END P;
+
+          PROCEDURE NP1 IS NEW P ( BOOLEAN );
+          PROCEDURE NP2 IS NEW P ( NEWBOOL );
+
+     BEGIN
+          NP1 ( "TRUE", TRUE );
+          NP2 ( "FALSE", FALSE );
+          NP2 ( "true", TRUE );
+          NP1 ( "false", FALSE );
+          NP1 ( "         TRUE", TRUE );
+          NP2 ( "FALSE        ", FALSE );
+     END;
+
+     DECLARE
+          GENERIC
+               TYPE BOOL IS (<>);
+          PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING);
+
+          PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING) IS
+               SUBTYPE SUBBOOL IS BOOL
+                    RANGE BOOL'VAL (IDENT_INT(0)) ..
+                                                BOOL'VAL (IDENT_INT(0));
+
+          BEGIN
+               BEGIN
+                    IF BOOL'VALUE (STR1) = B THEN
+                         FAILED ( "NO EXCEPTION RAISED - " &
+                                  "BOOL'VALUE WITH " & STR2 &
+                                  "- EQUAL " );
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED - " &
+                                  "BOOL'VALUE WITH " & STR2 &
+                                  " - NOT EQUAL" );
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED - " &
+                                  "BOOL'VALUE WITH " & STR2 );
+               END;
+               BEGIN
+                    IF SUBBOOL'VALUE (STR1) /= B THEN
+                         FAILED ( "NO EXCEPTION RAISED - " &
+                                  "SUBBOOL'VALUE WITH " &
+                                  STR2 & " - EQUAL");
+                    ELSE
+                         FAILED ( "NO EXCEPTION RAISED - " &
+                                  "SUBBOOL'VALUE WITH " &
+                                  STR2 & " - NOT EQUAL");
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED - " &
+                                  "SUBBOOL'VALUE WITH " & STR2 );
+               END;
+          END P;
+
+          PROCEDURE NP IS NEW P ( BOOLEAN );
+     BEGIN
+          NP ( "MAYBE", TRUE, "NON-BOOLEAN VALUE");
+          NP ( ASCII.HT & "TRUE", TRUE, "LEADING 'HT'" );
+          NP ( "FALSE" & ASCII.HT , FALSE, "TRAILING 'HT'" );
+     END;
+
+     RESULT;
+END C35508E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508g.ada
new file mode 100644
index 000000000..dd546d2b9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508g.ada
@@ -0,0 +1,105 @@
+-- C35508G.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 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN THE
+--     PREFIX IS A BOOLEAN TYPE.
+
+-- HISTORY:
+--     RJW 03/19/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35508G IS
+
+BEGIN
+     TEST ("C35508G", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                      "BOOLEAN TYPE" );
+
+     BEGIN
+          IF BOOLEAN'PRED (IDENT_BOOL(TRUE)) /= FALSE THEN
+               FAILED ( "INCORRECT VALUE FOR PRED OF TRUE" );
+          END IF;
+          IF BOOLEAN'SUCC (IDENT_BOOL(FALSE)) /= TRUE THEN
+               FAILED ( "INCORRECT VALUE FOR SUCC OF FALSE" );
+          END IF;
+     END;
+
+     DECLARE
+          TYPE NEWBOOL IS NEW BOOLEAN;
+     BEGIN
+          IF NEWBOOL'PRED (TRUE) /= FALSE THEN
+               FAILED ( "INCORRECT VALUE FOR NEWBOOL'PRED OF TRUE" );
+          END IF;
+          IF NEWBOOL'SUCC (FALSE) /= TRUE THEN
+               FAILED ( "INCORRECT VALUE FOR NEWBOOL'SUCC OF FALSE" );
+          END IF;
+     END;
+
+     DECLARE
+
+          SUBTYPE SBOOL IS BOOLEAN RANGE IDENT_BOOL(TRUE) ..
+                                                      IDENT_BOOL(TRUE);
+
+     BEGIN
+          BEGIN
+               IF SBOOL'PRED (IDENT_BOOL(TRUE)) /= FALSE THEN
+                    FAILED ( "INCORRECT VALUE FOR SBOOL'PRED " &
+                             "OF TRUE" );
+               END IF;
+          END;
+
+          BEGIN
+               IF SBOOL'PRED (IDENT_BOOL(SBOOL'BASE'FIRST)) = TRUE THEN
+                    FAILED("'PRED('FIRST) WRAPPED AROUNT TO TRUE");
+               END IF;
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "'PRED (SBOOL'BASE'FIRST)" );
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                             "'PRED (SBOOL'BASE'FIRST)" );
+          END;
+
+          BEGIN
+               IF SBOOL'SUCC (IDENT_BOOL(SBOOL'BASE'LAST)) = FALSE THEN
+                    FAILED("'SUCC('LAST) WRAPPED AROUNT TO FALSE");
+               END IF;
+               FAILED ( "NO EXCEPTION RAISED FOR " &
+                        "'SUCC (SBOOL'BASE'LAST)" );
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                             "'SUCC (SBOOL'BASE'LAST)" );
+          END;
+     END;
+
+     RESULT;
+END C35508G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508h.ada
new file mode 100644
index 000000000..2b89a29ed
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508h.ada
@@ -0,0 +1,116 @@
+-- C35508H.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 'PRED' AND 'SUCC' YIELD THE CORRECT RESULTS WHEN THE
+--     PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS A
+--     BOOLEAN TYPE.
+
+-- HISTORY:
+--     RJW 03/24/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35508H IS
+
+BEGIN
+     TEST ("C35508H", "CHECK THAT 'PRED' AND 'SUCC' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                      "FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER " &
+                      "IS A BOOLEAN TYPE" );
+
+     DECLARE
+
+          TYPE NEWBOOL IS NEW BOOLEAN;
+
+          GENERIC
+               TYPE BOOL IS (<>);
+               F, T : BOOL;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+               SUBTYPE SBOOL IS BOOL RANGE T .. T;
+          BEGIN
+               BEGIN
+                    IF BOOL'PRED (T) /= F THEN
+                         FAILED ( "INCORRECT VALUE FOR " &
+                                   STR & "'PRED OF T" );
+                    END IF;
+                    IF BOOL'SUCC (F) /= T THEN
+                         FAILED ( "INCORRECT VALUE FOR " &
+                                   STR & "'SUCC OF F" );
+                    END IF;
+               END;
+
+               BEGIN
+                    IF SBOOL'PRED (T) /= F THEN
+                         FAILED ( "INCORRECT VALUE FOR SBOOL'PRED " &
+                                  "OF T FOR " & STR);
+                    END IF;
+               END;
+
+               BEGIN
+                    IF SBOOL'PRED (SBOOL'BASE'FIRST) = T THEN
+                         FAILED("'PRED('FIRST) WRAPPED AROUND " &
+                                "TO TRUE FOR " & STR);
+                    END IF;
+                    FAILED ( "NO EXCEPTION RAISED FOR " &
+                              STR & "'PRED (SBOOL'BASE'FIRST)" );
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                   STR & "'PRED (SBOOL'BASE'FIRST)" );
+               END;
+
+               BEGIN
+                    IF SBOOL'SUCC (SBOOL'BASE'LAST) = F THEN
+                         FAILED("'SUCC('LAST) WRAPPED AROUND TO " &
+                                "FALSE FOR " & STR);
+                    END IF;
+                    FAILED ( "NO EXCEPTION RAISED FOR " & STR &
+                             "'SUCC (SBOOL'BASE'LAST)" );
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                  STR & "'SUCC (SBOOL'BASE'LAST)" );
+               END;
+          END P;
+
+          PROCEDURE NP1 IS NEW P
+                         ( BOOL => BOOLEAN, F => FALSE, T => TRUE );
+
+          PROCEDURE NP2 IS NEW P
+                         ( BOOL => NEWBOOL, F => FALSE, T => TRUE );
+     BEGIN
+          NP1 ("BOOLEAN");
+          NP2 ("NEWBOOL");
+     END;
+
+     RESULT;
+END C35508H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508k.ada
new file mode 100644
index 000000000..338397a5b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508k.ada
@@ -0,0 +1,125 @@
+-- C35508K.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE 
+-- PREFIX IS A BOOLEAN TYPE.
+
+-- RJW 3/19/86
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35508K IS
+
+     TYPE NEWBOOL IS NEW BOOLEAN;
+
+BEGIN
+     TEST ("C35508K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                      "CORRECT RESULTS  WHEN THE PREFIX IS A " &
+                      "BOOLEAN TYPE" );
+
+     BEGIN
+          IF BOOLEAN'POS (IDENT_BOOL(FALSE)) /= 0 THEN
+               FAILED ( "WRONG POS FOR 'FALSE'" );
+          END IF;
+          IF BOOLEAN'POS (IDENT_BOOL(TRUE)) /= 1 THEN
+               FAILED ( "WRONG POS FOR 'TRUE'" );
+          END IF;
+
+          IF BOOLEAN'VAL (IDENT_INT(0)) /= FALSE THEN
+               FAILED ( "WRONG VAL FOR '0'" );
+          END IF;
+          IF BOOLEAN'VAL (IDENT_INT(1)) /= TRUE THEN
+               FAILED ( "WRONG VAL FOR '1'" );
+          END IF;
+     END;
+
+     BEGIN
+          IF BOOLEAN'VAL (IDENT_INT(-1)) = TRUE THEN
+               FAILED("'VAL(-1) WRAPPED AROUND TO TRUE");
+          END IF;
+          FAILED ( "NO EXCEPTION RAISED FOR VAL OF '-1'" );
+     EXCEPTION     
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VAL OF '-1'" );
+     END;
+
+     BEGIN
+          IF BOOLEAN'VAL (IDENT_INT(2)) = FALSE THEN
+               FAILED("BOOLEAN'VAL(2) WRAPPED AROUND TO FALSE");
+          END IF;
+          FAILED ( "NO EXCEPTION RAISED FOR VAL OF '2'" );
+     EXCEPTION     
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VAL OF '2'" );
+     END;
+
+     BEGIN
+          IF NEWBOOL'POS (FALSE) /= 0 THEN
+               FAILED ( "WRONG POS FOR NEWBOOL'(FALSE)" );
+          END IF;
+          IF NEWBOOL'POS (TRUE) /= 1 THEN
+               FAILED ( "WRONG POS FOR NEWBOOL'(TRUE)" );
+          END IF;
+
+          IF NEWBOOL'VAL (0) /= FALSE THEN
+               FAILED ( "WRONG NEWBOOL'VAL FOR '0'" );
+          END IF;
+          IF NEWBOOL'VAL (1) /= TRUE THEN
+               FAILED ( "WRONG NEWBOOL'VAL FOR '1'" );
+          END IF;
+     END;
+
+     BEGIN
+          IF NEWBOOL'VAL (IDENT_INT(-1)) = TRUE THEN
+               FAILED("NEWBOOL'VAL(-1) WRAPPED AROUND TO TRUE"); 
+          END IF;
+          FAILED ( "NO EXCEPTION RAISED FOR NEWBOOL'VAL OF '-1'" );
+     EXCEPTION     
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "NEWBOOL'VAL OF '-1'" );
+     END;
+
+     BEGIN
+          IF NEWBOOL'VAL (IDENT_INT(2)) = FALSE THEN
+               FAILED("NEWBOOL'VAL(2) WRAPPED AROUND TO FALSE");
+          END IF;
+          FAILED ( "NO EXCEPTION RAISED FOR NEWBOOL'VAL OF '2'" );
+     EXCEPTION     
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "NEWBOOL'VAL OF '2'" );
+     END;
+
+     RESULT;
+END C35508K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508l.ada
new file mode 100644
index 000000000..cba30e237
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508l.ada
@@ -0,0 +1,132 @@
+-- C35508L.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE 
+-- PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS A 
+-- BOOLEAN TYPE.
+
+-- RJW 3/24/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35508L IS
+
+BEGIN
+     TEST ("C35508L", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                      "FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER " &
+                      "IS A BOOLEAN TYPE" );
+
+     DECLARE
+          TYPE NEWBOOL IS NEW BOOLEAN;
+
+          GENERIC 
+               TYPE BOOL IS (<>);
+          PROCEDURE P (STR : STRING; B : BOOL; I : INTEGER);
+
+          PROCEDURE P (STR : STRING; B : BOOL; I : INTEGER) IS
+               SUBTYPE SBOOL IS BOOL 
+               RANGE BOOL'VAL (IDENT_INT(0)) .. BOOL'VAL (IDENT_INT(0));
+          BEGIN
+               IF BOOL'POS (B) /= I THEN
+                    FAILED ( "WRONG " & STR & "'POS FOR " &
+                              BOOL'IMAGE (B) & " - 1" );
+               END IF;
+               IF BOOL'VAL (I) /= B THEN
+                    FAILED ( "WRONG " & STR & "'VAL FOR " &
+                              INTEGER'IMAGE (I) & " - 1" );
+               END IF;
+
+               IF SBOOL'POS (B) /= I THEN
+                    FAILED ( "WRONG " & STR & "'POS FOR " &
+                              BOOL'IMAGE (B) & " - 2" );
+               END IF;
+
+               IF SBOOL'VAL (I) /= B THEN
+                    FAILED ( "WRONG " & STR & "'VAL FOR " &
+                              INTEGER'IMAGE (I) & " - 2" );
+               END IF;
+          END P;
+
+          GENERIC 
+               TYPE BOOL IS (<>);
+          PROCEDURE Q (STR : STRING; B : BOOL; I : INTEGER);
+
+          PROCEDURE Q (STR : STRING; B : BOOL; I : INTEGER) IS
+               SUBTYPE SBOOL IS BOOL 
+               RANGE BOOL'VAL (IDENT_INT(0)) .. BOOL'VAL (IDENT_INT(0));
+          BEGIN
+               BEGIN
+                    IF BOOL'VAL (I) = B THEN
+                         FAILED (STR & "'VAL OF " & INTEGER'IMAGE (I) &
+                                       " = " & BOOL'IMAGE (B));
+                    END IF;
+                    FAILED ( "NO EXCEPTION RAISED FOR " & STR & 
+                             "'VAL OF " & INTEGER'IMAGE (I) );
+               EXCEPTION     
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " & STR &
+                                  "'VAL " & "OF " &
+                                   INTEGER'IMAGE (I) );
+               END;
+          
+               BEGIN
+                    IF SBOOL'VAL (I) = B THEN
+                         FAILED (STR & " SBOOL'VAL OF " & 
+                                 INTEGER'IMAGE(I) & " = " &
+                                 BOOL'IMAGE (B) );
+                         END IF;
+                         FAILED( "NO EXCEPTION RAISED FOR VAL OF " &
+                                  INTEGER'IMAGE (I)  &
+                                 "WITH SBOOL OF " & STR);
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " & STR &
+                                  "'VAL " & "OF " &
+                                   INTEGER'IMAGE (I) &
+                                  "WITH SBOOL " );  
+               END;
+          END Q;
+
+          PROCEDURE NP1 IS NEW P ( BOOL => BOOLEAN );
+          PROCEDURE NP2 IS NEW P ( BOOL => NEWBOOL );
+          PROCEDURE NQ1 IS NEW Q ( BOOL => BOOLEAN );
+          PROCEDURE NQ2 IS NEW Q ( BOOL => NEWBOOL );
+     BEGIN
+          NP1 ( "BOOLEAN", IDENT_BOOL(FALSE) , IDENT_INT(0) );
+          NP1 ( "BOOLEAN", IDENT_BOOL(TRUE) , IDENT_INT(1) );
+          NP2 ( "NEWBOOL", FALSE , 0 );
+          NP2 ( "NEWBOOL", TRUE , 1 );
+          NQ1 ( "BOOLEAN", IDENT_BOOL(FALSE) , IDENT_INT(-1) );
+          NQ1 ( "BOOLEAN", IDENT_BOOL(TRUE) , IDENT_INT(2) );
+          NQ2 ( "NEWBOOL", FALSE , -1 );
+          NQ2 ( "NEWBOOL", TRUE , 2 );
+     END;
+
+     RESULT;
+END C35508L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508o.ada
new file mode 100644
index 000000000..ff1eb67e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508o.ada
@@ -0,0 +1,98 @@
+-- C35508O.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 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
+--     PREFIX IS A BOOLEAN TYPE.
+
+-- HISTORY:
+--     RJW 03/19/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35508O IS
+
+BEGIN
+     TEST ("C35508O", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                      "BOOLEAN TYPE" );
+
+     DECLARE
+          SUBTYPE TBOOL IS BOOLEAN RANGE IDENT_BOOL(TRUE) ..
+                                                     IDENT_BOOL(TRUE);
+          SUBTYPE FBOOL IS BOOLEAN
+               RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
+          SUBTYPE NOBOOL IS BOOLEAN
+               RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE);
+          TYPE NEWBOOL IS NEW BOOLEAN;
+          TYPE NIL IS NEW BOOLEAN RANGE IDENT_BOOL(TRUE) ..
+                                                    IDENT_BOOL(FALSE);
+
+     BEGIN
+          IF IDENT_BOOL(BOOLEAN'FIRST) /= FALSE THEN
+               FAILED ( "WRONG VALUE FOR BOOLEAN'FIRST" );
+          END IF;
+          IF IDENT_BOOL(BOOLEAN'LAST) /= TRUE THEN
+               FAILED ( "WRONG VALUE FOR BOOLEAN'LAST" );
+          END IF;
+
+          IF TBOOL'FIRST /= TRUE THEN
+               FAILED ( "WRONG VALUE FOR TBOOL'FIRST" );
+          END IF;
+          IF TBOOL'LAST /= TRUE THEN
+               FAILED ( "WRONG VALUE FOR TBOOL'LAST" );
+          END IF;
+
+          IF FBOOL'FIRST /= FALSE THEN
+               FAILED ( "WRONG VALUE FOR FBOOL'FIRST" );
+          END IF;
+          IF FBOOL'LAST /= FALSE THEN
+               FAILED ( "WRONG VALUE FOR FBOOL'LAST" );
+          END IF;
+
+          IF NOBOOL'FIRST /= TRUE THEN
+               FAILED ( "WRONG VALUE FOR NOBOOL'FIRST" );
+          END IF;
+          IF NOBOOL'LAST /= FALSE THEN
+               FAILED ( "WRONG VALUE FOR NOBOOL'LAST" );
+          END IF;
+
+          IF NEWBOOL'FIRST /= FALSE THEN
+               FAILED ( "WRONG VALUE FOR NEWBOOL'FIRST" );
+          END IF;
+          IF NEWBOOL'LAST /= TRUE THEN
+               FAILED ( "WRONG VALUE FOR NEWBOOL'LAST" );
+          END IF;
+          IF NIL'FIRST /= TRUE THEN
+               FAILED ( "WRONG VALUE FOR NIL'FIRST" );
+          END IF;
+          IF NIL'LAST /= FALSE THEN
+               FAILED ( "WRONG VALUE FOR NIL'LAST" );
+          END IF;
+
+     END;
+
+     RESULT;
+END C35508O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508p.ada
new file mode 100644
index 000000000..8ee3e8848
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35508p.ada
@@ -0,0 +1,131 @@
+-- C35508P.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 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
+--     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER
+--     IS A BOOLEAN TYPE.
+
+-- HISTORY:
+--     RJW 03/19/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35508P IS
+
+BEGIN
+     TEST ("C35508P", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
+                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
+                      "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
+                      "PARAMETER IS A BOOLEAN TYPE" );
+     DECLARE
+          SUBTYPE TBOOL IS BOOLEAN
+               RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE);
+          SUBTYPE FBOOL IS BOOLEAN
+               RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
+          SUBTYPE NOBOOL IS BOOLEAN
+               RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE);
+          TYPE NEWBOOL IS NEW BOOLEAN;
+
+          GENERIC
+               TYPE BOOL IS (<>);
+               F, L : BOOL;
+          PROCEDURE P ( STR : STRING );
+
+          PROCEDURE P ( STR : STRING ) IS
+          BEGIN
+               IF BOOL'FIRST /= F THEN
+                    FAILED ( "WRONG VALUE FOR " & STR & "'FIRST" );
+               END IF;
+               IF BOOL'LAST /= L THEN
+                    FAILED ( "WRONG VALUE FOR " & STR & "'LAST" );
+               END IF;
+          END P;
+
+          GENERIC
+               TYPE BOOL IS (<>);
+          PROCEDURE Q;
+
+          PROCEDURE Q IS
+          BEGIN
+               IF BOOL'FIRST /= BOOL'VAL (IDENT_INT(1)) THEN
+                    FAILED ( "WRONG 'FIRST FOR NOBOOL" );
+               END IF;
+               IF BOOL'LAST /= BOOL'VAL (IDENT_INT(0)) THEN
+                    FAILED ( "WRONG 'LAST FOR NOBOOL" );
+               END IF;
+          END Q;
+
+          GENERIC
+               TYPE BOOL IS (<>);
+               F, L : BOOL;
+          PROCEDURE R;
+
+          PROCEDURE R IS
+               SUBTYPE SBOOL IS BOOL
+                              RANGE BOOL'VAL (0) .. BOOL'VAL (1);
+          BEGIN
+               IF SBOOL'FIRST /= F THEN
+                    FAILED ( "WRONG VALUE FOR BOOLEAN'FIRST AS " &
+                             "SUBTYPE " );
+               END IF;
+               IF SBOOL'LAST /= L THEN
+                    FAILED ( "WRONG VALUE FOR BOOLEAN'LAST AS " &
+                             "SUBTYPE" );
+               END IF;
+          END R;
+
+          PROCEDURE P1 IS NEW P
+          ( BOOL => BOOLEAN, F => IDENT_BOOL(FALSE),
+                                              L => IDENT_BOOL(TRUE) );
+
+          PROCEDURE P2 IS NEW P
+          ( BOOL => TBOOL, F => IDENT_BOOL(TRUE),
+                                              L => IDENT_BOOL(TRUE) );
+
+          PROCEDURE P3 IS NEW P
+          ( BOOL => FBOOL, F => IDENT_BOOL(FALSE),
+                                             L => IDENT_BOOL(FALSE) );
+
+          PROCEDURE P4 IS NEW P
+                         (BOOL => NEWBOOL, F => FALSE, L => TRUE );
+
+          PROCEDURE Q1 IS NEW Q
+                         ( BOOL => NOBOOL );
+
+          PROCEDURE R1 IS NEW R
+                         ( BOOL => BOOLEAN, F => FALSE, L => TRUE );
+
+     BEGIN
+          P1 ( "BOOLEAN" );
+          P2 ( "TBOOL" );
+          P3 ( "FBOOL" );
+          P4 ( "NEWBOOL" );
+          Q1;
+          R1;
+     END;
+
+     RESULT;
+END C35508P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35703a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35703a.ada
new file mode 100644
index 000000000..6980f3c9f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35703a.ada
@@ -0,0 +1,142 @@
+-- C35703A.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 AND 'LAST EXIST AND CAN BE ASSIGNED.  CHECK THAT
+-- 'FIRST IS LESS THAN OR EQUAL TO 'LAST.
+
+-- BAW 5 SEPT 80
+-- R.WILLIAMS 8/21/86    ADDED A TYPE DECLARED WITHOUT A RANGE
+--                       CONSTRAINT.  RENAMED TO -B.  ADDED EXCEPTION
+--                       HANDLERS.
+-- GMT 6/29/87           MOVED THE CALL TO  REPORT.TEST INTO A NEWLY
+--                       CREATED PACKAGE NAMED SHOW_TEST_HEADER.
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35703A IS
+
+     TYPE REAL1 IS DIGITS 2 RANGE 0.25..0.5;
+     TYPE REAL2 IS DIGITS 3;
+
+     PACKAGE  SHOW_TEST_HEADER  IS
+              -- PURPOSE OF THIS PACKAGE:
+              -- WE WANT THE TEST HEADER INFORMATION TO BE
+              -- PRINTED  BEFORE  ANY OF THE  PASS/FAIL  MESSAGES.
+     END SHOW_TEST_HEADER;
+
+     PACKAGE  BODY  SHOW_TEST_HEADER  IS
+     BEGIN
+          TEST( "C35703A",
+                "CHECK THAT FIRST AND LAST CAN BE ASSIGNED " &
+                "AND THAT FIRST <= LAST" );
+     END SHOW_TEST_HEADER;
+
+     PACKAGE XPKG IS
+          X : REAL1;
+     END XPKG;
+
+     PACKAGE BODY XPKG IS
+     BEGIN
+          X := REAL1'FIRST;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
+                        "REAL1'FIRST" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
+                        "REAL1'FIRST" );
+     END XPKG;
+
+     PACKAGE YPKG IS
+          Y : REAL1;
+     END YPKG;
+
+     PACKAGE BODY YPKG IS
+     BEGIN
+          Y := REAL1'LAST;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
+                        "REAL1'LAST" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
+                        "REAL1'LAST" );
+     END YPKG;
+
+     PACKAGE APKG IS
+          A : REAL2;
+     END APKG;
+
+     PACKAGE BODY APKG IS
+     BEGIN
+          A := REAL2'FIRST;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
+                        "REAL2'FIRST" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
+                        "REAL2'FIRST" );
+     END APKG;
+
+     PACKAGE BPKG IS
+          B : REAL2;
+     END BPKG;
+
+     PACKAGE BODY BPKG IS
+     BEGIN
+          B := REAL2'LAST;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED BY ASSIGNMENT OF " &
+                        "REAL2'LAST" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED BY ASSIGNMENT OF " &
+                        "REAL2'LAST" );
+     END BPKG;
+
+
+BEGIN
+
+     DECLARE
+          USE XPKG;
+          USE YPKG;
+     BEGIN
+          IF X > Y THEN
+               FAILED ( "REAL1'FIRST IS GREATER THAN REAL1'LAST" );
+          END IF;
+     END;
+
+     DECLARE
+          USE APKG;
+          USE BPKG;
+     BEGIN
+          IF A > B THEN
+               FAILED ( "REAL2'FIRST IS GREATER THEN REAL2'LAST" );
+          END IF;
+     END;
+
+     RESULT;
+
+END C35703A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704a.ada
new file mode 100644
index 000000000..e1e8532f4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704a.ada
@@ -0,0 +1,60 @@
+-- C35704A.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 FIXED POINT VALUES CAN BE USED IN FLOATING POINT RANGE
+-- CONSTRAINT IN TYPE DEFINITION.
+
+-- BAW 9/5/80
+-- JCR 4/7/82
+
+WITH REPORT;
+PROCEDURE C35704A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C35704A","CHECK THAT L AND R CAN BE FIXED POINT" &
+           " IN A FLOATING POINT TYPE DEFINITION");
+
+     DECLARE
+
+
+          TYPE F IS DELTA 0.5 RANGE -5.0..5.0;
+
+          F1 : CONSTANT F := -4.0;
+          F2 : CONSTANT F := 4.0;
+
+          TYPE G1 IS DIGITS 5 RANGE F1..F2;
+     BEGIN
+
+          IF (ABS(G1'FIRST)-4.0) /= 0.0 OR
+             (ABS(G1'LAST)-4.0)  /= 0.0
+          THEN FAILED ("ERROR IN USING FIXED-POINT IN RANGE " &
+                       "CONSTRAINT");
+          END IF;
+
+     END;
+     RESULT;
+
+END C35704A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704b.ada
new file mode 100644
index 000000000..7efae7783
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704b.ada
@@ -0,0 +1,62 @@
+-- C35704B.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 DIFFERENT FLOATING POINT TYPES FROM SAME PARENT CAN BE
+-- USED IN A FLOATING POINT RANGE CONSTRAINT IN A TYPE DEFINITION.
+
+-- JCR 4/7/82
+
+WITH REPORT;
+PROCEDURE C35704B IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C35704B", "DIFFERENT FLOATING POINT TYPES " &
+           "FROM THE SAME PARENT IN FLOATING POINT" &
+           "TYPE DEFINITION'S RANGE CONSTRAINT");
+
+     DECLARE
+          TYPE F IS  DIGITS 5 RANGE -5.0 .. 5.0;
+
+          TYPE F1 IS NEW F;
+
+          TYPE G1 IS DIGITS 5 RANGE F1'FIRST..F'LAST;
+          TYPE G2 IS DIGITS 5 RANGE F'FIRST..F1'LAST;
+
+     BEGIN
+
+          IF G1'FIRST /= G1(G2'FIRST) OR G1'LAST /= G1(G2'LAST) OR
+             G2'FIRST /= G2(F'FIRST) OR G2'LAST /= G2(F'LAST)
+          THEN 
+               FAILED ("USING DIFF FLOATING POINT TYPES " &
+                       "FROM SAME PARENT");
+
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C35704B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704c.ada
new file mode 100644
index 000000000..2b0fe3b32
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704c.ada
@@ -0,0 +1,62 @@
+-- C35704C.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 DIFFERENT FLOATING POINT TYPES FROM DIFFERENT PARENTS
+-- CAN BE USE IN FLOATING POINT RANGE CONSTRAINTS IN TYPE DEFINITIONS.
+
+-- JCR 4/7/82
+
+WITH REPORT;
+PROCEDURE C35704C IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C35704C", "DIFFERENT FLOATING POINT TYPES " &
+           "FROM DIFFERENT PARENTS IN FLOATING POINT RANGE " &
+           "CONSTRAINT IN TYPE DEFINITION");
+
+     DECLARE
+
+          TYPE F IS DIGITS 5 RANGE -5.0 .. 5.0;
+          TYPE F1 IS DIGITS 5 RANGE -5.0 .. 5.0;
+     
+          TYPE G1 IS DIGITS 5 RANGE  F'FIRST..F1'LAST;
+          TYPE G2 IS DIGITS 5 RANGE F1'FIRST..F'LAST;
+     
+     BEGIN
+
+
+          IF G1'FIRST /= G1(F'FIRST) OR G1'FIRST /= G1(G2'FIRST) OR
+          G1'FIRST /= G1(F1'FIRST) OR G1'LAST /= G1(F'LAST) OR
+          G1'LAST /= G1(G2'LAST) OR G1'LAST /= G1(F1'LAST)
+
+          THEN FAILED ("USING FLOAT FROM DIFF PARENTS");
+
+          END IF;
+     END;
+
+     RESULT;
+
+END C35704C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704d.ada
new file mode 100644
index 000000000..0afd81de1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35704d.ada
@@ -0,0 +1,70 @@
+-- C35704D.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 COMBINATION OF FIXED AND FLOAT CAN BE USED IN A
+-- FLOATING POINT RANGE CONSTRAINT IN A TYPE DEFINITION.
+
+-- JCR 4/7/82
+
+WITH REPORT;
+PROCEDURE C35704D IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C35704D","MIXED FIXED AND FLOAT IN FLOATING " &
+           "POINT RANGE CONSTRAINT IN A TYPE DEFINITION");
+
+     DECLARE
+
+          TYPE F IS DIGITS 5;
+          TYPE R IS DELTA 0.5 RANGE -5.0 .. 5.0;
+
+          T1 : CONSTANT F := -4.0;
+          T2 : CONSTANT F := 4.0;
+
+          R1 : CONSTANT R := -4.0;
+          R2 : CONSTANT R := 4.0;
+
+          TYPE G1 IS DIGITS 5 RANGE T1..R2;
+          TYPE G2 IS DIGITS 5 RANGE R1..T2;
+
+     BEGIN
+
+          IF (ABS(G1'FIRST)- 4.0) /= 0.0  OR
+             (ABS(G1'LAST) - 4.0) /= 0.0  OR
+             (ABS(G2'FIRST)- 4.0) /= 0.0  OR
+             (ABS(G2'LAST) - 4.0) /= 0.0
+     
+          THEN FAILED ("MIXED FIXED AND FLOAT IN FLOAT RANGE " &
+                       "CONSTRAINT");
+     
+          END IF;
+
+     END;
+
+     RESULT;
+ 
+
+END C35704D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35801d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35801d.ada
new file mode 100644
index 000000000..5ee825904
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35801d.ada
@@ -0,0 +1,79 @@
+-- C35801D.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 GENERIC FORMAL 
+-- SUBTYPE WHOSE ACTUAL ARGUMENT IS A FLOATING POINT TYPE.
+
+-- R.WILLIAMS 8/21/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35801D IS
+     TYPE REAL IS DIGITS 3 RANGE -100.0 .. 100.0;
+
+     TYPE NFLT IS NEW FLOAT;
+
+     GENERIC
+          TYPE F IS DIGITS <>;
+     PROCEDURE P (STR : STRING);
+
+     PROCEDURE P (STR : STRING) IS
+
+          SUBTYPE SF IS F RANGE -1.0 .. 1.0;
+          F1 : SF := 0.0;
+          F2 : SF := 0.0;
+          
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               F1 := SF'FIRST;
+               F2 := SF'LAST;
+          END IF;
+
+          IF F1 /= -1.0 OR F2 /= 1.0 THEN
+               FAILED ( "WRONG RESULTS FROM " & STR & "'FIRST OR " &
+                        STR & "'LAST" );
+          END IF;
+     END P;
+     
+     PROCEDURE NP1 IS NEW P (FLOAT);
+
+     PROCEDURE NP2 IS NEW P (NFLT);
+
+     PROCEDURE NP3 IS NEW P (REAL);
+
+BEGIN
+     TEST ( "C35801D", "CHECK THAT THE ATTRIBUTES FIRST AND " &
+                       "LAST RETURN VALUES HAVING THE SAME " &
+                       "BASE TYPE AS THE PREFIX WHEN THE " &
+                       "PREFIX IS A GENERIC FORMAL SUBTYPE " &
+                       "WHOSE ACTUAL ARGUMENT IS A FLOATING " &
+                       "POINT TYPE" );
+
+
+     NP1 ("FLOAT");
+     NP2 ("NFLT");
+     NP3 ("REAL");
+
+     RESULT;     
+END C35801D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35902d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35902d.ada
new file mode 100644
index 000000000..c09fe5894
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35902d.ada
@@ -0,0 +1,121 @@
+-- C35902D.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 BINARY POINT IN THE MANTISSA OF A FIXED POINT NUMBER
+-- CAN LIE OUTSIDE THE MANTISSA (EITHER TO THE LEFT OR TO THE RIGHT).
+
+-- WRG 7/18/86
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C35902D IS
+
+BEGIN
+
+     TEST ("C35902D", "CHECK THAT THE BINARY POINT IN THE MANTISSA " &
+                      "OF A FIXED POINT NUMBER CAN LIE OUTSIDE THE " &
+                      "MANTISSA (EITHER TO THE LEFT OR TO THE RIGHT)");
+
+     COMMENT ("VALUE OF SYSTEM.MAX_MANTISSA IS" &
+              POSITIVE'IMAGE(MAX_MANTISSA) );
+
+  A: DECLARE
+
+          RS : CONSTANT := 2.0;
+
+          TYPE ONE_TO_THE_RIGHT IS
+               DELTA RS
+               RANGE -(2.0 ** (MAX_MANTISSA+1) ) ..
+                       2.0 ** (MAX_MANTISSA+1);
+               -- THE BINARY POINT IS ONE PLACE TO THE RIGHT OF THE
+               -- LARGEST POSSIBLE MANTISSA.
+
+          R1, R2 : ONE_TO_THE_RIGHT;
+
+     BEGIN
+
+          R1 := RS;
+          FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
+               R1 := R1 * IDENT_INT (2);
+          END LOOP;
+          R2 := R1 - RS;
+          R2 := R2 + R1;
+          -- AT THIS POINT, R2 SHOULD EQUAL ONE_TO_THE_RIGHT'LARGE.
+          R2 := -R2;
+          R2 := R2 + (R1 - RS);
+          FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
+               R2 := R2 / IDENT_INT (2);
+          END LOOP;
+          IF R2 /= -RS THEN
+               FAILED ("IDENTITY-PRESERVING OPERATIONS ARE FLAKY - A");
+          END IF;
+
+     EXCEPTION
+
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - A");
+
+     END A;
+
+  B: DECLARE
+
+          LS : CONSTANT := 2.0 ** (-(MAX_MANTISSA+1) );
+
+          TYPE ONE_TO_THE_LEFT IS
+               DELTA LS
+               RANGE -(2.0 ** (-1) ) ..
+                       2.0 ** (-1);
+               -- THE BINARY POINT IS ONE PLACE TO THE LEFT OF THE
+               -- LARGEST POSSIBLE MANTISSA.
+
+          L1, L2 : ONE_TO_THE_LEFT;
+
+     BEGIN
+
+          L1 := LS;
+          FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
+               L1 := L1 * IDENT_INT (2);
+          END LOOP;
+          L2 := L1 - LS;
+          L2 := L2 + L1;
+          -- AT THIS POINT, L2 SHOULD EQUAL ONE_TO_THE_LEFT'LARGE.
+          L2 := -L2;
+          L2 := L2 + (L1 - LS);
+          FOR I IN POSITIVE RANGE 1 .. MAX_MANTISSA - 1 LOOP
+               L2 := L2 / IDENT_INT (2);
+          END LOOP;
+          IF L2 /= -LS THEN
+               FAILED ("IDENTITY-PRESERVING OPERATIONS ARE FLAKY - B");
+          END IF;
+
+     EXCEPTION
+
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - B");
+
+     END B;
+
+     RESULT;
+
+END C35902D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35904a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35904a.ada
new file mode 100644
index 000000000..8b3bfbba6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35904a.ada
@@ -0,0 +1,103 @@
+-- C35904A.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 INCOMPATIBLE FIXED POINT CONSTRAINTS RAISE
+--     APPROPRIATE EXCEPTIONS.
+ 
+ 
+-- HISTORY:
+--     RJK 05/17/83  CREATED ORIGINAL TEST.
+--     PWB 02/03/86  CORRECTED TEST ERROR:
+--                   ADDED POSSIBLITY OF NUMERIC_ERROR
+--                   IN DECLARATIONS OF SFX3 AND SFX4.
+--     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  CHANGED RANGE
+--                   CONSTRAINTS OF SUBTYPE SFX1.  CHANGED UPPER BOUND
+--                   OF THE CONSTRAINT OF SFX4.  CHANGED RANGE
+--                   CONSTRAINTS OF FIX.
+--     JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+--     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
+--     EDS 07/16/98  AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35904A IS
+
+     TYPE FIX IS DELTA 0.5 RANGE -3.0 .. 3.0;
+
+BEGIN
+
+     TEST ("C35904A", "CHECK THAT INCOMPATIBLE FIXED POINT " &
+                      "CONSTRAINTS RAISE APPROPRIATE EXCEPTION");
+ 
+-- TEST FOR CORRECT SUBTYPE DEFINITION FOR COMPATIBILITY BETWEEN TYPE
+-- AND SUBTYPE CONSTRAINTS.
+ 
+     BEGIN
+ 
+          DECLARE
+ 
+               SUBTYPE SFX1 IS FIX DELTA 1.0 RANGE 0.0 .. 2.0;   -- OK.
+               SFX1_VAR : SFX1;
+ 
+          BEGIN
+               SFX1_VAR := 1.0;
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+                FAILED ("FIXED POINT CONSTRAINTS ARE NOT IN ERROR");
+          WHEN OTHERS =>
+                FAILED ("EXCEPTION SHOULD NOT BE RAISED WHILE " &
+                        "CHECKING DELTA CONSTRAINT");
+     END;
+
+-- TEST FOR INCORRECT SUBTYPE DEFINITION ON ACCURACY BETWEEN TYPE AND
+-- SUBTYPE DEFINITIONS.
+
+     BEGIN
+
+          DECLARE
+
+               SUBTYPE SFX IS FIX DELTA 0.1;  -- DELTA IS SMALLER FOR
+                                              -- SUBTYPE THAN FOR TYPE.
+               -- DEFINE AN OBJECT OF SUBTYPE SFX AND USE IT TO AVOID 
+               -- OPTIMIZATION OF SUBTYPE
+               SFX_VAR : SFX := FIX(IDENT_INT(1));
+
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED FOR INCOMPATABLE DELTA " & 
+                       FIX'IMAGE(SFX_VAR) );  --USE SFX_VAR
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
+                       "DELTA CONSTRAINT");
+     END;
+
+     RESULT;
+
+END C35904A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35904b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35904b.ada
new file mode 100644
index 000000000..cff7d2ec8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35904b.ada
@@ -0,0 +1,136 @@
+-- C35904B.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 INCOMPATIBLE FIXED POINT CONSTRAINTS RAISE
+-- CONSTRAINT_ERROR FOR GENERIC FORMAL TYPES.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- RJW 6/20/86
+-- DWC 07/24/87     -- ADDED NUMERIC_ERROR HANDLERS.
+-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+-- EDS 07/16/98 AVOID OPTIMIZATION 
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35904B IS
+
+     GENERIC
+          TYPE FIX IS DELTA <>;
+     PROCEDURE PROC (STR : STRING);
+
+     PROCEDURE PROC (STR : STRING) IS
+          SUBTYPE SFIX IS FIX DELTA 0.1 RANGE -1.0 .. 1.0;
+          -- DEFINE AN OBJECT OF SUBTYPE SFIX AND USE IT TO AVOID 
+          -- OPTIMIZATION OF SUBTYPE
+          SFIX_VAR : SFIX := SFIX(IDENT_INT(0));
+     BEGIN
+          FAILED ("NO EXCEPTION RAISED FOR " & STR & " " &
+                  SFIX'IMAGE(SFIX_VAR) );  --USE SFIX_VAR
+     END PROC;
+
+BEGIN
+
+     TEST ( "C35904B", "CHECK THAT INCOMPATIBLE FIXED POINT " &
+                       "CONSTRAINTS RAISE CONSTRAINT_ERROR " &
+                       "FOR GENERIC FORMAL TYPES" );
+
+-- TEST FOR INCORRECT SUBTYPE DEFINITION ON ACCURACY BETWEEN TYPE AND
+-- SUBTYPE DEFINITIONS.
+
+     BEGIN
+
+          DECLARE
+
+               TYPE FIX1 IS DELTA 0.5          -- DELTA IS SMALLER FOR
+                         RANGE -2.0 .. 2.0;    -- SUBTYPE THEN FOR
+                                               -- TYPE.
+
+               PROCEDURE NPROC IS NEW PROC (FIX1);
+
+          BEGIN
+               NPROC ( "INCOMPATIBLE DELTA" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
+                       "DELTA CONSTRAINT");
+     END;
+
+-- TEST THAT CONSTRAINT_ERROR IS RAISED
+-- FOR A RANGE VIOLATION.
+
+     BEGIN
+
+          DECLARE
+
+               TYPE FIX2 IS DELTA 0.1 RANGE 0.0 .. 2.0; -- LOWER
+                                                        -- BOUND.
+
+               PROCEDURE NPROC IS NEW PROC (FIX2);
+
+          BEGIN
+               NPROC ("FIXED POINT LOWER BOUND CONSTRAINT VIOLATION");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED FOR " &
+                        "LOWER BOUND VIOLATION");
+          WHEN OTHERS =>
+               FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
+                       "FIXED POINT LOWER BOUND CONSTRAINT");
+     END;
+
+-- TEST THAT CONSTRAINT_ERROR IS RAISED
+-- FOR A RANGE VIOLATION.
+
+     BEGIN
+
+          DECLARE
+
+               TYPE FIX3 IS DELTA 0.1 RANGE -2.0 .. 0.0;  -- UPPER
+                                                          -- BOUND.
+
+               PROCEDURE NPROC IS NEW PROC (FIX3);
+          BEGIN
+               NPROC ("FIXED POINT UPPER BOUND CONSTRAINT VIOLATION");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED FOR " &
+                        "UPPER BOUND VIOLATION");
+          WHEN OTHERS =>
+               FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
+                       "FIXED POINT UPPER BOUND CONSTRAINT");
+     END;
+
+     RESULT;
+
+END C35904B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a02a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a02a.ada
new file mode 100644
index 000000000..5ebee358d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a02a.ada
@@ -0,0 +1,75 @@
+-- C35A02A.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 T'DELTA YIELDS CORRECT VALUES FOR SUBTYPE T.
+
+-- RJW 2/27/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35A02A IS
+
+BEGIN
+
+     TEST ( "C35A02A", "CHECK THAT T'DELTA YIELDS CORRECT VALUES " &
+                       "FOR SUBTYPE T" );
+                              
+     DECLARE
+          D  : CONSTANT := 0.125;
+          SD : CONSTANT := 1.0;
+     
+          TYPE VOLT IS DELTA D RANGE 0.0 .. 255.0;
+          SUBTYPE ROUGH_VOLTAGE IS VOLT DELTA SD;
+
+          GENERIC
+               TYPE FIXED IS DELTA <> ;
+          FUNCTION F RETURN FIXED;
+
+          FUNCTION F RETURN FIXED IS
+          BEGIN
+               RETURN FIXED'DELTA;
+          END F;
+
+          FUNCTION VF IS NEW F (VOLT);
+          FUNCTION RF IS NEW F (ROUGH_VOLTAGE);
+
+     BEGIN 
+          IF VOLT'DELTA /= D THEN
+               FAILED ( "INCORRECT VALUE FOR VOLT'DELTA" );
+          END IF;
+          IF ROUGH_VOLTAGE'DELTA /= SD THEN 
+               FAILED ( "INCORRECT VALUE FOR ROUGH_VOLTAGE'DELTA" );
+          END IF;
+
+          IF VF /= D THEN
+               FAILED ( "INCORRECT VALUE FOR VF" );
+          END IF;
+          IF RF /= SD THEN
+               FAILED ( "INCORRECT VALUE FOR RF" );
+          END IF;
+     END;               
+
+     RESULT;
+
+END C35A02A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05a.ada
new file mode 100644
index 000000000..c850249d4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05a.ada
@@ -0,0 +1,153 @@
+-- C35A05A.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 FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
+-- THE CORRECT VALUES.
+
+-- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+
+-- WRG 8/8/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35A05A IS
+
+     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+     -- 'MANTISSA VALUE.
+
+     TYPE LEFT_OUT_M1       IS DELTA 0.25  RANGE -0.5 .. 0.5;
+     TYPE LEFT_EDGE_M1      IS DELTA 0.5   RANGE -1.0 .. 1.0;
+     TYPE RIGHT_EDGE_M1     IS DELTA 1.0   RANGE -2.0 .. 2.0;
+     TYPE RIGHT_OUT_M1      IS DELTA 2.0   RANGE -4.0 .. 4.0;
+     TYPE MIDDLE_M2         IS DELTA 0.5   RANGE -2.0 .. 2.0;
+     TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
+     TYPE MIDDLE_M15        IS DELTA 2.0 **(-6) RANGE  -512.0 ..  512.0;
+     TYPE MIDDLE_M16        IS DELTA 2.0 **(-6) RANGE -1024.0 .. 1024.0;
+     TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+     TYPE DECIMAL_M18       IS DELTA 0.1   RANGE -10_000.0 .. 10_000.0;
+     TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
+     TYPE DECIMAL_M11       IS DELTA 0.09999 RANGE  -100.0 ..    100.0;
+     TYPE DECIMAL2_M18      IS DELTA 0.1   RANGE   -9999.0 ..   9999.0;
+
+     -------------------------------------------------------------------
+
+     SUBTYPE ST_LEFT_EDGE_M6 IS MIDDLE_M15
+          DELTA 2.0 ** (-6) RANGE IDENT_INT (1) * (-1.0) .. 1.0;
+     SUBTYPE ST_MIDDLE_M14   IS MIDDLE_M16
+          DELTA 2.0 ** (-5) RANGE -512.0 .. IDENT_INT (1) * 512.0;
+     SUBTYPE ST_MIDDLE_M2    IS LIKE_DURATION_M23
+          DELTA 0.5 RANGE -2.0 .. 2.0;
+     SUBTYPE ST_MIDDLE_M3    IS LIKE_DURATION_M23
+          DELTA 0.5 RANGE  0.0 .. 2.5;
+     SUBTYPE ST_DECIMAL_M7   IS DECIMAL_M18
+          DELTA  10.0 RANGE -1000.0 .. 1000.0;
+     SUBTYPE ST_DECIMAL_M3   IS DECIMAL_M4
+          DELTA 100.0 RANGE  -500.0 ..  500.0;
+
+     -------------------------------------------------------------------
+
+     PROCEDURE CHECK_FORE_AND_AFT
+         (NAME        : STRING;
+          ACTUAL_FORE : INTEGER; CORRECT_FORE : POSITIVE;
+          ACTUAL_AFT  : INTEGER; CORRECT_AFT  : POSITIVE) IS
+     BEGIN
+          IF ACTUAL_FORE /= IDENT_INT (CORRECT_FORE) THEN
+               FAILED (NAME & "'FORE =" & INTEGER'IMAGE(ACTUAL_FORE) );
+          END IF;
+          IF ACTUAL_AFT /= IDENT_INT (CORRECT_AFT) THEN
+               FAILED (NAME & "'AFT  =" & INTEGER'IMAGE(ACTUAL_AFT) );
+          END IF;
+     END CHECK_FORE_AND_AFT;
+
+BEGIN
+
+     TEST ("C35A05A", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
+                      "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
+                      "BASIC TYPES");
+
+     CHECK_FORE_AND_AFT ("LEFT_OUT_M1",       LEFT_OUT_M1'FORE, 2,
+                                              LEFT_OUT_M1'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("LEFT_EDGE_M1",      LEFT_EDGE_M1'FORE, 2,
+                                              LEFT_EDGE_M1'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("RIGHT_EDGE_M1",     RIGHT_EDGE_M1'FORE, 2,
+                                              RIGHT_EDGE_M1'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("RIGHT_OUT_M1",      RIGHT_OUT_M1'FORE, 2,
+                                              RIGHT_OUT_M1'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("MIDDLE_M2",         MIDDLE_M2'FORE, 2,
+                                              MIDDLE_M2'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("MIDDLE_M3",         MIDDLE_M3'FORE, 2,
+                                              MIDDLE_M3'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("MIDDLE_M15",        MIDDLE_M15'FORE, 4,
+                                              MIDDLE_M15'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("MIDDLE_M16",        MIDDLE_M16'FORE, 5,
+                                              MIDDLE_M16'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("LIKE_DURATION_M23", LIKE_DURATION_M23'FORE, 6,
+                                              LIKE_DURATION_M23'AFT, 2);
+
+     CHECK_FORE_AND_AFT ("DECIMAL_M18",       DECIMAL_M18'FORE, 6,
+                                              DECIMAL_M18'AFT,  1);
+
+     IF DECIMAL_M4'FORE /= 5 AND DECIMAL_M4'FORE /= 4 THEN
+          FAILED ("DECIMAL_M4'FORE =" &
+                  INTEGER'IMAGE(DECIMAL_M4'FORE) );
+     END IF;
+     IF DECIMAL_M4'AFT /= 1 THEN
+          FAILED ("DECIMAL_M4'AFT  =" &
+                  INTEGER'IMAGE(DECIMAL_M4'AFT) );
+     END IF;
+
+     CHECK_FORE_AND_AFT ("DECIMAL_M11",       DECIMAL_M11'FORE, 4,
+                                              DECIMAL_M11'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("DECIMAL2_M18",      DECIMAL2_M18'FORE, 5,
+                                              DECIMAL2_M18'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("ST_LEFT_EDGE_M6",   ST_LEFT_EDGE_M6'FORE, 2,
+                                              ST_LEFT_EDGE_M6'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("ST_MIDDLE_M14",     ST_MIDDLE_M14'FORE, 4,
+                                              ST_MIDDLE_M14'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("ST_MIDDLE_M2",      ST_MIDDLE_M2'FORE, 2,
+                                              ST_MIDDLE_M2'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("ST_MIDDLE_M3",      ST_MIDDLE_M3'FORE, 2,
+                                              ST_MIDDLE_M3'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("ST_DECIMAL_M7",     ST_DECIMAL_M7'FORE, 5,
+                                              ST_DECIMAL_M7'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("ST_DECIMAL_M3",     ST_DECIMAL_M3'FORE, 4,
+                                              ST_DECIMAL_M3'AFT,  1);
+
+     RESULT;
+
+END C35A05A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05d.ada
new file mode 100644
index 000000000..9b07671f5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05d.ada
@@ -0,0 +1,153 @@
+-- C35A05D.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 FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
+-- THE CORRECT VALUES.
+
+-- CASE D: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC.
+
+-- WRG 8/14/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35A05D IS
+
+     PI      : CONSTANT := 3.14159_26535_89793_23846;
+     TWO_PI  : CONSTANT := 2 * PI;
+     HALF_PI : CONSTANT := PI / 2;
+
+     MM : CONSTANT := 23;
+
+     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+     -- 'MANTISSA VALUE.
+
+     TYPE MICRO_ANGLE_ERROR_M15  IS
+          DELTA 16.0  RANGE -(2.0 ** 19) .. 2.0 ** 19;
+     TYPE TRACK_RANGE_M15        IS
+          DELTA 0.125 RANGE -(2.0 ** 12) .. 2.0 ** 12;
+     TYPE SECONDS_MM             IS
+          DELTA 2.0 ** (8 - MM) RANGE -(2.0 ** 8) .. 2.0 ** 8;
+     TYPE RANGE_CELL_MM          IS
+          DELTA 2.0 ** (-5)
+          RANGE -(2.0 ** (MM - 5) ) .. 2.0 ** (MM - 5);
+
+     TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
+     TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
+
+     TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
+     TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
+
+     TYPE SYMMETRIC_DEGREES_M7  IS
+          DELTA 2.0         RANGE -180.0 .. 180.0;
+     TYPE NATURAL_DEGREES_M15   IS
+          DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
+     TYPE SYMMETRIC_RADIANS_M16 IS
+          DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
+     TYPE NATURAL_RADIANS_M8    IS
+          DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
+
+     -------------------------------------------------------------------
+
+     SUBTYPE ST_MILES_M8             IS MILES_M16
+          DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
+     SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
+          DELTA 0.25 RANGE 0.0 .. 360.0;
+     SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
+          DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
+
+     -------------------------------------------------------------------
+
+     PROCEDURE CHECK_FORE_AND_AFT
+         (NAME        : STRING;
+          ACTUAL_FORE : INTEGER; CORRECT_FORE : POSITIVE;
+          ACTUAL_AFT  : INTEGER; CORRECT_AFT  : POSITIVE) IS
+     BEGIN
+          IF ACTUAL_FORE /= IDENT_INT (CORRECT_FORE) THEN
+               FAILED (NAME & "'FORE =" & INTEGER'IMAGE(ACTUAL_FORE) );
+          END IF;
+          IF ACTUAL_AFT /= IDENT_INT (CORRECT_AFT) THEN
+               FAILED (NAME & "'AFT  =" & INTEGER'IMAGE(ACTUAL_AFT) );
+          END IF;
+     END CHECK_FORE_AND_AFT;
+
+BEGIN
+
+     TEST ("C35A05D", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
+                      "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
+                      "TYPICAL TYPES");
+
+     CHECK_FORE_AND_AFT ("MICRO_ANGLE_ERROR_M15",
+                                         MICRO_ANGLE_ERROR_M15'FORE, 7,
+                                         MICRO_ANGLE_ERROR_M15'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("TRACK_RANGE_M15", TRACK_RANGE_M15'FORE, 5,
+                                            TRACK_RANGE_M15'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("SECONDS_MM",      SECONDS_MM'FORE, 4,
+                                            SECONDS_MM'AFT,  5);
+
+     CHECK_FORE_AND_AFT ("RANGE_CELL_MM",   RANGE_CELL_MM'FORE, 7,
+                                            RANGE_CELL_MM'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("PIXEL_M10",       PIXEL_M10'FORE, 2,
+                                            PIXEL_M10'AFT,  4);
+
+     CHECK_FORE_AND_AFT ("RULER_M8",        RULER_M8'FORE, 3,
+                                            RULER_M8'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("HOURS_M16",       HOURS_M16'FORE, 3,
+                                            HOURS_M16'AFT,  4);
+
+     CHECK_FORE_AND_AFT ("MILES_M16",       MILES_M16'FORE, 5,
+                                            MILES_M16'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("SYMMETRIC_DEGREES_M7",
+                                         SYMMETRIC_DEGREES_M7'FORE, 4,
+                                         SYMMETRIC_DEGREES_M7'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("NATURAL_DEGREES_M15",
+                                         NATURAL_DEGREES_M15'FORE, 4,
+                                         NATURAL_DEGREES_M15'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("SYMMETRIC_RADIANS_M16",
+                                         SYMMETRIC_RADIANS_M16'FORE, 2,
+                                         SYMMETRIC_RADIANS_M16'AFT,  5);
+
+     CHECK_FORE_AND_AFT ("NATURAL_RADIANS_M8",
+                                         NATURAL_RADIANS_M8'FORE, 2,
+                                         NATURAL_RADIANS_M8'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("ST_MILES_M8",  ST_MILES_M8'FORE, 3,
+                                         ST_MILES_M8'AFT,  2);
+
+     CHECK_FORE_AND_AFT ("ST_NATURAL_DEGREES_M11",
+                                       ST_NATURAL_DEGREES_M11'FORE, 4,
+                                       ST_NATURAL_DEGREES_M11'AFT,  1);
+
+     CHECK_FORE_AND_AFT ("ST_SYMMETRIC_RADIANS_M8",
+                                       ST_SYMMETRIC_RADIANS_M8'FORE, 2,
+                                       ST_SYMMETRIC_RADIANS_M8'AFT,  2);
+
+     RESULT;
+
+END C35A05D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05n.ada
new file mode 100644
index 000000000..4c1102d58
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05n.ada
@@ -0,0 +1,160 @@
+-- C35A05N.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 FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
+-- THE CORRECT VALUES.
+
+-- CASE N: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE,
+--         FOR GENERICS.
+
+-- WRG 8/15/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35A05N IS
+
+     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+     -- 'MANTISSA VALUE.
+
+     TYPE LEFT_OUT_M1       IS DELTA 0.25  RANGE -0.5 .. 0.5;
+     TYPE LEFT_EDGE_M1      IS DELTA 0.5   RANGE -1.0 .. 1.0;
+     TYPE RIGHT_EDGE_M1     IS DELTA 1.0   RANGE -2.0 .. 2.0;
+     TYPE RIGHT_OUT_M1      IS DELTA 2.0   RANGE -4.0 .. 4.0;
+     TYPE MIDDLE_M2         IS DELTA 0.5   RANGE -2.0 .. 2.0;
+     TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
+     TYPE MIDDLE_M15        IS DELTA 2.0 **(-6) RANGE  -512.0 ..  512.0;
+     TYPE MIDDLE_M16        IS DELTA 2.0 **(-6) RANGE -1024.0 .. 1024.0;
+     TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+     TYPE DECIMAL_M18       IS DELTA 0.1   RANGE -10_000.0 .. 10_000.0;
+     TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
+     TYPE DECIMAL_M11       IS DELTA 0.09999 RANGE  -100.0 ..    100.0;
+     TYPE DECIMAL2_M18      IS DELTA 0.1   RANGE   -9999.0 ..   9999.0;
+
+     -------------------------------------------------------------------
+
+     SUBTYPE ST_LEFT_EDGE_M6 IS MIDDLE_M15
+          DELTA 2.0 ** (-6) RANGE IDENT_INT (1) * (-1.0) .. 1.0;
+     SUBTYPE ST_MIDDLE_M14   IS MIDDLE_M16
+          DELTA 2.0 ** (-5) RANGE -512.0 .. IDENT_INT (1) * 512.0;
+     SUBTYPE ST_MIDDLE_M2    IS LIKE_DURATION_M23
+          DELTA 0.5 RANGE -2.0 .. 2.0;
+     SUBTYPE ST_MIDDLE_M3    IS LIKE_DURATION_M23
+          DELTA 0.5 RANGE  0.0 .. 2.5;
+     SUBTYPE ST_DECIMAL_M7   IS DECIMAL_M18
+          DELTA  10.0 RANGE -1000.0 .. 1000.0;
+     SUBTYPE ST_DECIMAL_M3   IS DECIMAL_M4
+          DELTA 100.0 RANGE  -500.0 ..  500.0;
+
+     -------------------------------------------------------------------
+
+     TYPE FORE_AND_AFT IS
+          RECORD
+               FORE, AFT : INTEGER;
+          END RECORD;
+
+     GENERIC
+          TYPE T IS DELTA <>;
+     FUNCTION ATTRIBUTES RETURN FORE_AND_AFT;
+
+     FUNCTION ATTRIBUTES RETURN FORE_AND_AFT IS
+     BEGIN
+          RETURN ( IDENT_INT (T'FORE), IDENT_INT (T'AFT) );
+     END ATTRIBUTES;
+
+     -------------------------------------------------------------------
+
+     PROCEDURE CHECK_ATTRIBUTES
+         (NAME : STRING;
+          ACTUAL_ATTRIBUTES, CORRECT_ATTRIBUTES : FORE_AND_AFT) IS
+     BEGIN
+          IF ACTUAL_ATTRIBUTES.FORE /= CORRECT_ATTRIBUTES.FORE THEN
+               FAILED ("GENERIC 'FORE FOR " & NAME & " =" &
+                       INTEGER'IMAGE(ACTUAL_ATTRIBUTES.FORE) );
+          END IF;
+          IF ACTUAL_ATTRIBUTES.AFT  /= CORRECT_ATTRIBUTES.AFT  THEN
+               FAILED ("GENERIC 'AFT  FOR " & NAME & " =" &
+                       INTEGER'IMAGE(ACTUAL_ATTRIBUTES.AFT ) );
+          END IF;
+     END CHECK_ATTRIBUTES;
+
+     -------------------------------------------------------------------
+
+     FUNCTION FA_LEFT_OUT_M1       IS NEW ATTRIBUTES(LEFT_OUT_M1      );
+     FUNCTION FA_LEFT_EDGE_M1      IS NEW ATTRIBUTES(LEFT_EDGE_M1     );
+     FUNCTION FA_RIGHT_EDGE_M1     IS NEW ATTRIBUTES(RIGHT_EDGE_M1    );
+     FUNCTION FA_RIGHT_OUT_M1      IS NEW ATTRIBUTES(RIGHT_OUT_M1     );
+     FUNCTION FA_MIDDLE_M2         IS NEW ATTRIBUTES(MIDDLE_M2        );
+     FUNCTION FA_MIDDLE_M3         IS NEW ATTRIBUTES(MIDDLE_M3        );
+     FUNCTION FA_MIDDLE_M15        IS NEW ATTRIBUTES(MIDDLE_M15       );
+     FUNCTION FA_MIDDLE_M16        IS NEW ATTRIBUTES(MIDDLE_M16       );
+     FUNCTION FA_LIKE_DURATION_M23 IS NEW ATTRIBUTES(LIKE_DURATION_M23);
+     FUNCTION FA_DECIMAL_M18       IS NEW ATTRIBUTES(DECIMAL_M18      );
+     FUNCTION FA_DECIMAL_M4        IS NEW ATTRIBUTES(DECIMAL_M4       );
+     FUNCTION FA_DECIMAL_M11       IS NEW ATTRIBUTES(DECIMAL_M11      );
+     FUNCTION FA_DECIMAL2_M18      IS NEW ATTRIBUTES(DECIMAL2_M18     );
+     FUNCTION FA_ST_LEFT_EDGE_M6   IS NEW ATTRIBUTES(ST_LEFT_EDGE_M6  );
+     FUNCTION FA_ST_MIDDLE_M14     IS NEW ATTRIBUTES(ST_MIDDLE_M14    );
+     FUNCTION FA_ST_MIDDLE_M2      IS NEW ATTRIBUTES(ST_MIDDLE_M2     );
+     FUNCTION FA_ST_MIDDLE_M3      IS NEW ATTRIBUTES(ST_MIDDLE_M3     );
+     FUNCTION FA_ST_DECIMAL_M7     IS NEW ATTRIBUTES(ST_DECIMAL_M7    );
+     FUNCTION FA_ST_DECIMAL_M3     IS NEW ATTRIBUTES(ST_DECIMAL_M3    );
+
+BEGIN
+
+     TEST ("C35A05N", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
+                      "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
+                      "BASIC TYPES, GENERICS");
+
+     CHECK_ATTRIBUTES ("LEFT_OUT_M1",     FA_LEFT_OUT_M1,     (2, 1) );
+     CHECK_ATTRIBUTES ("LEFT_EDGE_M1",    FA_LEFT_EDGE_M1,    (2, 1) );
+     CHECK_ATTRIBUTES ("RIGHT_EDGE_M1",   FA_RIGHT_EDGE_M1,   (2, 1) );
+     CHECK_ATTRIBUTES ("RIGHT_OUT_M1",    FA_RIGHT_OUT_M1,    (2, 1) );
+     CHECK_ATTRIBUTES ("MIDDLE_M2",       FA_MIDDLE_M2,       (2, 1) );
+     CHECK_ATTRIBUTES ("MIDDLE_M3",       FA_MIDDLE_M3,       (2, 1) );
+     CHECK_ATTRIBUTES ("MIDDLE_M15",      FA_MIDDLE_M15,      (4, 2) );
+     CHECK_ATTRIBUTES ("MIDDLE_M16",      FA_MIDDLE_M16,      (5, 2) );
+     CHECK_ATTRIBUTES ("LIKE_DURATION_M23",
+                                        FA_LIKE_DURATION_M23, (6, 2) );
+     CHECK_ATTRIBUTES ("DECIMAL_M18",     FA_DECIMAL_M18,     (6, 1) );
+
+     IF FA_DECIMAL_M4.FORE /= 5 AND FA_DECIMAL_M4.FORE /= 4 THEN
+          FAILED ("GENERIC 'FORE FOR DECIMAL_M4 =" &
+                  INTEGER'IMAGE(FA_DECIMAL_M4.FORE) );
+     END IF;
+     IF FA_DECIMAL_M4.AFT /= 1 THEN
+          FAILED ("GENERIC 'AFT  FOR DECIMAL_M4 =" &
+                  INTEGER'IMAGE(FA_DECIMAL_M4.AFT) );
+     END IF;
+
+     CHECK_ATTRIBUTES ("DECIMAL_M11",     FA_DECIMAL_M11,     (4, 2) );
+     CHECK_ATTRIBUTES ("DECIMAL2_M18",    FA_DECIMAL2_M18,    (5, 1) );
+     CHECK_ATTRIBUTES ("ST_LEFT_EDGE_M6", FA_ST_LEFT_EDGE_M6, (2, 2) );
+     CHECK_ATTRIBUTES ("ST_MIDDLE_M14",   FA_ST_MIDDLE_M14,   (4, 2) );
+     CHECK_ATTRIBUTES ("ST_MIDDLE_M2",    FA_ST_MIDDLE_M2,    (2, 1) );
+     CHECK_ATTRIBUTES ("ST_MIDDLE_M3",    FA_ST_MIDDLE_M3,    (2, 1) );
+     CHECK_ATTRIBUTES ("ST_DECIMAL_M7",   FA_ST_DECIMAL_M7,   (5, 1) );
+     CHECK_ATTRIBUTES ("ST_DECIMAL_M3",   FA_ST_DECIMAL_M3,   (4, 1) );
+
+     RESULT;
+
+END C35A05N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05q.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05q.ada
new file mode 100644
index 000000000..3a88ffb48
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a05q.ada
@@ -0,0 +1,184 @@
+-- C35A05Q.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 FIXED POINT TYPES THE FORE AND AFT ATTRIBUTES YIELD
+-- THE CORRECT VALUES.
+
+-- CASE Q: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC,
+--         FOR GENERICS.
+
+-- WRG 8/20/86
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C35A05Q IS
+
+     PI      : CONSTANT := 3.14159_26535_89793_23846;
+     TWO_PI  : CONSTANT := 2 * PI;
+     HALF_PI : CONSTANT := PI / 2;
+
+     MM : CONSTANT := 23;
+
+     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+     -- 'MANTISSA VALUE.
+
+     TYPE MICRO_ANGLE_ERROR_M15  IS
+          DELTA 16.0  RANGE -(2.0 ** 19) .. 2.0 ** 19;
+     TYPE TRACK_RANGE_M15        IS
+          DELTA 0.125 RANGE -(2.0 ** 12) .. 2.0 ** 12;
+     TYPE SECONDS_MM             IS
+          DELTA 2.0 ** (8 - MM) RANGE -(2.0 ** 8) .. 2.0 ** 8;
+     TYPE RANGE_CELL_MM          IS
+          DELTA 2.0 ** (-5)
+          RANGE -(2.0 ** (MM - 5) ) .. 2.0 ** (MM - 5);
+
+     TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
+     TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
+
+     TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
+     TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
+
+     TYPE SYMMETRIC_DEGREES_M7  IS
+          DELTA 2.0         RANGE -180.0 .. 180.0;
+     TYPE NATURAL_DEGREES_M15   IS
+          DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
+     TYPE SYMMETRIC_RADIANS_M16 IS
+          DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
+     TYPE NATURAL_RADIANS_M8    IS
+          DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
+
+     -------------------------------------------------------------------
+
+     SUBTYPE ST_MILES_M8             IS MILES_M16
+          DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
+     SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
+          DELTA 0.25 RANGE 0.0 .. 360.0;
+     SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
+          DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
+
+     -------------------------------------------------------------------
+
+     TYPE FORE_AND_AFT IS
+          RECORD
+               FORE, AFT : INTEGER;
+          END RECORD;
+
+     GENERIC
+          TYPE T IS DELTA <>;
+     FUNCTION ATTRIBUTES RETURN FORE_AND_AFT;
+
+     FUNCTION ATTRIBUTES RETURN FORE_AND_AFT IS
+     BEGIN
+          RETURN ( IDENT_INT (T'FORE), IDENT_INT (T'AFT) );
+     END ATTRIBUTES;
+
+     -------------------------------------------------------------------
+
+     PROCEDURE CHECK_ATTRIBUTES
+         (NAME : STRING;
+          ACTUAL_ATTRIBUTES, CORRECT_ATTRIBUTES : FORE_AND_AFT) IS
+     BEGIN
+          IF ACTUAL_ATTRIBUTES.FORE /= CORRECT_ATTRIBUTES.FORE THEN
+               FAILED ("GENERIC 'FORE FOR " & NAME & " =" &
+                       INTEGER'IMAGE(ACTUAL_ATTRIBUTES.FORE) );
+          END IF;
+          IF ACTUAL_ATTRIBUTES.AFT  /= CORRECT_ATTRIBUTES.AFT  THEN
+               FAILED ("GENERIC 'AFT  FOR " & NAME & " =" &
+                       INTEGER'IMAGE(ACTUAL_ATTRIBUTES.AFT ) );
+          END IF;
+     END CHECK_ATTRIBUTES;
+
+     -------------------------------------------------------------------
+
+     FUNCTION FA_MICRO_ANGLE_ERROR_M15
+                             IS NEW ATTRIBUTES(MICRO_ANGLE_ERROR_M15  );
+     FUNCTION FA_TRACK_RANGE_M15
+                             IS NEW ATTRIBUTES(TRACK_RANGE_M15        );
+     FUNCTION FA_SECONDS_MM  IS NEW ATTRIBUTES(SECONDS_MM             );
+     FUNCTION FA_RANGE_CELL_MM
+                             IS NEW ATTRIBUTES(RANGE_CELL_MM          );
+     FUNCTION FA_PIXEL_M10   IS NEW ATTRIBUTES(PIXEL_M10              );
+     FUNCTION FA_RULER_M8    IS NEW ATTRIBUTES(RULER_M8               );
+     FUNCTION FA_HOURS_M16   IS NEW ATTRIBUTES(HOURS_M16              );
+     FUNCTION FA_MILES_M16   IS NEW ATTRIBUTES(MILES_M16              );
+     FUNCTION FA_SYMMETRIC_DEGREES_M7
+                             IS NEW ATTRIBUTES(SYMMETRIC_DEGREES_M7   );
+     FUNCTION FA_NATURAL_DEGREES_M15
+                             IS NEW ATTRIBUTES(NATURAL_DEGREES_M15    );
+     FUNCTION FA_SYMMETRIC_RADIANS_M16
+                             IS NEW ATTRIBUTES(SYMMETRIC_RADIANS_M16  );
+     FUNCTION FA_NATURAL_RADIANS_M8
+                             IS NEW ATTRIBUTES(NATURAL_RADIANS_M8     );
+     FUNCTION FA_ST_MILES_M8 IS NEW ATTRIBUTES(ST_MILES_M8            );
+     FUNCTION FA_ST_NATURAL_DEGREES_M11
+                             IS NEW ATTRIBUTES(ST_NATURAL_DEGREES_M11 );
+     FUNCTION FA_ST_SYMMETRIC_RADIANS_M8
+                             IS NEW ATTRIBUTES(ST_SYMMETRIC_RADIANS_M8);
+
+BEGIN
+
+     TEST ("C35A05Q", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
+                      "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
+                      "TYPICAL TYPES, GENERICS");
+
+     CHECK_ATTRIBUTES ("MICRO_ANGLE_ERROR_M15",
+                                    FA_MICRO_ANGLE_ERROR_M15, (7, 1) );
+
+     CHECK_ATTRIBUTES ("TRACK_RANGE_M15", FA_TRACK_RANGE_M15, (5, 1) );
+
+     CHECK_ATTRIBUTES ("SECONDS_MM", FA_SECONDS_MM, (4, 5) );
+
+     CHECK_ATTRIBUTES ("RANGE_CELL_MM", FA_RANGE_CELL_MM, (7, 2) );
+
+     CHECK_ATTRIBUTES ("PIXEL_M10", FA_PIXEL_M10, (2, 4) );
+
+     CHECK_ATTRIBUTES ("RULER_M8",  FA_RULER_M8, (3, 2) );
+
+     CHECK_ATTRIBUTES ("HOURS_M16", FA_HOURS_M16, (3, 4) );
+
+     CHECK_ATTRIBUTES ("MILES_M16", FA_MILES_M16, (5, 2) );
+
+     CHECK_ATTRIBUTES ("SYMMETRIC_DEGREES_M7",
+                                    FA_SYMMETRIC_DEGREES_M7, (4, 1) );
+
+     CHECK_ATTRIBUTES ("NATURAL_DEGREES_M15",
+                                    FA_NATURAL_DEGREES_M15, (4, 2) );
+
+     CHECK_ATTRIBUTES ("SYMMETRIC_RADIANS_M16",
+                                    FA_SYMMETRIC_RADIANS_M16, (2, 5) );
+
+     CHECK_ATTRIBUTES ("NATURAL_RADIANS_M8",
+                                    FA_NATURAL_RADIANS_M8, (2, 2) );
+
+     CHECK_ATTRIBUTES ("ST_MILES_M8", FA_ST_MILES_M8, (3, 2) );
+
+     CHECK_ATTRIBUTES ("ST_NATURAL_DEGREES_M11",
+                                    FA_ST_NATURAL_DEGREES_M11, (4, 1) );
+
+     CHECK_ATTRIBUTES ("ST_SYMMETRIC_RADIANS_M8",
+                                   FA_ST_SYMMETRIC_RADIANS_M8, (2, 2) );
+
+     RESULT;
+
+END C35A05Q;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a07a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a07a.ada
new file mode 100644
index 000000000..ae7baf6fa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a07a.ada
@@ -0,0 +1,129 @@
+-- C35A07A.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 FIXED POINT TYPES THE FIRST AND LAST ATTRIBUTES YIELD
+-- CORRECT VALUES.
+
+-- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+
+-- WRG 8/25/86
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C35A07A IS
+
+     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+     -- 'MANTISSA VALUE.
+
+     TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
+     TYPE MIDDLE_M15        IS DELTA 2.0 **(-6) RANGE  -512.0 ..  512.0;
+     TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+     TYPE DECIMAL_M18       IS DELTA 0.1   RANGE -10_000.0 .. 10_000.0;
+     TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
+          -- LARGEST MODEL NUMBER IS 960.0.
+
+     -------------------------------------------------------------------
+
+     SUBTYPE ST_LEFT_EDGE_M6 IS MIDDLE_M15
+          DELTA 2.0 ** (-6) RANGE IDENT_INT (1) * (-1.0) .. 1.0;
+     SUBTYPE ST_MIDDLE_M3    IS LIKE_DURATION_M23
+          DELTA 0.5 RANGE  0.0 .. 2.5;
+     SUBTYPE ST_DECIMAL_M7   IS DECIMAL_M18
+          DELTA  10.0 RANGE -1000.0 .. 1000.0;
+          -- LARGEST MODEL NUMBER IS 1016.0.
+     SUBTYPE ST_DECIMAL_M3   IS DECIMAL_M4
+          DELTA 100.0 RANGE  -500.0 ..  500.0;
+          -- LARGEST MODEL NUMBER IS 448.0.
+     SUBTYPE ST_MIDDLE_M15   IS MIDDLE_M15
+          RANGE 6.0 .. 3.0;
+
+BEGIN
+
+     TEST ("C35A07A", "CHECK THAT FOR FIXED POINT TYPES THE FIRST " &
+                      "AND LAST ATTRIBUTES YIELD CORRECT VALUES - " &
+                      "BASIC TYPES");
+
+     -------------------------------------------------------------------
+
+
+     IF MIDDLE_M3'FIRST /= IDENT_INT (1) * 0.0 THEN
+          FAILED ("MIDDLE_M3'FIRST /= 0.0");
+     END IF;
+     IF MIDDLE_M3'LAST /= IDENT_INT (1) * 2.5 THEN
+          FAILED ("MIDDLE_M3'LAST /= 2.5");
+     END IF;
+
+     -------------------------------------------------------------------
+
+
+     IF LIKE_DURATION_M23'FIRST /= IDENT_INT (1) * (-86_400.0) THEN
+          FAILED ("LIKE_DURATION_M23'FIRST /= -86_400.0");
+     END IF;
+     IF LIKE_DURATION_M23'LAST  /= IDENT_INT (1) * 86_400.0 THEN
+          FAILED ("LIKE_DURATION_M23'LAST  /=  86_400.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     IF DECIMAL_M18'FIRST /= IDENT_INT (1) * (-10_000.0) THEN
+          FAILED ("DECIMAL_M18'FIRST /= -10_000.0");
+     END IF;
+     IF DECIMAL_M18'LAST /= IDENT_INT (1) * 10_000.0 THEN
+          FAILED ("DECIMAL_M18'LAST /= 10_000.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+
+     IF ST_MIDDLE_M3'FIRST /= IDENT_INT (1) * 0.0 THEN
+          FAILED ("ST_MIDDLE_M3'FIRST /= 0.0");
+     END IF;
+     IF ST_MIDDLE_M3'LAST /= IDENT_INT (1) * 2.5 THEN
+          FAILED ("ST_MIDDLE_M3'LAST /= 2.5");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     IF ST_DECIMAL_M7'FIRST /= IDENT_INT (1) * (-1000.0) THEN
+          FAILED ("ST_DECIMAL_M7'FIRST /= -1000.0");
+     END IF;
+     IF ST_DECIMAL_M7'LAST /= IDENT_INT (1) * 1000.0 THEN
+          FAILED ("ST_DECIMAL_M7'LAST /= 1000.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+
+     IF ST_MIDDLE_M15'FIRST /= IDENT_INT (1) * 6.0 THEN
+          FAILED ("ST_MIDDLE_M15'FIRST /= 6.0");
+     END IF;
+     IF ST_MIDDLE_M15'LAST /= IDENT_INT (1) * 3.0 THEN
+          FAILED ("ST_MIDDLE_M15'LAST /= 3.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+END C35A07A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a07d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a07d.ada
new file mode 100644
index 000000000..1a293cc83
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a07d.ada
@@ -0,0 +1,191 @@
+-- C35A07D.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 FIXED POINT TYPES THE FIRST AND LAST ATTRIBUTES YIELD
+-- CORRECT VALUES.
+
+-- CASE D: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC.
+
+-- WRG 8/25/86
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C35A07D IS
+
+     PI      : CONSTANT := 3.14159_26535_89793_23846;
+     TWO_PI  : CONSTANT := 2 * PI;
+     HALF_PI : CONSTANT := PI / 2;
+
+     MM : CONSTANT := MAX_MANTISSA;
+
+     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+     -- 'MANTISSA VALUE.
+
+     TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
+     TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
+
+     TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
+     TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
+
+     TYPE SYMMETRIC_DEGREES_M7  IS
+          DELTA 2.0         RANGE -180.0 .. 180.0;
+     TYPE NATURAL_DEGREES_M15   IS
+          DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
+     TYPE SYMMETRIC_RADIANS_M16 IS
+          DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
+               -- 'SMALL = 2.0 ** (-14) = 0.00006_10351_5625.
+     TYPE NATURAL_RADIANS_M8    IS
+          DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
+               -- 'SMALL = 2.0 ** ( -5) = 0.03125.
+
+     -------------------------------------------------------------------
+
+     SUBTYPE ST_MILES_M8             IS MILES_M16
+          DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
+     SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
+          DELTA 0.25 RANGE 0.0 .. 360.0;
+     SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
+          DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
+               -- 'SMALL = 2.0 ** ( -7) = 0.00781_25.
+
+BEGIN
+
+     TEST ("C35A07D", "CHECK THAT FOR FIXED POINT TYPES THE FIRST " &
+                      "AND LAST ATTRIBUTES YIELD CORRECT VALUES - " &
+                      "TYPICAL TYPES");
+
+     -------------------------------------------------------------------
+
+
+     IF PIXEL_M10'FIRST /= IDENT_INT (1) * 0.0 THEN
+          FAILED ("PIXEL_M10'FIRST /= 0.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     IF RULER_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
+          FAILED ("RULER_M8'FIRST /= 0.0");
+     END IF;
+     IF RULER_M8'LAST /= IDENT_INT (1) * 12.0 THEN
+          FAILED ("RULER_M8'LAST /= 12.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     IF HOURS_M16'FIRST /= IDENT_INT (1) * 0.0 THEN
+          FAILED ("HOURS_M16'FIRST /= 0.0");
+     END IF;
+     IF HOURS_M16'LAST /= IDENT_INT (1) * 24.0 THEN
+          FAILED ("HOURS_M16'LAST /= 24.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     IF MILES_M16'FIRST /= IDENT_INT (1) * 0.0 THEN
+          FAILED ("MILES_M16'FIRST /= 0.0");
+     END IF;
+     IF MILES_M16'LAST /= IDENT_INT (1) * 3000.0 THEN
+          FAILED ("MILES_M16'LAST /= 3000.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     IF SYMMETRIC_DEGREES_M7'FIRST /= IDENT_INT (1) * (-180.0) THEN
+          FAILED ("SYMMETRIC_DEGREES_M7'FIRST /= -180.0");
+     END IF;
+     IF SYMMETRIC_DEGREES_M7'LAST /= IDENT_INT (1) * 180.0 THEN
+          FAILED ("SYMMETRIC_DEGREES_M7'LAST /= 180.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     IF NATURAL_DEGREES_M15'FIRST /= IDENT_INT (1) * 0.0 THEN
+          FAILED ("NATURAL_DEGREES_M15'FIRST /= 0.0");
+     END IF;
+     IF NATURAL_DEGREES_M15'LAST /= IDENT_INT (1) * 360.0 THEN
+          FAILED ("NATURAL_DEGREES_M15'LAST /= 360.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     -- PI IS IN 3.0 + 2319 * 'SMALL .. 3.0 + 2320 * 'SMALL.
+     IF SYMMETRIC_RADIANS_M16'FIRST NOT IN
+        -3.14160_15625 .. -3.14154_05273_4375 THEN
+          FAILED ("SYMMETRIC_RADIANS_M16'FIRST NOT IN " &
+                  "-3.14160_15625 .. -3.14154_05273_4375");
+     END IF;
+     IF SYMMETRIC_RADIANS_M16'LAST  NOT IN
+        3.14154_05273_4375 .. 3.14160_15625 THEN
+          FAILED ("SYMMETRIC_RADIANS_M16'LAST NOT IN " &
+                  "3.14154_05273_4375 .. 3.14160_15625");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     IF NATURAL_RADIANS_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
+          FAILED ("NATURAL_RADIANS_M8'FIRST /= 0.0");
+     END IF;
+     -- TWO_PI IS IN 201 * 'SMALL .. 202 * 'SMALL.
+     IF NATURAL_RADIANS_M8'LAST  NOT IN 6.28125 .. 6.3125 THEN
+          FAILED ("NATURAL_RADIANS_M8'LAST NOT IN 6.28125 .. 6.3125");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     IF ST_MILES_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
+          FAILED ("ST_MILES_M8'FIRST /= 0.0");
+     END IF;
+     IF ST_MILES_M8'LAST /= IDENT_INT (1) * 10.0 THEN
+          FAILED ("ST_MILES_M8'LAST /= 10.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     IF ST_NATURAL_DEGREES_M11'FIRST /= IDENT_INT (1) * 0.0 THEN
+          FAILED ("ST_NATURAL_DEGREES_M11'FIRST /= 0.0");
+     END IF;
+     IF ST_NATURAL_DEGREES_M11'LAST /= IDENT_INT (1) * 360.0 THEN
+          FAILED ("ST_NATURAL_DEGREES_M11'LAST /= 360.0");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     -- HALF_PI IS IN 201 * 'SMALL .. 202 * 'SMALL.
+     IF ST_SYMMETRIC_RADIANS_M8'FIRST NOT IN
+        -1.57812_5 .. -1.57031_25 THEN
+          FAILED ("ST_SYMMETRIC_RADIANS_M8'FIRST NOT IN " &
+                  "-1.57812_5 .. -1.57031_25");
+     END IF;
+     IF ST_SYMMETRIC_RADIANS_M8'LAST  NOT IN
+        1.57031_25 .. 1.57812_5 THEN
+          FAILED ("ST_SYMMETRIC_RADIANS_M8'LAST NOT IN " &
+                  "1.57031_25 .. 1.57812_5");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+END C35A07D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a08b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a08b.ada
new file mode 100644
index 000000000..1750bfa12
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35a08b.ada
@@ -0,0 +1,91 @@
+-- C35A08B.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 MULTIPLICATION AND DIVISION OPERATORS FOR TWO
+--     FIXED POINT OPERANDS ARE DECLARED IN STANDARD AND ARE DIRECTLY
+--     VISIBLE.
+
+-- HISTORY:
+--     BCB 01/21/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C35A08B IS
+
+     PACKAGE P IS
+          TYPE T1 IS DELTA 2.0**(-4) RANGE -100.0 .. 100.0;
+          TYPE T2 IS DELTA 2.0**(-4) RANGE -100.0 .. 100.0;
+     END P;
+     USE P;
+
+     X1 : P.T1 := 6.0;
+     X2 : P.T1 := 2.0;
+     X3 : P.T1;
+     X4 : P.T1;
+     X5 : P.T1;
+     X6 : P.T1;
+
+     X7 : P.T2 := 2.0;
+
+     FUNCTION IDENT_FIXED(X : P.T1) RETURN P.T1 IS
+     BEGIN
+          RETURN X * IDENT_INT(1);
+     END IDENT_FIXED;
+
+BEGIN
+     TEST ("C35A08B", "CHECK THAT THE MULTIPLICATION AND DIVISION " &
+                      "OPERATORS FOR TWO FIXED POINT OPERANDS ARE " &
+                      "DECLARED IN STANDARD AND ARE DIRECTLY VISIBLE");
+
+     X3 := P.T1 (X1 * X2);
+     X4 := P.T1 (X1 / X2);
+
+     X5 := P.T1 (STANDARD."*" (X1,X2));
+     X6 := P.T1 (STANDARD."/" (X1,X2));
+
+     IF X3 /= IDENT_FIXED (12.0) THEN
+          FAILED ("IMPROPER VALUE FOR FIXED POINT MULTIPLICATION - 1");
+     END IF;
+
+     IF X4 /= IDENT_FIXED (3.0) THEN
+          FAILED ("IMPROPER VALUE FOR FIXED POINT DIVISION - 1");
+     END IF;
+
+     X3 := P.T1 (X1 * X7);
+     X4 := P.T1 (X1 / X7);
+
+     X5 := P.T1 (STANDARD."*" (X1,X7));
+     X6 := P.T1 (STANDARD."/" (X1,X7));
+
+     IF X3 /= IDENT_FIXED (12.0) THEN
+          FAILED ("IMPROPER VALUE FOR FIXED POINT MULTIPLICATION - 2");
+     END IF;
+
+     IF X4 /= IDENT_FIXED (3.0) THEN
+          FAILED ("IMPROPER VALUE FOR FIXED POINT DIVISION - 2");
+     END IF;
+
+     RESULT;
+END C35A08B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c360002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c360002.a
new file mode 100644
index 000000000..95cb3ef07
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c360002.a
@@ -0,0 +1,268 @@
+-- C360002.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 modular types may be used as array indices.
+--
+--      Check that if aliased appears in the component_definition of an
+--      array_type that each component of the array is aliased.
+--
+--      Check that references to aliased array objects produce correct
+--      results, and that out-of-bounds indexing correctly produces
+--      Constraint_Error.
+--
+-- TEST DESCRIPTION:
+--      This test defines several array types and subtypes indexed by modular
+--      types; some aliased some not, some with aliased components, some not.
+--
+--      It then checks that assignments move the correct data.
+--
+--
+-- CHANGE HISTORY:
+--      28 SEP 95   SAIC   Initial version
+--      23 APR 96   SAIC   Doc fixes, fixed constrained/unconstrained conflict
+--      13 FEB 97   PWB.CTA Removed illegal declarations and affected code
+--!
+
+------------------------------------------------------------------- C360002
+
+with Report;
+
+procedure C360002 is
+
+  Verbose : Boolean := Report.Ident_Bool( False );
+
+  type Mod_128 is mod 128;
+
+  function Ident_128( I: Integer ) return Mod_128 is
+  begin
+    return Mod_128( Report.Ident_Int( I ) );
+  end Ident_128;
+
+  type Unconstrained_Array
+       is array( Mod_128 range <> ) of Integer;
+
+  type Unconstrained_Array_Aliased
+       is array( Mod_128 range <> ) of aliased Integer;
+
+  type Access_All_Unconstrained_Array
+       is access all Unconstrained_Array;
+
+  type Access_All_Unconstrained_Array_Aliased
+       is access all Unconstrained_Array_Aliased;
+
+  subtype Array_01_10
+          is Unconstrained_Array(01..10);
+
+  subtype Array_11_20
+          is Unconstrained_Array(11..20);
+
+  subtype Array_Aliased_01_10
+          is Unconstrained_Array_Aliased(01..10);
+
+  subtype Array_Aliased_11_20
+          is Unconstrained_Array_Aliased(11..20);
+
+  subtype Access_All_01_10_Array
+          is Access_All_Unconstrained_Array(01..10);
+
+  subtype Access_All_01_10_Array_Aliased
+          is Access_All_Unconstrained_Array_Aliased(01..10);
+
+  subtype Access_All_11_20_Array
+          is Access_All_Unconstrained_Array(11..20);
+
+  subtype Access_All_11_20_Array_Aliased
+          is Access_All_Unconstrained_Array_Aliased(11..20);
+
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  -- these 'filler' functions create unique values for every element that
+  -- is used and/or tested in this test.
+
+  Well_Bottom : Integer := 0;
+
+  function Filler( Size : Mod_128 ) return Unconstrained_Array is
+    It : Unconstrained_Array( 0..Size-1 );
+  begin
+    for Eyes in It'Range loop
+      It(Eyes) := Integer( Eyes ) + Well_Bottom;
+    end loop;
+    Well_Bottom := Well_Bottom + It'Length;
+    return It;
+  end Filler;
+
+  function Filler( Size : Mod_128 ) return Unconstrained_Array_Aliased is
+    It : Unconstrained_Array_Aliased( 0..Size-1 );
+  begin
+    for Ayes in It'Range loop
+      It(Ayes) := Integer( Ayes ) + Well_Bottom;
+    end loop;
+    Well_Bottom := Well_Bottom + It'Length;
+    return It;
+  end Filler;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  An_Integer : Integer;
+
+  type AAI is access all Integer;
+
+  An_Integer_Access : AAI;
+
+  Array_Item_01_10 : Array_01_10 := Filler(10); -- 0..9
+
+  Array_Item_11_20 : Array_11_20 := Filler(10); -- 10..19 (sliding)
+
+  Array_Aliased_Item_01_10 : Array_Aliased_01_10 := Filler(10); -- 20..29
+
+  Array_Aliased_Item_11_20 : Array_Aliased_11_20 := Filler(10); -- 30..39
+
+  Aliased_Array_Item_01_10 : aliased Array_01_10 := Filler(10); -- 40..49
+
+  Aliased_Array_Item_11_20 : aliased Array_11_20 := Filler(10); -- 50..59
+
+  Aliased_Array_Aliased_Item_01_10 : aliased Array_Aliased_01_10
+                                   := Filler(10);               -- 60..69
+
+  Aliased_Array_Aliased_Item_11_20 : aliased Array_Aliased_11_20
+                                   := Filler(10);               -- 70..79
+
+  Check_Item            : Access_All_Unconstrained_Array;
+
+  Check_Aliased_Item    : Access_All_Unconstrained_Array_Aliased;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  procedure Fail( Message : String; CI, SB : Integer ) is
+  begin
+    Report.Failed("Wrong value passed " & Message);
+    if Verbose then
+      Report.Comment("got" & Integer'Image(CI) &
+                     " should be" & Integer'Image(SB) );
+    end if;
+  end Fail;
+
+  procedure Check_Array_01_10( Checked_Item : Array_01_10;
+                               Low_SB       : Integer ) is
+  begin
+    for Index in Checked_Item'Range loop
+      if (Checked_Item(Index) /= (Low_SB +Integer(Index)-1)) then
+        Fail("unaliased 1..10", Checked_Item(Index),
+                                (Low_SB +Integer(Index)-1));
+      end if;
+    end loop;
+  end Check_Array_01_10;
+
+  procedure Check_Array_11_20( Checked_Item : Array_11_20;
+                               Low_SB       : Integer ) is
+  begin
+    for Index in Checked_Item'Range loop
+      if (Checked_Item(Index) /= (Low_SB +Integer(Index)-11)) then
+        Fail("unaliased 11..20", Checked_Item(Index),
+                                 (Low_SB +Integer(Index)-11));
+      end if;
+    end loop;
+ end Check_Array_11_20;
+
+  procedure Check_Single_Integer( The_Integer, SB : Integer;
+                                  Message         : String ) is
+  begin
+    if The_Integer /= SB then
+      Report.Failed("Wrong integer value for " & Message );
+    end if;
+  end Check_Single_Integer;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+begin  -- Main test procedure.
+
+  Report.Test ("C360002", "Check that modular types may be used as array " &
+                          "indices.  Check that if aliased appears in " &
+                          "the component_definition of an array_type that " &
+                          "each component of the array is aliased.  Check " &
+                          "that references to aliased array objects " &
+                          "produce correct results, and that out of bound " &
+                          "references to aliased objects correctly " &
+                          "produce Constraint_Error" );
+  -- start with checks that the Filler assignments produced the expected
+  -- result.  This is a "case 0" test to check that nothing REALLY surprising
+  -- is happening
+
+  Check_Array_01_10( Array_Item_01_10, 0 );
+  Check_Array_11_20( Array_Item_11_20, 10 );
+
+  -- check that having the variable aliased makes no difference
+  Check_Array_01_10( Aliased_Array_Item_01_10, 40 );
+  Check_Array_11_20( Aliased_Array_Item_11_20, 50 );
+
+  -- now check that conversion between array types where the only
+  -- difference in the definitions is that the components are aliased works
+
+  Check_Array_01_10( Unconstrained_Array( Array_Aliased_Item_01_10 ), 20 );
+  Check_Array_11_20( Unconstrained_Array( Array_Aliased_Item_11_20 ), 30 );
+
+  -- check that conversion of an aliased object with aliased components
+  -- also works
+
+  Check_Array_01_10( Unconstrained_Array( Aliased_Array_Aliased_Item_01_10 ),
+                     60 );
+  Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
+                     70 );
+
+  -- check that the bounds will slide
+
+  Check_Array_01_10( Array_01_10( Array_Item_11_20 ), 10 );
+  Check_Array_11_20( Array_11_20( Array_Item_01_10 ),  0 );
+
+  -- point at some of the components and check them
+
+  An_Integer_Access := Array_Aliased_Item_01_10(5)'Access;
+
+  Check_Single_Integer( An_Integer_Access.all, 24,
+                       "Aliased component 'Access");
+
+  An_Integer_Access := Aliased_Array_Aliased_Item_01_10(7)'Access;
+
+  Check_Single_Integer( An_Integer_Access.all, 66,
+                       "Aliased Aliased component 'Access");
+
+  -- check some assignments
+
+  Array_Item_01_10 := Aliased_Array_Item_01_10;
+  Check_Array_01_10( Array_Item_01_10, 40 );
+
+  Aliased_Array_Item_01_10 := Aliased_Array_Item_11_20(11..20);
+  Check_Array_01_10( Aliased_Array_Item_01_10, 50 );
+
+  Aliased_Array_Aliased_Item_11_20(11..20)
+                                       := Aliased_Array_Aliased_Item_01_10;
+  Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
+                     60 );
+
+  Report.Result;
+
+end C360002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36104a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36104a.ada
new file mode 100644
index 000000000..4cdaccd0b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36104a.ada
@@ -0,0 +1,359 @@
+-- C36104A.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 OR NOT, AS APPROPRIATE,
+-- DURING DISCRETE_RANGE ELABORATIONS/EVALUATIONS IN LOOPS,
+-- ARRAY_TYPE_DEFINITIONS, ARRAY AGGREGATES, SLICES,
+-- AND INDEX CONSTRAINTS IN OBJECT AND TYPE DECLARATIONS,
+-- WHERE AN EXPLICIT (SUB)TYPE IS INCLUDED IN EACH DISCRETE_RANGE.
+-- MEMBERSHIP OPERATORS ARE CHECKED HERE, ALSO, TO ENSURE THAT
+-- EXCEPTIONS ARE NOT RAISED FOR NULL RANGES.
+-- ONLY STATIC CASES ARE CHECKED HERE.
+
+-- DAT 2/3/81
+-- JRK 2/25/81
+-- VKG 1/21/83
+-- L.BROWN  7/15/86  1) ADDED ACCESS TYPES.
+--                   2) DELETED "NULL INDEX RANGES, CONSTRAINT_ERROR 
+--                      RAISED" SECTION.
+--                   3) DELETED ANY MENTION OF CASE STATEMENT CHOICES
+--                      AND VARIANT CHOICES IN THE ABOVE COMMENT.
+-- EDS      7/16/98  AVOID OPTIMIZATION
+
+WITH REPORT;
+PROCEDURE C36104A IS
+
+     USE REPORT;
+
+     TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+     TYPE WEEK_ARRAY IS ARRAY (WEEK RANGE <>) OF WEEK;
+     SUBTYPE WORK_WEEK IS WEEK RANGE MON .. FRI;
+     SUBTYPE MID_WEEK IS WORK_WEEK RANGE TUE .. THU;
+
+     TYPE INT_10 IS NEW INTEGER RANGE -10 .. 10;
+     TYPE I_10 IS NEW INT_10;
+     SUBTYPE I_5 IS I_10 RANGE -5 .. 5;
+     TYPE I_5_ARRAY IS ARRAY (I_5 RANGE <>) OF I_5;
+
+BEGIN
+     TEST ("C36104A", "CONSTRAINT_ERROR IS RAISED OR NOT IN STATIC "
+          & "DISCRETE_RANGES WITH EXPLICIT TYPE_MARKS");
+
+     -- NON-NULL RANGES, CONSTRAINT_ERROR RAISED.
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (I_5 RANGE 0 .. 6) OF I_5;
+               -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
+          BEGIN
+               DECLARE
+                  -- DEFINE AN OBJECT OF TYPE A AND USE IT TO AVOID 
+                  -- OPTIMIZATION OF SUBTYPE
+                  A1 : A := (OTHERS => I_5(IDENT_INT(1)));
+               BEGIN
+                  FAILED ("CONSTRAINT_ERROR NOT RAISED 1 " & 
+                          I_5'IMAGE(A1(1)) );  --USE A1
+               END;
+          EXCEPTION
+             --MAKE SURE THAT CONSTRAINT_ERROR FROM ABOVE STATEMENTS
+             --REPORT FAILED.
+             WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 1");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED 1");
+     END;
+       
+     BEGIN
+          FOR I IN MID_WEEK RANGE MON .. MON LOOP
+               FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
+          END LOOP;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 3");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE P IS ACCESS I_5_ARRAY (I_5 RANGE 0 .. 6);
+               -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
+          BEGIN
+             DECLARE
+                TYPE PA IS NEW P;
+                -- DEFINE AN OBJECT OF TYPE PA AND USE IT TO AVOID 
+                -- OPTIMIZATION OF TYPE
+                PA1 : PA := NEW I_5_ARRAY'(0 .. I_5(IDENT_INT(6)) =>
+                                           I_5(IDENT_INT(1)));
+             BEGIN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED 4 " & 
+                        I_5'IMAGE(PA1(1))); --USE PA1
+             END;
+          EXCEPTION
+             WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 4");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 4");
+     END;
+
+     DECLARE
+          W : WEEK_ARRAY (MID_WEEK);
+     BEGIN
+          W := (MID_WEEK RANGE MON .. WED => WED);
+          -- CONSTRAINT_ERROR RAISED.
+          FAILED ("CONSTRAINT_ERROR NOT RAISED 7 " & 
+                  MID_WEEK'IMAGE(W(WED))); --USE W
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 7");
+     END;
+
+     DECLARE
+          W : WEEK_ARRAY (WORK_WEEK);
+     BEGIN
+          W := (W'RANGE => WED); -- OK.
+          W (MON .. WED) := W (MID_WEEK RANGE MON .. WED); -- EXCEPTION.
+          FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 
+                  MID_WEEK'IMAGE(W(WED))); --USE W
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 8");
+     END;
+
+     BEGIN
+          DECLARE
+               W : WEEK_ARRAY (MID_WEEK RANGE MON .. FRI);
+               -- ELABORATION OF ABOVE RAISES CONSTRAINT_ERROR.
+          BEGIN
+               W := (W'RANGE => WED); -- OK.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED 9 " & 
+                       MID_WEEK'IMAGE(W(WED))); --USE W
+          EXCEPTION
+               WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 9");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 9");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE SUN .. TUE);
+               -- RAISES CONSTRAINT_ERROR.
+          BEGIN
+             DECLARE
+                W1 : W := (OTHERS => WED);
+             BEGIN
+                FAILED ("CONSTRAINT_ERROR NOT RAISED 10 " & 
+                        MID_WEEK'IMAGE(W1(WED))); --USE W1
+             END;
+          EXCEPTION
+             WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 10");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 10");
+     END;
+
+     BEGIN
+          DECLARE
+               SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE MON .. WED);
+               -- RAISES CONSTRAINT_ERROR.
+          BEGIN
+               DECLARE
+                    W1 : W := (OTHERS => (WED));
+               BEGIN
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 
+                            MID_WEEK'IMAGE(W1(WED))); --USE W1
+               END;
+          EXCEPTION
+               WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 8");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 11");
+     END;
+
+     -- NULL DISCRETE/INDEX RANGES, EXCEPTION NOT RAISED.
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (I_5 RANGE -5 .. -6) OF I_5;
+               A1 : A;
+          BEGIN
+               IF A1'FIRST /= I_5(IDENT_INT(-5)) THEN
+                    FAILED ("'FIRST OF NULL ARRAY INCORRECT");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
+     END;
+
+     BEGIN
+          FOR I IN MID_WEEK RANGE SAT .. SUN LOOP
+               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+          END LOOP;
+          FOR I IN MID_WEEK RANGE FRI .. WED LOOP
+               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+          END LOOP;
+          FOR I IN MID_WEEK RANGE MON .. SUN LOOP
+               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+          END LOOP;
+          FOR I IN I_5 RANGE 10 .. -10 LOOP
+               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+          END LOOP;
+          FOR I IN I_5 RANGE 10 .. 9 LOOP
+               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+          END LOOP;
+          FOR I IN I_5 RANGE -10 .. -11 LOOP
+               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+          END LOOP;
+          FOR I IN I_5 RANGE -10 .. -20 LOOP
+               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+          END LOOP;
+          FOR I IN I_5 RANGE 6 .. 5 LOOP
+               FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES");
+          END LOOP;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE P IS ACCESS I_5_ARRAY (-5 .. -6);
+               PA1 : P := NEW I_5_ARRAY (-5 .. -6);
+          BEGIN
+               IF PA1'LENGTH /= IDENT_INT(0) THEN
+                    FAILED ("'LENGTH OF NULL ARRAY INCORRECT");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED 5");
+     END;
+
+     DECLARE
+          TYPE NARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+          SUBTYPE SNARR IS INTEGER RANGE 1 .. 2;
+          W : NARR(SNARR) := (1,2);
+     BEGIN
+          IF W = (SNARR RANGE IDENT_INT(4) .. 2 => 5) THEN
+               FAILED("EVALUATION OF EXPRESSION IS INCORRECT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
+     END;
+
+     DECLARE
+          W : WEEK_ARRAY (MID_WEEK);
+     BEGIN
+          W := (W'RANGE => WED); -- OK.
+          W (TUE .. MON) := W (MID_WEEK RANGE MON .. SUN);
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
+     END;
+
+     BEGIN
+          DECLARE
+               W : WEEK_ARRAY (MID_WEEK RANGE MON .. SUN);
+          BEGIN
+               IF (W'FIRST /= MON) THEN
+                    FAILED ("'FIRST OF NULL ARRAY INCORRECT");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
+               W1 : W;
+          BEGIN
+               IF (W1'FIRST /= TUE) THEN
+                    FAILED ("'FIRST OF NULL ARRAY INCORRECT");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
+     END;
+
+     BEGIN
+          DECLARE
+               SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
+               W1 : W;
+          BEGIN
+               IF (W1'FIRST /= TUE) THEN
+                    FAILED ("'FIRST OF NULL ARRAY INCORRECT");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 12");
+     END;
+
+     -- NULL MEMBERSHIP RANGES, EXCEPTION NOT RAISED.
+
+     BEGIN
+          IF SUN IN  SAT .. SUN
+          OR SAT IN  FRI .. WED
+          OR WED IN  THU .. TUE
+          OR THU IN  MON .. SUN
+          OR FRI IN  SAT .. FRI
+          OR WED IN  FRI .. MON
+          THEN
+               FAILED ("INCORRECT 'IN' EVALUATION 1");
+          END IF;
+
+          IF INTEGER'(0) IN  10 .. -10
+          OR INTEGER'(0) IN  10 .. 9
+          OR INTEGER'(0) IN  -10 .. -11
+          OR INTEGER'(0) IN  -10 .. -20 
+          OR INTEGER'(0) IN  6 .. 5
+          OR INTEGER'(0) IN  5 .. 3
+          OR INTEGER'(0) IN  7 .. 3
+          THEN
+               FAILED ("INCORRECT 'IN' EVALUATION 2");
+          END IF;
+
+          IF WED NOT IN  THU .. TUE
+          AND INTEGER'(0) NOT IN  4 .. -4
+          THEN NULL;
+          ELSE FAILED ("INCORRECT 'NOT IN' EVALUATION");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 52");
+     END;
+
+
+     RESULT;
+END C36104A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36104b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36104b.ada
new file mode 100644
index 000000000..9c896b9df
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36104b.ada
@@ -0,0 +1,421 @@
+-- C36104B.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 OR NOT, AS APPROPRIATE,
+-- DURING DISCRETE_RANGE ELABORATIONS/EVALUATIONS IN LOOPS,
+-- ARRAY_TYPE_DEFINITIONS, ARRAY AGGREGATES, SLICES,
+-- AND INDEX CONSTRAINTS IN OBJECT AND TYPE DECLARATIONS, WHERE
+-- AN EXPLICIT (SUB)TYPE IS INCLUDED IN EACH DISCRETE_RANGE.
+-- MEMBERSHIP OPERATORS ARE CHECKED HERE, ALSO, TO ENSURE THAT
+-- EXCEPTIONS ARE NOT RAISED FOR NULL RANGES.
+-- ONLY DYNAMIC CASES ARE CHECKED HERE.
+
+-- DAT 2/3/81
+-- JRK 2/25/81
+-- L.BROWN  7/15/86  1) ADDED ACCESS TYPES.
+--                   2) DELETED "NULL INDEX RANGE, CONSTRAINT_ERROR
+--                      RAISED" SECTION.
+--                   3) MADE USE OF DYNAMIC-RESULT FUNCTIONS.
+--                   4) DELETED ALL REFERENCES TO CASE STATEMENT CHOICES
+--                      AND VARIANT PART CHOICES IN THE ABOVE COMMENT.
+-- EDS      7/16/98  AVOID OPTIMIZATION
+
+WITH REPORT;
+PROCEDURE C36104B IS
+
+     USE REPORT;
+
+     TYPE WEEK IS (SSUN, SMON, STUE, SWED, STHU, SFRI, SSAT);
+     SUN : WEEK := WEEK'VAL(IDENT_INT(0));
+     MON : WEEK := WEEK'VAL(IDENT_INT(1));
+     TUE : WEEK := WEEK'VAL(IDENT_INT(2));
+     WED : WEEK := WEEK'VAL(IDENT_INT(3));
+     THU : WEEK := WEEK'VAL(IDENT_INT(4));
+     FRI : WEEK := WEEK'VAL(IDENT_INT(5));
+     SAT : WEEK := WEEK'VAL(IDENT_INT(6));
+     TYPE WEEK_ARRAY IS ARRAY (WEEK RANGE <>) OF WEEK;
+     SUBTYPE WORK_WEEK IS WEEK RANGE MON .. FRI;
+     SUBTYPE MID_WEEK IS WORK_WEEK RANGE TUE .. THU;
+
+     TYPE INT_10 IS NEW INTEGER RANGE -10 .. 10;
+     TYPE I_10 IS NEW INT_10;
+     SUBTYPE I_5 IS I_10 RANGE I_10(IDENT_INT(-5)) ..
+                               I_10(IDENT_INT(5));
+     TYPE I_5_ARRAY IS ARRAY (I_5 RANGE <>) OF I_5;
+
+     FUNCTION F(DAY : WEEK) RETURN WEEK IS
+        BEGIN
+          RETURN DAY;
+        END;
+
+BEGIN
+     TEST ("C36104B", "CONSTRAINT_ERROR IS RAISED OR NOT IN DYNAMIC "
+          & "DISCRETE_RANGES WITH EXPLICIT TYPE_MARKS");
+
+     -- NON-NULL RANGES, CONSTRAINT_ERROR RAISED.
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (I_5 RANGE 0 .. 6) OF I_5;
+               -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
+          BEGIN
+               DECLARE
+                  -- DEFINE AN OBJECT OF TYPE A AND USE IT TO AVOID 
+                  -- OPTIMIZATION OF SUBTYPE
+                  A1 : A := (A'RANGE => I_5(IDENT_INT(1)));
+               BEGIN
+                  FAILED ("CONSTRAINT_ERROR NOT RAISED 1 " & 
+                          I_5'IMAGE(A1(1)) );  --USE A1
+               END;
+          EXCEPTION
+             --MAKE SURE THAT CONSTRAINT_ERROR FROM ABOVE STATEMENTS
+             --REPORT FAILED.
+             WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 1");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 1");
+     END;
+
+     BEGIN
+          FOR I IN MID_WEEK RANGE MON .. MON LOOP
+
+               IF EQUAL(2,2)  THEN
+                    SAT := SSAT;
+               END IF;
+
+          END LOOP;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED 3");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 3");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE P IS ACCESS I_5_ARRAY (0 .. 6);
+               -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR.
+          BEGIN
+               DECLARE
+                  TYPE PA IS NEW P;
+                  -- DEFINE AN OBJECT OF TYPE PA AND USE IT TO AVOID 
+                  -- OPTIMIZATION OF TYPE
+                  PA1 : PA :=NEW I_5_ARRAY'(0.. I_5(IDENT_INT(6)) => 
+                                            I_5(IDENT_INT(1)));
+               BEGIN
+                  FAILED ("CONSTRAINT_ERROR NOT RAISED 4 " & 
+                          I_5'IMAGE(PA1(1))); --USE PA1
+               END;
+          EXCEPTION
+             WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 4");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 4");
+     END;
+
+     DECLARE
+          W : WEEK_ARRAY (MID_WEEK);
+     BEGIN
+          W := (MID_WEEK RANGE MON .. WED => WED);
+          -- CONSTRAINT_ERROR RAISED.
+          BEGIN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED 7 " & 
+                       MID_WEEK'IMAGE(W(WED))); --USE W
+          EXCEPTION
+               WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 7");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 7");
+     END;
+
+     DECLARE
+          W : WEEK_ARRAY (WORK_WEEK);
+     BEGIN
+          W := (W'RANGE => WED); -- OK.
+          W (MON .. WED) := W (MID_WEEK RANGE MON .. WED); -- EXCEPTION.
+          BEGIN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 
+                       MID_WEEK'IMAGE(W(WED))); --USE W
+          EXCEPTION
+               WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 8");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 8");
+     END;
+
+     BEGIN
+          DECLARE
+               W : WEEK_ARRAY (MID_WEEK RANGE MON .. FRI);
+               -- ELABORATION OF ABOVE RAISES CONSTRAINT_ERROR.
+          BEGIN
+               W(WED) := THU;        -- OK.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED 9 " &
+                       WEEK'IMAGE(W(WED)));   -- USE W
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 9");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE SUN .. WED);
+               -- RAISES CONSTRAINT_ERROR.
+          BEGIN
+               DECLARE
+                    X : W;              -- OK.
+               BEGIN
+                    X(TUE) := THU;   -- OK.
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED 10 " &
+                            WEEK'IMAGE(X(TUE)));   -- USE X
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 10");
+     END;
+
+     BEGIN
+          DECLARE
+               SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE MON .. THU);
+               -- RAISES CONSTRAINT_ERROR.
+          BEGIN
+               DECLARE
+                    T : W;               -- OK.
+               BEGIN
+                    T(TUE) := THU;    -- OK.
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED 11 " &
+                            WEEK'IMAGE(T(TUE)));
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED 11");
+     END;
+
+     -- NULL DISCRETE/INDEX RANGES, EXCEPTION NOT RAISED.
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (I_5 RANGE I_5(IDENT_INT(-5)) .. -6) OF I_5;
+               A1 : A;
+          BEGIN
+               IF A1'FIRST /= I_5(IDENT_INT(-5)) THEN
+                    FAILED ("'FIRST OF NULL ARRAY INCORRECT");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
+     END;
+
+     BEGIN
+          FOR I IN MID_WEEK RANGE SAT .. SUN LOOP
+               
+               IF EQUAL(2,2)  THEN
+                    TUE := STUE;
+               END IF;
+
+          END LOOP;
+          FOR I IN MID_WEEK RANGE FRI .. WED LOOP
+               
+               IF EQUAL(2,2)  THEN
+                    MON := SMON;
+               END IF;
+
+          END LOOP;
+          FOR I IN MID_WEEK RANGE MON .. SUN LOOP
+               
+               IF EQUAL(3,3)  THEN
+                    WED := SWED;
+               END IF;
+
+          END LOOP;
+          FOR I IN I_5 RANGE 10 .. -10 LOOP
+
+               IF EQUAL(2,2)  THEN
+                    TUE := STUE;
+               END IF;
+
+          END LOOP;
+          FOR I IN I_5 RANGE 10 .. 9 LOOP
+
+               IF EQUAL(2,2)  THEN
+                    THU := STHU;
+               END IF;
+
+          END LOOP;
+          FOR I IN I_5 RANGE -10 .. -11 LOOP
+
+               IF EQUAL(2,2)  THEN
+                    SAT := SSAT;
+               END IF;
+
+          END LOOP;
+          FOR I IN I_5 RANGE -10 .. -20 LOOP
+
+               IF EQUAL(2,2)  THEN
+                    SUN := SSUN;
+               END IF;
+
+          END LOOP;
+          FOR I IN I_5 RANGE 6 .. 5 LOOP
+
+               IF EQUAL(2,2)  THEN
+                    MON := SMON;
+               END IF;
+
+          END LOOP;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE P IS ACCESS I_5_ARRAY (I_5(IDENT_INT(-5)) .. -6);
+               PA1 : P := NEW I_5_ARRAY (I_5(IDENT_INT(-5)) .. -6);
+          BEGIN
+               IF PA1'LENGTH /= IDENT_INT(0) THEN
+                    FAILED ("'LENGTH OF NULL ARRAY INCORRECT");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED 5");
+     END;
+
+     DECLARE
+          TYPE NARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+          SUBTYPE SNARR IS INTEGER RANGE 1 .. 2;
+          W : NARR(SNARR) := (1,2);
+     BEGIN
+          IF W = (SNARR RANGE IDENT_INT(4) .. 2 => 5) THEN
+               FAILED("EVALUATION OF EXPRESSION IS INCORRECT");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
+     END;
+
+     DECLARE
+          W : WEEK_ARRAY (MID_WEEK);
+     BEGIN
+          W := (W'RANGE => WED); -- OK.
+          W (TUE .. MON) := W (MID_WEEK RANGE MON .. SUN);
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
+     END;
+
+     BEGIN
+          DECLARE
+               W : WEEK_ARRAY (MID_WEEK RANGE MON .. SUN);
+          BEGIN
+
+               IF EQUAL(W'LENGTH,0)  THEN
+                    TUE := STUE;
+               END IF;
+
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
+          BEGIN
+
+               IF EQUAL(W'LENGTH,0)  THEN
+                    MON := SMON;
+               END IF;
+
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
+     END;
+
+     BEGIN
+          DECLARE
+               SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE TUE .. MON);
+          BEGIN
+
+               IF EQUAL(W'LENGTH,0)  THEN
+                    WED := SWED;
+               END IF;
+
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 12");
+     END;
+
+     -- NULL MEMBERSHIP RANGES, EXCEPTION NOT RAISED.
+
+     BEGIN
+          IF F(SUN) IN  SAT .. SUN
+          OR SAT IN  FRI .. WED
+          OR F(WED) IN  THU .. TUE
+          OR THU IN  MON .. SUN
+          OR F(FRI) IN  SAT .. FRI
+          OR WED IN  FRI .. MON
+          THEN
+               FAILED ("INCORRECT 'IN' EVALUATION 1");
+          END IF;
+
+          IF IDENT_INT(0) IN  10 .. IDENT_INT(-10)
+          OR 0 IN  IDENT_INT(10) .. 9
+          OR IDENT_INT(0) IN  IDENT_INT(-10) .. -11
+          OR 0 IN  -10 .. IDENT_INT(-20) 
+          OR IDENT_INT(0) IN  6 .. IDENT_INT(5)
+          OR 0 IN  5 .. IDENT_INT(3)
+          OR IDENT_INT(0) IN  7 .. IDENT_INT(3)
+          THEN
+               FAILED ("INCORRECT 'IN' EVALUATION 2");
+          END IF;
+
+          IF F(WED) NOT IN  THU .. TUE
+          AND IDENT_INT(0) NOT IN  IDENT_INT(4) .. -4
+          THEN NULL;
+          ELSE FAILED ("INCORRECT 'NOT IN' EVALUATION");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 52");
+     END;
+
+     RESULT;
+END C36104B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36172a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36172a.ada
new file mode 100644
index 000000000..9c9e6cf13
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36172a.ada
@@ -0,0 +1,250 @@
+-- C36172A.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 APPROPRIATELY
+-- ON DISCRETE_RANGES USED AS INDEX_CONSTRAINTS.
+
+-- DAT 2/9/81
+-- SPS 4/7/82
+-- JBG 6/5/85
+
+WITH REPORT;
+PROCEDURE C36172A IS
+
+     USE REPORT;
+
+     SUBTYPE INT_10 IS INTEGER RANGE 1 .. 10;
+     TYPE A IS ARRAY (INT_10 RANGE <> ) OF INTEGER;
+
+     SUBTYPE INT_11 IS INTEGER RANGE 0 .. 11;
+     SUBTYPE NULL_6_4 IS INTEGER RANGE 6 .. 4;
+     SUBTYPE NULL_11_10 IS INTEGER RANGE 11 .. 10;
+     SUBTYPE INT_9_11 IS INTEGER RANGE 9 .. 11;
+
+     TYPE A_9_11 IS ARRAY (9..11) OF BOOLEAN;
+     TYPE A_11_10 IS ARRAY (11 .. 10) OF INTEGER;
+     SUBTYPE A_1_10 IS A(INT_10);
+
+BEGIN
+     TEST ("C36172A", "CONSTRAINT_ERROR IS RAISED APPROPRIATELY" &
+           " FOR INDEX_RANGES");
+
+     BEGIN
+          DECLARE
+               V : A (9 .. 11);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    FAILED ("OUT-OF-BOUNDS INDEX_RANGE 1");
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION 1");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (11 .. 10);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    NULL;
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+               "RAISED INAPPROPRIATELY 2");
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+               "SHOULD BE 2");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (6 .. 4);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    NULL;
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+               "RAISED INAPPROPRIATELY 3");
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+               "SHOULD BE 3");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (INT_9_11);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    FAILED ("OUT-OF-BOUNDS INDEX RANGE 4");
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION 4");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (NULL_11_10);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    NULL;
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+               "RAISED INAPPROPRIATELY 5");
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+               "SHOULD BE 5");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (NULL_6_4);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    NULL;
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+               "RAISED INAPPROPRIATELY 6");
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+               "SHOULD BE 6");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (INT_9_11 RANGE 10 .. 11);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    FAILED ("BAD NON-NULL INDEX RANGE 7");
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION 7");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (NULL_11_10 RANGE 11 .. 10);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    NULL;
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+               "RAISED INAPPROPRIATELY 8");
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+               "SHOULD BE 8");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (NULL_6_4 RANGE 6 .. 4);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    NULL;
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+               "RAISED INAPPROPRIATELY 9");
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+               "SHOULD BE 9");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (A_9_11'RANGE);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    FAILED ("BAD INDEX RANGE 10");
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION 10");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (A_11_10'RANGE);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    NULL;
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+               "RAISED INAPPROPRIATELY 11");
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+               "SHOULD BE 11");
+     END;
+
+     BEGIN
+          DECLARE
+               V : A (6 .. 4);
+          BEGIN
+               IF EQUAL (V'FIRST, V'FIRST) THEN
+                    NULL;
+               ELSE
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
+               "RAISED INAPPROPRIATELY 12");
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
+               "SHOULD BE 12");
+     END;
+
+     RESULT;
+END C36172A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36172b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36172b.ada
new file mode 100644
index 000000000..bf689b425
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36172b.ada
@@ -0,0 +1,161 @@
+-- C36172B.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 A MULTIDIMENSIONAL INDEX
+-- CONSTRAINT IF ONE OF THE RANGES IS A NULL RANGE AND THE OTHER IS A
+-- NON-NULL RANGE WITH A BOUND THAT LIES OUTSIDE THE INDEX SUBTYPE.
+
+-- CHECK THAT NO EXCEPTION IS RAISED IF ALL DISCRETE RANGES ARE NULL.
+
+-- JBG 6/5/85
+-- EDS 7/16/98     AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C36172B IS
+     SUBTYPE INT_10 IS INTEGER RANGE 1..10;
+     TYPE ARR2 IS ARRAY (INT_10 RANGE <>, INT_10 RANGE <>) OF INTEGER;
+BEGIN
+     TEST ("C36172B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
+                      "NON-NULL DIMENSION OF A NULL MULTIDIMENSIONAL " &
+                      "INDEX CONSTRAINT IF A BOUND LIES OUTSIDE THE " &
+                      "INDEX SUBTYPE");
+
+     BEGIN
+          DECLARE
+               V : ARR2 (6..4, 9..11);
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                       "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                       "THE INDEX SUBTYPE (13) " & INTEGER'IMAGE(V'FIRST));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 13");
+     END;
+
+     BEGIN
+          DECLARE
+               V : ARR2 (0..3, 8..7);
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                       "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                       "THE INDEX SUBTYPE (14) " & INTEGER'IMAGE(V'FIRST));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 14");
+     END;
+
+     BEGIN
+          DECLARE
+               V : ARR2 (6..4, IDENT_INT(0)..2);
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                       "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                       "THE INDEX SUBTYPE (15) " & INTEGER'IMAGE(V'FIRST));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 15");
+     END;
+
+     BEGIN
+          DECLARE
+               V : ARR2 (9..IDENT_INT(11), 6..4);
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                       "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                       "THE INDEX SUBTYPE (16) " & INTEGER'IMAGE(V'FIRST));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 16");
+     END;
+
+     BEGIN
+          DECLARE
+               V : ARR2 (6..IDENT_INT(4), 9..IDENT_INT(11));
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                       "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                       "THE INDEX SUBTYPE (17) " & INTEGER'IMAGE(V'FIRST));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 17");
+     END;
+
+     BEGIN
+          DECLARE
+               V : ARR2 (IDENT_INT(-1)..2, IDENT_INT(6)..4);
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
+                       "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
+                       "THE INDEX SUBTYPE (18) " & INTEGER'IMAGE(V'FIRST));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 18");
+     END;
+
+     BEGIN
+          DECLARE
+               V : ARR2 (6..-1, 11..9);
+          BEGIN
+               IF NOT EQUAL (V'FIRST, V'FIRST) THEN
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED FOR NULL CONSTRAINT - 19");
+     END;
+
+     BEGIN
+          DECLARE
+               V : ARR2 (IDENT_INT(11)..9, 6..IDENT_INT(0));
+          BEGIN
+               IF NOT EQUAL (V'FIRST, V'FIRST) THEN
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED FOR NULL CONSTRAINT - 20");
+     END;
+
+     RESULT;
+END C36172B; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36172c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36172c.ada
new file mode 100644
index 000000000..4d97fa13a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36172c.ada
@@ -0,0 +1,58 @@
+-- C36172C.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 NO EXCEPTION IS RAISED FOR A NULL ARRAY WHOSE DIFFERENCE
+-- IN BOUNDS LIES OUTSIDE THE INDEX BASE TYPE.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- JBG 6/5/85
+-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C36172C IS
+BEGIN
+     TEST ("C36172C", "CHECK THAT NO EXCEPTION IS RAISED FOR A NULL " &
+                      "ARRAY WHOSE DIFFERENCE IN BOUNDS LIES OUTSIDE " &
+                      "THE INDEX BASE TYPE");
+
+     BEGIN
+          DECLARE
+               V : STRING (INTEGER'LAST .. -2);
+          BEGIN
+               IF NOT EQUAL (V'FIRST, V'FIRST) THEN
+                    FAILED ("IMPOSSIBLE");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C36172C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36174a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36174a.ada
new file mode 100644
index 000000000..667512abc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36174a.ada
@@ -0,0 +1,118 @@
+-- C36174A.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 INDEX_CONSTRAINTS MAY BE OMITTED FOR CONSTANTS.
+
+-- DAT 2/9/81
+-- JBG 12/8/83
+
+
+WITH REPORT;
+PROCEDURE C36174A IS
+
+     USE REPORT;
+
+     S0 : CONSTANT STRING := "";
+     S1 : CONSTANT STRING := S0;
+     S2 : CONSTANT STRING := (1 .. 0 => 'Z');
+     S3 : CONSTANT STRING := ('A', 'B', 'C');
+     S4 : CONSTANT STRING := S3 & "ABC" & S3 & S2 & "Z";
+     S9 : CONSTANT STRING := S0 & S1 & S2 & S3(3..1);
+
+     TYPE A4 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>,
+          INTEGER RANGE <>, INTEGER RANGE <>) OF STRING (1 .. 0);
+     C4 : CONSTANT A4 :=
+          (-6 .. -4 =>
+               (4 .. 5 =>
+                    (-4 .. -5 =>
+                         (1000 .. 2000 =>
+                              S9))));
+     S10 : CONSTANT STRING := (10 .. 9 => 'Q');
+
+     TYPE I_12 IS NEW INTEGER RANGE 10 .. 12;
+     TYPE A_12 IS ARRAY (I_12 RANGE <>, I_12 RANGE <>) OF I_12;
+     A12 : CONSTANT A_12 :=
+          (11 .. 12 => (10 .. 10 => 10));
+     B12 : CONSTANT A_12 :=
+          (11 => (10 | 12 => 10, 11 => 11),
+           10 => (10 | 12 | 11 => 12));
+
+     N6 : CONSTANT INTEGER := IDENT_INT (6);
+     S6 : CONSTANT STRING := (N6 .. N6 + 6 => 'Z');
+     S7 : CONSTANT STRING := S6 (N6 .. N6 + IDENT_INT (-1));
+
+BEGIN
+     TEST ("C36174A", "INDEX_CONSTRAINTS MAY BE OMITTED FOR CONSTANTS");
+
+     IF S0'FIRST /= 1 OR S0'LAST /= 0
+     OR S1'FIRST /= 1 OR S1'LAST /= 0
+     OR S2'FIRST /= 1 OR S2'LAST /= 0
+     OR S3'FIRST /= 1 OR S3'LAST /= 3
+     THEN
+          FAILED ("INVALID STRING CONSTANT BOUNDS 1");
+     END IF;
+
+     IF S4'FIRST /= 1 OR S4'LAST /= 10 THEN
+          FAILED ("INVALID STRING CONSTANT BOUNDS 2");
+     END IF;
+
+     IF S9'FIRST /= 3 OR S9'LAST /= 1 THEN
+          FAILED ("INVALID STRING CONSTANT BOUNDS 3");
+     END IF;
+
+     IF C4'FIRST(1) /= -6 OR C4'LAST(1) /= -4
+     OR C4'FIRST(2) /= 4 OR C4'LAST(2) /= 5
+     OR C4'FIRST(3) /= -4 OR C4'LAST(3) /= -5
+     OR C4'FIRST(4) /= 1000 OR C4'LAST(4) /= 2000
+     THEN
+          FAILED ("INVALID ARRAY CONSTANT BOUNDS");
+     END IF;
+
+     IF S10'FIRST /= 10 OR S10'LAST /= 9
+     THEN
+          FAILED ("INVALID STRING CONSTANT BOUNDS 10");
+     END IF;
+
+     IF A12'FIRST /= 11 OR A12'LAST /= 12
+     OR A12'FIRST(2) /= 10 OR A12'LAST(2) /= 10
+     THEN FAILED ("INVALID ARRAY CONSTANT BOUNDS 2");
+     END IF;
+
+     IF B12'FIRST /= 10 OR B12'LAST /= 11
+     OR B12'FIRST(2) /= 10 OR B12'LAST(2) /= 12
+     THEN
+          FAILED ("INVALID ARRAY CONSTANT BOUNDS 3");
+     END IF;
+
+     IF S6'FIRST /= 6 OR S6'LAST /= 12 OR S6'LENGTH /= 7
+     THEN
+          FAILED ("INVALID STRING CONSTANT  BOUNDS 12");
+     END IF;
+
+     IF S7'FIRST /= 6 OR S7'LAST /= 5 THEN
+          FAILED ("INVALID STRING CONSTANT BOUNDS 13");
+     END IF;
+
+     RESULT;
+END C36174A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36180a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36180a.ada
new file mode 100644
index 000000000..553809605
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36180a.ada
@@ -0,0 +1,136 @@
+-- C36180A.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 INDEX CONSTRAINT CAN HAVE THE FORM A'RANGE,
+--     WHERE A IS A PREVIOUSLY DECLARED ARRAY OBJECT OR CONSTRAINED
+--     ARRAY SUBTYPE.
+
+-- HISTORY:
+--     BCB 01/21/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C36180A IS
+
+     TYPE J IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+
+     TYPE K IS ARRAY (1..10) OF INTEGER;
+
+     SUBTYPE A IS J (0 .. 50);
+
+     SUBTYPE W IS J (A'RANGE);
+
+     SUBTYPE X IS J (K'RANGE);
+
+     TYPE Y IS ACCESS J;
+
+     TYPE Z IS ACCESS J;
+
+     TYPE F IS NEW J (A'RANGE);
+
+     TYPE G IS NEW J (K'RANGE);
+
+     B : ARRAY (A'RANGE) OF INTEGER;
+
+     C : ARRAY (K'RANGE) OF INTEGER;
+
+     D : ARRAY (1 .. 10) OF INTEGER;
+
+     E : ARRAY (D'RANGE) OF INTEGER;
+
+     H : J (A'RANGE);
+
+     I : J (K'RANGE);
+
+     L : J (D'RANGE);
+
+     V1 : W;
+
+     V2 : X;
+
+     V3 : Y := NEW J (A'RANGE);
+
+     V4 : Z := NEW J (K'RANGE);
+
+     V5 : F;
+
+     V6 : G;
+
+BEGIN
+     TEST ("C36180A", "CHECK THAT AN INDEX CONSTRAINT CAN HAVE THE " &
+                      "FORM A'RANGE, WHERE A IS A PREVIOUSLY " &
+                      "DECLARED ARRAY OBJECT OR CONSTRAINED ARRAY " &
+                      "SUBTYPE");
+
+     IF B'FIRST /= IDENT_INT (0) OR B'LAST /= IDENT_INT (50)
+          THEN FAILED ("IMPROPER VALUE FOR B'FIRST OR B'LAST");
+     END IF;
+
+     IF C'FIRST /= IDENT_INT (1) OR C'LAST /= IDENT_INT (10)
+          THEN FAILED ("IMPROPER VALUE FOR C'FIRST OR C'LAST");
+     END IF;
+
+     IF E'FIRST /= IDENT_INT (1) OR E'LAST /= IDENT_INT (10)
+          THEN FAILED ("IMPROPER VALUE FOR E'FIRST OR E'LAST");
+     END IF;
+
+     IF H'FIRST /= IDENT_INT (0) OR H'LAST /= IDENT_INT (50)
+          THEN FAILED ("IMPROPER VALUE FOR H'FIRST OR H'LAST");
+     END IF;
+
+     IF I'FIRST /= IDENT_INT (1) OR I'LAST /= IDENT_INT (10)
+          THEN FAILED ("IMPROPER VALUE FOR I'FIRST OR I'LAST");
+     END IF;
+
+     IF L'FIRST /= IDENT_INT (1) OR L'LAST /= IDENT_INT (10)
+          THEN FAILED ("IMPROPER VALUE FOR L'FIRST OR L'LAST");
+     END IF;
+
+     IF V1'FIRST /= IDENT_INT (0) OR V1'LAST /= IDENT_INT (50)
+          THEN FAILED ("IMPROPER VALUE FOR V1'FIRST OR V1'LAST");
+     END IF;
+
+     IF V2'FIRST /= IDENT_INT (1) OR V2'LAST /= IDENT_INT (10)
+          THEN FAILED ("IMPROPER VALUE FOR V2'FIRST OR V2'LAST");
+     END IF;
+
+     IF V3.ALL'FIRST /= IDENT_INT (0) OR V3.ALL'LAST /= IDENT_INT (50)
+          THEN FAILED ("IMPROPER VALUE FOR V3'FIRST OR V3'LAST");
+     END IF;
+
+     IF V4.ALL'FIRST /= IDENT_INT (1) OR V4.ALL'LAST /= IDENT_INT (10)
+          THEN FAILED ("IMPROPER VALUE FOR V4'FIRST OR V4'LAST");
+     END IF;
+
+     IF V5'FIRST /= IDENT_INT (0) OR V5'LAST /= IDENT_INT (50)
+          THEN FAILED ("IMPROPER VALUE FOR V5'FIRST OR V5'LAST");
+     END IF;
+
+     IF V6'FIRST /= IDENT_INT (1) OR V6'LAST /= IDENT_INT (10)
+          THEN FAILED ("IMPROPER VALUE FOR V6'FIRST OR V6'LAST");
+     END IF;
+
+     RESULT;
+END C36180A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36202c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36202c.ada
new file mode 100644
index 000000000..03ca89e77
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36202c.ada
@@ -0,0 +1,87 @@
+-- C36202C.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 'LENGTH DOES NOT RAISE AN EXCEPTION
+-- WHEN APPLIED TO A NULL ARRAY A, EVEN IF A'LAST - A'FIRST 
+-- WOULD RAISE CONSTRAINT_ERROR.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- L.BROWN  07/29/86
+-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+
+PROCEDURE C36202C IS
+
+     TYPE LRG_INT IS RANGE MIN_INT .. MAX_INT;
+
+     BEGIN
+          TEST("C36202C", "NO EXCEPTION IS RAISED FOR 'LENGTH "&
+                          "WHEN APPLIED TO A NULL ARRAY");
+              
+          DECLARE
+               TYPE LRG_ARR IS ARRAY
+                              (LRG_INT RANGE MAX_INT .. MIN_INT)
+                                     OF INTEGER;
+               LRG_OBJ : LRG_ARR;
+
+          BEGIN
+               IF LRG_OBJ'LENGTH /= 0  THEN
+                    FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                           "FOR ONE-DIM NULL ARRAY");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED("CONSTRAINT_ERROR WAS RAISED " &
+                           "FOR ONE-DIM NULL ARRAY");
+               WHEN OTHERS =>
+                    FAILED("EXCEPTION RAISED FOR ONE-DIM " &
+                           "NULL ARRAY");
+          END;
+
+          DECLARE
+               TYPE LRG2_ARR IS ARRAY (LRG_INT RANGE 1 .. 3 ,
+                                LRG_INT RANGE MAX_INT .. MIN_INT)
+                                OF INTEGER;
+          BEGIN
+               IF LRG2_ARR'LENGTH(2) /= 0  THEN
+                    FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                           "FOR TWO-DIM NULL ARRAY");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED("CONSTRAINT_ERROR WAS RAISED " &
+                           "FOR TWO-DIM NULL ARRAY");
+               WHEN OTHERS =>
+                    FAILED("EXCEPTION RAISED FOR TWO-DIM " &
+                           "NULL ARRAY");
+          END;
+
+     RESULT;
+
+     END C36202C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36203a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36203a.ada
new file mode 100644
index 000000000..f3f7e2bc7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36203a.ada
@@ -0,0 +1,76 @@
+-- C36203A.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 'LENGTH YIELDS A RESULT OF TYPE UNIVERSAL INTEGER.
+
+-- L.BROWN  07/31/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C36203A IS
+
+     TYPE NINT IS NEW INTEGER RANGE 1 .. 5;
+
+     TYPE INT_ARR IS ARRAY(INTEGER RANGE 1 .. 3) OF INTEGER;
+     TYPE INT2_ARR IS ARRAY(INTEGER RANGE 1 .. 3,
+                            INTEGER RANGE 1 .. 2) OF INTEGER;
+
+     OBJA : INTEGER := 3;
+     OBJB : NINT := 3;
+
+BEGIN
+     TEST("C36203A", "'LENGTH YIELDS A RESULT OF TYPE " &
+                     "UNIVERSAL INTEGER");
+     IF (OBJA + INT_ARR'LENGTH) /= IDENT_INT(6)  THEN
+          FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                 "FOR ONE-DIM ARRAY TYPE 1");
+     END IF;
+
+     IF (OBJB + INT_ARR'LENGTH) /= 6  THEN
+          FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                 "FOR ONE-DIM ARRAY TYPE 2");
+     END IF;
+
+     IF (OBJA + INT2_ARR'LENGTH(1)) /= IDENT_INT(6)  THEN
+          FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                 "FOR FIRST DIMENSION OF TWO-DIM ARRAY TYPE 1");
+     END IF;
+
+     IF (OBJB + INT2_ARR'LENGTH(1)) /= 6  THEN
+          FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                 "FOR FIRST DIMENSION OF TWO-DIM ARRAY TYPE 2");
+     END IF;
+
+     IF (OBJA + INT2_ARR'LENGTH(2)) /= IDENT_INT(5)  THEN
+          FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                 "FOR SECOND DIMENSION OF TWO-DIM ARRAY TYPE 1");
+     END IF;
+
+     IF (OBJB + INT2_ARR'LENGTH(2)) /= 5  THEN
+          FAILED("INCORRECT VALUE RETURNED BY 'LENGTH " &
+                 "FOR SECOND DIMENSION OF TWO-DIM ARRAY TYPE 2");
+     END IF;
+
+     RESULT;
+
+END C36203A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204a.ada
new file mode 100644
index 000000000..4a4c37429
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204a.ada
@@ -0,0 +1,142 @@
+-- C36204A.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 EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES.
+-- BOTH ARRAY OBJECTS AND TYPES ARE CHECKED.
+
+-- DAT 2/12/81
+-- SPS 11/1/82
+-- WMC 03/16/92  CREATED TYPE RANGE CHECK FOR AE_TYPE.
+
+WITH REPORT;
+PROCEDURE C36204A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C36204A", "ARRAY ATTRIBUTES RETURN CORRECT VALUES");
+
+     DECLARE
+          A1 : ARRAY (BOOLEAN,
+                      INTEGER RANGE IDENT_INT(1)..IDENT_INT(10))
+               OF STRING(IDENT_INT(5)..IDENT_INT(7));
+          TYPE NI IS  RANGE -3 .. 3;
+          N : NI := NI(IDENT_INT(2));
+          SUBTYPE SNI IS NI RANGE -N .. N;
+          TYPE AA IS ARRAY (NI, SNI, BOOLEAN)
+               OF NI;
+          A1_1_1 : BOOLEAN := A1'FIRST;
+          A1_1_2 : BOOLEAN := A1'LAST(1);
+          A1_2_1 : INTEGER RANGE A1'RANGE(2) := A1'FIRST(2);  -- 1
+          A1_2_2 : INTEGER RANGE A1'RANGE(2) := A1'LAST(2);   -- 10
+          SUBTYPE AE_TYPE IS INTEGER RANGE A1(TRUE,5)'RANGE;    -- RANGE 5..7
+          A2 : AA;
+          A4 : ARRAY (A1_1_1 .. A1_1_2, A1_2_1 .. A1_2_2) OF
+               STRING (IDENT_INT(1)..IDENT_INT(3));
+
+          I : INTEGER;
+          B : BOOLEAN;
+     BEGIN
+          IF A4'FIRST /= IDENT_BOOL(FALSE)
+             OR A4'LAST /= IDENT_BOOL(TRUE)
+             OR A4'FIRST(2) /= INTEGER'(1)
+             OR A4'LAST(2) /= INTEGER'(10)
+          THEN
+               FAILED ("INCORRECT 'FIRST OR 'LAST  - 1");
+          END IF;
+      
+          IF A4'LENGTH /= INTEGER'(2)
+             OR A4'LENGTH /= NI'(2)
+             OR A4'LENGTH(1) /= N
+             OR A4'LENGTH(2) /= A4'LAST(2)
+          THEN
+               FAILED ("INCORRECT 'LENGTH - 1");
+          END IF;
+
+          A4 := (BOOLEAN => (1 .. 10 => "XYZ"));
+          FOR L1 IN A1'RANGE(1) LOOP
+               FOR L2 IN A4'RANGE(2) LOOP
+                    A1(L1,L2) := A4(L1,L2);
+               END LOOP;
+          END LOOP;
+
+          IF AA'FIRST(1) /= NI'(-3)
+             OR AA'LAST(1) /= N + 1
+             OR AA'FIRST(2) /= -N
+             OR AA'LAST(2) /= N
+             OR AA'FIRST(3) /= IDENT_BOOL(FALSE)
+             OR AA'LAST(3) /= IDENT_BOOL(TRUE)
+          THEN
+               FAILED ("INCORRECT 'FIRST OR 'LAST - 2");
+          END IF;
+
+          IF N NOT IN AA'RANGE(2)
+             OR IDENT_BOOL(FALSE) NOT IN AA'RANGE(3)
+             OR N + 1 NOT IN AA'RANGE
+             OR N + 1 IN AA'RANGE(2)
+          THEN
+               FAILED ("INCORRECT 'RANGE - 1");
+          END IF;
+
+          IF AA'LENGTH /= INTEGER'(7)
+             OR AA'LENGTH(2) - 3 /= N
+             OR AA'LENGTH(3) /= 2
+          THEN
+               FAILED ("INCORRECT 'LENGTH - 2");
+          END IF;
+
+          IF A2'FIRST(1) /= NI'(-3)
+             OR A2'LAST(1) /= N + 1
+             OR A2'FIRST(2) /= -N
+             OR A2'LAST(2) /= N
+             OR A2'FIRST(3) /= IDENT_BOOL(FALSE)
+             OR A2'LAST(3) /= IDENT_BOOL(TRUE)
+          THEN 
+               FAILED ("INCORRECT 'FIRST OR 'LAST - 3");
+          END IF;
+
+          IF N NOT IN A2'RANGE(2)
+             OR IDENT_BOOL(FALSE) NOT IN A2'RANGE(3)
+             OR N + 1 NOT IN A2'RANGE
+             OR N + 1 IN A2'RANGE(2)
+          THEN
+               FAILED ("INCORRECT 'RANGE - 2");
+          END IF;
+
+          IF A2'LENGTH /= INTEGER'(7)
+             OR A2'LENGTH(2) - 3 /= INTEGER(N)
+             OR A2'LENGTH(3) /= 2
+          THEN
+               FAILED ("INCORRECT 'LENGTH - 3");
+          END IF;
+
+          IF (AE_TYPE'FIRST /= 5) OR (AE_TYPE'LAST /= 7) THEN
+             FAILED ("INCORRECT TYPE RANGE DEFINED FOR AE_TYPE");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS => FAILED  ("EXCEPTION RAISED ?");
+     END;
+
+     RESULT;
+END C36204A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204b.ada
new file mode 100644
index 000000000..82f6b9369
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204b.ada
@@ -0,0 +1,229 @@
+-- C36204B.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 EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES WITH
+--     ACCESS VALUES AND FUNCTION CALLS AS THE PREFIXES.
+
+-- HISTORY:
+--     L.BROWN   08/05/86
+--     DWC  07/24/87  DELETED BLANK AT END OF TEST DESCRIPTION.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C36204B IS
+
+     BEGIN
+          TEST("C36204B", "ARRAY ATTRIBUTES RETURN CORRECT VALUES " &
+                          "FOR ACCESS VALUES AND FUNCTION CALLS AS " &
+                          "PREFIXES");
+          DECLARE
+               TYPE ARR1 IS ARRAY (INTEGER RANGE IDENT_INT(1) ..
+                                   IDENT_INT(10)) OF INTEGER ;
+               TYPE ARR2 IS ARRAY (BOOLEAN,
+                                   INTEGER RANGE IDENT_INT(1) ..
+                                   IDENT_INT(3)) OF INTEGER ;
+
+               TYPE PTR1 IS ACCESS ARR1;
+               TYPE PTR2 IS ACCESS ARR2;
+
+               PT1 : PTR1 := NEW ARR1'(ARR1'RANGE => 0);
+               PT2 : PTR2 := NEW ARR2'(ARR2'RANGE(1) =>
+                                      (ARR2'RANGE(2) => 0));
+               SUBTYPE ARR1_RANGE IS INTEGER RANGE PT1'RANGE;
+          BEGIN
+               IF PT1'FIRST /= IDENT_INT(1) THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING ACCESS TYPES AS PREFIXES 1");
+               END IF;
+
+               IF PT2'FIRST(2) /= IDENT_INT(1)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                           "ARRAY USING ACCESS TYPES AS PREFIXES 1");
+               END IF;
+
+               IF ARR1_RANGE'FIRST /= IDENT_INT(1) THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING ACCESS TYPES AS PREFIXES 2");
+               END IF;
+
+               IF PT1'LAST /= IDENT_INT(10) THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING ACCESS TYPES AS PREFIXES 3");
+               END IF;
+
+               IF PT2'LAST(2) /= IDENT_INT(3)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                           "ARRAY USING ACCESS TYPES AS PREFIXES 2");
+               END IF;
+
+               IF ARR1_RANGE'LAST /= IDENT_INT(10) THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING ACCESS TYPES AS PREFIXES 4");
+               END IF;
+
+               IF PT1'LENGTH /= IDENT_INT(10) THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING ACCESS TYPES AS PREFIXES 5");
+               END IF;
+
+               IF PT2'LENGTH(2) /= IDENT_INT(3)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                           "ARRAY USING ACCESS TYPES AS PREFIXES 3");
+               END IF;
+
+          END;
+
+          DECLARE
+
+               TYPE UNCON IS ARRAY (INTEGER RANGE <>) OF INTEGER ;
+               TYPE UNCON2 IS ARRAY (INTEGER RANGE <>,
+                                     INTEGER RANGE <>) OF INTEGER ;
+
+               ARY1 : STRING(IDENT_INT(5) .. IDENT_INT(8));
+               F : INTEGER := IDENT_INT(1);
+               L : INTEGER := IDENT_INT(3);
+
+               FUNCTION FUN( LO,HI : INTEGER ) RETURN UNCON IS
+                    ARR : UNCON(IDENT_INT(LO) .. IDENT_INT(HI));
+                    BEGIN
+                         ARR := (ARR'RANGE => 0);
+                         RETURN ARR;
+                    END FUN;
+
+               FUNCTION FUN2( LO,HI : INTEGER ) RETURN UNCON2 IS
+                    AR2 : UNCON2(IDENT_INT(LO) .. IDENT_INT(HI),
+                                 IDENT_INT(LO) .. IDENT_INT(HI));
+                    BEGIN
+                         AR2 := (AR2'RANGE(1) =>(AR2'RANGE(2) => 0));
+                         RETURN AR2;
+                    END FUN2;
+          BEGIN
+
+               ARY1 := (ARY1'RANGE => 'A');
+
+               IF FUN(F,L)'FIRST /= IDENT_INT(1)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING FUNCTION RESULTS AS " &
+                           "PREFIXES 1");
+               END IF;
+
+               IF FUN2(F,L)'FIRST(2) /= IDENT_INT(1)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                           "ARRAY USING FUNCTION RESULTS AS " &
+                           "PREFIXES 1");
+               END IF;
+
+               IF "&"(ARY1,"XX")'FIRST /= IDENT_INT(5)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING FUNCTION RESULTS AS " &
+                           "PREFIXES 2");
+               END IF;
+
+               IF FUN(F,L)'LAST /= IDENT_INT(3)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING FUNCTION RESULTS AS " &
+                           "PREFIXES 3");
+               END IF;
+
+               IF FUN2(F,L)'LAST(2) /= IDENT_INT(3)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                           "ARRAY USING FUNCTION RESULTS AS " &
+                           "PREFIXES 2");
+               END IF;
+
+               IF "&"(ARY1,"YY")'LAST /= IDENT_INT(10)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING FUNCTION RESULTS AS " &
+                           "PREFIXES 4");
+               END IF;
+
+               IF FUN(F,L)'LENGTH /= IDENT_INT(3) THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING FUNCTION RESULTS AS " &
+                           "PREFIXES 5");
+               END IF;
+
+               IF FUN2(F,L)'LENGTH(2) /= IDENT_INT(3)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
+                           "ARRAY USING FUNCTION RESULTS AS " &
+                           "PREFIXES 3");
+               END IF;
+
+               IF "&"(ARY1,"XX")'LENGTH /= IDENT_INT(6)  THEN
+                    FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
+                           "ARRAY USING FUNCTION RESULTS AS " &
+                           "PREFIXES 6");
+               END IF;
+
+               DECLARE
+
+                    SUBTYPE SMIN IS INTEGER RANGE FUN(F,L)'RANGE;
+                    SUBTYPE SMIN2 IS INTEGER RANGE FUN2(F,L)'RANGE(2);
+                    SUBTYPE SMIN3 IS INTEGER RANGE "&"(ARY1,"YY")'RANGE;
+
+               BEGIN
+                    IF SMIN'FIRST /= IDENT_INT(1)  THEN
+                         FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                "ONE-DIM ARRAY USING FUNCTION " &
+                                "RESULTS AS PREFIXES 7");
+                    END IF;
+
+                    IF SMIN2'FIRST /= IDENT_INT(1)  THEN
+                         FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                "TWO-DIM ARRAY USING FUNCTION " &
+                                "RESULTS AS PREFIXES 4");
+                    END IF;
+
+                    IF SMIN3'FIRST /= IDENT_INT(5)  THEN
+                         FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                "ONE-DIM ARRAY USING FUNCTION " &
+                                "RESULTS AS PREFIXES 8");
+                    END IF;
+
+                    IF SMIN'LAST /= IDENT_INT(3)  THEN
+                         FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                "ONE-DIM ARRAY USING FUNCTION " &
+                                "RESULTS AS PREFIXES 9");
+                    END IF;
+
+                    IF SMIN2'LAST /= IDENT_INT(3)  THEN
+                         FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                "TWO-DIM ARRAY USING FUNCTION " &
+                                "RESULTS AS PREFIXES 5");
+                    END IF;
+
+                    IF SMIN3'LAST /= IDENT_INT(10)  THEN
+                         FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
+                                "ONE-DIM ARRAY USING FUNCTION " &
+                                "RESULTS AS PREFIXES 10");
+                    END IF;
+
+               END;
+
+          END;
+
+     RESULT;
+
+     END C36204B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204c.ada
new file mode 100644
index 000000000..171369528
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204c.ada
@@ -0,0 +1,221 @@
+-- C36204C.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 'RANGE ATTRIBUTE CAN BE USED TO DECLARE OBJECTS
+--     AND IN A SUBTYPE AND TYPE DECLARATION.
+
+-- HISTORY:
+--     LB  08/13/86  CREATED ORIGINAL TEST.
+--     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.
+--                   REARRANGED STATEMENTS SO TEST IS CALLED FIRST.
+--                   ELIMINATED DEAD VARIABLE OPTIMIZATION.  CHECKED
+--                   RANGE VALUES FOR A SMALL INTEGER.
+
+WITH REPORT; USE REPORT;
+PROCEDURE  C36204C  IS
+
+BEGIN
+     TEST("C36204C","USING 'RANGE TO DECLARE OBJECTS AND " &
+                    "IN A SUBTYPE AND TYPE DECLARATION " &
+                    "RETURNS THE CORRECT VALUES.");
+
+     DECLARE
+
+          ARR : ARRAY(IDENT_INT(4) .. IDENT_INT(10)) OF INTEGER;
+          OBJ1 : ARRAY(ARR'RANGE) OF BOOLEAN;
+
+          SUBTYPE SMALL_INT IS INTEGER RANGE ARR'RANGE ;
+          SML : SMALL_INT;
+
+          TYPE OTHER_ARR IS ARRAY(ARR'RANGE) OF CHARACTER;
+          OBJ2 : OTHER_ARR;
+
+          TYPE ARR_TYPE IS ARRAY(INTEGER RANGE IDENT_INT(1) ..
+                                 IDENT_INT(10)) OF INTEGER;
+          TYPE ARR_PTR IS ACCESS ARR_TYPE;
+          PTR : ARR_PTR := NEW ARR_TYPE'(ARR_TYPE'RANGE => 0);
+
+          FUNCTION F RETURN ARR_TYPE IS
+               AR : ARR_TYPE := (ARR_TYPE'RANGE => 0);
+               BEGIN
+                    RETURN AR;
+               END F;
+
+          BEGIN
+               BEGIN
+                    IF OBJ1'FIRST /= IDENT_INT(4)  THEN
+                         FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " &
+                                "DECLARATION 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("EXCEPTION RAISED WHEN CHECKING " &
+                                "OBJECT DECLARATION 1");
+               END;
+
+               BEGIN
+                    IF OBJ1'LAST /= IDENT_INT(10)  THEN
+                         FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " &
+                                "DECLARATION 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("EXCEPTION RAISED WHEN CHECKING " &
+                                "OBJECT DECLARATION 2");
+               END;
+
+               BEGIN
+                    IF SMALL_INT'FIRST /= 4 THEN
+                         FAILED("INCORRECT RANGE VALUE FOR A SMALL " &
+                                "INTEGER DECLARATION 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" &
+                                " INTEGER DECLARATION 1");
+               END;
+
+               BEGIN
+                    IF SMALL_INT'LAST /= 10 THEN
+                         FAILED("INCORRECT RANGE VALUE FOR A SMALL " &
+                                "INTEGER DECLARATION 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" &
+                                " INTEGER DECLARATION 2");
+               END;
+
+               BEGIN
+                    SML := IDENT_INT(3) ;
+                    IF SML = 3 THEN
+                         COMMENT("VARIABLE SML OPTIMIZED VALUE 1");
+                    END IF;
+                    FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
+                           "VALUE 1");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
+                                "RANGE VALUE 1");
+               END;
+
+               BEGIN
+                    SML := IDENT_INT(11) ;
+                    IF SML = 11 THEN
+                         COMMENT("VARIABLE SML OPTIMIZED VALUE 2");
+                    END IF;
+                    FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
+                           "VALUE 2");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
+                                "RANGE VALUE 2");
+               END;
+
+               BEGIN
+                    IF OBJ2'FIRST /= IDENT_INT(4)  THEN
+                         FAILED("INCORRECT RANGE VALUE FOR A TYPE " &
+                                "DECLARATION 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("EXCEPTION RAISED WHEN CHECKING A " &
+                                "TYPE DECLARATION 1");
+               END;
+
+               BEGIN
+                    IF OBJ2'LAST /= IDENT_INT(10)  THEN
+                         FAILED("INCORRECT RANGE VALUE FOR A TYPE " &
+                                "DECLARATION 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("EXCEPTION RAISED WHEN CHECKING A " &
+                                "TYPE DECLARATION 2");
+               END;
+
+               BEGIN
+                    IF PTR'FIRST /= IDENT_INT(1)  THEN
+                         FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " &
+                                "TYPE DECLARATION 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("EXCEPTION RAISED WHEN CHECKING AN " &
+                                "ACCESS TYPE DECLARATION 1");
+               END;
+
+               BEGIN
+                    IF PTR'LAST /= IDENT_INT(10)  THEN
+                         FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " &
+                                "TYPE DECLARATION 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("EXCEPTION RAISED WHEN CHECKING AN " &
+                                "ACCESS TYPE DECLARATION 2");
+               END;
+
+               DECLARE
+                    OBJ_F1 : INTEGER RANGE F'RANGE ;
+               BEGIN
+                    OBJ_F1 := IDENT_INT(0) ;
+                    IF OBJ_F1 = 0 THEN
+                         COMMENT("VARIABLE OBJ_F1 OPTIMIZED VALUE 1");
+                    END IF;
+                    FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
+                           "VALUE 3");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
+                                "RANGE VALUE 3");
+               END;
+
+               DECLARE
+                    OBJ_F2 : INTEGER RANGE F'RANGE ;
+               BEGIN
+                    OBJ_F2 := IDENT_INT(11) ;
+                    IF OBJ_F2 = 11 THEN
+                         COMMENT("VARIABLE OBJ_F2 OPTIMIZED VALUE 1");
+                    END IF;
+                    FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
+                           "VALUE 4");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
+                                "RANGE VALUE 4");
+               END;
+          END;
+     RESULT;
+
+END C36204C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204d.ada
new file mode 100644
index 000000000..afdadbf53
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36204d.ada
@@ -0,0 +1,598 @@
+-- C36204D.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 EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES.
+-- BOTH ARRAY OBJECTS AND TYPES ARE CHECKED. THIS TEST CHECKS 
+-- THE ABOVE FOR ARRAYS WITHIN GENERIC PROGRAM UNITS.
+
+-- HISTROY
+--  EDWARD V. BERARD, 9 AUGUST 1990
+
+WITH REPORT ;
+WITH SYSTEM ;
+
+PROCEDURE C36204D IS
+
+    SHORT_START : CONSTANT := -10 ;
+    SHORT_END    : CONSTANT := 10 ;
+    TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+    SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
+    
+    TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                        SEP, OCT, NOV, DEC) ;
+    SUBTYPE MID_YEAR IS MONTH_TYPE RANGE MAY .. AUG ;
+    TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+    TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+    TYPE DATE IS RECORD
+      MONTH : MONTH_TYPE ;
+      DAY   : DAY_TYPE ;
+      YEAR  : YEAR_TYPE ;
+    END RECORD ;
+    
+    TODAY         : DATE := (MONTH => AUG,
+                             DAY   => 10,
+                             YEAR  => 1990) ;
+                            
+    FIRST_DATE     : DATE := (DAY   => 6,
+                              MONTH => JUN,
+                              YEAR  => 1967) ;
+                            
+    FUNCTION "=" (LEFT  : IN SYSTEM.ADDRESS ;
+                  RIGHT : IN SYSTEM.ADDRESS ) RETURN BOOLEAN
+            RENAMES SYSTEM."=" ;
+
+    GENERIC
+    
+        TYPE FIRST_INDEX IS (<>) ;
+        FIRST_INDEX_LENGTH : IN NATURAL ;
+        FIRST_TEST_VALUE : IN FIRST_INDEX ;
+        TYPE SECOND_INDEX IS (<>) ;
+        SECOND_INDEX_LENGTH : IN NATURAL ;
+        SECOND_TEST_VALUE : IN SECOND_INDEX ;
+        TYPE THIRD_INDEX IS (<>) ;
+        THIRD_INDEX_LENGTH : IN NATURAL ;
+        THIRD_TEST_VALUE : IN THIRD_INDEX ;
+        TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
+        FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+        SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+        TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
+        THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+        FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+    
+    PACKAGE ARRAY_ATTRIBUTE_TEST IS
+    
+        TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
+            OF FIRST_COMPONENT_TYPE ;
+            
+        TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
+            OF SECOND_COMPONENT_TYPE ;
+            
+    END ARRAY_ATTRIBUTE_TEST ;
+    
+    PACKAGE BODY ARRAY_ATTRIBUTE_TEST IS
+    
+        FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                    FIRST_DEFAULT_VALUE)) ;
+        
+        SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                       THIRD_DEFAULT_VALUE))) ;
+                                    
+        THIRD_ARRAY : CONSTANT MATRIX 
+                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                    SECOND_DEFAULT_VALUE)) ;
+                                        
+        FOURTH_ARRAY : CONSTANT CUBE 
+                            := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                       FOURTH_DEFAULT_VALUE))) ;
+                                    
+        FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
+        FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
+        FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
+        FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
+        
+        SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
+        SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
+        SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
+        SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
+        SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
+        SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
+        
+        FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
+        FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
+        
+        SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
+        SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
+        SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
+        
+        MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
+        CUBE_SIZE    : NATURAL := CUBE'SIZE ;
+        
+        FAA  : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
+        SAA  : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
+        TAA  : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
+        FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
+             
+     BEGIN  -- ARRAY_ATTRIBUTE_TEST
+     
+        IF (FA1 /= FIRST_INDEX'FIRST) OR
+           (FA3 /= SECOND_INDEX'FIRST) OR
+           (SA1 /= FIRST_INDEX'FIRST) OR
+           (SA3 /= SECOND_INDEX'FIRST) OR
+           (SA5 /= THIRD_INDEX'FIRST) THEN
+            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST - PACKAGE") ;
+        END IF ;
+        
+        IF (FA2 /= FIRST_INDEX'LAST) OR
+           (FA4 /= SECOND_INDEX'LAST) OR
+           (SA2 /= FIRST_INDEX'LAST) OR
+           (SA4 /= SECOND_INDEX'LAST) OR
+           (SA6 /= THIRD_INDEX'LAST) THEN
+            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST - PACKAGE") ;
+        END IF ;
+        
+        IF (FAL1 /= FIRST_INDEX_LENGTH) OR
+           (FAL2 /= SECOND_INDEX_LENGTH) OR
+           (SAL1 /= FIRST_INDEX_LENGTH) OR
+           (SAL2 /= SECOND_INDEX_LENGTH) OR
+           (SAL3 /= THIRD_INDEX_LENGTH) THEN
+            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH - PACKAGE") ;
+        END IF ;
+        
+        FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
+            FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
+                FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
+                    SECOND_DEFAULT_VALUE ;
+            END LOOP ;
+        END LOOP ;
+        
+        IF FIRST_ARRAY /= THIRD_ARRAY THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                           "FOR 2-DIMENSIONAL ARRAY. - PACKAGE") ;
+        END IF ;
+        
+        FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
+            FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
+                FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
+                    SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
+                        := FOURTH_DEFAULT_VALUE ;
+                END LOOP ;
+            END LOOP ;
+        END LOOP ;
+        
+        IF SECOND_ARRAY /= FOURTH_ARRAY THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                           "FOR 3-DIMENSIONAL ARRAY. - PACKAGE") ;
+        END IF ;
+        
+        IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
+           (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
+           (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
+           (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
+           (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                           "- PACKAGE") ;
+        END IF ;
+        
+        IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
+                           "- PACKAGE") ;
+        END IF ;
+        
+        IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
+           OR (SAA = TAA) OR (TAA = FRAA) THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
+                           "- PACKAGE") ;
+        END IF ;
+        
+    END ARRAY_ATTRIBUTE_TEST ;
+
+    GENERIC
+    
+        TYPE FIRST_INDEX IS (<>) ;
+        FIRST_INDEX_LENGTH : IN NATURAL ;
+        FIRST_TEST_VALUE : IN FIRST_INDEX ;
+        TYPE SECOND_INDEX IS (<>) ;
+        SECOND_INDEX_LENGTH : IN NATURAL ;
+        SECOND_TEST_VALUE : IN SECOND_INDEX ;
+        TYPE THIRD_INDEX IS (<>) ;
+        THIRD_INDEX_LENGTH : IN NATURAL ;
+        THIRD_TEST_VALUE : IN THIRD_INDEX ;
+        TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
+        FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+        SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+        TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
+        THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+        FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+        
+    PROCEDURE PROC_ARRAY_ATT_TEST ;
+    
+    PROCEDURE PROC_ARRAY_ATT_TEST IS
+    
+        TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
+            OF FIRST_COMPONENT_TYPE ;
+            
+        TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
+            OF SECOND_COMPONENT_TYPE ;
+            
+        FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                    FIRST_DEFAULT_VALUE)) ;
+        
+        SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                       THIRD_DEFAULT_VALUE))) ;
+                                    
+        THIRD_ARRAY : CONSTANT MATRIX 
+                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                    SECOND_DEFAULT_VALUE)) ;
+                                        
+        FOURTH_ARRAY : CONSTANT CUBE 
+                            := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                       FOURTH_DEFAULT_VALUE))) ;
+                                    
+        FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
+        FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
+        FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
+        FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
+        
+        SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
+        SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
+        SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
+        SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
+        SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
+        SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
+        
+        FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
+        FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
+        
+        SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
+        SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
+        SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
+        
+        MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
+        CUBE_SIZE    : NATURAL := CUBE'SIZE ;
+        
+        FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
+        SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
+        TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
+        FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
+             
+     BEGIN  -- PROC_ARRAY_ATT_TEST
+
+        IF (FA1 /= FIRST_INDEX'FIRST) OR
+           (FA3 /= SECOND_INDEX'FIRST) OR
+           (SA1 /= FIRST_INDEX'FIRST) OR
+           (SA3 /= SECOND_INDEX'FIRST) OR
+           (SA5 /= THIRD_INDEX'FIRST) THEN
+            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " &
+                           "- PROCEDURE") ;
+        END IF ;
+        
+        IF (FA2 /= FIRST_INDEX'LAST) OR
+           (FA4 /= SECOND_INDEX'LAST) OR
+           (SA2 /= FIRST_INDEX'LAST) OR
+           (SA4 /= SECOND_INDEX'LAST) OR
+           (SA6 /= THIRD_INDEX'LAST) THEN
+            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " &
+                           "- PROCEDURE") ;
+        END IF ;
+        
+        IF (FAL1 /= FIRST_INDEX_LENGTH) OR
+           (FAL2 /= SECOND_INDEX_LENGTH) OR
+           (SAL1 /= FIRST_INDEX_LENGTH) OR
+           (SAL2 /= SECOND_INDEX_LENGTH) OR
+           (SAL3 /= THIRD_INDEX_LENGTH) THEN
+            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " &
+                           "- PROCEDURE") ;
+        END IF ;
+        
+        FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
+            FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
+                FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
+                    SECOND_DEFAULT_VALUE ;
+            END LOOP ;
+        END LOOP ;
+        
+        IF FIRST_ARRAY /= THIRD_ARRAY THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                           "FOR 2-DIMENSIONAL ARRAY. - PROCEDURE") ;
+        END IF ;
+        
+        FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
+            FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
+                FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
+                    SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
+                        := FOURTH_DEFAULT_VALUE ;
+                END LOOP ;
+            END LOOP ;
+        END LOOP ;
+        
+        IF SECOND_ARRAY /= FOURTH_ARRAY THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                           "FOR 3-DIMENSIONAL ARRAY. - PROCEDURE") ;
+        END IF ;
+        
+        IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
+           (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
+           (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
+           (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
+           (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                           "- PROCEDURE") ;
+        END IF ;
+        
+        IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
+                           "- PROCEDURE") ;
+        END IF ;
+        
+        IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
+           OR (SAA = TAA) OR (TAA = FRAA) THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
+                           "- PROCEDURE") ;
+        END IF ;
+        
+    END PROC_ARRAY_ATT_TEST ;
+
+    GENERIC
+    
+        TYPE FIRST_INDEX IS (<>) ;
+        FIRST_INDEX_LENGTH : IN NATURAL ;
+        FIRST_TEST_VALUE : IN FIRST_INDEX ;
+        TYPE SECOND_INDEX IS (<>) ;
+        SECOND_INDEX_LENGTH : IN NATURAL ;
+        SECOND_TEST_VALUE : IN SECOND_INDEX ;
+        TYPE THIRD_INDEX IS (<>) ;
+        THIRD_INDEX_LENGTH : IN NATURAL ;
+        THIRD_TEST_VALUE : IN THIRD_INDEX ;
+        TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
+        FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+        SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
+        TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
+        THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+        FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
+        
+    FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN ;
+    
+    FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN IS
+    
+        TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
+            OF FIRST_COMPONENT_TYPE ;
+            
+        TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
+            OF SECOND_COMPONENT_TYPE ;
+            
+        FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                    FIRST_DEFAULT_VALUE)) ;
+        
+        SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                       THIRD_DEFAULT_VALUE))) ;
+                                    
+        THIRD_ARRAY : CONSTANT MATRIX 
+                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                                    SECOND_DEFAULT_VALUE)) ;
+                                        
+        FOURTH_ARRAY : CONSTANT CUBE 
+                            := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
+                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
+                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
+                                       FOURTH_DEFAULT_VALUE))) ;
+                                    
+        FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
+        FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
+        FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
+        FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
+        
+        SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
+        SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
+        SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
+        SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
+        SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
+        SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
+        
+        FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
+        FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
+        
+        SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
+        SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
+        SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
+        
+        MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
+        CUBE_SIZE    : NATURAL := CUBE'SIZE ;
+        
+        FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
+        SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
+        TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
+        FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
+             
+     BEGIN  -- FUNC_ARRAY_ATT_TEST
+
+        IF (FA1 /= FIRST_INDEX'FIRST) OR
+           (FA3 /= SECOND_INDEX'FIRST) OR
+           (SA1 /= FIRST_INDEX'FIRST) OR
+           (SA3 /= SECOND_INDEX'FIRST) OR
+           (SA5 /= THIRD_INDEX'FIRST) THEN
+            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " &
+                           "- FUNCTION") ;
+        END IF ;
+        
+        IF (FA2 /= FIRST_INDEX'LAST) OR
+           (FA4 /= SECOND_INDEX'LAST) OR
+           (SA2 /= FIRST_INDEX'LAST) OR
+           (SA4 /= SECOND_INDEX'LAST) OR
+           (SA6 /= THIRD_INDEX'LAST) THEN
+            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " &
+                           "- FUNCTION") ;
+        END IF ;
+        
+        IF (FAL1 /= FIRST_INDEX_LENGTH) OR
+           (FAL2 /= SECOND_INDEX_LENGTH) OR
+           (SAL1 /= FIRST_INDEX_LENGTH) OR
+           (SAL2 /= SECOND_INDEX_LENGTH) OR
+           (SAL3 /= THIRD_INDEX_LENGTH) THEN
+            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " &
+                           "- FUNCTION") ;
+        END IF ;
+        
+        FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
+            FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
+                FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
+                    SECOND_DEFAULT_VALUE ;
+            END LOOP ;
+        END LOOP ;
+        
+        IF FIRST_ARRAY /= THIRD_ARRAY THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                           "FOR 2-DIMENSIONAL ARRAY. - FUNCTION") ;
+        END IF ;
+        
+        FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
+            FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
+                FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
+                    SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
+                        := FOURTH_DEFAULT_VALUE ;
+                END LOOP ;
+            END LOOP ;
+        END LOOP ;
+        
+        IF SECOND_ARRAY /= FOURTH_ARRAY THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                           "FOR 3-DIMENSIONAL ARRAY. - FUNCTION") ;
+        END IF ;
+        
+        IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
+           (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
+           (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
+           (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
+           (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
+                           "- FUNCTION") ;
+        END IF ;
+        
+        IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
+                           "- FUNCTION") ;
+        END IF ;
+        
+        IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
+           OR (SAA = TAA) OR (TAA = FRAA) THEN
+            REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
+                           "- FUNCTION") ;
+        END IF ;
+        
+        RETURN TRUE ;
+        
+    END FUNC_ARRAY_ATT_TEST ;
+
+
+BEGIN -- C36204D
+
+    REPORT.TEST ("C36204D", "ARRAY ATTRIBUTES RETURN CORRECT " &
+                  "VALUES WITHIN GENERIC PROGRAM UNITS.") ;
+     
+    LOCAL_BLOCK:
+    
+    DECLARE
+    
+        DUMMY : BOOLEAN := FALSE ;
+    
+        PACKAGE NEW_ARRAY_ATTRIBUTE_TEST IS NEW ARRAY_ATTRIBUTE_TEST (
+            FIRST_INDEX             => SHORT_RANGE,
+            FIRST_INDEX_LENGTH      => SHORT_LENGTH,
+            FIRST_TEST_VALUE        => -7,
+            SECOND_INDEX            => MONTH_TYPE,
+            SECOND_INDEX_LENGTH     => 12,
+            SECOND_TEST_VALUE       => AUG,
+            THIRD_INDEX             => BOOLEAN,
+            THIRD_INDEX_LENGTH      => 2,
+            THIRD_TEST_VALUE        => FALSE,
+            FIRST_COMPONENT_TYPE    => MONTH_TYPE,
+            FIRST_DEFAULT_VALUE     => JAN,
+            SECOND_DEFAULT_VALUE    => DEC,
+            SECOND_COMPONENT_TYPE   => DATE,
+            THIRD_DEFAULT_VALUE     => TODAY,
+            FOURTH_DEFAULT_VALUE    => FIRST_DATE) ;
+        
+        PROCEDURE NEW_PROC_ARRAY_ATT_TEST IS NEW PROC_ARRAY_ATT_TEST (
+            FIRST_INDEX             => MONTH_TYPE,
+            FIRST_INDEX_LENGTH      => 12,
+            FIRST_TEST_VALUE        => AUG,
+            SECOND_INDEX            => SHORT_RANGE,
+            SECOND_INDEX_LENGTH     => SHORT_LENGTH,
+            SECOND_TEST_VALUE       => -7,
+            THIRD_INDEX             => BOOLEAN,
+            THIRD_INDEX_LENGTH      => 2,
+            THIRD_TEST_VALUE        => FALSE,
+            FIRST_COMPONENT_TYPE    => DATE,
+            FIRST_DEFAULT_VALUE     => TODAY,
+            SECOND_DEFAULT_VALUE    => FIRST_DATE,
+            SECOND_COMPONENT_TYPE   => MONTH_TYPE,
+            THIRD_DEFAULT_VALUE     => JAN,
+            FOURTH_DEFAULT_VALUE    => DEC) ;
+
+        FUNCTION NEW_FUNC_ARRAY_ATT_TEST IS NEW FUNC_ARRAY_ATT_TEST (
+            FIRST_INDEX             => DAY_TYPE,
+            FIRST_INDEX_LENGTH      => 31,
+            FIRST_TEST_VALUE        => 25,
+            SECOND_INDEX            => SHORT_RANGE,
+            SECOND_INDEX_LENGTH     => SHORT_LENGTH,
+            SECOND_TEST_VALUE       => -7,
+            THIRD_INDEX             => MID_YEAR,
+            THIRD_INDEX_LENGTH      => 4,
+            THIRD_TEST_VALUE        => JUL,
+            FIRST_COMPONENT_TYPE    => DATE,
+            FIRST_DEFAULT_VALUE     => TODAY,
+            SECOND_DEFAULT_VALUE    => FIRST_DATE,
+            SECOND_COMPONENT_TYPE   => MONTH_TYPE,
+            THIRD_DEFAULT_VALUE     => JAN,
+            FOURTH_DEFAULT_VALUE    => DEC) ;
+
+    BEGIN  -- LOCAL_BLOCK
+    
+        NEW_PROC_ARRAY_ATT_TEST ;
+        
+        DUMMY := NEW_FUNC_ARRAY_ATT_TEST ;
+        IF NOT DUMMY THEN
+            REPORT.FAILED ("WRONG VALUE RETURNED BY FUNCTION.") ;
+        END IF ;
+        
+    END LOCAL_BLOCK ;
+     
+    REPORT.RESULT ;
+     
+END C36204D ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205a.ada
new file mode 100644
index 000000000..8c1f683be
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205a.ada
@@ -0,0 +1,212 @@
+-- C36205A.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- BASIC CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS PASSED AS
+--   PARAMETERS
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205A IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     SUBTYPE STR IS STRING;
+     ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205A", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - BASIC CHECKS");
+
+     IF A10'FIRST /= 1
+        OR A2_10'FIRST(1) /= 1
+        OR A2_10'FIRST(2) /= IDENT_INT(13)
+        OR A2_20'FIRST /= 11
+        OR A2_20'FIRST(2) /= 21
+     THEN
+          FAILED ("'FIRST FOR OBJECTS IS WRONG");
+     END IF;
+
+
+     IF A10'LAST(1) /= 10
+        OR A2_10'LAST /= 10
+        OR A2_10'LAST(2) /= 20
+        OR A2_20'LAST(1) /= 30
+        OR A2_20'LAST(2) /= IDENT_INT(20)
+     THEN
+          FAILED ("'LAST FOR OBJECTS IS WRONG");
+     END IF;
+       IF A10'LENGTH /= IDENT_INT(10)
+        OR A2_10'LENGTH(1) /= 10
+        OR A2_10'LENGTH(2) /= IDENT_INT(8)
+        OR A2_20'LENGTH /= 20
+        OR A2_20'LENGTH(2) /= IDENT_INT(0)
+     THEN
+          FAILED ("'LENGTH FOR OBJECTS IS WRONG");
+     END IF;
+
+     IF 0 IN A10'RANGE
+        OR IDENT_INT(11) IN A10'RANGE(1)
+        OR IDENT_INT(0) IN A2_10'RANGE(1)
+        OR 11 IN A2_10'RANGE
+        OR 12 IN A2_10'RANGE(2)
+        OR IDENT_INT(21) IN A2_10'RANGE(2)
+        OR 10 IN A2_20'RANGE
+        OR IDENT_INT(31) IN A2_20'RANGE(1)
+        OR IDENT_INT(20) IN A2_20'RANGE(2)
+        OR 0 IN A2_20'RANGE(2)
+     THEN
+          FAILED ("'RANGE FOR OBJECTS IS WRONG");
+     END IF;
+
+     P1 (A10, 1, 10, "P1 1");
+     P1 (A20, 18, 20, "P1 A20");
+     P2(A2_10, 1, 10, 13, 20, "P2 1");
+     P2 (A2_20, 11, 30, 21, 20, "P2 2");
+     S1 (ALF, 1, 5, "X0");
+     S1 (ARF, 5, 9, "ARF1");
+
+     RESULT;
+
+END C36205A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205b.ada
new file mode 100644
index 000000000..b29816ca1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205b.ada
@@ -0,0 +1,169 @@
+-- C36205B.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- ATTRIBUTES OF NON-NULL STATIC SLICES
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205B IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     SUBTYPE STR IS STRING;
+     ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205B", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - NON-NULL STATIC SLICES");
+
+     P1 (A10(1 .. 10), 1, 10, "P1 2");
+     P1 (A10(1..9), 1, 9, "P1 3");
+     P1 (A10(2..10), 2, 10, "P1 4");
+     P1 (A10 (2..9), 2, 9, "P1 5");
+     P1 (A10 (4 .. 5), 4, 5, "P1 6");
+     P1 (A10 (5 .. 5), 5, 5, "P1 7");
+
+     RESULT;
+END C36205B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205c.ada
new file mode 100644
index 000000000..b11363baa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205c.ada
@@ -0,0 +1,165 @@
+-- C36205C.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- ATTRIBUTES OF NON-NULL DYNAMIC SLICES
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205C IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     SUBTYPE STR IS STRING;
+     ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205C", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - NON-NULL DYNAMIC SLICES");
+
+     P1 (A10 (I10..I10), 10, 10, "P1 8");
+     P1 (A10 (I10 - 9 .. I10), 1, 10, "P1 9");
+
+     RESULT;
+END C36205C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205d.ada
new file mode 100644
index 000000000..f03f75dd0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205d.ada
@@ -0,0 +1,180 @@
+-- C36205D.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- ATTRIBUTES OF NULL STATIC SLICES
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205D IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     SUBTYPE STR IS STRING;
+     ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205D", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - NULL STATIC SLICES");
+
+     P1 (A10 (1 .. 0), 1, 0, "P1 11");
+     P1 (A10 (2 .. 1), 2, 1, "P1 12");
+
+     P1 (A10, 1, 10, "P1 1");
+     P1 (A10(1 .. 10), 1, 10, "P1 2");
+     P1 (A10(1..9), 1, 9, "P1 3");
+     P1 (A10(2..10), 2, 10, "P1 4");
+     P1 (A10 (2..9), 2, 9, "P1 5");
+     P1 (A10 (4 .. 5), 4, 5, "P1 6");
+     P1 (A10 (5 .. 5), 5, 5, "P1 7");
+     P1 (A10 (I10..I10), 10, 10, "P1 8");
+     P1 (A10 (I10 - 9 .. I10), 1, 10, "P1 9");
+     P1 (A10 (I10 .. I10 - 1), 10, 9, "P1 10");
+     P1 (A10 (9 .. 10), 9, 10, "P1 13");
+     P1 (A10 (10 .. 9), 10, 9, "P1 14");
+     P1 (A10 (9 .. I10 - 1), 9, 9, "P1 15");
+     P1 (A10 (9 .. 8), 9, 8, "P1 16");
+
+     RESULT;
+END C36205D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205e.ada
new file mode 100644
index 000000000..f165a2894
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205e.ada
@@ -0,0 +1,164 @@
+-- C36205E.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- ATTRIBUTES OF DYNAMIC NULL SLICES
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205E IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     SUBTYPE STR IS STRING;
+     ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205E", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - DYNAMIC NULL SLICES");
+
+     P1 (A10 (I10 .. I10 - 1), 10, 9, "P1 10");
+
+     RESULT;
+END C36205E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205f.ada
new file mode 100644
index 000000000..22e1c1602
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205f.ada
@@ -0,0 +1,165 @@
+-- C36205F.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- ATTRIBUTES OF STATIC NON-NULL AGGREGATES
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205F IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     SUBTYPE STR IS STRING;
+     ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205F", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - STATIC NON-NULL AGGREGATES");
+
+     P1 ((3 .. 5 => 2), 3, 5, "P1 16");
+     P1 ((5 .. 5 => 5), 5, 5, "P1 17");
+
+     RESULT;
+END C36205F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205g.ada
new file mode 100644
index 000000000..93f5a2e54
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205g.ada
@@ -0,0 +1,165 @@
+-- C36205G.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- ATTRIBUTES OF DYNAMIC NON-NULL AGGREGATES
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205G IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     SUBTYPE STR IS STRING;
+     ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205G", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - DYNAMIC NON-NULL AGGREGATES");
+
+     P1 ((IDENT_INT(3) .. IDENT_INT(5) => 2), 3, 5, "P1 16");
+     P1 ((IDENT_INT(5) .. 5 => 5), 5, 5, "P1 17");
+
+     RESULT;
+END C36205G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205h.ada
new file mode 100644
index 000000000..00303bc80
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205h.ada
@@ -0,0 +1,166 @@
+-- C36205H.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- ATTRIBUTES OF STATIC NULL AGGREGATES
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205H IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     SUBTYPE STR IS STRING;
+     ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205H", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - STATIC NULL AGGREGATES");
+
+     P1 ((5 .. 4 => 4), 5, 4, "P1 18");
+     P1 ((1 .. 0 => 0), 1, 0, "P1 19");
+     P1 ((-12 .. -13 => 3), -12, -13, "P1 21");
+
+     RESULT;
+END C36205H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205i.ada
new file mode 100644
index 000000000..d61b3aa1c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205i.ada
@@ -0,0 +1,167 @@
+-- C36205I.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- ATTRIBUTES OF DYNAMIC NULL AGGREGATES
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205I IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10*I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     SUBTYPE STR IS STRING;
+     ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205I", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - DYNAMIC NULL AGGREGATES");
+
+
+     P1 ((IDENT_INT(5) .. IDENT_INT(4) => 4), 5, 4, "P1 18");
+     P1 ((IDENT_INT(1) .. IDENT_INT(0) => 0), 1, 0, "P1 19");
+     P1 ((IDENT_INT(-12) .. -13 => 3), -12, -13, "P1 21");
+
+     RESULT;
+END C36205I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205j.ada
new file mode 100644
index 000000000..a0d8218a6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205j.ada
@@ -0,0 +1,180 @@
+-- C36205J.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- ATTRIBUTES OF SLICES AND AGGREGATES OF MORE COMPLEX FORMS
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205J IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     TYPE STR IS NEW STRING;
+     ALF : CONSTANT STR := STR(IDENT_STR("ABCDE"));
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205J", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - COMPLEX MIXTURE OF SLICES/AGGREGATES");
+
+     FOR J IN IDENT_INT (-3) .. IDENT_INT (3) LOOP
+          FOR K IN J - 1 .. 2 LOOP
+               P1 ((J .. K => 0), J, K, "X");
+               P1 (A10 (J + 4 .. K + 4), J+4, K+4, "Y");
+          END LOOP;
+     END LOOP;
+     FOR I IN 18 .. 20 LOOP
+          FOR J IN I-1 .. 20 LOOP
+               P1 (A20 (I .. J), I, J, "A20 88");
+          END LOOP;
+     END LOOP;
+     FOR I IN 1 .. 5 LOOP
+          FOR J IN I - 1 .. 5 LOOP
+               S1( ALF (I .. J), I, J, "ALF 1");
+               S1 (ARF (I+4..J+4), I+4, J+4, "ARF 4");
+          END LOOP;
+     END LOOP;
+
+     RESULT;
+END C36205J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205k.ada
new file mode 100644
index 000000000..44a80767f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205k.ada
@@ -0,0 +1,173 @@
+-- C36205K.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
+-- UNCONSTRAINED FORMAL PARAMETERS.
+
+-- ATTRIBUTES OF SLICE OF SLICE
+
+-- DAT 2/17/81
+-- JBG 9/11/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36205K IS
+
+     USE REPORT;
+
+     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
+          INTEGER RANGE <> ) OF INTEGER;
+     A10 : I_A (1 .. 10);
+     A20 : I_A (18 .. 20);
+     I10 : INTEGER := IDENT_INT (10);
+     A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
+     A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
+     TYPE STR IS NEW STRING;
+     ALF : CONSTANT STR := STR(IDENT_STR("ABCDE"));
+     ARF : STR(5 .. 9) := ALF;
+
+     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= FIR
+             OR A'FIRST(1) /= FIR
+          THEN
+               FAILED ("'FIRST IS WRONG " & S);
+          END IF;
+
+          IF A'LAST /= LAS
+             OR A'LAST(1) /= LAS
+          THEN
+               FAILED ("'LAST IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH /= LAS - FIR + 1
+             OR A'LENGTH /= A'LENGTH(1)
+          THEN
+               FAILED ("'LENGTH IS WRONG " & S);
+          END IF;
+
+          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
+             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
+             OR FIR - 1 IN A'RANGE
+             OR LAS + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE IS WRONG " & S);
+          END IF;
+
+     END P1;
+
+     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
+     BEGIN
+          IF A'FIRST /= A'FIRST(1)
+             OR A'FIRST /= F1
+          THEN
+               FAILED ("'FIRST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(1) /= L1 THEN
+               FAILED ("'LAST(1) IS WRONG " & S);
+          END IF;
+
+          IF A'LENGTH(1) /= A'LENGTH
+             OR A'LENGTH /= L1 - F1 + 1
+          THEN
+               FAILED ("'LENGTH(1) IS WRONG " & S);
+          END IF;
+
+          IF F1 - 1 IN A'RANGE
+             OR (F1 NOT IN A'RANGE AND F1 <= L1)
+             OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
+             OR L1 + 1 IN A'RANGE(1)
+          THEN
+               FAILED ("'RANGE(1) IS WRONG " & S);
+          END IF;
+
+          IF A'FIRST(2) /= F2 THEN
+               FAILED ("'FIRST(2) IS WRONG " & S);
+          END IF;
+
+          IF A'LAST(2) /= L2 THEN
+               FAILED ("'LAST(2) IS WRONG " & S);
+          END IF;
+
+          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
+               FAILED ("'LENGTH(2) IS WRONG " & S);
+          END IF;
+
+          IF F2 - 1 IN A'RANGE(2)
+             OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
+             OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
+             OR L2 + 1 IN A'RANGE(2)
+          THEN
+               FAILED ("'RANGE(2) IS WRONG " & S);
+          END IF;
+     END P2;
+
+     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
+     BEGIN
+          IF S'FIRST /= F THEN
+               FAILED ("STRING 'FIRST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LAST(1) /= L THEN
+               FAILED ("STRING 'LAST IS WRONG " & MESS);
+          END IF;
+
+          IF S'LENGTH /= L - F + 1
+             OR S'LENGTH(1) /= S'LENGTH
+          THEN
+               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
+          END IF;
+
+          IF (F <= L AND
+                (F NOT IN S'RANGE
+                OR L NOT IN S'RANGE
+                OR F NOT IN S'RANGE(1)
+                OR L NOT IN S'RANGE(1)))
+             OR F - 1 IN S'RANGE
+             OR L + 1 IN S'RANGE(1)
+          THEN
+               FAILED ("STRING 'RANGE IS WRONG " & MESS);
+          END IF;
+     END S1;
+
+BEGIN
+     TEST ( "C36205K", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
+                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
+                       "ARRAYS - SLICES OF SLICES");
+
+     FOR I IN 18 .. 20 LOOP
+          FOR J IN I-1 .. 20 LOOP
+               P1 (A20 (A20'RANGE)(I..J), I, J, "A20 99");
+          END LOOP;
+     END LOOP;
+     FOR I IN 1 .. 5 LOOP
+          FOR J IN I - 1 .. 5 LOOP
+               S1 (ALF (1..5)(I..J),I,J,"ALF 3");
+          END LOOP;
+     END LOOP;
+
+     RESULT;
+END C36205K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205l.ada
new file mode 100644
index 000000000..9a1126e34
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36205l.ada
@@ -0,0 +1,288 @@
+-- C36205L.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
+--      FOR GENERIC PROCEDURES, CHECK THAT ATTRIBUTES GIVE THE
+--      CORRECT VALUES FOR UNCONSTRAINED FORMAL PARAMETERS.
+--      BASIC CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS PASSED AS
+--      PARAMETERS TO GENERIC PROCEDURES
+
+-- HISTORY
+--      EDWARD V. BERARD, 9 AUGUST 1990
+--      DAS   8 OCT 1990   ADDED OUT MODE PARAMETER TO GENERIC
+--                         PROCEDURE TEST_PROCEDURE AND FORMAL
+--                         GENERIC PARAMETER COMPONENT_VALUE.
+
+WITH REPORT ;
+
+PROCEDURE C36205L IS
+
+     SHORT_START : CONSTANT := -100 ;
+     SHORT_END   : CONSTANT := 100 ;
+     TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+     SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
+
+     MEDIUM_START    : CONSTANT := 1 ;
+     MEDIUM_END      : CONSTANT := 100 ;
+     TYPE MEDIUM_RANGE IS RANGE MEDIUM_START .. MEDIUM_END ;
+     MEDIUM_LENGTH : CONSTANT NATURAL := (MEDIUM_END - MEDIUM_START
+                                          + 1) ;
+
+     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                         SEP, OCT, NOV, DEC) ;
+     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+     TYPE DATE IS RECORD
+          MONTH : MONTH_TYPE ;
+          DAY   : DAY_TYPE ;
+          YEAR  : YEAR_TYPE ;
+     END RECORD ;
+
+     TODAY : DATE := (MONTH => AUG,
+                      DAY   => 9,
+                      YEAR  => 1990) ;
+
+     SUBTYPE SHORT_STRING IS STRING (1 ..5) ;
+
+     DEFAULT_STRING : SHORT_STRING := "ABCDE" ;
+
+     TYPE FIRST_TEMPLATE IS ARRAY (SHORT_RANGE RANGE <>,
+                                   MEDIUM_RANGE RANGE <>) OF DATE ;
+
+     TYPE SECOND_TEMPLATE IS ARRAY (MONTH_TYPE RANGE <>,
+                                    DAY_TYPE RANGE <>) OF SHORT_STRING ;
+
+     TYPE THIRD_TEMPLATE IS ARRAY (CHARACTER RANGE <>,
+                                   BOOLEAN RANGE <>) OF DAY_TYPE ;
+
+     FIRST_ARRAY      : FIRST_TEMPLATE (-10 .. 10, 27 .. 35)
+                            := (-10 .. 10 =>
+                               (27 .. 35 => TODAY)) ;
+     SECOND_ARRAY     : SECOND_TEMPLATE (JAN .. JUN, 1 .. 25)
+                            := (JAN .. JUN =>
+                               (1 .. 25 => DEFAULT_STRING)) ;
+     THIRD_ARRAY      : THIRD_TEMPLATE ('A' .. 'Z', FALSE .. TRUE)
+                            := ('A' .. 'Z' =>
+                               (FALSE .. TRUE => DAY_TYPE (9))) ;
+
+     FOURTH_ARRAY    : FIRST_TEMPLATE (0 .. 27, 75 .. 100)
+                            := (0 .. 27 =>
+                               (75 .. 100 => TODAY)) ;
+     FIFTH_ARRAY     : SECOND_TEMPLATE (JUL .. OCT, 6 .. 10)
+                            := (JUL .. OCT =>
+                               (6 .. 10 => DEFAULT_STRING)) ;
+     SIXTH_ARRAY      : THIRD_TEMPLATE ('X' .. 'Z', TRUE .. TRUE)
+                            := ('X' .. 'Z' =>
+                               (TRUE .. TRUE => DAY_TYPE (31))) ;
+
+     GENERIC
+
+          TYPE FIRST_INDEX IS (<>) ;
+          TYPE SECOND_INDEX IS (<>) ;
+          TYPE COMPONENT_TYPE IS PRIVATE ;
+          TYPE UNCONSTRAINED_ARRAY IS ARRAY (FIRST_INDEX RANGE <>,
+                    SECOND_INDEX RANGE <>) OF COMPONENT_TYPE ;
+          COMPONENT_VALUE: IN  COMPONENT_TYPE;
+
+     PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
+                               FFIFS        : IN FIRST_INDEX ;
+                               FFILS        : IN FIRST_INDEX ;
+                               FSIFS        : IN SECOND_INDEX ;
+                               FSILS        : IN SECOND_INDEX ;
+                               FFLEN        : IN NATURAL ;
+                               FSLEN        : IN NATURAL ;
+                               FFIRT        : IN FIRST_INDEX ;
+                               FSIRT        : IN SECOND_INDEX ;
+                               SECOND       : OUT UNCONSTRAINED_ARRAY ;
+                               SFIFS        : IN FIRST_INDEX ;
+                               SFILS        : IN FIRST_INDEX ;
+                               SSIFS        : IN SECOND_INDEX ;
+                               SSILS        : IN SECOND_INDEX ;
+                               SFLEN        : IN NATURAL ;
+                               SSLEN        : IN NATURAL ;
+                               SFIRT        : IN FIRST_INDEX ;
+                               SSIRT        : IN SECOND_INDEX ;
+                               REMARKS      : IN STRING) ;
+
+     PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
+                               FFIFS        : IN FIRST_INDEX ;
+                               FFILS        : IN FIRST_INDEX ;
+                               FSIFS        : IN SECOND_INDEX ;
+                               FSILS        : IN SECOND_INDEX ;
+                               FFLEN        : IN NATURAL ;
+                               FSLEN        : IN NATURAL ;
+                               FFIRT        : IN FIRST_INDEX ;
+                               FSIRT        : IN SECOND_INDEX ;
+                               SECOND       : OUT UNCONSTRAINED_ARRAY ;
+                               SFIFS        : IN FIRST_INDEX ;
+                               SFILS        : IN FIRST_INDEX ;
+                               SSIFS        : IN SECOND_INDEX ;
+                               SSILS        : IN SECOND_INDEX ;
+                               SFLEN        : IN NATURAL ;
+                               SSLEN        : IN NATURAL ;
+                               SFIRT        : IN FIRST_INDEX ;
+                               SSIRT        : IN SECOND_INDEX ;
+                               REMARKS      : IN STRING) IS
+
+     BEGIN -- TEST_PROCEDURE
+
+          IF (FIRST'FIRST /= FFIFS) OR
+             (FIRST'FIRST (1) /= FFIFS) OR
+             (FIRST'FIRST (2) /= FSIFS) OR
+             (SECOND'FIRST /= SFIFS) OR
+             (SECOND'FIRST (1) /= SFIFS) OR
+             (SECOND'FIRST (2) /= SSIFS) THEN
+               REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
+          END IF ;
+
+          IF (FIRST'LAST /= FFILS) OR
+             (FIRST'LAST (1) /= FFILS) OR
+             (FIRST'LAST (2) /= FSILS) OR
+             (SECOND'LAST /= SFILS) OR
+             (SECOND'LAST (1) /= SFILS) OR
+             (SECOND'LAST (2) /= SSILS) THEN
+               REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
+          END IF ;
+
+          IF (FIRST'LENGTH /= FFLEN) OR
+             (FIRST'LENGTH (1) /= FFLEN) OR
+             (FIRST'LENGTH (2) /= FSLEN) OR
+             (SECOND'LENGTH /= SFLEN) OR
+             (SECOND'LENGTH (1) /= SFLEN) OR
+             (SECOND'LENGTH (2) /= SSLEN) THEN
+               REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
+          END IF ;
+
+          IF (FFIRT NOT IN FIRST'RANGE (1)) OR
+             (FFIRT NOT IN FIRST'RANGE) OR
+             (SFIRT NOT IN SECOND'RANGE (1)) OR
+             (SFIRT NOT IN SECOND'RANGE) OR
+             (FSIRT NOT IN FIRST'RANGE (2)) OR
+             (SSIRT NOT IN SECOND'RANGE (2)) THEN
+               REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE " &
+                              "ATTRIBUTE.  " & REMARKS) ;
+          END IF ;
+
+          -- ASSIGN VALUES TO THE ARRAY PARAMETER OF MODE OUT
+          FOR I IN SECOND'RANGE(1) LOOP
+               FOR J IN SECOND'RANGE(2) LOOP
+                    SECOND(I, J) := COMPONENT_VALUE;
+               END LOOP;
+          END LOOP;
+
+     END TEST_PROCEDURE ;
+
+     PROCEDURE FIRST_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
+          FIRST_INDEX           => SHORT_RANGE,
+          SECOND_INDEX          => MEDIUM_RANGE,
+          COMPONENT_TYPE        => DATE,
+          UNCONSTRAINED_ARRAY   => FIRST_TEMPLATE,
+          COMPONENT_VALUE       => TODAY) ;
+
+     PROCEDURE SECOND_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
+          FIRST_INDEX           => MONTH_TYPE,
+          SECOND_INDEX          => DAY_TYPE,
+          COMPONENT_TYPE        => SHORT_STRING,
+          UNCONSTRAINED_ARRAY   => SECOND_TEMPLATE,
+          COMPONENT_VALUE       => DEFAULT_STRING) ;
+
+     PROCEDURE THIRD_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
+          FIRST_INDEX           => CHARACTER,
+          SECOND_INDEX          => BOOLEAN,
+          COMPONENT_TYPE        => DAY_TYPE,
+          UNCONSTRAINED_ARRAY   => THIRD_TEMPLATE,
+          COMPONENT_VALUE       => DAY_TYPE'FIRST) ;
+
+
+BEGIN  -- C36205L
+
+      REPORT.TEST ( "C36205L","FOR GENERIC PROCEDURES, CHECK THAT " &
+                    "ATTRIBUTES GIVE THE CORRECT VALUES FOR " &
+                    "UNCONSTRAINED FORMAL PARAMETERS.  BASIC " &
+                    "CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS " &
+                    "PASSED AS PARAMETERS TO GENERIC PROCEDURES");
+
+     FIRST_TEST_PROCEDURE (FIRST        => FIRST_ARRAY,
+                           FFIFS        => -10,
+                           FFILS        => 10,
+                           FSIFS        => 27,
+                           FSILS        => 35,
+                           FFLEN        => 21,
+                           FSLEN        => 9,
+                           FFIRT        => 0,
+                           FSIRT        => 29,
+                           SECOND       => FOURTH_ARRAY,
+                           SFIFS        => 0,
+                           SFILS        => 27,
+                           SSIFS        => 75,
+                           SSILS        => 100,
+                           SFLEN        => 28,
+                           SSLEN        => 26,
+                           SFIRT        => 5,
+                           SSIRT        => 100,
+                           REMARKS      => "FIRST_TEST_PROCEDURE") ;
+
+     SECOND_TEST_PROCEDURE (FIRST        => SECOND_ARRAY,
+                            FFIFS        => JAN,
+                            FFILS        => JUN,
+                            FSIFS        => 1,
+                            FSILS        => 25,
+                            FFLEN        => 6,
+                            FSLEN        => 25,
+                            FFIRT        => MAR,
+                            FSIRT        => 17,
+                            SECOND       => FIFTH_ARRAY,
+                            SFIFS        => JUL,
+                            SFILS        => OCT,
+                            SSIFS        => 6,
+                            SSILS        => 10,
+                            SFLEN        => 4,
+                            SSLEN        => 5,
+                            SFIRT        => JUL,
+                            SSIRT        => 6,
+                            REMARKS      => "SECOND_TEST_PROCEDURE") ;
+
+     THIRD_TEST_PROCEDURE (FIRST        => THIRD_ARRAY,
+                           FFIFS        => 'A',
+                           FFILS        => 'Z',
+                           FSIFS        => FALSE,
+                           FSILS        => TRUE,
+                           FFLEN        => 26,
+                           FSLEN        => 2,
+                           FFIRT        => 'T',
+                           FSIRT        => TRUE,
+                           SECOND       => SIXTH_ARRAY,
+                           SFIFS        => 'X',
+                           SFILS        => 'Z',
+                           SSIFS        => TRUE,
+                           SSILS        => TRUE,
+                           SFLEN        => 3,
+                           SSLEN        => 1,
+                           SFIRT        => 'Z',
+                           SSIRT        => TRUE,
+                           REMARKS      => "THIRD_TEST_PROCEDURE") ;
+
+      REPORT.RESULT ;
+
+END C36205L ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36301a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36301a.ada
new file mode 100644
index 000000000..9f93a7f3b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36301a.ada
@@ -0,0 +1,149 @@
+-- C36301A.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 PREDEFINED POSITIVE AND STRING TYPES
+-- ARE CORRECTLY DEFINED.
+
+-- DAT 2/17/81
+-- JBG 12/27/82
+-- RJW 1/20/86 - CHANGED 'NATURAL' TO 'POSITIVE'.  ADDED ADDITIONAL 
+--               CASES, INCLUDING A CHECK FOR STRINGS WITH BOUNDS
+--               OF INTEGER'FIRST AND INTEGER'LAST.
+-- EDS 7/16/98   AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C36301A IS
+     
+BEGIN
+     TEST ( "C36301A", "CHECK ATTRIBUTES OF PREDEFINED POSITIVE " &
+                       "AND STRING" );
+
+     BEGIN
+          IF POSITIVE'FIRST /= 1 THEN
+               FAILED ( "POSITIVE'FIRST IS WRONG" );
+          END IF;
+
+          IF POSITIVE'LAST /= INTEGER'LAST THEN
+               FAILED ( "POSITIVE'LAST IS WRONG" );
+          END IF;
+     END;
+
+     DECLARE
+
+          C : STRING (1..2) := ( 'A', 'B' );
+
+     BEGIN
+          IF C'LENGTH /= 2  THEN
+               FAILED ( "LENGTH OF C IS WRONG" );
+          END IF;
+
+          IF C'FIRST /= 1 THEN
+               FAILED ( "C'FIRST IS WRONG" );
+          END IF;
+
+          IF C'LAST /= 2 THEN
+               FAILED ( "C'LAST IS WRONG" );
+          END IF;
+     END;
+
+     DECLARE
+
+          SUBTYPE LARGE IS STRING ( INTEGER'LAST - 3 .. INTEGER'LAST );
+
+     BEGIN
+          IF LARGE'LENGTH /= 4  THEN
+               FAILED ( "LENGTH OF LARGE IS WRONG" );
+          END IF;
+
+          IF LARGE'FIRST /= INTEGER'LAST - 3  THEN
+               FAILED ( "LARGE'FIRST IS WRONG" );
+          END IF;
+
+          IF LARGE'LAST /= INTEGER'LAST THEN
+               FAILED ( "LARGE'LAST IS WRONG" );
+          END IF;
+     END;
+
+     DECLARE
+
+          SUBTYPE LARGER IS STRING ( 1 .. INTEGER'LAST );
+
+     BEGIN
+          IF LARGER'LENGTH /= INTEGER'LAST THEN
+               FAILED ( "LENGTH OF LARGER IS WRONG" );
+          END IF;
+
+          IF LARGER'FIRST /= 1 THEN
+               FAILED ( "LARGER'FIRST IS WRONG" );
+          END IF;
+
+          IF LARGER'LAST /= INTEGER'LAST THEN
+               FAILED ( "LARGER'LAST IS WRONG" );
+          END IF;
+     END;
+
+     BEGIN
+          DECLARE
+
+               D : STRING ( INTEGER'FIRST .. INTEGER'FIRST + 3 );
+
+          BEGIN
+               IF D'FIRST /= INTEGER'FIRST THEN   -- USE D
+                    FAILED ("D'FIRST IS INCORRECT " & INTEGER'IMAGE(D'FIRST));
+               END IF;
+               FAILED ( "NO EXCEPTION RAISED" );
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED" );
+     END;
+
+     BEGIN
+          DECLARE
+
+               E : STRING ( -1 .. INTEGER'FIRST );
+          
+          BEGIN
+               IF E'LENGTH /= 0 THEN
+                    FAILED ( "LENGTH OF E IS WRONG" );
+               END IF;
+
+               IF E'FIRST /= -1 THEN
+                    FAILED ( "E'FIRST IS WRONG" );
+               END IF;
+
+               IF E'LAST /= INTEGER'FIRST THEN
+                    FAILED ( "E'LAST IS WRONG" );
+               END IF;
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED FOR NULL STRING" );
+     END;
+
+     RESULT;
+END C36301A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36301b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36301b.ada
new file mode 100644
index 000000000..4153db2a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36301b.ada
@@ -0,0 +1,55 @@
+-- C36301B.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 PREDEFINED STRING ATTRIBUTES ARE CORRECTLY IMPLEMENTED.
+
+-- CASE B: STRING OF LENGTH INTEGER'LAST
+
+-- DAT 2/17/81
+-- JBG 12/28/82
+
+WITH REPORT;
+PROCEDURE C36301B IS
+
+     USE REPORT;
+
+     SUBTYPE STR2 IS STRING (1..INTEGER'LAST);
+
+BEGIN
+     TEST("C36301B", "CHECK ATTRIBUTES OF LONGEST STRING");
+
+     IF STR2'FIRST /= 1 THEN
+          FAILED ("STR'FIRST NOT 1");
+     END IF;
+
+     IF STR2'LAST /= INTEGER'LAST THEN
+          FAILED ("STR'LAST NOT INTEGER'LAST");
+     END IF;
+
+     IF STR2'LENGTH /= INTEGER'LAST THEN
+          FAILED ("'LENGTH NOT INTEGER'LAST");
+     END IF;
+
+     RESULT;
+END C36301B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36302a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36302a.ada
new file mode 100644
index 000000000..1e7159879
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36302a.ada
@@ -0,0 +1,53 @@
+-- C36302A.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 VARIABLE MAY BE DECLARED WITH AN INDEX
+-- STARTING WITH AN INTEGER GREATER THAN 1.
+
+-- DAT 2/17/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C36302A IS
+
+     USE REPORT;
+
+     S5 : STRING (5 .. 10);
+     SX : STRING (INTEGER'LAST - 5 .. INTEGER'LAST);
+
+BEGIN
+     TEST ("C36302A", "STRING VARIABLE INDICES NEEDN'T START AT 1");
+
+     IF S5'FIRST /= 5
+     OR S5'LAST /= 10
+     OR S5'LENGTH /= 6
+     OR SX'FIRST /= INTEGER'LAST - 5
+     OR SX'LAST /= INTEGER'LAST
+     OR SX'LENGTH /= 6
+     THEN
+          FAILED ("WRONG STRING ATTRIBUTES");
+     END IF;
+
+     RESULT;
+END C36302A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36304a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36304a.ada
new file mode 100644
index 000000000..a561f3fdd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36304a.ada
@@ -0,0 +1,91 @@
+-- C36304A.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 BOUNDS OF CONSTANT STRING OBJECTS IF NOT GIVEN IN
+-- THE DECLARATIONS ARE DETERMINED BY THE STRINGS' INITIAL VALUES.
+
+-- DAT 2/17/81
+-- JBG 8/21/83
+
+WITH REPORT;
+PROCEDURE C36304A IS
+
+     USE REPORT;
+
+     I3 : INTEGER := IDENT_INT (3);
+
+     S3 : CONSTANT STRING := "ABC";
+     S0 : CONSTANT STRING := "";
+     S1 : CONSTANT STRING := "A";
+     S2 : CONSTANT STRING := "AB";
+     S5 : CONSTANT STRING := "ABCDE";
+     S3A : CONSTANT STRING (I3 .. I3 + 2) := S3(I3 - 2 .. I3);
+     S3C : CONSTANT STRING := S3A;
+     S3D : CONSTANT STRING := S3C & "";
+     S3E : CONSTANT STRING := S3D;
+     X3 : CONSTANT STRING := (I3 .. 5 => 'X');
+     Y3 : CONSTANT STRING := X3;
+     Z0 : CONSTANT STRING := (-3..-5 => 'A');
+
+     PROCEDURE C (S : STRING; 
+                  FIRST, LAST, LENGTH : INTEGER; 
+                  ID : STRING) IS
+     BEGIN
+          IF S'FIRST /= FIRST THEN
+               FAILED ("'FIRST IS " & INTEGER'IMAGE(S'FIRST) &
+                       " INSTEAD OF " & INTEGER'IMAGE(FIRST) &
+                       " FOR " & ID);
+          END IF;
+
+          IF S'LAST /= LAST THEN
+               FAILED ("'LAST IS " & INTEGER'IMAGE(S'LAST) &
+                       " INSTEAD OF " & INTEGER'IMAGE(LAST) &
+                       " FOR " & ID);
+          END IF;
+
+          IF S'LENGTH /= LENGTH THEN
+               FAILED ("'LENGTH IS " & INTEGER'IMAGE(S'LENGTH) &
+                       " INSTEAD OF " & INTEGER'IMAGE(LENGTH) &
+                       " FOR " & ID);
+          END IF;
+     END C;
+
+BEGIN
+     TEST ("C36304A", "CHECK UNUSUAL CONSTANT STRING BOUNDS");
+
+
+     C(S0, 1, 0, 0, "S0");
+     C(S1, 1, 1, 1, "S1");
+     C(S2, 1, 2, 2, "S2");
+     C(S5, 1, 5, 5, "S5");
+     C(S3, 1, 3, 3, "S3");
+     C(S3C, 3, 5, 3, "S3C");
+     C(S3D, 3, 5, 3, "S3D");
+     C(S3E, 3, 5, 3, "S3E");
+     C(X3, 3, 5, 3, "X3");
+     C(Y3, 3, 5, 3, "Y3");
+     C(Z0, IDENT_INT(-3), IDENT_INT(-5), IDENT_INT(0), "Z0");
+
+     RESULT;
+END C36304A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36305a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36305a.ada
new file mode 100644
index 000000000..09adbe156
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c36305a.ada
@@ -0,0 +1,117 @@
+-- C36305A.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 VARIABLE IS CONSIDERED AN ARRAY.
+
+-- DAT 2/17/81
+-- SPS 10/25/82
+-- EDS 07/16/98    AVOID OPTIMIZATION
+
+WITH REPORT;
+PROCEDURE C36305A IS
+
+     USE REPORT;
+
+     S : STRING (IDENT_INT(5) .. IDENT_INT (10));
+     T : STRING (S'RANGE);
+     U : STRING (T'FIRST .. T'LAST);
+     SUBTYPE I_5 IS INTEGER RANGE U'RANGE(1);
+     I5 : I_5;
+     C : CONSTANT STRING := "ABCDEF";
+
+BEGIN
+     TEST ("C36305A", "CHECK THAT STRINGS ARE REALLY ARRAYS");
+
+     IF S'FIRST /= 5
+     OR S'LAST /= 10
+     OR S'LENGTH /= 6
+     OR U'FIRST(1) /= 5
+     OR U'LAST(1) /= 10
+     OR U'LENGTH(1) /= 6
+     THEN
+          FAILED ("INCORRECT STRING ATTRIBUTE VALUES");
+     END IF;
+
+     IF 4 IN U'RANGE
+     OR 3 IN U'RANGE(1)
+     OR 0 IN U'RANGE
+     OR 1 IN U'RANGE
+     OR 5 NOT IN U'RANGE
+     OR 7 NOT IN U'RANGE
+     OR 10 NOT IN U'RANGE
+     OR NOT (11 NOT IN U'RANGE)
+     THEN
+          FAILED ("INCORRECT STRING RANGE ATTRIBUTE");
+     END IF;
+
+     BEGIN
+          BEGIN
+               BEGIN
+                    I5 := 4;
+                    FAILED ("BAD I5 SUBRANGE 1 " & INTEGER'IMAGE(I5)); --use I5
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR => NULL;
+               END;
+               I5 := INTEGER'(11);
+               FAILED ("BAD I5 SUBRANGE 2 " & INTEGER'IMAGE(I5)); --use I5
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1");
+          END;
+          I5 := INTEGER'(5);
+          I5 := I5 + I5;
+          I5 := NATURAL'(8);
+     EXCEPTION
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
+     END;
+
+     FOR I IN S'RANGE LOOP
+          S(I) :=  C(11 - I);
+     END LOOP;
+     T := S;
+     FOR I IN REVERSE U'RANGE LOOP
+          U(I) := T(15 - I);
+     END LOOP;
+
+     FOR I IN 1 .. C'LENGTH LOOP
+          IF C(1 .. I) /= U(5 .. I + 4)
+          OR U(I + 4 .. U'LAST) /= C(I .. C'LAST)
+          OR C(I) /= U (I + 4)
+          OR C(I .. I)(I .. I)(I) /= U(U'RANGE)(I + 4) THEN
+               FAILED ("INCORRECT CHARACTER MISMATCH IN STRING");
+               EXIT;
+          END IF;
+     END LOOP;
+
+     IF U /= C
+     OR U /= "ABCDEF"
+     OR U(U'RANGE) /= C(C'RANGE)
+     OR U(5 .. 10) /= C(1 .. 6)
+     OR U(5 .. 6) /= C(1 .. 2)
+     THEN
+          FAILED ("STRINGS AS ARRAYS BEHAVE INCORRECTLY");
+     END IF;
+
+     RESULT;
+END C36305A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37002a.ada
new file mode 100644
index 000000000..fbb61cf39
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37002a.ada
@@ -0,0 +1,79 @@
+-- C37002A.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 INDEX CONSTRAINTS WITH NON-STATIC EXPRESSIONS CAN BE
+-- USED TO CONSTRAIN RECORD COMPONENTS HAVING AN ARRAY TYPE.
+
+-- RJW 2/28/86 
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C37002A IS
+
+BEGIN
+     TEST ( "C37002A", "CHECK THAT INDEX CONSTRAINTS WITH " &
+                       "NON-STATIC EXPRESSIONS CAN BE USED TO " &
+                       "CONSTRAIN RECORD COMPONENTS HAVING AN " &
+                       "ARRAY TYPE" );
+
+     DECLARE
+          X : INTEGER := IDENT_INT(5);
+          SUBTYPE S IS INTEGER RANGE 1 .. X;
+          TYPE AR1 IS ARRAY (S) OF INTEGER;
+
+          SUBTYPE T IS INTEGER RANGE X .. 10;
+          TYPE AR2 IS ARRAY (T) OF INTEGER;
+          TYPE U IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          SUBTYPE V IS INTEGER RANGE 1 .. 10;     
+
+          TYPE R IS 
+               RECORD
+                    A : STRING (1 .. X);              
+                    B : STRING (X .. 10);             
+                    C : AR1;                          
+                    D : AR2;                          
+                    E : STRING (S);
+                    F : U(T);
+                    G : U(V RANGE 1 ..X);
+                    H : STRING (POSITIVE RANGE X .. 10);
+                    I : U(AR1'RANGE);
+                    J : STRING (AR2'RANGE);
+               END RECORD;
+          RR : R;
+ 
+     BEGIN
+          IF RR.A'LAST /= 5 OR RR.B'FIRST /= 5 OR
+             RR.C'LAST /= 5 OR RR.D'FIRST /= 5 OR
+             RR.E'LAST /= 5 OR RR.F'FIRST /= 5 OR
+             RR.G'LAST /= 5 OR RR.H'FIRST /= 5 OR
+             RR.I'LAST /= 5 OR RR.J'FIRST /= 5 THEN 
+          
+                  FAILED("WRONG VALUE FOR NON-STATIC BOUND");
+
+           END IF;
+          
+     END;
+
+     RESULT;
+END C37002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37003a.ada
new file mode 100644
index 000000000..5378f4ddd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37003a.ada
@@ -0,0 +1,198 @@
+-- C37003A.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 MULTIPLE COMPONENT DECLARATIONS ARE TREATED AS A SERIES
+-- OF SINGLE COMNENT DECLARATIONS, I.E., THE COMPONENTS ALL HAVE THE
+-- SAME TYPE AND ANY EXPRESSION USED IN CONSTRAINTS OR INITIALIZATIONS
+-- IS EVALUATED ONCE FOR EACH COMPONENT.
+
+-- DAT 3/30/81
+-- SPS 10/26/82
+-- JWC 10/23/85  RENAMED FROM C37013A-AB.ADA.
+--               ADDED TEST TO ENSURE THAT ANY EXPRESSION USED
+--               IN A CONSTRAINT IS EVALUATED ONCE FOR EACH
+--               COMPONENT.
+-- JRK 11/15/85  ADDED INITIALIZATION EVALUATION CHECKS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C37003A IS
+
+     X : INTEGER := 0;
+
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+          X := X + 1;
+          RETURN X;
+     END F;
+
+     PROCEDURE RESET IS
+     BEGIN
+          X := 0;
+     END RESET;
+
+BEGIN
+     TEST ("C37003A", "CHECK THAT MULTIPLE COMPONENT DECLARATIONS " &
+                      "ARE TREATED AS A SERIES OF SINGLE COMPONENT " &
+                      "DECLARATIONS");
+
+     DECLARE
+
+          TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+
+          TYPE REC1 IS RECORD
+               A1, A2 : ARR (1 .. F) := (OTHERS => F);
+          END RECORD;
+
+          R1 : REC1 := (OTHERS => (OTHERS => 1));
+          Y : INTEGER := X;
+          R1A : REC1;
+
+     BEGIN
+
+          IF R1.A1 = R1.A2 THEN        -- TEST TO SEE IF THE COMPONENTS
+               NULL;                   -- ARE OF THE SAME TYPE.
+          END IF;
+
+          IF Y /= 2 THEN
+               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
+                       "FOR ARRAYS");
+          END IF;
+
+          IF X /= 5 THEN
+               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
+                       "EACH ARRAY COMPONENT");
+          END IF;
+
+          RESET;
+
+     END;
+
+     DECLARE
+
+          TYPE REC2 IS RECORD
+               I1, I2 : INTEGER RANGE 1 .. F := F * IDENT_INT(0) + 1;
+          END RECORD;
+
+          R2 : REC2 := (OTHERS => 1);
+          Y : INTEGER := X;
+          R2A : REC2;
+
+     BEGIN
+
+          IF R2.I1 = R2.I2 THEN        -- TEST TO SEE IF THE COMPONENTS
+               NULL;                   -- ARE OF THE SAME TYPE.
+          END IF;
+
+          IF Y /= 2 THEN
+               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
+                       "FOR SCALARS");
+          END IF;
+
+          IF X /= 4 THEN
+               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
+                       "EACH SCALAR COMPONENT");
+          END IF;
+
+          RESET;
+
+     END;
+
+     DECLARE
+
+          TYPE REC3X (DSC : INTEGER) IS RECORD
+               NULL;
+          END RECORD;
+
+          TYPE REC3Y IS RECORD
+               I : INTEGER;
+          END RECORD;
+
+          TYPE REC3 IS RECORD
+               RX1, RX2 : REC3X (F);
+               RY1, RY2 : REC3Y := (I => F);
+          END RECORD;
+
+          R3 : REC3 := ((DSC => 1), (DSC => 2), (I => 0), (I => 0));
+          Y : INTEGER := X;
+          R3A : REC3;
+
+     BEGIN
+
+          IF R3.RX1 = R3.RX2 THEN       -- TEST TO SEE IF THE COMPONENTS
+               NULL;                    -- ARE OF THE SAME TYPE.
+          END IF;
+
+          IF Y /= 2 THEN
+               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
+                       "FOR RECORDS");
+          END IF;
+
+          IF X /= 4 THEN
+               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
+                       "FOR EACH RECORD COMPONENT");
+          END IF;
+
+          RESET;
+
+     END;
+
+     DECLARE
+
+          TYPE REC4X (DSC : INTEGER) IS RECORD
+               NULL;
+          END RECORD;
+
+          TYPE ACR IS ACCESS REC4X;
+          TYPE ACI IS ACCESS INTEGER;
+
+          TYPE REC4 IS RECORD
+               AC1, AC2 : ACR (F);
+               AC3, AC4 : ACI := NEW INTEGER'(F);
+          END RECORD;
+
+          R4 : REC4 := (NULL, NULL, NULL, NULL);
+          Y : INTEGER := X;
+          R4A : REC4;
+
+     BEGIN
+
+          IF R4.AC1 = R4.AC2 THEN       -- TEST TO SEE IF THE COMPONENTS
+               NULL;                    -- ARE OF THE SAME TYPE.
+          END IF;
+
+          IF Y /= 2 THEN
+               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
+                       "FOR ACCESS");
+          END IF;
+
+          IF X /= 4 THEN
+               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
+                       "FOR EACH ACCESS COMPONENT");
+          END IF;
+
+     END;
+
+     RESULT;
+END C37003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37003b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37003b.ada
new file mode 100644
index 000000000..49ebdc0ed
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37003b.ada
@@ -0,0 +1,66 @@
+-- C37003B.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 FOR A RECORD WITH MULTIPLE DISCRIMINANTS WHICH HAVE
+--     DEFAULT EXPRESSIONS, THE EXPRESSIONS ARE EVALUATED ONCE FOR
+--     EACH DISCRIMINANT IN THE ASSOCIATION.
+
+-- HISTORY:
+--     DHH 08/04/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37003B IS
+
+     X : INTEGER := 0;
+
+     FUNCTION F1 RETURN INTEGER IS
+     BEGIN
+          X := X + 1;
+          RETURN X;
+     END F1;
+
+BEGIN
+     TEST("C37003B", "CHECK THAT FOR A RECORD WITH MULTIPLE " &
+                     "DISCRIMINANTS WHICH HAVE DEFAULT EXPRESSIONS, " &
+                     "THE  EXPRESSIONS ARE EVALUATED ONCE FOR EACH " &
+                     "DISCRIMINANT IN THE ASSOCIATION");
+
+     DECLARE
+          TYPE REC(D1, D2, D3, D4, D5 : INTEGER := F1) IS
+               RECORD
+                    Y : INTEGER := (D1 + D2 + D3 + D4 + D5);
+               END RECORD;
+
+          REC_F1 : REC;
+
+     BEGIN
+          IF REC_F1.Y /= IDENT_INT(15) THEN
+               FAILED("MULTIPLE DISCRIMINANTS NOT EVALUATED " &
+                      "SEPARATELY");
+          END IF;
+     END;
+
+     RESULT;
+END C37003B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37005a.ada
new file mode 100644
index 000000000..0983fe00e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37005a.ada
@@ -0,0 +1,92 @@
+-- C37005A.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 SCALAR RECORD COMPONENTS MAY HAVE NON-STATIC
+-- RANGE CONSTRAINTS OR DEFAULT INITIAL VALUES.
+
+-- DAT 3/6/81
+-- JWC 6/28/85   RENAMED TO -AB
+-- EDS 7/16/98   AVOID OPTIMIZATION
+
+WITH REPORT;
+PROCEDURE C37005A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C37005A", "SCALAR RECORD COMPONENTS MAY HAVE NON-STATIC"
+                    & " RANGE CONSTRAINTS OR DEFAULT INITIAL VALUES");
+
+     DECLARE
+          SUBTYPE DT IS INTEGER RANGE IDENT_INT (1) .. IDENT_INT (5);
+          L : INTEGER := IDENT_INT (DT'FIRST);
+          R : INTEGER := IDENT_INT (DT'LAST);
+          SUBTYPE DT2 IS INTEGER RANGE L .. R;
+          M : INTEGER := (L + R) / 2;
+
+          TYPE REC IS
+               RECORD
+                    C1 : INTEGER := M;
+                    C2 : DT2 := (L + R) / 2;
+                    C3 : BOOLEAN RANGE (L < M) .. (R > M)
+                         := IDENT_BOOL (TRUE);
+                    C4 : INTEGER RANGE L .. R := DT'FIRST;
+               END RECORD;
+
+          R1, R2 : REC := ((L+R)/2, M, M IN DT, L);
+          R3 : REC;
+     BEGIN
+          IF R3 /= R1
+          THEN
+               FAILED ("INCORRECT RECORD VALUES");
+          END IF;
+
+          R3 := (R2.C2, R2.C1, R3.C3, R);  -- CONSTRAINTS CHECKED BY :=
+          IF EQUAL(IDENT_INT(1), 2) THEN
+               FAILED("IMPOSSIBLE " & INTEGER'IMAGE(R3.C1));  --USE R3
+          END IF;
+
+          BEGIN
+               R3 := (M, M, IDENT_BOOL (FALSE), M); -- RAISES CON_ERR.
+               FAILED ("CONSTRAINT ERROR NOT RAISED " & INTEGER'IMAGE(R3.C1));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED ("WRONG EXCEPTION");
+          END;
+
+          FOR I IN DT LOOP
+               R3 := (I, I, I /= 100, I);
+               R1.C2 := I;
+               IF EQUAL(IDENT_INT(1), 2) THEN
+                    FAILED("IMPOSSIBLE " & 
+                           INTEGER'IMAGE(R3.C1 + R1.C2));  --USE R3, R1
+               END IF;
+          END LOOP;
+
+     EXCEPTION
+          WHEN OTHERS => FAILED ("INVALID EXCEPTION");
+     END;
+
+     RESULT;
+END C37005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37006a.ada
new file mode 100644
index 000000000..ac926d1f4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37006a.ada
@@ -0,0 +1,272 @@
+-- C37006A.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 A COMPONENT OF A RECORD, ACCESS, OR PRIVATE TYPE, OR FOR A 
+-- LIMITED PRIVATE COMPONENT, CHECK THAT A NON-STATIC EXPRESSION CAN 
+-- BE USED IN A DISCRIMINANT CONSTRAINT OR (EXCEPTING LIMITED PRIVATE 
+-- COMPONENTS) IN SPECIFYING A DEFAULT INITIAL VALUE.
+ 
+-- R.WILLIAMS 8/28/86
+ 
+WITH REPORT; USE REPORT;
+PROCEDURE C37006A IS
+
+     SUBTYPE INT IS INTEGER RANGE 0 .. 100;
+
+     TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
+
+     TYPE REC1 (D1, D2 : INT) IS
+          RECORD
+               A : ARR (D1 .. D2);
+          END RECORD;
+
+     TYPE REC1_NAME IS ACCESS REC1;
+ 
+     PROCEDURE CHECK (AR : ARR; STR : STRING) IS
+     BEGIN
+          IF AR'FIRST /= 1 OR AR'LAST /= 2 THEN
+               FAILED ( "INCORRECT BOUNDS FOR R.COMP.A IN COMPONENT " &
+                        "OF " & STR & " TYPE");
+          ELSIF AR /= (3, 4) THEN
+               FAILED ( "INITIALIZATION OF R.COMP.A IN COMPONENT OF " &
+                         STR & " TYPE FAILED" );
+          END IF;
+     END CHECK;
+          
+     PACKAGE PACK IS
+          TYPE PRIV (D1, D2 : INT) IS PRIVATE;
+          TYPE LIM (D1, D2 : INT) IS LIMITED PRIVATE;
+          FUNCTION PRIV_FUN (PARM1, PARM2 : INTEGER) RETURN PRIV;
+          PROCEDURE PRIV_CHECK (R : PRIV);
+          PROCEDURE LIM_CHECK (R : LIM);
+
+     PRIVATE
+          TYPE PRIV (D1, D2 : INT) IS
+               RECORD
+                    A : ARR (D1 .. D2);
+               END RECORD;
+
+          TYPE LIM (D1, D2 : INT) IS
+               RECORD
+                    A : ARR (D1 .. D2);
+               END RECORD;
+     END PACK;
+
+     PACKAGE BODY PACK IS
+
+          FUNCTION PRIV_FUN (PARM1, PARM2 : INTEGER) RETURN PRIV IS
+          BEGIN
+               RETURN (IDENT_INT (1), IDENT_INT (2),
+                       ARR'(1 => 3, 2 => 4));
+          END PRIV_FUN;
+          
+          PROCEDURE PRIV_CHECK (R : PRIV) IS
+          BEGIN
+               CHECK (R.A, "PRIVATE TYPE" );
+          END PRIV_CHECK;
+
+          PROCEDURE LIM_CHECK (R : LIM) IS
+          BEGIN
+               IF R.A'FIRST /= 1 OR R.A'LAST /= 2 THEN
+                    FAILED ( "INCORRECT BOUNDS FOR R.COMP.A IN " &
+                             "COMPONENT OF LIMITED PRIVATE TYPE");
+               END IF;
+          END LIM_CHECK;
+     END PACK;
+ 
+     USE PACK;
+
+BEGIN
+     
+     TEST ( "C37006A", "FOR A COMPONENT OF A RECORD, ACCESS, " &
+                       "OR PRIVATE TYPE, OR FOR A LIMITED PRIVATE " &
+                       "COMPONENT, CHECK THAT A NON-STATIC " &
+                       "EXPRESSION CAN BE USED IN A DISCRIMINANT " &
+                       "CONSTRAINT OR (EXCEPTING LIMITED PRIVATE " &
+                       "COMPONENTS) IN SPECIFYING A DEFAULT " &
+                       "INITIAL VALUE" );
+ 
+     BEGIN
+          DECLARE
+          
+               TYPE REC2 IS
+                    RECORD
+                         COMP : REC1 (IDENT_INT (1), IDENT_INT (2)) := 
+                                (IDENT_INT (1), IDENT_INT (2), 
+                                 ARR'(1 => 3, 2 => 4));
+                    END RECORD;
+ 
+          R : REC2;
+
+          BEGIN
+               IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN 
+                    CHECK (R.COMP.A, "RECORD");
+               ELSE 
+                    FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
+                             "OF RECORD TYPE COMPONENT" );
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
+                             "SEQUENCE FOLLOWING DECLARATION OF " &
+                             "RECORD TYPE COMPONENT" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
+                             "SEQUENCE FOLLOWING DECLARATION OF " &
+                             "RECORD TYPE COMPONENT" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
+                        "OF RECORD TYPE COMPONENT" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
+                        "OF RECORD TYPE COMPONENT" );
+     END;
+ 
+     BEGIN
+          DECLARE
+          
+               TYPE REC2 IS
+                    RECORD
+                         COMP : REC1_NAME (IDENT_INT (1), 
+                                           IDENT_INT (2)) := 
+                                NEW REC1'(IDENT_INT (1), 
+                                          IDENT_INT (2), 
+                                          ARR'(1 => 3, 2 => 4));
+                    END RECORD;
+ 
+          R : REC2;
+
+          BEGIN
+               IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN 
+                    CHECK (R.COMP.A, "ACCESS");
+               ELSE 
+                    FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
+                             "OF ACCESS TYPE COMPONENT" );
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
+                             "SEQUENCE FOLLOWING DECLARATION OF " &
+                             "ACCESS TYPE COMPONENT" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
+                             "SEQUENCE FOLLOWING DECLARATION OF " &
+                             "ACCESS TYPE COMPONENT" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
+                        "OF ACCESS TYPE COMPONENT" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
+                        "OF ACCESS TYPE COMPONENT" );
+     END;
+ 
+     BEGIN
+          DECLARE
+          
+               TYPE REC2 IS
+                    RECORD
+                         COMP : PRIV (IDENT_INT (1), IDENT_INT (2)) := 
+                                PRIV_FUN (IDENT_INT (1), 
+                                          IDENT_INT (2));
+                    END RECORD;
+ 
+          R : REC2;
+
+          BEGIN
+               IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN 
+                    PRIV_CHECK (R.COMP);
+               ELSE 
+                    FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
+                             "OF PRIVATE TYPE COMPONENT" );
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
+                             "SEQUENCE FOLLOWING DECLARATION OF " &
+                             "PRIVATE TYPE COMPONENT" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
+                             "SEQUENCE FOLLOWING DECLARATION OF " &
+                             "PRIVATE TYPE COMPONENT" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
+                        "OF PRIVATE TYPE COMPONENT" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
+                        "OF PRIVATE TYPE COMPONENT" );
+     END;
+ 
+     BEGIN
+          DECLARE
+          
+               TYPE REC2 IS
+                    RECORD
+                         COMP : LIM (IDENT_INT (1), IDENT_INT (2));
+                    END RECORD;
+
+          R : REC2;
+
+          BEGIN
+               IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
+                    LIM_CHECK (R.COMP);
+               ELSE
+                    FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
+                             "OF LIM PRIV TYPE COMPONENT" );
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
+                             "SEQUENCE FOLLOWING DECLARATION OF " &
+                             " LIM PRIV TYPE COMPONENT" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
+                             "SEQUENCE FOLLOWING DECLARATION OF " &
+                             " LIM PRIV TYPE COMPONENT" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
+                        "OF  LIM PRIV TYPE COMPONENT" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
+                        "OF  LIM PRIV TYPE COMPONENT" );
+     END;
+ 
+     RESULT;
+ 
+END C37006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37008a.ada
new file mode 100644
index 000000000..5546ae0ff
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37008a.ada
@@ -0,0 +1,270 @@
+-- C37008A.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 SPECIFYING AN INVALID DEFAULT INITIALIZATION
+-- RAISES CONSTRAINT_ERROR WHEN AN OBJECT IS DECLARED.
+
+-- DAT 3/6/81
+-- SPS 10/26/82
+-- RJW 1/9/86 -  REVISED COMMENTS. ADDED 'IDENT_INT'.
+-- EDS 7/22/98   AVOID OPTIMIZATION
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C37008A IS
+BEGIN
+     TEST ("C37008A", "CHECK THAT INVALID DEFAULT RECORD"
+                    & " COMPONENT INITIALIZATIONS RAISE"
+                    & " CONSTRAINT_ERROR");
+
+     BEGIN
+          DECLARE
+               TYPE R1 IS RECORD
+                    C1 : INTEGER RANGE 1 .. 5 := IDENT_INT (0);
+               END RECORD;
+               REC1 : R1;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 1 " & INTEGER'IMAGE(REC1.C1));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE R IS RECORD
+                    C : CHARACTER RANGE 'A' .. 'Y' := 'Z';
+               END RECORD;
+               REC2 : R;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 1A " & (REC2.C));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1A");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE R2 IS RECORD
+                    C2 : BOOLEAN RANGE FALSE .. FALSE := TRUE;
+               END RECORD;
+               REC3 : R2;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 2 " & BOOLEAN'IMAGE(REC3.C2));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE E IS (E1, E2, E3);
+               TYPE R IS RECORD
+                    C : E RANGE E2 .. E3 := E1;
+               END RECORD;
+               REC4 : R;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 2A " & E'IMAGE(REC4.C));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2A");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE R3 IS RECORD
+                    C3 : INTEGER RANGE 1 .. 5;
+               END RECORD;
+               REC5 : R3;
+               TYPE R3A IS RECORD
+                    C3A : R3 := (OTHERS => IDENT_INT (6));
+               END RECORD;
+               REC6 : R3A;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 3 " & 
+                       INTEGER'IMAGE(REC6.C3A.C3));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 3");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE ARR IS ARRAY (1..3) OF INTEGER RANGE 8..9;
+               TYPE R4 IS RECORD
+                    C4 : ARR
+                         := (1 => 8, 2 => 9, 3 => 10);
+               END RECORD;
+               REC7 : R4;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 4 " & 
+                       INTEGER'IMAGE(REC7.C4(1)));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 4");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 1 .. 5;
+
+               TYPE AA IS ACCESS A;
+
+               TYPE R5 IS RECORD
+                    C5 : AA := NEW A' (4, 5, 6);
+               END RECORD;
+               REC8 : R5;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 5 " & 
+                       INTEGER'IMAGE(REC8.C5(1)));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 5");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 1 .. 5;
+
+               TYPE AA IS ACCESS A (1 .. 3);
+
+               TYPE R6 IS RECORD
+                    C6 : AA := NEW A' (4, 4, 4, 4);
+               END RECORD;
+               REC9 : R6;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 6 " & 
+                       INTEGER'IMAGE(REC9.C6(1)));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 6");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE AI IS ACCESS INTEGER RANGE 6 .. 8;
+
+               TYPE R7 IS RECORD
+                    C7 : AI := NEW INTEGER' (5);
+               END RECORD;
+               REC10 : R7;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 7 " & 
+                       INTEGER'IMAGE(REC10.C7.ALL));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 7");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE UA IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 3 .. 5;
+
+               SUBTYPE CA IS UA (7 .. 8);
+
+               TYPE R8 IS RECORD
+                    C8 : CA := (6 .. 8 => 4);
+               END RECORD;
+               REC11 : R8;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 8 " & 
+                       INTEGER'IMAGE(REC11.C8(7)));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 8");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE UA IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 3 .. IDENT_INT(5);
+
+               TYPE R9 IS RECORD
+                    C9 : UA (11 .. 11) := (11 => 6);
+               END RECORD;
+               REC12 : R9;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 9 " & 
+                       INTEGER'IMAGE(REC12.C9(11)));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 9");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 1 .. IDENT_INT (5);
+
+               TYPE AA IS ACCESS A;
+
+               TYPE R10 IS RECORD
+                    C10 : AA := NEW A '(4, 5, 6);
+               END RECORD;
+               REC13 : R10;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 10 " & 
+                       INTEGER'IMAGE(REC13.C10(1)));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 10");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 1 .. 5;
+
+               TYPE AA IS ACCESS A (IDENT_INT (1) .. IDENT_INT (3));
+
+               TYPE R11 IS RECORD
+                    C11 : AA := NEW A '(4, 4, 4, 4);
+               END RECORD;
+               REC14 : R11;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED 11 " & 
+                       INTEGER'IMAGE(REC14.C11(1)));
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 11");
+     END;
+
+     RESULT;
+END C37008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37008b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37008b.ada
new file mode 100644
index 000000000..369f08cf5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37008b.ada
@@ -0,0 +1,232 @@
+-- C37008B.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 NO CONSTRAINT ERROR IS RAISED FOR AN UNUSED TYPE
+-- DECLARATION WITH AN INVALID DEFAULT VALUE
+
+-- JBG 9/11/81
+-- SPS 10/25/82
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C37008B IS
+BEGIN
+     TEST ("C37008B", "CHECK THAT INVALID DEFAULT RECORD"
+                    & " COMPONENT INITIALIZATIONS DO NOT RAISE"
+                    & " CONSTRAINT_ERROR");
+
+     BEGIN
+          DECLARE
+               TYPE R1 IS RECORD
+                    C1 : INTEGER RANGE 1 .. 5 := 0;
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 1");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE R IS RECORD
+                    C : CHARACTER RANGE 'A' .. 'Y' := 'Z';
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 1A");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE R2 IS RECORD
+                    C2 : BOOLEAN RANGE FALSE .. FALSE := TRUE;
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 2");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE E IS (E1, E2, E3);
+               TYPE R IS RECORD
+                    C : E RANGE E2 .. E3 := E1;
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 2A");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE R3 IS RECORD
+                    C3 : INTEGER RANGE 1 .. 5;
+               END RECORD;
+               TYPE R3A IS RECORD
+                    C3A : R3 := (OTHERS => 6);
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 3");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE ARR IS ARRAY (1..3) OF INTEGER RANGE 8..9;
+               TYPE R4 IS RECORD
+                    C4 : ARR
+                         := (1 => 8, 2 => 9, 3 => 10);
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 4");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 1 .. 5;
+
+               TYPE AA IS ACCESS A;
+
+               TYPE R5 IS RECORD
+                    C5 : AA := NEW A'(4, 5, 6);
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 5");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 1 .. 5;
+
+               TYPE AA IS ACCESS A (1 .. 3);
+
+               TYPE R6 IS RECORD
+                    C6 : AA := NEW A'(4, 4, 4, 4);
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 6");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE AI IS ACCESS INTEGER RANGE 6 .. 8;
+
+               TYPE R7 IS RECORD
+                    C7 : AI := NEW INTEGER'(5);
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 7");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE UA IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 3 .. 5;
+
+               SUBTYPE CA IS UA (7 .. 8);
+
+               TYPE R8 IS RECORD
+                    C8 : CA := (6 .. 8 => 4);
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 8");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE UA IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 3 .. IDENT_INT(5);
+
+               TYPE R9 IS RECORD
+                    C9 : UA (11 .. 11) := (11 => 6);
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 9");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 1 .. IDENT_INT (5);
+
+               TYPE AA IS ACCESS A;
+
+               TYPE R10 IS RECORD
+                    C10 : AA := NEW A'(4, 5, 6);
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 10");
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE A IS ARRAY (NATURAL RANGE <> )
+                    OF INTEGER RANGE 1 .. 5;
+
+               TYPE AA IS ACCESS A (IDENT_INT (1) .. IDENT_INT (3));
+
+               TYPE R11 IS RECORD
+                    C11 : AA := NEW A'(4, 4, 4, 4);
+               END RECORD;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED 11");
+     END;
+
+     RESULT;
+END C37008B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37009a.ada
new file mode 100644
index 000000000..bdb3d810c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37009a.ada
@@ -0,0 +1,195 @@
+-- C37009A.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 UNCONSTRAINED RECORD TYPE CAN BE USED TO DECLARE A
+--     RECORD COMPONENT THAT CAN BE INITIALIZED WITH AN APPROPRIATE
+--     EXPLICIT OR DEFAULT VALUE.
+
+-- HISTORY:
+--     DHH 02/01/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C37009A IS
+
+     TYPE FLOAT IS DIGITS 5;
+     TYPE COLOR IS (RED, YELLOW, BLUE);
+
+     TYPE COMPONENT IS
+          RECORD
+               I : INTEGER := 1;
+               X : FLOAT := 3.5;
+               BOL : BOOLEAN := FALSE;
+               FIRST : COLOR := RED;
+          END RECORD;
+     TYPE COMP_DIS(A : INTEGER := 1) IS
+          RECORD
+               I : INTEGER := 1;
+               X : FLOAT := 3.5;
+               BOL : BOOLEAN := FALSE;
+               FIRST : COLOR := RED;
+          END RECORD;
+     SUBTYPE SMAL_INTEGER IS INTEGER RANGE 1 .. 10;
+     TYPE LIST IS ARRAY(INTEGER RANGE <>) OF FLOAT;
+
+     TYPE DISCRIM(P : SMAL_INTEGER := 2) IS
+          RECORD
+               A : LIST(1 .. P) := (1 .. P => 1.25);
+          END RECORD;
+
+     TYPE REC_T IS                                     -- EXPLICIT INIT.
+          RECORD
+               T : COMPONENT := (5, 6.0, TRUE, YELLOW);
+               U : DISCRIM(3) := (3, (1 .. 3 => 2.25));
+               L : COMP_DIS(5) := (A => 5, I => 5, X => 6.0,
+                                      BOL =>TRUE, FIRST => YELLOW);
+          END RECORD;
+
+     TYPE REC_DEF_T IS                                 -- DEFAULT INIT.
+          RECORD
+               T : COMPONENT;
+               U : DISCRIM;
+               L : COMP_DIS;
+          END RECORD;
+
+     REC : REC_T;
+     REC_DEF : REC_DEF_T;
+
+     FUNCTION IDENT_FLT(X : FLOAT) RETURN FLOAT IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN X;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT_FLT;
+
+     FUNCTION IDENT_ENUM(X : COLOR) RETURN COLOR IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN X;
+          ELSE
+               RETURN BLUE;
+          END IF;
+     END IDENT_ENUM;
+
+BEGIN
+     TEST("C37009A", "CHECK THAT AN UNCONSTRAINED RECORD TYPE CAN " &
+                     "BE USED TO DECLARE A RECORD COMPONENT THAT " &
+                     "CAN BE INITIALIZED WITH AN APPROPRIATE " &
+                     "EXPLICIT OR DEFAULT VALUE");
+
+     IF REC_DEF.T.I /= IDENT_INT(1) THEN
+          FAILED("INCORRECT DEFAULT INITIALIZATION OF INTEGER");
+     END IF;
+
+     IF IDENT_BOOL(REC_DEF.T.BOL) THEN
+          FAILED("INCORRECT DEFAULT INITIALIZATION OF BOOLEAN");
+     END IF;
+
+     IF REC_DEF.T.X /= IDENT_FLT(3.5) THEN
+          FAILED("INCORRECT DEFAULT INITIALIZATION OF REAL");
+     END IF;
+
+     IF REC_DEF.T.FIRST /= IDENT_ENUM(RED) THEN
+          FAILED("INCORRECT DEFAULT INITIALIZATION OF ENUMERATION");
+     END IF;
+
+     FOR I IN 1 .. 2 LOOP
+          IF REC_DEF.U.A(I) /= IDENT_FLT(1.25) THEN
+               FAILED("INCORRECT DEFAULT INITIALIZATION OF ARRAY " &
+                      "POSITION " & INTEGER'IMAGE(I));
+          END IF;
+     END LOOP;
+
+     IF REC_DEF.L.A /= IDENT_INT(1) THEN
+          FAILED("INCORRECT DEFAULT INITIALIZATION OF DISCRIMINANT " &
+                 "- L");
+     END IF;
+
+     IF REC_DEF.L.I /= IDENT_INT(1) THEN
+          FAILED("INCORRECT DEFAULT INITIALIZATION OF INTEGER - L");
+     END IF;
+
+     IF IDENT_BOOL(REC_DEF.L.BOL) THEN
+          FAILED("INCORRECT DEFAULT INITIALIZATION OF BOOLEAN - L");
+     END IF;
+
+     IF REC_DEF.L.X /= IDENT_FLT(3.5) THEN
+          FAILED("INCORRECT DEFAULT INITIALIZATION OF REAL - L");
+     END IF;
+
+     IF REC_DEF.L.FIRST /= IDENT_ENUM(RED) THEN
+          FAILED("INCORRECT DEFAULT INITIALIZATION OF ENUMERATION - L");
+     END IF;
+--------------------------------------------------------------------
+     IF REC.T.I /= IDENT_INT(5) THEN
+          FAILED("INCORRECT EXPLICIT INITIALIZATION OF INTEGER");
+     END IF;
+
+     IF NOT IDENT_BOOL(REC.T.BOL) THEN
+          FAILED("INCORRECT EXPLICIT INITIALIZATION OF BOOLEAN");
+     END IF;
+
+     IF REC.T.X /= IDENT_FLT(6.0) THEN
+          FAILED("INCORRECT EXPLICIT INITIALIZATION OF REAL");
+     END IF;
+
+     IF REC.T.FIRST /= YELLOW THEN
+          FAILED("INCORRECT EXPLICIT INITIALIZATION OF ENUMERATION");
+     END IF;
+
+     FOR I IN 1 .. 3 LOOP
+          IF REC.U.A(I) /= IDENT_FLT(2.25) THEN
+               FAILED("INCORRECT EXPLICIT INITIALIZATION OF ARRAY " &
+                      "POSITION " & INTEGER'IMAGE(I));
+          END IF;
+     END LOOP;
+
+     IF REC.L.A /= IDENT_INT(5) THEN
+          FAILED("INCORRECT EXPLICIT INITIALIZATION OF DISCRIMINANT " &
+                 "- L");
+     END IF;
+
+     IF REC.L.I /= IDENT_INT(5) THEN
+          FAILED("INCORRECT EXPLICIT INITIALIZATION OF INTEGER - L");
+     END IF;
+
+     IF NOT IDENT_BOOL(REC.L.BOL) THEN
+          FAILED("INCORRECT EXPLICIT INITIALIZATION OF BOOLEAN - L");
+     END IF;
+
+     IF REC.L.X /= IDENT_FLT(6.0) THEN
+          FAILED("INCORRECT EXPLICIT INITIALIZATION OF REAL - L");
+     END IF;
+
+     IF REC.L.FIRST /= IDENT_ENUM(YELLOW) THEN
+          FAILED("INCORRECT EXPLICIT INITIALIZATION OF ENUMERATION " &
+                 "- L");
+     END IF;
+
+     RESULT;
+
+END C37009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37010a.ada
new file mode 100644
index 000000000..64ba42018
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37010a.ada
@@ -0,0 +1,140 @@
+-- C37010A.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 EXPRESSIONS IN CONSTRAINTS OF COMPONENT DECLARATIONS ARE
+-- EVALUATED IN THE ORDER THE COMPONENTS APPEAR.
+
+-- R.WILLIAMS 8/22/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37010A IS
+     
+     TYPE R (D : INTEGER) IS
+             RECORD
+                  NULL;
+             END RECORD;
+
+     TYPE ACCR IS ACCESS R;
+
+     TYPE ARR IS ARRAY (POSITIVE RANGE <> ) OF INTEGER;
+
+     TYPE ACCA IS ACCESS ARR;
+
+     BUMP : INTEGER := 0;
+
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+          BUMP := BUMP + 1;
+          RETURN BUMP;
+     END;          
+
+BEGIN
+     TEST ( "C37010A", "CHECK THAT EXPRESSIONS IN CONSTRAINTS OF " &
+                       "COMPONENT DECLARATIONS ARE EVALUATED IN " &
+                       "THE ORDER THE COMPONENTS APPEAR" );
+
+     DECLARE
+          
+          TYPE REC1 IS 
+               RECORD
+                    A1 : R (D => F);
+                    B1 : STRING (1 .. F);
+                    C1 : ACCR (F);
+                    D1 : ACCA (1 .. F);
+               END RECORD;
+               
+          R1 : REC1;
+
+     BEGIN
+          IF R1.A1.D /= 1 THEN 
+               FAILED ( "INCORRECT VALUE FOR R1.A1.D" );
+          END IF;
+     
+          IF R1.B1'LAST /= 2 THEN
+               FAILED ( "INCORRECT VALUE FOR R1.B1'LAST" );
+          END IF;
+     
+          BEGIN
+               R1.C1 := NEW R'(D => 3);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "INCORRECT VALUE FOR R1.C1" );
+          END;
+
+          BEGIN
+               R1.D1 := NEW ARR (1 .. 4);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "INCORRECT VALUE FOR R1.D1" );
+          END;
+
+     END;
+
+     BUMP := 0;
+          
+     DECLARE
+          
+          TYPE REC2 (I : INTEGER) IS
+               RECORD
+                    CASE I IS
+                         WHEN 1 =>
+                              NULL;
+                         WHEN OTHERS =>
+                              A2 : R (D => F);
+                              B2 : ARR (1 .. F);
+                              C2 : ACCR (F);
+                              D2 : ACCA (1 .. F);
+                    END CASE;                     
+               END RECORD;
+
+          R2 : REC2 (IDENT_INT (2));
+
+     BEGIN
+          
+          IF R2.A2.D /= 1 THEN 
+               FAILED ( "INCORRECT VALUE FOR R2.A2.D" );
+          END IF;
+
+          IF R2.B2'LAST /= 2 THEN
+               FAILED ( "INCORRECT VALUE FOR R2.B2'LAST" );
+          END IF;
+
+          BEGIN
+               R2.C2 := NEW R (D => 3);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "INCORRECT VALUE FOR R2.C2" );
+          END;
+ 
+          BEGIN
+               R2.D2 := NEW ARR (1 .. 4);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "INCORRECT VALUE FOR R2.D2" );
+          END;                         
+          
+     END;
+          
+     RESULT;
+END C37010A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37010b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37010b.ada
new file mode 100644
index 000000000..aa94b2dec
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37010b.ada
@@ -0,0 +1,164 @@
+-- C37010B.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 EXPRESSIONS IN AN INDEX CONSTRAINT OR DISCRIMINANT 
+-- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT DECLARATION IS 
+-- ELABORATED EVEN IF SOME BOUNDS OR DISCRIMINANTS ARE GIVEN BY
+-- A DISCRIMINANT OF AN ENCLOSING RECORD TYPE.
+
+-- R.WILLIAMS 8/22/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37010B IS
+     
+     INIT :INTEGER := IDENT_INT (5);
+
+     TYPE R (D1, D2 : INTEGER) IS
+          RECORD
+               NULL;
+          END RECORD;
+
+     TYPE ACCR IS ACCESS R;
+
+     TYPE ARR IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+
+     TYPE ACCA IS ACCESS ARR;
+
+     FUNCTION RESET (N : INTEGER) RETURN INTEGER IS
+     BEGIN
+          INIT := IDENT_INT (N);
+          RETURN N;
+     END RESET;
+
+BEGIN
+     TEST ( "C37010B", "CHECK THAT EXPRESSIONS IN AN INDEX " &
+                       "CONSTRAINT OR DISCRIMINANT CONSTRAINT " &
+                       "ARE EVALUATED WHEN THE COMPONENT " &
+                       "DECLARATION IS ELABORATED EVEN IF SOME " &
+                       "BOUNDS OR DISCRIMINANTS ARE GIVEN BY " &
+                       "A DISCRIMINANT OF AN ENCLOSING RECORD TYPE" );
+
+     DECLARE
+          
+          TYPE REC1 (D : INTEGER) IS 
+               RECORD
+                    W1 : R (D1 => INIT, D2 => D);
+                    X1 : ARR (INIT .. D);
+                    Y1 : ACCR (D, INIT);
+                    Z1 : ACCA (D .. INIT);
+               END RECORD;
+          
+          INT1 : INTEGER := RESET (10);
+
+          R1 : REC1 (D => 4);
+
+     BEGIN
+          IF R1.W1.D1 /= 5 THEN 
+               FAILED ( "INCORRECT VALUE FOR R1.W1.D1" );
+          END IF;
+     
+          IF R1.W1.D2 /= 4 THEN 
+               FAILED ( "INCORRECT VALUE FOR R1.W1.D2" );
+          END IF;
+
+          IF R1.X1'FIRST /= 5 THEN
+               FAILED ( "INCORRECT VALUE FOR R1.X1'FIRST" );
+          END IF;
+
+          IF R1.X1'LAST /= 4 THEN
+               FAILED ( "INCORRECT VALUE FOR R1.X1'LAST" );
+          END IF;
+
+          BEGIN
+               R1.Y1 := NEW R (4, 5);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "INCORRECT VALUE FOR R1.Y1" );
+          END;
+
+          BEGIN
+               R1.Z1 := NEW ARR (4 .. 5);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "INCORRECT VALUE FOR R1.Z1" );
+          END;
+                    
+     END;
+
+     DECLARE
+          
+          TYPE REC2 (D : INTEGER) IS
+               RECORD
+                    CASE D IS
+                         WHEN 1 =>
+                              NULL;
+                         WHEN 2 =>
+                              NULL;
+                         WHEN OTHERS =>
+                              W2 : R (D1 => D, D2 => INIT);
+                              X2 : ARR (D .. INIT);
+                              Y2 : ACCR (INIT, D);
+                              Z2 : ACCA (D .. INIT);
+                    END CASE;                     
+               END RECORD;
+
+          INT2 : INTEGER := RESET (20);
+
+          R2 : REC2 (D => 6);
+
+     BEGIN
+          IF R2.W2.D1 /= 6 THEN 
+               FAILED ( "INCORRECT VALUE FOR R2.W2.D1" );
+          END IF;
+
+          IF R2.W2.D2 /= 10 THEN 
+               FAILED ( "INCORRECT VALUE FOR R2.W2.D2" );
+          END IF;
+
+          IF R2.X2'FIRST /= 6 THEN
+               FAILED ( "INCORRECT VALUE FOR R2.X2'FIRST" );
+          END IF;
+
+          IF R2.X2'LAST /= 10 THEN
+               FAILED ( "INCORRECT VALUE FOR R2.X2'LAST" );
+          END IF;
+
+          BEGIN
+               R2.Y2 := NEW R (10, 6);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "INCORRECT VALUE FOR R2.Y2" );
+          END;
+
+          BEGIN
+               R2.Z2 := NEW ARR (6 .. 10);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "INCORRECT VALUE FOR R2.Z2" );
+          END;
+                    
+     END;
+
+     RESULT;
+END C37010B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371001.a
new file mode 100644
index 000000000..f6823570b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371001.a
@@ -0,0 +1,388 @@
+-- C371001.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 discriminant constraint depends on a discriminant,
+--      the evaluation of the expressions in the constraint is deferred 
+--      until an object of the subtype is created.  Check for cases of 
+--      records with private type component.
+--
+-- TEST DESCRIPTION:
+--      This transition test defines record type and incomplete types with 
+--      discriminant components which depend on the discriminants.  The 
+--      discriminants are calculated by function calls.  The test verifies
+--      that Constraint_Error is raised during the object creations when 
+--      values of discriminants are incompatible with the subtypes.
+--
+--      Inspired by C37214A.ADA and C37216A.ADA.
+--
+--
+-- CHANGE HISTORY:
+--      11 Apr 96   SAIC    Initial version for ACVC 2.1.
+--      06 Oct 96   SAIC    Added LM references. Replaced "others exception"
+--                          with "unexpected exception"                     
+--
+--!
+
+with Report; 
+
+procedure C371001 is
+
+   subtype Small_Int is Integer range 1..10;
+
+   Func1_Cons : Integer := 0;
+
+   ---------------------------------------------------------
+   function Func1 return Integer is
+   begin
+      Func1_Cons := Func1_Cons + Report.Ident_Int(1);
+      return Func1_Cons;
+   end Func1;
+
+
+begin
+   Report.Test ("C371001", "Check that if a discriminant constraint " &
+                "depends on a discriminant, the evaluation of the "   &
+                "expressions in the constraint is deferred until "    &
+                "object declarations");
+
+   ---------------------------------------------------------
+   -- Constraint checks on an object declaration of a record.
+
+   begin
+
+      declare
+
+         package C371001_0 is
+
+            type PT_W_Disc (D : Small_Int) is private;
+            type Rec_W_Private (D1 : Integer) is
+              record
+                 C : PT_W_Disc (D1);
+              end record;
+   
+            type Rec (D3 : Integer) is
+              record
+                 C1 : Rec_W_Private (D3);
+              end record;
+
+         private
+            type PT_W_Disc (D : Small_Int) is 
+              record
+                 Str : String (1 .. D) := (others => '*');
+              end record;
+
+         end C371001_0;                         
+
+         --=====================================================--
+
+         Obj : C371001_0.Rec(Report.Ident_Int(0));  -- Constraint_Error raised.
+
+      begin
+         Report.Failed ("Obj - Constraint_Error should be raised");
+         if Obj.C1.D1 /= 0 then
+            Report.Failed ("Obj - Shouldn't get here");
+         end if;
+
+      exception
+         when others           => 
+              Report.Failed ("Obj - exception raised too late");
+      end;
+
+   exception                      
+      when Constraint_Error =>                      -- Exception expected.
+           null;
+      when others           => 
+           Report.Failed ("Obj - unexpected exception raised");
+   end;
+
+   -------------------------------------------------------------------
+   -- Constraint checks on an object declaration of an array.
+
+   begin
+      declare
+
+         package C371001_1 is
+
+            type PT_W_Disc (D : Small_Int) is private;
+            type Rec_W_Private (D1 : Integer) is
+              record
+                 C : PT_W_Disc (D1);
+              end record;
+
+            type Rec_01 (D3 : Integer) is
+              record
+                 C1 : Rec_W_Private (D3);
+              end record;
+
+            type Arr is array (1 .. 5) of 
+              Rec_01(Report.Ident_Int(0));          -- No Constraint_Error 
+                                                    -- raised. 
+         private
+            type PT_W_Disc (D : Small_Int) is 
+              record
+                 Str : String (1 .. D) := (others => '*');
+              end record;
+
+         end C371001_1;                         
+
+         --=====================================================--
+
+      begin
+         declare
+            Obj1 : C371001_1.Arr;                   -- Constraint_Error raised.
+         begin
+            Report.Failed ("Obj1 - Constraint_Error should be raised");
+            if Obj1(1).D3 /= 0 then
+               Report.Failed ("Obj1 - Shouldn't get here");
+            end if;
+
+         exception
+            when others           => 
+                 Report.Failed ("Obj1 - exception raised too late");
+         end;
+
+      exception
+         when Constraint_Error =>                   -- Exception expected.
+              null;
+         when others =>
+              Report.Failed ("Obj1 - unexpected exception raised");
+      end;
+
+   exception
+      when Constraint_Error =>
+           Report.Failed ("Arr - Constraint_Error raised");
+      when others =>
+           Report.Failed ("Arr - unexpected exception raised");
+   end;
+
+
+   -------------------------------------------------------------------
+   -- Constraint checks on an object declaration of an access type.
+
+   begin
+      declare
+
+         package C371001_2 is
+
+            type PT_W_Disc (D : Small_Int) is private;
+            type Rec_W_Private (D1 : Integer) is
+              record
+                 C : PT_W_Disc (D1);
+              end record;
+   
+            type Rec_02 (D3 : Integer) is
+              record
+                 C1 : Rec_W_Private (D3);
+              end record;
+
+            type Acc_Rec2 is access Rec_02          -- No Constraint_Error 
+              (Report.Ident_Int(11));               -- raised. 
+
+         private
+            type PT_W_Disc (D : Small_Int) is 
+              record
+                 Str : String (1 .. D) := (others => '*');
+              end record;
+
+         end C371001_2;                         
+
+         --=====================================================--
+
+      begin
+         declare
+            Obj2 : C371001_2.Acc_Rec2;              -- No Constraint_Error 
+                                                    -- raised.
+         begin
+            Obj2 := new C371001_2.Rec_02 (Report.Ident_Int(11));       
+                                                    -- Constraint_Error raised.
+
+            Report.Failed ("Obj2 - Constraint_Error should be raised");
+            if Obj2.D3 /= 1 then
+               Report.Failed ("Obj2 - Shouldn't get here");
+            end if;
+
+         exception
+            when Constraint_Error =>                -- Exception expected.
+               null;
+            when others           => 
+               Report.Failed ("Obj2 - unexpected exception raised in " &
+                              "assignment");
+         end;
+
+      exception
+         when Constraint_Error =>  
+              Report.Failed ("Obj2 - Constraint_Error raised in declaration");
+         when others =>
+              Report.Failed ("Obj2 - unexpected exception raised in " &
+                             "declaration");
+      end;
+
+   exception
+      when Constraint_Error =>  
+           Report.Failed ("Acc_Rec2 - Constraint_Error raised");
+      when others =>
+           Report.Failed ("Acc_Rec2 - unexpected exception raised");
+   end;
+
+   -------------------------------------------------------------------
+   -- Constraint checks on an object declaration of a subtype.
+
+   Func1_Cons := -1;
+
+   begin
+      declare
+
+         package C371001_3 is
+
+            type PT_W_Disc (D1, D2 : Small_Int) is private;
+            type Rec_W_Private (D3, D4 : Integer) is
+              record
+                 C : PT_W_Disc (D3, D4);
+              end record;
+   
+            type Rec_03 (D5 : Integer) is
+              record
+                 C1 : Rec_W_Private (D5, Func1);     -- Func1 evaluated,
+              end record;                            -- value 0.
+
+            subtype Subtype_Rec is Rec_03(1);        -- No Constraint_Error 
+                                                     -- raised. 
+         private
+            type PT_W_Disc (D1, D2 : Small_Int) is 
+              record
+                 Str1 : String (1 .. D1) := (others => '*');
+                 Str2 : String (1 .. D2) := (others => '*');
+              end record;
+
+         end C371001_3;                         
+
+         --=====================================================--
+
+      begin
+         declare
+            Obj3 : C371001_3.Subtype_Rec;            -- Constraint_Error raised.
+         begin
+            Report.Failed ("Obj3 - Constraint_Error should be raised");
+            if Obj3.D5 /= 1 then
+               Report.Failed ("Obj3 - Shouldn't get here");
+            end if;
+
+         exception
+            when others           => 
+                 Report.Failed ("Obj3 - exception raised too late");
+         end;
+
+      exception
+         when Constraint_Error =>                    -- Exception expected.
+              null;
+         when others =>
+              Report.Failed ("Obj3 - unexpected exception raised");
+      end;
+
+   exception
+      when Constraint_Error =>
+           Report.Failed ("Subtype_Rec - Constraint_Error raised");
+      when others =>
+           Report.Failed ("Subtype_Rec - unexpected exception raised");
+   end;
+
+   -------------------------------------------------------------------
+   -- Constraint checks on an object declaration of an incomplete type.
+
+   Func1_Cons := 10;
+
+   begin
+      declare
+
+         package C371001_4 is
+
+            type Rec_04 (D3 : Integer);
+            type PT_W_Disc (D : Small_Int) is private;
+            type Rec_W_Private (D1, D2 : Small_Int) is
+              record
+                 C : PT_W_Disc (D2);
+              end record;
+
+            type Rec_04 (D3 : Integer) is
+              record
+                 C1 : Rec_W_Private (D3, Func1);     -- Func1 evaluated
+              end record;                            -- value 11.
+
+            type Acc_Rec4 is access Rec_04 (1);      -- No Constraint_Error 
+                                                     -- raised. 
+         private
+            type PT_W_Disc (D : Small_Int) is 
+              record
+                 Str : String (1 .. D) := (others => '*');
+              end record;
+
+         end C371001_4;                         
+
+         --=====================================================--
+
+      begin
+         declare
+            Obj4 : C371001_4.Acc_Rec4;               -- No Constraint_Error 
+                                                     -- raised.
+         begin
+            Obj4 := new C371001_4.Rec_04 (1);        -- Constraint_Error raised.
+
+            Report.Failed ("Obj4 - Constraint_Error should be raised");
+            if Obj4.D3 /= 1 then
+               Report.Failed ("Obj4 - Shouldn't get here");
+            end if;
+
+         exception
+            when Constraint_Error =>                 -- Exception expected.
+               null;
+            when others           => 
+               Report.Failed ("Obj4 - unexpected exception raised in " &
+                              "assignment");
+         end;
+
+      exception
+         when Constraint_Error =>  
+              Report.Failed ("Obj4 - Constraint_Error raised in declaration");
+         when others =>
+              Report.Failed ("Obj4 - unexpected exception raised in " &
+                             "declaration");
+      end;
+
+   exception
+      when Constraint_Error =>  
+           Report.Failed ("Acc_Rec4 - Constraint_Error raised");
+      when others =>
+           Report.Failed ("Acc_Rec4 - unexpected exception raised");
+   end;
+
+   Report.Result;
+
+exception
+   when others =>
+        Report.Failed ("Discriminant value checked too soon");
+        Report.Result;
+
+end C371001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371002.a
new file mode 100644
index 000000000..ea532550c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371002.a
@@ -0,0 +1,364 @@
+-- C371002.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 discriminant constraint depends on a discriminant,
+--      the evaluation of the expressions in the constraint is deferred until
+--      an object of the subtype is created.  Check for cases of records.
+--
+-- TEST DESCRIPTION:
+--      This transition test defines record types with discriminant components
+--      which depend on the discriminants.  The discriminants are calculated 
+--      by function calls.  The test verifies that Constraint_Error is raised 
+--      during the object creations when values of discriminants are 
+--      incompatible with the subtypes.
+--
+--      Inspired by C37213A.ADA, C37213C.ADA, C37215A.ADA and C37215C.ADA.
+--
+--
+-- CHANGE HISTORY:
+--      05 Apr 96   SAIC    Initial version for ACVC 2.1.
+--
+--!
+
+with Report; 
+
+procedure C371002 is
+
+   subtype Small_Int is Integer range 1..10;
+
+   type Rec_W_Disc (Disc1, Disc2 : Small_Int) is 
+     record 
+        Str1 : String (1 .. Disc1) := (others => '*');
+        Str2 : String (1 .. Disc2) := (others => '*');
+     end record;
+
+   type My_Array is array (Small_Int range <>) of Integer;
+
+   Func1_Cons : Integer := 0;
+
+   ---------------------------------------------------------
+   function Chk (Cons    : Integer;
+                 Value   : Integer;
+                 Message : String) return Boolean is
+   begin
+      if Cons /= Value then
+         Report.Failed (Message & ": Func1_Cons is " &
+                        Integer'Image(Func1_Cons));
+      end if;
+      return True;
+   end Chk;
+
+   ---------------------------------------------------------
+   function Func1 return Integer is
+   begin
+      Func1_Cons := Func1_Cons + Report.Ident_Int(1);
+      return Func1_Cons;
+   end Func1;
+
+begin
+   Report.Test ("C371002", "Check that if a discriminant constraint " &
+                "depends on a discriminant, the evaluation of the "   &
+                "expressions in the constraint is deferred until "    &
+                "object declarations");
+
+   ---------------------------------------------------------
+   declare
+      type Rec1 (D3 : Integer) is
+        record
+           C1 : Rec_W_Disc (D3, Func1);      -- Func1 evaluated, value 1.
+        end record;
+      
+      Chk1 : Boolean := Chk (Func1_Cons, 1,
+                             "Func1 not evaluated for Rec1");
+
+      Obj1 : Rec1 (1);                       -- Func1 not evaluated again.
+      Obj2 : Rec1 (2);                       -- Func1 not evaluated again. 
+
+      Chk2 : Boolean := Chk (Func1_Cons, 1,
+                             "Func1 evaluated too many times");
+   begin
+      if Obj1 /= (D3 => 1, 
+                  C1 => (Disc1   => 1,  
+                         Disc2   => 1, 
+                         Str1    => (others => '*'),
+                         Str2    => (others => '*'))) or
+         Obj2 /= (D3 => 2, 
+                  C1 => (Disc1   => 2,  
+                         Disc2   => 1, 
+                         Str1    => (others => '*'),
+                         Str2    => (others => '*'))) then
+           Report.Failed ("Obj1 & Obj2 - Discriminant values not correct");
+      end if;
+   end;
+
+   ---------------------------------------------------------
+   Func1_Cons := -11;
+
+   declare
+      type Rec_Of_Rec_01 (D3 : Integer) is
+        record
+           C1 : Rec_W_Disc (D3, Func1);      -- Func1 evaluated, value -10.
+        end record;                          -- Constraint_Error not raised. 
+
+      type Rec_Of_MyArr_01 (D3 : Integer) is
+        record
+           C1 : My_Array (Func1 .. D3);      -- Func1 evaluated, value -9.
+        end record;                          -- Constraint_Error not raised. 
+
+      type Rec_Of_Rec_02 (D3 : Integer) is
+        record
+           C1 : Rec_W_Disc (D3, 1);
+        end record;
+
+      type Rec_Of_MyArr_02 (D3 : Integer) is
+        record
+           C1 : My_Array (D3 .. 1);       
+        end record;
+
+   begin
+
+      ---------------------------------------------------------
+      begin
+         declare
+            Obj3 : Rec_Of_Rec_01(1);         -- Constraint_Error raised.
+         begin
+            Report.Failed ("Obj3 - Constraint_Error should be raised");
+            if Obj3 /= (1, (1, 1, others => (others => '*'))) then
+               Report.Comment ("Obj3 - Shouldn't get here");
+            end if;
+         end;
+
+      exception
+         when Constraint_Error =>            -- Exception expected.
+              null;
+         when others           => 
+              Report.Failed ("Obj3 - others exception raised");
+      end;
+        
+      ---------------------------------------------------------
+      begin
+         declare
+            subtype Subtype_Rec is Rec_Of_Rec_01(1);  
+                                             -- No Constraint_Error raised.
+         begin
+            declare
+               Obj4 : Subtype_Rec;           -- Constraint_Error raised.
+            begin
+               Report.Failed ("Obj4 - Constraint_Error should be raised");
+               if Obj4 /= (D3 => 1, 
+                           C1 => (Disc1   => 1,  
+                                  Disc2   => 1, 
+                                  Str1    => (others => '*'),
+                                  Str2    => (others => '*'))) then
+                  Report.Comment ("Obj4 - Shouldn't get here");
+               end if;
+            end;
+
+         exception
+            when Constraint_Error =>         -- Exception expected.
+                null;
+            when others =>
+                Report.Failed ("Obj4 - others exception raised");
+         end;
+
+      exception
+         when Constraint_Error =>
+              Report.Failed ("Subtype_Rec - Constraint_Error raised");
+         when others =>
+              Report.Failed ("Subtype_Rec - others exception raised");
+      end;
+
+      ---------------------------------------------------------
+      begin
+         declare
+            type Arr is array (1..5)         -- No Constraint_Error raised.
+              of Rec_Of_Rec_01(1);                         
+                                                       
+         begin
+            declare
+               Obj5 : Arr;                   -- Constraint_Error raised.
+            begin
+               Report.Failed ("Obj5 - Constraint_Error should be raised");
+               if Obj5 /= (1..5 => (1, (1, 1, others => (others => '*')))) then
+                  Report.Comment ("Obj5 - Shouldn't get here");
+               end if;
+            end;
+
+         exception
+            when Constraint_Error =>         -- Exception expected.
+                null;
+            when others =>
+                Report.Failed ("Obj5 - others exception raised");
+         end;
+
+      exception
+         when Constraint_Error =>
+              Report.Failed ("Arr - Constraint_Error raised");
+         when others =>
+              Report.Failed ("Arr - others exception raised");
+      end;
+
+      ---------------------------------------------------------
+      begin
+         declare
+            type Rec_Of_Rec_Of_MyArr is
+              record
+                 C1 : Rec_Of_MyArr_01(1);    -- No Constraint_Error raised.
+              end record;                    
+         begin
+            declare
+               Obj6 : Rec_Of_Rec_Of_MyArr;   -- Constraint_Error raised.
+            begin
+               Report.Failed ("Obj6 - Constraint_Error should be raised");
+               if Obj6 /= (C1 => (1, (1, 1))) then
+                  Report.Comment ("Obj6 - Shouldn't get here");
+               end if;
+            end;
+
+         exception
+            when Constraint_Error =>         -- Exception expected.
+                null;
+            when others =>
+                Report.Failed ("Obj6 - others exception raised");
+         end;
+
+      exception
+         when Constraint_Error =>
+              Report.Failed ("Rec_Of_Rec_Of_MyArr - Constraint_Error raised");
+         when others =>
+              Report.Failed ("Rec_Of_Rec_Of_MyArr - others exception raised");
+      end;
+
+      ---------------------------------------------------------
+      begin
+         declare
+            type New_Rec is 
+              new Rec_Of_MyArr_01(1);        -- No Constraint_Error raised.
+
+         begin
+            declare
+               Obj7 : New_Rec;               -- Constraint_Error raised.
+            begin
+               Report.Failed ("Obj7 - Constraint_Error should be raised");
+               if Obj7 /= (1, (1, 1)) then
+                  Report.Comment ("Obj7 - Shouldn't get here");
+               end if;
+            end;
+
+         exception
+            when Constraint_Error =>         -- Exception expected.
+                null;
+            when others =>
+                Report.Failed ("Obj7 - others exception raised");
+         end;
+
+      exception
+         when Constraint_Error =>
+              Report.Failed ("New_Rec - Constraint_Error raised");
+         when others =>
+              Report.Failed ("New_Rec - others exception raised");
+      end;
+
+      ---------------------------------------------------------
+      begin
+         declare
+            type Acc_Rec is 
+              access Rec_Of_Rec_02 (Report.Ident_Int(0));
+                                             -- No Constraint_Error raised.
+         begin
+            declare
+               Obj8 : Acc_Rec;               -- No Constraint_Error raised.
+
+            begin                                   
+               Obj8 := new Rec_Of_Rec_02 (Report.Ident_Int(0));
+                                             -- Constraint_Error raised.
+
+               Report.Failed ("Obj8 - Constraint_Error should be raised");
+               if Obj8.all /= (D3 => 1, 
+                               C1 => (Disc1   => 1,  
+                                      Disc2   => 1, 
+                                      Str1    => (others => '*'),
+                                      Str2    => (others => '*'))) then
+                  Report.Comment ("Obj8 - Shouldn't get here");
+               end if;
+            end;
+
+         exception
+            when Constraint_Error =>         -- Exception expected.
+                null;
+            when others =>
+                Report.Failed ("Obj8 - others exception raised");
+         end;
+
+      exception
+         when Constraint_Error =>
+              Report.Failed ("Acc_Rec - Constraint_Error raised");
+         when others =>
+              Report.Failed ("Acc_Rec - others exception raised");
+      end;
+
+      ---------------------------------------------------------
+      begin
+         declare
+            type Acc_Rec_MyArr is access 
+              Rec_Of_MyArr_02;               -- No Constraint_Error 
+                                             -- raised for either
+            Obj9 : Acc_Rec_MyArr;            -- declaration.
+
+         begin
+            Obj9 := new Rec_Of_MyArr_02 (Report.Ident_Int(0));
+                                             -- Constraint_Error raised.
+
+            Report.Failed ("Obj9 - Constraint_Error should be raised");
+
+            if Obj9.all /= (1, (1, 1)) then
+               Report.Comment ("Obj9 - Shouldn't get here");
+            end if;
+       
+         exception
+            when Constraint_Error =>         -- Exception expected.
+                null;
+            when others =>
+                Report.Failed ("Obj9 - others exception raised");
+         end;
+
+      exception
+         when Constraint_Error =>
+              Report.Failed ("Acc_Rec_MyArr - Constraint_Error raised");
+         when others =>
+              Report.Failed ("Acc_Rec_MyArr - others exception raised");
+      end;
+
+   end;      
+
+   Report.Result;
+
+exception
+     when others =>
+          Report.Failed ("Discriminant value checked too soon");
+          Report.Result;
+
+end C371002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371003.a
new file mode 100644
index 000000000..c4a8345f6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c371003.a
@@ -0,0 +1,474 @@
+-- C371003.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 discriminant constraint depends on a discriminant,
+--      the evaluation of the expressions in the constraint is deferred 
+--      until an object of the subtype is created.  Check for cases of 
+--      records where the component containing the constraint is present
+--      in the subtype.                                                    
+--
+-- TEST DESCRIPTION:
+--      This transition test defines record types with discriminant components
+--      which depend on the discriminants.  The discriminants are calculated 
+--      by function calls.  The test verifies that Constraint_Error is raised 
+--      during the object creations when values of discriminants are 
+--      incompatible with the subtypes.  Also check for cases, where the
+--      component is absent.
+--
+--      Inspired by C37213E.ADA, C37213G.ADA, C37215E.ADA, and C37215G.ADA.
+--
+--
+-- CHANGE HISTORY:
+--      10 Apr 96   SAIC    Initial version for ACVC 2.1.
+--      14 Jul 96   SAIC    Modified test description.  Added exception handler
+--                          for VObj_10 assignment.
+--      26 Oct 96   SAIC    Added LM references.        
+--
+--!
+
+with Report; 
+
+procedure C371003 is
+
+   subtype Small_Int is Integer range 1..10;
+
+   type Rec_W_Disc (Disc1, Disc2 : Small_Int) is 
+     record 
+        Str1 : String (1 .. Disc1) := (others => '*');
+        Str2 : String (1 .. Disc2) := (others => '*');
+     end record;
+
+   type My_Array is array (Small_Int range <>) of Integer;
+
+   Func1_Cons : Integer := 0;
+
+   ---------------------------------------------------------
+   function Chk (Cons    : Integer;
+                 Value   : Integer;
+                 Message : String) return Boolean is
+   begin
+      if Cons /= Value then
+         Report.Failed (Message & ": Func1_Cons is " &
+                        Integer'Image(Func1_Cons));
+      end if;
+      return True;
+   end Chk;
+
+   ---------------------------------------------------------
+   function Func1 return Integer is
+   begin
+      Func1_Cons := Func1_Cons + Report.Ident_Int(1);
+      return Func1_Cons;
+   end Func1;
+
+
+begin
+   Report.Test ("C371003", "Check that if a discriminant constraint " &
+                "depends on a discriminant, the evaluation of the "   &
+                "expressions in the constraint is deferred until "    &
+                "object declarations");
+
+   ---------------------------------------------------------
+   declare
+      type VRec_01 (D3 : Integer) is
+        record
+           case D3 is
+              when -5..10 => 
+                 C1 : Rec_W_Disc (D3, Func1);    -- Func1 evaluated, value 1.
+              when others =>
+                 C2 : Integer := Report.Ident_Int(0); 
+           end case;
+        end record;
+
+        Chk1 : Boolean := Chk (Func1_Cons, 1, 
+                               "Func1 not evaluated for VRec_01");
+
+        VObj_1 : VRec_01(1);                     -- Func1 not evaluated again
+        VObj_2 : VRec_01(2);                     -- Func1 not evaluated again
+
+        Chk2 : Boolean := Chk (Func1_Cons, 1, 
+                               "Func1 evaluated too many times");
+    
+   begin
+      if VObj_1 /= (D3 => 1, 
+                    C1 => (Disc1   => 1,  
+                           Disc2   => 1, 
+                           Str1    => (others => '*'),
+                           Str2    => (others => '*'))) or
+         VObj_2 /= (D3 => 2, 
+                    C1 => (Disc1   => 2,  
+                           Disc2   => 1, 
+                           Str1    => (others => '*'),
+                           Str2    => (others => '*'))) then
+         Report.Failed ("VObj_1 & VObj_2 - Discriminant values not correct");
+      end if;
+   end;
+
+   ---------------------------------------------------------
+   Func1_Cons := -11;
+
+   declare
+      type VRec_Of_VRec_01 (D3 : Integer) is
+        record
+           case D3 is
+              when -5..10 => 
+                 C1 : Rec_W_Disc (Func1, D3);   -- Func1 evaluated, value -10.
+              when others =>                    -- Constraint_Error not raised. 
+                 C2 : Integer := Report.Ident_Int(0); 
+           end case;
+        end record;
+
+      type VRec_Of_VRec_02 (D3 : Integer) is
+        record
+           case D3 is
+              when -5..10 => 
+                 C1 : Rec_W_Disc (1, D3); 
+              when others =>
+                 C2 : Integer := Report.Ident_Int(0); 
+           end case;
+        end record;
+
+      type VRec_Of_MyArr_01 (D3 : Integer) is
+        record
+           case D3 is
+              when -5..10 => 
+                 C1 : My_Array  (Func1..D3);    -- Func1 evaluated, value -9.
+              when others =>                    -- Constraint_Error not raised. 
+                 C2 : Integer := Report.Ident_Int(0); 
+           end case;
+        end record;
+
+      type VRec_Of_MyArr_02 (D3 : Integer) is
+        record
+           case D3 is
+              when -5..10 => 
+                 C1 : My_Array  (D3..1);
+              when others =>          
+                 C2 : Integer := Report.Ident_Int(0); 
+           end case;
+        end record;
+
+   begin
+
+      ---------------------------------------------------------
+      -- Component containing the constraint is present.
+      begin
+         declare
+            VObj_3 : VRec_Of_VRec_01(1);        -- Constraint_Error raised.
+         begin
+            Report.Failed ("VObj_3 - Constraint_Error should be raised");
+            if VObj_3 /= (1, (1, 1, others => (others => '*'))) then
+                Report.Comment ("VObj_3 - Shouldn't get here");
+            end if;
+         end;
+
+      exception
+         when Constraint_Error =>               -- Exception expected.
+              null;
+         when others           => 
+              Report.Failed ("VObj_3 - unexpected exception raised");
+      end;
+        
+      ---------------------------------------------------------
+      -- Component containing the constraint is present.
+      begin
+         declare
+            subtype Subtype_VRec is             -- No Constraint_Error raised.
+              VRec_Of_VRec_01(Report.Ident_Int(1));      
+         begin
+            declare
+               VObj_4 : Subtype_VRec;           -- Constraint_Error raised.
+            begin
+               Report.Failed ("VObj_4 - Constraint_Error should be raised");
+               if VObj_4 /= (D3 => 1, 
+                             C1 => (Disc1   => 1,  
+                                    Disc2   => 1, 
+                                    Str1    => (others => '*'),
+                                    Str2    => (others => '*'))) then
+                  Report.Comment ("VObj_4 - Shouldn't get here");
+               end if;
+            end;
+
+         exception
+            when Constraint_Error =>            -- Exception expected.
+                null;
+            when others =>
+                Report.Failed ("VObj_4 - unexpected exception raised");
+         end;
+
+      exception
+         when Constraint_Error =>
+              Report.Failed ("Subtype_VRec - Constraint_Error raised");
+         when others =>
+              Report.Failed ("Subtype_VRec - unexpected exception raised");
+      end;
+
+      ---------------------------------------------------------
+      -- Component containing the constraint is absent.
+      begin
+         declare
+            type Arr is array (1..5) of         
+              VRec_Of_VRec_01(Report.Ident_Int(-6)); -- No Constraint_Error 
+            VObj_5 : Arr;                            -- for either declaration.
+
+         begin
+            if VObj_5 /= (1 .. 5 => (-6, 0)) then
+               Report.Comment ("VObj_5 - wrong values");
+            end if;
+         end;
+
+      exception
+         when others =>
+              Report.Failed ("Arr - unexpected exception raised");
+      end;
+
+      ---------------------------------------------------------
+      -- Component containing the constraint is present.
+      begin
+         declare
+            type Rec_Of_Rec_Of_MyArr is
+              record
+                 C1 : VRec_Of_MyArr_01(1);    -- No Constraint_Error raised.
+              end record;                    
+         begin
+            declare
+               Obj_6 : Rec_Of_Rec_Of_MyArr;   -- Constraint_Error raised.
+            begin
+               Report.Failed ("Obj_6 - Constraint_Error should be raised");
+               if Obj_6 /= (C1 => (1, (1, 1))) then
+                  Report.Comment ("Obj_6 - Shouldn't get here");
+               end if;
+            end;
+
+         exception
+            when Constraint_Error =>         -- Exception expected.
+                null;
+            when others =>
+                Report.Failed ("Obj_6 - unexpected exception raised");
+         end;
+
+      exception
+         when Constraint_Error =>
+              Report.Failed ("Rec_Of_Rec_Of_MyArr - Constraint_Error raised");
+         when others =>
+              Report.Failed ("Rec_Of_Rec_Of_MyArr - unexpected exception " &
+                             "raised");
+      end;
+
+      ---------------------------------------------------------
+      -- Component containing the constraint is absent.
+      begin
+         declare
+            type New_VRec_Arr is 
+              new VRec_Of_MyArr_01(11);       -- No Constraint_Error raised
+            Obj_7 : New_VRec_Arr;             -- for either declaration.
+
+         begin
+            if Obj_7 /= (11, 0) then
+               Report.Failed ("Obj_7 - value incorrect");
+            end if;
+         end;
+
+      exception
+         when others =>
+              Report.Failed ("New_VRec_Arr - unexpected exception raised");
+      end;
+
+      ---------------------------------------------------------
+      -- Component containing the constraint is present.
+      begin
+         declare
+            type New_VRec is new
+              VRec_Of_VRec_02(Report.Ident_Int(0)); -- No Constraint_Error 
+                                                    -- raised.
+         begin
+            declare
+                VObj_8 : New_VRec;                  -- Constraint_Error raised.
+            begin
+               Report.Failed ("VObj_8 - Constraint_Error should be raised");
+               if VObj_8 /= (1, (1, 1, others => (others => '*'))) then
+                  Report.Comment ("VObj_8 - Shouldn't get here");
+               end if;
+            end;
+
+         exception
+            when Constraint_Error =>               -- Exception expected.
+                null;
+            when others =>
+                Report.Failed ("VObj_8 - unexpected exception raised");
+         end;
+
+      exception                                    
+         when Constraint_Error =>
+              Report.Failed ("New_VRec - Constraint_Error raised");
+         when others =>
+              Report.Failed ("New_VRec - unexpected exception raised");
+      end;
+
+      ---------------------------------------------------------
+      -- Component containing the constraint is absent.
+      begin
+         declare
+            subtype Sub_VRec is
+              VRec_Of_VRec_02(Report.Ident_Int(11)); -- No Constraint_Error 
+            VObj_9 : Sub_VRec;                       -- raised for either
+                                                     -- declaration.
+         begin
+            if VObj_9 /= (11, 0) then
+               Report.Comment ("VObj_9 - wrong values");
+            end if;
+         end;
+
+      exception                                    
+         when others =>
+              Report.Failed ("Sub_VRec - unexpected exception raised");
+      end;
+
+      ---------------------------------------------------------
+      -- Component containing the constraint is present.
+      begin
+         declare
+            type Acc_VRec_01 is access 
+              VRec_Of_VRec_02(Report.Ident_Int(0));  -- No Constraint_Error 
+                                                     -- raised.
+         begin
+            declare
+               VObj_10 : Acc_VRec_01;                -- No Constraint_Error 
+                                                     -- raised.
+            begin
+               VObj_10 := new VRec_Of_VRec_02
+                            (Report.Ident_Int(0));   -- Constraint_Error
+                                                     -- raised.
+               Report.Failed ("VObj_10 - Constraint_Error should be raised");
+               if VObj_10.all /= (1, (1, 1, others => (others => '*'))) then
+                  Report.Comment ("VObj_10 - Shouldn't get here");
+               end if;
+     
+            exception
+               when Constraint_Error =>              -- Exception expected.
+                   null;
+               when others =>
+                   Report.Failed ("VObj_10 - unexpected exception raised");
+            end;
+
+         exception
+            when Constraint_Error =>
+                Report.Failed ("VObj_10 - Constraint_Error exception raised");
+            when others =>
+                Report.Failed ("VObj_10 - unexpected exception raised at " &
+                               "declaration");
+         end;
+
+      exception
+         when Constraint_Error =>
+              Report.Failed ("Acc_VRec_01 - Constraint_Error raised");
+         when others =>
+              Report.Failed ("Acc_VRec_01 - unexpected exception raised");
+      end;
+
+      ---------------------------------------------------------
+      -- Component containing the constraint is absent.
+      begin
+         declare
+            type Acc_VRec_02 is access 
+              VRec_Of_VRec_02(11);                  -- No Constraint_Error 
+                                                    -- raised for either
+            VObj_11 :  Acc_VRec_02;                 -- declaration.
+
+         begin
+            VObj_11 := new VRec_Of_VRec_02(11);
+            if VObj_11.all /= (11, 0) then
+               Report.Comment ("VObj_11 - wrong values");
+            end if;
+         end;
+
+      exception
+         when others =>
+              Report.Failed ("Acc_VRec_02 - unexpected exception raised");
+      end;
+
+      ---------------------------------------------------------
+      -- Component containing the constraint is present.
+      begin
+         declare
+            type Acc_VRec_03 is access 
+              VRec_Of_MyArr_02;                    -- No Constraint_Error 
+                                                   -- raised for either
+            VObj_12 : Acc_VRec_03;                 -- declaration.
+         begin
+            VObj_12 := new VRec_Of_MyArr_02
+                           (Report.Ident_Int(0)); -- Constraint_Error raised.
+
+            Report.Failed ("VObj_12 - Constraint_Error should be raised");
+            if VObj_12.all /= (1, (1, 1)) then
+               Report.Comment ("VObj_12 - Shouldn't get here");
+            end if;
+       
+         exception
+            when Constraint_Error =>              -- Exception expected.
+                null;
+            when others =>
+                Report.Failed ("VObj_12 - unexpected exception raised");
+         end;
+
+      exception
+         when Constraint_Error =>
+              Report.Failed ("Acc_VRec_03 - Constraint_Error raised");
+         when others =>
+              Report.Failed ("Acc_VRec_03 - unexpected exception raised");
+      end;
+
+      ---------------------------------------------------------
+      -- Component containing the constraint is absent.
+      begin
+         declare
+            type Acc_VRec_04 is access 
+              VRec_Of_MyArr_02(11);                 -- No Constraint_Error 
+                                                    -- raised for either
+            VObj_13 :  Acc_VRec_04;                 -- declaration.
+                    
+         begin
+            VObj_13 := new VRec_Of_MyArr_02(11);
+            if VObj_13.all /= (11, 0) then
+               Report.Comment ("VObj_13 - wrong values");
+            end if;
+         end;
+
+      exception
+         when others =>
+              Report.Failed ("Acc_VRec_04 - unexpected exception raised");
+      end;
+
+   end;
+
+   Report.Result;
+
+exception
+     when others =>
+          Report.Failed ("Discriminant value checked too soon");
+          Report.Result;
+
+end C371003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37102b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37102b.ada
new file mode 100644
index 000000000..13c4e5c9c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37102b.ada
@@ -0,0 +1,109 @@
+-- C37102B.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 A RECORD TYPE, THE IDENTIFIER FOR A DISCRIMINANT 
+-- CAN BE USED AS A SELECTED COMPONENT IN AN INDEX OR DISCRIMINANT 
+-- CONSTRAINT, AS THE NAME OF A DISCRIMINANT IN A DISCRIMINANT 
+-- SPECIFICATION, AND AS THE PARAMETER NAME IN A FUNCTION CALL IN A 
+-- DISCRIMINANT OR INDEX CONSTRAINT.
+
+-- R.WILLIAMS 8/25/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37102B IS
+     
+BEGIN
+     TEST ( "C37102B", "CHECK THAT, FOR A RECORD TYPE, THE " &
+                       "IDENTIFIER FOR A DISCRIMINANT CAN BE USED " &
+                       "AS A SELECTED COMPONENT IN AN INDEX OR " &
+                       "DISCRIMINANT CONSTRAINT, AS THE NAME OF A " &
+                       "DISCRIMINANT IN A DISCRIMINANT " &
+                       "SPECIFICATION, AND AS THE PARAMETER NAME " &
+                       "IN A FUNCTION CALL IN A DISCRIMINANT OR " &
+                       "INDEX CONSTRAINT" );
+
+     DECLARE
+
+          FUNCTION F (D : INTEGER) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (D);
+          END F;
+
+          PACKAGE P IS
+
+               TYPE D IS NEW INTEGER;
+          
+               TYPE REC1 IS
+                    RECORD
+                         D : INTEGER := IDENT_INT (1);
+                    END RECORD;
+
+               G : REC1;
+
+               TYPE REC2 (D : INTEGER := 3) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               H : REC2 (IDENT_INT (5));
+
+               TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+
+               TYPE Q (D : INTEGER := 0) IS
+                    RECORD
+                         J : REC2 (D => H.D);
+                         K : ARR (G.D .. F (D => 5));
+                         L : REC2 (F (D => 4));
+                    END RECORD;
+               
+          END P;
+
+          USE P;
+
+     BEGIN
+          DECLARE
+               R : Q;
+          
+          BEGIN
+               IF R.J.D /= 5 THEN
+                    FAILED ( "INCORRECT VALUE FOR R.J" );
+               END IF;
+               
+               IF R.K'FIRST /= 1 THEN
+                    FAILED ( "INCORRECT VALUE FOR R.K'FIRST" );
+               END IF;
+
+               IF R.K'LAST /= 5 THEN
+                    FAILED ( "INCORRECT VALUE FOR R.K'LAST" );
+               END IF;
+
+               IF R.L.D /= 4 THEN
+                    FAILED ( "INCORRECT VALUE FOR R.L" );
+               END IF;
+          END;
+        
+     END;
+
+     RESULT;
+END C37102B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37103a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37103a.ada
new file mode 100644
index 000000000..10878357f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37103a.ada
@@ -0,0 +1,83 @@
+-- C37103A.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 DISCRIMINANTS MAY BE BOOLEAN, CHARACTER, USER_ENUM,
+-- INTEGER, DERIVED CHARACTER, DERIVED USER_ENUM, DERIVED INTEGER,
+-- AND DERIVED DERIVED USER_ENUM.
+
+-- DAT 5/18/81
+-- SPS 10/25/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C37103A IS
+BEGIN
+     TEST ("C37103A", "MANY DIFFERENT DISCRIMINANT TYPES");
+     DECLARE
+          PACKAGE P1 IS
+               TYPE ENUM IS (A, Z, Q, 'W', 'A');
+          END P1;
+
+          PACKAGE P2 IS
+               TYPE E2 IS NEW P1.ENUM;
+          END P2;
+
+          PACKAGE P3 IS
+               TYPE E3 IS NEW P2.E2;
+          END P3;
+
+          USE P1, P2, P3;
+          TYPE INT IS NEW INTEGER RANGE -3 .. 7;
+          TYPE CHAR IS NEW CHARACTER;
+          TYPE R1 (D : ENUM) IS RECORD NULL; END RECORD;
+          TYPE R2 (D : INTEGER) IS RECORD NULL; END RECORD;
+          TYPE R3 (D : BOOLEAN) IS RECORD NULL; END RECORD;
+          TYPE R4 (D : CHARACTER) IS RECORD NULL; END RECORD;
+          TYPE R5 (D : CHAR) IS RECORD NULL; END RECORD;
+          TYPE R6 (D : E2) IS RECORD NULL; END RECORD;
+          TYPE R7 (D : E3) IS RECORD NULL; END RECORD;
+          TYPE R8 (D : INT) IS RECORD NULL; END RECORD;
+          O1 : R1(A) := (D => A);
+          O2 : R2(3) := (D => 3);
+          O3 : R3(TRUE) := (D => TRUE);
+          O4 : R4(ASCII.NUL) := (D => ASCII.NUL);
+          O5 : R5('A') := (D => 'A');
+          O6 : R6('A') := (D => 'A');
+          O7 : R7(A) := (D => A);
+          O8 : R8(2) := (D => 2);
+     BEGIN
+          IF O1.D /= A
+          OR O2.D /= 3
+          OR NOT O3.D
+          OR O4.D IN 'A' .. 'Z'
+          OR O5.D /= 'A'
+          OR O6.D /= 'A'
+          OR O7.D /= A
+          OR O8.D /= 2
+          THEN FAILED ("WRONG DISCRIMINANT VALUE");
+          END IF;
+     END;
+
+     RESULT;
+END C37103A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37105a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37105a.ada
new file mode 100644
index 000000000..b8f836e73
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37105a.ada
@@ -0,0 +1,55 @@
+-- C37105A.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 RECORDS WITH ONLY DISCRIMINANTS ARE OK.
+
+-- DAT 5/18/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C37105A IS
+BEGIN
+     TEST ("C37105A", "RECORDS WITH ONLY DISCRIMINANTS");
+
+     DECLARE
+          TYPE R1 (D : BOOLEAN) IS RECORD
+               NULL; END RECORD;
+          TYPE R2 (D, E : BOOLEAN) IS RECORD
+               NULL; END RECORD;
+          TYPE R3 (A,B,C,D : INTEGER; W,X,Y,Z : CHARACTER) IS
+               RECORD NULL; END RECORD;
+          OBJ1 : R1 (IDENT_BOOL(TRUE));
+          OBJ2 : R2 (IDENT_BOOL(FALSE), IDENT_BOOL(TRUE));
+          OBJ3 : R3 (1,2,3,4,'A','B','C',IDENT_CHAR('D'));
+     BEGIN
+          IF OBJ1 = (D => (FALSE))
+          OR OBJ2 /= (FALSE, (TRUE))
+          OR OBJ3 /= (1,2,3,4,'A','B','C',('D'))
+          THEN FAILED ("DISCRIMINANT-ONLY RECORDS DON'T WORK");
+          END IF;
+     END;
+
+     RESULT;
+END C37105A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37107a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37107a.ada
new file mode 100644
index 000000000..a007f7c31
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37107a.ada
@@ -0,0 +1,154 @@
+-- C37107A.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 DEFAULT DISCRIMINANT EXPRESSION NEED NOT BE STATIC AND
+-- IS EVALUATED ONLY WHEN NEEDED.
+
+-- R.WILLIAMS 8/25/86
+-- GMT        6/29/87  ADDED INTEGER ARGUMENT TO THE FUNCTION F.
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37107A IS
+
+     FUNCTION  F (  B : BOOLEAN;
+                    I : INTEGER  ) RETURN INTEGER IS
+     BEGIN
+          IF NOT B THEN
+               FAILED ( "DEFAULT DISCRIMINANT EVALUATED " &
+                        "UNNECESSARILY - "                &
+                        INTEGER'IMAGE(I)  );
+          END IF;
+
+          RETURN IDENT_INT (1);
+     END F;
+
+BEGIN
+     TEST ( "C37107A", "CHECK THAT A DEFAULT DISCRIMINANT " &
+                       "EXPRESSION NEED NOT BE STATIC AND IS " &
+                       "EVALUATED ONLY WHEN NEEDED" );
+
+     DECLARE
+          TYPE REC1 (  D : INTEGER := F (TRUE,1)  ) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          R1 : REC1;
+
+          TYPE REC2 (  D : INTEGER := F (FALSE,2)  ) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          R2 : REC2 (D => 0);
+
+     BEGIN
+          IF R1.D /= 1 THEN
+               FAILED ( "INCORRECT VALUE FOR R1.D" );
+          END IF;
+
+          IF R2.D /= 0 THEN
+               FAILED ( "INCORRECT VALUE FOR R2.D" );
+          END IF;
+     END;
+
+     DECLARE
+
+          PACKAGE PRIV IS
+               TYPE REC3 (  D : INTEGER := F (TRUE,3)  ) IS PRIVATE;
+               TYPE REC4 (  D : INTEGER := F (FALSE,4) ) IS PRIVATE;
+
+          PRIVATE
+               TYPE REC3 (  D : INTEGER := F (TRUE,3)  ) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               TYPE REC4 (  D : INTEGER := F (FALSE,4)  ) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END PRIV;
+
+          USE PRIV;
+
+     BEGIN
+          DECLARE
+               R3 : REC3;
+               R4 : REC4 (D => 0);
+
+          BEGIN
+               IF R3.D /= 1 THEN
+                    FAILED ( "INCORRECT VALUE FOR R3.D" );
+               END IF;
+
+               IF R4.D /= 0 THEN
+                    FAILED ( "INCORRECT VALUE FOR R4.D" );
+               END IF;
+          END;
+
+     END;
+
+     DECLARE
+
+          PACKAGE LPRIV IS
+               TYPE  REC5
+                     (  D : INTEGER := F (TRUE,5)  ) IS LIMITED PRIVATE;
+               TYPE  REC6
+                     (  D : INTEGER := F (FALSE,6) ) IS LIMITED PRIVATE;
+
+          PRIVATE
+               TYPE REC5 (  D : INTEGER := F (TRUE,5)  ) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               TYPE REC6 (  D : INTEGER := F (FALSE,6) ) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END LPRIV;
+
+          USE LPRIV;
+
+     BEGIN
+          DECLARE
+               R5 : REC5;
+               R6 : REC6 (D => 0);
+
+          BEGIN
+               IF R5.D /= 1 THEN
+                    FAILED ( "INCORRECT VALUE FOR R5.D" );
+               END IF;
+
+               IF R6.D /= 0 THEN
+                    FAILED ( "INCORRECT VALUE FOR R6.D" );
+               END IF;
+          END;
+
+     END;
+
+     RESULT;
+END C37107A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37108b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37108b.ada
new file mode 100644
index 000000000..9d71e9a72
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37108b.ada
@@ -0,0 +1,247 @@
+-- C37108B.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 IN AN OBJECT DECLARATION IF
+-- A DEFAULT INITIAL VALUE HAS BEEN SPECIFIED WHICH VIOLATES THE 
+-- CONSTRAINTS OF A RECORD OR AN ARRAY TYPE WHOSE CONSTRAINT
+-- DEPENDS ON A DISCRIMINANT, AND NO EXPLICIT INITIALIZATION IS
+-- PROVIDED FOR THE OBJECT.
+
+-- R.WILLIAMS 8/25/86
+-- EDS        7/16/98    AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37108B IS
+     
+     TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+
+     TYPE R (P : POSITIVE) IS
+          RECORD
+               NULL;
+          END RECORD;
+     
+BEGIN
+     TEST ( "C37108B", "CHECK THAT CONSTRAINT_ERROR IS RAISED IN " &
+                       "AN OBJECT DECLARATION IF A DEFAULT INITIAL " &
+                       "VALUE HAS BEEN SPECIFIED WHICH VIOLATES THE " &
+                       "CONSTRAINTS OF A RECORD OR AN ARRAY TYPE " &
+                       "WHOSE CONSTRAINT DEPENDS ON A DISCRIMINANT, " &
+                       "AND NO EXPLICIT INITIALIZATION IS PROVIDED " &
+                       "FOR THE OBJECT" );
+
+
+     BEGIN
+          DECLARE     
+               TYPE REC1 (D : NATURAL := IDENT_INT (0)) IS
+                    RECORD
+                         A : ARR (D .. 5);
+                    END RECORD;
+               
+          BEGIN
+               DECLARE 
+                    R1 : REC1;
+                    
+               BEGIN
+                    R1.A (1) := IDENT_INT (2);
+                    FAILED ( "NO EXCEPTION RAISED AT DECLARATION OF " &
+                             "R1" & INTEGER'IMAGE(R1.A(5)));  --USE R2
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION FOR R1 RAISED INSIDE " &
+                                  "BLOCK" );
+               END;
+     
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF R1" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
+                        "DECLARATION OF REC1" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
+                        "DECLARATION OF REC1" );
+     END;
+     
+     BEGIN
+          DECLARE     
+               TYPE REC2 (D : INTEGER := IDENT_INT (-1)) IS
+                    RECORD
+                         A : R (P => D);
+                    END RECORD;
+               
+          BEGIN
+               DECLARE 
+                    R2 : REC2;
+                    
+               BEGIN
+                    R2.A := R'(P => IDENT_INT (1));
+                    FAILED ( "NO EXCEPTION RAISED AT DECLARATION OF " &
+                             "R2" & INTEGER'IMAGE(R2.A.P));  --USE R2
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION FOR R2 RAISED INSIDE " &
+                                  "BLOCK" );
+               END;
+     
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF R2" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
+                        "DECLARATION OF REC2" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
+                        "DECLARATION OF REC2" );
+     END;
+
+     BEGIN
+          DECLARE     
+               PACKAGE PRIV IS
+                    TYPE REC3 (D : INTEGER := IDENT_INT (-1)) IS 
+                         PRIVATE;
+                    PROCEDURE PROC (R :REC3);
+                         
+               PRIVATE
+                    TYPE REC3 (D : INTEGER := IDENT_INT (-1)) IS
+                         RECORD
+                              A : R (P => D);
+                         END RECORD;
+               END PRIV;
+               
+               PACKAGE BODY PRIV IS
+                    PROCEDURE PROC (R : REC3) IS
+                         I : INTEGER;
+                    BEGIN
+                         I := IDENT_INT (R.A.P);
+                         IF EQUAL(2, IDENT_INT(1)) THEN
+                              FAILED("IMPOSSIBLE " & INTEGER'IMAGE(I));  --USE I
+                         END IF;
+                    END PROC;
+               END PRIV;
+
+               USE PRIV;
+               
+          BEGIN
+               DECLARE 
+                    R3 : REC3;
+                    
+               BEGIN
+                    PROC (R3);
+                    FAILED ( "NO EXCEPTION RAISED AT " &
+                              "DECLARATION OF R3" );
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION FOR R3 RAISED INSIDE " &
+                                  "BLOCK" );
+               END;
+     
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF R3" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
+                        "DECLARATION OF REC3" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
+                        "DECLARATION OF REC3" );
+     END;
+
+     BEGIN
+          DECLARE     
+               PACKAGE LPRIV IS
+                    TYPE REC4 (D : NATURAL := IDENT_INT (0))
+                         IS LIMITED PRIVATE;
+                    PROCEDURE PROC (R :REC4);
+                         
+               PRIVATE
+                    TYPE REC4 (D : NATURAL := IDENT_INT (0)) IS
+                         RECORD
+                              A : ARR (D .. 5);
+                         END RECORD;
+               END LPRIV;
+               
+               PACKAGE BODY LPRIV IS
+                    PROCEDURE PROC (R : REC4) IS
+                         I : INTEGER;
+                    BEGIN
+                         I := IDENT_INT (R.A'FIRST);
+                         IF EQUAL(2, IDENT_INT(1)) THEN
+                              FAILED("IMPOSSIBLE " & INTEGER'IMAGE(I));  --USE I
+                         END IF;
+                    END PROC;
+               END LPRIV;
+
+               USE LPRIV;
+               
+          BEGIN
+               DECLARE 
+                    R4 : REC4;
+                    
+               BEGIN
+                    PROC (R4);
+                    FAILED ( "NO EXCEPTION RAISED AT " &
+                             "DECLARATION OF R4" );
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION FOR R4 RAISED INSIDE " &
+                                  "BLOCK" );
+               END;
+     
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF R4" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
+                        "DECLARATION OF REC4" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
+                        "DECLARATION OF REC4" );
+     END;
+
+     RESULT;
+END C37108B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37206a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37206a.ada
new file mode 100644
index 000000000..d37c794cb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37206a.ada
@@ -0,0 +1,65 @@
+-- C37206A.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:
+--     FOR A TYPE WITHOUT DEFAULT DISCRIMINANT VALUES (BUT WITH
+--     DISCRIMINANTS) CHECK THAT A TYPEMARK WHICH DENOTES SUCH AN
+--     UNCONSTRAINED TYPE CAN BE USED IN:
+
+--      1) A SUBTYPE DECLARATION, AND THE SUBTYPE NAME ACTS SIMPLY AS A
+--         NEW NAME FOR THE UNCONSTRAINED TYPE;
+--      2) IN A CONSTANT DECLARATION.
+
+-- HISTORY:
+--     AH  08/21/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+--     DTN 11/13/91 DELETED SUBPARTS (2 and 3).
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37206A IS
+BEGIN
+
+     TEST ("C37206A", "FOR TYPE WITH DEFAULT-LESS DISCRIMINANTS, " &
+           "UNCONSTRAINED TYPE_MARK CAN BE USED IN A SUBTYPE " &
+           "DECLARATION OR IN A CONSTANT DECLARATION");
+
+     DECLARE
+          TYPE REC(DISC : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          SUBTYPE ST IS REC;                               -- 1.
+
+          C1 : CONSTANT REC := (DISC => 5);                -- 2.
+          C2 : CONSTANT REC := (DISC => IDENT_INT(5));     -- 2.
+     BEGIN
+
+          IF C1 /= C2 OR C1 /= (DISC => 5) THEN
+               FAILED ("CONSTANT DECLARATIONS INCORRECT");
+          END IF;
+     END;
+
+     RESULT;
+END C37206A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37207a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37207a.ada
new file mode 100644
index 000000000..e02724088
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37207a.ada
@@ -0,0 +1,230 @@
+-- C37207A.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:
+
+--     FOR A TYPE WITH OR WITHOUT DEFAULT DISCRIMINANT VALUES, CHECK
+--     THAT A DISCRIMINANT CONSTRAINT CAN BE SUPPLIED IN THE FOLLOWING
+--     CONTEXTS AND HAS THE PROPER EFFECT:
+
+--     IN A 1) OBJECT_DECLARATION, 2) COMPONENT_DECLARATION OR
+--     3) SUBTYPE INDICATION OF AN ARRAY_TYPE_DEFINITION, AND HENCE,
+--     ASSIGNMENTS CANNOT ATTEMPT TO CHANGE THE SPECIFIED DISCRIMINANT
+--     VALUES WITHOUT RAISING CONSTRAINT_ERROR
+
+--     4) IN AN ACCESS_TYPE_DEFINITION, AND HENCE, ACCESS VALUES
+--     OF THIS ACCESS TYPE CANNOT BE ASSIGNED NON-NULL VALUES
+--     DESIGNATING OBJECTS WITH DIFFERENT DISCRIMINANT VALUES.
+
+--     5) IN AN ALLOCATOR, AND THE ALLOCATED OBJECT HAS THE SPECIFIED
+--     DISCRIMINANT VALUES.
+
+--     6) IN A FORMAL PARAMETER DECLARATION OF A SUBPROGRAM, AND
+--     HENCE, ASSIGNMENTS TO THE FORMAL PARAMETER CANNOT ATTEMPT TO
+--     CHANGE THE DISCRIMINANT VALUES WITHOUT RAISING CONSTRAINT_ERROR,
+--     CONSTRAINED IS TRUE, AND IF ACTUAL PARAMETERS HAVE DISCRIMINANT
+--     VALUES DIFFERENT FROM THE SPECIFIED ONES, CONSTRAINT_ERROR IS
+--     RAISED.
+
+-- HISTORY:
+
+--     ASL 07/24/81
+--     RJW 08/28/86  CORRECTED SYNTAX ERRORS.
+--     JLH 08/07/87  ADDED CODE TO PREVENT DEAD VARIABLE OPTIMIZATION.
+--     EDS 07/16/98  AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37207A IS
+
+BEGIN
+     TEST ("C37207A","DISCRIMINANT CONSTRAINT CAN BE SUPPLIED TO " &
+          "DECLARATIONS AND DEFINITIONS USING TYPES WITH OR WITHOUT " &
+          "DEFAULT DISCRIMINANT VALUES");
+
+     DECLARE
+          TYPE REC1 (DISC : INTEGER := 5) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE REC2 (DISC : INTEGER) IS
+               RECORD
+                    NULL;
+                END RECORD;
+
+          OBJ1 : REC1(6);                     -- 1.
+          OBJ2 : REC2(6);                     -- 1.
+          BADOBJ1 : REC1(7);                  -- 1.
+          BADOBJ2 : REC2(7);                  -- 1.
+
+          TYPE REC3 IS
+               RECORD
+                    COMP1 : REC1(6);          -- 2.
+                    COMP2 : REC2(6);          -- 2.
+               END RECORD;
+
+          OBJ3 : REC3;
+
+          TYPE ARR1 IS ARRAY (1..10) OF REC1(6);  -- 3.
+          TYPE ARR2 IS ARRAY (1..10) OF REC2(6);  -- 3.
+
+          A1 : ARR1;
+          A2 : ARR2;
+
+          TYPE REC1_NAME IS ACCESS REC1(6);   -- 4.
+          TYPE REC2_NAME IS ACCESS REC2(6);   -- 4.
+
+          ACC1 : REC1_NAME;
+          ACC2 : REC2_NAME;
+
+          SUBTYPE REC16 IS REC1(6);
+          SUBTYPE REC26 IS REC2(6);
+
+          PROCEDURE PROC (P1 : IN OUT REC16;     -- 6.
+                         P2 : IN OUT REC26) IS  -- 6.
+          BEGIN
+               IF NOT (P1'CONSTRAINED AND P2'CONSTRAINED) THEN  -- 6.
+                    FAILED ("'CONSTRAINED ATTRIBUTE INCORRECT FOR " &
+                            "CONSTRAINED FORMAL PARAMETERS");
+               END IF;
+               BEGIN
+                    P1 := (DISC => 7);         -- 6.
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                            "ATTEMPT TO CHANGE DISCRIMINANT OF " &
+                            "CONSTRAINED FORMAL PARAMETER " &                                                                                  
+                            INTEGER'IMAGE(P1.DISC));
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR => NULL;
+                    WHEN OTHERS => FAILED ("WRONG EXCEPTION     (1)");
+               END;
+               BEGIN
+                    P2 := (DISC => 7);         -- 6.
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                            "ATTEMPT TO CHANGE DISCRIMINANT OF " &
+                            "CONSTRAINED FORMAL PARAMETER " & 
+                            INTEGER'IMAGE(P2.DISC));
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR => NULL;
+                    WHEN OTHERS => FAILED ("WRONG EXCEPTION     (2)");
+               END;
+          END PROC;
+     BEGIN
+---------------------------------------------------------------
+
+          BEGIN
+               OBJ1 := (DISC => IDENT_INT(7));           -- 1.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                       "ATTEMPT TO CHANGE DISCRIMINANT OF " &
+                       "CONSTRAINED OBJECT");
+               IF OBJ1 = (DISC => 7) THEN
+                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED ("WRONG EXCEPTION     (3)");
+          END;
+
+---------------------------------------------------------------
+
+          BEGIN
+               OBJ3 := ((DISC => IDENT_INT(7)),      -- 2.
+                        (DISC => IDENT_INT(7)));     -- 2.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                       "ATTEMPT TO CHANGE DISCRIMINANT OF " &
+                       "CONSTRAINED RECORD COMPONENT");
+               IF OBJ3 = ((DISC => 7), (DISC => 7)) THEN
+                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED ("WRONG EXCEPTION     (4)");
+          END;
+
+--------------------------------------------------------------
+
+          BEGIN
+               A2(2) := (DISC => IDENT_INT(7));          -- 3.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                       "ATTEMPT TO CHANGE DISCRIMINANT OF " &
+                       "CONSTRAINED ARRAY COMPONENT");
+               IF A2(2) = (DISC => 7) THEN
+                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED ("WRONG EXCEPTION     (5)");
+          END;
+
+--------------------------------------------------------------
+
+          BEGIN
+               ACC1 := NEW REC1(DISC => IDENT_INT(7));   -- 4.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                       "ATTEMPT TO ASSIGN INCOMPATIBLE OBJECT " &
+                       "TO ACCESS VARIABLE");
+               IF ACC1 =  NEW REC1(DISC => 7) THEN
+                    COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
+               END IF;
+         EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED ("WRONG EXCEPTION     (6)");
+          END;
+
+----------------------------------------------------------------
+
+               ACC1 := NEW REC1(DISC => IDENT_INT(6));  -- OK.
+
+          BEGIN
+               ACC1.ALL := BADOBJ1;           -- 5.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                       "ATTEMPT TO ASSIGN INCOMPATIBLE OBJECT " &
+                       "TO ACCESSED OBJECT");
+               IF ACC1.ALL = BADOBJ1 THEN
+                    COMMENT ("PREVENT DEAD VARIABLE OPTIMIZATION");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED ("WRONG EXCEPTION     (7)");
+          END;
+
+-----------------------------------------------------------------
+
+               PROC (OBJ1,OBJ2);              -- OK.
+
+          BEGIN
+               PROC (BADOBJ1,BADOBJ2);        -- 6.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED UPON " &
+                       "PASSING OF CONSTRAINED ACTUAL " &
+                       "PARAMETERS TO DIFFERENTLY CONSTRAINED " &
+                       "FORMAL PARAMETERS");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED ("WRONG EXCEPTION     (8)");
+          END;
+
+---------------------------------------------------------------
+     END;
+
+     RESULT;
+END C37207A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37208a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37208a.ada
new file mode 100644
index 000000000..a83b7ef19
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37208a.ada
@@ -0,0 +1,172 @@
+-- C37208A.ADA     (RA #534/1)
+
+--                             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 A TYPE WITH DEFAULT DISCRIMINANT VALUES, CHECK THAT A
+-- DISCRIMINANT CONSTRAINT CAN BE OMITTED IN:
+ 
+     -- AN OBJECT DECLARATION, AND HENCE ASSIGNMENTS TO THE OBJECT CAN 
+     -- CHANGE ITS DISCRIMINANTS;
+ 
+     -- A COMPONENT_DECLARATION IN A RECORD TYPE DEFINITION, AND HENCE
+     -- ASSIGNMENTS TO THE COMPONENT CAN CHANGE THE VALUE OF ITS
+     -- DISCRIMINANTS;
+ 
+     -- A SUBTYPE INDICATION IN AN ARRAY TYPE DEFINITION, AND HENCE
+     -- ASSIGNMENTS TO ONE OF THE COMPONENTS CAN CHANGE ITS 
+     -- DISCRIMINANT VALUES;
+ 
+     -- A FORMAL PARAMETER OF A SUBPROGRAM; EXCEPT FOR PARAMETERS OF
+     -- MODE IN, THE 'CONSTRAINED ATTRIBUTE OF THE ACTUAL PARAMETER
+     -- BECOMES THE 'CONSTRAINED ATTRIBUTE OF THE FORMAL PARAMETER;
+     -- FOR IN OUT AND OUT PARAMETERS, IF THE 'CONSTRAINED ATTRIBUTE IS 
+     -- FALSE, ASSIGNMENTS TO THE FORMAL PARAMETER CAN CHANGE THE 
+     -- DISCRIMINANTS OF THE ACTUAL PARAMETER; IF THE 'CONSTRAINED 
+     -- ATTRIBUTE IS TRUE, ASSIGNNMENTS THAT ATTEMPT TO CHANGE THE 
+     -- DISCRIMINANTS OF THE ACTUAL PARAMETER RAISE CONSTRAINT_ERROR.
+ 
+-- ASL 7/23/81
+-- EDS 7/16/98    AVOID OPTIMIZATION
+ 
+WITH REPORT;
+PROCEDURE C37208A IS
+ 
+     USE REPORT;
+ 
+BEGIN
+     TEST ("C37208A","DISCRIMINANT CONSTRAINT CAN BE OMITTED " &
+           "FROM OBJECT DECLARATION, COMPONENT DECLARATION, SUBTYPE " &
+           "INDICATION OR FORMAL SUBPROGRAM PARAMETER, IF THE TYPE " &
+           "HAS DEFAULT DISCRIMINANTS");
+ 
+     DECLARE
+          TYPE REC1(DISC : INTEGER := 7) IS
+               RECORD
+                    NULL;
+               END RECORD;
+ 
+          TYPE REC2 IS
+               RECORD
+                    COMP : REC1;
+               END RECORD;
+ 
+          R : REC2;
+          U1,U2,U3 : REC1 := (DISC => 3);
+          C1,C2,C3 : REC1(3) := (DISC => 3);
+          ARR : ARRAY(INTEGER RANGE 1..10) OF REC1;
+          ARR2 : ARRAY (1..10) OF REC1(4);
+ 
+          PROCEDURE PROC(P_IN : IN REC1;
+                         P_OUT : OUT REC1;
+                         P_IN_OUT : IN OUT REC1;
+                         CONSTR : IN BOOLEAN) IS
+          BEGIN
+               IF P_OUT'CONSTRAINED /= CONSTR
+                    OR P_IN_OUT'CONSTRAINED /= CONSTR THEN
+                    FAILED ("CONSTRAINED ATTRIBUTES DO NOT MATCH " &
+                              "FOR ACTUAL AND FORMAL PARAMETERS");
+               END IF;
+
+               IF P_IN'CONSTRAINED /= IDENT_BOOL(TRUE) THEN
+                    FAILED ("'CONSTRAINED IS FALSE FOR IN " &
+                            "PARAMETER");
+               END IF;
+ 
+               IF NOT CONSTR THEN     -- UNCONSTRAINED ACTUAL PARAM
+                    P_OUT := (DISC => IDENT_INT(0));
+                    P_IN_OUT := (DISC => IDENT_INT(0));
+               ELSE
+                    BEGIN
+                         P_OUT := (DISC => IDENT_INT(0));
+                         FAILED ("DISCRIMINANT OF CONSTRAINED ACTUAL " &
+                                 "PARAMETER ILLEGALLY CHANGED - 1");
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION - 1");
+                    END;
+
+                    BEGIN
+                         P_IN_OUT := (DISC => IDENT_INT(0));
+                         FAILED ("DISCRIMINANT OF CONSTRAINED ACTUAL " &
+                                 "PARAMETER ILLEGALLY CHANGED - 2");
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR => NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION - 2");
+                    END;
+               END IF;
+          END PROC;
+     BEGIN
+          IF U1.DISC /= IDENT_INT(3) THEN
+               FAILED ("INITIAL DISCRIMINANT VALUE WRONG - U1");
+          END IF;
+
+          U1 := (DISC => IDENT_INT(5));
+          IF U1.DISC /= 5 THEN
+               FAILED ("ASSIGNMENT FAILED FOR OBJECT");
+          END IF;
+ 
+          IF R.COMP.DISC /= IDENT_INT(7) THEN
+               FAILED ("DEFAULT DISCRIMINANT VALUE WRONG - R");
+          END IF;
+
+          R.COMP := (DISC => IDENT_INT(5));
+          IF R.COMP.DISC /= 5 THEN
+               FAILED ("ASSIGNMENT FAILED FOR RECORD COMPONENT");
+          END IF;
+ 
+          FOR I IN 1..10 LOOP
+               IF ARR(I).DISC /= IDENT_INT(7) THEN
+                    FAILED ("DEFAULT DISCRIMINANT VALUE WRONG - ARR");
+               END IF;
+          END LOOP;
+
+          ARR(3) := (DISC => IDENT_INT(5));
+          IF ARR(3).DISC /= 5 THEN
+               FAILED ("ASSIGNMENT FAILED FOR ARRAY COMPONENT");
+          END IF;
+ 
+          IF ARR /= (1..2|4..10 => (DISC => 7), 3 => (DISC => 5)) THEN
+               FAILED ("MODIFIED WRONG COMPONENTS");
+          END IF;
+
+          PROC(C1,C2,C3,IDENT_BOOL(TRUE));
+          PROC(U1,U2,U3,IDENT_BOOL(FALSE));
+          IF U2.DISC /= 0 OR U3.DISC /= 0 THEN
+               FAILED ("ASSIGNMENT TO UNCONSTRAINED ACTUAL PARAMETER " &
+                       "FAILED TO CHANGE DISCRIMINANT");
+          END IF;
+
+          PROC(ARR(1), ARR(3), ARR(4), FALSE);
+          IF ARR(3).DISC /= 0 OR ARR(4).DISC /= 0 THEN
+               FAILED ("ARRAY COMPONENT ASSIGNMENTS DIDN'T CHANGE " &
+                       "DISCRIMINANT OF COMPONENT");
+          END IF;
+
+          PROC (ARR2(2), ARR2(5), ARR2(10), TRUE);
+     END;
+ 
+     RESULT;
+END C37208A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37208b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37208b.ada
new file mode 100644
index 000000000..3fc4e651b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37208b.ada
@@ -0,0 +1,120 @@
+-- C37208B.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 A TYPE WITH DEFAULT DISCRIMINANT VALUES, CHECK THAT A
+-- DISCRIMINANT CONSTRAINT CAN BE OMITTED IN A GENERIC FORMAL
+-- PARAMETER, AND HENCE, FOR BOTH IN AND IN OUT PARAMETERS, THE
+-- 'CONSTRAINED ATTRIBUTE OF THE ACTUAL PARAMETER BECOMES THE
+-- 'CONSTRAINED ATTRIBUTE OF THE FORMAL PARAMETER, AND, FOR IN
+-- OUT PARAMETERS, IF THE 'CONSTRAINED ATTRIBUTE IS FALSE,
+-- ASSIGNMENTS TO THE FORMAL PARAMETERS CAN CHANGE THE
+-- DISCRIMINANTS OF THE ACTUAL PARAMETER; IF THE 'CONSTRAINED
+-- ATTRIBUTE IS  TRUE, ASSIGNMENTS THAT ATTEMPT TO CHANGE THE
+-- DISCRIMINANTS OF THE ACTUAL PARAMETER RAISE CONSTRAINT_ERROR.
+ 
+-- ASL 7/29/81
+-- VKG 1/20/83
+-- EDS 7/16/98    AVOID OPTIMIZATION
+
+WITH REPORT;
+PROCEDURE C37208B IS
+ 
+     USE REPORT;
+ 
+BEGIN
+     TEST ("C37208B","FOR TYPES WITH DEFAULT DISCRIMINANT " &
+            "VALUES, DISCRIMINANT CONSTRAINTS CAN BE OMITTED " &
+            "IN GENERIC FORMAL PARAMETERS, AND THE " &
+            "'CONSTRAINED ATTRIBUTE HAS CORRECT VALUES " &
+            "DEPENDING ON THE ACTUAL PARAMETERS");
+ 
+     DECLARE
+          TYPE REC(DISC : INTEGER := 7) IS
+               RECORD
+                    NULL;
+               END RECORD;
+ 
+          KC : CONSTANT REC(3) := (DISC => 3);
+          KU : CONSTANT REC := (DISC => 3);
+          OBJC1,OBJC2 : REC(3) := (DISC => 3);
+          OBJU1,OBJU2 : REC := (DISC => 3);
+ 
+          GENERIC
+               P_IN1 : REC;
+               P_IN2 : REC;
+               P_IN_OUT : IN OUT REC;
+               STATUS : BOOLEAN;
+          PROCEDURE PROC;
+
+          PROCEDURE PROC IS
+          BEGIN
+
+               IF P_IN1'CONSTRAINED /= TRUE  OR
+                  P_IN2'CONSTRAINED /= TRUE  OR
+                  P_IN_OUT'CONSTRAINED /= STATUS
+               THEN
+
+                    FAILED ("'CONSTRAINED ATTRIBUTES DO NOT MATCH " &
+                            "FOR ACTUAL AND FORMAL PARAMETERS");
+               END IF;
+               IF NOT STATUS THEN
+                    BEGIN
+                         P_IN_OUT := (DISC => IDENT_INT(7));
+                    EXCEPTION 
+                         WHEN OTHERS =>
+                              FAILED ("EXCEPTION RAISED " &
+                                      "WHEN TRYING TO " &
+                                      "CHANGE UNCONSTRAINED " &
+                                      "DISCRIMINANT VALUE");
+                    END;
+               ELSE
+                    BEGIN
+                         P_IN_OUT := (DISC => IDENT_INT(7));
+                         FAILED ("DISCRIMINANT OF CONSTRAINED " &
+                                 "ACTUAL PARAMETER ILLEGALLY " &
+                                 "CHANGED BY ASSIGNMENT");
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR => NULL;     
+                         WHEN OTHERS => FAILED ("WRONG EXCEPTION");
+                    END;
+               END IF;
+          END PROC;
+
+     BEGIN
+
+          DECLARE
+               PROCEDURE PROC_C IS NEW PROC(KC,OBJC1,OBJC2,IDENT_BOOL(TRUE));
+               PROCEDURE PROC_U IS NEW PROC(KU,OBJU1,OBJU2,IDENT_BOOL(FALSE));
+          BEGIN
+               PROC_C;
+               PROC_U;
+               IF OBJU2.DISC /= 7 THEN
+               FAILED ("ASSIGNMENT TO UNCONSTRAINED ACTUAL " &
+                       "PARAMETER FAILED TO CHANGE DISCRIMINANT ");
+               END IF;
+          END;
+
+     END;
+     RESULT;
+END C37208B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37209a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37209a.ada
new file mode 100644
index 000000000..52d25077c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37209a.ada
@@ -0,0 +1,145 @@
+-- C37209A.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 NOT RAISED FOR A CONSTANT OBJECT 
+-- DECLARATION WHOSE SUBTYPE INDICATION SPECIFIES AN UNCONSTRAINED
+-- TYPE WITH DEFAULT DISCRIMINANT VALUES AND WHOSE INITIALIZATION
+-- EXPRESSION SPECIFIES A VALUE WHOSE DISCRIMINANTS ARE NOT EQUAL TO
+-- THE DEFAULT VALUE.
+
+-- R.WILLIAMS 8/25/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37209A IS
+     
+BEGIN
+     TEST ( "C37209A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+                       "FOR A CONSTANT OBJECT DECLARATION WHOSE " &
+                       "SUBTYPE INDICATION SPECIFIES AN " &
+                       "UNCONSTRAINED TYPE WITH DEFAULT " &
+                       "DISCRIMINANT VALUES AND WHOSE " &
+                       "INITIALIZATION EXPRESSION SPECIFIES A VALUE " &
+                       "WHOSE DISCRIMINANTS ARE NOT EQUAL TO THE " &
+                       "DEFAULT VALUE" );
+     DECLARE
+
+          TYPE REC1 (D : INTEGER := IDENT_INT (5)) IS
+               RECORD
+                    NULL;
+               END RECORD;
+               
+     BEGIN
+          DECLARE 
+               R1 : CONSTANT REC1 := (D => IDENT_INT (10));     
+          BEGIN
+               COMMENT ( "NO EXCEPTION RAISED AT DECLARATION OF R1" );
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION FOR R1 RAISED INSIDE BLOCK" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
+                        "R1" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION OF " &
+                        "R1" );
+     END;          
+     
+
+     BEGIN
+          DECLARE     
+               PACKAGE PRIV IS
+                    TYPE REC2 (D : INTEGER:= IDENT_INT (5)) IS PRIVATE;
+                    R2 : CONSTANT REC2;
+
+               PRIVATE
+                    TYPE REC2 (D : INTEGER := IDENT_INT (5)) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+
+                    R2 : CONSTANT REC2 := (D => IDENT_INT (10));
+               END PRIV;
+          
+               USE PRIV;
+               
+          BEGIN
+               DECLARE 
+                    I : INTEGER := R2.D;                    
+               BEGIN
+                    COMMENT ( "NO EXCEPTION RAISED AT DECLARATION " &
+                              "OF R2" );
+              END;
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
+                         "R2" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
+                        "OF R2" );
+     END;
+
+     BEGIN
+          DECLARE     
+               PACKAGE LPRIV IS
+                    TYPE REC3 (D : INTEGER:= IDENT_INT (5)) IS 
+                         LIMITED PRIVATE;
+
+                    R3 : CONSTANT REC3;
+
+               PRIVATE
+                    TYPE REC3 (D : INTEGER := IDENT_INT (5)) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+
+                    R3 : CONSTANT REC3 := (D => IDENT_INT (10));
+               END LPRIV;
+          
+               USE LPRIV;
+
+          BEGIN
+               DECLARE
+                    I : INTEGER;
+               BEGIN
+                    I := R3.D;
+                    COMMENT ( "NO EXCEPTION RAISED AT DECLARATION " &
+                              "OF R3" );
+              END;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
+                         "R3" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
+                        "OF R3" );
+     END;
+
+     RESULT;
+END C37209A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37209b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37209b.ada
new file mode 100644
index 000000000..9b1bfc8d4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37209b.ada
@@ -0,0 +1,194 @@
+-- C37209B.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 CONSTRAINT_ERROR IS RAISED WHEN THE SUBTYPE
+--     INDICATION IN A CONSTANT OBJECT DECLARATION SPECIFIES A
+--     CONSTRAINED SUBTYPE WITH DISCRIMINANTS AND THE INITIALIZATION
+--     VALUE DOES NOT BELONG TO THE SUBTYPE (I. E., THE DISCRIMINANT
+--     VALUE DOES NOT MATCH THOSE SPECIFIED BY THE CONSTRAINT).
+
+-- HISTORY:
+--     RJW 08/25/86  CREATED ORIGINAL TEST
+--     VCL 08/19/87  CHANGED THE RETURN TYPE OF FUNTION 'INIT' IN
+--                   PACKAGE 'PRIV2' SO THAT 'INIT' IS UNCONSTRAINED,
+--                   THUS NOT RAISING A CONSTRAINT ERROR ON RETURN FROM
+--                   'INIT'.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37209B IS
+
+BEGIN
+     TEST ( "C37209B", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                       "THE SUBTYPE INDICATION IN A CONSTANT " &
+                       "OBJECT DECLARATION SPECIFIES A CONSTRAINED " &
+                       "SUBTYPE WITH DISCRIMINANTS AND THE " &
+                       "INITIALIZATION VALUE DOES NOT BELONG TO " &
+                       "THE SUBTYPE (I. E., THE DISCRIMINANT VALUE " &
+                       "DOES NOT MATCH THOSE SPECIFIED BY THE " &
+                       "CONSTRAINT)" );
+     DECLARE
+
+          TYPE REC (D : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          SUBTYPE REC1 IS REC (IDENT_INT (5));
+     BEGIN
+          DECLARE
+               R1 : CONSTANT REC1 := (D => IDENT_INT (10));
+               I  : INTEGER := IDENT_INT (R1.D);
+          BEGIN
+               FAILED ( "NO EXCEPTION RAISED FOR DECLARATION OF " &
+                        "R1" );
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION FOR R1 RAISED INSIDE BLOCK" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION OF " &
+                        "R1" );
+     END;
+
+
+     BEGIN
+          DECLARE
+               PACKAGE PRIV1 IS
+                    TYPE REC (D : INTEGER) IS PRIVATE;
+                    SUBTYPE REC2 IS REC (IDENT_INT (5));
+                    R2 : CONSTANT REC2;
+
+               PRIVATE
+                    TYPE REC (D : INTEGER) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+
+                    R2 : CONSTANT REC2 := (D => IDENT_INT (10));
+               END PRIV1;
+
+               USE PRIV1;
+
+          BEGIN
+               DECLARE
+                    I : INTEGER := IDENT_INT (R2.D);
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
+                             "OF R2" );
+              END;
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
+                        "OF R2" );
+     END;
+
+     BEGIN
+          DECLARE
+               PACKAGE PRIV2 IS
+                    TYPE REC (D : INTEGER) IS PRIVATE;
+                    SUBTYPE REC3 IS REC (IDENT_INT (5));
+
+                    FUNCTION INIT (D : INTEGER) RETURN REC;
+               PRIVATE
+                    TYPE REC (D : INTEGER) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+
+               END PRIV2;
+
+               PACKAGE BODY PRIV2 IS
+                    FUNCTION INIT (D : INTEGER) RETURN REC IS
+                    BEGIN
+                         RETURN (D => IDENT_INT (D));
+                    END INIT;
+               END PRIV2;
+
+               USE PRIV2;
+
+          BEGIN
+               DECLARE
+                    R3 : CONSTANT REC3 := INIT (10);
+                    I  : INTEGER := IDENT_INT (R3.D);
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
+                             "OF R3" );
+              END;
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
+                        "OF R3" );
+     END;
+
+     BEGIN
+          DECLARE
+               PACKAGE LPRIV IS
+                    TYPE REC  (D : INTEGER) IS
+                         LIMITED PRIVATE;
+                    SUBTYPE REC4 IS REC (IDENT_INT (5));
+
+                    R4 : CONSTANT REC4;
+
+               PRIVATE
+                    TYPE REC (D : INTEGER) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+
+                    R4 : CONSTANT REC4 := (D => IDENT_INT (10));
+               END LPRIV;
+
+               USE LPRIV;
+
+          BEGIN
+               DECLARE
+                    I : INTEGER := IDENT_INT (R4.D);
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
+                             "OF R4" );
+              END;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
+                        "OF R4" );
+     END;
+
+     RESULT;
+END C37209B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37210a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37210a.ada
new file mode 100644
index 000000000..8542bb5b2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37210a.ada
@@ -0,0 +1,116 @@
+-- C37210A.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 EXPRESSION IN A DISCRIMINANT ASSOCIATION WITH MORE 
+-- THAN ONE NAME IS EVALUATED ONCE FOR EACH NAME.
+
+-- R.WILLIAMS 8/28/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37210A IS
+
+     BUMP : INTEGER := IDENT_INT (0);
+
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+          BUMP := BUMP + 1;
+          RETURN BUMP;
+     END F;
+
+     FUNCTION CHECK (STR : STRING) RETURN INTEGER IS
+     BEGIN
+          IF BUMP /= 2 THEN
+               FAILED ( "INCORRECT DISCRIMINANT VALUES FOR " & STR);
+          END IF;
+          BUMP := IDENT_INT (0);
+          RETURN 5;
+     END CHECK;
+          
+BEGIN
+     TEST ( "C37210A", "CHECK THAT THE EXPRESSION IN A " &
+                       "DISCRIMINANT ASSOCIATION WITH MORE THAN " &
+                       "ONE NAME IS EVALUATED ONCE FOR EACH NAME" );
+
+     DECLARE
+          TYPE REC (D1, D2 : INTEGER) IS
+               RECORD 
+                    NULL;
+               END RECORD;
+
+          R : REC (D1 | D2 => F);
+
+          I1 : INTEGER := CHECK ( "R" );
+
+          TYPE ACC IS ACCESS REC;
+
+          AC : ACC (D1 | D2 => F);
+     
+          I2 : INTEGER := CHECK ( "AC" );
+          
+          PACKAGE PKG IS
+               TYPE PRIV (D1, D2 : INTEGER) IS PRIVATE; 
+               TYPE PACC IS ACCESS PRIV;
+
+               TYPE LIM (D1, D2 : INTEGER) IS LIMITED PRIVATE;
+               TYPE LACC IS ACCESS LIM;
+
+          PRIVATE
+               TYPE PRIV (D1, D2 : INTEGER) IS 
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               TYPE LIM (D1, D2 : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END PKG;                                  
+          
+          USE PKG;
+
+     BEGIN
+
+          DECLARE
+               P  : PRIV (D1 | D2 => F);
+               
+               I1 : INTEGER := CHECK ( "P" );
+
+               PA : PACC (D1 | D2 => F);
+
+               I2 : INTEGER := CHECK ( "PA" );
+
+               L  : LIM (D1 | D2 => F);
+          
+               I3 : INTEGER := CHECK ( "L" );
+
+               LA : LACC (D1 | D2 => F);
+
+               I : INTEGER;
+          BEGIN
+               I := CHECK ( "LA" );
+          END;
+     END;
+
+     RESULT;
+END C37210A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211a.ada
new file mode 100644
index 000000000..4b718a9ec
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211a.ada
@@ -0,0 +1,242 @@
+-- C37211A.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 BY A DISCRIMINANT CONSTRAINT 
+-- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
+-- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
+-- INDICATIONS WHERE THE TYPE MARK DENOTES A RECORD TYPE.
+
+-- R.WILLIAMS 8/28/86
+-- EDS        7/14/98    AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37211A IS
+
+     TYPE REC (D : POSITIVE) IS
+          RECORD
+               NULL;
+          END RECORD;
+     
+BEGIN
+     TEST ( "C37211A", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                       "A DISCRIMINANT CONSTRAINT IF A VALUE " &
+                       "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
+                       "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
+                       "TYPE MARK DENOTES A RECORD TYPE" );
+                         
+     BEGIN
+          DECLARE
+               SUBTYPE SUBREC IS REC (IDENT_INT (-1));
+          BEGIN
+               DECLARE
+                    SR : SUBREC;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF SUBTYPE SUBREC " & INTEGER'IMAGE(SR.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT SR" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "SUBTYPE SUBREC" );
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE ARR IS ARRAY (1 .. 10) OF REC (IDENT_INT (-1));
+          BEGIN
+               DECLARE
+                    AR : ARR;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE ARR " & INTEGER'IMAGE(AR(1).D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT AR" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE ARR" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE REC1 IS 
+                    RECORD
+                         X : REC (IDENT_INT (-1));
+                    END RECORD;
+
+          BEGIN
+               DECLARE
+                    R1 : REC1;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE REC1 " & INTEGER'IMAGE(R1.X.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT R1" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE REC1" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE ACCREC IS ACCESS REC (IDENT_INT (-1));
+          BEGIN
+               DECLARE
+                    ACR : ACCREC;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE ACCREC " & INTEGER'IMAGE(ACR.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT ACR" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE ACCREC" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE NEWREC IS NEW REC (IDENT_INT (-1));
+          BEGIN
+               DECLARE
+                    NR : NEWREC;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE NEWREC " & INTEGER'IMAGE(NR.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT NR" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE NEWREC" );
+     END;
+
+     BEGIN
+          DECLARE
+               R : REC (IDENT_INT (-1));
+          BEGIN
+               FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
+                        "R " & INTEGER'IMAGE(R.D));
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
+                             "CONTAINING R" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
+                        "R" );
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE REC_NAME IS ACCESS REC;
+          BEGIN
+               DECLARE
+                    RN : REC_NAME := NEW REC (IDENT_INT (-1));
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "DECLARATION OF OBJECT RN " & INTEGER'IMAGE(RN.D));
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;               
+               WHEN OTHERS => 
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF OBJECT RN" );
+          END;
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                        "REC_NAME" );
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE BAD_REC (D : POSITIVE := IDENT_INT (-1)) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          BEGIN
+               DECLARE
+                    BR : BAD_REC;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "DECLARATION OF OBJECT BR " & INTEGER'IMAGE(BR.D));
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;               
+               WHEN OTHERS => 
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF OBJECT BR" );
+          END;
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                        "BAD_REC" );
+     END;
+
+     RESULT;
+END C37211A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211b.ada
new file mode 100644
index 000000000..fbc3591ef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211b.ada
@@ -0,0 +1,495 @@
+-- C37211B.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 BY A DISCRIMINANT CONSTRAINT 
+-- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
+-- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
+-- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED 
+-- PRIVATE TYPE, AND THE DISCRIMINANT CONSTRAINT OCCURS AFTER THE FULL 
+-- DECLARATION OF THE TYPE.
+
+-- R.WILLIAMS 8/28/86
+-- EDS        7/14/98    AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37211B IS
+
+     SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE;
+     
+     PACKAGE PKG IS
+          TYPE PRIV (L : LIES) IS PRIVATE;
+          TYPE LIM  (L : LIES) IS LIMITED PRIVATE;
+
+     PRIVATE
+          TYPE PRIV (L : LIES) IS 
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE LIM (L : LIES) IS
+               RECORD
+                    NULL;
+               END RECORD;
+     END PKG;     
+     
+     USE PKG;
+
+BEGIN
+     TEST ( "C37211B", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                       "A DISCRIMINANT CONSTRAINT IF A VALUE " &
+                       "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
+                       "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
+                       "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
+                       "PRIVATE TYPE, AND THE DISCRIMINANT " &
+                       "CONSTRAINT OCCURS AFTER THE FULL " & 
+                       "DECLARATION OF THE TYPE" );
+                         
+     BEGIN
+          DECLARE
+               SUBTYPE SUBPRIV IS PRIV (IDENT_BOOL (TRUE));
+          BEGIN
+               DECLARE
+                    SP : SUBPRIV;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF SUBTYPE SUBPRIV " & 
+                             BOOLEAN'IMAGE(SP.L));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT SP" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "SUBTYPE SUBPRIV" );
+     END;
+
+     BEGIN
+          DECLARE
+               SUBTYPE SUBLIM IS LIM (IDENT_BOOL (TRUE));
+          BEGIN
+               DECLARE
+                    SL : SUBLIM;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF SUBTYPE SUBLIM" & 
+                             BOOLEAN'IMAGE(SL.L));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT SL " );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "SUBTYPE SUBLIM" );
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE PARR IS ARRAY (1 .. 5) OF PRIV (IDENT_BOOL (TRUE));
+          BEGIN
+               DECLARE
+                    PAR : PARR;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE PARR " & 
+                             BOOLEAN'IMAGE(PAR(1).L));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT PAR" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE PARR" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE LARR IS ARRAY (1 .. 10) OF LIM (IDENT_BOOL (TRUE));
+          BEGIN
+               DECLARE
+                    LAR : LARR;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE LARR " & 
+                             BOOLEAN'IMAGE(LAR(1).L));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT LAR" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE LARR" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE PRIV1 IS 
+                    RECORD
+                         X : PRIV (IDENT_BOOL (TRUE));
+                    END RECORD;
+
+          BEGIN
+               DECLARE
+                    P1 : PRIV1;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE PRIV1 " & 
+                             BOOLEAN'IMAGE(P1.X.L));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT P1" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE PRIV1" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE LIM1 IS 
+                    RECORD
+                         X : LIM (IDENT_BOOL (TRUE));
+                    END RECORD;
+
+          BEGIN
+               DECLARE
+                    L1 : LIM1;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE LIM1 " & 
+                             BOOLEAN'IMAGE(L1.X.L));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT L1" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE LIM1" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE ACCPRIV IS ACCESS PRIV (IDENT_BOOL (TRUE));
+          BEGIN
+               DECLARE
+                    ACP : ACCPRIV;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE ACCPRIV " & 
+                             BOOLEAN'IMAGE(ACP.L));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT ACP" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE ACCPRIV" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE ACCLIM IS ACCESS LIM (IDENT_BOOL (TRUE));
+          BEGIN
+               DECLARE
+                    ACL : ACCLIM;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE ACCLIM " & 
+                             BOOLEAN'IMAGE(ACL.L));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT ACL" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE ACCLIM" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE NEWPRIV IS NEW PRIV (IDENT_BOOL (TRUE));
+          BEGIN
+               DECLARE
+                    NP : NEWPRIV;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE NEWPRIV " & 
+                             BOOLEAN'IMAGE(NP.L));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT NP" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE NEWPRIV" );
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE NEWLIM IS NEW LIM (IDENT_BOOL (TRUE));
+          BEGIN
+               DECLARE
+                    NL : NEWLIM;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE NEWLIM " & 
+                             BOOLEAN'IMAGE(NL.L));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT NL" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE NEWLIM" );
+     END;
+
+     BEGIN
+          DECLARE
+               P : PRIV (IDENT_BOOL (TRUE));
+          BEGIN
+               FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
+                        "P " & BOOLEAN'IMAGE(P.L));
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
+                             "CONTAINING P" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
+                        "P" );
+     END;
+
+     BEGIN
+          DECLARE
+               L : LIM (IDENT_BOOL (TRUE));
+          BEGIN
+               FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
+                        "L " & BOOLEAN'IMAGE(L.L));
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
+                             "CONTAINING L" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
+                        "L" );
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE PRIV_NAME IS ACCESS PRIV;
+          BEGIN
+               DECLARE
+                    PN : PRIV_NAME := NEW PRIV (IDENT_BOOL (TRUE));
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "DECLARATION OF OBJECT PN " & 
+                             BOOLEAN'IMAGE(PN.L));
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;               
+               WHEN OTHERS => 
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF OBJECT PN" );
+          END;
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                        "PRIV_NAME" );
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE LIM_NAME IS ACCESS LIM;
+          BEGIN
+               DECLARE
+                    LN : LIM_NAME := NEW LIM (IDENT_BOOL (TRUE));
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "DECLARATION OF OBJECT LN " & 
+                             BOOLEAN'IMAGE(LN.L));
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;               
+               WHEN OTHERS => 
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF OBJECT LN" );
+          END;
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                        "LIM_NAME" );
+     END;
+
+     BEGIN
+          DECLARE
+               PACKAGE PP IS
+                    TYPE BAD_PRIV (D : LIES := IDENT_BOOL (TRUE)) IS
+                         PRIVATE;
+               PRIVATE
+                    TYPE BAD_PRIV (D : LIES := IDENT_BOOL (TRUE)) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END PP;
+
+               USE PP;
+          BEGIN
+               DECLARE
+                    BP : BAD_PRIV;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "DECLARATION OF OBJECT BP " & 
+                             BOOLEAN'IMAGE(BP.D));
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;               
+               WHEN OTHERS => 
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF OBJECT BP" );
+          END;
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                        "BAD_PRIV" );
+     END;
+
+     BEGIN
+          DECLARE
+               PACKAGE PL IS
+                    TYPE BAD_LIM (D : LIES := IDENT_BOOL (TRUE)) IS
+                         LIMITED PRIVATE;
+               PRIVATE
+                    TYPE BAD_LIM (D : LIES := IDENT_BOOL (TRUE)) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END PL;
+
+               USE PL;
+          BEGIN
+               DECLARE
+                    BL : BAD_LIM;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "DECLARATION OF OBJECT BL " & 
+                             BOOLEAN'IMAGE(BL.D));
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION ATTEMPTING TO USE OBJECT" );
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;               
+               WHEN OTHERS => 
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF OBJECT BL" );
+          END;
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                        "BAD_LIM" );
+     END;
+
+     RESULT;
+END C37211B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211c.ada
new file mode 100644
index 000000000..ba15964d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211c.ada
@@ -0,0 +1,426 @@
+-- C37211C.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 BY A DISCRIMINANT CONSTRAINT 
+-- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
+-- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
+-- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED 
+-- PRIVATE TYPE, THE DISCRIMINANT CONSTRAINT OCCURS BEFORE THE FULL 
+-- DECLARATION OF THE TYPE, AND THERE ARE NO COMPONENTS OF THE TYPE 
+-- DEPENDENT ON THE DISCRIMINANT.
+
+-- R.WILLIAMS 8/28/86
+-- EDS        7/14/98    AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37211C IS
+
+     GLOBAL : BOOLEAN;
+
+     SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE;
+
+     FUNCTION SWITCH (B : BOOLEAN) RETURN BOOLEAN IS
+     BEGIN
+          GLOBAL := B;
+          RETURN B;
+     END SWITCH;
+     
+BEGIN
+     TEST ( "C37211C", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                       "A DISCRIMINANT CONSTRAINT IF A VALUE " &
+                       "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
+                       "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
+                       "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
+                       "PRIVATE TYPE, AND THE DISCRIMINANT " &
+                       "CONSTRAINT OCCURS BEFORE THE FULL " &
+                       "DECLARATION OF THE TYPE" );
+                         
+     BEGIN
+          DECLARE
+                                   
+               B1 : BOOLEAN := SWITCH (TRUE);
+
+               PACKAGE PP IS
+                    TYPE PRIV1 (D : LIES) IS PRIVATE;
+                    SUBTYPE SUBPRIV IS PRIV1 (IDENT_BOOL (TRUE));
+
+                    B2 : BOOLEAN := SWITCH (FALSE);
+
+               PRIVATE
+                    TYPE PRIV1 (D : LIES) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END PP;
+                    
+               USE PP;
+          BEGIN
+               DECLARE
+                    SP : SUBPRIV;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF SUBTYPE SUBPRIV " & BOOLEAN'IMAGE(SP.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT SP" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF GLOBAL THEN 
+                    NULL;
+               ELSE
+                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                             "FULL TYPE PRIV1 NOT SUBTYPE SUBPRIV" );
+               END IF;                    
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "SUBTYPE SUBPRIV" );
+     END;
+
+     BEGIN
+          DECLARE
+                                   
+               B1 : BOOLEAN := SWITCH (TRUE);
+
+               PACKAGE PL IS
+                    TYPE LIM1 (D : LIES) IS LIMITED PRIVATE;
+                    SUBTYPE SUBLIM IS LIM1 (IDENT_BOOL (TRUE));
+
+                    B2 : BOOLEAN := SWITCH (FALSE);
+
+               PRIVATE
+                    TYPE LIM1 (D : LIES) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END PL;
+                    
+               USE PL;
+          BEGIN
+               DECLARE
+                    SL : SUBLIM;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF SUBTYPE SUBLIM " & BOOLEAN'IMAGE(SL.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT SL" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF GLOBAL THEN 
+                    NULL;
+               ELSE
+                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                             "FULL TYPE LIM1 NOT SUBTYPE SUBLIM" );
+               END IF;                    
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "SUBTYPE SUBLIM" );
+     END;
+
+     BEGIN
+          DECLARE
+               B1 : BOOLEAN := SWITCH (TRUE);
+
+               PACKAGE PP IS
+                    TYPE PRIV2 (D : LIES) IS PRIVATE;
+                    TYPE PARR IS ARRAY (1 .. 5) OF 
+                         PRIV2 (IDENT_BOOL (TRUE));
+     
+                    B2 : BOOLEAN := SWITCH (FALSE);
+
+               PRIVATE
+                    TYPE PRIV2 (D : LIES) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END PP;
+                    
+               USE PP;
+          BEGIN
+               DECLARE
+                    PAR : PARR;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE PARR " & BOOLEAN'IMAGE(PAR(1).D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT PAR" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF GLOBAL THEN 
+                    NULL;
+               ELSE
+                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                             "FULL TYPE PRIV2 NOT TYPE PARR" );
+               END IF;                    
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE PARR" );
+     END;
+          
+     BEGIN
+          DECLARE
+               B1 : BOOLEAN := SWITCH (TRUE);
+
+               PACKAGE PL IS
+                    TYPE LIM2 (D : LIES) IS LIMITED PRIVATE;
+                    TYPE LARR IS ARRAY (1 .. 5) OF 
+                         LIM2 (IDENT_BOOL (TRUE));
+     
+                    B2 : BOOLEAN := SWITCH (FALSE);
+
+               PRIVATE
+                    TYPE LIM2 (D : LIES) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END PL;
+                    
+               USE PL;
+          BEGIN
+               DECLARE
+                    LAR : LARR;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE LARR " & BOOLEAN'IMAGE(LAR(1).D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT LAR" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF GLOBAL THEN 
+                    NULL;
+               ELSE
+                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                             "FULL TYPE LIM2 NOT TYPE LARR" );
+               END IF;                    
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE LARR" );
+     END;
+          
+     BEGIN
+          DECLARE
+               B1 : BOOLEAN := SWITCH (TRUE);
+
+               PACKAGE PP IS
+                    TYPE PRIV3 (D : LIES) IS PRIVATE;
+
+                    TYPE PRIV4 IS 
+                         RECORD
+                              X : PRIV3 (IDENT_BOOL (TRUE));
+                         END RECORD;
+
+                    B2 : BOOLEAN := SWITCH (FALSE);
+
+               PRIVATE
+                    TYPE PRIV3 (D : LIES) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END PP;
+                    
+               USE PP;
+          BEGIN
+               DECLARE
+                    P4 : PRIV4;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE PRIV4 " & BOOLEAN'IMAGE(P4.X.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT P4" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF GLOBAL THEN 
+                    NULL;
+               ELSE
+                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                             "FULL TYPE PRIV3 NOT TYPE PRIV4" );
+               END IF;                    
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE PRIV4" );
+     END;
+          
+     BEGIN
+          DECLARE
+               B1 : BOOLEAN := SWITCH (TRUE);
+
+               PACKAGE PL IS
+                    TYPE LIM3 (D : LIES) IS LIMITED PRIVATE;
+
+                    TYPE LIM4 IS 
+                         RECORD
+                              X : LIM3 (IDENT_BOOL (TRUE));
+                         END RECORD;
+
+                    B2 : BOOLEAN := SWITCH (FALSE);
+
+               PRIVATE
+                    TYPE LIM3 (D : LIES) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END PL;
+                    
+               USE PL;
+          BEGIN
+               DECLARE
+                    L4 : LIM4;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE LIM4 " & BOOLEAN'IMAGE(L4.X.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT L4" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF GLOBAL THEN 
+                    NULL;
+               ELSE
+                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                             "FULL TYPE LIM3 NOT TYPE LIM4" );
+               END IF;                    
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE LIM4" );
+     END;
+          
+     BEGIN
+          DECLARE
+               B1 : BOOLEAN := SWITCH (TRUE);
+
+               PACKAGE PP IS
+                    TYPE PRIV5 (D : LIES) IS PRIVATE;
+                    TYPE ACCPRIV IS ACCESS PRIV5 (IDENT_BOOL (TRUE));
+
+                    B2 : BOOLEAN := SWITCH (FALSE);
+
+               PRIVATE
+                    TYPE PRIV5 (D : LIES) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END PP;
+                    
+               USE PP;
+
+          BEGIN
+               DECLARE
+                    ACP : ACCPRIV;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE ACCPRIV " & BOOLEAN'IMAGE(ACP.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT ACP" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF GLOBAL THEN 
+                    NULL;
+               ELSE
+                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                             "FULL TYPE PRIV5 NOT TYPE ACCPRIV" );
+               END IF;                    
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE ACCPRIV" );
+     END;
+          
+     BEGIN
+          DECLARE
+               B1 : BOOLEAN := SWITCH (TRUE);
+
+               PACKAGE PL IS
+                    TYPE LIM5 (D : LIES) IS LIMITED PRIVATE;
+                    TYPE ACCLIM IS ACCESS LIM5 (IDENT_BOOL (TRUE));
+
+                    B2 : BOOLEAN := SWITCH (FALSE);
+
+               PRIVATE
+                    TYPE LIM5 (D : LIES) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END PL;
+                    
+               USE PL;
+
+          BEGIN
+               DECLARE
+                    ACL : ACCLIM;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE ACCLIM " & BOOLEAN'IMAGE(ACL.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT ACL" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF GLOBAL THEN 
+                    NULL;
+               ELSE
+                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                             "FULL TYPE LIM5 NOT TYPE ACCLIM" );
+               END IF;                    
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE ACCLIM" );
+     END;
+          
+     RESULT;
+END C37211C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211d.ada
new file mode 100644
index 000000000..8d623c8bd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211d.ada
@@ -0,0 +1,102 @@
+-- C37211D.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 BY A DISCRIMINANT CONSTRAINT 
+-- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
+-- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 
+-- INDICATIONS WHERE THE TYPE MARK DENOTES AN INCOMPLETE TYPE.
+
+-- R.WILLIAMS 8/28/86
+-- EDS        7/14/98    AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37211D IS
+
+     GLOBAL : BOOLEAN;
+
+     TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+
+     SUBTYPE WEEKDAY IS DAY RANGE MON .. FRI;
+
+     FUNCTION SWITCH (B : BOOLEAN) RETURN BOOLEAN IS
+     BEGIN
+          GLOBAL := B;
+          RETURN B;
+     END SWITCH;
+     
+     FUNCTION IDENT (D : DAY) RETURN DAY IS
+     BEGIN
+          RETURN DAY'VAL (IDENT_INT (DAY'POS (D)));
+     END IDENT;
+
+BEGIN
+     TEST ( "C37211D", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                       "A DISCRIMINANT CONSTRAINT IF A VALUE " &
+                       "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
+                       "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
+                       "TYPE MARK DENOTES AN INCOMPLETE TYPE" );
+                         
+     BEGIN
+          DECLARE
+                                   
+               B1 : BOOLEAN := SWITCH (TRUE);
+
+               TYPE REC (D : WEEKDAY);
+
+               TYPE ACCREC IS ACCESS REC (IDENT (SUN));
+
+               B2 : BOOLEAN := SWITCH (FALSE);
+
+               TYPE REC (D : WEEKDAY) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          BEGIN
+               DECLARE
+                    AC : ACCREC;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE ACCREC " & DAY'IMAGE(AC.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT AC" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF GLOBAL THEN 
+                    NULL;
+               ELSE
+                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
+                             "FULL TYPE REC NOT TYPE ACCREC" );
+               END IF;                    
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE ACCREC" );
+     END;
+
+     RESULT;
+END C37211D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211e.ada
new file mode 100644
index 000000000..c4b12fa44
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37211e.ada
@@ -0,0 +1,233 @@
+-- C37211E.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 BY A DISCRIMINANT CONSTRAINT 
+-- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
+-- OF THE DISCRIMINANT. 
+
+-- R.WILLIAMS 8/28/86
+-- PWN 10/27/95  REMOVED CHECK WHERE CONSTRAINT RULES HAVE CHANGED.
+-- PWN 12/03/95  CORRECTED FORMATING PROBLEM.
+-- TMB 11/20/96  REINTRODUCED CHECK REMOVED ON 10/27 WITH ADA95 CHANGES
+-- TMB 12/2/96   DELETED CHECK OF CONSTRAINED ACCESS TYPE
+-- EDS 07/14/98  AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37211E IS
+
+     TYPE REC (D : POSITIVE) IS
+          RECORD
+               NULL;
+          END RECORD;
+     
+     TYPE ACC IS ACCESS REC;
+BEGIN
+     TEST ( "C37211E", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                       "A DISCRIMINANT CONSTRAINT IF A VALUE " &
+                       "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
+                       "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
+                       "TYPE MARK DENOTES AN ACCESS TYPE" );
+                         
+     BEGIN
+          DECLARE
+               SUBTYPE SUBACC IS ACC (IDENT_INT (-1));
+          BEGIN
+               DECLARE
+                    SA : SUBACC;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF SUBTYPE SUBACC " & 
+                             INTEGER'IMAGE(SA.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT SA" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "SUBTYPE SUBACC" );
+     END;
+
+     BEGIN
+          DECLARE
+               TYPE ARR IS ARRAY (1 .. 10) OF ACC (IDENT_INT (-1));
+          BEGIN
+               DECLARE
+                    AR : ARR;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE ARR " & 
+                             INTEGER'IMAGE(AR(1).D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT AR" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE ARR" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE REC1 IS 
+                    RECORD
+                         X : ACC (IDENT_INT (-1));
+                    END RECORD;
+
+          BEGIN
+               DECLARE
+                    R1 : REC1;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE REC1 " & INTEGER'IMAGE(R1.X.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT R1" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE REC1" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE ACCA IS ACCESS ACC (IDENT_INT (-1));
+          BEGIN
+               DECLARE
+                    ACA : ACCA;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE ACCA " & 
+                             INTEGER'IMAGE(ACA.ALL.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT ACA" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE ACCA" );
+     END;
+          
+     BEGIN
+          DECLARE
+               TYPE NEWACC IS NEW ACC (IDENT_INT (-1));
+          BEGIN
+               DECLARE
+                    NA : NEWACC;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "ELABORATION OF TYPE NEWACC " & 
+                             INTEGER'IMAGE(NA.D));
+               END;
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
+                             "OBJECT NA" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
+                        "TYPE NEWACC" );
+     END;
+
+     BEGIN
+          DECLARE
+               A : ACC (IDENT_INT (-1));
+          BEGIN
+               FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
+                        "A " & INTEGER'IMAGE(A.D));
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
+                             "CONTAINING A" );
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
+                        "A" );
+     END;
+
+
+     BEGIN
+          DECLARE
+               TYPE BAD_ACC (D : POSITIVE := IDENT_INT (-1)) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          BEGIN
+               DECLARE
+                    BAC : BAD_ACC;
+               BEGIN
+                    FAILED ( "NO EXCEPTION RAISED AT THE " &
+                             "DECLARATION OF OBJECT BAC " & 
+                             INTEGER'IMAGE(BAC.D));
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
+                                  "DECLARING BAC" );
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;               
+               WHEN OTHERS => 
+                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
+                             "OF OBJECT BAC" );
+          END;
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
+                        "BAD_ACC" );
+     END;
+
+     RESULT;
+END C37211E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213b.ada
new file mode 100644
index 000000000..2117ece0b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213b.ada
@@ -0,0 +1,241 @@
+-- C37213B.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 DISCRIMINANT CONSTRAINT
+-- DEPENDS ON A DISCRIMINANT, THE NON-DISCRIMINANT EXPRESSIONS IN THE
+-- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT SUBTYPE DEFINITION IS
+-- ELABORATED, BUT THE VALUES ARE CHECKED WHEN THE RECORD TYPE IS:
+--
+--   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+--      DECLARATION.
+
+-- JBG 10/17/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37213B IS
+
+     SUBTYPE SM IS INTEGER RANGE 1..10;
+
+     TYPE REC (D1, D2 : SM) IS
+          RECORD NULL; END RECORD;
+
+     F1_CONS : INTEGER := 2;
+
+     FUNCTION CHK (
+          CONS    : INTEGER;
+          VALUE   : INTEGER;
+          MESSAGE : STRING) RETURN BOOLEAN IS
+     BEGIN
+          IF CONS /= VALUE THEN
+               FAILED (MESSAGE & ": CONS IS " &
+                       INTEGER'IMAGE(CONS));
+          END IF;
+          RETURN TRUE;
+     END CHK;
+
+     FUNCTION F1 RETURN INTEGER IS
+     BEGIN
+          F1_CONS := F1_CONS - IDENT_INT(1);
+          RETURN F1_CONS;
+     END F1;
+
+BEGIN
+     TEST ("C37213B", "CHECK EVALUATION OF DISCRIMINANT EXPRESSIONS " &
+                      "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                      "AND DISCRIMINANTS HAVE DEFAULTS");
+
+-- CASE B
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := 1) IS
+               RECORD
+                    C1 : REC (D3, F1);       -- F1 EVALUATED
+               END RECORD;
+          CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
+          X : CONS;             -- F1 NOT EVALUATED AGAIN
+          Y : CONS;             -- F1 NOT EVALUATED AGAIN
+          CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
+     BEGIN
+          IF X /= (1, (1, 1)) OR Y /= (1, (1, 1)) THEN
+               FAILED ("DISCRIMINANT VALUES NOT CORRECT");
+          END IF;
+     END;
+
+     F1_CONS := 12;
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := 1) IS
+               RECORD
+                    C1 : REC(D3, F1);
+               END RECORD;
+     BEGIN
+          BEGIN
+               DECLARE
+                    X : CONS;
+               BEGIN
+                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
+                    IF X /= (1, (1, 1)) THEN
+                         COMMENT ("SHOULDN'T GET HERE");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 1");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+                    X : ACC_CONS;
+               BEGIN
+                    X := NEW CONS;
+                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
+                    BEGIN
+                         IF X.ALL /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 3");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+               BEGIN
+                    DECLARE
+                         X : ARR;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 4");
+                         IF X /= (1..5 => (1, (1, 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 5");
+                         IF X /= (C1 => (1, (1, 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE DREC IS NEW CONS;
+               BEGIN
+                    DECLARE
+                         X : DREC;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 6");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+          END;
+
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+          RESULT;
+
+END C37213B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213d.ada
new file mode 100644
index 000000000..dc2d67299
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213d.ada
@@ -0,0 +1,240 @@
+-- C37213D.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
+--        AN INDEX CONSTRAINT
+-- DEPENDS ON A DISCRIMINANT, THE NON-DISCRIMINANT EXPRESSIONS IN THE
+-- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT SUBTYPE DEFINITION IS
+-- ELABORATED, BUT THE VALUES ARE CHECKED WHEN THE RECORD TYPE IS:
+--
+--   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+--      DECLARATION.
+
+-- JBG 10/17/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37213D IS
+
+     SUBTYPE SM IS INTEGER RANGE 1..10;
+
+     TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+
+     F1_CONS : INTEGER := 2;
+
+     FUNCTION CHK (
+          CONS    : INTEGER;
+          VALUE   : INTEGER;
+          MESSAGE : STRING) RETURN BOOLEAN IS
+     BEGIN
+          IF CONS /= VALUE THEN
+               FAILED (MESSAGE & ": CONS IS " &
+                       INTEGER'IMAGE(CONS));
+          END IF;
+          RETURN TRUE;
+     END CHK;
+
+     FUNCTION F1 RETURN INTEGER IS
+     BEGIN
+          F1_CONS := F1_CONS - IDENT_INT(1);
+          RETURN F1_CONS;
+     END F1;
+
+BEGIN
+     TEST ("C37213D", "CHECK EVALUATION OF INDEX BOUNDS " &
+                      "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                      "AND DISCRIMINANTS HAVE DEFAULTS");
+
+-- CASE B
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := 1) IS
+               RECORD
+                    C1 : MY_ARR (F1..D3);    -- F1 EVALUATED.
+               END RECORD;
+          CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
+          X : CONS;             -- F1 NOT EVALUATED AGAIN
+          Y : CONS;             -- F1 NOT EVALUATED AGAIN
+          CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
+     BEGIN
+          IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN
+               FAILED ("INDEX BOUNDS NOT CORRECT");
+          END IF;
+     END;
+
+     F1_CONS := 12;
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := 1) IS
+               RECORD
+                    C1 : MY_ARR(D3..F1);
+               END RECORD;
+     BEGIN
+          BEGIN
+               DECLARE
+                    X : CONS;
+               BEGIN
+                    FAILED ("INDEX CHECK NOT PERFORMED - 1");
+                    IF X /= (1, (1, 1)) THEN
+                         COMMENT ("SHOULDN'T GET HERE");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 1");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+                    X : ACC_CONS;
+               BEGIN
+                    X := NEW CONS;
+                    FAILED ("INDEX CHECK NOT PERFORMED - 2");
+                    BEGIN
+                         IF X.ALL /= (1, (1 => 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT " &
+                                 "PERFORMED - 3");
+                         IF X /= (1, (1 => 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+               BEGIN
+                    DECLARE
+                         X : ARR;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT " &
+                                 "PERFORMED - 4");
+                         IF X /= (1..5 => (1, (1 => 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT " &
+                                 "PERFORMED - 5");
+                         IF X /= (C1 => (1, (1 => 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE DREC IS NEW CONS;
+               BEGIN
+                    DECLARE
+                         X : DREC;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT " &
+                                 "PERFORMED - 6");
+                         IF X /= (1, (1 => 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+          END;
+
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+          RESULT;
+
+END C37213D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213f.ada
new file mode 100644
index 000000000..3699c1a97
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213f.ada
@@ -0,0 +1,379 @@
+-- C37213F.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 DISCRIMINANT CONSTRAINT
+-- DEPENDS ON A DISCRIMINANT, THE NON-DISCRIMINANT EXPRESSIONS IN THE
+-- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT SUBTYPE DEFINITION IS
+-- ELABORATED, BUT THE VALUES ARE CHECKED WHEN THE RECORD TYPE IS:
+--
+--   CASE D: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+--      DECLARATION AND THE COMPONENT IS PRESENT IN THE DEFAULT SUBTYPE.
+
+-- JBG 10/17/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37213F IS
+
+     SUBTYPE SM IS INTEGER RANGE 1..10;
+
+     TYPE REC (D1, D2 : SM) IS
+          RECORD NULL; END RECORD;
+
+     F1_CONS : INTEGER := 2;
+
+     FUNCTION CHK (
+          CONS    : INTEGER;
+          VALUE   : INTEGER;
+          MESSAGE : STRING) RETURN BOOLEAN IS
+     BEGIN
+          IF CONS /= VALUE THEN
+               FAILED (MESSAGE & ": CONS IS " &
+                       INTEGER'IMAGE(CONS));
+          END IF;
+          RETURN TRUE;
+     END CHK;
+
+     FUNCTION F1 RETURN INTEGER IS
+     BEGIN
+          F1_CONS := F1_CONS - IDENT_INT(1);
+          RETURN F1_CONS;
+     END F1;
+
+BEGIN
+     TEST ("C37213F", "CHECK EVALUATION OF DISCRIMINANT EXPRESSIONS " &
+                      "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                      "DISCRIMINANTS HAVE DEFAULTS, AND COMPONENT" &
+                      "SUBTYPE DETERMINES WHETHER CONSTRAINT SHOULD " &
+                      "BE CHECKED");
+
+-- CASE D1: COMPONENT IS PRESENT
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := IDENT_INT(1)) IS
+               RECORD
+                    CASE D3 IS
+                         WHEN -5..10 =>
+                              C1 : REC (D3, F1);       -- F1 EVALUATED
+                         WHEN OTHERS =>
+                              C2 : INTEGER := IDENT_INT(0);
+                    END CASE;
+               END RECORD;
+          CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
+          X : CONS;             -- F1 NOT EVALUATED AGAIN
+          Y : CONS;             -- F1 NOT EVALUATED AGAIN
+          CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
+     BEGIN
+          IF X /= (1, (1, 1)) OR Y /= (1, (1, 1)) THEN
+               FAILED ("DISCRIMINANT VALUES NOT CORRECT");
+          END IF;
+     END;
+
+     F1_CONS := 12;
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := IDENT_INT(1)) IS
+               RECORD
+                    CASE D3 IS
+                         WHEN -5..10 =>
+                              C1 : REC(D3, F1);
+                         WHEN OTHERS =>
+                              C2 : INTEGER := IDENT_INT(0);
+                    END CASE;
+               END RECORD;
+     BEGIN
+          BEGIN
+               DECLARE
+                    X : CONS;
+               BEGIN
+                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
+                    IF X /= (1, (1, 1)) THEN
+                         COMMENT ("SHOULDN'T GET HERE");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 1");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+                    X : ACC_CONS;
+               BEGIN
+                    X := NEW CONS;
+                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
+                    IF X.ALL /= (1, (1, 1)) THEN
+                         COMMENT ("IRRELEVANT");
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 3");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+               BEGIN
+                    DECLARE
+                         X : ARR;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 4");
+                         IF X /= (1..5 => (1, (1, 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 5");
+                         IF X /= (C1 => (1, (1, 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE DREC IS NEW CONS;
+               BEGIN
+                    DECLARE
+                         X : DREC;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 6");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+          END;
+
+     END;
+
+-- CASE C2 : COMPONENT IS ABSENT
+
+     F1_CONS := 2;
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := IDENT_INT(-6)) IS
+               RECORD
+                    CASE D3 IS
+                         WHEN -5..10 =>
+                              C1 : REC (D3, F1);       -- F1 EVALUATED
+                         WHEN OTHERS =>
+                              C2 : INTEGER := IDENT_INT(0);
+                    END CASE;
+               END RECORD;
+          CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED - 2");
+          X : CONS;             -- F1 NOT EVALUATED AGAIN
+          Y : CONS;             -- F1 NOT EVALUATED AGAIN
+          CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED - 2");
+     BEGIN
+          IF X /= (-6, 0) OR Y /= (-6, 0) THEN
+               FAILED ("DISCRIMINANT VALUES NOT CORRECT");
+          END IF;
+     END;
+
+     F1_CONS := 12;
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
+               RECORD
+                    CASE D3 IS
+                         WHEN -5..10 =>
+                              C1 : REC(D3, F1);
+                         WHEN OTHERS =>
+                              C2 : INTEGER := IDENT_INT(0);
+                    END CASE;
+               END RECORD;
+     BEGIN
+          BEGIN
+               DECLARE
+                    X : CONS;
+               BEGIN
+                    IF X /= (11, 0) THEN
+                         FAILED ("WRONG VALUE FOR X - 11");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 11");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+                    BEGIN
+                         IF X /= (11, 0) THEN
+                              FAILED ("X VALUE WRONG - 12");
+                         END IF;
+                    END;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 12");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+                    X : ARR;
+               BEGIN
+                    IF X /= (1..5 => (11, 0)) THEN
+                         FAILED ("X VALUE INCORRECT - 13");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 13");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+                    X : NREC;
+               BEGIN
+                    IF X /= (C1 => (11, 0)) THEN
+                         FAILED ("X VALUE IS INCORRECT - 14");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 14");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS NEW CONS;
+                    X : NREC;
+               BEGIN
+                    IF X /= (11, 0) THEN
+                         FAILED ("X VALUE INCORRECT - 15");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 15");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+                    X : ACC_CONS := NEW CONS;
+               BEGIN
+                    IF X.ALL /= (11, 0) THEN
+                         FAILED ("X VALUE INCORRECT - 17");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 17");
+          END;
+     END;
+
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+          RESULT;
+
+END C37213F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213h.ada
new file mode 100644
index 000000000..e83ae07ca
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213h.ada
@@ -0,0 +1,457 @@
+-- C37213H.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, WHERE AN INDEX CONSTRAINT DEPENDS ON A RECORD
+--     DISCRIMINANT WITH A DEFAULT VALUE AND THE RECORD TYPE IS NOT
+--     EXPLICITLY CONSTRAINED, THAT THE NON-DISCRIMINANT EXPRESSIONS
+--     IN THE INDEX CONSTRAINT ARE:
+--          1) EVALUATED WHEN THE RECORD COMPONENT SUBTYPE DEFINITION
+--             IS ELABORATED,
+--          2) PROPERLY CHECKED FOR COMPATIBILITY ONLY IN AN ALLOCATION
+--             OR OBJECT DECLARATION AND ONLY IF THE DISCRIMINANT-
+--             DEPENDENT COMPONENT IS PRESENT IN THE SUBTYPE.
+
+-- HISTORY:
+--     JBG  10/17/86  CREATED ORIGINAL TEST.
+--     VCL  10/23/87  MODIFIED THIS HEADER; MODIFIED THE CHECK OF
+--                    SUBTYPE 'SCONS', IN BOTH SUBPARTS OF THE TEST,
+--                    TO INDICATE FAILURE IF CONSTRAINT_ERROR IS RAISED
+--                    FOR THE SUBTYPE DECLARATION AND FAILURE IF
+--                    CONSTRAINT_ERROR IS NOT RAISED FOR AN OBJECT
+--                    DECLARATION OF THIS SUBTYPE; RELOCATED THE CALL TO
+--                    REPORT.TEST SO THAT IT COMES BEFORE ANY
+--                    DECLARATIONS;  ADDED 'SEQUENCE_NUMBER' TO IDENTIFY
+--                    THE CURRENT SUBTEST (FOR EXCEPTIONS); CHANGE THE
+--                    TYPE OF THE DISCRIMINANT IN THE RECORD 'CONS'
+--                    TO AN INTEGER SUBTYPE.
+--     VCL  03/30/88  MODIFIED HEADER AND MESSAGES OUTPUT BY REPORT
+--                    PACKAGE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37213H IS
+BEGIN
+     TEST ("C37213H", "THE NON-DISCRIMINANT EXPRESSIONS OF AN " &
+                      "INDEX CONSTRAINT THAT DEPEND ON A " &
+                      "DISCRIMINANT WITH A DEFAULT VALUE ARE " &
+                      "PROPERLY EVALUATED AND CHECKED WHEN THE " &
+                      "RECORD TYPE IS NOT EXPLICITLY CONSTRAINED AND " &
+                      "THE COMPONENT IS AND IS NOT PRESENT IN THE " &
+                      "SUBTYPE");
+
+     DECLARE
+          SEQUENCE_NUMBER : INTEGER;
+
+          SUBTYPE DISCR IS INTEGER RANGE -50..50;
+          SUBTYPE SM IS INTEGER RANGE 1..10;
+          TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+
+          F1_CONS : INTEGER := 2;
+
+          FUNCTION CHK (
+               CONS    : INTEGER;
+               VALUE   : INTEGER;
+               MESSAGE : STRING) RETURN BOOLEAN IS
+          BEGIN
+               IF CONS /= VALUE THEN
+                    FAILED (MESSAGE & ": F1_CONS IS " &
+                            INTEGER'IMAGE(F1_CONS));
+               END IF;
+               RETURN TRUE;
+          END CHK;
+
+          FUNCTION F1 RETURN INTEGER IS
+          BEGIN
+               F1_CONS := F1_CONS - IDENT_INT(1);
+               RETURN F1_CONS;
+          END F1;
+     BEGIN
+
+
+-- CASE 1: DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT.
+
+          SEQUENCE_NUMBER :=1;
+          DECLARE
+               TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(F1..D3); -- F1 EVALUATED.
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(0);
+                         END CASE;
+                    END RECORD;
+
+               CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
+
+               X : CONS;                     -- F1 NOT EVALUATED AGAIN.
+               Y : CONS;                     -- F1 NOT EVALUATED AGAIN.
+
+               CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
+          BEGIN
+               IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN
+                    FAILED ("VALUES NOT CORRECT");
+               END IF;
+          END;
+
+
+          F1_CONS := 12;
+
+          SEQUENCE_NUMBER := 2;
+          DECLARE
+               TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..F1);
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(0);
+                         END CASE;
+                    END RECORD;
+          BEGIN
+               BEGIN
+                    DECLARE
+                         X : CONS;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT PERFORMED - 1");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("INCORRECT VALUES FOR X - 1");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+               END;
+
+               BEGIN
+                    DECLARE
+                         SUBTYPE SCONS IS CONS;
+                    BEGIN
+                         DECLARE
+                              X : SCONS;
+                         BEGIN
+                              FAILED ("INDEX CHECK NOT PERFORMED - 2");
+                              IF X /= (1, (1, 1)) THEN
+                                   COMMENT ("INCORRECT VALUES FOR X " &
+                                            "- 2");
+                              END IF;
+                         END;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                      "- 2A");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
+               END;
+
+               BEGIN
+                    DECLARE
+                         TYPE ARR IS ARRAY (1..5) OF CONS;
+                    BEGIN
+                         DECLARE
+                              X : ARR;
+                         BEGIN
+                              FAILED ("INDEX CHECK NOT PERFORMED - 3");
+                              IF X /= (1..5 => (1, (1, 1))) THEN
+                                   COMMENT ("INCORRECT VALUES FOR X " &
+                                            "- 3");
+                              END IF;
+                         END;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                      "- 3A");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");
+               END;
+
+               BEGIN
+                    DECLARE
+                         TYPE NREC IS
+                              RECORD
+                                   C1 : CONS;
+                              END RECORD;
+                    BEGIN
+                         DECLARE
+                              X : NREC;
+                         BEGIN
+                              FAILED ("INDEX CHECK NOT PERFORMED - 4");
+                              IF X /= (C1 => (1, (1, 1))) THEN
+                                   COMMENT ("INCORRECT VALUES FOR X " &
+                                            "- 4");
+                              END IF;
+                         END;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                      "- 4A");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");
+               END;
+
+               BEGIN
+                    DECLARE
+                         TYPE NREC IS NEW CONS;
+                    BEGIN
+                         DECLARE
+                              X : NREC;
+                         BEGIN
+                              FAILED ("INDEX CHECK NOT PERFORMED - 5");
+                              IF X /= (1, (1, 1)) THEN
+                                   COMMENT ("INCORRECT VALUES FOR X " &
+                                            "- 5");
+                              END IF;
+                         END;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                       "- 5A");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
+               END;
+
+               BEGIN
+                    DECLARE
+                         TYPE ACC_CONS IS ACCESS CONS;
+                    BEGIN
+                         DECLARE
+                              X : ACC_CONS;
+                         BEGIN
+                              X := NEW CONS;
+                              FAILED ("INDEX CHECK NOT PERFORMED - 6");
+                              IF X.ALL /= (1, (1, 1)) THEN
+                                   COMMENT ("INCORRECT VALUES FOR X " &
+                                            "- 6");
+                              END IF;
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   COMMENT ("UNEXPECTED EXCEPTION " &
+                                            "RAISED - 6A");
+                         END;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              COMMENT ("UNEXPECTED EXCEPTION RAISED " &
+                                       "- 6B");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
+               END;
+          END;
+
+
+-- CASE D2: DISCRIMINANT-DEPENDENT COMPONENT IS ABSENT.
+
+          F1_CONS := 2;
+
+          SEQUENCE_NUMBER := 3;
+          DECLARE
+               TYPE CONS (D3 : DISCR := IDENT_INT(-6)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..F1); -- F1 EVALUATED.
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(0);
+                         END CASE;
+                    END RECORD;
+               CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
+
+               X : CONS;                      -- F1 NOT EVALUATED AGAIN.
+               Y : CONS;                      -- F1 NOT EVALUATED AGAIN.
+
+               CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
+          BEGIN
+               IF X /= (-6, 0) OR Y /= (-6, 0) THEN
+                    FAILED ("VALUES NOT CORRECT");
+               END IF;
+          END;
+
+          F1_CONS := 12;
+
+          SEQUENCE_NUMBER := 4;
+          DECLARE
+               TYPE CONS (D3 : DISCR := IDENT_INT(11)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..F1);
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(0);
+                         END CASE;
+                    END RECORD;
+          BEGIN
+               BEGIN
+                    DECLARE
+                         X : CONS;
+                    BEGIN
+                         IF X /= (11, 0) THEN
+                              FAILED ("X VALUE IS INCORRECT - 11");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
+               END;
+
+               BEGIN
+                    DECLARE
+                         SUBTYPE SCONS IS CONS;
+                    BEGIN
+                         DECLARE
+                              X : SCONS;
+                         BEGIN
+                              IF X /= (11, 0) THEN
+                                   FAILED ("X VALUE INCORRECT - 12");
+                              END IF;
+                         END;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
+                                      "12A");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
+               END;
+
+               BEGIN
+                    DECLARE
+                         TYPE ARR IS ARRAY (1..5) OF CONS;
+                    BEGIN
+                         DECLARE
+                              X : ARR;
+                         BEGIN
+                              IF X /= (1..5 => (11, 0)) THEN
+                                   FAILED ("X VALUE INCORRECT - 13");
+                              END IF;
+                         END;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
+                                      "13A");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
+               END;
+
+               BEGIN
+                    DECLARE
+                         TYPE NREC IS
+                              RECORD
+                                   C1 : CONS;
+                              END RECORD;
+                    BEGIN
+                         DECLARE
+                              X : NREC;
+                         BEGIN
+                              IF X /= (C1 => (11, 0)) THEN
+                                   FAILED ("X VALUE INCORRECT - 14");
+                              END IF;
+                         END;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
+                                      "14A");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
+               END;
+
+               BEGIN
+                    DECLARE
+                         TYPE NREC IS NEW CONS;
+                    BEGIN
+                         DECLARE
+                              X : NREC;
+                         BEGIN
+                              IF X /= (11, 0) THEN
+                                   FAILED ("X VALUE INCORRECT - 15");
+                              END IF;
+                         END;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
+                                      "15A");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
+               END;
+
+               BEGIN
+                    DECLARE
+                         TYPE ACC_CONS IS ACCESS CONS;
+                         X : ACC_CONS;
+                    BEGIN
+                         X := NEW CONS;
+                         IF X.ALL /= (11, 0) THEN
+                              FAILED ("X VALUE INCORRECT - 17");
+                         END IF;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
+                                      "17A");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                          FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
+               END;
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("INDEX VALUES IMPROPERLY CHECKED - " &
+                       INTEGER'IMAGE (SEQUENCE_NUMBER));
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                       INTEGER'IMAGE (SEQUENCE_NUMBER));
+     END;
+
+     RESULT;
+END C37213H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213j.ada
new file mode 100644
index 000000000..f09d853c2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213j.ada
@@ -0,0 +1,320 @@
+-- C37213J.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, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN
+--     INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE
+--     RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE AN
+--     OBJECT OR A SUBTYPE, THAT THE NON-DISCRIMINANT EXPRESSIONS
+--     OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY:
+--          1) ONLY IN AN OBJECT DECLARATION, AND
+--          2) ONLY IF THE DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT
+--             IN THE SUBTYPE.
+
+-- HISTORY:
+--     JBG  10/17/86  CREATED ORIGINAL TEST.
+--     VCL  10/23/87  MODIFIED THIS HEADER; SEPARATED THIS TEST INTO
+--                    3 NEW TESTS (J,K,L); CHANGED THE AGGREGATE FOR
+--                    THE PARAMETER 'VALUE' IN THE CALL OF PROCEDURE
+--                    'SUBTYPE_CHK1';  MOVED THE CALL TO REPORT.TEST
+--                    SO THAT IT COMES BEFORE ANY DECLARATIONS; ADDED
+--                    A SEQUENCE COUNTER TO IDENTIFY WHICH SUBTEST
+--                    DECLARATION PART RAISES CONSTRAINT_ERROR.
+--     VCL  03/28/88  MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY
+--                    DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL
+--                    PARAMETERS TO THE GENERIC UNITS AND THE
+--                    CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE
+--                    TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE
+--                    ARE TOGETHER.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37213J IS
+BEGIN
+     TEST ("C37213J", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
+                      "OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
+                      "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
+                      "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
+                      "USED AS THE ACTUAL PARAMETER TO A GENERIC " &
+                      "FORMAL TYPE USED TO DECLARE AN OBJECT OR A " &
+                      "SUBTYPE");
+
+     DECLARE
+          SUBTYPE SM IS INTEGER RANGE 1..10;
+          TYPE REC (D1, D2 : SM) IS
+               RECORD NULL; END RECORD;
+          TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+
+          SEQUENCE_NUMBER : INTEGER;
+
+          GENERIC
+               TYPE CONS IS PRIVATE;
+               OBJ_XCP : BOOLEAN;
+               TAG     : STRING;
+          PACKAGE OBJ_CHK IS END OBJ_CHK;
+
+          GENERIC
+               TYPE CONS IS PRIVATE;
+          PROCEDURE SUBTYP_CHK (OBJ_XCP : BOOLEAN;
+                                TAG     : STRING);
+
+          PACKAGE BODY OBJ_CHK IS
+          BEGIN          -- DECLARE AN OBJECT OF THE FORMAL TYPE.
+               DECLARE
+                    X : CONS;
+
+                    FUNCTION VALUE RETURN CONS IS
+                    BEGIN
+                         IF EQUAL (3,3) THEN
+                              RETURN X;
+                         ELSE
+                              RETURN X;
+                         END IF;
+                    END VALUE;
+               BEGIN
+                    IF OBJ_XCP THEN
+                         FAILED ("NO CHECK DURING DECLARATION " &
+                                 "OF OBJECT OF TYPE CONS - " & TAG);
+                    ELSIF X /= VALUE THEN
+                         FAILED ("INCORRECT VALUE FOR OBJECT OF " &
+                                 "TYPE CONS - " & TAG);
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT OBJ_XCP THEN
+                         FAILED ("IMPROPER CONSTRAINT CHECKED " &
+                                 "DURING DECLARATION OF OBJECT " &
+                                 "OF TYPE CONS - " & TAG);
+                    END IF;
+          END OBJ_CHK;
+
+          PROCEDURE SUBTYP_CHK (OBJ_XCP : BOOLEAN;
+                                TAG     : STRING)    IS
+          BEGIN          -- DECLARE A SUBTYPE OF THE FORMAL TYPE.
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+
+                         FUNCTION VALUE RETURN SCONS IS
+                         BEGIN
+                              IF EQUAL (5, 5) THEN
+                                   RETURN X;
+                              ELSE
+                                   RETURN X;
+                              END IF;
+                         END VALUE;
+                    BEGIN
+                         IF OBJ_XCP THEN
+                              FAILED ("NO CHECK DURING DECLARATION " &
+                                      "OF OBJECT OF SUBTYPE SCONS - " &
+                                      TAG);
+                         ELSIF X /= VALUE THEN
+                              FAILED ("INCORRECT VALUE FOR OBJECT " &
+                                      "OF SUBTYPE SCONS - " & TAG);
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         IF NOT OBJ_XCP THEN
+                              FAILED ("IMPROPER CONSTRAINT CHECKED " &
+                                      "DURING DECLARATION OF OBJECT " &
+                                      "OF SUBTYPE SCONS - " & TAG);
+                         END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                            "DURING SUBTYPE DECLARATION - " & TAG);
+          END SUBTYP_CHK;
+     BEGIN
+          SEQUENCE_NUMBER := 1;
+          DECLARE
+               TYPE REC_DEF (D3 : INTEGER := 1) IS
+                    RECORD
+                         C1 : REC (D3, 0);
+                    END RECORD;
+
+               PACKAGE PACK1 IS NEW OBJ_CHK (REC_DEF,
+                         OBJ_XCP => TRUE,
+                         TAG     => "PACK1");
+
+               PROCEDURE PROC1 IS NEW SUBTYP_CHK (REC_DEF);
+          BEGIN
+               PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
+          END;
+
+          SEQUENCE_NUMBER := 2;
+          DECLARE
+               TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
+                    RECORD
+                         C1 : MY_ARR (0..D3);
+                    END RECORD;
+
+               PACKAGE PACK2 IS NEW OBJ_CHK (ARR_DEF,
+                         OBJ_XCP => TRUE,
+                         TAG     => "PACK2");
+
+               PROCEDURE PROC2 IS NEW SUBTYP_CHK (ARR_DEF);
+          BEGIN
+               PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
+          END;
+
+
+          SEQUENCE_NUMBER := 3;
+          DECLARE
+               TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : REC (D3, IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK3 IS NEW OBJ_CHK (VAR_REC_DEF1,
+                              OBJ_XCP => TRUE,
+                              TAG     => "PACK3");
+
+               PROCEDURE PROC3 IS NEW SUBTYP_CHK (VAR_REC_DEF1);
+          BEGIN
+               PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
+          END;
+
+          SEQUENCE_NUMBER := 4;
+          DECLARE
+               TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : REC (D3, IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK4 IS NEW OBJ_CHK (VAR_REC_DEF6,
+                              OBJ_XCP => FALSE,
+                              TAG     => "PACK4");
+
+               PROCEDURE PROC4 IS NEW SUBTYP_CHK (VAR_REC_DEF6);
+          BEGIN
+               PROC4 (OBJ_XCP => FALSE,TAG => "PROC4");
+          END;
+
+          SEQUENCE_NUMBER := 5;
+          DECLARE
+               TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : REC (D3, IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK5 IS NEW OBJ_CHK (VAR_REC_DEF11,
+                              OBJ_XCP => FALSE,
+                              TAG     => "PACK5");
+
+               PROCEDURE PROC5 IS NEW SUBTYP_CHK (VAR_REC_DEF11);
+          BEGIN
+               PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
+          END;
+
+          SEQUENCE_NUMBER := 6;
+          DECLARE
+               TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK6 IS NEW OBJ_CHK (VAR_ARR_DEF1,
+                              OBJ_XCP => TRUE,
+                              TAG     => "PACK6");
+
+               PROCEDURE PROC6 IS NEW SUBTYP_CHK (VAR_ARR_DEF1);
+          BEGIN
+               PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
+          END;
+
+          SEQUENCE_NUMBER := 7;
+          DECLARE
+               TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK7 IS NEW OBJ_CHK (VAR_ARR_DEF6,
+                              OBJ_XCP => FALSE,
+                              TAG     => "PACK7");
+
+               PROCEDURE PROC7 IS NEW SUBTYP_CHK (VAR_ARR_DEF6);
+          BEGIN
+               PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
+          END;
+
+          SEQUENCE_NUMBER := 8;
+          DECLARE
+               TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK8 IS NEW OBJ_CHK (VAR_ARR_DEF11,
+                              OBJ_XCP => FALSE,
+                              TAG     => "PACK8");
+
+               PROCEDURE PROC8 IS NEW SUBTYP_CHK (VAR_ARR_DEF11);
+          BEGIN
+               PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
+          END;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED DURING DECLARATION / " &
+                       "INSTANTIATION ELABORATION - " &
+                       INTEGER'IMAGE(SEQUENCE_NUMBER));
+     END;
+
+     RESULT;
+END C37213J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213k.ada
new file mode 100644
index 000000000..d5b5dc38d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213k.ada
@@ -0,0 +1,324 @@
+-- C37213K.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, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN
+--     INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE
+--     RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE AN
+--     ARRAY OR RECORD COMPONENT, THAT THE NON-DISCRIMINANT EXPRESSIONS
+--     OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY:
+--          1) ONLY IN AN OBJECT DECLARATION, AND
+--          2) ONLY IF THE DESCRIMINANT-DEPENDENT COMPONENT IS PRESENT
+--             IN THE SUBTYPE.
+
+-- HISTORY:
+--     VCL  10/23/88  CREATED ORIGINAL TEST BY SPLITTING FROM C37213J.
+--     VCL  03/30/88  MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY
+--                    DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL
+--                    PARAMETERS TO THE GENERIC UNITS AND THE
+--                    CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE
+--                    TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE
+--                    ARE TOGETHER;  REWROTE ONE OF THE GENERIC
+--                    PACKAGES AS A GENERIC PROCEDURE TO BROADEN
+--                    COVERAGE OF TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37213K IS
+BEGIN
+     TEST ("C37213K", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
+                      "OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
+                      "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
+                      "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
+                      "USED AS THE ACTUAL PARAMETER TO A GENERIC " &
+                      "FORMAL TYPE USED TO DECLARE AN ARRAY OR A " &
+                      "RECORD COMPONENT");
+
+     DECLARE
+          SUBTYPE SM IS INTEGER RANGE 1..10;
+          TYPE REC (D1, D2 : SM) IS
+               RECORD NULL; END RECORD;
+          TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+
+          SEQUENCE_NUMBER : INTEGER;
+
+          GENERIC
+               TYPE CONS IS PRIVATE;
+               OBJ_XCP : BOOLEAN;
+               TAG     : STRING;
+          PACKAGE ARRAY_COMP_CHK IS END ARRAY_COMP_CHK;
+
+          PACKAGE BODY ARRAY_COMP_CHK IS
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+               BEGIN
+                    DECLARE
+                         X : ARR;
+
+                         FUNCTION VALUE RETURN ARR IS
+                         BEGIN
+                              IF EQUAL (3,3) THEN
+                                   RETURN X;
+                              ELSE
+                                   RETURN X;
+                              END IF;
+                         END VALUE;
+                    BEGIN
+                         IF OBJ_XCP THEN
+                              FAILED ("NO CHECK DURING DECLARATION " &
+                                      "OF OBJECT OF TYPE ARR - " & TAG);
+                         ELSIF X /= VALUE THEN
+                              FAILED ("INCORRECT VALUE FOR OBJECT OF " &
+                                      "TYPE ARR - " & TAG);
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         IF NOT OBJ_XCP THEN
+                              FAILED ("IMPROPER CONSTRAINT CHECKED " &
+                                      "DURING DECLARATION OF OBJECT " &
+                                      "OF TYPE ARR - " & TAG);
+                         END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                            "DURING DECLARATION OF ARR - " & TAG);
+          END ARRAY_COMP_CHK;
+
+          GENERIC
+               TYPE CONS IS PRIVATE;
+          PROCEDURE REC_COMP_CHK (OBJ_XCP : BOOLEAN;
+                                  TAG     : STRING);
+
+          PROCEDURE REC_COMP_CHK (OBJ_XCP : BOOLEAN;
+                                  TAG     : STRING)   IS
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+
+                         FUNCTION VALUE RETURN NREC IS
+                         BEGIN
+                              IF EQUAL (5, 5) THEN
+                                   RETURN X;
+                              ELSE
+                                   RETURN X;
+                              END IF;
+                         END VALUE;
+                    BEGIN
+                         IF OBJ_XCP THEN
+                              FAILED ("NO CHECK DURING DECLARATION " &
+                                      "OF OBJECT OF TYPE NREC - " &
+                                      TAG);
+                         ELSIF X /= VALUE THEN
+                              FAILED ("INCORRECT VALUE FOR OBJECT " &
+                                      "OF TYPE NREC - " & TAG);
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         IF NOT OBJ_XCP THEN
+                              FAILED ("IMPROPER CONSTRAINT CHECKED " &
+                                      "DURING DECLARATION OF OBJECT " &
+                                      "OF TYPE NREC - " & TAG);
+                         END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                            "DURING DECLARATION OF NREC - " & TAG);
+          END;
+     BEGIN
+          SEQUENCE_NUMBER := 1;
+          DECLARE
+               TYPE REC_DEF (D3 : INTEGER := 1) IS
+                    RECORD
+                         C1 : REC (D3, 0);
+                    END RECORD;
+
+               PACKAGE PACK1 IS NEW ARRAY_COMP_CHK (REC_DEF,
+                                  OBJ_XCP => TRUE,
+                                  TAG     => "PACK1");
+
+               PROCEDURE PROC1 IS NEW REC_COMP_CHK (REC_DEF);
+          BEGIN
+               PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
+          END;
+
+          SEQUENCE_NUMBER := 2;
+          DECLARE
+               TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
+                    RECORD
+                         C1 : MY_ARR (0..D3);
+                    END RECORD;
+
+               PACKAGE PACK2 IS NEW ARRAY_COMP_CHK (ARR_DEF,
+                                  OBJ_XCP => TRUE,
+                                  TAG     => "PACK2");
+
+               PROCEDURE PROC2 IS NEW REC_COMP_CHK (ARR_DEF);
+          BEGIN
+               PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
+          END;
+
+          SEQUENCE_NUMBER := 3;
+          DECLARE
+               TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : REC (D3, IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK3 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF1,
+                                  OBJ_XCP => TRUE,
+                                  TAG     => "PACK3");
+
+               PROCEDURE PROC3 IS NEW REC_COMP_CHK (VAR_REC_DEF1);
+          BEGIN
+               PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
+          END;
+
+          SEQUENCE_NUMBER := 4;
+          DECLARE
+               TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : REC (D3, IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK4 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF6,
+                                  OBJ_XCP => FALSE,
+                                  TAG     => "PACK4");
+
+               PROCEDURE PROC4 IS NEW REC_COMP_CHK (VAR_REC_DEF6);
+          BEGIN
+               PROC4 (OBJ_XCP => FALSE, TAG => "PROC4");
+          END;
+
+          SEQUENCE_NUMBER := 5;
+          DECLARE
+               TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : REC (D3, IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK5 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF11,
+                                  OBJ_XCP => FALSE,
+                                  TAG     => "PACK5");
+
+               PROCEDURE PROC5 IS NEW REC_COMP_CHK (VAR_REC_DEF11);
+          BEGIN
+               PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
+          END;
+
+          SEQUENCE_NUMBER := 6;
+          DECLARE
+               TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK6 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF1,
+                                  OBJ_XCP => TRUE,
+                                  TAG     => "PACK6");
+
+               PROCEDURE PROC6 IS NEW REC_COMP_CHK (VAR_ARR_DEF1);
+          BEGIN
+               PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
+          END;
+
+          SEQUENCE_NUMBER := 7;
+          DECLARE
+               TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK7 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF6,
+                                  OBJ_XCP => FALSE,
+                                  TAG     => "PACK7");
+
+               PROCEDURE PROC7 IS NEW REC_COMP_CHK (VAR_ARR_DEF6);
+          BEGIN
+               PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
+          END;
+
+          SEQUENCE_NUMBER := 8;
+          DECLARE
+               TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK8 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF11,
+                                  OBJ_XCP => FALSE,
+                                  TAG     => "PACK8");
+
+               PROCEDURE PROC8 IS NEW REC_COMP_CHK (VAR_ARR_DEF11);
+          BEGIN
+               PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
+                       "DECLARATION / INSTANTIATION ELABORATION - " &
+                       INTEGER'IMAGE (SEQUENCE_NUMBER));
+     END;
+
+     RESULT;
+END C37213K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213l.ada
new file mode 100644
index 000000000..07bd124f4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37213l.ada
@@ -0,0 +1,329 @@
+-- C37213L.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, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN
+--     INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE
+--     RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE A
+--     DERIVED OR AN ACCESS TYPE, THAT THE NON-DISCRIMINANT EXPRESSIONS
+--     OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY:
+--          1) ONLY IN AN OBJECT DECLARATION OR ALLOCATOR, AND
+--          2) ONLY IF THE DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT
+--             IN THE SUBTYPE.
+
+-- HISTORY:
+--     VCL  10/23/88  CREATED ORIGINAL TEST BY SPLITTING FROM C37213J.
+--     VCL  03/30/88  MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY
+--                    DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL
+--                    PARAMETERS TO THE GENERIC UNITS AND THE
+--                    CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE
+--                    TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE
+--                    ARE TOGETHER;  REWROTE ONE OF THE GENERIC
+--                    PACKAGES AS A GENERIC PROCEDURE TO BROADEN
+--                    COVERAGE OF TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37213L IS
+BEGIN
+     TEST ("C37213L", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " &
+                      "OR AN INDEX CONSTRAINT THAT DEPEND ON A " &
+                      "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " &
+                      "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " &
+                      "USED AS THE ACTUAL PARAMETER TO A GENERIC " &
+                      "FORMAL TYPE USED TO DECLARE A DERIVED OR AN " &
+                      "ACCESS TYPE");
+
+     DECLARE
+          SUBTYPE SM IS INTEGER RANGE 1..10;
+          TYPE REC (D1, D2 : SM) IS
+               RECORD NULL; END RECORD;
+          TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+
+          SEQUENCE_NUMBER : INTEGER;
+
+          GENERIC
+               TYPE CONS IS PRIVATE;
+               OBJ_XCP : BOOLEAN;
+               TAG     : STRING;
+          PACKAGE DER_CHK IS  END DER_CHK;
+
+          PACKAGE BODY DER_CHK IS
+          BEGIN
+               DECLARE
+                    TYPE DREC IS NEW CONS;
+               BEGIN
+                    DECLARE
+                         X : DREC;
+
+                         FUNCTION VALUE RETURN DREC IS
+                         BEGIN
+                              IF EQUAL (3,3) THEN
+                                   RETURN X;
+                              ELSE
+                                   RETURN X;
+                              END IF;
+                         END VALUE;
+                    BEGIN
+                         IF OBJ_XCP THEN
+                              FAILED ("NO CHECK DURING DECLARATION " &
+                                      "OF OBJECT OF TYPE DREC - " &
+                                      TAG);
+                         ELSIF X /= VALUE THEN
+                              FAILED ("INCORRECT VALUE FOR OBJECT OF " &
+                                      "TYPE DREC - " & TAG);
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         IF NOT OBJ_XCP THEN
+                              FAILED ("IMPROPER CONSTRAINT CHECKED " &
+                                      "DURING DECLARATION OF OBJECT " &
+                                      "OF TYPE DREC - " & TAG);
+                         END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                            "DURING DECLARATION OF DREC - " & TAG);
+          END;
+
+          GENERIC
+               TYPE CONS IS PRIVATE;
+          PROCEDURE ACC_CHK (OBJ_XCP : BOOLEAN;
+                             TAG     : STRING);
+
+          PROCEDURE ACC_CHK (OBJ_XCP : BOOLEAN;
+                             TAG     : STRING)  IS
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+               BEGIN
+                    DECLARE
+                         X : ACC_CONS;
+
+                         FUNCTION VALUE RETURN CONS IS
+                         BEGIN
+                              IF EQUAL (5, 5) THEN
+                                   RETURN X.ALL;
+                              ELSE
+                                   RETURN X.ALL;
+                              END IF;
+                         END VALUE;
+                    BEGIN
+                         X := NEW CONS;
+
+                         IF OBJ_XCP THEN
+                              FAILED ("NO CHECK DURING ALLOCATION " &
+                                      "OF OBJECT OF TYPE CONS - " &
+                                      TAG);
+                         ELSIF X.ALL /= VALUE THEN
+                              FAILED ("INCORRECT VALUE FOR OBJECT " &
+                                      "OF TYPE CONS - " & TAG);
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              IF NOT OBJ_XCP THEN
+                                   FAILED ("IMPROPER CONSTRAINT " &
+                                           "CHECKED DURING " &
+                                           "ALLOCATION OF OBJECT " &
+                                           "OF TYPE CONS - " & TAG);
+                              END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                                 "DURING DECLARATION OF X - " & TAG);
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT IMPROPERLY CHECKED " &
+                            "DURING DECLARATION OF ACC_CONS - " & TAG);
+          END ACC_CHK;
+     BEGIN
+          SEQUENCE_NUMBER := 1;
+          DECLARE
+               TYPE REC_DEF (D3 : INTEGER := 1) IS
+                    RECORD
+                         C1 : REC (D3, 0);
+                    END RECORD;
+
+               PACKAGE PACK1 IS NEW DER_CHK (REC_DEF,
+                                  OBJ_XCP => TRUE,
+                                  TAG     => "PACK1");
+
+               PROCEDURE PROC1 IS NEW ACC_CHK (REC_DEF);
+          BEGIN
+               PROC1 (OBJ_XCP => TRUE, TAG => "PROC1");
+          END;
+
+          SEQUENCE_NUMBER := 2;
+          DECLARE
+               TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS
+                    RECORD
+                         C1 : MY_ARR (0..D3);
+                    END RECORD;
+
+               PACKAGE PACK2 IS NEW DER_CHK (ARR_DEF,
+                                  OBJ_XCP => TRUE,
+                                  TAG     => "PACK2");
+
+               PROCEDURE PROC2 IS NEW ACC_CHK (ARR_DEF);
+          BEGIN
+               PROC2 (OBJ_XCP => TRUE, TAG => "PROC2");
+          END;
+
+          SEQUENCE_NUMBER := 3;
+          DECLARE
+               TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : REC (D3, IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK3 IS NEW DER_CHK (VAR_REC_DEF1,
+                                  OBJ_XCP => TRUE,
+                                  TAG     => "PACK3");
+
+               PROCEDURE PROC3 IS NEW ACC_CHK (VAR_REC_DEF1);
+          BEGIN
+               PROC3 (OBJ_XCP => TRUE, TAG => "PROC3");
+          END;
+
+          SEQUENCE_NUMBER := 4;
+          DECLARE
+               TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : REC (D3, IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK4 IS NEW DER_CHK (VAR_REC_DEF6,
+                                  OBJ_XCP => FALSE,
+                                  TAG     => "PACK4");
+
+               PROCEDURE PROC4 IS NEW ACC_CHK (VAR_REC_DEF6);
+          BEGIN
+               PROC4 (OBJ_XCP => FALSE, TAG => "PROC4");
+          END;
+
+          SEQUENCE_NUMBER := 5;
+          DECLARE
+               TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : REC (D3, IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK5 IS NEW DER_CHK (VAR_REC_DEF11,
+                                  OBJ_XCP => FALSE,
+                                  TAG     => "PACK5");
+
+               PROCEDURE PROC5 IS NEW ACC_CHK (VAR_REC_DEF11);
+          BEGIN
+               PROC5 (OBJ_XCP => FALSE, TAG => "PROC5");
+          END;
+
+          SEQUENCE_NUMBER := 6;
+          DECLARE
+               TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK6 IS NEW DER_CHK (VAR_ARR_DEF1,
+                                  OBJ_XCP => TRUE,
+                                  TAG     => "PACK6");
+
+               PROCEDURE PROC6 IS NEW ACC_CHK (VAR_ARR_DEF1);
+          BEGIN
+               PROC6 (OBJ_XCP => TRUE, TAG => "PROC6");
+          END;
+
+          SEQUENCE_NUMBER := 7;
+          DECLARE
+               TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK7 IS NEW DER_CHK (VAR_ARR_DEF6,
+                                  OBJ_XCP => FALSE,
+                                  TAG     => "PACK7");
+
+               PROCEDURE PROC7 IS NEW ACC_CHK (VAR_ARR_DEF6);
+          BEGIN
+               PROC7 (OBJ_XCP => FALSE, TAG => "PROC7");
+          END;
+
+          SEQUENCE_NUMBER := 8;
+          DECLARE
+               TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS
+                    RECORD
+                         CASE D3 IS
+                              WHEN -5..10 =>
+                                   C1 : MY_ARR(D3..IDENT_INT(11));
+                              WHEN OTHERS =>
+                                   C2 : INTEGER := IDENT_INT(5);
+                         END CASE;
+                    END RECORD;
+
+               PACKAGE PACK8 IS NEW DER_CHK (VAR_ARR_DEF11,
+                                  OBJ_XCP => FALSE,
+                                  TAG     => "PACK8");
+
+               PROCEDURE PROC8 IS NEW ACC_CHK (VAR_ARR_DEF11);
+          BEGIN
+               PROC8 (OBJ_XCP => FALSE, TAG => "PROC8");
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
+                       "DECLARATION / INSTANTIATION ELABORATION - " &
+                       INTEGER'IMAGE (SEQUENCE_NUMBER));
+     END;
+
+     RESULT;
+END C37213L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215b.ada
new file mode 100644
index 000000000..408804e17
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215b.ada
@@ -0,0 +1,203 @@
+-- C37215B.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 DISCRIMINANT CONSTRAINT
+-- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
+-- COMPATIBILITY WHEN THE RECORD TYPE IS:
+--
+--   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+--      DECLARATION.
+
+-- JBG 10/17/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37215B IS
+
+     SUBTYPE SM IS INTEGER RANGE 1..10;
+
+     TYPE REC (D1, D2 : SM) IS
+          RECORD NULL; END RECORD;
+
+BEGIN
+     TEST ("C37215B", "CHECK COMPATIBILITY OF DISCRIMINANT EXPRESSIONS"&
+                      " WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                      "AND DISCRIMINANTS HAVE DEFAULTS");
+
+-- CASE B
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
+               RECORD
+                    C1 : REC(D3, 1);
+               END RECORD;
+     BEGIN
+          BEGIN
+               DECLARE
+                    X : CONS;
+               BEGIN
+                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
+                    IF X /= (1, (1, 1)) THEN
+                         COMMENT ("SHOULDN'T GET HERE");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 1");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+                    X : ACC_CONS;
+               BEGIN
+                    X := NEW CONS;
+                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
+                    BEGIN
+                         IF X.ALL /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 3");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+               BEGIN
+                    DECLARE
+                         X : ARR;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 4");
+                         IF X /= (1..5 => (1, (1, 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 5");
+                         IF X /= (C1 => (1, (1, 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE DREC IS NEW CONS;
+               BEGIN
+                    DECLARE
+                         X : DREC;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 6");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+          END;
+
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+          RESULT;
+
+END C37215B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215d.ada
new file mode 100644
index 000000000..3eefc5378
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215d.ada
@@ -0,0 +1,202 @@
+-- C37215D.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
+--        AN INDEX CONSTRAINT
+-- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
+-- COMPATIBILITY WHEN THE RECORD TYPE IS:
+--
+--   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+--      DECLARATION.
+
+-- JBG 10/17/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37215D IS
+
+     SUBTYPE SM IS INTEGER RANGE 1..10;
+
+     TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+
+BEGIN
+     TEST ("C37215D", "CHECK COMPATIBILITY OF INDEX BOUNDS " &
+                      "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                      "AND DISCRIMINANTS HAVE DEFAULTS");
+
+-- CASE B
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
+               RECORD
+                    C1 : MY_ARR(2..D3);
+               END RECORD;
+     BEGIN
+          BEGIN
+               DECLARE
+                    X : CONS;
+               BEGIN
+                    FAILED ("INDEX CHECK NOT PERFORMED - 1");
+                    IF X /= (1, (1, 1)) THEN
+                         COMMENT ("SHOULDN'T GET HERE");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 1");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+                    X : ACC_CONS;
+               BEGIN
+                    X := NEW CONS;
+                    FAILED ("INDEX CHECK NOT PERFORMED - 2");
+                    BEGIN
+                         IF X.ALL /= (1, (1 => 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT " &
+                                 "PERFORMED - 3");
+                         IF X /= (1, (1 => 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+               BEGIN
+                    DECLARE
+                         X : ARR;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT " &
+                                 "PERFORMED - 4");
+                         IF X /= (1..5 => (1, (1 => 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT " &
+                                 "PERFORMED - 5");
+                         IF X /= (C1 => (1, (1 => 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE DREC IS NEW CONS;
+               BEGIN
+                    DECLARE
+                         X : DREC;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT " &
+                                 "PERFORMED - 6");
+                         IF X /= (1, (1 => 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+          END;
+
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+          RESULT;
+
+END C37215D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215f.ada
new file mode 100644
index 000000000..1f34c4eae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215f.ada
@@ -0,0 +1,313 @@
+-- C37215F.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 DISCRIMINANT CONSTRAINT
+-- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
+-- COMPATIBILITY WHEN THE RECORD TYPE IS:
+--
+--   CASE D: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
+--      DECLARATION AND THE COMPONENT IS PRESENT IN THE DEFAULT SUBTYPE.
+
+-- JBG 10/17/86
+-- PWN 05/31/96  Corrected format of call to "TEST" 
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37215F IS
+
+     SUBTYPE SM IS INTEGER RANGE 1..10;
+
+     TYPE REC (D1, D2 : SM) IS
+          RECORD NULL; END RECORD;
+
+BEGIN
+     TEST ("C37215F", "CHECK EVALUATION OF DISCRIMINANT EXPRESSIONS " &
+                      "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
+                      "DISCRIMINANTS HAVE DEFAULTS, AND COMPONENT " &
+                      "SUBTYPE DETERMINES WHETHER CONSTRAINT SHOULD " &
+                      "BE CHECKED");
+
+-- CASE D1: COMPONENT IS PRESENT
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := IDENT_INT(0)) IS
+               RECORD
+                    CASE D3 IS
+                         WHEN -5..10 =>
+                              C1 : REC(D3, 1);
+                         WHEN OTHERS =>
+                              C2 : INTEGER := IDENT_INT(0);
+                    END CASE;
+               END RECORD;
+     BEGIN
+          BEGIN
+               DECLARE
+                    X : CONS;
+               BEGIN
+                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
+                    IF X /= (1, (1, 1)) THEN
+                         COMMENT ("SHOULDN'T GET HERE");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 1");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+                    X : ACC_CONS;
+               BEGIN
+                    X := NEW CONS;
+                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
+                    IF X.ALL /= (1, (1, 1)) THEN
+                         COMMENT ("IRRELEVANT");
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 3");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+               BEGIN
+                    DECLARE
+                         X : ARR;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 4");
+                         IF X /= (1..5 => (1, (1, 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 5");
+                         IF X /= (C1 => (1, (1, 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE DREC IS NEW CONS;
+               BEGIN
+                    DECLARE
+                         X : DREC;
+                    BEGIN
+                         FAILED ("DISCRIMINANT CHECK NOT " &
+                                 "PERFORMED - 6");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
+          END;
+
+     END;
+
+-- CASE C2 : COMPONENT IS ABSENT
+
+     DECLARE
+          TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
+               RECORD
+                    CASE D3 IS
+                         WHEN -5..10 =>
+                              C1 : REC(D3, IDENT_INT(1));
+                         WHEN OTHERS =>
+                              C2 : INTEGER := IDENT_INT(5);
+                    END CASE;
+               END RECORD;
+     BEGIN
+          BEGIN
+               DECLARE
+                    X : CONS;
+               BEGIN
+                    IF X /= (11, 5) THEN
+                         FAILED ("WRONG VALUE FOR X - 11");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 11");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+                    BEGIN
+                         IF X /= (11, 5) THEN
+                              FAILED ("X VALUE WRONG - 12");
+                         END IF;
+                    END;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 12");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+                    X : ARR;
+               BEGIN
+                    IF X /= (1..5 => (11, 5)) THEN
+                         FAILED ("X VALUE INCORRECT - 13");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 13");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+                    X : NREC;
+               BEGIN
+                    IF X /= (C1 => (11, 5)) THEN
+                         FAILED ("X VALUE IS INCORRECT - 14");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 14");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS NEW CONS;
+                    X : NREC;
+               BEGIN
+                    IF X /= (11, 5) THEN
+                         FAILED ("X VALUE INCORRECT - 15");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 15");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+                    X : ACC_CONS := NEW CONS;
+               BEGIN
+                    IF X.ALL /= (11, 5) THEN
+                         FAILED ("X VALUE INCORRECT - 17");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NONEXISTENT CONSTRAINT CHECKED - 17");
+          END;
+     END;
+
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
+          RESULT;
+
+END C37215F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215h.ada
new file mode 100644
index 000000000..c98180a3c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37215h.ada
@@ -0,0 +1,345 @@
+-- C37215H.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 AN INDEX CONSTRAINT DEPENDS ON A DISCRIMINANT,
+--      THE DISCRIMINANT VALUE IS CHECKED FOR COMPATIBILITY WHEN THE
+--      RECORD TYPE IS:
+--
+--           CASE D: CONSTRAINED BY DEFAULT AND THE COMPONENT IS
+--                   PRESENT IN THE SUBTYPE.
+
+-- HISTORY:
+--      JBG 10/17/86  CREATED ORIGINAL TEST.
+--      RJW 10/13/87  CORRECTED VARIOUS CONSTRAINT ERRORS IN 'CASE D1'.
+--      VCL 03/30/88  CORRECTED VARIOUS CONSTRAINT ERRORS WITH TYPE
+--                    DECLARATIONS THROUGHOUT THE TEST.  ADDED SEQUENCE
+--                    NUMBERS.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37215H IS
+
+     SUBTYPE SM IS INTEGER RANGE 1..10;
+     TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
+
+     SEQUENCE_NUMBER : INTEGER;
+BEGIN
+     TEST ("C37215H", "THE DISCRIMINANT VALUES OF AN INDEX " &
+                      "CONSTRAINT ARE PROPERLY CHECK FOR " &
+                      "COMPATIBILITY WHEN THE DISCRIMINANT IS " &
+                      "DEFINED BY DEFAULT AND THE COMPONENT IS AND " &
+                      "IS NOT PRESENT IN THE SUBTYPE");
+
+-- CASE D1: COMPONENT IS PRESENT
+
+     SEQUENCE_NUMBER := 1;
+     DECLARE
+          TYPE CONS (D3 : INTEGER := IDENT_INT(0)) IS
+               RECORD
+                    CASE D3 IS
+                         WHEN -5..10 =>
+                              C1 : MY_ARR(D3..1);
+                         WHEN OTHERS =>
+                              C2 : INTEGER := IDENT_INT(0);
+                    END CASE;
+               END RECORD;
+     BEGIN
+          BEGIN
+               DECLARE
+                    X : CONS;
+               BEGIN
+                    FAILED ("INDEX CHECK NOT PERFORMED - 1");
+                    IF X /= (1, (1, 1)) THEN
+                         COMMENT ("SHOULDN'T GET HERE");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT PERFORMED - 2");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+               BEGIN
+                    DECLARE
+                         X : ARR;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT PERFORMED - 3");
+                         IF X /= (1..5 => (1, (1, 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT PERFORMED - 4");
+                         IF X /= (C1 => (1, (1, 1))) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS NEW CONS;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+                    BEGIN
+                         FAILED ("INDEX CHECK NOT PERFORMED - 5");
+                         IF X /= (1, (1, 1)) THEN
+                              COMMENT ("IRRELEVANT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+               BEGIN
+                    DECLARE
+                         X : ACC_CONS;
+                    BEGIN
+                         X := NEW CONS;
+                         FAILED ("INDEX CHECK NOT PERFORMED - 6");
+                         IF X.ALL /= (1, (1, 1)) THEN
+                              COMMENT ("WRONG VALUE FOR X - 6");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                      "- 6A");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6B");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
+          END;
+     END;
+
+-- CASE D2: COMPONENT IS ABSENT
+
+     SEQUENCE_NUMBER := 2;
+     DECLARE
+          TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
+               RECORD
+                    CASE D3 IS
+                         WHEN -5..10 =>
+                              C1 : MY_ARR(IDENT_INT(2)..D3);
+                         WHEN OTHERS =>
+                              C2 : INTEGER := IDENT_INT(5);
+                    END CASE;
+               END RECORD;
+     BEGIN
+          BEGIN
+               DECLARE
+                    X : CONS;
+               BEGIN
+                    IF X /= (11, 5) THEN
+                         COMMENT ("X VALUE IS INCORRECT - 11");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
+          END;
+
+          BEGIN
+               DECLARE
+                    SUBTYPE SCONS IS CONS;
+               BEGIN
+                    DECLARE
+                         X : SCONS;
+                    BEGIN
+                         IF X /= (11, 5) THEN
+                              FAILED ("X VALUE INCORRECT - 12");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 12A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ARR IS ARRAY (1..5) OF CONS;
+               BEGIN
+                    DECLARE
+                         X : ARR;
+                    BEGIN
+                         IF X /= (1..5 => (11, 5)) THEN
+                              FAILED ("X VALUE INCORRECT - 13");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 13A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS
+                         RECORD
+                              C1 : CONS;
+                         END RECORD;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+                    BEGIN
+                         IF X /= (C1 => (11, 5)) THEN
+                              FAILED ("X VALUE INCORRECT - 14");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 14A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE NREC IS NEW CONS;
+               BEGIN
+                    DECLARE
+                         X : NREC;
+                    BEGIN
+                         IF X /= (11, 5) THEN
+                              FAILED ("X VALUE INCORRECT - 15");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 15A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
+          END;
+
+          BEGIN
+               DECLARE
+                    TYPE ACC_CONS IS ACCESS CONS;
+                    X : ACC_CONS;
+               BEGIN
+                    X := NEW CONS;
+                    IF X.ALL /= (11, 5) THEN
+                         FAILED ("X VALUE INCORRECT - 17");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 17A");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
+          END;
+     END;
+
+     RESULT;
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("INDEX VALUES CHECKED TOO SOON - " &
+                  INTEGER'IMAGE(SEQUENCE_NUMBER));
+          RESULT;
+END C37215H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37217a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37217a.ada
new file mode 100644
index 000000000..bf0a9b4b4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37217a.ada
@@ -0,0 +1,128 @@
+-- C37217A.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 WHETHER THE OPTIONAL COMPATIBILITY CHECK IS
+--     PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS
+--     TYPE - AFTER THE TYPE'S FULL DECLARATION.
+
+-- HISTORY:
+--     DHH 02/05/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37217A IS
+
+     SUBTYPE SM IS INTEGER RANGE 1..10;
+
+BEGIN  --C37217A BODY
+     TEST ("C37217A", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " &
+                      "CHECK IS PERFORMED WHEN A DISCRIMINANT " &
+                      "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE " &
+                      "- AFTER THE TYPE'S FULL DECLARATION");
+
+                                         -- CHECK FULL DECLARATION
+                                         -- LOWER LIMIT
+     BEGIN
+          DECLARE
+
+               TYPE SM_REC(D : SM) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               TYPE REC(D1 : INTEGER) IS
+                    RECORD
+                         INT : SM_REC(D1);
+                    END RECORD;
+
+               TYPE PTR IS ACCESS REC;
+
+               Y : PTR(IDENT_INT(0));           -- OPTIONAL EXCEPTION.
+          BEGIN
+               COMMENT("OPTIONAL COMBATIBILITY CHECK NOT PERFORMED " &
+                       "- LOWER");
+               Y := NEW REC(IDENT_INT(0));      -- MANDATORY EXCEPTION.
+               FAILED("CONSTRAINT ERROR NOT RAISED");
+
+               IF IDENT_INT(Y.INT.D) /= IDENT_INT(-1) THEN
+                    COMMENT ("IRRELEVANT");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                           "VARIABLE ALLOCATION - LOWER");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT("OPTIONAL CONSTRAINT ERROR RAISED - LOWER");
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                      "VARIABLE DECLARATION - LOWER");
+     END;
+---------------------------------------------------------------------
+                                         -- CHECK FULL DECLARATION
+                                         -- UPPER LIMIT
+     BEGIN
+          DECLARE
+               TYPE SM_ARR IS ARRAY(SM RANGE <>) OF INTEGER;
+
+               TYPE REC(D1 : INTEGER) IS
+                    RECORD
+                         INT : SM_ARR(1 .. D1);
+                    END RECORD;
+
+               TYPE PTR IS ACCESS REC;
+
+               Y : PTR(IDENT_INT(11));           -- OPTIONAL EXCEPTION.
+          BEGIN
+               COMMENT("OPTIONAL COMBATIBILITY CHECK NOT PERFORMED " &
+                       "- UPPER");
+               Y := NEW REC'(IDENT_INT(11),     -- MANDATORY EXCEPTION.
+                                      INT => (OTHERS => IDENT_INT(0)));
+               FAILED("CONSTRAINT ERROR NOT RAISED");
+
+               IF IDENT_INT(Y.INT(IDENT_INT(1))) /= 11 THEN
+                    COMMENT ("IRRELEVANT");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                           "VARIABLE ALLOCATION - UPPER");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED " &
+                       "- UPPER");
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                      "VARIABLE DECLARATION - UPPER");
+     END;
+
+     RESULT;
+
+END C37217A;  -- BODY
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37217b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37217b.ada
new file mode 100644
index 000000000..77a9d8996
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37217b.ada
@@ -0,0 +1,132 @@
+-- C37217B.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 WHETHER THE OPTIONAL COMPATIBILITY CHECK IS
+--     PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS
+--     TYPE - BEFORE THE DESIGNATED TYPE'S FULL DECLARATION.
+
+-- HISTORY:
+--     DHH 08/04/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37217B IS
+
+     SUBTYPE SM IS INTEGER RANGE 1..10;
+
+BEGIN  --C37217B BODY
+     TEST ("C37217B", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " &
+                      "CHECK IS PERFORMED WHEN A DISCRIMINANT " &
+                      "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE - " &
+                      "BEFORE THE DESIGNATED TYPE'S FULL DECLARATION");
+
+---------------------------------------------------------------------
+                                             -- INCOMPLETE DECLARATION
+                                             -- UPPER LIMIT
+     BEGIN  -- F
+          DECLARE  -- F
+               TYPE REC(D1 : INTEGER);
+
+               TYPE PTR IS ACCESS REC;
+               X : PTR(IDENT_INT(11));
+
+               TYPE SM_REC(D : SM) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               TYPE REC(D1 : INTEGER) IS
+                    RECORD
+                         INT : SM_REC(D1);
+                    END RECORD;
+          BEGIN
+               COMMENT("OPTIONAL COMPATIBILITY CHECK NOT PERFORMED " &
+                       "- UPPER");
+               X := NEW REC(IDENT_INT(11));
+               FAILED("CONSTRAINT ERROR NOT RAISED - UPPER");
+
+               IF IDENT_INT(X.INT.D) /= IDENT_INT(1) THEN
+                    COMMENT("IRREVELANT");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                           "VARIABLE USE - INCOMPLETE UPPER");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED " &
+                       "- INCOMPLETE UPPER");
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                      "VARIABLE DECLARATION - INCOMPLETE UPPER");
+     END;  -- F
+
+-----------------------------------------------------------------------
+                                              -- INCOMPLETE DECLARATION
+                                              -- LOWER LIMIT
+     BEGIN  -- A
+          DECLARE  -- A
+               TYPE REC(D1 : INTEGER);
+
+               TYPE PTR IS ACCESS REC;
+               X : PTR(IDENT_INT(0));
+
+               TYPE SM_ARR IS ARRAY(SM RANGE <>) OF INTEGER;
+
+               TYPE REC(D1 : INTEGER) IS
+                    RECORD
+                         INT : SM_ARR(D1 .. 2);
+                    END RECORD;
+          BEGIN
+               COMMENT("OPTIONAL COMPATIBILITY CHECK NOT PERFORMED " &
+                       "- LOWER");
+               X := NEW REC'(IDENT_INT(0), INT =>
+                                             (OTHERS => IDENT_INT(1)));
+               FAILED("CONSTRAINT ERROR NOT RAISED - LOWER");
+
+               IF X.INT(IDENT_INT(1)) /= IDENT_INT(1) THEN
+                    COMMENT("IRREVELANT");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                           "VARIABLE USE - INCOMPLETE LOWER");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED " &
+                       "- INCOMPLETE LOWER");
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                      "VARIABLE DECLARATION - INCOMPLETE LOWER");
+     END;
+-----------------------------------------------------------------------
+     RESULT;
+
+END C37217B;  -- BODY
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37217c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37217c.ada
new file mode 100644
index 000000000..f6fee5c17
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37217c.ada
@@ -0,0 +1,100 @@
+-- C37217C.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 WHETHER THE OPTIONAL COMPATIBILITY CHECK IS
+--     PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS
+--     TYPE - WHEN THERE IS A "LOOP" IN THE DESIGNATED TYPE'S FULL
+--     DECLARATION.
+
+-- HISTORY:
+--     DHH 08/04/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37217C IS
+
+BEGIN  --C37217C BODY
+     TEST ("C37217C", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " &
+                      "CHECK IS PERFORMED WHEN A DISCRIMINANT " &
+                      "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE " &
+                      "- WHEN THERE IS A ""LOOP"" IN THE DESIGNATED " &
+                      "TYPE'S FULL DECLARATION");
+
+     BEGIN
+          DECLARE
+               TYPE R1(D1 : INTEGER);
+               TYPE R2(D2 : INTEGER);
+               TYPE R3(D3 : POSITIVE);
+
+               TYPE ACC_R1 IS ACCESS R1;
+               TYPE ACC_R2 IS ACCESS R2;
+               TYPE ACC_R3 IS ACCESS R3;
+
+               TYPE R1(D1 : INTEGER) IS
+                    RECORD
+                         C1 : ACC_R2(D1);
+                    END RECORD;
+
+               TYPE R2(D2 : INTEGER) IS
+                    RECORD
+                         C2 : ACC_R3(D2);
+                    END RECORD;
+
+               TYPE R3(D3 : POSITIVE) IS
+                    RECORD
+                         C3 : ACC_R1(D3);
+                    END RECORD;
+
+                X1 : ACC_R1(IDENT_INT(0));
+
+          BEGIN
+               COMMENT("OPTIONAL COMPATIBILITY CHECK NOT PERFORMED");
+
+               X1 := NEW R1'(D1 =>IDENT_INT(0),
+                             C1 => NEW R2'(D2 => IDENT_INT(0),
+                                           C2 => NEW R3(IDENT_INT(0))));
+
+               FAILED("CONSTRAINT_ERROR NOT RAISED");
+
+               IF IDENT_INT(X1.C1.C2.D3) /= IDENT_INT(0) THEN
+                    COMMENT("THIS LINE SHOULD NOT PRINT OUT");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                           "VARIABLE USE - LOOPED");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED");
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                      "VARIABLE DECLARATION - LOOPED");
+     END;
+
+     RESULT;
+
+END C37217C;  -- BODY
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37304a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37304a.ada
new file mode 100644
index 000000000..e521671e2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37304a.ada
@@ -0,0 +1,92 @@
+-- C37304A.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 CHOICE ARE PERMITTED IN A VARIANT_PART,
+-- AND, IN PARTICULAR, THAT FORMS LIKE ST RANGE L..R, AND ST ARE 
+-- PERMITTED.
+ 
+-- ASL 7/31/81
+--  RM 8/26/82
+-- SPS 1/21/83
+
+WITH REPORT;
+PROCEDURE C37304A IS
+ 
+     USE REPORT;
+     
+BEGIN
+
+     TEST("C37304A","ALL FORMS OF CHOICE ALLOWED IN A VARIANT_PART");
+
+     DECLARE
+
+          TYPE T IS RANGE 1 .. 10;
+          C5 : CONSTANT T := 5;
+          SUBTYPE S1 IS T RANGE 1 .. 5;
+          SUBTYPE S2 IS T RANGE C5 + 1 .. 7;
+          SUBTYPE SN IS T RANGE C5 + 4 .. C5 - 4 + 7;  -- NULL RANGE.
+          SUBTYPE S10 IS T RANGE C5 + 5 .. T'LAST;
+
+          TYPE VREC( DISC : T := 8 ) IS
+               RECORD
+                    CASE DISC IS
+                         WHEN SN                       -- 9..8
+                         | S1 RANGE 1 .. 0             -- 1..0
+                         | S2 RANGE C5 + 2 .. C5 + 1   -- 7..6
+                         | 3 .. 2                      -- 3..2
+                              => NULL;
+
+                         WHEN  S1 RANGE 4 .. C5        -- 4..5
+                         | S1 RANGE C5 - 4 .. C5 / 2   -- 1..2
+                         | 3 .. 1 + C5 MOD 3           -- 3..3
+                         | SN                          -- 9..8
+                         | S1 RANGE 5 .. C5 - 1        -- 5..4
+                         | 6 .. 7                      -- 6..7
+                         | S10                         -- 10..10
+                         | 9                           -- 9
+                         | S10 RANGE 10 .. 9           -- 10..9
+                              => NULL;
+
+                         WHEN C5 + C5 - 2 .. 8         -- 8
+                              => NULL;
+
+                    END CASE;
+               END RECORD;
+ 
+          V : VREC;
+
+     BEGIN
+
+          IF EQUAL(3,3) THEN
+               V := (DISC => 5);
+          END IF;
+          IF V.DISC /= 5 THEN
+               FAILED ("ASSIGNMENT FAILED");
+          END IF;
+
+     END;
+ 
+     RESULT;
+
+END C37304A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37305a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37305a.ada
new file mode 100644
index 000000000..0282fa90e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37305a.ada
@@ -0,0 +1,82 @@
+-- C37305A.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 CHOICES DENOTING A NULL RANGE OF VALUES ARE PERMITTED,
+-- AND THAT FOR CHOICES CONSISTING OF A SUBTYPE NAME FOLLOWED BY A
+-- RANGE CONSTRAINT WHERE THE LOWER BOUND IS GREATER THAN THE UPPER
+-- BOUND, THE BOUNDS NEED NOT BE IN THE RANGE OF THE SUBTYPE VALUES.
+
+-- CHECK THAT AN OTHERS ALTERNATIVE CAN BE PROVIDED EVEN IF ALL VALUES
+-- OF THE CASE EXPRESSION HAVE BEEN COVERED BY PRECEDING ALTERNATIVES.
+
+-- ASL 7/14/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C37305A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C37305A","NULL RANGES ALLOWED IN CHOICES FOR VARIANT " &
+           "PARTS.  OTHERS ALTERNATIVE ALLOWED AFTER ALL VALUES " &
+           "PREVIOUSLY COVERED");
+
+     DECLARE
+          SUBTYPE ST IS INTEGER RANGE 1..10;
+
+          TYPE REC(DISC : ST := 1) IS
+               RECORD
+                    CASE DISC IS
+                         WHEN 0..-1 => NULL;
+                         WHEN 1..-3 => NULL;
+                         WHEN 6..5 =>
+                              COMP : INTEGER;
+                         WHEN 11..10 => NULL;
+                         WHEN 15..12 => NULL;
+                         WHEN 11..0 => NULL;
+                         WHEN 1..10 => NULL;
+                         WHEN OTHERS => NULL;
+                    END CASE;
+               END RECORD;
+
+          R : REC;
+     BEGIN
+          R := (DISC => 4);
+
+          IF EQUAL(3,4) THEN
+               R := (DISC => 7);
+          END IF;
+
+          IF R.DISC /= 4 THEN
+               FAILED ("ASSIGNMENT FAILED");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED");
+     END;
+
+     RESULT;
+
+END C37305A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37306a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37306a.ada
new file mode 100644
index 000000000..f50fe0195
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37306a.ada
@@ -0,0 +1,70 @@
+-- C37306A.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 VARIANT PART OF A RECORD THE CHOICES WITHIN AND
+-- BETWEEN ALTERNATIVES CAN APPEAR IN NON-MONOTONIC ORDER.
+
+-- ASL 7/13/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE C37306A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C37306A","NON-MONOTONIC ORDER OF CHOICES IN VARIANT PARTS");
+
+     DECLARE
+          TYPE COLOR IS (WHITE,RED,ORANGE,YELLOW,GREEN,AQUA,BLUE,BLACK);
+
+          TYPE REC(DISC : COLOR := BLUE) IS
+               RECORD
+                    CASE DISC IS
+                         WHEN ORANGE => NULL;
+                         WHEN GREEN | WHITE | BLACK => NULL;
+                         WHEN YELLOW => NULL;
+                         WHEN BLUE | RED => NULL;
+                         WHEN OTHERS => NULL;
+                    END CASE;
+               END RECORD;
+
+          R : REC;
+     BEGIN
+          R := (DISC => WHITE);
+
+          IF EQUAL(3,4) THEN
+               R := (DISC => RED);
+          END IF;
+
+          IF R.DISC /= WHITE THEN
+               FAILED ("ASSIGNMENT FAILED");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C37306A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37309a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37309a.ada
new file mode 100644
index 000000000..316c0e8a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37309a.ada
@@ -0,0 +1,74 @@
+-- C37309A.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 DISCRIMINANT HAS A STATIC SUBTYPE, AN OTHERS
+-- CHOICE CAN BE OMITTED IF ALL VALUES IN THE 
+-- SUBTYPE'S RANGE ARE COVERED IN A VARIANT PART.
+ 
+-- ASL 7/10/81
+-- SPS 10/25/82
+-- SPS 7/17/83
+
+WITH REPORT;
+PROCEDURE C37309A IS
+
+     USE REPORT;
+ 
+BEGIN
+     TEST ("C37309A","OTHERS CHOICE CAN BE OMITTED IN VARIANT PART " &
+           "IF ALL VALUES IN STATIC SUBTYPE RANGE OF DISCRIMINANT " &
+           "ARE COVERED");
+ 
+     DECLARE
+          SUBTYPE STATCHAR IS CHARACTER RANGE 'I'..'N';
+          TYPE REC1(DISC : STATCHAR := 'J') IS
+               RECORD
+                    CASE DISC IS
+                         WHEN 'I' => NULL;
+                         WHEN 'J' => NULL;
+                         WHEN 'K' => NULL;
+                         WHEN 'L' => NULL;
+                         WHEN 'M' => NULL;
+                         WHEN 'N' => NULL;
+                    END CASE;          
+               END RECORD;
+      
+          R1 : REC1;
+     BEGIN
+          R1 := (DISC => 'N');
+          IF EQUAL(3,3) THEN
+               R1 := (DISC => 'K');
+          END IF;
+          IF R1.DISC /= 'K' THEN
+               FAILED ("ASSIGNMENT FAILED - 1");
+          END IF;
+ 
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED");
+     END;
+ 
+     RESULT;
+ 
+END C37309A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37310a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37310a.ada
new file mode 100644
index 000000000..dfa3748a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37310a.ada
@@ -0,0 +1,124 @@
+-- C37310A.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 DISCRIMINANT HAS A DYNAMIC SUBTYPE, AN OTHERS
+-- CHOICE CAN BE OMITTED IF ALL VALUES IN THE BASE
+-- TYPE'S RANGE ARE COVERED.
+ 
+-- ASL 7/10/81
+-- SPS 10/25/82
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT;
+PROCEDURE C37310A IS
+ 
+     USE REPORT;
+ 
+BEGIN
+     TEST ("C37310A", "CHECK DYNAMIC DISCRIMINANT SUBTYPES " &
+                      "IN VARIANT RECORD DECLARATIONS");
+
+     DECLARE
+ 
+          ACHAR : CHARACTER := IDENT_CHAR('A');
+          ECHAR : CHARACTER := IDENT_CHAR('E');
+          JCHAR : CHARACTER := IDENT_CHAR('J');
+          MCHAR : CHARACTER := IDENT_CHAR('M');
+          SUBTYPE STATCHAR IS CHARACTER RANGE 'I'..'N';
+          SUBTYPE DYNCHAR IS CHARACTER RANGE ACHAR..ECHAR; 
+          SUBTYPE SSTAT IS STATCHAR RANGE JCHAR..MCHAR;
+
+          TYPE LETTER IS NEW CHARACTER RANGE 'A'..'Z';
+          SUBTYPE DYNLETTER IS 
+               LETTER RANGE LETTER(ECHAR)..LETTER(JCHAR);     
+ 
+          TYPE REC1(DISC : SSTAT := 'K') IS
+               RECORD
+                    CASE DISC IS
+                         WHEN ASCII.NUL..CHARACTER'LAST => NULL;
+                    END CASE;
+               END RECORD;
+      
+          TYPE REC2(DISC : DYNCHAR := 'C') IS
+               RECORD
+                    CASE DISC IS
+                         WHEN ASCII.NUL..CHARACTER'LAST => NULL;
+                    END CASE;       
+               END RECORD;
+      
+          TYPE REC3(DISC: DYNCHAR := 'D') IS
+               RECORD
+                    CASE DISC IS
+                         WHEN CHARACTER'FIRST..CHARACTER'LAST => NULL;
+                    END CASE; 
+               END RECORD;
+      
+          TYPE REC4(DISC : DYNLETTER := 'F') IS
+               RECORD
+                    CASE DISC IS
+                         WHEN LETTER'BASE'FIRST..
+                              LETTER'BASE'LAST => NULL;
+                    END CASE; 
+               END RECORD;
+ 
+          R1 : REC1;
+          R2 : REC2;
+          R3 : REC3;
+          R4 : REC4;
+     BEGIN
+          IF EQUAL(3,3) THEN
+               R1 := (DISC => 'L');
+          END IF;
+          IF R1.DISC /= 'L' THEN
+               FAILED ("ASSIGNMENT FAILED - 1");
+          END IF;
+ 
+          IF EQUAL(3,3) THEN
+              R2 := (DISC => 'B');
+          END IF;
+          IF R2.DISC /= 'B' THEN
+               FAILED ("ASSIGNMENT FAILED - 2");
+          END IF;
+ 
+          IF EQUAL(3,3) THEN
+               R3 := (DISC => 'B');
+          END IF;
+          IF R3.DISC /= 'B' THEN
+               FAILED ("ASSIGNMENT FAILED - 3");
+          END IF;
+ 
+          IF EQUAL(3,3) THEN
+               R4 := (DISC => 'H');
+          END IF;
+          IF R4.DISC /= 'H' THEN
+               FAILED ("ASSIGNMENT FAILED - 4");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+              FAILED ("EXCEPTION RAISED");
+     END;
+ 
+     RESULT;
+ 
+END C37310A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37312a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37312a.ada
new file mode 100644
index 000000000..f34eb7cb3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37312a.ada
@@ -0,0 +1,87 @@
+-- C37312A.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 DISCRIMINANT CAN HAVE A GENERIC FORMAL DISCRETE
+--     TYPE WHEN IT DOES NOT GOVERN A VARIANT PART AND THAT AN
+--     OBJECT OF A GENERIC FORMAL TYPE CAN CONSTRAIN A COMPONENT
+--     IN A VARIANT PART.
+
+-- HISTORY:
+--     AH  08/22/86  CREATED ORIGINAL TEST.
+--     JET 08/13/87  REVISED FROM CLASS 'A' TO CLASS 'C' TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C37312A IS
+
+BEGIN
+     TEST ("C37312A", "DISCRIMINANT TYPE IS GENERIC FORMAL TYPE");
+
+     DECLARE
+          TYPE T IS RANGE 1 ..5;
+
+          GENERIC
+               TYPE G1 IS RANGE <>;
+          PACKAGE P IS
+               TYPE G2 (D1 : G1) IS
+                    RECORD
+                         R1 : G1;
+                         R2 : BOOLEAN;
+                    END RECORD;
+
+               TYPE STR IS ARRAY(G1 RANGE <>) OF INTEGER;
+               TYPE G3 (D : G1; E : INTEGER) IS
+                    RECORD
+                         CASE E IS
+                              WHEN 1 =>
+                                   S1 : STR(G1'FIRST..D);
+                              WHEN OTHERS =>
+                                   S2 : INTEGER;
+                         END CASE;
+                    END RECORD;
+
+          END P;
+
+          PACKAGE PKG IS NEW P (G1 => T);
+          USE PKG;
+
+          A2: G2(1) := (1, 5, FALSE);
+          A3: G3(5, 1) := (5, 1, (1, 2, 3, 4, 5));
+
+     BEGIN
+          A2.R2 := IDENT_BOOL (TRUE);
+          A3.S1(1) := IDENT_INT (6);
+
+          IF A2 /= (1, 5, TRUE) THEN
+               FAILED ("INVALID CONTENTS OF RECORD A2");
+          END IF;
+          IF A3 /= (5, 1, (6, 2, 3, 4, 5)) THEN
+               FAILED ("INVALID CONTENTS OF RECORD A3");
+          END IF;
+     END;
+
+     RESULT;
+
+END C37312A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37402a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37402a.ada
new file mode 100644
index 000000000..ec21d745f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37402a.ada
@@ -0,0 +1,253 @@
+-- C37402A.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 WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR 
+-- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT 
+-- HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN APPLIED TO FORMAL 
+-- PARAMETERS OF MODE IN AND HAS THE VALUE OF THE ACTUAL PARAMETER 
+-- FOR THE OTHER MODES.
+
+-- R.WILLIAMS 9/1/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37402A IS
+
+BEGIN
+     TEST ( "C37402A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " &
+                       "SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " &
+                       "UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " &
+                       "HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN " &
+                       "APPLIED TO FORMAL PARAMETERS OF MODE IN " &
+                       "AND HAS THE VALUE OF THE ACTUAL PARAMETER " &
+                       "FOR THE OTHER MODES" );
+
+     
+     DECLARE
+
+          SUBTYPE INT IS INTEGER RANGE 1 .. 5;
+
+          TYPE MATRIX IS ARRAY (INT RANGE <>, INT RANGE <>) 
+               OF INTEGER;
+
+          TYPE SQUARE (SIDE : INT := 1) IS
+               RECORD
+                    MAT : MATRIX (1 .. SIDE, 1 .. SIDE);
+               END RECORD;
+
+          SC : CONSTANT SQUARE := (2, ((0, 0), (0, 0)));
+
+          AC : SQUARE (2) := (2, ((1, 2), (3, 4)));
+          AU : SQUARE     := (SIDE => 1, MAT => (1 => (1 => 1)));
+
+          BC : SQUARE (2) := AC;
+          BU : SQUARE     := AU;
+
+          CC : SQUARE (2);
+          CU : SQUARE;
+ 
+          PROCEDURE P (CON, IN_CON : IN     SQUARE; 
+                       INOUT_CON   : IN OUT SQUARE;
+                       OUT_CON     : OUT    SQUARE; 
+                       IN_UNC      : IN     SQUARE; 
+                       INOUT_UNC   : IN OUT SQUARE; 
+                       OUT_UNC     : OUT    SQUARE) IS
+
+          BEGIN
+               IF CON'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                             "OF IN MODE - 1" );
+               END IF;
+
+               IF IN_CON'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                             "OF IN MODE - 2" );
+               END IF;
+
+               IF IN_UNC'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                             "OF IN MODE - 3" );
+               END IF;
+
+               IF INOUT_CON'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                             "CONSTRAINED OBJECT OF IN OUT MODE - 1" );
+               END IF;
+
+               IF OUT_CON'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                             "CONSTRAINED OBJECT OF OUT MODE - 1" );
+               END IF;
+
+               IF INOUT_UNC'CONSTRAINED THEN
+                    FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
+                             "UNCONSTRAINED OBJECT OF IN OUT MODE " &
+                             "- 1" );
+               END IF;
+
+               IF OUT_UNC'CONSTRAINED THEN
+                    FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
+                             "UNCONSTRAINED OBJECT OF OUT MODE - 1" );
+               END IF;
+          
+               OUT_CON := (2, ((1, 2), (3, 4)));
+               OUT_UNC := (2, ((1, 2), (3, 4)));
+          END P;
+
+          TASK T IS 
+               ENTRY Q (CON, IN_CON : IN     SQUARE; 
+                        INOUT_CON   : IN OUT SQUARE;
+                        OUT_CON     : OUT    SQUARE; 
+                        IN_UNC      : IN     SQUARE; 
+                        INOUT_UNC   : IN OUT SQUARE; 
+                        OUT_UNC     : OUT    SQUARE);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT Q (CON, IN_CON : IN     SQUARE; 
+                         INOUT_CON   : IN OUT SQUARE;
+                         OUT_CON     : OUT    SQUARE; 
+                         IN_UNC      : IN     SQUARE; 
+                         INOUT_UNC   : IN OUT SQUARE; 
+                         OUT_UNC     : OUT    SQUARE) DO
+                    BEGIN
+                         IF CON'CONSTRAINED THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                       "OBJECT OF IN MODE - 4" );
+                         END IF;
+
+                         IF IN_CON'CONSTRAINED THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                       "OBJECT OF IN MODE - 5" );
+                         END IF;
+
+                         IF IN_UNC'CONSTRAINED THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                       "OBJECT OF IN MODE - 6" );
+                         END IF;
+     
+                         IF INOUT_CON'CONSTRAINED THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                       "CONSTRAINED OBJECT OF " &
+                                       "IN OUT MODE - 2" );
+                         END IF;
+          
+                         IF OUT_CON'CONSTRAINED THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                       "CONSTRAINED OBJECT OF " &
+                                       "OUT MODE - 2" );
+                         END IF;
+
+                         IF INOUT_UNC'CONSTRAINED THEN
+                              FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
+                                       "UNCONSTRAINED OBJECT OF " &
+                                       "IN OUT MODE - 2" );
+                         END IF;
+          
+                         IF OUT_UNC'CONSTRAINED THEN
+                              FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
+                                       "UNCONSTRAINED OBJECT OF " &
+                                       "OUT MODE - 2" );
+                         END IF;
+          
+                         OUT_CON := (2, ((1, 2), (3, 4)));
+                         OUT_UNC := (2, ((1, 2), (3, 4)));
+                    END;
+               END Q;
+          END T;
+
+          GENERIC
+               CON, IN_CON : IN     SQUARE; 
+               INOUT_CON   : IN OUT SQUARE;
+               IN_UNC      : IN     SQUARE; 
+               INOUT_UNC   : IN OUT SQUARE; 
+          PACKAGE R IS END R;
+
+          PACKAGE BODY R IS
+          BEGIN
+               IF CON'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                             "OF IN MODE - 7" );
+               END IF;
+
+               IF IN_CON'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                             "OF IN MODE - 8" );
+               END IF;
+
+               IF IN_UNC'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                             "OF IN MODE - 9" );
+               END IF;
+
+               IF INOUT_CON'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                             "CONSTRAINED OBJECT OF IN OUT MODE - 3" );
+               END IF;
+
+               IF INOUT_UNC'CONSTRAINED THEN
+                    FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
+                             "UNCONSTRAINED OBJECT OF IN OUT MODE " &
+                             "- 3" );
+               END IF;
+
+          END R;
+
+          PACKAGE S IS NEW R (SC, AC, BC, AU, BU);
+
+     BEGIN
+          P (SC, AC, BC, CC, AU, BU, CU);
+          T.Q (SC, AC, BC, CC, AU, BU, CU);
+     END;
+          
+     RESULT;
+END C37402A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37403a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37403a.ada
new file mode 100644
index 000000000..baa65f57b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37403a.ada
@@ -0,0 +1,186 @@
+-- C37403A.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 WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR 
+-- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT DO 
+-- NOT HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' REGARDLESS OF THE MODE 
+-- OF THE PARAMETER.
+
+-- R.WILLIAMS 9/1/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37403A IS
+
+BEGIN
+     TEST ( "C37403A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " &
+                       "SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " &
+                       "UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " &
+                       "DO NOT HAVE DEFAULTS, 'CONSTRAINED IS " &
+                       "'TRUE' REGARDLESS OF THE MODE OF THE " &
+                       "PARAMETER" );
+
+     
+     DECLARE
+
+          SUBTYPE INT IS INTEGER RANGE 1.. 10;
+
+          TYPE MATRIX IS ARRAY (INT RANGE <>, INT RANGE <>) 
+               OF INTEGER;
+
+          TYPE SQUARE (SIDE : INT) IS
+               RECORD
+                    MAT : MATRIX (1 .. SIDE, 1 .. SIDE);
+               END RECORD;
+
+          S1 : SQUARE (2) := (2, ((1, 2), (3, 4)));
+
+          S2 : SQUARE (2) := S1;
+
+          S3 : SQUARE (2);
+ 
+          SC : CONSTANT SQUARE := (SIDE => 1, MAT => (1 => (1 => 1)));
+
+          PROCEDURE P (PIN1, PIN2 : IN     SQUARE; 
+                       PINOUT     : IN OUT SQUARE;
+                       POUT       : OUT    SQUARE) IS
+
+          BEGIN
+               IF PIN1'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                             "OF IN MODE - 1" );
+               END IF;
+
+               IF PIN2'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                             "OF IN MODE - 2" );
+               END IF;
+
+               IF PINOUT'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                             "OBJECT OF IN OUT MODE - 1" );
+               END IF;
+
+               IF POUT'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                             "OBJECT OF OUT MODE - 1" );
+               END IF;
+
+               POUT := (2, ((1, 2), (3, 4)));
+          END P;
+
+          TASK T IS 
+               ENTRY Q (PIN1, PIN2  : IN     SQUARE; 
+                        PINOUT      : IN OUT SQUARE;
+                        POUT        : OUT    SQUARE);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT Q (PIN1, PIN2  : IN     SQUARE; 
+                         PINOUT      : IN OUT SQUARE;
+                         POUT        : OUT    SQUARE) DO
+
+                    BEGIN
+                         IF PIN1'CONSTRAINED THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                       "OBJECT OF IN MODE - 3" );
+                         END IF;
+
+                         IF PIN2'CONSTRAINED THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                       "OBJECT OF IN MODE - 4" );
+                         END IF;
+     
+                         IF PINOUT'CONSTRAINED THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                       "OBJECT OF " &
+                                       "IN OUT MODE - 2" );
+                         END IF;
+          
+                         IF POUT'CONSTRAINED THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                                       "OBJECT OF " &
+                                       "OUT MODE - 2" );
+                         END IF;
+
+                         POUT := (2, ((1, 2), (3, 4)));
+                    END;
+               END Q;
+          END T;
+
+          GENERIC
+               PIN1, PIN2 : IN     SQUARE; 
+               PINOUT     : IN OUT SQUARE;
+          PACKAGE R IS END R;
+
+          PACKAGE BODY R IS
+          BEGIN
+               IF PIN1'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                             "OF IN MODE - 5" );
+               END IF;
+
+               IF PIN2'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
+                             "OF IN MODE - 6" );
+               END IF;
+
+               IF PINOUT'CONSTRAINED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
+                             "OBJECT OF IN OUT MODE - 3" );
+               END IF;
+
+          END R;
+
+          PACKAGE S IS NEW R (S1, SC, S2);
+
+     BEGIN
+          P (S1, SC, S2, S3);
+          T.Q (S1, SC, S2, S3);
+     END;
+          
+     RESULT;
+END C37403A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37404a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37404a.ada
new file mode 100644
index 000000000..006d4492b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37404a.ada
@@ -0,0 +1,168 @@
+--C37404A.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 'CONSTRAINED IS TRUE FOR VARIABLES DECLARED WITH A
+--     CONSTRAINED TYPE, FOR CONSTANT OBJECTS (EVEN IF NOT DECLARED
+--     WITH A CONSTRAINED TYPE), AND DESIGNATED OBJECTS.
+
+-- HISTORY:
+--     DHH 02/25/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37404A IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+     TYPE REC(A : INT) IS
+          RECORD
+               I : INT;
+     END RECORD;
+
+     TYPE ACC_REC IS ACCESS REC(4);
+     TYPE ACC_REC1 IS ACCESS REC;
+     SUBTYPE REC4 IS REC(4);
+     SUBTYPE REC5 IS REC;
+
+     TYPE REC_DEF(A : INT := 5) IS
+          RECORD
+               I : INT := 1;
+     END RECORD;
+
+     TYPE ACC_DEF IS ACCESS REC_DEF(4);
+     TYPE ACC_DEF1 IS ACCESS REC_DEF;
+     SUBTYPE REC6 IS REC_DEF(6);
+     SUBTYPE REC7 IS REC_DEF;
+
+     A : REC4 := (A => 4, I => 1);                    -- CONSTRAINED.
+     B : REC5(4) := (A => 4, I => 1);                 -- CONSTRAINED.
+     C : REC6;                                        -- CONSTRAINED.
+     D : REC7(6);                                     -- CONSTRAINED.
+     E : ACC_REC1(4);                                 -- CONSTRAINED.
+     F : ACC_DEF1(4);                                 -- CONSTRAINED.
+     G : ACC_REC1;                                    -- UNCONSTRAINED.
+     H : ACC_DEF1;                                    -- UNCONSTRAINED.
+
+     R : REC(5) := (A => 5, I => 1);                  -- CONSTRAINED.
+     T : REC_DEF(5);                                  -- CONSTRAINED.
+     U : ACC_REC;                                     -- CONSTRAINED.
+     V : ACC_DEF;                                     -- CONSTRAINED.
+     W : CONSTANT REC(5) := (A => 5, I => 1);         -- CONSTANT.
+     X : CONSTANT REC := (A => 5, I => 1);            -- CONSTANT.
+     Y : CONSTANT REC_DEF(5) := (A => 5, I => 1);     -- CONSTANT.
+     Z : CONSTANT REC_DEF := (A => 5, I => 1);        -- CONSTANT.
+
+BEGIN
+     TEST("C37404A", "CHECK THAT 'CONSTRAINED IS TRUE FOR VARIABLES " &
+                     "DECLARED WITH A  CONSTRAINED TYPE, FOR " &
+                     "CONSTANT OBJECTS (EVEN IF NOT DECLARED WITH A " &
+                     "CONSTRAINED TYPE), AND DESIGNATED OBJECTS");
+
+     U := NEW REC(4);
+     V := NEW REC_DEF(4);
+     E := NEW REC(4);
+     F := NEW REC_DEF(4);
+     G := NEW REC(4);                                 -- CONSTRAINED.
+     H := NEW REC_DEF(4);                             -- CONSTRAINED.
+
+     IF NOT A'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE1");
+     END IF;
+
+     IF NOT B'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE2");
+     END IF;
+
+     IF NOT C'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE1");
+     END IF;
+
+     IF NOT D'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE2");
+     END IF;
+
+     IF NOT R'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR RECORD COMPONENT");
+     END IF;
+
+     IF NOT T'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT VARIABLE");
+     END IF;
+
+     IF NOT E.ALL'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 1");
+     END IF;
+
+     IF NOT F.ALL'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 1");
+     END IF;
+
+     IF NOT G.ALL'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 2");
+     END IF;
+
+     IF NOT H.ALL'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 2");
+     END IF;
+
+     IF NOT U.ALL'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 3");
+     END IF;
+
+     IF NOT V.ALL'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 3");
+     END IF;
+
+     IF NOT W'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, CONSTRAINED");
+     END IF;
+
+     IF NOT X'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, UNCONSTRAINED");
+     END IF;
+
+     IF NOT Y'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " &
+                 "CONSTRAINED");
+     END IF;
+
+     IF NOT Z'CONSTRAINED THEN
+          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " &
+                 "UNCONSTRAINED");
+     END IF;
+
+     IF IDENT_INT(T.I) /= 1 OR
+        IDENT_INT(C.I) /= 1 OR
+        IDENT_INT(D.I) /= 1 OR
+        IDENT_INT(W.A) /= 5 OR
+        IDENT_INT(X.A) /= 5 OR
+        IDENT_INT(Y.A) /= 5 OR
+        IDENT_INT(Z.I) /= 1 OR
+        IDENT_INT(A.I) /= 1 OR
+        IDENT_INT(B.I) /= 1 OR
+        IDENT_BOOL(R.I /= 1) THEN
+             FAILED("INCORRECT INITIALIZATION VALUES");
+     END IF;
+
+     RESULT;
+END C37404A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37404b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37404b.ada
new file mode 100644
index 000000000..d7a03ecd6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37404b.ada
@@ -0,0 +1,148 @@
+--C37404B.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 'CONSTRAINED IS FALSE FOR VARIABLES THAT HAVE
+--     DISCRIMINANTS WITH DEFAULT VALUES.
+
+-- HISTORY:
+--     LDC 06/08/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37404B IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+
+     TYPE REC_DEF(A : INT := 5) IS
+          RECORD
+               I : INT := 1;
+     END RECORD;
+
+     SUBTYPE REC_DEF_SUB IS REC_DEF;
+
+     TYPE REC_DEF_ARR     IS ARRAY (INTEGER RANGE -8..7) OF REC_DEF;
+     TYPE REC_DEF_SARR IS ARRAY (INTEGER RANGE -8..7) OF REC_DEF_SUB;
+
+     PACKAGE PRI_PACK IS
+          TYPE REC_DEF_PRI(A : INTEGER := 5) IS PRIVATE;
+          TYPE REC_DEF_LIM_PRI(A : INTEGER := 5) IS LIMITED PRIVATE;
+
+     PRIVATE
+
+          TYPE REC_DEF_PRI(A : INTEGER := 5) IS
+               RECORD
+                    I : INTEGER := 1;
+          END RECORD;
+
+          TYPE REC_DEF_LIM_PRI(A : INTEGER := 5) IS
+               RECORD
+                    I : INTEGER := 1;
+          END RECORD;
+
+     END PRI_PACK;
+     USE PRI_PACK;
+
+     A : REC_DEF;
+     B : REC_DEF_SUB;
+     C : ARRAY (0..15) OF REC_DEF;
+     D : ARRAY (0..15) OF REC_DEF_SUB;
+     E : REC_DEF_ARR;
+     F : REC_DEF_SARR;
+     G : REC_DEF_PRI;
+     H : REC_DEF_LIM_PRI;
+
+     Z : REC_DEF;
+
+     PROCEDURE SUBPROG(REC : OUT REC_DEF) IS
+
+     BEGIN
+          IF REC'CONSTRAINED THEN
+               FAILED("'CONSTRAINED TRUE FOR SUBPROGRAM OUT " &
+                      "PARAMETER INSIDE THE SUBPROGRAM");
+          END IF;
+     END SUBPROG;
+
+BEGIN
+     TEST("C37404B", "CHECK THAT 'CONSTRAINED IS FALSE FOR VARIABLES" &
+                     " THAT HAVE DISCRIMINANTS WITH DEFAULT VALUES.");
+
+     IF A'CONSTRAINED THEN
+          FAILED("'CONSTRAINED TRUE FOR RECORD COMPONENT");
+     END IF;
+
+     IF B'CONSTRAINED THEN
+          FAILED("'CONSTRAINED TRUE FOR SUBTYPE");
+     END IF;
+
+     IF C(1)'CONSTRAINED THEN
+          FAILED("'CONSTRAINED TRUE FOR ARRAY TYPE");
+     END IF;
+
+     IF D(1)'CONSTRAINED THEN
+          FAILED("'CONSTRAINED TRUE FOR ARRAY OF SUBTYPE");
+     END IF;
+
+     IF E(1)'CONSTRAINED THEN
+          FAILED("'CONSTRAINED TRUE FOR ARRAY TYPE");
+     END IF;
+
+     IF F(1)'CONSTRAINED THEN
+          FAILED("'CONSTRAINED TRUE FOR ARRAY OF SUBTYPE");
+     END IF;
+
+     IF G'CONSTRAINED THEN
+          FAILED("'CONSTRAINED TRUE FOR PRIVATE TYPE");
+     END IF;
+
+     IF H'CONSTRAINED THEN
+          FAILED("'CONSTRAINED TRUE FOR LIMITED PRIVATE TYPE");
+     END IF;
+
+     SUBPROG(Z);
+     IF Z'CONSTRAINED THEN
+          FAILED("'CONSTRAINED TRUE FOR SUBPROGRAM OUT PARAMETER " &
+                 "AFTER THE CALL");
+     END IF;
+
+     IF IDENT_INT(A.I)    /= 1 OR
+        IDENT_INT(B.I)    /= 1 OR
+        IDENT_INT(C(1).I) /= 1 OR
+        IDENT_INT(D(1).I) /= 1 OR
+        IDENT_INT(E(1).I) /= 1 OR
+        IDENT_INT(F(1).I) /= 1 OR
+        IDENT_INT(Z.I)    /= 1 OR
+        IDENT_INT(A.A)    /= 5 OR
+        IDENT_INT(B.A)    /= 5 OR
+        IDENT_INT(C(1).A) /= 5 OR
+        IDENT_INT(D(1).A) /= 5 OR
+        IDENT_INT(E(1).A) /= 5 OR
+        IDENT_INT(F(1).A) /= 5 OR
+        IDENT_INT(G.A)    /= 5 OR
+        IDENT_INT(H.A)    /= 5 OR
+        IDENT_INT(Z.A)    /= 5 THEN
+             FAILED("INCORRECT INITIALIZATION VALUES");
+     END IF;
+
+     RESULT;
+END C37404B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37405a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37405a.ada
new file mode 100644
index 000000000..187033773
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37405a.ada
@@ -0,0 +1,161 @@
+-- C37405A.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 WHEN ASSIGNING TO A CONSTRAINED OR UNCONSTRAINED
+-- OBJECT OR FORMAL PARAMETER OF A TYPE DECLARED WITH DEFAULT
+-- DISCRIMINANTS, THE ASSIGNMENT DOES NOT CHANGE THE 'CONSTRAINED
+-- ATTRIBUTE VALUE ASSOCIATED WITH THE OBJECT OR PARAMETER.
+ 
+-- ASL 7/21/81
+-- TBN 1/20/86     RENAMED FROM C37209A.ADA AND REVISED THE ASSIGNMENTS 
+--                 OF CONSTRAINED AND UNCONSTRAINED OBJECTS TO ARRAY AND
+--                 RECORD COMPONENTS.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37405A IS
+ 
+     TYPE REC(DISC : INTEGER := 25) IS
+          RECORD
+               COMP : INTEGER;
+          END RECORD;
+ 
+     SUBTYPE CONSTR IS REC(10);
+     SUBTYPE UNCONSTR IS REC;
+
+     TYPE REC_C IS 
+          RECORD
+               COMP: CONSTR;
+          END RECORD;
+
+     TYPE REC_U IS
+          RECORD
+               COMP: UNCONSTR;
+          END RECORD;
+ 
+     C1,C2 : CONSTR;
+     U1,U2 : UNCONSTR;
+-- C2 AND U2 ARE NOT PASSED TO EITHER PROC1 OR PROC2.
+
+     ARR_C : ARRAY (1..5) OF CONSTR;
+     ARR_U : ARRAY (1..5) OF UNCONSTR;
+
+     REC_COMP_C : REC_C;
+     REC_COMP_U : REC_U;
+ 
+     PROCEDURE PROC11(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
+     BEGIN
+          PARM := C2;
+          IF IDENT_BOOL(B) /= PARM'CONSTRAINED THEN
+               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                       "ASSIGNMENT - 1");
+          END IF;
+     END PROC11;
+
+     PROCEDURE PROC12(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
+     BEGIN
+          PARM := U2;
+          IF B /= PARM'CONSTRAINED THEN
+               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                       "ASSIGNMENT - 2");
+          END IF;
+     END PROC12;
+
+     PROCEDURE PROC1(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
+     BEGIN
+          IF B /= PARM'CONSTRAINED THEN
+               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                       "PASSING PARAMETER");
+          END IF;
+ 
+          PROC11(PARM, B);
+ 
+          PROC12(PARM, B);
+
+     END PROC1;
+ 
+     PROCEDURE PROC2(PARM : IN OUT CONSTR) IS
+     BEGIN
+          COMMENT ("CALLING PROC1 FROM PROC2");   -- IN CASE TEST FAILS.
+          PROC1(PARM,TRUE);
+          PARM := U2;
+          IF NOT PARM'CONSTRAINED THEN
+               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                       "ASSIGNMENT - 3");
+          END IF;
+     END PROC2;
+BEGIN
+     TEST("C37405A", "'CONSTRAINED ATTRIBUTE OF OBJECTS, FORMAL " &
+                     "PARAMETERS CANNOT BE CHANGED BY ASSIGNMENT");
+ 
+     C2 := (DISC => IDENT_INT(10), COMP => 3);
+     U2 := (DISC => IDENT_INT(10), COMP => 4);
+
+     ARR_C := (1..5 => U2);
+     ARR_U := (1..5 => C2);
+
+     REC_COMP_C := (COMP => U2);
+     REC_COMP_U := (COMP => C2);
+ 
+     C1 := U2;
+     U1 := C2;
+ 
+     IF U1'CONSTRAINED OR NOT C1'CONSTRAINED THEN
+          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 4");
+     END IF;
+
+     IF ARR_U(3)'CONSTRAINED OR NOT ARR_C(4)'CONSTRAINED THEN
+          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 5");
+     END IF;
+
+     IF REC_COMP_U.COMP'CONSTRAINED
+         OR NOT REC_COMP_C.COMP'CONSTRAINED THEN
+          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 6");
+     END IF;
+ 
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(C1,TRUE);
+     PROC2(C1);
+
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(U1,FALSE);
+     PROC2(U1);
+
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(ARR_C(4), TRUE);
+     PROC2(ARR_C(5));
+
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(ARR_U(2), FALSE);
+     PROC2(ARR_U(3));
+
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(REC_COMP_C.COMP, TRUE);
+     PROC2(REC_COMP_C.COMP);
+
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(REC_COMP_U.COMP, FALSE);
+     PROC2(REC_COMP_U.COMP);
+ 
+     RESULT;
+END C37405A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37411a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37411a.ada
new file mode 100644
index 000000000..d11574b61
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37411a.ada
@@ -0,0 +1,82 @@
+-- C37411A.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 OPERATIONS OF ASSIGNMENT, COMPARISON, MEMBERSHIP
+--     TESTS, QUALIFICATION, TYPE CONVERSION, 'BASE, 'SIZE AND 'ADDRESS,
+--     ARE DEFINED FOR NULL RECORDS.
+
+-- HISTORY:
+--     DHH 03/04/88 CREATED ORIGINAL TEST.
+--     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE C37411A IS
+     TYPE S IS
+          RECORD
+               NULL;
+          END RECORD;
+
+     SUBTYPE SS IS S;
+
+     U,V,W : S;
+     X : SS;
+
+BEGIN
+
+     TEST("C37411A", "CHECK THAT THE OPERATIONS OF ASSIGNMENT, " &
+                     "COMPARISON, MEMBERSHIP TESTS, QUALIFICATION, " &
+                     "TYPE CONVERSION, 'BASE, 'SIZE AND 'ADDRESS, " &
+                     "ARE DEFINED FOR NULL RECORDS");
+     U := W;
+     IF U /= W THEN
+          FAILED("EQUALITY/ASSIGNMENT DOES NOT PERFORM CORRECTLY");
+     END IF;
+
+     IF V NOT IN S THEN
+          FAILED("MEMBERSHIP DOES NOT PERFORM CORRECTLY");
+     END IF;
+
+     IF X /= SS(V) THEN
+          FAILED("TYPE CONVERSION DOES NOT PERFORM CORRECTLY");
+     END IF;
+
+     IF S'(U) /= S'(W) THEN
+          FAILED("QUALIFIED EXPRESSION DOES NOT PERFORM CORRECTLY");
+     END IF;
+
+     IF X'SIZE /= V'SIZE THEN
+          FAILED("'BASE'SIZE DOES NOT PERFORM CORRECTLY WHEN PREFIX " &
+                 "IS AN OBJECT");
+     END IF;
+
+     IF X'ADDRESS = V'ADDRESS THEN
+          COMMENT("NULL RECORDS HAVE THE SAME ADDRESS");
+     ELSE
+          COMMENT("NULL RECORDS DO NOT HAVE THE SAME ADDRESS");
+     END IF;
+
+     RESULT;
+END C37411A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380001.a
new file mode 100644
index 000000000..0ebe4d31c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380001.a
@@ -0,0 +1,128 @@
+-- C380001.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 ACAA 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 checks are made properly when a per-object expression contains
+--    an attribute whose prefix denotes the current instance of the type.
+--    (Defect Report 8652/0002, as reflected in Technical Corrigendum 1,
+--    RM95 3.8(18/1)).
+--
+-- CHANGE HISTORY:
+--     9 FEB 2001   PHL   Initial version.
+--    29 JUN 2002   RLB   Readied for release.
+--
+--!
+with Ada.Exceptions;
+use Ada.Exceptions;
+with Report;
+use Report;
+procedure C380001 is
+
+    type Negative is range Integer'First .. -1;
+
+    type R1 is
+        record
+            C : Negative := Negative (Ident_Int (R1'Size));
+        end record;
+
+
+    type R2;
+
+    type R3 (D1 : access R2; D2 : Natural) is limited null record;
+
+    type R2 is limited
+        record
+            C : R3 (R2'Access, Ident_Int (-1));
+        end record;
+
+begin
+    Test ("C380001", "Check that checks are made properly when a " &
+                        "per-object expression contains an attribute whose " &
+                        "prefix denotes the current instance of the type");
+    begin
+        declare
+            X : R1;
+        begin
+            Failed
+               ("No exception raised when evaluating a per-object expression " &
+                "containing an attribute - 1");
+        end;
+    exception
+        when Constraint_Error =>
+            null;
+        when E: others =>
+            Failed ("Exception " & Exception_Name (E) &
+                    " raised - " & Exception_Information (E) & " - 1");
+    end;
+
+    declare
+        type A is access R1;
+        X : A;
+    begin
+        X := new R1;
+        Failed ("No exception raised when evaluating a per-object expression " &
+                "containing an attribute - 2");
+    exception
+        when Constraint_Error =>
+            null;
+        when E: others =>
+            Failed ("Exception " & Exception_Name (E) &
+                    " raised - " & Exception_Information (E) & " - 2");
+    end;
+
+    begin
+        declare
+            X : R2;
+        begin
+            Failed
+               ("No exception raised when elaborating a per-object constraint " &
+                "containing an attribute - 3");
+        end;
+    exception
+        when Constraint_Error =>
+            null;
+        when E: others =>
+            Failed ("Exception " & Exception_Name (E) &
+                    " raised - " & Exception_Information (E) & " - 3");
+    end;
+
+    declare
+        type A is access R2;
+        X : A;
+    begin
+        X := new R2;
+        Failed
+           ("No exception raised when evaluating a per-object constraint " &
+            "containing an attribute - 4");
+    exception
+        when Constraint_Error =>
+            null;
+        when E: others =>
+            Failed ("Exception " & Exception_Name (E) &
+                    " raised - " & Exception_Information (E) & " - 4");
+    end;
+
+    Result;
+end C380001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380002.a
new file mode 100644
index 000000000..ae58676cb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380002.a
@@ -0,0 +1,72 @@
+-- C380002.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 ACAA 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 expression in a per-object discriminant constraint which is
+--    part of a named association is evaluated once for each association.
+--    (Defect Report 8652/0002, as reflected in Technical Corrigendum 1,
+--    RM95 3.8(18.1/1)).
+--
+-- CHANGE HISTORY:
+--     9 FEB 2001   PHL   Initial version.
+--    29 JUN 2002   RLB   Readied for release.
+--
+--!
+with Ada.Exceptions;
+use Ada.Exceptions;
+with Report;
+use Report;
+procedure C380002 is
+
+    F_Val : Integer := Ident_Int (0);
+
+    function F return Integer is
+    begin
+        F_Val := F_Val + Ident_Int (1);
+        return F_Val;
+    end F;
+
+    type R1;
+
+    type R2 (D0 : Integer; D1 : access R1; D2 : Integer; D3 : Integer) is
+       limited null record;
+
+    type R1 is limited
+        record
+            C : R2 (D1 => R1'Access, D0 | D2 | D3 => F);
+        end record;
+
+begin
+    Test ("C380002", "Check that an expression in a per-object discriminant " &
+                        "constraint which is part of a named association is " &
+                        "evaluated once for each association");
+
+    if not Equal (F_Val, 3) then
+        Failed ("Expression not evaluated the proper number of times");
+    end if;
+
+    Result;
+end C380002;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380003.a
new file mode 100644
index 000000000..451d17703
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380003.a
@@ -0,0 +1,223 @@
+-- C380003.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 ACAA 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 per-object expressions are evaluated as specified for
+--    protected components.  (Defect Report 8652/0002, as reflected in
+--    Technical Corrigendum 1, RM95 3.6(22/1) and 3.8(18/1)).
+--
+-- CHANGE HISTORY:
+--     9 FEB 2001   PHL   Initial version.
+--    29 JUN 2002   RLB   Readied for release.
+--
+--!
+with Report;
+use Report;
+procedure C380003 is
+
+    subtype Sm is Integer range 1 .. 10;
+
+    type Rec (D1, D2 : Sm) is
+        record
+            null;
+        end record;
+
+begin
+    Test ("C380003",
+          "Check compatibility of discriminant expressions" &
+             " when the constraint depends on discriminants, " &
+             "and the discriminants have defaults - protected components");
+
+    declare
+        protected type Cons (D3 : Integer := Ident_Int (11)) is
+            function C1_D1 return Integer;
+            function C1_D2 return Integer;
+        private
+            C1 : Rec (D3, 1);
+        end Cons;
+        protected body Cons is
+            function C1_D1 return Integer is
+            begin
+                return C1.D1;
+            end C1_D1;
+            function C1_D2 return Integer is
+            begin
+                return C1.D2;
+            end C1_D2;
+        end Cons;
+
+        function Is_Ok
+                    (C : Cons; D3 : Integer; C1_D1 : Integer; C1_D2 : Integer)
+                    return Boolean is
+        begin
+            return C.D3 = D3 and C.C1_D1 = C1_D1 and C.C1_D2 = C1_D2;
+        end Is_Ok;
+
+    begin
+        begin
+            declare
+                X : Cons;
+            begin
+                Failed ("Discriminant check not performed - 1");
+                if not Is_Ok (X, 1, 1, 1) then
+                    Comment ("Shouldn't get here");
+                end if;
+            end;
+        exception
+            when Constraint_Error =>
+                null;
+            when others =>
+                Failed ("Unexpected exception - 1");
+        end;
+
+        begin
+            declare
+                type Acc_Cons is access Cons;
+                X : Acc_Cons;
+            begin
+                X := new Cons;
+                Failed ("Discriminant check not performed - 2");
+                begin
+                    if not Is_Ok (X.all, 1, 1, 1) then
+                        Comment ("Irrelevant");
+                    end if;
+                end;
+            exception
+                when Constraint_Error =>
+                    null;
+                when others =>
+                    Failed ("Unexpected exception raised - 2");
+            end;
+        exception
+            when others =>
+                Failed ("Constraint checked too soon - 2");
+        end;
+
+        begin
+            declare
+                subtype Scons is Cons;
+            begin
+                declare
+                    X : Scons;
+                begin
+                    Failed ("Discriminant check not performed - 3");
+                    if not Is_Ok (X, 1, 1, 1) then
+                        Comment ("Irrelevant");
+                    end if;
+                end;
+            exception
+                when Constraint_Error =>
+                    null;
+                when others =>
+                    Failed ("Unexpected exception raised - 3");
+            end;
+        exception
+            when others =>
+                Failed ("Constraint checked too soon - 3");
+        end;
+
+        begin
+            declare
+                type Arr is array (1 .. 5) of Cons;
+            begin
+                declare
+                    X : Arr;
+                begin
+                    Failed ("Discriminant check not performed - 4");
+                    for I in Arr'Range loop
+                        if not Is_Ok (X (I), 1, 1, 1) then
+                            Comment ("Irrelevant");
+                        end if;
+                    end loop;
+                end;
+            exception
+                when Constraint_Error =>
+                    null;
+                when others =>
+                    Failed ("Unexpected exception raised - 4");
+            end;
+        exception
+            when others =>
+                Failed ("Constraint checked too soon - 4");
+        end;
+
+        begin
+            declare
+                type Nrec is
+                    record
+                        C1 : Cons;
+                    end record;
+            begin
+                declare
+                    X : Nrec;
+                begin
+                    Failed ("Discriminant check not performed - 5");
+                    if not Is_Ok (X.C1, 1, 1, 1) then
+                        Comment ("Irrelevant");
+                    end if;
+                end;
+            exception
+                when Constraint_Error =>
+                    null;
+                when others =>
+                    Failed ("Unexpected exception raised - 5");
+            end;
+        exception
+            when others =>
+                Failed ("Constraint checked too soon - 5");
+        end;
+
+        begin
+            declare
+                type Drec is new Cons;
+            begin
+                declare
+                    X : Drec;
+                begin
+                    Failed ("Discriminant check not performed - 6");
+                    if not Is_Ok (Cons (X), 1, 1, 1) then
+                        Comment ("Irrelevant");
+                    end if;
+                end;
+            exception
+                when Constraint_Error =>
+                    null;
+                when others =>
+                    Failed ("Unexpected exception raised - 6");
+            end;
+        exception
+            when others =>
+                Failed ("Constraint checked too soon - 6");
+        end;
+
+    end;
+
+    Result;
+
+exception
+    when others =>
+        Failed ("Constraint check done too early");
+        Result;
+end C380003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380004.a
new file mode 100644
index 000000000..f83728b5f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c380004.a
@@ -0,0 +1,385 @@
+-- C380004.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 ACAA 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 per-object expressions are evaluated as specified for entry
+--    families and protected components.  (Defect Report 8652/0002,
+--    as reflected in Technical Corrigendum 1, RM95 3.6(22/1), 3.8(18/1), and
+--    9.5.2(22/1)).
+--
+-- CHANGE HISTORY:
+--     9 FEB 2001   PHL   Initial version.
+--    29 JUN 2002   RLB   Readied for release.
+--
+--!
+with Report;
+use Report;
+procedure C380004 is
+
+    type Rec (D1, D2 : Positive) is
+        record
+            null;
+        end record;
+
+    F1_Poe : Integer;
+
+    function Chk (Poe : Integer; Value : Integer; Message : String)
+                 return Boolean is
+    begin
+        if Poe /= Value then
+            Failed (Message & ": Poe is " & Integer'Image (Poe));
+        end if;
+        return True;
+    end Chk;
+
+    function F1 return Integer is
+    begin
+        F1_Poe := F1_Poe - Ident_Int (1);
+        return F1_Poe;
+    end F1;
+
+    generic
+        type T is limited private;
+        with function Is_Ok (X : T;
+                             Param1 : Integer;
+                             Param2 : Integer;
+                             Param3 : Integer) return Boolean;
+    procedure Check;
+
+    procedure Check is
+    begin
+
+        declare
+            type Poe is new T;
+            Chk1 : Boolean := Chk (F1_Poe, 17, "F1 evaluated");
+            X : Poe;             -- F1 evaluated
+            Y : Poe;             -- F1 evaluated
+            Chk2 : Boolean := Chk (F1_Poe, 15, "F1 not evaluated");
+        begin
+            if not Is_Ok (T (X), 16, 16, 17) or
+               not Is_Ok (T (Y), 15, 15, 17) then
+                Failed ("Discriminant values not correct - 0");
+            end if;
+        end;
+
+        declare
+            type Poe is new T;
+        begin
+            begin
+                declare
+                    X : Poe;
+                begin
+                    if not Is_Ok (T (X), 14, 14, 17) then
+                        Failed ("Discriminant values not correct - 1");
+                    end if;
+                end;
+            exception
+                when others =>
+                    Failed ("Unexpected exception - 1");
+            end;
+
+            declare
+                type Acc_Poe is access Poe;
+                X : Acc_Poe;
+            begin
+                X := new Poe;
+                begin
+                    if not Is_Ok (T (X.all), 13, 13, 17) then
+                        Failed ("Discriminant values not correct - 2");
+                    end if;
+                end;
+            exception
+                when others =>
+                    Failed ("Unexpected exception raised - 2");
+            end;
+
+            declare
+                subtype Spoe is Poe;
+                X : Spoe;
+            begin
+                if not Is_Ok (T (X), 12, 12, 17) then
+                    Failed ("Discriminant values not correct - 3");
+                end if;
+            exception
+                when others =>
+                    Failed ("Unexpected exception raised - 3");
+            end;
+
+            declare
+                type Arr is array (1 .. 2) of Poe;
+                X : Arr;
+            begin
+                if Is_Ok (T (X (1)), 11, 11, 17) and then
+                   Is_Ok (T (X (2)), 10, 10, 17) then
+                    null;
+                elsif Is_Ok (T (X (2)), 11, 11, 17) and then
+                      Is_Ok (T (X (1)), 10, 10, 17) then
+                    null;
+                else
+                    Failed ("Discriminant values not correct - 4");
+                end if;
+            exception
+                when others =>
+                    Failed ("Unexpected exception raised - 4");
+            end;
+
+            declare
+                type Nrec is
+                    record
+                        C1, C2 : Poe;
+                    end record;
+                X : Nrec;
+            begin
+                if Is_Ok (T (X.C1), 8, 8, 17) and then
+                   Is_Ok (T (X.C2), 9, 9, 17) then
+                    null;
+                elsif Is_Ok (T (X.C2), 8, 8, 17) and then
+                      Is_Ok (T (X.C1), 9, 9, 17) then
+                    null;
+                else
+                    Failed ("Discriminant values not correct - 5");
+                end if;
+            exception
+                when others =>
+                    Failed ("Unexpected exception raised - 5");
+            end;
+
+            declare
+                type Drec is new Poe;
+                X : Drec;
+            begin
+                if not Is_Ok (T (X), 7, 7, 17) then
+                    Failed ("Discriminant values not correct - 6");
+                end if;
+            exception
+                when others =>
+                    Failed ("Unexpected exception raised - 6");
+            end;
+        end;
+    end Check;
+
+
+begin
+    Test ("C380004",
+          "Check evaluation of discriminant expressions " &
+             "when the constraint depends on a discriminant, " &
+             "and the discriminants have defaults - discriminant-dependent" &
+             "entry families and protected components");
+
+
+    Comment ("Discriminant-dependent entry families for task types");
+
+    F1_Poe := 18;
+
+    declare
+        task type Poe (D3 : Positive := F1) is
+            entry E (D3 .. F1);    -- F1 evaluated
+            entry Is_Ok (D3 : Integer;
+                         E_First : Integer;
+                         E_Last : Integer;
+                         Ok : out Boolean);
+        end Poe;
+        task body Poe is
+        begin
+            loop
+                select
+                    accept Is_Ok (D3 : Integer;
+                                  E_First : Integer;
+                                  E_Last : Integer;
+                                  Ok : out Boolean) do
+                        declare
+                            Cnt : Natural;
+                        begin
+                            if Poe.D3 = D3 then
+                                -- Can't think of a better way to check the
+                                -- bounds of the entry family.
+                                begin
+                                    Cnt := E (E_First)'Count;
+                                    Cnt := E (E_Last)'Count;
+                                exception
+                                    when Constraint_Error =>
+                                        Ok := False;
+                                        return;
+                                end;
+                                begin
+                                    Cnt := E (E_First - 1)'Count;
+                                    Ok := False;
+                                    return;
+                                exception
+                                    when Constraint_Error =>
+                                        null;
+                                    when others =>
+                                        Ok := False;
+                                        return;
+                                end;
+                                begin
+                                    Cnt := E (E_Last + 1)'Count;
+                                    Ok := False;
+                                    return;
+                                exception
+                                    when Constraint_Error =>
+                                        null;
+                                    when others =>
+                                        Ok := False;
+                                        return;
+                                end;
+                                Ok := True;
+                            else
+                                Ok := False;
+                                return;
+                            end if;
+                        end;
+                    end Is_Ok;
+                or
+                    terminate;
+                end select;
+            end loop;
+        end Poe;
+
+        function Is_Ok
+                    (C : Poe; D3 : Integer; E_First : Integer; E_Last : Integer)
+                    return Boolean is
+            Ok : Boolean;
+        begin
+            C.Is_Ok (D3, E_First, E_Last, Ok);
+            return Ok;
+        end Is_Ok;
+
+        procedure Chk is new Check (Poe, Is_Ok);
+
+    begin
+        Chk;
+    end;
+
+
+    Comment ("Discriminant-dependent entry families for protected types");
+
+    F1_Poe := 18;
+
+    declare
+        protected type Poe (D3 : Integer := F1) is
+            entry E (D3 .. F1);    -- F1 evaluated
+            function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer)
+                           return Boolean;
+        end Poe;
+        protected body Poe is
+            entry E (for I in D3 .. F1) when True is
+            begin
+                null;
+            end E;
+            function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer)
+                           return Boolean is
+                Cnt : Natural;
+            begin
+                if Poe.D3 = D3 then
+                    -- Can't think of a better way to check the
+                    -- bounds of the entry family.
+                    begin
+                        Cnt := E (E_First)'Count;
+                        Cnt := E (E_Last)'Count;
+                    exception
+                        when Constraint_Error =>
+                            return False;
+                    end;
+                    begin
+                        Cnt := E (E_First - 1)'Count;
+                        return False;
+                    exception
+                        when Constraint_Error =>
+                            null;
+                        when others =>
+                            return False;
+                    end;
+                    begin
+                        Cnt := E (E_Last + 1)'Count;
+                        return False;
+                    exception
+                        when Constraint_Error =>
+                            null;
+                        when others =>
+                            return False;
+                    end;
+                    return True;
+                else
+                    return False;
+                end if;
+            end Is_Ok;
+        end Poe;
+
+        function Is_Ok
+                    (C : Poe; D3 : Integer; E_First : Integer; E_Last : Integer)
+                    return Boolean is
+        begin
+            return C.Is_Ok (D3, E_First, E_Last);
+        end Is_Ok;
+
+        procedure Chk is new Check (Poe, Is_Ok);
+
+    begin
+        Chk;
+    end;
+
+    Comment ("Protected components");
+
+    F1_Poe := 18;
+
+    declare
+        protected type Poe (D3 : Integer := F1) is
+            function C1_D1 return Integer;
+            function C1_D2 return Integer;
+        private
+            C1 : Rec (D3, F1);    -- F1 evaluated
+        end Poe;
+        protected body Poe is
+            function C1_D1 return Integer is
+            begin
+                return C1.D1;
+            end C1_D1;
+            function C1_D2 return Integer is
+            begin
+                return C1.D2;
+            end C1_D2;
+        end Poe;
+
+        function Is_Ok (C : Poe; D3 : Integer; C1_D1 : Integer; C1_D2 : Integer)
+                       return Boolean is
+        begin
+            return C.D3 = D3 and C.C1_D1 = C1_D1 and C.C1_D2 = C1_D2;
+        end Is_Ok;
+
+        procedure Chk is new Check (Poe, Is_Ok);
+
+    begin
+        Chk;
+    end;
+
+    Result;
+
+exception
+    when others =>
+        Failed ("Unexpected exception");
+        Result;
+
+end C380004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38002a.ada
new file mode 100644
index 000000000..33d6eba8a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38002a.ada
@@ -0,0 +1,420 @@
+-- C38002A.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 UNCONSTRAINED ARRAY TYPE OR A RECORD WITHOUT
+--     DEFAULT DISCRIMINANTS CAN BE USED IN AN ACCESS_TYPE_DEFINITION
+--     WITHOUT AN INDEX OR DISCRIMINANT CONSTRAINT.
+--
+--     CHECK THAT (NON-STATIC) INDEX OR DISCRIMINANT CONSTRAINTS CAN
+--     SUBSEQUENTLY BE IMPOSED WHEN THE TYPE IS USED IN AN OBJECT
+--     DECLARATION, ARRAY COMPONENT DECLARATION, RECORD COMPONENT
+--     DECLARATION, ACCESS TYPE DECLARATION, PARAMETER DECLARATION,
+--     DERIVED TYPE DEFINITION, PRIVATE TYPE.
+--
+--     CHECK FOR UNCONSTRAINED GENERIC FORMAL TYPE.
+
+-- HISTORY:
+--     AH  09/02/86 CREATED ORIGINAL TEST.
+--     DHH 08/16/88 REVISED HEADER AND ENTERED COMMENTS FOR PRIVATE TYPE
+--                  AND CORRECTED INDENTATION.
+--     BCB 04/12/90 ADDED CHECKS FOR AN ARRAY AS A SUBPROGRAM RETURN
+--                  TYPE AND AN ARRAY AS A FORMAL PARAMETER.
+--     LDC 10/01/90 ADDED CODE SO F, FPROC, G, GPROC AREN'T OPTIMIZED 
+--                  AWAY
+
+WITH REPORT; USE REPORT;
+PROCEDURE C38002A IS
+
+BEGIN
+     TEST ("C38002A", "NON-STATIC CONSTRAINTS CAN BE IMPOSED " &
+           "ON ACCESS TYPES ACCESSING PREVIOUSLY UNCONSTRAINED " &
+           "ARRAY OR RECORD TYPES");
+
+     DECLARE
+          C3 : CONSTANT INTEGER := IDENT_INT(3);
+
+          TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          TYPE ARR_NAME IS ACCESS ARR;
+          SUBTYPE ARR_NAME_3 IS ARR_NAME(1..3);
+
+          TYPE REC(DISC : INTEGER) IS
+               RECORD
+                    COMP : ARR_NAME(1..DISC);
+               END RECORD;
+          TYPE REC_NAME IS ACCESS REC;
+
+          OBJ : REC_NAME(C3);
+
+          TYPE ARR2 IS ARRAY (1..10) OF REC_NAME(C3);
+
+          TYPE REC2 IS
+               RECORD
+                    COMP2 : REC_NAME(C3);
+               END RECORD;
+
+          TYPE NAME_REC_NAME IS ACCESS REC_NAME(C3);
+
+          TYPE DERIV IS NEW REC_NAME(C3);
+          SUBTYPE REC_NAME_3 IS REC_NAME(C3);
+
+          FUNCTION F (PARM : REC_NAME_3) RETURN REC_NAME_3 IS
+          BEGIN
+               IF NOT EQUAL(IDENT_INT(3), 1 + IDENT_INT(2)) THEN
+                    COMMENT("DON'T OPTIMIZE F AWAY");
+               END IF;
+               RETURN PARM;
+          END;
+
+          PROCEDURE FPROC (PARM : REC_NAME_3) IS
+          BEGIN
+               IF NOT EQUAL(IDENT_INT(4), 2 + IDENT_INT(2)) THEN
+                    COMMENT("DON'T OPTIMIZE FPROC AWAY");
+               END IF;
+          END FPROC;
+
+          FUNCTION G (PA : ARR_NAME_3) RETURN ARR_NAME_3 IS
+          BEGIN
+               IF NOT EQUAL(IDENT_INT(5), 3 + IDENT_INT(2)) THEN
+                    COMMENT("DON'T OPTIMIZE G AWAY");
+               END IF;
+               RETURN PA;
+          END G;
+
+          PROCEDURE GPROC (PA : ARR_NAME_3) IS
+          BEGIN
+               IF NOT EQUAL(IDENT_INT(6), 4 + IDENT_INT(2)) THEN
+                    COMMENT("DON'T OPTIMIZE GPROC AWAY");
+               END IF;
+          END GPROC;
+
+     BEGIN
+          DECLARE
+               R : REC_NAME;
+          BEGIN
+               R := NEW REC'(DISC => 3, COMP => NEW ARR'(1..3 => 5));
+               R := F(R);
+               R := NEW REC'(DISC => 4, COMP => NEW ARR'(1..4 => 5));
+               R := F(R);
+               FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                       "ACCEPTED BY FUNCTION FOR RECORD");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF R = NULL OR ELSE R.DISC /= 4 THEN
+                         FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
+                                 "ACCESS VALUE - RECORD,FUNCTION");
+                    END IF;
+          END;
+
+          DECLARE
+               R : REC_NAME;
+          BEGIN
+               R := NEW REC'(DISC => 3, COMP => NEW ARR'(1..3 => 5));
+               FPROC(R);
+               R := NEW REC'(DISC => 4, COMP => NEW ARR'(1..4 => 5));
+               FPROC(R);
+               FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                       "ACCEPTED BY PROCEDURE FOR RECORD");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF R = NULL OR ELSE R.DISC /= 4 THEN
+                         FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
+                                 "ACCESS VALUE - RECORD,PROCEDURE");
+                    END IF;
+          END;
+
+          DECLARE
+               A : ARR_NAME;
+          BEGIN
+               A := NEW ARR'(1..3 => 5);
+               A := G(A);
+               A := NEW ARR'(1..4 => 6);
+               A := G(A);
+               FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                       "ACCEPTED BY FUNCTION FOR ARRAY");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF A = NULL OR ELSE A(4) /= 6 THEN
+                         FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
+                                 "ACCESS VALUE - ARRAY,FUNCTION");
+                    END IF;
+          END;
+
+          DECLARE
+               A : ARR_NAME;
+          BEGIN
+               A := NEW ARR'(1..3 => 5);
+               GPROC(A);
+               A := NEW ARR'(1..4 => 6);
+               GPROC(A);
+               FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                       "ACCEPTED BY PROCEDURE FOR ARRAY");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF A = NULL OR ELSE A(4) /= 6 THEN
+                         FAILED ("ERROR IN EVALUATION/ASSIGNMENT OF " &
+                                 "ACCESS VALUE - ARRAY,PROCEDURE");
+                    END IF;
+          END;
+     END;
+
+     DECLARE
+          C3 : CONSTANT INTEGER := IDENT_INT(3);
+
+          TYPE REC (DISC : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE P_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          TYPE P_ARR_NAME IS ACCESS P_ARR;
+
+          TYPE P_REC_NAME IS ACCESS REC;
+
+          GENERIC
+               TYPE UNCON_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          PACKAGE P IS
+               TYPE ACC_REC IS ACCESS REC;
+               TYPE ACC_ARR IS ACCESS UNCON_ARR;
+               TYPE ACC_P_ARR IS ACCESS P_ARR;
+               SUBTYPE ACC_P_ARR_3 IS ACC_P_ARR(1..3);
+               OBJ : ACC_REC(C3);
+
+               TYPE ARR2 IS ARRAY (1..10) OF ACC_REC(C3);
+
+               TYPE REC1 IS
+                    RECORD
+                         COMP1 : ACC_REC(C3);
+                    END RECORD;
+
+               TYPE REC2 IS
+                    RECORD
+                         COMP2 : ACC_ARR(1..C3);
+                    END RECORD;
+
+               SUBTYPE ACC_REC_3 IS ACC_REC(C3);
+
+               FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3;
+
+               PROCEDURE FPROC (PARM : ACC_REC_3);
+
+               FUNCTION G (PA : ACC_P_ARR_3) RETURN ACC_P_ARR_3;
+
+               PROCEDURE GPROC (PA : ACC_P_ARR_3);
+
+               TYPE ACC1 IS PRIVATE;
+               TYPE ACC2 IS PRIVATE;
+               TYPE DER1 IS PRIVATE;
+               TYPE DER2 IS PRIVATE;
+
+          PRIVATE
+
+               TYPE ACC1 IS ACCESS ACC_REC(C3);
+               TYPE ACC2 IS ACCESS ACC_ARR(1..C3);
+               TYPE DER1 IS NEW ACC_REC(C3);
+               TYPE DER2 IS NEW ACC_ARR(1..C3);
+          END P;
+
+          PACKAGE BODY P IS
+               FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3 IS
+               BEGIN
+                    IF NOT EQUAL(IDENT_INT(3), 1 + IDENT_INT(2)) THEN
+                         COMMENT("DON'T OPTIMIZE F AWAY");
+                    END IF;
+                    RETURN PARM;
+               END;
+
+               PROCEDURE FPROC (PARM : ACC_REC_3) IS
+               BEGIN
+                    IF NOT EQUAL(IDENT_INT(4), 2 + IDENT_INT(2)) THEN
+                         COMMENT("DON'T OPTIMIZE FPROC AWAY");
+                    END IF;
+               END FPROC;
+
+               FUNCTION G (PA : ACC_P_ARR_3) RETURN ACC_P_ARR_3 IS
+               BEGIN
+                    IF NOT EQUAL(IDENT_INT(5), 3 + IDENT_INT(2)) THEN
+                         COMMENT("DON'T OPTIMIZE G AWAY");
+                    END IF;
+                    RETURN PA;
+               END;
+
+               PROCEDURE GPROC (PA : ACC_P_ARR_3) IS
+               BEGIN
+                    IF NOT EQUAL(IDENT_INT(6), 4 + IDENT_INT(2)) THEN
+                         COMMENT("DON'T OPTIMIZE GPROC AWAY");
+                    END IF;
+               END GPROC;
+          END P;
+
+          PACKAGE NP IS NEW P (UNCON_ARR => P_ARR);
+
+          USE NP;
+
+     BEGIN
+          DECLARE
+               R : ACC_REC;
+          BEGIN
+               R := NEW REC(DISC => 3);
+               R := F(R);
+               R := NEW REC(DISC => 4);
+               R := F(R);
+               FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                       "ACCEPTED BY FUNCTION FOR A RECORD -GENERIC");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF R = NULL OR ELSE R.DISC /= 4 THEN
+                         FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                 "OF ACCESS VALUE - RECORD," &
+                                 "FUNCTION -GENERIC");
+                    END IF;
+          END;
+
+          DECLARE
+               R : ACC_REC;
+          BEGIN
+               R := NEW REC(DISC => 3);
+               FPROC(R);
+               R := NEW REC(DISC => 4);
+               FPROC(R);
+               FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                       "ACCEPTED BY PROCEDURE FOR A RECORD -GENERIC");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF R = NULL OR ELSE R.DISC /= 4 THEN
+                         FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                 "OF ACCESS VALUE - RECORD," &
+                                 "PROCEDURE -GENERIC");
+                    END IF;
+          END;
+
+          DECLARE
+               A : ACC_P_ARR;
+          BEGIN
+               A := NEW P_ARR'(1..3 => 5);
+               A := G(A);
+               A := NEW P_ARR'(1..4 => 6);
+               A := G(A);
+               FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                       "ACCEPTED BY FUNCTION FOR AN ARRAY -GENERIC");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF A = NULL OR ELSE A(4) /= 6 THEN
+                         FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                 "OF ACCESS VALUE - ARRAY," &
+                                 "FUNCTION -GENERIC");
+                    END IF;
+          END;
+
+          DECLARE
+               A : ACC_P_ARR;
+          BEGIN
+               A := NEW P_ARR'(1..3 => 5);
+               GPROC(A);
+               A := NEW P_ARR'(1..4 => 6);
+               GPROC(A);
+               FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                       "ACCEPTED BY PROCEDURE FOR AN ARRAY -GENERIC");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF A = NULL OR ELSE A(4) /= 6 THEN
+                         FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                 "OF ACCESS VALUE - ARRAY," &
+                                 "PROCEDURE -GENERIC");
+                    END IF;
+          END;
+     END;
+
+     DECLARE
+          TYPE CON_INT IS RANGE 1..10;
+
+          GENERIC
+               TYPE UNCON_INT IS RANGE <>;
+          PACKAGE P2 IS
+               SUBTYPE NEW_INT IS UNCON_INT RANGE 1..5;
+               FUNCTION FUNC_INT (PARM : NEW_INT) RETURN NEW_INT;
+
+               PROCEDURE PROC_INT (PARM : NEW_INT);
+          END P2;
+
+          PACKAGE BODY P2 IS
+               FUNCTION FUNC_INT (PARM : NEW_INT) RETURN NEW_INT IS
+               BEGIN
+                    IF NOT EQUAL(IDENT_INT(3), 1 + IDENT_INT(2)) THEN
+                         COMMENT("DON'T OPTIMIZE F AWAY");
+                    END IF;
+                    RETURN PARM;
+               END FUNC_INT;
+
+               PROCEDURE PROC_INT (PARM : NEW_INT) IS
+               BEGIN
+                    IF NOT EQUAL(IDENT_INT(4), 2 + IDENT_INT(2)) THEN
+                         COMMENT("DON'T OPTIMIZE FPROC AWAY");
+                    END IF;
+               END PROC_INT;
+          END P2;
+
+          PACKAGE NP2 IS NEW P2 (UNCON_INT => CON_INT);
+
+          USE NP2;
+
+     BEGIN
+          DECLARE
+               R : CON_INT;
+          BEGIN
+               R := 2;
+               R := FUNC_INT(R);
+               R := 8;
+               R := FUNC_INT(R);
+               FAILED ("INCOMPATIBLE CONSTRAINT ON VALUE " &
+                       "ACCEPTED BY FUNCTION -GENERIC");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF R /= 8 THEN
+                         FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                 "OF VALUE -FUNCTION, GENERIC");
+                    END IF;
+          END;
+
+          DECLARE
+               R : CON_INT;
+          BEGIN
+               R := 2;
+               PROC_INT(R);
+               R := 9;
+               PROC_INT(R);
+               FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE " &
+                       "ACCEPTED BY PROCEDURE -GENERIC");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF R /= 9 THEN
+                         FAILED ("ERROR IN EVALUATION/ASSIGNMENT " &
+                                 "OF ACCESS VALUE - PROCEDURE, " &
+                                 "GENERIC");
+                    END IF;
+          END;
+     END;
+
+     RESULT;
+END C38002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38002b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38002b.ada
new file mode 100644
index 000000000..9a51c9b8a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38002b.ada
@@ -0,0 +1,123 @@
+-- C38002B.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 UNCONSTRAINED ARRAY TYPE OR A RECORD WITHOUT
+--     DEFAULT DISCRIMINANTS CAN BE USED IN AN ACCESS_TYPE_DEFINITION
+--     WITHOUT AN INDEX OR DISCRIMINANT CONSTRAINT.
+--
+--     CHECK THAT (NON-STATIC) INDEX OR DISCRIMINANT CONSTRAINTS CAN
+--     SUBSEQUENTLY BE IMPOSED WHEN THE TYPE IS USED IN AN OBJECT
+--     DECLARATION, ARRAY COMPONENT DECLARATION, RECORD COMPONENT
+--     DECLARATION, ACCESS TYPE DECLARATION, PARAMETER DECLARATION,
+--     ALLOCATOR, DERIVED TYPE DEFINITION, PRIVATE TYPE, OR AS THE
+--     RETURN TYPE IN A FUNCTION DECLARATION.
+--
+--     CHECK FOR GENERIC FORMAL ACCESS TYPES.
+
+-- HISTORY:
+--     AH  09/02/86 CREATED ORIGINAL TEST.
+--     DHH 08/22/88 REVISED HEADER, ADDED 'PRIVATE TYPE' TO COMMENTS
+--                  AND CORRECTED INDENTATION.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C38002B IS
+
+     C3 : CONSTANT INTEGER := IDENT_INT(3);
+
+     TYPE UNCON_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+     TYPE REC (DISC : INTEGER) IS
+          RECORD
+               NULL;
+          END RECORD;
+
+     TYPE P_ARR_NAME IS ACCESS UNCON_ARR;
+     TYPE P_REC_NAME IS ACCESS REC;
+
+     GENERIC
+          TYPE ACC_REC IS ACCESS REC;
+          TYPE ACC_ARR IS ACCESS UNCON_ARR;
+     PACKAGE P IS
+          OBJ : ACC_REC(C3);
+
+          TYPE ARR2 IS ARRAY (1..10) OF ACC_REC(C3);
+
+          TYPE REC1 IS
+               RECORD
+                    COMP1 : ACC_REC(C3);
+               END RECORD;
+
+          TYPE REC2 IS
+               RECORD
+                    COMP2 : ACC_ARR(1..C3);
+               END RECORD;
+
+          SUBTYPE ACC_REC_3 IS ACC_REC(C3);
+          R : ACC_REC;
+
+          FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3;
+
+          TYPE ACC1 IS PRIVATE;
+          TYPE ACC2 IS PRIVATE;
+          TYPE DER1 IS PRIVATE;
+          TYPE DER2 IS PRIVATE;
+
+     PRIVATE
+
+          TYPE ACC1 IS ACCESS ACC_REC(C3);
+          TYPE ACC2 IS ACCESS ACC_ARR(1..C3);
+          TYPE DER1 IS NEW ACC_REC(C3);
+          TYPE DER2 IS NEW ACC_ARR(1..C3);
+     END P;
+
+     PACKAGE BODY P IS
+          FUNCTION F (PARM : ACC_REC_3) RETURN ACC_REC_3 IS
+          BEGIN
+               RETURN PARM;
+          END;
+     END P;
+
+     PACKAGE NP IS NEW P (ACC_REC => P_REC_NAME, ACC_ARR => P_ARR_NAME);
+
+     USE NP;
+BEGIN
+     TEST ("C38002B", "NON-STATIC CONSTRAINTS CAN BE IMPOSED " &
+           "ON ACCESS TYPES ACCESSING PREVIOUSLY UNCONSTRAINED " &
+           "ARRAY OR RECORD TYPES");
+
+     R := NEW REC(DISC => 3);
+     R := F(R);
+     R := NEW REC(DISC => 4);
+     R := F(R);
+     FAILED ("INCOMPATIBLE CONSTRAINT ON ACCESS VALUE ACCEPTED " &
+             "BY GENERIC FUNCTION");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF R = NULL OR ELSE R.DISC /= 4 THEN
+                    FAILED (" ERROR IN EVALUATION/ASSIGNMENT OF " &
+                            "GENERIC ACCESS VALUE");
+               END IF;
+
+     RESULT;
+END C38002B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38005a.ada
new file mode 100644
index 000000000..75a83a8a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38005a.ada
@@ -0,0 +1,170 @@
+-- C38005A.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 (UNINITIALIZED) ACCESS OBJECTS ARE INITIALIZED
+-- TO NULL BY DEFAULT. VARIABLES, ARRAYS, RECORDS, ARRAYS OF RECORDS,
+-- ARRAYS OF ARRAYS, RECORDS WITH ARRAYS AND RECORD COMPONENTS
+-- ARE ALL CHECKED.
+-- FUNCTION RESULTS (I.E. RETURNED FROM IMPLICIT FUNCTION RETURN)
+-- ARE NOT CHECKED.
+
+-- DAT 3/6/81
+-- VKG 1/5/83
+-- SPS 2/17/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C38005A IS
+
+     TYPE REC;
+     TYPE ACC_REC IS ACCESS REC;
+     TYPE VECTOR IS ARRAY ( NATURAL RANGE <> ) OF ACC_REC;
+     TYPE REC IS RECORD
+          VECT : VECTOR (3 .. 5);
+     END RECORD;
+
+     TYPE ACC_VECT IS ACCESS VECTOR;
+     TYPE ARR_REC IS ARRAY (1 .. 2) OF REC;
+     TYPE REC2;
+     TYPE ACC_REC2 IS ACCESS REC2;
+     TYPE REC2 IS RECORD
+          C1 : ACC_REC;
+          C2 : ACC_VECT;
+          C3 : ARR_REC;
+          C4 : REC;
+          C5 : ACC_REC2;
+     END RECORD;
+
+     N_REC      : REC;
+     N_ACC_REC  : ACC_REC;
+     N_VEC      : VECTOR (3 .. IDENT_INT (5));
+     N_ACC_VECT : ACC_VECT;
+     N_ARR_REC  : ARR_REC;
+     N_REC2     : REC2;
+     N_ACC_REC2 : ACC_REC2;
+     N_ARR      : ARRAY (1..2) OF VECTOR (1..2);
+     Q : REC2 :=
+                (C1 => NEW REC,
+                 C2 => NEW VECTOR'(NEW REC, NEW REC'(N_REC)),
+                 C3 => (1 | 2 => (VECT=>(3|4=> NEW REC, 
+                                         5=>N_ACC_REC)
+                                 )),
+                 C4 => N_REC2.C4,
+                 C5 => NEW REC2'(N_REC2));
+
+BEGIN
+     TEST ("C38005A", "DEFAULT VALUE FOR ACCESS OBJECTS IS NULL");
+
+     IF N_REC /= REC'(VECT => (3..5 => NULL))
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 1");
+     END IF;
+
+     IF N_ACC_REC /= NULL
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 2");
+     END IF;
+
+     IF N_VEC /= N_REC.VECT
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 3");
+     END IF;
+
+     IF N_ARR /= ((NULL, NULL), (NULL, NULL))
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 4");
+     END IF;
+
+     IF N_ACC_VECT /= NULL
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 5");
+     END IF;
+
+     IF N_ARR_REC /= (N_REC, N_REC)
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 6");
+     END IF;
+
+     IF N_REC2 /= (NULL, NULL, N_ARR_REC, N_REC, NULL)
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 7");
+     END IF;
+
+     IF N_ACC_REC2 /= NULL
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 8");
+     END IF;
+
+     IF Q /= (Q.C1, Q.C2, (Q.C3(1), Q.C3(2)), N_REC, Q.C5)
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 9");
+     END IF;
+
+     IF Q.C1.ALL /= N_REC
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 10");
+     END IF;
+
+     IF Q.C2.ALL(0).ALL /= N_REC
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 11");
+     END IF;
+
+     IF Q.C2(1).VECT /= N_VEC
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 12");
+     END IF;
+
+     IF Q.C3(2).VECT /= (3 => Q.C3(2).VECT(3),
+                         4 => Q.C3(2).VECT(4),
+                         5=>NULL)
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 13");
+     END IF;
+
+     IF Q.C3(2).VECT(3).ALL /= N_REC
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 14");
+     END IF;
+
+     IF Q.C5.ALL /= N_REC2
+     THEN
+          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 15");
+     END IF;
+
+     DECLARE
+          PROCEDURE T (R : OUT REC2) IS
+          BEGIN
+               NULL;
+          END T;
+     BEGIN
+          N_REC2 := Q;
+          T(Q);
+          IF Q /= N_REC2 THEN
+               FAILED ("INCORRECT OUT PARM INIT 2");
+          END IF;
+     END;
+
+     RESULT;
+END C38005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38005b.ada
new file mode 100644
index 000000000..1c2770425
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38005b.ada
@@ -0,0 +1,98 @@
+-- C38005B.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 ANY OBJECT WITH A FORMAL PRIVATE TYPE, WHOSE ACTUAL
+--     TYPE IN AN INSTANTIATION IS AN ACCESS TYPE, IS INITIALIZED BY
+--     DEFAULT TO THE VALUE NULL. THIS INCLUDES OBJECTS WHICH ARE ARRAY
+--     AND RECORD COMPONENTS.
+
+-- HISTORY:
+--     DHH 07/12/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C38005B IS
+
+BEGIN
+     TEST("C38005B", "CHECK THAT ANY OBJECT WITH A FORMAL PRIVATE " &
+                     "TYPE, WHOSE ACTUAL TYPE IN AN INSTANTIATION " &
+                     "IS AN ACCESS TYPE, IS INITIALIZED BY DEFAULT " &
+                     "TO THE VALUE NULL. THIS INCLUDES OBJECTS WHICH " &
+                     "ARE ARRAY AND RECORD COMPONENTS");
+     DECLARE
+          TYPE ARRY IS ARRAY(1 .. 10) OF BOOLEAN;
+          TYPE REC1 IS
+               RECORD
+                    A : INTEGER;
+                    B : ARRY;
+               END RECORD;
+
+          TYPE POINTER IS ACCESS REC1;
+
+          GENERIC
+               TYPE NEW_PTR IS PRIVATE;
+          PACKAGE GEN_PACK IS
+               TYPE PTR_ARY IS ARRAY(1 .. 5) OF NEW_PTR;
+               TYPE RECORD1 IS
+                    RECORD
+                         A : NEW_PTR;
+                         B : PTR_ARY;
+                    END RECORD;
+
+               OBJ : NEW_PTR;
+               ARY : PTR_ARY;
+               REC : RECORD1;
+          END GEN_PACK;
+
+          PACKAGE TEST_P IS NEW GEN_PACK(POINTER);
+          USE TEST_P;
+
+     BEGIN
+          IF OBJ /= NULL THEN
+               FAILED("OBJECT NOT INITIALIZED TO NULL");
+          END IF;
+
+          FOR I IN 1 .. 5 LOOP
+               IF ARY(I) /= NULL THEN
+                    FAILED("ARRAY COMPONENT " &
+                            INTEGER'IMAGE(I) &
+                           " NOT INITIALIZED TO NULL");
+               END IF;
+          END LOOP;
+
+          IF REC.A /= NULL THEN
+               FAILED("RECORD OBJECT NOT INITIALIZED TO NULL");
+          END IF;
+
+          FOR I IN 1 .. 5 LOOP
+               IF REC.B(I) /= NULL THEN
+                    FAILED("RECORD SUBCOMPONENT " &
+                           INTEGER'IMAGE(I) &
+                           " NOT INITIALIZED TO NULL");
+               END IF;
+          END LOOP;
+     END;
+
+     RESULT;
+END C38005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38005c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38005c.ada
new file mode 100644
index 000000000..5512ecbbf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38005c.ada
@@ -0,0 +1,156 @@
+-- C38005C.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 ALL OBJECTS OF FORMAL ACCESS TYPE, INCLUDING ARRAY AND
+--     RECORD COMPONENTS, ARE INITIALIZED BY DEFAULT WITH THE VALUE
+--     NULL.
+
+-- HISTORY:
+--     DHH 08/04/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C38005C IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+
+     TYPE ACC_I IS ACCESS INT;
+
+     SUBTYPE NEW_NODE IS CHARACTER;
+
+     TYPE ACC_CHAR IS ACCESS NEW_NODE;
+
+     X : ACC_I := NEW INT'(IDENT_INT(5));
+     Y : NEW_NODE := 'A';
+     Z : ACC_CHAR := NEW NEW_NODE'(Y);
+
+     GENERIC
+          TYPE ACC_INT IS ACCESS INT;
+          TYPE NODE IS PRIVATE;
+          TYPE LINK IS ACCESS NODE;
+     PROCEDURE P(U : ACC_INT; V : NODE; W : LINK);
+
+     GENERIC
+          TYPE ACC_INT IS ACCESS INT;
+          TYPE NODE IS PRIVATE;
+          TYPE LINK IS ACCESS NODE;
+     PACKAGE PACK IS
+
+          SUBTYPE NEW_ACC IS ACC_INT;
+
+          SUBTYPE NEW_L IS LINK;
+
+          TYPE ARR IS ARRAY(1 .. 4) OF ACC_INT;
+
+          TYPE REC IS
+               RECORD
+                    I : ACC_INT;
+                    L : LINK;
+               END RECORD;
+
+     END PACK;
+
+     PACKAGE NEW_PACK IS NEW PACK(ACC_I, NEW_NODE, ACC_CHAR);
+     USE NEW_PACK;
+
+     A : NEW_PACK.NEW_ACC;
+     B : NEW_PACK.NEW_L;
+     C : NEW_PACK.ARR;
+     D : NEW_PACK.REC;
+
+     PROCEDURE P(U : ACC_INT; V : NODE; W : LINK) IS
+
+          TYPE ARR IS ARRAY(1 .. 4) OF ACC_INT;
+
+          TYPE REC IS
+               RECORD
+                    I : ACC_INT;
+                    L : LINK;
+               END RECORD;
+
+          A : ACC_INT;
+          B : LINK;
+          C : ARR;
+          D : REC;
+
+     BEGIN
+          IF A /= NULL THEN
+               FAILED("OBJECT A NOT INITIALIZED - PROC");
+          END IF;
+
+          IF B /= NULL THEN
+               FAILED("OBJECT B NOT INITIALIZED - PROC");
+          END IF;
+
+          FOR I IN 1 .. 4 LOOP
+               IF C(I) /= NULL THEN
+                    FAILED("ARRAY " & INTEGER'IMAGE(I) &
+                           "NOT INITIALIZED - PROC");
+               END IF;
+          END LOOP;
+
+          IF D.I /= NULL THEN
+               FAILED("RECORD.I NOT INITIALIZED - PROC");
+          END IF;
+
+          IF D.L /= NULL THEN
+               FAILED("RECORD.L NOT INITIALIZED - PROC");
+          END IF;
+
+     END P;
+
+     PROCEDURE PROC IS NEW P(ACC_I, NEW_NODE, ACC_CHAR);
+
+BEGIN
+     TEST("C38005C", "CHECK THAT ALL OBJECTS OF FORMAL ACCESS TYPE, " &
+                     "INCLUDING ARRAY AND RECORD COMPONENTS, ARE " &
+                     "INITIALIZED BY DEFAULT WITH THE VALUE NULL");
+
+     PROC(X, Y, Z);
+
+     IF A /= NULL THEN
+          FAILED("OBJECT A NOT INITIALIZED - PACK");
+     END IF;
+
+     IF B /= NULL THEN
+          FAILED("OBJECT B NOT INITIALIZED - PACK");
+     END IF;
+
+     FOR I IN 1 .. 4 LOOP
+          IF C(I) /= NULL THEN
+               FAILED("ARRAY " & INTEGER'IMAGE(I) &
+                      "NOT INITIALIZED - PACK");
+          END IF;
+     END LOOP;
+
+     IF D.I /= NULL THEN
+          FAILED("RECORD.I NOT INITIALIZED - PACK");
+     END IF;
+
+     IF D.L /= NULL THEN
+          FAILED("RECORD.L NOT INITIALIZED - PACK");
+     END IF;
+
+     RESULT;
+END C38005C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38006a.ada
new file mode 100644
index 000000000..a4f0c90db
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38006a.ada
@@ -0,0 +1,50 @@
+-- C38006A.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 OBJECTS ACCESSED BY CONSTANTS CAN BE MODIFIED.
+
+-- DAT 3/6/81
+-- SPS 10/25/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C38006A IS
+
+     TYPE AI IS ACCESS INTEGER;
+
+     C : CONSTANT AI := NEW INTEGER'(1);
+
+BEGIN
+     TEST ("C38006A", "OBJECTS ACCESSED BY CONSTANTS MAY BE ASSIGNED");
+
+     FOR I IN 1 .. 10 LOOP
+          IF C.ALL /= I AND I > 1 THEN
+               FAILED ("OBJECT ACCESSED THRU CONSTANT NOT CHANGED");
+               EXIT;
+          END IF;
+          C.ALL := C.ALL + 1;
+     END LOOP;
+
+     RESULT;
+END C38006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102a.ada
new file mode 100644
index 000000000..32649abcd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102a.ada
@@ -0,0 +1,158 @@
+-- C38102A.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 INCOMPLETE TYPE DECLARATION CAN BE GIVEN FOR ANY TYPE.
+-- FULL DECLARATIONS FOR INTEGER, ENUMERATION, CONSTRAINED AND
+-- UNCONSTRAINED ARRAYS, RECORDS WITHOUT DISCRIMINANTS,
+-- AN ACCESS TYPE, OR TYPES DERIVED FROM ANY OF THE ABOVE.
+
+-- (FLOAT, FIXED, TASKS AND RECORDS WITH DISCRIMINANTS ARE CHECKED
+-- IN OTHER TESTS).
+
+-- DAT 3/24/81
+-- SPS 10/25/82
+-- SPS 2/17/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C38102A IS
+BEGIN
+     TEST ("C38102A", "ANY TYPE MAY BE INCOMPLETE");
+
+     DECLARE
+
+          TYPE X1;
+          TYPE X2;
+          TYPE X3;
+          TYPE X4;
+          TYPE X5;
+          TYPE X6;
+          TYPE X7;
+          TYPE X8;
+     
+          TYPE D1;
+          TYPE D2;
+          TYPE D3;
+          TYPE D4;
+          TYPE D5;
+          TYPE D6;
+     
+          TYPE X1 IS RANGE 1 .. 10;
+          TYPE X2 IS (TRUE, FALSE, MAYBE, GREEN);
+          TYPE X3 IS ARRAY (1 .. 3) OF STRING (1..10);
+          TYPE X4 IS ARRAY (NATURAL RANGE <> ) OF X3;
+          TYPE AR1 IS ARRAY (X2) OF X3;
+          TYPE X5 IS RECORD
+               C1 : X4 (1..3);
+               C2 : AR1;
+          END RECORD;
+          TYPE X6 IS ACCESS X8;
+          TYPE X7 IS ACCESS X6;
+          TYPE X8 IS ACCESS X6;
+     
+          TYPE D1 IS NEW X1;
+          TYPE D2 IS NEW X2;
+          TYPE D3 IS NEW X3;
+          TYPE D4 IS NEW X4;
+          TYPE D5 IS NEW X5;
+          SUBTYPE D7 IS X7;
+          SUBTYPE D8 IS X8;
+          TYPE D6 IS ACCESS D8;
+     
+          PACKAGE P IS
+     
+               TYPE X1;
+               TYPE X2;
+               TYPE X3;
+               TYPE X4;
+               TYPE X5;
+               TYPE X6;
+               TYPE X7 IS PRIVATE;
+               TYPE X8 IS LIMITED PRIVATE;
+     
+               TYPE D1;
+               TYPE D2;
+               TYPE D3;
+               TYPE D4;
+               TYPE D5;
+               TYPE D6;
+     
+               TYPE X1 IS RANGE 1 .. 10;
+               TYPE X2 IS (TRUE, FALSE, MAYBE, GREEN);
+               TYPE X3 IS ARRAY (1 .. 3) OF STRING (1..10);
+               TYPE X4 IS ARRAY (NATURAL RANGE <> ) OF X3;
+               TYPE AR1 IS ARRAY (X2) OF X3;
+               TYPE X5 IS RECORD
+                    C1 : X4 (1..3);
+                    C2 : AR1;
+               END RECORD;
+               TYPE X6 IS ACCESS X8;
+     
+               TYPE D1 IS RANGE 1 .. 10;
+               TYPE D2 IS NEW X2;
+               TYPE D3 IS NEW X3;
+               TYPE D4 IS NEW X4;
+               TYPE D5 IS NEW X5;
+               TYPE D6 IS NEW X6;
+               SUBTYPE D7 IS X7;
+               SUBTYPE D8 IS X8;
+               TYPE D9 IS ACCESS D8;
+
+               VX7 : CONSTANT X7;
+     
+          PRIVATE
+     
+               TYPE X7 IS RECORD
+                    C1 : X1;
+                    C3 : X3;
+                    C5 : X5;
+                    C6 : X6;
+                    C8 : D9;
+               END RECORD;
+
+               V3 : X3 := (X3'RANGE => "ABCDEFGHIJ");
+               TYPE A7 IS ACCESS X7;
+               TYPE X8 IS ARRAY (V3'RANGE) OF A7;
+     
+               VX7 : CONSTANT X7 := (3, V3, ((1..3=>V3),
+                    (TRUE..GREEN=>V3)), NULL,
+                    NEW D8);
+          END P;
+          USE P;
+
+          VD7: P.D7;
+
+          PACKAGE BODY P IS
+          BEGIN
+               VD7 := D7(VX7);
+          END P;
+
+     BEGIN
+          IF VX7 /= P.X7(VD7) THEN
+               FAILED ("WRONG VALUE SOMEWHERE");
+          END IF;
+     END;
+
+     RESULT;
+END C38102A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102b.ada
new file mode 100644
index 000000000..c9e4bc272
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102b.ada
@@ -0,0 +1,56 @@
+-- C38102B.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 INCOMPLETE TYPES CAN BE FLOAT.
+
+-- DAT 3/24/81
+-- SPS 10/25/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C38102B IS
+
+BEGIN
+     TEST ("C38102B", "INCOMPLETE TYPE CAN BE FLOAT");
+     
+     DECLARE
+
+          TYPE F;
+          TYPE G;
+          TYPE AF IS ACCESS F;
+          TYPE F IS DIGITS 2;
+          TYPE G IS NEW F RANGE 1.0 .. 1.5;
+          TYPE AG IS ACCESS G RANGE 1.0 .. 1.3;
+     
+          XF : AF := NEW F' (2.0);
+          XG : AG := NEW G' (G (XF.ALL/2.0));
+
+     BEGIN
+          IF XG.ALL NOT IN G THEN
+               FAILED ("ACCESS TO FLOAT");
+          END IF;
+     END;
+     
+     RESULT;
+END C38102B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102c.ada
new file mode 100644
index 000000000..a4128ae98
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102c.ada
@@ -0,0 +1,60 @@
+-- C38102C.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 INCOMPLETE TYPES CAN BE FIXED.
+
+-- HISTORY:
+--     DAT 03/24/81  CREATED ORIGINAL TEST.
+--     SPS 10/25/82
+--     BCB 10/21/87  CHANGED HEADER TO STANDARD FORMAT.  CHANGED VARIOUS
+--                   VALUES TO CORRECT CONSTRAINT PROBLEMS.  CHANGED
+--                   THE VALUE OF F'DELTA, USING A POWER OF TWO.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C38102C IS
+BEGIN
+     TEST ("C38102C", "INCOMPLETE TYPE CAN BE FIXED");
+
+     DECLARE
+
+          TYPE F;
+          TYPE G;
+          TYPE AF IS ACCESS F;
+          TYPE F IS DELTA 0.25 RANGE -2.0 .. 2.0;
+          TYPE G IS NEW F RANGE -1.0 .. 1.5;
+          TYPE AG IS ACCESS G RANGE -0.75 .. 1.25;
+
+          XF : AF := NEW F '(1.0);
+          XG : AG := NEW G '(G (XF.ALL/2));
+
+     BEGIN
+          IF XG.ALL NOT IN G THEN
+               FAILED ("ACCESS TO FIXED");
+          END IF;
+     END;
+
+     RESULT;
+END C38102C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102d.ada
new file mode 100644
index 000000000..60361272e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102d.ada
@@ -0,0 +1,54 @@
+-- C38102D.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 INCOMPLETE TYPE CAN BE REDECLARED AS A TASK TYPE.
+
+-- AH    8/14/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C38102D IS
+     GLOBAL : INTEGER := 0;
+BEGIN
+     TEST("C38102D", "INCOMPLETE TYPES CAN BE TASKS");
+     DECLARE
+          TYPE T1;
+          TASK TYPE T1 IS
+               ENTRY E(LOCAL : IN OUT INTEGER);
+          END T1;
+          T1_OBJ : T1;
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT E(LOCAL : IN OUT INTEGER) DO
+                    LOCAL := IDENT_INT(2);
+               END E;
+          END T1;
+     BEGIN
+          T1_OBJ.E(GLOBAL);
+     END;
+
+     IF GLOBAL /= IDENT_INT(2) THEN
+          FAILED ("TASK NOT EXECUTED");
+     END IF;
+     RESULT;
+END C38102D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102e.ada
new file mode 100644
index 000000000..6ffec0599
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38102e.ada
@@ -0,0 +1,164 @@
+-- C38102E.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 INCOMPLETE TYPE CAN BE REDECLARED AS A DERIVED GENERIC 
+-- FORMAL TYPE.
+
+-- AH     8/15/86
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+-- DNT 11/28/95  CHANGED TO FLAG1 := F4.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C38102E IS
+     TYPE RAINBOW IS (RED, ORANGE, YELLOW, GREEN, BLUE, INDIGO, VIOLET);
+     TYPE T_FLOAT IS DIGITS 5 RANGE -4.0 .. 4.0;
+     TYPE T_FIXED IS DELTA 0.01 RANGE 0.0 .. 1.5;
+     SUBTYPE P1 IS INTEGER;
+     TYPE P2 IS RANGE 0 .. 10;
+     TYPE P3 IS ARRAY (P2) OF INTEGER;
+     TYPE P4 IS ARRAY (P2, P2) OF INTEGER;
+
+     F1, F2 : BOOLEAN;
+
+     GENERIC
+          TYPE G1 IS (<>);
+          TYPE G2 IS RANGE <>;
+     FUNCTION G_DISCRETE RETURN BOOLEAN;
+
+     FUNCTION G_DISCRETE RETURN BOOLEAN IS
+          TYPE INC1;
+          TYPE INC2;
+          TYPE F1 IS NEW G1;
+          TYPE INC1 IS NEW G1;
+          TYPE INC2 IS NEW G2;
+
+          OBJ1_0 : INC1;
+          OBJ1_1 : INC1;
+          OBJ2_0 : INC2;
+          OBJ2_1 : INC2;
+          OBJ3 : F1;
+
+          RESULT_VALUE1 : BOOLEAN := FALSE;
+          RESULT_VALUE2 : BOOLEAN := FALSE;
+     BEGIN
+          OBJ3 := F1'LAST;
+          OBJ3 := F1'PRED(OBJ3);
+          IF INC1(OBJ3) = INC1'PRED(INC1'LAST) THEN
+               RESULT_VALUE1 := TRUE;
+          END IF;
+          OBJ2_0 := INC2'FIRST;
+          OBJ2_1 := INC2'LAST;
+          IF (OBJ2_0 + OBJ2_1) = (INC2'SUCC(OBJ2_0) +
+                                  INC2'PRED(OBJ2_1)) THEN
+               RESULT_VALUE2 := TRUE;
+          END IF;
+
+          RETURN (RESULT_VALUE1 AND RESULT_VALUE2);
+     END G_DISCRETE;
+
+     GENERIC
+          TYPE G3 IS DIGITS <>;
+          TYPE G4 IS DELTA <>;
+     PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN);
+
+     PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN) IS
+          F1, F2, F3, F4, F5, F6, F7, F8 : BOOLEAN;
+          TYPE INC3;
+          TYPE INC4;
+          TYPE P1 IS NEW G3;
+          TYPE P2 IS NEW G4;
+          TYPE INC3 IS NEW G3;
+          TYPE INC4 IS NEW G4;
+     BEGIN
+          F4 := P1'LAST = P1(INC3'LAST) AND P1'FIRST = P1(INC3'FIRST);
+
+          F5 := P2'FORE = INC4'FORE;
+          F6 := P2'AFT = INC4'AFT;
+          F7 := ABS(P2'LAST - P2'FIRST) = P2(ABS(INC4'LAST -
+                                                 INC4'FIRST));
+          F8 := INC4(P2'LAST / P2'LAST) = INC4(INC4'LAST / INC4'LAST);
+
+          FLAG1 := F4;
+          FLAG2 := F5 AND F6 AND F7 AND F8;
+     END REALS;
+
+     GENERIC
+          TYPE ITEM IS PRIVATE;
+          TYPE INDEX IS RANGE <>;
+          TYPE G5 IS ARRAY (INDEX) OF ITEM;
+          TYPE G6 IS ARRAY (INDEX, INDEX) OF ITEM;
+     PACKAGE DIMENSIONS IS
+          TYPE INC5;
+          TYPE INC6;
+          TYPE D1 IS NEW G5;
+          TYPE D2 IS NEW G6;
+          TYPE INC5 IS NEW G5;
+          TYPE INC6 IS NEW G6;
+          FUNCTION CHECK RETURN BOOLEAN;
+     END DIMENSIONS;
+
+     PACKAGE BODY DIMENSIONS IS
+          FUNCTION CHECK RETURN BOOLEAN IS
+               A1 : INC5;
+               A2 : INC6;
+               DIM1 : D1;
+               DIM2 : D2;
+               F1, F2 : BOOLEAN;
+          BEGIN
+               F1 := A1(INDEX'FIRST)'SIZE = DIM1(INDEX'FIRST)'SIZE;
+               F2 := A2(INDEX'FIRST, INDEX'LAST)'SIZE = 
+                     DIM2(INDEX'FIRST, INDEX'LAST)'SIZE;
+
+               RETURN (F1 AND F2);
+          END CHECK;
+     END DIMENSIONS;
+     
+     PROCEDURE PROC IS NEW REALS (G3 => T_FLOAT, G4 => T_FIXED);
+     FUNCTION DISCRETE IS NEW G_DISCRETE (G1 => RAINBOW, G2 => P2);
+     PACKAGE PKG IS NEW DIMENSIONS (ITEM => P1, INDEX => P2, G5 => P3,
+                                    G6 => P4);
+
+     USE PKG;
+BEGIN
+     TEST ("C38102E", "INCOMPLETE TYPES CAN BE DERIVED GENERIC " &
+                      "FORMAL TYPES");
+
+     IF NOT DISCRETE THEN
+          FAILED ("INTEGER AND ENUMERATED TYPES NOT DERIVED");
+     END IF;
+
+     PROC (F1, F2);
+     IF (NOT F1) THEN
+          FAILED ("FLOAT TYPES NOT DERIVED");
+     END IF;
+     IF (NOT F2) THEN
+          FAILED ("FIXED TYPES NOT DERIVED");
+     END IF;
+
+     IF NOT CHECK THEN
+          FAILED ("ONE AND TWO DIMENSIONAL ARRAY TYPES NOT DERIVED");
+     END IF;
+
+     RESULT;
+END C38102E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38104a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38104a.ada
new file mode 100644
index 000000000..f5f2873af
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38104a.ada
@@ -0,0 +1,97 @@
+-- C38104A.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 INCOMPLETE TYPE WITH DISCRIMINANTS CAN BE
+--     USED IN AN ACCESS TYPE DEFINITION WITH A COMPATIBLE DISCRIMINANT
+--     CONSTRAINT.
+
+-- HISTORY:
+--     PMW 09/01/88  CREATED ORIGINAL TEST BY RENAMING E38104A.ADA.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C38104A IS
+
+BEGIN
+
+     TEST ("C38104A","INCOMPLETELY DECLARED TYPE CAN BE USED AS TYPE " &
+           "MARK IN ACCESS TYPE DEFINITION, AND CAN BE CONSTRAINED " &
+           "THERE OR LATER IF INCOMPLETE TYPE HAD DISCRIMINANT(S)");
+
+     DECLARE
+          TYPE T1;
+          TYPE T1_NAME IS ACCESS T1;
+
+          TYPE T1 IS
+               RECORD
+                    COMP : INTEGER;
+               END RECORD;
+
+          TYPE T2(DISC : INTEGER := 5);
+          TYPE T2_NAME1 IS ACCESS T2(5);
+          TYPE T2_NAME2 IS ACCESS T2;
+
+          SUBTYPE SUB_T2_NAME2 IS T2_NAME2(5);
+          TYPE T2_NAME2_NAME IS ACCESS T2_NAME2(5);
+          X : T2_NAME2(5);
+
+          TYPE T2(DISC : INTEGER := 5) IS
+               RECORD
+                    COMP : T2_NAME2(DISC);
+               END RECORD;
+
+          X1N : T1_NAME;
+          X2A,X2B : T2;
+          X2N2 : T2_NAME2;
+
+     BEGIN
+          IF EQUAL(3,3) THEN
+               X1N := NEW T1 '(COMP => 5);
+          END IF;
+
+          IF X1N.COMP /= 5 THEN
+               FAILED ("ASSIGNMENT FAILED - 1");
+          END IF;
+
+          X2A := (DISC => IDENT_INT(7), COMP => NULL);
+          X2N2 := NEW T2(IDENT_INT(7));
+          X2N2.ALL := X2A;
+
+          IF EQUAL(3,3) THEN
+               X2B := (DISC => IDENT_INT(7), COMP => X2N2);
+          END IF;
+
+          IF X2B.COMP.COMP /= NULL
+               OR X2B.COMP.DISC /= 7 THEN
+               FAILED ("ASSIGNMENT FAILED - 2");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED");
+     END;
+
+     RESULT;
+
+END C38104A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38107a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38107a.ada
new file mode 100644
index 000000000..75a2492d6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38107a.ada
@@ -0,0 +1,105 @@
+-- C38107A.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:
+--     FOR AN INCOMPLETE TYPE WITH DISCRIMINANTS DECLARED IN THE
+--     VISIBLE PART OF A PACKAGE OR IN A DECLARATIVE PART, CHECK THAT
+--     CONSTRAINT_ERROR IS RAISED IF A DISCRIMINANT CONSTRAINT IS
+--     SPECIFIED FOR THE TYPE AND ONE OF THE DISCRIMINANT VALUES DOES
+--     NOT BELONG TO THE CORRESPONDING DISCRIMINANT'S SUBTYPE.
+
+-- HISTORY:
+--     BCB 01/21/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C38107A IS
+
+BEGIN
+     TEST ("C38107A", "FOR AN INCOMPLETE TYPE WITH DISCRIMINANTS " &
+                      "DECLARED IN THE VISIBLE PART OF A PACKAGE OR " &
+                      "IN A DECLARATIVE PART, CHECK THAT CONSTRAINT_" &
+                      "ERROR IS RAISED IF A DISCRIMINANT CONSTRAINT " &
+                      "IS SPECIFIED FOR THE TYPE AND ONE OF THE " &
+                      "DISCRIMINANT VALUES DOES NOT BELONG TO THE " &
+                      "CORRESPONDING DISCRIMINANT'S SUBTYPE");
+
+     BEGIN
+          DECLARE
+               PACKAGE P IS
+                    SUBTYPE INT6 IS INTEGER RANGE 1 .. 6;
+                    TYPE T_INT6 (D6 : INT6);
+                    TYPE TEST IS ACCESS T_INT6(7);  -- CONSTRAINT_ERROR.
+                    TYPE T_INT6 (D6 : INT6) IS
+                         RECORD
+                              NULL;
+                         END RECORD;
+               END P;
+               USE P;
+          BEGIN
+               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 1");
+               DECLARE
+                    T : P.TEST := NEW T_INT6(7);
+               BEGIN
+                    IF EQUAL(T.D6, T.D6) THEN
+                         COMMENT ("DON'T OPTIMIZE T.D6");
+                    END IF;
+               END;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                       "WAS RAISED - 1");
+     END;
+
+     BEGIN
+          DECLARE
+               SUBTYPE INT7 IS INTEGER RANGE 1 .. 7;
+               TYPE T_INT7 (D7 : INT7);
+               TYPE TEST IS ACCESS T_INT7(8);       -- CONSTRAINT_ERROR.
+               TYPE T_INT7 (D7 : INT7) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          BEGIN
+               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 2");
+               DECLARE
+                    T : TEST := NEW T_INT7(6);
+               BEGIN
+                    IF EQUAL(T.D7, T.D7) THEN
+                         COMMENT ("DON'T OPTIMIZE T.D7");
+                    END IF;
+               END;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                       "WAS RAISED - 2");
+     END;
+     RESULT;
+END C38107A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38107b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38107b.ada
new file mode 100644
index 000000000..8e74581f3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38107b.ada
@@ -0,0 +1,194 @@
+-- C38107B.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:
+--     IF A DISCRIMINANT CONSTRAINT IS APPLIED TO AN ACCESS TYPE WHICH
+--     DESIGNATES AN INCOMPLETE TYPE WHICH WAS DECLARED IN THE VISIBLE
+--     OR PRIVATE PART OF A PACKAGE SPECIFICATION, OR IN A DECLARATIVE
+--     PART, CONSTRAINT_ERROR IS RAISED IF ONE OF THE
+--     DISCRIMINANT'S VALUES DOES NOT BELONG TO THE CORRESPONDING
+--     DISCRIMINANT'S SUBTYPE.
+
+-- HISTORY:
+--     DHH 08/05/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C38107B IS
+
+BEGIN
+     TEST("C38107B", "IF A DISCRIMINANT CONSTRAINT IS APPLIED TO AN " &
+                     "ACCESS TYPE WHICH DESIGNATES AN INCOMPLETE " &
+                     "TYPE WHICH WAS DECLARED IN THE VISIBLE OR " &
+                     "PRIVATE PART OF A PACKAGE SPECIFICATION, OR IN " &
+                     "A DECLARATIVE PART, CONSTRAINT_ERROR IS " &
+                     "RAISED IF ONE OF THE DISCRIMINANT'S VALUES " &
+                     "DOES NOT BELONG TO THE CORRESPONDING " &
+                     "DISCRIMINANT'S SUBTYPE");
+
+------------------------------ VISIBLE ------------------------------
+     BEGIN
+          DECLARE
+               PACKAGE PACK IS
+                    SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
+
+                    TYPE INCOMPLETE(A : SMALLER);
+
+                    TYPE ACC_INC IS ACCESS INCOMPLETE;
+                    SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(6));
+
+                    TYPE INCOMPLETE(A : SMALLER) IS
+                         RECORD
+                              T : INTEGER := A;
+                         END RECORD;
+
+               END PACK;
+
+               PACKAGE BODY PACK IS
+               BEGIN
+                    FAILED("CONSTRAINT_ERROR NOT RAISED - VISIBLE");
+                    DECLARE
+                         Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(6));
+                    BEGIN
+                         IF IDENT_INT(Z.T) = IDENT_INT(6) THEN
+                              COMMENT("THIS LINE SHOULD NOT PRINT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         FAILED("CONSTRAINT_ERROR RAISED LATE " &
+                                "- VISIBLE");
+                    WHEN OTHERS =>
+                         FAILED("UNEXPECTED EXCEPTION RAISED " &
+                                "LATE - VISIBLE");
+               END PACK;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED " &
+                      "- VISIBLE");
+     END;
+
+------------------------------ PRIVATE ------------------------------
+     BEGIN
+          DECLARE
+               PACKAGE PACK2 IS
+                    SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
+
+                    TYPE PRIV IS PRIVATE;
+
+               PRIVATE
+                    TYPE PRIV IS
+                         RECORD
+                              V : INTEGER;
+                         END RECORD;
+
+                    TYPE INCOMPLETE(A : SMALLER);
+
+                    TYPE ACC_INC IS ACCESS INCOMPLETE;
+                    SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(0));
+
+                    TYPE INCOMPLETE(A : SMALLER) IS
+                         RECORD
+                              T : INTEGER := A;
+                              U : PRIV := (V => A ** IDENT_INT(2));
+                         END RECORD;
+
+               END PACK2;
+
+               PACKAGE BODY PACK2 IS
+               BEGIN
+                    FAILED("CONSTRAINT_ERROR NOT RAISED - PRIVATE");
+                    DECLARE
+                         Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(0));
+                    BEGIN
+                         IF IDENT_INT(Z.T) = IDENT_INT(0) THEN
+                              COMMENT("THIS LINE SHOULD NOT PRINT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         FAILED("CONSTRAINT_ERROR RAISED TOO LATE " &
+                                "- PRIVATE");
+                    WHEN OTHERS =>
+                         FAILED("UNEXPECTED EXCEPTION RAISED LATE" &
+                                "- PRIVATE");
+               END PACK2;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+                         FAILED("UNEXPECTED EXCEPTION RAISED " &
+                                "- PRIVATE");
+     END;
+
+-------------------------- DECLARATIVE PART --------------------------
+     BEGIN
+          DECLARE
+               SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
+
+               TYPE INCOMPLETE(A : SMALLER);
+
+               TYPE ACC_INC IS ACCESS INCOMPLETE;
+               SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(6));
+
+               TYPE INCOMPLETE(A : SMALLER) IS
+                    RECORD
+                         T : INTEGER := INTEGER'(A);
+                    END RECORD;
+
+          BEGIN
+               FAILED("CONSTRAINT_ERROR NOT RAISED - BLOCK " &
+                      "STATEMENT");
+               DECLARE
+                    Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(6));
+               BEGIN
+                    IF IDENT_INT(Z.T) = IDENT_INT(6) THEN
+                         COMMENT("THIS LINE SHOULD NOT PRINT");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED("CONSTRAINT_ERROR RAISED TOO LATE " &
+                           "- BLOCK STATEMENT");
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED LATE" &
+                           "- BLOCK STATEMENT");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+                         FAILED("UNEXPECTED EXCEPTION RAISED " &
+                                "- BLOCK STATEMENT");
+     END;
+
+     RESULT;
+END C38107B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108a.ada
new file mode 100644
index 000000000..4e533b7d8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108a.ada
@@ -0,0 +1,77 @@
+-- C38108A.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 INCOMPLETE TYPE CAN BE DECLARED IN THE PRIVATE PART OF
+-- A PACKAGE, WITH THE FULL DECLARATION OCCURRING IN THE PACKAGE BODY.
+
+-- AH  8/20/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C38108A IS
+
+     PACKAGE P IS 
+          TYPE L IS LIMITED PRIVATE;
+          PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
+          FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
+     PRIVATE
+          TYPE INC (D : INTEGER);
+          TYPE L IS ACCESS INC;
+     END P;
+
+     PACKAGE BODY P IS
+          TYPE INC (D : INTEGER) IS
+               RECORD
+                    C : INTEGER;
+               END RECORD;
+          
+          PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
+          BEGIN
+               Y := NEW INC(1);
+               Y.C := X;
+          END ASSIGN;
+
+          FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
+          BEGIN
+               RETURN (X.C = Y.C);          
+          END "=";
+
+     END P;
+
+USE P;
+BEGIN
+
+     TEST ("C38108A", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
+                      "PRIVATE PART WITHOUT FULL DECLARATION");
+     DECLARE
+          VAL_1, VAL_2 : L;
+     BEGIN
+          ASSIGN (2, VAL_1);
+          ASSIGN (2, VAL_2);
+          IF NOT "=" (VAL_1, VAL_2) THEN
+               FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
+          END IF;
+     END;
+
+     RESULT;
+END C38108A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108b.ada
new file mode 100644
index 000000000..120e51a35
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108b.ada
@@ -0,0 +1,76 @@
+-- C38108B.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 INCOMPLETE TYPE CAN BE DECLARED IN THE PRIVATE PART OF
+-- A LIBRARY PACKAGE, WITH THE FULL DECLARATION OCCURRING LATER IN A 
+-- PACKAGE BODY.
+
+-- AH  8/20/86
+
+PACKAGE C38108B_P IS 
+     TYPE L IS LIMITED PRIVATE;
+     PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
+     FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
+PRIVATE
+     TYPE INC (D : INTEGER);
+     TYPE L IS ACCESS INC;
+END C38108B_P;
+
+PACKAGE BODY C38108B_P IS
+     TYPE INC (D : INTEGER) IS
+          RECORD
+               C : INTEGER;
+          END RECORD;
+     
+     PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
+     BEGIN
+          Y := NEW INC(1);
+          Y.C := X;
+     END ASSIGN;
+
+     FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
+     BEGIN
+          RETURN (X.C = Y.C);          
+     END "=";
+
+END C38108B_P;
+
+WITH REPORT; USE REPORT;
+WITH C38108B_P; USE C38108B_P;
+PROCEDURE C38108B IS
+     VAL_1, VAL_2 : L;
+BEGIN
+
+     TEST ("C38108B", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
+                      "PRIVATE PART WITHOUT FULL DECLARATION - " &
+                      "LIBRARY PACKAGE");
+
+     ASSIGN (2, VAL_1);
+     ASSIGN (2, VAL_2);
+     IF NOT "=" (VAL_1, VAL_2) THEN
+          FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
+     END IF;
+
+     RESULT;
+END C38108B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108c0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108c0.ada
new file mode 100644
index 000000000..780436a68
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108c0.ada
@@ -0,0 +1,36 @@
+-- C38108C0.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.
+--*
+-- SPECIFICATION OF LIBRARY PACKAGE USED WITH C38108C1M.
+
+-- AH  8/20/86
+
+PACKAGE C38108C0 IS
+     TYPE L IS LIMITED PRIVATE;
+     PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
+     FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
+PRIVATE
+     TYPE INC (D : INTEGER);
+     TYPE L IS ACCESS INC;
+END C38108C0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108c1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108c1.ada
new file mode 100644
index 000000000..523663fcc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108c1.ada
@@ -0,0 +1,52 @@
+-- C38108C1M.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 INCOMPLETE TYPE CAN BE DELCARED IN A SEPARATELY
+-- COMPILED PACKAGE SPECIFICATION AND ITS FULL DECLARATION CAN LATER BE 
+-- GIVEN IN A SEPARATELY COMPILED BODY.
+
+-- AH  8/20/86
+
+-- C38108C0    THE PACKAGE SPECIFICATION.
+-- C38108C1M   THE MAIN PROGRAM.
+-- C38108C2    THE PACKAGE BODY.
+
+WITH REPORT; USE REPORT;
+WITH C38108C0; USE C38108C0;
+PROCEDURE C38108C1M IS
+     VAL_1, VAL_2 : L;
+BEGIN
+
+     TEST ("C38108C", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
+                      "PRIVATE PART WITHOUT FULL DECLARATION - " &
+                      "LIBRARY PACKAGE");
+
+     ASSIGN (2, VAL_1);
+     ASSIGN (2, VAL_2);
+     IF NOT "=" (VAL_1, VAL_2) THEN
+          FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
+     END IF;
+
+     RESULT;
+END C38108C1M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108c2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108c2.ada
new file mode 100644
index 000000000..9dda7aac0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108c2.ada
@@ -0,0 +1,47 @@
+-- C38108C2.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 BODY FOR USE WITH C38108C1M.
+-- SPECIFICATION IS IN C38108C0.
+
+-- AH  8/20/86
+
+PACKAGE BODY C38108C0 IS
+     TYPE INC (D : INTEGER) IS
+          RECORD
+               C : INTEGER;
+          END RECORD;
+     
+     PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
+     BEGIN
+          Y := NEW INC(1);
+          Y.C := X;
+     END ASSIGN;
+
+     FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
+     BEGIN
+          RETURN (X.C = Y.C);          
+     END "=";
+
+END C38108C0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108d0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108d0.ada
new file mode 100644
index 000000000..4b24e7c59
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108d0.ada
@@ -0,0 +1,65 @@
+-- C38108D0M.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 INCOMPLETE TYPE CAN BE DECLARED IN THE PRIVATE PART OF
+-- A PACKAGE, WITH THE FULL DECLARATION OCCURRING LATER IN A 
+-- PACKAGE BODY SUBUNIT.
+
+-- OTHER FILES: C38108D1.ADA (PACKAGE BODY SUBUNIT.)
+
+-- AH  8/20/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C38108D0M IS
+     PACKAGE C38108D1 IS
+          TYPE L IS LIMITED PRIVATE;
+          PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L);
+          FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN;
+     PRIVATE
+          TYPE INC (D : INTEGER);
+          TYPE L IS ACCESS INC;
+     END C38108D1;
+
+     PACKAGE BODY C38108D1 IS SEPARATE;
+
+USE C38108D1;
+BEGIN
+
+     TEST ("C38108D", "CHECK THAT INCOMPLETE TYPE CAN BE DECLARED IN " &
+                      "PRIVATE PART WITH FULL DECLARATION IN " &
+                      "A PACKAGE BODY SUBUNIT");
+
+DECLARE
+     VAL_1, VAL_2 : L;
+BEGIN
+     ASSIGN (2, VAL_1);
+     ASSIGN (2, VAL_2);
+     IF NOT "=" (VAL_1, VAL_2) THEN
+          FAILED ("INCOMPLETE TYPE NOT FULLY DECLARED");
+     END IF;
+END;
+
+     RESULT;
+END C38108D0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108d1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108d1.ada
new file mode 100644
index 000000000..895e956a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38108d1.ada
@@ -0,0 +1,47 @@
+-- C38108D1.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 BODY SUBUNIT USED WITH C38108D0M.
+
+-- AH  8/20/86
+
+SEPARATE (C38108D0M)
+PACKAGE BODY C38108D1 IS
+     TYPE INC (D : INTEGER) IS
+          RECORD
+               C : INTEGER;
+          END RECORD;
+     
+     PROCEDURE ASSIGN (X : IN INTEGER; Y : IN OUT L) IS
+     BEGIN
+          Y := NEW INC(1);
+          Y.C := X;
+     END ASSIGN;
+
+     FUNCTION "=" (X, Y : IN L) RETURN BOOLEAN IS
+     BEGIN
+          RETURN (X.C = Y.C);          
+     END "=";
+
+END C38108D1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38202a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38202a.ada
new file mode 100644
index 000000000..d0350fc1f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c38202a.ada
@@ -0,0 +1,197 @@
+-- C38202A.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 TASKING ATTRIBUTES ARE DECLARED AND RETURN CORRECT 
+-- VALUES FOR OBJECTS HAVING AN ACCESS TYPE WHOSE DESIGNATED 
+-- TYPE IS A TASK TYPE.
+-- CHECK THE ACCESS TYPE RESULTS OF FUNCTION CALLS.
+
+-- AH  9/12/86
+-- EDS 7/14/98  AVOID OPTIMIZATION
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C38202A IS
+BEGIN 
+     TEST ("C38202A", "OBJECTS HAVING ACCESS TYPES WITH DESIGNATED " &
+           "TASK TYPE CAN BE PREFIX OF TASKING ATTRIBUTES");
+
+-- CHECK TWO CASES:  (1)  TASK IS CALLABLE, NOT TERMINATED.
+--                   (2)  TASK IS NOT CALLABLE, TERMINATED.
+
+     DECLARE 
+          TASK TYPE TSK IS 
+               ENTRY GO_ON;
+          END TSK;
+
+          TASK DRIVER IS 
+               ENTRY TSK_DONE;
+          END DRIVER;
+
+          TYPE P_TYPE IS ACCESS TSK;
+          P : P_TYPE;
+
+          TASK BODY TSK IS
+               I : INTEGER RANGE 0 .. 2;
+          BEGIN 
+               ACCEPT GO_ON;
+               I := IDENT_INT(5);         -- CONSTRAINT_ERROR RAISED.
+               FAILED ("CONSTAINT_ERROR NOT RAISED IN TASK " &
+                       " TSK - 1A " & INTEGER'IMAGE(I));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    DRIVER.TSK_DONE;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN TASK " &
+                            "TSK - 1A ");
+                    DRIVER.TSK_DONE;
+          END TSK;
+
+          TASK BODY DRIVER IS
+               COUNTER : INTEGER := 1;
+          BEGIN
+               P := NEW TSK;
+               IF NOT P'CALLABLE THEN
+                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                            "VALUE - 1B");
+               END IF;
+
+               IF P'TERMINATED THEN 
+                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                            "VALUE - 1C");
+               END IF;
+
+               P.GO_ON;
+               ACCEPT TSK_DONE;
+               WHILE (NOT P'TERMINATED AND COUNTER <= 3) LOOP
+                    DELAY 10.0 * Impdef.One_Second;
+                    COUNTER := COUNTER + 1;
+               END LOOP;
+
+               IF COUNTER > 3 THEN
+                    FAILED ("TASK TSK NOT TERMINATED IN SUFFICIENT " &
+                            "TIME - 1D");
+               END IF;
+
+               IF P'CALLABLE THEN
+                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                            "VALUE - 1E");
+               END IF;
+
+               IF NOT P'TERMINATED THEN
+                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                            "VALUE - 1F");
+               END IF;
+          END DRIVER;
+
+     BEGIN
+          NULL;
+     END;     -- BLOCK
+
+-- CHECK ACCESS TYPE RESULT RETURNED FROM FUNCTION.
+-- CHECK TWO CASES:  (1)  TASK IS CALLABLE, NOT TERMINATED.
+--                   (2)  TASK IS NOT CALLABLE, TERMINATED.
+
+     DECLARE 
+          TASK TYPE TSK IS 
+               ENTRY GO_ON;
+          END TSK;
+
+          TASK DRIVER IS 
+               ENTRY TSK_DONE;
+          END DRIVER;
+
+          TYPE P_TYPE IS ACCESS TSK;
+          P : P_TYPE;
+
+          TSK_CREATED : BOOLEAN := FALSE;
+
+          FUNCTION F1 RETURN P_TYPE IS
+          BEGIN
+               RETURN P;
+          END F1;
+
+          TASK BODY TSK IS
+               I : INTEGER RANGE 0 .. 2;
+          BEGIN 
+               ACCEPT GO_ON;
+               I := IDENT_INT(5);          -- CONSTRAINT_ERROR RAISED.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED IN TASK " &
+                       "TSK - 2A " & INTEGER'IMAGE(I));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    DRIVER.TSK_DONE;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN TASK " &
+                            "TSK - 2A ");
+                    DRIVER.TSK_DONE;
+          END TSK;
+
+          TASK BODY DRIVER IS
+               COUNTER : INTEGER := 1;
+          BEGIN
+               P := NEW TSK;               -- ACTIVATE P.ALL (F1.ALL).
+               IF NOT F1'CALLABLE THEN
+                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                            "VALUE WHEN PREFIX IS VALUE FROM " &
+                            "FUNCTION CALL - 2B");
+               END IF;
+
+               IF F1'TERMINATED THEN 
+                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                            "VALUE WHEN PREFIX IS VALUE FROM " &
+                            "FUNCTION CALL - 2C");
+               END IF;
+
+               F1.ALL.GO_ON;
+               ACCEPT TSK_DONE;
+               WHILE (NOT F1'TERMINATED AND COUNTER <= 3) LOOP
+                    DELAY 10.0 * Impdef.One_Second;
+                    COUNTER := COUNTER + 1;
+               END LOOP;
+
+               IF COUNTER > 3 THEN
+                    FAILED ("TASK TSK NOT TERMINATED IN SUFFICIENT " &
+                            "TIME - 2D");
+               END IF;
+
+               IF F1'CALLABLE THEN
+                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                            "VALUE WHEN PREFIX IS VALUE FROM " &
+                            "FUNCTION CALL - 2E");
+               END IF;
+
+               IF NOT F1'TERMINATED THEN
+                    FAILED ("TASKING ATTRIBUTE RETURNS INCORRECT " &
+                            "VALUE WHEN PREFIX IS VALUE FROM " &
+                            "FUNCTION CALL - 2F");
+               END IF;
+          END DRIVER;
+
+     BEGIN
+          NULL;
+     END;     -- BLOCK
+
+     RESULT;
+END C38202A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900010.a
new file mode 100644
index 000000000..6d9ddb4a1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900010.a
@@ -0,0 +1,147 @@
+-- C3900010.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:
+--      See C3900011.AM.
+--
+-- TEST DESCRIPTION:
+--      See C3900011.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--      => C3900010.A
+--         C3900011.AM
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+--                          for Ada.Calendar.
+--
+--!
+
+with Ada.Calendar;
+pragma Elaborate (Ada.Calendar);
+
+package C3900010 is
+
+
+   -- 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 required for 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 inherited by
+                                                      -- all derivatives.
+
+
+
+   type Low_Alert_Type is new Alert_Type with record  -- Record extension of
+      Level : Integer := 0;                           -- root tagged type.
+   end record;
+
+   -- Inherits procedure Display from Alert.
+   -- Inherits procedure Handle  from Alert.
+
+   function Level_Of (LA : in Low_Alert_Type)         -- To be inherited by
+     return Integer;                                  -- all derivatives.
+
+
+
+   -- Declarations required for component Action_Officer;
+
+   type Person_Enum is (Nobody,          Duty_Officer,
+                        Watch_Commander, Commanding_Officer);
+
+
+
+   type Medium_Alert_Type is new Low_Alert_Type with record
+      Action_Officer : Person_Enum := Nobody;         -- Record extension of
+   end record;                                        -- record extension.
+
+   -- Inherits (inherited) procedure Display from Low_Alert_Type.
+   -- Inherits (inherited) procedure Handle  from Low_Alert_Type.
+
+   -- Inherits function Level_Of from Low_Alert_Type.
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum);
+
+
+end C3900010;
+
+
+     --==================================================================--
+
+
+package body C3900010 is
+
+
+   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;
+   end Handle;
+
+
+   function Level_Of (LA : in Low_Alert_Type) return Integer is
+   begin
+      return (LA.Level + 1);
+   end Level_Of;
+
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum) is
+   begin
+      MA.Action_Officer := To;
+   end Assign_Officer;
+
+
+end C3900010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900011.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900011.am
new file mode 100644
index 000000000..68207f32a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900011.am
@@ -0,0 +1,253 @@
+-- C3900011.AM
+--
+--                             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 record extension can be declared in the same package
+--      as its parent, and that this parent may be a tagged record or a
+--      record extension. Check that each derivative inherits all user-
+--      defined primitive subprograms of its parent (including those that
+--      its parent inherited), and that it may declare its own primitive
+--      subprograms.
+--
+--      Check that predefined equality operators are defined for the root
+--      tagged type.
+--
+--      Check that type conversion is defined from a type extension to its
+--      parent, and that this parent itself may be a type extension.
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged type in a package specification. Declare two
+--      primitive subprograms for the type.
+-- 
+--      Extend the root type with a record extension in the same package
+--      specification. Declare a new primitive subprogram for the extension
+--      (in addition to its two inherited subprograms).
+-- 
+--      Extend the extension with a record extension in the same package
+--      specification. Declare a new primitive subprogram for this second
+--      extension (in addition to its three inherited subprograms).
+-- 
+--      In the main program, declare operations for the root tagged type which
+--      utilize aggregates and equality operators to verify the correctness
+--      of the components. Overload these operations for the two type
+--      extensions. Within each of these overloading operations, utilize type
+--      conversion to call the parent's implementation of the same operation.
+-- 
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         C3900010.A
+--      => C3900011.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with C3900010;
+with Report;
+procedure C3900011 is
+
+
+   package Check_Alert_Values is
+
+      -- Declare functions to verify correctness of tagged record components
+      -- before and after calls to their primitive subprograms.
+
+
+      -- Alert_Type:
+
+      function Initial_Values_Okay (A : in C3900010.Alert_Type)
+        return Boolean;
+
+      function Bad_Final_Values (A : in C3900010.Alert_Type)
+        return Boolean;
+
+
+      -- Low_Alert_Type:
+
+      function Initial_Values_Okay (LA : in C3900010.Low_Alert_Type)
+        return Boolean;
+
+      function Bad_Final_Values (LA : in C3900010.Low_Alert_Type)
+        return Boolean;
+
+
+      -- Medium_Alert_Type:
+
+      function Initial_Values_Okay (MA : in C3900010.Medium_Alert_Type)
+        return Boolean;
+
+      function Bad_Final_Values (MA : in C3900010.Medium_Alert_Type)
+        return Boolean;
+
+
+   end Check_Alert_Values;
+
+
+        --==========================================================--
+
+
+   package body Check_Alert_Values is
+
+
+      function Initial_Values_Okay (A : in C3900010.Alert_Type)
+        return Boolean is
+         use type C3900010.Alert_Type;
+      begin                                      -- "=" operator availability.
+         return (A = (Arrival_Time => C3900010.Default_Time,
+                      Display_On   => C3900010.Null_Device));
+      end Initial_Values_Okay;
+
+
+      function Initial_Values_Okay (LA : in C3900010.Low_Alert_Type)
+        return Boolean is
+      begin                                      -- Type conversion.
+         return (Initial_Values_Okay (C3900010.Alert_Type (LA)) and
+                 LA.Level = 0);                               
+      end Initial_Values_Okay;
+
+
+      function Initial_Values_Okay (MA : in C3900010.Medium_Alert_Type)
+        return Boolean is
+         use type C3900010.Person_Enum;
+      begin                                      -- Type conversion.
+         return (Initial_Values_Okay (C3900010.Low_Alert_Type (MA)) and
+                 MA.Action_Officer = C3900010.Nobody);
+      end Initial_Values_Okay;
+
+
+      function Bad_Final_Values (A : in C3900010.Alert_Type)
+        return Boolean is
+         use type C3900010.Alert_Type;
+      begin                                      -- "/=" operator availability.
+         return (A /= (Arrival_Time => C3900010.Alert_Time,
+                       Display_On   => C3900010.Null_Device));
+      end Bad_Final_Values;
+
+
+      function Bad_Final_Values (LA : in C3900010.Low_Alert_Type)
+        return Boolean is
+         use type C3900010.Low_Alert_Type;
+      begin                                      -- "=" operator availability.
+         return not ( LA = (Arrival_Time => C3900010.Alert_Time,
+                            Display_On   => C3900010.Teletype,
+                            Level        => 1) );
+      end Bad_Final_Values;
+
+
+      function Bad_Final_Values (MA : in C3900010.Medium_Alert_Type)
+        return Boolean is
+         use type C3900010.Medium_Alert_Type;
+      begin                                      -- "/=" operator availability.
+         return ( MA /= (C3900010.Alert_Time,
+                         C3900010.Console,
+                         1,
+                         C3900010.Duty_Officer) );
+      end Bad_Final_Values;
+
+
+   end Check_Alert_Values;
+
+
+        --==========================================================--
+
+
+   use Check_Alert_Values;
+   use C3900010;
+
+   Root_Alarm   : C3900010.Alert_Type;
+   Low_Alarm    : C3900010.Low_Alert_Type;
+   Medium_Alarm : C3900010.Medium_Alert_Type;
+
+begin
+
+   Report.Test ("C390001", "Primitive operation inheritance by type " &
+                "extensions: all extensions declared in same package " &
+                "as parent");
+
+
+-- Check root tagged type:
+
+   if Initial_Values_Okay (Root_Alarm) then
+      Handle  (Root_Alarm);                          -- Explicitly declared.
+      Display (Root_Alarm);                          -- Explicitly declared.
+
+      if Bad_Final_Values (Root_Alarm) then
+         Report.Failed ("Wrong results after Alert_Type calls");
+      end if;
+   else
+      Report.Failed ("Wrong initial values for Alert_Type");
+   end if;
+
+
+-- Check record extension of root tagged type:
+
+   if Initial_Values_Okay (Low_Alarm) then
+      Handle (Low_Alarm);                            -- Inherited.
+      Low_Alarm.Display_On := Teletype;
+      Display (Low_Alarm);                           -- Inherited.
+      Low_Alarm.Level := Level_Of (Low_Alarm);       -- Explicitly declared.
+
+      if Bad_Final_Values (Low_Alarm) then
+         Report.Failed ("Wrong results after Low_Alert_Type calls");
+      end if;
+   else
+      Report.Failed ("Wrong initial values for Low_Alert_Type");
+   end if;
+
+
+-- Check record extension of record extension:
+
+   if Initial_Values_Okay (Medium_Alarm) then
+      Handle (Medium_Alarm);                         -- Inherited twice.
+      Medium_Alarm.Display_On := Console;
+      Display (Medium_Alarm);                        -- Inherited twice.
+      Medium_Alarm.Level := Level_Of (Medium_Alarm); -- Inherited.
+      Assign_Officer (Medium_Alarm, Duty_Officer);   -- Explicitly declared.
+
+      if Bad_Final_Values (Medium_Alarm) then
+         Report.Failed ("Wrong results after Medium_Alert_Type calls");
+      end if;
+   else
+      Report.Failed ("Wrong initial values for Medium_Alert_Type");
+   end if;
+
+
+-- Check final display counts:
+
+   if C3900010.Display_Count_For /= (Null_Device => 1,
+                                     Teletype    => 1,
+                                     Console     => 1,
+                                     Big_Screen  => 0)
+   then
+      Report.Failed ("Wrong final values for display counts");
+   end if;
+
+
+   Report.Result;
+
+end C3900011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390002.a
new file mode 100644
index 000000000..b3d11afed
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390002.a
@@ -0,0 +1,165 @@
+-- C390002.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 tagged base type may be declared, and derived
+--      from in simple, private and extended forms.  (Overlaps with C390B04)
+--      Check that the package Ada.Tags is present and correctly implemented.
+--      Check for the correct operation of Expanded_Name, External_Tag and
+--      Internal_Tag within that package.  Check that the exception Tag_Error
+--      is correctly raised on calling Internal_Tag with bad input.
+--
+-- TEST DESCRIPTION:
+--      This test declares a tagged type, and derives three types from it.
+--      These types are then used to test the presence and function of the
+--      package Ada.Tags.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--      27 Jan 96   SAIC    Update RM references for 2.1
+--
+--!
+
+with Report;
+with Ada.Tags;  
+
+procedure C390002 is
+
+  package Vehicle is
+
+    type Object is tagged limited private;  -- ancestor type
+    procedure Create( The_Vehicle : in out Object; Wheels : in Natural );
+    function  Wheels( The_Vehicle : Object ) return Natural;
+
+  private
+
+    type Object is tagged limited record
+      Wheel_Count : Natural := 0;
+    end record;
+
+  end Vehicle;
+
+  package Motivators is
+
+    type Bicycle is new Vehicle.Object with null record; -- simple 
+
+    type Car is new Vehicle.Object with record           -- extended
+      Convertible : Boolean;
+    end record;
+
+    type Truck is new Vehicle.Object with private;       -- private
+
+  private
+
+    type Truck is new Vehicle.Object with record
+      Air_Horn : Boolean;
+    end record;
+
+  end Motivators;
+
+  package body Vehicle is
+
+    procedure Create( The_Vehicle : in out Object; Wheels : in Natural ) is
+    begin
+      The_Vehicle.Wheel_Count := Wheels;
+    end Create;
+
+    function  Wheels( The_Vehicle : Object ) return Natural is
+    begin
+      return The_Vehicle.Wheel_Count;
+    end Wheels;
+
+  end Vehicle;
+
+  function TC_ID_Tag( Tag : in Ada.Tags.Tag ) return Ada.Tags.Tag is
+  begin
+    return Ada.Tags.Internal_Tag( Ada.Tags.External_Tag( Tag ) );
+    Report.Comment("This message intentionally blank.");
+  end TC_ID_Tag;
+
+  procedure Check_Tags( Machine       : in Vehicle.Object'Class;
+                        Expected_Name : in String;
+                        External_Tag  : in String ) is
+    The_Tag : constant Ada.Tags.Tag := Machine'Tag;
+    use type Ada.Tags.Tag;
+  begin
+      if Ada.Tags.Expanded_Name(The_Tag) /= Expected_Name then  
+         Report.Failed ("Failed in Check_Tags, Expanded_Name "
+                        & Expected_Name);
+      end if;
+      if Ada.Tags.External_Tag(The_Tag) /= External_Tag then  
+         Report.Failed ("Failed in Check_Tags, External_Tag "
+                        & Expected_Name);
+      end if;
+      if Ada.Tags.Internal_Tag(External_Tag) /= The_Tag then
+         Report.Failed ("Failed in Check_Tags, Internal_Tag "
+                        & Expected_Name);
+      end if;
+  end Check_Tags;
+
+  procedure Check_Exception is
+    Boeing_777_Id : Ada.Tags.Tag;
+  begin
+    Boeing_777_Id := Ada.Tags.Internal_Tag("!@#$%^:*\/?"" not a tag!");
+    Report.Failed ("Failed in Check_Exception, no exception");
+    Boeing_777_Id := TC_ID_Tag( Boeing_777_Id ); 
+  exception
+    when Ada.Tags.Tag_Error => null;  
+    when others =>
+      Report.Failed ("Failed in Check_Exception, wrong exception");
+  end Check_Exception;
+
+  use Motivators;
+  Two_Wheeler      : Bicycle;
+  Four_Wheeler     : Car;
+  Eighteen_Wheeler : Truck;
+
+begin  -- Main test procedure.
+
+    Report.Test ("C390002", "Check that a tagged type may be declared and " &
+                 "derived from in simple, private and extended forms.  " &
+                 "Check package Ada.Tags" );
+
+    Create( Two_Wheeler,       2 );
+    Create( Four_Wheeler,      4 );
+    Create( Eighteen_Wheeler, 18 );
+   
+    Check_Tags( Machine       => Two_Wheeler, 
+                Expected_Name => "C390002.MOTIVATORS.BICYCLE",
+                External_Tag  => Bicycle'External_Tag );
+    Check_Tags( Machine       => Four_Wheeler, 
+                Expected_Name => "C390002.MOTIVATORS.CAR",
+                External_Tag  => Car'External_Tag );
+    Check_Tags( Machine       => Eighteen_Wheeler, 
+                Expected_Name => "C390002.MOTIVATORS.TRUCK",
+                External_Tag  => Truck'External_Tag );
+
+    Check_Exception;
+ 
+  Report.Result;
+
+end C390002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390003.a
new file mode 100644
index 000000000..643aad1cd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390003.a
@@ -0,0 +1,419 @@
+-- C390003.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 for a subtype S of a tagged type T, S'Class denotes a
+--     class-wide subtype.  Check that T'Tag denotes the tag of the type T,
+--     and that, for a class-wide tagged type X, X'Tag denotes the tag of X.
+--     Check that the tags of stand alone objects, record and array
+--     components, aggregates, and formal parameters identify their type.
+--     Check that the tag of a value of a formal parameter is that of the
+--     actual parameter, even if the actual is passed by a view conversion.
+--
+-- TEST DESCRIPTION:
+--     This test defines a class hierarchy (based on C390002) and
+--     uses it to determine the correctness of the resulting tag
+--     information generated by the compiler.  A type is defined in the
+--     class which contains components of the class as part of its
+--     definition.  This is to reduce the overall number of types
+--     required, and to achieve the required nesting to accomplish
+--     this test.  The model is that of a car carrier truck; both car
+--     and truck being in the class of Vehicle.
+--
+--      Class Hierarchy:
+--                         Vehicle - - - - - - - (Bicycle)
+--                        /   |   \               /      \
+--                   Truck   Car   Q_Machine   Tandem  Motorcycle
+--                     |
+--                Auto_Carrier
+--      Contains:
+--                Auto_Carrier( Car )
+--                Q_Machine( Car, Motorcycle )
+--
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed ARM references from objective text.
+--      20 Dec 94   SAIC    Replaced three unnecessary extension
+--                          aggregates with simple aggregates.
+--      16 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
+--
+--!
+
+----------------------------------------------------------------- C390003_1
+
+with Ada.Tags;
+package C390003_1 is -- Vehicle
+
+  type TC_Keys is (Veh, MC, Tand, Car, Q, Truk, Heavy);
+  type States  is (Good, Flat, Worn);
+
+  type Wheel_List is array(Positive range <>) of States;
+
+  type Object(Wheels: Positive) is tagged record
+    Wheel_State : Wheel_List(1..Wheels);
+  end record;
+
+  procedure TC_Validate( It: Object; Key: TC_Keys );
+  procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag );
+
+  procedure Create( The_Vehicle : in out Object; Tyres : in States );
+  procedure Rotate( The_Vehicle : in out Object );
+  function  Wheels( The_Vehicle : Object ) return Positive;
+
+end C390003_1; -- Vehicle;
+
+----------------------------------------------------------------- C390003_2
+
+with C390003_1;
+package C390003_2 is -- Motivators
+
+  package Vehicle renames C390003_1;
+  subtype Bicycle is Vehicle.Object(2);  -- constrained subtype
+
+  type Motorcycle is new Bicycle with record
+    Displacement : Natural;
+  end record;
+  procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys );
+
+  type Tandem is new Bicycle with null record;
+  procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys );
+
+  type Car is new Vehicle.Object(4) with  -- extended, constrained
+    record
+      Displacement : Natural;
+    end record;
+  procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys );
+
+  type Truck is new Vehicle.Object with  -- extended, unconstrained
+    record
+      Tare : Natural;
+    end record;
+  procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys );
+
+end C390003_2; -- Motivators;
+
+----------------------------------------------------------------- C390003_3
+
+with C390003_1;
+with C390003_2;
+package C390003_3 is -- Special_Trucks
+  package Vehicle    renames C390003_1;
+  package Motivators renames C390003_2;
+  Max_Cars_On_Vehicle : constant := 6;
+  type Cargo_Index is range 0..Max_Cars_On_Vehicle;
+  type Cargo is array(Cargo_Index range 1..Max_Cars_On_Vehicle)
+                of Motivators.Car;
+  type Auto_Carrier is new Motivators.Truck(18) with
+    record
+      Load_Count : Cargo_Index := 0;
+      Payload    : Cargo;
+    end record;
+  procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys );
+  procedure Load  ( The_Car : in     Motivators.Car;
+                    Onto    : in out Auto_Carrier);
+  procedure Unload( The_Car :    out Motivators.Car;
+                    Off_of   : in out Auto_Carrier);
+end C390003_3;
+
+----------------------------------------------------------------- C390003_4
+
+with C390003_1;
+with C390003_2;
+package C390003_4 is -- James_Bond
+
+  package Vehicle   renames C390003_1;
+  package Motivators renames C390003_2;
+
+  type Q_Machine is new Vehicle.Object(4) with record
+    Car_Part  : Motivators.Car;
+    Bike_Part : Motivators.Motorcycle;
+  end record;
+  procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys );
+
+end C390003_4;
+
+----------------------------------------------------------------- C390003_1
+
+with Report;
+with Ada.Tags;
+package body C390003_1 is -- Vehicle
+
+  function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
+
+  procedure TC_Validate( It: Object; Key: TC_Keys ) is
+  begin
+    if Key /= Veh then
+      Report.Failed("Expected Veh Key");
+    end if;
+  end TC_Validate;
+
+  procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag ) is
+  begin
+    if It'Tag /= The_Tag then
+      Report.Failed("Unexpected Tag for classwide formal");
+    end if;
+  end TC_Validate;
+
+  procedure Create( The_Vehicle : in out Object; Tyres : in States ) is
+  begin
+    The_Vehicle.Wheel_State := ( others => Tyres );
+  end Create;
+
+  function  Wheels( The_Vehicle : Object ) return Positive is
+  begin
+    return The_Vehicle.Wheels;
+  end Wheels;
+
+  procedure Rotate( The_Vehicle : in out Object ) is
+    Push : States;
+    Pulled : States
+         := The_Vehicle.Wheel_State(The_Vehicle.Wheel_State'Last);
+  begin
+    for Finger in
+        The_Vehicle.Wheel_State'First..The_Vehicle.Wheel_State'Last loop
+      Push := The_Vehicle.Wheel_State(Finger);
+      The_Vehicle.Wheel_State(Finger) := Pulled;
+      Pulled := Push;
+    end loop;
+  end Rotate;
+
+end C390003_1; -- Vehicle;
+
+----------------------------------------------------------------- C390003_2
+
+with Ada.Tags;
+with Report;
+package body C390003_2 is -- Motivators
+
+  function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
+  function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
+
+  procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.MC then
+      Report.Failed("Expected MC Key");
+    end if;
+  end TC_Validate;
+
+  procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.Tand then
+      Report.Failed("Expected Tand Key");
+    end if;
+  end TC_Validate;
+
+  procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.Car then
+      Report.Failed("Expected Car Key");
+    end if;
+  end TC_Validate;
+
+  procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.Truk then
+      Report.Failed("Expected Truk Key");
+    end if;
+  end TC_Validate;
+end C390003_2; -- Motivators;
+
+----------------------------------------------------------------- C390003_3
+
+with Ada.Tags;
+with Report;
+package body C390003_3 is -- Special_Trucks
+
+  function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
+  function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
+
+  procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.Heavy then
+      Report.Failed("Expected Heavy Key");
+    end if;
+  end TC_Validate;
+
+  procedure Load  ( The_Car : in     Motivators.Car;
+                    Onto    : in out Auto_Carrier) is
+  begin
+    Onto.Load_Count := Onto.Load_Count +1;
+    Onto.Payload(Onto.Load_Count) := The_Car;
+  end Load;
+  procedure Unload( The_Car :    out Motivators.Car;
+                    Off_of   : in out Auto_Carrier) is
+  begin
+    The_Car := Off_of.Payload(Off_of.Load_Count);
+    Off_of.Load_Count := Off_of.Load_Count -1;
+  end Unload;
+
+end C390003_3;
+
+----------------------------------------------------------------- C390003_4
+
+with Report, Ada.Tags;
+package body C390003_4 is -- James_Bond
+
+  function "="(A,B: Ada.Tags.Tag)    return Boolean renames Ada.Tags."=";
+  function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
+
+  procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys ) is
+  begin
+    if Key /= Vehicle.Q then
+      Report.Failed("Expected Q Key");
+    end if;
+  end TC_Validate;
+
+end C390003_4;
+
+------------------------------------------------------------------- C390003
+
+with Report;
+with C390003_1;
+with C390003_2;
+with C390003_3;
+with C390003_4;
+procedure C390003 is
+
+  package Vehicle        renames C390003_1;  use Vehicle;
+  package Motivators     renames C390003_2;
+  package Special_Trucks renames C390003_3;
+  package James_Bond     renames C390003_4;
+
+  -- The cast, in order of complexity:
+
+  Pennys_Bike : Motivators.Bicycle;
+  Weekender   : Motivators.Tandem;
+  Qs_Moped    : Motivators.Motorcycle;
+  Ms_Limo     : Motivators.Car;
+  Yard_Van    : Motivators.Truck(8);
+  Specter_X   : Special_Trucks.Auto_Carrier;
+  Gen_II      : James_Bond.Q_Machine;
+
+
+  -- Check compatibility with the corresponding class wide type.
+
+  procedure Vehicle_Shop( It  : in out Vehicle.Object'Class;
+                          Key : in     Vehicle.TC_Keys ) is
+
+    -- Check that Subtype'Class is defined for tagged subtypes.
+    procedure Bike_Shop( Bike: in out Motivators.Bicycle'Class ) is
+    begin
+        -- Dispatch to appropriate TC_Validate
+      Vehicle.TC_Validate( Bike, Key );
+    end Bike_Shop;
+
+  begin
+    Vehicle.TC_Validate( It, Key );
+    if Vehicle.Wheels( It ) = 2 then
+      Bike_Shop( It );  -- only call Bike_Shop when It has 2 wheels
+    end if;
+  end Vehicle_Shop;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C390003", "Check that for a subtype S of a tagged type " &
+               "T, S'Class denotes a class-wide subtype.  Check that " &
+               "T'Tag denotes the tag of the type T, and that, for a " &
+               "class-wide tagged type X, X'Tag denotes the tag of X.  " &
+               "Check that the tags of stand alone objects, record and " &
+               "array components, aggregates, and formal parameters " &
+               "identify their type. Check that the tag of a value of a " &
+               "formal parameter is that of the actual parameter, even " &
+               "if the actual is passed by a view conversion" );
+
+--     Check that the tags of stand alone objects, record and array
+--     components, aggregates, and formal parameters identify their type.
+--     Check that the tag of a value of a formal parameter is that of the
+--     actual parameter, even if the actual is passed by a view conversion.
+
+  Vehicle_Shop( Pennys_Bike,          Veh );
+  Vehicle_Shop( Weekender,            Tand );
+  Vehicle_Shop( Qs_Moped,             MC );
+  Vehicle_Shop( Ms_Limo,              Car );
+  Vehicle_Shop( Yard_Van,             Truk );
+  Vehicle_Shop( Specter_X,            Heavy );
+  Vehicle_Shop( Specter_X.Payload(1), Car );
+  Vehicle_Shop( Gen_II,               Q );
+  Vehicle_Shop( Gen_II.Car_Part,      Car );
+  Vehicle_Shop( Gen_II.Bike_Part,     MC );
+
+  Vehicle.TC_Validate( Pennys_Bike, Vehicle.Object'Tag );
+  Vehicle.TC_Validate( Weekender,   Motivators.Tandem'Tag );
+  Vehicle.TC_Validate( Qs_Moped,    Motivators.Motorcycle'Tag );
+  Vehicle.TC_Validate( Ms_Limo,     Motivators.Car'Tag );
+  Vehicle.TC_Validate( Yard_Van,    Motivators.Truck'Tag );
+  Vehicle.TC_Validate( Specter_X,   Special_Trucks.Auto_Carrier'Tag );
+  Vehicle.TC_Validate( Specter_X.Payload(1), Motivators.Car'Tag );
+  Vehicle.TC_Validate( Gen_II,              James_Bond.Q_Machine'Tag );
+  Vehicle.TC_Validate( Gen_II.Car_Part,     Motivators.Car'Tag );
+  Vehicle.TC_Validate( Gen_II.Bike_Part,    Motivators.Motorcycle'Tag );
+
+-- Check the tag generated for an aggregate.
+
+  Rentals: declare
+    Mikes_Rental : Vehicle.Object'Class :=
+                     Vehicle.Object'( 3, (Good, Flat, Worn));
+    Diannes_Car  : Vehicle.Object'Class :=
+                      Motivators.Tandem'( Wheels      => 2, 
+                                          Wheel_State => (Good, Good) );
+    Jims_Bike    : Vehicle.Object'Class :=
+                      Motivators.Motorcycle'( Pennys_Bike
+                                              with Displacement => 350 );
+    Bills_Limo   : Vehicle.Object'Class :=
+                      Motivators.Car'( Wheels       => 4,
+                                       Wheel_State  => (others => Good),
+                                       Displacement => 282 );
+    Alans_Car    : Vehicle.Object'Class :=
+                      Motivators.Truck'( 18, (others => Worn),
+                                         Tare => 5_500 );
+    Pats_Truck   : Vehicle.Object'Class := Specter_X;
+    Keiths_Car   : Vehicle.Object'Class := Gen_II;
+    Isaacs_Bus   : Vehicle.Object'Class := Keiths_Car;
+
+  begin
+    Vehicle.TC_Validate( Mikes_Rental, Vehicle.Object'Tag );
+    Vehicle.TC_Validate( Diannes_Car,  Motivators.Tandem'Tag );
+    Vehicle.TC_Validate( Jims_Bike,    Motivators.Motorcycle'Tag );
+    Vehicle.TC_Validate( Bills_Limo,   Motivators.Car'Tag );
+    Vehicle.TC_Validate( Alans_Car,    Motivators.Truck'Tag );
+    Vehicle.TC_Validate( Pats_Truck,   Special_Trucks.Auto_Carrier'Tag );
+    Vehicle.TC_Validate( Keiths_Car,   James_Bond.Q_Machine'Tag );
+  end Rentals;
+
+-- Check the tag of parameters.
+-- Check that the tag is not affected by view conversion.
+
+  Vehicle.TC_Validate( Vehicle.Object( Gen_II  ), James_Bond.Q_Machine'Tag );
+  Vehicle.TC_Validate( Vehicle.Object( Ms_Limo ), Motivators.Car'Tag );
+  Vehicle.TC_Validate( Motivators.Bicycle( Weekender ),
+                       Motivators.Tandem'Tag );
+  Vehicle.TC_Validate( Motivators.Bicycle( Gen_II.Bike_Part ),
+                       Motivators.Motorcycle'Tag );
+
+  Report.Result;
+
+end C390003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390004.a
new file mode 100644
index 000000000..2c120bab9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390004.a
@@ -0,0 +1,404 @@
+-- C390004.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 tags of allocated objects correctly identify the
+--     type of the allocated object.  Check that the tag corresponds
+--     correctly to the value resulting from both normal and view
+--     conversion.  Check that the tags of accessed values designating
+--     aliased objects correctly identify the type of the object.  Check
+--     that the tag of a function result correctly evaluates.  Check this
+--     for class-wide functions.  The tag of a class-wide function result
+--     should be the tag appropriate to the actual value returned, not the
+--     tag of the ancestor type.
+--
+-- TEST DESCRIPTION:
+--     This test defines a class hierarchy of types, with reference
+--     semantics (an access type to the class-wide type).  Similar in
+--     structure to C392005, this test checks that dynamic allocation does
+--     not adversely impact the tagging of types.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C390004_1 is -- DMV
+  type Equipment is ( T_Veh, T_Car, T_Con, T_Jep );
+
+  type Vehicle is tagged record
+    Wheels : Natural := 4;
+    Parked : Boolean := False;
+  end record;
+
+  function  Wheels    ( It: Vehicle ) return Natural;
+  procedure Park      ( It: in out Vehicle );
+  procedure UnPark    ( It: in out Vehicle );
+  procedure Set_Wheels( It: in out Vehicle; To_Count: in Natural );
+  procedure TC_Check  ( It: in Vehicle; To_Equip: in Equipment );
+
+  type Car is new Vehicle with record
+    Passengers : Natural := 0;
+  end record;
+
+  function  Passengers     ( It: Car ) return Natural;
+  procedure Load_Passengers( It: in out Car; To_Count: in Natural );
+  procedure Park           ( It: in out Car );
+  procedure TC_Check       ( It: in Car; To_Equip: in Equipment );
+
+  type Convertible is new Car with record
+    Top_Up : Boolean := True;
+  end record;
+
+  function  Top_Up   ( It: Convertible ) return Boolean;
+  procedure Lower_Top( It: in out Convertible );
+  procedure Park     ( It: in out Convertible );
+  procedure Raise_Top( It: in out Convertible );
+  procedure TC_Check ( It: in Convertible; To_Equip: in Equipment );
+
+  type Jeep is new Convertible with record
+    Windshield_Up : Boolean := True;
+  end record;
+
+  function  Windshield_Up   ( It: Jeep ) return Boolean;
+  procedure Lower_Windshield( It: in out Jeep );
+  procedure Park            ( It: in out Jeep );
+  procedure Raise_Windshield( It: in out Jeep );
+  procedure TC_Check        ( It: in Jeep; To_Equip: in Equipment );
+
+end C390004_1;
+
+with Report;
+package body C390004_1 is
+
+  procedure Set_Wheels( It: in out Vehicle; To_Count: in Natural ) is
+  begin
+    It.Wheels := To_Count;
+  end Set_Wheels;
+
+  function  Wheels( It: Vehicle ) return Natural is
+  begin
+    return It.Wheels;
+  end Wheels;
+
+  procedure Park      ( It: in out Vehicle ) is
+  begin
+    It.Parked := True;
+  end Park;
+
+  procedure UnPark    ( It: in out Vehicle ) is
+  begin
+    It.Parked := False;
+  end UnPark;
+
+  procedure TC_Check  ( It: in Vehicle; To_Equip: in Equipment ) is
+  begin
+    if To_Equip /= T_Veh then
+      Report.Failed ("Failed, called Vehicle for "
+                     & Equipment'Image(To_Equip));      
+    end if;
+  end TC_Check;
+
+  procedure TC_Check  ( It: in Car; To_Equip: in Equipment ) is
+  begin
+    if To_Equip /= T_Car then
+      Report.Failed ("Failed, called Car for "
+                     & Equipment'Image(To_Equip));      
+    end if;
+  end TC_Check;
+
+  procedure TC_Check  ( It: in Convertible; To_Equip: in Equipment ) is
+  begin
+    if To_Equip /= T_Con then
+      Report.Failed ("Failed, called Convertible for "
+                     & Equipment'Image(To_Equip));      
+    end if;
+  end TC_Check;
+
+  procedure TC_Check  ( It: in Jeep; To_Equip: in Equipment ) is
+  begin
+    if To_Equip /= T_Jep then
+      Report.Failed ("Failed, called Jeep for "
+                     & Equipment'Image(To_Equip));      
+    end if;
+  end TC_Check;
+
+  procedure Load_Passengers( It: in out Car; To_Count: in Natural ) is
+  begin
+    It.Passengers := To_Count;
+    UnPark( It );
+  end Load_Passengers;
+
+  procedure Park( It: in out Car ) is
+  begin
+    It.Passengers := 0;
+    Park( Vehicle( It ) );
+  end Park;
+
+  function  Passengers( It: Car ) return Natural is
+  begin
+    return It.Passengers;
+  end Passengers;
+
+  procedure Raise_Top( It: in out Convertible ) is
+  begin
+    It.Top_Up := True;
+  end Raise_Top;
+
+  procedure Lower_Top( It: in out Convertible ) is
+  begin
+    It.Top_Up := False;
+  end Lower_Top;
+
+  function  Top_Up   ( It: Convertible ) return Boolean is
+  begin
+    return It.Top_Up;
+  end Top_Up;
+
+  procedure Park     ( It: in out Convertible ) is
+  begin
+    It.Top_Up := True;
+    Park( Car( It ) );
+  end Park;
+
+  procedure Raise_Windshield( It: in out Jeep ) is
+  begin
+    It.Windshield_Up := True;
+  end Raise_Windshield;
+
+  procedure Lower_Windshield( It: in out Jeep ) is
+  begin
+    It.Windshield_Up := False;
+  end Lower_Windshield;
+
+  function  Windshield_Up( It: Jeep ) return Boolean is
+  begin
+    return It.Windshield_Up;
+  end Windshield_Up;
+
+  procedure Park( It: in out Jeep ) is
+  begin
+    It.Windshield_Up := True;
+    Park( Convertible( It ) );
+  end Park;
+end C390004_1;
+
+with Report;
+with Ada.Tags;
+with C390004_1;
+procedure C390004 is
+  package DMV renames C390004_1;
+
+  The_Vehicle     : aliased DMV.Vehicle;
+  The_Car         : aliased DMV.Car;
+  The_Convertible : aliased DMV.Convertible;
+  The_Jeep        : aliased DMV.Jeep;
+
+  type C_Reference is access all DMV.Car'Class;
+  type V_Reference is access all DMV.Vehicle'Class;
+
+  Designator : V_Reference;
+  Storage    : Natural;
+
+  procedure Valet( It: in out DMV.Vehicle'Class ) is
+  begin
+    DMV.Park( It );
+  end Valet;
+
+  procedure TC_Match( Object: DMV.Vehicle'Class;
+                      Taglet: Ada.Tags.Tag;
+                      Where : String ) is
+    use Ada.Tags;
+  begin
+    if Object'Tag /= Taglet then
+      Report.Failed("Tag mismatch: " & Where);
+    end if;
+  end TC_Match;
+
+  procedure Parking_Validation( It: DMV.Vehicle; TC_Message: String ) is
+  begin
+    if DMV.Wheels( It ) /= 1  or not It.Parked then
+      Report.Failed ("Failed Vehicle " & TC_Message);
+    end if;
+  end Parking_Validation;
+
+  procedure Parking_Validation( It: DMV.Car; TC_Message: String ) is
+  begin
+    if DMV.Wheels( It ) /= 2 or DMV.Passengers( It ) /= 0
+       or not It.Parked then
+      Report.Failed ("Failed Car " & TC_Message);
+    end if;
+  end Parking_Validation;
+
+  procedure Parking_Validation( It: DMV.Convertible;
+                                TC_Message: String ) is
+  begin
+    if DMV.Wheels( It ) /= 3 or DMV.Passengers( It ) /= 0
+       or not DMV.Top_Up( It ) or not It.Parked then
+      Report.Failed ("Failed Convertible " & TC_Message);
+    end if;
+  end Parking_Validation;
+
+  procedure Parking_Validation( It: DMV.Jeep; TC_Message: String ) is
+  begin
+    if DMV.Wheels( It ) /= 4 or DMV.Passengers( It ) /= 0
+       or not DMV.Top_Up( It ) or not DMV.Windshield_Up( It )
+       or not It.Parked then
+      Report.Failed ("Failed Jeep " & TC_Message);
+    end if;
+  end Parking_Validation;
+
+  function Wash( It: V_Reference; TC_Expect : Ada.Tags.Tag )
+                                    return DMV.Vehicle'Class is
+    This_Machine : DMV.Vehicle'Class := It.all;
+  begin
+    TC_Match( It.all, TC_Expect, "Class-wide object in Wash" );
+    Storage := DMV.Wheels( This_Machine );
+    return This_Machine;
+  end Wash;
+
+  function Wash( It: C_Reference; TC_Expect : Ada.Tags.Tag )
+                                    return DMV.Car'Class is
+    This_Machine : DMV.Car'Class := It.all;
+  begin
+    TC_Match( It.all, TC_Expect, "Class-wide object in Wash" );
+    Storage := DMV.Wheels( This_Machine );
+    return This_Machine;
+  end Wash;
+
+begin
+
+  Report.Test( "C390004", "Check that the tags of allocated objects "
+                        & "correctly identify the type of the allocated "
+                        & "object.  Check that tags resulting from "
+                        & "normal and view conversions.  Check tags of "
+                        & "accessed values designating aliased objects. "
+                        & "Check function result tags" );
+
+  DMV.Set_Wheels( The_Vehicle, 1 );
+  DMV.Set_Wheels( The_Car, 2 );
+  DMV.Set_Wheels( The_Convertible, 3 );
+  DMV.Set_Wheels( The_Jeep, 4 );
+
+  Valet( The_Vehicle );
+  Valet( The_Car );
+  Valet( The_Convertible );
+  Valet( The_Jeep );
+
+  Parking_Validation( The_Vehicle,     "setup" );
+  Parking_Validation( The_Car,         "setup" );
+  Parking_Validation( The_Convertible, "setup" );
+  Parking_Validation( The_Jeep,        "setup" );
+
+-- Check that the tags of allocated objects correctly identify the type
+-- of the allocated object.
+
+  Designator := new DMV.Vehicle;
+  DMV.TC_Check( Designator.all, DMV.T_Veh );
+  TC_Match( Designator.all, DMV.Vehicle'Tag, "allocated Vehicle" );
+
+  Designator := new DMV.Car;
+  DMV.TC_Check( Designator.all, DMV.T_Car );
+  TC_Match( Designator.all, DMV.Car'Tag, "allocated Car");
+
+  Designator := new DMV.Convertible;
+  DMV.TC_Check( Designator.all, DMV.T_Con );
+  TC_Match( Designator.all, DMV.Convertible'Tag, "allocated Convertible" );
+
+  Designator := new DMV.Jeep;
+  DMV.TC_Check( Designator.all, DMV.T_Jep );
+  TC_Match( Designator.all, DMV.Jeep'Tag, "allocated Jeep" );
+
+-- Check that view conversion causes the correct dispatch
+  DMV.TC_Check( DMV.Vehicle( The_Jeep ),     DMV.T_Veh );
+  DMV.TC_Check( DMV.Car( The_Jeep ),         DMV.T_Car );
+  DMV.TC_Check( DMV.Convertible( The_Jeep ), DMV.T_Con );
+
+-- And that view conversion does not change the tag
+  TC_Match( DMV.Vehicle( The_Jeep ),     DMV.Jeep'Tag, "View Conv Veh" );
+  TC_Match( DMV.Car( The_Jeep ),         DMV.Jeep'Tag, "View Conv Car" );
+  TC_Match( DMV.Convertible( The_Jeep ), DMV.Jeep'Tag, "View Conv Jep" );
+
+-- Check that the tags of accessed values designating aliased objects
+-- correctly identify the type of the object.
+  Designator := The_Vehicle'Access;
+  DMV.TC_Check( Designator.all, DMV.T_Veh );
+  TC_Match( Designator.all, DMV.Vehicle'Tag, "aliased Vehicle" );
+
+  Designator := The_Car'Access;
+  DMV.TC_Check( Designator.all, DMV.T_Car );
+  TC_Match( Designator.all, DMV.Car'Tag, "aliased Car" );
+
+  Designator := The_Convertible'Access;
+  DMV.TC_Check( Designator.all, DMV.T_Con );
+  TC_Match( Designator.all, DMV.Convertible'Tag, "aliased Convertible" );
+
+  Designator := The_Jeep'Access;
+  DMV.TC_Check( Designator.all, DMV.T_Jep );
+  TC_Match( Designator.all, DMV.Jeep'Tag, "aliased Jeep" );
+
+-- Check that the tag of a function result correctly evaluates.
+-- Check this for class-wide functions.  The tag of a class-wide
+-- function result should be the tag appropriate to the actual value
+-- returned, not the tag of the ancestor type.
+  Function_Check: declare
+    A_Vehicle     : V_Reference := new DMV.Vehicle'( The_Vehicle );
+    A_Car         : C_Reference := new DMV.Car'( The_Car );
+    A_Convertible : C_Reference := new DMV.Convertible'( The_Convertible );
+    A_Jeep        : C_Reference := new DMV.Jeep'( The_Jeep );
+  begin
+    DMV.Unpark( A_Vehicle.all );
+    DMV.Load_Passengers( A_Car.all, 5 );
+    DMV.Load_Passengers( A_Convertible.all, 6 );
+    DMV.Load_Passengers( A_Jeep.all, 7 );
+    DMV.Lower_Top( DMV.Convertible(A_Convertible.all) );
+    DMV.Lower_Top( DMV.Jeep(A_Jeep.all) );
+    DMV.Lower_Windshield( DMV.Jeep(A_Jeep.all) );
+
+    if DMV.Wheels( Wash( A_Jeep, DMV.Jeep'Tag ) ) /= 4
+       or Storage /= 4 then
+      Report.Failed("Did not correctly wash Jeep");
+    end if;
+
+    if DMV.Wheels( Wash( A_Convertible, DMV.Convertible'Tag ) ) /= 3
+       or Storage /= 3 then
+      Report.Failed("Did not correctly wash Convertible");
+    end if;
+
+    if DMV.Wheels( Wash( A_Car, DMV.Car'Tag ) ) /= 2
+       or Storage /= 2 then
+      Report.Failed("Did not correctly wash Car");
+    end if;
+
+    if DMV.Wheels( Wash( A_Vehicle, DMV.Vehicle'Tag ) ) /= 1
+       or Storage /= 1 then
+      Report.Failed("Did not correctly wash Vehicle");
+    end if; 
+
+  end Function_Check;
+
+  Report.Result;
+end C390004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900050.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900050.a
new file mode 100644
index 000000000..8a00b2656
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900050.a
@@ -0,0 +1,157 @@
+-- C3900050.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:
+--      See C3900053.AM.
+--
+-- TEST DESCRIPTION:
+--      See C3900053.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--      => C3900050.A
+--         C3900051.A
+--         C3900052.A
+--         C3900053.AM
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+--                          for Ada.Calendar.
+--
+--!
+
+with Ada.Calendar;
+pragma Elaborate (Ada.Calendar);
+
+package C3900050 is  -- Alert system abstraction.
+
+   -- 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);
+
+
+   -- 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);
+
+
+
+   type Alert_Type is tagged private;                 -- Root tagged type.
+
+   procedure Set_Display (A : in out Alert_Type;      -- To be inherited by
+                          D : in     Device_Enum);    -- all derivatives.
+
+   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.
+
+
+   -- The following functions are needed to verify the values of the
+   -- root tagged type's private components.
+
+   function Get_Time (A: Alert_Type) return Ada.Calendar.Time;
+
+   function Get_Display (A: Alert_Type) return Device_Enum;
+
+   function Initial_Values_Okay (A : in Alert_Type)
+     return Boolean;
+
+   function Bad_Final_Values (A : in Alert_Type)
+     return Boolean;
+
+private
+
+   type Alert_Type is tagged record                    -- Root tagged type.
+      Arrival_Time : Ada.Calendar.Time := Default_Time;
+      Display_On   : Device_Enum   := Null_Device;
+   end record;
+
+
+end C3900050;
+
+
+     --==================================================================--
+
+
+package body C3900050 is  -- Alert system abstraction.
+
+
+   procedure Set_Display (A : in out Alert_Type;
+                          D : in     Device_Enum) is
+   begin
+      A.Display_On := D;
+   end Set_Display;
+
+
+   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;
+
+
+   function Get_Time (A: Alert_Type) return Ada.Calendar.Time is
+   begin
+      return A.Arrival_Time;
+   end Get_Time;
+
+
+   function Get_Display (A: Alert_Type) return Device_Enum is
+   begin
+      return A.Display_On;
+   end Get_Display;
+
+
+   function Initial_Values_Okay (A : in Alert_Type) return Boolean is
+   begin
+      return (A = (Arrival_Time => Default_Time,         -- Check "=" operator
+                   Display_On   => Null_Device));        -- availability.
+   end Initial_Values_Okay;                              -- Aggregate with
+                                                         -- named associations.
+
+   function Bad_Final_Values (A : in Alert_Type) return Boolean is
+   begin
+      return (A /= (Alert_Time, Null_Device));           -- Check "/=" operator
+                                                         -- availability.
+   end Bad_Final_Values;                                 -- Aggregate with
+                                                         -- positional assoc.
+
+end C3900050;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900051.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900051.a
new file mode 100644
index 000000000..d23a62bff
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900051.a
@@ -0,0 +1,137 @@
+-- C3900051.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:
+--      See C3900053.AM.
+--
+-- TEST DESCRIPTION:
+--      See C3900053.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         C3900050.A
+--      => C3900051.A
+--         C3900052.A
+--         C3900053.AM
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+--                          for Ada.Calendar.
+--
+--!
+
+with C3900050;       -- Alert system abstraction.
+package C3900051 is  -- Extended alert system abstraction.
+
+
+   type Low_Alert_Type is new C3900050.Alert_Type
+     with private;                                      -- Private extension of
+                                                        -- root tagged type.
+
+   -- Inherits procedure Display from Alert_Type.
+
+   procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
+                                                        -- primitive subprog.
+
+   procedure Set_Level (LA : in out Low_Alert_Type;     -- To be inherited by
+                        L  : in     Integer);           -- all derivatives.
+
+
+   -- The following functions are needed to verify the values of the
+   -- extension's private components.
+
+   function Get_Level (LA: Low_Alert_Type) return Integer;
+
+   function Initial_Values_Okay (LA : in Low_Alert_Type)
+     return Boolean;                                    -- Override parent's
+                                                        -- primitive subprog.
+
+   function Bad_Final_Values (LA : in Low_Alert_Type)   -- Override parent's
+     return Boolean;                                    -- primitive subprog.
+
+
+private
+
+   type Low_Alert_Type is new C3900050.Alert_Type with record
+      Level : Integer := 0;
+   end record;
+
+end C3900051;
+
+
+     --==================================================================--
+
+
+with Ada.Calendar;
+pragma Elaborate (Ada.Calendar);
+
+package body C3900051 is  -- Extended alert system abstraction.
+
+   use C3900050;  -- Alert system abstraction.
+
+
+   procedure Set_Level (LA : in out Low_Alert_Type;
+                        L  : in     Integer) is
+   begin
+      LA.Level := L;
+   end Set_Level;
+
+
+   procedure Handle (LA : in out Low_Alert_Type) is
+   begin
+      Handle (Alert_Type (LA));   -- Call parent's operation (type conversion).
+      Set_Level (LA, 1);          -- Call newly declared operation.
+      Set_Display (Alert_Type(LA),
+                   Teletype);     -- Call parent's operation (type conversion).
+      Display (LA);              
+   end Handle;
+
+
+   function Get_Level (LA: Low_Alert_Type) return Integer is
+   begin
+      return LA.Level;
+   end Get_Level;
+
+
+   function Initial_Values_Okay (LA : in Low_Alert_Type) return Boolean is
+   begin
+      -- Call parent's operation (type conversion).
+      return (Initial_Values_Okay (Alert_Type (LA)) and
+              LA.Level = 0);
+   end Initial_Values_Okay;
+
+
+   function Bad_Final_Values (LA : in Low_Alert_Type) return Boolean is
+      use type Ada.Calendar.Time;
+   begin
+      return (Get_Time(LA)    /= Alert_Time or
+              Get_Display(LA) /= Teletype or
+              LA.Level        /= 1);
+   end Bad_Final_Values;
+
+
+end C3900051;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900052.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900052.a
new file mode 100644
index 000000000..11d26db4a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900052.a
@@ -0,0 +1,138 @@
+-- C3900052.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:
+--      See C3900053.AM.
+--
+-- TEST DESCRIPTION:
+--      See C3900053.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         C3900050.A
+--         C3900051.A
+--      => C3900052.A
+--         C3900053.AM
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 May 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+--                          for Ada.Calendar.
+--
+--!
+
+with C3900051;       -- Extended alert system abstraction.
+package C3900052 is  -- Further extended alert system abstraction.
+
+
+   -- Declarations used by component Action_Officer;
+
+   type Person_Enum is (Nobody,          Duty_Officer,
+                        Watch_Commander, Commanding_Officer);
+
+
+   type Medium_Alert_Type is new C3900051.Low_Alert_Type
+     with private;                                      -- Private extension of
+                                                        -- private extension.
+
+   -- Inherits (inherited) procedure Display from Low_Alert_Type.
+   -- Inherits function Level_Of from Low_Alert_Type.
+
+   procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
+                                                        -- primitive subprog.
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum);
+
+
+   -- The following functions are needed to verify the values of the
+   -- extension's private components.
+
+   function Initial_Values_Okay (MA : in Medium_Alert_Type)
+     return Boolean;                                    -- Override parent's
+                                                        -- primitive subprog.
+
+   function Bad_Final_Values (MA: in Medium_Alert_Type) -- Override parent's
+     return Boolean;                                    -- primitive subprog.
+
+private
+
+   type Medium_Alert_Type is new C3900051.Low_Alert_Type with record
+      Action_Officer : Person_Enum := Nobody;
+   end record;
+
+end C3900052;
+
+
+     --==================================================================--
+
+
+with C3900050;            -- Basic alert abstraction.
+with Ada.Calendar;
+pragma Elaborate (Ada.Calendar);
+
+package body C3900052 is  -- Further extended alert system abstraction.
+
+   use C3900050;  -- Enumeration values directly visible.
+   use C3900051;  -- Extended alert system abstraction.
+
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum) is
+   begin
+      MA.Action_Officer := To;
+   end Assign_Officer;
+
+
+   procedure Handle (MA : in out Medium_Alert_Type) is
+   begin
+      Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
+      Set_Level (MA, 2);                 -- Call inherited operation.
+      Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
+      Set_Display (MA, Console);         -- Call inherited operation.
+      Display (MA);                      -- Call doubly inherited operation.
+   end Handle;
+
+
+   function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
+   begin
+      -- Call parent's operation (type conversion).
+      return (Initial_Values_Okay (Low_Alert_Type (MA)) and
+              MA.Action_Officer = Nobody);
+   end Initial_Values_Okay;
+
+
+   function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
+      use type Ada.Calendar.Time;
+   begin
+      return (Get_Time(MA)      /= Alert_Time or
+              Get_Display(MA)   /= Console    or
+              Get_Level(MA)     /= 2          or
+              MA.Action_Officer /= Duty_Officer);
+   end Bad_Final_Values;
+
+
+end C3900052;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900053.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900053.am
new file mode 100644
index 000000000..8ea3c118a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900053.am
@@ -0,0 +1,191 @@
+-- C3900053.AM
+--
+--                             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 private tagged type declared in a package specification
+--      may be extended with a private extension in a different package
+--      specification, and that this private extension may in turn be extended
+--      by a private extension in a third package.
+--
+--      Check that each derivative inherits the user-defined primitive
+--      subprograms of its parent (including those that its parent inherited),
+--      that it may override these inherited primitive subprograms, and that it
+--      may also declare its own primitive subprograms.
+--
+--      Check that type conversion is defined from a type extension to its
+--      parent, and that this parent itself may be a type extension.
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged private type and two associated primitive
+--      subprograms in a package specification. Declare operations to verify
+--      the correctness of the components. Declare operations which return
+--      values of the type's private components, and which will be
+--      inherited by later derivatives.
+-- 
+--      Extend the root type with a private extension in a second package
+--      specification. Declare a new primitive subprogram for the extension,
+--      and override one of the two inherited subprograms. Within the
+--      overriding subprogram, utilize type conversion to call the parent's
+--      implementation of the same subprogram. Also within the overriding
+--      subprogram, call the new primitive subprogram and each inherited
+--      subprogram. Declare operations of the private extension which
+--      override the verification operations of its parent. Declare operations
+--      of the private extension which return values of the extension's
+--      private components, and which will be inherited by later derivatives.
+--      
+--      Extend the extension with a private extension in a third package
+--      specification. Declare a new primitive subprogram for this private
+--      extension, and override one of the three inherited subprograms.
+--      Within the overriding subprogram, utilize type conversion to call the
+--      parent's implementation of the same subprogram. Also within the
+--      overriding subprogram, call the new primitive subprogram and each
+--      inherited subprogram. Declare operations of the private extension
+--      which override the verification operations of its parent.
+-- 
+--      In the main program, declare objects of the root tagged type and
+--      the two type extensions. For each object, call the overriding
+--      subprogram, and verify the correctness of the components by calling
+--      the verification operations.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         C3900050.A
+--         C3900051.A
+--         C3900052.A
+--      => C3900053.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 May 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with Report;
+
+with C3900050; -- Basic alert abstraction.
+with C3900051; -- Extended alert abstraction.
+with C3900052; -- Further extended alert abstraction.
+
+use  C3900050; -- Primitive operations of Alert_Type directly visible.
+
+procedure C3900053 is
+begin
+
+   Report.Test ("C390005", "Primitive operation inheritance by type " &
+                "extensions: root type is private; all extensions are " &
+                "private and declared in different packages");
+
+
+   ALERT_SUBTEST: -------------------------------------------------------------
+
+      declare
+         Alarm : C3900050.Alert_Type;     -- Root tagged private type.
+      begin
+         if not Initial_Values_Okay (Alarm) then
+            Report.Failed ("Wrong initial values for Alert_Type");
+         end if;
+
+         Handle (Alarm);
+
+         if Bad_Final_Values (Alarm) then
+            Report.Failed ("Wrong values for Alert_Type after Handle");
+         end if;
+      end Alert_Subtest;
+
+
+   -- Check intermediate display counts:
+
+   if C3900050.Display_Count_For (Null_Device) /= 1 or
+      C3900050.Display_Count_For (Teletype)    /= 0 or
+      C3900050.Display_Count_For (Console)     /= 0 or
+      C3900050.Display_Count_For (Big_Screen)  /= 0
+   then
+      Report.Failed ("Wrong display counts after Alert_Type");
+   end if;
+
+
+   LOW_ALERT_SUBTEST: ---------------------------------------------------------
+
+      declare
+         Low_Alarm : C3900051.Low_Alert_Type; -- Priv. ext. of tagged type.
+         use C3900051; -- Primitive operations of extension directly visible.
+      begin
+         if not Initial_Values_Okay (Low_Alarm) then
+            Report.Failed ("Wrong initial values for Low_Alert_Type");
+         end if;
+
+         Handle (Low_Alarm);
+
+         if Bad_Final_Values (Low_Alarm) then
+            Report.Failed ("Wrong values for Low_Alert_Type after Handle");
+         end if;
+      end Low_Alert_Subtest;
+
+
+   -- Check intermediate display counts:
+
+   if C3900050.Display_Count_For /= (Null_Device => 2,
+                                     Teletype    => 1,
+                                     Console     => 0,
+                                     Big_Screen  => 0)
+   then
+      Report.Failed ("Wrong display counts after Low_Alert_Type");
+   end if;
+
+
+   MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
+
+      declare
+         Medium_Alarm : C3900052.Medium_Alert_Type; -- Priv. ext. of extension.
+         use C3900052; -- Primitive operations of extension directly visible.
+      begin
+         if not Initial_Values_Okay (Medium_Alarm) then
+            Report.Failed ("Wrong initial values for Medium_Alert_Type");
+         end if;
+
+         Handle (Medium_Alarm);
+
+         if Bad_Final_Values (Medium_Alarm) then
+            Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
+         end if;
+      end Medium_Alert_Subtest;
+
+
+   -- Check final display counts:
+
+   if C3900050.Display_Count_For /= (Null_Device => 3,
+                                     Teletype    => 2,
+                                     Console     => 1,
+                                     Big_Screen  => 0)
+   then
+      Report.Failed ("Wrong display counts after Medium_Alert_Type");
+   end if;
+
+
+   Report.Result;
+
+end C3900053;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900060.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900060.a
new file mode 100644
index 000000000..b77219c57
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900060.a
@@ -0,0 +1,159 @@
+-- C3900060.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:
+--      See C3900063.AM.
+--
+-- TEST DESCRIPTION:
+--      See C3900063.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--      => C3900060.A
+--         C3900061.A
+--         C3900062.A
+--         C3900063.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+--                          for Ada.Calendar.
+--
+--!
+
+with Ada.Calendar;
+pragma Elaborate (Ada.Calendar);
+
+package C3900060 is  -- Alert system abstraction.
+
+
+   -- 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);
+
+
+   -- 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);
+
+
+
+   type Alert_Type is tagged private;                 -- Root tagged type.
+
+   procedure Set_Display (A : in out Alert_Type;      -- To be inherited by
+                          D : in     Device_Enum);    -- all derivatives.
+
+   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.
+
+
+   -- The following functions are needed to verify the values of the
+   -- root tagged type's private components.
+
+   function Get_Time (A: Alert_Type) return Ada.Calendar.Time;
+
+   function Get_Display (A: Alert_Type) return Device_Enum;
+
+   function Initial_Values_Okay (A : in Alert_Type)
+     return Boolean;
+
+   function Bad_Final_Values (A : in Alert_Type)
+     return Boolean;
+
+private
+
+   type Alert_Type is tagged record                    -- Root tagged type.
+      Arrival_Time : Ada.Calendar.Time := Default_Time;
+      Display_On   : Device_Enum   := Null_Device;
+   end record;
+
+
+end C3900060;
+
+
+     --==================================================================--
+
+
+package body C3900060 is
+
+
+   procedure Set_Display (A : in out Alert_Type;
+                          D : in     Device_Enum) is
+   begin
+      A.Display_On := D;
+   end Set_Display;
+
+
+   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;
+
+
+   function Get_Time (A: Alert_Type) return Ada.Calendar.Time is
+   begin
+      return A.Arrival_Time;
+   end Get_Time;
+
+
+   function Get_Display (A: Alert_Type) return Device_Enum is
+   begin
+      return A.Display_On;
+   end Get_Display;
+
+
+   function Initial_Values_Okay (A : in Alert_Type) return Boolean is
+   begin
+      return (A = (Arrival_Time => Default_Time,         -- Check "=" operator
+                   Display_On   => Null_Device));        -- availability.
+   end Initial_Values_Okay;                              -- Aggregate with
+                                                         -- named associations.
+
+   function Bad_Final_Values (A : in Alert_Type) return Boolean is
+   begin
+      return (A /= (Alert_Time, Null_Device));           -- Check "/=" operator
+                                                         -- availability.
+   end Bad_Final_Values;                                 -- Aggregate with
+                                                         -- positional assoc.
+
+end C3900060;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900061.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900061.a
new file mode 100644
index 000000000..f776dcdb8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900061.a
@@ -0,0 +1,138 @@
+-- C3900061.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:
+--      See C3900063.AM.
+--
+-- TEST DESCRIPTION:
+--      See C3900063.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         C3900060.A
+--      => C3900061.A
+--         C3900062.A
+--         C3900063.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+--                          for Ada.Calendar.
+--
+--!
+
+with C3900060;       -- Alert system abstraction.
+package C3900061 is  -- Extended alert abstraction.
+
+
+   type Low_Alert_Type is new C3900060.Alert_Type
+     with private;                                      -- Private extension of
+                                                        -- root tagged type.
+
+   -- Inherits procedure Display from Alert_Type.
+
+   procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
+                                                        -- primitive subprog.
+
+   procedure Set_Level (LA : in out Low_Alert_Type;     -- To be inherited by
+                        L  : in     Integer);           -- all derivatives.
+
+
+   -- The following functions are needed to verify the values of the
+   -- extension's private components.
+
+   function Get_Level (LA: Low_Alert_Type) return Integer;
+
+   function Initial_Values_Okay (LA : in Low_Alert_Type)
+     return Boolean;                                    -- Override parent's
+                                                        -- primitive subprog.
+
+   function Bad_Final_Values (LA : in Low_Alert_Type)   -- Override parent's
+     return Boolean;                                    -- primitive subprog.
+
+
+private
+
+   type Low_Alert_Type is new C3900060.Alert_Type with record
+      Level : Integer := 0;
+   end record;
+
+end C3900061;
+
+
+     --==================================================================--
+
+
+with Ada.Calendar;
+pragma Elaborate (Ada.Calendar);
+
+package body C3900061 is
+
+   use C3900060;  -- Alert system abstraction.
+
+
+   procedure Set_Level (LA : in out Low_Alert_Type;
+                        L  : in     Integer) is
+   begin
+      LA.Level := L;
+   end Set_Level;
+
+
+   procedure Handle (LA : in out Low_Alert_Type) is
+   begin
+      Handle (Alert_Type (LA));   -- Call parent's operation (type conversion).
+      Set_Level (LA, 1);          -- Call newly declared operation.
+      Set_Display (Alert_Type(LA),
+                   Teletype);     -- Call parent's operation (type conversion).
+      Display (LA);               -- Call inherited operation.
+   end Handle;
+
+
+   function Get_Level (LA: Low_Alert_Type) return Integer is
+   begin
+      return LA.Level;
+   end Get_Level;
+
+
+   function Initial_Values_Okay (LA : in Low_Alert_Type) return Boolean is
+   begin
+      -- Call parent's operation (type conversion).
+      return (Initial_Values_Okay (Alert_Type (LA)) and
+              LA.Level = 0);
+   end Initial_Values_Okay;
+
+
+   function Bad_Final_Values (LA : in Low_Alert_Type) return Boolean is
+      use type Ada.Calendar.Time;
+   begin
+      return (Get_Time(LA)    /= Alert_Time or
+              Get_Display(LA) /= Teletype or
+              LA.Level        /= 1);
+   end Bad_Final_Values;
+
+
+end C3900061;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900062.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900062.a
new file mode 100644
index 000000000..87a1cd5a3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900062.a
@@ -0,0 +1,137 @@
+-- C3900062.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:
+--      See C3900063.AM.
+--
+-- TEST DESCRIPTION:
+--      See C3900063.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         C3900060.A
+--         C3900061.A
+--      => C3900062.A
+--         C3900063.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue. Added pragma Elaborate
+--                          for Ada.Calendar.
+--
+--!
+
+with C3900061;       -- Extended alert system abstraction.
+package C3900062 is  -- Further extended alert system abstraction.
+
+
+   -- Declarations used by component Action_Officer;
+
+   type Person_Enum is (Nobody,          Duty_Officer,
+                        Watch_Commander, Commanding_Officer);
+
+
+   type Medium_Alert_Type is new C3900061.Low_Alert_Type
+     with record                                        -- Record extension of
+      Action_Officer : Person_Enum := Nobody;           -- private extension.
+   end record;
+
+
+   -- Inherits (inherited) procedure Display from Low_Alert_Type.
+   -- Inherits function Level_Of from Low_Alert_Type.
+
+   procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
+                                                        -- primitive subprog.
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum);
+
+
+   -- The following functions are needed to verify the values of the
+   -- extension's private components.
+
+   function Initial_Values_Okay (MA : in Medium_Alert_Type)
+     return Boolean;                                    -- Override parent's
+                                                        -- primitive subprog.
+
+   function Bad_Final_Values (MA: in Medium_Alert_Type) -- Override parent's
+     return Boolean;                                    -- primitive subprog.
+
+
+end C3900062;
+
+
+     --==================================================================--
+
+
+with C3900060;            -- Basic alert abstraction.
+
+with Ada.Calendar;
+pragma Elaborate (Ada.Calendar);
+
+package body C3900062 is
+
+   use C3900060;  -- Enumeration values directly visible.
+   use C3900061;  -- Extended alert system abstraction.
+
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum) is
+   begin
+      MA.Action_Officer := To;
+   end Assign_Officer;
+
+
+   procedure Handle (MA : in out Medium_Alert_Type) is
+   begin
+      Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
+      Set_Level (MA, 2);                 -- Call inherited operation.
+      Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
+      Set_Display (MA, Console);         -- Call inherited operation.
+      Display (MA);                      -- Call doubly inherited operation.
+   end Handle;
+
+
+   function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
+   begin
+      -- Call parent's operation (type conversion).
+      return (Initial_Values_Okay (Low_Alert_Type (MA)) and
+              MA.Action_Officer = Nobody);
+   end Initial_Values_Okay;
+
+
+   function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
+      use type Ada.Calendar.Time;
+   begin
+      return (Get_Time(MA)      /= Alert_Time or
+              Get_Display(MA)   /= Console    or
+              Get_Level(MA)     /= 2          or
+              MA.Action_Officer /= Duty_Officer);
+   end Bad_Final_Values;
+
+
+end C3900062;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900063.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900063.am
new file mode 100644
index 000000000..7d88719ad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3900063.am
@@ -0,0 +1,138 @@
+-- C3900063.AM
+--
+--                             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 private tagged type declared in a package specification
+--      may be extended with a private extension in a different package
+--      specification, and that this private extension may in turn be extended
+--      by a record extension in a third package.
+--
+--      Check that each derivative inherits the user-defined primitive
+--      subprograms of its parent (including those that its parent inherited),
+--      that it may override these inherited primitive subprograms, and that it
+--      may also declare its own primitive subprograms.
+--
+--      Check that type conversion is defined from a type extension to its
+--      parent, and that this parent itself may be a type extension.
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged private type and two associated primitive
+--      subprograms in a package specification. Declare operations to verify
+--      the correctness of the components. Declare operations which return
+--      values of the type's private components, and which will be inherited
+--      by later derivatives.
+-- 
+--      Extend the root type with a private extension in a second package
+--      specification. Declare a new primitive subprogram for the extension,
+--      and override one of the two inherited subprograms. Within the
+--      overriding subprogram, utilize type conversion to call the parent's
+--      implementation of the same subprogram. Also within the overriding
+--      subprogram, call the new primitive subprogram and each inherited
+--      subprogram. Declare operations of the private extension which
+--      override the verification operations of its parent. Declare
+--      operations which return values of the extension's private components,
+--      and which will be inherited by later derivatives.
+--      
+--      Extend the extension with a record extension in a third package
+--      specification. Declare a new primitive subprogram for this record
+--      extension, and override one of the three inherited subprograms.
+--      Within the overriding subprogram, utilize type conversion to call the
+--      parent's implementation of the same subprogram. Also within the
+--      overriding subprogram, call the new primitive subprogram and each
+--      inherited subprogram. Declare operations of the record extension
+--      which override the verification operations of its parent.
+-- 
+--      In the main program, declare objects of the root tagged type and
+--      the two type extensions. For each object, call the overriding
+--      subprogram, and verify the correctness of the components by calling
+--      the verification operations.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         C3900060.A
+--         C3900061.A
+--         C3900062.A
+--      => C3900063.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with Report;
+
+with C3900060; -- Basic alert abstraction.
+with C3900062; -- Further extended alert abstraction.
+
+use  C3900060; -- Primitive operations of Alert_Type directly visible.
+
+procedure C3900063 is
+begin
+
+   Report.Test ("C390006", "Primitive operation inheritance by type " &
+                "extensions: all extensions declared in different " &
+                "packages; root type and 1st extension are private, " &
+                "2nd extension is record extension");
+
+
+   -- The cases for type C3900060.Alert_Type and C3900061.Low_Alert_Type
+   -- are tested in C390005. Those subtests are not repeated here.
+
+
+   MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
+
+      declare
+         Medium_Alarm : C3900062.Medium_Alert_Type; -- Rec. ext. of extension.
+         use C3900062; -- Primitive operations of extension directly visible.
+      begin
+         if not Initial_Values_Okay (Medium_Alarm) then
+            Report.Failed ("Wrong initial values for Medium_Alert_Type");
+         end if;
+
+         Handle (Medium_Alarm);
+
+         if Bad_Final_Values (Medium_Alarm) then
+            Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
+         end if;
+      end Medium_Alert_Subtest;
+
+
+   -- Check final display counts:
+
+   if C3900060.Display_Count_For /= (Null_Device => 1,
+                                     Teletype    => 1,
+                                     Console     => 1,
+                                     Big_Screen  => 0)
+   then
+      Report.Failed ("Wrong display counts after Medium_Alert_Type");
+   end if;
+
+
+   Report.Result;
+
+end C3900063;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390007.a
new file mode 100644
index 000000000..46f59f66c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390007.a
@@ -0,0 +1,374 @@
+-- C390007.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 tag of an object of a tagged type is preserved by
+--      type conversion and parameter passing.
+--
+-- TEST DESCRIPTION:
+--      The fact that the tag of an object is not changed is verified by
+--      making dispatching calls to primitive operations, and confirming that
+--      the proper body is executed. Objects of both specific and class-wide
+--      types are checked. 
+--
+--      The dispatching calls are made in two contexts. The first is a
+--      straightforward dispatching call made from within a class-wide
+--      operation. The second is a redispatch from within a primitive
+--      operation.
+--
+--      For the parameter passing case, the initial class-wide and specific
+--      objects are passed directly in calls to the class-wide and primitive
+--      operations. The redispatch is accomplished by initializing a local
+--      class-wide object in the primitive operation to the value of the
+--      formal parameter, and using the local object as the actual in the
+--      (re)dispatching call.
+--
+--      For the type conversion case, the initial class-wide object is assigned
+--      a view conversion of an object of a specific type:
+--
+--         type T is tagged ...
+--         type DT is new T with ...
+--
+--         A : DT;
+--         B : T'Class := T(A); -- Despite conversion, tag of B is that of DT.
+--
+--      The class-wide object is then passed directly in calls to the
+--      class-wide and primitive operations. For the initial object of a
+--      specific type, however, a view conversion of the object is passed,
+--      forcing a non-dispatching call in the primitive operation case. Within
+--      the primitive operation, a view conversion of the formal parameter to
+--      a class-wide type is then used to force a (re)dispatching call.
+--
+--      For the type conversion and parameter passing case, a combining of
+--      view conversion and parameter passing of initial specific objects are 
+--      called directly to the class-wide and primitive operations. 
+--
+--
+-- CHANGE HISTORY:
+--      28 Jun 95   SAIC    Initial prerelease version.
+--      23 Apr 96   SAIC    Added use C390007_0 in the main.
+--
+--!
+
+package C390007_0 is
+
+   type Call_ID_Kind is (None, Parent_Outer,  Parent_Inner,
+                               Derived_Outer, Derived_Inner);
+
+   type Root_Type is abstract tagged null record;
+
+   procedure Outer_Proc (X : in out Root_Type) is abstract;
+   procedure Inner_Proc (X : in out Root_Type) is abstract;
+
+   procedure ClassWide_Proc (X : in out Root_Type'Class);
+
+end C390007_0;
+
+
+     --==================================================================--
+
+
+package body C390007_0 is
+
+   procedure ClassWide_Proc (X : in out Root_Type'Class) is
+   begin
+      Inner_Proc (X);
+   end ClassWide_Proc;
+
+end C390007_0;
+
+
+     --==================================================================--
+
+
+package C390007_0.C390007_1 is
+
+   type Param_Parent_Type is new Root_Type with record
+      Last_Call : Call_ID_Kind := None;
+   end record;
+
+   procedure Outer_Proc (X : in out Param_Parent_Type);
+   procedure Inner_Proc (X : in out Param_Parent_Type);
+
+end C390007_0.C390007_1;
+
+
+     --==================================================================--
+
+
+package body C390007_0.C390007_1 is
+
+   procedure Outer_Proc (X : in out Param_Parent_Type) is
+   begin
+      X.Last_Call := Parent_Outer;
+   end Outer_Proc;
+
+   procedure Inner_Proc (X : in out Param_Parent_Type) is
+   begin
+      X.Last_Call := Parent_Inner;
+   end Inner_Proc;
+
+end C390007_0.C390007_1;
+
+
+     --==================================================================--
+
+
+package C390007_0.C390007_1.C390007_2 is
+
+   type Param_Derived_Type is new Param_Parent_Type with null record;
+
+   procedure Outer_Proc (X : in out Param_Derived_Type);
+   procedure Inner_Proc (X : in out Param_Derived_Type);
+
+end C390007_0.C390007_1.C390007_2;
+
+
+     --==================================================================--
+
+
+package body C390007_0.C390007_1.C390007_2 is
+
+   procedure Outer_Proc (X : in out Param_Derived_Type) is
+      Y : Root_Type'Class := X;
+   begin
+      Inner_Proc (Y);  -- Redispatch.
+      Root_Type'Class (X) := Y;
+   end Outer_Proc;
+
+   procedure Inner_Proc (X : in out Param_Derived_Type) is
+   begin
+      X.Last_Call := Derived_Inner;
+   end Inner_Proc;
+
+end C390007_0.C390007_1.C390007_2;
+
+
+     --==================================================================--
+
+
+package C390007_0.C390007_3 is
+
+   type Convert_Parent_Type is new Root_Type with record
+      First_Call  : Call_ID_Kind := None;
+      Second_Call : Call_ID_Kind := None;
+   end record;
+
+   procedure Outer_Proc (X : in out Convert_Parent_Type);
+   procedure Inner_Proc (X : in out Convert_Parent_Type);
+
+end C390007_0.C390007_3;
+
+
+     --==================================================================--
+
+
+package body C390007_0.C390007_3 is
+
+   procedure Outer_Proc (X : in out Convert_Parent_Type) is
+   begin
+      X.First_Call := Parent_Outer;
+      Inner_Proc (Root_Type'Class(X));  -- Redispatch.
+   end Outer_Proc;
+
+   procedure Inner_Proc (X : in out Convert_Parent_Type) is
+   begin
+      X.Second_Call := Parent_Inner;
+   end Inner_Proc;
+
+end C390007_0.C390007_3;
+
+
+     --==================================================================--
+
+
+package C390007_0.C390007_3.C390007_4 is
+
+   type Convert_Derived_Type is new Convert_Parent_Type with null record;
+
+   procedure Outer_Proc (X : in out Convert_Derived_Type);
+   procedure Inner_Proc (X : in out Convert_Derived_Type);
+
+end C390007_0.C390007_3.C390007_4;
+
+
+     --==================================================================--
+
+
+package body C390007_0.C390007_3.C390007_4 is
+
+   procedure Outer_Proc (X : in out Convert_Derived_Type) is
+   begin
+      X.First_Call := Derived_Outer;
+      Inner_Proc (Root_Type'Class(X));  -- Redispatch.
+   end Outer_Proc;
+
+   procedure Inner_Proc (X : in out Convert_Derived_Type) is
+   begin
+      X.Second_Call := Derived_Inner;
+   end Inner_Proc;
+
+end C390007_0.C390007_3.C390007_4;
+
+
+     --==================================================================--
+
+
+with C390007_0.C390007_1.C390007_2;
+with C390007_0.C390007_3.C390007_4;
+use  C390007_0;
+
+with Report;
+procedure C390007 is
+begin
+   Report.Test ("C390007", "Check that the tag of an object of a tagged " &
+                "type is preserved by type conversion and parameter passing");
+
+
+   --
+   -- Check that tags are preserved by parameter passing:
+   --
+
+   Parameter_Passing_Subtest:
+   declare
+      Specific_A  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
+      Specific_B  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
+
+      ClassWide_A : C390007_0.C390007_1.Param_Parent_Type'Class := Specific_A;
+      ClassWide_B : C390007_0.C390007_1.Param_Parent_Type'Class := Specific_B;
+
+      use C390007_0.C390007_1;
+      use C390007_0.C390007_1.C390007_2;
+   begin
+
+      Outer_Proc (Specific_A);         
+      if Specific_A.Last_Call /= Derived_Inner then
+         Report.Failed ("Parameter passing: tag not preserved in call to " &
+                        "primitive operation with specific operand");
+      end if;
+
+      C390007_0.ClassWide_Proc (Specific_B);
+      if Specific_B.Last_Call /= Derived_Inner then
+         Report.Failed ("Parameter passing: tag not preserved in call to " &
+                        "class-wide operation with specific operand");
+      end if;
+
+      Outer_Proc (ClassWide_A);        
+      if ClassWide_A.Last_Call /= Derived_Inner then
+         Report.Failed ("Parameter passing: tag not preserved in call to " &
+                        "primitive operation with class-wide operand");
+      end if;
+
+      C390007_0.ClassWide_Proc (ClassWide_B);
+      if ClassWide_B.Last_Call /= Derived_Inner then
+         Report.Failed ("Parameter passing: tag not preserved in call to " &
+                        "class-wide operation with class-wide operand");
+      end if;
+
+   end Parameter_Passing_Subtest;
+
+
+   --
+   -- Check that tags are preserved by type conversion:
+   --
+
+   Type_Conversion_Subtest:
+   declare
+      Specific_A  : C390007_0.C390007_3.C390007_4.Convert_Derived_Type;
+      Specific_B  : C390007_0.C390007_3.C390007_4.Convert_Derived_Type;
+
+      ClassWide_A : C390007_0.C390007_3.Convert_Parent_Type'Class :=
+                    C390007_0.C390007_3.Convert_Parent_Type(Specific_A);
+      ClassWide_B : C390007_0.C390007_3.Convert_Parent_Type'Class :=
+                    C390007_0.C390007_3.Convert_Parent_Type(Specific_B);
+
+      use C390007_0.C390007_3;
+      use C390007_0.C390007_3.C390007_4;
+   begin
+
+      Outer_Proc (Convert_Parent_Type(Specific_A));
+      if (Specific_A.First_Call  /= Parent_Outer)  or
+         (Specific_A.Second_Call /= Derived_Inner)
+      then
+         Report.Failed ("Type conversion: tag not preserved in call to " &
+                        "primitive operation with specific operand");
+      end if;
+
+      Outer_Proc (ClassWide_A);   
+      if (ClassWide_A.First_Call  /= Derived_Outer) or
+         (ClassWide_A.Second_Call /= Derived_Inner)
+      then
+         Report.Failed ("Type conversion: tag not preserved in call to " &
+                        "primitive operation with class-wide operand");
+      end if;
+
+      C390007_0.ClassWide_Proc (Convert_Parent_Type(Specific_B));
+      if (Specific_B.Second_Call /= Derived_Inner) then
+         Report.Failed ("Type conversion: tag not preserved in call to " &
+                        "class-wide operation with specific operand");
+      end if;
+
+      C390007_0.ClassWide_Proc (ClassWide_B);
+      if (ClassWide_A.Second_Call /= Derived_Inner) then
+         Report.Failed ("Type conversion: tag not preserved in call to " &
+                        "class-wide operation with class-wide operand");
+      end if;
+
+   end Type_Conversion_Subtest;
+
+
+   --
+   -- Check that tags are preserved by type conversion and parameter passing:
+   --
+
+   Type_Conversion_And_Parameter_Passing_Subtest:
+   declare
+      Specific_A  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
+      Specific_B  : C390007_0.C390007_1.C390007_2.Param_Derived_Type;
+
+      use C390007_0.C390007_1;
+      use C390007_0.C390007_1.C390007_2;
+   begin
+
+      Outer_Proc (Param_Parent_Type (Specific_A));   
+      if Specific_A.Last_Call /= Parent_Outer then
+         Report.Failed ("Type conversion and parameter passing: tag not " &
+                        "preserved in call to primitive operation with "  &
+                        "specific operand");
+      end if;
+
+      C390007_0.ClassWide_Proc (Param_Parent_Type (Specific_B));
+      if Specific_B.Last_Call /= Derived_Inner then
+         Report.Failed ("Type conversion and parameter passing: tag not " &
+                        "preserved in call to class-wide operation with "  &
+                        "specific operand");
+      end if;
+
+   end Type_Conversion_And_Parameter_Passing_Subtest;
+
+
+   Report.Result;
+
+end C390007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390010.a
new file mode 100644
index 000000000..1590e5027
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390010.a
@@ -0,0 +1,216 @@
+-- C390010.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 S is a subtype of a tagged type T, and if S is
+--     constrained, then the allowable values of S'Class are only those
+--     that, when converted to T, belong to S.
+--
+-- TEST DESCRIPTION:
+--      This test defines a small tagged hierarchy of discriminated tagged
+--      records, and constrained subtypes of those tagged record types.
+--      It then uses access to the classwide of the constrained subtype
+--      to check the objective.
+--
+--
+-- CHANGE HISTORY:
+--      09 APR 96   SAIC   Initial version
+--      03 NOV 96   SAIC   Revised for 2.1 release
+--      31 DEC 97   EDS    Restored use of intermediate access variable
+--                         to eliminate raising of Program_Error
+--      13 SEP 99   RLB    Repaired previous change to avoid premature
+--                         subtype check.
+--      28 JUN 02   RLB    Added pragma Elaborate_All (Report);.
+--!
+
+----------------------------------------------------------------- C390010_0
+
+with Report; pragma Elaborate_All (Report);
+package C390010_0 is
+
+  -- the defined subprograms will allow checking the placement of
+  -- constraint_checks
+
+  -- define a discriminated tagged type, and a constrained subtype of
+  -- that type:
+
+  type Discr_Tag_Record( Disc: Boolean ) is tagged record
+    FieldA : Character := 'A';
+    case Disc is
+      when True  => FieldB : Character := 'B';
+      when False => FieldC : Character := 'C';
+    end case;
+  end record;
+
+  procedure Dispatching_Op( DTO : in out Discr_Tag_Record );
+
+  Authentic : Boolean := Report.Ident_Bool( True );
+
+  subtype True_Record is Discr_Tag_Record( Authentic );
+
+
+  -- derive a type, "passing through" one discriminant, adding one
+  -- discriminant, and a constrained subtype of THAT type:
+
+  type Derived_Record( Disc1, Disc2: Boolean ) is
+    new Discr_Tag_Record( Disc1 ) with record
+      FieldD : Character := 'D';
+      case Disc2 is
+        when True  => FieldE : Character := 'E';
+        when False => FieldF : Character := 'F';
+      end case;
+    end record;
+
+  procedure Dispatching_Op( DR : in out Derived_Record );
+
+  subtype True_True_Derived is Derived_Record( Authentic, Authentic );
+
+
+  -- now, define an access to classwide type, using the classwide from the
+  -- constrained subtype of the root (or parent) type:
+
+  type Subtype_Parent_Class_Access is access all True_Record'Class;
+  type Parent_Class_Access is access all Discr_Tag_Record'Class;
+
+  procedure PCW_Op( SPCA : in Subtype_Parent_Class_Access );
+
+end C390010_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- C390010_0
+
+with Report;
+with TCTouch;
+package body C390010_0 is
+
+  procedure Dispatching_Op( DTO : in out Discr_Tag_Record ) is
+  begin
+    TCTouch.Touch('1');  --------------------------------------------------- 1
+    if DTO.Disc then
+      TCTouch.Touch(DTO.FieldB);  ------------------------------------------ B
+    else
+      TCTouch.Touch(DTO.FieldC);  ------------------------------------------ C
+    end if;
+  end Dispatching_Op;
+
+
+  procedure Dispatching_Op( DR : in out Derived_Record ) is
+  begin
+    TCTouch.Touch('2');  --------------------------------------------------- 2
+    if DR.Disc1 then
+      TCTouch.Touch(DR.FieldB);   ------------------------------------------ B
+    else
+      TCTouch.Touch(DR.FieldC);   ------------------------------------------ C
+    end if;
+    if DR.Disc2 then
+      TCTouch.Touch(DR.FieldE);   ------------------------------------------ E
+    else
+      TCTouch.Touch(DR.FieldF);   ------------------------------------------ F
+    end if;
+  end Dispatching_Op;
+
+  procedure PCW_Op( SPCA : in Subtype_Parent_Class_Access ) is
+  begin
+
+    -- the following line is the "heart" of this test, objects of all types
+    -- covered by the classwide type will be passed to this subprogram in
+    -- the execution of the test.
+    if SPCA.Disc then
+      TCTouch.Touch(SPCA.FieldB); ------------------------------------------ B
+    else
+      TCTouch.Touch(SPCA.FieldC); ------------------------------------------ C
+    end if;
+
+    Dispatching_Op( SPCA.all );  -- check that this dispatches correctly,
+                                 -- with discriminants correctly represented
+
+  end PCW_Op;
+
+end C390010_0;
+
+------------------------------------------------------------------- C390010
+
+with Report;
+with TCTouch;
+with C390010_0;
+procedure C390010 is
+
+  package CP renames C390010_0;
+
+  procedure Check_Element( Item : access CP.Discr_Tag_Record'Class ) is
+  begin
+
+    -- the implicit conversion from the general access parameter to the more
+    -- constrained subtype access type in the following call should cause
+    -- Constraint_Error in the cases where the object is not correctly
+    -- constrained
+
+    CP.PCW_Op( Item.all'Access );
+
+  exception
+    when Constraint_Error => TCTouch.Touch('X');  -------------------------- X
+    when others => Report.Failed("Unanticipated exception in Check_Element");
+
+  end Check_Element;
+
+  An_Item : CP.Parent_Class_Access;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C390010", "Check that if S is a subtype of a tagged type " &
+                          "T, and if S is constrained, then the allowable " &
+                          "values of S'Class are only those that, when " &
+                          "converted to T, belong to S" );
+
+  An_Item := new CP.Discr_Tag_Record(True);
+  Check_Element( An_Item );
+  TCTouch.Validate("B1B","Case 1");
+
+  An_Item := new CP.Discr_Tag_Record(False);
+  Check_Element( An_Item );
+  TCTouch.Validate("X","Case 2");
+
+  An_Item := new CP.True_Record;
+  Check_Element( An_Item );
+  TCTouch.Validate("B1B","Case 3");
+
+  An_Item := new CP.Derived_Record(False, False);
+  Check_Element( An_Item );
+  TCTouch.Validate("X","Case 4");
+
+  An_Item := new CP.Derived_Record(False, True);
+  Check_Element( An_Item );
+  TCTouch.Validate("X","Case 5");
+
+  An_Item := new CP.Derived_Record(True, False);
+  Check_Element( An_Item );
+  TCTouch.Validate("B2BF","Case 6");
+
+  An_Item := new CP.True_True_Derived;
+  Check_Element( An_Item );
+  TCTouch.Validate("B2BE","Case 7");
+
+  Report.Result;
+
+end C390010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390011.a
new file mode 100644
index 000000000..74cf0eb04
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390011.a
@@ -0,0 +1,250 @@
+-- C390011.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+--     unlimited rights in the software and documentation contained herein.
+--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+--     this public release, the Government intends to confer upon all 
+--     recipients unlimited rights  equal to those held by the Government.  
+--     These rights include rights to use, duplicate, release or disclose the 
+--     released technical data and computer software in whole or in part, in 
+--     any manner and for any purpose whatsoever, and to have or permit others 
+--     to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--     Check that tagged types declared within generic package declarations
+--     generate distinct tags for each instance of the generic.
+--
+-- TEST DESCRIPTION:
+--     This test defines a very simple generic package (with the expectation
+--     that it should be easily be shared), and a few instances of that
+--     package.  In true user-like fashion, two of the instances are identical
+--     (to wit: IIO is new Integer_IO(Integer)).  The tags generated for each
+--     of them are placed into a list.  The last action of the test is to
+--     check that everything in the list is unique.
+--
+--     Almost as an aside, this test defines functions that return T'Base and
+--     T'Class, and then exercises these functions.
+--
+--     (JPR) persistent objects really need a function like:
+--        function Get_Object return T'class;
+--
+--
+-- CHANGE HISTORY:
+--      20 OCT 95   SAIC   Initial version
+--      23 APR 96   SAIC   Commentary Corrections 2.1
+--
+--!
+
+----------------------------------------------------------------- C390011_0
+
+with Ada.Tags;
+package C390011_0 is
+
+  procedure Add_Tag_To_List( T : Ada.Tags.Tag; X_Name, X_Tag: String );
+
+  procedure Check_List_For_Duplicates;
+
+end C390011_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body C390011_0 is
+
+  use type Ada.Tags.Tag;
+  type SP is access String;
+
+  type List_Item;
+  type List_P is access List_Item;
+  type List_Item is record
+    The_Tag  : Ada.Tags.Tag;
+    Exp_Name : SP;
+    Ext_Tag  : SP;
+    Next : List_P;
+  end record;
+
+  The_List : List_P;
+
+  procedure Add_Tag_To_List ( T : Ada.Tags.Tag; X_Name, X_Tag: String ) is
+  begin  -- prepend the tag information to the list
+    The_List := new List_Item'( The_Tag  => T, 
+                                Exp_Name => new String'(X_Name), 
+                                Ext_Tag  => new String'(X_Tag),
+                                Next     => The_List );
+  end Add_Tag_To_List;
+
+  procedure Check_List_For_Duplicates is
+    Finger : List_P;
+    Thumb  : List_P := The_List;
+  begin  -- 
+    while Thumb /= null loop
+      Finger := Thumb.Next;
+      while Finger /= null loop
+        -- Check that the tag is unique
+        if Finger.The_Tag = Thumb.The_Tag then
+          Report.Failed("Duplicate Tag");
+        end if;
+
+        -- Check that the Expanded name is unique
+        if Finger.Exp_Name.all = Thumb.Exp_Name.all then
+          Report.Failed("Tag name " & Finger.Exp_Name.all & " repeats");
+        end if;
+
+        -- Check that the External Tag is unique
+
+        if Finger.Ext_Tag.all = Thumb.Ext_Tag.all then
+          Report.Failed("External Tag " & Finger.Ext_Tag.all & " repeats");
+        end if;
+        Finger := Finger.Next;
+      end loop;
+      Thumb  := Thumb.Next;
+   end loop;
+  end Check_List_For_Duplicates;
+
+begin
+  -- some things I just don't trust...
+  if The_List /= null then
+    Report.Failed("Implicit default for The_List not null");
+  end if;
+end C390011_0;
+
+----------------------------------------------------------------- C390011_1
+
+generic
+  type Index is (<>);
+  type Item is private;
+package C390011_1 is
+
+  type List is array(Index range <>) of Item;
+  type ListP is access all List;
+
+  type Table is tagged record
+    Data: ListP;
+  end record;
+
+  function Sort( T: in Table'Class ) return Table'Class;
+
+  function Stable_Table return Table'Class;
+
+  function Table_End( T: Table ) return Index'Base;
+
+end C390011_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body C390011_1 is
+
+    -- In a user program this package would DO something
+
+  function Sort( T: in Table'Class ) return Table'Class is
+  begin
+   return T;
+  end Sort;
+
+  Empty : Table'Class := Table'( Data => null );
+
+  function Stable_Table return Table'Class is
+  begin
+    return Empty;
+  end Stable_Table;
+
+  function Table_End( T: Table ) return Index'Base is
+  begin
+    return Index'Base( T.Data.all'Last );
+  end Table_End;
+
+end C390011_1;
+
+----------------------------------------------------------------- C390011_2
+
+with C390011_1;
+package C390011_2 is new C390011_1( Index => Character, Item => Float );
+
+----------------------------------------------------------------- C390011_3
+
+with C390011_1;
+package C390011_3 is new C390011_1( Index => Character, Item => Float );
+
+----------------------------------------------------------------- C390011_4
+
+with C390011_1;
+package C390011_4 is new C390011_1( Index => Integer, Item => Character );
+
+----------------------------------------------------------------- C390011_5
+
+with C390011_3;
+with C390011_4;
+package C390011_5 is
+
+  type Table_3 is new C390011_3.Table with record
+    Serial_Number : Integer;
+  end record;
+
+  type Table_4 is new C390011_4.Table with record
+    Serial_Number : Integer;
+  end record;
+
+end C390011_5;
+
+-- no package body C390011_5 required
+
+------------------------------------------------------------------- C390011
+
+with Report;
+with C390011_0;
+with C390011_2;
+with C390011_3;
+with C390011_4;
+with C390011_5;
+with Ada.Tags;
+procedure C390011 is
+
+begin  -- Main test procedure.
+
+  Report.Test ("C390011", "Check that tagged types declared within " &
+                          "generic package declarations generate distinct " &
+                          "tags for each instance of the generic. " &
+                          "Check that 'Base may be used as a subtype mark. " &
+                          "Check that T'Base and T'Class are allowed as " &
+                          "the subtype mark in a function result" );
+
+  -- build the tag information table
+  C390011_0.Add_Tag_To_List(T => C390011_2.Table'Tag,
+                       X_Name => Ada.Tags.Expanded_Name(C390011_2.Table'Tag),
+                       X_Tag  => Ada.Tags.External_Tag(C390011_2.Table'Tag) );
+
+  C390011_0.Add_Tag_To_List(T => C390011_3.Table'Tag,
+                       X_Name => Ada.Tags.Expanded_Name(C390011_3.Table'Tag),
+                       X_Tag  => Ada.Tags.External_Tag(C390011_3.Table'Tag) );
+
+  C390011_0.Add_Tag_To_List(T => C390011_4.Table'Tag,
+                       X_Name => Ada.Tags.Expanded_Name(C390011_4.Table'Tag),
+                       X_Tag  => Ada.Tags.External_Tag(C390011_4.Table'Tag) );
+
+  C390011_0.Add_Tag_To_List(T => C390011_5.Table_3'Tag,
+                     X_Name => Ada.Tags.Expanded_Name(C390011_5.Table_3'Tag),
+                     X_Tag  => Ada.Tags.External_Tag(C390011_5.Table_3'Tag) );
+
+  C390011_0.Add_Tag_To_List(T => C390011_5.Table_4'Tag,
+                     X_Name => Ada.Tags.Expanded_Name(C390011_5.Table_4'Tag),
+                     X_Tag  => Ada.Tags.External_Tag(C390011_5.Table_4'Tag) );
+
+  -- preform the check for distinct tags
+  C390011_0.Check_List_For_Duplicates;
+
+  Report.Result;
+
+end C390011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006a.ada
new file mode 100644
index 000000000..7e5f43dc0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006a.ada
@@ -0,0 +1,207 @@
+-- C39006A.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 PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A
+-- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED.  CHECK THE
+-- FOLLOWING:
+--     A) A FUNCTION IS CALLED IN THE INITIALIZATION EXPRESSION OF A
+--        SCALAR VARIABLE OR A RECORD COMPONENT, AND THE SCALAR OR
+--        RECORD VARIABLE'S DECLARATION IS ELABORATED BEFORE THE
+--        SUBPROGRAM BODY IS ELABORATED.
+
+-- TBN  8/14/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C39006A IS
+
+BEGIN
+     TEST ("C39006A", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " &
+                      "ATTEMPT IS MADE TO CALL A SUBPROGRAM WHOSE " &
+                      "BODY HAS NOT YET BEEN ELABORATED");
+     BEGIN
+          DECLARE
+
+               FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER;
+
+               VAR1 : INTEGER := INIT_1 (1);
+
+               FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER IS
+               BEGIN
+                    RETURN (A + IDENT_INT(1));
+               END INIT_1;
+
+          BEGIN
+               FAILED ("PROGRAM_ERROR NOT RAISED - 1");
+          END;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+     END;
+
+     BEGIN
+          DECLARE
+
+               FUNCTION INIT_2 (A : INTEGER) RETURN INTEGER;
+
+               TYPE REC1 IS
+                    RECORD
+                         NUMBER : INTEGER := INIT_2 (2);
+                    END RECORD;
+
+               VAR2 : REC1;
+
+               FUNCTION INIT_2 (A : INTEGER) RETURN INTEGER IS
+               BEGIN
+                    RETURN (A + IDENT_INT(1));
+               END INIT_2;
+
+          BEGIN
+               FAILED ("PROGRAM_ERROR NOT RAISED - 2");
+          END;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+     END;
+
+     BEGIN
+          DECLARE
+
+               FUNCTION F1 RETURN INTEGER;
+
+               PACKAGE PACK IS
+                    VAR1 : INTEGER := F1;
+               END PACK;
+
+               FUNCTION F1 RETURN INTEGER IS
+               BEGIN
+                    RETURN (IDENT_INT(1));
+               END F1;
+
+          BEGIN
+               FAILED ("PROGRAM_ERROR NOT RAISED - 3");
+          END;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+     END;
+
+     BEGIN
+          DECLARE
+
+               PACKAGE PACK IS
+                    FUNCTION F2 RETURN INTEGER;
+                    VAR2 : INTEGER := F2;
+               END PACK;
+
+               PACKAGE BODY PACK IS
+                    FUNCTION F2 RETURN INTEGER IS
+                    BEGIN
+                         RETURN (IDENT_INT(3));
+                    END F2;
+               END PACK;
+
+          BEGIN
+               FAILED ("PROGRAM_ERROR NOT RAISED - 4");
+          END;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+     END;
+
+     BEGIN
+          DECLARE
+
+               FUNCTION INIT_3 (A : INTEGER) RETURN INTEGER;
+
+               GENERIC
+                    PACKAGE Q IS
+                         VAR1 : INTEGER := INIT_3 (1);
+                    END Q;
+
+               PACKAGE NEW_Q IS NEW Q;
+
+               FUNCTION INIT_3 (A : INTEGER) RETURN INTEGER IS
+               BEGIN
+                    RETURN (A + IDENT_INT(3));
+               END INIT_3;
+
+          BEGIN
+               FAILED ("PROGRAM_ERROR NOT RAISED - 5");
+          END;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+     END;
+
+     BEGIN
+          DECLARE
+
+               FUNCTION FUN RETURN INTEGER;
+
+               TYPE PARAM IS
+                    RECORD
+                         COMP : INTEGER := FUN;
+                    END RECORD;
+
+               GENERIC
+                    TYPE T IS PRIVATE;
+               PACKAGE GP IS
+                    OBJ : T;
+               END GP;
+
+               PACKAGE INST IS NEW GP(PARAM);
+
+               FUNCTION FUN RETURN INTEGER IS
+               BEGIN
+                    RETURN (IDENT_INT(3));
+               END FUN;
+
+          BEGIN
+               FAILED ("PROGRAM_ERROR NOT RAISED - 6");
+          END;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+     END;
+
+     RESULT;
+END C39006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006b.ada
new file mode 100644
index 000000000..f7b4f2757
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006b.ada
@@ -0,0 +1,163 @@
+-- C39006B.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 PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A
+-- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED.  CHECK THE
+-- FOLLOWING:
+--     B) THE SUBPROGRAM IS CALLED IN A PACKAGE BODY.
+--     C) THE SUBPROGRAM IS AN ACTUAL GENERIC PARAMETER CALLED DURING
+--        ELABORATION OF THE GENERIC INSTANTIATION.
+--     D) THE SUBPROGRAM IS CALLED DURING ELABORATION OF AN OPTIONAL
+--        PACKAGE BODY.
+
+-- TBN  8/19/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C39006B IS
+
+BEGIN
+     TEST ("C39006B", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " &
+                      "ATTEMPT IS MADE TO CALL A SUBPROGRAM WHOSE " &
+                      "BODY HAS NOT YET BEEN ELABORATED");
+     BEGIN
+          DECLARE
+               PACKAGE PACK IS
+                    FUNCTION FUN RETURN INTEGER;
+                    PROCEDURE PROC (A : IN OUT INTEGER);
+               END PACK;
+
+               PACKAGE BODY PACK IS
+
+                    VAR1 : INTEGER := 0;
+
+                    PROCEDURE PROC (A : IN OUT INTEGER) IS
+                    BEGIN
+                         IF A = IDENT_INT(1) THEN
+                              A := A + FUN;
+                              FAILED ("PROGRAM_ERROR NOT RAISED - 1");
+                         ELSE
+                              A := IDENT_INT(1);
+                         END IF;
+                    EXCEPTION
+                         WHEN PROGRAM_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                      "1");
+                    END PROC;
+
+                    PACKAGE INSIDE IS
+                    END INSIDE;
+
+                    PACKAGE BODY INSIDE IS
+                    BEGIN
+                         PROC (VAR1);
+                         PROC (VAR1);
+                    END INSIDE;
+
+                    FUNCTION FUN RETURN INTEGER IS
+                    BEGIN
+                         RETURN (IDENT_INT(1));
+                    END FUN;
+
+               BEGIN
+                    NULL;
+               END PACK;
+
+          BEGIN
+               NULL;
+          END;
+     END;
+
+     BEGIN
+          DECLARE
+               FUNCTION INIT_2 RETURN INTEGER;
+
+               GENERIC
+                    WITH FUNCTION FF RETURN INTEGER;
+               PACKAGE P IS
+                    Y : INTEGER;
+               END P;
+
+               GLOBAL_INT : INTEGER := IDENT_INT(1);
+
+               PACKAGE BODY P IS
+               BEGIN
+                    IF GLOBAL_INT = 1 THEN
+                         Y := FF;
+                    END IF;
+               END P;
+
+               PACKAGE N IS
+                    PACKAGE NEW_P IS NEW P(INIT_2);
+               END N;
+
+               FUNCTION INIT_2 RETURN INTEGER IS
+               BEGIN
+                    RETURN (IDENT_INT (1));
+               END INIT_2;
+
+          BEGIN
+               FAILED ("PROGRAM_ERROR NOT RAISED - 2");
+          END;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+     END;
+
+     DECLARE
+
+          PROCEDURE ADD1 (A : IN OUT INTEGER);
+
+          PACKAGE P IS
+               VAR : INTEGER := IDENT_INT(1);
+          END P;
+
+          PACKAGE BODY P IS
+          BEGIN
+               IF VAR = 1 THEN
+                    ADD1 (VAR);
+                    FAILED ("PROGRAM_ERROR NOT RAISED - 3");
+               END IF;
+          EXCEPTION
+               WHEN PROGRAM_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+          END P;
+
+          PROCEDURE ADD1 (A : IN OUT INTEGER) IS
+          BEGIN
+               A := A + IDENT_INT(1);
+          END ADD1;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C39006B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006c0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006c0.ada
new file mode 100644
index 000000000..c29dd6f31
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006c0.ada
@@ -0,0 +1,69 @@
+-- C39006C0M.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 PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A
+-- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED.  CHECK THE
+-- FOLLOWING:
+--     D) THE SUBPROGRAM IS CALLED DURING ELABORATION OF AN OPTIONAL
+--        PACKAGE BODY SUBUNIT THAT IS IN C39006C1.ADA.
+
+-- SEPARATE FILES ARE:
+--     C39006C0M     THE MAIN PROCEDURE.
+--     C39006C1      A SUBUNIT PACKAGE BODY.
+
+-- TBN  8/19/86
+-- LDC  5/26/88   CHANGED TEST NAME PARAMETER FROM C39006C0M TO
+--                C39006C IN THE TEST CALL.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C39006C0M IS
+
+     PACKAGE CALL_TEST_FIRST IS
+     END CALL_TEST_FIRST;
+
+     PACKAGE BODY CALL_TEST_FIRST IS
+     BEGIN
+          TEST ("C39006C", "CHECK THAT PROGRAM_ERROR IS RAISED IF " &
+                             "THE SUBPROGRAM WHOSE BODY HAS NOT BEEN " &
+                             "ELABORATED IS CALLED DURING " &
+                             "ELABORATION OF AN OPTIONAL PACKAGE " &
+                             "BODY SUBUNIT");
+     END CALL_TEST_FIRST;
+
+     PROCEDURE ADD1 (A : IN OUT INTEGER);
+
+     PACKAGE C39006C1 IS
+          VAR : INTEGER := IDENT_INT(1);
+     END C39006C1;
+
+     PACKAGE BODY C39006C1 IS SEPARATE;
+
+     PROCEDURE ADD1 (A : IN OUT INTEGER) IS
+     BEGIN
+          A := A + IDENT_INT(1);
+     END ADD1;
+
+BEGIN
+     RESULT;
+END C39006C0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006c1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006c1.ada
new file mode 100644
index 000000000..0665cf037
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006c1.ada
@@ -0,0 +1,41 @@
+-- C39006C1.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 BODY SUBUNIT FOR C39006C0M.ADA.
+
+-- TBN  8/19/86
+
+SEPARATE (C39006C0M)
+PACKAGE BODY C39006C1 IS
+BEGIN
+     IF VAR = IDENT_INT(1) THEN
+          ADD1 (VAR);
+          FAILED ("PROGRAM_ERROR NOT RAISED");
+     END IF;
+EXCEPTION
+     WHEN PROGRAM_ERROR =>
+          NULL;
+     WHEN OTHERS =>
+          FAILED ("UNEXPECTED EXCEPTION RAISED");
+END C39006C1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006d.ada
new file mode 100644
index 000000000..f2969e82e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006d.ada
@@ -0,0 +1,144 @@
+-- C39006D.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 FUNCTION IS USED IN A DEFAULT EXPRESSION FOR A
+-- SUBPROGRAM OR FORMAL GENERIC PARAMETER, PROGRAM_ERROR IS RAISED
+-- WHEN AN ATTEMPT IS MADE TO EVALUATE THE DEFAULT EXPRESSION,
+-- BECAUSE THE FUNCTION'S BODY HAS NOT BEEN ELABORATED YET.
+
+-- TBN  8/20/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C39006D IS
+
+BEGIN
+     TEST ("C39006D", "CHECK THAT IF A FUNCTION IS USED IN A DEFAULT " &
+                      "EXPRESSION FOR A SUBPROGRAM OR FORMAL GENERIC " &
+                      "PARAMETER, PROGRAM_ERROR IS RAISED WHEN AN " &
+                      "ATTEMPT IS MADE TO EVALUATE THE DEFAULT " &
+                      "EXPRESSION");
+     DECLARE
+          FUNCTION FUN RETURN INTEGER;
+
+          PACKAGE P IS
+               PROCEDURE DEFAULT (A : INTEGER := FUN);
+          END P;
+
+          PACKAGE BODY P IS
+               PROCEDURE DEFAULT (A : INTEGER := FUN) IS
+                    B : INTEGER := 1;
+               BEGIN
+                    B := B + IDENT_INT(A);
+               END DEFAULT;
+          BEGIN
+               DEFAULT (2);
+               DEFAULT;
+               FAILED ("PROGRAM_ERROR NOT RAISED - 1");
+          EXCEPTION
+               WHEN PROGRAM_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+          END P;
+
+          FUNCTION FUN RETURN INTEGER IS
+          BEGIN
+               RETURN (IDENT_INT(1));
+          END FUN;
+     BEGIN
+          NULL;
+     END;
+
+     BEGIN
+          DECLARE
+               FUNCTION INIT_1 RETURN INTEGER;
+
+               GENERIC
+                    LENGTH : INTEGER := INIT_1;
+               PACKAGE P IS
+                    TYPE ARRAY1 IS ARRAY (1 .. LENGTH) OF INTEGER;
+               END P;
+
+               PACKAGE NEW_P1 IS NEW P (4);
+               PACKAGE NEW_P2 IS NEW P;
+
+               FUNCTION INIT_1 RETURN INTEGER IS
+               BEGIN
+                    RETURN (IDENT_INT(2));
+               END INIT_1;
+
+          BEGIN
+               FAILED ("PROGRAM_ERROR NOT RAISED - 2");
+          END;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+     END;
+
+     DECLARE
+          FUNCTION INIT_2 RETURN INTEGER;
+
+          GLOBAL_INT : INTEGER := IDENT_INT(1);
+
+          GENERIC
+          PACKAGE Q IS
+               PROCEDURE ADD1 (A : INTEGER := INIT_2);
+          END Q;
+
+          PACKAGE BODY Q IS
+               PROCEDURE ADD1 (A : INTEGER := INIT_2) IS
+                    B : INTEGER;
+               BEGIN
+                    B := A;
+               END ADD1;
+          BEGIN
+               IF GLOBAL_INT = IDENT_INT(1) THEN
+                    ADD1;
+                    FAILED ("PROGRAM_ERROR NOT RAISED - 3");
+               ELSE
+                    ADD1 (2);
+               END IF;
+
+          EXCEPTION
+               WHEN PROGRAM_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+          END Q;
+
+          PACKAGE NEW_Q IS NEW Q;
+
+          FUNCTION INIT_2 RETURN INTEGER IS
+          BEGIN
+               RETURN (IDENT_INT(1));
+          END INIT_2;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C39006D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006e.ada
new file mode 100644
index 000000000..77e527135
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006e.ada
@@ -0,0 +1,213 @@
+-- C39006E.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 PROGRAM_ERROR IS NOT RAISED IF A SUBPROGRAM'S BODY HAS
+-- BEEN ELABORATED BEFORE IT IS CALLED. CHECK THE FOLLOWING:
+--     A) A SUBPROGRAM CAN APPEAR IN A NON-ELABORATED DECLARATIVE PART
+--        OR PACKAGE SPECIFICATION BEFORE ITS BODY.
+
+-- TBN  8/21/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C39006E IS
+
+BEGIN
+     TEST ("C39006E", "CHECK THAT PROGRAM_ERROR IS NOT RAISED IF A " &
+                      "SUBPROGRAM IS CALLED IN A NON-ELABORATED " &
+                      "DECLARATIVE PART OR PACKAGE SPECIFICATION " &
+                      "BEFORE ITS BODY IS ELABORATED");
+     DECLARE -- (A)
+
+          FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER;
+
+          PACKAGE P IS
+               PROCEDURE USE_INIT1;
+          END P;
+
+          PACKAGE BODY P IS
+               PROCEDURE USE_INIT1 IS
+               BEGIN
+                    IF NOT EQUAL (3, 3) THEN
+                         DECLARE
+                              X : INTEGER := INIT_1 (1);
+                         BEGIN
+                              NULL;
+                         END;
+                    ELSE
+                         NULL;
+                    END IF;
+
+               EXCEPTION
+                    WHEN PROGRAM_ERROR =>
+                         FAILED ("PROGRAM_ERROR RAISED - 1");
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+               END USE_INIT1;
+
+          BEGIN
+               USE_INIT1;
+          END P;
+
+          FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER IS
+          BEGIN
+               RETURN (A + IDENT_INT(1));
+          END INIT_1;
+
+     BEGIN -- (A)
+          NULL;
+     END; -- (A)
+
+     DECLARE -- (B)
+
+          PROCEDURE INIT_2 (A : IN OUT INTEGER);
+
+          PACKAGE P IS
+               FUNCTION USE_INIT2 RETURN BOOLEAN;
+          END P;
+
+          PACKAGE BODY P IS
+               FUNCTION USE_INIT2 RETURN BOOLEAN IS
+               BEGIN
+                    IF NOT EQUAL (3, 3) THEN
+                         DECLARE
+                              X : INTEGER;
+                         BEGIN
+                              INIT_2 (X);
+                         END;
+                    END IF;
+                    RETURN IDENT_BOOL (FALSE);
+
+               EXCEPTION
+                    WHEN PROGRAM_ERROR =>
+                         FAILED ("PROGRAM_ERROR RAISED - 2");
+                         RETURN FALSE;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+                         RETURN FALSE;
+               END USE_INIT2;
+          BEGIN
+               IF USE_INIT2 THEN
+                    FAILED ("INCORRECT RESULTS FROM FUNCTION CALL - 2");
+               END IF;
+          END P;
+
+          PROCEDURE INIT_2 (A : IN OUT INTEGER) IS
+          BEGIN
+               A := A + IDENT_INT(1);
+          END INIT_2;
+
+     BEGIN -- (B)
+          NULL;
+     END; -- (B)
+
+     DECLARE -- (C)
+          FUNCTION INIT_3 RETURN INTEGER;
+
+          PACKAGE Q IS
+               VAR : INTEGER;
+          END Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF NOT EQUAL (3, 3) THEN
+                    VAR := INIT_3;
+               END IF;
+          EXCEPTION
+               WHEN PROGRAM_ERROR =>
+                    FAILED ("PROGRAM_ERROR RAISED - 3");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+          END Q;
+
+          FUNCTION INIT_3 RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (1);
+          END INIT_3;
+
+     BEGIN -- (C)
+          NULL;
+     END; -- (C)
+
+     DECLARE -- (D)
+          PROCEDURE INIT_4 (A : IN OUT INTEGER);
+
+          PACKAGE Q IS
+               VAR : INTEGER := 1;
+          END Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF NOT EQUAL (3, 3) THEN
+                    INIT_4 (VAR);
+               END IF;
+          EXCEPTION
+               WHEN PROGRAM_ERROR =>
+                    FAILED ("PROGRAM_ERROR RAISED - 4");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+          END Q;
+
+          PROCEDURE INIT_4 (A : IN OUT INTEGER) IS
+          BEGIN
+               A := IDENT_INT (4);
+          END INIT_4;
+
+     BEGIN -- (D)
+          NULL;
+     END; -- (D)
+
+     BEGIN -- (E)
+
+          DECLARE
+               FUNCTION INIT_5 (A : INTEGER) RETURN INTEGER;
+
+               PROCEDURE USE_INIT5 IS
+                    PACKAGE Q IS
+                         X : INTEGER := INIT_5 (1);
+                    END Q;
+                    USE Q;
+               BEGIN
+                    X := IDENT_INT (5);
+
+               END USE_INIT5;
+
+               FUNCTION INIT_5 (A : INTEGER) RETURN INTEGER IS
+               BEGIN
+                    RETURN (A + IDENT_INT(1));
+               END INIT_5;
+
+          BEGIN
+               USE_INIT5;
+          END;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               FAILED ("PROGRAM_ERROR RAISED - 5");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+
+     END; -- (E)
+
+     RESULT;
+END C39006E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f0.ada
new file mode 100644
index 000000000..58a9b894b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f0.ada
@@ -0,0 +1,44 @@
+-- C39006F0.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 NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
+--     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
+--        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
+--           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
+--           SUBPROGRAM.
+
+--     THIS SUBPROGRAM LIBRARY UNIT IS USED BY C39006F2.ADA.
+
+-- HISTORY:
+--     TBN  08/22/86  CREATED ORIGINAL TEST.
+--     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
+--                    TO 'TEST'.
+
+WITH REPORT; USE REPORT;
+
+FUNCTION C39006F0 (A : INTEGER) RETURN INTEGER IS
+BEGIN
+     RETURN (IDENT_INT(A));
+END C39006F0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f1.ada
new file mode 100644
index 000000000..b90477db8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f1.ada
@@ -0,0 +1,42 @@
+-- C39006F1.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 NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
+--     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
+--        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
+--           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
+--           SUBPROGRAM.
+
+--     THIS LIBRARY PACKAGE SPECIFICATION IS USED BY C39006F3M.ADA.
+
+-- HISTORY:
+--     TBN  08/22/86  CREATED ORIGINAL TEST.
+--     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
+--                    TO 'TEST'.
+--     PWN  05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+PACKAGE C39006F1 IS
+     PROCEDURE REQUIRE_BODY;
+END C39006F1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f2.ada
new file mode 100644
index 000000000..2559b59aa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f2.ada
@@ -0,0 +1,130 @@
+-- C39006F2.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 NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
+--     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
+--        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
+--           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
+--           SUBPROGRAM.
+
+--     THIS LIBRARY PACKAGE BODY IS USED BY C39006F3M.ADA.
+
+-- HISTORY:
+--     TBN  08/22/86  CREATED ORIGINAL TEST.
+--     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
+--                    TO 'TEST'.
+--     PWN  05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+WITH C39006F0;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (C39006F0, REPORT);
+
+PACKAGE BODY C39006F1 IS
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+          NULL;
+     END;
+
+BEGIN
+     TEST ("C39006F", "CHECK THAT NO PROGRAM_ERROR IS RAISED IF A " &
+                      "SUBPROGRAM'S BODY HAS BEEN ELABORATED " &
+                      "BEFORE IT IS CALLED, WHEN A SUBPROGRAM " &
+                      "LIBRARY UNIT IS USED IN ANOTHER UNIT AND " &
+                      "PRAGMA ELABORATE IS USED");
+     BEGIN
+          DECLARE
+               VAR1 : INTEGER := C39006F0 (IDENT_INT(1));
+          BEGIN
+               IF VAR1 /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT RESULTS - 1");
+               END IF;
+          END;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               FAILED ("PROGRAM_ERROR RAISED - 1");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+     END;
+
+     DECLARE
+          VAR2 : INTEGER := 1;
+
+          PROCEDURE CHECK (B : IN OUT INTEGER) IS
+          BEGIN
+               B := C39006F0 (IDENT_INT(2));
+          EXCEPTION
+               WHEN PROGRAM_ERROR =>
+                    FAILED ("PROGRAM_ERROR RAISED - 2");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+          END CHECK;
+     BEGIN
+          CHECK (VAR2);
+          IF VAR2 /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+     END;
+
+     DECLARE
+          PACKAGE P IS
+               VAR3 : INTEGER;
+          END P;
+
+          PACKAGE BODY P IS
+          BEGIN
+               VAR3 := C39006F0 (IDENT_INT(3));
+               IF VAR3 /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT RESULTS - 3");
+               END IF;
+          EXCEPTION
+               WHEN PROGRAM_ERROR =>
+                    FAILED ("PROGRAM_ERROR RAISED - 3");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION - 3");
+          END P;
+     BEGIN
+          NULL;
+     END;
+
+     DECLARE
+          GENERIC
+               VAR4 : INTEGER := 1;
+          PACKAGE Q IS
+               TYPE ARRAY_TYP1 IS ARRAY (1 .. VAR4) OF INTEGER;
+               ARRAY_1 : ARRAY_TYP1;
+          END Q;
+
+          PACKAGE NEW_Q IS NEW Q (C39006F0 (IDENT_INT(4)));
+
+          USE NEW_Q;
+
+     BEGIN
+          IF ARRAY_1'LAST /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+     END;
+
+END C39006F1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f3.ada
new file mode 100644
index 000000000..206a47586
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006f3.ada
@@ -0,0 +1,49 @@
+-- C39006F3M.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 NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
+--     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
+--        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
+--           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
+--           SUBPROGRAM.
+
+-- SEPARATE FILES ARE:
+--      C39006F0     A LIBRARY FUNCTION.
+--      C39006F1     A LIBRARY PACKAGE SPECIFICATION.
+--      C39006F2     A LIBRARY PACKAGE BODY.
+--      C39006F3M    (THIS FILE) THE MAIN PROCEDURE.
+
+-- HISTORY:
+--     TBN  08/22/86  CREATED ORIGINAL TEST.
+--     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
+--                    TO 'TEST'.
+
+WITH C39006F1;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C39006F3M IS
+BEGIN
+     RESULT;
+END C39006F3M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006g.ada
new file mode 100644
index 000000000..48990a442
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39006g.ada
@@ -0,0 +1,71 @@
+-- C39006G.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 PROGRAM_ERROR IS RAISED BY AN ATTEMPT TO CALL A
+--     SUBPROGRAM WHOSE BODY IS NOT YET ELABORATED.  USE A PACKAGE
+--     WITH OPTIONAL BODY, WHERE THE SUBPROGRAM IS CALLED IN THE BODY.
+
+-- HISTORY:
+--     BCB 08/01/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C39006G IS
+
+     PROCEDURE INIT (X : IN OUT INTEGER);
+
+     PACKAGE P IS
+     END P;
+
+     PACKAGE BODY P IS
+          X : INTEGER := IDENT_INT(5);
+     BEGIN
+          TEST ("C39006G", "CHECK THAT PROGRAM_ERROR IS RAISED BY " &
+                           "AN ATTEMPT TO CALL A SUBPROGRAM WHOSE " &
+                           "BODY IS NOT YET ELABORATED.  USE A " &
+                           "PACKAGE WITH OPTIONAL BODY, WHERE THE " &
+                           "SUBPROGRAM IS CALLED IN THE BODY");
+          INIT(X);
+          FAILED ("NO EXCEPTION RAISED");
+          IF X /= IDENT_INT(10) THEN
+               COMMENT ("TOTALLY IRRELEVANT");
+          END IF;
+          RESULT;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               RESULT;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION WAS RAISED");
+               RESULT;
+     END P;
+
+     PROCEDURE INIT (X : IN OUT INTEGER) IS
+     BEGIN
+          X := IDENT_INT(10);
+     END INIT;
+
+BEGIN
+     NULL;
+END C39006G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39007a.ada
new file mode 100644
index 000000000..e25d96ae6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39007a.ada
@@ -0,0 +1,132 @@
+-- C39007A.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 PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO
+-- INSTANTIATE A GENERIC UNIT WHOSE BODY HAS NOT BEEN ELABORATED.
+-- CHECK THE FOLLOWING CASE:
+--     A) A SIMPLE CASE WHERE THE GENERIC UNIT BODY OCCURS LATER IN
+--        THE SAME DECLARATIVE PART.
+
+-- TBN  9/12/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C39007A IS
+
+BEGIN
+     TEST ("C39007A", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " &
+                      "ATTEMPT IS MADE TO INSTANTIATE A GENERIC " &
+                      "UNIT WHOSE BODY HAS NOT BEEN ELABORATED, " &
+                      "BUT OCCURS IN THE SAME DECLARATIVE PART");
+
+     BEGIN
+          IF EQUAL (1, 1) THEN
+               DECLARE
+                    GENERIC
+                    PACKAGE P IS
+                         A : INTEGER;
+                         PROCEDURE ASSIGN (X : OUT INTEGER);
+                    END P;
+
+                    PACKAGE NEW_P IS NEW P;
+
+                    PACKAGE BODY P IS
+                         PROCEDURE ASSIGN (X : OUT INTEGER) IS
+                         BEGIN
+                              X := IDENT_INT (1);
+                         END ASSIGN;
+                    BEGIN
+                         ASSIGN (A);
+                    END P;
+
+               BEGIN
+                    NULL;
+               END;
+               FAILED ("PROGRAM_ERROR WAS NOT RAISED - 1");
+          END IF;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+     END;
+
+------------------------------------------------------------------------
+
+     BEGIN
+          IF EQUAL (2, 2) THEN
+               DECLARE
+                    GENERIC
+                    PROCEDURE ADD1 (X : IN OUT INTEGER);
+
+                    PROCEDURE NEW_ADD1 IS NEW ADD1;
+
+                    PROCEDURE ADD1 (X : IN OUT INTEGER) IS
+                    BEGIN
+                         X := X + IDENT_INT (1);
+                    END ADD1;
+               BEGIN
+                    NULL;
+               END;
+               FAILED ("PROGRAM_ERROR WAS NOT RAISED - 2");
+          END IF;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+     END;
+
+------------------------------------------------------------------------
+
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               DECLARE
+                    GENERIC
+                    FUNCTION INIT RETURN INTEGER;
+
+                    FUNCTION NEW_INIT IS NEW INIT;
+
+                    FUNCTION INIT RETURN INTEGER IS
+                    BEGIN
+                         RETURN (IDENT_INT (1));
+                    END INIT;
+               BEGIN
+                    NULL;
+               END;
+               FAILED ("PROGRAM_ERROR WAS NOT RAISED - 3");
+          END IF;
+
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+     END;
+
+------------------------------------------------------------------------
+
+     RESULT;
+END C39007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39007b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39007b.ada
new file mode 100644
index 000000000..c95c064d2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39007b.ada
@@ -0,0 +1,83 @@
+-- C39007B.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 PROGRAM_ERROR IS RAISED BY AN ATTEMPT TO INSTANTIATE
+--     A GENERIC UNIT WHOSE BODY IS NOT YET ELABORATED.  USE A GENERIC
+--     UNIT THAT IS DECLARED AND INSTANTIATED IN A PACKAGE
+--     SPECIFICATION.
+
+-- HISTORY:
+--     BCB 08/01/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C39007B IS
+
+BEGIN
+     TEST ("C39007B", "CHECK THAT PROGRAM_ERROR IS RAISED BY AN " &
+                      "ATTEMPT TO INSTANTIATE A GENERIC UNIT WHOSE " &
+                      "BODY IS NOT YET ELABORATED.  USE A GENERIC " &
+                      "UNIT THAT IS DECLARED AND INSTANTIATED IN A " &
+                      "PACKAGE SPECIFICATION");
+
+     DECLARE
+     BEGIN
+          DECLARE
+               PACKAGE P IS
+                    GENERIC
+                    FUNCTION F RETURN BOOLEAN;
+
+                    FUNCTION NEW_F IS NEW F;
+               END P;
+
+               PACKAGE BODY P IS
+                    FUNCTION F RETURN BOOLEAN IS
+                    BEGIN
+                         RETURN TRUE;
+                    END F;
+               END P;
+          BEGIN
+               FAILED ("NO EXCEPTION RAISED");
+               DECLARE
+                    X : BOOLEAN := IDENT_BOOL(FALSE);
+               BEGIN
+                    X := P.NEW_F;
+                    IF X /= IDENT_BOOL(TRUE) THEN
+                         COMMENT ("NOT RELEVANT");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED TOO LATE");
+               END;
+          END;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C39007B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39008a.ada
new file mode 100644
index 000000000..4e40dc391
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39008a.ada
@@ -0,0 +1,73 @@
+-- C39008A.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 PROGRAM_ERROR IS RAISED BY AN ATTEMPT TO ACTIVATE
+--     A TASK BEFORE ITS BODY HAS BEEN ELABORATED.  CHECK THE CASE IN
+--     WHICH A TASK VARIABLE IS DECLARED IN A PACKAGE SPECIFICATION AND
+--     THE PACKAGE BODY OCCURS BEFORE THE TASK BODY.
+
+-- HISTORY:
+--     BCB 01/21/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C39008A IS
+
+BEGIN
+     TEST ("C39008A", "CHECK THAT PROGRAM_ERROR IS RAISED BY AN " &
+                      "ATTEMPT TO ACTIVATE A TASK BEFORE ITS BODY " &
+                      "HAS BEEN ELABORATED.  CHECK THE CASE IN WHICH " &
+                      "A TASK VARIABLE IS DECLARED IN A PACKAGE " &
+                      "SPECIFICATION AND THE PACKAGE BODY OCCURS " &
+                      "BEFORE THE TASK BODY");
+
+     BEGIN
+          DECLARE
+               TASK TYPE T;
+
+               PACKAGE P IS
+                    X : T;
+               END P;
+
+               PACKAGE BODY P IS
+               END P;                                  -- PROGRAM_ERROR.
+
+               TASK BODY T IS
+               BEGIN
+                    COMMENT ("TASK MESSAGE");
+               END T;
+          BEGIN
+               FAILED ("PROGRAM_ERROR WAS NOT RAISED");
+          END;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR WAS RAISED");
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN PROGRAM_ERROR WAS " &
+                       "RAISED");
+     END;
+
+     RESULT;
+END C39008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39008b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39008b.ada
new file mode 100644
index 000000000..d148e0ccf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39008b.ada
@@ -0,0 +1,77 @@
+-- C39008B.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 ACTIVATION OF A TASK IS ATTEMPTED BEFORE THE
+-- ELABORATION OF THE CORRESPONDING BODY IS FINISHED, THE EXCEPTION
+-- PROGRAM_ERROR IS RAISED, NOT TASKING_ERROR (SEE AI-00149).
+
+-- WEI  3/04/82
+-- JBG  2/17/84
+-- EG  11/02/84
+-- JBG 5/23/85
+-- JWC 6/28/85   RENAMED FROM C93007B-B.ADA
+
+WITH REPORT;
+ USE REPORT;
+
+PROCEDURE C39008B IS
+
+BEGIN
+
+     TEST ("C39008B", "PROGRAM_ERROR AFTER ATTEMPT OF ACTIVATION " &
+                      "BEFORE ELABORATION");
+BLOCK1:
+     BEGIN
+BLOCK2:
+          DECLARE
+               TASK TYPE TT1;
+
+               TYPE ATT1 IS ACCESS TT1;
+
+               POINTER_TT1 : ATT1 := NEW TT1;  -- ACCESSING TASK BODY
+                                               -- BEFORE ITS ELABORATION
+
+               TASK BODY TT1 IS
+               BEGIN
+                    FAILED ("TT1 ACTIVATED");
+               END TT1;
+
+          BEGIN
+
+               FAILED ("TT1 ACTIVATED - 2");
+
+          END BLOCK2;
+
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED");
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED");
+     END BLOCK1;
+
+     RESULT;
+
+END C39008B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39008c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39008c.ada
new file mode 100644
index 000000000..22d482559
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c39008c.ada
@@ -0,0 +1,97 @@
+-- C39008C.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 PROGRAM_ERROR IS RAISED WHEN AN ATTEMPT IS MADE TO
+--     ACTIVATE A TASK BEFORE ITS BODY HAS BEEN ELABORATED.  CHECK THE
+--     CASE IN WHICH SEVERAL TASKS ARE TO BE ACTIVATED, AND ONLY SOME
+--     HAVE UNELABORATED BODIES; NO TASKS SHOULD BE ACTIVATED.
+
+-- HISTORY:
+--     BCB 07/08/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C39008C IS
+
+BEGIN
+     TEST ("C39008C", "CHECK THAT PROGRAM_ERROR IS RAISED WHEN AN " &
+                      "ATTEMPT IS MADE TO ACTIVATE A TASK BEFORE ITS " &
+                      "BODY HAS BEEN ELABORATED.  CHECK THE CASE IN " &
+                      "WHICH SEVERAL TASKS ARE TO BE ACTIVATED, AND " &
+                      "ONLY SOME HAVE UNELABORATED BODIES; NO TASKS " &
+                      "SHOULD BE ACTIVATED");
+
+     BEGIN
+          DECLARE
+               TASK TYPE A;
+
+               TASK TYPE B;
+
+               TASK TYPE C;
+
+               TASK TYPE D;
+
+               PACKAGE P IS
+                    W : A;
+                    X : B;
+                    Y : C;
+                    Z : D;
+               END P;
+
+               TASK BODY A IS
+               BEGIN
+                    FAILED ("TASK A ACTIVATED");
+               END A;
+
+               TASK BODY D IS
+               BEGIN
+                    FAILED ("TASK D ACTIVATED");
+               END D;
+
+               PACKAGE BODY P IS
+               END P;
+
+               TASK BODY B IS
+               BEGIN
+                    FAILED ("TASK B ACTIVATED");
+               END B;
+
+               TASK BODY C IS
+               BEGIN
+                    FAILED ("TASK C ACTIVATED");
+               END C;
+          BEGIN
+               FAILED ("PROGRAM_ERROR WAS NOT RAISED");
+          END;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN PROGRAM_ERROR WAS " &
+                       "RAISED");
+     END;
+
+     RESULT;
+END C39008C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a010.a
new file mode 100644
index 000000000..18016de09
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a010.a
@@ -0,0 +1,127 @@
+-- C390A010.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:
+--      See C390A011.AM.
+--
+-- TEST DESCRIPTION:
+--      See C390A011.AM.
+-- 
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         F390A00.A
+--      => C390A010.A
+--         C390A011.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with F390A00;  -- Alert system abstraction.
+package C390A010 is
+
+
+   type Low_Alert_Type is new F390A00.Alert_Type with record
+      Level : Integer := 0;                             -- Record extension of
+   end record;                                          -- root tagged type.
+
+   -- Inherits procedure Display from Alert_Type.
+
+   procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
+                                                        -- primitive subprog.
+
+   function Level_Of (LA : in Low_Alert_Type)           -- To be inherited by
+     return Integer;                                    -- all derivatives.
+
+
+
+   -- Declarations required for component Action_Officer;
+
+   type Person_Enum is (Nobody,          Duty_Officer,
+                        Watch_Commander, Commanding_Officer);
+
+
+   type Medium_Alert_Type is new Low_Alert_Type with record
+      Action_Officer : Person_Enum := Nobody;           -- Record extension of
+   end record;                                          -- record extension.
+
+   -- Inherits (inherited) procedure Display from Low_Alert_Type.
+   -- Inherits function Level_Of from Low_Alert_Type.
+
+   procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
+                                                        -- primitive subprog.
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum);
+
+
+end C390A010;
+
+
+     --==================================================================--
+
+
+package body C390A010 is
+
+   use F390A00;  -- Alert system abstraction.
+
+
+   function Level_Of (LA : in Low_Alert_Type) return Integer is
+   begin
+      return (LA.Level + 1);
+   end Level_Of;
+
+
+   procedure Handle (LA : in out Low_Alert_Type) is
+   begin
+      Handle (Alert_Type (LA));          -- Call parent's op (type conversion).
+      LA.Level := Level_Of (LA);         -- Call newly declared operation.
+      LA.Display_On := Teletype;
+      Display (LA);                      -- Call inherited operation.
+   end Handle;
+
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum) is
+   begin
+      MA.Action_Officer := To;
+   end Assign_Officer;
+
+
+   procedure Handle (MA : in out Medium_Alert_Type) is
+   begin
+      Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
+      MA.Level := Level_Of (MA);         -- Call inherited operation.
+      Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
+      MA.Display_On := Console;
+      Display (MA);                      -- Call twice-inherited operation.
+   end Handle;
+
+
+end C390A010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a011.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a011.am
new file mode 100644
index 000000000..b5234e913
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a011.am
@@ -0,0 +1,218 @@
+-- C390A011.AM
+--
+--                             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 nonprivate tagged type declared in a package specification
+--      may be extended with a record extension in a different package
+--      specification, and that this record extension may in turn be extended
+--      by a record extension.
+--
+--      Check that each derivative inherits the user-defined primitive
+--      subprograms of its parent (including those that its parent inherited),
+--      that it may override these inherited primitive subprograms, and that it
+--      may also declare its own primitive subprograms.
+--
+--      Check that predefined equality operators are defined for the tagged
+--      type and its derivatives.
+--
+--      Check that type conversion is defined from a type extension to its
+--      parent, and that this parent itself may be a type extension.
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged type and two associated primitive subprograms
+--      in a package specification (foundation code).
+-- 
+--      Extend the root type with a record extension in a different package
+--      specification. Declare a new primitive subprogram for the extension,
+--      and override one of the two inherited subprograms. Within the
+--      overriding subprogram, utilize type conversion to call the parent's
+--      implementation of the same subprogram. Also within the overriding
+--      subprogram, call the new primitive subprogram and each inherited
+--      subprogram.
+--      
+--      Extend the extension with a record extension in the same package
+--      specification. Declare a new primitive subprogram for this second
+--      extension, and override one of the three inherited subprograms.
+--      Within the overriding subprogram, utilize type conversion to call the
+--      parent's implementation of the same subprogram. Also within the
+--      overriding subprogram, call the new primitive subprogram and each
+--      inherited subprogram.
+-- 
+--      In the main program, declare objects of the root tagged type
+--      and the two type extensions. For each object, call the overriding
+--      subprogram, and verify the correctness of the components by using
+--      aggregates and equality operators, or by checking the components
+--      directly.
+-- 
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         F390A00.A
+--         C390A010.A
+--      => C390A011.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with Report;
+
+with F390A00;   -- Basic alert abstraction.
+with C390A010;  -- Extended alert abstraction.
+
+use  F390A00;   -- Primitive operations of Alert_Type directly visible.
+
+with Ada.Calendar;
+
+procedure C390A011 is
+   use type Ada.Calendar.Time;  -- Equality/inequality ops directly visible.
+begin
+
+   Report.Test ("C390A01", "Primitive operation inheritance by type " &
+                "extensions: all extensions declared in same package, " &
+                "but a different package from that of root type");
+
+
+   ALERT_SUBTEST: -------------------------------------------------------------
+
+      declare
+         Alarm : F390A00.Alert_Type;  -- Root tagged type.
+      begin
+
+         -- Check "/=" operator availability. Aggregate with positional
+         -- associations:
+         if Alarm /= (Default_Time, Null_Device) then
+            Report.Failed ("Wrong initial values for Alert_Type");
+         end if;
+
+         Handle (Alarm);
+
+         -- Check "=" operator availability. Aggregate with named
+         -- associations:
+         if not (Alarm = (Arrival_Time => Alert_Time,
+                          Display_On   => Null_Device))
+         then
+            Report.Failed ("Wrong values for Alert_Type after Handle");
+         end if;
+
+      end Alert_Subtest;
+
+
+   -- Check intermediate display counts:
+
+   if F390A00.Display_Count_For (Null_Device) /= 1 or
+      F390A00.Display_Count_For (Teletype)    /= 0 or
+      F390A00.Display_Count_For (Console)     /= 0 or
+      F390A00.Display_Count_For (Big_Screen)  /= 0
+   then
+      Report.Failed ("Wrong display counts after Alert_Type");
+   end if;
+
+
+   LOW_ALERT_SUBTEST: ---------------------------------------------------------
+
+      declare
+         Low_Alarm : C390A010.Low_Alert_Type;  -- Extension of tagged type.
+         use C390A010; -- Primitive operations of extension directly visible.
+      begin
+
+         -- Check "=" operator availability. Aggregate with positional
+         -- associations:
+         if not (Low_Alarm = (Default_Time, Null_Device, 0)) then
+            Report.Failed ("Wrong initial values for Low_Alert_Type");
+         end if;
+
+         Handle (Low_Alarm);
+
+         -- Check component availability:
+         if Low_Alarm.Arrival_Time /= Alert_Time or
+            Low_Alarm.Display_On   /= Teletype   or
+            Low_Alarm.Level        /= 1
+         then
+            Report.Failed ("Wrong values for Low_Alert_Type after Handle");
+         end if;
+
+      end Low_Alert_Subtest;
+
+
+   -- Check intermediate display counts:
+
+   if F390A00.Display_Count_For /= (Null_Device => 2,
+                                    Teletype    => 1,
+                                    Console     => 0,
+                                    Big_Screen  => 0)
+   then
+      Report.Failed ("Wrong display counts after Low_Alert_Type");
+   end if;
+
+
+   MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
+
+      declare
+         Medium_Alarm : C390A010.Medium_Alert_Type; -- Extension of extension.
+         use C390A010; -- Primitive operations of extension directly visible.
+      begin
+
+         -- Check component availability:
+         if Medium_Alarm.Level          /= 0            or
+            Medium_Alarm.Arrival_Time   /= Default_Time or
+            Medium_Alarm.Action_Officer /= Nobody       or
+            Medium_Alarm.Display_On     /= Null_Device
+         then
+            Report.Failed ("Wrong initial values for Medium_Alert_Type");
+         end if;
+
+         Handle (Medium_Alarm);
+
+         -- Check "/=" operator availability. Aggregate with named
+         -- associations:
+         if Medium_Alarm /= (Arrival_Time   => Alert_Time,
+                             Display_On     => Console,
+                             Level          => 2,
+                             Action_Officer => Duty_Officer)
+         then
+            Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
+         end if;
+
+      end Medium_Alert_Subtest;
+
+
+   -- Check final display counts:
+
+   if F390A00.Display_Count_For /= (Null_Device => 3,
+                                    Teletype    => 2,
+                                    Console     => 1,
+                                    Big_Screen  => 0)
+   then
+      Report.Failed ("Wrong display counts after Medium_Alert_Type");
+   end if;
+
+
+   Report.Result;
+
+end C390A011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a020.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a020.a
new file mode 100644
index 000000000..29cd3ca97
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a020.a
@@ -0,0 +1,90 @@
+-- C390A020.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:
+--      See C390A022.AM.
+--
+-- TEST DESCRIPTION:
+--      See C390A022.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         F390A00.A
+--      => C390A020.A
+--         C390A021.A
+--         C390A022.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with F390A00;  -- Alert system abstraction.
+package C390A020 is
+
+
+   type Low_Alert_Type is new F390A00.Alert_Type with record
+      Level : Integer := 0;                             -- Record extension of
+   end record;                                          -- root tagged type.
+
+   -- Inherits procedure Display from Alert_Type.
+
+   procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
+                                                        -- primitive subprog.
+
+   function Level_Of (LA : in Low_Alert_Type)           -- To be inherited by
+     return Integer;                                    -- all derivatives.
+
+
+end C390A020;
+
+
+     --==================================================================--
+
+
+package body C390A020 is
+
+   use F390A00;  -- Alert system abstraction.
+
+
+   function Level_Of (LA : in Low_Alert_Type) return Integer is
+   begin
+      return (LA.Level + 1);
+   end Level_Of;
+
+
+   procedure Handle (LA : in out Low_Alert_Type) is
+   begin
+      Handle (Alert_Type (LA));   -- Call parent's oper. (type conversion).
+      LA.Level := Level_Of (LA);  -- Call newly declared operation.
+      LA.Display_On := Teletype;
+      Display (LA);               -- Call inherited operation.
+   end Handle;
+
+
+end C390A020;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a021.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a021.a
new file mode 100644
index 000000000..5d099f370
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a021.a
@@ -0,0 +1,133 @@
+-- C390A021.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:
+--      See C390A022.AM.
+--
+-- TEST DESCRIPTION:
+--      See C390A022.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         F390A00.A
+--         C390A020.A
+--      => C390A021.A
+--         C390A022.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with C390A020;  -- Extended alert abstraction.
+package C390A021 is
+
+
+   -- Declarations used by component Action_Officer;
+
+   type Person_Enum is (Nobody,          Duty_Officer,
+                        Watch_Commander, Commanding_Officer);
+
+
+   type Medium_Alert_Type is new C390A020.Low_Alert_Type
+     with private;                                      -- Private extension of
+                                                        -- record extension.
+
+   -- Inherits (inherited) procedure Display from Low_Alert_Type.
+   -- Inherits function Level_Of from Low_Alert_Type.
+
+   procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
+                                                        -- primitive subprog.
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum);
+
+
+   -- The following two functions are needed to verify the values of the
+   -- extension's private components.
+
+   function Initial_Values_Okay (MA : in Medium_Alert_Type)
+     return Boolean;
+
+   function Bad_Final_Values (MA : in Medium_Alert_Type)
+     return Boolean;
+
+
+private
+
+   type Medium_Alert_Type is new C390A020.Low_Alert_Type with record
+      Action_Officer : Person_Enum := Nobody;
+   end record;
+
+end C390A021;
+
+
+     --==================================================================--
+
+
+with F390A00;  -- Basic alert abstraction.
+use  F390A00;
+package body C390A021 is
+
+   use C390A020;  -- Extended alert abstraction.
+
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum) is
+   begin
+      MA.Action_Officer := To;
+   end Assign_Officer;
+
+
+   procedure Handle (MA : in out Medium_Alert_Type) is
+   begin
+      Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
+      MA.Level := Level_Of (MA);         -- Call inherited operation.
+      Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
+      MA.Display_On := Console;
+      Display (MA);                      -- Call twice-inherited operation.
+   end Handle;
+
+
+   function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
+   begin
+      return (MA = (Arrival_Time   => Default_Time,      -- Check "=" operator
+                    Display_On     => Null_Device,       -- availability.
+                    Level          => 0,                 -- Aggregate with
+                    Action_Officer => Nobody));          -- named associations.
+   end Initial_Values_Okay;
+
+
+   function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
+   begin
+      return (MA /= (Alert_Time, Console,                -- Check "/=" operator
+                     2         , Duty_Officer));         -- availability.
+   end Bad_Final_Values;                                 -- Aggregate with
+                                                         -- positional assoc.
+
+end C390A021;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a022.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a022.am
new file mode 100644
index 000000000..3ba273fe5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a022.am
@@ -0,0 +1,179 @@
+-- C390A022.AM
+--
+--                             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 nonprivate tagged type declared in a package specification
+--      may be extended with a record extension in a different package
+--      specification, and that this record extension may in turn be extended
+--      by a private extension in a third package.
+--  
+--      Check that each derivative inherits the user-defined primitive
+--      subprograms of its parent (including those that its parent inherited),
+--      that it may override these inherited primitive subprograms, and that it
+--      may also declare its own primitive subprograms.
+--
+--      Check that predefined equality operators are defined for the tagged
+--      type and its derivatives.
+--
+--      Check that type conversion is defined from a type extension to its
+--      parent, and that this parent itself may be a type extension.
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged type and two associated primitive subprograms
+--      in a package specification (foundation code).
+-- 
+--      Extend the root type with a record extension in a different package
+--      specification. Declare a new primitive subprogram for the extension,
+--      and override one of the two inherited subprograms. Within the
+--      overriding subprogram, utilize type conversion to call the parent's
+--      implementation of the same subprogram. Also within the overriding
+--      subprogram, call the new primitive subprogram and each inherited
+--      subprogram.
+--      
+--      Extend the extension with a private extension in a third package
+--      specification. Declare a new primitive subprogram for this private
+--      extension, and override one of the three inherited subprograms.
+--      Within the overriding subprogram, utilize type conversion to call the
+--      parent's implementation of the same subprogram. Also within the
+--      overriding subprogram, call the new primitive subprogram and each
+--      inherited subprogram.
+-- 
+--      Also in the third package, declare two operations of the private
+--      extension which utilize aggregates and equality operators to verify
+--      the correctness of the components.
+--
+--      In the main program, declare objects of the two extended types.
+--      For each object, call the overriding subprogram, and verify the
+--      correctness of the components by using aggregates and equality
+--      operators, or by checking the components directly, or, for the private
+--      extension, by calling the verification operations declared in the
+--      third package.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         F390A00.A
+--         C390A020.A
+--         C390A021.A
+--      => C390A022.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with Report;
+
+with F390A00;   -- Basic alert abstraction.
+with C390A020;  -- Extended alert abstraction.
+with C390A021;  -- Further extended alert abstraction.
+
+use  F390A00;   -- Primitive operations of Alert_Type directly visible.
+
+with Ada.Calendar;
+
+procedure C390A022 is
+   use type Ada.Calendar.Time;  -- Equality/inequality ops directly visible.
+begin
+
+   Report.Test ("C390A02", "Primitive operation inheritance by type " &
+                "extensions: all extensions declared in different " &
+                "packages; second extension is private");
+
+
+   -- The case for type F390A00.Alert_Type is tested in C390A01.
+   -- That subtest is not repeated here.
+
+
+   LOW_ALERT_SUBTEST: ---------------------------------------------------------
+
+      declare
+         Low_Alarm : C390A020.Low_Alert_Type;  -- Extension of tagged type.
+         use C390A020; -- Primitive operations of extension directly visible.
+      begin
+
+         -- Check "=" operator availability. Aggregate with positional
+         -- associations:
+         if not (Low_Alarm = (Default_Time, Null_Device, 0)) then
+            Report.Failed ("Wrong initial values for Low_Alert_Type");
+         end if;
+
+         Handle (Low_Alarm);
+
+         -- Check component availability:
+         if Low_Alarm.Arrival_Time /= Alert_Time or
+            Low_Alarm.Display_On   /= Teletype   or
+            Low_Alarm.Level        /= 1
+         then
+            Report.Failed ("Wrong values for Low_Alert_Type after Handle");
+         end if;
+      end Low_Alert_Subtest;
+
+
+   -- Check intermediate display counts:
+
+   if F390A00.Display_Count_For /= (Null_Device => 1,
+                                    Teletype    => 1,
+                                    Console     => 0,
+                                    Big_Screen  => 0)
+   then
+      Report.Failed ("Wrong display counts after Low_Alert_Type");
+   end if;
+
+
+   MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
+
+      declare
+         Medium_Alarm : C390A021.Medium_Alert_Type; -- Priv. ext. of extension.
+         use C390A021; -- Primitive operations of extension directly visible.
+      begin
+         if not C390A021.Initial_Values_Okay (Medium_Alarm) then
+            Report.Failed ("Wrong initial values for Medium_Alert_Type");
+         end if;
+
+         Handle (Medium_Alarm);
+
+         if C390A021.Bad_Final_Values (Medium_Alarm) then
+            Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
+         end if;
+      end Medium_Alert_Subtest;
+
+
+   -- Check final display counts:
+
+   if F390A00.Display_Count_For /= (Null_Device => 2,
+                                    Teletype    => 2,
+                                    Console     => 1,
+                                    Big_Screen  => 0)
+   then
+      Report.Failed ("Wrong display counts after Medium_Alert_Type");
+   end if;
+
+
+   Report.Result;
+
+end C390A022;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a030.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a030.a
new file mode 100644
index 000000000..51554a49a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a030.a
@@ -0,0 +1,188 @@
+-- C390A030.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:
+--      See C390A031.AM.
+--
+-- TEST DESCRIPTION:
+--      See C390A031.AM.
+-- 
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         F390A00.A
+--      => C390A030.A
+--         C390A031.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with F390A00;  -- Alert system abstraction.
+package C390A030 is
+
+
+   type Low_Alert_Type is new F390A00.Alert_Type        -- Private extension of
+     with private;                                      -- root tagged type.
+
+   -- Inherits procedure Display from Alert_Type.
+
+   procedure Handle (LA : in out Low_Alert_Type);       -- Override parent's
+                                                        -- primitive subprog.
+
+   function Level_Of (LA : in Low_Alert_Type)           -- To be inherited by
+     return Integer;                                    -- all derivatives.
+
+
+   -- The following two functions are needed to verify the values of the
+   -- extension's private components.
+
+   function Initial_Values_Okay (LA : in Low_Alert_Type)
+     return Boolean;
+
+   function Bad_Final_Values (LA : in Low_Alert_Type)
+     return Boolean;
+
+
+   -- Declarations used by private extension component.
+
+   type Person_Enum is (Nobody,          Duty_Officer,
+                        Watch_Commander, Commanding_Officer);
+
+
+   type Medium_Alert_Type is new Low_Alert_Type         -- Private extension of
+     with private;                                      -- private extension.
+
+   -- Inherits (inherited) procedure Display from Low_Alert_Type.
+   -- Inherits function Level_Of from Low_Alert_Type.
+
+   procedure Handle (MA : in out Medium_Alert_Type);    -- Override parent's
+                                                        -- primitive subprog.
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum);
+
+
+   -- The following two functions are needed to verify the values of the
+   -- extension's private components.
+
+   function Initial_Values_Okay (MA : in Medium_Alert_Type)
+     return Boolean;                                    -- Override parent's
+                                                        -- operation.
+
+   function Bad_Final_Values (MA : in Medium_Alert_Type)
+     return Boolean;                                    -- Override parent's
+                                                        -- operation.
+
+private
+
+   type Low_Alert_Type is new F390A00.Alert_Type with record
+      Level : Integer := 0;
+   end record;
+
+
+   type Medium_Alert_Type is new Low_Alert_Type with record
+      Action_Officer : Person_Enum := Nobody;
+   end record;
+
+end C390A030;
+
+
+     --==================================================================--
+
+
+package body C390A030 is
+
+   use F390A00;  -- Alert system abstraction.
+
+
+   function Level_Of (LA : in Low_Alert_Type) return Integer is
+   begin
+      return (LA.Level + 1);
+   end Level_Of;
+
+
+   procedure Handle (LA : in out Low_Alert_Type) is
+   begin
+      Handle (Alert_Type (LA));   -- Call parent's operation (type conversion).
+      LA.Level := Level_Of (LA);  -- Call newly declared operation.
+      LA.Display_On := Teletype;
+      Display (LA);               -- Call inherited operation.
+   end Handle;
+
+
+   function Initial_Values_Okay (LA : in Low_Alert_Type) return Boolean is
+   begin
+      return (LA = (Arrival_Time   => Default_Time,      -- Check "=" operator
+                    Display_On     => Null_Device,       -- availability.
+                    Level          => 0));               -- Aggregate with
+   end Initial_Values_Okay;                              -- named associations.
+
+
+   function Bad_Final_Values (LA : in Low_Alert_Type) return Boolean is
+   begin
+      return (LA /= (Alert_Time, Teletype, 1));          -- Check "/=" operator
+                                                         -- availability.
+   end Bad_Final_Values;                                 -- Aggregate with
+                                                         -- positional assoc.
+
+   procedure Assign_Officer (MA : in out Medium_Alert_Type;
+                             To : in     Person_Enum) is
+   begin
+      MA.Action_Officer := To;
+   end Assign_Officer;
+
+
+   procedure Handle (MA : in out Medium_Alert_Type) is
+   begin
+      Handle (Low_Alert_Type (MA));      -- Call parent's op (type conversion).
+      MA.Level := Level_Of (MA);         -- Call inherited operation.
+      Assign_Officer (MA, Duty_Officer); -- Call newly declared operation.
+      MA.Display_On := Console;
+      Display (MA);                      -- Call twice-inherited operation.
+   end Handle;
+
+
+   function Initial_Values_Okay (MA : in Medium_Alert_Type) return Boolean is
+   begin
+      -- Call parent's operation (type conversion).
+      return (Initial_Values_Okay (Low_Alert_Type (MA)) and
+              MA.Action_Officer = Nobody);
+   end Initial_Values_Okay;
+
+
+   function Bad_Final_Values (MA : in Medium_Alert_Type) return Boolean is
+   begin
+      return not (MA = (Arrival_Time   => Alert_Time,    -- Check "=" operator
+                        Display_On     => Console,       -- availability.
+                        Level          => 2,             -- Aggregate with
+                        Action_Officer => Duty_Officer));-- named associations.
+   end Bad_Final_Values;
+
+
+end C390A030;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a031.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a031.am
new file mode 100644
index 000000000..7f380c61d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c390a031.am
@@ -0,0 +1,167 @@
+-- C390A031.AM
+--
+--                             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 nonprivate tagged type declared in a package specification
+--      may be extended with a private extension in a different package
+--      specification, and that this private extension may in turn be extended
+--      by a private extension.
+--
+--      Check that each derivative inherits the user-defined primitive
+--      subprograms of its parent (including those that its parent inherited),
+--      that it may override these inherited primitive subprograms, and that it
+--      may also declare its own primitive subprograms.
+--
+--      Check that predefined equality operators are defined for the tagged
+--      type and its derivatives.
+--
+--      Check that type conversion is defined from a type extension to its
+--      parent, and that this parent itself may be a type extension.
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged type and two associated primitive subprograms
+--      in a package specification (foundation code).
+-- 
+--      Extend the root type with a private extension in a different package
+--      specification. Declare a new primitive subprogram for the extension,
+--      and override one of the two inherited subprograms. Within the
+--      overriding subprogram, utilize type conversion to call the parent's
+--      implementation of the same subprogram. Also within the overriding
+--      subprogram, call the new primitive subprogram and each inherited
+--      subprogram. Declare operations of the private extension which utilize
+--      aggregates and equality operators to verify the correctness of the
+--      components.
+--      
+--      Extend the extension with a private extension in the same package
+--      specification. Declare a new primitive subprogram for this second
+--      extension, and override one of the three inherited subprograms.
+--      Within the overriding subprogram, utilize type conversion to call the
+--      parent's implementation of the same subprogram. Also within the
+--      overriding subprogram, call the new primitive subprogram and each
+--      inherited subprogram. Declare operations of the private extension
+--      which override the verification operations of its parent. Within
+--      these overriding operations, utilize type conversion to call the
+--      parent's implementations of the same operations.
+-- 
+--      In the main program, declare objects of the two extended types.
+--      For each object, call the overriding subprogram, and verify the
+--      correctness of the components by calling the verification operations
+--      declared in the second package.
+-- 
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         F390A00.A
+--         C390A030.A
+--      => C390A031.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with Report;
+
+with F390A00;  -- Basic alert abstraction.
+with C390A030; -- Extended alert abstraction.
+
+use  F390A00;  -- Primitive operations of Alert_Type directly visible.
+
+procedure C390A031 is
+begin
+
+   Report.Test ("C390A03", "Primitive operation inheritance by type " &
+                "extensions: all extensions are private and declared " &
+                "in same package, but a different package from that " &
+                "of root type");
+
+
+   -- The case for type F390A00.Alert_Type is tested in C390A01.
+   -- That subtest is not repeated here.
+
+
+   LOW_ALERT_SUBTEST: ---------------------------------------------------------
+
+      declare
+         Low_Alarm : C390A030.Low_Alert_Type;  -- Priv. ext. of tagged type.
+         use C390A030; -- Primitive operations of extension directly visible.
+      begin
+         if not C390A030.Initial_Values_Okay (Low_Alarm) then
+            Report.Failed ("Wrong initial values for Low_Alert_Type");
+         end if;
+
+         Handle (Low_Alarm);
+
+         if C390A030.Bad_Final_Values (Low_Alarm) then
+            Report.Failed ("Wrong values for Low_Alert_Type after Handle");
+         end if;
+      end Low_Alert_Subtest;
+
+
+   -- Check intermediate display counts:
+
+   if F390A00.Display_Count_For /= (Null_Device => 1,
+                                    Teletype    => 1,
+                                    Console     => 0,
+                                    Big_Screen  => 0)
+   then
+      Report.Failed ("Wrong display counts after Low_Alert");
+   end if;
+
+
+   MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
+
+      declare
+         Medium_Alarm : C390A030.Medium_Alert_Type; -- Priv. ext. of extension.
+         use C390A030; -- Primitive operations of extension directly visible.
+      begin
+         if not C390A030.Initial_Values_Okay (Medium_Alarm) then
+            Report.Failed ("Wrong initial values for Medium_Alert_Type");
+         end if;
+
+         Handle (Medium_Alarm);
+
+         if C390A030.Bad_Final_Values (Medium_Alarm) then
+            Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
+         end if;
+      end Medium_Alert_Subtest;
+
+
+   -- Check final display counts:
+
+   if F390A00.Display_Count_For /= (Null_Device => 2,
+                                    Teletype    => 2,
+                                    Console     => 1,
+                                    Big_Screen  => 0)
+   then
+      Report.Failed ("Wrong display counts after Medium_Alert_Type");
+   end if;
+
+
+   Report.Result;
+
+end C390A031;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c391001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c391001.a
new file mode 100644
index 000000000..bca752576
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c391001.a
@@ -0,0 +1,329 @@
+-- C391001.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 structures nesting discriminated records as
+--      components in record extension are correctly supported.  Check
+--      for this using limited private structures.
+--      Check that record extensions inherit all the visible components
+--      of their ancestor types. 
+--      Check that discriminants are correctly inherited.
+--
+-- TEST DESCRIPTION:
+--      This test defines a textbook object, a serial number plaque.
+--      This object is used in each of several other structures modeled
+--      after those used in an existing antenna modeling software system.
+--      Record types discriminated and undiscriminated are nested to
+--      produce a layered design.  Some parametrization is programmatic;
+--      some parametrization is data-driven.
+--
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--      19 Apr 95   SAIC    Added "limited" to full type def of "Object"
+--
+--!
+ 
+ package C391001_1 is 
+   type Object is tagged limited private;
+   -- Constructor operation
+   procedure Create( The_Plaque : in out Object );
+   -- Selector operations
+   function "="( Left_Plaque,Right_Plaque : Object ) return Boolean;
+   function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
+     return Boolean;
+   function Serial_Number( A_Plaque : Object ) return Natural;
+   Unserialized : exception;  -- Serial_Number called before Create
+   Reserialized : exception;  -- Create called twice
+ private
+   type Object is tagged limited record
+     Serial_Number : Natural := 0;
+   end record;
+ end C391001_1;
+ 
+ package body C391001_1 is
+   Counter : Natural := 0;
+   procedure Create( The_Plaque : in out Object ) is
+   begin
+     if The_Plaque.Serial_Number = 0 then
+       Counter := Counter +1;
+       The_Plaque.Serial_Number := Counter;
+     else
+       raise Reserialized;
+     end if;
+   end Create;
+ 
+   function "="( Left_Plaque,Right_Plaque : Object ) return Boolean is
+   begin
+     return (Left_Plaque.Serial_Number = Right_Plaque.Serial_Number)
+            and then -- two uninitialized plates are unequal
+              (Left_Plaque.Serial_Number /= 0);
+   end "=";
+ 
+   function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
+     return Boolean is
+   begin
+     return (Left_Plaque.Serial_Number = Right_Natural);
+   end TC_Match;
+ 
+   function Serial_Number( A_Plaque : Object ) return Natural is
+   begin
+     if A_Plaque.Serial_Number = 0 then
+       raise Unserialized;
+     end if;
+     return A_Plaque.Serial_Number;
+   end Serial_Number;
+ end C391001_1;
+ 
+ with C391001_1;
+ package C391001_2 is -- package Boards is
+ 
+   package Plaque renames C391001_1;
+ 
+   type Modes is (Receiving, Transmitting, Standby);
+   type Link(Mode: Modes := Standby) is record
+     case Mode is
+       when Receiving    => TC_R : Integer := 100; 
+       when Transmitting => TC_T : Integer := 200;
+       when Standby      => TC_S : Integer := 300; -- TGA, TSA, SSA
+     end case;
+   end record;
+ 
+   type Data_Formats is (S_Band, KU_Band, UHF);
+ 
+ 
+   type Transceiver(Band: Data_Formats) is tagged limited record
+     ID : Plaque.Object;
+     The_Link: Link;
+     case Band is
+       when S_Band  => TC_S_Band_Data  : Integer := 1; -- TGA, SSA
+       when KU_Band => TC_KU_Band_Data : Integer := 2; -- TSA
+       when UHF     => TC_UHF_Data     : Integer := 3;
+     end case;
+   end record;
+ end C391001_2;
+ 
+ with C391001_1;
+ with C391001_2;
+ package C391001_3 is -- package Modules
+   package Plaque renames C391001_1;
+   package Boards renames C391001_2;
+   use type Boards.Modes;
+   use type Boards.Data_Formats;
+ 
+   type Command_Formats is ( Set_Compression_Code,
+                             Set_Data_Rate,
+                             Set_Power_State );
+ 
+   type Electronics_Module(EBand             : Boards.Data_Formats;
+                           The_Command_Format: Command_Formats)
+     is new Boards.Transceiver(EBand) with record
+       case The_Command_Format is
+         when Set_Compression_Code => TC_SCC : Integer := 10; -- SSA
+         when Set_Data_Rate        => TC_SDR : Integer := 20; -- TGA
+         when Set_Power_State      => TC_SPS : Integer := 30; -- TSA
+       end case;
+     end record;
+ end C391001_3;
+ 
+ with Report;
+ with C391001_1;
+ with C391001_2;
+ with C391001_3;
+ procedure C391001 is
+   package Plaque  renames C391001_1;
+   package Boards  renames C391001_2;
+   package Modules renames C391001_3;
+   use type Boards.Modes;
+   use type Boards.Data_Formats;
+   use type Modules.Command_Formats;
+ 
+   type Azimuth is range 0..359;
+ 
+   type Ground_Antenna(The_Band          : Boards.Data_Formats;
+                       The_Command_Format: Modules.Command_Formats) is
+     record
+       ID          : Plaque.Object;
+       Electronics : Modules.Electronics_Module(The_Band,The_Command_Format);
+       Pointing    : Azimuth;
+     end record;
+ 
+   type Space_Antenna(The_Band    : Boards.Data_Formats := Boards.KU_Band;
+                      The_Command : Modules.Command_Formats
+                                    := Modules.Set_Power_State)
+   is
+     record
+       ID          : Plaque.Object;
+       Electronics : Modules.Electronics_Module(The_Band,The_Command);
+     end record;
+ 
+   The_Ground_Antenna     : Ground_Antenna (Boards.S_Band,
+                                            Modules.Set_Data_Rate);
+   The_Space_Antenna      : Space_Antenna;
+   Space_Station_Antenna  : Space_Antenna  (Boards.S_Band,
+                                            Modules.Set_Compression_Code);
+ 
+ 
+   procedure Validate( Condition : Boolean; Message: String ) is
+   begin
+     if not Condition then
+       Report.Failed("Failed " & Message );
+     end if;
+   end Validate;
+ 
+ begin
+   Report.Test("C391001", "Check nested tagged discriminated "
+                        & "record structures");
+ 
+   Plaque.Create( The_Ground_Antenna.ID );               -- 1
+   Plaque.Create( The_Ground_Antenna.Electronics.ID );   -- 2
+   Plaque.Create( The_Space_Antenna.ID );                -- 3
+   Plaque.Create( The_Space_Antenna.Electronics.ID );    -- 4
+   Plaque.Create( Space_Station_Antenna.ID );            -- 5
+   Plaque.Create( Space_Station_Antenna.Electronics.ID );-- 6
+ 
+   The_Ground_Antenna.Pointing := 180;
+   Validate( The_Ground_Antenna.The_Band = Boards.S_Band, "TGA discr 1" );
+   Validate( The_Ground_Antenna.The_Command_Format = Modules.Set_Data_Rate,
+             "TGA discr 2" );
+   Validate( Plaque.TC_Match(The_Ground_Antenna.ID,1), "TGA comp 1" );
+   Validate( The_Ground_Antenna.Electronics.EBand = Boards.S_Band,
+             "TGA comp 2.discr 1" );
+   Validate( The_Ground_Antenna.Electronics.The_Command_Format
+             = Modules.Set_Data_Rate, "TGA comp 2.discr 2" );
+   Validate( The_Ground_Antenna.Electronics.TC_SDR = 20,
+             "TGA comp 2.1" );
+   Validate( Plaque.TC_Match( The_Ground_Antenna.Electronics.ID, 2 ),
+             "TGA comp 2.inher.1" );
+   Validate( The_Ground_Antenna.Electronics.The_Link.Mode = Boards.Standby,
+             "TGA comp 2.inher.2.discr" );
+   Validate( The_Ground_Antenna.Electronics.The_Link.TC_S = 300,
+             "TGA comp 2.inher.2.1" );
+   Validate( The_Ground_Antenna.Electronics.TC_S_Band_Data = 1,
+             "TGA comp 2.inher.3" );
+   Validate( The_Ground_Antenna.Pointing = 180, "TGA comp 3" );
+ 
+   Validate( The_Space_Antenna.The_Band = Boards.KU_Band, "TSA discr 1");
+   Validate( The_Space_Antenna.The_Command = Modules.Set_Power_State,
+             "TSA discr 2");
+   Validate( Plaque.TC_Match(The_Space_Antenna.ID,3),
+             "TSA comp 1");
+   Validate( The_Space_Antenna.Electronics.EBand = Boards.KU_Band,
+             "TSA comp 2.discr 1");
+   Validate( The_Space_Antenna.Electronics.The_Command_Format
+             = Modules.Set_Power_State,  "TSA comp 2.discr 2");
+   Validate( Plaque.TC_Match(The_Space_Antenna.Electronics.ID,4),
+             "TSA comp 2.inher.1");
+   Validate( The_Space_Antenna.Electronics.The_Link.Mode = Boards.Standby,
+             "TSA comp 2.inher.2.discr");
+   Validate( The_Space_Antenna.Electronics.The_Link.TC_S = 300,
+             "TSA comp 2.inher.2.1");
+   Validate( The_Space_Antenna.Electronics.TC_KU_Band_Data = 2,
+             "TSA comp 2.inher.3");
+   Validate( The_Space_Antenna.Electronics.TC_SPS = 30,
+             "TSA comp 2.1");
+ 
+   Validate( Space_Station_Antenna.The_Band = Boards.S_Band, "SSA discr 1");
+   Validate( Space_Station_Antenna.The_Command = Modules.Set_Compression_Code,
+             "SSA discr 2");
+   Validate( Plaque.TC_Match(Space_Station_Antenna.ID,5),
+             "SSA comp 1");
+   Validate( Space_Station_Antenna.Electronics.EBand = Boards.S_Band,
+             "SSA comp 2.discr 1");
+   Validate( Space_Station_Antenna.Electronics.The_Command_Format
+             = Modules.Set_Compression_Code,  "SSA comp 2.discr 2");
+   Validate( Plaque.TC_Match(Space_Station_Antenna.Electronics.ID,6),
+             "SSA comp 2.inher.1");
+   Validate( Space_Station_Antenna.Electronics.The_Link.Mode = Boards.Standby,
+             "SSA comp 2.inher.2.discr");
+   Validate( Space_Station_Antenna.Electronics.The_Link.TC_S = 300,
+             "SSA comp 2.inher.2.1");
+   Validate( Space_Station_Antenna.Electronics.TC_S_Band_Data = 1,
+             "SSA comp 2.inher.3");
+   Validate( Space_Station_Antenna.Electronics.TC_SCC = 10,
+             "SSA comp 2.1");
+ 
+   The_Ground_Antenna.Electronics.TC_SDR         := 1001;
+   The_Ground_Antenna.Electronics.The_Link       :=
+(Boards.Transmitting,2001);
+   The_Ground_Antenna.Electronics.TC_S_Band_Data := 3001;
+   The_Ground_Antenna.Pointing                   :=   41;
+ 
+   The_Space_Antenna.Electronics.The_Link        := (Boards.Receiving,1010);
+   The_Space_Antenna.Electronics.TC_KU_Band_Data := 2020;
+   The_Space_Antenna.Electronics.TC_SPS          := 3030;
+ 
+   Space_Station_Antenna.Electronics.The_Link
+     := The_Space_Antenna.Electronics.The_Link;
+   Space_Station_Antenna.Electronics.The_Link.TC_R  := 111;
+   Space_Station_Antenna.Electronics.TC_S_Band_Data := 222;
+   Space_Station_Antenna.Electronics.TC_SCC         := 333;
+ 
+ ----------------------------------------------------------------------
+   begin -- should fail discriminant check
+     The_Ground_Antenna.Electronics.TC_SCC := 909;
+     Report.Failed("Discriminant check, no exception");
+   exception
+     when Constraint_Error => null;
+     when others =>
+          Report.Failed("Discriminant check, wrong exception");
+   end;
+ 
+   Validate( The_Ground_Antenna.Electronics.TC_SDR         = 1001,
+             "assigned value 1");
+   Validate( The_Ground_Antenna.Electronics.The_Link.Mode
+                                            = Boards.Transmitting,
+             "assigned value 2.1");
+   Validate( The_Ground_Antenna.Electronics.The_Link.TC_T  = 2001,
+             "assigned value 2.2");
+   Validate( The_Ground_Antenna.Electronics.TC_S_Band_Data = 3001,
+             "assigned value 3");
+   Validate( The_Ground_Antenna.Pointing                   =   41,
+             "assigned value 4");
+ 
+   Validate( The_Space_Antenna.Electronics.The_Link.Mode   = Boards.Receiving,
+             "assigned value 5.1");
+   Validate( The_Space_Antenna.Electronics.The_Link.TC_R   = 1010,
+             "assigned value 5.2");
+   Validate( The_Space_Antenna.Electronics.TC_KU_Band_Data = 2020,
+             "assigned value 6");
+   Validate( The_Space_Antenna.Electronics.TC_SPS          = 3030,
+             "assigned value 7");
+ 
+   Validate( Space_Station_Antenna.Electronics.The_Link.Mode
+                                                 = Boards.Receiving,
+             "assigned value 8.1");
+   Validate( Space_Station_Antenna.Electronics.The_Link.TC_R  = 111,
+             "assigned value 8.2");
+   Validate( Space_Station_Antenna.Electronics.TC_S_Band_Data = 222,
+             "assigned value 9");
+   Validate( Space_Station_Antenna.Electronics.TC_SCC         = 333,
+             "assigned value 10");
+ 
+   Report.Result;
+ 
+end C391001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c391002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c391002.a
new file mode 100644
index 000000000..77fbfb328
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c391002.a
@@ -0,0 +1,493 @@
+-- C391002.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 structures nesting discriminated records as
+--      components in record extension are correctly supported.
+--      Check that record extensions inherit all the visible components
+--      of their ancestor types.
+--      Check that discriminants are correctly inherited.
+--
+-- TEST DESCRIPTION:
+--      This test defines a simple class hierarchy, where the final
+--      derivations exercise the different possible "permissions" available
+--      to a designer.  Extension aggregates for discriminated types are used
+--      to set values of these final types.  The key difference between
+--      this test and C391001 is that the types are visible, and allow the
+--      creation of complex discriminated extension aggregates.  Another
+--      layer of derivation is present to more robustly check that the
+--      inheritance is correctly supported.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      16 Dec 94   SAIC    Removed offending parenthesis in aggregate
+--                          extensions, corrected typo: TC_MC SB TC_PC,
+--                          corrected visibility errors for literals,
+--                          added qualification for aggregate expressions
+--                          used in extension aggregates, corrected parameter
+--                          order in call to Communications.Creator
+--     01 MAY 95    SAIC    Removed "limited" from the definition of Mil_Comm
+--     14 OCT 95    SAIC    Fixed some value bugs for ACVC 2.0.1
+--     04 MAR 96    SAIC    Altered 3 overambitious extension aggregates
+--     11 APR 96    SAIC    Updated documentation for 2.1
+--     27 FEB 97    PWB.CTA Deleted extra (illegal) component association
+--!
+
+----------------------------------------------------------------- C391002_1
+
+package C391002_1 is 
+
+  type Object is tagged private;  
+
+  -- Constructor operation
+  procedure Create( The_Plaque : in out Object );
+
+  -- Selector operations
+  function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
+    return Boolean;
+
+  function Serial_Number( A_Plaque : Object ) return Natural;
+
+  Unserialized : exception;  -- Serial_Number called before Create
+  Reserialized : exception;  -- Create called twice
+
+private
+  type Object is tagged record
+    Serial_Number : Natural := 0;
+  end record;
+end C391002_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body C391002_1 is
+
+  Counter : Natural := 0;
+
+  procedure Create( The_Plaque : in out Object ) is
+  begin
+    if The_Plaque.Serial_Number = 0 then
+      Counter := Counter +1;
+      The_Plaque.Serial_Number := Counter;
+    else
+      raise Reserialized;
+    end if;
+  end Create;
+
+  function TC_Match( Left_Plaque : Object; Right_Natural : Natural )
+    return Boolean is
+  begin
+    return (Left_Plaque.Serial_Number = Right_Natural);
+  end TC_Match;
+
+  function Serial_Number( A_Plaque : Object ) return Natural is
+  begin
+    if A_Plaque.Serial_Number = 0 then
+      raise Unserialized;
+    end if;
+    return A_Plaque.Serial_Number;
+  end Serial_Number;
+end C391002_1;
+
+----------------------------------------------------------------- C391002_2
+
+with C391002_1;
+package C391002_2 is -- package Boards is
+
+  package Plaque renames C391002_1;
+
+  type Modes is (Receiving, Transmitting, Standby);
+  type Link(Mode: Modes := Standby) is record
+    case Mode is
+      when Receiving    => TC_R : Integer := 100; 
+      when Transmitting => TC_T : Integer := 200;
+      when Standby      => TC_S : Integer := 300; -- TGA, TSA, SSA
+    end case;
+  end record;
+
+  type Data_Formats is (S_Band, KU_Band, UHF);
+
+  type Transceiver(Band: Data_Formats) is tagged record
+    ID : Plaque.Object;
+    The_Link: Link;
+    case Band is
+      when S_Band  => TC_S_Band_Data  : Integer := 1; -- TGA, SSA, Milnet
+      when KU_Band => TC_KU_Band_Data : Integer := 2; -- TSA, Usenet
+      when UHF     => TC_UHF_Data     : Integer := 3; -- Gossip
+    end case;
+  end record;
+end C391002_2;
+
+----------------------------------------------------------------- C391002_3
+
+with C391002_1;
+with C391002_2;
+package C391002_3 is -- package Modules
+
+  package Plaque renames C391002_1;
+  package Boards renames C391002_2;
+  use type Boards.Modes;
+  use type Boards.Data_Formats;
+
+  type Command_Formats is ( Set_Compression_Code,
+                            Set_Data_Rate,
+                            Set_Power_State );
+
+  type Electronics_Module(EBand       : Boards.Data_Formats;
+                          The_Command : Command_Formats)
+    is new Boards.Transceiver(EBand) with record
+      case The_Command is
+        when Set_Compression_Code => TC_SCC : Integer := 10; -- SSA, Gossip
+        when Set_Data_Rate        => TC_SDR : Integer := 20; -- TGA, Usenet
+        when Set_Power_State      => TC_SPS : Integer := 30; -- TSA, Milnet
+      end case;
+    end record;
+end C391002_3;
+
+----------------------------------------------------------------- C391002_4
+
+with C391002_3;
+package C391002_4 is -- Communications
+  package Modules renames C391002_3;
+
+  type Public_Comm is new Modules.Electronics_Module with
+    record
+      TC_VC : Integer;
+    end record;
+
+  type Private_Comm is new Modules.Electronics_Module with private;
+
+  type Mil_Comm is new Modules.Electronics_Module with private;
+
+  procedure Creator( Plugs : in Modules.Electronics_Module;
+                     Gives : out Mil_Comm);
+
+  function  Creator( Key : Integer; Plugs : in Modules.Electronics_Module )
+            return Private_Comm;
+
+  procedure Setup( It : in out Public_Comm;  Value : in Integer );
+  procedure Setup( It : in out Private_Comm; Value : in Integer );
+  procedure Setup( It : in out Mil_Comm;     Value : in Integer );
+
+  function  Selector( It : Public_Comm )  return Integer;
+  function  Selector( It : Private_Comm ) return Integer;
+  function  Selector( It : Mil_Comm )     return Integer;
+
+private
+  type Private_Comm is new Modules.Electronics_Module with
+    record
+      TC_PC : Integer;
+    end record;
+
+  type Mil_Comm is new Modules.Electronics_Module with 
+    record
+      TC_MC : Integer;
+    end record;
+end C391002_4; -- Communications
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with TCTouch;
+package body C391002_4 is -- Communications
+
+  procedure Creator( Plugs : in Modules.Electronics_Module;
+                     Gives : out Mil_Comm) is
+  begin
+    Gives := ( Plugs with TC_MC => -1 );
+  end Creator;
+
+  function  Creator( Key : Integer; Plugs : in Modules.Electronics_Module )
+            return Private_Comm is
+  begin
+    return ( Plugs with TC_PC => Key );
+  end Creator;
+
+  procedure Setup( It : in out Public_Comm; Value : in Integer ) is
+  begin
+    It.TC_VC := Value;
+    TCTouch.Assert( Value = 1, "Public_Comm");
+  end Setup;
+
+  procedure Setup( It : in out Private_Comm; Value : in Integer ) is
+  begin
+    It.TC_PC := Value;
+    TCTouch.Assert( Value = 2, "Private_Comm");
+  end Setup;
+
+  procedure Setup( It : in out Mil_Comm; Value : in Integer ) is
+  begin
+    It.TC_MC := Value;
+    TCTouch.Assert( Value = 3, "Private_Comm");
+  end Setup;
+
+  function  Selector( It : Public_Comm )  return Integer is
+  begin
+    return It.TC_VC;
+  end Selector;
+
+  function  Selector( It : Private_Comm ) return Integer is
+  begin
+    return It.TC_PC;
+  end Selector;
+
+  function  Selector( It : Mil_Comm )     return Integer is
+  begin
+    return It.TC_MC;
+  end Selector;
+
+end C391002_4; -- Communications
+
+------------------------------------------------------------------- C391002
+
+with Report;
+with TCTouch;
+with C391002_1;
+with C391002_2;
+with C391002_3;
+with C391002_4;
+procedure C391002 is
+
+  package Plaque  renames C391002_1;
+  package Boards  renames C391002_2;
+  package Modules renames C391002_3;
+  package Communications renames C391002_4;
+
+  procedure Assert( Condition: Boolean; Message: String )
+    renames TCTouch.Assert;
+
+  use type Boards.Modes;
+  use type Boards.Data_Formats;
+  use type Modules.Command_Formats;
+
+  type Azimuth is range 0..359;
+
+  type Ground_Antenna(The_Band    : Boards.Data_Formats;
+                      The_Command : Modules.Command_Formats) is
+    record
+      ID          : Plaque.Object;
+      Electronics : Modules.Electronics_Module(The_Band,The_Command);
+      Pointing    : Azimuth;
+    end record;
+
+  type Space_Antenna(The_Band    : Boards.Data_Formats    := Boards.KU_Band;
+                     The_Command : Modules.Command_Formats
+                                   := Modules.Set_Power_State)
+  is
+    record
+      ID          : Plaque.Object;
+      Electronics : Modules.Electronics_Module(The_Band,The_Command);
+    end record;
+
+  The_Ground_Antenna     : Ground_Antenna (Boards.S_Band,
+                                           Modules.Set_Data_Rate);
+  The_Space_Antenna      : Space_Antenna;
+  Space_Station_Antenna  : Space_Antenna  (Boards.UHF,
+                                           Modules.Set_Compression_Code);
+
+  Gossip : Communications.Public_Comm  (Boards.UHF,
+                                        Modules.Set_Compression_Code);
+  Usenet : Communications.Private_Comm (Boards.KU_Band,
+                                        Modules.Set_Data_Rate);
+  Milnet : Communications.Mil_Comm     (Boards.S_Band,
+                                        Modules.Set_Power_State);
+
+
+begin
+
+  Report.Test("C391002", "Check nested tagged discriminated"
+                       & " record structures");
+
+  Plaque.Create( The_Ground_Antenna.ID );               -- 1
+  Plaque.Create( The_Ground_Antenna.Electronics.ID );   -- 2
+  Plaque.Create( The_Space_Antenna.ID );                -- 3
+  Plaque.Create( The_Space_Antenna.Electronics.ID );    -- 4
+  Plaque.Create( Space_Station_Antenna.ID );            -- 5
+  Plaque.Create( Space_Station_Antenna.Electronics.ID );-- 6
+
+  The_Ground_Antenna := ( The_Band    => Boards.S_Band,
+                          The_Command => Modules.Set_Data_Rate,
+                          ID          => The_Ground_Antenna.ID,
+                          Electronics =>
+                          ( Boards.Transceiver'(
+                              Band     => Boards.S_Band,
+                              ID       => The_Ground_Antenna.Electronics.ID,
+                              The_Link => ( Mode => Boards.Transmitting,
+                                            TC_T => 222 ),
+                              TC_S_Band_Data => 8 )
+                            with   EBand       => Boards.S_Band,
+                                   The_Command => Modules.Set_Data_Rate,
+                                   TC_SDR      => 11 ),
+                          Pointing    => 270 );
+
+  The_Space_Antenna := ( The_Band    => Boards.S_Band,
+                         The_Command => Modules.Set_Data_Rate,
+                         ID          => The_Space_Antenna.ID,
+                         Electronics =>
+                         ( Boards.Transceiver'(
+                             Band     => Boards.S_Band,
+                             ID       => The_Space_Antenna.Electronics.ID,
+                             The_Link => ( Mode => Boards.Transmitting,
+                                           TC_T => 456 ),
+                             TC_S_Band_Data => 88 )
+                           with
+                               EBand       => Boards.S_Band,
+                               The_Command => Modules.Set_Data_Rate,
+                               TC_SDR      => 42
+                        ) );
+
+  Space_Station_Antenna := ( Boards.UHF, Modules.Set_Compression_Code,
+                             Space_Station_Antenna.ID,
+                             ( Boards.Transceiver'(
+                                 Boards.UHF,
+                                 Space_Station_Antenna.Electronics.ID,
+                                 ( Boards.Transmitting, 202 ),
+                                 42 )
+                                 with Boards.UHF, 
+                                      Modules.Set_Compression_Code,
+                                      TC_SCC => 101
+                           ) );
+
+  Assert( The_Ground_Antenna.The_Band = Boards.S_Band, "TGA disc 1" );
+  Assert( The_Ground_Antenna.The_Command = Modules.Set_Data_Rate,
+            "TGA disc 2" );
+  Assert( Plaque.TC_Match(The_Ground_Antenna.ID,1), "TGA comp 3" );
+  Assert( The_Ground_Antenna.Electronics.EBand = Boards.S_Band,
+            "TGA comp 2.disc 1" );
+  Assert( The_Ground_Antenna.Electronics.The_Command
+             = Modules.Set_Data_Rate,
+            "TGA comp 2.disc 2" );
+  Assert( The_Ground_Antenna.Electronics.TC_SDR = 11,
+            "TGA comp 2.1" );
+  Assert( Plaque.TC_Match( The_Ground_Antenna.Electronics.ID, 2 ),
+            "TGA comp 2.inher.1" );
+  Assert( The_Ground_Antenna.Electronics.The_Link.Mode = Boards.Transmitting,
+            "TGA comp 2.inher.2.disc" );
+  Assert( The_Ground_Antenna.Electronics.The_Link.TC_T = 222,
+            "TGA comp 2.inher.2.1" );
+  Assert( The_Ground_Antenna.Electronics.TC_S_Band_Data = 8,
+            "TGA comp 2.inher.3" );
+  Assert( The_Ground_Antenna.Pointing = 270, "TGA comp 3" );
+
+  Assert( The_Space_Antenna.The_Band = Boards.S_Band, "TSA disc 1");
+  Assert( The_Space_Antenna.The_Command = Modules.Set_Data_Rate,
+            "TSA disc 2");
+  Assert( Plaque.TC_Match(The_Space_Antenna.ID,3),
+            "TSA comp 1");
+  Assert( The_Space_Antenna.Electronics.EBand = Boards.S_Band,
+            "TSA comp 2.disc 1");
+  Assert( The_Space_Antenna.Electronics.The_Command = Modules.Set_Data_Rate,
+            "TSA comp 2.disc 2");
+  Assert( The_Space_Antenna.Electronics.TC_SDR = 42,
+            "TSA comp 2.1");
+  Assert( Plaque.TC_Match(The_Space_Antenna.Electronics.ID,4),
+            "TSA comp 2.inher.1");
+  Assert( The_Space_Antenna.Electronics.The_Link.Mode = Boards.Transmitting,
+            "TSA comp 2.inher.2.disc");
+  Assert( The_Space_Antenna.Electronics.The_Link.TC_T = 456,
+            "TSA comp 2.inher.2.1");
+  Assert( The_Space_Antenna.Electronics.TC_S_Band_Data = 88,
+            "TSA comp 2.inher.3");
+
+  Assert( Space_Station_Antenna.The_Band = Boards.UHF, "SSA disc 1");
+  Assert( Space_Station_Antenna.The_Command = Modules.Set_Compression_Code,
+            "SSA disc 2");
+  Assert( Plaque.TC_Match(Space_Station_Antenna.ID,5),
+            "SSA comp 1");
+  Assert( Space_Station_Antenna.Electronics.EBand = Boards.UHF,
+            "SSA comp 2.disc 1");
+  Assert( Space_Station_Antenna.Electronics.The_Command
+             = Modules.Set_Compression_Code,
+            "SSA comp 2.disc 2");
+  Assert( Space_Station_Antenna.Electronics.TC_SCC = 101,
+            "SSA comp 2.1");
+  Assert( Plaque.TC_Match(Space_Station_Antenna.Electronics.ID,6),
+            "SSA comp 2.inher.1");
+  Assert( Space_Station_Antenna.Electronics.The_Link.Mode
+            = Boards.Transmitting,
+            "SSA comp 2.inher.2.disc");
+  Assert( Space_Station_Antenna.Electronics.The_Link.TC_T = 202,
+            "SSA comp 2.inher.2.1");
+  Assert( Space_Station_Antenna.Electronics.TC_UHF_Data = 42,
+            "SSA comp 2.inher.3");
+
+
+  The_Space_Antenna := ( The_Band    => Boards.S_Band,
+                         The_Command => Modules.Set_Power_State,
+                         ID          => The_Space_Antenna.ID,
+                         Electronics =>
+                         ( Boards.Transceiver'(
+                             Band     => Boards.S_Band,
+                             ID       => The_Space_Antenna.Electronics.ID,
+                             The_Link => ( Mode => Boards.Transmitting,
+                                           TC_T => 1 ),
+                             TC_S_Band_Data => 5 )
+                           with
+                               EBand       => Boards.S_Band,
+                               The_Command => Modules.Set_Power_State,
+                               TC_SPS      => 101
+                        ) );
+
+  Communications.Creator( The_Space_Antenna.Electronics, Milnet );
+  Assert( Communications.Selector( Milnet ) = -1, "Milnet creator" );
+
+  Usenet := Communications.Creator( -2, 
+                     ( Boards.Transceiver'(
+                         Band        => Boards.KU_Band,
+                         ID          => The_Space_Antenna.Electronics.ID,
+                         The_Link    => ( Boards.Transmitting, TC_T => 101 ),
+                         TC_KU_Band_Data => 395 )
+                    with Boards.KU_Band, Modules.Set_Data_Rate, 66 ) );
+
+  Assert( Communications.Selector( Usenet ) = -2, "Usenet creator" );
+
+  Gossip := ( 
+    Modules.Electronics_Module'(
+      Boards.Transceiver'(
+         Band        => Boards.UHF,
+         ID          => The_Space_Antenna.Electronics.ID,
+         The_Link    => ( Boards.Transmitting, TC_T => 101 ),
+         TC_UHF_Data => 395 )
+       with 
+         Boards.UHF, Modules.Set_Compression_Code, 66 )
+     with
+       TC_VC => -3 ); 
+
+  Assert( Gossip.TC_VC = -3, "Gossip Aggregate" );
+
+  Communications.Setup( Gossip, 1 ); -- (Boards.UHF,
+                                     -- Modules.Set_Compression_Code)
+  Communications.Setup( Usenet, 2 ); -- (Boards.KU_Band,
+                                     -- Modules.Set_Data_Rate)
+  Communications.Setup( Milnet, 3 ); -- (Boards.S_Band,
+                                     -- Modules.Set_Power_State)
+
+  Assert( Communications.Selector( Gossip ) = 1, "Gossip Setup" );
+  Assert( Communications.Selector( Usenet ) = 2, "Usenet Setup" );
+  Assert( Communications.Selector( Milnet ) = 3, "Milnet Setup" );
+
+  Report.Result;
+
+end C391002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392002.a
new file mode 100644
index 000000000..41493c227
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392002.a
@@ -0,0 +1,349 @@
+-- C392002.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 use of a class-wide formal parameter allows for the 
+--      proper dispatching of objects to the appropriate implementation of 
+--      a primitive operation.  Check this in the case where the root tagged
+--      type is defined in a generic package, and the type derived from it is
+--      defined in that same generic package.
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged type, and some associated primitive operations.
+--      Extend the root type, and override one or more primitive operations, 
+--      inheriting the other primitive operations from the root type.
+--      Derive from the extended type, again overriding some primitive
+--      operations and inheriting others (including some that the parent 
+--      inherited).
+--      Define a subprogram with a class-wide parameter, inside of which is a 
+--      call on a dispatching primitive operation.  These primitive operations
+--      modify global variables (the class-wide parameter has mode IN).
+--     
+--  The following hierarchy of tagged types and primitive operations is 
+--  utilized in this test:
+--
+--
+--    type Vehicle (root)
+--            |
+--    type Motorcycle
+--            |
+--            | Operations
+--            |   Engine_Size
+--            |   Catalytic_Converter
+--            |   Emissions_Produced
+--            |
+--    type Automobile (extended from Motorcycle)
+--            |
+--            | Operations
+--            |   (Engine_Size)       (inherited)
+--            |   Catalytic_Converter (overridden)
+--            |   Emissions_Produced  (overridden)
+--            |
+--    type Truck (extended from Automobile)
+--            |
+--            | Operations
+--            |   (Engine_Size)         (inherited twice - Motorcycle)
+--            |   (Catalytic_Converter) (inherited - Automobile)
+--            |   Emissions_Produced    (overridden)
+-- 
+--
+-- In this test, we are concerned with the following selection of dispatching
+-- calls, accomplished with the use of a Vehicle'Class IN procedure 
+-- parameter :
+--
+--                       \ Type
+--               Prim. Op \   Motorcycle      Automobile        Truck
+--                         \------------------------------------------------ 
+--             Engine_Size |      X               X               X
+--     Catalytic_Converter |      X               X               X
+--     Emissions_Produced  |      X               X               X
+--
+--
+--
+-- The location of the declaration and derivation of the root and extended
+-- types will be varied over a series of tests.  Locations of declaration
+-- and derivation for a particular test are marked with an asterisk (*).
+--
+-- Root type:
+--       
+--       Declared in package.                                          
+--    *  Declared in generic package.
+--
+-- Extended types:
+--
+--    *  Derived in parent location.
+--       Derived in a nested package.
+--       Derived in a nested subprogram.
+--       Derived in a nested generic package.
+--       Derived in a separate package.
+--       Derived in a separate visible child package.
+--       Derived in a separate private child package.
+--
+-- Primitive Operations:
+--
+--    *  Procedures with same parameter profile.
+--       Procedures with different parameter profile.
+--    *  Functions with same parameter profile.
+--       Functions with different parameter profile.
+--    *  Mixture of Procedures and Functions.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      09 May 96   SAIC    Made single-file for 2.1
+--
+--!
+
+------------------------------------------------------------------- C392002_0
+
+-- Declare the root and extended types, along with their primitive
+-- operations in a generic package.
+
+generic
+
+   type Cubic_Inches     is range <>;
+   type Emission_Measure is digits <>;
+   Emissions_per_Engine_Cubic_Inch : Emission_Measure;
+
+package C392002_0 is       -- package Vehicle_Simulation
+
+   --
+   -- Equipment types and their primitive operations.
+   --
+
+   -- Root type.
+
+   type Vehicle is abstract tagged 
+      record 
+         Weight : Integer;
+         Wheels : Positive;
+      end record;
+
+   -- Abstract operations of type Vehicle.
+   function Engine_Size         (V : in Vehicle) return Cubic_Inches
+            is abstract;
+   function Catalytic_Converter (V : in Vehicle) return Boolean
+            is abstract;
+   function Emissions_Produced  (V : in Vehicle) return Emission_Measure
+            is abstract;
+
+   --
+
+   type Motorcycle is new Vehicle with
+      record
+         Size_Of_Engine : Cubic_Inches;
+      end record;
+
+   -- Primitive operations of type Motorcycle.
+   function Engine_Size         (V : in Motorcycle) return Cubic_Inches;
+   function Catalytic_Converter (V : in Motorcycle) return Boolean;
+   function Emissions_Produced  (V : in Motorcycle) return Emission_Measure;
+
+   --
+                          
+   type Automobile is new Motorcycle with
+      record
+         Passenger_Capacity : Integer;
+      end record;
+
+   -- Function Engine_Size inherited from parent (Motorcycle).
+   -- Primitive operations (Overridden).
+   function Catalytic_Converter (V : in Automobile) return Boolean;
+   function Emissions_Produced  (V : in Automobile) return Emission_Measure;
+                          
+   --
+
+   type Truck is new Automobile with
+      record
+         Hauling_Capacity : Natural;
+      end record;
+
+   -- Function Engine_Size inherited twice.
+   -- Function Catalytic_Converter inherited from parent (Automobile).
+   -- Primitive operation (Overridden).
+   function Emissions_Produced  (V : in Truck) return Emission_Measure;
+
+end C392002_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body c392002_0 is
+
+   --
+   -- Primitive operations for Motorcycle.
+   --
+
+   function Engine_Size         (V : in Motorcycle) return Cubic_Inches is
+   begin
+      return (V.Size_Of_Engine);
+   end Engine_Size;
+
+
+   function Catalytic_Converter (V : in Motorcycle) return Boolean is
+   begin
+      return (False);
+   end Catalytic_Converter;
+
+
+   function Emissions_Produced  (V : in Motorcycle) return Emission_Measure is
+   begin
+      return 100.00;
+   end Emissions_Produced;
+
+   --
+   -- Overridden operations for Automobile type.
+   --
+
+   function Catalytic_Converter (V : in Automobile) return Boolean is
+   begin
+      return (True);
+   end Catalytic_Converter;
+
+
+   function Emissions_Produced  (V : in Automobile) return Emission_Measure is
+   begin
+      return 200.00;
+   end Emissions_Produced;
+
+   --
+   -- Overridden operation for Truck type.
+   --
+
+   function Emissions_Produced  (V : in Truck) return Emission_Measure is
+   begin
+      return 300.00;
+   end Emissions_Produced;
+                     
+end C392002_0;
+
+--------------------------------------------------------------------- C392002
+
+with C392002_0;        -- with Vehicle_Simulation;
+with Report;
+
+procedure C392002 is  
+
+   type Decade                     is (c1970, c1980, c1990);
+   type Vehicle_Emissions          is digits 6;
+   type Engine_Emissions_by_Decade is array (Decade) of Vehicle_Emissions;
+   subtype Engine_Size             is Integer range 100 .. 1000;
+
+   Five_Tons                  : constant Natural := 10000;
+   Catalytic_Converter_Offset : constant Vehicle_Emissions := 0.8;
+   Truck_Adjustment_Factor    : constant Vehicle_Emissions := 1.2;
+
+
+   Engine_Emission_Factor : Engine_Emissions_by_Decade := (c1970 => 10.00,
+                                                           c1980 =>  8.00,
+                                                           c1990 =>  5.00);
+
+   -- Instantiate generic package for 1970 simulation.
+
+   package Sim_1970 is new C392002_0
+     (Cubic_Inches                    => Engine_Size,
+      Emission_Measure                => Vehicle_Emissions,
+      Emissions_Per_Engine_Cubic_Inch => Engine_Emission_Factor (c1970));
+
+
+   -- Declare and initialize vehicle objects.
+
+   Cycle_1970 : Sim_1970.Motorcycle := (Weight         => 400, 
+                                        Wheels         =>   2,
+                                        Size_Of_Engine => 100);
+
+   Auto_1970  : Sim_1970.Automobile := (2000, 4, 500, 5);
+
+   Truck_1970 : Sim_1970.Truck      := (Weight             => 5000, 
+                                        Wheels             => 18, 
+                                        Size_Of_Engine     => 1000, 
+                                        Passenger_Capacity => 2, 
+                                        Hauling_Capacity   => Five_Tons);
+
+   -- Function Get_Engine_Size performs a dispatching call on a
+   -- primitive operation that has been defined for an ancestor type and 
+   -- inherited by each type derived from the ancestor.
+
+   function Get_Engine_Size (V : in Sim_1970.Vehicle'Class) 
+     return Engine_Size is
+   begin
+     return (Sim_1970.Engine_Size (V)); -- Dispatch according to tag.
+   end Get_Engine_Size;
+ 
+
+   -- Function Catalytic_Converter_Present performs a dispatching call on 
+   -- a primitive operation that has been defined for an ancestor type, 
+   -- overridden in the parent extended type, and inherited by the subsequent 
+   -- extended type.
+
+   function Catalytic_Converter_Present (V : in Sim_1970.Vehicle'Class)
+     return Boolean is
+   begin
+      return (Sim_1970.Catalytic_Converter (V)); -- Dispatch according to tag.
+   end Catalytic_Converter_Present;
+
+
+   -- Function Air_Quality_Measure performs a dispatching call on 
+   -- a primitive operation that has been defined for an ancestor type, and
+   -- overridden in each subsequent extended type.
+
+   function Air_Quality_Measure (V : in Sim_1970.Vehicle'Class)
+     return Vehicle_Emissions is
+   begin
+      return (Sim_1970.Emissions_Produced (V));  -- Dispatch according to tag.
+   end Air_Quality_Measure;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+begin  -- Main test procedure.
+
+   Report.Test ("C392002",  "Check that the use of a class-wide parameter "
+                          & "allows for proper dispatching where root type "
+                          & "and extended types are declared in the same "
+                          & "generic package" );
+
+   if (Get_Engine_Size (Cycle_1970) /=  100) or
+      (Get_Engine_Size (Auto_1970)  /=  500) or
+      (Get_Engine_Size (Truck_1970) /= 1000) 
+   then
+      Report.Failed ("Failed dispatch to Get_Engine_Size");
+   end if;
+
+   if Catalytic_Converter_Present (Cycle_1970)    or
+      not Catalytic_Converter_Present (Auto_1970) or
+      not Catalytic_Converter_Present (Truck_1970)
+   then
+      Report.Failed ("Failed dispatch to Catalytic_Converter_Present");
+   end if;
+
+   if ((Air_Quality_Measure (Cycle_1970) /= 100.00) or
+       (Air_Quality_Measure (Auto_1970)  /= 200.00) or
+       (Air_Quality_Measure (Truck_1970) /= 300.00)) 
+   then
+      Report.Failed ("Failed dispatch to Air_Quality_Measure");
+   end if;
+
+   Report.Result;
+
+end C392002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392003.a
new file mode 100644
index 000000000..d7c5be228
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392003.a
@@ -0,0 +1,453 @@
+-- C392003.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 use of a class-wide formal parameter allows for the 
+--      proper dispatching of objects to the appropriate implementation of 
+--      a primitive operation.  Check this where the root tagged type is
+--      defined in a package, and the extended type is defined in a nested
+--      package.
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged type, and some associated primitive operations.
+--      Extend the root type, and override one or more primitive operations, 
+--      inheriting the other primitive operations from the root type.
+--      Derive from the extended type, again overriding some primitive
+--      operations and inheriting others (including some that the parent 
+--      inherited).
+--      Define a subprogram with a class-wide parameter, inside of which is a 
+--      call on a dispatching primitive operation.  These primitive operations
+--      modify global variables (the class-wide parameter has mode IN).
+--     
+--     
+--     
+-- The following hierarchy of tagged types and primitive operations is 
+-- utilized in this test:
+--
+--    type Bank_Account (root)
+--            |
+--            | Operations
+--            |   Increment_Bank_Reserve
+--            |   Assign_Representative
+--            |   Increment_Counters
+--            |   Open
+--            |
+--    type Savings_Account (extended from Bank_Account)
+--            |
+--            | Operations
+--            |   (Increment_Bank_Reserve) (inherited)
+--            |   Assign_Representative    (overridden)
+--            |   Increment_Counters       (overridden)
+--            |   Open                     (overridden)
+--            |
+--    type Preferred_Account (extended from Savings_Account)
+--            |
+--            | Operations
+--            |   (Increment_Bank_Reserve) (inherited twice - Bank_Acct.)
+--            |   (Assign_Representative)  (inherited - Savings_Acct.)
+--            |   Increment_Counters       (overridden)
+--            |   Open                     (overridden)
+-- 
+--
+-- In this test, we are concerned with the following selection of dispatching
+-- calls, accomplished with the use of a Bank_Account'Class IN procedure 
+-- parameter :
+--
+--                       \ Type
+--               Prim. Op \  Bank_Account  Savings_Account Preferred_Account
+--                         \------------------------------------------------ 
+--   Increment_Bank_Reserve|      X                               X
+--   Assign_Representative |                      X
+--   Increment_Counters    |      X               X               X
+--
+--
+--
+-- The location of the declaration and derivation of the root and extended
+-- types will be varied over a series of tests.  Locations of declaration
+-- and derivation for a particular test are marked with an asterisk (*).
+--
+-- Root type:
+--       
+--    *  Declared in package.
+--       Declared in generic package.
+--
+-- Extended types:
+--
+--       Derived in parent location.
+--    *  Derived in a nested package.
+--       Derived in a nested subprogram.
+--       Derived in a nested generic package.
+--       Derived in a separate package.
+--       Derived in a separate visible child package.
+--       Derived in a separate private child package.
+--
+-- Primitive Operations:
+--
+--    *  Procedures with same parameter profile.
+--       Procedures with different parameter profile.
+--    *  Functions with same parameter profile.
+--       Functions with different parameter profile.
+--    *  Mixture of Procedures and Functions.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+ 
+ 
+ with Report;
+ 
+ procedure C392003 is
+ 
+       --
+       -- 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);
+ 
+    -- Root tagged type and primitive operations declared in internal 
+    -- package (Accounts).
+    -- Extended types (and primitive operations) derived in nested packages.
+ 
+      --=================================================================--
+ 
+    package Accounts is
+ 
+       --
+       -- Root account type and primitive operations.
+       --
+ 
+       -- Root type.
+ 
+       type Bank_Account is tagged
+          record
+             Balance : Dollar_Amount;
+          end record;
+ 
+       -- Primitive operations of Bank_Account.
+ 
+       function  Increment_Bank_Reserve (Acct : in     Bank_Account) 
+         return Dollar_Amount;
+       function Assign_Representative   (Acct : in     Bank_Account)
+         return Account_Rep;
+       procedure Increment_Counters     (Acct : in     Bank_Account);
+       procedure Open                   (Acct : in out Bank_Account);
+ 
+      --=================================================================--
+                           
+       package S_And_L is 
+ 
+          -- Declare extended type in a nested package.
+ 
+          type Savings_Account is new Bank_Account with
+          record
+             Rate : Interest_Rate;
+          end record;
+ 
+          -- Function Increment_Bank_Reserve inherited from 
+          -- parent (Bank_Account).
+ 
+          -- Primitive operations (Overridden).
+          function Assign_Representative (Acct : in     Savings_Account)
+            return Account_Rep;
+          procedure Increment_Counters   (Acct : in     Savings_Account);
+          procedure Open                 (Acct : in out Savings_Account);
+                           
+ 
+      --=================================================================--
+                           
+          package Premium is 
+ 
+             -- Declare further extended type in a nested package.
+ 
+             type Preferred_Account is new Savings_Account with
+             record
+                Minimum_Balance : Dollar_Amount;
+             end record;
+ 
+             -- Function Increment_Bank_Reserve inherited twice.
+             -- Function Assign_Representative inherited from parent 
+             --   (Savings_Account).
+ 
+             -- Primitive operation (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 Premium;
+ 
+       end S_And_L;
+ 
+    end Accounts;
+ 
+      --=================================================================--
+ 
+    package body Accounts is
+ 
+       --
+       -- Primitive operations for Bank_Account.
+       --
+ 
+       function Increment_Bank_Reserve (Acct : in Bank_Account) 
+         return Dollar_Amount is
+       begin
+          return (Bank_Reserve + Acct.Balance);
+       end Increment_Bank_Reserve;
+ 
+       function Assign_Representative (Acct : in Bank_Account) 
+         return Account_Rep is
+       begin
+          return Account_Rep'(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;
+ 
+      --=================================================================--
+ 
+       package body S_And_L is
+ 
+          --
+          -- Overridden operations for Savings_Account type.
+          --
+ 
+          function Assign_Representative (Acct : in Savings_Account) 
+            return Account_Rep is
+          begin
+             return (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;
+      
+      --=================================================================--
+ 
+          package body Premium is
+ 
+             --
+             -- Overridden operations 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 Premium;
+  
+       end S_And_L;
+ 
+    end Accounts;
+ 
+      --=================================================================--
+ 
+    -- Declare account objects.
+ 
+    B_Account : Accounts.Bank_Account;
+    S_Account : Accounts.S_And_L.Savings_Account;
+    P_Account : Accounts.S_And_L.Premium.Preferred_Account;
+ 
+    -- Procedures to operate on accounts.
+    -- Each uses a class-wide IN parameter, as well as a call to a
+    -- dispatching operation.
+ 
+    -- Function Tabulate_Account performs a dispatching call on a primitive
+    -- operation that has been overridden for each of the extended types.
+ 
+    procedure Tabulate_Account (Acct : in Accounts.Bank_Account'Class) is
+    begin
+       Accounts.Increment_Counters (Acct);   -- Dispatch according to tag.
+    end Tabulate_Account;
+ 
+    -- Function Accumulate_Reserve performs a dispatching call on a
+    -- primitive operation that has been defined for the root type and 
+    -- inherited by each derived type.
+ 
+    function Accumulate_Reserve (Acct : in Accounts.Bank_Account'Class) 
+      return Dollar_Amount is
+    begin
+       -- Dispatch according to tag.
+       return (Accounts.Increment_Bank_Reserve (Acct));   
+    end Accumulate_Reserve;
+ 
+    -- Procedure Resolve_Dispute performs a dispatching call on a primitive
+    -- operation that has been defined in the root type, overridden in the
+    -- first derived extended type, and inherited by the subsequent extended
+    -- type.
+ 
+    procedure Resolve_Dispute (Acct : in Accounts.Bank_Account'Class) is
+    begin
+       -- Dispatch according to tag.
+       Daily_Representative := Accounts.Assign_Representative (Acct);   
+    end Resolve_Dispute;
+ 
+      --=================================================================--
+ 
+ begin  -- Main test procedure.
+ 
+    Report.Test ("C392003", "Check that the use of a class-wide parameter "   &
+                             "allows for proper dispatching where root type " &
+                             "is declared in a nested package, and "          &
+                             "subsequent extended types are derived in "      &
+                             "further nested packages" );
+    
+    Bank_Account_Subtest:
+    begin
+       Accounts.Open (B_Account);
+ 
+       -- Demonstrate class-wide parameter allowing dispatch by a primitive
+       -- operation that has been defined for this specific type.
+       Bank_Reserve := Accumulate_Reserve (Acct => B_Account);
+       Tabulate_Account (B_Account);
+ 
+       if (Bank_Reserve /= Opening_Balance) or
+          (Number_Of_Accounts (Bank) /= 1)  or
+          (Number_Of_Accounts (Total) /= 1) 
+       then
+          Report.Failed ("Failed in Bank_Account_Subtest");
+       end if;
+ 
+    end Bank_Account_Subtest;
+ 
+ 
+    Savings_Account_Subtest:
+    begin
+       Accounts.S_And_L.Open (Acct => S_Account);
+ 
+       -- Demonstrate class-wide parameter allowing dispatch by a primitive
+       -- operation that has been overridden for this extended type.
+       Resolve_Dispute  (Acct => S_Account);
+       Tabulate_Account (S_Account);
+ 
+       if (Daily_Representative /= Manager)   or 
+          (Number_Of_Accounts (Savings) /= 1) or
+          (Number_Of_Accounts (Total) /= 2)
+       then
+          Report.Failed ("Failed in Savings_Account_Subtest");
+       end if;
+ 
+    end Savings_Account_Subtest;
+ 
+ 
+ 
+    Preferred_Account_Subtest:
+    begin
+       Accounts.S_And_L.Premium.Open (P_Account);
+ 
+       -- Verify that the correct implementation of Open (overridden) was 
+       -- used for the Preferred_Account object.
+       if not Accounts.S_And_L.Premium.Verify_Open (P_Account) then
+          Report.Failed ("Incorrect values for init. Preferred Acct object");
+       end if;
+ 
+       -- Demonstrate class-wide parameter allowing dispatch by a primitive
+       -- operation that has been twice inherited by this extended type.
+       Bank_Reserve := Accumulate_Reserve (Acct => P_Account);
+ 
+       -- Demonstrate class-wide parameter allowing dispatch by a primitive
+       -- operation that has been overridden for this extended type (the
+       -- operation was overridden by its parent type as well).
+       Tabulate_Account (P_Account);
+       
+       if Bank_Reserve /= 1100.00             or 
+          Number_Of_Accounts (Preferred) /= 1 or
+          Number_Of_Accounts (Total) /= 3
+       then
+          Report.Failed ("Failed in Preferred_Account_Subtest");
+       end if;
+ 
+    end Preferred_Account_Subtest;
+ 
+    Report.Result;
+ 
+ end C392003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392004.a
new file mode 100644
index 000000000..0851db1d2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392004.a
@@ -0,0 +1,189 @@
+-- C392004.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 subprograms inherited from tagged derivations, which are
+--      subsequently redefined for the derived type, are available to the
+--      package defining the new class via view conversion.  Check
+--      that operations performed on objects using view conversion do not 
+--      affect the extended fields.  Check that visible operations not masked 
+--      by the deriving package remain available to the client, and do not 
+--      affect the extended fields.
+--
+-- TEST DESCRIPTION:
+--      This test declares a tagged type, with a constructor operation,
+--      derives a type from that tagged type, and declares a constructor
+--      operation which masks the inherited operation.  It then tests
+--      that the correct constructor is called, and that the extended
+--      part of the derived type remains untouched as appropriate.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--      04 Jan 94   SAIC    Fixed objective typo, removed dead code.
+--
+--!
+
+with Report;
+
+package C392004_1 is
+
+  type Vehicle is tagged private;
+
+  procedure Create ( The_Vehicle :    out Vehicle; TC_Flag : Natural );
+  procedure Start  ( The_Vehicle : in out Vehicle );
+
+private
+
+  type Vehicle is tagged record
+    Engine_On : Boolean;
+  end record;
+
+end C392004_1;
+
+package body C392004_1 is
+  procedure Create ( The_Vehicle : out Vehicle; TC_Flag : Natural ) is
+  begin
+    case TC_Flag is
+      when 1 => null; -- expected flag for this subprogram
+      when others =>
+         Report.Failed ("Called Vehicle Create");
+    end case;
+    The_Vehicle := (Engine_On => False);
+  end Create;
+
+  procedure Start ( The_Vehicle : in out Vehicle ) is
+  begin
+    The_Vehicle.Engine_On := True;
+  end Start;
+
+end C392004_1;
+
+----------------------------------------------------------------------------
+
+with C392004_1;
+package C392004_2 is
+
+  type Car is new C392004_1.Vehicle with record
+    Convertible : Boolean;
+  end record;
+
+  -- masking definition
+  procedure Create( The_Car : out Car; TC_Flag : Natural );
+
+  type Limo is new Car with null record;
+
+  procedure Create( The_Limo : out Limo; TC_Flag : Natural );
+
+end C392004_2;
+
+----------------------------------------------------------------------------
+
+with Report;
+package body C392004_2 is
+
+  procedure Create( The_Car : out Car; TC_Flag : Natural ) is
+  begin
+    case TC_Flag is
+      when 2      => null; -- expected flag for this subprogram
+      when others => Report.Failed ("Called Car Create");
+    end case;
+    C392004_1.Create( C392004_1.Vehicle(The_Car), 1);
+    The_Car.Convertible := False;
+  end Create;
+
+  procedure Create( The_Limo : out Limo; TC_Flag : Natural ) is
+  begin
+    case TC_Flag is
+      when 3      => null; -- expected flag for this subprogram
+      when others => Report.Failed ("Called Limo Create");
+    end case;
+    C392004_1.Create( C392004_1.Vehicle(The_Limo), 1);
+    The_Limo.Convertible := True;
+ end Create;
+
+end C392004_2;
+
+----------------------------------------------------------------------------
+
+with Report;
+with C392004_1; use C392004_1;
+with C392004_2; use C392004_2;
+procedure C392004 is
+
+  My_Car : Car;
+  Your_Car : Limo;
+
+  procedure TC_Assert( Is_True : Boolean; Message : String ) is
+  begin
+    if not Is_True then
+      Report.Failed (Message);
+    end if;
+  end TC_Assert;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C392004", "Check subprogram inheritance & visibility " &
+                          "for derived tagged types" );
+
+  My_Car.Convertible := False;
+  Create( Vehicle( My_Car ), 1 );
+  TC_Assert( not My_Car.Convertible, "Altered descendent component 1");
+
+  Create( Your_Car, 3 );
+  TC_Assert( Your_Car.Convertible, "Did not set inherited component 2");
+
+  My_Car.Convertible := True;
+  Create( Vehicle( My_Car ), 1 );
+  TC_Assert( My_Car.Convertible, "Altered descendent component 3");
+
+  Create( My_Car, 2 );
+  TC_Assert( not My_Car.Convertible, "Did not set extending component 4");
+
+  My_Car.Convertible := False;
+  Start( Vehicle( My_Car ) );
+  TC_Assert( not My_Car.Convertible , "Altered descendent component 5");
+
+  Start( My_Car );
+  TC_Assert( not My_Car.Convertible, "Altered unreferenced component 6");
+
+  Your_Car.Convertible := False;
+  Start( Vehicle( Your_Car ) );
+  TC_Assert( not Your_Car.Convertible , "Altered descendent component 7");
+
+  Start( Your_Car );
+  TC_Assert( not Your_Car.Convertible, "Altered unreferenced component 8");
+
+  My_Car.Convertible := True;
+  Start( Vehicle( My_Car ) );
+  TC_Assert( My_Car.Convertible, "Altered descendent component 9");
+
+  Start( My_Car );
+  TC_Assert( My_Car.Convertible, "Altered unreferenced component 10");
+
+  Report.Result;
+
+end C392004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392005.a
new file mode 100644
index 000000000..be49cd48b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392005.a
@@ -0,0 +1,367 @@
+-- C392005.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, for an implicitly declared dispatching operation that is
+--      overridden, the body executed is the body for the overriding
+--      subprogram, even if the overriding occurs in a private part.
+--
+--      Check for the case where the overriding operations are declared in a
+--      public child unit of the package declaring the parent type, and the
+--      descendant type is a private extension.
+--
+--      Check for both dispatching and nondispatching calls.
+--
+--
+-- TEST DESCRIPTION:
+--      Consider:
+--
+--      package Parent is
+--         type Root is tagged ...
+--         procedure Vis_Op (P: Root);
+--      private
+--         procedure Pri_Op (P: Root);
+--      end Parent;
+--
+--      package Parent.Child is
+--         type Derived is new Root with private;
+--         -- Implicit Vis_Op (P: Derived) declared here.
+--
+--         procedure Pri_Op (P: Derived);                  -- (A)
+--         ...
+--      private
+--         type Derived is new Root with record...
+--         -- Implicit Pri_Op (P: Derived) declared here.
+
+--         procedure Vis_Op (P: Derived);                  -- (B)
+--         ...
+--      end Parent.Child;
+--
+--      Type Derived inherits both Vis_Op and Pri_Op from the ancestor type
+--      Root. Note, however, that Vis_Op is implicitly declared in the visible
+--      part, whereas Pri_Op is implicitly declared in the private part
+--      (inherited subprograms for a private extension are implicitly declared
+--      after the private_extension_declaration if the corresponding
+--      declaration from the ancestor is visible at that place; otherwise the
+--      inherited subprogram is not declared for the private extension,
+--      although it might be for the full type).
+--
+--      Even though Root's version of Pri_Op hasn't been implicitly declared
+--      for Derived at the time Derived's version of Pri_Op has been
+--      explicitly declared, the explicit Pri_Op still overrides the implicit
+--      version. 
+--      Also, even though the explicit Vis_Op for Derived is declared in the
+--      private part it still overrides the implicit version declared in the
+--      visible part. Calls with tag Derived will execute (A) and (B).
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      26 Nov 96   SAIC    Improved for ACVC 2.1
+--
+--!
+
+package C392005_0 is
+
+   type Remote_Camera is tagged private;
+
+   type Depth_Of_Field is range 5 .. 100;  
+   type Shutter_Speed  is (One, Two_Fifty, Four_Hundred, Thousand);
+   type Aperture       is (Eight, Sixteen, Thirty_Two);     
+
+   -- ...Other declarations.
+
+   procedure Focus (Cam   : in out Remote_Camera;
+                    Depth : in     Depth_Of_Field);
+
+   procedure Self_Test (C: in out Remote_Camera'Class);
+
+   -- ...Other operations.
+
+   function TC_Get_Depth (C: Remote_Camera) return Depth_Of_Field;
+   function TC_Get_Speed (C: Remote_Camera) return Shutter_Speed;
+
+private
+
+   type Remote_Camera is tagged record
+      DOF    : Depth_Of_Field := 10;
+      Shutter: Shutter_Speed  := One;
+      FStop  : Aperture       := Eight;
+   end record;
+
+   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).
+
+   function Set_Aperture (C : Remote_Camera) return Aperture;
+                               
+end C392005_0;
+
+
+     --==================================================================--
+
+
+package body C392005_0 is
+
+   procedure Focus (Cam   : in out Remote_Camera;
+                    Depth : in     Depth_Of_Field) is
+   begin
+      -- Artificial for testing purposes.
+      Cam.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;
+
+   -----------------------------------------------------------
+   function Set_Aperture (C : Remote_Camera) return Aperture is
+   begin
+      -- Artificial for testing purposes.
+      return Thirty_Two;
+   end Set_Aperture;
+
+   -----------------------------------------------------------
+   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;
+
+   -----------------------------------------------------------
+   function TC_Get_Depth (C: Remote_Camera) return Depth_Of_Field is
+   begin
+      return C.DOF;
+   end TC_Get_Depth;
+
+   -----------------------------------------------------------
+   function TC_Get_Speed (C: Remote_Camera) return Shutter_Speed is
+   begin
+      return C.Shutter;
+   end TC_Get_Speed;
+
+end C392005_0;
+
+     --==================================================================--
+
+
+package C392005_0.C392005_1 is
+
+   type Auto_Speed is new Remote_Camera with private;
+
+
+   -- procedure Focus (C     : in out Auto_Speed;      -- Implicitly declared
+   --                  Depth : in     Depth_Of_Field)  -- here.
+
+   -- For the improved remote camera, shutter speed can be set manually,
+   -- so it is declared as a public operation.
+
+   -- The order of declarations for Set_Aperture and Set_Shutter_Speed are
+   -- reversed from the original declarations to trap potential compiler
+   -- problems related to subprogram ordering.
+
+   function Set_Aperture (C : Auto_Speed) return Aperture;    -- Overrides
+                                                              -- inherited op.
+
+   procedure Set_Shutter_Speed (C     : in out Auto_Speed;    -- Overrides
+                                Speed : in     Shutter_Speed);-- inherited op.
+
+   -- Set_Shutter_Speed and Set_Aperture override the operations inherited
+   -- from the parent, even though the inherited operations are not implicitly
+   -- declared until the private part below.
+
+   type New_Camera is private;
+
+   function TC_Get_Aper (C: New_Camera) return Aperture;
+
+   -- ...Other operations.
+
+private
+   type Film_Speed is (One_Hundred, Two_Hundred, Four_Hundred);
+
+   type Auto_Speed is new Remote_Camera with record
+      ASA : Film_Speed;
+   end record;
+
+   -- procedure Set_Shutter_Speed (C     : in out Auto_Speed;    -- Implicitly
+   --                              Speed : in     Shutter_Speed) -- declared
+                                                                 -- here.
+
+   -- function Set_Aperture (C : Auto_Speed) return Aperture;    -- Implicitly
+                                                                 -- declared.
+
+   procedure Focus (C     : in out Auto_Speed;                -- Overrides
+                    Depth : in     Depth_Of_Field);           -- inherited op.
+
+   -- For the improved remote camera, perhaps the focusing algorithm is
+   -- different, so the original Focus operation is overridden here.
+
+   Auto_Camera : Auto_Speed;
+
+   type New_Camera is record
+      Aper : Aperture := Set_Aperture (Auto_Camera);  -- Calls the overridden,
+   end record;                                        -- not the inherited op.
+
+end C392005_0.C392005_1;
+
+
+     --==================================================================--
+
+
+package body C392005_0.C392005_1 is
+
+   procedure Focus (C     : in out Auto_Speed;
+                    Depth : in     Depth_Of_Field) is
+   begin
+      -- Artificial for testing purposes.
+      C.DOF := 57;
+   end Focus;
+
+   ---------------------------------------------------------------
+   procedure Set_Shutter_Speed (C     : in out Auto_Speed;
+                                Speed : in     Shutter_Speed) is
+   begin
+      -- Artificial for testing purposes.
+      C.Shutter := Two_Fifty;
+   end Set_Shutter_Speed;
+
+   -----------------------------------------------------------
+   function Set_Aperture (C : Auto_Speed) return Aperture is
+   begin
+      -- Artificial for testing purposes.
+      return Sixteen;
+   end Set_Aperture;
+
+   -----------------------------------------------------------
+   function TC_Get_Aper (C: New_Camera) return Aperture is
+   begin
+      return C.Aper;
+   end TC_Get_Aper;
+
+end C392005_0.C392005_1;
+
+
+     --==================================================================--
+
+
+with C392005_0.C392005_1;
+
+with Report;
+
+procedure C392005 is
+   Basic_Camera : C392005_0.Remote_Camera;
+   Auto_Camera1 : C392005_0.C392005_1.Auto_Speed;
+   Auto_Camera2 : C392005_0.C392005_1.Auto_Speed;
+   Auto_Depth   : C392005_0.Depth_Of_Field := 67;
+   New_Camera1  : C392005_0.C392005_1.New_Camera;
+   TC_Expected_Basic_Depth : constant C392005_0.Depth_Of_Field := 46;
+   TC_Expected_Auto_Depth  : constant C392005_0.Depth_Of_Field := 57;
+   TC_Expected_Basic_Speed : constant C392005_0.Shutter_Speed  
+                           := C392005_0.Thousand;
+   TC_Expected_Auto_Speed  : constant C392005_0.Shutter_Speed  
+                           := C392005_0.Two_Fifty;
+   TC_Expected_New_Aper    : constant C392005_0.Aperture 
+                           := C392005_0.Sixteen;
+
+   use type C392005_0.Depth_Of_Field;
+   use type C392005_0.Shutter_Speed;
+   use type C392005_0.Aperture;
+
+begin
+   Report.Test ("C392005", "Dispatching for overridden primitive "        &
+                "subprograms: private extension declared in child unit, " &
+                "parent is tagged private whose full view is tagged record");
+
+-- Call the class-wide operation for Remote_Camera'Class, which itself makes
+-- dispatching calls to Focus and Set_Shutter_Speed:
+
+
+   -- For an object of type Remote_Camera, the dispatching calls should
+   -- dispatch to the bodies declared for the root type:
+     
+   C392005_0.Self_Test(Basic_Camera);
+
+   if C392005_0.TC_Get_Depth (Basic_Camera) /= TC_Expected_Basic_Depth 
+     or else C392005_0.TC_Get_Speed (Basic_Camera) /= TC_Expected_Basic_Speed
+   then
+      Report.Failed ("Calls dispatched incorrectly for root type");
+   end if;
+
+
+   -- For an object of type Auto_Speed, the dispatching calls should
+   -- dispatch to the bodies declared for the derived type:
+     
+   C392005_0.Self_Test(Auto_Camera1);
+
+   if C392005_0.C392005_1.TC_Get_Depth(Auto_Camera1) /= TC_Expected_Auto_Depth
+
+      or
+      C392005_0.C392005_1.TC_Get_Speed(Auto_Camera1) /= TC_Expected_Auto_Speed
+   then
+      Report.Failed ("Calls dispatched incorrectly for derived type");
+   end if;
+
+   -- For an object of type Auto_Speed, a non-dispatching call to Focus should
+
+   -- execute the body declared for the derived type (even through it is 
+   -- declared in the private part).
+
+   C392005_0.C392005_1.Focus (Auto_Camera2, Auto_Depth);
+
+   if C392005_0.C392005_1.TC_Get_Depth(Auto_Camera2) /= TC_Expected_Auto_Depth
+
+   then
+      Report.Failed ("Non-dispatching call to privately overriding " &
+                     "subprogram executed the wrong body");
+   end if;
+
+   -- For an object of type New_Camera, the initialization using Set_Ap 
+   -- should execute the overridden body, not the inherited one.
+
+   if C392005_0.C392005_1.TC_Get_Aper (New_Camera1) /= TC_Expected_New_Aper  
+   then
+      Report.Failed ("Non-dispatching call to visible overriding " &
+                     "subprogram executed the wrong body");
+   end if;
+
+   Report.Result;
+
+end C392005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392008.a
new file mode 100644
index 000000000..27b4e2a86
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392008.a
@@ -0,0 +1,401 @@
+-- C392008.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 use of a class-wide formal parameter allows for the 
+--      proper dispatching of objects to the appropriate implementation of 
+--      a primitive operation.  Check this for the case where the root tagged
+--      type is defined in a package and the extended type is defined in a
+--      dependent package.
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged type, and some associated primitive operations,
+--      in a visible library package.
+--      Extend the root type in another visible library package, and override 
+--      one or more primitive operations, inheriting the other primitive 
+--      operations from the root type.
+--      Derive from the extended type in yet another visible library package, 
+--      again overriding some primitive operations and inheriting others 
+--      (including some that the parent inherited).
+--      Define subprograms with class-wide parameters, inside of which is a 
+--      call on a dispatching primitive operation.  These primitive
+--      operations modify the objects of the specific class passed as actuals
+--      to the class-wide formal parameter (class-wide formal parameter has 
+--      mode IN OUT).
+--     
+-- The following hierarchy of tagged types and primitive operations is 
+-- utilized in this test:
+--
+--   package Bank
+--      type Account (root)
+--            |
+--            | Operations
+--            |     proc Deposit
+--            |     proc Withdrawal
+--            |     func Balance        
+--            |     proc Service_Charge 
+--            |     proc Add_Interest   
+--            |     proc Open
+--            |
+--   package Checking
+--      type Account (extended from Bank.Account)
+--            |
+--            | Operations
+--            |     proc Deposit         (inherited)
+--            |     proc Withdrawal      (inherited)
+--            |     func Balance         (inherited)
+--            |     proc Service_Charge  (inherited)
+--            |     proc Add_Interest    (inherited)
+--            |     proc Open            (overridden)
+--            |
+--   package Interest_Checking
+--      type Account (extended from Checking.Account)
+--            |
+--            | Operations
+--            |     proc Deposit         (inherited twice - Bank.Acct.)
+--            |     proc Withdrawal      (inherited twice - Bank.Acct.)
+--            |     func Balance         (inherited twice - Bank.Acct.)
+--            |     proc Service_Charge  (inherited twice - Bank.Acct.)
+--            |     proc Add_Interest    (overridden)
+--            |     proc Open            (overridden)
+--            |   
+--
+-- In this test, we are concerned with the following selection of dispatching
+-- calls, accomplished with the use of a Bank.Account'Class IN OUT formal
+-- parameter :
+--
+--                \ Type
+--        Prim. Op \  Bank.Account  Checking.Account Interest_Checking.Account
+--                  \---------------------------------------------------------
+
+--   Service_Charge |      X                X                 X
+--   Add_Interest   |      X                X                 X
+--   Open           |      X                X                 X
+--
+--
+--
+-- The location of the declaration of the root and derivation of extended
+-- types will be varied over a series of tests.  Locations of declaration
+-- and derivation for a particular test are marked with an asterisk (*).
+--
+-- Root type:
+--       
+--    *  Declared in package.
+--       Declared in generic package.
+--
+-- Extended types:
+--
+--       Derived in parent location.
+--       Derived in a nested package.
+--       Derived in a nested subprogram.
+--       Derived in a nested generic package.
+--    *  Derived in a separate package.
+--       Derived in a separate visible child package.
+--       Derived in a separate private child package.
+--
+-- Primitive Operations:
+--
+--    *  Procedures with same parameter profile.
+--       Procedures with different parameter profile.
+--       Functions with same parameter profile.
+--       Functions with different parameter profile.
+--       Mixture of Procedures and Functions.
+--
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         C392008_0.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      20 Nov 95   SAIC    C392B04 became C392008 for ACVC 2.0.1
+--
+--!
+
+----------------------------------------------------------------- C392008_0
+
+package C392008_0 is           -- package Bank
+
+  type Dollar_Amount is range -30_000..30_000; 
+ 
+   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 C392008_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body C392008_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
+      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 C392008_0;
+
+----------------------------------------------------------------- C392008_1
+
+with C392008_0;              -- package Bank
+
+package C392008_1 is      -- package Checking
+
+   package Bank renames C392008_0;
+
+   type Account is new Bank.Account with 
+      record
+         Overdraft_Fee : Bank.Dollar_Amount;
+      end record;
+
+   -- Overridden primitive operation.
+
+   procedure Open (A : in out Account);
+
+   -- 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);
+
+end C392008_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body C392008_1 is
+
+   -- Overridden primitive operation.
+
+   procedure Open (A : in out Account) is
+      Check_Guarantee : Bank.Dollar_Amount := 10_00;
+      Initial_Deposit : Bank.Dollar_Amount := 20_00;
+   begin
+      A.Current_Balance := Initial_Deposit;
+      A.Overdraft_Fee   := Check_Guarantee;
+   end Open;
+
+end C392008_1;
+
+----------------------------------------------------------------- C392008_2
+
+with C392008_0;             -- with Bank;
+with C392008_1;          -- with Checking;
+
+package C392008_2 is     -- package Interest_Checking
+
+   package Bank     renames C392008_0;
+   package Checking renames C392008_1;
+
+   subtype Interest_Rate is Bank.Dollar_Amount range 0..100; -- was digits 4;
+
+   Current_Rate : Interest_Rate := 0_02;
+
+   type Account is new Checking.Account with
+      record
+         Rate : Interest_Rate;
+      end record;
+
+   -- Overridden primitive operations.
+
+   procedure Add_Interest (A : in out Account);
+   procedure Open         (A : in out Account);
+
+   -- "Twice" inherited primitive operations (from Bank.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);
+
+end C392008_2;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body C392008_2 is
+
+   -- Overridden primitive operations.
+
+   procedure Add_Interest (A : in out Account) is
+      Interest_On_Account : Bank.Dollar_Amount
+        := Bank.Dollar_Amount( Bank."*"( A.Current_Balance, A.Rate ));
+   begin
+      A.Current_Balance := Bank."+"( A.Current_Balance, Interest_On_Account);
+   end Add_Interest;
+
+   procedure Open (A : in out Account) is
+      Initial_Deposit : Bank.Dollar_Amount := 30_00;
+   begin
+      Checking.Open (Checking.Account (A));
+      A.Current_Balance := Initial_Deposit;
+      A.Rate            := Current_Rate;
+   end Open;
+
+end C392008_2;
+
+------------------------------------------------------------------- C392008
+
+with C392008_0;    use C392008_0;          -- package Bank
+with C392008_1;    use C392008_1;        -- package Checking;
+with C392008_2;    use C392008_2;        -- package Interest_Checking;
+with Report;
+
+procedure C392008 is
+
+   package Bank              renames C392008_0;
+   package Checking          renames C392008_1;
+   package Interest_Checking renames C392008_2;
+
+   B_Acct  : Bank.Account;
+   C_Acct  : Checking.Account;
+   IC_Acct : Interest_Checking.Account;
+
+   --
+   -- Define procedures with class-wide formal parameters of mode IN OUT.
+   --
+
+   -- This procedure will perform a dispatching call on the
+   -- overridden primitive operation Open.
+
+   procedure New_Account (Acct : in out Bank.Account'Class) is
+   begin
+      Open (Acct);  -- Dispatch according to tag of class-wide parameter.
+   end New_Account;
+
+   -- This procedure will perform a dispatching call on the inherited
+   -- primitive operation (for all types derived from the root Bank.Account)
+   -- Service_Charge.
+
+   procedure Apply_Service_Charge (Acct: in out Bank.Account'Class) is
+   begin
+      Service_Charge (Acct);  -- Dispatch according to tag of class-wide parm.
+   end Apply_Service_Charge;
+
+   -- This procedure will perform a dispatching call on the 
+   -- inherited/overridden primitive operation Add_Interest.
+
+   procedure Annual_Interest (Acct: in out Bank.Account'Class) is
+   begin
+      Add_Interest (Acct);  -- Dispatch according to tag of class-wide parm.
+   end Annual_Interest;
+
+begin
+
+   Report.Test ("C392008",  "Check that the use of a class-wide formal "    &
+                            "parameter allows for the proper dispatching "  &
+                            "of objects to the appropriate implementation " &
+                            "of a primitive operation");
+
+   -- Check the dispatch to primitive operations overridden for each 
+   -- extended type.
+   New_Account (B_Acct);
+   New_Account (C_Acct);
+   New_Account (IC_Acct);
+   
+   if (B_Acct.Current_Balance  /= 10_00) or
+      (C_Acct.Current_Balance  /= 20_00) or
+      (IC_Acct.Current_Balance /= 30_00) 
+   then
+      Report.Failed ("Failed dispatch to multiply overridden prim. oper.");
+   end if;
+
+
+   Annual_Interest (B_Acct);
+   Annual_Interest (C_Acct);
+   Annual_Interest (IC_Acct); -- Check the dispatch to primitive operation 
+                              -- overridden from a parent type which inherited
+                              -- the operation from the root type.  
+   if (B_Acct.Current_Balance  /= 10_00) or
+      (C_Acct.Current_Balance  /= 20_00) or
+      (IC_Acct.Current_Balance /= 90_00)
+   then
+      Report.Failed ("Failed dispatch to overridden primitive operation");
+   end if;
+
+
+   Apply_Service_Charge (Acct => B_Acct);
+   Apply_Service_Charge (Acct => C_Acct);
+   Apply_Service_Charge (Acct => IC_Acct); -- Check the dispatch to a  
+                                           -- primitive operation twice 
+                                           -- inherited from the root
+                                           -- tagged type.
+   if (B_Acct.Current_Balance  /=  5_00) or
+      (C_Acct.Current_Balance  /= 15_00) or
+      (IC_Acct.Current_Balance /= 85_00) 
+   then
+      Report.Failed ("Failed dispatch to Apply_Service_Charge");
+   end if;
+
+   Report.Result;
+
+end C392008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392010.a
new file mode 100644
index 000000000..ec168780c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392010.a
@@ -0,0 +1,512 @@
+-- C392010.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 subprogram dispatches correctly with a controlling
+--     access parameter. Check that a subprogram dispatches correctly
+--     when it has access parameters that are not controlling.
+--     Check with and without default expressions.
+--
+-- TEST DESCRIPTION:
+--      The three packages define layers of tagged types.  The root tagged
+--      type contains a character value used to check that the right object
+--      got passed to the right routine.  Each subprogram has a unique
+--      TCTouch tag, upper case values are used for subprograms, lower case
+--      values are used for object values.
+--
+--      Notes on style: the "tagged" comment lines --I and --A represent
+--      commentary about what gets inherited and what becomes abstract,
+--      respectively.  The author felt these to be necessary with this test
+--      to reduce some of the additional complexities.
+--
+--3.9.2(16,17,18,20);6.0
+--
+-- CHANGE HISTORY:
+--      22 SEP 95   SAIC   Initial version
+--      22 APR 96   SAIC   Revised for 2.1
+--      05 JAN 98   EDS    Change return type of C392010_2.Func_W_Non to make
+--                         it override.
+--      21 JUN 00   RLB    Changed expected result to reflect the appropriate
+--                         value of the default expression.
+--      20 JUL 00   RLB    Removed entire call pending resolution by the ARG.
+
+--!
+
+----------------------------------------------------------------- C392010_0
+
+package C392010_0 is
+
+  -- define a root tagged type
+  type Tagtype_Level_0 is tagged record
+    Ch_Item : Character;
+  end record;
+
+  type Access_Procedure is access procedure( P: Tagtype_Level_0 );
+
+  procedure Proc_1( P: Tagtype_Level_0 );
+
+  procedure Proc_2( P: Tagtype_Level_0 );
+
+  function A_Default_Value return Tagtype_Level_0;
+
+  procedure Proc_w_Ap_and_Cp( AP : Access_Procedure;
+                              Cp : Tagtype_Level_0 );
+    -- has both access procedure and controlling parameter
+
+  procedure Proc_w_Ap_and_Cp_w_Def( AP : Access_Procedure := Proc_2'Access;
+                                    Cp : Tagtype_Level_0
+                                       := A_Default_Value );   ------------ z
+    -- has both access procedure and controlling parameter with defaults
+
+  -- for the objective:
+--     Check that access parameters may be controlling.
+
+  procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_0 );
+    -- has access parameter that is controlling
+
+  function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_0 )
+           return Tagtype_Level_0;
+    -- has access parameter that is controlling, and controlling result
+
+  Level_0_Global_Object : aliased Tagtype_Level_0
+                        := ( Ch_Item => 'a' );  ---------------------------- a
+
+end C392010_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+package body C392010_0 is
+
+  procedure Proc_1( P: Tagtype_Level_0 ) is
+  begin
+    TCTouch.Touch('A');  --------------------------------------------------- A
+    TCTouch.Touch(P.Ch_Item);  -- depends on the value passed -------------- ?
+  end Proc_1;
+
+  procedure Proc_2( P: Tagtype_Level_0 ) is
+  begin
+    TCTouch.Touch('B');  --------------------------------------------------- B
+    TCTouch.Touch(P.Ch_Item);  -- depends on the value passed -------------- ?
+  end Proc_2;
+
+  function A_Default_Value return Tagtype_Level_0 is
+  begin
+    return (Ch_Item => 'z');  ---------------------------------------------- z
+  end A_Default_Value;
+
+  procedure Proc_w_Ap_and_Cp( Ap : Access_Procedure;
+                              Cp : Tagtype_Level_0 ) is
+  begin
+    TCTouch.Touch('C');  --------------------------------------------------- C
+    Ap.all( Cp );
+  end Proc_w_Ap_and_Cp;
+
+  procedure Proc_w_Ap_and_Cp_w_Def( AP : Access_Procedure := Proc_2'Access;
+                                    Cp : Tagtype_Level_0
+                                       := A_Default_Value ) is
+  begin
+    TCTouch.Touch('D');  --------------------------------------------------- D
+    Ap.all( Cp );
+  end Proc_w_Ap_and_Cp_w_Def;
+
+  procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_0 ) is
+  begin
+    TCTouch.Touch('E');  --------------------------------------------------- E
+    TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
+  end Proc_w_Cp_Ap;
+
+  function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_0 )
+           return Tagtype_Level_0 is
+  begin
+    TCTouch.Touch('F');  --------------------------------------------------- F
+    TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
+    return ( Ch_Item => 'b' );  -------------------------------------------- b
+  end Func_w_Cp_Ap_and_Cr;
+
+end C392010_0;
+
+----------------------------------------------------------------- C392010_1
+
+with C392010_0;
+package C392010_1 is
+
+  type Tagtype_Level_1 is new C392010_0.Tagtype_Level_0 with record
+    Int_Item : Integer;
+  end record;
+
+  type Access_Tagtype_Level_1 is access all Tagtype_Level_1'Class;
+
+  -- the following procedures are inherited by the above declaration:
+  --I   procedure Proc_1( P: Tagtype_Level_1 );
+  --I
+  --I   procedure Proc_2( P: Tagtype_Level_1 );
+  --I
+  --I   procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
+  --I                               Cp : Tagtype_Level_1 );
+  --I
+  --I   procedure Proc_w_Ap_and_Cp_w_Def
+  --I             ( AP : C392010_0.Access_Procedure := Proc_2'Access;
+  --I               Cp : Tagtype_Level_1 := A_Default_Value );
+  --I
+  --I   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_1 );
+  --I
+
+  -- the following functions become abstract due to the above declaration:
+  --A   function A_Default_Value return Tagtype_Level_1;
+  --A
+  --A   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_1 )
+  --A            return Tagtype_Level_1;
+
+  -- so, in the interest of testing dispatching, we override them all:
+     -- except Proc_1 and Proc_2
+
+  procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
+                              Cp : Tagtype_Level_1 );
+
+  function A_Default_Value return Tagtype_Level_1;
+
+  procedure Proc_w_Ap_and_Cp_w_Def(
+              AP : C392010_0.Access_Procedure := C392010_0.Proc_2'Access;
+              Cp : Tagtype_Level_1 := A_Default_Value );
+
+ procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_1 );
+
+  function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_1 )
+           return Tagtype_Level_1;
+
+  -- to test the objective:
+--     Check that a subprogram dispatches correctly when it has
+--     access parameters that are not controlling.
+
+  procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_1;
+                        NonCp_Ap : access C392010_0.Tagtype_Level_0
+                             := C392010_0.Level_0_Global_Object'Access );
+
+  function Func_w_Non( Cp_Ap : access Tagtype_Level_1;
+                    NonCp_Ap : access C392010_0.Tagtype_Level_0
+                             := C392010_0.Level_0_Global_Object'Access )
+           return Access_Tagtype_Level_1;
+
+  Level_1_Global_Object : aliased Tagtype_Level_1
+                        := ( Int_Item => 0,
+                             Ch_Item  => 'c' );  --------------------------- c
+
+end C392010_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+package body C392010_1 is
+
+  procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
+                              Cp : Tagtype_Level_1 ) is
+  begin
+    TCTouch.Touch('G');  --------------------------------------------------- G
+    Ap.All( C392010_0.Tagtype_Level_0( Cp ) );
+  end Proc_w_Ap_and_Cp;
+
+  procedure Proc_w_Ap_and_Cp_w_Def(
+              AP : C392010_0.Access_Procedure := C392010_0.Proc_2'Access;
+              Cp : Tagtype_Level_1 := A_Default_Value )
+  is
+  begin
+    TCTouch.Touch('H');  --------------------------------------------------- H
+    Ap.All( C392010_0.Tagtype_Level_0( Cp ) );
+  end Proc_w_Ap_and_Cp_w_Def;
+
+  procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_1 ) is
+  begin
+    TCTouch.Touch('I');  --------------------------------------------------- I
+    TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
+  end Proc_w_Cp_Ap;
+
+  function A_Default_Value return Tagtype_Level_1 is
+  begin
+    return ( Int_Item => 0, Ch_Item  => 'y' );  ---------------------------- y
+  end A_Default_Value;
+
+  function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_1 )
+           return Tagtype_Level_1 is
+  begin
+    TCTouch.Touch('J');  --------------------------------------------------- J
+    TCTouch.Touch(Cp_Ap.Ch_Item);  -- depends on the value passed ---------- ?
+    return ( Int_Item => 2, Ch_Item => 'd' );  ----------------------------- d
+  end Func_w_Cp_Ap_and_Cr;
+
+  procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_1;
+                        NonCp_Ap : access C392010_0.Tagtype_Level_0
+                          := C392010_0.Level_0_Global_Object'Access ) is
+  begin
+    TCTouch.Touch('K');  --------------------------------------------------- K
+    TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
+    TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
+  end Proc_w_Non;
+
+  Own_Item : aliased Tagtype_Level_1 := ( Int_Item => 3, Ch_Item => 'e' );
+
+  function Func_w_Non( Cp_Ap : access Tagtype_Level_1;
+                    NonCp_Ap : access C392010_0.Tagtype_Level_0
+                             := C392010_0.Level_0_Global_Object'Access )
+           return Access_Tagtype_Level_1 is
+  begin
+    TCTouch.Touch('L');  --------------------------------------------------- L
+    TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
+    TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
+    return Own_Item'Access;  ----------------------------------------------- e
+  end Func_w_Non;
+
+end C392010_1;
+
+
+
+----------------------------------------------------------------- C392010_2
+
+with C392010_0;
+with C392010_1;
+package C392010_2 is
+
+  Lev2_Level_0_Global_Object : aliased C392010_0.Tagtype_Level_0
+                        := ( Ch_Item => 'f' );  ---------------------------- f
+
+  type Tagtype_Level_2 is new C392010_1.Tagtype_Level_1 with record
+    Another_Int_Item : Integer;
+  end record;
+
+  type Access_Tagtype_Level_2 is access all Tagtype_Level_2;
+
+  -- the following procedures are inherited by the above declaration:
+  --I   procedure Proc_1( P: Tagtype_Level_2 );
+  --I
+  --I   procedure Proc_2( P: Tagtype_Level_2 );
+  --I
+  --I   procedure Proc_w_Ap_and_Cp( AP : C392010_0.Access_Procedure;
+  --I                               Cp : Tagtype_Level_2 );
+  --I
+  --I   procedure Proc_w_Ap_and_Cp_w_Def
+  --I             (AP: C392010_0.Access_Procedure := C392010_0. Proc_2'Access;
+  --I              CP: Tagtype_Level_2 := A_Default_Value );
+  --I
+  --I   procedure Proc_w_Cp_Ap( Cp_Ap : access Tagtype_Level_2 );
+  --I
+  --I   procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_2;
+  --I                         NonCp_Ap : access C392010_0.Tagtype_Level_0
+  --I                           := C392010_0.Level_0_Global_Object'Access );
+
+  -- the following functions become abstract due to the above declaration:
+  --A   function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_2 )
+  --A            return Tagtype_Level_2;
+  --A
+  --A   function A_Default_Value
+  --A            return Access_Tagtype_Level_2;
+
+  -- so we override the interesting ones to check the objective:
+--     Check that a subprogram with parameters of distinct tagged types may
+--     be primitive for only one type (i.e. the other tagged types must be
+--     declared in other packages).  Check that the subprogram does not
+--     dispatch for the other type(s).
+
+  procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_2;
+                        NonCp_Ap : access C392010_0.Tagtype_Level_0
+                                   := Lev2_Level_0_Global_Object'Access );
+
+  function Func_w_Non( Cp_Ap : access Tagtype_Level_2;
+                    NonCp_Ap : access C392010_0.Tagtype_Level_0
+                                      := Lev2_Level_0_Global_Object'Access )
+           return C392010_1.Access_Tagtype_Level_1;
+
+  -- and override the other abstract functions
+  function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_2 )
+           return Tagtype_Level_2;
+
+  function A_Default_Value return Tagtype_Level_2;
+
+end C392010_2;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+with Report;
+package body C392010_2 is
+
+  procedure Proc_w_Non( Cp_Ap    : access Tagtype_Level_2;
+                          NonCp_Ap : access C392010_0.Tagtype_Level_0
+                                   := Lev2_Level_0_Global_Object'Access ) is
+  begin
+    TCTouch.Touch('M');  --------------------------------------------------- M
+    TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
+    TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
+  end Proc_w_Non;
+
+  function A_Default_Value return Tagtype_Level_2 is
+  begin
+     return ( Another_Int_Item | Int_Item => 0, Ch_Item  => 'x' );  -------- x
+  end A_Default_Value;
+
+  Own : aliased Tagtype_Level_2
+                 := ( Another_Int_Item | Int_Item => 4, Ch_Item => 'g' );
+
+  function Func_w_Non( Cp_Ap : access Tagtype_Level_2;
+                             NonCp_Ap : access C392010_0.Tagtype_Level_0
+                                      := Lev2_Level_0_Global_Object'Access )
+           return C392010_1.Access_Tagtype_Level_1 is
+  begin
+    TCTouch.Touch('N');  --------------------------------------------------- N
+    TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
+    TCTouch.Touch(NonCp_Ap.Ch_Item);  -- depends on the value passed ------- ?
+    return Own'Access;  ---------------------------------------------------- g
+  end Func_w_Non;
+
+  function Func_w_Cp_Ap_and_Cr( Cp_Ap : access Tagtype_Level_2 )
+           return Tagtype_Level_2 is
+  begin
+    TCTouch.Touch('P');  --------------------------------------------------- P
+    TCTouch.Touch(Cp_Ap.Ch_Item);  ----- depends on the value passed ------- ?
+    return ( Another_Int_Item | Int_Item => 5, Ch_Item => 'h' );  ---------- h
+ end Func_w_Cp_Ap_and_Cr;
+
+end C392010_2;
+
+
+
+------------------------------------------------------------------- C392010
+
+with Report;
+with TCTouch;
+with C392010_0, C392010_1, C392010_2;
+
+procedure C392010 is
+
+  type Access_Class_0 is access all C392010_0.Tagtype_Level_0'Class;
+
+  -- define an array of class-wide pointers:
+  type Zero_Dispatch_List is array(Natural range <>) of Access_Class_0;
+
+  Item_0 : aliased C392010_0.Tagtype_Level_0 := ( Ch_Item  => 'k' );  ------ k
+  Item_1 : aliased C392010_1.Tagtype_Level_1 := ( Ch_Item  => 'm',    ------ m
+                                                  Int_Item => 1 );
+  Item_2 : aliased C392010_2.Tagtype_Level_2 := ( Ch_Item  => 'n',    ------ n
+                                                  Int_Item => 1,
+                                                  Another_Int_Item => 1 );
+
+  Z: Zero_Dispatch_List(1..3) := (Item_0'Access,Item_1'Access,Item_2'Access);
+
+  procedure Subtest_1( Items: Zero_Dispatch_List ) is
+    -- there is little difference between the actions for _1 and _2 in
+    -- this subtest due to the nature of _2 inheriting most operations
+    --
+    -- this subtest checks operations available to Level_0'Class
+  begin
+    for I in Items'Range loop
+
+      C392010_0.Proc_w_Ap_and_Cp( C392010_0.Proc_1'Access, Items(I).all );
+      -- CAk, GAm, GAn
+      -- actual is class-wide, operation should dispatch
+
+      case I is  -- use defaults
+        when 1 => C392010_0.Proc_w_Ap_and_Cp_w_Def;
+                  -- DBz
+        when 2 => C392010_1.Proc_w_Ap_and_Cp_w_Def;
+                  -- HBy
+        when 3 => null; -- Removed following pending resolution by ARG
+                  -- (see AI-00239):
+                  -- C392010_2.Proc_w_Ap_and_Cp_w_Def;
+                  -- HBx
+        when others => Report.Failed("Unexpected loop value");
+      end case;
+
+      C392010_0.Proc_w_Ap_and_Cp_w_Def   -- override defaults
+                ( C392010_0.Proc_1'Access, Items(I).all );
+      -- DAk, HAm, HAn
+
+      C392010_0.Proc_w_Cp_Ap( Items(I) );
+      -- Ek, Im, In
+
+      -- function return value is controlling for procedure call
+      C392010_0.Proc_w_Ap_and_Cp_w_Def( C392010_0.Proc_1'Access,
+                                  C392010_0.Func_w_Cp_Ap_and_Cr( Items(I) ) );
+      -- FkDAb, JmHAd, PnHAh
+      -- note that the function evaluates first
+
+    end loop;
+  end Subtest_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  type Access_Class_1 is access all C392010_1.Tagtype_Level_1'Class;
+
+  type One_Dispatch_List is array(Natural range <>) of Access_Class_1;
+
+  Object_1 : aliased C392010_1.Tagtype_Level_1 := ( Ch_Item  => 'p',   ----- p
+                                                    Int_Item => 1 );
+  Object_2 : aliased C392010_2.Tagtype_Level_2 := ( Ch_Item  => 'q',   ----- q
+                                                    Int_Item => 1,
+                                            Another_Int_Item => 1 );
+
+  D: One_Dispatch_List(1..2) := (Object_1'Access, Object_2'Access);
+
+  procedure Subtest_2( Items: One_Dispatch_List ) is
+    -- this subtest checks operations available to Level_1'Class,
+    -- specifically those operations that are not testable in subtest_1,
+    -- the operations with parameters of the two tagged type objects.
+  begin
+    for I in Items'Range loop
+
+       C392010_1.Proc_w_Non(                               -- t_1,   t_2
+         C392010_1.Func_w_Non( Items(I),
+           C392010_0.Tagtype_Level_0(Z(I).all)'Access ),   -- Lpk    Nqm
+           C392010_0.Tagtype_Level_0(Z(I+1).all)'Access ); -- Kem    Mgn
+
+    end loop;
+  end Subtest_2;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C392010", "Check that a subprogram dispatches correctly " &
+                          "with a controlling access parameter. " &
+                          "Check that a subprogram dispatches correctly " &
+                          "when it has access parameters that are not " &
+                          "controlling. Check with and without default " &
+                          "expressions" );
+
+  Subtest_1( Z );
+
+  -- Original result:
+  --TCTouch.Validate( "CAkDBzDAkEkFkDAb"
+  --                & "GAmHByHAmImJmHAd"
+  --                & "GAnHBxHAnInPnHAh", "Subtest 1" );
+
+  -- Result pending resultion of AI-239:
+  TCTouch.Validate( "CAkDBzDAkEkFkDAb"
+                  & "GAmHByHAmImJmHAd"
+                  & "GAnHAnInPnHAh", "Subtest 1" );
+
+  Subtest_2( D );
+
+  TCTouch.Validate( "LpkKem" & "NqmMgn", "Subtest 2" );
+
+  Report.Result;
+
+end C392010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392011.a
new file mode 100644
index 000000000..c32ec77c0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392011.a
@@ -0,0 +1,299 @@
+-- C392011.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 function call with a controlling result is itself
+--     a controlling operand of an enclosing call on a dispatching operation,
+--     then its controlling tag value is determined by the controlling tag
+--     value of the enclosing call.
+--
+-- TEST DESCRIPTION:
+--      The test builds and traverses a "ragged" list; a linked list which
+--      contains data elements of three different types (all rooted at
+--      Level_0'Class).  The traversal of this list checks the objective
+--      by calling the dispatching operation "Check" using an item from the
+--      list, and calling the function create; thus causing the controlling
+--      result of the function to be determined by evaluating the value of
+--      the other controlling parameter to the two-parameter Check.
+--
+--
+-- CHANGE HISTORY:
+--      22 SEP 95   SAIC   Initial version
+--      23 APR 96   SAIC   Corrected commentary, differentiated integer.
+--
+--!
+
+----------------------------------------------------------------- C392011_0
+
+package C392011_0 is
+
+  type Level_0 is tagged record
+    Ch_Item : Character;
+  end record;
+
+  function Create return Level_0;
+    -- primitive dispatching function
+
+  procedure Check( Left, Right: in Level_0 );
+    -- has controlling parameters
+
+end C392011_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with TCTouch;
+package body C392011_0 is
+
+  The_Character : Character := 'A';
+
+  function Create return Level_0 is
+    Created_Item_0 : constant Level_0 := ( Ch_Item => The_Character );
+  begin
+    The_Character := Character'Succ(The_Character);
+    TCTouch.Touch('A'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- A
+    return Created_Item_0;
+  end Create;
+
+  procedure Check( Left, Right: in Level_0 ) is
+  begin
+    TCTouch.Touch('B'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- B
+  end Check;
+
+end C392011_0;
+
+----------------------------------------------------------------- C392011_1
+
+with C392011_0;
+package C392011_1 is
+
+  type Level_1 is new C392011_0.Level_0 with record
+    Int_Item : Integer;
+  end record;
+  
+  -- note that Create becomes abstract upon this derivation hence:
+
+  function Create return Level_1;
+
+  procedure Check( Left, Right: in Level_1 );
+
+end C392011_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+package body C392011_1 is
+
+  Integer_1 : Integer := 0;
+
+  function Create return Level_1 is
+    Created_Item_1 : constant Level_1
+                   := ( C392011_0.Create with Int_Item => Integer_1 );
+    -- note call to     ^--------------^   -- A
+  begin
+    Integer_1 := Integer'Succ(Integer_1);
+    TCTouch.Touch('C'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- C
+    return Created_Item_1;
+  end Create;
+
+  procedure Check( Left, Right: in Level_1 ) is
+  begin
+    TCTouch.Touch('D'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- D
+  end Check;
+
+end C392011_1;
+
+----------------------------------------------------------------- C392011_2
+
+with C392011_1;
+package C392011_2 is
+
+  type Level_2 is new C392011_1.Level_1 with record
+    Another_Int_Item : Integer;
+  end record;
+  
+  -- note that Create becomes abstract upon this derivation hence:
+
+  function Create return Level_2;
+
+  procedure Check( Left, Right: in Level_2 );
+
+end C392011_2;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+package body C392011_2 is
+
+  Integer_2 : Integer := 100;
+
+  function Create return Level_2 is
+    Created_Item_2 : constant Level_2
+                 := ( C392011_1.Create with Another_Int_Item => Integer_2 );
+    -- note call to   ^--------------^   -- AC
+  begin
+    Integer_2 := Integer'Succ(Integer_2);
+    TCTouch.Touch('E'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- E
+    return Created_Item_2;
+  end Create;
+
+  procedure Check( Left, Right: in Level_2 ) is
+  begin
+    TCTouch.Touch('F'); -- --- ---- ----- ---- --- -- --- ---- ----- ---- -- F
+  end Check;
+
+end C392011_2;
+
+------------------------------------------------------- C392011_2.C392011_3
+
+with C392011_0;
+package C392011_2.C392011_3 is
+
+  type Wide_Reference is access all C392011_0.Level_0'Class;
+
+  type Ragged_Element;
+
+  type List_Pointer is access Ragged_Element;
+
+  type Ragged_Element is record
+    Data : Wide_Reference;
+    Next : List_Pointer;
+  end record;
+
+  procedure Build_List;
+
+  procedure Traverse_List;
+
+end C392011_2.C392011_3;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body C392011_2.C392011_3 is
+
+  The_List : List_Pointer;
+
+  procedure Build_List is
+  begin
+
+    -- build a list that looks like:
+    -- Level_2, Level_1, Level_2, Level_1, Level_0
+    --
+    -- the mechanism is to create each object, "pushing" the existing list
+    -- onto the end: cons( new_item, car, cdr )
+
+    The_List := 
+        new Ragged_Element'( new C392011_0.Level_0'(C392011_0.Create), null );
+    -- Level_0                                                            >> A
+
+    The_List := 
+    new Ragged_Element'( new C392011_1.Level_1'(C392011_1.Create), The_List );
+    -- Level_1 -> Level_0                                                >> AC
+
+    The_List := 
+    new Ragged_Element'( new C392011_2.Level_2'(C392011_2.Create), The_List );
+    -- Level_2 -> Level_1 -> Level_0                                    >> ACE
+
+    The_List := 
+    new Ragged_Element'( new C392011_1.Level_1'(C392011_1.Create), The_List );
+    -- Level_1 -> Level_2 -> Level_1 -> Level_0                          >> AC
+
+    The_List := 
+    new Ragged_Element'( new C392011_2.Level_2'(C392011_2.Create), The_List );
+    -- Level_2 -> Level_1 -> Level_2 -> Level_1 -> Level_0              >> ACE
+
+  end Build_List;
+
+  procedure Traverse_List is
+
+    Next_Item : List_Pointer := The_List;
+
+  -- Check that if a function call with a controlling result is itself
+  -- a controlling operand of an enclosing call on a dispatching operation,
+  -- then its controlling tag value is determined by the controlling tag
+  -- value of the enclosing call.
+
+  -- Level_2 -> Level_1 -> Level_2 -> Level_1 -> Level_0
+
+  begin
+
+    while Next_Item /= null loop  -- here we go!
+      -- these calls better dispatch according to the value in the particular
+      -- list item; causing the call to create to dispatch accordingly.
+      -- why do it twice?  To make sure order makes no difference
+
+      C392011_0.Check(Next_Item.Data.all, C392011_0.Create);
+      -- Create will touch first, then Check touches
+
+      C392011_0.Check(C392011_0.Create, Next_Item.Data.all); 
+
+      -- Here's what's s'pos'd to 'appen:
+      -- Check( Lev_2, Create ) >> ACEF
+      -- Check( Create, Lev_2 ) >> ACEF
+      -- Check( Lev_1, Create ) >> ACD
+      -- Check( Create, Lev_1 ) >> ACD
+      -- Check( Lev_2, Create ) >> ACEF
+      -- Check( Create, Lev_2 ) >> ACEF
+      -- Check( Lev_1, Create ) >> ACD
+      -- Check( Create, Lev_1 ) >> ACD
+      -- Check( Lev_0, Create ) >> AB
+      -- Check( Create, Lev_0 ) >> AB
+
+      Next_Item := Next_Item.Next;   
+    end loop;
+  end Traverse_List;
+
+end C392011_2.C392011_3;
+
+------------------------------------------------------------------- C392011
+
+with Report;
+with TCTouch;
+with C392011_2.C392011_3;
+
+procedure C392011 is
+
+begin  -- Main test procedure.
+
+  Report.Test ("C392011", "Check that if a function call with a " &
+                          "controlling result is itself a controlling " &
+                          "operand of an enclosing call on a dispatching " &
+                          "operation, then its controlling tag value is " &
+                          "determined by the controlling tag value of " &
+                          "the enclosing call" );
+
+  C392011_2.C392011_3.Build_List;
+  TCTouch.Validate( "A" & "AC" & "ACE" & "AC" & "ACE", "Build List" );
+
+  C392011_2.C392011_3.Traverse_List;
+  TCTouch.Validate( "ACEFACEF" & 
+                    "ACDACD" &  
+                    "ACEFACEF" &  
+                    "ACDACD" &  
+                    "ABAB",
+                    "Traverse List" );
+
+  Report.Result;
+
+end C392011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392013.a
new file mode 100644
index 000000000..3873d9e62
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392013.a
@@ -0,0 +1,179 @@
+-- C392013.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that the "/=" implicitly declared with the declaration of "=" for
+--    a tagged type is legal and can be used in a dispatching call.
+--    (Defect Report 8652/0010, as reflected in Technical Corrigendum 1).
+--
+-- CHANGE HISTORY:
+--    23 JAN 2001   PHL   Initial version.
+--    16 MAR 2001   RLB   Readied for release; added identity and negative
+--                        result cases.
+--    24 MAY 2001   RLB   Corrected the result for the 9 vs. 9 case.
+--!
+with Report;
+use Report;
+procedure C392013 is
+
+    package P1 is
+        type T is tagged
+            record
+                C1 : Integer;
+            end record;
+        function "=" (L, R : T) return Boolean;
+    end P1;
+
+    package P2 is
+        type T is new P1.T with private;
+        function Make (Ancestor : P1.T; X : Float) return T;
+    private
+        type T is new P1.T with
+            record
+                C2 : Float;
+            end record;
+        function "=" (L, R : T) return Boolean;
+    end P2;
+
+    package P3 is
+        type T is new P2.T with
+            record
+                C3 : Character;
+            end record;
+    private
+        function "=" (L, R : T) return Boolean;
+        function Make (Ancestor : P1.T; X : Float) return T;
+    end P3;
+
+
+    package body P1 is separate;
+    package body P2 is separate;
+    package body P3 is separate;
+
+
+    type Cwat is access P1.T'Class;
+    type Cwat_Array is array (Positive range <>) of Cwat;
+
+    A : constant Cwat_Array :=
+       (1 => new P1.T'(C1 => Ident_Int (3)),
+        2 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (5)), X => 4.0)),
+        3 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (-5)), X => 4.2)),
+        4 => new P1.T'(C1 => Ident_Int (-3)),
+        5 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (5)), X => 3.6)),
+        6 => new P1.T'(C1 => Ident_Int (4)),
+        7 => new P3.T'(P2.Make
+                          (Ancestor => (C1 => Ident_Int (4)), X => 1.2) with
+                       Ident_Char ('a')),
+        8 => new P3.T'(P2.Make
+                          (Ancestor => (C1 => Ident_Int (-4)), X => 1.3) with
+                       Ident_Char ('A')),
+        9 => new P3.T'(P2.Make
+                          (Ancestor => (C1 => Ident_Int (4)), X => 1.0) with
+                       Ident_Char ('B')));
+
+    type Truth is ('F', 'T');
+    type Truth_Table is array (Positive range <>, Positive range <>) of Truth;
+
+    Equality : constant Truth_Table (A'Range, A'Range) := ("TFFTFFFFF",
+                                                           "FTTFTFFFF",
+                                                           "FTTFFFFFF",
+                                                           "TFFTFFFFF",
+                                                           "FTFFTFFFF",
+                                                           "FFFFFTFFF",
+                                                           "FFFFFFTTF",
+                                                           "FFFFFFTTF",
+                                                           "FFFFFFFFT");
+
+begin
+    Test ("C392013", "Check that the ""/="" implicitly declared " &
+                        "with the declaration of ""="" for a tagged " &
+                        "type is legal and can be used in a dispatching call");
+
+    for I in A'Range loop
+        for J in A'Range loop
+	    -- Test identity:
+            if P1."=" (A (I).all, A (J).all) /=
+                  (not P1."/=" (A (I).all, A (J).all)) then
+                Failed ("Incorrect identity comparing objects" &
+                        Positive'Image (I) & " and" & Positive'Image (J));
+            end if;
+            -- Test the result of "/=":
+            if Equality (I, J) = 'T' then
+                if P1."/=" (A (I).all, A (J).all) then
+                    Failed ("Incorrect result comparing objects" &
+                           Positive'Image (I) & " and" & Positive'Image (J) & " - T");
+                end if;
+            else
+                if not P1."/=" (A (I).all, A (J).all) then
+                    Failed ("Incorrect result comparing objects" &
+                           Positive'Image (I) & " and" & Positive'Image (J) & " - F");
+                end if;
+            end if;
+        end loop;
+    end loop;
+
+    Result;
+end C392013;
+separate (C392013)
+package body P1 is
+
+    function "=" (L, R : T) return Boolean is
+    begin
+        return abs L.C1 = abs R.C1;
+    end "=";
+
+end P1;
+separate (C392013)
+package body P2 is
+
+    function "=" (L, R : T) return Boolean is
+    begin
+        return P1."=" (P1.T (L), P1.T (R)) and then abs (L.C2 - R.C2) <= 0.5;
+    end "=";
+
+
+    function Make (Ancestor : P1.T; X : Float) return T is
+    begin
+        return (Ancestor with X);
+    end Make;
+
+end P2;
+with Ada.Characters.Handling;
+separate (C392013)
+package body P3 is
+
+    function "=" (L, R : T) return Boolean is
+    begin
+        return P2."=" (P2.T (L), P2.T (R)) and then
+                  Ada.Characters.Handling.To_Upper (L.C3) =
+                     Ada.Characters.Handling.To_Upper (R.C3);
+    end "=";
+
+    function Make (Ancestor : P1.T; X : Float) return T is
+    begin
+        return (P2.Make (Ancestor, X) with ' ');
+    end Make;
+
+end P3;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392014.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392014.a
new file mode 100644
index 000000000..8ecb4144b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392014.a
@@ -0,0 +1,227 @@
+-- C392014.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that objects designated by X'Access (where X is of a class-wide
+--    type) and new T'Class'(...) are dynamically tagged and can be used in
+--    dispatching calls.  (Defect Report 8652/0010).
+--
+-- CHANGE HISTORY:
+--    18 JAN 2001   PHL   Initial version
+--    15 MAR 2001   RLB   Readied for release.
+--    03 JUN 2004   RLB   Removed constraint for S0, as the subtype has
+--                        unknown discriminants.
+
+--!
+package C392014_0 is
+
+    type T (D : Integer) is abstract tagged private;
+
+    procedure P (X : access T) is abstract;
+    function Create (X : Integer) return T'Class;
+
+    Result : Natural := 0;
+
+private
+    type T (D : Integer) is abstract tagged null record;
+end C392014_0;
+
+with C392014_0;
+package C392014_1 is
+    type T is new C392014_0.T with private;
+    function Create (X : Integer) return T'Class;
+private
+    type T is new C392014_0.T with
+	record
+	    C1 : Integer;
+	end record;
+    procedure P (X : access T);
+end C392014_1;
+
+package C392014_1.Child is
+    type T is new C392014_1.T with private;
+    procedure P (X : access T);
+    function Create (X : Integer) return T'Class;
+private
+    type T is new C392014_1.T with
+	record
+	    C1C : Integer;
+	end record;
+end C392014_1.Child;
+
+with Report;
+use Report;
+with C392014_1.Child;
+package body C392014_1 is
+
+    procedure P (X : access T) is
+    begin
+	C392014_0.Result := C392014_0.Result + X.D + X.C1;
+    end P;
+
+    function Create (X : Integer) return T'Class is
+    begin
+	case X mod Ident_Int (2) is
+	    when 0 =>
+		return C392014_1.Child.Create (X / Ident_Int (2));
+	    when 1 =>
+		declare
+		    Y : T (D => (X / Ident_Int (2)) mod Ident_Int (20));
+		begin
+		    Y.C1 := X / Ident_Int (40);
+		    return T'Class (Y);
+		end;
+	    when others =>
+		null;
+	end case;
+    end Create;
+
+end C392014_1;
+
+with C392014_0;
+with C392014_1;
+package C392014_2 is
+    type T is new C392014_0.T with private;
+    function Create (X : Integer) return T'Class;
+private
+    type T is new C392014_1.T with
+	record
+	    C2 : Integer;
+	end record;
+    procedure P (X : access T);
+end C392014_2;
+
+with Report;
+use Report;
+with C392014_1.Child;
+with C392014_2;
+package body C392014_0 is
+
+    function Create (X : Integer) return T'Class is
+    begin
+	case X mod 3 is
+	    when 0 =>
+		return C392014_1.Create (X / Ident_Int (3));
+	    when 1 =>
+		return C392014_1.Child.Create (X / Ident_Int (3));
+	    when 2 =>
+		return C392014_2.Create (X / Ident_Int (3));
+	    when others =>
+		null;
+	end case;
+    end Create;
+
+end C392014_0;
+
+with Report;
+use Report;
+with C392014_0;
+package body C392014_1.Child is
+
+    procedure P (X : access T) is
+    begin
+	C392014_0.Result := C392014_0.Result + X.D + X.C1 + X.C1C;
+    end P;
+
+    function Create (X : Integer) return T'Class is
+	Y : T (D => X mod Ident_Int (20));
+    begin
+	Y.C1 := (X / Ident_Int (20)) mod Ident_Int (20);
+	Y.C1C := X / Ident_Int (400);
+	return T'Class (Y);
+    end Create;
+
+end C392014_1.Child;
+
+with Report;
+use Report;
+package body C392014_2 is
+
+    procedure P (X : access T) is
+    begin
+	C392014_0.Result := C392014_0.Result + X.D + X.C2;
+    end P;
+
+    function Create (X : Integer) return T'Class is
+	Y : T (D => X mod Ident_Int (20));
+    begin
+	Y.C2 := X / Ident_Int (600);
+	return T'Class (Y);
+    end Create;
+
+end C392014_2;
+
+with Report;
+use Report;
+with C392014_0;
+with C392014_1.Child;
+with C392014_2;
+procedure C392014 is
+
+    subtype S0 is C392014_0.T'Class;
+    subtype S1 is C392014_1.T'Class;
+
+    X0 : aliased C392014_0.T'Class := C392014_0.Create (Ident_Int (5218));
+    X1 : aliased C392014_1.T'Class := C392014_1.Create (Ident_Int (8253));
+
+    Y0 : aliased S0 := C392014_0.Create (Ident_Int (2693));
+    Y1 : aliased S1 := C392014_1.Create (Ident_Int (5622));
+
+    procedure TC_Check (Subtest : String; Expected : Integer) is
+    begin
+	if C392014_0.Result = Expected then
+	    Comment ("Subtest " & Subtest & " Passed");
+	else
+	    Failed ("Subtest " & Subtest & " Failed");
+	end if;
+	C392014_0.Result := Ident_Int (0);
+    end TC_Check;
+
+begin
+    Test ("C392014",
+	  "Check that objects designated by X'Access " &
+	     "(where X is of a class-wide type) and New T'Class'(...) " &
+	     "are dynamically tagged and can be used in dispatching " &
+	     "calls");
+
+    C392014_0.P (X0'Access);
+    TC_Check ("X0'Access", Ident_Int (29));
+    C392014_0.P (new C392014_0.T'Class'(C392014_0.Create (Ident_Int (12850))));
+    TC_Check ("New C392014_0.T'Class", Ident_Int (27));
+    C392014_1.P (X1'Access);
+    TC_Check ("X1'Access", Ident_Int (212));
+    C392014_1.P (new C392014_1.T'Class'(C392014_1.Create (Ident_Int (2031))));
+    TC_Check ("New C392014_1.T'Class", Ident_Int (65));
+    C392014_0.P (Y0'Access);
+    TC_Check ("Y0'Access", Ident_Int (18));
+    C392014_0.P (new S0'(C392014_0.Create (Ident_Int (6893))));
+    TC_Check ("New S0", Ident_Int (20));
+    C392014_1.P (Y1'Access);
+    TC_Check ("Y1'Access", Ident_Int (18));
+    C392014_1.P (new S1'(C392014_1.Create (Ident_Int (1861))));
+    TC_Check ("New S1", Ident_Int (56));
+
+    Result;
+end C392014;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392a01.a
new file mode 100644
index 000000000..8ad789142
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392a01.a
@@ -0,0 +1,265 @@
+-- C392A01.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 use of a class-wide formal parameter allows for the 
+ --      proper dispatching of objects to the appropriate implementation of 
+ --      a primitive operation.  Check this for the root tagged type defined
+ --      in a package, and the extended type is defined in that same package.
+ --
+ -- TEST DESCRIPTION:
+ --      Declare a root tagged type, and some associated primitive operations.
+ --      Extend the root type, and override one or more primitive operations, 
+ --      inheriting the other primitive operations from the root type.
+ --      Derive from the extended type, again overriding some primitive
+ --      operations and inheriting others (including some that the parent 
+ --      inherited).
+ --      Define a subprogram with a class-wide parameter, inside of which is a 
+ --      call on a dispatching primitive operation.  These primitive operations
+ --      modify global variables (the class-wide parameter has mode IN).
+ --     
+ --     
+ --     
+ -- The following hierarchy of tagged types and primitive operations is 
+ -- utilized in this test:
+ --
+ --    type Bank_Account (root)
+ --            |
+ --            | Operations
+ --            |   Increment_Bank_Reserve
+ --            |   Assign_Representative
+ --            |   Increment_Counters
+ --            |   Open
+ --            |
+ --    type Savings_Account (extended from Bank_Account)
+ --            |
+ --            | Operations
+ --            |   (Increment_Bank_Reserve) (inherited)
+ --            |   Assign_Representative    (overridden)
+ --            |   Increment_Counters       (overridden)
+ --            |   Open                     (overridden)
+ --            |
+ --    type Preferred_Account (extended from Savings_Account)
+ --            |
+ --            | Operations
+ --            |   (Increment_Bank_Reserve) (inherited twice - Bank_Acct.)
+ --            |   (Assign_Representative)  (inherited - Savings_Acct.)
+ --            |   Increment_Counters       (overridden)
+ --            |   Open                     (overridden)
+ -- 
+ --
+ -- In this test, we are concerned with the following selection of dispatching
+ -- calls, accomplished with the use of a Bank_Account'Class IN procedure 
+ -- parameter :
+ --
+ --                       \ Type
+ --               Prim. Op \  Bank_Account  Savings_Account Preferred_Account
+ --                         \------------------------------------------------ 
+ --   Increment_Bank_Reserve|      X               X               X
+ --   Assign_Representative |                      X
+ --   Increment_Counters    |      X               X               X
+ --
+ --
+ --
+ -- The location of the declaration and derivation of the root and extended
+ -- types will be varied over a series of tests.  Locations of declaration
+ -- and derivation for a particular test are marked with an asterisk (*).
+ --
+ -- Root type:
+ --       
+ --    *  Declared in package.
+ --       Declared in generic package.
+ --
+ -- Extended types:
+ --
+ --    *  Derived in parent location.
+ --       Derived in a nested package.
+ --       Derived in a nested subprogram.
+ --       Derived in a nested generic package.
+ --       Derived in a separate package.
+ --       Derived in a separate visible child package.
+ --       Derived in a separate private child package.
+ --
+ -- Primitive Operations:
+ --
+ --    *  Procedures with same parameter profile.
+ --       Procedures with different parameter profile.
+ --       Functions with same parameter profile.
+ --       Functions with different parameter profile.
+ --       Mixture of Procedures and Functions.
+ --
+ --
+ -- TEST FILES:
+ --      This test depends on the following foundation code:
+ --
+ --         F392A00.A
+ --
+ --      The following files comprise this test:
+ --
+ --      => C392A01.A
+ --
+ --
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+ --!
+ 
+ with F392A00;         -- package Accounts
+ with Report;
+ 
+ procedure C392A01 is
+ 
+    package Accounts renames F392A00;
+ 
+    -- Declare account objects.
+ 
+    B_Account : Accounts.Bank_Account;
+    S_Account : Accounts.Savings_Account;
+    P_Account : Accounts.Preferred_Account;
+ 
+    -- Procedures to operate on accounts.
+    -- Each uses a class-wide IN parameter, as well as a call to a
+    -- dispatching operation.
+ 
+    -- Procedure Tabulate_Account performs a dispatching call on a primitive
+    -- operation that has been overridden for each of the extended types.
+ 
+    procedure Tabulate_Account (Acct : in Accounts.Bank_Account'Class) is
+    begin
+       Accounts.Increment_Counters (Acct);   -- Dispatch according to tag.
+    end Tabulate_Account;
+ 
+ 
+    -- Procedure Accumulate_Reserve performs a dispatching call on a
+    -- primitive operation that has been defined for the root type and 
+    -- inherited by each derived type.
+ 
+    procedure Accumulate_Reserve (Acct : in Accounts.Bank_Account'Class) is
+    begin
+       Accounts.Increment_Bank_Reserve (Acct);   -- Dispatch according to tag.
+    end Accumulate_Reserve;
+ 
+ 
+    -- Procedure Resolve_Dispute performs a dispatching call on a primitive
+    -- operation that has been defined in the root type, overridden in the
+    -- first derived extended type, and inherited by the subsequent extended
+    -- type.
+ 
+    procedure Resolve_Dispute (Acct : in Accounts.Bank_Account'Class) is
+    begin
+       Accounts.Assign_Representative (Acct);   -- Dispatch according to tag.
+    end Resolve_Dispute;
+ 
+ 
+ 
+ begin  -- Main test procedure.
+ 
+    Report.Test ("C392A01", "Check that the use of a class-wide parameter "   &
+                             "allows for proper dispatching where root type " &
+                             "and extended types are declared in the same "   &
+                             "package" );
+    
+    Bank_Account_Subtest:
+    declare
+      use Accounts;
+    begin
+       Accounts.Open (B_Account);
+ 
+       -- Demonstrate class-wide parameter allowing dispatch by a primitive
+       -- operation that has been defined for this specific type.
+       Accumulate_Reserve (Acct => B_Account);
+       Tabulate_Account (B_Account);
+ 
+       if (Accounts.Bank_Reserve /= Accounts.Opening_Balance) or
+          (Accounts.Number_Of_Accounts (Bank) /= 1)           or
+          (Accounts.Number_Of_Accounts (Total) /= 1)
+       then
+          Report.Failed ("Failed in Bank_Account_Subtest");
+       end if;
+ 
+    end Bank_Account_Subtest;
+ 
+ 
+    Savings_Account_Subtest:
+    declare
+      use Accounts;
+    begin
+       Accounts.Open (Acct => S_Account);
+ 
+       -- Demonstrate class-wide parameter allowing dispatch by a primitive
+       -- operation that has been inherited by this extended type.
+       Accumulate_Reserve (Acct => S_Account);
+ 
+       -- Demonstrate class-wide parameter allowing dispatch by a primitive
+       -- operation that has been overridden for this extended type.
+       Resolve_Dispute  (Acct => S_Account);
+       Tabulate_Account (S_Account);
+ 
+       if Accounts.Bank_Reserve /= (3.0 * Accounts.Opening_Balance) or
+          Accounts.Daily_Representative /= Accounts.Manager         or
+          Accounts.Number_Of_Accounts (Savings) /= 1                or
+          Accounts.Number_Of_Accounts (Total) /= 2
+       then
+          Report.Failed ("Failed in Savings_Account_Subtest");
+       end if;
+ 
+    end Savings_Account_Subtest;
+ 
+ 
+    Preferred_Account_Subtest:
+    declare
+      use Accounts;
+    begin
+       Accounts.Open (P_Account);
+ 
+       -- Verify that the correct implementation of Open (overridden) was 
+       -- used for the Preferred_Account object.
+       if not Accounts.Verify_Open (P_Account) then
+          Report.Failed ("Incorrect values for init. Preferred Acct object");
+       end if;
+ 
+       -- Demonstrate class-wide parameter allowing dispatch by a primitive
+       -- operation that has been twice inherited by this extended type.
+       Accumulate_Reserve (Acct => P_Account);
+ 
+       -- Demonstrate class-wide parameter allowing dispatch by a primitive
+       -- operation that has been overridden for this extended type (the
+       -- operation was overridden by its parent type as well).
+       Tabulate_Account (P_Account);
+       
+       if Accounts.Bank_Reserve /= 1300.00             or
+          Accounts.Number_Of_Accounts (Preferred) /= 1 or
+          Accounts.Number_Of_Accounts (Total) /= 3
+       then
+          Report.Failed ("Failed in Preferred_Account_Subtest");
+       end if;
+ 
+    end Preferred_Account_Subtest;
+ 
+ 
+    Report.Result;
+ 
+ end C392A01;
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392c05.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392c05.a
new file mode 100644
index 000000000..6bd3cece7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392c05.a
@@ -0,0 +1,164 @@
+-- C392C05.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 for a call to a dispatching subprogram the subprogram
+--     body which is executed is determined by the controlling tag for
+--     the case where the call has statically tagged controlling operands
+--     of the type T.  Check this for various operands of tagged types:
+--     objects (declared or allocated), formal parameters, view conversions,
+--     function calls (both primitive and non-primitive).
+--
+-- TEST DESCRIPTION:
+--      This test uses foundation F392C00 to test the usages of statically
+--      tagged objects and values.  The calls to Validate indicate the
+--      expected sequence of procedure calls since the previous call to
+--      Validate.  Static tags can be determined at compile time, and
+--      hence this is a test of correct overload resolution for tagged types.
+--      A clever compiler which unrolls loops and does path analysis on
+--      access values will be able to perform the same kind of determination
+--      for all of the code in this test.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F392C00.A   (foundation code)
+--         C392C05.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--      24 Oct 95   SAIC    Updated for ACVC 2.0.1
+--      13 Feb 97   PWB.CTA Corrected assumption that "or" operands are
+--                          evaluated in textual order.
+--!
+
+with Report;
+with TCTouch;
+with F392C00_1;
+procedure C392C05 is -- Hardware_Store
+
+  package Switch renames F392C00_1;
+
+  subtype Switch_Class is Switch.Toggle'Class;
+
+  type Reference is access all Switch_Class;
+
+  A_Switch   : aliased Switch.Toggle;
+  A_Dimmer   : aliased Switch.Dimmer;
+  An_Autodim : aliased Switch.Auto_Dimmer;
+
+  type Light_Bank is array(Positive range <>) of Reference;
+
+  Lamps : Light_Bank(1..3);
+
+begin  -- Main test procedure.
+
+  Report.Test ("C392C05", "Check that a dispatching subprogram call is "
+                        & "determined by the controlling tag for statically "
+                        & "tagged controlling operands" );
+
+-- Check use of static tagged declared objects,
+--   and static tagged formal parameters
+-- Must call correct version of flip based on type of controlling op.
+
+-- Turn on the lights!
+
+  Switch.Flip( A_Switch );
+  TCTouch.Validate( "A", "Declared Toggle" );
+
+  Switch.Flip( A_Dimmer );
+  TCTouch.Validate( "GBA", "Declared Dimmer" );
+
+  Switch.Flip( An_Autodim );
+  TCTouch.Validate( "KGBA", "Declared Auto_Dimmer" );
+
+  Lamps(1) := new Switch.Toggle;
+  Lamps(2) := new Switch.Dimmer;
+  Lamps(3) := new Switch.Auto_Dimmer;
+
+-- Check use of static tagged allocated objects,
+--   and static tagged formal parameters in a loop which may dynamically
+--   dispatch.  If an optimizer unrolls the loop, it may then be statically
+--   determined, and no dispatching will occur.  Either interpretation is
+--   correct.
+  for Knob in Lamps'Range loop
+    Switch.Flip( Lamps(Knob).all );
+  end loop;
+  TCTouch.Validate( "AGBAKGBA", "Allocated Objects" );
+
+-- Check use of static tagged declared objects,
+--   calling non-primitive functions.
+  if not Switch.TC_Non_Disp( A_Switch ) then
+    Report.Failed( "Bad Value 1" );
+  end if;
+  TCTouch.Validate( "X", "Nonprimitive Function" );
+
+  if not Switch.TC_Non_Disp( A_Dimmer ) then
+    Report.Failed( "Bad Value 2" );
+  end if;
+  TCTouch.Validate( "Y", "Nonprimitive Function" );
+
+  if not Switch.TC_Non_Disp( An_Autodim ) then
+    Report.Failed( "Bad Value 3" );
+  end if;
+  TCTouch.Validate( "Z", "Nonprimitive Function" );
+
+  A_Switch   := Switch.Create;
+  A_Dimmer   := Switch.Create;
+  An_Autodim := Switch.Create;
+  TCTouch.Validate( "123", "Primitive Function" );
+
+-- View conversions
+  Switch.Brighten( An_Autodim, 50 ); 
+
+  Switch.Flip( Switch.Toggle( A_Switch ) );
+  Switch.Flip( Switch.Toggle( A_Dimmer ) );
+  Switch.Flip( Switch.Dimmer( An_Autodim ) );
+  TCTouch.Validate( "DAAGBA", "View Conversions" );
+
+-- statically tagged controlling operands (specific types) provided to
+-- class-wide functions
+  if Switch.On( A_Switch )
+     or Switch.On( A_Dimmer )
+     or Switch.On( An_Autodim ) then
+    Report.Failed( "Bad Value 4" );
+  end if;
+  TCTouch.Validate( "BBB", "Class-wide" );
+
+-- statically tagged controlling operands qualified expressions provided to
+-- primitive functions, also using context to determine call to a
+-- class-wide function.
+  if Switch.Off( Switch.Toggle'( Switch.Create ) )
+     or else Switch.Off( Switch.Dimmer'( Switch.Create ) )
+     or else Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then
+    Report.Failed( "Bad Value 5" );
+  end if;
+  TCTouch.Validate( "1C2C3C", "Qualified Expression/Class-Wide" );
+
+  Report.Result;
+
+end C392C05;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392c07.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392c07.a
new file mode 100644
index 000000000..f13cc0b01
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392c07.a
@@ -0,0 +1,190 @@
+-- C392C07.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 for a call to a dispatching subprogram the subprogram
+--     body which is executed is determined by the controlling tag for
+--     the case where the call has dynamic tagged controlling operands
+--     of the type T.  Check for calls to these same subprograms where
+--     the operands are of specific statically tagged types:
+--     objects (declared or allocated), formal parameters, view
+--     conversions, and function calls (both primitive and non-primitive).
+--
+-- TEST DESCRIPTION:
+--      This test uses foundation F392C00 to test the usages of statically
+--      tagged objects and values.  This test is derived in part from
+--      C392C05.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      24 Oct 95   SAIC    Updated for ACVC 2.0.1
+--
+--!
+
+with Report;
+with TCTouch;
+with F392C00_1;
+procedure C392C07 is -- Hardware_Store
+  package Switch renames F392C00_1;
+
+  subtype Switch_Class is Switch.Toggle'Class;
+
+  type Reference is access all Switch_Class;
+
+  A_Switch   : aliased Switch.Toggle;
+  A_Dimmer   : aliased Switch.Dimmer;
+  An_Autodim : aliased Switch.Auto_Dimmer;
+
+  type Light_Bank is array(Positive range <>) of Reference;
+
+  Lamps : Light_Bank(1..3);
+
+-- dynamically tagged controlling operands : class wide formal parameters
+  procedure Clamp( Device : in out Switch_Class; On : Boolean := False ) is
+  begin
+    if Switch.On( Device ) /= On then                  
+      Switch.Flip( Device );                           
+    end if;
+  end Clamp;
+  function Class_Item(Bank_Pos: Positive) return Switch_Class is
+  begin
+    return Lamps(Bank_Pos).all;
+  end Class_Item;
+
+begin  -- Main test procedure.
+  Report.Test ("C392C07", "Check that a dispatching subprogram call is "
+                        & "determined by the controlling tag for "
+                        & "dynamically tagged controlling operands" );
+
+  Lamps := ( A_Switch'Access, A_Dimmer'Access, An_Autodim'Access );
+
+-- dynamically tagged operands referring to
+-- statically tagged declared objects
+  for Knob in Lamps'Range loop
+    Clamp( Lamps(Knob).all, On => True );
+  end loop;
+  TCTouch.Validate( "BABGBABKGBA", "Clamping On Lamps" );
+
+  Lamps(1) := new Switch.Toggle;
+  Lamps(2) := new Switch.Dimmer;
+  Lamps(3) := new Switch.Auto_Dimmer;
+
+-- turn the full bank of switches ON
+-- dynamically tagged allocated objects
+  for Knob in Lamps'Range loop
+    Clamp( Lamps(Knob).all, On => True );
+  end loop;
+  TCTouch.Validate( "BABGBABKGBA", "Dynamic Allocated");
+
+-- Double check execution correctness
+  if Switch.Off( Lamps(1).all )
+     or Switch.Off( Lamps(2).all )
+     or Switch.Off( Lamps(3).all ) then
+    Report.Failed( "Bad Value" );
+  end if;
+  TCTouch.Validate( "CCC", "Class-wide");
+
+-- turn the full bank of switches OFF
+  for Knob in Lamps'Range loop
+    Switch.Flip( Lamps(Knob).all );
+  end loop;
+  TCTouch.Validate( "AGBAKGBA", "Dynamic Allocated, Primitive Ops");
+
+-- check switches for OFF
+-- a few function calls as operands
+  for Knob in Lamps'Range loop
+    if not Switch.Off( Class_Item(Knob) ) then
+      Report.Failed("At function tests, Switch not OFF");
+    end if;
+  end loop;
+  TCTouch.Validate( "CCC",
+                         "Using function returning class-wide type");
+
+-- Switches are all OFF now.
+-- dynamically tagged view conversion
+  Clamp( Switch_Class( A_Switch ) );         
+  Clamp( Switch_Class( A_Dimmer ) );         
+  Clamp( Switch_Class( An_Autodim ) );       
+  TCTouch.Validate( "BABGBABKGBA", "View Conversions" );
+
+-- dynamically tagged controlling operands : declared class wide objects
+--  calling primitive functions
+  declare
+    Dine_O_Might : Switch_Class := Switch.TC_CW_TI( 't' );  
+  begin
+    Switch.Flip( Dine_O_Might );                            
+    if Switch.On( Dine_O_Might ) then                       
+      Report.Failed( "Exploded at Dine_O_Might" );
+    end if;
+    TCTouch.Validate( "WAB", "Dispatching function 1" );
+  end;
+
+  declare
+    Dyne_A_Mite : Switch_Class := Switch.TC_CW_TI( 'd' );   
+  begin
+    Switch.Flip( Dyne_A_Mite );                             
+    if Switch.On( Dyne_A_Mite ) then                        
+      Report.Failed( "Exploded at Dyne_A_Mite" );
+    end if;
+    TCTouch.Validate( "WGBAB", "Dispatching function 2" );
+  end;
+
+  declare
+    Din_Um_Out : Switch_Class := Switch.TC_CW_TI( 'a' );    
+  begin
+    Switch.Flip( Din_Um_Out );                              
+    if Switch.Off( Din_Um_Out ) then                        
+      Report.Failed( "Exploded at Din_Um_Out" );
+    end if;
+    TCTouch.Validate( "WKCC", "Dispatching function 3" );
+
+-- Non-dispatching function calls.
+    if not Switch.TC_Non_Disp( Switch.Toggle( Din_Um_Out ) ) then
+      Report.Failed( "Non primitive, via view conversion" );
+    end if;
+    TCTouch.Validate( "X", "View Conversion 1" );
+
+    if not Switch.TC_Non_Disp( Switch.Dimmer( Din_Um_Out ) ) then
+      Report.Failed( "Non primitive, via view conversion" );
+    end if;
+    TCTouch.Validate( "Y", "View Conversion 2" );
+  end;
+
+  -- a few more function calls as operands (oops)
+  if not Switch.On( Switch.Toggle'( Switch.Create ) ) then 
+    Report.Failed("Toggle did not create ""On""");
+  end if;
+
+  if Switch.Off( Switch.Dimmer'( Switch.Create ) ) then 
+    Report.Failed("Dimmer created ""Off""");
+  end if;
+
+  if Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then 
+    Report.Failed("Auto_Dimmer created ""Off""");
+  end if;
+
+  Report.Result;
+end C392C07;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392d01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392d01.a
new file mode 100644
index 000000000..bb6e19202
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392d01.a
@@ -0,0 +1,324 @@
+-- C392D01.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, for an implicitly declared dispatching operation that is
+--      overridden, the body executed is the body for the overriding
+--      subprogram, even if the overriding occurs in a private part.
+--      Check that, for an implicitly declared dispatching operation that is
+--      NOT overridden, the body executed is the body of the corresponding
+--      subprogram of the parent type.
+--
+--      Check for the case where the overriding (and non-overriding) operations
+--      are declared for a private extension (and its full type) in a public
+--      child unit of the package declaring the ancestor type, and the ancestor
+--      type is a tagged private type whose full view is itself a derived type.
+--
+-- TEST DESCRIPTION:
+--      Consider:
+--
+--      package Parent is
+--         type Root is tagged ...
+--         procedure Vis_Op (P: Root);
+--      private
+--         procedure Pri_Op (P: Root);                     -- (A)
+--      end Parent;
+--
+--      package Intermediate is
+--         type Mid is tagged private;
+--      private
+--         type Mid is new Parent.Root with record ...
+--         -- Implicit Vis_Op (P: Mid) declared here.
+--
+--         procedure Vis_Op (P: Mid);                      -- (B)
+--      end Intermediate;
+--
+--      package Intermediate.Child is
+--         type Derived is new Mid with private; 
+--
+--         procedure Pri_Op (P: Derived);                  -- (C)
+--         ...
+--
+--      private
+--         type Derived is new Mid with record...
+--         -- Implicit Vis_Op (P: Derived) declared here.
+--         ...
+--      end Intermediate.Child;
+--
+--      Type Derived inherits Vis_Op from the parent type Mid. Note, however,
+--      that it is implicitly declared in the private part (inherited
+--      subprograms for a derived_type_definition -- in this case, the full
+--      type -- are implicitly declared at the  earliest place within the
+--      immediate scope of the type_declaration where the corresponding
+--      declaration from the parent is visible).
+--
+--      Because Parent.Pri_Op is never visible within the immediate scope
+--      of Mid, it is not implicitly declared for Mid. Thus, it is also not
+--      implicitly declared for Derived. As a result, the version of Pri_Op
+--      declared at (C) above does not override an inherited version of
+--      Parent.Pri_Op and is totally unrelated to it.
+--
+--      Dispatching calls with tag Mid will execute (A) and (B). Dispatching 
+--      calls with tag Derived from Parent will execute the bodies of (B) 
+--      and (A).  Dispatching calls with tag Derived from Parent.Child
+--      will execute the bodies of (B) and (C).  
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F392D00.A
+--         C392D01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with F392D00;
+package C392D01_0 is
+
+   type Zoom_Camera is tagged private;
+
+   procedure Self_Test (C : in out Zoom_Camera'Class);
+
+   -- ...Additional operations.
+
+
+   function TC_Correct_Result (C : Zoom_Camera;
+                               D : F392D00.Depth_Of_Field;
+                               S : F392D00.Shutter_Speed) return Boolean;
+
+private
+
+   type Magnification is (Low, Medium, High);
+
+   type Zoom_Camera is new F392D00.Remote_Camera with record
+      Mag : Magnification;
+   end record;
+
+   -- procedure Focus (C     : in out Zoom_Camera;               -- Implicitly
+   --                  Depth : in     Depth_Of_Field)            -- declared
+                                                                 -- here.
+
+   procedure Focus (C     : in out Zoom_Camera;                -- Overrides
+                    Depth : in     F392D00.Depth_Of_Field);    -- inherited op.
+
+   -- For the remote zoom camera, perhaps the focusing algorithm is different
+   -- in some way, so the original Focus operation is overridden here.
+
+   -- Since the partial view is not an extension, the overriding operation
+   -- must be declared after the full type. This version of Focus, although
+   -- not visible for type Zoom_Camera from outside the package, can still be
+   -- dispatched to.  
+
+
+   -- Note: F392D00.Set_Shutter_Speed is inherited by Zoom_Camera from
+   -- F392D00.Remote_Camera, but since the operation never becomes visible
+   -- within the immediate scope of Zoom_Camera, it is never implicitly
+   -- declared. 
+
+end C392D01_0;
+
+
+     --==================================================================--
+
+
+package body C392D01_0 is
+
+   procedure Focus (C     : in out Zoom_Camera;
+                    Depth : in     F392D00.Depth_Of_Field) is
+   begin
+      -- Artificial for testing purposes.
+      C.DOF := 83;
+   end Focus;
+
+   -----------------------------------------------------------
+   -- Indirect call to F392D00.Self_Test since the main does not know 
+   -- that Zoom_Camera is a private extension of F392D00.Basic_Camera.
+   procedure Self_Test (C : in out Zoom_Camera'Class) is
+   begin
+      F392D00.Self_Test (C);
+      -- ...Additional self-testing.
+   end Self_Test;
+
+   -----------------------------------------------------------
+   function TC_Correct_Result (C : Zoom_Camera;
+                               D : F392D00.Depth_Of_Field;
+                               S : F392D00.Shutter_Speed) return Boolean is
+      use type F392D00.Depth_Of_Field;
+      use type F392D00.Shutter_Speed;
+   begin
+      return (C.DOF = D and C.Shutter = S);
+   end TC_Correct_Result;
+
+end C392D01_0;
+
+
+     --==================================================================--
+
+
+with F392D00;
+package C392D01_0.C392D01_1 is
+
+   type Film_Speed is private;
+
+   type Auto_Speed is new Zoom_Camera with private;
+
+   -- Implicit function TC_Correct_Result (Auto_Speed) declared here.
+
+   procedure Set_Shutter_Speed (C     : in out Auto_Speed;     
+                                Speed : in     F392D00.Shutter_Speed); 
+
+   -- This version of Set_Shutter_Speed does NOT override the operation
+   -- inherited from Zoom_Camera, because the inherited operation is never
+   -- visible (and thus, is never implicitly declared) within the immediate
+   -- scope of type Auto_Speed.
+
+   procedure Self_Test (C : in out Auto_Speed'Class);
+
+   -- ...Other operations.
+
+private
+   type Film_Speed is (One_Hundred, Two_Hundred, Four_Hundred);
+
+   type Auto_Speed is new Zoom_Camera with record
+      ASA : Film_Speed;
+   end record;
+
+   -- procedure Focus (C     : in out Auto_Speed;                -- Implicitly
+   --                  Depth : in     F392D00.Depth_Of_Field);   -- declared
+                                                                 -- here.
+
+end C392D01_0.C392D01_1;
+
+
+     --==================================================================--
+
+
+package body C392D01_0.C392D01_1 is
+
+   procedure Set_Shutter_Speed (C     : in out Auto_Speed;
+                                Speed : in     F392D00.Shutter_Speed) is
+   begin
+      -- Artificial for testing purposes.
+      C.Shutter := F392D00.Two_Fifty;
+   end Set_Shutter_Speed;
+
+   -------------------------------------------------------
+   procedure Self_Test (C : in out Auto_Speed'Class) is
+   begin
+      -- Artificial for testing purposes.
+      Set_Shutter_Speed (C, F392D00.Thousand);
+      Focus (C, 27);
+   end Self_Test;
+
+end C392D01_0.C392D01_1;
+
+
+     --==================================================================--
+
+
+with F392D00;
+with C392D01_0.C392D01_1;
+
+with Report;
+
+procedure C392D01 is
+   Zooming_Camera : C392D01_0.Zoom_Camera;
+   Auto_Camera1   : C392D01_0.C392D01_1.Auto_Speed;
+   Auto_Camera2   : C392D01_0.C392D01_1.Auto_Speed;
+
+   TC_Expected_Zoom_Depth : constant F392D00.Depth_Of_Field := 83;
+   TC_Expected_Auto_Depth : constant F392D00.Depth_Of_Field := 83;
+   TC_Expected_Depth      : constant F392D00.Depth_Of_Field := 83;
+   TC_Expected_Zoom_Speed : constant F392D00.Shutter_Speed 
+                          := F392D00.Thousand;
+   TC_Expected_Auto_Speed : constant F392D00.Shutter_Speed 
+                          := F392D00.Thousand;
+   TC_Expected_Speed      : constant F392D00.Shutter_Speed 
+                          := F392D00.Two_Fifty;
+
+   use type F392D00.Depth_Of_Field;
+   use type F392D00.Shutter_Speed;
+
+begin
+   Report.Test ("C392D01", "Dispatching for overridden and non-overridden "   &
+                "primitive subprograms: private extension declared in child " &
+                "unit, parent is tagged private whose full view is derived  " &
+                "type");
+
+
+
+-- Call the class-wide operation (Self_Test) for Zoom_Camera'Class, which 
+-- itself calls the class-wide operation for Remote_Camera'Class, which
+-- in turn makes dispatching calls to Focus and Set_Shutter_Speed:
+
+
+   -- For an object of type Zoom_Camera, the dispatching call to Focus should
+   -- dispatch to the body explicitly declared for Zoom_Camera. The dispatching
+   -- to Set_Shutter_Speed should dispatch to the body declared for
+   -- Remote_Camera:
+     
+   C392D01_0.Self_Test(Zooming_Camera);
+
+   if not C392D01_0.TC_Correct_Result (Zooming_Camera,
+                                       TC_Expected_Zoom_Depth,
+                                       TC_Expected_Zoom_Speed)
+   then
+      Report.Failed ("Calls dispatched incorrectly for tagged private type");
+   end if;
+
+   -- For an object of type Auto_Speed, the dispatching call to Focus should
+   -- dispatch to the body explicitly declared for Zoom_Camera. The dispatching
+   -- call to Set_Shutter_Speed should dispatch to the body explicitly declared 
+   -- for Remote_Camera:
+     
+   C392D01_0.Self_Test(Auto_Camera1);
+
+   if not C392D01_0.C392D01_1.TC_Correct_Result (Auto_Camera1,
+                                                 TC_Expected_Auto_Depth,
+                                                 TC_Expected_Auto_Speed)
+   then
+      Report.Failed ("Calls dispatched incorrectly for private extension");
+   end if;
+
+   -- Call to Self_Test from C392D01_0.C392D01_1 invokes the dispatching call
+   -- to Focus which should dispatch to the body explicitly declared for 
+   -- Zoom_Camera. The dispatching call to Set_Shutter_Speed should dispatch 
+   -- to the body explicitly declared for Auto_Speed:
+
+   C392D01_0.C392D01_1.Self_Test(Auto_Camera2);
+
+   if not C392D01_0.C392D01_1.TC_Correct_Result (Auto_Camera2,
+                                                 TC_Expected_Depth,
+                                                 TC_Expected_Speed)
+   then
+      Report.Failed ("Call to explicit subprogram executed the wrong body");
+   end if;
+
+   Report.Result;
+
+end C392D01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392d02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392d02.a
new file mode 100644
index 000000000..d8e012cbe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392d02.a
@@ -0,0 +1,185 @@
+-- C392D02.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 primitive procedure declared in a private part is not
+--      overridden by a procedure explicitly declared at a place where the
+--      primitive procedure in question is not visible.
+--
+--      Check for the case where the non-overriding operation is declared in a
+--      separate (non-child) package from that declaring the parent type, and
+--      the descendant type is a record extension.
+--
+-- TEST DESCRIPTION:
+--      Consider:
+--
+--      package P is
+--         type Root is tagged ...
+--      private
+--         procedure Pri_Op (A: Root);
+--      end P;
+--
+--      with P;
+--      package Q is
+--         type Derived is new P.Root with record...
+--         procedure Pri_Op (A: Derived);  -- Does NOT override parent's Op.
+--         ...
+--      end Q;
+--
+--      Type Derived inherits Pri_Op from the parent type Root. However,
+--      because P.Pri_Op is never visible within the immediate scope of
+--      Derived, it is not implicitly declared for Derived. As a result,
+--      the explicit Q.Pri_Op does not override P.Pri_Op and is totally
+--      unrelated to it.
+--
+--      Dispatching calls to P.Pri_Op with operands of tag Derived will
+--      not dispatch to Q.Pri_Op; the body executed will be that of P.Pri_Op.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F392D00.A
+--         C392D02.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with F392D00;
+package C392D02_0 is
+
+   type Aperture is (Eight, Sixteen);     
+
+   type Auto_Speed is new F392D00.Remote_Camera with record
+      -- ...
+      FStop : Aperture;
+   end record;
+
+
+   procedure Set_Shutter_Speed (C     : in out Auto_Speed;     
+                                Speed : in     F392D00.Shutter_Speed); 
+                                                   -- Does NOT override.
+
+   -- This version of Set_Shutter_Speed does NOT override the operation
+   -- inherited from the parent, because the inherited operation is never
+   -- visible (and thus, is never implicitly declared) within the immediate
+   -- scope of type Auto_Speed.
+
+   procedure Self_Test (C : in out Auto_Speed'Class);
+
+   -- ...Other operations.
+
+end C392D02_0;
+
+
+     --==================================================================--
+
+
+package body C392D02_0 is
+
+   procedure Set_Shutter_Speed (C     : in out Auto_Speed;
+                                Speed : in     F392D00.Shutter_Speed) is
+   begin
+      -- Artificial for testing purposes.
+      C.Shutter := F392D00.Four_Hundred;
+   end Set_Shutter_Speed;
+
+   ----------------------------------------------------
+   procedure Self_Test (C : in out Auto_Speed'Class) is
+   begin
+      -- Should dispatch to the Set_Shutter_Speed explicitly declared
+      -- for Auto_Speed.
+      Set_Shutter_Speed (C, F392D00.Two_Fifty);
+   end Self_Test;
+
+end C392D02_0;
+
+
+     --==================================================================--
+
+
+with F392D00;
+with C392D02_0;
+
+with Report;
+
+procedure C392D02 is
+   Basic_Camera : F392D00.Remote_Camera;
+   Auto_Camera1 : C392D02_0.Auto_Speed;
+   Auto_Camera2 : C392D02_0.Auto_Speed;
+
+   TC_Expected_Basic_Speed : constant F392D00.Shutter_Speed 
+                           := F392D00.Thousand;
+   TC_Expected_Speed       : constant F392D00.Shutter_Speed 
+                           := F392D00.Four_Hundred;
+
+   use type F392D00.Shutter_Speed;
+
+begin
+   Report.Test ("C392D02", "Dispatching for non-overridden primitive " &
+                "subprograms: record extension declared in non-child " &
+                "package, parent is tagged record");
+
+-- Call the class-wide operation for Remote_Camera'Class, which dispatches
+-- to Set_Shutter_Speed:
+
+   -- For an object of type Remote_Camera, the dispatching call should
+   -- dispatch to the body declared for the root type:
+     
+   F392D00.Self_Test(Basic_Camera);
+
+   if Basic_Camera.Shutter /= TC_Expected_Basic_Speed then
+      Report.Failed ("Call dispatched incorrectly for root type");
+   end if;
+
+
+   -- C392D02_0.Set_Shutter_Speed should never be called by F392D00.Self_Test,
+   -- since C392D02_0.Set_Shutter_Speed does not override
+   -- F392D00.Set_Shutter_Speed.
+
+   -- For an object of type Auto_Speed, the dispatching call should
+   -- also dispatch to the body declared for the root type:
+     
+   F392D00.Self_Test(Auto_Camera1);
+
+   if Auto_Camera1.Shutter /= TC_Expected_Basic_Speed then
+      Report.Failed ("Call dispatched incorrectly for derived type");
+   end if;
+
+   -- Call to Self_Test from C392D02_0 invokes the dispatching call to
+   -- Set_Shutter_Speed which should dispatch to the body explicitly declared 
+   -- for Auto_Speed:
+
+   C392D02_0.Self_Test(Auto_Camera2);
+
+   if Auto_Camera2.Shutter /= TC_Expected_Speed then
+      Report.Failed ("Call to explicit subprogram executed the wrong body");
+   end if;
+
+   Report.Result;
+
+end C392D02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392d03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392d03.a
new file mode 100644
index 000000000..3a488952e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c392d03.a
@@ -0,0 +1,248 @@
+-- C392D03.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, for an inherited dispatching operation that is overridden,
+--      the body executed is the body of the overriding subprogram, even if
+--      the overriding occurs in a private part.
+--
+--      Check for the case where the overriding operation is declared in a
+--      separate (non-child) package from that declaring the parent type, and
+--      the descendant type is a record extension.
+--
+--      Check for both dispatching and nondispatching calls.
+--
+-- TEST DESCRIPTION:
+--      Consider:
+--
+--      package P is
+--         type Root is tagged ...
+--         procedure Op (A: Root);
+--      end P;
+--
+--      with P;
+--      package Q is
+--         type Derived1 is new P.Root with record...
+--         -- Implicit procedure Op (A: Derived1) declared here.
+--         type Derived2 is new P.Root with private...
+--         -- Implicit procedure Op (A: Derived2) declared here.
+--         type New_Derived is new Derived1 with private...
+--         -- Implicit procedure Op (A: New_Derived) declared here.
+--      private
+--         procedure Op (A: Derived1);  -- Overrides parent's Op.
+--         type Derived2 is new P.Root with record...
+--         procedure Op (A: Derived2);  -- Overrides parent's Op.
+--         type New_Derived is new Derived1 with record...
+--         ...
+--      end Q;
+--
+--      Both type Derived1 and Derived2 inherit Op from the parent type Root. 
+--      Type New_Derived inherits (inherited) Op from Derived1.  The inherited 
+--      operation is implicitly declared immediately after the type extension.  
+--      The inherited operation is overridden by an explicit declaration in 
+--      the private part. Even though the overriding operation is private, 
+--      calls to Op with an operand of tag Derived1, Derived2, or New_Derived
+--      will execute the body of the overriding operation.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F392D00.A
+--         C392D03.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with F392D00;
+package C392D03_0 is
+
+   type Aperture is (Eight, Sixteen);     
+
+   type Auto_Focus is new F392D00.Remote_Camera with record
+      -- ...
+      FStop : Aperture;
+   end record;
+
+   -- Implicit procedure Focus (C     : in out Auto_Focus;
+   --                           Depth : in     Depth_Of_Field) declared here.
+
+   type Auto_Flashing is new F392D00.Remote_Camera with private;
+
+   -- Implicit procedure Focus (C     : in out Auto_Flashing;
+   --                           Depth : in     Depth_Of_Field) declared here.
+
+   type Special_Focus is new Auto_Focus with private;
+
+   -- Implicit procedure Focus (C     : in out Special_Focus;
+   --                           Depth : in     Depth_Of_Field) declared here.
+
+   -- ...Other operations.
+
+private
+
+   procedure Focus (C     : in out Auto_Focus;              -- Overrides
+                    Depth : in     F392D00.Depth_Of_Field); -- parent's op.
+
+   -- For the improved remote camera, focus is set automatically, so it is
+   -- declared as a private operation.
+
+   type Auto_Flashing is new F392D00.Remote_Camera with null record;
+
+   procedure Focus (C     : in out Auto_Flashing;           -- Overrides
+                    Depth : in     F392D00.Depth_Of_Field); -- parent's op.
+
+   type Special_Focus is new Auto_Focus with null record;
+
+end C392D03_0;
+
+
+     --==================================================================--
+
+
+package body C392D03_0 is
+
+   procedure Focus (C     : in out Auto_Focus;
+                    Depth : in     F392D00.Depth_Of_Field) is
+   begin
+      -- Artificial for testing purposes.
+      C.DOF := 52;
+   end Focus;
+
+   -----------------------------------------------------------
+   procedure Focus (C     : in out Auto_Flashing;
+                    Depth : in     F392D00.Depth_Of_Field) is
+   begin
+      -- Artificial for testing purposes.
+      C.DOF := 91;
+   end Focus;
+
+end C392D03_0;
+
+
+     --==================================================================--
+
+
+with F392D00;
+with C392D03_0;
+
+with Report;
+
+procedure C392D03 is
+
+   type Focus_Ptr is access procedure 
+     (P1 : in out C392D03_0.Auto_Focus;
+      P2 : in F392D00.Depth_Of_Field);
+
+   Basic_Camera   : F392D00.Remote_Camera;
+   Auto_Camera1   : C392D03_0.Auto_Focus;
+   Auto_Camera2   : C392D03_0.Auto_Focus;
+   Flash_Camera1  : C392D03_0.Auto_Flashing;
+   Flash_Camera2  : C392D03_0.Auto_Flashing;
+   Special_Camera : C392D03_0.Special_Focus;
+   Auto_Depth     : F392D00.Depth_Of_Field := 78;
+
+   TC_Expected_Basic_Depth : constant F392D00.Depth_Of_Field := 46;
+   TC_Expected_Auto_Depth  : constant F392D00.Depth_Of_Field := 52;
+   TC_Expected_Depth       : constant F392D00.Depth_Of_Field := 91;
+
+   FP : Focus_Ptr := C392D03_0.Focus'Access;
+
+   use type F392D00.Depth_Of_Field;
+
+begin
+   Report.Test ("C392D03", "Dispatching for overridden primitive " &
+                "subprograms: record extension declared in non-child " &
+                "package, parent is tagged record");
+
+
+-- Call the class-wide operation for Remote_Camera'Class, which itself makes
+-- a dispatching call to Focus:
+
+   -- For an object of type Remote_Camera, the dispatching call should
+   -- dispatch to the body declared for the root type:
+     
+   F392D00.Self_Test(Basic_Camera);
+
+   if Basic_Camera.DOF /= TC_Expected_Basic_Depth then
+      Report.Failed ("Call dispatched incorrectly for root type");
+   end if;
+
+
+   -- For an object of type Auto_Focus, the dispatching call should
+   -- dispatch to the body declared for the derived type:
+     
+   F392D00.Self_Test(Auto_Camera1);
+
+   if Auto_Camera1.DOF /= TC_Expected_Auto_Depth then
+      Report.Failed ("Call dispatched incorrectly for Auto_Focus type");
+   end if;
+
+
+   -- For an object of type Auto_Flash, the dispatching call should
+   -- also dispatch to the body declared for the derived type:
+
+   F392D00.Self_Test(Flash_Camera1);
+
+   if Flash_Camera1.DOF /= TC_Expected_Depth then
+      Report.Failed ("Call dispatched incorrectly for Auto_Flash type");
+   end if;
+
+   -- For an object of Auto_Flash type, a non-dispatching call to Focus should 
+   -- execute the body declared for the derived type (even through it is 
+   -- declared in the private part).
+
+   C392D03_0.Focus (Flash_Camera2, Auto_Depth);
+
+   if Flash_Camera2.DOF /= TC_Expected_Depth then
+      Report.Failed ("Non-dispatching call to privately overriding " &
+                     "subprogram executed the wrong body");
+   end if;
+
+   -- For an object of Auto_Focus type, a non-dispatching call to Focus should 
+   -- execute the body declared for the derived type (even through it is 
+   -- declared in the private part).
+
+   FP.all (Auto_Camera2, Auto_Depth);
+
+   if Auto_Camera2.DOF /= TC_Expected_Auto_Depth then
+      Report.Failed ("Non-dispatching call by using access to overriding " &
+                     "subprogram executed the wrong body");
+   end if;
+
+   -- For an object of type Special_Camera, the dispatching call should
+   -- also dispatch to the body declared for the derived type:
+
+   F392D00.Self_Test(Special_Camera);
+
+   if Special_Camera.DOF /= TC_Expected_Auto_Depth then
+      Report.Failed ("Call dispatched incorrectly for Special_Camera type");
+   end if;
+
+   Report.Result;
+
+end C392D03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393001.a
new file mode 100644
index 000000000..9d6f85c63
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393001.a
@@ -0,0 +1,407 @@
+-- C393001.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 an abstract type can be declared, and in turn concrete
+--      types can be derived from it.  Check that the definition of 
+--      actual subprograms associated with the derived types dispatch
+--      correctly.
+--
+-- TEST DESCRIPTION:
+--      This test declares an abstract type Breaker in a package, and
+--      then derives from it.  The type Basic_Breaker defines the least
+--      possible in order to not be abstract.  The type Ground_Fault is
+--      defined to inherit as much as possible, whereas type Special_Breaker
+--      overrides everything it can.  The type Special_Breaker also includes
+--      an embedded Basic_Breaker object.  The main program then utilizes
+--      each of the three types of breaker, and to ascertain that the
+--      overloading and tagging resolution are correct, each "Create"
+--      procedure is called with a unique value.  The diagram below
+--      illustrates the relationships.  This test is derived from C3A2001.
+--
+--              Abstract type:           Breaker
+--                                           |
+--                                    Basic_Breaker (Short)
+--                                    /           \
+--                     (Sharp) Ground_Fault    Special_Breaker (Shock)
+--
+--      Test structure is an array of class-wide objects, modeling a circuit
+--      as a list of components.  The test then creates some values, and
+--      traverses the list to determine correct operation.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      13 Nov 95   SAIC    Revised for 2.0.1
+--
+--!
+
+----------------------------------------------------------------- C393001_1
+
+with Report;
+package C393001_1 is
+
+  type Breaker is abstract tagged private;
+  type Status  is ( Power_Off, Power_On, Tripped, Failed );
+
+  procedure Flip ( The_Breaker : in out Breaker ) is abstract;
+  procedure Trip ( The_Breaker : in out Breaker ) is abstract;
+  procedure Reset( The_Breaker : in out Breaker ) is abstract;
+  procedure Fail ( The_Breaker : in out Breaker );
+
+  procedure Set ( The_Breaker : in out Breaker'Class; To_State : Status );
+
+  function  Status_Of( The_Breaker : Breaker ) return Status;
+
+private
+  type Breaker is abstract tagged record
+    State : Status := Power_Off;
+  end record;
+end C393001_1;
+
+with TCTouch;
+package body C393001_1 is
+  procedure Fail( The_Breaker : in out Breaker ) is ------------------- a
+  begin
+    TCTouch.Touch( 'a' );
+    The_Breaker.State := Failed;
+  end Fail;
+
+  procedure Set( The_Breaker : in out Breaker'Class; To_State : Status ) is
+  begin
+    The_Breaker.State := To_State;
+  end Set;
+
+  function  Status_Of( The_Breaker : Breaker ) return Status is ------- b
+  begin
+    TCTouch.Touch( 'b' );
+    return The_Breaker.State;
+  end Status_Of;
+end C393001_1;
+
+----------------------------------------------------------------- C393001_2
+
+with C393001_1;
+package C393001_2 is
+
+  type Basic_Breaker is new C393001_1.Breaker with private;
+
+  type Voltages is ( V12, V110, V220, V440 );
+  type Amps     is ( A1, A5, A10, A25, A100 );
+
+  function Construct( Voltage : Voltages; Amperage : Amps )
+    return Basic_Breaker;
+
+  procedure Flip ( The_Breaker : in out Basic_Breaker );
+  procedure Trip ( The_Breaker : in out Basic_Breaker );
+  procedure Reset( The_Breaker : in out Basic_Breaker );
+private
+  type Basic_Breaker is new C393001_1.Breaker with record
+    Voltage_Level : Voltages := V110;
+    Amperage      : Amps;
+  end record;
+end C393001_2;
+
+with TCTouch;
+package body C393001_2 is
+  function Construct( Voltage : Voltages; Amperage : Amps ) ----------- c
+    return Basic_Breaker is
+    It : Basic_Breaker;
+  begin
+    TCTouch.Touch( 'c' );
+    It.Amperage := Amperage;
+    It.Voltage_Level := Voltage;
+    C393001_1.Set( It, C393001_1.Power_Off );
+    return It;
+  end Construct;
+
+  procedure Flip ( The_Breaker : in out Basic_Breaker ) is ------------ d
+  begin
+    TCTouch.Touch( 'd' );
+    case Status_Of( The_Breaker ) is
+      when C393001_1.Power_Off =>
+        C393001_1.Set( The_Breaker, C393001_1.Power_On );
+      when C393001_1.Power_On =>
+        C393001_1.Set( The_Breaker, C393001_1.Power_Off );
+      when C393001_1.Tripped | C393001_1.Failed  => null;
+    end case;
+  end Flip;
+
+  procedure Trip ( The_Breaker : in out Basic_Breaker ) is ------------ e
+  begin
+    TCTouch.Touch( 'e' );
+    C393001_1.Set( The_Breaker, C393001_1.Tripped );
+  end Trip;
+
+  procedure Reset( The_Breaker : in out Basic_Breaker ) is ------------ f
+  begin
+    TCTouch.Touch( 'f' );
+    case Status_Of( The_Breaker ) is
+      when C393001_1.Power_Off | C393001_1.Tripped =>
+        C393001_1.Set( The_Breaker, C393001_1.Power_On );
+      when C393001_1.Power_On  | C393001_1.Failed  => null;
+    end case;
+  end Reset;
+
+end C393001_2;
+
+with C393001_1,C393001_2;
+package C393001_3 is
+  
+  type Ground_Fault is new C393001_2.Basic_Breaker with private;
+
+  function Construct( Voltage : C393001_2.Voltages; Amperage : C393001_2.Amps
+)
+    return Ground_Fault;
+
+  procedure Set_Trip( The_Breaker : in out Ground_Fault;
+                      Capacitance : in     Integer );
+
+private
+  type Ground_Fault is new C393001_2.Basic_Breaker with record
+    Capacitance : Integer;
+  end record;
+end C393001_3;
+
+----------------------------------------------------------------- C393001_3
+
+with TCTouch;
+package body C393001_3 is
+
+  function Construct( Voltage  : C393001_2.Voltages; ------------------ g
+                      Amperage : C393001_2.Amps )
+    return Ground_Fault is
+
+    It : Ground_Fault;
+
+    procedure Set_Root( It: in out C393001_2.Basic_Breaker ) is
+    begin
+      It := C393001_2.Construct( Voltage, Amperage );
+    end Set_Root;
+
+  begin
+    TCTouch.Touch( 'g' );
+    Set_Root( C393001_2.Basic_Breaker( It ) );
+    It.Capacitance := 0;
+    return It;
+  end Construct;
+
+  procedure Set_Trip( The_Breaker : in out Ground_Fault; -------------- h
+                      Capacitance : in     Integer ) is
+  begin
+    TCTouch.Touch( 'h' );
+    The_Breaker.Capacitance := Capacitance;
+  end Set_Trip;
+
+end C393001_3;
+
+----------------------------------------------------------------- C393001_4
+
+with C393001_1, C393001_2;
+package C393001_4 is
+
+  type Special_Breaker is new C393001_2.Basic_Breaker with private;
+
+  function Construct( Voltage     : C393001_2.Voltages;
+                      Amperage    : C393001_2.Amps )
+    return Special_Breaker;
+
+  procedure Flip ( The_Breaker : in out Special_Breaker );
+  procedure Trip ( The_Breaker : in out Special_Breaker );
+  procedure Reset( The_Breaker : in out Special_Breaker );
+  procedure Fail ( The_Breaker : in out Special_Breaker );
+
+  function Status_Of( The_Breaker : Special_Breaker ) return C393001_1.Status;
+  function On_Backup( The_Breaker : Special_Breaker ) return Boolean;
+
+private
+  type Special_Breaker is new C393001_2.Basic_Breaker with record
+    Backup : C393001_2.Basic_Breaker;
+  end record;
+end C393001_4;
+
+with TCTouch;
+package body C393001_4 is
+
+  function Construct( Voltage     : C393001_2.Voltages; --------------- i
+                      Amperage    : C393001_2.Amps )
+    return Special_Breaker is
+    It: Special_Breaker;
+    procedure Set_Root( It: in out C393001_2.Basic_Breaker ) is
+    begin
+      It := C393001_2.Construct( Voltage, Amperage );
+    end Set_Root;
+  begin
+    TCTouch.Touch( 'i' );
+    Set_Root( C393001_2.Basic_Breaker( It ) );
+    Set_Root( It.Backup );
+    return It;
+  end Construct;
+
+  function Status_Of( It: C393001_1.Breaker ) return C393001_1.Status
+    renames C393001_1.Status_Of;
+
+  procedure Flip ( The_Breaker : in out Special_Breaker ) is ---------- j
+  begin
+    TCTouch.Touch( 'j' );
+    case Status_Of( C393001_1.Breaker( The_Breaker )) is
+      when C393001_1.Power_Off | C393001_1.Power_On =>
+        C393001_2.Flip( C393001_2.Basic_Breaker( The_Breaker ) );
+      when others =>
+        C393001_2.Flip( The_Breaker.Backup );
+    end case;
+  end Flip;
+
+  procedure Trip ( The_Breaker : in out Special_Breaker ) is ---------- k
+  begin
+    TCTouch.Touch( 'k' );
+    case Status_Of( C393001_1.Breaker( The_Breaker )) is
+      when C393001_1.Power_Off => null;
+      when C393001_1.Power_On  =>
+        C393001_2.Reset( The_Breaker.Backup );
+        C393001_2.Trip( C393001_2.Basic_Breaker( The_Breaker ) );
+      when others =>
+        C393001_2.Trip( The_Breaker.Backup );
+    end case;
+  end Trip;
+
+  procedure Reset( The_Breaker : in out Special_Breaker ) is ---------- l
+  begin
+    TCTouch.Touch( 'l' );
+    case Status_Of( C393001_1.Breaker( The_Breaker )) is
+      when C393001_1.Tripped  =>
+        C393001_2.Reset( C393001_2.Basic_Breaker( The_Breaker ));
+      when C393001_1.Failed  =>
+        C393001_2.Reset( The_Breaker.Backup );
+      when C393001_1.Power_On | C393001_1.Power_Off =>
+        null;
+    end case;
+  end Reset;
+
+  procedure Fail ( The_Breaker : in out Special_Breaker ) is ---------- m
+  begin
+    TCTouch.Touch( 'm' );
+    case Status_Of( C393001_1.Breaker( The_Breaker )) is
+      when C393001_1.Failed  =>
+        C393001_2.Fail( The_Breaker.Backup );
+      when others => 
+        C393001_2.Fail( C393001_2.Basic_Breaker( The_Breaker ));
+        C393001_2.Reset( The_Breaker.Backup );
+    end case;
+  end Fail;
+
+  function Status_Of( The_Breaker : Special_Breaker ) ----------------- n
+    return C393001_1.Status is
+  begin
+    TCTouch.Touch( 'n' );
+    case Status_Of( C393001_1.Breaker( The_Breaker )) is
+      when C393001_1.Power_On  => return C393001_1.Power_On;
+      when C393001_1.Power_Off => return C393001_1.Power_Off;
+      when others =>
+        return C393001_2.Status_Of( The_Breaker.Backup );
+    end case;
+  end Status_Of;
+
+  function On_Backup( The_Breaker : Special_Breaker ) return Boolean is
+    use C393001_2;
+    use type C393001_1.Status;
+  begin
+    return Status_Of(Basic_Breaker(The_Breaker)) = C393001_1.Tripped
+        or Status_Of(Basic_Breaker(The_Breaker)) = C393001_1.Failed;
+  end On_Backup;
+
+end C393001_4;
+
+------------------------------------------------------------------- C393001
+
+with Report, TCTouch;
+with C393001_1, C393001_2, C393001_3, C393001_4;
+procedure C393001 is
+ 
+  procedure Flipper( The_Circuit : in out C393001_1.Breaker'Class ) is
+  begin
+      C393001_1.Flip( The_Circuit );
+  end Flipper;
+
+  procedure Tripper( The_Circuit : in out C393001_1.Breaker'Class ) is
+  begin
+      C393001_1.Trip( The_Circuit );
+  end Tripper;
+
+  procedure Restore( The_Circuit : in out C393001_1.Breaker'Class ) is
+  begin
+      C393001_1.Reset( The_Circuit );
+  end Restore;
+
+  procedure Failure( The_Circuit : in out C393001_1.Breaker'Class ) is
+  begin
+      C393001_1.Fail( The_Circuit );
+  end Failure;
+
+  Short : C393001_1.Breaker'Class -- Basic_Breaker
+          := C393001_2.Construct( C393001_2.V440, C393001_2.A5 );
+  Sharp : C393001_1.Breaker'Class -- Ground_Fault
+          := C393001_3.Construct( C393001_2.V110, C393001_2.A1 );
+  Shock : C393001_1.Breaker'Class -- Special_Breaker
+          := C393001_4.Construct( C393001_2.V12,  C393001_2.A100 );
+
+begin  -- Main test procedure.
+
+  Report.Test ("C393001", "Check that an abstract type can be declared " &
+               "and used.  Check actual subprograms dispatch correctly" );
+
+  TCTouch.Validate( "cgcicc", "Declaration" );
+
+  Flipper( Short );
+  TCTouch.Validate( "db", "Flipping Short" );
+  Flipper( Sharp );
+  TCTouch.Validate( "db", "Flipping Sharp" );
+  Flipper( Shock );
+  TCTouch.Validate( "jbdb", "Flipping Shock" );
+
+  Tripper( Short );
+  TCTouch.Validate( "e", "Tripping Short" );
+  Tripper( Sharp );
+  TCTouch.Validate( "e", "Tripping Sharp" );
+  Tripper( Shock );
+  TCTouch.Validate( "kbfbe", "Tripping Shock" );
+
+  Restore( Short );
+  TCTouch.Validate( "fb", "Restoring Short" );
+  Restore( Sharp );
+  TCTouch.Validate( "fb", "Restoring Sharp" );
+  Restore( Shock );
+  TCTouch.Validate( "lbfb", "Restoring Shock" );
+
+  Failure( Short );
+  TCTouch.Validate( "a", "Shock Failing" );
+  Failure( Sharp );
+  TCTouch.Validate( "a", "Shock Failing" );
+  Failure( Shock );
+  TCTouch.Validate( "mbafb", "Shock Failing" );
+
+  Report.Result;
+
+end C393001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393007.a
new file mode 100644
index 000000000..93458eeff
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393007.a
@@ -0,0 +1,157 @@
+-- C393007.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that an extended type can be derived from an abstract type,
+--      where the abstract type is defined in a package, and the type derived
+--      from it is defined in a distinct library package.
+--
+-- TEST DESCRIPTION:
+--      Declare an private (abstract) type; declare two primitive operations 
+--      of the type that are explicitly abstract.
+--      Derive an extended type from the (private) abstract type, overriding 
+--      both of the primitive operations.
+--      This test also checks to see that name overloading between abstract
+--      and non-abstract functions is resolved correctly.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+   package C393007_0 is
+        -- Alert_System
+ 
+     type DT_Type is new Integer;
+ 
+     type Alert_Type is abstract tagged record
+        Time_Of_Arrival : DT_Type;
+     end record;
+ 
+     type Log_File_Type is range 0 .. 100;
+ 
+     Procedure Handle (A : in out Alert_type) is abstract;
+       
+     procedure Log    (A : Alert_Type;                   
+                       L : in out Log_File_Type) is abstract;  
+   
+     procedure Set_Time (A : in out Alert_Type);
+ 
+     function Correct_Time_Stamp (A : Alert_Type) return Boolean;
+       
+     Day_Time : DT_Type := 100;
+ 
+   end C393007_0;
+    -- Alert_System;
+ 
+ --=======================================================================--
+ 
+   package body C393007_0 is
+             -- Alert_System
+ 
+     function Time_Stamp return DT_Type is
+       begin
+         Day_Time := Day_Time + 1;
+         return Day_Time;
+       end Time_Stamp;
+ 
+     procedure Set_Time (A : in out Alert_Type) is
+       begin
+         A.Time_Of_Arrival := Time_Stamp;
+       end Set_time;
+       
+     function Correct_Time_Stamp ( A : Alert_Type) return Boolean is
+       begin
+         return (A.Time_Of_Arrival = Day_Time);
+       end Correct_Time_Stamp;
+ 
+   end C393007_0;
+    -- Alert_System;
+ 
+ --=======================================================================--
+ 
+ with Report;
+ with C393007_0;
+   -- Alert_system;
+ 
+ package C393007_1 is
+ 
+   type Normal_Alert_Type is   
+     new C393007_0.Alert_Type
+     with null record;
+ 
+   Log_File: C393007_0.Log_File_Type := C393007_0.Log_File_Type'First;
+ 
+   procedure Handle (A : in out Normal_Alert_Type);  -- Override is required
+ 
+   procedure Log    (A : Normal_Alert_Type;          -- Override is required
+                     L : in out C393007_0.Log_File_Type);
+ end C393007_1;
+ 
+ package body C393007_1 is
+   use type C393007_0.Log_File_Type;
+ 
+   procedure Handle (A : in out Normal_Alert_Type) is   
+     begin
+       Set_Time (A);
+       Log (A, Log_File);
+     end Handle;
+ 
+   procedure Log    (A : Normal_Alert_Type;      
+                     L : in out C393007_0.Log_File_Type) is
+      begin
+        L := C393007_0."+"(L, 1);
+      end Log;
+   
+ end C393007_1;
+ 
+ with Report;
+ with C393007_0;
+ with C393007_1;
+   -- Alert_system;
+ 
+ procedure C393007 is
+   use C393007_0;
+   use C393007_1;
+ 
+   Alert_One : C393007_1.Normal_Alert_Type;
+ 
+ begin
+   Report.Test ("C393007", "Check that an extended type can be derived " &
+                           "from an abstract type");
+ 
+   Handle (Alert_One);
+   if not Correct_Time_Stamp (Alert_One) then
+     Report.Failed ("Wrong results from procedure Handle");
+   end if;
+ 
+   if Log_File /=1 then 
+     Report.Failed ("Wrong results");
+   end if;
+ 
+   Report.Result;
+ 
+ end C393007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393008.a
new file mode 100644
index 000000000..d2d2aefed
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393008.a
@@ -0,0 +1,204 @@
+-- C393008.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that an extended type can be derived from an abstract type.
+--
+-- TEST DESCRIPTION:
+--      Declare a tagged record; declare an abstract 
+--      primitive operation and a non-abstract primitive operation of the 
+--      type.  Derive an extended type from it, including a new component.
+--      Use the derived type, the overriding operation and the inherited 
+--      operation to instantiate a generic package.  The overriding operation
+--      calls a new primitive operation and an inherited operation [so the 
+--      instantiation must get this sorted out correctly].
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with TCTouch;
+procedure C393008 is
+
+package C393008_0 is
+
+  type Status_Enum is (No_Status, Handled, Unhandled, Pending);
+
+  type Alert_Type is abstract tagged record
+      Status : Status_Enum;
+      Reply  : Boolean;
+      Urgent : Boolean;
+  end record;
+
+  subtype Serial_Number is Integer range 0..Integer'last;
+  Serial_Num : Serial_Number := 0;
+
+  procedure Handle   (A : in out Alert_Type) is abstract; 
+                                        -- abstract primitive operation
+
+  -- the procedure Init would be _nice_ have this procedure be non_abstract
+  -- and create a "base" object with a "null" constraint.  The language
+  -- will not allow this due to the restriction that an object of an
+  -- abstract type cannot be created.  Hence Init must be abstract,
+  -- requiring any type derived directly from Alert_Type to declare
+  -- an Init.
+  --
+  -- In light of this, I have changed init to a function to more closely
+  -- model the typical usage of OO features...
+
+  function  Init return Alert_Type is abstract;
+
+  procedure No_Reply (A : in out Alert_Type);
+
+end C393008_0;
+
+--=======================================================================--
+
+package body C393008_0 is
+
+  procedure No_Reply (A : in out Alert_Type) is
+    begin                              -- primitive operation, not abstract
+      TCTouch.Touch('A');  ------------------------------------------------- A
+      if A.Status = Handled then
+        A.Reply  := False;
+      end if;
+    end No_Reply;
+
+end C393008_0;
+
+--=======================================================================--
+
+  generic
+                        -- pass in the Alert_Type object, including its 
+                        -- operations
+    type Data_Type is new C393008_0.Alert_Type with private; 
+                        -- note that Alert_Type is abstract, so it may not be
+                        -- used as an actual parameter
+    with procedure Update     (P : in out Data_Type) is <>;  -- generic formal
+    with function  Initialize return Data_Type is <>;        -- generic formal
+
+  package C393008_1 is
+       -- Utilities
+
+    procedure Modify (Item : in out Data_Type);
+
+  end C393008_1;
+   -- Utilities
+
+--=======================================================================--
+
+  package body C393008_1 is
+            -- Utilities
+
+      procedure Modify (Item : in out Data_Type) is
+        begin
+          TCTouch.Touch('B');  --------------------------------------------- B
+          Item := Initialize;
+          Update (Item);
+        end Modify;
+
+  end C393008_1;
+
+--=======================================================================--
+
+  package C393008_2 is
+
+    type Low_Alert_Type is new C393008_0.Alert_Type with record
+      Serial : C393008_0.Serial_Number;
+    end record;
+  
+    procedure Serialize (LA : in out Low_Alert_Type);
+  
+    -- inherit No_Reply
+
+    procedure Handle (LA : in out Low_Alert_Type);
+
+    function Init return Low_Alert_Type;
+  end C393008_2;
+
+  package body C393008_2 is
+    procedure Serialize (LA : in out Low_Alert_Type) is
+    begin                          -- new primitive operation
+      TCTouch.Touch('C');  ------------------------------------------------- C
+      C393008_0.Serial_Num := C393008_0.Serial_Num + 1;
+      LA.Serial := C393008_0.Serial_Num;
+    end Serialize;
+  
+  -- inherit No_Reply
+
+    function Init return Low_Alert_Type is
+      TA: Low_Alert_Type;
+    begin
+      TCTouch.Touch('D');  ------------------------------------------------- D
+      Serialize( TA );
+      TA.Status := C393008_0.No_Status;
+      return TA;
+    end Init;
+
+    procedure Handle (LA : in out Low_Alert_Type) is    
+    begin                          -- overrides abstract inherited Handle
+      TCTouch.Touch('E');  ------------------------------------------------- E
+      Serialize (LA);
+      LA.Reply := False;
+      LA.Status := C393008_0.Handled;
+      No_Reply (LA);
+    end Handle;
+
+  end C393008_2;
+
+  use C393008_2;
+  
+  package Alert_Utilities is new
+    C393008_1 (Data_Type   => Low_Alert_Type,
+               Update      => Handle,   -- Low_Alert's Handle
+               Initialize  => Init);    -- inherited from Alert
+
+  Item : Low_Alert_Type;
+
+  use type C393008_0.Status_Enum;
+
+begin
+
+  Report.Test ("C393008", "Check that an extended type can be derived "&
+                          "from an abstract type");
+
+  Item := Init;
+  if (Item.Status /= C393008_0.No_Status) or (Item.Serial /=1)  then
+    Report.Failed ("Wrong initialization");
+  end if;
+  TCTouch.Validate("DC", "Initialization Call");
+
+  Alert_Utilities.Modify (Item);
+  if (Item.Status /= C393008_0.Handled) or (Item.Serial /= 3) then 
+    Report.Failed ("Wrong results from Modify");
+  end if;
+  TCTouch.Validate("BDCECA", "Generic Instance Call");
+
+  Report.Result;
+
+end C393008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393009.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393009.a
new file mode 100644
index 000000000..1353f9c37
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393009.a
@@ -0,0 +1,170 @@
+-- C393009.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that an extended type can be derived from an abstract type.
+--
+-- TEST DESCRIPTION:
+--      Declare an abstract type in the specification of a generic package.
+--      Instantiate the package and derive an extended type from the abstract
+--      (instantiated) type; override all abstract operations; use all
+--      inherited operations;
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      14 Oct 95   SAIC    Fixed for ACVC 2.0.1
+--
+--!
+  
+with Report;
+procedure C393009 is
+  
+  package Display_Devices is
+  
+    type Display_Device_Enum is (None, TTY, Console, Big_Screen);
+    Display : Display_Device_Enum := None;
+  
+  end Display_Devices;
+  
+--=======================================================================--
+  
+  generic
+  
+    type Generic_Status is (<>);
+    
+    type Serial_Type is (<>);
+  
+  package Alert_System is
+  
+    type Alert_Type (Serial : Serial_Type) is abstract tagged record
+      Status : Generic_Status;
+    end record;
+    
+    Next_Serial_Number : Serial_Type := Serial_Type'First;
+  
+    procedure Handle (A : in out Alert_Type) is abstract;
+      -- abstract operation - must be overridden after instantiation
+  
+    procedure Display ( A : Alert_Type; 
+                       On : Display_Devices.Display_Device_Enum);
+              -- primitive operation of Alert_Type
+              -- not required to be overridden
+  
+    function Get_Serial_Number (A : Alert_Type) return Serial_Type;
+              -- primitive operation of Alert_Type
+              -- not required to be overridden
+  
+  end Alert_System;
+  
+--=======================================================================--
+  
+  package body Alert_System is
+  
+    procedure Display ( A : in Alert_Type;
+                       On : Display_Devices.Display_Device_Enum) is
+      begin
+        Display_Devices.Display := On;
+      end Display;
+  
+    function Get_Serial_Number (A : Alert_Type) 
+      return Serial_Type is
+      begin
+        return A.Serial;
+      end Get_Serial_Number;
+  
+  end Alert_System;
+  
+--=======================================================================--
+
+  package NCC_1701 is
+  
+    type Status_Kind is (Green, Yellow, Red);
+    type Serial_Number_Type is new Integer range 1..Integer'Last;
+    
+    subtype Msg_Str is String (1..16);
+    Alert_Msg : Msg_Str := "C393009  passed.";
+                        --  123456789A123456
+  
+    package Alert_Pkg is new Alert_System (Status_Kind, Serial_Number_Type);
+  
+    type New_Alert_Type(Serial : Serial_Number_Type) is
+      new Alert_Pkg.Alert_Type(Serial) with record
+      Message : Msg_Str;
+      end record;
+   
+    -- procedure Display is inherited by New_Alert_Type
+  
+    -- function Get_Serial_Number is inherited by New_Alert_Type
+    procedure Handle (NA : in out New_Alert_Type);  -- must be overridden
+    procedure Init   (NA : in out New_Alert_Type);  -- new primitive
+  
+    NA : New_Alert_Type(Alert_Pkg.Next_Serial_Number);
+         -- New_Alert_Type is not abstract, so an object of that
+         -- type may be declared
+  
+  end NCC_1701;
+  
+  package body NCC_1701 is
+  
+    procedure Handle (NA : in out New_Alert_Type) is
+    begin
+      NA.Message := Alert_Msg;
+      Display (NA, On => Display_Devices.TTY);
+      end Handle;
+  
+    procedure Init (NA : in out New_Alert_Type) is  -- new primitive operation
+    begin                                           -- for New_Alert_Type
+      NA := (Serial=> NA.Serial, Status => Green, Message => (others => ' '));
+    end Init;
+    
+   end NCC_1701;
+  
+   use NCC_1701;
+   use type Display_Devices.Display_Device_Enum;
+  
+begin
+
+  Report.Test ("C393009", "Check that an extended type can be derived " &
+                          "from an abstract type");
+
+  Init (NA);
+  if (Get_Serial_Number (NA) /= 1)
+    or (NA.Status /= Green)
+    or (Display_Devices.Display /= Display_Devices.None) then
+      Report.Failed ("Wrong Initialization");
+  end if;
+  
+  Handle (NA);
+  if (Get_Serial_Number (NA) /= 1)
+    or (NA.Status /= Green)
+    or (NA.Message /= Alert_Msg) 
+    or (Display_Devices.Display /= Display_Devices.TTY) then
+      Report.Failed ("Wrong results from Handle");
+  end if;
+  
+  Report.Result;
+
+end C393009;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393010.a
new file mode 100644
index 000000000..6a52cf889
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393010.a
@@ -0,0 +1,306 @@
+-- C393010.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that an extended type can be derived from an abstract type and
+--      that a call on an abstract operation is a dispatching operation.
+--      Check that such a call can dispatch to an overriding operation
+--      declared in the private part of a package.
+--
+-- TEST DESCRIPTION:
+--      Taking from a classroom example of a typical usage: declare a basic
+--      abstract type containing data germane to the entire class structure,
+--      derive from that a type with specific data, and derive from that
+--      another type merely providing a "secret" override.  The abstract type
+--      provides a concrete procedure that itself "redispatches" to an
+--      abstract procedure; the abstract procedure must be provided by one or
+--      more of the concrete types derived from the abstract type, and hence
+--      upon re-evaluating the actual type of the operand should dispatch
+--      accordingly.
+--
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Mar 96   SAIC    ACVC 2.1
+--
+--!
+
+----------------------------------------------------------------- C393010_0
+
+package C393010_0 is
+
+  type Ticket is abstract tagged record
+    Flight        : Natural;
+    Serial_Number : Natural;
+  end record;
+
+  function Issue return Ticket is abstract;
+  procedure Label( T: Ticket ) is abstract;
+
+  procedure Print( T: Ticket );
+
+end C393010_0;
+
+with TCTouch;
+package body C393010_0 is
+
+  procedure Print( T: Ticket ) is
+  begin
+    -- Check that a call on an abstract operation is a dispatching operation
+    Label( Ticket'Class( T ) );
+    -- Appropriate_IO.Put( T.Flight & T.Serial_Number );
+    TCTouch.Touch('P'); -------------------------------------------------- P
+  end Print;
+
+end C393010_0;
+
+----------------------------------------------------------------- C393010_1
+
+with C393010_0;
+package C393010_1 is
+
+  type Service_Classes is (First, Business, Coach);
+
+  type Menu is (Steak, Lobster, Fowl, Vegan);
+
+  -- Check that an extended type can be derived from an abstract type.
+  type Passenger_Ticket(Service : Service_Classes) is
+    new C393010_0.Ticket with record
+      Row_Seat : String(1..3);
+      case Service is
+        when First | Business => Meal : Menu;
+        when Coach => null;
+      end case;
+  end record;
+
+  function Issue return Passenger_Ticket;
+  function Issue( Service : Service_Classes;
+                   Flight : Natural;
+                     Seat : String;
+                     Meal : Menu := Fowl ) return Passenger_Ticket;
+
+  procedure Label( T: Passenger_Ticket );
+
+  procedure Print( T: Passenger_Ticket );
+
+end C393010_1;
+
+with TCTouch;
+package body C393010_1 is
+
+  procedure Label( T: Passenger_Ticket ) is
+  begin
+    -- Appropriate_IO.Put( T.Service );
+    TCTouch.Touch('L'); -------------------------------------------------- L
+  end Label;
+
+  procedure Print( T: Passenger_Ticket ) is
+  begin
+    -- call parent print:
+    C393010_0.Print( C393010_0.Ticket( T ) );
+    case T.Service is
+      when First    => -- Appropriate_IO.Put( Meal );
+        TCTouch.Touch('F'); ---------------------------------------------- F
+      when Business => -- Appropriate_IO.Put( Meal );
+        TCTouch.Touch('B'); ---------------------------------------------- B
+      when Coach    => -- Appropriate_IO.Put( "BYO" & " peanuts" );
+        TCTouch.Touch('C'); ---------------------------------------------- C
+    end case;   
+  end Print;
+
+  Num : Natural := 1000;
+
+  function Issue( Service : Service_Classes;
+                   Flight : Natural;
+                     Seat : String;
+                     Meal : Menu := Fowl ) return Passenger_Ticket is
+  begin
+    Num := Num +1;
+    case Service is
+      when First =>
+        return Passenger_Ticket'(Service => First, Flight => Flight,
+                       Row_Seat => Seat, Meal => Meal, Serial_Number => Num );
+      when Business =>
+        return Passenger_Ticket'(Service => Business, Flight => Flight,
+                       Row_Seat => Seat, Meal => Meal, Serial_Number => Num );
+      when Coach =>
+        return Passenger_Ticket'(Service => Coach, Flight => Flight,
+                       Row_Seat => Seat, Serial_Number => Num );
+    end case;
+  end Issue;
+
+  function Issue return Passenger_Ticket is
+  begin
+    return Issue( Coach, 0, "non" );
+  end Issue;
+
+end C393010_1;
+
+----------------------------------------------------------------- C393010_1
+
+with C393010_1;
+package C393010_2 is
+
+  type Charter is new C393010_1.Passenger_Ticket( C393010_1.Coach )
+    with private;
+
+  function Issue return Charter;
+
+  -- procedure Print( T: Passenger_Ticket );
+
+private
+  type Charter is new C393010_1.Passenger_Ticket( C393010_1.Coach )
+    with null record;
+
+  -- Check that the dispatching call to the abstract operation will dispatch
+  -- to a procedure defined in the private part of a package.
+  procedure Label( T: Charter );
+
+  -- an example of a required function the users shouldn't see:
+  function Issue( Service : C393010_1.Service_Classes;
+                   Flight : Natural;
+                     Seat : String;
+                     Meal : C393010_1.Menu ) return Charter;
+
+end C393010_2;
+
+with TCTouch;
+package body C393010_2 is
+
+  procedure Label( T: Charter ) is
+  begin
+    -- Appropriate_IO.Put( "Excursion Fare" );
+    TCTouch.Touch('X'); -------------------------------------------------- X
+  end Label;
+
+  Num : Natural := 4000;
+
+  function Issue return Charter is
+  begin
+    Num := Num +1;
+    return Charter'(Service => C393010_1.Coach, Flight => 1001,
+                       Row_Seat => "OPN", Serial_Number => Num );
+  end Issue;
+
+  function Issue( Service : C393010_1.Service_Classes;
+                   Flight : Natural;
+                     Seat : String;
+                     Meal : C393010_1.Menu ) return Charter is
+  begin
+    return Issue;
+  end Issue;
+
+end C393010_2;
+
+----------------------------------------------------------------- C393010_1
+
+with Report;
+with TCTouch;
+with C393010_0;
+with C393010_1;
+with C393010_2; -- Charter Tours
+
+procedure C393010 is
+
+  type Agents_Handle is access all C393010_0.Ticket'Class;
+
+  type Itinerary;
+
+  type Next_Leg is access Itinerary;
+
+  type Itinerary is record
+    Leg  : Agents_Handle;
+    Next : Next_Leg;
+  end record;
+
+  function Travel_Agent_1 return Next_Leg is
+  begin
+    -- ORL -> JFK -> LAX -> SAN -> DFW -> ORL
+    return new Itinerary'(
+       -- ORL -> JFK 01   12  2A First, Lobster
+       new C393010_1.Passenger_Ticket'(
+         C393010_1.Issue(C393010_1.First, 12, " 2A", C393010_1.Lobster )),
+         new Itinerary'(
+       -- JFK -> LAX 02   18  2B First, Steak
+       new C393010_1.Passenger_Ticket'(
+         C393010_1.Issue(C393010_1.First, 18, " 2B", C393010_1.Steak )),
+         new Itinerary'(
+       -- LAX -> SAN 03 5225 34H Coach
+       new C393010_1.Passenger_Ticket'(
+         C393010_1.Issue(C393010_1.Coach, 5225, "34H")),
+         new Itinerary'(
+       -- SAN -> DFW 04   25 13A Business, Fowl
+       new C393010_1.Passenger_Ticket'(
+         C393010_1.Issue(C393010_1.Business, 25, "13A")),
+         new Itinerary'(
+       -- DFW -> ORL 05   15  1D First, Lobster
+       new C393010_1.Passenger_Ticket'(
+         C393010_1.Issue(C393010_1.First, 15, " 1D", C393010_1.Lobster )),
+         null          )))));
+  end Travel_Agent_1;
+
+  function Travel_Agent_2 return Next_Leg is
+  begin
+    -- LAX -> NRT -> SYD -> LAX
+    return new Itinerary'(
+       new C393010_2.Charter'( C393010_2.Issue ),
+         new Itinerary'(
+       new C393010_2.Charter'( C393010_2.Issue ),
+         new Itinerary'(
+       new C393010_2.Charter'( C393010_2.Issue ),
+         new Itinerary'(
+       new C393010_2.Charter'( C393010_2.Issue ),
+         null ))));
+  end Travel_Agent_2;
+
+  procedure Traveler( Pax_Tix : in Next_Leg ) is
+    Fly_Me : Next_Leg := Pax_Tix;
+  begin
+    -- a particularly consumptive process...
+    while Fly_Me /= null loop
+      C393010_0.Print( Fly_Me.Leg.all );  -- herein lies the test.
+      Fly_Me := Fly_Me.Next;
+    end loop;
+  end Traveler;
+
+begin
+
+  Report.Test ("C393010", "Check that an extended type can be derived from "
+                        & "an abstract type and that a call on an abstract "
+                        & "operation is a dispatching operation.  Check "
+                        & "that such a call can dispatch to an overriding "
+                        & "operation declared in the private part of a "
+                        & "package" );
+
+  Traveler( Travel_Agent_1 );
+  TCTouch.Validate("LPFLPFLPCLPBLPF","First Trip");
+
+  Traveler( Travel_Agent_2 );
+  TCTouch.Validate("XPCXPCXPCXPC","Second Trip");
+
+  Report.Result;
+
+end C393010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393011.a
new file mode 100644
index 000000000..8741e87c1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393011.a
@@ -0,0 +1,220 @@
+-- C393011.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that an abstract extended type can be derived from an abstract
+--      type, and that a a non-abstract type may then be derived from the
+--      second abstract type.
+--
+-- TEST DESCRIPTION:
+--      Define an abstract type with three primitive operations, two of them
+--      abstract.  Derive an extended type from it, inheriting the non-
+--      abstract operation, overriding one of the abstract operations with
+--      a non-abstract operation, and overriding the other abstract operation
+--      with an abstract operation.  The extended type is therefore abstract;
+--      derive an extended type from it.  Override the abstract operation with
+--      a non-abstract operation; inherit one operation from the original
+--      abstract type, and inherit one operation from the intermediate 
+--      abstract type.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+ 
+ Package C393011_0 is
+     -- Definitions
+ 
+   type Status_Enum is (None, Unhandled, Pending, Handled);
+   type Serial_Type is new Integer range 0 .. Integer'Last;
+   subtype Priority_Type is Integer range 0..10;
+ 
+   type Display_Enum is (Bit_Bucket, TTY, Console, Big_Screen);
+ 
+   Next : Serial_Type := 1;
+   Display_Device : Display_Enum := Bit_Bucket;
+ 
+ end C393011_0;
+ -- Definitions;
+ 
+ --=======================================================================--
+ 
+ with C393011_0;
+   -- Definitions
+ 
+ Package C393011_1 is
+      -- Alert
+ 
+   package Definitions renames C393011_0;
+ 
+   type Alert_Type is abstract tagged record         
+     Status     : Definitions.Status_Enum := Definitions.None;  
+     Serial_Num : Definitions.Serial_Type := 0;
+     Priority   : Definitions.Priority_Type;
+   end record;
+                             -- Alert_Type is an abstract type with
+                             -- two operations to be overridden
+ 
+   procedure Set_Status ( A : in out Alert_Type;          -- not abstract
+                         To : Definitions.Status_Enum);
+ 
+   procedure Set_Serial ( A : in out Alert_Type) is abstract;
+   procedure Display    ( A : Alert_Type)        is abstract;
+  
+ end C393011_1;
+  -- Alert
+ 
+ --=======================================================================--
+ 
+ with C393011_0;
+ package body C393011_1 is
+           -- Alert
+   procedure Set_Status ( A : in out Alert_Type;
+                         To : Definitions.Status_Enum) is
+     begin
+       A.Status := To;
+     end Set_Status;
+ 
+ end C393011_1;
+  -- Alert;
+ 
+ --=======================================================================--
+ 
+ with C393011_0,
+   -- Definitions, 
+      C393011_1,
+   -- Alert, 
+      Calendar;
+ 
+ Package C393011_3 is
+      -- New_Alert
+ 
+   type New_Alert_Type is abstract new C393011_1.Alert_Type with record
+     Display_Dev : C393011_0.Display_Enum := C393011_0.TTY;
+   end record;
+ 
+   -- procedure Set_Status is inherited
+ 
+   procedure Set_Serial ( A : in out New_Alert_Type);   -- override/see body
+ 
+   procedure Display    ( A : New_Alert_Type) is abstract;
+                          -- override is abstract 
+                          -- still can't declare objects of New_Alert_Type
+ 
+ end C393011_3;
+  -- New_Alert
+ 
+ --=======================================================================--
+ 
+ with C393011_0;
+ Package Body C393011_3 is 
+           -- New_Alert
+ 
+   package Definitions renames C393011_0;
+ 
+   procedure Set_Serial (A : in out New_Alert_Type) is
+     use type Definitions.Serial_Type;
+     begin
+       A.Serial_Num := Definitions.Next;
+       Definitions.Next := Definitions."+"( Definitions.Next, 1);
+     end Set_Serial;
+ 
+ End C393011_3;
+  -- New_Alert;
+ 
+ --=======================================================================--
+ 
+ with C393011_0,
+   -- Definitions 
+      C393011_3;
+   -- New_Alert  -- package Alert is not visible
+ package C393011_4 is
+ 
+   package New_Alert renames C393011_3;
+   package Definitions renames C393011_0;
+ 
+   type Final_Alert_Type is new New_Alert.New_Alert_Type with null record;
+   -- inherits Set_Status including body
+   -- inherits Set_Serial including body
+   -- must override Display since inherited Display is abstract
+   procedure Display(FA : in     Final_Alert_Type);
+   procedure Handle (FA : in out Final_Alert_Type);
+ 
+ end C393011_4;
+ 
+ package body C393011_4 is
+ 
+   procedure Display    (FA : in Final_Alert_Type) is 
+     begin
+       Definitions.Display_Device := FA.Display_Dev;
+     end Display;
+ 
+   procedure Handle (FA : in out Final_Alert_Type) is
+     begin
+       Set_Status (FA, Definitions.Handled);
+       Set_Serial (FA);
+       Display (FA);
+     end Handle;
+ end C393011_4;
+ 
+ with C393011_0,
+   -- Definitions 
+      C393011_3;
+   -- New_Alert  -- package Alert is not visible
+ with C393011_4;
+ with Report;
+ procedure C393011 is
+   use C393011_4;
+   use Definitions;
+ 
+   FA : Final_Alert_Type;
+ 
+ begin
+ 
+   Report.Test ("C393011", "Check that an extended type can be derived " &
+                           "from an abstract type");
+ 
+   if (Definitions.Display_Device /= Definitions.Bit_Bucket)
+       or (Definitions.Next /= 1)
+       or (FA.Status /= Definitions.None)
+       or (FA.Serial_Num /= 0)
+       or (FA.Display_Dev /= TTY) then
+     Report.Failed ("Incorrect initial conditions");
+   end if;
+ 
+   Handle (FA);
+   if (Definitions.Display_Device /= Definitions.TTY)
+       or (Definitions.Next /= 2)
+       or (FA.Status /= Definitions.Handled)
+       or (FA.Serial_Num /= 1)
+       or (FA.Display_Dev /= TTY) then
+     Report.Failed ("Incorrect results from Handle");
+   end if;
+ 
+   Report.Result;
+ 
+ end C393011;
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393012.a
new file mode 100644
index 000000000..16bf6ddcc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393012.a
@@ -0,0 +1,221 @@
+-- C393012.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 non-abstract subprogram of an abstract type can be
+--     called with a controlling operand that is a type conversion to
+--     the abstract type.
+--
+--     Check that converting to the class-wide type of an abstract type
+--     inside an operation of that type causes a "redispatch" of the
+--     called operation.
+--
+-- TEST DESCRIPTION:
+--     This test defines an abstract type, and further derives types from it.
+--     The key feature of this test is in the "Display" procedures where
+--     the bodies of these procedures convert an object to the class-wide
+--     type of the root abstract type, causing a "redispatch".
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      16 Dec 94   SAIC    Add allocation to the object initializations
+--
+--!
+
+package C393012_0 is
+
+  subtype Row_Number  is Positive  range 1..120;
+  subtype Seat_Letter is Character range 'A'..'M';
+
+  type Ticket is abstract tagged
+    record
+      Flight : Natural;
+      Row    : Row_Number;
+      Seat   : Seat_Letter;
+    end record;
+
+   function Display( T: Ticket ) return String;
+   function Service( T: Ticket ) return String is abstract;
+
+end C393012_0;
+
+with TCTouch;
+package body C393012_0 is
+   function Display( T: Ticket ) return String is
+  begin
+    TCTouch.Touch('T');  --------------------------------------------------- T
+    return "Fl:" & Natural'Image(T.Flight)
+         & Service( Ticket'Class( T ) )   
+         & " Seat:" & Row_Number'Image(T.Row) & T.Seat;
+  end Display;
+end C393012_0;
+
+with C393012_0;
+package C393012_1 is
+  type Economy is new C393012_0.Ticket with null record;
+  function Display( T: Economy ) return String;
+  function Service( T: Economy ) return String;
+
+  type Meal_Designator is ( B, L, D, V, SN );
+
+  type First is new C393012_0.Ticket with
+    record
+      Meal : Meal_Designator;
+    end record;
+  function Display( T: First ) return String;
+  function Service( T: First ) return String;
+  procedure Set_Meal( T: in out First; To_Meal : Meal_Designator );
+
+end C393012_1;
+
+with TCTouch;
+package body C393012_1 is
+  function Display( T: Economy ) return String is
+  begin
+    TCTouch.Touch('E');  --------------------------------------------------- E
+    return C393012_0.Display( C393012_0.Ticket( T ) );  
+  end Display;                -- conversion to abstract type
+
+  function Service( T: Economy ) return String is
+  begin
+    TCTouch.Touch('e');  --------------------------------------------------- e
+    return " K";
+  end Service;
+
+  function Display( T: First ) return String is
+  begin
+    TCTouch.Touch('F');  --------------------------------------------------- F
+    return C393012_0.Display( C393012_0.Ticket( T ) );  
+  end Display;                -- conversion to abstract type
+
+  function Service( T: First ) return String is
+  begin
+    TCTouch.Touch('f');  --------------------------------------------------- f
+    return " F" & Meal_Designator'Image(T.Meal);
+  end Service;
+
+  procedure Set_Meal( T: in out First; To_Meal : Meal_Designator ) is
+  begin
+    T.Meal := To_Meal;
+  end Set_Meal;
+
+end C393012_1;
+
+with Report;
+with TCTouch;
+with C393012_0;
+with C393012_1;
+procedure C393012 is
+
+  package Rt renames C393012_0;
+  package Tx renames C393012_1;
+
+  type Tix is access Rt.Ticket'Class;
+  type Itinerary is array(Positive range 1..3) of Tix;
+
+-- Outbound and Inbound itineraries provide different orderings of mixtures
+-- of Economy and First_Class.  Not that that should make any difference...
+
+  Outbound : Itinerary := ( 1 => new Tx.Economy'( 5335,  5, 'B' ),
+                            2 => new Tx.First'  (   67,  1, 'J', Tx.L ),
+                            3 => new Tx.Economy'(  345, 37, 'C' ) );
+
+  Inbound  : Itinerary := ( 1 => new Tx.First'  (  456,  4, 'F', Tx.SN ),
+                            2 => new Tx.Economy'(   68, 12, 'D' ),
+                            3 => new Tx.Economy'( 5336,  6, 'A' ) );
+
+-- Each call to Display uses a parameter that is a type conversion
+-- to the abstract type Ticket.
+
+  procedure TC_Convert( I: Itinerary; Leg1,Leg2,Leg3: String ) is
+  begin
+    if Rt.Display( Rt.Ticket( I(1).all ) ) /= Leg1 then
+      Report.Failed( Rt.Display( Rt.Ticket( I(1).all ) ) & " /= " & Leg1 );
+    end if;
+    if Rt.Display( Rt.Ticket( I(2).all ) ) /= Leg2 then
+      Report.Failed( Rt.Display( Rt.Ticket( I(2).all ) ) & " /= " & Leg2 );
+    end if;
+    if Rt.Display( Rt.Ticket( I(3).all ) ) /= Leg3 then
+      Report.Failed( Rt.Display( Rt.Ticket( I(3).all ) ) & " /= " & Leg3 );
+    end if;
+  end TC_Convert;
+
+-- Each call to Display uses a parameter that is not a type conversion
+
+  procedure TC_Match( I: Itinerary; Leg1,Leg2,Leg3: String ) is
+  begin
+    if Rt.Display( I(1).all ) /= Leg1 then
+      Report.Failed( Rt.Display( I(1).all ) & " /= " & Leg1 );
+    end if;
+    if Rt.Display( I(2).all ) /= Leg2 then
+      Report.Failed( Rt.Display( I(2).all ) & " /= " & Leg2 );
+    end if;
+    if Rt.Display( I(3).all ) /= Leg3 then
+      Report.Failed( Rt.Display( I(3).all ) & " /= " & Leg3 );
+    end if;
+  end TC_Match;
+
+begin  -- Main test procedure.
+
+   Report.Test ("C393012", "Check that a non-abstract subprogram of an "
+                         & "abstract type can be called with a "
+                         & "controlling operand that is a type "
+                         & "conversion to the abstract type.  "
+                         & "Check that converting to the class-wide type "
+                         & "of an abstract type inside an operation of "
+                         & "that type causes a redispatch" );
+
+  -- Test conversions to abstract type
+
+   TC_Convert( Outbound, "Fl: 5335 K Seat: 5B",
+                         "Fl: 67 FL Seat: 1J",
+                         "Fl: 345 K Seat: 37C" );
+
+   TCTouch.Validate( "TeTfTe", "Outbound flight (converted)" );
+
+   TC_Convert( Inbound, "Fl: 456 FSN Seat: 4F",
+                        "Fl: 68 K Seat: 12D",
+                        "Fl: 5336 K Seat: 6A" );
+
+   TCTouch.Validate( "TfTeTe", "Inbound flight (converted)" );
+
+  -- Test without conversions to abstract type
+
+   TC_Match( Outbound, "Fl: 5335 K Seat: 5B",
+                       "Fl: 67 FL Seat: 1J",
+                       "Fl: 345 K Seat: 37C" );
+
+   TCTouch.Validate( "ETeFTfETe", "Outbound flight" );
+
+   TC_Match( Inbound, "Fl: 456 FSN Seat: 4F",
+                       "Fl: 68 K Seat: 12D",
+                       "Fl: 5336 K Seat: 6A" );
+
+   TCTouch.Validate( "FTfETeETe", "Inbound flight" );
+
+   Report.Result;
+
+end C393012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a02.a
new file mode 100644
index 000000000..177bd34b8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a02.a
@@ -0,0 +1,213 @@
+-- C393A02.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 dispatching call to an abstract subprogram invokes
+--     the correct subprogram body of a descendant type according to
+--     the controlling tag.
+--     Check that a subprogram can be declared with formal parameters
+--     and result that are of an abstract type's associated class-wide
+--     type and that such subprograms can be called. 3.4.1(4)
+--
+-- TEST DESCRIPTION:
+--     This test declares several objects of types derived from the
+--     abstract type as defined in the foundation F393A00.  It then calls
+--     various dispatching and class-wide subprograms using those objects.
+--     The packages in F393A00 are instrumented to trace the flow of
+--     execution.
+--     The test checks for the correct order of execution, as expected
+--     by the various calls.
+--
+-- TEST FILES:
+--     The following files comprise this test:
+--
+--        F393A00.A   (foundation code)
+--        C393A02.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--      05 APR 96   SAIC    Update RM references for 2.1
+--
+--!
+
+with Report;
+with F393A00_0;
+with F393A00_1;
+with F393A00_2;
+with F393A00_3;
+with F393A00_4;
+procedure C393A02 is
+
+  A_Windmill : F393A00_2.Windmill;
+  A_Pump     : F393A00_3.Pump;
+  A_Mill     : F393A00_4.Mill;
+
+  A_Windmill_2 : F393A00_2.Windmill;
+  A_Pump_2     : F393A00_3.Pump;
+  A_Mill_2     : F393A00_4.Mill;
+
+  B_Windmill : F393A00_2.Windmill;
+  B_Pump     : F393A00_3.Pump;
+  B_Mill     : F393A00_4.Mill;
+
+  procedure Swapem( A,B: in out F393A00_2.Windmill'Class ) is
+  begin
+   F393A00_0.TC_Touch('x');
+   F393A00_2.Swap( A,B );
+  end Swapem;
+
+  function Zephyr( A: F393A00_2.Windmill'Class )
+           return F393A00_2.Windmill'Class is
+    Item : F393A00_2.Windmill'Class := A;
+  begin
+    F393A00_0.TC_Touch('y');
+    if not F393A00_1.Initialized( Item ) then  -- b
+      F393A00_2.Initialize( Item );            -- a
+    end if;
+    F393A00_2.Stop( Item );                    -- f / mff
+    F393A00_2.Add_Spin( Item, 10 );            -- e
+    return Item;
+  end Zephyr;
+
+  function Gale( It: F393A00_2.Windmill ) return F393A00_2.Windmill'Class is
+    Item : F393A00_2.Windmill'Class := It;
+  begin
+    F393A00_2.Stop( Item );                   -- f
+    F393A00_2.Add_Spin( Item, 40 );           -- e
+    return Item;
+  end Gale;
+
+  function Gale( It: F393A00_3.Pump ) return F393A00_2.Windmill'Class is
+    Item : F393A00_2.Windmill'Class := It;
+  begin 
+    F393A00_2.Stop( Item );                   -- f
+    F393A00_2.Add_Spin( Item, 50 );           -- e
+    return Item;
+  end Gale;
+
+  function Gale( It: F393A00_4.Mill ) return F393A00_2.Windmill'Class is
+    Item : F393A00_2.Windmill'Class := It;
+  begin 
+    F393A00_2.Stop( Item );                   -- mff
+    F393A00_2.Add_Spin( Item, 60 );           -- e
+    return Item;
+  end Gale;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C393A02", "Check that a dispatching call to an abstract "
+                         & "subprogram invokes the correct subprogram body. "
+                         & "Check that a subprogram declared with formal "
+                         & "parameters/result of an abstract type's "
+                         & "associated class-wide can be called" );
+
+  F393A00_0.TC_Validate( "hhh", "Mill declarations" );
+  A_Windmill := F393A00_2.Create;
+  F393A00_0.TC_Validate( "d", "Create A_Windmill" );
+
+  A_Pump     := F393A00_3.Create;
+  F393A00_0.TC_Validate( "h", "Create A_Pump" );
+
+  A_Mill     := F393A00_4.Create;
+  F393A00_0.TC_Validate( "hl", "Create A_Mill" );
+
+  --------------
+
+  Swapem( A_Windmill, A_Windmill_2 );
+  F393A00_0.TC_Validate( "xc", "Windmill Swap" );
+  
+  Swapem( A_Pump, A_Pump_2 );
+  F393A00_0.TC_Validate( "xc", "Pump Swap" );
+  
+  Swapem( A_Mill, A_Mill_2 );
+  F393A00_0.TC_Validate( "xk", "Pump Swap" );
+
+  F393A00_2.Initialize( A_Windmill_2 );  
+  F393A00_3.Initialize( A_Pump_2 );      
+  F393A00_4.Initialize( A_Mill_2 );      
+  B_Windmill := A_Windmill_2;
+  B_Pump     := A_Pump_2;
+  B_Mill     := A_Mill_2;                
+  F393A00_2.Add_Spin( B_Windmill, 123 ); 
+  F393A00_3.Set_Rate( B_Pump, 12.34 );   
+  F393A00_4.Add_Spin( B_Mill, 321 );     
+  F393A00_0.TC_Validate( "aaaeie", "Setting Values" );
+
+  declare
+    It : F393A00_2.Windmill'Class := Zephyr( B_Windmill ); -- ybfe
+    XX : F393A00_2.Windmill'Class := Gale( B_Windmill );   -- fe
+    use type F393A00_2.Rotational_Measurement;
+  begin
+    if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
+then
+      Report.Failed( "Copy to class-wide variable" );
+    end if;                                                -- bb
+    if F393A00_2.Spin( It ) /= 10                          -- g
+       or F393A00_2.Spin( XX ) /= 40 then                  -- g
+      Report.Failed( "Call to class-wide operation" );
+    end if;
+
+    F393A00_0.TC_Validate( "ybfefebbgg", "Windmill Zephyr" );
+  end;
+
+  declare
+    It : F393A00_2.Windmill'Class := Zephyr( B_Pump );     -- ybfe
+    XX : F393A00_2.Windmill'Class := Gale( B_Pump );       -- fe
+    use type F393A00_2.Rotational_Measurement;
+  begin
+    if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
+then
+      Report.Failed( "Bad copy to class-wide variable" );
+    end if;                                                -- bb
+    if F393A00_2.Spin( It ) /= 10                          -- g
+       or F393A00_2.Spin( XX ) /= 50 then                  -- g
+      Report.Failed( "Call to class-wide operation" );
+    end if;
+
+    F393A00_0.TC_Validate( "ybfefebbgg", "Pump Zephyr" );
+  end;
+
+  declare
+    It : F393A00_2.Windmill'Class := Zephyr( B_Mill );     -- ybmffe
+    XX : F393A00_2.Windmill'Class := Gale( B_Mill );       -- mffe
+    use type F393A00_2.Rotational_Measurement;
+  begin
+    if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
+then
+      Report.Failed( "Bad copy to class-wide variable" );
+    end if;                                                -- bb
+    if F393A00_2.Spin( It ) /= 10                          -- g
+       or F393A00_2.Spin( XX ) /= 60 then                  -- g
+      Report.Failed( "Call to class-wide operation" );
+    end if;
+
+    F393A00_0.TC_Validate( "ybmffemffebbgg", "Mill Zephyr" );
+  end;
+
+  Report.Result;
+
+end C393A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a03.a
new file mode 100644
index 000000000..90106f4bf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a03.a
@@ -0,0 +1,242 @@
+-- C393A03.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 non-abstract primitive subprogram of an abstract
+--      type can be called as a dispatching operation and that the body
+--      of this subprogram can make a dispatching call to an abstract
+--      operation of the corresponding abstract type. 
+--
+-- TEST DESCRIPTION:
+--      This test expands on the class family defined in foundation F393A00
+--      by deriving a new abstract type from the root abstract type "Object".
+--      The subprograms defined for the new abstract type are then
+--      appropriately overridden, and the test ultimately calls various
+--      mixtures of these subprograms to check that the dispatching occurs
+--      correctly.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F393A00.A   (foundation code)
+--         C393A03.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed ARM references from objective text.
+--      23 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
+--
+--!
+
+------------------------------------------------------------------- C393A03_0
+
+with F393A00_1;
+package C393A03_0 is
+
+  type Counting_Object is abstract new F393A00_1.Object with private;
+  -- inherits Initialize, Swap (abstract) and Create (abstract)
+
+  procedure Bump ( A_Counter: in out Counting_Object );
+  procedure Clear( A_Counter: in out Counting_Object ) is abstract;
+  procedure Zero ( A_Counter: in out Counting_Object );
+  function  Value( A_Counter: Counting_Object'Class ) return Natural;
+
+private
+
+  type Counting_Object is abstract new F393A00_1.Object with
+    record
+      Tally : Natural :=0;
+    end record;
+
+end C393A03_0;
+
+-----------------------------------------------------------------------------
+
+with F393A00_0;
+package body C393A03_0 is
+
+  procedure Bump ( A_Counter: in out Counting_Object ) is
+  begin
+    F393A00_0.TC_Touch('A');
+    A_Counter.Tally := A_Counter.Tally +1;
+  end Bump;
+
+  procedure Zero ( A_Counter: in out Counting_Object ) is
+  begin
+    F393A00_0.TC_Touch('B');
+
+ -- dispatching call to abstract operation of Counting_Object
+    Clear( Counting_Object'Class(A_Counter) );
+
+    A_Counter.Tally := 0;
+
+  end Zero;
+
+  function  Value( A_Counter: Counting_Object'Class ) return Natural is
+  begin
+    F393A00_0.TC_Touch('C');
+    return A_Counter.Tally;
+  end Value;
+
+end C393A03_0;
+
+------------------------------------------------------------------- C393A03_1
+
+with C393A03_0;
+package C393A03_1 is
+
+  type Modular_Object is new C393A03_0.Counting_Object with private;
+  -- inherits Initialize, Bump, Zero and Value,
+  -- inherits abstract Swap, Create and Clear
+
+  procedure Swap( A,B: in out Modular_Object );
+  procedure Clear( It: in out Modular_Object );
+  procedure Set_Max( It : in out Modular_Object; Value : Natural );
+  function  Create return Modular_Object;
+
+private
+
+  type Modular_Object is new C393A03_0.Counting_Object with
+    record
+      Max_Value : Natural;
+    end record;
+
+end C393A03_1;
+
+-----------------------------------------------------------------------------
+
+with F393A00_0;
+package body C393A03_1 is
+
+  procedure Swap( A,B: in out Modular_Object ) is
+    T : constant Modular_Object := B;
+  begin
+    F393A00_0.TC_Touch('1');
+    B := A;
+    A := T;
+  end Swap;
+
+  procedure Clear( It: in out Modular_Object ) is
+  begin
+    F393A00_0.TC_Touch('2');
+    null;
+  end Clear;
+
+  procedure Set_Max( It : in out Modular_Object; Value : Natural ) is
+  begin
+    F393A00_0.TC_Touch('3');
+    It.Max_Value := Value;
+  end Set_Max;
+
+  function  Create return Modular_Object is
+    AMO : Modular_Object;
+  begin
+    F393A00_0.TC_Touch('4');
+    AMO.Max_Value := Natural'Last;
+    return AMO;
+  end Create;
+
+end C393A03_1;
+
+--------------------------------------------------------------------- C393A03
+
+with Report;
+with F393A00_0;
+with F393A00_1;
+with C393A03_0;
+with C393A03_1;
+procedure C393A03 is
+
+  A_Thing       : C393A03_1.Modular_Object;
+  Another_Thing : C393A03_1.Modular_Object;
+
+  procedure Initialize( It: in out C393A03_0.Counting_Object'Class ) is
+  begin
+    C393A03_0.Initialize( It );  -- dispatch to inherited procedure
+  end Initialize;
+
+  procedure Bump( It: in out C393A03_0.Counting_Object'Class ) is
+  begin
+    C393A03_0.Bump( It ); -- dispatch to non-abstract procedure
+  end Bump;
+
+  procedure Set_Max( It  : in out C393A03_1.Modular_Object'Class;
+                     Val : Natural) is
+  begin
+    C393A03_1.Set_Max( It, Val ); -- dispatch to non-abstract procedure
+  end Set_Max;
+
+  procedure Swap( A, B  : in out C393A03_0.Counting_Object'Class ) is
+  begin
+    C393A03_0.Swap( A, B ); -- dispatch to inherited abstract procedure
+  end Swap;
+
+  procedure Zero( It: in out C393A03_0.Counting_Object'Class ) is
+  begin
+    C393A03_0.Zero( It ); -- dispatch to non-abstract procedure
+  end Zero;
+
+begin  -- Main test procedure.
+
+   Report.Test ("C393A03", "Check that a non-abstract primitive subprogram "
+			 & "of an abstract type can be called as a "
+			 & "dispatching operation and that the body of this "
+			 & "subprogram can make a dispatching call to an "
+			 & "abstract operation of the corresponding "
+			 & "abstract type" );
+
+   A_Thing := C393A03_1.Create; -- Max_Value = Natural'Last
+   F393A00_0.TC_Validate( "4", "Overridden primitive layer 2");
+
+   Initialize( A_Thing );
+   Initialize( Another_Thing );
+   F393A00_0.TC_Validate( "aa", "Non-abstract primitive layer 0");
+   
+   Bump( A_Thing ); -- Tally = 1
+   F393A00_0.TC_Validate( "A", "Non-abstract primitive layer 1");
+
+   Set_Max( A_Thing, 42 ); -- Max_Value = 42
+   F393A00_0.TC_Validate( "3", "Non-abstract normal layer 2");
+
+   if not F393A00_1.Initialized( A_Thing ) then
+     Report.Failed("Initialize didn't");
+   end if;
+   F393A00_0.TC_Validate( "b", "Class-wide layer 0");
+
+   Swap( A_Thing, Another_Thing );
+   F393A00_0.TC_Validate( "1", "Overridden abstract layer 2");
+
+   Zero( A_Thing );
+   F393A00_0.TC_Validate( "B2", "Non-abstract layer 0, calls dispatch");
+
+   if C393A03_0.Value( A_Thing ) /= 0 then
+     Report.Failed("Zero didn't");
+   end if;
+   F393A00_0.TC_Validate( "C", "Class-wide normal layer 2");
+
+   Report.Result;
+
+end C393A03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a05.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a05.a
new file mode 100644
index 000000000..b404559cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a05.a
@@ -0,0 +1,166 @@
+-- C393A05.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 for a nonabstract private extension, any inherited
+ --      abstract subprograms can be overridden in the private part of
+ --      the immediately enclosing package and that calls can be made to
+ --      private dispatching operations.
+ --
+ -- TEST DESCRIPTION:
+ --      This test builds an additional layer upon the foundation code to
+ --      provide the required "hidden" dispatching operation.  The procedure
+ --      Swap, a private subprogram, should be called by dispatch.
+ --
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         F393A00.A   (foundation code)
+ --         C393A05.A
+ --
+ --
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+ --!
+ 
+ with F393A00_4;
+ package C393A05_0 is
+   type Grinder is new F393A00_4.Mill with private;
+   type Coarseness is (Whole_Bean, Coarse, Medium, Fine, Espresso);
+ 
+   procedure Set_Grind( It: in out Grinder; The_Grind: Coarseness );
+   function  Grind( It: Grinder ) return Coarseness;
+ 
+   function  Create return Grinder;
+ private
+   procedure Swap( A,B: in out Grinder );
+   type Grinder is new F393A00_4.Mill with
+     record
+       Grind : Coarseness := Whole_Bean;
+     end record;
+ end C393A05_0;
+ 
+ with F393A00_0;
+ package body C393A05_0 is
+   procedure Set_Grind( It: in out Grinder; The_Grind: Coarseness ) is
+   begin
+     F393A00_0.TC_Touch( 'A' );
+     It.Grind := The_Grind;
+   end Set_Grind;
+ 
+   function  Grind( It: Grinder ) return Coarseness is
+   begin
+     F393A00_0.TC_Touch( 'B' );
+     return It.Grind;
+   end Grind;
+ 
+   procedure Swap( A,B: in out Grinder ) is
+     T : constant Grinder := A;
+   begin
+     F393A00_0.TC_Touch( 'C' );
+     A := B;
+     B := T;
+   end Swap;
+ 
+   function  Create return Grinder is
+     One: Grinder;  
+   begin
+     F393A00_0.TC_Touch( 'D' );
+     F393A00_4.Initialize( F393A00_4.Mill( One ) );
+     One.Grind := Fine;
+     return One;
+   end Create;
+ end C393A05_0;
+ 
+ with Report;
+ with F393A00_0;
+ with C393A05_0;
+ procedure C393A05 is
+ 
+   package Tracer renames F393A00_0;
+   package Coffee renames C393A05_0;
+   use type Coffee.Coarseness;
+ 
+   Morning   : Coffee.Grinder;
+   Afternoon : Coffee.Grinder;
+ 
+   Gritty    : Coffee.Coarseness;
+ 
+   procedure Class_Swap( A, B: in out Coffee.Grinder'Class ) is
+   begin
+     Coffee.Swap( A, B ); -- dispatch
+   end Class_Swap;
+ 
+ begin  -- Main test procedure.
+ 
+   Report.Test ("C393A05",  "Check that nonabstract private extensions, "
+                          & "inherited abstract subprograms overridden "
+                          & "in the private part can be dispatched from "
+                          & "outside the package" );
+ 
+   Tracer.TC_Validate( "hh", "Declarations" );
+ 
+   Morning := Coffee.Create;
+   Tracer.TC_Validate( "hDa", "Creating Morning Coffee" );
+   Gritty  := Coffee.Grind( Morning );
+   Tracer.TC_Validate( "B", "Finding Morning Grind" );
+ 
+   Afternoon := Coffee.Create;
+   Tracer.TC_Validate( "hDa", "Creating Afternoon Coffee" );
+   Coffee.Set_Grind( Afternoon, Coffee.Medium );
+   Tracer.TC_Validate( "A", "Setting Afternoon Grind" );
+ 
+   Coffee.Swap( Morning, Afternoon );
+   Tracer.TC_Validate( "C", "Dispatching Swapping Coffees" );
+ 
+   if Gritty /= Coffee.Grind( Afternoon )
+      or Coffee.Grind ( Afternoon ) /= Coffee.Fine then
+     Report.Failed ("Result of Swap");
+   end if;
+   Tracer.TC_Validate( "BB", "Finding Afternoon Grind" );
+ 
+   Sunset: declare
+     Evening   : Coffee.Grinder'Class := Coffee.Create;
+   begin
+     Tracer.TC_Validate( "hDa", "Creating Evening Coffee" );
+ 
+     Coffee.Set_Grind( Evening, Coffee.Espresso );
+     Tracer.TC_Validate( "A", "Setting Evening Grind" );
+ 
+     Morning := Coffee.Grinder( Evening );
+     Class_Swap( Morning, Evening );
+     Tracer.TC_Validate( "C", "Swapping Coffees" );
+     if Coffee.Grind( Morning ) /= Coffee.Espresso then
+       Report.Failed ("Result of Assignment");
+     end if;
+   end Sunset;
+ 
+   Report.Result;
+ 
+ end C393A05;
+ 
+ 
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a06.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a06.a
new file mode 100644
index 000000000..c257d5fa0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393a06.a
@@ -0,0 +1,201 @@
+-- C393A06.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 type that inherits abstract operations but
+--      overrides each of these operations is not required to be
+--      abstract, and that objects of the type and its class-wide type
+--      may be declared and passed in calls to the overriding
+--      subprograms.
+--
+-- TEST DESCRIPTION:
+--      This test derives a type from the root abstract type available
+--      in foundation F393A00.  It declares subprograms as required by
+--      the language to override the abstract subprograms, allowing the
+--      derived type itself to be not abstract.  It also declares
+--      operations on the new type, as well as on the associated class-
+--      wide type.  The main program then uses two objects of the type
+--      and two objects of the class-wide type as parameters for each of
+--      the subprograms.  Correct execution is determined by path
+--      analysis and value checking.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F393A00.A   (foundation code)
+--         C393A06.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--
+--!
+ 
+ with F393A00_1;
+ package C393A06_0 is
+   type Organism is new F393A00_1.Object with private;
+   type Kingdoms is ( Animal, Vegetable, Unspecified );
+ 
+   procedure Swap( A,B: in out Organism );
+   function  Create return Organism;
+ 
+   procedure Initialize( The_Entity     : in out Organism;
+                         In_The_Kingdom : Kingdoms );
+   function  Kingdom( Of_The_Entity : Organism ) return Kingdoms;
+ 
+   procedure TC_Check( An_Entity   : Organism'Class;
+                       In_Kingdom  : Kingdoms;
+                       Initialized : Boolean );
+ 
+   Incompatible : exception;
+ 
+ private
+   type Organism is new F393A00_1.Object with
+     record
+       In_Kingdom : Kingdoms;
+     end record;
+ end C393A06_0;
+ 
+ with F393A00_0;
+ package body C393A06_0 is
+ 
+   procedure Swap( A,B: in out Organism ) is
+   begin
+     F393A00_0.TC_Touch( 'A' );  ------------------------------------------- A
+     if A.In_Kingdom /= B.In_Kingdom then
+       F393A00_0.TC_Touch( 'X' );
+       raise Incompatible;
+     else
+       declare
+         T: constant Organism := A;
+       begin
+         A := B;
+         B := T;
+       end;
+     end if;
+   end Swap;
+ 
+   function  Create return Organism is
+     Widget : Organism;
+   begin
+     F393A00_0.TC_Touch( 'B' ); ------------------------------------------- B
+     Initialize( Widget );
+     Widget.In_Kingdom := Unspecified;
+     return Widget;
+   end Create;
+ 
+   procedure Initialize( The_Entity     : in out Organism;
+                         In_The_Kingdom : Kingdoms ) is
+   begin
+     F393A00_0.TC_Touch( 'C' ); ------------------------------------------- C
+     F393A00_1.Initialize( F393A00_1.Object( The_Entity ) );
+     The_Entity.In_Kingdom := In_The_Kingdom;
+   end Initialize;
+ 
+   function  Kingdom( Of_The_Entity : Organism ) return Kingdoms is
+   begin
+     F393A00_0.TC_Touch( 'D' ); ------------------------------------------- D
+     return Of_The_Entity.In_Kingdom;
+   end Kingdom;
+ 
+   procedure TC_Check( An_Entity   : Organism'Class;
+                       In_Kingdom  : Kingdoms;
+                       Initialized : Boolean ) is
+   begin
+     if F393A00_1.Initialized( An_Entity ) /= Initialized then
+       F393A00_0.TC_Touch( '-' ); ------------------------------------------- -
+     elsif An_Entity.In_Kingdom /= In_Kingdom then
+       F393A00_0.TC_Touch( '!' ); ------------------------------------------- !
+     else
+       F393A00_0.TC_Touch( '+' ); ------------------------------------------- +
+     end if;
+   end TC_Check;
+ 
+ end C393A06_0;
+ 
+ with Report;
+ 
+ with C393A06_0;
+ with F393A00_0;
+ with F393A00_1;
+ procedure C393A06 is
+ 
+   package Darwin  renames C393A06_0;
+   package Tagger  renames F393A00_0;
+   package Objects renames F393A00_1;
+ 
+   Lion      : Darwin.Organism;
+   Tigerlily : Darwin.Organism;
+   Bear      : Darwin.Organism'Class := Darwin.Create;
+   Sunflower : Darwin.Organism'Class := Darwin.Create;
+ 
+   use type Darwin.Kingdoms;
+ 
+ begin  -- Main test procedure.
+ 
+    Report.Test ("C393A06", "Check that a type that inherits abstract "
+                          & "operations but overrides each of these "
+                          & "operations is not required to be abstract. "
+                          & "Check that objects of the type and its "
+                          & "class-wide type may be declared and passed "
+                          & "in calls to the overriding subprograms" );
+ 
+   Tagger.TC_Validate( "BaBa", "Declaration Initializations" );
+ 
+   Darwin.Initialize( Lion,      Darwin.Animal );
+   Darwin.Initialize( Tigerlily, Darwin.Vegetable );
+   Darwin.Initialize( Bear,      Darwin.Animal );
+   Darwin.Initialize( Sunflower, Darwin.Vegetable );
+ 
+   Tagger.TC_Validate( "CaCaCaCa", "Initialization sequence" );
+ 
+   Oh_My: begin
+     Darwin.Swap( Lion, Darwin.Organism( Bear ) );
+     Darwin.Swap( Lion, Tigerlily );
+     Report.Failed("Exception not raised");
+   exception
+     when Darwin.Incompatible => null;
+   end Oh_My;
+ 
+   Tagger.TC_Validate( "AAX", "Swap sequence" );
+ 
+   if Darwin.Kingdom( Darwin.Create ) = Darwin.Unspecified then
+     Darwin.Swap( Sunflower, Darwin.Organism'Class( Tigerlily ) );
+   end if;
+ 
+   Tagger.TC_Validate( "BaDA", "Vegetable swap sequence" );
+ 
+   Darwin.TC_Check( Lion,      Darwin.Animal,    True );
+   Darwin.TC_Check( Tigerlily, Darwin.Vegetable, True );
+   Darwin.TC_Check( Bear,      Darwin.Animal,    True );
+   Darwin.TC_Check( Sunflower, Darwin.Vegetable, True );
+ 
+   Tagger.TC_Validate( "b+b+b+b+", "Final sequence" );
+ 
+   Report.Result;
+ 
+ end C393A06;
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393b12.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393b12.a
new file mode 100644
index 000000000..5d1b46daa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393b12.a
@@ -0,0 +1,131 @@
+-- C393B12.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that an extended type can be derived in the specification of a
+--      generic package when the parent is an abstract type in a library
+--      package.
+--
+-- TEST DESCRIPTION:
+--      Extend an abstract type in the visible part of a generic package.
+--      Make all of the procedures which override abstract procedures
+--      available as part of the generic interface.  Instantiate the generic.
+--
+-- TEST FILES: 
+--      This test depends on the following foundation code:
+--
+--         F393B00.A  Package Alert_Foundation
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      14 Oct 95   SAIC    Update and repair for ACVC 2.0.1
+--      27 Feb 97   PWB.CTA Add pragma Elaborate for C393B12_0.
+--!
+
+----------------------------------------------------------------- C393B12_0
+
+with F393B00;
+  -- Alert_Foundation
+generic 
+  type Generic_Status_Enum is (<>);
+
+package C393B12_0 is
+     -- Alert_Functions
+
+  type Generic_Alert_Type is new F393B00.Alert with record
+    Status : Generic_Status_Enum := Generic_Status_Enum'First;
+  end record;
+                                     -- extension of an abstract type
+
+  procedure Handle (GA : in out Generic_Alert_Type);
+                                     -- override of abstract procedure
+
+  function Query_Status (GA : Generic_Alert_Type)
+    return Generic_Status_Enum;      -- new primitive operation for
+                                     -- Generic_Alert_Type
+end C393B12_0;
+ -- Alert_Functions
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body C393B12_0 is
+          -- Alert_Functions
+
+  procedure Handle (GA : in out Generic_Alert_Type) is
+    begin
+      GA.Status := Generic_Status_Enum'Last;
+    end Handle;
+
+  function Query_Status (GA : Generic_Alert_Type) 
+    return Generic_Status_Enum is
+    begin
+      return GA.Status;
+    end Query_Status;
+
+end C393B12_0;
+
+----------------------------------------------------------------- C393B12_1
+
+package C393B12_1 is
+  type Status is (Low, Medium, High);
+end C393B12_1;
+
+------------------------------------------------------- C393B12_1.C393B12_2
+
+with C393B12_0;
+pragma Elaborate (C393B12_0);
+package C393B12_1.C393B12_2 is new C393B12_0 
+                        -- Alert_Functions
+                 (Generic_Status_Enum => Status);
+
+------------------------------------------------------------------- C393B12
+
+with C393B12_1.C393B12_2;
+with Report;
+procedure C393B12 is
+
+  use type C393B12_1.Status;
+
+  package Alt_Alert renames C393B12_1.C393B12_2;
+
+  GA : Alt_Alert.Generic_Alert_Type;
+
+begin
+  Report.Test ("C393B12",  "Check that an extended type can be derived " &
+                           "from an abstract type");
+
+  if Alt_Alert.Query_Status (GA) /= C393B12_1.Low then
+    Report.Failed ("Wrong initialization");
+  end if;
+
+  Alt_Alert.Handle (GA);
+  if Alt_Alert.Query_Status (GA) /= C393B12_1.High then
+    Report.Failed ("Wrong results from Handle");
+  end if;
+
+  Report.Result;
+
+end C393B12;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393b13.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393b13.a
new file mode 100644
index 000000000..c533badbe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393b13.a
@@ -0,0 +1,105 @@
+-- C393B13.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that an extended type can be derived from an abstract type
+--      when that derivation is declared in a child package.
+--
+-- TEST DESCRIPTION:
+--      Add a visible child to Alert_Foundation.  Using the abstract type
+--      Alert as parent, declare an extended type with discriminant and new
+--      record components.  Override the Handle procedure.
+--  
+-- TEST FILES: 
+--      This test depends on the following foundation code:
+--
+--         F393B00.A  Package Alert_Foundation
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
+--
+--!
+
+package F393B00.C393B13_0 is
+     -- Alert_Foundation.Public_Child
+
+  subtype Msg_Length_Range is integer range 0 .. 240;
+  Max_Msg_Length : constant Msg_Length_Range := 80;
+  Message : String := "Test Passed";
+
+  type Child_Alert (Length : Msg_Length_Range) 
+    is new Alert with record        -- abstract type is in parent package
+      Times_Handled : Natural := 0;
+      Msg           : String (1..Length);
+    end record;
+
+  procedure Handle (CA : in out Child_Alert);  -- required override
+  
+end F393B00.C393B13_0;
+ -- Alert_Foundation.Public_Child;
+
+--=======================================================================--
+
+package body F393B00.C393B13_0 is
+          -- Alert_Foundation.Public_Child
+  
+  procedure Handle (CA : in out Child_Alert) is
+    begin
+      CA.Msg(1..Message'Length) := Message;
+      CA.Times_Handled := CA.Times_Handled + 1;
+    end;
+  
+end F393B00.C393B13_0;
+ -- Alert_Foundation.Public_Child
+
+--=======================================================================--
+  
+with Report;
+with F393B00.C393B13_0;
+  -- Alert_foundation.Public_Child;
+procedure C393B13 is
+  package Child renames F393B00.C393B13_0;
+  CA : Child.Child_Alert(Child.Message'Length);
+ 
+begin
+
+  Report.Test ("C393B13", "Check that an extended type can be derived " &
+                          "from an abstract type");
+
+  if CA.Times_Handled /= 0 then
+    Report.Failed ("Wrong initialization");
+  end if;
+
+  Child.Handle (CA);
+  if (CA.Times_Handled /= 1)
+  or (CA.Msg /= Child.Message) then
+    Report.Failed ("Wrong results from Handle");
+  end if;
+  
+  Report.Result;
+
+end C393B13;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393b14.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393b14.a
new file mode 100644
index 000000000..f100377aa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c393b14.a
@@ -0,0 +1,147 @@
+-- C393B14.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that an extended type can be derived in a private child package
+--      from an abstract type defined in a library package.
+--
+-- TEST DESCRIPTION:
+--      Add a private child package to Alert_Foundation.  Using Private_Alert
+--      as parent type, declare an extended type adding a new record component.
+--      Override procedure Handle.  Declare an object of the new type in the
+--      child specification. Use type definitions from the private part of the
+--      parent in the body of the child.
+--
+-- TEST FILES: 
+--      This test depends on the following foundation code:
+--
+--         F393B00.A  Package Alert_Foundation
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+private package F393B00.C393B14_0 is
+             -- Alert_Foundation.Private_Child
+
+  type Implementation_Specific_Alert_Type is new Private_Alert with record
+    New_Private_Field : Implementation_Detail 
+                        := Implementation_Detail'Last;
+  end record;
+
+  procedure Handle (PA : in out Implementation_Specific_Alert_Type);
+                             -- overrides abstract Handle, as required
+  PA : Implementation_Specific_Alert_Type;
+
+end F393B00.C393B14_0;
+ -- Alert_Foundation.Private_Child
+
+--=======================================================================--
+
+package body F393B00.C393B14_0 is
+                  -- Alert_Foundation.Private_Child
+
+  procedure Handle (PA : in out Implementation_Specific_Alert_Type) is
+    begin
+      PA.Private_Field := 1;
+      PA.New_Private_Field := PA.Private_Field + 1;
+    end;
+
+end F393B00.C393B14_0;
+ -- Alert_Foundation.Private_Child
+
+--=======================================================================--
+
+package F393B00.C393B14_1 is
+     -- Alert_Foundation.Public_Child
+
+  type Timing is (Before, After);
+  procedure Init;
+  procedure Modify;
+  function Check_Before return Boolean;
+  function Check_After  return Boolean;
+
+end F393B00.C393B14_1;
+ -- Alert_Foundation.Public_Child
+
+--=======================================================================--
+
+with F393B00.C393B14_0;               -- private sibling is visible in the
+  -- Alert_Foundation.Private_Child   -- body of a public sibling
+package body F393B00.C393B14_1 is
+     -- Alert_Foundation.Public_Child
+  package Priv renames F393B00.C393B14_0;
+
+  procedure Init is
+    begin
+      Priv.PA.Private_Field     := 5;
+      Priv.PA.New_Private_Field := 10;
+    end Init;
+
+  procedure Modify is
+    begin 
+      Priv.Handle (Priv.PA);
+    end Modify;
+
+  function Check_Before return Boolean is
+    begin
+      return ((Priv.PA.Private_Field = 5) 
+               and (Priv.PA.New_Private_Field =10));
+    end Check_Before;
+
+  function Check_After return Boolean is
+    begin
+      return ((Priv.PA.Private_Field = 1)
+               and (Priv.PA.New_Private_Field = 2));
+    end Check_After;
+
+end F393B00.C393B14_1;
+ -- Alert_Foundation.Public_Child
+
+--=======================================================================--
+
+with Report;
+with F393B00.C393B14_1;
+procedure C393B14 is
+ -- Alert_Foundation.Public_Child;
+
+begin
+  Report.Test ("C393B14", "Check that an extended type can be derived " &
+                          "from an abstract type");
+
+  F393B00.C393B14_1.Init;
+  if not F393B00.C393B14_1.Check_Before then 
+    Report.Failed ("Wrong initialization");
+  end if;
+
+  F393B00.C393B14_1.Modify;
+  if not F393B00.C393B14_1.Check_After then
+    Report.Failed ("Wrong results from Handle");
+  end if;
+
+  Report.Result;
+end C393B14;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0001.a
new file mode 100644
index 000000000..f8a0681e7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0001.a
@@ -0,0 +1,138 @@
+-- C3A0001.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 access to subprogram type can be used to select and
+--      invoke functions with appropriate arguments dynamically.
+--
+-- TEST DESCRIPTION:
+--      Declare an access to function type in a package specification.  
+--      Declare three different sine functions that can be referred to by 
+--      the access to function type.  
+--      
+--      In the main program, call each function indirectly by dereferencing 
+--      the access value.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C3A0001_0 is
+   
+   TC_Call_Tag : Natural := 0;
+
+   -- Type accesses to any sine function
+   type Sine_Function_Ptr is access function   
+      (Angle : in Float) return Float;
+
+-- Three 'Sine' functions that model an application situation in which
+-- one function might be chosen when speed is important, another (using
+-- a different algorithm) might be chosen when accuracy is important,
+-- and so on.
+
+   function Sine_Calc_Fast  (Angle : in Float) return Float;         
+
+   function Sine_Calc_Acc   (Angle : in Float) return Float;        
+
+   function Sine_Calc_Table (Angle : in Float) return Float;        
+
+end C3A0001_0;
+
+
+-----------------------------------------------------------------------------
+
+
+package body C3A0001_0 is
+
+   function Sine_Calc_Fast (Angle : in Float) return Float is
+   begin
+      TC_Call_Tag := 1;
+      return 1.0;
+   end Sine_Calc_Fast;
+
+
+   function Sine_Calc_Acc (Angle : in Float) return Float is
+   begin
+      TC_Call_Tag := 2;
+      return 0.0;
+   end Sine_Calc_Acc;
+
+
+   function Sine_Calc_Table (Angle : in Float) return Float is
+   begin
+      TC_Call_Tag := 3;
+      return -1.0;         
+   end Sine_Calc_Table;
+
+end C3A0001_0;
+
+-----------------------------------------------------------------------------
+
+with Report;
+with C3A0001_0;
+
+procedure C3A0001 is
+
+   Sine_Access : C3A0001_0.Sine_Function_Ptr;
+   X, Theta    : Float := 0.0;
+
+begin
+
+   Report.Test ("C3A0001", "Check that access to subprogram can be " &
+                "used to select and invoke an operation with " &
+                "appropriate arguments dynamically");
+
+   Sine_Access := C3A0001_0.Sine_Calc_Fast'Access;
+
+   -- Invoking Sine function designated by access value
+   X := Sine_Access(Theta);
+
+   If C3A0001_0.TC_Call_Tag /= 1 then
+      Report.Failed ("Incorrect Sine_Calc_Fast result");
+   end if;
+
+   Sine_Access := C3A0001_0.Sine_Calc_Acc'Access;
+
+   -- Invoking Sine function designated by access value
+   X := Sine_Access(Theta);
+
+   If C3A0001_0.TC_Call_Tag /= 2 then
+      Report.Failed ("Incorrect Sine_Calc_Acc result");
+   end if;
+
+   Sine_Access := C3A0001_0.Sine_Calc_Table'Access;
+
+   -- Invoking Sine function designated by access value
+   X := Sine_Access(Theta);
+
+   If C3A0001_0.TC_Call_Tag /= 3 then
+      Report.Failed ("Incorrect Sine_Calc_Table result");
+   end if;
+
+   Report.Result;
+
+end C3A0001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0002.a
new file mode 100644
index 000000000..5c05d43fb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0002.a
@@ -0,0 +1,142 @@
+-- C3A0002.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 access to subprogram type can be used to select and 
+--      invoke procedures with appropriate arguments dynamically.
+--
+-- TEST DESCRIPTION:
+--      Declare an access to procedure type in a package specification.  
+--      Declare three different log procedures that can be referred to by 
+--      the access to procedure type.  
+-- 
+--      In the main program, call each procedure indirectly by dereferencing 
+--      the access value.
+-- 
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      05 APR 96   SAIC    RM reference change for 2.1
+--
+--
+--!
+
+
+package C3A0002_0 is
+
+   TC_Call_Tag : Natural := 0;
+
+   Return_Num          : Float   := 0.0;
+
+   -- Type accesses to any log procedure
+   type Log_Procedure_Ptr is access procedure   
+      (Angle : in Float);
+
+   procedure Log_Calc_Fast  (Angle : in Float);         
+
+   procedure Log_Calc_Acc   (Angle : in Float);        
+
+   procedure Log_Calc_Table (Angle : in Float);
+
+end C3A0002_0;
+
+
+-----------------------------------------------------------------------------
+
+
+package body C3A0002_0 is
+
+   procedure Log_Calc_Fast (Angle : in Float) is
+   begin
+      TC_Call_Tag := 1;
+      Return_Num := Angle;
+   end Log_Calc_Fast;
+
+
+   procedure Log_Calc_Acc (Angle : in Float) is
+   begin
+      TC_Call_Tag  := 2;
+      Return_Num := Angle;
+   end Log_Calc_Acc;
+
+
+   procedure Log_Calc_Table (Angle : in Float) is
+   begin
+      TC_Call_Tag := 3;
+      Return_Num := Angle;
+   end Log_Calc_Table;
+
+end C3A0002_0;
+
+-----------------------------------------------------------------------------
+
+with Report;
+with C3A0002_0; 
+
+procedure C3A0002 is
+
+   Log_Access : C3A0002_0.Log_Procedure_Ptr;
+   Theta      : Float := 0.0;
+
+begin
+
+   Report.Test ("C3A0002", "Check that access to subprogram type can be "
+                         & "used to select and invoke procedures with "
+                         & "appropriate arguments dynamically" );
+
+   Log_Access := C3A0002_0.Log_Calc_Fast'Access;
+
+   -- Invoking Log procedure designated by access value
+   Log_Access (Theta);
+
+   If C3A0002_0.TC_Call_Tag /= 1 or C3A0002_0.Return_Num /= 0.0 then
+      Report.Failed ("Incorrect Log_Calc_Fast result");
+   end if;
+
+   Theta := 1.0;
+
+   Log_Access := C3A0002_0.Log_Calc_Acc'Access;
+
+   -- Invoking Log procedure designated by access value
+   Log_Access (Theta);
+
+   If C3A0002_0.TC_Call_Tag /= 2 or C3A0002_0.Return_Num /= 1.0 then
+      Report.Failed ("Incorrect Log_Calc_Acc result");
+   end if;
+
+   Theta := -1.0;
+
+   Log_Access := C3A0002_0.Log_Calc_Table'Access;
+
+   -- Invoking Log procedure designated by access value
+   Log_Access (Theta);
+
+   If C3A0002_0.TC_Call_Tag /= 3 or C3A0002_0.Return_Num /= -1.0 then
+      Report.Failed ("Incorrect Log_Calc_Table result");
+   end if;
+
+   Report.Result;
+
+end C3A0002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0003.a
new file mode 100644
index 000000000..4f9fdbe29
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0003.a
@@ -0,0 +1,144 @@
+-- C3A0003.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 function in a generic instance can be called using
+--      an access-to-subprogram value.
+--
+-- TEST DESCRIPTION:
+--      Declare a numeric type in the visible part of a generic package.
+--      Declare an access to function type.  Declare three different sine 
+--      functions that can be referred to by the access to function type.  
+--
+--      In the main program, instantiate the generic.  Call each function 
+--      indirectly by dereferencing the access value.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+generic
+   type Real_Num is digits <>;
+
+package C3A0003_0 is
+   
+   TC_Call_Tag : Natural := 0;
+
+   -- Type accesses to any sine function
+   type Sine_Function_Ptr is access function   
+      (Angle : in Real_Num) return Real_Num;
+
+   function Sine_Calc_Fast  (Angle : in Real_Num) return Real_Num;         
+
+   function Sine_Calc_Acc   (Angle : in Real_Num) return Real_Num;        
+
+   function Sine_Calc_Table (Angle : in Real_Num) return Real_Num;        
+
+end C3A0003_0;
+
+
+-----------------------------------------------------------------------------
+
+
+package body C3A0003_0 is
+
+   function Sine_Calc_Fast (Angle : in Real_Num) return Real_Num is
+      Sine_Num : Real_Num := 1.0;
+   begin
+      TC_Call_Tag := 1;
+      return Sine_Num;
+   end Sine_Calc_Fast;
+
+
+   function Sine_Calc_Acc (Angle : in Real_Num) return Real_Num is
+      Sine_Num : Real_Num := 0.0;
+   begin
+      TC_Call_Tag := 2;
+      return Sine_Num;
+   end Sine_Calc_Acc;
+
+
+   function Sine_Calc_Table (Angle : in Real_Num) return Real_Num is
+      Sine_Num : Real_Num := -1.0;
+   begin
+      TC_Call_Tag := 3;
+      return Sine_Num;
+   end Sine_Calc_Table;
+
+end C3A0003_0;
+
+-----------------------------------------------------------------------------
+
+with Report;
+with C3A0003_0;
+
+procedure C3A0003 is
+
+   type Real is digits 5;
+
+   Subtype Trig_Float is Real range -1.0 .. 1.0;
+
+   package Trig is new C3A0003_0 (Real_Num => Trig_Float);
+
+   Sine_Access : Trig.Sine_Function_Ptr;
+   X, Theta    : Trig_Float := 0.0;
+
+begin
+
+   Report.Test ("C3A0003", "Check that a function in a generic instance can "
+                         & "be called using an access-to-subprogram value");
+
+   Sine_Access := Trig.Sine_Calc_Fast'Access;
+
+   -- Invoking Sine function designated by access value
+   X := Sine_Access.all(Theta);
+
+   If Trig.TC_Call_Tag /= 1 then
+      Report.Failed ("Incorrect Sine_Calc_Fast result");
+   end if;
+
+   Sine_Access := Trig.Sine_Calc_Acc'Access;
+
+   -- Invoking Sine function designated by access value
+   X := Sine_Access.all(Theta);
+
+   If Trig.TC_Call_Tag /= 2 then
+      Report.Failed ("Incorrect Sine_Calc_Acc result");
+   end if;
+
+   Sine_Access := Trig.Sine_Calc_Table'Access;
+
+   -- Invoking Sine function designated by access value
+   X := Sine_Access.all(Theta);
+
+   If Trig.TC_Call_Tag /= 3 then
+      Report.Failed ("Incorrect Sine_Calc_Table result");
+   end if;
+
+   Report.Result;
+
+end C3A0003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0004.a
new file mode 100644
index 000000000..2557546c2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0004.a
@@ -0,0 +1,115 @@
+-- C3A0004.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 access to subprogram may be stored within array 
+ --      objects, and that the access to subprogram can subsequently 
+ --      be called. 
+ -- 
+ -- TEST DESCRIPTION:
+ --      Declare an access to procedure type in a package specification.  
+ --      Declare an array of the access type.  Declare three different 
+ --      procedures that can be referred to by the access to procedure type.  
+ --
+ --      In the main program, build the array by dereferencing the access 
+ --      value.
+ --
+ --
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+ --!
+ 
+ with Report;
+ 
+ procedure C3A0004 is
+ 
+    Left_Turn   : Integer  := 1;
+ 
+    Right_Turn  : Integer  := 1;
+ 
+    Center_Turn : Integer  := 1;
+ 
+    -- Type accesses to any procedure
+    type Action_Ptr is access procedure;
+    
+    -- Array of access to procedure
+    type Action_Array is array (Integer range <>) of Action_Ptr;
+ 
+ 
+    procedure Rotate_Left is
+    begin
+       Left_Turn := 2;
+    end Rotate_Left;
+ 
+ 
+    procedure Rotate_Right is
+    begin
+       Right_Turn := 3;
+    end Rotate_Right;
+ 
+ 
+    procedure Center is
+    begin
+       Center_Turn := 0;
+    end Center;
+ 
+ 
+ begin
+ 
+    Report.Test ("C3A0004", "Check that access to subprogram may be "
+                          & "stored within data structures, and that the "
+                          & "access to subprogram can subsequently be called");
+ 
+    ------------------------------------------------------------------------
+ 
+    declare
+       Total_Actions   : constant := 3;
+       Action_Sequence : Action_Array (1 .. Total_Actions);
+ 
+    begin
+ 
+       -- Build the action sequence
+       Action_Sequence := (Rotate_Left'Access, Center'Access,
+                           Rotate_Right'Access);
+ 
+       -- Assign actions by invoking subprogram designated by access value
+       for I in Action_Sequence'Range loop
+          Action_Sequence(I).all;
+       end loop;
+ 
+       If Left_Turn /= 2 or Right_Turn /= 3
+          or Center_Turn /= 0 then
+             Report.Failed ("Incorrect Action sequence result");
+       end if;
+ 
+     end;
+ 
+    ------------------------------------------------------------------------
+ 
+    Report.Result;
+ 
+ end C3A0004;
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0005.a
new file mode 100644
index 000000000..1f2368957
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0005.a
@@ -0,0 +1,147 @@
+-- C3A0005.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 access to subprogram may be stored within record 
+--      objects, and that the access to subprogram can subsequently 
+--      be called. 
+-- 
+-- TEST DESCRIPTION:
+--      Declare an access to procedure type in a package specification.  
+--      Declare two different procedures that can be referred to by the 
+--      access to procedure type.  Declare a record with the access to 
+--      procedure type as a component.  Use the access to procedure type to 
+--      initialize the component of a record.  
+--
+--      In the main program, declare an operation.  An access value 
+--      designating this operation is passed as a parameter to be 
+--      stored in the record.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C3A0005_0 is
+
+   Default_Call   : Boolean := False;
+
+   type Button;
+
+
+   -- Type accesses to procedures Push and Default_Response
+   type Button_Response_Ptr is access procedure
+      (B : access Button);
+
+   procedure Push (B : access Button);
+
+   procedure Set_Response (B : access Button;
+                           R : in Button_Response_Ptr);
+
+   procedure Default_Response  (B : access Button);
+
+   Emergency_Call : Boolean := False;
+
+   procedure Emergency (B : access C3A0005_0.Button);
+
+   type Button is
+      record
+         Response :  Button_Response_Ptr
+                  := Default_Response'Access;   
+      end record;
+
+end C3A0005_0;
+
+
+-----------------------------------------------------------------------------
+
+with TCTouch;
+package body C3A0005_0 is
+
+   procedure Push (B : access Button) is
+   begin
+      TCTouch.Touch( 'P' ); --------------------------------------------- P
+      -- Invoking subprogram designated by access value
+      B.Response (B);
+   end Push;
+
+
+   procedure Set_Response (B : access Button;
+                           R : in     Button_Response_Ptr) is
+   begin
+      TCTouch.Touch( 'S' ); --------------------------------------------- S
+      -- Set procedure value in record
+      B.Response := R;
+   end Set_Response;
+
+
+   procedure Default_Response (B : access Button) is
+   begin
+      TCTouch.Touch( 'D' ); --------------------------------------------- D
+      Default_Call := True;
+   end Default_Response;
+
+
+   procedure Emergency (B : access C3A0005_0.Button) is
+   begin
+      TCTouch.Touch( 'E' ); --------------------------------------------- E
+      Emergency_Call := True;
+   end Emergency;
+
+end C3A0005_0;
+
+
+-----------------------------------------------------------------------------
+
+with TCTouch;
+with Report;
+
+with C3A0005_0;
+
+procedure C3A0005 is
+
+   Big_Red_Button : aliased C3A0005_0.Button;
+
+begin
+
+   Report.Test ("C3A0005", "Check that access to subprogram may be "
+                         & "stored within data structures, and that the "
+                         & "access to subprogram can subsequently be called");
+
+   C3A0005_0.Push (Big_Red_Button'Access);
+   TCTouch.Validate("PD", "Using default value");
+   TCTouch.Assert( C3A0005_0.Default_Call, "Default Call" );
+
+   -- set Emergency value in Button.Response
+   C3A0005_0.Set_Response(Big_Red_Button'Access, C3A0005_0.Emergency'Access);
+
+   C3A0005_0.Push (Big_Red_Button'Access);
+   TCTouch.Validate("SPE", "After set to Emergency value");
+   TCTouch.Assert( C3A0005_0.Emergency_Call, "Emergency Call");
+
+   Report.Result;
+
+end C3A0005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0006.a
new file mode 100644
index 000000000..effab3465
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0006.a
@@ -0,0 +1,163 @@
+-- C3A0006.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 access to subprogram may be stored within data 
+--      structures, and that the access to subprogram can subsequently 
+--      be called. 
+-- 
+-- TEST DESCRIPTION:
+--      Declare an access to function type in a package specification.  
+--      Declare an array of the access type.  Declare three different 
+--      functions that can be referred to by the access to function type.  
+--      
+--      In the main program, declare a key function that builds the array 
+--      by calling each function indirectly through the access value.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+package C3A0006_0 is
+
+   TC_Sine_Call  : Integer := 0;
+   TC_Cos_Call   : Integer := 0;
+   TC_Tan_Call   : Integer := 0;
+
+   Sine_Value    : Float :=  4.0;
+   Cos_Value     : Float :=  8.0;
+   Tan_Value     : Float := 10.0;
+
+   -- Type accesses to any function
+   type Trig_Function_Ptr is access function        
+      (Angle : in Float) return Float;
+
+   function Sine (Angle : in Float) return Float;         
+
+   function Cos  (Angle : in Float) return Float;        
+
+   function Tan  (Angle : in Float) return Float;         
+
+end C3A0006_0;
+
+
+-----------------------------------------------------------------------------
+
+
+package body C3A0006_0 is
+
+   function Sine (Angle : in Float) return Float is
+   begin
+     TC_Sine_Call := TC_Sine_Call + 1;
+     Sine_Value := Sine_Value + Angle;
+     return Sine_Value;
+   end Sine;
+
+
+   function Cos  (Angle: in Float) return Float is
+   begin
+     TC_Cos_Call := TC_Cos_Call + 1;
+     Cos_Value := Cos_Value - Angle;
+     return Cos_Value;
+   end Cos;
+
+
+   function Tan (Angle : in Float) return Float is
+   begin
+     TC_Tan_Call := TC_Tan_Call + 1;
+     Tan_Value := (Tan_Value + (Tan_Value * Angle));
+     return Tan_Value;
+   end Tan;
+
+
+end C3A0006_0;
+
+-----------------------------------------------------------------------------
+
+
+with Report;
+
+with C3A0006_0; 
+
+procedure C3A0006 is
+
+   Trig_Value, Theta  : Float := 0.0;
+
+   Total_Routines     : constant := 3;
+
+   Sine_Total         : constant := 7.0;
+   Cos_Total          : constant := 5.0;
+   Tan_Total          : constant := 75.0;
+
+   Trig_Table : array (1 .. Total_Routines) of C3A0006_0.Trig_Function_Ptr;
+
+
+   -- Key function to build the table
+   function Call_Trig_Func (Func : C3A0006_0.Trig_Function_Ptr;
+                            Operand : Float) return Float is 
+   begin
+      return (Func(Operand));
+   end Call_Trig_Func;
+
+
+begin
+
+   Report.Test ("C3A0006", "Check that access to subprogram may be " &
+                "stored within data structures, and that the access " &
+                "to subprogram can subsequently be called");
+
+   Trig_Table := (C3A0006_0.Sine'Access, C3A0006_0.Cos'Access, 
+                  C3A0006_0.Tan'Access);
+
+   -- increase the value of Theta to build the table
+   for I in 1 .. Total_Routines loop
+      Theta := Theta + 0.5;
+      for J in 1 .. Total_Routines loop
+         Trig_Value     := Call_Trig_Func (Trig_Table(J), Theta);
+      end loop;
+   end loop;
+
+   if C3A0006_0.TC_Sine_Call /= Total_Routines 
+     or C3A0006_0.TC_Cos_Call /= Total_Routines
+     or C3A0006_0.TC_Tan_Call /= Total_Routines then
+        Report.Failed ("Incorrect subprograms result");
+   end if;
+
+   if C3A0006_0.Sine_Value /= Sine_Total
+     or C3A0006_0.Cos_Value /= Cos_Total
+     or C3A0006_0.Tan_Value /= Tan_Total then
+        Report.Failed ("Incorrect values returned from subprograms");
+   end if;
+
+   if Trig_Value /= Tan_Total then
+        Report.Failed ("Incorrect call order.");
+   end if;
+
+   Report.Result;
+
+end C3A0006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0007.a
new file mode 100644
index 000000000..ff18d2f9e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0007.a
@@ -0,0 +1,234 @@
+-- C3A0007.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 call to a subprogram via an access-to-subprogram value
+--      stored in a data structure will correctly dispatch according to the
+--      tag of the class-wide parameter passed via that call.
+-- 
+-- TEST DESCRIPTION:
+--      Declare an access to procedure type in a package specification. 
+--      Declare a root tagged type with the access to procedure type as a 
+--      component.  Declare three primitive procedures for the type that 
+--      can be referred to by the access to procedure type.  Use the access 
+--      to procedure type to initialize the component of a record.
+--
+--      Extend the root type with a record extension in another package
+--      specification. Declare a new primitive procedure for the extension
+--      (in addition to its three inherited subprograms).
+--
+--      In the main program, declare an operation for the root tagged type 
+--      which can be passed as an access value to change the initial value
+--      of the component.  Call the inherited operation indirectly by 
+--      dereferencing the access value to check on the initial value of the 
+--      extension.  Call inherited operations indirectly by dereferencing 
+--      the access value to replace the initial value.  Call the primitive 
+--      procedure indirectly by dereferencing the access value to modify the 
+--      extension.
+--
+--          type Button
+--            procedure Push(Button)
+--            procedure Set_Response(Button,Button_Response_Ptr)
+--            procedure Default_Response(Button)
+--
+--          type Priority_Button (new Button)
+--            procedures Push, Set_Response inherited
+--            procedure Default_Response
+--            procedure Set_Priority
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C3A0007_0 is
+
+   Default_Call   : Boolean := False;
+
+   type Button is tagged private;
+
+   type Button_Response_Ptr is access procedure
+      (B : in out Button'Class);
+
+   procedure Push (B : in out Button);               -- to be inherited
+
+   procedure Set_Response (B : in out Button;        -- to be inherited
+                           R : in Button_Response_Ptr);
+
+   procedure Response  (B : in out Button);          -- to be inherited
+
+private
+   procedure Default_Response(B: in out Button'Class);
+   type Button is tagged                             -- root tagged type
+      record
+         Action :  Button_Response_Ptr 
+                  := Default_Response'Access;   
+      end record;
+end C3A0007_0;
+
+with C3A0007_0;
+package C3A0007_1 is
+
+   type Priority_Button is new C3A0007_0.Button
+     with record
+        Priority : Integer := 0;
+      end record;
+
+   -- Inherits procedure Push from Button
+   -- Inherits procedure Set_Response from Button
+
+   -- Override procedure Response from Button
+   procedure Response (B : in out Priority_Button);
+
+   -- Primitive operation of the extension
+   procedure Set_Priority (B : in out Priority_Button);
+
+end C3A0007_1;
+
+with C3A0007_0;
+package C3A0007_2 is
+
+   Emergency_Call : Boolean := False;
+
+   procedure Emergency (B : in out C3A0007_0.Button'Class);
+end C3A0007_2;
+
+-----------------------------------------------------------------------------
+
+with TCTouch;
+package body C3A0007_0 is
+
+   procedure Push (B : in out Button) is
+   begin
+      TCTouch.Touch( 'P' ); --------------------------------------------- P
+      -- Invoking subprogram designated by access value
+      B.Action (B);
+   end Push;
+
+
+   procedure Set_Response (B : in out Button;
+                           R : in     Button_Response_Ptr) is
+   begin
+      TCTouch.Touch( 'S' ); --------------------------------------------- S
+      -- Set procedure value in record
+      B.Action := R;
+   end Set_Response;
+
+
+   procedure Response (B : in out Button) is
+   begin
+      TCTouch.Touch( 'D' ); --------------------------------------------- D
+      Default_Call := True;
+   end Response;
+
+   procedure Default_Response (B : in out Button'Class) is
+   begin
+      TCTouch.Touch( 'C' ); --------------------------------------------- C
+      Response(B);
+   end Default_Response;
+
+end C3A0007_0;
+
+with TCTouch;
+package body C3A0007_1 is
+
+   procedure Set_Priority (B : in out Priority_Button) is
+   begin
+      TCTouch.Touch( 's' ); --------------------------------------------- s
+      B.Priority := 1;
+   end Set_Priority;
+
+   procedure Response (B : in out Priority_Button) is
+   begin
+      TCTouch.Touch( 'd' ); --------------------------------------------- d
+   end Response;
+
+end C3A0007_1;
+
+with TCTouch;
+package body C3A0007_2 is
+   procedure Emergency (B : in out C3A0007_0.Button'Class) is
+      begin
+        TCTouch.Touch( 'E' ); ------------------------------------------- E
+        Emergency_Call := True;
+      end Emergency;
+end C3A0007_2;
+
+-----------------------------------------------------------------------------
+
+with Report;
+with TCTouch;
+
+with C3A0007_0; 
+with C3A0007_1; 
+with C3A0007_2;
+procedure C3A0007 is
+
+   Pink_Button  : C3A0007_0.Button;
+   Green_Button : C3A0007_1.Priority_Button;
+
+begin
+
+   Report.Test ("C3A0007", "Check that a call to a subprogram via an "
+                         & "access-to-subprogram value stored in a data "
+                         & "structure will correctly dispatch according to "
+                         & "the tag of the class-wide parameter passed "
+                         & "via that call" );
+
+   -- Call inherited operation Push to set Default_Response value 
+   -- in the extension.
+
+   C3A0007_1.Push (Green_Button);
+   TCTouch.Validate("PCd", "First Green Button Push");
+
+   TCTouch.Assert_Not(C3A0007_0.Default_Call,
+                         "Incorrect Green Default_Response");
+
+   C3A0007_0.Push (Pink_Button);
+   TCTouch.Validate("PCD", "First Pink Button Push");
+
+   -- Call inherited operations Set_Response and Push to set 
+   -- Emergency value in the extension.
+   C3A0007_1.Set_Response (Green_Button, C3A0007_2.Emergency'Access);  
+   C3A0007_1.Push (Green_Button);
+   TCTouch.Validate("SPE", "Second Green Button Push");
+
+   TCTouch.Assert(C3A0007_2.Emergency_Call, "Incorrect Green Emergency");
+
+   C3A0007_0.Set_Response (Pink_Button, C3A0007_2.Emergency'Access);  
+   C3A0007_0.Push (Pink_Button);
+   TCTouch.Validate("SPE", "Second Pink Button Push");
+
+   -- Call primitive operation to set priority value 
+   -- in the extension.
+   C3A0007_1.Set_Priority (Green_Button);
+   TCTouch.Validate("s", "Green Button Priority");
+
+   TCTouch.Assert(Green_Button.Priority = 1, "Incorrect Set_Priority");
+
+   Report.Result;
+
+end C3A0007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0008.a
new file mode 100644
index 000000000..6cd9ce3dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0008.a
@@ -0,0 +1,150 @@
+-- C3A0008.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 subprogram references may be passed as parameters using 
+--      access-to-subprogram types. Check that the passed subprograms may 
+--      be invoked from within the called subprogram.
+--
+-- TEST DESCRIPTION:
+--      Declare an access to function type in a package specification.  
+--      Declare three different trig functions that can be referred to by 
+--      the access to function type.  
+--
+--      In the main program, call each function indirectly by passing the 
+--      access to subprogram value as parameter.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+package Integrate_Lookup is
+
+  TC_Log_Call  : Boolean := False;
+
+  TC_Cos_Call  : Boolean := False;
+
+  TC_Sine_Call : Boolean := False;
+
+  -- Type accesses to functions Log, Sine, or Cos
+  type Integrand_Ptr is access function        
+     (Angle : Float) return Float;
+
+  function Log  (Angle : in Float) return Float;        
+
+  function Sine (Angle : in Float) return Float;         
+
+  function Cos  (Angle : in Float) return Float;        
+
+  function Integrate  (Func : Integrand_Ptr; From, To: Float) 
+    return Float;
+
+end Integrate_Lookup;
+
+
+-----------------------------------------------------------------------------
+
+
+package body Integrate_Lookup is
+
+
+  function Log (Angle : in Float) return Float is
+  begin
+     TC_Log_Call := True;
+     return 0.1;
+  end Log;
+
+
+  function Sine (Angle : in Float) return Float is
+  begin
+     TC_Sine_Call := True;
+     return 0.0;
+  end Sine;
+
+
+  function Cos  (Angle : in Float) return Float is
+  begin
+     TC_Cos_Call := True;
+     return 1.0;
+  end Cos;
+
+
+  function Integrate (Func : Integrand_Ptr; From, To: Float) 
+    return Float is
+     Theta : Float;
+  begin
+     -- calls the actual subprogram passed as parameter
+     Theta := Func (From) + Func (To);
+     return Theta;
+  end Integrate;
+
+end Integrate_Lookup;
+
+
+-----------------------------------------------------------------------------
+
+
+with Report;
+
+with Integrate_Lookup; 
+
+procedure C3A0008 is
+
+  Area : Float := 0.0;
+
+begin
+
+  Report.Test ("C3A0008", "Check that subprogram references may be passed "
+                        & "as parameters using access-to-subprogram types. " 
+                       & "Check that the passed subprograms may be invoked "
+                        & "from within the called subprogram");
+
+  Area := Integrate_Lookup.Integrate
+            (Integrate_Lookup.Log'Access, 1.0, 2.0);
+
+  If not Integrate_Lookup.TC_Log_Call or Area /= 0.2 then
+     Report.Failed ("Incorrect Log result");
+  end if;
+
+  Area := Integrate_Lookup.Integrate
+            (Integrate_Lookup.Sine'Access, 1.0, 2.0);
+
+  If not Integrate_Lookup.TC_Sine_Call or Area /= 0.0 then
+     Report.Failed ("Incorrect Sine result");
+  end if;
+
+  Area := Integrate_Lookup.Integrate
+            (Integrate_Lookup.Cos'Access, 1.0, 2.0);
+
+  If not Integrate_Lookup.TC_Cos_Call or Area /= 2.0 then
+     Report.Failed ("Incorrect Cos result");
+  end if;
+
+  Report.Result;
+
+end C3A0008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0009.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0009.a
new file mode 100644
index 000000000..ba3f2f6e1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0009.a
@@ -0,0 +1,219 @@
+-- C3A0009.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 subprogram references may be passed as parameters using 
+--      access-to-subprogram types. Check that the passed subprograms may 
+--      be invoked from within the called subprogram.
+--
+-- TEST DESCRIPTION:
+--      Declare an access to procedure type in a package specification. 
+--      Declare a root tagged type with the access to procedure type as a 
+--      component.  Declare three primitive procedures for the type that 
+--      can be referred to by the access to procedure type.  Use the access 
+--      to procedure type to initialize the component of a record.
+--
+--      Extend the root type with a private extension in the same package
+--      specification. Declare two new primitive subprograms for the extension
+--      (in addition to its three inherited subprograms).
+--
+--      In the main program, declare an operation for the root tagged type 
+--      which can be passed as an access value to change the initial value
+--      of the component.  Call the inherited operations indirectly by 
+--      de-referencing the access value to set value in the extension.
+--      Call the primitive function to modify the extension by passing 
+--      the access value designating the primitive procedure as a parameter.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C3A0009_0 is -- Push_Buttons
+
+   type Button is tagged private;
+
+   -- Type accesses to procedures Push and Default_Response
+   type Button_Response_Ptr is access procedure
+      (B : in out Button);
+
+   procedure Push (B : in out Button);               -- to be inherited
+
+   procedure Set_Response (B : in out Button;        -- to be inherited
+                           R : in Button_Response_Ptr);
+
+   procedure Default_Response  (B : in out Button);  -- to be inherited
+
+   type Alert_Button is new Button with private;  -- private extension of
+                                                  -- root tagged type
+   -- Inherits procedure Push from Button
+   -- Inherits procedure Set_Response from Button
+   -- Inherits procedure Default_Response from Button
+
+   procedure Replace_Action( B: in out Alert_Button );
+
+   -- type accesses to procedure Default_Action
+   type Button_Action_Ptr is access procedure;
+
+   -- The following function is needed to set value in the
+   -- extension's private component.
+   function Alert (B : in Alert_Button) return Button_Action_Ptr;
+
+private
+
+   type Button is tagged                             -- root tagged type
+      record
+         Response :  Button_Response_Ptr 
+                  := Default_Response'Access;   
+      end record;
+
+   procedure Default_Action;
+
+   type Alert_Button is new Button with record
+        Action :  Button_Action_Ptr 
+               := Default_Action'Access;
+      end record;
+
+end C3A0009_0;
+
+
+-----------------------------------------------------------------------------
+
+
+with TCTouch;
+package body C3A0009_0 is
+
+   procedure Push (B : in out Button) is
+   begin
+      TCTouch.Touch( 'P' ); --------------------------------------------- P
+      -- Invoking subprogram designated by access value
+      B.Response (B);
+   end Push;
+
+
+   procedure Set_Response (B : in out Button;
+                           R : in     Button_Response_Ptr) is
+   begin
+      TCTouch.Touch( 'S' ); --------------------------------------------- S
+      -- Set procedure value in record
+      B.Response := R;
+   end Set_Response;
+
+
+   procedure Default_Response (B : in out Button) is
+   begin
+      TCTouch.Touch( 'D' ); --------------------------------------------- D
+   end Default_Response;
+
+
+   procedure Default_Action is
+   begin
+      TCTouch.Touch( 'd' ); --------------------------------------------- d
+   end Default_Action;
+
+   procedure Replacement_Action is
+   begin
+      TCTouch.Touch( 'r' ); --------------------------------------------- r
+   end Replacement_Action;
+
+   procedure Replace_Action( B: in out Alert_Button ) is
+   begin
+      TCTouch.Touch( 'R' ); --------------------------------------------- R
+      B.Action := Replacement_Action'Access;
+   end Replace_Action;
+
+   function Alert (B : in Alert_Button) return Button_Action_Ptr is
+   begin
+      TCTouch.Touch( 'A' ); --------------------------------------------- A
+      return (B.Action);
+   end Alert;
+
+end C3A0009_0;
+
+-----------------------------------------------------------------------------
+
+with C3A0009_0;
+package C3A0009_1 is -- Emergency_Items
+   package Push_Buttons renames C3A0009_0;
+
+   procedure Emergency (B : in out Push_Buttons.Button);
+end C3A0009_1;
+
+with TCTouch;
+package body C3A0009_1 is -- Emergency_Items
+   procedure Emergency (B : in out Push_Buttons.Button) is
+      begin
+        TCTouch.Touch( 'E' ); ------------------------------------------- E
+      end Emergency;
+end C3A0009_1;
+-----------------------------------------------------------------------------
+
+with Report;
+
+with C3A0009_0, C3A0009_1; 
+with TCTouch;
+procedure C3A0009 is
+
+   package Push_Buttons    renames C3A0009_0;
+   package Emergency_Items renames C3A0009_1;
+      
+   Black_Button : Push_Buttons.Alert_Button;
+   Alert_Ptr    : Push_Buttons.Button_Action_Ptr;
+
+begin
+
+   Report.Test ("C3A0009", "Check that subprogram references may be passed "
+                         & "as parameters using access-to-subprogram types. "
+                         & "Check that the passed subprograms may be "
+                         & "invoked from within the called subprogram");
+
+
+   Push_Buttons.Push( Black_Button );
+   Push_Buttons.Alert( Black_Button ).all;
+
+   TCTouch.Validate( "PDAd", "Default operation set" );
+
+   -- Call inherited operations Set_Response and Push to set 
+   -- Emergency value in the extension.
+   Push_Buttons.Set_Response (Black_Button, Emergency_Items.Emergency'Access);
+ 
+
+   Push_Buttons.Push( Black_Button );
+   Push_Buttons.Alert( Black_Button ).all;
+
+   TCTouch.Validate( "SPEAd", "Altered Response set" );
+
+   -- Call primitive operation to set action value in the extension.
+   Push_Buttons.Replace_Action( Black_Button );
+
+
+   Push_Buttons.Push( Black_Button );
+   Push_Buttons.Alert( Black_Button ).all;
+
+   TCTouch.Validate( "RPEAr", "Altered Action set" );
+
+   Report.Result;
+end C3A0009;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0010.a
new file mode 100644
index 000000000..5628c9518
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0010.a
@@ -0,0 +1,158 @@
+-- C3A0010.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 an access-to-subprogram type in a generic instance may be
+--      used to declare access-to-subprogram objects which invoke subprograms
+--      in the instance.
+--
+-- TEST DESCRIPTION:
+--      Declare a numeric type in the visible part of a generic package.
+--      Declare two different math procedures that can be referred to by 
+--      the access to procedure type.  
+--
+--      In the main program, instantiate the generic.  Declare an access 
+--      to procedure type.  Call each procedure indirectly by dereferencing 
+--      the access value.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      05 APR 96   SAIC    Header correction for 2.1
+--
+--!
+
+generic
+   type Real_Num is digits <>;
+
+package C3A0010_0 is
+
+   -- Type accesses to any math procedure
+   type Math_Procedure_Ptr is access procedure   
+       (First_Num, Second_Num : in  Real_Num;
+        Result_Num            : out Real_Num);
+
+   procedure Add      (First_Num, Second_Num : in  Real_Num;
+                       Result_Num            : out Real_Num);
+
+   procedure Subtract (First_Num, Second_Num : in  Real_Num;
+                       Result_Num            : out Real_Num);
+
+end C3A0010_0;
+
+
+-----------------------------------------------------------------------------
+
+
+package body C3A0010_0 is
+
+   procedure Add (First_Num, Second_Num : in  Real_Num;
+                  Result_Num            : out Real_Num) is
+   begin
+      Result_Num := First_Num + Second_Num;
+   end Add;
+
+
+   procedure Subtract (First_Num, Second_Num : in  Real_Num;
+                       Result_Num            : out Real_Num) is
+   begin
+      Result_Num := First_Num - Second_Num;
+   end Subtract;
+
+end C3A0010_0;
+
+-----------------------------------------------------------------------------
+
+with Report;
+with C3A0010_0; 
+
+procedure C3A0010 is
+
+   type Real is digits 2;
+
+   subtype Math_Float is Real range -10.0 .. 10.0;
+
+   package Math_Pk is new C3A0010_0 (Real_Num => Math_Float);
+
+   Math_Access : Math_Pk.Math_Procedure_Ptr;
+
+   Total_Num   : Math_Float := 0.0;
+   First_Num   : Math_Float := 1.0;
+   Second_Num  : Math_Float := 2.0;
+
+   procedure Max( A_Num, B_Num: in Math_Float; Result : out Math_Float ) is
+   begin
+      if A_Num > B_Num then
+        Result := A_Num;
+      else
+        Result := B_Num;
+      end if;
+   end Max;
+
+   procedure Due_Process( Process: Math_Pk.Math_Procedure_Ptr ) is
+   begin
+     Process(First_Num, Second_Num, Total_Num);
+   end Due_Process;
+
+begin
+
+   Report.Test ("C3A0010", "Check that an access-to-subprogram type in a "
+                         & "generic instance may be used to declare "
+                         & "access-to-subprogram objects which invoke "
+                         & "subprograms in the instance");
+
+-- Check for correct defaulting
+   if Math_Pk."/="( Math_Access, null) then
+     Report.Failed("subprogram access type object not initialized to null");
+   end if;
+
+   Math_Access := Math_Pk.Add'Access;
+
+   -- Invoking Add procedure designated by access value
+   Due_Process( Math_Access );
+
+   If Total_Num /= 3.0 then
+      Report.Failed ("Incorrect Add result");
+   end if;
+
+   Math_Access := Math_Pk.Subtract'Access;
+
+   Due_Process( Math_Access );
+
+   If Total_Num /= -1.0 then
+      Report.Failed ("Incorrect Subtract result");
+   end if;
+
+   Math_Access := Max'Access;
+
+   Due_Process( Math_Access );
+
+   If Total_Num /= 2.0 then
+      Report.Failed ("Incorrect Max result");
+   end if;
+
+   Report.Result;
+
+end C3A0010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0011.a
new file mode 100644
index 000000000..985080659
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0011.a
@@ -0,0 +1,186 @@
+-- C3A0011.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 an access-to-subprogram object whose type is declared in a
+--      parent package, may be used to invoke subprograms in a child package.
+--      Check that such access objects may be stored in a data structure and
+--      that subprograms may be called by walking the data structure.
+-- 
+-- TEST DESCRIPTION:
+--      In the package, declare an access to procedure type.  Declare an 
+--      array of the access type.  Declare three different procedures that 
+--      can be referred to by the access to procedure type.           
+--
+--      In the visible child package, declare two procedures that can be 
+--      referred to by the access to procedure type of the parent.  Build 
+--      the array by calling each procedure indirectly through the access 
+--      value.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      16 Dec 94   SAIC    Improved visibility of "/=" in main body
+--
+--!
+
+package C3A0011_0 is -- Interpreter
+   
+   type Compass_Point is mod 360;
+
+   function Heading return Compass_Point;
+
+   -- Type accesses to any procedure
+   type Action_Ptr is access procedure;
+   
+   -- Array of access to procedure
+   type Action_Array is array (Natural range <>) of Action_Ptr;
+
+   procedure Rotate_Left;
+
+   procedure Rotate_Right;
+
+   procedure Center;
+
+private
+   The_Heading : Compass_Point := Compass_Point'First;
+
+end C3A0011_0;
+
+
+-----------------------------------------------------------------------------
+
+
+package body C3A0011_0 is
+
+   function Heading return Compass_Point is
+   begin
+     return The_Heading;
+   end Heading;
+
+   procedure Rotate_Left is
+   begin
+      The_Heading := The_Heading - 90;
+   end Rotate_Left;
+
+
+   procedure Rotate_Right is
+   begin
+      The_Heading := The_Heading + 90;
+   end Rotate_Right;
+
+
+   procedure Center is
+   begin
+      The_Heading := 0;
+   end Center;
+
+end C3A0011_0;
+
+
+-----------------------------------------------------------------------------
+
+
+package C3A0011_0.Action is
+
+   procedure Rotate_Front;
+
+   procedure Rotate_Back;
+
+end C3A0011_0.Action;
+
+
+-----------------------------------------------------------------------------
+
+
+package body C3A0011_0.Action is
+
+   procedure Rotate_Front is
+   begin
+      The_Heading := The_Heading + 5;
+   end Rotate_Front;
+
+
+   procedure Rotate_Back is
+   begin
+      The_Heading := The_Heading - 5;
+   end Rotate_Back;
+
+end C3A0011_0.Action;
+
+
+-----------------------------------------------------------------------------
+
+
+with C3A0011_0.Action;
+
+with Report;
+
+procedure C3A0011 is
+
+   Total_Actions   : constant := 6;
+
+   Action_Sequence : C3A0011_0.Action_Array (1 .. Total_Actions);
+
+   type Result_Array is array (Natural range <>) of C3A0011_0.Compass_Point;
+
+   Action_Results  : Result_Array(1 .. Total_Actions);
+
+   package IA renames C3A0011_0.Action;
+   
+begin
+
+   Report.Test ("C3A0011", "Check that an access-to-subprogram object whose "
+                         & "type is declared in a parent package, may be "
+                         & "used to invoke subprograms in a child package. "
+                         & "Check that such access objects may be stored in "
+                         & "a data structure and that subprograms may be "
+                         & "called by walking the data structure");
+
+   -- Build the action sequence
+   Action_Sequence := (C3A0011_0.Rotate_Left'Access, 
+                       C3A0011_0.Center'Access,
+                       C3A0011_0.Rotate_Right'Access, 
+                       IA.Rotate_Front'Access,
+                       C3A0011_0.Center'Access,
+                       IA.Rotate_Back'Access);
+
+   -- Build the expected result
+   Action_Results := ( 270, 0, 90, 95, 0, 355 );
+
+   -- Assign actions by invoking subprogram designated by access value
+   for I in Action_Sequence'Range loop
+      Action_Sequence(I).all;
+      if C3A0011_0."/="( C3A0011_0.Heading, Action_Results(I) ) then
+        Report.Failed ("Expecting "
+                       & C3A0011_0.Compass_Point'Image(Action_Results(I))
+                       & " Got"
+                       & C3A0011_0.Compass_Point'Image(C3A0011_0.Heading));
+      end if;
+   end loop;
+
+   Report.Result;
+
+end C3A0011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a00120.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a00120.a
new file mode 100644
index 000000000..5ce7b6175
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a00120.a
@@ -0,0 +1,83 @@
+-- C3A00120.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:
+ --      See file C3A00122.AM
+ --
+ -- TEST DESCRIPTION:
+ --      See file C3A00122.AM
+ -- 
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --      => C3A00120.A
+ --         C3A00121.A
+ --         C3A00122.AM
+ --
+ --
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+ --!
+ 
+ package C3A0012_0 is
+ 
+       type Call_Kind is (No_Call_Made, Fast_Call, Accurate_Call, 
+                          Table_Lookup_Call);
+ 
+       Log_Result : Float := 0.0;
+ 
+       -- Type accesses to any log procedure
+       type Log_Procedure_Ptr is access procedure   
+          (Angle : in Float; Log_Call : out Call_Kind);
+ 
+       procedure Log_Calc_Fast  (Angle      : in  Float; 
+                                 Method     : out Call_Kind);
+ 
+       procedure Log_Calc_Acc   (Angle      : in  Float;
+                                 Method     : out Call_Kind);
+ 
+       procedure Log_Calc_Table (Angle      : in  Float; 
+                                 Method     : out Call_Kind);
+ 
+ end C3A0012_0;
+ 
+ 
+ --=======================================================================--
+ 
+ 
+ package body C3A0012_0 is
+ 
+    procedure Log_Calc_Fast  (Angle      : in  Float; 
+                              Method     : out Call_Kind) is separate;
+ 
+    procedure Log_Calc_Acc   (Angle      : in  Float; 
+                              Method     : out Call_Kind) is separate;
+ 
+    procedure Log_Calc_Table (Angle      : in  Float; 
+                              Method     : out Call_Kind) is separate;
+ 
+ end C3A0012_0;
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a00121.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a00121.a
new file mode 100644
index 000000000..acb1dab99
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a00121.a
@@ -0,0 +1,76 @@
+-- C3A00121.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:
+ --      See file C3A00122.AM
+ --
+ -- TEST DESCRIPTION:
+ --      See file C3A00122.AM
+ -- 
+ -- TEST FILES:
+ --      The following files comprise this test:
+ --
+ --         C3A00120.A
+ --      => C3A00121.A
+ --         C3A00122.AM
+ --
+ --
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+ --!
+ 
+ Separate (C3A0012_0)
+ procedure Log_Calc_Fast (Angle     : in  Float;
+                          Method    : out Call_Kind) is
+ begin
+    C3A0012_0.Log_Result := Angle;
+    Method := Fast_Call;
+ end Log_Calc_Fast;
+ 
+ 
+ --=======================================================================--
+ 
+ 
+ Separate (C3A0012_0)
+ procedure Log_Calc_Acc (Angle    : in  Float;
+                         Method   : out Call_Kind) is
+ begin
+    C3A0012_0.Log_Result := Angle;
+    Method := Accurate_Call;
+ end Log_Calc_Acc;
+ 
+ 
+ --=======================================================================--
+ 
+ 
+ Separate (C3A0012_0)
+ procedure Log_Calc_Table (Angle      : in  Float;
+                           Method     : out Call_Kind) is
+ begin
+    C3A0012_0.Log_Result := Angle;
+    Method := Table_Lookup_Call;
+ end Log_Calc_Table;
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a00122.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a00122.am
new file mode 100644
index 000000000..7af03c256
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a00122.am
@@ -0,0 +1,113 @@
+-- C3A00122.AM
+--
+--                             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 access-to-subprogram object can be used to invoke a
+--      subprogram when the subprogram body had been declared and implemented
+--      as a subunit.
+--
+-- TEST DESCRIPTION:
+--      Declare an access to procedure type in a main program.  Declare 
+--      three different log subprogram body stubs that can be referred to by 
+--      the access to procedure type.
+--
+--      Complete bodies of the log procedures.
+--
+--      In the main program, each procedure will be called indirectly by 
+--      dereferencing the access value.
+-- 
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         C3A00120.A
+--         C3A00121.A
+--      => C3A00122.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+ 
+ with Report;
+ 
+ with C3A0012_0; 
+ 
+ procedure C3A00122 is
+ 
+    function "="( A,B: C3A0012_0.Call_Kind ) return Boolean
+             renames C3A0012_0."=";
+ 
+    Log_Access  : C3A0012_0.Log_Procedure_Ptr;
+    Theta       : Float := 0.0;
+    Method      : C3A0012_0.Call_Kind := C3A0012_0.No_Call_Made;
+ 
+ 
+ 
+   function Due_Process( LA: C3A0012_0.Log_Procedure_Ptr )
+            return C3A0012_0.Call_Kind is
+     Result : C3A0012_0.Call_Kind := C3A0012_0.No_Call_Made;
+   begin
+     LA( Theta, Result );
+     return Result;
+   end Due_Process;
+ 
+ begin
+ 
+    Report.Test ("C3A0012", "Check that an access to a subprogram object " &
+                 "can be used to select and invoke an operation with " &
+                 "appropriate arguments");
+ 
+    Log_Access := C3A0012_0.Log_Calc_Fast'Access;
+ 
+    -- Invoking Log procedure designated by access value
+    Method := Due_Process( Log_Access );
+ 
+    If Method /= C3A0012_0.Fast_Call then
+       Report.Failed ("Incorrect Log_Calc_Fast result");
+    end if;
+ 
+    Log_Access := C3A0012_0.Log_Calc_Acc'Access;
+ 
+    -- Invoking Log procedure designated by access value
+    Method := Due_Process( Log_Access );
+ 
+    If Method /= C3A0012_0.Accurate_Call then
+       Report.Failed ("Incorrect Log_Calc_Acc result");
+    end if;
+ 
+    Log_Access := C3A0012_0.Log_Calc_Table'Access;
+ 
+    -- Invoking Log procedure designated by access value
+    Method := Due_Process( Log_Access );
+ 
+    If Method /= C3A0012_0.Table_Lookup_Call then
+       Report.Failed ("Incorrect Log_Calc_Table result");
+    end if;
+ 
+    Report.Result;
+ 
+ end C3A00122;
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0013.a
new file mode 100644
index 000000000..b23d4ee11
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0013.a
@@ -0,0 +1,347 @@
+-- C3A0013.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 general access type object may reference allocated
+--      pool objects as well as aliased objects. (3,4)
+--      Check that formal parameters of tagged types are implicitly
+--      defined as aliased; check that the 'Access of these formal
+--      parameters designates the correct object with the correct
+--      tag. (5)
+--      Check that the current instance of a limited type is defined as
+--      aliased. (5)
+--
+-- TEST DESCRIPTION:
+--      This test takes from the hierarchy defined in C390003; making
+--      the root type Vehicle limited private.  It also shifts the
+--      abstraction to include the notion of a transmission, an object
+--      which is contained within any vehicle.  Using an access
+--      discriminant, any subprogram which operates on a transmission
+--      may also reference the vehicle in which it is installed.
+--
+--      Class Hierarchy:
+--              Vehicle         Transmission
+--               /   \
+--           Truck    Car
+--
+--      Contains:
+--                Vehicle( Transmission )
+--
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      16 Dec 94   SAIC    Fixed accessibility problems
+--
+--!
+
+package C3A0013_1 is
+  type Vehicle is tagged limited private;
+  type Vehicle_ID is access all Vehicle'Class;
+
+  -- Constructors
+  procedure Create     ( It : in out Vehicle; 
+                         Wheels : Natural := 4 );
+  -- Modifiers
+  procedure Accelerate ( It : in out Vehicle );
+  procedure Decelerate ( It : in out Vehicle );
+  procedure Up_Shift   ( It : in out Vehicle );
+  procedure Stop       ( It : in out Vehicle );
+
+  -- Selectors
+  function  Speed      ( It : Vehicle ) return Natural;
+  function  Wheels     ( It : Vehicle ) return Natural;
+  function  Gear_Factor( It : Vehicle ) return Natural;
+
+  -- TC_Ops
+  procedure TC_Validate( It : in out Vehicle; Speed_Trap : Natural );
+
+  -- dispatching procedure used to check tag correctness
+  procedure TC_Validate( It     : Vehicle;
+                         TC_ID  : Character);
+
+private
+
+  type Transmission(Within: access Vehicle'Class) is limited record
+    Engaged : Boolean := False;
+    Gear    : Integer range -1..5 := 0;
+  end record;
+
+  -- Current instance of a limited type is defined as aliased
+
+  type Vehicle is tagged limited record
+    Wheels: Natural;
+    Speed : Natural;
+    Power_Train: Transmission( Vehicle'Access );
+  end record;
+end C3A0013_1;
+
+with C3A0013_1;
+package C3A0013_2 is
+  type Car is new C3A0013_1.Vehicle with private;
+  procedure TC_Validate( It     : Car;
+                         TC_ID  : Character);
+  function  Gear_Factor( It : Car ) return Natural;
+private
+  type Car is new C3A0013_1.Vehicle with record
+    Displacement : Natural;
+  end record;
+end C3A0013_2;
+
+with C3A0013_1;
+package C3A0013_3 is
+  type Truck is new C3A0013_1.Vehicle with private;
+  procedure TC_Validate( It     : Truck;
+                         TC_ID  : Character);
+  function  Gear_Factor( It : Truck ) return Natural;
+private
+  type Truck is new C3A0013_1.Vehicle with record
+    Displacement : Natural;
+  end record;
+end C3A0013_3;
+
+with Report;
+package body C3A0013_1 is
+
+  procedure Create    ( It : in out Vehicle; 
+                        Wheels : Natural := 4 ) is
+  begin
+    It.Wheels   := Wheels;
+    It.Speed    := 0;
+  end Create;
+
+  procedure Accelerate( It : in out Vehicle ) is
+  begin
+    It.Speed := It.Speed + Gear_Factor( It.Power_Train.Within.all );
+  end Accelerate;
+
+  procedure Decelerate( It : in out Vehicle ) is
+  begin
+    It.Speed := It.Speed - Gear_Factor( It.Power_Train.Within.all );
+  end Decelerate;
+
+  procedure Stop      ( It : in out Vehicle ) is
+  begin
+    It.Speed := 0;
+    It.Power_Train.Engaged := False;
+  end Stop;
+
+  function  Gear_Factor( It : Vehicle ) return Natural is
+  begin
+    return It.Power_Train.Gear;
+  end Gear_Factor;
+
+  function  Speed     ( It : Vehicle ) return Natural is
+  begin
+    return It.Speed;
+  end Speed;
+
+  function  Wheels     ( It : Vehicle ) return Natural is
+  begin
+    return It.Wheels;
+  end Wheels;
+
+  -- formal tagged parameters are implicitly aliased
+
+  procedure TC_Validate( It : in out Vehicle; Speed_Trap : Natural ) is
+    License: Vehicle_ID := It'Unchecked_Access;
+  begin
+    if Speed( License.all ) /= Speed_Trap then
+      Report.Failed("Speed Trap: expected: " & Natural'Image(Speed_Trap));
+    end if;
+  end TC_Validate;
+
+  procedure TC_Validate( It     : Vehicle;
+                         TC_ID  : Character) is
+  begin
+    if TC_ID /= 'V' then
+      Report.Failed("Dispatched to Vehicle");
+    end if;
+    if Wheels( It ) /= 1 then
+      Report.Failed("Not a Vehicle");
+    end if;
+  end TC_Validate;
+
+  procedure Up_Shift( It: in out Vehicle ) is
+  begin
+    It.Power_Train.Gear    := It.Power_Train.Gear +1;
+    It.Power_Train.Engaged := True;
+    Accelerate( It );
+  end Up_Shift;
+end C3A0013_1;
+
+with Report;
+package body C3A0013_2 is
+
+  procedure TC_Validate( It     : Car;
+                         TC_ID  : Character ) is
+  begin
+    if TC_ID /= 'C' then
+      Report.Failed("Dispatched to Car");
+    end if;
+    if Wheels( It ) /= 4 then
+      Report.Failed("Not a Car");
+    end if;
+  end TC_Validate;
+
+  function  Gear_Factor( It : Car ) return Natural is
+  begin
+    return C3A0013_1.Gear_Factor( C3A0013_1.Vehicle( It ) )*2;
+  end Gear_Factor;
+
+end C3A0013_2;
+
+with Report;
+package body C3A0013_3 is
+
+  procedure TC_Validate( It     : Truck;
+                         TC_ID  : Character) is
+  begin
+    if TC_ID /= 'T' then
+      Report.Failed("Dispatched to Truck");
+    end if;
+    if Wheels( It ) /= 3 then
+      Report.Failed("Not a Truck");
+    end if;
+  end TC_Validate;
+
+  function  Gear_Factor( It : Truck ) return Natural is
+  begin
+    return C3A0013_1.Gear_Factor( C3A0013_1.Vehicle( It ) )*3;
+  end Gear_Factor;
+
+end C3A0013_3;
+
+package C3A0013_4 is
+  procedure Perform_Tests;
+end C3A0013_4;
+
+with Report;
+with C3A0013_1;
+with C3A0013_2;
+with C3A0013_3;
+package body C3A0013_4 is
+  package Root   renames C3A0013_1;
+  package Cars   renames C3A0013_2;
+  package Trucks renames C3A0013_3;
+
+  type Car_Pool is array(1..4) of aliased Cars.Car;
+  Commuters : Car_Pool;
+
+  My_Car      : aliased Cars.Car;
+  Company_Car : Root.Vehicle_ID;
+  Repair_Shop : Root.Vehicle_ID;
+
+  The_Vehicle : Root.Vehicle;
+  The_Car     : Cars.Car;
+  The_Truck   : Trucks.Truck;
+
+  procedure TC_Dispatch( Ptr   : Root.Vehicle_ID;
+                         Char  : Character ) is
+  begin
+    Root.TC_Validate( Ptr.all, Char );
+  end TC_Dispatch;
+
+  procedure TC_Check_Formal_Access( Item: in out Root.Vehicle'Class;
+                                    Char: Character) is
+  begin
+    TC_Dispatch( Item'Unchecked_Access, Char );
+  end TC_Check_Formal_Access;
+
+  procedure Perform_Tests is
+  begin  -- Main test procedure.
+
+  for Lane in Commuters'Range loop
+    Cars.Create( Commuters(Lane) );
+    for Excitement in 1..Lane loop
+      Cars.Up_Shift( Commuters(Lane) );
+    end loop;
+  end loop;
+
+  Cars.Create( My_Car );
+  Cars.Up_Shift( My_Car );
+  Cars.TC_Validate( My_Car, 2 );
+
+  Root.Create( The_Vehicle, 1 );
+  Cars.Create( The_Car    , 4 );
+  Trucks.Create( The_Truck, 3 );
+
+  TC_Check_Formal_Access( The_Vehicle, 'V' );
+  TC_Check_Formal_Access( The_Car,     'C' );
+  TC_Check_Formal_Access( The_Truck,   'T' );
+
+  Root.Up_Shift( The_Vehicle );
+  Cars.Up_Shift( The_Car );
+  Trucks.Up_Shift( The_Truck );
+
+  Root.TC_Validate( The_Vehicle, 1 ); 
+  Cars.TC_Validate( The_Car, 2 ); 
+  Trucks.TC_Validate( The_Truck, 3 ); 
+
+  --  general access type may reference allocated objects
+
+  Company_Car := new Cars.Car;
+  Root.Create( Company_Car.all );
+  Root.Up_Shift( Company_Car.all );
+  Root.Up_Shift( Company_Car.all );
+  Root.TC_Validate( Company_Car.all, 6 );
+
+  --  general access type may reference aliased objects
+
+  Repair_Shop := My_Car'Access;
+  Root.TC_Validate( Repair_Shop.all, 2 );
+
+  --  general access type may reference aliased objects
+
+  Construction: declare
+    type Speed_List is array(Commuters'Range) of Natural;
+    Accelerations : constant Speed_List := (2, 6, 12, 20);
+  begin
+    for Rotation in Commuters'Range loop
+      Repair_Shop := Commuters(Rotation)'Access;
+      Root.TC_Validate( Repair_Shop.all, Accelerations(Rotation) );
+    end loop;
+  end Construction;
+
+end Perform_Tests;
+
+end C3A0013_4;
+
+with C3A0013_4;
+with Report;
+procedure C3A0013 is
+begin
+
+  Report.Test ("C3A0013", "Check general access types.  Check aliased "
+                        & "nature of formal tagged type parameters.  "
+                        & "Check aliased nature of the current "
+                        & "instance of a limited type.  Check the "
+                        & "constraining of actual subtypes for "
+                        & "discriminated objects" );
+
+  C3A0013_4.Perform_Tests;
+
+  Report.Result;
+end C3A0013;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0014.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0014.a
new file mode 100644
index 000000000..c83ab4f5e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0014.a
@@ -0,0 +1,453 @@
+-- C3A0014.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 the view defined by an object declaration is aliased,
+--      and the type of the object has discriminants, then the object is
+--      constrained by its initial value even if its nominal subtype is
+--      unconstrained.
+--
+--      Check that the attribute A'Constrained returns True if A is a formal
+--      out or in out parameter, or dereference thereof, and A denotes an
+--      aliased view of an object.
+--
+-- TEST DESCRIPTION:
+--      These rules apply to objects of a record type with defaulted
+--      discriminants, which may be unconstrained variables. If such a
+--      variable is declared to be aliased, then it is constrained by its
+--      initial value, and the value of the discriminant cannot be changed
+--      for the life of the variable.
+--
+--      The rules do not apply to aliased component types because if such
+--      types are discriminated they must be constrained.
+--
+--      A'Constrained returns True if A denotes a constant, value, or
+--      constrained variable. Since aliased objects are constrained, it must
+--      return True if the actual parameter corresponding to a formal
+--      parameter A is an aliased object. The objective only mentions formal
+--      parameters of mode out and in out, since parameters of mode in are
+--      by definition constant, and would result in True anyway.
+--
+--      This test declares aliased objects of a nominally unconstrained
+--      record subtype, both with and without initialization expressions.
+--      It also declares access values which point to such objects. It then
+--      checks that Constraint_Error is raised if an attempt is made to
+--      change the discriminant value of an aliased object, either directly
+--      or via a dereference of an access value. For aliased objects, this
+--      check is also performed for subprogram parameters of mode out.
+--
+--      The test also passes aliased objects and access values which point
+--      to such objects as actuals to subprograms and verifies, for parameter
+--      modes out and in out, that P'Constrained returns true if P is the
+--      corresponding formal parameter or a dereference thereof.
+--
+--      Additionally, the test declares a generic package which declares a
+--      an aliased object of a formal derived unconstrained type, which is
+--      is initialized with the value of a formal object of that type.
+--      procedure declared within the generic assigns a value to the object
+--      which has the same discriminant value as the formal derived type's
+--      ancestor type. The generic is instantiated with various actuals
+--      for the formal object, and the procedure is called. The test verifies
+--      that Constraint_Error is raised if the discriminant values of the
+--      actual corresponding to the formal object and the value assigned
+--      by the procedure are not equal.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      16 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected numerous errors.
+--
+--!
+
+package C3A0014_0 is
+
+   subtype Reasonable is Integer range 1..10;
+                                          -- Unconstrained (sub)type.
+   type UC (D: Reasonable := 2) is record -- Discriminant default.
+      S: String (1 .. D) := "Hi";         -- Default value.
+   end record;
+
+   type AUC is access all UC;
+
+   -- Nominal subtype is unconstrained for the following:
+
+   Obj0 :         UC;                  -- An unconstrained object.
+
+   Obj1 :         UC := (5, "Hello");  -- Non-aliased with initialization,
+                                       -- an unconstrained object.
+
+   Obj2 : aliased UC := (5, "Hello");  -- Aliased with initialization,
+                                       -- a constrained object.
+
+   Obj3 :         UC renames Obj2;     -- Aliased (renaming of aliased view),
+                                       -- a constrained object.
+   Obj4 : aliased UC;                  -- Aliased without initialization, Obj4
+                                       -- constrained here to initial value
+                                       -- taken from default for type.
+
+   Ptr1 : AUC := new UC'(Obj1);
+   Ptr2 : AUC := new UC;
+   Ptr3 : AUC := Obj3'Access;
+   Ptr4 : AUC := Obj4'Access;
+
+
+   procedure NP_Proc (A:    out UC);
+   procedure NP_Cons (A: in out UC;  B: out Boolean);
+   procedure P_Cons  (A:    out AUC; B: out Boolean);
+
+
+   generic
+      type FT is new UC;
+      FObj : in out FT;
+   package Gen is
+      F  : aliased FT := FObj;     -- Constrained if FT has discriminants.
+      procedure Proc;
+   end Gen;
+
+
+   procedure Avoid_Optimization_and_Fail ( P : UC; Msg : String );
+
+
+end C3A0014_0;
+
+
+  --=======================================================================--
+
+with Report;
+
+package body C3A0014_0 is
+
+   procedure NP_Proc (A: out UC) is
+   begin
+      A := (3, "Bye");
+   end NP_Proc;
+
+   procedure NP_Cons (A: in out UC; B: out Boolean) is
+   begin
+      B := A'Constrained; 
+   end NP_Cons;
+
+   procedure P_Cons (A: out AUC; B: out Boolean) is
+   begin
+      B := A.all'Constrained; 
+   end P_Cons;
+
+
+   package body Gen is
+     
+      procedure Proc is
+      begin
+         F := (2, "Fi");
+      end Proc;
+
+   end Gen;
+
+
+   procedure Avoid_Optimization_and_Fail ( P : UC; Msg : String ) is
+      Default : UC := (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;
+
+
+end C3A0014_0;
+
+
+  --=======================================================================--
+
+
+with C3A0014_0;  use C3A0014_0;
+with Report;
+
+procedure C3A0014 is
+begin
+
+   Report.Test("C3A0014", "Check that if the view defined by an object "   &
+                          "declaration is aliased, and the type of the "   &
+                          "object has discriminants, then the object is "  &
+                          "constrained by its initial value even if its "  &
+                          "nominal subtype is unconstrained.  Check that " &
+                          "the attribute A'Constrained returns True if A " &
+                          "is a formal out or in out parameter, or "       &
+                          "dereference thereof, and A denotes an aliased " &
+                          "view of an object");
+
+   Non_Pointer_Block:
+   begin
+
+      begin
+         Obj0 := (3, "Bye");              -- OK: Obj0 not constrained.
+         if Obj0 /= (3, "Bye") then
+            Report.Failed 
+              ("Wrong value after aggregate assignment - Subtest 1");
+         end if;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception raised - Subtest 1");
+      end;
+
+
+      begin
+         Obj1 := (3, "Bye");              -- OK: Obj1 not constrained.
+         if Obj1 /= (3, "Bye") then
+            Report.Failed
+              ("Wrong value after aggregate assignment - Subtest 2");
+         end if;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception raised - Subtest 2");
+      end;
+
+
+      begin
+         Obj2 := (3, "Bye");              -- C_E: Obj2 is constrained (D=>5).
+         Avoid_Optimization_and_Fail (Obj2, "Subtest 3");
+      exception
+         when Constraint_Error => null;  -- Exception is expected.
+      end;
+
+
+      begin
+         Obj3 := (3, "Bye");              -- C_E: Obj3 is constrained (D=>5).
+         Avoid_Optimization_and_Fail (Obj3, "Subtest 4");
+      exception
+         when Constraint_Error => null;  -- Exception is expected.
+      end;
+
+
+      begin
+         Obj4 := (3, "Bye");              -- C_E: Obj4 is constrained (D=>2).
+         Avoid_Optimization_and_Fail (Obj4, "Subtest 5");
+      exception
+         when Constraint_Error => null;  -- Exception is expected.
+      end;
+
+   exception
+      when others => Report.Failed("Unexpected exception: Non_Pointer_Block");
+   end Non_Pointer_Block;
+
+
+   Pointer_Block:
+   begin
+   
+      begin
+         Ptr1.all := (3, "Bye");        -- C_E: Ptr1.all is constrained (D=>5).
+         Avoid_Optimization_and_Fail (Ptr1.all, "Subtest 6");
+      exception
+         when Constraint_Error => null; -- Exception is expected.
+      end;
+
+
+      begin
+         Ptr2.all := (3, "Bye");        -- C_E: Ptr2.all is constrained (D=>2).
+         Avoid_Optimization_and_Fail (Ptr2.all, "Subtest 7");
+      exception
+         when Constraint_Error => null; -- Exception is expected. 
+      end;
+
+
+      begin
+         Ptr3.all := (3, "Bye");        -- C_E: Ptr3.all is constrained (D=>5).
+         Avoid_Optimization_and_Fail (Ptr3.all, "Subtest 8");
+      exception
+         when Constraint_Error => null; -- Exception is expected. 
+      end;
+
+
+      begin
+         Ptr4.all := (3, "Bye");        -- C_E: Ptr4.all is constrained (D=>2).
+         Avoid_Optimization_and_Fail (Ptr4.all, "Subtest 9");
+      exception
+         when Constraint_Error => null; -- Exception is expected. 
+      end;
+
+   exception
+      when others => Report.Failed("Unexpected exception: Pointer_Block");
+   end Pointer_Block;
+
+
+   Subprogram_Block:
+   declare
+      Is_Constrained : Boolean;
+   begin
+
+      begin
+         NP_Proc (Obj0);                 -- OK: Obj0 not constrained, can
+         if Obj0 /= (3, "Bye") then      -- change discriminant value.
+            Report.Failed 
+              ("Wrong value after aggregate assignment - Subtest 10");
+         end if;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception raised - Subtest 10");
+      end;
+
+
+      begin
+         NP_Proc (Obj2);                 -- C_E: Obj2 is constrained (D=>5).
+         Avoid_Optimization_and_Fail (Obj2, "Subtest 11");      
+      exception
+         when Constraint_Error => null;  -- Exception is expected.
+      end;
+
+
+      begin
+         NP_Proc (Obj3);                 -- C_E: Obj3 is constrained (D=>5).
+         Avoid_Optimization_and_Fail (Obj3, "Subtest 12");
+      exception
+         when Constraint_Error => null;  -- Exception is expected.
+      end;
+
+
+      begin
+         NP_Proc (Obj4);                 -- C_E: Obj4 is constrained (D=>2).
+         Avoid_Optimization_and_Fail (Obj4, "Subtest 13");
+      exception
+         when Constraint_Error => null;  -- Exception is expected.
+      end;
+
+
+
+      begin
+         Is_Constrained := True;
+         NP_Cons (Obj1, Is_Constrained);  -- Should return False, since Obj1
+         if Is_Constrained then           -- is not constrained.
+            Report.Failed ("Wrong result from 'Constrained - Subtest 14");
+         end if;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception raised - Subtest 14");
+      end;
+
+
+      begin
+         Is_Constrained := False;
+         NP_Cons (Obj2, Is_Constrained);  -- Should return True, Obj2 is
+         if not Is_Constrained then       -- constrained.
+            Report.Failed ("Wrong result from 'Constrained - Subtest 15");
+         end if;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception raised - Subtest 15");
+      end;
+
+
+
+
+      begin
+         Is_Constrained := False;
+         P_Cons (Ptr2, Is_Constrained);   -- Should return True, Ptr2.all
+         if not Is_Constrained then       -- is constrained.
+            Report.Failed ("Wrong result from 'Constrained - Subtest 16");
+         end if;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception raised - Subtest 16");
+      end;
+
+
+      begin
+         Is_Constrained := False;
+         P_Cons (Ptr3, Is_Constrained);   -- Should return True, Ptr3.all
+         if not Is_Constrained then       -- is constrained.
+            Report.Failed ("Wrong result from 'Constrained - Subtest 17");
+         end if;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception raised - Subtest 17");
+      end;
+
+
+   exception
+      when others => Report.Failed("Exception raised in Subprogram_Block");
+   end Subprogram_Block;
+
+
+   Generic_Block:
+   declare
+
+      type NUC is new UC;
+
+      Obj : NUC;
+
+
+      package Instance_A is new Gen (NUC, Obj);
+      package Instance_B is new Gen (UC, Obj2);
+      package Instance_C is new Gen (UC, Obj3);
+      package Instance_D is new Gen (UC, Obj4);
+
+   begin
+
+      begin
+         Instance_A.Proc;                -- OK: Obj.D = 2.
+         if Instance_A.F /= (2, "Fi") then
+            Report.Failed 
+              ("Wrong value after aggregate assignment - Subtest 18");
+         end if;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception raised - Subtest 18");
+      end;
+
+
+      begin
+         Instance_B.Proc;                -- C_E: Obj2.D = 5.
+         Avoid_Optimization_and_Fail (Obj2, "Subtest 19");
+      exception
+         when Constraint_Error => null;  -- Exception is expected.
+      end;
+
+
+      begin
+         Instance_C.Proc;                -- C_E: Obj3.D = 5.
+         Avoid_Optimization_and_Fail (Obj3, "Subtest 20");
+      exception
+         when Constraint_Error => null;  -- Exception is expected.
+      end;
+
+
+      begin
+         Instance_D.Proc;                -- OK: Obj4.D = 2.
+         if Instance_D.F /= (2, "Fi") then
+            Report.Failed 
+              ("Wrong value after aggregate assignment - Subtest 21");
+         end if;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception raised - Subtest 21");
+      end;
+
+   exception
+      when others => Report.Failed("Exception raised in Generic_Block");
+   end Generic_Block;
+
+
+   Report.Result;
+
+end C3A0014;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0015.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0015.a
new file mode 100644
index 000000000..856c910f9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a0015.a
@@ -0,0 +1,267 @@
+-- C3A0015.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that a derived access type has the same storage pool as its
+--    parent.  (Defect Report 8652/0012, Technical Corrigendum 3.10(7/1)).
+--
+-- CHANGE HISTORY:
+--    24 JAN 2001   PHL   Initial version.
+--    29 JUN 2001   RLB   Reformatted for ACATS.
+--
+--!
+with System.Storage_Elements;
+use System.Storage_Elements;
+with System.Storage_Pools;
+use System.Storage_Pools;
+package C3A0015_0 is
+
+    type Pool (Storage_Size : Storage_Count) is new Root_Storage_Pool with
+	record
+	    First_Free : Storage_Count := 1;
+	    Contents : Storage_Array (1 .. Storage_Size);
+	end record;
+
+    procedure Allocate (Pool : in out C3A0015_0.Pool;
+			Storage_Address : out System.Address;
+			Size_In_Storage_Elements : in Storage_Count;
+			Alignment : in Storage_Count);
+
+    procedure Deallocate (Pool : in out C3A0015_0.Pool;
+			  Storage_Address : in System.Address;
+			  Size_In_Storage_Elements : in Storage_Count;
+			  Alignment : in Storage_Count);
+
+    function Storage_Size (Pool : in C3A0015_0.Pool) return Storage_Count;
+
+end C3A0015_0;
+
+package body C3A0015_0 is
+
+    use System;
+
+    procedure Allocate (Pool : in out C3A0015_0.Pool;
+			Storage_Address : out System.Address;
+			Size_In_Storage_Elements : in Storage_Count;
+			Alignment : in Storage_Count) is
+	Unaligned_Address : constant System.Address :=
+	   Pool.Contents (Pool.First_Free)'Address;
+	Unalignment : Storage_Count;
+    begin
+	Unalignment := Unaligned_Address mod Alignment;
+	if Unalignment = 0 then
+	    Storage_Address := Unaligned_Address;
+	    Pool.First_Free := Pool.First_Free + Size_In_Storage_Elements;
+	else
+	    Storage_Address :=
+	       Pool.Contents (Pool.First_Free + Alignment - Unalignment)'
+		  Address;
+	    Pool.First_Free := Pool.First_Free + Size_In_Storage_Elements +
+				  Alignment - Unalignment;
+	end if;
+    end Allocate;
+
+    procedure Deallocate (Pool : in out C3A0015_0.Pool;
+			  Storage_Address : in System.Address;
+			  Size_In_Storage_Elements : in Storage_Count;
+			  Alignment : in Storage_Count) is
+    begin
+	if Storage_Address + Size_In_Storage_Elements =
+	   Pool.Contents (Pool.First_Free)'Address then
+	    -- Only deallocate if the block is at the end.
+	    Pool.First_Free := Pool.First_Free - Size_In_Storage_Elements;
+	end if;
+    end Deallocate;
+
+    function Storage_Size (Pool : in C3A0015_0.Pool) return Storage_Count is
+    begin
+	return Pool.Storage_Size;
+    end Storage_Size;
+
+end C3A0015_0;
+
+with Ada.Exceptions;
+use Ada.Exceptions;
+with Ada.Unchecked_Deallocation;
+with Report;
+use Report;
+with System.Storage_Elements;
+use System.Storage_Elements;
+with C3A0015_0;
+procedure C3A0015 is
+
+    type Standard_Pool is access Float;
+    type Derived_Standard_Pool is new Standard_Pool;
+    type Derived_Derived_Standard_Pool is new Derived_Standard_Pool;
+
+    type User_Defined_Pool is access Integer;
+    type Derived_User_Defined_Pool is new User_Defined_Pool;
+    type Derived_Derived_User_Defined_Pool is new Derived_User_Defined_Pool;
+
+    My_Pool : C3A0015_0.Pool (1024);
+    for User_Defined_Pool'Storage_Pool use My_Pool;
+
+    generic
+	type Designated is private;
+	Value : Designated;
+	type Acc is access Designated;
+	type Derived_Acc is new Acc;
+    procedure Check (Subtest : String; User_Defined_Pool : Boolean);
+
+    procedure Check (Subtest : String; User_Defined_Pool : Boolean) is
+
+	procedure Deallocate is
+	   new Ada.Unchecked_Deallocation (Object => Designated,
+					   Name => Acc);
+	procedure Deallocate is
+	   new Ada.Unchecked_Deallocation (Object => Designated,
+					   Name => Derived_Acc);
+
+	First_Free : Storage_Count;
+	X : Acc;
+	Y : Derived_Acc;
+    begin
+	if User_Defined_Pool then
+	    First_Free := My_Pool.First_Free;
+	end if;
+	X := new Designated'(Value);
+	if User_Defined_Pool and then First_Free >= My_Pool.First_Free then
+	    Failed (Subtest &
+		    " - Allocation didn't consume storage in the pool - 1");
+	else
+	    First_Free := My_Pool.First_Free;
+	end if;
+
+	Y := Derived_Acc (X);
+	if User_Defined_Pool and then First_Free /= My_Pool.First_Free then
+	    Failed (Subtest &
+		    " - Conversion did consume storage in the pool - 1");
+	end if;
+	if Y.all /= Value then
+	    Failed (Subtest &
+		    " - Incorrect allocation/conversion of access values - 1");
+	end if;
+
+	Deallocate (Y);
+	if User_Defined_Pool and then First_Free <= My_Pool.First_Free then
+	    Failed (Subtest &
+		    " - Deallocation didn't release storage from the pool - 1");
+	else
+	    First_Free := My_Pool.First_Free;
+	end if;
+
+	Y := new Designated'(Value);
+	if User_Defined_Pool and then First_Free >= My_Pool.First_Free then
+	    Failed (Subtest &
+		    " - Allocation didn't consume storage in the pool - 2");
+	else
+	    First_Free := My_Pool.First_Free;
+	end if;
+
+	X := Acc (Y);
+	if User_Defined_Pool and then First_Free /= My_Pool.First_Free then
+	    Failed (Subtest &
+		    " - Conversion did consume storage in the pool - 2");
+	end if;
+	if X.all /= Value then
+	    Failed (Subtest &
+		    " - Incorrect allocation/conversion of access values - 2");
+	end if;
+
+	Deallocate (X);
+	if User_Defined_Pool and then First_Free <= My_Pool.First_Free then
+	    Failed (Subtest &
+		    " - Deallocation didn't release storage from the pool - 2");
+	end if;
+    exception
+	when E: others =>
+	    Failed (Subtest & " - Exception " & Exception_Name (E) &
+		    " raised - " & Exception_Message (E));
+    end Check;
+
+
+begin
+    Test ("C3A0015", "Check that a dervied access type has the same " &
+			"storage pool as its parent");
+
+    Comment ("Access types using the standard storage pool");
+
+    Std:
+	declare
+	    procedure Check1 is
+	       new Check (Designated => Float,
+			  Value => 3.0,
+			  Acc => Standard_Pool,
+			  Derived_Acc => Derived_Standard_Pool);
+	    procedure Check2 is
+	       new Check (Designated => Float,
+			  Value => 4.0,
+			  Acc => Standard_Pool,
+			  Derived_Acc => Derived_Derived_Standard_Pool);
+	    procedure Check3 is
+	       new Check (Designated => Float,
+			  Value => 5.0,
+			  Acc => Derived_Standard_Pool,
+			  Derived_Acc => Derived_Derived_Standard_Pool);
+	begin
+	    Check1 ("Standard_Pool/Derived_Standard_Pool",
+		    User_Defined_Pool => False);
+	    Check2 ("Standard_Pool/Derived_Derived_Standard_Pool",
+		    User_Defined_Pool => False);
+	    Check3 ("Derived_Standard_Pool/Derived_Derived_Standard_Pool",
+		    User_Defined_Pool => False);
+	end Std;
+
+    Comment ("Access types using a user-defined storage pool");
+
+    User:
+	declare
+	    procedure Check1 is
+	       new Check (Designated => Integer,
+			  Value => 17,
+			  Acc => User_Defined_Pool,
+			  Derived_Acc => Derived_User_Defined_Pool);
+	    procedure Check2 is
+	       new Check (Designated => Integer,
+			  Value => 18,
+			  Acc => User_Defined_Pool,
+			  Derived_Acc => Derived_Derived_User_Defined_Pool);
+	    procedure Check3 is
+	       new Check (Designated => Integer,
+			  Value => 19,
+			  Acc => Derived_User_Defined_Pool,
+			  Derived_Acc => Derived_Derived_User_Defined_Pool);
+	begin
+	    Check1 ("User_Defined_Pool/Derived_User_Defined_Pool",
+		    User_Defined_Pool => True);
+	    Check2 ("User_Defined_Pool/Derived_Derived_User_Defined_Pool",
+		    User_Defined_Pool => True);
+	    Check3
+	       ("Derived_User_Defined_Pool/Derived_Derived_User_Defined_Pool",
+		User_Defined_Pool => True);
+	end User;
+
+    Result;
+end C3A0015;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1001.a
new file mode 100644
index 000000000..9b05b5da2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1001.a
@@ -0,0 +1,315 @@
+-- C3A1001.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 full type completing a type with no discriminant part
+--      or an unknown discriminant part may have explicitly declared or
+--      inherited discriminants.
+--      Check for cases where the types are records and protected types.
+--
+-- TEST DESCRIPTION:
+--      Declare two groups of incomplete types: one group with no discriminant 
+--      part and one group with unknown discriminant part.  Both groups of 
+--      incomplete types are completed with both explicit and inherited 
+--      discriminants.  Discriminants for record and protected types are 
+--      declared with default and non default values.
+--      In the main program, verify that objects of both groups of incomplete 
+--      types can be created by default values or by assignments.
+--
+--
+-- CHANGE HISTORY:
+--      11 Oct 95   SAIC    Initial prerelease version.
+--      11 Nov 96   SAIC    Revised for version 2.1.
+--
+--!
+
+package C3A1001_0 is
+
+   type Incomplete1 (<>);                          -- unknown discriminant
+
+   type Incomplete2;                               -- no discriminant
+
+   type Incomplete3 (<>);                          -- unknown discriminant
+
+   type Incomplete4;                               -- no discriminant
+
+   type Incomplete5 (<>);                          -- unknown discriminant
+
+   type Incomplete6;                               -- no discriminant
+
+   type Incomplete8;                               -- no discriminant
+
+   subtype Small_Int is Integer range 1 .. 10;
+
+   type Enu_Type is (M, F);
+
+   type Incomplete1 (Disc : Enu_Type) is           -- unknown discriminant/
+     record                                        -- explicit discriminant 
+        case Disc is
+           when M => MInteger : Small_Int := 3;
+           when F => FInteger : Small_Int := 8;
+        end case;
+     end record;
+
+   type Incomplete2 (Disc : Small_Int := 8) is     -- no discriminant/  
+     record                                        -- explicit discriminant 
+        ID : String (1 .. Disc) := "Plymouth";
+     end record;
+
+   type Incomplete3 is new Incomplete2;            -- unknown discriminant/
+                                                   -- inherited discriminant
+
+   type Incomplete4 is new Incomplete2;            -- no discriminant/  
+                                                   -- inherited discriminant   
+                                                   
+   protected type Incomplete5                      -- unknown discriminant/
+     (Disc : Enu_Type) is                          -- explicit discriminant
+        function Get_Priv_Val return Enu_Type;     
+   private
+      Enu_Obj : Enu_Type := Disc;
+   end Incomplete5;    
+
+   protected type Incomplete6                      -- no discriminant/  
+     (Disc : Small_Int := 1) is                    -- explicit discriminant
+        function Get_Priv_Val return Small_Int;    -- with default
+   private
+      Num : Small_Int := Disc;
+   end Incomplete6;
+
+   type Incomplete8 (Disc : Small_Int) is          -- no discriminant/  
+     record                                        -- explicit discriminant
+       Str : String (1 .. Disc);                   -- no default
+     end record;
+
+   type Incomplete9 is new Incomplete8;
+
+   function Return_String (S : String) return String;
+
+end C3A1001_0;
+
+     --==================================================================--
+
+with Report;
+
+package body C3A1001_0 is
+
+   protected body Incomplete5 is    
+
+      function Get_Priv_Val return Enu_Type is
+      begin
+         return Enu_Obj;
+      end Get_Priv_Val; 
+
+    end Incomplete5; 
+
+   ----------------------------------------------------------------------
+   protected body Incomplete6 is                                             
+            
+      function Get_Priv_Val return Small_Int is
+      begin
+         return Num;
+      end Get_Priv_Val; 
+
+    end Incomplete6; 
+
+   ----------------------------------------------------------------------
+   function Return_String (S : String) return String is
+   begin
+      if Report.Ident_Bool(True) = True then
+         return S;
+      end if;
+
+      return S;
+   end Return_String;
+   
+end C3A1001_0;
+
+     --==================================================================--
+
+with Report;
+
+with C3A1001_0;
+use  C3A1001_0;
+
+procedure C3A1001 is
+
+   -- Discriminant value comes from default.
+
+   Incomplete2_Obj_1 :  Incomplete2;                
+
+   Incomplete4_Obj_1 :  Incomplete4;
+
+   Incomplete6_Obj_1 :  Incomplete6;                
+
+   -- Discriminant value comes from explicit constraint.
+
+   Incomplete1_Obj_1 :  Incomplete1 (F);              
+
+   Incomplete5_Obj_1 :  Incomplete5 (M);               
+
+   Incomplete6_Obj_2 :  Incomplete6 (2);           
+
+   -- Discriminant value comes from assignment.        
+
+   Incomplete3_Obj_1 :  Incomplete3 := (Disc => 6, ID => "Sentra");       
+
+   Incomplete1_Obj_2 :  Incomplete1 := (Disc => M, MInteger => 9);    
+                                  
+   Incomplete2_Obj_2 :  Incomplete2 := (Disc => 5, ID => "Buick");    
+                                  
+begin
+
+   Report.Test ("C3A1001", "Check that the full type completing a type " &
+                "with no discriminant part or an unknown discriminant "  &
+                "part may have explicitly declared or inherited "        &
+                "discriminants.  Check for cases where the types are "   &
+                "records and protected types");
+
+   -- Check the initial values.
+
+   if (Incomplete2_Obj_1.Disc /= 8) or
+      (Incomplete2_Obj_1.ID   /= "Plymouth") then
+         Report.Failed ("Wrong initial values for Incomplete2_Obj_1");
+   end if;
+
+   if (Incomplete4_Obj_1.Disc /= 8) or
+      (Incomplete4_Obj_1.ID   /= "Plymouth") then
+         Report.Failed ("Wrong initial values for Incomplete4_Obj_1");
+   end if;
+
+   if (Incomplete6_Obj_1.Disc         /= 1) or
+      (Incomplete6_Obj_1.Get_Priv_Val /= 1) then
+         Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
+   end if;
+
+   -- Check the explicit values.
+
+   if (Incomplete1_Obj_1.Disc     /= F) or 
+      (Incomplete1_Obj_1.FInteger /= 8) then
+         Report.Failed ("Wrong values for Incomplete1_Obj_1");
+   end if;
+
+   if (Incomplete5_Obj_1.Disc         /= M) or  
+      (Incomplete5_Obj_1.Get_Priv_Val /= M) then
+         Report.Failed ("Wrong value for Incomplete5_Obj_1");
+   end if;
+
+   if (Incomplete6_Obj_2.Disc         /= 2) or
+      (Incomplete6_Obj_2.Get_Priv_Val /= 2) then
+         Report.Failed ("Wrong value for Incomplete6_Obj_2");
+   end if;
+
+   -- Check the assigned values.
+
+   if (Incomplete3_Obj_1.Disc /= 6) or 
+      (Incomplete3_Obj_1.ID   /= "Sentra") then
+         Report.Failed ("Wrong values for Incomplete3_Obj_1");
+   end if;
+
+   if (Incomplete1_Obj_2.Disc     /= M) or
+      (Incomplete1_Obj_2.MInteger /= 9) then
+         Report.Failed ("Wrong values for Incomplete1_Obj_2");
+   end if;
+
+   if (Incomplete2_Obj_2.Disc /= 5) or 
+      (Incomplete2_Obj_2.ID   /= "Buick") then
+         Report.Failed ("Wrong values for Incomplete2_Obj_2");
+   end if;
+
+   -- Make sure that assignments work without problems.
+
+   Incomplete1_Obj_1.FInteger := 1;
+
+   -- Avoid optimization (dead variable removal of FInteger):
+
+   if Incomplete1_Obj_1.FInteger /= Report.Ident_Int(1) 
+      then  
+         Report.Failed ("Wrong value stored in Incomplete1_Obj_1.FInteger");
+   end if;
+
+   Incomplete2_Obj_1.ID       := Return_String ("12345678");
+
+   -- Avoid optimization (dead variable removal of ID)
+
+   if Incomplete2_Obj_1.ID /= Return_String ("12345678")
+     then   
+        Report.Failed ("Wrong values for Incomplete8_Obj_1.ID");
+   end if;
+
+   Incomplete4_Obj_1.ID       := Return_String ("87654321");
+
+   -- Avoid optimization (dead variable removal of ID)
+
+   if Incomplete4_Obj_1.ID /= Return_String ("87654321")
+     then   
+        Report.Failed ("Wrong values for Incomplete4_Obj_1.ID");
+   end if;
+
+
+   Test1:
+   declare
+   
+      Incomplete8_Obj_1 :  Incomplete8 (10);
+
+   begin
+      Incomplete8_Obj_1.Str := "Merry Xmas";
+
+      -- Avoid optimization (dead variable removal of Str):
+
+      if Return_String (Incomplete8_Obj_1.Str) /= "Merry Xmas"
+        then   
+           Report.Failed ("Wrong values for Incomplete8_Obj_1.Str");
+      end if;
+
+   exception
+      when Constraint_Error =>
+          Report.Failed ("Constraint_Error raised in Incomplete8_Obj_1");
+
+   end Test1;
+
+   Test2:
+   declare
+
+      Incomplete8_Obj_2 :  Incomplete8 (5);
+
+   begin
+      Incomplete8_Obj_2.Str := "Happy";       
+
+      -- Avoid optimization (dead variable removal of Str):
+
+      if Return_String (Incomplete8_Obj_2.Str) /= "Happy"               
+        then   
+           Report.Failed ("Wrong values for Incomplete8_Obj_1.Str");
+      end if;
+
+   exception
+      when Constraint_Error =>
+          Report.Failed ("Constraint_Error raised in Incomplete8_Obj_2");
+
+   end Test2;
+
+   Report.Result;
+
+end C3A1001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1002.a
new file mode 100644
index 000000000..27d1f843c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a1002.a
@@ -0,0 +1,251 @@
+-- C3A1002.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 full type completing a type with no discriminant part
+--      or an unknown discriminant part may have explicitly declared or
+--      inherited discriminants.
+--      Check for cases where the types are tagged records and task types.
+--
+-- TEST DESCRIPTION:
+--      Declare two groups of incomplete types: one group with no discriminant 
+--      part and one group with unknown discriminant part.  Both groups of 
+--      incomplete types are completed with both explicit and inherited 
+--      discriminants.  Discriminants for task types are declared with both 
+--      default and non default values.  Discriminants for tagged types are 
+--      only declared without default values.  
+--      In the main program, verify that objects of both groups of incomplete 
+--      types can be created by default values or by assignments.
+--
+--
+-- CHANGE HISTORY:
+--      23 Oct 95   SAIC    Initial prerelease version.
+--      19 Oct 96   SAIC    ACVC 2.1: modified test description.  Initialized
+--                          Int_Val.
+--
+--!
+
+package C3A1002_0 is
+
+   subtype Small_Int is Integer range 1 .. 15;
+
+   type Enu_Type is (M, F);
+
+   type Tag_Type is tagged         
+     record                                          
+        I : Small_Int := 1;
+     end record;
+
+   type NTag_Type (D : Small_Int) is new Tag_Type with
+     record                                          
+        S : String (1 .. D) := "Aloha";  
+     end record;
+
+   type Incomplete1;                               -- no discriminant
+
+   type Incomplete2 (<>);                          -- unknown discriminant
+
+   type Incomplete3;                               -- no discriminant
+
+   type Incomplete4 (<>);                          -- unknown discriminant
+
+   type Incomplete5;                               -- no discriminant
+
+   type Incomplete6 (<>);                          -- unknown discriminant
+
+   type Incomplete1 (D1 : Enu_Type) is tagged      -- no discriminant/  
+     record                                        -- explicit discriminant
+        case D1 is
+           when M => MInteger : Small_Int := 9;
+           when F => FInteger : Small_Int := 8;
+        end case;
+     end record;
+
+   type Incomplete2 (D2 : Small_Int) is new       -- unknown discriminant/
+     Incomplete1 (D1 => F) with record            -- explicit discriminant
+        ID : String (1 .. D2) := "ACVC95";
+     end record;
+
+   type Incomplete3 is new                         -- no discriminant/
+     NTag_Type with record                         -- inherited discriminant
+        E : Enu_Type := M;
+     end record;
+
+   type Incomplete4 is new                         -- unknown discriminant/
+     NTag_Type (D => 3) with record                -- inherited discriminant
+        E : Enu_Type := F;
+     end record;
+
+   task type Incomplete5 (D5 : Enu_Type) is      -- no discriminant/
+      entry Read_Disc (P : out Enu_Type);        -- explicit discriminant
+   end Incomplete5;
+
+   task type Incomplete6 
+     (D6 : Small_Int := 4) is                    -- unknown discriminant/
+      entry Read_Int (P : out Small_Int);        -- explicit discriminant
+   end Incomplete6;
+
+end C3A1002_0;
+
+     --==================================================================--
+
+package body C3A1002_0 is
+
+   task body Incomplete5 is  
+   begin
+      select 
+         accept Read_Disc (P : out Enu_Type) do  
+            P := D5;
+         end Read_Disc;
+      or
+         terminate;
+      end select;
+
+   end Incomplete5;
+
+   ----------------------------------------------------------------------
+   task body Incomplete6 is 
+   begin
+      select 
+         accept Read_Int (P : out Small_Int) do  
+            P := D6;
+         end Read_Int;
+      or
+         terminate;
+      end select;
+
+   end Incomplete6;
+
+end C3A1002_0;
+
+     --==================================================================--
+
+with Report;
+
+with C3A1002_0;
+use  C3A1002_0;
+
+procedure C3A1002 is
+
+   Enum_Val : Enu_Type := M;
+
+   Int_Val  : Small_Int := 15;
+
+   -- Discriminant value comes from default.
+
+   Incomplete6_Obj_1  :  Incomplete6;
+
+   -- Discriminant value comes from explicit constraint.
+
+   Incomplete1_Obj_1  :  Incomplete1 (M);
+
+   Incomplete2_Obj_1  :  Incomplete2 (6);
+
+   Incomplete5_Obj_1  :  Incomplete5 (F);
+
+   Incomplete6_Obj_2  :  Incomplete6 (7);
+
+   -- Discriminant value comes from assignment.        
+
+   Incomplete1_Obj_2  :  Incomplete1
+                      := (F, 12);
+
+   Incomplete3_Obj_1  :  Incomplete3
+                      := (D => 2, S => "Hi", I => 10, E => F);
+
+   Incomplete4_Obj_1  :  Incomplete4
+                      := (E => M, D => 3, S => "Bye", I => 14);
+
+begin
+
+   Report.Test ("C3A1002", "Check that the full type completing a type " &
+                "with no discriminant part or an unknown discriminant "  &
+                "part may have explicitly declared or inherited "        &
+                "discriminants.  Check for cases where the types are "   &
+                "tagged records and task types");
+
+   -- Check the initial values.
+
+   if (Incomplete6_Obj_1.D6 /= 4) then 
+      Report.Failed ("Wrong initial value for Incomplete6_Obj_1");
+   end if;
+
+   -- Check the explicit values.
+
+   if (Incomplete1_Obj_1.D1       /= M) or 
+      (Incomplete1_Obj_1.MInteger /= 9) then
+        Report.Failed ("Wrong values for Incomplete1_Obj_1");
+   end if;
+
+   if (Incomplete2_Obj_1.D2       /= 6) or 
+      (Incomplete2_Obj_1.FInteger /= 8) or
+      (Incomplete2_Obj_1.ID       /= "ACVC95") then
+         Report.Failed ("Wrong values for Incomplete2_Obj_1");
+   end if;
+
+   if (Incomplete5_Obj_1.D5 /= F) then 
+      Report.Failed ("Wrong value for Incomplete5_Obj_1");
+   end if;
+
+   Incomplete5_Obj_1.Read_Disc (Enum_Val);
+
+   if (Enum_Val /= F) then 
+      Report.Failed ("Wrong value for Enum_Val");
+   end if;
+
+   if (Incomplete6_Obj_2.D6 /= 7) then 
+      Report.Failed ("Wrong value for Incomplete6_Obj_2");
+   end if;
+
+   Incomplete6_Obj_1.Read_Int (Int_Val);
+
+   if (Int_Val /= 4) then 
+      Report.Failed ("Wrong value for Int_Val");
+   end if;
+
+   -- Check the assigned values.
+
+   if (Incomplete1_Obj_2.D1       /= F)  or 
+      (Incomplete1_Obj_2.FInteger /= 12) then
+         Report.Failed ("Wrong values for Incomplete1_Obj_2");
+   end if;
+
+   if (Incomplete3_Obj_1.D /= 2 ) or 
+      (Incomplete3_Obj_1.I /= 10) or
+      (Incomplete3_Obj_1.E /= F ) or
+      (Incomplete3_Obj_1.S /= "Hi") then
+         Report.Failed ("Wrong values for Incomplete3_Obj_1");
+   end if;
+
+   if (Incomplete4_Obj_1.E /= M )      or 
+      (Incomplete4_Obj_1.D /= 3)       or
+      (Incomplete4_Obj_1.S /= "Bye")   or
+      (Incomplete4_Obj_1.I /= 14)      then
+         Report.Failed ("Wrong values for Incomplete4_Obj_1");
+   end if;
+
+   Report.Result;
+
+end C3A1002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2001.a
new file mode 100644
index 000000000..c3c7f4410
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2001.a
@@ -0,0 +1,460 @@
+-- C3A2001.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 an access type may be defined to designate the
+--      class-wide type of an abstract type.  Check that the access type
+--      may then be used subsequently with types derived from the abstract
+--      type.  Check that dispatching operations dispatch correctly, when
+--      called using values designated by objects of the access type.
+--
+-- TEST DESCRIPTION:
+--      This test declares an abstract type Breaker in a package, and
+--      then derives from it.  The type Basic_Breaker defines the least
+--      possible in order to not be abstract.  The type Ground_Fault is
+--      defined to inherit as much as possible, whereas type Special_Breaker
+--      overrides everything it can.  The type Special_Breaker also includes
+--      an embedded Basic_Breaker object.  The main program then utilizes
+--      each of the three types of breaker, and to ascertain that the
+--      overloading and tagging resolution are correct, each "Create"
+--      procedure is called with a unique value.  The diagram below
+--      illustrates the relationships.
+--
+--              Abstract type:           Breaker(1)
+--                                           |
+--                                    Basic_Breaker(2)
+--                                    /           \
+--                           Ground_Fault(3)    Special_Breaker(4)
+--
+--      Test structure is a polymorphic linked list, modeling a circuit
+--      as a list of components.  The type component is the access type
+--      defined to designate Breaker'Class values.  The test then creates
+--      some values, and traverses the list to determine correct operation.
+--      This test is instrumented with a the trace facility found in
+--      foundation F392C00 to simplify the verification process.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Nov 95   SAIC    Checked compilation for ACVC 2.0.1
+--      23 APR 96   SAIC    Added pragma Elaborate_All
+--      26 NOV 96   SAIC    Elaborate_Body changed to Elaborate_All
+--
+--!
+
+with Report;
+with TCTouch;
+package C3A2001_1 is
+
+  type Breaker is abstract tagged private;
+  type Status  is ( Power_Off, Power_On, Tripped, Failed );
+
+  procedure Flip ( The_Breaker : in out Breaker ) is abstract;
+  procedure Trip ( The_Breaker : in out Breaker ) is abstract;
+  procedure Reset( The_Breaker : in out Breaker ) is abstract;
+  procedure Fail ( The_Breaker : in out Breaker );
+
+  procedure Set ( The_Breaker : in out Breaker'Class; To_State : Status );
+
+  function  Status_Of( The_Breaker : Breaker ) return Status;
+
+private
+  type Breaker is abstract tagged record
+    State : Status := Power_Off;
+  end record;
+end C3A2001_1;
+
+----------------------------------------------------------------------------
+
+with TCTouch;
+package body C3A2001_1 is
+  procedure Fail( The_Breaker : in out Breaker ) is
+  begin
+    TCTouch.Touch( 'a' ); --------------------------------------------- a
+    The_Breaker.State := Failed;
+  end Fail;
+
+  procedure Set( The_Breaker : in out Breaker'Class; To_State : Status ) is
+  begin
+    The_Breaker.State := To_State;
+  end Set;
+
+  function  Status_Of( The_Breaker : Breaker ) return Status is
+  begin
+    TCTouch.Touch( 'b' ); --------------------------------------------- b
+    return The_Breaker.State;
+  end Status_Of;
+end C3A2001_1;
+
+----------------------------------------------------------------------------
+
+with C3A2001_1;
+package C3A2001_2 is
+
+  type Basic_Breaker is new C3A2001_1.Breaker with private;
+
+  type Voltages is ( V12, V110, V220, V440 );
+  type Amps     is ( A1, A5, A10, A25, A100 );
+
+  function Construct( Voltage : Voltages; Amperage : Amps )
+    return Basic_Breaker;
+
+  procedure Flip ( The_Breaker : in out Basic_Breaker );
+  procedure Trip ( The_Breaker : in out Basic_Breaker );
+  procedure Reset( The_Breaker : in out Basic_Breaker );
+private
+  type Basic_Breaker is new C3A2001_1.Breaker with record
+    Voltage_Level : Voltages := V110;
+    Amperage      : Amps;
+  end record;
+end C3A2001_2;
+
+----------------------------------------------------------------------------
+
+with TCTouch;
+package body C3A2001_2 is
+  function Construct( Voltage : Voltages; Amperage : Amps )
+    return Basic_Breaker is
+    It : Basic_Breaker;
+  begin
+    TCTouch.Touch( 'c' ); --------------------------------------------- c
+    It.Amperage := Amperage;
+    It.Voltage_Level := Voltage;
+    C3A2001_1.Set( It, C3A2001_1.Power_Off );
+    return It;
+  end Construct;
+
+  procedure Flip ( The_Breaker : in out Basic_Breaker ) is
+  begin
+    TCTouch.Touch( 'd' ); --------------------------------------------- d
+    case Status_Of( The_Breaker ) is
+      when C3A2001_1.Power_Off =>
+        C3A2001_1.Set( The_Breaker, C3A2001_1.Power_On );
+      when C3A2001_1.Power_On =>
+        C3A2001_1.Set( The_Breaker, C3A2001_1.Power_Off );
+      when C3A2001_1.Tripped | C3A2001_1.Failed  => null;
+    end case;
+  end Flip;
+
+  procedure Trip ( The_Breaker : in out Basic_Breaker ) is
+  begin
+    TCTouch.Touch( 'e' ); --------------------------------------------- e
+    C3A2001_1.Set( The_Breaker, C3A2001_1.Tripped );
+  end Trip;
+
+  procedure Reset( The_Breaker : in out Basic_Breaker ) is
+  begin
+    TCTouch.Touch( 'f' ); --------------------------------------------- f
+    case Status_Of( The_Breaker ) is
+      when C3A2001_1.Power_Off | C3A2001_1.Tripped =>
+        C3A2001_1.Set( The_Breaker, C3A2001_1.Power_On );
+      when C3A2001_1.Power_On  | C3A2001_1.Failed  => null;
+    end case;
+  end Reset;
+
+end C3A2001_2;
+
+----------------------------------------------------------------------------
+
+with C3A2001_1,C3A2001_2;
+package C3A2001_3 is
+  use type C3A2001_1.Status;
+
+  type Ground_Fault is new C3A2001_2.Basic_Breaker with private;
+
+  function Construct( Voltage  : C3A2001_2.Voltages;
+                      Amperage : C3A2001_2.Amps )
+    return Ground_Fault;
+
+  procedure Set_Trip( The_Breaker : in out Ground_Fault;
+                      Capacitance : in     Integer );
+
+private
+  type Ground_Fault is new C3A2001_2.Basic_Breaker with record
+    Capacitance : Integer;
+  end record;
+end C3A2001_3;
+
+----------------------------------------------------------------------------
+
+with TCTouch;
+package body C3A2001_3 is
+
+  function Construct( Voltage  : C3A2001_2.Voltages;
+                      Amperage : C3A2001_2.Amps )
+    return Ground_Fault is
+  begin
+    TCTouch.Touch( 'g' ); --------------------------------------------- g
+    return ( C3A2001_2.Construct( Voltage, Amperage )
+             with Capacitance => 0 );
+  end Construct;
+
+
+  procedure Set_Trip( The_Breaker : in out Ground_Fault;
+                      Capacitance : in     Integer ) is
+  begin
+    TCTouch.Touch( 'h' ); --------------------------------------------- h
+    The_Breaker.Capacitance := Capacitance;
+  end Set_Trip;
+
+end C3A2001_3;
+
+----------------------------------------------------------------------------
+
+with C3A2001_1, C3A2001_2;
+package C3A2001_4 is
+
+  type Special_Breaker is new C3A2001_2.Basic_Breaker with private;
+
+  function Construct( Voltage     : C3A2001_2.Voltages;
+                      Amperage    : C3A2001_2.Amps )
+    return Special_Breaker;
+
+  procedure Flip ( The_Breaker : in out Special_Breaker );
+  procedure Trip ( The_Breaker : in out Special_Breaker );
+  procedure Reset( The_Breaker : in out Special_Breaker );
+  procedure Fail ( The_Breaker : in out Special_Breaker );
+
+  function Status_Of( The_Breaker : Special_Breaker ) return C3A2001_1.Status;
+  function On_Backup( The_Breaker : Special_Breaker ) return Boolean;
+
+private
+  type Special_Breaker is new C3A2001_2.Basic_Breaker with record
+    Backup : C3A2001_2.Basic_Breaker;
+  end record;
+end C3A2001_4;
+
+----------------------------------------------------------------------------
+
+with TCTouch;
+package body C3A2001_4 is
+
+  function Construct( Voltage     : C3A2001_2.Voltages;
+                      Amperage    : C3A2001_2.Amps )
+    return Special_Breaker is
+    It: Special_Breaker;
+    procedure Set_Root( It: in out C3A2001_2.Basic_Breaker ) is
+    begin
+      It := C3A2001_2.Construct( Voltage, Amperage );
+    end Set_Root;
+  begin
+    TCTouch.Touch( 'i' ); --------------------------------------------- i
+    Set_Root( C3A2001_2.Basic_Breaker( It ) );
+    Set_Root( It.Backup );
+    return It;
+  end Construct;
+
+  function Status_Of( It: C3A2001_1.Breaker ) return C3A2001_1.Status
+    renames C3A2001_1.Status_Of;
+
+  procedure Flip ( The_Breaker : in out Special_Breaker ) is
+  begin
+    TCTouch.Touch( 'j' ); --------------------------------------------- j
+    case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
+      when C3A2001_1.Power_Off | C3A2001_1.Power_On =>
+        C3A2001_2.Flip( C3A2001_2.Basic_Breaker( The_Breaker ) );
+      when others =>
+        C3A2001_2.Flip( The_Breaker.Backup );
+    end case;
+  end Flip;
+
+  procedure Trip ( The_Breaker : in out Special_Breaker ) is
+  begin
+    TCTouch.Touch( 'k' ); --------------------------------------------- k
+    case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
+      when C3A2001_1.Power_Off => null;
+      when C3A2001_1.Power_On  =>
+        C3A2001_2.Reset( The_Breaker.Backup );
+        C3A2001_2.Trip( C3A2001_2.Basic_Breaker( The_Breaker ) );
+      when others =>
+        C3A2001_2.Trip( The_Breaker.Backup );
+    end case;
+  end Trip;
+
+  procedure Reset( The_Breaker : in out Special_Breaker ) is
+  begin
+    TCTouch.Touch( 'l' ); --------------------------------------------- l
+    case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
+      when C3A2001_1.Tripped  =>
+        C3A2001_2.Reset( C3A2001_2.Basic_Breaker( The_Breaker ));
+      when C3A2001_1.Failed  =>
+        C3A2001_2.Reset( The_Breaker.Backup );
+      when C3A2001_1.Power_On | C3A2001_1.Power_Off =>
+        null;
+    end case;
+  end Reset;
+
+  procedure Fail ( The_Breaker : in out Special_Breaker ) is
+  begin
+    TCTouch.Touch( 'm' ); --------------------------------------------- m
+    case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
+      when C3A2001_1.Failed  =>
+        C3A2001_2.Fail( The_Breaker.Backup );
+      when others => 
+        C3A2001_2.Fail( C3A2001_2.Basic_Breaker( The_Breaker ));
+        C3A2001_2.Reset( The_Breaker.Backup );
+    end case;
+  end Fail;
+
+  function Status_Of( The_Breaker : Special_Breaker )
+    return C3A2001_1.Status is
+  begin
+    TCTouch.Touch( 'n' ); --------------------------------------------- n
+    case Status_Of( C3A2001_1.Breaker( The_Breaker )) is
+      when C3A2001_1.Power_On  => return C3A2001_1.Power_On;
+      when C3A2001_1.Power_Off => return C3A2001_1.Power_Off;
+      when others =>
+        return C3A2001_2.Status_Of( The_Breaker.Backup );
+    end case;
+  end Status_Of;
+
+  function On_Backup( The_Breaker : Special_Breaker ) return Boolean is
+    use C3A2001_2;
+    use type C3A2001_1.Status;
+  begin
+    return Status_Of(Basic_Breaker(The_Breaker)) = C3A2001_1.Tripped
+        or Status_Of(Basic_Breaker(The_Breaker)) = C3A2001_1.Failed;
+  end On_Backup;
+
+end C3A2001_4;
+
+----------------------------------------------------------------------------
+
+with C3A2001_1;
+package C3A2001_5 is
+
+  type Component is access C3A2001_1.Breaker'Class;
+
+  type Circuit;
+  type Connection is access Circuit;
+
+  type Circuit is record
+    The_Gadget : Component;
+    Next : Connection;
+  end record;
+
+  procedure Flipper( The_Circuit : Connection );
+  procedure Tripper( The_Circuit : Connection );
+  procedure Restore( The_Circuit : Connection );
+  procedure Failure( The_Circuit : Connection );
+
+  Short : Connection := null;
+
+end C3A2001_5;
+
+----------------------------------------------------------------------------
+with Report;
+with TCTouch;
+with C3A2001_1, C3A2001_2, C3A2001_3, C3A2001_4;
+
+pragma Elaborate_All( Report, TCTouch,
+                      C3A2001_1, C3A2001_2, C3A2001_3, C3A2001_4 );
+
+package body C3A2001_5 is
+
+  function Neww( Breaker: in C3A2001_1.Breaker'Class )
+    return Component is
+  begin
+    return new C3A2001_1.Breaker'Class'( Breaker );
+  end Neww;
+
+  procedure Add( Gadget     : in     Component;
+                 To_Circuit : in out Connection) is
+  begin
+    To_Circuit := new Circuit'(Gadget,To_Circuit);
+  end Add;
+
+  procedure Flipper( The_Circuit : Connection ) is
+    Probe : Connection := The_Circuit;
+  begin
+    while Probe /= null loop
+      C3A2001_1.Flip( Probe.The_Gadget.all );
+      Probe := Probe.Next;
+    end loop;
+  end Flipper;
+
+  procedure Tripper( The_Circuit : Connection ) is
+    Probe : Connection := The_Circuit;
+  begin
+    while Probe /= null loop
+      C3A2001_1.Trip( Probe.The_Gadget.all );
+      Probe := Probe.Next;
+    end loop;
+  end Tripper;
+
+  procedure Restore( The_Circuit : Connection ) is
+    Probe : Connection := The_Circuit;
+  begin
+    while Probe /= null loop
+      C3A2001_1.Reset( Probe.The_Gadget.all );
+      Probe := Probe.Next;
+    end loop;
+  end Restore;
+
+  procedure Failure( The_Circuit : Connection ) is
+    Probe : Connection := The_Circuit;
+  begin
+    while Probe /= null loop
+      C3A2001_1.Fail( Probe.The_Gadget.all );
+      Probe := Probe.Next;
+    end loop;
+  end Failure;
+
+begin
+  Add( Neww( C3A2001_2.Construct( C3A2001_2.V440, C3A2001_2.A5   )), Short );
+  Add( Neww( C3A2001_3.Construct( C3A2001_2.V110, C3A2001_2.A1   )), Short );
+  Add( Neww( C3A2001_4.Construct( C3A2001_2.V12,  C3A2001_2.A100 )), Short );
+end C3A2001_5;
+
+----------------------------------------------------------------------------
+
+with Report;
+with TCTouch;
+with C3A2001_5;
+procedure C3A2001 is
+
+begin  -- Main test procedure.
+
+  Report.Test ("C3A2001", "Check that an abstract type can be declared " &
+               "and used.  Check actual subprograms dispatch correctly" );
+
+  -- This Validate call must be _after_ the call to Report.Test
+  TCTouch.Validate( "cgcicc", "Adding" );
+
+  C3A2001_5.Flipper( C3A2001_5.Short );
+  TCTouch.Validate( "jbdbdbdb", "Flipping" );
+
+  C3A2001_5.Tripper( C3A2001_5.Short );
+  TCTouch.Validate( "kbfbeee", "Tripping" );
+
+  C3A2001_5.Restore( C3A2001_5.Short );
+  TCTouch.Validate( "lbfbfbfb", "Restoring" );
+
+  C3A2001_5.Failure( C3A2001_5.Short );
+  TCTouch.Validate( "mbafbaa", "Circuits Failing" );
+
+  Report.Result;
+
+end C3A2001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2002.a
new file mode 100644
index 000000000..63ea7008b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2002.a
@@ -0,0 +1,295 @@
+-- C3A2002.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, for X'Access of a general access type A, Program_Error is
+--      raised if the accessibility level of X is deeper than that of A.
+--      Check for the case where X denotes a view that is a dereference of an
+--      access parameter, or a rename thereof.
+--      
+--      Check for cases where the actual corresponding to X is:
+--         (a) An allocator.
+--         (b) An expression of a named access type.
+--         (c) Obj'Access.
+--      
+-- TEST DESCRIPTION:
+--      In order to satisfy accessibility requirements, the designated
+--      object X must be at the same or a less deep nesting level than the
+--      general access type A -- X must "live" as long as A. Nesting
+--      levels are the run-time nestings of masters: block statements;
+--      subprogram, task, and entry bodies; and accept statements. Packages
+--      are invisible to accessibility rules.
+--
+--      This test declares subprograms with access parameters, within which
+--      'Access is attempted on a dereference of the access parameter, and
+--      assigned to an access object whose type A is declared at some nesting
+--      level. The test verifies that Program_Error is raised if the actual
+--      corresponding to the access parameter is:
+--
+--         (1) an allocator, and the accessibility level of the execution
+--             of the called subprogram is deeper than that of the access
+--             type A. 
+--
+--         (2) an expression of a named access type, and the accessibility
+--             level of the named access type is deeper than that of the
+--             access type A. 
+--
+--         (3) a reference to the Access attribute (e.g., X'Access), and
+--             the accessibility level of X is deeper than that of the
+--             access type A. 
+--
+--      Note that the static nesting level of the actual corresponding to the
+--      access parameter can be deeper than that of the type A -- it is
+--      the run-time nesting that matters for accessibility rules. Consider
+--      the case where the access type A is declared within the called
+--      subprogram. The accessibility check will never fail, even if the
+--      actual happens to have a deeper static nesting level:
+--
+--         procedure P (X: access T) is
+--            type A is access all T;   -- Static level = 2, e.g.
+--            Acc : A := X.all'Access;  -- Check should never fail.
+--         begin null; end;
+--         . . .
+--         declare
+--            Actual : aliased T;       -- Static level = 3, e.g.
+--         begin
+--            P (Actual'Access);
+--         end;
+--
+--         For the execution of P, the accessibility level of type A will
+--         always be deeper than that of Actual, so there is no danger of a
+--         dangling reference arising from the assignment to Acc. Thus,
+--         X.all'Access is safe, even though the static nesting level of
+--         Actual is deeper than that of A.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C3A2002_0 is
+
+   type Desig is array (1 .. 10) of Integer;
+
+   X0 : aliased Desig;                                            -- Level = 0.
+
+   type Acc_L0 is access all Desig;                               -- Level = 0.
+   A0 : Acc_L0;
+
+   type Result_Kind is (OK, P_E, O_E);
+
+   procedure A_Is_Level_0 (X: access Desig; R : out Result_Kind);
+   procedure Never_Fails  (X: access Desig; R : out Result_Kind);
+
+end C3A2002_0;
+
+
+     --==================================================================--
+
+package body C3A2002_0 is
+
+   procedure A_Is_Level_0 (X : access Desig;
+                           R : out Result_Kind) is
+   begin
+      -- The accessibility level of the type of A0 is 0.
+      A0 := X.all'Access;
+      R  := OK;
+   exception
+      when Program_Error =>    
+         R := P_E;
+      when others        =>    
+         R := O_E;
+   end A_Is_Level_0;
+
+   -----------------------------------------------
+   procedure Never_Fails (X: access Desig;
+                          R : out Result_Kind) is
+      type Acc_Local is access all Desig;
+      AL : Acc_Local;
+   begin
+      -- X.all'Access below will always be safe, since the accessibility
+      -- level (although not necessarily the static nesting depth) of the
+      -- type of AL will always be deeper than or the same as that of the 
+      -- actual corresponding to Y. 
+      AL := X.all'Access;
+      R  := OK;
+   exception
+      when Program_Error =>    
+         R := P_E;
+      when others        =>    
+         R := O_E;
+   end Never_Fails;
+
+end C3A2002_0;
+
+
+     --==================================================================--
+
+
+with C3A2002_0;
+with Report;
+
+procedure C3A2002 is
+
+   X1 : aliased C3A2002_0.Desig;                                  -- Level = 1.
+
+   type Acc_L1 is access all C3A2002_0.Desig;                     -- Level = 1.
+   A1 : Acc_L1;
+
+   Expr_L0 : C3A2002_0.Acc_L0 := C3A2002_0.X0'Access;
+   Expr_L1 : Acc_L1           := X1'Access;
+
+   Res : C3A2002_0.Result_Kind;
+
+   use type C3A2002_0.Result_Kind;
+
+   -----------------------------------------------
+   procedure A_Is_Level_1 (X : access C3A2002_0.Desig;
+                           R : out C3A2002_0.Result_Kind) is
+      -- Dereference of an access_to_object value is aliased.
+      Ren : C3A2002_0.Desig renames X.all;      -- Renaming of a dereference
+   begin                                        -- of an access parameter.
+      -- The accessibility level of the type of A1 is 1.
+      A1 := Ren'Access;
+      R  := C3A2002_0.OK;
+   exception
+      when Program_Error =>    
+         R := C3A2002_0.P_E;
+      when others        =>    
+         R := C3A2002_0.O_E;
+   end A_Is_Level_1;
+
+   -----------------------------------------------
+   procedure Display_Results (Result  : in C3A2002_0.Result_Kind;
+                              Expected: in C3A2002_0.Result_Kind;
+                              Message : in String) is
+   begin
+      if Result /= Expected then
+         case Result is
+            when C3A2002_0.OK  => Report.Failed ("No exception raised: "  & 
+                                                 Message);
+            when C3A2002_0.P_E => Report.Failed ("Program_Error raised: " & 
+                                                 Message);
+            when C3A2002_0.O_E => Report.Failed ("Unexpected exception "  &
+                                                 "raised: " & Message);
+         end case;
+      end if;
+   end Display_Results;
+
+begin -- C3A2002 
+
+   Report.Test ("C3A2002", "Check that, for X'Access of general access "   &
+                "type A, Program_Error is raised if the accessibility "    &
+                "level of X is deeper than that of A: X is an access "     &
+                "parameter; corresponding actual is an allocator, "        &
+                "expression of a named access type, Obj'Access, or a "     &
+                "rename thereof");
+
+
+   -- Actual is X'Access:
+
+   C3A2002_0.Never_Fails (C3A2002_0.X0'Access, Res);
+   Display_Results (Res, C3A2002_0.OK, "X0'Access, local access type");
+
+   C3A2002_0.A_Is_Level_0 (C3A2002_0.X0'Access, Res);
+   Display_Results (Res, C3A2002_0.OK, "X0'Access, level 0 access type");
+
+   C3A2002_0.A_Is_Level_0 (X1'Access, Res);
+   Display_Results (Res, C3A2002_0.P_E, "X1'Access, level 0 access type");
+
+   A_Is_Level_1 (X1'Access, Res);
+   Display_Results (Res, C3A2002_0.OK, "X1'Access, level 1 access type");
+
+
+   -- Actual is expression of a named access type:
+
+   C3A2002_0.Never_Fails (Expr_L1, Res);
+   Display_Results (Res, C3A2002_0.OK, "Expr_L1, local access type");
+
+   C3A2002_0.A_Is_Level_0 (Expr_L1, Res);
+   Display_Results (Res, C3A2002_0.P_E, "Expr_L1, level 0 access type");
+
+   A_Is_Level_1 (Expr_L0, Res);
+   Display_Results (Res, C3A2002_0.OK, "Expr_L0, level 1 access type");
+
+   A_Is_Level_1 (Expr_L1, Res);
+   Display_Results (Res, C3A2002_0.OK, "Expr_L1, level 1 access type");
+
+   -- Actual is allocator (level of execution = 2):
+
+   C3A2002_0.Never_Fails (new C3A2002_0.Desig, Res);
+   Display_Results (Res, C3A2002_0.OK, "Allocator level 2, " &
+                                       "local access type");
+
+   -- Since actual is an allocator, its accessibility level is that of
+   -- the execution of the called subprogram, i.e., level 2.
+
+   C3A2002_0.A_Is_Level_0 (new C3A2002_0.Desig, Res);
+   Display_Results (Res, C3A2002_0.P_E, "Allocator level 2, " &
+                                        "level 0 access type");
+
+   A_Is_Level_1 (new C3A2002_0.Desig, Res);
+   Display_Results (Res, C3A2002_0.P_E, "Allocator level 2, " &
+                                        "level 1 access type");
+
+
+   Block_L2:
+   declare
+      X2 : aliased C3A2002_0.Desig;                               -- Level = 2.
+      type Acc_L2 is access all C3A2002_0.Desig;                  -- Level = 2.
+      Expr_L2 : Acc_L2 := X1'Access;
+   begin
+
+      -- Actual is X'Access:
+
+      C3A2002_0.Never_Fails (X2'Access, Res);
+      Display_Results (Res, C3A2002_0.OK, "X2'Access, local access type");
+
+      C3A2002_0.A_Is_Level_0 (X2'Access, Res);
+      Display_Results (Res, C3A2002_0.P_E, "X2'Access, level 0 access type");
+
+
+      -- Actual is expression of a named access type:
+
+      A_Is_Level_1 (Expr_L2, Res);
+      Display_Results (Res, C3A2002_0.P_E, "Expr_L2, level 1 access type");
+
+
+      -- Actual is allocator (level of execution = 3):
+
+      C3A2002_0.Never_Fails (new C3A2002_0.Desig, Res);
+      Display_Results (Res, C3A2002_0.OK, "Allocator level 3, " &
+                                          "local access type");
+
+      A_Is_Level_1 (new C3A2002_0.Desig, Res);
+      Display_Results (Res, C3A2002_0.P_E, "Allocator level 3, " &
+                                           "level 1 access type");
+
+   end Block_L2;
+
+   Report.Result;
+
+end C3A2002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2003.a
new file mode 100644
index 000000000..deb92f1a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2003.a
@@ -0,0 +1,329 @@
+-- C3A2003.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, for X'Access of a general access type A, Program_Error is
+--      raised if the accessibility level of X is deeper than that of A.
+--      Check for the case where X denotes a view that is a dereference of an
+--      access parameter, or a rename thereof. Check for the case where X is
+--      an access parameter and the corresponding actual is another access
+--      parameter.
+--
+-- TEST DESCRIPTION:
+--      In order to satisfy accessibility requirements, the designated
+--      object X must be at the same or a less deep nesting level than the
+--      general access type A -- X must "live" as long as A. Nesting
+--      levels are the run-time nestings of masters: block statements;
+--      subprogram, task, and entry bodies; and accept statements. Packages
+--      are invisible to accessibility rules.
+--
+--      This test declares subprograms with access parameters, within which
+--      'Access is attempted on a dereference of an access parameter, and
+--      assigned to an access object whose type A is declared at some nesting
+--      level. The test verifies that Program_Error is raised if the actual
+--      corresponding to the access parameter is another access parameter,
+--      and the actual corresponding to this second access parameter is:
+--
+--         (1) an expression of a named access type, and the accessibility
+--             level of the named access type is deeper than that of the
+--             access type A.
+--
+--         (2) a reference to the Access attribute (e.g., X'Access), and
+--             the accessibility level of X is deeper than that of the
+--             access type A.
+--
+--      Note that the static nesting level of the actual corresponding to the
+--      access parameter can be deeper than that of the type A -- it is
+--      the run-time nesting that matters for accessibility rules. Consider
+--      the case where the access type A is declared within the called
+--      subprogram. The accessibility check will never fail, even if the
+--      actual happens to have a deeper static nesting level:
+--
+--         procedure P (X: access T) is
+--            type A is access all T;   -- Static level = 2, e.g.
+--            Acc : A := X.all'Access;  -- Check should never fail.
+--         begin null; end;
+--         . . .
+--         procedure Q (Y: access T) is
+--         begin
+--            P(Y);
+--         end;
+--         . . .
+--         declare
+--            Actual : aliased T;       -- Static level = 3, e.g.
+--         begin
+--            Q (Actual'Access);
+--         end;
+--
+--         For the execution of Q (and hence P), the accessibility level of
+--         type A will always be deeper than that of Actual, so there is no
+--         danger of a dangling reference arising from the assignment to
+--         Acc. Thus, X.all'Access is safe, even though the static nesting
+--         level of Actual is deeper than that of A.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC   ACVC 2.0
+--      15 Jul 98   EDS    Avoid optimization.
+--      28 Jun 02   RLB    Added pragma Elaborate_All (Report);.
+--!
+
+with report; use report; pragma Elaborate_All (report);
+package C3A2003_0 is
+
+   type Desig is array (1 .. 10) of Integer;
+
+   X0 : aliased Desig := (Desig'Range => Ident_Int(3));           -- Level = 0.
+
+   type Acc_L0 is access all Desig;                               -- Level = 0.
+   A0 : Acc_L0;
+
+   type Result_Kind is (OK, P_E, O_E);
+
+   procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind);
+   procedure Never_Fails_Nest       (Y: access Desig; S: out Result_Kind);
+   procedure Never_Fails_Same       (Y: access Desig; S: out Result_Kind);
+
+end C3A2003_0;
+
+
+     --==================================================================--
+
+
+package body C3A2003_0 is
+
+   procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind) is
+
+
+      -- This procedure utilizes 'Access on a dereference of an access
+      -- parameter, and assigned to an access object whose type A is
+      -- declared at some nesting level.  Program_Error is raised if
+      -- the accessibility level of the operand type is deeper than that
+      -- of the target type.
+
+      procedure Nested (X: access Desig; R: out Result_Kind) is
+         -- Dereference of an access_to_object value is aliased.
+         Ren : Desig renames X.all;                -- Renaming of a dereference
+      begin                                        -- of an access parameter.
+         -- The accessibility level of type A0 is 0.
+         A0 := Ren'Access;
+         R  := OK;
+      exception
+         when Program_Error =>
+            R := P_E;
+         when others        =>
+            R := O_E;
+      end Nested;
+
+   begin   -- Target_Is_Level_0_Nest
+      Nested (Y, S);
+   end Target_Is_Level_0_Nest;
+
+   ------------------------------------------------------------------
+
+   procedure Never_Fails_Nest (Y: access Desig; S: out Result_Kind) is
+
+      type Acc_Deeper is access all Desig;
+      AD : Acc_Deeper;
+
+      function Nested (X: access Desig) return Result_Kind is
+      begin
+         -- X.all'Access below will always be safe, since the accessibility
+         -- level (although not necessarily the static nesting depth) of the
+         -- type of AD will always be deeper than or the same as that of the
+         -- actual corresponding to Y.
+         AD := X.all'Access;
+         if Ident_Int (AD(4)) /= 3 then            --Avoid Optimization of AD
+           FAILED ("Initial Values not correct.");
+         end if;
+         return OK;
+      exception
+         when Program_Error =>
+            return P_E;
+         when others        =>
+            return O_E;
+      end Nested;
+
+   begin  -- Never_Fails_Nest
+      S := Nested (Y);
+   end Never_Fails_Nest;
+
+   ------------------------------------------------------------------
+
+   procedure Called_By_Never_Fails_Same
+     (X: access Desig; R: out Result_Kind) is
+      type Acc_Local is access all Desig;
+      AL : Acc_Local;
+
+      -- Dereference of an access_to_object value is aliased.
+      Ren : Desig renames X.all;                   -- Renaming of a dereference
+   begin                                           -- of an access parameter.
+      -- Ren'Access below will always be safe, since the accessibility
+      -- level (although not necessarily the static nesting depth) of
+      -- type of AL will always be deeper than or the same as that of the
+      -- actual corresponding to Y.
+      AL := Ren'Access;
+      if Ident_Int (AL(4)) /= 3 then       --Avoid Optimization of AL
+        FAILED ("Initial Values not correct.");
+      end if;
+      R  := OK;
+   exception
+      when Program_Error =>
+         R := P_E;
+      when others        =>
+         R := O_E;
+   end Called_By_Never_Fails_Same;
+
+   ------------------------------------------------------------------
+
+   procedure Never_Fails_Same (Y: access Desig; S: out Result_Kind) is
+   begin
+      Called_By_Never_Fails_Same (Y, S);
+   end Never_Fails_Same;
+
+end C3A2003_0;
+
+
+     --==================================================================--
+
+
+with C3A2003_0;
+use  C3A2003_0;
+
+with Report; use report;
+
+procedure C3A2003 is
+
+   type Acc_L1 is access all Desig;                               -- Level = 1.
+   A1  : Acc_L1;
+   X1 : aliased Desig := (Desig'Range => Ident_Int(3));
+   Res : Result_Kind;
+
+
+   procedure Called_By_Target_L1 (X: access Desig; R: out Result_Kind) is
+   begin
+      -- The accessibility level of the type of A1 is 1.
+      A1 := X.all'Access;
+      if IDENT_INT (A1(4)) /= 3 then       --Avoid optimization of A1
+        FAILED ("Initial values not correct.");
+      end if;
+      R  := OK;
+   exception
+      when Program_Error =>
+         R := P_E;
+      when others        =>
+         R := O_E;
+   end Called_By_Target_L1;
+
+   ------------------------------------------------------------------
+
+   function Target_Is_Level_1_Same (Y: access Desig) return Result_Kind is
+      S : Result_Kind;
+   begin
+      Called_By_Target_L1 (Y, S);
+      return S;
+   end Target_Is_Level_1_Same;
+
+   ------------------------------------------------------------------
+
+   procedure Display_Results (Result  : in Result_Kind;
+                              Expected: in Result_Kind;
+                              Msg     : in String) is
+   begin
+      if Result /= Expected then
+         case Result is
+            when OK  => Report.Failed ("No exception raised: "         & Msg);
+            when P_E => Report.Failed ("Program_Error raised: "        & Msg);
+            when O_E => Report.Failed ("Unexpected exception raised: " & Msg);
+         end case;
+      end if;
+   end Display_Results;
+
+begin -- C3A2003
+
+   Report.Test ("C3A2003", "Check that, for X'Access of general access "   &
+                "type A, Program_Error is raised if the accessibility "    &
+                "level of X is deeper than that of A: X is an access "     &
+                "parameter; corresponding actual is another access "       &
+                "parameter");
+
+
+   -- Accessibility level of actual is 0 (actual is X'Access):
+
+   Never_Fails_Same (X0'Access, Res);
+   Display_Results (Res, OK, "Never_Fails_Same, level 0 actual");
+
+   Never_Fails_Nest (X0'Access, Res);
+   Display_Results (Res, OK, "Target_L1_Nest, level 0 actual");
+
+   Target_Is_Level_0_Nest (X0'Access, Res);
+   Display_Results (Res, OK, "Target_L0_Nest, level 0 actual");
+
+   Res := Target_Is_Level_1_Same (X0'Access);
+   Display_Results (Res, OK, "Target_L1_Same, level 0 actual");
+
+
+   -- Accessibility level of actual is 1 (actual is X'Access):
+
+   Never_Fails_Same (X1'Access, Res);
+   Display_Results (Res, OK, "Never_Fails_Same, level 1 actual");
+
+   Never_Fails_Nest (X1'Access, Res);
+   Display_Results (Res, OK, "Target_L1_Nest, level 1 actual");
+
+   Target_Is_Level_0_Nest (X1'Access, Res);
+   Display_Results (Res, P_E, "Target_L0_Nest, level 1 actual");
+
+   Res := Target_Is_Level_1_Same (X1'Access);
+   Display_Results (Res, OK, "Target_L1_Same, level 1 actual");
+
+
+   Block_L2:
+   declare
+      X2 : aliased Desig := (Desig'Range => Ident_Int(3));
+      type Acc_L2 is access all Desig;                            -- Level = 2.
+      Expr_L2 : Acc_L2 := X2'Access;
+   begin
+
+      -- Accessibility level of actual is 2 (actual is expression of named
+      -- access type):
+
+      Never_Fails_Same (Expr_L2, Res);
+      Display_Results (Res, OK, "Never_Fails_Same, level 2 actual");
+
+      Never_Fails_Nest (Expr_L2, Res);
+      Display_Results (Res, OK, "Target_L1_Nest, level 2 actual");
+
+      Target_Is_Level_0_Nest (Expr_L2, Res);
+      Display_Results (Res, P_E, "Target_L0_Nest, level 2 actual");
+
+      Res := Target_Is_Level_1_Same (Expr_L2);
+      Display_Results (Res, P_E, "Target_L1_Same, level 2 actual");
+
+   end Block_L2;
+
+   Report.Result;
+
+end C3A2003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2a01.a
new file mode 100644
index 000000000..8271d4869
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2a01.a
@@ -0,0 +1,367 @@
+-- C3A2A01.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, for X'Access of a general access type A, Program_Error is
+--      raised if the accessibility level of X is deeper than that of A.
+--      Check for cases where X'Access occurs in an instance body, and A
+--      is passed as an actual during instantiation.
+--
+-- TEST DESCRIPTION:
+--      In order to satisfy accessibility requirements, the designated
+--      object X must be at the same or a less deep nesting level than the
+--      general access type A -- X must "live" as long as A. Nesting
+--      levels are the run-time nestings of masters: block statements;
+--      subprogram, task, and entry bodies; and accept statements. Packages
+--      are invisible to accessibility rules.
+--
+--      This test declares three generic units, each of which has a formal
+--      general access type:
+--
+--         (1) A generic package, in which X is declared in the specification,
+--             and X'Access occurs within the declarative part of the body.
+--
+--         (2) A generic package, in which X is a formal in out object of a
+--             tagged formal derived type, and X'Access occurs in the sequence
+--             of statements of a nested subprogram.
+--
+--         (3) A generic procedure, in which X is a dereference of an access
+--             parameter, and X'Access occurs in the sequence of statements.
+--
+--      The test verifies the following:
+--
+--         For (1), Program_Error is raised upon instantiation if the generic
+--         package is instantiated at a deeper level than that of the general
+--         access type passed as an actual. The exception is propagated to the
+--         innermost enclosing master.
+--
+--         For (2), Program_Error is raised when the nested subprogram is
+--         called if the object passed as an actual during instantiation of
+--         the generic package has an accessibility level deeper than that of
+--         the general access type passed as an actual. The exception is
+--         handled within the nested subprogram. Also, check that
+--         Program_Error is not raised if the level of the actual access type
+--         is deeper than that of the actual object.
+--
+--         For (3), Program_Error is raised when the instance subprogram is
+--         called if the object pointed to by the actual corresponding to
+--         the access parameter has an accessibility level deeper than that of
+--         the general access type passed as an actual during instantiation.
+--         The exception is handled within the instance subprogram. Also,
+--         check that Program_Error is not raised if the level of the actual
+--         access type is deeper than that of the actual corresponding to the
+--         access parameter.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F3A2A00.A
+--      -> C3A2A01.A
+--
+--
+-- CHANGE HISTORY:
+--      12 May 95   SAIC    Initial prerelease version.
+--      10 Jul 95   SAIC    Modified code to avoid dead variable optimization.
+--
+--!
+
+with F3A2A00;
+generic
+   type FD  is new F3A2A00.Array_Type;
+   type FAF is access all FD;
+package C3A2A01_0 is
+   X : aliased FD;
+
+   procedure Dummy;  -- Needed to allow package body.
+end C3A2A01_0;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C3A2A01_0 is
+   Ptr   : FAF     := X'Access;
+   Index : Integer := F3A2A00.Array_Type'First;
+
+   procedure Dummy is
+   begin
+      null;
+   end Dummy;
+begin
+   -- Avoid optimization (dead variable removal of Ptr):
+
+   if not Report.Equal (Ptr(Index).C, Ptr(Index).C) then   -- Always false.
+      Report.Failed ("Unexpected error in C3A2A01_0 instance");
+   end if;
+end C3A2A01_0;
+
+
+     --==================================================================--
+
+
+with F3A2A00;
+generic
+   type FD  is new F3A2A00.Tagged_Type with private;
+   type FAF is access all FD;
+   FObj : in out FD;
+package C3A2A01_1 is
+   procedure Handle (R: out F3A2A00.TC_Result_Kind);
+end C3A2A01_1;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C3A2A01_1 is
+
+   procedure Handle (R: out F3A2A00.TC_Result_Kind) is
+      Ptr : FAF;
+   begin
+      Ptr := FObj'Access;
+      R   := F3A2A00.OK;
+
+      -- Avoid optimization (dead variable removal of Ptr):
+
+      if not Report.Equal (Ptr.C, Ptr.C) then              -- Always false.
+         Report.Failed ("Unexpected error in Handle");
+      end if;
+   exception
+      when Program_Error => R := F3A2A00.P_E;
+      when others        => R := F3A2A00.O_E;
+   end Handle;
+
+end C3A2A01_1;
+
+
+     --==================================================================--
+
+
+with F3A2A00;
+generic
+   type FD  is new F3A2A00.Array_Type;
+   type FAF is access all FD;
+procedure C3A2A01_2 (P: access FD; R: out F3A2A00.TC_Result_Kind);
+
+
+     --==================================================================--
+
+
+with Report;
+procedure C3A2A01_2 (P: access FD; R: out F3A2A00.TC_Result_Kind) is
+   Ptr   : FAF;
+   Index : Integer := F3A2A00.Array_Type'First;
+begin
+   Ptr := P.all'Access;
+   R   := F3A2A00.OK;
+
+   -- Avoid optimization (dead variable removal of Ptr):
+
+   if not Report.Equal (Ptr(Index).C, Ptr(Index).C) then   -- Always false.
+      Report.Failed ("Unexpected error in C3A2A01_2 instance");
+   end if;
+exception
+   when Program_Error => R := F3A2A00.P_E;
+   when others        => R := F3A2A00.O_E;
+end C3A2A01_2;
+
+
+     --==================================================================--
+
+
+with F3A2A00;
+with C3A2A01_0;
+with C3A2A01_1;
+with C3A2A01_2;
+
+with Report;
+procedure C3A2A01 is
+begin -- C3A2A01.                                              -- [ Level = 1 ]
+
+   Report.Test ("C3A2A01", "Run-time accessibility checks: instance " &
+                "bodies. Type of X'Access is passed as actual to instance");
+
+
+   SUBTEST1:
+   declare                                                     -- [ Level = 2 ]
+      Result : F3A2A00.TC_Result_Kind;
+   begin -- SUBTEST1.
+
+      declare                                                  -- [ Level = 3 ]
+         type AccArr_L3 is access all F3A2A00.Array_Type;
+      begin
+         declare                                               -- [ Level = 4 ]
+            -- The accessibility level of Pack.X is that of the instantiation
+            -- (4). The accessibility level of the actual access type used to
+            -- instantiate Pack is 3. Therefore, the X'Access in Pack
+            -- propagates Program_Error when the instance body is elaborated:
+
+            package Pack is new C3A2A01_0 (F3A2A00.Array_Type, AccArr_L3);
+         begin
+            Result := F3A2A00.OK;
+         end;
+      exception
+         when Program_Error => Result := F3A2A00.P_E;       -- Expected result.
+         when others        => Result := F3A2A00.O_E;
+      end;
+
+      F3A2A00.TC_Display_Results (Result, F3A2A00.P_E, "SUBTEST #1");
+
+   end SUBTEST1;
+
+
+
+   SUBTEST2:
+   declare                                                     -- [ Level = 2 ]
+      Result : F3A2A00.TC_Result_Kind;
+   begin -- SUBTEST2.
+
+      declare                                                  -- [ Level = 3 ]
+         -- The instantiation of C3A2A01_1 should NOT result in any
+         -- exceptions.
+
+         type AccTag_L3 is access all F3A2A00.Tagged_Type;
+
+         package Pack_OK is new C3A2A01_1 (F3A2A00.Tagged_Type,
+                                           AccTag_L3,
+                                           F3A2A00.X_L0);
+      begin
+         -- The accessibility level of the actual object used to instantiate
+         -- Pack_OK is 0. The accessibility level of the actual access type
+         -- used to instantiate Pack_OK is 3. Therefore, the FObj'Access in
+         -- Pack_OK.Handle does not raise an exception when the subprogram is
+         -- called. If an exception is (incorrectly) raised, however, it is
+         -- handled within the subprogram:
+
+         Pack_OK.Handle (Result);
+      end;
+
+      F3A2A00.TC_Display_Results (Result, F3A2A00.OK, "SUBTEST #2");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #2: Program_Error incorrectly raised " &
+                        "during instantiation of generic");
+      when others        =>
+         Report.Failed ("SUBTEST #2: Unexpected exception raised " &
+                        "during instantiation of generic");
+   end SUBTEST2;
+
+
+
+   SUBTEST3:
+   declare                                                     -- [ Level = 2 ]
+      Result : F3A2A00.TC_Result_Kind;
+   begin -- SUBTEST3.
+
+      declare                                                  -- [ Level = 3 ]
+         -- The instantiation of C3A2A01_1 should NOT result in any
+         -- exceptions.
+
+         X_L3: F3A2A00.Tagged_Type;
+
+         package Pack_PE is new C3A2A01_1 (F3A2A00.Tagged_Type,
+                                           F3A2A00.AccTag_L0,
+                                           X_L3);
+      begin
+         -- The accessibility level of the actual object used to instantiate
+         -- Pack_PE is 3. The accessibility level of the actual access type
+         -- used to instantiate Pack_PE is 0. Therefore, the FObj'Access in
+         -- Pack_OK.Handle raises Program_Error when the subprogram is
+         -- called. The exception is handled within the subprogram:
+
+         Pack_PE.Handle (Result);
+      end;
+
+      F3A2A00.TC_Display_Results (Result, F3A2A00.P_E, "SUBTEST #3");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #3: Program_Error incorrectly raised " &
+                        "during instantiation of generic");
+      when others        =>
+         Report.Failed ("SUBTEST #3: Unexpected exception raised " &
+                        "during instantiation of generic");
+   end SUBTEST3;
+
+
+
+   SUBTEST4:
+   declare                                                     -- [ Level = 2 ]
+      Result1 : F3A2A00.TC_Result_Kind;
+      Result2 : F3A2A00.TC_Result_Kind;
+   begin -- SUBTEST4.
+
+      declare                                                  -- [ Level = 3 ]
+         -- The instantiation of C3A2A01_2 should NOT result in any
+         -- exceptions.
+
+         X_L3: aliased F3A2A00.Array_Type;
+         type AccArr_L3 is access all F3A2A00.Array_Type;
+
+         procedure Proc is new C3A2A01_2 (F3A2A00.Array_Type, AccArr_L3);
+      begin
+         -- The accessibility level of Proc.P.all is that of the corresponding
+         -- actual during the call (in this case 3). The accessibility level of
+         -- the access type used to instantiate Proc is also 3. Therefore, the
+         -- P.all'Access in Proc does not raise an exception when the
+         -- subprogram is called. If an exception is (incorrectly) raised,
+         -- however, it is handled within the subprogram:
+
+         Proc (X_L3'Access, Result1);
+
+         F3A2A00.TC_Display_Results (Result1, F3A2A00.OK,
+                                     "SUBTEST #4: same levels");
+
+         declare                                               -- [ Level = 4 ]
+            X_L4: aliased F3A2A00.Array_Type;
+         begin
+            -- Within this block, the accessibility level of the actual
+            -- corresponding to Proc.P.all is 4. Therefore, the P.all'Access
+            -- in Proc raises Program_Error when the subprogram is called. The
+            -- exception is handled within the subprogram:
+
+            Proc (X_L4'Access, Result2);
+
+            F3A2A00.TC_Display_Results (Result2, F3A2A00.P_E,
+                                        "SUBTEST #4: object at deeper level");
+         end;
+
+      end;
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #4: Program_Error incorrectly raised " &
+                        "during instantiation of generic");
+      when others        =>
+         Report.Failed ("SUBTEST #4: Unexpected exception raised " &
+                        "during instantiation of generic");
+   end SUBTEST4;
+
+
+   Report.Result;
+
+end C3A2A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2a02.a
new file mode 100644
index 000000000..23b2c1c5d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c3a2a02.a
@@ -0,0 +1,396 @@
+-- C3A2A02.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, for X'Access of a general access type A, Program_Error is
+--      raised if the accessibility level of X is deeper than that of A.
+--      Check for cases where X'Access occurs in an instance body, and A
+--      is a type either declared inside the instance, or declared outside
+--      the instance but not passed as an actual during instantiation.
+--
+-- TEST DESCRIPTION:
+--      In order to satisfy accessibility requirements, the designated
+--      object X must be at the same or a less deep nesting level than the
+--      general access type A -- X must "live" as long as A. Nesting
+--      levels are the run-time nestings of masters: block statements;
+--      subprogram, task, and entry bodies; and accept statements. Packages
+--      are invisible to accessibility rules.
+--
+--      This test declares three generic packages:
+--
+--         (1) One in which X is of a formal tagged derived type and declared
+--             in the body, A is a type declared outside the instance, and
+--             X'Access occurs in the declarative part of a nested subprogram.
+--
+--         (2) One in which X is a formal object of a tagged type, A is a
+--             type declared outside the instance, and X'Access occurs in the
+--             declarative part of the body.
+--
+--         (3) One in which there are two X's and two A's. In the first pair,
+--             X is a formal in object of a tagged type, A is declared in the
+--             specification, and X'Access occurs in the declarative part of
+--             the body. In the second pair, X is of a formal derived type,
+--             X and A are declared in the specification, and X'Access occurs
+--             in the sequence of statements of the body.
+--
+--      The test verifies the following:
+--
+--         For (1), Program_Error is raised when the nested subprogram is
+--         called, if the generic package is instantiated at a deeper level
+--         than that of A. The exception is propagated to the innermost
+--         enclosing master. Also, check that Program_Error is not raised
+--         if the instantiation is at the same level as that of A.
+--
+--         For (2), Program_Error is raised upon instantiation if the object
+--         passed as an actual during instantiation has an accessibility level
+--         deeper than that of A. The exception is propagated to the innermost
+--         enclosing master. Also, check that Program_Error is not raised if
+--         the level of the actual object is not deeper than that of A.
+--
+--         For (3), Program_Error is not raised, for actual objects at
+--         various accessibility levels (since A will have at least the same
+--         accessibility level as X in all cases, no exception should ever
+--         be raised).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F3A2A00.A
+--      -> C3A2A02.A
+--
+--
+-- CHANGE HISTORY:
+--      12 May 95   SAIC    Initial prerelease version.
+--      10 Jul 95   SAIC    Modified code to avoid dead variable optimization.
+--      26 Jun 98   EDS     Added pragma Elaborate (C3A2A02_0) to package
+--                          package C3A2A02_3, in order to avoid possible
+--                          instantiation error.
+--!
+
+with F3A2A00;
+generic
+   type FD is new F3A2A00.Tagged_Type with private;
+package C3A2A02_0 is
+   procedure Proc;
+end C3A2A02_0;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C3A2A02_0 is
+   X : aliased FD;
+
+   procedure Proc is
+      Ptr : F3A2A00.AccTagClass_L0 := X'Access;
+   begin
+      -- Avoid optimization (dead variable removal of Ptr):
+
+      if not Report.Equal (Ptr.C, Ptr.C) then              -- Always false.
+         Report.Failed ("Unexpected error in Proc");
+      end if;
+   end Proc;
+end C3A2A02_0;
+
+
+     --==================================================================--
+
+
+with F3A2A00;
+generic
+   FObj : in out F3A2A00.Tagged_Type;
+package C3A2A02_1 is
+   procedure Dummy; -- Needed to allow package body.
+end C3A2A02_1;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C3A2A02_1 is
+   Ptr : F3A2A00.AccTag_L0 := FObj'Access;
+
+   procedure Dummy is
+   begin
+      null;
+   end Dummy;
+begin
+   -- Avoid optimization (dead variable removal of Ptr):
+
+   if not Report.Equal (Ptr.C, Ptr.C) then              -- Always false.
+      Report.Failed ("Unexpected error in C3A2A02_1 instance");
+   end if;
+end C3A2A02_1;
+
+
+     --==================================================================--
+
+
+with F3A2A00;
+generic
+   type FD is new F3A2A00.Array_Type;
+   FObj : in F3A2A00.Tagged_Type;
+package C3A2A02_2 is
+   type GAF is access all FD;
+   type GAO is access constant F3A2A00.Tagged_Type;
+   XG    : aliased FD;
+   PtrF  : GAF;
+   Index : Integer := FD'First;
+
+   procedure Dummy; -- Needed to allow package body.
+end C3A2A02_2;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C3A2A02_2 is
+   PtrO : GAO := FObj'Access;
+
+   procedure Dummy is
+   begin
+      null;
+   end Dummy;
+begin
+   PtrF := XG'Access;
+
+   -- Avoid optimization (dead variable removal of PtrO and/or PtrF):
+
+   if not Report.Equal (PtrO.C, PtrO.C) then                -- Always false.
+      Report.Failed ("Unexpected error in C3A2A02_2 instance: PtrO");
+   end if;
+
+   if not Report.Equal (PtrF(Index).C, PtrF(Index).C) then  -- Always false.
+      Report.Failed ("Unexpected error in C3A2A02_2 instance: PtrF");
+   end if;
+end C3A2A02_2;
+
+
+     --==================================================================--
+
+
+-- The instantiation of C3A2A02_0 should NOT result in any exceptions.
+
+with F3A2A00;
+with C3A2A02_0;
+pragma Elaborate (C3A2A02_0);
+package C3A2A02_3 is new C3A2A02_0 (F3A2A00.Tagged_Type);
+
+
+     --==================================================================--
+
+
+with F3A2A00;
+with C3A2A02_0;
+with C3A2A02_1;
+with C3A2A02_2;
+with C3A2A02_3;
+
+with Report;
+procedure C3A2A02 is
+begin -- C3A2A02.                                              -- [ Level = 1 ]
+
+   Report.Test ("C3A2A02", "Run-time accessibility checks: instance " &
+                "bodies. Type of X'Access is local or global to instance");
+
+
+   SUBTEST1:
+   declare                                                     -- [ Level = 2 ]
+      Result1 : F3A2A00.TC_Result_Kind;
+      Result2 : F3A2A00.TC_Result_Kind;
+   begin -- SUBTEST1.
+
+      declare                                                  -- [ Level = 3 ]
+         package Pack_Same_Level renames C3A2A02_3;
+      begin
+         -- The accessibility level of Pack_Same_Level.X is that of the
+         -- instance (0), not that of the renaming declaration. The level of
+         -- the type of Pack_Same_Level.X'Access (F3A2A00.AccTagClass_L0) is
+         -- 0. Therefore, the X'Access in Pack_Same_Level.Proc does not raise
+         -- an exception when the subprogram is called. The level of execution
+         -- of the subprogram is irrelevant:
+
+         Pack_Same_Level.Proc;
+         Result1 := F3A2A00.OK;                             -- Expected result.
+      exception
+         when Program_Error => Result1 := F3A2A00.P_E;
+         when others        => Result1 := F3A2A00.O_E;
+      end;
+
+      F3A2A00.TC_Display_Results (Result1, F3A2A00.OK,
+                                  "SUBTEST #1 (same level)");
+
+
+      declare                                                  -- [ Level = 3 ]
+         -- The instantiation of C3A2A02_0 should NOT result in any
+         -- exceptions.
+
+         package Pack_Deeper_Level is new C3A2A02_0 (F3A2A00.Tagged_Type);
+      begin
+         -- The accessibility level of Pack_Deeper_Level.X is that of the
+         -- instance (3). The level of the type of Pack_Deeper_Level.X'Access
+         -- (F3A2A00.AccTagClass_L0) is 0. Therefore, the X'Access in
+         -- Pack_Deeper_Level.Proc propagates Program_Error when the
+         -- subprogram is called:
+
+         Pack_Deeper_Level.Proc;
+         Result2 := F3A2A00.OK;
+      exception
+         when Program_Error => Result2 := F3A2A00.P_E;      -- Expected result.
+         when others        => Result2 := F3A2A00.O_E;
+      end;
+
+      F3A2A00.TC_Display_Results (Result2, F3A2A00.P_E,
+                                  "SUBTEST #1: deeper level");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #1: Program_Error incorrectly raised " &
+                        "during instantiation of generic");
+      when others        =>
+         Report.Failed ("SUBTEST #1: Unexpected exception raised " &
+                        "during instantiation of generic");
+   end SUBTEST1;
+
+
+
+   SUBTEST2:
+   declare                                                     -- [ Level = 2 ]
+      Result1 : F3A2A00.TC_Result_Kind;
+      Result2 : F3A2A00.TC_Result_Kind;
+   begin -- SUBTEST2.
+
+      declare                                                  -- [ Level = 3 ]
+         X_L3 : F3A2A00.Tagged_Type;
+      begin
+         declare                                               -- [ Level = 4 ]
+            -- The accessibility level of the actual object corresponding to
+            -- FObj in Pack_PE is 3. The level of the type of FObj'Access
+            -- (F3A2A00.AccTag_L0) is 0. Therefore, the FObj'Access in Pack_PE
+            -- propagates Program_Error when the instance body is elaborated:
+
+            package Pack_PE is new C3A2A02_1 (X_L3);
+         begin
+            Result1 := F3A2A00.OK;
+         end;
+      exception
+         when Program_Error => Result1 := F3A2A00.P_E;      -- Expected result.
+         when others        => Result1 := F3A2A00.O_E;
+      end;
+
+      F3A2A00.TC_Display_Results (Result1, F3A2A00.P_E,
+                                  "SUBTEST #2: deeper level");
+
+
+      begin                                                    -- [ Level = 3 ]
+         declare                                               -- [ Level = 4 ]
+            -- The accessibility level of the actual object corresponding to
+            -- FObj in Pack_OK is 0. The level of the type of FObj'Access
+            -- (F3A2A00.AccTag_L0) is also 0. Therefore, the FObj'Access in
+            -- Pack_OK does not raise an exception when the instance body is
+            -- elaborated:
+
+            package Pack_OK is new C3A2A02_1 (F3A2A00.X_L0);
+         begin
+            Result2 := F3A2A00.OK;                          -- Expected result.
+         end;
+      exception
+         when Program_Error => Result2 := F3A2A00.P_E;
+         when others        => Result2 := F3A2A00.O_E;
+      end;
+
+      F3A2A00.TC_Display_Results (Result2, F3A2A00.OK,
+                                  "SUBTEST #2: same level");
+
+   end SUBTEST2;
+
+
+
+   SUBTEST3:
+   declare                                                     -- [ Level = 2 ]
+      Result1 : F3A2A00.TC_Result_Kind;
+      Result2 : F3A2A00.TC_Result_Kind;
+   begin -- SUBTEST3.
+
+      declare                                                  -- [ Level = 3 ]
+         X_L3 : F3A2A00.Tagged_Type;
+      begin
+         declare                                               -- [ Level = 4 ]
+            -- Since the accessibility level of the type of X'Access in
+            -- both cases within Pack_OK1 is that of the instance, and since
+            -- X is either passed as an actual (in which case its level will
+            -- not be deeper than that of the instance) or is declared within
+            -- the instance (in which case its level is the same as that of
+            -- the instance), no exception should be raised when the instance
+            -- body is elaborated:
+
+            package Pack_OK1 is new C3A2A02_2 (F3A2A00.Array_Type, X_L3);
+         begin
+            Result1 := F3A2A00.OK;                          -- Expected result.
+         end;
+      exception
+         when Program_Error => Result1 := F3A2A00.P_E;
+         when others        => Result1 := F3A2A00.O_E;
+      end;
+
+      F3A2A00.TC_Display_Results (Result1, F3A2A00.OK,
+                                  "SUBTEST #3: 1st okay case");
+
+
+      declare                                                  -- [ Level = 3 ]
+         type My_Array is new F3A2A00.Array_Type;
+      begin
+         declare                                               -- [ Level = 4 ]
+            -- Since the accessibility level of the type of X'Access in
+            -- both cases within Pack_OK2 is that of the instance, and since
+            -- X is either passed as an actual (in which case its level will
+            -- not be deeper than that of the instance) or is declared within
+            -- the instance (in which case its level is the same as that of
+            -- the instance), no exception should be raised when the instance
+            -- body is elaborated:
+
+            package Pack_OK2 is new C3A2A02_2 (My_Array, F3A2A00.X_L0);
+         begin
+            Result2 := F3A2A00.OK;                          -- Expected result.
+         end;
+      exception
+         when Program_Error => Result2 := F3A2A00.P_E;
+         when others        => Result2 := F3A2A00.O_E;
+      end;
+
+      F3A2A00.TC_Display_Results (Result2, F3A2A00.OK,
+                                  "SUBTEST #3: 2nd okay case");
+
+
+   end SUBTEST3;
+
+
+
+   Report.Result;
+
+end C3A2A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c410001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c410001.a
new file mode 100644
index 000000000..26555531b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c410001.a
@@ -0,0 +1,303 @@
+-- C410001.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 evaluating an access to subprogram variable containing
+--      the value null causes the exception Constraint_Error.
+--      Check that the default value for objects of access to subprogram
+--      types is null.
+--
+-- TEST DESCRIPTION:
+--      This test defines a few simple access_to_subprogram types, and
+--      objects of those types.  It checks that the default values for
+--      these objects is null, and that an attempt to make a subprogram
+--      call via one of this objects containing a null value causes the
+--      predefined exception Constraint_Error.  The check is performed
+---     both with the default null value, and with an explicitly assigned
+--      null value, after the object has been used to successfully designate
+--      and call a subprogram.
+--
+--
+-- CHANGE HISTORY:
+--      05 APR 96   SAIC   Initial version
+--      04 NOV 96   SAIC   Revised for 2.1 release
+--      26 FEB 97   PWB.CTA Initialized variable before passing to function
+--!
+
+----------------------------------------------------------------- C410001_0
+
+package C410001_0 is
+
+  -- used to "switch state" in the software
+  Expect_Exception : Boolean;
+
+  -- define a minimal mixture of access_to_subprogram types
+
+  type Proc_Ref is access procedure;
+
+  type Func_Ref is access function(I:Integer) return Integer;
+
+  type Proc_Para_Ref is access procedure(P:Proc_Ref);
+
+  type Func_Para_Ref is access function(F:Func_Ref) return Integer;
+
+  type Prot_Proc_Ref is access protected procedure;
+
+  type Prot_Func_Ref is access protected function return Boolean;
+
+  -- define some subprograms for them to reference
+
+  procedure Proc;
+
+  function Func(I:Integer) return Integer;
+
+  procedure Proc_Para( Param : Proc_Ref );
+
+  function Func_Para( Param : Func_Ref ) return Integer;
+
+  protected Prot_Obj is
+    procedure Prot_Proc;
+    function Prot_Func return Boolean;
+  end Prot_Obj;
+
+end C410001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body C410001_0 is
+
+  -- Note that some failing cases will cause duplicate failure messages;
+  -- rather than have the procedure/function bodies be null, the error
+  -- checking code makes for a reasonable anti-optimization feature.
+
+  procedure Proc is
+  begin
+    if Expect_Exception then
+      Report.Failed("Expected exception did not occur: Proc");
+    end if;
+  end Proc;
+
+  function Func(I:Integer) return Integer is
+  begin
+    if Expect_Exception then
+      Report.Failed("Expected exception did not occur: Func");
+    end if;
+    return Report.Ident_Int(I);
+  end Func;
+
+  procedure Proc_Para( Param : Proc_Ref ) is
+  begin
+
+    Param.all;        -- call by explicit dereference
+
+    if Expect_Exception then
+      Report.Failed("Expected exception did not occur: Proc_Para");
+    end if;
+
+  exception
+    when Constraint_Error =>
+      if not Expect_Exception then
+        Report.Failed("Unexpected Constraint_Error: Proc_Para");
+      end if;  -- else null; expected the exception
+    when others => Report.Failed("Unexpected exception: Proc_Para");
+  end Proc_Para;
+
+  function Func_Para( Param : Func_Ref ) return Integer is
+  begin
+
+    return Param(1);  -- call by implicit dereference
+
+    if Expect_Exception then
+      Report.Failed("Expected exception did not occur: Func_Para");
+    end if;
+    return 1;  -- really just to avoid warnings
+
+  exception
+    when Constraint_Error =>
+      if not Expect_Exception then
+        Report.Failed("Unexpected Constraint_Error: Func_Para");
+        return 0;
+      else
+        return 1995;  -- any value other than this is unexpected
+      end if;
+    when others => Report.Failed("Unexpected exception: Func_Para");
+                   return -42;
+  end Func_Para;
+
+  protected body Prot_Obj is
+
+    procedure Prot_Proc is
+    begin
+      if Expect_Exception then
+        Report.Failed("Expected exception did not occur: Prot_Proc");
+      end if;
+    end Prot_Proc;
+
+    function Prot_Func return Boolean is
+    begin
+      if Expect_Exception then
+        Report.Failed("Expected exception did not occur: Prot_Func");
+      end if;
+      return Report.Ident_Bool( True );
+    end Prot_Func;
+
+  end Prot_Obj;
+
+end C410001_0;
+
+------------------------------------------------------------------- C410001
+
+with Report;
+with TCTouch;
+with C410001_0;
+procedure C410001 is
+
+  Proc_Ref_Var : C410001_0.Proc_Ref;
+
+  Func_Ref_Var : C410001_0.Func_Ref;
+
+  Proc_Para_Ref_Var : C410001_0.Proc_Para_Ref;
+
+  Func_Para_Ref_Var : C410001_0.Func_Para_Ref;
+
+  type Enclosure is record
+    Prot_Proc_Ref_Var : C410001_0.Prot_Proc_Ref;
+    Prot_Func_Ref_Var : C410001_0.Prot_Func_Ref;
+  end record;
+
+  Enclosed : Enclosure;
+
+  Valid_Proc : C410001_0.Proc_Ref := C410001_0.Proc'Access;
+
+  Valid_Func : C410001_0.Func_Ref := C410001_0.Func'Access;
+
+  procedure Make_Calls( Expecting_Exceptions : Boolean ) is
+    type Case_Numbers is range 1..6;
+    Some_Integer : Integer := 0;
+  begin
+    for Cases in Case_Numbers loop
+      Catch_Exception : begin
+        case Cases is
+          when 1 => Proc_Ref_Var.all;
+          when 2 => Some_Integer := Func_Ref_Var.all( Some_Integer );
+          when 3 => Proc_Para_Ref_Var( Valid_Proc );
+          when 4 => Some_Integer := Func_Para_Ref_Var( Valid_Func );
+          when 5 => Enclosed.Prot_Proc_Ref_Var.all;
+          when 6 => TCTouch.Assert( Enclosed.Prot_Func_Ref_Var.all
+                                    /= Expecting_Exceptions,
+                                    "Case 6");
+        end case;
+        if Expecting_Exceptions then
+          Report.Failed("Exception expected: Case"
+                        & Case_Numbers'Image(Cases) );
+        end if;
+      exception
+        when Constraint_Error =>
+          if not Expecting_Exceptions then
+            Report.Failed("Constraint_Error not expected: Case"
+                          & Case_Numbers'Image(Cases) );
+          end if;
+        when others =>
+          Report.Failed("Wrong/Bad Exception: Case"
+                        & Case_Numbers'Image(Cases) );
+      end Catch_Exception;
+    end loop;
+  end Make_Calls;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C410001", "Check that evaluating an access to subprogram " &
+                          "variable containing the value null causes the " &
+                          "exception Constraint_Error. Check that the " &
+                          "default value for objects of access to " &
+                          "subprogram types is null" );
+   
+  -- check that the default values are null
+  declare
+    use C410001_0; -- make all "="'s visible for all types
+  begin
+    TCTouch.Assert( Proc_Ref_Var = null, "Proc_Ref_Var = null" );
+
+    TCTouch.Assert( Func_Ref_Var = null, "Func_Ref_Var = null" );
+
+    TCTouch.Assert( Proc_Para_Ref_Var = null, "Proc_Para_Ref_Var = null" );
+
+    TCTouch.Assert( Func_Para_Ref_Var = null, "Func_Para_Ref_Var = null" );
+
+    TCTouch.Assert( Enclosed.Prot_Proc_Ref_Var = null,
+                   "Enclosed.Prot_Proc_Ref_Var = null" );
+
+    TCTouch.Assert( Enclosed.Prot_Func_Ref_Var = null,
+                   "Enclosed.Prot_Func_Ref_Var = null" );
+  end;
+
+  -- check that calls via the default values cause Constraint_Error
+
+  C410001_0.Expect_Exception := True;
+
+  Make_Calls( Expecting_Exceptions => True );
+
+  -- assign non-null values to the objects
+
+  Proc_Ref_Var      := C410001_0.Proc'Access;
+  Func_Ref_Var      := C410001_0.Func'Access;
+  Proc_Para_Ref_Var := C410001_0.Proc_Para'Access;
+  Func_Para_Ref_Var := C410001_0.Func_Para'Access;
+  Enclosed          := (C410001_0.Prot_Obj.Prot_Proc'Access,
+                        C410001_0.Prot_Obj.Prot_Func'Access);
+
+  -- check that the calls perform normally
+
+  C410001_0.Expect_Exception := False;
+
+  Make_Calls( Expecting_Exceptions => False );
+
+  -- check that a passed null value causes Constraint_Error
+
+  C410001_0.Expect_Exception := True;
+
+  Proc_Para_Ref_Var( null );
+
+  TCTouch.Assert( Func_Para_Ref_Var( null ) = 1995,
+                 "Func_Para_Ref_Var( null )");
+
+  -- assign the null value to the objects
+
+  Proc_Ref_Var      := null;
+  Func_Ref_Var      := null;
+  Proc_Para_Ref_Var := null;
+  Func_Para_Ref_Var := null;
+  Enclosed          := (null,null);
+
+  -- check that calls now again cause Constraint_Error
+
+  C410001_0.Expect_Exception := True;
+
+  Make_Calls( Expecting_Exceptions => True );
+
+  Report.Result;
+
+end C410001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41101d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41101d.ada
new file mode 100644
index 000000000..c826a227b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41101d.ada
@@ -0,0 +1,102 @@
+-- C41101D.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 INDEXED COMPONENTS OF THE FORM F(...), CHECK THAT 
+--   THE NUMBER OF INDEX VALUES, THE TYPE OF THE INDEX
+--   VALUES, AND THE REQUIRED TYPE OF THE INDEXED COMPONENT
+--   ARE USED TO RESOLVE AN OVERLOADING OF F.
+
+-- WKB 8/12/81
+-- JBG 10/12/81
+-- SPS 11/1/82
+
+WITH REPORT;
+PROCEDURE C41101D IS
+
+     USE REPORT;
+
+     TYPE T1 IS ARRAY (1..10) OF INTEGER;
+     TYPE T2 IS ARRAY (1..10, 1..10) OF INTEGER;
+     I : INTEGER;
+
+     TYPE U1 IS (MON,TUE,WED,THU,FRI);
+     TYPE U2 IS ARRAY (U1 RANGE MON..THU) OF INTEGER;
+
+     TYPE V1 IS ARRAY (1..10) OF BOOLEAN;
+     B : BOOLEAN;
+
+     FUNCTION F RETURN T1 IS
+     BEGIN
+          RETURN (1..10 => 1);
+     END F;
+
+     FUNCTION F RETURN T2 IS
+     BEGIN
+          RETURN (1..10 => (1..10 => 2));
+     END F;
+
+     FUNCTION G RETURN U2 IS
+     BEGIN
+          RETURN (MON..THU => 3);
+     END G;
+
+     FUNCTION G RETURN T1 IS
+     BEGIN
+          RETURN (1..10 => 4);
+     END G;
+
+     FUNCTION H RETURN T1 IS
+     BEGIN
+          RETURN (1..10 => 5);
+     END H;
+
+     FUNCTION H RETURN V1 IS
+     BEGIN
+          RETURN (1..10 => FALSE);
+     END H;
+
+BEGIN
+
+     TEST ("C41101D", "WHEN INDEXING FUNCTION RESULTS, INDEX TYPE, " &
+                      "NUMBER OF INDICES, AND COMPONENT TYPE ARE " &
+                      "USED FOR OVERLOADING RESOLUTION");
+
+     I := F(7);              -- NUMBER OF INDEX VALUES.
+     IF I /= IDENT_INT(1) THEN
+          FAILED ("WRONG VALUE - 1");
+     END IF;
+
+     I := G(3);              -- INDEX TYPE.
+     IF I /= IDENT_INT(4) THEN
+          FAILED ("WRONG VALUE - 2");
+     END IF;
+
+     B := H(5);              -- COMPONENT TYPE.
+     IF B /= IDENT_BOOL(FALSE) THEN
+          FAILED ("WRONG VALUE - 3");
+     END IF;
+
+     RESULT;
+
+END C41101D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41103a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41103a.ada
new file mode 100644
index 000000000..21feafb36
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41103a.ada
@@ -0,0 +1,239 @@
+-- C41103A.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 NAME IN AN INDEXED_COMPONENT MAY BE:
+--   AN IDENTIFIER DENOTING AN ARRAY OBJECT - N1;
+--   AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
+--        DESIGNATES AN ARRAY OBJECT - N2;
+--   A FUNCTION CALL DELIVERING AN ARRAY OBJECT USING
+--        A PREDEFINED FUNCTION - &,
+--        A USER-DEFINED FUNCTION - F1;
+--   A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
+--        DESIGNATES AN ARRAY - F2;
+--   A SLICE (CHECKING UPPER AND LOWER BOUND COMPONENTS) - N3;
+--   AN INDEXED COMPONENT DENOTING AN ARRAY OBJECT
+--        (ARRAY OF ARRAYS) - N4;
+--   AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
+--        ENCLOSING ITS DECLARATION - C41103A.N1;
+--   A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
+--        ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
+-- CHECK THAT THE APPROPRIATE COMPONENT IS ACCESSED (FOR
+--   STATIC INDICES).
+
+-- WKB 7/27/81
+-- JRK 7/28/81
+-- SPS 10/26/82
+-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41103A IS
+
+     TYPE A1 IS ARRAY (INTEGER RANGE 1..4) OF INTEGER;
+     N1 : A1 := (1,2,3,4);
+
+BEGIN
+     TEST ("C41103A", "CHECK THAT AN INDEXED_COMPONENT MAY BE OF " &
+                      "CERTAIN FORMS AND THAT THE APPROPRIATE " &
+                      "COMPONENT IS ACCESSED (FOR STATIC INDICES)");
+
+     DECLARE
+
+          TYPE A2 IS ARRAY (INTEGER RANGE 1..4) OF BOOLEAN;
+          TYPE A3 IS ACCESS A1;
+          TYPE A4 IS ARRAY (INTEGER RANGE 1..4) OF A1;
+          TYPE R (LENGTH : INTEGER) IS 
+               RECORD
+                    S : STRING (1..LENGTH);
+               END RECORD;
+
+          N2 : A3 := NEW A1' (1,2,3,4);
+          N3 : ARRAY (1..7) OF INTEGER := (1,2,3,4,5,6,7);
+          N4 : A4 := (1 => (1,2,3,4), 2 => (5,6,7,8),
+                      3 => (9,10,11,12), 4 => (13,14,15,16));
+          N5 : R(4) := (LENGTH => 4, S => "ABCD");
+
+          FUNCTION F1 RETURN A2 IS
+          BEGIN
+               RETURN (FALSE,FALSE,TRUE,FALSE);
+          END F1;
+
+          FUNCTION F2 RETURN A3 IS
+          BEGIN
+               RETURN N2;
+          END F2;
+
+          PROCEDURE P1 (X : IN INTEGER; Y : IN OUT INTEGER;
+                        Z : OUT INTEGER; W : IN STRING) IS
+          BEGIN
+               IF X /= 2 THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+               END IF;
+               IF Y /= 3 THEN
+                    FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+               END IF;
+               Y := 8;
+               Z := 9;
+          END P1;
+
+          PROCEDURE P2 (X : CHARACTER) IS
+          BEGIN
+               IF X /= 'C' THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
+               END IF;
+          END P2;
+
+          PROCEDURE P3 (X : BOOLEAN) IS
+          BEGIN
+               IF X /= TRUE THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
+               END IF;
+          END P3;
+
+          PROCEDURE P5 (X : IN CHARACTER; Y : IN OUT CHARACTER;
+                        Z : OUT CHARACTER) IS
+          BEGIN 
+               IF X /= 'A' THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
+               END IF;
+               IF Y /= 'D' THEN
+                    FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
+               END IF;
+               Y := 'Y';
+               Z := 'Z';
+          END P5;
+
+     BEGIN
+
+          IF N1(2) /= 2 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N1");
+          END IF;
+          N1(2) := 7;
+          IF N1 /= (1,7,3,4) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
+          END IF;
+          N1 := (1,2,3,4);
+          P1 (N1(2), N1(3), N1(1), "N1");
+          IF N1 /= (9,2,8,4) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
+          END IF;
+
+          IF N2(3) /= 3 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N2");
+          END IF;
+          N2(3) := 7;
+          IF N2.ALL /= (1,2,7,4) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
+          END IF;
+          N2.ALL := (2,1,4,3);
+          P1 (N2(1), N2(4), N2(2), "N2");
+          IF N2.ALL /= (2,9,4,8) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
+          END IF;
+
+          IF "&" (STRING'("AB"), STRING'("CDEF"))(5) /= CHARACTER'('E') THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
+          END IF;
+          P2 ("&" ("AB", "CD")(3));
+
+          IF F1(3) /= TRUE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - F1");
+          END IF;
+          P3 (F1(3));
+
+          N2 := NEW A1' (1,2,3,4);
+          IF F2(2) /= 2 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - F2");
+          END IF;
+          F2(3) := 7;
+          IF N2.ALL /= (1,2,7,4) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
+          END IF;
+          N2.ALL := (1,2,3,4);
+          P1 (F2(2), F2(3), F2(1), "F2");
+          IF N2.ALL /= (9,2,8,4) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
+          END IF;
+
+          IF N3(2..5)(5) /= 5 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N3");
+          END IF;
+          N3(2..5)(2) := 8;
+          IF N3 /= (1,8,3,4,5,6,7) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
+          END IF;
+          N3 := (5,3,4,2,1,6,7);
+          P1 (N3(2..5)(4), N3(2..5)(2), N3(2..5)(5), "N3");
+          IF N3 /= (5,8,4,2,9,6,7) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
+          END IF;
+
+          IF N4(1)(2) /= 2 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N4");
+          END IF;
+          N4(3)(1) := 20;
+          IF N4 /= ((1,2,3,4),(5,6,7,8),(20,10,11,12),
+                    (13,14,15,16)) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
+          END IF;
+          N4 := (1 => (0,6,4,2), 2 => (10,11,12,13),
+                 3 => (14,15,16,17), 4 => (7,5,3,1));
+          P1 (N4(1)(4), N4(4)(3), N4(2)(1), "N4");
+          IF N4 /= ((0,6,4,2),(9,11,12,13),(14,15,16,17),
+                    (7,5,8,1)) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
+          END IF;
+
+          N1 := (1,2,3,4);
+          IF C41103A.N1(2) /= 2 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - C41103A.N1");
+          END IF;
+          C41103A.N1(2) := 7;
+          IF N1 /= (1,7,3,4) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - C41103A.N1");
+          END IF;
+          N1 := (1,2,3,4);
+          P1 (C41103A.N1(2), C41103A.N1(3), C41103A.N1(1),
+              "C41103A.N1");
+          IF N1 /= (9,2,8,4) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
+                      "- C41103A.N1");
+          END IF;
+
+          IF N5.S(3) /= 'C' THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N5");
+          END IF;
+          N5.S(4) := 'X';
+          IF N5.S /= "ABCX" THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
+          END IF;
+          N5.S := "ABCD";
+          P5 (N5.S(1), N5.S(4), N5.S(2));
+          IF N5.S /= "AZCY" THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
+          END IF;
+     END;
+
+     RESULT;
+END C41103A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41103b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41103b.ada
new file mode 100644
index 000000000..7fbab7174
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41103b.ada
@@ -0,0 +1,366 @@
+-- C41103B.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 NAME IN AN INDEXED_COMPONENT MAY BE:
+--        AN IDENTIFIER DENOTING AN ARRAY OBJECT - N1;
+--        AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
+--           DESIGNATES AN ARRAY OBJECT - N2;
+--        A FUNCTION CALL DELIVERING AN ARRAY OBJECT USING
+--           PREDEFINED FUNCTIONS - &, AND THE LOGICAL OPERATORS
+--        A USER-DEFINED FUNCTION - F1;
+--        A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
+--           DESIGNATES AN ARRAY - F2;
+--        A SLICE (CHECKING UPPER AND LOWER BOUND COMPONENTS) - N3;
+--        AN INDEXED COMPONENT DENOTING AN ARRAY OBJECT
+--           (ARRAY OF ARRAYS) - N4;
+--        AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
+--           ENCLOSING ITS DECLARATION - C41103B.N1;
+--        A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
+--           ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
+--     CHECK THAT THE APPROPRIATE COMPONENT IS ACCESSED (FOR
+--     DYNAMIC INDICES).
+
+-- HISTORY:
+--     WKB 08/05/81  CREATED ORIGINAL TEST.
+--     SPS 10/26/82
+--     BCB 08/02/88  MODIFIED HEADER FORMAT AND ADDED CALLS TO THE
+--                   LOGICAL OPERATORS.
+--     BCB 04/16/90  MODIFIED SLICE TEST TO INCLUDE A READING OF THE
+--                   COMPONENT DESIGNATED BY THE LOWER BOUND OF THE
+--                   SLICE.  ADDED TEST FOR PREFIX OF INDEXED COMPONENT
+--                   HAVING A LIMITED TYPE.
+--     PWN 11/30/94  SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41103B IS
+
+     TYPE A1 IS ARRAY (INTEGER RANGE 1..4) OF INTEGER;
+     N1 : A1 := (1,2,3,4);
+
+BEGIN
+     TEST ("C41103B", "CHECK THAT AN INDEXED_COMPONENT MAY BE OF " &
+                      "CERTAIN FORMS AND THAT THE APPROPRIATE " &
+                      "COMPONENT IS ACCESSED (FOR DYNAMIC INDICES)");
+
+     DECLARE
+
+          TYPE A2 IS ARRAY (INTEGER RANGE 1..4) OF BOOLEAN;
+          TYPE A3 IS ACCESS A1;
+          TYPE A4 IS ARRAY (INTEGER RANGE 1..4) OF A1;
+          TYPE R (LENGTH : INTEGER) IS
+               RECORD
+                    S : STRING (1..LENGTH);
+               END RECORD;
+
+          N2 : A3 := NEW A1' (1,2,3,4);
+          N3 : ARRAY (1..7) OF INTEGER := (1,2,3,4,5,6,7);
+          N4 : A4 := (1 => (1,2,3,4), 2 => (5,6,7,8),
+                      3 => (9,10,11,12), 4 => (13,14,15,16));
+          N5 : R(4) := (LENGTH => 4, S => "ABCD");
+
+          M2A : A2 := (TRUE,FALSE,TRUE,FALSE);
+          M2B : A2 := (TRUE,TRUE,FALSE,FALSE);
+
+          FUNCTION F1 RETURN A2 IS
+          BEGIN
+               RETURN (FALSE,FALSE,TRUE,FALSE);
+          END F1;
+
+          FUNCTION F2 RETURN A3 IS
+          BEGIN
+               RETURN N2;
+          END F2;
+
+          PROCEDURE P1 (X : IN INTEGER; Y : IN OUT INTEGER;
+                        Z : OUT INTEGER; W : IN STRING) IS
+          BEGIN
+               IF X /= 2 THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+               END IF;
+               IF Y /= 3 THEN
+                    FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+               END IF;
+               Y := 8;
+               Z := 9;
+          END P1;
+
+          PROCEDURE P2 (X : CHARACTER) IS
+          BEGIN
+               IF X /= 'C' THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
+               END IF;
+          END P2;
+
+          PROCEDURE P3 (X : BOOLEAN) IS
+          BEGIN
+               IF X /= TRUE THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
+               END IF;
+          END P3;
+
+          PROCEDURE P5 (X : IN CHARACTER; Y : IN OUT CHARACTER;
+                        Z : OUT CHARACTER) IS
+          BEGIN
+               IF X /= 'A' THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
+               END IF;
+               IF Y /= 'D' THEN
+                    FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
+               END IF;
+               Y := 'Y';
+               Z := 'Z';
+          END P5;
+
+          PROCEDURE P6 (X : BOOLEAN) IS
+          BEGIN
+               IF X /= TRUE THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - NOT");
+               END IF;
+          END P6;
+
+          PROCEDURE P7 (X : BOOLEAN) IS
+          BEGIN
+               IF X /= TRUE THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - AND");
+               END IF;
+          END P7;
+
+          PROCEDURE P8 (X : BOOLEAN) IS
+          BEGIN
+               IF X /= TRUE THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - OR");
+               END IF;
+          END P8;
+
+          PROCEDURE P9 (X : BOOLEAN) IS
+          BEGIN
+               IF X /= TRUE THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - XOR");
+               END IF;
+          END P9;
+
+     BEGIN
+
+          IF N1(IDENT_INT(2)) /= 2 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N1");
+          END IF;
+          N1(IDENT_INT(2)) := 7;
+          IF N1 /= (1,7,3,4) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
+          END IF;
+          N1 := (1,2,3,4);
+          P1 (N1(IDENT_INT(2)), N1(IDENT_INT(3)),
+              N1(IDENT_INT(1)), "N1");
+          IF N1 /= (9,2,8,4) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
+          END IF;
+
+          IF N2(IDENT_INT(3)) /= 3 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N2");
+          END IF;
+          N2(IDENT_INT(3)) := 7;
+          IF N2.ALL /= (1,2,7,4) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
+          END IF;
+          N2.ALL := (2,1,4,3);
+          P1 (N2(IDENT_INT(1)), N2(IDENT_INT(4)),
+              N2(IDENT_INT(2)), "N2");
+          IF N2.ALL /= (2,9,4,8) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
+          END IF;
+
+          IF "&" (STRING'("AB"), STRING'("CDEF"))(IDENT_INT(5)) 
+             /= CHARACTER'('E') THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
+          END IF;
+          P2 ("&" ("AB", "CD")(IDENT_INT(3)));
+
+          IF "NOT" (M2A)(IDENT_INT(4)) /= TRUE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - 'NOT'");
+          END IF;
+          P6 ("NOT" (M2A)(IDENT_INT(4)));
+
+          IF "AND" (M2A,M2B)(IDENT_INT(3)) /= FALSE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - 'AND'");
+          END IF;
+          P7 ("AND" (M2A,M2B)(IDENT_INT(1)));
+
+          IF "OR" (M2A,M2B)(IDENT_INT(3)) /= TRUE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - 'OR'");
+          END IF;
+          P8 ("OR" (M2A,M2B)(IDENT_INT(3)));
+
+          IF "XOR" (M2A,M2B)(IDENT_INT(1)) /= FALSE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - 'XOR'");
+          END IF;
+          P9 ("XOR" (M2A,M2B)(IDENT_INT(3)));
+
+          IF F1(IDENT_INT(3)) /= TRUE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - F1");
+          END IF;
+          P3 (F1(IDENT_INT(3)));
+
+          N2 := NEW A1'(1,2,3,4);
+          IF F2(IDENT_INT(2)) /= 2 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - F2");
+          END IF;
+          F2(IDENT_INT(3)) := 7;
+          IF N2.ALL /= (1,2,7,4) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
+          END IF;
+          N2.ALL := (1,2,3,4);
+          P1 (F2(IDENT_INT(2)), F2(IDENT_INT(3)),
+              F2(IDENT_INT(1)), "F2");
+          IF N2.ALL /= (9,2,8,4) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
+          END IF;
+
+          IF N3(2..5)(IDENT_INT(2)) /= 2 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION (LOWER BOUND) - N3");
+          END IF;
+          IF N3(2..5)(IDENT_INT(5)) /= 5 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION (UPPER BOUND) - N3");
+          END IF;
+          N3(2..5)(IDENT_INT(2)) := 8;
+          IF N3 /= (1,8,3,4,5,6,7) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
+          END IF;
+          N3 := (5,3,4,2,1,6,7);
+          P1 (N3(2..5)(IDENT_INT(4)), N3(2..5)(IDENT_INT(2)),
+              N3(2..5)(IDENT_INT(5)), "N3");
+          IF N3 /= (5,8,4,2,9,6,7) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
+          END IF;
+
+          IF N4(1)(IDENT_INT(2)) /= 2 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N4");
+          END IF;
+          N4(3)(IDENT_INT(1)) := 20;
+          IF N4 /= ((1,2,3,4),(5,6,7,8),(20,10,11,12),
+                    (13,14,15,16)) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
+          END IF;
+          N4 := (1 => (0,6,4,2), 2 => (10,11,12,13),
+                 3 => (14,15,16,17), 4 => (7,5,3,1));
+          P1 (N4(1)(IDENT_INT(4)), N4(4)(IDENT_INT(3)),
+              N4(2)(IDENT_INT(1)), "N4");
+          IF N4 /= ((0,6,4,2),(9,11,12,13),(14,15,16,17),
+                    (7,5,8,1)) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
+          END IF;
+
+          N1 := (1,2,3,4);
+          IF C41103B.N1(IDENT_INT(2)) /= 2 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - C41103B.N1");
+          END IF;
+          C41103B.N1(IDENT_INT(2)) := 7;
+          IF N1 /= (1,7,3,4) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - C41103B.N1");
+          END IF;
+          N1 := (1,2,3,4);
+          P1 (C41103B.N1(IDENT_INT(2)), C41103B.N1(IDENT_INT(3)),
+              C41103B.N1(IDENT_INT(1)), "C41103B.N1");
+          IF N1 /= (9,2,8,4) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
+                       "- C41103B.N1");
+          END IF;
+
+          IF N5.S(IDENT_INT(3)) /= 'C' THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N5");
+          END IF;
+          N5.S(IDENT_INT(4)) := 'X';
+          IF N5.S /= "ABCX" THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
+          END IF;
+          N5.S := "ABCD";
+          P5 (N5.S(IDENT_INT(1)), N5.S(IDENT_INT(4)),
+              N5.S(IDENT_INT(2)));
+          IF N5.S /= "AZCY" THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
+          END IF;
+
+          DECLARE
+               PACKAGE P IS
+                    TYPE LIM IS LIMITED PRIVATE;
+                    PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER);
+                    PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM);
+                    FUNCTION "=" (ONE,TWO : LIM) RETURN BOOLEAN;
+               PRIVATE
+                    TYPE LIM IS ARRAY(1..3) OF INTEGER;
+               END P;
+
+               USE P;
+
+               TYPE A IS ARRAY(1..3) OF LIM;
+
+               H : A;
+
+               N6 : LIM;
+
+               PACKAGE BODY P IS
+                    PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER) IS
+                    BEGIN
+                         V := (X,Y,Z);
+                    END INIT;
+
+                    PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM) IS
+                    BEGIN
+                         ONE := TWO;
+                    END ASSIGN;
+
+                    FUNCTION "=" (ONE,TWO : LIM) RETURN BOOLEAN IS
+                    BEGIN
+                         IF ONE(1) = TWO(1) AND ONE(2) = TWO(2) AND
+                           ONE(3) = TWO(3) THEN
+                              RETURN TRUE;
+                         ELSE
+                              RETURN FALSE;
+                         END IF;
+                    END "=";
+               END P;
+
+               FUNCTION FR RETURN A IS
+               BEGIN
+                    RETURN H;
+               END FR;
+
+          BEGIN
+               INIT (H(1),1,2,3);
+               INIT (H(2),4,5,6);
+               INIT (H(3),7,8,9);
+               INIT (N6,0,0,0);
+
+               ASSIGN (N6,FR(2));
+
+               IF N6 /= FR(2) THEN
+                    FAILED ("WRONG VALUE FROM LIMITED COMPONENT TYPE");
+               END IF;
+
+          END;
+     END;
+
+     RESULT;
+END C41103B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41104a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41104a.ada
new file mode 100644
index 000000000..540702869
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41104a.ada
@@ -0,0 +1,240 @@
+-- C41104A.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 IF AN EXPRESSION GIVES AN INDEX
+-- VALUE OUTSIDE THE RANGE SPECIFIED FOR THE INDEX FOR ARRAYS AND ACCESS
+-- TYPES.
+
+-- TBN  9/12/86
+-- EDS  8/03/98  AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41104A IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 5;
+     SUBTYPE BOOL IS BOOLEAN RANGE TRUE .. TRUE;
+     SUBTYPE CHAR IS CHARACTER RANGE 'W' .. 'Z';
+     TYPE ARRAY1 IS ARRAY (INT RANGE <>) OF INTEGER;
+     TYPE ARRAY2 IS ARRAY (3 .. 1) OF INTEGER;
+     TYPE ARRAY3 IS ARRAY (BOOL RANGE <>) OF INTEGER;
+     TYPE ARRAY4 IS ARRAY (CHAR RANGE <>) OF INTEGER;
+
+     TYPE REC (D : INT) IS
+          RECORD
+               A : ARRAY1 (1 .. D);
+          END RECORD;
+
+     TYPE B_REC (D : BOOL) IS
+          RECORD
+               A : ARRAY3 (TRUE .. D);
+          END RECORD;
+
+     TYPE NULL_REC (D : INT) IS
+          RECORD
+               A : ARRAY1 (D .. 1);
+          END RECORD;
+
+     TYPE NULL_CREC (D : CHAR) IS
+          RECORD
+               A : ARRAY4 (D .. 'W');
+          END RECORD;
+
+BEGIN
+     TEST ("C41104A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF AN " &
+                      "EXPRESSION GIVES AN INDEX VALUE OUTSIDE THE " &
+                      "RANGE SPECIFIED FOR THE INDEX FOR ARRAYS AND " &
+                      "ACCESS TYPES");
+
+     DECLARE
+          ARA1 : ARRAY1 (1 .. 5) := (1, 2, 3, 4, 5);
+     BEGIN
+          ARA1 (IDENT_INT(0)) := 1;
+
+          BEGIN
+               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
+                        INTEGER'IMAGE(ARA1 (1)));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - 1");
+     END;
+------------------------------------------------------------------------
+     DECLARE
+          TYPE ACC_ARRAY IS ACCESS ARRAY3 (TRUE .. TRUE);
+          ACC_ARA : ACC_ARRAY := NEW ARRAY3'(TRUE => 2);
+     BEGIN
+          ACC_ARA (IDENT_BOOL(FALSE)) := 2;
+
+          BEGIN
+
+               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
+                        INTEGER'IMAGE(ACC_ARA (TRUE)));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - 2");
+     END;
+------------------------------------------------------------------------
+     DECLARE
+          ARA2 : ARRAY4 ('Z' .. 'Y');
+     BEGIN
+          ARA2 (IDENT_CHAR('Y')) := 3;
+
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 3");
+
+          BEGIN
+               COMMENT ("ARA2 (Y) IS " & INTEGER'IMAGE(ARA2 ('Y')));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - 3");
+     END;
+------------------------------------------------------------------------
+     DECLARE
+          TYPE ACC_ARRAY IS ACCESS ARRAY2;
+          ACC_ARA : ACC_ARRAY := NEW ARRAY2;
+     BEGIN
+          ACC_ARA (IDENT_INT(4)) := 4;
+
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 4");
+
+          BEGIN
+               COMMENT ("ACC_ARA (4) IS " & INTEGER'IMAGE(ACC_ARA (4)));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - 4");
+     END;
+------------------------------------------------------------------------
+     DECLARE
+          REC1 : B_REC (TRUE) := (TRUE, A => (TRUE => 5));
+     BEGIN
+          REC1.A (IDENT_BOOL (FALSE)) := 1;
+
+          BEGIN
+               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
+                       INTEGER'IMAGE(REC1.A (TRUE)));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - 5");
+     END;
+------------------------------------------------------------------------
+     DECLARE
+          TYPE ACC_REC IS ACCESS REC (3);
+          ACC_REC1 : ACC_REC := NEW REC'(3, (4, 5, 6));
+     BEGIN
+          ACC_REC1.A (IDENT_INT(4)) := 4;
+
+          BEGIN
+               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
+                        INTEGER'IMAGE(ACC_REC1.A (3)));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - 6");
+     END;
+------------------------------------------------------------------------
+     DECLARE
+          REC1 : NULL_REC (2);
+     BEGIN
+          REC1.A (IDENT_INT(2)) := 1;
+
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 7");
+
+          BEGIN
+               COMMENT ("REC1.A (2) IS " & INTEGER'IMAGE(REC1.A (2)));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - 7");
+     END;
+------------------------------------------------------------------------
+     DECLARE
+          TYPE ACC_REC IS ACCESS NULL_CREC ('Z');
+          ACC_REC1 : ACC_REC := NEW NULL_CREC ('Z');
+     BEGIN
+          ACC_REC1.A (IDENT_CHAR('A')) := 4;
+
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 8");
+          BEGIN
+               COMMENT ("ACC_REC1.A (A) IS " &
+                         INTEGER'IMAGE(ACC_REC1.A ('A')));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - 8");
+     END;
+------------------------------------------------------------------------
+
+     RESULT;
+END C41104A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41105a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41105a.ada
new file mode 100644
index 000000000..1b5ad40f6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41105a.ada
@@ -0,0 +1,104 @@
+-- C41105A.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 CONSTRAINT_ERROR IS RAISED IF THE NAME PART OF AN
+--     INDEXED COMPONENT DENOTES AN ACCESS OBJECT WHOSE VALUE IS NULL,
+--     AND ALSO IF THE NAME IS A FUNCTION CALL DELIVERING NULL.
+
+-- HISTORY:
+--     WKB 07/29/81  CREATED ORIGINAL TEST.
+--     SPS 10/26/82
+--     JET 01/05/88  UPDATED HEADER FORMAT AND ADDED CODE TO PREVENT
+--                   OPTIMIZATION.
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41105A IS
+
+BEGIN
+     TEST ("C41105A", "CONSTRAINT_ERROR FROM NAMES DENOTING A NULL " &
+                      "ACCESS OBJECT AND A FUNCTION CALL DELIVERING " &
+                      "NULL");
+
+     DECLARE
+
+          TYPE T1 IS ARRAY (1..2) OF INTEGER;
+          TYPE A1 IS ACCESS T1;
+          B : A1 := NEW T1' (1,2);
+          I : INTEGER;
+
+     BEGIN
+
+          IF EQUAL (3,3) THEN
+               B := NULL;
+          END IF;
+
+          I := B(1);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
+
+          IF EQUAL (I,I) THEN
+               COMMENT ("NO EXCEPTION RAISED");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 1");
+
+     END;
+
+
+     DECLARE
+
+          TYPE T2 IS ARRAY (1..2) OF INTEGER;
+          TYPE A2 IS ACCESS T2;
+          I : INTEGER;
+
+          FUNCTION F RETURN A2 IS
+          BEGIN
+               IF EQUAL (3,3) THEN
+                    RETURN NULL;
+               END IF;
+               RETURN NEW T2' (1,2);
+          END F;
+
+     BEGIN
+
+          I := F(1);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
+
+          IF EQUAL (I,I) THEN
+               COMMENT ("NO EXCEPTION RAISED");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 2");
+
+     END;
+
+     RESULT;
+END C41105A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41107a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41107a.ada
new file mode 100644
index 000000000..13781fbf4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41107a.ada
@@ -0,0 +1,142 @@
+-- C41107A.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 ARRAY HAVING BOTH POSITIVE AND NEGATIVE
+--   INDEX VALUES, THE PROPER COMPONENT IS SELECTED - A.
+-- CHECK THAT FOR AN ARRAY INDEXED WITH AN ENUMERATION TYPE,
+--   APPROPRIATE COMPONENTS CAN BE SELECTED - B.
+-- CHECK THAT SUBSCRIPT EXPRESSIONS CAN BE OF COMPLEXITY GREATER
+--   THAN VARIABLE + - CONSTANT - C.
+-- CHECK THAT MULTIPLY DIMENSIONED ARRAYS ARE PROPERLY INDEXED - D.
+
+-- WKB 7/29/81
+-- JBG 8/21/83
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41107A IS
+
+     TYPE T1 IS ARRAY (INTEGER RANGE -2..2) OF INTEGER;
+     A : T1 := (1,2,3,4,5);
+
+     TYPE COLOR IS (RED,ORANGE,YELLOW,GREEN,BLUE);
+     TYPE T2 IS ARRAY (COLOR RANGE RED..BLUE) OF INTEGER;
+     B : T2 := (5,4,3,2,1);
+
+     C : STRING (1..7) := "ABCDEFG";
+
+     TYPE T4 IS ARRAY (1..4,1..3) OF INTEGER;
+     D : T4 := (1 => (1,2,3), 2 => (4,5,6), 3 => (7,8,9),
+                4 => (0,-1,-2));
+
+     V1 : INTEGER := IDENT_INT (1);
+     V2 : INTEGER := IDENT_INT (2);
+     V3 : INTEGER := IDENT_INT (3);
+
+     PROCEDURE P1 (X : IN INTEGER; Y : IN OUT INTEGER;
+                   Z : OUT INTEGER; W : STRING) IS
+     BEGIN
+          IF X /= 1 THEN
+               FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+          END IF;
+          IF Y /= 4 THEN
+               FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+          END IF;
+          Y := 11;
+          Z := 12;
+     END P1;
+
+     PROCEDURE P2 (X : IN CHARACTER; Y : IN OUT CHARACTER;
+                   Z : OUT CHARACTER) IS
+     BEGIN
+          IF X /= 'D' THEN
+               FAILED ("WRONG VALUE FOR IN PARAMETER - C");
+          END IF;
+          IF Y /= 'F' THEN
+               FAILED ("WRONG VALUE FOR IN OUT PARAMETER - C");
+          END IF;
+          Y := 'Y';
+          Z := 'Z';
+     END P2;
+
+BEGIN
+     TEST ("C41107A", "CHECK THAT THE PROPER COMPONENT IS SELECTED " &
+                      "FOR ARRAYS WITH POS AND NEG INDICES, " &  
+                      "ENUMERATION INDICES, COMPLEX SUBSCRIPT " &
+                      "EXPRESSIONS, AND MULTIPLE DIMENSIONS");
+
+     IF A(IDENT_INT(1)) /= 4 THEN 
+          FAILED ("WRONG VALUE FOR EXPRESSION - A");
+     END IF;
+     A(IDENT_INT(-2)) := 10;
+     IF A /= (10,2,3,4,5) THEN
+          FAILED ("WRONG TARGET FOR ASSIGNMENT - A");
+     END IF;
+     A := (2,1,0,3,4);
+     P1 (A(-1), A(2), A(-2), "A");
+     IF A /= (12,1,0,3,11) THEN
+          FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - A");
+     END IF;
+
+     IF B(GREEN) /= 2 THEN
+          FAILED ("WRONG VALUE FOR EXPRESSION - B");
+     END IF;
+     B(YELLOW) := 10;
+     IF B /= (5,4,10,2,1) THEN
+          FAILED ("WRONG TARGET FOR ASSIGNMENT - B");
+     END IF;
+     B := (1,4,2,3,5);
+     P1 (B(RED), B(ORANGE), B(BLUE), "B");
+     IF B /= (1,11,2,3,12) THEN
+          FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - B");
+     END IF;
+
+     IF C(3..6)(3**2 / 3 * (2-1) - 6 / 3 + 2) /= 'C' THEN
+          FAILED ("WRONG VALUE FOR EXPRESSION - C");
+     END IF;
+     C(3..6)(V3**2 / V1 * (V3-V2) + IDENT_INT(4) - V3 * V2 - V1) := 'W';
+     IF C /= "ABCDEWG" THEN
+          FAILED ("WRONG TARGET FOR ASSIGNMENT - C");
+     END IF;
+     C := "ABCDEFG";
+     P2 (C(3..6)(V3+V1), C(3..6)(V3*V2), C(3..6)((V1+V2)*V1));
+     IF C /= "ABZDEYG" THEN
+          FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - C");
+     END IF;
+
+     IF D(IDENT_INT(1),IDENT_INT(3)) /= 3 THEN
+          FAILED ("WRONG VALUE FOR EXPRESSION - D");
+     END IF;
+     D(IDENT_INT(4),IDENT_INT(2)) := 10;
+     IF D /= ((1,2,3),(4,5,6),(7,8,9),(0,10,-2)) THEN
+          FAILED ("WRONG TARGET FOR ASSIGNMENT - D");
+     END IF;
+     D := (1 => (0,2,3), 2 => (4,5,6), 3 => (7,8,9), 4 => (1,-1,-2));
+     P1 (D(4,1), D(2,1), D(3,2), "D");
+     IF D /= ((0,2,3),(11,5,6),(7,12,9),(1,-1,-2)) THEN
+          FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - D");
+     END IF;
+
+     RESULT;
+END C41107A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41201d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41201d.ada
new file mode 100644
index 000000000..a589ba765
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41201d.ada
@@ -0,0 +1,105 @@
+-- C41201D.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 SLICED COMPONENTS OF THE FORM F(...), CHECK THAT 
+--   THE REQUIREMENT FOR A ONE-DIMENSIONAL ARRAY AND THE
+--   TYPE OF THE INDEX ARE USED TO RESOLVE AN OVERLOADING OF F.
+
+-- WKB 8/11/81
+-- JBG 10/12/81
+-- SPS 11/1/82
+
+WITH REPORT;
+PROCEDURE C41201D IS
+
+     USE REPORT;
+
+     TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     SUBTYPE T1 IS T(1..10);
+     TYPE T2 IS ARRAY (1..10, 1..10) OF INTEGER;
+     TT : T(1..3);
+
+     SUBTYPE U1 IS T(1..10);
+     TYPE U2 IS (MON,TUE,WED,THU,FRI);
+     SUBTYPE SU2 IS U2 RANGE MON .. THU;
+     TYPE U3 IS ARRAY (SU2) OF INTEGER;
+     UU : T(1..3);
+
+     TYPE V IS ARRAY (INTEGER RANGE <> ) OF BOOLEAN;
+     SUBTYPE V1 IS V(1..10);
+     SUBTYPE V2 IS T(1..10);
+     VV : V(2..5);
+
+     FUNCTION F RETURN T1 IS
+     BEGIN
+          RETURN (1,1,1,1,5,6,7,8,9,10);
+     END F;
+
+     FUNCTION F RETURN T2 IS
+     BEGIN
+          RETURN (1..10 => (1,2,3,4,5,6,7,8,9,10));
+     END F;
+
+     FUNCTION G RETURN U1 IS
+     BEGIN
+          RETURN (3,3,3,3,5,6,7,8,9,10);
+     END G;
+
+     FUNCTION G RETURN U3 IS
+     BEGIN
+          RETURN (0,1,2,3);
+     END G;
+
+     FUNCTION H RETURN V1 IS
+     BEGIN
+          RETURN (1|3..10 => FALSE, 2 => IDENT_BOOL(TRUE));
+     END H;
+
+     FUNCTION H RETURN V2 IS
+     BEGIN
+          RETURN (1..10 => 5);
+     END H;
+
+BEGIN
+
+     TEST ("C41201D", "WHEN SLICING FUNCTION RESULTS, TYPE OF " &
+                      "RESULT IS USED FOR OVERLOADING RESOLUTION");
+
+     IF F(1..3) /=
+        F(IDENT_INT(2)..IDENT_INT(4)) THEN -- NUMBER OF DIMENSIONS.
+          FAILED ("WRONG VALUE - 1");
+     END IF;
+
+     IF G(1..3) /=
+        G(IDENT_INT(2)..IDENT_INT(4)) THEN -- INDEX TYPE.
+          FAILED ("WRONG VALUE - 2");
+     END IF;
+
+     IF NOT IDENT_BOOL(H(2..3)(2)) THEN    -- COMPONENT TYPE.
+          FAILED ("WRONG VALUE - 3");
+     END IF;
+
+     RESULT;
+
+END C41201D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41203a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41203a.ada
new file mode 100644
index 000000000..7e751650f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41203a.ada
@@ -0,0 +1,241 @@
+-- C41203A.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 NAME PART OF A SLICE MAY BE:
+--   AN IDENTIFIER DENOTING A ONE DIMENSIONAL ARRAY OBJECT - N1;
+--   AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
+--        DESIGNATES A ONE DIMENSIONAL ARRAY OBJECT - N2;
+--   A FUNCTION CALL DELIVERING A ONE DIMENSIONAL ARRAY OBJECT USING
+--        A PREDEFINED FUNCTION - &,
+--        A USER-DEFINED FUNCTION - F1;
+--   A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
+--        DESIGNATES A ONE DIMENSIONAL ARRAY - F2;
+--   A SLICE - N3;
+--   AN INDEXED COMPONENT DENOTING A ONE DIMENSIONAL ARRAY OBJECT
+--        (ARRAY OF ARRAYS) - N4;
+--   AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
+--        ENCLOSING ITS DECLARATION - C41203A.N1;
+--   A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
+--        ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
+-- CHECK THAT THE APPROPRIATE SLICE IS ACCESSED (FOR
+--   STATIC INDICES).
+
+-- WKB 8/5/81
+-- SPS 11/1/82
+-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41203A IS		
+
+     TYPE T1 IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     SUBTYPE A1 IS T1 (1..6);
+     N1 : A1 := (1,2,3,4,5,6);
+
+BEGIN
+     TEST ("C41203A", "CHECK THAT THE NAME PART OF A SLICE MAY BE " &
+                      "OF CERTAIN FORMS AND THAT THE APPROPRIATE " &
+                      "SLICE IS ACCESSED (FOR STATIC INDICES)");
+
+     DECLARE
+
+          TYPE T2 IS ARRAY (INTEGER RANGE <> ) OF BOOLEAN;
+          SUBTYPE A2 IS T2 (1..6);
+          TYPE A3 IS ACCESS A1;
+          SUBTYPE SI IS INTEGER RANGE 1 .. 3;
+          TYPE A4 IS ARRAY (SI) OF A1;
+          TYPE R (LENGTH : INTEGER) IS
+               RECORD
+                    S : STRING (1..LENGTH);
+               END RECORD;
+
+          N2 : A3 := NEW A1' (1,2,3,4,5,6);
+          N3 : T1 (1..7) := (1,2,3,4,5,6,7);
+          N4 : A4 := (1 => (1,2,3,4,5,6), 2 => (7,8,9,10,11,12),
+                      3 => (13,14,15,16,17,18));
+          N5 : R(6) := (LENGTH => 6, S => "ABCDEF");
+
+          FUNCTION F1 RETURN A2 IS
+          BEGIN
+               RETURN (FALSE,FALSE,TRUE,FALSE,TRUE,TRUE);
+          END F1;
+
+          FUNCTION F2 RETURN A3 IS
+          BEGIN
+               RETURN N2;
+          END F2;
+
+          PROCEDURE P1 (X : IN T1; Y : IN OUT T1;
+                        Z : OUT T1; W : IN STRING) IS
+          BEGIN
+               IF X /= (1,2) THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+               END IF;
+               IF Y /= (3,4) THEN
+                    FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+               END IF;
+               Y := (10,11);
+               Z := (12,13);
+          END P1;
+
+          PROCEDURE P2 (X : STRING) IS
+          BEGIN
+               IF X /= "BC" THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
+               END IF;
+          END P2;
+
+          PROCEDURE P3 (X : T2) IS
+          BEGIN
+               IF X /= (FALSE,TRUE,FALSE) THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
+               END IF;
+          END P3;
+
+          PROCEDURE P5 (X : IN STRING; Y : IN OUT STRING;
+                        Z : OUT STRING) IS
+          BEGIN 
+               IF X /= "EF" THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
+               END IF;
+               IF Y /= "CD" THEN
+                    FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
+               END IF;
+               Y := "XY";
+               Z := "WZ";
+          END P5;
+
+     BEGIN
+
+          IF N1(1..2) /= (1,2) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N1");
+          END IF;
+          N1(1..2) := (7,8);
+          IF N1 /= (7,8,3,4,5,6) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
+          END IF;
+          N1 := (1,2,3,4,5,6);
+          P1 (N1(1..2), N1(3..4), N1(5..6), "N1");
+          IF N1 /= (1,2,10,11,12,13) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
+          END IF;
+
+          IF N2(4..6) /= (4,5,6) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N2");
+          END IF;
+          N2(4..6) := (7,8,9);
+          IF N2.ALL /= (1,2,3,7,8,9) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
+          END IF;
+          N2.ALL := (1,2,5,6,3,4);
+          P1 (N2(1..2), N2(5..6), N2(3..4), "N2");
+          IF N2.ALL /= (1,2,12,13,10,11) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
+          END IF;
+
+          IF "&" (STRING'("AB"), STRING'("CDEF"))(4..6) /= STRING'("DEF") THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
+          END IF;
+          P2 ("&" ("AB", "CD")(2..3));
+
+          IF F1(1..2) /= (FALSE,FALSE) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - F1");
+          END IF;
+          P3 (F1(2..4));
+
+          N2 := NEW A1' (1,2,3,4,5,6);
+          IF F2(2..6) /= (2,3,4,5,6) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - F2");
+          END IF;
+          F2(3..3) := (5 => 7);
+          IF N2.ALL /= (1,2,7,4,5,6) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
+          END IF;
+          N2.ALL := (5,6,1,2,3,4);
+          P1 (F2(3..4), F2(5..6), F2(1..2), "F2");
+          IF N2.ALL /= (12,13,1,2,10,11) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
+          END IF;
+
+          IF N3(2..7)(2..4) /= (2,3,4) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N3");
+          END IF;
+          N3(2..7)(4..5) := (8,9);
+          IF N3 /= (1,2,3,8,9,6,7) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
+          END IF;
+          N3 := (5,3,4,1,2,6,7);
+          P1 (N3(2..7)(4..5), N3(2..7)(2..3), N3(2..7)(6..7), "N3");
+          IF N3 /= (5,10,11,1,2,12,13) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
+          END IF;
+
+          IF N4(1)(3..5) /= (3,4,5) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N4");
+          END IF;
+          N4(2)(1..3) := (21,22,23);
+          IF N4 /= ((1,2,3,4,5,6),(21,22,23,10,11,12),
+                    (13,14,15,16,17,18)) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
+          END IF;
+          N4 := (1 => (18,19,20,21,22,23), 2 => (17,16,15,1,2,14),
+                 3 => (7,3,4,5,6,8));
+          P1 (N4(2)(4..5), N4(3)(2..3), N4(1)(5..6), "N4");
+          IF N4 /= ((18,19,20,21,12,13),(17,16,15,1,2,14),
+                    (7,10,11,5,6,8)) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
+          END IF;
+
+          N1 := (1,2,3,4,5,6);
+          IF C41203A.N1(1..2) /= (1,2) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - C41203A.N1");
+          END IF;
+          C41203A.N1(1..2) := (7,8);
+          IF N1 /= (7,8,3,4,5,6) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - C41203A.N1");
+          END IF;
+          N1 := (1,2,3,4,5,6);
+          P1 (C41203A.N1(1..2), C41203A.N1(3..4), C41203A.N1(5..6),
+              "C41203A.N1");
+          IF N1 /= (1,2,10,11,12,13) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
+                       "- C41203A.N1");
+          END IF;
+
+          IF N5.S(1..5) /= "ABCDE" THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N5");
+          END IF;
+          N5.S(4..6) := "PQR";
+          IF N5.S /= "ABCPQR" THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
+          END IF;
+          N5.S := "ABCDEF";
+          P5 (N5.S(5..6), N5.S(3..4), N5.S(1..2));
+          IF N5.S /= "WZXYEF" THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
+          END IF;
+     END;
+
+     RESULT;
+END C41203A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41203b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41203b.ada
new file mode 100644
index 000000000..2bfb0952e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41203b.ada
@@ -0,0 +1,378 @@
+-- C41203B.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 NAME PART OF A SLICE MAY BE:
+--        AN IDENTIFIER DENOTING A ONE DIMENSIONAL ARRAY OBJECT - N1;
+--        AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE
+--           DESIGNATES A ONE DIMENSIONAL ARRAY OBJECT - N2;
+--        A FUNCTION CALL DELIVERING A ONE DIMENSIONAL ARRAY OBJECT
+--           USING PREDEFINED FUNCTIONS - &, AND THE LOGICAL OPERATORS
+--        A USER-DEFINED FUNCTION - F1;
+--        A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT
+--           DESIGNATES A ONE DIMENSIONAL ARRAY - F2;
+--        A SLICE - N3;
+--        AN INDEXED COMPONENT DENOTING A ONE DIMENSIONAL ARRAY OBJECT
+--           (ARRAY OF ARRAYS) - N4;
+--        AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
+--           ENCLOSING ITS DECLARATION - C41203B.N1;
+--        A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE
+--           ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5.
+--     CHECK THAT THE APPROPRIATE SLICE IS ACCESSED (FOR
+--     DYNAMIC INDICES).
+
+-- HISTORY:
+--     WKB 08/05/81  CREATED ORIGINAL TEST.
+--     SPS 02/04/83
+--     BCB 08/02/88  MODIFIED HEADER FORMAT AND ADDED CALLS TO THE
+--                   LOGICAL OPERATORS.
+--     BCB 04/16/90  ADDED TEST FOR PREFIX OF INDEXED COMPONENT HAVING
+--                   A LIMITED TYPE.
+--     PWN 11/30/94  SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41203B IS
+
+     TYPE T1 IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+     SUBTYPE A1 IS T1 (1..6);
+     N1 : A1 := (1,2,3,4,5,6);
+
+BEGIN
+     TEST ("C41203B", "CHECK THAT THE NAME PART OF A SLICE MAY BE " &
+                      "OF CERTAIN FORMS AND THAT THE APPROPRIATE " &
+                      "SLICE IS ACCESSED (FOR DYNAMIC INDICES)");
+
+     DECLARE
+
+          TYPE T2 IS ARRAY (INTEGER RANGE <> ) OF BOOLEAN;
+          SUBTYPE A2 IS T2 (1..6);
+          TYPE A3 IS ACCESS A1;
+          TYPE A4 IS ARRAY (INTEGER RANGE 1..3 ) OF A1;
+          TYPE R (LENGTH : INTEGER) IS
+               RECORD
+                    S : STRING (1..LENGTH);
+               END RECORD;
+
+          N2 : A3 := NEW A1'(1,2,3,4,5,6);
+          N3 : T1(1..7) := (1,2,3,4,5,6,7);
+          N4 : A4 := (1 => (1,2,3,4,5,6), 2 => (7,8,9,10,11,12),
+                      3 => (13,14,15,16,17,18));
+          N5 : R(6) := (LENGTH => 6, S => "ABCDEF");
+
+          M2A : A2 := (TRUE,TRUE,TRUE,FALSE,FALSE,FALSE);
+          M2B : A2 := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
+
+          FUNCTION F1 RETURN A2 IS
+          BEGIN
+               RETURN (FALSE,FALSE,TRUE,FALSE,TRUE,TRUE);
+          END F1;
+
+          FUNCTION F2 RETURN A3 IS
+          BEGIN
+               RETURN N2;
+          END F2;
+
+          PROCEDURE P1 (X : IN T1; Y : IN OUT T1;
+                        Z : OUT T1; W : IN STRING) IS
+          BEGIN
+               IF X /= (1,2) THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+               END IF;
+               IF Y /= (3,4) THEN
+                    FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+               END IF;
+               Y := (10,11);
+               Z := (12,13);
+          END P1;
+
+          PROCEDURE P2 (X : STRING) IS
+          BEGIN
+               IF X /= "BC" THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - '&'");
+               END IF;
+          END P2;
+
+          PROCEDURE P3 (X : T2) IS
+          BEGIN
+               IF X /= (FALSE,TRUE,FALSE) THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
+               END IF;
+          END P3;
+
+          PROCEDURE P5 (X : IN STRING; Y : IN OUT STRING;
+                        Z : OUT STRING) IS
+          BEGIN
+               IF X /= "EF" THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - N5");
+               END IF;
+               IF Y /= "CD" THEN
+                    FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5");
+               END IF;
+               Y := "XY";
+               Z := "WZ";
+          END P5;
+
+          PROCEDURE P6 (X : T2) IS
+          BEGIN
+               IF X /= (FALSE,FALSE,TRUE) THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - NOT");
+               END IF;
+          END P6;
+
+          PROCEDURE P7 (X : T2) IS
+          BEGIN
+               IF X /= (FALSE,TRUE,FALSE) THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - AND");
+               END IF;
+          END P7;
+
+          PROCEDURE P8 (X : T2) IS
+          BEGIN
+               IF X /= (FALSE,TRUE,FALSE) THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - OR");
+               END IF;
+          END P8;
+
+          PROCEDURE P9 (X : T2) IS
+          BEGIN
+               IF X /= (FALSE,TRUE,FALSE) THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - XOR");
+               END IF;
+          END P9;
+
+     BEGIN
+
+          IF N1(IDENT_INT(1)..IDENT_INT(2)) /= (1,2) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N1");
+          END IF;
+          N1(IDENT_INT(1)..IDENT_INT(2)) := (7,8);
+          IF N1 /= (7,8,3,4,5,6) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N1");
+          END IF;
+          N1 := (1,2,3,4,5,6);
+          P1 (N1(IDENT_INT(1)..IDENT_INT(2)),
+              N1(IDENT_INT(3)..IDENT_INT(4)),
+              N1(IDENT_INT(5)..IDENT_INT(6)), "N1");
+          IF N1 /= (1,2,10,11,12,13) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1");
+          END IF;
+
+          IF N2(IDENT_INT(4)..IDENT_INT(6)) /= (4,5,6) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N2");
+          END IF;
+          N2(IDENT_INT(4)..IDENT_INT(6)) := (7,8,9);
+          IF N2.ALL /= (1,2,3,7,8,9) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N2");
+          END IF;
+          N2.ALL := (1,2,5,6,3,4);
+          P1 (N2(IDENT_INT(1)..IDENT_INT(2)),
+              N2(IDENT_INT(5)..IDENT_INT(6)),
+              N2(IDENT_INT(3)..IDENT_INT(4)), "N2");
+          IF N2.ALL /= (1,2,12,13,10,11) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2");
+          END IF;
+
+          IF "&" (STRING'("AB"),STRING'("CDEF"))(IDENT_INT(4)..IDENT_INT(6)) 
+            /= STRING'("DEF") THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - '&'");
+          END IF;
+          P2 ("&" ("AB","CD")(IDENT_INT(2)..IDENT_INT(3)));
+
+          IF "NOT" (M2A)(IDENT_INT(3)..IDENT_INT(5)) /=
+             (FALSE,TRUE,TRUE) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - 'NOT'");
+          END IF;
+          P6 ("NOT" (M2A)(IDENT_INT(2)..IDENT_INT(4)));
+
+          IF "AND" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /=
+             (TRUE,FALSE,FALSE) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - 'AND'");
+          END IF;
+          P7 ("AND" (M2A,M2B)(IDENT_INT(2)..IDENT_INT(4)));
+
+          IF "OR" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /=
+             (TRUE,FALSE,TRUE) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - 'OR'");
+          END IF;
+          P8 ("OR" (M2A,M2B)(IDENT_INT(4)..IDENT_INT(6)));
+
+          IF "XOR" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /=
+             (FALSE,FALSE,TRUE) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - 'XOR'");
+          END IF;
+          P9 ("XOR" (M2A,M2B)(IDENT_INT(1)..IDENT_INT(3)));
+
+          IF F1(IDENT_INT(1)..IDENT_INT(2)) /= (FALSE,FALSE) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - F1");
+          END IF;
+          P3 (F1(IDENT_INT(2)..IDENT_INT(4)));
+
+          N2 := NEW A1'(1,2,3,4,5,6);
+          IF F2(IDENT_INT(2)..IDENT_INT(6)) /= (2,3,4,5,6) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - F2");
+          END IF;
+          F2(IDENT_INT(3)..IDENT_INT(3)) := (5 => 7);
+          IF N2.ALL /= (1,2,7,4,5,6) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
+          END IF;
+          N2.ALL := (5,6,1,2,3,4);
+          P1 (F2(IDENT_INT(3)..IDENT_INT(4)),
+              F2(IDENT_INT(5)..IDENT_INT(6)),
+              F2(IDENT_INT(1)..IDENT_INT(2)), "F2");
+          IF N2.ALL /= (12,13,1,2,10,11) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
+          END IF;
+
+          IF N3(2..7)(IDENT_INT(2)..IDENT_INT(4)) /= (2,3,4) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N3");
+          END IF;
+          N3(2..7)(IDENT_INT(4)..IDENT_INT(5)) := (8,9);
+          IF N3 /= (1,2,3,8,9,6,7) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N3");
+          END IF;
+          N3 := (5,3,4,1,2,6,7);
+          P1 (N3(2..7)(IDENT_INT(4)..IDENT_INT(5)),
+              N3(2..7)(IDENT_INT(2)..IDENT_INT(3)),
+              N3(2..7)(IDENT_INT(6)..IDENT_INT(7)), "N3");
+          IF N3 /= (5,10,11,1,2,12,13) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3");
+          END IF;
+
+          IF N4(1)(IDENT_INT(3)..IDENT_INT(5)) /= (3,4,5) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N4");
+          END IF;
+          N4(2)(IDENT_INT(1)..IDENT_INT(3)) := (21,22,23);
+          IF N4 /= ((1,2,3,4,5,6),(21,22,23,10,11,12),
+                    (13,14,15,16,17,18)) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N4");
+          END IF;
+          N4 := (1 => (18,19,20,21,22,23), 2 => (17,16,15,1,2,14),
+                 3 => (7,3,4,5,6,8));
+          P1 (N4(2)(IDENT_INT(4)..IDENT_INT(5)),
+              N4(3)(IDENT_INT(2)..IDENT_INT(3)),
+              N4(1)(IDENT_INT(5)..IDENT_INT(6)), "N4");
+          IF N4 /= ((18,19,20,21,12,13),(17,16,15,1,2,14),
+                    (7,10,11,5,6,8)) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4");
+          END IF;
+
+          N1 := (1,2,3,4,5,6);
+          IF C41203B.N1(IDENT_INT(1)..IDENT_INT(2)) /= (1,2) THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - C41203B.N1");
+          END IF;
+          C41203B.N1(IDENT_INT(1)..IDENT_INT(2)) := (7,8);
+          IF N1 /= (7,8,3,4,5,6) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - C41203B.N1");
+          END IF;
+          N1 := (1,2,3,4,5,6);
+          P1 (C41203B.N1(IDENT_INT(1)..IDENT_INT(2)),
+              C41203B.N1(IDENT_INT(3)..IDENT_INT(4)),
+              C41203B.N1(IDENT_INT(5)..IDENT_INT(6)), "C41203B.N1");
+          IF N1 /= (1,2,10,11,12,13) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " &
+                       "- C41203B.N1");
+          END IF;
+
+          IF N5.S(IDENT_INT(1)..IDENT_INT(5)) /= "ABCDE" THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - N5");
+          END IF;
+          N5.S(IDENT_INT(4)..IDENT_INT(6)) := "PQR";
+          IF N5.S /= "ABCPQR" THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - N5");
+          END IF;
+          N5.S := "ABCDEF";
+          P5 (N5.S(IDENT_INT(5)..IDENT_INT(6)),
+              N5.S(IDENT_INT(3)..IDENT_INT(4)),
+              N5.S(IDENT_INT(1)..IDENT_INT(2)));
+          IF N5.S /= "WZXYEF" THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5");
+          END IF;
+
+          DECLARE
+               PACKAGE P IS
+                    TYPE LIM IS LIMITED PRIVATE;
+                    TYPE A IS ARRAY(INTEGER RANGE <>) OF LIM;
+                    PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER);
+                    PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM);
+                    FUNCTION "=" (ONE,TWO : A) RETURN BOOLEAN;
+               PRIVATE
+                    TYPE LIM IS ARRAY(1..3) OF INTEGER;
+               END P;
+
+               USE P;
+
+               H : A(1..5);
+
+               N6 : A(1..3);
+
+               PACKAGE BODY P IS
+                    PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER) IS
+                    BEGIN
+                         V := (X,Y,Z);
+                    END INIT;
+
+                    PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM) IS
+                    BEGIN
+                         ONE := TWO;
+                    END ASSIGN;
+
+                    FUNCTION "=" (ONE,TWO : A) RETURN BOOLEAN IS
+                    BEGIN
+                         IF ONE(1) = TWO(2) AND ONE(2) = TWO(3) AND
+                           ONE(3) = TWO(4) THEN
+                              RETURN TRUE;
+                         ELSE
+                              RETURN FALSE;
+                         END IF;
+                    END "=";
+               END P;
+
+               FUNCTION FR RETURN A IS
+               BEGIN
+                    RETURN H;
+               END FR;
+
+          BEGIN
+               INIT (H(1),1,2,3);
+               INIT (H(2),4,5,6);
+               INIT (H(3),7,8,9);
+               INIT (H(4),10,11,12);
+               INIT (H(5),13,14,15);
+               INIT (N6(1),0,0,0);
+               INIT (N6(2),0,0,0);
+               INIT (N6(3),0,0,0);
+
+               ASSIGN (N6(1),H(2));
+               ASSIGN (N6(2),H(3));
+               ASSIGN (N6(3),H(4));
+
+               IF N6 /= FR(2..4) THEN
+                    FAILED ("WRONG VALUE FROM LIMITED COMPONENT TYPE");
+               END IF;
+          END;
+     END;
+
+     RESULT;
+END C41203B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41204a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41204a.ada
new file mode 100644
index 000000000..0ad8439b3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41204a.ada
@@ -0,0 +1,86 @@
+-- C41204A.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 IF A SLICE'S DISCRETE
+--   RANGE IS NOT NULL, AND ITS LOWER OR UPPER BOUND IS NOT A
+--   POSSIBLE INDEX FOR THE NAMED ARRAY.
+
+-- WKB 8/4/81
+-- EDS 7/14/98    AVOID OPTIMIZATION
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41204A IS
+
+BEGIN
+     TEST ("C41204A", "ILLEGAL UPPER OR LOWER BOUNDS FOR A " &
+                      "SLICE RAISES CONSTRAINT_ERROR");
+
+     DECLARE
+
+          TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+          A : T (10..15) := (10,11,12,13,14,15);
+          B : T (-20..30);
+
+     BEGIN
+
+          BEGIN
+               B (IDENT_INT(9)..12) := A (IDENT_INT(9)..12);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 1" &
+                       INTEGER'IMAGE(B(10)));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 1");
+          END;
+
+          BEGIN
+               B (IDENT_INT(-12)..14) := A (IDENT_INT(-12)..14);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 2" &
+                       INTEGER'IMAGE(B(10)));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 2");
+          END;
+
+          BEGIN
+               B (11..IDENT_INT(16)) := A (11..IDENT_INT(16));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 3" &
+                       INTEGER'IMAGE(B(15)));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 3");
+          END;
+
+          BEGIN
+               B (17..20) := A (IDENT_INT(17)..IDENT_INT(20));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 4" &
+                       INTEGER'IMAGE(B(17)));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 4");
+          END;
+     END;
+
+     RESULT;
+END C41204A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41205a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41205a.ada
new file mode 100644
index 000000000..220ae33cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41205a.ada
@@ -0,0 +1,94 @@
+-- C41205A.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 IF THE NAME PART OF A
+--   SLICE DENOTES AN ACCESS OBJECT WHOSE VALUE IS NULL, AND
+--   ALSO IF THE NAME IS A FUNCTION CALL DELIVERING NULL.
+
+-- WKB 8/6/81
+-- SPS 10/26/82
+-- EDS 07/14/98    AVOID OPTIMIZATION
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41205A IS
+
+BEGIN
+     TEST ("C41205A", "CONSTRAINT_ERROR WHEN THE NAME PART OF A " &
+                      "SLICE DENOTES A NULL ACCESS OBJECT OR A " &
+                      "FUNCTION CALL DELIVERING NULL");
+
+     DECLARE
+
+          TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+          SUBTYPE T1 IS T (1..5);
+          TYPE A1 IS ACCESS T1;
+          B : A1 := NEW T1' (1,2,3,4,5);
+          I : T (2..3);
+
+     BEGIN
+
+          IF EQUAL (3,3) THEN
+               B := NULL;
+          END IF;
+
+          I := B(2..3);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 1 " & INTEGER'IMAGE(I(2)));
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 1");
+
+     END;
+
+     DECLARE
+
+          TYPE T IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
+          SUBTYPE T2 IS T (1..5);
+          TYPE A2 IS ACCESS T2;
+          I : T (2..5);
+
+          FUNCTION F RETURN A2 IS
+          BEGIN
+               IF EQUAL (3,3) THEN
+                    RETURN NULL;
+               END IF;
+               RETURN NEW T2' (1,2,3,4,5);
+          END F;
+
+     BEGIN
+
+          I := F(2..5);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 2 " & INTEGER'IMAGE(I(2)));
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS           => FAILED ("WRONG EXCEPTION - 2");
+
+     END;
+
+     RESULT;
+END C41205A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41206a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41206a.ada
new file mode 100644
index 000000000..b12e43d19
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41206a.ada
@@ -0,0 +1,84 @@
+-- C41206A.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 RANGE L..R, WHERE L=SUCC(R) CAN BE USED TO FORM
+--   A NULL SLICE FROM AN ARRAY WHEN:
+--        BOTH L AND R SATISFY THE INDEX CONSTRAINT;
+--        L SATISFIES THE INDEX CONSTRAINT, R DOES NOT (BUT IT
+--             BELONGS TO THE BASE TYPE OF THE INDEX);
+--        L SATISFIES THE CONSTRAINT IMPOSED BY THE TYPE MARK OF
+--             THE INDEX, BUT NOT THE CONSTRAINT ASSOCIATED WITH
+--             THE INDEX;
+--        THE ARRAY IS NULL, AND L IS IN THE RANGE OF THE INDEX SUBTYPE.
+
+-- WKB 8/10/81
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41206A IS
+
+     TYPE SMALL IS RANGE 1..100;
+     TYPE T IS ARRAY (SMALL RANGE <> ) OF INTEGER;
+     SUBTYPE T1 IS T(5..10);
+     A : T1 := (5,6,7,8,9,10);
+     B : T(8..7) := (8..7 => 1);
+
+BEGIN
+     TEST ("C41206A", "USING A RANGE L..R, WHERE L=SUCC(R), " &
+                      "TO FORM A NULL SLICE FROM AN ARRAY");
+
+     BEGIN
+          IF A (7..6) /= B OR A (SMALL(IDENT_INT(7))..6) /= B THEN
+               FAILED ("SLICE NOT NULL - 1");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED - 1");
+     END;
+
+     BEGIN
+          IF A (5..4) /= B OR A (SMALL(IDENT_INT(5))..4) /= B THEN
+               FAILED ("SLICE NOT NULL - 2");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED - 2");
+     END;
+
+     BEGIN
+          IF A (50..49) /= B OR A (SMALL(IDENT_INT(50))..49) /= B THEN
+               FAILED ("SLICE NOT NULL - 3");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED - 3");
+     END;
+
+     BEGIN
+          IF B (50..49) /= B OR B (SMALL(IDENT_INT(50))..49) /= B THEN
+               FAILED ("SLICE NOT NULL - 4");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RAISED - 4");
+     END;
+
+     RESULT;
+END C41206A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41207a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41207a.ada
new file mode 100644
index 000000000..6f1807f4a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41207a.ada
@@ -0,0 +1,69 @@
+-- C41207A.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 DISCRETE RANGE IN A SLICE CAN HAVE THE FORM
+--     A'RANGE, WHERE A IS A CONSTRAINED ARRAY SUBTYPE OR AN ARRAY
+--     OBJECT.
+
+-- HISTORY:
+--     BCB 07/13/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C41207A IS
+
+     TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+
+     SUBTYPE A1 IS ARR(1..5);
+
+     ARR_VAR : ARR(1..10) := (90,91,92,93,94,95,96,97,98,99);
+
+     A2 : ARRAY(1..5) OF INTEGER := (80,81,82,83,84);
+
+BEGIN
+     TEST ("C41207A", "CHECK THAT THE DISCRETE RANGE IN A SLICE CAN " &
+                      "HAVE THE FORM A'RANGE, WHERE A IS A " &
+                      "CONSTRAINED ARRAY SUBTYPE OR AN ARRAY OBJECT");
+
+     ARR_VAR (A1'RANGE) := (1,2,3,4,5);
+
+     IF NOT (EQUAL(ARR_VAR(1),1) AND EQUAL(ARR_VAR(2),2) AND
+         EQUAL(ARR_VAR(3),3) AND EQUAL(ARR_VAR(4),4) AND
+         EQUAL(ARR_VAR(5),5)) THEN
+          FAILED ("IMPROPER RESULT FROM SLICE ASSIGNMENT USING THE " &
+                  "RANGE OF A CONSTRAINED ARRAY SUBTYPE");
+     END IF;
+
+     ARR_VAR (A2'RANGE) := (6,7,8,9,10);
+
+     IF (NOT EQUAL(ARR_VAR(1),6) OR NOT EQUAL(ARR_VAR(2),7) OR
+         NOT EQUAL(ARR_VAR(3),8) OR NOT EQUAL(ARR_VAR(4),9) OR
+         NOT EQUAL(ARR_VAR(5),10)) THEN
+          FAILED ("IMPROPER RESULT FROM SLICE ASSIGNMENT USING THE " &
+                  "RANGE OF AN ARRAY OBJECT");
+     END IF;
+
+     RESULT;
+END C41207A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41301a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41301a.ada
new file mode 100644
index 000000000..78017f5dc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41301a.ada
@@ -0,0 +1,216 @@
+-- C41301A.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 NOTATION L.R MAY BE USED TO DENOTE A RECORD COMPONENT,
+--   WHERE R IS THE IDENTIFIER OF SUCH COMPONENT, AND L MAY BE ANY OF
+--   THE FOLLOWING:
+--        AN IDENTIFIER DENOTING A RECORD OBJECT - X2;
+--        AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE DESIGNATES
+--           A RECORD OBJECT - X3;
+--        A FUNCTION CALL DELIVERING A RECORD VALUE - F1;
+--        A FUNCTION CALL DELIVERING AN ACCESS VALUE DESIGNATING A
+--           RECORD OBJECT - F2;
+--        AN INDEXED COMPONENT - X4;
+--        AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT
+--           ENCLOSING THE IDENTIFIER'S DECLARATION - C41301A.X1;
+--        A SELECTED COMPONENT DENOTING A RECORD (WHICH IS A COMPONENT
+--           OF ANOTHER RECORD) - X5.
+
+-- WKB 8/13/81
+-- JRK 8/17/81
+-- SPS 10/26/82
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41301A IS
+
+     TYPE T1 IS
+          RECORD
+               A : INTEGER;
+               B : BOOLEAN;
+               C : BOOLEAN;
+          END RECORD;
+     X1 : T1 := (A=>1, B=>TRUE, C=>FALSE);
+
+BEGIN
+     TEST ("C41301A", "CHECK THAT THE NOTATION L.R MAY BE USED TO " &
+                      "DENOTE A RECORD COMPONENT, WHERE R IS THE " &
+                      "IDENTIFIER AND L MAY BE OF CERTAIN FORMS");
+
+     DECLARE
+
+          TYPE T2 (DISC : INTEGER := 0) IS
+               RECORD
+                    D : BOOLEAN;
+                    E : INTEGER;
+                    F : BOOLEAN;
+                    CASE DISC IS
+                         WHEN 1 =>
+                              G : BOOLEAN;
+                         WHEN 2 =>
+                              H : INTEGER;
+                         WHEN OTHERS =>
+                              NULL;
+                    END CASE;
+               END RECORD;
+          X2 : T2(2) := (DISC=>2, D=>TRUE, E=>3, F=>FALSE, H=>1);
+
+          TYPE T3 IS ACCESS T1;
+          X3 : T3 := NEW T1' (A=>1, B=>TRUE, C=>FALSE);
+
+          TYPE T4 IS ARRAY (1..3) OF T1;
+          X4 : T4 := (1 => (1, TRUE, FALSE),
+                      2 => (2, FALSE, TRUE),
+                      3 => (3, TRUE, FALSE));
+
+          TYPE T5 IS
+               RECORD
+                    I : INTEGER;
+                    J : T1;
+               END RECORD;
+          X5 : T5 := (I => 5, J => (6, FALSE, TRUE));
+
+          FUNCTION F1 RETURN T2 IS
+          BEGIN
+               RETURN (DISC=>1, D=>FALSE, E=>3, F=>TRUE, G=>FALSE);
+          END F1;
+
+          FUNCTION F2 RETURN T3 IS
+          BEGIN
+               RETURN X3;
+          END F2;
+
+          PROCEDURE P1 (X : IN BOOLEAN; Y : IN OUT INTEGER;
+                        Z : OUT BOOLEAN; W : STRING) IS
+          BEGIN
+               IF X /= TRUE THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - " & W);
+               END IF;
+               IF Y /= 1 THEN
+                    FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W);
+               END IF;
+               Y := 10;
+               Z := TRUE;
+          END P1;
+
+          PROCEDURE P2 (X : IN INTEGER) IS
+          BEGIN
+               IF X /= 1 THEN
+                    FAILED ("WRONG VALUE FOR IN PARAMETER - F1");
+               END IF;
+          END P2;
+
+     BEGIN
+
+          IF X2.E /= 3 THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - X2");
+          END IF;
+          X2.E := 5;
+          IF X2 /= (2, TRUE, 5, FALSE, 1) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - X2");
+          END IF;
+          X2 := (DISC=>2, D=>TRUE, E=>3, F=>FALSE, H=>1);
+          P1 (X2.D, X2.H, X2.F, "X2");
+          IF X2 /= (2, TRUE, 3, TRUE, 10) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X2");
+          END IF;
+
+          IF X3.C /= FALSE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - X3");
+          END IF;
+          X3.A := 5;
+          IF X3.ALL /= (5, TRUE, FALSE) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - X3");
+          END IF;
+          X3 := NEW T1 '(A=>1, B=>TRUE, C=>FALSE);
+          P1 (X3.B, X3.A, X3.C, "X3");
+          IF X3.ALL /= (10, TRUE, TRUE) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X3");
+          END IF;
+
+          IF F1.G /= FALSE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - F1");
+          END IF;
+          P2 (F1.DISC);
+
+          X3 := NEW T1' (A=>3, B=>FALSE, C=>TRUE);
+          IF F2.B /= FALSE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - F2");
+          END IF;
+          F2.A := 4;
+          IF X3.ALL /= (4, FALSE, TRUE) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - F2");
+          END IF;
+          X3 := NEW T1' (A=>1, B=>FALSE, C=>TRUE);
+          P1 (F2.C, F2.A, F2.B, "F2");
+          IF X3.ALL /= (10, TRUE, TRUE) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2");
+          END IF;
+
+          IF X4(2).C /= TRUE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - X4");
+          END IF;
+          X4(3).A := 4;
+          IF X4 /= ((1,TRUE,FALSE), (2,FALSE,TRUE), (4,TRUE,FALSE)) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - X4");
+          END IF;
+          X4 := (1 => (2,TRUE,FALSE), 2 => (1,FALSE,TRUE),
+                 3 => (3,TRUE,FALSE));
+          P1 (X4(3).B, X4(2).A, X4(1).C, "X4");
+          IF X4 /= ((2,TRUE,TRUE), (10,FALSE,TRUE), (3,TRUE,FALSE)) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X4");
+          END IF;
+
+          X1 := (A=>1, B=>FALSE, C=>TRUE);
+          IF C41301A.X1.C /= TRUE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - C41301A.X1");
+          END IF;
+          C41301A.X1.B := TRUE;
+          IF X1 /= (1, TRUE, TRUE) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - C41301A.X1");
+          END IF;
+          X1 := (A=>1, B=>FALSE, C=>TRUE);
+          P1 (C41301A.X1.C, C41301A.X1.A, C41301A.X1.B, "C41301A.X1");
+          IF X1 /= (10, TRUE, TRUE) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - " &
+                       "C41301A.X1");
+          END IF;
+
+          IF X5.J.C /= TRUE THEN
+               FAILED ("WRONG VALUE FOR EXPRESSION - X5");
+          END IF;
+          X5.J.C := FALSE;
+          IF X5 /= (5, (6, FALSE, FALSE)) THEN
+               FAILED ("WRONG TARGET FOR ASSIGNMENT - X5");
+          END IF;
+          X5 := (I => 5, J => (A=>1, B=>TRUE, C=>FALSE));
+          P1 (X5.J.B, X5.J.A, X5.J.C, "X5");
+          IF X5 /= (5, (10, TRUE, TRUE)) THEN
+               FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - X5");
+          END IF;
+
+     END;
+
+     RESULT;
+END C41301A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303a.ada
new file mode 100644
index 000000000..4224effd7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303a.ada
@@ -0,0 +1,120 @@
+-- C41303A.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||  XXXXXXXXX  |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/20/82
+-- RM  1/25/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303A IS
+
+
+BEGIN
+
+     TEST ( "C41303A" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                    &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                    &   " DESIGNATING A RECORD, AN ARRAY, OR A SCALAR");
+
+
+     -------------------------------------------------------------------
+     --------------------  ACCESS TO RECORD  ---------------------------
+
+     DECLARE
+
+          TYPE  REC  IS
+
+               RECORD
+                    A , B , C : INTEGER ;
+               END RECORD ;
+
+          REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
+          REC_VAR      :  REC  :=    REC_CONST  ;
+
+          TYPE  ACC_REC  IS  ACCESS REC ;
+
+          ACC_REC_VAR  :  ACC_REC  :=  NEW REC'( 17 , 18 , 19 );
+
+     BEGIN
+
+          REC_VAR          :=  ACC_REC_VAR.ALL ;
+
+          IF  REC_VAR /= ( 17 , 18 , 19 )
+          THEN
+               FAILED( "ACC. RECORD, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
+          END IF;
+
+
+          ACC_REC_VAR.ALL  :=  REC_CONST ;
+
+          IF  ACC_REC_VAR.ALL /= ( 7 , 8 , 9 )
+          THEN
+               FAILED( "ACC. RECORD, LEFT SIDE OF ASSIGN.,WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303b.ada
new file mode 100644
index 000000000..cb6c1ab6b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303b.ada
@@ -0,0 +1,117 @@
+-- C41303B.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||  XXXXXXXXX  |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/20/82
+-- RM  1/25/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303B IS
+
+
+BEGIN
+
+     TEST ( "C41303B" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                    &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                    &   " DESIGNATING A RECORD, AN ARRAY, OR A SCALAR");
+
+
+     -------------------------------------------------------------------
+     --------------------  ACCESS TO ARRAY  ----------------------------
+
+     DECLARE
+
+          TYPE  ARR  IS  ARRAY(1..2) OF BOOLEAN ;
+
+          ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
+          ARR_VAR      :  ARR  :=    ARR_CONST  ;
+
+          TYPE  ACC_ARR  IS  ACCESS ARR ;
+
+          ACC_ARR_VAR  :  ACC_ARR  :=  NEW ARR'( FALSE , TRUE );
+
+     BEGIN
+
+          ARR_VAR          :=  ACC_ARR_VAR.ALL ;
+
+          IF  ARR_VAR /= ( FALSE , TRUE )
+          THEN
+               FAILED( "ACC. ARRAY, RIGHT SIDE OF ASSIGN., WRONG VAL.");
+          END IF;
+
+
+          ACC_ARR_VAR.ALL  :=  ARR_CONST ;
+
+          IF  ACC_ARR_VAR.ALL /= ( TRUE , FALSE )
+          THEN
+               FAILED( "ACC. ARRAY, LEFT SIDE OF ASSIGN., WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303c.ada
new file mode 100644
index 000000000..d68872539
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303c.ada
@@ -0,0 +1,116 @@
+-- C41303C.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||  XXXXXXXXX  |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/20/82
+-- RM  1/25/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303C IS
+
+
+BEGIN
+
+     TEST ( "C41303C" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                    &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                    &   " DESIGNATING A RECORD, AN ARRAY, OR A SCALAR");
+
+
+     -------------------------------------------------------------------
+     --------------------  ACCESS TO SCALAR  ---------------------------
+
+     DECLARE
+
+          TYPE  NEWINT  IS  NEW INTEGER ;
+
+          NEWINT_CONST    :  NEWINT  :=  813 ;
+          NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
+
+          TYPE  ACC_NEWINT  IS  ACCESS NEWINT ;
+
+          ACC_NEWINT_VAR  :  ACC_NEWINT  :=  NEW NEWINT'( 707 );
+
+     BEGIN
+
+          NEWINT_VAR          :=  ACC_NEWINT_VAR.ALL ;
+
+          IF  NEWINT_VAR /= ( 707 )
+          THEN
+               FAILED( "ACC. NEWINT, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
+          END IF;
+
+
+          ACC_NEWINT_VAR.ALL  :=  NEWINT_CONST ;
+
+          IF  ACC_NEWINT_VAR.ALL /= 813 
+          THEN
+               FAILED( "ACC. NEWINT, LEFT SIDE OF ASSIGN.,WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303e.ada
new file mode 100644
index 000000000..f49dae27c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303e.ada
@@ -0,0 +1,124 @@
+-- C41303E.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||  XXXXXXXXX  |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/20/82
+-- RM  1/25/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303E IS
+
+
+BEGIN
+
+     TEST ( "C41303E" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                    &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                    &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
+
+     DECLARE
+
+          TYPE  REC  IS
+
+               RECORD
+                    A , B , C : INTEGER ;
+               END RECORD ;
+
+
+          TYPE  ACCREC  IS  ACCESS REC ;
+
+          ACCREC_CONST    :  ACCREC  :=  NEW REC'( 7 , 8 , 9 );
+          ACCREC_VAR      :  ACCREC  :=    ACCREC_CONST  ;
+          ACCREC_CONST2   :  ACCREC  :=  NEW REC'( 17 , 18 , 19 );
+
+          TYPE  ACC_ACCREC  IS  ACCESS ACCREC ;
+
+          ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'(ACCREC_CONST2);
+
+     BEGIN
+
+          ACCREC_VAR          :=  ACC_ACCREC_VAR.ALL ;
+
+          IF  ACCREC_VAR /= ACCREC_CONST2
+          THEN
+               FAILED( "ACC2 RECORD, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
+          END IF;
+
+
+          ACC_ACCREC_VAR.ALL  :=  ACCREC_CONST ;
+
+          IF  ACCREC_CONST /= ACC_ACCREC_VAR.ALL 
+          THEN
+               FAILED( "ACC2 RECORD, LEFT SIDE OF ASSIGN.,WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303f.ada
new file mode 100644
index 000000000..aa474cd8d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303f.ada
@@ -0,0 +1,117 @@
+-- C41303F.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||  XXXXXXXXX  |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/20/82
+-- RM  1/25/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303F IS
+
+BEGIN
+
+     TEST ( "C41303F" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                    &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                    &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
+
+     DECLARE
+
+          TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
+          TYPE  ACCARR  IS  ACCESS ARR ;
+
+          ACCARR_CONST    :  ACCARR  :=  NEW ARR'( TRUE , FALSE );
+          ACCARR_VAR      :  ACCARR  :=    ACCARR_CONST  ;
+          ACCARR_CONST2   :  ACCARR  :=  NEW ARR'( FALSE , TRUE );
+
+          TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
+
+          ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(ACCARR_CONST2);
+
+     BEGIN
+
+          ACCARR_VAR          :=  ACC_ACCARR_VAR.ALL ;
+
+          IF  ACCARR_VAR /= ACCARR_CONST2
+          THEN
+               FAILED( "ACC2 ARRAY, RIGHT SIDE OF ASSIGN., WRONG VAL.");
+          END IF;
+
+
+          ACC_ACCARR_VAR.ALL  :=  ACCARR_CONST ;
+
+          IF  ACCARR_CONST /= ACC_ACCARR_VAR.ALL
+          THEN
+               FAILED( "ACC2 ARRAY, LEFT SIDE OF ASSIGN., WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303g.ada
new file mode 100644
index 000000000..39a6aa3f7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303g.ada
@@ -0,0 +1,121 @@
+-- C41303G.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||  XXXXXXXXX  |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/20/82
+-- RM  1/25/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303G IS
+
+
+BEGIN
+
+     TEST ( "C41303G" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                    &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                    &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
+
+     DECLARE
+
+          TYPE  NEWINT  IS  NEW INTEGER ;
+
+          TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
+
+          ACCNEWINT_CONST    :  ACCNEWINT  :=  NEW NEWINT'( 813 );
+          ACCNEWINT_VAR      :  ACCNEWINT  :=  ACCNEWINT_CONST  ;
+          ACCNEWINT_CONST2   :  ACCNEWINT  :=  NEW NEWINT'( 707 );
+
+          TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
+
+          ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                       ACCNEWINT_CONST2
+                                                                );
+
+     BEGIN
+
+          ACCNEWINT_VAR          :=  ACC_ACCNEWINT_VAR.ALL ;
+
+          IF  ACCNEWINT_VAR /= ACCNEWINT_CONST2
+          THEN
+               FAILED( "ACC2 NEWINT, RIGHT SIDE OF ASSIGN.,WRONG VAL.");
+          END IF;
+
+
+          ACC_ACCNEWINT_VAR.ALL  :=  ACCNEWINT_CONST ;
+
+          IF  ACCNEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL
+          THEN
+               FAILED( "ACC2 NEWINT, LEFT SIDE OF ASSIGN.,WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303i.ada
new file mode 100644
index 000000000..1c0aff25a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303i.ada
@@ -0,0 +1,127 @@
+-- C41303I.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||  XXXXXXXXX  |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/20/82
+-- RM  1/25/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303I IS
+
+
+BEGIN
+
+     TEST ( "C41303I" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                        " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                        " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                        " ACCEPTED" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
+
+     DECLARE
+
+          TYPE  REC  IS
+
+               RECORD
+                    A , B , C : INTEGER ;
+               END RECORD ;
+
+
+          REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
+          REC_VAR      :  REC  :=    REC_CONST  ;
+          REC_CONST2   :  REC  :=  ( 17 , 18 , 19 );
+
+          TYPE  ACCREC  IS  ACCESS REC ;
+
+          TYPE  ACC_ACCREC  IS  ACCESS ACCREC ;
+
+          ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'( 
+                                            NEW REC'( REC_CONST2 )
+                                                      );
+
+     BEGIN
+
+          REC_VAR          :=  ACC_ACCREC_VAR.ALL.ALL ;
+
+          IF  REC_VAR /= REC_CONST2
+          THEN
+               FAILED( "ACC2 RECORD,RIGHT SIDE OF ASSIGN., WRONG VAL.");
+          END IF;
+
+
+          ACC_ACCREC_VAR.ALL.ALL  :=  REC_CONST ;
+
+          IF  ( 7 , 8 , 9 ) /= ACC_ACCREC_VAR.ALL.ALL 
+          THEN
+               FAILED( "ACC2 RECORD, LEFT SIDE OF ASSIGN., WRONG VAL.");
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303j.ada
new file mode 100644
index 000000000..fad2a394e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303j.ada
@@ -0,0 +1,122 @@
+-- C41303J.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||  XXXXXXXXX  |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/20/82
+-- RM  1/25/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303J IS
+
+
+BEGIN
+
+     TEST ( "C41303J" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                        " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                        " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                        " ACCEPTED" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
+
+     DECLARE
+
+          TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
+
+          ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
+          ARR_VAR      :  ARR  :=    ARR_CONST  ;
+          ARR_CONST2   :  ARR  :=  ( FALSE , TRUE );
+
+          TYPE  ACCARR  IS  ACCESS ARR ;
+
+          TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
+
+          ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(
+                                            NEW ARR'( ARR_CONST2 )
+                                                      );
+
+     BEGIN
+
+          ARR_VAR          :=  ACC_ACCARR_VAR.ALL.ALL ;
+
+          IF  ARR_VAR /= ARR_CONST2
+          THEN
+               FAILED( "ACC2 ARRAY, RIGHT SIDE OF ASSIGN., WRONG VAL.");
+          END IF;
+
+
+          ACC_ACCARR_VAR.ALL.ALL  :=  ARR_CONST ;
+
+          IF  ( TRUE , FALSE ) /= ACC_ACCARR_VAR.ALL.ALL
+          THEN
+               FAILED( "ACC2 ARRAY, LEFT SIDE OF ASSIGN., WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303k.ada
new file mode 100644
index 000000000..bb6f2a785
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303k.ada
@@ -0,0 +1,124 @@
+-- C41303K.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||  XXXXXXXXX  |
+--      ============================================================
+
+
+-- RM  1/20/82
+-- RM  1/25/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303K IS
+
+
+BEGIN
+
+     TEST ( "C41303K" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                        " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                        " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                        " ACCEPTED" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
+
+     DECLARE
+
+          TYPE  NEWINT  IS  NEW INTEGER ;
+
+          NEWINT_CONST    :  NEWINT  :=  ( 813 );
+          NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
+          NEWINT_CONST2   :  NEWINT  :=  ( 707 );
+
+          TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
+
+          TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
+
+          ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                   NEW NEWINT' ( 
+                                                   NEWINT_CONST2
+                                                              )
+                                                                );
+
+     BEGIN
+
+          NEWINT_VAR          :=  ACC_ACCNEWINT_VAR.ALL.ALL ;
+
+          IF  NEWINT_VAR /= NEWINT_CONST2
+          THEN
+               FAILED( "ACC2 NEWINT,RIGHT SIDE OF ASSIGN., WRONG VAL.");
+          END IF;
+
+
+          ACC_ACCNEWINT_VAR.ALL.ALL  :=  NEWINT_CONST ;
+
+          IF  NEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL.ALL
+          THEN
+               FAILED( "ACC2 NEWINT,LEFT SIDE OF ASSIGN., WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303m.ada
new file mode 100644
index 000000000..f0c13d3eb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303m.ada
@@ -0,0 +1,150 @@
+-- C41303M.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |     XXXXXXXXX
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/22/82
+-- RM  1/26/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303M IS
+
+
+BEGIN
+
+     TEST ( "C41303M" , "CHECK THAT  L.ALL  , WHERE  L  IS THE NAME OF"
+                      & " AN ACCESS OBJECT DESIGNATING A RECORD, AN"
+                      & " ARRAY, OR A SCALAR,  IS ALLOWED AS"
+                      & " ACTUAL PARAMETER OF ANY MODE" );
+
+
+     -------------------------------------------------------------------
+     --------------------  ACCESS TO RECORD  ---------------------------
+
+     DECLARE
+
+          TYPE  REC  IS
+
+               RECORD
+                    A , B , C : INTEGER ;
+               END RECORD ;
+
+          REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
+          REC_VAR      :  REC  :=    REC_CONST  ;
+          REC_VAR0     :  REC  :=    REC_CONST  ;
+
+          TYPE  ACC_REC  IS  ACCESS REC ;
+
+          ACC_REC_VAR  :  ACC_REC  :=  NEW REC'( 17 , 18 , 19 );
+          ACC_REC_VAR0 :  ACC_REC  :=  NEW REC'( 17 , 18 , 19 );
+
+
+          PROCEDURE  R_ASSIGN( R_IN    : IN      REC ;
+                               R_INOUT : IN OUT  REC )  IS
+          BEGIN
+               REC_VAR   :=  R_IN    ;
+               REC_VAR0  :=  R_INOUT ;
+          END ;
+
+
+          PROCEDURE  L_ASSIGN( L_OUT   :    OUT  REC ;
+                               L_INOUT : IN OUT  REC )  IS
+          BEGIN
+               L_OUT   :=  REC_CONST ;
+               L_INOUT :=  REC_CONST ;
+          END ;
+
+     BEGIN
+
+          R_ASSIGN( ACC_REC_VAR.ALL , ACC_REC_VAR0.ALL );
+
+          IF  REC_VAR /= ( 17 , 18 , 19 )
+          THEN
+               FAILED( "ACC. RECORD, RIGHT SIDE (1), WRONG VAL.");
+          END IF;
+
+          IF  REC_VAR0 /= ( 17 , 18 , 19 )
+          THEN
+               FAILED( "ACC. RECORD, RIGHT SIDE (2), WRONG VAL.");
+          END IF;
+
+
+          L_ASSIGN( ACC_REC_VAR.ALL , ACC_REC_VAR0.ALL );
+
+          IF  ACC_REC_VAR.ALL /= ( 7 , 8 , 9 )
+          THEN
+              FAILED( "ACC. RECORD, LEFT SIDE (1), WRONG VAL." );
+          END IF;
+
+
+          IF  ACC_REC_VAR0.ALL /= ( 7 , 8 , 9 )
+          THEN
+               FAILED( "ACC. RECORD, LEFT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303n.ada
new file mode 100644
index 000000000..431d01e6d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303n.ada
@@ -0,0 +1,147 @@
+-- C41303N.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |     XXXXXXXXX
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/22/82
+-- RM  1/26/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303N IS
+
+
+BEGIN
+
+     TEST ( "C41303N" , "CHECK THAT  L.ALL  , WHERE  L  IS THE NAME OF"
+                      & " AN ACCESS OBJECT DESIGNATING A RECORD, AN"
+                      & " ARRAY, OR A SCALAR,  IS ALLOWED AS"
+                      & " ACTUAL PARAMETER OF ANY MODE" );
+
+
+     -------------------------------------------------------------------
+     --------------------  ACCESS TO ARRAY  ----------------------------
+
+     DECLARE
+
+          TYPE  ARR  IS  ARRAY(1..2) OF BOOLEAN ;
+
+          ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
+          ARR_VAR      :  ARR  :=    ARR_CONST  ;
+          ARR_VAR0     :  ARR  :=    ARR_CONST  ;
+
+          TYPE  ACC_ARR  IS  ACCESS ARR ;
+
+          ACC_ARR_VAR  :  ACC_ARR  :=  NEW ARR'( FALSE , TRUE );
+          ACC_ARR_VAR0 :  ACC_ARR  :=  NEW ARR'( FALSE , TRUE );
+
+
+          PROCEDURE  R_ASSIGN( R_IN    : IN      ARR ;
+                               R_INOUT : IN OUT  ARR )  IS
+          BEGIN
+               ARR_VAR   :=  R_IN    ;
+               ARR_VAR0  :=  R_INOUT ;
+          END ;
+
+
+          PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ARR ;
+                               L_INOUT : IN OUT  ARR )  IS
+          BEGIN
+               L_OUT   :=  ARR_CONST ;
+               L_INOUT :=  ARR_CONST ;
+          END ;
+
+     BEGIN
+
+
+          R_ASSIGN( ACC_ARR_VAR.ALL , ACC_ARR_VAR0.ALL );
+
+          IF  ARR_VAR /= ( FALSE , TRUE )                   
+          THEN
+               FAILED( "ACC. ARRAY, RIGHT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  ARR_VAR0 /= ( FALSE , TRUE )
+          THEN
+               FAILED( "ACC. ARRAY, RIGHT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+          L_ASSIGN( ACC_ARR_VAR.ALL , ACC_ARR_VAR0.ALL );
+
+          IF  ACC_ARR_VAR.ALL /= ( TRUE , FALSE )
+          THEN
+               FAILED( "ACC. ARRAY, LEFT SIDE (1), WRONG VAL." );
+          END IF;
+
+
+          IF  ACC_ARR_VAR0.ALL /= ( TRUE , FALSE )
+          THEN
+               FAILED( "ACC. ARRAY, LEFT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303o.ada
new file mode 100644
index 000000000..8f488bde6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303o.ada
@@ -0,0 +1,145 @@
+-- C41303O.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |     XXXXXXXXX
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/27/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303O IS
+
+
+BEGIN
+
+     TEST ( "C41303O" , "CHECK THAT  L.ALL  , WHERE  L  IS THE NAME OF"
+                      & " AN ACCESS OBJECT DESIGNATING A RECORD, AN"
+                      & " ARRAY, OR A SCALAR,  IS ALLOWED AS"
+                      & " ACTUAL PARAMETER OF ANY MODE" );
+
+
+     -------------------------------------------------------------------
+     --------------------  ACCESS TO SCALAR  ---------------------------
+
+     DECLARE
+
+          TYPE  NEWINT  IS  NEW INTEGER ;
+
+          NEWINT_CONST    :  NEWINT  :=  813 ;
+          NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
+          NEWINT_VAR0     :  NEWINT  :=  NEWINT_CONST  ;
+
+          TYPE  ACC_NEWINT  IS  ACCESS NEWINT ;
+
+          ACC_NEWINT_VAR  :  ACC_NEWINT  :=  NEW NEWINT'( 707 );
+          ACC_NEWINT_VAR0 :  ACC_NEWINT  :=  NEW NEWINT'( 707 );
+
+
+          PROCEDURE  R_ASSIGN( R_IN    : IN      NEWINT ;
+                               R_INOUT : IN OUT  NEWINT )  IS
+          BEGIN
+               NEWINT_VAR   :=  R_IN    ;
+               NEWINT_VAR0  :=  R_INOUT ;
+          END ;
+
+
+          PROCEDURE  L_ASSIGN( L_OUT   :    OUT  NEWINT ;
+                               L_INOUT : IN OUT  NEWINT )  IS
+          BEGIN
+               L_OUT   :=  NEWINT_CONST ;
+               L_INOUT :=  NEWINT_CONST ;
+          END ;
+
+
+     BEGIN
+
+          R_ASSIGN( ACC_NEWINT_VAR.ALL , ACC_NEWINT_VAR0.ALL );
+
+          IF  NEWINT_VAR /= ( 707 )
+          THEN
+               FAILED( "ACC. NEWINT, RIGHT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  NEWINT_VAR0 /= ( 707 )
+          THEN
+               FAILED( "ACC. NEWINT, RIGHT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+          L_ASSIGN( ACC_NEWINT_VAR.ALL , ACC_NEWINT_VAR0.ALL );
+
+          IF  ACC_NEWINT_VAR.ALL /= 813 
+          THEN
+               FAILED( "ACC. NEWINT, LEFT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  ACC_NEWINT_VAR0.ALL /= 813 
+          THEN
+               FAILED( "ACC. NEWINT, LEFT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303q.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303q.ada
new file mode 100644
index 000000000..bf8756240
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303q.ada
@@ -0,0 +1,152 @@
+-- C41303Q.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |     XXXXXXXXX
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/28/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303Q IS
+
+
+BEGIN
+
+     TEST ( "C41303Q" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                    &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                    &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
+
+     DECLARE
+
+          TYPE  REC  IS
+
+               RECORD
+                    A , B , C : INTEGER ;
+               END RECORD ;
+
+
+          TYPE  ACCREC  IS  ACCESS REC ;
+
+          ACCREC_CONST    :  ACCREC  :=  NEW REC'( 7 , 8 , 9 );
+          ACCREC_VAR      :  ACCREC  :=    ACCREC_CONST ;
+          ACCREC_VAR0     :  ACCREC  :=    ACCREC_CONST ;
+          ACCREC_CONST2   :  ACCREC  :=  NEW REC'( 17 , 18 , 19 );
+
+          TYPE ACC_ACCREC  IS  ACCESS ACCREC ;
+
+          ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'(ACCREC_CONST2);
+          ACC_ACCREC_VAR0 :  ACC_ACCREC :=  NEW ACCREC'(ACCREC_CONST2);
+
+          PROCEDURE  R_ASSIGN( R_IN    : IN      ACCREC ;
+                               R_INOUT : IN OUT  ACCREC )  IS
+          BEGIN
+               ACCREC_VAR   :=  R_IN    ;
+               ACCREC_VAR0  :=  R_INOUT ;
+          END ;
+
+
+          PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ACCREC ;
+                               L_INOUT : IN OUT  ACCREC )  IS
+          BEGIN
+               L_OUT   :=  ACCREC_CONST ;
+               L_INOUT :=  ACCREC_CONST ;
+          END ;
+
+
+     BEGIN
+
+
+          R_ASSIGN( ACC_ACCREC_VAR.ALL , ACC_ACCREC_VAR0.ALL );
+
+          IF  ACCREC_VAR /= ACCREC_CONST2
+          THEN
+               FAILED( "ACC. RECORD, RIGHT SIDE (1), WRONG VAL.");
+          END IF;
+
+          IF  ACCREC_VAR0 /= ACCREC_CONST2
+          THEN
+               FAILED( "ACC. RECORD, RIGHT SIDE (2), WRONG VAL.");
+          END IF;
+
+
+          L_ASSIGN( ACC_ACCREC_VAR.ALL , ACC_ACCREC_VAR0.ALL );
+
+          IF  ACCREC_CONST /= ACC_ACCREC_VAR.ALL 
+          THEN
+              FAILED( "ACC. RECORD, LEFT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  ACCREC_CONST /= ACC_ACCREC_VAR0.ALL 
+          THEN
+               FAILED( "ACC. RECORD, LEFT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303Q;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303r.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303r.ada
new file mode 100644
index 000000000..b219e3c74
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303r.ada
@@ -0,0 +1,145 @@
+-- C41303R.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |     XXXXXXXXX
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/28/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303R IS
+
+BEGIN
+
+     TEST ( "C41303R" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                    &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                    &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
+
+     DECLARE
+
+          TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
+          TYPE  ACCARR  IS  ACCESS ARR ;
+
+          ACCARR_CONST    :  ACCARR  :=  NEW ARR'( TRUE , FALSE );
+          ACCARR_VAR      :  ACCARR  :=    ACCARR_CONST  ;
+          ACCARR_VAR0     :  ACCARR  :=    ACCARR_CONST  ;
+          ACCARR_CONST2   :  ACCARR  :=  NEW ARR'( FALSE , TRUE );
+
+          TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
+
+          ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(ACCARR_CONST2);
+          ACC_ACCARR_VAR0 :  ACC_ACCARR :=  NEW ACCARR'(ACCARR_CONST2);
+
+
+          PROCEDURE  R_ASSIGN( R_IN    : IN      ACCARR ;
+                               R_INOUT : IN OUT  ACCARR )  IS
+          BEGIN
+               ACCARR_VAR   :=  R_IN    ;
+               ACCARR_VAR0  :=  R_INOUT ;
+          END ;
+
+
+          PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ACCARR ;
+                               L_INOUT : IN OUT  ACCARR )  IS
+          BEGIN
+               L_OUT   :=  ACCARR_CONST ;
+               L_INOUT :=  ACCARR_CONST ;
+          END ;
+
+
+     BEGIN
+
+          R_ASSIGN( ACC_ACCARR_VAR.ALL, ACC_ACCARR_VAR0.ALL );
+
+          IF  ACCARR_VAR /= ACCARR_CONST2
+          THEN
+               FAILED( "ACC2 ARRAY, RIGHT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  ACCARR_VAR0 /= ACCARR_CONST2
+          THEN
+               FAILED( "ACC2 ARRAY, RIGHT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+          L_ASSIGN( ACC_ACCARR_VAR.ALL , ACC_ACCARR_VAR0.ALL );
+
+          IF  ACCARR_CONST /= ACC_ACCARR_VAR.ALL
+          THEN
+               FAILED( "ACC2. ARRAY, LEFT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  ACCARR_CONST /= ACC_ACCARR_VAR0.ALL
+          THEN
+               FAILED( "ACC2. ARRAY, LEFT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303R;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303s.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303s.ada
new file mode 100644
index 000000000..09ce2f49e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303s.ada
@@ -0,0 +1,151 @@
+-- C41303S.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |     XXXXXXXXX
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/28/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303S IS
+
+
+BEGIN
+
+     TEST ( "C41303S" , "CHECK THAT THE NOTATION  L.ALL  IS ALLOWED IF"
+                    &   "  L  IS THE NAME OF AN ACCESS OBJECT"
+                    &   " DESIGNATING  ANOTHER ACCESS OBJECT" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
+
+     DECLARE
+
+          TYPE  NEWINT  IS  NEW INTEGER ;
+
+          TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
+
+          ACCNEWINT_CONST    :  ACCNEWINT  :=  NEW NEWINT'( 813 );
+          ACCNEWINT_VAR      :  ACCNEWINT  :=  ACCNEWINT_CONST  ;
+          ACCNEWINT_VAR0     :  ACCNEWINT  :=  ACCNEWINT_CONST  ;
+          ACCNEWINT_CONST2   :  ACCNEWINT  :=  NEW NEWINT'( 707 );
+
+          TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
+
+          ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                       ACCNEWINT_CONST2
+                                                                );
+
+          ACC_ACCNEWINT_VAR0 :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                       ACCNEWINT_CONST2
+                                                                );
+
+          PROCEDURE  R_ASSIGN( R_IN    : IN      ACCNEWINT ;
+                               R_INOUT : IN OUT  ACCNEWINT )  IS
+          BEGIN
+               ACCNEWINT_VAR   :=  R_IN    ;
+               ACCNEWINT_VAR0  :=  R_INOUT ;
+          END ;
+
+
+          PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ACCNEWINT ;
+                               L_INOUT : IN OUT  ACCNEWINT )  IS
+          BEGIN
+               L_OUT   :=  ACCNEWINT_CONST ;
+               L_INOUT :=  ACCNEWINT_CONST ;
+          END ;
+
+
+     BEGIN
+
+          R_ASSIGN( ACC_ACCNEWINT_VAR.ALL , ACC_ACCNEWINT_VAR0.ALL  );
+
+          IF  ACCNEWINT_VAR /= ACCNEWINT_CONST2
+          THEN
+               FAILED( "ACC. NEWINT, RIGHT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  ACCNEWINT_VAR0 /= ACCNEWINT_CONST2
+          THEN
+               FAILED( "ACC. NEWINT, RIGHT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+          L_ASSIGN( ACC_ACCNEWINT_VAR.ALL , ACC_ACCNEWINT_VAR0.ALL  );
+
+          IF  ACCNEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL
+          THEN
+               FAILED( "ACC. NEWINT, LEFT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  ACCNEWINT_CONST /= ACC_ACCNEWINT_VAR0.ALL
+          THEN
+               FAILED( "ACC. NEWINT, LEFT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303S;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303u.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303u.ada
new file mode 100644
index 000000000..92a76014e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303u.ada
@@ -0,0 +1,158 @@
+-- C41303U.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |     XXXXXXXXX
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/29/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303U IS
+
+
+BEGIN
+
+     TEST ( "C41303U" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                        " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                        " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                        " ACCEPTED" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO RECORD  ----------------------
+
+     DECLARE
+
+             TYPE  REC  IS
+
+               RECORD
+                    A , B , C : INTEGER ;
+               END RECORD ;
+
+
+          REC_CONST    :  REC  :=  ( 7 , 8 , 9 );
+          REC_VAR      :  REC  :=    REC_CONST  ;
+          REC_VAR0     :  REC  :=    REC_CONST  ;
+          REC_CONST2   :  REC  :=  ( 17 , 18 , 19 );
+
+          TYPE  ACCREC  IS  ACCESS REC ;
+
+          TYPE  ACC_ACCREC  IS  ACCESS ACCREC ;
+
+          ACC_ACCREC_VAR  :  ACC_ACCREC :=  NEW ACCREC'( 
+                                            NEW REC'( REC_CONST2 )
+                                                      );
+
+          ACC_ACCREC_VAR0 :  ACC_ACCREC :=  NEW ACCREC'( 
+                                            NEW REC'( REC_CONST2 )
+                                                      );
+
+
+          PROCEDURE  R_ASSIGN( R_IN    : IN      REC ;
+                               R_INOUT : IN OUT  REC )  IS
+          BEGIN
+               REC_VAR   :=  R_IN    ;
+               REC_VAR0  :=  R_INOUT ;
+          END ;
+
+
+          PROCEDURE  L_ASSIGN( L_OUT   :    OUT  REC ;
+                               L_INOUT : IN OUT  REC )  IS
+          BEGIN
+               L_OUT   :=  REC_CONST ;
+               L_INOUT :=  REC_CONST ;
+          END ;
+
+
+     BEGIN
+
+          R_ASSIGN( ACC_ACCREC_VAR.ALL.ALL , ACC_ACCREC_VAR0.ALL.ALL );
+
+          IF  REC_VAR /= REC_CONST2
+          THEN
+               FAILED( "ACC2 RECORD, RIGHT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  REC_VAR0 /= REC_CONST2
+          THEN
+               FAILED( "ACC2 RECORD, RIGHT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+          L_ASSIGN( ACC_ACCREC_VAR.ALL.ALL , ACC_ACCREC_VAR0.ALL.ALL );
+
+          IF  ( 7 , 8 , 9 ) /= ACC_ACCREC_VAR.ALL.ALL 
+          THEN
+               FAILED( "ACC2 RECORD, LEFT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  ( 7 , 8 , 9 ) /= ACC_ACCREC_VAR0.ALL.ALL 
+          THEN
+               FAILED( "ACC2 RECORD, LEFT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303U;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303v.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303v.ada
new file mode 100644
index 000000000..e6a6259af
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303v.ada
@@ -0,0 +1,155 @@
+-- C41303V.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |     XXXXXXXXX
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ============================================================
+
+
+-- RM  1/29/82
+-- SPS 12/2/82
+
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303V IS
+
+
+BEGIN
+
+     TEST ( "C41303V" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                        " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                        " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                        " ACCEPTED" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO ARRAY  -----------------------
+
+     DECLARE
+
+          TYPE  ARR     IS  ARRAY(1..2) OF BOOLEAN ;
+
+          ARR_CONST    :  ARR  :=  ( TRUE , FALSE );
+          ARR_VAR      :  ARR  :=    ARR_CONST  ;
+          ARR_VAR0     :  ARR  :=    ARR_CONST  ;
+          ARR_CONST2   :  ARR  :=  ( FALSE , TRUE );
+
+          TYPE  ACCARR  IS  ACCESS ARR ;
+
+          TYPE  ACC_ACCARR  IS  ACCESS ACCARR ;
+
+          ACC_ACCARR_VAR  :  ACC_ACCARR :=  NEW ACCARR'(
+                                            NEW ARR'( ARR_CONST2 )
+                                                      );
+
+          ACC_ACCARR_VAR0 :  ACC_ACCARR :=  NEW ACCARR'(
+                                            NEW ARR'( ARR_CONST2 )
+                                                      );
+
+
+          PROCEDURE  R_ASSIGN( R_IN    : IN      ARR ;
+                               R_INOUT : IN OUT  ARR )  IS
+          BEGIN
+               ARR_VAR   :=  R_IN    ;
+               ARR_VAR0  :=  R_INOUT ;
+          END ;
+
+
+          PROCEDURE  L_ASSIGN( L_OUT   :    OUT  ARR ;
+                               L_INOUT : IN OUT  ARR )  IS
+          BEGIN
+               L_OUT   :=  ARR_CONST ;
+               L_INOUT :=  ARR_CONST ;
+          END ;
+
+
+     BEGIN
+
+
+          R_ASSIGN( ACC_ACCARR_VAR.ALL.ALL , ACC_ACCARR_VAR0.ALL.ALL );
+
+          IF  ARR_VAR /= ARR_CONST2
+          THEN
+               FAILED( "ACC2 ARRAY, RIGHT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  ARR_VAR0 /= ARR_CONST2
+          THEN
+               FAILED( "ACC2 ARRAY, RIGHT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+          L_ASSIGN( ACC_ACCARR_VAR.ALL.ALL , ACC_ACCARR_VAR0.ALL.ALL );
+
+          IF  ( TRUE , FALSE ) /= ACC_ACCARR_VAR.ALL.ALL
+          THEN
+               FAILED( "ACC2 ARRAY, LEFT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  ( TRUE , FALSE ) /= ACC_ACCARR_VAR0.ALL.ALL
+          THEN
+               FAILED( "ACC2 ARRAY, LEFT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303V;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303w.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303w.ada
new file mode 100644
index 000000000..a1bf58050
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41303w.ada
@@ -0,0 +1,159 @@
+-- C41303W.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 NOTATION  L.ALL  IS ALLOWED IF  L  IS THE NAME OF AN
+--     ACCESS OBJECT DESIGNATING A RECORD, AN ARRAY, A SCALAR, OR
+--     ANOTHER ACCESS OBJECT.
+-- CHECK THAT IF  A  IS AN IDENTIFIER DENOTING AN ACCESS OBJECT WHICH
+--     IN TURN DESIGNATES AN ACCESS OBJECT, THE FORM  A.ALL.ALL  IS
+--     ACCEPTED.
+
+
+-- THIS OBJECTIVE IS COVERED IN SEVERAL TESTS. IN THE FOLLOWING DIAGRAM,
+--     THE PORTION COVERED BY THE CURRENT TEST IS MARKED BY 'X' .
+
+
+--                              ||   ASSIGNMT  |  PROC. PARAMETERS
+--                              ||  ():=  :=() | IN   OUT    IN OUT
+--      ========================||=============|====================
+--                 ACC REC      ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ARR      ||             |
+--                --------------||-------------|--------------------
+--                 ACC SCLR     ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       1 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |
+--      ========================||=============|====================
+--                 ACC ACC REC  ||             |
+--                --------------||-------------|--------------------
+--       2 '.ALL'  ACC ACC ARR  ||             |
+--                --------------||-------------|--------------------
+--                 ACC ACC SCLR ||             |     XXXXXXXXX
+--      ============================================================
+
+
+-- RM  1/29/82
+-- SPS 12/2/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41303W IS
+
+
+BEGIN
+
+     TEST ( "C41303W" , "CHECK THAT IF  A  IS AN IDENTIFIER DENOTING" &
+                        " AN ACCESS OBJECT WHICH IN TURN DESIGNATES"  &
+                        " AN ACCESS OBJECT,  THE FORM  A.ALL.ALL  IS" &
+                        " ACCEPTED" );
+
+
+     -------------------------------------------------------------------
+     ---------------  ACCESS TO ACCESS TO SCALAR  ----------------------
+
+     DECLARE
+
+          TYPE  NEWINT  IS  NEW INTEGER ;
+
+          NEWINT_CONST    :  NEWINT  :=  ( 813 );
+          NEWINT_VAR      :  NEWINT  :=  NEWINT_CONST  ;
+          NEWINT_VAR0     :  NEWINT  :=  NEWINT_CONST  ;
+          NEWINT_CONST2   :  NEWINT  :=  ( 707 );
+
+          TYPE  ACCNEWINT  IS  ACCESS NEWINT ;
+
+          TYPE  ACC_ACCNEWINT  IS  ACCESS ACCNEWINT ;
+
+          ACC_ACCNEWINT_VAR  :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                   NEW NEWINT' ( 
+                                                   NEWINT_CONST2
+                                                              )
+                                                                );
+
+          ACC_ACCNEWINT_VAR0 :  ACC_ACCNEWINT  :=  NEW ACCNEWINT'(
+                                                   NEW NEWINT' ( 
+                                                   NEWINT_CONST2
+                                                              )
+                                                                );
+
+          PROCEDURE  R_ASSIGN( R_IN    : IN      NEWINT ;
+                               R_INOUT : IN OUT  NEWINT )  IS
+          BEGIN
+               NEWINT_VAR   :=  R_IN    ;
+               NEWINT_VAR0  :=  R_INOUT ;
+          END ;
+
+
+          PROCEDURE  L_ASSIGN( L_OUT   :    OUT  NEWINT ;
+                               L_INOUT : IN OUT  NEWINT )  IS
+          BEGIN
+               L_OUT   :=  NEWINT_CONST ;
+               L_INOUT :=  NEWINT_CONST ;
+          END ;
+
+
+     BEGIN
+
+
+          R_ASSIGN( ACC_ACCNEWINT_VAR.ALL.ALL  ,
+                    ACC_ACCNEWINT_VAR0.ALL.ALL );
+
+          IF  NEWINT_VAR /= NEWINT_CONST2
+          THEN
+               FAILED( "ACC2 NEWINT, RIGHT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  NEWINT_VAR0 /= NEWINT_CONST2
+          THEN
+               FAILED( "ACC2 NEWINT, RIGHT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+          L_ASSIGN( ACC_ACCNEWINT_VAR.ALL.ALL  ,
+                    ACC_ACCNEWINT_VAR0.ALL.ALL );
+
+          IF  NEWINT_CONST /= ACC_ACCNEWINT_VAR.ALL.ALL
+          THEN
+               FAILED( "ACC2 NEWINT, LEFT SIDE (1), WRONG VAL." );
+          END IF;
+
+          IF  NEWINT_CONST /= ACC_ACCNEWINT_VAR0.ALL.ALL
+          THEN
+               FAILED( "ACC2 NEWINT, LEFT SIDE (2), WRONG VAL." );
+          END IF;
+
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41303W;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41304a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41304a.ada
new file mode 100644
index 000000000..124d527c5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41304a.ada
@@ -0,0 +1,119 @@
+-- C41304A.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 L.R RAISES CONSTRAINT_ERROR WHEN:
+--       L DENOTES AN ACCESS OBJECT HAVING THE VALUE NULL.
+--       L IS A FUNCTION CALL DELIVERING THE ACCESS VALUE NULL.
+
+-- HISTORY:
+--     WKB 08/14/81
+--     JRK 08/17/81
+--     SPS 10/26/82
+--     TBN 03/26/86  PUT THE NON-EXISTENT COMPONENT CASES INTO C41304B.
+--     JET 01/05/88  MODIFIED HEADER FORMAT AND ADDED CODE TO PREVENT
+--                   OPTIMIZATION.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41304A IS
+
+     TYPE R IS
+          RECORD
+               I : INTEGER;
+          END RECORD;
+
+     TYPE T IS ACCESS R;
+
+BEGIN
+     TEST ("C41304A", "CONSTRAINT_ERROR WHEN L IN L.R DENOTES A NULL " &
+                      "ACCESS OBJECT OR A FUNCTION CALL DELIVERING " &
+                      "NULL");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          A : T := NEW R' (I => 1);
+          J : INTEGER;
+
+     BEGIN
+
+          IF EQUAL (4, 4) THEN
+               A := NULL;
+          END IF;
+
+          J := A.I;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A NULL ACCESS " &
+                  "OBJECT");
+
+          IF EQUAL (J,J) THEN
+               COMMENT ("NO EXCEPTION RAISED");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR A NULL ACCESS " &
+                       "OBJECT");
+
+     END;
+
+     --------------------------------------------------
+
+     DECLARE
+
+          J : INTEGER;
+
+          FUNCTION F RETURN T IS
+          BEGIN
+               IF EQUAL (4, 4) THEN
+                    RETURN NULL;
+               END IF;
+               RETURN NEW R' (I => 2);
+          END F;
+
+     BEGIN
+
+          J := F.I;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A FUNCTION CALL " &
+                  "DELIVERING A NULL ACCESS VALUE");
+
+          IF EQUAL (J,J) THEN
+               COMMENT ("NO EXCEPTION RAISED");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR A FUNCTION CALL " &
+                       "DELIVERING A NULL ACCESS VALUE");
+
+     END;
+
+     RESULT;
+END C41304A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41304b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41304b.ada
new file mode 100644
index 000000000..c6dec9c6c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41304b.ada
@@ -0,0 +1,198 @@
+-- C41304B.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 L.R RAISES CONSTRAINT_ERROR WHEN:
+--        L DENOTES A RECORD OBJECT SUCH THAT, FOR THE EXISTING
+--           DISCRIMINANT VALUES, THE COMPONENT DENOTED BY R DOES
+--           NOT EXIST.
+--        L IS A FUNCTION CALL DELIVERING A RECORD VALUE SUCH THAT,
+--           FOR THE EXISTING DISCRIMINANT VALUES, THE COMPONENT
+--           DENOTED BY R DOES NOT EXIST.
+--        L IS AN ACCESS OBJECT AND THE OBJECT DESIGNATED BY THE ACCESS
+--           VALUE IS SUCH THAT COMPONENT R DOES NOT EXIST FOR THE
+--           OBJECT'S CURRENT DISCRIMINANT VALUES.
+--        L IS A FUNCTION CALL RETURNING AN ACCESS VALUE AND THE OBJECT
+--           DESIGNATED BY THE ACCESS VALUE IS SUCH THAT COMPONENT R
+--           DOES NOT EXIST FOR THE OBJECT'S CURRENT DISCRIMINANT
+--           VALUES.
+
+-- HISTORY:
+--     TBN 05/23/86  CREATED ORIGINAL TEST.
+--     JET 01/08/88  MODIFIED HEADER FORMAT AND ADDED CODE TO
+--                   PREVENT OPTIMIZATION.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41304B IS
+
+     TYPE V (DISC : INTEGER := 0) IS
+          RECORD
+               CASE DISC IS
+                    WHEN 1 =>
+                         X : INTEGER;
+                    WHEN OTHERS =>
+                         Y : INTEGER;
+               END CASE;
+          END RECORD;
+
+     TYPE T IS ACCESS V;
+
+BEGIN
+     TEST ("C41304B", "CHECK THAT L.R RAISES CONSTRAINT_ERROR WHEN " &
+                      "THE COMPONENT DENOTED BY R DOES NOT EXIST");
+
+     DECLARE
+
+          VR : V := (DISC => 0, Y => 4);
+          J : INTEGER;
+
+     BEGIN
+
+          IF EQUAL (4, 4) THEN
+               VR := (DISC => 1, X => 3);
+          END IF;
+
+          J := VR.Y;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A RECORD OBJECT");
+
+          -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
+
+          IF EQUAL (J,3) THEN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR A RECORD OBJECT");
+
+     END;
+
+     --------------------------------------------------
+
+     DECLARE
+
+          J : INTEGER;
+
+          FUNCTION F RETURN V IS
+          BEGIN
+               IF EQUAL (4, 4) THEN
+                    RETURN (DISC => 2, Y => 3);
+               END IF;
+               RETURN (DISC => 1, X => 4);
+          END F;
+
+     BEGIN
+
+          J := F.X;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A FUNCTION CALL " &
+                  "DELIVERING A RECORD VALUE");
+
+          -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
+
+          IF EQUAL (J,3) THEN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR A FUNCTION CALL " &
+                       "DELIVERING A RECORD VALUE");
+
+     END;
+
+     --------------------------------------------------
+
+     DECLARE
+
+          A : T := NEW V' (DISC => 0, Y => 4);
+          J : INTEGER;
+
+     BEGIN
+
+          IF EQUAL (4, 4) THEN
+               A := NEW V' (DISC => 1, X => 3);
+          END IF;
+
+          J := A.Y;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR AN ACCESS OBJECT");
+
+          -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
+
+          IF EQUAL (J,3) THEN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 3");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR AN ACCESS OBJECT");
+
+     END;
+
+     --------------------------------------------------
+
+     DECLARE
+
+          J : INTEGER;
+
+          FUNCTION F RETURN T IS
+          BEGIN
+               IF EQUAL (4, 4) THEN
+                    RETURN NEW V' (DISC => 2, Y => 3);
+               END IF;
+               RETURN NEW V' (DISC => 1, X => 4);
+          END F;
+
+     BEGIN
+
+          J := F.X;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR A FUNCTION CALL " &
+                  "DELIVERING AN ACCESS VALUE");
+
+          -- IF STATEMENT PREVENTS OPTIMIZING OF VARIABLE J.
+
+          IF EQUAL (J,3) THEN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 4");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR A FUNCTION CALL " &
+                       "DELIVERING AN ACCESS VALUE");
+
+     END;
+
+     RESULT;
+END C41304B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41306a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41306a.ada
new file mode 100644
index 000000000..2521d7bd4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41306a.ada
@@ -0,0 +1,104 @@
+-- C41306A.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  F  IS A FUNCTION RETURNING A TASK OF A TYPE HAVING
+--     AN ENTRY  E ,  AN ENTRY CALL OF THE FORM
+--
+--                           F.E
+--
+--     IS PERMITTED.
+
+
+-- RM  2/2/82
+-- ABW 7/16/82
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C41306A IS
+
+
+BEGIN
+
+     TEST ( "C41306A" , "CHECK THAT IF  F  IS A FUNCTION RETURNING" &
+                        " A TASK OF A TYPE HAVING AN ENTRY  E ,  AN" &
+                        " ENTRY CALL OF THE FORM  F.E  IS PERMITTED");
+
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          X  : INTEGER  :=  0 ;
+
+          TASK TYPE  T  IS
+               ENTRY  E ;
+          END  T ;
+
+          T1 : T ;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT  E  DO
+                    X := IDENT_INT(17) ;
+               END  E ;
+               ACCEPT  E  DO
+                    X := IDENT_INT(16) ;
+               END  E ;
+          END  T ;
+
+          FUNCTION  F1  RETURN  T  IS
+          BEGIN
+               RETURN  T1 ;
+          END  F1 ;
+
+          FUNCTION F2 (A,B : BOOLEAN) RETURN T IS
+          BEGIN
+               IF A AND B THEN NULL; END IF;
+               RETURN T1;
+          END F2;
+
+     BEGIN
+
+          F1.E ;                                  -- X SET TO 17.
+
+          IF  X /= 17 THEN
+               FAILED("WRONG VALUE FOR GLOBAL VARIABLE - 1");
+          END IF;
+
+          X := 0;
+          F2(TRUE,TRUE).E;                        -- X SET TO 16.
+                            -- X TO BE SET TO 16.
+
+          IF X /= 16 THEN
+               FAILED("WRONG VALUE FOR GLOBAL VARIABLE - 2");
+          END IF;
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+
+END C41306A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41306b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41306b.ada
new file mode 100644
index 000000000..390f978a0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41306b.ada
@@ -0,0 +1,217 @@
+-- C41306B.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  F  IS A FUNCTION RETURNING AN ACCESS VALUE DESIGNATING
+--     A TASK OF A TYPE HAVING
+--     AN ENTRY  E ,  AN ENTRY CALL OF THE FORM
+--
+--                           F.ALL.E
+--
+--     IS PERMITTED.
+
+-- RM  02/02/82
+-- ABW 07/16/82
+-- EG  05/28/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C41306B IS
+
+BEGIN
+
+     TEST ( "C41306B" , "CHECK THAT IF  F  IS A FUNCTION RETURNING" &
+                        " AN ACCESS VALUE DESIGNATING"              &
+                        " A TASK OF A TYPE HAVING AN ENTRY  E ,  AN" &
+                        " ENTRY CALL OF THE FORM  F.ALL.E  IS"       &
+                        " PERMITTED" );
+
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          X  : INTEGER  :=  0 ;
+
+          TASK TYPE  T  IS
+               ENTRY  E ;
+          END  T ;
+
+          TYPE  A_T  IS  ACCESS T ;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT  E  DO
+                    X := IDENT_INT(17) ;
+               END  E ;
+          END  T ;
+
+          FUNCTION  F1  RETURN  A_T  IS
+               A_T_VAR1 : A_T := NEW T ;
+          BEGIN
+               RETURN  A_T_VAR1 ;
+          END  F1 ;
+
+          FUNCTION F2 (A, B : BOOLEAN) RETURN A_T IS
+               A_T_VAR2 : A_T := NEW T;
+          BEGIN
+               IF A AND B THEN
+                    NULL;
+               END IF;
+               RETURN A_T_VAR2;
+          END F2;
+
+     BEGIN
+
+          F1.ALL.E ;  --  THE ELABOR. OF  F1 (BODY)  ACTIVATES THE TASK,
+                      --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
+                      --      BE CALLED.
+
+                      --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+
+          IF  X /= 17
+          THEN
+               FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (1)" );
+          END IF;
+
+          X := 0;
+          F2(TRUE, TRUE).ALL.E;    -- THE ELABORATION OF F2 (BODY)
+                                   -- ACTIVATES THE TASK, WHICH 
+                                   -- PROCEEDS TO WAIT FOR THE
+                                   -- ENTRY E TO BE CALLED.
+
+                                   -- THE CALLED ENTRY CAUSES X TO BE 
+                                   -- SET TO 17.
+
+          IF X /= 17 THEN
+               FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (2)");
+          END IF;
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          X  : INTEGER  :=  0 ;
+
+          TASK TYPE  T  IS
+               ENTRY  E ;
+          END  T ;
+
+          TYPE  A_T  IS  ACCESS T ;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT  E  DO
+                    X := IDENT_INT(17) ;
+               END  E ;
+          END  T ;
+
+          FUNCTION  F3  RETURN  A_T  IS
+          BEGIN
+               RETURN  NEW T ;
+          END  F3;
+
+          FUNCTION F4 (C, D : BOOLEAN) RETURN A_T IS
+          BEGIN
+               IF C AND D THEN
+                    NULL;
+               END IF;
+               RETURN NEW T;
+          END F4;
+
+     BEGIN
+
+          F3.ALL.E ;  --  THE ELABOR. OF  F3 (BODY)  ACTIVATES THE TASK,
+                      --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
+                      --      BE CALLED.
+
+                      --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+
+          IF  X /= 17
+          THEN
+               FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (3)" );
+          END IF;
+
+          X := 0;
+          F4(TRUE, TRUE).ALL.E;    -- THE ELABORATION OF F4 (BODY)
+                                   -- ACTIVATES THE TASK, WHICH
+                                   -- PROCEEDS TO WAIT FOR THE
+                                   -- ENTRY E TO BE CALLED.
+
+                                   -- THE CALLED ENTRY CAUSES X TO BE
+                                   -- SET TO 17.
+
+          IF X /= 17 THEN
+               FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (4)");
+          END IF;
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          X  : INTEGER  :=  0 ;
+
+          TASK TYPE  T  IS
+               ENTRY  E ;
+          END  T ;
+
+          TYPE  A_T  IS  ACCESS T ;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT  E  DO
+                    X := IDENT_INT(17) ;
+               END  E ;
+          END  T ;
+
+     BEGIN
+
+          DECLARE
+
+               F3 : A_T := NEW T;
+
+          BEGIN
+
+               F3.ALL.E;
+
+                      --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+
+               IF  X /= 17 THEN
+                    FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (5)" );
+               END IF;
+
+          END;
+
+     END ;
+
+     -------------------------------------------------------------------
+
+
+     RESULT;
+
+
+END C41306B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41306c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41306c.ada
new file mode 100644
index 000000000..dc715c881
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41306c.ada
@@ -0,0 +1,215 @@
+-- C41306C.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  F  IS A FUNCTION RETURNING AN ACCESS VALUE DESIGNATING
+--     A TASK OF A TYPE HAVING
+--     AN ENTRY  E ,  AN ENTRY CALL OF THE FORM
+--
+--                           F.E
+--
+--     IS PERMITTED.
+
+
+-- RM  02/02/82
+-- ABW 07/16/82
+-- EG  05/28/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C41306C IS
+
+BEGIN
+
+     TEST ( "C41306C" , "CHECK THAT IF  F  IS A FUNCTION RETURNING" &
+                        " AN ACCESS VALUE DESIGNATING"              &
+                        " A TASK OF A TYPE HAVING AN ENTRY  E ,  AN" &
+                        " ENTRY CALL OF THE FORM  F.E  IS PERMITTED" );
+
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          X  : INTEGER  :=  0 ;
+
+          TASK TYPE  T  IS
+               ENTRY  E ;
+          END  T ;
+
+          TYPE  A_T  IS  ACCESS T ;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT  E  DO
+                    X := IDENT_INT(17) ;
+               END  E ;
+          END  T ;
+
+          FUNCTION  F1  RETURN  A_T  IS
+               A_T_VAR1 : A_T := NEW T ;
+          BEGIN
+               RETURN  A_T_VAR1 ;
+          END  F1 ;
+
+          FUNCTION F2 (A, B : BOOLEAN) RETURN A_T IS
+               A_T_VAR2 : A_T := NEW T;
+          BEGIN
+               IF A AND B THEN
+                    NULL;
+               END IF;
+               RETURN A_T_VAR2;
+          END F2;
+
+     BEGIN
+
+          F1.E ;      --  THE ELABOR. OF  F1 (BODY)  ACTIVATES THE TASK,
+                      --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
+                      --      BE CALLED.
+
+                      --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+
+          IF  X /= 17
+          THEN
+               FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (1)" );
+          END IF;
+
+          X := 0;
+          F2(TRUE, TRUE).E;   -- THE ELABORATION OF F2 (BODY) ACTIVATES
+                              -- THE TASK, WHICH PROCEEDS TO WAIT FOR
+                              -- ENTRY E TO BE CALLED.
+
+                              -- THE CALLED ENTRY CAUSES X TO BE SET TO
+                              -- 17.
+
+          IF X /= 17 THEN
+               FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (2)");
+          END IF;
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          X  : INTEGER  :=  0 ;
+
+          TASK TYPE  T  IS
+               ENTRY  E ;
+          END  T ;
+
+          TYPE  A_T  IS  ACCESS T ;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT  E  DO
+                    X := IDENT_INT(17) ;
+               END  E ;
+          END  T ;
+
+          FUNCTION  F3  RETURN  A_T  IS
+          BEGIN
+               RETURN  NEW T ;
+          END  F3;
+
+          FUNCTION F4 (C, D : BOOLEAN) RETURN A_T IS
+          BEGIN
+               IF C AND D THEN
+                    NULL;
+               END IF;
+               RETURN NEW T;
+          END F4;
+
+     BEGIN
+
+          F3.E ;      --  THE ELABOR. OF  F3 (BODY)  ACTIVATES THE TASK,
+                      --      WHICH  PROCEEDS TO WAIT FOR ENTRY  E  TO
+                      --      BE CALLED.
+
+                      --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+
+          IF  X /= 17
+          THEN
+               FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (3)" );
+          END IF;
+
+          X := 0;
+          F4(TRUE, TRUE).E;   -- THE ELABORATION OF F4 (BODY) ACTIVATES
+                              -- THE TASK WHICH PROCEEDS TO WAIT FOR
+                              -- ENTRY E TO BE CALLED.
+
+                              -- THE CALLED ENTRY CAUSES X TO BE SET TO
+                              -- 17.
+
+          IF X /= 17 THEN
+               FAILED ("WRONG VALUE FOR GLOBAL VARIABLE (4)");
+          END IF;
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          X  : INTEGER  :=  0 ;
+
+          TASK TYPE  T  IS
+               ENTRY  E ;
+          END  T ;
+
+          TYPE  A_T  IS  ACCESS T ;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT  E  DO
+                    X := IDENT_INT(17) ;
+               END  E ;
+          END  T ;
+
+     BEGIN
+
+          DECLARE
+
+               F3 : A_T := NEW T;
+
+          BEGIN
+
+               F3.E;
+
+                      --  THE CALLED ENTRY CAUSES  X  TO BE SET TO  17 .
+
+               IF  X /= 17 THEN
+                    FAILED( "WRONG VALUE FOR GLOBAL VARIABLE   (5)" );
+               END IF;
+
+          END;
+
+     END ;
+
+     -------------------------------------------------------------------
+
+
+     RESULT;
+
+
+END C41306C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41307d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41307d.ada
new file mode 100644
index 000000000..e65e79fb8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41307d.ada
@@ -0,0 +1,255 @@
+-- C41307D.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 L.R IS ALLOWED INSIDE A PACKAGE, GENERIC PACKAGE,
+-- SUBPROGRAM, GENERIC SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT
+-- STATEMENT NAMED L, IF R IS DECLARED INSIDE THE UNIT.
+
+-- TBN 12/15/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41307D IS
+
+BEGIN
+     TEST ("C41307D", "CHECK THAT L.R IS ALLOWED INSIDE A PACKAGE, " &
+                      "GENERIC PACKAGE, SUBPROGRAM, GENERIC " &
+                      "SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT " &
+                      "STATEMENT NAMED L, IF R IS DECLARED INSIDE " &
+                      "THE UNIT");
+     DECLARE
+          PACKAGE L IS
+               R : INTEGER := 5;
+               A : INTEGER := L.R;
+          END L;
+
+          PACKAGE BODY L IS
+               B : INTEGER := L.R + 1;
+          BEGIN
+               IF IDENT_INT(A) /= 5 OR IDENT_INT(B) /= 6 THEN
+                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+               END IF;
+          END L;
+
+          GENERIC
+               S : INTEGER;
+          PACKAGE M IS
+               X : INTEGER := M.S;
+          END M;
+
+          PACKAGE BODY M IS
+               Y : INTEGER := M.S + 1;
+          BEGIN
+               IF IDENT_INT(X) /= 2 OR
+                  IDENT_INT(Y) /= 3 OR
+                  IDENT_INT(M.X) /= 2 THEN
+                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+               END IF;
+          END M;
+
+          PACKAGE Q IS NEW M(2);
+     BEGIN
+          IF IDENT_INT(Q.X) /= 2 THEN
+               FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+          END IF;
+     END;
+     -------------------------------------------------------------------
+
+     DECLARE
+          CH : CHARACTER := '6';
+
+          PROCEDURE L (R : IN OUT CHARACTER) IS
+               A : CHARACTER := L.R;
+          BEGIN
+               IF IDENT_CHAR(L.A) /= '6' THEN
+                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+               END IF;
+               L.R := IDENT_CHAR('7');
+          END L;
+
+          GENERIC
+               S : CHARACTER;
+          PROCEDURE M;
+
+          PROCEDURE M IS
+               T : CHARACTER := M.S;
+          BEGIN
+               IF IDENT_CHAR(T) /= '3' OR IDENT_CHAR(M.S) /= '3' THEN
+                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+               END IF;
+          END M;
+
+          PROCEDURE P1 IS NEW M('3');
+
+     BEGIN
+          L (CH);
+          IF CH /= IDENT_CHAR('7') THEN
+               FAILED ("INCORRECT RESULTS RETURNED FROM PROCEDURE - 6");
+          END IF;
+          P1;
+     END;
+     -------------------------------------------------------------------
+
+     DECLARE
+          INT : INTEGER := 3;
+
+          FUNCTION L (R : INTEGER) RETURN INTEGER IS
+               A : INTEGER := L.R;
+          BEGIN
+               IF IDENT_INT(L.A) /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+               END IF;
+               RETURN IDENT_INT(4);
+          END L;
+
+          GENERIC
+               S : INTEGER;
+          FUNCTION M RETURN INTEGER;
+
+          FUNCTION M RETURN INTEGER IS
+               T : INTEGER := M.S;
+          BEGIN
+               IF IDENT_INT(M.T) /= 4 OR M.S /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+               END IF;
+               RETURN IDENT_INT(1);
+          END M;
+
+          FUNCTION F1 IS NEW M(4);
+
+     BEGIN
+          IF L(INT) /= 4 OR F1 /= 1 THEN
+               FAILED ("INCORRECT RESULTS RETURNED FROM FUNCTION - 9");
+          END IF;
+     END;
+     -------------------------------------------------------------------
+
+     DECLARE
+          TASK L IS
+               ENTRY E (A : INTEGER);
+          END L;
+
+          TASK TYPE M IS
+               ENTRY E1 (A : INTEGER);
+          END M;
+
+          T1 : M;
+
+          TASK BODY L IS
+               X : INTEGER := IDENT_INT(1);
+               R : INTEGER RENAMES X;
+               Y : INTEGER := L.R;
+          BEGIN
+               X := X + L.R;
+               IF X /= IDENT_INT(2) OR Y /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
+                            "10");
+               END IF;
+          END L;
+
+          TASK BODY M IS
+               X : INTEGER := IDENT_INT(2);
+               R : INTEGER RENAMES X;
+               Y : INTEGER := M.R;
+          BEGIN
+               ACCEPT E1 (A : INTEGER) DO
+                    X := X + M.R;
+                    IF X /= IDENT_INT(4) OR Y /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
+                                 "NAME - 11");
+                    END IF;
+                    IF E1.A /= IDENT_INT(3) THEN
+                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
+                                 "NAME - 12");
+                    END IF;
+               END E1;
+          END M;
+     BEGIN
+          T1.E1 (3);
+     END;
+     -------------------------------------------------------------------
+
+     DECLARE
+          TASK T IS
+               ENTRY G (1..2) (A : INTEGER);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT G (1) (A : INTEGER) DO
+                    IF G.A /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
+                                 "NAME - 13");
+                    END IF;
+                    BLK:
+                         DECLARE
+                              B : INTEGER := 7;
+                         BEGIN
+                              IF T.BLK.B /= IDENT_INT(7) THEN
+                                   FAILED ("INCORRECT RESULTS FROM " &
+                                           "EXPANDED NAME - 14");
+                              END IF;
+                         END BLK;
+               END G;
+               ACCEPT G (2) (A : INTEGER) DO
+                    IF G.A /= IDENT_INT(1) THEN
+                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
+                                 "NAME - 15");
+                    END IF;
+               END G;
+          END T;
+     BEGIN
+          T.G (1) (2);
+          T.G (2) (1);
+     END;
+     -------------------------------------------------------------------
+
+     SWAP:
+          DECLARE
+               VAR : CHARACTER := '*';
+               RENAME_VAR : CHARACTER RENAMES VAR;
+               NEW_VAR : CHARACTER;
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    NEW_VAR := SWAP.RENAME_VAR;
+               END IF;
+               IF NEW_VAR /= IDENT_CHAR('*') THEN
+                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
+                            "16");
+               END IF;
+               LP:  FOR I IN 1..2 LOOP
+                         IF SWAP.LP.I = IDENT_INT(2) OR
+                            LP.I = IDENT_INT(1) THEN
+                              GOTO SWAP.LAB1;
+                         END IF;
+                         NEW_VAR := IDENT_CHAR('+');
+                         <<LAB1>>
+                         NEW_VAR := IDENT_CHAR('-');
+                    END LOOP LP;
+               IF NEW_VAR /= IDENT_CHAR('-') THEN
+                    FAILED ("INCORRECT RESULTS FROM FOR LOOP - 17");
+               END IF;
+          END SWAP;
+
+     RESULT;
+END C41307D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41309a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41309a.ada
new file mode 100644
index 000000000..a1dc91734
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41309a.ada
@@ -0,0 +1,69 @@
+-- C41309A.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 EXPANDED NAME IS ALLOWED EVEN IF A USE CLAUSE MAKES THE
+-- EXPANDED NAME UNNECESSARY.
+
+-- TBN  12/15/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41309A IS
+
+BEGIN
+     TEST ("C41309A", "CHECK THAT AN EXPANDED NAME IS ALLOWED EVEN " &
+                      "IF A USE CLAUSE MAKES THE EXPANDED NAME " &
+                      "UNNECESSARY");
+     DECLARE
+          PACKAGE P IS
+               PACKAGE Q IS
+                    PACKAGE R IS
+                         TYPE REC IS
+                              RECORD
+                                   A : INTEGER := 5;
+                                   B : BOOLEAN := TRUE;
+                              END RECORD;
+                         REC1 : REC;
+                    END R;
+
+                    USE R;
+
+                    REC2 : R.REC := R.REC1;
+               END Q;
+
+               USE Q; USE R;
+
+               REC3 : Q.R.REC := Q.REC2;
+          END P;
+
+          USE P; USE Q; USE R;
+
+          REC4 : P.Q.R.REC := P.REC3;
+     BEGIN
+          IF REC4 /= (IDENT_INT(5), IDENT_BOOL(TRUE)) THEN
+               FAILED ("INCORRECT RESULTS FROM EXPANDED NAME");
+          END IF;
+     END;
+
+     RESULT;
+END C41309A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41320a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41320a.ada
new file mode 100644
index 000000000..011174a62
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41320a.ada
@@ -0,0 +1,97 @@
+-- C41320A.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 IMPLICITLY DECLARED ENUMERATION LITERALS, CHARACTER
+--    LITERALS, AND THE RELATIONAL OPERATORS CAN BE SELECTED FROM
+--    OUTSIDE THE PACKAGE USING AN EXPANDED NAME, FOR ENUMERATION TYPES.
+
+-- HISTORY:
+--    TBN 07/15/86  CREATED ORIGINAL TEST.
+--    JET 08/04/87  ADDED TEST FOR OVERLOADED VARIABLES.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41320A IS
+
+     PACKAGE P IS
+          TYPE FLAG IS (RED, WHITE, BLUE);
+          TYPE ROMAN_DIGITS IS ('I', 'V', 'X', 'C', 'M');
+          TYPE TRAFFIC_LIGHT IS (RED, YELLOW, GREEN);
+          TYPE HEX IS ('A', 'B', 'C', 'D', 'E', 'F');
+          FLAG_COLOR_1 : FLAG := RED;
+          FLAG_COLOR_2 : FLAG := WHITE;
+          TRAFFIC_LIGHT_COLOR_1 : FLAG := RED;
+          HEX_3 : HEX := 'C';
+          ROMAN_1 : ROMAN_DIGITS := 'I';
+     END P;
+
+     USA_FLAG_1 : P.FLAG := P.RED;
+     USA_FLAG_3 : P.FLAG := P.BLUE;
+     HEX_CHAR_3 : P.HEX := P.'C';
+     ROMAN_DIGITS_4 : P.ROMAN_DIGITS := P.'C';
+     TRAFFIC_LIGHT_1 : P.TRAFFIC_LIGHT := P.RED;
+
+BEGIN
+     TEST ("C41320A", "CHECK THAT IMPLICITLY DECLARED ENUMERATION " &
+                      "LITERALS, CHARACTER LITERALS, AND THE " &
+                      "RELATIONAL OPERATORS CAN BE SELECTED FROM " &
+                      "OUTSIDE THE PACKAGE USING AN EXPANDED NAME " &
+                      "FOR ENUMERATION TYPES");
+
+     IF P."/=" (USA_FLAG_1, P.FLAG_COLOR_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+     END IF;
+
+     IF P."=" (USA_FLAG_3, P.FLAG_COLOR_2) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+     END IF;
+
+     IF P."<" (HEX_CHAR_3, P.HEX_3) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+     END IF;
+
+     IF P.">" (P.ROMAN_1, ROMAN_DIGITS_4) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+     END IF;
+
+     IF P.">=" (TRAFFIC_LIGHT_1, P.TRAFFIC_LIGHT'PRED (P.GREEN)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+     END IF;
+
+     FOR J IN P.FLAG'(P.WHITE) .. P.FLAG'(P.WHITE) LOOP
+          IF P."<=" (P.FLAG'SUCC (P.WHITE), J) THEN
+               FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+          END IF;
+     END LOOP;
+
+     IF P.">=" (P.RED, P.GREEN) THEN
+          FAILED ("INCORRECT RESULT FROM OVERLOADED VARIABLE NAME - 1");
+     END IF;
+
+     IF P."<=" (P.BLUE, P.RED) THEN
+          FAILED ("INCORRECT RESULT FROM OVERLOADED VARIABLE NAME - 2");
+     END IF;
+
+     RESULT;
+END C41320A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41321a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41321a.ada
new file mode 100644
index 000000000..8064c127b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41321a.ada
@@ -0,0 +1,106 @@
+-- C41321A.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 IMPLICITLY DECLARED RELATIONAL OPERATORS, LOGICAL 
+-- OPERATORS, AND THE "NOT" OPERATOR MAY BE SELECTED FROM OUTSIDE
+-- THE PACKAGE USING AN EXPANDED NAME, FOR A DERIVED BOOLEAN TYPE.
+
+-- TBN  7/16/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41321A IS
+
+     PACKAGE P IS
+          TYPE DERIVED_BOOLEAN IS NEW BOOLEAN RANGE FALSE .. TRUE;
+          DERIVED_FALSE : DERIVED_BOOLEAN := FALSE;
+          DERIVED_TRUE : DERIVED_BOOLEAN := TRUE;
+     END P;
+
+     DBOOL_FALSE : P.DERIVED_BOOLEAN := P.FALSE;
+     DBOOL_TRUE : P.DERIVED_BOOLEAN := P.TRUE;
+
+BEGIN
+     TEST ("C41321A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
+                      "OPERATORS, LOGICAL OPERATORS, AND THE 'NOT' " &
+                      "OPERATOR MAY BE SELECTED FROM OUTSIDE THE " &
+                      "PACKAGE USING AN EXPANDED NAME, FOR A DERIVED " &
+                      "BOOLEAN TYPE");
+
+     IF P."=" (DBOOL_FALSE, P.DERIVED_TRUE) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+     END IF;
+
+     IF P."/=" (DBOOL_TRUE, P.DERIVED_TRUE) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+     END IF;
+
+     IF P."<" (P.DERIVED_TRUE, P.DERIVED_FALSE) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+     END IF;
+
+     IF P.">" (DBOOL_TRUE, P.DERIVED_TRUE) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+     END IF;
+
+     IF P."<=" (P.DERIVED_TRUE, DBOOL_FALSE) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+     END IF;
+
+     IF P."<=" (P.DERIVED_TRUE, DBOOL_TRUE) THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+     END IF;
+
+     IF P.">=" (P.DERIVED_TRUE, DBOOL_TRUE) THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+     END IF;
+
+     FOR J IN P.DERIVED_BOOLEAN'(P.TRUE) .. P.DERIVED_BOOLEAN'(P.TRUE)
+          LOOP
+               IF P.">=" (DBOOL_FALSE, J) THEN
+                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+               END IF;
+          END LOOP;
+
+     IF P."AND" (DBOOL_FALSE, P.DERIVED_TRUE) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
+     END IF;
+
+     IF P."OR" (DBOOL_FALSE, P.DERIVED_FALSE) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
+     END IF;
+
+     IF P."XOR" (DBOOL_TRUE, P.DERIVED_TRUE) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
+     END IF;
+
+     IF P."NOT" (P.DERIVED_TRUE) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
+     END IF;
+
+     RESULT;
+END C41321A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41322a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41322a.ada
new file mode 100644
index 000000000..eaf3a6ff7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41322a.ada
@@ -0,0 +1,125 @@
+-- C41322A.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 IMPLICITLY DECLARED RELATIONAL OPERATORS AND ARITHMETIC
+-- OPERATORS (+, -, *, /, **, ABS, MOD, REM) MAY BE SELECTED FROM
+-- OUTSIDE THE PACKAGE USING AN EXPANDED NAME, FOR AN INTEGER TYPE.
+
+-- TBN  7/16/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41322A IS
+
+     PACKAGE P IS
+          TYPE INT IS RANGE -10 .. 10;
+          OBJ_INT_1 : INT := -10;
+          OBJ_INT_2 : INT := 1;
+          OBJ_INT_3 : INT := 10;
+     END P;
+
+     INT_VAR : P.INT;
+     INT_VAR_1 : P.INT := P."-"(P.INT'(10));
+     INT_VAR_2 : P.INT := P.INT'(1);
+     INT_VAR_3 : P.INT := P.INT'(10);
+
+BEGIN
+     TEST ("C41322A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
+                      "OPERATORS AND ARITHMETIC OPERATORS (+, -, *, " &
+                      "/, **, ABS, MOD, REM) MAY BE SELECTED FROM " &
+                      "OUTSIDE THE PACKAGE USING AN EXPANDED NAME, " &
+                      "FOR AN INTEGER TYPE");
+
+     IF P."=" (INT_VAR_1, P.INT'(2)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+     END IF;
+
+     IF P."/=" (INT_VAR_1, P.OBJ_INT_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+     END IF;
+
+     IF P."<" (INT_VAR_2, 0) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+     END IF;
+
+     IF P.">" (INT_VAR_2, P.OBJ_INT_3) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+     END IF;
+
+     IF P."<=" (INT_VAR_3, P.INT'(9)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+     END IF;
+
+     FOR J IN P.INT'(4) .. P.INT'(4) LOOP
+          IF P.">=" (J, INT_VAR_3) THEN
+               FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+          END IF;
+     END LOOP;
+
+     INT_VAR := P."+" (INT_VAR_1, P.INT'(2));
+     IF P."/=" (INT_VAR, P."-"(P.INT'(8))) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+     END IF;
+
+     INT_VAR := P."+" (P.INT'(2));
+     IF P."/=" (INT_VAR, P.INT'(2)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+     END IF;
+
+     INT_VAR := P."-" (INT_VAR_2, P.INT'(0));
+     IF P."/=" (INT_VAR, P.OBJ_INT_2) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
+     END IF;
+
+     INT_VAR := P."*" (INT_VAR_2, P.INT'(5));
+     IF P."/=" (INT_VAR, P.INT'(5)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
+     END IF;
+
+     INT_VAR := P."/" (INT_VAR_3, P.INT'(2));
+     IF P."/=" (INT_VAR, P.INT'(5)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
+     END IF;
+
+     INT_VAR := P."**" (P.INT'(2), 3);
+     IF P."/=" (INT_VAR, P.INT'(8)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
+     END IF;
+
+     INT_VAR := P."ABS" (INT_VAR_1);
+     IF P."/=" (INT_VAR, P.OBJ_INT_3) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
+     END IF;
+
+     INT_VAR := P."MOD" (INT_VAR_1, P.INT'(3));
+     IF P."/=" (INT_VAR, P.INT'(2)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
+     END IF;
+
+     INT_VAR := P."REM" (INT_VAR_1, P.INT'(3));
+     IF P."/=" (INT_VAR, P."-" (INT_VAR_2)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 15");
+     END IF;
+
+     RESULT;
+END C41322A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41323a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41323a.ada
new file mode 100644
index 000000000..f82a97abf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41323a.ada
@@ -0,0 +1,125 @@
+-- C41323A.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 IMPLICITLY DECLARED RELATIONAL OPERATORS AND ARITHMETIC
+-- OPERATORS (+, -, *, /, **, ABS) MAY BE SELECTED FROM OUTSIDE THE
+-- PACKAGE USING AN EXPANDED NAME, FOR A FLOATING POINT TYPE.
+
+-- TBN  7/16/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41323A IS
+
+     PACKAGE P IS
+          TYPE FLOAT IS DIGITS 5 RANGE -1.0E1 .. 1.0E1;
+          OBJ_FLO_1 : FLOAT := -5.5;
+          OBJ_FLO_2 : FLOAT := 1.5;
+          OBJ_FLO_3 : FLOAT := 10.0;
+     END P;
+
+     FLO_VAR : P.FLOAT;
+     FLO_VAR_1 : P.FLOAT := P."-"(P.FLOAT'(5.5));
+     FLO_VAR_2 : P.FLOAT := P.FLOAT'(1.5);
+     FLO_VAR_3 : P.FLOAT := P.FLOAT'(1.0E1);
+
+BEGIN
+     TEST ("C41323A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
+                      "OPERATORS AND ARITHMETIC OPERATORS (+, -, *, " &
+                      "/, **, ABS) MAY BE SELECTED FROM OUTSIDE THE " &
+                      "PACKAGE USING AN EXPANDED NAME, FOR A " &
+                      "FLOATING POINT TYPE");
+
+     IF P."=" (FLO_VAR_1, P."-"(P.FLOAT'(5.55))) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+     END IF;
+
+     IF P."/=" (FLO_VAR_1, P.OBJ_FLO_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+     END IF;
+
+     IF P."<" (FLO_VAR_2, P.OBJ_FLO_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+     END IF;
+
+     IF P.">" (FLO_VAR_2, P.OBJ_FLO_3) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+     END IF;
+
+     IF P."<=" (FLO_VAR_3, P.FLOAT'(9.9)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+     END IF;
+
+     IF P."<=" (FLO_VAR_3, P.FLOAT'(10.0)) THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+     END IF;
+
+     IF P.">=" (P.OBJ_FLO_2, FLO_VAR_3) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+     END IF;
+
+     IF P.">=" (P.OBJ_FLO_3, FLO_VAR_3) THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+     END IF;
+
+     FLO_VAR := P."+" (FLO_VAR_1, P.OBJ_FLO_2);
+     IF P."/=" (FLO_VAR, P."-"(P.FLOAT'(4.0))) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
+     END IF;
+
+     FLO_VAR := P."+" (FLO_VAR_1);
+     IF P."/=" (FLO_VAR, P.OBJ_FLO_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
+     END IF;
+
+     FLO_VAR := P."-" (FLO_VAR_2, P.OBJ_FLO_1);
+     IF P."/=" (FLO_VAR, P.FLOAT'(7.0)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
+     END IF;
+
+     FLO_VAR := P."*" (FLO_VAR_2, P.FLOAT'(2.0));
+     IF P."/=" (FLO_VAR, P.FLOAT'(3.0)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
+     END IF;
+
+     FLO_VAR := P."/" (FLO_VAR_3, P.FLOAT'(2.0));
+     IF P."/=" (FLO_VAR, P.FLOAT'(5.0)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
+     END IF;
+
+     FLO_VAR := P."**" (P.FLOAT'(2.0), 3);
+     IF P."/=" (FLO_VAR, P.FLOAT'(8.0)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
+     END IF;
+
+     FLO_VAR := P."ABS" (FLO_VAR_1);
+     IF P."/=" (FLO_VAR, P.FLOAT'(5.5)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 15");
+     END IF;
+
+     RESULT;
+END C41323A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41324a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41324a.ada
new file mode 100644
index 000000000..19992a29b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41324a.ada
@@ -0,0 +1,120 @@
+-- C41324A.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 IMPLICITLY DECLARED RELATIONAL OPERATORS AND ARITHMETIC
+-- OPERATORS (+, -, *, /, ABS) MAY BE SELECTED FROM OUTSIDE THE
+-- PACKAGE USING AN EXPANDED NAME, FOR A FIXED POINT TYPE.
+
+-- TBN  7/16/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41324A IS
+
+     PACKAGE P IS
+          TYPE FIXED IS DELTA 0.125 RANGE -1.0E1 .. 1.0E1;
+          OBJ_FIX_1 : FIXED := -5.5;
+          OBJ_FIX_2 : FIXED := 1.5;
+          OBJ_FIX_3 : FIXED := 10.0;
+     END P;
+
+     FIX_VAR : P.FIXED;
+     FIX_VAR_1 : P.FIXED := P."-"(P.FIXED'(5.5));
+     FIX_VAR_2 : P.FIXED := P.FIXED'(1.5);
+     FIX_VAR_3 : P.FIXED := P.FIXED'(1.0E1);
+
+BEGIN
+     TEST ("C41324A", "CHECK THAT IMPLICITLY DECLARED RELATIONAL " &
+                      "OPERATORS AND ARITHMETIC OPERATORS (+, -, *, " &
+                      "/, ABS) MAY BE SELECTED FROM OUTSIDE THE " &
+                      "PACKAGE USING AN EXPANDED NAME, FOR A FIXED " &
+                      "POINT TYPE");
+
+     IF P."=" (FIX_VAR_1, P."-"(P.FIXED'(6.0))) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+     END IF;
+
+     IF P."/=" (FIX_VAR_1, P.OBJ_FIX_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+     END IF;
+
+     IF P."<" (FIX_VAR_2, P.OBJ_FIX_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+     END IF;
+
+     IF P.">" (FIX_VAR_2, P.OBJ_FIX_3) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+     END IF;
+
+     IF P."<=" (FIX_VAR_3, P.FIXED'(9.9)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+     END IF;
+
+     IF P."<=" (FIX_VAR_3, P.FIXED'(10.0)) THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+     END IF;
+
+     IF P.">=" (P.OBJ_FIX_2, FIX_VAR_3) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+     END IF;
+
+     IF P.">=" (P.OBJ_FIX_2, FIX_VAR_2) THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+     END IF;
+
+     FIX_VAR := P."+" (FIX_VAR_1, P.OBJ_FIX_2);
+     IF P."/=" (FIX_VAR, P."-"(P.FIXED'(4.0))) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
+     END IF;
+
+     FIX_VAR := P."-" (FIX_VAR_2, P.OBJ_FIX_1);
+     IF P."/=" (FIX_VAR, P.FIXED'(7.0)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
+     END IF;
+
+     FIX_VAR := P."*" (FIX_VAR_2, 2);
+     IF P."/=" (FIX_VAR, P.FIXED'(3.0)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
+     END IF;
+
+     FIX_VAR := P."*" (3, FIX_VAR_2);
+     IF P."/=" (FIX_VAR, P.FIXED'(4.5)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
+     END IF;
+
+     FIX_VAR := P."/" (FIX_VAR_3, 2);
+     IF P."/=" (FIX_VAR, P.FIXED'(5.0)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
+     END IF;
+
+     FIX_VAR := P."ABS" (FIX_VAR_1);
+     IF P."/=" (FIX_VAR, P.FIXED'(5.5)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
+     END IF;
+
+     RESULT;
+END C41324A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41325a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41325a.ada
new file mode 100644
index 000000000..95437ab3e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41325a.ada
@@ -0,0 +1,173 @@
+-- C41325A.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 IMPLICITLY DECLARED ENTITIES CAN BE SELECTED
+-- FROM OUTSIDE THE PACKAGE USING AN EXPANDED NAME, FOR AN ARRAY TYPE.
+--     CASE 1: CHECK EQUALITY AND INEQUALITY WHEN COMPONENT TYPE IS
+--               NON-LIMITED, FOR MULTIDIMENSIONAL ARRAYS.
+--     CASE 2: FOR ONE DIMENSIONAL ARRAYS:
+--               A) CHECK CATENATION, EQUALITY, AND INEQUALITY WHEN 
+--                    COMPONENT TYPE IS NON-LIMITED.
+--               B) CHECK RELATIONAL OPERATORS WHEN COMPONENT TYPE IS 
+--                    DISCRETE.
+--               C) CHECK THE "NOT" OPERATOR AND THE LOGICAL OPERATORS 
+--                    WHEN COMPONENT TYPE IS BOOLEAN.
+
+-- TBN  7/17/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41325A IS
+
+     PACKAGE P IS
+          TYPE CATARRAY IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+
+          TYPE ARRAY_1 IS ARRAY (1..10) OF INTEGER;
+          TYPE ARRAY_2 IS ARRAY (1..4, 1..4) OF INTEGER;
+          TYPE ARRAY_3 IS ARRAY (1..2, 1..3, 1..4) OF INTEGER;
+          TYPE ARRAY_4 IS ARRAY (1..10) OF BOOLEAN;
+          TYPE ARRAY_5 IS ARRAY (1..4, 1..4) OF BOOLEAN;
+          TYPE ARRAY_6 IS ARRAY (1..2, 1..3, 1..4) OF BOOLEAN;
+
+          OBJ_ARA_1 : ARRAY_1 := (1..10 => IDENT_INT(0));
+          OBJ_ARA_2 : ARRAY_2 := (1..4 => (1..4 => IDENT_INT(0)));
+          OBJ_ARA_3 : ARRAY_3 := (1..2 => (1..3 =>
+                                               (1..4 => IDENT_INT(0))));
+          OBJ_ARA_4 : ARRAY_4 := (1..10 => IDENT_BOOL(FALSE));
+          OBJ_ARA_5 : ARRAY_5 := (1..4 => (1..4 => IDENT_BOOL(FALSE)));
+          OBJ_ARA_6 : ARRAY_6 := (1..2 => (1..3 =>
+                                          (1..4 => IDENT_BOOL(FALSE))));
+          OBJ_ARA_7 : CATARRAY (1..10) := (1..10 => IDENT_INT(0));
+          OBJ_ARA_20 : CATARRAY (1..20) := (1..10 => 1,
+                                                11..20 => IDENT_INT(0));
+     END P;
+
+     VAR_ARA_1 : P.ARRAY_1 := (1..10 => IDENT_INT(1));
+     VAR_ARA_2 : P.ARRAY_2 := (1..4 => (1..4 => IDENT_INT(1)));
+     VAR_ARA_3 : P.ARRAY_3 := (1..2 => (1..3 =>
+                                               (1..4 => IDENT_INT(1))));
+     VAR_ARA_4 : P.ARRAY_4 := (1..10 => IDENT_BOOL(TRUE));
+     VAR_ARA_5 : P.ARRAY_5 := (1..4 => (1..4 => IDENT_BOOL(TRUE)));
+     VAR_ARA_6 : P.ARRAY_6 := (1..2 => (1..3 =>
+                                           (1..4 => IDENT_BOOL(TRUE))));
+     VAR_ARA_7 : P.CATARRAY (1..10) := (1..10 => IDENT_INT(1));
+     VAR_ARA_8 : P.ARRAY_4 := (1..10 => IDENT_BOOL(TRUE));
+     VAR_ARA_20 : P.CATARRAY (1..20) := (1..20 => IDENT_INT(0));
+
+BEGIN
+     TEST ("C41325A", "CHECK THAT IMPLICITLY DECLARED ENTITIES CAN " &
+                      "BE SELECTED FROM OUTSIDE THE PACKAGE USING AN " &
+                      "EXPANDED NAME, FOR AN ARRAY TYPE");
+
+     -- CASE 1: MULTIDIMENSIONAL ARRAYS.
+
+     IF P."=" (VAR_ARA_2, P.OBJ_ARA_2) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+     END IF;
+
+     IF P."=" (VAR_ARA_5, P.OBJ_ARA_5) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+     END IF;
+
+     IF P."/=" (VAR_ARA_2, P.ARRAY_2'(1..4 => (1..4 => 1))) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+     END IF;
+
+     IF P."/=" (VAR_ARA_5, P.ARRAY_5'(1..4 => (1..4 => TRUE))) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+     END IF;
+
+     IF P."=" (VAR_ARA_3, P.OBJ_ARA_3) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
+     END IF;
+
+     IF P."/=" (VAR_ARA_6, P.ARRAY_6'(1..2 =>(1..3 =>(1..4 => TRUE)))) 
+          THEN
+               FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 6");
+     END IF;
+
+     -- CASE 2: ONE DIMENSIONAL ARRAYS.
+
+     IF P."=" (VAR_ARA_1, P.OBJ_ARA_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
+     END IF;
+
+     IF P."/=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 1)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
+     END IF;
+
+     VAR_ARA_20 := P."&" (VAR_ARA_7, P.OBJ_ARA_7);
+     IF P."/=" (VAR_ARA_20, P.OBJ_ARA_20) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 9");
+     END IF;
+
+     IF P."<" (VAR_ARA_1, P.OBJ_ARA_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 10");
+     END IF;
+
+     IF P.">" (P.OBJ_ARA_1, VAR_ARA_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 11");
+     END IF;
+
+     IF P."<=" (VAR_ARA_1, P.OBJ_ARA_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 12");
+     END IF;
+
+     IF P."<=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 1)) THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 13");
+     END IF;
+
+     IF P.">=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 2)) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 14");
+     END IF;
+
+     IF P.">=" (VAR_ARA_1, P.ARRAY_1'(1..10 => 1)) THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 15");
+     END IF;
+
+     VAR_ARA_8 := P."NOT" (VAR_ARA_4);
+     IF P."/=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 16");
+     END IF;
+
+     VAR_ARA_8 := P."OR" (VAR_ARA_4, P.OBJ_ARA_4);
+     IF P."=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 17");
+     END IF;
+
+     VAR_ARA_8 := P."AND" (VAR_ARA_4, P.OBJ_ARA_4);
+     IF P."/=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 18");
+     END IF;
+
+     VAR_ARA_8 := P."XOR" (VAR_ARA_4, P.OBJ_ARA_4);
+     IF P."=" (VAR_ARA_8, P.OBJ_ARA_4) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 19");
+     END IF;
+
+     RESULT;
+END C41325A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41326a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41326a.ada
new file mode 100644
index 000000000..9ef3c65b0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41326a.ada
@@ -0,0 +1,72 @@
+-- C41326A.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 IMPLICITLY DECLARED EQUALITY AND INEQUALITY OPERATORS
+-- MAY BE SELECTED FROM OUTSIDE A PACKAGE USING AN EXPANDED NAME, FOR
+-- AN ACCESS TYPE.
+
+-- TBN  7/18/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41326A IS
+
+     PACKAGE P IS
+          TYPE CELL IS
+               RECORD
+                    VALUE : INTEGER;
+               END RECORD;
+          TYPE LINK IS ACCESS CELL;
+
+          OBJ_LINK_1 : LINK := NEW CELL'(VALUE => 1);
+          OBJ_LINK_2 : LINK := OBJ_LINK_1;
+     END P;
+
+     VAR_LINK_1 : P.LINK := NEW P.CELL'(VALUE => 1);
+     VAR_LINK_2 : P.LINK := NEW P.CELL'(VALUE => 2);
+
+BEGIN
+     TEST ("C41326A", "CHECK THAT IMPLICITLY DECLARED EQUALITY AND " &
+                      "INEQUALITY OPERATORS MAY BE SELECTED FROM " &
+                      "OUTSIDE A PACKAGE USING AN EXPANDED NAME, " &
+                      "FOR AN ACCESS TYPE");
+
+     IF P."=" (VAR_LINK_1, P.OBJ_LINK_1) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+     END IF;
+
+     IF P."/=" (P.OBJ_LINK_1, P.OBJ_LINK_2) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+     END IF;
+
+     IF P."=" (VAR_LINK_2.ALL, P.OBJ_LINK_1.ALL) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
+     END IF;
+
+     VAR_LINK_2.VALUE := 1;
+     IF P."/=" (VAR_LINK_2.ALL, P.OBJ_LINK_1.ALL) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
+     END IF;
+
+     RESULT;
+END C41326A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41327a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41327a.ada
new file mode 100644
index 000000000..4d5d85284
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41327a.ada
@@ -0,0 +1,84 @@
+-- C41327A.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 IMPLICITLY DECLARED EQUALITY AND INEQUALITY OPERATORS
+-- MAY BE SELECTED FROM OUTSIDE A PACKAGE USING AN EXPANDED NAME, FOR
+-- A PRIVATE TYPE.
+
+-- TBN  7/18/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41327A IS
+
+     PACKAGE P IS
+          TYPE KEY IS PRIVATE;
+          TYPE CHAR IS PRIVATE;
+          FUNCTION INIT_KEY (X : NATURAL) RETURN KEY;
+          FUNCTION INIT_CHAR (X : CHARACTER) RETURN CHAR;
+     PRIVATE
+          TYPE KEY IS NEW NATURAL;
+          TYPE CHAR IS NEW CHARACTER;
+     END P;
+
+     VAR_KEY_1 : P.KEY;
+     VAR_KEY_2 : P.KEY;
+     VAR_CHAR_1 : P.CHAR;
+     VAR_CHAR_2 : P.CHAR;
+
+     PACKAGE BODY P IS
+
+          FUNCTION INIT_KEY (X : NATURAL) RETURN KEY IS
+          BEGIN
+               RETURN (KEY (X));
+          END INIT_KEY;
+
+          FUNCTION INIT_CHAR (X : CHARACTER) RETURN CHAR IS
+          BEGIN
+               RETURN (CHAR (X));
+          END INIT_CHAR;
+
+     BEGIN
+          NULL;
+     END P;
+
+BEGIN
+     TEST ("C41327A", "CHECK THAT IMPLICITLY DECLARED EQUALITY AND " &
+                      "INEQUALITY OPERATORS MAY BE SELECTED FROM " &
+                      "OUTSIDE A PACKAGE USING AN EXPANDED NAME, " &
+                      "FOR A PRIVATE TYPE");
+
+     VAR_KEY_1 := P.INIT_KEY (1);
+     VAR_KEY_2 := P.INIT_KEY (2);
+     VAR_CHAR_1 := P.INIT_CHAR ('A');
+     VAR_CHAR_2 := P.INIT_CHAR ('A');
+     IF P."=" (VAR_KEY_1, VAR_KEY_2) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
+     END IF;
+
+     IF P."/=" (VAR_CHAR_1, VAR_CHAR_2) THEN
+          FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
+     END IF;
+
+     RESULT;
+END C41327A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41328a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41328a.ada
new file mode 100644
index 000000000..3c6ea5b2f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41328a.ada
@@ -0,0 +1,100 @@
+-- C41328A.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 IMPLICITLY DECLARED DERIVED SUBPROGRAMS CAN BE SELECTED
+-- FROM OUTSIDE A PACKAGE USING AN EXPANDED NAME, FOR A DERIVED TYPE.
+
+-- TBN  7/21/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41328A IS
+
+     PACKAGE P IS
+          PACKAGE Q IS
+               TYPE PAIR IS ARRAY (1..2) OF INTEGER;
+               FUNCTION INIT (INT : INTEGER) RETURN PAIR;
+               PROCEDURE SWAP (TWO : IN OUT PAIR);
+          END Q;
+          TYPE COUPLE IS NEW Q.PAIR;
+     END P;
+
+     VAR_1 : P.COUPLE;
+     VAR_2 : P.COUPLE;
+
+     PACKAGE BODY P IS
+
+          PACKAGE BODY Q IS
+
+               FUNCTION INIT (INT : INTEGER) RETURN PAIR IS
+                    A : PAIR;
+               BEGIN
+                    A (1) := INT;
+                    A (2) := INT + 1;
+                    RETURN (A);
+               END INIT;
+
+               PROCEDURE SWAP (TWO : IN OUT PAIR) IS
+                    TEMP : INTEGER;
+               BEGIN
+                    TEMP := TWO (1);
+                    TWO (1) := TWO (2);
+                    TWO (2) := TEMP;
+               END SWAP;
+
+          BEGIN
+               NULL;
+          END Q;
+
+     BEGIN
+          NULL;
+     END P;
+
+BEGIN
+     TEST ("C41328A", "CHECK THAT IMPLICITLY DECLARED DERIVED " &
+                      "SUBPROGRAMS CAN BE SELECTED FROM OUTSIDE A " &
+                      "PACKAGE USING AN EXPANDED NAME, FOR A DERIVED " &
+                      "TYPE");
+
+     VAR_1 := P.INIT (IDENT_INT(1));
+     IF P."/=" (VAR_1, P.COUPLE'(1 => 1, 2 => 2)) THEN
+          FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 1");
+     END IF;
+
+     VAR_2 := P.INIT (IDENT_INT(2));
+     IF P."=" (VAR_2, P.COUPLE'(1 => 1, 2 => 2)) THEN
+          FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 2");
+     END IF;
+
+     P.SWAP (VAR_1);
+     IF P."=" (VAR_1, P.COUPLE'(1 => 1, 2 => 2)) THEN
+          FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 3");
+     END IF;
+
+     P.SWAP (VAR_2);
+     IF P."/=" (VAR_2, P.COUPLE'(1 => 3, 2 => 2)) THEN
+          FAILED ("INCORRECT RESULTS FROM DERIVED SUBPROGRAM - 4");
+     END IF;
+
+     RESULT;
+END C41328A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41401a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41401a.ada
new file mode 100644
index 000000000..f58a8a472
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41401a.ada
@@ -0,0 +1,216 @@
+-- C41401A.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 IF THE PREFIX OF THE FOLLOWING
+-- ATTRIBUTES HAS THE VALUE NULL:
+--     A) 'CALLABLE AND 'TERMINATED FOR A TASK TYPE.
+--     B) 'FIRST, 'FIRST(N), 'LAST, 'LAST(N), 'LENGTH, 'LENGTH(N),
+--        'RANGE, AND 'RANGE(N) FOR AN ARRAY TYPE.
+
+-- TBN  10/2/86
+-- EDS  07/14/98    AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41401A IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TYPE ACC_TT IS ACCESS TT;
+
+     TYPE NULL_ARR1 IS ARRAY (2 .. 1) OF INTEGER;
+     TYPE ARRAY1 IS ARRAY (INT RANGE <>) OF INTEGER;
+     TYPE NULL_ARR2 IS ARRAY (3 .. 1, 2 .. 1) OF INTEGER;
+     TYPE ARRAY2 IS ARRAY (INT RANGE <>, INT RANGE <>) OF INTEGER;
+     TYPE ACC_NULL1 IS ACCESS NULL_ARR1;
+     TYPE ACC_ARR1 IS ACCESS ARRAY1;
+     TYPE ACC_NULL2 IS ACCESS NULL_ARR2;
+     TYPE ACC_ARR2 IS ACCESS ARRAY2;
+
+     PTR_TT : ACC_TT;
+     PTR_ARA1: ACC_NULL1;
+     PTR_ARA2 : ACC_ARR1 (1 .. 4);
+     PTR_ARA3 : ACC_NULL2;
+     PTR_ARA4 : ACC_ARR2 (1 .. 2, 2 .. 4);
+     BOOL_VAR : BOOLEAN := FALSE;
+     INT_VAR : INTEGER := 1;
+
+     TASK BODY TT IS
+     BEGIN
+          ACCEPT E;
+     END TT;
+
+BEGIN
+     TEST ("C41401A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE " &
+                      "PREFIX HAS A VALUE OF NULL FOR THE FOLLOWING " &
+                      "ATTRIBUTES: 'CALLABLE, 'TERMINATED, 'FIRST, " &
+                      "'LAST, 'LENGTH, AND 'RANGE");
+
+     BEGIN
+          IF EQUAL (3, 2) THEN
+               PTR_TT := NEW TT;
+          END IF;
+          BOOL_VAR := IDENT_BOOL(PTR_TT'CALLABLE);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 1 " & BOOLEAN'IMAGE(BOOL_VAR));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+     END;
+
+     BEGIN
+          IF EQUAL (1, 3) THEN
+               PTR_TT := NEW TT;
+          END IF;
+          BOOL_VAR := IDENT_BOOL(PTR_TT'TERMINATED);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 3 " & BOOLEAN'IMAGE(BOOL_VAR));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+     END;
+
+     BEGIN
+          INT_VAR := IDENT_INT(PTR_ARA1'FIRST);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 5 " & INTEGER'IMAGE(INT_VAR));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+     END;
+
+     BEGIN
+          INT_VAR := IDENT_INT(PTR_ARA2'LAST);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 7 " & INTEGER'IMAGE(INT_VAR));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 8");
+     END;
+
+     BEGIN
+          INT_VAR := IDENT_INT(PTR_ARA1'LENGTH);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 9 " & INTEGER'IMAGE(INT_VAR));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 10");
+     END;
+
+     BEGIN
+          DECLARE
+               A : ARRAY1 (PTR_ARA2'RANGE);
+          BEGIN
+               A (1) := IDENT_INT(1);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 11 " & 
+                       INTEGER'IMAGE(A(1)));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - 11 ");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 12");
+     END;
+
+     BEGIN
+          INT_VAR := IDENT_INT(PTR_ARA3'FIRST(2));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 13 " & INTEGER'IMAGE(INT_VAR));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 14");
+     END;
+
+     BEGIN
+          INT_VAR := IDENT_INT(PTR_ARA4'LAST(2));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 15 " & INTEGER'IMAGE(INT_VAR));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 16");
+     END;
+
+     BEGIN
+          INT_VAR := IDENT_INT(PTR_ARA3'LENGTH(2));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 17 " & INTEGER'IMAGE(INT_VAR));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 18");
+     END;
+
+     BEGIN
+          DECLARE
+               A : ARRAY1 (PTR_ARA4'RANGE(2));
+          BEGIN
+               A (1) := IDENT_INT(1);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 19 " & 
+                       INTEGER'IMAGE(A(1)));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - 19 ");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 20");
+     END;
+
+     BEGIN
+          INT_VAR := IDENT_INT(PTR_ARA4'LAST(1));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 21 " & INTEGER'IMAGE(INT_VAR));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 22");
+     END;
+
+     BEGIN
+          INT_VAR := IDENT_INT(PTR_ARA3'LENGTH(1));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 23 " & INTEGER'IMAGE(INT_VAR));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 24");
+     END;
+
+     RESULT;
+END C41401A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41402a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41402a.ada
new file mode 100644
index 000000000..003fb12eb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41402a.ada
@@ -0,0 +1,118 @@
+-- C41402A.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 CONSTRAINT_ERROR IS NOT RAISED IF THE PREFIX OF
+--     'ADDRESS, 'SIZE, 'FIRST_BIT, 'LAST_BIT, AND 'POSITION HAS THE
+--     VALUE NULL.
+
+-- HISTORY:
+--     TBN  10/02/86  CREATED ORIGINAL TEST.
+--     CJJ  07/01/87  REMOVED TEST FOR 'STORAGE_SIZE, WHICH IS NO LONGER
+--                    PART OF THE OBJECTIVE.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE C41402A IS
+
+     TYPE ARRAY1 IS ARRAY (1 .. 2) OF INTEGER;
+     TYPE ACC_ARA IS ACCESS ARRAY1;
+
+     PTR_ARA : ACC_ARA;
+     VAR1 : INTEGER;
+
+     TYPE REC1 IS
+          RECORD
+               A : INTEGER;
+          END RECORD;
+
+     TYPE ACC_REC1 IS ACCESS REC1;
+
+     TYPE REC2 IS
+          RECORD
+               P_AR : ACC_ARA;
+               P_REC : ACC_REC1;
+          END RECORD;
+
+     OBJ_REC : REC2;
+
+
+     PROCEDURE PROC (A : ADDRESS) IS
+     BEGIN
+          NULL;
+     END;
+
+BEGIN
+     TEST ("C41402A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                      "THE PREFIX OF 'ADDRESS, 'SIZE, " &
+                      "'FIRST_BIT, 'LAST_BIT, AND 'POSITION HAS THE " &
+                      "VALUE NULL");
+
+     BEGIN
+          PROC (PTR_ARA'ADDRESS);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR 'ADDRESS");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED 'ADDRESS");
+     END;
+
+     BEGIN
+          VAR1 := PTR_ARA'SIZE;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR 'SIZE");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED 'SIZE");
+     END;
+
+     BEGIN
+          VAR1 := OBJ_REC.P_AR'FIRST_BIT;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR 'FIRST_BIT");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED 'FIRST_BIT");
+     END;
+
+     BEGIN
+          VAR1 := OBJ_REC.P_AR'LAST_BIT;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR 'LAST_BIT");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED 'LAST_BIT");
+     END;
+
+     BEGIN
+          VAR1 := OBJ_REC.P_REC'POSITION;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR 'POSITION");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED 'POSITION");
+     END;
+
+     RESULT;
+END C41402A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41404a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41404a.ada
new file mode 100644
index 000000000..9aa937852
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c41404a.ada
@@ -0,0 +1,136 @@
+-- C41404A.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 PREFIX OF THE ARRAY ATTRIBUTES CAN BE THE VALUE OF AN
+-- IMAGE ATTRIBUTE.
+
+-- JBG 6/1/85
+-- PWB 2/3/86  CORRECTED COMPARISON VALUES FOR 'LAST AND 'LENGTH.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C41404A IS
+
+     TYPE ENUM IS (ONE, FOUR, 'C');
+
+BEGIN
+
+     TEST ("C41404A", "CHECK WHEN PREFIX OF AN ATTRIBUTE IS 'IMAGE");
+
+     IF ENUM'IMAGE(FOUR)'LENGTH /= IDENT_INT(4) THEN
+          FAILED ("WRONG VALUE FOR LENGTH - ENUM");
+     END IF;
+
+     IF ENUM'IMAGE('C')'LENGTH /= IDENT_INT(3) THEN
+          FAILED ("WRONG VALUE FOR LENGTH - ENUM: 'C'");
+     END IF;
+
+     IF INTEGER'IMAGE(IDENT_INT(56))'LENGTH /= IDENT_INT(3) THEN
+          FAILED ("WRONG VALUE FOR LENGTH - INTEGER: 56");
+     END IF;
+
+     IF CHARACTER'IMAGE(IDENT_CHAR('B'))'LENGTH /= IDENT_INT(3) THEN
+          FAILED ("WRONG VALUE FOR LENGTH - CHAR: 'B'");
+     END IF;
+
+     IF ENUM'IMAGE(FOUR)'FIRST /= IDENT_INT(1) THEN
+          FAILED ("WRONG VALUE FOR FIRST - ENUM");
+     END IF;
+
+     IF ENUM'IMAGE('C')'FIRST(1) /= IDENT_INT(1) THEN
+          FAILED ("WRONG VALUE FOR FIRST - ENUM: 'C'");
+     END IF;
+
+     IF INTEGER'IMAGE(IDENT_INT(56))'FIRST /= IDENT_INT(1) THEN
+          FAILED ("WRONG VALUE FOR FIRST - INTEGER: 56");
+     END IF;
+
+     IF CHARACTER'IMAGE(IDENT_CHAR('B'))'FIRST /= IDENT_INT(1) THEN
+          FAILED ("WRONG VALUE FOR FIRST - CHAR: 'B'");
+     END IF;
+
+     IF ENUM'IMAGE(FOUR)'LAST /= IDENT_INT(4) THEN
+          FAILED ("WRONG VALUE FOR LAST - ENUM");
+     END IF;
+
+     IF ENUM'IMAGE('C')'LAST(1) /= IDENT_INT(3) THEN
+          FAILED ("WRONG VALUE FOR LAST - ENUM: 'C'");
+     END IF;
+
+     IF INTEGER'IMAGE(IDENT_INT(-56))'LAST /= IDENT_INT(3) THEN
+          FAILED ("WRONG VALUE FOR LAST - INTEGER: -56");
+     END IF;
+
+     IF CHARACTER'IMAGE(IDENT_CHAR('B'))'LAST /= IDENT_INT(3) THEN
+          FAILED ("WRONG VALUE FOR LAST - CHAR: 'B'");
+     END IF;
+
+     DECLARE
+
+          FOUR_VAR : STRING(ENUM'IMAGE(FOUR)'RANGE);
+          C_VAR    : STRING(ENUM'IMAGE('C')'RANGE);
+          VAR_101  : STRING(INTEGER'IMAGE(IDENT_INT(101))'RANGE);
+          CHAR_VAR : STRING(CHARACTER'IMAGE(IDENT_CHAR('B'))'RANGE);
+
+     BEGIN
+
+          IF FOUR_VAR'FIRST /= 1 OR
+             FOUR_VAR'LAST  /= 4 OR
+             FOUR_VAR'LENGTH /= 4 THEN
+               FAILED ("FOUR_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
+                       INTEGER'IMAGE(FOUR_VAR'FIRST) & ".  LAST IS" &
+                       INTEGER'IMAGE(FOUR_VAR'LAST) & ".  LENGTH IS" &
+                       INTEGER'IMAGE(FOUR_VAR'LENGTH));
+          END IF;
+
+          IF C_VAR'FIRST /= 1 OR
+             C_VAR'LAST  /= 3 OR
+             C_VAR'LENGTH /= 3 THEN
+               FAILED ("C_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
+                       INTEGER'IMAGE(C_VAR'FIRST) & ".  LAST IS" &
+                       INTEGER'IMAGE(C_VAR'LAST) & ".  LENGTH IS" &
+                       INTEGER'IMAGE(C_VAR'LENGTH));
+          END IF;
+
+          IF VAR_101'FIRST /= 1 OR
+             VAR_101'LAST  /= 4 OR
+             VAR_101'LENGTH /= 4 THEN
+               FAILED ("VAR_101 ATTRIBUTES INCORRECT.  FIRST IS" &
+                       INTEGER'IMAGE(VAR_101'FIRST) & ".  LAST IS" &
+                       INTEGER'IMAGE(VAR_101'LAST) & ".  LENGTH IS" &
+                       INTEGER'IMAGE(VAR_101'LENGTH));
+          END IF;
+
+          IF CHAR_VAR'FIRST /= 1 OR
+             CHAR_VAR'LAST  /= 3 OR
+             CHAR_VAR'LENGTH /= 3 THEN
+               FAILED ("CHAR_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
+                       INTEGER'IMAGE(CHAR_VAR'FIRST) & ".  LAST IS" &
+                       INTEGER'IMAGE(CHAR_VAR'LAST) & ".  LENGTH IS" &
+                       INTEGER'IMAGE(CHAR_VAR'LENGTH));
+          END IF;
+
+     END;
+
+     RESULT;
+END C41404A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c420001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c420001.a
new file mode 100644
index 000000000..ae4b4d8fd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c420001.a
@@ -0,0 +1,110 @@
+-- C420001.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE
+--     Check that if the index subtype of a string type is a modular subtype
+--     whose lower bound is zero, then the evaluation of a null string_literal
+--     raises Constraint_Error. This was confirmed by AI95-00138.
+--
+-- TEST DESCRIPTION
+--     In this test, we have a generic formal modular type, and we have
+--     several null string literals of that type.  Because the type is
+--     generic formal, the string literals are not static, and therefore
+--     the Constraint_Error should be detected at run time.
+--
+-- CHANGE HISTORY:
+--      29 JUN 1999   RAD   Initial Version
+--      23 SEP 1999   RLB   Improved comments and messages, renamed, issued.
+--
+--!
+with Report; use Report; pragma Elaborate_All(Report);
+with System;
+procedure C420001 is
+    generic
+        type Modular is mod <>;
+    package Mod_Test is
+        type Str is array(Modular range <>) of Character;
+        procedure Test_String_Literal;
+    end Mod_Test;
+
+    package body Mod_Test is
+        procedure Test_String_Literal is
+        begin
+            begin
+                declare
+                    Null_String: Str := ""; -- Should raise C_E.
+                begin
+                    Comment(String(Null_String)); -- Avoid 11.6 issues.
+                end;
+                Failed("Null string didn't raise Constraint_Error");
+            exception
+                when Exc: Constraint_Error =>
+                    null; -- Comment("Constraint_Error -- OK");
+                when Exc2: others =>
+                    Failed("Null string raised wrong exception");
+            end;
+            begin
+                Failed(String(Str'(""))); -- Should raise C_E, not do Failed.
+                Failed("Null string didn't raise Constraint_Error");
+            exception
+                when Exc: Constraint_Error =>
+                    null; -- Comment("Constraint_Error -- OK");
+                when Exc2: others =>
+                    Failed("Null string raised wrong exception");
+            end;
+        end Test_String_Literal;
+    begin
+        Test_String_Literal;
+    end Mod_Test;
+begin
+    Test("C420001", "Check that if the index subtype of a string type is a " &
+                    "modular subtype whose lower bound is zero, then the " &
+                    "evaluation of a null string_literal raises " &
+                    "Constraint_Error. ");
+    declare
+        type M1 is mod 1;
+        package Test_M1 is new Mod_Test(M1);
+        type M2 is mod 2;
+        package Test_M2 is new Mod_Test(M2);
+        type M3 is mod 3;
+        package Test_M3 is new Mod_Test(M3);
+        type M4 is mod 4;
+        package Test_M4 is new Mod_Test(M4);
+        type M5 is mod 5;
+        package Test_M5 is new Mod_Test(M5);
+        type M6 is mod 6;
+        package Test_M6 is new Mod_Test(M6);
+        type M7 is mod 7;
+        package Test_M7 is new Mod_Test(M7);
+        type M8 is mod 8;
+        package Test_M8 is new Mod_Test(M8);
+        type M_Max_Binary_Modulus is mod System.Max_Binary_Modulus;
+        package Test_M_Max_Binary_Modulus is new Mod_Test(M_Max_Binary_Modulus);
+        type M_Max_Nonbinary_Modulus is mod System.Max_Nonbinary_Modulus;
+        package Test_M_Max_Nonbinary_Modulus is new Mod_Test(M_Max_Nonbinary_Modulus);
+    begin
+        null;
+    end;
+    Result;
+end C420001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c42006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c42006a.ada
new file mode 100644
index 000000000..6c2201704
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c42006a.ada
@@ -0,0 +1,99 @@
+-- C42006A.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 WHEN A STRING LITERAL OF AN
+-- ARRAY TYPE CONTAINS A CHARACTER THAT DOES NOT BELONG TO THE COMPONENT
+-- SUBTYPE.
+
+-- SPS 2/22/84
+-- EDS 12/02/97  MODIFIED THE COMPONENT SUBTYPES SO THAT THEY ARE NON-STATIC.
+-- EDS 7/14/98    AVOID OPTIMIZATION
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C42006A IS
+BEGIN
+
+     TEST ("C42006A", "CHECK THAT THE VALUES OF STRING LITERALS MUST" &
+           " BELONG TO THE COMPONENT SUBTYPE.");
+
+     DECLARE
+
+          TYPE CHAR_COMP IS ('A', 'B', 'C', 'D', 'E', 'F');
+
+          ASCIINUL : CHARACTER := ASCII.NUL;
+          SUBTYPE NON_GRAPHIC_CHAR IS CHARACTER 
+               RANGE ASCIINUL .. ASCII.BEL;
+
+          BEE : CHAR_COMP := 'B';
+          TYPE CHAR_STRING IS ARRAY (POSITIVE RANGE <>) 
+               OF CHAR_COMP RANGE BEE..'C';
+          TYPE NON_GRAPHIC_CHAR_STRING IS ARRAY (POSITIVE RANGE <>)
+               OF NON_GRAPHIC_CHAR;
+
+          C_STR : CHAR_STRING (1 .. 1);
+          C_STR_5 : CHAR_STRING (1 .. 5) := "BBBBB";
+          N_G_STR : NON_GRAPHIC_CHAR_STRING (1 .. 1) := 
+                    (OTHERS => NON_GRAPHIC_CHAR'FIRST);
+
+     BEGIN
+
+          BEGIN
+               C_STR_5 := "BABCC";      -- 'A' NOT IN COMPONENT SUBTYPE.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 1 " & 
+                       CHAR_COMP'IMAGE(C_STR_5(1)));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("SOME EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               C_STR_5 := "BCBCD";      -- 'D' NOT IN COMPONENT SUBTYPE.
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 2 " & 
+                       CHAR_COMP'IMAGE(C_STR_5(1)));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("SOME EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               N_G_STR := "Z";
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 3 " & 
+                       INTEGER'IMAGE(CHARACTER'POS(N_G_STR(1))));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("SOME EXCEPTION RAISED - 3");
+          END;
+
+     END;
+
+     RESULT;
+
+END C42006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c42007e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c42007e.ada
new file mode 100644
index 000000000..09fd6e6ef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c42007e.ada
@@ -0,0 +1,117 @@
+-- C42007E.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 A STRING LITERAL ARE DETERMINED CORRECTLY.
+-- IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY 'FIRST OF THE
+-- INDEX SUBTYPE WHEN THE STRING LITERAL IS USED AS:
+
+--   E) THE LEFT OR RIGHT OPERAND OF "&".
+
+-- TBN  7/28/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C42007E IS
+
+BEGIN
+
+     TEST("C42007E", "CHECK THE BOUNDS OF A STRING LITERAL WHEN USED " &
+                     "AS THE LEFT OR RIGHT OPERAND OF THE CATENATION " &
+                     "OPERATOR");
+
+     BEGIN
+
+CASE_E :  DECLARE
+
+               SUBTYPE STR_RANGE IS INTEGER RANGE 2 .. 10;
+               TYPE STR IS ARRAY (STR_RANGE RANGE <>) OF CHARACTER;
+
+               FUNCTION CONCAT1 RETURN STR IS
+               BEGIN
+                    RETURN ("ABC" & (7 .. 8 => 'D'));
+               END CONCAT1;
+
+               FUNCTION CONCAT2 RETURN STR IS
+               BEGIN
+                    RETURN ((IDENT_INT(4) .. 3 => 'A') & "BC");
+               END CONCAT2;
+
+               FUNCTION CONCAT3 RETURN STRING IS
+               BEGIN
+                    RETURN ("TEST" & (7 .. 8 => 'X'));
+               END CONCAT3;
+
+               FUNCTION CONCAT4 RETURN STRING IS
+               BEGIN
+                    RETURN ((8 .. 5 => 'A') & "DE");
+               END CONCAT4;
+
+          BEGIN
+
+               IF CONCAT1'FIRST /= IDENT_INT(2) THEN
+                    FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 1");
+               END IF;
+               IF CONCAT1'LAST /= 6 THEN
+                    FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 1");
+               END IF;
+               IF CONCAT1 /= "ABCDD" THEN
+                    FAILED ("STRING INCORRECTLY DETERMINED - 1");
+               END IF;
+
+               IF CONCAT2'FIRST /= IDENT_INT(2) THEN
+                    FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 2");
+               END IF;
+               IF CONCAT2'LAST /= 3 THEN
+                    FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 2");
+               END IF;
+               IF CONCAT2 /= "BC" THEN
+                    FAILED ("STRING INCORRECTLY DETERMINED - 2");
+               END IF;
+
+               IF CONCAT3'FIRST /= IDENT_INT(1) THEN
+                    FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 3");
+               END IF;
+               IF CONCAT3'LAST /= 6 THEN
+                    FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 3");
+               END IF;
+               IF CONCAT3 /= "TESTXX" THEN
+                    FAILED ("STRING INCORRECTLY DETERMINED - 3");
+               END IF;
+
+               IF CONCAT4'FIRST /= IDENT_INT(1) THEN
+                    FAILED ("LOWER BOUND INCORRECTLY DETERMINED - 4");
+               END IF;
+               IF CONCAT4'LAST /= 2 THEN
+                    FAILED ("UPPER BOUND INCORRECTLY DETERMINED - 4");
+               END IF;
+               IF CONCAT4 /= "DE" THEN
+                    FAILED ("STRING INCORRECTLY DETERMINED - 4");
+               END IF;
+
+          END CASE_E;
+
+     END;
+
+     RESULT;
+
+END C42007E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43003a.ada
new file mode 100644
index 000000000..976788118
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43003a.ada
@@ -0,0 +1,64 @@
+-- C43003A.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 WHEN INITIALIZING AN ARRAY OF ACCESS OBJECTS, WITH
+-- AN AGGREGATE CONTAINING A SINGLE ALLOCATOR, ALL ELEMENTS
+-- ARE INITIALIZED TO THE SAME INITIAL VALUE.
+-- THAT IS, CHECK THAT ALL COMPONENTS OF THE ARRAY DESIGNATE
+-- DISTINCT OBJECTS.
+
+-- DAT 3/18/81
+-- SPS 10/26/82
+-- JBG 12/27/82
+-- R. WILLIAMS 11/11/86     RENAMED FROM C38007A-B.ADA.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C43003A IS
+
+     TYPE AI IS ACCESS INTEGER;
+
+     TYPE AAI IS ARRAY (1..5) OF AI;
+
+     A : AAI := AAI'(OTHERS => NEW INTEGER '(2));
+
+BEGIN
+     TEST ("C43003A", "CHECK THAT ALLOCATORS IN INITIALIZATIONS"
+          & " FOR ARRAYS OF ACCESS VALUES ARE EVALUATED ONCE" &
+          " FOR EACH COMPONENT");
+
+     FOR I IN 1..5
+     LOOP
+          FOR J IN I+1..5
+          LOOP
+               IF A(I) = A(J) THEN
+                    FAILED ("DID NOT EVALUATE ALLOCATOR FOR EACH " &
+                            "COMPONENT");
+                    EXIT;
+               END IF;
+          END LOOP;
+     END LOOP;
+
+     RESULT;
+END C43003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43004a.ada
new file mode 100644
index 000000000..86e705de7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43004a.ada
@@ -0,0 +1,350 @@
+-- C43004A.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 CONSTRAINT_ERROR IS RAISED IF A VALUE FOR A
+--     NON-DISCRIMINANT SCALAR COMPONENT OF AN AGGREGATE IS NOT
+--     WITHIN THE RANGE OF THE COMPONENT'S SUBTYPE.
+
+-- HISTORY:
+--     BCB 01/22/88  CREATED ORIGINAL TEST.
+--     RJW 06/27/90  CORRECTED CONSTRAINTS OF TYPE DFIX.
+--     LDC 09/25/90  ADDED A BLOCK IN THE EXCEPTION HANDLER SO IT CAN
+--                   NOT OPTIMIZE IT AWAY,  ALSO INITIALIZED EACH
+--                   OBJECT TO VALID DATA BEFORE DOING THE INVALID,
+--                   MADE 'IDENT_XXX' FUNCTIONS SO THE COMPILER CAN
+--                   NOT JUST EVALUATE THE ASSIGNMENT AND PUT IN CODE
+--                   FOR A CONSTRAINT ERROR IN IS PLACE.
+--     JRL 06/07/96  Changed value in aggregate in subtest 4 to value
+--                   guaranteed to be in the base range of the type FIX.
+--                   Corrected typo.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C43004A IS
+
+     TYPE INT IS RANGE 1 .. 8;
+     SUBTYPE SINT IS INT RANGE 2 .. 7;
+
+     TYPE ENUM IS (VINCE, JOHN, TOM, PHIL, ROSA, JODIE, BRIAN, DAVE);
+     SUBTYPE SENUM IS ENUM RANGE JOHN .. BRIAN;
+
+     TYPE FL IS DIGITS 5 RANGE 0.0 .. 10.0;
+     SUBTYPE SFL IS FL RANGE 1.0 .. 9.0;
+
+     TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 8.0;
+     SUBTYPE SFIX IS FIX RANGE 1.0 .. 7.0;
+
+     TYPE DINT IS NEW INTEGER RANGE 1 .. 8;
+     SUBTYPE SDINT IS DINT RANGE 2 .. 7;
+
+     TYPE DENUM IS NEW ENUM RANGE VINCE .. DAVE;
+     SUBTYPE SDENUM IS DENUM RANGE JOHN .. BRIAN;
+
+     TYPE DFL IS NEW FLOAT RANGE 0.0 .. 10.0;
+     SUBTYPE SDFL IS DFL RANGE 1.0 .. 9.0;
+
+     TYPE DFIX IS NEW FIX RANGE 0.5 .. 7.5;
+     SUBTYPE SDFIX IS DFIX RANGE 1.0 .. 7.0;
+
+     TYPE REC1 IS RECORD
+           E1, E2, E3, E4, E5 : SENUM;
+     END RECORD;
+
+     TYPE REC2 IS RECORD
+           E1, E2, E3, E4, E5 : SFIX;
+     END RECORD;
+
+     TYPE REC3 IS RECORD
+           E1, E2, E3, E4, E5 : SDENUM;
+     END RECORD;
+
+     TYPE REC4 IS RECORD
+           E1, E2, E3, E4, E5 : SDFIX;
+     END RECORD;
+
+     ARRAY_OBJ : ARRAY(1..2) OF INTEGER;
+
+     A  : ARRAY(1..5) OF SINT;
+     B  : REC1;
+     C  : ARRAY(1..5) OF SFL;
+     D  : REC2;
+     E  : ARRAY(1..5) OF SDINT;
+     F  : REC3;
+     G  : ARRAY(1..5) OF SDFL;
+     H  : REC4;
+
+     GENERIC
+          TYPE GENERAL_PURPOSE IS PRIVATE;
+     FUNCTION GENEQUAL(ONE, TWO : GENERAL_PURPOSE) RETURN BOOLEAN;
+
+     FUNCTION GENEQUAL(ONE, TWO : GENERAL_PURPOSE) RETURN BOOLEAN IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN ONE = TWO;
+          ELSE
+               RETURN ONE /= TWO;
+          END IF;
+     END GENEQUAL;
+
+     FUNCTION EQUAL IS NEW GENEQUAL(SENUM);
+     FUNCTION EQUAL IS NEW GENEQUAL(SFL);
+     FUNCTION EQUAL IS NEW GENEQUAL(SFIX);
+     FUNCTION EQUAL IS NEW GENEQUAL(SDENUM);
+     FUNCTION EQUAL IS NEW GENEQUAL(SDFL);
+     FUNCTION EQUAL IS NEW GENEQUAL(SDFIX);
+
+     GENERIC
+          TYPE GENERAL_PURPOSE IS PRIVATE;
+          WITH FUNCTION EQUAL_GENERAL(ONE, TWO : GENERAL_PURPOSE) 
+                   RETURN BOOLEAN;
+     FUNCTION GEN_IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;
+     FUNCTION GEN_IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS
+          BEGIN
+          IF EQUAL_GENERAL (X, X) THEN  -- ALWAYS EQUAL.
+               RETURN X;                -- ALWAYS EXECUTED.
+          END IF;
+                                        -- NEVER EXECUTED.
+          RETURN X;
+     END GEN_IDENT;
+
+     FUNCTION IDENT_FL    IS NEW GEN_IDENT(FL, EQUAL);
+     FUNCTION IDENT_FIX   IS NEW GEN_IDENT(FIX, EQUAL);
+     FUNCTION IDENT_DFL   IS NEW GEN_IDENT(DFL, EQUAL);
+     FUNCTION IDENT_DFIX  IS NEW GEN_IDENT(DFIX, EQUAL);
+
+BEGIN
+     TEST ("C43004A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF A " &
+                      "VALUE FOR A NON-DISCRIMINANT SCALAR COMPONENT " &
+                      "OF AN AGGREGATE IS NOT WITHIN THE RANGE OF " &
+                      "THE COMPONENT'S SUBTYPE");
+
+     ARRAY_OBJ := (1, 2);
+
+     BEGIN
+          A  := (2,3,4,5,6);            -- OK
+
+          IF EQUAL (INTEGER (A(IDENT_INT(1))),
+                    INTEGER (A(IDENT_INT(2)))) THEN
+               COMMENT ("DON'T OPTIMIZE A");
+          END IF;
+
+          A := (SINT(IDENT_INT(1)),2,3,4,7);
+                                       -- CONSTRAINT_ERROR BY AGGREGATE
+                                       -- WITH INTEGER COMPONENTS.
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 1");
+          IF EQUAL (INTEGER (A(IDENT_INT(1))),
+                    INTEGER (A(IDENT_INT(1)))) THEN
+               COMMENT ("DON'T OPTIMIZE A");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                         ARRAY_OBJ(IDENT_INT(2))) THEN
+                    COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                       "WAS RAISED - 1");
+     END;
+
+     BEGIN
+          B := (JOHN,TOM,PHIL,ROSA,JOHN);  -- OK
+
+          IF EQUAL (B.E1, B.E2) THEN
+               COMMENT ("DON'T OPTIMIZE B");
+          END IF;
+
+          B := (ENUM'VAL(IDENT_INT(ENUM'POS(DAVE))), TOM, PHIL,
+                ROSA, JODIE);
+                                       -- CONSTRAINT_ERROR BY AGGREGATE
+                                       -- WITH COMPONENTS OF AN
+                                       -- ENUMERATION TYPE.
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 2");
+          IF NOT EQUAL (B.E1, B.E1) THEN
+               COMMENT ("DON'T OPTIMIZE B");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                         ARRAY_OBJ(IDENT_INT(2))) THEN
+                    COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                       "WAS RAISED - 2");
+     END;
+     BEGIN
+          C := (2.0,3.0,4.0,5.0,6.0);  -- OK
+          IF EQUAL (C(IDENT_INT(1)), C(IDENT_INT(2))) THEN
+               COMMENT ("DON'T OPTIMIZE C");
+          END IF;
+
+          C := (IDENT_FL(1.0),2.0,3.0,4.0,IDENT_FL(10.0));
+                                      -- CONSTRAINT_ERROR BY AGGREGATE
+                                      -- WITH FLOATING POINT COMPONENTS.
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 3");
+          IF NOT EQUAL (C(IDENT_INT(1)), C(IDENT_INT(1))) THEN
+               COMMENT ("DON'T OPTIMIZE C");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                         ARRAY_OBJ(IDENT_INT(2))) THEN
+                    COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                       "WAS RAISED - 3");
+     END;
+
+     BEGIN
+          D := (2.2,3.3,4.4,5.5,6.6); -- OK
+          IF EQUAL (D.E1, D.E5) THEN
+               COMMENT ("DON'T OPTIMIZE D");
+          END IF;
+
+          D := (IDENT_FIX(1.0),2.1,3.3,4.4,IDENT_FIX(7.75));
+                                       -- CONSTRAINT_ERROR BY AGGREGATE
+                                       -- WITH FIXED POINT COMPONENTS.
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 4");
+          IF NOT EQUAL (D.E5, D.E5) THEN
+               COMMENT ("DON'T OPTIMIZE D");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                         ARRAY_OBJ(IDENT_INT(2))) THEN
+                    COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                       "WAS RAISED - 4");
+     END;
+
+     BEGIN
+          E := (2,3,4,5,6); -- OK
+          IF EQUAL (INTEGER (E(IDENT_INT(1))),
+                    INTEGER (E(IDENT_INT(2)))) THEN
+               COMMENT ("DON'T OPTIMIZE E");
+          END IF;
+
+          E := (SDINT(IDENT_INT(1)),2,3,4,7);
+                                     -- CONSTRAINT_ERROR BY AGGREGATE
+                                     -- WITH DERIVED INTEGER COMPONENTS.
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 5");
+          IF NOT EQUAL (INTEGER (E(IDENT_INT(1))),
+                        INTEGER (E(IDENT_INT(1)))) THEN
+               COMMENT ("DON'T OPTIMIZE E");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                         ARRAY_OBJ(IDENT_INT(2))) THEN
+                    COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                       "WAS RAISED - 5");
+     END;
+
+     BEGIN
+          F := (JOHN,TOM,PHIL,ROSA,JOHN);  -- OK
+          IF EQUAL (F.E1, F.E2) THEN
+               COMMENT ("DON'T OPTIMIZE F");
+          END IF;
+
+          F := (DENUM'VAL(IDENT_INT(DENUM'POS(VINCE))), TOM, PHIL,
+                ROSA, JODIE);
+                                       -- CONSTRAINT_ERROR BY AGGREGATE
+                                       -- WITH COMPONENTS OF A DERIVED
+                                       -- ENUMERATION TYPE.
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 6");
+          IF NOT EQUAL (F.E1, F.E1) THEN
+               COMMENT ("DON'T OPTIMIZE F");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                         ARRAY_OBJ(IDENT_INT(2))) THEN
+                    COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                       "WAS RAISED - 6");
+     END;
+
+     BEGIN
+          G := (2.0,3.0,4.0,5.0,6.0); -- OK
+          IF EQUAL (G(IDENT_INT(1)), G(IDENT_INT(2))) THEN
+               COMMENT ("DON'T OPTIMIZE G");
+          END IF;
+
+          G := (IDENT_DFL(1.0),2.0,3.0,4.0,IDENT_DFL(10.0));
+                                       -- CONSTRAINT_ERROR BY AGGREGATE
+                                       -- WITH DERIVED FLOATING POINT
+                                       -- COMPONENTS.
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 7");
+          IF NOT EQUAL (G(IDENT_INT(1)), G(IDENT_INT(1))) THEN
+               COMMENT ("DON'T OPTIMIZE G");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                         ARRAY_OBJ(IDENT_INT(2))) THEN
+                    COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                       "WAS RAISED - 7");
+     END;
+
+     BEGIN
+          H := (2.2,3.3,4.4,5.5,6.6); -- OK
+          IF EQUAL (H.E1, H.E2) THEN
+               COMMENT ("DON'T OPTIMIZE H");
+          END IF;
+
+          H := (IDENT_DFIX(2.0),2.5,3.5,4.3,IDENT_DFIX(7.4));
+                                       -- CONSTRAINT_ERROR BY AGGREGATE
+                                       -- WITH DERIVED FIXED POINT
+                                       -- COMPONENTS.
+          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 8");
+          IF EQUAL (H.E1, H.E5) THEN
+               COMMENT ("DON'T OPTIMIZE H");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF EQUAL (ARRAY_OBJ(IDENT_INT(1)),
+                         ARRAY_OBJ(IDENT_INT(2))) THEN
+                    COMMENT ("DON'T OPTIMIZE EXCEPTION HANDLER");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                       "WAS RAISED - 8");
+     END;
+
+
+     RESULT;
+END C43004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43004c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43004c.ada
new file mode 100644
index 000000000..253467477
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43004c.ada
@@ -0,0 +1,230 @@
+-- C43004C.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 CONSTRAINT_ERROR IS RAISED IF THE VALUE OF A
+--     DISCRIMINANT OF A CONSTRAINED COMPONENT OF AN AGGREGATE DOES
+--     NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE FOR THE
+--     COMPONENT'S SUBTYPE.
+
+-- HISTORY:
+--     BCB 07/19/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C43004C IS
+
+     ZERO : INTEGER := 0;
+
+     TYPE REC (D : INTEGER := 0) IS RECORD
+          COMP1 : INTEGER;
+     END RECORD;
+
+     TYPE DREC (DD : INTEGER := ZERO) IS RECORD
+          DCOMP1 : INTEGER;
+     END RECORD;
+
+     TYPE REC1 IS RECORD
+          A : REC(0);
+     END RECORD;
+
+     TYPE REC2 IS RECORD
+          B : DREC(ZERO);
+     END RECORD;
+
+     TYPE REC3 (D3 : INTEGER := 0) IS RECORD
+          C : REC(D3);
+     END RECORD;
+
+     V : REC1;
+     W : REC2;
+     X : REC3;
+
+     PACKAGE P IS
+          TYPE PRIV1 (D : INTEGER := 0) IS PRIVATE;
+          TYPE PRIV2 (DD : INTEGER := ZERO) IS PRIVATE;
+          FUNCTION INIT (I : INTEGER) RETURN PRIV1;
+     PRIVATE
+          TYPE PRIV1 (D : INTEGER := 0) IS RECORD
+               NULL;
+          END RECORD;
+
+          TYPE PRIV2 (DD : INTEGER := ZERO) IS RECORD
+               NULL;
+          END RECORD;
+     END P;
+
+     TYPE REC7 IS RECORD
+          H : P.PRIV1 (0);
+     END RECORD;
+
+     Y : REC7;
+
+     GENERIC
+          TYPE GP IS PRIVATE;
+     FUNCTION GEN_EQUAL (X, Y : GP) RETURN BOOLEAN;
+
+     FUNCTION GEN_EQUAL (X, Y : GP) RETURN BOOLEAN IS
+     BEGIN
+          RETURN X = Y;
+     END GEN_EQUAL;
+
+     PACKAGE BODY P IS
+          TYPE REC4 IS RECORD
+               E : PRIV1(0);
+          END RECORD;
+
+          TYPE REC5 IS RECORD
+               F : PRIV2(ZERO);
+          END RECORD;
+
+          TYPE REC6 (D6 : INTEGER := 0) IS RECORD
+               G : PRIV1(D6);
+          END RECORD;
+
+          VV : REC4;
+          WW : REC5;
+          XX : REC6;
+
+          FUNCTION REC4_EQUAL IS NEW GEN_EQUAL (REC4);
+          FUNCTION REC5_EQUAL IS NEW GEN_EQUAL (REC5);
+          FUNCTION REC6_EQUAL IS NEW GEN_EQUAL (REC6);
+
+          FUNCTION INIT (I : INTEGER) RETURN PRIV1 IS
+               VAR : PRIV1;
+          BEGIN
+               VAR := (D => I);
+               RETURN VAR;
+          END INIT;
+     BEGIN
+          TEST ("C43004C", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                           "IF THE VALUE OF A DISCRIMINANT OF A " &
+                           "CONSTRAINED COMPONENT OF AN AGGREGATE " &
+                           "DOES NOT EQUAL THE CORRESPONDING " &
+                            "DISCRIMINANT VALUE FOR THECOMPONENT'S " &
+                           "SUBTYPE");
+
+          BEGIN
+               VV := (E => (D => 1));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
+               IF REC4_EQUAL (VV,VV) THEN
+                    COMMENT ("DON'T OPTIMIZE VV");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               WW := (F => (DD => 1));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
+               IF REC5_EQUAL (WW,WW) THEN
+                    COMMENT ("DON'T OPTIMIZE WW");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               XX := (D6 => 1, G => (D => 5));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - 3");
+               IF REC6_EQUAL (XX,XX) THEN
+                    COMMENT ("DON'T OPTIMIZE XX");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 3");
+          END;
+     END P;
+
+     USE P;
+
+     FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
+     FUNCTION REC2_EQUAL IS NEW GEN_EQUAL (REC2);
+     FUNCTION REC3_EQUAL IS NEW GEN_EQUAL (REC3);
+     FUNCTION REC7_EQUAL IS NEW GEN_EQUAL (REC7);
+
+BEGIN
+
+     BEGIN
+          V := (A => (D => 1, COMP1 => 2));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 4");
+          IF REC1_EQUAL (V,V) THEN
+               COMMENT ("DON'T OPTIMIZE V");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED - 4");
+     END;
+
+     BEGIN
+          W := (B => (DD => 1, DCOMP1 => 2));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 5");
+          IF REC2_EQUAL (W,W) THEN
+               COMMENT ("DON'T OPTIMIZE W");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED - 5");
+     END;
+
+     BEGIN
+          X := (D3 => 1, C => (D => 5, COMP1 => 2));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 6");
+          IF REC3_EQUAL (X,X) THEN
+               COMMENT ("DON'T OPTIMIZE X");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED - 6");
+     END;
+
+     BEGIN
+          Y := (H => INIT (1));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - 7");
+          IF REC7_EQUAL (Y,Y) THEN
+               COMMENT ("DON'T OPTIMIZE Y");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED - 7");
+     END;
+
+     RESULT;
+END C43004C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c431001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c431001.a
new file mode 100644
index 000000000..7d417ce69
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c431001.a
@@ -0,0 +1,464 @@
+-- C431001.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 record aggregate can be given for a nonprivate,
+--      nonlimited record extension and that the tag of the aggregate 
+--      values are initialized to the tag of the record extension.
+--
+-- TEST DESCRIPTION:
+--      From an initial parent tagged type, several type extensions
+--      are declared. Each type extension adds components onto
+--      the existing record structure.
+--
+--      In the main procedure, aggregates are declared in two ways.
+--      In the declarative part, aggregates are used to supply
+--      initial values for objects of specific types. In the executable
+--      part, aggregates are used directly as actual parameters to
+--      a class-wide formal parameter.
+--
+--      The abstraction is for a catalog of recordings. A recording
+--      can be a CD or a record (vinyl). Additionally, a CD may also
+--      be a CD-ROM, containing both music and data. This type is declared
+--      as an extension to a type extension, to test that the inclusion
+--      of record components is transitive across multiple extensions.
+--
+--      That the aggregate has the correct tag is verify by feeding
+--      it to a dispatching operation and confirming that the
+--      expected subprogram is called as a result. To accomplish this,
+--      an enumeration type is declared with an enumeration literal
+--      representing each of the declared types in the hierarchy. A value
+--      of this type is passed as a parameter to the dispatching
+--      operation which passes it along to the dispatched subprogram.
+--      Each dispatched subprogram verifies that it received the
+--      expected enumeration literal.
+--
+--      Not quite fitting the above abstraction are several test cases
+--      for null records. These tests verify that the new syntax for
+--      null record aggregates, (null record), is supported. A type is
+--      declared which extends a null tagged type and adds components.
+--      Aggregates of this type should include associations for the
+--      components of the type extension only. Finally, a type is
+--      declared that adds a null type extension onto a non-null tagged
+--      type. The aggregate associations should remain the same.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--
+--!
+--
+package C431001_0 is
+
+   -- Values of TC_Type_ID are passed through to dispatched subprogram
+   -- calls so that it can be verified that the dispatching resulted in
+   -- the expected call.
+   type TC_Type_ID is (TC_Recording, TC_CD, TC_Vinyl, TC_CD_ROM);
+
+   type Genre is (Classical, Country, Jazz, Rap, Rock, World);
+
+   type Recording is tagged record
+      Artist     : String (1..20);
+      Category   : Genre;
+      Length     : Duration;
+      Selections : Positive;
+   end record;
+
+   function Summary (R       : in Recording;
+                     TC_Type : in TC_Type_ID) return String;
+
+   type Recording_Method is (Audio, Digital);
+   type CD is new Recording with record
+      Recorded : Recording_Method;
+      Mastered : Recording_Method;
+   end record;
+
+   function Summary (Disc    : in CD;
+                     TC_Type : in TC_Type_ID) return String;
+
+   type Playing_Speed is (LP_33, Single_45, Old_78);
+   type Vinyl is new Recording with record
+      Speed : Playing_Speed;
+   end record;
+
+   function Summary (Album   : in Vinyl;
+                     TC_Type : in TC_Type_ID)  return String;
+                       
+
+   type CD_ROM is new CD with record
+      Storage : Positive;
+   end record;
+
+   function Summary (Disk    : in CD_ROM;
+                     TC_Type : in TC_Type_ID)  return String;
+                       
+   function Catalog_Entry (R       : in Recording'Class;
+                           TC_Type : in TC_Type_ID) return String;
+
+   procedure Print (S : in String); -- provides somewhere for the
+                                    -- results of Catalog_Entry to
+                                    -- "go", so they don't get
+                                    -- optimized away.
+
+   -- The types and procedures declared below are not a continuation
+   -- of the Recording abstraction. These types are intended to test
+   -- support for null tagged types and type extensions. TC_Check mirrors
+   -- the operation of function Summary, above. Similarly, TC_Dispatch
+   -- mirrors the operation of Catalog_Entry.
+
+   type TC_N_Type_ID is
+      (TC_Null_Tagged, TC_Null_Extension,
+       TC_Extension_Of_Null, TC_Null_Extension_Of_Nonnull);
+
+   type Null_Tagged is tagged null record;
+   procedure TC_Check (N       : in Null_Tagged;
+                       TC_Type : in TC_N_Type_ID);
+
+   type Null_Extension is new Null_Tagged with null record;
+   procedure TC_Check (N       : in Null_Extension;
+                       TC_Type : in TC_N_Type_ID);
+   
+   type Extension_Of_Null is new Null_Tagged with record
+      New_Component1 : Boolean;
+      New_Component2 : Natural;
+   end record;
+   procedure TC_Check (N       : in Extension_Of_Null;
+                       TC_Type : in TC_N_Type_ID);
+
+   type Null_Extension_Of_Nonnull is new Extension_Of_Null
+      with null record;
+   procedure TC_Check (N       : in Null_Extension_Of_Nonnull;
+                       TC_Type : in TC_N_Type_ID);
+
+   procedure TC_Dispatch (N       : in Null_Tagged'Class;
+                          TC_Type : in TC_N_Type_ID);
+
+end C431001_0;
+
+with Report;
+package body C431001_0 is
+
+   function Summary (R       : in Recording;
+                     TC_Type : in TC_Type_ID) return String is
+   begin
+
+      if TC_Type /= TC_Recording then
+         Report.Failed ("Did not dispatch on tag for tagged parent " &
+                        "type Recording");
+      end if;
+
+      return R.Artist (1..10)
+             & ' ' & Genre'Image (R.Category) (1..2)
+             & ' ' & Duration'Image (R.Length)
+             & ' ' & Integer'Image (R.Selections);
+
+   end Summary;
+
+   function Summary (Disc    : in CD;
+                     TC_Type : in TC_Type_ID) return String is
+   begin
+
+      if TC_Type /= TC_CD then
+         Report.Failed ("Did not dispatch on tag for type extension " &
+                        "CD");
+      end if;
+
+      return Summary (Recording (Disc), TC_Type => TC_Recording)
+         & ' ' & Recording_Method'Image(Disc.Recorded)(1)
+         & Recording_Method'Image(Disc.Mastered)(1);
+
+   end Summary;
+
+   function Summary (Album   : in Vinyl;
+                     TC_Type : in TC_Type_ID)  return String is
+   begin
+      if TC_Type /= TC_Vinyl then
+         Report.Failed ("Did not dispatch on tag for type extension " &
+                        "Vinyl");
+      end if;
+
+      case Album.Speed is
+      when LP_33 =>
+         return Summary (Recording (Album), TC_Type => TC_Recording)
+            & " 33";
+      when Single_45 =>
+         return Summary (Recording (Album), TC_Type => TC_Recording)      
+            & " 45";
+      when Old_78 =>
+         return Summary (Recording (Album), TC_Type => TC_Recording)      
+            & " 78";
+      end case;
+
+   end Summary;
+
+   function Summary (Disk    : in CD_ROM;
+                     TC_Type : in TC_Type_ID)  return String is
+   begin
+      if TC_Type /= TC_CD_ROM then
+         Report.Failed ("Did not dispatch on tag for type extension " &
+                        "CD_ROM. This is an extension of the type " &
+                        "extension CD");
+      end if;
+
+      return Summary (Recording(Disk), TC_Type => TC_Recording)
+         & ' ' & Integer'Image (Disk.Storage) & 'K';
+
+   end Summary;
+
+   function Catalog_Entry (R       : in Recording'Class;
+                           TC_Type : in TC_Type_ID) return String is
+   begin
+      return Summary (R, TC_Type); -- dispatched call
+   end Catalog_Entry;
+
+   procedure Print (S : in String) is
+      T : String (1..S'Length) := Report.Ident_Str (S);
+   begin
+      -- Ada.Text_IO.Put_Line (S);
+      null;
+   end Print;
+   
+   -- Bodies for null type checks
+   procedure TC_Check (N       : in Null_Tagged;
+                       TC_Type : in TC_N_Type_ID) is
+   begin
+      if TC_Type /= TC_Null_Tagged then
+         Report.Failed ("Did not dispatch on tag for null tagged " &
+                        "type Null_Tagged");
+      end if;
+   end TC_Check;
+
+   procedure TC_Check (N       : in Null_Extension;
+                       TC_Type : in TC_N_Type_ID) is
+   begin
+      if TC_Type /= TC_Null_Extension then
+         Report.Failed ("Did not dispatch on tag for null tagged " &
+                        "type extension Null_Extension");
+      end if;
+   end TC_Check;
+   
+   procedure TC_Check (N       : in Extension_Of_Null;
+                       TC_Type : in TC_N_Type_ID) is
+   begin
+      if TC_Type /= TC_Extension_Of_Null then
+         Report.Failed
+            ("Did not dispatch on tag for extension of null parent" &
+             "type");
+      end if;
+   end TC_Check;
+
+   procedure TC_Check (N       : in Null_Extension_Of_Nonnull;
+                       TC_Type : in TC_N_Type_ID) is
+   begin
+      if TC_Type /= TC_Null_Extension_Of_Nonnull then
+         Report.Failed
+            ("Did not dispatch on tag for null extension of nonnull " &
+             "parent type");
+      end if;
+   end TC_Check;
+
+   procedure TC_Dispatch (N       : in Null_Tagged'Class;
+                          TC_Type : in TC_N_Type_ID) is
+   begin
+      TC_Check (N, TC_Type); -- dispatched call
+   end TC_Dispatch;
+
+end C431001_0;
+
+
+with C431001_0;
+with Report;
+procedure C431001 is
+
+   -- Tagged type
+   -- Named component associations
+   DAT : C431001_0.Recording :=
+      (Artist     => "Aerosmith           ",
+       Category   => C431001_0.Rock,
+       Length     => 48.5,
+       Selections => 10);
+
+   -- Type extensions
+   -- Named component associations
+   Disc1 : C431001_0.CD :=
+      (Artist     => "London Symphony     ",
+       Category   => C431001_0.Classical,
+       Length     => 55.0,
+       Selections => 4,
+       Recorded   => C431001_0.Digital,
+       Mastered   => C431001_0.Digital);
+   
+   -- Named component associations with others
+   Disc2 : C431001_0.CD :=
+      (Artist     => "Pink Floyd          ",
+       Category   => C431001_0.Rock,
+       Length     => 51.8,
+       Selections => 5,
+       others     => C431001_0.Audio); -- Recorded
+                                       -- Mastered
+   
+   -- Positional component associations
+   Album1 : C431001_0.Vinyl :=
+      ("Hammer              ", -- Artist
+       C431001_0.Rap,          -- Category
+       46.2,                   -- Length
+       9,                      -- Selections
+       C431001_0.LP_33);       -- Speed
+   
+   -- Mixed positional and named component associations
+   -- Named component associations out of order
+   Album2 : C431001_0.Vinyl :=
+      ("Balinese Gamelan    ", -- Artist 
+       C431001_0.World,        -- Category
+       42.6,                   -- Length
+       14,                     -- Selections
+       C431001_0.LP_33);       -- Speed
+   
+   -- Type extension, parent is also type extension
+   -- Named notation, components out of order
+   Data : C431001_0.CD_ROM :=
+      (Storage    => 140,
+       Mastered   => C431001_0.Digital,
+       Category   => C431001_0.Rock,
+       Selections => 10,
+       Recorded   => C431001_0.Digital,
+       Artist     => "Black, Clint        ",
+       Length     => 48.5);
+
+   -- Null tagged type
+   Null_Rec : C431001_0.Null_Tagged := (null record);
+
+   -- Null type extension
+   Null_Ext : C431001_0.Null_Extension := (null record);
+
+   -- Nonnull extension of null parent
+   Ext_Of_Null : C431001_0.Extension_Of_Null := (True, 0);
+
+   -- Null extension of nonnull parent
+   Null_Ext_Of_Nonnull : C431001_0.Null_Extension_Of_Nonnull
+      := (False, 1);
+
+begin
+
+   Report.Test ("C431001", "Aggregate values for type extensions");
+
+   C431001_0.Print (C431001_0.Catalog_Entry (DAT, C431001_0.TC_Recording));
+   C431001_0.Print (C431001_0.Catalog_Entry (Disc1, C431001_0.TC_CD));
+   C431001_0.Print (C431001_0.Catalog_Entry (Disc2, C431001_0.TC_CD));
+   C431001_0.Print (C431001_0.Catalog_Entry (Album1, C431001_0.TC_Vinyl));
+   C431001_0.Print (C431001_0.Catalog_Entry (Album2, C431001_0.TC_Vinyl));
+   C431001_0.Print (C431001_0.Catalog_Entry (Data, C431001_0.TC_CD_ROM));
+
+   C431001_0.TC_Dispatch (Null_Rec, C431001_0.TC_Null_Tagged);
+   C431001_0.TC_Dispatch (Null_Ext, C431001_0.TC_Null_Extension);
+   C431001_0.TC_Dispatch (Ext_Of_Null, C431001_0.TC_Extension_Of_Null);
+   C431001_0.TC_Dispatch
+      (Null_Ext_Of_Nonnull, C431001_0.TC_Null_Extension_Of_Nonnull);
+
+   -- Tagged type
+   -- Named component associations
+   C431001_0.Print (C431001_0.Catalog_Entry
+      (TC_Type => C431001_0.TC_Recording,
+       R => C431001_0.Recording'(Artist     => "Zappa, Frank        ",
+                                 Category   => C431001_0.Rock,
+                                 Length     => 70.0,
+                                 Selections => 38)));
+
+   -- Type extensions
+   -- Named component associations
+   C431001_0.Print (C431001_0.Catalog_Entry
+      (TC_Type => C431001_0.TC_CD,
+       R => C431001_0.CD'(Artist     => "Dog, Snoop Doggy    ",
+                          Category   => C431001_0.Rap,
+                          Length     => 37.3,
+                          Selections => 8,
+                          Recorded   => C431001_0.Audio,
+                          Mastered   => C431001_0.Digital)));
+
+   -- Named component associations with others
+   C431001_0.Print (C431001_0.Catalog_Entry
+      (TC_Type => C431001_0.TC_CD,
+       R => C431001_0.CD'(Artist     => "Judd, Winona        ",
+                          Category   => C431001_0.Country,
+                          Length     => 51.2,
+                          Selections => 11,
+                          others     => C431001_0.Digital))); -- Recorded
+                                                              -- Mastered
+
+   -- Positional component associations
+   C431001_0.Print (C431001_0.Catalog_Entry
+      (TC_Type => C431001_0.TC_Vinyl,
+       R => C431001_0.Vinyl'("Davis, Miles        ",  -- Artist
+                              C431001_0.Jazz,         -- Category
+                              50.4,                   -- Length
+                              10,                     -- Selections
+                              C431001_0.LP_33)));      -- Speed
+
+   -- Mixed positional and named component associations
+   -- Named component associations out of order
+   C431001_0.Print (C431001_0.Catalog_Entry
+      (TC_Type => C431001_0.TC_Vinyl,
+       R => C431001_0.Vinyl'("Zamfir              ",    -- Artist
+                              C431001_0.World,          -- Category
+                              Speed => C431001_0.LP_33,
+                              Selections => 14,
+                              Length => 56.5)));
+
+   -- Type extension, parent is also type extension
+   -- Named notation, components out of order
+   C431001_0.Print (C431001_0.Catalog_Entry
+      (TC_Type => C431001_0.TC_CD_ROM,
+       R => C431001_0.CD_ROM'(Storage         => 720,
+                              Category        => C431001_0.Classical,
+                              Recorded        => C431001_0.Digital,
+                              Artist          => "Baltimore Symphony  ",
+                              Length          => 68.9,
+                              Mastered        => C431001_0.Digital,
+                              Selections      => 5)));
+   
+   -- Null tagged type
+   C431001_0.TC_Dispatch
+      (TC_Type => C431001_0.TC_Null_Tagged,
+       N => C431001_0.Null_Tagged'(null record));
+
+   -- Null type extension
+   C431001_0.TC_Dispatch
+      (TC_Type => C431001_0.TC_Null_Extension,
+       N => C431001_0.Null_Extension'(null record));
+
+   -- Nonnull extension of null parent
+   C431001_0.TC_Dispatch
+      (TC_Type => C431001_0.TC_Extension_Of_Null,
+       N => C431001_0.Extension_Of_Null'(True, 3));
+
+   -- Null extension of nonnull parent
+   C431001_0.TC_Dispatch
+      (TC_Type => C431001_0.TC_Extension_Of_Null,
+       N => C431001_0.Extension_Of_Null'(False, 4));
+
+   Report.Result;
+
+end C431001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43103a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43103a.ada
new file mode 100644
index 000000000..4267f5895
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43103a.ada
@@ -0,0 +1,127 @@
+-- C43103A.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 DISCRIMINANT DOES NOT GOVERN A VARIANT PART,
+-- ITS VALUE CAN BE GIVEN BY A NON-STATIC EXPRESSION.
+
+-- EG  02/13/84
+
+WITH REPORT;
+
+PROCEDURE C43103A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43103A","CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN " &
+                    "A VARIANT PART, ITS VALUE CAN BE GIVEN BY A "  &
+                    "NON-STATIC EXPRESSION");
+
+     BEGIN
+
+          COMMENT ("CASE A : DISCRIMINANT THAT IS NOT USED INSIDE " &
+                   "THE RECORD");
+
+CASE_A :  DECLARE
+
+               TYPE R1 (A : INTEGER) IS
+                    RECORD
+                         B : STRING(1 .. 2);
+                         C : INTEGER;
+                    END RECORD;
+
+               A1 : R1(IDENT_INT(5)) := (IDENT_INT(5), "AB", -2);
+
+          BEGIN
+
+               IF A1.A /= IDENT_INT(5) OR A1.B /= "AB" OR 
+                  A1.C /= -2 THEN
+                    FAILED ("CASE A : INCORRECT VALUES IN RECORD");
+               END IF;
+
+          END CASE_A;
+
+          COMMENT ("CASE B : DISCRIMINANT THAT IS USED AS AN ARRAY " &
+                   "INDEX BOUND");
+
+CASE_B :  DECLARE
+
+               SUBTYPE STB IS INTEGER RANGE 1 .. 10;
+               TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER;
+               TYPE R2 (A : STB) IS
+                    RECORD
+                         B : TB(1 .. A);
+                         C : BOOLEAN;
+                    END RECORD;
+
+               B1 : R2(IDENT_INT(2)) := (IDENT_INT(2), (-1, -2), FALSE);
+
+          BEGIN
+
+               IF B1.B'LAST /= IDENT_INT(2) THEN
+                    FAILED ("CASE B : INCORRECT UPPER BOUND");
+               ELSIF B1.A /= IDENT_INT(2) OR B1.B /= (-1, -2) OR
+                     B1.C /= FALSE THEN
+                    FAILED ("CASE B : INCORRECT VALUES IN RECORD");
+               END IF;
+
+          END CASE_B;
+
+          COMMENT ("CASE C : DISCRIMINANT THAT IS USED IN A " &
+                   "DISCRIMINANT CONSTRAINT");
+
+CASE_C :  DECLARE
+
+               SUBTYPE STC IS INTEGER RANGE 1 .. 10;
+               TYPE TC IS ARRAY(STC RANGE <>) OF INTEGER;
+               TYPE R3 (A : STC) IS
+                    RECORD
+                         B : TC(1 .. A);
+                         C : INTEGER := -4;
+                    END RECORD;
+               TYPE R4 (A : INTEGER) IS
+                    RECORD
+                         B : R3(A);
+                         C : INTEGER;
+                    END RECORD;
+
+               C1 : R4(IDENT_INT(3)) := (IDENT_INT(3), 
+                                         (IDENT_INT(3), (1, 2, 3), 4),
+                                         5);
+
+          BEGIN
+
+               IF C1.B.B /= (1, 2, 3) OR C1.B.C /= 4 OR
+                  C1.C   /= 5 THEN
+                    FAILED ("CASE C : INCORRECT VALUES IN RECORD");
+               END IF;
+
+          END CASE_C;
+
+     END;
+
+     RESULT;
+
+END C43103A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43103b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43103b.ada
new file mode 100644
index 000000000..994e42459
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43103b.ada
@@ -0,0 +1,186 @@
+-- C43103B.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 DISCRIMINANT DOES NOT GOVERN A VARIANT PART, ITS
+-- VALUE CAN BE GIVEN BY A NONSTATIC EXPRESSION.
+-- ADDITIONAL CASES OF USE OF A DISCRIMINANT THAT IS USED AS AN
+-- ARRAY INDEX BOUND.
+
+-- PK  02/21/84
+-- EG  05/30/84
+-- EG  11/02/84
+-- DN  12/01/95  REMOVED CONFORMANCE CHECKS WHERE RULES RELAXED.
+-- PWN 10/25/96  RESTORED CHECK WITH ADA 95 EXPECTED RESULTS INCLUDED.
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE C43103B IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+
+     TYPE A2 IS ARRAY(INT RANGE <>, INT RANGE <>) OF INTEGER;
+
+     SUBTYPE DINT IS INTEGER RANGE 0 .. 10;
+          
+     TYPE REC(D, E : DINT := IDENT_INT(1)) IS RECORD
+          U : A2(1 .. D, E .. 3) := (1 .. D =>
+                                     (E .. 3 => IDENT_INT(1)));
+     END RECORD;
+
+BEGIN
+
+     TEST("C43103B","CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN " &
+                    "A VARIANT PART, ITS VALUE CAN BE GIVEN BY A "  &
+                    "NONSTATIC EXPRESSION");
+
+-- SIMPLE DECLARATIONS
+
+     BEGIN
+
+          DECLARE
+
+               L : REC(IDENT_INT(2), IDENT_INT(2));
+               K : REC(IDENT_INT(0), IDENT_INT(1));
+               M : REC(IDENT_INT(3), IDENT_INT(4));
+
+          BEGIN
+               IF L.U'FIRST(1) /= IDENT_INT(1) OR
+                  L.U'LAST(1)  /= IDENT_INT(2) OR
+                  L.U'FIRST(2) /= IDENT_INT(2) OR
+                  L.U'LAST(2)  /= IDENT_INT(3) THEN
+                    FAILED("1.1 - INCORRECT BOUNDS");
+               END IF;
+               IF K.U'FIRST(1) /= IDENT_INT(1) OR
+                  K.U'LAST(1)  /= IDENT_INT(0) OR
+                  K.U'FIRST(2) /= IDENT_INT(1) OR
+                  K.U'LAST(2)  /= IDENT_INT(3) THEN
+                    FAILED("1.2 - INCORRECT BOUNDS");
+               END IF;
+               IF M.U'FIRST(1) /= IDENT_INT(1) OR
+                  M.U'LAST(1)  /= IDENT_INT(3) OR
+                  M.U'FIRST(2) /= IDENT_INT(4) OR
+                  M.U'LAST(2)  /= IDENT_INT(3) THEN
+                    FAILED("1.3 - INCORRECT BOUNDS");
+               END IF;
+               IF M.U'LENGTH(1) /= 3 OR M.U'LENGTH(2) /= 0 THEN
+                    FAILED("1.4 - INCORRECT ARRAY LENGTH");
+               END IF;
+          END;
+
+     EXCEPTION
+
+          WHEN OTHERS => 
+               FAILED ("1.5 - EXCEPTION RAISED");
+
+     END;
+
+-- EXPLICIT INITIAL VALUE - OK
+
+     BEGIN
+
+          DECLARE
+               O : CONSTANT REC := (IDENT_INT(2), IDENT_INT(2),
+                        ((1, IDENT_INT(2)), (IDENT_INT(2), 3)));
+          BEGIN
+               IF O.U'FIRST(1) /= IDENT_INT(1) OR
+                  O.U'LAST(1)  /= IDENT_INT(2) OR
+                  O.U'FIRST(2) /= IDENT_INT(2) OR
+                  O.U'LAST(2)  /= IDENT_INT(3) THEN
+                    FAILED("2.1 - INCORRECT BOUNDS");
+               END IF;
+          END;
+
+     EXCEPTION
+
+          WHEN OTHERS => 
+               FAILED ("2.2 - EXCEPTION RAISED");
+     END;
+
+-- EXPLICIT INITIAL VALUE: NULL ARRAY WITH WRONG BOUNDS
+
+     BEGIN
+
+          DECLARE
+               P : CONSTANT REC := (IDENT_INT(0), IDENT_INT(2),
+                                    (IDENT_INT(3) .. IDENT_INT(0) =>
+                                     (IDENT_INT(2), 3)));
+          BEGIN
+                NULL;
+          END;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("3.1 -  CONSTRAINT_ERROR RAISED");
+          WHEN OTHERS => 
+               FAILED ("3.2 -  WRONG EXCEPTION RAISED");
+     END;
+ 
+-- EXPLICIT INITIAL VALUE: NULL ARRAY WITH WRONG BOUNDS
+
+     BEGIN
+
+          DECLARE
+               P : CONSTANT REC := (IDENT_INT(0), IDENT_INT(2),
+                                    (IDENT_INT(3) .. IDENT_INT(0) =>
+                                     (OTHERS => IDENT_INT(2))));
+          BEGIN
+               NULL;
+          END;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR => 
+               FAILED ("4.1 - CONSTRAINT_ERROR RAISED");
+          WHEN OTHERS => 
+               FAILED ("4.2 - WRONG EXCEPTION RAISED");
+
+     END;
+
+-- EXPLICIT INITIAL VALUE: NULL ARRAY WITH WRONG BOUNDS 2ND DIM.
+
+     BEGIN
+
+          DECLARE
+               P : CONSTANT REC := (IDENT_INT(0), IDENT_INT(2),
+                                    (IDENT_INT(1) .. IDENT_INT(0) =>
+                                     (IDENT_INT(1) .. IDENT_INT(2) =>
+                                      1)));
+          BEGIN
+               NULL;
+          END;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR => 
+               FAILED ("5.1 - CONSTRAINT_ERROR RAISED");
+          WHEN OTHERS => 
+               FAILED ("5.2 - WRONG EXCEPTION RAISED");
+
+     END;
+              
+     RESULT;
+
+END C43103B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43104a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43104a.ada
new file mode 100644
index 000000000..3c1ee9dda
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43104a.ada
@@ -0,0 +1,86 @@
+-- C43104A.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 WITH THE TYPE OF THE AGGREGATE RESOLVED, THE
+--     DISCRIMINANT MAY BE USED TO DECIDE TO WHICH OF THE VARIANT'S
+--     SUBTYPES THE AGGREGATE BELONGS.
+
+-- HISTORY:
+--     DHH 08/08/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43104A IS
+
+     TYPE INT IS RANGE 0 .. 10;
+
+     TYPE VAR_REC(BOOL : BOOLEAN := TRUE) IS
+          RECORD
+               CASE BOOL IS
+                    WHEN TRUE =>
+                         X : INTEGER;
+                    WHEN FALSE =>
+                         Y : INT;
+               END CASE;
+          END RECORD;
+
+     SUBTYPE S_TRUE IS VAR_REC(TRUE);
+     SUBTYPE S_FALSE IS VAR_REC(FALSE);
+
+     PROCEDURE CHECK(P : IN S_TRUE) IS
+     BEGIN
+          IF P.BOOL = FALSE THEN
+               FAILED("WRONG PROCEDURE ENTERED");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED("EXCEPTION RAISED INSIDE PROCEDURE");
+
+     END CHECK;
+
+BEGIN
+     TEST("C43104A", "CHECK THAT WITH THE TYPE OF THE AGGREGATE " &
+                     "RESOLVED, THE DISCRIMINANT MAY BE USED TO " &
+                     "DECIDE TO WHICH OF THE VARIANT'S SUBTYPES " &
+                     "THE AGGREGATE BELONGS");
+
+     CHECK((TRUE, 1));
+
+     BEGIN
+
+          CHECK((FALSE, 2));
+          FAILED("PROCEDURE CALL USING '(FALSE, 2)' DID NOT RAISE " &
+                 "EXCEPTION");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED("INCORRECT EXCEPTION RAISED ON PROCEDURE CALL " &
+                      "USING '(FALSE,2)'");
+     END;
+
+     RESULT;
+END C43104A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43105a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43105a.ada
new file mode 100644
index 000000000..28e9d280d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43105a.ada
@@ -0,0 +1,97 @@
+-- C43105A.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:
+--     IN A RECORD AGGREGATE, (X => E, Y => E), WHERE E IS AN OVERLOADED
+--     ENUMERATION LITERAL, OVERLOADING RESOLUTION OCCURS SEPARATELY FOR
+--     THE DIFFERENT OCCURRENCES OF E.
+
+-- HISTORY:
+--     DHH 08/10/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43105A IS
+
+BEGIN
+     TEST("C43105A", "IN A RECORD AGGREGATE, (X => E, Y => E), WHERE " &
+                     "E IS AN OVERLOADED ENUMERATION LITERAL, " &
+                     "OVERLOADING RESOLUTION OCCURS SEPARATELY FOR " &
+                     "THE DIFFERENT OCCURRENCES OF E");
+
+     DECLARE
+          TYPE COLOR IS (RED, YELLOW, GREEN);
+          TYPE PALETTE IS (GREEN, YELLOW, RED);
+
+          TYPE REC IS
+               RECORD
+                    X : COLOR;
+                    Y : PALETTE;
+               END RECORD;
+
+          TYPE RECD IS
+               RECORD
+                    X : PALETTE;
+                    Y : COLOR;
+               END RECORD;
+
+          REC1 : REC;
+          REC2 : RECD;
+
+          FUNCTION IDENT_C(C : COLOR) RETURN COLOR IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN C;
+               ELSE
+                    RETURN GREEN;
+               END IF;
+          END IDENT_C;
+
+          FUNCTION IDENT_P(P : PALETTE) RETURN PALETTE IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN P;
+               ELSE
+                    RETURN RED;
+               END IF;
+          END IDENT_P;
+
+
+     BEGIN
+          REC1 := (X => YELLOW, Y => YELLOW);
+          REC2 := (X => YELLOW, Y => YELLOW);
+
+          IF REC1.X /= IDENT_C(REC2.Y) THEN
+               FAILED("COLOR RESOLUTION FAILED");
+          END IF;
+
+          IF REC1.Y /= IDENT_P(REC2.X) THEN
+               FAILED("PALETTE RESOLUTION FAILED");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED("EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C43105A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43105b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43105b.ada
new file mode 100644
index 000000000..6a7ea8171
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43105b.ada
@@ -0,0 +1,94 @@
+-- C43105B.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:
+--     IN A RECORD AGGREGATE (X => E, Y => E), WHERE E IS AN OVERLOADED
+--     FUNCTION CALL, OVERLOADING RESOLUTION OCCURS SEPARATELY FOR THE
+--     DIFFERENT OCCURRENCES OF E.
+
+-- HISTORY:
+--     DHH 09/07/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43105B IS
+BEGIN
+     TEST ("C43105B", "IN A RECORD AGGREGATE (X => E, Y => E), WHERE " &
+                      "E IS AN OVERLOADED FUNCTION CALL, OVERLOADING " &
+                      "RESOLUTION OCCURS SEPARATELY FOR THE " &
+                      "DIFFERENT OCCURRENCES OF E");
+
+     DECLARE
+          TYPE COLOR IS (RED, YELLOW, GREEN);
+          TYPE PALETTE IS (GREEN, YELLOW, RED);
+
+          TYPE REC IS
+               RECORD
+                    X : COLOR;
+                    Y : PALETTE;
+               END RECORD;
+
+          TYPE RECD IS
+               RECORD
+                    X : PALETTE;
+                    Y : COLOR;
+               END RECORD;
+
+          REC1 : REC;
+          REC2 : RECD;
+
+          FUNCTION IDENT_C(C : COLOR) RETURN COLOR IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN C;
+               ELSE
+                    RETURN GREEN;
+               END IF;
+          END IDENT_C;
+
+          FUNCTION IDENT_C(P : PALETTE) RETURN PALETTE IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN P;
+               ELSE
+                    RETURN RED;
+               END IF;
+          END IDENT_C;
+
+     BEGIN
+          REC1 := (X => IDENT_C(YELLOW), Y => IDENT_C(YELLOW));
+          REC2 := (X => IDENT_C(YELLOW), Y => IDENT_C(YELLOW));
+
+          IF REC1.X /= REC2.Y THEN
+               FAILED("COLOR FUNCTION RESOLUTION FAILED");
+          END IF;
+
+          IF REC1.Y /= REC2.X THEN
+               FAILED("PALETTE FUNCTION RESOLUTION FAILED");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED("EXCEPTION RAISED");
+     END;
+     RESULT;
+END C43105B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43106a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43106a.ada
new file mode 100644
index 000000000..64ac9503c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43106a.ada
@@ -0,0 +1,90 @@
+-- C43106A.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 BOTH NAMED AND POSITIONAL NOTATIONS ARE PERMITTED
+--     WITHIN THE SAME RECORD AGGREGATE, (PROVIDED THAT ALL POSITIONAL
+--     ASSOCIATIONS APPEAR BEFORE ANY NAMED ASSOCIATION).
+
+-- HISTORY:
+--     DHH 08/10/88 CREATED ORIGIANL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43106A IS
+
+     TYPE REC IS
+          RECORD
+               A : INTEGER;
+               B : CHARACTER;
+               C : BOOLEAN;
+               D, E, F, G : INTEGER;
+               H, I, J, K : CHARACTER;
+               L, M, N, O : BOOLEAN;
+               P, Q, R, S : STRING(1 .. 3);
+               T, U, V, W, X, Y, Z : BOOLEAN;
+          END RECORD;
+     AGG : REC := (12, 'A', TRUE, 1, 2, 3, 4, 'B', 'C', 'D', 'E',
+                   P|R => "ABC", S|Q => "DEF", L|X|O|U => TRUE,
+                   OTHERS => FALSE);
+
+     FUNCTION IDENT_CHAR(X : CHARACTER) RETURN CHARACTER IS
+     BEGIN
+          IF EQUAL(3, 3) THEN
+               RETURN X;
+          ELSE
+               RETURN 'Z';
+          END IF;
+     END IDENT_CHAR;
+
+BEGIN
+     TEST("C43106A", "CHECK THAT BOTH NAMED AND POSITIONAL NOTATIONS " &
+                     "ARE PERMITTED WITHIN THE SAME RECORD " &
+                     "AGGREGATE, (PROVIDED THAT ALL POSITIONAL " &
+                     "ASSOCIATIONS APPEAR BEFORE ANY NAMED " &
+                     "ASSOCIATION)");
+
+     IF NOT IDENT_BOOL(AGG.C) OR NOT IDENT_BOOL(AGG.L) OR
+        NOT IDENT_BOOL(AGG.X) OR NOT IDENT_BOOL(AGG.O) OR
+        NOT IDENT_BOOL(AGG.U) OR IDENT_BOOL(AGG.M) OR
+            IDENT_BOOL(AGG.N) OR IDENT_BOOL(AGG.T) OR
+            IDENT_BOOL(AGG.V) OR IDENT_BOOL(AGG.W) OR
+            IDENT_BOOL(AGG.Y) OR IDENT_BOOL(AGG.Z) THEN
+          FAILED("BOOLEANS NOT INITIALIZED TO AGGREGATE VALUES");
+     END IF;
+
+     IF IDENT_STR(AGG.P) /= IDENT_STR(AGG.R) OR
+        IDENT_STR(AGG.Q) /= IDENT_STR(AGG.S) THEN
+          FAILED("STRINGS NOT INITIALIZED CORRECTLY");
+     END IF;
+
+     IF IDENT_CHAR(AGG.B) /= IDENT_CHAR('A') OR
+        IDENT_CHAR(AGG.H) /= IDENT_CHAR('B') OR
+        IDENT_CHAR(AGG.I) /= IDENT_CHAR('C') OR
+        IDENT_CHAR(AGG.J) /= IDENT_CHAR('D') OR
+        IDENT_CHAR(AGG.K) /= IDENT_CHAR('E') THEN
+          FAILED("CHARACTERS NOT INITIALIZED CORRECTLY");
+     END IF;
+
+     RESULT;
+END C43106A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43107a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43107a.ada
new file mode 100644
index 000000000..5fcc1a273
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43107a.ada
@@ -0,0 +1,125 @@
+-- C43107A.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 EXPRESSION ASSOCIATED WITH MORE THAN ONE RECORD
+-- COMPONENT IS EVALUATED ONCE FOR EACH ASSOCIATED COMPONENT.
+
+-- EG  02/14/84
+
+WITH REPORT;
+
+PROCEDURE C43107A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43107A","CHECK THAT AN EXPRESSION WITH MORE THAN ONE " &
+                    "RECORD COMPONENT IS EVALUATED ONCE FOR EACH " &
+                    "ASSOCIATED COMPONENT");
+
+     BEGIN
+
+CASE_A :  DECLARE
+
+               TYPE T1 IS ARRAY(1 .. 2) OF INTEGER;
+               TYPE R1 IS
+                    RECORD
+                         A : T1;
+                         B : INTEGER;
+                         C : T1;
+                         D : INTEGER;
+                         E : INTEGER;
+                    END RECORD;
+
+               A1   : R1;
+               CNTR : INTEGER := 0;
+
+               FUNCTION FUN1 (A : T1) RETURN T1 IS
+               BEGIN
+                    CNTR := IDENT_INT(CNTR+1);
+                    RETURN A;
+               END FUN1;
+
+               FUNCTION FUN2 (A : INTEGER) RETURN INTEGER IS
+               BEGIN
+                    CNTR := CNTR+1;
+                    RETURN IDENT_INT(A);
+               END FUN2;
+
+          BEGIN
+
+               A1 := (A | C => FUN1((-1, -2)), OTHERS => FUN2(-3)+1);
+               IF CNTR /= 5 THEN
+                    FAILED ("CASE A : INCORRECT NUMBER OF EVALUATIONS" &
+                            " OF RECORD ASSOCIATED COMPONENTS");
+               END IF;
+               IF A1.A /= (-1, -2) OR A1.C /= (-1, -2) OR
+                  A1.B /= -2 OR A1.D /= -2 OR A1.E /= -2 THEN
+                    FAILED ("CASE A : INCORRECT VALUES IN RECORD");
+               END IF;
+
+          END CASE_A;
+
+CASE_B :  DECLARE
+
+               TYPE T2 IS ACCESS INTEGER;
+               TYPE R2 IS
+                    RECORD
+                         A : T2;
+                         B : INTEGER;
+                         C : T2;
+                         D : INTEGER;
+                         E : INTEGER;
+                    END RECORD;
+
+               B1   : R2;
+               CNTR : INTEGER := 0;
+
+               FUNCTION FUN3 RETURN INTEGER IS
+               BEGIN
+                    CNTR := CNTR+1;
+                    RETURN IDENT_INT(2);
+               END FUN3;
+
+          BEGIN
+
+               B1 := (A | C => NEW INTEGER'(-1),
+                      B | D | E => FUN3);
+               IF B1.A = B1.C OR CNTR /= 3 THEN
+                    FAILED ("CASE B : INCORRECT NUMBER OF EVALUATION" &
+                            " OF RECORD ASSOCIATED COMPONENTS");
+               END IF;
+               IF B1.B /= 2 OR B1.D /= 2 OR B1.E /= 2 OR
+                  B1.A = NULL OR B1.C = NULL OR B1.A = B1.C THEN
+                    FAILED ("CASE B : INCORRECT VALUES IN RECORD");
+               END IF;
+
+          END CASE_B;
+
+     END;
+
+     RESULT;
+
+END C43107A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43108a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43108a.ada
new file mode 100644
index 000000000..24c140f67
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43108a.ada
@@ -0,0 +1,111 @@
+-- C43108A.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 A RECORD AGGREGATE THE VALUE OF A DISCRIMINANT IS
+--     USED TO RESOLVE THE TYPE OF A COMPONENT THAT DEPENDS ON THE
+--     DISCRIMINANT.
+
+-- HISTORY:
+--     DHH 09/08/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43108A IS
+
+BEGIN
+     TEST ("C43108A", "CHECK THAT IN A RECORD AGGREGATE THE VALUE OF " &
+                      "A DISCRIMINANT IS USED TO RESOLVE THE TYPE OF " &
+                      "A COMPONENT THAT DEPENDS ON THE DISCRIMINANT");
+
+     DECLARE
+          A : INTEGER;
+
+          TYPE DIS(A : BOOLEAN) IS
+               RECORD
+                    CASE A IS
+                         WHEN TRUE =>
+                              B : BOOLEAN;
+                              C : INTEGER;
+                         WHEN FALSE =>
+                              D : INTEGER;
+                    END CASE;
+               END RECORD;
+
+          FUNCTION DIFF(PARAM : DIS) RETURN INTEGER IS
+          BEGIN
+               IF PARAM.B THEN
+                    RETURN PARAM.C;
+               ELSE
+                    RETURN PARAM.D;
+               END IF;
+          END DIFF;
+
+     BEGIN
+          A := DIFF((C => 3, OTHERS => TRUE));
+
+          IF A /= IDENT_INT(3) THEN
+               FAILED("STATIC OTHERS NOT DECIDED CORRECTLY");
+          END IF;
+     END;
+
+     DECLARE
+          GLOBAL : INTEGER := 0;
+          TYPE INT IS NEW INTEGER;
+
+          TYPE DIS(A : BOOLEAN) IS
+               RECORD
+                    CASE A IS
+                         WHEN TRUE =>
+                              I1 : INT;
+                         WHEN FALSE =>
+                              I2 : INTEGER;
+                    END CASE;
+               END RECORD;
+          FUNCTION F RETURN INT;
+          FUNCTION F RETURN INTEGER;
+
+          A : DIS(TRUE);
+
+          FUNCTION F RETURN INT IS
+          BEGIN
+               GLOBAL := 1;
+               RETURN 5;
+          END F;
+
+          FUNCTION F RETURN INTEGER IS
+          BEGIN
+               GLOBAL := 2;
+               RETURN 5;
+          END F;
+
+     BEGIN
+          A := (TRUE, OTHERS => F);
+
+          IF GLOBAL /= 1 THEN
+               FAILED("NON_STATIC OTHERS NOT DECIDED CORRECTLY");
+          END IF;
+     END;
+
+     RESULT;
+END C43108A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432001.a
new file mode 100644
index 000000000..dab75b388
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432001.a
@@ -0,0 +1,512 @@
+-- C432001.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 extension aggregates may be used to specify values
+--      for types that are record extensions. Check that the
+--      type of the ancestor expression may be any nonlimited type that
+--      is a record extension, including private types and private
+--      extensions. Check that the type for the aggregate is
+--      derived from the type of the ancestor expression.
+--
+-- TEST DESCRIPTION:
+--
+--      Two progenitor nonlimited record types are declared, one
+--      nonprivate and one private. Using these as parent types,
+--      all possible combinations of record extensions are declared
+--      (Nonprivate record extension of nonprivate type, private
+--      extension of nonprivate type, nonprivate record extension of
+--      private type, and private extension of private type). Finally,
+--      each of these types is extended using nonprivate record
+--      extensions.
+--
+--      Extension of private types is done in packages other than
+--      the ones containing the parent declaration. This is done
+--      to eliminate errors with extension of the partial view of
+--      a type, which is not an objective of this test.
+--
+--      All components of private types and private extensions are given
+--      default values. This eliminates the need for separate subprograms
+--      whose sole purpose is to place a value into a private record type.
+--
+--      Types that have been extended are checked using an object of their
+--      parent type as the ancestor expression. For those types that
+--      have been extended twice, using only nonprivate record extensions,
+--      a check is made using an object of their grandparent type as
+--      the ancestor expression.
+--      
+--      For each type, a subprogram is defined which checks the contents
+--      of the parameter, which is a value of the record extension.
+--      Components of nonprivate record extensions are checked against
+--      passed-in parameters of the component type. Components of private
+--      extensions are checked to ensure that they maintain their initial
+--      values.
+--
+--      To check that the aggregate's type is derived from its ancestor,
+--      each Check subprogram in turn calls the Check subprogram for
+--      its parent type. Explicit conversion is used to convert the
+--      record extension to the parent type.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+package C432001_0 is
+
+   type Eras is (Precambrian, Paleozoic, Mesozoic, Cenozoic);
+
+   type N is tagged record
+      How_Long_Ago : Natural := Report.Ident_Int(1);
+      Era          : Eras := Cenozoic;
+   end record;
+
+   function Check (Rec : in N;
+                   N   : in Natural;
+                   E   : in Eras) return Boolean;
+
+   type P is tagged private;
+
+   function Check (Rec : in P) return Boolean;
+
+private
+
+   type P is tagged record
+      How_Long_Ago : Natural := Report.Ident_Int(150);
+      Era          : Eras := Mesozoic;
+   end record;
+
+end C432001_0;
+
+package body C432001_0 is
+
+   function Check (Rec : in P) return Boolean is
+   begin
+      return Rec.How_Long_Ago = 150 and Rec.Era = Mesozoic;
+   end Check;
+
+   function Check (Rec : in N;
+                   N   : in Natural;
+                   E   : in Eras) return Boolean is
+   begin
+      return Rec.How_Long_Ago = N and Rec.Era = E;
+   end Check;
+
+end C432001_0;
+
+with C432001_0;
+package C432001_1 is
+
+   type Periods is
+      (Aphebian, Helikian, Hadrynian,
+       Cambrian, Ordovician, Silurian, Devonian, Carboniferous, Permian,
+       Triassic, Jurassic, Cretaceous,
+       Tertiary, Quaternary);
+
+   type N_N is new C432001_0.N with record
+      Period : Periods := C432001_1.Quaternary;
+   end record;
+
+   function Check (Rec : in N_N;
+                   N   : in Natural;
+                   E   : in C432001_0.Eras;
+                   P   : in Periods) return Boolean;
+
+   type N_P is new C432001_0.N with private;
+
+   function Check (Rec : in N_P) return Boolean;
+
+   type P_N is new C432001_0.P with record
+      Period : Periods := C432001_1.Jurassic;
+   end record;
+
+   function Check (Rec : in P_N;
+                   P   : in Periods) return Boolean;
+
+   type P_P is new C432001_0.P with private;
+
+   function Check (Rec : in P_P) return Boolean;
+
+   type P_P_Null is new C432001_0.P with null record;  
+
+private
+
+   type N_P is new C432001_0.N with record
+      Period : Periods := C432001_1.Quaternary;
+   end record;
+
+   type P_P is new C432001_0.P with record
+      Period : Periods := C432001_1.Jurassic;
+   end record;
+
+end C432001_1;
+
+with Report;
+package body C432001_1 is
+
+   function Check (Rec : in N_N;
+                   N   : in Natural;
+                   E   : in C432001_0.Eras;
+                   P   : in Periods) return Boolean is
+   begin
+      if not C432001_0.Check (C432001_0.N (Rec), N, E) then
+         Report.Failed ("Conversion to parent type of " &
+                        "nonprivate portion of " &
+                        "nonprivate extension failed");
+      end if;
+      return Rec.Period = P;
+   end Check;
+   
+
+   function Check (Rec : in N_P) return Boolean is
+   begin
+      if not C432001_0.Check (C432001_0.N (Rec), 1, C432001_0.Cenozoic) then
+         Report.Failed ("Conversion to parent type of " &
+                        "nonprivate portion of " &
+                        "private extension failed");
+      end if;
+      return Rec.Period = C432001_1.Quaternary;
+   end Check;
+
+   function Check (Rec : in P_N;
+                   P   : in Periods) return Boolean is
+   begin
+      if not C432001_0.Check (C432001_0.P (Rec)) then
+         Report.Failed ("Conversion to parent type of " &
+                        "private portion of " &
+                        "nonprivate extension failed");
+      end if;
+      return Rec.Period = P;
+   end Check;
+
+   function Check (Rec : in P_P) return Boolean is
+   begin
+      if not C432001_0.Check (C432001_0.P (Rec)) then
+         Report.Failed ("Conversion to parent type of " &
+                        "private portion of " &
+                        "private extension failed");
+      end if;
+      return Rec.Period = C432001_1.Jurassic;
+   end Check;
+
+end C432001_1;
+
+with C432001_0;
+with C432001_1;
+package C432001_2 is
+
+   -- All types herein are nonprivate extensions, since aggregates
+   -- cannot be given for private extensions
+   
+   type N_N_N is new C432001_1.N_N with record
+      Sample_On_Loan : Boolean;
+   end record;
+
+   function Check (Rec : in N_N_N;
+                   N   : in Natural;
+                   E   : in C432001_0.Eras;
+                   P   : in C432001_1.Periods;
+                   B   : in Boolean) return Boolean;
+
+   type N_P_N is new C432001_1.N_P with record
+      Sample_On_Loan : Boolean;
+   end record;
+
+   function Check (Rec : in N_P_N;
+                   B   : Boolean) return Boolean;
+
+   type P_N_N is new C432001_1.P_N with record
+      Sample_On_Loan : Boolean;
+   end record;
+
+   function Check (Rec : in P_N_N;
+                   P   : in C432001_1.Periods;
+                   B   : Boolean) return Boolean;
+
+   type P_P_N is new C432001_1.P_P with record
+      Sample_On_Loan : Boolean;
+   end record;
+
+   function Check (Rec : in P_P_N;
+                   B   : Boolean) return Boolean;
+
+end C432001_2;
+
+with Report;
+package body C432001_2 is
+
+   -- direct access to operator
+   use type C432001_1.Periods;
+
+
+   function Check (Rec : in N_N_N;
+                   N   : in Natural;
+                   E   : in C432001_0.Eras;
+                   P   : in C432001_1.Periods;
+                   B   : in Boolean) return Boolean is
+   begin
+      if not C432001_1.Check (C432001_1.N_N (Rec), N, E, P) then
+         Report.Failed ("Conversion to parent " &
+                        "nonprivate type extension " &
+                        "failed");
+      end if;
+      return Rec.Sample_On_Loan = B;
+   end Check;
+   
+
+   function Check (Rec : in N_P_N;
+                   B   : Boolean) return Boolean is
+   begin
+      if not C432001_1.Check (C432001_1.N_P (Rec)) then
+         Report.Failed ("Conversion to parent " &
+                        "private type extension " &
+                        "failed");
+      end if;
+      return Rec.Sample_On_Loan = B;
+   end Check;
+
+   function Check (Rec : in P_N_N;
+                   P   : in C432001_1.Periods;
+                   B   : Boolean) return Boolean is
+   begin
+      if not C432001_1.Check (C432001_1.P_N (Rec), P) then
+         Report.Failed ("Conversion to parent " &
+                        "nonprivate type extension " &
+                        "failed");
+      end if;
+      return Rec.Sample_On_Loan = B;
+   end Check;
+
+   function Check (Rec : in P_P_N;
+                   B   : Boolean) return Boolean is
+   begin
+      if not C432001_1.Check (C432001_1.P_P (Rec)) then
+         Report.Failed ("Conversion to parent " &
+                        "private type extension " &
+                        "failed");
+      end if;
+      return Rec.Sample_On_Loan = B;
+   end Check;
+
+end C432001_2;
+
+
+with C432001_0;
+with C432001_1;
+with C432001_2;
+with Report;
+procedure C432001 is
+
+   N_Object : C432001_0.N := (How_Long_Ago => Report.Ident_Int(375),
+                              Era          => C432001_0.Paleozoic);
+
+   P_Object : C432001_0.P; -- default value is (150,
+                           --                   C432001_0.Mesozoic)
+
+   N_N_Object : C432001_1.N_N :=
+      (N_Object with Period => C432001_1.Devonian);
+
+   P_N_Object : C432001_1.P_N :=
+      (P_Object with Period => C432001_1.Jurassic);
+
+   N_P_Object : C432001_1.N_P; -- default is (1,
+                               --             C432001_0.Cenozoic,
+                               --             C432001_1.Quaternary)
+
+   P_P_Object : C432001_1.P_P; -- default is (150,
+                               --             C432001_0.Mesozoic,
+                               --             C432001_1.Jurassic)
+
+   P_P_Null_Ob:C432001_1.P_P_Null := (P_Object with null record);
+
+   N_N_N_Object : C432001_2.N_N_N :=
+      (N_N_Object with Sample_On_Loan => Report.Ident_Bool(True));
+
+   N_P_N_Object : C432001_2.N_P_N :=
+      (N_P_Object with Sample_On_Loan => Report.Ident_Bool(False));
+
+   P_N_N_Object : C432001_2.P_N_N :=
+      (P_N_Object with Sample_On_Loan => Report.Ident_Bool(True));
+
+   P_P_N_Object : C432001_2.P_P_N :=
+      (P_P_Object with Sample_On_Loan => Report.Ident_Bool(False));
+
+   P_N_Object_2 : C432001_1.P_N := (C432001_0.P(P_N_N_Object)
+                                    with C432001_1.Carboniferous);
+
+   N_N_Object_2 : C432001_1.N_N := (C432001_0.N'(42,C432001_0.Precambrian)
+                                    with C432001_1.Carboniferous);
+
+begin
+
+   Report.Test ("C432001", "Extension aggregates");
+
+   -- check ultimate ancestor types
+
+   if not C432001_0.Check (N_Object,
+                           375,
+                           C432001_0.Paleozoic) then
+      Report.Failed ("Object of " &
+                     "nonprivate type " &
+                     "failed content check");
+   end if;
+
+   if not C432001_0.Check (P_Object) then
+      Report.Failed ("Object of " &
+                     "private type " &
+                     "failed content check");
+   end if;
+
+   -- check direct type extensions
+
+   if not C432001_1.Check (N_N_Object,
+                           375,
+                           C432001_0.Paleozoic,
+                           C432001_1.Devonian) then
+      Report.Failed ("Object of " &
+                     "nonprivate extension of nonprivate type " &
+                     "failed content check");
+   end if;
+
+   if not C432001_1.Check (N_P_Object) then
+      Report.Failed ("Object of " &
+                     "private extension of nonprivate type " &
+                     "failed content check");
+   end if;
+
+   if not C432001_1.Check (P_N_Object,
+                           C432001_1.Jurassic) then
+      Report.Failed ("Object of " &
+                     "nonprivate extension of private type " &
+                     "failed content check");
+   end if;
+
+   if not C432001_1.Check (P_P_Object) then
+      Report.Failed ("Object of " &
+                     "private extension of private type " &
+                     "failed content check");
+   end if;
+
+    if not C432001_1.Check (P_P_Null_Ob) then
+      Report.Failed ("Object of " &
+                     "private type " &
+                     "failed content check");
+   end if;
+
+
+   -- check direct extensions of extensions
+
+   if not C432001_2.Check (N_N_N_Object,
+                           375,
+                           C432001_0.Paleozoic,
+                           C432001_1.Devonian,
+                           True) then
+      Report.Failed ("Object of " &
+                     "nonprivate extension of nonprivate extension " &
+                     "(of nonprivate parent) " &
+                     "failed content check");
+   end if;
+
+   if not C432001_2.Check (N_P_N_Object, False) then
+      Report.Failed ("Object of " &
+                     "nonprivate extension of private extension " &
+                     "(of nonprivate parent) " &
+                     "failed content check");
+   end if;
+
+   if not C432001_2.Check (P_N_N_Object,
+                           C432001_1.Jurassic,
+                           True) then
+      Report.Failed ("Object of " &
+                     "nonprivate extension of nonprivate extension " &
+                     "(of private parent) " &
+                     "failed content check");
+   end if;
+
+   if not C432001_2.Check (P_P_N_Object, False) then
+      Report.Failed ("Object of " &
+                     "nonprivate extension of private extension " &
+                     "(of private parent) " &
+                     "failed content check");
+   end if;
+
+   -- check that the extension aggregate may specify an expression of
+   -- a "grandparent" ancestor type
+
+   -- types tested are derived through nonprivate extensions only
+   -- (extension aggregates are not allowed if the path from the
+   -- ancestor type wanders through a private extension)
+   
+   N_N_N_Object :=
+      (N_Object with Period => C432001_1.Devonian,
+                     Sample_On_Loan => Report.Ident_Bool(True));
+
+   if not C432001_2.Check (N_N_N_Object,
+                           375,
+                           C432001_0.Paleozoic,
+                           C432001_1.Devonian,
+                           True) then
+      Report.Failed ("Object of " &
+                     "nonprivate extension " &
+                     "of nonprivate ancestor " &
+                     "failed content check");
+   end if;
+
+   P_N_N_Object :=
+      (P_Object with Period => C432001_1.Jurassic,
+                     Sample_On_Loan => Report.Ident_Bool(True));
+
+   if not C432001_2.Check (P_N_N_Object,
+                           C432001_1.Jurassic,
+                           True) then
+      Report.Failed ("Object of " &
+                     "nonprivate extension " &
+                     "of private ancestor " &
+                     "failed content check");
+   end if;
+
+  -- Check additional cases
+   if not C432001_1.Check (P_N_Object_2,
+                           C432001_1.Carboniferous) then
+      Report.Failed ("Additional Object of " &
+                     "nonprivate extension of private type " &
+                     "failed content check");
+   end if;
+
+   if not C432001_1.Check (N_N_Object_2,
+                           42,
+                           C432001_0.Precambrian,
+                           C432001_1.Carboniferous) then
+      Report.Failed ("Additional Object of " &
+                     "nonprivate extension of nonprivate type " &
+                     "failed content check");
+   end if;
+
+   Report.Result;
+
+end C432001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432002.a
new file mode 100644
index 000000000..5de821b30
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432002.a
@@ -0,0 +1,764 @@
+-- C432002.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 an extension aggregate specifies a value for a record 
+--      extension and the ancestor expression has discriminants that are
+--      inherited by the record extension, then a check is made that each
+--      discriminant has the value specified.
+--
+--      Check that if an extension aggregate specifies a value for a record 
+--      extension and the ancestor expression has discriminants that are not
+--      inherited by the record extension, then a check is made that each
+--      such discriminant has the value specified for the corresponding
+--      discriminant.
+--
+--      Check that the corresponding discriminant value may be specified
+--      in the record component association list or in the derived type
+--      definition for an ancestor.
+--
+--      Check the case of ancestors that are several generations removed.
+--      Check the case where the value of the discriminant(s) in question
+--      is supplied several generations removed.
+--
+--      Check the case of multiple discriminants.
+--
+--      Check that Constraint_Error is raised if the check fails.
+--
+-- TEST DESCRIPTION:
+--      A hierarchy of tagged types is declared from a discriminated
+--      root type. Each level declares two kinds of types: (1) a type
+--      extension which constrains the discriminant of its parent to
+--      the value of an expression and (2) a type extension that
+--      constrains the discriminant of its parent to equal a new discriminant
+--      of the type extension (These are the two categories of noninherited
+--      discriminants).
+--
+--      Values for each type are declared within nested blocks. This is
+--      done so that the instances that produce Constraint_Error may
+--      be dealt with cleanly without forcing the program to exit.
+--
+--      Success and failure cases (which should raise Constraint_Error)
+--      are set up for each kind of type. Additionally, for the first
+--      level of the hierarchy, separate tests are done for ancestor
+--      expressions specified by aggregates and those specified by
+--      variables. Later tests are performed using variables only.
+--
+--      Additionally, the cases tested consist of the following kinds of
+--      types:
+--
+--         Extensions of extensions, using both the parent and grandparent
+--         types for the ancestor expression,
+--
+--         Ancestor expressions which are several generations removed
+--         from the type of the aggregate,
+--
+--         Extensions of types with multiple discriminants, where the
+--         extension declares a new discriminant which corresponds to
+--         more than one discriminant of the ancestor types.
+--
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--      20 Dec 94   SAIC    Repair confusion WRT overridden discriminants
+--
+--!
+
+package C432002_0 is
+
+   subtype Length is Natural range 0..256;
+   type Discriminant (L : Length) is tagged
+      record
+         S1 : String (1..L);
+      end record;
+
+   procedure Do_Something (Rec : in out Discriminant);
+   -- inherited by all type extensions
+
+   -- Aggregates of Discriminant are of the form
+   --    (L, S1) where L= S1'Length
+
+   -- Discriminant of parent constrained to value of an expression
+   type Constrained_Discriminant_Extension is
+      new Discriminant (L => 10)
+      with record
+         S2 : String (1..20);
+      end record;
+
+   -- Aggregates of Constrained_Discriminant_Extension are of the form
+   --    (L, S1, S2), where L = S1'Length = 10, S2'Length = 20
+
+   type Once_Removed is new Constrained_Discriminant_Extension
+      with record
+         S3 : String (1..3);
+      end record;
+
+   type Twice_Removed is new Once_Removed
+      with record
+         S4 : String (1..8);
+      end record;
+
+   -- Aggregates of Twice_Removed are of the form
+   --    (L, S1, S2, S3, S4), where L = S1'Length = 10,
+   --                               S2'Length = 20,
+   --                               S3'Length = 3,
+   --                               S4'Length = 8
+
+   -- Discriminant of parent constrained to equal new discriminant
+   type New_Discriminant_Extension (N : Length) is
+      new Discriminant (L => N) with
+      record
+         S2 : String (1..N);
+      end record;
+
+   -- Aggregates of New_Discriminant_Extension are of the form
+   --   (N, S1, S2), where N = S1'Length = S2'Length
+
+   -- Discriminant of parent extension constrained to the value of
+   -- an expression
+   type Constrained_Extension_Extension is
+      new New_Discriminant_Extension (N => 20)
+      with record
+         S3 : String (1..5);
+      end record;
+
+   -- Aggregates of Constrained_Extension_Extension are of the form
+   --   (N, S1, S2, S3), where N = S1'Length = S2'Length = 20,
+   --                             S3'Length = 5
+
+   -- Discriminant of parent extension constrained to equal a new
+   -- discriminant
+   type New_Extension_Extension (I : Length) is
+      new New_Discriminant_Extension (N => I)
+      with record
+         S3 : String (1..I);
+      end record;
+
+   -- Aggregates of New_Extension_Extension are of the form
+   --    (I, S1, 2, S3), where
+   --       I = S1'Length = S2'Length = S3'Length
+
+   type Multiple_Discriminants (A, B : Length) is tagged
+      record
+         S1 : String (1..A);
+         S2 : String (1..B);
+      end record;
+
+   procedure Do_Something (Rec : in out Multiple_Discriminants);
+   -- inherited by type extension
+
+   -- Aggregates of Multiple_Discriminants are of the form
+   --    (A, B, S1, S2), where A = S1'Length, B = S2'Length
+
+   type Multiple_Discriminant_Extension (C : Length) is
+      new Multiple_Discriminants (A => C, B => C)
+      with record
+         S3 : String (1..C);
+      end record;
+
+   -- Aggregates of Multiple_Discriminant_Extension are of the form
+   --    (A, B, S1, S2, C, S3), where
+   --       A = B = C = S1'Length = S2'Length = S3'Length
+
+end C432002_0;
+
+with Report;
+package body C432002_0 is
+
+   S : String (1..20) := "12345678901234567890";
+
+   procedure Do_Something (Rec : in out Discriminant) is
+   begin
+      Rec.S1 := Report.Ident_Str (S (1..Rec.L));
+   end Do_Something;
+
+   procedure Do_Something (Rec : in out Multiple_Discriminants) is
+   begin
+      Rec.S1 := Report.Ident_Str (S (1..Rec.A));
+   end Do_Something;
+
+end C432002_0;
+
+
+with C432002_0;
+with Report;
+procedure C432002 is
+
+   -- Various different-sized strings for variety
+   String_3  : String (1..3)  := Report.Ident_Str("123");
+   String_5  : String (1..5)  := Report.Ident_Str("12345");
+   String_8  : String (1..8)  := Report.Ident_Str("12345678");
+   String_10 : String (1..10) := Report.Ident_Str("1234567890");
+   String_11 : String (1..11) := Report.Ident_Str("12345678901");
+   String_20 : String (1..20) := Report.Ident_Str("12345678901234567890");
+
+begin
+
+   Report.Test ("C432002",
+                "Extension aggregates for discriminated types");
+
+   --------------------------------------------------------------------
+   -- Extension constrains parent's discriminant to value of expression
+   --------------------------------------------------------------------
+
+   -- Successful cases - value matches corresponding discriminant value
+
+   CD_Matched_Aggregate:
+   begin
+      declare
+         CD : C432002_0.Constrained_Discriminant_Extension :=
+            (C432002_0.Discriminant'(L  => 10,
+                                     S1 => String_10)
+               with S2 => String_20);
+      begin
+         C432002_0.Do_Something(CD); -- success
+      end;
+   exception
+      when Constraint_Error =>
+         Report.Comment ("Ancestor expression is an aggregate");
+         Report.Failed ("Aggregate of extension " &
+                        "with discriminant constrained: " &
+                        "Constraint_Error was incorrectly raised " &
+                        "for value that matches corresponding " &
+                        "discriminant");
+   end CD_Matched_Aggregate;
+   
+   CD_Matched_Variable:
+   begin
+      declare
+         D : C432002_0.Discriminant(L => 10) :=
+            C432002_0.Discriminant'(L  => 10,
+                                    S1 => String_10);
+
+         CD : C432002_0.Constrained_Discriminant_Extension :=
+            (D with S2 => String_20);
+      begin
+         C432002_0.Do_Something(CD); -- success
+      end;
+   exception
+      when Constraint_Error =>
+         Report.Comment ("Ancestor expression is a variable");
+         Report.Failed ("Aggregate of extension " &
+                        "with discriminant constrained: " &
+                        "Constraint_Error was incorrectly raised " &
+                        "for value that matches corresponding " &
+                        "discriminant");
+   end CD_Matched_Variable;
+
+   
+   -- Unsuccessful cases - value does not match value of corresponding
+   --                      discriminant. Constraint_Error should be
+   --                      raised.
+
+   CD_Unmatched_Aggregate:
+   begin
+      declare
+         CD : C432002_0.Constrained_Discriminant_Extension :=
+            (C432002_0.Discriminant'(L  => 5,
+                                     S1 => String_5)
+               with S2 => String_20);
+      begin
+         Report.Comment ("Ancestor expression is an aggregate");
+         Report.Failed ("Aggregate of extension " &
+                        "with discriminant constrained: " &
+                        "Constraint_Error was not raised " &
+                        "for discriminant value that does not match " &
+                        "corresponding discriminant");
+         C432002_0.Do_Something(CD); -- disallow unused var optimization
+      end;
+   exception
+      when Constraint_Error =>
+         null; -- raise of Constraint_Error is expected
+   end CD_Unmatched_Aggregate;
+   
+   CD_Unmatched_Variable:
+   begin
+      declare
+         D : C432002_0.Discriminant(L => 5) :=
+            C432002_0.Discriminant'(L  => 5,
+                                    S1 => String_5);
+
+         CD : C432002_0.Constrained_Discriminant_Extension :=
+            (D with S2 => String_20);
+      begin
+         Report.Comment ("Ancestor expression is an variable");
+         Report.Failed ("Aggregate of extension " &
+                        "with discriminant constrained: " &
+                        "Constraint_Error was not raised " &
+                        "for discriminant value that does not match " &
+                        "corresponding discriminant");
+         C432002_0.Do_Something(CD); -- disallow unused var optimization
+      end;
+   exception
+      when Constraint_Error =>
+         null; -- raise of Constraint_Error is expected
+   end CD_Unmatched_Variable;
+
+   -----------------------------------------------------------------------
+   -- Extension constrains parent's discriminant to equal new discriminant
+   -----------------------------------------------------------------------
+
+   -- Successful cases - value matches corresponding discriminant value
+
+   ND_Matched_Aggregate:
+   begin
+      declare
+         ND : C432002_0.New_Discriminant_Extension (N => 8) :=
+            (C432002_0.Discriminant'(L  => 8,
+                                     S1 => String_8)
+               with N  => 8,
+                    S2 => String_8);
+      begin
+         C432002_0.Do_Something(ND); -- success
+      end;
+   exception
+      when Constraint_Error =>
+         Report.Comment ("Ancestor expression is an aggregate");
+         Report.Failed ("Aggregate of extension " &
+                        "with new discriminant: " &
+                        "Constraint_Error was incorrectly raised " &
+                        "for value that matches corresponding " &
+                        "discriminant");
+   end ND_Matched_Aggregate;
+   
+   ND_Matched_Variable:
+   begin
+      declare
+         D : C432002_0.Discriminant(L => 3) :=
+            C432002_0.Discriminant'(L  => 3,
+                                    S1 => String_3);
+
+         ND : C432002_0.New_Discriminant_Extension (N => 3) :=
+            (D with N  => 3,
+                    S2 => String_3);
+      begin
+         C432002_0.Do_Something(ND); -- success
+      end;
+   exception
+      when Constraint_Error =>
+         Report.Comment ("Ancestor expression is an variable");
+         Report.Failed ("Aggregate of extension " &
+                        "with new discriminant: " &
+                        "Constraint_Error was incorrectly raised " &
+                        "for value that matches corresponding " &
+                        "discriminant");
+   end ND_Matched_Variable;
+
+   
+   -- Unsuccessful cases - value does not match value of corresponding
+   --                      discriminant. Constraint_Error should be
+   --                      raised.
+   
+   ND_Unmatched_Aggregate:
+   begin
+      declare
+         ND : C432002_0.New_Discriminant_Extension (N => 20) :=
+            (C432002_0.Discriminant'(L  => 11,
+                                     S1 => String_11)
+               with N  => 20,
+                    S2 => String_20);
+      begin
+         Report.Comment ("Ancestor expression is an aggregate");
+         Report.Failed ("Aggregate of extension " &
+                        "with new discriminant: " &
+                        "Constraint_Error was not raised " &
+                        "for discriminant value that does not match " &
+                        "corresponding discriminant");
+         C432002_0.Do_Something(ND); -- disallow unused var optimization
+      end;
+   exception
+      when Constraint_Error =>
+         null; -- raise is expected
+   end ND_Unmatched_Aggregate;
+   
+   ND_Unmatched_Variable:
+   begin
+      declare
+         D : C432002_0.Discriminant(L => 5) :=
+            C432002_0.Discriminant'(L  => 5,
+                                    S1 => String_5);
+
+         ND : C432002_0.New_Discriminant_Extension (N => 20) :=
+            (D with N  => 20,
+                    S2 => String_20);
+      begin
+         Report.Comment ("Ancestor expression is an variable");
+         Report.Failed ("Aggregate of extension " &
+                        "with new discriminant: " &
+                        "Constraint_Error was not raised " &
+                        "for discriminant value that does not match " &
+                        "corresponding discriminant");
+         C432002_0.Do_Something(ND); -- disallow unused var optimization
+      end;
+   exception
+      when Constraint_Error =>
+         null; -- raise is expected
+   end ND_Unmatched_Variable;
+
+   --------------------------------------------------------------------
+   -- Extension constrains parent's discriminant to value of expression
+   -- Parent is a discriminant extension
+   --------------------------------------------------------------------
+
+   -- Successful cases - value matches corresponding discriminant value
+
+   CE_Matched_Aggregate:
+   begin
+      declare
+         CE : C432002_0.Constrained_Extension_Extension :=
+            (C432002_0.Discriminant'(L  => 20,
+                                     S1 => String_20)
+               with N => 20,
+                    S2 => String_20,
+                    S3 => String_5);
+      begin
+         C432002_0.Do_Something(CE); -- success
+      end;
+   exception
+      when Constraint_Error =>
+         Report.Comment ("Ancestor expression is an aggregate");
+         Report.Failed ("Aggregate of extension (of extension) " &
+                        "with discriminant constrained: " &
+                        "Constraint_Error was incorrectly raised " &
+                        "for value that matches corresponding " &
+                        "discriminant");
+   end CE_Matched_Aggregate;
+   
+   CE_Matched_Variable:
+   begin
+      declare
+         ND : C432002_0.New_Discriminant_Extension (N => 20) :=
+            C432002_0.New_Discriminant_Extension'
+               (N  => 20,
+                S1 => String_20,
+                S2 => String_20);
+
+         CE : C432002_0.Constrained_Extension_Extension :=
+            (ND with S3 => String_5);
+      begin
+         C432002_0.Do_Something(CE); -- success
+      end;
+   exception
+      when Constraint_Error =>
+         Report.Comment ("Ancestor expression is a variable");
+         Report.Failed ("Aggregate of extension (of extension) " &
+                        "with discriminant constrained: " &
+                        "Constraint_Error was incorrectly raised " &
+                        "for value that matches corresponding " &
+                        "discriminant");
+   end CE_Matched_Variable;
+
+   
+   -- Unsuccessful cases - value does not match value of corresponding
+   --                      discriminant. Constraint_Error should be
+   --                      raised.
+
+   CE_Unmatched_Aggregate:
+   begin
+      declare
+         CE : C432002_0.Constrained_Extension_Extension :=
+            (C432002_0.New_Discriminant_Extension'
+               (N  => 11,
+                S1 => String_11,
+                S2 => String_11)
+            with S3 => String_5);
+      begin
+         Report.Comment ("Ancestor expression is an aggregate");
+         Report.Failed ("Aggregate of extension (of extension) " &
+                        "Constraint_Error was not raised " &
+                        "with discriminant constrained: " &
+                        "for discriminant value that does not match " &
+                        "corresponding discriminant");
+         C432002_0.Do_Something(CE); -- disallow unused var optimization
+      end;
+   exception
+      when Constraint_Error =>
+         null; -- raise of Constraint_Error is expected
+   end CE_Unmatched_Aggregate;
+   
+   CE_Unmatched_Variable:
+   begin
+      declare
+         D : C432002_0.Discriminant(L => 8) :=
+            C432002_0.Discriminant'(L  => 8,
+                                    S1 => String_8);
+
+         CE : C432002_0.Constrained_Extension_Extension :=
+            (D with N  => 8,
+                    S2 => String_8,
+                    S3 => String_5);
+      begin
+         Report.Comment ("Ancestor expression is a variable");
+         Report.Failed ("Aggregate of extension (of extension) " &
+                        "with discriminant constrained: " &
+                        "Constraint_Error was not raised " &
+                        "for discriminant value that does not match " &
+                        "corresponding discriminant");
+         C432002_0.Do_Something(CE); -- disallow unused var optimization
+      end;
+   exception
+      when Constraint_Error =>
+         null; -- raise of Constraint_Error is expected
+   end CE_Unmatched_Variable;
+
+   -----------------------------------------------------------------------
+   -- Extension constrains parent's discriminant to equal new discriminant
+   -- Parent is a discriminant extension
+   -----------------------------------------------------------------------
+
+   -- Successful cases - value matches corresponding discriminant value
+
+   NE_Matched_Aggregate:
+   begin
+      declare
+         NE : C432002_0.New_Extension_Extension (I => 8) :=
+            (C432002_0.Discriminant'(L  => 8,
+                                     S1 => String_8)
+               with I  => 8,
+                    S2 => String_8,
+                    S3 => String_8);
+      begin
+         C432002_0.Do_Something(NE); -- success
+      end;
+   exception
+      when Constraint_Error =>
+         Report.Comment ("Ancestor expression is an aggregate");
+         Report.Failed ("Aggregate of extension (of extension) " &
+                        "with new discriminant: " &
+                        "Constraint_Error was incorrectly raised " &
+                        "for value that matches corresponding " &
+                        "discriminant");
+   end NE_Matched_Aggregate;
+   
+   NE_Matched_Variable:
+   begin
+      declare
+         ND : C432002_0.New_Discriminant_Extension (N => 3) :=
+            C432002_0.New_Discriminant_Extension'
+               (N  => 3,
+                S1 => String_3,
+                S2 => String_3);
+
+         NE : C432002_0.New_Extension_Extension (I => 3) :=
+            (ND with I  => 3,
+                     S3 => String_3);
+      begin
+         C432002_0.Do_Something(NE); -- success
+      end;
+   exception
+      when Constraint_Error =>
+         Report.Comment ("Ancestor expression is a variable");
+         Report.Failed ("Aggregate of extension (of extension) " &
+                        "with new discriminant: " &
+                        "Constraint_Error was incorrectly raised " &
+                        "for value that matches corresponding " &
+                        "discriminant");
+   end NE_Matched_Variable;
+
+   
+   -- Unsuccessful cases - value does not match value of corresponding
+   --                      discriminant. Constraint_Error should be
+   --                      raised.
+
+   NE_Unmatched_Aggregate:
+   begin
+      declare
+         NE : C432002_0.New_Extension_Extension (I => 8) :=
+            (C432002_0.New_Discriminant_Extension'
+               (C432002_0.Discriminant'(L  => 11,
+                                        S1 => String_11)
+                with N  => 11,
+                     S2 => String_11)
+            with I  => 8,
+                 S3 => String_8);
+      begin
+         Report.Comment ("Ancestor expression is an extension aggregate");
+         Report.Failed ("Aggregate of extension (of extension) " &
+                        "with new discriminant: " &
+                        "Constraint_Error was not raised " &
+                        "for discriminant value that does not match " &
+                        "corresponding discriminant");
+         C432002_0.Do_Something(NE); -- disallow unused var optimization
+      end;
+   exception
+      when Constraint_Error =>
+         null; -- raise is expected
+   end NE_Unmatched_Aggregate;
+   
+   NE_Unmatched_Variable:
+   begin
+      declare
+         D : C432002_0.Discriminant(L => 5) :=
+            C432002_0.Discriminant'(L  => 5,
+                                    S1 => String_5);
+
+         NE : C432002_0.New_Extension_Extension (I => 20) :=
+            (D with I  => 5,
+                    S2 => String_5,
+                    S3 => String_20);
+      begin
+         Report.Comment ("Ancestor expression is a variable");
+         Report.Failed ("Aggregate of extension (of extension) " &
+                        "with new discriminant: " &
+                        "Constraint_Error was not raised " &
+                        "for discriminant value that does not match " &
+                        "corresponding discriminant");
+         C432002_0.Do_Something(NE); -- disallow unused var optimization
+      end;
+   exception
+      when Constraint_Error =>
+         null; -- raise is expected
+   end NE_Unmatched_Variable;
+
+   -----------------------------------------------------------------------
+   -- Corresponding discriminant is two levels deeper than aggregate
+   -----------------------------------------------------------------------
+
+   -- Successful case - value matches corresponding discriminant value
+
+   TR_Matched_Variable:
+   begin
+      declare
+         D : C432002_0.Discriminant (L => 10) :=
+            C432002_0.Discriminant'(L  => 10,
+                                    S1 => String_10);
+
+         TR : C432002_0.Twice_Removed :=
+            C432002_0.Twice_Removed'(D with S2 => String_20,
+                                            S3 => String_3,
+                                            S4 => String_8);
+         -- N is constrained to a value in the derived_type_definition
+         -- of Constrained_Discriminant_Extension. Its omission from
+         -- the above record_component_association_list is allowed by
+         -- 4.3.2(6).
+
+      begin
+         C432002_0.Do_Something(TR); -- success
+      end;
+   exception
+      when Constraint_Error =>
+         Report.Failed ("Aggregate of far-removed extension " &
+                        "with discriminant constrained: " &
+                        "Constraint_Error was incorrectly raised " &
+                        "for value that matches corresponding " &
+                        "discriminant");
+   end TR_Matched_Variable;
+   
+   
+   -- Unsuccessful case - value does not match value of corresponding
+   --                      discriminant. Constraint_Error should be
+   --                      raised.
+
+   TR_Unmatched_Variable:
+   begin
+      declare
+         D : C432002_0.Discriminant (L => 5) :=
+            C432002_0.Discriminant'(L  => 5,
+                                    S1 => String_5);
+
+         TR : C432002_0.Twice_Removed :=
+            C432002_0.Twice_Removed'(D with S2 => String_20,
+                                            S3 => String_3,
+                                            S4 => String_8);
+
+      begin
+         Report.Failed ("Aggregate of far-removed extension " &
+                        "with discriminant constrained: " &
+                        "Constraint_Error was not raised " &
+                        "for discriminant value that does not match " &
+                        "corresponding discriminant");
+         C432002_0.Do_Something(TR); -- disallow unused var optimization
+      end;
+   exception
+      when Constraint_Error =>
+         null; -- raise is expected
+   end TR_Unmatched_Variable;
+   
+   ------------------------------------------------------------------------
+   -- Parent has multiple discriminants.
+   -- Discriminant in extension corresponds to both parental discriminants.
+   ------------------------------------------------------------------------
+
+   -- Successful case - value matches corresponding discriminant value
+
+   MD_Matched_Variable:
+   begin
+      declare
+         MD : C432002_0.Multiple_Discriminants (A => 10, B => 10) :=
+            C432002_0.Multiple_Discriminants'(A  => 10,
+                                              B  => 10,
+                                              S1 => String_10,
+                                              S2 => String_10);
+         MDE : C432002_0.Multiple_Discriminant_Extension (C => 10) :=
+            (MD with C  => 10,
+                     S3 => String_10);
+
+      begin
+         C432002_0.Do_Something(MDE); -- success
+      end;
+   exception
+      when Constraint_Error =>
+         Report.Failed ("Aggregate of extension " &
+                        "of multiply-discriminated parent: " &
+                        "Constraint_Error was incorrectly raised " &
+                        "for value that matches corresponding " &
+                        "discriminant");
+   end MD_Matched_Variable;
+
+   
+   -- Unsuccessful case - value does not match value of corresponding
+   --                      discriminant. Constraint_Error should be
+   --                      raised.
+
+   MD_Unmatched_Variable:
+   begin
+      declare
+         MD : C432002_0.Multiple_Discriminants (A => 10, B => 8) :=
+            C432002_0.Multiple_Discriminants'(A  => 10,
+                                              B  => 8,
+                                              S1 => String_10,
+                                              S2 => String_8);
+         MDE : C432002_0.Multiple_Discriminant_Extension (C => 10) :=
+            (MD with C  => 10,
+                     S3 => String_10);
+
+      begin
+         Report.Failed ("Aggregate of extension " &
+                        "of multiply-discriminated parent: " &
+                        "Constraint_Error was not raised " &
+                        "for discriminant value that does not match " &
+                        "corresponding discriminant");
+         C432002_0.Do_Something(MDE); -- disallow unused var optimization
+      end;
+   exception
+      when Constraint_Error =>
+         null; -- raise is expected
+   end MD_Unmatched_Variable;
+
+   Report.Result;
+
+end C432002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432003.a
new file mode 100644
index 000000000..8988992c4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432003.a
@@ -0,0 +1,594 @@
+-- C432003.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 the type of the ancestor part of an extension aggregate
+--      has discriminants that are not inherited by the type of the aggregate,
+--      and the ancestor part is a subtype mark that denotes a constrained
+--      subtype, Constraint_Error is raised if: 1) any discriminant of the
+--      ancestor has a different value than that specified for a corresponding
+--      discriminant in the derived type definition for some ancestor of the
+--      type of the aggregate, or 2) the value for the discriminant in the
+--      record association list is not the value of the corresponding 
+--      discriminant.  Check that the components of the value of the
+--      aggregate not given by the record component association list are
+--      initialized by default as for an object of the ancestor type.
+--
+-- TEST DESCRIPTION:
+--      Consider:
+--
+--      type T (D1: ...) is tagged ...
+--
+--      type    DT is new T with ...
+--      subtype ST is DT (D1 => 3);    -- Constrained subtype.
+--
+--      type NT1 (D2: ...) is new DT (D1 => D2) with null record;
+--      type NT2 (D2: ...) is new DT (D1 => 6)  with null record;
+--      type NT3           is new DT (D1 => 6)  with null record;
+--
+--      A: NT1 := (T  with D2 => 6); -- OK: T  is unconstrained.
+--      B: NT1 := (DT with D2 => 6); -- OK: DT is unconstrained.
+--      C: NT1 := (ST with D2 => 6); -- NO: ST.D1 /= D2.
+--
+--      D: NT2 := (T  with D2 => 4); -- OK: T  is unconstrained.
+--      E: NT2 := (DT with D2 => 4); -- OK: DT is unconstrained.
+--      F: NT2 := (ST with  . . . ); -- NO: ST.D1 /= DT.D1 as specified in NT2.
+--
+--      G: NT3 := (T  with D1 => 6); -- OK: T  is unconstrained.
+--      H: NT3 := (DT with D1 => 6); -- OK: DT is unconstrained.
+--      I: NT3 := (ST with D1 => 6); -- NO: ST.D1 /= DT.D1 as specified in NT3.
+--
+--      In A, B, D, E, G, and H the ancestor part is the name of an
+--      unconstrained subtype, so this rule does not apply. In C, F, and I
+--      the ancestor part (ST) is the name of a constrained subtype of DT,
+--      which is itself a derived type of a discriminated tagged type T. ST
+--      constrains the discriminant of DT (D1) to the value 3; thus, the
+--      type of any extension aggregate for which ST is the ancestor part
+--      must have an ancestor which also constrained D1 to 3. F and I raise
+--      Constraint_Error because NT2 and NT3, respectively, constrain D1 to
+--      6. C raises Constraint_Error because NT1 constrains D1 to the value
+--      of D2, which is set to 6 in the record component association list of
+--      the aggregate.
+--
+--      This test verifies each of the three scenarios above:
+--
+--         (1) Ancestor of type of aggregate constrains discriminant with
+--             new discriminant.
+--         (2) Ancestor of type of aggregate constrains discriminant with
+--             value, and has a new discriminant part.
+--         (3) Ancestor of type of aggregate constrains discriminant with
+--             value, and has no discriminant part.
+--
+--      Verification is made for cases where the type of the aggregate is
+--      once- and twice-removed from the type of the ancestor part.
+--      
+--      Additionally, a case is included where a new discriminant corresponds
+--      to multiple discriminants of the type of the ancestor part.
+--
+--      To test the portion of the objective concerning "initialization by 
+--      default," the test verifies that, after a successful aggregate
+--      assignment, components not assigned an explicit value by the aggregate
+--      contain the default values for the corresponding components of the
+--      ancestor type.
+--    
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Dec 94   SAIC    Removed discriminant defaults from tagged types.
+--      17 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected subtype constraint
+--                          for component NT_C3.Str2. Added missing component
+--                          checks. Removed record component update from
+--                          Avoid_Optimization. Fixed incorrect component
+--                          checks.
+--      02 Dec 95   SAIC    ACVC 2.0.1 fixes: Corrected Failed comment for
+--                          Q case.
+--
+--!
+
+package C432003_0 is
+
+   Default_String : constant String := "This is a default string"; -- len = 24
+   Another_String : constant String := "Another default string";   -- len = 22
+
+   subtype Length is Natural range 0..255;
+
+   type ROOT (D1 : Length) is tagged 
+      record
+         S1  : String (1..D1) := Default_String(1..D1);
+         Acc : Natural := 356;
+      end record;
+
+   procedure Avoid_Optimization (Rec : in out ROOT); -- Inherited by all type
+                                                     -- extensions.
+
+   type Unconstrained_Der is new ROOT with 
+      record
+         Str1 : String(1..5) := "abcde";
+      end record;
+
+   subtype Constrained_Subtype is Unconstrained_Der (D1 => 10);
+
+   type NT_A1 (D2 : Length) is new Unconstrained_Der (D1 => D2) with 
+      record
+         S2 : String(1..D2);         -- Inherited discrim. constrained by
+      end record;                    -- new discriminant.
+
+   type NT_A2 (D3 : Length) is new NT_A1 (D2 => D3) with 
+      record
+         S3 : String(1..D3);         -- Inherited discrim. constrained by
+      end record;                    -- new discriminant.
+
+
+   type NT_B1 (D2 : Length) is new Unconstrained_Der (D1 => 5) with 
+      record
+         S2 : String(1..D2);         -- Inherited discrim. constrained by
+      end record;                    -- explicit value.
+
+   type NT_B2 (D3 : Length) is new NT_B1 (D2 => 10) with 
+      record
+         S3 : String(1..D3);         -- Inherited discrim. constrained by
+      end record;                    -- explicit value.
+
+   type NT_B3 (D2 : Length) is new Unconstrained_Der (D1 => 10) with
+      record
+         S2 : String(1..D2);
+      end record;
+
+
+   type NT_C1 is new Unconstrained_Der (D1 => 5) with 
+      record
+         Str2 : String(1..5);         -- Inherited discrim. constrained
+      end record;                     -- No new value.
+
+   type NT_C2 (D2 : Length) is new NT_C1 with 
+      record
+         S2 : String(1..D2);          -- Inherited discrim. not further
+      end record;                     -- constrained, new discriminant.
+
+   type NT_C3 is new Unconstrained_Der(D1 => 10) with
+      record
+         Str2 : String(1..5);
+      end record;
+
+
+   type MULTI_ROOT (D1 : Length; D2 : Length) is tagged
+      record
+         S1 : String (1..D1) := Default_String(1..D1);
+         S2 : String (1..D2) := Another_String(1..D2);
+      end record;
+
+   procedure Avoid_Optimization (Rec : in out MULTI_ROOT); -- Inherited by all
+                                                           -- type extensions.
+                                                           
+   type Mult_Unconstr_Der is new MULTI_ROOT with
+      record
+         Str1 : String(1..8) := "AbCdEfGh";  -- Derived, no constraints.
+      end record;
+
+   -- Subtypes with constrained discriminants.
+   subtype Mult_Constr_Sub1 is Mult_Unconstr_Der(D1 => 15,  -- Disc. have
+                                                 D2 => 20); -- diff values
+
+   subtype Mult_Constr_Sub2 is Mult_Unconstr_Der(D1 => 15,  -- Disc. have
+                                                 D2 => 15); -- same value
+
+   type Mult_NT_A1 (D3 : Length) is 
+     new Mult_Unconstr_Der (D1 => D3, D2 => D3) with
+      record
+         S3 : String(1..D3);      -- Both inherited discriminants constrained
+      end record;                 -- by new discriminant.
+
+end C432003_0;
+
+
+   --=====================================================================--
+
+
+with Report;
+package body C432003_0 is
+
+   procedure Avoid_Optimization (Rec : in out ROOT) is
+   begin
+      Rec.S1 := Report.Ident_Str(Rec.S1);
+   end Avoid_Optimization;
+
+   procedure Avoid_Optimization (Rec : in out MULTI_ROOT) is
+   begin
+      Rec.S1 := Report.Ident_Str(Rec.S1);
+   end Avoid_Optimization;
+
+end C432003_0;
+
+
+   --=====================================================================--
+
+
+with C432003_0;
+with Report;
+procedure C432003 is
+begin
+
+   Report.Test("C432003", "Extension aggregates where ancestor part "      &
+                          "is a subtype mark that denotes a constrained "  &
+                          "subtype causing Constraint_Error if any "       &
+                          "discriminant of the ancestor has a different "  &
+                          "value than that specified for a corresponding " &
+                          "discriminant in the derived type definition "   &
+                          "for some ancestor of the type of the aggregate");
+
+   Test_Block:
+      declare
+
+         -- Variety of string object declarations.
+         String2  : String(1..2)  := Report.Ident_Str("12");
+         String5  : String(1..5)  := Report.Ident_Str("12345");
+         String8  : String(1..8)  := Report.Ident_Str("AbCdEfGh");
+         String10 : String(1..10) := Report.Ident_Str("1234567890");
+         String15 : String(1..15) := Report.Ident_Str("123456789012345");
+         String20 : String(1..20) := Report.Ident_Str("12345678901234567890");
+
+      begin
+
+
+         begin
+            declare
+               A : C432003_0.NT_A1 :=                                  -- OK
+                     (C432003_0.ROOT with D2   => 5,
+                                          Str1 => "cdefg",
+                                          S2   => String5);
+            begin
+               C432003_0.Avoid_Optimization(A);
+               if A.Acc  /= 356       or
+                  A.Str1 /= "cdefg"   or
+                  A.S2   /= String5   or 
+                  A.D2   /= 5         or
+                  A.S1   /= C432003_0.Default_String(1..5)
+               then
+                  Report.Failed("Incorrect object values for Object A");
+               end if;
+            end;
+         exception
+            when Constraint_Error =>
+               Report.Failed("Constraint_Error raised for Object A");
+         end;
+
+
+         begin
+            declare
+               C: C432003_0.NT_A1 :=                                   -- OK
+                    (C432003_0.Constrained_Subtype with D2 => 10,
+                                                        S2 => String10);
+            begin
+               C432003_0.Avoid_Optimization(C);
+               if C.D2   /= 10        or  C.Acc /= 356      or
+                  C.Str1 /= "abcde"   or  C.S2  /= String10 or
+                  C.S1   /= C432003_0.Default_String(1..10)
+               then
+                  Report.Failed("Incorrect object values for Object C");
+               end if;
+            end;
+         exception
+            when Constraint_Error =>
+               Report.Failed("Constraint_Error raised for Object C");
+         end;
+
+
+         begin
+            declare 
+               D: C432003_0.NT_A1 :=                                  -- C_E
+                    (C432003_0.Constrained_Subtype with 
+                       D2 => Report.Ident_Int(5),
+                       S2 => String5);
+            begin
+               C432003_0.Avoid_Optimization(D);
+               Report.Failed("Constraint_Error not raised for Object D");
+            end;
+         exception
+            when Constraint_Error =>
+               null;  -- Raise of Constraint_Error is expected.
+         end;
+
+
+         begin
+            declare
+               E: C432003_0.NT_A2 :=                                   -- OK
+                    (C432003_0.Constrained_Subtype with D3 => 10,
+                                                        S2 => String10,
+                                                        S3 => String10);
+            begin
+               C432003_0.Avoid_Optimization(E);
+               if E.D3   /= 10        or  E.Acc /= 356        or
+                  E.Str1 /= "abcde"   or  E.S2  /= String10   or
+                  E.S3   /= String10  or
+                  E.S1   /= C432003_0.Default_String(1..10)
+               then
+                  Report.Failed("Incorrect object values for Object E");
+               end if;
+            end;
+         exception
+            when Constraint_Error =>
+               Report.Failed("Constraint_Error raised for Object E");
+         end;
+
+
+         begin
+            declare
+               F: C432003_0.NT_A2 :=                                  -- C_E
+                    (C432003_0.Constrained_Subtype with 
+                       D3 => Report.Ident_Int(5),  
+                       S2 => String5,
+                       S3 => String5);
+            begin
+               C432003_0.Avoid_Optimization(F);
+               Report.Failed("Constraint_Error not raised for Object F");
+            end;
+         exception
+            when Constraint_Error =>
+               null;  -- Raise of Constraint_Error is expected.
+         end;
+
+
+         begin
+            declare
+               G: C432003_0.NT_B2 :=                                  -- OK
+                    (C432003_0.ROOT with D3   => 5,     
+                                         Str1 => "cdefg",
+                                         S2   => String10,
+                                         S3   => String5);
+            begin
+               C432003_0.Avoid_Optimization(G);
+               if G.D3   /= 5         or  G.Acc /= 356       or
+                  G.Str1 /= "cdefg"   or  G.S2  /= String10  or
+                  G.S3   /= String5   or
+                  G.S1   /= C432003_0.Default_String(1..5)
+               then
+                  Report.Failed("Incorrect object values for Object G");
+               end if;
+            end;
+         exception
+            when Constraint_Error =>
+               Report.Failed("Constraint_Error raised for Object G");
+         end;
+
+
+         begin
+            declare
+               H: C432003_0.NT_B3 :=                                    -- OK
+                    (C432003_0.Unconstrained_Der with D2 => 5,
+                                                      S2 => String5);
+            begin
+               C432003_0.Avoid_Optimization(H);
+               if H.D2   /= 5          or  H.Acc /= 356      or
+                  H.Str1 /= "abcde"    or  H.S2  /= String5  or
+                  H.S1   /= C432003_0.Default_String(1..10)
+               then
+                  Report.Failed("Incorrect object values for Object H");
+               end if;
+            end;
+         exception
+            when Constraint_Error =>
+               Report.Failed("Constraint_Error raised for Object H");
+         end;
+
+
+         begin
+            declare
+               I: C432003_0.NT_B1 :=                                  -- C_E
+                    (C432003_0.Constrained_Subtype with 
+                        D2 => Report.Ident_Int(10),
+                        S2 => String10);
+            begin
+               C432003_0.Avoid_Optimization(I);
+               Report.Failed("Constraint_Error not raised for Object I");
+            end;
+         exception
+            when Constraint_Error =>
+               null;  -- Raise of Constraint_Error is expected.
+         end;
+
+
+         begin
+            declare
+               J: C432003_0.NT_B2 :=                                  -- C_E
+                    (C432003_0.Constrained_Subtype with 
+                       D3 => Report.Ident_Int(10),
+                       S2 => String10,
+                       S3 => String10);
+            begin
+               C432003_0.Avoid_Optimization(J);
+               Report.Failed("Constraint_Error not raised by Object J");
+            end;
+         exception
+            when Constraint_Error =>
+               null;  -- Raise of Constraint_Error is expected.
+         end;
+
+
+         begin
+            declare
+               K: C432003_0.NT_B3 :=                                   -- OK
+                    (C432003_0.Constrained_Subtype with D2 => 5,
+                                                        S2 => String5);
+            begin
+               C432003_0.Avoid_Optimization(K);
+               if K.D2   /= 5          or  K.Acc /= 356       or
+                  K.Str1 /= "abcde"    or  K.S2  /= String5   or
+                  K.S1   /= C432003_0.Default_String(1..10)
+               then
+                  Report.Failed("Incorrect object values for Object K");
+               end if;
+            end;
+         exception
+            when Constraint_Error =>
+               Report.Failed("Constraint_Error raised for Object K");
+         end;
+
+
+         begin
+            declare
+               M: C432003_0.NT_C2 :=                                   -- OK
+                    (C432003_0.ROOT with D2   => 10,
+                                         Str1 => "cdefg",
+                                         Str2 => String5,
+                                         S2   => String10);
+            begin
+               C432003_0.Avoid_Optimization(M);
+               if M.D2   /= 10         or  M.Acc /= 356       or
+                  M.Str1 /= "cdefg"    or  M.S2  /= String10  or
+                  M.Str2 /= String5    or
+                  M.S1   /= C432003_0.Default_String(1..5)
+               then
+                  Report.Failed("Incorrect object values for Object M");
+               end if;
+            end;
+         exception
+            when Constraint_Error =>
+               Report.Failed("Constraint_Error raised for Object M");
+         end;
+
+
+         begin
+            declare
+               O: C432003_0.NT_C1 :=                                  -- C_E
+                    (C432003_0.Constrained_Subtype with 
+                       Str2 => Report.Ident_Str(String5));
+            begin
+               C432003_0.Avoid_Optimization(O);
+               Report.Failed("Constraint_Error not raised for Object O");
+            end;
+         exception
+            when Constraint_Error =>
+               null;  -- Raise of Constraint_Error is expected.
+         end;
+
+
+         begin
+            declare
+               P: C432003_0.NT_C2 :=                                  -- C_E
+                    (C432003_0.Constrained_Subtype with 
+                       D2   => Report.Ident_Int(10),
+                       Str2 => String5,
+                       S2   => String10);
+            begin
+               C432003_0.Avoid_Optimization(P);
+               Report.Failed("Constraint_Error not raised by Object P");
+            end;
+         exception
+            when Constraint_Error =>
+               null;  -- Raise of Constraint_Error is expected.
+         end;
+
+
+         begin
+            declare
+               Q: C432003_0.NT_C3 := 
+                  (C432003_0.Constrained_Subtype with Str2 => String5);  -- OK
+            begin
+               C432003_0.Avoid_Optimization(Q);
+               if Q.Str2 /= String5  or  
+                  Q.Acc  /= 356      or  
+                  Q.Str1 /= "abcde"  or
+                  Q.D1   /= 10       or
+                  Q.S1   /= C432003_0.Default_String(1..10)
+               then
+                  Report.Failed("Incorrect object values for Object Q");
+               end if;
+            end;
+         exception
+            when Constraint_Error =>
+               Report.Failed("Constraint_Error raised for Object Q");
+         end;
+
+
+         -- The following cases test where a new discriminant corresponds
+         -- to multiple discriminants of the type of the ancestor part.
+
+         begin
+            declare
+               S: C432003_0.Mult_NT_A1 :=                              -- OK
+                    (C432003_0.Mult_Unconstr_Der with D3 => 15,
+                                                      S3 => String15);
+            begin
+               C432003_0.Avoid_Optimization(S);
+               if S.S1   /= C432003_0.Default_String(1..15)  or  
+                  S.Str1 /= String8                          or
+                  S.S2   /= C432003_0.Another_String(1..15)  or  
+                  S.S3   /= String15                         or
+                  S.D3   /= 15
+               then
+                  Report.Failed("Incorrect object values for Object S");
+               end if;
+            end;
+         exception
+            when Constraint_Error =>
+               Report.Failed("Constraint_Error raised for Object S");
+         end;
+
+
+         begin
+            declare
+               U: C432003_0.Mult_NT_A1 :=                             -- C_E
+                    (C432003_0.Mult_Constr_Sub1 with 
+                       D3 => Report.Ident_Int(15),
+                       S3 => String15);
+            begin
+               C432003_0.Avoid_Optimization(U);
+               Report.Failed("Constraint_Error not raised for Object U");
+            end;
+         exception
+            when Constraint_Error =>
+               null;  -- Raise of Constraint_Error is expected.
+         end;
+
+
+         begin
+            declare
+               V: C432003_0.Mult_NT_A1 :=                              -- OK
+                    (C432003_0.Mult_Constr_Sub2 with D3 => 15,
+                                                     S3 => String15);
+            begin
+               C432003_0.Avoid_Optimization(V);
+               if V.D3   /= 15        or  
+                  V.Str1 /= String8   or
+                  V.S3   /= String15  or
+                  V.S1   /= C432003_0.Default_String(1..15) or
+                  V.S2   /= C432003_0.Another_String(1..15)
+               then
+                  Report.Failed("Incorrect object values for Object V");
+               end if;
+            end;
+         exception
+            when Constraint_Error =>
+               Report.Failed("Constraint_Error raised for Object V");
+         end;
+
+
+      exception
+         when others => Report.Failed("Exception raised in Test_Block");
+      end Test_Block;
+
+      Report.Result;
+
+end C432003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432004.a
new file mode 100644
index 000000000..3a1486211
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c432004.a
@@ -0,0 +1,319 @@
+-- C432004.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 type of an extension aggregate may be derived from the
+--      type of the ancestor part through multiple record extensions. Check
+--      for ancestor parts that are subtype marks. Check that the type of the
+--      ancestor part may be abstract.
+--
+-- TEST DESCRIPTION:
+--      This test defines the following type hierarchies:
+--
+--                (A)                           (F)
+--              Abstract                      Abstract
+--           Tagged record                 Tagged private
+--            /         \                   /          \
+--           /          (C)               (G)           \
+--         (B)        Abstract         Abstract         (H)
+--       Record       private          record         Private
+--      extension     extension        extension     extension
+--          |             |                |             |
+--         (D)           (E)              (I)           (J)
+--       Record        Record           Record        Record
+--      extension     extension        extension     extension
+--
+--      Extension aggregates for B, D, E, I, and J are constructed using each
+--      of its ancestor types as the ancestor part (except for E and J, for
+--      which only the immediate ancestor is used, since using A and F,
+--      respectively, as the ancestor part would be illegal).
+--
+--      X1 : B := (A with ...);
+--      X2 : D := (A with ...);         X5 : I := (F with ...);
+--      X3 : D := (B with ...);         X6 : I := (G with ...);
+--      X4 : E := (C with ...);         X7 : J := (H with ...);
+--
+--      For each assignment of an aggregate, the value of the target object is
+--      checked to ensure that the proper values for each component were
+--      assigned.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C432004_0 is
+
+   type Drawers is record
+      Building : natural;
+   end record;
+
+   type Location is access Drawers;
+
+   type Eras is (Precambrian, Paleozoic, Mesozoic, Cenozoic);
+
+   type SampleType_A is abstract tagged record
+      Era : Eras := Cenozoic;
+      Loc : Location;
+   end record;
+
+   type SampleType_F is abstract tagged private;
+
+   -- The following function is needed to verify the values of the
+   -- private components.
+   function TC_Correct_Result (Rec : SampleType_F'Class;
+                               E   : Eras) return Boolean;
+
+private
+   type SampleType_F is abstract tagged record
+      Era : Eras := Mesozoic;
+   end record;
+
+end C432004_0;
+
+     --==================================================================--
+
+package body C432004_0 is
+
+   function TC_Correct_Result (Rec : SampleType_F'Class;
+                               E   : Eras) return Boolean is
+   begin
+      return (Rec.Era = E);
+   end TC_Correct_Result;
+
+end C432004_0;
+
+     --==================================================================--
+
+with C432004_0;
+package C432004_1 is
+
+   type Periods is
+      (Aphebian, Helikian, Hadrynian,
+       Cambrian, Ordovician, Silurian, Devonian, Carboniferous, Permian,
+       Triassic, Jurassic, Cretaceous,
+       Tertiary, Quaternary);
+
+   type SampleType_B is new C432004_0.SampleType_A with record
+      Period : Periods := Quaternary;
+   end record;
+
+   type SampleType_C is abstract new C432004_0.SampleType_A with private;
+
+   -- The following function is needed to verify the values of the
+   -- extension's private components.
+   function TC_Correct_Result (Rec : SampleType_C'Class;
+                               P   : Periods) return Boolean;
+
+   type SampleType_G is abstract new C432004_0.SampleType_F with record
+      Period : Periods := Jurassic;
+      Loc    : C432004_0.Location;
+   end record;
+
+   type SampleType_H is new C432004_0.SampleType_F with private;
+
+   -- The following function is needed to verify the values of the
+   -- extension's private components.
+   function TC_Correct_Result (Rec : SampleType_H'Class;
+                               P   : Periods;
+                               E   : C432004_0.Eras) return Boolean;
+
+private
+   type SampleType_C is abstract new C432004_0.SampleType_A with record
+      Period : Periods := Quaternary;
+   end record;
+
+   type SampleType_H is new C432004_0.SampleType_F with record
+      Period : Periods := Jurassic;
+   end record;
+
+end C432004_1;
+
+     --==================================================================--
+
+package body C432004_1 is
+
+   function TC_Correct_Result (Rec : SampleType_C'Class;
+                               P   : Periods) return Boolean is
+   begin
+      return (Rec.Period = P);
+   end TC_Correct_Result;
+
+   -------------------------------------------------------------
+   function TC_Correct_Result (Rec : SampleType_H'Class;
+                               P   : Periods;
+                               E   : C432004_0.Eras) return Boolean is
+   begin
+      return (Rec.Period = P) and C432004_0.TC_Correct_Result (Rec, E);
+   end TC_Correct_Result;
+
+end C432004_1;
+
+     --==================================================================--
+
+with C432004_0;
+with C432004_1;
+package C432004_2 is
+
+   -- All types herein are record extensions, since aggregates
+   -- cannot be given for private extensions
+   
+   type SampleType_D is new C432004_1.SampleType_B with record
+      Sample_On_Loan : Boolean := False;
+   end record;
+
+   type SampleType_E is new C432004_1.SampleType_C 
+     with null record;
+
+   type SampleType_I is new C432004_1.SampleType_G with record
+      Sample_On_Loan : Boolean := True;
+   end record;
+
+   type SampleType_J is new C432004_1.SampleType_H with record
+      Sample_On_Loan : Boolean := True;
+   end record;
+
+end C432004_2;
+
+
+     --==================================================================--
+
+with Report;
+with C432004_0;
+with C432004_1;
+with C432004_2;
+use  C432004_1;
+use  C432004_2;
+
+procedure C432004 is
+
+   -- Variety of extension aggregates.
+
+   -- Default values for the components of SampleType_A 
+   -- (Era => Cenozoic, Loc => null).
+   Sample_B  :  SampleType_B 
+             := (C432004_0.SampleType_A with Period => Devonian);
+
+   -- Default values from SampleType_A (Era => Cenozoic, Loc => null).
+   Sample_D1 :  SampleType_D
+             := (C432004_0.SampleType_A with Period => Cambrian,
+                                     Sample_On_Loan => True);
+
+   -- Default values from SampleType_A and SampleType_B
+   -- (Era => Cenozoic, Loc => null, Period => Quaternary).
+   Sample_D2 :  SampleType_D
+             := (SampleType_B with Sample_On_Loan => True);
+
+   -- Default values from SampleType_A and SampleType_C
+   -- (Era => Cenozoic, Loc => null, Period => Quaternary).
+   Sample_E  :  SampleType_E
+             := (SampleType_C with null record);
+
+   -- Default value from SampleType_F (Era => Mesozoic).
+   Sample_I1 :  SampleType_I
+             := (C432004_0.SampleType_F with Period => Tertiary,
+                 Loc => new C432004_0.Drawers'(Building => 9),
+                 Sample_On_Loan => False);
+
+   -- Default values from SampleType_F and SampleType_G
+   -- (Era => Mesozoic, Period => Jurassic, Loc => null).
+   Sample_I2 :  SampleType_I
+             := (SampleType_G with Sample_On_Loan => False);
+
+   -- Default values from SampleType_H (Era => Mesozoic, Period => Jurassic).
+   Sample_J  :  SampleType_J
+             := (SampleType_H with Sample_On_Loan => False);
+
+   use type C432004_0.Eras;
+   use type C432004_0.Location;
+
+begin
+
+   Report.Test ("C432004", "Check that the type of an extension aggregate "  &
+                "may be derived from the type of the ancestor part through " &
+                "multiple record extensions");
+
+   if Sample_B /= (C432004_0.Cenozoic, null, Devonian) then
+      Report.Failed ("Object of record extension of abstract ancestor, " &
+                     "SampleType_B, failed content check");
+   end if;
+
+   -------------------
+   if Sample_D1 /= (Era => C432004_0.Cenozoic, Loc => null, 
+                    Period => Cambrian, Sample_On_Loan => True) then
+      Report.Failed ("Object 1 of record extension of record extension, "  & 
+                     "of abstract ancestor, SampleType_D, failed content " &
+                     "check");
+   end if;
+
+   -------------------
+   if Sample_D2 /= (C432004_0.Cenozoic, null, Quaternary, True) then
+      Report.Failed ("Object 2 of record extension of record extension, "  & 
+                     "of abstract ancestor, SampleType_D, failed content " &
+                     "check");
+   end if;
+   -------------------
+   if Sample_E.Era /= C432004_0.Cenozoic or 
+      Sample_E.Loc /= null               or
+      not TC_Correct_Result (Sample_E, Quaternary) then
+         Report.Failed ("Object of record extension of abstract private " & 
+                        "extension of abstract ancestor, SampleType_E, "  &
+                        "failed content check");
+   end if;
+
+   -------------------
+   if not C432004_0.TC_Correct_Result (Sample_I1, C432004_0.Mesozoic) or
+     Sample_I1.Period         /= Tertiary                             or
+     Sample_I1.Loc.Building   /= 9                                    or
+     Sample_I1.Sample_On_Loan /= False                                then
+       Report.Failed ("Object 1 of record extension of abstract record " &
+                      "extension of abstract private ancestor, "         &
+                      "SampleType_I, failed content check");
+   end if;
+
+   -------------------
+   if not C432004_0.TC_Correct_Result (Sample_I2, C432004_0.Mesozoic) or  
+     Sample_I2.Period         /= Jurassic                             or
+     Sample_I2.Loc            /= null                                 or
+     Sample_I2.Sample_On_Loan /= False                                then
+       Report.Failed ("Object 2 of record extension of abstract record " &
+                      "extension of abstract private ancestor, "         &
+                      "SampleType_I, failed content check");
+   end if;
+
+   -------------------
+   if not TC_Correct_Result (Sample_J,
+                             Jurassic,
+                             C432004_0.Mesozoic) or
+     Sample_J.Sample_On_Loan /= False            then
+        Report.Failed ("Object of record extension of private extension " &
+                       "of abstract private ancestor, SampleType_J, "     &
+                       "failed content check");
+   end if;
+
+   Report.Result;
+
+end C432004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204a.ada
new file mode 100644
index 000000000..33450dba0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204a.ada
@@ -0,0 +1,158 @@
+-- C43204A.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 ARRAY AGGREGATE WITH AN OTHERS CHOICE CAN APPEAR
+--     (AND BOUNDS ARE DETERMINED CORRECTLY) AS AN ACTUAL PARAMETER OF
+--     A SUBPROGRAM CALL WHEN THE FORMAL PARAMETER IS CONSTRAINED.
+
+-- HISTORY:
+--     JET 08/04/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43204A IS
+
+     TYPE ARR10 IS ARRAY(IDENT_INT(1)..IDENT_INT(0)) OF INTEGER;
+     TYPE ARR11 IS ARRAY(INTEGER RANGE -3..3) OF INTEGER;
+     TYPE ARR12 IS ARRAY(IDENT_INT(-3)..IDENT_INT(3)) OF INTEGER;
+
+     TYPE ARR20 IS ARRAY(IDENT_INT(1)..IDENT_INT(0),
+                         IDENT_INT(0)..IDENT_INT(-1)) OF INTEGER;
+     TYPE ARR21 IS ARRAY(INTEGER RANGE -1..1,
+                         INTEGER RANGE -1..1) OF INTEGER;
+     TYPE ARR22 IS ARRAY(IDENT_INT(-1)..IDENT_INT(1),
+                         IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
+     TYPE ARR23 IS ARRAY(INTEGER'(-1)..1,
+                         IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
+
+     PROCEDURE PROC10 (A : ARR10) IS
+     BEGIN
+          IF A'LENGTH /= IDENT_INT(0) THEN
+               FAILED ("PROC10 ARRAY IS NOT NULL");
+          END IF;
+     END PROC10;
+
+     PROCEDURE PROC11 (A : ARR11; C : INTEGER) IS
+     BEGIN
+          IF A'LENGTH /= IDENT_INT(7) OR
+             A'FIRST /= IDENT_INT(-3) OR
+             A'LAST /= IDENT_INT(3)   THEN
+               FAILED ("INCORRECT LENGTH IN PROC11 CALL NUMBER" &
+                       INTEGER'IMAGE(C));
+          END IF;
+
+          FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
+               IF IDENT_INT(A(I)) /= C THEN
+                    FAILED ("INCORRECT VALUE OF COMPONENT " &
+                            INTEGER'IMAGE(I) & ", PROC11 CALL NUMBER" &
+                            INTEGER'IMAGE(C));
+               END IF;
+          END LOOP;
+     END PROC11;
+
+     PROCEDURE PROC12 (A : ARR12) IS
+     BEGIN
+          IF A'LENGTH /= IDENT_INT(7) THEN
+               FAILED ("INCORRECT LENGTH IN PROC12");
+          END IF;
+
+          FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
+               IF IDENT_INT(A(I)) /= 3 THEN
+                    FAILED ("INCORRECT VALUE OF COMPONENT " &
+                            INTEGER'IMAGE(I) & ", PROC12");
+               END IF;
+          END LOOP;
+     END PROC12;
+
+     PROCEDURE PROC20 (A : ARR20) IS
+     BEGIN
+          IF A'LENGTH(1) /= IDENT_INT(0) OR
+             A'LENGTH(2) /= IDENT_INT(0) THEN
+               FAILED ("PROC20 ARRAY IS NOT NULL");
+          END IF;
+     END PROC20;
+
+     PROCEDURE PROC21 (A : ARR21; C : INTEGER) IS
+     BEGIN
+          FOR I IN INTEGER'(-1)..1 LOOP
+               FOR J IN INTEGER'(-1)..1 LOOP
+                    IF IDENT_INT(A(I,J)) /= C THEN
+                         FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                 INTEGER'IMAGE(I) & "," &
+                                 INTEGER'IMAGE(J) & "), PROC21 CALL " &
+                                 "NUMBER" & INTEGER'IMAGE(C));
+                    END IF;
+               END LOOP;
+          END LOOP;
+     END PROC21;
+
+     PROCEDURE PROC22 (A : ARR22) IS
+     BEGIN
+          FOR I IN INTEGER'(-1)..1 LOOP
+               FOR J IN INTEGER'(-1)..1 LOOP
+                    IF IDENT_INT(A(I,J)) /= 5 THEN
+                         FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                 INTEGER'IMAGE(I) & "," &
+                                 INTEGER'IMAGE(J) & "), PROC22");
+                    END IF;
+               END LOOP;
+          END LOOP;
+     END PROC22;
+
+     PROCEDURE PROC23 (A : ARR23) IS
+     BEGIN
+          FOR I IN INTEGER'(-1)..1 LOOP
+               FOR J IN INTEGER'(-1)..1 LOOP
+                    IF IDENT_INT(A(I,J)) /= 7 THEN
+                         FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                 INTEGER'IMAGE(I) & "," &
+                                 INTEGER'IMAGE(J) & "), PROC23");
+                    END IF;
+               END LOOP;
+          END LOOP;
+     END PROC23;
+
+BEGIN
+     TEST ("C43204A", "CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS " &
+                      "CHOICE CAN APPEAR (AND BOUNDS ARE DETERMINED " &
+                      "CORRECTLY) AS AN ACTUAL PARAMETER OF A " &
+                      "SUBPROGRAM CALL WHEN THE FORMAL PARAMETER IS " &
+                      "CONSTRAINED");
+
+     PROC11 ((1,1,1, OTHERS => 1), 1);
+     PROC11 ((2 => 2, 3 => 2, OTHERS => 2), 2);
+     PROC12 ((OTHERS => 3));
+     PROC10 ((OTHERS => 4));
+
+     PROC21 (((1,1,1), OTHERS => (1,1,1)), 1);
+     PROC21 ((1 => (2,2,2), OTHERS => (2,2,2)), 2);
+     PROC21 (((3,OTHERS => 3), (3,OTHERS => 3), (3,3,OTHERS => 3)), 3);
+     PROC21 (((-1 => 4, OTHERS => 4), (0 => 4, OTHERS => 4),
+              (1 => 4, OTHERS => 4)), 4);
+     PROC22 ((OTHERS => (OTHERS => 5)));
+     PROC20 ((OTHERS => (OTHERS => 6)));
+     PROC23 ((OTHERS => (7,7,7)));
+
+     RESULT;
+END C43204A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204c.ada
new file mode 100644
index 000000000..1db9f7f17
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204c.ada
@@ -0,0 +1,192 @@
+-- C43204C.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 ARRAY AGGREGATE WITH AN OTHERS CHOICE CAN APPEAR
+--     (AND BOUNDS ARE DETERMINED CORRECTLY) AS AN ACTUAL PARAMETER OF
+--     A GENERIC INSTANTIATION WHEN THE GENERIC FORMAL PARAMETER IS
+--     CONSTRAINED.
+
+-- HISTORY:
+--     JET 08/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43204C IS
+
+     TYPE ARR10 IS ARRAY(IDENT_INT(1)..IDENT_INT(0)) OF INTEGER;
+     TYPE ARR11 IS ARRAY(INTEGER RANGE -3..3) OF INTEGER;
+     TYPE ARR12 IS ARRAY(IDENT_INT(-3)..IDENT_INT(3)) OF INTEGER;
+
+     TYPE ARR20 IS ARRAY(IDENT_INT(1)..IDENT_INT(0),
+                         IDENT_INT(0)..IDENT_INT(-1)) OF INTEGER;
+     TYPE ARR21 IS ARRAY(INTEGER RANGE -1..1,
+                         INTEGER RANGE -1..1) OF INTEGER;
+     TYPE ARR22 IS ARRAY(IDENT_INT(-1)..IDENT_INT(1),
+                         IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
+     TYPE ARR23 IS ARRAY(INTEGER'(-1)..1,
+                         IDENT_INT(-1)..IDENT_INT(1)) OF INTEGER;
+
+     GENERIC
+          A : ARR10;
+     PROCEDURE GPROC10;
+
+     GENERIC
+          A : ARR11;
+     PROCEDURE GPROC11;
+
+     GENERIC
+          A : ARR12;
+     PROCEDURE GPROC12;
+
+     GENERIC
+          A : ARR20;
+     PROCEDURE GPROC20;
+
+     GENERIC
+          A : ARR21;
+     PROCEDURE GPROC21 (C : INTEGER);
+
+     GENERIC
+          A : ARR22;
+     PROCEDURE GPROC22;
+
+     GENERIC
+          A : ARR23;
+     PROCEDURE GPROC23;
+
+     PROCEDURE GPROC10 IS
+     BEGIN
+          IF A'LENGTH /= IDENT_INT(0) THEN
+               FAILED ("PROC10 ARRAY IS NOT NULL");
+          END IF;
+     END GPROC10;
+
+     PROCEDURE GPROC11 IS
+     BEGIN
+          IF A'LENGTH /= IDENT_INT(7) OR
+             A'FIRST /= IDENT_INT(-3) OR
+             A'LAST /= IDENT_INT(3)   THEN
+               FAILED ("INCORRECT LENGTH IN PROC11");
+          END IF;
+
+          FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
+               IF IDENT_INT(A(I)) /= 1 THEN
+                    FAILED ("INCORRECT VALUE OF COMPONENT " &
+                            INTEGER'IMAGE(I) & ", PROC11");
+               END IF;
+          END LOOP;
+     END GPROC11;
+
+     PROCEDURE GPROC12 IS
+     BEGIN
+          IF A'LENGTH /= IDENT_INT(7) THEN
+               FAILED ("INCORRECT LENGTH IN PROC12");
+          END IF;
+
+          FOR I IN IDENT_INT(-3)..IDENT_INT(3) LOOP
+               IF IDENT_INT(A(I)) /= 2 THEN
+                    FAILED ("INCORRECT VALUE OF COMPONENT " &
+                            INTEGER'IMAGE(I) & ", PROC12");
+               END IF;
+          END LOOP;
+     END GPROC12;
+
+     PROCEDURE GPROC20 IS
+     BEGIN
+          IF A'LENGTH(1) /= IDENT_INT(0) OR
+             A'LENGTH(2) /= IDENT_INT(0) THEN
+               FAILED ("GPROC20 ARRAY IS NOT NULL");
+          END IF;
+     END GPROC20;
+
+     PROCEDURE GPROC21 (C : INTEGER) IS
+     BEGIN
+          FOR I IN INTEGER'(-1)..1 LOOP
+               FOR J IN INTEGER'(-1)..1 LOOP
+                    IF IDENT_INT(A(I,J)) /= C THEN
+                         FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                 INTEGER'IMAGE(I) & "," &
+                                 INTEGER'IMAGE(J) & "), GPROC21 CALL " &
+                                 "NUMBER" & INTEGER'IMAGE(C));
+                    END IF;
+               END LOOP;
+          END LOOP;
+     END GPROC21;
+
+     PROCEDURE GPROC22 IS
+     BEGIN
+          FOR I IN INTEGER'(-1)..1 LOOP
+               FOR J IN INTEGER'(-1)..1 LOOP
+                    IF IDENT_INT(A(I,J)) /= 3 THEN
+                         FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                 INTEGER'IMAGE(I) & "," &
+                                 INTEGER'IMAGE(J) & "), GPROC22");
+                    END IF;
+               END LOOP;
+          END LOOP;
+     END GPROC22;
+
+     PROCEDURE GPROC23 IS
+     BEGIN
+          FOR I IN INTEGER'(-1)..1 LOOP
+               FOR J IN INTEGER'(-1)..1 LOOP
+                    IF IDENT_INT(A(I,J)) /= 4 THEN
+                         FAILED ("INCORRECT VALUE OF COMPONENT (" &
+                                 INTEGER'IMAGE(I) & "," &
+                                 INTEGER'IMAGE(J) & "), GPROC23");
+                    END IF;
+               END LOOP;
+          END LOOP;
+     END GPROC23;
+
+     PROCEDURE PROC11 IS NEW GPROC11((1,1,1, OTHERS => 1));
+     PROCEDURE PROC12 IS NEW GPROC12((OTHERS => 2));
+     PROCEDURE PROC10 IS NEW GPROC10((OTHERS => 3));
+
+     PROCEDURE PROC21 IS NEW GPROC21(((1,1,1), OTHERS => (1,1,1)));
+     PROCEDURE PROC22 IS NEW GPROC21(((2,OTHERS => 2), (2,OTHERS => 2),
+                                      (2,2,OTHERS => 2)));
+     PROCEDURE PROC23 IS NEW GPROC22((OTHERS => (OTHERS => 3)));
+     PROCEDURE PROC24 IS NEW GPROC23((OTHERS => (4,4,4)));
+     PROCEDURE PROC20 IS NEW GPROC20((OTHERS => (OTHERS => 5)));
+
+BEGIN
+     TEST ("C43204C", "CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS " &
+                      "CHOICE CAN APPEAR (AND BOUNDS ARE DETERMINED " &
+                      "CORRECTLY) AS AN ACTUAL PARAMETER OF A " &
+                      "SUBPROGRAM CALL WHEN THE FORMAL PARAMETER IS " &
+                      "CONSTRAINED");
+
+     PROC11;
+     PROC12;
+     PROC10;
+
+     PROC21(1);
+     PROC22(2);
+     PROC23;
+     PROC24;
+     PROC20;
+
+     RESULT;
+END C43204C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204e.ada
new file mode 100644
index 000000000..8b6566660
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204e.ada
@@ -0,0 +1,179 @@
+-- C43204E.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 ARRAY AGGREGATE WITH AN OTHERS CHOICE CAN APPEAR
+--     AS THE INITIALIZATION EXPRESSION OF A CONSTRAINED CONSTANT,
+--     VARIABLE OBJECT DECLARATION, OR RECORD COMPONENT DECLARATION,
+--     AND THAT THE BOUNDS OF THE AGGREGATE ARE DETERMINED CORRECTLY.
+
+-- HISTORY:
+--     JET 08/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43204E IS
+
+     TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
+     TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
+     TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
+     TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
+                          INTEGER RANGE -1 .. 1) OF INTEGER;
+     TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+     TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+     TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+
+     CA11 : CONSTANT ARR11 := (1, OTHERS => IDENT_INT(2));
+     CA12 : CONSTANT ARR12 := (OTHERS => IDENT_INT(2));
+     CA13 : CONSTANT ARR13 := (OTHERS => IDENT_INT(2));
+     CA21 : CONSTANT ARR21 := (OTHERS => (-1..1 => IDENT_INT(2)));
+     CA22 : CONSTANT ARR22 := (OTHERS => (-1..1 => IDENT_INT(2)));
+     CA23 : CONSTANT ARR23 := (-1..1 => (OTHERS => IDENT_INT(2)));
+     CA24 : CONSTANT ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
+
+     VA11 : ARR11 := (1,1, OTHERS => IDENT_INT(2));
+     VA12 : ARR12 := (OTHERS => IDENT_INT(2));
+     VA13 : ARR13 := (OTHERS => IDENT_INT(2));
+     VA21 : ARR21 := ((1,1,1), OTHERS => (-1..1 => IDENT_INT(2)));
+     VA22 : ARR22 := (-1 => (1,1,1), 0..1 => (OTHERS => IDENT_INT(2)));
+     VA23 : ARR23 := (OTHERS => (OTHERS => IDENT_INT(2)));
+     VA24 : ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
+
+     TYPE REC IS RECORD
+          RA11 : ARR11 := (1,1,1, OTHERS => IDENT_INT(2));
+          RA12 : ARR12 := (OTHERS => IDENT_INT(2));
+          RA13 : ARR13 := (OTHERS => IDENT_INT(2));
+          RA21 : ARR21 := ((1,1,1), (1,1,1), OTHERS => (IDENT_INT(2),
+                           IDENT_INT(2), IDENT_INT(2)));
+          RA22 : ARR22 := (OTHERS => (OTHERS => IDENT_INT(2)));
+          RA23 : ARR23 := (-1 => (OTHERS => 1),
+                           0..1 => (OTHERS => IDENT_INT(2)));
+          RA24 : ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
+     END RECORD;
+
+     R : REC;
+
+BEGIN
+     TEST ("C43204E", "CHECK THAT AN ARRAY AGGREGATE WITH AN OTHERS " &
+                      "CHOICE CAN APPEAR AS THE INITIALIZATION " &
+                      "EXPRESSION OF A CONSTRAINED CONSTANT, " &
+                      "VARIABLE OBJECT DECLARATION, OR RECORD " &
+                      "COMPONENT DECLARATION, AND THAT THE BOUNDS OF " &
+                      "THE AGGREGATE ARE DETERMINED CORRECTLY");
+
+     IF CA11 /= (1, 2, 2, 2, 2, 2, 2) THEN
+          FAILED("INCORRECT VALUE OF CA11");
+     END IF;
+
+     IF CA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+          FAILED("INCORRECT VALUE OF CA12");
+     END IF;
+
+     IF CA13'LENGTH /= 0 THEN
+          FAILED("INCORRECT VALUE OF CA13");
+     END IF;
+
+     IF CA21 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF CA21");
+     END IF;
+
+     IF CA22 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF CA22");
+     END IF;
+
+     IF CA23 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF CA23");
+     END IF;
+
+     IF CA24'LENGTH /= 0 OR CA24'LENGTH(2) /= 3 THEN
+          FAILED("INCORRECT VALUE OF CA24");
+     END IF;
+
+     IF VA11 /= (1, 1, 2, 2, 2, 2, 2) THEN
+          FAILED("INCORRECT VALUE OF VA11");
+     END IF;
+
+     IF VA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+          FAILED("INCORRECT VALUE OF VA12");
+     END IF;
+
+     IF VA13'LENGTH /= 0 THEN
+          FAILED("INCORRECT VALUE OF VA13");
+     END IF;
+
+     IF VA21 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF VA21");
+     END IF;
+
+     IF VA22 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF VA22");
+     END IF;
+
+     IF VA23 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF VA23");
+     END IF;
+
+     IF VA24'LENGTH /= 0 OR VA24'LENGTH(2) /= 3 THEN
+          FAILED("INCORRECT VALUE OF VA24");
+     END IF;
+
+     IF R.RA11 /= (1, 1, 1, 2, 2, 2, 2) THEN
+          FAILED("INCORRECT VALUE OF RA11");
+     END IF;
+
+     IF R.RA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+          FAILED("INCORRECT VALUE OF RA12");
+     END IF;
+
+     IF R.RA13'LENGTH /= 0 THEN
+          FAILED("INCORRECT VALUE OF RA13");
+     END IF;
+
+     IF R.RA21 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF RA21");
+     END IF;
+
+     IF R.RA22 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF RA22");
+     END IF;
+
+     IF R.RA23 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF RA23");
+     END IF;
+
+     IF R.RA24'LENGTH /= 0 OR R.RA24'LENGTH(2) /= 3 THEN
+          FAILED("INCORRECT VALUE OF RA24");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
+                  "RAISED");
+
+          RESULT;
+END C43204E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204f.ada
new file mode 100644
index 000000000..bd6cc6170
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204f.ada
@@ -0,0 +1,107 @@
+-- C43204F.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 AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS A
+--     CONSTRAINED FORMAL PARAMETER OF A SUBPROGRAM AND THAT THE BOUNDS
+--     OF THE AGGREGATE ARE DETERMINED CORRECTLY.
+
+-- HISTORY:
+--     JET 08/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43204F IS
+
+     TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
+     TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
+     TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
+     TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
+                          INTEGER RANGE -1 .. 1) OF INTEGER;
+     TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+     TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+     TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+
+     PROCEDURE PROC (PA11 : ARR11 := (1,1,1,1,1,1,
+                                      OTHERS => IDENT_INT(2));
+                     PA12 : ARR12 := (OTHERS => IDENT_INT(2));
+                     PA13 : ARR13 := (OTHERS => IDENT_INT(2));
+                     PA21 : ARR21 := ((1,1,1), (1,1,1),
+                                      (1, OTHERS => IDENT_INT(2)));
+                     PA22 : ARR22 := ((1,1,1), (1,1,1),
+                                      (OTHERS => IDENT_INT(2)));
+                     PA23 : ARR23 := ((1,1,1), (1,1,1), (1,1,1),
+                                      OTHERS => (OTHERS =>
+                                      IDENT_INT(2)));
+                     PA24 : ARR24 := (OTHERS => (OTHERS =>
+                                      IDENT_INT(2)))) IS
+     BEGIN
+          IF PA11 /= (1, 1, 1, 1, 1, 1, 2) THEN
+               FAILED("INCORRECT VALUE OF PA11");
+          END IF;
+
+          IF PA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+               FAILED("INCORRECT VALUE OF PA12");
+          END IF;
+
+          IF PA13'LENGTH /= 0 THEN
+               FAILED("INCORRECT VALUE OF PA13");
+          END IF;
+
+          IF PA21 /= ((1,1,1), (1,1,1), (1,2,2)) THEN
+               FAILED("INCORRECT VALUE OF PA21");
+          END IF;
+
+          IF PA22 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
+               FAILED("INCORRECT VALUE OF PA22");
+          END IF;
+
+          IF PA23 /= ((1,1,1), (1,1,1), (1,1,1)) THEN
+               FAILED("INCORRECT VALUE OF PA23");
+          END IF;
+
+          IF PA24'LENGTH /= 0 OR PA24'LENGTH(2) /= 3 THEN
+               FAILED("INCORRECT VALUE OF PA24");
+          END IF;
+     END PROC;
+
+BEGIN
+     TEST ("C43204F", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
+                      "CAN APPEAR AS A CONSTRAINED FORMAL PARAMETER " &
+                      "OF A SUBPROGRAM AND THAT THE BOUNDS OF THE " &
+                      "AGGREGATE ARE DETERMINED CORRECTLY");
+
+     PROC;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
+                  "RAISED");
+
+          RESULT;
+END C43204F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204g.ada
new file mode 100644
index 000000000..3474e5728
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204g.ada
@@ -0,0 +1,125 @@
+-- C43204G.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 AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS A
+--     CONSTRAINED FORMAL PARAMETER OF AN ENTRY, AND THAT THE BOUNDS
+--     OF THE AGGREGATE ARE DETERMINED CORRECTLY.
+
+-- HISTORY:
+--     JET 08/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43204G IS
+
+     TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
+     TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
+     TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
+     TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
+                          INTEGER RANGE -1 .. 1) OF INTEGER;
+     TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+     TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+     TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+
+     TASK T IS
+          ENTRY E (EA11 : ARR11 := (1,1,1,1, OTHERS => IDENT_INT(2));
+                   EA12 : ARR12 := (OTHERS => IDENT_INT(2));
+                   EA13 : ARR13 := (OTHERS => IDENT_INT(2));
+                   EA21 : ARR21 := ((1,1,1), (1,1,1), (1,1,1),
+                                    OTHERS => (-1..1 => IDENT_INT(2)));
+                   EA22 : ARR22 := ((OTHERS => IDENT_INT(2)), (1,1,1),
+                                    (1,1,1));
+                   EA23 : ARR23 := (-1..0 => (OTHERS => 1),
+                                    1 => (OTHERS => IDENT_INT(2)));
+                   EA24: ARR24 := (OTHERS => (OTHERS => IDENT_INT(2))));
+     END T;
+
+     TASK BODY T IS
+     BEGIN
+          ACCEPT E (EA11 : ARR11 := (1,1,1,1, OTHERS => IDENT_INT(2));
+                    EA12 : ARR12 := (OTHERS => IDENT_INT(2));
+                    EA13 : ARR13 := (OTHERS => IDENT_INT(2));
+                    EA21 : ARR21 := ((1,1,1), (1,1,1), (1,1,1),
+                                     OTHERS => (-1..1 => IDENT_INT(2)));
+                    EA22 : ARR22 := ((OTHERS => IDENT_INT(2)), (1,1,1),
+                                     (1,1,1));
+                    EA23 : ARR23 := (-1..0 => (OTHERS => 1),
+                                     1 => (OTHERS => IDENT_INT(2)));
+                    EA24 : ARR24 := (OTHERS => (OTHERS =>
+                                    IDENT_INT(2))))
+          DO
+               IF EA11 /= (1, 1, 1, 1, 2, 2, 2) THEN
+                    FAILED("INCORRECT VALUE OF EA11");
+               END IF;
+
+               IF EA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+                    FAILED("INCORRECT VALUE OF EA12");
+               END IF;
+
+               IF EA13'LENGTH /= 0 THEN
+                    FAILED("INCORRECT VALUE OF EA13");
+               END IF;
+
+               IF EA21 /= ((1,1,1), (1,1,1), (1,1,1)) THEN
+                    FAILED("INCORRECT VALUE OF EA21");
+               END IF;
+
+               IF EA22 /= ((2,2,2), (1,1,1), (1,1,1)) THEN
+                    FAILED("INCORRECT VALUE OF EA22");
+               END IF;
+
+               IF EA23 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
+                    FAILED("INCORRECT VALUE OF EA23");
+               END IF;
+
+               IF EA24'LENGTH /= 0 OR EA24'LENGTH(2) /= 3 THEN
+                    FAILED("INCORRECT VALUE OF EA24");
+               END IF;
+          END E;
+     END T;
+
+BEGIN
+     TEST ("C43204G", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
+                      "CAN APPEAR AS A CONSTRAINED FORMAL PARAMETER " &
+                      "OF AN ENTRY, AND THAT THE BOUNDS OF THE " &
+                      "AGGREGATE ARE DETERMINED CORRECTLY");
+
+     T.E;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
+                  "RAISED");
+
+          IF T'CALLABLE THEN
+               T.E;
+          END IF;
+
+          RESULT;
+END C43204G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204h.ada
new file mode 100644
index 000000000..54b19587b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204h.ada
@@ -0,0 +1,107 @@
+-- C43204H.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 AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS A
+--     CONSTRAINED FORMAL PARAMETER OF A GENERIC UNIT, AND THAT THE
+--     BOUNDS OF THE AGGREGATE ARE DETERMINED CORRECTLY.
+
+-- HISTORY:
+--     JET 08/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43204H IS
+
+     TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
+     TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
+     TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
+     TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
+                          INTEGER RANGE -1 .. 1) OF INTEGER;
+     TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+     TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+     TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+
+     GENERIC
+          GA11 : ARR11 := (1,1,1,1,1, OTHERS => IDENT_INT(2));
+          GA12 : ARR12 := (OTHERS => IDENT_INT(2));
+          GA13 : ARR13 := (OTHERS => IDENT_INT(2));
+          GA21 : ARR21 := ((1,1,1), (1,1,1), (OTHERS => IDENT_INT(2)));
+          GA22 : ARR22 := ((1,1,1), (OTHERS => IDENT_INT(2)), (1,1,1));
+          GA23 : ARR23 := ((1,1,1), (OTHERS => IDENT_INT(2)), (1,1,1));
+          GA24 : ARR24 := (OTHERS => (OTHERS => IDENT_INT(2)));
+     PROCEDURE GEN;
+
+     PROCEDURE GEN IS
+     BEGIN
+          IF GA11 /= (1, 1, 1, 1, 1, 2, 2) THEN
+               FAILED("INCORRECT VALUE OF GA11");
+          END IF;
+
+          IF GA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+               FAILED("INCORRECT VALUE OF GA12");
+          END IF;
+
+          IF GA13'LENGTH /= 0 THEN
+               FAILED("INCORRECT VALUE OF GA13");
+          END IF;
+
+          IF GA21 /= ((1,1,1), (1,1,1), (2,2,2)) THEN
+               FAILED("INCORRECT VALUE OF GA21");
+          END IF;
+
+          IF GA22 /= ((1,1,1), (2,2,2), (1,1,1)) THEN
+               FAILED("INCORRECT VALUE OF GA22");
+          END IF;
+
+          IF GA23 /= ((1,1,1), (2,2,2), (1,1,1)) THEN
+               FAILED("INCORRECT VALUE OF GA23");
+          END IF;
+
+          IF GA24'LENGTH /= 0 OR GA24'LENGTH(2) /= 3 THEN
+               FAILED("INCORRECT VALUE OF GA24");
+          END IF;
+     END GEN;
+
+     PROCEDURE PROCG IS NEW GEN;
+
+BEGIN
+     TEST ("C43204H", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
+                      "CAN APPEAR AS A CONSTRAINED FORMAL PARAMETER " &
+                      "OF A GENERIC UNIT, AND THAT THE BOUNDS OF " &
+                      "THE AGGREGATE ARE DETERMINED CORRECTLY");
+
+     PROCG;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
+                  "RAISED");
+
+          RESULT;
+END C43204H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204i.ada
new file mode 100644
index 000000000..1a761a541
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43204i.ada
@@ -0,0 +1,106 @@
+-- C43204I.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 AGGREGATE WITH AN OTHERS CLAUSE CAN APPEAR AS THE
+--     EXPRESSION IN AN ASSIGNMENT STATEMENT, AND THAT THE BOUNDS OF
+--     THE AGGREGATE ARE DETERMINED CORRECTLY.
+
+-- HISTORY:
+--     JET 08/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43204I IS
+
+     TYPE ARR11 IS ARRAY (INTEGER RANGE -3 .. 3) OF INTEGER;
+     TYPE ARR12 IS ARRAY (IDENT_INT(-3) .. IDENT_INT(3)) OF INTEGER;
+     TYPE ARR13 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1)) OF INTEGER;
+     TYPE ARR21 IS ARRAY (INTEGER RANGE -1 .. 1,
+                          INTEGER RANGE -1 .. 1) OF INTEGER;
+     TYPE ARR22 IS ARRAY (IDENT_INT(-1) .. IDENT_INT(1),
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+     TYPE ARR23 IS ARRAY (INTEGER RANGE -1 .. 1,
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+     TYPE ARR24 IS ARRAY (IDENT_INT(1) .. IDENT_INT(-1),
+                          IDENT_INT(-1) .. IDENT_INT(1)) OF INTEGER;
+
+     VA11 : ARR11;
+     VA12 : ARR12;
+     VA13 : ARR13;
+     VA21 : ARR21;
+     VA22 : ARR22;
+     VA23 : ARR23;
+     VA24 : ARR24;
+
+BEGIN
+     TEST ("C43204I", "CHECK THAT AN AGGREGATE WITH AN OTHERS CLAUSE " &
+                      "CAN APPEAR AS THE EXPRESSION IN AN ASSIGNMENT " &
+                      "STATEMENT, AND THAT THE BOUNDS OF THE " &
+                      "AGGREGATE ARE DETERMINED CORRECTLY");
+
+     VA11 := (1,1, OTHERS => IDENT_INT(2));
+     VA12 := (OTHERS => IDENT_INT(2));
+     VA13 := (OTHERS => IDENT_INT(2));
+     VA21 := ((1,1,1), OTHERS => (-1..1 => IDENT_INT(2)));
+     VA22 := (-1 => (1,1,1), 0..1 => (OTHERS => IDENT_INT(2)));
+     VA23 := (OTHERS => (OTHERS => IDENT_INT(2)));
+     VA24 := (OTHERS => (OTHERS => IDENT_INT(2)));
+
+     IF VA11 /= (1, 1, 2, 2, 2, 2, 2) THEN
+          FAILED("INCORRECT VALUE OF VA11");
+     END IF;
+
+     IF VA12 /= (2, 2, 2, 2, 2, 2, 2) THEN
+          FAILED("INCORRECT VALUE OF VA12");
+     END IF;
+
+     IF VA13'LENGTH /= 0 THEN
+          FAILED("INCORRECT VALUE OF VA13");
+     END IF;
+
+     IF VA21 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF VA21");
+     END IF;
+
+     IF VA22 /= ((1,1,1), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF VA22");
+     END IF;
+
+     IF VA23 /= ((2,2,2), (2,2,2), (2,2,2)) THEN
+          FAILED("INCORRECT VALUE OF VA23");
+     END IF;
+
+     IF VA24'LENGTH /= 0 OR VA24'LENGTH(2) /= 3 THEN
+          FAILED("INCORRECT VALUE OF VA24");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("UNEXPECTED CONSTRAINT_ERROR OR OTHER EXCEPTION " &
+                  "RAISED");
+
+          RESULT;
+END C43204I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205a.ada
new file mode 100644
index 000000000..9946ba9ee
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205a.ada
@@ -0,0 +1,111 @@
+-- C43205A.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 A POSITIONAL AGGREGATE ARE DETERMINED
+-- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+-- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
+
+--   A) AN ACTUAL PARAMETER IN A SUBPROGRAM OR ENTRY CALL, AND THE
+--      FORMAL PARAMETER IS UNCONSTRAINED.
+
+-- EG  01/26/84
+
+WITH REPORT;
+
+PROCEDURE C43205A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43205A", "CASE A1 : SUBPROGRAM WITH UNCONSTRAINED " &
+                     "ONE-DIMENSIONAL ARRAY FORMAL PARAMETER");
+
+     BEGIN
+
+CASE_A :  BEGIN
+
+     CASE_A1 : DECLARE
+
+                    SUBTYPE STA IS INTEGER RANGE 11 .. 15;
+                    TYPE TA IS ARRAY (STA RANGE <>) OF INTEGER;
+
+                    PROCEDURE PROC1 (A : TA) IS
+                    BEGIN
+                         IF A'FIRST /= IDENT_INT(11) THEN
+                              FAILED ("CASE A1 : LOWER BOUND " &
+                                      "INCORRECTLY GIVEN BY 'FIRST");
+                         ELSIF A'LAST /= 15 THEN
+                              FAILED ("CASE A1 : UPPER BOUND " &
+                                      "INCORRECTLY GIVEN BY 'LAST");
+                         ELSIF A /= (6, 7, 8, 9, 10) THEN
+                              FAILED ("CASE A1 : ARRAY DOES NOT " &
+                                     "CONTAIN THE CORRECT VALUES");
+                         END IF;
+                    END;
+
+               BEGIN
+
+                    PROC1 ((6, 7, 8, 9, IDENT_INT(10)));
+
+               END CASE_A1;
+
+               COMMENT ("CASE A2 : SUBPROGRAM WITH UNCONSTRAINED " &
+                        "TWO-DIMENSIONAL ARRAY FORMAL PARAMETER");
+
+     CASE_A2 : DECLARE
+
+                    SUBTYPE STA1 IS INTEGER RANGE 11 .. IDENT_INT(12);
+                    SUBTYPE STA2 IS INTEGER RANGE 10 .. 11;
+                    TYPE TA IS ARRAY (STA1 RANGE <>, STA2 RANGE <>)
+                                    OF INTEGER;
+
+                    PROCEDURE PROC1 (A : TA) IS
+                    BEGIN
+                         IF A'FIRST(1) /= 11 OR A'FIRST(2) /= 10 THEN
+                              FAILED ("CASE A2 : LOWER BOUND " &
+                                      "INCORRECTLY GIVEN BY 'FIRST");
+                         ELSIF A'LAST(1) /= 12 OR 
+                               A'LAST(2) /= IDENT_INT(11) THEN
+                              FAILED ("CASE A2 : UPPER BOUND " &
+                                      "INCORRECTLY GIVEN BY 'LAST");
+                         ELSIF A /= ((1, 2), (3, 4)) THEN
+                              FAILED ("CASE A2 : ARRAY DOES NOT " &
+                                     "CONTAIN THE CORRECT VALUES");
+                         END IF;
+                    END;
+
+               BEGIN
+
+                    PROC1 (((1, 2), (IDENT_INT(3), 4)));
+
+               END CASE_A2;
+
+          END CASE_A;
+
+     END;
+
+     RESULT;
+
+END C43205A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205b.ada
new file mode 100644
index 000000000..7f4dfd6fd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205b.ada
@@ -0,0 +1,82 @@
+-- C43205B.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 A POSITIONAL AGGREGATE ARE DETERMINED
+-- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+-- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
+
+--   B) AN ACTUAL PARAMETER IN A GENERIC INSTANTIATION, AND THE FORMAL
+--      PARAMETER IS UNCONSTRAINED.
+
+-- EG  01/26/84
+
+WITH REPORT;
+
+PROCEDURE C43205B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43205B", "CASE B : UNCONSTRAINED ARRAY FORMAL GENERIC " &
+                      "PARAMETER");
+
+     BEGIN
+
+CASE_B :  DECLARE
+
+               SUBTYPE STB IS INTEGER RANGE IDENT_INT(-8) .. -5;
+               TYPE TB IS ARRAY (STB RANGE <>) OF INTEGER;
+
+               GENERIC
+                    B1 : TB;
+               PROCEDURE PROC1;
+
+               PROCEDURE PROC1 IS
+               BEGIN
+                    IF B1'FIRST /= -8 THEN
+                         FAILED ("CASE B : LOWER BOUND INCORRECTLY " &
+                                 "GIVEN BY 'FIRST");
+                    ELSIF B1'LAST /= IDENT_INT(-5) THEN
+                         FAILED ("CASE B : UPPER BOUND INCORRECTLY " &
+                                 "GIVEN BY 'LAST");
+                    ELSIF B1 /= (7, 6, 5, 4) THEN
+                         FAILED ("CASE B : ARRAY DOES NOT " &
+                                 "CONTAIN THE CORRECT VALUES");
+                    END IF;
+               END;
+
+               PROCEDURE PROC2 IS NEW PROC1 ((7, 6, IDENT_INT(5), 4));
+
+          BEGIN
+
+               PROC2;
+
+          END CASE_B;
+
+     END;
+
+     RESULT;
+
+END C43205B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205c.ada
new file mode 100644
index 000000000..e78837027
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205c.ada
@@ -0,0 +1,83 @@
+-- C43205C.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 A POSITIONAL AGGREGATE ARE DETERMINED
+-- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+-- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
+
+--   C) THE RETURN EXPRESSION IN A FUNCTION WHOSE RETURN TYPE IS
+--      UNCONSTRAINED.
+
+-- EG  01/26/84
+
+WITH REPORT;
+
+PROCEDURE C43205C IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43205C", "CASE C : UNCONSTRAINED FUNCTION RESULT TYPE");
+
+     BEGIN
+
+CASE_C :  DECLARE
+
+               SUBTYPE STC1 IS INTEGER RANGE -2 .. 3;
+               SUBTYPE STC2 IS INTEGER RANGE 7 .. 20;
+               TYPE TC IS ARRAY (STC1 RANGE <>, STC2 RANGE <>)
+                                                        OF INTEGER;
+
+               FUNCTION FUN1 (A : INTEGER) RETURN TC IS
+               BEGIN
+                    RETURN ((5, 4, 3), (2, IDENT_INT(1), 0));
+               END;
+
+          BEGIN
+
+               IF FUN1(5)'FIRST(1) /= -2 THEN
+                    FAILED ("CASE C : LOWER BOUND INCORRECTLY " &
+                            "GIVEN BY 'FIRST(1)");
+               ELSIF FUN1(5)'FIRST(2) /= 7 THEN
+                    FAILED ("CASE C : LOWER BOUND INCORRECTLY " &
+                            "GIVEN BY 'FIRST(2)");
+               ELSIF FUN1(5)'LAST(1) /= -1 THEN
+                    FAILED ("CASE C : UPPER BOUND INCORRECTLY " &
+                            "GIVEN BY 'LAST(1)");
+               ELSIF FUN1(5)'LAST(2) /= 9 THEN
+                    FAILED ("CASE C : UPPER BOUND INCORRECTLY " &
+                            "GIVEN BY 'LAST(2)");
+               ELSIF FUN1(5) /= ((5, 4, 3), (2, 1, 0)) THEN
+                    FAILED ("CASE C : FUNCTION DOES NOT " &
+                            "RETURN THE CORRECT VALUES");
+               END IF;
+
+          END CASE_C;
+
+     END;
+
+     RESULT;
+
+END C43205C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205d.ada
new file mode 100644
index 000000000..ddffcbe8a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205d.ada
@@ -0,0 +1,73 @@
+-- C43205D.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 A POSITIONAL AGGREGATE ARE DETERMINED
+-- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+-- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
+
+--   D) THE INITIALIZATION EXPRESSION OF A CONSTANT WHOSE TYPE MARK
+--      DENOTES AN UNCONSTRAINED ARRAY.
+
+-- EG  01/26/84
+
+WITH REPORT;
+
+PROCEDURE C43205D IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43205D", "CASE D : INITIALIZATION OF UNCONSTRAINED " &
+                     "ARRAY CONSTANT");
+
+     BEGIN
+
+CASE_D :  DECLARE
+
+               SUBTYPE STD IS INTEGER RANGE IDENT_INT(11) .. 13;
+               TYPE TD IS ARRAY (STD RANGE <>) OF INTEGER;
+
+               D1 : CONSTANT TD := (-1, -2, -3);
+
+          BEGIN
+
+               IF D1'FIRST /= 11 THEN
+                    FAILED ("CASE D : LOWER BOUND INCORRECTLY " &
+                            "GIVEN BY 'FIRST");
+               ELSIF D1'LAST /= 13 THEN
+                    FAILED ("CASE D : UPPER BOUND INCORRECTLY " &
+                            "GIVEN BY 'LAST");
+               ELSIF D1 /= (-1, -2, -3) THEN
+                    FAILED ("CASE D : ARRAY DOES NOT CONTAIN " &
+                            "THE CORRECT VALUES");
+               END IF;
+
+          END CASE_D;
+
+     END;
+
+     RESULT;
+
+END C43205D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205e.ada
new file mode 100644
index 000000000..d06f209ae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205e.ada
@@ -0,0 +1,117 @@
+-- C43205E.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 A POSITIONAL AGGREGATE ARE DETERMINED
+-- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+-- 'FIRST OF THE INDEX SUBTYPE WHEN THE POSITIONAL AGGREGATE IS USED AS:
+
+--   E) THE LEFT OR RIGHT OPERAND OF "&".
+
+-- EG  01/26/84
+
+WITH REPORT;
+
+PROCEDURE C43205E IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43205E", "CASE E : OPERAND OF &");
+
+     BEGIN
+
+CASE_E :  DECLARE
+
+               SUBTYPE STE IS INTEGER RANGE 2 .. 10;
+
+               TYPE COLOR IS (RED, GREEN, BLUE);
+               TYPE TE IS ARRAY (STE RANGE <>) OF COLOR;
+
+               FUNCTION CONCAT1 RETURN TE IS
+               BEGIN
+                    RETURN (RED, GREEN, BLUE) & (7 .. 8 => RED);
+               END;
+
+               FUNCTION CONCAT2 RETURN TE IS
+               BEGIN
+                    RETURN (IDENT_INT(4) .. 3 => RED) & (GREEN, BLUE);
+               END;
+
+               FUNCTION CONCAT3 RETURN STRING IS
+               BEGIN
+                    RETURN "TEST" & (7 .. 8 => 'X');
+               END;
+
+               FUNCTION CONCAT4 RETURN STRING IS
+               BEGIN
+                    RETURN (8 .. 5 => 'A') & "BC";
+               END;
+
+          BEGIN
+
+               IF CONCAT1'FIRST /= IDENT_INT(2) THEN
+                    FAILED ("CASE E1 : LOWER BOUND INCORRECTLY " &
+                            "GIVEN BY 'FIRST");
+               ELSIF CONCAT1'LAST /= 6 THEN
+                    FAILED ("CASE E1 : UPPER BOUND INCORRECTLY " &
+                            "GIVEN BY 'LAST");
+               ELSIF CONCAT1 /= (RED, GREEN, BLUE, RED, RED) THEN
+                    FAILED ("CASE E1 : INCORRECT VALUES PRODUCED");
+               END IF;
+               IF CONCAT2'FIRST /= IDENT_INT(2) THEN
+                    FAILED ("CASE E2 : LOWER BOUND INCORRECTLY " &
+                            "GIVEN BY 'FIRST");
+               ELSIF CONCAT2'LAST /= 3 THEN
+                    FAILED ("CASE E2 : UPPER BOUND INCORRECTLY " &
+                            "GIVEN BY 'LAST");
+               ELSIF CONCAT2 /= (GREEN, BLUE) THEN
+                    FAILED ("CASE E2 : INCORRECT VALUES PRODUCED");
+               END IF;
+               IF CONCAT3'FIRST /= IDENT_INT(1) THEN
+                    FAILED ("CASE E3 : LOWER BOUND INCORRECTLY " &
+                            "GIVEN BY 'FIRST");
+               ELSIF CONCAT3'LAST /= 6 THEN
+                    FAILED ("CASE E3 : UPPER BOUND INCORRECTLY " &
+                            "GIVEN BY 'LAST");
+               ELSIF CONCAT3 /= "TESTXX" THEN
+                    FAILED ("CASE E3 : INCORRECT VALUES PRODUCED");
+               END IF;
+               IF CONCAT4'FIRST /= IDENT_INT(1) THEN
+                    FAILED ("CASE E4 : LOWER BOUND INCORRECTLY " &
+                            "GIVEN BY 'FIRST");
+               ELSIF CONCAT4'LAST /= 2 THEN
+                    FAILED ("CASE E4 : UPPER BOUND INCORRECTLY " &
+                            "GIVEN BY 'LAST");
+               ELSIF CONCAT4 /= "BC" THEN
+                    FAILED ("CASE E4 : INCORRECT VALUES PRODUCED");
+               END IF;
+
+          END CASE_E;
+
+     END;
+
+     RESULT;
+
+END C43205E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205g.ada
new file mode 100644
index 000000000..54e0b743a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205g.ada
@@ -0,0 +1,105 @@
+-- C43205G.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 A POSITIONAL AGGREGATE ARE DETERMINED
+-- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+-- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
+-- POSITIONAL AGGREGATE IS USED AS:
+
+-- AN ACTUAL PARAMETER IN A SUBPROGRAM, AND THE
+-- FORMAL PARAMETER IS CONSTRAINED.
+
+-- EG  01/27/84
+
+WITH REPORT;
+
+PROCEDURE C43205G IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43205G", "SUBPROGRAM WITH CONSTRAINED " &
+                     "ONE-DIMENSIONAL ARRAY FORMAL PARAMETER");
+
+     BEGIN
+
+CASE_G :  BEGIN
+
+     CASE_G1 : DECLARE
+
+                    TYPE TA IS ARRAY (IDENT_INT(11) .. 15) OF INTEGER;
+
+                    PROCEDURE PROC1 (A : TA) IS
+                    BEGIN
+                         IF A'FIRST /= 11 THEN
+                              FAILED ("CASE A1 : LOWER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A'LAST /= 15 THEN
+                              FAILED ("CASE A1 : UPPER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A /= (6, 7, 8, 9, 10) THEN
+                              FAILED ("CASE A1 : ARRAY DOES NOT " &
+                                     "CONTAIN THE CORRECT VALUES");
+                         END IF;
+                    END;
+
+               BEGIN
+
+                    PROC1 ((6, 7, 8, IDENT_INT(9), 10));
+
+               END CASE_G1;
+
+     CASE_G2 : DECLARE
+
+                    TYPE TA IS ARRAY (11 .. 12, 
+                                      IDENT_INT(10) .. 11) OF INTEGER;
+
+                    PROCEDURE PROC1 (A : TA) IS
+                    BEGIN
+                         IF A'FIRST(1) /= 11 OR A'FIRST(2) /= 10 THEN
+                              FAILED ("CASE A2 : LOWER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A'LAST(1) /= 12 OR A'LAST(2) /= 11 THEN
+                              FAILED ("CASE A2 : UPPER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A /= ((1, 2), (3, 4)) THEN
+                              FAILED ("CASE A2 : ARRAY DOES NOT " &
+                                      "CONTAIN THE CORRECT VALUES");
+                         END IF;
+                    END;
+
+               BEGIN
+
+                    PROC1 (((1, 2), (3, 4)));
+
+               END CASE_G2;
+
+          END CASE_G;
+
+     END;
+
+     RESULT;
+
+END C43205G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205h.ada
new file mode 100644
index 000000000..9e4dc4ae0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205h.ada
@@ -0,0 +1,82 @@
+-- C43205H.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 A POSITIONAL AGGREGATE ARE DETERMINED
+-- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+-- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
+-- POSITIONAL AGGREGATE IS USED AS:
+
+-- AN ACTUAL PARAMETER IN A GENERIC INSTANTIATION, AND THE FORMAL
+-- PARAMETER IS CONSTRAINED.
+
+-- EG  01/27/84
+
+WITH REPORT;
+
+PROCEDURE C43205H IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43205H", "CONSTRAINED ARRAY FORMAL GENERIC " &
+                     "PARAMETER");
+
+     BEGIN
+
+CASE_H :  DECLARE
+
+               SUBTYPE STH IS INTEGER RANGE -10 .. 0;
+               TYPE BASE IS ARRAY(STH RANGE <>) OF INTEGER;
+               SUBTYPE TB IS BASE(IDENT_INT(-8) .. -5);
+
+               GENERIC
+                    B1 : TB;
+               PROCEDURE PROC1;
+
+               PROCEDURE PROC1 IS
+               BEGIN
+                    IF B1'FIRST /= -8 THEN
+                         FAILED ("CASE B : LOWER BOUND INCORRECT");
+                    ELSIF B1'LAST /= -5 THEN
+                         FAILED ("CASE B : UPPER BOUND INCORRECT");
+                    ELSIF B1 /= (7, 6, 5, 4) THEN
+                         FAILED ("CASE B : ARRAY DOES NOT " &
+                                 "CONTAIN THE CORRECT VALUES");
+                    END IF;
+               END;
+
+               PROCEDURE PROC2 IS NEW PROC1 ((7, 6, 5, 4));
+
+          BEGIN
+
+               PROC2;
+
+          END CASE_H;
+
+     END;
+
+     RESULT;
+
+END C43205H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205i.ada
new file mode 100644
index 000000000..44c255766
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205i.ada
@@ -0,0 +1,83 @@
+-- C43205I.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 A POSITIONAL AGGREGATE ARE DETERMINED
+-- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+-- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
+-- POSITIONAL AGGREGATE IS USED AS:
+
+-- THE RETURN EXPRESSION IN A FUNCTION WHOSE RETURN TYPE IS
+-- CONSTRAINED.
+
+-- EG  01/27/84
+
+WITH REPORT;
+
+PROCEDURE C43205I IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43205I", "CONSTRAINED FUNCTION RESULT TYPE");
+
+     BEGIN
+
+CASE_I :  DECLARE
+
+               SUBTYPE STC IS INTEGER RANGE -2 .. 10;
+               TYPE BASE IS ARRAY(STC RANGE <>, STC RANGE <>)OF INTEGER;
+               SUBTYPE TC IS BASE(IDENT_INT(-1) .. 0, 7 .. 9);
+
+               FUNCTION FUN1 (A : INTEGER) RETURN TC IS
+               BEGIN
+                    RETURN ((5, 4, 3), (2, 1, 0));
+               END;
+
+          BEGIN
+
+               IF FUN1(5)'FIRST(1) /= -1 THEN
+                    FAILED ("CASE I : LOWER BOUND INCORRECT " &
+                            "FOR 'FIRST(1)");
+               ELSIF FUN1(5)'FIRST(2) /= 7 THEN
+                    FAILED ("CASE I : LOWER BOUND INCORRECT " &
+                            "FOR 'FIRST(2)");
+               ELSIF FUN1(5)'LAST(1) /= 0 THEN
+                    FAILED ("CASE I : UPPER BOUND INCORRECT " &
+                            "FOR 'LAST(1)");
+               ELSIF FUN1(5)'LAST(2) /= 9 THEN
+                    FAILED ("CASE I : UPPER BOUND INCORRECT " &
+                            "FOR 'LAST(2)");
+               ELSIF FUN1(5) /= ((5, 4, 3), (2, 1, 0)) THEN
+                    FAILED ("CASE I : FUNCTION DOES NOT " &
+                            "RETURN THE CORRECT VALUES");
+               END IF;
+
+          END CASE_I;
+
+     END;
+
+     RESULT;
+
+END C43205I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205j.ada
new file mode 100644
index 000000000..946e074dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205j.ada
@@ -0,0 +1,146 @@
+-- C43205J.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 A POSITIONAL AGGREGATE ARE DETERMINED
+-- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+-- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
+-- POSITIONAL AGGREGATE IS USED AS:
+
+--   J) THE INITIALIZATION EXPRESSION OF A CONSTANT, VARIABLE, OR FORMAL
+--      PARAMETER (OF A SUBPROGRAM, ENTRY, OR GENERIC UNIT) WHEN THE
+--      TYPE OF THE CONSTANT, VARIABLE, OR PARAMETER IS CONSTRAINED.
+
+-- EG  01/27/84
+
+WITH REPORT;
+
+PROCEDURE C43205J IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43205J", "CASE J : INITIALIZATION OF CONSTRAINED " &
+                     "ARRAY");
+
+     BEGIN
+
+CASE_J :  BEGIN
+
+     CASE_J1 : DECLARE
+
+                    TYPE TD1 IS ARRAY (IDENT_INT(11) .. 13) OF INTEGER;
+
+                    D1 : CONSTANT TD1 := (-1, -2, -3);
+
+               BEGIN
+
+                    IF D1'FIRST /= 11 THEN
+                         FAILED ("CASE J1 : LOWER BOUND INCORRECT");
+                    ELSIF D1'LAST /= 13 THEN
+                         FAILED ("CASE J1 : UPPER BOUND INCORRECT");
+                    ELSIF D1 /= (-1, -2, -3) THEN
+                              FAILED ("CASE J1 : ARRAY DOES NOT " &
+                                      "CONTAINING THE CORRECT VALUES");
+                    END IF;
+
+               END CASE_J1;
+
+     CASE_J2 : DECLARE
+
+                    TYPE TD2 IS ARRAY(INTEGER RANGE -13 .. -11)
+                                                            OF INTEGER;
+                    D2 : TD2 := (3, 2, 1);
+
+               BEGIN
+
+                    IF D2'FIRST /= -13 THEN
+                         FAILED ("CASE J2 : LOWER BOUND INCORRECT");
+                    ELSIF D2'LAST /= -11 THEN
+                         FAILED ("CASE J2 : UPPER BOUND INCORRECT");
+                    ELSIF D2 /= (3, 2, 1) THEN
+                         FAILED ("CASE J2 : INCORRECT VALUES");
+                    END IF;
+
+               END CASE_J2;
+
+     CASE_J3 : DECLARE
+
+                    TYPE TD3 IS ARRAY(IDENT_INT(5) .. 7) OF INTEGER;
+
+                    PROCEDURE PROC1 (A : TD3 := (2, 3, 4)) IS
+                    BEGIN
+                         IF A'FIRST /= 5 THEN
+                              FAILED ("CASE J3 : LOWER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A'LAST /= 7 THEN
+                              FAILED ("CASE J3 : UPPER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A /= (2, 3, 4) THEN
+                              FAILED ("CASE J3 : INCORRECT VALUES");
+                         END IF;
+                    END PROC1;
+
+               BEGIN
+
+               PROC1;
+
+               END CASE_J3;
+
+     CASE_J4 : DECLARE
+
+                    TYPE TD4 IS ARRAY(5 .. 8) OF INTEGER;
+
+                    GENERIC
+                         D4 : TD4 := (1, -2, 3, -4);
+                    PROCEDURE PROC1;
+
+                    PROCEDURE PROC1 IS
+                    BEGIN
+                         IF D4'FIRST /= 5 THEN
+                              FAILED ("CASE J4 : LOWER BOUND " &
+                                      "INCORRECT");
+                         ELSIF D4'LAST /= 8 THEN
+                              FAILED ("CASE J4 : UPPER BOUND " &
+                                      "INCORRECT");
+                         ELSIF D4 /= (1, -2, 3, -4) THEN
+                              FAILED ("CASE J4 : INCORRECT VALUES");
+                         END IF;
+                    END PROC1;
+
+                    PROCEDURE PROC2 IS NEW PROC1;
+
+               BEGIN
+
+                    PROC2;
+
+               END CASE_J4;
+
+          END CASE_J;
+
+     END;
+
+     RESULT;
+
+END C43205J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205k.ada
new file mode 100644
index 000000000..a3a712a44
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43205k.ada
@@ -0,0 +1,110 @@
+-- C43205K.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 A POSITIONAL AGGREGATE ARE DETERMINED
+-- CORRECTLY. IN PARTICULAR, CHECK THAT THE LOWER BOUND IS GIVEN BY
+-- THE LOWER BOUND OF THE APPLICABLE INDEX CONSTRAINT WHEN THE
+-- POSITIONAL AGGREGATE IS USED AS:
+
+-- THE EXPRESSION OF AN ENCLOSING RECORD OR ARRAY AGGREGATE, AND
+-- THE EXPRESSION GIVES THE VALUE OF A RECORD OR ARRAY COMPONENT
+-- (WHICH IS NECESSARILY CONSTRAINED).
+
+-- EG  01/27/84
+-- JBG 3/30/84
+
+WITH REPORT;
+
+PROCEDURE C43205K IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43205K", "THE EXPRESSION OF AN ENCLOSING RECORD " &
+                     "OR ARRAY AGGREGATE, AND THE EXPRESSION GIVES "   &
+                     "THE VALUE OF A RECORD OR ARRAY COMPONENT");
+
+     BEGIN
+
+CASE_K :  BEGIN
+
+     CASE_K1 : DECLARE
+
+                    SUBTYPE SK1 IS INTEGER RANGE 2 .. 6;
+                    TYPE BASE IS ARRAY(SK1 RANGE <>) OF INTEGER;
+                    SUBTYPE TE1 IS BASE(IDENT_INT(3) .. 5);
+                    TYPE TE2 IS ARRAY(1 .. 2) OF TE1;
+
+                    E1 : TE2;
+
+               BEGIN
+
+                    E1 := (1 .. 2 => (3, 2, 1));
+                    IF (E1'FIRST /= 1 OR E1'LAST /= 2) OR ELSE
+                       (E1(1)'FIRST /= 3 OR E1(1)'LAST /= 5 OR
+                        E1(2)'FIRST /= 3 OR E1(2)'LAST /= 5) THEN
+                         FAILED ("CASE K1 : INCORRECT BOUNDS");
+                    ELSE
+                         IF E1 /= (1 .. 2 => (3, 2, 1)) THEN
+                              FAILED ("CASE K1 : ARRAY DOES NOT " &
+                                      "CONTAIN THE CORRECT VALUES");
+                         END IF;
+                    END IF;
+
+               END CASE_K1;
+
+     CASE_K2 : DECLARE
+
+                    TYPE SK2 IS RANGE 2 .. 6;
+                    TYPE BASE IS ARRAY(SK2 RANGE <>) OF INTEGER;
+                    SUBTYPE TE1 IS BASE(3 .. 5);
+                    TYPE TER IS
+                         RECORD
+                              REC : TE1;
+                         END RECORD;
+
+                    E2 : TER;
+
+               BEGIN
+
+                    E2 := (REC => (3, 2, 1));
+                    IF E2.REC'FIRST /= 3 OR E2.REC'LAST /= 5 THEN
+                         FAILED ("CASE K2 : INCORRECT BOUNDS");
+                    ELSE
+                         IF E2.REC /= (3, 2, 1) THEN
+                              FAILED ("CASE K2 : ARRAY DOES NOT " &
+                                      "CONTAIN CORRECT VALUES");
+                         END IF;
+                    END IF;
+
+               END CASE_K2;
+
+          END CASE_K;
+
+     END;
+
+     RESULT;
+
+END C43205K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43206a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43206a.ada
new file mode 100644
index 000000000..af738920e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43206a.ada
@@ -0,0 +1,242 @@
+-- C43206A.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 A NULL ARRAY AGGREGATE ARE DETERMINED
+-- BY THE BOUNDS SPECIFIED BY THE CHOICES. IN PARTICULAR, CHECK
+-- THAT:
+
+--   A) THE UPPER BOUND IS NOT REQUIRED TO BE THE PREDECESSOR OF
+--      THE LOWER BOUND.
+
+--   B) NEITHER THE UPPER NOR THE LOWER BOUND NEED BELONG TO THE
+--      INDEX SUBTYPE FOR NULL RANGES.
+
+--   C) IF ONE CHOICE OF A MULTIDIMENSIONAL AGGREGATE IS NON-NULL
+--      BUT THE AGGREGATE IS A NULL ARRAY, CONSTRAINT_ERROR IS 
+--      RAISED WHEN THE NON-NULL CHOICES DO NOT BELONG TO THE
+--      INDEX SUBTYPE.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- EG  02/02/84
+-- JBG 12/6/84
+-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT;
+
+PROCEDURE C43206A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43206A", "CHECK THAT THE BOUNDS OF A NULL ARRAY ARE " &
+                     "DETERMINED BY THE BOUNDS SPECIFIED BY THE " &
+                     "CHOICES");
+
+     DECLARE
+
+          SUBTYPE ST1 IS INTEGER RANGE 10 .. 15;
+          SUBTYPE ST2 IS INTEGER RANGE 1 .. 5;
+
+          TYPE T1 IS ARRAY (ST1 RANGE <>) OF INTEGER;
+          TYPE T2 IS ARRAY (ST2 RANGE <>, ST1 RANGE <>) OF INTEGER;
+
+     BEGIN
+
+CASE_A :  BEGIN
+
+     CASE_A1 : DECLARE
+
+                    PROCEDURE PROC1 (A : T1) IS
+                    BEGIN
+                         IF A'FIRST /= 12 OR A'LAST /= 10 THEN
+                              FAILED ("CASE A1 : INCORRECT BOUNDS");
+                         END IF;
+                    END PROC1;
+
+               BEGIN
+
+                    PROC1((12 .. 10 => -2));
+
+               EXCEPTION
+
+                    WHEN OTHERS =>
+                         FAILED ("CASE A1 : EXCEPTION RAISED");
+
+               END CASE_A1;
+
+     CASE_A2 : DECLARE
+
+                    PROCEDURE PROC1 (A : STRING) IS
+                    BEGIN
+                         IF A'FIRST /= 5 OR A'LAST /= 2 THEN
+                              FAILED ("CASE A2 : INCORRECT BOUNDS");
+                         END IF;
+                    END PROC1;
+
+               BEGIN
+
+                    PROC1 ((5 .. 2 => 'E'));
+
+               EXCEPTION
+
+                    WHEN OTHERS =>
+                         FAILED ("CASE A2 : EXCEPTION RAISED");
+
+               END CASE_A2;
+
+          END CASE_A;
+
+CASE_B :  BEGIN
+
+     CASE_B1 : DECLARE
+
+                    PROCEDURE PROC1 (A : T1; L, U : INTEGER) IS
+                    BEGIN
+                         IF A'FIRST /= L OR A'LAST /= U THEN
+                              FAILED ("CASE B1 : INCORRECT BOUNDS");
+                         END IF;
+                    END PROC1;
+
+               BEGIN
+
+                    BEGIN
+
+                         PROC1 ((5 .. INTEGER'FIRST => -2),
+                                 5, INTEGER'FIRST);
+
+                    EXCEPTION
+
+                         WHEN CONSTRAINT_ERROR =>
+                              FAILED ("CASE B1A : CONSTRAINT_ERROR " &
+                                      "RAISED FOR NULL RANGE");
+                         WHEN OTHERS =>
+                              FAILED ("CASE B1A : EXCEPTION RAISED");
+
+                    END;
+
+                    BEGIN
+
+                         PROC1 ((IDENT_INT(6) .. 3 => -2),6,3);
+
+                    EXCEPTION
+
+                         WHEN OTHERS =>
+                              FAILED ("CASE B1B : EXCEPTION RAISED");
+
+                    END;
+
+               END CASE_B1;
+
+     CASE_B2 : DECLARE
+
+                    PROCEDURE PROC1 (A : STRING) IS
+                    BEGIN
+                         IF A'FIRST /= 1 OR 
+                            A'LAST /= INTEGER'FIRST THEN
+                              FAILED ("CASE B2 : INCORRECT BOUNDS");
+                         END IF;
+                    END PROC1;
+
+               BEGIN
+
+                    PROC1 ((1 .. INTEGER'FIRST => ' '));
+
+               EXCEPTION
+
+                    WHEN OTHERS =>
+                         FAILED ("CASE B2 : EXCEPTION RAISED");
+
+               END CASE_B2;
+
+          END CASE_B;
+
+CASE_C :  BEGIN
+
+     CASE_C1 : DECLARE
+
+                    PROCEDURE PROC1 (A : T2) IS
+                    BEGIN
+                         IF A'FIRST(1) /=  5 OR A'LAST(1) /=  3 OR
+                            A'FIRST(2) /= INTEGER'LAST-1 OR
+                            A'LAST(2)  /= INTEGER'LAST THEN
+                              FAILED ("CASE C1 : INCORRECT BOUNDS");
+                         END IF;
+                    END PROC1;
+
+               BEGIN
+
+                    PROC1 ((5 .. 3 => 
+                              (IDENT_INT(INTEGER'LAST-1) ..
+                               IDENT_INT(INTEGER'LAST) => -2)));
+                    FAILED ("CASE C1 : CONSTRAINT_ERROR NOT RAISED");
+
+               EXCEPTION
+
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+
+                    WHEN OTHERS =>
+                         FAILED ("CASE C1 : EXCEPTION RAISED");
+
+               END CASE_C1;
+
+     CASE_C2 : DECLARE
+
+                    PROCEDURE PROC1 (A : T2) IS
+                    BEGIN
+                         IF A'FIRST(1) /=  INTEGER'FIRST OR
+                            A'LAST(1)  /=  INTEGER'FIRST+1 OR
+                            A'FIRST(2) /= 14 OR A'LAST(2) /= 11 THEN
+                              FAILED ("CASE C2 : INCORRECT BOUNDS");
+                         END IF;
+                    END PROC1;
+
+               BEGIN
+
+                    PROC1 ((IDENT_INT(INTEGER'FIRST) ..
+                            IDENT_INT(INTEGER'FIRST+1) =>
+                                    (14 .. IDENT_INT(11) => -2)));
+                    FAILED ("CASE C2 : CONSTRAINT_ERROR NOT RAISED");
+
+               EXCEPTION
+
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+
+                    WHEN OTHERS =>
+                         FAILED ("CASE C2 : EXCEPTION RAISED");
+
+               END CASE_C2;
+
+          END CASE_C;
+
+     END;
+
+     RESULT;
+
+END C43206A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43207b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43207b.ada
new file mode 100644
index 000000000..197a9155e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43207b.ada
@@ -0,0 +1,149 @@
+-- C43207B.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 A MULTIDIMENSIONAL AGGREGATE OF THE FORM (F..G => (H..I => J)),
+-- CHECK THAT:
+
+--     B) IF H..I IS A NULL RANGE, CONSTRAINT_ERROR IS RAISED IF
+--        F..G IS NON-NULL AND F OR G DO NOT BELONG TO THE INDEX
+--        SUBTYPE;
+
+-- EG  01/18/84
+-- BHS  7/13/84
+-- JBG 12/6/84
+
+WITH REPORT;
+
+PROCEDURE C43207B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43207B", "CHECK THAT THE EVALUATION OF A MULTI" &
+                     "DIMENSIONAL AGGREGATE OF THE FORM "   &
+                     "(F..G => (H..I = J)) IS PERFORMED "   &
+                     "CORRECTLY");
+
+     DECLARE
+
+          TYPE CHOICE_INDEX IS (F, G, H, I, J);
+          TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
+
+          CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
+
+          SUBTYPE SINT IS INTEGER RANGE 1 .. 8;
+          TYPE T0 IS ARRAY(SINT RANGE <>, SINT RANGE <>) OF INTEGER;
+   
+          FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
+                         RETURN INTEGER IS
+          BEGIN
+               CNTR(A) := CNTR(A) + 1;
+               RETURN IDENT_INT(B);
+          END CALC;
+
+     BEGIN
+
+CASE_B :  DECLARE
+               PROCEDURE CHECK (A : T0; M : STRING) IS
+               BEGIN
+                    IF (A'FIRST(1) /= 1) OR (A'LAST(1) /= 9) OR
+                       (A'FIRST(2) /= 6) OR (A'LAST(2) /= 5) THEN
+                         FAILED("CASE B" & M & " : ARRAY NOT " &
+                                "BOUNDED CORRECTLY");
+                    END IF;
+               END CHECK;
+          BEGIN
+
+     CASE_B1 : BEGIN
+                    CHECK ((1 .. 9 => (6 .. 5 => 2)),"1");
+                    FAILED ("CASE B1 : CONSTRAINT_ERROR NOT RAISED");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("CASE B1 : EXCEPTION RAISED");
+               END CASE_B1;
+
+     CASE_B2 : BEGIN
+                    CHECK ((CALC(F,1) .. CALC(G,9) => (6 .. 5 => 2)),
+                           "2");
+                    FAILED ("CASE B2 : CONSTRAINT_ERROR NOT RAISED");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("CASE B2 : EXCEPTION RAISED");
+               END CASE_B2;
+
+     CASE_B3 : BEGIN
+                    CHECK ((1 .. 9 => (CALC(H,6) .. CALC(I,5) => 2)),
+                           "3");
+                    FAILED ("CASE B3 : CONSTRAINT_ERROR NOT RAISED");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("CASE B3 : EXCEPTION RAISED");
+               END CASE_B3;
+
+          END CASE_B;
+
+     IF CNTR(F) /= 1 THEN
+          FAILED ("CASE B2 : F WAS NOT EVALUATED " &
+                  "ONCE.  F WAS EVALUATED"         & 
+                  INTEGER'IMAGE(CNTR(F)) & " TIMES");
+     END IF;
+     IF CNTR(G) /= 1 THEN
+          FAILED ("CASE B2 : G WAS NOT EVALUATED " &
+                  "ONCE.  G WAS EVALUATED"         &
+                  INTEGER'IMAGE(CNTR(G)) & " TIMES");
+     END IF;
+
+     IF CNTR(H) /= 0 AND CNTR(I) /= 0 THEN
+          COMMENT ("CASE B3 : ALL CHOICES " &
+                   "EVALUATED BEFORE CHECKING " &
+                   "INDEX SUBTYPE");
+     ELSIF CNTR(H) = 0 AND CNTR(I) = 0 THEN
+          COMMENT ("CASE B3 : SUBTYPE CHECKS "&
+                   "MADE AS CHOICES ARE EVALUATED");
+     END IF;
+                              
+     IF CNTR(H) > 1 THEN
+          FAILED("CASE B3 : H WAS NOT EVALUATED " &
+                 "AT MOST ONCE. H WAS EVALUATED" &
+                 INTEGER'IMAGE(CNTR(H)) & " TIMES");
+     END IF;
+
+     IF CNTR(I) > 1 THEN
+          FAILED("CASE B3 : I WAS NOT EVALUATED " &
+                 "AT MOST ONCE. I WAS EVALUATED" &
+                 INTEGER'IMAGE(CNTR(I)) & " TIMES");
+     END IF;
+
+     END;
+
+     RESULT;
+
+END C43207B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43207d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43207d.ada
new file mode 100644
index 000000000..5733ec8fa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43207d.ada
@@ -0,0 +1,135 @@
+-- C43207D.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 A MULTIDIMENSIONAL AGGREGATE OF THE FORM (F..G => (H..I => J)),
+-- CHECK THAT:
+
+--     D) J IS EVALUATED ONCE FOR EACH COMPONENT (ZERO TIMES IF THE
+--        ARRAY IS NULL).
+
+-- EG  01/18/84
+
+WITH REPORT;
+
+PROCEDURE C43207D IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43207D", "CHECK THAT THE EVALUATION OF A MULTI" &
+                     "DIMENSIONAL AGGREGATE OF THE FORM "   &
+                     "(F..G => (H..I = J)) IS PERFORMED "   &
+                     "CORRECTLY");
+
+     DECLARE
+
+          TYPE CHOICE_INDEX IS (F, G, H, I, J);
+          TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
+
+          CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
+
+          SUBTYPE SINT IS INTEGER RANGE 1 .. 8;
+          TYPE T0 IS ARRAY(SINT RANGE <>, SINT RANGE <>) OF INTEGER;
+   
+          FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
+                         RETURN INTEGER IS
+          BEGIN
+               CNTR(A) := CNTR(A) + 1;
+               RETURN IDENT_INT(B);
+          END CALC;
+
+     BEGIN
+
+CASE_D :  BEGIN
+
+     CASE_D1 : DECLARE
+                    D1 : T0(8 .. 4, 5 .. 1);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    D1 := (8 .. 4 => (5 .. 1 => CALC(J,2)));
+                    IF CNTR(J) /= 0 THEN
+                         FAILED("CASE D1 : INCORRECT NUMBER " &
+                                "OF EVALUATIONS. J EVALUATED" &
+                                INTEGER'IMAGE(CNTR(J)) & " TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE D1 : EXCEPTION RAISED");
+               END CASE_D1;
+
+     CASE_D2 : DECLARE
+                    D2 : T0(8 .. 4, 5 .. 1);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    D2 := (CALC(F,8) .. CALC(G,4) =>
+                              (CALC(H,5) .. CALC(I,1) => CALC(J,2)));
+                    IF CNTR(J) /= 0 THEN
+                         FAILED("CASE D2 : INCORRECT NUMBER " &
+                                "OF EVALUATIONS. J EVALUATED" &
+                                INTEGER'IMAGE(CNTR(J)) & " TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE D2 : EXCEPTION RAISED");
+               END CASE_D2;
+
+     CASE_D3 : DECLARE
+                    D3 : T0(3 .. 5, 1 .. 2);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    D3 := (3 .. 5 => (1 .. 2 => CALC(J,2)));
+                    IF CNTR(J) /= 6 THEN
+                         FAILED("CASE D3 : INCORRECT NUMBER " &
+                                "OF EVALUATIONS. J EVALUATED" &
+                                INTEGER'IMAGE(CNTR(J)) & " TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE D3 : EXCEPTION RAISED");
+               END CASE_D3;
+
+     CASE_D4 : DECLARE
+                    D4 : T0(1 .. 2, 5 .. 7);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    D4 := (CALC(F,1) .. CALC(G,2) =>
+                              (CALC(H,5) .. CALC(I,7) => CALC(J,2)));
+                    IF CNTR(J) /= 6 THEN
+                         FAILED("CASE D4 : INCORRECT NUMBER " &
+                                "OF EVALUATIONS. J EVALUATED" &
+                                INTEGER'IMAGE(CNTR(J)) & " TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE D4 : EXCEPTION RAISED");
+               END CASE_D4;
+
+          END CASE_D;
+
+     END;
+
+     RESULT;
+
+END C43207D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43208a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43208a.ada
new file mode 100644
index 000000000..c04a395ea
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43208a.ada
@@ -0,0 +1,208 @@
+-- C43208A.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 A ONE-DIMENSIONAL AGGREGATE OF THE FORM (F..G => (H..I => J)),
+-- CHECK THAT:
+
+--     A) IF F..G IS A NULL RANGE, H, I, AND J ARE NOT EVALUATED.
+
+--     B) IF F..G IS A NON-NULL RANGE, H AND I ARE EVALUATED G-F+1
+--        TIMES, AND J IS EVALUATED (I-H+1)*(G-F+1) TIMES IF H..I
+--        IS NON-NULL.
+
+-- EG  01/19/84
+
+WITH REPORT;
+
+PROCEDURE C43208A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43208A", "CHECK THAT THE EVALUATION OF A ONE-" &
+                     "DIMENSIONAL AGGREGATE OF THE FORM "  &
+                     "(F..G => (H..I = J)) IS PERFORMED "  &
+                     "CORRECTLY");
+
+     DECLARE
+
+          TYPE CHOICE_INDEX IS (F, G, H, I, J);
+          TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
+
+          CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
+
+          TYPE T1 IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+   
+          FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
+                         RETURN INTEGER IS
+          BEGIN
+               CNTR(A) := CNTR(A) + 1;
+               RETURN IDENT_INT(B);
+          END CALC;
+
+     BEGIN
+
+CASE_A :  BEGIN
+
+     CASE_A1 : DECLARE
+                    A1 : ARRAY(4 .. 2) OF T1(1 .. 2);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    A1 := (4 .. 2 => 
+                              (CALC(H,1) .. CALC(I,2) => CALC(J,2)));
+                    IF CNTR(H) /= 0 THEN
+                         FAILED("CASE A1 : H WAS EVALUATED");
+                    END IF;
+                    IF CNTR(I) /= 0 THEN
+                         FAILED("CASE A1 : I WAS EVALUATED");
+                    END IF;
+                    IF CNTR(J) /= 0 THEN
+                         FAILED("CASE A1 : J WAS EVALUATED");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE A1 : EXCEPTION RAISED");
+               END CASE_A1;
+
+     CASE_A2 : DECLARE
+                    A2 : ARRAY(4 .. 2) OF T1(1 .. 2);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    A2 := (CALC(F,4) .. CALC(G,2) =>
+                               (CALC(H,1) .. CALC(I,2) => CALC(J,2)));
+                    IF CNTR(H) /= 0 THEN
+                         FAILED("CASE A2 : H WAS EVALUATED");
+                    END IF;
+                    IF CNTR(I) /= 0 THEN
+                         FAILED("CASE A2 : I WAS EVALUATED");
+                    END IF;
+                    IF CNTR(J) /= 0 THEN
+                         FAILED("CASE A2 : J WAS EVALUATED");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE A2 : EXCEPTION RAISED");
+               END CASE_A2;
+
+          END CASE_A;
+
+CASE_B :  BEGIN
+
+     CASE_B1 : DECLARE
+                    B1 : ARRAY(2 .. 3) OF T1(1 .. 2);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    B1 := (2 .. 3 =>
+                              (CALC(H,1) .. CALC(I,2) => CALC(J,2)));
+                    IF CNTR(H) /= 2 THEN
+                         FAILED("CASE B1 : H NOT EVALUATED G-F+1 " &
+                                "TIMES");
+                    END IF;
+                    IF CNTR(I) /= 2 THEN
+                         FAILED("CASE B1 : I NOT EVALUATED G-F+1 " &
+                                "TIMES");
+                    END IF;
+                    IF CNTR(J) /= 4 THEN
+                         FAILED("CASE B1 : J NOT EVALUATED (I-H+1)*" &
+                                "(G-F+1) TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE B1 : EXECEPTION RAISED");
+               END CASE_B1;
+
+     CASE_B2 : DECLARE
+                    B2 : ARRAY(2 .. 3) OF T1(9 .. 10);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    B2 := (CALC(F,2) .. CALC(G,3) =>
+                              (CALC(H,9) .. CALC(I,10) => CALC(J,2)));
+                    IF CNTR(H) /= 2 THEN
+                         FAILED("CASE B2 : H NOT EVALUATED G-F+1 " &
+                                "TIMES");
+                    END IF;
+                    IF CNTR(I) /= 2 THEN
+                         FAILED("CASE B2 : I NOT EVALUATED G-F+1 " &
+                                "TIMES");
+                    END IF;
+                    IF CNTR(J) /= 4 THEN
+                         FAILED("CASE B2 : J NOT EVALUATED (I-H+1)*" &
+                                "(G-F+1) TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE B2 : EXECEPTION RAISED");
+               END CASE_B2;
+
+     CASE_B3 : DECLARE
+                    B3 : ARRAY(2 .. 3) OF T1(2 .. 1);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    B3 := (2 .. 3 =>
+                              (CALC(H,2) .. CALC(I,1) => CALC(J,2)));
+                    IF CNTR(H) /= 2 THEN
+                         FAILED("CASE B3 : H NOT EVALUATED G-F+1 " &
+                                "TIMES");
+                    END IF;
+                    IF CNTR(I) /= 2 THEN
+                         FAILED("CASE B3 : I NOT EVALUATED G-F+1 " &
+                                "TIMES");
+                    END IF;
+                    IF CNTR(J) /= 0 THEN
+                         FAILED("CASE B3 : J NOT EVALUATED ZERO TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE B3 : EXECEPTION RAISED");
+               END CASE_B3;
+
+     CASE_B4 : DECLARE
+                    B4 : ARRAY(2 .. 3) OF T1(2 .. 1);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    B4 := (CALC(F,2) .. CALC(G,3) =>
+                              (CALC(H,2) .. CALC(I,1) => CALC(J,2)));
+                    IF CNTR(H) /= 2 THEN
+                         FAILED("CASE B4 : H NOT EVALUATED G-F+1 " &
+                                "TIMES");
+                    END IF;
+                    IF CNTR(I) /= 2 THEN
+                         FAILED("CASE B4 : I NOT EVALUATED G-F+1 " &
+                                "TIMES");
+                    END IF;
+                    IF CNTR(J) /= 0 THEN
+                         FAILED("CASE B4 : J NOT EVALUATED ZERO TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE B4 : EXECEPTION RAISED");
+               END CASE_B4;
+
+          END CASE_B;
+      END;
+
+     RESULT;
+
+END C43208A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43208b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43208b.ada
new file mode 100644
index 000000000..de5ac5fd1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43208b.ada
@@ -0,0 +1,266 @@
+-- C43208B.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 AN AGGREGATE OF THE FORM:
+--        (B..C => (D..E => (F..G => (H..I => J))))
+-- WHOSE TYPE IS A TWO-DIMENSIONAL ARRAY TYPE THAT HAS A TWO-
+-- DIMENSIONAL ARRAY COMPONENT TYPE, CHECK THAT:
+
+--     A) IF B..C OR D..E IS A NULL RANGE, THEN F, G, H, I, AND J
+--        ARE NOT EVALUATED.
+
+--     B) IF B..C AND D..E ARE NON-NULL RANGES, THEN F, G, H AND I
+--        ARE EVALUATED (C-B+1)*(E-D+1) TIMES, AND J IS EVALUATED
+--        (C-B+1)*(E-D+1)*(G-F+1)*(I-H+1) TIMES IF F..G AND H..I
+--        ARE NON-NULL.
+
+-- EG  01/19/84
+
+WITH REPORT;
+
+PROCEDURE C43208B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43208B", "CHECK THAT THE EVALUATION OF A MULTI" &
+                     "DIMENSIONAL ARRAY TYPE THAT HAS AN "  &
+                     "ARRAY COMPONENT TYPE IS PERFORMED "   &
+                     "CORRECTLY");
+
+     DECLARE
+
+          TYPE CHOICE_INDEX IS (B, C, D, E, F, G, H, I, J);
+          TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
+
+          CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
+
+          TYPE T1 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
+                          OF INTEGER;
+   
+          FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
+                         RETURN INTEGER IS
+          BEGIN
+               CNTR(A) := CNTR(A) + 1;
+               RETURN IDENT_INT(B);
+          END CALC;
+
+     BEGIN
+
+CASE_A :  BEGIN
+
+     CASE_A1 : DECLARE
+                    A1 : ARRAY(4 .. 3, 3 .. 4) OF T1(2 .. 3, 1 .. 2);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    A1 := (4 .. 3 => (3 .. 4 => 
+                            (CALC(F,2) .. CALC(G,3) =>
+                              (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
+                    IF CNTR(F) /= 0 THEN
+                         FAILED("CASE A1 : F WAS EVALUATED");
+                    END IF;
+                    IF CNTR(G) /= 0 THEN
+                         FAILED("CASE A1 : G WAS EVALUATED");
+                    END IF;
+                    IF CNTR(H) /= 0 THEN
+                         FAILED("CASE A1 : H WAS EVALUATED");
+                    END IF;
+                    IF CNTR(I) /= 0 THEN
+                         FAILED("CASE A1 : I WAS EVALUATED");
+                    END IF;
+                    IF CNTR(J) /= 0 THEN
+                         FAILED("CASE A1 : J WAS EVALUATED");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE A1 : EXCEPTION RAISED");
+               END CASE_A1;
+
+     CASE_A2 : DECLARE
+                    A2 : ARRAY(3 .. 4, 4 .. 3) OF T1(2 .. 3, 1 .. 2);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    A2 := (CALC(B,3) .. CALC(C,4) =>
+                           (CALC(D,4) .. CALC(E,3) =>
+                            (CALC(F,2) .. CALC(G,3) =>
+                             (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
+                    IF CNTR(F) /= 0 THEN
+                         FAILED("CASE A2 : F WAS EVALUATED");
+                    END IF;
+                    IF CNTR(G) /= 0 THEN
+                         FAILED("CASE A2 : G WAS EVALUATED");
+                    END IF;
+                    IF CNTR(H) /= 0 THEN
+                         FAILED("CASE A2 : H WAS EVALUATED");
+                    END IF;
+                    IF CNTR(I) /= 0 THEN
+                         FAILED("CASE A2 : I WAS EVALUATED");
+                    END IF;
+                    IF CNTR(J) /= 0 THEN
+                         FAILED("CASE A2 : J WAS EVALUATED");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE A2 : EXCEPTION RAISED");
+               END CASE_A2;
+
+          END CASE_A;
+
+CASE_B :  BEGIN
+
+     CASE_B1 : DECLARE
+                    B1 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 9 .. 10);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    B1 := (2 .. 3 => (1 .. 2 =>
+                            (CALC(F,1) .. CALC(G,2) =>
+                              (CALC(H,9) .. CALC(I,10) => CALC(J,2)))));
+                    IF CNTR(F) /= 4 THEN
+                         FAILED("CASE B1 : F NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(G) /= 4 THEN
+                         FAILED("CASE B1 : G NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(H) /= 4 THEN
+                         FAILED("CASE B1 : H NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(I) /= 4 THEN
+                         FAILED("CASE B1 : I NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(J) /= 16 THEN
+                         FAILED("CASE B1 : J NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1)*(G-F+1)*(I-H+1) TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE B1 : EXECEPTION RAISED");
+               END CASE_B1;
+
+     CASE_B2 : DECLARE
+                    B2 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 9 .. 10);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    B2 := (CALC(B,2) .. CALC(C,3) =>
+                           (CALC(D,1) .. CALC(E,2) =>
+                            (CALC(F,1) .. CALC(G,2) =>
+                             (CALC(H,9) .. CALC(I,10) => CALC(J,2)))));
+                    IF CNTR(F) /= 4 THEN
+                         FAILED("CASE B2 : F NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(G) /= 4 THEN
+                         FAILED("CASE B2 : G NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(H) /= 4 THEN
+                         FAILED("CASE B2 : H NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(I) /= 4 THEN
+                         FAILED("CASE B2 : I NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(J) /= 16 THEN
+                         FAILED("CASE B2 : J NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1)*(G-F+1)*(I-H+1) TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE B2 : EXECEPTION RAISED");
+               END CASE_B2;
+
+     CASE_B3 : DECLARE
+                    B3 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 2 .. 1);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    B3 := (2 .. 3 => (1 .. 2 =>
+                            (CALC(F,1) .. CALC(G,2) =>
+                              (CALC(H,2) .. CALC(I,1) => CALC(J,2)))));
+                    IF CNTR(F) /= 4 THEN
+                         FAILED("CASE B3 : F NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(G) /= 4 THEN
+                         FAILED("CASE B3 : G NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(H) /= 4 THEN
+                         FAILED("CASE B3 : H NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(I) /= 4 THEN
+                         FAILED("CASE B3 : I NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(J) /= 0 THEN
+                         FAILED("CASE B3 : J NOT EVALUATED ZERO TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE B3 : EXECEPTION RAISED");
+               END CASE_B3;
+
+     CASE_B4 : DECLARE
+                    B4 : ARRAY(2 .. 3, 1 .. 2) OF T1(2 .. 1, 1 .. 2);
+               BEGIN
+                    CNTR := (CHOICE_INDEX => 0);
+                    B4 := (CALC(B,2) .. CALC(C,3) =>
+                           (CALC(D,1) .. CALC(E,2) =>
+                            (CALC(F,2) .. CALC(G,1) =>
+                             (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
+                    IF CNTR(F) /= 4 THEN
+                         FAILED("CASE B4 : F NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(G) /= 4 THEN
+                         FAILED("CASE B4 : G NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(H) /= 4 THEN
+                         FAILED("CASE B4 : H NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(I) /= 4 THEN
+                         FAILED("CASE B4 : I NOT EVALUATED (C-B+1)*" &
+                                "(E-D+1) TIMES");
+                    END IF;
+                    IF CNTR(J) /= 0 THEN
+                         FAILED("CASE B4 : J NOT EVALUATED ZERO TIMES");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED("CASE B4 : EXECEPTION RAISED");
+               END CASE_B4;
+
+          END CASE_B;
+      END;
+
+     RESULT;
+
+END C43208B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43209a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43209a.ada
new file mode 100644
index 000000000..c86d9494c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43209a.ada
@@ -0,0 +1,135 @@
+-- C43209A.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 STRING LITERAL IS ALLOWED IN A MULTIDIMENSIONAL
+--     ARRAY AGGREGATE AT THE PLACE OF A ONE DIMENSIONAL ARRAY OF
+--     CHARACTER TYPE.
+
+-- HISTORY:
+--     DHH 08/12/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43209A IS
+
+     TYPE MULTI_ARRAY IS ARRAY(1 .. 2, 1 .. 3, 1 .. 6) OF CHARACTER;
+
+BEGIN
+     TEST("C43209A", "CHECK THAT A STRING LITERAL IS ALLOWED IN A " &
+                     "MULTIDIMENSIONAL ARRAY AGGREGATE AT THE PLACE " &
+                     "OF A ONE DIMENSIONAL ARRAY OF CHARACTER TYPE");
+
+     DECLARE
+          X : MULTI_ARRAY := ((('A', 'B', 'C', 'D', 'E', 'F'),
+                              ('G', 'H', 'I', 'J', 'K', 'L'),
+                              ('M', 'N', 'O', 'P', 'Q', 'R')),
+                              (('S', 'T', 'U', 'V', 'W', 'X'),
+                              ('W', 'Z', 'A', 'B', 'C', 'D'),
+                              "WHOZAT"));
+
+          Y : MULTI_ARRAY := (("WHOZAT",
+                              ('A', 'B', 'C', 'D', 'E', 'F'),
+                              ('G', 'H', 'I', 'J', 'K', 'L')),
+                              (('M', 'N', 'O', 'P', 'Q', 'R'),
+                              ('S', 'T', 'U', 'V', 'W', 'X'),
+                              ('W', 'Z', 'A', 'B', 'C', 'D')));
+
+     BEGIN
+          IF X(IDENT_INT(2), IDENT_INT(3), IDENT_INT(6)) /=
+                  Y(IDENT_INT(1), IDENT_INT(1), IDENT_INT(6)) THEN
+               FAILED("INITIALIZATION FAILURE");
+          END IF;
+     END;
+
+     DECLARE
+          PROCEDURE FIX_AGG(T : MULTI_ARRAY) IS
+          BEGIN
+               IF T(IDENT_INT(2), IDENT_INT(2), IDENT_INT(5)) /=
+                       T(IDENT_INT(1), IDENT_INT(1), IDENT_INT(1)) THEN
+                    FAILED("SUBPROGRAM FAILURE");
+               END IF;
+          END;
+     BEGIN
+          FIX_AGG((("WHOZAT", ('A', 'B', 'C', 'D', 'E', 'F'),
+                              ('G', 'H', 'I', 'J', 'K', 'L')),
+                              (('M', 'N', 'O', 'P', 'Q', 'R'),
+                              ('S', 'T', 'U', 'V', 'W', 'X'),
+                              ('W', 'Z', 'A', 'B', 'C', 'D'))));
+
+     END;
+
+     DECLARE
+
+          Y : CONSTANT MULTI_ARRAY := (("WHOZAT",
+                              ('A', 'B', 'C', 'D', 'E', 'F'),
+                              ('G', 'H', 'I', 'J', 'K', 'L')),
+                              (('M', 'N', 'O', 'P', 'Q', 'R'),
+                              ('S', 'T', 'U', 'V', 'W', 'X'),
+                              ('W', 'Z', 'A', 'B', 'C', 'D')));
+
+     BEGIN
+          IF Y(IDENT_INT(2), IDENT_INT(2), IDENT_INT(5)) /=
+             Y(IDENT_INT(1), IDENT_INT(1), IDENT_INT(1)) THEN
+               FAILED("CONSTANT FAILURE");
+          END IF;
+     END;
+
+     DECLARE
+     BEGIN
+          IF MULTI_ARRAY'((1 =>(('A', 'B', 'C', 'D', 'E', 'F'),
+               ('G', 'H', 'I', 'J', 'K', 'L'),
+               ('M', 'N', 'O', 'P', 'Q', 'R')),
+              2 => (('S', 'T', 'U', 'V', 'W', 'X'),
+               ('W', 'Z', 'A', 'B', 'C', 'D'),
+               "WHOZAT"))) = MULTI_ARRAY'((1 =>(1 =>"WHOZAT",
+                             2 =>('A', 'B', 'C', 'D', 'E', 'F'),
+                             3 =>('G', 'H', 'I', 'J', 'K', 'L')),
+                            2 => (1 =>('M', 'N', 'O', 'P', 'Q', 'R'),
+                             2 =>('S', 'T', 'U', 'V', 'W', 'X'),
+                             3 => ('W', 'Z', 'A', 'B', 'C', 'D')))) THEN
+               FAILED("EQUALITY OPERATOR FAILURE");
+          END IF;
+     END;
+
+     DECLARE
+          SUBTYPE SM IS INTEGER RANGE 1 .. 10;
+          TYPE UNCONSTR IS ARRAY(SM RANGE <>, SM RANGE<>) OF CHARACTER;
+
+          FUNCTION FUNC(X : SM) RETURN UNCONSTR IS
+          BEGIN
+               IF EQUAL(X,X) THEN
+                    RETURN (1 => "WHEN", 2 => "WHAT");
+               ELSE
+                    RETURN ("    ", "    ");
+               END IF;
+          END FUNC;
+
+     BEGIN
+          IF FUNC(1) /= FUNC(2) THEN
+               FAILED("UNCONSTRAINED FUNCTION RETURN FAILURE");
+          END IF;
+     END;
+
+     RESULT;
+END C43209A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43210a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43210a.ada
new file mode 100644
index 000000000..549021e60
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43210a.ada
@@ -0,0 +1,142 @@
+-- C43210A.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 NON-AGGREGATE EXPRESSION IN A NAMED COMPONENT
+-- ASSOCIATION IS EVALUATED ONCE FOR EACH COMPONENT SPECIFIED
+-- BY THE ASSOCIATION.
+
+-- EG  02/02/84
+
+WITH REPORT;
+
+PROCEDURE C43210A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43210A", "CHECK THAT A NON-AGGREGATE IN A NAMED "   &
+                     "COMPONENT ASSOCIATION IS EVALUATED ONCE " &
+                     "FOR EACH COMPONENT SPECIFIED BY THE "     &
+                     "ASSOCIATION");
+
+     DECLARE
+
+          TYPE T1 IS ARRAY(1 .. 10) OF INTEGER;
+          TYPE T2 IS ARRAY(1 .. 8, 1 .. 2) OF INTEGER;
+          TYPE T3 IS ARRAY(1 .. 2, 1 .. 8) OF INTEGER;
+          TYPE T4 IS ARRAY(1 .. 8, 1 .. 8) OF INTEGER;
+
+          A1 : T1;
+          A2 : T2;
+          A3 : T3;
+          A4 : T4;
+          CC : INTEGER;
+
+          FUNCTION CALC (A : INTEGER) RETURN INTEGER IS
+          BEGIN
+               CC := CC + 1;
+               RETURN IDENT_INT(A);
+          END CALC;
+
+          PROCEDURE CHECK (A : STRING; B : INTEGER) IS
+          BEGIN
+               IF CC /= B THEN
+                    FAILED ("CASE " & A & " : INCORRECT NUMBER OF " &
+                            "EVALUATIONS. NUMBER OF EVALUATIONS "   &
+                            "SHOULD BE " & INTEGER'IMAGE(B) & 
+                            ", BUT IS " & INTEGER'IMAGE(CC));
+               END IF;
+          END CHECK;
+
+     BEGIN
+
+CASE_A :  BEGIN
+
+               CC := 0;
+               A1 := T1'(4 .. 5 => CALC(2), 6 .. 8 => CALC(4),
+                         OTHERS => 5);
+               CHECK ("A", 5);
+
+          END CASE_A;
+
+CASE_B :  BEGIN
+
+               CC := 0;
+               A1 := T1'(1 | 4 .. 6 | 3 | 2 => CALC(-1), OTHERS => -2);
+               CHECK ("B", 6);
+
+          END CASE_B;
+
+CASE_C :  BEGIN
+
+               CC := 0;
+               A1 := T1'(1 | 3 | 5 | 7 .. 9 => -1, OTHERS => CALC(-2));
+               CHECK ("C", 4);
+
+          END CASE_C;
+
+CASE_D :  BEGIN
+
+               CC := 0;
+               A2 := T2'(4 .. 6 | 8 | 2 .. 3 => (1 .. 2 => CALC(1)),
+                         OTHERS => (1 .. 2 => -1));
+               CHECK ("D", 12);
+
+          END CASE_D;
+
+CASE_E : BEGIN
+
+               CC := 0;
+               A3 := T3'(1 .. 2 => (2 | 4 | 6 .. 8 => CALC(-1),
+                                    OTHERS => -2));
+               CHECK ("E", 10);
+
+          END CASE_E;
+
+CASE_F :  BEGIN
+
+               CC := 0;
+               A4 := T4'(7 .. 8 | 3 .. 5 => 
+                          (1 | 2 | 4 | 6 .. 8 => CALC(1), OTHERS => -2),
+                         OTHERS => (OTHERS => -2));
+               CHECK ("F", 30);
+
+          END CASE_F;
+
+CASE_G :  BEGIN
+
+               CC := 0;
+               A4 := T4'(5 .. 8 | 3 | 1 => (7 | 1 .. 5 | 8 => -1,
+                                            OTHERS => CALC(-2)),
+                         OTHERS => (OTHERS => CALC(-2)));
+               CHECK ("G", 22);
+
+          END CASE_G;
+
+     END;
+
+     RESULT;
+
+END C43210A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43211a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43211a.ada
new file mode 100644
index 000000000..cf745d0dc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43211a.ada
@@ -0,0 +1,170 @@
+-- C43211A.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 IF A BOUND IN A NON-NULL
+-- RANGE OF A NON-NULL AGGREGATE DOES NOT BELONG TO THE INDEX SUBTYPE.
+
+-- EG  02/06/84
+-- EG  05/08/85
+-- EDS 07/15/98    AVOID OPTIMIZATION
+
+WITH REPORT;
+
+PROCEDURE C43211A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43211A","CHECK THAT CONSTRAINT_ERROR IS RAISED IF A " &
+                    "BOUND IN A NON-NULL RANGE OF A NON-NULL "    &
+                    "AGGREGATE DOES NOT BELONG TO THE INDEX "     &
+                    "SUBTYPE");
+
+     DECLARE
+
+          SUBTYPE ST IS INTEGER RANGE 4 .. 8;
+          TYPE BASE IS ARRAY(ST RANGE <>, ST RANGE <>) OF INTEGER;
+          SUBTYPE T IS BASE(5 .. 7, 5 .. 7);
+
+          A    : T;
+
+     BEGIN
+
+CASE_A :  BEGIN
+
+               A := (6 .. 8 => (4 .. 6 => 0));
+               IF A /= (6 .. 8 => (4 .. 6 => 0)) THEN
+                    FAILED ("CASE A : INCORRECT VALUES");
+               END IF;
+
+          EXCEPTION
+
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED: CASE A");
+
+          END CASE_A;
+
+CASE_B :  BEGIN
+
+               A := (6 .. IDENT_INT(8) =>
+                     (IDENT_INT(4) .. 6 => 1));
+               IF A /= (6 .. IDENT_INT(8) =>
+                        (IDENT_INT(4) .. 6 => 1)) THEN
+                    FAILED ("CASE B : INCORRECT VALUES");
+               END IF;
+
+          EXCEPTION
+
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED: CASE B");
+
+          END CASE_B;
+
+CASE_C :  BEGIN
+
+               A := (7 .. 9 => (5 .. 7 => IDENT_INT(2)));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE C " & 
+                INTEGER'IMAGE(A(IDENT_INT(7),7)));
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED: CASE C");
+
+          END CASE_C;
+
+CASE_D :  BEGIN
+
+               A := (5 .. 7 => (3 .. 5 => IDENT_INT(3)));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE D " &
+                INTEGER'IMAGE(A(7,IDENT_INT(5))));
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED: CASE D");
+
+          END CASE_D;
+
+CASE_E :  BEGIN
+
+               A := (7 .. IDENT_INT(9) => (5 .. 7 => IDENT_INT(4)));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE E " &
+                INTEGER'IMAGE(A(IDENT_INT(7),7)));
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("CASE E : EXCEPTION RAISED");
+
+          END CASE_E;
+
+CASE_F :  BEGIN
+
+               A := (5 .. 7 => (IDENT_INT(3) .. 5 => IDENT_INT(5)));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE F " &
+                INTEGER'IMAGE(A(7,IDENT_INT(5))));
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED: CASE F");
+
+          END CASE_F;
+
+CASE_G :  BEGIN
+
+               A := (7 .. 8 => (5 .. 7 => IDENT_INT(6)),
+              9 => (5 .. 7 => IDENT_INT(6)));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED: CASE G " &
+                INTEGER'IMAGE(A(7,IDENT_INT(7))));
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED: CASE G");
+
+          END CASE_G;
+
+     END;
+
+     RESULT;
+
+END C43211A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43212a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43212a.ada
new file mode 100644
index 000000000..fd940332e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43212a.ada
@@ -0,0 +1,154 @@
+-- C43212A.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 IF ALL SUBAGGREGATES FOR A
+-- PARTICULAR DIMENSION DO NOT HAVE THE SAME BOUNDS.
+
+-- EG  02/06/1984
+-- JBG 3/30/84
+-- JRK 4/18/86   CORRECTED ERROR TO ALLOW CONSTRAINT_ERROR TO BE
+--               RAISED EARLIER.
+-- EDS 7/15/98   AVOID OPTIMIZATION.
+
+WITH REPORT;
+
+PROCEDURE C43212A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST ("C43212A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL " &
+                      "SUBAGGREGATES FOR A PARTICULAR DIMENSION DO "  &
+                      "NOT HAVE THE SAME BOUNDS");
+
+     DECLARE
+
+          TYPE CHOICE_INDEX IS (H, I);
+          TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
+
+          CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
+
+          FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
+                                             RETURN INTEGER IS
+          BEGIN
+               CNTR(A) := CNTR(A) + 1;
+               RETURN IDENT_INT(B);
+          END CALC;
+
+     BEGIN
+
+CASE_1 :  DECLARE
+
+               TYPE T IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
+                                                   OF INTEGER;
+
+               A1 : T(1 .. 3, 2 .. 5) := (OTHERS => (OTHERS => 0));
+
+          BEGIN
+
+               CNTR := (CHOICE_INDEX => 0);
+               A1 := (1 => (CALC(H,2) .. CALC(I,5) => -4),
+                      2 => (CALC(H,3) .. CALC(I,6) => -5),
+                      3 => (CALC(H,2) .. CALC(I,5) => -3));
+               FAILED ("CASE 1 : CONSTRAINT_ERROR NOT RAISED" &
+                       INTEGER'IMAGE(A1(1,5)) );
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    IF CNTR(H) < 2 AND CNTR(I) < 2 THEN
+                         FAILED ("CASE 1 : BOUNDS OF SUBAGGREGATES " &
+                                 "NOT DETERMINED INDEPENDENTLY");
+                    END IF;
+
+               WHEN OTHERS =>
+                    FAILED ("CASE 1 : WRONG EXCEPTION RAISED");
+
+          END CASE_1;
+
+CASE_1A : DECLARE
+
+               TYPE T IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
+                                                  OF INTEGER;
+
+               A1 : T(1 .. 3, 2 .. 3) := (1 .. 3 => (2 .. 3 => 1));
+
+          BEGIN
+
+               IF (1 .. 2 => (IDENT_INT(3) .. IDENT_INT(4) => 0),
+                        3 => (1, 2)) = A1 THEN
+                    BEGIN
+                         COMMENT(" IF SHOULD GENERATE CONSTRAINT_ERROR " & 
+                                 INTEGER'IMAGE(A1(1,2)) );
+                    EXCEPTION
+                         WHEN OTHERS =>
+                            FAILED ("CASE 1A : CONSTRAINT_ERROR NOT RAISED");
+                    END;
+               END IF;
+                    FAILED ("CASE 1A : CONSTRAINT_ERROR NOT RAISED");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("CASE 1A : WRONG EXCEPTION RAISED");
+
+          END CASE_1A;
+
+CASE_2 :  DECLARE
+
+               TYPE T IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
+                                                   OF INTEGER;
+
+               A2 : T(1 .. 3, IDENT_INT(4) .. 2);
+
+          BEGIN
+
+               CNTR := (CHOICE_INDEX => 0);
+               A2 := (1 => (CALC(H,5) .. CALC(I,3) => -4),
+                      3 => (CALC(H,4) .. CALC(I,2) => -5),
+                      2 => (CALC(H,4) .. CALC(I,2) => -3));
+               FAILED ("CASE 2 : CONSTRAINT_ERROR NOT RAISED " &
+                       INTEGER'IMAGE(IDENT_INT(A2'FIRST(1))));
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    IF CNTR(H) < 2 AND CNTR(I) < 2 THEN
+                         FAILED ("CASE 2 : BOUNDS OF SUBAGGREGATES " &
+                                 "NOT DETERMINED INDEPENDENTLY");
+                    END IF;
+
+               WHEN OTHERS =>
+                    FAILED ("CASE 2 : WRONG EXCEPTION RAISED");
+
+          END CASE_2;
+
+     END;
+
+     RESULT;
+
+END C43212A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43212c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43212c.ada
new file mode 100644
index 000000000..30764670e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43212c.ada
@@ -0,0 +1,102 @@
+-- C43212C.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 IF ALL SUBAGGREGATES FOR
+-- A PARTICULAR DIMENSION DO NOT HAVE THE SAME BOUNDS.
+-- ADDITIONAL CASES FOR THE THIRD DIMENSION AND FOR THE NULL ARRAYS.
+
+-- PK  02/21/84
+-- EG  05/30/84
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE C43212C IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+
+BEGIN
+
+     TEST("C43212C","CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL " &
+                    "SUBAGGREGATES FOR A PARTICULAR DIMENSION DO "  &
+                    "NOT HAVE THE SAME BOUNDS");
+
+     DECLARE
+          TYPE A3 IS ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>)
+                         OF INTEGER;
+     BEGIN
+          IF A3'(((IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)),
+                      (1 .. IDENT_INT(2) => IDENT_INT(1))),
+                     ((IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)),
+                      (IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)))) 
+            =
+             A3'(((IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)),
+                      (1 .. IDENT_INT(2) => IDENT_INT(1))),
+                     ((IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)),
+                      (IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)))) 
+          THEN
+                FAILED ("A3 - EXCEPTION NOT RAISED, ARRAYS EQUAL");
+          END IF;
+          FAILED ("A3 - EXCEPTION NOT RAISED, ARRAYS NOT EQUAL");
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => 
+               FAILED ("A3 - WRONG EXCEPTION RAISED");
+
+     END;
+
+     DECLARE
+
+          TYPE B3 IS ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>)
+                         OF INTEGER;
+
+     BEGIN
+
+          IF B3'(((IDENT_INT(2) .. IDENT_INT(1) => IDENT_INT(1)),
+                      (2 .. IDENT_INT(1) => IDENT_INT(1))),
+                     ((IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)),
+                      (IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)))) 
+            =
+             B3'(((IDENT_INT(2) .. IDENT_INT(1) => IDENT_INT(1)),
+                      (2 .. IDENT_INT(1) => IDENT_INT(1))),
+                     ((IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)),
+                      (IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)))) 
+          THEN
+                FAILED ("B3 - EXCEPTION NOT RAISED, ARRAYS EQUAL");
+          END IF;
+          FAILED ("B3 - EXCEPTION NOT RAISED, ARRAYS NOT EQUAL");
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS => 
+                FAILED ("B3 - WRONG EXCEPTION RAISED");
+
+     END;
+
+     RESULT;
+
+END C43212C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214a.ada
new file mode 100644
index 000000000..6d953c4d7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214a.ada
@@ -0,0 +1,100 @@
+-- C43214A.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 A MULTIDIMENSIONAL AGGREGATE OF THE FORM (F..G => ""), CHECK
+-- THAT CONSTRAINT_ERROR IS RAISED IF F..G IS NON-NULL AND
+-- F OR G DO NOT BELONG TO THE INDEX SUBTYPE.
+
+-- EG  02/10/1984
+-- JBG 12/6/84
+-- EDS 07/15/98     AVOID OPTIMIZATION
+
+WITH REPORT;
+
+PROCEDURE C43214A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43214A", "FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM " &
+                     "(F..G => """"), CHECK THAT CONSTRAINT ERROR "  &
+                     "IS RAISED IF F..G IS NON-NULL AND NOT IN THE " &
+                     "INDEX SUBTYPE");
+
+     DECLARE
+
+          SUBTYPE STA IS INTEGER RANGE 4 .. 7;
+          TYPE TA IS ARRAY(STA RANGE 5 .. 6, 
+                           STA RANGE 6 .. IDENT_INT(4)) OF CHARACTER;
+
+          A : TA := (5 .. 6 => "");
+
+     BEGIN
+
+CASE_A :  BEGIN
+
+               IF (6 .. IDENT_INT(8) => "") = A THEN
+                    FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED");
+               END IF;
+               FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED - 2");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("CASE A : WRONG EXCEPTION RAISED");
+
+          END CASE_A;
+
+CASE_B :  BEGIN
+
+               A := (IDENT_INT(3) .. 4 => "");
+               FAILED ("CASE B : CONSTRAINT_ERROR NOT RAISED");
+               BEGIN
+                  FAILED("ATTEMPT TO USE A " &
+                         CHARACTER'VAL(IDENT_INT(CHARACTER'POS(
+                            A(A'FIRST(1), A'FIRST(2)) ))) );
+               EXCEPTION
+                  WHEN OTHERS =>
+                     FAILED("CONSTRAINT_ERROR NOT RAISED AT PROPER PLACE");
+               END;
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("CASE B : WRONG EXCEPTION RAISED");
+
+          END CASE_B;
+
+     END;
+
+     RESULT;
+
+END C43214A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214b.ada
new file mode 100644
index 000000000..6db7e2b9d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214b.ada
@@ -0,0 +1,105 @@
+-- C43214B.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 LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
+-- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
+
+-- EG  02/10/84
+
+WITH REPORT;
+
+PROCEDURE C43214B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43214B", "SUBPROGRAM WITH CONSTRAINED ARRAY FORMAL " &
+                     "PARAMETER");
+
+     BEGIN
+
+CASE_A :  BEGIN
+
+--             COMMENT ("CASE A1 : SUBPROGRAM WITH CONSTRAINED " &
+--                      "ONE-DIMENSIONAL ARRAY FORMAL PARAMETER");
+
+     CASE_A1 : DECLARE
+
+                    SUBTYPE STA1 IS STRING(IDENT_INT(11) .. 15);
+
+                    PROCEDURE PROC1 (A : STA1) IS
+                    BEGIN
+                         IF A'FIRST /= 11 THEN
+                              FAILED ("CASE 1 : LOWER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A'LAST /= 15 THEN
+                              FAILED ("CASE 1 : UPPER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A /= "ABCDE" THEN
+                              FAILED ("CASE 1 : ARRAY DOES NOT " &
+                                     "CONTAIN THE CORRECT VALUES");
+                         END IF;
+                    END;
+
+               BEGIN
+
+                    PROC1 ("ABCDE");
+
+               END CASE_A1;
+
+--             COMMENT ("CASE A2 : SUBPROGRAM WITH CONSTRAINED " &
+--                      "TWO-DIMENSIONAL ARRAY FORMAL PARAMETER");
+
+     CASE_A2 : DECLARE
+
+                    TYPE TA IS ARRAY (11 .. 12, 10 .. 11) OF CHARACTER;
+
+                    PROCEDURE PROC1 (A : TA) IS
+                    BEGIN
+                         IF A'FIRST(1) /= 11 OR A'FIRST(2) /= 10 THEN
+                              FAILED ("CASE 2 : LOWER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A'LAST(1) /= 12 OR A'LAST(2) /= 11 THEN
+                              FAILED ("CASE 2 : UPPER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A /= ("AB", "CD") THEN
+                              FAILED ("CASE 2 : ARRAY DOES NOT " &
+                                      "CONTAIN THE CORRECT VALUES");
+                         END IF;
+                    END;
+
+               BEGIN
+
+                    PROC1 (("AB", "CD"));
+
+               END CASE_A2;
+
+          END CASE_A;
+
+     END;
+
+     RESULT;
+
+END C43214B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214c.ada
new file mode 100644
index 000000000..b5233022f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214c.ada
@@ -0,0 +1,75 @@
+-- C43214C.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 LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
+-- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
+
+-- EG  02/10/84
+
+WITH REPORT;
+
+PROCEDURE C43214C IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43214C", "CONSTRAINED ARRAY FORMAL GENERIC " &
+                     "PARAMETER");
+
+     BEGIN
+
+CASE_B :  DECLARE
+
+               SUBTYPE STB IS STRING(5 .. 8);
+
+               GENERIC
+                    B1 : STB;
+               PROCEDURE PROC1;
+
+               PROCEDURE PROC1 IS
+               BEGIN
+                    IF B1'FIRST /= 5 THEN
+                         FAILED ("LOWER BOUND INCORRECT");
+                    ELSIF B1'LAST /= 8 THEN
+                         FAILED ("UPPER BOUND INCORRECT");
+                    ELSIF B1 /= "ABCD" THEN
+                         FAILED ("ARRAY DOES NOT " &
+                                 "CONTAIN THE CORRECT VALUES");
+                    END IF;
+               END;
+
+               PROCEDURE PROC2 IS NEW PROC1 ("ABCD");
+
+          BEGIN
+
+               PROC2;
+
+          END CASE_B;
+
+     END;
+
+     RESULT;
+
+END C43214C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214d.ada
new file mode 100644
index 000000000..7274a4b46
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214d.ada
@@ -0,0 +1,77 @@
+-- C43214D.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 LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
+-- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
+
+-- EG  02/10/84
+
+WITH REPORT;
+
+PROCEDURE C43214D IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43214D", "CONSTRAINED FUNCTION RESULT TYPE");
+
+     BEGIN
+
+CASE_C :  DECLARE
+
+               TYPE TC IS ARRAY (INTEGER RANGE -1 .. 0, 
+                                 IDENT_INT(7) .. 9) OF CHARACTER;
+
+               FUNCTION FUN1 (A : INTEGER) RETURN TC IS
+               BEGIN
+                    RETURN ("ABC", "DEF");
+               END;
+
+          BEGIN
+
+               IF FUN1(5)'FIRST(1) /= -1 THEN
+                    FAILED ("LOWER BOUND INCORRECT " &
+                            "FOR 'FIRST(1)");
+               ELSIF FUN1(5)'FIRST(2) /= 7 THEN
+                    FAILED ("LOWER BOUND INCORRECT " &
+                            "FOR 'FIRST(2)");
+               ELSIF FUN1(5)'LAST(1) /= 0 THEN
+                    FAILED ("UPPER BOUND INCORRECT " &
+                            "FOR 'LAST(1)");
+               ELSIF FUN1(5)'LAST(2) /= 9 THEN
+                    FAILED ("UPPER BOUND INCORRECT " &
+                            "FOR 'LAST(2)");
+               ELSIF FUN1(5) /= ("ABC", "DEF") THEN
+                    FAILED ("FUNCTION DOES NOT " &
+                            "RETURN THE CORRECT VALUES");
+               END IF;
+
+          END CASE_C;
+
+     END;
+
+     RESULT;
+
+END C43214D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214e.ada
new file mode 100644
index 000000000..88ebb510b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214e.ada
@@ -0,0 +1,147 @@
+-- C43214E.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 LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
+-- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
+
+-- EG  02/10/84
+
+WITH REPORT;
+
+PROCEDURE C43214E IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43214E", "INITIALIZATION OF CONSTRAINED ARRAY");
+
+     BEGIN
+
+CASE_D :  BEGIN
+
+--             COMMENT ("CASE D1 : INITIALIZATION OF CONSTRAINED " &
+--                      "ARRAY CONSTANT");
+
+     CASE_D1 : DECLARE
+
+                    D1 : CONSTANT STRING(11 .. 13) := "ABC";
+
+               BEGIN
+
+                    IF D1'FIRST /= 11 THEN
+                         FAILED ("CASE 1 : LOWER BOUND INCORRECT");
+                    ELSIF D1'LAST /= 13 THEN
+                         FAILED ("CASE 1 : UPPER BOUND INCORRECT");
+                    ELSIF D1 /= "ABC" THEN
+                              FAILED ("CASE 1 : ARRAY DOES NOT " &
+                                      "CONTAIN THE CORRECT VALUES");
+                    END IF;
+
+               END CASE_D1;
+
+--             COMMENT ("CASE D2 : INITIALIZATION OF CONSTRAINED " &
+--                      "ARRAY VARIABLE");
+
+     CASE_D2 : DECLARE
+
+                    D2 : STRING(11 .. 13) := "ABC";
+
+               BEGIN
+
+                    IF D2'FIRST /= 11 THEN
+                         FAILED ("CASE 2 : LOWER BOUND INCORRECT");
+                    ELSIF D2'LAST /= 13 THEN
+                         FAILED ("CASE 2 : UPPER BOUND INCORRECT");
+                    ELSIF D2 /= "ABC" THEN
+                         FAILED ("CASE 2 : INCORRECT VALUES");
+                    END IF;
+
+               END CASE_D2;
+
+--             COMMENT ("CASE D3 : INITIALIZATION OF CONSTRAINED " &
+--                      "ARRAY FORMAL PARAMETER OF A SUBPROGRAM");
+
+     CASE_D3 : DECLARE
+
+                    SUBTYPE STD3 IS STRING(IDENT_INT(5) .. 7);
+
+                    PROCEDURE PROC1 (A : STD3 := "ABC") IS
+                    BEGIN
+                         IF A'FIRST /= 5 THEN
+                              FAILED ("CASE 3 : LOWER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A'LAST /= 7 THEN
+                              FAILED ("CASE 3 : UPPER BOUND " &
+                                      "INCORRECT");
+                         ELSIF A /= "ABC" THEN
+                              FAILED ("CASE 3 : INCORRECT VALUES");
+                         END IF;
+                    END PROC1;
+
+               BEGIN
+
+               PROC1;
+
+               END CASE_D3;
+
+--             COMMENT ("CASE D4 : INITIALIZATION OF CONSTRAINED " &
+--                      "ARRAY FORMAL PARAMETER OF A GENERIC UNIT");
+
+     CASE_D4 : DECLARE
+
+                    SUBTYPE STD4 IS STRING(5 .. 8);
+
+                    GENERIC
+                         D4 : STD4 := "ABCD";
+                    PROCEDURE PROC1;
+
+                    PROCEDURE PROC1 IS
+                    BEGIN
+                         IF D4'FIRST /= 5 THEN
+                              FAILED ("CASE 4 : LOWER BOUND " &
+                                      "INCORRECT");
+                         ELSIF D4'LAST /= 8 THEN
+                              FAILED ("CASE 4 : UPPER BOUND " &
+                                      "INCORRECT");
+                         ELSIF D4 /= "ABCD" THEN
+                              FAILED ("CASE 4 : INCORRECT VALUES");
+                         END IF;
+                    END PROC1;
+
+                    PROCEDURE PROC2 IS NEW PROC1;
+
+               BEGIN
+
+                    PROC2;
+
+               END CASE_D4;
+
+          END CASE_D;
+
+     END;
+
+     RESULT;
+
+END C43214E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214f.ada
new file mode 100644
index 000000000..2c19d1748
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43214f.ada
@@ -0,0 +1,151 @@
+-- C43214F.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 LOWER BOUND FOR THE STRING LITERAL IS DETERMINED BY
+-- THE APPLICABLE INDEX CONSTRAINT, WHEN ONE EXISTS.
+
+-- EG  02/10/84
+-- JBG 3/30/84
+
+WITH REPORT;
+
+PROCEDURE C43214F IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C43214F", "ARRAY COMPONENT EXPRESSION OF AN ENCLOSING " &
+                     "AGGREGATE");
+
+     BEGIN
+
+CASE_E :  BEGIN
+
+--             COMMENT ("CASE E1 : ARRAY COMPONENT EXPRESSION OF " &
+--                      "AN ENCLOSING ARRAY AGGREGATE");
+
+     CASE_E1 : DECLARE
+
+                    TYPE TE2 IS ARRAY(1 .. 2) OF 
+                                STRING(IDENT_INT(3) .. 5);
+
+                    E1 : TE2;
+
+               BEGIN
+
+                    E1 := (1 .. 2 => "ABC");
+                    IF (E1'FIRST /= 1 OR E1'LAST /= 2) OR ELSE
+                       (E1(1)'FIRST /= 3 OR E1(1)'LAST /= 5 OR
+                        E1(2)'FIRST /= 3 OR E1(2)'LAST /= 5) THEN
+                         FAILED ("CASE 1 : INCORRECT BOUNDS");
+                    ELSIF E1 /= (1 .. 2 => "ABC") THEN
+                         FAILED ("CASE 1 : ARRAY DOES NOT " &
+                                 "CONTAIN THE CORRECT VALUES");
+                    END IF;
+
+               END CASE_E1;
+
+--             COMMENT ("CASE E2 : ARRAY COMPONENT EXPRESSION OF " &
+--                      "AN ENCLOSING RECORD AGGREGATE");
+
+     CASE_E2 : DECLARE
+
+                    TYPE TER IS
+                         RECORD
+                              REC : STRING(3 .. 5);
+                         END RECORD;
+
+                    E2 : TER;
+
+               BEGIN
+
+                    E2 := (REC => "ABC");
+                    IF E2.REC'FIRST /= 3 OR E2.REC'LAST /= 5 THEN
+                         FAILED ("CASE 2 : INCORRECT BOUNDS");
+                    ELSIF E2.REC /= "ABC" THEN
+                         FAILED ("CASE 2 : ARRAY DOES NOT " &
+                                 "CONTAIN CORRECT VALUES");
+                    END IF;
+
+               END CASE_E2;
+
+--             COMMENT ("CASE E3 : NULL LITERAL OF AN ENCLOSING " &
+--                      "ARRAY AGGREGATE");
+
+     CASE_E3 : DECLARE
+
+                    TYPE TE2 IS ARRAY(1 .. 2) OF
+                                STRING(3 .. IDENT_INT(2));
+
+                    E3 : TE2;
+
+               BEGIN
+
+                    E3 := (1 .. 2 => "");
+                    IF (E3'FIRST /= 1 OR E3'LAST /= 2) OR ELSE
+                       (E3(1)'FIRST /= 3 OR E3(1)'LAST /= 2 OR
+                        E3(2)'FIRST /= 3 OR E3(2)'LAST /= 2) THEN
+                         FAILED ("CASE 3 : INCORRECT BOUND");
+                    ELSIF E3 /= (1 .. 2 => "") THEN
+                         FAILED ("CASE 3 : ARRAY DOES NOT CONTAIN " &
+                                 "THE CORRECT VALUES");
+                    END IF;
+
+               END CASE_E3;
+
+--             COMMENT ("CASE E4 : ARRAY COMPONENT EXPRESSION OF "  &
+--                      "AN ENCLOSING RECORD AGGREGATE THAT HAS A " &
+--                      "DISCRIMINANT AND THE DISCRIMINANT DETER"   &
+--                      "MINES THE BOUNDS OF THE COMPONENT");
+
+     CASE_E4 : DECLARE
+
+                    SUBTYPE TEN IS INTEGER RANGE 1 .. 10;
+                    TYPE TER (A : TEN) IS
+                         RECORD
+                              REC : STRING(3 .. A);
+                         END RECORD;
+
+                    E4 : TER(5);
+
+               BEGIN
+
+                    E4 := (REC => "ABC", A => 5);
+                    IF E4.REC'FIRST /= 3 OR E4.REC'LAST /= 5 THEN
+                         FAILED ("CASE 4 : INCORRECT BOUNDS");
+                    ELSIF E4.REC /= "ABC" THEN
+                         FAILED ("CASE 4 : ARRAY DOES NOT CONTAIN " &
+                                 "CORRECT VALUES");
+                    END IF;
+
+               END CASE_E4;
+
+          END CASE_E;
+
+     END;
+
+     RESULT;
+
+END C43214F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43215a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43215a.ada
new file mode 100644
index 000000000..ff832cc2a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43215a.ada
@@ -0,0 +1,138 @@
+-- C43215A.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 A POSITIONAL
+-- ARRAY AGGREGATE WHOSE UPPER BOUND EXCEEDS THE UPPER BOUND
+-- OF THE INDEX SUBTYPE BUT BELONGS TO THE INDEX BASE TYPE.
+
+-- EG  02/13/84
+
+WITH REPORT;
+WITH SYSTEM;
+
+PROCEDURE C43215A IS
+
+     USE REPORT;
+     USE SYSTEM;
+
+BEGIN
+
+     TEST("C43215A","CHECK THAT CONSTRAINT_ERROR IS RAISED "      &
+                    "FOR A POSITIONAL ARRAY AGGREGATE WHOSE "     &
+                    "UPPER BOUND EXCEEDS THE UPPER BOUND OF THE " &
+                    "INDEX SUBTYPE BUT BELONGS TO THE INDEX "     &
+                    "BASE TYPE");
+
+     BEGIN
+
+CASE_A :  DECLARE
+
+               LOWER_BOUND : CONSTANT  := MAX_INT-3;
+               UPPER_BOUND : CONSTANT  := MAX_INT-1;
+
+               TYPE STA IS RANGE LOWER_BOUND .. UPPER_BOUND;
+
+               TYPE TA IS ARRAY(STA RANGE <>) OF INTEGER;
+
+               A1 : TA(STA);
+               OK : EXCEPTION;
+
+               FUNCTION FUN1 RETURN TA IS
+               BEGIN
+                    RETURN (1, 2, 3, 4);
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                    BEGIN
+                         COMMENT ("CASE A : CONSTRAINT_ERROR RAISED");
+                         RAISE OK;
+                    END;
+                    WHEN OTHERS =>
+                    BEGIN
+                         FAILED ("CASE A : EXCEPTION RAISED IN FUN1");
+                         RAISE OK;
+                    END;
+               END FUN1;
+
+          BEGIN
+
+               A1 := FUN1;
+               FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED");
+
+          EXCEPTION
+
+               WHEN OK =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("CASE A : EXCEPTION RAISED");
+
+          END CASE_A;
+
+CASE_B :  DECLARE
+
+               TYPE ENUM IS (A, B, C, D);
+
+               SUBTYPE STB IS ENUM RANGE A .. C;
+
+               TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER;
+
+               B1 : TB(STB);
+               OK : EXCEPTION;
+
+               FUNCTION FUN1 RETURN TB IS
+               BEGIN
+                    RETURN (1, 2, 3, 4);
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                    BEGIN
+                         COMMENT ("CASE B : CONSTRAINT_ERROR RAISED");
+                         RAISE OK;
+                    END;
+                    WHEN OTHERS =>
+                    BEGIN
+                         FAILED ("CASE B : EXCEPTION RAISED IN FUN1");
+                         RAISE OK;
+                    END;
+               END FUN1;
+
+          BEGIN
+
+               B1 := FUN1;
+               FAILED ("CASE B : CONSTRAINT_ERROR NOT RAISED");
+
+          EXCEPTION
+
+               WHEN OK =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("CASE B : EXCEPTION RAISED");
+
+          END CASE_B;
+
+     END;
+
+     RESULT;
+
+END C43215A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43215b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43215b.ada
new file mode 100644
index 000000000..a80f818f2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43215b.ada
@@ -0,0 +1,142 @@
+-- C43215B.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 WHEN THE UPPER BOUND
+-- OF A POSITIONAL AGGREGATE DOES NOT BELONG TO THE INDEX BASE TYPE.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- EG  02/13/84
+-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT;
+WITH SYSTEM;
+
+PROCEDURE C43215B IS
+
+     USE REPORT;
+     USE SYSTEM;
+
+BEGIN
+
+     TEST("C43215B","CHECK THAT CONSTRAINT_ERROR IS RAISED "   &
+                    "WHEN THE UPPER BOUND OF A POSITIONAL ARRAY " &
+                    "AGGREGATE DOES NOT BELONG TO THE INDEX "     &
+                    "BASE TYPE");
+
+     BEGIN
+
+CASE_A :  DECLARE
+
+               LOWER_BOUND : CONSTANT := MAX_INT-3;
+               UPPER_BOUND : CONSTANT := MAX_INT-1;
+
+               TYPE STA IS RANGE LOWER_BOUND .. UPPER_BOUND;
+
+               TYPE TA IS ARRAY(STA RANGE <>) OF INTEGER;
+
+               A1 : TA(STA);
+               OK : EXCEPTION;
+
+               FUNCTION FUN1 RETURN TA IS
+               BEGIN
+                    RETURN (1, 2, 3, 4, 5);
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                    BEGIN
+                         COMMENT ("CASE A : CONSTRAINT_ERROR RAISED");
+                         RAISE OK;
+                    END;
+                    WHEN OTHERS =>
+                    BEGIN
+                         FAILED ("CASE A : EXCEPTION RAISED IN FUN1");
+                         RAISE OK;
+                    END;
+               END FUN1;
+
+          BEGIN
+
+               A1 := FUN1;
+               FAILED ("CASE A : CONSTRAINT OR NUMERIC ERROR WAS " &
+                       "NOT RAISED");
+
+          EXCEPTION
+
+               WHEN OK =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("CASE A : WRONG EXCEPTION RAISED");
+
+          END CASE_A;
+
+CASE_B :  DECLARE
+
+               TYPE ENUM IS (A, B, C, D);
+
+               SUBTYPE STB IS ENUM RANGE A .. C;
+
+               TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER;
+
+               B1 : TB(STB);
+               OK : EXCEPTION;
+
+               FUNCTION FUN1 RETURN TB IS
+               BEGIN
+                    RETURN (1, 2, 3, 4, 5);
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                    BEGIN
+                         COMMENT ("CASE B : CONSTRAINT_ERROR RAISED");
+                         RAISE OK;
+                    END;
+                    WHEN OTHERS =>
+                    BEGIN
+                         FAILED ("CASE B : EXCEPTION RAISED IN FUN1");
+                         RAISE OK;
+                    END;
+               END FUN1;
+
+          BEGIN
+
+               B1 := FUN1;
+               FAILED ("CASE B : CONSTRAINT ERROR WAS NOT RAISED");
+
+          EXCEPTION
+
+               WHEN OK =>
+                    NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("CASE B : WRONG EXCEPTION RAISED");
+
+          END CASE_B;
+
+     END;
+
+     RESULT;
+
+END C43215B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43222a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43222a.ada
new file mode 100644
index 000000000..f1056576f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43222a.ada
@@ -0,0 +1,49 @@
+-- C43222A.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 ARRAY AGGREGATE NEED NOT BE RESOLVABLE TO A
+--     CONSTRAINED SUBTYPE.
+
+-- HISTORY:
+--     DHH 08/12/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43222A IS
+
+BEGIN
+     TEST("C43222A", "CHECK THAT AN ARRAY AGGREGATE NEED NOT BE " &
+                     "RESOLVABLE TO A CONSTRAINED SUBTYPE");
+
+     DECLARE
+          TYPE A IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+          B : BOOLEAN := (1, 2, 3) = A'(1, 2, 3);
+     BEGIN
+          IF IDENT_BOOL(B) /= IDENT_BOOL(TRUE) THEN
+               FAILED("INITIALIZATION FAILURE");
+          END IF;
+     END;
+
+     RESULT;
+END C43222A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43224a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43224a.ada
new file mode 100644
index 000000000..799309a82
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c43224a.ada
@@ -0,0 +1,75 @@
+-- C43224A.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 NON-STATIC CHOICE OF AN ARRAY AGGREGATE CAN BE A
+--     'RANGE ATTRIBUTE.
+
+-- HISTORY:
+--     DHH 08/15/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C43224A IS
+
+     M, O : INTEGER := IDENT_INT(2);
+     N : INTEGER := IDENT_INT(3);
+
+     TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+     TYPE D3_ARR IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>,
+                          INTEGER RANGE <>) OF INTEGER;
+
+     SUBTYPE ARR1 IS ARR(IDENT_INT(2) .. IDENT_INT(3));
+     SUBTYPE ARR2 IS D3_ARR(1 .. M, 1 .. N, 1 ..O);
+
+     SUB : ARR1;
+     SUB1 : ARR2;
+
+     PROCEDURE PROC(ARRY : IN OUT ARR) IS
+     BEGIN
+          ARRY := (ARR1'RANGE => IDENT_INT(7));
+          IF ARRY(IDENT_INT(ARRY'FIRST)) /= IDENT_INT(7) THEN
+               FAILED("RANGE NOT INITIALIZED - 1");
+          END IF;
+     END PROC;
+
+     PROCEDURE PROC1(ARRY : IN OUT D3_ARR) IS
+     BEGIN
+          ARRY := (ARR2'RANGE(1) => (ARRY'RANGE(2) =>
+                  (ARRY'RANGE(3) => IDENT_INT(7))));
+
+          IF ARRY(IDENT_INT(1), IDENT_INT(2), IDENT_INT(1)) /=
+                  IDENT_INT(7) THEN
+               FAILED("RANGE NOT INITIALIZED - 2");
+          END IF;
+     END PROC1;
+
+BEGIN
+     TEST("C43224A", "CHECK THAT A NON-STATIC CHOICE OF AN ARRAY " &
+                     "AGGREGATE CAN BE A 'RANGE ATTRIBUTE");
+
+     PROC(SUB);
+     PROC1(SUB1);
+
+     RESULT;
+END C43224A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c433001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c433001.a
new file mode 100644
index 000000000..613b688c8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c433001.a
@@ -0,0 +1,302 @@
+-- C433001.A
+
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE
+--     Check that an others choice is allowed in an array aggregate whose
+--     applicable index constraint is dynamic. (This was an extension to
+--     Ada 83). Check that index choices are within the applicable index
+--     constraint for array aggregates with others choices.
+--
+-- TEST DESCRIPTION
+--     In this test, we declare several unconstrained array types, and
+--     several dynamic subtypes. We then test a variety of cases of using
+--     appropriate aggregates. Some cases expect to raise Constraint_Error.
+--
+-- HISTORY:
+--      16 DEC 1999   RLB   Initial Version.
+
+with Report;
+procedure C433001 is
+
+    type Color_Type is (Red, Orange, Yellow, Green, Blue, Indigo, Violet);
+
+    type Array_1 is array (Positive range <>) of Integer;
+
+    subtype Sub_1_1 is Array_1 (Report.Ident_Int(1) .. Report.Ident_Int(3));
+    subtype Sub_1_2 is Array_1 (Report.Ident_Int(3) .. Report.Ident_Int(5));
+    subtype Sub_1_3 is Array_1 (Report.Ident_Int(5) .. Report.Ident_Int(9));
+
+    type Array_2 is array (Color_Type range <>) of Integer;
+
+    subtype Sub_2_1 is Array_2 (Color_Type'Val(Report.Ident_Int(0)) ..
+                                Color_Type'Val(Report.Ident_Int(2)));
+                                                 -- Red .. Yellow
+    subtype Sub_2_2 is Array_2 (Color_Type'Val(Report.Ident_Int(3)) ..
+                                Color_Type'Val(Report.Ident_Int(6)));
+                                                 -- Green .. Violet
+    type Array_3 is array (Color_Type range <>, Positive range <>) of Integer;
+
+    subtype Sub_3_1 is Array_3 (Color_Type'Val(Report.Ident_Int(0)) ..
+                                Color_Type'Val(Report.Ident_Int(2)),
+                                Report.Ident_Int(3) .. Report.Ident_Int(5));
+                                                 -- Red .. Yellow, 3 .. 5
+    subtype Sub_3_2 is Array_3 (Color_Type'Val(Report.Ident_Int(1)) ..
+                                Color_Type'Val(Report.Ident_Int(3)),
+                                Report.Ident_Int(6) .. Report.Ident_Int(8));
+                                                 -- Orange .. Green, 6 .. 8
+
+    procedure Check_1 (Obj : Array_1; Low, High : Integer;
+                       First_Component, Second_Component,
+                           Last_Component : Integer;
+                       Test_Case : Character) is
+    begin
+        if Obj'First /= Low then
+           Report.Failed ("Low bound incorrect (" & Test_Case & ")");
+        end if;
+        if Obj'Last /= High then
+           Report.Failed ("High bound incorrect (" & Test_Case & ")");
+        end if;
+        if Obj(Low) /= First_Component then
+           Report.Failed ("First Component incorrect (" & Test_Case & ")");
+        end if;
+        if Obj(Low+1) /= Second_Component then
+           Report.Failed ("First Component incorrect (" & Test_Case & ")");
+        end if;
+        if Obj(High) /= Last_Component then
+           Report.Failed ("First Component incorrect (" & Test_Case & ")");
+        end if;
+    end Check_1;
+
+    procedure Check_2 (Obj : Array_2; Low, High : Color_Type;
+                       First_Component, Second_Component,
+                           Last_Component : Integer;
+                       Test_Case : Character) is
+    begin
+        if Obj'First /= Low then
+           Report.Failed ("Low bound incorrect (" & Test_Case & ")");
+        end if;
+        if Obj'Last /= High then
+           Report.Failed ("High bound incorrect (" & Test_Case & ")");
+        end if;
+        if Obj(Low) /= First_Component then
+           Report.Failed ("First Component incorrect (" & Test_Case & ")");
+        end if;
+        if Obj(Color_Type'Succ(Low)) /= Second_Component then
+           Report.Failed ("First Component incorrect (" & Test_Case & ")");
+        end if;
+        if Obj(High) /= Last_Component then
+           Report.Failed ("First Component incorrect (" & Test_Case & ")");
+        end if;
+    end Check_2;
+
+    procedure Check_3 (Test_Obj, Check_Obj : Array_3;
+                       Low_1, High_1 : Color_Type;
+                       Low_2, High_2 : Integer;
+                       Test_Case : Character) is
+    begin
+        if Test_Obj'First(1) /= Low_1 then
+           Report.Failed ("Low bound for dimension 1 incorrect (" &
+                Test_Case & ")");
+        end if;
+        if Test_Obj'Last(1) /= High_1 then
+           Report.Failed ("High bound for dimension 1 incorrect (" &
+                Test_Case & ")");
+        end if;
+        if Test_Obj'First(2) /= Low_2 then
+           Report.Failed ("Low bound for dimension 2 incorrect (" &
+                Test_Case & ")");
+        end if;
+        if Test_Obj'Last(2) /= High_2 then
+           Report.Failed ("High bound for dimension 2 incorrect (" &
+                Test_Case & ")");
+        end if;
+        if Test_Obj /= Check_Obj then
+           Report.Failed ("Components incorrect (" & Test_Case & ")");
+        end if;
+    end Check_3;
+
+    procedure Subtest_Check_1 (Obj : Sub_1_3;
+                               First_Component, Second_Component,
+                                        Last_Component : Integer;
+                               Test_Case : Character) is
+    begin
+        Check_1 (Obj, 5, 9, First_Component, Second_Component, Last_Component,
+                 Test_Case);
+    end Subtest_Check_1;
+
+    procedure Subtest_Check_2 (Obj : Sub_2_2;
+                               First_Component, Second_Component,
+                                        Last_Component : Integer;
+                               Test_Case : Character) is
+    begin
+        Check_2 (Obj, Green, Violet, First_Component, Second_Component,
+                 Last_Component, Test_Case);
+    end Subtest_Check_2;
+
+    procedure Subtest_Check_3 (Obj : Sub_3_2;
+                               Test_Case : Character) is
+    begin
+        Check_3 (Obj, Obj, Orange, Green, 6, 8, Test_Case);
+    end Subtest_Check_3;
+
+begin
+
+    Report.Test ("C433001",
+                 "Check that an others choice is allowed in an array " &
+                 "aggregate whose applicable index constraint is dynamic. " &
+                 "Also check index choices are within the applicable index " &
+                 "constraint for array aggregates with others choices");
+
+    -- Check with a qualified expression:
+    Check_1 (Sub_1_1'(2, 3, others => 4), Low => 1, High => 3,
+             First_Component => 2, Second_Component => 3, Last_Component => 4,
+             Test_Case => 'A');
+
+    Check_2 (Sub_2_1'(1, others => Report.Ident_Int(6)),
+             Low => Red, High => Yellow,
+             First_Component => 1, Second_Component => 6, Last_Component => 6,
+             Test_Case => 'B');
+
+    Check_3 (Sub_3_1'((1, others => 3), others => (2, 4, others => 6)),
+             Check_Obj => ((1, 3, 3), (2, 4, 6), (2, 4, 6)),
+             Low_1 => Red, High_1 => Yellow, Low_2 => 3, High_2 => 5,
+             Test_Case => 'C');
+
+    -- Check that the others clause does not need to represent any components:
+    Check_1 (Sub_1_2'(5, 6, 8, others => 10), Low => 3, High => 5,
+             First_Component => 5, Second_Component => 6, Last_Component => 8,
+             Test_Case => 'D');
+
+    -- Check named choices are allowed:
+    Check_1 (Sub_1_1'(2 => Report.Ident_Int(-1), others => 8),
+             Low => 1, High => 3,
+             First_Component => 8, Second_Component => -1, Last_Component => 8,
+             Test_Case => 'E');
+
+    -- Check named choices and formal parameters:
+    Subtest_Check_1 ((6 => 4, 8 => 86, others => 1),
+             First_Component => 1, Second_Component => 4, Last_Component => 1,
+             Test_Case => 'F');
+
+    Subtest_Check_2 ((Green => Report.Ident_Int(88), Violet => 89,
+             Indigo => Report.Ident_Int(42), Blue => 0, others => -1),
+             First_Component => 88, Second_Component => 0, Last_Component => 89,
+             Test_Case => 'G');
+
+    Subtest_Check_3 ((Yellow => (7 => 0, others => 10), others => (1, 2, 3)),
+             Test_Case => 'H');
+
+    -- Check object declarations and assignment:
+    declare
+        Var : Sub_1_2 := (4, 36, others => 86);
+    begin
+        Check_1 (Var, Low => 3, High => 5,
+             First_Component => 4, Second_Component => 36,
+             Last_Component => 86,
+             Test_Case => 'I');
+        Var := (5 => 415, others => Report.Ident_Int(1522));
+        Check_1 (Var, Low => 3, High => 5,
+             First_Component => 1522, Second_Component => 1522,
+             Last_Component => 415,
+             Test_Case => 'J');
+    end;
+
+    -- Check positional aggregates that are too long:
+    begin
+        Subtest_Check_2 ((Report.Ident_Int(88), 89, 90, 91, 92, others => 93),
+             First_Component => 88, Second_Component => 89,
+             Last_Component => 91,
+             Test_Case => 'K');
+        Report.Failed ("Constraint_Error not raised by positional " &
+                       "aggregate with too many choices (K)");
+    exception
+        when Constraint_Error => null; -- Expected exception.
+    end;
+
+    begin
+        Subtest_Check_3 (((0, others => 10), (2, 3, others => 4),
+             (5, 6, 8, others => 10), (1, 4, 7),  others => (1, 2, 3)),
+             Test_Case => 'L');
+        Report.Failed ("Constraint_Error not raised by positional " &
+                       "aggregate with too many choices (L)");
+    exception
+        when Constraint_Error => null; -- Expected exception.
+    end;
+
+    -- Check named aggregates with choices in the index subtype but not in the
+    -- applicable index constraint:
+
+    begin
+        Subtest_Check_1 ((5 => Report.Ident_Int(88), 8 => 89,
+             10 => 66, -- 10 not in applicable index constraint
+             others => 93),
+             First_Component => 88, Second_Component => 93,
+             Last_Component => 93,
+             Test_Case => 'M');
+        Report.Failed ("Constraint_Error not raised by aggregate choice " &
+                       "index outside of applicable index constraint (M)");
+    exception
+        when Constraint_Error => null; -- Expected exception.
+    end;
+
+    begin
+        Subtest_Check_2 (
+             (Yellow => 23, -- Yellow not in applicable index constraint.
+             Blue => 16, others => 77),
+             First_Component => 77, Second_Component => 16,
+             Last_Component => 77,
+             Test_Case => 'N');
+        Report.Failed ("Constraint_Error not raised by aggregate choice " &
+                       "index outside of applicable index constraint (N)");
+    exception
+        when Constraint_Error => null; -- Expected exception.
+    end;
+
+    begin
+        Subtest_Check_3 ((Orange => (0, others => 10),
+             Blue => (2, 3, others => 4), -- Blue not in applicable index cons.
+             others => (1, 2, 3)),
+             Test_Case => 'P');
+        Report.Failed ("Constraint_Error not raised by aggregate choice " &
+                       "index outside of applicable index constraint (P)");
+    exception
+        when Constraint_Error => null; -- Expected exception.
+    end;
+
+    begin
+        Subtest_Check_3 ((Orange => (6 => 0, others => Report.Ident_Int(10)),
+             Green => (8 => 2, 4 => 3, others => 7),
+                -- 4 not in applicable index cons.
+             others => (1, 2, 3, others => Report.Ident_Int(10))),
+             Test_Case => 'Q');
+        Report.Failed ("Constraint_Error not raised by aggregate choice " &
+                       "index outside of applicable index constraint (Q)");
+    exception
+        when Constraint_Error => null; -- Expected exception.
+    end;
+
+    Report.Result;
+
+end C433001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c44003d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c44003d.ada
new file mode 100644
index 000000000..57ad7c4d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c44003d.ada
@@ -0,0 +1,188 @@
+-- C44003D.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 FOR CORRECT PRECEDENCE OF PREDEFINED AND OVERLOADED
+--     OPERATIONS ON PREDEFINED TYPE FLOAT, USER-DEFINED TYPES, AND
+--     ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF TYPE FLOAT.
+
+-- HISTORY:
+--     RJW 10/13/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C44003D IS
+
+BEGIN
+     TEST ("C44003D", "CHECK FOR CORRECT PRECEDENCE OF PREDEFINED " &
+                      "AND OVERLOADED OPERATIONS ON PREDEFINED TYPE " &
+                      "FLOAT, USER-DEFINED TYPES, AND ONE-DIMEN" &
+                      "SIONAL ARRAYS WITH COMPONENTS OF TYPE FLOAT");
+
+----- PREDEFINED FLOAT:
+
+     DECLARE
+          F1 : FLOAT := 1.0;
+          F2 : FLOAT := 2.0;
+          F5 : FLOAT := 5.0;
+
+          FUNCTION "OR" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
+          BEGIN
+               RETURN 4.5;
+          END "OR";
+
+          FUNCTION "<" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
+          BEGIN
+               RETURN 5.5;
+          END "<";
+
+          FUNCTION "-" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
+          BEGIN
+               RETURN 6.5;
+          END "-";
+
+          FUNCTION "+" (RIGHT : FLOAT) RETURN FLOAT IS
+          BEGIN
+               RETURN 7.5;
+          END "+";
+
+          FUNCTION "*" (LEFT, RIGHT : FLOAT) RETURN FLOAT IS
+          BEGIN
+               RETURN 8.5;
+          END "*";
+
+          FUNCTION "NOT" (RIGHT : FLOAT) RETURN FLOAT IS
+          BEGIN
+               RETURN 9.5;
+          END "NOT";
+
+     BEGIN
+          IF NOT (-ABS F1 + F2 / F1 + F5 ** 2 =  26.0 AND
+                  F1 > 0.0 AND
+                  - F2 * F2 ** 3 = -8.5) THEN
+               FAILED ("INCORRECT RESULT - 1");
+          END IF;
+
+          IF (F1 OR NOT F2 < F1 - F5 * F5 ** 3) /= 4.5 THEN
+               FAILED ("INCORRECT RESULT - 2");
+          END IF;
+     END;
+
+----- USER-DEFINED TYPE:
+
+     DECLARE
+          TYPE USR IS DIGITS 5;
+
+          F1 : USR := 1.0;
+          F2 : USR := 2.0;
+          F5 : USR := 5.0;
+
+          FUNCTION "AND" (LEFT, RIGHT : USR) RETURN USR IS
+          BEGIN
+               RETURN 4.5;
+          END "AND";
+
+          FUNCTION ">=" (LEFT, RIGHT : USR) RETURN USR IS
+          BEGIN
+               RETURN 5.5;
+          END ">=";
+
+          FUNCTION "+" (LEFT, RIGHT : USR) RETURN USR IS
+          BEGIN
+               RETURN 6.5;
+          END "+";
+
+          FUNCTION "-" (RIGHT : USR) RETURN USR IS
+          BEGIN
+               RETURN 7.5;
+          END "-";
+
+          FUNCTION "/" (LEFT, RIGHT : USR) RETURN USR IS
+          BEGIN
+               RETURN 8.5;
+          END "/";
+
+          FUNCTION "**" (LEFT, RIGHT : USR) RETURN USR IS
+          BEGIN
+               RETURN 9.5;
+          END "**";
+     BEGIN
+          IF +F5 - F2 * F1 ** 2 /= 3.0 OR
+             ABS F1 <= 0.0 OR
+             - F2 * F2 ** 3.0 /= 7.5 THEN
+               FAILED ("INCORRECT RESULT - 3");
+          END IF;
+
+          IF (F1 AND F2 >= F1 + F5 / F5 ** 3) /= 4.5 THEN
+               FAILED ("INCORRECT RESULT - 4");
+          END IF;
+     END;
+
+----- ARRAYS:
+
+     DECLARE
+          TYPE ARR IS ARRAY (INTEGER RANGE <>) OF FLOAT;
+
+          SUBTYPE SARR IS ARR (1 .. 3);
+
+          F1 : SARR := (OTHERS => 1.0);
+          F2 : SARR := (OTHERS => 2.0);
+          F5 : SARR := (OTHERS => 5.0);
+
+          FUNCTION "XOR" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => 4.5);
+          END "XOR";
+
+          FUNCTION "<=" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => 5.5);
+          END "<=";
+
+          FUNCTION "&" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => 6.5);
+          END "&";
+
+          FUNCTION "MOD" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => 8.5);
+          END "MOD";
+
+          FUNCTION "ABS" (RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => 9.5);
+          END "ABS";
+     BEGIN
+          IF (ABS F1 <= F2 & F5 MOD F1 XOR F1) /= (1 .. 3 => 4.5) THEN
+               FAILED ("INCORRECT RESULT - 5");
+          END IF;
+
+          IF (ABS F1 & F2) /= (1 .. 3 => 6.5) OR
+             (F1 MOD F2 <= F5) /= (1 .. 3 => 5.5) THEN
+               FAILED ("INCORRECT RESULT - 6");
+          END IF;
+     END;
+
+     RESULT;
+END C44003D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c44003f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c44003f.ada
new file mode 100644
index 000000000..11121b20c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c44003f.ada
@@ -0,0 +1,143 @@
+-- C44003F.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 FOR CORRECT PRECEDENCE OF PRE-DEFINED AND OVERLOADED
+--     OPERATIONS ON ENUMERATION TYPES OTHER THAN BOOLEAN OR CHARACTER
+--     AND ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF SUCH TYPES.
+
+-- HISTORY:
+--     RJW 10/13/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C44003F IS
+
+     TYPE ENUM IS (ZERO, ONE, TWO, THREE, FOUR, FIVE);
+
+BEGIN
+     TEST ("C44003F", "CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED " &
+                      "AND OVERLOADED OPERATIONS ON ENUMERATION " &
+                      "TYPES OTHER THAN BOOLEAN OR CHARACTER AND " &
+                      "ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF " &
+                      "SUCH TYPES");
+
+
+----- ENUMERATION TYPE:
+
+     DECLARE
+          E1 : ENUM := ONE;
+          E2 : ENUM := TWO;
+          E5 : ENUM := FIVE;
+
+          FUNCTION "AND" (LEFT, RIGHT : ENUM) RETURN ENUM IS
+          BEGIN
+               RETURN ZERO;
+          END "AND";
+
+          FUNCTION "<" (LEFT, RIGHT : ENUM) RETURN ENUM IS
+          BEGIN
+               RETURN THREE;
+          END "<";
+
+          FUNCTION "-" (LEFT, RIGHT : ENUM) RETURN ENUM IS
+          BEGIN
+               RETURN ENUM'VAL (ENUM'POS (LEFT) - ENUM'POS (RIGHT));
+          END "-";
+
+          FUNCTION "+" (RIGHT : ENUM) RETURN ENUM IS
+          BEGIN
+               RETURN RIGHT;
+          END "+";
+
+          FUNCTION "*" (LEFT, RIGHT : ENUM) RETURN ENUM IS
+          BEGIN
+               RETURN ENUM'VAL (ENUM'POS (LEFT) * ENUM'POS (RIGHT));
+          END "*";
+
+          FUNCTION "**" (LEFT, RIGHT : ENUM) RETURN ENUM IS
+          BEGIN
+               RETURN ENUM'VAL (ENUM'POS (LEFT) ** ENUM'POS (RIGHT));
+          END "**";
+
+     BEGIN
+          IF NOT (+E1 < E2) OR NOT (E2 >= +E2) OR NOT (E5 = +FIVE) THEN
+               FAILED ("INCORRECT RESULT - 1");
+          END IF;
+
+          IF (E5 ** E1 AND E2) /= (E5 - E1 * E5 ** E1) THEN
+               FAILED ("INCORRECT RESULT - 2");
+          END IF;
+
+     END;
+
+----- ARRAYS:
+
+     DECLARE
+          TYPE ARR IS ARRAY (INTEGER RANGE <>) OF ENUM;
+
+          SUBTYPE SARR IS ARR (1 .. 3);
+
+          E1 : SARR := (OTHERS => ONE);
+          E2 : SARR := (OTHERS => TWO);
+          E5 : SARR := (OTHERS => FIVE);
+
+          FUNCTION "XOR" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => ZERO);
+          END "XOR";
+
+          FUNCTION "<=" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => THREE);
+          END "<=";
+
+          FUNCTION "+" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => ZERO);
+          END "+";
+
+          FUNCTION "MOD" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => THREE);
+          END "MOD";
+
+          FUNCTION "**" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => FOUR);
+          END "**";
+     BEGIN
+          IF (E5 ** E1 <= E2 + E5 MOD E1 XOR E1) /= (1 .. 3 => ZERO)
+             THEN
+               FAILED ("INCORRECT RESULT - 3");
+          END IF;
+
+          IF (E5 ** E1 & E2) /= (FOUR, FOUR, FOUR, TWO, TWO, TWO) OR
+             (E1 MOD E2 <= E5) /= (1 .. 3 => THREE) THEN
+               FAILED ("INCORRECT RESULT - 4");
+          END IF;
+     END;
+
+     RESULT;
+
+END C44003F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c44003g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c44003g.ada
new file mode 100644
index 000000000..6825cc218
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c44003g.ada
@@ -0,0 +1,134 @@
+-- C44003G.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 FOR CORRECT PRECEDENCE OF PRE-DEFINED AND OVERLOADED
+--     OPERATIONS ON BOOLEAN TYPES AND ONE-DIMENSIONAL ARRAYS WITH
+--     COMPONENTS OF TYPE BOOLEAN.
+
+-- HISTORY:
+--     RJW 10/13/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C44003G IS
+
+BEGIN
+     TEST ("C44003G", "CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED " &
+                      "AND OVERLOADED OPERATIONS ON BOOLEAN TYPES " &
+                      "AND ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF " &
+                      "TYPE BOOLEAN");
+
+----- PREDEFINED BOOLEAN:
+
+     DECLARE
+          T : BOOLEAN := TRUE;
+          F : BOOLEAN := FALSE;
+
+          FUNCTION "AND" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               RETURN FALSE;
+          END "AND";
+
+          FUNCTION "<" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               RETURN TRUE;
+          END "<";
+
+          FUNCTION "-" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               RETURN TRUE;
+          END "-";
+
+          FUNCTION "+" (RIGHT : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               RETURN NOT RIGHT;
+          END "+";
+
+          FUNCTION "*" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               RETURN FALSE;
+          END "*";
+
+          FUNCTION "**" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               RETURN TRUE;
+          END "**";
+
+     BEGIN
+          IF NOT (+T = F) OR T /= +F OR (TRUE AND FALSE ** TRUE) OR
+             NOT (+T < F) OR NOT (T - F * T) OR (NOT T - F XOR + F - F)
+             THEN
+               FAILED ("INCORRECT RESULT - 1");
+          END IF;
+
+     END;
+
+----- ARRAYS:
+
+     DECLARE
+          TYPE ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+
+          SUBTYPE SARR IS ARR (1 .. 3);
+
+          T : SARR := (OTHERS => TRUE);
+          F : SARR := (OTHERS => FALSE);
+
+          FUNCTION "XOR" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => FALSE);
+          END "XOR";
+
+          FUNCTION "<=" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => TRUE);
+          END "<=";
+
+          FUNCTION "+" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => FALSE);
+          END "+";
+
+          FUNCTION "MOD" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => TRUE);
+          END "MOD";
+
+          FUNCTION "**" (LEFT, RIGHT : ARR) RETURN ARR IS
+          BEGIN
+               RETURN (1 .. 3 => FALSE);
+          END "**";
+     BEGIN
+          IF (F ** T <= F + T MOD T XOR T) /= (1 .. 3 => FALSE)
+             THEN
+               FAILED ("INCORRECT RESULT - 2");
+          END IF;
+
+          IF F ** T & T /= NOT T & T OR
+             (T MOD F <= T) /= (1 .. 3 => TRUE) THEN
+               FAILED ("INCORRECT RESULT - 3");
+          END IF;
+     END;
+
+     RESULT;
+END C44003G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c450001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c450001.a
new file mode 100644
index 000000000..e398ffc63
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c450001.a
@@ -0,0 +1,434 @@
+-- C450001.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 operations on modular types perform correctly.
+--
+--     Check that loops over the range of a modular type do not over or
+--     under run the loop.
+--
+-- TEST DESCRIPTION:
+--     Check logical and arithmetic operations.
+--     (Attributes are tested elsewhere)
+--     Checks to make sure that:
+--        for X in Mod_Type loop
+--     doesn't do something silly like infinite loop.
+--
+--
+-- CHANGE HISTORY:
+--      20 SEP 95   SAIC   Initial version
+--      20 FEB 96   SAIC   Added underrun cases for 2.1
+--
+--!
+
+----------------------------------------------------------------- C450001_0
+
+package C450001_0 is
+
+  type Unsigned_8_Bit is mod 2**8;
+
+  Shy_By_One : constant := 2**8-1;
+
+  Heavy_By_Two : constant := 2**8+2;
+
+  type Unsigned_Edge_8 is mod Shy_By_One;
+
+  type Unsigned_Over_8 is mod Heavy_By_Two;
+
+  procedure Loop_Check;
+
+ -- embed some calls to Report.Ident_Int:
+
+  function ID( U8B: Unsigned_8_Bit )  return Unsigned_8_Bit;
+  function ID( UEB: Unsigned_Edge_8 ) return Unsigned_Edge_8;
+  function ID( UOB: Unsigned_Over_8 ) return Unsigned_Over_8;
+
+end C450001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body C450001_0 is
+
+  procedure Loop_Check is
+    Counter_Check : Natural := 0;
+  begin
+    for Ever in Unsigned_8_Bit loop
+      Counter_Check := Report.Ident_Int(Counter_Check) + 1;
+      if Counter_Check > 2**8 then
+        Report.Failed("Unsigned_8_Bit loop overrun");
+        exit;
+      end if;
+    end loop;
+
+    if Counter_Check < 2**8 then
+      Report.Failed("Unsigned_8_Bit loop underrun");
+    end if;
+
+    Counter_Check := 0;
+
+    for Never in Unsigned_Edge_8 loop
+      Counter_Check := Report.Ident_Int(Counter_Check) + 1;
+      if Counter_Check > Shy_By_One then
+        Report.Failed("Unsigned_Edge_8 loop overrun");
+        exit;
+      end if;
+    end loop;
+
+    if Counter_Check < Shy_By_One then
+      Report.Failed("Unsigned_Edge_8 loop underrun");
+    end if;
+
+    Counter_Check := 0;
+
+    for Getful in reverse Unsigned_Over_8 loop
+      Counter_Check := Report.Ident_Int(Counter_Check) + 1;
+      if Counter_Check > Heavy_By_Two then
+        Report.Failed("Unsigned_Over_8 loop overrun");
+        exit;
+      end if;
+    end loop;
+
+    if Counter_Check < Heavy_By_Two then
+      Report.Failed("Unsigned_Over_8 loop underrun");
+    end if;
+
+  end Loop_Check;
+
+  function ID( U8B: Unsigned_8_Bit )  return Unsigned_8_Bit is
+  begin
+    return Unsigned_8_Bit(Report.Ident_Int(Integer(U8B)));
+  end ID;
+
+  function ID( UEB: Unsigned_Edge_8 ) return Unsigned_Edge_8 is
+  begin
+    return Unsigned_Edge_8(Report.Ident_Int(Integer(UEB)));
+  end ID;
+
+  function ID( UOB: Unsigned_Over_8 ) return Unsigned_Over_8 is
+  begin
+    return Unsigned_Over_8(Report.Ident_Int(Integer(UOB)));
+  end ID;
+
+end C450001_0;
+
+------------------------------------------------------------------- C450001
+
+with Report;
+with C450001_0;
+with TCTouch;
+procedure C450001 is
+  use C450001_0;
+
+  BR : constant String := " produced the wrong result";
+
+  procedure Is_T(B:Boolean;S:String) renames TCTouch.Assert;
+  procedure Is_F(B:Boolean;S:String) renames TCTouch.Assert_Not;
+
+  Whole_8_A, Whole_8_B, Whole_8_C : C450001_0.Unsigned_8_Bit;
+
+  Short_8_A, Short_8_B, Short_8_C : C450001_0.Unsigned_Edge_8;
+
+  Over_8_A, Over_8_B, Over_8_C : C450001_0.Unsigned_Over_8;
+
+begin  -- Main test procedure. C450001
+
+  Report.Test ("C450001", "Check that operations on modular types " &
+                          "perform correctly." );
+
+
+  -- the cases for the whole 8 bit type are pretty simple
+
+  Whole_8_A :=                             2#00000000#;
+  Whole_8_B :=                             2#11111111#;
+
+  Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#00000000#,"8 bit and" & BR);
+  Is_T((ID(Whole_8_A)  or ID(Whole_8_B)) = 2#11111111#,"8 bit  or" & BR);
+  Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#11111111#,"8 bit xor" & BR);
+
+  Whole_8_A :=                             2#00001111#;
+  Whole_8_B :=                             2#11111111#;
+
+  Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#00001111#,"8 bit and" & BR);
+  Is_T((ID(Whole_8_A)  or ID(Whole_8_B)) = 2#11111111#,"8 bit  or" & BR);
+  Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#11110000#,"8 bit xor" & BR);
+
+  Whole_8_A :=                             2#10101010#;
+  Whole_8_B :=                             2#11110000#;
+
+  Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#10100000#,"8 bit and" & BR);
+  Is_T((ID(Whole_8_A)  or ID(Whole_8_B)) = 2#11111010#,"8 bit  or" & BR);
+  Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#01011010#,"8 bit xor" & BR);
+
+  -- the cases for the partial 8 bit type involve subtracting the modulus
+  -- from results that exceed the modulus.
+  -- hence, any of the following operations that exceed 2#11111110# must
+  -- have 2#11111111# subtracted from the result; i.e. where you would
+  -- expect to see 2#11111111# as in the above operations, the correct
+  -- result will be 2#00000000#.  Note that 2#11111111# is not a legal
+  -- value of type C450001_0.Unsigned_Edge_8.
+
+  Short_8_A :=                             2#11100101#;
+  Short_8_B :=                             2#00011111#;
+
+  Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#00000101#,"8 short and 1" & BR);
+  Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#00000000#,"8 short  or 1" & BR);
+  Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#11111010#,"8 short xor 1" & BR);
+
+  Short_8_A :=                             2#11110000#;
+  Short_8_B :=                             2#11111110#;
+
+  Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#11110000#,"8 short and 2" & BR);
+  Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#11111110#,"8 short  or 2" & BR);
+  Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#00001110#,"8 short xor 2" & BR);
+
+  Short_8_A :=                             2#10101010#;
+  Short_8_B :=                             2#01010101#;
+
+  Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#00000000#,"8 short and 3" & BR);
+  Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#00000000#,"8 short  or 3" & BR);
+  Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#00000000#,"8 short xor 3" & BR);
+
+  Short_8_A :=                             2#10101010#;
+  Short_8_B :=                             2#11111110#;
+
+  Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#10101010#,"8 short and 4" & BR);
+  Is_T((ID(Short_8_A)  or ID(Short_8_B)) = 2#11111110#,"8 short  or 4" & BR);
+  Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#01010100#,"8 short xor 4" & BR);
+
+  -- the cases for the over 8 bit type have similar issues to the short type
+  -- however the bit patterns are a little different.  The rule is to subtract
+  -- the modulus (258) from any resulting value equal or greater than the
+  -- modulus       -- note that 258 =    2#100000010#
+
+  Over_8_A :=                            2#100000000#;
+  Over_8_B :=                            2#011111111#;
+
+  Is_T((ID(Over_8_A) and ID(Over_8_B)) = 2#000000000#,"8 over and" & BR);
+  Is_T((ID(Over_8_A)  or ID(Over_8_B)) = 2#011111101#,"8 over  or" & BR);
+  Is_T((ID(Over_8_A) xor ID(Over_8_B)) = 2#011111101#,"8 over xor" & BR);
+
+  Over_8_A :=                            2#100000001#;
+  Over_8_B :=                            2#011111111#;
+
+  Is_T((ID(Over_8_A) and ID(Over_8_B)) = 2#000000001#,"8 over and" & BR);
+  Is_T((ID(Over_8_A)  or ID(Over_8_B)) = 2#011111101#,"8 over  or" & BR);
+  Is_T((ID(Over_8_A) xor ID(Over_8_B)) = 2#011111100#,"8 over xor" & BR);
+
+
+
+  Whole_8_A := 128;
+  Whole_8_B := 255;
+
+  Is_T(ID(Whole_8_A) /= ID(Whole_8_B), "8 /=" & BR);
+  Is_F(ID(Whole_8_A)  = ID(Whole_8_B), "8  =" & BR);
+
+  Is_T(ID(Whole_8_A) <= ID(Whole_8_B), "8 <=" & BR);
+  Is_T(ID(Whole_8_A) <  ID(Whole_8_B), "8 < " & BR);
+
+  Is_F(ID(Whole_8_A) >= ID(Whole_8_B), "8 >=" & BR);
+  Is_T(ID(Whole_8_A) >  ID(Whole_8_B + 7), "8 > " & BR);
+
+  Is_T(ID(Whole_8_A)     in ID(100)..ID(200), "8 in" & BR);
+  Is_F(ID(Whole_8_A) not in ID(100)..ID(200), "8 not in" & BR);
+
+  Is_F(ID(Whole_8_A)     in ID(200)..ID(250), "8 in" & BR);
+  Is_T(ID(Whole_8_A) not in ID(200)..ID(250), "8 not in" & BR);
+
+  Short_8_A := 127;
+  Short_8_B := 254;
+
+  Is_T(ID(Short_8_A) /= ID(Short_8_B), "short 8 /=" & BR);
+  Is_F(ID(Short_8_A)  = ID(Short_8_B), "short 8  =" & BR);
+
+  Is_T(ID(Short_8_A) <= ID(Short_8_B), "short 8 <=" & BR);
+  Is_T(ID(Short_8_A) <  ID(Short_8_B), "short 8 < " & BR);
+
+  Is_F(ID(Short_8_A) >= ID(Short_8_B), "short 8 >=" & BR);
+  Is_F(ID(Short_8_A) >  ID(Short_8_B), "short 8 > " & BR);
+
+  Is_T(ID(Short_8_A)     in ID(100)..ID(200), "8 in" & BR);
+  Is_F(ID(Short_8_A) not in ID(100)..ID(200), "8 not in" & BR);
+
+  Is_F(ID(Short_8_A)     in ID(200)..ID(250), "8 in" & BR);
+  Is_T(ID(Short_8_A) not in ID(200)..ID(250), "8 not in" & BR);
+
+
+  Whole_8_A := 1;
+  Whole_8_B := 254;
+  Short_8_A := 1;
+  Short_8_B := 2;
+
+  Whole_8_C := ID(Whole_8_A) + ID(Whole_8_B);
+  Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 binary + 1" & BR);
+
+  Whole_8_C := Whole_8_C + ID(Whole_8_A);
+  Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'First, "8 binary + 2" & BR);
+
+  Whole_8_C := ID(Whole_8_A) - ID(Whole_8_A);
+  Is_T(Whole_8_C = 0, "8 binary -" & BR);
+
+  Whole_8_C := Whole_8_C - ID(Whole_8_A);
+  Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 binary + 3" & BR);
+
+  Short_8_C := ID(Short_8_A) + ID(C450001_0.Unsigned_Edge_8'Last);
+  Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'First, "Short binary + 1" & BR);
+
+  Short_8_C := Short_8_A + ID(Short_8_A);
+  Is_T(Short_8_C = ID(Short_8_B), "Short binary + 2" & BR);
+
+  Short_8_C := ID(Short_8_A) - ID(Short_8_A);
+  Is_T(Short_8_C = 0, "Short 8 binary -" & BR);
+
+  Short_8_C := Short_8_C - ID(Short_8_A);
+  Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'Last, "Short binary + 3" & BR);
+
+
+  Whole_8_C := ( + ID(Whole_8_B) );
+  Is_T(Whole_8_C = 254, "8 unary +" & BR);
+
+  Whole_8_C := ( - ID(Whole_8_A) );
+  Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 unary -" & BR);
+
+  Whole_8_C := ( - ID(0) );
+  Is_T(Whole_8_C = 0, "8 unary -0" & BR);
+
+  Short_8_C := ( + ID(C450001_0.Unsigned_Edge_8'Last) );
+  Is_T(Short_8_C = 254, "Short 8 unary +" & BR);
+
+  Short_8_C := ( - ID(Short_8_A) );
+  Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'Last, "Short 8 unary -" & BR);
+
+
+  Whole_8_A := 20;
+  Whole_8_B := 255;
+
+  Whole_8_C := ID(Whole_8_A) * ID(Whole_8_B); -- 5100 = 19*256 + 236 (256-20)
+  Is_T(Whole_8_C = 236, "8 *" & BR);
+
+  Short_8_A := 9;
+  Short_8_B := 254;
+
+  Short_8_C := ID(Short_8_A) * ID(Short_8_B); -- 2286 = 8*255 + 246 (255-9)
+  Is_T(Short_8_C = 246, "short 8 *" & BR);
+
+  Over_8_A := 12;
+  Over_8_B := 86;
+
+  Over_8_C := ID(Over_8_A) * ID(Over_8_B); -- 1032 = 4*258 + 0
+  Is_T(Over_8_C = 0, "over 8 *" & BR);
+
+
+  Whole_8_A := 255;
+  Whole_8_B := 4;
+
+  Whole_8_C := ID(Whole_8_A) / ID(Whole_8_B);
+  Is_T(Whole_8_C = 63, "8 /" & BR);
+
+  Short_8_A := 253;
+  Short_8_B := 127;
+
+  Short_8_C := ID(Short_8_A) / ID(Short_8_B);
+  Is_T(Short_8_C = 1, "short 8 / 1" & BR);
+
+  Short_8_C := ID(Short_8_A) / ID(126);
+  Is_T(Short_8_C = 2, "short 8 / 2" & BR);
+
+
+  Whole_8_A := 255;
+  Whole_8_B := 254;
+
+  Whole_8_C := ID(Whole_8_A) rem ID(Whole_8_B);
+  Is_T(Whole_8_C = 1, "8 rem" & BR);
+
+  Short_8_A := 222;
+  Short_8_B := 111;
+
+  Short_8_C := ID(Short_8_A) rem ID(Short_8_B);
+  Is_T(Short_8_C = 0, "short 8 rem" & BR);
+
+
+  Whole_8_A := 99;
+  Whole_8_B := 9;
+
+  Whole_8_C := ID(Whole_8_A) mod ID(Whole_8_B);
+  Is_T(Whole_8_C = 0, "8 mod" & BR);
+
+  Short_8_A := 254;
+  Short_8_B := 250;
+
+  Short_8_C := ID(Short_8_A) mod ID(Short_8_B);
+  Is_T(Short_8_C = 4, "short 8 mod" & BR);
+
+
+  Whole_8_A := 99;
+
+  Whole_8_C := abs Whole_8_A;
+  Is_T(Whole_8_C = ID(99), "8 abs" & BR);
+
+  Short_8_A := 254;
+
+  Short_8_C := ID( abs Short_8_A );
+  Is_T(Short_8_C = 254, "short 8 abs" & BR);
+
+
+  Whole_8_B :=        2#00001111#;
+
+  Whole_8_C := not Whole_8_B;
+  Is_T(Whole_8_C = ID(2#11110000#), "8 not" & BR);
+
+  Short_8_B :=     2#00001111#;                      -- 15
+
+  Short_8_C := ID( not Short_8_B );                  -- 254 - 15
+  Is_T(Short_8_C = 2#11101111#, "short 8 not" & BR); -- 239
+
+
+  Whole_8_A := 2;
+
+  Whole_8_C := Whole_8_A ** 7;
+  Is_T(Whole_8_C = ID(128), "2 ** 7, whole 8" & BR);
+
+  Whole_8_C := Whole_8_A ** 9;
+  Is_T(Whole_8_C = ID(0), "2 ** 9, whole 8" & BR);
+
+  Short_8_A := 4;
+
+  Short_8_C := ID( Short_8_A ) ** 4;
+  Is_T(Short_8_C = 1, "4 ** 4, short" & BR);
+
+  Over_8_A := 4;
+
+  Over_8_C := ID( Over_8_A ) ** 4;
+  Is_T(Over_8_C = 256, "4 ** 4, over" & BR);
+
+  Over_8_C := ID( Over_8_A ) ** 5; -- 1024 = 3*258 + 250
+  Is_T(Over_8_C = 250, "4 ** 5, over" & BR);
+
+
+  C450001_0.Loop_Check;
+
+  Report.Result;
+
+end C450001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45112a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45112a.ada
new file mode 100644
index 000000000..f18b1be57
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45112a.ada
@@ -0,0 +1,233 @@
+-- C45112A.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 THE RESULT OF A LOGICAL ARRAY OPERATION 
+-- ARE THE BOUNDS OF THE LEFT OPERAND.
+
+-- RJW 2/3/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45112A IS 
+     
+     TYPE ARR IS ARRAY(INTEGER RANGE <>) OF BOOLEAN;
+     A1 : ARR(IDENT_INT(3) .. IDENT_INT(4)) := (TRUE, FALSE);
+     A2 : ARR(IDENT_INT(1) .. IDENT_INT(2)) := (TRUE, FALSE);
+     SUBTYPE CARR IS ARR (IDENT_INT (A1'FIRST) .. IDENT_INT (A1'LAST));
+
+     PROCEDURE CHECK (X : ARR; N1, N2 : STRING) IS
+     BEGIN
+          IF X'FIRST /= A1'FIRST OR X'LAST /= A1'LAST THEN
+               FAILED ( "WRONG BOUNDS FOR " & N1 & " FOR " & N2 );
+          END IF;
+     END CHECK;
+     
+BEGIN
+
+     TEST ( "C45112A", "CHECK THE BOUNDS OF THE RESULT OF LOGICAL " &
+                       "ARRAY OPERATIONS" );
+
+     BEGIN
+          DECLARE
+               AAND : CONSTANT ARR := A1 AND A2;
+               AOR  : CONSTANT ARR := A1 OR A2;
+               AXOR : CONSTANT ARR := A1 XOR A2;          
+          BEGIN
+               CHECK (AAND, "INITIALIZATION OF CONSTANT ARRAY ", 
+                            "'AND'" );
+
+               CHECK (AOR, "INITIALIZATION OF CONSTANT ARRAY ", 
+                            "'OR'" );
+     
+               CHECK (AXOR, "INITIALIZATION OF CONSTANT ARRAY ", 
+                            "'XOR'" );
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED DURING " &
+                        "INTIALIZATIONS" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED DURING " &
+                        "INITIALIZATIONS" );
+     END;
+                              
+     DECLARE
+          PROCEDURE PROC (A : ARR; STR : STRING) IS
+          BEGIN
+               CHECK (A, "FORMAL PARAMETER FOR CONSTRAINED ARRAY", 
+                      STR);
+          END PROC;
+     BEGIN
+          PROC ((A1 AND A2), "'AND'" );
+          PROC ((A1 OR A2), "'OR'" );
+          PROC ((A1 XOR A2), "'XOR'" );
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING TEST FOR FORMAL " &
+                        "PARAMETERS" );
+     END;
+
+     DECLARE
+          FUNCTION FUNCAND RETURN ARR IS
+          BEGIN
+               RETURN A1 AND A2;
+          END FUNCAND;
+
+          FUNCTION FUNCOR RETURN ARR IS
+          BEGIN
+               RETURN A1 OR A2;
+          END FUNCOR;
+     
+          FUNCTION FUNCXOR RETURN ARR IS
+          BEGIN
+               RETURN A1 XOR A2;
+          END FUNCXOR;
+
+     BEGIN
+          CHECK (FUNCAND, "RETURN STATEMENT", "'AND'");
+          CHECK (FUNCOR, "RETURN STATEMENT", "'OR'");
+          CHECK (FUNCXOR, "RETURN STATEMENT", "'XOR'");
+     
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING TEST FOR RETURN " &
+                        "FROM FUNCTION" );
+     END;
+
+     BEGIN
+          DECLARE
+               GENERIC
+                   X : IN ARR;
+               PACKAGE PKG IS 
+                    FUNCTION G RETURN ARR;
+               END PKG;
+     
+               PACKAGE BODY PKG IS
+                    FUNCTION G RETURN ARR IS
+                    BEGIN
+                         RETURN X;
+                    END G;
+               END PKG;
+                         
+               PACKAGE PAND IS NEW PKG(X => A1 AND A2);
+               PACKAGE POR IS NEW PKG(X => A1 OR A2);
+               PACKAGE PXOR IS NEW PKG(X => A1 XOR A2);
+          BEGIN
+               CHECK (PAND.G, "GENERIC FORMAL PARAMETER", "'AND'");
+               CHECK (POR.G, "GENERIC FORMAL PARAMETER", "'OR'");
+               CHECK (PXOR.G, "GENERIC FORMAL PARAMMETER", "'XOR'");
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING GENERIC " &
+                        "INSTANTIATION" );
+     END;
+
+     DECLARE
+          TYPE ACC IS ACCESS ARR;
+          AC : ACC;
+               
+     BEGIN
+          AC :=  NEW ARR'(A1 AND A2);
+          CHECK (AC.ALL, "ALLOCATION", "'AND'");
+          AC :=  NEW ARR'(A1 OR A2);
+          CHECK (AC.ALL, "ALLOCATION", "'OR'");
+          AC :=  NEW ARR'(A1 XOR A2);
+          CHECK (AC.ALL, "ALLOCATION", "'XOR'");
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED ON ALLOCATION" );
+     END;
+
+     BEGIN
+          CHECK (CARR' (A1 AND A2), "QUALIFIED EXPRESSION", "'AND'");
+          CHECK (CARR' (A1 OR A2), "QUALIFIED EXPRESSION", "'OR'");
+          CHECK (CARR' (A1 XOR A2), "QUALIFIED EXPRESSION", "'XOR'");
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED ON QUALIFIED EXPRESSION" );
+     END;
+               
+     DECLARE
+          TYPE REC IS
+               RECORD
+                    RCA : CARR;
+               END RECORD;
+          R1 : REC;
+
+     BEGIN
+          R1 := (RCA => (A1 AND A2));
+          CHECK (R1.RCA, "AGGREGATE", "'AND'");
+          R1 := (RCA => (A1 OR A2));
+          CHECK (R1.RCA, "AGGREGATE", "'OR'");
+          R1 := (RCA => (A1 XOR A2));
+          CHECK (R1.RCA, "AGGREGATE", "'XOR'");
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED ON AGGREGATE" );
+     END;
+                    
+     BEGIN
+          DECLARE
+               TYPE RECDEF IS
+                    RECORD
+                         RCDF1 : CARR := A1 AND A2;
+                         RCDF2 : CARR := A1 OR A2;
+                         RCDF3 : CARR := A1 XOR A2;
+                    END RECORD;
+               RD : RECDEF;
+          BEGIN
+               CHECK (RD.RCDF1, "DEFAULT RECORD", "'AND'");
+               CHECK (RD.RCDF2, "DEFAULT RECORD", "'OR'");
+               CHECK (RD.RCDF3, "DEFAULT RECORD", "'XOR'");
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED ON DEFAULT RECORD" );
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING INITIALIZATION OF " &
+                        "DEFAULT RECORD" );
+     END;
+               
+     DECLARE 
+          PROCEDURE PDEF (X : CARR := A1 AND A2; 
+                          Y : CARR := A1 OR A2; 
+                          Z : CARR := A1 XOR A2 ) IS
+          BEGIN
+               CHECK (X, "DEFAULT PARAMETER", "'AND'");
+               CHECK (Y, "DEFAULT PARAMETER", "'OR'");
+               CHECK (Z, "DEFAULT PARAMETER", "'XOR'");
+          END PDEF;
+     
+     BEGIN
+          PDEF;
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED ON DEFAULT PARM" );
+     END;
+
+     RESULT;
+
+END C45112A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45112b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45112b.ada
new file mode 100644
index 000000000..ef6a7c0a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45112b.ada
@@ -0,0 +1,234 @@
+-- C45112B.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 THE RESULT OF A LOGICAL ARRAY OPERATION 
+-- ARE THE BOUNDS OF THE LEFT OPERAND WHEN THE OPERANDS ARE NULL 
+-- ARRAYS.
+
+-- RJW 2/3/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45112B IS 
+     
+     TYPE ARR IS ARRAY(INTEGER RANGE <>) OF BOOLEAN;
+     A1 : ARR(IDENT_INT(4) .. IDENT_INT(3));
+     A2 : ARR(IDENT_INT(2) .. IDENT_INT(1));
+     SUBTYPE CARR IS ARR (IDENT_INT (A1'FIRST) .. IDENT_INT (A1'LAST));
+
+     PROCEDURE CHECK (X : ARR; N1, N2 : STRING) IS
+     BEGIN
+          IF X'FIRST /= A1'FIRST OR X'LAST /= A1'LAST THEN
+               FAILED ( "WRONG BOUNDS FOR " & N1 & " FOR " & N2 );
+          END IF;
+     END CHECK;
+     
+BEGIN
+
+     TEST ( "C45112B", "CHECK THE BOUNDS OF THE RESULT OF LOGICAL " &
+                       "ARRAY OPERATIONS ON NULL ARRAYS" );
+
+     BEGIN
+          DECLARE
+               AAND : CONSTANT ARR := A1 AND A2;
+               AOR  : CONSTANT ARR := A1 OR A2;
+               AXOR : CONSTANT ARR := A1 XOR A2;          
+          BEGIN
+               CHECK (AAND, "INITIALIZATION OF CONSTANT ARRAY ", 
+                            "'AND'" );
+
+               CHECK (AOR, "INITIALIZATION OF CONSTANT ARRAY ", 
+                            "'OR'" );
+     
+               CHECK (AXOR, "INITIALIZATION OF CONSTANT ARRAY ", 
+                            "'XOR'" );
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED DURING " &
+                        "INTIALIZATIONS" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED DURING " &
+                        "INITIALIZATIONS" );
+     END;
+                              
+     DECLARE
+          PROCEDURE PROC (A : ARR; STR : STRING) IS
+          BEGIN
+               CHECK (A, "FORMAL PARAMETER FOR CONSTRAINED ARRAY", 
+                      STR);
+          END PROC;
+     BEGIN
+          PROC ((A1 AND A2), "'AND'" );
+          PROC ((A1 OR A2), "'OR'" );
+          PROC ((A1 XOR A2), "'XOR'" );
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING TEST FOR FORMAL " &
+                        "PARAMETERS" );
+     END;
+
+     DECLARE
+          FUNCTION FUNCAND RETURN ARR IS
+          BEGIN
+               RETURN A1 AND A2;
+          END FUNCAND;
+
+          FUNCTION FUNCOR RETURN ARR IS
+          BEGIN
+               RETURN A1 OR A2;
+          END FUNCOR;
+     
+          FUNCTION FUNCXOR RETURN ARR IS
+          BEGIN
+               RETURN A1 XOR A2;
+          END FUNCXOR;
+
+     BEGIN
+          CHECK (FUNCAND, "RETURN STATEMENT", "'AND'");
+          CHECK (FUNCOR, "RETURN STATEMENT", "'OR'");
+          CHECK (FUNCXOR, "RETURN STATEMENT", "'XOR'");
+     
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING TEST FOR RETURN " &
+                        "FROM FUNCTION" );
+     END;
+
+     BEGIN
+          DECLARE
+               GENERIC
+                   X : IN ARR;
+               PACKAGE PKG IS 
+                    FUNCTION G RETURN ARR;
+               END PKG;
+     
+               PACKAGE BODY PKG IS
+                    FUNCTION G RETURN ARR IS
+                    BEGIN
+                         RETURN X;
+                    END G;
+               END PKG;
+                         
+               PACKAGE PAND IS NEW PKG(X => A1 AND A2);
+               PACKAGE POR IS NEW PKG(X => A1 OR A2);
+               PACKAGE PXOR IS NEW PKG(X => A1 XOR A2);
+          BEGIN
+               CHECK (PAND.G, "GENERIC FORMAL PARAMETER", "'AND'");
+               CHECK (POR.G, "GENERIC FORMAL PARAMETER", "'OR'");
+               CHECK (PXOR.G, "GENERIC FORMAL PARAMMETER", "'XOR'");
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING GENERIC " &
+                        "INSTANTIATION" );
+     END;
+
+     DECLARE
+          TYPE ACC IS ACCESS ARR;
+          AC : ACC;
+               
+     BEGIN
+          AC :=  NEW ARR'(A1 AND A2);
+          CHECK (AC.ALL, "ALLOCATION", "'AND'");
+          AC :=  NEW ARR'(A1 OR A2);
+          CHECK (AC.ALL, "ALLOCATION", "'OR'");
+          AC :=  NEW ARR'(A1 XOR A2);
+          CHECK (AC.ALL, "ALLOCATION", "'XOR'");
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED ON ALLOCATION" );
+     END;
+
+     BEGIN
+          CHECK (CARR' (A1 AND A2), "QUALIFIED EXPRESSION", "'AND'");
+          CHECK (CARR' (A1 OR A2), "QUALIFIED EXPRESSION", "'OR'");
+          CHECK (CARR' (A1 XOR A2), "QUALIFIED EXPRESSION", "'XOR'");
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED ON QUALIFIED EXPRESSION" );
+     END;
+               
+     DECLARE
+          TYPE REC IS
+               RECORD
+                    RCA : CARR;
+               END RECORD;
+          R1 : REC;
+
+     BEGIN
+          R1 := (RCA => (A1 AND A2));
+          CHECK (R1.RCA, "AGGREGATE", "'AND'");
+          R1 := (RCA => (A1 OR A2));
+          CHECK (R1.RCA, "AGGREGATE", "'OR'");
+          R1 := (RCA => (A1 XOR A2));
+          CHECK (R1.RCA, "AGGREGATE", "'XOR'");
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED ON AGGREGATE" );
+     END;
+                    
+     BEGIN
+          DECLARE
+               TYPE RECDEF IS
+                    RECORD
+                         RCDF1 : CARR := A1 AND A2;
+                         RCDF2 : CARR := A1 OR A2;
+                         RCDF3 : CARR := A1 XOR A2;
+                    END RECORD;
+               RD : RECDEF;
+          BEGIN
+               CHECK (RD.RCDF1, "DEFAULT RECORD", "'AND'");
+               CHECK (RD.RCDF2, "DEFAULT RECORD", "'OR'");
+               CHECK (RD.RCDF3, "DEFAULT RECORD", "'XOR'");
+          EXCEPTION
+               WHEN OTHERS => 
+                    FAILED ( "EXCEPTION RAISED ON DEFAULT RECORD" );
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING INITIALIZATION OF " &
+                        "DEFAULT RECORD" );
+     END;
+               
+     DECLARE 
+          PROCEDURE PDEF (X : CARR := A1 AND A2; 
+                          Y : CARR := A1 OR A2; 
+                          Z : CARR := A1 XOR A2 ) IS
+          BEGIN
+               CHECK (X, "DEFAULT PARAMETER", "'AND'");
+               CHECK (Y, "DEFAULT PARAMETER", "'OR'");
+               CHECK (Z, "DEFAULT PARAMETER", "'XOR'");
+          END PDEF;
+     
+     BEGIN
+          PDEF;
+     EXCEPTION
+          WHEN OTHERS => 
+               FAILED ( "EXCEPTION RAISED ON DEFAULT PARM" );
+     END;
+
+     RESULT;
+
+END C45112B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45113a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45113a.ada
new file mode 100644
index 000000000..14471d348
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45113a.ada
@@ -0,0 +1,91 @@
+-- C45113A.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 WHEN THE OPERANDS OF LOGICAL
+-- OPERATORS HAVE DIFFERENT LENGTHS.
+
+-- RJW  1/15/86
+
+WITH REPORT; USE REPORT; 
+
+PROCEDURE C45113A IS
+
+BEGIN
+
+     TEST( "C45113A" , "CHECK ON LOGICAL OPERATORS WITH " &
+                       "OPERANDS OF DIFFERENT LENGTHS" );
+     
+     DECLARE
+
+          TYPE ARR IS ARRAY ( INTEGER RANGE <> ) OF BOOLEAN;
+     
+          A : ARR( IDENT_INT(1) .. IDENT_INT(2) ) := ( TRUE, FALSE );
+          B : ARR( IDENT_INT(1) .. IDENT_INT(3) ) := ( TRUE, FALSE, 
+                                                       TRUE );
+
+     BEGIN
+
+          BEGIN -- TEST FOR 'AND'.
+               IF (A AND B) = B THEN
+                    FAILED ( "A AND B = B" );
+               END IF;
+               FAILED ( "NO EXCEPTION RAISED FOR 'AND'" );
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED FOR 'AND'" );
+          END;           
+
+
+          BEGIN -- TEST FOR 'OR'.
+               IF (A OR B) = B THEN
+                    FAILED ( "A OR B = B" );
+               END IF;
+               FAILED ( "NO EXCEPTION RAISED FOR 'OR'" );
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED FOR 'OR'" );
+          END;           
+
+
+          BEGIN -- TEST FOR 'XOR'.
+               IF (A XOR B) = B THEN
+                    FAILED ( "A XOR B = B" );
+               END IF;
+               FAILED ( "NO EXCEPTION RAISED FOR 'XOR'" );
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED FOR 'XOR'" );
+          END;           
+
+     END;
+
+     RESULT;
+
+END C45113A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45114b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45114b.ada
new file mode 100644
index 000000000..d49b9eda5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45114b.ada
@@ -0,0 +1,73 @@
+-- C45114B.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 LOGICAL OPERATORS ARE DEFINED FOR PACKED BOOLEAN ARRAYS.
+
+--  RJW  1/17/86
+
+WITH  REPORT; USE REPORT;
+PROCEDURE  C45114B  IS
+
+BEGIN
+
+     TEST( "C45114B" , "CHECK THAT LOGICAL OPERATORS ARE DEFINED " &
+                       "FOR PACKED BOOLEAN ARRAYS" );
+
+     DECLARE
+
+          TYPE ARR IS ARRAY (1 .. 32) OF BOOLEAN;
+
+          PRAGMA PACK (ARR);
+
+          A : ARR := ( TRUE, TRUE, FALSE, FALSE, OTHERS => TRUE );
+          B : ARR := ( TRUE, FALSE, TRUE, FALSE, OTHERS => FALSE );
+
+          A_AND_B : ARR := ( TRUE, OTHERS => FALSE );
+          A_OR_B  : ARR := ARR'( 4 => FALSE, OTHERS => TRUE );
+          A_XOR_B : ARR := ARR'( 1|4 => FALSE, OTHERS => TRUE );
+          NOT_A   : ARR := ARR'( 3|4 => TRUE, OTHERS => FALSE );
+
+     BEGIN
+
+          IF ( A AND B ) /= A_AND_B THEN
+               FAILED ( "'AND' NOT CORRECTLY DEFINED" );
+          END IF;
+
+          IF ( A OR B ) /= A_OR_B THEN
+               FAILED ( "'OR' NOT CORRECTLY DEFINED" );
+          END IF;
+
+          IF ( A XOR B ) /= A_XOR_B THEN
+               FAILED ( "'XOR' NOT CORRECTLY DEFINED" );
+          END IF;
+
+          IF NOT A /= NOT_A THEN
+               FAILED ( "'NOT' NOT CORRECTLY DEFINED" );
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45114B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c452001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c452001.a
new file mode 100644
index 000000000..ec78cd2a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c452001.a
@@ -0,0 +1,707 @@
+-- C452001.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:
+--      For a type extension, check that predefined equality is defined in
+--      terms of the primitive equals operator of the parent type and any
+--      tagged components of the extension part.
+--
+--      For other composite types, check that the primitive equality operator
+--      of any matching tagged components is used to determine equality of the
+--      enclosing type.
+--
+--      For private types, check that predefined equality is defined in
+--      terms of the user-defined (primitive) operator of the full type if
+--      the full type is tagged. The partial view of the type may be
+--      tagged or untagged. Check that predefined equality for a private
+--      type whose full view is untagged is defined in terms of the
+--      predefined equality operator of its full type.
+--
+-- TEST DESCRIPTION:
+--      Tagged types are declared and used as components in several
+--      differing composite type declarations, both tagged and untagged.
+--      To differentiate between predefined and primitive equality
+--      operations, user-defined equality operators are declared for
+--      each component type that is to contribute to the equality
+--      operator of the composite type that houses it. All user-defined
+--      equality operations are designed to yield the opposite result
+--      from the predefined operator, given the same component values.
+--
+--      For cases where primitive equality is to be incorporated into
+--      equality for the enclosing composite type, values are assigned
+--      to the component type so that user-defined equality will return
+--      True. If predefined equality is to be used instead, then the
+--      same strategy results in the equality operator returning False.
+--
+--      When equality for a type incorporates the user-defined equality
+--      operator of one of its component types, the resulting operator
+--      is considered to be the predefined operator of the composite type.
+--      This case is confirmed by defining an tagged component of an
+--      untagged composite type, then using the resulting untagged type
+--      as a component of another composite type. The user-defined operator
+--      for the lowest level should still be called.
+--
+--      Three cases are set up to test private types:
+--
+--                        Case 1        Case 2      Case 3
+--         partial view:  tagged       untagged    untagged
+--         full view:     tagged        tagged     untagged
+--
+--      Types are declared for each of the above cases and user-defined
+--      (primitive) operators are declared following the full type
+--      declaration of each type (i.e., in the private part).
+--
+--      Values are assigned into objects of these types using the same
+--      strategy outlined above. Cases 1 and 2 should execute the
+--      user-defined operator. Case 3 should ignore the user-defined
+--      operator and user predefined equality for the type.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Removed RM references from objective text.
+--      15 Nov 95   SAIC    Fixed for 2.0.1
+--      04 NOV 96   SAIC    Typographical revision
+--
+--!
+
+package c452001_0 is
+
+   type Point is
+      record
+         X : Integer := 0;
+         Y : Integer := 0;
+      end record;
+
+   type Circle is tagged
+      record
+         Center : Point;
+         Radius : Integer;
+      end record;
+
+   function "=" (L, R : Circle) return Boolean;
+
+   type Colors is (Red, Orange, Yellow, Green, Blue, Purple, Black, White);
+
+   type Colored_Circle is new Circle
+      with record
+         Color : Colors := White;
+      end record;
+
+   function "=" (L, R : Colored_Circle) return Boolean;
+   -- Override predefined equality for this tagged type. Predefined
+   -- equality should incorporate user-defined (primitive) equality
+   -- from type Circle. See C340001 for a test of that feature.
+
+   -- Equality is overridden to ensure that predefined equality 
+   -- incorporates this user-defined function for
+   -- any composite type with Colored_Circle as a component type.
+   -- (i.e., the type extension is recognized as a tagged type for
+   -- the purpose of defining predefined equality for the composite type).
+
+end C452001_0;
+
+package body c452001_0 is
+
+   function "=" (L, R : Circle) return Boolean is
+   begin
+      return L.Radius = R.Radius; -- circles are same size
+   end "=";
+
+   function "=" (L, R : Colored_Circle) return Boolean is
+   begin
+      return Circle(L) = Circle(R);
+   end "=";
+
+end C452001_0;
+
+with C452001_0;
+package C452001_1 is
+
+   type Planet is tagged record
+      Name : String (1..15);
+      Representation : C452001_0.Colored_Circle;
+   end record;
+
+   -- Type Planet will be used to check that predefined equality
+   -- for a tagged type with a tagged component incorporates
+   -- user-defined equality for the component type.
+
+   type TC_Planet is new Planet with null record;
+
+   -- A "copy" of Planet. Used to create a type extension. An "="
+   -- operator will be defined for this type that should be
+   -- incorporated by the type extension.
+
+   function "=" (Arg1, Arg2 : in TC_Planet) return Boolean;
+
+   type Craters is array (1..3) of C452001_0.Colored_Circle;
+
+   -- An array type (untagged) with tagged components
+
+   type Moon is new TC_Planet
+     with record
+        Crater : Craters;
+     end record;
+     
+   -- A tagged record type. Extended component type is untagged,
+   -- but its predefined equality operator should incorporate
+   -- the user-defined operator of its tagged component type.
+
+end C452001_1;
+
+package body C452001_1 is
+
+   function "=" (Arg1, Arg2 : in TC_Planet) return Boolean is
+   begin
+      return Arg1.Name = Arg2.Name;
+   end "=";
+
+end C452001_1;
+
+package C452001_2 is
+
+   -- Untagged record types
+   -- Equality should not be incorporated
+
+   type Spacecraft_Design is (Mariner, Pioneer, Viking, Voyager);
+   type Spacecraft is record
+     Design      : Spacecraft_Design;
+     Operational : Boolean;
+   end record;
+
+   function "=" (L : in Spacecraft; R : in Spacecraft) return Boolean;
+
+   type Mission is record
+      Craft       : Spacecraft;
+      Launch_Date : Natural;
+   end record;
+
+   type Inventory is array (Positive range <>) of Spacecraft;
+
+end C452001_2;
+
+package body C452001_2 is
+
+   function "=" (L : in Spacecraft; R : in Spacecraft) return Boolean is
+   begin
+      return L.Design = R.Design;
+   end "=";
+
+end C452001_2;
+
+package C452001_3 is
+
+   type Tagged_Partial_Tagged_Full is tagged private;
+   procedure Change (Object : in out Tagged_Partial_Tagged_Full;
+                    Value  : in Boolean);
+
+   type Untagged_Partial_Tagged_Full is private;
+   procedure Change (Object : in out Untagged_Partial_Tagged_Full;
+                    Value  : in Integer);
+
+   type Untagged_Partial_Untagged_Full is private;
+   procedure Change (Object : in out Untagged_Partial_Untagged_Full;
+                    Value  : in Duration);
+
+private
+
+   type Tagged_Partial_Tagged_Full is
+      tagged record
+         B : Boolean := True;
+         C : Character := ' ';
+      end record;
+   -- predefined equality checks that all components are equal
+
+   function "=" (L, R : in Tagged_Partial_Tagged_Full) return Boolean;
+   -- primitive equality checks that records equate in component C only
+
+   type Untagged_Partial_Tagged_Full is
+      tagged record
+         I : Integer := 0;
+         P : Positive := 1;
+      end record;
+   -- predefined equality checks that all components are equal
+
+   function "=" (L, R : in Untagged_Partial_Tagged_Full) return Boolean;
+   -- primitive equality checks that records equate in component P only
+
+   type Untagged_Partial_Untagged_Full is
+      record
+         D : Duration := 0.0;
+         S : String (1..12) := "Ada 9X rules";
+      end record;
+   -- predefined equality checks that all components are equal
+
+   function "=" (L, R : in Untagged_Partial_Untagged_Full) return Boolean;
+   -- primitive equality checks that records equate in component S only
+
+end C452001_3;
+   
+with Report;
+package body C452001_3 is
+
+   procedure Change (Object : in out Tagged_Partial_Tagged_Full;
+                    Value  : in Boolean) is
+   begin
+      Object := (Report.Ident_Bool(Value), Object.C);
+   end Change;
+
+   procedure Change (Object : in out Untagged_Partial_Tagged_Full;
+                    Value  : in Integer) is
+   begin
+      Object := (Report.Ident_Int(Value), Object.P);
+   end Change;
+
+   procedure Change (Object : in out Untagged_Partial_Untagged_Full;
+                    Value  : in Duration) is
+   begin
+      Object := (Value, Report.Ident_Str(Object.S));
+   end Change;
+
+   function "=" (L, R : in Tagged_Partial_Tagged_Full) return Boolean is
+   begin
+      return L.C = R.C;
+   end "=";
+
+   function "=" (L, R : in Untagged_Partial_Tagged_Full) return Boolean is
+   begin
+      return L.P = R.P;
+   end "=";
+
+   function "=" (L, R : in Untagged_Partial_Untagged_Full) return Boolean is
+   begin
+      return R.S = L.S;
+   end "=";
+
+end C452001_3;
+
+
+with C452001_0;
+with C452001_1;
+with C452001_2;
+with C452001_3;
+with Report;
+procedure C452001 is
+
+   Mars_Aphelion : C452001_1.Planet :=
+      (Name           => "Mars           ",
+       Representation => (Center => (Report.Ident_Int(20),
+                                     Report.Ident_Int(0)),
+                          Radius => Report.Ident_Int(4),
+                          Color  => C452001_0.Red));
+
+   Mars_Perihelion : C452001_1.Planet :=
+      (Name           => "Mars           ",
+       Representation => (Center => (Report.Ident_Int(-20),
+                                     Report.Ident_Int(0)),
+                          Radius => Report.Ident_Int(4),
+                          Color  => C452001_0.Red));
+
+   -- Mars_Perihelion = Mars_Aphelion if user-defined equality from
+   -- the tagged type Colored_Circle was incorporated into
+   -- predefined equality for the tagged type Planet. User-defined
+   -- equality for Colored_Circle checks only that the Radii are equal.
+
+   Blue_Mars : C452001_1.Planet :=
+      (Name           => "Mars           ",
+       Representation => (Center => (Report.Ident_Int(10),
+                                     Report.Ident_Int(10)),
+                          Radius => Report.Ident_Int(4),
+                          Color  => C452001_0.Blue));
+
+   -- Blue_Mars should equal Mars_Perihelion, because Names and
+   -- Radii are equal (all other components are not).
+
+   Green_Mars : C452001_1.Planet :=
+      (Name           => "Mars           ",
+       Representation => (Center => (Report.Ident_Int(10),
+                                     Report.Ident_Int(10)),
+                          Radius => Report.Ident_Int(4),
+                          Color  => C452001_0.Green));
+
+   -- Blue_Mars should equal Green_Mars. They differ only in the
+   -- Color component. All user-defined equality operations return
+   -- True, but records are not equal by predefined equality.
+
+   -- Blue_Mars should equal Mars_Perihelion, because Names and
+   -- Radii are equal (all other components are not).
+
+   Moon_Craters : C452001_1.Craters :=
+      ((Center => (Report.Ident_Int(9), Report.Ident_Int(11)),
+        Radius => Report.Ident_Int(1),
+        Color  => C452001_0.Black),
+       (Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
+        Radius => Report.Ident_Int(1),
+        Color  => C452001_0.Black),
+       (Center => (Report.Ident_Int(11), Report.Ident_Int(9)),
+        Radius => Report.Ident_Int(1),
+        Color  => C452001_0.Black));
+
+   Alternate_Moon_Craters : C452001_1.Craters :=
+      ((Center => (Report.Ident_Int(9), Report.Ident_Int(9)),
+        Radius => Report.Ident_Int(1),
+        Color  => C452001_0.Yellow),
+       (Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
+        Radius => Report.Ident_Int(1),
+        Color  => C452001_0.Purple),
+       (Center => (Report.Ident_Int(11), Report.Ident_Int(11)),
+        Radius => Report.Ident_Int(1),
+        Color  => C452001_0.Purple));
+
+   -- Moon_Craters = Alternate_Moon_Craters if user-defined equality from
+   -- the tagged type Colored_Circle was incorporated into
+   -- predefined equality for the untagged type Craters. User-defined
+   -- equality checks only that the Radii are equal.
+
+   New_Moon : C452001_1.Moon := 
+      (Name           => "Moon           ",
+       Representation => (Center => (Report.Ident_Int(10),
+                                     Report.Ident_Int(8)),
+                          Radius => Report.Ident_Int(3),
+                          Color  => C452001_0.Black),
+       Crater         => Moon_Craters);
+
+   Full_Moon : C452001_1.Moon := 
+      (Name           => "Moon           ",
+       Representation => (Center => (Report.Ident_Int(10),
+                                     Report.Ident_Int(8)),
+                          Radius => Report.Ident_Int(3),
+                          Color  => C452001_0.Black),
+       Crater         => Alternate_Moon_Craters);
+
+   -- New_Moon = Full_Moon if user-defined equality from
+   -- the tagged type Colored_Circle was incorporated into
+   -- predefined equality for the untagged type Craters. This
+   -- equality test should call user-defined equality for type
+   -- TC_Planet (checks that Names are equal), then predefined
+   -- equality for Craters (ultimately calls user-defined equality
+   -- for type Circle, checking that Radii of craters are equal).
+
+   Mars_Moon : C452001_1.Moon := 
+      (Name           => "Phobos         ",
+       Representation => (Center => (Report.Ident_Int(10),
+                                     Report.Ident_Int(8)),
+                          Radius => Report.Ident_Int(3),
+                          Color  => C452001_0.Black),
+       Crater         => Alternate_Moon_Craters);
+
+   -- Mars_Moon /= Full_Moon since the Names differ.
+
+   Alternate_Moon_Craters_2 : C452001_1.Craters :=
+      ((Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
+        Radius => Report.Ident_Int(1),
+        Color  => C452001_0.Red),
+       (Center => (Report.Ident_Int(9), Report.Ident_Int(9)),
+        Radius => Report.Ident_Int(1),
+        Color  => C452001_0.Red),
+       (Center => (Report.Ident_Int(10), Report.Ident_Int(9)),
+        Radius => Report.Ident_Int(1),
+        Color  => C452001_0.Red));
+
+   Harvest_Moon : C452001_1.Moon := 
+      (Name           => "Moon           ",
+       Representation => (Center => (Report.Ident_Int(11),
+                                     Report.Ident_Int(7)),
+                          Radius => Report.Ident_Int(4),
+                          Color  => C452001_0.Orange),
+       Crater         => Alternate_Moon_Craters_2);
+
+   -- Only the fields that are employed by the user-defined equality
+   -- operators are the same. Everything else differs. Equality should
+   -- still return True.
+
+   Viking_1_Orbiter : C452001_2.Mission :=
+      (Craft => (Design      => C452001_2.Viking,
+                 Operational => Report.Ident_Bool(False)),
+       Launch_Date => 1975);
+
+   Viking_1_Lander : C452001_2.Mission :=
+      (Craft => (Design      => C452001_2.Viking,
+                 Operational => Report.Ident_Bool(True)),
+       Launch_Date => 1975);
+
+   -- Viking_1_Orbiter /= Viking_1_Lander if predefined equality
+   -- from the untagged type Spacecraft is used for equality
+   -- of matching components in type Mission. If user-defined
+   -- equality for type Spacecraft is incorporated, which it
+   -- should not be by 4.5.2(21), then Viking_1_Orbiter = Viking_1_Lander.
+   
+   Voyagers : C452001_2.Inventory (1..2):=
+    ((C452001_2.Voyager, Operational => Report.Ident_Bool(True)),
+     (C452001_2.Voyager, Operational => Report.Ident_Bool(False)));
+
+   Jupiter_Craft : C452001_2.Inventory (1..2):=
+    ((C452001_2.Voyager, Operational => Report.Ident_Bool(True)),
+     (C452001_2.Voyager, Operational => Report.Ident_Bool(True)));
+   
+   -- Voyagers /= Jupiter_Craft if predefined equality
+   -- from the untagged type Spacecraft is used for equality
+   -- of matching components in type Inventory. If user-defined
+   -- equality for type Spacecraft is incorporated, which it
+   -- should not be by 4.5.2(21), then Voyagers = Jupiter_Craft.
+
+   TPTF_1 : C452001_3.Tagged_Partial_Tagged_Full;
+   TPTF_2 : C452001_3.Tagged_Partial_Tagged_Full;
+   
+   -- With differing values for Boolean component, user-defined
+   -- (primitive) equality returns True, predefined equality
+   -- returns False. Since full type is tagged, primitive equality
+   -- should be used.
+
+   UPTF_1 : C452001_3.Untagged_Partial_Tagged_Full;
+   UPTF_2 : C452001_3.Untagged_Partial_Tagged_Full;
+
+   -- With differing values for Boolean component, user-defined
+   -- (primitive) equality returns True, predefined equality
+   -- returns False. Since full type is tagged, primitive equality
+   -- should be used.
+
+   UPUF_1 : C452001_3.Untagged_Partial_Untagged_Full;
+   UPUF_2 : C452001_3.Untagged_Partial_Untagged_Full;
+
+   -- With differing values for Duration component, user-defined
+   -- (primitive) equality returns True, predefined equality
+   -- returns False. Since full type is untagged, predefined equality
+   -- should be used.
+
+   -- Use type clauses make "=" and "/=" operators directly visible
+   use type C452001_1.Planet;
+   use type C452001_1.Craters;
+   use type C452001_1.Moon;
+   use type C452001_2.Mission;
+   use type C452001_2.Inventory;
+   use type C452001_3.Tagged_Partial_Tagged_Full;
+   use type C452001_3.Untagged_Partial_Tagged_Full;
+   use type C452001_3.Untagged_Partial_Untagged_Full;
+
+begin
+
+   Report.Test ("C452001", "Equality of private types and " &
+                           "composite types with tagged components");
+
+   -------------------------------------------------------------------
+   -- Tagged type with tagged component.
+   -------------------------------------------------------------------
+
+   if not (Mars_Aphelion = Mars_Perihelion) then
+      Report.Failed ("User-defined equality for tagged component " &
+                     "was not incorporated into predefined equality " &
+                     "for enclosing tagged record type");
+   end if;
+
+   if Mars_Aphelion /= Mars_Perihelion then
+      Report.Failed ("User-defined equality for tagged component " &
+                     "was not incorporated into predefined inequality " &
+                     "for enclosing tagged record type");
+   end if;
+
+   if not (Blue_Mars = Mars_Perihelion) then
+      Report.Failed ("Equality test for tagged record type " &
+                     "incorporates record components " &
+                     "other than those used by user-defined equality");
+   end if;
+
+   if Blue_Mars /= Mars_Perihelion then
+      Report.Failed ("Inequality test for tagged record type " &
+                     "incorporates record components " &
+                     "other than those used by user-defined equality");
+   end if;
+
+   if Blue_Mars /= Green_Mars then
+      Report.Failed ("Records are unequal even though they only differ " &
+                     "in a component not used by user-defined equality");
+   end if;
+
+   if not (Blue_Mars = Green_Mars) then
+      Report.Failed ("Records are not equal even though they only differ " &
+                     "in a component not used by user-defined equality");
+   end if;
+
+   -------------------------------------------------------------------
+   -- Untagged (array) type with tagged component.
+   -------------------------------------------------------------------
+
+   if not (Moon_Craters = Alternate_Moon_Craters) then
+      Report.Failed ("User-defined equality for tagged component " &
+                     "was not incorporated into predefined equality " &
+                     "for enclosing array type");
+   end if;
+
+   if Moon_Craters /= Alternate_Moon_Craters then
+      Report.Failed ("User-defined equality for tagged component " &
+                     "was not incorporated into predefined inequality " &
+                     "for enclosing array type");
+   end if;
+
+   -------------------------------------------------------------------
+   -- Tagged type with untagged composite component. Untagged
+   -- component itself has tagged components.
+   -------------------------------------------------------------------
+   if not (New_Moon = Full_Moon) then
+      Report.Failed ("User-defined equality for tagged component " &
+                     "was not incorporated into predefined equality " &
+                     "for array component of tagged record type");
+   end if;
+
+   if New_Moon /= Full_Moon then
+      Report.Failed ("User-defined equality for tagged component " &
+                     "was not incorporated into predefined inequality " &
+                     "for array component of tagged record type");
+   end if;
+
+   if Mars_Moon = Full_Moon then
+      Report.Failed ("User-defined equality for tagged component " &
+                     "was not incorporated into predefined equality " &
+                     "for array component of tagged record type");
+   end if;
+
+   if not (Mars_Moon /= Full_Moon) then
+      Report.Failed ("User-defined equality for tagged component " &
+                     "was not incorporated into predefined inequality " &
+                     "for array component of tagged record type");
+   end if;
+
+   if not (Harvest_Moon = Full_Moon) then
+      Report.Failed ("Equality test for record with array of tagged " &
+                     "components incorporates record components " &
+                     "other than those used by user-defined equality");
+   end if;
+
+   if Harvest_Moon /= Full_Moon then
+      Report.Failed ("Inequality test for record with array of tagged " &
+                     "components incorporates record components " &
+                     "other than those used by user-defined equality");
+   end if;
+
+   -------------------------------------------------------------------
+   -- Untagged types with no tagged components.
+   -------------------------------------------------------------------
+
+   -- Record type
+
+   if Viking_1_Orbiter = Viking_1_Lander then
+      Report.Failed ("User-defined equality for untagged composite " &
+                     "component was incorporated into predefined " &
+                     "equality for " &
+                     "untagged record type");
+   end if;
+
+   if not (Viking_1_Orbiter /= Viking_1_Lander) then
+      Report.Failed ("User-defined equality for untagged composite " &
+                     "component was incorporated into predefined " &
+                     "inequality for " &
+                     "untagged record type");
+   end if;
+
+   -- Array type
+   
+   if Voyagers = Jupiter_Craft then
+      Report.Failed ("User-defined equality for untagged composite " &
+                     "component was incorporated into predefined " &
+                     "equality for " &
+                     "array type");
+   end if;
+
+   if not (Voyagers /= Jupiter_Craft) then
+      Report.Failed ("User-defined equality for untagged composite " &
+                     "component was incorporated into predefined " &
+                     "inequality for " &
+                     "array type");
+   end if;
+
+   -------------------------------------------------------------------
+   -- Private types tests.
+   -------------------------------------------------------------------
+
+   -- Make objects differ from one another
+
+   C452001_3.Change (TPTF_1, False);
+   C452001_3.Change (UPTF_1, 999);
+   C452001_3.Change (UPUF_1, 40.0);
+
+   -------------------------------------------------------------------
+   -- Partial type and full type are tagged. (Full type must be tagged
+   -- if partial type is tagged)
+   -------------------------------------------------------------------
+
+   if not (TPTF_1 = TPTF_2) then
+      Report.Failed ("Predefined equality for full type " &
+                     "was used to determine equality of " &
+                     "tagged private type " &
+                     "instead of user-defined (primitive) equality");
+   end if;
+
+   if TPTF_1 /= TPTF_2 then
+      Report.Failed ("Predefined equality for full type " &
+                     "was used to determine inequality of " &
+                     "tagged private type " &
+                     "instead of user-defined (primitive) equality");
+   end if;
+
+   -------------------------------------------------------------------
+   -- Partial type untagged, full type tagged.
+   -------------------------------------------------------------------
+
+   if not (UPTF_1 = UPTF_2) then
+      Report.Failed ("Predefined equality for full type " &
+                     "was used to determine equality of " &
+                     "private type (untagged partial view, " &
+                     "tagged full view) " &
+                     "instead of user-defined (primitive) equality");
+   end if;
+
+   if UPTF_1 /= UPTF_2 then
+      Report.Failed ("Predefined equality for full type " &
+                     "was used to determine inequality of " &
+                     "private type (untagged partial view, " &
+                     "tagged full view) " &
+                     "instead of user-defined (primitive) equality");
+   end if;
+
+   -------------------------------------------------------------------
+   -- Partial type and full type are both untagged.
+   -------------------------------------------------------------------
+
+   if UPUF_1 = UPUF_2 then
+      Report.Failed ("User-defined (primitive) equality for full type " &
+                     "was used to determine equality of " &
+                     "private type (untagged partial view, " &
+                     "untagged full view) " &
+                     "instead of predefined equality");
+   end if;
+
+   if not (UPUF_1 /= UPUF_2) then
+      Report.Failed ("User-defined (primitive) equality for full type " &
+                     "was used to determine inequality of " &
+                     "private type (untagged partial view, " &
+                     "untagged full view) " &
+                     "instead of predefined equality");
+   end if;
+
+   -------------------------------------------------------------------
+   Report.Result;
+
+end C452001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45201a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45201a.ada
new file mode 100644
index 000000000..5c1970d34
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45201a.ada
@@ -0,0 +1,242 @@
+-- C45201A.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  '='  AND  '/='  PRODUCE CORRECT RESULTS ON
+--    ENUMERATION-TYPE OPERANDS (IN PARTICULAR, FOR OPERANDS HAVING
+--    DIFFERENT SUBTYPES).
+
+-- THIS TEST'S FRAMEWORK IS FROM  C45201B.ADA , C45210A.ADA .
+
+
+-- RM    20 OCTOBER 1980
+-- JWC 7/8/85   RENAMED TO -AB
+
+
+WITH  REPORT ;
+PROCEDURE  C45201A  IS
+
+     USE REPORT;
+
+     TYPE  T  IS  ( A , SLIT , B , PLIT , C , NUL , D , 'R' , E );
+
+     --                 S-LIT ,    P-LIT ,    NUL ,     'R'   CORRESPOND
+     --            TO    'S'  ,     'P'  ,    'M'  ,    'R'  IN C45210A.
+
+     SUBTYPE  T1  IS  T RANGE A..B ;
+     SUBTYPE  T2  IS  T RANGE A..C ;    -- INCLUDES  T1
+     SUBTYPE  T3  IS  T RANGE B..D ;    -- INTERSECTS  T2 , T4
+     SUBTYPE  T4  IS  T RANGE C..E ;    -- DISJOINT FROM  T1 , T2
+
+     MVAR  : T3 := T'(NUL ) ;
+     PVAR  : T2 := T'(PLIT) ;
+     RVAR  : T4 := T'('R' ) ;
+     SVAR  : T1 := T'(SLIT) ;
+
+     ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          ERROR_COUNT := ERROR_COUNT + 1 ;
+     END BUMP ;
+
+     FUNCTION  ITSELF( THE_ARGUMENT : T )  RETURN  T  IS
+     BEGIN
+          IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
+          ELSE  RETURN  A ;
+          END IF;
+     END ;
+
+
+BEGIN
+
+     TEST( "C45201A" , "CHECK THAT  '='  AND  '/='  PRODUCE CORRECT" &
+                       " RESULTS ON ENUMERATION-TYPE LITERALS" ) ;
+
+     -- 128 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
+     --             2 (4)  OPERATORS (2, TWICE): '=' , '/=' , '=' , '/='
+     --                          (IN THE TABLE:   A  ,  B   ,  C  ,  D )
+     --                          (C45201B.ADA HAD  < <= > >= ; REVERSED)
+     --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+     --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
+     --                         (IN THE TABLE:  VV = ALPHA ,
+     --                                         VL = BETA  ,
+     --                                         LV = GAMMA ,
+     --                                         LL = DELTA  ) RANDOMIZED
+     --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
+     --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
+
+     --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
+     --         LEFT
+     --       OPERAND:
+
+     --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
+     --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
+     --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
+     --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
+
+     --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
+     --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
+
+     -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
+     --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
+     --    ( VV , ALPHA ) FOR BOTH OPERATORS.
+
+    -----------------------------------------------------------------
+
+     -- PART 1
+
+     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+
+     IF  T'(SVAR) =  T'(SVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(SVAR) /= T'(PLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(SLIT) =  T'(MVAR)  THEN  BUMP ;               END IF;
+     IF  T'(SLIT) /= T'('R' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+
+     IF  T'(PLIT) =  T'(SLIT)  THEN  BUMP ;               END IF;
+     IF  T'(PLIT) /= T'(PVAR)  THEN  BUMP ;               END IF;
+     IF  T'(PVAR) =  T'(NUL )  THEN  BUMP ;               END IF;
+     IF  T'(PVAR) /= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+
+     IF  T'(MVAR) /= T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(MVAR) =  T'(PVAR)  THEN  BUMP ;               END IF;
+     IF  T'(NUL ) /= T'(NUL )  THEN  BUMP ;               END IF;
+     IF  T'(NUL ) =  T'(RVAR)  THEN  BUMP ;               END IF;
+
+     IF  T'('R' ) /= T'(SVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'('R' ) =  T'(PLIT)  THEN  BUMP ;               END IF;
+     IF  T'(RVAR) /= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(RVAR) =  T'('R' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+
+
+     IF  ERROR_COUNT /= 0  THEN
+          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE1" );
+     END IF;
+
+    -----------------------------------------------------------------
+
+     -- PART 2
+
+     --  'BUMP'  STILL MEANS  'BUMP THE ERROR COUNT'
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+          FOR  BVAR  IN  T'FIRST..T'LAST  LOOP     -- 9 VALUES
+
+               IF  AVAR  = BVAR  THEN
+                    IF  AVAR /= BVAR  THEN  BUMP ;  END IF;
+               END IF;
+
+               IF  AVAR /= BVAR  THEN
+                    IF  AVAR  = BVAR  THEN  BUMP ;  END IF;
+               END IF;
+
+          END LOOP;
+     END LOOP;
+
+     IF  ERROR_COUNT /= 0  THEN
+          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE2" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+
+          FOR  BVAR  IN  T'FIRST..T'LAST   LOOP    -- 9 VALUES
+
+               IF ( AVAR /= BVAR ) /= ( T'POS(AVAR) /= T'POS(BVAR) )THEN
+                    BUMP ;
+               END IF;
+
+               IF ( AVAR  = BVAR ) /= ( T'POS(AVAR)  = T'POS(BVAR) )THEN
+                    BUMP ;
+               END IF;
+
+          END LOOP;
+
+     END LOOP;
+
+     IF  ERROR_COUNT /= 0  THEN
+          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE3" );
+     END IF;
+
+     ERROR_COUNT := 0 ;
+
+     FOR  IVAR IN  0..8  LOOP                      -- 9 VALUES
+
+          FOR  JVAR  IN  0..8   LOOP               -- 9 VALUES
+
+               IF ( IVAR /= JVAR ) /= ( T'VAL(IVAR) /= T'VAL(JVAR) )THEN
+                    BUMP ;
+               END IF;
+
+               IF ( IVAR  = JVAR ) /= ( T'VAL(IVAR)  = T'VAL(JVAR) )THEN
+                    BUMP ;
+               END IF;
+
+          END LOOP;
+
+     END LOOP;
+
+     IF  ERROR_COUNT /= 0  THEN
+          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE4" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP    -- 9 VALUES (THE DIAGONAL)
+
+          IF  AVAR  = ITSELF(AVAR)  THEN NULL;  ELSE BUMP;  END IF;
+          IF  AVAR /= ITSELF(AVAR)  THEN BUMP;              END IF;
+
+     END LOOP;
+
+     IF  ERROR_COUNT /= 0  THEN
+          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE5" );
+     END IF;
+
+
+     -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+          FOR  BVAR  IN  T'FIRST..T'LAST  LOOP     -- 9 VALUES
+
+               IF  AVAR /= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 72
+
+          END LOOP;
+     END LOOP;
+
+     IF  ERROR_COUNT /= 72  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                   --    ERROR COUNT
+          FAILED( "EQUALITY OF ENUMERATION VALUES - FAILURE6" );
+     END IF;
+
+
+     RESULT;
+
+END C45201A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45201b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45201b.ada
new file mode 100644
index 000000000..7c64c8bf4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45201b.ada
@@ -0,0 +1,236 @@
+-- C45201B.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 ORDERING OF ENUMERATION LITERALS AS DEFINED BY THE
+--    ORDERING OPERATORS IS THE SAME AS THE ORDER OF OCCURRENCE OF THE
+--    LITERALS IN THE TYPE DEFINITION.
+
+-- THIS TEST IS DERIVED FROM  C45210A.ADA .
+
+
+-- RM    17 OCTOBER 1980
+-- JWC 7/8/85   RENAMED TO -AB
+
+
+WITH  REPORT ;
+PROCEDURE  C45201B  IS
+
+     USE REPORT;
+
+     TYPE  T  IS  ( A , SLIT , B , PLIT , C , NUL , D , 'R' , E );
+
+     --                 S-LIT ,    P-LIT ,    NUL ,     'R'   CORRESPOND
+     --            TO    'S'  ,     'P'  ,    'M'  ,    'R'  IN C45210A.
+
+     SUBTYPE  T1  IS  T RANGE A..B ;
+     SUBTYPE  T2  IS  T RANGE A..C ;    -- INCLUDES  T1
+     SUBTYPE  T3  IS  T RANGE B..D ;    -- INTERSECTS  T2 , T4
+     SUBTYPE  T4  IS  T RANGE C..E ;    -- DISJOINT FROM  T1 , T2
+
+     MVAR  : T3 := T'(NUL ) ;
+     PVAR  : T2 := T'(PLIT) ;
+     RVAR  : T4 := T'('R' ) ;
+     SVAR  : T1 := T'(SLIT) ;
+
+     ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          ERROR_COUNT := ERROR_COUNT + 1 ;
+     END BUMP ;
+
+
+BEGIN
+
+     TEST( "C45201B","CHECK THAT THE ORDERING OF ENUMERATION LITERALS "&
+                     " AS DEFINED BY THE ORDERING OPERATORS" &
+                     " IS THE SAME AS THE ORDER OF OCCURRENCE OF THE " &
+                     " LITERALS IN THE TYPE DEFINITION" ) ;
+
+     -- 256 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
+     --               4    ORDERING OPERATORS: '<' , '<=' , '>' , '>='
+     --                         (IN THE TABLE:  A  ,  B   ,  C  ,  D   )
+     --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+     --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
+     --                         (IN THE TABLE:  VV = ALPHA ,
+     --                                         VL = BETA  ,
+     --                                         LV = GAMMA ,
+     --                                         LL = DELTA  ) RANDOMIZED
+     --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
+     --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
+
+     --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
+     --         LEFT
+     --       OPERAND:
+
+     --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
+     --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
+     --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
+     --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
+
+     --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
+     --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
+
+     -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
+     --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
+     --    ( VV , ALPHA ) FOR ALL 4 OPERATORS.
+
+    -----------------------------------------------------------------
+
+     -- PART 1
+
+     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+
+     IF  T'(SVAR) <  T'(SVAR)  THEN  BUMP ;               END IF;
+     IF  T'(SVAR) <= T'(PLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(SLIT) >  T'(MVAR)  THEN  BUMP ;               END IF;
+     IF  T'(SLIT) >= T'('R' )  THEN  BUMP ;               END IF;
+
+     IF  T'(PLIT) >  T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(PLIT) >= T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(PVAR) <  T'(NUL )  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(PVAR) <= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+
+     IF  T'(MVAR) >= T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(MVAR) >  T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(NUL ) <= T'(NUL )  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(NUL ) <  T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+
+     IF  T'('R' ) <= T'(SVAR)  THEN  BUMP ;               END IF;
+     IF  T'('R' ) <  T'(PLIT)  THEN  BUMP ;               END IF;
+     IF  T'(RVAR) >= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(RVAR) >  T'('R' )  THEN  BUMP ;               END IF;
+
+
+     IF  ERROR_COUNT /= 0  THEN
+          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE1" );
+     END IF;
+
+    -----------------------------------------------------------------
+
+     -- PART 2
+
+     -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+          FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
+
+               IF  AVAR <  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  6
+
+          END LOOP;
+     END LOOP;
+
+     IF  ERROR_COUNT /= 6  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                   --    ERROR COUNT
+          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE2" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+          FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
+
+               IF  AVAR <= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 10
+
+          END LOOP;
+     END LOOP;
+
+     IF  ERROR_COUNT /=10  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                   --    ERROR COUNT
+          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE3" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+          FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
+
+               IF  AVAR >  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 26
+
+          END LOOP;
+     END LOOP;
+
+     IF  ERROR_COUNT /=26  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                   --    ERROR COUNT
+          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE4" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+          FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
+
+               IF  AVAR >= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 30
+
+          END LOOP;
+     END LOOP;
+
+     IF  ERROR_COUNT /=30  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                   --    ERROR COUNT
+          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE5" );
+     END IF;
+
+
+     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT' (AGAIN)
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
+
+          FOR  BVAR  IN  T'FIRST..T'LAST   LOOP    -- 9 VALUES
+
+               IF ( AVAR <  BVAR ) /= ( T'POS(AVAR) <  T'POS(BVAR) )THEN
+                    BUMP ;
+               END IF;
+
+               IF ( AVAR <= BVAR ) /= ( T'POS(AVAR) <= T'POS(BVAR) )THEN
+                    BUMP ;
+               END IF;
+
+               IF ( AVAR >  BVAR ) /= ( T'POS(AVAR) >  T'POS(BVAR) )THEN
+                    BUMP ;
+               END IF;
+
+               IF ( AVAR >= BVAR ) /= ( T'POS(AVAR) >= T'POS(BVAR) )THEN
+                    BUMP ;
+               END IF;
+
+          END LOOP;
+
+     END LOOP;
+
+
+     IF  ERROR_COUNT /= 0  THEN   -- REAL ERROR COUNT AGAIN
+          FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE6" );
+     END IF;
+
+
+     RESULT;
+
+END C45201B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45202b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45202b.ada
new file mode 100644
index 000000000..bf2a02fef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45202b.ada
@@ -0,0 +1,95 @@
+-- C45202B.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 MEMBERSHIP OPERATIONS IN THE CASE IN WHICH A USER HAS 
+-- REDEFINED THE ORDERING OPERATORS.
+
+-- RJW 1/22/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45202B IS
+
+
+BEGIN
+
+     TEST( "C45202B" , "CHECK MEMBERSHIP OPERATIONS IN WHICH A USER " &
+                       "HAS REDEFINED THE ORDERING OPERATORS" ) ;
+
+
+     DECLARE
+
+          TYPE  T  IS  ( AA, BB, CC, LIT, XX, YY, ZZ );    
+          SUBTYPE ST IS T RANGE AA .. LIT;     
+
+          VAR  :           T :=  LIT ;
+          CON  :  CONSTANT T :=  LIT ;
+
+          FUNCTION ">" ( L, R : T ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN T'POS(L) <= T'POS(R);
+          END;
+                    
+          FUNCTION ">=" ( L, R : T ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN T'POS(L) < T'POS(R);
+          END;
+
+          FUNCTION "<" ( L, R : T ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN T'POS(L) >= T'POS(R);
+          END;
+                    
+          FUNCTION "<=" ( L, R : T ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN T'POS(L) > T'POS(R);
+          END;
+                    
+
+     BEGIN
+
+          IF   LIT NOT IN ST      OR
+               VAR NOT IN ST      OR
+               CON NOT IN ST      OR
+               NOT (VAR IN ST)    OR
+               XX IN ST           OR
+               NOT (XX NOT IN ST) 
+          THEN
+               FAILED( "WRONG VALUES FOR 'IN ST'" );
+          END IF;
+
+          IF   LIT     IN AA ..CC       OR
+               VAR NOT IN LIT..ZZ       OR
+               CON     IN ZZ ..AA       OR
+               NOT (CC IN CC .. YY)     OR
+               NOT (BB NOT IN CC .. YY) 
+          THEN
+               FAILED( "WRONG VALUES FOR 'IN AA..CC'" );
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45202B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45210a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45210a.ada
new file mode 100644
index 000000000..e7461aa8d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45210a.ada
@@ -0,0 +1,191 @@
+-- C45210A.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 ENUMERATION IMPOSING AN "UNNATURAL" ORDER ON ALPHABETIC
+--    CHARACTERS CORRECTLY EVALUATES THE ORDERING OPERATORS.
+
+
+-- RM    15 OCTOBER 1980
+-- JWC 7/8/85   RENAMED TO -AB
+
+
+WITH  REPORT ;
+PROCEDURE  C45210A  IS
+
+     USE REPORT;
+
+     TYPE  T  IS  ( 'S' , 'P' , 'M' , 'R' );
+
+     MVAR  : T := T'('M') ;
+     PVAR  : T := T'('P') ;
+     RVAR  : T := T'('R') ;
+     SVAR  : T := T'('S') ;
+
+     ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          ERROR_COUNT := ERROR_COUNT +1 ;
+     END BUMP ;
+
+
+BEGIN
+
+     TEST( "C45210A" , "CHECK THAT AN ENUMERATION IMPOSING" &
+                       " AN ""UNNATURAL"" ORDER ON ALPHABETIC" &
+                       " CHARACTERS  CORRECTLY EVALUATES THE " &
+                       " ORDERING OPERATORS" ) ;
+
+     -- 256 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
+     --               4    ORDERING OPERATORS: '<' , '<=' , '>' , '>='
+     --                         (IN THE TABLE:  A  ,  B   ,  C  ,  D   )
+     --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+     --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
+     --                         (IN THE TABLE:  VV = ALPHA ,
+     --                                         VL = BETA  ,
+     --                                         LV = GAMMA ,
+     --                                         LL = DELTA  ) RANDOMIZED
+     --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
+     --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
+
+     --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
+     --         LEFT
+     --       OPERAND:
+
+     --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
+     --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
+     --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
+     --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
+
+     --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
+     --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
+
+     -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
+     --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
+     --    ( VV , ALPHA ) FOR ALL 4 OPERATORS.
+
+    -----------------------------------------------------------------
+
+     -- PART 1
+
+     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+
+     IF  T'(SVAR) <  T'(SVAR)  THEN  BUMP ;               END IF;
+     IF  T'(SVAR) <= T'('P' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'('S' ) >  T'(MVAR)  THEN  BUMP ;               END IF;
+     IF  T'('S' ) >= T'('R' )  THEN  BUMP ;               END IF;
+
+     IF  T'('P' ) >  T'('S' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'('P' ) >= T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(PVAR) <  T'('M' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(PVAR) <= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+
+     IF  T'(MVAR) >= T'('S' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(MVAR) >  T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'('M' ) <= T'('M' )  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'('M' ) <  T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+
+     IF  T'('R' ) <= T'(SVAR)  THEN  BUMP ;               END IF;
+     IF  T'('R' ) <  T'('P' )  THEN  BUMP ;               END IF;
+     IF  T'(RVAR) >= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
+     IF  T'(RVAR) >  T'('R' )  THEN  BUMP ;               END IF;
+
+
+     IF  ERROR_COUNT /= 0  THEN
+          FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE1" );
+     END IF;
+
+    -----------------------------------------------------------------
+
+     -- PART 2
+
+     -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
+          FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
+
+               IF  AVAR <  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  1
+
+          END LOOP;
+     END LOOP;
+
+     IF  ERROR_COUNT /= 1  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                   --    ERROR COUNT
+          FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE2" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
+          FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
+
+               IF  AVAR <= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  3
+
+          END LOOP;
+     END LOOP;
+
+     IF  ERROR_COUNT /= 3  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                   --    ERROR COUNT
+          FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE3" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
+          FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
+
+               IF  AVAR >  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  5
+
+          END LOOP;
+     END LOOP;
+
+     IF  ERROR_COUNT /= 5  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                   --    ERROR COUNT
+          FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE4" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 4 VALUES
+          FOR  BVAR  IN  T'FIRST..T'('P')  LOOP    -- 2 VALUES
+
+               IF  AVAR >= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  7
+
+          END LOOP;
+     END LOOP;
+
+     IF  ERROR_COUNT /= 7  THEN   -- THIS IS A PLAIN COUNT, NOT AN
+                                   --    ERROR COUNT
+          FAILED( """UNNATURAL"" ORDER ON CHARACTER TYPES - FAILURE5" );
+     END IF;
+
+
+     RESULT;
+
+END C45210A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45211a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45211a.ada
new file mode 100644
index 000000000..8d73d771e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45211a.ada
@@ -0,0 +1,66 @@
+-- C45211A.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 MEMBERSHIP TESTS FOR AN 'UNNATURAL' ORDERING OF CHARACTER
+-- LITERALS.
+
+-- RJW 1/22/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45211A IS
+
+     TYPE  T  IS  ( 'S' , 'Q' , 'P' , 'M' , 'R' );
+     SUBTYPE ST IS T RANGE 'P' .. 'R';
+
+     MVAR  : T := T'('M') ;
+     QVAR  : T := T'('Q') ;
+     MCON  : CONSTANT T := T'('M');
+     QCON  : CONSTANT T := T'('Q');
+
+BEGIN
+
+     TEST( "C45211A" , "CHECK MEMBERSHIP TESTS FOR AN 'UNNATURAL' " &
+                       "ORDERING OF CHARACTER LITERALS" ) ;
+
+     IF QVAR IN T'('P') .. T'('R')  OR
+        'Q'  IN ST
+     THEN
+          FAILED ( "MEMBERSHIP TEST FOR 'UNNATURAL' ORDERING - 1" );
+     END IF;
+
+     IF MVAR NOT IN T'('P') .. T'('R')  OR
+        'M'  NOT IN ST
+     THEN
+          FAILED ( "MEMBERSHIP TEST FOR 'UNNATURAL' ORDERING - 2" );
+     END IF;
+
+     IF QCON IN T'('P') .. T'('R')  OR
+        MCON NOT IN ST
+     THEN
+          FAILED ( "MEMBERSHIP TEST FOR 'UNNATURAL' ORDERING - 3" );
+     END IF;
+
+     RESULT;
+
+END C45211A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220a.ada
new file mode 100644
index 000000000..382ccbb6d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220a.ada
@@ -0,0 +1,129 @@
+-- C45220A.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  '='  AND  '/='  PRODUCE CORRECT RESULTS ON
+--    BOOLEAN-TYPE OPERANDS (IN PARTICULAR, FOR OPERANDS HAVING
+--    DIFFERENT SUBTYPES).
+
+-- THIS TEST IS DERIVED FROM  C45201A.ADA .
+
+
+-- RM    27 OCTOBER 1980
+-- JWC 7/8/85   RENAMED TO -AB
+
+
+WITH  REPORT ;
+PROCEDURE  C45220A  IS
+
+
+     USE REPORT;
+
+     SUBTYPE  T1  IS  BOOLEAN RANGE FALSE..FALSE ;
+     SUBTYPE  T2  IS  BOOLEAN RANGE TRUE..TRUE ;
+     SUBTYPE  T3  IS  BOOLEAN RANGE FALSE..TRUE ;
+     SUBTYPE  T4  IS  T3 RANGE TRUE..TRUE ;
+
+     FVAR1  : T1 := FALSE ;
+     TVAR1  : T2 := TRUE ;
+     FVAR2  : T3 := FALSE ;
+     TVAR2  : T4 := TRUE ;
+
+     ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          ERROR_COUNT := ERROR_COUNT + 1 ;
+     END BUMP ;
+
+
+BEGIN
+
+
+     TEST( "C45220A" , "CHECK THAT  '='  AND  '/='  PRODUCE CORRECT" &
+                       " RESULTS ON BOOLEAN-TYPE OPERANDS" ) ;
+
+     -- 32  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
+     --               2    OPERATORS : '=' , '/=' ,
+     --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+     --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
+
+
+     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+
+     FVAR1  := IDENT_BOOL( FALSE ) ;
+     TVAR1  := IDENT_BOOL( TRUE ) ;
+     FVAR2  := IDENT_BOOL( FALSE ) ;
+     TVAR2  := IDENT_BOOL( TRUE ) ;
+
+     IF  FALSE =  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR1 =  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FALSE =  FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR2 =  FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  FALSE =  TRUE   THEN  BUMP ;                END IF;
+     IF  FVAR1 =  TRUE   THEN  BUMP ;                END IF;
+     IF  FALSE =  TVAR2  THEN  BUMP ;                END IF;
+     IF  FVAR2 =  TVAR1  THEN  BUMP ;                END IF;
+
+     IF  TRUE  =  FALSE  THEN  BUMP ;                END IF;
+     IF  TRUE  =  FVAR1  THEN  BUMP ;                END IF;
+     IF  TVAR2 =  FALSE  THEN  BUMP ;                END IF;
+     IF  TVAR1 =  FVAR2  THEN  BUMP ;                END IF;
+
+     IF  TRUE  =  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR1 =  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TRUE  =  TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR2 =  TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+
+     IF  FALSE /= FALSE  THEN  BUMP ;                END IF;
+     IF  FVAR1 /= FALSE  THEN  BUMP ;                END IF;
+     IF  FALSE /= FVAR2  THEN  BUMP ;                END IF;
+     IF  FVAR2 /= FVAR1  THEN  BUMP ;                END IF;
+
+     IF  FALSE /= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR1 /= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FALSE /= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR2 /= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  TRUE  /= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TRUE  /= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR2 /= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR1 /= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  TRUE  /= TRUE   THEN  BUMP ;                END IF;
+     IF  TVAR1 /= TRUE   THEN  BUMP ;                END IF;
+     IF  TRUE  /= TVAR2  THEN  BUMP ;                END IF;
+     IF  TVAR2 /= TVAR1  THEN  BUMP ;                END IF;
+
+
+     IF  ERROR_COUNT /=0  THEN
+          FAILED( "(IN)EQUALITY OF BOOLEAN VALUES - FAILURE1" );
+     END IF;
+
+
+     RESULT ;
+
+
+END C45220A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220b.ada
new file mode 100644
index 000000000..87ba73442
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220b.ada
@@ -0,0 +1,191 @@
+-- C45220B.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  '<' , '<=' , '>' , '>='  PRODUCE CORRECT RESULTS ON
+--    BOOLEAN-TYPE OPERANDS (IN PARTICULAR, FOR OPERANDS HAVING
+--    DIFFERENT SUBTYPES).
+
+-- THIS TEST IS DERIVED FROM  C45220A.ADA .
+
+
+-- RM    28 OCTOBER 1980
+-- JWC 7/8/85   RENAMED TO -AB
+
+
+WITH  REPORT ;
+PROCEDURE  C45220B  IS
+
+
+     USE REPORT;
+
+     SUBTYPE  T1  IS  BOOLEAN RANGE FALSE..FALSE ;
+     SUBTYPE  T2  IS  BOOLEAN RANGE TRUE..TRUE ;
+     SUBTYPE  T3  IS  BOOLEAN RANGE FALSE..TRUE ;
+     SUBTYPE  T4  IS  T3 RANGE TRUE..TRUE ;
+
+     FVAR1  : T1 := FALSE ;
+     TVAR1  : T2 := TRUE ;
+     FVAR2  : T3 := FALSE ;
+     TVAR2  : T4 := TRUE ;
+
+     ERROR_COUNT : INTEGER := 0 ;
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          ERROR_COUNT := ERROR_COUNT + 1 ;
+     END BUMP ;
+
+
+BEGIN
+
+
+     TEST( "C45220B" , "CHECK THAT  '<' , '<=' , '>' , '>='  PRODUCE" &
+                       " CORRECT RESULTS ON BOOLEAN-TYPE OPERANDS" ) ;
+
+     -- 64  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
+     --               4    OPERATORS : '<' , <=' , '>' , '>='
+     --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+     --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
+
+
+     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+
+     FVAR1  := IDENT_BOOL( FALSE ) ;
+     TVAR1  := IDENT_BOOL( TRUE ) ;
+     FVAR2  := IDENT_BOOL( FALSE ) ;
+     TVAR2  := IDENT_BOOL( TRUE ) ;
+
+
+     ERROR_COUNT := 0 ;
+
+     IF  FALSE <  FALSE  THEN  BUMP ;                END IF;
+     IF  FVAR1 <  FALSE  THEN  BUMP ;                END IF;
+     IF  FALSE <  FVAR2  THEN  BUMP ;                END IF;
+     IF  FVAR2 <  FVAR1  THEN  BUMP ;                END IF;
+
+     IF  FALSE <  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR1 <  TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FALSE <  TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR2 <  TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  TRUE  <  FALSE  THEN  BUMP ;                END IF;
+     IF  TRUE  <  FVAR1  THEN  BUMP ;                END IF;
+     IF  TVAR2 <  FALSE  THEN  BUMP ;                END IF;
+     IF  TVAR1 <  FVAR2  THEN  BUMP ;                END IF;
+
+     IF  TRUE  <  TRUE   THEN  BUMP ;                END IF;
+     IF  TVAR1 <  TRUE   THEN  BUMP ;                END IF;
+     IF  TRUE  <  TVAR2  THEN  BUMP ;                END IF;
+     IF  TVAR2 <  TVAR1  THEN  BUMP ;                END IF;
+
+     IF  ERROR_COUNT > 0  THEN
+          FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '<'" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     IF  FALSE <= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR1 <= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FALSE <= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR2 <= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  FALSE <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR1 <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FALSE <= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR2 <= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  TRUE  <= FALSE  THEN  BUMP ;                END IF;
+     IF  TRUE  <= FVAR1  THEN  BUMP ;                END IF;
+     IF  TVAR2 <= FALSE  THEN  BUMP ;                END IF;
+     IF  TVAR1 <= FVAR2  THEN  BUMP ;                END IF;
+
+     IF  TRUE  <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR1 <= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TRUE  <= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR2 <= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  ERROR_COUNT > 0  THEN
+          FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '<='" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     IF  FALSE >  FALSE  THEN  BUMP ;                END IF;
+     IF  FVAR1 >  FALSE  THEN  BUMP ;                END IF;
+     IF  FALSE >  FVAR2  THEN  BUMP ;                END IF;
+     IF  FVAR2 >  FVAR1  THEN  BUMP ;                END IF;
+
+     IF  FALSE >  TRUE   THEN  BUMP ;                END IF;
+     IF  FVAR1 >  TRUE   THEN  BUMP ;                END IF;
+     IF  FALSE >  TVAR2  THEN  BUMP ;                END IF;
+     IF  FVAR2 >  TVAR1  THEN  BUMP ;                END IF;
+
+     IF  TRUE  >  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TRUE  >  FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR2 >  FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR1 >  FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  TRUE  >  TRUE   THEN  BUMP ;                END IF;
+     IF  TVAR1 >  TRUE   THEN  BUMP ;                END IF;
+     IF  TRUE  >  TVAR2  THEN  BUMP ;                END IF;
+     IF  TVAR2 >  TVAR1  THEN  BUMP ;                END IF;
+
+     IF  ERROR_COUNT > 0  THEN
+          FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '>'" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     IF  FALSE >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR1 >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FALSE >= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  FVAR2 >= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  FALSE >= TRUE   THEN  BUMP ;                END IF;
+     IF  FVAR1 >= TRUE   THEN  BUMP ;                END IF;
+     IF  FALSE >= TVAR2  THEN  BUMP ;                END IF;
+     IF  FVAR2 >= TVAR1  THEN  BUMP ;                END IF;
+
+     IF  TRUE  >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TRUE  >= FVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR2 >= FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR1 >= FVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  TRUE  >= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR1 >= TRUE   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TRUE  >= TVAR2  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  TVAR2 >= TVAR1  THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  ERROR_COUNT > 0  THEN
+          FAILED( "ORDERING OF BOOLEAN VALUES - FAILURE '>='" );
+     END IF;
+
+
+     RESULT ;
+
+
+END C45220B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220c.ada
new file mode 100644
index 000000000..cb505f256
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220c.ada
@@ -0,0 +1,138 @@
+-- C45220C.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  '='  AND  '/='  PRODUCE CORRECT RESULTS ON
+--    OPERANDS OF A TYPE DERIVED FROM THE TYPE 'BOOLEAN'
+--    (IN PARTICULAR, FOR OPERANDS HAVING DIFFERENT SUBTYPES).
+
+-- THIS TEST IS DERIVED FROM  C45220A.ADA .
+
+
+-- RM    27 OCTOBER 1980
+-- JWC 7/8/85   RENAMED TO -AB
+
+
+WITH  REPORT ;
+PROCEDURE  C45220C  IS
+
+
+     USE REPORT;
+
+     TYPE  NB  IS  NEW BOOLEAN ;
+
+     SUBTYPE  T1  IS  NB RANGE NB'(FALSE)..NB'(FALSE) ;
+     SUBTYPE  T2  IS  NB RANGE NB'(TRUE )..NB'(TRUE );
+     SUBTYPE  T3  IS  NB RANGE NB'(FALSE)..NB'(TRUE );
+     SUBTYPE  T4  IS  T3 RANGE NB'(TRUE )..NB'(TRUE );
+
+     FVAR1   : T1 := NB'(FALSE) ;
+     TVAR1   : T2 := NB'(TRUE );
+     FVAR2   : T3 := NB'(FALSE) ;
+     TVAR2   : T4 := NB'(TRUE );
+
+     ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          ERROR_COUNT := ERROR_COUNT + 1 ;
+     END BUMP ;
+
+     FUNCTION  IDENT_NEW_BOOL( THE_ARGUMENT : NB )  RETURN  NB  IS
+     BEGIN
+          IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
+          ELSE  RETURN  NB'(FALSE) ;
+          END IF;
+     END ;
+
+
+BEGIN
+
+
+     TEST( "C45220C" , "CHECK THAT  '='  AND  '/='  PRODUCE CORRECT" &
+                       " RESULTS ON DERIVED-BOOLEAN-TYPE OPERANDS" ) ;
+
+     -- 32  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
+     --               2    OPERATORS : '=' , '/=' ,
+     --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+     --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
+
+
+     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+
+     FVAR1   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
+     TVAR1   := IDENT_NEW_BOOL( NB'(TRUE )) ;
+     FVAR2   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
+     TVAR2   := IDENT_NEW_BOOL( NB'(TRUE )) ;
+
+     IF  NB'(FALSE) =  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR1  =  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(FALSE) =      FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR2  =      FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  NB'(FALSE) =  NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF      FVAR1  =  NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF  NB'(FALSE) =      TVAR2   THEN  BUMP ;                END IF;
+     IF      FVAR2  =      TVAR1   THEN  BUMP ;                END IF;
+
+     IF  NB'(TRUE ) =  NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF  NB'(TRUE ) =      FVAR1   THEN  BUMP ;                END IF;
+     IF      TVAR2  =  NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF      TVAR1  =      FVAR2   THEN  BUMP ;                END IF;
+
+     IF  NB'(TRUE ) =  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR1  =  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(TRUE ) =      TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR2  =      TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+
+     IF  NB'(FALSE) /= NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF      FVAR1  /= NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF  NB'(FALSE) /=     FVAR2   THEN  BUMP ;                END IF;
+     IF      FVAR2  /=     FVAR1   THEN  BUMP ;                END IF;
+
+     IF  NB'(FALSE) /= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR1  /= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(FALSE) /=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR2  /=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  NB'(TRUE ) /= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(TRUE ) /=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR2  /= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR1  /=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  NB'(TRUE ) /= NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF      TVAR1  /= NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF  NB'(TRUE ) /=     TVAR2   THEN  BUMP ;                END IF;
+     IF      TVAR2  /=     TVAR1   THEN  BUMP ;                END IF;
+
+
+     IF  ERROR_COUNT /=0  THEN
+          FAILED( "(IN)EQUALITY OF N_BOOLEAN VALUES - FAILURE1" );
+     END IF;
+
+
+     RESULT ;
+
+
+END C45220C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220d.ada
new file mode 100644
index 000000000..752d1fcaa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220d.ada
@@ -0,0 +1,200 @@
+-- C45220D.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  '<' , '<=' , '>' , '>='  PRODUCE CORRECT RESULTS ON
+--    OPERANDS OF A TYPE DERIVED FROM THE TYPE 'BOOLEAN'
+--    (IN PARTICULAR, FOR OPERANDS HAVING DIFFERENT SUBTYPES).
+
+-- THIS TEST IS DERIVED FROM  C45220B.ADA , C45220C.ADA .
+
+
+-- RM    28 OCTOBER 1980
+-- JWC 7/8/85   RENAMED TO -AB
+
+WITH  REPORT ;
+PROCEDURE  C45220D  IS
+
+
+     USE REPORT;
+
+     TYPE  NB  IS  NEW BOOLEAN ;
+
+     SUBTYPE  T1  IS  NB RANGE NB'(FALSE)..NB'(FALSE) ;
+     SUBTYPE  T2  IS  NB RANGE NB'(TRUE )..NB'(TRUE );
+     SUBTYPE  T3  IS  NB RANGE NB'(FALSE)..NB'(TRUE );
+     SUBTYPE  T4  IS  T3 RANGE NB'(TRUE )..NB'(TRUE );
+
+     FVAR1   : T1 := NB'(FALSE) ;
+     TVAR1   : T2 := NB'(TRUE );
+     FVAR2   : T3 := NB'(FALSE) ;
+     TVAR2   : T4 := NB'(TRUE );
+
+     ERROR_COUNT : INTEGER := 0 ;
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          ERROR_COUNT := ERROR_COUNT + 1 ;
+     END BUMP ;
+
+     FUNCTION  IDENT_NEW_BOOL( THE_ARGUMENT : NB )  RETURN  NB  IS
+     BEGIN
+          IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
+          ELSE  RETURN  NB'(FALSE) ;
+          END IF;
+     END ;
+
+
+BEGIN
+
+
+     TEST( "C45220D" , "CHECK THAT  '<' , '<=' , '>' , '>='  PRODUCE" &
+                       " CORRECT RESULTS ON DERIVED-BOOLEAN-TYPE" &
+                       " OPERANDS" ) ;
+
+     -- 64  CASES ( 2 * 2  ORDERED PAIRS OF OPERAND VALUES,
+     --               4    OPERATORS : '<' , <=' , '>' , '>='
+     --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
+     --                    VARIABLE/LITERAL FOR RIGHT OPERAND.
+
+
+     --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
+
+     FVAR1   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
+     TVAR1   := IDENT_NEW_BOOL( NB'(TRUE )) ;
+     FVAR2   := IDENT_NEW_BOOL( NB'(FALSE) ) ;
+     TVAR2   := IDENT_NEW_BOOL( NB'(TRUE )) ;
+
+
+     ERROR_COUNT := 0 ;
+
+     IF  NB'(FALSE) <  NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF      FVAR1  <  NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF  NB'(FALSE) <      FVAR2   THEN  BUMP ;                END IF;
+     IF      FVAR2  <      FVAR1   THEN  BUMP ;                END IF;
+
+     IF  NB'(FALSE) <  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR1  <  NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(FALSE) <      TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR2  <      TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  NB'(TRUE ) <  NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF  NB'(TRUE ) <      FVAR1   THEN  BUMP ;                END IF;
+     IF      TVAR2  <  NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF      TVAR1  <      FVAR2   THEN  BUMP ;                END IF;
+
+     IF  NB'(TRUE ) <  NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF      TVAR1  <  NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF  NB'(TRUE ) <      TVAR2   THEN  BUMP ;                END IF;
+     IF      TVAR2  <      TVAR1   THEN  BUMP ;                END IF;
+
+     IF  ERROR_COUNT > 0  THEN
+          FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '<'" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     IF  NB'(FALSE) <= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR1  <= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(FALSE) <=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR2  <=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  NB'(FALSE) <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR1  <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(FALSE) <=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR2  <=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  NB'(TRUE ) <= NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF  NB'(TRUE ) <=     FVAR1   THEN  BUMP ;                END IF;
+     IF      TVAR2  <= NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF      TVAR1  <=     FVAR2   THEN  BUMP ;                END IF;
+
+     IF  NB'(TRUE ) <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR1  <= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(TRUE ) <=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR2  <=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  ERROR_COUNT > 0  THEN
+          FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '<='" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     IF  NB'(FALSE) >  NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF      FVAR1  >  NB'(FALSE)  THEN  BUMP ;                END IF;
+     IF  NB'(FALSE) >      FVAR2   THEN  BUMP ;                END IF;
+     IF      FVAR2  >      FVAR1   THEN  BUMP ;                END IF;
+
+     IF  NB'(FALSE) >  NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF      FVAR1  >  NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF  NB'(FALSE) >      TVAR2   THEN  BUMP ;                END IF;
+     IF      FVAR2  >      TVAR1   THEN  BUMP ;                END IF;
+
+     IF  NB'(TRUE ) >  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(TRUE ) >      FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR2  >  NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR1  >      FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  NB'(TRUE ) >  NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF      TVAR1  >  NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF  NB'(TRUE ) >      TVAR2   THEN  BUMP ;                END IF;
+     IF      TVAR2  >      TVAR1   THEN  BUMP ;                END IF;
+
+     IF  ERROR_COUNT > 0  THEN
+          FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '>'" );
+     END IF;
+
+
+     ERROR_COUNT := 0 ;
+
+     IF  NB'(FALSE) >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR1  >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(FALSE) >=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      FVAR2  >=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  NB'(FALSE) >= NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF      FVAR1  >= NB'(TRUE )  THEN  BUMP ;                END IF;
+     IF  NB'(FALSE) >=     TVAR2   THEN  BUMP ;                END IF;
+     IF      FVAR2  >=     TVAR1   THEN  BUMP ;                END IF;
+
+     IF  NB'(TRUE ) >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(TRUE ) >=     FVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR2  >= NB'(FALSE)  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR1  >=     FVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  NB'(TRUE ) >= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR1  >= NB'(TRUE )  THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF  NB'(TRUE ) >=     TVAR2   THEN  NULL ;  ELSE  BUMP ;  END IF;
+     IF      TVAR2  >=     TVAR1   THEN  NULL ;  ELSE  BUMP ;  END IF;
+
+     IF  ERROR_COUNT > 0  THEN
+          FAILED( "ORDERING OF N_BOOLEAN VALUES - FAILURE '>='" );
+     END IF;
+
+
+     RESULT ;
+
+
+END C45220D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220e.ada
new file mode 100644
index 000000000..0fbf5bfeb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220e.ada
@@ -0,0 +1,74 @@
+-- C45220E.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 PROPER OPERATION OF THE MEMBERSHIP OPERATORS  'IN'  AND
+--    'NOT IN'  FOR BOOLEAN TYPES.
+
+
+-- RM 03/20/81
+-- SPS 10/26/82
+
+
+WITH REPORT;
+PROCEDURE  C45220E  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C45220E" , "CHECK THE PROPER OPERATION OF THE MEMBERSHIP" &
+                       " OPERATORS  'IN'  AND  'NOT IN'  FOR" &
+                       " BOOLEAN TYPES" );
+
+     DECLARE
+
+          SUBTYPE  SUBBOOL   IS  BOOLEAN RANGE FALSE..TRUE ;
+
+          VAR  :            BOOLEAN  :=  FALSE ;
+          CON  :   CONSTANT BOOLEAN  :=  FALSE ;
+
+     BEGIN
+
+          IF   TRUE NOT IN SUBBOOL  OR
+               VAR  NOT IN SUBBOOL  OR
+               CON  NOT IN SUBBOOL
+          THEN
+               FAILED( "WRONG VALUES FOR 'IN SUBBOOL'" );
+          END IF;
+
+          IF   FALSE   IN TRUE..FALSE  OR
+               VAR NOT IN FALSE..TRUE  OR
+               CON     IN TRUE..TRUE
+          THEN
+               FAILED( "WRONG VALUES FOR 'IN AAA..BBB'" );
+          END IF;
+
+
+          RESULT ;
+
+
+     END ;
+
+
+END C45220E ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220f.ada
new file mode 100644
index 000000000..3d557d95b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45220f.ada
@@ -0,0 +1,67 @@
+-- C45220F.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 MEMBERSHIP OPERATIONS WORK CORRECTLY FOR DERIVED
+-- BOOLEAN TYPES.
+
+-- GLH 08/01/85
+
+WITH REPORT;
+PROCEDURE  C45220F  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C45220F" , "CHECK MEMBERSHIP OPERATIONS FOR " &
+                       "DERIVED BOOLEAN");
+
+     DECLARE
+
+          TYPE NEWBOOL IS NEW BOOLEAN;
+
+          VAR  :          NEWBOOL  :=  FALSE ;
+          CON  : CONSTANT NEWBOOL  :=  FALSE ;
+
+     BEGIN
+
+          IF   TRUE NOT IN NEWBOOL  OR
+               VAR  NOT IN NEWBOOL  OR
+               CON  NOT IN NEWBOOL
+          THEN
+               FAILED( "WRONG VALUES FOR 'IN NEWBOOL'" );
+          END IF;
+
+          IF  NEWBOOL'(FALSE)   IN TRUE..FALSE  OR
+              VAR           NOT IN FALSE..TRUE  OR
+              CON               IN TRUE..TRUE
+          THEN
+               FAILED( "WRONG VALUES FOR 'IN AAA..BBB'" );
+          END IF;
+
+          RESULT ;
+
+     END ;
+
+END C45220F ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231a.ada
new file mode 100644
index 000000000..d5fce67cd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231a.ada
@@ -0,0 +1,252 @@
+-- C45231A.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 RELATIONAL AND MEMBERSHIP OPERATIONS YIELD CORRECT 
+-- RESULTS FOR PREDEFINED TYPE INTEGER (INCLUDING THE CASE IN WHICH THE
+-- RELATIONAL OPERATORS ARE REDEFINED).
+
+-- SUBTESTS ARE:
+--     (A). TESTS FOR RELATIONAL OPERATORS.
+--     (B). TESTS FOR MEMBERSHIP OPERATORS.
+--     (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE 
+--          RELATIONAL OPERATORS ARE REDEFINED.
+
+
+-- RJW 2/4/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45231A IS
+     
+     
+BEGIN
+
+     TEST ( "C45231A", "CHECK THAT THE RELATIONAL AND " &
+                       "MEMBERSHIP OPERATIONS YIELD CORRECT " &
+                       "RESULTS FOR PREDEFINED TYPE INTEGER " &
+                       "(INCLUDING THE CASE IN WHICH THE " &
+                       "RELATIONAL OPERATORS ARE REDEFINED)" );
+
+     DECLARE -- (A)
+     
+          I1A, I1B   : INTEGER          := IDENT_INT (1);
+          I2         : INTEGER          := IDENT_INT (2);
+          CI2        : CONSTANT INTEGER := 2;
+
+
+     BEGIN -- (A)
+
+          IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 1" );
+          END IF;
+
+          IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 2" );
+          END IF;
+
+          IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 3" );
+          END IF;
+
+          IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 4");
+          END IF;
+
+          IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 5" );
+          END IF;
+
+          IF (I1A >= I1B) AND (I1A <= I1B) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 6" );
+          END IF;
+
+          IF ">" (LEFT => CI2, RIGHT => I1A) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 7" );
+          END IF;
+
+          IF "<" (LEFT => I1A, RIGHT => I2) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 8" );
+          END IF;
+
+          IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 9 ");
+          END IF;
+
+          IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 10 ");
+          END IF;
+
+          IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 11 ");
+          END IF;
+
+          IF "/=" (LEFT => CI2, RIGHT => 4) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 12 ");
+          END IF;
+         
+     END; -- (A) 
+
+     ----------------------------------------------------------------
+
+     DECLARE -- (B)
+          
+          SUBTYPE ST IS INTEGER RANGE -10 .. 10;
+
+          I1 : INTEGER := IDENT_INT (1);
+          I5 : INTEGER := IDENT_INT (5);
+
+          CI2  : CONSTANT INTEGER := 2;
+          CI10 : CONSTANT INTEGER := 10;
+          
+          
+     BEGIN -- (B)
+     
+          IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.1" );
+          END IF;
+
+          IF (IDENT_INT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.2" );
+          END IF;
+
+          IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT_INT (-11) IN ST) 
+             THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.3" );
+          END IF;
+     
+          IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.4" );
+          END IF;
+
+          IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN 
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.5" );
+          END IF;
+
+     END; -- (B)
+
+     -------------------------------------------------------------
+
+     DECLARE -- (C)
+
+          SUBTYPE ST IS INTEGER RANGE -10 .. 10;
+
+          I1 : INTEGER := IDENT_INT (1);
+          I5 : INTEGER := IDENT_INT (5);
+
+          CI2  : CONSTANT INTEGER := 2;
+          CI10 : CONSTANT INTEGER := 10;
+          
+                    
+          FUNCTION ">" ( L, R : INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN INTEGER'POS (L) <= INTEGER'POS (R);
+          END;
+                    
+          FUNCTION ">=" ( L, R : INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN INTEGER'POS (L) < INTEGER'POS (R);
+          END;
+
+          FUNCTION "<" ( L, R : INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN  INTEGER'POS (L) >= INTEGER'POS (R);
+          END;
+                    
+          FUNCTION "<=" ( L, R : INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN INTEGER'POS (L) > INTEGER'POS (R);
+          END;
+                    
+     BEGIN -- (C)
+
+          IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.1" );
+          END IF;
+
+          IF (IDENT_INT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.2" );
+          END IF;
+
+          IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT_INT (-11) IN ST) 
+             THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.3" );
+          END IF;
+     
+          IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.4" );
+          END IF;
+
+          IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN 
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.5" );
+          END IF;
+
+     END; -- (C)
+
+     RESULT;
+
+END C45231A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231b.dep
new file mode 100644
index 000000000..ba5fecf40
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231b.dep
@@ -0,0 +1,265 @@
+-- C45231B.DEP
+
+--                             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 RELATIONAL AND MEMBERSHIP OPERATIONS YIELD
+--     CORRECT RESULTS FOR PREDEFINED TYPE SHORT_INTEGER (INCLUDING
+--     THE CASE IN WHICH THE RELATIONAL OPERATORS ARE REDEFINED).
+
+--     SUBTESTS ARE:
+--       (A). TESTS FOR RELATIONAL OPERATORS.
+--       (B). TESTS FOR MEMBERSHIP OPERATORS.
+--       (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE
+--            RELATIONAL OPERATORS ARE REDEFINED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH
+--     SUPPORT SHORT_INTEGER.
+
+--     IF "SHORT_INTEGER" IS NOT SUPPORTED THEN THE DECLARATION OF
+--     "CHECK_SHORT" MUST BE REJECTED.
+
+-- HISTORY:
+--     RJW 02/04/86 CREATED ORIGINAL TEST.
+--     DHH 01/08/87 ENTERED APPLICABILITY CRITERIA AND FORMATTED HEADER.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45231B IS
+
+     CHECK_SHORT : SHORT_INTEGER;                       -- N/A => ERROR.
+
+     FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
+     END IDENT;
+
+BEGIN
+
+     TEST ( "C45231B", "CHECK THAT THE RELATIONAL AND " &
+                       "MEMBERSHIP OPERATIONS YIELD CORRECT " &
+                       "RESULTS FOR PREDEFINED TYPE SHORT_INTEGER " &
+                       "(INCLUDING THE CASE IN WHICH THE " &
+                       "RELATIONAL OPERATORS ARE REDEFINED)" );
+
+     DECLARE -- (A)
+
+          I1A, I1B   : SHORT_INTEGER          := IDENT (1);
+          I2         : SHORT_INTEGER          := IDENT (2);
+          CI2        : CONSTANT SHORT_INTEGER := 2;
+
+
+     BEGIN -- (A)
+
+          IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 1" );
+          END IF;
+
+          IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 2" );
+          END IF;
+
+          IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 3" );
+          END IF;
+
+          IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 4");
+          END IF;
+
+          IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 5" );
+          END IF;
+
+          IF (I1A >= I1B) AND (I1A <= I1B) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 6" );
+          END IF;
+
+          IF ">" (LEFT => CI2, RIGHT => I1A) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 7" );
+          END IF;
+
+          IF "<" (LEFT => I1A, RIGHT => I2) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 8" );
+          END IF;
+
+          IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 9 ");
+          END IF;
+
+          IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 10 ");
+          END IF;
+
+          IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 11 ");
+          END IF;
+
+          IF "/=" (LEFT => CI2, RIGHT => 4) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 12 ");
+          END IF;
+
+     END; -- (A)
+
+     ----------------------------------------------------------------
+
+     DECLARE -- (B)
+
+          SUBTYPE ST IS SHORT_INTEGER RANGE -10 .. 10;
+
+          I1 : SHORT_INTEGER := IDENT (1);
+          I5 : SHORT_INTEGER := IDENT (5);
+
+          CI2  : CONSTANT SHORT_INTEGER := 2;
+          CI10 : CONSTANT SHORT_INTEGER := 10;
+
+
+     BEGIN -- (B)
+
+          IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.1" );
+          END IF;
+
+          IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.2" );
+          END IF;
+
+          IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.3" );
+          END IF;
+
+          IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.4" );
+          END IF;
+
+          IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.5" );
+          END IF;
+
+     END; -- (B)
+
+     -------------------------------------------------------------
+
+     DECLARE -- (C)
+
+          SUBTYPE ST IS SHORT_INTEGER RANGE -10 .. 10;
+
+          I1 : SHORT_INTEGER := IDENT (1);
+          I5 : SHORT_INTEGER := IDENT (5);
+
+          CI2  : CONSTANT SHORT_INTEGER := 2;
+          CI10 : CONSTANT SHORT_INTEGER := 10;
+
+
+          FUNCTION ">" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN SHORT_INTEGER'POS (L) <= SHORT_INTEGER'POS (R);
+          END;
+
+          FUNCTION ">=" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN SHORT_INTEGER'POS (L) < SHORT_INTEGER'POS (R);
+          END;
+
+          FUNCTION "<" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN  SHORT_INTEGER'POS (L) >= SHORT_INTEGER'POS (R);
+          END;
+
+          FUNCTION "<=" ( L, R : SHORT_INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN SHORT_INTEGER'POS (L) > SHORT_INTEGER'POS (R);
+          END;
+
+     BEGIN -- (C)
+
+          IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.1" );
+          END IF;
+
+          IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.2" );
+          END IF;
+
+          IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.3" );
+          END IF;
+
+          IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.4" );
+          END IF;
+
+          IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.5" );
+          END IF;
+
+     END; -- (C)
+
+     RESULT;
+
+END C45231B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231c.dep
new file mode 100644
index 000000000..d2971e295
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231c.dep
@@ -0,0 +1,265 @@
+-- C45231C.DEP
+
+--                             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 RELATIONAL AND MEMBERSHIP OPERATIONS YIELD
+--     CORRECT RESULTS FOR PREDEFINED TYPE LONG_INTEGER (INCLUDING
+--     THE CASE IN WHICH THE RELATIONAL OPERATORS ARE REDEFINED).
+
+--     SUBTESTS ARE:
+--       (A). TESTS FOR RELATIONAL OPERATORS.
+--       (B). TESTS FOR MEMBERSHIP OPERATORS.
+--       (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE
+--            RELATIONAL OPERATORS ARE REDEFINED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     LONG_INTEGER.
+
+--     IF "LONG_INTEGER" IS NOT SUPPORTED THEN THE DECLARATION OF
+--     "CHECK_LONG" MUST BE REJECTED.
+
+-- HISTORY:
+--     RJW 02/04/86 CREATED ORIGINAL TEST.
+--     DHH 01/08/87 ENTERED APPLICABILITY CRITERIA AND FORMATTED HEADER.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45231C IS
+
+     CHECK_LONG : LONG_INTEGER;                        -- N/A => ERROR.
+
+     FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
+     END IDENT;
+
+BEGIN
+
+     TEST ( "C45231C", "CHECK THAT THE RELATIONAL AND " &
+                       "MEMBERSHIP OPERATIONS YIELD CORRECT " &
+                       "RESULTS FOR PREDEFINED TYPE LONG_INTEGER " &
+                       "(INCLUDING THE CASE IN WHICH THE " &
+                       "RELATIONAL OPERATORS ARE REDEFINED)" );
+
+     DECLARE -- (A)
+
+          I1A, I1B   : LONG_INTEGER          := IDENT (1);
+          I2         : LONG_INTEGER          := IDENT (2);
+          CI2        : CONSTANT LONG_INTEGER := 2;
+
+
+     BEGIN -- (A)
+
+          IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 1" );
+          END IF;
+
+          IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 2" );
+          END IF;
+
+          IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 3" );
+          END IF;
+
+          IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 4");
+          END IF;
+
+          IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 5" );
+          END IF;
+
+          IF (I1A >= I1B) AND (I1A <= I1B) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 6" );
+          END IF;
+
+          IF ">" (LEFT => CI2, RIGHT => I1A) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 7" );
+          END IF;
+
+          IF "<" (LEFT => I1A, RIGHT => I2) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 8" );
+          END IF;
+
+          IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 9 ");
+          END IF;
+
+          IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 10 ");
+          END IF;
+
+          IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 11 ");
+          END IF;
+
+          IF "/=" (LEFT => CI2, RIGHT => 4) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 12 ");
+          END IF;
+
+     END; -- (A)
+
+     ----------------------------------------------------------------
+
+     DECLARE -- (B)
+
+          SUBTYPE ST IS LONG_INTEGER RANGE -10 .. 10;
+
+          I1 : LONG_INTEGER := IDENT (1);
+          I5 : LONG_INTEGER := IDENT (5);
+
+          CI2  : CONSTANT LONG_INTEGER := 2;
+          CI10 : CONSTANT LONG_INTEGER := 10;
+
+
+     BEGIN -- (B)
+
+          IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.1" );
+          END IF;
+
+          IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.2" );
+          END IF;
+
+          IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.3" );
+          END IF;
+
+          IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.4" );
+          END IF;
+
+          IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.5" );
+          END IF;
+
+     END; -- (B)
+
+     -------------------------------------------------------------
+
+     DECLARE -- (C)
+
+          SUBTYPE ST IS LONG_INTEGER RANGE -10 .. 10;
+
+          I1 : LONG_INTEGER := IDENT (1);
+          I5 : LONG_INTEGER := IDENT (5);
+
+          CI2  : CONSTANT LONG_INTEGER := 2;
+          CI10 : CONSTANT LONG_INTEGER := 10;
+
+
+          FUNCTION ">" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN LONG_INTEGER'POS (L) <= LONG_INTEGER'POS (R);
+          END;
+
+          FUNCTION ">=" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN LONG_INTEGER'POS (L) < LONG_INTEGER'POS (R);
+          END;
+
+          FUNCTION "<" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN  LONG_INTEGER'POS (L) >= LONG_INTEGER'POS (R);
+          END;
+
+          FUNCTION "<=" ( L, R : LONG_INTEGER ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN LONG_INTEGER'POS (L) > LONG_INTEGER'POS (R);
+          END;
+
+     BEGIN -- (C)
+
+          IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.1" );
+          END IF;
+
+          IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.2" );
+          END IF;
+
+          IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.3" );
+          END IF;
+
+          IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.4" );
+          END IF;
+
+          IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.5" );
+          END IF;
+
+     END; -- (C)
+
+     RESULT;
+
+END C45231C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231d.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231d.tst
new file mode 100644
index 000000000..66be11b1b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45231d.tst
@@ -0,0 +1,274 @@
+-- C45231D.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 THE RELATIONAL AND MEMBERSHIP OPERATIONS YIELD CORRECT
+--     RESULTS FOR PREDEFINED TYPE $NAME (INCLUDING THE CASE IN
+--     WHICH THE RELATIONAL OPERATORS ARE REDEFINED).
+
+--     SUBTESTS ARE:
+--         (A). TESTS FOR RELATIONAL OPERATORS.
+--         (B). TESTS FOR MEMBERSHIP OPERATORS.
+--         (C). TESTS FOR MEMBERSHIP OPERATORS IN THE CASE IN WHICH THE
+--              RELATIONAL OPERATORS ARE REDEFINED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT A
+--     PREDEFINED INTEGER TYPE OTHER THAN INTEGER, SHORT_INTEGER, OR
+--     LONG_INTEGER.
+
+--     IF NO SUCH PREDEFINED INTEGER TYPE IS SUPPORTED, THEN THE
+--     SPECIFICATION OF THE FUNCTION IDENT MUST BE REJECTED.
+
+-- MACRO SUBSTITUTION:
+--     $NAME IS A PREDEFINED INTEGER TYPE OTHER THAN INTEGER,
+--     SHORT_INTEGER, AND LONG_INTEGER.
+
+-- HISTORY:
+--     RJW 02/04/86
+--     THS 04/16/90  ADDED OMITTED "-- N/A => ERROR." MESSAGE AND
+--                   MODIFIED HEADER.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45231D IS
+
+     FUNCTION IDENT (X : $NAME)
+          RETURN $NAME IS   -- N/A => ERROR.
+     BEGIN
+          RETURN $NAME (IDENT_INT (INTEGER (X)));
+     END IDENT;
+
+BEGIN
+
+     TEST ( "C45231D", "CHECK THAT THE RELATIONAL AND " &
+                       "MEMBERSHIP OPERATIONS YIELD CORRECT " &
+                       "RESULTS FOR PREDEFINED TYPE $NAME " &
+                       "(INCLUDING THE CASE IN WHICH THE " &
+                       "RELATIONAL OPERATORS ARE REDEFINED)" );
+
+     DECLARE -- (A)
+
+          I1A, I1B   : $NAME          := IDENT (1);
+          I2         : $NAME          := IDENT (2);
+          CI2        : CONSTANT $NAME := 2;
+
+
+     BEGIN -- (A)
+
+          IF (I2 = CI2) AND (NOT (I2 /= CI2)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 1" );
+          END IF;
+
+          IF (I2 /= 4) AND (NOT (I2 = 4)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 2" );
+          END IF;
+
+          IF (I1A = I1B) AND (NOT (I1A /= I1B)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 3" );
+          END IF;
+
+          IF (I2 >= CI2) AND (NOT (I2 < CI2)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 4");
+          END IF;
+
+          IF (I2 <= 4) AND (NOT (I2 > 4)) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 5" );
+          END IF;
+
+          IF (I1A >= I1B) AND (I1A <= I1B) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 6" );
+          END IF;
+
+          IF ">" (LEFT => CI2, RIGHT => I1A) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 7" );
+          END IF;
+
+          IF "<" (LEFT => I1A, RIGHT => I2) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 8" );
+          END IF;
+
+          IF ">=" (LEFT => I1A, RIGHT => I1A ) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 9 ");
+          END IF;
+
+          IF "<=" (LEFT => I1A, RIGHT => CI2) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 10 ");
+          END IF;
+
+          IF "=" (LEFT => I1A, RIGHT => I1B ) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 11 ");
+          END IF;
+
+          IF "/=" (LEFT => CI2, RIGHT => 4) THEN
+               NULL;
+          ELSE
+               FAILED ( "RELATIONAL TEST - 12 ");
+          END IF;
+
+     END; -- (A)
+
+     ----------------------------------------------------------------
+
+     DECLARE -- (B)
+
+          SUBTYPE ST IS $NAME RANGE -10 .. 10;
+
+          I1 : $NAME := IDENT (1);
+          I5 : $NAME := IDENT (5);
+
+          CI2  : CONSTANT $NAME := 2;
+          CI10 : CONSTANT $NAME := 10;
+
+
+     BEGIN -- (B)
+
+          IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.1" );
+          END IF;
+
+          IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.2" );
+          END IF;
+
+          IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.3" );
+          END IF;
+
+          IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.4" );
+          END IF;
+
+          IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - B.5" );
+          END IF;
+
+     END; -- (B)
+
+     -------------------------------------------------------------
+
+     DECLARE -- (C)
+
+          SUBTYPE ST IS $NAME RANGE -10 .. 10;
+
+          I1 : $NAME := IDENT (1);
+          I5 : $NAME := IDENT (5);
+
+          CI2  : CONSTANT $NAME := 2;
+          CI10 : CONSTANT $NAME := 10;
+
+
+          FUNCTION ">" ( L, R : $NAME ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN $NAME'POS (L) <= 
+	              $NAME'POS (R);
+          END;
+
+          FUNCTION ">=" ( L, R : $NAME ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN $NAME'POS (L) < 
+                      $NAME'POS (R);
+          END;
+
+          FUNCTION "<" ( L, R : $NAME ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN  $NAME'POS (L) >= 
+                       $NAME'POS (R);
+          END;
+
+          FUNCTION "<=" ( L, R : $NAME ) RETURN BOOLEAN IS
+          BEGIN
+               RETURN $NAME'POS (L) > 
+                      $NAME'POS (R);
+          END;
+
+     BEGIN -- (C)
+
+          IF (I1 IN ST) AND (I1 NOT IN CI2 .. CI10) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.1" );
+          END IF;
+
+          IF (IDENT (11) NOT IN ST) AND (CI2 IN I1 .. I5) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.2" );
+          END IF;
+
+          IF NOT (I5 NOT IN CI2 .. 10) AND NOT (IDENT (-11) IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.3" );
+          END IF;
+
+          IF NOT (I1 IN CI2 .. CI10) AND NOT (I5 NOT IN ST) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.4" );
+          END IF;
+
+          IF (I1 NOT IN I5 .. I1) AND NOT (I5 IN I5 .. I1) THEN
+               NULL;
+          ELSE
+               FAILED ( "MEMBERSHIP TEST - C.5" );
+          END IF;
+
+     END; -- (C)
+
+     RESULT;
+
+END C45231D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45232b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45232b.ada
new file mode 100644
index 000000000..459bc835b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45232b.ada
@@ -0,0 +1,135 @@
+-- C45232B.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 NO EXCEPTION IS RAISED WHEN AN INTEGER LITERAL IN
+-- A COMPARISON  BELONGS TO THE BASE TYPE BUT IS OUTSIDE THE 
+-- SUBTYPE OF THE OTHER OPERAND.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- P. BRASHEAR  08/21/86
+-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT, SYSTEM; USE REPORT;
+PROCEDURE C45232B IS
+
+BEGIN
+
+     TEST ("C45232B", "NO EXCEPTION IS RAISED WHEN AN INTEGER " & 
+                      "LITERAL IN A COMPARISON BELONGS TO THE BASE " &
+                      "TYPE BUT IS OUTSIDE THE SUBTYPE OF THE " &
+                      "OTHER OPERAND");
+
+     DECLARE
+
+           TYPE INT10 IS RANGE -10 .. 5;
+
+     BEGIN    
+
+          IF 7 > INT10'(-10) THEN
+               COMMENT ("NO EXCEPTION RAISED FOR '7 > " &
+                        "INT10'(-10)'");
+          ELSE
+               FAILED ("WRONG RESULT FOR '7 > INT10'(-10)'");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR '7 " &
+                       "> INT10'(-10)'");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR '7 > " &
+                       "INT10'(-10)'");
+     END;  
+
+     DECLARE
+
+           TYPE INT10 IS RANGE -10 .. 5;
+
+     BEGIN    
+
+          IF 7 NOT IN INT10 THEN
+               COMMENT ("NO EXCEPTION RAISED FOR '7 NOT IN " &
+                        "INT'");
+          ELSE
+               FAILED ("WRONG RESULT FOR '7 NOT IN INT'");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR '7 " &
+                       "NOT IN INT'");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR '7 NOT IN " &
+                       "INT'");
+     END;  
+
+     DECLARE
+
+           TYPE INT700 IS RANGE -700 .. 500;
+
+     BEGIN    
+          IF 600 > INT700'(5) THEN
+               COMMENT ("NO EXCEPTION RAISED FOR '600 > " &
+                        "INT700'(5)'");
+          ELSE
+               FAILED ("WRONG RESULT FOR '600 > INT700'(5)'");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR '600 " &
+                       "> INT700'(5)'");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR '600 > " &
+                       "INT700'(5)'");
+     END;  
+
+     DECLARE
+
+           TYPE INT700 IS RANGE -700 .. 500;
+
+     BEGIN    
+
+          IF 600 NOT IN INT700 THEN
+               COMMENT ("NO EXCEPTION RAISED FOR '600 NOT IN " &
+                        "INT700'");
+          ELSE
+               FAILED ("WRONG RESULT FOR '600 NOT IN INT700'");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR '600 " &
+                       "NOT IN INT700'");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR '600 NOT IN " &
+                       "INT700'");
+     END;  
+
+     RESULT;
+
+END C45232B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45242b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45242b.ada
new file mode 100644
index 000000000..bd05afc3b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45242b.ada
@@ -0,0 +1,148 @@
+-- C45242B.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 NO EXCEPTION IS RAISED WHEN A FLOATING POINT LITERAL
+--     OPERAND IN A COMPARISON OR A FLOATING POINT LITERAL LEFT OPERAND
+--     IN A MEMBERSHIP TEST BELONGS TO THE BASE TYPE BUT IS OUTSIDE
+--     THE RANGE OF THE SUBTYPE.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--     PWB 09/04/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+--     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT, SYSTEM; USE REPORT;
+PROCEDURE C45242B IS
+
+BEGIN
+
+     TEST ("C45242B", "NO EXCEPTION IS RAISED WHEN A FLOATING " &
+                      "LITERAL USED IN A COMPARISON OR AS THE " &
+                      "LEFT OPERAND IN A MEMBERSHIP TEST " &
+                      "BELONGS TO THE BASE TYPE BUT IS OUTSIDE " &
+                      "THE RANGE OF THE SUBTYPE");
+
+     DECLARE
+          N : FLOAT := FLOAT (IDENT_INT (1));
+          SUBTYPE FLOAT_1 IS FLOAT RANGE -1.0 .. N;
+          NUM : FLOAT_1 := N;
+     BEGIN    -- PRE-DEFINED FLOAT COMPARISON
+
+          IF EQUAL(3,3) THEN
+               NUM := FLOAT_1'(0.5);
+          END IF;
+
+          IF 2.0 > NUM THEN
+               COMMENT ("NO EXCEPTION RAISED FOR PRE-DEFINED FLOAT " &
+                        "COMPARISON");
+          ELSE
+               FAILED ("WRONG RESULT FROM PRE-DEFINED FLOAT " &
+                       "COMPARISON");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR PRE-DEFINED " &
+                       "FLOAT COMPARISON");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR PRE-DEFINED " &
+                       "FLOAT COMPARISON");
+     END;  -- PRE-DEFINED FLOAT COMPARISON
+
+     DECLARE
+          N : FLOAT := FLOAT (IDENT_INT (1));
+          SUBTYPE FLOAT_1 IS FLOAT RANGE -1.0 .. N;
+     BEGIN    -- PRE-DEFINED FLOAT MEMBERSHIP
+
+          IF 2.0 IN FLOAT_1 THEN
+               FAILED ("WRONG RESULT FROM PRE-DEFINED FLOAT " &
+                       "MEMBERSHIP");
+          ELSE
+               COMMENT ("NO EXCEPTION RAISED FOR PRE-DEFINED FLOAT " &
+                        "MEMBERSHIP");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR PRE-DEFINED " &
+                       "FLOAT MEMBERSHIP");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR PRE-DEFINED " &
+                       "FLOAT MEMBERSHIP");
+     END;  -- PRE-DEFINED FLOAT MEMBERSHIP
+
+     DECLARE -- PRECISE FLOAT COMPARISON
+          TYPE FINE_FLOAT IS DIGITS SYSTEM.MAX_DIGITS;
+          N : FINE_FLOAT := 0.5 * FINE_FLOAT (IDENT_INT (1));
+          SUBTYPE SUB_FINE IS FINE_FLOAT RANGE -0.5 .. N;
+          NUM : SUB_FINE := N;
+     BEGIN
+          IF EQUAL(3,3) THEN
+               NUM := 0.25;
+          END IF;
+
+          IF 0.75 > NUM THEN
+               COMMENT ("NO EXCEPTION RAISED FOR FINE_FLOAT " &
+                        "COMPARISON");
+          ELSE
+               FAILED ("WRONG RESULT FROM FINE_FLOAT COMPARISON");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR " &
+                       "FINE_FLOAT COMPARISON");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR  " &
+                       "FINE_FLOAT COMPARISON");
+     END;  --  FINE_FLOAT COMPARISON
+
+     DECLARE -- PRECISE FLOAT MEMBERSHIP
+          TYPE FINE_FLOAT IS DIGITS SYSTEM.MAX_DIGITS;
+          N : FINE_FLOAT := 0.5 * FINE_FLOAT (IDENT_INT (1));
+          SUBTYPE SUB_FINE IS FINE_FLOAT RANGE -0.5 .. N;
+     BEGIN
+
+          IF 0.75 IN SUB_FINE THEN
+               FAILED ("WRONG RESULT FROM FINE_FLOAT MEMBERSHIP");
+          ELSE
+               COMMENT ("NO EXCEPTION RAISED FOR FINE_FLOAT " &
+                        "MEMBERSHIP");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR " &
+                       "FINE_FLOAT MEMBERSHIP");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR  " &
+                       "FINE_FLOAT MEMBERSHIP");
+     END;  --  FINE_FLOAT MEMBERSHIP
+
+     RESULT;
+
+END C45242B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45251a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45251a.ada
new file mode 100644
index 000000000..0e1bbb508
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45251a.ada
@@ -0,0 +1,178 @@
+-- C45251A.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 RELATIONAL OPERATIONS ON FIXED POINT TYPES THE
+-- FOLLOWING HOLD:
+--       (A) A /= B IS THE SAME AS NOT (A = B).
+--       (B) A < B IS THE SAME AS NOT (A >= B).
+--       (C) A > B IS THE SAME AS NOT (A <= B).
+--       (D) ADJACENT MODEL NUMBERS GIVE CORRECT RESULTS.
+--       (E) NON-MODEL NUMBERS WITH DISTINCT MODEL INTERVALS GIVE
+--           CORRECT RESULTS.
+--       (F) CASE WHERE MODEL INTERVALS INTERSECT IN A SINGLE MODEL
+--           NUMBER GIVES CORRECT RESULT.
+
+-- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+
+-- WRG 8/26/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45251A IS
+
+     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+     -- 'MANTISSA VALUE.
+
+     TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+     TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
+
+BEGIN
+
+     TEST ("C45251A", "CHECK RELATIONAL OPERATIONS FOR FIXED POINT " &
+                      "TYPES - BASIC TYPES");
+
+     -------------------------------------------------------------------
+
+     DECLARE
+          A, B : LIKE_DURATION_M23 := 0.0;
+          C, D : DECIMAL_M4        := 0.0;
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := 2#0.0000_0011#; -- JUST BELOW LIKE_DURATION'SMALL.
+               B := 2#0.0000_0101#; -- JUST ABOVE LIKE_DURATION'SMALL.
+          END IF;
+
+          -- (A)
+          IF A /= B XOR NOT (A = B) THEN
+               FAILED ("A /= B IS NOT THE SAME AS NOT (A = B)");
+          END IF;
+
+          -- (B)
+          IF A < B XOR NOT (A >= B) THEN
+               FAILED ("A < B IS NOT THE SAME AS NOT (A >= B)");
+          END IF;
+
+          -- (C)
+          IF A > B XOR NOT (A <= B) THEN
+               FAILED ("A > B IS NOT THE SAME AS NOT (A <= B)");
+          END IF;
+
+          -- (D)
+          IF EQUAL (3, 3) THEN
+               A := -(16#1_5180.00#); -- (-86_400.0)
+               B := -(16#1_517F.FC#); -- (-86_400.0 + 1.0/64)
+
+               C :=  64.0; -- DECIMAL_M4'SMALL.
+               D := 128.0; -- 2 * DECIMAL_M4'SMALL.
+          END IF;
+          IF "=" (LEFT => A, RIGHT => B) THEN
+               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                       "- (A = B)");
+          END IF;
+          IF NOT "/=" (LEFT => C, RIGHT => D) THEN
+               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                       "- (C /= D)");
+          END IF;
+          IF "<" (LEFT => B, RIGHT => A) THEN
+               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                       "- (B < A)");
+          END IF;
+          IF ">" (LEFT => C, RIGHT => D) THEN
+               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                       "- (C > D)");
+          END IF;
+          IF ">=" (LEFT => A, RIGHT => B) THEN
+               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                       "- (A >= B)");
+          END IF;
+          IF "<=" (LEFT => D, RIGHT => C) THEN
+               FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
+                       "- (D <= C)");
+          END IF;
+
+          -- (E)
+          IF EQUAL (3, 3) THEN
+               A :=  0.02;  -- INTERVAL IS  1.0/64 ..  2.0/64.
+               B := -0.02;  -- INTERVAL IS -2.0/64 .. -1.0/64.
+
+               C :=  800.0; -- INTERVAL IS 768.0 .. 832.0.
+               D :=  900.0; -- INTERVAL IS 896.0 .. 960.0.
+          END IF;
+          IF A = B THEN
+               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                       "INTERVALS GIVE INCORRECT RESULT - (A = B)");
+          END IF;
+          IF NOT (C /= D) THEN
+               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                       "INTERVALS GIVE INCORRECT RESULT - (C /= D)");
+          END IF;
+          IF A < B THEN
+               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                       "INTERVALS GIVE INCORRECT RESULT - (A < B)");
+          END IF;
+          IF C > D THEN
+               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                       "INTERVALS GIVE INCORRECT RESULT - (C > D)");
+          END IF;
+          IF B >= A THEN
+               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                       "INTERVALS GIVE INCORRECT RESULT - (B >= A)");
+          END IF;
+          IF D <= C THEN
+               FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
+                       "INTERVALS GIVE INCORRECT RESULT - (D <= C)");
+          END IF;
+
+          -- (F)
+          IF EQUAL (3, 3) THEN
+               B := 0.035;  -- INTERVAL IS 2.0/64 .. 3.0/64.
+
+               C := 850.0;  -- INTERVAL IS 832.0 .. 896.0.
+          END IF;
+          IF NOT (A <= B) THEN
+               FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
+                       "COMMON MODEL INTERVAL END-POINT GIVES " &
+                       "INCORRECT RESULT - (A <= B)");
+          END IF;
+          IF A > B THEN
+               FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
+                       "COMMON MODEL INTERVAL END-POINT GIVES " &
+                       "INCORRECT RESULT - (A > B)");
+          END IF;
+          IF NOT (D >= C) THEN
+               FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
+                       "COMMON MODEL INTERVAL END-POINT GIVES " &
+                       "INCORRECT RESULT - (D >= C)");
+          END IF;
+          IF D < C THEN
+               FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
+                       "COMMON MODEL INTERVAL END-POINT GIVES " &
+                       "INCORRECT RESULT - (D < C)");
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+END C45251A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45252a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45252a.ada
new file mode 100644
index 000000000..e21496662
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45252a.ada
@@ -0,0 +1,200 @@
+-- C45252A.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 FIXED POINT TYPES, CHECK THAT
+-- CONSTRAINT_ERROR IS RAISED WHEN A LITERAL USED IN A COMPARISON OR
+-- MEMBERSHIP OPERATION (AS THE FIRST OPERAND) DOES NOT BELONG TO THE
+-- BASE TYPE.
+--
+-- CHECK THAT NO EXCEPTION IS RAISED FOR A FIXED POINT RELATIONAL OR
+-- MEMBERSHIP OPERATION IF LITERAL VALUES BELONG TO THE BASE TYPE.
+
+-- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- WRG 9/10/86
+-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45252A IS
+
+     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+     -- 'MANTISSA VALUE.
+
+     TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
+     TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+
+BEGIN
+
+     TEST ("C45252A", "CHECK RAISING OF EXCEPTIONS BY RELATIONAL " &
+                      "OPERATIONS FOR FIXED POINT TYPES - BASIC TYPES");
+
+     -------------------------------------------------------------------
+
+     BEGIN
+          -- 2.0 ** 31 < 2.9E9 < 2.0 ** 32.
+          IF 2.9E9 <= LIKE_DURATION_M23'LAST THEN
+               FAILED ("2.9E9 <= LIKE_DURATION_M23'LAST");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
+                        """2.9E9 <= LIKE_DURATION_M23'LAST""");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY COMPARISON " &
+                       """2.9E9 <= LIKE_DURATION_M23'LAST""");
+     END;
+
+     -------------------------------------------------------------------
+
+     BEGIN
+          -- 2.0 ** 63 < 1.0E19 < 2.0 ** 64.
+          IF 1.0E19 IN LIKE_DURATION_M23 THEN
+               FAILED ("1.0E19 IN LIKE_DURATION_M23");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
+                        """1.0E19 IN LIKE_DURATION_M23""");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY MEMBERSHIP TEST " &
+                       """1.0E19 IN LIKE_DURATION_M23""");
+     END;
+
+     -------------------------------------------------------------------
+
+     BEGIN
+          -- 2.0 ** 63 < 1.0E19 < 2.0 ** 64.
+          IF 1.0E19 <= MIDDLE_M3'LAST THEN
+               FAILED ("1.0E19 <= MIDDLE_M3'LAST");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
+                        """1.0E19 <= MIDDLE_M3'LAST""");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY COMPARISON " &
+                       """1.0E19 <= MIDDLE_M3'LAST""");
+     END;
+
+     -------------------------------------------------------------------
+
+     BEGIN
+          -- 2.0 ** 31 < 2.9E9 < 2.0 ** 32.
+          IF 2.9E9 IN MIDDLE_M3 THEN
+               FAILED ("2.9E9 IN MIDDLE_M3");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
+                        """2.9E9 IN MIDDLE_M3""");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY MEMBERSHIP TEST " &
+                       """2.9E9 IN MIDDLE_M3""");
+     END;
+
+     -------------------------------------------------------------------
+
+     BEGIN
+          -- 3.5 IS A MODEL NUMBER OF THE TYPE MIDDLE_M3.
+          IF 3.5 <= MIDDLE_M3'LAST THEN
+               FAILED ("3.5 <= MIDDLE_M3'LAST");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
+                       """3.5 <= MIDDLE_M3'LAST""");
+          WHEN OTHERS =>
+               FAILED ("SOME EXCEPTION RAISED BY COMPARISON " &
+                       """3.5 <= MIDDLE_M3'LAST""");
+     END;
+
+     -------------------------------------------------------------------
+
+     BEGIN
+          IF 3.0 IN MIDDLE_M3 THEN
+               FAILED ("3.0 IN MIDDLE_M3");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
+                       """3.0 IN MIDDLE_M3""");
+          WHEN OTHERS =>
+               FAILED ("SOME EXCEPTION RAISED BY MEMBERSHIP TEST " &
+                       """3.0 IN MIDDLE_M3""");
+     END;
+
+     -------------------------------------------------------------------
+
+     BEGIN
+          IF 86_450.0 <= LIKE_DURATION_M23'LAST THEN
+               FAILED ("86_450.0 <= LIKE_DURATION_M23'LAST");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED BY COMPARISON " &
+                       """86_450.0 <= LIKE_DURATION_M23'LAST""");
+          WHEN OTHERS =>
+               FAILED ("SOME EXCEPTION RAISED BY COMPARISON " &
+                       """86_450.0 <= LIKE_DURATION_M23'LAST""");
+     END;
+
+     -------------------------------------------------------------------
+
+     BEGIN
+          IF 86_500.0 IN LIKE_DURATION_M23 THEN
+               FAILED ("86_500.0 IN LIKE_DURATION_M23");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
+                       """86_500.0 IN LIKE_DURATION_M23""");
+          WHEN OTHERS =>
+               FAILED ("SOME EXCEPTION RAISED BY MEMBERSHIP TEST " &
+                       """86_500.0 IN LIKE_DURATION_M23""");
+     END;
+
+     -------------------------------------------------------------------
+
+     BEGIN
+          IF -86_450.0 IN LIKE_DURATION_M23 THEN
+               FAILED ("-86_450.0 IN LIKE_DURATION_M23");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED BY MEMBERSHIP TEST " &
+                       """-86_450.0 IN LIKE_DURATION_M23""");
+          WHEN OTHERS =>
+               FAILED ("SOME EXCEPTION RAISED BY MEMBERSHIP TEST " &
+                       """-86_450.0 IN LIKE_DURATION_M23""");
+     END;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+END C45252A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45252b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45252b.ada
new file mode 100644
index 000000000..bc6b46d38
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45252b.ada
@@ -0,0 +1,146 @@
+-- C45252B.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 NO EXCEPTION IS RAISED WHEN A FIXED POINT LITERAL
+--     OPERAND IN A COMPARISON OR A FIXED POINT LITERAL LEFT OPERAND
+--     IN A MEMBERSHIP TEST BELONGS TO THE BASE TYPE BUT IS OUTSIDE
+--     THE RANGE OF THE SUBTYPE.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--     PWB 09/04/86 CREATED ORIGINAL TEST.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+--     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT, SYSTEM; USE REPORT;
+PROCEDURE C45252B IS
+
+BEGIN
+
+     TEST ("C45252B", "NO EXCEPTION IS RAISED WHEN A FIXED " &
+                      "LITERAL USED IN A COMPARISON OR AS THE " &
+                      "LEFT OPERAND IN A MEMBERSHIP TEST " &
+                      "BELONGS TO THE BASE TYPE BUT IS OUTSIDE " &
+                      "THE RANGE OF THE SUBTYPE");
+
+     DECLARE
+          TYPE FIXED IS DELTA 0.25 RANGE -10.0 .. 10.0;
+          SUBTYPE FIXED_1 IS FIXED RANGE -1.0 .. 1.0;
+          NUM : FIXED_1 := 0.0;
+     BEGIN    -- FIXED COMPARISON
+
+          IF EQUAL(3,3) THEN
+               NUM := FIXED_1'(0.5);
+          END IF;
+
+          IF 2.0 > NUM THEN
+               COMMENT ("NO EXCEPTION RAISED FOR FIXED " &
+                        "COMPARISON");
+          ELSE
+               FAILED ("WRONG RESULT FROM FIXED " &
+                       "COMPARISON");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR " &
+                       "FIXED COMPARISON");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR " &
+                       "FIXED COMPARISON");
+     END;  -- FIXED COMPARISON
+
+     DECLARE
+          TYPE FIXED IS DELTA 0.25 RANGE -10.0 .. 10.0;
+          SUBTYPE FIXED_1 IS FIXED RANGE -1.0 .. 1.0;
+     BEGIN    -- FIXED MEMBERSHIP
+
+          IF 2.0 IN FIXED_1 THEN
+               FAILED ("WRONG RESULT FROM FIXED " &
+                       "MEMBERSHIP");
+          ELSE
+               COMMENT ("NO EXCEPTION RAISED FOR FIXED " &
+                        "MEMBERSHIP");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR  " &
+                       "FIXED MEMBERSHIP");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR  " &
+                       "FIXED MEMBERSHIP");
+     END;  -- FIXED MEMBERSHIP
+
+     DECLARE -- PRECISE FIXED COMPARISON
+          TYPE FINE_FIXED IS DELTA SYSTEM.FINE_DELTA RANGE -1.0 .. 1.0;
+          SUBTYPE SUB_FINE IS FINE_FIXED RANGE -0.5 .. 0.5;
+          NUM : SUB_FINE := 0.0;
+     BEGIN
+          IF EQUAL(3,3) THEN
+               NUM := 0.25;
+          END IF;
+
+          IF 0.75 > NUM THEN
+               COMMENT ("NO EXCEPTION RAISED FOR FINE_FIXED " &
+                        "COMPARISON");
+          ELSE
+               FAILED ("WRONG RESULT FROM FINE_FIXED COMPARISON");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR " &
+                       "FINE_FIXED COMPARISON");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR  " &
+                       "FINE_FIXED COMPARISON");
+     END;  --  FINE_FIXED COMPARISON
+
+     DECLARE -- PRECISE FIXED MEMBERSHIP
+          TYPE FINE_FIXED IS DIGITS SYSTEM.MAX_DIGITS;
+          SUBTYPE SUB_FINE IS FINE_FIXED RANGE -0.5 .. 0.5;
+     BEGIN
+
+          IF 0.75 IN SUB_FINE THEN
+               FAILED ("WRONG RESULT FROM FINE_FIXED MEMBERSHIP");
+          ELSE
+               COMMENT ("NO EXCEPTION RAISED FOR FINE_FIXED " &
+                        "MEMBERSHIP");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED FOR " &
+                       "FINE_FIXED MEMBERSHIP");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR  " &
+                       "FINE_FIXED MEMBERSHIP");
+     END;  --  FINE_FIXED MEMBERSHIP
+
+     RESULT;
+
+END C45252B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45253a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45253a.ada
new file mode 100644
index 000000000..d2a06618a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45253a.ada
@@ -0,0 +1,97 @@
+-- C45253A.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 FIXED POINT TYPES "A IN T" AND "A NOT IN T" GIVE
+-- APPROPRIATE RESULTS, EVEN WHEN USER-DEFINED ORDERING OPERATORS EXIST
+-- FOR T.
+
+-- WRG 8/27/86
+-- JRL 06/12/96  Added function The_Delta. Eliminated static expressions
+--               outside the base range of type T.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45253A IS
+
+     TYPE FIXED IS DELTA 0.25 RANGE 0.0 .. 1000.0;
+     TYPE T IS NEW FIXED;
+
+     FUNCTION "<" (LEFT, RIGHT : T) RETURN BOOLEAN IS
+     BEGIN
+          RETURN FIXED (LEFT) >= FIXED (RIGHT);
+     END "<";
+
+     FUNCTION "<=" (LEFT, RIGHT : T) RETURN BOOLEAN IS
+     BEGIN
+          RETURN FIXED (LEFT) > FIXED (RIGHT);
+     END "<=";
+
+     FUNCTION ">" (LEFT, RIGHT : T) RETURN BOOLEAN IS
+     BEGIN
+          RETURN FIXED (LEFT) <= FIXED (RIGHT);
+     END ">";
+
+     FUNCTION ">=" (LEFT, RIGHT : T) RETURN BOOLEAN IS
+     BEGIN
+          RETURN FIXED (LEFT) < FIXED (RIGHT);
+     END ">=";
+
+     function The_Delta return T is
+     begin
+        return T'Delta;
+     end The_Delta;
+
+BEGIN
+
+     TEST ("C45253A", "CHECK THAT FOR FIXED POINT TYPES ""A IN T"" " &
+                      "AND ""A NOT IN T"" GIVE APPROPRIATE RESULTS, " &
+                      "EVEN WHEN USER-DEFINED ORDERING OPERATORS " &
+                      "EXIST FOR T");
+
+     IF IDENT_INT (1) * 0.0 NOT IN T THEN
+          FAILED ("0.0 NOT IN T");
+     END IF;
+
+-- 06/12/96      IF IDENT_INT (1) * 1000.0 NOT IN T THEN
+     if Ident_Int (2) * 500.0 not in T then
+          FAILED ("1000.0 NOT IN T");
+     END IF;
+
+-- 06/12/96      IF IDENT_INT (1) * (-0.25) IN T THEN
+     if Ident_Int (1) * (-The_Delta) in T then
+          FAILED ("-0.25 IN T");
+     END IF;
+
+-- 06/12/96      IF IDENT_INT (1) * 1000.25 IN T THEN
+     if Ident_Int (2) * 500.0 + The_Delta in T then
+          FAILED ("1000.25 IN T");
+     END IF;
+
+-- 06/12/96      IF IDENT_INT (1) * (-1000.0) IN T THEN
+     if Ident_Int (2) * (-500.0) in T then
+          FAILED ("-1000.0 IN T");
+     END IF;
+
+     RESULT;
+
+END C45253A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262a.ada
new file mode 100644
index 000000000..270dc88dc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262a.ada
@@ -0,0 +1,214 @@
+-- C45262A.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 ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
+-- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST CHECKS ARRAYS OF
+-- INTEGERS.
+
+-- JWC 8/19/85
+-- JRK 6/24/86   FIXED SPELLING IN FAILURE MESSAGE.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45262A IS
+BEGIN
+     TEST ("C45262A", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
+                      "DISCRETE ARRAY TYPES - INTEGER COMPONENTS");
+
+     DECLARE
+
+          TYPE ARR IS ARRAY( INTEGER RANGE <> ) OF INTEGER;
+          ARR1 : ARR(1 .. IDENT_INT(0));
+          ARR2 : ARR(2 .. IDENT_INT(0));
+          ARR3 : ARR(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 0);
+          ARR4 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 0);
+          ARR5 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 1);
+          ARR6 : ARR(1 .. IDENT_INT(5)) := (1 .. IDENT_INT(5) => 0);
+          ARR7 : ARR(0 .. 4) := (0 .. 3 => 0, 4 => 1);
+          ARR8 : ARR(0 .. IDENT_INT(4)) := (0 .. IDENT_INT(4) => 0);
+          ARR9 : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => 0);
+          ARRA : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => 1);
+
+     BEGIN
+          IF ARR1 < ARR2 THEN
+               FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <");
+          END IF;
+
+          IF NOT (ARR1 <= ARR2) THEN
+               FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <=");
+          END IF;
+
+          IF ARR1 > ARR2 THEN
+               FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >");
+          END IF;
+
+          IF NOT ( ">=" (ARR1, ARR2) ) THEN
+               FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >=");
+          END IF;
+
+          IF ARR3 < ARR1 THEN
+               FAILED ("NON-NULL ARRAY ARR3 LESS THAN NULL ARR1");
+          END IF;
+
+          IF ARR3 <= ARR1 THEN
+               FAILED ("NON-NULL ARRAY ARR3 LESS THAN EQUAL NULL ARR1");
+          END IF;
+
+          IF NOT ( ">" (ARR3, ARR1) ) THEN
+               FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN NULL " &
+                       "ARR1");
+          END IF;
+
+          IF NOT (ARR3 >= ARR1) THEN
+               FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN EQUAL " &
+                       "NULL ARR1");
+          END IF;
+
+          IF ARR3 < ARR4 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <");
+          END IF;
+
+          IF NOT ( "<=" (ARR3, ARR4) ) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <=");
+          END IF;
+
+          IF ARR3 > ARR4 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >");
+          END IF;
+
+          IF NOT (ARR3 >= ARR4) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >=");
+          END IF;
+
+          IF NOT ( "<" (ARR3, ARR5) ) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <");
+          END IF;
+
+          IF NOT (ARR3 <= ARR5) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <=");
+          END IF;
+
+          IF ARR3 > ARR5 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >");
+          END IF;
+
+          IF ARR3 >= ARR5 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >=");
+          END IF;
+
+          IF NOT (ARR6 < ARR7) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
+          END IF;
+
+          IF NOT (ARR6 <= ARR7) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                       "<=");
+          END IF;
+
+          IF ARR6 > ARR7 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - >");
+          END IF;
+
+          IF ">=" (LEFT => ARR6, RIGHT => ARR7) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                       ">=");
+          END IF;
+
+          IF ARR6 < ARR8 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <");
+          END IF;
+
+          IF NOT (ARR6 <= ARR8) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <=");
+          END IF;
+
+          IF ">" (RIGHT => ARR8, LEFT => ARR6) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >");
+          END IF;
+
+          IF NOT (ARR6 >= ARR8) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >=");
+          END IF;
+
+          IF ARR8 < ARR9 THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <");
+          END IF;
+
+          IF ARR8 <= ARR9 THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <=");
+          END IF;
+
+          IF NOT (ARR8 > ARR9) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >");
+          END IF;
+
+          IF NOT (ARR8 >= ARR9) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >=");
+          END IF;
+
+          IF NOT (ARR8 < ARRA) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <");
+          END IF;
+
+          IF NOT (ARR8 <= ARRA) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <=");
+          END IF;
+
+          IF ARR8 > ARRA THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >");
+          END IF;
+
+          IF ARR8 >= ARRA THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >=");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45262A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262b.ada
new file mode 100644
index 000000000..9d4e80676
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262b.ada
@@ -0,0 +1,219 @@
+-- C45262B.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 ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
+-- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST CHECKS STRING TYPES.
+
+-- JWC 9/9/85
+-- JRK 6/24/86   FIXED SPELLING IN FAILURE MESSAGE.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45262B IS
+BEGIN
+     TEST ("C45262B", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
+                      "DISCRETE ARRAY TYPES - TYPE STRING");
+
+     DECLARE
+
+          STRING1 : STRING(2 .. IDENT_INT(1));
+          STRING2 : STRING(3 .. IDENT_INT(1));
+          STRING3 : STRING(2 .. IDENT_INT(2)) := (IDENT_INT(2) => 'A');
+          STRING4 : STRING(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 'A');
+          STRING5 : STRING(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 'B');
+          STRING6 : STRING(2 .. IDENT_INT(6)) :=
+                                             (2 .. IDENT_INT(6) => 'A');
+          STRING7 : STRING(1 .. 5) := (1 .. 4 => 'A', 5 => 'B');
+          STRING8 : STRING(1 .. IDENT_INT(5)) :=
+                                             (1 .. IDENT_INT(5) => 'A');
+          STRING9 : STRING(1 .. IDENT_INT(4)) :=
+                                             (1 .. IDENT_INT(4) => 'A');
+          STRINGA : STRING(1 .. IDENT_INT(4)) :=
+                                             (1 .. IDENT_INT(4) => 'B');
+
+     BEGIN
+          IF STRING1 < STRING2 THEN
+               FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - <");
+          END IF;
+
+          IF NOT (STRING1 <= STRING2) THEN
+               FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - " &
+                       "<=");
+          END IF;
+
+          IF STRING1 > STRING2 THEN
+               FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - >");
+          END IF;
+
+          IF NOT ( ">=" (STRING1, STRING2) ) THEN
+               FAILED ("NULL ARRAYS STRING1 AND STRING2 NOT EQUAL - " &
+                       ">=");
+          END IF;
+
+          IF STRING3 < STRING1 THEN
+               FAILED ("NON-NULL ARRAY STRING3 LESS THAN NULL STRING1");
+          END IF;
+
+          IF STRING3 <= STRING1 THEN
+               FAILED ("NON-NULL ARRAY STRING3 LESS THAN EQUAL NULL " &
+                        "STRING1");
+          END IF;
+
+          IF NOT ( ">" (STRING3, STRING1) ) THEN
+               FAILED ("NON-NULL ARRAY STRING3 NOT GREATER THAN NULL " &
+                       "STRING1");
+          END IF;
+
+          IF NOT (STRING3 >= STRING1) THEN
+               FAILED ("NON-NULL ARRAY STRING3 NOT GREATER THAN " &
+                       "EQUAL NULL STRING1");
+          END IF;
+
+          IF STRING3 < STRING4 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <");
+          END IF;
+
+          IF NOT ( "<=" (STRING3, STRING4) ) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <=");
+          END IF;
+
+          IF STRING3 > STRING4 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >");
+          END IF;
+
+          IF NOT (STRING3 >= STRING4) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >=");
+          END IF;
+
+          IF NOT ( "<" (STRING3, STRING5) ) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <");
+          END IF;
+
+          IF NOT (STRING3 <= STRING5) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <=");
+          END IF;
+
+          IF STRING3 > STRING5 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >");
+          END IF;
+
+          IF STRING3 >= STRING5 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >=");
+          END IF;
+
+          IF NOT (STRING6 < STRING7) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
+          END IF;
+
+          IF NOT (STRING6 <= STRING7) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                       "<=");
+          END IF;
+
+          IF STRING6 > STRING7 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - >");
+          END IF;
+
+          IF ">=" (LEFT => STRING6, RIGHT => STRING7) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                       ">=");
+          END IF;
+
+          IF STRING6 < STRING8 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <");
+          END IF;
+
+          IF NOT (STRING6 <= STRING8) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <=");
+          END IF;
+
+          IF ">" (RIGHT => STRING8, LEFT => STRING6) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >");
+          END IF;
+
+          IF NOT (STRING6 >= STRING8) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >=");
+          END IF;
+
+          IF STRING8 < STRING9 THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <");
+          END IF;
+
+          IF STRING8 <= STRING9 THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <=");
+          END IF;
+
+          IF NOT (STRING8 > STRING9) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >");
+          END IF;
+
+          IF NOT (STRING8 >= STRING9) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >=");
+          END IF;
+
+          IF NOT (STRING8 < STRINGA) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <");
+          END IF;
+
+          IF NOT (STRING8 <= STRINGA) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <=");
+          END IF;
+
+          IF STRING8 > STRINGA THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >");
+          END IF;
+
+          IF STRING8 >= STRINGA THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >=");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45262B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262c.ada
new file mode 100644
index 000000000..a4e156a74
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262c.ada
@@ -0,0 +1,216 @@
+-- C45262C.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 ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
+-- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST CHECKS ARRAYS OF
+-- AN ENUMERATION TYPE.
+
+-- JWC 8/19/85
+-- JRK 6/24/86   FIXED SPELLING IN FAILURE MESSAGE.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45262C IS
+BEGIN
+     TEST ("C45262C", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
+                      "DISCRETE ARRAY TYPES - ENUMERATED COMPONENTS");
+
+     DECLARE
+
+          SUBTYPE SUBINT IS INTEGER RANGE 0 .. 5;
+          TYPE ENUM IS (E0, E1);
+          TYPE ARR IS ARRAY( SUBINT RANGE <> ) OF ENUM;
+          ARR1 : ARR(1 .. IDENT_INT(0));
+          ARR2 : ARR(2 .. IDENT_INT(0));
+          ARR3 : ARR(1 .. IDENT_INT(1)) := (IDENT_INT(1) => E0);
+          ARR4 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => E0);
+          ARR5 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => E1);
+          ARR6 : ARR(1 .. IDENT_INT(5)) := (1 .. IDENT_INT(5) => E0);
+          ARR7 : ARR(0 .. 4) := (0 .. 3 => E0, 4 => E1);
+          ARR8 : ARR(0 .. IDENT_INT(4)) := (0 .. IDENT_INT(4) => E0);
+          ARR9 : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => E0);
+          ARRA : ARR(0 .. IDENT_INT(3)) := (0 .. IDENT_INT(3) => E1);
+
+     BEGIN
+          IF ARR1 < ARR2 THEN
+               FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <");
+          END IF;
+
+          IF NOT (ARR1 <= ARR2) THEN
+               FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <=");
+          END IF;
+
+          IF ARR1 > ARR2 THEN
+               FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >");
+          END IF;
+
+          IF NOT ( ">=" (ARR1, ARR2) ) THEN
+               FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - >=");
+          END IF;
+
+          IF ARR3 < ARR1 THEN
+               FAILED ("NON-NULL ARRAY ARR3 LESS THAN NULL ARR1");
+          END IF;
+
+          IF ARR3 <= ARR1 THEN
+               FAILED ("NON-NULL ARRAY ARR3 LESS THAN EQUAL NULL ARR1");
+          END IF;
+
+          IF NOT ( ">" (ARR3, ARR1) ) THEN
+               FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN NULL " &
+                       "ARR1");
+          END IF;
+
+          IF NOT (ARR3 >= ARR1) THEN
+               FAILED ("NON-NULL ARRAY ARR3 NOT GREATER THAN EQUAL " &
+                       "NULL ARR1");
+          END IF;
+
+          IF ARR3 < ARR4 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <");
+          END IF;
+
+          IF NOT ( "<=" (ARR3, ARR4) ) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <=");
+          END IF;
+
+          IF ARR3 > ARR4 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >");
+          END IF;
+
+          IF NOT (ARR3 >= ARR4) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >=");
+          END IF;
+
+          IF NOT ( "<" (ARR3, ARR5) ) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <");
+          END IF;
+
+          IF NOT (ARR3 <= ARR5) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <=");
+          END IF;
+
+          IF ARR3 > ARR5 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >");
+          END IF;
+
+          IF ARR3 >= ARR5 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >=");
+          END IF;
+
+          IF NOT (ARR6 < ARR7) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
+          END IF;
+
+          IF NOT (ARR6 <= ARR7) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                       "<=");
+          END IF;
+
+          IF ARR6 > ARR7 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - >");
+          END IF;
+
+          IF ">=" (LEFT => ARR6, RIGHT => ARR7) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - " &
+                       ">=");
+          END IF;
+
+          IF ARR6 < ARR8 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <");
+          END IF;
+
+          IF NOT (ARR6 <= ARR8) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - <=");
+          END IF;
+
+          IF ">" (RIGHT => ARR8, LEFT => ARR6) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >");
+          END IF;
+
+          IF NOT (ARR6 >= ARR8) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS EQUAL - >=");
+          END IF;
+
+          IF ARR8 < ARR9 THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <");
+          END IF;
+
+          IF ARR8 <= ARR9 THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - <=");
+          END IF;
+
+          IF NOT (ARR8 > ARR9) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >");
+          END IF;
+
+          IF NOT (ARR8 >= ARR9) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >=");
+          END IF;
+
+          IF NOT (ARR8 < ARRA) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <");
+          END IF;
+
+          IF NOT (ARR8 <= ARRA) THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - <=");
+          END IF;
+
+          IF ARR8 > ARRA THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >");
+          END IF;
+
+          IF ARR8 >= ARRA THEN
+               FAILED ("DIFFERENT NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >=");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45262C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262d.ada
new file mode 100644
index 000000000..7889501b5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45262d.ada
@@ -0,0 +1,105 @@
+-- C45262D.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 ORDERING COMPARISONS YIELD CORRECT RESULTS FOR
+-- ONE-DIMENSIONAL DISCRETE ARRAY TYPES.  THIS TEST USES
+-- USER-DEFINED ORDERING OPERATORS FOR THE DISCRETE COMPONENT TYPE.
+
+-- JWC 8/19/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45262D IS
+
+     FUNCTION "<"(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          RETURN STANDARD.">="(LEFT, RIGHT);
+     END "<";
+
+     FUNCTION "<="(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          RETURN STANDARD.">"(LEFT, RIGHT);
+     END "<=";
+
+     FUNCTION ">"(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          RETURN STANDARD."<="(LEFT, RIGHT);
+     END ">";
+
+     FUNCTION ">="(LEFT, RIGHT : INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          RETURN STANDARD."<"(LEFT, RIGHT);
+     END ">=";
+
+BEGIN
+     TEST ("C45262D", "ORDERING COMPARISONS OF ONE-DIMENSIONAL " &
+                      "DISCRETE ARRAY TYPES");
+
+     DECLARE
+
+          SUBTYPE SUBINT IS INTEGER RANGE 0 .. 5;
+          TYPE ARR IS ARRAY( SUBINT RANGE <> ) OF INTEGER;
+          ARR1 : ARR(1 .. IDENT_INT(0));
+          ARR2 : ARR(2 .. IDENT_INT(0));
+          ARR3 : ARR(1 .. IDENT_INT(1)) := (IDENT_INT(1) => 0);
+          ARR4 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 0);
+          ARR5 : ARR(0 .. IDENT_INT(0)) := (IDENT_INT(0) => 1);
+          ARR6 : ARR(1 .. IDENT_INT(5)) := (1 .. IDENT_INT(5) => 0);
+          ARR7 : ARR(0 .. 4) := (0 .. 3 => 0, 4 => 1);
+
+     BEGIN
+
+          IF ARR1 < ARR2 THEN
+               FAILED ("NULL ARRAYS ARR1 AND ARR2 NOT EQUAL - <");
+          END IF;
+
+          IF ARR3 <= ARR1 THEN
+               FAILED ("NON-NULL ARRAY ARR3 LESS THAN EQUAL NULL " &
+                       "ARR1");
+          END IF;
+
+          IF ARR3 > ARR4 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS EQUAL - >");
+          END IF;
+
+          IF NOT (ARR3(1) > ARR4(0)) THEN
+               FAILED ("REDEFINED COMPONENT COMPARISON - >");
+          END IF;
+
+          IF ARR3 >= ARR5 THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "COMPONENTS NOT EQUAL - >=");
+          END IF;
+
+          IF NOT ( "<" (ARR6, ARR7) ) THEN
+               FAILED ("DIFFERENT BOUNDS, SAME NUMBER OF COMPONENTS, " &
+                       "MULTIPLE COMPONENTS, COMPONENTS NOT EQUAL - <");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45262D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45264a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45264a.ada
new file mode 100644
index 000000000..d701be0f6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45264a.ada
@@ -0,0 +1,109 @@
+-- C45264A.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 EQUALITY COMPARISONS YIELD CORRECT RESULTS FOR ONE
+-- DIMENSIONAL AND MULTI-DIMENSIONAL ARRAY TYPES.
+-- CASE THAT CHECKS THAT TWO NULL ARRAYS OF THE SAME TYPE ARE
+-- ALWAYS EQUAL.
+
+-- PK  02/21/84
+-- EG  05/30/84
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE C45264A IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+
+BEGIN
+
+     TEST("C45264A","CHECK THAT EQUALITY COMPARISONS YIELD CORRECT " &
+                    "RESULTS FOR ONE DIMENSIONAL AND MULTI-"         &
+                    "DIMENSIONAL ARRAY TYPES");
+
+     DECLARE
+
+          TYPE A1 IS ARRAY(INT RANGE <>) OF INTEGER;
+
+     BEGIN
+
+          IF A1'(1 .. IDENT_INT(2) => IDENT_INT(1)) /=
+             A1'(IDENT_INT(2) .. 3 => IDENT_INT(1)) THEN
+               FAILED ("A1 - ARRAYS NOT EQUAL");
+          END IF;
+
+     EXCEPTION
+
+          WHEN OTHERS => 
+               FAILED ("A1 - EXCEPTION RAISED");
+
+     END;
+
+     DECLARE
+
+          TYPE A2 IS ARRAY(INT RANGE <>, INT RANGE <>) OF INTEGER;
+
+     BEGIN
+          IF A2'(1 .. IDENT_INT(2) => 
+                 (IDENT_INT(3) .. IDENT_INT(2) => IDENT_INT(1))) /=
+             A2'(IDENT_INT(2) .. 3 => 
+                 (IDENT_INT(2) .. IDENT_INT(1) =>  IDENT_INT(1))) THEN
+                FAILED ("A2 - ARRAYS NOT EQUAL");
+          END IF;
+
+     EXCEPTION
+
+          WHEN OTHERS => 
+                FAILED ("A2 - EXCEPTION RAISED");
+
+     END;
+
+     DECLARE
+
+          TYPE A3 IS 
+               ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>) OF
+                    INTEGER;
+
+     BEGIN
+
+          IF A3'(1 .. IDENT_INT(2) => 
+                 (IDENT_INT(1) .. IDENT_INT(3) => 
+                  (IDENT_INT(3) .. IDENT_INT(2) => IDENT_INT(1)))) /=
+             A3'(IDENT_INT(1) .. 3 => 
+                 (IDENT_INT(2) .. IDENT_INT(1) =>  
+                  (IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)))) THEN
+                FAILED ("A3 - ARRAYS NOT EQUAL");
+          END IF;
+
+     EXCEPTION
+
+          WHEN OTHERS => 
+                FAILED ("A3 - EXCEPTION RAISED");
+
+     END;
+
+     RESULT;
+
+END C45264A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45264b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45264b.ada
new file mode 100644
index 000000000..44063f7ac
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45264b.ada
@@ -0,0 +1,88 @@
+-- C45264B.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 EQUALITY COMPARISONS YIELD CORRECT RESULTS FOR ONE
+-- DIMENSIONAL AND MULTI-DIMENSIONAL ARRAY TYPES.
+-- THIS TEST CHECKS THE CASE WHERE THE ARRAY HAS A BOUND THAT DEPENDS ON
+-- A DISCRIMINANT WITH DEFAULTS.
+
+-- JWC 11/18/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45264B IS
+
+BEGIN
+
+     TEST("C45264B","CHECK THAT EQUALITY COMPARISONS YIELD CORRECT " &
+                    "RESULTS FOR ONE DIMENSIONAL AND MULTI-"         &
+                    "DIMENSIONAL ARRAY TYPES");
+
+     DECLARE
+
+          SUBTYPE SUBINT IS INTEGER RANGE 1 .. 5;
+          TYPE REC (DISC : SUBINT := 1) IS
+               RECORD
+                    COMP : STRING(IDENT_INT(3) .. DISC);
+               END RECORD;
+          TYPE ARR IS ARRAY (1 .. 3) OF REC;
+
+          A1, A2 : ARR;
+
+     BEGIN
+
+          IF A1 /= A2 THEN
+               FAILED ("NULL ARRAYS, RESULT NOT EQUAL");
+          END IF;
+
+          A1(2) := (5, "ABC");
+
+          IF A1 = A2 THEN
+               FAILED ("NON-NULL ARRAY AND NULL ARRAY, RESULT EQUAL");
+          END IF;
+
+          A2(2) := (5, "ABD");
+
+          IF A1 = A2 THEN
+               FAILED ("ARRAYS DIFFER BY LAST ELEMENT, RESULT EQUAL");
+          END IF;
+
+          A2(2) := (4, "AB");
+
+          IF A1 = A2 THEN
+               FAILED ("ARRAYS OF DIFFERENT LENGTH, RESULT EQUAL");
+          END IF;
+
+          A1(2) := (4, "AB");
+
+          IF A1 /= A2 THEN
+               FAILED ("DISCRIMINANTS AND COMPONENTS ARE THE SAME, " &
+                       "RESULT NOT EQUAL");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45264B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45264c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45264c.ada
new file mode 100644
index 000000000..c9959a5ba
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45264c.ada
@@ -0,0 +1,153 @@
+-- C45264C.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 COMPARING ARRAYS OF DIFFERENT LENGTHS DOES NOT RAISE AN
+-- EXCEPTION.
+
+-- TBN  7/21/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45264C IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+     TYPE ARRAY_TYPE_1 IS ARRAY (INT RANGE <>) OF INTEGER;
+     TYPE ARRAY_TYPE_2 IS ARRAY (INT RANGE <>, INT RANGE <>) OF INTEGER;
+     TYPE ARRAY_TYPE_3 IS ARRAY (INT RANGE <>, INT RANGE <>,
+                                               INT RANGE <>) OF INTEGER;
+
+     ARRAY_1 : ARRAY_TYPE_1 (1..5) := (1..5 => 1);
+     ARRAY_2 : ARRAY_TYPE_1 (1..7) := (1..7 => 1);
+     ARRAY_3 : ARRAY_TYPE_2 (1..5, 1..4) := (1..5 => (1..4 => 1));
+     ARRAY_4 : ARRAY_TYPE_2 (1..2, 1..3) := (1..2 => (1..3 => 1));
+     ARRAY_5 : ARRAY_TYPE_3 (1..2, 1..3, 1..2) := (1..2 => (1..3 =>
+                                                  (1..2 => 2)));
+     ARRAY_6 : ARRAY_TYPE_3 (1..1, 1..2, 1..3) := (1..1 => (1..2 =>
+                                                  (1..3 => 2)));
+     ARRAY_7 : ARRAY_TYPE_2 (1..5, 1..4) := (1..5 => (1..4 => 3));
+     ARRAY_8 : ARRAY_TYPE_2 (1..5, 1..3) := (1..5 => (1..3 => 3));
+     ARRAY_9 : ARRAY_TYPE_2 (1..3, 1..2) := (1..3 => (1..2 => 4));
+     ARRAY_10 : ARRAY_TYPE_2 (1..2, 1..2) := (1..2 => (1..2 => 4));
+
+BEGIN
+     TEST ("C45264C", "CHECK THAT COMPARING ARRAYS OF DIFFERENT " &
+                      "LENGTHS DOES NOT RAISE AN EXCEPTION");
+
+     BEGIN     -- (A)
+          IF "=" (ARRAY_1 (1..INTEGER'FIRST), ARRAY_2) THEN
+               FAILED ("INCORRECT RESULTS FROM COMPARING ONE " &
+                       "DIMENSIONAL ARRAYS - 1");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED EVALUATING - 1");
+     END;     -- (A)
+
+     BEGIN     -- (B)
+          IF ARRAY_1 /= ARRAY_2 THEN
+               NULL;
+          ELSE
+               FAILED ("INCORRECT RESULTS FROM COMPARING ONE " &
+                       "DIMENSIONAL ARRAYS - 2");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED EVALUATING - 2");
+     END;     -- (B)
+
+     BEGIN     -- (C)
+          IF ARRAY_3 = ARRAY_4 THEN
+               FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
+                       "DIMENSIONAL ARRAYS - 3");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED EVALUATING - 3");
+     END;     -- (C)
+
+     BEGIN     -- (D)
+          IF "/=" (ARRAY_3, ARRAY_4) THEN
+               NULL;
+          ELSE
+               FAILED ("INCORRECT RESULTS FROM COMPARING MULT-" &
+                       "DIMENSIONAL ARRAYS - 4");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - 4");
+     END;     -- (D)
+
+     BEGIN     -- (E)
+          IF "=" (ARRAY_5, ARRAY_6) THEN
+               FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
+                       "DIMENSIONAL ARRAYS - 5");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED EVALUATING - 5");
+     END;     -- (E)
+
+     BEGIN     -- (F)
+          IF ARRAY_6 /= ARRAY_5 THEN
+               NULL;
+          ELSE
+               FAILED ("INCORRECT RESULTS FROM COMPARING MULT-" &
+                       "DIMENSIONAL ARRAYS - 6");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - 6");
+     END;     -- (F)
+
+     BEGIN     -- (G)
+          IF ARRAY_7 = ARRAY_8 THEN
+               FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
+                       "DIMENSIONAL ARRAYS - 7");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED EVALUATING - 7");
+     END;     -- (G)
+
+     BEGIN     -- (H)
+          IF ARRAY_9 /= ARRAY_10 THEN
+               NULL;
+          ELSE
+               FAILED ("INCORRECT RESULTS FROM COMPARING MULTI-" &
+                       "DIMENSIONAL ARRAYS - 8");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED EVALUATING - 8");
+     END;     -- (H)
+
+     RESULT;
+END C45264C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45265a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45265a.ada
new file mode 100644
index 000000000..711124358
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45265a.ada
@@ -0,0 +1,196 @@
+-- C45265A.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 MEMBERSHIP TESTS YIELD THE CORRECT RESULTS FOR ONE
+-- DIMENSIONAL AND MULTI-DIMENSIONAL ARRAY TYPES WHEN:
+--     A) THE SUBTYPE INDICATION DENOTES AN UNCONSTRAINED ARRAY.
+--     B) THE SUBTYPE INDICATION DENOTES A CONSTRAINED ARRAY.
+
+-- TBN  7/22/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45265A IS
+
+     PACKAGE P IS
+          TYPE KEY IS LIMITED PRIVATE;
+     PRIVATE
+          TYPE KEY IS NEW NATURAL;
+     END P;
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 20;
+     TYPE ARRAY_TYPE_1 IS ARRAY (INT RANGE <>) OF INTEGER;
+     TYPE ARRAY_TYPE_2 IS ARRAY (INT RANGE <>, INT RANGE <>) OF INTEGER;
+     TYPE ARRAY_TYPE_3 IS ARRAY (INT RANGE <>, INT RANGE <>,
+                                               INT RANGE <>) OF INTEGER;
+     TYPE ARRAY_TYPE_4 IS ARRAY (INT RANGE <>) OF P.KEY;
+     TYPE ARRAY_TYPE_5 IS ARRAY (INT RANGE <>, INT RANGE <>) OF P.KEY;
+
+     SUBTYPE ARRAY_SUB1 IS ARRAY_TYPE_1;
+     SUBTYPE ARRAY_SUB2 IS ARRAY_TYPE_2;
+     SUBTYPE ARRAY_SUB3 IS ARRAY_TYPE_3;
+     SUBTYPE ARRAY_SUB4 IS ARRAY_TYPE_4;
+     SUBTYPE ARRAY_SUB5 IS ARRAY_TYPE_5;
+     SUBTYPE CON_ARRAY1 IS ARRAY_TYPE_1 (1..5);
+     SUBTYPE CON_ARRAY2 IS ARRAY_TYPE_2 (1..2, 1..2);
+     SUBTYPE CON_ARRAY3 IS ARRAY_TYPE_3 (1..2, 1..3, 1..4);
+     SUBTYPE CON_ARRAY4 IS ARRAY_TYPE_4 (1..4);
+     SUBTYPE CON_ARRAY5 IS ARRAY_TYPE_5 (1..2, 1..3);
+     SUBTYPE NULL_ARRAY1 IS ARRAY_TYPE_1 (2 .. 1);
+
+     ARRAY1 : ARRAY_TYPE_1 (1..10);
+     ARRAY2 : ARRAY_SUB1 (11..20);
+     ARRAY3 : ARRAY_TYPE_2 (1..4, 1..3);
+     ARRAY4 : ARRAY_SUB2 (5..7, 5..8);
+     ARRAY5 : ARRAY_TYPE_3 (1..2, 1..3, 1..4);
+     ARRAY6 : ARRAY_SUB3 (1..3, 1..2, 1..4);
+     NULL_ARRAY_1 : ARRAY_TYPE_1 (3..2);
+     NULL_ARRAY_2 : ARRAY_SUB1 (2..1);
+     ARRAY7 : ARRAY_TYPE_1 (1..10) := (1..10 => 7);
+     ARRAY8 : CON_ARRAY1 := (1..5 => 8);
+     ARRAY9 : ARRAY_TYPE_2 (1..10, 1..10) := (1..10 => (1..10 => 9));
+     ARRAY10 : CON_ARRAY2 := (1..2 => (1..2 => 10));
+     ARRAY11 : ARRAY_TYPE_3 (1..10, 1..10, 1..10) := (1..10 =>
+                                              (1..10 => (1..10 => 11)));
+     ARRAY12 : CON_ARRAY3 := (1..2 => (1..3 => (1..4 => 12)));
+     ARRAY13 : ARRAY_TYPE_4 (1..2);
+     ARRAY14 : ARRAY_SUB4 (1..5);
+     ARRAY15 : ARRAY_TYPE_4 (1..6);
+     ARRAY16 : CON_ARRAY4;
+     ARRAY17 : ARRAY_TYPE_5 (1..3, 1..2);
+     ARRAY18 : ARRAY_SUB5 (1..2, 1..3);
+     ARRAY19 : ARRAY_TYPE_5 (1..4, 1..3);
+     ARRAY20 : CON_ARRAY5;
+
+BEGIN
+     TEST ("C45265A", "CHECK THAT MEMBERSHIP TESTS YIELD THE CORRECT " &
+                      "RESULTS FOR ONE DIMENSIONAL AND MULTI-" &
+                      "DIMENSIONAL ARRAY TYPES");
+
+     ARRAY1 := (ARRAY1'RANGE => 1);
+     ARRAY2 := (ARRAY2'RANGE => 2);
+     ARRAY3 := (ARRAY3'RANGE(1) => (ARRAY3'RANGE(2) => 3));
+     ARRAY4 := (ARRAY4'RANGE(1) => (ARRAY4'RANGE(2) => 4));
+     ARRAY5 := (ARRAY5'RANGE(1) => (ARRAY5'RANGE(2) =>
+                                   (ARRAY5'RANGE(3) => 5)));
+     ARRAY6 := (ARRAY6'RANGE(1) => (ARRAY6'RANGE(2) =>
+                                   (ARRAY6'RANGE(3) => 6)));
+
+     IF ARRAY1 IN ARRAY_SUB1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 1");
+     END IF;
+     IF ARRAY2 NOT IN ARRAY_SUB1 THEN
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 2");
+     END IF;
+
+     IF ARRAY3 IN ARRAY_SUB2 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 3");
+     END IF;
+     IF ARRAY4 NOT IN ARRAY_SUB2 THEN
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 4");
+     END IF;
+
+     IF ARRAY5 IN ARRAY_SUB3 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 5");
+     END IF;
+     IF ARRAY6 NOT IN ARRAY_SUB3 THEN
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 6");
+     END IF;
+
+     IF NULL_ARRAY_1 IN ARRAY_SUB1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 7");
+     END IF;
+     IF NULL_ARRAY_2 NOT IN ARRAY_SUB1 THEN
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 8");
+     END IF;
+
+     IF ARRAY7 IN CON_ARRAY1 THEN
+          FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 9");
+     END IF;
+     IF ARRAY8 NOT IN CON_ARRAY1 THEN
+          FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 10");
+     END IF;
+
+     IF ARRAY9 IN CON_ARRAY2 THEN
+          FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 11");
+     END IF;
+     IF ARRAY10 NOT IN CON_ARRAY2 THEN
+          FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 12");
+     END IF;
+
+     IF ARRAY11 IN CON_ARRAY3 THEN
+          FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 13");
+     END IF;
+     IF ARRAY12 NOT IN CON_ARRAY3 THEN
+          FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 14");
+     END IF;
+
+     IF ARRAY13 IN ARRAY_SUB4 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 15");
+     END IF;
+     IF ARRAY14 NOT IN ARRAY_SUB4 THEN
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 16");
+     END IF;
+
+     IF ARRAY15 IN CON_ARRAY4 THEN
+          FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 17");
+     END IF;
+     IF ARRAY16 NOT IN CON_ARRAY4 THEN
+          FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 18");
+     END IF;
+
+     IF ARRAY17 IN ARRAY_SUB5 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 19");
+     END IF;
+     IF ARRAY18 NOT IN ARRAY_SUB5 THEN
+          FAILED ("INCORRECT RESULTS FOR UNCONSTRAINED ARRAYS - 20");
+     END IF;
+
+     IF ARRAY19 IN CON_ARRAY5 THEN
+          FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 21");
+     END IF;
+     IF ARRAY20 NOT IN CON_ARRAY5 THEN
+          FAILED ("INCORRECT RESULTS FOR CONSTRAINED ARRAYS - 22");
+     END IF;
+
+     IF NULL_ARRAY_1 IN NULL_ARRAY1 THEN
+          FAILED ("INCORRECT RESULTS FOR NULL ARRAYS - 23");
+     END IF;
+     IF NULL_ARRAY_2 NOT IN NULL_ARRAY1 THEN
+          FAILED ("INCORRECT RESULTS FOR NULL ARRAYS - 24");
+     END IF;
+
+     RESULT;
+END C45265A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45271a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45271a.ada
new file mode 100644
index 000000000..8e621993b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45271a.ada
@@ -0,0 +1,112 @@
+-- C45271A.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 EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR
+-- RECORDS WHOSE COMPONENTS DO NOT HAVE CHANGEABLE DISCRIMINANTS.
+
+-- TBN  8/6/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45271A IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 20;
+     TYPE ARRAY_BOOL IS ARRAY (1 .. 5) OF BOOLEAN;
+
+     TYPE REC_TYPE1 IS
+          RECORD
+               BOOL : ARRAY_BOOL;
+               A : INTEGER;
+          END RECORD;
+
+     TYPE REC_TYPE2 (LEN : INT := 3) IS
+          RECORD
+               A : STRING (1 .. LEN);
+          END RECORD;
+
+     TYPE REC_TYPE3 (NUM : INT := 1) IS
+          RECORD
+               A : REC_TYPE1;
+          END RECORD;
+
+     REC1, REC2 : REC_TYPE1 := (A => 2, OTHERS => (OTHERS => TRUE));
+     REC3, REC4 : REC_TYPE2 (5) := (5, "WHERE");
+     REC5, REC6 : REC_TYPE2;
+     REC7, REC8 : REC_TYPE3;
+     REC9, REC10 : REC_TYPE3 (3) := (NUM => 3, A =>
+                                   (A => 5, BOOL => (OTHERS => FALSE)));
+
+BEGIN
+     TEST ("C45271A", "CHECK THAT EQUALITY AND INEQUALITY ARE " &
+                      "EVALUATED CORRECTLY FOR RECORDS WHOSE " &
+                      "COMPONENTS DO NOT HAVE CHANGEABLE " &
+                      "DISCRIMINANTS");
+
+     IF "/=" (LEFT => REC1, RIGHT => REC2) THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 1");
+     END IF;
+     REC1.A := IDENT_INT(1);
+     IF "=" (LEFT => REC2, RIGHT => REC1) THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 2");
+     END IF;
+
+     IF REC3 /= REC4 THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 3");
+     END IF;
+     REC4.A := IDENT_STR("12345");
+     IF REC3 = REC4 THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 4");
+     END IF;
+
+     REC5.A := IDENT_STR("WHO");
+     REC6.A := IDENT_STR("WHY");
+     IF REC5 = REC6 THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 5");
+     END IF;
+     REC5.A := "WHY";
+     IF REC6 /= REC5 THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 6");
+     END IF;
+
+     REC7.A.A := IDENT_INT(1);
+     REC7.A.BOOL := (OTHERS => IDENT_BOOL(TRUE));
+     REC8.A.A := 1;
+     REC8.A.BOOL := (OTHERS => TRUE);
+     IF REC7 /= REC8 THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 7");
+     END IF;
+     REC8.A.BOOL := (OTHERS => IDENT_BOOL(FALSE));
+     IF REC8 = REC7 THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 8");
+     END IF;
+
+     IF "/=" (LEFT => REC9, RIGHT => REC10) THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 9");
+     END IF;
+     REC9.A.A := IDENT_INT(1);
+     IF "=" (LEFT => REC9, RIGHT => REC10) THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 10");
+     END IF;
+
+     RESULT;
+END C45271A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45272a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45272a.ada
new file mode 100644
index 000000000..447d468df
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45272a.ada
@@ -0,0 +1,105 @@
+-- C45272A.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 EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR 
+-- RECORDS WHOSE COMPONENTS HAVE CHANGEABLE DISCRIMINANTS, INCLUDING
+-- RECORDS DESIGNATED BY ACCESS VALUES.
+
+-- TBN  8/7/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45272A IS
+
+     SUBTYPE INT IS INTEGER RANGE 0 .. 20;
+     TYPE VARSTR (LEN : INT := 0) IS
+          RECORD
+               VAL : STRING (1..LEN);
+          END RECORD;
+     TYPE VARREC IS
+          RECORD
+               A, B : VARSTR;
+          END RECORD;
+
+     TYPE CELL2;
+     TYPE LINK IS ACCESS CELL2;
+     TYPE CELL1 (NAM_LEN : INT := 0) IS
+          RECORD
+               NAME : STRING (1..NAM_LEN);
+          END RECORD;
+     TYPE CELL2 IS
+          RECORD
+               ONE : CELL1;
+               TWO : CELL1;
+               NEW_LINK : LINK;
+          END RECORD;
+
+     X, Y : VARREC;
+     FRONT : LINK := NEW CELL2'((5, "XXYZZ"), (5, "YYYZZ"), NULL);
+     BACK : LINK := NEW CELL2'((5, "XXYZZ"), (5, "YYYZZ"), NULL);
+
+BEGIN
+     TEST ("C45272A", "CHECK THAT EQUALITY AND INEQUALITY ARE " &
+                      "EVALUATED CORRECTLY FOR RECORDS WHOSE " &
+                      "COMPONENTS HAVE CHANGEABLE DISCRIMINANTS");
+
+     X := ((5, "AAAXX"), (5, "BBBYY"));
+     Y := ((5, "AAAZZ"), (5, "BBBYY"));
+     IF X = Y THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 1");
+     END IF;
+
+     X.A := (3, "HHH");
+     Y.A := (IDENT_INT(3), IDENT_STR("HHH"));
+     IF X /= Y THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 2");
+     END IF;
+
+     IF FRONT.ALL /= BACK.ALL THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 3");
+     END IF;
+
+     BACK.NEW_LINK := FRONT;
+     IF FRONT.ALL = BACK.ALL THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 4");
+     END IF;
+
+     FRONT.NEW_LINK := FRONT;
+     IF FRONT.ALL /= BACK.ALL THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 5");
+     END IF;
+
+     FRONT.ONE := (5, "XXXXX");
+     BACK.ONE := (5, "ZZZZZ");
+     IF FRONT.ALL = BACK.ALL THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 6");
+     END IF;
+
+     FRONT.ONE := (3, "XXX");
+     BACK.ONE := (3, "XXX");
+     IF FRONT.ALL /= BACK.ALL THEN
+          FAILED ("INCORRECT RESULTS FOR RECORDS - 7");
+     END IF;
+
+     RESULT;
+END C45272A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45273a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45273a.ada
new file mode 100644
index 000000000..ae74c2957
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45273a.ada
@@ -0,0 +1,133 @@
+-- C45273A.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 EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR
+--     RECORD OBJECTS HAVING DIFFERENT VALUES OF THE 'CONSTRAINED
+--     ATTRIBUTE.
+
+-- HISTORY:
+--     TBN  08/07/86  CREATED ORIGINAL TEST.
+--     VCL  10/27/87  MODIFIED THIS HEADER; RELOCATED THE CALL TO
+--                    REPORT.TEST SO THAT IT COMES BEFORE ANY
+--                    DECLARATIONS; CHANGED THE 'ELSEIF' CONDITION IN
+--                    THE PROCEDURE 'PROC' SO THAT IT REFERS TO THE
+--                    FORMAL PARAMETERS.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45273A IS
+BEGIN
+     TEST ("C45273A", "EQUALITY AND INEQUALITY ARE " &
+                      "EVALUATED CORRECTLY FOR RECORD OBJECTS HAVING " &
+                      "DIFFERENT VALUES OF THE 'CONSTRAINED' " &
+                      " ATTRIBUTE");
+
+     DECLARE
+          SUBTYPE INT IS INTEGER RANGE 1 .. 20;
+          TYPE REC_TYPE1 IS
+               RECORD
+                    A : INTEGER;
+               END RECORD;
+
+          TYPE REC_TYPE2 (LEN : INT := 3) IS
+               RECORD
+                    A : STRING (1 .. LEN);
+               END RECORD;
+
+          TYPE REC_TYPE3 (NUM : INT := 1) IS
+               RECORD
+                    A : REC_TYPE1;
+               END RECORD;
+
+          REC1 : REC_TYPE2 (3) := (3, "WHO");
+          REC2 : REC_TYPE2;
+          REC3 : REC_TYPE2 (5) := (5, "WHERE");
+          REC4 : REC_TYPE3;
+          REC5 : REC_TYPE3 (1) := (1, A => (A => 5));
+
+          PROCEDURE PROC (PREC1 : REC_TYPE2;
+                          PREC2 : IN OUT REC_TYPE2) IS
+          BEGIN
+               IF NOT (PREC1'CONSTRAINED) OR PREC2'CONSTRAINED THEN
+                    FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                            "ATTRIBUTE - 6");
+               ELSIF PREC1 /= PREC2 THEN
+                    FAILED ("INCORRECT RESULTS FOR RECORDS - 6");
+               END IF;
+               PREC2.A := "WHO";
+          END PROC;
+
+     BEGIN
+          REC2.A := "WHO";
+          IF NOT (REC1'CONSTRAINED) OR REC2'CONSTRAINED THEN
+               FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                       "ATTRIBUTE - 1");
+          ELSIF REC1 /= REC2 THEN
+               FAILED ("INCORRECT RESULTS FOR RECORDS - 1");
+          END IF;
+
+          IF REC2'CONSTRAINED OR NOT (REC3'CONSTRAINED) THEN
+               FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                       "ATTRIBUTE - 2");
+          ELSIF REC2 = REC3 THEN
+               FAILED ("INCORRECT RESULTS FOR RECORDS - 2");
+          END IF;
+
+          REC2 := (5, "WHERE");
+          IF REC2'CONSTRAINED OR NOT (REC3'CONSTRAINED) THEN
+               FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                       "ATTRIBUTE - 3");
+          ELSIF REC2 /= REC3 THEN
+               FAILED ("INCORRECT RESULTS FOR RECORDS - 3");
+          END IF;
+
+          REC4.A.A := 5;
+          IF REC4'CONSTRAINED OR NOT (REC5'CONSTRAINED) THEN
+               FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                       "ATTRIBUTE - 4");
+          ELSIF REC4 /= REC5 THEN
+               FAILED ("INCORRECT RESULTS FOR RECORDS - 4");
+          END IF;
+
+          REC5.A := (A => 6);
+          IF REC4'CONSTRAINED OR NOT (REC5'CONSTRAINED) THEN
+               FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                       "ATTRIBUTE - 5");
+          ELSIF REC4 = REC5 THEN
+               FAILED ("INCORRECT RESULTS FOR RECORDS - 5");
+          END IF;
+
+          REC1.A := "WHY";
+          REC2 := (3, "WHY");
+          PROC (REC1, REC2);
+          IF NOT (REC1'CONSTRAINED) OR REC2'CONSTRAINED THEN
+               FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
+                       "ATTRIBUTE - 7");
+          ELSIF REC1 = REC2 THEN
+               FAILED ("INCORRECT RESULTS FOR RECORDS - 7");
+          END IF;
+     END;
+
+     RESULT;
+END C45273A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45274a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45274a.ada
new file mode 100644
index 000000000..ea7473192
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45274a.ada
@@ -0,0 +1,222 @@
+-- C45274A.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 MEMBERSHIP OPERATOR  IN   ( NOT IN )  ALWAYS
+--     YIELDS  TRUE   (RESP.  FALSE )  FOR
+--
+-->> * RECORD TYPES WITHOUT DISCRIMINANTS;
+-->> * PRIVATE TYPES WITHOUT DISCRIMINANTS;
+-->> * LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS;
+--   * (UNCONSTRAINED) RECORD TYPES WITH DISCRIMINANTS; 
+--   * (UNCONSTRAINED) PRIVATE TYPES WITH DISCRIMINANTS;
+--   * (UNCONSTRAINED) LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
+
+
+-- RM  3/01/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C45274A IS
+
+
+BEGIN
+
+     TEST ( "C45274A" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
+                        "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
+                        " FOR RECORD TYPES WITHOUT DISCRIMINANTS," &
+                        " PRIVATE TYPES WITHOUT DISCRIMINANTS, AND" &
+                        " LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS");
+
+
+     -------------------------------------------------------------------
+     -----------------  RECORD TYPES WITHOUT DISCRIMINANTS  ------------
+
+     DECLARE
+
+          TYPE  REC  IS
+               RECORD
+                    A , B : INTEGER ;
+               END RECORD ;
+
+          X : REC := ( 19 , 91 );
+
+     BEGIN
+
+          IF  X  IN  REC  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'IN', 1" );
+          END IF;
+
+          IF  X  NOT IN  REC  THEN
+               FAILED( "WRONG VALUE: 'NOT IN', 1" );
+          ELSE 
+               NULL;
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+
+     END;
+
+
+     -------------------------------------------------------------------
+     -----------------  PRIVATE TYPES WITHOUT DISCRIMINANTS  -----------
+
+     DECLARE
+
+          PACKAGE  P  IS
+               TYPE  PRIV  IS PRIVATE;
+          PRIVATE
+               TYPE  PRIV  IS
+                    RECORD
+                         A , B : INTEGER ;
+                    END RECORD ;
+          END  P ;
+
+          USE  P ;
+
+          X : PRIV ;
+
+          PACKAGE BODY  P  IS
+          BEGIN
+               X := ( 19 , 91 );
+          END  P ;
+
+     BEGIN
+
+          IF  X  IN  PRIV  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'IN', 2" );
+          END IF;
+
+          IF  X  NOT IN  PRIV  THEN
+               FAILED( "WRONG VALUE: 'NOT IN', 2" );
+          ELSE 
+               NULL;
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+
+     END;
+
+     -------------------------------------------------------------------
+     ---------  LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS  -----------
+
+     DECLARE
+
+          PACKAGE  P  IS
+               TYPE  LP  IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE  LP  IS
+                    RECORD
+                         A , B : INTEGER ;
+                    END RECORD ;
+          END  P ;
+
+          USE  P ;
+
+          X : LP ;
+
+          PACKAGE BODY  P  IS
+          BEGIN
+               X := ( 19 , 91 );
+          END  P ;
+
+     BEGIN
+
+          IF  X  IN  LP  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'IN', 3" );
+          END IF;
+
+          IF  X  NOT IN  LP  THEN
+               FAILED( "WRONG VALUE: 'NOT IN', 3" );
+          ELSE 
+               NULL;
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+
+     END;
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          PACKAGE  P  IS
+               TYPE  LP  IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE  LP  IS
+                    RECORD
+                         A , B : INTEGER ;
+                    END RECORD ;
+          END  P ;
+
+          USE  P ;
+
+          Y : LP ;
+
+     -- CHECK THAT NO EXCEPTION FOR UNINITIALIZED VARIABLE
+     BEGIN
+
+          IF  Y  IN  LP  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'IN', 3BIS" );
+          END IF;
+
+          IF  Y  NOT IN  LP  THEN
+               FAILED( "WRONG VALUE: 'NOT IN', 3BIS" );
+          ELSE 
+               NULL;
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "3BIS - UNINITIALIZED VARIABLE - 'IN' " &
+                       "( 'NOT IN' )  RAISED AN EXCEPTION" );
+
+     END;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT;
+
+
+END  C45274A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45274b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45274b.ada
new file mode 100644
index 000000000..4833b6d7d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45274b.ada
@@ -0,0 +1,229 @@
+-- C45274B.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 MEMBERSHIP OPERATOR  IN   ( NOT IN )  ALWAYS
+--     YIELDS  TRUE   (RESP.  FALSE )  FOR
+--
+--   * RECORD TYPES WITHOUT DISCRIMINANTS;
+--   * PRIVATE TYPES WITHOUT DISCRIMINANTS;
+--   * LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS;
+-->> * (UNCONSTRAINED) RECORD TYPES WITH DISCRIMINANTS; 
+-->> * (UNCONSTRAINED) PRIVATE TYPES WITH DISCRIMINANTS;
+-->> * (UNCONSTRAINED) LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
+
+
+-- RM  3/03/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C45274B IS
+
+
+BEGIN
+
+     TEST ( "C45274B" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
+                        "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
+                        " FOR UNCONSTRAINED TYPES WITH DISCRIMINANTS" );
+
+
+     -------------------------------------------------------------------
+     --------  UNCONSTRAINED RECORD TYPES WITH DISCRIMINANTS  ----------
+
+     DECLARE
+
+          TYPE  REC ( DISCR : BOOLEAN ) IS
+               RECORD
+                    A , B : INTEGER ;
+               END RECORD ;
+
+          X : REC(FALSE) := ( FALSE , 19 , 81 );
+
+          TYPE  REC0 ( DISCR : BOOLEAN := FALSE ) IS
+               RECORD
+                    A , B : INTEGER ;
+               END RECORD ;
+
+          Y : REC0 := ( TRUE , 19 , 81 );
+
+     BEGIN
+
+          IF  X  IN  REC  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'IN', 1A" );
+          END IF;
+
+          IF  Y  NOT IN  REC0  THEN
+               FAILED( "WRONG VALUE: 'NOT IN', 1B" );
+          ELSE 
+               NULL;
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+
+     END;
+
+
+     -------------------------------------------------------------------
+     -------  UNCONSTRAINED PRIVATE TYPES WITH DISCRIMINANTS  ----------
+
+     DECLARE
+
+          PACKAGE  P  IS
+               TYPE  PRIV ( DISCR : BOOLEAN ) IS PRIVATE;
+          PRIVATE
+               TYPE  PRIV ( DISCR : BOOLEAN ) IS
+                    RECORD
+                         A , B : INTEGER ;
+                    END RECORD ;
+          END  P ;
+
+          USE  P ;
+
+          X : PRIV(FALSE) ;
+
+          PACKAGE BODY  P  IS
+          BEGIN
+               X := ( FALSE , 19 , 91 );
+          END  P ;
+
+     BEGIN
+
+          IF  X  IN  PRIV  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'IN', 2" );
+          END IF;
+
+          IF  X  NOT IN  PRIV  THEN
+               FAILED( "WRONG VALUE: 'NOT IN', 2" );
+          ELSE 
+               NULL;
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+
+     END;
+
+
+     -------------------------------------------------------------------
+     ---------  UNCONSTRAINED LIM. PRIV. TYPES WITH DISCRIM.  ----------
+
+     DECLARE
+
+          PACKAGE  P  IS
+               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
+                    RECORD
+                         A , B : INTEGER ;
+                    END RECORD ;
+          END  P ;
+
+          USE  P ;
+
+          X : LP(TRUE) ;
+
+          PACKAGE BODY  P  IS
+          BEGIN
+               X := ( TRUE , 19 , 91 );
+          END  P ;
+
+     BEGIN
+
+          IF  X  IN  LP  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'IN', 3" );
+          END IF;
+
+          IF  X  NOT IN  LP  THEN
+               FAILED( "WRONG VALUE: 'NOT IN', 3" );
+          ELSE 
+               NULL;
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+
+     END;
+
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          PACKAGE  P  IS
+               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
+                    RECORD
+                         A , B : INTEGER ;
+                    END RECORD ;
+          END  P ;
+
+          USE  P ;
+
+          Y : LP(TRUE) ;
+
+     -- CHECK THAT NO EXCEPTION FOR UNINITIALIZED VARIABLE
+     BEGIN
+
+          IF  Y  IN  LP  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'IN', 3BIS" );
+          END IF;
+
+          IF  Y  NOT IN  LP  THEN
+               FAILED( "WRONG VALUE: 'NOT IN', 3BIS" );
+          ELSE 
+               NULL;
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "3BIS - UNINITIALIZED VARIABLE - 'IN' " &
+                       "( 'NOT IN' )  RAISED AN EXCEPTION" );
+
+     END;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT;
+
+
+END  C45274B ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45274c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45274c.ada
new file mode 100644
index 000000000..647089782
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45274c.ada
@@ -0,0 +1,187 @@
+-- C45274C.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 MEMBERSHIP OPERATOR  IN   ( NOT IN )
+--     YIELDS  TRUE  (RESP.  FALSE ) IF THE DISCRIMINANTS OF THE LEFT
+--     VALUE EQUAL THE DISCRIMINANTS OF THE SUBTYPE INDICATION.
+--
+--
+--   * RECORD TYPES WITH DISCRIMINANTS;
+--   * PRIVATE TYPES WITH DISCRIMINANTS;
+--   * LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
+
+
+-- RM  3/01/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C45274C IS
+
+
+BEGIN
+
+     TEST ( "C45274C" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
+                        "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
+                        " IF THE DISCRIMINANTS OF THE LEFT VALUE" &
+                        " EQUAL THE DISCRIMINANTS OF THE SUBTYPE" &
+                        " INDICATION" );
+
+
+     -------------------------------------------------------------------
+     -----------------  RECORD TYPES WITH DISCRIMINANTS  ---------------
+
+     DECLARE
+
+          TYPE  REC ( DISCR : BOOLEAN := FALSE ) IS
+               RECORD
+                    A , B : INTEGER ;
+               END RECORD ;
+
+          SUBTYPE  RECTRUE  IS REC(TRUE) ;
+
+          X : REC  :=  ( TRUE , 19 , 91 );
+
+     BEGIN
+
+          IF  X  IN  RECTRUE  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'IN', 1" );
+          END IF;
+
+          IF  X  NOT IN  RECTRUE  THEN
+               FAILED( "WRONG VALUE: 'NOT IN', 1" );
+          ELSE 
+               NULL;
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+
+     END;
+
+
+     -------------------------------------------------------------------
+     -----------------  PRIVATE TYPES WITH DISCRIMINANTS  --------------
+
+     DECLARE
+
+          PACKAGE  P  IS
+               TYPE  PRIV ( DISCR : BOOLEAN ) IS PRIVATE;
+          PRIVATE
+               TYPE  PRIV ( DISCR : BOOLEAN ) IS
+                    RECORD
+                         A , B : INTEGER ;
+                    END RECORD ;
+          END  P ;
+
+          USE  P ;
+
+          SUBTYPE  PRIVTRUE  IS  PRIV( IDENT_BOOL(TRUE) );
+
+          X : PRIV(TRUE) ;
+
+          PACKAGE BODY  P  IS
+          BEGIN
+               X := ( TRUE , 19 , 91 );
+          END  P ;
+
+     BEGIN
+
+          IF  X  IN  PRIVTRUE  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'IN', 2" );
+          END IF;
+
+          IF  X  NOT IN  PRIVTRUE  THEN
+               FAILED( "WRONG VALUE: 'NOT IN', 2" );
+          ELSE 
+               NULL;
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+
+     END;
+
+     -------------------------------------------------------------------
+     ---------  LIMITED PRIVATE TYPES WITH DISCRIMINANTS  --------------
+
+     DECLARE
+
+          PACKAGE  P  IS
+               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
+                    RECORD
+                         A , B : INTEGER ;
+                    END RECORD ;
+          END  P ;
+
+          USE  P ;
+
+          SUBTYPE  LPFALSE  IS  LP(FALSE) ;
+
+          X : LP(TRUE) ;
+
+          PACKAGE BODY  P  IS
+          BEGIN
+               X := ( IDENT_BOOL(TRUE) , 19 , 91 );
+          END  P ;
+
+     BEGIN
+
+          IF  X  IN  LPFALSE  THEN
+               FAILED( "WRONG VALUE: 'IN', 3" );
+          ELSE 
+               NULL;
+          END IF;
+
+          IF  X  NOT IN  LPFALSE  THEN
+               NULL;
+          ELSE 
+               FAILED( "WRONG VALUE: 'NOT IN', 3" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS =>
+               FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
+
+     END;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT;
+
+
+END  C45274C ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45281a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45281a.ada
new file mode 100644
index 000000000..24353f1ce
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45281a.ada
@@ -0,0 +1,84 @@
+-- C45281A.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 EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR ACCESS
+-- TYPES.
+
+-- TBN  8/8/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45281A IS
+
+     TYPE STR_NAME IS ACCESS STRING;
+
+     TYPE GENDER IS (F, M);
+     TYPE PERSON (SEX : GENDER) IS
+          RECORD
+               NAME : STRING (1..6) := "NONAME";
+          END RECORD;
+
+     TYPE PERSON_NAME IS ACCESS PERSON;
+     SUBTYPE MALE IS PERSON_NAME (M);
+     SUBTYPE FEMALE IS PERSON_NAME (F);
+
+     S : STR_NAME (1..10) := NEW STRING'("0123456789");
+     T : STR_NAME (1..10) := S;
+     A : MALE;
+     B : FEMALE;
+     C : PERSON_NAME;
+
+BEGIN
+     TEST ("C45281A", "CHECK THAT EQUALITY AND INEQUALITY ARE " &
+                      "EVALUATED CORRECTLY FOR ACCESS TYPES");
+
+     IF "/=" (LEFT => S, RIGHT => T) THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 1");
+     END IF;
+     T := NEW STRING'("0123456789");
+     IF "=" (S, T) THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 2");
+     END IF;
+
+     IF A /= B THEN
+          FAILED ("INCORRECT RESULTS FOR NULL ACCESS VALUES - 3");
+     END IF;
+     IF A /= C THEN
+          FAILED ("INCORRECT RESULTS FOR NULL ACCESS VALUES - 4");
+     END IF;
+
+     A := NEW PERSON'(M, "THOMAS");
+     IF "=" (LEFT => A, RIGHT => B) THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 5");
+     END IF;
+     C := A;
+     IF C /= A THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 6");
+     END IF;
+     C := NEW PERSON'(M, "THOMAS");
+     IF A = C THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS VALUES - 7");
+     END IF;
+
+     RESULT;
+END C45281A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282a.ada
new file mode 100644
index 000000000..e248e3ae2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282a.ada
@@ -0,0 +1,170 @@
+-- C45282A.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 AND NOT IN ARE EVALUATED CORRECTLY FOR :
+--     A) ACCESS TO SCALAR TYPES;
+--     B) ACCESS TO ARRAY TYPES (CONSTRAINED AND UNCONSTRAINED);
+--     C) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT
+--        DISCRIMINANTS;
+
+-- TBN  8/8/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45282A IS
+
+     PACKAGE P IS
+          TYPE KEY IS PRIVATE;
+          FUNCTION INIT_KEY (X : NATURAL) RETURN KEY;
+          TYPE NEWKEY IS LIMITED PRIVATE;
+          TYPE ACC_NKEY IS ACCESS NEWKEY;
+          PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY);
+     PRIVATE
+          TYPE KEY IS NEW NATURAL;
+          TYPE NEWKEY IS NEW KEY;
+     END P;
+
+     USE P;
+     SUBTYPE I IS INTEGER;
+     TYPE ACC_INT IS ACCESS I;
+     P_INT : ACC_INT;
+     SUBTYPE INT IS INTEGER RANGE 1 .. 5;
+     TYPE ARRAY_TYPE1 IS ARRAY (INT RANGE <>) OF INTEGER;
+     TYPE ACC_ARA_1 IS ACCESS ARRAY_TYPE1;
+     SUBTYPE ACC_ARA_2 IS ACC_ARA_1 (1 .. 2);
+     SUBTYPE ACC_ARA_3 IS ACC_ARA_1 (1 .. 3);
+     ARA1 : ACC_ARA_1;
+     ARA2 : ACC_ARA_2;
+     ARA3 : ACC_ARA_3;
+     TYPE GREET IS
+          RECORD
+               NAME : STRING (1 .. 2);
+          END RECORD;
+     TYPE ACC_GREET IS ACCESS GREET;
+     INTRO : ACC_GREET;
+     TYPE ACC_KEY IS ACCESS KEY;
+     KEY1 : ACC_KEY;
+     KEY2 : ACC_NKEY;
+
+     PACKAGE BODY P IS
+          FUNCTION INIT_KEY (X : NATURAL) RETURN KEY IS
+          BEGIN
+               RETURN (KEY(X));
+          END INIT_KEY;
+
+          PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY) IS
+          BEGIN
+               Y.ALL := NEWKEY (1);
+          END ASSIGN_NEWKEY;
+     END P;
+
+BEGIN
+
+     TEST ("C45282A", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " &
+                      "ACCESS TYPES TO SCALAR TYPES, ARRAY TYPES, " &
+                      "RECORD TYPES, PRIVATE TYPES, AND LIMITED " &
+                      "PRIVATE TYPES WITHOUT DISCRIMINANTS");
+
+-- CASE A
+     IF P_INT NOT IN ACC_INT THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1");
+     END IF;
+     P_INT := NEW INT'(5);
+     IF P_INT IN ACC_INT THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2");
+     END IF;
+
+-- CASE B
+     IF ARA1 NOT IN ACC_ARA_1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3");
+     END IF;
+     IF ARA1 NOT IN ACC_ARA_2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4");
+     END IF;
+     IF ARA1 IN ACC_ARA_3 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5");
+     END IF;
+     IF ARA2 IN ACC_ARA_1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6");
+     END IF;
+     IF ARA3 NOT IN ACC_ARA_1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7");
+     END IF;
+     ARA1 := NEW ARRAY_TYPE1'(1, 2, 3);
+     IF ARA1 IN ACC_ARA_1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8");
+     END IF;
+     IF ARA1 IN ACC_ARA_2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9");
+     END IF;
+     IF ARA1 NOT IN ACC_ARA_3 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10");
+     END IF;
+     ARA2 := NEW ARRAY_TYPE1'(1, 2);
+     IF ARA2 NOT IN ACC_ARA_1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11");
+     END IF;
+     IF ARA2 NOT IN ACC_ARA_2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12");
+     END IF;
+
+-- CASE C
+     IF INTRO NOT IN ACC_GREET THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13");
+     END IF;
+     INTRO := NEW GREET'(NAME => "HI");
+     IF INTRO IN ACC_GREET THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14");
+     END IF;
+     IF KEY1 NOT IN ACC_KEY THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15");
+     END IF;
+     KEY1 := NEW KEY'(INIT_KEY (1));
+     IF KEY1 IN ACC_KEY THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16");
+     END IF;
+     IF KEY2 NOT IN ACC_NKEY THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17");
+     END IF;
+     KEY2 := NEW NEWKEY;
+     ASSIGN_NEWKEY (KEY2);
+     IF KEY2 IN ACC_NKEY THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18");
+     END IF;
+
+     RESULT;
+END C45282A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282b.ada
new file mode 100644
index 000000000..af3a2bf2d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45282b.ada
@@ -0,0 +1,347 @@
+-- C45282B.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 AND NOT IN ARE EVALUATED CORRECTLY FOR :
+--     D) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH
+--        DISCRIMINANTS (WITH AND WITHOUT DEFAULT VALUES), WHERE THE 
+--        TYPE MARK DENOTES A CONSTRAINED AND UNCONSTRAINED TYPE;
+--     E) ACCESS TO TASK TYPES.
+
+-- TBN  8/8/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45282B IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 5;
+
+     PACKAGE P IS
+          TYPE PRI_REC1 (D : INT) IS PRIVATE;
+          TYPE PRI_REC2 (D : INT := 2) IS PRIVATE;
+          FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1;
+          FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2;
+          TYPE LIM_REC1 (D : INT) IS LIMITED PRIVATE;
+          TYPE ACC_LIM1 IS ACCESS LIM_REC1;
+          SUBTYPE ACC_SUB_LIM1 IS ACC_LIM1 (2);
+          PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING);
+          TYPE LIM_REC2 (D : INT := 2) IS LIMITED PRIVATE;
+          TYPE ACC_LIM2 IS ACCESS LIM_REC2;
+          SUBTYPE ACC_SUB_LIM2 IS ACC_LIM2 (2);
+          PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING);
+     PRIVATE
+          TYPE PRI_REC1 (D : INT) IS
+               RECORD
+                    STR : STRING (1 .. D);
+               END RECORD;
+          TYPE PRI_REC2 (D : INT := 2) IS
+               RECORD
+                    STR : STRING (1 .. D);
+               END RECORD;
+          TYPE LIM_REC1 (D : INT) IS
+               RECORD
+                    STR : STRING (1 .. D);
+               END RECORD;
+          TYPE LIM_REC2 (D : INT := 2) IS
+               RECORD
+                    STR : STRING (1 .. D);
+               END RECORD;
+     END P;
+
+     USE P;
+
+     TYPE DIS_REC1 (D : INT) IS
+          RECORD
+               STR : STRING (1 .. D);
+          END RECORD;
+     TYPE DIS_REC2 (D : INT := 5) IS
+          RECORD
+               STR : STRING (D .. 8);
+          END RECORD;
+
+     TYPE ACC1_REC1 IS ACCESS DIS_REC1;
+     SUBTYPE ACC2_REC1 IS ACC1_REC1 (2);
+     TYPE ACC1_REC2 IS ACCESS DIS_REC2;
+     SUBTYPE ACC2_REC2 IS ACC1_REC2 (2);
+     REC1 : ACC1_REC1;
+     REC2 : ACC2_REC1;
+     REC3 : ACC1_REC2;
+     REC4 : ACC2_REC2;
+     TYPE ACC_PREC1 IS ACCESS PRI_REC1;
+     SUBTYPE ACC_SREC1 IS ACC_PREC1 (2);
+     REC5 : ACC_PREC1;
+     REC6 : ACC_SREC1;
+     TYPE ACC_PREC2 IS ACCESS PRI_REC2;
+     SUBTYPE ACC_SREC2 IS ACC_PREC2 (2);
+     REC7 : ACC_PREC2;
+     REC8 : ACC_SREC2;
+     REC9 : ACC_LIM1;
+     REC10 : ACC_SUB_LIM1;
+     REC11 : ACC_LIM2;
+     REC12 : ACC_SUB_LIM2;
+
+     TASK TYPE T IS
+          ENTRY E (X : INTEGER);
+     END T;
+
+     TASK BODY T IS
+     BEGIN
+          ACCEPT E (X : INTEGER) DO
+               IF X /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT VALUE PASSED TO TASK");
+               END IF;
+          END E;
+     END T;
+
+     PACKAGE BODY P IS
+          FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1 IS
+               REC : PRI_REC1 (A);
+          BEGIN
+               REC := (A, B);
+               RETURN (REC);
+          END INIT_PREC1;
+
+          FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2 IS
+               REC : PRI_REC2;
+          BEGIN
+               REC := (A, B);
+               RETURN (REC);
+          END INIT_PREC2;
+
+          PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING) IS
+          BEGIN
+               A.ALL := (B, C);
+          END ASSIGN_LIM1;
+
+          PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING) IS
+          BEGIN
+               A.ALL := (B, C);
+          END ASSIGN_LIM2;
+     END P;
+
+BEGIN
+
+     TEST ("C45282B", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " &
+                      "ACCESS TYPES TO RECORD TYPES, PRIVATE TYPES, " &
+                      "LIMITED PRIVATE TYPES WITH DISCRIMINANTS, AND " &
+                      "TASK TYPES");
+
+-- CASE D
+------------------------------------------------------------------------
+     IF REC1 NOT IN ACC1_REC1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1");
+     END IF;
+     IF REC1 IN ACC2_REC1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2");
+     END IF;
+     IF REC2 NOT IN ACC1_REC1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3");
+     END IF;
+     REC1 := NEW DIS_REC1'(5, "12345");
+     IF REC1 IN ACC1_REC1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4");
+     END IF;
+     IF REC1 IN ACC2_REC1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5");
+     END IF;
+     REC2 := NEW DIS_REC1'(2, "HI");
+     IF REC2 IN ACC1_REC1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6");
+     END IF;
+
+------------------------------------------------------------------------
+
+     IF REC3 IN ACC1_REC2 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7");
+     END IF;
+     IF REC3 NOT IN ACC2_REC2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8");
+     END IF;
+     IF REC4 IN ACC1_REC2 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9");
+     END IF;
+     REC3 := NEW DIS_REC2'(5, "5678");
+     IF REC3 IN ACC1_REC2 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10");
+     END IF;
+     IF REC3 IN ACC2_REC2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11");
+     END IF;
+     REC4 := NEW DIS_REC2'(2, "2345678");
+     IF REC4 IN ACC1_REC2 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12");
+     END IF;
+     IF REC4 NOT IN ACC2_REC2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13");
+     END IF;
+
+------------------------------------------------------------------------
+
+     IF REC5 NOT IN ACC_PREC1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14");
+     END IF;
+     IF REC5 NOT IN ACC_SREC1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15");
+     END IF;
+     IF REC6 NOT IN ACC_PREC1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16");
+     END IF;
+     REC5 := NEW PRI_REC1'(INIT_PREC1 (5, "12345"));
+     IF REC5 IN ACC_PREC1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17");
+     END IF;
+     IF REC5 IN ACC_SREC1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18");
+     END IF;
+     REC6 := NEW PRI_REC1'(INIT_PREC1 (2, "HI"));
+     IF REC6 IN ACC_PREC1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 19");
+     END IF;
+
+------------------------------------------------------------------------
+
+     IF REC7 NOT IN ACC_PREC2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 20");
+     END IF;
+     IF REC7 NOT IN ACC_SREC2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 21");
+     END IF;
+     IF REC8 NOT IN ACC_PREC2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 22");
+     END IF;
+     REC7 := NEW PRI_REC2'(INIT_PREC2 (5, "12345"));
+     IF REC7 IN ACC_PREC2 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 23");
+     END IF;
+     IF REC7 IN ACC_SREC2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 24");
+     END IF;
+     REC8 := NEW PRI_REC2'(INIT_PREC2 (2, "HI"));
+     IF REC8 IN ACC_PREC2 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 25");
+     END IF;
+
+------------------------------------------------------------------------
+
+     IF REC9 NOT IN ACC_LIM1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 26");
+     END IF;
+     IF REC9 NOT IN ACC_SUB_LIM1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 27");
+     END IF;
+     IF REC10 NOT IN ACC_LIM1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 28");
+     END IF;
+     REC9 := NEW LIM_REC1 (5);
+     ASSIGN_LIM1 (REC9, 5, "12345");
+     IF REC9 IN ACC_LIM1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 29");
+     END IF;
+     IF REC9 IN ACC_SUB_LIM1 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 30");
+     END IF;
+     REC10 := NEW LIM_REC1 (2);
+     ASSIGN_LIM1 (REC10, 2, "12");
+     IF REC10 IN ACC_LIM1 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 31");
+     END IF;
+
+------------------------------------------------------------------------
+
+     IF REC11 NOT IN ACC_LIM2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 32");
+     END IF;
+     IF REC11 NOT IN ACC_SUB_LIM2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 33");
+     END IF;
+     IF REC12 NOT IN ACC_LIM2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 34");
+     END IF;
+     REC11 := NEW LIM_REC2;
+     IF REC11 NOT IN ACC_SUB_LIM2 THEN
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 35");
+     END IF;
+     ASSIGN_LIM2 (REC11, 2, "12");
+     IF REC11 IN ACC_LIM2 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 36");
+     END IF;
+     IF REC11 IN ACC_SUB_LIM2 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 37");
+     END IF;
+     REC12 := NEW LIM_REC2;
+     ASSIGN_LIM2 (REC12, 2, "12");
+     IF REC12 IN ACC_LIM2 THEN
+          NULL;
+     ELSE
+          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38");
+     END IF;
+
+-- CASE E
+------------------------------------------------------------------------
+     DECLARE
+          TYPE ACC_TASK IS ACCESS T;
+          T1 : ACC_TASK;
+     BEGIN
+          IF T1 NOT IN ACC_TASK THEN
+               FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 39");
+          END IF;
+          T1 := NEW T;
+          IF T1 IN ACC_TASK THEN
+               NULL;
+          ELSE
+               FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38");
+          END IF;
+          T1.E (1);
+     END;
+
+     RESULT;
+END C45282B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45291a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45291a.ada
new file mode 100644
index 000000000..86c9eb2d8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45291a.ada
@@ -0,0 +1,158 @@
+-- C45291A.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 MEMBERSHIP TESTS YIELD CORRECT RESULTS FOR TASK
+--     TYPES, LIMITED PRIVATE TYPES, COMPOSITE LIMITED TYPES, AND
+--     PRIVATE TYPES WITHOUT DISCRIMINANTS.
+
+-- HISTORY:
+--     JET 08/10/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45291A IS
+
+     TASK TYPE TASK1 IS
+          ENTRY E;
+     END TASK1;
+
+     PACKAGE PACK IS
+          TYPE LIM_PRIV IS LIMITED PRIVATE;
+          TYPE LIM_COMP IS ARRAY (1..10) OF LIM_PRIV;
+          TYPE PRIV IS PRIVATE;
+          PROCEDURE INIT(LP : OUT LIM_PRIV;
+                         LC : IN OUT LIM_COMP;
+                         P  : OUT PRIV);
+     PRIVATE
+          TYPE LIM_PRIV IS RANGE -100..100;
+          TYPE PRIV IS RECORD
+               I : INTEGER;
+          END RECORD;
+     END PACK;
+
+     SUBTYPE SUB_TASK1 IS TASK1;
+     SUBTYPE SUB_LIM_PRIV IS PACK.LIM_PRIV;
+     SUBTYPE SUB_LIM_COMP IS PACK.LIM_COMP;
+     SUBTYPE SUB_PRIV IS PACK.PRIV;
+
+     T1 : TASK1;
+     LP : PACK.LIM_PRIV;
+     LC : PACK.LIM_COMP;
+     P  : PACK.PRIV;
+
+     TASK BODY TASK1 IS
+     BEGIN
+          ACCEPT E DO
+               NULL;
+          END E;
+     END TASK1;
+
+     PACKAGE BODY PACK IS
+          PROCEDURE INIT (LP : OUT LIM_PRIV;
+                          LC : IN OUT LIM_COMP;
+                          P  : OUT PRIV) IS
+          BEGIN
+               LP := 0;
+               LC := (OTHERS => 0);
+               P  := (I => 0);
+          END INIT;
+     END PACK;
+
+BEGIN
+     TEST ("C45291A", "CHECK THAT THE MEMBERSHIP TESTS YIELD CORRECT " &
+                      "RESULTS FOR TASK TYPES, LIMITED PRIVATE TYPES," &
+                      " COMPOSITE LIMITED TYPES, AND PRIVATE TYPES " &
+                      "WITHOUT DISCRIMINANTS");
+
+     PACK.INIT(LP, LC, P);
+
+     IF NOT IDENT_BOOL(T1 IN TASK1) THEN
+          FAILED ("INCORRECT VALUE OF 'T1 IN TASK1'");
+     END IF;
+
+     IF IDENT_BOOL(T1 NOT IN TASK1) THEN
+          FAILED ("INCORRECT VALUE OF 'T1 NOT IN TASK1'");
+     END IF;
+
+     IF NOT IDENT_BOOL(LP IN PACK.LIM_PRIV) THEN
+          FAILED ("INCORRECT VALUE OF 'LP IN LIM_PRIV'");
+     END IF;
+
+     IF IDENT_BOOL(LP NOT IN PACK.LIM_PRIV) THEN
+          FAILED ("INCORRECT VALUE OF 'LP NOT IN LIM_PRIV'");
+     END IF;
+
+     IF NOT IDENT_BOOL(LC IN PACK.LIM_COMP) THEN
+          FAILED ("INCORRECT VALUE OF 'LC IN LIM_COMP'");
+     END IF;
+
+     IF IDENT_BOOL(LC NOT IN PACK.LIM_COMP) THEN
+          FAILED ("INCORRECT VALUE OF 'LC NOT IN LIM_COMP'");
+     END IF;
+
+     IF NOT IDENT_BOOL(P IN PACK.PRIV) THEN
+          FAILED ("INCORRECT VALUE OF 'P IN PRIV'");
+     END IF;
+
+     IF IDENT_BOOL(P NOT IN PACK.PRIV) THEN
+          FAILED ("INCORRECT VALUE OF 'P NOT IN PRIV'");
+     END IF;
+
+     IF NOT IDENT_BOOL(T1 IN SUB_TASK1) THEN
+          FAILED ("INCORRECT VALUE OF 'T1 IN SUB_TASK1'");
+     END IF;
+
+     IF IDENT_BOOL(T1 NOT IN SUB_TASK1) THEN
+          FAILED ("INCORRECT VALUE OF 'T1 NOT IN SUB_TASK1'");
+     END IF;
+
+     IF NOT IDENT_BOOL(LP IN SUB_LIM_PRIV) THEN
+          FAILED ("INCORRECT VALUE OF 'LP IN SUB_LIM_PRIV'");
+     END IF;
+
+     IF IDENT_BOOL(LP NOT IN SUB_LIM_PRIV) THEN
+          FAILED ("INCORRECT VALUE OF 'LP NOT IN SUB_LIM_PRIV'");
+     END IF;
+
+     IF NOT IDENT_BOOL(LC IN SUB_LIM_COMP) THEN
+          FAILED ("INCORRECT VALUE OF 'LC IN SUB_LIM_COMP'");
+     END IF;
+
+     IF IDENT_BOOL(LC NOT IN SUB_LIM_COMP) THEN
+          FAILED ("INCORRECT VALUE OF 'LC NOT IN SUB_LIM_COMP'");
+     END IF;
+
+     IF NOT IDENT_BOOL(P IN SUB_PRIV) THEN
+          FAILED ("INCORRECT VALUE OF 'P IN SUB_PRIV'");
+     END IF;
+
+     IF IDENT_BOOL(P NOT IN SUB_PRIV) THEN
+          FAILED ("INCORRECT VALUE OF 'P NOT IN SUB_PRIV'");
+     END IF;
+
+     T1.E;
+
+     RESULT;
+
+END C45291A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45303a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45303a.ada
new file mode 100644
index 000000000..01cd53dba
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45303a.ada
@@ -0,0 +1,80 @@
+-- C45303A.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 ADDITION AND SUBTRACTION YIELD RESULTS BELONGING TO THE
+-- BASE TYPE.
+
+-- JBG 2/24/84
+-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+-- JRL 10/13/96 Fixed static expressions which contained values outside
+--              the base range.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45303A IS
+
+     TYPE INT IS RANGE 1..10;
+
+     X, Y : INT := INT(IDENT_INT(9));
+
+BEGIN
+
+     TEST ("C45303A", "CHECK SUBTYPE OF INTEGER ADDITION/SUBTRACTION");
+
+     BEGIN
+
+          IF X + Y - 10 /= INT(IDENT_INT(8)) THEN
+               FAILED ("INCORRECT RESULT - ADDITION");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               IF INT'POS(INT'BASE'LAST) >= 18 THEN
+                    FAILED ("ADDITION DOES NOT YIELD RESULT " &
+                            "BELONGING TO THE BASE TYPE");
+               ELSE
+                    COMMENT ("BASE TYPE HAS RANGE LESS THAN 18 - ADD");
+               END IF;
+     END;
+
+     BEGIN
+
+          IF 2 - X - INT(IDENT_INT(1)) /= INT'VAL(IDENT_INT(-8)) THEN
+               FAILED ("INCORRECT RESULT - SUBTRACTION");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               IF INT'POS(INT'BASE'FIRST) <= -8 THEN
+                    FAILED ("SUBTRACTION DOES NOT YIELD RESULT " &
+                            "BELONGING TO THE BASE TYPE");
+               ELSE
+                    COMMENT ("BASE TYPE HAS RANGE GREATER THAN -8 - SUB");
+               END IF;
+     END;
+
+     RESULT;
+
+END C45303A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45304a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45304a.ada
new file mode 100644
index 000000000..8a5dfe991
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45304a.ada
@@ -0,0 +1,82 @@
+-- C45304A.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 CONSTRAINT_ERROR IS RAISED BY
+--     "+" AND "-" FOR PREDEFINED INTEGER WHEN THE RESULT IS OUTSIDE
+--     THE RANGE OF THE BASE TYPE.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--     TBN 10/06/86  CREATED ORIGINAL TEST.
+--     JET 12/29/87  FURTHER DEFEATED OPTIMIZATION.
+--     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45304A IS
+
+BEGIN
+     TEST ("C45304A", "CHECK THAT CONSTRAINT_ERROR " &
+                      "IS RAISED BY ""+"" AND ""-"" FOR PREDEFINED " &
+                      "INTEGER WHEN THE RESULT IS OUTSIDE THE RANGE " &
+                      "OF THE BASE TYPE");
+
+     DECLARE
+          B : INTEGER := INTEGER'LAST;
+     BEGIN
+          IF EQUAL (IDENT_INT(B)+1, 0) THEN
+               FAILED ("NO EXCEPTION FOR ADDITION -- ZERO RESULT");
+          ELSE
+               FAILED ("NO EXCEPTION FOR ADDITION -- NONZERO RESULT");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR ADDITION");
+     END;
+
+     DECLARE
+          B : INTEGER := INTEGER'FIRST;
+     BEGIN
+          IF EQUAL (IDENT_INT(B)-1, 0) THEN
+               FAILED ("NO EXCEPTION FOR SUBTRACTION -- ZERO RESULT");
+          ELSE
+               FAILED ("NO EXCEPTION FOR SUBTRACTION -- " &
+                       "NONZERO RESULT");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR SUBTRACTION");
+     END;
+
+     RESULT;
+END C45304A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45304b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45304b.dep
new file mode 100644
index 000000000..23620f8b9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45304b.dep
@@ -0,0 +1,111 @@
+-- C45304B.DEP
+
+--                             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 CONSTRAINT_ERROR IS RAISED BY
+--     "+" AND "-" FOR PREDEFINED SHORT_INTEGER WHEN THE RESULT IS
+--     OUTSIDE THE RANGE OF THE BASE TYPE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE IF THE IMPLEMENTATION HAS A
+--     PREDEFINED TYPE SHORT_INTEGER.
+
+--     IF SHORT_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "TEST_VAR" MUST BE REJECTED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--     TBN 10/07/86  CREATED ORIGINAL TEST.
+--     JET 12/30/87  ADDED CODE TO PREVENT OPTIMIZATION.
+--     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45304B IS
+
+     TEST_VAR : SHORT_INTEGER;                 -- N/A => ERROR.
+
+     -- THESE FUNCTIONS ARE TO PREVENT OPTIMIZATION.
+
+     FUNCTION IDENT_SHORT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;
+          ELSE
+               RETURN (0);
+          END IF;
+     END IDENT_SHORT;
+
+     FUNCTION SHORT_OK (X : SHORT_INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          RETURN EQUAL (INTEGER(X),INTEGER(X));
+     END SHORT_OK;
+
+BEGIN
+     TEST ("C45304B", "CHECK THAT CONSTRAINT_ERROR " &
+                      "IS RAISED BY ""+"" AND ""-"" FOR PREDEFINED " &
+                      "SHORT_INTEGER WHEN THE RESULT IS OUTSIDE THE " &
+                      "RANGE OF THE BASE TYPE");
+
+     DECLARE
+          B : SHORT_INTEGER := SHORT_INTEGER'LAST;
+     BEGIN
+          IF SHORT_OK (B + IDENT_SHORT(1)) THEN
+               FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
+                       "SHORT_OK RETURNS TRUE");
+          ELSE
+               FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
+                       "SHORT_OK RETURNS FALSE");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+     END;
+
+     DECLARE
+          B : SHORT_INTEGER := SHORT_INTEGER'FIRST;
+     BEGIN
+
+          IF SHORT_OK (B - IDENT_SHORT(1)) THEN
+               FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION- " &
+                       "SHORT_OK RETURNS TRUE");
+          ELSE
+               FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION - " &
+                       "SHORT_OK RETURNS FALSE");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+     END;
+
+     RESULT;
+END C45304B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45304c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45304c.dep
new file mode 100644
index 000000000..9eaba634f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45304c.dep
@@ -0,0 +1,110 @@
+-- C45304C.DEP
+
+--                             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 CONSTRAINT_ERROR IS RAISED BY
+--     "+" AND "-" FOR PREDEFINED LONG_INTEGER WHEN THE RESULT IS
+--     OUTSIDE THE RANGE OF THE BASE TYPE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE IF THE IMPLEMENTATION HAS A
+--     PREDEFINED TYPE LONG_INTEGER.
+
+--     IF LONG_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "TEST_VAR" MUST BE REJECTED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--     TBN 10/07/86  CREATED ORIGINAL TEST.
+--     JET 12/30/87  ADDED CODE TO PREVENT OPTIMIZATION.
+--     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45304C IS
+
+     TEST_VAR : LONG_INTEGER;               -- N/A => ERROR.
+
+     -- THESE FUNCTIONS ARE TO PREVENT OPTIMIZATION.
+
+     FUNCTION IDENT_LONG (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT_LONG;
+
+     FUNCTION LONG_OK (X : LONG_INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          RETURN X = IDENT_LONG(X);
+     END LONG_OK;
+
+BEGIN
+     TEST ("C45304C", "CHECK THAT CONSTRAINT_ERROR " &
+                      "IS RAISED BY ""+"" AND ""-"" FOR PREDEFINED " &
+                      "LONG_INTEGER WHEN THE RESULT IS OUTSIDE THE " &
+                      "RANGE OF THE BASE TYPE");
+
+     DECLARE
+          B : LONG_INTEGER := LONG_INTEGER'LAST;
+     BEGIN
+          IF LONG_OK (B + IDENT_LONG(1)) THEN
+               FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
+                       "LONG_OK RETURNS TRUE");
+          ELSE
+               FAILED ("NO EXCEPTION RAISED FOR ADDITION - " &
+                       "LONG_OK RETURNS FALSE");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+     END;
+
+     DECLARE
+          B : LONG_INTEGER := LONG_INTEGER'FIRST;
+     BEGIN
+          IF LONG_OK (B - IDENT_LONG(1)) THEN
+               FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION - " &
+                       "LONG_OK RETURNS TRUE");
+          ELSE
+               FAILED ("NO EXCEPTION RAISED FOR SUBTRACTION - " &
+                       "LONG_OK RETURNS FALSE");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+     END;
+
+     RESULT;
+END C45304C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45322a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45322a.ada
new file mode 100644
index 000000000..8857c32f2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45322a.ada
@@ -0,0 +1,196 @@
+-- C45322A.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 CONSTRAINT_ERROR IS RAISED IF 
+--     MACHINE_OVERFLOWS IS TRUE AND THE RESULT OF THE ADDITION OR 
+--     SUBTRACTION LIES OUTSIDE OF THE RANGE OF THE BASE TYPE.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--     NPL 09/01/90  CREATED ORIGINAL TEST.
+--     LDC 10/09/90  CHANGED THE STYLE OF THE TEST TO THE STANDARD
+--                   ACVC FORMAT AND WRAPPED LINES WHICH WHERE LONGER
+--                   THAN 71 CHARACTERS.
+--     JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45322A IS
+
+  TYPE FLOAT5 IS DIGITS 5;
+  F5 : FLOAT5;
+
+  FUNCTION IDENT (F : FLOAT5) RETURN FLOAT5 IS
+  BEGIN
+    RETURN F * FLOAT5(IDENT_INT(1));
+  END IDENT;
+
+  FUNCTION EQUAL (F,G : FLOAT5) RETURN BOOLEAN IS
+  BEGIN
+    RETURN F = G + FLOAT5(IDENT_INT(0));
+  END EQUAL;
+
+BEGIN
+     TEST ("C45322A", "CHECK THAT CONSTRAINT_ERROR " &
+                      "IS RAISED IF MACHINE_OVERFLOWS IS TRUE AND " &
+                      "THE RESULT OF THE ADDITION OR SUBTRACTION " &
+                      "LIES OUTSIDE OF THE RANGE OF THE BASE TYPE");
+
+     IF NOT FLOAT5'MACHINE_OVERFLOWS THEN
+          NOT_APPLICABLE("MACHINE_OVERFLOWS IS FALSE");
+     ELSE
+
+          BEGIN
+               F5 := IDENT(FLOAT5'BASE'LAST) + FLOAT5'BASE'LAST;
+
+               FAILED("NO EXCEPTION RAISED BY LARGE '+'");
+
+               IF NOT EQUAL(F5, F5) THEN
+                    COMMENT("DON'T OPTIMIZE F5");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED BY LARGE '+'");
+          END;
+
+          -- AS ABOVE BUT INTERCHANGING '+' AND '-'
+          BEGIN
+               F5 := IDENT(FLOAT5'BASE'LAST) - FLOAT5'BASE'LAST;
+
+               IF NOT EQUAL(F5, F5) THEN
+                    COMMENT("DON'T OPTIMIZE F5");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED("CONSTRAINT_ERROR " &
+                           "RAISED BY INTERCHANGING LARGE '+'");
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED BY " &
+                           "INTERCHANGING LARGE '+'");
+          END;
+
+          BEGIN
+               F5 := IDENT(FLOAT5'BASE'FIRST) + FLOAT5'BASE'FIRST;
+
+               FAILED("NO EXCEPTION RAISED BY SMALL '+'");
+
+               IF NOT EQUAL(F5, F5) THEN
+                    COMMENT("DON'T OPTIMIZE F5");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED BY SMALL '+'");
+          END;
+
+          -- AS ABOVE BUT INTERCHANGING '+' AND '-'
+          BEGIN
+               F5 := IDENT(FLOAT5'BASE'FIRST) - FLOAT5'BASE'FIRST;
+
+               IF NOT EQUAL(F5, F5) THEN
+                    COMMENT("DON'T OPTIMIZE F5");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED("CONSTRAINT_ERROR " &
+                           "RAISED BY INTERCHANGING SMALL '+'");
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED BY " &
+                           "INTERCHANGING SMALL '+'");
+          END;
+
+          BEGIN
+               F5 := IDENT(FLOAT5'BASE'LAST) - FLOAT5'BASE'FIRST;
+
+               FAILED("NO EXCEPTION RAISED BY LARGE '-'");
+
+               IF NOT EQUAL(F5, F5) THEN
+                    COMMENT("DON'T OPTIMIZE F5");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED BY LARGE '-'");
+          END;
+
+          -- AS ABOVE BUT INTERCHANGING '+' AND '-'
+          BEGIN
+               F5 := IDENT(FLOAT5'BASE'LAST) + FLOAT5'BASE'FIRST;
+
+               IF NOT EQUAL(F5, F5) THEN
+                    COMMENT("DON'T OPTIMIZE F5");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED("CONSTRAINT_ERROR " &
+                           "RAISED BY INTERCHANGING LARGE '-'");
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED BY " &
+                           "INTERCHANGING LARGE '-'");
+          END;
+
+          BEGIN
+               F5 := IDENT(FLOAT5'BASE'FIRST) - FLOAT5'BASE'LAST;
+
+               FAILED("NO EXCEPTION RAISED BY SMALL '-'");
+
+               IF NOT EQUAL(F5, F5) THEN
+                    COMMENT("DON'T OPTIMIZE F5");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED BY SMALL '-'");
+          END;
+
+          -- AS ABOVE BUT INTERCHANGING '+' AND '-'
+          BEGIN
+               F5 := IDENT(FLOAT5'BASE'FIRST) + FLOAT5'BASE'LAST;
+
+               IF NOT EQUAL(F5, F5) THEN
+                    COMMENT("DON'T OPTIMIZE F5");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED("CONSTRAINT_ERROR " &
+                           "RAISED BY INTERCHANGING SMALL '-'");
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED BY " &
+                           "INTERCHANGING SMALL '-'");
+          END;
+
+     END IF;
+
+     RESULT;
+
+END C45322A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45323a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45323a.ada
new file mode 100644
index 000000000..98c17d740
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45323a.ada
@@ -0,0 +1,67 @@
+-- C45323A.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 NONASSOCIATIVITY OF REAL ARITHMETIC IS PRESERVED
+--     FOR FLOATING POINT PRECISION 5, EVEN WHEN OPTIMIZATION WOULD
+--     BENEFIT IF FLOATING POINT ADDITION WERE ASSOCIATIVE.
+
+-- HISTORY:
+--     JET 08/10/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45323A IS
+
+     TYPE FLOAT5 IS DIGITS 5;
+
+     A, B, C, D, E : FLOAT5;
+
+     FUNCTION IDENT(F : FLOAT5) RETURN FLOAT5 IS
+     BEGIN
+          RETURN F * FLOAT5(IDENT_INT(1));
+     END IDENT;
+
+BEGIN
+     TEST ("C45323A", "CHECK THAT THE NONASSOCIATIVITY OF REAL " &
+                      "ARITHMETIC IS PRESERVED FOR FLOATING POINT " &
+                      "PRECISION 5, EVEN WHEN OPTIMIZATION WOULD " &
+                      "BENEFIT IF FLOATING POINT ADDITION WERE " &
+                      "ASSOCIATIVE");
+
+     B := 2#0.1010_1010_1010_1010_10#E3;
+     A := -B;
+     C := 2#0.1000_0000_0000_0000_00#E-18;
+     D := B + C;
+     E := A + B + C;
+
+     IF IDENT(A) + IDENT(B) /= 0.0 THEN
+          FAILED("INCORRECT VALUE OF A + B");
+     END IF;
+
+     IF IDENT(E) /= IDENT(C) THEN
+          FAILED("C DOES NOT EQUAL E");
+     END IF;
+
+     RESULT;
+END C45323A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45331a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45331a.ada
new file mode 100644
index 000000000..bdbcd6150
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45331a.ada
@@ -0,0 +1,357 @@
+-- C45331A.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 FIXED POINT TYPES THE OPERATORS "+" AND "-" PRODUCE
+-- CORRECT RESULTS WHEN:
+--      (A) A, B, A+B, AND A-B ARE ALL MODEL NUMBERS.
+--      (B) A IS A MODEL NUMBER BUT B, A+B, AND A-B ARE NOT.
+--      (C) A, B, A+B, AND A-B ARE ALL MODEL NUMBERS WITH DIFFERENT
+--          SUBTYPES.
+
+-- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+
+-- WRG 8/27/86
+-- KAS 11/14/95 REDUCE EXPECTATION FOR T'SMALL
+-- KAS 11/30/95 ONE MORE CHANGE...
+-- PWN 02/28/96 CLEANED COMMENTS FOR RELEASE
+-- KAS 03/18/96 ELIDED TWO 'SMALL CASES FOR 2.1
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45331A IS
+
+     TYPE LIKE_DURATION IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+          -- 'MANTISSA = 23.
+     SUBTYPE F     IS LIKE_DURATION DELTA 0.25 RANGE -1000.0 .. 1000.0;
+     SUBTYPE ST_F1 IS LIKE_DURATION DELTA 0.5  RANGE    -4.0 ..    3.0;
+     SUBTYPE ST_F2 IS LIKE_DURATION DELTA 1.0 / 16
+             RANGE -13.0 / 16 .. 5.0 + 1.0 / 16;
+
+BEGIN
+
+     TEST ("C45331A", "CHECK THAT FOR FIXED POINT TYPES THE " &
+                      "OPERATORS ""+"" AND ""-"" PRODUCE CORRECT " &
+                      "RESULTS - BASIC TYPES");
+
+     -------------------------------------------------------------------
+
+A:   DECLARE
+          SMALL, MAX, MIN, ZERO : F := 0.5;
+          X                     : F := 0.0;
+     BEGIN
+          -- INITIALIZE "CONSTANTS":
+          IF EQUAL (3, 3) THEN
+               SMALL := F'SMALL;
+               MAX   := F'LAST;  -- BECAUSE F'LAST < F'LARGE AND F'LAST
+                                 -- IS A MODEL NUMBER.
+               MIN   := F'FIRST; -- F'FIRST IS A MODEL NUMBER.
+               ZERO  := 0.0;
+          END IF;
+
+          -- CHECK SMALL + OR - ZERO = SMALL:
+          IF "+"(LEFT => SMALL, RIGHT => ZERO) /= SMALL OR
+             0.0 + SMALL /= SMALL THEN
+               FAILED ("F'SMALL + 0.0 /= F'SMALL");
+          END IF;
+          IF "-"(LEFT => SMALL, RIGHT => ZERO) /= SMALL OR
+             SMALL - 0.0 /= SMALL THEN
+               FAILED ("F'SMALL - 0.0 /= F'SMALL");
+          END IF;
+
+          -- CHECK MAX + OR - ZERO = MAX:
+          IF MAX + ZERO /= MAX OR 0.0 + MAX /= MAX THEN
+               FAILED ("F'LAST + 0.0 /= F'LAST");
+          END IF;
+          IF MAX - ZERO /= MAX OR MAX - 0.0 /= MAX THEN
+               FAILED ("F'LAST - 0.0 /= F'LAST");
+          END IF;
+
+          -- CHECK SMALL - SMALL = 0.0:
+          IF EQUAL (3, 3) THEN
+               X := SMALL;
+          END IF;
+          IF SMALL - X /= 0.0 OR SMALL - SMALL /= 0.0 OR
+             F'SMALL - F'SMALL /= 0.0 THEN
+               FAILED ("F'SMALL - F'SMALL /= 0.0");
+          END IF;
+
+          -- CHECK MAX - MAX = 0.0:
+          IF EQUAL (3, 3) THEN
+               X := MAX;
+          END IF;
+          IF MAX - X /= 0.0 OR MAX - MAX /= 0.0 OR
+             F'LAST - F'LAST /= 0.0 THEN
+               FAILED ("F'LAST - F'LAST /= 0.0");
+          END IF;
+
+          -- CHECK ZERO - MAX = MIN, MIN - MIN = 0.0,
+          -- AND MIN + MAX = 0.0:
+          IF EQUAL (3, 3) THEN
+               X := ZERO - MAX;
+          END IF;
+          IF X /= MIN THEN
+               FAILED ("0.0 - 1000.0 /= -1000.0");
+          END IF;
+          IF EQUAL (3, 3) THEN
+               X := MIN;
+          END IF;
+          IF MIN - X /= 0.0 OR MIN - MIN /= 0.0 OR
+             F'FIRST - F'FIRST /= 0.0 THEN
+               FAILED ("F'FIRST - F'FIRST /= 0.0");
+          END IF;
+          IF MIN + MAX /= 0.0 OR MAX + MIN /= 0.0 OR
+             F'FIRST + F'LAST /= 0.0 THEN
+               FAILED ("-1000.0 + 1000.0 /= 0.0");
+          END IF;
+
+          -- CHECK ADDITION AND SUBTRACTION FOR ARBITRARY MID-RANGE
+          -- NUMBERS:
+          IF EQUAL (3, 3) THEN
+               X := 100.75;
+          END IF;
+          IF (X + SMALL) /= (SMALL + X) OR
+             (X + SMALL) > (X + 0.25) THEN -- X + SMALL SB <= X + DELTA
+               FAILED("X + SMALL DELIVERED BAD RESULT");
+          END IF;
+
+          -- CHECK (MAX - SMALL) + SMALL = MAX:
+          IF EQUAL (3, 3) THEN
+               X := MAX - SMALL;
+          END IF;
+          IF X + SMALL /= MAX THEN
+              FAILED("(MAX - SMALL) + SMALL /= MAX");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - A");
+     END A;
+
+     -------------------------------------------------------------------
+
+B:   DECLARE
+          NON_MODEL_CONST : CONSTANT := 2.0 / 3;
+          NON_MODEL_VAR   : F        := 0.0;
+
+          SMALL, MAX, MIN, ZERO : F := 0.5;
+          X                     : F := 0.0;
+     BEGIN
+          -- INITIALIZE "CONSTANTS":
+          IF EQUAL (3, 3) THEN
+               SMALL         := F'SMALL;
+               MAX           := F'LAST;  -- BECAUSE F'LAST < F'LARGE AND
+                                         -- F'LAST  IS A MODEL NUMBER.
+               MIN           := F'FIRST; -- F'FIRST IS A MODEL NUMBER.
+               ZERO          := 0.0;
+               NON_MODEL_VAR := NON_MODEL_CONST;
+          END IF;
+
+          -- CHECK VALUE OF NON_MODEL_VAR:
+          IF NON_MODEL_VAR NOT IN 0.5 .. 0.75 THEN
+               FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE");
+          END IF;
+
+          -- CHECK NON-MODEL VALUE + OR - ZERO:
+          IF NON_MODEL_VAR + ZERO NOT IN 0.5 .. 0.75 OR
+             F'(0.0) + NON_MODEL_CONST NOT IN 0.5 .. 0.75 THEN
+               FAILED ("(2.0 / 3) + 0.0 NOT IN 0.5 .. 0.75");
+          END IF;
+          IF NON_MODEL_VAR  - ZERO NOT IN 0.5 .. 0.75 OR
+             NON_MODEL_CONST - F'(0.0) NOT IN 0.5 .. 0.75 THEN
+               FAILED ("(2.0 / 3) - 0.0 NOT IN 0.5 .. 0.75");
+          END IF;
+
+          -- CHECK ZERO - NON-MODEL:
+          IF F'(0.0) - NON_MODEL_CONST NOT IN -0.75 .. -0.5 THEN
+               FAILED ("0.0 - (2.0 / 3) NOT IN -0.75 .. -0.5");
+          END IF;
+
+          IF F'(1.0) - NON_MODEL_CONST NOT IN 0.25 .. 0.5 THEN
+               FAILED ("1.0 - (2.0 / 3) NOT IN 0.25 .. 0.5");
+          END IF;
+
+          -- CHECK ADDITION AND SUBTRACTION OF NON-MODEL NEAR MIN AND
+          -- MAX:
+          IF MIN + NON_MODEL_VAR NOT IN -999.5 .. -999.25 OR
+             NON_MODEL_CONST + F'FIRST NOT IN -999.5 .. -999.25 THEN
+               FAILED ("-1000.0 + (2.0 / 3) NOT IN -999.5 .. -999.25");
+          END IF;
+          IF MAX - NON_MODEL_VAR NOT IN 999.25 .. 999.5 OR
+             F'LAST - NON_MODEL_CONST NOT IN 999.25 .. 999.5 THEN
+               FAILED ("1000.0 - (2.0 / 3) NOT IN 999.25 .. 999.5");
+          END IF;
+
+          -- CHECK ADDITION AND SUBTRACTION FOR ARBITRARY MID-RANGE
+          -- MODEL NUMBER WITH NON-MODEL:
+          IF EQUAL (3, 3) THEN
+               X := -213.25;
+          END IF;
+          IF X + NON_MODEL_CONST NOT IN -212.75 .. -212.5 THEN
+               FAILED ("-213.25 + (2.0 / 3) NOT IN -212.75 .. -212.5");
+          END IF;
+          IF NON_MODEL_VAR - X NOT IN 213.75 .. 214.0 THEN
+               FAILED ("(2.0 / 3) - (-213.25) NOT IN 213.75 .. 214.0");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - B");
+     END B;
+
+     -------------------------------------------------------------------
+
+C:   DECLARE
+          A_SMALL, A_MAX, A_MIN : ST_F1 := 0.0;
+          B_SMALL, B_MAX, B_MIN : ST_F2 := 0.0;
+          X                     : F;
+     BEGIN
+          -- INITIALIZE "CONSTANTS":
+          IF EQUAL (3, 3) THEN
+               A_SMALL := ST_F1'SMALL;
+               A_MAX   := ST_F1'LAST;  -- BECAUSE 'LAST < 'LARGE AND
+                                       -- 'LAST  IS A MODEL NUMBER.
+               A_MIN   := ST_F1'FIRST; -- 'FIRST IS A MODEL NUMBER.
+
+               B_SMALL := ST_F2'SMALL;
+               B_MAX   := ST_F2'LAST;  -- BECAUSE 'LAST <= 'LARGE AND
+                                       -- 'LAST  IS A MODEL NUMBER.
+               B_MIN   := ST_F2'FIRST; -- 'FIRST IS A MODEL NUMBER.
+          END IF;
+
+          IF A_MIN + B_MIN /= -4.8125 THEN
+               FAILED ("-4.0 + (-0.8125) /= -4.8125");
+          END IF;
+
+          IF A_MIN - B_MIN /= -3.1875 THEN
+               FAILED ("-4.0 - (-0.8125) /= -3.1875");
+          END IF;
+
+          IF (A_MIN + B_SMALL) NOT IN A_MIN .. -3.9375 THEN
+               FAILED ("(A_MIN + B_SMALL) NOT IN A_MIN .. -3.9375");
+          END IF;
+
+          IF (A_MIN - B_SMALL) NOT IN -4.0625 .. -4.0 THEN
+              FAILED ("(A_MIN - B_SMALL) NOT IN -4.0 .. -4.0625");
+          END IF;
+
+          IF A_MIN + B_MAX /= 1.0625 THEN
+               FAILED ("-4.0 + 5.0625 /= 1.0625");
+          END IF;
+
+          IF A_MIN - B_MAX /= -9.0625 THEN
+               FAILED ("-4.0 - 5.0625 /= -9.0625");
+          END IF;
+
+          IF (A_SMALL + B_MIN) NOT IN  B_MIN..-0.3125 THEN
+               FAILED ("(A_SMALL + B_MIN) NOT IN  B_MIN..-0.3125");
+          END IF;
+
+          IF (A_SMALL - B_MIN) NOT IN +0.8125 .. 1.3125 THEN
+               FAILED ("(A_SMALL - B_MIN) NOT IN -0.8125 .. 1.3125");
+          END IF;
+
+
+
+          IF (A_SMALL + B_MAX) NOT IN 5.0625 .. 5.5625 THEN
+               FAILED ("(A_SMALL + B_MAX) NOT IN 5.0625 .. 5.5625");
+          END IF;
+
+          IF (A_SMALL - B_MAX) NOT IN -5.0625 .. -4.5625 THEN
+               FAILED ("(A_SMALL - B_MAX) NOT IN -5.0625 .. -4.5625");
+          END IF;
+
+          IF A_MAX + B_MIN /= 2.1875 THEN
+               FAILED ("3.0 + (-0.8125) /= 2.1875");
+          END IF;
+
+          IF A_MAX - B_MIN /= 3.8125 THEN
+               FAILED ("3.0 - (-0.8125) /= 3.8125");
+          END IF;
+
+          IF (A_MAX + B_SMALL) NOT IN 3.0 .. 3.0625 THEN
+               FAILED ("(A_MAX + B_SMALL) NOT IN 3.0 .. 3.0625");
+          END IF;
+
+          IF (A_MAX - B_SMALL) NOT IN 2.9375..3.0 THEN
+               FAILED ("(A_MAX - B_SMALL) NOT IN 2.9375..3.0");
+          END IF;
+
+          IF A_MAX + B_MAX /= 8.0625 THEN
+               FAILED ("3.0 + 5.0625 /= 8.0625");
+          END IF;
+
+          IF A_MAX - B_MAX /= -2.0625 THEN
+               FAILED ("3.0 - 5.0625 /= -2.0625");
+          END IF;
+
+          X := B_MIN - A_MIN;
+          IF X NOT IN 3.0 .. 3.25 THEN
+               FAILED ("-0.8125 - (-4.0) NOT IN RANGE");
+          END IF;
+
+          X := B_MIN - A_SMALL;
+          IF X NOT IN -1.3125 .. -0.8125 THEN
+               FAILED ("B_MIN - A_SMALL NOT IN RANGE");
+          END IF;
+
+          X := B_MIN - A_MAX;
+          IF X NOT IN -4.0 .. -3.75 THEN
+               FAILED ("-0.8125 - 3.0 NOT IN RANGE");
+          END IF;
+
+          X := B_SMALL - A_MIN;
+          IF X NOT IN 4.0 .. 4.0625 THEN
+               FAILED ("B_SMALL - A_MIN NOT IN RANGE");
+          END IF;
+
+
+          X := B_SMALL - A_MAX;
+          IF X NOT IN -3.0 .. -2.75 THEN
+               FAILED ("B_SMALL - A_MAX NOT IN RANGE");
+          END IF;
+
+          X := B_MAX - A_MIN;
+          IF X NOT IN 9.0 .. 9.25 THEN
+               FAILED ("5.0625 - (-4.0) NOT IN RANGE");
+          END IF;
+
+          X := B_MAX - A_SMALL;
+         IF X NOT IN 4.56 .. 5.0625 THEN
+               FAILED ("5.0625 - 0.5 NOT IN RANGE");
+          END IF;
+
+          X := B_MAX - A_MAX;
+          IF X NOT IN 2.0 .. 2.25 THEN
+               FAILED ("5.0625 - 3.0 NOT IN RANGE");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - C");
+     END C;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+END C45331A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45342a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45342a.ada
new file mode 100644
index 000000000..73a05290a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45342a.ada
@@ -0,0 +1,99 @@
+-- C45342A.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 CATENATION OF TWO OR MORE NON-NULL OPERANDS YIELDS THE
+-- CORRECT RESULT, WITH THE CORRECT BOUNDS, WHETHER BOUNDS ARE STATIC OR
+-- DYNAMIC.
+
+-- BHS 6/27/84
+
+WITH REPORT;
+PROCEDURE C45342A IS
+
+     USE REPORT;
+
+     SUBTYPE S IS INTEGER RANGE 1..100;
+     TYPE ARR IS ARRAY (S RANGE <>) OF INTEGER;
+     
+     A,B : ARR (2..9);
+
+     FUNCTION F (AR_VAR1, AR_VAR2, AR_VAR3 : ARR) RETURN ARR IS
+     BEGIN
+          RETURN AR_VAR1 & AR_VAR2 & AR_VAR3;
+     END F;
+
+     PROCEDURE CAT (A : ARR; I1,I2 : INTEGER; NUM : CHARACTER) IS
+     BEGIN
+          IF A'FIRST /= I1 OR A'LAST /= I2 THEN
+               FAILED ("INCORRECT CATENATION BOUNDS - " & NUM);
+          END IF;
+     END CAT;
+
+
+BEGIN
+
+     TEST ("C45342A", "CHECK THAT CATENATION OF NON-NULL OPERANDS " &
+                      "YIELDS CORRECT RESULT WITH CORRECT BOUNDS"); 
+
+     BEGIN
+          A := (1,2,3,4,5,6,7,8);
+          B := A(2..4) & A(2..5) & A(2..2);
+          IF B /= (1,2,3,1,2,3,4,1) THEN
+               FAILED ("INCORRECT CATENATION RESULT - 1");
+          END IF;
+
+          A := (8,7,6,5,4,3,2,1);
+          IF F(A(2..3), A(2..4), A(2..4)) /= (8,7,8,7,6,8,7,6) THEN 
+               FAILED ("INCORRECT CATENATION RESULT - 2");
+          END IF;
+
+          CAT ( A(3..5) & A(2..3), 3, 7, '3' );
+     END;
+
+
+     DECLARE
+          DYN2 : INTEGER := IDENT_INT(2);
+          DYN3 : INTEGER := IDENT_INT(3);
+          DYN4 : INTEGER := IDENT_INT(4);
+          DYN6 : INTEGER := IDENT_INT(6);
+          
+     BEGIN
+          A := (1,2,3,4,5,6,7,8);
+          B := A(DYN2..DYN3) & A(DYN2..DYN4) & A(DYN2..DYN4);
+          IF B /= (1,2,1,2,3,1,2,3) THEN
+               FAILED ("INCORRECT CATENATION RESULT - 4");
+          END IF;
+
+          A := (8,7,6,5,4,3,2,1);
+          IF F ( A(DYN2..DYN6), A(DYN2..DYN3), A(DYN2..DYN2) )
+                /= (8,7,6,5,4,8,7,8) THEN
+               FAILED ("INCORRECT CATENATION RESULT - 5");
+          END IF;
+
+          CAT ( A(DYN3..5) & A(2..3), 3, 7, '6');
+     END;  
+
+     RESULT;
+
+END C45342A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45343a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45343a.ada
new file mode 100644
index 000000000..a99db7f28
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45343a.ada
@@ -0,0 +1,75 @@
+-- C45343A.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 CATENATION OF NULL OPERANDS YIELDS THE CORRECT RESULT,
+-- WITH THE CORRECT BOUNDS.
+
+-- BHS 6/29/84
+
+WITH REPORT;
+PROCEDURE C45343A IS
+
+     USE REPORT;
+
+     TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+     SUBTYPE ARR_8 IS ARR (1..8);
+     A1, A2 : ARR_8;
+
+     PROCEDURE CAT (A : ARR; I1,I2 : INTEGER; NUM : CHARACTER) IS
+     BEGIN
+          IF A'FIRST /= I1 OR A'LAST /= I2 THEN
+               FAILED ("INCORRECT CATENATION - " & NUM);
+          END IF;
+     END CAT;
+
+BEGIN
+
+     TEST ("C45343A", "CATENATION OF NULL OPERANDS"); 
+
+
+     A1 := (1,2,3,4,5,6,7,8);
+     A2 := A1(1..0) & A1(6..5) & A1(1..8);
+     IF A2 /= (1,2,3,4,5,6,7,8) THEN
+          FAILED ("INCORRECT CATENATION RESULT - 1");
+     END IF;
+
+     A1 := (1,2,3,4,5,6,7,8);
+     A2 := A1(2..8) & A1(1..0) & 9;
+     IF A2 /= (2,3,4,5,6,7,8,9) THEN
+          FAILED ("INCORRECT CATENATION RESULT - 2");
+     END IF;
+
+
+     CAT ( A1(1..0) & A1(IDENT_INT(2)..0), 2, 0, '3' );
+     CAT ( A1(IDENT_INT(1)..0) & A2(2..0), 2, 0, '4' );
+
+     CAT ( A1(1..0) & A1(6..5) & A1(2..8), 2, 8, '5' );
+     CAT ( A1(2..8) & A1(1..0), 2, 8, '6' );
+
+     CAT ( A2(1..0) & A2(6..5) & A2(IDENT_INT(2)..8), 2, 8, '7' );
+     CAT ( A2(IDENT_INT(2)..8) & A2(1..0), 2, 8, '8' );
+
+     RESULT;
+
+END C45343A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45344a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45344a.ada
new file mode 100644
index 000000000..b75f2a7ef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45344a.ada
@@ -0,0 +1,116 @@
+-- C45344A.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 CORRECT RESULT IS PRODUCED WHEN A FUNCTION RETURNS 
+-- THE RESULT OF A CATENATION WHOSE BOUNDS ARE NOT DEFINED STATICALLY.
+
+-- R.WILLIAMS 9/1/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45344A IS
+
+BEGIN
+     TEST ( "C45344A", "CHECK THAT THE CORRECT RESULT IS PRODUCED " &
+                       "WHEN A FUNCTION RETURNS THE RESULT OF A " &
+                       "CATENATION WHOSE BOUNDS ARE NOT DEFINED " &
+                       "STATICALLY" );
+
+     DECLARE
+          SUBTYPE INT IS INTEGER RANGE IDENT_INT (1) .. IDENT_INT (30);
+
+          TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
+          SUBTYPE CARR IS ARR (1 .. 9);
+          C : CARR;
+          
+          AR1 : ARR (IDENT_INT (2) .. IDENT_INT (4)) :=
+                    (IDENT_INT (2) .. IDENT_INT (4) => 1);
+
+          AR2 : ARR (IDENT_INT (6) .. IDENT_INT (6)) :=
+                    (IDENT_INT (6) .. IDENT_INT (6) => 2);
+
+          AR3 : ARR (IDENT_INT (4) .. IDENT_INT (2));
+     
+          FUNCTION F (A, B : ARR; N : NATURAL) RETURN ARR IS
+          BEGIN
+               IF N = 0 THEN
+                    RETURN A & B;
+               ELSE
+                    RETURN F (A & B, B, N - 1);
+               END IF;
+          END F;
+     
+          FUNCTION G (A : INTEGER; B : ARR; N : NATURAL) RETURN ARR IS
+          BEGIN
+               IF N = 0 THEN
+                    RETURN A & B;
+               ELSE
+                    RETURN G (A, A & B, N - 1);
+               END IF;
+          END G;
+
+          FUNCTION H (A : ARR; B : INTEGER; N : NATURAL) RETURN ARR IS
+          BEGIN
+               IF N = 0 THEN
+                    RETURN A & B;
+               ELSE
+                    RETURN H (A & B, B, N - 1);
+               END IF;
+          END H;
+     
+          PROCEDURE CHECK (X, Y : ARR; F, L : INTEGER; STR : STRING) IS
+               OK : BOOLEAN := TRUE;
+          BEGIN
+               IF X'FIRST /= F AND X'LAST /= L THEN
+                    FAILED ( "INCORRECT RANGE FOR " & STR);
+               ELSE
+                    FOR I IN F .. L LOOP
+                         IF X (I) /= Y (I) THEN
+                              OK := FALSE;
+                         END IF;
+                    END LOOP;
+     
+                    IF NOT OK THEN
+                         FAILED ( "INCORRECT VALUE FOR " & STR);
+                    END IF;
+               END IF;
+          END CHECK;
+
+     BEGIN
+          C := (1 .. 4 => 1, 5 .. 9 => 2);
+          CHECK (F (AR1, AR2, IDENT_INT (3)), C, 2, 8, "F - 1" );
+          CHECK (F (AR3, AR2, IDENT_INT (3)), C, 6, 9, "F - 2" );
+          CHECK (F (AR2, AR3, IDENT_INT (3)), C, 6, 6, "F - 3" );
+
+          C := (1 ..4 => 5, 5 .. 9 => 1);
+          CHECK (G (5, AR1, IDENT_INT (3)), C, 1, 7, "G - 1" );
+          CHECK (G (5, AR3, IDENT_INT (3)), C, 1, 4, "G - 2" );
+
+          CHECK (H (AR3, 5, IDENT_INT (3)), C, 1, 4, "H - 1" );
+
+          C := (1 ..4 => 1, 5 .. 9 => 5);
+          CHECK (H (AR1, 5, IDENT_INT (3)), C, 2, 8, "H - 2" );
+     END;
+
+     RESULT;
+END C45344A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45345b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45345b.ada
new file mode 100644
index 000000000..e4b31ec59
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45345b.ada
@@ -0,0 +1,118 @@
+-- C45345B.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 NOT RAISED IF THE RESULT OF
+--     CATENATION HAS PRECISELY THE MAXIMUM LENGTH PERMITTED BY THE
+--     INDEX SUBTYPE.
+
+
+-- RM  2/26/82
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C45345B IS
+
+
+BEGIN
+
+     TEST ( "C45345B" , "CHECK THAT  CONSTRAINT_ERROR  IS NOT RAISED" &
+                        " IF THE RESULT OF CATENATION HAS PRECISELY" &
+                        " THE MAXIMUM LENGTH PERMITTED BY THE" &
+                        " INDEX SUBTYPE" );
+
+
+     -------------------------------------------------------------------
+     -----------------  STRG_VAR := STRG_LIT & STRG_LIT  ---------------
+
+     DECLARE
+
+          X : STRING(1..5) ;
+
+     BEGIN
+
+          X := "ABCD" & "E" ;
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+               FAILED( "'STRING & STRING' RAISED  CONSTRAINT_ERROR " );
+
+          WHEN  OTHERS =>
+               FAILED( "'STRING & STRING' RAISED ANOTHER EXCEPTION" );
+
+     END;
+
+
+     -------------------------------------------------------------------
+     -----------------  STRG_VAR := STRG_LIT & CHARACTER  --------------
+
+     DECLARE
+
+          X : STRING(1..5) ;
+
+     BEGIN
+
+          X := "ABCD" & 'E' ;
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+               FAILED( "'STRING & STRING' RAISED  CONSTRAINT_ERROR " );
+
+          WHEN  OTHERS =>
+               FAILED( "'STRING & STRING' RAISED ANOTHER EXCEPTION" );
+
+     END;
+
+     -------------------------------------------------------------------
+     -----------------  STRG_VAR := STRG_VAR & STRG_VAR  ---------------
+
+     DECLARE
+
+          X :          STRING(1..5) ;
+          A : CONSTANT STRING       := "A" ;
+          B :          STRING(1..4) := IDENT_STR("BCDE") ;
+
+     BEGIN
+
+          X :=  A & B ;
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+               FAILED( "'STRING & STRING' RAISED  CONSTRAINT_ERROR " );
+
+          WHEN  OTHERS =>
+               FAILED( "'STRING & STRING' RAISED ANOTHER EXCEPTION" );
+
+     END;
+
+     -------------------------------------------------------------------
+
+
+     RESULT;
+
+
+END C45345B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347a.ada
new file mode 100644
index 000000000..a93ae875e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347a.ada
@@ -0,0 +1,96 @@
+-- C45347A.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 CATENATION IS DEFINED FOR RECORD TYPES AS COMPONENT TYPES.
+
+-- JWC 11/15/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45347A IS
+
+BEGIN
+
+     TEST ("C45347A", "CHECK THAT CATENATION IS DEFINED " &
+                      "FOR RECORD TYPES AS COMPONENT TYPES");
+
+     DECLARE
+
+          TYPE REC IS
+               RECORD
+                    X : INTEGER;
+               END RECORD;
+
+          SUBTYPE INT IS INTEGER RANGE 1 .. 4;
+          TYPE A IS ARRAY ( INT RANGE <>) OF REC;
+
+          R1 : REC := (X => 4);
+          R2 : REC := (X => 1);
+
+          A1 : A(1 .. 2) := ((X => 1), (X => 2));
+          A2 : A(1 .. 2) := ((X => 3), (X => 4));
+          A3 : A(1 .. 4) := ((X => 1), (X => 2), (X => 3), (X => 4));
+          A4 : A(1 .. 4);
+          A5 : A(1 .. 4) := ((X => 4), (X => 3), (X => 2), (X => 1));
+
+     BEGIN
+
+          A4 := A1 & A2;
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR TWO ARRAYS OF " &
+                       "RECORDS");
+          END IF;
+
+          A4 := A5;
+
+          A4 := A1 & A2(1) & R1;
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR ARRAY OF RECORD, " &
+                       "AND RECORDS");
+          END IF;
+
+          A4 := A5;
+
+          A4 := R2 & (A1(2) & A2);
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR RECORDS, " &
+                       "AND ARRAY OF RECORDS");
+          END IF;
+
+          A4 := A5;
+
+          A4 := R2 & A1(2) & (A2(1) & R1);
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR RECORDS");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45347A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347b.ada
new file mode 100644
index 000000000..220100b39
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347b.ada
@@ -0,0 +1,90 @@
+-- C45347B.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 CATENATION IS DEFINED FOR ARRAY TYPES AS COMPONENT TYPES.
+
+-- JWC 11/15/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45347B IS
+
+BEGIN
+
+     TEST ("C45347B", "CHECK THAT CATENATION IS DEFINED " &
+                      "FOR ARRAY TYPES AS COMPONENT TYPES");
+
+     DECLARE
+
+          TYPE ARR IS ARRAY (1 .. 2) OF INTEGER;
+          TYPE A IS ARRAY ( INTEGER RANGE <>) OF ARR;
+
+          AR1 : ARR := (4,1);
+          AR2 : ARR := (1,1);
+
+          A1 : A(1 .. 2) := ((1,1), (2,1));
+          A2 : A(1 .. 2) := ((3,1), (4,1));
+          A3 : A(1 .. 4) := ((1,1), (2,1), (3,1), (4,1));
+          A4 : A(1 .. 4);
+          A5 : A(1 .. 4) := ((4,1), (3,1), (2,1), (1,1));
+
+     BEGIN
+
+          A4 := A1 & A2;
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR ARRAYS OF ARRAYS");
+          END IF;
+
+          A4 := A5;
+
+          A4 := A1 & A2(1) & AR1;
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR ARRAY OF ARRAYS " &
+                       "WITH ARRAYS");
+          END IF;
+
+          A4 := A5;
+
+          A4 := AR2 & (A1(2) & A2);
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR ARRAYS WITH ARRAYS " &
+                       "OF ARRAYS");
+          END IF;
+
+          A4 := A5;
+
+          A4 := A'(AR2 & A1(2)) & A'(A2(1) & AR1);
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR ARRAYS");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45347B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347c.ada
new file mode 100644
index 000000000..0ad23a7a6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347c.ada
@@ -0,0 +1,108 @@
+-- C45347C.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 CATENATION IS DEFINED FOR PRIVATE TYPES AS COMPONENT
+-- TYPES.
+
+-- JWC 11/15/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45347C IS
+
+BEGIN
+
+     TEST ("C45347C", "CHECK THAT CATENATION IS DEFINED " &
+                      "FOR PRIVATE TYPES AS COMPONENT TYPES");
+
+     DECLARE
+
+          PACKAGE PKG IS
+               TYPE PRIV IS PRIVATE;
+               ONE : CONSTANT PRIV;
+               TWO : CONSTANT PRIV;
+               THREE : CONSTANT PRIV;
+               FOUR : CONSTANT PRIV;
+          PRIVATE
+               TYPE PRIV IS NEW INTEGER;
+               ONE : CONSTANT PRIV := 1;
+               TWO : CONSTANT PRIV := 2;
+               THREE : CONSTANT PRIV := 3;
+               FOUR : CONSTANT PRIV := 4;
+          END PKG;
+
+          USE PKG;
+
+          SUBTYPE INT IS INTEGER RANGE 1 .. 4;
+          TYPE A IS ARRAY ( INT RANGE <>) OF PRIV;
+
+          P1 : PRIV := FOUR;
+          P2 : PRIV := ONE;
+
+          A1 : A(1 .. 2) := (ONE, TWO);
+          A2 : A(1 .. 2) := (THREE, FOUR);
+          A3 : A(1 .. 4) := (ONE, TWO, THREE, FOUR);
+          A4 : A(1 .. 4);
+          A5 : A(1 .. 4) := (FOUR, THREE, TWO, ONE);
+
+     BEGIN
+
+          A4 := A1 & A2;
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR TWO ARRAYS OF " &
+                       "PRIVATE");
+          END IF;
+
+          A4 := A5;
+
+          A4 := A1 & A2(1) & P1;
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR ARRAY OF PRIVATE, " &
+                       "AND PRIVATE");
+          END IF;
+
+          A4 := A5;
+
+          A4 := P2 & (A1(2) & A2);
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR PRIVATE, AND ARRAY " &
+                       "OF PRIVATE");
+          END IF;
+
+          A4 := A5;
+
+          A4 := P2 & A1(2) & (A2(1) & P1);
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR PRIVATE");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45347C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347d.ada
new file mode 100644
index 000000000..0791be10f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45347d.ada
@@ -0,0 +1,93 @@
+-- C45347D.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 CATENATION IS DEFINED FOR ACCESS TYPES AS COMPONENT TYPES.
+
+-- JWC 11/15/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45347D IS
+
+BEGIN
+
+     TEST ("C45347D", "CHECK THAT CATENATION IS DEFINED " &
+                      "FOR ACCESS TYPES AS COMPONENT TYPES");
+
+     DECLARE
+
+          SUBTYPE INT IS INTEGER RANGE 1 .. 4;
+          TYPE ACC IS ACCESS INT;
+          TYPE A IS ARRAY ( INT RANGE <>) OF ACC;
+
+          AC1 : ACC := NEW INT'(1);
+          AC2 : ACC := NEW INT'(2);
+          AC3 : ACC := NEW INT'(3);
+          AC4 : ACC := NEW INT'(4);
+
+          A1 : A(1 .. 2) := (AC1, AC2);
+          A2 : A(1 .. 2) := (AC3, AC4);
+          A3 : A(1 .. 4) := (AC1, AC2, AC3, AC4);
+          A4 : A(1 .. 4);
+          A5 : A(1 .. 4) := (AC4, AC3, AC2, AC1);
+
+     BEGIN
+
+          A4 := A1 & A2;
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR TWO ARRAYS OF ACCESS");
+          END IF;
+
+          A4 := A5;
+
+          A4 := A1 & A2(1) & AC4;
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR ARRAY OF ACCESS, " &
+                       "AND ACCESS");
+          END IF;
+
+          A4 := A5;
+
+          A4 := AC1 & (A1(2) & A2);
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR ACCESS, AND ARRAY " &
+                       "OF ACCESS");
+          END IF;
+
+          A4 := A5;
+
+          A4 := AC1 & A1(2) & (A2(1) & AC4);
+
+          IF A3 /= A4 THEN
+               FAILED ("INCORRECT CATENATION FOR ACCESS");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45347D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411a.ada
new file mode 100644
index 000000000..0ac3b10a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411a.ada
@@ -0,0 +1,120 @@
+-- C45411A.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 UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
+--     PREDEFINED INTEGER OPERANDS.
+
+-- HISTORY:
+--     JET 01/25/88  CREATED ORIGINAL TEST.
+--     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45411A IS
+
+     TYPE DT IS NEW INTEGER RANGE -3..3;
+     I1 : INTEGER := 1;
+     D1 : DT := 1;
+
+BEGIN
+     TEST ("C45411A", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
+                      "CORRECT RESULTS FOR PREDEFINED INTEGER " &
+                      "OPERANDS");
+
+     FOR I IN (1-2)..INTEGER(1) LOOP
+          IF "-"(RIGHT => I1) /= IDENT_INT(I) THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                       INTEGER'IMAGE(I+2));
+          END IF;
+
+          IF +I1 /= IDENT_INT(I1) THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                       INTEGER'IMAGE(I+2));
+          END IF;
+          I1 := I1 - 1;
+     END LOOP;
+
+     FOR I IN (1-2)..INTEGER(1) LOOP
+          IF -I /= IDENT_INT(0)-I THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                       INTEGER'IMAGE(I+5));
+          END IF;
+
+          IF "+"(RIGHT => IDENT_INT(I)) /= I THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                       INTEGER'IMAGE(I+5));
+          END IF;
+     END LOOP;
+
+     IF -1 /= IDENT_INT(1)-2 THEN
+          FAILED ("INCORRECT RESULT FOR ""-"" - 7");
+     END IF;
+
+     IF "-"(RIGHT => 0) /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT RESULT FOR ""-"" - 8");
+     END IF;
+
+     IF "-"(RIGHT => "-"(RIGHT => 1)) /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT RESULT FOR ""-"" - 9");
+     END IF;
+
+     IF "+"(RIGHT => 1) /= IDENT_INT(2)-1 THEN
+          FAILED ("INCORRECT RESULT FOR ""+"" - 7");
+     END IF;
+
+     IF +0 /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT RESULT FOR ""+"" - 8");
+     END IF;
+
+     IF +(-1) /= IDENT_INT(1)-2 THEN
+          FAILED ("INCORRECT RESULT FOR ""+"" - 9");
+     END IF;
+
+     FOR I IN (1-2)..INTEGER(1) LOOP
+          IF "-"(RIGHT => D1) /= DT(IDENT_INT(I)) THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                       INTEGER'IMAGE(I+11));
+          END IF;
+
+          IF +D1 /= DT(IDENT_INT(INTEGER(D1))) THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                       INTEGER'IMAGE(I+11));
+          END IF;
+          D1 := D1 - 1;
+     END LOOP;
+
+     IF INTEGER'LAST + INTEGER'FIRST = 0 THEN
+          IF IDENT_INT(-INTEGER'LAST) /= INTEGER'FIRST THEN
+               FAILED ("-INTEGER'LAST IS NOT EQUAL TO INTEGER'FIRST");
+          END IF;
+     ELSE
+          IF IDENT_INT(-INTEGER'LAST) /= INTEGER'FIRST+1 THEN
+               FAILED ("-INTEGER'LAST IS NOT EQUAL TO INTEGER'FIRST+1");
+          END IF;
+     END IF;
+
+     RESULT;
+
+END C45411A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411b.dep
new file mode 100644
index 000000000..faae4b1f7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411b.dep
@@ -0,0 +1,123 @@
+-- C45411B.DEP
+
+--                             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 UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
+--     PREDEFINED SHORT_INTEGER OPERANDS.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+--     THE PREDEFINED SHORT_INTEGER TYPE.
+
+--     IF THE TYPE SHORT_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION
+--     OF TYPE "DT" MUST BE REJECTED.
+
+-- HISTORY:
+--     JET 07/11/88  CREATED ORIGINAL TEST.
+--     KAS 01/12/95  DELETED INCOMPATIBLE SUBTEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45411B IS
+
+     TYPE DT IS NEW SHORT_INTEGER RANGE -3..3;          -- N/A => ERROR.
+     I1 : SHORT_INTEGER := 1;
+     D1 : DT := 1;
+
+     FUNCTION IDENT (A : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          RETURN A * SHORT_INTEGER(IDENT_INT(1));
+     END;
+
+BEGIN
+     TEST ("C45411B", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
+                      "CORRECT RESULTS FOR PREDEFINED SHORT_INTEGER " &
+                      "OPERANDS");
+
+     FOR I IN (1-2)..SHORT_INTEGER(1) LOOP
+          IF "-"(RIGHT => I1) /= IDENT(I) THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                       SHORT_INTEGER'IMAGE(I+2));
+          END IF;
+
+          IF +I1 /= IDENT(I1) THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                       SHORT_INTEGER'IMAGE(I+2));
+          END IF;
+          I1 := I1 - 1;
+     END LOOP;
+
+     FOR I IN (1-2)..SHORT_INTEGER(1) LOOP
+          IF -I /= IDENT(0)-I THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                       SHORT_INTEGER'IMAGE(I+5));
+          END IF;
+
+          IF "+"(RIGHT => IDENT(I)) /= I THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                       SHORT_INTEGER'IMAGE(I+5));
+          END IF;
+     END LOOP;
+
+     IF -1 /= IDENT(1)-2 THEN
+          FAILED ("INCORRECT RESULT FOR ""-"" - 7");
+     END IF;
+
+     IF "-"(RIGHT => 0) /= IDENT(0) THEN
+          FAILED ("INCORRECT RESULT FOR ""-"" - 8");
+     END IF;
+
+     IF "-"(RIGHT => "-"(RIGHT => 1)) /= IDENT(1) THEN
+          FAILED ("INCORRECT RESULT FOR ""-"" - 9");
+     END IF;
+
+     IF "+"(RIGHT => 1) /= IDENT(2)-1 THEN
+          FAILED ("INCORRECT RESULT FOR ""+"" - 7");
+     END IF;
+
+     IF +0 /= IDENT(0) THEN
+          FAILED ("INCORRECT RESULT FOR ""+"" - 8");
+     END IF;
+
+     IF +(-1) /= IDENT(1)-2 THEN
+          FAILED ("INCORRECT RESULT FOR ""+"" - 9");
+     END IF;
+
+     FOR I IN (1-2)..SHORT_INTEGER(1) LOOP
+          IF "-"(RIGHT => D1) /= DT(IDENT(I)) THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                       SHORT_INTEGER'IMAGE(I+11));
+          END IF;
+
+          IF +D1 /= DT(IDENT(SHORT_INTEGER(D1))) THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                       SHORT_INTEGER'IMAGE(I+11));
+          END IF;
+          D1 := D1 - 1;
+     END LOOP;
+
+
+     RESULT;
+
+END C45411B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411c.dep
new file mode 100644
index 000000000..eaa472362
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411c.dep
@@ -0,0 +1,123 @@
+-- C45411C.DEP
+
+--                             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 UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
+--     PREDEFINED LONG_INTEGER OPERANDS.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+--     THE PREDEFINED LONG_INTEGER TYPE.
+
+--     IF THE TYPE LONG_INTEGER IS NOT SUPPORTED, THEN THE DECLARATION
+--     OF TYPE "DT" MUST BE REJECTED.
+
+-- HISTORY:
+--     JET 07/11/88  CREATED ORIGINAL TEST.
+--     KAS 01/12/95  REMOVED INCOMPATIBLE SUBTEST
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45411C IS
+
+     TYPE DT IS NEW LONG_INTEGER RANGE -3..3;          -- N/A => ERROR.
+     I1 : LONG_INTEGER := 1;
+     D1 : DT := 1;
+
+     FUNCTION IDENT (A : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          RETURN A * LONG_INTEGER(IDENT_INT(1));
+     END;
+
+BEGIN
+     TEST ("C45411C", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
+                      "CORRECT RESULTS FOR PREDEFINED LONG_INTEGER " &
+                      "OPERANDS");
+
+     FOR I IN (1-2)..LONG_INTEGER(1) LOOP
+          IF "-"(RIGHT => I1) /= IDENT(I) THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                       LONG_INTEGER'IMAGE(I+2));
+          END IF;
+
+          IF +I1 /= IDENT(I1) THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                       LONG_INTEGER'IMAGE(I+2));
+          END IF;
+          I1 := I1 - 1;
+     END LOOP;
+
+     FOR I IN (1-2)..LONG_INTEGER(1) LOOP
+          IF -I /= IDENT(0)-I THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                       LONG_INTEGER'IMAGE(I+5));
+          END IF;
+
+          IF "+"(RIGHT => IDENT(I)) /= I THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                       LONG_INTEGER'IMAGE(I+5));
+          END IF;
+     END LOOP;
+
+     IF -1 /= IDENT(1)-2 THEN
+          FAILED ("INCORRECT RESULT FOR ""-"" - 7");
+     END IF;
+
+     IF "-"(RIGHT => 0) /= IDENT(0) THEN
+          FAILED ("INCORRECT RESULT FOR ""-"" - 8");
+     END IF;
+
+     IF "-"(RIGHT => "-"(RIGHT => 1)) /= IDENT(1) THEN
+          FAILED ("INCORRECT RESULT FOR ""-"" - 9");
+     END IF;
+
+     IF "+"(RIGHT => 1) /= IDENT(2)-1 THEN
+          FAILED ("INCORRECT RESULT FOR ""+"" - 7");
+     END IF;
+
+     IF +0 /= IDENT(0) THEN
+          FAILED ("INCORRECT RESULT FOR ""+"" - 8");
+     END IF;
+
+     IF +(-1) /= IDENT(1)-2 THEN
+          FAILED ("INCORRECT RESULT FOR ""+"" - 9");
+     END IF;
+
+     FOR I IN (1-2)..LONG_INTEGER(1) LOOP
+          IF "-"(RIGHT => D1) /= DT(IDENT(I)) THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" -" &
+                       LONG_INTEGER'IMAGE(I+11));
+          END IF;
+
+          IF +D1 /= DT(IDENT(LONG_INTEGER(D1))) THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" -" &
+                       LONG_INTEGER'IMAGE(I+11));
+          END IF;
+          D1 := D1 - 1;
+     END LOOP;
+
+
+     RESULT;
+
+END C45411C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411d.ada
new file mode 100644
index 000000000..23adcbdc6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45411d.ada
@@ -0,0 +1,98 @@
+-- C45411D.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 UNARY "+" AND "-" YIELD CORRECT RESULTS FOR
+--     OPERANDS OF DERIVED INTEGER TYPES.
+
+-- HISTORY:
+--     JET 07/11/88  CREATED ORIGINAL TEST.
+--     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45411D IS
+
+     TYPE INT IS RANGE -100..100;
+
+     TYPE DT1 IS NEW INTEGER;
+     TYPE DT2 IS NEW INT;
+
+     D1 : DT1 := 1;
+     D2 : DT2 := 1;
+
+     FUNCTION IDENT (A : DT1) RETURN DT1 IS
+     BEGIN
+          RETURN A * DT1(IDENT_INT(1));
+     END IDENT;
+
+     FUNCTION IDENT (A : DT2) RETURN DT2 IS
+     BEGIN
+          RETURN A * DT2(IDENT_INT(1));
+     END IDENT;
+
+BEGIN
+     TEST ("C45411D", "CHECK THAT UNARY ""+"" AND ""-"" YIELD " &
+                      "CORRECT RESULTS FOR OPERANDS OF DERIVED " &
+                      "INTEGER TYPES");
+
+     FOR I IN DT1'(1-2)..DT1'(1) LOOP
+          IF "-"(RIGHT => D1) /= IDENT(I) THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" DT1 -" &
+                       DT1'IMAGE(I+2));
+          END IF;
+
+          IF +D1 /= IDENT(D1) THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" DT1 -" &
+                       DT1'IMAGE(I+2));
+          END IF;
+          D1 := D1 - 1;
+     END LOOP;
+
+     IF DT1'LAST + DT1'FIRST = 0 THEN
+          IF IDENT(-DT1'LAST) /= DT1'FIRST THEN
+               FAILED ("-DT1'LAST IS NOT EQUAL TO DT1'FIRST");
+          END IF;
+     ELSE
+          IF IDENT(-DT1'LAST) /= DT1'FIRST+1 THEN
+               FAILED ("-DT1'LAST IS NOT EQUAL TO DT1'FIRST+1");
+          END IF;
+     END IF;
+
+     FOR I IN DT2'(1-2)..DT2'(1) LOOP
+          IF -D2 /= IDENT(I) THEN
+               FAILED ("INCORRECT RESULT FOR ""-"" DT2 -" &
+                       DT2'IMAGE(I+2));
+          END IF;
+
+          IF "+"(RIGHT => D2) /= IDENT(D2) THEN
+               FAILED ("INCORRECT RESULT FOR ""+"" DT2 -" &
+                       DT2'IMAGE(I+2));
+          END IF;
+          D2 := D2 - 1;
+     END LOOP;
+
+     RESULT;
+
+END C45411D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45413a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45413a.ada
new file mode 100644
index 000000000..46833238f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45413a.ada
@@ -0,0 +1,74 @@
+-- C45413A.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 UNARY MINUS YIELDS AND ACCEPTS RESULTS BELONGING TO
+-- THE BASE TYPE.
+
+-- JBG 2/24/84
+-- JRL 10/13/96 Removed static expressions which contained values outside
+--              the base range.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45413A IS
+
+     TYPE INT IS RANGE 1..10;
+
+     X : INT := INT(IDENT_INT(9));
+
+BEGIN
+
+     TEST ("C45413A", "CHECK SUBTYPE OF UNARY PLUS/MINUS");
+
+     BEGIN
+
+          IF -X /= INT'VAL(-9) THEN
+               FAILED ("INCORRECT RESULT - UNARY MINUS");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("UNARY MINUS DOES NOT YIELD RESULT " &
+                       "BELONGING TO THE BASE TYPE");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED - 1");
+     END;
+
+     BEGIN
+
+          IF -(INT'VAL(-9)) /= 9 THEN
+               FAILED ("WRONG RESULT - UNARY MINUS");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("UNARY MINUS ARGUMENT NOT IN BASE TYPE");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED - 2");
+     END;
+
+     RESULT;
+
+END C45413A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45431a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45431a.ada
new file mode 100644
index 000000000..d66e890fc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45431a.ada
@@ -0,0 +1,212 @@
+-- C45431A.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 FIXED POINT TYPES +A = A AND THAT, FOR MODEL NUMBERS,
+-- -(-A) = A.
+
+-- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
+
+-- WRG 8/28/86
+-- PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45431A IS
+
+BEGIN
+
+     TEST ("C45431A", "CHECK THAT FOR FIXED POINT TYPES +A = A AND " &
+                      "THAT, FOR MODEL NUMBERS, -(-A) = A " &
+                      "-- BASIC TYPES");
+
+     -------------------------------------------------------------------
+
+A:   DECLARE
+          TYPE LIKE_DURATION IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
+
+          NON_MODEL_CONST : CONSTANT      := 2.0 / 3;
+          NON_MODEL_VAR   : LIKE_DURATION := 0.0;
+
+          SMALL, MAX, MIN, ZERO : LIKE_DURATION := 0.5;
+          X                     : LIKE_DURATION := 0.0;
+     BEGIN
+          -- INITIALIZE "CONSTANTS":
+          IF EQUAL (3, 3) THEN
+               NON_MODEL_VAR := NON_MODEL_CONST;
+               SMALL         := LIKE_DURATION'SMALL;
+               MAX           := LIKE_DURATION'LAST;
+               MIN           := LIKE_DURATION'FIRST;
+               ZERO          := 0.0;
+          END IF;
+
+          -- CHECK + OR - ZERO = ZERO:
+          IF "+"(RIGHT => ZERO) /= 0.0 OR
+             +LIKE_DURATION'(0.0) /= ZERO THEN
+               FAILED ("+0.0 /= 0.0");
+          END IF;
+          IF "-"(RIGHT => ZERO) /= 0.0 OR
+             -LIKE_DURATION'(0.0) /= ZERO THEN
+               FAILED ("-0.0 /= 0.0");
+          END IF;
+          IF -(-ZERO) /= 0.0 THEN
+               FAILED ("-(-0.0) /= 0.0");
+          END IF;
+
+          -- CHECK + AND - MAX:
+          IF EQUAL (3, 3) THEN
+               X := MAX;
+          END IF;
+          IF +X /= MAX OR +LIKE_DURATION'LAST /= MAX THEN
+               FAILED ("+LIKE_DURATION'LAST /= LIKE_DURATION'LAST");
+          END IF;
+          IF -(-X) /= MAX OR -(-LIKE_DURATION'LAST) /= MAX THEN
+               FAILED ("-(-LIKE_DURATION'LAST) /= LIKE_DURATION'LAST");
+          END IF;
+
+          -- CHECK + AND - MIN:
+          IF EQUAL (3, 3) THEN
+               X := MIN;
+          END IF;
+          IF +X /= MIN OR +LIKE_DURATION'FIRST /= MIN THEN
+               FAILED ("+LIKE_DURATION'FIRST /= LIKE_DURATION'FIRST");
+          END IF;
+          IF -(-X) /= MIN OR -(-LIKE_DURATION'FIRST) /= MIN THEN
+               FAILED("-(-LIKE_DURATION'FIRST) /= LIKE_DURATION'FIRST");
+          END IF;
+
+          -- CHECK + AND - SMALL:
+          IF EQUAL (3, 3) THEN
+               X := SMALL;
+          END IF;
+          IF +X /= SMALL OR +LIKE_DURATION'SMALL /= SMALL THEN
+               FAILED ("+LIKE_DURATION'SMALL /= LIKE_DURATION'SMALL");
+          END IF;
+          IF -(-X) /= SMALL OR -(-LIKE_DURATION'SMALL) /= SMALL THEN
+               FAILED("-(-LIKE_DURATION'SMALL) /= LIKE_DURATION'SMALL");
+          END IF;
+
+          -- CHECK ARBITRARY MID-RANGE NUMBERS:
+          IF EQUAL (3, 3) THEN
+               X := 1000.984_375;
+          END IF;
+          IF +X /= 1000.984_375 OR +1000.984_375 /= X THEN
+               FAILED ("+1000.984_375 /= 1000.984_375");
+          END IF;
+          IF -(-X) /= 1000.984_375 OR -(-1000.984_375) /= X THEN
+               FAILED ("-(-1000.984_375) /= 1000.984_375");
+          END IF;
+
+          -- CHECK "+" AND "-" FOR NON-MODEL NUMBER:
+          IF +LIKE_DURATION'(NON_MODEL_CONST) NOT IN 0.656_25 ..
+                                                     0.671_875 OR
+             +NON_MODEL_VAR NOT IN 0.656_25 .. 0.671_875 THEN
+               FAILED ("+LIKE_DURATION'(2.0 / 3) NOT IN 0.656_25 .. " &
+                       "0.671_875");
+          END IF;
+          IF -LIKE_DURATION'(NON_MODEL_CONST) NOT IN -0.671_875 ..
+                                                     -0.656_25 OR
+             -NON_MODEL_VAR NOT IN -0.671_875 .. -0.656_25 THEN
+               FAILED ("-LIKE_DURATION'(2.0 / 3) NOT IN -0.671_875 " &
+                       ".. -0.656_25");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED -- A");
+     END A;
+
+     -------------------------------------------------------------------
+
+B:   DECLARE
+          TYPE DECIMAL_M4 IS DELTA 100.0 RANGE -1000.0 .. 1000.0;
+
+          NON_MODEL_CONST : CONSTANT   := 2.0 / 3;
+          NON_MODEL_VAR   : DECIMAL_M4 := 0.0;
+
+          SMALL, MAX, MIN, ZERO : DECIMAL_M4 := -128.0;
+          X                     : DECIMAL_M4 :=    0.0;
+     BEGIN
+          -- INITIALIZE "CONSTANTS":
+          IF EQUAL (3, 3) THEN
+               NON_MODEL_VAR :=  NON_MODEL_CONST;
+               SMALL         :=  DECIMAL_M4'SMALL;
+               ZERO          :=  0.0;
+          END IF;
+
+          -- CHECK + OR - ZERO = ZERO:
+          IF +ZERO /= 0.0 OR +DECIMAL_M4'(0.0) /= ZERO THEN
+               FAILED ("+0.0 /= 0.0");
+          END IF;
+          IF -ZERO /= 0.0 OR -DECIMAL_M4'(0.0) /= ZERO THEN
+               FAILED ("-0.0 /= 0.0");
+          END IF;
+          IF -(-ZERO) /= 0.0 THEN
+               FAILED ("-(-0.0) /= 0.0");
+          END IF;
+
+          -- CHECK + AND - MAX:
+          IF EQUAL (3, 3) THEN
+               X := MAX;
+          END IF;
+          -- CHECK + AND - SMALL:
+          IF EQUAL (3, 3) THEN
+               X := SMALL;
+          END IF;
+          IF +X /= SMALL OR +DECIMAL_M4'SMALL /= SMALL THEN
+               FAILED ("+DECIMAL_M4'SMALL /= DECIMAL_M4'SMALL");
+          END IF;
+          IF -(-X) /= SMALL OR -(-DECIMAL_M4'SMALL) /= SMALL THEN
+               FAILED ("-(-DECIMAL_M4'SMALL) /= DECIMAL_M4'SMALL");
+          END IF;
+
+          -- CHECK ARBITRARY MID-RANGE NUMBERS:
+          IF EQUAL (3, 3) THEN
+               X := 256.0;
+          END IF;
+          IF +X /= 256.0 OR +256.0 /= X THEN
+               FAILED ("+256.0 /= 256.0");
+          END IF;
+          IF -(-X) /= 256.0 OR -(-256.0) /= X THEN
+               FAILED ("-(-256.0) /= 256.0");
+          END IF;
+
+          -- CHECK "+" AND "-" FOR NON-MODEL NUMBER:
+          IF +DECIMAL_M4'(NON_MODEL_CONST) NOT IN 0.0 .. 64.0 OR
+             +NON_MODEL_VAR NOT IN 0.0 .. 64.0 THEN
+               FAILED ("+DECIMAL_M4'(2.0 / 3) NOT IN 0.0 .. 64.0");
+          END IF;
+          IF -DECIMAL_M4'(NON_MODEL_CONST) NOT IN -64.0 .. 0.0 OR
+             -NON_MODEL_VAR NOT IN -64.0 .. 0.0 THEN
+               FAILED ("-DECIMAL_M4'(2.0 / 3) NOT IN -64.0 .. 0.0");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED -- B");
+     END B;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+END C45431A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c455001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c455001.a
new file mode 100644
index 000000000..8685e1b33
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c455001.a
@@ -0,0 +1,164 @@
+-- C455001.A
+
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--     Check that universal fixed multiplying operators can be used without
+--     a conversion in contexts where the result type is determined.
+--
+--     Note: This is intended to check the changes made to these operators
+--     in Ada 95; legacy tests should cover cases from Ada 83.
+--
+-- CHANGE HISTORY:
+--      18 MAR 99   RLB    Initial version
+--
+--!
+
+with Report; use Report;
+
+procedure C455001 is
+
+     type F1 is delta 2.0**(-1) range 0.0 .. 8.0;
+
+     type F2 is delta 2.0**(-2) range 0.0 .. 4.0;
+
+     type F3 is delta 2.0**(-3) range 0.0 .. 2.0;
+
+     A : F1;
+     B : F2;
+     C : F3;
+
+     type Fixed_Record is record
+	D : F1;
+        E : F2;
+     end record;
+
+     R : Fixed_Record;
+
+     function Ident_Fix (X : F3) return F3 is
+     begin
+          if Equal(3,3) then
+               return X;
+          else
+               return 0.0;
+          end if;
+     end Ident_Fix;
+
+begin
+     Test ("C455001", "Check that universal fixed multiplying operators " &
+                      "can be used without a conversion in contexts where " &
+                      "the result type is determined.");
+
+     A := 1.0; B := 1.0;
+     C := A * B; -- Assignment context.
+
+     if C /= Ident_Fix(1.0) then
+          Failed ("Incorrect results for multiplication (1) - result is " &
+		  F3'Image(C));
+     end if;
+
+     C := A / B;
+
+     if C /= Ident_Fix(1.0) then
+          Failed ("Incorrect results for division (1) - result is " &
+		  F3'Image(C));
+     end if;
+
+     A := 2.5;
+     C := A * 0.25;
+
+     if C /= Ident_Fix(0.625) then
+          Failed ("Incorrect results for multiplication (2) - result is " &
+		  F3'Image(C));
+     end if;
+
+     C := A / 4.0;
+
+     if C /= Ident_Fix(0.625) then
+          Failed ("Incorrect results for division (2) - result is " &
+		  F3'Image(C));
+     end if;
+
+     C := Ident_Fix(0.75);
+     C := C * 0.5;
+
+     if C /= Ident_Fix(0.375) then
+          Failed ("Incorrect results for multiplication (3) - result is " &
+		  F3'Image(C));
+     end if;
+
+     C := Ident_Fix(0.75);
+     C := C / 0.5;
+
+     if C /= Ident_Fix(1.5) then
+          Failed ("Incorrect results for division (3) - result is " &
+		  F3'Image(C));
+     end if;
+
+     A := 0.5; B := 0.3; -- Function parameter context.
+     if Ident_Fix(A * B) not in Ident_Fix(0.125) .. Ident_Fix(0.25) then
+          Failed ("Incorrect results for multiplication (4) - result is " &
+		  F3'Image(A * B)); -- Exact = 0.15
+     end if;
+
+     B := 0.8;
+     if Ident_Fix(A / B) not in Ident_Fix(0.5) .. Ident_Fix(0.75) then
+          Failed ("Incorrect results for division (4) - result is " &
+		  F3'Image(A / B));
+		-- Exact = 0.625..., but B is only restricted to the range
+		-- 0.75 .. 1.0, so the result can be anywhere in the range
+		-- 0.5 .. 0.75.
+     end if;
+
+     C := 0.875; B := 1.5;
+     R := (D => C * 4.0, E => B / 0.5); -- Aggregate context.
+
+     if R.D /= 3.5 then
+          Failed ("Incorrect results for multiplication (5) - result is " &
+		  F1'Image(R.D));
+     end if;
+
+     if R.E /= 3.0 then
+          Failed ("Incorrect results for division (5) - result is " &
+		  F2'Image(R.E));
+     end if;
+
+     A := 0.5;
+     C := A * F1'(B * 2.0); -- Qualified expression context.
+
+     if C /= Ident_Fix(1.5) then
+          Failed ("Incorrect results for multiplication (6) - result is " &
+		  F3'Image(C));
+     end if;
+
+     A := 4.0;
+     C := F1'(B / 0.5) / A;
+
+     if C /= Ident_Fix(0.75) then
+          Failed ("Incorrect results for division (6) - result is " &
+		  F3'Image(C));
+     end if;
+
+     Result;
+
+end C455001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45502b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45502b.dep
new file mode 100644
index 000000000..a8bd24ce1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45502b.dep
@@ -0,0 +1,291 @@
+-- C45502B.DEP
+
+--                             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 MULTIPLICATION AND DIVISION YIELD CORRECT RESULTS WHEN
+--     THE OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     SHORT_INTEGER.
+
+--     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_SHORT" MUST BE REJECTED.
+
+-- HISTORY:
+--     RJW 09/01/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45502B IS
+
+     CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+
+     FUNCTION IDENT (S : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          RETURN SHORT_INTEGER (IDENT_INT (INTEGER (S)));
+     END IDENT;
+
+BEGIN
+     TEST ( "C45502B", "CHECK THAT MULTIPLICATION AND DIVISION " &
+                       "YIELD CORRECT RESULTS WHEN THE OPERANDS " &
+                       "ARE OF PREDEFINED TYPE SHORT_INTEGER" );
+
+     DECLARE
+          I0  : SHORT_INTEGER := 0;
+          I1  : SHORT_INTEGER := 1;
+          I2  : SHORT_INTEGER := 2;
+          I3  : SHORT_INTEGER := 3;
+          I5  : SHORT_INTEGER := 5;
+          I10 : SHORT_INTEGER := 10;
+          I11 : SHORT_INTEGER := 11;
+          I12 : SHORT_INTEGER := 12;
+          I13 : SHORT_INTEGER := 13;
+          I14 : SHORT_INTEGER := 14;
+          N1  : SHORT_INTEGER := -1;
+          N2  : SHORT_INTEGER := -2;
+          N5  : SHORT_INTEGER := -5;
+          N10 : SHORT_INTEGER := -10;
+          N11 : SHORT_INTEGER := -11;
+          N12 : SHORT_INTEGER := -12;
+          N13 : SHORT_INTEGER := -13;
+          N14 : SHORT_INTEGER := -14;
+          N50 : SHORT_INTEGER := -50;
+
+     BEGIN
+          IF I0 * SHORT_INTEGER'FIRST /= 0 THEN
+               FAILED ( "INCORRECT RESULT FOR I0 * " &
+                        "SHORT_INTEGER'FIRST" );
+          END IF;
+
+          IF I0 * SHORT_INTEGER'LAST /= 0 THEN
+               FAILED ( "INCORRECT RESULT FOR I0 * " &
+                        "SHORT_INTEGER'LAST" );
+          END IF;
+
+          IF N1 * SHORT_INTEGER'LAST + SHORT_INTEGER'LAST /= 0 THEN
+               FAILED ( "INCORRECT RESULT FOR N1 * " &
+                        "SHORT_INTEGER'LAST" );
+          END IF;
+
+          IF I3 * I1 /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR I3 * I1" );
+          END IF;
+
+          IF IDENT (I3) * IDENT (I1) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I3) * " &
+                        "IDENT (I1)" );
+          END IF;
+
+          IF I2 * N1 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I2 * N1" );
+          END IF;
+
+          IF "*" (LEFT => I2, RIGHT => N1) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I2, " &
+                        "RIGHT => N1)" );
+          END IF;
+
+          IF IDENT (I2) * IDENT (N1) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I2) * " &
+                        "IDENT (N1)" );
+          END IF;
+
+          IF I5 * I2 * N5 /= N50 THEN
+               FAILED ( "INCORRECT RESULT FOR I5 * I2 * N5" );
+          END IF;
+
+          IF IDENT (N1) * IDENT (N5) /= I5 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF "*" (LEFT => IDENT (N1), RIGHT => IDENT (N5)) /=
+                 I5 THEN
+               FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => " &
+                        "IDENT (N1), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF IDENT (N1) * IDENT (I2) * IDENT (N5) /= I10
+             THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
+                        "IDENT (I2) * IDENT (N5)" );
+          END IF;
+
+          IF (-IDENT (I0)) * IDENT (I10) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) * " &
+                        "IDENT (I10)" );
+          END IF;
+
+          IF I0 * I10 /= (-I0) THEN
+               FAILED ( "INCORRECT RESULT FOR I0 * I10" );
+          END IF;
+
+          IF "*" (LEFT => I0, RIGHT => I10) /= (-I0) THEN
+               FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I0, " &
+                        "RIGHT => I10)" );
+          END IF;
+
+          IF IDENT (I10) / IDENT (I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I10) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF I11 / I5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR I11 / I5" );
+          END IF;
+
+          IF IDENT (I12) / IDENT (I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I12) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF "/" (LEFT => IDENT (I12), RIGHT => IDENT (I5)) /=
+                 I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                        "IDENT (I12), RIGHT => IDENT (I5))" );
+          END IF;
+
+          IF I13 / I5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR I13 / I5" );
+          END IF;
+
+          IF IDENT (I14) / IDENT (I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I14) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF I10 / N5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I10 / N5" );
+          END IF;
+
+          IF "/" (LEFT => I10, RIGHT => N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I10, " &
+                        "RIGHT => N5)" );
+          END IF;
+
+          IF IDENT (I11) / IDENT (N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I11) " &
+                        "/ IDENT (N5)" );
+          END IF;
+
+          IF I12 / N5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I12 / N5" );
+          END IF;
+
+          IF IDENT (I13) / IDENT (N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I13) " &
+                        "/ IDENT (N5)" );
+          END IF;
+
+          IF I14 / N5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I14 / N5" );
+          END IF;
+
+          IF IDENT (N10) / IDENT (I5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N10) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF "/" (LEFT => IDENT (N10), RIGHT => IDENT (I5)) /=
+                 N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                        "IDENT (N10), RIGHT => IDENT (I5))" );
+          END IF;
+
+          IF N11 / I5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR N11 / I5" );
+          END IF;
+
+          IF IDENT (N12) / IDENT (I5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N12) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF N13 / I5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR N13 / I5" );
+          END IF;
+
+          IF "/" (LEFT => N13, RIGHT => I5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N13, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT (N14) / IDENT (I5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N14) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF N10 / N5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR N10 / N5" );
+          END IF;
+
+          IF IDENT (N11) / IDENT (N5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N11) " &
+                        "/ IDENT (N5)" );
+          END IF;
+
+          IF "/" (LEFT => IDENT (N11), RIGHT => IDENT (N5)) /=
+                 I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                        "IDENT (N11), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF N12 / N5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR N12 / N5" );
+          END IF;
+
+
+          IF IDENT (N13) / IDENT (N5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N13) " &
+                        "/ IDENT (N5)" );
+          END IF;
+
+          IF N14 / N5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR N14 / N5" );
+          END IF;
+
+          IF "/" (LEFT => N14, RIGHT => N5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N14, " &
+                        "RIGHT => N5)" );
+          END IF;
+
+          IF I0 / I5 /= (-I0) THEN
+               FAILED ( "INCORRECT RESULT FOR I0 / I5" );
+          END IF;
+
+          IF "/" (LEFT => I0, RIGHT => I5) /= (-I0) THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I0, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF (-IDENT (I0)) / IDENT (I5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) / " &
+                        "IDENT (I5)" );
+          END IF;
+
+     END;
+
+     RESULT;
+END C45502B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45502c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45502c.dep
new file mode 100644
index 000000000..96d0212d8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45502c.dep
@@ -0,0 +1,295 @@
+-- C45502C.DEP
+
+--                             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 MULTIPLICATION AND DIVISION YIELD CORRECT RESULTS WHEN
+--     THE OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     LONG_INTEGER.
+
+--     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_LONG" MUST BE REJECTED.
+
+-- HISTORY:
+--     RJW 09/01/86
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45502C IS
+
+     CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+
+     FUNCTION IDENT (S : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN S;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT;
+
+BEGIN
+     TEST ( "C45502C", "CHECK THAT MULTIPLICATION AND DIVISION " &
+                       "YIELD CORRECT RESULTS WHEN THE OPERANDS " &
+                       "ARE OF PREDEFINED TYPE LONG_INTEGER" );
+
+     DECLARE
+          I0  : LONG_INTEGER := 0;
+          I1  : LONG_INTEGER := 1;
+          I2  : LONG_INTEGER := 2;
+          I3  : LONG_INTEGER := 3;
+          I5  : LONG_INTEGER := 5;
+          I10 : LONG_INTEGER := 10;
+          I11 : LONG_INTEGER := 11;
+          I12 : LONG_INTEGER := 12;
+          I13 : LONG_INTEGER := 13;
+          I14 : LONG_INTEGER := 14;
+          N1  : LONG_INTEGER := -1;
+          N2  : LONG_INTEGER := -2;
+          N5  : LONG_INTEGER := -5;
+          N10 : LONG_INTEGER := -10;
+          N11 : LONG_INTEGER := -11;
+          N12 : LONG_INTEGER := -12;
+          N13 : LONG_INTEGER := -13;
+          N14 : LONG_INTEGER := -14;
+          N50 : LONG_INTEGER := -50;
+
+     BEGIN
+          IF I0 * LONG_INTEGER'FIRST /= 0 THEN
+               FAILED ( "INCORRECT RESULT FOR I0 * " &
+                        "LONG_INTEGER'FIRST" );
+          END IF;
+
+          IF I0 * LONG_INTEGER'LAST /= 0 THEN
+               FAILED ( "INCORRECT RESULT FOR I0 * " &
+                        "LONG_INTEGER'LAST" );
+          END IF;
+
+          IF N1 * LONG_INTEGER'LAST + LONG_INTEGER'LAST /= 0 THEN
+               FAILED ( "INCORRECT RESULT FOR N1 * " &
+                        "LONG_INTEGER'LAST" );
+          END IF;
+
+          IF I3 * I1 /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR I3 * I1" );
+          END IF;
+
+          IF IDENT (I3) * IDENT (I1) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I3) * " &
+                        "IDENT (I1)" );
+          END IF;
+
+          IF I2 * N1 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I2 * N1" );
+          END IF;
+
+          IF "*" (LEFT => I2, RIGHT => N1) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I2, " &
+                        "RIGHT => N1)" );
+          END IF;
+
+          IF IDENT (I2) * IDENT (N1) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I2) * " &
+                        "IDENT (N1)" );
+          END IF;
+
+          IF I5 * I2 * N5 /= N50 THEN
+               FAILED ( "INCORRECT RESULT FOR I5 * I2 * N5" );
+          END IF;
+
+          IF IDENT (N1) * IDENT (N5) /= I5 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF "*" (LEFT => IDENT (N1), RIGHT => IDENT (N5)) /=
+                 I5 THEN
+               FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => " &
+                        "IDENT (N1), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF IDENT (N1) * IDENT (I2) * IDENT (N5) /= I10
+             THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N1) * " &
+                        "IDENT (I2) * IDENT (N5)" );
+          END IF;
+
+          IF (-IDENT (I0)) * IDENT (I10) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) * " &
+                        "IDENT (I10)" );
+          END IF;
+
+          IF I0 * I10 /= (-I0) THEN
+               FAILED ( "INCORRECT RESULT FOR I0 * I10" );
+          END IF;
+
+          IF "*" (LEFT => I0, RIGHT => I10) /= (-I0) THEN
+               FAILED ( "INCORRECT RESULT FOR ""*"" (LEFT => I0, " &
+                        "RIGHT => I10)" );
+          END IF;
+
+          IF IDENT (I10) / IDENT (I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I10) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF I11 / I5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR I11 / I5" );
+          END IF;
+
+          IF IDENT (I12) / IDENT (I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I12) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF "/" (LEFT => IDENT (I12), RIGHT => IDENT (I5)) /=
+                 I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                        "IDENT (I12), RIGHT => IDENT (I5))" );
+          END IF;
+
+          IF I13 / I5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR I13 / I5" );
+          END IF;
+
+          IF IDENT (I14) / IDENT (I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I14) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF I10 / N5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I10 / N5" );
+          END IF;
+
+          IF "/" (LEFT => I10, RIGHT => N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I10, " &
+                        "RIGHT => N5)" );
+          END IF;
+
+          IF IDENT (I11) / IDENT (N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I11) " &
+                        "/ IDENT (N5)" );
+          END IF;
+
+          IF I12 / N5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I12 / N5" );
+          END IF;
+
+          IF IDENT (I13) / IDENT (N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I13) " &
+                        "/ IDENT (N5)" );
+          END IF;
+
+          IF I14 / N5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I14 / N5" );
+          END IF;
+
+          IF IDENT (N10) / IDENT (I5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N10) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF "/" (LEFT => IDENT (N10), RIGHT => IDENT (I5)) /=
+                 N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                        "IDENT (N10), RIGHT => IDENT (I5))" );
+          END IF;
+
+          IF N11 / I5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR N11 / I5" );
+          END IF;
+
+          IF IDENT (N12) / IDENT (I5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N12) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF N13 / I5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR N13 / I5" );
+          END IF;
+
+          IF "/" (LEFT => N13, RIGHT => I5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N13, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT (N14) / IDENT (I5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N14) " &
+                        "/ IDENT (I5)" );
+          END IF;
+
+          IF N10 / N5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR N10 / N5" );
+          END IF;
+
+          IF IDENT (N11) / IDENT (N5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N11) " &
+                        "/ IDENT (N5)" );
+          END IF;
+
+          IF "/" (LEFT => IDENT (N11), RIGHT => IDENT (N5)) /=
+                 I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => " &
+                        "IDENT (N11), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF N12 / N5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR N12 / N5" );
+          END IF;
+
+
+          IF IDENT (N13) / IDENT (N5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N13) " &
+                        "/ IDENT (N5)" );
+          END IF;
+
+          IF N14 / N5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR N14 / N5" );
+          END IF;
+
+          IF "/" (LEFT => N14, RIGHT => N5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => N14, " &
+                        "RIGHT => N5)" );
+          END IF;
+
+          IF I0 / I5 /= (-I0) THEN
+               FAILED ( "INCORRECT RESULT FOR I0 / I5" );
+          END IF;
+
+          IF "/" (LEFT => I0, RIGHT => I5) /= (-I0) THEN
+               FAILED ( "INCORRECT RESULT FOR ""/"" (LEFT => I0, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF (-IDENT (I0)) / IDENT (I5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR (-IDENT (I0)) / " &
+                        "IDENT (I5)" );
+          END IF;
+
+     END;
+
+     RESULT;
+END C45502C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45503a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45503a.ada
new file mode 100644
index 000000000..0461b0151
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45503a.ada
@@ -0,0 +1,310 @@
+-- C45503A.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 'REM' AND 'MOD' YIELD CORRECT RESULTS WHEN THE OPERANDS 
+-- ARE OF PREDEFINED TYPE INTEGER.
+
+-- R.WILLIAMS 9/1/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45503A IS
+
+BEGIN
+     TEST ( "C45503A", "CHECK THAT 'REM' AND 'MOD' YIELD CORRECT " &
+                       "RESULTS WHEN THE OPERANDS ARE OF PREDEFINED " &
+                       "TYPE INTEGER" );
+
+     DECLARE
+          I0  : INTEGER := 0;
+          I1  : INTEGER := 1;
+          I2  : INTEGER := 2;
+          I3  : INTEGER := 3;
+          I4  : INTEGER := 4;
+          I5  : INTEGER := 5;    
+          I10 : INTEGER := 10;
+          I11 : INTEGER := 11;
+          I12 : INTEGER := 12;
+          I13 : INTEGER := 13;
+          I14 : INTEGER := 14;
+          N1  : INTEGER := -1;
+          N2  : INTEGER := -2;
+          N3  : INTEGER := -3;
+          N4  : INTEGER := -4;
+          N5  : INTEGER := -5;
+          N10 : INTEGER := -10;
+          N11 : INTEGER := -11;
+          N12 : INTEGER := -12;
+          N13 : INTEGER := -13;
+          N14 : INTEGER := -14;
+
+     BEGIN
+          IF I10 REM I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR I10 REM I5" );
+          END IF;
+
+          IF IDENT_INT (I11) REM IDENT_INT (I5) /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (I11) REM " &
+                        "IDENT_INT (I5)" );
+          END IF;
+ 
+          IF I12 REM I5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR I12 REM I5" );
+          END IF;
+
+          IF "REM" (LEFT => I12, RIGHT => I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I12, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT_INT (I13) REM IDENT_INT (I5) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (I13) REM " &
+                        "IDENT_INT (I5)" );
+          END IF;
+
+          IF I14 REM I5 /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR I14 REM I5" );
+          END IF;
+
+          IF IDENT_INT (I10) REM IDENT_INT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (I10) REM " &
+                        "IDENT_INT (N5)" );
+          END IF;
+
+          IF "REM" (LEFT => IDENT_INT (I10), RIGHT => IDENT_INT (N5)) 
+                   /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                        "IDENT_INT (I10), RIGHT => IDENT_INT (N5))" );
+          END IF;
+
+          IF I11 REM N5 /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR I11 REM N5" );
+          END IF;
+
+          IF IDENT_INT (I12) REM IDENT_INT (N5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (I12) REM " &
+                        "IDENT_INT (N5)" );
+          END IF;
+
+          IF I13 REM N5 /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR I13 REM N5" );
+          END IF;
+
+          IF "REM" (LEFT => I13, RIGHT => N5) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I13, " &
+                        "RIGHT => N5)" );
+          END IF;
+
+          IF IDENT_INT (I14) REM IDENT_INT (N5) /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (I14) REM " &
+                        "IDENT_INT (N5)" );
+          END IF;
+
+          IF N10 REM I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR N10 REM I5" );
+          END IF;
+
+          IF IDENT_INT (N11) REM IDENT_INT (I5) /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (N11) REM " &
+                        "IDENT_INT (I5)" );
+          END IF;
+
+          IF "REM" (LEFT => IDENT_INT (N11), RIGHT => IDENT_INT (I5)) 
+                   /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                        "IDENT_INT (N11), RIGHT => IDENT_INT (I5))" );
+          END IF;
+
+          IF N12 REM I5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR N12 REM I5" );
+          END IF;
+
+          IF IDENT_INT (N13) REM IDENT_INT (I5) /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (N13) REM " &
+                        "IDENT_INT (I5)" );
+          END IF;
+
+          IF N14 REM I5 /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR N14 REM I5" );
+          END IF;
+
+          IF "REM" (LEFT => N14, RIGHT => I5) /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => N14, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT_INT (N10) REM IDENT_INT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (N10) REM " &
+                        "IDENT_INT (N5)" );
+          END IF;
+
+          IF N11 REM N5 /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR N11 REM N5" );
+          END IF;
+
+          IF IDENT_INT (N12) REM IDENT_INT (N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (N12) REM " &
+                        "IDENT_INT (N5)" );
+          END IF;
+
+          IF "REM" (LEFT => IDENT_INT (N12), RIGHT => IDENT_INT (N5)) 
+                   /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                        "IDENT_INT (N12), RIGHT => IDENT_INT (N5))" );
+          END IF;
+
+          IF N13 REM N5 /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR N13 REM N5" );
+          END IF;
+
+          IF IDENT_INT (N14) REM IDENT_INT (N5) /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (N14) REM " &
+                        "IDENT_INT (N5)" );
+          END IF;
+          
+          IF I10 MOD I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR I10 MOD I5" );
+          END IF;
+
+          IF IDENT_INT (I11) MOD IDENT_INT (I5) /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (I11) MOD " &
+                        "IDENT_INT (I5)" );
+          END IF;
+ 
+          IF I12 MOD I5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR I12 MOD I5" );
+          END IF;
+
+          IF "MOD" (LEFT => I12, RIGHT => I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I12, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT_INT (I13) MOD IDENT_INT (I5) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (I13) MOD " &
+                        "IDENT_INT (I5)" );
+          END IF;
+
+          IF I14 MOD I5 /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR I14 MOD I5" );
+          END IF;
+
+          IF IDENT_INT (I10) MOD IDENT_INT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (I10) MOD " &
+                        "IDENT_INT (N5)" );
+          END IF;
+
+          IF "MOD" (LEFT => IDENT_INT (I10), RIGHT => IDENT_INT (N5)) 
+                   /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                        "IDENT_INT (I10), RIGHT => IDENT_INT (N5))" );
+          END IF;
+
+          IF I11 MOD N5 /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR I11 MOD N5" );
+          END IF;
+
+          IF IDENT_INT (I12) MOD IDENT_INT (N5) /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (I12) MOD " &
+                        "IDENT_INT (N5)" );
+          END IF;
+
+          IF I13 MOD N5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I13 MOD N5" );
+          END IF;
+
+          IF "MOD" (LEFT => I13, RIGHT => N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I13, " &
+                        "RIGHT => N5)" );
+          END IF;
+
+          IF IDENT_INT (I14) MOD IDENT_INT (N5) /=  N1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (I14) MOD " &
+                        "IDENT_INT (N5)" );
+          END IF;
+
+          IF N10 MOD I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR N10 MOD I5" );
+          END IF;
+
+          IF IDENT_INT (N11) MOD IDENT_INT (I5) /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (N11) MOD " &
+                        "IDENT_INT (I5)" );
+          END IF;
+
+          IF "MOD" (LEFT => IDENT_INT (N11), RIGHT => IDENT_INT (I5)) 
+                   /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                        "IDENT_INT (N11), RIGHT => IDENT_INT (I5))" );
+          END IF;
+
+          IF N12 MOD I5 /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR N12 MOD I5" );
+          END IF;
+
+          IF IDENT_INT (N13) MOD IDENT_INT (I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (N13) MOD " &
+                        "IDENT_INT (I5)" );
+          END IF;
+
+          IF N14 MOD I5 /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR N14 MOD I5" );
+          END IF;
+
+          IF "MOD" (LEFT => N14, RIGHT => I5) /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I14, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT_INT (N10) MOD IDENT_INT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (N10) MOD " &
+                        "IDENT_INT (N5)" );
+          END IF;
+
+          IF N11 MOD N5 /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR N11 MOD N5" );
+          END IF;
+
+          IF IDENT_INT (N12) MOD IDENT_INT (N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (N12) MOD " &
+                        "IDENT_INT (N5)" );
+          END IF;
+
+          IF "MOD" (LEFT => IDENT_INT (N12), RIGHT => IDENT_INT (N5)) 
+                   /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                        "IDENT_INT (N12), RIGHT => IDENT_INT (N5))" );
+          END IF;
+
+          IF N13 MOD N5 /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR N13 MOD N5" );
+          END IF;
+
+          IF IDENT_INT (N14) MOD IDENT_INT (N5) /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT_INT (N14) MOD " &
+                        "IDENT_INT (N5)" );
+          END IF;
+     END;
+          
+     RESULT;
+END C45503A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45503b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45503b.dep
new file mode 100644
index 000000000..570c52934
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45503b.dep
@@ -0,0 +1,327 @@
+-- C45503B.DEP
+
+--                             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 'REM' AND 'MOD' YIELD CORRECT RESULTS WHEN THE
+--     OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     SHORT_INTEGER.
+
+--     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_SHORT" MUST BE REJECTED.
+
+-- HISTORY:
+--     RJW 09/01/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45503B IS
+
+     CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+
+     FUNCTION IDENT (S : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          RETURN SHORT_INTEGER (IDENT_INT (INTEGER (S)));
+     END IDENT;
+
+BEGIN
+     TEST ( "C45503B", "CHECK THAT 'REM' AND 'MOD' YIELD CORRECT " &
+                       "RESULTS WHEN THE OPERANDS ARE OF PREDEFINED " &
+                       "TYPE SHORT_INTEGER" );
+
+     DECLARE
+          I0  : SHORT_INTEGER := 0;
+          I1  : SHORT_INTEGER := 1;
+          I2  : SHORT_INTEGER := 2;
+          I3  : SHORT_INTEGER := 3;
+          I4  : SHORT_INTEGER := 4;
+          I5  : SHORT_INTEGER := 5;
+          I10 : SHORT_INTEGER := 10;
+          I11 : SHORT_INTEGER := 11;
+          I12 : SHORT_INTEGER := 12;
+          I13 : SHORT_INTEGER := 13;
+          I14 : SHORT_INTEGER := 14;
+          N1  : SHORT_INTEGER := -1;
+          N2  : SHORT_INTEGER := -2;
+          N3  : SHORT_INTEGER := -3;
+          N4  : SHORT_INTEGER := -4;
+          N5  : SHORT_INTEGER := -5;
+          N10 : SHORT_INTEGER := -10;
+          N11 : SHORT_INTEGER := -11;
+          N12 : SHORT_INTEGER := -12;
+          N13 : SHORT_INTEGER := -13;
+          N14 : SHORT_INTEGER := -14;
+
+     BEGIN
+          IF I10 REM I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR I10 REM I5" );
+          END IF;
+
+          IF IDENT (I11) REM IDENT (I5) /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I11) REM " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF I12 REM I5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR I12 REM I5" );
+          END IF;
+
+          IF "REM" (LEFT => I12, RIGHT => I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I12, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT (I13) REM IDENT (I5) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I13) REM " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF I14 REM I5 /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR I14 REM I5" );
+          END IF;
+
+          IF IDENT (I10) REM IDENT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I10) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF "REM" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
+                   /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                        "IDENT (I10), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF I11 REM N5 /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR I11 REM N5" );
+          END IF;
+
+          IF IDENT (I12) REM IDENT (N5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I12) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF I13 REM N5 /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR I13 REM N5" );
+          END IF;
+
+          IF "REM" (LEFT => I13, RIGHT => N5) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I13, " &
+                        "RIGHT => N5)" );
+          END IF;
+
+          IF IDENT (I14) REM IDENT (N5) /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I14) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF N10 REM I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR N10 REM I5" );
+          END IF;
+
+          IF IDENT (N11) REM IDENT (I5) /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N11) REM " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF "REM" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
+                   /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                        "IDENT (N11), RIGHT => IDENT (I5))" );
+          END IF;
+
+          IF N12 REM I5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR N12 REM I5" );
+          END IF;
+
+          IF IDENT (N13) REM IDENT (I5) /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N13) REM " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF N14 REM I5 /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR N14 REM I5" );
+          END IF;
+
+          IF "REM" (LEFT => N14, RIGHT => I5) /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => N14, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT (N10) REM IDENT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N10) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF N11 REM N5 /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR N11 REM N5" );
+          END IF;
+
+          IF IDENT (N12) REM IDENT (N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N12) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF "REM" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
+                   /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                        "IDENT (N12), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF N13 REM N5 /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR N13 REM N5" );
+          END IF;
+
+          IF IDENT (N14) REM IDENT (N5) /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N14) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF I10 MOD I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR I10 MOD I5" );
+          END IF;
+
+          IF IDENT (I11) MOD IDENT (I5) /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I11) MOD " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF I12 MOD I5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR I12 MOD I5" );
+          END IF;
+
+          IF "MOD" (LEFT => I12, RIGHT => I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I12, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT (I13) MOD IDENT (I5) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I13) MOD " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF I14 MOD I5 /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR I14 MOD I5" );
+          END IF;
+
+          IF IDENT (I10) MOD IDENT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I10) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF "MOD" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
+                   /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                        "IDENT (I10), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF I11 MOD N5 /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR I11 MOD N5" );
+          END IF;
+
+          IF IDENT (I12) MOD IDENT (N5) /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I12) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF I13 MOD N5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I13 MOD N5" );
+          END IF;
+
+          IF "MOD" (LEFT => I13, RIGHT => N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I13, " &
+                        "RIGHT => N5)" );
+          END IF;
+
+          IF IDENT (I14) MOD IDENT (N5) /=  N1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I14) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF N10 MOD I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR N10 MOD I5" );
+          END IF;
+
+          IF IDENT (N11) MOD IDENT (I5) /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N11) MOD " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF "MOD" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
+                   /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                        "IDENT (N11), RIGHT => IDENT (I5))" );
+          END IF;
+
+          IF N12 MOD I5 /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR N12 MOD I5" );
+          END IF;
+
+          IF IDENT (N13) MOD IDENT (I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N13) MOD " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF N14 MOD I5 /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR N14 MOD I5" );
+          END IF;
+
+          IF "MOD" (LEFT => N14, RIGHT => I5) /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I14, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT (N10) MOD IDENT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N10) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF N11 MOD N5 /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR N11 MOD N5" );
+          END IF;
+
+          IF IDENT (N12) MOD IDENT (N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N12) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF "MOD" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
+                   /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                        "IDENT (N12), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF N13 MOD N5 /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR N13 MOD N5" );
+          END IF;
+
+          IF IDENT (N14) MOD IDENT (N5) /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N14) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+     END;
+
+     RESULT;
+END C45503B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45503c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45503c.dep
new file mode 100644
index 000000000..9a66c3529
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45503c.dep
@@ -0,0 +1,331 @@
+-- C45503C.DEP
+
+--                             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 'REM' AND 'MOD' YIELD CORRECT RESULTS WHEN THE
+--     OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     LONG_INTEGER.
+
+--     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_LONG" MUST BE REJECTED.
+
+-- HISTORY:
+--     RJW 09/01/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45503C IS
+
+     CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+
+     FUNCTION IDENT (L : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN L;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT;
+
+BEGIN
+     TEST ( "C45503C", "CHECK THAT 'REM' AND 'MOD' YIELD CORRECT " &
+                       "RESULTS WHEN THE OPERANDS ARE OF PREDEFINED " &
+                       "TYPE LONG_INTEGER" );
+
+     DECLARE
+          I0  : LONG_INTEGER := 0;
+          I1  : LONG_INTEGER := 1;
+          I2  : LONG_INTEGER := 2;
+          I3  : LONG_INTEGER := 3;
+          I4  : LONG_INTEGER := 4;
+          I5  : LONG_INTEGER := 5;
+          I10 : LONG_INTEGER := 10;
+          I11 : LONG_INTEGER := 11;
+          I12 : LONG_INTEGER := 12;
+          I13 : LONG_INTEGER := 13;
+          I14 : LONG_INTEGER := 14;
+          N1  : LONG_INTEGER := -1;
+          N2  : LONG_INTEGER := -2;
+          N3  : LONG_INTEGER := -3;
+          N4  : LONG_INTEGER := -4;
+          N5  : LONG_INTEGER := -5;
+          N10 : LONG_INTEGER := -10;
+          N11 : LONG_INTEGER := -11;
+          N12 : LONG_INTEGER := -12;
+          N13 : LONG_INTEGER := -13;
+          N14 : LONG_INTEGER := -14;
+
+     BEGIN
+          IF I10 REM I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR I10 REM I5" );
+          END IF;
+
+          IF IDENT (I11) REM IDENT (I5) /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I11) REM " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF I12 REM I5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR I12 REM I5" );
+          END IF;
+
+          IF "REM" (LEFT => I12, RIGHT => I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I12, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT (I13) REM IDENT (I5) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I13) REM " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF I14 REM I5 /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR I14 REM I5" );
+          END IF;
+
+          IF IDENT (I10) REM IDENT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I10) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF "REM" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
+                   /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                        "IDENT (I10), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF I11 REM N5 /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR I11 REM N5" );
+          END IF;
+
+          IF IDENT (I12) REM IDENT (N5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I12) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF I13 REM N5 /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR I13 REM N5" );
+          END IF;
+
+          IF "REM" (LEFT => I13, RIGHT => N5) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => I13, " &
+                        "RIGHT => N5)" );
+          END IF;
+
+          IF IDENT (I14) REM IDENT (N5) /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I14) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF N10 REM I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR N10 REM I5" );
+          END IF;
+
+          IF IDENT (N11) REM IDENT (I5) /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N11) REM " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF "REM" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
+                   /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                        "IDENT (N11), RIGHT => IDENT (I5))" );
+          END IF;
+
+          IF N12 REM I5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR N12 REM I5" );
+          END IF;
+
+          IF IDENT (N13) REM IDENT (I5) /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N13) REM " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF N14 REM I5 /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR N14 REM I5" );
+          END IF;
+
+          IF "REM" (LEFT => N14, RIGHT => I5) /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => N14, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT (N10) REM IDENT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N10) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF N11 REM N5 /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR N11 REM N5" );
+          END IF;
+
+          IF IDENT (N12) REM IDENT (N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N12) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF "REM" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
+                   /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""REM"" (LEFT => " &
+                        "IDENT (N12), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF N13 REM N5 /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR N13 REM N5" );
+          END IF;
+
+          IF IDENT (N14) REM IDENT (N5) /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N14) REM " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF I10 MOD I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR I10 MOD I5" );
+          END IF;
+
+          IF IDENT (I11) MOD IDENT (I5) /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I11) MOD " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF I12 MOD I5 /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR I12 MOD I5" );
+          END IF;
+
+          IF "MOD" (LEFT => I12, RIGHT => I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I12, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT (I13) MOD IDENT (I5) /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I13) MOD " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF I14 MOD I5 /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR I14 MOD I5" );
+          END IF;
+
+          IF IDENT (I10) MOD IDENT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I10) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF "MOD" (LEFT => IDENT (I10), RIGHT => IDENT (N5))
+                   /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                        "IDENT (I10), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF I11 MOD N5 /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR I11 MOD N5" );
+          END IF;
+
+          IF IDENT (I12) MOD IDENT (N5) /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I12) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF I13 MOD N5 /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR I13 MOD N5" );
+          END IF;
+
+          IF "MOD" (LEFT => I13, RIGHT => N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I13, " &
+                        "RIGHT => N5)" );
+          END IF;
+
+          IF IDENT (I14) MOD IDENT (N5) /=  N1 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (I14) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF N10 MOD I5 /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR N10 MOD I5" );
+          END IF;
+
+          IF IDENT (N11) MOD IDENT (I5) /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N11) MOD " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF "MOD" (LEFT => IDENT (N11), RIGHT => IDENT (I5))
+                   /= I4 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                        "IDENT (N11), RIGHT => IDENT (I5))" );
+          END IF;
+
+          IF N12 MOD I5 /= I3 THEN
+               FAILED ( "INCORRECT RESULT FOR N12 MOD I5" );
+          END IF;
+
+          IF IDENT (N13) MOD IDENT (I5) /= I2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N13) MOD " &
+                        "IDENT (I5)" );
+          END IF;
+
+          IF N14 MOD I5 /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR N14 MOD I5" );
+          END IF;
+
+          IF "MOD" (LEFT => N14, RIGHT => I5) /= I1 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => I14, " &
+                        "RIGHT => I5)" );
+          END IF;
+
+          IF IDENT (N10) MOD IDENT (N5) /= I0 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N10) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF N11 MOD N5 /= N1 THEN
+               FAILED ( "INCORRECT RESULT FOR N11 MOD N5" );
+          END IF;
+
+          IF IDENT (N12) MOD IDENT (N5) /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N12) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+
+          IF "MOD" (LEFT => IDENT (N12), RIGHT => IDENT (N5))
+                   /= N2 THEN
+               FAILED ( "INCORRECT RESULT FOR ""MOD"" (LEFT => " &
+                        "IDENT (N12), RIGHT => IDENT (N5))" );
+          END IF;
+
+          IF N13 MOD N5 /= N3 THEN
+               FAILED ( "INCORRECT RESULT FOR N13 MOD N5" );
+          END IF;
+
+          IF IDENT (N14) MOD IDENT (N5) /= N4 THEN
+               FAILED ( "INCORRECT RESULT FOR IDENT (N14) MOD " &
+                        "IDENT (N5)" );
+          END IF;
+     END;
+
+     RESULT;
+END C45503C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504a.ada
new file mode 100644
index 000000000..7cc4af4bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504a.ada
@@ -0,0 +1,92 @@
+-- C45504A.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 CONSTRAINT_ERROR IS RAISED WHEN A
+--      PRODUCT LIES OUTSIDE THE RANGE OF THE BASE TYPE, IF THE
+--      OPERANDS ARE OF PREDEFINED TYPE INTEGER.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--      RJW 09/01/86  CREATED ORIGINAL TEST.
+--      JET 12/30/87  UPDATED HEADER FORMAT AND ADDED CODE TO
+--                    PREVENT OPTIMIZATION.
+--      JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45504A IS
+
+     F : INTEGER := IDENT_INT (INTEGER'FIRST);
+     L : INTEGER := IDENT_INT (INTEGER'LAST);
+
+BEGIN
+     TEST ( "C45504A", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED WHEN A PRODUCT LIES OUTSIDE THE " &
+                       "RANGE OF THE BASE TYPE, IF THE OPERANDS ARE " &
+                       "OF PREDEFINED TYPE INTEGER" );
+
+     BEGIN
+          IF EQUAL (F*L,-100) THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * L'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'F * L'" );
+     END;
+
+     BEGIN
+          IF EQUAL (F*F,100) THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * F'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'F * F'" );
+     END;
+
+     BEGIN
+          IF EQUAL (L*L,100) THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'L * L'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'L * L'" );
+     END;
+
+     RESULT;
+END C45504A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504b.dep
new file mode 100644
index 000000000..230750540
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504b.dep
@@ -0,0 +1,117 @@
+-- C45504B.DEP
+
+--                             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 CONSTRAINT_ERROR IS RAISED WHEN
+--      A PRODUCT LIES OUTSIDE THE RANGE OF THE BASE TYPE, IF
+--      THE OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
+
+-- APPLICABILITY CRITERIA:
+--      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+--      THE PREDEFINED TYPE "SHORT_INTEGER".
+
+--      IF SUCH A TYPE IS NOT SUPPORTED, THEN THE DECLARATION OF
+--      THE VARIABLE "F" MUST BE REJECTED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--      RJW 09/01/86  CREATED ORIGINAL TEST.
+--      JET 12/30/87  UPDATED HEADER FORMAT AND ADDED CODE TO
+--                    DEFEAT OPTIMIZATION.
+--      JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45504B IS
+
+     F : SHORT_INTEGER;                -- N/A => ERROR.
+     L : SHORT_INTEGER;
+
+     FUNCTION IDENT_SHORT(A : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN A;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT_SHORT;
+
+     FUNCTION SHORT_OK(X : SHORT_INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          RETURN X = IDENT_SHORT(X);
+     END SHORT_OK;
+
+BEGIN
+     TEST ( "C45504B", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED WHEN A PRODUCT LIES OUTSIDE THE " &
+                       "RANGE OF THE BASE TYPE, IF THE OPERANDS ARE " &
+                       "OF PREDEFINED TYPE SHORT_INTEGER" );
+
+     F := IDENT_SHORT(SHORT_INTEGER'FIRST);
+     L := IDENT_SHORT(SHORT_INTEGER'LAST);
+
+     BEGIN
+          IF SHORT_OK (F*L) THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * L'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'F * L'" );
+     END;
+
+     BEGIN
+          IF SHORT_OK (F * F) THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * F'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'F * F'" );
+     END;
+
+     BEGIN
+          IF SHORT_OK (L * L) THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'L * L'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'L * L'" );
+     END;
+
+     RESULT;
+
+END C45504B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504c.dep
new file mode 100644
index 000000000..d39ee6378
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504c.dep
@@ -0,0 +1,119 @@
+-- C45504C.DEP
+
+--                             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 CONSTRAINT_ERROR IS RAISED WHEN A
+--      PRODUCT LIES OUTSIDE THE RANGE OF THE BASE TYPE, IF THE
+--      OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
+
+-- APPLICABILITY CRITERIA:
+--      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+--      THE PREDEFINED TYPE "LONG_INTEGER".
+
+--      IF SUCH A TYPE IS NOT SUPPORTED THEN THE DECLARATION OF THE
+--      VARIABLE "F" MUST BE REJECTED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--      RJW 09/01/86  CREATED ORIGINAL TEST.
+--      JET 12/30/87  UPDATED HEADER FORMAT AND DEFEATED OPTIMIZATION.
+--      JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45504C IS
+
+     F : LONG_INTEGER;                --  N/A => ERROR.
+     L : LONG_INTEGER;
+
+     FUNCTION IDENT_LONG(A : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN A;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT_LONG;
+
+     FUNCTION LONG_OK (X : LONG_INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          RETURN X = IDENT_LONG(X);
+     END;
+
+BEGIN
+     TEST ( "C45504C", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED WHEN A PRODUCT LIES OUTSIDE THE " &
+                       "RANGE OF THE BASE TYPE, IF THE OPERANDS ARE " &
+                       "OF PREDEFINED TYPE LONG_INTEGER" );
+
+     F := IDENT_LONG(LONG_INTEGER'FIRST);
+     L := IDENT_LONG(LONG_INTEGER'LAST);
+
+     BEGIN
+          IF LONG_OK (F * L) THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'F * L' - 2" );
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * L'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'F * L'" );
+     END;
+
+     BEGIN
+          IF LONG_OK (F * F) THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'F * F' - 2" );
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'F * F'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'F * F'" );
+     END;
+
+     BEGIN
+          IF LONG_OK (L * L) THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'L * L' - 2" );
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'L * L'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'L * L'" );
+     END;
+
+     RESULT;
+
+END C45504C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504d.ada
new file mode 100644
index 000000000..0b37b13c0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504d.ada
@@ -0,0 +1,214 @@
+-- C45504D.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 WHEN THE SECOND
+-- OPERAND OF '/', 'MOD', OR 'REM' EQUALS ZERO, IF THE OPERANDS ARE OF 
+-- PREDEFINED TYPE INTEGER.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- R.WILLIAMS 9/1/86
+-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45504D IS
+
+     I0 : INTEGER := IDENT_INT (0);
+     I5 : INTEGER := IDENT_INT (5);
+     N5 : INTEGER := IDENT_INT (-5);
+
+BEGIN
+     TEST ( "C45504D", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED WHEN THE SECOND OPERAND OF '/', " &
+                       "'MOD', OR 'REM' EQUALS ZERO, IF THE " & 
+                       "OPERANDS ARE OF PREDEFINED TYPE INTEGER" );
+
+     BEGIN
+          IF I5 / I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0'" );
+     END;
+
+     BEGIN
+          IF N5 / I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 / I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'N5 / I0'" );
+     END;
+
+     BEGIN
+          IF I0 / I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 / I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I0 / I0'" );
+     END;
+
+     BEGIN
+          IF I5 / I0 * I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0 * I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0 * I0'" );
+     END;
+
+     BEGIN
+          IF I5 MOD I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0'" );
+     END;
+
+     BEGIN
+          IF N5 MOD I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'N5 MOD I0'" );
+     END;
+
+     BEGIN
+          IF I0 MOD I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I0 MOD I0'" );
+     END;
+
+     BEGIN
+          IF I5 MOD I0 = (I5 + I0) MOD I0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                        "(I5 + I0) MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                        "(I5 + I0) MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0'" );
+     END;
+          
+     BEGIN
+          IF I5 REM I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM I0'" );
+     END;
+
+     BEGIN
+          IF N5 REM I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'N5 REM I0'" );
+     END;
+
+     BEGIN
+          IF I0 REM I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I0 REM I0'" );
+     END;
+
+     BEGIN
+          IF I5 REM (-I0) = I5 REM I0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                        "I5 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                        "I5 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM (-I0) " &
+                         "= I5 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                         "I5 REM I0'" );
+     END;
+          
+     RESULT;
+END C45504D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504e.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504e.dep
new file mode 100644
index 000000000..8ad4e59e3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504e.dep
@@ -0,0 +1,234 @@
+-- C45504E.DEP
+
+--                             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 CONSTRAINT_ERROR IS RAISED WHEN THE
+--     SECOND OPERAND OF '/', 'MOD', OR 'REM' EQUALS ZERO, IF THE
+--     OPERANDS ARE OF PREDEFINED TYPE SHORT_INTEGER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     SHORT_INTEGER.
+
+--     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_SHORT" MUST BE REJECTED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--     RJW 09/01/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     JRL 03/11/93 INITIALIZED VARIABLES TO DEFEAT OPTIMIZATION.
+--     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45504E IS
+
+     CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+
+     I0 : SHORT_INTEGER := 1;
+     I5 : SHORT_INTEGER := 2;
+     N5 : SHORT_INTEGER := 3;
+
+BEGIN
+     TEST ( "C45504E", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED WHEN THE SECOND OPERAND OF '/', " &
+                       "'MOD', OR 'REM' EQUALS ZERO, IF THE " &
+                       "OPERANDS ARE OF PREDEFINED TYPE " &
+                       "SHORT_INTEGER" );
+
+     IF EQUAL (3, 3) THEN
+          I0 := 0;
+          I5 := 5;
+          N5 := -5;
+     END IF;
+
+     BEGIN
+          IF I5 / I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0'" );
+     END;
+
+     BEGIN
+          IF N5 / I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 / I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'N5 / I0'" );
+     END;
+
+     BEGIN
+          IF I0 / I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 / I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I0 / I0'" );
+     END;
+
+     BEGIN
+          IF I5 / I0 * I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0 * I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0 * I0'" );
+     END;
+
+     BEGIN
+          IF I5 MOD I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0'" );
+     END;
+
+     BEGIN
+          IF N5 MOD I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'N5 MOD I0'" );
+     END;
+
+     BEGIN
+          IF I0 MOD I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I0 MOD I0'" );
+     END;
+
+     BEGIN
+          IF I5 MOD I0 = (I5 + I0) MOD I0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                        "(I5 + I0) MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                        "(I5 + I0) MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0'" );
+     END;
+
+     BEGIN
+          IF I5 REM I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM I0'" );
+     END;
+
+     BEGIN
+          IF N5 REM I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'N5 REM I0'" );
+     END;
+
+     BEGIN
+          IF I0 REM I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I0 REM I0'" );
+     END;
+
+     BEGIN
+          IF I5 REM (-I0) = I5 REM I0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                        "I5 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                        "I5 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM (-I0) " &
+                         "= I5 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                         "I5 REM I0'" );
+     END;
+
+     RESULT;
+END C45504E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504f.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504f.dep
new file mode 100644
index 000000000..81ea6c194
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45504f.dep
@@ -0,0 +1,234 @@
+-- C45504F.DEP
+
+--                             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 CONSTRAINT_ERROR IS RAISED WHEN THE
+--     SECOND OPERAND OF '/', 'MOD', OR 'REM' EQUALS ZERO, IF THE
+--     OPERANDS ARE OF PREDEFINED TYPE LONG_INTEGER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     LONG_INTEGER.
+
+--     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_LONG" MUST BE REJECTED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- HISTORY:
+--     RJW 09/01/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     JRL 03/11/93 INITIALIZED VARIABLES TO DEFEAT OPTIMIZATION.
+--     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45504F IS
+
+     CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+
+     I0 : LONG_INTEGER := 1;
+     I5 : LONG_INTEGER := 2;
+     N5 : LONG_INTEGER := 3;
+
+BEGIN
+     TEST ( "C45504F", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED WHEN THE SECOND OPERAND OF '/', " &
+                       "'MOD', OR 'REM' EQUALS ZERO, IF THE " &
+                       "OPERANDS ARE OF PREDEFINED TYPE " &
+                       "LONG_INTEGER" );
+
+     IF EQUAL (3, 3) THEN
+          I0 := 0;
+          I5 := 5;
+          N5 := -5;
+     END IF;
+
+     BEGIN
+          IF I5 / I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0'" );
+     END;
+
+     BEGIN
+          IF N5 / I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 / I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 / I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'N5 / I0'" );
+     END;
+
+     BEGIN
+          IF I0 / I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 / I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 / I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I0 / I0'" );
+     END;
+
+     BEGIN
+          IF I5 / I0 * I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 / I0 * I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 / I0 * I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 / I0 * I0'" );
+     END;
+
+     BEGIN
+          IF I5 MOD I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0'" );
+     END;
+
+     BEGIN
+          IF N5 MOD I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'N5 MOD I0'" );
+     END;
+
+     BEGIN
+          IF I0 MOD I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I0 MOD I0'" );
+     END;
+
+     BEGIN
+          IF I5 MOD I0 = (I5 + I0) MOD I0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                        "(I5 + I0) MOD I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                        "(I5 + I0) MOD I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 MOD I0 = " &
+                         "(I5 + I0) MOD I0'" );
+     END;
+
+     BEGIN
+          IF I5 REM I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM I0'" );
+     END;
+
+     BEGIN
+          IF N5 REM I0 = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'N5 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'N5 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'N5 REM I0'" );
+     END;
+
+     BEGIN
+          IF I0 REM I0  = 0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I0 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I0 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I0 REM I0'" );
+     END;
+
+     BEGIN
+          IF I5 REM (-I0) = I5 REM I0 THEN
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                        "I5 REM I0' - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                        "I5 REM I0' - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED BY 'I5 REM (-I0) " &
+                         "= I5 REM I0'" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED BY 'I5 REM (-I0) = " &
+                         "I5 REM I0'" );
+     END;
+
+     RESULT;
+END C45504F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45505a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45505a.ada
new file mode 100644
index 000000000..747d34b54
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45505a.ada
@@ -0,0 +1,65 @@
+-- C45505A.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 MULTIPLICATION FOR INTEGER SUBTYPES YIELDS A RESULT
+-- BELONGING TO THE BASE TYPE.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+
+-- JBG 2/24/84
+-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45505A IS
+
+     TYPE INT IS RANGE 1..10;
+
+     X, Y : INT := INT(IDENT_INT(5));
+
+BEGIN
+
+     TEST ("C45505A", "CHECK SUBTYPE OF INTEGER MULTIPLICATION");
+
+     BEGIN
+
+          IF X * Y / 5 /= INT(IDENT_INT(5)) THEN
+               FAILED ("INCORRECT RESULT");
+          END IF;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               IF INT'BASE'LAST >= INT'VAL(25) THEN
+                    FAILED ("MULTIPLICATION DOES NOT YIELD RESULT " &
+                            "BELONGING TO THE BASE TYPE");
+               ELSE
+                    COMMENT ("BASE TYPE HAS RANGE LESS THAN 25");
+               END IF;
+     END;
+
+     RESULT;
+
+END C45505A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45523a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45523a.ada
new file mode 100644
index 000000000..ff78eaba7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45523a.ada
@@ -0,0 +1,111 @@
+-- C45523A.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:
+--     FOR FLOATING POINT TYPES, IF MACHINE_OVERFLOWS IS TRUE AND
+--     EITHER THE RESULT OF MULTIPLICATION LIES OUTSIDE THE RANGE OF THE
+--     BASE TYPE, OR AN ATTEMPT IS MADE TO DIVIDE BY ZERO, THEN
+--     CONSTRAINT_ERROR IS RAISED.  THIS TESTS
+--     DIGITS 5.
+
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     BCB 02/09/88  CREATED ORIGINAL TEST.
+--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+--     KAS 11/14/95  DELETED USAGE OF 'SAFE_LARGE
+--     KAS 11/30/95  GOT IT RIGHT THIS TIME
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45523A IS
+
+     TYPE FLT IS DIGITS 5;
+
+     F : FLT;
+
+     FUNCTION IDENT_FLT(X : FLT) RETURN FLT IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN X;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT_FLT;
+
+     FUNCTION EQUAL_FLT(ONE, TWO : FLT) RETURN BOOLEAN IS
+     BEGIN
+          RETURN ONE = TWO * FLT (IDENT_INT(1));
+     END EQUAL_FLT;
+
+BEGIN
+     TEST ("C45523A", "FOR FLOATING POINT TYPES, IF MACHINE_" &
+                      "OVERFLOWS IS TRUE AND EITHER THE RESULT OF " &
+                      "MULTIPLICATION LIES OUTSIDE THE RANGE OF THE " &
+                      "BASE TYPE, OR AN ATTEMPT IS MADE TO DIVIDE BY " &
+                      "ZERO, THEN CONSTRAINT_ERROR IS RAISED." &
+                      "THIS TESTS DIGITS 5");
+
+
+     IF FLT'MACHINE_OVERFLOWS THEN
+          BEGIN
+               F := (FLT'BASE'LAST) * IDENT_FLT (2.0);
+               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED FOR MULTIPLICATION");
+               IF EQUAL_FLT(F,F**IDENT_INT(1)) THEN
+                    COMMENT ("DON'T OPTIMIZE F");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR WAS RAISED FOR " &
+                             "MULTIPLICATION");
+               WHEN OTHERS =>
+                    FAILED ("AN EXCEPTION OTHER THAN " &
+                            "CONSTRAINT_ERROR WAS RAISED FOR " &
+                            "MULTIPLICATION");
+          END;
+          BEGIN
+               F := (FLT'LAST) / IDENT_FLT (0.0);
+               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED FOR DIVISION BY ZERO");
+               IF EQUAL_FLT(F,F**IDENT_INT(1)) THEN
+                    COMMENT ("DON'T OPTIMIZE F");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR WAS RAISED FOR " &
+                             "DIVISION BY ZERO");
+               WHEN OTHERS =>
+                    FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                            "WAS RAISED FOR DIVISION BY ZERO");
+          END;
+     ELSE
+          NOT_APPLICABLE ("THIS TEST IS NOT APPLICABLE DUE TO " &
+                          "MACHINE_OVERFLOWS BEING FALSE");
+     END IF;
+
+     RESULT;
+END C45523A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531a.ada
new file mode 100644
index 000000000..6a77909da
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531a.ada
@@ -0,0 +1,182 @@
+-- C45531A.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+--       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45531A IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 12;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     DEL4            : CONSTANT := 4.0 * DEL1;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45531A", "MIXED FIXED POINT AND INTEGER ""*"" "
+                     & "FOR RANGE <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := 3;
+               B := FX_0P5 (0.125);               -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (0.125);                 -- A MODEL NUMBER
+               B := 6;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+
+C:   DECLARE
+          A               : INTEGER   := 0;
+          B               : FX_2      := 0.0;
+          RESULT_VALUE    : FX_2      := 0.0;
+          LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+          HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                      := FX_2 (DEL4 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                      := FX_2 (DEL4 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+               A := 3;
+               B := FX_2 (DEL4 * FORTH + DEL1 );
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+     -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+
+D:   DECLARE
+          A               : FX_2      := 0.0;
+          B               : INTEGER   := 0;
+          RESULT_VALUE    : FX_2      := 0.0;
+          LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+          HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                      := FX_2 (DEL4 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                      := FX_2 (DEL4 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+               A := FX_2 (DEL4 * FORTH + DEL1 );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END D;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531b.ada
new file mode 100644
index 000000000..74ac115e1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531b.ada
@@ -0,0 +1,153 @@
+-- C45531B.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+--       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45531B IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 12;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     DEL2            : CONSTANT := 2.0 * DEL1;
+     DEL4            : CONSTANT := 4.0 * DEL1;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45531B", "MIXED FIXED POINT AND INTEGER ""/"" "
+                     & "FOR RANGE <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
+               B := 5;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (DEL2 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (DEL2 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
+               A := FX_1 (DEL2 * (3 * FORTH + 1) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                    &  "NUMBER, RESULT NOT");
+
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_2    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (DEL4 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (DEL4 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+               A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531c.ada
new file mode 100644
index 000000000..a864decdb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531c.ada
@@ -0,0 +1,183 @@
+-- C45531C.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+--       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45531C IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 12;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45531C", "MIXED FIXED POINT AND INTEGER ""*"" "
+                    &  "FOR DELTA <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := 3;
+               B := FX_0P5 (2.5);               -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
+               B := 6;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+
+C:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_RNG1 := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+          HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+               A := 3;
+               B := FX_RNG1 (RNG1 * FORTH + 0.5);
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+     -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+
+D:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+          HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+               A := FX_RNG1 (RNG1 * FORTH + 0.5);
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END D;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531d.ada
new file mode 100644
index 000000000..2c2eb87d1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531d.ada
@@ -0,0 +1,153 @@
+-- C45531D.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+--       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45531D IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 12;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45531D", "MIXED FIXED POINT AND INTEGER ""/"" "
+                     & "FOR DELTA <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (7.5);                 -- A MODEL NUMBER
+               B := 5;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (FORTH + 1);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                    &  "NUMBER, RESULT NOT");
+
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+               A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531e.ada
new file mode 100644
index 000000000..f05ef92c7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531e.ada
@@ -0,0 +1,182 @@
+-- C45531E.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+--       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45531E IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 16;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     DEL4            : CONSTANT := 4.0 * DEL1;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45531E", "MIXED FIXED POINT AND INTEGER ""*"" "
+                     & "FOR RANGE <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := 3;
+               B := FX_0P5 (0.125);               -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (0.125);                 -- A MODEL NUMBER
+               B := 6;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+
+C:   DECLARE
+          A               : INTEGER   := 0;
+          B               : FX_2      := 0.0;
+          RESULT_VALUE    : FX_2      := 0.0;
+          LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+          HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                      := FX_2 (DEL4 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                      := FX_2 (DEL4 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+               A := 3;
+               B := FX_2 (DEL4 * FORTH + DEL1 );
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+     -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+
+D:   DECLARE
+          A               : FX_2      := 0.0;
+          B               : INTEGER   := 0;
+          RESULT_VALUE    : FX_2      := 0.0;
+          LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+          HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                      := FX_2 (DEL4 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                      := FX_2 (DEL4 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+               A := FX_2 (DEL4 * FORTH + DEL1 );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END D;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531f.ada
new file mode 100644
index 000000000..65b1f1803
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531f.ada
@@ -0,0 +1,153 @@
+-- C45531F.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+--       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45531F IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 16;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     DEL2            : CONSTANT := 2.0 * DEL1;
+     DEL4            : CONSTANT := 4.0 * DEL1;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45531F", "MIXED FIXED POINT AND INTEGER ""/"" "
+                     & "FOR RANGE <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
+               B := 5;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (DEL2 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (DEL2 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
+               A := FX_1 (DEL2 * (3 * FORTH + 1) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                    &  "NUMBER, RESULT NOT");
+
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_2    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (DEL4 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (DEL4 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+               A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531g.ada
new file mode 100644
index 000000000..b6146ab64
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531g.ada
@@ -0,0 +1,183 @@
+-- C45531G.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+--       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45531G IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 16;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45531G", "MIXED FIXED POINT AND INTEGER ""*"" "
+                    &  "FOR DELTA <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := 3;
+               B := FX_0P5 (2.5);               -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
+               B := 6;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+
+C:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_RNG1 := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+          HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+               A := 3;
+               B := FX_RNG1 (RNG1 * FORTH + 0.5);
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+     -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+
+D:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+          HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+               A := FX_RNG1 (RNG1 * FORTH + 0.5);
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END D;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531h.ada
new file mode 100644
index 000000000..e1351582f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531h.ada
@@ -0,0 +1,153 @@
+-- C45531H.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+--       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45531H IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 16;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45531H", "MIXED FIXED POINT AND INTEGER ""/"" "
+                     & "FOR DELTA <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (7.5);                 -- A MODEL NUMBER
+               B := 5;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (FORTH + 1);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                    &  "NUMBER, RESULT NOT");
+
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+               A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531i.ada
new file mode 100644
index 000000000..ff4765871
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531i.ada
@@ -0,0 +1,182 @@
+-- C45531I.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+--       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45531I IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 32;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     DEL4            : CONSTANT := 4.0 * DEL1;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45531I", "MIXED FIXED POINT AND INTEGER ""*"" "
+                     & "FOR RANGE <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := 3;
+               B := FX_0P5 (0.125);               -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (0.125);                 -- A MODEL NUMBER
+               B := 6;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+
+C:   DECLARE
+          A               : INTEGER   := 0;
+          B               : FX_2      := 0.0;
+          RESULT_VALUE    : FX_2      := 0.0;
+          LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+          HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                      := FX_2 (DEL4 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                      := FX_2 (DEL4 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+               A := 3;
+               B := FX_2 (DEL4 * FORTH + DEL1 );
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+     -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+
+D:   DECLARE
+          A               : FX_2      := 0.0;
+          B               : INTEGER   := 0;
+          RESULT_VALUE    : FX_2      := 0.0;
+          LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+          HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                      := FX_2 (DEL4 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                      := FX_2 (DEL4 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+               A := FX_2 (DEL4 * FORTH + DEL1 );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END D;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531j.ada
new file mode 100644
index 000000000..7279dd946
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531j.ada
@@ -0,0 +1,153 @@
+-- C45531J.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+--       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45531J IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 32;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     DEL2            : CONSTANT := 2.0 * DEL1;
+     DEL4            : CONSTANT := 4.0 * DEL1;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45531J", "MIXED FIXED POINT AND INTEGER ""/"" "
+                     & "FOR RANGE <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
+               B := 5;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (DEL2 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (DEL2 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
+               A := FX_1 (DEL2 * (3 * FORTH + 1) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                    &  "NUMBER, RESULT NOT");
+
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_2    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (DEL4 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (DEL4 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+               A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531k.ada
new file mode 100644
index 000000000..2e70d17e5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531k.ada
@@ -0,0 +1,184 @@
+-- C45531K.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+--       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+
+WITH REPORT;
+PROCEDURE C45531K IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 32;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45531K", "MIXED FIXED POINT AND INTEGER ""*"" "
+                    &  "FOR DELTA <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := 3;
+               B := FX_0P5 (2.5);               -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
+               B := 6;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+
+C:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_RNG1 := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+          HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+               A := 3;
+               B := FX_RNG1 (RNG1 * FORTH + 0.5);
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+     -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+
+D:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+          HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+               A := FX_RNG1 (RNG1 * FORTH + 0.5);
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END D;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531l.ada
new file mode 100644
index 000000000..97a6f8d97
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531l.ada
@@ -0,0 +1,154 @@
+-- C45531L.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+--       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+
+WITH REPORT;
+PROCEDURE C45531L IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 32;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45531L", "MIXED FIXED POINT AND INTEGER ""/"" "
+                     & "FOR DELTA <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (7.5);                 -- A MODEL NUMBER
+               B := 5;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (FORTH + 1);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                    &  "NUMBER, RESULT NOT");
+
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+               A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531m.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531m.dep
new file mode 100644
index 000000000..25ded1fb6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531m.dep
@@ -0,0 +1,189 @@
+-- C45531M.DEP
+
+--                             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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+--       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+--     'MAX_MANTISSA OF 47 OR GREATER.
+
+--     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+--     'TYPE FX_OP5' MUST BE REJECTED.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+
+
+WITH REPORT;
+PROCEDURE C45531M IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 48;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     DEL4            : CONSTANT := 4.0 * DEL1;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+                                                        -- N/A => ERROR.
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45531M", "MIXED FIXED POINT AND INTEGER ""*"" "
+                     & "FOR RANGE <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (0.375);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (0.375);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := 3;
+               B := FX_0P5 (0.125);               -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.75);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.75);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (0.125);                 -- A MODEL NUMBER
+               B := 6;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+
+C:   DECLARE
+          A               : INTEGER   := 0;
+          B               : FX_2      := 0.0;
+          RESULT_VALUE    : FX_2      := 0.0;
+          LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+          HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                      := FX_2 (DEL4 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                      := FX_2 (DEL4 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+               A := 3;
+               B := FX_2 (DEL4 * FORTH + DEL1 );
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+     -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+
+D:   DECLARE
+          A               : FX_2      := 0.0;
+          B               : INTEGER   := 0;
+          RESULT_VALUE    : FX_2      := 0.0;
+          LOW_COUNT       : CONSTANT  := (3 * (FORTH + 0) );
+          HIGH_COUNT      : CONSTANT  := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE     :  FX_2
+                                      := FX_2 (DEL4 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE    :  FX_2
+                                      := FX_2 (DEL4 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+               A := FX_2 (DEL4 * FORTH + DEL1 );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END D;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531n.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531n.dep
new file mode 100644
index 000000000..f461ba083
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531n.dep
@@ -0,0 +1,160 @@
+-- C45531N.DEP
+
+--                             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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+--       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+--     'MAX_MANTISSA OF 47 OR GREATER.
+
+--     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+--     'TYPE FX_OP5' MUST BE REJECTED.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+
+
+WITH REPORT;
+PROCEDURE C45531N IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 48;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     DEL2            : CONSTANT := 2.0 * DEL1;
+     DEL4            : CONSTANT := 4.0 * DEL1;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+                                                        -- N/A => ERROR.
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45531N", "MIXED FIXED POINT AND INTEGER ""/"" "
+                     & "FOR RANGE <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (3 * DEL1);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (3 * DEL1);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (15 * DEL1);           -- A MODEL NUMBER
+               B := 5;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (DEL2 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (DEL2 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A IS A MODEL NUMBER
+               A := FX_1 (DEL2 * (3 * FORTH + 1) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                    &  "NUMBER, RESULT NOT");
+
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_2    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (DEL4 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (DEL4 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+               A := FX_2 (3 * (DEL4 * FORTH + DEL1) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531o.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531o.dep
new file mode 100644
index 000000000..ae8c3953f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531o.dep
@@ -0,0 +1,189 @@
+-- C45531O.DEP
+
+--                             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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 4 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+--       D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+--     'MAX_MANTISSA OF 47 OR GREATER.
+
+--     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+--     'TYPE FX_OP5' MUST BE REJECTED.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+
+WITH REPORT;
+PROCEDURE C45531O IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 48;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+                                                        -- N/A => ERROR.
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45531O", "MIXED FIXED POINT AND INTEGER ""*"" "
+                    &  "FOR DELTA <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) INTEGER * FIXED WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (7.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (7.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := 3;
+               B := FX_0P5 (2.5);               -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED * INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (3 * FORTH);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (3 * FORTH);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (FULL_SCALE / 8);        -- A MODEL NUMBER
+               B := 6;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) INTEGER * FIXED FOR NON-MODEL NUMBERS.
+
+C:   DECLARE
+          A              : INTEGER := 0;
+          B              : FX_RNG1 := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+          HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- B NOT A MODEL NUMBER
+               A := 3;
+               B := FX_RNG1 (RNG1 * FORTH + 0.5);
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR INTEGER * FIXED FOR NON-MODEL NUMBERS");
+
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+     -- CASE D) FIXED * INTEGER FOR NON-MODEL NUMBERS.
+
+D:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := (3 * (FORTH + 0) );
+          HIGH_COUNT    : CONSTANT := (3 * (FORTH + 1) );
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN        -- A NOT A MODEL NUMBER
+               A := FX_RNG1 (RNG1 * FORTH + 0.5);
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A * B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED * INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END D;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531p.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531p.dep
new file mode 100644
index 000000000..e4b6ce967
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45531p.dep
@@ -0,0 +1,159 @@
+-- C45531P.DEP
+
+--                             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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR MIXED FIXED POINT AND INTEGER TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+--       B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER AND RESULT NOT.
+--       C) FIXED / INTEGER FOR NON-MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+--     'MAX_MANTISSA OF 47 OR GREATER.
+
+--     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+--     'TYPE FX_OP5' MUST BE REJECTED.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     BCB 04/27/90 REVISED APPLICABILITY CRITERIA.
+
+WITH REPORT;
+PROCEDURE C45531P IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 48;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+                                                        -- N/A => ERROR.
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45531P", "MIXED FIXED POINT AND INTEGER ""/"" "
+                     & "FOR DELTA <, =, > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) FIXED / INTEGER WHEN ALL VALUES ARE MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (1.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (1.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (7.5);                 -- A MODEL NUMBER
+               B := 5;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER "
+                    &  "WHEN ALL VALUES ARE MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) FIXED / INTEGER WITH NUMERATOR MODEL NUMBER, RESULT NOT
+
+B:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (FORTH + 1);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (3 * FORTH + 1);         -- A MODEL NUMBER
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER WITH NUMERATOR MODEL "
+                    &  "NUMBER, RESULT NOT");
+
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) FIXED / INTEGER FOR NON-MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : INTEGER := 0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * FORTH );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * (FORTH + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN                    -- A NOT MODEL NUMBER
+               A := FX_RNG1 (3 * (RNG1 * FORTH + 0.5) );
+               B := 3;
+          END IF;
+
+          RESULT_VALUE := A / B;
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "FOR FIXED / INTEGER FOR NON-MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45531P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532a.ada
new file mode 100644
index 000000000..8ebbc0a37
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532a.ada
@@ -0,0 +1,152 @@
+-- C45532A.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+--       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+--       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45532A IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 12;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45532A", "FIXED POINT OPERATOR ""*"" "
+                     & "FOR RANGE <, =, AND > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_2    := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.25);                -- A MODEL NUMBER
+               B := FX_2   (0.50);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
+          HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (4 * DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (4 * DEL1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
+               B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A * B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
+          HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (4 * DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (4 * DEL1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
+               B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532b.ada
new file mode 100644
index 000000000..5077477f3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532b.ada
@@ -0,0 +1,159 @@
+-- C45532B.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+--       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+--       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45532B IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 12;            -- MUST BE EVEN & >= 6
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     A_THIRD         : CONSTANT := FULL_SCALE / 3;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
+                                       0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
+                                       1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
+                                       2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45532B", "FIXED POINT OPERATOR ""/"" "
+                     & "FOR RANGE <, =, AND > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.125);               -- A MODEL NUMBER
+               B := FX_1   (0.25);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (2 * DEL1 * A_THIRD);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (2 * DEL1 * (A_THIRD + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
+               B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A / B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
+                            --   := (2 * FULL_SCALE * (2 * FORTH + 0))
+                            --                      / (6 * FORTH + 2);
+          HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
+                            --   := (2 * FULL_SCALE * (2 * FORTH + 2))
+                            --                      / (6 * FORTH + 0);
+          LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                   := FX_0P5 (DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                   := FX_0P5 (DEL1 * HIGH_COUNT );
+     BEGIN
+          IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
+               A := FX_1 (DEL1 * (2 * FORTH + 1));
+               B := FX_1 (DEL1 * (6 * FORTH + 1));
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532c.ada
new file mode 100644
index 000000000..9e9aaa292
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532c.ada
@@ -0,0 +1,156 @@
+-- C45532C.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+--       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+--       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45532C IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 12;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45532C", "FIXED POINT OPERATOR ""*"" "
+                     & "FOR DELTA <, =, AND > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOWEST_ACCEPTABLE_VALUE
+                         : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+          HIGHEST_ACCEPTABLE_VALUE
+                         : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
+               B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
+          HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
+               B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A * B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_RNG1    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
+          HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
+               B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532d.ada
new file mode 100644
index 000000000..51923df95
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532d.ada
@@ -0,0 +1,150 @@
+-- C45532D.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 12.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+--       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+--       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45532D IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 12;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     A_THIRD         : CONSTANT := FULL_SCALE / 3;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45532D", "FIXED POINT OPERATOR ""/"" "
+                     & "FOR DELTA <, =, AND > 1.0");
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
+               B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+
+B:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                   := FX_0P5 (0.5 * A_THIRD);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                   := FX_0P5 (0.5 * (A_THIRD + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
+               B := FX_1    (3.0);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A / B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 ( RNG1 - 3.0);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 ( RNG1 + 4.0);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
+               B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532e.ada
new file mode 100644
index 000000000..42989f162
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532e.ada
@@ -0,0 +1,151 @@
+-- C45532E.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+--       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+--       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45532E IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 16;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45532E", "FIXED POINT OPERATOR ""*""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_2    := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.25);                -- A MODEL NUMBER
+               B := FX_2   (0.50);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
+          HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (4 * DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (4 * DEL1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
+               B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A * B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
+          HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (4 * DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (4 * DEL1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
+               B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532f.ada
new file mode 100644
index 000000000..59a9e25bb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532f.ada
@@ -0,0 +1,158 @@
+-- C45532F.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+--       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+--       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45532F IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 16;            -- MUST BE EVEN & >= 6
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     A_THIRD         : CONSTANT := FULL_SCALE / 3;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
+                                      0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
+                                      1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
+                                      2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45532F", "FIXED POINT OPERATOR ""/""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.125);               -- A MODEL NUMBER
+               B := FX_1   (0.25);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (2 * DEL1 * A_THIRD);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (2 * DEL1 * (A_THIRD + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
+               B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A / B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
+                            --   := (2 * FULL_SCALE * (2 * FORTH + 0))
+                            --                      / (6 * FORTH + 2);
+          HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
+                            --   := (2 * FULL_SCALE * (2 * FORTH + 2))
+                            --                      / (6 * FORTH + 0);
+          LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                   := FX_0P5 (DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                   := FX_0P5 (DEL1 * HIGH_COUNT );
+     BEGIN
+          IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
+               A := FX_1 (DEL1 * (2 * FORTH + 1));
+               B := FX_1 (DEL1 * (6 * FORTH + 1));
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532g.ada
new file mode 100644
index 000000000..c9d8f004d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532g.ada
@@ -0,0 +1,155 @@
+-- C45532G.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+--       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+--       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45532G IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 16;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45532G", "FIXED POINT OPERATOR ""*""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOWEST_ACCEPTABLE_VALUE
+                         : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+          HIGHEST_ACCEPTABLE_VALUE
+                         : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
+               B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
+          HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
+               B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A * B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_RNG1    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
+          HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
+               B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532h.ada
new file mode 100644
index 000000000..ea1d9613f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532h.ada
@@ -0,0 +1,149 @@
+-- C45532H.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 16.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+--       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+--       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45532H IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 16;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     A_THIRD         : CONSTANT := FULL_SCALE / 3;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45532H", "FIXED POINT OPERATOR ""/""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
+               B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+
+B:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                   := FX_0P5 (0.5 * A_THIRD);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                   := FX_0P5 (0.5 * (A_THIRD + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
+               B := FX_1    (3.0);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A / B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 ( RNG1 - 3.0);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 ( RNG1 + 4.0);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
+               B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532i.ada
new file mode 100644
index 000000000..60a7dfe18
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532i.ada
@@ -0,0 +1,152 @@
+-- C45532I.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+--       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+--       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+
+WITH REPORT;
+PROCEDURE C45532I IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 32;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45532I", "FIXED POINT OPERATOR ""*""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_2    := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.25);                -- A MODEL NUMBER
+               B := FX_2   (0.50);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
+          HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (4 * DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (4 * DEL1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
+               B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A * B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
+          HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (4 * DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (4 * DEL1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
+               B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532j.ada
new file mode 100644
index 000000000..a50906c46
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532j.ada
@@ -0,0 +1,158 @@
+-- C45532J.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+--       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+--       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;
+PROCEDURE C45532J IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 32;            -- MUST BE EVEN & >= 6
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     A_THIRD         : CONSTANT := FULL_SCALE / 3;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
+                                      0.5 - DEL1 * 1;
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
+                                      1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
+                                      2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45532J", "FIXED POINT OPERATOR ""/""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.125);               -- A MODEL NUMBER
+               B := FX_1   (0.25);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (2 * DEL1 * A_THIRD);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (2 * DEL1 * (A_THIRD + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
+               B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A / B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
+                            --   := (2 * FULL_SCALE * (2 * FORTH + 0))
+                            --                      / (6 * FORTH + 2);
+          HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
+                            --   := (2 * FULL_SCALE * (2 * FORTH + 2))
+                            --                      / (6 * FORTH + 0);
+          LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                   := FX_0P5 (DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                   := FX_0P5 (DEL1 * HIGH_COUNT );
+     BEGIN
+          IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
+               A := FX_1 (DEL1 * (2 * FORTH + 1));
+               B := FX_1 (DEL1 * (6 * FORTH + 1));
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532k.ada
new file mode 100644
index 000000000..1f2bd7102
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532k.ada
@@ -0,0 +1,156 @@
+-- C45532K.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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+--       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+--       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+
+WITH REPORT;
+PROCEDURE C45532K IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 32;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45532K", "FIXED POINT OPERATOR ""*""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOWEST_ACCEPTABLE_VALUE
+                         : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+          HIGHEST_ACCEPTABLE_VALUE
+                         : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
+               B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
+          HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
+               B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A * B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_RNG1    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
+          HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
+               B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532l.ada
new file mode 100644
index 000000000..2ea7fea82
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532l.ada
@@ -0,0 +1,150 @@
+-- C45532L.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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 32.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+--       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+--       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+--     BCB 10/03/90 REMOVED APPLICABILITY CRITERIA AND N/A => ERROR
+--                  LINE.  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+
+WITH REPORT;
+PROCEDURE C45532L IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 32;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     A_THIRD         : CONSTANT := FULL_SCALE / 3;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45532L", "FIXED POINT OPERATOR ""/""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
+               B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+
+B:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                   := FX_0P5 (0.5 * A_THIRD);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                   := FX_0P5 (0.5 * (A_THIRD + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
+               B := FX_1    (3.0);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A / B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 ( RNG1 - 3.0);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 ( RNG1 + 4.0);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
+               B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532m.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532m.dep
new file mode 100644
index 000000000..b4001af93
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532m.dep
@@ -0,0 +1,157 @@
+-- C45532M.DEP
+
+--                             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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+--       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+--       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+--     'MAX_MANTISSA OF 47 OR GREATER.
+
+--     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+--     'TYPE FX_OP5' MUST BE REJECTED.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+
+WITH REPORT;
+PROCEDURE C45532M IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 48;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 .. 0.5 - DEL1 * 1;
+                                                        -- N/A => ERROR.
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 .. 1.0 - DEL1 * 2;
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 .. 2.0 - DEL1 * 4;
+
+BEGIN TEST ("C45532M", "FIXED POINT OPERATOR ""*""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_2    := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_1 := FX_1 (0.125);
+          HIGHEST_ACCEPTABLE_VALUE : FX_1 := FX_1 (0.125);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.25);                -- A MODEL NUMBER
+               B := FX_2   (0.50);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 64;
+          HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (4 * DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (4 * DEL1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (DEL1 * (FORTH + 1) ); -- A MODEL NUMBER
+               B := FX_1   (DEL1 * (FORTH * 2) ); -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A * B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 128 - 1;
+          HIGH_COUNT    : CONSTANT := FULL_SCALE / 128 + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_2
+                                   := FX_2 (4 * DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_2
+                                   := FX_2 (4 * DEL1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (DEL1 * (FORTH + 1) );   -- NOT MODEL NUMBER
+               B := FX_1 (DEL1 * (FORTH - 1) );   -- NOT MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532n.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532n.dep
new file mode 100644
index 000000000..9315c6826
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532n.dep
@@ -0,0 +1,163 @@
+-- C45532N.DEP
+
+--                             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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE LESS THAN 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+--       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+--       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+--     'MAX_MANTISSA OF 47 OR GREATER.
+
+-- IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+--    'TYPE FX_OP5' MUST BE REJECTED.
+
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+
+WITH REPORT;
+PROCEDURE C45532N IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 48;            -- MUST BE EVEN & >= 6
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     A_THIRD         : CONSTANT := FULL_SCALE / 3;
+     DEL1            : CONSTANT := 0.5 / FULL_SCALE;
+     TYPE FX_0P5 IS DELTA DEL1 * 1 RANGE -0.5 ..
+                                      0.5 - DEL1 * 1; -- N/A => ERROR.
+     TYPE FX_1   IS DELTA DEL1 * 2 RANGE -1.0 ..
+                                      1.0 - DEL1 * 2; -- N/A => ERROR.
+     TYPE FX_2   IS DELTA DEL1 * 4 RANGE -2.0 ..
+                                      2.0 - DEL1 * 4; -- N/A => ERROR.
+
+BEGIN TEST ("C45532N", "FIXED POINT OPERATOR ""/""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_2    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_2 := FX_2 (0.5);
+          HIGHEST_ACCEPTABLE_VALUE : FX_2 := FX_2 (0.5);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.125);               -- A MODEL NUMBER
+               B := FX_1   (0.25);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_2 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 (2 * DEL1 * A_THIRD);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 (2 * DEL1 * (A_THIRD + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (DEL1 * 1);            -- A MODEL NUMBER
+               B := FX_0P5 (DEL1 * 3);            -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A / B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOW_COUNT    : CONSTANT  := 2 * A_THIRD;
+                            --   := (2 * FULL_SCALE * (2 * FORTH + 0))
+                            --                      / (6 * FORTH + 2);
+          HIGH_COUNT   : CONSTANT  := 2 * A_THIRD + 4;
+                            --   := (2 * FULL_SCALE * (2 * FORTH + 2))
+                            --                      / (6 * FORTH + 0);
+          LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                   := FX_0P5 (DEL1 * LOW_COUNT );
+          HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                   := FX_0P5 (DEL1 * HIGH_COUNT );
+     BEGIN
+          IF EQUAL (3, 3) THEN     -- A AND B NOT MODEL NUMBERS
+               A := FX_1 (DEL1 * (2 * FORTH + 1));
+               B := FX_1 (DEL1 * (6 * FORTH + 1));
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532o.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532o.dep
new file mode 100644
index 000000000..b0126df4b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532o.dep
@@ -0,0 +1,161 @@
+-- C45532O.DEP
+
+--                             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 OPERATOR "*" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+--       B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+--       C) THE OPERATOR *, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+--     'MAX_MANTISSA OF 47 OR GREATER.
+
+--     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+--     'TYPE FX_OP5' MUST BE REJECTED.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+
+WITH REPORT;
+PROCEDURE C45532O IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 48;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     FORTH           : CONSTANT := FULL_SCALE / 4;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+                                                        -- N/A => ERROR.
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45532O", "FIXED POINT OPERATOR ""*""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR *, A, B, AND A * B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOWEST_ACCEPTABLE_VALUE
+                         : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+          HIGHEST_ACCEPTABLE_VALUE
+                         : FX_RNG1 := FX_RNG1 (RNG1 * RNG1 / 4);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (RNG1 / 2);            -- A MODEL NUMBER
+               B := FX_1   (RNG1 / 2);            -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A * B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR *, A, B MODEL NUMBERS A * B NOT.
+
+B:   DECLARE
+          A              : FX_0P5  := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_RNG1 := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 16;
+          HIGH_COUNT    : CONSTANT := LOW_COUNT + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_0P5 (0.5 * (FORTH + 1) );  -- A MODEL NUMBER
+               B := FX_0P5 (0.5 * (FORTH * 2) );  -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A * B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR *, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_1    := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_RNG1    := 0.0;
+          LOW_COUNT     : CONSTANT := FULL_SCALE / 32 - 1;
+          HIGH_COUNT    : CONSTANT := FULL_SCALE / 32 + 1;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * LOW_COUNT);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_RNG1
+                                   := FX_RNG1 (RNG1 * HIGH_COUNT);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_1 (0.5 * (FORTH + 1) );    -- NOT MODEL NUMBER
+               B := FX_1 (0.5 * (FORTH - 1) );    -- NOT MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_RNG1 (A * B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""*"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532p.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532p.dep
new file mode 100644
index 000000000..cab503166
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45532p.dep
@@ -0,0 +1,155 @@
+-- C45532P.DEP
+
+--                             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 OPERATOR "/" PRODUCES CORRECT RESULTS
+--     FOR FIXED POINT TYPES USING 3 SUBTESTS.
+--       THIS TEST REQUIRES MIN_WORD_LENGTH = 48.
+--       THIS TEST USES VALUES OF DELTA WHICH ARE GREATER THAN OR
+--       EQUAL TO 0.5.
+--
+--     TEST CASES ARE:
+--       A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+--       B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+--       C) THE OPERATOR /, USING NO MODEL NUMBERS.
+--
+--     REPEAT FOR MINIMUM REQUIRED WORD LENGTHS OF 12, 16, 32 AND 48,
+--     WITH RANGE <, =, AND > THAN 1.0 AND
+--     WITH DELTA <, =, AND > THAN 1.0.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE FOR IMPLEMENTATIONS WHICH HAVE A
+--     'MAX_MANTISSA OF 47 OR GREATER.
+
+--     IF 'MAX_MANTISSA >= 47 IS NOT SUPPORTED THEN THE DECLARATION OF
+--     'TYPE FX_OP5' MUST BE REJECTED.
+
+-- HISTORY:
+--     NTW 09/08/86 CREATED ORIGINAL TEST.
+--     RJW 11/05/86 REVISED COMMENTS.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     RDH 04/27/90 REVISED APPLICABILITY CRITERIA.
+
+WITH REPORT;
+PROCEDURE C45532P IS
+
+     USE REPORT;
+
+     MIN_WORD_LENGTH : CONSTANT := 48;
+     FULL_SCALE      : CONSTANT := 2 ** (MIN_WORD_LENGTH - 1);
+     A_THIRD         : CONSTANT := FULL_SCALE / 3;
+     RNG1            : CONSTANT := FULL_SCALE * 0.5;
+     TYPE FX_0P5  IS DELTA 0.5 RANGE -RNG1 * 1 .. RNG1 * 1 - 0.5;
+                                                        -- N/A => ERROR.
+     TYPE FX_1    IS DELTA 1.0 RANGE -RNG1 * 2 .. RNG1 * 2 - 1.0;
+     TYPE FX_RNG1 IS DELTA RNG1
+                    RANGE -RNG1 * FULL_SCALE .. RNG1 * (FULL_SCALE - 1);
+
+BEGIN TEST ("C45532P", "FIXED POINT OPERATOR ""/""" );
+
+     --------------------------------------------------
+
+     -- CASE A) THE OPERATOR /, A, B, AND A / B ALL MODEL NUMBERS.
+
+A:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_0P5  := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  : FX_0P5 := FX_0P5 (RNG1 / 2);
+          HIGHEST_ACCEPTABLE_VALUE : FX_0P5 := FX_0P5 (RNG1 / 2);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1 * RNG1 / 4);    -- A MODEL NUMBER
+               B := FX_0P5  (RNG1 / 2);           -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B, AND A / B ARE ALL MODEL NUMBERS");
+          END IF;
+     END A;
+
+     --------------------------------------------------
+
+     -- CASE B) THE OPERATOR /, A, B MODEL NUMBERS A / B NOT.
+
+B:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_0P5  := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_0P5
+                                   := FX_0P5 (0.5 * A_THIRD);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_0P5
+                                   := FX_0P5 (0.5 * (A_THIRD + 1) );
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1);               -- A MODEL NUMBER
+               B := FX_1    (3.0);                -- A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_0P5 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN A, B MODEL NUMBERS A / B NOT");
+          END IF;
+     END B;
+
+     --------------------------------------------------
+
+     -- CASE C) THE OPERATOR /, USING NO MODEL NUMBERS
+
+C:   DECLARE
+          A              : FX_RNG1 := 0.0;
+          B              : FX_1    := 0.0;
+          RESULT_VALUE   : FX_1    := 0.0;
+          LOWEST_ACCEPTABLE_VALUE  :  FX_1
+                                   := FX_1 ( RNG1 - 3.0);
+          HIGHEST_ACCEPTABLE_VALUE :  FX_1
+                                   := FX_1 ( RNG1 + 4.0);
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               A := FX_RNG1 (RNG1 * RNG1 / 3);    -- NOT A MODEL NUMBER
+               B := FX_1    (RNG1 / 3);           -- NOT A MODEL NUMBER
+          END IF;
+
+          RESULT_VALUE := FX_1 (A / B);
+
+          IF    (RESULT_VALUE < LOWEST_ACCEPTABLE_VALUE)
+             OR (RESULT_VALUE > HIGHEST_ACCEPTABLE_VALUE) THEN
+               FAILED ("RESULT OF ""/"" OUTSIDE RESULT MODEL INTERVAL "
+                    &  "WHEN USING NO MODEL NUMBERS");
+          END IF;
+     END C;
+
+     --------------------------------------------------
+
+
+     RESULT;
+
+END C45532P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45534b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45534b.ada
new file mode 100644
index 000000000..6c087c3fa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45534b.ada
@@ -0,0 +1,105 @@
+-- C45534B.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 CONSTRAINT_ERROR IS RAISED WHEN A
+--     FIXED POINT VALUE IS DIVIDED BY ZERO (EITHER AN INTEGER ZERO OR
+--     A FIXED POINT ZERO).
+
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     BCB 07/14/88  CREATED ORIGINAL TEST.
+--     MRM 03/30/93  REMOVED NUMERIC ERROR FOR 9X CONSISTENCY
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45534B IS
+
+     TYPE FIX IS DELTA 2.0**(-1) RANGE -2.0 .. 2.0;
+     TYPE FIX2 IS DELTA 2.0**(-1) RANGE -3.0 .. 3.0;
+
+     A : FIX := 1.0;
+     B : FIX;
+     ZERO : FIX := 0.0;
+     ZERO2 : FIX2 := 0.0;
+
+     FUNCTION IDENT_FLT (ONE, TWO : FIX) RETURN BOOLEAN IS
+     BEGIN
+          RETURN ONE = FIX (TWO * FIX (IDENT_INT(1)));
+     END IDENT_FLT;
+
+BEGIN
+     TEST ("C45534B", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                      "A FIXED POINT VALUE IS " &
+                      "DIVIDED BY ZERO (EITHER AN INTEGER ZERO OR A " &
+                      "FIXED POINT ZERO)");
+
+     BEGIN
+          B := A / IDENT_INT (0);
+          FAILED ("NO EXCEPTION RAISED FOR DIVISION BY INTEGER ZERO");
+          IF IDENT_FLT (B,B) THEN
+               COMMENT ("DON'T OPTIMIZE B");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED");
+     END;
+
+     BEGIN
+          B := FIX (A / ZERO);
+          FAILED ("NO EXCEPTION RAISED FOR DIVISION BY FIXED POINT " &
+                  "ZERO - 1");
+          IF IDENT_FLT (B,B) THEN
+               COMMENT ("DON'T OPTIMIZE B");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED");
+      END;
+
+     BEGIN
+          B := FIX (A / ZERO2);
+          FAILED ("NO EXCEPTION RAISED FOR DIVISION BY FIXED POINT " &
+                  "ZERO - 2");
+          IF IDENT_FLT (B,B) THEN
+               COMMENT ("DON'T OPTIMIZE B");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED");
+      END;
+
+     RESULT;
+END C45534B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45536a.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45536a.dep
new file mode 100644
index 000000000..760d43011
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45536a.dep
@@ -0,0 +1,158 @@
+-- C45536A.DEP
+
+--                             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 FIXED POINT MULTIPLICATION AND DIVISION WHEN 'SMALL OF
+--     THE OPERANDS ARE NOT BOTH POWERS OF THE SAME BASE VALUE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     REPRESENTATION CLAUSES FOR 'SMALL WHICH ARE NOT POWERS OF TWO.
+
+--     IF SUCH REPRESENTATION CLAUSES ARE NOT SUPPORTED, THEN THE
+--     REPRESENTATION CLAUSE FOR CHECK_TYPE MUST BE REJECTED.
+
+-- HISTORY:
+--     BCB 02/02/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45536A IS
+
+     TYPE CHECK_TYPE IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
+     FOR CHECK_TYPE'SMALL USE 0.2;                     -- N/A => ERROR.
+
+     TYPE F1 IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
+     FOR F1'SMALL USE 0.5;
+
+     TYPE F2 IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
+     FOR F2'SMALL USE 0.2;
+
+     TYPE F3 IS DELTA 2.0**(-1) RANGE 0.0 .. 8.0;
+     FOR F3'SMALL USE 0.1;
+
+     A : F1;
+     B : F2;
+     C : F3;
+
+     FUNCTION IDENT_FIX(X : F3) RETURN F3 IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN X;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT_FIX;
+
+BEGIN
+     TEST ("C45536A", "CHECK FIXED POINT MULTIPLICATION AND DIVISION " &
+                      "WHEN 'SMALL OF THE OPERANDS ARE NOT BOTH " &
+                      "POWERS OF THE SAME BASE VALUE");
+
+     A := 1.0; B := 1.0; C := F3(A * B);
+
+     IF C /= IDENT_FIX(1.0) THEN
+          FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 1");
+     END IF;
+
+     C := F3(A / B);
+
+     IF C /= IDENT_FIX(1.0) THEN
+          FAILED ("IMPROPER RESULTS FOR DIVISION - 1");
+     END IF;
+
+     A := 1.0; B := 0.3; C := F3(A * B);
+
+     IF C NOT IN IDENT_FIX(0.2) .. IDENT_FIX(0.4) THEN
+          FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 2");
+     END IF;
+
+     B := 0.25; C := F3(A / B);
+
+     IF C NOT IN IDENT_FIX(2.5) .. IDENT_FIX(5.0) THEN
+          FAILED ("IMPROPER RESULTS FOR DIVISION - 2");
+     END IF;
+
+     A := 0.5; B := 0.3; C := F3(A * B);
+
+     IF C NOT IN IDENT_FIX(0.1) .. IDENT_FIX(0.2) THEN
+          FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 3");
+     END IF;
+
+     C := F3(A / B);
+
+     IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(2.5) THEN
+          FAILED ("IMPROPER RESULTS FOR DIVISION - 3");
+     END IF;
+
+     B := 0.3; C := 0.2; A := F1(B * C);
+
+     IF A NOT IN F1(IDENT_FIX(0.0)) .. F1(IDENT_FIX(0.5)) THEN
+          FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 4");
+     END IF;
+
+     A := 1.0; B := 1.6; C := F3(A / B);
+
+     IF C NOT IN IDENT_FIX(0.6) .. IDENT_FIX(0.7) THEN
+          FAILED ("IMPROPER RESULTS FOR DIVISION - 4");
+     END IF;
+
+     A := 0.75; B := 0.4; C := F3(A * B);
+
+     IF C NOT IN IDENT_FIX(0.2) .. IDENT_FIX(0.4) THEN
+          FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 5");
+     END IF;
+
+     A := 0.8; C := F3(A / B);
+
+     IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(2.5) THEN
+          FAILED ("IMPROPER RESULTS FOR DIVISION - 5");
+     END IF;
+
+     A := 0.8; B := 0.4; C := F3(A * B);
+
+     IF C NOT IN IDENT_FIX(0.2) .. IDENT_FIX(0.4) THEN
+          FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 6");
+     END IF;
+
+     A := 0.75; C := F3(A / B);
+
+     IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(2.5) THEN
+          FAILED ("IMPROPER RESULTS FOR DIVISION - 6");
+     END IF;
+
+     A := 0.7; B := 0.3; C := F3(A * B);
+
+     IF C NOT IN IDENT_FIX(0.1) .. IDENT_FIX(0.4) THEN
+          FAILED ("IMPROPER RESULTS FOR MULTIPLICATION - 7");
+     END IF;
+
+     C := F3(A / B);
+
+     IF C NOT IN IDENT_FIX(1.2) .. IDENT_FIX(5.0) THEN
+          FAILED ("IMPROPER RESULTS FOR DIVISION - 7");
+     END IF;
+
+     RESULT;
+END C45536A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c456001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c456001.a
new file mode 100644
index 000000000..9062f93fc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c456001.a
@@ -0,0 +1,91 @@
+-- C456001.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 ACAA 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.
+--
+--                                     Notice
+--
+--    The ACAA has created and maintains the Ada Conformity Assessment Test
+--    Suite for the purpose of conformity assessments conducted in accordance
+--    with the International Standard ISO/IEC 18009 - Ada: Conformity
+--    assessment of a language processor. This test suite should not be used
+--    to make claims of conformance unless used in accordance with
+--    ISO/IEC 18009 and any applicable ACAA procedures.
+--
+--*
+-- OBJECTIVE:
+--     For exponentiation of floating point types, check that
+--       Constraint_Error is raised (or, if no exception is raised and
+--       Machine_Overflows is False, that a result is produced) if the
+--       result is outside of the range of the base type.
+--     This tests digits 5.
+
+-- HISTORY:
+--     04/30/03  RLB  Created test from old C45622A and C45624A.
+
+with Report;
+
+procedure C456001 is
+
+     type Flt is digits 5;
+
+     F : Flt;
+
+     function Equal_Flt (One, Two : Flt) return Boolean is
+         -- Break optimization.
+     begin
+          return One = Two * Flt (Report.Ident_Int(1));
+     end Equal_Flt;
+
+begin
+     Report.Test ("C456001", "For exponentiation of floating point types, " &
+                      "check that Constraint_Error is raised (or, if " &
+                      "if no exception is raised and Machine_Overflows is " &
+                      "False, that a result is produced) if the result is " &
+                      "outside of the range of the base type.");
+
+     begin
+         F := (Flt'Base'Last)**Report.Ident_Int (2);
+         if Flt'Machine_Overflows Then
+             Report.Failed ("Constraint_Error was not raised for " &
+                       "exponentiation");
+         else
+             -- RM95 3.5.6(7) allows disobeying RM95 4.5(10) if
+             -- Machine_Overflows is False.
+             Report.Comment ("Constraint_Error was not raised for " &
+                       "exponentiation and Machine_Overflows is False");
+         end if;
+         if not Equal_Flt (F, F) then
+             -- Optimization breaker, F must be evaluated.
+             Report.Comment ("Don't optimize F");
+         end if;
+     exception
+         when Constraint_Error =>
+             Report.Comment ("Constraint_Error was raised for " &
+                             "exponentiation");
+         when others =>
+             Report.Failed ("An exception other than Constraint_Error " &
+                            "was raised for exponentiation");
+     end;
+
+     Report.Result;
+end C456001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45611a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45611a.ada
new file mode 100644
index 000000000..3f7a690fb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45611a.ada
@@ -0,0 +1,123 @@
+--  C45611A.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 EXPONENTIATION OF AN INTEGER TO AN INTEGER VALUE IS 
+--  CORRECTLY EVALUATED.
+
+--  H. TILTON 9/23/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45611A IS
+
+    I1,INT : INTEGER;
+   
+    BEGIN
+
+ 
+         TEST ("C45611A", "CHECK THAT EXPONENTIATION OF AN INTEGER " &
+                          "VALUE IS CORRECTLY EVALUATED");
+
+         I1 := IDENT_INT(0) ** IDENT_INT(0);
+
+         IF IDENT_INT(I1) /= IDENT_INT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '0**0'" ); 
+         END IF;
+
+         INT := "**" (IDENT_INT(0),IDENT_INT(1));
+
+         IF IDENT_INT(INT) /= IDENT_INT(0) THEN
+              FAILED( "INCORRECT RESULT FOR '0**1'" ); 
+         END IF;
+
+         I1 := IDENT_INT(6) ** IDENT_INT(0);
+
+         IF IDENT_INT(I1) /= IDENT_INT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '6**0'" ); 
+         END IF;
+
+         INT := IDENT_INT(156) ** IDENT_INT(1);
+
+         IF IDENT_INT(INT) /= IDENT_INT(156) THEN
+              FAILED( "INCORRECT RESULT FOR '156**1'" ); 
+         END IF;
+
+         I1 := IDENT_INT(-3) ** IDENT_INT(0);
+
+         IF IDENT_INT(I1) /= IDENT_INT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '(-3)**0'" ); 
+         END IF;
+
+         INT := "**" (IDENT_INT(-7),IDENT_INT(1));
+
+         IF IDENT_INT(INT) /= IDENT_INT(-7) THEN
+              FAILED( "INCORRECT RESULT FOR '(-7)**1'" ); 
+         END IF;
+
+         I1 := "**" (IDENT_INT(-1),IDENT_INT(2));
+
+         IF IDENT_INT(I1) /= IDENT_INT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '(-1)**2'" );
+         END IF;
+  
+  
+         INT := IDENT_INT(-1) ** 3;         
+
+         IF IDENT_INT(INT) /= IDENT_INT(-1) THEN
+              FAILED( "INCORRECT RESULT FOR '(-1)**3'" );
+         END IF;
+  
+         INT := "**" (IDENT_INT(0),IDENT_INT(2));
+
+         IF IDENT_INT(INT) /= IDENT_INT(0) THEN
+              FAILED( "INCORRECT RESULT FOR '0**2'" );
+         END IF;
+
+         INT := IDENT_INT(0) ** IDENT_INT(10);
+
+         IF IDENT_INT(INT) /= IDENT_INT(0) THEN
+              FAILED( "INCORRECT RESULT FOR '0**10'" );
+         END IF;
+  
+         INT := "**" (IDENT_INT(6),IDENT_INT(2));
+
+         IF IDENT_INT(INT) /= IDENT_INT(36) THEN
+              FAILED( "INCORRECT RESULT FOR '6**2'" );
+         END IF;
+  
+         INT := "**" (IDENT_INT(2),IDENT_INT(2));
+
+         IF IDENT_INT(INT) /= IDENT_INT(4) THEN
+              FAILED( "INCORRECT RESULT FOR '2**2'" );
+         END IF;
+
+         I1 := "**" (IDENT_INT(1),IDENT_INT(10));
+
+         IF IDENT_INT(I1) /= IDENT_INT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '1**10'" );
+         END IF;
+        
+         RESULT;
+
+    END C45611A;      
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45611b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45611b.dep
new file mode 100644
index 000000000..fb63ef82e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45611b.dep
@@ -0,0 +1,141 @@
+--  C45611B.DEP
+
+--                             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 EXPONENTIATION OF A SHORT_INTEGER TO AN INTEGER VALUE
+--     IS CORRECTLY EVALUATED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     SHORT_INTEGER.
+
+--     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_SHORT" MUST BE REJECTED.
+
+-- HISTORY:
+--     HTG 09/23/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45611B IS
+
+    CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+
+    I1,INT : SHORT_INTEGER;
+
+    FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+    BEGIN
+         RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
+    END IDENT;
+
+    BEGIN
+
+
+         TEST ("C45611B", "CHECK THAT EXPONENTIATION OF A " &
+                          "SHORT_INTEGER VALUE IS CORRECTLY " &
+                          "EVALUATED");
+
+         I1 := IDENT(0) ** IDENT_INT(0);
+
+         IF IDENT(I1) /= IDENT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '0**0'" );
+         END IF;
+
+         INT := "**" (IDENT(0),IDENT_INT(1));
+
+         IF IDENT(INT) /= IDENT(0) THEN
+              FAILED( "INCORRECT RESULT FOR '0**1'" );
+         END IF;
+
+         I1 := IDENT(6) ** IDENT_INT(0);
+
+         IF IDENT(I1) /= IDENT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '6**0'" );
+         END IF;
+
+         INT := IDENT(15) ** IDENT_INT(1);
+
+         IF IDENT(INT) /= IDENT(15) THEN
+              FAILED( "INCORRECT RESULT FOR '15**1'" );
+         END IF;
+
+         I1 := IDENT(-3) ** IDENT_INT(0);
+
+         IF IDENT(I1) /= IDENT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '(-3)**0'" );
+         END IF;
+
+         INT := "**" (IDENT(-7),IDENT_INT(1));
+
+         IF IDENT(INT) /= IDENT(-7) THEN
+              FAILED( "INCORRECT RESULT FOR '(-7)**1'" );
+         END IF;
+
+         I1 := "**" (IDENT(-1),IDENT_INT(2));
+
+         IF IDENT(I1) /= IDENT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '(-1)**2'" );
+         END IF;
+
+
+         INT := IDENT(-1) ** IDENT_INT(3);
+
+         IF IDENT(INT) /= IDENT(-1) THEN
+              FAILED( "INCORRECT RESULT FOR '(-1)**3'" );
+         END IF;
+
+         INT := "**" (IDENT(0),IDENT_INT(2));
+
+         IF IDENT(INT) /= IDENT(0) THEN
+              FAILED( "INCORRECT RESULT FOR '0**2'" );
+         END IF;
+
+         INT := IDENT(0) ** IDENT_INT(10);
+
+         IF IDENT(INT) /= IDENT(0) THEN
+              FAILED( "INCORRECT RESULT FOR '0**10'" );
+         END IF;
+
+         INT := "**" (IDENT(6),IDENT_INT(2));
+
+         IF IDENT(INT) /= IDENT(36) THEN
+              FAILED( "INCORRECT RESULT FOR '6**2'" );
+         END IF;
+
+         INT := "**" (IDENT(2),IDENT_INT(2));
+
+         IF IDENT(INT) /= IDENT(4) THEN
+              FAILED( "INCORRECT RESULT FOR '2**2'" );
+         END IF;
+
+         I1 := "**" (IDENT(1),IDENT_INT(10));
+
+         IF IDENT(I1) /= IDENT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '1**10'" );
+         END IF;
+
+         RESULT;
+
+    END C45611B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45611c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45611c.dep
new file mode 100644
index 000000000..0687d3a48
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45611c.dep
@@ -0,0 +1,141 @@
+--  C45611C.DEP
+
+--                             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 EXPONENTIATION OF A LONG_INTEGER TO AN INTEGER VALUE
+--     IS CORRECTLY EVALUATED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     LONG_INTEGER.
+
+--     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_LONG" MUST BE REJECTED.
+
+-- HISTORY:
+--     HTG 09/23/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45611C IS
+
+    CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+
+    I1,INT : LONG_INTEGER;
+
+    FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+    BEGIN
+         RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
+    END IDENT;
+
+    BEGIN
+
+
+         TEST ("C45611C", "CHECK THAT EXPONENTIATION OF A " &
+                          "LONG_INTEGER VALUE IS CORRECTLY " &
+                          "EVALUATED");
+
+         I1 := IDENT(0) ** IDENT_INT(0);
+
+         IF IDENT(I1) /= IDENT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '0**0'" );
+         END IF;
+
+         INT := "**" (IDENT(0),IDENT_INT(1));
+
+         IF IDENT(INT) /= IDENT(0) THEN
+              FAILED( "INCORRECT RESULT FOR '0**1'" );
+         END IF;
+
+         I1 := IDENT(6) ** IDENT_INT(0);
+
+         IF IDENT(I1) /= IDENT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '6**0'" );
+         END IF;
+
+         INT := IDENT(156) ** IDENT_INT(1);
+
+         IF IDENT(INT) /= IDENT(156) THEN
+              FAILED( "INCORRECT RESULT FOR '156**1'" );
+         END IF;
+
+         I1 := IDENT(-3) ** IDENT_INT(0);
+
+         IF IDENT(I1) /= IDENT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '(-3)**0'" );
+         END IF;
+
+         INT := "**" (IDENT(-7),IDENT_INT(1));
+
+         IF IDENT(INT) /= IDENT(-7) THEN
+              FAILED( "INCORRECT RESULT FOR '(-7)**1'" );
+         END IF;
+
+         I1 := "**" (IDENT(-1),IDENT_INT(2));
+
+         IF IDENT(I1) /= IDENT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '(-1)**2'" );
+         END IF;
+
+
+         INT := IDENT(-1) ** IDENT_INT(3);
+
+         IF IDENT(INT) /= IDENT(-1) THEN
+              FAILED( "INCORRECT RESULT FOR '(-1)**3'" );
+         END IF;
+
+         INT := "**" (IDENT(0),IDENT_INT(2));
+
+         IF IDENT(INT) /= IDENT(0) THEN
+              FAILED( "INCORRECT RESULT FOR '0**2'" );
+         END IF;
+
+         INT := IDENT(0) ** IDENT_INT(10);
+
+         IF IDENT(INT) /= IDENT(0) THEN
+              FAILED( "INCORRECT RESULT FOR '0**10'" );
+         END IF;
+
+         INT := "**" (IDENT(6),IDENT_INT(2));
+
+         IF IDENT(INT) /= IDENT(36) THEN
+              FAILED( "INCORRECT RESULT FOR '6**2'" );
+         END IF;
+
+         INT := "**" (IDENT(2),IDENT_INT(2));
+
+         IF IDENT(INT) /= IDENT(4) THEN
+              FAILED( "INCORRECT RESULT FOR '2**2'" );
+         END IF;
+
+         I1 := "**" (IDENT(1),IDENT_INT(10));
+
+         IF IDENT(I1) /= IDENT(1) THEN
+              FAILED( "INCORRECT RESULT FOR '1**10'" );
+         END IF;
+
+         RESULT;
+
+    END C45611C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45613a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45613a.ada
new file mode 100644
index 000000000..b539018bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45613a.ada
@@ -0,0 +1,79 @@
+-- C45613A.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
+-- BY "**" FOR INTEGERS WHEN THE RESULT EXCEEDS THE RANGE 
+-- OF THE BASE TYPE.
+
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- H. TILTON 10/06/86
+--      MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45613A IS
+ 
+BEGIN
+     TEST ("C45613A","CHECK THAT CONSTRAINT_ERROR " &
+                     "IS RAISED BY ""**"" FOR INTEGERS WHEN THE " &
+                     "RESULT EXCEEDS THE RANGE OF THE BASE TYPE");
+
+     DECLARE
+          INT : INTEGER;
+     BEGIN
+          INT := IDENT_INT(INTEGER'LAST ** IDENT_INT(2));
+          FAILED ("NO EXCEPTION FOR SECOND POWER OF INTEGER'LAST");
+             
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS => 
+                    FAILED ("WRONG EXCEPTION RAISED FOR " &
+                            "SECOND POWER OF " &
+                            "INTEGER'LAST");
+     END;
+
+     DECLARE
+          INT : INTEGER;
+     BEGIN
+          INT := IDENT_INT(INTEGER'FIRST ** IDENT_INT(3));
+          FAILED ("NO EXCEPTION FOR THIRD POWER OF INTEGER'FIRST");
+               
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR " &
+                            "THIRD POWER OF " &
+                            "INTEGER'FIRST");
+            
+     END;
+
+     RESULT;
+   
+END C45613A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45613b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45613b.dep
new file mode 100644
index 000000000..4ce07cd9d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45613b.dep
@@ -0,0 +1,97 @@
+-- C45613B.DEP
+
+--                             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 CONSTRAINT_ERROR IS RAISED
+--     BY "**" FOR SHORT_INTEGER WHEN THE RESULT EXCEEDS THE RANGE
+--     OF THE BASE TYPE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     SHORT_INTEGER.
+
+--     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_SHORT" MUST BE REJECTED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     HTG 10/06/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45613B IS
+
+    CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+
+    FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+    BEGIN
+         RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
+    END IDENT;
+
+BEGIN
+     TEST ("C45613B","CHECK THAT CONSTRAINT_ERROR " &
+                     "IS RAISED BY ""**"" FOR SHORT_INTEGER WHEN " &
+                     "THE RESULT EXCEEDS THE RANGE OF THE BASE TYPE");
+
+     DECLARE
+          INT : SHORT_INTEGER;
+     BEGIN
+          INT := IDENT(SHORT_INTEGER'LAST ** IDENT_INT(2));
+                 FAILED ("NO EXCEPTION FOR SECOND POWER OF " &
+                         "SHORT_INTEGER'LAST");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR " &
+                            "SECOND POWER OF " &
+                            "SHORT_INTEGER'LAST");
+     END;
+
+     DECLARE
+          INT : SHORT_INTEGER;
+     BEGIN
+          INT := IDENT(SHORT_INTEGER'FIRST ** IDENT_INT(3));
+          FAILED ("NO EXCEPTION FOR THIRD POWER OF " &
+                  "SHORT_INTEGER'FIRST");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR " &
+                            "THIRD POWER OF " &
+                            "SHORT_INTEGER'FIRST");
+
+     END;
+
+     RESULT;
+
+END C45613B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45613c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45613c.dep
new file mode 100644
index 000000000..074d2b352
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45613c.dep
@@ -0,0 +1,97 @@
+-- C45613C.DEP
+
+--                             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 CONSTRAINT_ERROR IS RAISED
+--     BY "**" FOR LONG_INTEGER WHEN THE RESULT EXCEEDS THE RANGE
+--     OF THE BASE TYPE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     LONG_INTEGER.
+
+--     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_LONG" MUST BE REJECTED.
+
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     HTG 10/06/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+--     MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45613C IS
+
+     CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+
+     FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
+     END IDENT;
+
+BEGIN
+     TEST ("C45613C","CHECK THAT CONSTRAINT_ERROR " &
+                     "IS RAISED BY ""**"" FOR LONG_INTEGER WHEN " &
+                     "THE RESULT EXCEEDS THE RANGE OF THE BASE TYPE");
+
+     DECLARE
+          INT : LONG_INTEGER;
+     BEGIN
+          INT := IDENT(LONG_INTEGER'LAST ** IDENT_INT(2));
+          FAILED ("NO EXCEPTION FOR SECOND POWER OF " &
+                  "LONG_INTEGER'LAST");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR " &
+                            "SECOND POWER OF " &
+                            "LONG_INTEGER'LAST");
+     END;
+
+     DECLARE
+          INT : LONG_INTEGER;
+     BEGIN
+          INT := IDENT(LONG_INTEGER'FIRST ** IDENT_INT(3));
+                 FAILED ("NO EXCEPTION FOR THIRD POWER OF " &
+                         "LONG_INTEGER'FIRST");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR " &
+                            "THIRD POWER OF " &
+                            "LONG_INTEGER'FIRST");
+
+     END;
+
+     RESULT;
+
+END C45613C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45614a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45614a.ada
new file mode 100644
index 000000000..9a0d835bd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45614a.ada
@@ -0,0 +1,99 @@
+-- C45614A.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 IF THE EXPONENT VALUE IN 
+-- AN INTEGER EXPONENTIATION IS NEGATIVE.
+-- CHECK BOTH STATIC AND NONSTATIC EXPONENT VALUES.
+
+-- AH  9/29/86
+-- EDS 7/15/98    AVOID OPTIMIZATION
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45614A IS
+     INT : INTEGER :=1;
+     RES : INTEGER :=0;
+BEGIN
+     TEST ("C45614A", "CONSTRAINT_ERROR IS RAISED FOR INTEGERS " & 
+                      "HAVING A NEGATIVE EXPONENT");
+
+     DECLARE
+          E1 : CONSTANT INTEGER := -5;
+     BEGIN
+          RES := INT ** E1;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - E1A " &
+                   INTEGER'IMAGE(RES));
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - E1B");
+     END;
+
+     DECLARE
+          E2 : INTEGER := 5;
+     BEGIN
+          RES := INT ** (-E2);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - E2A " &
+                  INTEGER'IMAGE(RES));
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - E2B");
+     END;
+
+     DECLARE
+          E3 : INTEGER;
+     BEGIN
+          E3 := IDENT_INT(-5);
+          RES := INT ** E3;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - E3A " &
+                  INTEGER'IMAGE(RES));
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - E3B");
+     END;
+
+     DECLARE
+     BEGIN
+          RES := INT ** IDENT_INT(-5);
+          FAILED ("CONSTRAINT_ERROR NOT RAISED - E4A " &
+                  INTEGER'IMAGE(RES));
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - E4B");
+     END;
+
+     RES := IDENT_INT(2);
+     RES := IDENT_INT(RES);
+     RESULT;
+END C45614A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45614b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45614b.dep
new file mode 100644
index 000000000..c96ab3330
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45614b.dep
@@ -0,0 +1,128 @@
+--  C45614B.DEP
+
+--                             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 CONSTRAINT_ERROR IS RAISED BY PREDEFINED SHORT_INTEGER
+--     "**" IF THE SECOND OPERAND HAS A NEGATIVE VALUE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     SHORT_INTEGER.
+
+--     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_SHORT" MUST BE REJECTED.
+
+-- HISTORY:
+--     HTG 10/07/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45614B IS
+
+     CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+
+     FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
+     END IDENT;
+
+BEGIN
+
+     TEST ("C45614B", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                      "PREDEFINED SHORT_INTEGER ""**"" IF THE " &
+                      "SECOND OPERAND HAS A NEGATIVE VALUE");
+
+     DECLARE
+          A : INTEGER := -2;
+          B : SHORT_INTEGER := 3;
+          INT : SHORT_INTEGER := 0;
+     BEGIN
+          INT := IDENT(B ** IDENT_INT(A));
+          FAILED ("NO EXCEPTION FOR '3**(-2)'");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR '3**(-2)'");
+     END;
+
+     DECLARE
+          A : INTEGER := -3;
+          B : SHORT_INTEGER := -5;
+          INT : SHORT_INTEGER := 0;
+     BEGIN
+          INT := IDENT(B ** IDENT_INT(A));
+          FAILED ("NO EXCEPTION FOR '(-5)**(-3)'");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR '(-5)**(-3)'");
+     END;
+
+     DECLARE
+          B : SHORT_INTEGER := 0;
+          INT : SHORT_INTEGER := 0;
+     BEGIN
+          INT := IDENT(B ** IDENT_INT(-3));
+          FAILED ("NO EXCEPTION FOR '0**(-3)");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR '0**(-3)'");
+     END;
+
+     DECLARE
+          INT : SHORT_INTEGER := 0;
+     BEGIN
+          INT := IDENT(-10 ** IDENT_INT(-2));
+          FAILED ("NO EXCEPTION FOR '(-10)**(-2)'");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR '(-10)**(-2)'");
+     END;
+
+     DECLARE
+          INT : SHORT_INTEGER := 0;
+     BEGIN
+          INT := IDENT(6 ** IDENT_INT(-4));
+          FAILED ("NO EXCEPTION FOR '6**(-4)'");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR '6**(-4)'");
+     END;
+
+     RESULT;
+
+END C45614B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45614c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45614c.dep
new file mode 100644
index 000000000..0a60a13b5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45614c.dep
@@ -0,0 +1,125 @@
+-- C45614C.DEP
+
+--                             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 CONSTRAINT_ERROR IS RAISED BY PREDEFINED
+--     LONG_INTEGER "**" IF THE SECOND OPERAND HAS A NEGATIVE
+--     VALUE.
+
+-- APPLICABILITY CRITERIA:
+--     IN ORDER FOR THIS TEST TO BE NOT-APPLICABLE THE COMPILER
+--     MUST REJECT THE USE OF "LONG_INTEGER" AS AN UNDECLARED
+--     IDENTIFIER.
+
+-- HISTORY:
+--     HT  10/07/86  CREATED ORIGINAL TEST.
+--     JET 08/06/87  REMOVED BUG FROM FUNCTION IDENT (X).
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45614C IS
+
+     FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
+     END IDENT;
+
+BEGIN
+
+     TEST ("C45614C", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
+                      "PREDEFINED LONG_INTEGER ""**"" IF THE SECOND " &
+                      "OPERAND HAS A NEGATIVE VALUE");
+
+     DECLARE
+          A : INTEGER := -2;
+          B : LONG_INTEGER := 3;
+          INT : LONG_INTEGER := 0;
+     BEGIN
+          INT := IDENT(B ** IDENT_INT(A));
+          FAILED ("NO EXCEPTION FOR '3**(-2)'");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR '3**(-2)'");
+     END;
+
+     DECLARE
+          A : INTEGER := -3;
+          B : LONG_INTEGER := -5;
+          INT : LONG_INTEGER := 0;
+     BEGIN
+          INT := IDENT(B ** IDENT_INT(A));
+          FAILED ("NO EXCEPTION FOR '(-5)**(-3)'");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR '(-5)**(-3)'");
+     END;
+
+     DECLARE
+          B : LONG_INTEGER := 0;
+          INT : LONG_INTEGER := 0;
+     BEGIN
+          INT := IDENT(B ** IDENT_INT(-3));
+          FAILED ("NO EXCEPTION FOR '0**(-3)");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR '0**(-3)'");
+     END;
+
+     DECLARE
+          INT : LONG_INTEGER := 0;
+     BEGIN
+          INT := IDENT(-10 ** IDENT_INT(-2));
+          FAILED ("NO EXCEPTION FOR '(-10)**(-2)'");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR '(-10)**(-2)'");
+     END;
+
+     DECLARE
+          INT : LONG_INTEGER := 0;
+     BEGIN
+          INT := IDENT(6 ** IDENT_INT(-4));
+          FAILED ("NO EXCEPTION FOR '6**(-4)'");
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR '6**(-4)'");
+     END;
+
+     RESULT;
+
+END C45614C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45622a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45622a.ada
new file mode 100644
index 000000000..42f02045f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45622a.ada
@@ -0,0 +1,83 @@
+-- C45622A.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:
+--     FOR EXPONENTIATION OF FLOATING POINT TYPES, CHECK THAT
+--      CONSTRAINT_ERROR IS RAISED IF
+--     MACHINE_OVERFLOWS IS TRUE AND THE RESULT IS OUTSIDE THE RANGE OF
+--     THE BASE TYPE.  THIS TESTS DIGITS 5.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     BCB 02/09/88  CREATED ORIGINAL TEST.
+--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45622A IS
+
+     TYPE FLT IS DIGITS 5;
+
+     F : FLT;
+
+     FUNCTION EQUAL_FLT (ONE, TWO : FLT) RETURN BOOLEAN IS
+     BEGIN
+          RETURN ONE = TWO * FLT (IDENT_INT(1));
+     END EQUAL_FLT;
+
+BEGIN
+     TEST ("C45622A", "FOR EXPONENTIATION OF FLOATING POINT TYPES, " &
+                      "CHECK THAT CONSTRAINT_ERROR " &
+                      "IS RAISED IF MACHINE_OVERFLOWS IS TRUE AND " &
+                      "THE RESULT IS OUTSIDE THE RANGE OF THE BASE " &
+                      "TYPE.  THIS TESTS DIGITS 5");
+
+     IF FLT'MACHINE_OVERFLOWS THEN
+          BEGIN
+               F := (FLT'BASE'LAST)**IDENT_INT (2);
+               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED FOR " &
+                       "EXPONENTIATION");
+
+               IF NOT EQUAL_FLT(F,F) THEN
+                    COMMENT ("DON'T OPTIMIZE F");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR WAS RAISED FOR " &
+                             "EXPONENTIATION");
+               WHEN OTHERS =>
+                    FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                            "WAS RAISED FOR EXPONENTIATION");
+          END;
+     ELSE
+          NOT_APPLICABLE ("THIS TEST IS NOT APPLICABLE DUE TO " &
+                          "MACHINE_OVERFLOWS BEING FALSE");
+     END IF;
+
+     RESULT;
+END C45622A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45624a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45624a.ada
new file mode 100644
index 000000000..32ba4c07a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45624a.ada
@@ -0,0 +1,86 @@
+-- C45624A.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:
+--     FOR FLOATING POINT TYPES, CHECK THAT CONSTRAINT_ERROR
+--     IS RAISED IF THE RESULT OF A FLOATING POINT
+--     EXPONENTIATION IS OUTSIDE THE RANGE OF THE BASE TYPE AND
+--     MACHINE_OVERFLOWS IS FALSE.  THIS TESTS DIGITS 5.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     BCB 02/09/88  CREATED ORIGINAL TEST.
+--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45624A IS
+
+     TYPE FLT IS DIGITS 5;
+
+     F : FLT;
+
+     FUNCTION EQUAL_FLT (ONE, TWO : FLT) RETURN BOOLEAN IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN ONE = TWO;
+          ELSE
+               RETURN ONE /= TWO;
+          END IF;
+     END EQUAL_FLT;
+
+BEGIN
+     TEST ("C45624A", "FOR FLOATING POINT TYPES, CHECK THAT " &
+                      "CONSTRAINT_ERROR IS RAISED " &
+                      "IF MACHINE_OVERFLOWS IS FALSE.  THIS TESTS " &
+                      "DIGITS 5");
+
+     IF FLT'MACHINE_OVERFLOWS THEN
+          NOT_APPLICABLE ("THIS TEST IS NOT APPLICABLE DUE TO " &
+                          "MACHINE_OVERFLOWS BEING TRUE");
+     ELSE
+          BEGIN
+               F := FLT'BASE'FIRST**IDENT_INT (2);
+               COMMENT ("CONSTRAINT_ERROR WAS NOT RAISED WHEN " &
+                         "MACHINE_OVERFLOWS WAS FALSE");
+
+               IF EQUAL_FLT(F,F**IDENT_INT(1)) THEN
+                    COMMENT ("DON'T OPTIMIZE F");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR WAS RAISED WHEN " &
+                             "MACHINE_OVERFLOWS WAS FALSE");
+               WHEN OTHERS =>
+                    FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                            "WAS RAISED");
+          END;
+     END IF;
+
+     RESULT;
+END C45624A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45624b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45624b.ada
new file mode 100644
index 000000000..c7bd592d6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45624b.ada
@@ -0,0 +1,81 @@
+-- C45624B.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:
+--     FOR FLOATING POINT TYPES, CHECK THAT
+--     CONSTRAINT_ERROR IS RAISED IF THE RESULT OF A FLOATING POINT
+--     EXPONENTIATION IS OUTSIDE THE RANGE OF THE BASE TYPE AND
+--     MACHINE_OVERFLOWS IS FALSE.  THIS TESTS DIGITS 6.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     BCB 07/14/88  CREATED ORIGINAL TEST.
+--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45624B IS
+
+     TYPE FLT IS DIGITS 6;
+
+     F : FLT;
+
+     FUNCTION EQUAL_FLT (ONE, TWO : FLT) RETURN BOOLEAN IS
+     BEGIN
+          RETURN ONE = TWO * FLT (IDENT_INT(1));
+     END EQUAL_FLT;
+
+BEGIN
+     TEST ("C45624B", "FOR FLOATING POINT TYPES, CHECK THAT " &
+                      "CONSTRAINT_ERROR IS RAISED " &
+                      "IF MACHINE_OVERFLOWS IS FALSE.  THIS TESTS " &
+                      "DIGITS 6");
+
+     IF FLT'MACHINE_OVERFLOWS THEN
+          NOT_APPLICABLE ("THIS TEST IS NOT APPLICABLE DUE TO " &
+                          "MACHINE_OVERFLOWS BEING TRUE");
+     ELSE
+          BEGIN
+               F := FLT'BASE'LAST**IDENT_INT (2);
+               COMMENT ("CONSTRAINT_ERROR WAS NOT RAISED WHEN " &
+                        "MACHINE_OVERFLOWS WAS FALSE");
+               IF NOT EQUAL_FLT(F,F**IDENT_INT(1)) THEN
+                    COMMENT ("DON'T OPTIMIZE F");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR WAS RAISED WHEN " &
+                             "MACHINE_OVERFLOWS WAS FALSE");
+               WHEN OTHERS =>
+                    FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
+                            "WAS RAISED");
+          END;
+     END IF;
+
+     RESULT;
+END C45624B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45631a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45631a.ada
new file mode 100644
index 000000000..43f794abc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45631a.ada
@@ -0,0 +1,98 @@
+-- C45631A.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 TYPE INTEGER 'ABS A' EQUALS A IF A IS POSITIVE AND 
+-- EQUALS -A IF A IS NEGATIVE.
+
+-- RJW 2/10/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45631A IS
+     
+BEGIN
+
+     TEST ( "C45631A", "CHECK THAT FOR TYPE INTEGER 'ABS A' " &
+                       "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " & 
+                       "A IS NEGATIVE" );
+
+     DECLARE 
+     
+          P : INTEGER := IDENT_INT (1);
+          N : INTEGER := IDENT_INT (-1);
+          Z : INTEGER := IDENT_INT (0);
+     BEGIN 
+
+          IF ABS P = P THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR P - 1" );
+          END IF;
+
+          IF ABS N = -N THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR N - 1" );
+          END IF;
+
+          IF ABS Z = Z THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS TEST FOR Z - 1" );
+          END IF;
+
+          IF ABS (Z) = -Z THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS TEST FOR Z - 2");
+          END IF;
+
+          IF "ABS" (RIGHT => P) = P THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR P - 2" );
+          END IF;
+
+          IF "ABS" (N) = -N THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR N - 2 " );
+          END IF;
+
+          IF "ABS" (Z) = Z THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR Z - 3" );
+          END IF;
+         
+          IF ABS (IDENT_INT (-INTEGER'LAST)) = INTEGER'LAST THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR -INTEGER'LAST" );
+          END IF;
+     END; 
+
+     RESULT;
+
+END C45631A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45631b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45631b.dep
new file mode 100644
index 000000000..750ea210d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45631b.dep
@@ -0,0 +1,116 @@
+-- C45631B.DEP
+
+--                             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 FOR TYPE SHORT_INTEGER 'ABS A' EQUALS A IF A IS
+--     POSITIVE AND EQUALS -A IF A IS NEGATIVE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     SHORT_INTEGER.
+
+--     IF "SHORT_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_SHORT" MUST BE REJECTED.
+
+-- HISTORY:
+--     RJW 02/26/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45631B IS
+
+     CHECK_SHORT : SHORT_INTEGER;                   -- N/A => ERROR.
+
+     FUNCTION IDENT (X : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          RETURN SHORT_INTEGER (IDENT_INT (INTEGER (X)));
+     END IDENT;
+
+BEGIN
+
+     TEST ( "C45631B", "CHECK THAT FOR TYPE SHORT_INTEGER 'ABS A' " &
+                       "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " &
+                       "A IS NEGATIVE" );
+
+     DECLARE
+
+          P : SHORT_INTEGER := IDENT (1);
+          N : SHORT_INTEGER := IDENT (-1);
+          Z : SHORT_INTEGER := IDENT (0);
+     BEGIN
+
+          IF ABS P = P THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR P - 1" );
+          END IF;
+
+          IF ABS N = -N THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR N - 1" );
+          END IF;
+
+          IF ABS Z = Z THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS TEST FOR Z - 1" );
+          END IF;
+
+          IF ABS (Z) = -Z THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS TEST FOR Z - 2");
+          END IF;
+
+          IF "ABS" (RIGHT => P) = P THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR P - 2" );
+          END IF;
+
+          IF "ABS" (N) = -N THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR N - 2 " );
+          END IF;
+
+          IF "ABS" (Z) = Z THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR Z - 3" );
+          END IF;
+
+          IF ABS (IDENT (-SHORT_INTEGER'LAST)) = SHORT_INTEGER'LAST
+             THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR -SHORT_INTEGER'LAST" );
+          END IF;
+     END;
+
+     RESULT;
+
+END C45631B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45631c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45631c.dep
new file mode 100644
index 000000000..2d47637ab
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45631c.dep
@@ -0,0 +1,122 @@
+-- C45631C.DEP
+
+--                             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 FOR TYPE LONG_INTEGER 'ABS A' EQUALS A IF A IS
+--     POSITIVE AND EQUALS -A IF A IS NEGATIVE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT
+--     LONG_INTEGER.
+
+--     IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF
+--     "CHECK_LONG" MUST BE REJECTED.
+
+-- HISTORY:
+--     RJW 02/26/86 CREATED ORIGINAL TEST.
+--     DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45631C IS
+
+     CHECK_LONG : LONG_INTEGER;                      -- N/A => ERROR.
+
+     FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          IF X >= LONG_INTEGER (INTEGER'FIRST) AND
+             X <= LONG_INTEGER (INTEGER'LAST) THEN
+               RETURN LONG_INTEGER (IDENT_INT (INTEGER (X)));
+          ELSIF EQUAL (3, 3) THEN
+               RETURN X;
+          END IF;
+          RETURN 0;
+     END IDENT;
+
+BEGIN
+
+     TEST ( "C45631C", "CHECK THAT FOR TYPE LONG_INTEGER 'ABS A' " &
+                       "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " &
+                       "A IS NEGATIVE" );
+
+     DECLARE
+
+          P : LONG_INTEGER := IDENT (1);
+          N : LONG_INTEGER := IDENT (-1);
+          Z : LONG_INTEGER := IDENT (0);
+     BEGIN
+
+          IF ABS P = P THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR P - 1" );
+          END IF;
+
+          IF ABS N = -N THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR N - 1" );
+          END IF;
+
+          IF ABS Z = Z THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS TEST FOR Z - 1" );
+          END IF;
+
+          IF ABS (Z) = -Z THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS TEST FOR Z - 2");
+          END IF;
+
+          IF "ABS" (RIGHT => P) = P THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR P - 2" );
+          END IF;
+
+          IF "ABS" (N) = -N THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR N - 2 " );
+          END IF;
+
+          IF "ABS" (Z) = Z THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR Z - 3" );
+          END IF;
+
+          IF ABS (IDENT (-LONG_INTEGER'LAST)) = LONG_INTEGER'LAST
+             THEN
+               NULL;
+          ELSE
+               FAILED ( "'ABS' TEST FOR -LONG_INTEGER'LAST" );
+          END IF;
+     END;
+
+     RESULT;
+
+END C45631C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45632a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45632a.ada
new file mode 100644
index 000000000..399188eb0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45632a.ada
@@ -0,0 +1,76 @@
+-- C45632A.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 FOR PREDEFINED TYPE INTEGER, CONSTRAINT_ERROR
+--     IS RAISED FOR ABS (INTEGER'FIRST) IF
+--     -INTEGER'LAST > INTEGER'FIRST.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     RJW 02/10/86  CREATED ORIGINAL TEST.
+--     JET 12/30/87  UPDATED HEADER FORMAT AND ADDED CODE TO
+--                   PREVENT OPTIMIZATION.
+--     MRM 03/30/93  REMOVED NUMERIC ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45632A IS
+
+     I : INTEGER := IDENT_INT (INTEGER'FIRST);
+
+BEGIN
+
+     TEST ( "C45632A", "CHECK THAT FOR PREDEFINED TYPE INTEGER " &
+                       "CONSTRAINT_ERROR IS RAISED " &
+                       "FOR ABS (INTEGER'FIRST) IF -INTEGER'LAST > " &
+                       "INTEGER'FIRST" );
+
+     BEGIN
+          IF - INTEGER'LAST > INTEGER'FIRST THEN
+               BEGIN
+                    IF EQUAL (ABS I, I) THEN
+                         NULL;
+                    ELSE
+                         FAILED ( "WRONG RESULT FOR ABS" );
+                    END IF;
+                    FAILED ( "EXCEPTION NOT RAISED" );
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         COMMENT ( "CONSTRAINT_ERROR RAISED" );
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED" );
+               END;
+          ELSE
+               COMMENT ( "-INTEGER'LAST <= INTEGER'FIRST" );
+          END IF;
+     END;
+
+     RESULT;
+
+END C45632A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45632b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45632b.dep
new file mode 100644
index 000000000..fdf33713a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45632b.dep
@@ -0,0 +1,94 @@
+-- C45632B.DEP
+
+--                             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 FOR PREDEFINED TYPE SHORT_INTEGER,
+--     CONSTRAINT_ERROR IS RAISED FOR ABS (SHORT_INTEGER'FIRST)
+--     IF -SHORT_INTEGER'LAST > SHORT_INTEGER'FIRST.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+--     THE PREDEFINED TYPE "SHORT_INTEGER".
+
+--     IF SUCH A TYPE IS NOT SUPPORTED, THEN THE DECLARATION OF THE
+--     VARIABLE "TEST_VAR" MUST BE REJECTED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     RJW 02/20/86  CREATED ORIGINAL TEST.
+--     JET 12/30/87  UPDATED HEADER FORMAT, ADDED CODE TO DEFEAT
+--                   OPTIMIZATION.
+--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45632B IS
+
+     TEST_VAR : SHORT_INTEGER;               -- N/A => ERROR.
+     I : SHORT_INTEGER;
+
+     FUNCTION IDENT_SHORT (A : SHORT_INTEGER) RETURN SHORT_INTEGER IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN A;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT_SHORT;
+
+BEGIN
+
+     TEST ( "C45632B", "CHECK THAT FOR PREDEFINED TYPE " &
+                       "SHORT_INTEGER CONSTRAINT_ERROR IS RAISED FOR " &
+                       "ABS (SHORT_INTEGER'FIRST) IF " &
+                       "-SHORT_INTEGER'LAST > SHORT_INTEGER'FIRST");
+
+     BEGIN
+          I := IDENT_SHORT (SHORT_INTEGER'FIRST);
+
+          IF -SHORT_INTEGER'LAST > SHORT_INTEGER'FIRST THEN
+               BEGIN
+                    IF IDENT_SHORT (ABS I) = IDENT_SHORT (I) THEN
+                         FAILED ("NO EXCEPTION -- EQUALITY TRUE");
+                    ELSE
+                         FAILED ("NO EXCEPTION -- EQUALITY FALSE");
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         COMMENT ( "CONSTRAINT_ERROR RAISED" );
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED" );
+               END;
+          ELSE
+               COMMENT ( "-SHORT_INTEGER'LAST <= SHORT_INTEGER'FIRST");
+          END IF;
+     END;
+
+     RESULT;
+
+END C45632B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45632c.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45632c.dep
new file mode 100644
index 000000000..72564bf5b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45632c.dep
@@ -0,0 +1,94 @@
+-- C45632C.DEP
+
+--                             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 FOR PREDEFINED TYPE LONG_INTEGER,
+--     CONSTRAINT_ERROR IS RAISED FOR ABS (LONG_INTEGER'FIRST)
+--     IF -LONG_INTEGER'LAST > LONG_INTEGER'FIRST.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+--     THE USE OF "LONG_INTEGER" AS A PREDEFINED DATA TYPE.
+
+--     IF SUCH A TYPE IS NOT SUPPORTED, THEN THE DECLARATION OF THE
+--     VARIABLE "TEST_VAR" MUST BE REJECTED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     RJW 02/20/86  CREATED ORIGINAL TEST.
+--     JET 12/30/87  UPDATED HEADER FORMAT, ADDED CODE TO DEFEAT
+--                   OPTIMIZATION.
+--     MRM 03/30/93  REMOVED NUMERIC ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C45632C IS
+
+     TEST_VAR : LONG_INTEGER;                  -- N/A => ERROR.
+
+     FUNCTION IDENT_LONG (A : LONG_INTEGER) RETURN LONG_INTEGER IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN A;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT_LONG;
+
+BEGIN
+
+     TEST ( "C45632C", "CHECK THAT FOR PREDEFINED TYPE " &
+                       "LONG_INTEGER CONSTRAINT_ERROR IS RAISED FOR " &
+                       "ABS (LONG_INTEGER'FIRST) IF " &
+                       "-LONG_INTEGER'LAST > LONG_INTEGER'FIRST" );
+
+     BEGIN
+          IF - LONG_INTEGER'LAST > LONG_INTEGER'FIRST THEN
+               DECLARE
+                    I : LONG_INTEGER := IDENT_LONG(LONG_INTEGER'FIRST);
+               BEGIN
+                    IF IDENT_LONG(ABS I) = IDENT_LONG(I) THEN
+                         FAILED ("NO EXCEPTION -- EQUALITY TRUE");
+                    ELSE
+                         FAILED ("NO EXCEPTION -- EQUALITY FALSE");
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         COMMENT ( "CONSTRAINT_ERROR RAISED" );
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED" );
+               END;
+          ELSE
+               COMMENT ( "-LONG_INTEGER'LAST <= " &
+                         "LONG_INTEGER'FIRST" );
+          END IF;
+     END;
+
+     RESULT;
+
+END C45632C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45651a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45651a.ada
new file mode 100644
index 000000000..c568b843b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45651a.ada
@@ -0,0 +1,246 @@
+-- C45651A.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:
+--     FOR FIXED POINT TYPES, CHECK:
+--          (A) FOR MODEL NUMBERS A >= 0.0, THAT ABS A = A.
+--          (B) FOR MODEL NUMBERS A <= 0.0. THAT ABS A = -A.
+--          (C) FOR NON-MODEL NUMBERS A > 0.0, THAT ABS A VALUES ARE
+--              WITHIN THE APPROPRIATE MODEL INTERVAL.
+--          (D) FOR NON-MODEL NUMBERS A < 0.0, THAT ABS A VALUES ARE
+--              WITHIN THE APPROPRIATE MODEL INTERVAL.
+
+--     CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF
+--     DURATION'BASE.
+
+-- HISTORY:
+--     WRG 9/11/86
+--     PWB 3/31/88  CHANGED RANGE FOR MEMBERSHIP TEST INVOLVING
+--                  ABS (DECIMAL_M4'FIRST + DECIMAL_M4'SMALL / 2).
+--     RJW 8/21/89  REMOVED CHECKS INVOLVING HARD-CODED FIXED-POINT
+--                  UPPER BOUNDS WHICH WERE INCORRECT FOR SOME
+--                  IMPLEMENTATIONS.  REVISED HEADER.
+--     PWN 02/02/95 REMOVED INCONSISTENCIES WITH ADA 9X.
+--     KAS 11/14/95 REMOVED CASES THAT DEPEND ON SPECIFIC VALUE FOR 'SMALL
+--     TMB 11/19/94 REMOVED CASES RELATING TO 3.5.9(8) RULES - SMALL
+--                  MAY BE LESS THAN OR EQUAL TO DELTA FOR FIXED POINT.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C45651A IS
+
+     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
+     -- 'MANTISSA VALUE.
+
+BEGIN
+
+     TEST ("C45651A", "CHECK THAT, FOR FIXED POINT TYPES, THE ABS " &
+                      "OPERATOR PRODUCES CORRECT RESULTS - BASIC " &
+                      "TYPES");
+
+     -------------------------------------------------------------------
+
+A:   DECLARE
+          TYPE LIKE_DURATION_M23 IS DELTA 0.020
+               RANGE -86_400.0 .. 86_400.0;
+
+          NON_MODEL_CONST : CONSTANT          := 2.0 / 3;
+          NON_MODEL_VAR   : LIKE_DURATION_M23 := 0.0;
+
+          SMALL, MAX, MIN, ZERO : LIKE_DURATION_M23 := 0.5;
+          X                     : LIKE_DURATION_M23 := 1.0;
+     BEGIN
+          -- INITIALIZE "CONSTANTS":
+          IF EQUAL (3, 3) THEN
+               SMALL         := LIKE_DURATION_M23'SMALL;
+               MAX           := LIKE_DURATION_M23'LAST;
+               MIN           := LIKE_DURATION_M23'FIRST;
+               ZERO          := 0.0;
+               NON_MODEL_VAR := NON_MODEL_CONST;
+          END IF;
+
+          -- (A)
+          IF EQUAL (3, 3) THEN
+               X := SMALL;
+          END IF;
+          IF ABS X /= SMALL OR X /= ABS LIKE_DURATION_M23'SMALL THEN
+               FAILED ("ABS (1.0 / 64) /= (1.0 / 64)");
+          END IF;
+          IF EQUAL (3, 3) THEN
+               X := MAX;
+          END IF;
+          IF ABS X /= MAX OR X /= ABS LIKE_DURATION_M23'LAST THEN
+               FAILED ("ABS 86_400.0 /= 86_400.0");
+          END IF;
+
+          -- (B)
+          IF EQUAL (3, 3) THEN
+               X := -SMALL;
+          END IF;
+          IF ABS X /= SMALL OR
+             ABS (-LIKE_DURATION_M23'SMALL) /= SMALL THEN
+               FAILED ("ABS -(1.0 / 64) /= (1.0 / 64)");
+          END IF;
+          IF EQUAL (3, 3) THEN
+               X := MIN;
+          END IF;
+          IF ABS X /= MAX OR ABS LIKE_DURATION_M23'FIRST /= MAX THEN
+               FAILED ("ABS -86_400.0 /= 86_400.0");
+          END IF;
+
+          -- (A) AND (B)
+          IF EQUAL (3, 3) THEN
+               X := 0.0;
+          END IF;
+          IF "ABS" (RIGHT => X) /= ZERO OR X /= ABS 0.0 THEN
+               FAILED ("ABS 0.0 /= 0.0 -- (LIKE_DURATION_M23)");
+          END IF;
+
+          -- CHECK THAT VALUE OF NON_MODEL_VAR IS IN THE RANGE
+          -- 42 * 'SMALL .. 43 * 'SMALL:
+          IF NON_MODEL_VAR NOT IN 0.65625 .. 0.671875 THEN
+               FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE " &
+                       "- A");
+          END IF;
+
+          -- (C)
+          IF ABS NON_MODEL_VAR NOT IN 0.65625 .. 0.671875 OR
+             ABS LIKE_DURATION_M23'(NON_MODEL_CONST) NOT IN
+                 0.65625 .. 0.671875 THEN
+               FAILED ("ABS (2.0 / 3) NOT IN CORRECT RANGE - A");
+          END IF;
+          IF EQUAL (3, 3) THEN
+               X := 86_399.992_187_5;  -- LIKE_DURATION_M23'LAST -
+                                       -- 1.0 / 128.
+          END IF;
+          IF ABS X NOT IN 86_399.984_375 .. 86_400.0 OR
+             ABS (LIKE_DURATION_M23'LAST - LIKE_DURATION_M23'SMALL / 2)
+                 NOT IN 86_399.984_375 .. 86_400.0 THEN
+               FAILED ("ABS (LIKE_DURATION_M23'LAST - " &
+                       "LIKE_DURATION_M23'SMALL / 2) NOT IN CORRECT " &
+                       "RANGE");
+          END IF;
+
+          -- (D)
+          IF EQUAL (3, 3) THEN
+               X := -NON_MODEL_CONST;
+          END IF;
+          IF ABS X NOT IN 0.65625 .. 0.671875 OR
+             ABS (-LIKE_DURATION_M23'(NON_MODEL_CONST)) NOT IN
+                 0.65625 .. 0.671875 THEN
+               FAILED ("ABS (-2.0 / 3) NOT IN CORRECT RANGE - A");
+          END IF;
+          IF EQUAL (3, 3) THEN
+               X := -86_399.992_187_5;  -- LIKE_DURATION_M23'FIRST +
+                                        -- 1.0 / 128.
+          END IF;
+          IF ABS X NOT IN 86_399.984_375 .. 86_400.0 OR
+             ABS (LIKE_DURATION_M23'FIRST + LIKE_DURATION_M23'SMALL / 2)
+                 NOT IN 86_399.984_375 .. 86_400.0 THEN
+               FAILED ("ABS (LIKE_DURATION_M23'FIRST +" &
+                       "LIKE_DURATION_M23'SMALL / 2) NOT IN CORRECT " &
+                       "RANGE");
+          END IF;
+     END A;
+
+     -------------------------------------------------------------------
+
+B:   DECLARE
+          TYPE DECIMAL_M4 IS DELTA 100.0 RANGE -1000.0 .. 1000.0;
+
+          NON_MODEL_CONST : CONSTANT   := 2.0 / 3;
+          NON_MODEL_VAR   : DECIMAL_M4 := 0.0;
+
+          SMALL, MAX, MIN, ZERO : DECIMAL_M4 := 128.0;
+          X                     : DECIMAL_M4 :=   0.0;
+     BEGIN
+          -- INITIALIZE "CONSTANTS":
+          IF EQUAL (3, 3) THEN
+               SMALL         :=  DECIMAL_M4'SMALL;
+               ZERO          :=  0.0;
+               NON_MODEL_VAR := NON_MODEL_CONST;
+          END IF;
+
+          -- (A)
+          IF EQUAL (3, 3) THEN
+               X := SMALL;
+          END IF;
+          IF ABS X /= SMALL OR X /= ABS DECIMAL_M4'SMALL THEN
+               FAILED ("ABS 64.0 /= 64.0");
+          END IF;
+
+          -- (B)
+          IF EQUAL (3, 3) THEN
+               X := -SMALL;
+          END IF;
+          IF ABS X /= SMALL OR ABS (-DECIMAL_M4'SMALL) /= SMALL THEN
+               FAILED ("ABS -64.0 /= 64.0");
+          END IF;
+
+          -- (A) AND (B)
+          IF EQUAL (3, 3) THEN
+               X := 0.0;
+          END IF;
+          IF ABS X /= ZERO OR X /= ABS 0.0 THEN
+               FAILED ("ABS 0.0 /= 0.0 -- (DECIMAL_M4)");
+          END IF;
+
+          -- CHECK THE VALUE OF NON_MODEL_VAR:
+          IF NON_MODEL_VAR NOT IN 0.0 .. 64.0 THEN
+               FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE " &
+                       "- B");
+          END IF;
+
+          -- (C)
+          IF ABS NON_MODEL_VAR NOT IN 0.0 .. 64.0 OR
+             ABS DECIMAL_M4'(NON_MODEL_CONST) NOT IN 0.0 .. 64.0 THEN
+               FAILED ("ABS (2.0 / 3) NOT IN CORRECT RANGE - B");
+          END IF;
+          IF EQUAL (3, 3) THEN
+               X := 37.0;  -- INTERVAL IS 0.0 .. 64.0.
+          END IF;
+          IF EQUAL (3, 3) THEN
+               X := 928.0;
+          END IF;
+
+          -- (D)
+          IF EQUAL (3, 3) THEN
+               X := -NON_MODEL_CONST;
+          END IF;
+          IF ABS X NOT IN 0.0 .. 64.0 OR
+             ABS (-DECIMAL_M4'(NON_MODEL_CONST)) NOT IN 0.0 .. 64.0 THEN
+               FAILED ("ABS -(2.0 / 3) NOT IN CORRECT RANGE - B");
+          END IF;
+          IF EQUAL (3, 3) THEN
+               X := -37.0;  -- INTERVAL IS -SMALL .. 0.0.
+          END IF;
+          IF EQUAL (3, 3) THEN
+               X := -928.0;
+          END IF;
+     END B;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+
+END C45651A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45662a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45662a.ada
new file mode 100644
index 000000000..bf23598e3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45662a.ada
@@ -0,0 +1,105 @@
+-- C45662A.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 TRUTH TABLE FOR  'NOT' .
+
+-- THE COMBINATIONS OF  'NOT'  WITH  'AND' , 'OR' , 'XOR'  ARE TESTED
+--    IN C45101(A,G).
+
+
+-- RM    28 OCTOBER 1980
+-- TBN 10/21/85     RENAMED FROM C45401A.ADA.
+
+
+WITH  REPORT ;
+PROCEDURE  C45662A  IS
+
+     USE REPORT;
+
+     TVAR , FVAR , CVAR : BOOLEAN := FALSE ; -- INITIAL VALUE IRRELEVANT
+     ERROR_COUNT : INTEGER := 0 ;            -- INITIAL VALUE ESSENTIAL
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          ERROR_COUNT  :=  ERROR_COUNT + 1 ;
+     END BUMP ;
+
+BEGIN
+
+     TEST( "C45662A" , "CHECK THE TRUTH TABLE FOR  'NOT'" ) ;
+
+     FOR  A  IN  BOOLEAN  LOOP
+
+          CVAR  :=  NOT A ;
+
+          IF  NOT A  THEN
+               IF  A  THEN  BUMP ;
+               END IF ;
+          END IF;
+
+          IF  CVAR  THEN
+               IF  A  THEN  BUMP ;
+               END IF ;
+          END IF;
+
+          IF  NOT( NOT( NOT( NOT(   CVAR   ))))
+          THEN
+               IF  A  THEN  BUMP ;
+               END IF ;
+          END IF;
+
+     END LOOP ;
+
+     FOR  I  IN  1..2  LOOP
+
+          CVAR  :=  NOT ( I > 1 ) ;
+
+          IF  NOT ( I > 1 )  THEN
+               IF  I>1  THEN  BUMP ;
+               END IF ;
+          END IF;
+
+          IF  CVAR  THEN
+               IF  I>1  THEN  BUMP ;
+               END IF ;
+          END IF;
+
+     END LOOP ;
+
+     IF  NOT TRUE   THEN  BUMP ;                END IF ;
+     IF  NOT FALSE  THEN  NULL ;  ELSE  BUMP ;  END IF ;
+
+     TVAR := IDENT_BOOL( TRUE );
+     FVAR := IDENT_BOOL( FALSE );
+
+     IF  NOT TVAR  THEN  BUMP ;                END IF ;
+     IF  NOT FVAR  THEN  NULL ;  ELSE  BUMP ;  END IF ;
+
+
+     IF  ERROR_COUNT  /= 0  THEN  FAILED( "'NOT' TRUTH TABLE" );
+     END IF ;
+
+     RESULT;
+
+END C45662A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45662b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45662b.ada
new file mode 100644
index 000000000..7feb6a655
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45662b.ada
@@ -0,0 +1,120 @@
+-- C45662B.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 TRUTH TABLE FOR  'NOT'  ON DERIVED-BOOLEAN-TYPE OPERANDS.
+
+-- THE COMBINATIONS OF  'NOT'  WITH  'AND' , 'OR' , 'XOR'  ARE TESTED
+--    IN C45101K.
+
+
+-- RM    28 OCTOBER 1980
+-- TBN 10/21/85     RENAMED FROM C45401B-AB.ADA.  REMOVED DUPLICATED
+--                  CODE NEAR END.
+
+WITH  REPORT; USE REPORT;
+PROCEDURE  C45662B  IS
+
+     TYPE  NB  IS  NEW BOOLEAN ;
+
+     TVAR , FVAR , CVAR : NB := NB'(FALSE) ; -- INITIAL VALUE IRRELEVANT
+     ERROR_COUNT : INTEGER := 0 ;            -- INITIAL VALUE ESSENTIAL
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          ERROR_COUNT := ERROR_COUNT + 1 ;
+     END BUMP ;
+
+     FUNCTION  IDENT_NEW_BOOL( THE_ARGUMENT : NB )  RETURN  NB  IS
+     BEGIN
+          IF  EQUAL(2,2)  THEN  RETURN THE_ARGUMENT;
+          ELSE  RETURN  NB'(FALSE) ;
+          END IF;
+     END ;
+
+
+BEGIN
+
+     TEST( "C45662B" , "CHECK THE TRUTH TABLE FOR  'NOT'" &
+                       " ON DERIVED-BOOLEAN-TYPE OPERANDS" ) ;
+
+     FOR  A  IN  NB  LOOP
+
+          CVAR  :=  NOT A ;
+
+          IF  BOOLEAN( NOT A )  THEN
+               IF  BOOLEAN( A )  THEN  BUMP ;
+               END IF ;
+          END IF;
+
+          IF  BOOLEAN( CVAR )  THEN
+               IF  BOOLEAN( A )  THEN  BUMP ;
+               END IF ;
+          END IF;
+
+          IF  BOOLEAN(
+
+              NOT( NOT( NOT( NOT( NOT(
+              NOT( NOT( NOT( NOT( NOT(
+              NOT( NOT( NOT( NOT( NOT(
+              NOT( NOT( NOT( NOT( NOT(   CVAR  ))))) ))))) ))))) )))))
+                      )
+          THEN
+               IF  BOOLEAN( A )  THEN  BUMP ;
+               END IF ;
+          END IF;
+
+     END LOOP ;
+
+     FOR  I  IN  1..2  LOOP
+
+          CVAR  :=  NOT( NB( I > 1 ) ) ;
+
+          IF  BOOLEAN(  NOT(  NB( I > 1 )))  THEN
+               IF  I>1  THEN  BUMP ;
+               END IF ;
+          END IF;
+
+          IF  BOOLEAN( CVAR )  THEN
+               IF  I>1  THEN  BUMP ;
+               END IF ;
+          END IF;
+
+     END LOOP ;
+
+     IF  BOOLEAN( NOT( NB'(TRUE ))) THEN  BUMP ;                END IF ;
+     IF  BOOLEAN( NOT( NB'(FALSE))) THEN  NULL ;  ELSE  BUMP ;  END IF ;
+
+
+     TVAR := IDENT_NEW_BOOL( NB'(TRUE ) );
+     FVAR := IDENT_NEW_BOOL( NB'(FALSE) );
+
+     IF  BOOLEAN( NOT TVAR )  THEN  BUMP ;                END IF ;
+     IF  BOOLEAN( NOT FVAR )  THEN  NULL ;  ELSE  BUMP ;  END IF ;
+
+     IF  ERROR_COUNT  /= 0  THEN  FAILED( "'NOT' TRUTH TABLE" );
+     END IF ;
+
+     RESULT;
+
+END C45662B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45672a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45672a.ada
new file mode 100644
index 000000000..1e5405525
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c45672a.ada
@@ -0,0 +1,109 @@
+-- C45672A.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 "NOT" YIELDS THE CORRECT RESULTS WHEN APPLIED TO
+-- ONE-DIMENSIONAL BOOLEAN ARRAYS.
+
+-- JWC 11/15/85
+
+WITH REPORT;USE REPORT;
+
+PROCEDURE C45672A IS
+BEGIN
+
+     TEST ("C45672A", "CHECK THE UNARY OPERATOR 'NOT' APPLIED TO " &
+                      "ONE-DIMENSIONAL BOOLEAN ARRAYS");
+
+     DECLARE
+
+          TYPE ARR1 IS ARRAY (INTEGER RANGE 1 .. 4) OF BOOLEAN;
+          TYPE ARR2 IS ARRAY (INTEGER RANGE 1 .. 40) OF BOOLEAN;
+          TYPE ARR3 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+          TYPE ARR4 IS ARRAY (INTEGER RANGE 1 .. 4) OF BOOLEAN;
+          TYPE ARR5 IS ARRAY (INTEGER RANGE 1 .. 40) OF BOOLEAN;
+
+          PRAGMA PACK (ARR4);
+          PRAGMA PACK (ARR5);
+
+          A1 : ARR1 := ARR1'(1 | 3 => TRUE, OTHERS => FALSE);
+          A2 : ARR2 := ARR2'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37 => TRUE,
+                             OTHERS => FALSE);
+          A3 : ARR3(IDENT_INT(3) .. IDENT_INT(4)) := ARR3'(TRUE, FALSE);
+          A4 : ARR4 := ARR4'(1 | 3 => TRUE, OTHERS => FALSE);
+          A5 : ARR5 := ARR5'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37 => TRUE,
+                             OTHERS => FALSE);
+          A6 : ARR3 (IDENT_INT(9) .. IDENT_INT(7));
+
+          PROCEDURE P (A : ARR3; F : INTEGER; L : INTEGER) IS
+          BEGIN
+               IF A'FIRST /= F OR A'LAST /= L THEN
+                    FAILED ("'NOT' YIELDED THE WRONG BOUNDS");
+               END IF;
+          END P;
+
+     BEGIN
+
+          P (NOT A3, 3, 4);
+          P (NOT A6, 9, 7);
+
+          IF NOT A1 /= ARR1'(1 | 3 => FALSE, OTHERS => TRUE) THEN
+               FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
+                       "TO SMALL ARRAY");
+          END IF;
+
+          IF NOT A2 /= ARR2'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37
+                             => FALSE, OTHERS => TRUE) THEN
+               FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
+                       "TO LARGE ARRAY");
+          END IF;
+
+          IF NOT A4 /= ARR4'(1 | 3 => FALSE, OTHERS => TRUE) THEN
+               FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
+                       "TO SMALL PACKED ARRAY");
+          END IF;
+
+          IF NOT A5 /= ARR5'(1 | 14 .. 18 | 30 .. 33 | 35 .. 37
+                             => FALSE, OTHERS => TRUE) THEN
+               FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
+                       "TO LARGE PACKED ARRAY");
+          END IF;
+
+          IF "NOT" (RIGHT => A1) /= ARR1'(1 | 3 => FALSE,
+                                          OTHERS => TRUE) THEN
+               FAILED ("WRONG RESULT WHEN 'NOT' APPLIED " &
+                       "TO SMALL ARRAY USING NAMED NOTATION");
+          END IF;
+
+          IF "NOT" (RIGHT => A5) /= ARR5'(1 | 14 .. 18 | 30 .. 33 |
+                                          35 .. 37 => FALSE,
+                                          OTHERS => TRUE) THEN
+               FAILED ("WRONG RESULT WHEN 'NOT' APPLIED TO LARGE " &
+                       "PACKED ARRAY USING NAMED NOTATION");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C45672A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460001.a
new file mode 100644
index 000000000..907b8564f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460001.a
@@ -0,0 +1,300 @@
+-- C460001.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 the target type of a type conversion is a general
+--      access type, Program_Error is raised if the accessibility level
+--      of the operand type is deeper than that of the target type.
+--      Check for the case where the operand is an access parameter.
+--      
+--      Check for cases where the actual corresponding to the access
+--      parameter is:
+--         (a) An allocator.
+--         (b) An expression of a named access type.
+--         (c) Obj'Access.
+--      
+-- TEST DESCRIPTION:
+--      In order to satisfy accessibility requirements, the operand type
+--      must be at the same or a less deep nesting level than the target
+--      type -- the operand type must "live" as long as the target type.
+--      Nesting levels are the run-time nestings of masters: block statements;
+--      subprogram, task, and entry bodies; and accept statements. Packages
+--      are invisible to accessibility rules.
+--
+--      This test declares subprograms with access parameters, within which
+--      a type conversion is attempted on the access parameter to an access
+--      type A declared at some nesting level. The test verifies that
+--      Program_Error is raised if the actual corresponding to the access
+--      parameter is:
+--
+--         (1) an allocator, and the accessibility level of the execution
+--             of the called subprogram is deeper than that of the access
+--             type A. 
+--
+--         (2) an expression of a named access type, and the accessibility
+--             level of the named access type is deeper than that of the
+--             access type A. 
+--
+--         (3) a reference to the Access attribute (e.g., X'Access), and
+--             the accessibility level of X is deeper than that of the
+--             access type A. 
+--
+--      Note that the static nesting level of the actual corresponding to the
+--      access parameter can be deeper than that of the target type -- it is
+--      the run-time nesting that matters for accessibility rules. Consider
+--      the case where the access type A is declared within the called
+--      subprogram. The accessibility check will never fail, even if the
+--      actual happens to have a deeper static nesting level:
+--
+--         procedure P (X: access T) is
+--            type A is access all T;   -- Static level = 2, e.g.
+--            Acc : A := A(X);          -- Check should never fail.
+--         begin null; end;
+--         . . .
+--         declare
+--            Actual : aliased T;       -- Static level = 3, e.g.
+--         begin
+--            P (Actual'Access);
+--         end;
+--
+--         For the execution of P, the accessibility level of type A will
+--         always be deeper than that of Actual, so there is no danger of a
+--         dangling reference arising from the assignment to Acc. Thus, the
+--         type conversion is safe, even though the static nesting level of
+--         Actual is deeper than that of A.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C460001_0 is
+
+   type Desig is array (1 .. 10) of Integer;
+
+   X0 : aliased Desig;                                            -- Level = 0.
+
+   type Acc_L0 is access all Desig;                               -- Level = 0.
+   A0 : Acc_L0;
+
+   type Result_Kind is (OK, P_E, O_E);
+
+   procedure Target_Is_Level_0 (X: access Desig; R : out Result_Kind);
+   procedure Never_Fails       (X: access Desig; R : out Result_Kind);
+
+end C460001_0;
+
+
+     --==================================================================--
+
+
+package body C460001_0 is
+
+   procedure Target_Is_Level_0 (X : access Desig;
+                                R : out Result_Kind) is
+   begin
+      -- The accessibility level of type Acc_L0 is 0.
+      A0 := Acc_L0(X);
+      R  := OK;
+   exception
+      when Program_Error =>    
+         R := P_E;
+      when others        =>    
+         R := O_E;
+   end Target_Is_Level_0;
+
+   -----------------------------------------------
+   procedure Never_Fails (X: access Desig;
+                          R : out Result_Kind) is
+      type Acc_Local is access all Desig;
+      AL : Acc_Local;
+   begin
+      -- The type conversion below will always be safe, since the
+      -- accessibility level (although not necessarily the static nesting
+      -- depth) of Acc_Local will always be deeper than or the same as that 
+      -- of the actual corresponding to X. 
+      AL := Acc_Local(X);
+      R  := OK;
+   exception
+      when Program_Error =>    
+         R := P_E;
+      when others        =>    
+         R := O_E;
+   end Never_Fails;
+
+end C460001_0;
+
+
+     --==================================================================--
+
+
+with C460001_0;
+with Report;
+
+procedure C460001 is
+
+   X1 : aliased C460001_0.Desig;                                  -- Level = 1.
+
+   type Acc_L1 is access all C460001_0.Desig;                     -- Level = 1.
+   A1 : Acc_L1;
+
+   Expr_L0 : C460001_0.Acc_L0 := C460001_0.X0'Access;
+   Expr_L1 : Acc_L1           := X1'Access;
+
+   Res : C460001_0.Result_Kind;
+
+   use type C460001_0.Result_Kind;
+
+   -----------------------------------------------
+   procedure Target_Is_Level_1 (X : access C460001_0.Desig;
+                                R : out C460001_0.Result_Kind) is
+   begin
+      -- The accessibility level of type Acc_L1 is 1.
+      A1 := Acc_L1(X);
+      R  := C460001_0.OK;
+   exception
+      when Program_Error =>    
+         R := C460001_0.P_E;
+      when others        =>    
+         R := C460001_0.O_E;
+   end Target_Is_Level_1;
+
+   -----------------------------------------------
+   procedure Display_Results (Result  : in C460001_0.Result_Kind;
+                              Expected: in C460001_0.Result_Kind;
+                              Message : in String) is
+   begin
+      if Result /= Expected then
+         case Result is
+            when C460001_0.OK  => Report.Failed ("No exception raised: "  & 
+                                                 Message);
+            when C460001_0.P_E => Report.Failed ("Program_Error raised: " & 
+                                                 Message);
+            when C460001_0.O_E => Report.Failed ("Unexpected exception "  &
+                                                 "raised: " & Message);
+         end case;
+      end if;
+   end Display_Results;
+
+begin -- C460001
+
+   Report.Test ("C460001", "Check that if the target type of a type "      &
+                "conversion is a general access type, Program_Error is "   &
+                "raised if the accessibility level of the operand type "   &
+                "is deeper than that of the target type: operand is an "   &
+                "access parameter; corresponding actual is an allocator, " &
+                "expression of a named access type, Obj'Access");
+
+
+   -- Actual is X'Access:
+
+   C460001_0.Never_Fails (X1'Access, Res);
+   Display_Results (Res, C460001_0.OK, "X1'Access, local access type");
+
+   C460001_0.Target_Is_Level_0 (X1'Access, Res);
+   Display_Results (Res, C460001_0.P_E, "X1'Access, level 0 access type");
+
+   Target_Is_Level_1 (C460001_0.X0'Access, Res);
+   Display_Results (Res, C460001_0.OK, "X0'Access, level 1 access type");
+
+   Target_Is_Level_1 (X1'Access, Res);
+   Display_Results (Res, C460001_0.OK, "X1'Access, level 1 access type");
+
+   C460001_0.Target_Is_Level_0 (C460001_0.X0'Access, Res);
+   Display_Results (Res, C460001_0.OK, "X0'Access, level 0 access type");
+
+
+   -- Actual is expression of a named access type:
+
+   C460001_0.Never_Fails (Expr_L0, Res);
+   Display_Results (Res, C460001_0.OK, "Expr_L0, local access type");
+
+   C460001_0.Target_Is_Level_0 (Expr_L0, Res);
+   Display_Results (Res, C460001_0.OK, "Expr_L0, level 0 access type");
+
+   C460001_0.Target_Is_Level_0 (Expr_L1, Res);
+   Display_Results (Res, C460001_0.P_E, "Expr_L1, level 0 access type");
+
+   Target_Is_Level_1 (Expr_L1, Res);
+   Display_Results (Res, C460001_0.OK, "Expr_L1, level 1 access type");
+
+   Target_Is_Level_1 (Expr_L0, Res);
+   Display_Results (Res, C460001_0.OK, "Expr_L0, level 1 access type");
+
+   -- Actual is allocator (level of execution = 2):
+
+   C460001_0.Never_Fails (new C460001_0.Desig, Res);
+   Display_Results (Res, C460001_0.OK, "Allocator level 2, " &
+                                       "local access type");
+
+   C460001_0.Target_Is_Level_0 (new C460001_0.Desig, Res);
+   Display_Results (Res, C460001_0.P_E, "Allocator level 2, " &
+                                        "level 0 access type");
+
+   Target_Is_Level_1 (new C460001_0.Desig, Res);
+   Display_Results (Res, C460001_0.P_E, "Allocator level 2, " &
+                                        "level 1 access type");
+
+
+   Block_L2:
+   declare
+      X2 : aliased C460001_0.Desig;                               -- Level = 2.
+      type Acc_L2 is access all C460001_0.Desig;                  -- Level = 2.
+      Expr_L2 : Acc_L2 := X1'Access;
+   begin
+
+      -- Actual is X'Access:
+
+      C460001_0.Never_Fails (X2'Access, Res);
+      Display_Results (Res, C460001_0.OK, "X2'Access, local access type");
+
+      Target_Is_Level_1 (X2'Access, Res);
+      Display_Results (Res, C460001_0.P_E, "X2'Access, level 1 access type");
+
+      -- Actual is expression of a named access type:
+
+      C460001_0.Never_Fails (Expr_L2, Res);
+      Display_Results (Res, C460001_0.OK, "Expr_L2, local access type");
+
+      C460001_0.Target_Is_Level_0 (Expr_L2, Res);
+      Display_Results (Res, C460001_0.P_E, "Expr_L2, level 0 access type");
+
+
+      -- Actual is allocator (level of execution = 3):
+
+      C460001_0.Never_Fails (new C460001_0.Desig, Res);
+      Display_Results (Res, C460001_0.OK, "Allocator level 3, " &
+                                          "local access type");
+
+      Target_Is_Level_1 (new C460001_0.Desig, Res);
+      Display_Results (Res, C460001_0.P_E, "Allocator level 3, " &
+                                           "level 1 access type");
+
+   end Block_L2;
+
+   Report.Result;
+
+end C460001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460002.a
new file mode 100644
index 000000000..945dd5677
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460002.a
@@ -0,0 +1,330 @@
+-- C460002.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 the target type of a type conversion is a general
+--      access type, Program_Error is raised if the accessibility level
+--      of the operand type is deeper than that of the target type.
+--      Check for the case where the operand is an access parameter,
+--      and the actual corresponding to the access parameter is another
+--      access parameter.
+--
+-- TEST DESCRIPTION:
+--      In order to satisfy accessibility requirements, the operand type
+--      must be at the same or a less deep nesting level than the target
+--      type -- the operand type must "live" as long as the target type.
+--      Nesting levels are the run-time nestings of masters: block statements;
+--      subprogram, task, and entry bodies; and accept statements. Packages
+--      are invisible to accessibility rules.
+--
+--      This test declares subprograms with access parameters, within which
+--      a type conversion is attempted on the access parameter to an access
+--      type A declared at some nesting level. The test verifies that
+--      Program_Error is raised if the actual corresponding to the access
+--      parameter is another access parameter, and the actual corresponding
+--      to this second access parameter is:
+--
+--         (1) an expression of a named access type, and the accessibility
+--             level of the named access type is deeper than that of the
+--             access type A.
+--
+--         (2) a reference to the Access attribute (e.g., X'Access), and
+--             the accessibility level of X is deeper than that of the
+--             access type A.
+--
+--      Note that the static nesting level of the actual corresponding to the
+--      access parameter can be deeper than that of the target type -- it is
+--      the run-time nesting that matters for accessibility rules. Consider
+--      the case where the access type A is declared within the called
+--      subprogram. The accessibility check will never fail, even if the
+--      actual happens to have a deeper static nesting level:
+--
+--         procedure P (X: access T) is
+--            type A is access all T;   -- Static level = 2, e.g.
+--            Acc : A := A(X);          -- Check should never fail.
+--         begin null; end;
+--         . . .
+--         procedure Q (Y: access T) is
+--         begin
+--            P(Y);
+--         end;
+--         . . .
+--         declare
+--            Actual : aliased T;       -- Static level = 3, e.g.
+--         begin
+--            Q (Actual'Access);
+--         end;
+--
+--         For the execution of Q (and hence P), the accessibility level of
+--         type A will always be deeper than that of Actual, so there is no
+--         danger of a dangling reference arising from the assignment to
+--         Acc. Thus, the type conversion is safe, even though the static
+--         nesting level of Actual is deeper than that of A.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Changed maintenance documentation.
+--      15 Jul 98   EDS     Avoid Optimization
+--      28 Jun 02   RLB     Added pragma Elaborate_All.
+--!
+
+with Report; use Report; pragma Elaborate_All (Report);
+package C460002_0 is
+
+   type Component is array (1 .. 10) of Natural;
+
+   type Desig is record
+      C: Component;
+   end record;
+
+   X0 : aliased Desig := (C=>(others => Ident_Int(3)));    -- Level = 0.
+
+   type Acc_L0 is access all Desig;                               -- Level = 0.
+   A0 : Acc_L0;
+
+   type Result_Kind is (OK, P_E, O_E);
+
+   procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind);
+   procedure Never_Fails_Nest       (Y: access Desig; S: out Result_Kind);
+   procedure Never_Fails_Same       (Y: access Desig; S: out Result_Kind);
+
+end C460002_0;
+
+
+     --==================================================================--
+
+
+package body C460002_0 is
+
+   procedure Target_Is_Level_0_Nest (Y: access Desig; S: out Result_Kind) is
+
+      procedure Nested (X: access Desig; R: out Result_Kind) is
+      -- This procedure attempts a type conversion on the access parameter to
+      -- an access type declared at some nesting level.  Program_Error is
+      -- raised if the accessibility level of the operand type is deeper than
+      -- that of the target type.
+
+      begin
+         -- The accessibility level of type Acc_L0 is 0.
+         A0 := Acc_L0(X);
+         R  := OK;
+      exception
+         when Program_Error =>
+            R := P_E;
+         when others        =>
+            R := O_E;
+      end Nested;
+
+   begin
+      Nested (Y, S);
+   end Target_Is_Level_0_Nest;
+
+   -------------------------------------------------------------
+
+   procedure Never_Fails_Nest (Y: access Desig; S: out Result_Kind) is
+
+      type Acc_Deeper is access all Desig;
+      AD : Acc_Deeper;
+
+      function Nested (X: access Desig) return Result_Kind is
+      begin
+         -- The type conversion below will always be safe, since the
+         -- accessibility level (although not necessarily the static nesting
+         -- depth) of Acc_Deeper will always be deeper than or the same as that
+         -- of the actual corresponding to Y.
+         AD := Acc_Deeper(X);
+         if Natural(Ident_Int(AD.C(1))) /= 3 then            --Avoid Optimization of AD
+           Report.Failed ("Initial Values not correct.");
+         end if;
+         return OK;
+      exception
+         when Program_Error =>
+            return P_E;
+         when others        =>
+            return O_E;
+      end Nested;
+
+   begin
+      S := Nested (Y);
+   end Never_Fails_Nest;
+
+   -------------------------------------------------------------
+
+   procedure Called_By_Never_Fails_Same
+     (X: access Desig; R: out Result_Kind) is
+      type Acc_Local is access all Desig;
+      AL : Acc_Local;
+   begin
+      -- The type conversion below will always be safe, since the
+      -- accessibility level (although not necessarily the static nesting
+      -- depth) of Acc_Local will always be deeper than or the same as that
+      -- of the actual corresponding to X.
+      AL := Acc_Local(X);
+      if Natural(Ident_Int(AL.C(1))) /= 3 then       --Avoid Optimization of AL
+        Report.Failed ("Initial Values not correct.");
+      end if;
+      R  := OK;
+   exception
+      when Program_Error =>
+         R := P_E;
+      when others        =>
+         R := O_E;
+   end Called_By_Never_Fails_Same;
+
+   -------------------------------------------------------------
+
+   procedure Never_Fails_Same (Y: access Desig; S: out Result_Kind) is
+   begin
+      Called_By_Never_Fails_Same (Y, S);
+   end Never_Fails_Same;
+
+end C460002_0;
+
+
+     --==================================================================--
+
+
+with C460002_0;
+use  C460002_0;
+
+with Report; use Report;
+
+procedure C460002 is
+
+   type Acc_L1 is access all Desig;                               -- Level = 1.
+   A1 : Acc_L1;
+   X1 : aliased Desig := (C=>(others => Ident_Int(3)));
+   Res : Result_Kind;
+
+
+
+   procedure Called_By_Target_L1 (X: access Desig; R: out Result_Kind) is
+   begin
+      -- The accessibility level of type Acc_L1 is 1.
+      A1 := Acc_L1(X);
+      if Natural(Ident_Int(A1.C(1))) /= 3 then       --Avoid Optimization of A1
+        Report.Failed ("Initial Values not correct.");
+      end if;
+      R  := OK;
+   exception
+      when Program_Error =>
+         R := P_E;
+      when others        =>
+         R := O_E;
+   end Called_By_Target_L1;
+
+   -------------------------------------------------------------
+
+   function Target_Is_Level_1_Same (Y: access Desig) return Result_Kind is
+      S : Result_Kind;
+   begin
+      Called_By_Target_L1 (Y, S);
+      return S;
+   end Target_Is_Level_1_Same;
+
+   -------------------------------------------------------------
+
+   procedure Display_Results (Result  : in Result_Kind;
+                              Expected: in Result_Kind;
+                              Msg     : in String) is
+   begin
+      if Result /= Expected then
+         case Result is
+            when OK  => Report.Failed ("No exception raised: "         & Msg);
+            when P_E => Report.Failed ("Program_Error raised: "        & Msg);
+            when O_E => Report.Failed ("Unexpected exception raised: " & Msg);
+         end case;
+      end if;
+   end Display_Results;
+
+begin -- C460002.
+
+   Report.Test ("C460002", "Check that if the target type of a type "      &
+                "conversion is a general access type, Program_Error is "   &
+                "raised if the accessibility level of the operand type "   &
+                "is deeper than that of the target type: operand is an "   &
+                "access parameter; corresponding actual is another "       &
+                "access parameter");
+
+
+   -- Accessibility level of actual is 0 (actual is X'Access):
+
+   Never_Fails_Same (X0'Access, Res);
+   Display_Results (Res, OK, "Never_Fails_Same, level 0 actual");
+
+   Never_Fails_Nest (X0'Access, Res);
+   Display_Results (Res, OK, "Target_L1_Nest, level 0 actual");
+
+   Target_Is_Level_0_Nest (X0'Access, Res);
+   Display_Results (Res, OK, "Target_L0_Nest, level 0 actual");
+
+   Res := Target_Is_Level_1_Same (X0'Access);
+   Display_Results (Res, OK, "Target_L1_Same, level 0 actual");
+
+
+   -- Accessibility level of actual is 1 (actual is X'Access):
+
+   Never_Fails_Same (X1'Access, Res);
+   Display_Results (Res, OK, "Never_Fails_Same, level 1 actual");
+
+   Never_Fails_Nest (X1'Access, Res);
+   Display_Results (Res, OK, "Target_L1_Nest, level 1 actual");
+
+   Target_Is_Level_0_Nest (X1'Access, Res);
+   Display_Results (Res, P_E, "Target_L0_Nest, level 1 actual");
+
+   Res := Target_Is_Level_1_Same (X1'Access);
+   Display_Results (Res, OK, "Target_L1_Same, level 1 actual");
+
+
+   Block_L2:
+   declare
+      X2 : aliased Desig := (C=>(others => Ident_Int(3)));
+      type Acc_L2 is access all Desig;                            -- Level = 2.
+      Expr_L2 : Acc_L2 := X2'Access;
+   begin
+
+      -- Accessibility level of actual is 2 (actual is expression of named
+      -- access type):
+
+      Never_Fails_Same (Expr_L2, Res);
+      Display_Results (Res, OK, "Never_Fails_Same, level 2 actual");
+
+      Never_Fails_Nest (Expr_L2, Res);
+      Display_Results (Res, OK, "Target_L1_Nest, level 2 actual");
+
+      Target_Is_Level_0_Nest (Expr_L2, Res);
+      Display_Results (Res, P_E, "Target_L0_Nest, level 2 actual");
+
+      Res := Target_Is_Level_1_Same (Expr_L2);
+      Display_Results (Res, P_E, "Target_L1_Same, level 2 actual");
+
+   end Block_L2;
+
+
+   Report.Result;
+
+end C460002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460004.a
new file mode 100644
index 000000000..b00428121
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460004.a
@@ -0,0 +1,335 @@
+-- C460004.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 the operand type of a type conversion is class-wide,
+--      Constraint_Error is raised if the tag of the operand does not
+--      identify a specific type that is covered by or descended from the
+--      target type.
+--
+-- TEST DESCRIPTION:
+--      View conversions of class-wide operands to specific types are
+--      placed on the right and left sides of assignment statements, and
+--      conversions of class-wide operands to class-wide types are used
+--      as actual parameters to dispatching operations. In all cases, a
+--      check is made that Constraint_Error is raised if the tag of the
+--      operand does not identify a specific type covered by or descended
+--      from the target type, and not raised otherwise.
+--      
+--      A specific type is descended from itself and from those types it is
+--      directly or indirectly derived from. A specific type is covered by
+--      itself and each class-wide type to whose class it belongs.
+--      
+--      A class-wide type T'Class is descended from T and those types which
+--      T is descended from. A class-wide type is covered by each class-wide
+--      type to whose class it belongs.
+--      
+--
+-- CHANGE HISTORY:
+--      19 Jul 95   SAIC    Initial prerelease version.
+--      18 Apr 96   SAIC    ACVC 2.1: Added a check for correct tag.
+--
+--!
+package C460004_0 is
+
+   type Tag_Type is tagged record
+      C1 : Natural;
+   end record;
+
+   procedure Proc (X : in out Tag_Type);
+
+
+   type DTag_Type is new Tag_Type with record
+      C2 : String (1 .. 5);
+   end record;
+
+   procedure Proc (X : in out DTag_Type);
+
+
+   type DDTag_Type is new DTag_Type with record
+      C3 : String (1 .. 5);
+   end record;
+
+   procedure Proc (X : in out DDTag_Type);
+
+   procedure NewProc (X : in DDTag_Type);
+
+   function CWFunc (X : Tag_Type'Class) return Tag_Type'Class;
+
+end C460004_0;
+
+
+     --==================================================================--
+
+with Report;
+package body C460004_0 is
+
+   procedure Proc (X : in out Tag_Type) is
+   begin
+      X.C1 := 25;
+   end Proc;
+
+   -----------------------------------------
+   procedure Proc (X : in out DTag_Type) is
+   begin
+      Proc ( Tag_Type(X) );
+      X.C2 := "Earth";
+   end Proc;
+
+   -----------------------------------------
+   procedure Proc (X : in out DDTag_Type) is
+   begin
+      Proc ( DTag_Type(X) );
+      X.C3 := "Orbit";
+   end Proc;
+
+   -----------------------------------------
+   procedure NewProc (X : in DDTag_Type) is
+      Y : DDTag_Type := X;
+   begin
+      Proc (Y);
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in NewProc");
+   end NewProc;
+
+   -----------------------------------------
+   function CWFunc (X : Tag_Type'Class) return Tag_Type'Class is
+      Y : Tag_Type'Class := X;
+   begin
+      Proc (Y);
+      return Y;
+   end CWFunc;
+
+end C460004_0;
+
+
+     --==================================================================--
+
+
+with C460004_0;
+use  C460004_0;
+
+with Report;
+procedure C460004 is
+
+   Tag_Type_Init    :  constant Tag_Type   := (C1 => 0);
+   DTag_Type_Init   :  constant DTag_Type  := (Tag_Type_Init with "Hello");
+   DDTag_Type_Init  :  constant DDTag_Type := (DTag_Type_Init with "World");
+
+   Tag_Type_Value   :  constant Tag_Type   := (C1 => 25);
+   DTag_Type_Value  :  constant DTag_Type  := (Tag_Type_Value  with "Earth");
+   DDTag_Type_Value :  constant DDTag_Type := (DTag_Type_Value with "Orbit");
+
+begin
+
+   Report.Test ("C460004", "Check that for a view conversion of a "      &
+                "class-wide operand, Constraint_Error is raised if the " &
+                "tag of the operand does not identify a specific type "  &
+                "covered by or descended from the target type");
+
+--
+-- View conversion to specific type:
+--
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Target : Tag_Type := Tag_Type_Init;     
+      begin
+         Target := Tag_Type(P);                      
+         if (Target /= Tag_Type_Value) then
+            Report.Failed ("Target has wrong value: #01");
+         end if;
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised: #01");
+         when others           => 
+            Report.Failed ("Unexpected exception: #01");
+      end CW_Proc;
+
+   begin
+      CW_Proc (DDTag_Type_Value);
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      Target : DTag_Type := DTag_Type_Init;           
+   begin
+      Target := DTag_Type(CWFunc(DDTag_Type_Value));  
+      if (Target /= DTag_Type_Value) then
+         Report.Failed ("Target has wrong value: #02");
+      end if;
+   exception
+      when Constraint_Error => Report.Failed ("Constraint_Error raised: #02");
+      when others           => Report.Failed ("Unexpected exception: #02");
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      Target : DDTag_Type;
+   begin
+      Target := DDTag_Type(CWFunc(Tag_Type_Value));
+                -- CWFunc returns a Tag_Type; its tag is preserved through 
+                -- the view conversion.  Constraint_Error should be raised.
+
+      Report.Failed ("Constraint_Error not raised: #03"); 
+
+   exception
+      when Constraint_Error => null;                 -- expected exception
+      when others           => Report.Failed ("Unexpected exception: #03");
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+      begin
+         NewProc (DDTag_Type(P));
+         Report.Failed ("Constraint_Error not raised: #04"); 
+                                                         
+      exception
+         when Constraint_Error => null;              -- expected exception
+         when others           => Report.Failed ("Unexpected exception: #04");
+      end CW_Proc;
+ 
+   begin
+      CW_Proc (DTag_Type_Value);
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Target : DDTag_Type := DDTag_Type_Init; 
+      begin
+         Target := DDTag_Type(P);
+         if (Target /= DDTag_Type_Value) then
+            Report.Failed ("Target has wrong value: #05");
+         end if;
+
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised: #05");
+         when others           
+            => Report.Failed ("Unexpected exception: #05");
+      end CW_Proc;
+ 
+   begin
+      CW_Proc (DDTag_Type_Value);
+   end;
+
+
+--
+-- View conversion to class-wide type:
+--
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Operand : Tag_Type'Class := P;
+      begin
+         Proc( DTag_Type'Class(Operand) );
+         Report.Failed ("Constraint_Error not raised: #06");
+
+      exception
+         when Constraint_Error => null;              -- expected exception
+         when others           => Report.Failed ("Unexpected exception: #06");
+      end CW_Proc;
+ 
+   begin
+      CW_Proc (Tag_Type_Init);
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Operand : Tag_Type'Class := P;
+      begin
+         Proc( DDTag_Type'Class(Operand) );
+         Report.Failed ("Constraint_Error not raised: #07");
+
+      exception
+         when Constraint_Error => null;              -- expected exception
+         when others           => Report.Failed ("Unexpected exception: #07");
+      end CW_Proc;
+ 
+   begin
+      CW_Proc (Tag_Type_Init);
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Operand : Tag_Type'Class := P;
+      begin
+         Proc( DTag_Type'Class(Operand) );  
+         if Operand not in DTag_Type then
+            Report.Failed ("Operand has wrong tag: #08");
+         elsif (Operand /= Tag_Type'Class (DTag_Type_Value)) then
+            Report.Failed ("Operand has wrong value: #08");
+         end if;
+
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised: #08");
+         when others           => 
+            Report.Failed ("Unexpected exception: #08");
+      end CW_Proc;
+ 
+   begin
+      CW_Proc (DTag_Type_Init);
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Operand : Tag_Type'Class := P;
+      begin
+         Proc( Tag_Type'Class(Operand) );
+         if Operand not in DDTag_Type then
+            Report.Failed ("Operand has wrong tag: #09");
+         elsif (Operand /= Tag_Type'Class (DDTag_Type_Value)) then
+            Report.Failed ("Operand has wrong value: #09");
+         end if;
+
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised: #09");
+         when others           => 
+            Report.Failed ("Unexpected exception: #09");
+      end CW_Proc;
+ 
+   begin
+      CW_Proc (DDTag_Type_Init);
+   end;
+
+
+   Report.Result;
+
+end C460004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460005.a
new file mode 100644
index 000000000..95b14a9a2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460005.a
@@ -0,0 +1,260 @@
+-- C460005.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, for a view conversion of a tagged type that is the left 
+--      side of an assignment statement, the assignment assigns to the 
+--      corresponding part of the object denoted by the operand.
+--
+-- TEST DESCRIPTION:
+--      View conversions of class-wide operands to specific types are
+--      placed on the right and left sides of assignment statements, and
+--      conversions of class-wide operands to class-wide types are used
+--      as actual parameters to dispatching operations. In all cases, a
+--      check is made that Constraint_Error is raised if the tag of the
+--      operand does not identify a specific type covered by or descended
+--      from the target type, and not raised otherwise.
+--
+--      For the cases where the view conversion is the left side of an
+--      assignment statement, and Constraint_Error should not be raised,
+--      an additional check is made that only the corresponding portion
+--      of the operand is updated by the assignment. For example:
+--
+--         type T is tagged record
+--            C1 : Integer := 0;
+--         end record;
+--
+--         type DT is new T with record
+--            C2 : Integer := 0;
+--         end record;
+--
+--         A    : T       := (C1 => 5);
+--         B    : DT      := (C1 => 0, C2 => 10);
+--         CWDT : T'Class := B;
+--
+--         T(CWDT) := A;  -- Updates component C1; C2 remains unchanged.
+--                        -- Value of CWDT is (C1 => 5, C2 => 10).
+--
+--
+-- CHANGE HISTORY:
+--      31 Jul 95   SAIC    Initial prerelease version.
+--      22 Apr 96   SAIC    ACVC 2.1: Added a check for correct tag.
+--      08 Sep 96   SAIC    ACVC 2.1: Modified Report.Test. 
+--
+--!
+
+package C460005_0 is
+
+   type Tag_Type is tagged record
+      C1 : Natural;
+   end record;
+
+   procedure Proc (X : in out Tag_Type);
+
+
+   type DTag_Type is new Tag_Type with record
+      C2 : String (1 .. 5);
+   end record;
+
+   procedure Proc (X : in out DTag_Type);
+
+
+   type DDTag_Type is new DTag_Type with record
+      C3 : String (1 .. 5);
+   end record;
+
+   procedure Proc (X : in out DDTag_Type);
+
+end C460005_0;
+
+
+     --==================================================================--
+
+
+package body C460005_0 is
+
+   procedure Proc (X : in out Tag_Type) is
+   begin
+      X.C1 := 25;
+   end Proc;
+
+   -----------------------------------------
+   procedure Proc (X : in out DTag_Type) is
+   begin
+      Proc ( Tag_Type(X) );
+      X.C2 := "Earth";
+   end Proc;
+
+   -----------------------------------------
+   procedure Proc (X : in out DDTag_Type) is
+   begin
+      Proc ( DTag_Type(X) );
+      X.C3 := "Orbit";
+   end Proc;
+
+end C460005_0;
+
+
+     --==================================================================--
+
+
+with C460005_0;
+use  C460005_0;
+
+with Report;
+procedure C460005 is
+
+   Tag_Type_Init    :  constant Tag_Type   := (C1 => 0);
+   DTag_Type_Init   :  constant DTag_Type  := (Tag_Type_Init with "Hello");
+   DDTag_Type_Init  :  constant DDTag_Type := (DTag_Type_Init with "World");
+
+   Tag_Type_Value   :  constant Tag_Type   := (C1 => 25);
+   DTag_Type_Value  :  constant DTag_Type  := (Tag_Type_Value  with "Earth");
+   DDTag_Type_Value :  constant DDTag_Type := (DTag_Type_Value with "Orbit");
+
+   Tag_Type_Res     :  constant Tag_Type   := (C1 => 25);
+   DTag_Type_Res    :  constant DTag_Type  := (Tag_Type_Res  with "Hello");
+   DDTag_Type_Res   :  constant DDTag_Type := (DTag_Type_Res with "World");
+
+begin
+
+   Report.Test ("C460005", "Check that, for a view conversion of a tagged " &
+                "type that is the left side of an assignment statement, "   &
+                "the assignment assigns to the corresponding part of the "  &
+                "object denoted by the operand");
+
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Operand : Tag_Type'Class := P;               
+      begin
+         Tag_Type(Operand) := Tag_Type_Value;         
+
+         if (Operand /= Tag_Type'Class (Tag_Type_Value)) then
+            Report.Failed ("Operand has wrong value: #01");
+         end if;
+
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised: #01");
+         when others           => 
+            Report.Failed ("Unexpected exception: #01");
+      end CW_Proc;
+
+   begin
+      CW_Proc (Tag_Type_Init);
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Operand : Tag_Type'Class := P;               
+      begin
+         DTag_Type(Operand) := DTag_Type_Value;
+         Report.Failed ("Constraint_Error not raised: #02"); 
+
+      exception
+         when Constraint_Error => null;              -- expected exception
+         when others           => Report.Failed ("Unexpected exception: #02");
+      end CW_Proc;
+
+   begin
+      CW_Proc (Tag_Type_Init);
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Operand : Tag_Type'Class := P;               
+      begin
+         DDTag_Type(Operand) := DDTag_Type_Value;
+         Report.Failed ("Constraint_Error not raised: #03"); 
+
+      exception
+         when Constraint_Error => null;              -- expected exception
+         when others           => Report.Failed ("Unexpected exception: #03");
+      end CW_Proc;
+
+   begin
+      CW_Proc (Tag_Type_Init);
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Operand : Tag_Type'Class := P;
+      begin
+         Tag_Type(Operand) := Tag_Type_Value;  
+
+         if Operand not in DTag_Type then
+            Report.Failed ("Operand has wrong tag: #04");
+         elsif (Operand /= Tag_Type'Class (DTag_Type_Res)) 
+         then                                              -- Check to make 
+           Report.Failed ("Operand has wrong value: #04"); -- sure that C2 was
+         end if;                                           -- not modified.
+
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised: #04");
+         when others           => 
+            Report.Failed ("Unexpected exception: #04");
+      end CW_Proc;
+
+   begin
+      CW_Proc (DTag_Type_Init);
+   end;
+
+   ----------------------------------------------------------------------
+
+   declare
+      procedure CW_Proc (P : Tag_Type'Class) is
+         Operand : Tag_Type'Class := P;
+      begin
+         Tag_Type(Operand) := Tag_Type_Value;         
+
+         if Operand not in DDTag_Type then
+            Report.Failed ("Operand has wrong tag: #05");
+         elsif (Operand /= Tag_Type'Class (DDTag_Type_Res)) 
+         then                                              -- Check to make 
+           Report.Failed ("Operand has wrong value: #05"); -- sure that C2, C3
+         end if;                                           -- were not changed.
+
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised: #05");
+         when others           => 
+            Report.Failed ("Unexpected exception: #05");
+      end CW_Proc;
+
+   begin
+      CW_Proc (DDTag_Type_Init);
+   end;
+
+   Report.Result;
+
+end C460005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460006.a
new file mode 100644
index 000000000..99968847b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460006.a
@@ -0,0 +1,378 @@
+-- C460006.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 view conversion to a tagged type is permitted in the 
+--      prefix of a selected component, an object renaming declaration, and 
+--      (if the operand is a variable) on the left side of an assignment 
+--      statement. Check that such a renaming or assignment does not change 
+--      the tag of the operand.
+--
+--      Check that, for a view conversion of a tagged type, each
+--      nondiscriminant component of the new view denotes the matching
+--      component of the operand object. Check that reading the value of the
+--      view yields the result of converting the value of the operand object
+--      to the target subtype.
+--
+-- TEST DESCRIPTION:
+--      The fact that the tag of an object is not changed is verified by
+--      making calls to primitive operations which in turn make (re)dispatching
+--      calls, and confirming that the proper bodies are executed.
+--
+--      Selected components are checked in three contexts: as the object name
+--      in an object renaming declaration, as the left operand of an inequality
+--      operation, and as the left side of an assignment statement.
+--
+--      View conversions of an object of a 2nd level type extension are
+--      renamed as objects of an ancestor type and of a class-wide type. In
+--      one case the operand of the conversion is itself a renaming of an
+--      object.
+--
+--      View conversions of an object of a 2nd level type extension are
+--      checked for equality with record aggregates of various ancestor types.
+--      In one case, the view conversion is to a class-wide type, and it is
+--      checked for equality with the result of a class-wide function with
+--      the following structure:
+--
+--         function F return T'Class is
+--            A : DDT     := Expected_Value;
+--            X : T'Class := T(A);
+--         begin
+--            return X;
+--
+--         end F;
+--
+--         ...
+--
+--         Var : DDT := Expected_Value;
+--
+--         if (T'Class(Var) /= F) then    -- Condition should yield FALSE.
+--            FAIL;
+--         end if;
+--
+--      The view conversion to which X is initialized does not affect the
+--      value or tag of the operand; the tag of X is that of type DDT (not T),
+--      and the components are those of A. The result of this function
+--      should equal the value of an object of type DDT initialized to the
+--      same value as F.A.
+--
+--      To check that assignment to a view conversion does not change the tag
+--      of the operand, an assignment is made to a conversion of an object,
+--      and the object is then passed as an actual to a dispatching operation.
+--      Conversions to both specific and class-wide types are checked.
+--
+--
+-- CHANGE HISTORY:
+--      20 Jul 95   SAIC    Initial prerelease version.
+--      24 Apr 96   SAIC    Added type conversions.
+--
+--!
+
+package C460006_0 is
+
+   type Call_ID_Kind is (None, Parent_Outer,     Parent_Inner,
+                               Child_Outer,      Child_Inner,
+                               Grandchild_Outer, Grandchild_Inner);
+
+   type Root_Type is abstract tagged record
+      First_Call  : Call_ID_Kind := None;
+      Second_Call : Call_ID_Kind := None;
+   end record;
+
+   procedure Inner_Proc (X : in out Root_Type) is abstract;
+   procedure Outer_Proc (X : in out Root_Type) is abstract;
+
+end C460006_0;
+
+
+     --==================================================================--
+
+
+package C460006_0.C460006_1 is
+
+   type Parent_Type is new Root_Type with record
+      C1 : Integer := 0;
+   end record;
+
+   procedure Inner_Proc (X : in out Parent_Type);
+   procedure Outer_Proc (X : in out Parent_Type);
+
+end C460006_0.C460006_1;
+
+
+     --==================================================================--
+
+
+package body C460006_0.C460006_1 is
+
+   procedure Inner_Proc (X : in out Parent_Type) is
+   begin
+      X.Second_Call := Parent_Inner;
+   end Inner_Proc;
+
+   -------------------------------------------------
+   procedure Outer_Proc (X : in out Parent_Type) is
+   begin
+      X.First_Call := Parent_Outer;
+      Inner_Proc ( Parent_Type'Class(X) );
+   end Outer_Proc;
+
+end C460006_0.C460006_1;
+
+
+     --==================================================================--
+
+
+package C460006_0.C460006_1.C460006_2 is
+
+   type Child_Type is new Parent_Type with record
+      C2 : String(1 .. 5) := "-----";
+   end record;
+
+   procedure Inner_Proc (X : in out Child_Type);
+   procedure Outer_Proc (X : in out Child_Type);
+
+end C460006_0.C460006_1.C460006_2;
+
+
+     --==================================================================--
+
+
+package body C460006_0.C460006_1.C460006_2 is
+
+   procedure Inner_Proc (X : in out Child_Type) is
+   begin
+      X.Second_Call := Child_Inner;
+   end Inner_Proc;
+
+   -------------------------------------------------
+   procedure Outer_Proc (X : in out Child_Type) is
+   begin
+      X.First_Call := Child_Outer;
+      Inner_Proc ( Parent_Type'Class(X) );
+   end Outer_Proc;
+
+end C460006_0.C460006_1.C460006_2;
+
+
+     --==================================================================--
+
+
+package C460006_0.C460006_1.C460006_2.C460006_3 is
+
+   type Grandchild_Type is new Child_Type with record
+      C3: String(1 .. 5) := "-----";
+   end record;
+
+   procedure Inner_Proc (X : in out Grandchild_Type);
+   procedure Outer_Proc (X : in out Grandchild_Type);
+
+
+   function ClassWide_Func return Parent_Type'Class;
+
+
+   Grandchild_Value : constant Grandchild_Type := (First_Call  => None,
+                                                   Second_Call => None,
+                                                   C1          => 15,
+                                                   C2          => "Hello",
+                                                   C3          => "World");
+
+end C460006_0.C460006_1.C460006_2.C460006_3;
+
+
+     --==================================================================--
+
+
+package body C460006_0.C460006_1.C460006_2.C460006_3 is
+
+   procedure Inner_Proc (X : in out Grandchild_Type) is
+   begin
+      X.Second_Call := Grandchild_Inner;
+   end Inner_Proc;
+
+   -------------------------------------------------
+   procedure Outer_Proc (X : in out Grandchild_Type) is
+   begin
+      X.First_Call := Grandchild_Outer;
+      Inner_Proc ( Parent_Type'Class(X) );
+   end Outer_Proc;
+
+   -------------------------------------------------
+   function ClassWide_Func return Parent_Type'Class is
+      A : Grandchild_Type   := Grandchild_Value;
+      X : Parent_Type'Class := Parent_Type(A); -- Value of X is still that of A.
+   begin
+      return X;
+   end ClassWide_Func;
+
+end C460006_0.C460006_1.C460006_2.C460006_3;
+
+
+     --==================================================================--
+
+
+with C460006_0.C460006_1.C460006_2.C460006_3;
+
+with Report;
+procedure C460006 is
+
+   package Root_Package       renames C460006_0;
+   package Parent_Package     renames C460006_0.C460006_1;
+   package Child_Package      renames C460006_0.C460006_1.C460006_2;
+   package Grandchild_Package renames C460006_0.C460006_1.C460006_2.C460006_3;
+
+begin
+   Report.Test ("C460006", "Check that a view conversion to a tagged type " &
+                "is permitted in the prefix of a selected component, an "   &
+                "object renaming declaration, and (if the operand is a "    &
+                "variable) on the left side of an assignment statement.  "  &
+                "Check that such a renaming or assignment does not change " &
+                " the tag of the operand");
+
+
+   --
+   -- Check conversion as prefix of selected component:
+   --
+
+   Selected_Component_Subtest:
+   declare
+      use Root_Package, Parent_Package, Child_Package, Grandchild_Package;
+
+      Var    : Grandchild_Type   := Grandchild_Value;
+      CW_Var : Parent_Type'Class := Var;
+
+      Ren    : Integer renames Parent_Type(Var).C1;
+
+   begin
+      if Ren /= 15 then
+         Report.Failed ("Wrong value: selected component in renaming");
+      end if;
+
+      if Child_Type(Var).C2 /= "Hello" then
+         Report.Failed ("Wrong value: selected component in IF");
+      end if;
+
+      Grandchild_Type(CW_Var).C3(2..4) := "eir";
+      if CW_Var /= Parent_Type'Class
+                   (Grandchild_Type'(None, None, 15, "Hello", "Weird"))
+      then
+         Report.Failed ("Wrong value: selected component in assignment");
+      end if;
+   end Selected_Component_Subtest;
+
+
+   --
+   -- Check conversion in object renaming:
+   --
+
+   Object_Renaming_Subtest:
+   declare
+      use Root_Package, Parent_Package, Child_Package, Grandchild_Package;
+
+      Var : Grandchild_Type := Grandchild_Value;
+      Ren1 : Parent_Type       renames Parent_Type(Var);
+      Ren2 : Child_Type        renames Child_Type(Var);
+      Ren3 : Parent_Type'Class renames Parent_Type'Class(Var);
+      Ren4 : Parent_Type       renames Parent_Type(Ren2); -- Rename of rename.
+   begin
+      Outer_Proc (Ren1);
+      if Ren1 /= (Parent_Outer, Grandchild_Inner, 15) then
+         Report.Failed ("Value or tag not preserved by object renaming: Ren1");
+      end if;
+
+      Outer_Proc (Ren2);
+      if Ren2 /= (Child_Outer, Grandchild_Inner, 15, "Hello") then
+         Report.Failed ("Value or tag not preserved by object renaming: Ren2");
+      end if;
+
+      Outer_Proc (Ren3);
+      if Ren3 /= Parent_Type'Class
+                 (Grandchild_Type'(Grandchild_Outer,
+                                   Grandchild_Inner,
+                                   15,
+                                   "Hello",
+                                   "World"))
+      then
+         Report.Failed ("Value or tag not preserved by object renaming: Ren3");
+      end if;
+
+      Outer_Proc (Ren4);
+      if Ren4 /= (Parent_Outer, Grandchild_Inner, 15) then
+         Report.Failed ("Value or tag not preserved by object renaming: Ren4");
+      end if;
+   end Object_Renaming_Subtest;
+
+
+   --
+   -- Check reading view conversion, and conversion as left side of assignment:
+   --
+
+   View_Conversion_Subtest:
+   declare
+      use Root_Package, Parent_Package, Child_Package, Grandchild_Package;
+
+      Var : Grandchild_Type := Grandchild_Value;
+      Specific  : Child_Type;
+      ClassWide : Parent_Type'Class := Var;   -- Grandchild_Type tag.
+   begin
+      if Parent_Type(Var) /= (None, None, 15) then
+         Report.Failed ("View has wrong value: #1");
+      end if;
+
+      if Child_Type(Var) /= (None, None, 15, "Hello") then
+         Report.Failed ("View has wrong value: #2");
+      end if;
+
+      if Parent_Type'Class(Var) /= ClassWide_Func then
+         Report.Failed ("Upward view conversion did not preserve " &
+                        "extension's components");
+      end if;
+
+
+      Parent_Type(Specific) := (None, None, 26); -- Assign to view.
+      Outer_Proc (Specific);                     -- Call dispatching op.
+
+      if Specific /= (Child_Outer, Child_Inner, 26, "-----") then
+         Report.Failed ("Value or tag not preserved by assignment: Specific");
+      end if;
+
+
+      Parent_Type(ClassWide) := (None, None, 44); -- Assign to view.
+      Outer_Proc (ClassWide);                     -- Call dispatching op.
+
+      if ClassWide /= Parent_Type'Class
+                      (Grandchild_Type'(Grandchild_Outer,
+                                        Grandchild_Inner,
+                                        44,
+                                        "Hello",
+                                        "World"))
+      then
+         Report.Failed ("Value or tag not preserved by assignment: ClassWide");
+      end if;
+   end View_Conversion_Subtest;
+
+   Report.Result;
+
+end C460006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460007.a
new file mode 100644
index 000000000..fdcc1adcc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460007.a
@@ -0,0 +1,239 @@
+-- C460007.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, in a numeric type conversion, if the target type is an
+--      integer type and the operand type is real, the result is rounded
+--      to the nearest integer, and away from zero if the result is exactly
+--      halfway between two integers. Check for static and non-static type
+--      conversions.
+--
+-- TEST DESCRIPTION:
+--      The following cases are considered:
+--
+--          X.5    X.5 + delta   -X.5 + delta
+--         -X.5    X.5 - delta   -X.5 - delta
+--
+--      Both zero and non-zero values are used for X. The value of delta is
+--      chosen to be a very small increment (on the order of 1.0E-10). For
+--      fixed and floating point cases, the value of delta is chosen such that
+--      "(-)X.5 +(-) delta" is a multiple of the small, or a machine number,
+--      respectively.
+--
+--      The following type conversions are performed:
+--
+--      ID   Real operand            Cases          Target integer subtype
+--      ------------------------------------------------------------------
+--       1   Real named number        X.5           Nonstatic
+--       2                            X.5 - delta   Nonstatic
+--       3                           -X.5 - delta   Static
+--       4   Real literal            -X.5           Static
+--       5                            X.5 + delta   Static
+--       6                           -X.5 + delta   Nonstatic
+--       7   Floating point object   -X.5 - delta   Nonstatic
+--       8                            X.5 - delta   Static
+--       9   Fixed point object       X.5           Static
+--      10                            X.5 + delta   Static
+--      11                           -X.5 + delta   Nonstatic
+--      The conversion is either assigned to a variable of the target subtype
+--      or passed as a parameter to a subprogram (both nonstatic contexts).
+--
+--      The subprogram Equal is used to circumvent potential optimizations.
+--
+--
+-- CHANGE HISTORY:
+--      03 Oct 95   SAIC    Initial prerelease version.
+--
+--!
+
+with System;
+package C460007_0 is
+
+--
+-- Target integer subtype (static):
+--
+
+   type Static_Integer_Subtype is range -32_000 .. 32_000;
+
+   Static_Target : Static_Integer_Subtype;
+
+   function Equal (L, R: Static_Integer_Subtype) return Boolean;
+
+
+--
+-- Named numbers:
+--
+
+   NN_Half      : constant := 0.5000000000;
+   NN_Less_Half : constant := 126.4999999999;
+   NN_More_Half : constant := -NN_Half - 0.0000000001;
+
+
+--
+-- Floating point:
+--
+
+   type My_Float is digits System.Max_Digits;
+
+   Flt_Rnd_Toward_Zero :          My_Float := My_Float'Pred(NN_Half);
+   Flt_Rnd_Away_Zero   : constant My_Float := My_Float'Pred(-113.5);
+
+
+--
+-- Fixed point:
+--
+
+   type My_Fixed is delta 0.1 range -5.0 .. 5.0;
+
+   Fix_Half            :          My_Fixed := 0.5;
+   Fix_Rnd_Away_Zero   :          My_Fixed := Fix_Half + My_Fixed'Small;
+   Fix_Rnd_Toward_Zero : constant My_Fixed := -3.5 + My_Fixed'Small;
+
+end C460007_0;
+
+
+     --==================================================================--
+
+
+package body C460007_0 is
+
+   function Equal (L, R: Static_Integer_Subtype) return Boolean is
+   begin
+      return (L = R);
+   end Equal;
+
+end C460007_0;
+
+
+     --==================================================================--
+
+
+with C460007_0;
+use  C460007_0;
+
+with Report;
+procedure C460007 is
+
+--
+-- Target integer subtype (nonstatic):
+--
+
+   Limit : Static_Integer_Subtype :=
+           Static_Integer_Subtype(Report.Ident_Int(128));
+
+   subtype Nonstatic_Integer_Subtype is Static_Integer_Subtype
+     range -Limit .. Limit;
+
+   Nonstatic_Target : Static_Integer_Subtype;
+
+begin
+
+   Report.Test ("C460007", "Rounding for type conversions of real operand " &
+                "to integer target");
+
+
+   -- --------------------------
+   -- Named number/literal cases:
+   -- --------------------------
+
+   Nonstatic_Target := Nonstatic_Integer_Subtype(NN_Half);
+   
+   if not Equal(Nonstatic_Target, 1) then                           -- Case 1.
+      Report.Failed ("Wrong result for named number operand" &
+                     "(case 1), nonstatic target subtype");
+   end if;
+
+   if not Equal(Nonstatic_Integer_Subtype(NN_Less_Half), 126) then  -- Case 2. 
+      Report.Failed ("Wrong result for named number operand" &
+                     "(case 2), nonstatic target subtype");
+   end if;
+
+   Static_Target := Static_Integer_Subtype(NN_More_Half);
+   
+   if not Equal(Static_Target, -1) then                             -- Case 3.
+      Report.Failed ("Wrong result for named number operand" &
+                     "(case 3), static target subtype");
+   end if;
+
+   if not Equal(Static_Integer_Subtype(-0.50), -1) then             -- Case 4.
+      Report.Failed ("Wrong result for literal operand" &
+                     "(case 4), static target subtype");
+   end if;
+
+   if not Equal(Static_Integer_Subtype(29_546.5001), 29_547) then   -- Case 5.
+      Report.Failed ("Wrong result for literal operand" &
+                     "(case 5), static target subtype");
+   end if;
+
+   if not Equal(Nonstatic_Integer_Subtype(-66.499), -66) then       -- Case 6.
+      Report.Failed ("Wrong result for literal operand" &
+                     "(case 6), nonstatic target subtype");
+   end if;
+
+
+   -- --------------------
+   -- Floating point cases:
+   -- --------------------
+
+   Nonstatic_Target := Nonstatic_Integer_Subtype(Flt_Rnd_Away_Zero);
+
+   if not Equal(Nonstatic_Target, -114) then                        -- Case 7.
+      Report.Failed ("Wrong result for floating point operand" &
+                     "(case 7), nonstatic target subtype");
+   end if;
+                                                                    -- Case 8.
+   if not Equal(Static_Integer_Subtype(Flt_Rnd_Toward_Zero), 0) then
+      Report.Failed ("Wrong result for floating point operand" &
+                     "(case 8), static target subtype");
+   end if;
+
+
+   -- -----------------
+   -- Fixed point cases:
+   -- -----------------
+
+   Static_Target := Static_Integer_Subtype(Fix_Half);
+
+   if not Equal(Static_Target, 1) then                              -- Case 9.
+      Report.Failed ("Wrong result for fixed point operand" &
+                     "(case 9), static target subtype");
+   end if;
+
+   if not Equal(Static_Integer_Subtype(Fix_Rnd_Away_Zero), 1) then  -- Case 10.
+      Report.Failed ("Wrong result for fixed point operand" &
+                     "(case 10), static target subtype");
+   end if;
+
+   Nonstatic_Target := Nonstatic_Integer_Subtype(Fix_Rnd_Toward_Zero);
+
+   if not Equal(Nonstatic_Target, -3) then                          -- Case 11.
+      Report.Failed ("Wrong result for fixed point operand" &
+                     "(case 11), nonstatic target subtype");
+   end if;
+
+
+   Report.Result;
+
+end C460007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460008.a
new file mode 100644
index 000000000..29d48ecd4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460008.a
@@ -0,0 +1,286 @@
+-- C460008.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 conversion to a modular type raises Constraint_Error
+--     when the operand value is outside the base range of the modular type.
+--
+-- TEST DESCRIPTION:
+--      Test conversion from integer, float, fixed and decimal types to
+--      modular types.  Test conversion to mod 255, mod 256 and mod 258
+--      to test the boundaries of 8 bit (+/-) unsigned numbers.
+--      Test operand values that are negative, the value of the mod,
+--      and greater than the value of the mod.
+--      Declare a generic test procedure and instantiate it for each of the
+--      unsigned types for each operand type.
+--
+--
+-- CHANGE HISTORY:
+--      04 OCT 95   SAIC   Initial version
+--      15 MAY 96   SAIC   Revised for 2.1
+--      24 NOV 98   RLB    Moved decimal cases into new test, C460011, to
+--                         prevent this test from being inapplicable to
+--                         implementations not supporting decimal types.
+--
+--!
+
+------------------------------------------------------------------- C460008
+
+with Report;
+
+procedure C460008 is
+
+  Shy_By_One   : constant := 2**8-1;
+  Heavy_By_Two : constant := 2**8+2;
+
+  type Unsigned_Edge_8 is mod Shy_By_One;
+  type Unsigned_8_Bit  is mod 2**8;
+  type Unsigned_Over_8 is mod Heavy_By_Two;
+
+  NPC : constant String := " not properly converted";
+
+  procedure Assert( Truth: Boolean; Message: String ) is
+  begin
+    if not Truth then
+      Report.Failed(Message);
+    end if;
+  end Assert;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  generic
+    type Source is range <>;
+    type Target is mod <>;
+  procedure Integer_Conversion_Check( For_The_Value : Source;
+                                      Message       : String );
+
+  procedure Integer_Conversion_Check( For_The_Value : Source;
+                                      Message       : String ) is
+
+    Item : Target;
+
+  begin
+    Item := Target( For_The_Value );
+    Report.Failed("Int expected Constraint_Error " & Message);
+    -- the call to Comment is to make the otherwise dead assignment to
+    -- Item live.
+    -- To avoid invoking C_E on a call to 'Image in Report.Failed that
+    -- could cause a false pass
+   Report.Comment("Value of" & Target'Image(Item) & NPC);
+  exception
+    when Constraint_Error => null; -- expected case
+    when others => Report.Failed("Int Raised wrong exception " & Message);
+  end Integer_Conversion_Check;
+
+  procedure Int_To_Short is
+    new Integer_Conversion_Check( Integer, Unsigned_Edge_8 );
+
+  procedure Int_To_Eight is
+    new Integer_Conversion_Check( Integer, Unsigned_8_Bit );
+
+  procedure Int_To_Wide is
+    new Integer_Conversion_Check( Integer, Unsigned_Over_8 );
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  generic
+    type Source is digits <>;
+    type Target is mod <>;
+  procedure Float_Conversion_Check( For_The_Value : Source;
+                                    Message       : String );
+
+  procedure Float_Conversion_Check( For_The_Value : Source;
+                                    Message       : String ) is
+
+    Item : Target;
+
+  begin
+    Item := Target( For_The_Value );
+    Report.Failed("Flt expected Constraint_Error " & Message);
+    Report.Comment("Value of" & Target'Image(Item) & NPC);
+  exception
+    when Constraint_Error => null; -- expected case
+    when others => Report.Failed("Flt raised wrong exception " & Message);
+  end Float_Conversion_Check;
+
+  procedure Float_To_Short is
+    new Float_Conversion_Check( Float, Unsigned_Edge_8 );
+
+  procedure Float_To_Eight is
+    new Float_Conversion_Check( Float, Unsigned_8_Bit );
+
+  procedure Float_To_Wide is
+    new Float_Conversion_Check( Float, Unsigned_Over_8 );
+
+  function Identity( Root_Beer: Float ) return Float is
+    -- a knockoff of Report.Ident_Int for type Float
+    Nothing : constant Float := 0.0;
+  begin
+    if Report.Ident_Bool( Root_Beer = Nothing ) then
+      return Nothing;
+    else
+      return Root_Beer;
+    end if;
+  end Identity;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  generic
+    type Source is delta <>;
+    type Target is mod <>;
+  procedure Fixed_Conversion_Check( For_The_Value : Source;
+                                    Message       : String );
+
+  procedure Fixed_Conversion_Check( For_The_Value : Source;
+                                    Message       : String ) is
+
+    Item : Target;
+
+  begin
+    Item := Target( For_The_Value );
+    Report.Failed("Fix expected Constraint_Error " & Message);
+    Report.Comment("Value of" & Target'Image(Item) & NPC);
+  exception
+    when Constraint_Error => null; -- expected case
+    when others => Report.Failed("Fix raised wrong exception " & Message);
+  end Fixed_Conversion_Check;
+
+  procedure Fixed_To_Short is
+    new Fixed_Conversion_Check( Duration, Unsigned_Edge_8 );
+
+  procedure Fixed_To_Eight is
+    new Fixed_Conversion_Check( Duration, Unsigned_8_Bit );
+
+  procedure Fixed_To_Wide is
+    new Fixed_Conversion_Check( Duration, Unsigned_Over_8 );
+
+  function Identity( A_Stitch: Duration ) return Duration is
+    Threadbare : constant Duration := 0.0;
+  begin
+    if Report.Ident_Bool( A_Stitch = Threadbare ) then
+      return Threadbare;
+    else
+      return A_Stitch;
+    end if;
+  end Identity;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+begin  -- Main test procedure.
+
+  Report.Test ("C460008", "Check that conversion to " &
+                          "a modular type raises Constraint_Error when " &
+                          "the operand value is outside the base range " &
+                          "of the modular type" );
+
+
+  -- Integer Error cases
+
+  Int_To_Short( Report.Ident_Int( -1 ), "I2S Dynamic, Negative" );
+  Int_To_Short( Report.Ident_Int( Shy_By_One ), "I2S Dynamic, At_Mod" );
+  Int_To_Short( Report.Ident_Int( Heavy_By_Two+1 ), "I2S Dynamic, Over_Mod" );
+
+  Int_To_Eight( -Shy_By_One, "I28 Static,  Negative" );
+  Int_To_Eight( 2**8, "I28 Static,  At_Mod" );
+  Int_To_Eight( Heavy_By_Two+1, "I28 Static,  Over_Mod" );
+
+  Int_To_Wide ( Report.Ident_Int( -(Heavy_By_Two*2) ),
+                "I2W Dynamic, Negative" );
+  Int_To_Wide ( Heavy_By_Two, "I2W Static,  At_Mod" );
+  Int_To_Wide ( Report.Ident_Int( Heavy_By_Two*2 ), "I2W Dynamic, Over_Mod" );
+
+  -- Float Error cases
+
+  Float_To_Short( -13.31, "F2S Static,  Negative" );
+  Float_To_Short( Identity ( Float(Shy_By_One)), "F2S Dynamic, At_Mod" );
+  Float_To_Short( 6378.388, "F2S Static,  Over_Mod" );
+
+  Float_To_Eight( Identity( -99.3574 ), "F28 Dynamic, Negative" );
+  Float_To_Eight( 2.0**8, "F28 Static,  At_Mod" );
+  Float_To_Eight( 2.0**9, "F28 Static,  Over_Mod" );
+
+  Float_To_Wide ( -0.54953_93129_81644, "FTW Static,  Negative" );
+  Float_To_Wide ( Identity( 2.0**8 +2.0 ), "FTW Dynamic, At_Mod" );
+  Float_To_Wide ( Identity( 2.0**8 +2.5001 ), "FTW Dynamic, Over_Mod" );
+  Float_To_Wide ( Identity( Float'Last ), "FTW Dynamic, Over_Mod" );
+
+  -- Fixed Error cases
+
+  Fixed_To_Short( Identity( -5.00 ), "D2S Dynamic, Negative" );
+  Fixed_To_Short( Shy_By_One * 1.0, "D2S Static,  At_Mod" );
+  Fixed_To_Short( 1995.9, "D2S Static,  Over_Mod" );
+
+  Fixed_To_Eight( -0.5, "D28 Static, Negative" );
+  Fixed_To_Eight( 2.0*128, "D28 Static,  At_Mod" );
+  Fixed_To_Eight( Identity( 2001.2 ), "D28 Dynamic, Over_Mod" );
+
+  Fixed_To_Wide ( Duration'First, "D2W Static,  Negative" );
+  Fixed_To_Wide ( Identity( 2*128.0 +2.0 ), "D2W Dynamic, At_Mod" );
+  Fixed_To_Wide ( Duration'Last, "D2W Static,  Over_Mod" );
+
+  -- having made it this far, the rest is downhill...
+  -- check a few, correct, edge cases, and we're done
+
+  Eye_Dew: declare
+    A_Float   : Float    := 0.0;
+    Your_Time : Duration := 0.0;
+    Number    : Integer  := 0;
+
+    Little   : Unsigned_Edge_8;
+    Moderate : Unsigned_8_Bit;
+    Big      : Unsigned_Over_8;
+
+  begin
+    Little := Unsigned_Edge_8(A_Float);
+    Assert( Little = 0, "Float => Little, 0");
+
+
+    Moderate := Unsigned_8_Bit (Your_Time);
+    Assert( Moderate = 0, "Your_Time => Moderate, 0");
+
+    Big := Unsigned_Over_8 (Number);
+    Assert( Big = 0, "Number => Big, 0");
+
+    A_Float   := 2.0**8-2.0;
+    Your_Time := 2.0*128-2.0;
+    Number    := 2**8;
+
+    Little := Unsigned_Edge_8(A_Float);
+    Assert( Little = 254, "Float => Little, 254");
+
+    Little := Unsigned_Edge_8(Your_Time);
+    Assert( Little = 254, "Your_Time => Little, 254");
+
+    Big := Unsigned_Over_8 (A_Float + 2.0);
+    Assert( Big = 256, "Sense => Big, 256");
+
+    Big := Unsigned_Over_8 (Number);
+    Assert( Big = 256, "Number => Big, 256");
+
+  end Eye_Dew;
+
+  Report.Result;
+
+end C460008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460009.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460009.a
new file mode 100644
index 000000000..62dbd47c2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460009.a
@@ -0,0 +1,467 @@
+-- C460009.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 Constraint_Error is raised in cases of null arrays when:
+--     1.  an assignment is made to a null array if the length of each
+--         dimension of the operand does not match the length of 
+--         the corresponding dimension of the target subtype.
+--     2.  an array actual parameter does not match the length of
+--         corresponding dimensions of the formal in out parameter where
+--         the actual parameter has the form of a type conversion.     
+--     3.  an array actual parameter does not match the length of
+--         corresponding dimensions of the formal out parameter where
+--         the actual parameter has the form of a type conversion.     
+--
+-- TEST DESCRIPTION:
+--      This transition test creates examples where array of null ranges 
+--      raises Constraint_Error if any of the lengths mismatch.
+--
+--      Inspired by C52103S.ADA, C64105E.ADA, and C64105F.ADA.
+--
+--
+-- CHANGE HISTORY:
+--      21 Mar 96   SAIC    Initial version for ACVC 2.1.
+--      21 Sep 96   SAIC    ACVC 2.1: Added new case.
+--
+--!
+
+with Report;
+
+procedure C460009 is
+
+   subtype Int is Integer range 1 .. 3;
+
+begin
+
+   Report.Test("C460009","Check that Constraint_Error is raised in "  &
+               "cases of null arrays if any of the lengths mismatch " & 
+               "in assignments and parameter passing");
+
+   ---------------------------------------------------------------------------
+   declare
+
+      type Arr_Int1 is array (Int range <>) of Integer;
+      Arr_Obj1 : Arr_Int1 (2 .. Report.Ident_Int(1));     -- null array object
+
+   begin
+
+      -- Same lengths, no Constraint_Error raised.
+      Arr_Obj1 := (Report.Ident_Int(3) .. 2 => Report.Ident_Int(1));
+
+      Report.Comment ("Dead assignment prevention in Arr_Obj1 => " &
+                       Integer'Image (Arr_Obj1'Last));
+
+   exception
+
+      when Constraint_Error => 
+        Report.Failed ("Arr_Obj1 - Constraint_Error exception raised");
+      when others           => 
+        Report.Failed ("Arr_Obj1 - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   declare
+
+      type Arr_Int2 is array (Int range <>, Int range <>) of Integer;
+      Arr_Obj2 : Arr_Int2 (1 .. Report.Ident_Int(2), 
+                           Report.Ident_Int(3) .. Report.Ident_Int(2));
+                                                           -- null array object
+   begin
+
+      -- Same lengths, no Constraint_Error raised.
+      Arr_Obj2 := Arr_Int2'(Report.Ident_Int(2) .. 3 => 
+                  (Report.Ident_Int(2) .. Report.Ident_Int(1) =>  
+                   Report.Ident_Int(1)));
+
+      Report.Comment ("Dead assignment prevention in Arr_Obj2 => " &
+                       Integer'Image (Arr_Obj2'Last));
+
+   exception
+
+      when Constraint_Error => 
+        Report.Failed ("Arr_Obj2 - Constraint_Error exception raised");
+      when others           => 
+        Report.Failed ("Arr_Obj2 - others exception raised");
+
+   end;
+   
+   ---------------------------------------------------------------------------
+   declare
+
+      type Arr_Int3 is array (Int range <>, Int range <>) of Integer;
+      Arr_Obj3 : Arr_Int3 (1 .. Report.Ident_Int(2), 
+                           Report.Ident_Int(3) .. Report.Ident_Int(2));
+                                                           -- null array object
+
+   begin
+
+      -- Lengths mismatch, Constraint_Error raised.
+      Arr_Obj3 := Arr_Int3'(Report.Ident_Int(3) .. 2 => 
+                  (Report.Ident_Int(1) .. Report.Ident_Int(3) =>  
+                   Report.Ident_Int(1)));
+
+      Report.Comment ("Dead assignment prevention in Arr_Obj3 => " &
+                       Integer'Image (Arr_Obj3'Last));
+
+      Report.Failed ("Constraint_Error not raised in Arr_Obj3");
+
+   exception
+
+      when Constraint_Error => null;      -- exception expected.
+      when others           => 
+        Report.Failed ("Arr_Obj3 - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   declare
+
+      type Arr_Int4 is array (Int range <>, Int range <>, Int range <>) of 
+        Integer;
+      Arr_Obj4 : Arr_Int4 (1 .. Report.Ident_Int(2), 
+                           Report.Ident_Int(1) .. Report.Ident_Int(3),
+                           Report.Ident_Int(3) .. Report.Ident_Int(2));
+                                                           -- null array object
+   begin
+
+      -- Lengths mismatch, Constraint_Error raised.
+      Arr_Obj4 := Arr_Int4'(Report.Ident_Int(1) .. 3 => 
+                  (Report.Ident_Int(1) .. Report.Ident_Int(2) =>  
+                   (Report.Ident_Int(3) .. Report.Ident_Int(2) =>  
+                   Report.Ident_Int(1))));
+
+      Report.Comment ("Dead assignment prevention in Arr_Obj4 => " &
+                       Integer'Image (Arr_Obj4'Last));
+
+      Report.Failed ("Constraint_Error not raised in Arr_Obj4");
+
+   exception
+
+      when Constraint_Error => null;      -- exception expected.
+      when others           => 
+        Report.Failed ("Arr_Obj4 - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   declare
+
+      type Arr_Int5 is array (Int range <>) of Integer;
+      Arr_Obj5 : Arr_Int5 (2 .. Report.Ident_Int(1));     -- null array object
+
+   begin
+
+      -- Only lengths of two null ranges are different, no Constraint_Error 
+      -- raised.
+      Arr_Obj5 := (Report.Ident_Int(3) .. 1 => Report.Ident_Int(1));
+
+      Report.Comment ("Dead assignment prevention in Arr_Obj5 => " &
+                       Integer'Image (Arr_Obj5'Last));
+
+   exception
+
+      when Constraint_Error => 
+        Report.Failed ("Arr_Obj5 - Constraint_Error exception raised");
+      when others           => 
+        Report.Failed ("Arr_Obj5 - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   declare
+      subtype Str is String (Report.Ident_Int(5) .. 4);  
+                                                            -- null string
+      Str_Obj : Str;
+
+   begin
+
+      -- Same lengths, no Constraint_Error raised.
+      Str_Obj := (Report.Ident_Int(1) .. 0 => 'Z');
+      Str_Obj(2 .. 1) := "";
+      Str_Obj(4 .. 2) := (others => 'X');
+      Str_Obj(Report.Ident_Int(6) .. 3) := "";
+      Str_Obj(Report.Ident_Int(0) .. Report.Ident_Int(-1)) := (others => 'Y');
+
+   exception
+
+      when Constraint_Error => 
+        Report.Failed ("Str_Obj - Constraint_Error exception raised");
+      when others           => 
+        Report.Failed ("Str_Obj - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   declare
+
+      type Arr_Char5 is array (Int range <>, Int range <>) of Character;
+      subtype Formal is Arr_Char5 
+        (Report.Ident_Int(2) .. 0, 1 .. Report.Ident_Int(3));  
+      Arr_Obj5 : Arr_Char5 (Report.Ident_Int(2) .. Report.Ident_Int(1),
+                            Report.Ident_Int(1) .. Report.Ident_Int(2))
+               := (Report.Ident_Int(2) .. Report.Ident_Int(1) =>
+                  (Report.Ident_Int(1) .. Report.Ident_Int(2) => ' ')); 
+
+      procedure Proc5 (P : in out Formal) is
+      begin
+         Report.Failed ("No exception raised in Proc5");
+
+      exception       
+
+         when Constraint_Error => 
+           Report.Failed ("Constraint_Error exception raised in Proc5");
+         when others           => 
+           Report.Failed ("Others exception raised in Proc5");
+      end;            
+
+   begin
+
+      -- Lengths mismatch in the type conversion, Constraint_Error raised.
+      Proc5 (Formal(Arr_Obj5));
+
+      Report.Failed ("Constraint_Error not raised in the call Proc5");
+
+   exception
+
+      when Constraint_Error => null;      -- exception expected.
+      when others           => 
+        Report.Failed ("Arr_Obj5 - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   declare
+
+      type Formal is array 
+        (Report.Ident_Int(1) .. 3, 3 .. Report.Ident_Int(1)) of Character;
+
+      type Actual is array 
+        (Report.Ident_Int(5) .. 3, 3 .. Report.Ident_Int(5)) of Character;
+
+      Arr_Obj6 : Actual := (5 .. 3 => (3 .. 5 => ' '));
+
+      procedure Proc6 (P : in out Formal) is
+      begin
+         Report.Failed ("No exception raised in Proc6");
+
+      exception       
+
+         when Constraint_Error => 
+           Report.Failed ("Constraint_Error exception raised in Proc6");
+         when others           => 
+           Report.Failed ("Others exception raised in Proc6");
+      end;            
+
+   begin
+
+      -- Lengths mismatch in the type conversion, Constraint_Error raised.
+      Proc6 (Formal(Arr_Obj6));
+
+      Report.Failed ("Constraint_Error not raised in the call Proc6");
+
+   exception
+
+      when Constraint_Error => null;      -- exception expected.
+      when others           => 
+        Report.Failed ("Arr_Obj6 - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   declare
+
+      type Formal is array (Int range <>, Int range <>) of Character;
+      type Actual is array (Positive range 5 .. 2,
+                            Positive range 1 .. 3) of Character;
+
+      Arr_Obj7 : Actual := (5 .. 2 => (1 .. 3 => ' '));
+
+      procedure Proc7 (P : in out Formal) is
+      begin
+         if P'Last /= 2 and P'Last(2) /= 3 then
+            Report.Failed ("Wrong bounds passed for Arr_Obj7");
+         end if;
+
+         -- Lengths mismatch, Constraint_Error raised.
+         P := (1 .. 3 => (3 .. 0 => ' '));
+
+         Report.Comment ("Dead assignment prevention in Proc7 => " &
+                          Integer'Image (P'Last));
+
+         Report.Failed ("No exception raised in Proc7");
+
+      exception       
+
+         when Constraint_Error => null;      -- exception expected.
+         when others           => 
+           Report.Failed ("Others exception raised in Proc7");
+      end;            
+
+   begin
+
+      -- Same lengths, no Constraint_Error raised.
+      Proc7 (Formal(Arr_Obj7));
+
+      if Arr_Obj7'Last /= 2 and Arr_Obj7'Last(2) /= 3 then
+         Report.Failed ("Bounds changed for Arr_Obj7");
+      end if;
+
+   exception
+
+      when Constraint_Error => 
+        Report.Failed ("Constraint_Error exception raised after call Proc7");
+      when others           => 
+        Report.Failed ("Arr_Obj7 - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   declare
+
+      type Arr_Char8 is array (Int range <>, Int range <>) of Character;
+      subtype Formal is Arr_Char8 
+        (Report.Ident_Int(2) .. 0, 1 .. Report.Ident_Int(3));  
+      Arr_Obj8 : Arr_Char8 (Report.Ident_Int(2) .. Report.Ident_Int(1),
+                            Report.Ident_Int(1) .. Report.Ident_Int(2));
+
+      procedure Proc8 (P : out Formal) is
+      begin
+         Report.Failed ("No exception raised in Proc8");
+
+      exception       
+
+         when Constraint_Error => 
+           Report.Failed ("Constraint_Error exception raised in Proc8");
+         when others           => 
+           Report.Failed ("Others exception raised in Proc8");
+      end;            
+
+   begin
+
+      -- Lengths mismatch in the type conversion, Constraint_Error raised.
+      Proc8 (Formal(Arr_Obj8));
+
+      Report.Failed ("Constraint_Error not raised in the call Proc8");
+
+   exception
+
+      when Constraint_Error => null;      -- exception expected.
+      when others           => 
+        Report.Failed ("Arr_Obj8 - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   declare
+
+      type Formal is array 
+        (Report.Ident_Int(1) .. 3, 3 .. Report.Ident_Int(1)) of Character;
+
+      type Actual is array 
+        (Report.Ident_Int(5) .. 3, 3 .. Report.Ident_Int(5)) of Character;
+
+      Arr_Obj9 : Actual;
+
+      procedure Proc9 (P : out Formal) is
+      begin
+         Report.Failed ("No exception raised in Proc9");
+
+      exception       
+
+         when Constraint_Error => 
+           Report.Failed ("Constraint_Error exception raised in Proc9");
+         when others           => 
+           Report.Failed ("Others exception raised in Proc9");
+      end;            
+
+   begin
+
+      -- Lengths mismatch in the type conversion, Constraint_Error raised.
+      Proc9 (Formal(Arr_Obj9));
+
+      Report.Failed ("Constraint_Error not raised in the call Proc9");
+
+   exception
+
+      when Constraint_Error => null;      -- exception expected.
+      when others           => 
+        Report.Failed ("Arr_Obj9 - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   declare
+
+      type Formal is array (Int range <>, Int range <>) of Character;
+      type Actual is array (Positive range 5 .. 2,
+                            Positive range 1 .. 3) of Character;
+
+      Arr_Obj10 : Actual;
+
+      procedure Proc10 (P : out Formal) is
+      begin
+         if P'Last /= 2 and P'Last(2) /= 3 then
+            Report.Failed ("Wrong bounds passed for Arr_Obj10");
+         end if;
+
+         -- Lengths mismatch, Constraint_Error raised.
+         P := (1 .. 3 => (3 .. 1 => ' '));
+
+         Report.Comment ("Dead assignment prevention in Proc10 => " &
+                          Integer'Image (P'Last));
+
+         Report.Failed ("No exception raised in Proc10");
+
+      exception       
+
+         when Constraint_Error => null;      -- exception expected.
+         when others           => 
+           Report.Failed ("Others exception raised in Proc10");
+      end;            
+
+   begin
+
+      -- Same lengths, no Constraint_Error raised.
+      Proc10 (Formal(Arr_Obj10));
+
+      if Arr_Obj10'Last /= 2 and Arr_Obj10'Last(2) /= 3 then
+         Report.Failed ("Bounds changed for Arr_Obj10");
+      end if;
+
+   exception
+
+      when Constraint_Error => 
+        Report.Failed ("Constraint_Error exception raised after call Proc10");
+      when others           => 
+        Report.Failed ("Arr_Obj10 - others exception raised");
+
+   end;
+
+   ---------------------------------------------------------------------------
+   Report.Result;
+
+end C460009;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460010.a
new file mode 100644
index 000000000..790a8c339
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460010.a
@@ -0,0 +1,354 @@
+-- C460010.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, for an array aggregate without an others choice assigned
+--      to an object of a constrained array subtype, Constraint_Error is not
+--      raised if the length of each dimension of the aggregate equals the
+--      length of the corresponding dimension of the target object, even if
+--      the bounds of the corresponding index ranges do not match.
+--
+-- TEST DESCRIPTION:
+--      The test verifies that sliding of array bounds is performed on array
+--      aggregates that are part of a larger aggregate, where the bounds of
+--      the corresponding index ranges do not match but the lengths of the
+--      corresponding dimensions are the same. Both aggregates containing
+--      named associations and positional associations are checked. Cases
+--      involving static and nonstatic index constraints, as well as pre-
+--      defined and modular integer index subtypes, are included.
+--
+--
+-- CHANGE HISTORY:
+--      15 Apr 96   SAIC    Prerelease version for ACVC 2.1.
+--      20 Oct 96   SAIC    Removed unnecessary parentheses and type
+--                          conversions.
+--
+--!
+
+with Report;
+pragma Elaborate (Report);
+
+package C460010_0 is
+
+  type Modular_Type is mod 10;  -- Range 0 .. 9.
+
+
+  Two  : Modular_Type := Modular_Type (Report.Ident_Int(2));
+  Four : Modular_Type := Modular_Type (Report.Ident_Int(4));
+
+  type Array_Modular_Index is array (Modular_Type range <>) of Integer;
+
+  subtype Array_Static_Modular_Constraint    is Array_Modular_Index(2..4);
+  subtype Array_Nonstatic_Modular_Constraint is Array_Modular_Index(Two..Four);
+
+end C460010_0;
+
+
+     --==================================================================--
+
+
+with Report;
+pragma Elaborate (Report);
+
+package C460010_1 is
+
+  One  : Integer := Report.Ident_Int(1);
+  Ten  : Integer := Report.Ident_Int(10);
+
+  subtype Integer_Subtype is Integer range One .. Ten;
+
+
+  Two  : Integer := Report.Ident_Int(2);
+  Four : Integer := Report.Ident_Int(4);
+
+  type Array_Integer_Index is array (Integer_Subtype range <>) of Boolean;
+
+  subtype Array_Static_Integer_Constraint    is Array_Integer_Index(2..4);
+  subtype Array_Nonstatic_Integer_Constraint is Array_Integer_Index(Two..Four);
+
+end C460010_1;
+
+
+     --==================================================================--
+
+
+-- Generic equality function:
+
+generic
+   type Operand_Type is private;
+function C460010_2 (L, R : Operand_Type) return Boolean;
+
+
+function C460010_2 (L, R : Operand_Type) return Boolean is
+begin
+   return L = R;
+end C460010_2;
+
+
+     --==================================================================--
+
+
+with C460010_0;
+with C460010_1;
+with C460010_2;
+
+with Report;
+
+procedure C460010 is
+
+   generic function Generic_Equality renames C460010_2;
+
+begin
+   Report.Test ("C460010", "Check that Constraint_Error is not raised if " &
+                "an array aggregate without an others choice is assigned " &
+                "to an object of a constrained array subtype, and the "    &
+                "length of each dimension of the aggregate equals the "    &
+                "length of the corresponding dimension of the target object");
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   declare
+     type Arr is array (1..1) of C460010_0.Array_Static_Modular_Constraint;
+     function Equals is new Generic_Equality (Arr);
+     Target : Arr;
+   begin
+                       ---=---=---=---=---=---=---
+     CASE_1:
+     begin
+        Target := (1 => (1 => 1, 2 => 2, 3 => 3));  -- Named associations.
+
+        if not Equals (Target, Target) then
+             Report.Failed ("Avoid optimization");  -- Never executed.
+        end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised: Case 1");
+         when others           =>
+            Report.Failed ("Unexpected exception raised: Case 1");
+      end CASE_1;
+
+                       ---=---=---=---=---=---=---
+
+     CASE_2:
+     begin
+        Target := (1 => (5, 10, 15));  -- Positional associations.
+
+        if not Equals (Target, Target) then
+             Report.Failed ("Avoid optimization");  -- Never executed.
+        end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised: Case 2");
+         when others           =>
+            Report.Failed ("Unexpected exception raised: Case 2");
+      end CASE_2;
+
+                       ---=---=---=---=---=---=---
+   end;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   declare
+     type Rec (Disc : C460010_0.Modular_Type := 4) is record
+       Arr : C460010_0.Array_Modular_Index(2 .. Disc);
+     end record;
+
+     function Equals is new Generic_Equality (Rec);
+     Target : Rec;
+   begin
+                       ---=---=---=---=---=---=---
+     CASE_3:
+     begin
+        Target := (Disc => 4, Arr => (1 => 1, 2 => 2, 3 => 3));  -- Named.
+
+        if not Equals (Target, Target) then
+             Report.Failed ("Avoid optimization");  -- Never executed.
+        end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised: Case 3");
+         when others           =>
+            Report.Failed ("Unexpected exception raised: Case 3");
+      end CASE_3;
+
+                       ---=---=---=---=---=---=---
+
+     CASE_4:
+     begin
+        Target := (Disc => 4, Arr => (1 ,2, 3));    -- Positional.
+
+        if not Equals (Target, Target) then
+             Report.Failed ("Avoid optimization");  -- Never executed.
+        end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised: Case 4");
+         when others           =>
+            Report.Failed ("Unexpected exception raised: Case 4");
+      end CASE_4;
+
+                       ---=---=---=---=---=---=---
+   end;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   declare
+     type Arr is array (1..1) of C460010_0.Array_Nonstatic_Modular_Constraint;
+     function Equals is new Generic_Equality (Arr);
+     Target : Arr;
+   begin
+                       ---=---=---=---=---=---=---
+     CASE_5:
+     begin
+        Target := (1 => (1 => 1, 2 => 2, 3 => 3));  -- Named associations.
+
+        if not Equals (Target, Target) then
+             Report.Failed ("Avoid optimization");  -- Never executed.
+        end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised: Case 5");
+         when others           =>
+            Report.Failed ("Unexpected exception raised: Case 5");
+      end CASE_5;
+
+                       ---=---=---=---=---=---=---
+
+     CASE_6:
+     begin
+        Target := (1 => ((5, 10, 15)));  -- Positional associations.
+
+        if not Equals (Target, Target) then
+             Report.Failed ("Avoid optimization");  -- Never executed.
+        end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised: Case 6");
+         when others           =>
+            Report.Failed ("Unexpected exception raised: Case 6");
+      end CASE_6;
+
+                       ---=---=---=---=---=---=---
+   end;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   declare
+     type Arr is array (1..1) of C460010_1.Array_Static_Integer_Constraint;
+     function Equals is new Generic_Equality (Arr);
+     Target : Arr;
+   begin
+                       ---=---=---=---=---=---=---
+     CASE_7:
+     begin
+        Target := (1 => (1 => True, 2 => True, 3 => False));  -- Named.
+
+        if not Equals (Target, Target) then
+             Report.Failed ("Avoid optimization");  -- Never executed.
+        end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised: Case 7");
+         when others           =>
+            Report.Failed ("Unexpected exception raised: Case 7");
+      end CASE_7;
+
+                       ---=---=---=---=---=---=---
+
+     CASE_8:
+     begin
+        Target := (1 => ((False, False, True)));  -- Positional.
+
+        if not Equals (Target, Target) then
+             Report.Failed ("Avoid optimization");  -- Never executed.
+        end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised: Case 8");
+         when others           =>
+            Report.Failed ("Unexpected exception raised: Case 8");
+      end CASE_8;
+
+                       ---=---=---=---=---=---=---
+   end;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   declare
+     type Arr is array (1..1) of C460010_1.Array_Nonstatic_Integer_Constraint;
+     function Equals is new Generic_Equality (Arr);
+     Target : Arr;
+   begin
+                       ---=---=---=---=---=---=---
+     CASE_9:
+     begin
+        Target := (1 => (1 => True, 2 => True, 3 => False));  -- Named.
+
+        if not Equals (Target, Target) then
+             Report.Failed ("Avoid optimization");  -- Never executed.
+        end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised: Case 9");
+         when others           =>
+            Report.Failed ("Unexpected exception raised: Case 9");
+      end CASE_9;
+
+                       ---=---=---=---=---=---=---
+
+     CASE_10:
+     begin
+        Target := (1 => (False, False, True));      -- Positional.
+
+        if not Equals (Target, Target) then
+             Report.Failed ("Avoid optimization");  -- Never executed.
+        end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised: Case 10");
+         when others           =>
+            Report.Failed ("Unexpected exception raised: Case 10");
+      end CASE_10;
+
+                       ---=---=---=---=---=---=---
+   end;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+     Report.Result;
+
+end C460010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460011.a
new file mode 100644
index 000000000..78038a2bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460011.a
@@ -0,0 +1,210 @@
+-- C460011.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are 
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release, 
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+--     WARRANTY AS TO ANY MATTER 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 conversion of a decimal type to a modular type raises
+--     Constraint_Error when the operand value is outside the base range
+--     of the modular type.
+--     Check that a conversion of a decimal type to an integer type
+--     rounds correctly.
+--
+-- TEST DESCRIPTION:
+--      Test conversion from decimal types to modular types.  Test
+--      conversion to mod 255, mod 256 and mod 258 to test the boundaries
+--      of 8 bit (+/-) unsigned numbers.
+--      Test operand values that are negative, the value of the mod,
+--      and greater than the value of the mod.
+--      Declare a generic test procedure and instantiate it for each of the
+--      unsigned types for each operand type.
+--      Check that the operand is properly rounded during the conversion.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations which support
+--      decimal types.
+--
+-- CHANGE HISTORY:
+--      24 NOV 98   RLB  Split decimal cases from C460008 into this
+--                       test, added conversions to integer types.
+--      18 JAN 99   RLB  Repaired errors in test.
+--
+--!
+
+------------------------------------------------------------------- C460011
+
+with Report;
+
+procedure C460011 is
+
+  Shy_By_One   : constant := 2**8-1;
+  Heavy_By_Two : constant := 2**8+2;
+
+  type Unsigned_Edge_8 is mod Shy_By_One;
+  type Unsigned_8_Bit  is mod 2**8;
+  type Unsigned_Over_8 is mod Heavy_By_Two;
+
+  type Signed_8_Bit is range -128 .. 127;
+  type Signed_Over_8 is range -200 .. 200;
+
+  NPC : constant String := " not properly converted";
+
+  procedure Assert( Truth: Boolean; Message: String ) is
+  begin
+    if not Truth then
+      Report.Failed(Message);
+    end if;
+  end Assert;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  type Decim is delta 0.1 digits 5;    -- N/A => ERROR.
+
+  generic
+    type Source is delta <> digits <>;
+    type Target is mod <>;
+  procedure Decimal_Conversion_Check( For_The_Value : Source;
+                                      Message       : String );
+
+  procedure Decimal_Conversion_Check( For_The_Value : Source;
+                                      Message       : String ) is
+
+    Item : Target;
+
+  begin  
+    Item := Target( For_The_Value );
+    Report.Failed("Deci expected Constraint_Error " & Message);
+    Report.Comment("Value of" & Target'Image(Item) & NPC);
+  exception
+    when Constraint_Error => null; -- expected case
+    when others => Report.Failed("Deci raised wrong exception " & Message);
+  end Decimal_Conversion_Check;
+
+  procedure Decim_To_Short is
+    new Decimal_Conversion_Check( Decim, Unsigned_Edge_8 );
+
+  procedure Decim_To_Eight is
+    new Decimal_Conversion_Check( Decim, Unsigned_8_Bit );
+
+  procedure Decim_To_Wide is
+    new Decimal_Conversion_Check( Decim, Unsigned_Over_8 );
+
+  function Identity( Launder: Decim ) return Decim is
+    Flat_Broke : constant Decim := 0.0;
+  begin
+    if Report.Ident_Bool( Launder = Flat_Broke ) then
+      return Flat_Broke;
+    else
+      return Launder;
+    end if;
+  end Identity;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+begin  -- Main test procedure.
+
+  Report.Test ("C460011", "Check that conversion to " &
+                          "a modular type raises Constraint_Error when " &
+                          "the operand value is outside the base range " &
+                          "of the modular type" );
+   
+  -- Decimal Error cases
+
+  Decim_To_Short( Identity( -5.00 ), "M2S Dynamic, Negative" );
+  Decim_To_Short( Shy_By_One * 1.0, "M2S Static,  At_Mod" );
+  Decim_To_Short( 1995.9, "M2S Static,  Over_Mod" );
+
+  Decim_To_Eight( -0.5, "M28 Static, Negative" );
+  Decim_To_Eight( 2.0*128, "M28 Static,  At_Mod" );
+  Decim_To_Eight( Identity( 2001.2 ), "M28 Dynamic, Over_Mod" );
+
+  Decim_To_Wide ( Decim'First, "M2W Static,  Negative" );
+  Decim_To_Wide ( Identity( 2*128.0 +2.0 ), "M2W Dynamic, At_Mod" );
+  Decim_To_Wide ( Decim'Last, "M2W Static,  Over_Mod" );
+
+  -- Check a few, correct, edge cases, for modular types.
+
+  Eye_Dew: declare
+    Sense     : Decim    := 0.00;
+
+    Little   : Unsigned_Edge_8;
+    Moderate : Unsigned_8_Bit;
+    Big      : Unsigned_Over_8;
+
+  begin
+    Moderate := Unsigned_8_Bit (Sense);
+    Assert( Moderate = 0, "Sense => Moderate, 0");
+
+    Sense     := 2*128.0;
+
+    Big := Unsigned_Over_8 (Sense);
+    Assert( Big = 256, "Sense => Big, 256");
+
+  end Eye_Dew;
+
+  Rounding: declare
+    Easy     : Decim  := Identity ( 2.0);
+    Simple   : Decim  := Identity ( 2.1);
+    Halfway  : Decim  := Identity ( 2.5);
+    Upward   : Decim  := Identity ( 2.8);
+    Chop     : Decim  := Identity (-2.2);
+    Neg_Half : Decim  := Identity (-2.5);
+    Downward : Decim  := Identity (-2.7);
+
+    Little   : Unsigned_Edge_8;
+    Moderate : Unsigned_8_Bit;
+    Big      : Unsigned_Over_8;
+
+    Also_Little:Signed_8_Bit;
+    Also_Big : Signed_Over_8;
+    
+  begin
+    Little := Unsigned_Edge_8 (Easy);
+    Assert( Little = 2, "Easy => Little, 2");
+
+    Moderate := Unsigned_8_Bit (Simple);
+    Assert( Moderate = 2, "Simple => Moderate, 2");
+
+    Big := Unsigned_Over_8 (Halfway); -- Rounds up by 4.6(33).
+    Assert( Big = 3, "Halfway => Big, 3");
+
+    Little := Unsigned_Edge_8 (Upward);
+    Assert( Little = 3, "Upward => Little, 3");
+
+    Also_Big := Signed_Over_8 (Halfway); -- Rounds up by 4.6(33).
+    Assert( Also_Big = 3, "Halfway => Also_Big, 3");
+
+    Also_Little := Signed_8_Bit (Chop);
+    Assert( Also_Little = -2, "Chop => Also_Little, -2");
+
+    Also_Big := Signed_Over_8 (Neg_Half); -- Rounds down by 4.6(33).
+    Assert( Also_Big = -3, "Halfway => Also_Big, -3");
+
+    Also_Little := Signed_8_Bit (Downward);
+    Assert( Also_Little = -3, "Downward => Also_Little, -3");
+
+  end Rounding;
+
+
+  Report.Result;
+
+end C460011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460012.a
new file mode 100644
index 000000000..0fb32060a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460012.a
@@ -0,0 +1,93 @@
+-- C460012.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that the view created by a view conversion is constrained if the
+--    target subtype is indefinite.  (Defect Report 8652/0017, Technical
+--    Corrigendum 4.6(54/1)).
+--
+-- CHANGE HISTORY:
+--    25 JAN 2001   PHL   Initial version.
+--    29 JUN 2001   RLB   Reformatted for ACATS. Added optimization blocking.
+--    02 JUL 2001   RLB   Fixed discriminant reference.
+--
+--!
+with Ada.Exceptions;
+use Ada.Exceptions;
+with Report;
+use Report;
+procedure C460012 is
+
+    subtype Index is Positive range 1 .. 10;
+
+    type Definite_Parent (D1 : Index := 6) is
+	record
+	    F : String (1 .. D1) := (others => 'a');
+	end record;
+
+    type Indefinite_Child (D2 : Index) is new Definite_Parent (D1 => D2);
+
+    Y : Definite_Parent;
+
+    procedure P (X : in out Indefinite_Child) is
+	C : Character renames X.F (3);
+    begin
+	X := (1, "a");
+        if C /= 'a' then
+            Failed ("No exception raised when changing the " &
+		    "discriminant of a view conversion, value of C changed");
+        elsif X.D2 /= 1 then
+            Failed ("No exception raised when changing the " &
+		    "discriminant of a view conversion, discriminant not " &
+                    "changed");
+            -- This check primarily exists to prevent X from being optimized by
+            -- 11.6 permissions, or the Failed call being made before the assignment.
+        else
+            Failed ("No exception raised when changing the " &
+		    "discriminant of a view conversion, discriminant changed");
+        end if;
+    exception
+	when Constraint_Error =>
+	    null;
+	when E: others =>
+	    Failed ("Wrong exception " & Exception_Name (E) & " raised - " &
+		    Exception_Message (E));
+    end P;
+
+begin
+    Test ("C460012",
+             "Check that the view created by a view conversion " &
+	     "is constrained if the target subtype is indefinite");
+
+    P (Indefinite_Child (Y));
+
+    if Y.D1 /= Ident_Int(6) then
+	Failed ("Discriminant of indefinite view changed");
+        -- This check exists mainly to prevent Y from being optimized away.
+    end if;
+
+    Result;
+end C460012;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46011a.ada
new file mode 100644
index 000000000..16a1df6c7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46011a.ada
@@ -0,0 +1,145 @@
+-- C46011A.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 CONVERSIONS ARE PERFORMED CORRECTLY WHEN THE 
+-- TARGET AND OPERAND TYPES ARE BOTH INTEGER TYPES.
+
+-- R.WILLIAMS 9/8/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46011A IS
+
+     TYPE INT1 IS RANGE -100 .. 100;
+     I1 : INT1 := INT1'VAL (IDENT_INT (10));
+     F1 : INT1 := INT1'VAL (IDENT_INT (-100));
+     L1 : INT1 := INT1'VAL (IDENT_INT (100));
+
+     TYPE INT2 IS RANGE -100 .. 100;
+     I2 : INT2 := INT2'VAL (IDENT_INT (10));
+     F2 : INT2 := INT2'VAL (IDENT_INT (-100));
+     L2 : INT2 := INT2'VAL (IDENT_INT (100));
+
+     
+     TYPE NEWINTEGER IS NEW INTEGER;
+     N1 : NEWINTEGER := 
+          NEWINTEGER'VAL (IDENT_INT (10));
+
+     T1 : INTEGER := IDENT_INT (10);
+
+     U1 : CONSTANT := INTEGER'POS (10);
+BEGIN
+     TEST ( "C46011A", "CHECK THAT INTEGER CONVERSIONS ARE " &
+                       "PERFORMED CORRECTLY WHEN THE TARGET AND " &
+                       "OPERAND TYPES ARE BOTH INTEGER TYPES" );
+     
+     IF INT1 (U1) /= U1 THEN 
+          FAILED ( "INCORRECT CONVERSION OF 'INT1 (U1)'" );
+     END IF;
+
+     IF INT1 (I1) /= I1 THEN 
+          FAILED ( "INCORRECT CONVERSION OF 'INT1 (I1)'" );
+     END IF;
+
+     IF INT1 (N1) /= I1 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INT1 (N1)'" );
+     END IF;
+
+     IF INT1 (10) /= I1 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INT1 (10)'" );
+     END IF;
+
+     IF INT1 (T1) /= I1 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INT1 (T1)'" );
+     END IF;
+
+     IF INT1 (F2) /= F1 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INT1 (F2)'" );
+     END IF;
+
+     IF INT1 (L2) /= L1 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INT1 (L2)'" );
+     END IF;
+
+     IF INT2 (I1) /= I2 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INT2 (I1)'" );
+     END IF;
+
+     IF INT2 (T1) /= 10 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INT2 (T1)'" );
+     END IF;
+
+     IF INT2 (F1) /= -100 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INT2 (F1)'" );
+     END IF;
+
+     IF INT2 (L1) /= 100 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INT2 (L1)'" );
+     END IF;
+
+     IF NEWINTEGER (I1) /= N1 THEN 
+          FAILED ( "INCORRECT CONVERSION OF 'NEWINTEGER (I1)'" );
+     END IF;
+
+     IF NEWINTEGER (N1) /= N1 THEN 
+          FAILED ( "INCORRECT CONVERSION OF 'NEWINTEGER (N1)'" );
+     END IF;
+
+     IF NEWINTEGER (T1) /= N1 THEN 
+          FAILED ( "INCORRECT CONVERSION OF 'NEWINTEGER (T1)'" );
+     END IF;
+
+     IF NEWINTEGER (INTEGER (N1)) /= N1 THEN 
+          FAILED ( "INCORRECT CONVERSION OF " &
+                   "'NEWINTEGER (INTEGER (N1))'" );
+     END IF;
+
+     IF NEWINTEGER (INTEGER (N1 + 1)) /= 11 THEN 
+          FAILED ( "INCORRECT CONVERSION OF " &
+                   "'NEWINTEGER (INTEGER (N1 + 1))'" );
+     END IF;
+
+     IF INTEGER (10) /= T1 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INTEGER (10)'" );
+     END IF;
+
+     IF INTEGER (N1) /= 10 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INTEGER (N1)'" );
+     END IF;
+     
+     IF INTEGER (I1) /= T1 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INTEGER (I1)'" );
+     END IF;     
+
+     IF INTEGER (INT1 (NEWINTEGER (INT1 (I1)))) /= T1 THEN
+          FAILED ( "INCORRECT CONVERSION OF " &
+                   "'INTEGER (INT1 (NEWINTEGER (INT1 (I1)))'" );
+     END IF;     
+
+     
+     IF INTEGER (I1 + 1) /= 11 THEN
+          FAILED ( "INCORRECT CONVERSION OF 'INTEGER (I1 + 1)'" );
+     END IF;     
+
+     RESULT;
+END C46011A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46013a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46013a.ada
new file mode 100644
index 000000000..b9fa7d069
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46013a.ada
@@ -0,0 +1,260 @@
+-- C46013A.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 INTEGER CONVERSIONS ARE PERFORMED CORRECTLY WHEN THE
+--     OPERAND TYPE IS A FIXED POINT TYPE.
+
+-- HISTORY:
+--     JET 02/09/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C46013A IS
+
+     TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
+     TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
+     TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
+     TYPE FIX4 IS NEW FIX1;
+
+     F1 : FIX1 := 7.75;
+     F2 : FIX2 := -111.25;
+     F3 : FIX3 := 0.875;
+     F4 : FIX4 := -15.25;
+
+     TYPE INT IS RANGE -512 .. 512;
+
+     FUNCTION IDENT (I : INT) RETURN INT IS
+     BEGIN
+          RETURN I * INT(IDENT_INT(1));
+     END IDENT;
+
+BEGIN
+     TEST ("C46013A", "CHECK THAT INTEGER CONVERSIONS ARE PERFORMED " &
+                      "CORRECTLY WHEN THE OPERAND TYPE IS A FIXED " &
+                      "POINT TYPE");
+
+     IF INTEGER(FIX1'(-7.25)) /= IDENT_INT(-7) THEN
+          FAILED ("INCORRECT VALUE (1)");
+     END IF;
+
+     IF INTEGER(FIX1'(6.75)) /= IDENT_INT(7) THEN
+          FAILED ("INCORRECT VALUE (2)");
+     END IF;
+
+     IF INTEGER(F1) /= IDENT_INT(8) THEN
+          FAILED ("INCORRECT VALUE (3)");
+     END IF;
+
+     IF INT(FIX1'(-7.25)) /= IDENT(-7) THEN
+          FAILED ("INCORRECT VALUE (4)");
+     END IF;
+
+     IF INTEGER(FIX1'(3.33)) /= IDENT_INT(3) AND
+        INTEGER(FIX1'(3.33)) /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT VALUE (5)");
+     END IF;
+
+     IF INTEGER(FIX1'(-2.5)) = IDENT_INT(-2) AND
+        INTEGER(FIX1'(-1.5)) = IDENT_INT(-1) AND
+        INTEGER(FIX1'(1.5)) = IDENT_INT(2) AND
+        INTEGER(FIX1'(2.5)) = IDENT_INT(3) THEN
+          COMMENT ("FIX1 HALF VALUES ROUND UP");
+     ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-3) AND
+           INTEGER(FIX1'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX1'(1.5)) = IDENT_INT(1) AND
+           INTEGER(FIX1'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX1 HALF VALUES ROUND DOWN");
+     ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX1'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX1'(1.5)) = IDENT_INT(2) AND
+           INTEGER(FIX1'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX1 HALF VALUES ROUND TO EVEN");
+     ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX1'(-1.5)) = IDENT_INT(-1) AND
+           INTEGER(FIX1'(1.5)) = IDENT_INT(1) AND
+           INTEGER(FIX1'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX1 HALF VALUES ROUND TOWARD ZERO");
+     ELSIF INTEGER(FIX1'(-2.5)) = IDENT_INT(-3) AND
+           INTEGER(FIX1'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX1'(1.5)) = IDENT_INT(2) AND
+           INTEGER(FIX1'(2.5)) = IDENT_INT(3) THEN
+          COMMENT ("FIX1 HALF VALUES ROUND AWAY FROM ZERO");
+     ELSE
+          COMMENT ("FIX1 HALF VALUES ROUND ERRATICALLY");
+     END IF;
+
+     IF INTEGER(FIX2'(-127.9375)) /= IDENT_INT(-128) THEN
+          FAILED ("INCORRECT VALUE (6)");
+     END IF;
+
+     IF INTEGER(FIX2'(127.0625)) /= IDENT_INT(127) THEN
+          FAILED ("INCORRECT VALUE (7)");
+     END IF;
+
+     IF INTEGER(F2) /= IDENT_INT(-111) THEN
+          FAILED ("INCORRECT VALUE (8)");
+     END IF;
+
+     IF INT(FIX2'(-0.25)) /= IDENT(0) THEN
+          FAILED ("INCORRECT VALUE (9)");
+     END IF;
+
+     IF INTEGER(FIX2'(66.67)) /= IDENT_INT(67) AND
+        INTEGER(FIX2'(66.67)) /= IDENT_INT(66) THEN
+          FAILED ("INCORRECT VALUE (10)");
+     END IF;
+
+     IF INTEGER(FIX2'(-2.5)) = IDENT_INT(-2) AND
+        INTEGER(FIX2'(-1.5)) = IDENT_INT(-1) AND
+        INTEGER(FIX2'(1.5)) = IDENT_INT(2) AND
+        INTEGER(FIX2'(2.5)) = IDENT_INT(3) THEN
+          COMMENT ("FIX2 HALF VALUES ROUND UP");
+     ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-3) AND
+           INTEGER(FIX2'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX2'(1.5)) = IDENT_INT(1) AND
+           INTEGER(FIX2'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX2 HALF VALUES ROUND DOWN");
+     ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX2'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX2'(1.5)) = IDENT_INT(2) AND
+           INTEGER(FIX2'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX2 HALF VALUES ROUND TO EVEN");
+     ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX2'(-1.5)) = IDENT_INT(-1) AND
+           INTEGER(FIX2'(1.5)) = IDENT_INT(1) AND
+           INTEGER(FIX2'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX2 HALF VALUES ROUND TOWARD ZERO");
+     ELSIF INTEGER(FIX2'(-2.5)) = IDENT_INT(-3) AND
+           INTEGER(FIX2'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX2'(1.5)) = IDENT_INT(2) AND
+           INTEGER(FIX2'(2.5)) = IDENT_INT(3) THEN
+          COMMENT ("FIX2 HALF VALUES ROUND AWAY FROM ZERO");
+     ELSE
+          COMMENT ("FIX2 HALF VALUES ROUND ERRATICALLY");
+     END IF;
+
+     IF INTEGER(FIX3'(-0.25)) /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT VALUE (11)");
+     END IF;
+
+     IF INTEGER(FIX3'(511.75)) /= IDENT_INT(512) THEN
+          FAILED ("INCORRECT VALUE (12)");
+     END IF;
+
+     IF INTEGER(F3) /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE (13)");
+     END IF;
+
+     IF INT(FIX3'(-7.0)) /= IDENT(-7) THEN
+          FAILED ("INCORRECT VALUE (14)");
+     END IF;
+
+     IF INTEGER(FIX3'(-66.67)) /= IDENT_INT(-67) AND
+        INTEGER(FIX3'(-66.67)) /= IDENT_INT(-66) THEN
+          FAILED ("INCORRECT VALUE (15)");
+     END IF;
+
+     IF INTEGER(FIX3'(-2.5)) = IDENT_INT(-2) AND
+        INTEGER(FIX3'(-1.5)) = IDENT_INT(-1) AND
+        INTEGER(FIX3'(1.5)) = IDENT_INT(2) AND
+        INTEGER(FIX3'(2.5)) = IDENT_INT(3) THEN
+          COMMENT ("FIX3 HALF VALUES ROUND UP");
+     ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-3) AND
+           INTEGER(FIX3'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX3'(1.5)) = IDENT_INT(1) AND
+           INTEGER(FIX3'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX3 HALF VALUES ROUND DOWN");
+     ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX3'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX3'(1.5)) = IDENT_INT(2) AND
+           INTEGER(FIX3'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX3 HALF VALUES ROUND TO EVEN");
+     ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX3'(-1.5)) = IDENT_INT(-1) AND
+           INTEGER(FIX3'(1.5)) = IDENT_INT(1) AND
+           INTEGER(FIX3'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX3 HALF VALUES ROUND TOWARD ZERO");
+     ELSIF INTEGER(FIX3'(-2.5)) = IDENT_INT(-3) AND
+           INTEGER(FIX3'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX3'(1.5)) = IDENT_INT(2) AND
+           INTEGER(FIX3'(2.5)) = IDENT_INT(3) THEN
+          COMMENT ("FIX3 HALF VALUES ROUND AWAY FROM ZERO");
+     ELSE
+          COMMENT ("FIX3 HALF VALUES ROUND ERRATICALLY");
+     END IF;
+
+     IF INTEGER(FIX4'(-7.25)) /= IDENT_INT(-7) THEN
+          FAILED ("INCORRECT VALUE (16)");
+     END IF;
+
+     IF INTEGER(FIX4'(6.75)) /= IDENT_INT(7) THEN
+          FAILED ("INCORRECT VALUE (17)");
+     END IF;
+
+     IF INTEGER(F4) /= IDENT_INT(-15) THEN
+          FAILED ("INCORRECT VALUE (18)");
+     END IF;
+
+     IF INT(FIX4'(-31.75)) /= IDENT(-32) THEN
+          FAILED ("INCORRECT VALUE (19)");
+     END IF;
+
+     IF INTEGER(FIX4'(3.33)) /= IDENT_INT(3) AND
+        INTEGER(FIX4'(3.33)) /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT VALUE (20)");
+     END IF;
+
+     IF INTEGER(FIX4'(-2.5)) = IDENT_INT(-2) AND
+        INTEGER(FIX4'(-1.5)) = IDENT_INT(-1) AND
+        INTEGER(FIX4'(1.5)) = IDENT_INT(2) AND
+        INTEGER(FIX4'(2.5)) = IDENT_INT(3) THEN
+          COMMENT ("FIX4 HALF VALUES ROUND UP");
+     ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-3) AND
+           INTEGER(FIX4'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX4'(1.5)) = IDENT_INT(1) AND
+           INTEGER(FIX4'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX4 HALF VALUES ROUND DOWN");
+     ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX4'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX4'(1.5)) = IDENT_INT(2) AND
+           INTEGER(FIX4'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX4 HALF VALUES ROUND TO EVEN");
+     ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX4'(-1.5)) = IDENT_INT(-1) AND
+           INTEGER(FIX4'(1.5)) = IDENT_INT(1) AND
+           INTEGER(FIX4'(2.5)) = IDENT_INT(2) THEN
+          COMMENT ("FIX4 HALF VALUES ROUND TOWARD ZERO");
+     ELSIF INTEGER(FIX4'(-2.5)) = IDENT_INT(-3) AND
+           INTEGER(FIX4'(-1.5)) = IDENT_INT(-2) AND
+           INTEGER(FIX4'(1.5)) = IDENT_INT(2) AND
+           INTEGER(FIX4'(2.5)) = IDENT_INT(3) THEN
+          COMMENT ("FIX4 HALF VALUES ROUND AWAY FROM ZERO");
+     ELSE
+          COMMENT ("FIX4 HALF VALUES ROUND ERRATICALLY");
+     END IF;
+
+     RESULT;
+
+END C46013A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46014a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46014a.ada
new file mode 100644
index 000000000..9f47479df
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46014a.ada
@@ -0,0 +1,287 @@
+-- C46014A.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:
+--     FOR PREDEFINED TYPE INTEGER, CHECK THAT
+--     CONSTRAINT_ERROR IS RAISED IF THE OPERAND VALUE OF A
+--     CONVERSION LIES OUTSIDE OF THE RANGE OF THE TARGET TYPE'S BASE
+--     TYPE. ALSO, CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE
+--     OPERAND VALUE LIES OUTSIDE OF THE RANGE OF THE TARGET TYPE'S
+--     SUBTYPE BUT WITHIN THE RANGE OF THE BASE TYPE.
+
+-- HISTORY:
+--     RJW 09/08/86  CREATED ORIGINAL TEST.
+--     RJW 11/13/87  ADDED CODE TO PREVENT DEAD VARIABLE OPTIMIZATION.
+--     JET 12/30/87  ADDED MORE CODE TO PREVENT OPTIMIZATION.
+--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+--     JRL 12/08/96  Changed usages of System.Max_Int and System.Min_Int to
+--                   Integer'Base'Last and Integer'Base'First in first two
+--                   subtests.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46014A IS
+
+     SUBTYPE SMALL IS INTEGER RANGE -100 .. 100;
+     S1 : SMALL;
+
+     TYPE INT IS RANGE -100 .. 100;
+     T1 : INT;
+
+     TYPE NEWINTEGER IS NEW INTEGER;
+     N1 : NEWINTEGER;
+
+     SUBTYPE SUBNEW IS NEWINTEGER RANGE -100 .. 100;
+     SN : SUBNEW;
+
+     I1 : INTEGER;
+     P1 : POSITIVE;
+     L1 : NATURAL;
+
+     FUNCTION IDENT (I : INTEGER) RETURN INT IS
+     BEGIN
+          RETURN INT'VAL (IDENT_INT (I));
+     END IDENT;
+
+     FUNCTION IDENT (I : NEWINTEGER) RETURN NEWINTEGER IS
+     BEGIN
+          RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (I)));
+     END IDENT;
+
+BEGIN
+     TEST ( "C46014A", "FOR PREDEFINED TYPE INTEGER, CHECK THAT " &
+                       "CONSTRAINT_ERROR IS RAISED IF " &
+                       "THE OPERAND VALUE OF A CONVERSION LIES " &
+                       "OUTSIDE OF THE RANGE OF THE TARGET TYPE'S " &
+                       "BASE TYPE. ALSO, CHECK THAT " &
+                       "CONSTRAINT_ERROR IS RAISED IF THE OPERAND " &
+                       "VALUE LIES OUTSIDE OF THE RANGE OF THE " &
+                       "TARGET TYPE'S SUBTYPE BUT WITHIN THE " &
+                       "RANGE OF THE BASE TYPE" );
+
+     BEGIN
+          I1 := Integer'Base'Last + Ident_Int(1);
+          Failed ("NO EXCEPTION RAISED FOR INTEGER'BASE'LAST + 1");
+          IF EQUAL (I1, I1) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               Comment ("CONSTRAINT_ERROR RAISED FOR INTEGER'BASE'LAST + 1");
+          WHEN OTHERS =>
+               Failed ("WRONG EXCEPTION RAISED FOR INTEGER'BASE'LAST + 1");
+     END;
+
+     BEGIN
+          I1 := Integer'Base'First - Ident_Int(1);
+          Failed ("NO EXCEPTION RAISED FOR INTEGER'BASE'FIRST - 1");
+          IF EQUAL (I1, I1) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               Comment ("CONSTRAINT_ERROR RAISED FOR INTEGER'BASE'FIRST - 1");
+          WHEN OTHERS =>
+               Failed ("WRONG EXCEPTION RAISED FOR INTEGER'BASE'FIRST - 1");
+     END;
+
+     BEGIN
+          I1 := INTEGER (IDENT_INT (INTEGER'FIRST) - 1);
+          FAILED ( "NO EXCEPTION RAISED FOR " &
+                   "INTEGER (IDENT_INT (INTEGER'FIRST) - 1)" );
+          IF EQUAL (I1, I1) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
+                         "INTEGER (IDENT_INT (INTEGER'FIRST - 1)" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "INTEGER (IDENT_INT (INTEGER'FIRST - 1)" );
+     END;
+
+     BEGIN
+          N1 := NEWINTEGER (IDENT_INT (INTEGER'LAST) + 1);
+          FAILED ( "NO EXCEPTION RAISED FOR " &
+                   "NEWINTEGER (IDENT_INT (INTEGER'LAST) + 1)" );
+          IF EQUAL (INTEGER (N1), INTEGER (N1)) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
+                         "NEWINTEGER (IDENT_INT (INTEGER'LAST + 1)" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "NEWINTEGER (IDENT_INT (INTEGER'LAST + 1)" );
+     END;
+
+     BEGIN
+          T1 := INT (INT'BASE'FIRST - IDENT (1));
+          FAILED ( "NO EXCEPTION RAISED FOR " &
+                   "INT (INT'BASE'FIRST - IDENT (1))" );
+          IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ( "CONSTRAINT_ERROR RAISED FOR " &
+                         "INT (INT'BASE'FIRST - IDENT (1))" );
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "INT (INT'BASE'FIRST - IDENT (1))" );
+     END;
+
+     BEGIN
+          T1 := IDENT (-101);
+          FAILED ( "NO EXCEPTION RAISED FOR " &
+                   "T1 := -101" );
+          IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "T1 := -101" );
+     END;
+
+     BEGIN
+          T1 := INTEGER'POS (IDENT_INT (101));
+          FAILED ( "NO EXCEPTION RAISED FOR " &
+                   "T1 := INTEGER'POS (IDENT_INT (101))" );
+          IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "T1 := INTEGER'POS (IDENT_INT (101));" );
+     END;
+
+     BEGIN
+          T1 := INT (IDENT (INTEGER (INT'FIRST)) - 1);
+          FAILED ( "NO EXCEPTION RAISED FOR " &
+                   "INT (INT'FIRST - 1)" );
+          IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "INT (INT'FIRST - 1)" );
+     END;
+
+     BEGIN
+          T1 := INT (IDENT_INT (101));
+          FAILED ( "NO EXCEPTION RAISED FOR INT (101)" );
+          IF EQUAL (INTEGER (T1), INTEGER (T1)) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR INT (101)" );
+     END;
+
+     BEGIN
+          S1 := SMALL (IDENT_INT (101));
+          FAILED ( "NO EXCEPTION RAISED FOR SMALL (101)" );
+          IF EQUAL (S1, S1) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR SMALL (101)" );
+     END;
+
+     BEGIN
+          SN := SUBNEW (IDENT_INT (-101));
+          FAILED ( "NO EXCEPTION RAISED FOR SUBNEW (-101)" );
+          IF EQUAL (INTEGER (SN), INTEGER (SN)) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR SUBNEW (-101)" );
+     END;
+
+     BEGIN
+          P1 := IDENT_INT (101);
+          SN := SUBNEW (P1);
+          FAILED ( "NO EXCEPTION RAISED FOR SUBNEW (P1)" );
+          IF EQUAL (INTEGER (SN), INTEGER (SN)) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR SUBNEW (P1)" );
+     END;
+
+     BEGIN
+          SN := IDENT (0);
+          P1 := POSITIVE (SN);
+          FAILED ( "NO EXCEPTION RAISED FOR " &
+                   "POSITIVE (SN)" );
+          IF EQUAL (P1, P1) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "POSITIVE (SN)" );
+     END;
+
+     BEGIN
+          N1 := IDENT (-1);
+          L1 := NATURAL (N1);
+          FAILED ( "NO EXCEPTION RAISED FOR " &
+                   "NATURAL (N1)" );
+          IF EQUAL (L1, L1) THEN
+               COMMENT ("SHOULDN'T GET HERE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                        "NATURAL (N1)" );
+     END;
+
+     RESULT;
+END C46014A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46021a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46021a.ada
new file mode 100644
index 000000000..198fc7ca6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46021a.ada
@@ -0,0 +1,210 @@
+-- C46021A.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 FLOATING POINT CONVERSIONS ARE PERFORMED CORRECTLY
+--     WHEN THE OPERAND TYPE IS AN INTEGER TYPE, FOR 5-DIGIT PRECISION.
+
+-- HISTORY:
+--     JET 02/12/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C46021A IS
+
+     TYPE FLOAT5 IS DIGITS 5;
+     TYPE INT IS RANGE -32768..32767;
+
+     TYPE NFLOAT5 IS NEW FLOAT5;
+
+     FUNCTION IDENT (A : FLOAT5) RETURN FLOAT5 IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN A;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT;
+
+     FUNCTION IDENT (A : NFLOAT5) RETURN NFLOAT5 IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN A;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT;
+
+BEGIN
+     TEST ("C46021A", "CHECK THAT FLOATING POINT CONVERSIONS ARE " &
+                      "PERFORMED CORRECTLY WHEN THE OPERAND TYPE " &
+                      "IS AN INTEGER TYPE, FOR 5-DIGIT PRECISION");
+
+     IF FLOAT5(IDENT_INT(-7)) /= -7.0 THEN
+          FAILED ("INCORRECT VALUE (1)");
+     END IF;
+
+     IF FLOAT5(IDENT_INT(3)) /= 3.0 THEN
+          FAILED ("INCORRECT VALUE (2)");
+     END IF;
+
+     IF FLOAT5(IDENT_INT(-999)) /= -999.0 THEN
+          FAILED ("INCORRECT VALUE (3)");
+     END IF;
+
+     IF FLOAT5(IDENT_INT(101)) /= 101.0 THEN
+          FAILED ("INCORRECT VALUE (4)");
+     END IF;
+
+     IF FLOAT5(IDENT_INT(-32767)) /= -32767.0 THEN
+          FAILED ("INCORRECT VALUE (5)");
+     END IF;
+
+     IF FLOAT5(IDENT_INT(32767)) /= 32767.0 THEN
+          FAILED ("INCORRECT VALUE (6)");
+     END IF;
+
+     IF FLOAT5(-7) /= IDENT(-7.0) THEN
+          FAILED ("INCORRECT VALUE (7)");
+     END IF;
+
+     IF FLOAT5(3) /= IDENT(3.0) THEN
+          FAILED ("INCORRECT VALUE (8)");
+     END IF;
+
+     IF FLOAT5(-999) /= IDENT(-999.0) THEN
+          FAILED ("INCORRECT VALUE (9)");
+     END IF;
+
+     IF FLOAT5(101) /= IDENT(101.0) THEN
+          FAILED ("INCORRECT VALUE (10)");
+     END IF;
+
+     IF FLOAT5(-32767) /= IDENT(-32767.0) THEN
+          FAILED ("INCORRECT VALUE (11)");
+     END IF;
+
+     IF FLOAT5(32767) /= IDENT(32767.0) THEN
+          FAILED ("INCORRECT VALUE (12)");
+     END IF;
+
+     IF FLOAT5(INT'(-7)) /= IDENT(-7.0) THEN
+          FAILED ("INCORRECT VALUE (13)");
+     END IF;
+
+     IF FLOAT5(INT'(3)) /= IDENT(3.0) THEN
+          FAILED ("INCORRECT VALUE (14)");
+     END IF;
+
+     IF FLOAT5(INT'(-999)) /= IDENT(-999.0) THEN
+          FAILED ("INCORRECT VALUE (15)");
+     END IF;
+
+     IF FLOAT5(INT'(101)) /= IDENT(101.0) THEN
+          FAILED ("INCORRECT VALUE (16)");
+     END IF;
+
+     IF FLOAT5(INT'(-32767)) /= IDENT(-32767.0) THEN
+          FAILED ("INCORRECT VALUE (17)");
+     END IF;
+
+     IF FLOAT5(INT'(32767)) /= IDENT(32767.0) THEN
+          FAILED ("INCORRECT VALUE (18)");
+     END IF;
+
+     IF NFLOAT5(IDENT_INT(-7)) /= -7.0 THEN
+          FAILED ("INCORRECT VALUE (19)");
+     END IF;
+
+     IF NFLOAT5(IDENT_INT(3)) /= 3.0 THEN
+          FAILED ("INCORRECT VALUE (20)");
+     END IF;
+
+     IF NFLOAT5(IDENT_INT(-999)) /= -999.0 THEN
+          FAILED ("INCORRECT VALUE (21)");
+     END IF;
+
+     IF NFLOAT5(IDENT_INT(101)) /= 101.0 THEN
+          FAILED ("INCORRECT VALUE (22)");
+     END IF;
+
+     IF NFLOAT5(IDENT_INT(-32767)) /= -32767.0 THEN
+          FAILED ("INCORRECT VALUE (23)");
+     END IF;
+
+     IF NFLOAT5(IDENT_INT(32767)) /= 32767.0 THEN
+          FAILED ("INCORRECT VALUE (24)");
+     END IF;
+
+     IF NFLOAT5(-7) /= IDENT(-7.0) THEN
+          FAILED ("INCORRECT VALUE (25)");
+     END IF;
+
+     IF NFLOAT5(3) /= IDENT(3.0) THEN
+          FAILED ("INCORRECT VALUE (26)");
+     END IF;
+
+     IF NFLOAT5(-999) /= IDENT(-999.0) THEN
+          FAILED ("INCORRECT VALUE (27)");
+     END IF;
+
+     IF NFLOAT5(101) /= IDENT(101.0) THEN
+          FAILED ("INCORRECT VALUE (28)");
+     END IF;
+
+     IF NFLOAT5(-32767) /= IDENT(-32767.0) THEN
+          FAILED ("INCORRECT VALUE (29)");
+     END IF;
+
+     IF NFLOAT5(32767) /= IDENT(32767.0) THEN
+          FAILED ("INCORRECT VALUE (30)");
+     END IF;
+
+     IF NFLOAT5(INT'(-7)) /= IDENT(-7.0) THEN
+          FAILED ("INCORRECT VALUE (31)");
+     END IF;
+
+     IF NFLOAT5(INT'(3)) /= IDENT(3.0) THEN
+          FAILED ("INCORRECT VALUE (32)");
+     END IF;
+
+     IF NFLOAT5(INT'(-999)) /= IDENT(-999.0) THEN
+          FAILED ("INCORRECT VALUE (33)");
+     END IF;
+
+     IF NFLOAT5(INT'(101)) /= IDENT(101.0) THEN
+          FAILED ("INCORRECT VALUE (34)");
+     END IF;
+
+     IF NFLOAT5(INT'(-32767)) /= IDENT(-32767.0) THEN
+          FAILED ("INCORRECT VALUE (35)");
+     END IF;
+
+     IF NFLOAT5(INT'(32767)) /= IDENT(32767.0) THEN
+          FAILED ("INCORRECT VALUE (36)");
+     END IF;
+
+     RESULT;
+
+END C46021A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46024a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46024a.ada
new file mode 100644
index 000000000..6f0714f42
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46024a.ada
@@ -0,0 +1,136 @@
+-- C46024A.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 FLOATING POINT CONVERSIONS WHEN THE TARGET TYPE IS A
+--     FIXED POINT TYPE, FOR DIGITS 5.
+
+-- HISTORY:
+--     JET 02/19/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C46024A IS
+
+     TYPE FLOAT5 IS DIGITS 5;
+     TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
+     TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
+     TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
+
+     F5, F5A, F5B : FLOAT5;
+
+     GENERIC
+          TYPE F IS DELTA <>;
+     FUNCTION IDENTG (A : F) RETURN F;
+
+     FUNCTION IDENTG (A : F) RETURN F IS
+     BEGIN
+          RETURN A + F(IDENT_INT(0));
+     END IDENTG;
+
+     FUNCTION IDENT1 IS NEW IDENTG(FIX1);
+     FUNCTION IDENT2 IS NEW IDENTG(FIX2);
+     FUNCTION IDENT3 IS NEW IDENTG(FIX3);
+
+BEGIN
+     TEST ("C46024A", "CHECK FLOATING POINT CONVERSIONS WHEN THE " &
+                      "TARGET TYPE IS A FIXED POINT TYPE, FOR " &
+                      "5-DIGIT PRECISION");
+
+     IF FIX1(FLOAT5'(2#0.1000_0000_0000_0000_00#E-1)) /=
+        IDENT1(2#0.01#) THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
+     END IF;
+
+     IF FIX1(FLOAT5'(-2#0.1111_1110_0000_0000_00#E5)) /=
+        IDENT1(-2#1_1111.11#) THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
+     END IF;
+
+     IF FIX1(FLOAT5'(-2#0.1010_0111_1111_1111_11#E4)) <
+        IDENT1(-2#1010.10#) OR
+        FIX1(FLOAT5'(-2#0.1010_0111_1111_1111_11#E4)) >
+        IDENT1(-2#1010.01#) THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
+     END IF;
+
+     IF FIX2(FLOAT5'(-2#0.1000_0000_0000_0000_00#E-3)) /=
+        IDENT2(-2#0.0001#) THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
+     END IF;
+
+     IF FIX2(FLOAT5'(2#0.1111_1111_1110_0000_00#E7)) /=
+        IDENT2(2#111_1111.1111#) THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
+     END IF;
+
+     F5 := 2#0.1010_1010_1010_1010_10#E5;
+     IF FIX2(F5) < IDENT2(2#1_0101.0101#) OR
+        FIX2(F5) > IDENT2(2#1_0101.0110#) THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
+     END IF;
+
+     IF FIX3(FLOAT5'(2#0.1000_0000_0000_0000_00#E-5)) /=
+        IDENT3(2#0.000001#) THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (7)");
+     END IF;
+
+     IF FIX3(FLOAT5'(-2#0.1111_1111_1111_1110_00#E9)) /=
+        IDENT3(-2#1_1111_1111.1111_11#) THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (8)");
+     END IF;
+
+     F5 := -2#0.1010_1010_1010_1010_10#E8;
+     IF FIX3(F5) < IDENT3(-2#1010_1010.1010_11#) OR
+        FIX3(F5) > IDENT3(-2#1010_1010.1010_10#) THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (9)");
+     END IF;
+
+     F5A := 2#0.1010_1010_1010_1010_10#E4;
+     F5B := 2#0.1010_1010_1010_1010_10#E5;
+
+     IF FIX1(F5A) = IDENT1(2#1010.11#)   AND
+        FIX1(-F5A) = IDENT1(-2#1010.11#) AND
+        FIX1(F5B) = IDENT1(2#1_0101.01#) AND
+        FIX1(-F5B) = IDENT1(-2#1_0101.01#) THEN
+          COMMENT ("CONVERSION ROUNDS TO NEAREST");
+     ELSIF FIX1(F5A) = IDENT1(2#1010.10#) AND
+           FIX1(-F5B) = IDENT1(-2#1_0101.10#) THEN
+          COMMENT ("CONVERSION ROUNDS TO LEAST FIXED-POINT VALUE");
+     ELSIF FIX1(F5B) = IDENT1(2#1_0101.10#) AND
+           FIX1(-F5A) = IDENT1(-2#1010.10#) THEN
+          COMMENT ("CONVERSION ROUNDS TO GREATEST FIXED-POINT VALUE");
+     ELSIF FIX1(F5A) = IDENT1(2#1010.10#) AND
+           FIX1(-F5A) = IDENT1(-2#1010.10#) THEN
+          COMMENT ("CONVERSION ROUNDS TOWARD ZERO");
+     ELSIF FIX1(F5B) = IDENT1(2#1_0101.10#) AND
+           FIX1(-F5B) = IDENT1(-2#1_0101.10#) THEN
+          COMMENT ("CONVERSION ROUNDS AWAY FROM ZERO");
+     ELSE
+          COMMENT ("UNABLE TO DETERMINE CONVERSION PATTERN");
+     END IF;
+
+     RESULT;
+
+END C46024A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46031a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46031a.ada
new file mode 100644
index 000000000..589833c19
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46031a.ada
@@ -0,0 +1,85 @@
+-- C46031A.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 CONVERSIONS TO FIXED POINT TYPES WHEN THE OPERAND TYPE
+--     IS AN INTEGER TYPE.
+
+-- HISTORY:
+--     JET 07/11/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46031A IS
+
+     TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
+     TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
+     TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
+
+     TYPE NEW_INT IS NEW INTEGER RANGE -16#200# .. 16#200#;
+
+     I : INTEGER;
+     J : NEW_INT;
+
+     FUNCTION IDENT_NEW (X : NEW_INT) RETURN NEW_INT IS
+     BEGIN
+          RETURN X * NEW_INT(IDENT_INT(1));
+     END IDENT_NEW;
+
+BEGIN
+     TEST ("C46031A", "CHECK CONVERSIONS TO FIXED POINT TYPES WHEN " &
+                      "THE OPERAND TYPE IS AN INTEGER TYPE");
+
+     I := IDENT_INT(-16#1F#);
+     IF FIX1(I) /= -16#1F.0# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
+     END IF;
+
+     J := IDENT_NEW(0);
+     IF FIX1(J) /= 0.0 THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
+     END IF;
+
+     I := IDENT_INT(16#7F#);
+     IF FIX2(I) /= 16#7F.0# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
+     END IF;
+
+     J := IDENT_NEW(16#1#);
+     IF FIX2(J) /= 16#1.0# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
+     END IF;
+
+     I := IDENT_INT(-16#55#);
+     IF FIX3(I) /= -16#55.0# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
+     END IF;
+
+     J := IDENT_NEW(-16#1#);
+     IF FIX3(J) /= -16#1.0# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
+     END IF;
+
+     RESULT;
+
+END C46031A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46032a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46032a.ada
new file mode 100644
index 000000000..a89e11598
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46032a.ada
@@ -0,0 +1,103 @@
+-- C46032A.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 CONVERSIONS TO FIXED POINT TYPES WHEN THE OPERAND TYPE
+--     IS A FLOATING POINT TYPE OF 5 DIGITS PRECISION.
+
+-- HISTORY:
+--     JET 07/11/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46032A IS
+
+     TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
+     TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
+     TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
+
+     TYPE FLOAT5 IS DIGITS 5;
+
+     F5 : FLOAT5;
+
+     FUNCTION IDENT5 (X : FLOAT5) RETURN FLOAT5 IS
+     BEGIN
+          RETURN X * FLOAT5(IDENT_INT(1));
+     END IDENT5;
+
+BEGIN
+     TEST ("C46032A", "CHECK CONVERSIONS TO FIXED POINT TYPES WHEN " &
+                      "THE OPERAND TYPE IS A FLOATING POINT TYPE " &
+                      "OF 5 DIGITS PRECISION");
+
+     F5 := IDENT5(2#0.1100_0000_0000_0000_00#E0);
+     IF FIX1(F5) /= 16#0.C# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
+     END IF;
+
+     F5 := IDENT5(2#0.1111_1110_0000_0000_00#E5);
+     IF FIX1(F5) /= 16#1F.C# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
+     END IF;
+
+     F5 := IDENT5(-2#0.1010_1010_1010_1010_10#E2);
+     IF FIX1(F5) < -16#2.C# OR
+        FIX1(F5) > -16#2.8# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
+     END IF;
+
+     F5 := IDENT5(2#0.1111_0000_0000_0000_00#E0);
+     IF FIX2(F5) /= 16#0.F# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
+     END IF;
+
+     F5 := IDENT5(-2#0.1111_1110_0000_0000_00#E7);
+     IF FIX2(F5) /= -16#7F.0# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
+     END IF;
+
+     F5 := IDENT5(2#0.1111_1111_1101_0000_00#E7);
+     IF FIX2(F5) < 16#7F.E# OR
+        FIX2(F5) > 16#7F.F# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
+     END IF;
+
+     F5 := IDENT5(2#0.1000_0000_0000_0000_00#E-5);
+     IF FIX3(F5) /= 16#0.04# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (7)");
+     END IF;
+
+     F5 := -IDENT5(2#0.1010_1010_1010_1010_00#E9);
+     IF FIX3(F5) /= -16#155.54# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (8)");
+     END IF;
+
+     F5 := IDENT5(2#0.1000_0000_0000_0010_11#E9);
+     IF FIX3(F5) < 16#100.04# OR
+        FIX3(F5) > 16#100.08# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (9)");
+     END IF;
+
+     RESULT;
+
+END C46032A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46033a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46033a.ada
new file mode 100644
index 000000000..7657854e8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46033a.ada
@@ -0,0 +1,110 @@
+-- C46033A.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 CONVERSIONS TO FIXED POINT TYPES WHEN THE OPERAND TYPE
+--     IS ANOTHER FIXED POINT TYPE.
+
+-- HISTORY:
+--     JET 07/12/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46033A IS
+
+     TYPE FIX1 IS DELTA 2#0.01# RANGE -16#20.0# .. 16#20.0#;
+     TYPE FIX2 IS DELTA 2#0.0001# RANGE -16#80.0# .. 16#80.0#;
+     TYPE FIX3 IS DELTA 2#0.000001# RANGE -16#200.0# .. 16#200.0#;
+
+     F1 : FIX1;
+     F2 : FIX2;
+     F3 : FIX3;
+
+     GENERIC
+          TYPE F IS DELTA <>;
+     FUNCTION IDENT_G (X : F) RETURN F;
+
+     FUNCTION IDENT_G (X : F) RETURN F IS
+     BEGIN
+          RETURN X + F(IDENT_INT(0));
+     END IDENT_G;
+
+     FUNCTION IDENT IS NEW IDENT_G(FIX1);
+     FUNCTION IDENT IS NEW IDENT_G(FIX2);
+     FUNCTION IDENT IS NEW IDENT_G(FIX3);
+
+BEGIN
+     TEST ("C46033A", "CHECK CONVERSIONS TO FIXED POINT TYPES WHEN " &
+                      "THE OPERAND TYPE IS ANOTHER FIXED POINT TYPE");
+
+     F1 := IDENT(-16#1F.C#);
+     IF FIX1(F1) /= -16#1F.C# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (1)");
+     END IF;
+
+     F1 := IDENT(16#0.4#);
+     IF FIX2(F1) /= 16#0.4# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (2)");
+     END IF;
+
+     F1 := IDENT(-16#10.4#);
+     IF FIX3(F1) /= -16#10.4# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (3)");
+     END IF;
+
+     F2 := IDENT(16#3.3#);
+     IF FIX1(F2) < 16#3.0# OR
+        FIX1(F2) > 16#3.4# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (4)");
+     END IF;
+
+     F2 := IDENT(-16#40.1#);
+     IF FIX2(F2) /= -16#40.1# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (5)");
+     END IF;
+
+     F2 := IDENT(16#0.0#);
+     IF FIX3(F2) /= 16#0.0# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (6)");
+     END IF;
+
+     F3 := IDENT(-16#0.04#);
+     IF FIX1(F3) < -16#0.4# OR
+        FIX1(F3) > -16#0.0# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (7)");
+     END IF;
+
+     F3 := -IDENT(16#55.A8#);
+     IF FIX2(F3) < -16#55.B# OR
+        FIX2(F3) > -16#55.A# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (8)");
+     END IF;
+
+     F3 := IDENT(16#101.84#);
+     IF FIX3(F3) /= 16#101.84# THEN
+          FAILED ("INCORRECT RESULT FROM CONVERSION (9)");
+     END IF;
+
+     RESULT;
+
+END C46033A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46041a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46041a.ada
new file mode 100644
index 000000000..a9fd5d734
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46041a.ada
@@ -0,0 +1,141 @@
+-- C46041A.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 ARRAY CONVERSIONS WHEN THE TARGET TYPE IS AN UNCONSTRAINED 
+-- ARRAY TYPE AND THE OPERAND TYPE REQUIRES CONVERSION OF THE INDEX
+-- BOUNDS.
+
+-- R.WILLIAMS 9/8/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46041A IS
+     
+     TYPE INT IS RANGE -100 .. 100;
+     TYPE NEWINTEGER IS NEW INTEGER;
+
+     TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+
+     TYPE NDAY1 IS NEW DAY RANGE SUN .. FRI;
+     TYPE NDAY2 IS NEW DAY RANGE MON .. SAT;
+     
+     TYPE NNDAY1 IS NEW NDAY1;
+
+     FUNCTION IDENT (X : INT) RETURN INT IS
+     BEGIN
+          RETURN INT'VAL (IDENT_INT (INT'POS (X)));
+     END IDENT;
+
+     FUNCTION IDENT (X : NEWINTEGER) RETURN NEWINTEGER IS
+     BEGIN
+          RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (X)));
+     END IDENT;
+
+     FUNCTION IDENT (X : NDAY1) RETURN NDAY1 IS
+     BEGIN
+          RETURN NDAY1'VAL (IDENT_INT (NDAY1'POS (X)));
+     END IDENT;
+
+     FUNCTION IDENT (X : NDAY2) RETURN NDAY2 IS
+     BEGIN
+          RETURN NDAY2'VAL (IDENT_INT (NDAY2'POS (X)));
+     END IDENT;
+
+     FUNCTION IDENT (X : NNDAY1) RETURN NNDAY1 IS
+     BEGIN
+          RETURN NNDAY1'VAL (IDENT_INT (NNDAY1'POS (X)));
+     END IDENT;
+
+BEGIN
+     TEST ( "C46041A", "CHECK ARRAY CONVERSIONS WHEN THE TARGET " &
+                       "TYPE IS AN UNCONSTRAINED ARRAY TYPE AND " &
+                       "THE OPERAND TYPE REQUIRES CONVERSION OF " &
+                       "THE INDEX BOUNDS" );
+
+     DECLARE
+
+          TYPE UNARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+     
+          TYPE UNARR2 IS ARRAY (INTEGER RANGE <>, NDAY1 RANGE <>) 
+               OF INTEGER;
+     
+          TYPE ARR1 IS ARRAY (INT RANGE <>) OF INTEGER;
+          A1 : ARR1 (IDENT (11) .. IDENT (20)) := 
+                    (IDENT (11) .. IDENT (20) => 0);
+
+          TYPE ARR2 IS ARRAY (INT RANGE <>, NDAY2 RANGE <>) 
+               OF INTEGER;
+          A2 : ARR2 (IDENT (11) .. IDENT (20), 
+                     IDENT (TUE) .. IDENT (THU)) :=
+                    (IDENT (11) .. IDENT (20) => 
+                    (IDENT (TUE) .. IDENT (THU) => 0));
+     
+          TYPE ARR3 IS ARRAY (NEWINTEGER RANGE <>, NNDAY1 RANGE <>)
+               OF INTEGER;
+          A3 : ARR3 (IDENT (11) .. IDENT (20),
+                     IDENT (TUE) .. IDENT (THU)) :=
+                    (IDENT (11) .. IDENT (20) => 
+                    (IDENT (TUE) .. IDENT (THU) => 0));
+
+          PROCEDURE CHECK (A : UNARR1) IS
+          BEGIN
+               IF A'FIRST /= 11 OR A'LAST /= 20 THEN
+                    FAILED ( "INCORRECT CONVERSION OF UNARR1 (A1)" );
+               END IF;
+          END CHECK;
+
+          PROCEDURE CHECK (A : UNARR2; STR : STRING) IS
+          BEGIN
+               IF A'FIRST (1) /= 11 OR A'LAST /= 20 OR
+                  A'FIRST (2) /= TUE OR A'LAST (2) /= THU THEN
+                    FAILED ( "INCORRECT CONVERSION OF UNARR2 (A" & 
+                              STR & ")" );
+               END IF;
+          END CHECK;
+
+     BEGIN
+          BEGIN
+               CHECK (UNARR1 (A1));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED BY 'UNARR1 (A1)'" );
+          END;
+                             
+          BEGIN
+               CHECK (UNARR2 (A2), "2");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED BY 'UNARR2 (A2)'" );
+          END;
+                             
+          BEGIN
+               CHECK (UNARR2 (A3), "3");                             
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED BY 'UNARR2 (A3)'" );
+          END;
+                             
+     END;
+
+     RESULT;
+END C46041A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46042a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46042a.ada
new file mode 100644
index 000000000..2099ca6bb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46042a.ada
@@ -0,0 +1,146 @@
+-- C46042A.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 ARRAY CONVERSIONS WHEN THE TARGET TYPE IS A CONSTRAINED 
+-- ARRAY TYPE AND THE OPERAND TYPE HAS BOUNDS THAT DO NOT BELONG TO
+-- THE BASE TYPE OF THE TARGET TYPE'S INDEX SUBTYPE.
+
+-- R.WILLIAMS 9/8/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46042A IS
+     
+     TYPE INT IS RANGE -100 .. 100;
+
+     TYPE NEWINTEGER IS NEW INTEGER;
+
+     TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+
+     TYPE NDAY1 IS NEW DAY RANGE MON .. FRI;
+     TYPE NDAY2 IS NEW DAY RANGE MON .. FRI;
+     
+     TYPE NNDAY1 IS NEW NDAY1;
+
+     FUNCTION IDENT (X : INT) RETURN INT IS
+     BEGIN
+          RETURN INT'VAL (IDENT_INT (INT'POS (X)));
+     END IDENT;
+
+     FUNCTION IDENT (X : NEWINTEGER) RETURN NEWINTEGER IS
+     BEGIN
+          RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (X)));
+     END IDENT;
+
+     FUNCTION IDENT (X : NDAY1) RETURN NDAY1 IS
+     BEGIN
+          RETURN NDAY1'VAL (IDENT_INT (NDAY1'POS (X)));
+     END IDENT;
+
+     FUNCTION IDENT (X : NDAY2) RETURN NDAY2 IS
+     BEGIN
+          RETURN NDAY2'VAL (IDENT_INT (NDAY2'POS (X)));
+     END IDENT;
+
+     FUNCTION IDENT (X : NNDAY1) RETURN NNDAY1 IS
+     BEGIN
+          RETURN NNDAY1'VAL (IDENT_INT (NNDAY1'POS (X)));
+     END IDENT;
+
+BEGIN
+     TEST ( "C46042A", "CHECK ARRAY CONVERSIONS WHEN THE TARGET " &
+                       "TYPE IS A CONSTRAINED ARRAY TYPE AND THE " &
+                       "OPERAND TYPE HAS BOUNDS THAT DO NOT " &
+                       "BELONG TO THE BASE TYPE OF THE TARGET " &
+                       "TYPE'S INDEX SUBTYPE" );
+
+     DECLARE
+
+          TYPE UNARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          SUBTYPE CONARR1 IS UNARR1 (IDENT_INT (1) .. IDENT_INT (10));
+
+          TYPE UNARR2 IS ARRAY (INTEGER RANGE <>, NDAY1 RANGE <>) 
+               OF INTEGER;
+          SUBTYPE CONARR2 IS UNARR2 (IDENT_INT (1) .. IDENT_INT (10),
+                                     IDENT (MON) .. IDENT (TUE));
+          
+          TYPE ARR1 IS ARRAY (INT RANGE <>) OF INTEGER;
+          A1 : ARR1 (IDENT (11) .. IDENT (20)) := 
+                    (IDENT (11) .. IDENT (20) => 0);
+
+          TYPE ARR2 IS ARRAY (INT RANGE <>, NDAY2 RANGE <>) 
+               OF INTEGER;
+          A2 : ARR2 (IDENT (11) .. IDENT (20), 
+                     IDENT (WED) .. IDENT (THU)) :=
+                    (IDENT (11) .. IDENT (20) =>
+                    (IDENT (WED) .. IDENT (THU) => 0));
+     
+          TYPE ARR3 IS ARRAY (NEWINTEGER RANGE <>, NNDAY1 RANGE <>)
+               OF INTEGER;
+          A3 : ARR3 (IDENT (11) .. IDENT (20),
+                     IDENT (WED) .. IDENT (THU)) :=
+                    (IDENT (11) .. IDENT (20) =>
+                    (IDENT (WED) .. IDENT (THU) => 0));
+
+          PROCEDURE CHECK (A : UNARR1) IS
+          BEGIN
+               IF A'FIRST /= 1 OR A'LAST /= 10 THEN
+                    FAILED ( "INCORRECT CONVERSION OF UNARR1 (A1)" );
+               END IF;
+          END CHECK;
+
+          PROCEDURE CHECK (A : UNARR2; STR : STRING) IS
+          BEGIN
+               IF A'FIRST (1) /= 1 OR A'LAST /= 10 OR
+                  A'FIRST (2) /= MON OR A'LAST (2) /= TUE THEN
+                    FAILED ( "INCORRECT CONVERSION OF UNARR2 (A" & 
+                              STR & ")" );
+               END IF;
+          END CHECK;
+
+     BEGIN
+          BEGIN
+               CHECK (CONARR1 (A1));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED BY 'CONARR1 (A1)'" );
+          END;
+                             
+          BEGIN
+               CHECK (CONARR2 (A2), "2");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED BY 'CONARR2 (A2)'" );
+          END;
+                             
+          BEGIN
+               CHECK (CONARR2 (A3), "3");                             
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED BY 'CONARR2 (A3)'" );
+          END;
+                             
+     END;
+
+     RESULT;
+END C46042A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46043b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46043b.ada
new file mode 100644
index 000000000..ee973a605
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46043b.ada
@@ -0,0 +1,148 @@
+-- C46043B.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 CONVERSION TO AN 
+-- UNCONSTRAINED ARRAY TYPE IF, FOR A NON-NULL DIMENSION OF THE 
+-- OPERAND TYPE, ONE BOUND DOES NOT BELONG TO THE CORRESPONDING INDEX
+-- SUBTYPE OF THE TARGET TYPE.
+
+-- R.WILLIAMS 9/8/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46043B IS
+          
+     SUBTYPE SUBINT IS INTEGER RANGE IDENT_INT (0) .. IDENT_INT (9);
+
+BEGIN
+     TEST ( "C46043B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                       "CONVERSION TO AN UNCONSTRAINED ARRAY TYPE " &
+                       "IF, FOR A NON-NULL DIMENSION OF THE OPERAND " &
+                       "TYPE, ONE BOUND DOES NOT BELONG TO THE " &
+                       "CORRESPONDING INDEX SUBTYPE OF THE TARGET " &
+                       "TYPE" );
+
+     DECLARE
+          TYPE ARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10));
+
+          TYPE ARR2 IS ARRAY (SUBINT RANGE <>) OF INTEGER;
+          
+          PROCEDURE CHECK (A : ARR2) IS
+          BEGIN               
+               FAILED ( "NO EXCEPTION RAISED WITH ONE DIMENSIONAL " &
+                        "ARRAYS" );
+          END CHECK;
+               
+     BEGIN
+          A1 := (A1'RANGE => 0);
+          CHECK (ARR2 (A1));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED WITH ONE " &
+                        "DIMENSIONAL ARRAYS" );
+     END;
+
+     DECLARE
+          TYPE ARR1 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
+               INTEGER;
+          A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10), 
+                     IDENT_INT (1) .. IDENT_INT (1));
+
+          TYPE ARR2 IS ARRAY (SUBINT RANGE <>, INTEGER RANGE <>) OF 
+               INTEGER;
+          
+          PROCEDURE CHECK (A : ARR2) IS
+          BEGIN               
+               FAILED ( "NO EXCEPTION RAISED WITH TWO DIMENSIONAL " &
+                        "ARRAYS" );
+          END CHECK;
+               
+     BEGIN
+          A1 := (A1'RANGE (1) => (A1'RANGE (2) => 0));
+          CHECK (ARR2 (A1));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED WITH TWO " &
+                        "DIMENSIONAL ARRAYS" );
+     END;
+
+     DECLARE
+          TYPE ARR1 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
+               INTEGER;
+          A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10), 
+                     IDENT_INT (1) .. IDENT_INT (0));
+
+          TYPE ARR2 IS ARRAY (SUBINT RANGE <>, INTEGER RANGE <>) OF 
+               INTEGER;
+          
+          PROCEDURE CHECK (A : ARR2) IS
+          BEGIN               
+               FAILED ( "NO EXCEPTION RAISED WITH NULL ARRAYS - 1" );
+          END CHECK;
+               
+     BEGIN
+          A1 := (A1'RANGE (1) => (A1'RANGE (2) => 0));
+          CHECK (ARR2 (A1));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " & 
+                        "WITH NULL ARRAYS - 1" );
+     END;
+
+     DECLARE
+          TYPE ARR1 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
+               INTEGER;
+          A1 : ARR1 (IDENT_INT (1) .. IDENT_INT (10), 
+                     IDENT_INT (1) .. IDENT_INT (0));
+
+          SUBTYPE NOINT IS INTEGER 
+               RANGE IDENT_INT (1) .. IDENT_INT (0);
+
+          TYPE ARR2 IS ARRAY (SUBINT RANGE <>, NOINT RANGE <>) OF 
+               INTEGER;
+          
+          PROCEDURE CHECK (A : ARR2) IS
+          BEGIN               
+               FAILED ( "NO EXCEPTION RAISED WITH NULL ARRAYS - 2" );
+          END CHECK;
+               
+     BEGIN
+          A1 := (A1'RANGE (1) => (A1'RANGE (2) => 0));
+          CHECK (ARR2 (A1));
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED " & 
+                        "WITH NULL ARRAYS - 2" );
+     END;
+
+     RESULT;
+END C46043B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46044b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46044b.ada
new file mode 100644
index 000000000..90ea0e494
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46044b.ada
@@ -0,0 +1,235 @@
+-- C46044B.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 CONVERSION TO A  
+-- CONSTRAINED ARRAY TYPE IF THE TARGET TYPE IS NON-NULL AND
+-- CORRESPONDING DIMENSIONS OF THE TARGET AND OPERAND DO NOT HAVE
+-- THE SAME LENGTH. ALSO, CHECK THAT CONSTRAINT_ERROR IS RAISED IF
+-- THE TARGET TYPE IS NULL AND THE OPERAND TYPE IS NON-NULL.
+
+-- R.WILLIAMS 9/8/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46044B IS
+
+     TYPE ARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+
+     SUBTYPE CARR1A IS ARR1 (IDENT_INT (1) .. IDENT_INT (6));
+     C1A : CARR1A := (CARR1A'RANGE => 0);
+
+     SUBTYPE CARR1B IS ARR1 (IDENT_INT (2) .. IDENT_INT (5));
+     C1B : CARR1B := (CARR1B'RANGE => 0);
+
+     SUBTYPE CARR1N IS ARR1 (IDENT_INT (1) .. IDENT_INT (0));
+     C1N : CARR1N := (CARR1N'RANGE => 0);
+
+     TYPE ARR2 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
+          INTEGER;
+
+     SUBTYPE CARR2A IS ARR2 (IDENT_INT (1) .. IDENT_INT (2),
+                             IDENT_INT (1) .. IDENT_INT (2));
+     C2A : CARR2A := (CARR2A'RANGE (1) => (CARR2A'RANGE (2) => 0));
+
+     SUBTYPE CARR2B IS ARR2 (IDENT_INT (0) .. IDENT_INT (2),
+                             IDENT_INT (0) .. IDENT_INT (2));
+     C2B : CARR2B := (CARR2B'RANGE (1) => (CARR2B'RANGE (2) => 0));
+
+     SUBTYPE CARR2N IS ARR2 (IDENT_INT (2) .. IDENT_INT (1),
+                             IDENT_INT (1) .. IDENT_INT (2));
+     C2N : CARR2N := (CARR2N'RANGE (1) => (CARR2N'RANGE (2) => 0));
+     
+     PROCEDURE CHECK1 (A : ARR1; STR : STRING) IS
+     BEGIN
+          FAILED ( "NO EXCEPTION RAISED - " & STR );
+     END CHECK1;
+
+     PROCEDURE CHECK2 (A : ARR2; STR : STRING) IS
+     BEGIN
+          FAILED ( "NO EXCEPTION RAISED - " & STR );
+     END CHECK2;
+
+BEGIN
+     TEST ( "C46044B", "CHECK THAT CONSTRAINT ERROR IS RAISED FOR " &
+                       "CONVERSION TO A CONSTRAINED ARRAY TYPE " &
+                       "IF THE TARGET TYPE IS NON-NULL AND " &
+                       "CORRESPONDING DIMENSIONS OF THE TARGET AND " &
+                       "OPERAND DO NOT HAVE THE SAME LENGTH. " &
+                       "ALSO, CHECK THAT CONSTRAINT_ERROR IS " &
+                       "RAISED IF THE TARGET TYPE IS NULL AND " &
+                       "THE OPERAND TYPE IS NON-NULL" );
+
+     BEGIN -- (A).
+          C1A := C1B;
+          CHECK1 (C1A, "(A)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (A)" );
+     END;
+
+     BEGIN -- (B).
+          CHECK1 (CARR1A (C1B), "(B)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (B)" );
+     END; 
+
+     BEGIN -- (C).
+          C1B := C1A;
+          CHECK1 (C1B, "(C)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (C)" );
+     END;
+
+     BEGIN -- (D).
+          CHECK1 (CARR1B (C1A), "(D)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (D)" );
+     END;
+
+     BEGIN -- (E).
+          C1A := C1N;
+          CHECK1 (C1A, "(E)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (E)" );
+     END;
+
+     BEGIN -- (F).
+          CHECK1 (CARR1A (C1N), "(F)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (F)" );
+     END;
+
+     BEGIN -- (G).
+          C2A := C2B;
+          CHECK2 (C2A, "(G)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (G)" );
+     END;
+
+     BEGIN -- (H).
+          CHECK2 (CARR2A (C2B), "(H)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (H)" );
+     END;
+
+     BEGIN -- (I).
+          C2B := C2A;
+          CHECK2 (C2B, "(I)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (I)" );
+     END;
+
+     BEGIN -- (J).
+          CHECK2 (CARR2A (C2B), "(J)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (J)" );
+     END;
+
+     BEGIN -- (K).
+          C2A := C2N;
+          CHECK2 (C2A, "(K)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (K)" );
+     END;
+
+     BEGIN -- (L).
+          CHECK2 (CARR2A (C2N), "(L)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (L)" );
+     END;
+
+     BEGIN -- (M).
+          C1N := C1A;
+          CHECK1 (C1N, "(M)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (M)" );
+     END;
+
+     BEGIN -- (N).
+          CHECK1 (CARR1N (C1A), "(N)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (N)" );
+     END;
+
+     BEGIN -- (O).
+          C2N := C2A;
+          CHECK2 (C2N, "(O)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (O)" );
+     END;
+
+     BEGIN -- (P).
+          CHECK2 (CARR2N (C2A), "(P)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED - (P)" );
+     END;
+
+     RESULT;
+END C46044B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46051a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46051a.ada
new file mode 100644
index 000000000..9468e8f76
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46051a.ada
@@ -0,0 +1,414 @@
+-- C46051A.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 ENUMERATION, RECORD, ACCESS, PRIVATE, AND TASK VALUES CAN
+-- BE CONVERTED IF THE OPERAND AND TARGET TYPES ARE RELATED BY 
+-- DERIVATION.
+
+-- R.WILLIAMS 9/8/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46051A IS
+     
+BEGIN
+     TEST ( "C46051A", "CHECK THAT ENUMERATION, RECORD, ACCESS, " &
+                       "PRIVATE, AND TASK VALUES CAN BE CONVERTED " &
+                       "IF THE OPERAND AND TARGET TYPES ARE " &
+                       "RELATED BY DERIVATION" );
+
+     DECLARE
+          TYPE ENUM IS (A, AB, ABC, ABCD);
+          E : ENUM := ABC;
+
+          TYPE ENUM1 IS NEW ENUM;
+          E1 : ENUM1 := ENUM1'VAL (IDENT_INT (2));
+
+          TYPE ENUM2 IS NEW ENUM;
+          E2 : ENUM2 := ABC;
+
+          TYPE NENUM1 IS NEW ENUM1;
+          NE : NENUM1 := NENUM1'VAL (IDENT_INT (2));
+     BEGIN
+          IF ENUM (E) /= E THEN
+               FAILED ( "INCORRECT CONVERSION OF 'ENUM (E)'" );
+          END IF;
+
+          IF ENUM (E1) /= E THEN
+               FAILED ( "INCORRECT CONVERSION OF 'ENUM (E1)'" );
+          END IF;
+
+          IF ENUM1 (E2) /= E1 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E2)'" );
+          END IF;
+                              
+          IF ENUM2 (NE) /= E2 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (NE)'" );
+          END IF;
+
+          IF NENUM1 (E) /= NE THEN
+               FAILED ( "INCORRECT CONVERSION OF 'NENUM (E)'" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                        "ENUMERATION TYPES" );
+     END;
+
+     DECLARE
+          TYPE REC IS 
+               RECORD
+                    NULL;
+               END RECORD;
+
+          R : REC;
+
+          TYPE REC1 IS NEW REC;
+          R1 : REC1;
+
+          TYPE REC2 IS NEW REC;
+          R2 : REC2;
+
+          TYPE NREC1 IS NEW REC1;
+          NR : NREC1;
+     BEGIN
+          IF REC (R) /= R THEN
+               FAILED ( "INCORRECT CONVERSION OF 'REC (R)'" );
+          END IF;
+
+          IF REC (R1) /= R THEN
+               FAILED ( "INCORRECT CONVERSION OF 'REC (R1)'" );
+          END IF;
+
+          IF REC1 (R2) /= R1 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'REC1 (R2)'" );
+          END IF;
+                              
+          IF REC2 (NR) /= R2 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'REC2 (NR)'" );
+          END IF;
+
+          IF NREC1 (R) /= NR THEN
+               FAILED ( "INCORRECT CONVERSION OF 'NREC (R)'" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                        "RECORD TYPES" );
+     END;
+
+     DECLARE
+          TYPE REC (D : INTEGER) IS 
+               RECORD
+                    NULL;
+               END RECORD;
+
+          SUBTYPE CREC IS REC (3);
+          R : CREC;
+
+          TYPE CREC1 IS NEW REC (3);
+          R1 : CREC1;
+
+          TYPE CREC2 IS NEW REC (3);
+          R2 : CREC2;
+
+          TYPE NCREC1 IS NEW CREC1;
+          NR : NCREC1;
+     BEGIN
+          IF CREC (R) /= R THEN
+               FAILED ( "INCORRECT CONVERSION OF 'CREC (R)'" );
+          END IF;
+
+          IF CREC (R1) /= R THEN
+               FAILED ( "INCORRECT CONVERSION OF 'CREC (R1)'" );
+          END IF;
+
+          IF CREC1 (R2) /= R1 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'CREC1 (R2)'" );
+          END IF;
+                              
+          IF CREC2 (NR) /= R2 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'CREC2 (NR)'" );
+          END IF;
+
+          IF NCREC1 (R) /= NR THEN
+               FAILED ( "INCORRECT CONVERSION OF 'NCREC (R)'" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                        "RECORD TYPES WITH DISCRIMINANTS" );
+     END;
+
+     DECLARE
+          TYPE REC IS 
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE ACCREC IS ACCESS REC;
+          AR : ACCREC;
+
+          TYPE ACCREC1 IS NEW ACCREC;
+          AR1 : ACCREC1;
+
+          TYPE ACCREC2 IS NEW ACCREC;
+          AR2 : ACCREC2;
+
+          TYPE NACCREC1 IS NEW ACCREC1;
+          NAR : NACCREC1;
+
+          FUNCTION F (A : ACCREC) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (0);
+          END F;
+
+          FUNCTION F (A : ACCREC1) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (1);
+          END F;
+
+          FUNCTION F (A : ACCREC2) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (2);
+          END F;
+
+          FUNCTION F (A : NACCREC1) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (3);
+          END F;
+
+     BEGIN
+          IF F (ACCREC (AR)) /= 0 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR)'" );
+          END IF;
+
+          IF F (ACCREC (AR1)) /= 0 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR1)'" );
+          END IF;
+
+          IF F (ACCREC1 (AR2)) /= 1 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'ACCREC1 (AR2)'" );
+          END IF;
+                              
+          IF F (ACCREC2 (NAR)) /= 2 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'ACCREC2 (NAR)'" );
+          END IF;
+
+          IF F (NACCREC1 (AR)) /= 3 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'NACCREC (AR)'" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                        "ACCESS TYPES" );
+     END;
+
+     DECLARE
+          TYPE REC (D : INTEGER) IS 
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE ACCR IS ACCESS REC;
+
+          SUBTYPE CACCR IS ACCR (3);
+          AR : CACCR;
+
+          TYPE CACCR1 IS NEW ACCR (3);
+          AR1 : CACCR1;
+
+          TYPE CACCR2 IS NEW ACCR (3);
+          AR2 : CACCR2;
+
+          TYPE NCACCR1 IS NEW CACCR1;
+          NAR : NCACCR1;
+
+          FUNCTION F (A : CACCR) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (0);
+          END F;
+
+          FUNCTION F (A : CACCR1) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (1);
+          END F;
+
+          FUNCTION F (A : CACCR2) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (2);
+          END F;
+
+          FUNCTION F (A : NCACCR1) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (3);
+          END F;
+
+     BEGIN
+          IF F (CACCR (AR)) /= 0 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR)'" );
+          END IF;
+
+          IF F (CACCR (AR1)) /= 0 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR1)'" );
+          END IF;
+
+          IF F (CACCR1 (AR2)) /= 1 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'CACCR1 (AR2)'" );
+          END IF;
+                              
+          IF F (CACCR2 (NAR)) /= 2 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'CACCR2 (NAR)'" );
+          END IF;
+
+          IF F (NCACCR1 (AR)) /= 3 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'NCACCR (AR)'" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                        "CONSTRAINED ACCESS TYPES" );
+     END;
+
+     DECLARE
+          PACKAGE PKG1 IS
+               TYPE PRIV IS PRIVATE;
+          PRIVATE
+               TYPE PRIV IS 
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END PKG1;
+
+          USE PKG1;
+
+          PACKAGE PKG2 IS
+               R : PRIV;
+
+               TYPE PRIV1 IS NEW PRIV;
+               R1 : PRIV1;
+
+               TYPE PRIV2 IS NEW PRIV;
+               R2 : PRIV2;
+          END PKG2;
+     
+          USE PKG2;
+
+          PACKAGE PKG3 IS
+               TYPE NPRIV1 IS NEW PRIV1;
+               NR : NPRIV1;
+          END PKG3;
+
+          USE PKG3;
+     BEGIN
+          IF PRIV (R) /= R THEN
+               FAILED ( "INCORRECT CONVERSION OF 'PRIV (R)'" );
+          END IF;
+
+          IF PRIV (R1) /= R THEN
+               FAILED ( "INCORRECT CONVERSION OF 'PRIV (R1)'" );
+          END IF;
+
+          IF PRIV1 (R2) /= R1 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'PRIV1 (R2)'" );
+          END IF;
+                              
+          IF PRIV2 (NR) /= R2 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'PRIV2 (NR)'" );
+          END IF;
+
+          IF NPRIV1 (R) /= NR THEN
+               FAILED ( "INCORRECT CONVERSION OF 'NPRIV (R)'" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                        "PRIVATE TYPES" );
+     END;
+
+     DECLARE
+          TASK TYPE TK;
+          T : TK;
+
+          TYPE TK1 IS NEW TK;
+          T1 : TK1; 
+
+          TYPE TK2 IS NEW TK;
+          T2 : TK2;
+
+          TYPE NTK1 IS NEW TK1;
+          NT : NTK1;
+          
+          TASK BODY TK IS
+          BEGIN
+               NULL;
+          END;
+
+          FUNCTION F (T : TK) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (0);
+          END F;
+
+          FUNCTION F (T : TK1) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (1);
+          END F;
+
+          FUNCTION F (T : TK2) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (2);
+          END F;
+
+          FUNCTION F (T : NTK1) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT (3);
+          END F;
+
+     BEGIN
+          IF F (TK (T)) /= 0 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'TK (T))'" );
+          END IF;
+
+          IF F (TK (T1)) /= 0 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'TK (T1))'" );
+          END IF;
+
+          IF F (TK1 (T2)) /= 1 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'TK1 (T2))'" );
+          END IF;
+                              
+          IF F (TK2 (NT)) /= 2 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'TK2 (NT))'" );
+          END IF;
+
+          IF F (NTK1 (T)) /= 3 THEN
+               FAILED ( "INCORRECT CONVERSION OF 'NTK (T))'" );
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                        "TASK TYPES" );
+     END;
+
+     RESULT;
+END C46051A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46051b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46051b.ada
new file mode 100644
index 000000000..402992da4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46051b.ada
@@ -0,0 +1,102 @@
+-- C46051B.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 ENUMERATION VALUES CAN BE CONVERTED IF THE OPERAND
+--     AND TARGET TYPES ARE RELATED BY DERIVATION, EVEN IF THE OPERAND
+--     AND TARGET TYPES HAVE DIFFERENT REPRESENTATIONS.
+
+-- HISTORY:
+--     JET 07/13/88  CREATED ORIGINAL TEST.
+--     RJW 08/28/89  REMOVED APPLICABILITY CRITERIA AND CHANGED
+--                   EXTENSION TO 'ADA'.  CHANGED THE CODES IN SECOND
+--                   ENUMERATION REPRESENTATION CLAUSE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46051B IS
+
+     TYPE ENUM IS (WE, LOVE, WRITING, TESTS);
+
+     TYPE ENUM1 IS NEW ENUM;
+     FOR ENUM1 USE
+          (WE => -1, LOVE => 0, WRITING => 3, TESTS => 9);
+
+     TYPE ENUM2 IS NEW ENUM;
+     FOR ENUM2 USE
+          (WE => 10, LOVE => 15, WRITING => 16, TESTS => 19);
+
+     TYPE ENUM3 IS NEW ENUM1;
+
+     E : ENUM := ENUM'VAL (IDENT_INT (0));
+     E1 : ENUM1 := ENUM1'VAL (IDENT_INT (1));
+     E2 : ENUM2 := ENUM2'VAL (IDENT_INT (2));
+     E3 : ENUM3 := ENUM3'VAL (IDENT_INT (3));
+
+BEGIN
+     TEST ( "C46051B", "CHECK THAT ENUMERATION VALUES CAN BE " &
+                       "CONVERTED IF THE OPERAND AND TARGET TYPES " &
+                       "ARE RELATED BY DERIVATION, EVEN IF THE " &
+                       "OPERAND AND TARGET TYPES HAVE DIFFERENT " &
+                       "REPRESENTATIONS");
+
+     IF ENUM1 (E) /= WE THEN
+          FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E)'" );
+     END IF;
+
+     IF ENUM (E1) /= LOVE THEN
+          FAILED ( "INCORRECT CONVERSION OF 'ENUM (E1)'" );
+     END IF;
+
+     IF ENUM1 (E2) /= WRITING THEN
+          FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E2)'" );
+     END IF;
+
+     IF ENUM2 (E3) /= TESTS THEN
+          FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (E3)'" );
+     END IF;
+
+     IF ENUM (E) /= WE THEN
+          FAILED ( "INCORRECT CONVERSION OF 'ENUM (E)'" );
+     END IF;
+
+     IF ENUM2 (E1) /= LOVE THEN
+          FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (E1)'" );
+     END IF;
+
+     IF ENUM3 (E2) /= WRITING THEN
+          FAILED ( "INCORRECT CONVERSION OF 'ENUM3 (E2)'" );
+     END IF;
+
+     IF ENUM (E3) /= TESTS THEN
+          FAILED ( "INCORRECT CONVERSION OF 'ENUM (E3)'" );
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                   "ENUMERATION TYPES" );
+          RESULT;
+END C46051B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46051c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46051c.ada
new file mode 100644
index 000000000..c5cfd8fa7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46051c.ada
@@ -0,0 +1,120 @@
+-- C46051C.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 RECORD VALUES CAN BE CONVERTED IF THE OPERAND
+--     AND TARGET TYPES ARE RELATED BY DERIVATION, EVEN IF THE OPERAND
+--     AND TARGET TYPES HAVE DIFFERENT REPRESENTATIONS.
+
+-- HISTORY:
+--     JET 07/13/88  CREATED ORIGINAL TEST.
+--     RJW 08/28/89  REMOVED APPLICABILITY CRITERIA AND CHANGED
+--                   EXTENSION TO 'ADA'.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM;
+
+PROCEDURE C46051C IS
+
+     UNITS_PER_INTEGER : CONSTANT :=
+          (INTEGER'SIZE+SYSTEM.STORAGE_UNIT-1) / SYSTEM.STORAGE_UNIT;
+
+     TYPE ARR IS ARRAY (1..2) OF INTEGER;
+
+     TYPE REC IS RECORD
+          F1 : INTEGER;
+          F2 : INTEGER;
+          F3 : INTEGER;
+     END RECORD;
+
+     TYPE REC1 IS NEW REC;
+     FOR REC1 USE
+          RECORD
+               F1 AT 0 RANGE 0 .. INTEGER'SIZE - 1;
+               F2 AT 1*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
+               F3 AT 3*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
+          END RECORD;
+
+     TYPE REC2 IS NEW REC;
+     FOR REC2 USE
+          RECORD
+               F1 AT 0 RANGE 0 .. INTEGER'SIZE - 1;
+               F2 AT 2*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
+               F3 AT 3*UNITS_PER_INTEGER RANGE 0..INTEGER'SIZE - 1;
+          END RECORD;
+
+     TYPE REC3 IS NEW REC1;
+
+     R  : REC  := (IDENT_INT (0), 1, 2);
+     R1 : REC1 := (IDENT_INT (1), 2, 3);
+     R2 : REC2 := (IDENT_INT (2), 3, 4);
+     R3 : REC3 := (IDENT_INT (3), 4, 5);
+
+BEGIN
+     TEST ( "C46051C", "CHECK THAT RECORD VALUES CAN BE " &
+                       "CONVERTED IF THE OPERAND AND TARGET TYPES " &
+                       "ARE RELATED BY DERIVATION, EVEN IF THE " &
+                       "OPERAND AND TARGET TYPES HAVE DIFFERENT " &
+                       "REPRESENTATIONS");
+
+     IF REC1(R) /= (0,1,2) THEN
+          FAILED ( "INCORRECT CONVERSION OF 'REC1 (R)'" );
+     END IF;
+
+     IF REC (R1) /= (1,2,3) THEN
+          FAILED ( "INCORRECT CONVERSION OF 'REC (R1)'" );
+     END IF;
+
+     IF REC1 (R2) /= (2,3,4) THEN
+          FAILED ( "INCORRECT CONVERSION OF 'REC1 (R2)'" );
+     END IF;
+
+     IF REC2 (R3) /= (3,4,5) THEN
+          FAILED ( "INCORRECT CONVERSION OF 'REC2 (R3)'" );
+     END IF;
+
+     IF REC (R) /= (0,1,2) THEN
+          FAILED ( "INCORRECT CONVERSION OF 'REC (R)'" );
+     END IF;
+
+     IF REC2 (R1) /= (1,2,3) THEN
+          FAILED ( "INCORRECT CONVERSION OF 'REC2 (R1)'" );
+     END IF;
+
+     IF REC3 (R2) /= (2,3,4) THEN
+          FAILED ( "INCORRECT CONVERSION OF 'REC3 (R2)'" );
+     END IF;
+
+     IF REC (R3) /= (3,4,5) THEN
+          FAILED ( "INCORRECT CONVERSION OF 'REC (R3)'" );
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
+                   "RECORD TYPES" );
+          RESULT;
+END C46051C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46052a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46052a.ada
new file mode 100644
index 000000000..7e69844ad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46052a.ada
@@ -0,0 +1,100 @@
+-- C46052A.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 CONVERSION TO AN 
+-- ENUMERATION TYPE IF THE VALUE OF THE OPERAND DOES NOT BELONG TO THE
+-- RANGE OF ENUMERATION VALUES FOR THE TARGET SUBTYPE.
+
+-- R.WILLIAMS 9/9/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46052A IS
+     
+     TYPE ENUM IS (A, AB, ABC, ABCD);
+     E : ENUM := ENUM'VAL (IDENT_INT (0));
+     
+     FUNCTION IDENT (E : ENUM) RETURN ENUM IS
+     BEGIN
+          RETURN ENUM'VAL (IDENT_INT (ENUM'POS (E)));
+     END IDENT;
+
+BEGIN
+     TEST ( "C46052A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                       "CONVERSION TO AN ENUMERATION TYPE IF THE " &
+                       "VALUE OF THE OPERAND DOES NOT BELONG TO " &
+                       "THE RANGE OF ENUMERATION VALUES FOR THE " &
+                       "TARGET SUBTYPE" );
+
+     DECLARE
+          SUBTYPE SENUM IS ENUM RANGE AB .. ABCD;
+     BEGIN
+          E := IDENT (SENUM (E));
+          FAILED ( "NO EXCEPTION RAISED FOR 'SENUM (E)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'SENUM (E)'" );
+     END;
+
+     DECLARE
+          SUBTYPE NOENUM IS ENUM RANGE ABCD .. AB;
+     BEGIN
+          E := IDENT (NOENUM (E));
+          FAILED ( "NO EXCEPTION RAISED FOR 'NOENUM (E)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'NOENUM (E)'" );
+     END;
+
+     DECLARE
+          SUBTYPE SCHAR IS CHARACTER RANGE 'C' .. 'R';
+          A : CHARACTER := IDENT_CHAR ('A');
+     BEGIN
+          A := IDENT_CHAR (SCHAR (A));
+          FAILED ( "NO EXCEPTION RAISED FOR 'SCHAR (A)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'SCHAR (A)'" );
+     END;
+
+     DECLARE
+          SUBTYPE FRANGE IS BOOLEAN RANGE FALSE .. FALSE;
+          T : BOOLEAN := IDENT_BOOL (TRUE);
+     BEGIN
+          T := IDENT_BOOL (FRANGE (T));
+          FAILED ( "NO EXCEPTION RAISED FOR 'FRANGE (T)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'FRANGE (T)'" );
+     END;
+
+     RESULT;
+END C46052A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46053a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46053a.ada
new file mode 100644
index 000000000..53c17c4b9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46053a.ada
@@ -0,0 +1,139 @@
+-- C46053A.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 CONVERSION TO A 
+-- CONSTRAINED RECORD, PRIVATE, OR LIMITED PRIVATE SUBTYPE IF THE 
+-- DISCRIMINANTS OF THE TARGET SUBTYPE DO NOT EQUAL THOSE OF THE 
+-- OPERAND.
+
+-- R.WILLIAMS 9/9/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46053A IS
+     
+BEGIN
+     TEST ( "C46053A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                       "CONVERSION TO A CONSTRAINED RECORD, " &
+                       "PRIVATE, OR LIMITED PRIVATE SUBTYPE IF " &
+                       "THE DISCRIMINANTS OF THE TARGET SUBTYPE DO " &
+                       "NOT EQUAL THOSE OF THE OPERAND" );
+
+     DECLARE
+          TYPE REC (D : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+          
+          SUBTYPE REC3 IS REC (IDENT_INT (3));
+          R : REC (IDENT_INT (1));
+
+          PROCEDURE PROC (R : REC) IS
+               I : INTEGER;
+          BEGIN
+               I := IDENT_INT (R.D);
+          END PROC;
+               
+     BEGIN
+          PROC (REC3 (R));
+          FAILED ( "NO EXCEPTION RAISED FOR 'REC3 (R)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'REC3 (R)'" );
+     END;
+
+     DECLARE
+          PACKAGE PKG1 IS
+               TYPE PRIV (D : INTEGER) IS PRIVATE;
+               SUBTYPE PRIV3 IS PRIV (IDENT_INT (3));
+          PRIVATE
+               TYPE PRIV  (D : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END PKG1;
+          
+          USE PKG1;
+
+          PACKAGE PKG2 IS
+               P : PRIV (IDENT_INT (0));
+          END PKG2;
+
+          USE PKG2;
+
+          PROCEDURE PROC (P : PRIV) IS
+               I : INTEGER;
+          BEGIN
+               I := IDENT_INT (P.D);
+          END PROC;
+               
+     BEGIN
+          PROC (PRIV3 (P));
+          FAILED ( "NO EXCEPTION RAISED FOR 'PRIV3 (P)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'PRIV3 (P)'" );
+     END;
+
+     DECLARE
+          PACKAGE PKG1 IS
+               TYPE LIM (D : INTEGER) IS LIMITED PRIVATE;
+               SUBTYPE LIM3 IS LIM (IDENT_INT (3));
+          PRIVATE
+               TYPE LIM  (D : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END PKG1;
+          
+          USE PKG1;
+
+          PACKAGE PKG2 IS
+               L : LIM (IDENT_INT (0));
+               I : INTEGER;
+          END PKG2;
+
+          USE PKG2;
+
+          PROCEDURE PROC (L : LIM) IS
+               I : INTEGER;
+          BEGIN
+               I := IDENT_INT (L.D);
+          END PROC;
+               
+     BEGIN
+          PROC (LIM3 (L));
+          FAILED ( "NO EXCEPTION RAISED FOR 'LIM3 (L)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'LIM3 (L)'" );
+     END;
+
+     RESULT;
+END C46053A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46054a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46054a.ada
new file mode 100644
index 000000000..f87cfa4f7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c46054a.ada
@@ -0,0 +1,191 @@
+-- C46054A.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 CONVERSION TO AN 
+-- ACCESS SUBTYPE IF THE OPERAND VALUE IS NOT NULL AND THE 
+-- DISCRIMINANTS OR INDEX BOUNDS OF THE DESIGNATED OBJECT DO NOT
+-- MATCH THOSE OF THE TARGET TYPE.
+
+-- R.WILLIAMS 9/9/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C46054A IS
+     
+BEGIN
+     TEST ( "C46054A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " &
+                       "CONVERSION TO AN ACCESS SUBTYPE IF THE " &
+                       "OPERAND VALUE IS NOT NULL AND THE " &
+                       "DISCRIMINANTS OR INDEX BOUNDS OF THE " &
+                       "DESIGNATED OBJECT DO NOT MATCH THOSE OF " &
+                       "THE TARGET TYPE" );
+
+     DECLARE
+          TYPE REC (D : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+          
+          TYPE ACREC IS ACCESS REC;
+          A : ACREC (IDENT_INT (0)) := NEW REC (IDENT_INT (0));
+
+          SUBTYPE ACREC3 IS ACREC (IDENT_INT (3));
+
+          PROCEDURE PROC (A : ACREC) IS
+               I : INTEGER;
+          BEGIN
+               I := IDENT_INT (A.D);
+          END PROC;
+
+     BEGIN
+          PROC (ACREC3 (A));
+          FAILED ( "NO EXCEPTION RAISED FOR 'ACREC3 (A)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'ACREC3 (A)'" );
+     END;
+
+     DECLARE
+          TYPE REC (D1, D2 : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+          
+          TYPE ACREC IS ACCESS REC;
+
+          A : ACREC (IDENT_INT (3), IDENT_INT (1)) := 
+              NEW REC (IDENT_INT (3), IDENT_INT (1));
+
+          SUBTYPE ACREC13 IS ACREC (IDENT_INT (1), IDENT_INT (3));
+
+          PROCEDURE PROC (A : ACREC) IS
+               I : INTEGER;
+          BEGIN
+               I := IDENT_INT (A.D1);
+          END PROC;
+
+     BEGIN
+          PROC (ACREC13 (A));
+          FAILED ( "NO EXCEPTION RAISED FOR 'ACREC13 (A)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'ACREC13 (A)'" );
+     END;
+
+     DECLARE
+          TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          
+          TYPE ACARR IS ACCESS ARR;
+          A : ACARR (IDENT_INT (0) .. IDENT_INT (1)) := 
+              NEW ARR'(IDENT_INT (0) .. IDENT_INT (1) => 0);
+
+          SUBTYPE ACARR02 IS ACARR (IDENT_INT (0) .. IDENT_INT (2));
+
+          PROCEDURE PROC (A : ACARR) IS
+               I : INTEGER;
+          BEGIN
+               I := IDENT_INT (A'LAST);
+          END PROC;
+
+     BEGIN
+          PROC (ACARR02 (A));
+          FAILED ( "NO EXCEPTION RAISED FOR 'ACARR02 (A)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'ACARR02 (A)'" );
+     END;
+
+     DECLARE
+          TYPE ARR IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF 
+               INTEGER;
+          
+          TYPE ACARR IS ACCESS ARR;
+          A : ACARR (IDENT_INT (1) .. IDENT_INT (0),
+                     IDENT_INT (4) .. IDENT_INT (5)) := 
+              NEW ARR'(IDENT_INT (1) .. IDENT_INT (0) =>
+                      (IDENT_INT (4) .. IDENT_INT (5) => 0));
+
+          SUBTYPE NACARR IS ACARR (IDENT_INT (0) .. IDENT_INT (1),
+                                   IDENT_INT (5) .. IDENT_INT (4));
+
+          PROCEDURE PROC (A : NACARR) IS
+               I : INTEGER;
+          BEGIN
+               I := IDENT_INT (A'LAST (1));
+          END PROC;
+
+     BEGIN
+          PROC (NACARR (A));
+          FAILED ( "NO EXCEPTION RAISED FOR 'NACARR (A)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'NACARR (A)'" );
+     END;
+
+     DECLARE
+          PACKAGE PKG1 IS
+               TYPE PRIV (D : INTEGER) IS PRIVATE;
+               TYPE ACPRV IS ACCESS PRIV;
+               SUBTYPE ACPRV3 IS ACPRV (IDENT_INT (3));
+
+          PRIVATE
+               TYPE PRIV (D : INTEGER) IS
+                    RECORD
+                         NULL;
+               END RECORD;
+          END PKG1;
+          
+          USE PKG1;
+          
+          PACKAGE PKG2 IS
+               A : ACPRV (IDENT_INT (0)) := NEW PRIV (IDENT_INT (0));
+          END PKG2;
+
+          USE PKG2;
+
+          PROCEDURE PROC (A : ACPRV) IS
+               I : INTEGER;
+          BEGIN
+               I := IDENT_INT (A.D);
+          END PROC;
+
+     BEGIN
+          PROC (ACPRV3 (A));
+          FAILED ( "NO EXCEPTION RAISED FOR 'ACPRV3 (A)'" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR 'ACPRV3 (A)'" );
+     END;
+
+     RESULT;
+END C46054A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460a01.a
new file mode 100644
index 000000000..2d583706e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460a01.a
@@ -0,0 +1,408 @@
+-- C460A01.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 the target type of a type conversion is a general
+--      access type, Program_Error is raised if the accessibility level of
+--      the operand type is deeper than that of the target type. Check for
+--      cases where the type conversion occurs in an instance body, and
+--      the operand type is passed as an actual during instantiation.
+--
+-- TEST DESCRIPTION:
+--      In order to satisfy accessibility requirements, the operand type must
+--      be at the same or a less deep nesting level than the target type -- the
+--      operand type must "live" as long as the target type. Nesting levels
+--      are the run-time nestings of masters: block statements; subprogram,
+--      task, and entry bodies; and accept statements. Packages are invisible
+--      to accessibility rules.
+--
+--      This test checks for cases where the operand is a subprogram formal
+--      parameter.
+--
+--      The test declares three generic packages, each containing an access
+--      type conversion in which the operand type is a formal type:
+--
+--         (1) One in which the target type is declared within the
+--             specification, and the conversion occurs within a nested
+--             function.
+--
+--         (2) One in which the target type is also a formal type, and
+--             the conversion occurs within a nested function.
+--
+--         (3) One in which the target type is declared outside the
+--             generic, and the conversion occurs within a nested
+--             procedure.
+--
+--      The test verifies the following:
+--
+--         For (1), Program_Error is not raised when the nested function is
+--         called. Since the actual corresponding to the formal operand type
+--         must always have the same or a less deep level than the target
+--         type declared within the instance, the access type conversion is
+--         always safe.
+--
+--         For (2), Program_Error is raised when the nested function is
+--         called if the operand type passed as an actual during instantiation
+--         has an accessibility level deeper than that of the target type
+--         passed as an actual, and that no exception is raised otherwise.
+--         The exception is propagated to the innermost enclosing master.
+--
+--         For (3), Program_Error is raised when the nested procedure is
+--         called if the operand type passed as an actual during instantiation
+--         has an accessibility level deeper than that of the target type.
+--         The exception is handled within the nested procedure.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F460A00.A
+--      => C460A01.A
+--
+--
+-- CHANGE HISTORY:
+--      09 May 95   SAIC    Initial prerelease version.
+--      24 Apr 96   SAIC    Added code to avoid dead variable optimization.
+--      13 Feb 97   PWB.CTA Removed 'Class from qual expression at line 342.
+--!
+
+generic
+   type Designated_Type is tagged private;
+   type Operand_Type is access Designated_Type;
+package C460A01_0 is
+   type Target_Type is access all Designated_Type;
+   function Convert (P : Operand_Type) return Target_Type;
+end C460A01_0;
+
+
+     --==================================================================--
+
+
+package body C460A01_0 is
+   function Convert (P : Operand_Type) return Target_Type is
+   begin
+      return Target_Type(P); -- Never fails.
+   end Convert;
+end C460A01_0;
+
+
+     --==================================================================--
+
+
+generic
+   type Designated_Type is tagged private;
+   type Operand_Type is access all Designated_Type;
+   type Target_Type  is access all Designated_Type;
+package C460A01_1 is
+   function Convert (P : Operand_Type) return Target_Type;
+end C460A01_1;
+
+
+     --==================================================================--
+
+
+package body C460A01_1 is
+   function Convert (P : Operand_Type) return Target_Type is
+   begin
+      return Target_Type(P);
+   end Convert;
+end C460A01_1;
+
+
+     --==================================================================--
+
+
+with F460A00;
+generic
+   type Designated_Type (<>) is new F460A00.Tagged_Type with private;
+   type Operand_Type is access Designated_Type;
+package C460A01_2 is
+   procedure Proc (P   : Operand_Type; 
+                   Res : out F460A00.TC_Result_Kind);
+end C460A01_2;
+
+
+     --==================================================================--
+
+with Report;
+package body C460A01_2 is
+   procedure Proc (P   : Operand_Type; 
+                   Res : out F460A00.TC_Result_Kind) is
+      Ptr : F460A00.AccTag_L0;
+   begin
+      Ptr := F460A00.AccTag_L0(P);
+
+      -- Avoid optimization (dead variable removal of Ptr):
+      if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.
+         Report.Failed ("Unexpected error in C460A01_2 instance");
+      end if;
+
+      Res := F460A00.OK;
+   exception
+      when Program_Error => Res := F460A00.PE_Exception;
+      when others        => Res := F460A00.Others_Exception;
+   end Proc;
+end C460A01_2;
+
+
+     --==================================================================--
+
+
+with F460A00;
+with C460A01_0;
+with C460A01_1;
+with C460A01_2;
+
+with Report;
+procedure C460A01 is
+begin -- C460A01.                                              -- [ Level = 1 ]
+
+   Report.Test ("C460A01", "Run-time accessibility checks: instance " &
+                "bodies. Operand type of access type conversion is "  &
+                "passed as actual to instance");
+
+
+   SUBTEST1:
+   declare                                                     -- [ Level = 2 ]
+      type AccTag_L2 is access all F460A00.Tagged_Type;
+      Operand: AccTag_L2 := new F460A00.Tagged_Type;
+
+      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST1.
+
+      declare                                                  -- [ Level = 3 ]
+         -- The instantiation of C460A01_0 should NOT result in any
+         -- exceptions.
+
+         package Pack_OK is new C460A01_0 (F460A00.Tagged_Type, AccTag_L2);
+         Target : Pack_OK.Target_Type;
+      begin
+         -- The accessibility level of Pack_OK.Target_Type will always be at
+         -- least as deep as the operand type passed as an actual. Thus,
+         -- a call to Pack_OK.Convert does not propagate an exception:
+
+         Target := Pack_OK.Convert(Operand);
+
+         -- Avoid optimization (dead variable removal of Target):
+         if not Report.Equal (Target.C, Target.C) then      -- Always false.
+            Report.Failed ("Unexpected error in SUBTEST #1");
+         end if;
+
+         Result := F460A00.OK;                              -- Expected result.
+      exception
+         when Program_Error => Result := F460A00.PE_Exception;
+         when others        => Result := F460A00.Others_Exception;
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #1: Program_Error incorrectly raised");
+      when others        =>
+         Report.Failed ("SUBTEST #1: Unexpected exception raised");
+   end SUBTEST1;
+
+
+
+   SUBTEST2:
+   declare                                                     -- [ Level = 2 ]
+      type AccTag_L2 is access all F460A00.Tagged_Type;
+      Operand : AccTag_L2 := new F460A00.Tagged_Type;
+
+      Result  : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST2.
+
+      declare                                                  -- [ Level = 3 ]
+
+         type AccTag_L3 is access all F460A00.Tagged_Type;
+         Target : AccTag_L3;
+
+         -- The instantiation of C460A01_1 should NOT result in any
+         -- exceptions.
+
+         package Pack_OK is new C460A01_1
+           (Designated_Type => F460A00.Tagged_Type,
+            Operand_Type    => AccTag_L2,
+            Target_Type     => AccTag_L3);
+      begin
+         -- The accessibility level of the actual passed as the operand type
+         -- in Pack_OK is 2. The accessibility level of the actual passed as
+         -- the target type is 3. Therefore, the access type conversion in
+         -- Pack_OK.Convert does not raise an exception when the subprogram is
+         -- called. If an exception is (incorrectly) raised, it is propagated 
+         -- to the innermost enclosing master:
+
+         Target := Pack_OK.Convert(Operand);
+
+         -- Avoid optimization (dead variable removal of Target):
+         if not Report.Equal (Target.C, Target.C) then      -- Always false.
+            Report.Failed ("Unexpected error in SUBTEST #2");
+         end if;
+
+         Result := F460A00.OK;                              -- Expected result.
+      exception
+         when Program_Error => Result := F460A00.PE_Exception;
+         when others        => Result := F460A00.Others_Exception;
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #2");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #2: Program_Error incorrectly raised");
+      when others        =>
+         Report.Failed ("SUBTEST #2: Unexpected exception raised");
+   end SUBTEST2;
+
+
+
+   SUBTEST3:
+   declare                                                     -- [ Level = 2 ]
+      type AccTag_L2 is access all F460A00.Tagged_Type;
+      Target : AccTag_L2;
+
+      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST3.
+
+      declare                                                  -- [ Level = 3 ]
+
+         type AccTag_L3 is access all F460A00.Tagged_Type;
+         Operand : AccTag_L3 := new F460A00.Tagged_Type;
+
+         -- The instantiation of C460A01_1 should NOT result in any
+         -- exceptions.
+
+         package Pack_PE is new C460A01_1
+           (Designated_Type => F460A00.Tagged_Type,
+            Operand_Type    => AccTag_L3,
+            Target_Type     => AccTag_L2);
+      begin
+         -- The accessibility level of the actual passed as the operand type
+         -- in Pack_PE is 3. The accessibility level of the actual passed as
+         -- the target type is 2. Therefore, the access type conversion in
+         -- Pack_PE.Convert raises Program_Error when the subprogram is
+         -- called. The exception is propagated to the innermost enclosing
+         -- master:
+
+         Target := Pack_PE.Convert(Operand);
+
+         -- Avoid optimization (dead variable removal of Target):
+         if not Report.Equal (Target.C, Target.C) then      -- Always false.
+            Report.Failed ("Unexpected error in SUBTEST #3");
+         end if;
+
+         Result := F460A00.OK;
+      exception
+         when Program_Error => Result := F460A00.PE_Exception; 
+                                                          -- Expected result.
+         when others        => Result := F460A00.Others_Exception;
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #3");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #3: Program_Error incorrectly raised");
+      when others        =>
+         Report.Failed ("SUBTEST #3: Unexpected exception raised");
+   end SUBTEST3;
+
+
+
+   SUBTEST4:
+   declare                                                     -- [ Level = 2 ]
+      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST4.
+
+      declare                                                  -- [ Level = 3 ]
+
+         TType   :  F460A00.Tagged_Type;
+         Operand :  F460A00.AccTagClass_L0 
+                 := new F460A00.Tagged_Type'(TType);
+
+         -- The instantiation of C460A01_2 should NOT result in any
+         -- exceptions.
+
+         package Pack_OK is new C460A01_2 (F460A00.Tagged_Type'Class,
+                                           F460A00.AccTagClass_L0);
+      begin
+         -- The accessibility level of the actual passed as the operand type
+         -- in Pack_OK is 0. The accessibility level of the target type
+         -- (F460A00.AccTag_L0) is also 0. Therefore, the access type
+         -- conversion in Pack_OK.Proc does not raise an exception when the
+         -- subprogram is called. If an exception is (incorrectly) raised, 
+         -- it is handled within the subprogram:
+
+         Pack_OK.Proc(Operand, Result);
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #4");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #4: Program_Error incorrectly raised");
+      when others        =>
+         Report.Failed ("SUBTEST #4: Unexpected exception raised");
+   end SUBTEST4;
+
+
+
+   SUBTEST5:
+   declare                                                     -- [ Level = 2 ]
+      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST5.
+
+      declare                                                  -- [ Level = 3 ]
+
+         type AccDerTag_L3 is access all F460A00.Derived_Tagged_Type;
+         Operand : AccDerTag_L3 := new F460A00.Derived_Tagged_Type;
+
+         -- The instantiation of C460A01_2 should NOT result in any
+         -- exceptions.
+
+         package Pack_PE is new C460A01_2 (F460A00.Derived_Tagged_Type,
+                                           AccDerTag_L3);
+      begin
+         -- The accessibility level of the actual passed as the operand type
+         -- in Pack_PE is 3. The accessibility level of the target type
+         -- (F460A00.AccTag_L0) is 0. Therefore, the access type conversion
+         -- in Pack_PE.Proc raises Program_Error when the subprogram is
+         -- called. The exception is handled within the subprogram:
+
+         Pack_PE.Proc(Operand, Result);
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #5");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #5: Program_Error incorrectly raised");
+      when others        =>
+         Report.Failed ("SUBTEST #5: Unexpected exception raised");
+   end SUBTEST5;
+
+   Report.Result;
+
+end C460A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460a02.a
new file mode 100644
index 000000000..1d79d3a61
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c460a02.a
@@ -0,0 +1,413 @@
+-- C460A02.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 the target type of a type conversion is a general
+--      access type, Program_Error is raised if the accessibility level of
+--      the operand type is deeper than that of the target type. Check for
+--      cases where the type conversion occurs in an instance body, and
+--      the operand type is declared inside the instance or is the anonymous
+--      access type of an access parameter or access discriminant.
+--
+-- TEST DESCRIPTION:
+--      In order to satisfy accessibility requirements, the operand type must
+--      be at the same or a less deep nesting level than the target type -- the
+--      operand type must "live" as long as the target type. Nesting levels
+--      are the run-time nestings of masters: block statements; subprogram,
+--      task, and entry bodies; and accept statements. Packages are invisible
+--      to accessibility rules.
+--
+--      This test checks for cases where the operand is a component of a
+--      generic formal object, a stand-alone object, and an access parameter.
+--
+--      The test declares three generic units, each containing an access
+--      type conversion in which the target type is a formal type:
+--
+--         (1) A generic package in which the operand type is the anonymous
+--             access type of an access discriminant, and the conversion
+--             occurs within the declarative part of the body.
+--
+--         (2) A generic package in which the operand type is declared within
+--             the specification, and the conversion occurs within the
+--             sequence of statements of the body.
+--
+--         (3) A generic procedure in which the operand type is the anonymous
+--             access type of an access parameter, and the conversion occurs
+--             within the sequence of statements.
+--
+--      The test verifies the following:
+--
+--         For (1), Program_Error is raised when the package is instantiated
+--         if the actual passed through the formal object has an accessibility
+--         level deeper than that of the target type passed as an actual, and
+--         that no exception is raised otherwise. The exception is propagated
+--         to the innermost enclosing master.
+--
+--         For (2), Program_Error is raised when the package is instantiated
+--         if the package is instantiated at a level deeper than that of the
+--         target type passed as an actual, and that no exception is raised
+--         otherwise. The exception is handled within the package body.
+--
+--         For (3), Program_Error is raised when the instance procedure is
+--         called if the actual passed through the access parameter has an
+--         accessibility level deeper than that of the target type passed as
+--         an actual, and that no exception is raised otherwise. The exception
+--         is handled within the instance procedure.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F460A00.A
+--      => C460A02.A
+--
+--
+-- CHANGE HISTORY:
+--      10 May 95   SAIC    Initial prerelease version.
+--      24 Apr 96   SAIC    Changed the target type formal to be 
+--                          access-to-constant; Modified code to avoid dead 
+--                          variable optimization.
+--
+--!
+
+with F460A00;
+generic
+   type Target_Type is access all F460A00.Tagged_Type;
+   FObj: in out F460A00.Composite_Type;
+package C460A02_0 is
+   procedure Dummy; -- Needed to allow package body.
+end C460A02_0;
+
+
+     --==================================================================--
+
+with Report;
+package body C460A02_0 is
+   Ptr: Target_Type := Target_Type(FObj.D);
+
+   procedure Dummy is
+   begin
+      null;
+   end Dummy;
+
+begin
+   -- Avoid optimization (dead variable removal of Ptr):
+   if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.
+      Report.Failed ("Unexpected error in C460A02_0 instance");
+   end if;
+
+end C460A02_0;
+
+
+     --==================================================================--
+
+
+with F460A00;
+generic
+   type Designated_Type is private;
+   type Target_Type is access all Designated_Type;
+   FObj : in out Target_Type;
+   FRes : in out F460A00.TC_Result_Kind;
+package C460A02_1 is
+   type Operand_Type is access Designated_Type;
+   Ptr : Operand_Type := new Designated_Type;
+
+   procedure Dummy; -- Needed to allow package body.
+end C460A02_1;
+
+
+     --==================================================================--
+
+
+package body C460A02_1 is
+   procedure Dummy is
+   begin
+      null;
+   end Dummy;
+begin
+   FRes := F460A00.UN_Init;
+   FObj := Target_Type(Ptr);
+   FRes := F460A00.OK;
+exception
+   when Program_Error => FRes := F460A00.PE_Exception;
+   when others        => FRes := F460A00.Others_Exception;
+end C460A02_1;
+
+
+     --==================================================================--
+
+
+with F460A00;
+generic
+   type Designated_Type is new F460A00.Tagged_Type with private;
+   type Target_Type is access constant Designated_Type;
+procedure C460A02_2 (P   : access Designated_Type'Class;
+                     Res : out    F460A00.TC_Result_Kind);
+
+
+     --==================================================================--
+
+
+with Report;
+procedure C460A02_2 (P   : access Designated_Type'Class;
+                     Res : out    F460A00.TC_Result_Kind) is
+   Ptr : Target_Type;
+begin
+   Res := F460A00.UN_Init;
+   Ptr := Target_Type(P);
+
+   -- Avoid optimization (dead variable removal of Ptr):
+   if not Report.Equal (Ptr.C, Ptr.C) then                  -- Always false.
+      Report.Failed ("Unexpected error in C460A02_2 instance");
+   end if;
+   Res := F460A00.OK;
+exception
+   when Program_Error => Res := F460A00.PE_Exception;
+   when others        => Res := F460A00.Others_Exception;
+end C460A02_2;
+
+
+     --==================================================================--
+
+
+with F460A00;
+with C460A02_0;
+with C460A02_1;
+with C460A02_2;
+
+with Report;
+procedure C460A02 is
+begin -- C460A02.                                              -- [ Level = 1 ]
+
+   Report.Test ("C460A02", "Run-time accessibility checks: instance " &
+                "bodies. Operand type of access type conversion is "  &
+                "declared inside instance or is anonymous");
+
+
+   SUBTEST1:
+   declare                                                     -- [ Level = 2 ]
+      type AccTag_L2 is access all F460A00.Tagged_Type;
+      PTag_L2    : AccTag_L2 := new F460A00.Tagged_Type;
+      Operand_L2 : F460A00.Composite_Type(PTag_L2);
+
+      Result     : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST1.
+
+      begin                                                    -- [ Level = 3 ]
+         declare                                               -- [ Level = 4 ]
+            -- The accessibility level of the actual passed as the target type
+            -- in Pack_OK is 2. The accessibility level of the composite actual
+            -- (and thus, the level of the anonymous type of the access
+            -- discriminant, which is the same as that of the containing 
+            -- object) is also 2. Therefore, the access type conversion in 
+            -- Pack_OK does not raise an exception upon instantiation:
+
+            package Pack_OK is new C460A02_0 
+              (Target_Type => AccTag_L2, FObj => Operand_L2);
+         begin
+            Result := F460A00.OK;                           -- Expected result.
+         end;
+      exception
+         when Program_Error => Result := F460A00.PE_Exception;
+         when others        => Result := F460A00.Others_Exception;
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1");
+
+   end SUBTEST1;
+
+
+
+   SUBTEST2:
+   declare                                                     -- [ Level = 2 ]
+      type AccTag_L2 is access all F460A00.Tagged_Type;
+      PTag_L2 : AccTag_L2 := new F460A00.Tagged_Type;
+
+      Result  : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST2.
+
+      declare                                                  -- [ Level = 3 ]
+         Operand_L3 : F460A00.Composite_Type(PTag_L2);
+      begin
+         declare                                               -- [ Level = 4 ]
+            -- The accessibility level of the actual passed as the target type
+            -- in Pack_PE is 2. The accessibility level of the composite actual
+            -- (and thus, the level of the anonymous type of the access
+            -- discriminant, which is the same as that of the containing 
+            -- object) is 3. Therefore, the access type conversion in Pack_PE 
+            -- propagates Program_Error upon instantiation:
+
+            package Pack_PE is new C460A02_0 (AccTag_L2, Operand_L3);
+         begin
+            Result := F460A00.OK;
+         end;
+      exception
+         when Program_Error => Result := F460A00.PE_Exception;       
+                                                          -- Expected result.
+         when others        => Result := F460A00.Others_Exception;
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #2");
+
+   end SUBTEST2;
+
+
+
+   SUBTEST3:
+   declare                                                     -- [ Level = 2 ]
+      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST3.
+
+      declare                                                  -- [ Level = 3 ]
+         type AccArr_L3 is access all F460A00.Array_Type;
+         Target: AccArr_L3;
+
+         -- The accessibility level of the actual passed as the target type
+         -- in Pack_OK is 3. The accessibility level of the operand type is
+         -- that of the instance, which is also 3. Therefore, the access type
+         -- conversion in Pack_OK does not raise an exception upon
+         -- instantiation. If an exception is (incorrectly) raised, it is 
+         -- handled within the instance:
+
+         package Pack_OK is new C460A02_1
+           (Designated_Type => F460A00.Array_Type,
+            Target_Type     => AccArr_L3,
+            FObj            => Target,
+            FRes            => Result);
+      begin
+         null;
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #3");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #3: Program_Error incorrectly propagated");
+      when others        =>
+         Report.Failed ("SUBTEST #3: Unexpected exception propagated");
+   end SUBTEST3;
+
+
+
+   SUBTEST4:
+   declare                                                     -- [ Level = 2 ]
+      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST4.
+
+      declare                                                  -- [ Level = 3 ]
+         Target: F460A00.AccArr_L0;
+
+         -- The accessibility level of the actual passed as the target type
+         -- in Pack_PE is 0. The accessibility level of the operand type is
+         -- that of the instance, which is 3. Therefore, the access type
+         -- conversion in Pack_PE raises Program_Error upon instantiation.
+         -- The exception is handled within the instance:
+
+         package Pack_PE is new C460A02_1
+           (Designated_Type => F460A00.Array_Type,
+            Target_Type     => F460A00.AccArr_L0,
+            FObj            => Target,
+            FRes            => Result);
+      begin
+         null;
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #4");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #4: Program_Error incorrectly raised");
+      when others        =>
+         Report.Failed ("SUBTEST #4: Unexpected exception raised");
+   end SUBTEST4;
+
+
+
+   SUBTEST5:
+   declare                                                     -- [ Level = 2 ]
+      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST5.
+
+      declare                                                  -- [ Level = 3 ]
+         -- The instantiation of C460A02_2 should NOT result in any
+         -- exceptions.
+
+         procedure Proc is new C460A02_2 (F460A00.Tagged_Type,
+                                          F460A00.AccTag_L0);
+      begin
+         -- The accessibility level of the actual passed to Proc is 0. The
+         -- accessibility level of the actual passed as the target type is
+         -- also 0. Therefore, the access type conversion in Proc does not
+         -- raise an exception when the subprogram is called. If an exception
+         -- is (incorrectly) raised, it is handled within the subprogram:
+
+         Proc (F460A00.PTagClass_L0, Result);
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #5");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #5: Program_Error incorrectly raised");
+      when others        =>
+         Report.Failed ("SUBTEST #5: Unexpected exception raised");
+   end SUBTEST5;
+
+
+
+   SUBTEST6:
+   declare                                                     -- [ Level = 2 ]
+      Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
+   begin -- SUBTEST6.
+
+      declare                                                  -- [ Level = 3 ]
+         -- The instantiation of C460A02_2 should NOT result in any
+         -- exceptions.
+
+         procedure Proc is new C460A02_2 (F460A00.Tagged_Type,
+                                          F460A00.AccTag_L0);
+      begin
+         -- In the call to (instantiated) procedure Proc, the first actual
+         -- parameter is an allocator. Its accessibility level is that of 
+         -- the level of execution of Proc, which is 3. The accessibility 
+         -- level of the actual passed as the target type is 0.  Therefore, 
+         -- the access type conversion in Proc raises Program_Error when the
+         -- subprogram is called. The exception is handled within the
+         -- subprogram:
+
+         Proc (new F460A00.Tagged_Type, Result);
+      end;
+
+      F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #6");
+
+   exception
+      when Program_Error =>
+         Report.Failed ("SUBTEST #6: Program_Error incorrectly raised");
+      when others        =>
+         Report.Failed ("SUBTEST #6: Unexpected exception raised");
+   end SUBTEST6;
+
+   Report.Result;
+
+end C460A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002a.ada
new file mode 100644
index 000000000..e86498da0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002a.ada
@@ -0,0 +1,107 @@
+-- C47002A.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 VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
+-- THE OPERANDS OF QUALIFIED EXPRESSIONS.
+-- THIS TEST IS FOR DISCRETE TYPES.
+
+-- RJW 7/23/86
+
+WITH REPORT; USE REPORT; 
+PROCEDURE C47002A IS
+
+BEGIN
+
+     TEST( "C47002A", "CHECK THAT VALUES HAVING DISCRETE TYPES " &
+                      "CAN BE WRITTEN AS THE OPERANDS OF " &
+                      "QUALIFIED EXPRESSIONS" );
+
+     DECLARE  -- ENUMERATION TYPES.
+          
+          TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+          TYPE WEEKEND IS (SAT, SUN);
+
+          TYPE CHAR IS ('B', 'A');
+
+          TYPE MYBOOL IS (TRUE, FALSE);
+          
+          TYPE NBOOL IS NEW BOOLEAN;
+
+     BEGIN
+          IF WEEKEND'(SAT) >= SUN THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE WEEKEND" );
+          END IF;
+
+          IF CHAR'('B') >= 'A' THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE CHAR" );
+          END IF;
+
+          IF MYBOOL'(TRUE) >= FALSE THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE MYBOOL" );
+          END IF;
+
+          IF NBOOL'(TRUE) <= FALSE THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE NBOOL" );
+          END IF;
+     END;
+
+     DECLARE -- INTEGER TYPES.
+
+          TYPE RESULTS IS (INT1, INT2, INT3);
+   
+          TYPE NEWINT IS NEW INTEGER;
+          
+          TYPE INT IS RANGE -10 .. 10;
+
+          FUNCTION F (I : NEWINT) RETURN RESULTS IS
+          BEGIN
+               RETURN INT1;
+          END F;
+
+          FUNCTION F (I : INT) RETURN RESULTS IS
+          BEGIN
+               RETURN INT2;
+          END F;
+
+          FUNCTION F (I : INTEGER) RETURN RESULTS IS
+          BEGIN
+               RETURN INT3;
+          END F;
+
+     BEGIN
+          IF F (NEWINT'(5)) /= INT1 THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE NEWINT" );
+          END IF;
+
+          IF F (INT'(5)) /= INT2 THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE INT" );
+          END IF;
+
+          IF F (INTEGER'(5)) /= INT3 THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE INTEGER" );
+          END IF;
+     END;
+
+     RESULT;
+END C47002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002b.ada
new file mode 100644
index 000000000..ffa7b96dc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002b.ada
@@ -0,0 +1,115 @@
+-- C47002B.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 VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
+-- THE OPERANDS OF QUALIFIED EXPRESSIONS.
+-- THIS TEST IS FOR REAL TYPES.
+
+-- RJW 7/23/86
+
+WITH REPORT; USE REPORT; 
+PROCEDURE C47002B IS
+
+BEGIN
+
+     TEST( "C47002B", "CHECK THAT VALUES HAVING REAL TYPES " &
+                      "CAN BE WRITTEN AS THE OPERANDS OF " &
+                      "QUALIFIED EXPRESSIONS" );
+
+     DECLARE -- FLOATING POINT TYPES.
+     
+          TYPE RESULTS IS (FL1, FL2, FL3);
+
+          TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
+
+          TYPE NFLT IS NEW FLOAT;
+
+          FUNCTION F (FL : FLT) RETURN RESULTS IS 
+          BEGIN
+               RETURN FL1;
+          END F;
+
+          FUNCTION F (FL : NFLT) RETURN RESULTS IS
+          BEGIN
+               RETURN FL2;
+          END F;
+
+          FUNCTION F (FL : FLOAT) RETURN RESULTS IS
+          BEGIN
+               RETURN FL3;
+          END F;
+
+     BEGIN
+          IF F (FLT'(0.0)) /= FL1 THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE FLT" );
+          END IF;
+
+          IF F (NFLT'(0.0)) /= FL2 THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE NFLT" );
+          END IF;
+
+          IF F (FLOAT'(0.0)) /= FL3 THEN 
+               FAILED ( "INCORRECT RESULTS FOR TYPE FLOAT" );
+          END IF;
+     END;   
+     
+     DECLARE -- FIXED POINT TYPES.
+     
+          TYPE RESULTS IS (FI1, FI2, FI3);
+
+          TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
+
+          TYPE NFIX IS NEW FIXED;
+
+          FUNCTION F (FI : FIXED) RETURN RESULTS IS 
+          BEGIN
+               RETURN FI1;
+          END F;
+
+          FUNCTION F (FI : NFIX) RETURN RESULTS IS
+          BEGIN
+               RETURN FI2;
+          END F;
+
+          FUNCTION F (FI : DURATION) RETURN RESULTS IS
+          BEGIN
+               RETURN FI3;
+          END F;
+
+     BEGIN
+          IF F (FIXED'(0.0)) /= FI1 THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE FIXED" );
+          END IF;
+
+          IF F (NFIX'(0.0)) /= FI2 THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE NFIX" );
+          END IF;
+
+          IF F (DURATION'(0.0)) /= FI3 THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE DURATION" );
+          END IF;
+     END;   
+     
+     RESULT;
+END C47002B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002c.ada
new file mode 100644
index 000000000..b9327e93b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002c.ada
@@ -0,0 +1,212 @@
+-- C47002C.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 VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
+-- THE OPERANDS OF QUALIFIED EXPRESSIONS.
+-- THIS TEST IS FOR ARRAY, RECORD, AND ACCESS TYPES.
+
+-- RJW 7/23/86
+
+WITH REPORT; USE REPORT; 
+PROCEDURE C47002C IS
+
+BEGIN
+
+     TEST( "C47002C", "CHECK THAT VALUES HAVING ARRAY, RECORD, AND " &
+                      "ACCESS TYPES CAN BE WRITTEN AS THE OPERANDS " &
+                      "OF QUALIFIED EXPRESSIONS" );
+
+     DECLARE -- ARRAY TYPES.
+     
+          TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+          SUBTYPE ARR1 IS ARR (1 .. 1);
+          SUBTYPE ARR5 IS ARR (1 .. 5);
+
+          TYPE NARR IS NEW ARR;
+          SUBTYPE NARR2 IS NARR (2 .. 2);
+
+          TYPE TARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) 
+               OF INTEGER;
+          SUBTYPE TARR15 IS TARR (1 .. 1, 1 .. 5);
+          SUBTYPE TARR51 IS TARR (1 .. 5, 1 .. 1);
+
+          TYPE NTARR IS NEW TARR;
+          SUBTYPE NTARR26 IS NTARR (2 .. 6, 2 .. 6);
+
+          FUNCTION F (X : ARR) RETURN ARR IS
+          BEGIN
+               RETURN X;
+          END;
+
+          FUNCTION F (X : NARR) RETURN NARR IS
+          BEGIN
+               RETURN X;
+          END;
+
+          FUNCTION F (X : TARR) RETURN TARR IS
+          BEGIN
+               RETURN X;
+          END;
+
+          FUNCTION F (X : NTARR) RETURN NTARR IS
+          BEGIN
+               RETURN X;
+          END;
+
+     BEGIN
+          IF F (ARR1'(OTHERS => 0))'LAST /= 1 THEN
+               FAILED ( "INCORRECT RESULTS FOR SUBTYPE ARR1" );
+          END IF;
+
+          IF F (ARR5'(OTHERS => 0))'LAST /= 5 THEN 
+               FAILED ( "INCORRECT RESULTS FOR SUBTYPE ARR5" );
+          END IF;
+
+          IF F (NARR2'(OTHERS => 0))'FIRST /= 2 OR 
+             F (NARR2'(OTHERS => 0))'LAST /= 2 THEN
+               FAILED ( "INCORRECT RESULTS FOR SUBTYPE NARR2" );
+          END IF;
+
+          IF F (TARR15'(OTHERS => (OTHERS => 0)))'LAST /= 1 OR 
+             F (TARR15'(OTHERS => (OTHERS => 0)))'LAST (2) /= 5 THEN
+               FAILED ( "INCORRECT RESULTS FOR SUBTYPE TARR15" );
+          END IF;
+
+          IF F (TARR51'(OTHERS => (OTHERS => 0)))'LAST /= 5 OR 
+             F (TARR51'(OTHERS => (OTHERS => 0)))'LAST (2) /= 1 THEN
+               FAILED ( "INCORRECT RESULTS FOR SUBTYPE TARR51" );
+          END IF;
+
+          IF F (NTARR26'(OTHERS => (OTHERS => 0)))'FIRST /= 2 OR 
+             F (NTARR26'(OTHERS => (OTHERS => 0)))'LAST /= 6 OR
+             F (NTARR26'(OTHERS => (OTHERS => 0)))'FIRST (2) /= 2 OR 
+             F (NTARR26'(OTHERS => (OTHERS => 0)))'LAST (2) /= 6 THEN
+               FAILED ( "INCORRECT RESULTS FOR SUBTYPE NTARR26" );
+          END IF;
+
+     END;   
+     
+     DECLARE -- RECORD TYPES.
+
+          TYPE GENDER IS (MALE, FEMALE, NEUTER);
+          
+          TYPE MAN IS
+               RECORD
+                    AGE : POSITIVE;
+               END RECORD;
+
+          TYPE WOMAN IS
+               RECORD
+                    AGE : POSITIVE;
+               END RECORD;
+
+          TYPE ANDROID IS NEW MAN;
+          
+          FUNCTION F (X: WOMAN) RETURN GENDER IS
+          BEGIN
+               RETURN FEMALE;
+          END F;
+
+          FUNCTION F (X: MAN) RETURN GENDER IS
+          BEGIN
+               RETURN MALE;
+          END F;
+          
+          FUNCTION F (X : ANDROID) RETURN GENDER IS
+          BEGIN
+               RETURN NEUTER;
+          END F;
+
+     BEGIN
+          IF F (MAN'(AGE => 23)) /= MALE THEN
+               FAILED ( "INCORRECT RESULTS FOR SUBTYPE MAN" );
+          END IF;
+
+          IF F (WOMAN'(AGE => 38)) /= FEMALE THEN
+               FAILED ( "INCORRECT RESULTS FOR SUBTYPE WOMAN" );
+          END IF;
+
+          IF F (ANDROID'(AGE => 2001)) /= NEUTER THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE ANDRIOD" );
+          END IF;
+     END;     
+                    
+     DECLARE -- ACCESS TYPES.
+
+          TYPE CODE IS (OLD, BRANDNEW, WRECK);
+          
+          TYPE CAR (D : CODE) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE KEY IS ACCESS CAR;
+
+          TYPE KEY_OLD IS ACCESS CAR (OLD);
+          KO : KEY_OLD := NEW CAR'(D => OLD);          
+
+          TYPE KEY_WRECK IS ACCESS CAR (WRECK);
+
+          TYPE KEY_CARD IS NEW KEY;
+          KC : KEY_CARD := NEW CAR'(D => BRANDNEW);          
+ 
+          FUNCTION F (X : KEY_OLD) RETURN CODE IS
+          BEGIN
+               RETURN OLD;
+          END F;
+
+          FUNCTION F (X : KEY_WRECK) RETURN CODE IS
+          BEGIN
+               RETURN WRECK;
+          END F;
+
+          FUNCTION F (X : KEY_CARD) RETURN CODE IS
+          BEGIN
+               RETURN BRANDNEW;
+          END F;
+     BEGIN
+          IF KEY_OLD'(KO) /= KO THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE KEY_OLD - 1" );
+          END IF;
+
+          IF KEY_CARD'(KC) /= KC THEN 
+               FAILED ( "INCORRECT RESULTS FOR TYPE KEY_CARD - 1" );
+          END IF;
+
+
+          IF F (KEY_OLD'(NULL)) /= OLD THEN
+               FAILED ( "INCORRECT RESULTS FOR SUBTYPE KEY_OLD - 2" );
+          END IF;
+
+          IF F (KEY_WRECK'(NULL)) /= WRECK THEN
+               FAILED ( "INCORRECT RESULTS FOR SUBTYPE KEY_WRECK" );
+          END IF;
+
+          IF F (KEY_CARD'(NULL)) /= BRANDNEW THEN
+               FAILED ( "INCORRECT RESULTS FOR TYPE KEY_CARD - 2" );
+          END IF;
+     END;
+          
+     RESULT;
+END C47002C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002d.ada
new file mode 100644
index 000000000..472c20072
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47002d.ada
@@ -0,0 +1,273 @@
+-- C47002D.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 VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
+-- THE OPERANDS OF QUALIFIED EXPRESSIONS.
+-- THIS TEST IS FOR PRIVATE AND LIMITED PRIVATE TYPES.
+
+-- RJW 7/23/86
+
+WITH REPORT; USE REPORT; 
+PROCEDURE C47002D IS
+
+BEGIN
+
+     TEST( "C47002D", "CHECK THAT VALUES HAVING PRIVATE AND LIMITED " &
+                      "PRIVATE TYPES CAN BE WRITTEN AS THE OPERANDS " &
+                      "OF QUALIFIED EXPRESSIONS" );
+
+     DECLARE -- PRIVATE TYPES.
+
+          TYPE RESULTS IS (P1, P2, P3, P4, P5);
+
+          PACKAGE PKG1 IS
+               TYPE PINT IS PRIVATE;
+               TYPE PCHAR IS PRIVATE;
+               TYPE PARR IS PRIVATE;
+               TYPE PREC (D : INTEGER) IS PRIVATE;
+               TYPE PACC IS PRIVATE;
+
+               FUNCTION F RETURN PINT;
+               FUNCTION F RETURN PCHAR;
+               FUNCTION F RETURN PARR;
+               FUNCTION F RETURN PREC;
+               FUNCTION F RETURN PACC;
+
+          PRIVATE
+               TYPE PINT IS NEW INTEGER;
+               TYPE PCHAR IS NEW CHARACTER;
+               TYPE PARR IS ARRAY (1 .. 2) OF NATURAL;
+
+               TYPE PREC (D : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+     
+               TYPE PACC IS ACCESS PREC;
+
+          END PKG1;
+          
+          PACKAGE BODY PKG1 IS
+               FUNCTION F RETURN PINT IS
+               BEGIN
+                    RETURN 1;
+               END F;
+                    
+               FUNCTION F RETURN PCHAR IS
+               BEGIN
+                    RETURN 'B';
+               END F;
+
+               FUNCTION F RETURN PARR IS
+               BEGIN
+                    RETURN PARR'(OTHERS => 3);
+               END F;
+
+               FUNCTION F RETURN PREC IS
+               BEGIN
+                    RETURN PREC'(D => 4);
+               END F;
+
+               FUNCTION F RETURN PACC IS
+               BEGIN
+                    RETURN NEW PREC'(F);
+               END F;
+
+          END PKG1;
+                    
+          PACKAGE PKG2 IS END PKG2;
+
+          PACKAGE BODY PKG2 IS
+               USE PKG1;
+
+               FUNCTION CHECK (P : PINT) RETURN RESULTS IS
+               BEGIN
+                    RETURN  P1;
+               END CHECK;
+     
+               FUNCTION CHECK (P : PCHAR) RETURN RESULTS IS
+               BEGIN
+                    RETURN  P2;
+               END CHECK;
+     
+               FUNCTION CHECK (P : PARR) RETURN RESULTS IS
+               BEGIN
+                    RETURN  P3;
+               END CHECK;
+     
+               FUNCTION CHECK (P : PREC) RETURN RESULTS IS
+               BEGIN
+                    RETURN  P4;
+               END CHECK;
+
+               FUNCTION CHECK (P : PACC) RETURN RESULTS IS
+               BEGIN
+                    RETURN  P5;
+               END CHECK;
+          
+          BEGIN              
+               IF CHECK (PINT'(F)) /= P1 THEN
+                    FAILED ( "INCORRECT RESULTS FOR TYPE PINT" );
+               END IF;
+
+               IF CHECK (PCHAR'(F)) /= P2 THEN
+                    FAILED ( "INCORRECT RESULTS FOR TYPE PCHAR" );
+               END IF;
+                 
+               IF CHECK (PARR'(F)) /= P3 THEN
+                    FAILED ( "INCORRECT RESULTS FOR TYPE PARR" );
+               END IF;
+                 
+               IF CHECK (PREC'(F)) /= P4 THEN
+                    FAILED ( "INCORRECT RESULTS FOR TYPE PREC" );
+               END IF;
+
+               IF CHECK (PACC'(F)) /= P5 THEN
+                    FAILED ( "INCORRECT RESULTS FOR TYPE PACC" );
+               END IF;
+                 
+          END PKG2;
+
+     BEGIN
+          NULL;
+     END;
+
+     DECLARE -- LIMITED PRIVATE TYPES.
+
+          TYPE RESULTS IS (LP1, LP2, LP3, LP4, LP5);
+
+          PACKAGE PKG1 IS
+               TYPE LPINT IS LIMITED PRIVATE;
+               TYPE LPCHAR IS LIMITED PRIVATE;
+               TYPE LPARR IS LIMITED PRIVATE;
+               TYPE LPREC (D : INTEGER) IS LIMITED PRIVATE;
+               TYPE LPACC IS LIMITED PRIVATE;
+
+               FUNCTION F RETURN LPINT;
+               FUNCTION F RETURN LPCHAR;
+               FUNCTION F RETURN LPARR;
+               FUNCTION F RETURN LPREC;
+               FUNCTION F RETURN LPACC;
+
+          PRIVATE
+               TYPE LPINT IS NEW INTEGER;
+               TYPE LPCHAR IS NEW CHARACTER;
+               TYPE LPARR IS ARRAY (1 .. 2) OF NATURAL;
+
+               TYPE LPREC (D : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+     
+               TYPE LPACC IS ACCESS LPREC;
+
+          END PKG1;
+          
+          PACKAGE BODY PKG1 IS
+               FUNCTION F RETURN LPINT IS
+               BEGIN
+                    RETURN 1;
+               END F;
+                    
+               FUNCTION F RETURN LPCHAR IS
+               BEGIN
+                    RETURN 'B';
+               END F;
+
+               FUNCTION F RETURN LPARR IS
+               BEGIN
+                    RETURN LPARR'(OTHERS => 3);
+               END F;
+
+               FUNCTION F RETURN LPREC IS
+               BEGIN
+                    RETURN LPREC'(D => 4);
+               END F;
+
+               FUNCTION F RETURN LPACC IS
+               BEGIN
+                    RETURN NEW LPREC'(F);
+               END F;
+
+          END PKG1;
+                    
+          PACKAGE PKG2 IS END PKG2;
+
+          PACKAGE BODY PKG2 IS
+               USE PKG1;
+
+               FUNCTION CHECK (LP : LPINT) RETURN RESULTS IS
+               BEGIN
+                    RETURN  LP1;
+               END CHECK;
+     
+               FUNCTION CHECK (LP : LPCHAR) RETURN RESULTS IS
+               BEGIN
+                    RETURN  LP2;
+               END CHECK;
+     
+               FUNCTION CHECK (LP : LPARR) RETURN RESULTS IS
+               BEGIN
+                    RETURN  LP3;
+               END CHECK;
+     
+               FUNCTION CHECK (LP : LPREC) RETURN RESULTS IS
+               BEGIN
+                    RETURN  LP4;
+               END CHECK;
+
+               FUNCTION CHECK (LP : LPACC) RETURN RESULTS IS
+               BEGIN
+                    RETURN  LP5;
+               END CHECK;
+          
+          BEGIN              
+               IF CHECK (LPINT'(F)) /= LP1 THEN
+                    FAILED ( "INCORRECT RESULTS FOR TYPE LPINT" );
+               END IF;
+
+               IF CHECK (LPCHAR'(F)) /= LP2 THEN
+                    FAILED ( "INCORRECT RESULTS FOR TYPE LPCHAR" );
+               END IF;
+                 
+               IF CHECK (LPARR'(F)) /= LP3 THEN
+                    FAILED ( "INCORRECT RESULTS FOR TYPE LPARR" );
+               END IF;
+                 
+               IF CHECK (LPREC'(F)) /= LP4 THEN
+                    FAILED ( "INCORRECT RESULTS FOR TYPE LPREC" );
+               END IF;
+
+               IF CHECK (LPACC'(F)) /= LP5 THEN
+                    FAILED ( "INCORRECT RESULTS FOR TYPE LPACC" );
+               END IF;
+                 
+          END PKG2;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C47002D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47003a.ada
new file mode 100644
index 000000000..a3bd47a63
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47003a.ada
@@ -0,0 +1,115 @@
+-- C47003A.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.
+--*
+-- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN 
+-- ENUMERATION TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE 
+-- VALUE OF THE OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
+
+-- RJW 7/23/86
+
+WITH REPORT; USE REPORT; 
+PROCEDURE C47003A IS
+
+BEGIN
+
+     TEST( "C47003A", "WHEN THE TYPE MARK IN A QUALIFIED " &
+                      "EXPRESSION DENOTES AN ENUMERATION " &
+                      "TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "WHEN THE VALUE OF THE OPERAND DOES NOT LIE " &
+                      "WITHIN THE RANGE OF THE TYPE MARK" );
+
+     DECLARE  
+          
+          TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+          SUBTYPE MIDWEEK IS WEEK RANGE TUE .. THU;
+
+          FUNCTION IDENT (W : WEEK) RETURN WEEK IS
+          BEGIN
+               RETURN WEEK'VAL (IDENT_INT (WEEK'POS (W)));
+          END IDENT;
+
+     BEGIN
+          IF MIDWEEK'(IDENT (SUN)) = TUE THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE MIDWEEK - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE MIDWEEK - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE MIDWEEK" );
+     END;
+
+     DECLARE  
+          
+          SUBTYPE CHAR IS CHARACTER RANGE 'C' .. 'R';
+
+     BEGIN
+          IF CHAR'(IDENT_CHAR ('A')) = 'C' THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE CHAR - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE CHAR - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE CHAR" );
+     END;
+
+     DECLARE  
+
+          TYPE NBOOL IS NEW BOOLEAN;
+          SUBTYPE NFALSE IS NBOOL RANGE FALSE .. FALSE;
+
+          FUNCTION IDENT (B : NBOOL) RETURN NBOOL IS
+          BEGIN
+               RETURN NBOOL (IDENT_BOOL (BOOLEAN (B)));
+          END IDENT;
+
+     BEGIN
+          IF NFALSE'(IDENT (TRUE)) = FALSE THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE NFALSE - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE NFALSE - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE NFALSE" );
+     END;
+
+     RESULT;
+END C47003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47004a.ada
new file mode 100644
index 000000000..39659009d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47004a.ada
@@ -0,0 +1,115 @@
+-- C47004A.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.
+--*
+-- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN INTEGER 
+-- TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE OF THE 
+-- OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
+
+-- RJW 7/23/86
+
+WITH REPORT; USE REPORT; 
+PROCEDURE C47004A IS
+
+BEGIN
+
+     TEST( "C47004A", "WHEN THE TYPE MARK IN A QUALIFIED " &
+                      "EXPRESSION DENOTES AN INTEGER " &
+                      "TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "WHEN THE VALUE OF THE OPERAND DOES NOT LIE " &
+                      "WITHIN THE RANGE OF THE TYPE MARK" );
+
+     DECLARE  
+          
+          TYPE INT IS RANGE -10 .. 10;
+          SUBTYPE SINT IS INT RANGE -5 .. 5;
+          
+          FUNCTION IDENT (I : INT) RETURN INT IS
+          BEGIN
+               RETURN INT (IDENT_INT (INTEGER (I)));
+          END;
+
+     BEGIN
+          IF SINT'(IDENT (10)) = 5 THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SINT - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SINT - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE SINT" );
+     END;
+
+     DECLARE  
+          
+          SUBTYPE SINTEGER IS INTEGER RANGE -10 .. 10;
+          
+     BEGIN
+          IF SINTEGER'(IDENT_INT (20)) = 15 THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SINTEGER - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SINTEGER - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE SINTEGER" );
+     END;
+
+     DECLARE  
+          
+          TYPE NINTEGER IS NEW INTEGER;
+          SUBTYPE SNINT IS NINTEGER RANGE -10 .. 10;
+          
+          FUNCTION IDENT (I : NINTEGER) RETURN NINTEGER IS
+          BEGIN
+               RETURN NINTEGER (IDENT_INT (INTEGER (I)));
+          END;
+
+     BEGIN
+          IF SNINT'(IDENT (-20)) = -10 THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SNINT - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SNINT - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE SNINT" );
+     END;
+
+     RESULT;
+END C47004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47005a.ada
new file mode 100644
index 000000000..f9ec93063
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47005a.ada
@@ -0,0 +1,136 @@
+-- C47005A.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:
+--     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A FLOATING
+--     POINT TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE
+--     OF THE OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
+
+-- HISTORY:
+--     RJW 07/23/86  CREATED ORIGINAL TEST.
+--     BCB 08/19/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  ADDED
+--                   TEST FOR UPPER SIDE OF RANGE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C47005A IS
+
+BEGIN
+
+     TEST( "C47005A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
+                      "DENOTES A FLOATING POINT TYPE, CHECK THAT " &
+                      "CONSTRAINT_ERROR IS RAISED WHEN THE VALUE " &
+                      "OF THE OPERAND DOES NOT LIE WITHIN THE " &
+                      "RANGE OF THE TYPE MARK" );
+
+     DECLARE
+
+          SUBTYPE SFLOAT IS FLOAT RANGE -1.0 .. 1.0;
+
+          FUNCTION IDENT (F : FLOAT) RETURN FLOAT IS
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    RETURN F;
+               ELSE
+                    RETURN 0.0;
+               END IF;
+          END IDENT;
+
+     BEGIN
+          IF SFLOAT'(IDENT (-2.0)) = -1.0 THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SFLOAT - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SFLOAT - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE SFLOAT" );
+     END;
+
+     DECLARE
+
+          TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
+          SUBTYPE SFLT IS FLT RANGE -1.0 .. 1.0;
+
+          FUNCTION IDENT (F : FLT) RETURN FLT IS
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    RETURN F;
+               ELSE
+                    RETURN 0.0;
+               END IF;
+          END IDENT;
+
+     BEGIN
+          IF SFLT'(IDENT (-2.0)) = -1.0 THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SFLT - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SFLT - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE SFLT" );
+     END;
+
+     DECLARE
+
+          TYPE NFLT IS NEW FLOAT;
+          SUBTYPE SNFLT IS NFLT RANGE -1.0 .. 1.0;
+
+          FUNCTION IDENT (F : NFLT) RETURN NFLT IS
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    RETURN F;
+               ELSE
+                    RETURN 0.0;
+               END IF;
+          END IDENT;
+
+     BEGIN
+          IF SNFLT'(IDENT (2.0)) = 1.0 THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SNFLT 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SNFLT 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE SNFLT" );
+     END;
+
+     RESULT;
+END C47005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47006a.ada
new file mode 100644
index 000000000..c9587432a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47006a.ada
@@ -0,0 +1,100 @@
+-- C47006A.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.
+--*
+-- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A FIXED POINT 
+-- TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE OF THE 
+-- OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
+
+-- RJW 7/23/86
+
+WITH REPORT; USE REPORT; 
+PROCEDURE C47006A IS
+
+     TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0;
+
+BEGIN
+
+     TEST( "C47006A", "WHEN THE TYPE MARK IN A QUALIFIED " &
+                      "EXPRESSION DENOTES A FIXED POINT TYPE, " &
+                      "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "WHEN THE VALUE OF THE OPERAND DOES NOT LIE " &
+                      "WITHIN THE RANGE OF THE TYPE MARK" );
+
+     DECLARE  
+
+          SUBTYPE SFIXED IS FIXED RANGE -2.0 .. 2.0;
+
+          FUNCTION IDENT (X : FIXED) RETURN FIXED IS
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    RETURN X;
+               ELSE
+                    RETURN 0.0;
+               END IF;
+          END IDENT;
+
+     BEGIN
+          IF SFIXED'(IDENT (-5.0)) = -2.0 THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SFIXED - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SFIXED - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE SFIXED" );
+     END;
+
+     DECLARE  
+
+          TYPE NFIX IS NEW FIXED;
+          SUBTYPE SNFIX IS NFIX RANGE -2.0 .. 2.0;
+
+          FUNCTION IDENT (X : NFIX) RETURN NFIX IS
+          BEGIN
+               RETURN NFIX (IDENT_INT (INTEGER (X)));
+          END IDENT;
+
+     BEGIN
+          IF SNFIX'(IDENT (-5.0)) = -2.0 THEN
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SNFIX - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
+                        "SUBTYPE SNFIX - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
+                        "OF SUBTYPE SNFIX" );
+     END;
+
+     RESULT;
+END C47006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47007a.ada
new file mode 100644
index 000000000..bacc39f77
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47007a.ada
@@ -0,0 +1,195 @@
+-- C47007A.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.
+--*
+-- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A CONSTRAINED 
+-- ARRAY TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE BOUNDS 
+-- OF THE OPERAND ARE NOT THE SAME AS THE BOUNDS OF THE TYPE MARK.
+
+-- RJW 7/23/86
+
+WITH REPORT; USE REPORT; 
+PROCEDURE C47007A IS
+
+     TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+
+     TYPE TARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) 
+          OF INTEGER;
+
+     TYPE NARR IS NEW ARR;
+
+     TYPE NTARR IS NEW TARR;
+
+BEGIN
+
+     TEST( "C47007A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
+                      "DENOTES A CONSTRAINED ARRAY TYPE, CHECK THAT " &
+                      "CONSTRAINT_ERROR IS RAISED WHEN THE BOUNDS " &
+                      "OF THE OPERAND ARE NOT THE SAME AS THE " &
+                      "BOUNDS OF THE TYPE MARK" );
+
+     DECLARE  
+          
+          SUBTYPE SARR IS ARR (IDENT_INT (1) .. IDENT_INT (1));
+          A : ARR (IDENT_INT (2) .. IDENT_INT (2));
+     BEGIN
+          A := SARR'(A'RANGE => 0);
+          FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                   "THOSE OF SUBTYPE SARR" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                        "THE SAME AS THOSE OF SUBTYPE SARR" );
+     END;
+
+     DECLARE  
+          
+          SUBTYPE NULLA IS ARR (IDENT_INT (1) .. IDENT_INT (0));
+          A : ARR (IDENT_INT (2) .. IDENT_INT (1));
+
+     BEGIN
+          A := NULLA'(A'FIRST .. A'LAST => 0);
+          FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                   "THOSE OF SUBTYPE NULLA" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                        "THE SAME AS THOSE OF SUBTYPE NULLA" );
+     END;
+
+     DECLARE  
+
+          SUBTYPE STARR IS TARR (IDENT_INT (1) .. IDENT_INT (1), 
+                                 IDENT_INT (1) .. IDENT_INT (5));
+          A : TARR (IDENT_INT (2) .. IDENT_INT (6),
+                    IDENT_INT (1) .. IDENT_INT (1));
+     BEGIN
+          A := STARR'(A'RANGE => (A'RANGE (2) => 0));
+          FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                   "THOSE OF SUBTYPE STARR" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                        "THE SAME AS THOSE OF SUBTYPE STARR" );
+     END;
+
+     DECLARE  
+          
+          SUBTYPE NULLT IS TARR (IDENT_INT (1) .. IDENT_INT (5), 
+                                 IDENT_INT (1) .. IDENT_INT (0));
+
+          A : TARR (IDENT_INT (1) .. IDENT_INT (5),
+                    IDENT_INT (2) .. IDENT_INT (1));
+     BEGIN
+          A := NULLT'(A'FIRST .. A'LAST  => 
+                     (A'FIRST (2) .. A'LAST (2) => 0));
+          FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                   "THOSE OF SUBTYPE NULLT" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                        "THE SAME AS THOSE OF SUBTYPE NULLT" );
+     END;
+
+     DECLARE  
+          
+          SUBTYPE SNARR IS NARR (IDENT_INT (1) .. IDENT_INT (1));
+          A : NARR (IDENT_INT (2) .. IDENT_INT (2));
+
+     BEGIN
+          A := SNARR'(A'RANGE => 0);
+          FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                   "THOSE OF SUBTYPE SNARR" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                        "THE SAME AS THOSE OF SUBTYPE SNARR" );
+     END;
+
+     DECLARE  
+          
+          SUBTYPE NULLNA IS NARR (IDENT_INT (1) .. IDENT_INT (0));
+          A : NARR (IDENT_INT (2) .. IDENT_INT (1));
+
+     BEGIN
+          A := NULLNA'(A'RANGE => 0);
+          FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                   "THOSE OF SUBTYPE NULLNA" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                        "THE SAME AS THOSE OF SUBTYPE NULLNA" );
+     END;
+
+     DECLARE  
+          
+          SUBTYPE SNTARR IS NTARR (IDENT_INT (1) .. IDENT_INT (1), 
+                                   IDENT_INT (1) .. IDENT_INT (5));
+
+          A : NTARR (IDENT_INT (2) .. IDENT_INT (2),
+                     IDENT_INT (1) .. IDENT_INT (5));
+     BEGIN
+          A := SNTARR'(A'RANGE => (A'RANGE (2) => 0));
+          FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                   "THOSE OF SUBTYPE SNTARR" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                        "THE SAME AS THOSE OF SUBTYPE SNTARR" );
+     END;
+
+     DECLARE  
+          
+          SUBTYPE NULLNT IS NTARR (IDENT_INT (1) .. IDENT_INT (5), 
+                                   IDENT_INT (1) .. IDENT_INT (0));
+
+          A : NTARR (IDENT_INT (1) .. IDENT_INT (5),
+                    IDENT_INT (1) .. IDENT_INT (1));
+     BEGIN
+          A := NULLNT'(A'RANGE => (A'RANGE (2) => 0));
+          FAILED ( "NO EXCEPTION RAISED WHEN BOUNDS NOT THE SAME AS " &
+                   "THOSE OF SUBTYPE NULLNT" );
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED WHEN BOUNDS NOT " &
+                        "THE SAME AS THOSE OF SUBTYPE NULLNT" );
+     END;
+
+     RESULT;
+END C47007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47008a.ada
new file mode 100644
index 000000000..b2218297f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47008a.ada
@@ -0,0 +1,299 @@
+-- C47008A.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:
+--     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A
+--     CONSTRAINED RECORD, PRIVATE, OR LIMITED PRIVATE TYPE, CHECK THAT
+--     CONSTRAINT_ERROR IS RAISED WHEN THE DISCRIMINANTS OF THE OPERAND
+--     DO NOT EQUAL THOSE OF THE TYPE MARK.
+
+-- HISTORY:
+--     RJW 07/23/86
+--     DWC 07/24/87  CHANGED CODE TO TEST FOR FIRST DISCRIMINANT
+--                   AND LAST DISCRIMINANT MISMATCH.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C47008A IS
+
+     TYPE GENDER IS (MALE, FEMALE, NEUTER);
+
+     FUNCTION IDENT (G : GENDER) RETURN GENDER IS
+     BEGIN
+          RETURN GENDER'VAL (IDENT_INT (GENDER'POS (G)));
+     END IDENT;
+
+BEGIN
+
+     TEST( "C47008A", "WHEN THE TYPE MARK IN A QUALIFIED " &
+                      "EXPRESSION DENOTES A CONSTRAINED RECORD, " &
+                      "PRIVATE, OR LIMITED PRIVATE TYPE, CHECK " &
+                      "THAT CONSTRAINT_ERROR IS RAISED WHEN THE " &
+                      "DISCRIMANTS OF THE OPERAND DO NOT EQUAL " &
+                      "THOSE OF THE TYPE MARK" );
+
+     DECLARE
+
+          TYPE PERSON (SEX : GENDER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          SUBTYPE WOMAN IS PERSON (IDENT (FEMALE));
+          TOM : PERSON (MALE) := (SEX => IDENT (MALE));
+
+     BEGIN
+          IF WOMAN'(TOM) = PERSON'(SEX => MALE) THEN
+               FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                        "NOT EQUAL TO THOSE OF SUBTYPE WOMAN - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                        "NOT EQUAL TO THOSE OF SUBTYPE WOMAN - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
+                        "DISC NOT EQUAL TO THOSE OF SUBTYPE WOMAN" );
+     END;
+
+     DECLARE
+          TYPE PAIR (SEX1, SEX2 : GENDER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          SUBTYPE COUPLE IS PAIR (IDENT (FEMALE), IDENT (MALE));
+          JONESES : PAIR (IDENT (MALE), IDENT (FEMALE));
+
+     BEGIN
+          IF COUPLE'(JONESES) = PAIR'(SEX1 => MALE, SEX2 => FEMALE)
+             THEN
+               FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                        "NOT EQUAL TO THOSE OF SUBTYPE COUPLE - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                        "NOT EQUAL TO THOSE OF SUBTYPE COUPLE - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
+                        "DISC NOT EQUAL TO THOSE OF SUBTYPE COUPLE" );
+     END;
+
+     DECLARE
+
+          PACKAGE PKG IS
+               TYPE PERSON (SEX : GENDER) IS PRIVATE;
+               SUBTYPE MAN IS PERSON (IDENT (MALE));
+
+               TESTWRITER : CONSTANT PERSON;
+
+          PRIVATE
+               TYPE PERSON (SEX : GENDER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               TESTWRITER : CONSTANT PERSON := (SEX => FEMALE);
+
+          END PKG;
+
+          USE PKG;
+
+          ROSA : PERSON (IDENT (FEMALE));
+
+     BEGIN
+          IF MAN'(ROSA) = TESTWRITER THEN
+               FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                        "NOT EQUAL TO THOSE OF SUBTYPE MAN - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                        "NOT EQUAL TO THOSE OF SUBTYPE MAN - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
+                        "DISC NOT EQUAL TO THOSE OF SUBTYPE MAN" );
+     END;
+
+     DECLARE
+          PACKAGE PKG IS
+               TYPE PAIR (SEX1, SEX2 : GENDER) IS PRIVATE;
+               SUBTYPE FRIENDS IS PAIR (IDENT (FEMALE), IDENT (MALE));
+
+               ALICE_AND_JERRY : CONSTANT FRIENDS;
+
+          PRIVATE
+               TYPE PAIR (SEX1, SEX2 : GENDER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               ALICE_AND_JERRY : CONSTANT FRIENDS :=
+                                 (IDENT (FEMALE), IDENT (MALE));
+
+          END PKG;
+
+          USE PKG;
+
+          DICK_AND_JOE : PAIR (IDENT (MALE), IDENT (MALE));
+
+     BEGIN
+          IF FRIENDS'(DICK_AND_JOE) = ALICE_AND_JERRY THEN
+               FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                        "NOT EQUAL TO THOSE OF SUBTYPE FRIENDS - 1");
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH DISC " &
+                        "NOT EQUAL TO THOSE OF SUBTYPE FRIENDS - 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND WITH " &
+                        "DISC NOT EQUAL TO THOSE OF SUBTYPE FRIENDS" );
+     END;
+
+     DECLARE
+
+          PACKAGE PKG1 IS
+               TYPE PERSON (SEX : GENDER) IS LIMITED PRIVATE;
+               SUBTYPE ANDROID IS PERSON (IDENT (NEUTER));
+
+               FUNCTION F RETURN PERSON;
+               FUNCTION "=" (A, B : PERSON) RETURN BOOLEAN;
+          PRIVATE
+               TYPE PERSON (SEX : GENDER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+          END PKG1;
+
+          PACKAGE BODY PKG1 IS
+
+               FUNCTION F RETURN PERSON IS
+               BEGIN
+                    RETURN PERSON'(SEX => (IDENT (MALE)));
+               END F;
+
+               FUNCTION "=" (A, B : PERSON) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN A.SEX = B.SEX;
+               END;
+
+          END PKG1;
+
+          PACKAGE PKG2 IS END PKG2;
+
+          PACKAGE BODY PKG2 IS
+               USE PKG1;
+
+          BEGIN
+               IF ANDROID'(F) = F THEN
+                    FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
+                             "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
+                             "ANDROID - 1");
+               ELSE
+                    FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
+                             "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
+                             "ANDROID - 2");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND " &
+                             "WITH DISC NOT EQUAL TO THOSE OF " &
+                             "SUBTYPE ANDROID" );
+          END PKG2;
+
+     BEGIN
+          NULL;
+     END;
+
+     DECLARE
+          PACKAGE PKG1 IS
+               TYPE PAIR (SEX1, SEX2 : GENDER) IS LIMITED PRIVATE;
+               SUBTYPE LOVERS IS PAIR (IDENT (FEMALE), IDENT (MALE));
+
+               FUNCTION F RETURN PAIR;
+               FUNCTION "=" (A, B : PAIR) RETURN BOOLEAN;
+          PRIVATE
+               TYPE PAIR (SEX1, SEX2 : GENDER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END PKG1;
+
+          PACKAGE BODY PKG1 IS
+
+               FUNCTION F RETURN PAIR IS
+               BEGIN
+                    RETURN PAIR'(SEX1 => (IDENT (FEMALE)),
+                                   SEX2 => (IDENT (FEMALE)));
+               END F;
+
+               FUNCTION "=" (A, B : PAIR) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN A.SEX1 = B.SEX2;
+               END;
+
+          END PKG1;
+
+          PACKAGE PKG2 IS END PKG2;
+
+          PACKAGE BODY PKG2 IS
+               USE PKG1;
+
+          BEGIN
+               IF LOVERS'(F) = F THEN
+                    FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
+                             "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
+                             "LOVERS - 1");
+               ELSE
+                    FAILED ( "NO EXCEPTION RAISED FOR OPERAND WITH " &
+                             "DISC NOT EQUAL TO THOSE OF SUBTYPE " &
+                             "LOVERS - 2");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED FOR OPERAND " &
+                             "WITH DISC NOT EQUAL TO THOSE OF " &
+                             "SUBTYPE LOVERS" );
+          END PKG2;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C47008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47009a.ada
new file mode 100644
index 000000000..2fee5194e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47009a.ada
@@ -0,0 +1,254 @@
+-- C47009A.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:
+--     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A
+--     CONSTRAINED ACCESS TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED
+--     WHEN THE VALUE OF THE OPERAND IS NOT NULL AND THE DESIGNATED
+--     OBJECT HAS INDEX BOUNDS OR DISCRIMINANT VALUES THAT DO NOT EQUAL
+--     THOSE SPECIFIED IN THE ACCESS TYPE'S CONSTRAINT.
+
+-- HISTORY:
+--     RJW 7/23/86
+--     DWC 07/24/87  REVISED TO MAKE THE ACCESS TYPE UNCONSTRAINED
+--                   AND TO PREVENT DEAD VARIABLE OPTIMIZATION.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C47009A IS
+
+BEGIN
+
+     TEST( "C47009A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
+                      "DENOTES A CONSTRAINED ACCESS TYPE, CHECK " &
+                      "THAT CONSTRAINT_ERROR IS RAISED WHEN THE " &
+                      "VALUE OF THE OPERAND IS NOT NULL AND THE " &
+                      "DESIGNATED OBJECT HAS INDEX BOUNDS OR " &
+                      "DISCRIMINANT VALUES THAT DO NOT EQUAL THOSE " &
+                      "SPECIFIED IN THE ACCESS TYPE'S CONSTRAINT" );
+
+     DECLARE
+
+          TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+          TYPE ACC1 IS ACCESS ARR;
+          SUBTYPE ACC1S IS ACC1 (IDENT_INT (1) .. IDENT_INT (5));
+          A : ACC1;
+          B : ARR (IDENT_INT (2) .. IDENT_INT (6));
+
+     BEGIN
+          A := ACC1S'(NEW ARR'(B'FIRST .. B'LAST => 0));
+          IF A'FIRST = 1 THEN
+               FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC1 - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC1 - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC1" );
+     END;
+
+     DECLARE
+
+          TYPE ARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>)
+               OF INTEGER;
+          TYPE ACC2 IS ACCESS ARR;
+          SUBTYPE ACC2S IS ACC2 (IDENT_INT (1) .. IDENT_INT (5),
+                                   IDENT_INT (1) .. IDENT_INT (1));
+          A : ACC2;
+          B : ARR (IDENT_INT (1) .. IDENT_INT (5),
+                   IDENT_INT (2) .. IDENT_INT (2));
+
+     BEGIN
+          A := ACC2S'(NEW ARR'(B'RANGE => (B'RANGE (2) => 0)));
+          IF A'FIRST = 1 THEN
+               FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC2 - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC2 - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC2" );
+     END;
+
+     DECLARE
+
+          TYPE REC (D : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE ACC3 IS ACCESS REC;
+          SUBTYPE ACC3S IS ACC3 (IDENT_INT (3));
+          A : ACC3;
+          B : REC (IDENT_INT (5)) := (D => (IDENT_INT (5)));
+
+     BEGIN
+          A := ACC3S'(NEW REC'(B));
+          IF A = NULL THEN
+               FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC3 - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC3 - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC3" );
+     END;
+
+     DECLARE
+
+          TYPE REC (D1,D2 : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE ACC4 IS ACCESS REC;
+          SUBTYPE ACC4S IS ACC4 (IDENT_INT (4), IDENT_INT (5));
+          A : ACC4;
+          B : REC (IDENT_INT (5), IDENT_INT (4)) :=
+              (D1 => (IDENT_INT (5)), D2 => (IDENT_INT (4)));
+
+     BEGIN
+          A := ACC4S'(NEW REC'(B));
+          IF A = NULL THEN
+               FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC4 - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC4 - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR DISC VALUES " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC4" );
+     END;
+
+     DECLARE
+
+          PACKAGE PKG IS
+               TYPE REC (D : INTEGER) IS PRIVATE;
+
+               B : CONSTANT REC;
+          PRIVATE
+               TYPE REC (D : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               B : CONSTANT REC := (D => (IDENT_INT (4)));
+          END PKG;
+
+          USE PKG;
+
+          TYPE ACC5 IS ACCESS REC;
+          SUBTYPE ACC5S IS ACC5 (IDENT_INT (3));
+          A : ACC5;
+
+     BEGIN
+          A := ACC5S'(NEW REC'(B));
+          IF A = NULL THEN
+               FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC5 - 1" );
+          ELSE
+               FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC5 - 2" );
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ( "WRONG EXCEPTION RAISED FOR DISC VALUES " &
+                        "DIFFERENT FROM THOSE OF TYPE ACC5" );
+     END;
+
+     DECLARE
+
+          PACKAGE PKG1 IS
+               TYPE REC (D : INTEGER) IS LIMITED PRIVATE;
+               TYPE ACC6 IS ACCESS REC;
+               SUBTYPE ACC6S IS ACC6 (IDENT_INT (6));
+
+               FUNCTION F RETURN ACC6;
+          PRIVATE
+               TYPE REC (D : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END PKG1;
+
+          PACKAGE BODY PKG1 IS
+
+               FUNCTION F RETURN ACC6 IS
+               BEGIN
+                    RETURN NEW REC'(D => IDENT_INT (5));
+               END F;
+
+          END PKG1;
+
+          PACKAGE PKG2 IS END PKG2;
+
+          PACKAGE BODY PKG2 IS
+               USE PKG1;
+
+               A : ACC6;
+
+          BEGIN
+               A := ACC6S'(F);
+               IF A = NULL THEN
+                    FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                             "DIFFERENT FROM THOSE OF TYPE ACC6 - 1" );
+               ELSE
+                    FAILED ( "NO EXCEPTION RAISED FOR INDEX BOUNDS " &
+                             "DIFFERENT FROM THOSE OF TYPE ACC6 - 2" );
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED FOR DISC " &
+                             "VALUES DIFFERENT FROM THOSE OF TYPE " &
+                             "ACC6" );
+          END PKG2;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C47009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47009b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47009b.ada
new file mode 100644
index 000000000..accd787d4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c47009b.ada
@@ -0,0 +1,282 @@
+-- C47009B.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:
+--     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES AN ACCESS
+--     TYPE, CHECK THAT CONSTRAINT_ERROR IS NOT RAISED WHEN THE VALUE
+--     OF THE OPERAND IS NULL.
+
+-- HISTORY:
+--     RJW 07/23/86  CREATED ORIGINAL TEST.
+--     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  CHANGED
+--                   CONSTRAINTS OF B SUBTYPES TO VALUES WHICH ARE
+--                   CLOSER TO THE VALUES OF THE A SUBTYPES.  INDENTED
+--                   THE EXCEPTION STATEMENTS IN SUBTEST 11.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C47009B IS
+
+BEGIN
+
+     TEST( "C47009B", "WHEN THE TYPE MARK IN A QUALIFIED " &
+                      "EXPRESSION DENOTES AN ACCESS TYPE, " &
+                      "CHECK THAT CONSTRAINT_ERROR IS NOT " &
+                      "RAISED WHEN THE VALUE OF THE OPERAND IS NULL" );
+
+     DECLARE
+
+          TYPE ACC1 IS ACCESS BOOLEAN;
+          A : ACC1;
+
+     BEGIN
+          A := ACC1'(NULL);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC1" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC1" );
+     END;
+
+     DECLARE
+
+          TYPE ACC2 IS ACCESS INTEGER;
+          A : ACC2;
+
+     BEGIN
+          A := ACC2'(NULL);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC2" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC2" );
+     END;
+
+     DECLARE
+
+          TYPE CHAR IS ('A', 'B');
+          TYPE ACC3 IS ACCESS CHAR;
+          A : ACC3;
+
+     BEGIN
+          A := ACC3'(NULL);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC3" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC3" );
+     END;
+
+     DECLARE
+
+          TYPE FLOAT1 IS DIGITS 5 RANGE -1.0 .. 1.0;
+          TYPE ACC4 IS ACCESS FLOAT1;
+          A : ACC4;
+
+     BEGIN
+          A := ACC4'(NULL);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC4" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC4" );
+     END;
+
+     DECLARE
+
+          TYPE FIXED IS DELTA 0.5 RANGE -1.0 .. 1.0;
+          TYPE ACC5 IS ACCESS FIXED;
+          A : ACC5;
+
+     BEGIN
+          A := ACC5'(NULL);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE ACC5" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE ACC5" );
+     END;
+
+     DECLARE
+
+          TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
+          TYPE ACC6 IS ACCESS ARR;
+          SUBTYPE ACC6A IS ACC6 (IDENT_INT (1) .. IDENT_INT (5));
+          SUBTYPE ACC6B IS ACC6 (IDENT_INT (2) .. IDENT_INT (10));
+          A : ACC6A;
+          B : ACC6B;
+
+     BEGIN
+          A := ACC6A'(B);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
+                        "TYPE ACC6" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                        "TYPE ACC6" );
+     END;
+
+     DECLARE
+
+          TYPE ARR IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>)
+               OF INTEGER;
+          TYPE ACC7 IS ACCESS ARR;
+          SUBTYPE ACC7A IS ACC7 (IDENT_INT (1) .. IDENT_INT (5),
+                                 IDENT_INT (1) .. IDENT_INT (1));
+          SUBTYPE ACC7B IS ACC7 (IDENT_INT (1) .. IDENT_INT (15),
+                                 IDENT_INT (1) .. IDENT_INT (10));
+          A : ACC7A;
+          B : ACC7B;
+
+     BEGIN
+          A := ACC7A'(B);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
+                        "TYPE ACC7" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                        "TYPE ACC7" );
+     END;
+
+     DECLARE
+
+          TYPE REC (D : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE ACC8 IS ACCESS REC;
+          SUBTYPE ACC8A IS ACC8 (IDENT_INT (5));
+          SUBTYPE ACC8B IS ACC8 (IDENT_INT (6));
+          A : ACC8A;
+          B : ACC8B;
+
+     BEGIN
+          A := ACC8A'(B);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
+                        "TYPE ACC8" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                        "TYPE ACC8" );
+     END;
+
+     DECLARE
+
+          TYPE REC (D1,D2 : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE ACC9 IS ACCESS REC;
+          SUBTYPE ACC9A IS ACC9 (IDENT_INT (4), IDENT_INT (5));
+          SUBTYPE ACC9B IS ACC9 (IDENT_INT (5), IDENT_INT (4));
+          A : ACC9A;
+          B : ACC9B;
+
+     BEGIN
+          A := ACC9A'(B);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
+                        "TYPE ACC9" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                        "TYPE ACC9" );
+     END;
+
+     DECLARE
+
+          PACKAGE PKG IS
+               TYPE REC (D : INTEGER) IS PRIVATE;
+
+          PRIVATE
+               TYPE REC (D : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+          END PKG;
+
+          USE PKG;
+
+          TYPE ACC10 IS ACCESS REC;
+          SUBTYPE ACC10A IS ACC10 (IDENT_INT (10));
+          SUBTYPE ACC10B IS ACC10 (IDENT_INT (9));
+          A : ACC10A;
+          B : ACC10B;
+
+     BEGIN
+          A := ACC10A'(B);
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF " &
+                        "TYPE ACC10" );
+          WHEN OTHERS =>
+               FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                        "TYPE ACC10" );
+     END;
+
+     DECLARE
+
+          PACKAGE PKG1 IS
+               TYPE REC (D : INTEGER) IS LIMITED PRIVATE;
+
+          PRIVATE
+               TYPE REC (D : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END PKG1;
+
+          PACKAGE PKG2 IS END PKG2;
+
+          PACKAGE BODY PKG2 IS
+               USE PKG1;
+
+               TYPE ACC11 IS ACCESS REC;
+               SUBTYPE ACC11A IS ACC11 (IDENT_INT (11));
+               SUBTYPE ACC11B IS ACC11 (IDENT_INT (12));
+               A : ACC11A;
+               B : ACC11B;
+
+          BEGIN
+               A := ACC11A'(B);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED FOR SUBTYPES OF" &
+                             " TYPE ACC11" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED FOR SUBTYPES OF " &
+                             "TYPE ACC11" );
+          END PKG2;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C47009B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004a.ada
new file mode 100644
index 000000000..5dd315a17
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004a.ada
@@ -0,0 +1,60 @@
+-- C48004A.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 FORM "NEW T" IS PERMITTED IF T IS A SCALAR SUBTYPE.
+
+-- RM  01/12/80
+-- JBG 03/03/83
+-- EG  07/05/84
+
+WITH REPORT;
+
+PROCEDURE  C48004A  IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48004A","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF " &
+                    "T IS A SCALAR SUBTYPE");
+
+     DECLARE
+
+          SUBTYPE TA IS INTEGER RANGE 1 .. 7;
+          TYPE ATA IS ACCESS TA;
+          VA : ATA;
+
+     BEGIN
+
+          VA := NEW TA;
+          VA.ALL := IDENT_INT(6);
+          IF VA.ALL /= 6 THEN
+               FAILED ("INCORRECT VALUE");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C48004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004b.ada
new file mode 100644
index 000000000..0ba6c07b0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004b.ada
@@ -0,0 +1,140 @@
+-- C48004B.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 FORM "NEW T" IS PERMITTED IF T IS A CONSTRAINED
+-- RECORD, PRIVATE, OR LIMITED PRIVATE TYPE.
+
+-- RM  01/12/80
+-- JBG 03/03/83
+-- EG  07/05/84
+
+WITH REPORT;
+
+PROCEDURE C48004B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48004B","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF " &
+                    "T IS A CONSTRAINED RECORD, PRIVATE, OR "      &
+                    "LIMITED PRIVATE TYPE");
+
+     DECLARE
+
+          TYPE  TB0(A , B : INTEGER )  IS
+               RECORD
+                    C : INTEGER := 7;
+               END RECORD;
+          SUBTYPE  TB  IS  TB0( 2 , 3 );
+          TYPE ATB IS ACCESS TB0;
+          VB : ATB;
+
+          TYPE  TBB0(  A , B : INTEGER := 5 )  IS
+               RECORD
+                    C : INTEGER := 6;
+               END RECORD;
+          SUBTYPE  TBB  IS  TBB0( 4 , 5 );
+          TYPE ATBB IS ACCESS TBB0;
+          VBB : ATBB;
+
+          PACKAGE  P  IS
+               TYPE   PRIV0( A , B : INTEGER )  IS PRIVATE;
+               TYPE  LPRIV0( A , B : INTEGER := 1 )  IS LIMITED PRIVATE;
+               FUNCTION FUN(LP : LPRIV0) RETURN INTEGER;
+          PRIVATE
+               TYPE  PRIV0( A , B : INTEGER )  IS
+                    RECORD
+                         Q : INTEGER;
+                    END RECORD;
+               TYPE  LPRIV0( A , B : INTEGER := 1 )  IS
+                    RECORD
+                         Q : INTEGER := 7;
+                    END RECORD;
+          END P;
+     
+          USE P;
+
+          SUBTYPE  PRIV  IS  P.PRIV0( 12 , 13 );
+          TYPE  A_PRIV  IS  ACCESS P.PRIV0;
+          VP : A_PRIV;
+
+          TYPE  A_LPRIV  IS  ACCESS LPRIV0;
+          VLP : A_LPRIV;
+
+          TYPE LCR(A, B : INTEGER := 4) IS
+               RECORD
+                    C : P.LPRIV0;
+               END RECORD;
+          SUBTYPE SLCR IS LCR(1, 2);
+          TYPE A_SLCR IS ACCESS SLCR;
+          VSLCR : A_SLCR;
+
+          PACKAGE BODY P IS
+               FUNCTION FUN(LP : LPRIV0) RETURN INTEGER IS
+               BEGIN
+                    RETURN LP.Q;
+               END FUN;
+          END P;
+
+     BEGIN
+
+          VB  :=  NEW TB;
+          IF ( VB.A /= IDENT_INT(2)  OR
+               VB.B /= 3  OR
+               VB.C /= 7 )  THEN FAILED( "WRONG VALUES  -  B1" );
+          END IF;
+
+          VBB  :=  NEW TBB0;
+          IF ( VBB.A /= IDENT_INT(5)  OR
+               VBB.B /= 5  OR
+               VBB.C /= 6 )  THEN
+               FAILED( "WRONG VALUES  -  B2" );
+          END IF;
+          
+          VP  :=  NEW PRIV;
+          IF ( VP.A /= IDENT_INT(12)  OR
+               VP.B /= 13 )  THEN 
+               FAILED( "WRONG VALUES  -  B3" );
+          END IF;
+          
+          VLP  :=  NEW LPRIV0;
+          IF ( VLP.A /= IDENT_INT(1)  OR
+               VLP.B /= 1 OR
+               P.FUN(VLP.ALL) /= IDENT_INT(7) )  THEN 
+               FAILED( "WRONG VALUES  -  B4" );
+          END IF;
+
+          VSLCR := NEW SLCR;
+          IF ( VSLCR.A /= IDENT_INT(1) OR
+               VSLCR.B /= IDENT_INT(2) OR
+               P.FUN(VSLCR.C) /= IDENT_INT(7) ) THEN
+               FAILED ("WRONG VALUES - B5");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C48004B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004c.ada
new file mode 100644
index 000000000..2b867a070
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004c.ada
@@ -0,0 +1,101 @@
+-- C48004C.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 FORM "NEW T" IS PERMITTED IF T IS AN UNCONSTRAINED
+-- RECORD, PRIVATE, OR LIMITED TYPE WHOSE DISCRIMINANTS HAVE DEFAULT
+-- VALUES.
+
+-- EG  08/03/84
+
+WITH REPORT;
+
+PROCEDURE C48004C IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48004C","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF "   &
+                    "T IS AN UNCONSTRAINED RECORD, PRIVATE, OR "     &
+                    "LIMITED TYPE WHOSE DISCRIMINANTS HAVE DEFAULT " &
+                    "VALUES");
+
+     DECLARE
+
+          TYPE  UR(A : INTEGER := 1; B : INTEGER := 2)  IS
+               RECORD
+                    C : INTEGER := 7;
+               END RECORD;
+
+          PACKAGE  P  IS
+
+               TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS PRIVATE;
+               TYPE UL(A, B : INTEGER := 1) IS LIMITED PRIVATE;
+
+          PRIVATE
+
+               TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS
+                    RECORD
+                         Q : INTEGER;
+                    END RECORD;
+               TYPE UL(A, B : INTEGER := 1) IS
+                    RECORD
+                         Q : INTEGER;
+                    END RECORD;
+
+          END P;
+     
+          USE P;
+
+          TYPE A_UR IS ACCESS UR;
+          TYPE A_UP IS ACCESS UP;
+          TYPE A_UL IS ACCESS UL;
+
+          V_UR : A_UR;
+          V_UP : A_UP;
+          V_UL : A_UL;
+
+     BEGIN
+
+          V_UR := NEW UR;
+          IF ( V_UR.A /= IDENT_INT(1) OR V_UR.B /= 2 OR
+               V_UR.C /= 7 ) THEN 
+               FAILED("WRONG VALUES - UR");
+          END IF;
+
+          V_UP := NEW UP;
+          IF ( V_UP.A /= IDENT_INT(12) OR V_UP.B /= 13 ) THEN
+               FAILED("WRONG VALUES - UP");
+          END IF;
+          
+          V_UL := NEW UL;
+          IF ( V_UL.A /= IDENT_INT(1) OR V_UL.B /= 1 ) THEN
+               FAILED("WRONG VALUES - UL");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C48004C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004d.ada
new file mode 100644
index 000000000..9454327dc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004d.ada
@@ -0,0 +1,124 @@
+-- C48004D.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 FORM "NEW T" IS PERMITTED IF T IS A RECORD, PRIVATE,
+-- OR LIMITED TYPE WITHOUT DISCRIMINANTS.
+
+-- RM  01/12/80
+-- JBG 03/03/83
+-- EG  07/05/84
+
+WITH REPORT;
+
+PROCEDURE C48004D IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48004D","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
+                    "IS A RECORD, PRIVATE, OR LIMITED TYPE WITHOUT " &
+                    "DISCRIMINANTS");
+
+     DECLARE
+
+          TYPE  TC  IS
+               RECORD
+                    C : INTEGER := 18;
+               END RECORD;
+          TYPE ATC IS ACCESS TC;
+          VC : ATC;
+
+          PACKAGE  P  IS
+               TYPE   PRIV  IS PRIVATE;
+               TYPE  LPRIV  IS LIMITED PRIVATE;
+               TYPE A_PRIV  IS  ACCESS PRIV;
+               TYPE A_LPRIV  IS  ACCESS LPRIV;
+               PROCEDURE   CHECK( X: A_PRIV  );
+               PROCEDURE  LCHECK( X: A_LPRIV );
+               PROCEDURE LRCHECK( X: LPRIV );
+          PRIVATE
+               TYPE   PRIV  IS
+                    RECORD
+                         Q : INTEGER := 19;
+                    END RECORD;
+               TYPE  LPRIV  IS
+                    RECORD
+                         Q : INTEGER := 20;
+                    END RECORD;
+          END P;
+
+     
+          VP  :  P.A_PRIV;
+          VLP : P.A_LPRIV;
+
+          TYPE LCR IS
+               RECORD
+                    C : P.LPRIV;
+               END RECORD;
+          TYPE A_LCR IS ACCESS LCR;
+          VLCR : A_LCR;
+
+          PACKAGE BODY  P  IS
+
+               PROCEDURE  CHECK( X: A_PRIV )  IS
+               BEGIN
+                    IF  X.Q /= 19  THEN  FAILED( "WRONG VALUES - C2" );
+                    END IF;
+               END CHECK;
+     
+               PROCEDURE  LCHECK( X: A_LPRIV )  IS
+               BEGIN
+                    IF  X.Q /= 20  THEN  FAILED( "WRONG VALUES - C3" );
+                    END IF;
+               END LCHECK;
+
+               PROCEDURE LRCHECK (X : LPRIV) IS
+               BEGIN
+                    IF X.Q /= 20 THEN
+                         FAILED ("WRONG VALUES - C4");
+                    END IF;
+               END LRCHECK;
+
+          END P;
+
+     BEGIN
+
+          VC  :=  NEW TC;
+          IF  VC.C /= 18  THEN FAILED( "WRONG VALUES  -  C1" );
+          END IF;
+          
+          VP  :=  NEW P.PRIV;
+          P.CHECK( VP );
+          VLP :=  NEW P.LPRIV;
+          P.LCHECK( VLP );
+
+          VLCR := NEW LCR;
+          P.LRCHECK( VLCR.ALL.C );
+
+     END;
+
+     RESULT;
+
+END C48004D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004e.ada
new file mode 100644
index 000000000..22e62ba84
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004e.ada
@@ -0,0 +1,89 @@
+-- C48004E.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 FORM "NEW T" IS PERMITTED IF T IS A CONSTRAINED ARRAY
+-- TYPE.
+
+-- RM  01/12/80
+-- JBG 03/03/83
+-- EG  07/05/84
+
+WITH REPORT;
+
+PROCEDURE  C48004E  IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48004E","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
+                    "IS A CONSTRAINED ARRAY TYPE");
+
+     DECLARE
+
+          TYPE ARR0 IS ARRAY( INTEGER RANGE <> ) OF BOOLEAN;
+          SUBTYPE ARR IS ARR0(1 .. 10);
+          TYPE  A_ARR  IS  ACCESS ARR;
+          VARR : A_ARR;
+
+          PACKAGE P IS
+               TYPE LPRIV IS LIMITED PRIVATE;
+               FUNCTION CHECK (X : LPRIV) RETURN INTEGER;
+          PRIVATE
+               TYPE LPRIV IS
+                    RECORD
+                         Q : INTEGER := 20;
+                    END RECORD;
+          END P;
+
+          TYPE LPARR IS ARRAY(1 .. 2) OF P.LPRIV;
+          TYPE A_LPARR IS ACCESS LPARR;
+
+          V_A_LPARR : A_LPARR;
+
+          PACKAGE BODY P IS
+               FUNCTION CHECK (X : LPRIV) RETURN INTEGER IS
+               BEGIN
+                    RETURN X.Q;
+               END CHECK;
+          END P;
+          
+     BEGIN
+
+          VARR := NEW ARR;
+          IF  ( VARR'FIRST /= IDENT_INT(1)  OR
+                VARR'LAST /= 10 )  THEN FAILED("WRONG BOUNDS - CASE 1");
+          END IF;
+
+          V_A_LPARR := NEW LPARR;
+          IF ( P.CHECK(V_A_LPARR.ALL(1)) /= IDENT_INT(20) OR
+               P.CHECK(V_A_LPARR.ALL(2)) /= IDENT_INT(20) ) THEN
+               FAILED ("WRONG VALUES - CASE 2");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C48004E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004f.ada
new file mode 100644
index 000000000..50ab9e71e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48004f.ada
@@ -0,0 +1,99 @@
+-- C48004F.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 FORM "NEW T" IS PERMITTED IF T IS AN ACCESS TYPE.
+
+-- RM  01/12/80
+-- JBG 03/03/83
+-- EG  07/05/84
+
+WITH REPORT;
+
+PROCEDURE C48004F  IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48004F","CHECK THAT THE FORM 'NEW T' IS PERMITTED IF T " &
+                    "IS AN ACCESS TYPE");
+
+     DECLARE
+
+          TYPE AINT IS ACCESS INTEGER;
+          TYPE A_AINT IS ACCESS AINT;
+          VA_AINT : A_AINT;
+
+          TYPE AST IS ACCESS STRING;
+          SUBTYPE CAST_4 IS AST(1 .. 4);
+          TYPE A_AST IS ACCESS AST;
+          TYPE ACAST_3 IS ACCESS AST(1 .. 3);
+          V_AAST : A_AST;
+          V_ACAST_3 : ACAST_3;
+
+          TYPE UR(A, B : INTEGER) IS
+               RECORD
+                    C : INTEGER;
+               END RECORD;
+          SUBTYPE CR IS UR(1, 2);
+          TYPE A_CR IS ACCESS CR;
+          TYPE AA_CR IS ACCESS A_CR;
+          V_AA_CR : AA_CR;
+
+     BEGIN
+
+          VA_AINT := NEW AINT;
+          IF VA_AINT.ALL /= NULL THEN
+               FAILED ("VARIABLE IS NOT NULL - CASE 1");
+          END IF;
+
+          BEGIN
+
+               V_ACAST_3 := NEW CAST_4;
+               IF V_ACAST_3.ALL /= NULL THEN
+                    FAILED ("VARIABLE IS NOT NULL - CASE 2");
+               END IF;
+
+          EXCEPTION
+
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - CASE 2");
+
+          END;
+
+          V_AAST := NEW AST;
+          IF V_AAST.ALL /= NULL THEN
+               FAILED ("VARIABLE IS NOT NULL - CASE 3");
+          END IF;
+
+          V_AA_CR := NEW A_CR;
+          IF V_AA_CR.ALL /= NULL THEN
+               FAILED ("VARIABLE IS NOT NULL - CASE 4");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C48004F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48005a.ada
new file mode 100644
index 000000000..13bea3af1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48005a.ada
@@ -0,0 +1,121 @@
+-- C48005A.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 ALLOCATOR OF THE FORM "NEW T X" ALLOCATES A NEW OBJECT
+-- EACH TIME IT IS EXECUTED AND THAT IF T IS AN UNCONSTRAINED RECORD,
+-- PRIVATE, OR LIMITED TYPE, THE ALLOCATED OBJECT HAS THE DISCRIMINANT
+-- VALUES SPECIFIED BY X.
+
+-- EG  08/08/84
+
+WITH REPORT;
+
+PROCEDURE C48005A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48005A","CHECK THAT THE FORM 'NEW T X' ALLOCATES A " &
+                    "NEW OBJECT AND THAT IF T IS AN UNCONSTRAINED " &
+                    "RECORD, PRIVATE, OR LIMITED TYPE, THE " &
+                    "ALLOCATED OBJECT HAS THE DISCRIMINANT " &
+                    "VALUES SPECIFIED BY X");
+
+     DECLARE
+
+          TYPE UR1(A : INTEGER) IS
+               RECORD
+                    B : INTEGER := 7;
+                    C : INTEGER := 4;
+               END RECORD;
+          TYPE UR2(A : INTEGER) IS
+               RECORD
+                    CASE A IS
+                         WHEN 1 =>
+                              A1 : INTEGER := 4;
+                         WHEN 2 =>
+                              A2 : INTEGER := 5;
+                         WHEN OTHERS =>
+                              NULL;
+                    END CASE;
+               END RECORD;
+
+          TYPE A_UR1 IS ACCESS UR1;
+          TYPE A_UR2 IS ACCESS UR2;
+
+          V1AUR1 : A_UR1;
+          V1AUR2, V2AUR2 : A_UR2;
+
+          TYPE REC (A : INTEGER) IS
+               RECORD
+                    B : INTEGER;
+               END RECORD;
+
+          TYPE A_REC IS ACCESS REC;
+
+          V_A_REC : A_REC;
+
+          TYPE ARR IS ARRAY(1 .. 1) OF INTEGER;
+
+          TYPE RECVAL IS
+               RECORD
+                    A : INTEGER;
+                    B : ARR;
+               END RECORD;
+
+          FUNCTION FUN (A : INTEGER) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT(A);
+          END FUN;
+          FUNCTION FUN (A : INTEGER) RETURN RECVAL IS
+          BEGIN
+               FAILED ("WRONG OVERLOADED FUNCTION CALLED");
+               RETURN (1, (1 => 2));
+          END FUN;
+
+     BEGIN
+
+          V1AUR1 := NEW UR1(3);
+          IF ( V1AUR1.A /= 3 OR V1AUR1.B /= 7 OR
+               V1AUR1.C /= IDENT_INT(4) ) THEN
+               FAILED("WRONG VALUES - V1UAR1");
+          END IF;
+
+          V1AUR2 := NEW UR2(IDENT_INT(2));
+          IF ( V1AUR2.A /= 2 OR V1AUR2.A2 /= IDENT_INT(5) ) THEN
+               FAILED("WRONG VALUES - V1AUR2");
+          END IF;
+
+          V2AUR2 := NEW UR2(IDENT_INT(3));
+          IF ( V2AUR2.A /= IDENT_INT(3) ) THEN
+               FAILED("WRONG VALUES - V2AUR2");
+          END IF;
+
+          V_A_REC := NEW REC(FUN(2));
+     END;
+
+     RESULT;
+
+END C48005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48005b.ada
new file mode 100644
index 000000000..c03bde6e0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48005b.ada
@@ -0,0 +1,78 @@
+-- C48005B.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 ALLOCATOR OF THE FORM "NEW T X" ALLOCATES A NEW OBJECT
+-- EACH TIME IT IS EXECUTED AND THAT IF X IS AN INDEX CONSTRAINT AND T
+-- AN UNCONSTRAINED ARRAY TYPE, THE ALLOCATED OBJECT HAS THE INDEX
+-- BOUNDS SPECIFIED BY X.
+
+-- EG  08/10/84
+
+WITH REPORT;
+
+PROCEDURE C48005B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48005B","CHECK THAT THE FORM 'NEW T X' ALLOCATES A " &
+                    "NEW OBJECT AND THAT IF X IS AN INDEX "      &
+                    "CONSTRAINT AND T AN UNCONSTRAINED ARRAY "   &
+                    "TYPE, THE ALLOCATED OBJECT HAS THE INDEX "  &
+                    "BOUND SPECIFIED BY X");
+
+     DECLARE
+
+          TYPE UA1 IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+          TYPE UA2 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
+                              OF INTEGER;
+
+          TYPE A_UA1 IS ACCESS UA1;
+          TYPE A_UA2 IS ACCESS UA2;
+
+          V_A_UA1 : A_UA1;
+          V_A_UA2 : A_UA2;
+
+     BEGIN
+
+          V_A_UA1 := NEW UA1(4 .. 7);
+          IF ( V_A_UA1'FIRST /= IDENT_INT(4) OR
+               V_A_UA1'LAST  /= IDENT_INT(7) ) THEN
+               FAILED("WRONG ARRAY BOUNDS - V_A_UA1");
+          END IF;
+
+          V_A_UA2 := NEW UA2(2 .. 3, 4 .. 6);
+          IF ( V_A_UA2'FIRST(1) /= IDENT_INT(2) OR
+               V_A_UA2'LAST(1)  /= IDENT_INT(3) OR
+               V_A_UA2'FIRST(2) /= IDENT_INT(4) OR
+               V_A_UA2'LAST(2)  /= IDENT_INT(6) ) THEN
+               FAILED("WRONG ARRAY BOUNDS - V_A_UA2");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C48005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48006a.ada
new file mode 100644
index 000000000..22c0582ac
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48006a.ada
@@ -0,0 +1,96 @@
+-- C48006A.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 ALLOCATOR OF THE FORM "NEW T'(X)" ALLOCATES A NEW 
+-- OBJECT EACH TIME IT IS EXECUTED AND THAT IF T IS A SCALAR OR ACCESS
+-- TYPE, THE ALLOCATED OBJECT HAS THE VALUE OF X.
+
+-- RM  01/14/80
+-- RM  01/O1/82
+-- SPS 10/27/82
+-- EG  07/05/84
+
+WITH REPORT;
+
+PROCEDURE C48006A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48006A","CHECK THAT THE FORM 'NEW T'(X)' " &
+                    "ALLOCATES A NEW OBJECT " &
+                    "AND THAT IF T IS A SCALAR OR ACCESS TYPE, THE "   &
+                    "ALLOCATED OBJECT HAS THE VALUE OF X");
+
+     DECLARE
+
+          TYPE ATA IS ACCESS INTEGER;
+          TYPE AATA IS ACCESS ATA;
+          VA1, VA2, VA3 : ATA;
+          VAA1, VAA2, VAA3 : AATA;
+
+     BEGIN
+
+          VA1 := NEW INTEGER'(5 + 7);
+          IF VA1.ALL /= IDENT_INT(12) THEN
+               FAILED("WRONG VALUES - VA1");
+          END IF;
+
+          VA2 := NEW INTEGER'(1 + 2);
+          IF (VA1.ALL /= IDENT_INT(12) OR
+              VA2.ALL /= IDENT_INT( 3)) THEN
+               FAILED("WRONG VALUES - VA2");
+          END IF;
+
+          VA3 := NEW INTEGER'(IDENT_INT(3) + IDENT_INT(4));
+          IF (VA1.ALL /= IDENT_INT(12) OR
+              VA2.ALL /= IDENT_INT( 3) OR
+              VA3.ALL /= IDENT_INT( 7)) THEN
+               FAILED("WRONG VALUES - VA3");
+          END IF;
+
+          VAA1 := NEW ATA'(NEW INTEGER'(3));
+          IF VAA1.ALL.ALL /= IDENT_INT(3) THEN
+               FAILED ("WRONG VALUES - VAA1");
+          END IF;
+
+          VAA2 := NEW ATA'(NEW INTEGER'(IDENT_INT(5)));
+          IF (VAA1.ALL.ALL /= 3 OR
+              VAA2.ALL.ALL /= 5 ) THEN
+               FAILED ("WRONG VALUES - VAA2");
+          END IF;
+
+          VAA3 := NEW ATA'(NEW INTEGER'(IDENT_INT(6)));
+          IF (VAA1.ALL.ALL /= 3 OR
+              VAA2.ALL.ALL /= 5 OR
+              VAA3.ALL.ALL /= 6 ) THEN
+               FAILED ("WRONG VALUES - VAA3");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C48006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48006b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48006b.ada
new file mode 100644
index 000000000..001b8897c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48006b.ada
@@ -0,0 +1,236 @@
+-- C48006B.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 ALLOCATOR OF THE FORM "NEW T'(X)" ALLOCATES A NEW
+-- OBJECT EACH TIME IT IS EXECUTED AND THAT IF T IS A RECORD, ARRAY, OR
+-- PRIVATE TYPE (CONSTRAINED OR UNCONSTRAINED), THE ALLOCATED OBJECT HAS
+-- THE VALUE OF (X).
+
+-- RM  01/14/80
+-- RM  01/O1/82
+-- SPS 10/27/82
+-- EG  07/05/84
+-- JBG 11/08/85 AVOID CONFLICT WITH AI-7 OR AI-275
+
+WITH REPORT;
+
+PROCEDURE C48006B IS
+
+     USE REPORT ;
+
+BEGIN
+
+     TEST("C48006B","CHECK THAT THE FORM 'NEW T'(X)' " &
+                    "ALLOCATES A NEW OBJECT " &
+                    "AND THAT IF T IS A RECORD, ARRAY, OR PRIVATE "    &
+                    "TYPE, THE ALLOCATED OBJECT HAS THE VALUE (X)");
+
+     -- RECORD OR ARRAY TYPE (CONSTRAINED OR UNCONSTRAINED)
+
+     DECLARE
+
+          TYPE  TB0(  A , B : INTEGER )  IS
+               RECORD
+                    C : INTEGER := 7 ;
+               END RECORD;
+          SUBTYPE  TB  IS  TB0( 2 , 3 );
+          TYPE ATB  IS  ACCESS TB  ;
+          TYPE ATB0 IS  ACCESS TB0 ;
+          VB1  ,  VB2  : ATB  ;
+          VB01 , VB02  : ATB0 ;
+
+          TYPE  ARR0  IS  ARRAY( INTEGER RANGE <> ) OF INTEGER ;
+          SUBTYPE  ARR  IS ARR0( 1..4 );
+          TYPE  A_ARR   IS  ACCESS ARR  ;
+          TYPE  A_ARR0  IS  ACCESS ARR0 ;
+          VARR1  , VARR2  : A_ARR  ;
+          VARR01 , VARR02 : A_ARR0 ;
+
+     BEGIN
+
+          VB1  :=  NEW TB'( 2 , 3 , 5 );
+          IF ( VB1.A /=IDENT_INT( 2)  OR
+               VB1.B /=IDENT_INT( 3)  OR
+               VB1.C /=IDENT_INT( 5) )
+          THEN FAILED( "WRONG VALUES  -  B1 1" );
+          END IF;
+
+          VB2  :=  NEW TB'( IDENT_INT(2), IDENT_INT(3), IDENT_INT(6));
+          IF ( VB2.A /= 2  OR
+               VB2.B /= 3  OR
+               VB2.C /= 6  OR
+               VB1.A /= 2  OR
+               VB1.B /= 3  OR
+               VB1.C /= 5 )
+          THEN FAILED( "WRONG VALUES  -  B1 2" );
+          END IF;
+
+          VB01  :=  NEW TB0'( 1 , 2 , 3 );
+          IF ( VB01.A /=IDENT_INT( 1)  OR
+               VB01.B /=IDENT_INT( 2)  OR
+               VB01.C /=IDENT_INT( 3) )
+          THEN FAILED( "WRONG VALUES  -  B2 1" );
+          END IF;
+
+          VB02  :=  NEW TB0'( IDENT_INT(4) , IDENT_INT(5) ,
+                                                      IDENT_INT(6) );
+          IF ( VB02.A /=IDENT_INT( 4)  OR
+               VB02.B /=IDENT_INT( 5)  OR
+               VB02.C /=IDENT_INT( 6)  OR
+               VB01.A /=IDENT_INT( 1)  OR
+               VB01.B /=IDENT_INT( 2)  OR
+               VB01.C /=IDENT_INT( 3) )
+          THEN FAILED( "WRONG VALUES  -  B2 2" );
+          END IF;
+
+          VARR1 := NEW ARR'( 5 , 6 , 7 , 8 );
+          IF  ( VARR1(1) /=IDENT_INT( 5)  OR
+                VARR1(2) /=IDENT_INT( 6)  OR
+                VARR1(3) /=IDENT_INT( 7)  OR
+                VARR1(4) /=IDENT_INT( 8) )
+          THEN FAILED( "WRONG VALUES  -  B3 1" );
+          END IF ;
+
+          VARR2 := NEW ARR'( IDENT_INT(1) , IDENT_INT(2) , IDENT_INT(3),
+                                                         IDENT_INT(4) );
+          IF  ( VARR2(1) /= 1  OR
+                VARR2(2) /= 2  OR
+                VARR2(3) /= 3  OR
+                VARR2(4) /= 4  OR
+                VARR1(1) /= 5  OR
+                VARR1(2) /= 6  OR
+                VARR1(3) /= 7  OR
+                VARR1(4) /= 8 )
+          THEN FAILED( "WRONG VALUES  -  B3 2" );
+          END IF ;
+
+          VARR01 := NEW ARR0'( 11 , 12 , 13 );
+          IF  ( VARR01(INTEGER'FIRST) /= IDENT_INT(11)  OR
+                VARR01(INTEGER'FIRST + 1) /= IDENT_INT(12)  OR
+                VARR01(INTEGER'FIRST + 2) /= IDENT_INT(13) )
+          THEN FAILED( "WRONG VALUES -  B4 1" );
+          END IF ;
+          IF  ( VARR01.ALL'FIRST /= IDENT_INT( INTEGER'FIRST )  OR
+                VARR01.ALL'LAST  /= IDENT_INT( INTEGER'FIRST + 2 ) )
+          THEN FAILED( "WRONG VALUES -  B4 2" );
+          END IF ;
+
+          VARR02 := NEW ARR0'( 1 => IDENT_INT(14) , 2 => IDENT_INT(15));
+          IF  ( VARR02(1) /= 14  OR
+                VARR02(2) /= 15  OR
+                VARR01(INTEGER'FIRST) /= 11  OR
+                VARR01(INTEGER'FIRST + 1) /= 12  OR
+                VARR01(INTEGER'FIRST + 2) /= 13 )
+          THEN FAILED( "WRONG VALUES -  B4 3" );
+          END IF ;
+
+     END ;
+
+     -- PRIVATE TYPE (CONSTRAINED OR UNCONSTRAINED)
+
+     DECLARE
+
+          PACKAGE P IS
+               TYPE UP(A, B : INTEGER) IS PRIVATE;
+--             SUBTYPE CP IS UP(1, 2);
+--             TYPE A_CP IS ACCESS CP;
+               TYPE A_UP IS ACCESS UP;
+               CONS1_UP : CONSTANT UP;
+               CONS2_UP : CONSTANT UP;
+               CONS3_UP : CONSTANT UP;
+               CONS4_UP : CONSTANT UP;
+--             PROCEDURE CHECK1 (X : A_CP);
+--             PROCEDURE CHECK2 (X, Y : A_CP);
+               PROCEDURE CHECK3 (X : A_UP);
+               PROCEDURE CHECK4 (X, Y : A_UP);
+          PRIVATE
+               TYPE UP(A, B : INTEGER) IS
+                    RECORD
+                         C : INTEGER;
+                    END RECORD;
+               CONS1_UP : CONSTANT UP := (1, 2, 3);
+               CONS2_UP : CONSTANT UP := (IDENT_INT(1), IDENT_INT(2),
+                                          IDENT_INT(4));
+               CONS3_UP : CONSTANT UP := (7, 8, 9);
+               CONS4_UP : CONSTANT UP := (IDENT_INT(10), IDENT_INT(11),
+                                          IDENT_INT(12));
+          END P;
+
+          USE P;
+
+--        V_A_CP1, V_A_CP2 : A_CP;
+          V_A_UP1, V_A_UP2 : A_UP;
+
+          PACKAGE BODY P IS
+--             PROCEDURE CHECK1 (X : A_CP) IS
+--             BEGIN
+--                  IF (X.A /= IDENT_INT(1) OR
+--                      X.B /= IDENT_INT(2) OR
+--                      X.C /= IDENT_INT(3)) THEN
+--                       FAILED ("WRONG VALUES - CP1");
+--                  END IF;
+--             END CHECK1;
+--             PROCEDURE CHECK2 (X, Y : A_CP) IS
+--             BEGIN
+--                  IF (X.A /= 1 OR X.B /= 2 OR X.C /= 3 OR
+--                      Y.A /= 1 OR Y.B /= 2 OR Y.C /= 4) THEN
+--                       FAILED ("WRONG VALUES - CP2");
+--                  END IF;
+--             END CHECK2;
+               PROCEDURE CHECK3 (X : A_UP) IS
+               BEGIN
+                    IF (X.A /= IDENT_INT(7) OR
+                        X.B /= IDENT_INT(8) OR
+                        X.C /= IDENT_INT(9)) THEN
+                         FAILED ("WRONG VALUES - UP1");
+                    END IF;
+               END CHECK3;
+               PROCEDURE CHECK4 (X, Y : A_UP) IS
+               BEGIN
+                    IF (X.A /=  7 OR X.B /=  8 OR X.C /=  9 OR
+                        Y.A /= 10 OR Y.B /= 11 OR Y.C /= 12) THEN
+                         FAILED ("WRONG VALUES - UP2");
+                    END IF;
+               END CHECK4;
+          END P;
+
+     BEGIN
+
+--        V_A_CP1 := NEW CP'(CONS1_UP);
+--        CHECK1(V_A_CP1);
+
+--        V_A_CP2 := NEW CP'(CONS2_UP);
+--        CHECK2(V_A_CP1, V_A_CP2);
+
+          V_A_UP1 := NEW P.UP'(CONS3_UP);
+          CHECK3(V_A_UP1);
+
+          V_A_UP2 := NEW P.UP'(CONS4_UP);
+          CHECK4(V_A_UP1, V_A_UP2);
+
+     END;
+
+     RESULT;
+
+END C48006B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48007a.ada
new file mode 100644
index 000000000..7fe88b8a6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48007a.ada
@@ -0,0 +1,130 @@
+-- C48007A.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 ALLOCATORS OF THE FORM "NEW T", CHECK THAT CONSTRAINT_ERROR IS
+-- RAISED IF T IS AN UNCONSTRAINED TYPE WITH DEFAULT DISCRIMINANTS
+-- (RECORD, PRIVATE OR LIMITED) AND ONE DEFAULT DISCRIMINANT VALUE DOES
+-- NOT EQUAL THE CORRESPONDING VALUE SPECIFIED FOR THE ALLOCATOR'S BASE
+-- TYPE.
+
+-- EG  08/10/84
+
+WITH REPORT;
+
+PROCEDURE C48007A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48007A","FOR ALLOCATORS OF THE FORM 'NEW T' CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN "     &
+                    "APPROPRIATE - UNCONSTRAINED TYPE WITH "    &
+                    "DEFAULT DISCRIMINANTS");
+
+     DECLARE
+
+          TYPE UR(A : INTEGER := 1; B : INTEGER := 2) IS
+               RECORD
+                    C : INTEGER := 7;
+               END RECORD;
+
+          PACKAGE P IS
+
+               TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS
+                    PRIVATE;
+               TYPE UL(A, B : INTEGER := 4) IS LIMITED PRIVATE;
+
+          PRIVATE
+
+               TYPE UP(A : INTEGER := 12; B : INTEGER := 13) IS
+                    RECORD
+                         C : INTEGER := 8;
+                    END RECORD;
+               TYPE UL(A, B : INTEGER := 4) IS
+                    RECORD
+                         C : INTEGER := 9;
+                    END RECORD;
+
+          END P;
+
+          USE P;
+
+          TYPE A_UR IS ACCESS UR(1, 9);
+          TYPE A_UP IS ACCESS UP(9, 13);
+          TYPE A_UL IS ACCESS UL(4, 9);
+
+          VUR : A_UR;
+          VUP : A_UP;
+          VUL : A_UL;
+
+     BEGIN
+
+          BEGIN -- UR
+
+               VUR := NEW UR;
+               FAILED("NO EXCEPTION RAISED - UR");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - UR");
+
+          END;
+
+          BEGIN -- UP
+
+               VUP := NEW UP;
+               FAILED("NO EXCEPTION RAISED - UP");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - UP");
+
+          END;
+
+          BEGIN -- UL
+
+               VUL := NEW UL;
+               FAILED("NO EXCEPTION RAISED - UL");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - UL");
+
+          END;
+
+     END;
+
+     RESULT;
+
+END C48007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48007b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48007b.ada
new file mode 100644
index 000000000..117e1677e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48007b.ada
@@ -0,0 +1,133 @@
+-- C48007B.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 ALLOCATORS OF THE FORM "NEW T", CHECK THAT CONSTRAINT_ERROR IS
+-- RAISED IF T IS A CONSTRAINED TYPE WITH DISCRIMINANTS (RECORD, PRIVATE
+-- OR LIMITED) AND AT LEAST ONE DISCRIMINANT VALUE SPECIFIED FOR T DOES
+-- NOT EQUAL THE CORRESPONDING VALUE SPECIFIED FOR THE ALLOCATOR'S BASE
+-- TYPE.
+
+-- EG  08/10/84
+
+WITH REPORT;
+
+PROCEDURE C48007B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48007B","FOR ALLOCATORS OF THE FORM 'NEW T' CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN "     &
+                    "APPROPRIATE - CONSTRAINED TYPE WITH "      &
+                    "DISCRIMINANT");
+
+     DECLARE
+
+          TYPE UR(A, B : INTEGER) IS
+               RECORD
+                    C : INTEGER;
+               END RECORD;
+
+          PACKAGE P IS
+
+               TYPE UP(A, B : INTEGER) IS PRIVATE;
+               TYPE UL(A, B : INTEGER) IS LIMITED PRIVATE;
+
+          PRIVATE
+
+               TYPE UP(A, B : INTEGER) IS
+                    RECORD
+                         C : INTEGER;
+                    END RECORD;
+               TYPE UL(A, B : INTEGER) IS
+                    RECORD
+                         C : INTEGER;
+                    END RECORD;
+
+          END P;
+
+          USE P;
+
+          SUBTYPE CR IS UR(1, 2);
+          SUBTYPE CP IS UP(12, 13);
+          SUBTYPE CL IS UL(4, 4);
+
+          TYPE A_UR IS ACCESS UR(1, 9);
+          TYPE A_UP IS ACCESS UP(9, 13);
+          TYPE A_UL IS ACCESS UL(4, 9);
+
+          VUR : A_UR;
+          VUP : A_UP;
+          VUL : A_UL;
+
+     BEGIN
+
+          BEGIN -- CR
+
+               VUR := NEW CR;
+               FAILED("NO EXCEPTION RAISED - CR");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - CR");
+
+          END;
+
+          BEGIN -- CP
+
+               VUP := NEW CP;
+               FAILED("NO EXCEPTION RAISED - CP");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - CP");
+
+          END;
+
+          BEGIN -- CL
+
+               VUL := NEW CL;
+               FAILED("NO EXCEPTION RAISED - CL");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - CL");
+
+          END;
+
+     END;
+
+     RESULT;
+
+END C48007B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48007c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48007c.ada
new file mode 100644
index 000000000..fff3172d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48007c.ada
@@ -0,0 +1,162 @@
+-- C48007C.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 ALLOCATORS OF THE FORM "NEW T", CHECK THAT CONSTRAINT_ERROR IS
+-- RAISED IF T IS A CONSTRAINED ARRAY TYPE AND AT LEAST ONE INDEX BOUND
+-- FOR T DOES NOT EQUAL THE CORRESPONDING VALUE SPECIFIED FOR THE
+-- ALLOCATOR'S BASE TYPE.
+
+-- EG  08/10/84
+
+WITH REPORT;
+
+PROCEDURE C48007C IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48007C","FOR ALLOCATORS OF THE FORM 'NEW T' CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN "     &
+                    "APPROPRIATE - CONSTRAINED ARRAY TYPE");
+
+     DECLARE
+
+          TYPE UA1 IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+          TYPE UA2 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>) OF
+                         INTEGER;
+          TYPE UA3 IS ARRAY(INTEGER RANGE <>) OF UA1(1 .. 2);
+
+          SUBTYPE CA11 IS UA1(1 .. 3);
+          SUBTYPE CA12 IS UA1(3 .. 2);
+          SUBTYPE CA21 IS UA2(1 .. 2, 1 .. 2);
+          SUBTYPE CA22 IS UA2(1 .. 2, 2 .. 0);
+          SUBTYPE CA31 IS UA3(1 .. 2);
+          SUBTYPE CA32 IS UA3(4 .. 1);
+
+          TYPE A_UA11 IS ACCESS UA1(2 .. 4);
+          TYPE A_UA12 IS ACCESS UA1(4 .. 3);
+          TYPE A_UA21 IS ACCESS UA2(1 .. 3, 1 .. 2);
+          TYPE A_UA22 IS ACCESS UA2(1 .. 2, 2 .. 1);
+          TYPE A_UA31 IS ACCESS UA3(1 .. 3);
+          TYPE A_UA32 IS ACCESS UA3(3 .. 1);
+
+          V11 : A_UA11;
+          V12 : A_UA12;
+          V21 : A_UA21;
+          V22 : A_UA22;
+          V31 : A_UA31;
+          V32 : A_UA32;
+
+     BEGIN
+
+          BEGIN -- V11
+
+               V11 := NEW CA11;
+               FAILED("NO EXCEPTION RAISED - V11");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - V11");
+
+          END;
+
+          BEGIN -- V12
+
+               V12 := NEW CA12;
+               FAILED("NO EXCEPTION RAISED - V12");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - V12");
+
+          END;
+
+          BEGIN -- V21
+
+               V21 := NEW CA21;
+               FAILED("NO EXCEPTION RAISED - V21");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - V21");
+
+          END;
+
+          BEGIN -- V22
+
+               V22 := NEW CA22;
+               FAILED("NO EXCEPTION RAISED - V22");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - V22");
+
+          END;
+
+          BEGIN -- V31
+
+               V31 := NEW CA31;
+               FAILED("NO EXCEPTION RAISED - V31");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - V31");
+
+          END;
+
+          BEGIN -- V32
+
+               V32 := NEW CA32;
+               FAILED("NO EXCEPTION RAISED - V32");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED - V32");
+
+          END;
+
+     END;
+
+     RESULT;
+
+END C48007C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48008a.ada
new file mode 100644
index 000000000..19e87aafa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48008a.ada
@@ -0,0 +1,345 @@
+-- C48008A.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 ALLOCATORS OF THE FORM "NEW T X", CHECK THAT CONSTRAINT_ERROR IS
+-- RAISED IF T IS AN UNCONSTRAINED RECORD, PRIVATE, OR LIMITED TYPE, X
+-- IS A DISCRIMINANT CONSTRAINT, AND
+--   1) ONE OF THE VALUES OF X IS OUTSIDE THE RANGE OF THE CORRESPONDING
+--      DISCRIMINANT;
+--   2) ONE OF THE DISCRIMINANT VALUES IS NOT COMPATIBLE WITH A
+--      CONSTRAINT OF A SUBCOMPONENT IN WHICH IT IS USED;
+--   3) ONE OF THE DISCRIMINANT VALUES DOES NOT EQUAL THE CORRESPONDING
+--      VALUE OF THE ALLOCATOR'S BASE TYPE;
+--   4) A DEFAULT INITIALIZATION RAISES AN EXCEPTION.
+
+-- RM  01/08/80
+-- NL  10/13/81
+-- SPS 10/26/82
+-- JBG 03/02/83
+-- EG  07/05/84
+-- PWB 02/05/86  CORRECTED TEST ERROR:
+--               CHANGED "FAILED" TO "COMMENT" IN PROCEDURE INCR_CHECK,
+--               SO AS NOT TO PROHIBIT EVAL OF DEFLT EXPR (AI-00397/01)
+--               ADDED COMMENTS FOR CASES.
+
+WITH REPORT;
+
+PROCEDURE  C48008A  IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST( "C48008A" , "FOR ALLOCATORS OF THE FORM 'NEW T X', " &
+                       "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                       "APPROPRIATE - UNCONSTRAINED RECORD AND " &
+                       "PRIVATE TYPES");
+
+     DECLARE
+
+          DISC_FLAG : BOOLEAN := FALSE;
+          INCR_VAL : INTEGER;
+          FUNCTION INCR(A : INTEGER) RETURN INTEGER;
+
+          SUBTYPE I1_7 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(7);
+          SUBTYPE I1_10 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(10);
+          SUBTYPE I2_9 IS INTEGER RANGE IDENT_INT(2)..IDENT_INT(9);
+
+          TYPE REC (A : I2_9) IS
+               RECORD
+                    B : INTEGER := INCR(2);
+               END RECORD;
+
+          TYPE ARR IS ARRAY (I2_9 RANGE <>) OF INTEGER;
+
+          TYPE T_REC (C : I1_10) IS
+               RECORD
+                    D : REC(C);
+               END RECORD;
+
+          TYPE T_ARR (C : I1_10) IS
+               RECORD
+                    D : ARR(2..C);
+                    E : ARR(C..9);
+               END RECORD;
+
+          TYPE T_REC_REC (A : I1_10) IS
+               RECORD
+                    B : T_REC(A);
+               END RECORD;
+
+          TYPE T_REC_ARR (A : I1_10) IS
+               RECORD
+                    B : T_ARR(A);
+               END RECORD;
+
+          TYPE  TB (  A : I1_7 )  IS
+               RECORD
+                    R : INTEGER := INCR(1);
+               END RECORD;
+
+          TYPE UR (A : INTEGER) IS
+               RECORD
+                    B : I2_9 := INCR(1);
+               END RECORD;
+
+          TYPE A_T_REC_REC IS ACCESS T_REC_REC;
+          TYPE A_T_REC_ARR IS ACCESS T_REC_ARR;
+          TYPE ATB IS ACCESS TB;
+          TYPE ACTB IS ACCESS TB(3);
+          TYPE A_UR IS ACCESS UR;
+
+          VA_T_REC_REC : A_T_REC_REC;
+          VA_T_REC_ARR : A_T_REC_ARR;
+          VB  : ATB;
+          VCB : ACTB;
+          V_A_UR : A_UR;
+
+          BOOL : BOOLEAN;
+
+          FUNCTION DISC (A : INTEGER) RETURN INTEGER;
+
+
+          PACKAGE  P  IS
+               TYPE  PRIV( A : I1_10 := DISC(8) )  IS PRIVATE;
+               CONS_PRIV : CONSTANT PRIV;
+          PRIVATE
+               TYPE  PRIV( A : I1_10 := DISC(8) )  IS
+                    RECORD
+                         R : INTEGER := INCR(1);
+                    END RECORD;
+               CONS_PRIV : CONSTANT PRIV := (2, 3);
+          END P;
+
+          TYPE  A_PRIV  IS  ACCESS P.PRIV;
+          TYPE  A_CPRIV IS  ACCESS P.PRIV (3);
+
+          VP  : A_PRIV;
+          VCP : A_CPRIV;
+
+          PROCEDURE PREC_REC (X : A_T_REC_REC) IS
+          BEGIN
+               NULL;
+          END PREC_REC;
+
+          PROCEDURE PREC_ARR (X : A_T_REC_ARR) IS
+          BEGIN
+               NULL;
+          END PREC_ARR;
+
+          PROCEDURE PB (X : ATB) IS
+          BEGIN
+               NULL;
+          END PB;
+
+          PROCEDURE PCB (X : ACTB) IS
+          BEGIN
+               NULL;
+          END PCB;
+
+          PROCEDURE PPRIV (X : A_PRIV) IS
+          BEGIN
+               NULL;
+          END PPRIV;
+
+          PROCEDURE PCPRIV (X : A_CPRIV) IS
+          BEGIN
+               NULL;
+          END PCPRIV;
+
+          FUNCTION DISC (A : INTEGER) RETURN INTEGER IS
+          BEGIN
+               DISC_FLAG := TRUE;
+               RETURN A;
+          END DISC;
+
+          FUNCTION INCR(A : INTEGER) RETURN INTEGER IS
+          BEGIN
+               INCR_VAL := IDENT_INT(INCR_VAL+1);
+               RETURN A;
+          END INCR;
+
+          PROCEDURE INCR_CHECK(CASE_ID : STRING) IS
+          BEGIN
+               IF INCR_VAL /= IDENT_INT(0) THEN
+                    COMMENT ("DEFAULT INITIAL VALUE WAS EVALUATED - " &
+                             "CASE " & CASE_ID);
+               END IF;
+          END INCR_CHECK;
+
+     BEGIN
+
+          BEGIN  -- A1A: 0 ILLEGAL FOR TB.A.
+               INCR_VAL := 0;
+               VB  :=  NEW TB (A => 0);
+               FAILED ("NO EXCEPTION RAISED - CASE A1A");
+          EXCEPTION
+               WHEN  CONSTRAINT_ERROR  =>
+                    INCR_CHECK("A1A");
+               WHEN  OTHERS            =>
+                    FAILED( "WRONG EXCEPTION RAISED - CASE A1A" );
+          END;   -- A1A
+
+          BEGIN  -- A1B: 8 ILLEGAL IN I1_7.
+               INCR_VAL := 0;
+               VB  :=  NEW TB (A => I1_7'(IDENT_INT(8)));
+               FAILED ("NO EXCEPTION RAISED - CASE A1B");
+          EXCEPTION
+               WHEN  CONSTRAINT_ERROR  =>
+                    INCR_CHECK("A1B");
+               WHEN  OTHERS            =>
+                    FAILED( "WRONG EXCEPTION RAISED - CASE A1B");
+          END;   -- A1B
+
+          BEGIN  -- A1C: 8 ILLEGAL FOR TB.A.
+               INCR_VAL := 0;
+               PB(NEW TB (A => 8));
+               FAILED ("NO EXCEPTION RAISED - CASE A1C");
+          EXCEPTION
+               WHEN  CONSTRAINT_ERROR  =>
+                    INCR_CHECK("A1C");
+               WHEN  OTHERS            =>
+                    FAILED( "WRONG EXCEPTION RAISED - CASE A1C");
+          END;   --A1C
+
+          BEGIN  --A1D: 0 ILLEGAL FOR TB.A.
+               INCR_VAL := 0;
+               BOOL := ATB'(NEW TB(A => 0)) = NULL;
+               FAILED ("NO EXCEPTION RAISED - CASE A1D");
+          EXCEPTION
+               WHEN  CONSTRAINT_ERROR  =>
+                    INCR_CHECK("A1D");
+               WHEN  OTHERS            =>
+                    FAILED( "WRONG EXCEPTION RAISED - CASE A1D");
+          END;   --A1D
+
+          BEGIN  --A1E: 11 ILLEGAL FOR PRIV.A.
+               DISC_FLAG := FALSE;
+               INCR_VAL := 0;
+               VP := NEW P.PRIV(11);
+               FAILED("NO EXCEPTION RAISED - CASE A1E");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF DISC_FLAG THEN
+                         FAILED ("DISCR DEFAULT EVALUATED WHEN " &
+                                 "EXPLICIT VALUE WAS PROVIDED - A1E");
+                    END IF;
+                    INCR_CHECK("A1E");
+               WHEN OTHERS           =>
+                    FAILED("WRONG EXCEPTION RAISED - CASE A1E");
+          END;   -- A1E
+
+          BEGIN  -- A2A: 1 ILLEGAL FOR REC.A.
+               INCR_VAL := 0;
+               VA_T_REC_REC := NEW T_REC_REC(A => I1_10'(IDENT_INT(1)));
+               FAILED ("NO EXCEPTION RAISED - CASE A2A");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    INCR_CHECK("A2A");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE A2A");
+          END;   -- A2A
+
+          BEGIN  --A2B: 10 ILLEGAL FOR REC.A.
+               INCR_VAL := 0;
+               VA_T_REC_REC := NEW T_REC_REC (10);
+               FAILED ("NO EXCEPTION RAISED - CASE A2B");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    INCR_CHECK("A2B");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE A2B");
+          END;   -- A2B
+
+          BEGIN  -- A2C: 1 ILLEGAL FOR T.ARR.E'FIRST.
+               INCR_VAL := 0;
+               PREC_ARR (NEW T_REC_ARR (1));
+               FAILED ("NO EXCEPTION RAISED - CASE A2C");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    INCR_CHECK ("A2C");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE A2C");
+          END;   -- A2C
+
+          BEGIN  -- A2D: 10 ILLEGAL FOR T_ARR.D'LAST.
+               INCR_VAL := 0;
+               BOOL := NEW T_REC_ARR (IDENT_INT(10)) = NULL;
+               FAILED ("NO EXCEPTION RAISED - CASE A2D");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    INCR_CHECK ("A2D");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE A2D");
+          END;   -- A2D
+
+          BEGIN -- A3A: ASSIGNMENT VIOLATES CONSTRAINT ON VCB'S SUBTYPE.
+               INCR_VAL := 0;
+               VCB := NEW TB (4);
+               FAILED ("NO EXCEPTION RAISED - CASE A3A");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    INCR_CHECK("A3A");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE A3A");
+          END;   -- A3A
+
+          BEGIN  -- A3B: PARM ASSOC VIOLATES CONSTRAINT ON PARM SUBTYPE.
+               INCR_VAL := 0;
+               PCB (NEW TB (4));
+               FAILED ("NO EXCEPTION RAISED - CASE A3B");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    INCR_CHECK("A3B");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE A3B");
+          END;   -- A3B
+
+          BEGIN  -- A3C: 2 VIOLATES CONSTRAINT ON SUBTYPE ACTB.
+               INCR_VAL := 0;
+               BOOL := ACTB'(NEW TB (IDENT_INT(2))) = NULL;
+               FAILED ("NO EXCEPTION RAISED - CASE A3C");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    INCR_CHECK("A3C");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE A3C");
+          END;   -- A3C
+
+          BEGIN  -- A4A: EVALUATION OF DEFAULT RAISES EXCEPTION.
+               INCR_VAL := 0;
+               V_A_UR := NEW UR(4);
+               FAILED ("NO EXCEPTION RAISED - CASE A4A");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE A4A");
+          END;   -- A4A
+
+     END;
+
+     RESULT;
+
+END C48008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48008c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48008c.ada
new file mode 100644
index 000000000..39f564d57
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48008c.ada
@@ -0,0 +1,79 @@
+-- C48008C.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 ALLOCATORS OF THE FORM "NEW T X", CHECK THAT CONSTRAINT_ERROR IS
+-- RAISED IF T IS AN UNCONSTRAINED ARRAY TYPE WITH INDEX SUBTYPE(S) S, X
+-- IS AN INDEX CONSTRAINT, AND THE BOUNDS OF X ARE NOT COMPATIBLE WITH
+-- AN INDEX SUBTYPE OF T.
+
+-- RM 01/08/80
+-- NL 10/13/81
+-- EG 07/05/84
+
+WITH REPORT;
+
+PROCEDURE C48008C IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48008C","FOR ALLOCATORS OF THE FORM 'NEW T X', CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                    "APPROPRIATE - UNCONSTRAINED ARRAY TYPE");
+
+     DECLARE
+
+          SUBTYPE  TWO  IS  INTEGER RANGE 1..2;
+          TYPE  TF IS ARRAY( TWO RANGE <> ,  TWO RANGE <> ) OF INTEGER;
+          TYPE  ATF  IS  ACCESS TF;
+          VF  : ATF;
+
+     BEGIN
+
+          BEGIN
+               VF  :=  NEW TF ( 0..1 , 1..2 );
+               FAILED ("NO EXCEPTION RAISED - CASE 1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>  
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 1");
+          END;
+
+          BEGIN
+               VF := NEW TF(1 .. 2, 2 .. IDENT_INT(3));
+               FAILED ("NO EXCEPTION RAISED - CASE 2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 2");
+          END;
+
+     END;
+
+     RESULT;
+
+END C48008C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009a.ada
new file mode 100644
index 000000000..fa0d4075a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009a.ada
@@ -0,0 +1,104 @@
+-- C48009A.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 ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+-- IS RAISED IF T IS A SCALAR SUBTYPE AND X IS OUTSIDE THE RANGE OF T,
+-- OR IS WITHIN T'S RANGE AND OUTSIDE OF THE RANGE OF VALUES PERMITTED
+-- FOR OBJECTS DESIGNATED BY VALUES OF THE ALLOCATOR'S BASE TYPE.
+
+-- RM  01/08/80
+-- NL  10/13/81
+-- SPS 10/26/82
+-- JBG 03/02/83
+-- EG  07/05/84
+-- EDS 12/01/97  ADDED IDENT_INT TO MAKE EXPRESSION NON-STATIC.
+
+WITH REPORT;
+
+PROCEDURE  C48009A  IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST( "C48009A" , "FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK" &
+                       " THAT CONSTRAINT_ERROR IS RAISED WHEN" &
+                       " APPROPRIATE - SCALAR TYPES");
+     DECLARE        -- A1
+
+          SUBTYPE  TA  IS  INTEGER RANGE 1..7;
+          TYPE ATA IS ACCESS TA;
+          VA : ATA;
+
+     BEGIN
+
+          VA  :=  NEW TA'( IDENT_INT(0) );
+          FAILED ("NO EXCEPTION RAISED - 1");
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR  =>  NULL;
+          WHEN  OTHERS      =>  FAILED ( "WRONG EXCEPTION RAISED - 1" );
+
+     END;  -- A1
+
+     DECLARE        -- A2
+
+          SUBTYPE T1_7 IS INTEGER RANGE 1..7;
+          TYPE AT2_6 IS ACCESS INTEGER RANGE 2..6;
+          VAT2_6 : AT2_6;
+
+     BEGIN
+
+          BEGIN
+
+               VAT2_6 := NEW T1_7'(1);
+               FAILED ("NO EXCEPTION RAISED - 2");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => 
+                    FAILED ("WRONG EXCEPTION RAISED - 2");
+
+          END;
+
+          BEGIN
+
+               VAT2_6 := NEW T1_7'(7);
+               FAILED ("NO EXCEPTION RAISED - 3");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 3");
+
+          END;
+
+     END; -- A2
+
+     RESULT;
+
+END C48009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009b.ada
new file mode 100644
index 000000000..d74d90249
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009b.ada
@@ -0,0 +1,255 @@
+-- C48009B.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 ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+-- IS RAISED IF T IS AN UNCONSTRAINED RECORD OR PRIVATE TYPE, (X) IS AN
+-- AGGREGATE OR A VALUE OF TYPE T, AND ONE OF THE DISCRIMINANT VALUES IN
+-- X:
+--   1) DOES NOT SATISFY THE RANGE CONSTRAINT FOR THE CORRESPONDING
+--      DISCRIMINANT OF T.
+--   2) DOES NOT EQUAL THE DISCRIMINANT VALUE SPECIFIED IN THE
+--      DECLARATION OF THE ALLOCATOR'S BASE TYPE.
+--   3) A DISCRIMINANT VALUE IS COMPATIBLE WITH A DISCRIMINANT'S SUBTYPE
+--      BUT DOES NOT PROVIDE A COMPATIBLE INDEX OR DISCRIMINANT
+--      CONSTRAINT FOR A SUBCOMPONENT DEPENDENT ON THE DISCRIMINANT.
+
+-- RM  01/08/80
+-- NL  10/13/81
+-- SPS 10/26/82
+-- JBG 03/02/83
+-- EG  07/05/84
+
+WITH REPORT;
+
+PROCEDURE  C48009B  IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST( "C48009B" , "FOR ALLOCATORS OF THE FORM 'NEW T '(X)', " &
+                       "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                       "APPROPRIATE - UNCONSTRAINED RECORD AND " &
+                       "PRIVATE TYPES");
+
+     DECLARE
+
+          SUBTYPE I1_7 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(7);
+          SUBTYPE I1_10 IS INTEGER RANGE IDENT_INT(1)..IDENT_INT(10);
+          SUBTYPE I2_9 IS INTEGER RANGE IDENT_INT(2)..IDENT_INT(9);
+
+          TYPE REC (A : I2_9) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE ARR IS ARRAY (I2_9 RANGE <>) OF INTEGER;
+
+          TYPE T_REC (C : I1_10) IS
+               RECORD
+                    D : REC(C);
+               END RECORD;
+
+          TYPE T_ARR (C : I1_10) IS
+               RECORD
+                    D : ARR(2..C);
+                    E : ARR(C..9);
+               END RECORD;
+
+          TYPE T_REC_REC (A : I1_10) IS
+               RECORD
+                    B : T_REC(A);
+               END RECORD;
+
+          TYPE T_REC_ARR (A : I1_10) IS
+               RECORD
+                    B : T_ARR(A);
+               END RECORD;
+
+          TYPE  TB (  A : I1_7 )  IS
+               RECORD
+                    R : INTEGER;
+               END RECORD;
+
+          TYPE A_T_REC_REC IS ACCESS T_REC_REC;
+          TYPE A_T_REC_ARR IS ACCESS T_REC_ARR;
+          TYPE ATB IS ACCESS TB;
+          TYPE ACTB IS ACCESS TB(3);
+
+          VA_T_REC_REC : A_T_REC_REC;
+          VA_T_REC_ARR : A_T_REC_ARR;
+          VB  : ATB;
+          VCB : ACTB;
+
+          PACKAGE  P  IS
+               TYPE  PRIV( A : I1_10 )  IS PRIVATE;
+               CONS_PRIV : CONSTANT PRIV;
+          PRIVATE
+               TYPE  PRIV( A : I1_10 )  IS
+                    RECORD
+                         R : INTEGER;
+                    END RECORD;
+               CONS_PRIV : CONSTANT PRIV := (2, 3);
+          END P;
+
+          USE P;
+
+          TYPE  A_PRIV  IS  ACCESS P.PRIV;
+          TYPE  A_CPRIV IS  ACCESS P.PRIV (3);
+     
+          VP  : A_PRIV;
+          VCP : A_CPRIV;
+
+          FUNCTION ALLOC1(X : P.PRIV) RETURN A_CPRIV IS
+          BEGIN
+               IF EQUAL(1, 1) THEN
+                    RETURN NEW P.PRIV'(X);
+               ELSE
+                    RETURN NULL;
+               END IF;
+          END ALLOC1;
+          FUNCTION ALLOC2(X : TB) RETURN ACTB IS
+          BEGIN
+               IF EQUAL(1, 1) THEN
+                    RETURN NEW TB'(X);
+               ELSE
+                    RETURN NULL;
+               END IF;
+          END ALLOC2;
+
+     BEGIN
+
+          BEGIN     -- B1
+               VB  :=  NEW TB'(A => IDENT_INT(0), R => 1);
+               FAILED ("NO EXCEPTION RAISED - CASE 1A");
+          EXCEPTION
+               WHEN  CONSTRAINT_ERROR  =>  NULL;
+               WHEN  OTHERS            =>
+                    FAILED( "WRONG EXCEPTION RAISED - CASE 1A" );
+          END;
+
+          BEGIN     
+               VB  :=  NEW TB'(A => 8, R => 1);
+               FAILED ("NO EXCEPTION RAISED - CASE 1B");
+          EXCEPTION
+               WHEN  CONSTRAINT_ERROR  =>  NULL;
+               WHEN  OTHERS            =>
+                    FAILED( "WRONG EXCEPTION RAISED - CASE 1B");
+          END; -- B1
+
+          BEGIN     -- B2
+               VCB := NEW TB'(2, 3);
+               FAILED ("NO EXCEPTION RAISED - CASE 2A");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 2A");
+          END;
+
+          BEGIN
+               IF ALLOC2((IDENT_INT(4), 3)) = NULL THEN
+                    FAILED ("IMPOSSIBLE - CASE 2B");
+               END IF;
+               FAILED ("NO EXCEPTION RAISED - CASE 2B");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 2B");
+          END;
+
+          BEGIN
+
+               IF ALLOC1(CONS_PRIV) = NULL THEN
+                    FAILED ("IMPOSSIBLE - CASE 2C");
+               END IF;
+               FAILED ("NO EXCEPTION RAISED - CASE 2C");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 2C");
+
+          END; -- B2
+
+          BEGIN     -- B3
+
+               VA_T_REC_REC := NEW T_REC_REC'(1, (1, (A => 1)));
+               FAILED ("NO EXCEPTION RAISED - CASE 3A");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 3A");
+
+          END;
+
+          BEGIN
+
+               VA_T_REC_REC := NEW T_REC_REC'(10, 
+                                             (10, (A => 10)));
+               FAILED ("NO EXCEPTION RAISED - CASE 3B");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 3B");
+
+          END;
+
+          BEGIN
+
+               VA_T_REC_ARR := NEW T_REC_ARR'(1, (1, (OTHERS => 1),
+                                                     (OTHERS => 2)));
+               FAILED ("NO EXCEPTION RAISED - CASE 3C");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 3C");
+
+          END;
+
+          BEGIN
+
+               VA_T_REC_ARR := NEW T_REC_ARR'(10, (10, (OTHERS => 1),
+                                                       (OTHERS => 2)));
+               FAILED ("NO EXCEPTION RAISED - CASE 3D");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 3D");
+
+          END;
+
+     END;
+
+     RESULT;
+
+END C48009B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009c.ada
new file mode 100644
index 000000000..80d18f342
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009c.ada
@@ -0,0 +1,113 @@
+-- C48009C.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 ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+-- IS RAISED IF T IS A CONSTRAINED RECORD OR PRIVATE TYPE, (X) IS AN
+-- AGGREGATE OR A VALUE OF TYPE T, AND ONE OF THE DISCRIMINANT VALUES IN
+-- X:
+--   1) DOES NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE FOR T.
+--   2) DOES NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE SPECIFIED
+--      IN THE DECLARATION OF THE ALLOCATOR'S BASE TYPE.
+--   3) DOES NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE IN THE
+--      ACCESS TO ACCESS CASE.
+
+-- RM  01/08/80
+-- NL  10/13/81
+-- SPS 10/26/82
+-- EG  07/05/84
+
+WITH REPORT;
+
+PROCEDURE C48009C IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48009C","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
+                    "APPROPRIATE - CONSTRAINED RECORD TYPES");
+
+     DECLARE
+
+          TYPE TC0(A, B : INTEGER) IS
+               RECORD
+                    C : INTEGER RANGE 1 .. 7;
+               END RECORD;
+          SUBTYPE TC IS TC0(2, 3);
+          TYPE ATC IS ACCESS TC0(2, 3);
+          SUBTYPE TC4_5 IS TC0(IDENT_INT(4), IDENT_INT(5));
+          VC : ATC;
+
+     BEGIN
+
+          BEGIN
+               VC := NEW TC'(102, 3, 4);
+               FAILED ("NO EXCEPTION RAISED - CASE 1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS           =>  
+                    FAILED("WRONG EXCEPTION RAISED - CASE 1");
+          END;
+
+          BEGIN
+               VC := NEW TC4_5'(IDENT_INT(4), IDENT_INT(5), 1);
+               FAILED ("NO EXCEPTION RAISED - CASE 2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS           =>  
+                    FAILED("WRONG EXCEPTION RAISED - CASE 2");
+          END;
+
+     END;
+
+     DECLARE
+
+          TYPE UR(A : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+          TYPE A_UR IS ACCESS UR;
+          SUBTYPE CA_UR IS A_UR(2);
+          TYPE A_CA_UR IS ACCESS CA_UR;
+
+          V : A_CA_UR;
+
+     BEGIN
+
+          V := NEW CA_UR'(NEW UR'(A => IDENT_INT(3)));
+          FAILED ("NO EXCEPTION RAISED - CASE 3");
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - CASE 3");
+
+     END;
+
+     RESULT;
+
+END C48009C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009d.ada
new file mode 100644
index 000000000..0c5d3d647
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009d.ada
@@ -0,0 +1,128 @@
+-- C48009D.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 ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+-- IS RAISED IF T IS AN UNCONSTRAINED ARRAY TYPE WITH INDEX SUBTYPE(S)
+-- S,
+--   1) X HAS TOO MANY VALUES FOR S;
+--   2) A NAMED NON-NULL BOUND OF X LIES OUTSIDE S'S RANGE;
+--   3) THE BOUND'S OF X ARE NOT EQUAL TO BOUNDS SPECIFIED FOR THE
+--      ALLOCATOR'S DESIGNATED BASE TYPE. (THEY ARE EQUAL TO THE BOUNDS
+--      SPECIFIED FOR T).
+
+-- RM  01/08/80
+-- NL  10/13/81
+-- SPS 10/26/82
+-- JBG 03/03/83
+-- EG  07/05/84
+-- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
+-- KAS 11/14/95 FOR SLIDING ASSIGNMENT, CHANGED FAIL TO COMMENT ON LANGUAGE
+-- KAS 12/02/95 INCLUDED SECOND CASE
+-- PWN 05/03/96 Enforced Ada 95 sliding rules
+
+WITH REPORT;
+
+PROCEDURE  C48009D  IS
+
+     USE REPORT ;
+
+BEGIN
+
+     TEST("C48009D","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
+                    "APPROPRIATE - UNCONSTRAINED ARRAY TYPES");
+     DECLARE
+
+          SUBTYPE TWO  IS INTEGER RANGE 1 .. 2;
+          SUBTYPE TWON IS INTEGER RANGE IDENT_INT(1) .. IDENT_INT(2);
+          TYPE UA  IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+          TYPE TD  IS ARRAY(TWO  RANGE <>) OF INTEGER RANGE 1 .. 7;
+          TYPE TDN IS ARRAY(TWON RANGE <>) OF INTEGER RANGE 1 .. 7;
+          TYPE ATD  IS ACCESS TD;
+          TYPE ATDN IS ACCESS TDN;
+          TYPE A_UA IS ACCESS UA;
+          TYPE A_CA IS ACCESS UA(3 .. 4);
+          TYPE A_CAN IS ACCESS UA(4 .. 3);
+          VD  : ATD;
+          VDN : ATDN;
+          V_A_CA : A_CA;
+          V_A_CAN : A_CAN;
+
+     BEGIN
+
+          BEGIN
+               VD := NEW TD'(3, 4, 5);
+               FAILED ("NO EXCEPTION RAISED - CASE 1A");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>  
+                    NULL;
+               WHEN OTHERS =>  
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 1A");
+          END;
+
+          BEGIN
+               VDN := NEW TDN'(3, 4, 5);
+               FAILED ("NO EXCEPTION RAISED - CASE 1B");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 1B");
+          END;
+
+          BEGIN
+               VD := NEW TD'(IDENT_INT(0) .. 2 => 6);
+               FAILED ("NO EXCEPTION RAISED - CASE 2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    NULL;
+               WHEN OTHERS =>  
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 2");
+          END;
+
+          BEGIN
+               V_A_CA := NEW UA'(2 .. 3 => 3);
+               COMMENT ("ADA 95 SLIDING ASSIGNMENT - CASE 3A");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("ADA 83 NON SLIDING ASSIGNMENT - CASE 3A");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 3A");
+          END;
+
+          BEGIN
+               V_A_CAN := NEW UA'(IDENT_INT(3) .. IDENT_INT(2) => 3);
+               COMMENT ("ADA 95 SLIDING ASSIGNMENT - CASE 3B");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("ADA 83 NON SLIDING ASSIGNMENT - CASE 3B");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 3B");
+          END;
+
+     END;
+
+     RESULT;
+
+END C48009D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009e.ada
new file mode 100644
index 000000000..e27319249
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009e.ada
@@ -0,0 +1,224 @@
+-- C48009E.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 ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+-- IS RAISED IF T IS A CONSTRAINED ARRAY TYPE AND:
+--   1) A NAMED NULL OR NON-NULL BOUND FOR X DOES NOT EQUAL THE
+--      CORRESPONDING BOUND FOR T;
+--   2) A BOUND OF T DOES NOT EQUAL THE CORRESPONDING VALUE SPECIFIED IN
+--      THE DECLARATION OF THE ALLOCATOR'S BASE TYPE; 
+--   3) A POSITIONAL AGGREGATE DOES NOT HAVE THE NUMBER OF COMPONENTS
+--      REQUIRED BY T OR BY THE ALLOCATOR'S BASE TYPE. 
+ 
+ -- RM  01/08/80
+ -- NL  10/13/81
+ -- SPS 10/26/82
+ -- JBG 03/03/83
+ -- EG  07/05/84
+ -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
+ -- KAS 11/14/95 CHANGED FAILURE AT SLIDING ASSIGNMENT TO COMMENT ON LANGUAGE
+ -- KAS 11/30/95 REINSTRUMENTED CASES TO SELECT LANGUAGE SEMANTICS
+ -- PWN 05/03/96 Enforced Ada 95 sliding rules
+ -- PWN 10/24/96 Adjusted expected results for Ada 95.
+ -- TMB 11/19/96 BACKED OUT CHANGE FOR SLIDING WITH ACCESS TYPES
+ -- MRM 12/16/96 Removed problem code from withdrawn version of test, and
+ --              implemented a dereference-index check to ensure Ada95
+ --              required behavior.
+ -- PWB.CTA 03/07/97 Restored checks from 1.11 in 2 cases where sliding does
+ --                  not occur 
+ WITH REPORT;
+ 
+ PROCEDURE  C48009E  IS
+ 
+      USE REPORT ;
+ 
+ BEGIN
+ 
+      TEST("C48009E","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                     "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
+                     "APPROPRIATE - CONSTRAINED ARRAY TYPES");
+      DECLARE
+ 
+           TYPE UA IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+           TYPE CA3_2 IS ARRAY(3 .. 2) OF INTEGER;
+           TYPE SA1_3 IS ARRAY(1 .. 3) OF INTEGER;
+           TYPE NA1_3 IS ARRAY(1 .. IDENT_INT(3)) OF INTEGER;
+           SUBTYPE CA2_6 IS UA(2 .. 6);
+           SUBTYPE CA1_4 IS UA(1 .. 4);
+           SUBTYPE CA1_6 IS UA(1 .. 6);
+           SUBTYPE CA4_1 IS UA(4 .. 1);
+           SUBTYPE CA4_2 IS UA(4 .. 2);
+ 
+           TYPE A_CA3_2 IS ACCESS CA3_2;
+           TYPE A_SA1_3 IS ACCESS SA1_3;
+           TYPE A_NA1_3 IS ACCESS NA1_3;
+           TYPE A_CA1_5 IS ACCESS UA(1 .. 5);
+           TYPE A_CA4_2 IS ACCESS CA4_2;
+ 
+           V_A_CA3_2 : A_CA3_2;
+           V_A_SA1_3 : A_SA1_3;
+           V_A_NA1_3 : A_NA1_3;
+           V_A_CA1_5 : A_CA1_5;
+ 
+           FUNCTION ALLOC1(X : CA2_6) RETURN A_CA1_5 IS
+           BEGIN
+                IF EQUAL(1, 1) THEN
+                     RETURN NEW CA2_6'(X);
+                ELSE
+                     RETURN NULL;
+                END IF;
+           END ALLOC1;
+           FUNCTION ALLOC2(X : CA4_1) RETURN A_CA4_2 IS
+           BEGIN
+                IF EQUAL(1, 1) THEN
+                     RETURN NEW CA4_1'(X);
+                ELSE
+                     RETURN NULL;
+                END IF;
+           END ALLOC2;
+ 
+      BEGIN
+ 
+          BEGIN
+               V_A_CA3_2 := NEW CA3_2'(IDENT_INT(4) .. IDENT_INT(2)
+                                       => 5);
+               FAILED ("NO EXCEPTION RAISED - CASE 1A");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 1A");
+          END;
+ 
+           BEGIN
+                V_A_NA1_3 := NEW NA1_3'(1 .. IDENT_INT(2) => 4);
+                FAILED ("NO EXCEPTION RAISED - CASE 1B");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 1B");
+           END;
+ 
+           BEGIN
+                -- note that ALLOC1 returns A_CA1_5, so both
+                -- (1) and (5) are valid index references!
+                IF ALLOC1((2 .. 6 => 2))(5) /= 2 THEN
+                     FAILED ("Wrong Value Returned - CASE 2A");
+                ELSIF ALLOC1((2 .. 6 => 3))(1) /= 3 THEN
+                     FAILED ("Unlikely Index Case - CASE 2A");
+                END IF;
+           EXCEPTION
+                WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED - CASE 2A");
+           END;
+ 
+           BEGIN
+                IF ALLOC2((4 .. 1 => 3)) = NULL THEN
+                     FAILED ("IMPOSSIBLE - CASE 2B");
+                END IF;
+                COMMENT ("ADA 95 SLIDING ASSIGNMENT");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     FAILED ("ADA 83 NON-SLIDING ASSIGNMENT");
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 2B");
+           END;
+ 
+           BEGIN
+                V_A_SA1_3 := NEW SA1_3'(1, 2);
+                FAILED ("NO EXCEPTION RAISED - CASE 3A");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>  
+                     NULL;
+                WHEN OTHERS =>  
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3A");
+           END;
+ 
+           BEGIN
+                V_A_SA1_3 := NEW SA1_3'(3, 4, 5, 6);
+                FAILED ("NO EXCEPTION RAISED - CASE 3B");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>  
+                     NULL;
+                WHEN OTHERS =>  
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3B");
+           END;
+ 
+           BEGIN
+                V_A_NA1_3 := NEW NA1_3'(1, 2);
+                FAILED ("NO EXCEPTION RAISED - CASE 3C");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>  
+                     NULL;
+                WHEN OTHERS =>  
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3C");
+           END;
+ 
+           BEGIN -- SATISFIES T BUT NOT BASE TYPE.
+                V_A_CA1_5 := NEW CA1_4'(1, 2, 3, 4);
+                FAILED ("NO EXCEPTION RAISED - CASE 3D");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>  
+                     NULL;
+                WHEN OTHERS =>  
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3D");
+           END;
+ 
+           BEGIN -- SATISFIES T BUT NOT BASE TYPE.
+                V_A_CA1_5 := NEW CA1_6'(1, 2, 3, 4, 5, 6);
+                FAILED ("NO EXCEPTION RAISED - CASE 3E");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3E");
+           END;
+ 
+           BEGIN -- SATISFIES BASE TYPE BUT NOT T.
+                V_A_CA1_5 := NEW CA1_4'(1, 2, 3, 4, 5);
+                FAILED ("NO EXCEPTION RAISED - CASE 3F");
+           EXCEPTION
+                WHEN CONSTRAINT_ERROR =>
+                     NULL;
+                WHEN OTHERS =>
+                     FAILED ("WRONG EXCEPTION RAISED - CASE 3F");
+           END;
+ 
+          BEGIN -- SATISFIES BASE TYPE BUT NOT T.
+               V_A_CA1_5 := NEW CA1_6'(1, 2, 3, 4, 5);
+               FAILED ("NO EXCEPTION RAISED - CASE 3G");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CASE 3G");
+          END;
+ 
+      END ;
+ 
+      RESULT ;
+ 
+ END C48009E ;
+ 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009f.ada
new file mode 100644
index 000000000..d02e2c1fd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009f.ada
@@ -0,0 +1,99 @@
+-- C48009F.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 ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+-- IS RAISED IF T IS A CONSTRAINED OR UNCONSTRAINED MULTI-DIMENSIONAL
+-- ARRAY TYPE AND ALL COMPONENTS OF X DO NOT HAVE THE SAME LENGTH OR
+-- BOUNDS. 
+
+-- RM  01/08/80
+-- NL  10/13/81
+-- SPS 10/26/82
+-- JBG 03/03/83
+-- EG  07/05/84
+
+WITH REPORT;
+
+PROCEDURE  C48009F  IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48009F","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN "          &
+                    "X IS AN ILL-FORMED MULTIDIMENSIONAL AGGREGATE");
+
+     DECLARE
+
+          TYPE  TG00  IS  ARRAY( 4..2 ) OF  INTEGER;
+          TYPE  TG10  IS  ARRAY( 1..2 ) OF  INTEGER;
+          TYPE  TG20  IS  ARRAY( INTEGER RANGE <> ) OF  INTEGER;
+
+          TYPE  TG0  IS  ARRAY( 3..2 ) OF  TG00;
+          TYPE  TG1  IS  ARRAY( 1..2 ) OF  TG10;
+          TYPE  TG2  IS  ARRAY( INTEGER RANGE <> ) OF  TG20(1..3);
+
+          TYPE  ATG0  IS  ACCESS TG0;
+          TYPE  ATG1  IS  ACCESS TG1;
+          TYPE  ATG2  IS  ACCESS TG2;
+
+          VG0  : ATG0;
+          VG1  : ATG1;
+          VG2  : ATG2;
+
+     BEGIN
+
+          BEGIN
+               VG0  :=  NEW TG0 '( 5..4 => ( 3..1 => 2 ) );
+               FAILED ("NO EXCEPTION RAISED - CASE 0");
+          EXCEPTION
+               WHEN  CONSTRAINT_ERROR  =>  NULL;
+               WHEN  OTHERS            =>
+                    FAILED( "WRONG EXCEPTION RAISED - CASE 0" );
+          END;
+
+          BEGIN
+               VG1  :=  NEW TG1 '( ( 1 , 2 ) , ( 3 , 4 , 5 ) );
+               FAILED ("NO EXCEPTION RAISED - CASE 1");
+          EXCEPTION
+               WHEN  CONSTRAINT_ERROR  =>  NULL;
+               WHEN  OTHERS            =>  
+                    FAILED( "WRONG EXCEPTION RAISED - CASE 1" );
+          END;
+
+          BEGIN
+               VG2 := NEW TG2'( 1 => ( 1..2 => 7) , 2 => ( 1..3 => 7));
+               FAILED ("NO EXCEPTION RAISED - CASE 2");
+          EXCEPTION
+               WHEN  CONSTRAINT_ERROR  =>  NULL;
+               WHEN  OTHERS            =>  
+                    FAILED( "WRONG EXCEPTION RAISED - CASE 2" );
+          END;
+
+     END;
+
+     RESULT;
+
+END C48009F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009g.ada
new file mode 100644
index 000000000..13fec942f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009g.ada
@@ -0,0 +1,209 @@
+-- C48009G.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:
+--     FOR ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT
+--     CONSTRAINT_ERROR IS RAISED IF T IS A CONSTRAINED ACCESS
+--     TYPE AND THE OBJECT DESIGNATED BY X DOES NOT HAVE DISCRIMINANTS
+--     OR INDEX BOUNDS THAT EQUAL THE CORRESPONDING VALUES FOR T.
+
+-- HISTORY:
+--     EG  08/30/84  CREATED ORIGINAL TEST.
+--     JET 01/05/87  UPDATED HEADER FORMAT AND ADDED CODE TO PREVENT
+--                   OPTIMIZATION.
+
+WITH REPORT;
+
+PROCEDURE C48009G IS
+
+     USE REPORT;
+
+     GENERIC
+          TYPE G_TYPE IS PRIVATE;
+     FUNCTION EQUAL_G (X : G_TYPE; Y : G_TYPE) RETURN BOOLEAN;
+
+     FUNCTION EQUAL_G (X : G_TYPE; Y : G_TYPE) RETURN BOOLEAN IS
+     BEGIN
+          IF (IDENT_INT(3) = 3) AND (X = Y) THEN
+               RETURN TRUE;
+          ELSE
+               RETURN FALSE;
+          END IF;
+     END EQUAL_G;
+
+BEGIN
+
+     TEST("C48009G","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                    "APPROPRIATE - CONSTRAINED ACCESS TYPE");
+
+     DECLARE
+
+          TYPE INT IS RANGE 1 .. 5;
+
+          TYPE UR(A : INT) IS
+               RECORD
+                    B : INTEGER;
+               END RECORD;
+          TYPE UA IS ARRAY(INT RANGE <>) OF INTEGER;
+
+          PACKAGE P IS
+               TYPE UP(A, B : INT) IS PRIVATE;
+               TYPE UL(A, B : INT) IS LIMITED PRIVATE;
+               CONS_UP : CONSTANT UP;
+          PRIVATE
+               TYPE UP(A, B : INT) IS
+                    RECORD
+                         C : INTEGER;
+                    END RECORD;
+               TYPE UL(A, B : INT) IS
+                    RECORD
+                         C : INTEGER;
+                    END RECORD;
+               CONS_UP : CONSTANT UP := (2, 2, (IDENT_INT(3)));
+          END P;
+
+          TYPE A_UR IS ACCESS UR;
+          TYPE A_UA IS ACCESS UA;
+          TYPE A_UP IS ACCESS P.UP;
+          TYPE A_UL IS ACCESS P.UL;
+
+          SUBTYPE CA_UR IS A_UR(2);
+          SUBTYPE CA_UA IS A_UA(2 .. 3);
+          SUBTYPE CA_UP IS A_UP(3, 2);
+          SUBTYPE CA_UL IS A_UL(2, 4);
+
+          TYPE A_CA_UR IS ACCESS CA_UR;
+          TYPE A_CA_UA IS ACCESS CA_UA;
+          TYPE A_CA_UP IS ACCESS CA_UP;
+          TYPE A_CA_UL IS ACCESS CA_UL;
+
+          V_A_CA_UR : A_CA_UR;
+          V_A_CA_UA : A_CA_UA;
+          V_A_CA_UP : A_CA_UP;
+          V_A_CA_UL : A_CA_UL;
+
+          FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UR);
+          FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UA);
+          FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UP);
+          FUNCTION EQUAL IS NEW EQUAL_G(A_CA_UL);
+
+     BEGIN
+
+          BEGIN
+               V_A_CA_UR := NEW CA_UR'(NEW UR'(1,(IDENT_INT(2))));
+
+               IF EQUAL (V_A_CA_UR, V_A_CA_UR) THEN
+                    FAILED ("NO EXCEPTION RAISED - UR");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UR");
+          END;
+
+          BEGIN
+               V_A_CA_UA := NEW CA_UA'(NEW UA'(1 => 2,
+                                               2 => IDENT_INT(3)));
+
+               IF EQUAL (V_A_CA_UA, V_A_CA_UA) THEN
+                    FAILED ("NO EXCEPTION RAISED - UA");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UA");
+          END;
+
+          BEGIN
+               V_A_CA_UP := NEW CA_UP'(NEW P.UP'(P.CONS_UP));
+
+               IF EQUAL (V_A_CA_UP, V_A_CA_UP) THEN
+                    FAILED ("NO EXCEPTION RAISED - UP");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UP");
+          END;
+
+          BEGIN
+               V_A_CA_UR := NEW CA_UR'(NULL);
+
+               IF NOT EQUAL (V_A_CA_UR, V_A_CA_UR) THEN
+                    COMMENT ("NO EXCEPTION RAISED - UR");
+               END IF;
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - UR");
+          END;
+
+          BEGIN
+               V_A_CA_UA := NEW CA_UA'(NULL);
+
+               IF NOT EQUAL (V_A_CA_UA, V_A_CA_UA) THEN
+                    COMMENT ("NO EXCEPTION RAISED - UA");
+               END IF;
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - UA");
+          END;
+
+          BEGIN
+               V_A_CA_UP := NEW CA_UP'(NULL);
+
+               IF NOT EQUAL (V_A_CA_UP, V_A_CA_UP) THEN
+                    COMMENT ("NO EXCEPTION RAISED - UP");
+               END IF;
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - UP");
+          END;
+
+          BEGIN
+               V_A_CA_UL := NEW CA_UL'(NULL);
+
+               IF NOT EQUAL (V_A_CA_UL, V_A_CA_UL) THEN
+                    COMMENT ("NO EXCEPTION RAISED - UL");
+               END IF;
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - UL");
+          END;
+
+     END;
+
+     RESULT;
+
+END C48009G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009h.ada
new file mode 100644
index 000000000..661793be3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009h.ada
@@ -0,0 +1,129 @@
+-- C48009H.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 ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+-- IS RAISED IF T IS AN (UNCONSTRAINED) ACCESS TYPE, THE DESIGNATED TYPE
+-- FOR T'BASE IS CONSTRAINED, AND THE OBJECT DESIGNATED BY X DOES NOT
+-- HAVE DISCRIMINANTS OR INDEX BOUNDS THAT EQUAL THE CORRESPONDING
+-- VALUES FOR T'S DESIGNATED TYPE.
+
+-- EG  08/30/84
+
+WITH REPORT;
+
+PROCEDURE C48009H IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48009H","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                    "APPROPRIATE - UNCONSTRAINED ACCESS TYPE OF A " &
+                    "CONSTRAINED TYPE");
+
+     DECLARE
+
+          TYPE UR(A : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+          TYPE UA IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+
+          PACKAGE P IS
+               TYPE UP(A : INTEGER) IS PRIVATE;
+               TYPE UL(A : INTEGER) IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE UP(A : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+               TYPE UL(A : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END P;
+
+          TYPE A_CR IS ACCESS UR(IDENT_INT(2));
+          TYPE A_CA IS ACCESS UA(2 .. IDENT_INT(4));
+          TYPE A_CP IS ACCESS P.UP(3);
+          TYPE A_CL IS ACCESS P.UL(4);
+
+          TYPE AA_CR IS ACCESS A_CR;
+          TYPE AA_CA IS ACCESS A_CA;
+          TYPE AA_CP IS ACCESS A_CP;
+          TYPE AA_CL IS ACCESS A_CL;
+
+          V_AA_CR : AA_CR;
+          V_AA_CA : AA_CA;
+          V_AA_CP : AA_CP;
+          V_AA_CL : AA_CL;
+
+     BEGIN
+
+          BEGIN
+               V_AA_CR := NEW A_CR'(NEW UR(3));
+               FAILED ("NO EXCEPTION RAISED - CR");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CR");
+          END;
+
+          BEGIN
+               V_AA_CA := NEW A_CA'(NEW UA(IDENT_INT(3) .. 5));
+               FAILED ("NO EXCEPTION RAISED - CA");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CA");
+          END;
+
+          BEGIN
+               V_AA_CP := NEW A_CP'(NEW P.UP(IDENT_INT(4)));
+               FAILED ("NO EXCEPTION RAISED - CP");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CP");
+          END;
+
+          BEGIN
+               V_AA_CL := NEW A_CL'(NEW P.UL(5));
+               FAILED ("NO EXCEPTION RAISED - CL");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CL");
+          END;
+
+     END;
+
+     RESULT;
+
+END C48009H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009i.ada
new file mode 100644
index 000000000..d59b4ddb9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009i.ada
@@ -0,0 +1,128 @@
+-- C48009I.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 ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+-- IS RAISED IF THE DESIGNATED TYPE FOR "NEW T'(X)" IS A CONSTRAINED
+-- ACCESS TYPE, CA, T IS CA'BASE, AND A DISCRIMINANT OR INDEX VALUE OF X
+-- DOES NOT EQUAL A VALUE SPECIFIED FOR CA.
+
+-- EG  08/30/84
+
+WITH REPORT;
+
+PROCEDURE C48009I IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48009I","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                    "APPROPRIATE - ACCESS TYPE OF CONSTRAINED " &
+                    "ACCESS TYPE");
+
+     DECLARE
+
+          TYPE UR(A : INTEGER) IS
+               RECORD
+                    NULL;
+               END RECORD;
+          TYPE UA IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+          
+          PACKAGE P IS
+               TYPE UP(A : INTEGER) IS PRIVATE;
+               TYPE UL(A : INTEGER) IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE UP(A : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+               TYPE UL(A : INTEGER) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END P;
+
+          TYPE A_UR IS ACCESS UR;
+          TYPE A_UA IS ACCESS UA;
+          TYPE A_UP IS ACCESS P.UP;
+          TYPE A_UL IS ACCESS P.UL;
+
+          TYPE AC_A_UR IS ACCESS A_UR(2);
+          TYPE AC_A_UA IS ACCESS A_UA(2 .. 4);
+          TYPE AC_A_UP IS ACCESS A_UP(3);
+          TYPE AC_A_UL IS ACCESS A_UL(4);
+
+          V_AC_A_UR : AC_A_UR;
+          V_AC_A_UA : AC_A_UA;
+          V_AC_A_UP : AC_A_UP;
+          V_AC_A_UL : AC_A_UL;
+
+     BEGIN
+
+          BEGIN
+               V_AC_A_UR := NEW A_UR'(NEW UR(3));
+               FAILED ("NO EXCEPTION RAISED - UR");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UR");
+          END;
+
+          BEGIN
+               V_AC_A_UA := NEW A_UA'(NEW UA(3 .. 5));
+               FAILED ("NO EXCEPTION RAISED - UA");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UA");
+          END;
+
+          BEGIN
+               V_AC_A_UP := NEW A_UP'(NEW P.UP(IDENT_INT(4)));
+               FAILED ("NO EXCEPTION RAISED - UP");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UP");
+          END;
+
+          BEGIN
+               V_AC_A_UL := NEW A_UL'(NEW P.UL(IDENT_INT(5)));
+               FAILED ("NO EXCEPTION RAISED - UL");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UL");
+          END;
+
+     END;
+
+     RESULT;
+
+END C48009I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009j.ada
new file mode 100644
index 000000000..c384f38b5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48009j.ada
@@ -0,0 +1,132 @@
+-- C48009J.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 ALLOCATORS OF THE FORM "NEW T'(X)", CHECK THAT CONSTRAINT_ERROR
+-- IS RAISED IF T IS AN UNCONSTRAINED ACCESS TYPE, ITS DESIGNATED TYPE
+-- IS ALSO UNCONSTRAINED, AND A DISCRIMINANT VALUE FOR X LIES OUTSIDE
+-- THE RANGE OF THE CORRESPONDING DISCRIMINANT SPECIFICATION FOR THE
+-- DESIGNATED TYPE, OR A NON-NULL INDEX BOUND LIES OUTSIDE THE RANGE OF
+-- AN INDEX SUBTYPE OF THE DESIGNATED TYPE.
+
+-- EG  08/30/84
+
+WITH REPORT;
+
+PROCEDURE C48009J IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48009J","FOR ALLOCATORS OF THE FORM 'NEW T'(X)', CHECK " &
+                    "THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                    "APPROPRIATE - ACCESS TYPE OF UNCONSTRAINED " &
+                    "ACCESS TYPE");
+
+     DECLARE
+
+          TYPE INT IS RANGE 1 .. 5;
+
+          TYPE UR(A : INT) IS
+               RECORD
+                    NULL;
+               END RECORD;
+          TYPE UA IS ARRAY(INT RANGE <>) OF INTEGER;
+
+          PACKAGE P IS
+               TYPE UP(A : INT) IS PRIVATE;
+               TYPE UL(A : INT) IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE UP(A : INT) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+               TYPE UL(A : INT) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END P;
+
+          TYPE A_UR IS ACCESS UR;
+          TYPE A_UA IS ACCESS UA;
+          TYPE A_UP IS ACCESS P.UP;
+          TYPE A_UL IS ACCESS P.UL;
+
+          TYPE AA_UR IS ACCESS A_UR;
+          TYPE AA_UA IS ACCESS A_UA;
+          TYPE AA_UP IS ACCESS A_UP;
+          TYPE AA_UL IS ACCESS A_UL;
+
+          V_AA_UR : AA_UR;
+          V_AA_UA : AA_UA;
+          V_AA_UP : AA_UP;
+          V_AA_UL : AA_UL;
+
+     BEGIN
+
+          BEGIN
+               V_AA_UR := NEW A_UR'(NEW UR(INT(IDENT_INT(6))));
+               FAILED ("NO EXCEPTION RAISED - UR");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UR");
+          END;
+
+          BEGIN
+               V_AA_UA := NEW A_UA'(NEW UA(4 .. 7));
+               FAILED ("NO EXCEPTION RAISED - UA");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UA");
+          END;
+
+          BEGIN
+               V_AA_UP := NEW A_UP'(NEW P.UP(0));
+               FAILED ("NO EXCEPTION RAISED - UP");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UP");
+          END;
+
+          BEGIN
+               V_AA_UL := NEW A_UL'(NEW P.UL(INT(IDENT_INT(0))));
+               FAILED ("NO EXCEPTION RAISED - UL");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - UL");
+          END;
+
+     END;
+
+     RESULT;
+
+END C48009J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48010a.ada
new file mode 100644
index 000000000..15c7e2172
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48010a.ada
@@ -0,0 +1,90 @@
+-- C48010A.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 NULL ARRAYS AND NULL RECORDS CAN BE ALLOCATED.
+
+-- EG  08/30/84
+
+WITH REPORT;
+
+PROCEDURE C48010A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48010A","CHECK THAT NULL ARRAYS AND NULL RECORDS CAN " &
+                    "BE ALLOCATED");
+
+     DECLARE
+
+          TYPE CA IS ARRAY(4 .. 3) OF INTEGER;
+          TYPE CR IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE A_CA IS ACCESS CA;
+          TYPE A_CR IS ACCESS CR;
+
+          TYPE AA_CA IS ACCESS A_CA;
+          TYPE AA_CR IS ACCESS A_CR;
+
+          V_A_CA  : A_CA;
+          V_A_CR  : A_CR;
+          V_AA_CA : AA_CA;
+          V_AA_CR : AA_CR;
+
+     BEGIN
+
+          V_A_CA := NEW CA;
+          IF V_A_CA = NULL THEN
+               FAILED ("NULL ARRAY WAS NOT ALLOCATED - CA");
+          ELSIF V_A_CA.ALL'FIRST /= 4 AND V_A_CA.ALL'LAST /= 3 THEN
+               FAILED ("NULL ARRAY BOUNDS ARE INCORRECT - CA");
+          END IF;
+
+          V_A_CR := NEW CR;
+          IF V_A_CR = NULL THEN
+               FAILED ("NULL RECORD WAS NOT ALLOCATED - CR");
+          END IF;
+
+          V_AA_CA := NEW A_CA'(NEW CA);
+          IF V_AA_CA.ALL = NULL THEN
+               FAILED ("NULL ARRAY WAS NOT ALLOCATED - A_CA");
+          ELSIF V_AA_CA.ALL.ALL'FIRST /= 4 AND 
+                V_AA_CA.ALL.ALL'LAST /= 3 THEN
+               FAILED ("NULL ARRAY BOUNDS ARE INCORRECT - A_CA");
+          END IF;
+
+          V_AA_CR := NEW A_CR'(NEW CR);
+          IF (V_AA_CR = NULL OR V_AA_CR.ALL = NULL) THEN
+               FAILED ("NULL RECORD WAS NOT ALLOCATED - A_CR");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C48010A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48011a.ada
new file mode 100644
index 000000000..7281fce9a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48011a.ada
@@ -0,0 +1,101 @@
+-- C48011A.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 OVERLOADED ALLOCATORS ARE DETERMINED TO HAVE THE
+--     APPROPRIATE TYPE.
+
+-- HISTORY:
+--     JET 08/17/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C48011A IS
+
+     TYPE ACC1 IS ACCESS INTEGER;
+     TYPE ACC2 IS ACCESS INTEGER;
+
+     A1 : ACC1 := NULL;
+     A2 : ACC2 := NULL;
+
+     TYPE REC1 IS RECORD
+          A : INTEGER;
+     END RECORD;
+
+     TYPE REC2 IS RECORD
+          A : ACC2;
+     END RECORD;
+
+     TYPE AREC1 IS ACCESS REC1;
+     TYPE AREC2 IS ACCESS REC2;
+
+     PROCEDURE PROC(A : ACC1) IS
+     BEGIN
+          IF A.ALL /= 1 THEN
+               FAILED("INCORRECT CALL OF FIRST PROC");
+          END IF;
+     END PROC;
+
+     PROCEDURE PROC(A : INTEGER) IS
+     BEGIN
+          IF A /= 2 THEN
+               FAILED("INCORRECT CALL OF SECOND PROC");
+          END IF;
+     END PROC;
+
+     FUNCTION FUNC(I : INTEGER) RETURN AREC1 IS
+     BEGIN
+          IF I /= 1 THEN
+               FAILED("INCORRECT CALL OF FIRST FUNC");
+          END IF;
+          RETURN NEW REC1'(A => 0);
+     END FUNC;
+
+     FUNCTION FUNC(I : INTEGER) RETURN AREC2 IS
+     BEGIN
+          IF I /= 2 THEN
+               FAILED("INCORRECT CALL OF SECOND FUNC");
+          END IF;
+          RETURN NEW REC2'(A => NULL);
+     END FUNC;
+
+BEGIN
+     TEST ("C48011A", "CHECK THAT OVERLOADED ALLOCATORS ARE " &
+                      "DETERMINED TO HAVE THE APPROPRIATE TYPE");
+
+     IF A1 = NEW INTEGER'(1) THEN
+          FAILED("INCORRECT RETURN VALUE FROM ALLOCATOR 1");
+     END IF;
+
+     IF A2 = NEW INTEGER'(2) THEN
+          FAILED("INCORRECT RETURN VALUE FROM ALLOCATOR 2");
+     END IF;
+
+     FUNC(1).A := INTEGER'(1);
+     FUNC(IDENT_INT(2)).A := NEW INTEGER'(2);
+
+     PROC(NEW INTEGER'(IDENT_INT(1)));
+     PROC(IDENT_INT(2));
+
+     RESULT;
+END C48011A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48012a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48012a.ada
new file mode 100644
index 000000000..f85ad782f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c48012a.ada
@@ -0,0 +1,75 @@
+-- C48012A.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 DISCRIMINANTS GOVERNING VARIANT PARTS NEED NOT BE
+-- SPECIFIED WITH STATIC VALUES IN AN ALLOCATOR OF THE FORM 
+-- "NEW T X".
+
+-- EG  08/30/84
+
+WITH REPORT;
+
+PROCEDURE C48012A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C48012A","CHECK THAT DISCRIMINANTS GOVERNING VARIANT " &
+                    "PARTS NEED NOT BE SPECIFIED WITH STATIC "    &
+                    "VALUES IN AN ALLOCATOR OF THE FORM 'NEW T X'");
+
+     DECLARE
+
+          TYPE INT IS RANGE 1 .. 5;
+          TYPE ARR IS ARRAY(INT RANGE <>) OF INTEGER;
+
+          TYPE UR(A : INT) IS
+               RECORD
+                    CASE A IS
+                         WHEN 1 =>
+                              NULL;
+                         WHEN OTHERS =>
+                              B : ARR(1 .. A);
+                    END CASE;
+               END RECORD;
+
+          TYPE A_UR IS ACCESS UR;
+
+          V_A_UR : A_UR;
+
+     BEGIN
+
+          V_A_UR := NEW UR(A => INT(IDENT_INT(2)));
+          IF V_A_UR.A /= 2 THEN
+               FAILED ("WRONG DISCRIMINANT VALUE");
+          ELSIF V_A_UR.B'FIRST /= 1 AND V_A_UR.B'LAST /= 2 THEN
+               FAILED ("WRONG BOUNDS IN VARIANT PART");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C48012A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c490001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c490001.a
new file mode 100644
index 000000000..19153504c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c490001.a
@@ -0,0 +1,215 @@
+-- C490001.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, for a real static expression that is not part of a larger
+--      static expression, and whose expected type T is a floating point type
+--      that is not a descendant of a formal scalar type, the value is rounded
+--      to the nearest machine number of T if T'Machine_Rounds is true, and is
+--      truncated otherwise. Check that if rounding is performed, and the value
+--      is exactly halfway between two machine numbers, one of the two machine
+--      numbers is used.
+--
+-- TEST DESCRIPTION:
+--      The test obtains a machine number M1 for a floating point subtype S by
+--      passing a real literal to S'Machine. It then obtains an adjacent
+--      machine number M2 by using S'Succ (or S'Pred). It then constructs
+--      values which lie between these two machine numbers: one (A) which is
+--      closer to M1, one (B) which is exactly halfway between M1 and M2, and
+--      one (C) which is closer to M2. This is done for both positive and
+--      negative machine numbers.
+--
+--      Let M1 be closer to zero than M2. Then if S'Machine_Rounds is true,
+--      C must be rounded to M2, A must be rounded to M1, and B must be rounded
+--      to either M1 or M2. If S'Machine_Rounds is false, all the values must
+--      be truncated to M1.
+--
+--      A, B, and C are constructed using the following static expressions:
+--
+--         A: constant S := M1 + (M2 - M1)*Z; -- Z slightly less than 0.5.
+--         B: constant S := M1 + (M2 - M1)*Z; -- Z equals 0.5.
+--         C: constant S := M1 + (M2 - M1)*Z; -- Z slightly more than 0.5.
+--
+--      Since these are static expressions, they must be evaluated exactly,
+--      and no rounding may occur until the final result is calculated.
+--
+--      The checks for equality between the members of (A, B, C) and (M1, M2)
+--      are performed at run-time within the body of a subprogram.
+--
+--      The test performs additional checks that the rounding performed on
+--      real literals is consistent for a floating point subtype. A literal is
+--      assigned to a constant of a floating point subtype S. The same literal
+--      is then passed to a subprogram, along with the constant, and an
+--      equality check is performed within the body of the subprogram.
+--
+--
+-- CHANGE HISTORY:
+--      25 Sep 95   SAIC    Initial prerelease version.
+--      25 May 01   RLB     Repaired to work with the repeal of the round away
+--                          rule by AI-268.
+--
+--!
+
+with System;
+package C490001_0 is
+
+   type My_Flt is digits System.Max_Digits;
+
+   procedure Float_Subtest (A, B: in My_Flt; Msg: in String);
+
+   procedure Float_Subtest (A, B, C: in My_Flt; Msg: in String);
+
+
+--
+-- Positive cases:
+--
+
+   --  |----|-------------|-----------------|-------------------|-----------|
+   --  |    |             |                 |                   |           |
+   --  0   P_M1  Less_Pos_Than_Half  Pos_Exactly_Half  More_Pos_Than_Half  P_M2
+
+
+   Positive_Float : constant My_Flt := 12.440193950021943;
+
+   -- The literal value 12.440193950021943 is rounded up or down to the
+   -- nearest machine number of My_Flt when Positive_Float is initialized.
+   -- The value of Positive_Float should therefore be a machine number, and
+   -- the use of 'Machine in the initialization of P_M1 will be redundant for
+   -- a correct implementation. It's done anyway to make certain that P_M1 is
+   -- a machine number, independent of whether an implementation correctly
+   -- performs rounding.
+
+   P_M1 : constant My_Flt := My_Flt'Machine(Positive_Float);
+   P_M2 : constant My_Flt := My_Flt'Succ(P_M1);
+
+   -- P_M1 and P_M2 are adjacent machine numbers. Note that because it is not
+   -- certain whether 12.440193950021943 is a machine number, nor whether
+   -- 'Machine rounds it up or down, 12.440193950021943 may not lie between
+   -- P_M1 and P_M2. The test does not depend on this information, however;
+   -- the literal is only used as a "seed" to obtain the machine numbers.
+
+
+   -- The following entities are used to verify that rounding is performed
+   -- according to the value of 'Machine_Rounds. If language rules are
+   -- obeyed, the intermediate expressions in the following static
+   -- initialization expressions will not be rounded; all calculations will
+   -- be performed exactly. The final result, however, will be rounded to
+   -- a machine number (either P_M1 or P_M2, depending on the value of
+   -- My_Flt'Machine_Rounds). Thus, the value of each constant below will
+   -- equal that of P_M1 or P_M2.
+
+   Less_Pos_Than_Half : constant My_Flt := P_M1 + ((P_M2 - P_M1)*2.9/6.0);
+   Pos_Exactly_Half   : constant My_Flt := P_M1 + ((P_M2 - P_M1)/2.0);
+   More_Pos_Than_Half : constant My_Flt := P_M1 + ((P_M2 - P_M1)*4.6/9.0);
+
+
+--
+-- Negative cases:
+--
+
+   --  -|-------------|-----------------|-------------------|-----------|----|
+   --   |             |                 |                   |           |    |
+   --  N_M2  More_Neg_Than_Half  Neg_Exactly_Half  Less_Neg_Than_Half  N_M1  0
+
+
+   -- The descriptions for the positive cases above apply to the negative
+   -- cases below as well. Note that, for N_M2, 'Pred is used rather than
+   -- 'Succ. Thus, N_M2 is further from 0.0 (i.e. more negative) than N_M1.
+
+   Negative_Float : constant My_Flt := -0.692074550952117;
+
+
+   N_M1 : constant My_Flt := My_Flt'Machine(Negative_Float);
+   N_M2 : constant My_Flt := My_Flt'Pred(N_M1);
+
+   More_Neg_Than_Half : constant My_Flt := N_M1 + ((N_M2 - N_M1)*4.1/8.0);
+   Neg_Exactly_Half   : constant My_Flt := N_M1 + ((N_M2 - N_M1)/2.0);
+   Less_Neg_Than_Half : constant My_Flt := N_M1 + ((N_M2 - N_M1)*2.4/5.0);
+
+end C490001_0;
+
+
+     --==================================================================--
+
+
+with TCTouch;
+package body C490001_0 is
+
+   procedure Float_Subtest (A, B: in My_Flt; Msg: in String) is
+   begin
+       TCTouch.Assert (A = B, Msg);
+   end Float_Subtest;
+
+   procedure Float_Subtest (A, B, C: in My_Flt; Msg: in String) is
+   begin
+       TCTouch.Assert (A = B or A = C, Msg);
+   end Float_Subtest;
+
+end C490001_0;
+
+
+     --==================================================================--
+
+
+with C490001_0;  -- Floating point support.
+use  C490001_0;
+
+with Report;
+procedure C490001 is
+begin
+   Report.Test ("C490001", "Rounding of real static expressions: " &
+                "floating point subtypes");
+
+
+   -- Check that rounding direction is consistent for literals:
+
+   Float_Subtest (12.440193950021943, P_M1, "Positive Float: literal");
+   Float_Subtest (-0.692074550952117, N_M1, "Negative Float: literal");
+
+
+   -- Now check that rounding is performed correctly for values between
+   -- machine numbers, according to the value of 'Machine_Rounds:
+
+   if My_Flt'Machine_Rounds then
+      Float_Subtest (Pos_Exactly_Half,   P_M1, P_M2, "Positive Float: = half");
+      Float_Subtest (More_Pos_Than_Half, P_M2, "Positive Float: > half");
+      Float_Subtest (Less_Pos_Than_Half, P_M1, "Positive Float: < half");
+
+      Float_Subtest (Neg_Exactly_Half,   N_M1, N_M2, "Negative Float: = half");
+      Float_Subtest (More_Neg_Than_Half, N_M2, "Negative Float: > half");
+      Float_Subtest (Less_Neg_Than_Half, N_M1, "Negative Float: < half");
+   else
+      Float_Subtest (Pos_Exactly_Half,   P_M1, "Positive Float: = half");
+      Float_Subtest (More_Pos_Than_Half, P_M1, "Positive Float: > half");
+      Float_Subtest (Less_Pos_Than_Half, P_M1, "Positive Float: < half");
+
+      Float_Subtest (Neg_Exactly_Half,   N_M1, "Negative Float: = half");
+      Float_Subtest (More_Neg_Than_Half, N_M1, "Negative Float: > half");
+      Float_Subtest (Less_Neg_Than_Half, N_M1, "Negative Float: < half");
+   end if;
+
+
+   Report.Result;
+end C490001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c490002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c490002.a
new file mode 100644
index 000000000..71169b833
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c490002.a
@@ -0,0 +1,239 @@
+-- C490002.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, for a real static expression that is not part of a larger
+--      static expression, and whose expected type T is an ordinary fixed
+--      point type that is not a descendant of a formal scalar type, the value
+--      is rounded to the nearest integral multiple of the small of T if
+--      T'Machine_Rounds is true, and is truncated otherwise. Check that if
+--      rounding is performed, and the value is exactly halfway between two
+--      multiples of the small, one of the two multiples of small is used.
+--
+-- TEST DESCRIPTION:
+--      The test obtains an integral multiple M1 of the small of an ordinary
+--      fixed point subtype S by dividing a real literal by S'Small, and then
+--      truncating the result using 'Truncation. It then obtains an adjacent
+--      multiple M2 of the small by using S'Succ (or S'Pred). It then
+--      constructs values which lie between these multiples: one (A) which is
+--      closer to M1, one (B) which is exactly halfway between M1 and M2, and
+--      one (C) which is closer to M2. This is done for both positive and
+--      negative multiples of the small.
+--
+--      Let M1 be closer to zero than M2. Then if S'Machine_Rounds is true,
+--      C must be rounded to M2, A must be rounded to M1, and B must be rounded
+--      to either M1 or M2. If S'Machine_Rounds is false, all the values must
+--      be truncated to M1.
+--
+--      A, B, and C are constructed using the following static expressions:
+--
+--         A: constant S := M1 + (M2 - M1)/Z; -- Z slightly more than 2.0.
+--         B: constant S := M1 + (M2 - M1)/Z; -- Z equals 2.0.
+--         C: constant S := M1 + (M2 - M1)/Z; -- Z slightly less than 2.0.
+--
+--      Since these are static expressions, they must be evaluated exactly,
+--      and no rounding may occur until the final result is calculated.
+--
+--      The checks for equality between the members of (A, B, C) and (M1, M2)
+--      are performed at run-time within the body of a subprogram.
+--
+--      The test performs additional checks that the rounding performed on
+--      real literals is consistent for ordinary fixed point subtypes. A
+--      named number (initialized with a literal) is assigned to a constant of
+--      a fixed point subtype S. The same literal is then passed to a
+--      subprogram, along with the constant, and an equality check is
+--      performed within the body of the subprogram.
+--
+--
+-- CHANGE HISTORY:
+--      26 Sep 95   SAIC    Initial prerelease version.
+--
+--!
+
+package C490002_0 is
+
+   type My_Fix is delta 0.0625 range -1000.0 .. 1000.0;
+
+   Small : constant := My_Fix'Small;                      -- Named number.
+
+   procedure Fixed_Subtest (A, B: in My_Fix; Msg: in String);
+
+   procedure Fixed_Subtest (A, B, C: in My_Fix; Msg: in String);
+
+
+--
+-- Positive cases:
+--
+
+   --  |----|-------------|-----------------|-------------------|-----------|
+   --  |    |             |                 |                   |           |
+   --  0   P_M1  Less_Pos_Than_Half  Pos_Exactly_Half  More_Pos_Than_Half  P_M2
+
+
+   Positive_Real  : constant := 0.11433;          -- Named number.
+   Pos_Multiplier : constant := Float'Truncation(Positive_Real/Small);
+
+   -- Pos_Multiplier is the number of integral multiples of small contained
+   -- in Positive_Real. P_M1 is thus the largest integral multiple of
+   -- small less than or equal to Positive_Real. Note that since Positive_Real
+   -- is a named number and not a fixed point object, P_M1 is generated
+   -- without assuming that rounding is performed correctly for fixed point
+   -- subtypes.
+
+   Positive_Fixed : constant My_Fix := Positive_Real;
+
+   P_M1 : constant My_Fix := Pos_Multiplier * Small;
+   P_M2 : constant My_Fix := My_Fix'Succ(P_M1);
+
+   -- P_M1 and P_M2 are adjacent multiples of the small of My_Fix. Note that
+   -- 0.11433 either equals P_M1 (if it is an integral multiple of the small)
+   -- or lies between P_M1 and P_M2 (since truncation was forced in
+   -- generating Pos_Multiplier). It is not certain, however, exactly where
+   -- it lies between them (halfway, less than halfway, more than halfway).
+   -- This fact is irrelevant to the test.
+
+
+   -- The following entities are used to verify that rounding is performed
+   -- according to the value of 'Machine_Rounds. If language rules are
+   -- obeyed, the intermediate expressions in the following static
+   -- initialization expressions will not be rounded; all calculations will
+   -- be performed exactly. The final result, however, will be rounded to
+   -- an integral multiple of the small (either P_M1 or P_M2, depending on the
+   -- value of My_Fix'Machine_Rounds). Thus, the value of each constant below
+   -- will equal that of P_M1 or P_M2.
+
+   Less_Pos_Than_Half : constant My_Fix := P_M1 + ((P_M2 - P_M1)/2.050);
+   Pos_Exactly_Half   : constant My_Fix := P_M1 + ((P_M2 - P_M1)/2.000);
+   More_Pos_Than_Half : constant My_Fix := P_M1 + ((P_M2 - P_M1)/1.975);
+
+
+--
+-- Negative cases:
+--
+
+   --  -|-------------|-----------------|-------------------|-----------|----|
+   --   |             |                 |                   |           |    |
+   --  N_M2  More_Neg_Than_Half  Neg_Exactly_Half  Less_Neg_Than_Half  N_M1  0
+
+
+   -- The descriptions for the positive cases above apply to the negative
+   -- cases below as well. Note that, for N_M2, 'Pred is used rather than
+   -- 'Succ. Thus, N_M2 is further from 0.0 (i.e. more negative) than N_M1.
+
+   Negative_Real  : constant := -467.13988;       -- Named number.
+   Neg_Multiplier : constant := Float'Truncation(Negative_Real/Small);
+
+   Negative_Fixed : constant My_Fix := Negative_Real;
+
+   N_M1 : constant My_Fix := Neg_Multiplier * Small;
+   N_M2 : constant My_Fix := My_Fix'Pred(N_M1);
+
+   More_Neg_Than_Half : constant My_Fix := N_M1 + ((N_M2 - N_M1)/1.980);
+   Neg_Exactly_Half   : constant My_Fix := N_M1 + ((N_M2 - N_M1)/2.000);
+   Less_Neg_Than_Half : constant My_Fix := N_M1 + ((N_M2 - N_M1)/2.033);
+
+end C490002_0;
+
+
+     --==================================================================--
+
+
+with TCTouch;
+package body C490002_0 is
+
+   procedure Fixed_Subtest (A, B: in My_Fix; Msg: in String) is
+   begin
+       TCTouch.Assert (A = B, Msg);
+   end Fixed_Subtest;
+
+   procedure Fixed_Subtest (A, B, C: in My_Fix; Msg: in String) is
+   begin
+       TCTouch.Assert (A = B or A = C, Msg);
+   end Fixed_Subtest;
+
+end C490002_0;
+
+
+     --==================================================================--
+
+
+with C490002_0;  -- Fixed point support.
+use  C490002_0;
+
+with Report;
+procedure C490002 is
+begin
+   Report.Test ("C490002", "Rounding of real static expressions: " &
+                "ordinary fixed point subtypes");
+
+
+   -- Literal cases: If the named numbers used to initialize Positive_Fixed
+   -- and Negative_Fixed are rounded to an integral multiple of the small
+   -- prior to assignment (as expected), then Positive_Fixed and
+   -- Negative_Fixed are already integral multiples of the small, and
+   -- equal either P_M1 or P_M2 (resp., N_M1 or N_M2). An equality check
+   -- can determine in which direction rounding occurred. For example:
+   --
+   --        if (Positive_Fixed = P_M1) then -- Rounding was toward 0.0.
+   --
+   -- Check here that the rounding direction is consistent for literals:
+
+   if (Positive_Fixed = P_M1) then
+      Fixed_Subtest (0.11433, P_M1, "Positive Fixed: literal");
+   else
+      Fixed_Subtest (0.11433, P_M2, "Positive Fixed: literal");
+   end if;
+
+   if (Negative_Fixed = N_M1) then
+      Fixed_Subtest (-467.13988, N_M1, "Negative Fixed: literal");
+   else
+      Fixed_Subtest (-467.13988, N_M2, "Negative Fixed: literal");
+   end if;
+
+
+   -- Now check that rounding is performed correctly for values between
+   -- multiples of the small, according to the value of 'Machine_Rounds:
+
+   if My_Fix'Machine_Rounds then
+      Fixed_Subtest (Pos_Exactly_Half,   P_M1, P_M2, "Positive Fixed: = half");
+      Fixed_Subtest (More_Pos_Than_Half, P_M2, "Positive Fixed: > half");
+      Fixed_Subtest (Less_Pos_Than_Half, P_M1, "Positive Fixed: < half");
+
+      Fixed_Subtest (Neg_Exactly_Half,   N_M1, N_M2, "Negative Fixed: = half");
+      Fixed_Subtest (More_Neg_Than_Half, N_M2, "Negative Fixed: > half");
+      Fixed_Subtest (Less_Neg_Than_Half, N_M1, "Negative Fixed: < half");
+   else
+      Fixed_Subtest (Pos_Exactly_Half,   P_M1, "Positive Fixed: = half");
+      Fixed_Subtest (More_Pos_Than_Half, P_M1, "Positive Fixed: > half");
+      Fixed_Subtest (Less_Pos_Than_Half, P_M1, "Positive Fixed: < half");
+
+      Fixed_Subtest (Neg_Exactly_Half,   N_M1, "Negative Fixed: = half");
+      Fixed_Subtest (More_Neg_Than_Half, N_M1, "Negative Fixed: > half");
+      Fixed_Subtest (Less_Neg_Than_Half, N_M1, "Negative Fixed: < half");
+   end if;
+
+
+   Report.Result;
+end C490002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c490003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c490003.a
new file mode 100644
index 000000000..a135b5ac3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c490003.a
@@ -0,0 +1,215 @@
+-- C490003.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 static expression is legal if its evaluation fails
+--      no language-defined check other than Overflow_Check. Check that such
+--      a static expression is legal if it is part of a larger static
+--      expression, even if its value is outside the base range of the
+--      expected type.
+--
+--      Check that if a static expression is part of the right operand of a
+--      short circuit control form whose value is determined by its left
+--      operand, it is not evaluated.
+--
+--      Check that a static expression in a non-static context is evaluated
+--      exactly.
+--
+-- TEST DESCRIPTION:
+--      The first part of the objective is tested by constructing static
+--      expressions which involve predefined operations of integer, floating
+--      point, and fixed point subtypes. Intermediate expressions within the
+--      static expressions have values outside the base range of the expected
+--      type. In one case, the extended-range intermediates are compared as
+--      part of a boolean expression. In the remaining two cases, further
+--      predefined operations on the intermediates bring the final result
+--      within the base range. An implementation which compiles these static
+--      expressions satisfies this portion of the objective. A check is
+--      performed at run-time to ensure that the static expressions evaluate
+--      to values within the base range of their respective expected types.
+--
+--      The second part of the objective is tested by constructing
+--      short-circuit control forms whose left operands have the values
+--      shown below:
+--
+--         (TRUE)  or else  (...)
+--         (FALSE) and then (...)
+--    
+--      In both cases the left operand determines the value of the condition.
+--      In the test each right operand involves a division by zero, which will
+--      raise Constraint_Error if evaluated. A check is made that no exception
+--      is raised when each short-circuit control form is evaluated, and that
+--      the value of the condition is that of the left operand.
+--    
+--      The third part of the objective is tested by evaluating static
+--      expressions involving many operations in contexts which do not
+--      require a static expression, and verifying that the exact
+--      mathematical results are calculated.
+--    
+--
+-- CHANGE HISTORY:
+--      15 Sep 95   SAIC    Initial prerelease version for ACVC 2.1.
+--      20 Oct 96   SAIC    Modified expressions in C490003_0 to avoid
+--                          the use of universal operands.
+--
+--!
+
+with System;
+package C490003_0 is
+
+   type My_Flt is digits System.Max_Digits;
+
+   Flt_Range_Diff : My_Flt := (My_Flt'Base'Last - My_Flt'Base'First) -
+                              (My_Flt'Last - My_Flt'First);           -- OK.
+
+
+   type My_Fix is delta 0.125 range -128.0 .. 128.0;
+
+   Symmetric : Boolean := (My_Fix'Base'Last - My_Fix'Base'First) = 
+                          (My_Fix'Base'Last + My_Fix'Base'Last);      -- OK.
+
+
+   Center : constant Integer := Integer'Base'Last -
+                                 (Integer'Base'Last -
+                                  Integer'Base'First) / 2;            -- OK.
+
+end C490003_0;
+
+
+     --==================================================================--
+
+
+with Ada.Numerics;
+package C490003_1 is
+
+   Zero       : constant := 0.0;
+   Pi         : constant := Ada.Numerics.Pi;
+
+   Two_Pi     : constant := 2.0 * Pi;
+   Half_Pi    : constant := Pi/2.0;
+
+   Quarter    : constant := 90.0;
+   Half       : constant := 180.0;
+   Full       : constant := 360.0;
+
+   Deg_To_Rad : constant := Half_Pi/90;
+   Rad_To_Deg : constant := 1.0/Deg_To_Rad;
+   
+end C490003_1;
+
+
+     --==================================================================--
+
+
+with C490003_0;
+with C490003_1;
+
+with Report;
+procedure C490003 is
+begin
+   Report.Test ("C490003", "Check that static expressions failing "          &
+                "Overflow_Check are legal if part of a larger static "       &
+                "expression. Check that static expressions as right "        &
+                "operands of short-circuit control forms are not "           &
+                "evaluated if value of control form is determined by "       &
+                "left operand. Check that static expressions in non-static " &
+                "contexts are evaluated exactly");
+
+
+--
+-- Static expressions within larger static expressions:
+--
+
+
+   if C490003_0.Flt_Range_Diff not in C490003_0.My_Flt'Base'Range then
+      Report.Failed ("Error evaluating static expression: floating point");
+   end if;
+
+   if C490003_0.Symmetric not in Boolean'Range then
+      Report.Failed ("Error evaluating static expression: fixed point");
+   end if;
+
+   if C490003_0.Center not in Integer'Base'Range then
+      Report.Failed ("Error evaluating static expression: integer");
+   end if;
+
+
+--
+-- Short-circuit control forms:
+--
+
+   declare
+      N : constant := 0.0;
+   begin
+
+      begin
+         if not ( (N = 0.0) or else (1.0/N > 0.5) ) then
+            Report.Failed ("Error evaluating OR ELSE");
+         end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Right side of OR ELSE was evaluated");
+         when others           =>
+            Report.Failed ("OR ELSE: unexpected exception raised");
+      end;
+
+      begin
+         if (N /= 0.0) and then (1.0/N <= 0.5) then
+            Report.Failed ("Error evaluating AND THEN");
+         end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Right side of AND THEN was evaluated");
+         when others           =>
+            Report.Failed ("AND THEN: unexpected exception raised");
+      end;
+
+   end;
+
+
+--
+-- Exact evaluation of static expressions:
+--
+
+
+   declare
+      use C490003_1;
+
+      Left  : constant := 6.0 + 0.3125*( (Full*0.375) + (Half/2.4) -
+                             ((Quarter + 36.0)/3.0) )/10.0;            -- 11.25
+      Right : constant := (Pi/3.0) * 1.2 * (15.0/96.0);                -- Pi/16
+   begin
+      if Deg_To_Rad*Left /= Right then
+         Report.Failed ("Static expressions not evaluated exactly: #1");
+      end if;
+
+      if ((Pi*Rad_To_Deg)*2.0 + 4.0*Quarter)/16.0 /= Rad_To_Deg*(Pi/4.0) then
+         Report.Failed ("Static expressions not evaluated exactly: #2");
+      end if;
+   end;
+
+
+   Report.Result;
+end C490003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49020a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49020a.ada
new file mode 100644
index 000000000..ebd2fde9a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49020a.ada
@@ -0,0 +1,73 @@
+-- C49020A.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 ENUMERATION LITERALS (INCLUDING CHARACTER LITERALS) CAN BE
+-- USED IN STATIC EXPRESSIONS TOGETHER WITH RELATIONAL AND EQUALITY 
+-- OPERATORS.
+
+-- L.BROWN   09/30/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE  C49020A  IS
+
+     CAS_BOL : BOOLEAN := TRUE;
+     OBJ1 : INTEGER := 4;
+     TYPE ENUM IS (RED,GREEN,BLUE,OFF,ON,'A','B');
+
+BEGIN
+     TEST("C49020A","ENUMERATION LITERALS (INCLUDING CHARACTER "&
+                    "LITERALS) TOGETHER WITH RELATIONAL OPERATORS "&
+                    "CAN BE USED IN STATIC EXPRESSION");
+
+     CASE CAS_BOL IS
+          WHEN (RED <= BLUE) =>
+               OBJ1 := 5;
+          WHEN (BLUE = GREEN) =>
+               FAILED("INCORRECT VALUE RETURNED BY ENUMERATION "&
+                      "EXPRESSION 1");
+     END CASE;
+
+     CAS_BOL := TRUE;
+
+     CASE CAS_BOL IS
+          WHEN (GREEN >= ON) =>
+               FAILED("INCORRECT VALUE RETURNED BY ENUMERATION "&
+                      "EXPRESSION 2");
+          WHEN (ENUM'('A') < ENUM'('B')) =>
+               OBJ1 := 6;
+     END CASE;
+
+     CAS_BOL := TRUE;
+
+     CASE CAS_BOL IS
+          WHEN (BLUE > 'B') =>
+               FAILED("INCORRECT VALUE RETURNED BY ENUMERATION "&
+                      "EXPRESSION 3");
+          WHEN (OFF /= 'A') =>
+               OBJ1 := 7;
+     END CASE;
+
+     RESULT;
+
+END C49020A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49021a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49021a.ada
new file mode 100644
index 000000000..b58fcd468
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49021a.ada
@@ -0,0 +1,83 @@
+-- C49021A.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 BOOLEAN LITERALS CAN BE USED IN STATIC EXPRESSIONS 
+-- TOGETHER WITH THE LOGICAL OPERATORS, THE NOT OPERATOR, AND THE
+-- RELATIONAL AND EQUALITY OPERATORS.
+
+-- L.BROWN  09/25/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE  C49021A  IS
+
+     CAS_BOL : BOOLEAN := TRUE;
+     X1 : CONSTANT := BOOLEAN'POS((TRUE AND FALSE)OR(TRUE AND TRUE));
+     X2 : CONSTANT := BOOLEAN'POS((TRUE <= FALSE)AND(FALSE >= FALSE));
+
+BEGIN
+     TEST("C49021A","BOOLEAN LITERALS TOGETHER WITH CERTAIN OPERATORS,"&
+                    "CAN BE USED IN STATIC EXPRESSIONS.");
+     IF X1 /= 1  THEN
+          FAILED("INCORRECT VALUE RETURNED BY BOOLEAN EXPRESSION 1");
+     END IF;
+
+     IF X2 /= 0  THEN
+          FAILED("INCORRECT VALUE RETURNED BY BOOLEAN EXPRESSION 2");
+     END IF;
+
+     CASE CAS_BOL IS
+          WHEN ((TRUE AND FALSE) XOR (TRUE XOR TRUE)) =>
+               FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
+                      "EXPRESSION 2");
+          WHEN OTHERS =>
+               CAS_BOL := TRUE;
+     END CASE;
+
+     CASE CAS_BOL IS
+          WHEN ((TRUE > FALSE) OR (FALSE <= TRUE)) =>
+               CAS_BOL := TRUE;
+          WHEN OTHERS =>
+               FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
+                      "EXPRESSION 3");
+     END CASE;
+
+     CASE CAS_BOL IS
+          WHEN NOT((TRUE OR FALSE) = (FALSE AND TRUE)) =>
+               CAS_BOL := TRUE;
+          WHEN OTHERS =>
+               FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
+                      "EXPRESSION 4");
+     END CASE;
+
+     CASE CAS_BOL IS
+          WHEN (((TRUE = FALSE) OR (FALSE AND TRUE)) /= (TRUE < TRUE))=>
+               FAILED("INCORRECT VALUE RETURNED BY BOOLEAN " &
+                      "EXPRESSION 5");
+          WHEN OTHERS =>
+               CAS_BOL := TRUE;
+     END CASE;
+
+     RESULT;
+
+END C49021A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49022a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49022a.ada
new file mode 100644
index 000000000..d0cfa9d97
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49022a.ada
@@ -0,0 +1,158 @@
+-- C49022A.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 NAMED NUMBER DECLARATIONS (INTEGER) MAY USE EXPRESSIONS
+-- WITH INTEGERS.
+
+-- BAW 29 SEPT 80
+-- TBN 10/28/85     RENAMED FROM C4A001A.ADA. ADDED RELATIONAL
+--                  OPERATORS AND USE OF NAMED NUMBERS.
+
+WITH REPORT;
+PROCEDURE C49022A IS
+
+     USE REPORT;
+
+     ADD1 : CONSTANT :=   1   +  1;
+     ADD2 : CONSTANT :=   1   + (-1);
+     ADD3 : CONSTANT := (-1)  +   1;
+     ADD4 : CONSTANT := (-1)  + (-1);
+     SUB1 : CONSTANT :=   1   -   1;
+     SUB2 : CONSTANT :=   1   - (-1);
+     SUB3 : CONSTANT := (-1)  -   1;
+     SUB4 : CONSTANT := (-1)  - (-1);
+     MUL1 : CONSTANT :=   1   *   1;
+     MUL2 : CONSTANT :=   1   * (-1);
+     MUL3 : CONSTANT := (-1)  *   1;
+     MUL4 : CONSTANT := (-1)  * (-1);
+     DIV1 : CONSTANT :=   1   /   1;
+     DIV2 : CONSTANT :=   1   / (-1);
+     DIV3 : CONSTANT := (-1)  /   1;
+     DIV4 : CONSTANT := (-1)  / (-1);
+     REM1 : CONSTANT :=  14  REM  5;
+     REM2 : CONSTANT :=  14  REM(-5);
+     REM3 : CONSTANT :=(-14) REM  5;
+     REM4 : CONSTANT :=(-14) REM(-5);
+     MOD1 : CONSTANT :=   4  MOD   3;
+     MOD2 : CONSTANT :=   4  MOD (-3);
+     MOD3 : CONSTANT := (-4) MOD   3;
+     MOD4 : CONSTANT := (-4) MOD (-3);
+     EXP1 : CONSTANT :=   1  ** 1;
+     EXP2 : CONSTANT := (-1) ** 1;
+     ABS1 : CONSTANT := ABS( - 10 );
+     ABS2 : CONSTANT := ABS( + 10 );
+     TOT1 : CONSTANT := ADD1 + SUB1 - MUL1 + DIV1 - REM3 + MOD2 - EXP1;
+     LES1 : CONSTANT := BOOLEAN'POS (1 < 2);
+     LES2 : CONSTANT := BOOLEAN'POS (1 < (-2));
+     LES3 : CONSTANT := BOOLEAN'POS ((-1) < (-2));
+     LES4 : CONSTANT := BOOLEAN'POS (ADD1 < SUB1);
+     GRE1 : CONSTANT := BOOLEAN'POS (2 > 1);
+     GRE2 : CONSTANT := BOOLEAN'POS ((-1) > 2);
+     GRE3 : CONSTANT := BOOLEAN'POS ((-1) > (-2));
+     GRE4 : CONSTANT := BOOLEAN'POS (ADD1 > SUB1);
+     LEQ1 : CONSTANT := BOOLEAN'POS (1 <= 1);
+     LEQ2 : CONSTANT := BOOLEAN'POS ((-1) <= 1);
+     LEQ3 : CONSTANT := BOOLEAN'POS ((-1) <= (-2));
+     LEQ4 : CONSTANT := BOOLEAN'POS (ADD2 <= SUB3);
+     GEQ1 : CONSTANT := BOOLEAN'POS (2 >= 1);
+     GEQ2 : CONSTANT := BOOLEAN'POS ((-2) >= 1);
+     GEQ3 : CONSTANT := BOOLEAN'POS ((-2) >= (-1));
+     GEQ4 : CONSTANT := BOOLEAN'POS (ADD2 >= SUB3);
+     EQU1 : CONSTANT := BOOLEAN'POS (2 = 2);
+     EQU2 : CONSTANT := BOOLEAN'POS ((-2) = 2);
+     EQU3 : CONSTANT := BOOLEAN'POS ((-2) = (-2));
+     EQU4 : CONSTANT := BOOLEAN'POS (ADD2 = SUB3);
+     NEQ1 : CONSTANT := BOOLEAN'POS (2 /= 2);
+     NEQ2 : CONSTANT := BOOLEAN'POS ((-2) /= 1);
+     NEQ3 : CONSTANT := BOOLEAN'POS ((-2) /= (-2));
+     NEQ4 : CONSTANT := BOOLEAN'POS (ADD2 /= SUB3);
+
+
+BEGIN
+     TEST("C49022A","CHECK THAT NAMED NUMBER DECLARATIONS (INTEGER) " &
+                    "MAY USE EXPRESSIONS WITH INTEGERS");
+
+     IF ADD1 /= 2 OR ADD2 /= 0 OR ADD3 /= 0 OR ADD4 /= -2 THEN
+          FAILED("ERROR IN THE ADDING OPERATOR +");
+     END IF;
+
+     IF SUB1 /= 0 OR SUB2 /= 2 OR SUB3 /= -2 OR SUB4 /= 0 THEN
+          FAILED("ERROR IN THE ADDING OPERATOR -");
+     END IF;
+
+     IF MUL1 /= 1 OR MUL2 /= -1 OR MUL3 /= -1 OR MUL4 /= 1 THEN
+          FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
+     END IF;
+
+     IF DIV1 /= 1 OR DIV2 /= -1 OR DIV3 /= -1 OR DIV4 /= 1 THEN
+          FAILED("ERROR IN THE MULTIPLYING OPERATOR /");
+     END IF;
+
+     IF REM1 /= 4 OR REM2 /=  4 OR REM3 /= -4 OR REM4 /= -4 THEN
+          FAILED("ERROR IN THE MULTIPLYING OPERATOR REM");
+     END IF;
+
+     IF MOD1 /= 1 OR MOD2 /= -2 OR MOD3 /= 2 OR MOD4 /= -1 THEN
+          FAILED("ERROR IN THE MULTIPLYING OPERATOR MOD");
+     END IF;
+
+     IF EXP1 /= 1 OR EXP2 /= -1 THEN
+          FAILED("ERROR IN THE EXPONENTIATING OPERATOR");
+     END IF;
+
+     IF ABS1 /= 10 OR ABS2 /= 10 THEN
+          FAILED("ERROR IN THE ABS OPERATOR");
+     END IF;
+
+     IF TOT1 /= 3 THEN
+          FAILED("ERROR IN USING NAMED NUMBERS WITH OPERATORS");
+     END IF;
+
+     IF LES1 /= 1 OR LES2 /= 0 OR LES3 /= 0 OR LES4 /= 0 THEN
+          FAILED("ERROR IN THE LESS THAN OPERATOR");
+     END IF;
+
+     IF GRE1 /= 1 OR GRE2 /= 0 OR GRE3 /= 1 OR GRE4 /= 1 THEN
+          FAILED("ERROR IN THE GREATER THAN OPERATOR");
+     END IF;
+
+     IF LEQ1 /= 1 OR LEQ2 /= 1 OR LEQ3 /= 0 OR LEQ4 /= 0 THEN
+          FAILED("ERROR IN THE LESS THAN EQUAL OPERATOR");
+     END IF;
+
+     IF GEQ1 /= 1 OR GEQ2 /= 0 OR GEQ3 /= 0 OR GEQ4 /= 1 THEN
+          FAILED("ERROR IN THE GREATER THAN EQUAL OPERATOR");
+     END IF;
+
+     IF EQU1 /= 1 OR EQU2 /= 0 OR EQU3 /= 1 OR EQU4 /= 0 THEN
+          FAILED("ERROR IN THE EQUAL OPERATOR");
+     END IF;
+
+     IF NEQ1 /= 0 OR NEQ2 /= 1 OR NEQ3 /= 0 OR NEQ4 /= 1 THEN
+          FAILED("ERROR IN THE NOT EQUAL OPERATOR");
+     END IF;
+
+     RESULT;
+
+END C49022A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49022b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49022b.ada
new file mode 100644
index 000000000..a7fe57e3c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49022b.ada
@@ -0,0 +1,73 @@
+-- C49022B.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 NUMBER DECLARATIONS, IDENTIFIERS CORRECTLY REPRESENT
+-- VALUES OF OTHER LITERALS.
+
+-- BAW 29 SEPT 80
+-- TBN 10/22/85     RENAMED FROM C4A003A.ADA AND ADDED RELATIONAL 
+--                  OPERATORS USING NAMED NUMBERS.
+
+
+WITH REPORT;
+PROCEDURE C49022B IS
+
+     USE REPORT;
+
+     A : CONSTANT := 10;                     -- A =  10
+     B : CONSTANT := 25 - (2 * A);           -- B =   5
+     C : CONSTANT := A / B;                  -- C =   2
+     D : CONSTANT := (C * A) - (B - C);      -- D =  17
+     E : CONSTANT := D ** C;                 -- E = 289
+     F : CONSTANT := (E MOD A) + 1;          -- F =  10
+     G : CONSTANT := A REM B + C + D + E + ABS(-F);  -- G = 318
+     H : CONSTANT := BOOLEAN'POS (A > B);    -- H = 1
+     I : CONSTANT := BOOLEAN'POS (A < B);    -- I = 0
+     J : CONSTANT := BOOLEAN'POS (C >= A);   -- J = 0
+     K : CONSTANT := BOOLEAN'POS (B <= B);   -- K = 1
+     L : CONSTANT := BOOLEAN'POS (D = A);    -- L = 0
+     M : CONSTANT := BOOLEAN'POS (A /= F);   -- M = 0
+
+BEGIN
+     TEST("C49022B","CHECK THAT IN NUMBER DECLARATIONS, IDENTIFIERS " &
+                    "CORRECTLY REPRESENT VALUES OF OTHER LITERALS");
+
+     IF G /= 318 THEN
+          FAILED("USE OF OTHER NUMBER DECLARATIONS GIVES " &
+                 "WRONG RESULTS");
+     END IF;
+
+     IF H /= 1 OR I /= 0 OR J /= 0 OR K /= 1 THEN
+          FAILED("USE OF NAMED NUMBERS AND RELATIONAL OPERATORS " &
+                 "GIVES WRONG RESULTS");
+     END IF;
+
+     IF L /= 0 OR M /= 0 THEN
+          FAILED("USE OF NAMED NUMBERS AND EQUALITY OPERATORS " &
+                 "GIVES WRONG RESULTS");
+     END IF;
+
+     RESULT;
+
+END C49022B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49022c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49022c.ada
new file mode 100644
index 000000000..69822c83a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49022c.ada
@@ -0,0 +1,170 @@
+-- C49022C.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 NAMED NUMBER DECLARATIONS (REAL) MAY USE EXPRESSIONS
+-- WITH REALS.
+
+-- BAW 29 SEPT 80
+-- TBN 10/24/85     RENAMED FROM C4A011A.ADA. ADDED RELATIONAL
+--                  OPERATORS AND NAMED NUMBERS.
+
+WITH REPORT;
+PROCEDURE C49022C IS
+
+     USE REPORT;
+
+     ADD1 : CONSTANT :=   2.5  +   1.5;
+     ADD2 : CONSTANT :=   2.5  + (-1.5);
+     ADD3 : CONSTANT := (-2.5) +   1.5;
+     ADD4 : CONSTANT := (-2.5) + (-1.5);
+     SUB1 : CONSTANT :=   2.5  -   1.5;
+     SUB2 : CONSTANT :=   2.5  - (-1.5);
+     SUB3 : CONSTANT := (-2.5) -   1.5;
+     SUB4 : CONSTANT := (-2.5) - (-1.5);
+     MUL1 : CONSTANT :=   2.5  *   1.5;
+     MUL2 : CONSTANT :=   2.5  * (-1.5);
+     MUL3 : CONSTANT := (-2.5) *   1.5;
+     MUL4 : CONSTANT := (-2.5) * (-1.5);
+     MLR1 : CONSTANT :=   2    *   1.5;
+     MLR2 : CONSTANT := (-2)   *   1.5;
+     MLR3 : CONSTANT :=   2    * (-1.5);
+     MLR4 : CONSTANT := (-2)   * (-1.5);
+     MLL1 : CONSTANT :=  1.5   *    2 ;
+     MLL2 : CONSTANT :=  1.5   *  (-2);
+     MLL3 : CONSTANT :=(-1.5)  *    2 ;
+     MLL4 : CONSTANT :=(-1.5)  *  (-2);
+     DIV1 : CONSTANT :=   3.75  /   2.5;
+     DIV2 : CONSTANT :=   3.75  / (-2.5);
+     DIV3 : CONSTANT := (-3.75) /   2.5;
+     DIV4 : CONSTANT := (-3.75) / (-2.5);
+     DVI1 : CONSTANT :=   3.0   /   2;
+     DVI2 : CONSTANT := (-3.0)  /   2;
+     DVI3 : CONSTANT :=   3.0   / (-2);
+     DVI4 : CONSTANT := (-3.0)  / (-2);
+     EXP1 : CONSTANT :=   2.0  **   1;
+     EXP2 : CONSTANT :=   2.0  ** (-1);
+     EXP3 : CONSTANT := (-2.0) **   1;
+     EXP4 : CONSTANT := (-2.0) ** (-1);
+     ABS1 : CONSTANT := ABS( - 3.75 );
+     ABS2 : CONSTANT := ABS( + 3.75 );
+     TOT1 : CONSTANT := ADD1 + SUB4 - MUL1 + DIV1 - EXP2 + ABS1;
+     LES1 : CONSTANT := BOOLEAN'POS (1.5 < 2.0);
+     LES2 : CONSTANT := BOOLEAN'POS (1.5 < (-2.0));
+     LES3 : CONSTANT := BOOLEAN'POS ((-1.5) < (-2.0));
+     LES4 : CONSTANT := BOOLEAN'POS (ADD2 < SUB1);
+     GRE1 : CONSTANT := BOOLEAN'POS (2.0 > 1.5);
+     GRE2 : CONSTANT := BOOLEAN'POS ((-2.0) > 1.5);
+     GRE3 : CONSTANT := BOOLEAN'POS ((-2.0) > (-1.5));
+     GRE4 : CONSTANT := BOOLEAN'POS (ADD1 > SUB1);
+     LEQ1 : CONSTANT := BOOLEAN'POS (1.5 <= 2.0);
+     LEQ2 : CONSTANT := BOOLEAN'POS (1.5 <= (-2.0));
+     LEQ3 : CONSTANT := BOOLEAN'POS ((-1.5) <= (-2.0));
+     LEQ4 : CONSTANT := BOOLEAN'POS (ADD2 <= SUB1);
+     GEQ1 : CONSTANT := BOOLEAN'POS (2.0 >= 1.5);
+     GEQ2 : CONSTANT := BOOLEAN'POS ((-2.0) >= 1.5);
+     GEQ3 : CONSTANT := BOOLEAN'POS ((-2.0) >= (-1.5));
+     GEQ4 : CONSTANT := BOOLEAN'POS (ADD1 >= SUB2);
+     EQU1 : CONSTANT := BOOLEAN'POS (1.5 = 2.0);
+     EQU2 : CONSTANT := BOOLEAN'POS ((-1.5) = 2.0);
+     EQU3 : CONSTANT := BOOLEAN'POS ((-1.5) = (-1.5));
+     EQU4 : CONSTANT := BOOLEAN'POS (ADD1 = SUB2);
+     NEQ1 : CONSTANT := BOOLEAN'POS (1.5 /= 1.5);
+     NEQ2 : CONSTANT := BOOLEAN'POS ((-1.5) /= 1.5);
+     NEQ3 : CONSTANT := BOOLEAN'POS ((-1.5) /= (-2.0));
+     NEQ4 : CONSTANT := BOOLEAN'POS (ADD1 /= SUB2);
+
+
+BEGIN
+     TEST("C49022C","CHECK THAT NAMED NUMBER DECLARATIONS (REAL) " &
+                    "MAY USE EXPRESSIONS WITH REALS.");
+
+     IF ADD1 /= 4.0 OR ADD2 /= 1.0 OR ADD3 /= -1.0 OR ADD4 /= -4.0 THEN
+          FAILED("ERROR IN THE ADDING OPERATOR +");
+     END IF;
+
+     IF SUB1 /= 1.0 OR SUB2 /= 4.0 OR SUB3 /= -4.0 OR SUB4 /= -1.0 THEN
+          FAILED("ERROR IN THE ADDING OPERATOR -");
+     END IF;
+
+     IF MUL1 /= 3.75 OR MUL2 /= -3.75 OR
+        MUL3 /= -3.75 OR MUL4 /= 3.75 THEN
+          FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
+     END IF;
+
+     IF MLR1 /= 3.0 OR MLR2 /= -3.0 OR
+        MLR3 /= -3.0 OR MLR4 /= 3.0 THEN
+          FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
+     END IF;
+
+     IF MLL1 /= 3.0 OR MLL2 /= -3.0 OR MLL3 /= -3.0 OR MLL4 /= 3.0 THEN
+          FAILED("ERROR IN THE MULTIPLYING OPERATOR *");
+     END IF;
+
+     IF DIV1 /= 1.5 OR DIV2 /= -1.5 OR DIV3 /= -1.5 OR DIV4 /= 1.5 THEN
+          FAILED("ERROR IN THE MULTIPLYING OPERATOR /");
+     END IF;
+
+     IF DVI1 /= 1.5 OR DVI2 /= -1.5 OR DVI3 /= -1.5 OR DVI4 /= 1.5 THEN
+          FAILED("ERROR IN THE MULTIPLYING OPERATOR /");
+     END IF;
+
+     IF EXP1 /= 2.0 OR EXP2 /= 0.5 OR EXP3 /= -2.0 OR EXP4 /= -0.5 THEN
+          FAILED("ERROR IN THE EXPONENTIATING OPERATOR");
+     END IF;
+
+     IF ABS1 /= 3.75 OR ABS2 /= 3.75 THEN
+          FAILED("ERROR IN THE ABS OPERATOR");
+     END IF;
+
+     IF TOT1 /= 4.00 THEN
+          FAILED("ERROR IN USE OF NAMED NUMBERS WITH OPERATORS");
+     END IF;
+
+     IF LES1 /= 1 OR LES2 /= 0 OR LES3 /= 0 OR LES4 /= 0 THEN
+          FAILED("ERROR IN THE LESS THAN OPERATOR");
+     END IF;
+
+     IF GRE1 /= 1 OR GRE2 /= 0 OR GRE3 /= 0 OR GRE4 /= 1 THEN
+          FAILED("ERROR IN THE GREATER THAN OPERATOR");
+     END IF;
+
+     IF LEQ1 /= 1 OR LEQ2 /= 0 OR LEQ3 /= 0 OR LEQ4 /= 1 THEN
+          FAILED("ERROR IN THE LESS THAN EQUAL OPERATOR");
+     END IF;
+
+     IF GEQ1 /= 1 OR GEQ2 /= 0 OR GEQ3 /= 0 OR GEQ4 /= 1 THEN
+          FAILED("ERROR IN THE GREATER THAN EQUAL OPERATOR");
+     END IF;
+
+     IF EQU1 /= 0 OR EQU2 /= 0 OR EQU3 /= 1 OR EQU4 /= 1 THEN
+          FAILED("ERROR IN THE EQUAL OPERATOR");
+     END IF;
+
+     IF NEQ1 /= 0 OR NEQ2 /= 1 OR NEQ3 /= 1 OR NEQ4 /= 0 THEN
+          FAILED("ERROR IN THE NOT EQUAL OPERATOR");
+     END IF;
+
+     RESULT;
+
+END C49022C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49023a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49023a.ada
new file mode 100644
index 000000000..052034270
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49023a.ada
@@ -0,0 +1,117 @@
+-- C49023A.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 CONSTANT DECLARED BY AN OBJECT DECLARATION CAN BE USED
+-- IN A STATIC EXPRESSION IF THE CONSTANT WAS DECLARED WITH A STATIC
+-- SUBTYPE AND INITIALIZED WITH A STATIC EXPRESSION.
+
+-- L.BROWN  10/01/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE  C49023A  IS
+
+BEGIN
+     TEST("C49023A","A CONSTANT DECLARED BY AN OBJECT DECLARATION "&
+                    "UNDER CERTAIN CONDITIONS CAN BE USED IN A "&
+                    "STATIC EXPRESSION");
+     DECLARE
+          TYPE ENUM IS (RED,GREEN,BLUE,YELLOW);
+          SUBTYPE SENUM IS ENUM RANGE RED .. BLUE;
+          CONEN : CONSTANT SENUM := GREEN;
+          TYPE INT IS RANGE 1 .. 10;
+          SUBTYPE SINT IS INT RANGE 1 .. 5;
+          CONIN : CONSTANT SINT := 3;
+          TYPE FLT IS DIGITS 3 RANGE 0.0 .. 25.0;
+          SUBTYPE SFLT IS FLT RANGE 10.0 .. 20.0;
+          CONFL : CONSTANT SFLT := 11.0;
+          TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 25.0;
+          SUBTYPE SFIX IS FIX RANGE 0.0 .. 12.0;
+          CONFI : CONSTANT SFIX := 0.25;
+          CAS_EN : ENUM := CONEN;
+          TYPE ITEG IS RANGE 1 .. CONIN;
+          TYPE FLTY IS DIGITS CONIN;
+          TYPE FIXY IS DELTA CONFI RANGE 0.0 .. 10.0;
+          TYPE REAL IS DELTA 0.25 RANGE 0.0 .. 11.0;
+          TYPE FIXTY IS DELTA 0.25 RANGE 0.0 .. CONFL;
+
+          FUNCTION IDENT_REAL (X : REAL) RETURN REAL;
+
+          PACKAGE P IS
+               TYPE T IS PRIVATE;
+               CON1 : CONSTANT T;
+          PRIVATE
+               TYPE T IS NEW INTEGER;
+               CON1 : CONSTANT T := 10;
+               TYPE NINT IS RANGE 1 .. CON1;
+          END P;
+          PACKAGE BODY P IS
+               TYPE CON2 IS RANGE CON1 .. 50;
+          BEGIN
+               IF NINT'LAST /= NINT(IDENT_INT(10)) THEN
+                    FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 1");
+               END IF;
+               IF CON2'FIRST /= CON2(IDENT_INT(10)) THEN
+                    FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 2");
+               END IF;
+          END P;
+
+          FUNCTION IDENT_REAL (X : REAL) RETURN REAL IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN X;
+               ELSE
+                    RETURN 0.0;
+               END IF;
+          END IDENT_REAL;
+
+     BEGIN
+
+          IF ITEG'LAST /= ITEG(IDENT_INT(3))  THEN
+               FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 3");
+          END IF;
+
+          IF FLTY'DIGITS /= IDENT_INT(3)  THEN
+               FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 4");
+          END IF;
+
+          IF FIXY'DELTA /= IDENT_REAL(0.25)  THEN
+               FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 5");
+          END IF;
+
+          IF FIXTY'LAST /= FIXTY(IDENT_REAL(11.0)) THEN
+               FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 6");
+          END IF;
+
+          CASE CAS_EN IS
+               WHEN CONEN =>
+                    CAS_EN := RED;
+               WHEN OTHERS =>
+                    FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 7");
+          END CASE;
+
+     END;
+
+     RESULT;
+
+END C49023A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49024a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49024a.ada
new file mode 100644
index 000000000..df815794a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49024a.ada
@@ -0,0 +1,134 @@
+-- C49024A.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 FUNCTION CALL CAN APPEAR IN A STATIC EXPRESSION IF THE
+-- FUNCTION NAME DENOTES A PREDEFINED OPERATOR AND HAS THE FORM OF AN
+-- OPERATOR SYMBOL OR AN EXPANDED NAME WHOSE SELECTOR IS AN OPERATOR
+-- SYMBOL.
+
+-- L.BROWN  10/02/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE  C49024A  IS
+
+     PACKAGE P IS
+          TYPE TY IS NEW INTEGER;
+     END P;
+
+     CON1 : CONSTANT P.TY := 3;
+     CON2 : CONSTANT P.TY := 4;
+     TYPE INT1 IS RANGE 1 .. P."+"(CON1,CON2);
+     CON3 : CONSTANT := 5;
+     CON4 : CONSTANT := 7;
+     TYPE FLT IS DIGITS "-"(CON4,CON3);
+     TYPE FIX1 IS DELTA 1.0 RANGE 0.0 .. 25.0;
+     CON5 : CONSTANT := 3.0;
+     CON6 : CONSTANT := 6.0;
+     TYPE FIX2 IS DELTA 1.0 RANGE 0.0 .. "/"(CON6,CON5);
+     TYPE ENUM IS (RED,BLUE,GREEN,BLACK);
+     CON7 : CONSTANT BOOLEAN := TRUE;
+     CON8 : CONSTANT ENUM := BLUE;
+     CAS_INT1 : CONSTANT := 10;
+     CAS_INT2 : CONSTANT := 2;
+     OBJ1 : INTEGER := 10;
+     CAS_BOL : BOOLEAN := TRUE;
+     CON9 : CONSTANT ENUM := BLACK;
+     CON10 : CONSTANT FIX1 := 2.0;
+     CON11 : CONSTANT FIX1 := 10.0;
+     TYPE FIX3 IS DELTA "+"(CON10) RANGE 0.0 .. 20.0;
+     TYPE INT2 IS RANGE 0 .. "ABS"("-"(CON4));
+     CON12 : CONSTANT CHARACTER := 'D';
+     CON13 : CONSTANT CHARACTER := 'B';
+     CON14 : CONSTANT BOOLEAN := FALSE;
+     CON15 : CONSTANT := 10;
+
+BEGIN
+
+     TEST("C49024A","A FUNCTION CALL CAN BE IN A STATIC EXPRESSION "&
+                    "IF THE FUNCTION NAME DENOTES A PREDEFINED "&
+                    "OPERATOR AND HAS THE FORM OF AN OPERATOR SYMBOL");
+
+     CASE CAS_BOL IS
+          WHEN ("NOT"(CON7)) =>
+               FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                      "OPERATORS 1");
+          WHEN ("/="(CON8,CON9)) =>
+               OBJ1 := 2;
+     END CASE;
+     CAS_BOL := TRUE;
+
+     CASE CAS_BOL IS
+          WHEN ("*"(CON3,CON4) = CAS_INT1) =>
+               FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                      "OPERATORS 2");
+          WHEN ("ABS"(CON15) = CAS_INT1) =>
+               OBJ1 := 3;
+     END CASE;
+     CAS_BOL := TRUE;
+
+     CASE CAS_BOL IS
+          WHEN ("<"(CON11,CON10)) =>
+               FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                      "OPERATORS 3");
+          WHEN ("<="(CON13,CON12)) =>
+               OBJ1 := 4;
+     END CASE;
+     CAS_BOL := TRUE;
+
+     CASE CAS_BOL IS
+          WHEN ("REM"(CON4,CON3) = CAS_INT2) =>
+               OBJ1 := 5;
+          WHEN ("**"(CON3,CON4) = CAS_INT2) =>
+               FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                      "OPERATORS 4");
+     END CASE;
+
+     CASE CAS_BOL IS
+          WHEN (P.">"(CON1,CON2)) =>
+               FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                      "OPERATORS 5");
+          WHEN ("OR"(CON7,CON14)) =>
+               OBJ1 := 6;
+     END CASE;
+     CAS_BOL := TRUE;
+
+     CASE CAS_BOL IS
+          WHEN ("MOD"(CON4,CON3) = CAS_INT2) =>
+               OBJ1 := 7;
+          WHEN ("ABS"(CON4) = CAS_INT2) =>
+               FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                      "OPERATORS 6");
+     END CASE;
+
+     CASE CAS_BOL IS
+          WHEN ("AND"(CON7,CON14)) =>
+               FAILED("INCORRECT VALUE RETURNED FOR STATIC "&
+                      "OPERATORS 7");
+          WHEN (">="(CON12,CON13)) =>
+               OBJ1 := 9;
+     END CASE;
+
+     RESULT;
+
+END C49024A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49025a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49025a.ada
new file mode 100644
index 000000000..be15cbde2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49025a.ada
@@ -0,0 +1,104 @@
+-- C49025A.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 CERTAIN ATTRIBUTES CAN BE USED IN STATIC EXPRESSIONS
+-- SUCH AS: 'SUCC, 'PRED, 'POS, 'VAL, 'AFT, 'DELTA, 'DIGITS, 'FIRST,
+--'FORE, 'LAST, 'MACHINE_EMAX, 'MACHINE_EMIN, 'MACHINE_MANTISSA, 
+--'MACHINE_OVERFLOWS, 'MACHINE_RADIX, 'MACHINE_ROUNDS, 'SIZE, 'SMALL, 'WIDTH.
+
+-- L.BROWN  10/07/86
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C49025A  IS
+
+     TYPE ENUM IS (RED,BLUE,GREEN,BLACK);
+     TYPE FIX IS DELTA 0.125 RANGE 0.0 .. 20.0;
+     TYPE FLT IS DIGITS 3 RANGE 0.0 .. 25.0;
+     TYPE INT IS RANGE 1 .. 100;
+     TYPE TINT1 IS RANGE 1 .. ENUM'POS(BLUE);
+     TYPE TFLT IS DIGITS FIX'AFT RANGE 0.0 .. 10.0;
+     TYPE TFIX2 IS DELTA FIX'DELTA RANGE 0.0 .. 5.0;
+     TYPE TFLT1 IS DIGITS FLT'DIGITS;
+     TYPE ITN IS RANGE 0 .. INT'FIRST;
+     TYPE TINT2 IS RANGE 1 .. FIX'FORE;
+     TYPE TFLT3 IS DIGITS 3 RANGE 5.0 .. FLT'LAST;
+     CON3 : CONSTANT := FLT'MACHINE_EMAX;
+     TYPE TINT3 IS RANGE FLT'MACHINE_EMIN .. 1;
+     CON4 : CONSTANT := FLT'MACHINE_MANTISSA;
+     TYPE TINT4 IS RANGE 1 .. FLT'MACHINE_RADIX;
+     CON6 : CONSTANT := INT'SIZE;
+     TYPE TFIX5 IS DELTA 0.125 RANGE 0.0 .. FIX'SMALL;
+     TYPE TINT6 IS RANGE 1 .. ENUM'WIDTH;
+     OBJ1 : INTEGER := 1;
+     CAS_OBJ : BOOLEAN := TRUE;
+
+BEGIN
+
+     TEST("C49025A","CHECK THAT CERTAIN ATTRIBUTES CAN "&
+                    "BE USED IN STATIC EXPRESSIONS.");
+
+     CASE CAS_OBJ IS
+          WHEN (ENUM'PRED(BLUE) = ENUM'(RED)) =>
+               OBJ1 := 2;
+          WHEN OTHERS =>
+               FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 1");
+     END CASE;
+     CAS_OBJ := TRUE;
+
+     CASE CAS_OBJ IS
+          WHEN (ENUM'SUCC(RED) = ENUM'(BLUE)) =>
+               OBJ1 := 3;
+          WHEN OTHERS =>
+               FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 2");
+     END CASE;
+     CAS_OBJ := TRUE;
+
+     CASE CAS_OBJ IS
+          WHEN (ENUM'VAL(3) = ENUM'(BLACK)) =>
+               OBJ1 := 4;
+          WHEN OTHERS =>
+               FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 3");
+     END CASE;
+     CAS_OBJ := TRUE;
+
+     CASE CAS_OBJ IS
+          WHEN (TRUE OR FLT'MACHINE_OVERFLOWS) =>
+               OBJ1 := 5;
+          WHEN OTHERS =>
+               FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 4");
+     END CASE;
+     CAS_OBJ := FALSE;
+
+     CASE CAS_OBJ IS
+          WHEN (FALSE AND FIX'MACHINE_ROUNDS) =>
+               OBJ1 := 6;
+          WHEN OTHERS =>
+               FAILED("INCORRECT VALUE RETURNED FOR ATTRIBUTE 5");
+     END CASE;
+
+     RESULT;
+
+END C49025A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49026a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49026a.ada
new file mode 100644
index 000000000..c4cffa729
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c49026a.ada
@@ -0,0 +1,59 @@
+-- C49026A.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 QUALIFIED EXPRESSION CAN APPEAR IN A STATIC EXPRESSION.
+
+-- L.BROWN  10/07/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  C49026A  IS
+
+     TYPE ENUM IS (RED,GREEN,BLUE,YELLOW);
+     TYPE INT1 IS RANGE 1 .. 50;
+     TYPE FLT1 IS DIGITS 3 RANGE 1.0 .. 5.0;
+     TYPE FIX1 IS DELTA 0.125 RANGE 0.0 .. 10.0;
+     TYPE INT2 IS RANGE 1 .. INT1'(25);
+     TYPE FLT2 IS DIGITS 3 RANGE 1.0 .. FLT1'(2.0);
+     TYPE FIX2 IS DELTA 0.125 RANGE 0.0 .. FIX1'(5.0);
+     TYPE FLT3 IS DIGITS INT1'(3);
+     TYPE FIX3 IS DELTA FIX1'(0.125) RANGE 0.0 .. 5.0;
+     OBJ1 : INTEGER := 2;
+     CAS_OBJ : ENUM := GREEN;
+
+BEGIN
+
+     TEST("C49026A","QUALIFIED EXPRESSIONS CAN APPEAR IN STATIC "&
+                    "EXPRESSIONS");
+
+     CASE CAS_OBJ IS
+          WHEN ENUM'(GREEN) =>
+               OBJ1 := 3;
+          WHEN OTHERS =>
+               FAILED("INCORRECT VALUE FOR QUALIFIED EXPRESSION 1");
+     END CASE;
+
+     RESULT;
+
+END C49026A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a005b.ada
new file mode 100644
index 000000000..371077f45
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a005b.ada
@@ -0,0 +1,104 @@
+-- C4A005B.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 NONSTATIC UNIVERSAL INTEGER EXPRESSION RAISES
+-- CONSTRAINT_ERROR IF DIVISION BY ZERO IS ATTEMPTED
+-- OR IF THE SECOND OPERAND OF REM OR MOD IS ZERO.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- JBG 5/2/85
+-- EG  10/24/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+--               AI-00387; PREVENT DEAD VARIABLE OPTIMIZATION
+-- MRM 03/30/93  REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+PROCEDURE C4A005B IS
+BEGIN
+     TEST("C4A005B", "CHECK CONSTRAINT_ERROR FOR " &
+                     "NONSTATIC UNIVERSAL " &
+                     "INTEGER EXPRESSIONS - DIVISION BY ZERO");
+     BEGIN
+          DECLARE
+               X : BOOLEAN := 1 = 1/INTEGER'POS(IDENT_INT(0));
+          BEGIN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - DIV");
+               IF X /= IDENT_BOOL(X) THEN
+                    FAILED ("WRONG RESULT - DIV");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION IN WRONG PLACE - DIV");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED FOR / BY 0");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - DIV");
+     END;
+
+     BEGIN
+          DECLARE
+               X : BOOLEAN := 1 = 1 REM INTEGER'POS(IDENT_INT(0));
+          BEGIN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - REM");
+               IF X /= IDENT_BOOL(X) THEN
+                    FAILED ("WRONG RESULT - REM");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION IN WRONG PLACE - REM");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED FOR REM BY 0");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - REM");
+     END;
+
+     BEGIN
+          DECLARE
+               X : BOOLEAN := 1 = INTEGER'POS(IDENT_INT(1)) MOD 0;
+          BEGIN
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - MOD");
+               IF X /= IDENT_BOOL(X) THEN
+                    FAILED ("WRONG RESULT - MOD");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION IN WRONG PLACE - MOD");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED FOR MOD BY 0");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - MOD");
+     END;
+
+     RESULT;
+
+END C4A005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a006a.ada
new file mode 100644
index 000000000..5ba984a7a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a006a.ada
@@ -0,0 +1,61 @@
+-- C4A006A.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 A UNIVERSAL_INTEGER 
+-- EXPRESSION CONTAINING AN EXPONENTIATION OPERATOR IF THE EXPONENT
+-- HAS A NEGATIVE VALUE.
+
+-- BAW 9/29/80
+-- SPS 4/7/82
+-- TBN 10/23/85     RENAMED FROM B4A006A-B.ADA. REVISED TO CHECK FOR
+--                  CONSTRAINT_ERROR WHEN EXPONENT IS NEGATIVE IN
+--                  A NONSTATIC CONTEXT.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C4A006A IS
+
+BEGIN 
+     TEST ("C4A006A", "CHECK THAT A NEGATIVE EXPONENT IN " &
+                      "UNIVERSAL_INTEGER EXPONENTIATION RAISES " &
+                      "CONSTRAINT_ERROR");
+
+     DECLARE
+          B : BOOLEAN;
+     BEGIN
+
+          B := (1 ** IDENT_INT(-1)) = 1;
+          FAILED ("EXCEPTION NOT RAISED");
+          IF NOT B THEN
+               FAILED ("(1 ** (-1)) /= 1");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;     
+
+     RESULT;
+END C4A006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a007a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a007a.tst
new file mode 100644
index 000000000..56850ca3e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a007a.tst
@@ -0,0 +1,47 @@
+-- C4A007A.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.
+--*
+-- USE OF MAX_INT IN NUMBER DECLARATION
+
+-- BAW 29 SEPT 80
+
+WITH REPORT;
+PROCEDURE C4A007A IS
+
+     USE REPORT;
+
+     X : CONSTANT := $MAX_INT - ($MAX_INT MOD 2);
+     Y : CONSTANT := ($MAX_INT / 2) * 2;
+
+BEGIN TEST("C4A007A","USING THE INTEGER VALUE  MAX_INT IN NUMBER " &
+           " DECLARATIONS ");
+
+      IF X /= Y
+      THEN FAILED("USING THE INTEGER VALUE MAX_INT GIVES " &
+                  " GIVES WRONG RESULTS ");
+      END IF;
+
+      RESULT;
+
+END C4A007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a010a.ada
new file mode 100644
index 000000000..e6dfe7e38
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a010a.ada
@@ -0,0 +1,80 @@
+-- C4A010A.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 STATIC UNIVERSAL_REAL EXPRESSIONS ARE EVALUATED EXACTLY.
+
+-- SMALL RATIONAL NUMBERS ARE USED IN THIS TEST.
+
+-- JBG 5/3/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C4A010A IS
+
+     C13 : CONSTANT := 1.0/3.0;
+     C47 : CONSTANT := 4.0/7.0;
+     C112: CONSTANT := 13.0/12.0;
+     HALF: CONSTANT := 3.5/7.0;
+
+BEGIN
+
+     TEST ("C4A010A", "CHECK STATIC UNIVERSAL_REAL ACCURACY FOR " &
+                      "SMALL RATIONAL NUMBERS");
+
+     IF C13 - C47 /= -5.0/21.0 THEN
+          FAILED ("REAL SUBTRACTION RESULT INCORRECT");
+     END IF;
+
+     IF C47 + C112 = 1.0 + 55.0/84.0 THEN
+          NULL;
+     ELSE
+          FAILED ("REAL ADDITION RESULT INCORRECT");
+     END IF;
+
+     IF C112 - C13 /= 6.0/8.0 THEN
+          FAILED ("LCD NOT FOUND");
+     END IF;
+
+     IF 0.1 * 0.1 /= 0.01 THEN
+          FAILED ("REAL MULTIPLICATION RESULT INCORRECT");
+     END IF;
+
+     IF C112/C13 /= 13.0/4 THEN
+          FAILED ("REAL QUOTIENT RESULT INCORRECT");
+     END IF;
+
+     IF 0.1 ** 4 /= 0.0001 THEN
+          FAILED ("POSITIVE EXPONENTIATION RESULT INCORRECT");
+     END IF;
+
+     IF C13 ** (-3) /= 27.0 * 0.5 * 2 THEN
+          FAILED ("NEGATIVE EXPONENTIATION RESULT INCORRECT");
+     END IF;
+
+     IF HALF /= 0.1/0.2 THEN
+          FAILED ("FRACTIONAL NUMERATOR AND DENOMINATOR");
+     END IF;
+
+     RESULT;
+
+END C4A010A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a010b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a010b.ada
new file mode 100644
index 000000000..31cf3d9de
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a010b.ada
@@ -0,0 +1,82 @@
+-- C4A010B.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 STATIC UNIVERSAL REAL EXPRESSIONS ARE EVALUATED 
+-- EXACTLY.  IN PARTICULAR, CHECK THAT THE CASCADING USE OF FRACTIONAL
+-- VALUES DOES NOT RESULT IN THE LOSS OF PRECISION.
+
+-- RJW 7/31/86
+
+WITH REPORT; USE REPORT; 
+PROCEDURE C4A010B IS
+
+
+BEGIN
+
+     TEST( "C4A010B", "CHECK THAT STATIC UNIVERSAL REAL EXPRESSIONS " &
+                      "ARE EVALUATED EXACTLY.  IN PARTICULAR, CHECK " &
+                      "THAT THE CASCADING USE OF FRACTIONAL VALUES " &
+                      "DOES NOT RESULT IN THE LOSS OF PRECISION" );
+
+     DECLARE
+          B : CONSTANT := 2.0/3.0;
+          
+          X0 : CONSTANT := 1.0;
+          X1 : CONSTANT := X0 + B;
+          X2 : CONSTANT := X1 + B ** 2;
+          X3 : CONSTANT := X2 + B ** 3;
+          X4 : CONSTANT := X3 + B ** 4;
+          X5 : CONSTANT := X4 + B ** 5;
+          X6 : CONSTANT := X5 + B ** 6;
+          X7 : CONSTANT := X6 + B ** 7;
+          X8 : CONSTANT := X7 + B ** 8;
+          X9 : CONSTANT := X8 + B ** 9;
+     
+          Y1 : CONSTANT := B ** 10;
+          Y2 : CONSTANT := 1.0;
+          Y3 : CONSTANT := Y1 - Y2;
+          Y4 : CONSTANT := B;
+          Y5 : CONSTANT := Y4 - Y2;
+          Y6 : CONSTANT := Y3 / Y5;
+
+     BEGIN
+          IF X9 /= 58025.0/19683.0 THEN
+               FAILED ( "INCORRECT RESULTS FOR SERIES OF NAMED " &
+                        "NUMBERS  - 1" );
+          END IF;
+          
+          IF Y6 /= 58025.0/19683.0 THEN
+               FAILED ( "INCORRECT RESULTS FOR SERIES OF NAMED " &
+                        "NUMBERS  - 2" );
+          END IF;
+          
+          IF X9 /= Y6 THEN
+               FAILED ( "INCORRECT RESULTS FOR SERIES OF NAMED " &
+                        "NUMBERS  - 3" );
+          END IF;
+          
+     END;   
+     
+     RESULT;
+END C4A010B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a011a.ada
new file mode 100644
index 000000000..374827cc9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a011a.ada
@@ -0,0 +1,334 @@
+-- C4A011A.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 NONSTATIC UNIVERSAL REAL EXPRESSIONS ARE EVALUATED WITH
+-- THE ACCURACY OF THE MOST PRECISE PREDEFINED FLOATING POINT TYPE
+-- (I. E., THE TYPE FOR WHICH 'DIGITS EQUALS SYSTEM.MAX_DIGITS).
+
+-- RJW 8/4/86
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C4A011A IS
+
+     TYPE MAX_FLOAT IS DIGITS MAX_DIGITS;
+
+     C5L : CONSTANT := 16#0.AAAA8#;
+     C5U : CONSTANT := 16#0.AAAAC#;
+
+     C6L : CONSTANT := 16#0.AAAAA8#;
+     C6U : CONSTANT := 16#0.AAAAB0#;
+
+     C7L : CONSTANT := 16#0.AAAAAA8#;
+     C7U : CONSTANT := 16#0.AAAAAB0#;
+
+     C8L : CONSTANT := 16#0.AAAAAAA#;
+     C8U : CONSTANT := 16#0.AAAAAAB#;
+
+     C9L : CONSTANT := 16#0.AAAAAAAA#;
+     C9U : CONSTANT := 16#0.AAAAAAAC#;
+
+     C10L : CONSTANT := 16#0.AAAAAAAAA#;
+     C10U : CONSTANT := 16#0.AAAAAAAAC#;
+
+     C11L : CONSTANT := 16#0.AAAAAAAAA8#;
+     C11U : CONSTANT := 16#0.AAAAAAAAAC#;
+
+     C12L : CONSTANT := 16#0.AAAAAAAAAA8#;
+     C12U : CONSTANT := 16#0.AAAAAAAAAB0#;
+
+     C13L : CONSTANT := 16#0.AAAAAAAAAAA8#;
+     C13U : CONSTANT := 16#0.AAAAAAAAAAB0#;
+
+     C14L : CONSTANT := 16#0.AAAAAAAAAAAA#;
+     C14U : CONSTANT := 16#0.AAAAAAAAAAAB#;
+
+     C15L : CONSTANT := 16#0.AAAAAAAAAAAAA#;
+     C15U : CONSTANT := 16#0.AAAAAAAAAAAAC#;
+
+     C16L : CONSTANT := 16#0.AAAAAAAAAAAAAA#;
+     C16U : CONSTANT := 16#0.AAAAAAAAAAAAAC#;
+
+     C17L : CONSTANT := 16#0.AAAAAAAAAAAAAA8#;
+     C17U : CONSTANT := 16#0.AAAAAAAAAAAAAAC#;
+
+     C18L : CONSTANT := 16#0.AAAAAAAAAAAAAAA8#;
+     C18U : CONSTANT := 16#0.AAAAAAAAAAAAAAB0#;
+
+     C19L : CONSTANT := 16#0.AAAAAAAAAAAAAAAA8#;
+     C19U : CONSTANT := 16#0.AAAAAAAAAAAAAAAB0#;
+
+     C20L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAA#;
+     C20U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAB#;
+
+     C21L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAA#;
+     C21U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAC#;
+
+     C22L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAA#;
+     C22U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAC#;
+
+     C23L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAA8#;
+     C23U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAC#;
+
+     C24L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAA8#;
+     C24U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAB0#;
+
+     C25L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAA8#;
+     C25U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAB0#;
+
+     C26L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAA#;
+     C26U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAB#;
+
+     C27L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAA#;
+     C27U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAC#;
+
+     C28L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAA#;
+     C28U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAC#;
+
+     C29L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAA8#;
+     C29U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAC#;
+
+     C30L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAA8#;
+     C30U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAB0#;
+
+     C31L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAA#;
+     C31U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAB#;
+
+     C32L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAA#;
+     C32U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAB#;
+
+     C33L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAA#;
+     C33U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAC#;
+
+     C34L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAA8#;
+     C34U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAAC#;
+
+     C35L : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAAA8#;
+     C35U : CONSTANT := 16#0.AAAAAAAAAAAAAAAAAAAAAAAAAAAAAC#;
+
+BEGIN
+
+     TEST ( "C4A011A", "CHECK THAT NONSTATIC UNIVERSAL REAL " & 
+                       "EXPRESSIONS ARE EVALUATED WITH THE " &
+                       "ACCURACY OF THE MOST PRECISE PREDEFINED " &
+                       "FLOATING POINT TYPE (I. E., THE TYPE FOR " &
+                       "WHICH 'DIGITS EQUALS SYSTEM.MAX_DIGITS" );
+
+     CASE MAX_DIGITS IS
+          WHEN 5 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C5L ..  C5U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 5" );
+               END IF;
+          WHEN 6 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C6L ..  C6U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 6" );
+               END IF;
+          WHEN 7 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C7L ..  C7U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 7" );
+               END IF;
+          WHEN 8 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C8L ..  C8U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 8" );
+               END IF;
+          WHEN 9 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C9L ..  C9U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 9" );
+               END IF;
+          WHEN 10 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C10L ..  C10U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 10" );
+               END IF;
+          WHEN 11 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C11L ..  C11U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 11" );
+               END IF;
+          WHEN 12 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C12L ..  C12U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 12" );
+               END IF;
+          WHEN 13 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C13L ..  C13U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 13" );
+               END IF;
+          WHEN 14 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C14L ..  C14U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 14" );
+               END IF;
+          WHEN 15 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C15L ..  C15U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 15" );
+               END IF;
+          WHEN 16 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C16L ..  C16U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 16" );
+               END IF;
+          WHEN 17 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C17L ..  C17U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 17" );
+               END IF;
+          WHEN 18 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C18L ..  C18U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 18" );
+               END IF;
+          WHEN 19 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C19L ..  C19U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 19" );
+               END IF;
+          WHEN 20 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C20L ..  C20U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 20" );
+               END IF;
+          WHEN 21 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C21L ..  C21U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 21" );
+               END IF;
+          WHEN 22 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C22L ..  C22U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 22" );
+               END IF;
+          WHEN 23 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C23L ..  C23U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 23" );
+               END IF;
+          WHEN 24 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C24L ..  C24U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 24" );
+               END IF;
+          WHEN 25 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C25L ..  C25U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 25" );
+               END IF;
+          WHEN 26 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C26L ..  C26U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 26" );
+               END IF;
+          WHEN 27 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C27L ..  C27U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 27" );
+               END IF;
+          WHEN 28 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C28L ..  C28U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 28" );
+               END IF;
+          WHEN 29 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C29L ..  C29U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 29" );
+               END IF;
+          WHEN 30 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C30L ..  C30U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 30" );
+               END IF;
+          WHEN 31 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C31L ..  C31U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 31" );
+               END IF;
+          WHEN 32 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C32L ..  C32U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 32" );
+               END IF;
+          WHEN 33 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C33L ..  C33U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 33" );
+               END IF;
+          WHEN 34 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C34L ..  C34U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 34" );
+               END IF;
+          WHEN 35 =>
+               IF (2.0 * INTEGER'POS (IDENT_INT (1))) / 3.0 NOT IN
+                  C35L ..  C35U THEN
+                    FAILED ( "INCORRECT ACCURACY FOR A MAX_DIGITS " &
+                             "VALUE OF 35" );
+               END IF;
+          WHEN OTHERS =>
+               NOT_APPLICABLE ( "MAX_DIGITS OUT OF RANGE OF TEST.  " &
+                                "MAX_DIGITS = " & 
+                                 INTEGER'IMAGE (MAX_DIGITS));
+     END CASE;
+
+     RESULT;
+
+END C4A011A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a012b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a012b.ada
new file mode 100644
index 000000000..70c23ad94
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a012b.ada
@@ -0,0 +1,184 @@
+-- C4A012B.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 CONSTRAINT_ERROR IS RAISED FOR
+--     A UNIVERSAL_REAL EXPRESSION IF DIVISION BY ZERO IS ATTEMPTED.
+
+--     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR
+--     0.0 ** (-1) (OR ANY OTHER NEGATIVE EXPONENT VALUE).
+
+-- HISTORY:
+--     RJW 09/04/86  CREATED ORIGINAL TEST.
+--     CJJ 09/04/87  ADDED PASS MESSAGE FOR RAISING NUMERIC_ERROR;
+--                   MODIFIED CODE TO PREVENT COMPILER OPTIMIZING
+--                   OUT THE TEST.
+--     JET 12/31/87  ADDED MORE CODE TO PREVENT OPTIMIZATION.
+--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+--     JRL 02/29/96  Added code to check for value of Machine_Overflows; if
+--                   False, test is inapplicable.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C4A012B IS
+
+     F : FLOAT;
+
+     I3 : INTEGER := -3;
+
+     SUBTYPE SINT IS INTEGER RANGE -10 .. 10;
+     SI5 : CONSTANT SINT := -5;
+
+     FUNCTION IDENT (X:FLOAT) RETURN FLOAT IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN X;
+          ELSE
+               RETURN 1.0;
+          END IF;
+     END IDENT;
+
+BEGIN
+
+     TEST ( "C4A012B", "CHECK THAT CONSTRAINT_ERROR " &
+                       "IS RAISED FOR " &
+                       "0.0 ** (-1) (OR ANY OTHER NEGATIVE EXPONENT " &
+                       "VALUE)" );
+
+     IF FLOAT'MACHINE_OVERFLOWS = FALSE THEN
+        REPORT.NOT_APPLICABLE ("Float'Machine_Overflows = False");
+     ELSE
+
+        BEGIN
+             F := IDENT (0.0) ** (-1);
+             FAILED ( "THE EXPRESSION '0.0 ** (-1)' DID NOT RAISE " &
+                      "AN EXCEPTION" );
+             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                  COMMENT ("SHOULDN'T BE HERE!");
+             END IF;
+        EXCEPTION
+             WHEN CONSTRAINT_ERROR =>
+                  COMMENT ("CONSTRAINT_ERROR RAISED - 1");
+             WHEN OTHERS =>
+                  FAILED ( "THE EXPRESSION '0.0 ** (-1)' RAISED THE " &
+                           "WRONG EXCEPTION" );
+        END;
+
+        BEGIN
+             F := 0.0 ** (IDENT_INT (-1));
+             FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (-1))' DID " &
+                       "NOT RAISE AN EXCEPTION" );
+             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                  COMMENT ("SHOULDN'T BE HERE!");
+             END IF;
+        EXCEPTION
+             WHEN CONSTRAINT_ERROR =>
+                  COMMENT ("CONSTRAINT_ERROR RAISED - 2");
+             WHEN OTHERS =>
+                  FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (-1))' " &
+                           "RAISED THE WRONG EXCEPTION" );
+        END;
+
+        BEGIN
+             F := 0.0 ** (INTEGER'POS (IDENT_INT (-1)));
+             FAILED ( "THE EXPRESSION '0.0 ** " &
+                      "(INTEGER'POS (IDENT_INT (-1)))' DID " &
+                      "NOT RAISE AN EXCEPTION" );
+             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                  COMMENT ("SHOULDN'T BE HERE!");
+             END IF;
+        EXCEPTION
+             WHEN CONSTRAINT_ERROR =>
+                  COMMENT ("CONSTRAINT_ERROR RAISED - 3");
+             WHEN OTHERS =>
+                  FAILED ( "THE EXPRESSION '0.0 ** " &
+                           "(INTEGER'POS (IDENT_INT (-1)))' RAISED " &
+                           "THE WRONG EXCEPTION" );
+        END;
+
+        BEGIN
+             F := IDENT(0.0) ** I3;
+             FAILED ( "THE EXPRESSION '0.0 ** I3' DID NOT RAISE " &
+                       "AN EXCEPTION" );
+             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                  COMMENT ("SHOULDN'T BE HERE!");
+             END IF;
+        EXCEPTION
+             WHEN CONSTRAINT_ERROR =>
+                  COMMENT ("CONSTRAINT_ERROR RAISED - 4");
+             WHEN OTHERS =>
+                  FAILED ( "THE EXPRESSION '0.0 ** I3' RAISED THE " &
+                           "WRONG EXCEPTION" );
+        END;
+
+        BEGIN
+             F := 0.0 ** (IDENT_INT (I3));
+             FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (I3))' DID " &
+                      "NOT RAISE AN EXCEPTION" );
+             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                  COMMENT ("SHOULDN'T BE HERE!");
+             END IF;
+        EXCEPTION
+             WHEN CONSTRAINT_ERROR =>
+                  COMMENT ("CONSTRAINT_ERROR RAISED - 5");
+             WHEN OTHERS =>
+                  FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (I3))' " &
+                            "RAISED THE WRONG EXCEPTION" );
+        END;
+
+        BEGIN
+             F := IDENT (0.0) ** SI5;
+             FAILED ( "THE EXPRESSION '0.0 ** SI5' DID NOT RAISE " &
+                       "AN EXCEPTION" );
+             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                  COMMENT ("SHOULDN'T BE HERE!");
+             END IF;
+        EXCEPTION
+             WHEN CONSTRAINT_ERROR =>
+                  COMMENT ("CONSTRAINT_ERROR RAISED - 6");
+             WHEN OTHERS =>
+                  FAILED ( "THE EXPRESSION '0.0 ** SI5' RAISED THE " &
+                           "WRONG EXCEPTION" );
+        END;
+
+        BEGIN
+             F := 0.0 ** (IDENT_INT (SI5));
+             FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (SI5))' DID " &
+                      "NOT RAISE AN EXCEPTION" );
+             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
+                  COMMENT ("SHOULDN'T BE HERE!");
+             END IF;
+        EXCEPTION
+             WHEN CONSTRAINT_ERROR =>
+                  COMMENT ("CONSTRAINT_ERROR RAISED - 7");
+             WHEN OTHERS =>
+                  FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (SI5))' " &
+                            "RAISED THE WRONG EXCEPTION" );
+        END;
+
+     END IF;
+
+     RESULT;
+
+END C4A012B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a013a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a013a.ada
new file mode 100644
index 000000000..1f385b5b4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a013a.ada
@@ -0,0 +1,77 @@
+-- C4A013A.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 A NONSTATIC
+-- UNIVERSAL_REAL EXPRESSION IF THE VALUE WOULD LIE OUTSIDE THE RANGE OF
+-- THE BASE TYPE OF THE MOST ACCURATE PREDEFINED FLOATING POINT TYPE AND
+-- MACHINE_OVERFLOWS IS TRUE FOR THAT TYPE.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- BAW 29 SEPT 80
+-- TBN 10/30/85     RENAMED FROM C4A013A.ADA.
+-- JRK 1/13/86      COMPLETELY REVISED TO CHECK NONSTATIC UNIVERSAL_REAL
+--                  EXPRESSIONS WHOSE RESULTS OVERFLOW.  REVISED
+--                  NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+--                  AI-00387.
+-- MRM 03/30/93     REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH SYSTEM, REPORT;
+USE SYSTEM, REPORT;
+
+PROCEDURE C4A013A IS
+
+     TYPE F IS DIGITS MAX_DIGITS;
+
+     B : BOOLEAN;
+
+BEGIN
+     TEST ("C4A013A", "CHECK NONSTATIC UNIVERSAL_REAL EXPRESSIONS " &
+                      "WHOSE RESULTS OVERFLOW");
+
+     BEGIN
+          B := 1.0 < 1.0 / (1.0 * INTEGER'POS (IDENT_INT (0)));
+
+          IF F'MACHINE_OVERFLOWS THEN
+               FAILED ("MACHINE_OVERFLOWS IS TRUE, BUT NO EXCEPTION " &
+                       "WAS RAISED");
+          ELSE COMMENT ("MACHINE_OVERFLOWS IS FALSE AND NO EXCEPTION " &
+                        "WAS RAISED");
+          END IF;
+
+          IF NOT B THEN  -- USE B TO PREVENT DEAD VARIABLE OPTIMIZATION.
+               COMMENT ("1.0 < 1.0 / 0.0 YIELDS FALSE");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END C4A013A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a014a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a014a.ada
new file mode 100644
index 000000000..84aa878c5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c4/c4a014a.ada
@@ -0,0 +1,86 @@
+-- C4A014A.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 ROUNDING IS DONE CORRECTLY FOR STATIC UNIVERSAL REAL
+-- EXPRESSIONS.
+
+-- JBG 5/3/85
+-- JBG 11/3/85   DECLARE INTEGER CONSTANTS INSTEAD OF UNIVERSAL INTEGER
+-- DTN 11/27/91  DELETED SUBPART (B).
+
+WITH REPORT; USE REPORT;
+PROCEDURE C4A014A IS
+
+     C15  : CONSTANT := 1.5;
+     C25  : CONSTANT := 2.5;
+     CN15 : CONSTANT := -1.5;
+     CN25 : CONSTANT := -2.5;
+
+     C15R  : CONSTANT INTEGER := INTEGER(C15);
+     C25R  : CONSTANT INTEGER := INTEGER(C25);
+     CN15R : CONSTANT INTEGER := INTEGER(CN15);
+     CN25R : CONSTANT INTEGER := INTEGER(CN25);
+
+     C15_1   : BOOLEAN := 1 = C15R;
+     C15_2   : BOOLEAN := 2 = C15R;
+     C25_2   : BOOLEAN := 2 = C25R;
+     C25_3   : BOOLEAN := 3 = C25R;
+
+     CN15_N1 : BOOLEAN := -1 = CN15R;
+     CN15_N2 : BOOLEAN := -2 = CN15R;
+     CN25_N2 : BOOLEAN := -2 = CN25R;
+     CN25_N3 : BOOLEAN := -3 = CN25R;
+
+BEGIN
+
+     TEST ("C4A014A", "CHECK ROUNDING TO INTEGER FOR UNIVERSAL REAL " &
+                      "EXPRESSIONS");
+
+     IF 1 /= INTEGER(1.4) THEN
+          FAILED ("INTEGER(1.4) DOES NOT EQUAL 1");
+     END IF;
+
+     IF 2 /= INTEGER(1.6) THEN
+          FAILED ("INTEGER(1.6) DOES NOT EQUAL 2");
+     END IF;
+
+     IF -1 /= INTEGER(-1.4) THEN
+          FAILED ("INTEGER(-1.4) DOES NOT EQUAL -1");
+     END IF;
+
+     IF -2 /= INTEGER(-1.6) THEN
+          FAILED ("INTEGER(-1.6) DOES NOT EQUAL -2");
+     END IF;
+
+     IF NOT (C15_1 OR C15_2) OR (NOT (C25_2 OR C25_3)) THEN
+          FAILED ("ROUNDING OF POSITIVE VALUES NOT CORRECT");
+     END IF;
+
+     IF NOT (CN15_N1 OR CN15_N2) OR (NOT (CN25_N2 OR CN25_N3)) THEN
+          FAILED ("ROUNDING OF NEGATIVE VALUES NOT CORRECT");
+     END IF;
+
+     RESULT;
+
+END C4A014A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c51004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c51004a.ada
new file mode 100644
index 000000000..75fa271d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c51004a.ada
@@ -0,0 +1,261 @@
+-- C51004A.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 LABELS, LOOP IDENTIFIERS, AND BLOCK IDENTIFIERS ARE
+-- IMPLICITLY DECLARED AT THE END OF THE DECLARATIVE PART.  PRIOR TO
+-- THE END OF THE DECLARATIVE PART, THEY MAY BE USED TO REFERENCE
+-- ENTITIES IN AN ENCLOSING SCOPE.  SUBTESTS ARE:
+--        (A) BLOCK.
+--        (B) PROCEDURE BODY.
+--        (C) PACKAGE BODY.
+--        (D) GENERIC FUNCTION BODY.
+--        (E) GENERIC PACKAGE BODY.
+--        (F) TASK BODY.
+
+-- CPP  6/1/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C51004A IS
+
+BEGIN
+     TEST("C51004A", "CHECK THAT LABELS, LOOP IDENTIFIERS, AND BLOCK " &
+          "IDENTIFIERS MAY BE USED PRIOR TO THEIR IMPLICIT " &
+          "DECLARATION");
+
+OUTER: DECLARE
+
+          TYPE IDN1 IS NEW INTEGER;
+          IDN2 : CONSTANT INTEGER := 2;
+          TYPE IDN3 IS ACCESS INTEGER;
+
+     BEGIN     -- OUTER
+
+     -----------------------------------------------
+
+     A :  DECLARE
+
+               A1 : IDN1;
+               A2 : CONSTANT INTEGER := IDN2;
+               A3 : IDN3;
+
+               TEMP : INTEGER;
+
+          BEGIN     -- A
+
+           <<IDN1>> TEMP := 0;
+
+             IDN2 : FOR I IN 1..1 LOOP
+                         TEMP := A2;
+                    END LOOP IDN2;
+
+             IDN3 : BEGIN
+                         NULL;
+                    END IDN3;
+
+          END A;
+
+     -----------------------------------------------
+
+     B :  DECLARE
+
+               PROCEDURE P (TEMP : OUT INTEGER) IS
+
+                    B1 : IDN1;
+                    B2 : CONSTANT INTEGER := IDN2 + 2;
+                    B3 : IDN3;
+
+               BEGIN     -- P
+               
+          <<L>> <<IDN1>> TEMP := 0;
+
+                  IDN2 : WHILE B2 < 0 LOOP
+                              TEMP := 0;
+                         END LOOP IDN2;
+
+                  IDN3 : DECLARE
+                         BEGIN
+                              NULL;
+                         END IDN3;
+
+               END P;
+
+          BEGIN     -- B
+               NULL;
+          END B;
+
+     -----------------------------------------------
+
+     C :  DECLARE
+
+               PACKAGE PKG IS
+               END PKG;
+
+               PACKAGE BODY PKG IS
+
+                    C1 : IDN1;
+                    C2 : CONSTANT INTEGER := 2 * IDN2;
+                    C3 : IDN3;
+
+                    TEMP : INTEGER;
+
+               BEGIN
+
+                <<IDN1>> TEMP := 0;
+
+                  IDN2 : LOOP
+                              TEMP := 0;
+                              EXIT;          
+                         END LOOP IDN2;
+
+                  IDN3 : BEGIN
+                              NULL;
+                         END IDN3;
+
+               END PKG;
+
+          BEGIN     -- C
+               NULL;
+          END C;
+
+     ---------------------------------------------------
+
+     D :  DECLARE
+
+               GENERIC
+                    TYPE Q IS (<>);
+               FUNCTION FN RETURN INTEGER;
+
+               FUNCTION FN RETURN INTEGER IS
+
+                    D1 : IDN1;
+                    D2 : CONSTANT INTEGER := IDN2;
+                    D3 : IDN3;
+
+                    TEMP : INTEGER;
+
+               BEGIN     
+
+                <<IDN1>> TEMP := 0;
+
+                  IDN2 : FOR I IN 1..5 LOOP
+                              TEMP := 0;
+                         END LOOP IDN2;
+
+                  IDN3 : BEGIN
+                              NULL;
+                         END IDN3;  
+                    
+                         RETURN TEMP;
+
+               END FN;
+
+          BEGIN
+               NULL;
+          END D;
+
+     -----------------------------------------------
+
+     E :  DECLARE
+
+               GENERIC
+
+                    TYPE ELEMENT IS (<>);
+                    ITEM : ELEMENT;
+
+               PACKAGE PKG IS
+               END PKG;
+
+               PACKAGE BODY PKG IS
+
+                    E1 : IDN1 RANGE 1..5;
+                    E2 : CONSTANT INTEGER := IDN2;
+                    E3 : IDN3;
+
+                    TEMP : ELEMENT;
+
+               BEGIN
+
+          <<IDN1>> <<L>> TEMP := ITEM;
+
+                  IDN2 : WHILE TEMP /= ITEM LOOP
+                              TEMP := ITEM;
+                         END LOOP IDN2;
+
+                  IDN3 : DECLARE
+                         BEGIN
+                              NULL;
+                         END IDN3;
+
+               END PKG;
+          
+          BEGIN     -- E
+
+               DECLARE
+                    PACKAGE P1 IS NEW PKG (INTEGER, 0);
+               BEGIN
+                    NULL;
+               END;
+               
+          END E;
+
+     -----------------------------------------------
+
+     F :  DECLARE
+
+               TASK T;
+
+               TASK BODY T IS
+
+                    F1 : IDN1 RANGE -4..2;
+                    F2 : CONSTANT INTEGER := IDN2;
+                    F3 : IDN3;
+
+                    TEMP : INTEGER;
+
+               BEGIN
+
+                <<IDN1>> TEMP := 1;
+
+                  IDN2 : LOOP
+                              TEMP := TEMP + 1;
+                              EXIT;
+                         END LOOP IDN2;
+
+                  IDN3 : DECLARE
+                         BEGIN
+                              TEMP := TEMP + 1;
+                         END IDN3;
+
+               END T;
+
+          BEGIN     -- F
+               NULL;
+          END F;
+
+     -----------------------------------------------
+
+     END OUTER;
+
+     RESULT;
+END C51004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005a.ada
new file mode 100644
index 000000000..2c70049c8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005a.ada
@@ -0,0 +1,177 @@
+-- C52005A.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 CONSTRAINT_ERROR EXCEPTION IS RAISED WHEN A STATIC
+--    EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE OF INTEGER, BOOLEAN,
+--    CHARACTER, AND ENUMERATION ASSIGNMENT TARGET VARIABLES.
+
+-- DCB 2/5/80
+-- JRK 7/21/80
+-- SPS 3/21/83
+
+WITH REPORT;
+PROCEDURE C52005A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C52005A", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED "
+         & "ON STATIC OUT OF RANGE INTEGER, BOOLEAN, CHARACTER, " &
+           "AND ENUMERATION ASSIGNMENTS");
+
+-------------------------
+
+     DECLARE
+          I1 : INTEGER RANGE 0..10 := 5;
+
+     BEGIN
+          I1 := 11;
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE INT ASSNMT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF I1 /= 5 THEN
+               FAILED ("VALUE ALTERED BEFORE INT RANGE" &
+                       "EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          I2 : INTEGER RANGE 0..10 := 5;
+
+     BEGIN
+          I2 := 10;
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL INTEGER ASSIGNMENT");
+     END;
+
+-------------------------
+
+     DECLARE
+          B1 : BOOLEAN RANGE TRUE..TRUE := TRUE;
+
+     BEGIN
+          B1 := FALSE;
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE BOOL ASSNMT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF B1 /= TRUE THEN
+               FAILED ("VALUE ALTERED BEFORE BOOLEAN RANGE EXCEPTION");
+          END IF;
+     END;
+
+-------------------------
+
+     DECLARE
+          B2 : BOOLEAN := TRUE;
+
+     BEGIN
+          B2 := FALSE;
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL BOOLEAN ASSNMNT");
+
+     END;
+
+-------------------------
+
+     DECLARE
+          C1 : CHARACTER RANGE 'B'..'Z' := 'M';
+
+     BEGIN
+          C1 := 'A';
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE CHAR ASSNMNT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF C1 /= 'M' THEN
+               FAILED ("VALUE ALTERED BEFORE CHARACTER RANGE " &
+                       "EXCEPTION");
+          END IF; 
+
+     END;
+
+-------------------------
+
+     DECLARE
+          C2 : CHARACTER RANGE 'B'..'Z' := 'M';
+
+     BEGIN
+          C2 := 'B';
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED OF LEGAL CHARACTER ASSNMNT");
+
+     END;
+
+-------------------------
+
+     DECLARE
+          TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+          WORKDAY : DAY RANGE MON..FRI := TUE;
+
+     BEGIN
+          WORKDAY := SUN;
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE ENUM. " &
+                  "ASSIGNMENT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF WORKDAY /= TUE THEN
+               FAILED ("VALUE ALTERED BEFORE ENUM. RANGE EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+          WORKDAY : DAY RANGE MON..FRI := TUE;
+
+     BEGIN
+          WORKDAY := FRI;
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL ENUM. ASSNMNT");
+
+     END;
+
+-------------------------
+
+     RESULT;
+END C52005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005b.ada
new file mode 100644
index 000000000..94b55be7f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005b.ada
@@ -0,0 +1,115 @@
+-- C52005B.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 CONSTRAINT_ERROR EXCEPTION IS RAISED
+--    WHEN A STATIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
+--    OF FLOATING POINT ASSIGNMENTS.
+
+-- DCB 2/6/80
+-- JRK 7/21/80
+-- SPS 3/21/83
+
+WITH REPORT;
+PROCEDURE C52005B IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C52005B", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
+         & " ON STATIC OUT OF RANGE FLOATING POINT ASSIGNMENTS");
+
+-------------------------
+
+     DECLARE
+          TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
+          FL1 : FLT RANGE 0.0 .. 100.0 := 50.0;
+
+     BEGIN
+          FL1 := 101.0;
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLT1 PT " &
+                  "ASSIGNMENT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF FL1 /= 50.0 THEN
+               FAILED ("VALUE ALTERED BEFORE FLT1 PT RANGE EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
+          FL2 : FLT RANGE 0.0 .. 100.0 := 50.0;
+
+
+     BEGIN
+          FL2 := 100.0;
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL FLOATING1 PT" &
+                  "ASSIGNMENT");
+
+     END;
+
+-------------------------
+
+     DECLARE
+          FL1 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
+
+     BEGIN
+          FL1 := -0.001;
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLTG PT " &
+                  "ASSIGNMENT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF FL1 /= 50.0 THEN
+               FAILED ("VALUE ALTERED BEFORE FLTG PT RANGE EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          FL2 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
+
+     BEGIN
+          FL2 := 0.0;
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL FLOATING PT ASSNMT");
+
+     END;
+
+----------------------
+
+     RESULT;
+END C52005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005c.ada
new file mode 100644
index 000000000..e064e5ca7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005c.ada
@@ -0,0 +1,79 @@
+-- C52005C.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 CONSTRAINT_ERROR EXCEPTION IS RAISED
+--    WHEN A STATIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
+--    OF FIXED POINT ASSIGNMENTS.
+
+-- DCB 2/6/80
+-- JRK 7/21/80
+-- SPS 3/21/83
+
+WITH REPORT;
+PROCEDURE C52005C IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C52005C", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
+         & " ON STATIC OUT OF RANGE FIXED POINT ASSIGNMENTS");
+
+-----------------------
+
+     DECLARE
+          TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
+          FX1 : REAL RANGE 0.00 .. 7.00 := 4.50;
+
+     BEGIN
+          FX1 := 7.01;
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FIXED ASSNMT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF FX1 /= 4.50 THEN
+               FAILED ("VALUE ALTERED BEFORE FIXED PT RANGE EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
+          FX2 : REAL RANGE 0.00 .. 7.00 := 4.50;
+
+     BEGIN
+          FX2 := 7.00;
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL FIXED PT ASSNMT");
+
+     END;
+
+-------------------------
+
+     RESULT;
+END C52005C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005d.ada
new file mode 100644
index 000000000..055482b9f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005d.ada
@@ -0,0 +1,182 @@
+-- C52005D.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 CONSTRAINT_ERROR EXCEPTION IS RAISED WHEN A DYNAMIC
+--    EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE OF INTEGER, BOOLEAN,
+--    CHARACTER, AND ENUMERATION ASSIGNMENT TARGET VARIABLES.
+
+-- JRK 7/21/80
+-- SPS 3/21/83
+
+WITH REPORT;
+PROCEDURE C52005D IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C52005D", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED "
+         & "ON DYNAMIC OUT OF RANGE INTEGER, BOOLEAN, CHARACTER, " &
+           "AND ENUMERATION ASSIGNMENTS");
+
+-------------------------
+
+     DECLARE
+          I1 : INTEGER RANGE 0..10 := 5;
+
+     BEGIN
+          I1 := IDENT_INT(11);
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE INT ASSNMT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF I1 /= 5 THEN
+               FAILED ("VALUE ALTERED BEFORE INT RANGE EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          I2 : INTEGER RANGE 0..10 := 5;
+
+     BEGIN
+          I2 := IDENT_INT(10);
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL INTEGER ASSIGNMENT");
+     END;
+
+-------------------------
+
+     DECLARE
+          B1 : BOOLEAN RANGE TRUE..TRUE := TRUE;
+
+     BEGIN
+          B1 := IDENT_BOOL(FALSE);
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE BOOL ASSNMT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF B1 /= TRUE THEN
+               FAILED ("VALUE ALTERED BEFORE BOOLEAN RANGE EXCEPTION");
+          END IF;
+     END;
+
+-------------------------
+
+     DECLARE
+          B2 : BOOLEAN := TRUE;
+
+     BEGIN
+          B2 := IDENT_BOOL(FALSE);
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL BOOLEAN ASSNMNT");
+
+     END;
+
+-------------------------
+
+     DECLARE
+          C1 : CHARACTER RANGE 'B'..'Z' := 'M';
+
+     BEGIN
+          C1 := IDENT_CHAR('A');
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE CHAR ASSNMNT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF C1 /= 'M' THEN
+               FAILED ("VALUE ALTERED BEFORE CHARACTER RANGE " &
+                       "EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          C2 : CHARACTER RANGE 'B'..'Z' := 'M';
+
+     BEGIN
+          C2 := IDENT_CHAR('B');
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED OF LEGAL CHARACTER ASSNMNT");
+
+     END;
+
+-------------------------
+
+     DECLARE
+          TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+          ALLDAYS : DAY := TUE;
+          WORKDAY : DAY RANGE MON..FRI := TUE;
+
+     BEGIN
+          IF EQUAL(3,3) THEN
+               ALLDAYS := SUN;
+          END IF;
+          WORKDAY := ALLDAYS;
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE ENUM. " &
+                  "ASSIGNMENT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF WORKDAY /= TUE THEN
+               FAILED ("VALUE ALTERED BEFORE ENUM. RANGE EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
+          ALLDAYS : DAY := TUE;
+          WORKDAY : DAY RANGE MON..FRI := TUE;
+
+     BEGIN
+          IF EQUAL(3,3) THEN
+               ALLDAYS := FRI;
+          END IF;
+          WORKDAY := ALLDAYS;
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL ENUM. ASSNMNT");
+
+     END;
+
+-------------------------
+
+     RESULT;
+END C52005D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005e.ada
new file mode 100644
index 000000000..c474e21e9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005e.ada
@@ -0,0 +1,129 @@
+-- C52005E.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 CONSTRAINT_ERROR EXCEPTION IS RAISED
+--    WHEN A DYNAMIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
+--    OF FLOATING POINT ASSIGNMENTS.
+
+-- JRK 7/21/80
+-- SPS 3/21/83
+
+WITH REPORT;
+PROCEDURE C52005E IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C52005E", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
+        &  " ON DYNAMIC OUT OF RANGE FLOATING POINT ASSIGNMENTS");
+
+-------------------------
+
+     DECLARE
+          TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
+          FL : FLT := 50.0;
+          FL1 : FLT RANGE 0.0 .. 100.0 := 50.0;
+
+     BEGIN
+          IF EQUAL(3,3) THEN
+               FL := 101.0;
+          END IF;
+          FL1 := FL;
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLT1 PT " &
+                  "ASSIGNMENT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF FL1 /= 50.0 THEN
+               FAILED ("VALUE ALTERED BEFORE FLT1 PT RANGE EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          TYPE FLT IS DIGITS 3 RANGE 0.0 .. 5.0E2;
+          FL : FLT := 50.0;
+          FL2 : FLT RANGE 0.0 .. 100.0 := 50.0;
+
+
+     BEGIN
+          IF EQUAL(3,3) THEN
+               FL := 100.0;
+          END IF;
+          FL2 := FL;
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL FLOATING1 PT ASSNMT");
+
+     END;
+
+-------------------------
+
+     DECLARE
+          FL : FLOAT := 50.0;
+          FL1 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
+
+     BEGIN
+          IF EQUAL(3,3) THEN
+               FL := -0.001;
+          END IF;
+          FL1 := FL;
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FLTG PT " &
+                  "ASSIGNMENT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF FL1 /= 50.0 THEN
+               FAILED ("VALUE ALTERED BEFORE FLTG PT RANGE EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          FL : FLOAT := 50.0;
+          FL2 : FLOAT RANGE 0.0 .. 100.0 := 50.0;
+
+     BEGIN
+          IF EQUAL(3,3) THEN
+               FL := 0.0;
+          END IF;
+          FL2 := FL;
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL FLOATING PT ASSNMT");
+
+     END;
+
+----------------------
+
+     RESULT;
+END C52005E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005f.ada
new file mode 100644
index 000000000..19d58d0e4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52005f.ada
@@ -0,0 +1,86 @@
+-- C52005F.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 CONSTRAINT_ERROR EXCEPTION IS RAISED
+--    WHEN A DYNAMIC EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE
+--    OF FIXED POINT ASSIGNMENTS.
+
+-- JRK 7/21/80
+-- SPS 3/21/83
+
+WITH REPORT;
+PROCEDURE C52005F IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C52005F", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED"
+         & " ON DYNAMIC OUT OF RANGE FIXED POINT ASSIGNMENTS");
+
+-----------------------
+
+     DECLARE
+          TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
+          FX : REAL := 4.50;
+          FX1 : REAL RANGE 0.00 .. 7.00 := 4.50;
+
+     BEGIN
+          IF EQUAL(3,3) THEN
+               FX := 7.01;
+          END IF;
+          FX1 := FX;
+
+          FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE FIXED ASSNMT");
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          IF FX1 /= 4.50 THEN
+               FAILED ("VALUE ALTERED BEFORE FIXED PT RANGE EXCEPTION");
+          END IF;
+
+     END;
+
+-------------------------
+
+     DECLARE
+          TYPE REAL IS DELTA 0.01 RANGE 0.00 .. 9.99;
+          FX : REAL := 4.50;
+          FX2 : REAL RANGE 0.00 .. 7.00 := 4.50;
+
+     BEGIN
+          IF EQUAL(3,3) THEN
+               FX := 7.00;
+          END IF;
+          FX2 := FX;
+
+     EXCEPTION
+     WHEN CONSTRAINT_ERROR =>
+          FAILED ("EXCEPTION RAISED ON LEGAL FIXED PT ASSNMT");
+
+     END;
+
+-------------------------
+
+     RESULT;
+END C52005F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52008a.ada
new file mode 100644
index 000000000..ac0e8b05c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52008a.ada
@@ -0,0 +1,73 @@
+-- C52008A.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 RECORD VARIABLE CONSTRAINED BY A SPECIFIED DISCRIMINANT
+-- VALUE CANNOT HAVE ITS DISCRIMINANT VALUE ALTERED BY ASSIGNMENT.  
+-- ASSIGNING AN ENTIRE RECORD VALUE WITH A DIFFERENT DISCRIMINANT VALUE
+-- SHOULD RAISE CONSTRAINT_ERROR AND LEAVE THE TARGET VARIABLE 
+-- UNALTERED.  THIS TEST USES STATIC DISCRIMINANT VALUES.
+ 
+-- ASL 6/25/81
+-- SPS 3/21/83
+
+WITH REPORT;
+PROCEDURE C52008A IS
+ 
+     USE REPORT;
+ 
+     TYPE REC(DISC : INTEGER) IS
+          RECORD
+               COMP : INTEGER;
+          END RECORD;
+ 
+     R : REC(5) := (5,0);
+ 
+BEGIN
+ 
+     TEST ("C52008A", "CANNOT ASSIGN RECORD VARIABLE WITH SPECIFIED " &
+                      "DISCRIMINANT VALUE A VALUE WITH A DIFFERENT " &
+                      "STATIC DISCRIMINANT VALUE");
+ 
+     BEGIN
+          R := (DISC => 5, COMP => 3);
+          IF R /= (5,3) THEN
+               FAILED ("LEGAL ASSIGNMENT FAILED");
+          END IF;
+          R := (DISC => 4, COMP => 2);
+          FAILED ("RECORD ASSIGNED VALUE WITH DIFFERENT DISCRIMINANT " &
+                  "VALUE");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF R /= (5,3) THEN
+                    FAILED ("TARGET RECORD VALUE ALTERED BY " &
+                            "ASSIGNMENT TO VALUE WITH DIFFERENT " &
+                            "DISCRIMINANT VALUE EVEN AFTER " &
+                            "CONSTRAINT_ERROR RAISED");
+               END IF;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION");
+     END;
+ 
+     RESULT;
+ 
+END C52008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52008b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52008b.ada
new file mode 100644
index 000000000..3d0fa8df1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52008b.ada
@@ -0,0 +1,110 @@
+-- C52008B.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 RECORD VARIABLE DECLARED WITH A SPECIFIED
+--     DISCRIMINANT CONSTRAINT CANNOT HAVE A DISCRIMINANT VALUE ALTERED
+--     BY ASSIGNMENT.  ASSIGNING AN ENTIRE RECORD VALUE WITH A
+--     DIFFERENT DISCRIMINANT VALUE SHOULD RAISE CONSTRAINT_ERROR AND
+--     LEAVE THE TARGET VARIABLE UNALTERED.  THIS TEST USES NON-STATIC
+--     DISCRIMINANT VALUES.
+
+-- HISTORY:
+--     ASL  6/25/81  CREATED ORIGINAL TEST
+--     JRK 11/18/82
+--     RJW  8/17/89  ADDED SUBTYPE 'SUBINT'.
+
+WITH REPORT;
+PROCEDURE C52008B IS
+
+     USE REPORT;
+
+     TYPE REC1(D1,D2 : INTEGER) IS
+          RECORD
+               COMP1 : STRING(D1..D2);
+          END RECORD;
+
+     TYPE AR_REC1 IS ARRAY (NATURAL RANGE <>) OF REC1(IDENT_INT(3),
+                                                      IDENT_INT(5));
+
+     SUBTYPE SUBINT IS INTEGER RANGE -128 .. 127;
+
+     TYPE REC2(D1,D2,D3,D4 : SUBINT := 0) IS
+          RECORD
+               COMP1 : STRING(1..D1);
+               COMP2 : STRING(D2..D3);
+               COMP5 : AR_REC1(1..D4);
+               COMP6 : REC1(D3,D4);
+          END RECORD;
+
+     STR : STRING(IDENT_INT(3)..IDENT_INT(5)) := "ZZZ";
+
+     R1A : REC1(IDENT_INT(3),IDENT_INT(5)) := (3,5,STR);
+     R1C : REC1(5,6) := (5,6,COMP1 => (5..6 => 'K'));
+
+     Q,R : REC2(IDENT_INT(2),IDENT_INT(3),IDENT_INT(5),IDENT_INT(6));
+     TEMP : REC2(2,3,5,6);
+
+     W : REC2(1,4,6,8);
+     OK : BOOLEAN := FALSE;
+
+
+BEGIN
+
+     TEST ("C52008B", "CANNOT ASSIGN RECORD VARIABLE WITH SPECIFIED " &
+                      "DISCRIMINANT VALUE A VALUE WITH A DIFFERENT " &
+                      "(DYNAMIC) DISCRIMINANT VALUE");
+
+     BEGIN
+          R1A := (IDENT_INT(3),5,"XYZ");
+
+          R := (IDENT_INT(2),IDENT_INT(3),IDENT_INT(5),IDENT_INT(6),
+                "AB",
+                STR,
+                (1..6 => R1A),
+                R1C);
+
+          TEMP := R;
+          Q := TEMP;
+          R.COMP1 := "YY";
+          OK := TRUE;
+          W := R;
+          FAILED ("ASSIGNMENT MADE USING INCORRECT DISCRIMINANT " &
+                  "VALUES");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT OK
+               OR Q /= TEMP
+               OR R = TEMP
+               OR R = Q
+               OR W.D4 /= 8 THEN
+                    FAILED ("LEGITIMATE ASSIGNMENT FAILED");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION");
+     END;
+
+     RESULT;
+
+END C52008B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52009a.ada
new file mode 100644
index 000000000..8a46f988c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52009a.ada
@@ -0,0 +1,77 @@
+-- C52009A.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 RECORD VARIABLE DESIGNATED BY AN ACCESS VALUE CANNOT
+-- HAVE ITS DISCRIMINANT ALTERED, EVEN BY A COMPLETE RECORD
+-- ASSIGNMENT, AND EVEN THOUGH THE THE TARGET ACCESS VARIABLE IS NOT 
+-- CONSTRAINED TO A SPECIFIC DISCRIMINANT VALUE.  ATTEMPTING TO
+-- CHANGE THE TARGET'S DISCRIMINANT RAISES CONSTRAINT_ERROR AND LEAVES 
+-- THE TARGET RECORD UNALTERED.  THIS  TEST USES STATIC DISCRIMINANT 
+-- VALUES.
+ 
+-- ASL 6/25/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C52009A IS
+ 
+     USE REPORT;
+ 
+     TYPE REC (DISC : INTEGER) IS
+          RECORD
+               COMP : INTEGER;
+          END RECORD;
+ 
+     TYPE REC_NAME IS ACCESS REC;
+ 
+     HR : REC_NAME := NEW REC'(5,0);
+ 
+BEGIN
+ 
+     TEST ("C52009A", "CANNOT CHANGE, THROUGH ASSIGNMENT, THE " &
+           "(STATIC) DISCRIMINANT VALUE OF A RECORD DESIGNATED " &
+           "BY AN ACCESS VALUE");
+ 
+     BEGIN
+          HR.ALL := (DISC => 5, COMP => 3);
+          IF HR.ALL /= (5,3) THEN
+               FAILED ("LEGAL ASSIGNMENT FAILED");
+          END IF;
+          HR.ALL := (DISC => 4, COMP => 2);
+          FAILED ("RECORD ASSIGNED VALUE WITH DIFFERENT DISCRIMINANT " &
+                  "VALUE");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF HR.ALL /= (5,3) THEN
+                    FAILED ("TARGET RECORD VALUE ALTERED BY " &
+                            "ASSIGNMENT WITH A DIFFERENT " &
+                            "DISCRIMINANT VALUE EVEN AFTER " &
+                            "CONSTRAINT_ERROR RAISED");
+               END IF;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION");
+     END;
+ 
+     RESULT;
+ 
+END C52009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52009b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52009b.ada
new file mode 100644
index 000000000..98577fd53
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52009b.ada
@@ -0,0 +1,81 @@
+-- C52009B.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 RECORD VARIABLE DESIGNATED BY AN ACCESS VALUE CANNOT
+-- HAVE ITS DISCRIMINANT ALTERED, EVEN BY A COMPLETE RECORD
+-- ASSIGNMENT, AND EVEN THOUGH THE THE TARGET ACCESS VARIABLE IS NOT 
+-- CONSTRAINED TO A SPECIFIC DISCRIMINANT VALUE.  ATTEMPTING TO
+-- CHANGE THE TARGET'S DISCRIMINANT RAISES CONSTRAINT_ERROR AND LEAVES 
+-- THE TARGET RECORD UNALTERED.  THIS TEST USES NON-STATIC DISCRIMINANT 
+-- VALUES AND A TYPE WITH DEFAULT DISCRIMINANTS.
+ 
+-- ASL 7/6/81
+-- SPS 10/26/82
+-- JBG 1/10/84
+
+WITH REPORT;
+PROCEDURE C52009B IS
+ 
+     USE REPORT;
+ 
+     TYPE REC(DISC : INTEGER := 5) IS
+          RECORD
+               COMP : INTEGER := 0;
+          END RECORD;
+ 
+     TYPE REC_NAME IS ACCESS REC;
+ 
+     HR : REC_NAME := NEW REC;
+ 
+BEGIN
+ 
+     TEST ("C52009B", "CANNOT CHANGE, THROUGH ASSIGNMENT, THE " &
+           "(DYNAMIC) DISCRIMINANT VALUE OF A RECORD DESIGNATED " &
+           "BY AN ACCESS VALUE");
+ 
+     BEGIN
+          HR.ALL := (DISC => IDENT_INT(5), COMP => 3);
+          IF HR.ALL /= (IDENT_INT(5),3) THEN
+               FAILED ("LEGAL ASSIGNMENT FAILED");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => 
+               FAILED ("CONSTRAINT_ERROR RAISED WHEN DISCRIMINANT " &
+                       "VALUE NOT CHANGED");
+     END;
+
+     BEGIN
+          HR.ALL := (DISC => IDENT_INT(4), COMP => 2);
+          FAILED ("RECORD ASSIGNED VALUE WITH DIFFERENT DISCRIMINANT " &
+                  "VALUE");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("DETECTED ATTEMPT TO CHANGE DISCRIMINANT " &
+                        "VALUE");
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION");
+     END;
+ 
+     RESULT;
+ 
+END C52009B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52010a.ada
new file mode 100644
index 000000000..ddb58f7f6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52010a.ada
@@ -0,0 +1,186 @@
+-- C52010A.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 RECORD ASSIGNMENTS USE "COPY" SEMANTICS. (PART I).
+
+
+-- FACTORS AFFECTING THE SITUATION TO BE TESTED:
+--
+--        COMPONENT TYPE                     * INTEGER
+--                                           * BOOLEAN (OMITTED)
+--                                           * CHARACTER (OMITTED)
+--                                           * USER-DEFINED ENUMERATION
+--
+--        DERIVED VS. NON-DERIVED
+--
+--        TYPE VS. SUBTYPE
+--
+--        ORDER OF COMPONENT ASSIGNMENTS     * LEFT-TO-RIGHT
+--                                           * RIGHT-TO-LEFT
+--                                           * INSIDE-OUT
+--                                           * OUTSIDE IN
+
+
+-- RM 02/23/80
+-- SPS 3/21/83
+
+WITH REPORT;
+PROCEDURE C52010A IS
+
+     USE REPORT;
+
+     TYPE  ENUM  IS  ( AA , BB , CC , DD , EE , FF , GG , HH ,
+                       II , JJ , KK , LL , MM , NN , PP , QQ ,
+                                 TT , UU , VV , WW , XX , YY );
+
+BEGIN
+
+     TEST ( "C52010A" ,  "CHECK THAT RECORD ASSIGNMENTS USE ""COPY""" &
+                         " SEMANTICS" );
+
+
+     DECLARE
+          TYPE  REC  IS
+               RECORD
+                    X , Y  :  INTEGER ;
+               END RECORD;
+          R  :  REC ;
+     BEGIN
+
+          R  :=  ( 5 , 8 ) ;
+          R  :=  ( X => 1 , Y => R.X ) ;
+          IF  R  /=  ( 1 , 5 )  THEN
+               FAILED ( "WRONG VALUE  (1)" );
+          END IF;
+
+          R  :=  ( 5 , 8 ) ;
+          R  :=  ( Y => 1 , X => R.Y ) ;
+          IF  R  /=  ( 8 , 1 )  THEN
+               FAILED ( "WRONG VALUE  (2)" );
+          END IF;
+
+          R  :=  ( 5 , 8 ) ;
+          R  :=  ( R.Y+1 , R.X+1 ) ;
+          IF  R  /=  ( 9 , 6 ) THEN
+               FAILED ( "WRONG VALUE  (3)" );
+          END IF;
+
+     END;
+
+     DECLARE
+          TYPE  REC3  IS
+               RECORD
+                    DEEP0     :  INTEGER   ;
+                    DEEP      :  INTEGER   ;
+               END RECORD;
+          TYPE  REC2  IS
+               RECORD
+                    YX        :  REC3      ;
+                    MODERATE  :  INTEGER   ;
+               END RECORD;
+          TYPE  REC  IS
+               RECORD
+                    SHALLOW   :  INTEGER   ;
+                    YZ        :  REC2      ;
+               END RECORD;
+          R  :  REC ;
+     BEGIN
+          R  :=  ( 0              , ((5,  1         ), 2             ));
+          R  :=  ( R.YZ.MODERATE+8, ((7, R.SHALLOW+1),R.YZ.YX.DEEP+99));
+          IF R/= (              10, ((7,           1),            100))
+          THEN
+               FAILED ( "WRONG VALUE  (4)" );
+          END IF;
+     END;
+
+
+     DECLARE
+          TYPE  SUB_ENUM  IS  NEW ENUM RANGE  AA..DD ;
+          TYPE  REC  IS
+               RECORD
+                    X , Y  :  SUB_ENUM ;
+               END RECORD;
+          R  :  REC ;
+     BEGIN
+          R  :=  ( AA , CC ) ;
+          R  :=  ( X => BB , Y => R.X ) ;
+          IF  R  /=  ( BB , AA )  THEN
+               FAILED ( "WRONG VALUE  (5)" );
+          END IF;
+
+          R  :=  ( AA , CC ) ;
+          R  :=  ( Y => BB , X => R.Y ) ;
+          IF  R  /=  ( CC , BB )  THEN
+               FAILED ( "WRONG VALUE  (6)" );
+          END IF;
+
+          R  :=  ( AA , CC ) ;
+          R  :=  ( SUB_ENUM'SUCC( R.Y ) , SUB_ENUM'SUCC( R.X ) ) ;
+          IF  R /= ( DD , BB )  THEN
+               FAILED ( "WRONG VALUE  (7)" );
+          END IF;
+
+     END;
+
+
+     DECLARE
+          TYPE  REC3  IS
+               RECORD
+                    DEEP0      :  ENUM ;
+                    DEEP       :  ENUM ;
+               END RECORD;     
+          TYPE  REC2  IS
+               RECORD
+                    YX         :  REC3 ;
+                    MODERATE   :  ENUM ;
+               END RECORD;
+          TYPE  REC  IS
+               RECORD
+                    SHALLOW    :  ENUM ;
+                    YZ         :  REC2 ;
+               END RECORD;
+          R  :  REC ;
+     BEGIN
+
+          R  :=  (    TT ,
+                   (( YY , II ) ,
+                      AA ) ) ;
+
+          R  :=  (    ENUM'SUCC(ENUM'SUCC( R.YZ.MODERATE )) ,
+                   (( AA , ENUM'SUCC( R.SHALLOW ) ) ,
+                    ( ENUM'SUCC(ENUM'SUCC(ENUM'SUCC(ENUM'SUCC(
+                                R.YZ.YX.DEEP )))) ) ) ) ;
+
+          IF R/= (    CC ,
+                   (( AA , UU ) ,
+                      MM ) )
+          THEN
+               FAILED ( "WRONG VALUE  (8)" );
+          END IF;
+
+     END;
+
+     RESULT ;
+
+END C52010A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52011a.ada
new file mode 100644
index 000000000..1f46c4da5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52011a.ada
@@ -0,0 +1,170 @@
+-- C52011A.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 INDEX CONSTRAINTS FOR ASSIGNMENT OF ACCESS SUBTYPES.
+-- SPECIFICALLY, CHECK THAT:
+
+-- A) ANY ACCESS TYPE VARIABLE AND CONSTRAINED SUBTYPE VARIABLES OF THAT
+-- TYPE MAY BE ASSIGNED TO ONE ANOTHER IF THE VALUE BEING ASSIGNED
+-- IS NULL.
+
+-- B) VARIABLES OF THE SAME CONSTRAINED ACCESS SUBTYPE MAY BE ASSIGNED
+-- TO ONE ANOTHER OR TO VARIABLES OF THE BASE ACCESS TYPE.
+
+-- C) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF NON-NULL OBJECTS
+-- BETWEEN DIFFERENTLY CONSTRAINED ACCESS SUBTYPES.
+
+-- D) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF A NON-NULL OBJECT
+-- OF A BASE ACCESS TYPE VARIABLE TO A VARIABLE OF ONE OF ITS
+-- CONSTRAINED SUBTYPES IF THE CONSTRAINTS ON THE OBJECT DIFFER
+-- FROM THOSE ON THE SUBTYPE.
+
+-- E) NULL CAN BE ASSIGNED TO BASE ACCESS TYPES AND ANY CONSTRAINED
+-- SUBTYPES OF THIS TYPE.
+
+-- ASL 6/29/81
+--  RM 6/17/82
+-- SPS 10/26/82
+-- RLB  6/29/01 - FIXED TO ALLOW AGGRESIVE OPTIMIZATION.
+
+WITH REPORT;
+PROCEDURE C52011A IS
+
+     USE REPORT;
+
+     TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER;
+     TYPE ARR_NAME IS ACCESS ARR;
+     SUBTYPE S1 IS ARR_NAME(IDENT_INT(1)..IDENT_INT(10));
+     SUBTYPE S2 IS ARR_NAME(IDENT_INT(3)..IDENT_INT(6));
+
+     W : ARR_NAME := NULL;                    -- E.
+     X1,X2 : S1 := NULL;                      -- E.
+     Y1,Y2 : S2 := NULL;                      -- E.
+
+     W_NONNULL  : ARR_NAME := NEW ARR'(3..5=>7) ;
+     X1_NONNULL : S1       := NEW ARR'(IDENT_INT(1)..IDENT_INT(10)=>7);
+     Y1_NONNULL : S2       := NEW ARR'(IDENT_INT(3)..IDENT_INT( 6)=>7);
+
+     TOO_EARLY : BOOLEAN := TRUE;
+
+BEGIN
+
+     TEST ("C52011A", "INDEX CONSTRAINTS ON ACCESS SUBTYPE OBJECTS " &
+                      "MUST BE SATISFIED FOR ASSIGNMENT");
+
+     BEGIN
+
+          IF EQUAL(3,3) THEN
+               W_NONNULL := X1;               -- A.
+          END IF;
+          IF W_NONNULL /= X1 THEN
+               FAILED ("ASSIGNMENT FAILED - 1");
+          END IF;
+
+          IF EQUAL(3,3) THEN
+               X1_NONNULL := X2;              -- A.
+          END IF;
+          IF X1_NONNULL /= X2 THEN
+               FAILED ("ASSIGNMENT FAILED - 2");
+          END IF;
+
+          IF EQUAL(3,3) THEN
+               X1_NONNULL := Y1;              -- A.
+          END IF;
+          IF X1 /= Y1 THEN
+               FAILED ("ASSIGNMENT FAILED - 3");
+          END IF;
+
+          X1 := NEW ARR'(1..IDENT_INT(10) => 5);
+          IF EQUAL(3,3) THEN
+               X2 := X1;                      -- B.
+          END IF;
+          IF X2 /= X1 THEN
+               FAILED ("ASSIGNMENT FAILED - 4");
+          END IF;
+
+          IF EQUAL(3,3) THEN
+               W := X1;                       -- B.
+          END IF;
+          IF W /= X1 THEN
+               FAILED ("ASSIGNMENT FAILED - 5");
+          END IF;
+
+          BEGIN
+               Y1 := X1;                      -- C.
+               IF Y1'FIRST /= REPORT.IDENT_INT(3) THEN
+                  FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
+                     "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
+                     "AND CONSTRAINT IS CHANGED");
+               ELSE
+                  FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
+                     "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
+                     "AND CONSTRAINT IS NOT CHANGED");
+               END IF;
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR => NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION - 1");
+
+          END;
+
+          W := NEW ARR'(IDENT_INT(3)..IDENT_INT(6) => 3);
+
+          BEGIN
+               X1 := W;                            -- D.
+               IF X1'FIRST /= REPORT.IDENT_INT(1) THEN
+                  FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
+                          "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
+                          "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
+                          "AND CONSTRAINT IS CHANGED");
+               ELSE
+                  FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
+                          "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
+                          "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
+                          "AND CONSTRAINT IS NOT CHANGED");
+               END IF;
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL ;
+
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION - 2");
+
+          END;
+
+     EXCEPTION
+
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED");
+
+     END;
+
+
+     RESULT;
+
+
+END C52011A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52011b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52011b.ada
new file mode 100644
index 000000000..460f51835
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52011b.ada
@@ -0,0 +1,180 @@
+-- C52011B.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 DISCRIMINANT CONSTRAINTS FOR ASSIGNMENT OF ACCESS SUBTYPES.
+-- SPECIFICALLY, CHECK THAT:
+
+-- A) ANY ACCESS TYPE VARIABLE AND CONSTRAINED SUBTYPE VARIABLES OF THAT
+-- TYPE MAY BE ASSIGNED TO ONE ANOTHER IF THE VALUE BEING ASSIGNED
+-- IS NULL.
+
+-- B) VARIABLES OF THE SAME CONSTRAINED ACCESS SUBTYPE MAY BE ASSIGNED
+-- TO ONE ANOTHER OR TO VARIABLES OF THE BASE ACCESS TYPE.
+
+-- C) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF NON-NULL OBJECTS
+-- BETWEEN DIFFERENTLY CONSTRAINED ACCESS SUBTYPES.
+
+-- D) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF A NON-NULL OBJECT
+-- OF A BASE ACCESS TYPE VARIABLE TO A VARIABLE OF ONE OF ITS
+-- CONSTRAINED SUBTYPES IF THE CONSTRAINTS ON THE OBJECT DIFFER
+-- FROM THOSE ON THE SUBTYPE.
+
+-- E) NULL CAN BE ASSIGNED TO BASE ACCESS TYPES AND ANY CONSTRAINED
+-- SUBTYPES OF THIS TYPE.
+
+-- ASL 7/06/81
+--  RM 6/17/82
+-- RLB 6/29/01 - FIXED TO ALLOW AGGRESIVE OPTIMIZATION.
+
+WITH REPORT;
+PROCEDURE C52011B IS
+
+     USE REPORT;
+
+     TYPE REC(DISC : INTEGER := -1 ) IS
+          RECORD
+               NULL;
+          END RECORD;
+
+     TYPE REC_NAME IS ACCESS REC;
+     SUBTYPE S1 IS REC_NAME(IDENT_INT(5));
+     SUBTYPE S2 IS REC_NAME(IDENT_INT(3));
+
+     W : REC_NAME := NULL;                    -- E.
+     X1,X2 : S1 := NULL;                      -- E.
+     Y1,Y2 : S2 := NULL;                      -- E.
+
+     W_NONNULL  : REC_NAME := NEW REC(7) ;
+     X1_NONNULL : S1       := NEW REC(IDENT_INT(5));
+     Y1_NONNULL : S2       := NEW REC(IDENT_INT(3));
+
+     TOO_EARLY : BOOLEAN := TRUE;
+
+BEGIN
+
+     TEST ("C52011B", "DISCRIMINANT CONSTRAINTS ON ACCESS SUBTYPE " &
+                      "OBJECTS MUST BE SATISFIED FOR ASSIGNMENT");
+
+     BEGIN
+
+          IF EQUAL(3,3) THEN
+               W_NONNULL := X1;               -- A.
+          END IF;
+          IF W_NONNULL /= X1 THEN
+               FAILED ("ASSIGNMENT FAILED - 1");
+          END IF;
+
+          IF EQUAL(3,3) THEN
+               W := Y1;                       -- A.
+          END IF;
+          IF W /= Y1 THEN
+               FAILED ("ASSIGNMENT FAILED - 2");
+          END IF;
+
+          IF EQUAL(3,3) THEN
+               X1_NONNULL := Y1;              -- A.
+          END IF;
+          IF X1_NONNULL /= Y1 THEN
+               FAILED ("ASSIGNMENT FAILED - 3");
+          END IF;
+
+          IF EQUAL(3,3) THEN
+               Y1_NONNULL := Y2;              -- A.
+          END IF;
+          IF Y1_NONNULL /= Y2 THEN
+               FAILED ("ASSIGNMENT FAILED - 4");
+          END IF;
+
+          X1 := NEW REC(IDENT_INT(5));
+          IF EQUAL(3,3) THEN
+               X2 := X1;                      -- B.
+          END IF;
+          IF X1 /= X2 THEN
+               FAILED ("ASSIGNMENT FAILED - 5");
+          END IF;
+
+          IF EQUAL(3,3) THEN
+               W := X1;                       -- B.
+          END IF;
+          IF W /= X1 THEN
+               FAILED ("ASSIGNMENT FAILED - 6");
+          END IF;
+
+          BEGIN
+               Y1 := X1;                      -- C.
+               IF Y1.DISC /= REPORT.IDENT_INT(3) THEN
+                  FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
+                     "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
+                     "AND CONSTRAINT IS CHANGED");
+               ELSE
+                  FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
+                     "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
+                     "AND CONSTRAINT IS NOT CHANGED");
+               END IF;
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR => NULL;
+
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION - 1");
+
+          END;
+
+          W := NEW REC(IDENT_INT(3));
+
+          BEGIN
+               X1 := W;                            -- D.
+               IF X1.DISC /= REPORT.IDENT_INT(5) THEN
+                  FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
+                          "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
+                          "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
+                          "AND CONSTRAINT IS CHANGED");
+               ELSE
+                  FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
+                          "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
+                          "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
+                          "AND CONSTRAINT IS NOT CHANGED");
+               END IF;
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    NULL ;
+
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION - 2");
+
+          END;
+
+     EXCEPTION
+
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED");
+
+     END;
+
+
+     RESULT;
+
+
+END C52011B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52101a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52101a.ada
new file mode 100644
index 000000000..87a450040
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52101a.ada
@@ -0,0 +1,81 @@
+-- C52101A.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 ARRAY SUBTYPE CONVERSION IS APPLIED AFTER AN ARRAY VALUE
+-- IS DETERMINED.
+
+-- BHS 6/22/84
+
+WITH REPORT;
+PROCEDURE C52101A IS
+
+     USE REPORT;
+
+     TYPE DAY IS (MON, TUE, WED, THU, FRI, SAT, SUN);
+     SUBTYPE WEEKDAY IS DAY RANGE MON..FRI;
+
+     TYPE ARR IS ARRAY  (WEEKDAY RANGE <>) OF INTEGER;
+     TYPE ARR_DAY IS ARRAY (DAY RANGE <>) OF INTEGER;
+
+     NORM     : ARR (MON..FRI);          -- INDEX SUBTYPE WEEKDAY
+     NORM_DAY : ARR_DAY (MON..FRI);      -- INDEX SUBTYPE DAY
+
+BEGIN
+     TEST ("C52101A", "CHECK THAT ARRAY SUBTYPE CONVERSION " &
+                      "APPLIED AFTER ARRAY VAL. DETERMINED");
+
+     BEGIN   -- ILLEGAL CASE
+          NORM := (WED..SUN => 0);        -- ERROR: INDEX SUBTYPE
+
+          FAILED ("EXCEPTION NOT RAISED FOR INDEX SUBTYPE ERROR");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("IMPROPER AGGREGATE BOUNDS DETECTED");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+
+     END;
+
+
+     BEGIN    -- LEGAL CASE
+          NORM_DAY := (WED..FRI => 0, SAT..SUN => 1);
+          IF NORM_DAY /= ( 0, 0, IDENT_INT(0), IDENT_INT(1),
+                                               IDENT_INT(1)) THEN
+               FAILED ("INCORRECT ASSIGNMENT IN LEGAL CASE");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED ON LEGAL INDEX " &
+                       "SUBTYPE CONVERSION");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED IN LEGAL CASE");
+
+     END;
+
+
+     RESULT;
+
+END C52101A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102a.ada
new file mode 100644
index 000000000..0d686edd5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102a.ada
@@ -0,0 +1,251 @@
+-- C52102A.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 ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
+--    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
+--    THE SEMANTICS OF "COPY" ASSIGNMENT.  (THIS TEST IS IN TWO PARTS,
+--    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
+
+-- PART 1:  STATIC BOUNDS
+
+
+-- RM 02/25/80
+-- SPS 2/18/83
+-- JBG 8/21/83
+-- JBG 5/8/84
+-- JBG 6/09/84
+
+WITH REPORT;
+PROCEDURE  C52102A  IS
+
+     USE  REPORT; 
+
+
+BEGIN
+
+
+     TEST( "C52102A" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
+                       "SOURCE AND TARGET VARIABLES (INCLUDING " &
+                       "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
+                       "SATISFIES THE SEMANTICS OF ""COPY"" " &
+                       "ASSIGNMENT (PART 1: STATIC BOUNDS)" );
+
+
+     -------------------------------------------------------------------
+     --------------------  ARRAYS OF INTEGERS  -------------------------
+
+     DECLARE
+          A   :    ARRAY( 1..4 ) OF INTEGER; 
+
+     BEGIN
+          A   :=   (  11  ,  12  ,  13  ,  14  );
+          A   :=   (  1   , A(1) , A(2) , A(1) );
+          IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
+               FAILED( "WRONG VALUES  -  I1" );
+          END IF;
+
+          A   :=   (  11  ,  12  ,  13  ,  14  );
+          A   :=   ( A(4) , A(3) , A(4) ,  1   );
+          IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
+               FAILED( "WRONG VALUES  -  I2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    ARRAY( INTEGER RANGE -4..4 ) OF INTEGER; 
+
+     BEGIN
+          A   :=  (  -4 , -3 , -2 , -1 , 100 , 1 , 2 , 3 , 4 );
+          A(-4..0)  :=  A(0..4); 
+          IF  A   /=  ( 100 ,  1 ,  2 ,  3 ,  4  , 1 , 2 , 3 , 4 )
+          THEN
+               FAILED( "WRONG VALUES  -  I3" );
+          END IF;
+
+          A   :=  ( -4 , -3 , -2 , -1 , 100 ,  1 ,  2 ,  3 ,  4 );
+          A(0..4)   :=  A(-4..0); 
+          IF  A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
+          THEN
+               FAILED( "WRONG VALUES  -  I4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE INT_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          A  :  INT_ARR (1..10);
+
+     BEGIN
+          A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
+          A   :=  0  &  A(1..2)  &  A(1..2)  &  A(1..5); 
+          IF  A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
+          THEN
+               FAILED( "WRONG VALUES  -  I5" );
+          END IF;
+
+          A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
+          A   :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  0  &  0; 
+          IF  A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
+          THEN
+               FAILED( "WRONG VALUES  -  I6" );
+          END IF;
+
+     END; 
+
+
+     -------------------------------------------------------------------
+     --------------------  ARRAYS OF BOOLEANS  -------------------------
+
+     DECLARE
+          A   :    ARRAY( 1..4 ) OF BOOLEAN; 
+
+     BEGIN
+          A   :=   (  FALSE , TRUE , TRUE , FALSE );
+          A   :=   (  TRUE  , A(1) , A(2) , A(1)  );
+          IF  A /= (  TRUE , FALSE , TRUE , FALSE )
+          THEN
+               FAILED( "WRONG VALUES  -  B1" );
+          END IF;
+
+          A   :=   (  FALSE , TRUE , TRUE , FALSE );
+          A   :=   (  A(4)  , A(3) , A(4) ,  TRUE );
+          IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
+          THEN
+               FAILED( "WRONG VALUES  -  B2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    ARRAY( INTEGER RANGE -4..4 ) OF BOOLEAN; 
+
+     BEGIN
+          A  := (FALSE,FALSE,FALSE,FALSE,FALSE,TRUE, TRUE, TRUE,TRUE);
+          A(-4..0)  :=  A(0..4); 
+          IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B3" );
+          END IF;
+
+          A  := (FALSE,FALSE,FALSE,FALSE, TRUE,TRUE, TRUE, TRUE,TRUE);
+          A(0..4)   :=  A(-4..0); 
+          IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+          A  :  B_ARR (1..10); 
+
+     BEGIN
+          A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
+          A :=  FALSE  &  A(1..2)  &  A(1..2)  &  A(1..5); 
+          IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B5" );
+          END IF;
+
+          A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
+          A :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  FALSE  &  TRUE; 
+          IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B6" );
+          END IF;
+
+     END; 
+
+
+     -------------------------------------------------------------------
+     --------------------  CHARACTER STRINGS  --------------------------
+
+     DECLARE
+          A   :    STRING( 1..4 ); 
+
+     BEGIN
+          A   :=   "ARGH"; 
+          A   :=   (  'Q' , A(1) , A(2) , A(1) );
+          IF  A /= "QARA"  THEN
+               FAILED( "WRONG VALUES  -  C1" );
+          END IF;
+
+          A   :=   "ARGH"; 
+          A   :=   ( A(4) , A(3) , A(4) , 'X' );
+          IF  A /= "HGHX"  THEN
+               FAILED( "WRONG VALUES  -  C2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    STRING( 96..104 );
+
+     BEGIN
+          A  :=  "APHRODITE"; 
+          A(96..100)  :=  A(100..104); 
+          IF  A  /=  "ODITEDITE"   THEN
+               FAILED( "WRONG VALUES  -  C3" );
+          END IF;
+
+          A  :=  "APHRODITE"; 
+          A(100..104) :=  A(96..100) ; 
+          IF  A  /=  "APHRAPHRO"   THEN
+               FAILED( "WRONG VALUES  -  C4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
+          A  :  CH_ARR (1..9);
+
+     BEGIN
+          A   :=  "CAMBRIDGE"; 
+          A   :=  'S'  &  A(1..2)  &  A(1..2)  &  A(1..4); 
+          IF  A  /=  "SCACACAMB"  THEN
+               FAILED( "WRONG VALUES  -  C5" );
+          END IF;
+
+          A   :=  "CAMBRIDGE"; 
+          A   :=  A(8..8)  &  A(6..8)  &  A(6..8)  &  "EA"; 
+          IF  A  /=  "GIDGIDGEA"  THEN
+               FAILED( "WRONG VALUES  -  C6" );
+          END IF;
+
+     END; 
+
+
+     RESULT; 
+
+
+END C52102A; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102b.ada
new file mode 100644
index 000000000..79b304947
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102b.ada
@@ -0,0 +1,278 @@
+-- C52102B.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 ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
+--    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
+--    THE SEMANTICS OF "COPY" ASSIGNMENT.  (THIS TEST IS IN TWO PARTS,
+--    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
+
+-- PART 2:  DYNAMIC BOUNDS
+
+
+-- RM 02/27/80
+-- SPS 2/18/83
+-- JBG 3/15/84
+-- JBG 6/9/84
+
+WITH REPORT;
+PROCEDURE  C52102B  IS
+
+     USE  REPORT; 
+     IDENT_INT_0 : INTEGER := IDENT_INT(0);
+     IDENT_INT_1 : INTEGER := IDENT_INT (1);
+     IDENT_INT_2 : INTEGER := IDENT_INT (2);
+     IDENT_INT_3 : INTEGER := IDENT_INT (3);
+     IDENT_INT_4 : INTEGER := IDENT_INT (4);
+     IDENT_INT_5 : INTEGER := IDENT_INT (5);
+     IDENT_INT_6 : INTEGER := IDENT_INT (6);
+     IDENT_INT_8 : INTEGER := IDENT_INT (8);
+     IDENT_INT_9 : INTEGER := IDENT_INT (9);
+
+BEGIN
+
+
+     TEST( "C52102B" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
+                       "SOURCE AND TARGET VARIABLES (INCLUDING " &
+                       "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
+                       "SATISFIES THE SEMANTICS OF ""COPY"" " &
+                       "ASSIGNMENT (PART 2: DYNAMIC BOUNDS)" );
+
+
+     -------------------------------------------------------------------
+     --------------------  ARRAYS OF INTEGERS  -------------------------
+
+     DECLARE
+          A   :   ARRAY( 1..IDENT_INT_4 ) OF INTEGER; 
+
+     BEGIN
+          A   :=   (  11  ,  12  ,  13  ,  14  );
+          A   :=   (  1   , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                              A(IDENT_INT_1) );
+          IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
+               FAILED( "WRONG VALUES  -  I1" );
+          END IF;
+
+          A   :=   (  11  ,  12  ,  13  ,  14  );
+          A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
+                                       A(IDENT_INT_4) ,  1   );
+          IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
+               FAILED( "WRONG VALUES  -  I2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    ARRAY( -4..IDENT_INT_4 ) OF INTEGER; 
+
+     BEGIN
+          A         :=  (  -4 , -3 , -2 , -1 , 100 , 1 , 2 , 3 , 4 );
+          A(-4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
+          IF    A   /=  ( 100 ,  1 ,  2 ,  3 ,  4  , 1 , 2 , 3 , 4 )
+          THEN
+               FAILED( "WRONG VALUES  -  I3" );
+          END IF;
+
+          A   :=  ( -4 , -3 , -2 , -1 , 100 ,  1 ,  2 ,  3 ,  4 );
+          A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
+          IF    A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
+          THEN
+               FAILED( "WRONG VALUES  -  I4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          A   :  ARR (1..10);
+
+     BEGIN
+          A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
+          A   :=  0  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                        A(IDENT_INT_1..IDENT_INT_2)  &
+                         A(IDENT_INT_1..IDENT_INT_5); 
+          IF   A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
+          THEN
+               FAILED( "WRONG VALUES  -  I5" );
+          END IF;
+
+          A   :=  ( 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 );
+          A   :=  A(IDENT_INT_6..IDENT_INT_9)  &
+                  A(IDENT_INT_8..IDENT_INT_9)  &
+                  A(IDENT_INT_8..IDENT_INT_9)  &  0  &  0; 
+          IF   A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
+          THEN
+               FAILED( "WRONG VALUES  -  I6" );
+          END IF;
+
+     END; 
+
+
+     -------------------------------------------------------------------
+     --------------------  ARRAYS OF BOOLEANS  -------------------------
+
+     DECLARE
+          A   :    ARRAY( 1..4 ) OF BOOLEAN; 
+
+     BEGIN
+          A   :=   (  FALSE , TRUE , TRUE , FALSE );
+          A   :=   (  TRUE  , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                                A(IDENT_INT_1)  );
+          IF  A /= (  TRUE , FALSE , TRUE , FALSE )
+          THEN
+               FAILED( "WRONG VALUES  -  B1" );
+          END IF;
+
+          A   :=   (  FALSE , TRUE , TRUE , FALSE );
+          A   :=   (  A(IDENT_INT_4)  , A(IDENT_INT_3) ,
+                                         A(IDENT_INT_4) ,  TRUE );
+          IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
+          THEN
+               FAILED( "WRONG VALUES  -  B2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    ARRAY( -IDENT_INT_4..4 ) OF BOOLEAN; 
+
+     BEGIN
+          A  := (FALSE,FALSE,FALSE,FALSE,FALSE,TRUE, TRUE, TRUE,TRUE);
+          A(-IDENT_INT_4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
+          IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B3" );
+          END IF;
+
+          A  := (FALSE,FALSE,FALSE,FALSE, TRUE,TRUE, TRUE, TRUE,TRUE);
+          A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
+          IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+          A  :  B_ARR (1..10); 
+
+     BEGIN
+          A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
+          A :=  FALSE  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                          A(IDENT_INT_1..IDENT_INT_2)  &
+                          A(IDENT_INT_1..IDENT_INT_5); 
+          IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B5" );
+          END IF;
+
+          A := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE);
+          A :=  A(IDENT_INT_6..IDENT_INT_9)  &
+                A(IDENT_INT_8..IDENT_INT_9)  &
+                A(IDENT_INT_8..IDENT_INT_9)  &      FALSE  &  TRUE; 
+          IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B6" );
+          END IF;
+
+     END; 
+
+
+     -------------------------------------------------------------------
+     --------------------  CHARACTER STRINGS  --------------------------
+
+     DECLARE
+          A   :    STRING( 1..4 ); 
+
+     BEGIN
+          A   :=   "ARGH"; 
+          A   :=   (  'Q' , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                              A(IDENT_INT_1) );
+          IF  A /= "QARA"  THEN
+               FAILED( "WRONG VALUES  -  C1" );
+          END IF;
+
+          A   :=   "ARGH"; 
+          A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
+                     A(IDENT_INT_4) , 'X' );
+          IF  A /= "HGHX"  THEN
+               FAILED( "WRONG VALUES  -  C2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    STRING( IDENT_INT(96)..104 );
+
+     BEGIN
+          A   :=  "APHRODITE"; 
+          A(IDENT_INT(96)..IDENT_INT(100))  :=  A(IDENT_INT(100)..
+                                                  IDENT_INT(104)); 
+          IF  A  /=  "ODITEDITE"   THEN
+               FAILED( "WRONG VALUES  -  C3" );
+          END IF;
+
+          A   :=  "APHRODITE"; 
+          A(IDENT_INT(100)..IDENT_INT(104)) :=  A(IDENT_INT(96)..
+                                                  IDENT_INT(100)) ; 
+          IF  A  /=  "APHRAPHRO"   THEN
+               FAILED( "WRONG VALUES  -  C4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
+          A  :  CH_ARR (IDENT_INT_1..9); 
+
+     BEGIN
+          A   :=  "CAMBRIDGE"; 
+          A   :=  'S'  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                          A(IDENT_INT_1..IDENT_INT_2)  &
+                          A(IDENT_INT_1..IDENT_INT_4); 
+          IF  A  /=  "SCACACAMB"  THEN
+               FAILED( "WRONG VALUES  -  C5" );
+          END IF;
+
+          A   :=  "CAMBRIDGE"; 
+          A   :=  A(IDENT_INT_8..IDENT_INT_8)  &
+                  A(IDENT_INT_6..IDENT_INT_8)  &
+                  A(IDENT_INT_6..IDENT_INT_8)  &  "EA"; 
+          IF  A  /=  "GIDGIDGEA"  THEN
+               FAILED( "WRONG VALUES  -  C6" );
+          END IF;
+
+     END; 
+
+
+     RESULT; 
+
+
+END C52102B; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102c.ada
new file mode 100644
index 000000000..17fdf43f9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102c.ada
@@ -0,0 +1,280 @@
+-- C52102C.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 ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
+--    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
+--    THE SEMANTICS OF "COPY" ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES
+--    REQUIRE RUN-TIME EVALUATION.   (THIS TEST IS IN TWO PARTS,
+--    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
+
+-- PART 1:  STATIC BOUNDS
+
+
+-- RM 02/25/80
+-- SPS 2/18/83
+-- JBG 8/21/83
+-- JBG 5/8/84
+-- JBG 6/09/84
+-- BHS 6/26/84
+
+WITH REPORT;
+PROCEDURE  C52102C  IS
+
+     USE  REPORT; 
+
+     FUNCTION ID_I (X : INTEGER) RETURN INTEGER RENAMES IDENT_INT;
+     FUNCTION ID_B (X : BOOLEAN) RETURN BOOLEAN RENAMES IDENT_BOOL;
+
+BEGIN
+
+
+     TEST( "C52102C" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
+                       "SOURCE AND TARGET VARIABLES (INCLUDING " &
+                       "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
+                       "SATISFIES THE SEMANTICS OF ""COPY"" " &
+                       "ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES " &
+                       "ARE DYNAMIC  (PART 1: STATIC BOUNDS)" );
+
+
+     -------------------------------------------------------------------
+     --------------------  ARRAYS OF INTEGERS  -------------------------
+
+     DECLARE
+          A   :    ARRAY( 1..4 ) OF INTEGER; 
+
+     BEGIN
+          A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14));
+          A   :=   (  1   , A(1) , A(2) , A(1) );
+          IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
+               FAILED( "WRONG VALUES  -  I1" );
+          END IF;
+
+          A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14));
+          A   :=   ( A(4) , A(3) , A(4) ,  1   );
+          IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
+               FAILED( "WRONG VALUES  -  I2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    ARRAY( INTEGER RANGE -4..4 ) OF INTEGER; 
+
+     BEGIN
+          A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
+                     ID_I(100), ID_I(1),ID_I(2), ID_I(3), ID_I(4) );
+          A(-4..0)  :=  A(0..4); 
+          IF    A   /=  ( 100 ,  1 ,  2 ,  3 ,  4  , 1 , 2 , 3 , 4 )
+          THEN
+               FAILED( "WRONG VALUES  -  I3" );
+          END IF;
+
+          A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
+               ID_I(100),  ID_I(1), ID_I(2),  ID_I(3),  ID_I(4) );
+          A(0..4)   :=  A(-4..0); 
+          IF    A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
+          THEN
+               FAILED( "WRONG VALUES  -  I4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE INT_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          A  :  INT_ARR (1..10);
+
+     BEGIN
+          A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
+                     ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10) );
+          A   :=  0  &  A(1..2)  &  A(1..2)  &  A(1..5); 
+          IF   A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
+          THEN
+               FAILED( "WRONG VALUES  -  I5" );
+          END IF;
+
+          A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
+                    ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10) );
+          A   :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  0  &  0; 
+          IF   A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
+          THEN
+               FAILED( "WRONG VALUES  -  I6" );
+          END IF;
+
+     END; 
+
+
+     -------------------------------------------------------------------
+     --------------------  ARRAYS OF BOOLEANS  -------------------------
+
+     DECLARE
+          A   :    ARRAY( 1..4 ) OF BOOLEAN; 
+
+     BEGIN
+          A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
+          A   :=   (  TRUE  , A(1) , A(2) , A(1)  );
+          IF  A /= (  TRUE  ,FALSE , TRUE , FALSE )
+          THEN
+               FAILED( "WRONG VALUES  -  B1" );
+          END IF;
+
+          A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
+          A   :=   (  A(4)  , A(3) , A(4) ,  TRUE );
+          IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
+          THEN
+               FAILED( "WRONG VALUES  -  B2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    ARRAY( INTEGER RANGE -4..4 ) OF BOOLEAN; 
+
+     BEGIN
+          A   := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
+                  ID_B(FALSE), ID_B(TRUE), ID_B(TRUE),
+                  ID_B(TRUE), ID_B(TRUE));
+          A(-4..0)  :=  A(0..4); 
+          IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B3" );
+          END IF;
+
+          A   := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
+                  ID_B(TRUE), ID_B(TRUE), ID_B(TRUE),
+                  ID_B(TRUE), ID_B(TRUE));
+          A(0..4)   :=  A(-4..0); 
+          IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+          A  :  B_ARR (1..10); 
+
+     BEGIN
+          A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
+                ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), 
+                ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
+          A :=  FALSE  &  A(1..2)  &  A(1..2)  &  A(1..5); 
+          IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B5" );
+          END IF;
+
+          A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
+                ID_B(TRUE), ID_B(FALSE), ID_B(TRUE),
+                ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
+          A :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  FALSE  &  TRUE; 
+          IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B6" );
+          END IF;
+
+     END; 
+
+
+     -------------------------------------------------------------------
+     --------------------  CHARACTER STRINGS  --------------------------
+
+     DECLARE
+          A   :    STRING( 1..4 ); 
+
+     BEGIN
+          IF EQUAL (3,3) THEN
+               A   :=   "ARGH"; 
+          END IF;
+          A   :=   (  'Q' , A(1) , A(2) , A(1) );
+          IF  A /= "QARA"  THEN
+               FAILED( "WRONG VALUES  -  C1" );
+          END IF;
+
+          IF EQUAL (3,3) THEN
+               A   :=   "ARGH"; 
+          END IF;
+          A   :=   ( A(4) , A(3) , A(4) , 'X' );
+          IF  A /= "HGHX"  THEN
+               FAILED( "WRONG VALUES  -  C2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    STRING( 96..104 );
+
+     BEGIN
+          IF EQUAL (3,3) THEN
+               A      :=  "APHRODITE"; 
+          END IF;
+          A(96..100)  :=  A(100..104); 
+          IF  A  /=  "ODITEDITE"   THEN
+               FAILED( "WRONG VALUES  -  C3" );
+          END IF;
+
+          IF EQUAL (3,3) THEN
+               A      :=  "APHRODITE"; 
+          END IF;
+          A(100..104) :=  A(96..100) ; 
+          IF  A  /=  "APHRAPHRO"   THEN
+               FAILED( "WRONG VALUES  -  C4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
+          A  :  CH_ARR (1..9); 
+
+     BEGIN
+          IF EQUAL (3,3) THEN
+               A   :=  "CAMBRIDGE"; 
+          END IF;
+          A   :=  'S'  &  A(1..2)  &  A(1..2)  &  A(1..4); 
+          IF  A  /=  "SCACACAMB"  THEN
+               FAILED( "WRONG VALUES  -  C5" );
+          END IF;
+
+          IF EQUAL (3,3) THEN
+               A   :=  "CAMBRIDGE"; 
+          END IF;
+          A   :=  A(8..8)  &  A(6..8)  &  A(6..8)  &  "EA"; 
+          IF  A  /=  "GIDGIDGEA"  THEN
+               FAILED( "WRONG VALUES  -  C6" );
+          END IF;
+
+     END; 
+
+
+     RESULT; 
+
+
+END C52102C; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102d.ada
new file mode 100644
index 000000000..fd4e41350
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52102d.ada
@@ -0,0 +1,307 @@
+-- C52102D.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 ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
+--    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
+--    THE SEMANTICS OF "COPY" ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES
+--    REQUIRE RUN-TIME EVALUATION.   (THIS TEST IS IN TWO PARTS,
+--    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
+
+-- PART 2:  DYNAMIC BOUNDS
+
+
+-- RM 02/27/80
+-- SPS 2/18/83
+-- JBG 3/15/84
+-- JBG 6/9/84
+-- BHS 6/26/84
+
+WITH REPORT;
+PROCEDURE  C52102D  IS
+
+     USE  REPORT; 
+     IDENT_INT_0 : INTEGER := IDENT_INT(0);
+     IDENT_INT_1 : INTEGER := IDENT_INT (1);
+     IDENT_INT_2 : INTEGER := IDENT_INT (2);
+     IDENT_INT_3 : INTEGER := IDENT_INT (3);
+     IDENT_INT_4 : INTEGER := IDENT_INT (4);
+     IDENT_INT_5 : INTEGER := IDENT_INT (5);
+     IDENT_INT_6 : INTEGER := IDENT_INT (6);
+     IDENT_INT_8 : INTEGER := IDENT_INT (8);
+     IDENT_INT_9 : INTEGER := IDENT_INT (9);
+
+     FUNCTION ID_I (X : INTEGER) RETURN INTEGER RENAMES IDENT_INT;
+     FUNCTION ID_B (X : BOOLEAN) RETURN BOOLEAN RENAMES IDENT_BOOL;
+
+BEGIN
+
+
+     TEST( "C52102D" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
+                       "SOURCE AND TARGET VARIABLES (INCLUDING " &
+                       "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
+                       "SATISFIES THE SEMANTICS OF ""COPY"" " &
+                       "ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES " &
+                       "ARE DYNAMIC  (PART 2: DYNAMIC BOUNDS)" );
+
+     -------------------------------------------------------------------
+     --------------------  ARRAYS OF INTEGERS  -------------------------
+
+     DECLARE
+          A   :    ARRAY( 1..IDENT_INT_4 ) OF INTEGER; 
+
+     BEGIN
+          A   :=   ( ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14) );
+          A   :=   (  1   , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                              A(IDENT_INT_1) );
+          IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
+               FAILED( "WRONG VALUES  -  I1" );
+          END IF;
+
+          A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14) );
+          A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
+                                       A(IDENT_INT_4) ,  1   );
+          IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
+               FAILED( "WRONG VALUES  -  I2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    ARRAY( -4..IDENT_INT_4 ) OF INTEGER; 
+
+     BEGIN
+          A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
+                    ID_I(100), ID_I(1), ID_I(2), ID_I(3), ID_I(4));
+          A(-4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
+          IF    A   /=  ( 100 , 1 , 2 , 3 , 4 , 1 , 2 , 3 , 4 )
+          THEN
+               FAILED( "WRONG VALUES  -  I3" );
+          END IF;
+
+          A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
+                    ID_I(100), ID_I(1), ID_I(2), ID_I(3), ID_I(4));
+          A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
+          IF    A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
+          THEN
+               FAILED( "WRONG VALUES  -  I4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE INT_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          A   :  INT_ARR (1..10);
+
+     BEGIN
+          A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
+                    ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10));
+          A   :=  0  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                        A(IDENT_INT_1..IDENT_INT_2)  &
+                        A(IDENT_INT_1..IDENT_INT_5); 
+          IF     A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
+          THEN
+               FAILED( "WRONG VALUES  -  I5" );
+          END IF;
+
+          A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
+                    ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10));
+          A   :=  A(IDENT_INT_6..IDENT_INT_9)  &
+                  A(IDENT_INT_8..IDENT_INT_9)  &
+                  A(IDENT_INT_8..IDENT_INT_9)  &  0  &  0; 
+          IF   A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
+          THEN
+               FAILED( "WRONG VALUES  -  I6" );
+          END IF;
+
+     END; 
+
+
+     -------------------------------------------------------------------
+     --------------------  ARRAYS OF BOOLEANS  -------------------------
+
+     DECLARE
+          A   :    ARRAY( 1..4 ) OF BOOLEAN; 
+
+     BEGIN
+          A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
+          A   :=   (  TRUE  , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                                A(IDENT_INT_1)  );
+          IF  A /= (  TRUE  ,FALSE , TRUE , FALSE )
+          THEN
+               FAILED( "WRONG VALUES  -  B1" );
+          END IF;
+
+          A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
+          A   :=   (  A(IDENT_INT_4)  , A(IDENT_INT_3) ,
+                                         A(IDENT_INT_4) ,  TRUE );
+          IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
+          THEN
+               FAILED( "WRONG VALUES  -  B2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    ARRAY( -IDENT_INT_4..4 ) OF BOOLEAN; 
+
+     BEGIN
+          A  := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
+                 ID_B(FALSE), ID_B(TRUE), ID_B(TRUE),
+                 ID_B(TRUE), ID_B(TRUE));
+          A(-IDENT_INT_4..IDENT_INT_0)  :=  A(IDENT_INT_0..4); 
+          IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B3" );
+          END IF;
+
+          A  := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
+                 ID_B(TRUE), ID_B(TRUE), ID_B(TRUE),
+                 ID_B(TRUE), ID_B(TRUE));
+          A(IDENT_INT_0..4)   :=  A(-4..IDENT_INT_0); 
+          IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+          A  :  B_ARR (1..10); 
+
+     BEGIN
+          A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE), 
+                ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), 
+                ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
+          A :=  FALSE  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                          A(IDENT_INT_1..IDENT_INT_2)  &
+                          A(IDENT_INT_1..IDENT_INT_5); 
+          IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B5" );
+          END IF;
+
+          A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
+                ID_B(TRUE), ID_B(FALSE), ID_B(TRUE),
+                ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
+          A :=  A(IDENT_INT_6..IDENT_INT_9)  &
+                A(IDENT_INT_8..IDENT_INT_9)  &
+                A(IDENT_INT_8..IDENT_INT_9)  &  FALSE  &  TRUE; 
+          IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
+          THEN
+               FAILED( "WRONG VALUES  -  B6" );
+          END IF;
+
+     END; 
+
+
+     -------------------------------------------------------------------
+     --------------------  CHARACTER STRINGS  --------------------------
+
+     DECLARE
+          A   :    STRING( 1..4 ); 
+
+     BEGIN
+          IF EQUAL (3,3) THEN          
+               A   :=   "ARGH"; 
+          END IF;
+          A   :=   (  'Q' , A(IDENT_INT_1) , A(IDENT_INT_2) ,
+                                              A(IDENT_INT_1) );
+          IF  A /= "QARA"  THEN
+               FAILED( "WRONG VALUES  -  C1" );
+          END IF;
+
+          IF EQUAL (3,3) THEN
+               A   :=   "ARGH"; 
+          END IF;
+          A   :=   ( A(IDENT_INT_4) , A(IDENT_INT_3) ,
+                     A(IDENT_INT_4) , 'X' );
+          IF  A /= "HGHX"  THEN
+               FAILED( "WRONG VALUES  -  C2" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          A   :    STRING( IDENT_INT(96)..104 );
+
+     BEGIN
+          IF EQUAL (3,3) THEN
+               A  :=  "APHRODITE"; 
+          END IF;
+          A(IDENT_INT(96)..IDENT_INT(100))  :=  A(IDENT_INT(100)..
+                                                  IDENT_INT(104)); 
+          IF   A  /=  "ODITEDITE"   THEN
+               FAILED( "WRONG VALUES  -  C3" );
+          END IF;
+
+          IF EQUAL (3,3) THEN
+               A  :=  "APHRODITE"; 
+          END IF;
+          A(IDENT_INT(100)..IDENT_INT(104)) :=  A(IDENT_INT(96)..
+                                                  IDENT_INT(100)) ; 
+          IF   A  /=  "APHRAPHRO"   THEN
+               FAILED( "WRONG VALUES  -  C4" );
+          END IF;
+
+     END; 
+
+
+     DECLARE
+          TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
+          A  :  CH_ARR (IDENT_INT_1..9); 
+
+     BEGIN
+          IF EQUAL (3,3) THEN
+               A  :=  "CAMBRIDGE"; 
+          END IF;
+          A  :=  'S'  &  A(IDENT_INT_1..IDENT_INT_2)  &
+                         A(IDENT_INT_1..IDENT_INT_2)  &
+                         A(IDENT_INT_1..IDENT_INT_4); 
+          IF  A  /=  "SCACACAMB"  THEN
+               FAILED( "WRONG VALUES  -  C5" );
+          END IF;
+
+          IF EQUAL (3,3) THEN
+               A  :=  "CAMBRIDGE"; 
+          END IF;
+          A  :=  A(IDENT_INT_8..IDENT_INT_8)  &
+                 A(IDENT_INT_6..IDENT_INT_8)  &
+                 A(IDENT_INT_6..IDENT_INT_8)  &  "EA"; 
+          IF  A  /=  "GIDGIDGEA"  THEN
+               FAILED( "WRONG VALUES  -  C6" );
+          END IF;
+
+     END; 
+
+
+     RESULT; 
+
+
+END C52102D; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103a.ada
new file mode 100644
index 000000000..f8fca51bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103a.ada
@@ -0,0 +1,385 @@
+-- C52103A.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+--    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 2/18/83
+
+WITH REPORT;
+PROCEDURE  C52103A  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103A" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+     --
+     --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
+     --                                AND PRECISELY 5 CASES FROM THE
+     --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
+     --                                                  10-11-12-13-14)
+     --
+     --                              ( IN THE CURRENT DIVISION, THE 5
+     --                                FLOATING SELECTIONS ARE 2-11-4-
+     --                                -13-6 ; THUS THE 8 SELECTIONS ARE
+     --                                2-11-4-13-6-7-8-9 (IN THIS ORDER)
+     --                                .)
+     --
+     --
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+     --
+     --
+     --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
+     --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
+     --
+     --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
+     --        IN THE SAME DECLARATION.)
+     --
+     --
+     --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
+     --        USING AGGREGATES
+     --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
+     --                SEE  (5) )
+     --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
+     --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
+     --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
+     --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
+     --                TO THE TYPEMARK OF  ARR ),
+     --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+     --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+     --
+     --
+     --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --        (SINCE WE ARE NOT USING AGGREGATES
+     --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
+     --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+     --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+     --
+     --
+     --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
+     --
+     --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
+     --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
+     --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
+     --        ALSO WHEN NO SLIDING IS INVOLVED.)
+     --
+     --
+     --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+     --
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+     --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+     --
+     --
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+     --
+     --
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --
+     --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
+     --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+     --                                            ARRAYS ONLY,
+     --                                            DIVISIONS C AND D .)
+     --
+     --
+     --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+     --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+     --
+     --
+
+
+     -------------------------------------------------------------------
+
+     --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TA21  IS  ARRAY( INTEGER RANGE 1..5 , INTEGER RANGE 0..7
+                               )  OF INTEGER ;
+
+          SUBTYPE  TA22  IS  TA21 ;
+
+          ARR21  :  TA21 ;
+          ARR22  :  TA22 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  1..5  LOOP
+
+               FOR  J  IN  0..7  LOOP
+                    ARR21( I , J )  :=   I * I * J  ;
+               END LOOP;
+
+          END LOOP;
+
+
+          -- ARRAY ASSIGNMENT:
+
+          ARR22 := ARR21 ;
+
+          -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+
+          FOR  I  IN  1..5  LOOP
+
+               FOR  J  IN  0..7  LOOP
+
+                    IF  ARR22( I , J )  /=  ( I-0 ) * ( I-0 ) * ( J-0 )
+                    THEN
+                         FAILED( "ARRAY ASSIGNMENT NOT CORRECT" );
+                    END IF;
+
+               END LOOP;
+
+          END LOOP;
+
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 2" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+
+          SUBTYPE  TABOX11  IS  TABOX1( 1..5 ) ;
+
+          ARRX11  :  TABOX11 ;
+          ARRX12  :  TABOX1( 5..9 );
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  1..5  LOOP
+               ARRX11( I )  :=   I * I  ;
+          END LOOP;
+
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX12 := ARRX11 ;
+
+          -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+
+          FOR  I  IN  5..9  LOOP
+
+               IF  ARRX12( I )  /=  ( I-4 ) * ( I-4 )
+               THEN
+                    FAILED( "ARRAY ASSIGNMENT NOT CORRECT (11)" );
+               END IF;
+
+          END LOOP;
+
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 11" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+
+     DECLARE
+
+          TYPE  TA42  IS  ARRAY( INTEGER RANGE 1..5 )  OF BOOLEAN ;
+
+          SUBTYPE  TA41  IS  TA42 ;
+
+          ARR41  :  TA41 ;
+          ARR42  :  TA42 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  1..5  LOOP
+               ARR41( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+          END LOOP;
+
+          ARR41(2) := TRUE ;
+
+          ARR41(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+
+
+          -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+
+          ARR42( 1 )  :=  TRUE ;
+
+
+          -- SLICE ASSIGNMENT:
+
+          ARR42(2..5) := ARR41(1..4) ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          FOR  I  IN  2..5  LOOP
+
+               IF  ARR42( I )  /=  FALSE  AND  I /= 3
+               THEN
+                    FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+               ELSIF  ARR42( I ) /= TRUE  AND  I  = 3
+               THEN
+                    FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+               END IF;
+
+          END LOOP;
+
+          IF  ARR42( 1 )  /=  TRUE
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (SLIDING)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 4" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52103A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103b.ada
new file mode 100644
index 000000000..678ef5dbb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103b.ada
@@ -0,0 +1,139 @@
+-- C52103B.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE SECOND FILE IN
+--    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 2/18/83
+
+WITH REPORT;
+PROCEDURE  C52103B  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103B" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+
+          ARRX31  :  TABOX3( 11..15 );
+
+     BEGIN
+
+
+          -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+
+          ARRX31 :=  "QUINC" ; -- "QUINC"(1..5)  SLIDES TO 11..15
+
+
+          -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+
+          IF  ARRX31           /=  "QUINC"  OR
+              ARRX31( 11..15 ) /=  "QUINC"
+          THEN
+               FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 13" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+
+     DECLARE
+
+          TYPE  TA61  IS  ARRAY( INTEGER RANGE 11..15 )  OF CHARACTER ;
+
+          ARR61  :  TA61 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+
+          ARR61( 11..11 )  :=  "Q"  ;
+
+
+          -- SLICE ASSIGNMENT:
+
+          ARR61( 12..15 ) :=  "UINC" ; -- "UINC"(1..4)  SLIDES TO 12..15
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARR61           /=  "QUINC"  OR
+              ARR61( 11..15 ) /=  "QUINC"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (6)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 6" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52103B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103c.ada
new file mode 100644
index 000000000..fb122a76e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103c.ada
@@ -0,0 +1,178 @@
+-- C52103C.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE THIRD FILE IN
+--    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+
+WITH REPORT;
+
+
+PROCEDURE  C52103C  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103C" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+
+     DECLARE
+
+          ARR71  :  STRING( 1..5 )  := "ABCDE" ;
+          ARR72  :  STRING( 5..9 )  := "FGHIJ" ;
+
+     BEGIN
+
+
+          -- STRING ASSIGNMENT:
+
+          ARR72 := ARR71 ;
+
+
+          -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+          IF  ARR72 /= "ABCDE"
+          THEN
+               FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+
+     DECLARE
+
+          ARR82 : STRING( 5..9 ) ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+
+          ARR82( 5..5 )  :=  "Q"  ;
+
+
+          -- STRING LITERAL ASSIGNMENT:
+
+          ARR82( 5..9 )( 6..9 ) :=  "BCDE" ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARR82           /=  "QBCDE"  OR
+              ARR82(  5..9  ) /=  "QBCDE"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+
+     DECLARE
+
+          SUBTYPE  TA92  IS  STRING( 5..9 ) ;
+
+          ARR91  :  STRING( 1..5 )  := "ABCDE" ;
+          ARR92  :  TA92 ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+
+          ARR92( 5..5 )  :=  "Q"  ;
+
+
+          -- STRING SLICE ASSIGNMENT:
+
+          ARR92( 5..9 )( 6..9 ) :=  ARR91( 1..5 )(2..5 )( 2..5 ) ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARR92           /=  "QBCDE"  OR
+              ARR92(  5..9  ) /=  "QBCDE"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52103C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103f.ada
new file mode 100644
index 000000000..fad061697
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103f.ada
@@ -0,0 +1,338 @@
+-- C52103F.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+--    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+
+WITH REPORT;
+PROCEDURE  C52103F  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103F" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+     --
+     --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
+     --                                AND PRECISELY 5 CASES FROM THE
+     --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
+     --                                                  10-11-12-13-14)
+     --
+     --                              ( IN THE CURRENT DIVISION, THE 5
+     --                                FLOATING SELECTIONS ARE 10-3-12-
+     --                                -5-14 ; THUS THE 8 SELECTIONS ARE
+     --                                10-3-12-5-14-7-8-9 (IN THIS ORDER
+     --                                ).)
+     --
+     --
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+     --
+     --
+     --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
+     --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
+     --
+     --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
+     --        IN THE SAME DECLARATION.)
+     --
+     --
+     --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
+     --        USING AGGREGATES
+     --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
+     --                SEE  (5) )
+     --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
+     --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
+     --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
+     --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
+     --                TO THE TYPEMARK OF  ARR ),
+     --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+     --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+     --
+     --
+     --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --        (SINCE WE ARE NOT USING AGGREGATES
+     --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
+     --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+     --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+     --
+     --
+     --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+     --
+     --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
+     --
+     --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
+     --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
+     --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
+     --        ALSO WHEN NO SLIDING IS INVOLVED.)
+     --
+     --
+     --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+     --
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+     --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+     --
+     --
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+     --
+     --
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --
+     --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+     --                                            ARRAYS ONLY,
+     --                                            DIVISIONS C AND D .)
+     --
+     --
+     --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+     --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+     --
+     --
+
+
+     -------------------------------------------------------------------
+
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                 )  OF INTEGER ;
+
+          SUBTYPE  TABOX01  IS  TABOX0( 1..0 ,  0..7  );
+          SUBTYPE  TABOX02  IS  TABOX0 ;
+
+          ARRX01  :  TABOX01 ;
+          ARRX02  :  TABOX02( 7..6 , 20..27 );
+
+     BEGIN
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX02 := ARRX01 ;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 10" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TA3  IS  ARRAY( INTEGER RANGE 100..99 )  OF INTEGER ;
+
+          SUBTYPE  TA31  IS  TA3 ;
+          SUBTYPE  TA32  IS  TA3 ;
+
+          ARR31  :  TA31 ;
+          ARR32  :  TA32 ;
+
+     BEGIN
+
+          -- ARRAY ASSIGNMENT:
+
+          ARR32 := ARR31 ;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 3" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+
+     DECLARE
+
+          TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+
+          SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
+
+          ARRX51  :  TABOX51 ;
+          ARRX52  :  TABOX5( 5..9 );
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  1..5  LOOP
+               ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+          END LOOP;
+
+          ARRX51(2) := TRUE ;
+
+          ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          FOR  I  IN  5..9  LOOP
+               ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
+          END LOOP;
+
+          ARRX52(6) := FALSE ;
+
+          ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
+
+
+          -- NULL SLICE ASSIGNMENT:
+
+          ARRX52(6..5) := ARRX51(4..3) ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARRX52( 5 )  /=  TRUE   OR
+              ARRX52( 6 )  /=  FALSE  OR
+              ARRX52( 7 )  /=  TRUE   OR
+              ARRX52( 8 )  /=  TRUE   OR
+              ARRX52( 9 )  /=  FALSE
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
+
+     END ;
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52103F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103g.ada
new file mode 100644
index 000000000..0a3a8f15d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103g.ada
@@ -0,0 +1,142 @@
+-- C52103G.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE SECOND FILE IN
+--    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+
+WITH REPORT;
+PROCEDURE  C52103G  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103G" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+
+     DECLARE
+
+          TYPE  TA51  IS  ARRAY( INTEGER RANGE 11..10 )  OF CHARACTER ;
+
+          ARR51  :  TA51 ;
+
+     BEGIN
+
+
+          -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+
+          ARR51 :=  "" ;
+
+
+          -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+
+          IF  ARR51           /=  ""
+          THEN
+               FAILED( "ARRAY ASSIGNMENT NOT CORRECT (5)" );
+          END IF;
+
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 5" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+
+          SUBTYPE  TABOX42  IS  TABOX4( 11..15 );
+
+          ARRX42  :  TABOX42 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARRX42  :=  "QUINC"  ;
+
+
+          -- NULL SLICE ASSIGNMENT:
+
+          ARRX42( 13..12 ) :=  "" ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARRX42           /=  "QUINC"  OR
+              ARRX42( 11..15 ) /=  "QUINC"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (14)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 14" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52103G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103h.ada
new file mode 100644
index 000000000..6915cb4cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103h.ada
@@ -0,0 +1,175 @@
+-- C52103H.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE THIRD FILE IN
+--    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+
+WITH REPORT;
+PROCEDURE  C52103H  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103H" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+
+     DECLARE
+
+          ARR71  :  STRING( 1..0 )  := "" ;
+          ARR72  :  STRING( 5..4 )  ;
+
+     BEGIN
+
+
+          -- STRING ASSIGNMENT:
+
+          ARR72 := ARR71 ;
+
+
+          -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+          IF  ARR72 /= ""
+          THEN
+               FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+
+     DECLARE
+
+          ARR82 : STRING( 5..9 ) ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARR82( 5..9 )  :=  "QUINC"  ;
+
+
+          -- STRING LITERAL ASSIGNMENT:
+
+          ARR82( 5..9 )( 6..9 )( 6..5 ) :=  "" ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARR82           /=  "QUINC"  OR
+              ARR82(  5..9  ) /=  "QUINC"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+
+     DECLARE
+
+          SUBTYPE  TA92  IS  STRING( 5..9 ) ;
+
+          ARR91  :  STRING( 1..5 )  := "ABCDE" ;
+          ARR92  :  TA92 ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARR92( 5..9 )  :=  "QUINC"  ;
+
+
+          -- STRING SLICE ASSIGNMENT:
+
+          ARR92( 5..9 )( 6..9 )( 8..7 ) :=  ARR91( 1..5 )( 5..4 ) ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARR92           /=  "QUINC"  OR
+              ARR92(  5..9  ) /=  "QUINC"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
+
+     END ;
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52103H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103k.ada
new file mode 100644
index 000000000..f0d593be4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103k.ada
@@ -0,0 +1,393 @@
+-- C52103K.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+--    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+--                   STATICALLY.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+
+WITH REPORT;
+PROCEDURE  C52103K  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103K" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+     --
+     --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
+     --                                AND PRECISELY 5 CASES FROM THE
+     --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
+     --                                                  10-11-12-13-14)
+     --
+     --                              ( IN THE CURRENT DIVISION, THE 5
+     --                                FLOATING SELECTIONS ARE 2-11-4-
+     --                                -13-6 ; THUS THE 8 SELECTIONS ARE
+     --                                2-11-4-13-6-7-8-9 (IN THIS ORDER)
+     --                                .)
+     --
+     --
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+     --
+     --
+     --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
+     --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
+     --
+     --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
+     --        IN THE SAME DECLARATION.)
+     --
+     --
+     --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
+     --        USING AGGREGATES
+     --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
+     --                SEE  (5) )
+     --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
+     --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
+     --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
+     --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
+     --                TO THE TYPEMARK OF  ARR ),
+     --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+     --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+     --
+     --
+     --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --        (SINCE WE ARE NOT USING AGGREGATES
+     --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
+     --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+     --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+     --
+     --
+     --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
+     --
+     --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
+     --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
+     --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
+     --        ALSO WHEN NO SLIDING IS INVOLVED.)
+     --
+     --
+     --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+     --
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+     --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+     --
+     --
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+     --
+     --
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --
+     --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
+     --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+     --                                            ARRAYS ONLY,
+     --                                            DIVISIONS C AND D .)
+     --
+     --
+     --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+     --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+     --
+     --
+
+
+     -------------------------------------------------------------------
+
+     --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TA21  IS  ARRAY(
+               INTEGER RANGE IDENT_INT(1)..IDENT_INT(5) ,
+               INTEGER RANGE IDENT_INT(0)..IDENT_INT(7)
+                               )  OF INTEGER ;
+
+          SUBTYPE  TA22  IS  TA21 ;
+
+          ARR21  :  TA21 ;
+          ARR22  :  TA22 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+
+               FOR  J  IN  IDENT_INT(0)..IDENT_INT(7)  LOOP
+                    ARR21( I , J )  :=   I * I * J  ;
+               END LOOP;
+
+          END LOOP;
+
+
+          -- ARRAY ASSIGNMENT:
+
+          ARR22 := ARR21 ;
+
+          -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+
+          FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+
+               FOR  J  IN  IDENT_INT(0)..IDENT_INT(7)  LOOP
+
+                    IF  ARR22( I , J )  /=  ( I-0 ) * ( I-0 ) * ( J-0 )
+                    THEN
+                         FAILED( "ARRAY ASSIGNMENT NOT CORRECT" );
+                    END IF;
+
+               END LOOP;
+
+          END LOOP;
+
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 2" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+
+          SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(1)..IDENT_INT(5) ) ;
+
+          ARRX11  :  TABOX11 ;
+          ARRX12  :  TABOX1( IDENT_INT(5)..IDENT_INT(9) );
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+               ARRX11( I )  :=   I * I  ;
+          END LOOP;
+
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX12 := ARRX11 ;
+
+          -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+
+          FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
+
+               IF  ARRX12( I )  /=  ( I-4 ) * ( I-4 )
+               THEN
+                    FAILED( "ARRAY ASSIGNMENT NOT CORRECT (11)" );
+               END IF;
+
+          END LOOP;
+
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 11" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+
+     DECLARE
+
+          TYPE  TA42  IS  ARRAY(
+               INTEGER RANGE IDENT_INT(1)..IDENT_INT(5)
+                               )  OF BOOLEAN ;
+
+          SUBTYPE  TA41  IS  TA42 ;
+
+          ARR41  :  TA41 ;
+          ARR42  :  TA42 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+               ARR41( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+          END LOOP;
+
+          ARR41(2) := TRUE ;
+
+          ARR41(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+
+
+          -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+
+          ARR42( 1 )  :=  TRUE ;
+
+
+          -- SLICE ASSIGNMENT:
+
+          ARR42( IDENT_INT(2)..IDENT_INT(5) ) :=
+               ARR41(
+                 IDENT_INT(1)..IDENT_INT(4) ) ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          FOR  I  IN  IDENT_INT(2)..IDENT_INT(5)  LOOP
+
+               IF  ARR42( I )  /=  FALSE  AND  I /= 3
+               THEN
+                    FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+               ELSIF  ARR42( I ) /= TRUE  AND  I  = 3
+               THEN
+                    FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+               END IF;
+
+          END LOOP;
+
+          IF  ARR42( 1 )  /=  TRUE
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (SLIDING)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 4" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52103K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103l.ada
new file mode 100644
index 000000000..528745ce2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103l.ada
@@ -0,0 +1,145 @@
+-- C52103L.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE SECOND FILE IN
+--    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+--                   STATICALLY.
+
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+
+WITH REPORT;
+PROCEDURE  C52103L  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103L" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+
+          ARRX31  :  TABOX3( IDENT_INT(11)..IDENT_INT(15) );
+
+     BEGIN
+
+
+          -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+
+          ARRX31 :=  "QUINC" ; -- "QUINC"(1..5)  SLIDES TO 11..15
+
+
+          -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+
+          IF  ARRX31                                 /=  "QUINC"  OR
+              ARRX31( IDENT_INT(11)..IDENT_INT(15) ) /=  "QUINC"
+          THEN
+               FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 13" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+
+     DECLARE
+
+          TYPE  TA61  IS  ARRAY(
+               INTEGER RANGE IDENT_INT(11)..IDENT_INT(15)
+                               )  OF CHARACTER ;
+
+          ARR61  :  TA61 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+
+          ARR61( IDENT_INT(11)..IDENT_INT(11) )  :=  "Q"  ;
+
+
+          -- SLICE ASSIGNMENT:
+
+          ARR61( IDENT_INT(12)..IDENT_INT(15) ) :=  "UINC" ;
+                                   -- "UINC"(1..4)  SLIDES TO 12..15
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARR61                                 /=  "QUINC"  OR
+              ARR61( IDENT_INT(11)..IDENT_INT(15) ) /=  "QUINC"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (6)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 6" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END  C52103L ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103m.ada
new file mode 100644
index 000000000..2377248b8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103m.ada
@@ -0,0 +1,183 @@
+-- C52103M.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE THIRD FILE IN
+--    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+--                   STATICALLY.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+
+WITH REPORT;
+PROCEDURE  C52103M  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103M" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+
+     DECLARE
+
+          ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
+          ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(9) )  := "FGHIJ" ;
+
+     BEGIN
+
+
+          -- STRING ASSIGNMENT:
+
+          ARR72 := ARR71 ;
+
+
+          -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+          IF  ARR72 /= "ABCDE"
+          THEN
+               FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+
+     DECLARE
+
+          ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+
+          ARR82( IDENT_INT(5)..IDENT_INT(5) )  :=  "Q"  ;
+
+
+          -- STRING LITERAL ASSIGNMENT:
+
+          ARR82( IDENT_INT(5)..IDENT_INT(9) )
+               ( IDENT_INT(6)..IDENT_INT(9) ) :=  "BCDE" ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARR82                                 /=  "QBCDE"  OR
+              ARR82(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QBCDE"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+
+     DECLARE
+
+          SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+
+          ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
+          ARR92  :  TA92 ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+
+          ARR92( IDENT_INT(5)..IDENT_INT(5) )  :=  "Q"  ;
+
+
+          -- STRING SLICE ASSIGNMENT:
+
+          ARR92( IDENT_INT(5)..IDENT_INT(9) )
+               ( IDENT_INT(6)..IDENT_INT(9) ) :=
+               ARR91
+               ( IDENT_INT(1)..IDENT_INT(5) )
+               ( IDENT_INT(2)..IDENT_INT(5) )
+               ( IDENT_INT(2)..IDENT_INT(5) ) ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARR92                                 /=  "QBCDE"  OR
+              ARR92(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QBCDE"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END  C52103M ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103p.ada
new file mode 100644
index 000000000..7cbd7a589
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103p.ada
@@ -0,0 +1,344 @@
+-- C52103P.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+--    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+
+WITH REPORT;
+PROCEDURE  C52103P  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103P" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+     --
+     --                              ( THE SELECTIONS ARE  7 , 8 , 9 ,
+     --                                AND PRECISELY 5 CASES FROM THE
+     --                                TWO 5-CASE SERIES 2-3-4-5-6 AND
+     --                                                  10-11-12-13-14)
+     --
+     --                              ( IN THE CURRENT DIVISION, THE 5
+     --                                FLOATING SELECTIONS ARE 10-3-12-
+     --                                -5-14 ; THUS THE 8 SELECTIONS ARE
+     --                                10-3-12-5-14-7-8-9 (IN THIS ORDER
+     --                                ).)
+     --
+     --
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+     --
+     --
+     --    (1) ARRAY OBJECTS DECLARED IN THE SAME DECLARATION.
+     --        (TWO-DIMENSIONAL; NON-CONSTRAINABLE TYPEMARK.)
+     --
+     --        (THIS WILL BE THE ONLY CASE INVOLVING OBJECTS DECLARED
+     --        IN THE SAME DECLARATION.)
+     --
+     --
+     --    (2) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED WITHOUT EVER USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --        (SLICING IS ILLEGAL; SINCE IN THIS TEST WE ARE NEVER
+     --        USING AGGREGATES
+     --                (EXCEPT FOR ONE-DIMENSIONAL ARRAYS OF CHARACTERS;
+     --                SEE  (5) )
+     --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS
+     --                (AS IN    T1(ARR)   , WHERE  ARR  IS AN ARRAY
+     --                OBJECT AND  T1  IS AN ARRAY TYPEMARK SIMILAR
+     --                -- AS MORE PRECISELY SPECIFIED IN  RM 4.6(B) --
+     --                TO THE TYPEMARK OF  ARR ),
+     --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+     --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+     --
+     --
+     --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --        (SINCE WE ARE NOT USING AGGREGATES
+     --        AND WE ARE NOT USING CONVERSION-TO-CONSTRAINED-TYPEMARKS,
+     --        THE ARRAY ASSIGNMENT CANNOT INVOLVE ANY SLIDING,
+     --        AND THE TYPEMARKS ARE ESSENTIALLY THE SAME.)
+     --
+     --
+     --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+     --
+     --        (THE ASSIGNMENT MAY REQUIRE SLIDING.)
+     --
+     --        (MOST SUBSEQUENT SUBCASES IN THIS TEST (OTHER THAN NULL
+     --        ASSIGNMENTS) WILL INVOLVE SLIDING; WE ASSUME THAT
+     --        SUBCASES WHICH WORK IN CONJUNCTION WITH SLIDING  WORK
+     --        ALSO WHEN NO SLIDING IS INVOLVED.)
+     --
+     --
+     --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --    (6) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+     --
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+     --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+     --
+     --
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+     --
+     --
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --
+     --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+     --                                            ARRAYS ONLY,
+     --                                            DIVISIONS C AND D .)
+     --
+     --
+     --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+     --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+     --
+     --
+
+
+     -------------------------------------------------------------------
+
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                 )  OF INTEGER ;
+
+          SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(0) ,
+                                        IDENT_INT(0)..IDENT_INT(7)  );
+          SUBTYPE  TABOX02  IS  TABOX0 ;
+
+          ARRX01  :  TABOX01 ;
+          ARRX02  :  TABOX02( IDENT_INT(7)..IDENT_INT(6) ,
+                              IDENT_INT(20)..IDENT_INT(27) );
+
+     BEGIN
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX02 := ARRX01 ;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 10" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (3) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TA3  IS  ARRAY(
+               INTEGER RANGE IDENT_INT(100)..IDENT_INT(99)
+                              )  OF INTEGER ;
+
+          SUBTYPE  TA31  IS  TA3 ;
+          SUBTYPE  TA32  IS  TA3 ;
+
+          ARR31  :  TA31 ;
+          ARR32  :  TA32 ;
+
+     BEGIN
+
+          -- ARRAY ASSIGNMENT:
+
+          ARR32 := ARR31 ;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 3" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+
+     DECLARE
+
+          TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+
+          SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
+
+          ARRX51  :  TABOX51 ;
+          ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+               ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+          END LOOP;
+
+          ARRX51(2) := TRUE ;
+
+          ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
+               ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
+          END LOOP;
+
+          ARRX52(6) := FALSE ;
+
+          ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
+
+
+          -- NULL SLICE ASSIGNMENT:
+
+          ARRX52( IDENT_INT(6)..IDENT_INT(5) ) :=
+               ARRX51(
+                  IDENT_INT(4)..IDENT_INT(3) ) ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARRX52( 5 )  /=  TRUE   OR
+              ARRX52( 6 )  /=  FALSE  OR
+              ARRX52( 7 )  /=  TRUE   OR
+              ARRX52( 8 )  /=  TRUE   OR
+              ARRX52( 9 )  /=  FALSE
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (VALUES)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+                FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
+
+     END ;
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52103P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103q.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103q.ada
new file mode 100644
index 000000000..919d037c6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103q.ada
@@ -0,0 +1,143 @@
+-- C52103Q.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSWEWHERE.)
+
+-- THIS IS THE SECOND FILE IN
+--    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+
+
+-- RM 07/20/81
+-- SPS 2/18/83
+
+WITH REPORT;
+PROCEDURE  C52103Q  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103Q" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --    (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+
+     DECLARE
+
+          TYPE  TA51  IS  ARRAY(
+               INTEGER RANGE IDENT_INT(11)..IDENT_INT(10)
+                               )  OF CHARACTER ;
+
+          ARR51  :  TA51 ;
+
+     BEGIN
+
+
+          -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+
+          ARR51 :=  "" ;
+
+
+          -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+
+          IF  ARR51           /=  ""
+          THEN
+               FAILED( "ARRAY ASSIGNMENT NOT CORRECT (5)" );
+          END IF;
+
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 5" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+
+          SUBTYPE  TABOX42  IS  TABOX4( IDENT_INT(11)..IDENT_INT(15) );
+
+          ARRX42  :  TABOX42 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARRX42  :=  "QUINC"  ;
+
+
+          -- NULL SLICE ASSIGNMENT:
+
+          ARRX42( IDENT_INT(13)..IDENT_INT(12) ) :=  "" ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARRX42                                 /=  "QUINC"  OR
+              ARRX42( IDENT_INT(11)..IDENT_INT(15) ) /=  "QUINC"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (14)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 14" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52103Q;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103r.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103r.ada
new file mode 100644
index 000000000..1daa11857
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103r.ada
@@ -0,0 +1,181 @@
+-- C52103R.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSWEWHERE.)
+
+-- THIS IS THE THIRD FILE IN
+--    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+
+
+-- RM 07/20/81
+-- SPS 2/18/83
+
+WITH REPORT;
+PROCEDURE  C52103R  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103R" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+
+     DECLARE
+
+          ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(0) )  := "" ;
+          ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(4) )  ;
+
+     BEGIN
+
+
+          -- STRING ASSIGNMENT:
+
+          ARR72 := ARR71 ;
+
+
+          -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+          IF  ARR72 /= ""
+          THEN
+               FAILED( "STRING ASSIGNMENT NOT CORRECT (7)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 7" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+
+     DECLARE
+
+          ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARR82( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
+
+
+          -- STRING LITERAL ASSIGNMENT:
+
+          ARR82( IDENT_INT(5)..IDENT_INT(9) )
+               ( IDENT_INT(6)..IDENT_INT(9) )
+               ( IDENT_INT(6)..IDENT_INT(5) ) :=  "" ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARR82                                 /=  "QUINC"  OR
+              ARR82(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (8)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 8" );
+
+     END ;
+
+     -------------------------------------------------------------------
+
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+
+     DECLARE
+
+          SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+
+          ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
+          ARR92  :  TA92 ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARR92( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
+
+
+          -- STRING SLICE ASSIGNMENT:
+
+          ARR92( IDENT_INT(5)..IDENT_INT(9) )
+               ( IDENT_INT(6)..IDENT_INT(9) )
+               ( IDENT_INT(8)..IDENT_INT(7) ) :=
+               ARR91
+               ( IDENT_INT(1)..IDENT_INT(5) )
+               ( IDENT_INT(5)..IDENT_INT(4) ) ;
+
+
+          -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+          IF  ARR92                                 /=  "QUINC"  OR
+              ARR92(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
+          THEN
+               FAILED( "SLICE ASSIGNMENT NOT CORRECT (9)" );
+          END IF;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 9" );
+
+     END ;
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52103R;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103x.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103x.ada
new file mode 100644
index 000000000..f0fa56a2a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52103x.ada
@@ -0,0 +1,241 @@
+-- C52103X.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS A SPECIAL CASE IN
+
+--    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+--                   STATICALLY
+
+-- WHICH TREATS ARRAYS OF LENGTH GREATER THAN  INTEGER'LAST .
+--    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
+--    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE
+--    CONSTRAINT_ERROR TO BE RAISED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- RM  07/31/81
+-- SPS 10/26/82
+-- JBG 06/15/83
+-- EG  11/02/84
+-- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+--               AI-00387.
+-- JRK 06/24/86  FIXED COMMENTS ABOUT NUMERIC_ERROR/CONSTRAINT_ERROR.
+-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT;
+PROCEDURE  C52103X  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52103X" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE " &
+                       "ASSIGNMENTS, THE LENGTHS MUST MATCH; ALSO " &
+                       "CHECK WHETHER CONSTRAINT_ERROR " &
+                       "OR STORAGE_ERROR ARE RAISED FOR LARGE ARRAYS" );
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -------------------------------------------------------------------
+
+     --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+
+CONSTR_ERR:         -- THIS BLOCK CATCHES CONSTRAINT_ERROR
+                    -- FOR THE TYPE DECLARATION.
+     BEGIN
+
+DCL_ARR:  DECLARE   -- THIS BLOCK DECLARES THE ARRAY TYPE
+
+               TYPE  TA42  IS  ARRAY(
+                    INTEGER RANGE IDENT_INT(-2)..IDENT_INT(INTEGER'LAST)
+                                    )  OF BOOLEAN ;
+               -- CONSTRAINT_ERROR MAY BE RAISED BY THE
+               -- ARRAY TYPE DECLARATION.
+               PRAGMA PACK (TA42);
+
+               SUBTYPE  TA41  IS  TA42 ;
+
+          BEGIN
+
+               COMMENT ("NO CONSTRAINT_ERROR FOR TYPE " &
+                        "WITH 'LENGTH = INTEGER'LAST + 3");
+
+OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES TWO BOOLEAN ARRAYS THAT
+                         -- HAVE INTEGER'LAST + 3 COMPONENTS;
+                         -- STORAGE_ERROR MAY BE RAISED.
+                    ARR41  :  TA41 ;
+                    ARR42  :  TA42 ;
+
+               BEGIN
+
+               COMMENT ("NO STORAGE_ERROR OR CONSTRAINT_ERROR RAISED " &
+                        "WHEN ALLOCATING TWO BIG BOOLEAN ARRAYS");
+               -- INITIALIZATION OF RHS ARRAY:
+
+               -- ONLY A SHORT INITIAL SEGMENT IS INITIALIZED,
+               -- SINCE A COMPLETE INITIALIZATION MIGHT TAKE TOO LONG
+               -- AND THE EXECUTION MIGHT BE ABORTED BEFORE THE LENGTH
+               -- COMPARISON OF THE ARRAY ASSIGNMENT IS ATTEMPTED.
+
+NO_EXCP:       BEGIN     -- NO EXCEPTION SHOULD OCCUR HERE.
+                    FOR  I  IN  IDENT_INT(-2)..IDENT_INT(2)  LOOP
+                         ARR41(I)  :=  FALSE  ;  -- VALUES ARE:: FTFFT
+                    END LOOP;
+
+                    ARR41(-1) := TRUE ;
+
+                    ARR41( 2) := TRUE ;          -- RHS IS: F T F F T
+
+
+                    -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
+
+                    ARR42( -2 )  :=  TRUE ;
+
+               EXCEPTION
+
+                    WHEN CONSTRAINT_ERROR =>
+                         FAILED ("CONSTRAINT_ERROR RAISED WHEN " &
+                                 "ASSIGNING TO ARRAY COMPONENTS");
+                    WHEN OTHERS =>
+                         FAILED ("OTHER EXCEPTION RAISED - 1");
+
+               END NO_EXCP;
+
+DO_SLICE:      BEGIN
+                    -- SLICE ASSIGNMENT:
+
+                    ARR42(  IDENT_INT(-1)..IDENT_INT(INTEGER'LAST  )) :=
+                         ARR41(
+                            IDENT_INT(-2)..IDENT_INT(INTEGER'LAST-1)) ;
+
+                    COMMENT ("NO EXCEPTION RAISED DURING SLICE " &
+                             "ASSIGNMENT");
+
+                    -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+     CHK_SLICE:     BEGIN
+                         FOR  I  IN  IDENT_INT(-1)..IDENT_INT(2)  LOOP
+
+                              IF  ARR42( I )  /=  FALSE  AND  I /= 0
+                              THEN
+                                   FAILED( "SLICE ASSIGNMENT NOT " &
+                                           "CORRECT (VALUES)" );
+                              ELSIF  ARR42( I ) /= TRUE  AND  I  = 0
+                              THEN
+                                   FAILED( "SLICE ASSIGNMENT NOT " &
+                                           "CORRECT (VALUES)" );
+                              END IF;
+
+                         END LOOP;
+
+                         IF  ARR42( -2 )  /=  TRUE
+                         THEN
+                              FAILED( "SLICE ASSIGNMENT NOT CORRECT " &
+                                      "(SLIDING)" );
+                         END IF;
+
+                    EXCEPTION
+
+                         WHEN OTHERS =>
+                              FAILED ("SOME EXCEPTION RAISED - 2");
+
+                    END CHK_SLICE;
+
+               EXCEPTION
+
+                    WHEN CONSTRAINT_ERROR =>
+                         COMMENT ("CONSTRAINT_ERROR RAISED DURING " &
+                                  "SLICE ASSIGNMENT");
+                    WHEN STORAGE_ERROR =>
+                         COMMENT ("STORAGE_ERROR RAISED DURING SLICE " &
+                                  "ASSIGNMENT");
+                    WHEN OTHERS =>
+                         FAILED ("SOME EXCEPTION DURING SLICE " &
+                                 "ASSIGNMENT");
+               END DO_SLICE;
+
+          END OBJ_DCL;
+
+          EXCEPTION
+
+               WHEN STORAGE_ERROR =>
+                    COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING " &
+                             "TWO PACKED BOOLEAN ARRAYS WITH " &
+                             "INTEGER'LAST + 3 COMPONENTS");
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING " &
+                             "TWO PACKED BOOLEAN ARRAYS WITH " &
+                             "INTEGER'LAST + 3 COMPONENTS");
+               WHEN OTHERS =>
+                    FAILED ("SOME EXCEPTION RAISED - 3");
+
+          END DCL_ARR;
+
+     EXCEPTION
+
+
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
+                        "ARRAY TYPE WITH INTEGER'LAST + 3 COMPONENTS");
+
+          WHEN STORAGE_ERROR =>
+               FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
+
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED - 4");
+
+     END CONSTR_ERR;
+
+
+     RESULT ;
+
+
+END C52103X;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104a.ada
new file mode 100644
index 000000000..c71408cc3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104a.ada
@@ -0,0 +1,343 @@
+-- C52104A.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+--    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+WITH REPORT;
+PROCEDURE  C52104A  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104A" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+     --
+     --                              ( THE 8 SELECTIONS ARE THE 5-CASE
+     --                                SERIES 10-11-12-13-14 FOLLOWED
+     --                                BY  7 , 8 , 9 (IN THIS ORDER). )
+     --
+     --
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+     --
+     --
+     --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
+     --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
+     --
+     --
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+     --
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+     --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+     --
+     --
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+     --
+     --
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --
+     --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
+     --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+     --                                            ARRAYS ONLY,
+     --                                            DIVISIONS C AND D .)
+     --
+     --
+     --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+     --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+     --
+     --
+
+
+     -------------------------------------------------------------------
+
+     --    (1..6: NOT APPLICABLE)
+     --
+     --
+
+     -------------------------------------------------------------------
+
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                 )  OF INTEGER ;
+
+          SUBTYPE  TABOX01  IS  TABOX0( 1..5 ,  0..7  );
+          SUBTYPE  TABOX02  IS  TABOX0( 0..5 ,  2..9  );
+
+          ARRX01  :  TABOX01 ;
+          ARRX02  :  TABOX02 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  1..5  LOOP
+
+               FOR  J  IN  0..7  LOOP
+                    ARRX01( I , J )  :=   I * I * J  ;
+               END LOOP;
+
+          END LOOP;
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          FOR  I  IN  0..5  LOOP
+
+               FOR  J  IN  2..9  LOOP
+                    ARRX02( I , J )  :=   I * I * J * 3  ;
+               END LOOP;
+
+          END LOOP;
+
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX02 := ARRX01 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+
+               FOR  I  IN  0..5  LOOP
+
+                    FOR  J  IN  2..9  LOOP
+
+                         IF  ARRX02( I , J )  /=   I * I * J * 3
+                         THEN
+                              FAILED( "ORIG. VALUE ALTERED (10)" );
+                         END IF;
+
+                    END LOOP;
+
+               END LOOP;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+
+          SUBTYPE  TABOX11  IS  TABOX1( 1..5 ) ;
+
+          ARRX11  :  TABOX11 ;
+          ARRX12  :  TABOX1( 6..9 );
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  1..5  LOOP
+
+               ARRX11( I )  :=   I * I  ;
+
+          END LOOP;
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          FOR  I  IN  6..9  LOOP
+               ARRX12( I )  :=   I * I * 3  ;
+          END LOOP;
+
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX12 := ARRX11 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+
+               FOR  I  IN  6..9  LOOP
+
+                    IF  ARRX12( I )  /=   I * I * 3
+                    THEN
+                         FAILED( "ORIG. VALUE ALTERED (11)" );
+                    END IF;
+
+               END LOOP;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+
+     DECLARE
+
+          TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+
+          SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
+
+          ARRX51  :  TABOX51 ;
+          ARRX52  :  TABOX5( 5..9 );
+
+     BEGIN
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          FOR  I  IN  5..9  LOOP
+               ARRX52( I )  :=  FALSE  ;
+          END LOOP;
+
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  1..5  LOOP
+               ARRX51( I )  :=  TRUE  ;
+          END LOOP;
+
+
+          -- SLICE ASSIGNMENT:
+
+          ARRX52(6..9) := ARRX51(3..3) ;
+          FAILED( "EXCEPTION NOT RAISED  (12)" );
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+               FOR  I  IN  5..9  LOOP
+
+                    IF  ARRX52( I )  /=  FALSE
+                    THEN
+                         FAILED( "LHS ARRAY ALTERED  ( 12 ) " );
+                    END IF;
+
+               END LOOP;
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104b.ada
new file mode 100644
index 000000000..d2f426189
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104b.ada
@@ -0,0 +1,144 @@
+-- C52104B.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE SECOND FILE IN
+--    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+WITH REPORT;
+PROCEDURE  C52104B  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104B" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+
+          ARRX31  :  TABOX3( 2..6 )  :=  "QUINC"  ;
+
+     BEGIN
+
+
+          -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+
+          ARRX31 :=  "ABCD" ;
+          FAILED( "NO EXCEPTION RAISED  (13)" );
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+
+               IF  ARRX31           /=  "QUINC"  OR
+                   ARRX31(  2..6  ) /=  "QUINC"
+               THEN
+                    FAILED( "LHS ARRAY ALTERED  (13)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+
+          SUBTYPE  TABOX42  IS  TABOX4( 5..9 );
+
+          ARRX42  :  TABOX42 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARRX42  :=  "QUINC"  ;
+
+
+          -- SLICE ASSIGNMENT:
+
+          ARRX42( 6..9 )  :=  "ABCDEFGH"  ;
+          FAILED( "NO EXCEPTION RAISED  (14)" );
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+
+               IF  ARRX42           /=  "QUINC"  OR
+                   ARRX42(  5..9  ) /=  "QUINC"
+               THEN
+                    FAILED( "LHS ARRAY ALTERED  (14)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104c.ada
new file mode 100644
index 000000000..34cb2aaf2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104c.ada
@@ -0,0 +1,178 @@
+-- C52104C.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE THIRD FILE IN
+--    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+WITH REPORT;
+PROCEDURE  C52104C  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104C" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+
+     DECLARE
+
+          ARR71  :  STRING( 1..5 )  := "ABCDE" ;
+          ARR72  :  STRING( 5..8 )  := "FGHI"  ;
+
+     BEGIN
+
+
+          -- STRING ASSIGNMENT:
+
+          ARR72 := ARR71 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+               IF  ARR72 /= "FGHI"
+               THEN
+                    FAILED( "ORIGINAL VALUE ALTERED (7)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+
+     DECLARE
+
+          ARR82 : STRING( 5..9 )  :=  "QBCDE"  ;
+
+     BEGIN
+
+
+          -- STRING LITERAL ASSIGNMENT:
+
+          ARR82( 5..9 )( 6..9 ) :=  "EIN" ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+               IF  ARR82           /=  "QBCDE"  OR
+                   ARR82(  5..9  ) /=  "QBCDE"
+               THEN
+                    FAILED( "LHS ARRAY ALTERED  (8)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+
+     DECLARE
+
+          SUBTYPE  TA92  IS  STRING( 5..9 ) ;
+
+          ARR91  :  STRING( 1..7 )  := "ABCDEFG" ;
+          ARR92  :  TA92 ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARR92( 5..9 )  :=  "QUINC"  ;
+
+
+          -- STRING SLICE ASSIGNMENT:
+
+          ARR92( 5..9 )( 6..9 ) :=  ARR91( 1..7 )( 1..6 )( 1..6 ) ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+               IF  ARR92           /=  "QUINC"  OR
+                   ARR92(  5..9  ) /=  "QUINC"
+               THEN
+                    FAILED( "LHS VALUE ALTERED  (9)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104f.ada
new file mode 100644
index 000000000..a6e8a392e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104f.ada
@@ -0,0 +1,292 @@
+-- C52104F.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSWEWHERE.)
+
+--    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 10/27/82
+
+WITH REPORT;
+PROCEDURE  C52104F  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104F" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+     --
+     --                              ( THE 8 SELECTIONS ARE THE 5-CASE
+     --                                SERIES 10-11-12-13-14 FOLLOWED
+     --                                BY  7 , 8 , 9 (IN THIS ORDER). )
+     --
+     --
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+     --
+     --
+     --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
+     --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
+     --
+     --
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+     --
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+     --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+     --
+     --
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+     --
+     --
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --
+     --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+     --                                            ARRAYS ONLY,
+     --                                            DIVISIONS C AND D .)
+     --
+     --
+     --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+     --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
+     --
+     --
+
+
+     -------------------------------------------------------------------
+
+     --    (1 .. 6: NOT APPLICABLE)
+     --
+     --
+
+     -------------------------------------------------------------------
+
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                 )  OF INTEGER ;
+
+          SUBTYPE  TABOX01  IS  TABOX0( 1..1 ,  0..7  );
+          SUBTYPE  TABOX02  IS  TABOX0 ;
+
+          ARRX01  :  TABOX01 ;
+          ARRX02  :  TABOX02( 1..0 , 0..7 );
+
+     BEGIN
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX02 := ARRX01 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               NULL ;
+
+          WHEN  OTHERS  =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+
+          SUBTYPE  TABOX11  IS  TABOX1( 4..5 ) ;
+
+          ARRX11  :  TABOX11 ;
+          ARRX12  :  TABOX1( 5..4 );
+
+     BEGIN
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX12 := ARRX11 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               NULL ;
+
+          WHEN  OTHERS  =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+
+     DECLARE
+
+          TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+
+          SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
+
+          ARRX51  :  TABOX51 ;
+          ARRX52  :  TABOX5( 5..9 );
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  1..5  LOOP
+               ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+          END LOOP;
+
+          ARRX51(2) := TRUE ;
+
+          ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          FOR  I  IN  5..9  LOOP
+               ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
+          END LOOP;
+
+          ARRX52(6) := FALSE ;
+
+          ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
+
+
+          -- NULL SLICE ASSIGNMENT:
+
+          ARRX52( 6..5 ) := ARRX51( 4..4 ) ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 12" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+               IF  ARRX52( 5 )  /=  TRUE   OR
+                   ARRX52( 6 )  /=  FALSE  OR
+                   ARRX52( 7 )  /=  TRUE   OR
+                   ARRX52( 8 )  /=  TRUE   OR
+                   ARRX52( 9 )  /=  FALSE
+               THEN
+                    FAILED( "LHS ARRAY ALTERED  (12)" );
+               END IF;
+
+          WHEN  OTHERS =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 12" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104g.ada
new file mode 100644
index 000000000..40f5daa99
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104g.ada
@@ -0,0 +1,146 @@
+-- C52104G.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE SECOND FILE IN
+--    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+-- JBG 4/24/84
+
+WITH REPORT;
+PROCEDURE  C52104G  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104G" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX3  IS  ARRAY( NATURAL RANGE <> )  OF CHARACTER ;
+
+          ARRX31  :  TABOX3( 11..10 )  :=  ""  ;
+
+     BEGIN
+
+
+          -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+
+          ARRX31 :=  "AZ" ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 13" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+               IF  ARRX31  /=  ""
+               THEN
+                    FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
+               END IF;
+
+          WHEN  OTHERS =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+
+          SUBTYPE  TABOX42  IS  TABOX4( 11..15 );
+
+          ARRX42  :  TABOX42 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARRX42  :=  "QUINC"  ;
+
+
+          -- NULL SLICE ASSIGNMENT:
+
+          ARRX42( 13..12 ) :=  "ABCD" ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 14" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+               IF  ARRX42           /=  "QUINC"  OR
+                   ARRX42( 11..15 ) /=  "QUINC"
+               THEN
+                    FAILED( "LHS ARRAY ALTERED  (14)" );
+               END IF;
+
+          WHEN  OTHERS =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104h.ada
new file mode 100644
index 000000000..8846bba24
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104h.ada
@@ -0,0 +1,183 @@
+-- C52104H.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE THIRD FILE IN
+--    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+WITH REPORT;
+PROCEDURE  C52104H  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104H" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+
+     DECLARE
+
+          ARR71  :  STRING( 1..1 )  := "A" ;
+          ARR72  :  STRING( 5..4 )  := ""  ;
+
+     BEGIN
+
+          -- STRING ASSIGNMENT:
+
+          ARR72 := ARR71 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+               IF  ARR72 /= ""
+               THEN
+                    FAILED( "ORIGINAL VALUE ALTERED (7)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+
+     DECLARE
+
+          ARR82 : STRING( 5..9 ) ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARR82( 5..9 )  :=  "QUINC"  ;
+
+
+          -- STRING LITERAL ASSIGNMENT:
+
+          ARR82( 5..9 )( 6..9 )( 6..5 ) :=  "ABC" ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+               IF  ARR82           /=  "QUINC"  OR
+                   ARR82(  5..9  ) /=  "QUINC"
+               THEN
+                    FAILED( "ORIGINAL VALUE ALTERED (8)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+
+     DECLARE
+
+          SUBTYPE  TA92  IS  STRING( 5..9 ) ;
+
+          ARR91  :  STRING( 1..5 )  := "ABCDE" ;
+          ARR92  :  TA92 ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARR92( 5..9 )  :=  "QUINC"  ;
+
+
+          -- STRING SLICE ASSIGNMENT:
+
+          ARR92( 5..9 )( 6..9 )( 8..7 ) :=  ARR91( 1..5 )( 5..7 ) ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+               IF ARR92           /=  "QUINC"  OR
+                  ARR92(  5..9  ) /=  "QUINC"
+               THEN
+                    FAILED( "ORIGINAL VALUE ALTERED (9)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104k.ada
new file mode 100644
index 000000000..f7abc7367
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104k.ada
@@ -0,0 +1,347 @@
+-- C52104K.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+--    DIVISION  C :  NON-NULL LENGTHS NOT DETERMINABLE STATICALLY.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+WITH REPORT;
+PROCEDURE  C52104K  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104K" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+     --
+     --                              ( THE 8 SELECTIONS ARE THE 5-CASE
+     --                                SERIES 10-11-12-13-14 FOLLOWED
+     --                                BY  7 , 8 , 9 (IN THIS ORDER). )
+     --
+     --
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+     --
+     --
+     --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
+     --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
+     --
+     --
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+     --
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+     --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+     --
+     --
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+     --
+     --
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --
+     --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
+     --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+     --                                            ARRAYS ONLY,
+     --                                            DIVISIONS C AND D .)
+     --
+     --
+     --    (-) THE STATIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
+     --        VISIONS A (FOR NON-NULL ARRAYS) AND B (FOR NULL ARRAYS).
+     --
+     --
+
+
+     -------------------------------------------------------------------
+
+     --    (1..6: NOT APPLICABLE)
+     --
+     --
+
+     -------------------------------------------------------------------
+
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                 )  OF INTEGER ;
+
+          SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(5) ,
+                                        IDENT_INT(0)..IDENT_INT(7) );
+          SUBTYPE  TABOX02  IS  TABOX0( IDENT_INT(0)..IDENT_INT(5) ,
+                                        IDENT_INT(2)..IDENT_INT(9) );
+
+          ARRX01  :  TABOX01 ;
+          ARRX02  :  TABOX02 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+
+               FOR  J  IN  IDENT_INT(0)..IDENT_INT(7)  LOOP
+                    ARRX01( I , J )  :=   I * I * J  ;
+               END LOOP;
+
+          END LOOP;
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(0)..IDENT_INT(5)  LOOP
+
+               FOR  J  IN  IDENT_INT(2)..IDENT_INT(9)  LOOP
+                    ARRX02( I , J )  :=   I * I * J * 3  ;
+               END LOOP;
+
+          END LOOP;
+
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX02 := ARRX01 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+
+               FOR  I  IN  IDENT_INT(0)..IDENT_INT(5)  LOOP
+
+                    FOR  J  IN  IDENT_INT(2)..IDENT_INT(9)  LOOP
+
+                         IF  ARRX02( I , J )  /=   I * I * J * 3
+                         THEN
+                              FAILED( "ORIG. VALUE ALTERED (10)" );
+                         END IF;
+
+                    END LOOP;
+
+               END LOOP;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+
+          SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(1)..IDENT_INT(5) ) ;
+
+          ARRX11  :  TABOX11 ;
+          ARRX12  :  TABOX1( IDENT_INT(6)..IDENT_INT(9) );
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+
+               ARRX11( I )  :=   I * I  ;
+
+          END LOOP;
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(6)..IDENT_INT(9)  LOOP
+               ARRX12( I )  :=   I * I * 3  ;
+          END LOOP;
+
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX12 := ARRX11 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
+
+               FOR  I  IN  IDENT_INT(6)..IDENT_INT(9)  LOOP
+
+                    IF  ARRX12( I )  /=   I * I * 3
+                    THEN
+                         FAILED( "ORIG. VALUE ALTERED (11)" );
+                    END IF;
+
+               END LOOP;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+
+     DECLARE
+
+          TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+
+          SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
+
+          ARRX51  :  TABOX51 ;
+          ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
+
+     BEGIN
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
+               ARRX52( I )  :=  FALSE  ;
+          END LOOP;
+
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+               ARRX51( I )  :=  TRUE  ;
+          END LOOP;
+
+
+          -- SLICE ASSIGNMENT:
+
+          ARRX52( IDENT_INT(6)..IDENT_INT(9) ) :=
+               ARRX51(
+                  IDENT_INT(3)..IDENT_INT(3) ) ;
+          FAILED( "EXCEPTION NOT RAISED  (12)" );
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+               FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
+
+                    IF  ARRX52( I )  /=  FALSE
+                    THEN
+                         FAILED( "LHS ARRAY ALTERED  ( 12 ) " );
+                    END IF;
+
+               END LOOP;
+
+          WHEN  OTHERS  =>
+               FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104l.ada
new file mode 100644
index 000000000..ca7ae3271
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104l.ada
@@ -0,0 +1,146 @@
+-- C52104L.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--     MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--     ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--     INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--     (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--     ARE TREATED ELSEWHERE.)
+
+--     THIS IS THE SECOND FILE IN
+--     DIVISION  C :  NON-NULL LENGTHS NOT DETERMINABLE STATICALLY.
+
+-- HISTORY:
+--     RM  07/20/81 CREATED ORIGINAL TEST.
+--     SPS 03/22/83
+--     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT;
+PROCEDURE  C52104L  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104L" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX3  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+
+          ARRX31  :  TABOX3( IDENT_INT(2)..IDENT_INT(6) )  := "QUINC" ;
+
+     BEGIN
+
+
+          -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+
+          ARRX31 :=  "ABCD" ;
+          FAILED( "NO EXCEPTION RAISED  (13)" );
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+
+               IF  ARRX31                               /=  "QUINC"  OR
+                   ARRX31( IDENT_INT(2)..IDENT_INT(6) ) /=  "QUINC"
+               THEN
+                    FAILED( "LHS ARRAY ALTERED  (13)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+
+          SUBTYPE  TABOX42  IS  TABOX4( IDENT_INT(5)..IDENT_INT(9) );
+
+          ARRX42  :  TABOX42 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARRX42  :=  "QUINC"  ;
+
+
+          -- SLICE ASSIGNMENT:
+
+          ARRX42( IDENT_INT(6)..IDENT_INT(9) )  :=  "ABCDEFGH"  ;
+          FAILED( "NO EXCEPTION RAISED  (14)" );
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
+
+               IF  ARRX42                               /=  "QUINC"  OR
+                   ARRX42( IDENT_INT(5)..IDENT_INT(9) ) /=  "QUINC"
+               THEN
+                    FAILED( "LHS ARRAY ALTERED  (14)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104m.ada
new file mode 100644
index 000000000..3227d591d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104m.ada
@@ -0,0 +1,184 @@
+-- C52104M.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE THIRD FILE IN
+--    DIVISION  C :  NON-NULL LENGTHS NOT DETERMINABLE STATICALLY.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+WITH REPORT;
+PROCEDURE  C52104M  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104M" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+
+     DECLARE
+
+          ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
+          ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(8) )  := "FGHI"  ;
+
+     BEGIN
+
+
+          -- STRING ASSIGNMENT:
+
+          ARR72 := ARR71 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+               IF  ARR72 /= "FGHI"
+               THEN
+                    FAILED( "ORIGINAL VALUE ALTERED (7)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+
+     DECLARE
+
+          ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) )  :=  "QBCDE"  ;
+
+     BEGIN
+
+
+          -- STRING LITERAL ASSIGNMENT:
+
+          ARR82( IDENT_INT(5)..IDENT_INT(9) )
+               ( IDENT_INT(6)..IDENT_INT(9) ) :=  "EIN" ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+               IF  ARR82                               /=  "QBCDE"  OR
+                   ARR82( IDENT_INT(5)..IDENT_INT(9) ) /=  "QBCDE"
+               THEN
+                    FAILED( "LHS ARRAY ALTERED  (8)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+
+     DECLARE
+
+          SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+
+          ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(7) )  := "ABCDEFG" ;
+          ARR92  :  TA92 ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARR92( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
+
+
+          -- STRING SLICE ASSIGNMENT:
+
+          ARR92( IDENT_INT(5)..IDENT_INT(9) )
+               ( IDENT_INT(6)..IDENT_INT(9) ) :=
+               ARR91
+               ( IDENT_INT(1)..IDENT_INT(7) )
+               ( IDENT_INT(1)..IDENT_INT(6) )
+               ( IDENT_INT(1)..IDENT_INT(6) ) ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+               IF  ARR92                               /=  "QUINC"  OR
+                   ARR92( IDENT_INT(5)..IDENT_INT(9) ) /=  "QUINC"
+               THEN
+                    FAILED( "LHS VALUE ALTERED  (9)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104p.ada
new file mode 100644
index 000000000..f455519a0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104p.ada
@@ -0,0 +1,292 @@
+-- C52104P.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+--    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+
+
+-- RM 07/20/81
+
+
+WITH REPORT;
+PROCEDURE  C52104P  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104P" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
+     --
+     --                              ( THE 8 SELECTIONS ARE THE 5-CASE
+     --                                SERIES 10-11-12-13-14 FOLLOWED
+     --                                BY  7 , 8 , 9 (IN THIS ORDER). )
+     --
+     --
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+     --
+     --
+     --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
+     --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
+     --
+     --
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+     --
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+     --
+     --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
+     --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
+     --
+     --
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+     --
+     --
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+     --
+     --
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
+     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
+     --        BY THE TYPEMARK WILL NOT BE  1 .)
+     --
+     --
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+     --
+     --
+     --
+     --    (-) SPECIAL CASES:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
+     --                                            ARRAYS ONLY,
+     --                                            DIVISIONS C AND D .)
+     --
+     --
+
+
+     -------------------------------------------------------------------
+
+     --    (1 .. 6: NOT APPLICABLE)
+     --
+     --
+
+     -------------------------------------------------------------------
+
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
+                                 )  OF INTEGER ;
+
+          SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(1) ,
+                                        IDENT_INT(0)..IDENT_INT(7)  );
+          SUBTYPE  TABOX02  IS  TABOX0 ;
+
+          ARRX01  :  TABOX01 ;
+          ARRX02  :  TABOX02( IDENT_INT(1)..IDENT_INT(0) ,
+                              IDENT_INT(0)..IDENT_INT(7) );
+
+     BEGIN
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX02 := ARRX01 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               NULL ;
+
+          WHEN  OTHERS  =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
+
+     DECLARE
+
+          TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
+
+          SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(4)..IDENT_INT(5) ) ;
+
+          ARRX11  :  TABOX11 ;
+          ARRX12  :  TABOX1( IDENT_INT(5)..IDENT_INT(4) );
+
+     BEGIN
+
+          -- ARRAY ASSIGNMENT:
+
+          ARRX12 := ARRX11 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               NULL ;
+
+          WHEN  OTHERS  =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+
+     DECLARE
+
+          TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+
+          SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
+
+          ARRX51  :  TABOX51 ;
+          ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
+
+     BEGIN
+
+          -- INITIALIZATION OF RHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
+               ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
+          END LOOP;
+
+          ARRX51(2) := TRUE ;
+
+          ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
+               ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
+          END LOOP;
+
+          ARRX52(6) := FALSE ;
+
+          ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
+
+
+          -- NULL SLICE ASSIGNMENT:
+
+          ARRX52( IDENT_INT(6)..IDENT_INT(5) ) :=
+               ARRX51
+                ( IDENT_INT(4)..IDENT_INT(4) ) ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 12" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+               IF  ARRX52( 5 )  /=  TRUE   OR
+                   ARRX52( 6 )  /=  FALSE  OR
+                   ARRX52( 7 )  /=  TRUE   OR
+                   ARRX52( 8 )  /=  TRUE   OR
+                   ARRX52( 9 )  /=  FALSE
+               THEN
+                    FAILED( "LHS ARRAY ALTERED  (12)" );
+               END IF;
+
+          WHEN  OTHERS =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 12" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104q.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104q.ada
new file mode 100644
index 000000000..dc01ca880
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104q.ada
@@ -0,0 +1,146 @@
+-- C52104Q.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE SECOND FILE IN
+--    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+-- JBG 4/24/84
+
+WITH REPORT;
+PROCEDURE  C52104Q  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104Q" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX3  IS  ARRAY( NATURAL RANGE <> )  OF CHARACTER ;
+
+          ARRX31  :  TABOX3( IDENT_INT(11)..IDENT_INT(10) )  :=  ""  ;
+
+     BEGIN
+
+
+          -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
+
+          ARRX31 :=  "AZ" ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 13" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+               IF  ARRX31  /=  ""
+               THEN
+                    FAILED( "ARRAY ASSIGNMENT NOT CORRECT (13)" );
+               END IF;
+
+          WHEN  OTHERS =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 13" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
+
+     DECLARE
+
+          TYPE  TABOX4  IS  ARRAY( INTEGER RANGE <> )  OF CHARACTER ;
+
+          SUBTYPE  TABOX42  IS  TABOX4( IDENT_INT(11)..IDENT_INT(15) );
+
+          ARRX42  :  TABOX42 ;
+
+     BEGIN
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARRX42  :=  "QUINC"  ;
+
+
+          -- NULL SLICE ASSIGNMENT:
+
+          ARRX42( IDENT_INT(13)..IDENT_INT(12) ) :=  "ABCD" ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 14" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
+
+               IF  ARRX42                                 /= "QUINC"  OR
+                   ARRX42( IDENT_INT(11)..IDENT_INT(15) ) /= "QUINC"
+               THEN
+                    FAILED( "LHS ARRAY ALTERED  (14)" );
+               END IF;
+
+          WHEN  OTHERS =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 14" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104Q;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104r.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104r.ada
new file mode 100644
index 000000000..8b9e3d466
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104r.ada
@@ -0,0 +1,190 @@
+-- C52104R.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS THE THIRD FILE IN
+--    DIVISION  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
+
+
+-- RM 07/20/81
+-- SPS 3/22/83
+
+WITH REPORT;
+PROCEDURE  C52104R  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104R" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
+
+
+     --                              ( EACH DIVISION COMPRISES 3 FILES,
+     --                                COVERING RESPECTIVELY THE FIRST
+     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
+     --                                SELECTIONS FOR THE DIVISION.)
+
+
+     -------------------------------------------------------------------
+
+     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+
+     DECLARE
+
+          ARR71  :  STRING( IDENT_INT(1)..IDENT_INT(1) )  := "A" ;
+          ARR72  :  STRING( IDENT_INT(5)..IDENT_INT(4) )  := ""  ;
+
+     BEGIN
+
+          -- STRING ASSIGNMENT:
+
+          ARR72 := ARR71 ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 7" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+               IF  ARR72 /= ""
+               THEN
+                    FAILED( "ORIGINAL VALUE ALTERED (7)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 7" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
+     --        STRING LITERALS.
+     --
+
+     DECLARE
+
+          ARR82 : STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARR82( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
+
+
+          -- STRING LITERAL ASSIGNMENT:
+
+          ARR82( IDENT_INT(5)..IDENT_INT(9) )
+               ( IDENT_INT(6)..IDENT_INT(9) )
+               ( IDENT_INT(6)..IDENT_INT(5) ) := "ABC" ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 8" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+               IF  ARR82                                 /=  "QUINC"  OR
+                   ARR82(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
+               THEN
+                    FAILED( "ORIGINAL VALUE ALTERED (8)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 8" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
+     --        THEMSELVES).
+     --
+
+     DECLARE
+
+          SUBTYPE  TA92  IS  STRING( IDENT_INT(5)..IDENT_INT(9) ) ;
+
+          ARR91  :  STRING( IDENT_INT(1)..IDENT_INT(5) )  := "ABCDE" ;
+          ARR92  :  TA92 ;
+
+     BEGIN
+
+
+          -- INITIALIZATION OF LHS ARRAY:
+
+          ARR92( IDENT_INT(5)..IDENT_INT(9) )  :=  "QUINC"  ;
+
+
+          -- STRING SLICE ASSIGNMENT:
+
+          ARR92( IDENT_INT(5)..IDENT_INT(9) )
+               ( IDENT_INT(6)..IDENT_INT(9) )
+               ( IDENT_INT(8)..IDENT_INT(7) ) :=
+               ARR91
+               ( IDENT_INT(1)..IDENT_INT(5) )
+               ( IDENT_INT(5)..IDENT_INT(7) ) ;
+          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 9" );
+
+     EXCEPTION
+
+          WHEN  CONSTRAINT_ERROR =>
+
+               -- CHECKING THE VALUES AFTER THE STRING ASSIGNMENT:
+
+               IF ARR92                                 /=  "QUINC"  OR
+                  ARR92(  IDENT_INT(5)..IDENT_INT(9)  ) /=  "QUINC"
+               THEN
+                    FAILED( "ORIGINAL VALUE ALTERED (9)" );
+               END IF;
+
+          WHEN  OTHERS  =>
+
+               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 9" );
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END C52104R;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104x.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104x.ada
new file mode 100644
index 000000000..3db74d7cd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104x.ada
@@ -0,0 +1,222 @@
+-- C52104X.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS A SPECIAL CASE IN
+
+--    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+--                   STATICALLY
+
+-- WHICH TREATS ARRAYS OF LENGTH GREATER THAN  INTEGER'LAST .
+--    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
+--    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE
+--    CONSTRAINT_ERROR TO BE RAISED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- RM  07/31/81
+-- SPS 02/07/83
+-- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+--               AI-00387.
+-- JRK 06/24/86  FIXED COMMENTS ABOUT NUMERIC_ERROR/CONSTRAINT_ERROR.
+-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X INCOMPATIBILITY
+
+WITH REPORT;
+PROCEDURE  C52104X  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104X" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE " &
+                       "ASSIGNMENTS, THE LENGTHS MUST MATCH; ALSO " &
+                       "CHECK WHETHER CONSTRAINT_ERROR " &
+                       "OR STORAGE_ERROR ARE RAISED FOR LARGE ARRAYS");
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -------------------------------------------------------------------
+
+     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
+     --        WERE DEFINED USING THE "BOX" SYMBOL
+     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
+     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
+
+CONSTR_ERR:         -- THIS BLOCK CATCHES CONSTRAINT_ERROR
+                    -- FOR THE SUBTYPE DECLARATION.
+     BEGIN
+
+DCL_ARR:  DECLARE        -- THIS BLOCK DECLARES THE ARRAY SUBTYPE.
+
+               TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
+               PRAGMA PACK (TABOX5);
+
+               SUBTYPE  TABOX51  IS  TABOX5
+                             (IDENT_INT(-6)..IDENT_INT(INTEGER'LAST-4));
+               -- CONSTRAINT_ERROR MAY BE RAISED BY THIS
+               -- SUBTYPE DECLARATION.
+
+          BEGIN
+
+               COMMENT ("NO CONSTRAINT_ERROR FOR TYPE " &
+                        "WITH 'LENGTH = INTEGER'LAST + 3");
+
+OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES TWO BOOLEAN ARRAYS THAT
+                         -- HAVE INTEGER'LAST + 3 COMPONENTS;
+                         -- STORAGE_ERROR MAY BE RAISED.
+                    ARRX51  :  TABOX51 ;
+                    ARRX52  :  TABOX5
+                             (IDENT_INT(-2)..IDENT_INT( INTEGER'LAST));
+
+               BEGIN
+
+               COMMENT ("NO STORAGE_ERROR OR " &
+                        "CONSTRAINT_ERROR RAISED WHEN ALLOCATING TWO " &
+                        "BIG BOOLEAN ARRAYS");
+
+               -- INITIALIZATION OF LHS ARRAY:
+
+NO_EXCP:       BEGIN          -- NO EXCEPTION SHOULD OCCUR IN THIS BLOCK
+                    FOR  I  IN  IDENT_INT(-2)..IDENT_INT(9)  LOOP
+                         ARRX52( I )  :=  FALSE  ;
+                    END LOOP;
+
+
+               -- INITIALIZATION OF RHS ARRAY:
+
+               -- ONLY A SHORT INITIAL SEGMENT IS INITIALIZED,
+               -- SINCE A COMPLETE INITIALIZATION MIGHT TAKE TOO LONG
+               -- AND THE EXECUTION MIGHT BE ABORTED BEFORE THE LENGTH
+               -- COMPARISON OF THE ARRAY ASSIGNMENT IS ATTEMPTED.
+
+                    FOR  I  IN  IDENT_INT(-6)..IDENT_INT(5)  LOOP
+                         ARRX51( I )  :=  TRUE  ;
+                    END LOOP;
+
+               EXCEPTION
+
+                    WHEN CONSTRAINT_ERROR =>
+                         FAILED ("CONSTRAINT_ERROR RAISED WHEN " &
+                                 "ASSIGNING TO ARRAY COMPONENTS");
+                    WHEN OTHERS =>
+                         FAILED ("OTHER EXCEPTION RAISED - 1");
+
+               END NO_EXCP;
+
+DO_SLICE:      BEGIN
+               -- SLICE ASSIGNMENT:
+
+                    ARRX52( IDENT_INT(-1)..IDENT_INT(INTEGER'LAST  )) :=
+                         ARRX51(
+                            IDENT_INT(-4)..IDENT_INT(INTEGER'LAST-4) ) ;
+                    FAILED( "EXCEPTION NOT RAISED  (12)" );
+
+               EXCEPTION
+
+                    WHEN CONSTRAINT_ERROR =>
+
+                         COMMENT ("CONSTRAINT_ERROR RAISED DURING " &
+                                  "CHECK FOR SLICE ASSIGNMENT");
+
+                         -- CHECKING THE VALUES AFTER THE SLICE
+                         -- ASSIGNMENT:
+
+                         FOR  I  IN  IDENT_INT(-2)..IDENT_INT(9)  LOOP
+
+                              IF  ARRX52( I )  /=  FALSE
+                              THEN
+                                   FAILED( "LHS ARRAY ALTERED  (12A)");
+                              END IF;
+
+                         END LOOP;
+
+
+                    WHEN STORAGE_ERROR =>
+                         COMMENT ("STORAGE_ERROR RAISED DURING CHECK " &
+                                  "FOR SLICE ASSIGNMENT");
+
+                    WHEN OTHERS =>
+                         FAILED ("SOME EXCEPTION RAISED DURING SLICE");
+
+               END DO_SLICE;
+
+          END OBJ_DCL;
+
+          EXCEPTION
+
+               WHEN STORAGE_ERROR =>
+                    COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING " &
+                             "TWO PACKED BOOLEAN ARRAYS WITH " &
+                             "INTEGER'LAST + 3 COMPONENTS");
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING " &
+                             "TWO PACKED BOOLEAN ARRAYS WITH " &
+                             "INTEGER'LAST + 3 COMPONENTS");
+               WHEN OTHERS =>
+                    FAILED ("SOME EXCEPTION RAISED - 3");
+
+          END DCL_ARR;
+
+     EXCEPTION
+
+
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
+                        "ARRAY SUBTYPE WITH INTEGER'LAST + 3 " &
+                        "COMPONENTS");
+
+          WHEN STORAGE_ERROR =>
+               FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
+
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED - 4");
+
+     END CONSTR_ERR;
+
+     RESULT ;
+
+END C52104X;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104y.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104y.ada
new file mode 100644
index 000000000..220a4a14c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c52104y.ada
@@ -0,0 +1,174 @@
+-- C52104Y.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
+--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
+--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+-- THIS IS A SPECIAL CASE IN
+
+--    DIVISION  D :  NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+--                   STATICALLY
+
+-- WHICH (THE SPECIAL CASE) TREATS TWO-DIMENSIONAL ARRAYS WHOSE LENGTH
+--    ALONG ONE DIMENSION IS GREATER THAN  INTEGER'LAST  AND WHOSE
+--    LENGTH ALONG THE OTHER DIMENSION IS  0 .
+--    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
+--    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE  CONSTRAINT_ERROR
+--    TO BE RAISED.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- RM  07/31/81
+-- SPS 03/22/83
+-- JBG 06/16/83
+-- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+--               AI-00387.
+-- MRM 03/30/93  REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT;
+PROCEDURE  C52104Y  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C52104Y" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
+                       " ASSIGNMENTS, THE LENGTHS MUST MATCH" );
+
+     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
+     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
+     --
+     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
+     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
+
+
+     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
+     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
+     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
+     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
+     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
+     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
+     --    INTEGER , CHARACTER , BOOLEAN .)
+
+
+     -------------------------------------------------------------------
+
+     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
+     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
+     --        (TWO-DIMENSIONAL ARRAYS OF BOOLEANS.)
+
+CONSTR_ERR:
+     BEGIN          -- THIS BLOCK CATCHES CONSTRAINT_ERROR IF IT IS
+                    -- RAISED BY THE SUBTYPE DECLARATION.
+
+DCL_ARR:  DECLARE
+
+               TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> ,
+                                        INTEGER RANGE <> )  OF BOOLEAN ;
+               PRAGMA PACK (TABOX5);
+
+               SUBTYPE  TABOX52  IS  TABOX5(
+                         IDENT_INT(13)..IDENT_INT(       13       ) ,
+                         IDENT_INT(-6)..IDENT_INT( INTEGER'LAST-4 ) );
+
+          BEGIN
+
+               COMMENT ("NO CONSTRAINT_ERROR FOR NON-NULL ARRAY SUBTYPE " &
+                        "WHEN ONE DIMENSION HAS INTEGER'LAST + 3 " &
+                        "COMPONENTS");
+
+OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES ONE NULL ARRAY AND ONE
+                         -- PACKED BOOLEAN ARRAY WITH INTEGER'LAST + 3
+                         -- COMPONENTS;  STORAGE ERROR MAY BE RAISED.
+
+                    ARRX51  :  TABOX5(
+                         IDENT_INT(13)..IDENT_INT(       12       ) ,
+                         IDENT_INT(-6)..IDENT_INT( INTEGER'LAST-4 ) );
+                    ARRX52  :  TABOX52 ;     -- BIG ARRAY HERE.
+
+               BEGIN
+
+                    COMMENT ("NO CONSTRAINT OR STORAGE ERROR WHEN ARRAY "&
+                            "WITH INTEGER'LAST+3 COMPONENTS ALLOCATED");
+
+               -- NULL ARRAY ASSIGNMENT:
+
+                    ARRX52 := ARRX51 ;
+                    FAILED( "EXCEPTION NOT RAISED  (10)" );
+
+               EXCEPTION
+
+                    WHEN CONSTRAINT_ERROR =>
+                         COMMENT ("CONSTRAINT_ERROR RAISED WHEN " &
+                                  "CHECKING LENGTHS FOR ARRAY HAVING " &
+                                  "> INTEGER'LAST COMPONENTS ON ONE " &
+                                  "DIMENSION");
+
+
+                    WHEN  OTHERS  =>
+                         FAILED( "OTHER EXCEPTION RAISED - SUBTEST 10");
+
+               END OBJ_DCL;
+
+          EXCEPTION
+
+               WHEN STORAGE_ERROR =>
+                    COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING ONE "&
+                             "PACKED BOOLEAN ARRAY WITH INTEGER'LAST "&
+                             "+ 3 COMPONENTS");
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING "&
+                             "ONE PACKED BOOLEAN ARRAY WITH "&
+                             "INTEGER'LAST + 3 COMPONENTS");
+               WHEN OTHERS =>
+                    FAILED ("SOME EXCEPTION RAISED - 3");
+
+          END DCL_ARR;
+
+     EXCEPTION
+
+
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
+                        "ARRAY SUBTYPE WITH INTEGER'LAST + 3 " &
+                        "COMPONENTS");
+
+          WHEN STORAGE_ERROR =>
+               FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
+
+          WHEN  OTHERS  =>
+               FAILED( "OTHER EXCEPTION RAISED - 4");
+
+     END CONSTR_ERR;
+
+     RESULT ;
+
+END C52104Y;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c53007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c53007a.ada
new file mode 100644
index 000000000..bda27b919
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c53007a.ada
@@ -0,0 +1,139 @@
+-- C53007A.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 CONTROL FLOWS CORRECTLY IN SIMPLE NESTED IF_STATEMENTS.
+
+-- JRK 7/23/80
+-- SPS 3/4/83
+
+WITH REPORT;
+PROCEDURE C53007A IS
+
+     USE REPORT;
+
+     CI1 : CONSTANT INTEGER := 1;
+     CI9 : CONSTANT INTEGER := 9;
+     CBT : CONSTANT BOOLEAN := TRUE;
+     CBF : CONSTANT BOOLEAN := FALSE;
+
+     VI1 : INTEGER := IDENT_INT(1);
+     VI9 : INTEGER := IDENT_INT(9);
+     VBT : BOOLEAN := IDENT_BOOL(TRUE);
+     VBF : BOOLEAN := IDENT_BOOL(FALSE);
+
+     FLOW_COUNT : INTEGER := 0;
+
+BEGIN
+     TEST ("C53007A", "CHECK THAT CONTROL FLOWS CORRECTLY IN SIMPLE " &
+           "NESTED IF_STATEMENTS");
+
+     IF VBF THEN  -- (FALSE)
+          FAILED ("INCORRECT CONTROL FLOW 1");
+     ELSIF CI9 < 20 THEN  -- (TRUE)
+          FLOW_COUNT := FLOW_COUNT + 1;
+          IF VI1 /= 0 AND TRUE THEN  -- (TRUE)
+               FLOW_COUNT := FLOW_COUNT + 1;
+          ELSE FAILED ("INCORRECT CONTROL FLOW 2");
+          END IF;
+     ELSE FAILED ("INCORRECT CONTROL FLOW 3");
+     END IF;
+
+     IF CBF OR ELSE VI9 = 9 THEN  -- (TRUE)
+          IF VI1 + CI9 > 0 OR (CBF AND VBT) THEN  -- (TRUE)
+               FLOW_COUNT := FLOW_COUNT + 1;
+          END IF;
+     ELSIF VBF OR VI1 > 10 THEN  -- (FALSE)
+          FAILED ("INCORRECT CONTROL FLOW 4");
+     END IF;
+
+     IF NOT CBT AND THEN NOT VBT AND THEN CI9 < 0 THEN  -- (FALSE)
+          IF FALSE OR NOT TRUE THEN  -- (FALSE)
+               FAILED ("INCORRECT CONTROL FLOW 5");
+          ELSIF VI1 >= 0 THEN  -- (TRUE)
+               NULL;
+          ELSE FAILED ("INCORRECT CONTROL FLOW 6");
+          END IF;
+          FAILED ("INCORRECT CONTROL FLOW 7");
+     ELSIF (VI1 * CI9 + 3 < 0) OR (VBT AND NOT (CI1 < 0)) THEN -- (TRUE)
+          FLOW_COUNT := FLOW_COUNT + 1;
+          IF NOT CBT OR ELSE CI9 + 1 = 0 THEN  -- (FALSE)
+               FAILED ("INCORRECT CONTROL FLOW 8");
+          ELSE FLOW_COUNT := FLOW_COUNT + 1;
+               IF VI1 * 2 > 0 THEN  -- (TRUE)
+                    FLOW_COUNT := FLOW_COUNT + 1;
+               ELSIF TRUE THEN  -- (TRUE)
+                    FAILED ("INCORRECT CONTROL FLOW 9");
+               ELSE NULL;
+               END IF;
+          END IF;
+     ELSIF FALSE AND CBF THEN  -- (FALSE)
+          FAILED ("INCORRECT CONTROL FLOW 10");
+     ELSE IF VBT THEN  -- (TRUE)
+               FAILED ("INCORRECT CONTROL FLOW 11");
+          ELSIF VI1 = 0 THEN  -- (FALSE)
+               FAILED ("INCORRECT CONTROL FLOW 12");
+          ELSE FAILED ("INCORRECT CONTROL FLOW 13");
+          END IF;
+     END IF;
+
+     IF 3 = 5 OR NOT VBT THEN  -- (FALSE)
+          FAILED ("INCORRECT CONTROL FLOW 14");
+          IF TRUE AND CBT THEN  -- (TRUE)
+               FAILED ("INCORRECT CONTROL FLOW 15");
+          ELSE FAILED ("INCORRECT CONTROL FLOW 16");
+          END IF;
+     ELSIF CBF THEN  -- (FALSE)
+          IF VI9 >= 0 OR FALSE THEN  -- (TRUE)
+               IF VBT THEN  -- (TRUE)
+                    FAILED ("INCORRECT CONTROL FLOW 17");
+               END IF;
+               FAILED ("INCORRECT CONTROL FLOW 18");
+          ELSIF VI1 + CI9 /= 0 THEN  -- (TRUE)
+               FAILED ("INCORRECT CONTROL FLOW 19");
+          END IF;
+          FAILED ("INCORRECT CONTROL FLOW 20");
+     ELSE IF VBT AND CI9 - 9 = 0 THEN  -- (TRUE)
+               IF FALSE THEN  -- (FALSE)
+                    FAILED ("INCORRECT CONTROL FLOW 21");
+               ELSIF NOT VBF AND THEN CI1 > 0 THEN  -- (TRUE)
+                    FLOW_COUNT := FLOW_COUNT + 1;
+               ELSE FAILED ("INCORRECT CONTROL FLOW 22");
+               END IF;
+               FLOW_COUNT := FLOW_COUNT + 1;
+          ELSIF NOT CBF OR VI1 /= 0 THEN  -- (TRUE)
+               IF VBT THEN  -- (TRUE)
+                    NULL;
+               END IF;
+               FAILED ("INCORRECT CONTROL FLOW 23");
+          ELSE FAILED ("INCORRECT CONTROL FLOW 24");
+          END IF;
+          FLOW_COUNT := FLOW_COUNT + 1;
+     END IF;
+
+     IF FLOW_COUNT /= 9 THEN
+          FAILED ("INCORRECT FLOW_COUNT VALUE");
+     END IF;
+
+     RESULT;
+END C53007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c540001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c540001.a
new file mode 100644
index 000000000..b7dbdd6e9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c540001.a
@@ -0,0 +1,410 @@
+-- C540001.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 an expression in a case statement may be of a generic formal
+--      type.  Check that a function call may be used as a case statement 
+--      expression.  Check that a call to a generic formal function may be 
+--      used as a case statement expression.  Check that a call to an inherited
+--      function may be used as a case statement expression even if its result
+--      type does not correspond to any nameable subtype.
+--
+-- TEST DESCRIPTION:
+--      This transition test creates examples where expressions in a case
+--      statement can be a generic formal object and a call to a generic formal
+--      function.  This test also creates examples when either a function call,
+--      a renaming of a function, or a call to an inherited function is used
+--      in the case expressions, the choices of the case statement only need 
+--      to cover the values in the result of the function.
+--
+--      Inspired by B54A08A.ADA.
+--
+--
+-- CHANGE HISTORY:
+--      12 Feb 96   SAIC    Initial version for ACVC 2.1.
+--
+--!
+
+package C540001_0 is 
+   type Int is range 1 .. 2;
+
+end C540001_0;
+
+     --==================================================================--
+
+with C540001_0;
+package C540001_1 is 
+   type Enum_Type is (Eh, Bee, Sea, Dee); -- Range of Enum_Type'Val is 0..3.
+   type Mixed     is ('A','B', 'C', None); 
+   subtype Small_Num is Natural range 0 .. 10;
+   type Small_Int is range 1 .. 2;
+   function Get_Small_Int (P : Boolean) return Small_Int;
+   procedure Assign_Mixed (P1 : in     Boolean;
+                           P2 :    out Mixed);
+
+   type Tagged_Type is tagged
+     record
+        C1 : Enum_Type;
+     end record;
+   function Get_Tagged (P : Tagged_Type) return C540001_0.Int;
+
+end C540001_1;
+
+     --==================================================================--
+
+package body C540001_1 is 
+   function Get_Small_Int (P : Boolean) return Small_Int is
+   begin
+      if P then
+         return Small_Int'First;
+      else
+         return Small_Int'Last; 
+      end if;
+   end Get_Small_Int;
+
+   ---------------------------------------------------------------------
+   procedure Assign_Mixed (P1 : in     Boolean;
+                           P2 :    out Mixed) is
+   begin
+      case Get_Small_Int (P1) is          -- Function call as expression
+           when 1  => P2 := None;         -- in case statement.
+           when 2  => P2 := 'A';
+           -- No others needed.
+      end case;
+
+   end Assign_Mixed;
+
+   ---------------------------------------------------------------------
+   function Get_Tagged (P : Tagged_Type) return C540001_0.Int is
+   begin
+      return C540001_0.Int'Last;
+   end Get_Tagged;
+
+end C540001_1;
+
+     --==================================================================--
+
+generic               
+
+   type Formal_Scalar is range <>;  
+
+   FSO : Formal_Scalar;
+
+package C540001_2 is              
+
+   type Enum is (Alpha, Beta, Theta);
+
+   procedure Assign_Enum (ET : out Enum);
+
+end C540001_2;
+
+     --==================================================================--
+
+package body C540001_2 is              
+
+   procedure Assign_Enum (ET : out Enum) is
+   begin
+      case FSO is                         -- Type of expression in case
+           when 1      => ET := Alpha;    -- statement is generic formal type.
+           when 2      => ET := Beta;
+           when others => ET := Theta;
+      end case;
+
+   end Assign_Enum;
+
+end C540001_2;
+
+     --==================================================================--
+
+with C540001_1;
+generic               
+
+   type Formal_Enum_Type is new C540001_1.Enum_Type;
+
+   with function Formal_Func (P : C540001_1.Small_Num) 
+     return Formal_Enum_Type is <>;
+
+function C540001_3 (P : C540001_1.Small_Num) return Formal_Enum_Type;
+
+     --==================================================================--
+
+function C540001_3 (P : C540001_1.Small_Num) return Formal_Enum_Type is
+
+begin
+   return Formal_Func (P);
+end C540001_3;
+
+     --==================================================================--
+
+with C540001_1;
+generic               
+
+   type Formal_Int_Type is new C540001_1.Small_Int;
+
+   with function Formal_Func return Formal_Int_Type;
+
+package C540001_4 is
+
+   procedure Gen_Assign_Mixed (P : out C540001_1.Mixed);
+
+end C540001_4;
+
+     --==================================================================--
+
+package body C540001_4 is
+
+   procedure Gen_Assign_Mixed (P : out C540001_1.Mixed) is
+   begin
+      case Formal_Func is                          -- Case expression is
+         when 1      => P := C540001_1.'A';        -- generic function.
+         when others => P := C540001_1.'B';
+      end case;
+
+   end Gen_Assign_Mixed;
+
+end C540001_4;
+
+     --==================================================================--
+
+with C540001_1;
+package C540001_5 is
+   type New_Tagged is new C540001_1.Tagged_Type with
+      record
+         C2 : C540001_1.Mixed;
+      end record;
+
+    -- Inherits Get_Tagged (P : New_Tagged) return C540001_0.Int;
+    -- Note that the return type of the inherited function is not
+    -- nameable here.
+
+   procedure Assign_Tagged (P1 : in     New_Tagged;
+                            P2 :    out New_Tagged);
+
+end C540001_5;
+
+     --==================================================================--
+
+package body C540001_5 is
+
+   procedure Assign_Tagged (P1 : in     New_Tagged;
+                            P2 :    out New_Tagged) is
+   begin
+      case Get_Tagged (P1) is                      -- Case expression is
+                                                   -- inherited function.
+         when 2      => P2 := (C540001_1.Bee, 'B');       
+         when others => P2 := (C540001_1.Sea, C540001_1.None);
+      end case;
+
+   end Assign_Tagged;
+
+end C540001_5;
+
+     --==================================================================--
+
+with Report;
+with C540001_1;
+with C540001_2;
+with C540001_3;
+with C540001_4;
+with C540001_5;
+
+procedure C540001 is
+   type Value is range 1 .. 5;
+
+begin
+   Report.Test ("C540001", "Check that an expression in a case statement " &
+                "may be of a generic formal type.  Check that a function " &
+                "call may be used as a case statement expression.  Check " &
+                "that a call to a generic formal function may be used as " &
+                "a case statement expression.  Check that a call to an "   &
+                "inherited function may be used as a case statement "      &
+                "expression");
+
+   Generic_Formal_Object_Subtest:
+   begin
+      declare
+         One  : Value := 1;
+         package One_Pck is new C540001_2 (Value, One);
+         use One_Pck;
+         EObj : Enum;
+      begin
+         Assign_Enum (EObj);
+         if EObj /= Alpha then
+            Report.Failed ("Incorrect result for value of one in generic" &
+                           "formal object subtest");
+         end if;
+      end;
+
+      declare
+         Five : Value := 5;
+         package Five_Pck is new C540001_2 (Value, Five);
+         use Five_Pck;
+         EObj : Enum;
+      begin
+         Assign_Enum (EObj);
+         if EObj /= Theta then
+            Report.Failed ("Incorrect result for value of five in generic" &
+                           "formal object subtest");
+         end if;
+      end;
+
+   end Generic_Formal_Object_Subtest;
+
+   Instantiated_Generic_Function_Subtest:
+   declare
+      type New_Enum_Type is new C540001_1.Enum_Type;
+
+      function Get_Enum_Value (P : C540001_1.Small_Num) 
+        return New_Enum_Type is
+      begin
+         return New_Enum_Type'Val (P);
+      end Get_Enum_Value;
+
+      function Val_Func is new C540001_3 
+        (Formal_Enum_Type => New_Enum_Type, 
+         Formal_Func      => Get_Enum_Value);
+
+      procedure Assign_Num (P : in out C540001_1.Small_Num) is
+      begin
+         case Val_Func (P) is                         -- Case expression is
+                                                      -- instantiated generic
+             when New_Enum_Type (C540001_1.Eh) |      -- function.
+                  New_Enum_Type (C540001_1.Sea)   => P := 4;
+             when New_Enum_Type (C540001_1.Bee)   => P := 7;
+             when others                          => P := 9;
+         end case;
+
+      end Assign_Num;
+
+      SNObj  : C540001_1.Small_Num;
+
+   begin
+      SNObj := 0;
+      Assign_Num (SNObj);       
+      if SNObj /= 4 then
+         Report.Failed ("Incorrect result for value of zero in call to " &
+                        "generic function subtest");
+      end if;
+
+      SNObj := 3;
+      Assign_Num (SNObj);       
+      if SNObj /= 9 then
+         Report.Failed ("Incorrect result for value of three in call to " &
+                        "generic function subtest");
+      end if;
+
+   end Instantiated_Generic_Function_Subtest;
+
+   -- When a function call, a renaming of a function, or a call to an 
+   -- inherited function is used in the case expressions, the choices 
+   -- of the case statement only need to cover the values in the result 
+   -- of the function.
+
+   Function_Call_Subtest:
+   declare
+      MObj : C540001_1.Mixed := 'B';
+      BObj : Boolean         := True;
+      use type C540001_1.Mixed;
+   begin
+      C540001_1.Assign_Mixed (BObj, MObj);
+      if MObj /= C540001_1.None then
+         Report.Failed ("Incorrect result for value of true in function" &
+                        "call subtest");
+         end if;
+
+      BObj := False;
+      C540001_1.Assign_Mixed (BObj, MObj);
+      if MObj /= C540001_1.'A' then
+         Report.Failed ("Incorrect result for value of false in function" &
+                        "call subtest");
+      end if;
+
+   end Function_Call_Subtest;
+
+   Function_Renaming_Subtest:
+   declare
+      use C540001_1;
+      function Rename_Get_Small_Int (P : Boolean) 
+        return Small_Int renames Get_Small_Int;
+      MObj : Mixed   := None;
+      BObj : Boolean := False;
+   begin
+      case Rename_Get_Small_Int (BObj) is
+          when 1 => MObj := 'A';
+          when 2 => MObj := 'B';
+          -- No others needed.
+      end case;
+
+      if MObj /= 'B' then
+         Report.Failed ("Incorrect result for value of false in function" &
+                        "renaming subtest");
+      end if;
+
+   end Function_Renaming_Subtest;
+
+   Call_To_Generic_Formal_Function_Subtest:
+   declare
+      type New_Small_Int is new C540001_1.Small_Int;
+
+      function Get_Int_Value return New_Small_Int is
+      begin
+         return New_Small_Int'First;
+      end Get_Int_Value;
+
+      package Int_Pck is new C540001_4 
+        (Formal_Int_Type => New_Small_Int, 
+         Formal_Func     => Get_Int_Value);
+
+      use type C540001_1.Mixed;
+      MObj : C540001_1.Mixed := C540001_1.None; 
+
+   begin
+      Int_Pck.Gen_Assign_Mixed (MObj); 
+      if MObj /= C540001_1.'A' then
+         Report.Failed ("Incorrect result in call to generic formal " &
+                        "function subtest");
+      end if;
+
+   end Call_To_Generic_Formal_Function_Subtest;
+
+   Call_To_Inherited_Function_Subtest:
+   declare
+      NTObj1 : C540001_5.New_Tagged := (C1 => C540001_1.Eh,
+                                        C2 => C540001_1.'A');
+      NTObj2 : C540001_5.New_Tagged := (C540001_1.Dee, C540001_1.'C');
+      use type C540001_1.Mixed;
+      use type C540001_1.Enum_Type;
+   begin
+      C540001_5.Assign_Tagged (NTObj1, NTObj2);
+      if NTObj2.C1 /= C540001_1.Bee or  
+         NTObj2.C2 /= C540001_1.'B' then
+         Report.Failed ("Incorrect result in inherited function subtest");
+      end if;
+
+   end Call_To_Inherited_Function_Subtest;
+
+   Report.Result;
+
+end C540001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a03a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a03a.ada
new file mode 100644
index 000000000..cc46df8c6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a03a.ada
@@ -0,0 +1,105 @@
+-- C54A03A.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 BOOLEAN, CHARACTER, USER-DEFINED ENUMERATED, INTEGER,
+--    AND DERIVED TYPES MAY BE USED IN A CASE EXPRESSION.
+
+-- DAT 1/22/81
+-- PWB 4/22/86  RENAME TO -AB;
+--              REMOVE EXTRANEOUS <CR> FROM BEGINNING OF LINE 45.
+
+WITH REPORT;
+PROCEDURE C54A03A IS
+
+     USE REPORT;
+
+     TYPE D_INT IS NEW INTEGER RANGE 1 .. 2;
+     TYPE D_BOOL IS NEW BOOLEAN;
+     TYPE D_BOOL_2 IS NEW D_BOOL;
+     TYPE M_ENUM IS (FIRST, SECOND, THIRD);
+     TYPE M_CHAR IS NEW CHARACTER RANGE ASCII.NUL .. 'Z';
+     TYPE M_ENUM_2 IS NEW M_ENUM;
+
+     I : INTEGER := 1;
+     D_I : D_INT := 1;
+     B : BOOLEAN := TRUE;
+     D_B : D_BOOL := TRUE;
+     D_B_2 : D_BOOL_2 := FALSE;
+     E : M_ENUM := THIRD;
+     C : CHARACTER := 'A';
+     M_C : M_CHAR := 'Z';
+     D_E : M_ENUM_2 := SECOND;
+
+BEGIN
+     TEST ("C54A03A", "CHECK VARIOUS DISCRETE TYPES " &
+                      "IN CASE EXPRESSIONS");
+
+     CASE I IS
+          WHEN 2 | 3 => FAILED ("WRONG CASE 1");
+          WHEN 1 => NULL;
+          WHEN OTHERS => FAILED ("WRONG CASE 2");
+     END CASE;
+
+     CASE D_I IS
+          WHEN 1 => NULL;
+          WHEN 2 => FAILED ("WRONG CASE 2A");
+     END CASE;
+
+     CASE B IS
+          WHEN TRUE => NULL;
+          WHEN FALSE => FAILED ("WRONG CASE 3");
+     END CASE;
+
+     CASE D_B IS
+          WHEN TRUE => NULL;
+          WHEN FALSE => FAILED ("WRONG CASE 4");
+     END CASE;
+
+     CASE D_B_2 IS
+          WHEN FALSE => NULL;
+          WHEN TRUE => FAILED ("WRONG CASE 5");
+     END CASE;
+
+     CASE E IS
+          WHEN SECOND | FIRST => FAILED ("WRONG CASE 6");
+          WHEN THIRD => NULL;
+     END CASE;
+
+     CASE C IS
+          WHEN 'A' .. 'Z' => NULL;
+          WHEN OTHERS => FAILED ("WRONG CASE 7");
+     END CASE;
+
+     CASE M_C IS
+          WHEN 'Z' => NULL;
+          WHEN OTHERS => FAILED ("WRONG CASE 8");
+     END CASE;
+
+     CASE D_E IS
+          WHEN FIRST => FAILED ("WRONG CASE 9");
+          WHEN SECOND | THIRD => NULL;
+     END CASE;
+
+     RESULT;
+END C54A03A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a04a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a04a.ada
new file mode 100644
index 000000000..c52de5003
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a04a.ada
@@ -0,0 +1,75 @@
+-- C54A04A.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 PRIVATE (DISCRETE) TYPES MAY BE USED IN CASE EXPRESSIONS
+--     WITHIN THE DEFINING PACKAGE.
+
+-- DAT 1/29/81
+
+WITH REPORT;
+PROCEDURE C54A04A IS
+
+     USE REPORT;
+
+     PACKAGE P IS
+
+          TYPE T IS PRIVATE;
+          TYPE LT IS LIMITED PRIVATE;
+
+     PRIVATE
+
+          TYPE T IS ('Z', X);
+          TYPE LT IS NEW INTEGER RANGE 0 .. 1;
+
+     END P;
+
+     VT : P.T;
+     VLT : P.LT;
+
+     PACKAGE BODY P IS
+
+     BEGIN
+          TEST ("C54A04A", "PRIVATE DISCRETE TYPES MAY APPEAR IN " &
+                "CASE EXPRESSIONS IN PACKAGE BODY");
+
+          VT := 'Z';
+          VLT := LT (IDENT_INT (1));
+
+          CASE VT IS
+               WHEN X => FAILED ("WRONG CASE 1");
+               WHEN 'Z' => NULL; -- OK
+          END CASE;
+
+          CASE VLT IS
+               WHEN 1 => NULL; -- OK
+               WHEN 0 => FAILED ("WRONG CASE 2");
+          END CASE;
+     END P;
+
+BEGIN
+
+     -- TEST CALLED FROM PACKAGE BODY, ALREADY ELABORATED.
+
+     RESULT;
+END C54A04A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a07a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a07a.ada
new file mode 100644
index 000000000..0729b802f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a07a.ada
@@ -0,0 +1,111 @@
+-- C54A07A.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 VARIABLE USED AS A CASE EXPRESSION IS NOT CONSIDERED
+--    LOCAL TO THE CASE STATEMENT.  IN PARTICULAR, CHECK THAT THE
+--    VARIABLE CAN BE ASSIGNED A NEW VALUE, AND THE ASSIGNMENT TAKES
+--    EFFECT IMMEDIATELY (I.E. THE CASE STATEMENT DOES NOT USE A
+--    COPY OF THE CASE EXPRESSION).
+
+
+-- RM 01/21/80
+
+
+WITH REPORT ;
+PROCEDURE  C54A07A  IS
+
+     USE REPORT ;
+
+BEGIN
+
+     TEST("C54A07A" , "CHECK THAT A VARIABLE USED AS A CASE" &
+                      " EXPRESSION IS NOT CONSIDERED LOCAL TO" &
+                      " THE CASE STATEMENT" );
+
+     DECLARE   -- A
+     BEGIN
+
+B1 :      DECLARE
+
+               TYPE  VARIANT_REC( DISCR : BOOLEAN := TRUE )  IS
+                    RECORD
+                         A , B : INTEGER ;
+                         CASE  DISCR  IS
+                              WHEN  TRUE   =>  P , Q : CHARACTER ;
+                              WHEN  FALSE  =>  X , Y : INTEGER   ;
+                         END CASE;
+                    END RECORD ;
+
+               V : VARIANT_REC := ( TRUE , 1 , 2 ,
+                                           IDENT_CHAR( 'P' )   ,
+                                           IDENT_CHAR( 'Q' )   );
+
+          BEGIN
+
+               IF  EQUAL( 3 , 7 )  THEN  V := ( FALSE , 3 , 4 , 7 , 8 );
+               END IF;
+
+               CASE  V.DISCR  IS
+
+                    WHEN  TRUE    =>  
+
+                         IF  ( V.P /= 'P'  OR
+                               V.Q /= 'Q'  )
+                         THEN  FAILED( "WRONG VALUES  -  1" );
+                         END IF;
+
+                         B1.V  :=  ( FALSE , 3 , 4 ,
+                                             IDENT_INT( 5 )   ,
+                                             IDENT_INT( 6 )   );
+
+                         IF  V.DISCR  THEN FAILED( "WRONG DISCR." );
+                         END IF;
+
+                         IF  ( V.X /= 5  OR
+                               V.Y /= 6  )
+                         THEN  FAILED( "WRONG VALUES  -  2" );
+                         END IF;
+
+                    WHEN  FALSE   =>  
+                         FAILED( "WRONG BRANCH IN CASE STMT." );
+
+               END CASE;
+
+          EXCEPTION
+
+               WHEN  OTHERS  =>  FAILED("EXCEPTION RAISED");
+
+          END B1 ;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>  FAILED( "EXCEPTION RAISED BY DECLARATIONS");
+
+     END ;    -- A
+
+
+     RESULT ;
+
+
+END C54A07A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13a.ada
new file mode 100644
index 000000000..949de8112
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13a.ada
@@ -0,0 +1,109 @@
+-- C54A13A.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 CASE EXPRESSION IS A DECLARED VARIABLE OR
+--     CONSTANT, OR ONE OF THESE IN PARENTHESES, AND ITS SUBTYPE IS
+--     NONSTATIC, THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY
+--     APPEAR AS A CHOICE.
+
+-- HISTORY:
+--     BCB 02/29/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C54A13A IS
+
+     SUBTYPE INT IS INTEGER RANGE IDENT_INT(5) .. IDENT_INT(10);
+
+     A : INT := 8;
+     B : CONSTANT INT := 7;
+     C, D : INTEGER;
+
+     FUNCTION IDENT(X : INT) RETURN INT IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN X;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT;
+
+BEGIN
+     TEST ("C54A13A", "CHECK THAT IF A CASE EXPRESSION IS A DECLARED " &
+                      "VARIABLE OR CONSTANT, OR ONE OF THESE IN " &
+                      "PARENTHESES, AND ITS SUBTYPE IS NONSTATIC, " &
+                      "THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE " &
+                      "MAY APPEAR AS A CHOICE");
+
+     CASE A IS
+          WHEN 0 => C := IDENT_INT(5);
+          WHEN 8 => C := IDENT_INT(10);
+          WHEN 30000 => C := IDENT_INT(15);
+          WHEN -30000 => C := IDENT_INT(20);
+          WHEN OTHERS => C := IDENT_INT(25);
+     END CASE;
+
+     IF C /= IDENT_INT(10) THEN
+          FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 1");
+     END IF;
+
+     CASE B IS
+          WHEN 0 => D := IDENT_INT(5);
+          WHEN 100 => D := IDENT_INT(10);
+          WHEN 30000 => D := IDENT_INT(15);
+          WHEN -30000 => D := IDENT_INT(20);
+          WHEN OTHERS => D := IDENT_INT(25);
+     END CASE;
+
+     IF D /= IDENT_INT(25) THEN
+          FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 2");
+     END IF;
+
+     CASE (A) IS
+          WHEN 0 => C := IDENT_INT(5);
+          WHEN 8 => C := IDENT_INT(10);
+          WHEN 30000 => C := IDENT_INT(15);
+          WHEN -30000 => C := IDENT_INT(20);
+          WHEN OTHERS => C := IDENT_INT(25);
+     END CASE;
+
+     IF C /= IDENT_INT(10) THEN
+          FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 3");
+     END IF;
+
+     CASE (B) IS
+          WHEN 0 => D := IDENT_INT(5);
+          WHEN 110 => D := IDENT_INT(10);
+          WHEN 30000 => D := IDENT_INT(15);
+          WHEN -30000 => D := IDENT_INT(20);
+          WHEN OTHERS => D := IDENT_INT(25);
+     END CASE;
+
+     IF D /= IDENT_INT(25) THEN
+          FAILED ("IMPROPER VALUE FOR CASE EXPRESSION - 4");
+     END IF;
+
+     RESULT;
+END C54A13A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13b.ada
new file mode 100644
index 000000000..b0f3d1aea
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13b.ada
@@ -0,0 +1,105 @@
+-- C54A13B.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 CASE EXPRESSION IS A GENERIC "IN" OR "IN OUT"
+--     PARAMETER WITH A NON-STATIC SUBTYPE OR ONE OF THESE IN
+--     PARENTHESES, THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY
+--     APPEAR AS A CHOICE.
+
+-- HISTORY:
+--     BCB 07/13/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C54A13B IS
+
+     L : INTEGER := IDENT_INT(1);
+     R : INTEGER := IDENT_INT(100);
+
+     SUBTYPE INT IS INTEGER RANGE L .. R;
+
+     GENERIC
+          IN_PAR : IN INT;
+          IN_OUT_PAR : IN OUT INT;
+     PROCEDURE GEN_PROC (I : IN OUT INTEGER);
+
+     IN_VAR : INT := IDENT_INT (10);
+     IN_OUT_VAR : INT := IDENT_INT (100);
+     CHECK_VAR : INT := IDENT_INT (1);
+
+     PROCEDURE GEN_PROC (I : IN OUT INTEGER) IS
+     BEGIN
+          CASE IN_PAR IS
+               WHEN 0 => I := I + IDENT_INT (2);
+               WHEN 10 => I := I + IDENT_INT (1);
+               WHEN -3000 => I := I + IDENT_INT (3);
+               WHEN OTHERS => I := I + IDENT_INT (4);
+          END CASE;
+
+          CASE IN_OUT_PAR IS
+               WHEN 0 => IN_OUT_PAR := IDENT_INT (0);
+               WHEN 100 => IN_OUT_PAR := IDENT_INT (50);
+               WHEN -3000 => IN_OUT_PAR := IDENT_INT (-3000);
+               WHEN OTHERS => IN_OUT_PAR := IDENT_INT (5);
+          END CASE;
+
+          CASE (IN_PAR) IS
+               WHEN 0 => I := I + IDENT_INT (2);
+               WHEN 10 => I := I + IDENT_INT (1);
+               WHEN -3000 => I := I + IDENT_INT (3);
+               WHEN OTHERS => I := I + IDENT_INT (4);
+          END CASE;
+
+          CASE (IN_OUT_PAR) IS
+               WHEN 0 => IN_OUT_PAR := IDENT_INT (200);
+               WHEN 50 => IN_OUT_PAR := IDENT_INT (25);
+               WHEN -3000 => IN_OUT_PAR := IDENT_INT (300);
+               WHEN OTHERS => IN_OUT_PAR := IDENT_INT (400);
+          END CASE;
+
+     END GEN_PROC;
+
+     PROCEDURE P IS NEW GEN_PROC (IN_VAR, IN_OUT_VAR);
+
+BEGIN
+     TEST ("C54A13B", "CHECK THAT IF A CASE EXPRESSION IS A " &
+                      "GENERIC 'IN' OR 'IN OUT' PARAMETER WITH A " &
+                      "NON-STATIC SUBTYPE OR ONE OF " &
+                      "THESE IN PARENTHESES, THEN ANY VALUE OF " &
+                      "THE EXPRESSION'S BASE TYPE MAY APPEAR AS " &
+                      "A CHOICE");
+
+     P (CHECK_VAR);
+
+     IF NOT EQUAL (CHECK_VAR, IDENT_INT(3)) THEN
+          FAILED ("INCORRECT CHOICES MADE FOR IN PARAMETER IN CASE");
+     END IF;
+
+     IF NOT EQUAL (IN_OUT_VAR, IDENT_INT(25)) THEN
+          FAILED ("INCORRECT CHOICESMADE FOR IN OUT PARAMETER IN CASE");
+     END IF;
+
+     RESULT;
+END C54A13B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13c.ada
new file mode 100644
index 000000000..f093a44b5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13c.ada
@@ -0,0 +1,104 @@
+-- C54A13C.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 CASE EXPRESSION IS A QUALIFIED EXPRESSION, A
+--     TYPE CONVERSION, OR ONE OF THESE IN PARENTHESES, AND ITS
+--     SUBTYPE IS NONSTATIC, THEN ANY VALUE OF THE EXPRESSION'S
+--     BASE TYPE MAY APPEAR AS A CHOICE.
+
+-- HISTORY:
+--     BCB 07/13/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C54A13C IS
+
+     L : INTEGER := 1;
+     R : INTEGER := 100;
+
+     SUBTYPE INT IS INTEGER RANGE L .. R;
+
+     A : INT := 50;
+
+     B : INTEGER := 50;
+
+     C : INTEGER;
+
+BEGIN
+     TEST ("C54A13C", "CHECK THAT IF A CASE EXPRESSION IS A " &
+                      "QUALIFIED EXPRESSION, A TYPE CONVERSION, " &
+                      "OR ONE OF THESE IN PARENTHESES, AND ITS " &
+                      "SUBTYPE IS NONSTATIC, THEN ANY VALUE OF THE " &
+                      "EXPRESSION'S BASE TYPE MAY APPEAR AS A CHOICE");
+
+     CASE INT'(A) IS
+          WHEN 0 => C := IDENT_INT (5);
+          WHEN 50 => C := IDENT_INT (10);
+          WHEN -3000 => C := IDENT_INT (15);
+          WHEN OTHERS => C := IDENT_INT (20);
+     END CASE;
+
+     IF C /= IDENT_INT (10) THEN
+          FAILED ("INCORRECT CHOICE MADE FOR QUALIFIED EXPRESSION IN " &
+                  "CASE");
+     END IF;
+
+     CASE INT(B) IS
+          WHEN 0 => C := IDENT_INT (5);
+          WHEN 50 => C := IDENT_INT (10);
+          WHEN -3000 => C := IDENT_INT (15);
+          WHEN OTHERS => C := IDENT_INT (20);
+     END CASE;
+
+     IF C /= IDENT_INT (10) THEN
+          FAILED ("INCORRECT CHOICE MADE FOR TYPE CONVERSION IN CASE");
+     END IF;
+
+     CASE (INT'(A)) IS
+          WHEN 0 => C := IDENT_INT (5);
+          WHEN 50 => C := IDENT_INT (10);
+          WHEN -3000 => C := IDENT_INT (15);
+          WHEN OTHERS => C := IDENT_INT (20);
+     END CASE;
+
+     IF C /= IDENT_INT (10) THEN
+          FAILED ("INCORRECT CHOICE MADE FOR QUALIFIED EXPRESSION IN " &
+                  "PARENTHESES IN CASE");
+     END IF;
+
+     CASE (INT(B)) IS
+          WHEN 0 => C := IDENT_INT (5);
+          WHEN 50 => C := IDENT_INT (10);
+          WHEN -3000 => C := IDENT_INT (15);
+          WHEN OTHERS => C := IDENT_INT (20);
+     END CASE;
+
+     IF C /= IDENT_INT (10) THEN
+          FAILED ("INCORRECT CHOICE MADE FOR TYPE CONVERSION IN " &
+                  "PARENTHESES IN CASE");
+     END IF;
+
+     RESULT;
+END C54A13C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13d.ada
new file mode 100644
index 000000000..9c71bd106
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a13d.ada
@@ -0,0 +1,138 @@
+-- C54A13D.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 CASE EXPRESSION IS A FUNCTION INVOCATION,
+--     ATTRIBUTE, STATIC EXPRESSION, OR ONE OF THESE IN PARENTHESES,
+--     THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY APPEAR AS A
+--     CHOICE.
+
+-- HISTORY:
+--     BCB 07/19/88  CREATED ORIGINAL TEST.
+--     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+--     GJD 11/15/95  REMOVED ADA 95 INCOMPATIBLE ALTERNATIVE IN FIRST CASE.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C54A13D IS
+
+     SUBTYPE INT IS INTEGER RANGE -100 .. 100;
+
+     CONS : CONSTANT INT := 0;
+
+     C : INT;
+
+     TYPE ENUM IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
+
+     SUBTYPE SUBENUM IS ENUM RANGE THREE .. FOUR;
+
+     FUNCTION FUNC RETURN INT IS
+     BEGIN
+          RETURN 0;
+     END FUNC;
+
+BEGIN
+     TEST ("C54A13D", "CHECK THAT IF A CASE EXPRESSION IS A FUNCTION " &
+                      "INVOCATION, ATTRIBUTE, STATIC EXPRESSION, OR " &
+                      "ONE OF THESE IN PARENTHESES, THEN ANY VALUE " &
+                      "OF THE EXPRESSION'S BASE TYPE MAY APPEAR AS " &
+                      "A CHOICE");
+
+     CASE FUNC IS
+          WHEN 0 => C := IDENT_INT (5);
+          WHEN 100 => C := IDENT_INT (10);
+          WHEN OTHERS => C := IDENT_INT (20);
+     END CASE;
+
+     IF NOT EQUAL (C,5) THEN
+          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
+                  "FUNCTION INVOCATION - 1");
+     END IF;
+
+     CASE (FUNC) IS
+          WHEN 0 => C := IDENT_INT (25);
+          WHEN 100 => C := IDENT_INT (50);
+          WHEN -3000 => C := IDENT_INT (75);
+          WHEN OTHERS => C := IDENT_INT (90);
+     END CASE;
+
+     IF NOT EQUAL (C,25) THEN
+          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
+                  "FUNCTION INVOCATION - 2");
+     END IF;
+
+     CASE SUBENUM'FIRST IS
+          WHEN ONE => C := IDENT_INT (100);
+          WHEN TWO => C := IDENT_INT (99);
+          WHEN THREE => C := IDENT_INT (98);
+          WHEN FOUR => C := IDENT_INT (97);
+          WHEN FIVE => C := IDENT_INT (96);
+          WHEN SIX => C := IDENT_INT (95);
+     END CASE;
+
+     IF NOT EQUAL (C,98) THEN
+          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS AN " &
+                  "ATTRIBUTE - 1");
+     END IF;
+
+     CASE (SUBENUM'FIRST) IS
+          WHEN ONE => C := IDENT_INT (90);
+          WHEN TWO => C := IDENT_INT (89);
+          WHEN THREE => C := IDENT_INT (88);
+          WHEN FOUR => C := IDENT_INT (87);
+          WHEN FIVE => C := IDENT_INT (86);
+          WHEN SIX => C := IDENT_INT (85);
+     END CASE;
+
+     IF NOT EQUAL (C,88) THEN
+          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS AN " &
+                  "ATTRIBUTE - 2");
+     END IF;
+
+     CASE CONS * 1 IS
+          WHEN 0 => C := IDENT_INT (1);
+          WHEN 100 => C := IDENT_INT (2);
+          WHEN -3000 => C := IDENT_INT (3);
+          WHEN OTHERS => C := IDENT_INT (4);
+     END CASE;
+
+     IF NOT EQUAL (C,1) THEN
+          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
+                  "STATIC EXPRESSION - 1");
+     END IF;
+
+     CASE (CONS * 1) IS
+          WHEN 0 => C := IDENT_INT (10);
+          WHEN 100 => C := IDENT_INT (20);
+          WHEN -3000 => C := IDENT_INT (30);
+          WHEN OTHERS => C := IDENT_INT (40);
+     END CASE;
+
+     IF NOT EQUAL (C,10) THEN
+          FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
+                  "STATIC EXPRESSION - 2");
+     END IF;
+
+     RESULT;
+END C54A13D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a22a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a22a.ada
new file mode 100644
index 000000000..4f6ab69d3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a22a.ada
@@ -0,0 +1,68 @@
+-- C54A22A.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 ALL FORMS OF CHOICE IN CASE CHOICES.
+
+-- DAT 1/29/81
+-- SPS 1/21/83
+
+WITH REPORT;
+PROCEDURE C54A22A IS
+
+     USE REPORT;
+
+     TYPE T IS RANGE 1 .. 10;
+     C5 : CONSTANT T := 5;
+     SUBTYPE S1 IS T RANGE 1 .. 5;
+     SUBTYPE S2 IS T RANGE C5 + 1 .. 7;
+     SUBTYPE SN IS T RANGE C5 + 4 .. C5 - 4 + 7;  -- NULL RANGE.
+     SUBTYPE S10 IS T RANGE C5 + 5 .. T'LAST;
+
+BEGIN
+     TEST ("C54A22A", "CHECK ALL FORMS OF CASE CHOICES");
+
+     CASE T'(C5 + 3) IS
+          WHEN SN                       -- 9..8
+          | S1 RANGE 1 .. 0             -- 1..0
+          | S2 RANGE C5 + 2 .. C5 + 1   -- 7..6
+          | 3 .. 2                      -- 3..2
+               => FAILED ("WRONG CASE 1");
+
+          WHEN  S1 RANGE 4 .. C5        -- 4..5
+          | S1 RANGE C5 - 4 .. C5 / 2   -- 1..2
+          | 3 .. 1 + C5 MOD 3           -- 3..3
+          | SN                          -- 9..8
+          | S1 RANGE 5 .. C5 - 1        -- 5..4
+          | 6 .. 7                      -- 6..7
+          | S10                         -- 10..10
+          | 9                           -- 9
+          | S10 RANGE 10 .. 9 =>        -- 10..9
+               FAILED ("WRONG CASE 2");
+
+          WHEN C5 + C5 - 2 .. 8         -- 8
+               => NULL;
+     END CASE;
+
+     RESULT;
+END C54A22A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a23a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a23a.ada
new file mode 100644
index 000000000..7acaa5e65
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a23a.ada
@@ -0,0 +1,49 @@
+-- C54A23A.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 CASE CHOICES MAY BE CONSTANT NAMES
+
+-- DAT 3/18/81
+-- SPS 4/7/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C54A23A IS
+
+     C1 : CONSTANT INTEGER := 1;
+     C2 : CONSTANT INTEGER := 2;
+     C3 : CONSTANT INTEGER := 3;
+
+BEGIN
+     TEST ("C54A23A", "CASE CHOICES MAY BE CONSTANTS");
+
+     CASE IDENT_INT (C3) IS
+          WHEN C1 | C2
+               => FAILED ("WRONG CASE CHOICE 1");
+          WHEN 3 => NULL;
+          WHEN OTHERS => FAILED ("WRONG CASE CHOICE 2");
+     END CASE;
+
+     RESULT;
+END C54A23A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a24a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a24a.ada
new file mode 100644
index 000000000..edac9de5f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a24a.ada
@@ -0,0 +1,63 @@
+-- C54A24A.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 NULL SUBRANGE CHOICES MAY OCCUR IN CASE STATEMENT, WITH
+-- OUT-OF-BOUNDS RANGE BOUNDS, AND WHERE VACUOUS CHOICES ARE NULL.
+-- CHECK THAT AN UNNEEDED OTHERS CHOICE IS PERMITTED.
+
+-- DAT 1/29/81
+-- JBG 8/21/83
+
+WITH REPORT;
+PROCEDURE C54A24A IS
+
+     USE REPORT;
+
+     TYPE T IS RANGE 1 .. 1010;
+     SUBTYPE ST IS T RANGE 5 .. 7;
+
+     V : ST := 6;
+
+BEGIN
+     TEST ("C54A24A", "CHECK NULL CASE SUBRANGE CHOICES, WITH " &
+           "OUTRAGEOUS BOUNDS");
+
+     CASE V IS
+          WHEN -1000 .. -1010 => NULL;
+          WHEN T RANGE -5 .. -6 => NULL;
+          WHEN 12 .. 11 | ST RANGE 1000 .. 99 => NULL;
+          WHEN ST RANGE -99 .. -999 => NULL;
+          WHEN ST RANGE 6 .. 6 => V := V - 1;
+          WHEN T RANGE ST'BASE'LAST .. ST'BASE'FIRST => NULL;
+          WHEN 5 | 7 => NULL;
+          WHEN ST RANGE T'BASE'LAST .. T'BASE'FIRST => NULL;
+          WHEN T'BASE'LAST .. T'BASE'FIRST => NULL;
+          WHEN OTHERS => V := V + 1;
+     END CASE;
+     IF V /= 5 THEN
+          FAILED ("IMPROPER CASE EXECUTION");
+     END IF;
+
+     RESULT;
+END C54A24A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a24b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a24b.ada
new file mode 100644
index 000000000..4515e93ca
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a24b.ada
@@ -0,0 +1,58 @@
+-- C54A24B.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 NULL SUBTYPE RANGES ARE ACCEPTABLE CASE CHOICES,
+--     WHERE THE BOUNDS ARE BOTH OUT OF THE SUBRANGE'S RANGE, AND
+--     WHERE VACUOUS CHOICES HAVE NON-NULL STATEMENT SEQUENCES.
+--     CHECK THAT AN UNNEEDED OTHERS CLAUSE IS PERMITTED.
+
+-- HISTORY:
+--     DAT 01/29/81 CREATED ORIGINAL TEST.
+--     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT;
+PROCEDURE C54A24B IS
+
+     USE REPORT;
+
+     TYPE C IS NEW CHARACTER RANGE 'A' .. 'D';
+     X : C := 'B';
+
+BEGIN
+     TEST ("C54A24B", "NULL CASE CHOICE SUBRANGES WITH VALUES " &
+           "OUTSIDE SUBRANGE");
+
+     CASE X IS
+          WHEN C RANGE C'BASE'LAST .. C'BASE'FIRST
+               | C RANGE 'Z' .. ' ' => X := 'A';
+          WHEN C => NULL;
+          WHEN OTHERS => X := 'C';
+     END CASE;
+     IF X /= 'B' THEN
+          FAILED ("WRONG CASE EXECUTION");
+     END IF;
+
+     RESULT;
+END C54A24B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42a.ada
new file mode 100644
index 000000000..b6babb0d2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42a.ada
@@ -0,0 +1,173 @@
+-- C54A42A.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  CASE_STATEMENT  MAY HANDLE A LARGE NUMBER OF
+--    POTENTIAL VALUES GROUPED INTO A SMALL NUMBER OF ALTERNATIVES
+--    AND THAT EACH TIME THE APPROPRIATE ALTERNATIVE IS EXECUTED.
+
+-- (OPTIMIZATION TEST.)
+
+
+-- RM 03/24/81
+-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+
+
+WITH REPORT;
+PROCEDURE  C54A42A  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C54A42A" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
+                       " A LARGE NUMBER OF POTENTIAL VALUES GROUPED"   &
+                       " INTO A SMALL NUMBER OF ALTERNATIVES" );
+
+     DECLARE
+
+          STATCON : CONSTANT CHARACTER := 'B' ;
+          STATVAR :          CHARACTER := 'Q' ;
+          DYNCON  : CONSTANT CHARACTER := IDENT_CHAR( 'Y' );
+          DYNVAR  :          CHARACTER := IDENT_CHAR( 'Z' );
+
+     BEGIN
+
+          CASE  CHARACTER'('A')  IS
+               WHEN  ASCII.NUL .. 'A'  =>  NULL ;
+               WHEN  'B'               =>  FAILED( "WRONG ALTERN. A2" );
+               WHEN  'P'               =>  FAILED( "WRONG ALTERN. A3" );
+               WHEN  'Y'               =>  FAILED( "WRONG ALTERN. A4" );
+               WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. A5" );
+               WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. A6" );
+          END CASE;
+
+          CASE  STATCON  IS
+               WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. B1" );
+               WHEN  'B'               =>  NULL ;
+               WHEN  'P'               =>  FAILED( "WRONG ALTERN. B3" );
+               WHEN  'Y'               =>  FAILED( "WRONG ALTERN. B4" );
+               WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. B5" );
+               WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. B6" );
+          END CASE;
+
+          CASE  STATVAR  IS
+               WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. C1" );
+               WHEN  'B'               =>  FAILED( "WRONG ALTERN. C2" );
+               WHEN  'P'               =>  FAILED( "WRONG ALTERN. C3" );
+               WHEN  'Y'               =>  FAILED( "WRONG ALTERN. C4" );
+               WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. C5" );
+               WHEN  OTHERS            =>  NULL ;
+          END CASE;
+
+          CASE  DYNCON  IS
+               WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. D1" );
+               WHEN  'B'               =>  FAILED( "WRONG ALTERN. D2" );
+               WHEN  'P'               =>  FAILED( "WRONG ALTERN. D3" );
+               WHEN  'Y'               =>  NULL ;
+               WHEN  'Z' .. ASCII.DEL  =>  FAILED( "WRONG ALTERN. D5" );
+               WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. D6" );
+          END CASE;
+
+          CASE  DYNVAR  IS
+               WHEN  ASCII.NUL .. 'A'  =>  FAILED( "WRONG ALTERN. E1" );
+               WHEN  'B'               =>  FAILED( "WRONG ALTERN. E2" );
+               WHEN  'P'               =>  FAILED( "WRONG ALTERN. E3" );
+               WHEN  'Y'               =>  FAILED( "WRONG ALTERN. E4" );
+               WHEN  'Z' .. ASCII.DEL  =>  NULL ;
+               WHEN  OTHERS            =>  FAILED( "WRONG ALTERN. E6" );
+          END CASE;
+
+     END ;
+
+
+     DECLARE
+
+          NUMBER  : CONSTANT           := -100 ;
+          LITEXPR : CONSTANT           := 0 * NUMBER  + 16 ;
+          STATCON : CONSTANT INTEGER   := +100 ;
+          DYNVAR  :          INTEGER   := IDENT_INT( 102 ) ;
+          DYNCON  : CONSTANT INTEGER   := IDENT_INT(  17 ) ;
+
+     BEGIN
+
+          CASE  INTEGER'(-102)  IS
+               WHEN  INTEGER'FIRST..-101 => NULL ;
+               WHEN  -100                => FAILED("WRONG ALTERN. F2");
+               WHEN  17                  => FAILED("WRONG ALTERN. F2");
+               WHEN  100                 => FAILED("WRONG ALTERN. F4");
+               WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. F5");
+               WHEN  OTHERS              => FAILED("WRONG ALTERN. F6");
+          END CASE;
+
+          CASE  IDENT_INT(NUMBER)  IS
+               WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. G1");
+               WHEN  -100                => NULL ;
+               WHEN  17                  => FAILED("WRONG ALTERN. G3");
+               WHEN  100                 => FAILED("WRONG ALTERN. G4");
+               WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. G5");
+               WHEN  OTHERS              => FAILED("WRONG ALTERN. G6");
+          END CASE;
+
+          CASE  IDENT_INT(LITEXPR)  IS
+               WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. H1");
+               WHEN  -100                => FAILED("WRONG ALTERN. H2");
+               WHEN  17                  => FAILED("WRONG ALTERN. H3");
+               WHEN  100                 => FAILED("WRONG ALTERN. H4");
+               WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. H5");
+               WHEN  OTHERS              => NULL ;
+          END CASE;
+
+          CASE  STATCON  IS
+               WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. I1");
+               WHEN  -100                => FAILED("WRONG ALTERN. I2");
+               WHEN  17                  => FAILED("WRONG ALTERN. I3");
+               WHEN  100                 => NULL ;
+               WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. I5");
+               WHEN  OTHERS              => FAILED("WRONG ALTERN. I6");
+          END CASE;
+
+          CASE  DYNVAR   IS
+               WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. J1");
+               WHEN  -100                => FAILED("WRONG ALTERN. J2");
+               WHEN  17                  => FAILED("WRONG ALTERN. J3");
+               WHEN  100                 => FAILED("WRONG ALTERN. J4");
+               WHEN  101..INTEGER'LAST   => NULL ;
+               WHEN  OTHERS              => FAILED("WRONG ALTERN. J6");
+          END CASE;
+
+          CASE  DYNCON  IS
+               WHEN  INTEGER'FIRST..-101 => FAILED("WRONG ALTERN. K1");
+               WHEN  -100                => FAILED("WRONG ALTERN. K2");
+               WHEN  17                  => NULL ;
+               WHEN  100                 => FAILED("WRONG ALTERN. K4");
+               WHEN  101..INTEGER'LAST   => FAILED("WRONG ALTERN. K5");
+               WHEN  OTHERS              => FAILED("WRONG ALTERN. K6");
+          END CASE;
+     END ;
+
+
+     RESULT ;
+
+
+END  C54A42A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42b.ada
new file mode 100644
index 000000000..bcf1dcc90
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42b.ada
@@ -0,0 +1,173 @@
+-- C54A42B.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  CASE_STATEMENT CORRECTLY HANDLES A SMALL RANGE OF
+--    POTENTIAL VALUES GROUPED INTO A SMALL NUMBER OF ALTERNATIVES.
+
+-- (OPTIMIZATION TEST -- JUMP TABLE.)
+
+
+-- RM 03/26/81
+-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+
+
+WITH REPORT;
+PROCEDURE  C54A42B  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C54A42B" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
+                       " A SMALL NUMBER OF POTENTIAL VALUES GROUPED"   &
+                       " INTO A SMALL NUMBER OF ALTERNATIVES" );
+
+     DECLARE
+
+          STATCON : CONSTANT CHARACTER RANGE 'A'..'K' := 'J' ;
+          STATVAR :          CHARACTER RANGE 'A'..'K' := 'A' ;
+          DYNCON  : CONSTANT CHARACTER RANGE 'A'..'K' :=IDENT_CHAR('K');
+          DYNVAR  :          CHARACTER RANGE 'A'..'K' :=IDENT_CHAR('G');
+
+     BEGIN
+
+          CASE  STATVAR  IS
+               WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE A1" );
+               WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE A2" );
+               WHEN  'F'            => FAILED( "WRONG ALTERNATIVE A3" );
+               WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE A4" );
+               WHEN  'G'            => FAILED( "WRONG ALTERNATIVE A5" );
+               WHEN  OTHERS         => NULL ;
+          END CASE;
+
+          CASE  CHARACTER'('B')  IS
+               WHEN  'B' | 'E'      => NULL ;
+               WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE B2" );
+               WHEN  'F'            => FAILED( "WRONG ALTERNATIVE B3" );
+               WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE B4" );
+               WHEN  'G'            => FAILED( "WRONG ALTERNATIVE B5" );
+               WHEN  OTHERS         => FAILED( "WRONG ALTERNATIVE B6" );
+          END CASE;
+
+          CASE  DYNVAR   IS
+               WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE C1" );
+               WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE C2" );
+               WHEN  'F'            => FAILED( "WRONG ALTERNATIVE C3" );
+               WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE C4" );
+               WHEN  'G'            => NULL ;
+               WHEN  OTHERS         => FAILED( "WRONG ALTERNATIVE C6" );
+          END CASE;
+
+          CASE  IDENT_CHAR(STATCON)  IS
+               WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE D1" );
+               WHEN  'J' | 'C'      => NULL ;
+               WHEN  'F'            => FAILED( "WRONG ALTERNATIVE D3" );
+               WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE D4" );
+               WHEN  'G'            => FAILED( "WRONG ALTERNATIVE D5" );
+               WHEN  OTHERS         => FAILED( "WRONG ALTERNATIVE D6" );
+          END CASE;
+
+          CASE  DYNCON   IS
+               WHEN  'B' | 'E'      => FAILED( "WRONG ALTERNATIVE E1" );
+               WHEN  'J' | 'C'      => FAILED( "WRONG ALTERNATIVE E2" );
+               WHEN  'F'            => FAILED( "WRONG ALTERNATIVE E3" );
+               WHEN  'D' | 'H'..'I' => FAILED( "WRONG ALTERNATIVE E4" );
+               WHEN  'G'            => FAILED( "WRONG ALTERNATIVE E5" );
+               WHEN  OTHERS         => NULL ;
+          END CASE;
+
+     END ;
+
+
+     DECLARE
+
+          NUMBER  : CONSTANT                      := 1 ;
+          LITEXPR : CONSTANT                      := NUMBER + 5 ;
+          STATCON : CONSTANT INTEGER RANGE 0..10  := 9 ;
+          DYNVAR  :          INTEGER RANGE 0..10  := IDENT_INT( 10 );
+          DYNCON  : CONSTANT INTEGER RANGE 0..10  := IDENT_INT(  2 );
+
+     BEGIN
+
+          CASE  INTEGER'(0)  IS
+               WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE F1");
+               WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE F2");
+               WHEN  5               =>  FAILED("WRONG ALTERNATIVE F3");
+               WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE F4");
+               WHEN  6               =>  FAILED("WRONG ALTERNATIVE F5");
+               WHEN  OTHERS          =>  NULL ;
+          END CASE;
+
+          CASE  INTEGER'(NUMBER)   IS
+               WHEN  1 | 4           =>  NULL ;
+               WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE G2");
+               WHEN  5               =>  FAILED("WRONG ALTERNATIVE G3");
+               WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE G4");
+               WHEN  6               =>  FAILED("WRONG ALTERNATIVE G5");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE G6");
+          END CASE;
+
+          CASE  IDENT_INT(LITEXPR)  IS
+               WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE H1");
+               WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE H2");
+               WHEN  5               =>  FAILED("WRONG ALTERNATIVE H3");
+               WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE H4");
+               WHEN  6               =>  NULL ;
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE H6");
+          END CASE;
+
+          CASE  STATCON  IS
+               WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE I1");
+               WHEN  9 | 2           =>  NULL ;
+               WHEN  5               =>  FAILED("WRONG ALTERNATIVE I3");
+               WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE I4");
+               WHEN  6               =>  FAILED("WRONG ALTERNATIVE I5");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE I6");
+          END CASE;
+
+          CASE  DYNVAR   IS
+               WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE J1");
+               WHEN  9 | 2           =>  FAILED("WRONG ALTERNATIVE J2");
+               WHEN  5               =>  FAILED("WRONG ALTERNATIVE J3");
+               WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE J4");
+               WHEN  6               =>  FAILED("WRONG ALTERNATIVE J5");
+               WHEN  OTHERS          =>  NULL ;
+          END CASE;
+
+          CASE  DYNCON  IS
+               WHEN  1 | 4           =>  FAILED("WRONG ALTERNATIVE K1");
+               WHEN  9 | 2           =>  NULL ;
+               WHEN  5               =>  FAILED("WRONG ALTERNATIVE K3");
+               WHEN  3 | 7..8        =>  FAILED("WRONG ALTERNATIVE K4");
+               WHEN  6               =>  FAILED("WRONG ALTERNATIVE K5");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE K6");
+          END CASE;
+
+     END ;
+
+
+     RESULT ;
+
+
+END  C54A42B ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42c.ada
new file mode 100644
index 000000000..79a397976
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42c.ada
@@ -0,0 +1,123 @@
+-- C54A42C.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  CASE_STATEMENT  CORRECTLY HANDLES A SPARSE SET OF
+--    POTENTIAL VALUES (OF TYPE INTEGER) IN A LARGE RANGE.
+
+--    (OPTIMIZATION TEST)
+
+
+-- RM 03/26/81
+
+
+WITH REPORT;
+PROCEDURE  C54A42C  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C54A42C" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
+                       " A SPARSE SET OF POTENTIAL VALUES IN A LARGE"  &
+                       " RANGE" );
+
+     DECLARE
+
+          NUMBER  : CONSTANT                           := 1001 ;
+          LITEXPR : CONSTANT                           := NUMBER + 998 ;
+          STATCON : CONSTANT INTEGER RANGE  1..INTEGER'LAST :=    1000 ;
+          DYNVAR  :          INTEGER RANGE  1..INTEGER'LAST :=
+                                           IDENT_INT( INTEGER'LAST-50 );
+          DYNCON  : CONSTANT INTEGER RANGE  1..INTEGER'LAST :=
+                                           IDENT_INT( 1000 );
+
+     BEGIN
+
+          CASE  INTEGER'( NUMBER )  IS
+               WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE F1");
+               WHEN  1000            =>  FAILED("WRONG ALTERNATIVE F2");
+               WHEN  2000            =>  FAILED("WRONG ALTERNATIVE F3");
+               WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE F4");
+               WHEN  INTEGER'LAST-100 ..
+                     INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE F5");
+               WHEN  OTHERS          =>  NULL ;
+          END CASE;
+
+          CASE  IDENT_INT( 10 )  IS
+               WHEN  1 .. 10         =>  NULL ;
+               WHEN  1000            =>  FAILED("WRONG ALTERNATIVE G2");
+               WHEN  2000            =>  FAILED("WRONG ALTERNATIVE G3");
+               WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE G4");
+               WHEN  INTEGER'LAST -100 ..
+                     INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE G5");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE G6");
+          END CASE;
+
+          CASE  IDENT_INT(LITEXPR)  IS
+               WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE H1");
+               WHEN  1000            =>  FAILED("WRONG ALTERNATIVE H2");
+               WHEN  2000            =>  FAILED("WRONG ALTERNATIVE H3");
+               WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE H4");
+               WHEN  INTEGER'LAST -100 ..
+                     INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE H5");
+               WHEN  OTHERS          =>  NULL ;
+          END CASE;
+
+          CASE  STATCON  IS
+               WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE I1");
+               WHEN  1000            =>  NULL ;
+               WHEN  2000            =>  FAILED("WRONG ALTERNATIVE I3");
+               WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE I4");
+               WHEN  INTEGER'LAST -100 ..
+                     INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE I5");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE I6");
+          END CASE;
+
+          CASE  DYNVAR   IS
+               WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE J1");
+               WHEN  1000            =>  FAILED("WRONG ALTERNATIVE J2");
+               WHEN  2000            =>  FAILED("WRONG ALTERNATIVE J3");
+               WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE J4");
+               WHEN  INTEGER'LAST -100 ..
+                     INTEGER'LAST    =>  NULL ;
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE J6");
+          END CASE;
+
+          CASE  DYNCON  IS
+               WHEN  1 .. 10         =>  FAILED("WRONG ALTERNATIVE K1");
+               WHEN  1000            =>  NULL ;
+               WHEN  2000            =>  FAILED("WRONG ALTERNATIVE K3");
+               WHEN  4000 .. 4100    =>  FAILED("WRONG ALTERNATIVE K4");
+               WHEN  INTEGER'LAST -100 ..
+                     INTEGER'LAST    =>  FAILED("WRONG ALTERNATIVE K5");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE K6");
+          END CASE;
+
+     END ;
+
+
+     RESULT ;
+
+
+END  C54A42C ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42d.ada
new file mode 100644
index 000000000..9394f5c56
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42d.ada
@@ -0,0 +1,104 @@
+-- C54A42D.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  CASE_STATEMENT CORRECTLY HANDLES A FEW ALTERNATIVES
+--    COVERING A LARGE RANGE OF INTEGERS.
+
+
+-- (OPTIMIZATION TEST.)
+
+
+-- RM 03/30/81
+
+
+WITH REPORT;
+PROCEDURE  C54A42D  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C54A42D" , "TEST THAT A  CASE_STATEMENT CORRECTLY HANDLES" &
+                       " A FEW ALTERNATIVES COVERING A LARGE RANGE" &
+                       " OF INTEGERS" );
+
+     DECLARE
+
+          NUMBER  : CONSTANT          := 2000 ;
+          LITEXPR : CONSTANT          := NUMBER + 2000 ;
+          STATCON : CONSTANT INTEGER  := 2001 ;
+          DYNVAR  :          INTEGER  := IDENT_INT( 0 );
+          DYNCON  : CONSTANT INTEGER  := IDENT_INT( 1 );
+
+     BEGIN
+
+          CASE  INTEGER'(-4000)  IS
+               WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE F1");
+               WHEN  INTEGER'FIRST..0=>  NULL ;
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE F3");
+               WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE F4");
+          END CASE;
+
+          CASE  INTEGER'(NUMBER)   IS
+               WHEN  1..2000         =>  NULL ;
+               WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE G2");
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE G3");
+               WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE G4");
+          END CASE;
+
+          CASE  IDENT_INT(LITEXPR)  IS
+               WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE H1");
+               WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE H2");
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE H3");
+               WHEN  2002..INTEGER'LAST=>NULL ;
+          END CASE;
+
+          CASE  STATCON  IS
+               WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE I1");
+               WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE I2");
+               WHEN  2001            =>  NULL ;
+               WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE I4");
+          END CASE;
+
+          CASE  DYNVAR   IS
+               WHEN  1..2000         =>  FAILED("WRONG ALTERNATIVE J1");
+               WHEN  INTEGER'FIRST..0=>  NULL ;
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE J3");
+               WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE J4");
+          END CASE;
+
+          CASE  DYNCON   IS
+               WHEN  1..2000         =>  NULL ;
+               WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE K2");
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE K3");
+               WHEN  2002..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE K4");
+          END CASE;
+
+     END ;
+
+
+     RESULT ;
+
+
+END  C54A42D ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42e.ada
new file mode 100644
index 000000000..fb2216407
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42e.ada
@@ -0,0 +1,125 @@
+-- C54A42E.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  CASE_STATEMENT  CORRECTLY HANDLES A SMALL RANGE OF
+--    POTENTIAL VALUES OF TYPE INTEGER, SITUATED FAR FROM  0  AND
+--    GROUPED INTO A SMALL NUMBER OF ALTERNATIVES.
+
+-- (OPTIMIZATION TEST -- BIASED JUMP TABLE.)
+
+
+-- RM 03/26/81
+
+
+WITH REPORT;
+PROCEDURE  C54A42E  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C54A42E" , "TEST THAT A  CASE_STATEMENT HANDLES CORRECTLY" &
+                       " A SMALL, FAR RANGE OF POTENTIAL VALUES OF" &
+                       " TYPE INTEGER" );
+
+     DECLARE
+
+          NUMBER  : CONSTANT                           := 4001 ;
+          LITEXPR : CONSTANT                           := NUMBER + 5 ;
+          STATCON : CONSTANT INTEGER RANGE 4000..4010  := 4009 ;
+          DYNVAR  :          INTEGER RANGE 4000..4010  :=
+                                                      IDENT_INT( 4010 );
+          DYNCON  : CONSTANT INTEGER RANGE 4000..4010  :=
+                                                      IDENT_INT( 4002 );
+
+     BEGIN
+
+          CASE  INTEGER'(4000)  IS
+               WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE F1");
+               WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE F2");
+               WHEN  4005            =>  FAILED("WRONG ALTERNATIVE F3");
+               WHEN  4003 |
+                     4007..4008      =>  FAILED("WRONG ALTERNATIVE F4");
+               WHEN  4006            =>  FAILED("WRONG ALTERNATIVE F5");
+               WHEN  OTHERS          =>  NULL ;
+          END CASE;
+
+          CASE  IDENT_INT(NUMBER)  IS
+               WHEN  4001 | 4004     =>  NULL ;
+               WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE G2");
+               WHEN  4005            =>  FAILED("WRONG ALTERNATIVE G3");
+               WHEN  4003 |
+                     4007..4008      =>  FAILED("WRONG ALTERNATIVE G4");
+               WHEN  4006            =>  FAILED("WRONG ALTERNATIVE G5");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE G6");
+          END CASE;
+
+          CASE  IDENT_INT(LITEXPR)  IS
+               WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE H1");
+               WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE H2");
+               WHEN  4005            =>  FAILED("WRONG ALTERNATIVE H3");
+               WHEN  4003 |
+                     4007..4008      =>  FAILED("WRONG ALTERNATIVE H4");
+               WHEN  4006            =>  NULL ;
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE H6");
+          END CASE;
+
+          CASE  STATCON  IS
+               WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE I1");
+               WHEN  4009 | 4002     =>  NULL ;
+               WHEN  4005            =>  FAILED("WRONG ALTERNATIVE I3");
+               WHEN  4003 |
+                     4007..4008      =>  FAILED("WRONG ALTERNATIVE I4");
+               WHEN  4006            =>  FAILED("WRONG ALTERNATIVE I5");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE I6");
+          END CASE;
+
+          CASE  DYNVAR   IS
+               WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE J1");
+               WHEN  4009 | 4002     =>  FAILED("WRONG ALTERNATIVE J2");
+               WHEN  4005            =>  FAILED("WRONG ALTERNATIVE J3");
+               WHEN  4003 |
+                     4007..4008      =>  FAILED("WRONG ALTERNATIVE J4");
+               WHEN  4006            =>  FAILED("WRONG ALTERNATIVE J5");
+               WHEN  OTHERS          =>  NULL ;
+
+          END CASE;
+
+          CASE  DYNCON  IS
+               WHEN  4001 | 4004     =>  FAILED("WRONG ALTERNATIVE K1");
+               WHEN  4009 | 4002     =>  NULL ;
+               WHEN  4005            =>  FAILED("WRONG ALTERNATIVE K3");
+               WHEN  4003 |
+                     4007..4008      =>  FAILED("WRONG ALTERNATIVE K4");
+               WHEN  4006            =>  FAILED("WRONG ALTERNATIVE K5");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE K6");
+          END CASE;
+
+     END ;
+
+
+     RESULT ;
+
+
+END  C54A42E ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42f.ada
new file mode 100644
index 000000000..c321ce8c8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42f.ada
@@ -0,0 +1,126 @@
+-- C54A42F.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  CASE_STATEMENT CORRECTLY HANDLES SEVERAL SMALL,
+--    NON-CONTIGUOUS RANGES OF INTEGERS COVERED BY A SINGLE  'OTHERS'
+--    ALTERNATIVE.
+
+
+-- (OPTIMIZATION TEST.)
+
+
+-- RM 03/31/81
+
+
+WITH REPORT;
+PROCEDURE  C54A42F  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C54A42F" , "TEST THAT A  CASE_STATEMENT CORRECTLY HANDLES" &
+                       " SEVERAL SMALL, NON-CONTIGUOUS ENUMERATION"    &
+                       " RANGES COVERED BY A SINGLE  'OTHERS'  "       &
+                       " ALTERNATIVE"  );
+
+     DECLARE
+
+          TYPE  DAY  IS (SUN , MON , TUE , WED , THU , FRI ,  SAT );
+
+          DYNVAR2 :          DAY  := MON ;
+          STATVAR :          DAY  := TUE ;
+          STATCON : CONSTANT DAY  := WED ;
+          DYNVAR  :          DAY  := THU ;
+          DYNCON  : CONSTANT DAY  :=     DAY'VAL( IDENT_INT(5) ); -- FRI
+
+     BEGIN
+
+          IF EQUAL(1,289) THEN
+               DYNVAR  := SUN ;
+               DYNVAR2 := SUN ;
+          END IF;
+
+          CASE  SUN  IS        --  SUN
+               WHEN  THU       =>  FAILED("WRONG ALTERNATIVE F1");
+               WHEN  SUN       =>  NULL ;
+               WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE F3");
+               WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE F4");
+               WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE F5");
+          END CASE;
+
+          CASE  DYNVAR2   IS   --  MON
+               WHEN  THU       =>  FAILED("WRONG ALTERNATIVE G1");
+               WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE G2");
+               WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE G3");
+               WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE G4");
+               WHEN  OTHERS    =>  NULL ;
+          END CASE;
+
+          CASE  STATVAR  IS    --  TUE
+               WHEN  THU       =>  FAILED("WRONG ALTERNATIVE H1");
+               WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE H2");
+               WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE H3");
+               WHEN  TUE..WED  =>  NULL ;
+               WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE H5");
+          END CASE;
+
+          CASE  STATCON  IS    --  WED
+               WHEN  THU       =>  FAILED("WRONG ALTERNATIVE I1");
+               WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE I2");
+               WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE I3");
+               WHEN  TUE..WED  =>  NULL ;
+               WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE I5");
+          END CASE;
+
+          CASE  DYNVAR   IS    --  THU
+               WHEN  THU       =>  NULL ;
+               WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE J2");
+               WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE J3");
+               WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE J4");
+               WHEN  OTHERS    =>  FAILED("WRONG ALTERNATIVE J5");
+          END CASE;
+
+          CASE  DYNCON   IS    --  FRI
+               WHEN  THU       =>  FAILED("WRONG ALTERNATIVE K1");
+               WHEN  SUN       =>  FAILED("WRONG ALTERNATIVE K2");
+               WHEN  SAT       =>  FAILED("WRONG ALTERNATIVE K3");
+               WHEN  TUE..WED  =>  FAILED("WRONG ALTERNATIVE K4");
+               WHEN  OTHERS    =>  NULL ;
+          END CASE;
+
+          CASE  DAY'SUCC( DYNCON )  IS   --  SAT
+               WHEN THU       =>  FAILED("WRONG ALTERNATIVE L1");
+               WHEN SUN       =>  FAILED("WRONG ALTERNATIVE L2");
+               WHEN SAT       =>  NULL ;
+               WHEN TUE..WED  =>  FAILED("WRONG ALTERNATIVE L4");
+               WHEN OTHERS    =>  FAILED("WRONG ALTERNATIVE L5");
+          END CASE;
+     END ;
+
+
+     RESULT ;
+
+
+END  C54A42F ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42g.ada
new file mode 100644
index 000000000..ebe44f387
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c54a42g.ada
@@ -0,0 +1,119 @@
+-- C54A42G.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  CASE_STATEMENT CORRECTLY HANDLES SEVERAL NON-CONTIGUOUS
+--    RANGES OF INTEGERS COVERED BY A SINGLE  'OTHERS'  ALTERNATIVE.
+
+
+-- (OPTIMIZATION TEST.)
+
+
+-- RM 03/30/81
+
+
+WITH REPORT;
+PROCEDURE  C54A42G  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C54A42G" , "TEST THAT A  CASE_STATEMENT CORRECTLY HANDLES" &
+                       " SEVERAL NON-CONTIGUOUS RANGES OF INTEGERS"    &
+                       " COVERED BY A SINGLE  'OTHERS'  ALTERNATIVE"  );
+
+     DECLARE
+
+          NUMBER  : CONSTANT          := 2000 ;
+          LITEXPR : CONSTANT          := NUMBER + 2000 ;
+          STATCON : CONSTANT INTEGER  := 2002 ;
+          DYNVAR  :          INTEGER  := IDENT_INT( 0 );
+          DYNCON  : CONSTANT INTEGER  := IDENT_INT( 1 );
+
+     BEGIN
+
+          CASE  INTEGER'(-4000)  IS
+               WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE F1");
+               WHEN  INTEGER'FIRST..0=>  NULL ;
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE F3");
+               WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE F4");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE F5");
+          END CASE;
+
+          CASE  IDENT_INT(NUMBER)   IS
+               WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE G1");
+               WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE G2");
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE G3");
+               WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE G4");
+               WHEN  OTHERS          =>  NULL ;
+          END CASE;
+
+          CASE  IDENT_INT(LITEXPR)  IS
+               WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE H1");
+               WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE H2");
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE H3");
+               WHEN  2100..INTEGER'LAST=>NULL ;
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE H5");
+          END CASE;
+
+          CASE  IDENT_INT(STATCON)  IS
+               WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE I1");
+               WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE I2");
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE I3");
+               WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE I4");
+               WHEN  OTHERS          =>  NULL ;
+          END CASE;
+
+          CASE  DYNVAR   IS
+               WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE J1");
+               WHEN  INTEGER'FIRST..0=>  NULL ;
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE J3");
+               WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE J4");
+               WHEN  OTHERS          =>  FAILED("WRONG ALTERNATIVE J5");
+          END CASE;
+
+          CASE  DYNCON   IS
+               WHEN  100..1999       =>  FAILED("WRONG ALTERNATIVE K1");
+               WHEN  INTEGER'FIRST..0=>  FAILED("WRONG ALTERNATIVE K2");
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE K3");
+               WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE K4");
+               WHEN  OTHERS          =>  NULL ;
+          END CASE;
+
+          CASE  IDENT_INT( -3900 )  IS
+               WHEN  -3000..1999     =>  FAILED("WRONG ALTERNATIVE X1");
+               WHEN  INTEGER'FIRST..
+                           -4000     =>  FAILED("WRONG ALTERNATIVE X2");
+               WHEN  2001            =>  FAILED("WRONG ALTERNATIVE X3");
+               WHEN  2100..INTEGER'LAST=>FAILED("WRONG ALTERNATIVE X4");
+               WHEN  OTHERS          =>  NULL ;
+          END CASE;
+
+     END ;
+
+
+     RESULT ;
+
+
+END  C54A42G ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b03a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b03a.ada
new file mode 100644
index 000000000..ddcadcef8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b03a.ada
@@ -0,0 +1,59 @@
+-- C55B03A.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 LOOP_PARAMETER IS ASSIGNED VALUES IN ASCENDING ORDER 
+--   IF REVERSE IS ABSENT, AND DESCENDING ORDER IF REVERSE IS PRESENT.
+
+-- DAS 1/12/81
+-- SPS 3/2/83
+
+WITH REPORT;
+PROCEDURE C55B03A IS
+
+     USE REPORT;
+     I1 : INTEGER;
+
+BEGIN
+     TEST( "C55B03A" , "CHECK CORRECT ORDER OF VALUE SEQUENCING" & 
+           " FOR A LOOP_PARAMETER" );
+
+     I1 := 0;
+     FOR I IN IDENT_INT(1)..IDENT_INT(5) LOOP
+          I1 := I1 + 1;
+          IF ( I /= I1 ) THEN
+               FAILED ( "LOOP_PARAMETER ASCENDING INCORRECTLY" );
+          END IF;
+     END LOOP;
+
+     I1 := 6;
+     FOR I IN REVERSE IDENT_INT(1)..IDENT_INT(5) LOOP
+          I1 := I1 - 1;
+          IF ( I /= I1 ) THEN
+               FAILED ( "LOOP_PARAMETER DESCENDING INCORRECTLY" );
+          END IF;
+     END LOOP;
+
+     RESULT;
+
+END C55B03A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b04a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b04a.ada
new file mode 100644
index 000000000..748f192e8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b04a.ada
@@ -0,0 +1,96 @@
+--  C55B04A.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 LOOP IS NOT ENTERED IF THE LOWER BOUND OF THE DISCRETE
+--   RANGE IS GREATER THAN THE UPPER BOUND, WHETHER REVERSE IS PRESENT
+--   OR NOT.
+
+-- CHECK THAT LOOP BOUNDS ARE EVALUATED ONLY ONCE, UPON ENTRY TO 
+--   THE LOOP.
+
+-- DAS  01/12/81
+-- SPS 3/2/83
+-- JBG 8/21/83
+
+WITH REPORT;
+PROCEDURE C55B04A IS
+
+     USE REPORT;
+
+     C10 : CONSTANT INTEGER := 10;
+     I10 : INTEGER;
+
+BEGIN
+     TEST ( "C55B04A", "CHECK OPERATION OF A FOR LOOP OVER A NULL " & 
+                       "DISCRETE RANGE" );
+
+     -- NOTE: EXIT STATEMENTS ARE INCLUDED TO AID IN RECOVERY FROM
+     --   TEST FAILURE.
+
+     -- SUBTESTS INVOLVING STATIC BOUNDS:
+
+     FOR I IN 10..1 LOOP
+          FAILED ( "LOOPING OVER NULL RANGE 10..1" );
+          EXIT;
+     END LOOP;
+
+     FOR I IN REVERSE INTEGER RANGE -1..-10 LOOP
+          FAILED ( "LOOPING OVER NULL RANGE -1..-10" );
+          EXIT;
+     END LOOP;
+
+     FOR I IN (C10 + 3)..(-3 * C10 + 27) LOOP     -- 13..-3
+          FAILED ("LOOPING OVER NULL RANGE (C10 + 3)..(-3 * C10 + 27)");
+          EXIT;
+     END LOOP;
+
+
+     -- SUBTESTS INVOLVING DYNAMIC BOUNDS:
+
+     I10 := IDENT_INT(10);
+
+     FOR I IN REVERSE I10..(I10-1) LOOP           -- 10..9
+          FAILED ( "LOOPING OVER NULL RANGE I10..(I10-1)");
+          EXIT;
+     END LOOP;
+
+
+     FOR I IN (C10 - I10)..(I10 - 11) LOOP        -- 0..-1
+          FAILED ( "LOOPING OVER NULL RANGE (C10 - I10)..(I10 - 11)" );
+          EXIT;
+     END LOOP;
+
+
+     -- SUBTEST OF BOUNDS EVALUTION ONLY AT ENTRY:
+
+     FOR I IN 1..I10 LOOP
+          I10 := I10 - 1;
+     END LOOP;
+     IF (I10 /= 0) THEN
+          FAILED ( "LOOP BOUNDS NOT FIXED AT LOOP ENTRY" );
+     END IF;
+
+     RESULT;
+
+END C55B04A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b05a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b05a.ada
new file mode 100644
index 000000000..20e8ff438
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b05a.ada
@@ -0,0 +1,170 @@
+-- C55B05A.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 LOOPS WITH BOUNDS INTEGER'LAST OR
+-- INTEGER'FIRST DO NOT RAISE INVALID EXCEPTIONS.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- DAT 3/26/81
+-- SPS 3/2/83
+-- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C55B05A IS
+BEGIN
+     TEST ("C55B05A", "LOOPS WITH INTEGER'FIRST AND 'LAST AS BOUNDS");
+
+     DECLARE
+
+          COUNT : INTEGER := 0;
+
+          PROCEDURE C IS
+          BEGIN
+               COUNT := COUNT + 1;
+          END C;
+
+     BEGIN
+          FOR I IN INTEGER'LAST .. INTEGER'FIRST LOOP
+               FAILED ("WRONG NULL RANGE LOOP EXECUTION");
+               EXIT;
+          END LOOP;
+          FOR I IN INTEGER'FIRST .. INTEGER'FIRST LOOP
+               C;
+          END LOOP;
+          FOR I IN INTEGER'FIRST .. INTEGER'FIRST + 2 LOOP
+               C; C;
+          END LOOP;
+          FOR I IN INTEGER'FIRST + 1 .. INTEGER'FIRST LOOP
+               FAILED ("NULL RANGE ERROR 2");
+               EXIT;
+          END LOOP;
+          FOR I IN INTEGER'FIRST .. INTEGER'LAST LOOP
+               C;
+               EXIT;
+          END LOOP;
+          FOR I IN INTEGER LOOP
+               C;
+               EXIT;
+          END LOOP;
+          FOR I IN INTEGER'LAST - 2 .. INTEGER'LAST LOOP
+               C; C; C;
+          END LOOP;
+          FOR I IN INTEGER'LAST - 2 .. INTEGER'LAST - 1 LOOP
+               C;
+          END LOOP;
+          FOR I IN 0 .. INTEGER'FIRST LOOP
+               FAILED ("NULL LOOP ERROR 3");
+               EXIT;
+          END LOOP;
+          FOR I IN -1 .. INTEGER'FIRST LOOP
+               FAILED ("NULL LOOP ERROR 4");
+               EXIT;
+          END LOOP;
+          FOR I IN -3 .. IDENT_INT(0) LOOP
+               FOR J IN INTEGER'FIRST .. INTEGER'FIRST - I LOOP
+                    C; C; C; C;
+               END LOOP;
+               FOR J IN INTEGER'FIRST - I .. INTEGER'FIRST + 3 - I LOOP
+                    C; C; C; C;
+               END LOOP;
+               FOR J IN INTEGER'LAST - 3 .. INTEGER'LAST + I LOOP
+                    C; C; C; C;
+               END LOOP;
+               FOR J IN INTEGER'LAST + I .. INTEGER'LAST LOOP
+                    C; C; C; C;
+               END LOOP;
+          END LOOP;
+
+          FOR I IN REVERSE INTEGER'LAST .. INTEGER'FIRST LOOP
+               FAILED ("REVERSE WRONG NULL RANGE LOOP EXECUTION");
+               EXIT;
+          END LOOP;
+          FOR I IN REVERSE INTEGER'FIRST .. INTEGER'FIRST LOOP
+               C;
+          END LOOP;
+          FOR I IN REVERSE INTEGER'FIRST .. INTEGER'FIRST + 2 LOOP
+               C; C;
+          END LOOP;
+          FOR I IN REVERSE INTEGER'FIRST + 1 .. INTEGER'FIRST LOOP
+               FAILED ("NULL RANGE ERROR 8");
+               EXIT;
+          END LOOP;
+          FOR I IN REVERSE INTEGER'FIRST .. INTEGER'LAST LOOP
+               C;
+               EXIT;
+          END LOOP;
+          FOR I IN REVERSE INTEGER LOOP
+               C;
+               EXIT;
+          END LOOP;
+          FOR I IN REVERSE INTEGER'LAST - 2 .. INTEGER'LAST LOOP
+               C; C; C;
+          END LOOP;
+          FOR I IN REVERSE INTEGER'LAST - 2 .. INTEGER'LAST - 1 LOOP
+               C;
+          END LOOP;
+          FOR I IN REVERSE 0 .. INTEGER'FIRST LOOP
+               FAILED ("NULL LOOP ERROR 9");
+               EXIT;
+          END LOOP;
+          FOR I IN REVERSE -1 .. INTEGER'FIRST LOOP
+               FAILED ("NULL LOOP ERROR 7");
+               EXIT;
+          END LOOP;
+          FOR I IN REVERSE -3 .. IDENT_INT(0) LOOP
+               FOR J IN REVERSE INTEGER'FIRST .. INTEGER'FIRST - I LOOP
+                    C; C; C; C;
+               END LOOP;
+               FOR J IN REVERSE INTEGER'FIRST - I
+                    .. INTEGER'FIRST + 3 - I
+               LOOP
+                    C; C; C; C;
+               END LOOP;
+               FOR J IN REVERSE INTEGER'LAST - 3 .. INTEGER'LAST + I
+               LOOP
+                    C; C; C; C;
+               END LOOP;
+               FOR J IN REVERSE INTEGER'LAST + I .. INTEGER'LAST LOOP
+                    C; C; C; C;
+               END LOOP;
+          END LOOP;
+
+          IF COUNT /= 408 THEN
+               FAILED ("WRONG LOOP EXECUTION COUNT");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED INCORRECTLY");
+          WHEN OTHERS =>
+               FAILED ("UNKNOWN EXCEPTION RAISED INCORRECTLY");
+     END;
+
+     RESULT;
+END C55B05A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b06a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b06a.ada
new file mode 100644
index 000000000..524de24f7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b06a.ada
@@ -0,0 +1,313 @@
+-- C55B06A.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 LOOPS MAY BE SPECIFIED FOR BOOLEAN, INTEGER,
+-- CHARACTER, ENUMERATION, AND DERIVED TYPES, INCLUDING
+-- TYPES DERIVED FROM DERIVED TYPES. DERIVED BOOLEAN IS NOT
+-- TESTED IN THIS TEST.
+
+-- DAT 3/26/81
+-- JBG 9/29/82
+-- SPS 3/11/83
+-- JBG 10/5/83
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C55B06A IS
+
+     TYPE ENUM IS ('A', 'B', 'D', 'C', Z, X, D, A, C);
+
+     TYPE D1 IS NEW CHARACTER RANGE 'A' .. 'Z';
+     TYPE D2 IS NEW INTEGER;
+     TYPE D3 IS NEW ENUM;
+     TYPE D4 IS NEW D1;
+     TYPE D5 IS NEW D2;
+     TYPE D6 IS NEW D3;
+
+     ONE : INTEGER := IDENT_INT(1);
+     COUNT : INTEGER := 0;
+     OLDCOUNT : INTEGER := 0;
+
+     PROCEDURE Q IS
+     BEGIN
+          COUNT := COUNT + ONE;
+     END Q;
+
+BEGIN
+     TEST ("C55B06A", "TEST LOOPS FOR ALL DISCRETE TYPES");
+
+     FOR I IN BOOLEAN LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+          FAILED ("LOOP 1");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN FALSE .. TRUE LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+          FAILED ("LOOP 2");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN BOOLEAN RANGE FALSE .. TRUE LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+          FAILED ("LOOP 3");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN INTEGER LOOP
+          Q;
+          EXIT WHEN I = INTEGER'FIRST + 2;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
+          FAILED ("LOOP 4");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN 3 .. IDENT_INT (5) LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
+          FAILED ("LOOP 5");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN INTEGER RANGE -2 .. -1 LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+          FAILED ("LOOP 6");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN INTEGER RANGE INTEGER'FIRST .. INTEGER'FIRST + 1 LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+          FAILED ("LOOP 7");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN 'A' .. CHARACTER'('Z') LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
+          FAILED ("LOOP 9");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN CHARACTER RANGE 'A' .. 'D' LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(4) /= COUNT THEN
+          FAILED ("LOOP 10");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN ENUM LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(9) /= COUNT THEN
+          FAILED ("LOOP 11");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN ENUM RANGE D .. C LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
+          FAILED ("LOOP 12");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN 'A' .. ENUM'(Z) LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+          FAILED ("LOOP 13");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D1 LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
+          FAILED ("LOOP 14");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D1 RANGE 'A' .. 'Z' LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
+          FAILED ("LOOP 15");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D1'('A') .. 'D' LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(4) /= COUNT THEN
+          FAILED ("LOOP 16");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D2 LOOP
+          Q;
+          IF I > D2'FIRST + 3 THEN
+               EXIT;
+          END IF;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+          FAILED ("LOOP 17");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D2 RANGE -100 .. -99 LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+          FAILED ("LOOP 18");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D2'(1) .. 2 LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+          FAILED ("LOOP 19");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D3 LOOP
+          IF I IN 'A' .. 'C' THEN
+               Q;        -- 4
+          ELSE
+               Q; Q;     -- 10
+          END IF;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(14) /= COUNT THEN
+          FAILED ("LOOP 20");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D3 RANGE 'A' .. Z LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+          FAILED ("LOOP 21");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN 'A' .. D3'(Z) LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+          FAILED ("LOOP 22");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D4 LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
+          FAILED ("LOOP 23");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D4'('A') .. 'Z' LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(26) /= COUNT THEN
+          FAILED ("LOOP 24");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR I IN D4 RANGE 'B' .. 'D' LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(3) /= COUNT THEN
+          FAILED ("LOOP 25");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR J IN D5 LOOP
+          Q;        -- 4
+          EXIT WHEN J = D5(INTEGER'FIRST) + 3;
+          Q;        -- 3
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(7) /= COUNT THEN
+          FAILED ("LOOP 26");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR J IN D5 RANGE -2 .. -1 LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(2) /= COUNT THEN
+          FAILED ("LOOP 27");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR  J IN D5'(-10) .. D5'(-6) LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+          FAILED ("LOOP 28");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR J IN D6 LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(9) /= COUNT THEN
+          FAILED ("LOOP 29");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR J IN D6 RANGE Z .. A LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(4) /= COUNT THEN
+          FAILED ("LOOP 30");
+     END IF;
+     OLDCOUNT := COUNT;
+
+     FOR J IN D6'('D') .. D LOOP
+          Q;
+     END LOOP;
+     IF OLDCOUNT + IDENT_INT(5) /= COUNT THEN
+          FAILED ("LOOP 31");
+     END IF;
+     OLDCOUNT := COUNT;
+
+
+     RESULT;
+END C55B06A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b06b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b06b.ada
new file mode 100644
index 000000000..4bff008dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b06b.ada
@@ -0,0 +1,188 @@
+-- C55B06B.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 LOOPS MAY BE SPECIFIED FOR DERIVED BOOLEAN AND
+-- DERIVED DERIVED BOOLEAN.
+
+-- DAT 3/26/81
+-- SPS 3/2/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C55B06B IS
+
+     TYPE E IS (FALSE, TRUE);
+     TYPE B1 IS NEW BOOLEAN;
+     TYPE B2 IS NEW B1;
+     TYPE B3 IS NEW E;
+
+     ONE : INTEGER := IDENT_INT (1);
+     COUNT : INTEGER := 0;
+     OLD_COUNT : INTEGER := 0;
+
+     PROCEDURE Q IS
+     BEGIN
+          COUNT := COUNT + 1;
+     END Q;
+
+BEGIN
+     TEST ("C55B06B", "LOOPS OVER DERIVED BOOLEAN");
+
+     FOR I IN BOOLEAN LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 1");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN BOOLEAN RANGE FALSE .. TRUE LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 2");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN BOOLEAN'(FALSE) .. TRUE LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 3");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN E LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 4");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN E RANGE FALSE .. TRUE LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 5");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN FALSE .. E'(TRUE) LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 6");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN B1 LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 7");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN B1 RANGE FALSE .. TRUE LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 8");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN FALSE .. B1'(TRUE) LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 9");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN B2 LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 10");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN B2 RANGE FALSE .. TRUE LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 11");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN B2'(FALSE) .. TRUE LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 12");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN B3 LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 13");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN B3 RANGE FALSE .. TRUE LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 14");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     FOR I IN FALSE .. B3'(TRUE) LOOP
+          Q;
+     END LOOP;
+     IF OLD_COUNT + IDENT_INT (2) /= COUNT THEN
+          FAILED ("LOOP 15");
+     ELSE
+          OLD_COUNT := COUNT;
+     END IF;
+
+     RESULT;
+ END C55B06B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b07a.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b07a.dep
new file mode 100644
index 000000000..22c2ce491
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b07a.dep
@@ -0,0 +1,126 @@
+-- C55B07A.DEP
+
+--                             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 LOOPS OVER RANGES OF TYPE LONG_INTEGER
+--     CAN BE WRITTEN.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     THE TYPE LONG_INTEGER.
+--
+--     IF THE TYPE LONG_INTEGER IS NOT SUPPORTED, THEN THE
+--     DECLARATION OF CHECK MUST BE REJECTED.
+
+-- HISTORY:
+--     RM  07/06/82  CREATED ORIGINAL TEST.
+--     BCB 01/04/88  MODIFIED HEADER.
+
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C55B07A IS
+
+     CHECK : LONG_INTEGER;                             -- N/A => ERROR.
+
+     TYPE  NEW_LONG_INTEGER  IS  NEW LONG_INTEGER ;
+
+     THE_COUNT : INTEGER := 777 ;   -- JUST A DUMMY...
+
+     LI_VAR   :           LONG_INTEGER      :=  1 ;
+     LI_CON   :  CONSTANT LONG_INTEGER      :=  1 ;
+
+     NLI_VAR  :           NEW_LONG_INTEGER  :=  1 ;
+     NLI_CON  :  CONSTANT NEW_LONG_INTEGER  :=  1 ;
+
+     SUBTYPE   LI_SEGMENT  IS  LONG_INTEGER RANGE
+                               LONG_INTEGER'LAST..LONG_INTEGER'LAST ;
+
+     SUBTYPE  NLI_SEGMENT  IS  NEW_LONG_INTEGER RANGE
+                               NEW_LONG_INTEGER'FIRST..
+                               NEW_LONG_INTEGER'FIRST ;
+
+     COUNT : INTEGER := 0;
+
+     PROCEDURE  BUMP ( DUMMY : INTEGER )  IS
+     BEGIN
+          COUNT := COUNT + 1;
+     END  BUMP;
+
+BEGIN
+
+     TEST ( "C55B07A" , "LOOPS OVER RANGES OF TYPE  LONG_INTEGER " );
+
+     FOR  I  IN  1..LI_CON  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  NLI_VAR..1  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  1..LONG_INTEGER(1)  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  1..NEW_LONG_INTEGER(1)  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  LI_SEGMENT  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  REVERSE NLI_SEGMENT  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  LONG_INTEGER RANGE 1..1  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  NEW_LONG_INTEGER RANGE 1..1  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  LONG_INTEGER LOOP
+          BUMP(THE_COUNT) ;
+          EXIT WHEN  I = LONG_INTEGER'FIRST + 1;
+     END LOOP;
+
+     FOR  I  IN  NEW_LONG_INTEGER LOOP
+          BUMP(THE_COUNT) ;
+          EXIT WHEN  I = NEW_LONG_INTEGER'FIRST + 1;
+     END LOOP;
+
+
+     IF  COUNT /= 12  THEN
+          FAILED ("WRONG LOOP COUNT");
+     END IF;
+
+
+     RESULT;
+
+
+END  C55B07A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b07b.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b07b.dep
new file mode 100644
index 000000000..17c0c6b04
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b07b.dep
@@ -0,0 +1,126 @@
+-- C55B07B.DEP
+
+--                             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 LOOPS OVER RANGES OF TYPE SHORT_INTEGER
+--     CAN BE WRITTEN.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     THE TYPE SHORT_INTEGER.
+--
+--     IF THE TYPE SHORT_INTEGER IS NOT SUPPORTED, THEN THE
+--     DECLARATION OF CHECK MUST BE REJECTED.
+
+-- HISTORY:
+--     RM  07/08/82  CREATED ORIGINAL TEST.
+--     BCB 01/04/88  MODIFIED HEADER.
+
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C55B07B IS
+
+     CHECK : SHORT_INTEGER;                            -- N/A => ERROR.
+
+     TYPE  NEW_SHORT_INTEGER  IS  NEW SHORT_INTEGER ;
+
+     THE_COUNT : INTEGER := 777 ;   -- JUST A DUMMY...
+
+     SI_VAR   :           SHORT_INTEGER      :=  1 ;
+     SI_CON   :  CONSTANT SHORT_INTEGER      :=  1 ;
+
+     NSI_VAR  :           NEW_SHORT_INTEGER  :=  1 ;
+     NSI_CON  :  CONSTANT NEW_SHORT_INTEGER  :=  1 ;
+
+     SUBTYPE   SI_SEGMENT  IS  SHORT_INTEGER RANGE
+                               SHORT_INTEGER'LAST..SHORT_INTEGER'LAST ;
+
+     SUBTYPE  NSI_SEGMENT  IS  NEW_SHORT_INTEGER RANGE
+                               NEW_SHORT_INTEGER'FIRST..
+                               NEW_SHORT_INTEGER'FIRST ;
+
+     COUNT : INTEGER := 0;
+
+     PROCEDURE  BUMP ( DUMMY : INTEGER )  IS
+     BEGIN
+          COUNT := COUNT + 1;
+     END  BUMP;
+
+BEGIN
+
+     TEST ( "C55B07B" , "LOOPS OVER RANGES OF TYPE  SHORT_INTEGER " );
+
+     FOR  I  IN  1..SI_CON  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  NSI_VAR..1  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  1..SHORT_INTEGER(1)  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  1..NEW_SHORT_INTEGER(1)  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  SI_SEGMENT  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  REVERSE NSI_SEGMENT  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  SHORT_INTEGER RANGE 1..1  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  NEW_SHORT_INTEGER RANGE 1..1  LOOP
+          BUMP(THE_COUNT) ;
+     END LOOP;
+
+     FOR  I  IN  SHORT_INTEGER LOOP
+          BUMP(THE_COUNT) ;
+          EXIT WHEN  I = SHORT_INTEGER'FIRST + 1;
+     END LOOP;
+
+     FOR  I  IN  NEW_SHORT_INTEGER LOOP
+          BUMP(THE_COUNT) ;
+          EXIT WHEN  I = NEW_SHORT_INTEGER'FIRST + 1;
+     END LOOP;
+
+
+     IF  COUNT /= 12  THEN
+          FAILED ("WRONG LOOP COUNT");
+     END IF;
+
+
+     RESULT;
+
+
+END  C55B07B ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b10a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b10a.ada
new file mode 100644
index 000000000..46773d46d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b10a.ada
@@ -0,0 +1,80 @@
+-- C55B10A.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 'FOR I IN L .. R LOOP', IF EITHER L OR R IS AN
+--     OVERLOADED ENUMERATION LITERAL, THE OVERLOADING IS CORRECTLY
+--     RESOLVED AND THE LOOP PARAMETER HAS THE APPROPRIATE TYPE.
+
+-- HISTORY:
+--     DHH 08/15/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C55B10A IS
+
+     TYPE ENUM IS (ALPH, BET, NEITHER);
+
+     GLOBAL : ENUM := NEITHER;
+
+     TYPE ALPHA IS (A, B, C, D, E);
+     TYPE BETA IS (G, F, E, D, C);
+
+     PROCEDURE VAR(DEC : ALPHA) IS
+     BEGIN
+          IF EQUAL(3, 3) THEN
+               GLOBAL := ALPH;
+          END IF;
+     END;
+
+     PROCEDURE VAR(DEC : BETA) IS
+     BEGIN
+          IF EQUAL(3, 3) THEN
+               GLOBAL := BET;
+          END IF;
+     END;
+
+BEGIN
+     TEST("C55B10A", "CHECK THAT, IN 'FOR I IN L .. R LOOP', IF " &
+                     "EITHER L OR R IS AN OVERLOADED ENUMERATION " &
+                     "LITERAL, THE OVERLOADING IS CORRECTLY RESOLVED " &
+                     "AND THE LOOP PARAMETER HAS THE APPROPRIATE TYPE");
+
+     FOR I IN A .. E LOOP
+          VAR(I);
+
+          IF GLOBAL /= ALPH THEN
+               FAILED("WRONG TYPE FOR ALPHA");
+          END IF;
+     END LOOP;
+
+     FOR I IN G .. E LOOP
+          VAR(I);
+
+          IF GLOBAL /= BET THEN
+               FAILED("WRONG TYPE FOR BETA");
+          END IF;
+     END LOOP;
+
+     RESULT;
+END C55B10A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b11a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b11a.ada
new file mode 100644
index 000000000..4dae09714
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b11a.ada
@@ -0,0 +1,104 @@
+-- C55B11A.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 'FOR IN ST RANGE L .. R LOOP', THE PARAMETER IS OF
+--     THE TYPE ST'BASE; THAT IS THAT IT CAN BE ASSIGNED TO OTHER
+--     VARIABLES DECLARED WITH SOME OTHER SUBTYPES OF ST.
+
+-- HISTORY:
+--     DHH 08/15/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C55B11A IS
+
+     TYPE ENUM IS (A, B, C, D, E, F, G, H);
+
+     SUBTYPE ONE IS ENUM RANGE A .. H;
+     SUBTYPE TWO IS ENUM RANGE B .. H;
+     SUBTYPE THREE IS ENUM RANGE C .. H;
+     SUBTYPE FOUR IS ENUM RANGE D .. H;
+
+     GLOBAL : INTEGER := 0;
+
+     VAR_1 : ONE;
+     VAR_2 : TWO;
+     VAR_3 : THREE;
+     VAR_4 : FOUR;
+
+     PROCEDURE CHECK_VAR(T : ENUM) IS
+     BEGIN
+          GLOBAL := GLOBAL + 1;
+          CASE T IS
+               WHEN D =>
+                    IF GLOBAL /= IDENT_INT(1) THEN
+                         FAILED("VAR_1 WRONG VALUE");
+                    END IF;
+
+               WHEN E =>
+                    IF GLOBAL /= IDENT_INT(2) THEN
+                         FAILED("VAR_2 WRONG VALUE");
+                    END IF;
+
+               WHEN F =>
+                    IF GLOBAL /= IDENT_INT(3) THEN
+                         FAILED("VAR_3 WRONG VALUE");
+                    END IF;
+
+               WHEN G =>
+                    IF GLOBAL /= IDENT_INT(4) THEN
+                         FAILED("VAR_4 WRONG VALUE");
+                    END IF;
+
+               WHEN OTHERS =>
+
+                   FAILED("WRONG VALUE TO PROCEDURE");
+          END CASE;
+     END CHECK_VAR;
+
+BEGIN
+     TEST("C55B11A", "CHECK THAT, IN 'FOR IN ST RANGE L .. R LOOP', " &
+                     "THE PARAMETER IS OF THE TYPE ST'BASE; THAT IS " &
+                     "THAT IT CAN BE ASSIGNED TO OTHER VARIABLES " &
+                     "DECLARED WITH SOME OTHER SUBTYPES OF ST");
+
+     FOR I IN ONE RANGE D .. G LOOP
+          CASE I IS
+               WHEN D =>
+                    VAR_1 := I;
+                    CHECK_VAR(VAR_1);
+               WHEN E =>
+                    VAR_2 := I;
+                    CHECK_VAR(VAR_2);
+               WHEN F =>
+                    VAR_3 := I;
+                    CHECK_VAR(VAR_3);
+               WHEN G =>
+                    VAR_4 := I;
+                    CHECK_VAR(VAR_4);
+          END CASE;
+     END LOOP;
+
+     RESULT;
+END C55B11A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b11b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b11b.ada
new file mode 100644
index 000000000..3d1b48846
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b11b.ada
@@ -0,0 +1,86 @@
+-- C55B11B.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 FORM 'FOR I IN ST RANGE L .. R LOOP' IS ACCEPTED
+--     EVEN IF BOTH L AND R ARE OVERLOADED ENUMERATION LITERALS (SO
+--     THAT L .. R WOULD BE ILLEGAL WITHOUT ST RANGE).
+
+-- HISTORY:
+--     DHH 09/07/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C55B11B IS
+     TYPE ST IS (A, B, C, D, E, F, G, H);
+     TYPE SI IS (A, B, C, D, F, E, G, H);
+
+     GLOBAL : INTEGER := 0;
+
+     PROCEDURE CHECK_VAR(T : ST) IS
+     BEGIN
+          GLOBAL := GLOBAL + 1;
+          CASE T IS
+               WHEN D =>
+                    IF GLOBAL /= IDENT_INT(1) THEN
+                         FAILED("1 WRONG VALUE");
+                    END IF;
+
+               WHEN E =>
+                    IF GLOBAL /= IDENT_INT(2) THEN
+                         FAILED("2 WRONG VALUE");
+                    END IF;
+
+               WHEN F =>
+                    IF GLOBAL /= IDENT_INT(3) THEN
+                         FAILED("3 WRONG VALUE");
+                    END IF;
+
+               WHEN G =>
+                    IF GLOBAL /= IDENT_INT(4) THEN
+                         FAILED("4 WRONG VALUE");
+                    END IF;
+
+               WHEN OTHERS =>
+                   FAILED("WRONG VALUE TO PROCEDURE");
+
+          END CASE;
+     END CHECK_VAR;
+
+     PROCEDURE CHECK_VAR(T : SI) IS
+     BEGIN
+          FAILED("WRONG PROCEDURE CALLED");
+     END CHECK_VAR;
+
+BEGIN
+     TEST ("C55B11B", "CHECK THAT THE 'FORM FOR I IN ST RANGE L .. R " &
+                      "LOOP' IS ACCEPTED EVEN IF BOTH L AND R ARE " &
+                      "OVERLOADED ENUMERATION LITERALS (SO THAT L .. " &
+                      "R WOULD BE ILLEGAL WITHOUT ST RANGE)");
+
+     FOR I IN ST RANGE D .. G LOOP
+          CHECK_VAR(I);
+     END LOOP;
+
+     RESULT;
+END C55B11B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b15a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b15a.ada
new file mode 100644
index 000000000..a04941962
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b15a.ada
@@ -0,0 +1,207 @@
+-- C55B15A.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 DISCRETE_RANGE OF THE FORM  'ST RANGE L..R'
+--    RAISES AN EXCEPTION BECAUSE  L  OR  R  IS A NON-STATIC
+--    EXPRESSION WHOSE VALUE IS OUTSIDE  THE RANGE OF VALUES
+--    ASSOCIATED WITH  ST  (OR BECAUSE  ST'FIRST  IS NON-STATIC
+--    AND  L  IS STATIC AND LESS THAN  ST'FIRST ; SIMILARLY FOR
+--     ST'LAST  AND  R ), CONTROL DOES NOT ENTER THE LOOP.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- RM  04/13/81
+-- SPS 11/01/82
+-- BHS 07/13/84
+-- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+--               AI-00387.
+-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+-- GJD 11/15/95  REMOVED CASE OF POTENTIALLY STATICALLY INCOMPATIBLE RANGE.
+
+WITH SYSTEM;
+WITH REPORT;
+PROCEDURE  C55B15A  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C55B15A" , "WHEN  'FOR  I  IN  ST RANGE L..R  LOOP' "     &
+                       "RAISES AN EXCEPTION, CONTROL DOES NOT ENTER " &
+                       "THE BODY OF THE LOOP" );
+
+     -------------------------------------------------------------------
+     ----------------- STATIC (SUB)TYPE, DYNAMIC RANGE -----------------
+
+     DECLARE
+
+          SUBTYPE  ST  IS  INTEGER RANGE 1..4 ;
+
+          FIRST   :  CONSTANT INTEGER := IDENT_INT( 1) ;
+          SECOND  :  CONSTANT INTEGER := IDENT_INT( 2) ;
+          THIRD   :  CONSTANT INTEGER := IDENT_INT( 3) ;
+          FOURTH  :  CONSTANT INTEGER := IDENT_INT( 4) ;
+          FIFTH   :  CONSTANT INTEGER := IDENT_INT( 5) ;
+          TENTH   :  CONSTANT INTEGER := IDENT_INT(10) ;
+          ZEROTH  :  CONSTANT INTEGER := IDENT_INT( 0) ;
+
+     BEGIN
+
+          BEGIN
+
+               FOR  I  IN  ST RANGE 3..TENTH  LOOP
+                    FAILED( "EXCEPTION NOT RAISED (I1)" );
+               END LOOP;
+
+          EXCEPTION
+
+               WHEN  CONSTRAINT_ERROR => NULL ;
+               WHEN  OTHERS           =>
+                    FAILED( "WRONG EXCEPTION RAISED (I1)" );
+
+          END ;
+
+
+          BEGIN
+
+               FOR  I  IN  ST RANGE 0..THIRD  LOOP
+                    FAILED( "EXCEPTION NOT RAISED (I2)" );
+               END LOOP;
+
+          EXCEPTION
+
+               WHEN  CONSTRAINT_ERROR => NULL ;
+               WHEN  OTHERS           =>
+                    FAILED( "WRONG EXCEPTION RAISED (I2)" );
+
+          END ;
+     END ;
+
+
+     -------------------------------------------------------------------
+     ----------------- DYNAMIC (SUB)TYPE, STATIC RANGE -----------------
+
+     DECLARE
+
+          TYPE  ENUM   IS  ( AMINUS , A,B,C,D,E,  F,G,H,I,J );
+
+          SUBTYPE  ST  IS  ENUM RANGE ENUM'VAL( IDENT_INT( 1) ) ..
+                                      ENUM'VAL( IDENT_INT( 4) ) ;
+
+          FIRST   :  CONSTANT ENUM := A ;
+          SECOND  :  CONSTANT ENUM := B ;
+          THIRD   :  CONSTANT ENUM := C ;
+          FOURTH  :  CONSTANT ENUM := D ;
+          FIFTH   :  CONSTANT ENUM := E ;
+          TENTH   :  CONSTANT ENUM := J ;
+          ZEROTH  :  CONSTANT ENUM := AMINUS ;
+
+     BEGIN
+
+          BEGIN
+
+               FOR  I  IN  ST RANGE C..TENTH  LOOP
+                    FAILED( "EXCEPTION NOT RAISED (E1)" );
+               END LOOP;
+
+          EXCEPTION
+
+               WHEN  CONSTRAINT_ERROR => NULL ;
+               WHEN  OTHERS           =>
+                    FAILED( "WRONG EXCEPTION RAISED (E1)" );
+
+          END ;
+
+
+          BEGIN
+
+               FOR  I  IN  ST RANGE AMINUS..THIRD  LOOP
+                    FAILED( "EXCEPTION NOT RAISED (E2)" );
+               END LOOP;
+
+          EXCEPTION
+
+               WHEN  CONSTRAINT_ERROR => NULL ;
+               WHEN  OTHERS           =>
+                    FAILED( "WRONG EXCEPTION RAISED (E2)" );
+
+          END ;
+
+     END ;
+
+
+     DECLARE
+
+          SUBTYPE  ST  IS  CHARACTER RANGE IDENT_CHAR( 'A' ) ..
+                                           IDENT_CHAR( 'D' ) ;
+
+          FIRST   :  CONSTANT CHARACTER := 'A' ;
+          SECOND  :  CONSTANT CHARACTER := 'B' ;
+          THIRD   :  CONSTANT CHARACTER := 'C' ;
+          FOURTH  :  CONSTANT CHARACTER := 'D' ;
+          FIFTH   :  CONSTANT CHARACTER := 'E' ;
+          TENTH   :  CONSTANT CHARACTER := 'J' ;
+          ZEROTH  :  CONSTANT CHARACTER := '0' ;--ZERO; PRECEDES LETTERS
+
+     BEGIN
+
+          BEGIN
+
+               FOR  I  IN  ST RANGE 'C'..TENTH  LOOP
+                    FAILED( "EXCEPTION NOT RAISED (C1)" );
+               END LOOP;
+
+          EXCEPTION
+
+               WHEN  CONSTRAINT_ERROR => NULL ;
+               WHEN  OTHERS           =>
+                    FAILED( "WRONG EXCEPTION RAISED (C1)" );
+
+          END ;
+
+
+          BEGIN
+
+               FOR  I  IN  ST RANGE '0'..THIRD  LOOP -- ZERO..'C'
+                    FAILED( "EXCEPTION NOT RAISED (C2)" );
+               END LOOP;
+
+          EXCEPTION
+
+               WHEN  CONSTRAINT_ERROR => NULL ;
+               WHEN  OTHERS           =>
+                    FAILED( "WRONG EXCEPTION RAISED (C2)" );
+
+          END ;
+
+     END ;
+
+
+     RESULT ;
+
+
+END  C55B15A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b16a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b16a.ada
new file mode 100644
index 000000000..c6bf2b8f1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55b16a.ada
@@ -0,0 +1,101 @@
+-- C55B16A.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 THE PROCESSING OF ITERATIONS OVER AN ENUMERATION TYPE
+--     WHOSE (USER-DEFINED) REPRESENTATION CONSISTS OF A NON-CONTIGUOUS
+--     SET OF INTEGERS.
+--
+--     (INHERITANCE (AND SUBSEQUENT OVERRIDING) OF REPRESENTATION
+--     SPECIFICATIONS WILL BE TESTED ELSEWHERE.)
+
+-- HISTORY:
+--     RM  08/06/82  CREATED ORIGINAL TEST.
+--     BCB 01/04/88  MODIFIED HEADER.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE  C55B16A  IS
+
+     I1  :  INTEGER := 0 ;
+
+     TYPE  ENUM  IS  ( 'A' , 'B' , 'D' , 'C' , Z , X , D , A , C );
+     FOR   ENUM  USE ( -15 , -14 , -11 , -10 ,
+                         1 , 3 , 4 , 8 , 9 );
+
+BEGIN
+
+     TEST ("C55B16A" , "TEST LOOPING OVER ENUMERATION TYPES WITH"  &
+                       " NON-CONTIGUOUS REPRESENTATION"            );
+
+     I1 := IDENT_INT(0) ;
+
+     FOR  X  IN ENUM LOOP
+
+          IF  X /= ENUM'VAL(I1)  OR
+              ENUM'POS(X) /= I1                               -- 0..8
+          THEN
+               FAILED ( "LOOP_PARAMETER ASCENDING INCORRECTLY (1)" );
+          END IF;
+
+          I1 := I1 + IDENT_INT(1) ;
+
+     END LOOP;
+
+
+     I1 := IDENT_INT(6) ;
+
+     FOR  X  IN ENUM RANGE D .. C LOOP
+
+          IF  X /= ENUM'VAL(I1)  OR
+              ENUM'POS(X) /= I1                               -- 6..8
+          THEN
+               FAILED ( "LOOP_PARAMETER ASCENDING INCORRECTLY (2)" );
+          END IF;
+
+          I1 := I1 + IDENT_INT(1) ;
+
+     END LOOP;
+
+
+     I1 := IDENT_INT(4) ;
+
+     FOR  X  IN REVERSE 'A'..ENUM'(Z) LOOP
+
+          IF  X /= ENUM'VAL(I1)  OR
+              ENUM'POS(X) /= I1                               -- 4..0
+          THEN
+               FAILED ( "LOOP_PARAMETER DESCENDING INCORRECTLY (3)" );
+          END IF;
+
+          I1 := I1 - IDENT_INT(1) ;
+
+     END LOOP;
+
+
+     RESULT ;
+
+
+END  C55B16A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55c02a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55c02a.ada
new file mode 100644
index 000000000..c320edbb2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55c02a.ada
@@ -0,0 +1,49 @@
+-- C55C02A.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 WHILE LOOPS WITH FALSE CONDITIONS ARE NEVER EXECUTED.
+
+-- DAT 1/29/81
+-- DLD 8/06/82
+
+WITH REPORT;
+PROCEDURE C55C02A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C55C02A", "INITIAL FALSE CONDITIONS IN WHILE LOOPS");
+
+     WHILE FALSE LOOP
+          FAILED ("STATIC FALSE WHILE LOOP ENTERED");
+          EXIT;
+     END LOOP;
+
+     WHILE IDENT_BOOL (FALSE) LOOP
+          FAILED ("DYNAMIC FALSE WHILE LOOP ENTERED");
+          EXIT;
+     END LOOP;
+
+     RESULT;
+END C55C02A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55c02b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55c02b.ada
new file mode 100644
index 000000000..c344838c6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c55c02b.ada
@@ -0,0 +1,59 @@
+-- C55C02B.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 WHILE CONDITION IS EVALUATED EACH TIME.
+
+-- DAT 1/29/81
+-- SPS 3/2/83
+
+WITH REPORT;
+PROCEDURE C55C02B IS
+
+     USE REPORT;
+
+     I : INTEGER := 0;
+
+     FT : ARRAY (FALSE .. TRUE) OF BOOLEAN 
+          := (IDENT_BOOL (FALSE), IDENT_BOOL (TRUE));
+
+BEGIN
+     TEST ("C55C02B", "WHILE CONDITION IS EVALUATED EACH TIME THROUGH");
+
+     WHILE I /= 10 LOOP
+          I := I + 1;
+     END LOOP;
+     IF I /= 10 THEN
+          FAILED ("BAD LOOP FLOW - OPTIMIZABLE CONDITION");
+     END IF;
+
+     I := 10;
+     WHILE FT (IDENT_BOOL (I /= 14)) LOOP
+          I := I + 1;
+     END LOOP;
+     IF I /= 14 THEN
+          FAILED ("BAD LOOP FLOW - DYNAMIC CONDITION");
+     END IF;
+
+     RESULT;
+END C55C02B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c56002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c56002a.ada
new file mode 100644
index 000000000..ff368e363
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c56002a.ada
@@ -0,0 +1,148 @@
+-- C56002A.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 BLOCKS CAN HAVE DECLARATIVE PARTS AND THAT
+--    THE EFFECT OF THESE DECLARATIONS IS LIMITED TO THE BLOCKS
+--    IN WHICH THEY OCCUR.
+
+
+-- RM 04/16/81
+-- SPS 3/4/83
+
+WITH REPORT;
+PROCEDURE  C56002A  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C56002A" , "BLOCKS CAN HAVE DECLARATIVE PARTS AND"         &
+                       " THE EFFECT OF THESE DECLARATIONS IS LIMITED"  &
+                       " TO THE BLOCKS IN WHICH THEY OCCUR" )          ;
+
+     DECLARE
+
+          FIRST   :  CONSTANT INTEGER := IDENT_INT( 1) ;
+          SECOND  :  CONSTANT INTEGER := IDENT_INT( 2) ;
+          THIRD   :  CONSTANT INTEGER := IDENT_INT( 3) ;
+          FOURTH  :  CONSTANT INTEGER := IDENT_INT( 4) ;
+          FIFTH   :  CONSTANT INTEGER := IDENT_INT( 5) ;
+          TENTH   :  CONSTANT INTEGER := IDENT_INT(10) ;
+          ZEROTH  :  CONSTANT INTEGER := IDENT_INT( 0) ;
+
+     BEGIN
+
+          IF   FIRST   /= 1  OR
+               SECOND  /= 2  OR
+               THIRD   /= 3  OR
+               FOURTH  /= 4  OR
+               FIFTH   /= 5  OR
+               TENTH   /=10  OR
+               ZEROTH  /= 0
+          THEN
+               FAILED( "WRONG VALUES  -  1" );
+          END IF;
+
+          DECLARE
+
+               TYPE  ENUM   IS  ( AMINUS , A,B,C,D,E,  F,G,H,I,J );
+
+               FIRST   :  CONSTANT ENUM := A ;
+               SECOND  :  CONSTANT ENUM := B ;
+               THIRD   :  CONSTANT ENUM := C ;
+               FOURTH  :  CONSTANT ENUM := D ;
+               FIFTH   :  CONSTANT ENUM := E ;
+               TENTH   :  CONSTANT ENUM := J ;
+               ZEROTH  :  CONSTANT ENUM := AMINUS ;
+
+          BEGIN
+
+               IF   FIRST   /= ENUM'VAL( IDENT_INT( 1 ) )  OR
+                    SECOND  /= ENUM'VAL( IDENT_INT( 2 ) )  OR
+                    THIRD   /= ENUM'VAL( IDENT_INT( 3 ) )  OR
+                    FOURTH  /= ENUM'VAL( IDENT_INT( 4 ) )  OR
+                    FIFTH   /= ENUM'VAL( IDENT_INT( 5 ) )  OR
+                    TENTH   /= ENUM'VAL( IDENT_INT(10 ) )  OR
+                    ZEROTH  /= ENUM'VAL( IDENT_INT( 0 ) )
+               THEN
+                    FAILED( "WRONG VALUES  -  2" );
+               END IF;
+
+          END ;
+
+          IF   FIRST   /= 1  OR
+               SECOND  /= 2  OR
+               THIRD   /= 3  OR
+               FOURTH  /= 4  OR
+               FIFTH   /= 5  OR
+               TENTH   /=10  OR
+               ZEROTH  /= 0
+          THEN
+               FAILED( "WRONG VALUES  -  3" );
+          END IF;
+
+          DECLARE
+
+               FIRST   :  CONSTANT CHARACTER := 'A' ;
+               SECOND  :  CONSTANT CHARACTER := 'B' ;
+               THIRD   :  CONSTANT CHARACTER := 'C' ;
+               FOURTH  :  CONSTANT CHARACTER := 'D' ;
+               FIFTH   :  CONSTANT CHARACTER := 'E' ;
+               TENTH   :  CONSTANT CHARACTER := 'J' ;
+               ZEROTH  :  CONSTANT CHARACTER := '0' ;--ZERO < ANY LETTER
+
+          BEGIN
+
+               IF   FIRST   /= IDENT_CHAR( 'A' )  OR
+                    SECOND  /= IDENT_CHAR( 'B' )  OR
+                    THIRD   /= IDENT_CHAR( 'C' )  OR
+                    FOURTH  /= IDENT_CHAR( 'D' )  OR
+                    FIFTH   /= IDENT_CHAR( 'E' )  OR
+                    TENTH   /= IDENT_CHAR( 'J' )  OR
+                    ZEROTH  /= IDENT_CHAR( '0' )
+               THEN
+                    FAILED( "WRONG VALUES  -  4" );
+               END IF;
+
+          END ;
+
+          IF   FIRST   /= 1  OR
+               SECOND  /= 2  OR
+               THIRD   /= 3  OR
+               FOURTH  /= 4  OR
+               FIFTH   /= 5  OR
+               TENTH   /=10  OR
+               ZEROTH  /= 0
+          THEN
+               FAILED( "WRONG VALUES  -  5" );
+          END IF;
+
+
+     END ;
+
+
+     RESULT ;
+
+
+END  C56002A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c57003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c57003a.ada
new file mode 100644
index 000000000..8ca95e52e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c57003a.ada
@@ -0,0 +1,334 @@
+-- C57003A.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 EXIT STATEMENT IS EVALUATED EACH TIME THROUGH A LOOP,
+--    AND THAT IT IS EVALUATED CORRECTLY WHETHER POSITIONED AT THE
+--    BEGINNING, MIDDLE, OR END OF THE LOOP.
+
+
+
+-- EACH TEST IS A LOOP ON  J  WHERE THE EXIT CONDITIONS ARE TO EVALUATE
+--    TO  'FALSE'  A CERTAIN NUMBER OF TIMES UNTIL, AT THE APPROPRIATE
+--    TIME, ONE OF THEM EVALUATES TO  'TRUE'  AND CAUSES THE LOOP TO BE
+--    EXITED.
+--
+--
+--    THE TEST IS PERFORMED 30 TIMES FOR EACH OF THE FIRST TWO
+--    DATA TYPES CONSIDERED ('INTEGER', USER-DEFINED ENUMERATION)
+--    AND 26 TIMES FOR 'CHARACTER' (THUS 86 TIMES ALTOGETHER).
+--
+--
+--    EACH DATA TYPE HAS ITS OWN SEPARATE SECTION OF CODE.  ALL SECTIONS
+--    FOLLOW THE SAME TESTING ALGORITHM (MUTATIS MUTANDIS).  THE CALCU-
+--    LATIONS WHICH KEEP TRACK OF THE FLOW OF CONTROL ARE ALL DONE IN
+--    INTEGER ARITHMETIC.  THERE ARE THREE DATA TYPES, THUS THREE
+--    SECTIONS.
+--
+--
+--    FOR EACH DATA TYPE, THE 30 TESTS ARE DIVIDED INTO 3 "SEGMENTS"
+--
+--               << NOTE:  THE NUMBER OF SEGMENTS IS WRITTEN  " 3 "    ,
+--                         THE NUMBER OF SECTIONS IS WRITTEN  "THREE" >>
+--
+--    (OF 10 TESTS EACH, EXCEPT 10,10,6 FOR 'CHARACTER'), NUMBERED
+--     0 , 1 , 2  AND CORRESPONDING TO THE 3 SIGNIFICANTLY DIFFERENT
+--    POSITIONS OF AN EXIT STATEMENT WITH RESPECT TO THE LOOP IT IS IN
+--    ( "AT THE VERY TOP" , "AT THE VERY BOTTOM" , "ANYWHERE IN BETWEEN"
+--    ).  AT THE BEGINNING OF EACH TEST, THE VARIABLE  WHICH_SEGMENT
+--    IS UPDATED TO CONTAIN THE NEW VALUE OF THIS IDENTIFYING NUMBER
+--    (FOR THE TEST ABOUT TO BEGIN):
+--
+--             EXIT AT THE TOP      ........   WHICH_SEGMENT = 0
+--             EXIT FROM THE MIDDLE ........   WHICH_SEGMENT = 1
+--             EXIT AT THE BOTTOM   ........   WHICH_SEGMENT = 2   .
+--
+--
+--    WITHIN EACH SECTION, THE TESTS ARE NUMBERED  FROM  1  TO  30
+--    (26 FOR 'CHARACTER').  THIS NUMBER IS STORED IN THE INTEGER
+--    VARIABLE  INT_I  (EQUAL TO THE CURRENT VALUE OF THE OUTER-LOOP
+--    INDEX WHEN THAT INDEX IS OF INTEGER TYPE), WHOSE APPROPRIATE VALUE
+--    FOR EACH TEST IS SET AT THE BEGINNING OF THE TEST.
+--
+--
+--    AS PART OF THE EVALUATION PROCESS, THE PROGRAM COMPUTES FOR EACH
+--    TEST (I.E.  FOR EACH VALUE OF  I , OR OF  INT_I ) THE APPROPRIATE
+--    NUMBER OF INNER-LOOP ITERATIONS REQUIRED BEFORE EXIT; THIS IS
+--    THE EXPECTED VALUE OF  J  (EXPRESSED AS AN INTEGER IN THE RANGE
+--     1..10 ) AND STORES IT IN  EXPECTED_J .  FOR EACH OF THE THREE
+--    SECTIONS, THE TIME SEQUENCE OF THESE 30 VALUES IS
+--
+--             1   2   3   4   5   6   7   8   9  10     << SEGMENT 1 >>
+--             6   6   7   7   8   8   9   9  10  10     << SEGMENT 2 >>
+--             7   8   8   8   9   9   9  10  10  10     << SEGMENT 3 >>
+--
+--    (EACH SECTION GETS ALL 3 ROWS, NOT ONE ROW PER SECTION;
+--    FOR 'CHARACTER', WHERE ONLY 26 VALUES ARE REQUIRED, THE LAST 4
+--    VALUES ARE OMITTED).  THIS NUMBER IS COMPARED WITH THE ACTUAL
+--    VALUE OF  J  (ACTUAL NUMBER OF INNER-LOOP ITERATIONS BEFORE THE
+--    EXECUTION OF THE EXIT STATEMENT) AS SAVED JUST BEFORE THE EXIT
+--    FROM THE LOOP (AGAIN IN THE FORM OF AN INTEGER IN THE RANGE
+--     1..30 , IRRESPECTIVE OF THE DATA TYPE BEING TESTED),  I F
+--    SUCH SAVED VALUE IS AVAILABLE.
+--
+--
+--    THE ACTUAL VALUE OF INNER-LOOP ITERATIONS (AS SAVED IMMEDIATELY
+--    BEFORE THE EXIT, AS OPPOSED TO A VALUE LEFT OVER FROM SOME
+--    PREVIOUS ITERATION) IS AVAILABLE ONLY IF  WHICH_SEGMENT /= 0 ,
+--    AND IS THEN STORED IN  SAVE_J .
+--
+--
+--    FOR THE CASE  WHICH_SEGMENT = 0 , THE ITERATIONS ARE COUNTED IN
+--    THE VARIABLE  COUNT , WHOSE VALUE AT THE COMPLETION OF THE
+--    I-TH TEST ( I IN 1..10 ) MUST BE EQUAL TO  EXPECTED_J - 1 ,
+--    AND THUS TO  I - 1  (METHODOLOGICALLY AS WELL AS COMPUTATIONALLY
+--    THIS IS NO DIFFERENT FROM USING THE MOST RECENT VALUE OF  SAVE_J
+--    WHEN A CURRENT ONE CANNOT BE OBTAINED).  AFTER BEING INCREMENTED
+--    BY  1 ,  COUNT  IS CHECKED AGAINST  EXPECTED_J .
+--
+--
+--    THIS CONCLUDES THE DESCRIPTION OF THE CASE  WHICH_SEGMENT = 0 ,
+--    AND THUS OF THE ALGORITHM.  THE ONLY REASON FOR SPLITTING THE
+--    CASE  WHICH_SEGMENT /= 0  INTO TWO IS THE DESIRE TO PROVIDE FOR
+--    DISTINCT MESSAGES.
+
+
+
+-- RM 04/23/81
+-- SPS 3/7/83
+
+WITH REPORT;
+PROCEDURE  C57003A  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C57003A" , "TEST THAT THE EXIT STATEMENT IS EVALUATED" &
+                       " EACH TIME THROUGH THE LOOP"               );
+
+     DECLARE
+
+          WHICH_SEGMENT  :  INTEGER RANGE 0..2   ;   -- BOUNDS ARE TIGHT
+          SAVE_J         :  INTEGER RANGE 1..10  ;
+          EXPECTED_J     :  INTEGER RANGE 1..10  ;
+          COUNT          :  INTEGER RANGE 0..100     := 0 ;
+          INT_I          :  INTEGER RANGE 1..30  ;
+
+          TYPE  ENUM  IS    ( CHANGE_THE_ORIGIN_FROM_0_TO_1 ,
+
+               A1 , A2 , A3 , A4 , A5 , A6 , A7 , A8 , A9 , A10 ,
+               A11, A12, A13, A14, A15, A16, A17, A18, A19, A20 ,
+               A21, A22, A23, A24, A25, A26, A27, A28, A29, A30 );
+
+     BEGIN
+
+
+          --------------------------------------------------------------
+          -----------------------  INTEGER  ----------------------------
+
+
+          FOR  I  IN  INTEGER RANGE 1..30  LOOP
+
+
+               WHICH_SEGMENT  :=  ( I - 1 ) / 10        ;
+               EXPECTED_J     :=  ( I + WHICH_SEGMENT ) /
+                                  ( WHICH_SEGMENT + 1 ) ;
+
+               COUNT  :=  0 ;
+
+
+               FOR  J  IN  INTEGER RANGE 1..10  LOOP
+
+                    --  J  NOT SAVED HERE (SO THAT 'EXIT' BE FIRST STMT)
+
+                    EXIT WHEN  WHICH_SEGMENT = 0  AND
+                               1*J >= I ;--COUNT+:=1 ON NXT LINE INSTEAD
+                    COUNT := COUNT + 1 ;
+
+                    NULL ;
+                    NULL ;
+                    NULL ;
+                    SAVE_J := J ;
+                    EXIT WHEN  WHICH_SEGMENT = 1  AND
+                               2*J >= I ;
+
+                    NULL ;
+                    NULL ;
+                    NULL ;
+                    SAVE_J := J ;
+                    EXIT WHEN  WHICH_SEGMENT = 2  AND
+                               3*J >= I ;
+
+               END LOOP;
+
+
+               COUNT          :=  COUNT + 1             ;  -- SEE HEADER
+
+               CASE  WHICH_SEGMENT  IS
+                    WHEN  0  =>
+                         IF  COUNT  /=  EXPECTED_J  THEN
+                              FAILED( "WRONG COUNT; INT, EXIT AT TOP" );
+                         END IF;
+                    WHEN  1  =>                 -- WOULD WORK ALSO FOR 0
+                         IF  SAVE_J  /=  EXPECTED_J  THEN
+                              FAILED( "WRONG COUNT; I,EXIT AT MIDDLE" );
+                         END IF;
+                    WHEN  2  =>
+                         IF  SAVE_J  /=  EXPECTED_J  THEN
+                              FAILED( "WRONG COUNT; I,EXIT AT BOTTOM" );
+                         END IF;
+               END CASE;
+
+          END LOOP;
+
+
+
+          --------------------------------------------------------------
+          ----------------------  CHARACTER  ---------------------------
+
+
+          FOR  I  IN  CHARACTER RANGE 'A'..'Z'  LOOP
+
+               INT_I  := CHARACTER'POS(I) - CHARACTER'POS('A') + 1;
+
+               WHICH_SEGMENT  :=  ( INT_I - 1 ) / 10        ;
+               EXPECTED_J     :=  ( INT_I + WHICH_SEGMENT ) /
+                                  ( WHICH_SEGMENT + 1 )     ;
+
+               COUNT  :=  0 ;
+
+
+               FOR  J  IN  CHARACTER RANGE 'A'..'J'  LOOP
+
+                    --  J  NOT SAVED HERE (SO THAT 'EXIT' BE FIRST STMT)
+
+                    EXIT WHEN  WHICH_SEGMENT = 0  AND
+                               J >= I ; -- COUNT+:=1 ON NXT LINE INSTEAD
+                    COUNT := COUNT + 1 ;
+
+                    NULL ;
+                    NULL ;
+                    NULL ;
+                    SAVE_J := CHARACTER'POS(J) - CHARACTER'POS('A') + 1;
+                    EXIT WHEN  WHICH_SEGMENT = 1  AND
+                               2 * SAVE_J >= INT_I ;
+
+                    NULL ;
+                    NULL ;
+                    NULL ;
+                    EXIT WHEN  WHICH_SEGMENT = 2  AND
+                               3 * SAVE_J >= INT_I ;
+
+               END LOOP;
+
+
+               COUNT          :=    COUNT + 1               ;
+
+               CASE  WHICH_SEGMENT  IS
+                    WHEN  0  =>
+                         IF  COUNT  /=  EXPECTED_J  THEN
+                              FAILED( "WRONG COUNT;CHAR, EXIT AT TOP" );
+                         END IF;
+                    WHEN  1  =>                 -- WOULD WORK ALSO FOR 0
+                         IF  SAVE_J  /=  EXPECTED_J  THEN
+                              FAILED( "WRONG COUNT; C,EXIT AT MIDDLE" );
+                         END IF;
+                    WHEN  2  =>
+                         IF  SAVE_J  /=  EXPECTED_J  THEN
+                              FAILED( "WRONG COUNT; C,EXIT AT BOTTOM" );
+                         END IF;
+               END CASE;
+
+          END LOOP;
+
+
+
+          --------------------------------------------------------------
+          ---------------------  ENUMERATION  --------------------------
+
+
+          FOR  I  IN  ENUM RANGE A1..A30  LOOP
+
+
+               INT_I          :=    ENUM'POS(I) ;
+
+               WHICH_SEGMENT  :=  ( INT_I - 1 ) / 10        ;
+               EXPECTED_J     :=  ( INT_I + WHICH_SEGMENT ) /
+                                  ( WHICH_SEGMENT + 1 )     ;
+
+               COUNT  :=  0 ;
+
+
+               FOR  J  IN  ENUM RANGE A1..A10  LOOP
+
+                    --  J  NOT SAVED HERE (SO THAT 'EXIT' BE FIRST STMT)
+
+                    EXIT WHEN  WHICH_SEGMENT = 0  AND
+                               J >= I ; -- COUNT+:=1 ON NXT LINE INSTEAD
+                    COUNT := COUNT + 1 ;
+
+                    NULL ;
+                    NULL ;
+                    NULL ;
+                    SAVE_J := ENUM'POS(J) ;
+                    EXIT WHEN  WHICH_SEGMENT = 1  AND
+                               2 * SAVE_J >= INT_I ;
+
+                    NULL ;
+                    NULL ;
+                    NULL ;
+                    EXIT WHEN  WHICH_SEGMENT = 2  AND
+                               3 * SAVE_J >= INT_I ;
+
+               END LOOP;
+
+
+               COUNT          :=    COUNT + 1               ;
+
+               CASE  WHICH_SEGMENT  IS
+                    WHEN  0  =>
+                         IF  COUNT  /=  EXPECTED_J  THEN
+                              FAILED( "WRONG COUNT;ENUM, EXIT AT TOP" );
+                         END IF;
+                    WHEN  1  =>                 -- WOULD WORK ALSO FOR 0
+                         IF  SAVE_J  /=  EXPECTED_J  THEN
+                              FAILED( "WRONG COUNT; E,EXIT AT MIDDLE" );
+                         END IF;
+                    WHEN  2  =>
+                         IF  SAVE_J  /=  EXPECTED_J  THEN
+                              FAILED( "WRONG COUNT; E,EXIT AT BOTTOM" );
+                         END IF;
+               END CASE;
+
+          END LOOP;
+
+          --------------------------------------------------------------
+
+     END ;
+
+
+     RESULT ;
+
+
+END  C57003A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c57004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c57004a.ada
new file mode 100644
index 000000000..352528b92
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c57004a.ada
@@ -0,0 +1,160 @@
+-- C57004A.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 EXIT STATEMENT WITH A LOOP NAME TERMINATES EXECUTION
+--    OF THE LOOP STATEMENT WHOSE NAME IT MENTIONS, AND OF ALL OTHER
+--    LOOP STATEMENTS (IF ANY) INTERIOR TO THE FIRST LOOP AND ENCLOSING
+--    THE EXIT STATEMENT.
+
+-- CASE 1 :  UNCONDITIONAL EXITS.
+
+
+-- RM 04/24/81
+-- SPS 3/7/83
+
+WITH REPORT;
+PROCEDURE  C57004A  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C57004A" , "CHECK THAT A NAMING EXIT STATEMENT TERMINATES" &
+                       " EXECUTION OF THE NAMED LOOP AND OF ALL LOOPS" &
+                       " SITUATED IN-BETWEEN"                         );
+
+     DECLARE
+
+          COUNT : INTEGER     := 0   ;
+
+     BEGIN
+
+          OUTERMOST :
+          FOR  X  IN  INTEGER RANGE 1..2  LOOP
+
+               FOR  Y  IN  INTEGER RANGE 1..2  LOOP
+
+                    COMMENT( "BEFORE 1" );
+
+                    LOOP1 :
+                    FOR  I  IN  1..10  LOOP
+                         COMMENT( "INSIDE 1" );
+                         EXIT  LOOP1 ;
+                         FAILED( "EXIT NOT OBEYED (1)" );
+                         FOR  J  IN  1..10  LOOP
+                              FAILED( "OUTER EXIT NOT OBEYED (1)" );
+                              EXIT ;
+                              FAILED( "BOTH EXITS IGNORED (1)" );
+                         END LOOP;
+                    END LOOP  LOOP1 ;
+
+
+                    COMMENT( "BEFORE 2" );
+                    COUNT := COUNT + 1 ;
+
+                    LOOP2 :
+                    FOR  A  IN  1..1  LOOP
+                         FOR  B  IN  1..1  LOOP
+
+                              FOR  I  IN  CHARACTER  LOOP
+                                   COMMENT( "INSIDE 2" );
+                                   EXIT  LOOP2 ;
+                                   FAILED( "EXIT NOT OBEYED (2)" );
+                                   FOR  J  IN  BOOLEAN  LOOP
+                                        FAILED( "OUTER EXIT NOT " &
+                                                "OBEYED (2)");
+                                        EXIT ;
+                                        FAILED( "BOTH EXITS IGNORED " &
+                                                "(2)");
+                                   END LOOP;
+                              END LOOP;
+
+                         END LOOP;
+                    END LOOP  LOOP2 ;
+
+
+                    COMMENT( "BEFORE 3" );
+                    COUNT := COUNT + 1 ;
+
+                    LOOP3 :
+                    FOR  A  IN  1..1  LOOP
+                         FOR  B  IN  1..1  LOOP
+
+                              FOR  I  IN  BOOLEAN  LOOP
+                                   COMMENT( "INSIDE 3" );
+                                   BEGIN
+                                        EXIT  LOOP3 ;
+                                        FAILED( "EXIT NOT OBEYED (3)" );
+                                   END ;
+                                   FAILED( "EXIT NOT OBEYED (3BIS)" );
+                              END LOOP;
+
+                         END LOOP;
+                    END LOOP  LOOP3 ;
+
+
+                    COMMENT( "BEFORE 4" );
+                    COUNT := COUNT + 1 ;
+
+                    LOOP4 :
+                    FOR  A  IN  1..1  LOOP
+                         FOR  B  IN  1..1  LOOP
+
+
+                              FOR  I  IN  INTEGER RANGE 1..10  LOOP
+                                   COMMENT( "INSIDE 4" );
+                                   CASE  A  IS
+                                        WHEN  1  =>
+                                             EXIT  LOOP4 ;
+                                             FAILED("EXIT NOT OBEYED " &
+                                                    "(4)" );
+                                   END CASE;
+                                   FAILED( "EXIT NOT OBEYED (4BIS)" );
+                              END LOOP;
+
+                         END LOOP;
+                    END LOOP  LOOP4 ;
+
+
+                    COMMENT( "AFTER 4" );
+                    COUNT := COUNT + 1 ;
+                    EXIT  OUTERMOST ;
+
+               END LOOP;
+
+               FAILED( "MISSED FINAL EXIT" );
+
+          END LOOP  OUTERMOST ;
+
+
+          IF  COUNT /= 4  THEN
+               FAILED( "WRONG FLOW OF CONTROL" );
+          END IF;
+
+     END ;
+
+     RESULT ;
+
+
+END  C57004A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c57004b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c57004b.ada
new file mode 100644
index 000000000..63f5760ca
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c57004b.ada
@@ -0,0 +1,162 @@
+-- C57004B.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 EXIT STATEMENT WITH A LOOP NAME TERMINATES EXECUTION
+--    OF THE LOOP STATEMENT WHOSE NAME IT MENTIONS, AND OF ALL OTHER
+--    LOOP STATEMENTS (IF ANY) INTERIOR TO THE FIRST LOOP AND ENCLOSING
+--    THE EXIT STATEMENT.
+
+-- CASE 2 :  CONDITIONAL EXITS.
+
+
+-- RM 04/27/81
+-- SPS 3/7/83
+
+WITH REPORT;
+PROCEDURE  C57004B  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C57004B" , "CHECK THAT A NAMING EXIT STATEMENT TERMINATES" &
+                       " EXECUTION OF THE NAMED LOOP AND OF ALL LOOPS" &
+                       " SITUATED IN-BETWEEN"                         );
+
+     DECLARE
+
+          COUNT : INTEGER     := 0   ;
+
+     BEGIN
+
+          OUTERMOST :
+          FOR  X  IN  INTEGER RANGE 1..2  LOOP
+
+               FOR  Y  IN  INTEGER RANGE 1..2  LOOP
+
+                    COMMENT( "BEFORE 1" );
+
+                    LOOP1 :
+                    FOR  I  IN  1..10  LOOP
+                         COMMENT( "INSIDE 1" );
+                         EXIT  LOOP1  WHEN  EQUAL(1,1) ;
+                         FAILED( "EXIT NOT OBEYED (1)" );
+                         FOR  J  IN  1..10  LOOP
+                              FAILED( "OUTER EXIT NOT OBEYED (1)" );
+                              EXIT  WHEN EQUAL(1,1) ;
+                              FAILED( "BOTH EXITS IGNORED (1)" );
+                         END LOOP;
+                    END LOOP  LOOP1 ;
+
+
+                    COMMENT( "BEFORE 2" );
+                    COUNT := COUNT + 1 ;
+
+                    LOOP2 :
+                    FOR  A  IN  1..1  LOOP
+                         FOR  B  IN  1..1  LOOP
+
+                              FOR  I  IN  CHARACTER  LOOP
+                                   COMMENT( "INSIDE 2" );
+                                   EXIT  LOOP2  WHEN  EQUAL(1,1) ;
+                                   FAILED( "EXIT NOT OBEYED (2)" );
+                                   FOR  J  IN  BOOLEAN  LOOP
+                                        FAILED( "OUTER EXIT NOT " &
+                                                "OBEYED (2)");
+                                        EXIT  WHEN EQUAL(1,1) ;
+                                        FAILED( "BOTH EXITS IGNORED " &
+                                                "(2)");
+                                   END LOOP;
+                              END LOOP;
+
+                         END LOOP;
+                    END LOOP  LOOP2 ;
+
+
+                    COMMENT( "BEFORE 3" );
+                    COUNT := COUNT + 1 ;
+
+                    LOOP3 :
+                    FOR  A  IN  1..1  LOOP
+                         FOR  B  IN  1..1  LOOP
+
+                              FOR  I  IN  BOOLEAN  LOOP
+                                   COMMENT( "INSIDE 3" );
+                                   BEGIN
+                                        EXIT  LOOP3  WHEN  EQUAL(1,1) ;
+                                        FAILED( "EXIT NOT OBEYED (3)" );
+                                   END ;
+                                   FAILED( "EXIT NOT OBEYED (3BIS)" );
+                              END LOOP;
+
+                         END LOOP;
+                    END LOOP  LOOP3 ;
+
+
+                    COMMENT( "BEFORE 4" );
+                    COUNT := COUNT + 1 ;
+
+                    LOOP4 :
+                    FOR  A  IN  1..1  LOOP
+                         FOR  B  IN  1..1  LOOP
+
+
+                              FOR  I  IN  INTEGER RANGE 1..10  LOOP
+                                   COMMENT( "INSIDE 4" );
+                                   CASE  A  IS
+                                        WHEN  1  =>
+                                             EXIT LOOP4 WHEN EQUAL(1,1);
+                                             FAILED("EXIT NOT OBEYED " &
+                                                    "(4)" );
+                                   END CASE;
+                                   FAILED( "EXIT NOT OBEYED (4BIS)" );
+                              END LOOP;
+
+                         END LOOP;
+                    END LOOP  LOOP4 ;
+
+
+                    COMMENT( "AFTER 4" );
+                    COUNT := COUNT + 1 ;
+                    EXIT  OUTERMOST ;
+
+               END LOOP;
+
+               FAILED( "MISSED FINAL EXIT" );
+
+          END LOOP  OUTERMOST ;
+
+
+          IF  COUNT /= 4  THEN
+               FAILED( "WRONG FLOW OF CONTROL" );
+          END IF;
+
+
+     END ;
+
+
+     RESULT ;
+
+
+END  C57004B ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58004c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58004c.ada
new file mode 100644
index 000000000..dcb66e091
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58004c.ada
@@ -0,0 +1,86 @@
+-- C58004C.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 RETURN STATEMENT WORKS FOR RECURSIVE SUBPROGRAMS,
+--    BOTH FUNCTIONS AND PROCEDURES.
+
+-- DCB 2/8/80
+-- SPS 3/7/83
+-- JBG 5/17/83
+
+WITH REPORT;
+PROCEDURE C58004C IS
+
+     USE REPORT;
+
+     I1, I2 : INTEGER := 0;   -- INITIAL VALUE IS IMMATERIAL
+
+     PROCEDURE FACTORIALP (IP1 : IN INTEGER; IP2 : IN OUT INTEGER) IS
+
+     BEGIN
+          IF IP1 = 1 THEN
+               IP2 := 1;
+               RETURN;
+          ELSE FACTORIALP (IP1 - 1, IP2);
+               IP2 := IP1 * IP2;
+               RETURN;
+          END IF;
+
+          IP2 := 0;
+
+     END FACTORIALP;
+
+     FUNCTION FACTORIALF (IF1 : INTEGER) RETURN INTEGER IS
+
+     BEGIN
+          IF IF1 = 1 THEN RETURN (1);
+          END IF;
+
+          RETURN (IF1 * FACTORIALF(IF1 - 1) );
+
+     END FACTORIALF;
+
+BEGIN
+     TEST ("C58004C", "CHECK THAT THE RETURN STATEMENT WORKS FOR" &
+           " RECURSIVE FUNCTIONS AND PROCEDURES");
+
+     I1 := FACTORIALF (5);
+
+     IF I1 /= 120 THEN
+           FAILED ("RETURN STATEMENT IN RECURSIVE FUNCTION NOT " &
+                   "WORKING");
+     END IF;
+
+     FACTORIALP (5, I2);
+
+     IF I2 = 0 THEN
+          FAILED ("RETURN STATEMENT IN RECURSIVE PROCEDURE NOT " &
+                  "WORKING");
+     ELSIF I2 /= 120 THEN
+          FAILED
+          ("RETURN STMT IN RECURSIVE PROCEDURE NOT WORKING CORRECTLY");
+     END IF;
+
+     RESULT;
+END C58004C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58004d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58004d.ada
new file mode 100644
index 000000000..c4e3ffb44
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58004d.ada
@@ -0,0 +1,90 @@
+-- C58004D.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 RETURN STATEMENT TERMINATES EXECUTION
+--    OF THE INNERMOST ENCLOSING SUBPROGRAM.
+
+-- CHECKS GENERIC SUBPROGRAMS.
+
+-- SPS 3/7/83
+-- JRK 1/31/84
+
+WITH REPORT;
+PROCEDURE C58004D IS
+
+     USE REPORT;
+
+     I1, I2 : INTEGER;
+
+     GENERIC
+     PROCEDURE ADDM (IA1 : IN OUT INTEGER; IA2 : IN INTEGER);
+
+     PROCEDURE ADDM (IA1 : IN OUT INTEGER; IA2 : IN INTEGER) IS
+
+          GENERIC
+          PROCEDURE MULT (IM1 : IN OUT INTEGER; IM2 : IN INTEGER);
+
+          PROCEDURE MULT (IM1 : IN OUT INTEGER; IM2 : IN INTEGER) IS
+          BEGIN
+               IM1 := IM1 * IM2;
+
+               IF IM1 > 0 THEN RETURN;
+               END IF;
+
+               IM1 := 0;
+          END MULT;
+
+          PROCEDURE MLT IS NEW MULT;
+
+     BEGIN
+          MLT (IA1, IA2);
+          IA1 := IA1 + IA2;
+
+          IF IA1 > 0 THEN RETURN;
+          END IF;
+
+          IA1 := 0;
+     END ADDM;
+
+     PROCEDURE ADM IS NEW ADDM;
+
+BEGIN
+     TEST ("C58004D","CHECK THAT RETURN TERMINATES EXECUTION OF ONLY" &
+           " THE INNERMOST ENCLOSING GENERIC SUBPROGRAM");
+
+     I1 := 2;
+     I2 := 3;
+     ADM (I1,I2);     -- SAME AS I1 := (I1 * I2) + I2
+
+     IF I1 = 0 THEN
+          FAILED ("RETURN DOES NOT TERMINATE SUBPROGRAM");
+     ELSIF I1 = 6 THEN
+          FAILED
+          ("RETURN TERMINATES ALL SUBPROGRAMS NOT JUST INNERMOST");
+     ELSIF I1 /= 9 THEN
+          FAILED ("RETURN STATEMENT NOT WORKING CORRECTLY");
+     END IF;
+
+     RESULT;
+END C58004D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58004g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58004g.ada
new file mode 100644
index 000000000..945920a9e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58004g.ada
@@ -0,0 +1,95 @@
+-- C58004G.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 RETURN STATEMENT WORKS FOR RECURSIVE SUBPROGRAMS,
+--    BOTH FUNCTIONS AND PROCEDURES.
+
+-- CHECK GENERIC SUBPROGRAMS.
+
+-- SPS 3/7/83
+-- JBG 9/13/83
+
+WITH REPORT;
+PROCEDURE C58004G IS
+
+     USE REPORT;
+
+     I1, I2 : INTEGER := 0;
+
+     GENERIC
+     PROCEDURE FACTORIALP (IP1 : IN INTEGER; IP2 : IN OUT INTEGER);
+
+     GENERIC
+     FUNCTION FACTORIALF (IF1: INTEGER) RETURN INTEGER;
+
+     PROCEDURE FACTORIALP (IP1 : IN INTEGER; IP2 : IN OUT INTEGER) IS
+     BEGIN
+          IF IP1 = 1 THEN
+               IP2 := 1;
+               RETURN;
+          ELSE FACTORIALP (IP1 - 1, IP2);
+               IP2 := IP1 * IP2;
+               RETURN;
+          END IF;
+
+          IP2 := 0;
+
+     END FACTORIALP;
+
+     FUNCTION FACTORIALF (IF1 : INTEGER) RETURN INTEGER IS
+
+     BEGIN
+          IF IF1 = 1 THEN RETURN (1);
+          END IF;
+
+          RETURN (IF1 * FACTORIALF(IF1 - 1) );
+
+     END FACTORIALF;
+
+     PROCEDURE FACTP IS NEW FACTORIALP;
+     FUNCTION FACTF IS NEW FACTORIALF;
+
+BEGIN
+     TEST ("C58004G", "CHECK THAT THE RETURN STATEMENT WORKS FOR" &
+           " RECURSIVE GENERIC FUNCTIONS AND PROCEDURES");
+
+     I1 := FACTF (5);
+
+     IF I1 /= 120 THEN
+           FAILED ("RETURN STATEMENT IN RECURSIVE FUNCTION NOT " &
+                   "WORKING");
+     END IF;
+
+     FACTP (5, I2);
+
+     IF I2 = 0 THEN
+          FAILED ("RETURN STATEMENT IN RECURSIVE PROCEDURE NOT " &
+                  "WORKING");
+     ELSIF I2 /= 120 THEN
+          FAILED
+          ("RETURN STMT IN RECURSIVE PROCEDURE NOT WORKING CORRECTLY");
+     END IF;
+
+     RESULT;
+END C58004G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58005a.ada
new file mode 100644
index 000000000..ef6b16487
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58005a.ada
@@ -0,0 +1,121 @@
+-- C58005A.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 WHEN A FUNCTION IS READY TO RETURN CONTROL TO ITS INVOKER
+--    THE CONSTRAINTS ON THE RETURN VALUES ARE CHECKED, AND THAT
+--     CONSTRAINT ERROR  IS THEN RAISED IF AND ONLY IF THE CONSTRAINTS
+--    ARE NOT SATISFIED.
+
+-- THIS TEST CHECKS THAT THE EXCEPTION IS RAISED UNDER THE APPROPRIATE
+--    CONDITIONS; IT ALSO CHECKS THE IDENTITY OF THE EXCEPTION.  THE
+--    PRECISE MOMENT AND PLACE THE EXCEPTION IS RAISED IS TESTED
+--    ELSEWHERE.
+
+
+-- RM 05/14/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE  C58005A  IS
+
+     USE  REPORT ;
+
+     INTVAR  :  INTEGER ;
+
+BEGIN
+
+     TEST( "C58005A" , "CHECK THAT EXCEPTIONS ARE RAISED BY A RETURN"  &
+                       " STATEMENT IF AND ONLY IF THE CONSTRAINTS ARE" &
+                       " VIOLATED" );
+
+
+     DECLARE
+          SUBTYPE I1 IS INTEGER RANGE -10..90;
+          SUBTYPE I2 IS INTEGER RANGE 1..10;
+          FUNCTION  FN1( X : I1 )
+                    RETURN  I2  IS
+          BEGIN
+               RETURN  0 ;
+          END  FN1 ;
+
+          FUNCTION  FN2( X : I1 )
+                    RETURN  I2  IS
+          BEGIN
+               RETURN  X + IDENT_INT(0) ;
+          END  FN2 ;
+
+          FUNCTION  FN3( X : I1  )
+                    RETURN  I2  IS
+               HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100) ;
+          BEGIN
+               RETURN  HUNDRED - 90 ;
+          END  FN3 ;
+
+     BEGIN
+
+          INTVAR := 0 ;
+
+          BEGIN
+               INTVAR := FN1( 0 ) + INTVAR ;  -- EXCEPTION.
+               FAILED( "EXCEPTION NOT RAISED  -  1" );
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => INTVAR := INTVAR + 10 ;
+               WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  1" ) ;
+          END ;
+
+          BEGIN
+               INTVAR := FN2( 1 ) + INTVAR ; -- 10+1=11 -- NO EXCEPTION.
+               INTVAR := INTVAR + 100 ;   -- 11+100=111
+          EXCEPTION
+               WHEN OTHERS => FAILED( "EXCEPTION RAISED  -  2" ) ;
+          END ;
+
+          BEGIN
+               INTVAR := FN2(11 ) + INTVAR ;  -- EXCEPTION.
+               FAILED( "EXCEPTION NOT RAISED  -  3" );
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => INTVAR := INTVAR + 10 ; -- 121
+               WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  3" ) ;
+          END ;
+
+          BEGIN
+               INTVAR := FN3( 0 ) + INTVAR ;--121+10=131 --NO EXCEPTION.
+               INTVAR := INTVAR + 1000 ;-- 131+1000=1131
+          EXCEPTION
+               WHEN OTHERS => FAILED( "EXCEPTION RAISED  -  4" ) ;
+          END ;
+
+
+     END ;
+
+
+     IF  INTVAR /= 1131  THEN
+          FAILED("WRONG FLOW OF CONTROL" );
+     END IF;
+
+
+     RESULT ;
+
+
+END C58005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58005b.ada
new file mode 100644
index 000000000..05cda7093
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58005b.ada
@@ -0,0 +1,94 @@
+-- C58005B.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 WHEN A GENERIC FUNCTION IS READY TO RETURN CONTROL TO ITS 
+--    INVOKER THE CONSTRAINTS ON THE RETURN VALUES ARE CHECKED, AND THAT
+--    CONSTRAINT ERROR  IS THEN RAISED IF AND ONLY IF THE CONSTRAINTS
+--    ARE NOT SATISFIED.
+
+-- THIS TEST CHECKS THAT THE EXCEPTION IS RAISED UNDER THE APPROPRIATE
+--    CONDITIONS; IT ALSO CHECKS THE IDENTITY OF THE EXCEPTION.  THE
+--    PRECISE MOMENT AND PLACE THE EXCEPTION IS RAISED IS TESTED
+--    ELSEWHERE.
+
+-- SPS 3/10/83
+-- JBG 9/13/83
+-- AH  8/29/86  ADDED CALLS TO "FAILED" AFTER "IF" STATEMENTS.
+
+WITH REPORT;
+PROCEDURE  C58005B  IS
+
+     USE  REPORT;
+
+BEGIN
+
+     TEST( "C58005B" , "CHECK THAT EXCEPTIONS ARE RAISED BY A RETURN"  &
+                       " STATEMENT IF AND ONLY IF THE CONSTRAINTS ARE" &
+                       " VIOLATED" );
+
+
+     DECLARE
+          SUBTYPE I1 IS INTEGER RANGE -10..90;
+          SUBTYPE I2 IS INTEGER RANGE 1..10;
+
+          GENERIC
+          FUNCTION FN1 ( X : I1 ) RETURN I2;
+
+          FUNCTION  FN1( X : I1 )
+                    RETURN  I2  IS
+          BEGIN
+               RETURN X;
+          END  FN1;
+
+          FUNCTION F1 IS NEW FN1;
+
+     BEGIN
+
+          BEGIN
+               IF F1(IDENT_INT(0)) IN I2 THEN
+                    FAILED( "EXCEPTION NOT RAISED  -  1A" );
+               ELSE
+                    FAILED( "EXCEPTION NOT RAISED  -  1B" );
+               END IF;          
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  1" );
+          END;
+
+          BEGIN
+               IF F1(IDENT_INT(11)) IN I2 THEN
+                    FAILED( "EXCEPTION NOT RAISED  -  2A" );
+               ELSE
+                    FAILED( "EXCEPTION NOT RAISED  -  2B" );
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED  -  2" );
+          END;
+
+     END;
+
+     RESULT;
+
+END C58005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58005h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58005h.ada
new file mode 100644
index 000000000..276d34d69
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58005h.ada
@@ -0,0 +1,172 @@
+-- C58005H.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 CONSTRAINTS ON THE RETURN VALUE OF A FUNCTION ARE
+-- SATISIFIED WHEN THE FUNCTION RETURNS CONTROL TO ITS INVOKER.
+
+-- THIS TESTS CHECKS FOR CONSTRAINTS ON CONSTRAINED ACCESS TYPES WITH
+-- RECORD, ARRAY, PRIVATE AND LIMITED PRIVATE DESIGNATED TYPES.
+
+-- SPS 3/10/83
+-- RLB 6/29/01 - Repaired test to work in the face of aggressive optimizations.
+--               The objects must be used, and must be tied somehow to the
+--               calls to Failed.
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C58005H IS
+
+     PACKAGE PACK IS
+          TYPE PV (D : NATURAL) IS PRIVATE;
+          TYPE LP (D : NATURAL) IS LIMITED PRIVATE;
+     PRIVATE
+          TYPE PV (D : NATURAL) IS RECORD
+               NULL;
+          END RECORD;
+          TYPE LP (D : NATURAL) IS RECORD
+               NULL;
+          END RECORD;
+     END PACK;
+
+     USE PACK;
+
+     TYPE ARR IS ARRAY (NATURAL RANGE <>) OF NATURAL;
+     TYPE REC (D : NATURAL) IS RECORD
+          NULL;
+     END RECORD;
+
+     TYPE ACC_REC IS ACCESS REC;
+     TYPE ACC_ARR IS ACCESS ARR;
+     TYPE ACC_PV IS ACCESS PV;
+     TYPE ACC_LP IS ACCESS LP;
+
+     SUBTYPE ACC_REC1 IS ACC_REC (D => 1);
+     SUBTYPE ACC_REC2 IS ACC_REC (D => 2);
+
+     SUBTYPE ACC_ARR1 IS ACC_ARR (1 .. 10);
+     SUBTYPE ACC_ARR2 IS ACC_ARR (2 .. 5);
+
+     SUBTYPE ACC_PV1 IS ACC_PV (D => 1);
+     SUBTYPE ACC_PV2 IS ACC_PV (D => 2);
+
+     SUBTYPE ACC_LP1 IS ACC_LP (D => 1);
+     SUBTYPE ACC_LP2 IS ACC_LP (D => 2);
+
+     VAR1 : ACC_REC1 := NEW REC(1);
+     VAR2 : ACC_REC2 := NEW REC(2);
+     VAA1 : ACC_ARR1 := NEW ARR(1 .. 10);
+     VAA2 : ACC_ARR2 := NEW ARR(2 .. 5);
+     VAP1 : ACC_PV1 := NEW PV(1);
+     VAP2 : ACC_PV2 := NEW PV(2);
+     VAL1 : ACC_LP1 := NEW LP(1);
+     VAL2 : ACC_LP2 := NEW LP(2);
+
+     FUNCTION FREC ( X : ACC_REC1) RETURN ACC_REC2 IS
+     BEGIN
+          RETURN X;
+     END FREC;
+
+     FUNCTION FARR ( X : ACC_ARR1) RETURN ACC_ARR2 IS
+     BEGIN
+          RETURN X;
+     END FARR;
+
+     FUNCTION FPV ( X : ACC_PV1) RETURN ACC_PV2 IS
+     BEGIN
+          RETURN X;
+     END FPV;
+
+     FUNCTION FLP ( X : ACC_LP1) RETURN ACC_LP2 IS
+     BEGIN
+          RETURN X;
+     END FLP;
+
+     PACKAGE BODY PACK IS
+          FUNCTION LF (X : LP) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT(3);
+          END LF;
+     BEGIN
+          NULL;
+     END PACK;
+
+BEGIN
+
+     TEST ("C58005H", "CHECK ACCESS CONSTRAINTS ON RETURN VALUES " &
+                      "OF FUNCTIONS");
+
+     BEGIN
+          VAR2 := FREC (VAR1);
+          IF VAR2.D /= REPORT.IDENT_INT(2) THEN
+              FAILED ("CONSTRAINT_ERROR NOT RAISED - REC 1");
+          ELSE
+              FAILED ("CONSTRAINT_ERROR NOT RAISED - REC 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - REC");
+     END;
+
+     BEGIN
+          VAA2 := FARR (VAA1);
+          IF VAA2'FIRST /= REPORT.IDENT_INT(2) THEN
+              FAILED ("CONSTRAINT_ERROR NOT RAISED - ARR 1");
+          ELSE
+              FAILED ("CONSTRAINT_ERROR NOT RAISED - ARR 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - ARR");
+     END;
+
+     BEGIN
+          VAP2 := FPV (VAP1);
+          IF VAP2.D /= REPORT.IDENT_INT(2) THEN
+              FAILED ("CONSTRAINT_ERROR NOT RAISED - PV 1");
+          ELSE
+              FAILED ("CONSTRAINT_ERROR NOT RAISED - PV 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - PV");
+     END;
+
+     BEGIN
+          VAL2 := FLP (VAL1);
+          IF VAL2.D /= REPORT.IDENT_INT(2) THEN
+              FAILED ("CONSTRAINT_ERROR NOT RAISED - LP 1");
+          ELSE
+              FAILED ("CONSTRAINT_ERROR NOT RAISED - LP 2");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR => NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - LP");
+     END;
+
+     RESULT;
+END C58005H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58006a.ada
new file mode 100644
index 000000000..f7a2f1ca1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58006a.ada
@@ -0,0 +1,128 @@
+-- C58006A.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 EVALUATION OF A RETURN STATEMENT'S EXPRESSION
+-- RAISES AN EXCEPTION, THE EXCEPTION CAN BE HANDLED WITHIN THE BODY OF
+-- THE FUNCTION. 
+
+-- RM 05/11/81
+-- SPS 10/26/82
+-- SPS 3/8/83
+-- JBG 9/13/83
+
+WITH REPORT;
+PROCEDURE  C58006A  IS
+
+     USE  REPORT;
+
+BEGIN
+
+     TEST( "C58006A" , "CHECK THAT EXCEPTION RAISED BY A RETURN" &
+                       " STATEMENT CAN BE HANDLED LOCALLY" );
+
+
+     DECLARE
+          SUBTYPE I1 IS INTEGER RANGE -10..90;
+          SUBTYPE I2 IS INTEGER RANGE 1..10; 
+
+          FUNCTION  FN1( X : I1 )
+                    RETURN  I2  IS
+          BEGIN
+               RETURN  0;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    COMMENT ("EXCEPTION RAISED - F1");
+                    RETURN 1;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FN1");
+          END  FN1;
+
+          FUNCTION  FN2( X : I1 )
+                    RETURN  I2  IS
+          BEGIN
+               RETURN  X + IDENT_INT(0);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    COMMENT ("EXCEPTION RAISED - F2");
+                    RETURN 1;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FN2");
+          END  FN2;
+
+          FUNCTION  FN3( X : I1 )
+                    RETURN  I2  IS
+               HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100);
+          BEGIN
+               RETURN  HUNDRED;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    COMMENT ("EXCEPTION RAISED - F3");
+                    RETURN 1;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FN3");
+          END  FN3;
+
+     BEGIN
+
+          BEGIN
+               IF FN1( 0 ) /= IDENT_INT(1) THEN
+                    FAILED ("NO EXCEPTION RAISED - FN1( 0 )");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION PROPAGATED - FN1( 0 )");
+          END;
+
+          BEGIN
+               IF FN2( 0 ) /= IDENT_INT(1) THEN
+                    FAILED ("NO EXCEPTION RAISED - FN2( 0 )");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION PROPAGATED - FN2( 0 )");
+          END;
+
+          BEGIN
+               IF FN2(11 ) /= IDENT_INT(1) THEN
+                    FAILED ("NO EXCEPTION RAISED - FN2(11 )");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION PROPAGATED - FN2(11 )");
+          END;
+
+          BEGIN
+               IF FN3( 0 ) /= IDENT_INT(1) THEN
+                    FAILED ("NO EXCEPTION RAISED - FN3( 0 )");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION PROPAGATED - FN3( 0 )");
+          END;
+
+     END;
+
+     RESULT;
+
+END C58006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58006b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58006b.ada
new file mode 100644
index 000000000..82b313255
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c58006b.ada
@@ -0,0 +1,141 @@
+-- C58006B.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 EVALUATION OF A RETURN STATEMENT'S EXPRESSION
+-- RAISES AN EXCEPTION, THE EXCEPTION CAN BE HANDLED WITHIN THE BODY OF
+-- THE FUNCTION. 
+
+-- CHECKS GENERIC FUNCTIONS.
+
+-- SPS 3/8/83
+-- JBG 9/13/83
+
+WITH REPORT;
+PROCEDURE  C58006B  IS
+
+     USE  REPORT;
+
+BEGIN
+
+     TEST( "C58006B" , "CHECK THAT EXCEPTION RAISED BY A RETURN" &
+                       " STATEMENT CAN BE HANDLED LOCALLY" );
+
+
+     DECLARE
+          SUBTYPE I1 IS INTEGER RANGE -10..90;
+          SUBTYPE I2 IS INTEGER RANGE 1..10; 
+
+          GENERIC
+          FUNCTION FN1 (X : I1) RETURN I2;
+
+          GENERIC
+          FUNCTION FN2 (X : I1) RETURN I2;
+
+          GENERIC
+          FUNCTION FN3 (X : I1) RETURN I2;
+
+          FUNCTION  FN1( X : I1 )
+                    RETURN  I2  IS
+          BEGIN
+               RETURN  0;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    COMMENT ("EXCEPTION RAISED - F1");
+                    RETURN 1;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FN1");
+          END  FN1;
+
+          FUNCTION  FN2( X : I1 )
+                    RETURN  I2  IS
+          BEGIN
+               RETURN  X + IDENT_INT(0);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    COMMENT ("EXCEPTION RAISED - F2");
+                    RETURN 1;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FN2");
+          END  FN2;
+
+          FUNCTION  FN3( X : I1 )
+                    RETURN  I2  IS
+               HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100);
+          BEGIN
+               RETURN  HUNDRED;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => 
+                    COMMENT ("EXCEPTION RAISED - F3");
+                    RETURN 1;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FN3");
+          END  FN3;
+
+          FUNCTION F1 IS NEW FN1;
+          FUNCTION F2 IS NEW FN2;
+          FUNCTION F3 IS NEW FN3;
+
+     BEGIN
+
+          BEGIN
+               IF F1( 0 ) /= IDENT_INT(1) THEN
+                    FAILED ("NO EXCEPTION RAISED - F1( 0 )");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION PROPAGATED - F1( 0 )");
+          END;
+
+          BEGIN
+               IF F2( 0 ) /= IDENT_INT(1) THEN
+                    FAILED ("NO EXCEPTION RAISED - F2( 0 )");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION PROPAGATED - F2( 0 )");
+          END;
+
+          BEGIN
+               IF F2(11 ) /= IDENT_INT(1) THEN
+                    FAILED ("NO EXCEPTION RAISED - F2(11 )");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION PROPAGATED - F2(11 )");
+          END;
+
+          BEGIN
+               IF F3( 0 ) /= IDENT_INT(1) THEN
+                    FAILED ("NO EXCEPTION RAISED - F3( 0 )");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION PROPAGATED - F3( 0 )");
+          END;
+
+     END;
+
+     RESULT;
+
+END C58006B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c59002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c59002a.ada
new file mode 100644
index 000000000..521071972
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c59002a.ada
@@ -0,0 +1,102 @@
+-- C59002A.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 JUMPS OUT OF AN EXCEPTION HANDLER CONTAINED IN A BLOCK
+--    TO A STATEMENT IN AN ENCLOSING UNIT ARE ALLOWED AND ARE PERFORMED 
+--    CORRECTLY.
+
+
+-- RM 05/22/81
+-- SPS 3/8/83
+
+WITH REPORT;
+PROCEDURE  C59002A  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C59002A" , "CHECK THAT JUMPS OUT OF EXCEPTION HANDLERS" &
+                       " ARE ALLOWED" );
+
+     DECLARE
+
+          FLOW : INTEGER := 1 ;
+          EXPON: INTEGER RANGE 0..3 := 0 ;
+
+     BEGIN
+
+          GOTO  START ;
+
+          FAILED( "'GOTO' NOT OBEYED" );
+
+          << BACK_LABEL >>
+          FLOW  := FLOW  * 3**EXPON ;                    -- 1*5*9
+          EXPON := EXPON + 1 ;
+          GOTO  FINISH ;
+
+          << START >>
+          FLOW  := FLOW  * 7**EXPON ;                    -- 1
+          EXPON := EXPON + 1 ;
+
+          DECLARE
+          BEGIN
+               RAISE  CONSTRAINT_ERROR ;
+               FAILED( "EXCEPTION NOT RAISED  -  1" );
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR  =>
+                    GOTO  FORWARD_LABEL ;
+          END ;
+
+          FAILED( "INNER 'GOTO' NOT OBEYED  -  1" );
+
+          << FORWARD_LABEL >>
+          FLOW  := FLOW  * 5**EXPON ;                    -- 1*5
+          EXPON := EXPON + 1 ;
+
+          DECLARE
+          BEGIN
+               RAISE  CONSTRAINT_ERROR ;
+               FAILED( "EXCEPTION NOT RAISED  -  2" );
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR  =>
+                    GOTO  BACK_LABEL ;
+          END ;
+
+          FAILED( "INNER 'GOTO' NOT OBETED  -  2" );
+
+          << FINISH >>
+          FLOW  := FLOW  * 2**EXPON ;                    -- 1*5*9*8
+
+          IF  FLOW /= 360  THEN
+               FAILED( "WRONG FLOW OF CONTROL" );
+          END IF;
+
+     END ;
+
+
+     RESULT ;
+
+
+END C59002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c59002b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c59002b.ada
new file mode 100644
index 000000000..aee5839a7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c59002b.ada
@@ -0,0 +1,209 @@
+-- C59002B.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 JUMPS OUT OF COMPOUND STATEMENTS (OTHER THAN
+--    ACCEPT STATEMENTS) ARE POSSIBLE AND ARE CORRECTLY PERFORMED.
+
+
+-- FLOW OF CONTROL:   A ->  B ->  C ->  D ->   E ->  F ->  G ->  H .
+--                    |     |     |     |      |     |     |
+--                    IF   LOOP   CASE  BLOCK  IF   LOOP   CASE
+--                                             LOOP CASE   BLOCK
+
+
+--          A : GOTO B              L111 -> L311
+--          FAILURE                 L121
+--          E : GOTO F              L131 -> L331
+
+--          FAILURE                 L100
+
+--          C : GOTO D              L211 -> L411
+--          FAILURE                 L221
+--          G : GOTO H              L231
+
+--          FAILURE                 L200
+
+--          B : GOTO C              L311 -> L211
+--          FAILURE                 L321
+--          F : GOTO G              L331
+
+--          FAILURE                 L300
+
+--          D : GOTO E              L411 -> L131
+--          FAILURE                 L421
+--          H :                     L431 -> (OUT)
+
+--          PRINT RESULTS
+
+
+-- RM 06/05/81
+-- SPS 3/8/83
+
+WITH REPORT;
+PROCEDURE  C59002B  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "C59002B" , "CHECK THAT ONE CAN JUMP OUT OF COMPOUND STATE" &
+                       "MENTS" );
+
+
+     DECLARE
+
+          FLOW_STRING : STRING(1..8) := "XXXXXXXX" ;
+          INDEX       : INTEGER      :=  1 ;
+
+     BEGIN
+
+          << L111 >>
+
+          FLOW_STRING(INDEX) := 'A' ;
+          INDEX              := INDEX + 1 ;
+
+          IF  FALSE  THEN
+               FAILED( "WRONG 'IF' BRANCH" );
+          ELSE
+               GOTO  L311 ;
+          END IF;
+
+          << L121 >>
+
+          FAILED( "AT L121  -  WRONGLY" );
+
+          << L131 >>
+
+          FLOW_STRING(INDEX) := 'E' ;
+          INDEX              := INDEX + 1 ;
+
+          IF  FALSE  THEN
+               FAILED( "WRONG 'IF' BRANCH" );
+          ELSE
+               FOR  J  IN  1..1  LOOP
+                    GOTO  L331 ;
+               END LOOP;
+          END IF;
+
+          << L100 >>
+
+          FAILED( "AT L100  -  WRONGLY" );
+
+          << L211 >>
+
+          FLOW_STRING(INDEX) := 'C' ;
+          INDEX              := INDEX + 1 ;
+
+          CASE  2  IS
+               WHEN  1  =>
+                    FAILED( "WRONG 'CASE' BRANCH" );
+               WHEN  OTHERS  =>
+                    GOTO  L411 ;
+          END CASE;
+
+          << L221 >>
+
+          FAILED( "AT L221  -  WRONGLY" );
+
+          << L231 >>
+
+          FLOW_STRING(INDEX) := 'G' ;
+          INDEX              := INDEX + 1 ;
+
+          CASE  2  IS
+               WHEN  1  =>
+                    FAILED( "WRONG 'CASE' BRANCH" );
+               WHEN  OTHERS  =>
+                    DECLARE
+                    BEGIN
+                         GOTO  L431 ;
+                    END ;
+          END CASE;
+
+          << L200 >>
+
+          FAILED( "AT L200  -  WRONGLY" );
+
+          << L311 >>
+
+          FLOW_STRING(INDEX) := 'B' ;
+          INDEX              := INDEX + 1 ;
+
+          FOR  I  IN  1..1  LOOP
+               GOTO  L211 ;
+          END LOOP;
+
+          << L321 >>
+
+          FAILED( "AT L321  -  WRONGLY" );
+
+          << L331 >>
+
+          FLOW_STRING(INDEX) := 'F' ;
+          INDEX              := INDEX + 1 ;
+
+          FOR  I  IN  1..1  LOOP
+               CASE  2  IS
+                    WHEN  1  =>
+                         FAILED( "WRONG 'CASE' BRANCH" );
+                    WHEN  OTHERS  =>
+                         GOTO  L231 ;
+               END CASE;
+          END LOOP;
+
+          << L300 >>
+
+          FAILED( "AT L300  -  WRONGLY" );
+
+          << L411 >>
+
+          FLOW_STRING(INDEX) := 'D' ;
+          INDEX              := INDEX + 1 ;
+
+          DECLARE
+               K : INTEGER := 17 ;
+          BEGIN
+               GOTO  L131 ;
+          END;
+
+          << L421 >>
+
+          FAILED( "AT L421  -  WRONGLY" );
+
+          << L431 >>
+
+          FLOW_STRING(INDEX) := 'H' ;
+
+
+          IF  FLOW_STRING /= "ABCDEFGH"  THEN
+               FAILED("WRONG FLOW OF CONTROL" );
+          END IF;
+
+     END ;
+
+
+     RESULT ;
+
+
+END C59002B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c59002c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c59002c.ada
new file mode 100644
index 000000000..cc01a7e6c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c5/c59002c.ada
@@ -0,0 +1,150 @@
+-- C59002C.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 JUMPS OUT OF SELECT STATEMENTS (OTHER THAN
+--    FROM INSIDE  ACCEPT  BODIES IN SELECT_ALTERNATIVES)
+--    ARE POSSIBLE AND ARE CORRECTLY PERFORMED.
+
+-- THIS TEST CONTAINS SHARED VARIABLES.
+
+
+-- RM 08/15/82
+-- SPS 12/13/82
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+with Impdef;
+WITH REPORT;
+WITH SYSTEM;
+USE SYSTEM;
+PROCEDURE  C59002C  IS
+
+     USE  REPORT ;
+
+     FLOW_STRING : STRING(1..2) := "XX" ;
+     INDEX       : INTEGER      :=  1 ;
+
+
+BEGIN
+
+     TEST( "C59002C" , "CHECK THAT ONE CAN JUMP OUT OF SELECT STATE" &
+                       "MENTS" );
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          TASK  T  IS
+
+
+               ENTRY  E1 ;
+               ENTRY  E2 ;
+          END  T ;
+
+          TASK BODY T IS
+          BEGIN
+
+               WHILE  E2'COUNT <= 0  LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+               SELECT 
+                    ACCEPT  E1  DO
+                         FAILED( " E1  ACCEPTED; NO ENTRY CALL (1)" );
+                    END ;
+               OR
+                    ACCEPT  E2 ;
+                    GOTO  L123 ;
+                    FAILED( "'GOTO' NOT OBEYED (1)" );
+               OR
+                    DELAY 10.0 * Impdef.One_Second;
+                    FAILED( "DELAY ALTERNATIVE SELECTED (1)" );
+               END SELECT;
+
+               FAILED( "WRONG DESTINATION FOR 'GOTO' (1)" );
+
+               << L123 >>
+
+               FLOW_STRING(INDEX) := 'A' ;
+               INDEX              := INDEX + 1 ;
+
+          END T;
+
+     BEGIN
+
+          T.E2 ;
+
+     END;
+
+     -------------------------------------------------------------------
+
+     DECLARE
+
+          TASK  T  IS
+               ENTRY  E1 ;
+               ENTRY  E2 ;
+          END  T ;
+
+          TASK BODY T IS
+          BEGIN
+
+               SELECT 
+                    ACCEPT  E1  DO
+                         FAILED( " E1  ACCEPTED; NO ENTRY CALL (2)" );
+                    END ;
+               OR
+                    ACCEPT  E2  DO
+                         FAILED( " E2  ACCEPTED; NO ENTRY CALL (2)" );
+                    END ;
+               OR
+                    DELAY 10.0 * Impdef.One_Second;
+                    GOTO  L321 ;
+                    FAILED( "'GOTO' NOT OBEYED (2)" );
+               END SELECT;
+
+               FAILED( "WRONG DESTINATION FOR 'GOTO' (2)" );
+
+               << L321 >>
+
+               FLOW_STRING(INDEX) := 'B' ;
+               INDEX              := INDEX + 1 ;
+
+          END T;
+
+     BEGIN
+
+          NULL ;
+
+     END;
+
+     -------------------------------------------------------------------
+
+     IF  FLOW_STRING /= "AB"  THEN
+          FAILED("WRONG FLOW OF CONTROL" );
+     END IF;
+
+
+     RESULT ;
+
+
+END  C59002C ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c61008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c61008a.ada
new file mode 100644
index 000000000..eb60e89dc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c61008a.ada
@@ -0,0 +1,266 @@
+-- C61008A.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 NOT RAISED IF THE DEFAULT VALUE
+-- FOR A FORMAL PARAMETER DOES NOT SATISFY THE CONSTRAINTS OF THE 
+-- SUBTYPE_INDICATION WHEN THE DECLARATION IS ELABORATED, ONLY WHEN
+-- THE DEFAULT IS USED.
+
+--   SUBTESTS ARE:
+--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
+--            INITIALIZED WITH A STATIC AGGREGATE.
+--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
+--            INITIALIZED WITH A STATIC VALUE.
+--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
+--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
+--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
+--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+--            WITH A STATIC AGGREGATE.
+--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
+--            INITIALIZED WITH A STATIC AGGREGATE.
+
+-- DAS  1/20/81
+-- SPS 10/26/82
+-- VKG 1/13/83
+-- SPS 2/9/83
+-- BHS 7/9/84
+
+WITH REPORT;
+PROCEDURE C61008A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST ("C61008A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                      "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                      "CONSTRAINTS ON A FORMAL PARAMETER");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          PROCEDURE PA (I1, I2 : INTEGER) IS
+
+               TYPE A1 IS ARRAY (1..I1,1..I2) OF INTEGER;
+
+               PROCEDURE PA1 (A : A1 := ((1,0),(0,1))) IS
+               BEGIN
+                    FAILED ("BODY OF PA1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN PA1");
+               END PA1;
+
+          BEGIN
+               PA1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PA1");
+          END PA;
+
+     BEGIN   -- (A)
+          PA (IDENT_INT(1), IDENT_INT(10));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO PA");
+     END;    -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          PROCEDURE PB (I1, I2 : INTEGER) IS
+
+               SUBTYPE INT IS INTEGER RANGE I1..I2;
+
+               PROCEDURE PB1 (I : INT := -1) IS
+               BEGIN
+                    FAILED ("BODY OF PB1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN PB1");
+               END PB1;
+
+          BEGIN
+               PB1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PB1");
+          END PB;
+
+     BEGIN   -- (B)
+          PB (IDENT_INT(0), IDENT_INT(63));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO PB");
+     END;    -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          PROCEDURE PC (I1, I2 : INTEGER) IS
+               TYPE AR1 IS ARRAY (1..3) OF INTEGER RANGE I1..I2; 
+               TYPE REC IS
+                    RECORD
+                         I : INTEGER RANGE I1..I2;
+                         A : AR1 ;
+                    END RECORD;
+
+               PROCEDURE PC1 (R : REC := (-3,(0,2,3))) IS
+               BEGIN
+                    FAILED ("BODY OF PC1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN PC1");
+               END PC1;
+
+          BEGIN
+               PC1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PC1");
+          END PC;
+
+     BEGIN   -- (C)
+          PC (IDENT_INT(1), IDENT_INT(3));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO PC");
+     END;    -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D1)
+
+          PROCEDURE P1D (I1, I2 : INTEGER) IS
+
+               TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
+
+               PROCEDURE P1D1 (A : A1 := ((1,-1),(1,2))) IS
+               BEGIN
+                    FAILED ("BODY OF P1D1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN P1D1");
+               END P1D1;
+
+          BEGIN
+               P1D1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - P1D1");
+          END P1D;
+
+     BEGIN   -- (D1)
+          P1D (IDENT_INT(1), IDENT_INT(2));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO P1D");
+     END;    -- (D1)
+
+     --------------------------------------------------
+
+     DECLARE -- (D2)
+
+          PROCEDURE P2D (I1, I2 : INTEGER) IS
+               
+               TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
+
+               PROCEDURE P2D1 (A : A1 := (3..4 => (1,2))) IS
+               BEGIN
+                    FAILED ("BODY OF P2D1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN P2D1");
+               END P2D1;
+
+          BEGIN
+               P2D1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - P2D1");
+          END P2D;
+
+     BEGIN  -- (D2)
+          P2D (IDENT_INT(1), IDENT_INT(2));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO P2D");
+     END;   -- (D2)
+
+     --------------------------------------------------
+
+     DECLARE -- (E)
+
+          PROCEDURE PE (I1, I2 : INTEGER) IS
+               SUBTYPE INT IS INTEGER RANGE 0..10;
+               TYPE ARR IS ARRAY (1..3) OF INT;
+               TYPE REC (I : INT) IS
+                    RECORD
+                         A : ARR;
+                    END RECORD;
+
+               SUBTYPE REC4 IS REC(I1);
+
+               PROCEDURE PE1 (R : REC4 := (3,(1,2,3))) IS
+               BEGIN
+                    FAILED ("BODY OF PE1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN PE1");
+               END PE1;
+
+          BEGIN
+               PE1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PE1");
+          END PE;
+
+     BEGIN   -- (E)
+          PE (IDENT_INT(4), IDENT_INT(10));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO PE");
+     END;    -- (E)
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C61008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c61009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c61009a.ada
new file mode 100644
index 000000000..d98674d29
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c61009a.ada
@@ -0,0 +1,160 @@
+-- C61009A.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 STATIC EXPRESSION, CONSTANT NAME, ATTRIBUTE NAME,
+--   VARIABLE, DEREFERENCED ACCESS, USER-DEFINED OPERATOR, USER-
+--   DEFINED FUNCTION, OR ALLOCATOR CAN BE USED IN THE INITIALIZATION
+--   EXPRESSION OF A FORMAL PARAMETER, AND THAT THE APPROPRIATE
+--   VALUE IS USED AS A DEFAULT PARAMETER VALUE WHEN THE SUBPROGRAM
+--   IS CALLED.
+
+-- DAS  1/21/81
+-- ABW  7/20/82
+-- SPS  12/10/82
+
+WITH REPORT;
+PROCEDURE C61009A IS
+
+     USE REPORT;
+
+     TYPE INT IS RANGE 1 .. 10;
+
+     TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+
+     TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+          RECORD
+               A : ARR (0..CONSTRAINT); 
+          END RECORD;
+
+     C7   : CONSTANT INTEGER  := 7;
+     V7   : INTEGER  := 7;
+     
+     TYPE  A_INT IS ACCESS INTEGER;
+     C_A  : CONSTANT A_INT  := NEW INTEGER'(7);
+
+     SUBTYPE RECTYPE1 IS RECTYPE (2 + 5);
+     SUBTYPE RECTYPE2 IS RECTYPE (C7);
+     SUBTYPE RECTYPE3 IS RECTYPE (V7);
+
+     FUNCTION "&" (X,Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN 10;
+     END "&";
+
+     FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN X;
+     END FUNC;
+
+     -- STATIC EXPRESSION
+
+     PROCEDURE PROC1 (REC : RECTYPE1 := (3+4,(0,1,2,3,4,5,6,7))) IS
+     BEGIN
+          IF (REC /= (7,(0,1,2,3,4,5,6,7))) THEN
+               FAILED ("INCORRECT DEFAULT VALUE FOR PROC1 PARAMETER");
+          END IF;
+     END PROC1;
+
+     -- CONSTANT NAME
+
+     PROCEDURE PROC2 (REC : RECTYPE2 := (C7,(0,1,2,3,4,5,6,7))) IS
+     BEGIN
+          IF (REC /= (C7,(0,1,2,3,4,5,6,7))) THEN
+               FAILED ("INCORRECT DEFAULT VALUE FOR PROC2 PARAMETER");
+          END IF;
+     END PROC2;
+
+     -- ATTRIBUTE NAME
+
+     PROCEDURE PROC3 (P1 : INT := INT'LAST) IS
+     BEGIN
+          IF (P1 /= INT (10)) THEN
+               FAILED ("INCORRECT DEFAULT VALUE FOR PROC3 PARAMETER");
+          END IF;
+     END PROC3;
+
+     -- VARIABLE
+
+     PROCEDURE PROC4 (P4 : RECTYPE3 := (V7,(0,1,2,3,4,5,6,7))) IS
+     BEGIN
+          IF (P4 /= (V7,(0,1,2,3,4,5,6,7))) THEN
+               FAILED ("INCORRECT DEFAULT VALUE FOR PROC4 PARAMETER");
+               END IF;
+          END PROC4;
+
+     --DEREFERENCED ACCESS
+
+     PROCEDURE PROC5 (P5 : INTEGER := C_A.ALL) IS
+     BEGIN
+          IF(P5 /= C_A.ALL) THEN
+               FAILED ("INCORRECT DEFAULT VALUE FOR PROC5 PARAMETER");
+          END IF;
+     END PROC5;
+
+     --USER-DEFINED OPERATOR
+
+     PROCEDURE PROC6 (P6 : INTEGER := 6&4) IS
+     BEGIN
+          IF (P6 /= IDENT_INT(10)) THEN
+               FAILED ("INCORRECT DEFAULT VALUE FOR PROC6 PARAMETER");
+          END IF;
+     END PROC6;
+
+     --USER-DEFINED FUNCTION
+
+     PROCEDURE PROC7 (P7 : INTEGER := FUNC(10)) IS
+     BEGIN
+          IF (P7 /= IDENT_INT(10)) THEN
+               FAILED ("INCORRECT DEFAULT VALUE FOR PROC7 PARAMETER");
+          END IF;
+     END PROC7;
+
+     -- ALLOCATOR
+
+     PROCEDURE PROC8 (P8 : A_INT := NEW INTEGER'(7)) IS
+     BEGIN
+          IF (P8.ALL /= IDENT_INT(7)) THEN
+               FAILED ("INCORRECT DEFAULT VALUE FOR PROC8 PARAMETER");
+          END IF;
+     END PROC8;
+
+BEGIN
+     TEST ("C61009A", "CHECK USE OF STATIC EXPRESSIONS, CONSTANT " &
+                      "NAMES, ATTRIBUTE NAMES, VARIABLES, USER- " &
+                      "DEFINED OPERATORS, USER-DEFINED FUNCTIONS " &
+                      "DEREFERENCED ACCESSES, AND ALLOCATORS IN " &
+                      "THE FORMAL PART OF A SUBPROGRAM SPECIFICATION");
+
+     PROC1;
+     PROC2;
+     PROC3;
+     PROC4;
+     PROC5;
+     PROC6;
+     PROC7;
+     PROC8;
+
+     RESULT;
+
+END C61009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c61010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c61010a.ada
new file mode 100644
index 000000000..ab35f4d46
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c61010a.ada
@@ -0,0 +1,246 @@
+-- C61010A.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 IN OR IN OUT FORMAL PARAMETER CAN BE DECLARED WITH A
+-- LIMITED PRIVATE TYPE OR A LIMITED COMPOSITE TYPE.
+
+-- DAS  1/22/81
+-- JRK  1/20/84  TOTALLY REVISED.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C61010A IS
+
+     PACKAGE PKG IS
+
+          TYPE ITYPE IS LIMITED PRIVATE;
+
+          PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
+
+          PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
+                                  M : STRING);
+
+          PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER);
+
+          SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
+          TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
+
+          PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+                                S : STRING; M : STRING);
+
+          PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
+                                   I : INTEGER; S : STRING;
+                                   M : STRING);
+
+          PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
+                            S : STRING);
+
+     PRIVATE
+
+          TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
+
+          TYPE VRTYPE (C : INT_0_20 := 20) IS
+               RECORD
+                    I : INTEGER;
+                    S : STRING (1 .. C);
+               END RECORD;
+
+     END PKG;
+
+     USE PKG;
+
+     I1 : ITYPE;
+
+     TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
+
+     A1 : ATYPE;
+
+     VR1 : VRTYPE;
+
+     D : CONSTANT INT_0_20 := 10;
+
+     TYPE RTYPE IS
+          RECORD
+               J : ITYPE;
+               R : VRTYPE (D);
+          END RECORD;
+
+     R1 : RTYPE;
+
+     PACKAGE BODY PKG IS
+
+          PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
+          BEGIN
+               IF INTEGER (X) /= V THEN
+                    FAILED ("WRONG SCALAR VALUE - " & M);
+               END IF;
+          END LOOK_IN_I;
+
+          PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
+                                  M : STRING) IS
+          BEGIN
+               IF INTEGER (X) /= V THEN
+                    FAILED ("WRONG SCALAR VALUE - " & M);
+               END IF;
+          END LOOK_INOUT_I;
+
+          PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER) IS
+          BEGIN
+               X := ITYPE (IDENT_INT (V));
+          END SET_I;
+
+          PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+                                S : STRING; M : STRING) IS
+          BEGIN
+               IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
+                    FAILED ("WRONG COMPOSITE VALUE - " & M);
+               END IF;
+          END LOOK_IN_VR;
+
+          PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
+                                   I : INTEGER; S : STRING;
+                                   M : STRING) IS
+          BEGIN
+               IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
+                    FAILED ("WRONG COMPOSITE VALUE - " & M);
+               END IF;
+          END LOOK_INOUT_VR;
+
+          PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
+                            S : STRING) IS
+          BEGIN
+               X := (IDENT_INT(C), IDENT_INT(I), IDENT_STR(S));
+          END SET_VR;
+
+     BEGIN
+          I1 := ITYPE (IDENT_INT(2));
+
+          FOR I IN A1'RANGE LOOP
+               A1 (I) := ITYPE (3 + IDENT_INT(I));
+          END LOOP;
+
+          VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
+
+          R1.J := ITYPE (IDENT_INT(6));
+          R1.R := (IDENT_INT(D), IDENT_INT(19),
+                   IDENT_STR("ABCDEFGHIJ"));
+     END PKG;
+
+     PROCEDURE CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
+     BEGIN
+          LOOK_IN_I (X, V, M);
+     END CHECK_IN_I;
+
+     PROCEDURE CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
+                              NV : INTEGER; M : STRING) IS
+     BEGIN
+          LOOK_INOUT_I (X, OV, M & " - A");
+          SET_I (X, NV);
+          LOOK_INOUT_I (X, NV, M & " - B");
+          LOOK_IN_I (X, NV, M & " - C");
+     END CHECK_INOUT_I;
+
+     PROCEDURE CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) IS
+     BEGIN
+          FOR I IN X'RANGE LOOP
+               LOOK_IN_I (X(I), V+I, M & " -" & INTEGER'IMAGE (I));
+          END LOOP;
+     END CHECK_IN_A;
+
+     PROCEDURE CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
+                              NV : INTEGER; M : STRING) IS
+     BEGIN
+          FOR I IN X'RANGE LOOP
+               LOOK_INOUT_I (X(I), OV+I, M & " - A" &
+                                         INTEGER'IMAGE (I));
+               SET_I (X(I), NV+I);
+               LOOK_INOUT_I (X(I), NV+I, M & " - B" &
+                                         INTEGER'IMAGE (I));
+               LOOK_IN_I (X(I), NV+I, M & " - C" & INTEGER'IMAGE (I));
+          END LOOP;
+     END CHECK_INOUT_A;
+
+     PROCEDURE CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+                            S : STRING; M : STRING) IS
+     BEGIN
+          LOOK_IN_VR (X, C, I, S, M);
+     END CHECK_IN_VR;
+
+     PROCEDURE CHECK_INOUT_VR (X : IN OUT VRTYPE;
+                               OC : INTEGER; OI : INTEGER; OS : STRING;
+                               NC : INTEGER; NI : INTEGER; NS : STRING;
+                               M : STRING) IS
+     BEGIN
+          LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
+          SET_VR (X, NC, NI, NS);
+          LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
+          LOOK_IN_VR (X, NC, NI, NS, M & " - C");
+     END CHECK_INOUT_VR;
+
+     PROCEDURE CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
+                           I : INTEGER; S : STRING; M : STRING) IS
+     BEGIN
+          LOOK_IN_I (X.J, J, M & " - A");
+          LOOK_IN_VR (X.R, C, I, S, M & " - B");
+     END CHECK_IN_R;
+
+     PROCEDURE CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
+                              OC : INTEGER; OI : INTEGER; OS : STRING;
+                              NJ : INTEGER;
+                              NC : INTEGER; NI : INTEGER; NS : STRING;
+                              M : STRING) IS
+     BEGIN
+          LOOK_INOUT_I (X.J, OJ, M & " - A");
+          LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
+          SET_I (X.J, NJ);
+          SET_VR (X.R, NC, NI, NS);
+          LOOK_INOUT_I (X.J, NJ, M & " - C");
+          LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
+          LOOK_IN_I (X.J, NJ, M & " - E");
+          LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
+     END CHECK_INOUT_R;
+
+BEGIN
+     TEST ("C61010A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
+                      "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
+
+     CHECK_IN_I (I1, 2, "IN I");
+
+     CHECK_INOUT_I (I1, 2, 5, "INOUT I");
+
+     CHECK_IN_A (A1, 3, "IN A");
+
+     CHECK_INOUT_A (A1, 3, 17, "INOUT A");
+
+     CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
+
+     CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
+                     "INOUT VR");
+
+     CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
+
+     CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5, "ZYXWVUTSRQ",
+                    "INOUT R");
+
+     RESULT;
+END C61010A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62002a.ada
new file mode 100644
index 000000000..f15bca7d2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62002a.ada
@@ -0,0 +1,190 @@
+-- C62002A.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 COMPONENTS OF ACCESS IN PARAMETERS CAN BE USED AS THE
+--   TARGET OF AN ASSIGNMENT STATEMENT OR AS AN ACTUAL PARAMETER OF
+--   ANY MODE.  SUBTESTS ARE:
+--        (A) INTEGER ACCESS TYPE.
+--        (B) ARRAY ACCESS TYPE.
+--        (C) RECORD ACCESS TYPE.
+
+-- DAS  1/23/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C62002A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST ("C62002A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS" &
+                      " MAY BE USED IN ASSIGNMENT CONTEXTS");
+
+     --------------------------------------------------
+
+     DECLARE   -- (A)
+
+          TYPE PTRINT IS ACCESS INTEGER;
+          PI   : PTRINT;
+
+          PROCEDURE PROCA (PI : IN PTRINT) IS
+
+               PROCEDURE PROCA1 (I : OUT INTEGER) IS
+               BEGIN
+                    I := 7;
+               END PROCA1;
+
+               PROCEDURE PROCA2 (I : IN OUT INTEGER) IS
+               BEGIN
+                    I := I + 1;
+               END PROCA2;
+          BEGIN
+
+               PROCA1 (PI.ALL);
+               PROCA2 (PI.ALL);
+               PI.ALL := PI.ALL + 1;
+               IF (PI.ALL /= 9) THEN
+                    FAILED ("ASSIGNMENT TO COMPONENT OF INTEGER" &
+                            " ACCESS PARAMETER FAILED");
+               END IF;
+          END PROCA;
+
+     BEGIN     -- (A)
+
+          PI := NEW INTEGER '(0);
+          PROCA (PI);
+
+     END;      -- (A)
+
+     ---------------------------------------------
+
+     DECLARE   -- (B)
+
+          TYPE TBL IS ARRAY (1..3) OF INTEGER;
+          TYPE PTRTBL IS ACCESS TBL;
+          PT   : PTRTBL;
+
+          PROCEDURE PROCB (PT : IN PTRTBL) IS
+
+               PROCEDURE PROCB1 (I : OUT INTEGER) IS
+               BEGIN
+                    I := 7;
+               END  PROCB1;
+
+               PROCEDURE PROCB2 (I : IN OUT INTEGER) IS
+               BEGIN
+                    I := I + 1;
+               END PROCB2;
+
+               PROCEDURE PROCB3 (T : OUT TBL) IS
+               BEGIN
+                    T := (1,2,3);
+               END PROCB3;
+
+               PROCEDURE PROCB4 (T : IN OUT TBL) IS
+               BEGIN
+                    T(3) := T(3) - 1;
+               END PROCB4;
+
+          BEGIN
+
+               PROCB3 (PT.ALL);         -- (1,2,3)
+               PROCB4 (PT.ALL);         -- (1,2,2)
+               PROCB1 (PT(2));          -- (1,7,2)
+               PROCB2 (PT(1));          -- (2,7,2)
+               PT(3) := PT(3) + 7;      -- (2,7,9)
+               IF (PT.ALL /= (2,7,9)) THEN
+                    FAILED ("ASSIGNMENT TO COMPONENT OF ARRAY" &
+                            " ACCESS PARAMETER FAILED");
+               END IF;
+          END PROCB;
+
+     BEGIN     -- (B)
+
+          PT := NEW TBL '(0,0,0);
+          PROCB (PT);
+
+     END;      -- (B)
+
+     ---------------------------------------------
+
+     DECLARE   -- (C)
+
+          TYPE REC IS
+               RECORD
+                    I1   : INTEGER;
+                    I2   : INTEGER;
+                    I3   : INTEGER;
+               END RECORD;
+          TYPE PTRREC IS ACCESS REC;
+          PR   : PTRREC;
+
+          PROCEDURE PROCC (PR : IN PTRREC) IS
+
+               PROCEDURE PROCC1 (I : OUT INTEGER) IS
+               BEGIN
+                    I := 7;
+               END  PROCC1;
+
+               PROCEDURE PROCC2 (I : IN OUT INTEGER) IS
+               BEGIN
+                    I := I + 1;
+               END PROCC2;
+
+               PROCEDURE PROCC3 (R : OUT REC) IS
+               BEGIN
+                    R := (1,2,3);
+               END PROCC3;
+
+               PROCEDURE PROCC4 (R : IN OUT REC) IS
+               BEGIN
+                    R.I3 := R.I3 - 1;
+               END PROCC4;
+
+          BEGIN
+
+               PROCC3 (PR.ALL);         -- (1,2,3)
+               PROCC4 (PR.ALL);         -- (1,2,2)
+               PROCC1 (PR.I2);          -- (1,7,2)
+               PROCC2 (PR.I1);          -- (2,7,2)
+               PR.I3 := PR.I3 + 7;      -- (2,7,9)
+               IF (PR.ALL /= (2,7,9)) THEN
+                    FAILED ("ASSIGNMENT TO COMPONENT OF RECORD" &
+                            " ACCESS PARAMETER FAILED");
+               END IF;
+          END PROCC;
+
+     BEGIN     -- (C)
+
+          PR := NEW REC '(0,0,0);
+          PROCC (PR);
+
+     END;      -- (C)
+
+     ---------------------------------------------
+
+     RESULT;
+
+END C62002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62003a.ada
new file mode 100644
index 000000000..e5ab95a19
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62003a.ada
@@ -0,0 +1,234 @@
+-- C62003A.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 SCALAR AND ACCESS PARAMETERS ARE COPIED.
+--   SUBTESTS ARE:
+--        (A) SCALAR PARAMETERS TO PROCEDURES.
+--        (B) SCALAR PARAMETERS TO FUNCTIONS.
+--        (C) ACCESS PARAMETERS TO PROCEDURES.
+--        (D) ACCESS PARAMETERS TO FUNCTIONS.
+
+-- DAS 01/14/80
+-- SPS 10/26/82
+-- CPP 05/25/84
+-- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+
+WITH REPORT;
+PROCEDURE C62003A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C62003A", "CHECK THAT SCALAR AND ACCESS PARAMETERS ARE " &
+                      "COPIED");
+
+     --------------------------------------------------
+
+     DECLARE  -- (A)
+
+          I    : INTEGER;
+          E    : EXCEPTION;
+
+          PROCEDURE P (PI : IN INTEGER;  PO : OUT INTEGER;
+                       PIO : IN OUT INTEGER) IS
+
+               TMP  : INTEGER;
+
+          BEGIN
+
+               TMP := PI;     -- SAVE VALUE OF PI AT PROC ENTRY.
+
+               PO := 10;
+               IF (PI /= TMP) THEN
+                    FAILED ("ASSIGNMENT TO SCALAR OUT " &
+                            "PARAMETER CHANGES THE VALUE OF " &
+                            "INPUT PARAMETER");
+                    TMP := PI;     -- RESET TMP FOR NEXT CASE.
+               END IF;
+
+               PIO := PIO + 100;
+               IF (PI /= TMP) THEN
+                    FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
+                            "PARAMETER CHANGES THE VALUE OF " &
+                            "INPUT PARAMETER");
+                    TMP := PI;     -- RESET TMP FOR NEXT CASE.
+               END IF;
+
+               I := I + 1;
+               IF (PI /= TMP) THEN
+                    FAILED ("ASSIGNMENT TO SCALAR ACTUAL " &
+                            "PARAMETER CHANGES THE VALUE OF " &
+                            "INPUT PARAMETER");
+               END IF;
+
+               RAISE E;  -- CHECK EXCEPTION HANDLING.
+          END P;
+
+     BEGIN  -- (A)
+          I := 0;   -- INITIALIZE I SO VARIOUS CASES CAN BE DETECTED.
+          P (I, I, I);
+          FAILED ("EXCEPTION NOT RAISED - A");
+     EXCEPTION
+          WHEN E =>
+               IF (I /= 1) THEN
+                    CASE I IS
+                         WHEN 11  =>
+                              FAILED ("OUT ACTUAL SCALAR PARAMETER " &
+                                      "CHANGED GLOBAL VALUE");
+                         WHEN 101 =>
+                              FAILED ("IN OUT ACTUAL SCALAR " &
+                                      "PARAMETER CHANGED GLOBAL VALUE");
+                         WHEN 111 =>
+                              FAILED ("OUT AND IN OUT ACTUAL SCALAR " &
+                                      "PARAMETERS CHANGED GLOBAL " &
+                                      "VALUE");
+                         WHEN OTHERS =>
+                              FAILED ("UNDETERMINED CHANGE TO GLOBAL " &
+                                      "VALUE");
+                    END CASE;
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - A");
+     END;  -- (A)
+
+     --------------------------------------------------
+
+     DECLARE  -- (B)
+
+          I,J  : INTEGER;
+
+          FUNCTION F (FI : IN INTEGER) RETURN INTEGER IS
+
+               TMP  : INTEGER := FI;
+
+          BEGIN
+
+               I := I + 1;
+               IF (FI /= TMP) THEN
+                    FAILED ("ASSIGNMENT TO SCALAR ACTUAL FUNCTION " &
+                            "PARAMETER CHANGES THE VALUE OF " &
+                            "INPUT PARAMETER");
+               END IF;
+
+               RETURN (100);
+          END F;
+
+     BEGIN  -- (B)
+          I := 100;
+          J := F(I);
+     END;  -- (B)
+
+     --------------------------------------------------
+
+     DECLARE  -- (C)
+
+          TYPE ACCTYPE IS ACCESS INTEGER;
+
+          I    : ACCTYPE;
+          E    : EXCEPTION;
+
+          PROCEDURE P (PI : IN ACCTYPE;  PO : OUT ACCTYPE;
+                       PIO : IN OUT ACCTYPE) IS
+
+               TMP  : ACCTYPE;
+
+          BEGIN
+
+               TMP := PI;     -- SAVE VALUE OF PI AT PROC ENTRY.
+
+               I := NEW INTEGER'(101);
+               IF (PI /= TMP) THEN
+                    FAILED ("ASSIGNMENT TO ACCESS ACTUAL " &
+                            "PARAMETER CHANGES THE VALUE OF " &
+                            "INPUT PARAMETER");
+                    TMP := PI;     -- RESET TMP FOR NEXT CASE.
+               END IF;
+
+               PO := NEW INTEGER'(1);
+               IF (PI /= TMP) THEN
+                    FAILED ("ASSIGNMENT TO ACCESS OUT " &
+                            "PARAMETER CHANGES THE VALUE OF " &
+                            "INPUT PARAMETER");
+                    TMP := PI;     -- RESET TMP FOR NEXT CASE.
+               END IF;
+
+               PIO := NEW INTEGER'(10);
+               IF (PI /= TMP) THEN
+                    FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
+                            "PARAMETER CHANGES THE VALUE OF " &
+                            "INPUT PARAMETER");
+               END IF;
+
+               RAISE E;  -- CHECK EXCEPTION HANDLING.
+          END P;
+
+     BEGIN  -- (C)
+          I := NEW INTEGER'(100);
+          P (I, I, I);
+          FAILED ("EXCEPTION NOT RAISED - C");
+     EXCEPTION
+          WHEN E =>
+               IF (I.ALL /= 101) THEN
+                    FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
+                            "PARAMETER VALUE CHANGED DESPITE " &
+                            "RAISED EXCEPTION");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - C");
+     END;  -- (C)
+
+     --------------------------------------------------
+
+     DECLARE  -- (D)
+
+          TYPE ACCTYPE IS ACCESS INTEGER;
+
+          I,J  : ACCTYPE;
+
+          FUNCTION F (FI : IN ACCTYPE) RETURN ACCTYPE IS
+
+               TMP  : ACCTYPE := FI;
+
+          BEGIN
+
+               I := NEW INTEGER;
+               IF (FI /= TMP) THEN
+                    FAILED ("ASSIGNMENT TO ACCESS ACTUAL FUNCTION " &
+                            "PARAMETER CHANGES THE VALUE OF " &
+                            "INPUT PARAMETER");
+               END IF;
+
+               RETURN (NULL);
+          END F;
+
+     BEGIN  -- (D)
+          I := NULL;
+          J := F(I);
+     END;  -- (D)
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C62003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62003b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62003b.ada
new file mode 100644
index 000000000..f03c774de
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62003b.ada
@@ -0,0 +1,301 @@
+-- C62003B.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 PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
+--   PASSED BY COPY.
+--   SUBTESTS ARE:
+--        (A) PRIVATE SCALAR PARAMETERS TO PROCEDURES.
+--        (B) PRIVATE SCALAR PARAMETERS TO FUNCTIONS.
+--        (C) PRIVATE ACCESS PARAMETERS TO PROCEDURES.
+--        (D) PRIVATE ACCESS PARAMETERS TO FUNCTIONS.
+
+-- CPP 05/25/84
+-- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C62003B IS
+
+BEGIN
+     TEST("C62003B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
+                     "PARAMETERS ARE COPIED");
+
+     ---------------------------------------------------
+
+A_B: DECLARE
+
+          PACKAGE SCALAR_PKG IS
+
+               TYPE T IS PRIVATE;
+               C0 : CONSTANT T;
+               C1 : CONSTANT T;
+               C10 : CONSTANT T;
+               C100 : CONSTANT T;
+
+               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
+               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;
+
+          PRIVATE
+               TYPE T IS NEW INTEGER;
+               C0 : CONSTANT T := 0;
+               C1 : CONSTANT T := 1;
+               C10 : CONSTANT T := 10;
+               C100 : CONSTANT T := 100;
+
+          END SCALAR_PKG;
+
+
+          PACKAGE BODY SCALAR_PKG IS
+
+               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
+               BEGIN     -- "+"
+                    RETURN T(INTEGER(OLD) + INTEGER(INCREMENT));
+               END "+";
+
+               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
+               BEGIN     -- CONVERT
+                    RETURN INTEGER(OLD_PRIVATE);
+               END CONVERT;
+
+          END SCALAR_PKG;
+
+          USE SCALAR_PKG;
+
+     ---------------------------------------------------
+
+     BEGIN     -- A_B
+
+      A : DECLARE
+
+               I : T;
+               E : EXCEPTION;
+
+               PROCEDURE P (PI : IN T; PO : OUT T; PIO : IN OUT T) IS
+
+                    TEMP : T;
+
+               BEGIN  -- P
+
+                    TEMP := PI;    -- SAVE VALUE OF PI AT PROC ENTRY.
+
+                    PO := C10;
+                    IF (PI /= TEMP) THEN
+                         FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) OUT " &
+                                 "PARAMETER CHANGES THE VALUE OF " &
+                                 "INPUT PARAMETER");
+                         TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
+                    END IF;
+
+                    PIO := PIO + C100;
+                    IF (PI /= TEMP) THEN
+                         FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) IN " &
+                                 "OUT PARAMETER CHANGES THE VALUE OF " &
+                                 "INPUT PARAMETER");
+                         TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
+                    END IF;
+
+                    I := I + C1;
+                    IF (PI /= TEMP) THEN
+                         FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) " &
+                                 "ACTUAL PARAMETER CHANGES THE " &
+                                 "VALUE OF INPUT PARAMETER");
+                    END IF;
+
+                    RAISE E;  -- CHECK EXCEPTION HANDLING.
+               END P;
+
+          BEGIN  -- A
+               I := C0;  -- INITIALIZE I SO VARIOUS CASES CAN BE
+                         -- DETECTED.
+               P (I, I, I);
+               FAILED ("EXCEPTION NOT RAISED - A");
+          EXCEPTION
+               WHEN E =>
+                    IF (I /= C1) THEN
+                         CASE CONVERT(I) IS
+                              WHEN 11 =>
+                                   FAILED ("OUT ACTUAL PRIVATE " &
+                                           "(SCALAR) PARAMETER " &
+                                           "CHANGED GLOBAL VALUE");
+                              WHEN 101 =>
+                                   FAILED ("IN OUT ACTUAL PRIVATE " &
+                                           "(SCALAR) PARAMETER " &
+                                           "CHANGED GLOBAL VALUE");
+                              WHEN 111 =>
+                                   FAILED ("OUT AND IN OUT ACTUAL " &
+                                           "PRIVATE (SCALAR) " &
+                                           "PARAMETER CHANGED " &
+                                           "GLOBAL VALUE");
+                              WHEN OTHERS =>
+                                   FAILED ("UNDETERMINED CHANGE TO " &
+                                           "GLOBAL VALUE");
+                         END CASE;
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - A");
+          END A;
+
+     ---------------------------------------------------
+
+      B : DECLARE
+
+               I, J : T;
+
+               FUNCTION F (FI : IN T) RETURN T IS
+
+                    TEMP : T := FI;  -- SAVE VALUE OF FI AT FN ENTRY.
+
+               BEGIN  -- F
+
+                    I := I + C1;
+                    IF (FI /= TEMP) THEN
+                         FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) " &
+                                 "ACTUAL FUNCTION PARAMETER CHANGES " &
+                                 "THE VALUE OF INPUT PARAMETER ");
+                    END IF;
+
+                    RETURN C0;
+               END F;
+
+          BEGIN  -- B
+               I := C0;
+               J := F(I);
+          END B;
+
+     END A_B;
+
+     ---------------------------------------------------
+
+C_D: DECLARE
+
+          PACKAGE ACCESS_PKG IS
+
+               TYPE T IS PRIVATE;
+               C_NULL : CONSTANT T;
+               C1 : CONSTANT T;
+               C10 : CONSTANT T;
+               C100 : CONSTANT T;
+               C101 : CONSTANT T;
+
+          PRIVATE
+               TYPE T IS ACCESS INTEGER;
+               C_NULL : CONSTANT T := NULL;
+               C1 : CONSTANT T := NEW INTEGER'(1);
+               C10 : CONSTANT T := NEW INTEGER'(10);
+               C100 : CONSTANT T := NEW INTEGER'(100);
+               C101 : CONSTANT T := NEW INTEGER'(101);
+
+          END ACCESS_PKG;
+
+          USE ACCESS_PKG;
+
+     ---------------------------------------------------
+
+     BEGIN     -- C_D;
+
+      C : DECLARE
+
+               I : T;
+               E : EXCEPTION;
+               PROCEDURE P (PI : IN T; PO : OUT T; PIO : IN OUT T) IS
+
+                    TEMP : T;
+
+               BEGIN     -- P
+
+                    TEMP := PI;    -- SAVE VALUE OF PI AT PROC ENTRY.
+
+                    I := C101;
+                    IF (PI /= TEMP) THEN
+                         FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) " &
+                                 "ACTUAL VARIABLE CHANGES THE VALUE " &
+                                 "OF INPUT PARAMETER");
+                         TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
+                    END IF;
+
+                    PO := C1;
+                    IF (PI /= TEMP) THEN
+                         FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) OUT " &
+                                 "PARAMETER CHANGES THE VALUE OF " &
+                                 "INPUT PARAMETER");
+                         TEMP := PI;    -- RESET TEMP FOR NEXT CASE.
+                    END IF;
+
+                    PIO := C10;
+                    IF (PI /= TEMP) THEN
+                         FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) IN " &
+                                 "OUT PARAMETER CHANGES THE VALUE " &
+                                 "OF INPUT PARAMETER");
+                    END IF;
+
+                    RAISE E;  -- CHECK EXCEPTION HANDLING.
+               END P;
+
+          BEGIN     -- C
+               I := C100;
+               P (I, I, I);
+               FAILED ("EXCEPTION NOT RAISED - C");
+          EXCEPTION
+               WHEN E =>
+                    IF (I /= C101) THEN
+                         FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
+                                 "PARAMETER VALUE CHANGED DESPITE " &
+                                 "RAISED EXCEPTION");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - C");
+          END C;
+
+     ---------------------------------------------------
+
+      D : DECLARE
+
+               I, J : T;
+
+               FUNCTION F (FI : IN T) RETURN T IS
+
+                    TEMP : T := FI;     -- SAVE VALUE OF FI AT FN ENTRY.
+
+               BEGIN     -- F
+                    I := C100;
+                    IF (FI /= TEMP) THEN
+                         FAILED ("ASSIGNMENT TO PRIVATE " &
+                                 "(ACCESS) ACTUAL FUNCTION " &
+                                 "PARAMETER CHANGES THE VALUE " &
+                                 "OF INPUT PARAMETER");
+                    END IF;
+                    RETURN C_NULL;
+               END F;
+
+           BEGIN     -- D
+               I := C_NULL;
+               J := F(I);
+          END D;
+
+     END C_D;
+
+     ---------------------------------------------------
+
+     RESULT;
+
+END C62003B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62004a.ada
new file mode 100644
index 000000000..408a6cd6f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62004a.ada
@@ -0,0 +1,64 @@
+-- C62004A.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 ALIASING IS PERMITTED FOR PARAMETERS OF COMPOSITE TYPES,
+--   E.G., THAT A MATRIX ADDITION PROCEDURE CAN BE CALLED WITH THREE
+--   IDENTICAL ARGUMENTS.  (NOTE: ALIASING MAY NOT WORK FOR ARGUMENTS
+--   TO ALL SUBROUTINES SINCE PARAMETER PASSING IS IMPLEMENTATION
+--   DEPENDENT.  HOWEVER, THIS TEST IS NOT ERRONEOUS.)
+
+-- DAS  1/26/81
+
+WITH REPORT;
+PROCEDURE C62004A IS
+
+     USE REPORT;
+
+     TYPE MATRIX IS ARRAY (1..3,1..3) OF INTEGER;
+
+     A    : MATRIX  := ((1,2,3),(4,5,6),(7,8,9));
+
+     PROCEDURE MAT_ADD (X,Y : IN MATRIX; SUM : OUT MATRIX) IS
+     BEGIN
+          FOR I IN 1..3 LOOP
+               FOR J IN 1..3 LOOP
+                    SUM(I,J) := X(I,J) + Y(I,J);
+               END LOOP;
+          END LOOP;
+     END MAT_ADD;
+
+BEGIN
+
+     TEST ("C62004A", "CHECK THAT ALIASING IS PERMITTED FOR" &
+                      " PARAMETERS OF COMPOSITE TYPES");
+
+     MAT_ADD (A, A, A);
+
+     IF (A /= ((2,4,6),(8,10,12),(14,16,18))) THEN
+          FAILED ("THE RESULT OF THE MATRIX ADDITION IS INCORRECT");
+     END IF;
+
+     RESULT;
+
+END C62004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62006a.ada
new file mode 100644
index 000000000..c3ca244d4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c62006a.ada
@@ -0,0 +1,70 @@
+-- C62006A.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 DISCRIMINANTS OF AN OUT FORMAL PARAMETER, AS WELL AS
+-- THE DISCRIMINANTS OF THE SUBCOMPONENTS OF AN OUT FORMAL PARAMETER,
+-- MAY BE READ INSIDE THE PROCEDURE.
+
+-- SPS 2/17/84
+
+WITH REPORT; USE REPORT;
+PROCEDURE C62006A IS
+BEGIN
+
+     TEST ("C62006A", "CHECK THAT THE DISCRIMINANTS OF AN OUT FORMAL " &
+           "PARAMETER CAN BE READ INSIDE THE PROCEDURE");
+
+     DECLARE
+
+          TYPE R1 (D1 : INTEGER) IS RECORD
+               NULL;
+          END RECORD;
+
+          TYPE R2 (D2 : POSITIVE) IS RECORD
+               C : R1 (2);
+          END RECORD;
+
+          R : R2 (5);
+
+          PROCEDURE P (REC : OUT R2) IS
+          BEGIN
+
+               IF REC.D2 /= 5 THEN
+                    FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT OF" &
+                            " OUT PARAMETER");
+               END IF;
+
+               IF REC.C.D1 /= 2 THEN
+                    FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                            " OF THE SUBCOMPONENT OF AN OUT PARAMETER");
+               END IF;
+          END P;
+
+     BEGIN
+          P (R);
+     END;
+
+     RESULT;
+
+END C62006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c631001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c631001.a
new file mode 100644
index 000000000..f8b0c775b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c631001.a
@@ -0,0 +1,134 @@
+-- C631001.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 different forms of a name are used in the default 
+--      expression of a discriminant part, the selector may be an operator
+--      symbol or a character literal.
+--
+-- TEST DESCRIPTION:
+--      This transition test defines private types where their selectors in
+--      the default expression of the discriminant parts at the full type 
+--      declarations are an operator and a literal, respectively. 
+--      The test also declares procedures that use an operator and a literal
+--      as selectors in the formal parts. 
+--
+--      Inspired by B63102A.ADA.
+--
+--
+-- CHANGE HISTORY:
+--      25 Mar 96   SAIC    Initial version for ACVC 2.1.
+--      26 Feb 97   PWB.CTA Removed use of function called before elaboration
+--!
+
+with Report;
+
+procedure C631001 is
+
+   package C631001_0 is 
+
+      type Int_Type is range 1 .. 100;
+      type Enu_Type is ('A', 'B', 'C', 'D');
+
+      type Private_Enu (D : Enu_Type := 'B')       is private;
+
+      function "+" (X, Y : Int_Type) return Int_Type;
+
+      procedure Int_Proc (P1 : in  Int_Type := "+" (10, 15);
+                          P2 : out Int_Type);
+                                    
+      procedure Enu_Proc (P1 : in  Enu_Type := 'C';
+                          P2 : out Enu_Type);
+
+   private
+
+      type Private_Enu (D : Enu_Type := C631001_0.'B') is              -- OK.
+        record
+           C2 : Enu_Type := D;
+        end record;
+
+      -----------------------------------------------------------------
+      PE_Obj  : C631001_0.Private_Enu;
+
+   end C631001_0;
+
+     --==================================================================--
+
+   package body C631001_0 is 
+
+      function "+" (X, Y : Int_Type) return Int_Type is
+      begin
+         return 10;
+      end "+";
+
+      -----------------------------------------------------------------
+      procedure Int_Proc (P1 : in  Int_Type := C631001_0."+" (10, 15); -- OK.
+                          P2 : out Int_Type) is
+                                    
+      begin
+         P2 := P1;
+      end Int_Proc;
+
+      -----------------------------------------------------------------
+      procedure Enu_Proc (P1 : in  Enu_Type := C631001_0.'C';          -- OK.
+                          P2 : out Enu_Type) is
+      begin
+         P2 := P1;
+      end Enu_Proc;
+
+      -----------------------------------------------------------------
+
+   end C631001_0;
+
+   ---------------------------------------------------------------------------
+   Int_Obj : C631001_0.Int_Type := 50;
+   Enu_Obj : C631001_0.Enu_Type := C631001_0.'D';
+
+   -- Direct visibility to operator symbols
+   use type C631001_0.Int_Type;
+   use type C631001_0.Enu_Type;
+
+begin  -- main
+
+   Report.Test ("C631001", "Check that if different forms of a name are " &
+                "used in the default expression of a discriminant part, " &
+                "the selector may be an operator symbol or a character "  &
+                "literal");
+
+   C631001_0.Int_Proc (P2 => Int_Obj);
+
+   if Int_Obj /= 10 then
+     Report.Failed ("Wrong result for Int_Obj");
+   end if;
+
+   C631001_0.Enu_Proc (P2 => Enu_Obj);
+
+   if Enu_Obj /= 'C' then
+     Report.Failed ("Wrong result for Enu_Obj");
+   end if;
+
+   Report.Result;
+
+end C631001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c640001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c640001.a
new file mode 100644
index 000000000..8e259162e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c640001.a
@@ -0,0 +1,334 @@
+-- C640001.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 prefix of a subprogram call with an actual parameter
+--      part may be an implicit dereference of an access-to-subprogram value.
+--      Check that, for an access-to-subprogram type whose designated profile
+--      contains parameters of a tagged generic formal type, an access-to-
+--      subprogram value may designate dispatching and non-dispatching
+--      operations, and that dereferences of such a value call the appropriate
+--      subprogram.
+--
+-- TEST DESCRIPTION:
+--      The test declares a tagged type (Table) with a dispatching operation
+--      (Clear), as well as a derivative (Table2) which overrides that
+--      operation. A subprogram with the same name and profile as Clear is
+--      declared in a separate package -- it is therefore not a dispatching
+--      operation of Table. For the purposes of the test, each version of Clear
+--      modifies the components of its parameter in a unique way.
+--
+--      Additionally, an operation (Reset) of type Table is declared which
+--      makes a re-dispatching call to Clear, i.e.,
+--
+--         procedure Reset (A: in out Table) is
+--         begin
+--            ...
+--            Clear (Table'Class(A));  -- Re-dispatch based on tag of actual.
+--            ...
+--         end Reset;   
+--
+--      An access-to-subprogram type is declared within a generic package,
+--      with a designated profile which declares a parameter of a generic
+--      formal tagged private type.
+--
+--      The generic is instantiated with type Table. The instance defines an
+--      array of access-to-subprogram values (which represents a table of
+--      operations to be performed sequentially on a single operand).
+--      Access values designating the dispatching version of Clear, the
+--      non-dispatching version of Clear, and Reset (which re-dispatches to
+--      Clear) are placed in this array.
+--
+--      In the instance, each subprogram in the array is called by implicitly
+--      dereferencing the corresponding access value. For the dispatching and
+--      non-dispatching versions of Clear, the actual parameter passed is of
+--      type Table. For Reset, the actual parameter passed is a view conversion
+--      of an object of type Table2 to type Table, i.e., Table(Table2_Obj).
+--      Since the tag of the operand never changes, the call to Clear within
+--      Reset should execute Table2's version of Clear.
+--
+--      The main program verifies that the appropriate version of Clear is
+--      called in each case, by checking that the components of the actual are
+--      updated as expected.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C640001_0 is
+
+   -- Data type artificial for testing purposes.
+
+   Row_Len : constant := 10;
+
+   T : constant Boolean := True;
+   F : constant Boolean := False;
+
+   type Row_Type is array (1 .. Row_Len) of Boolean;
+
+   function Is_True  (A : in Row_Type) return Boolean;
+   function Is_False (A : in Row_Type) return Boolean;
+
+
+   Init : constant Row_Type := (T, F, T, F, T, F, T, F, T, F);
+
+   type Table is tagged record                  -- Tagged type.
+      Row1 : Row_Type := Init;
+      Row2 : Row_Type := Init;
+   end record;
+
+   procedure Clear (A : in out Table);          -- Dispatching operation.
+
+   procedure Reset (A : in out Table);          -- Re-dispatching operation.
+
+   -- ...Other operations.
+
+
+   type Table2 is new Table with null record;   -- Extension of Table (but
+                                                -- structurally identical).
+
+   procedure Clear (A : in out Table2);         -- Overrides parent's op.
+
+   -- ...Other operations.
+
+
+end C640001_0;
+
+
+     --===================================================================--
+
+
+package body C640001_0 is
+
+   function Is_True (A : in Row_Type) return Boolean is
+   begin
+      for I in A'Range loop
+         if A(I) /= True then                  -- Return true if all elements
+            return False;                      -- of A are True.
+         end if;
+      end loop;
+      return True;
+   end Is_True;
+
+
+   function Is_False (A : in Row_Type) return Boolean is
+   begin
+      return A = Row_Type'(others => False);   -- Return true if all elements
+   end Is_False;                               -- of A are False.
+
+
+   procedure Clear (A : in out Table) is
+   begin
+      for I in Row_Type'Range loop             -- This version of Clear sets
+         A.Row1(I) := False;                   -- the elements of Row1 only
+      end loop;                                -- to False.
+   end Clear;
+
+
+   procedure Reset (A : in out Table) is
+   begin
+      Clear (Table'Class(A));                  -- Redispatch to appropriate
+      -- ... Other "reset" activities.         -- version of Clear.
+   end Reset;
+
+
+   procedure Clear (A : in out Table2) is
+   begin
+      for I in Row_Type'Range loop             -- This version of Clear sets
+         A.Row1(I) := True;                    -- the elements of Row1 only
+      end loop;                                -- to True.
+   end Clear;
+
+
+end C640001_0;
+
+
+     --===================================================================--
+
+
+with C640001_0;
+package C640001_1 is
+
+   procedure Clear (T : in out C640001_0.Table);  -- Non-dispatching operation.
+
+end C640001_1;
+
+
+     --===================================================================--
+
+
+package body C640001_1 is
+
+   procedure Clear (T : in out C640001_0.Table) is
+   begin
+      for I in C640001_0.Row_Type'Range loop   -- This version of Clear sets
+         T.Row2(I) := True;                    -- the elements of Row2 only
+      end loop;                                -- to True.
+   end Clear;
+
+end C640001_1;
+
+
+     --===================================================================--
+
+
+-- This unit represents a support package for table-driven processing of
+-- data objects. Process_Operand performs a set of operations are performed
+-- sequentially on a single operand. Note that parameters are provided to
+-- specify which subset of operations in the operations table are to be
+-- performed (ordinarily these might be omitted, but the test requires that
+-- each operation be called individually for a single operand).
+
+generic
+   type Tag is tagged private;
+package C640001_2 is
+
+   type Proc_Ptr is access procedure (P: in out Tag);
+
+   type Op_List is private;
+
+   procedure Add_Op (Op   : in     Proc_Ptr;                -- Add operation to
+                     List : in out Op_List);                -- to list of ops.
+
+   procedure Process_Operand (Operand  : in out Tag;        -- Execute a subset
+                              List     : in     Op_List;    -- of a list of
+                              First_Op : in     Positive;   -- operations using
+                              Last_Op  : in     Positive);  -- a given operand.
+
+   -- ...Other operations.
+
+private
+   type Op_Array is array (1 .. 3) of Proc_Ptr;
+
+   type Op_List is record
+      Top : Natural := 0;
+      Ops : Op_Array;
+   end record;
+end C640001_2;
+
+
+     --===================================================================--
+
+
+package body C640001_2 is
+
+   procedure Add_Op (Op   : in     Proc_Ptr;
+                     List : in out Op_List) is
+   begin
+      List.Top := List.Top + 1;  -- Artificial; no Constraint_Error protection.
+      List.Ops(List.Top) := Op;
+   end Add_Op;
+
+
+   procedure Process_Operand (Operand  : in out Tag;
+                              List     : in     Op_List;
+                              First_Op : in     Positive;
+                              Last_Op  : in     Positive) is
+   begin
+      for I in First_Op .. Last_Op loop
+         List.Ops(I)(Operand);       -- Implicit dereference of an
+      end loop;                      -- access-to-subprogram value.
+   end Process_Operand;
+
+end C640001_2;
+
+
+     --===================================================================--
+
+
+with C640001_0;
+with C640001_1;
+with C640001_2;
+
+with Report;
+procedure C640001 is
+
+   package Table_Support is new C640001_2 (C640001_0.Table);
+
+   Sub_Ptr   : Table_Support.Proc_Ptr;
+   My_List   : Table_Support.Op_List;
+   My_Table1 : C640001_0.Table;             -- Initial values of both Row1 &
+                                            -- Row2 are (T,F,T,F,T,F,T,F,T,F).
+   My_Table2 : C640001_0.Table2;            -- Initial values of both Row1 &
+                                            -- Row2 are (T,F,T,F,T,F,T,F,T,F).
+begin
+   Report.Test ("C640001", "Check that, for an access-to-subprogram type " &
+                           "whose designated profile contains parameters " &
+                           "of a tagged generic formal type, an access-" &
+                           "to-subprogram value may designate dispatching " &
+                           "and non-dispatching operations");
+
+   --
+   -- Add subprogram access values to list:
+   --
+
+   Sub_Ptr := C640001_0.Clear'Access;       -- Designates dispatching op.
+   Table_Support.Add_Op (Sub_Ptr, My_List); -- (1st operation on My_List).
+
+   Sub_Ptr := C640001_1.Clear'Access;       -- Designates non-dispatching op.
+   Table_Support.Add_Op (Sub_Ptr, My_List); -- (2nd operation on My_List).
+
+   Sub_Ptr := C640001_0.Reset'Access;       -- Designates re-dispatching op.
+   Table_Support.Add_Op (Sub_Ptr, My_List); -- (3rd operation on My_List).
+
+
+   --
+   -- Call dispatching operation:
+   --
+
+   Table_Support.Process_Operand (My_Table1, My_List, 1, 1);   -- Call 1st op.
+   
+   if not C640001_0.Is_False (My_Table1.Row1) then
+      Report.Failed ("Wrong result after calling dispatching operation");
+   end if;
+
+
+   --
+   -- Call non-dispatching operation:
+   --
+
+   Table_Support.Process_Operand (My_Table1, My_List, 2, 2);   -- Call 2nd op.
+   
+   if not C640001_0.Is_True (My_Table1.Row2) then
+      Report.Failed ("Wrong result after calling non-dispatching operation");
+   end if;
+
+
+   --
+   -- Call re-dispatching operation:
+   --
+
+   Table_Support.Process_Operand (C640001_0.Table(My_Table2),  -- View conv.
+                                  My_List, 3, 3);              -- Call 3rd op.
+   
+   if not C640001_0.Is_True (My_Table2.Row1) then
+      Report.Failed ("Wrong result after calling re-dispatching operation");
+   end if;
+
+
+   Report.Result;
+end C640001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64002b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64002b.ada
new file mode 100644
index 000000000..2f71f32d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64002b.ada
@@ -0,0 +1,65 @@
+-- C64002B.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 PARAMETERLESS SUBPROGRAMS CAN BE CALLED WITH APPROPRIATE
+--   NOTATION.
+
+-- DAS  1/27/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C64002B IS
+
+     USE REPORT;
+
+     I    : INTEGER := 1;
+
+     FUNCTION F0 RETURN INTEGER IS
+     BEGIN
+          RETURN 7;
+     END F0;
+
+     PROCEDURE P0 IS
+     BEGIN
+          I := 15;
+     END P0;
+
+BEGIN
+
+     TEST ("C64002B", "CHECK THAT PARAMETERLESS SUBPROGRAMS CAN BE" &
+                      " CALLED");
+
+     IF (F0 /= 7) THEN
+          FAILED ("PARAMETERLESS FUNCTION CALL RETURNS BAD VALUE");
+     END IF;
+
+     P0;
+     IF (I /= 15) THEN
+          FAILED ("PARAMETERLESS PROCEDURE CALL YIELDS INCORRECT" &
+                  " RESULT");
+     END IF;
+
+     RESULT;
+
+END C64002B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64004g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64004g.ada
new file mode 100644
index 000000000..005a3a742
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64004g.ada
@@ -0,0 +1,102 @@
+-- C64004G.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 CALLS TO SUBPROGRAMS HAVING AT LEAST ONE DEFAULT
+--   PARAMETER, THE CORRECT ASSOCIATION IS MADE BETWEEN ACTUAL AND
+--   FORMAL PARAMETERS.
+
+-- DAS  1/27/81
+
+
+WITH REPORT;
+PROCEDURE C64004G IS
+
+     USE REPORT;
+
+     Y1,Y2,Y3  : INTEGER := 0;
+     O1,O2     : INTEGER := 0;
+
+     PROCEDURE P (I1: INTEGER; I2: INTEGER := 2; I3: INTEGER := 3;
+                  O1,O2,O3: OUT INTEGER) IS
+     BEGIN
+          O1 := I1;
+          O2 := I2;
+          O3 := I3;
+     END P;
+
+     FUNCTION F (I1: INTEGER := 1; I2: INTEGER) RETURN INTEGER IS
+     BEGIN
+          C64004G.O1 := I1;
+          C64004G.O2 := I2;
+          RETURN 1;
+     END F;
+
+BEGIN
+
+     TEST ("C64004G", "CHECK ASSOCIATIONS BETWEEN ACTUAL AND FORMAL" &
+                      " PARAMETERS (HAVING DEFAULT VALUES)");
+
+     P (I1=>11, I2=>12, I3=>13, O1=>Y1, O2=>Y2, O3=>Y3);
+     IF (Y1 /= 11) OR (Y2 /= 12) OR (Y3 /= 13) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 1");
+     END IF;
+
+     P (I1=>21, O1=>Y1, O2=>Y2, O3=>Y3);
+     IF (Y1 /= 21) OR (Y2 /= 2) OR (Y3 /= 3) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 2");
+     END IF;
+
+     P (O1=>Y1, O3=>Y3, I1=>31, I3=>33, O2=>Y2);
+     IF (Y1 /= 31) OR (Y2 /= 2) OR (Y3 /= 33) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 3");
+     END IF;
+
+     P (41, 42, O1=>Y1, O2=>Y2, O3=>Y3);
+     IF (Y1 /= 41) OR (Y2 /= 42) OR (Y3 /= 3) THEN
+          FAILED ("INCORRECT PARANETER ASSOCIATION - 4");
+     END IF;
+
+     P (51, O3=>Y3, O1=>Y1, O2=>Y2, I3=>53);
+     IF (Y1 /= 51) OR (Y2 /= 2) OR (Y3 /= 53) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 5");
+     END IF;
+
+     Y1 := F (I1=>61, I2=>62);
+     IF (O1 /= 61) OR (O2 /= 62) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 6");
+     END IF;
+
+     Y2 := F (I2=>72, I1=>71);
+     IF (O1 /= 71) OR (O2 /= 72) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 7");
+     END IF;
+
+     Y3 := F (I2=>82);
+     IF (O1 /= 1) OR (O2 /= 82) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 8");
+     END IF;
+
+     RESULT;
+
+END C64004G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005a.ada
new file mode 100644
index 000000000..af5584e9d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005a.ada
@@ -0,0 +1,64 @@
+-- C64005A.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 SUBPROGRAM CAN BE CALLED
+-- RECURSIVELY AND THAT NON-LOCAL VARIABLES AND 
+-- CONSTANTS ARE PROPERLY ACCESSED FROM WITHIN
+-- RECURSIVE INVOCATIONS.
+
+-- CVP 5/1/81
+
+WITH REPORT;
+PROCEDURE C64005A IS
+
+     USE REPORT;
+
+     TWENTY : CONSTANT INTEGER := 20;
+     C1 : CONSTANT INTEGER := 1;
+     I1, I2 : INTEGER := 0;
+
+     PROCEDURE RECURSE (I1A : INTEGER; I2 : IN OUT INTEGER) IS
+          C1 : CONSTANT INTEGER := 5;
+     BEGIN
+          IF I1A < TWENTY THEN
+               RECURSE (I1A+C1, I2);
+               I1 := I1 + C64005A.C1;
+               I2 := I2 + I1A;
+          END IF;
+     END RECURSE;
+
+BEGIN
+     TEST ("C64005A", "RECURSIVE SUBPROGRAMS WITH " &
+           "NON-LOCAL DATA ACCESS");
+
+     RECURSE (0, I2);
+
+     IF I1 /= 4 OR I2 /= 30 THEN
+          FAILED ("RECURSIVE PROCEDURE INVOCATIONS " &
+                  "WITH GLOBAL DATA ACCESS NOT PERFORMED " &
+                  "CORRECTLY");
+     END IF;
+
+     RESULT;
+END C64005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005b.ada
new file mode 100644
index 000000000..5e3f4c507
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005b.ada
@@ -0,0 +1,109 @@
+-- C64005B.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 SUBPROGRAM CAN BE CALLED RECURSIVELY AND THAT NON-LOCAL
+-- VARIABLES AND CONSTANTS ARE PROPERLY ACCESSED FROM WITHIN RECURSIVE
+-- INVOCATIONS.
+
+-- CPP 7/2/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64005B IS
+
+     COUNT : INTEGER := 0;
+     TWENTY : CONSTANT INTEGER := 20;
+     C1 : CONSTANT INTEGER := 1;
+     G1, G2, G3 : INTEGER := 0;
+     G4, G5 : INTEGER := 0;
+
+     PROCEDURE R (A1 : INTEGER; A2 : IN OUT INTEGER; A3 : OUT INTEGER)
+     IS
+          C1 : CONSTANT INTEGER := 5;
+          TEN : CONSTANT INTEGER := 10;
+          J1, J2 : INTEGER := 1;
+          J3 : INTEGER := 0;
+
+          PROCEDURE RECURSE (P1 : INTEGER; P2 : IN OUT INTEGER) IS
+               C1 : INTEGER := 2;
+          BEGIN     -- RECURSE
+               C1 := IDENT_INT (10);
+               IF P1 < TWENTY THEN
+                    RECURSE (P1 + C1, G2);
+                    G1 := G1 + C64005B.C1;
+                    G3 := G3 + P1;
+                    P2 := P2 + IDENT_INT(2);
+                    A2 := A2 + IDENT_INT(1);
+                    J2 := J2 + R.C1;
+               END IF;
+          END RECURSE;
+
+     BEGIN     -- R
+          IF A2 < TEN THEN
+               A2 := A2 + C1;
+               RECURSE (0, J1);
+               J3 := J3 + TEN;
+               COUNT := COUNT + 1;
+               COMMENT ("ON PASS # " & INTEGER'IMAGE(COUNT));
+               COMMENT ("VALUE OF A2 IS " & INTEGER'IMAGE(A2));
+               COMMENT ("VALUE OF J3 IS " & INTEGER'IMAGE(J3));
+               R (0, A2, J3);
+               J3 := J3 + A2;
+          END IF;
+          A3 := J1 + J3;
+     END R;
+
+BEGIN
+     TEST("C64005B", "RECURSIVE SUBPROGRAMS WITH ALL KINDS " &
+          "OF DATA ACCESS");
+
+     R (0, G4, G5);
+
+     IF (COUNT /=  2) OR (G1 /=  4) OR
+        (G2    /=  4) OR (G3 /= 20) OR
+        (G4    /= 14) OR (G5 /= 35) THEN
+          FAILED ("RECURSIVE INVOCATIONS' DATA ACCESS IS NOT" &
+                  " WORKING CORRECTLY");
+     END IF;
+
+     COMMENT ("VALUE OF COUNT IS " & INTEGER'IMAGE(COUNT));
+     COMMENT ("VALUE OF G1 IS " & INTEGER'IMAGE(G1));
+     COMMENT ("VALUE OF G2 IS " & INTEGER'IMAGE(G2));
+     COMMENT ("VALUE OF G3 IS " & INTEGER'IMAGE(G3));
+     COMMENT ("VALUE OF G4 IS " & INTEGER'IMAGE(G4));
+     COMMENT ("VALUE OF G5 IS " & INTEGER'IMAGE(G5));
+
+     RESULT;
+
+EXCEPTION
+     WHEN PROGRAM_ERROR =>
+          FAILED ("PROGRAM_ERROR RAISED");
+          COMMENT ("VALUE OF COUNT IS " & INTEGER'IMAGE(COUNT));
+          COMMENT ("VALUE OF G1 IS " & INTEGER'IMAGE(G1));
+          COMMENT ("VALUE OF G2 IS " & INTEGER'IMAGE(G2));
+          COMMENT ("VALUE OF G3 IS " & INTEGER'IMAGE(G3));
+          COMMENT ("VALUE OF G4 IS " & INTEGER'IMAGE(G4));
+          COMMENT ("VALUE OF G5 IS " & INTEGER'IMAGE(G5));
+          RESULT;
+
+END C64005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005c.ada
new file mode 100644
index 000000000..ccb0a2a0e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005c.ada
@@ -0,0 +1,330 @@
+-- C64005C.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 NESTED SUBPROGRAMS CAN BE CALLED RECURSIVELY AND THAT
+-- NON-LOCAL VARIABLES AND FORMAL PARAMETERS ARE PROPERLY ACCESSED FROM
+-- WITHIN RECURSIVE INVOCATIONS.  THIS TEST CHECKS THAT EVERY DISPLAY OR
+-- STATIC CHAIN LEVEL CAN BE ACCESSED.
+
+-- THIS TEST USES 3 LEVELS OF NESTED RECURSIVE PROCEDURES.
+
+-- JRK 7/26/84
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C64005C IS
+
+     SUBTYPE LEVEL IS CHARACTER RANGE 'A' .. 'C';
+     SUBTYPE CALL IS CHARACTER RANGE '1' .. '3';
+
+     MAX_LEV : CONSTANT := LEVEL'POS (LEVEL'LAST) -
+                           LEVEL'POS (LEVEL'FIRST) + 1;
+     T_LEN : CONSTANT := 2 * (1 + 3 * (MAX_LEV +
+                                       MAX_LEV*(MAX_LEV+1)/2*2)) + 1;
+     G_LEN : CONSTANT := 2 + 4 * MAX_LEV;
+
+     TYPE TRACE IS
+          RECORD
+               E : NATURAL := 0;
+               S : STRING (1 .. T_LEN);
+          END RECORD;
+
+     V : CHARACTER := IDENT_CHAR ('<');
+     L : CHARACTER := IDENT_CHAR ('>');
+     T : TRACE;
+     G : STRING (1 .. G_LEN);
+
+     PROCEDURE C64005CA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+
+          V : STRING (1..2);
+
+          M : CONSTANT NATURAL := LEVEL'POS (L) -
+                                  LEVEL'POS (LEVEL'FIRST) + 1;
+          N : CONSTANT NATURAL := 2 * M + 1;
+
+          PROCEDURE C64005CB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+
+               V : STRING (1..2);
+
+               M : CONSTANT NATURAL := LEVEL'POS (L) -
+                                       LEVEL'POS (LEVEL'FIRST) + 1;
+               N : CONSTANT NATURAL := 2 * M + 1;
+
+               PROCEDURE C64005CC (L : LEVEL; C : CALL;
+                                   T : IN OUT TRACE) IS
+
+                    V : STRING (1..2);
+
+                    M : CONSTANT NATURAL := LEVEL'POS (L) -
+                                            LEVEL'POS (LEVEL'FIRST) + 1;
+                    N : CONSTANT NATURAL := 2 * M + 1;
+
+               BEGIN
+
+                    V (1) := IDENT_CHAR (ASCII.LC_C);
+                    V (2) := C;
+
+                    -- APPEND ALL V TO T.
+                    T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V &
+                                            C64005CB.V & C64005CC.V;
+                    T.E := T.E + N;
+
+                    CASE C IS
+
+                         WHEN '1' =>
+                              C64005CA (IDENT_CHAR(LEVEL'FIRST),
+                                        IDENT_CHAR('2'), T);
+
+                         WHEN '2' =>
+                              C64005CC (L, IDENT_CHAR('3'), T);
+
+                         WHEN '3' =>
+                              -- APPEND MID-POINT SYMBOL TO T.
+                              T.S (T.E+1) := IDENT_CHAR ('=');
+                              T.E := T.E + 1;
+
+                              -- G := CATENATE ALL V, L, C;
+                              G := C64005C.V & C64005C.L &
+                                  C64005CA.V & C64005CA.L & C64005CA.C &
+                                  C64005CB.V & C64005CB.L & C64005CB.C &
+                                  C64005CC.V & C64005CC.L & C64005CC.C;
+                    END CASE;
+
+                    -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+                    T.S (T.E+1 .. T.E+N) := C64005CC.L & C64005CC.C &
+                                            C64005CB.L & C64005CB.C &
+                                            C64005CA.L & C64005CA.C &
+                                            C64005C.L;
+                    T.E := T.E + N;
+
+               END C64005CC;
+
+          BEGIN
+
+               V (1) := IDENT_CHAR (ASCII.LC_B);
+               V (2) := C;
+
+               -- APPEND ALL V TO T.
+               T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V &
+                                       C64005CB.V;
+               T.E := T.E + N;
+
+               CASE C IS
+
+                    WHEN '1' =>
+                         C64005CC (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
+
+                    WHEN '2' =>
+                         C64005CB (L, IDENT_CHAR('3'), T);
+
+                    WHEN '3' =>
+                         C64005CC (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
+               END CASE;
+
+               -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+               T.S (T.E+1 .. T.E+N) := C64005CB.L & C64005CB.C &
+                                       C64005CA.L & C64005CA.C &
+                                       C64005C.L;
+               T.E := T.E + N;
+
+          END C64005CB;
+
+     BEGIN
+
+          V (1) := IDENT_CHAR (ASCII.LC_A);
+          V (2) := C;
+
+          -- APPEND ALL V TO T.
+          T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V;
+          T.E := T.E + N;
+
+          CASE C IS
+
+               WHEN '1' =>
+                    C64005CB (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
+
+               WHEN '2' =>
+                    C64005CA (L, IDENT_CHAR('3'), T);
+
+               WHEN '3' =>
+                    C64005CB (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
+          END CASE;
+
+          -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+          T.S (T.E+1 .. T.E+N) := C64005CA.L & C64005CA.C & C64005C.L;
+          T.E := T.E + N;
+
+     END C64005CA;
+
+BEGIN
+     TEST ("C64005C", "CHECK THAT NON-LOCAL VARIABLES AND FORMAL " &
+                      "PARAMETERS AT ALL LEVELS OF NESTED " &
+                      "RECURSIVE PROCEDURES ARE ACCESSIBLE");
+
+     -- APPEND V TO T.
+     T.S (T.E+1) := V;
+     T.E := T.E + 1;
+
+     C64005CA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('1'), T);
+
+     -- APPEND L TO T.
+     T.S (T.E+1) := L;
+     T.E := T.E + 1;
+
+     COMMENT ("FINAL CALL TRACE LENGTH IS: " & INTEGER'IMAGE(T.E));
+     COMMENT ("FINAL CALL TRACE IS: " & T.S(1..T.E));
+     COMMENT ("GLOBAL SNAPSHOT IS: " & G);
+
+     -- CHECK THAT T AND G ARE CORRECT BY COMPUTING THEM ITERATIVELY.
+
+     DECLARE
+          SUBTYPE LC_LEVEL IS CHARACTER RANGE ASCII.LC_A ..
+               CHARACTER'VAL (CHARACTER'POS(ASCII.LC_A) + MAX_LEV - 1);
+
+          CT : TRACE;
+          CG : STRING (1 .. G_LEN);
+     BEGIN
+          COMMENT ("CORRECT FINAL CALL TRACE LENGTH IS: " &
+                   INTEGER'IMAGE(T_LEN));
+
+          IF T.E /= IDENT_INT (T_LEN) THEN
+               FAILED ("WRONG FINAL CALL TRACE LENGTH");
+
+          ELSE CT.S (CT.E+1) := '<';
+               CT.E := CT.E + 1;
+
+               FOR I IN LC_LEVEL LOOP
+                    CT.S (CT.E+1) := '<';
+                    CT.E := CT.E + 1;
+
+                    FOR J IN LC_LEVEL'FIRST .. I LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '1';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+               END LOOP;
+
+               FOR I IN LC_LEVEL LOOP
+                    CT.S (CT.E+1) := '<';
+                    CT.E := CT.E + 1;
+
+                    FOR J IN LC_LEVEL'FIRST .. LC_LEVEL'PRED(I) LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '3';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+
+                    CT.S (CT.E+1) := I;
+                    CT.S (CT.E+2) := '2';
+                    CT.E := CT.E + 2;
+
+                    CT.S (CT.E+1) := '<';
+                    CT.E := CT.E + 1;
+
+                    FOR J IN LC_LEVEL'FIRST .. I LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '3';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+               END LOOP;
+
+               CT.S (CT.E+1) := '=';
+               CT.E := CT.E + 1;
+
+               FOR I IN REVERSE LEVEL LOOP
+                    FOR J IN REVERSE LEVEL'FIRST .. I LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '3';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+
+                    CT.S (CT.E+1) := '>';
+                    CT.E := CT.E + 1;
+
+                    CT.S (CT.E+1) := I;
+                    CT.S (CT.E+2) := '2';
+                    CT.E := CT.E + 2;
+
+                    FOR J IN REVERSE LEVEL'FIRST .. LEVEL'PRED(I) LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '3';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+
+                    CT.S (CT.E+1) := '>';
+                    CT.E := CT.E + 1;
+               END LOOP;
+
+               FOR I IN REVERSE LEVEL LOOP
+                    FOR J IN REVERSE LEVEL'FIRST .. I LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '1';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+
+                    CT.S (CT.E+1) := '>';
+                    CT.E := CT.E + 1;
+               END LOOP;
+
+               CT.S (CT.E+1) := '>';
+               CT.E := CT.E + 1;
+
+               IF CT.E /= IDENT_INT (T_LEN) THEN
+                    FAILED ("WRONG ITERATIVE TRACE LENGTH");
+
+               ELSE COMMENT ("CORRECT FINAL CALL TRACE IS: " & CT.S);
+
+                    IF T.S /= CT.S THEN
+                         FAILED ("WRONG FINAL CALL TRACE");
+                    END IF;
+               END IF;
+          END IF;
+
+          DECLARE
+               E : NATURAL := 0;
+          BEGIN
+               CG (1..2) := "<>";
+               E := E + 2;
+
+               FOR I IN LEVEL LOOP
+                    CG (E+1) := LC_LEVEL'VAL (LEVEL'POS(I) -
+                                              LEVEL'POS(LEVEL'FIRST) +
+                                              LC_LEVEL'POS
+                                                      (LC_LEVEL'FIRST));
+                    CG (E+2) := '3';
+                    CG (E+3) := I;
+                    CG (E+4) := '3';
+                    E := E + 4;
+               END LOOP;
+
+               COMMENT ("CORRECT GLOBAL SNAPSHOT IS: " & CG);
+
+               IF G /= CG THEN
+                    FAILED ("WRONG GLOBAL SNAPSHOT");
+               END IF;
+          END;
+     END;
+
+     RESULT;
+END C64005C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005d0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005d0.ada
new file mode 100644
index 000000000..adc8a0b55
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005d0.ada
@@ -0,0 +1,219 @@
+-- C64005D0M.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 NESTED SUBPROGRAMS CAN BE CALLED RECURSIVELY AND THAT
+-- NON-LOCAL VARIABLES AND FORMAL PARAMETERS ARE PROPERLY ACCESSED FROM
+-- WITHIN RECURSIVE INVOCATIONS.  THIS TEST CHECKS THAT EVERY DISPLAY OR
+-- STATIC CHAIN LEVEL CAN BE ACCESSED.
+
+-- THIS TEST USES 3 LEVELS OF NESTED RECURSIVE PROCEDURES (SEPARATELY
+-- COMPILED AS SUBUNITS).
+
+-- SEPARATE FILES ARE:
+--   C64005D0M THE MAIN PROCEDURE.
+--   C64005DA  A RECURSIVE PROCEDURE SUBUNIT OF C64005D0M.
+--   C64005DB  A RECURSIVE PROCEDURE SUBUNIT OF C64005DA.
+--   C64005DC  A RECURSIVE PROCEDURE SUBUNIT OF C64005DB.
+
+-- JRK 7/30/84
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C64005D0M IS
+
+     SUBTYPE LEVEL IS CHARACTER RANGE 'A' .. 'C';
+     SUBTYPE CALL IS CHARACTER RANGE '1' .. '3';
+
+     MAX_LEV : CONSTANT := LEVEL'POS (LEVEL'LAST) -
+                           LEVEL'POS (LEVEL'FIRST) + 1;
+     T_LEN : CONSTANT := 2 * (1 + 3 * (MAX_LEV +
+                                       MAX_LEV*(MAX_LEV+1)/2*2)) + 1;
+     G_LEN : CONSTANT := 2 + 4 * MAX_LEV;
+
+     TYPE TRACE IS
+          RECORD
+               E : NATURAL := 0;
+               S : STRING (1 .. T_LEN);
+          END RECORD;
+
+     V : CHARACTER := IDENT_CHAR ('<');
+     L : CHARACTER := IDENT_CHAR ('>');
+     T : TRACE;
+     G : STRING (1 .. G_LEN);
+
+     PROCEDURE C64005DA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+          SEPARATE;
+
+BEGIN
+     TEST ("C64005D", "CHECK THAT NON-LOCAL VARIABLES AND FORMAL " &
+                      "PARAMETERS AT ALL LEVELS OF NESTED " &
+                      "RECURSIVE PROCEDURES ARE ACCESSIBLE (FOR " &
+                      "3 LEVELS OF SEPARATELY COMPILED SUBUNITS)");
+
+     -- APPEND V TO T.
+     T.S (T.E+1) := V;
+     T.E := T.E + 1;
+
+     C64005DA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('1'), T);
+
+     -- APPEND L TO T.
+     T.S (T.E+1) := L;
+     T.E := T.E + 1;
+
+     COMMENT ("FINAL CALL TRACE LENGTH IS: " & INTEGER'IMAGE(T.E));
+     COMMENT ("FINAL CALL TRACE IS: " & T.S(1..T.E));
+     COMMENT ("GLOBAL SNAPSHOT IS: " & G);
+
+     -- CHECK THAT T AND G ARE CORRECT BY COMPUTING THEM ITERATIVELY.
+
+     DECLARE
+          SUBTYPE LC_LEVEL IS CHARACTER RANGE ASCII.LC_A ..
+               CHARACTER'VAL (CHARACTER'POS(ASCII.LC_A) + MAX_LEV - 1);
+
+          CT : TRACE;
+          CG : STRING (1 .. G_LEN);
+     BEGIN
+          COMMENT ("CORRECT FINAL CALL TRACE LENGTH IS: " &
+                   INTEGER'IMAGE(T_LEN));
+
+          IF T.E /= IDENT_INT (T_LEN) THEN
+               FAILED ("WRONG FINAL CALL TRACE LENGTH");
+
+          ELSE CT.S (CT.E+1) := '<';
+               CT.E := CT.E + 1;
+
+               FOR I IN LC_LEVEL LOOP
+                    CT.S (CT.E+1) := '<';
+                    CT.E := CT.E + 1;
+
+                    FOR J IN LC_LEVEL'FIRST .. I LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '1';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+               END LOOP;
+
+               FOR I IN LC_LEVEL LOOP
+                    CT.S (CT.E+1) := '<';
+                    CT.E := CT.E + 1;
+
+                    FOR J IN LC_LEVEL'FIRST .. LC_LEVEL'PRED(I) LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '3';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+
+                    CT.S (CT.E+1) := I;
+                    CT.S (CT.E+2) := '2';
+                    CT.E := CT.E + 2;
+
+                    CT.S (CT.E+1) := '<';
+                    CT.E := CT.E + 1;
+
+                    FOR J IN LC_LEVEL'FIRST .. I LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '3';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+               END LOOP;
+
+               CT.S (CT.E+1) := '=';
+               CT.E := CT.E + 1;
+
+               FOR I IN REVERSE LEVEL LOOP
+                    FOR J IN REVERSE LEVEL'FIRST .. I LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '3';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+
+                    CT.S (CT.E+1) := '>';
+                    CT.E := CT.E + 1;
+
+                    CT.S (CT.E+1) := I;
+                    CT.S (CT.E+2) := '2';
+                    CT.E := CT.E + 2;
+
+                    FOR J IN REVERSE LEVEL'FIRST .. LEVEL'PRED(I) LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '3';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+
+                    CT.S (CT.E+1) := '>';
+                    CT.E := CT.E + 1;
+               END LOOP;
+
+               FOR I IN REVERSE LEVEL LOOP
+                    FOR J IN REVERSE LEVEL'FIRST .. I LOOP
+                         CT.S (CT.E+1) := J;
+                         CT.S (CT.E+2) := '1';
+                         CT.E := CT.E + 2;
+                    END LOOP;
+
+                    CT.S (CT.E+1) := '>';
+                    CT.E := CT.E + 1;
+               END LOOP;
+
+               CT.S (CT.E+1) := '>';
+               CT.E := CT.E + 1;
+
+               IF CT.E /= IDENT_INT (T_LEN) THEN
+                    FAILED ("WRONG ITERATIVE TRACE LENGTH");
+
+               ELSE COMMENT ("CORRECT FINAL CALL TRACE IS: " & CT.S);
+
+                    IF T.S /= CT.S THEN
+                         FAILED ("WRONG FINAL CALL TRACE");
+                    END IF;
+               END IF;
+          END IF;
+
+          DECLARE
+               E : NATURAL := 0;
+          BEGIN
+               CG (1..2) := "<>";
+               E := E + 2;
+
+               FOR I IN LEVEL LOOP
+                    CG (E+1) := LC_LEVEL'VAL (LEVEL'POS(I) -
+                                              LEVEL'POS(LEVEL'FIRST) +
+                                              LC_LEVEL'POS
+                                                      (LC_LEVEL'FIRST));
+                    CG (E+2) := '3';
+                    CG (E+3) := I;
+                    CG (E+4) := '3';
+                    E := E + 4;
+               END LOOP;
+
+               COMMENT ("CORRECT GLOBAL SNAPSHOT IS: " & CG);
+
+               IF G /= CG THEN
+                    FAILED ("WRONG GLOBAL SNAPSHOT");
+               END IF;
+          END;
+     END;
+
+     RESULT;
+END C64005D0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005da.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005da.ada
new file mode 100644
index 000000000..33a50aa5f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005da.ada
@@ -0,0 +1,65 @@
+-- C64005DA.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.
+--*
+-- JRK 7/30/84
+
+SEPARATE (C64005D0M)
+
+PROCEDURE C64005DA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+
+     V : STRING (1..2);
+
+     M : CONSTANT NATURAL := LEVEL'POS (L) -
+                             LEVEL'POS (LEVEL'FIRST) + 1;
+     N : CONSTANT NATURAL := 2 * M + 1;
+
+     PROCEDURE C64005DB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+          SEPARATE;
+
+BEGIN
+
+     V (1) := IDENT_CHAR (ASCII.LC_A);
+     V (2) := C;
+
+     -- APPEND ALL V TO T.
+     T.S (T.E+1 .. T.E+N) := C64005D0M.V & C64005DA.V;
+     T.E := T.E + N;
+
+     CASE C IS
+
+          WHEN '1' =>
+               C64005DB (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
+
+          WHEN '2' =>
+               C64005DA (L, IDENT_CHAR('3'), T);
+
+          WHEN '3' =>
+               C64005DB (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
+     END CASE;
+
+     -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+     T.S (T.E+1 .. T.E+N) := C64005DA.L & C64005DA.C & C64005D0M.L;
+     T.E := T.E + N;
+
+END C64005DA;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005db.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005db.ada
new file mode 100644
index 000000000..92a5892a3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005db.ada
@@ -0,0 +1,67 @@
+-- C64005DB.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.
+--*
+-- JRK 7/30/84
+
+SEPARATE (C64005D0M.C64005DA)
+
+PROCEDURE C64005DB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+
+     V : STRING (1..2);
+
+     M : CONSTANT NATURAL := LEVEL'POS (L) -
+                             LEVEL'POS (LEVEL'FIRST) + 1;
+     N : CONSTANT NATURAL := 2 * M + 1;
+
+     PROCEDURE C64005DC (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+          SEPARATE;
+
+BEGIN
+
+     V (1) := IDENT_CHAR (ASCII.LC_B);
+     V (2) := C;
+
+     -- APPEND ALL V TO T.
+     T.S (T.E+1 .. T.E+N) := C64005D0M.V & C64005DA.V & C64005DB.V;
+     T.E := T.E + N;
+
+     CASE C IS
+
+          WHEN '1' =>
+               C64005DC (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
+
+          WHEN '2' =>
+               C64005DB (L, IDENT_CHAR('3'), T);
+
+          WHEN '3' =>
+               C64005DC (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
+     END CASE;
+
+     -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+     T.S (T.E+1 .. T.E+N) := C64005DB.L & C64005DB.C &
+                             C64005DA.L & C64005DA.C &
+                             C64005D0M.L;
+     T.E := T.E + N;
+
+END C64005DB;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005dc.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005dc.ada
new file mode 100644
index 000000000..45e8a5ec4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64005dc.ada
@@ -0,0 +1,74 @@
+-- C64005DC.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.
+--*
+-- JRK 7/30/84
+
+SEPARATE (C64005D0M.C64005DA.C64005DB)
+
+PROCEDURE C64005DC (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
+
+     V : STRING (1..2);
+
+     M : CONSTANT NATURAL := LEVEL'POS (L) -
+                             LEVEL'POS (LEVEL'FIRST) + 1;
+     N : CONSTANT NATURAL := 2 * M + 1;
+
+BEGIN
+
+     V (1) := IDENT_CHAR (ASCII.LC_C);
+     V (2) := C;
+
+     -- APPEND ALL V TO T.
+     T.S (T.E+1 .. T.E+N) := C64005D0M.V & C64005DA.V & C64005DB.V &
+                             C64005DC.V;
+     T.E := T.E + N;
+
+     CASE C IS
+
+          WHEN '1' =>
+               C64005DA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('2'), T);
+
+          WHEN '2' =>
+               C64005DC (L, IDENT_CHAR('3'), T);
+
+          WHEN '3' =>
+               -- APPEND MID-POINT SYMBOL TO T.
+               T.S (T.E+1) := IDENT_CHAR ('=');
+               T.E := T.E + 1;
+
+               -- G := CATENATE ALL V, L, C;
+               G := C64005D0M.V & C64005D0M.L &
+                    C64005DA.V & C64005DA.L & C64005DA.C &
+                    C64005DB.V & C64005DB.L & C64005DB.C &
+                    C64005DC.V & C64005DC.L & C64005DC.C;
+     END CASE;
+
+     -- APPEND ALL L AND C TO T IN REVERSE ORDER.
+     T.S (T.E+1 .. T.E+N) := C64005DC.L & C64005DC.C &
+                             C64005DB.L & C64005DB.C &
+                             C64005DA.L & C64005DA.C &
+                             C64005D0M.L;
+     T.E := T.E + N;
+
+END C64005DC;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c641001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c641001.a
new file mode 100644
index 000000000..84ee58a7e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c641001.a
@@ -0,0 +1,281 @@
+-- C641001.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 actual parameters passed by reference are view converted
+--      to the nominal subtype of the formal parameter.
+--
+-- TEST DESCRIPTION:
+--      Check that sliding is allowed for formal parameters, especially
+--      check cases that would have caused errors in Ada'83.
+--      Check that length check for a formal parameter (esp out mode)
+--      is performed before the call, not after.
+--
+--  notes: 6.2; by reference ::= tagged, task, protected,
+--                       limited (nonprivate), or composite containing such
+--         4.6; view conversion
+--
+--
+-- CHANGE HISTORY:
+--      26 JAN 96   SAIC   Initial version
+--      04 NOV 96   SAIC   Commentary revision for release 2.1
+--      27 FEB 97   PWB.CTA Corrected reference to the wrong string
+--!
+
+----------------------------------------------------------------- C641001_0
+
+package C641001_0 is
+
+  subtype String_10 is String(1..10);
+
+  procedure Check_String_10( S : out String_10; Start, Stop: Natural );
+
+  procedure Check_Illegal_Slice_Reference( Slice_Passed : in out String;
+                                           Index: Natural );
+
+  type Tagged_Data(Bound: Natural) is tagged record
+    Data_Item : String(1..Bound) := (others => '*');
+  end record;
+
+  type Tag_List is array(Natural range <>) of Tagged_Data(5);
+
+  subtype Tag_List_10 is Tag_List(1..10);
+
+  procedure Check_Tag_Slice( TL : in out Tag_List_10 );
+
+  procedure Check_Out_Tagged_Data( Formal : out Tagged_Data );
+
+end C641001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with TCTouch;
+package body C641001_0 is
+
+  String_Data : constant String := "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+
+  procedure Check_String_10( S : out String_10; Start, Stop: Natural ) is
+  begin
+    if S'Length /= 10 then
+      Report.Failed("Length check not performed prior to execution");
+    end if;
+    S := String_Data(Start..Stop);
+  exception
+    when others => Report.Failed("Exception encountered in Check_String_10");
+  end Check_String_10;
+
+  procedure Check_Illegal_Slice_Reference( Slice_Passed : in out String;
+                                           Index: Natural ) is
+  begin
+    -- essentially "do-nothing" for optimization foilage...
+    if Slice_Passed(Index) in Character then
+    -- Intent is    ^^^^^  should raise Constraint_Error
+      Report.Failed("Illegal Slice provided legal character");
+    else
+      Report.Failed("Illegal Slice provided illegal character");
+    end if;
+  exception
+    when Constraint_Error =>
+      null; -- expected case
+    when others =>
+      Report.Failed("Wrong exception in Check_Illegal_Slice_Reference");
+  end Check_Illegal_Slice_Reference;
+
+  procedure Check_Tag_Slice( TL : in out Tag_List_10 ) is
+    -- if the view conversion is not performed, one of the following checks
+    -- will fail (given data passed as 0..9 and then 2..11)
+  begin
+    Check_Under_Index:  -- index 0 should raise C_E
+    begin
+      TCTouch.Assert( TL(Report.Ident_Int(0)).Data_Item = "*****",
+                      "Index 0 (illegal); bad data" );
+      Report.Failed("Index 0 did not raise Constraint_Error");
+    exception
+      when Constraint_Error =>
+        null; -- expected case
+      when others =>
+        Report.Failed("Wrong exception in Check_Under_Index ");
+    end Check_Under_Index;
+
+    Check_Over_Index:  -- index 11 should raise C_E
+    begin
+      TCTouch.Assert( TL(Report.Ident_Int(11)).Data_Item = "*****",
+                      "Index 11 (illegal); bad data" );
+      Report.Failed("Index 11 did not raise Constraint_Error");
+    exception
+      when Constraint_Error =>
+        null; -- expected case
+      when others =>
+        Report.Failed("Wrong exception in Check_Over_Index ");
+    end Check_Over_Index;
+
+  end Check_Tag_Slice;
+
+  procedure Check_Out_Tagged_Data( Formal : out Tagged_Data ) is
+  begin
+    TCTouch.Assert( Formal.Data_Item = "*****", "out formal data bad" );
+    Formal.Data_Item(1) := '!';
+  end Check_Out_Tagged_Data;
+
+end C641001_0;
+
+------------------------------------------------------------------- C641001
+
+with Report;
+with TCTouch;
+with C641001_0;
+procedure C641001 is
+
+  function II( I: Integer ) return Integer renames Report.Ident_Int;
+        -- ^^ name chosen to allow embedding in calls
+
+  A_String_10 : C641001_0.String_10;
+  Slicable    : String(1..40);
+  Tag_Slices  : C641001_0.Tag_List(0..11);
+
+  Global_Data : String(1..26) := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+
+  procedure Check_Out_Sliding( Lo1, Hi1, Lo2, Hi2 : Natural ) is
+
+    subtype One_Constrained_String is String(Lo1..Hi1);   -- 1  5
+    subtype Two_Constrained_String is String(Lo2..Hi2);   -- 6 10
+
+    procedure Out_Param( Param : out One_Constrained_String ) is
+    begin
+      Param := Report.Ident_Str( Global_Data(Lo2..Hi2) );
+    end Out_Param;
+    Object : Two_Constrained_String;
+  begin
+    Out_Param( Object );
+    if Object /= Report.Ident_Str( Global_Data(Lo2..Hi2) ) then
+      Report.Failed("Bad result in Check_Out_Sliding");
+    end if;
+  exception
+    when others => Report.Failed("Exception in Check_Out_Sliding");
+  end Check_Out_Sliding;
+
+  procedure Check_Dynamic_Subtype_Cases(F_Lower,F_Upper: Natural;
+                                        A_Lower,A_Upper: Natural) is
+
+    subtype Dyn_String is String(F_Lower..F_Upper);
+
+    procedure Check_Dyn_Subtype_Formal_Out( Param : out Dyn_String ) is
+    begin
+      Param := Global_Data(11..20);
+    end Check_Dyn_Subtype_Formal_Out;
+
+    procedure Check_Dyn_Subtype_Formal_In( Param : in Dyn_String ) is
+    begin
+      if Param /= Global_Data(11..20) then
+        Report.Failed("Dynamic case, data mismatch");
+      end if;
+    end Check_Dyn_Subtype_Formal_In;
+
+    Stuff: String(A_Lower..A_Upper);
+
+  begin
+    Check_Dyn_Subtype_Formal_Out( Stuff );
+    Check_Dyn_Subtype_Formal_In( Stuff );
+  end Check_Dynamic_Subtype_Cases;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C641001", "Check that actual parameters passed by " &
+                          "reference are view converted to the nominal " &
+                          "subtype of the formal parameter" );
+
+  -- non error cases for string slices
+
+  C641001_0.Check_String_10( A_String_10, 1, 10 );
+  TCTouch.Assert( A_String_10 = "1234567890", "Nominal case" );
+
+  C641001_0.Check_String_10( A_String_10, 11, 20 );
+  TCTouch.Assert( A_String_10 = "ABCDEFGHIJ", "Sliding to subtype" );
+
+  C641001_0.Check_String_10( Slicable(1..10), 1, 10 );
+  TCTouch.Assert( Slicable(1..10) = "1234567890", "Slice, no sliding" );
+
+  C641001_0.Check_String_10( Slicable(1..10), 21, 30 );
+  TCTouch.Assert( Slicable(1..10) = "KLMNOPQRST", "Sliding to slice" );
+
+  C641001_0.Check_String_10( Slicable(11..20), 11, 20 );
+  TCTouch.Assert( Slicable(11..20) = "ABCDEFGHIJ", "Sliding to same" );
+
+  C641001_0.Check_String_10( Slicable(21..30), 11, 20 );
+  TCTouch.Assert( Slicable(21..30) = "ABCDEFGHIJ", "Sliding up" );
+
+  -- error cases for string slices
+
+  C641001_0.Check_Illegal_Slice_Reference( Slicable(21..30), 20 );
+
+  C641001_0.Check_Illegal_Slice_Reference( Slicable(1..15), Slicable'Last );
+
+  -- checks for view converting actuals to formals
+
+  -- catch low bound fault
+  C641001_0.Check_Tag_Slice( Tag_Slices(II(0)..9) );     -- II ::= Ident_Int
+  TCTouch.Assert( Tag_Slices'First = 0, "Tag_Slices'First = 0" );
+  TCTouch.Assert( Tag_Slices'Last = 11, "Tag_Slices'Last = 11" );
+
+  -- catch high bound fault
+  C641001_0.Check_Tag_Slice( Tag_Slices(2..II(11)) );
+  TCTouch.Assert( Tag_Slices'First = 0, "Tag_Slices'First = 0" );
+  TCTouch.Assert( Tag_Slices'Last = 11, "Tag_Slices'Last = 11" );
+
+  Check_Formal_Association_Check:
+  begin
+    C641001_0.Check_String_10( Slicable, 1, 10 ); -- catch length fault
+    Report.Failed("Exception not raised at Check_Formal_Association_Check");
+  exception
+    when Constraint_Error =>
+      null; -- expected case
+    when others =>
+      Report.Failed("Wrong exception at Check_Formal_Association_Check");
+  end Check_Formal_Association_Check;
+
+  -- check for constrained actual, unconstrained formal
+  C641001_0.Check_Out_Tagged_Data( Tag_Slices(5) );
+  TCTouch.Assert( Tag_Slices(5).Data_Item = "!****",
+                  "formal out returned bad result" );
+
+  -- additional checks for out mode formal parameters, dynamic subtypes
+
+  Check_Out_Sliding( II(1),II(5), II(6),II(10) );
+
+  Check_Out_Sliding( 21,25, 6,10 );
+
+  Check_Dynamic_Subtype_Cases(F_Lower => II(1), F_Upper => II(10),
+                              A_Lower => II(1), A_Upper => II(10));
+
+  Check_Dynamic_Subtype_Cases(F_Lower => II(21), F_Upper => II(30),
+                              A_Lower => II( 1), A_Upper => II(10));
+
+  Check_Dynamic_Subtype_Cases(F_Lower => II( 1), F_Upper => II(10),
+                              A_Lower => II(21), A_Upper => II(30));
+
+  Report.Result;
+
+end C641001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103b.ada
new file mode 100644
index 000000000..3af6c6191
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103b.ada
@@ -0,0 +1,379 @@
+-- C64103B.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, FOR IN-OUT PARAMETERS OF A SCALAR TYPE,
+--     CONSTRAINT_ERROR IS RAISED:
+--          BEFORE A SUBPROGRAM CALL WHEN THE CONVERTED ACTUAL
+--          PARAMETER IS OUTSIDE THE RANGE OF THE FORMAL PARAMETER'S
+--          SUBTYPE;
+--          AFTER A SUBPROGRAM CALL WHEN THE CONVERTED FORMAL PARAMETER
+--          IS OUTSIDE THE RANGE OF THE ACTUAL PARAMETER'S SUBTYPE.
+
+-- HISTORY:
+--     CPP  07/18/84  CREATED ORIGINAL TEST.
+--     VCL  10/27/87  MODIFIED THIS HEADER; ADDED STATEMENTS WHICH
+--                    REFERENCED THE ACTUAL PARAMETERS IN THE SECOND
+--                    SUBTEST.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64103B IS
+BEGIN
+     TEST ("C64103B", "FOR IN-OUT PARAMETERS OF A SCALAR TYPE, " &
+                      "CONSTRAINT_ERROR IS RAISED:  BEFORE A " &
+                      "SUBPROGRAM CALL WHEN THE CONVERTED ACTUAL " &
+                      "PARAMETER IS OUTSIDE THE RANGE OF THE FORMAL " &
+                      "PARAMETER'S SUBTYPE;  AFTER A SUBPROGRAM " &
+                      "CALL WHEN THE CONVERTED FORMAL PARAMETER IS " &
+                      "OUTSIDE THE RANGE OF THE ACTUAL PARAMETER'S " &
+                      "SUBTYPE");
+
+
+     DECLARE
+          A0 : INTEGER := -9;
+          A1 : INTEGER := IDENT_INT(-1);
+          TYPE SUBINT IS RANGE -8 .. -2;
+
+          TYPE FLOAT_TYPE IS DIGITS 3 RANGE 0.0 .. 3.0;
+          A2 : FLOAT_TYPE := 0.12;
+          A3 : FLOAT_TYPE := 2.5;
+          TYPE NEW_FLOAT IS DIGITS 3 RANGE 1.0 .. 2.0;
+
+          TYPE FIXED_TYPE IS DELTA 1.0 RANGE -2.0 .. 5.0;
+          A4 : FIXED_TYPE := -2.0;
+          A5 : FIXED_TYPE := 4.0;
+          TYPE NEW_FIXED IS DELTA 1.0 RANGE -1.0 .. 3.0;
+
+          A6 : CHARACTER := 'A';
+          SUBTYPE SUPER_CHAR IS CHARACTER RANGE 'B'..'Q';
+
+          TYPE COLOR IS (RED, BURGUNDY, LILAC, MAROON, MAGENTA);
+          SUBTYPE A_COLOR IS COLOR RANGE RED..LILAC;
+          SUBTYPE B_COLOR IS COLOR RANGE MAROON..MAGENTA;
+          A7 : B_COLOR := MAROON;
+
+          PROCEDURE P1 (X : IN OUT SUBINT;
+                        S :        STRING) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (A" &
+                       S & ")");
+          END P1;
+
+          PROCEDURE P2 (X : IN OUT NEW_FLOAT;
+                        S :        STRING)     IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P2 (A" &
+                       S & ")");
+          END P2;
+
+          PROCEDURE P3 (X : IN OUT NEW_FIXED;
+                        S :        STRING)     IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P3 (A" &
+                       S & ")");
+          END P3;
+
+          PROCEDURE P4 (X : IN OUT SUPER_CHAR;
+                        S :        STRING)     IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P4 (A" &
+                        S & ")");
+          END P4;
+
+          PROCEDURE P5 (X : IN OUT A_COLOR;
+                        S :        STRING) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P5 (A" &
+                       S & ")");
+          END P5;
+     BEGIN
+          BEGIN
+               P1 (SUBINT (A0), "1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (A1)");
+          END;
+
+          BEGIN
+               P1 (SUBINT (A1), "2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (A2)");
+          END;
+
+          BEGIN
+               P2 (NEW_FLOAT (A2), "1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P2 (A1)");
+          END;
+
+          BEGIN
+               P2 (NEW_FLOAT (A3), "2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P2 (A2)");
+          END;
+
+          BEGIN
+               P3 (NEW_FIXED (A4), "1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P3 (A1)");
+          END;
+
+          BEGIN
+               P3 (NEW_FIXED (A5), "2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P3 (A2)");
+          END;
+
+          BEGIN
+               P4 (SUPER_CHAR (A6),"1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P4 (A1)");
+          END;
+
+          BEGIN
+               P5 (A_COLOR (A7), "1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P5 (A1)");
+          END;
+     END;
+
+
+     DECLARE
+          CALLED : BOOLEAN;
+          TYPE SUBINT IS RANGE -8 .. -2;
+          A0 : SUBINT := -3;
+          A1 : INTEGER := -9;
+          A2 : INTEGER := -1;
+
+          TYPE FLOAT IS DIGITS 3 RANGE -1.0 .. 2.0;
+          TYPE A_FLOAT IS DIGITS 3 RANGE 0.0 .. 1.0;
+          A3 : A_FLOAT := 1.0;
+          A4 : FLOAT := -0.5;
+          A5 : FLOAT := 1.5;
+
+          TYPE NEW_FIXED IS DELTA 1.0 RANGE -1.0 .. 3.0;
+          A6 : NEW_FIXED := 0.0;
+          TYPE FIXED_TYPE IS DELTA 1.0 RANGE -2.0 .. 5.0;
+          A7 : FIXED_TYPE := -2.0;
+          A8 : FIXED_TYPE := 4.0;
+
+          SUBTYPE SUPER_CHAR IS CHARACTER RANGE 'B'..'Q';
+          A9  : SUPER_CHAR := 'C';
+          A10 : CHARACTER := 'A';
+          A11 : CHARACTER := 'R';
+
+          PROCEDURE P1 (X : IN OUT INTEGER; Y : INTEGER) IS
+          BEGIN
+               CALLED := TRUE;
+               X := IDENT_INT (Y);
+          END P1;
+
+          PROCEDURE P2 (X : IN OUT FLOAT; Y : FLOAT) IS
+          BEGIN
+               CALLED := TRUE;
+               X := Y;
+          END P2;
+
+          PROCEDURE P3 ( X : IN OUT FIXED_TYPE; Y : FIXED_TYPE) IS
+          BEGIN
+               CALLED := TRUE;
+               X := Y;
+          END P3;
+
+          PROCEDURE P4 (X : IN OUT CHARACTER; Y : CHARACTER) IS
+          BEGIN
+               CALLED := TRUE;
+               X := IDENT_CHAR(Y);
+          END P4;
+     BEGIN
+          BEGIN
+               CALLED := FALSE;
+               P1 (INTEGER(A0), A1);
+               IF A0 = -3 THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B1)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B2)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P1 (B1)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
+          END;
+
+          BEGIN
+               CALLED := FALSE;
+               P1 (INTEGER(A0), A2);
+               IF A0 = -3 THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B3)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B4)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P1 (B2)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
+          END;
+
+          BEGIN
+               CALLED := FALSE;
+               P2 (FLOAT (A3), A4);
+               IF A3 = 1.0 THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B1)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B2)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P2 (B1)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P2 (B1)");
+          END;
+
+          BEGIN
+               CALLED := FALSE;
+               P2 (FLOAT (A3), A5);
+               IF A3 = 1.0 THEN
+                    FAILED ("EXCEPTION NOT RAISED -P2 (B3)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED -P2 (B4)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P2 (B2)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P2 (B2)");
+          END;
+
+          BEGIN
+               CALLED := FALSE;
+               P3 (FIXED_TYPE (A6), A7);
+               IF A6 = 0.0 THEN
+                    FAILED ("EXCEPTION NOT RAISED -P3 (B1)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED -P3 (B2)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P3 (B1)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P3 (B1)");
+          END;
+
+          BEGIN
+               CALLED := FALSE;
+               P3 (FIXED_TYPE (A6), A8);
+               IF A6 = 0.0 THEN
+                    FAILED ("EXCEPTION NOT RAISED -P3 (B3)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED -P3 (B4)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P3 (B2)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P3 (B2)");
+          END;
+
+          BEGIN
+               CALLED := FALSE;
+               P4 (CHARACTER (A9), A10);
+               IF A9 = 'C' THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B1)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B2)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P4 (B1)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P4 (B1)");
+          END;
+
+          BEGIN
+               CALLED := FALSE;
+               P4 (CHARACTER (A9), A11);
+               IF A9 = 'C' THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B3)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P4 (B4)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P4 (B2)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P4 (B2)");
+          END;
+     END;
+
+     RESULT;
+END C64103B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103c.ada
new file mode 100644
index 000000000..c08ef8693
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103c.ada
@@ -0,0 +1,230 @@
+-- C64103C.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 APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS
+-- ON IN OUT ARRAY PARAMETERS.  IN PARTICULAR:
+--   (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL
+--       COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S
+--       CONSTRAINTS.
+--   (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO
+--       AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
+--       OUTSIDE OF A FORMAL INDEX SUBTYPE FOR A NON-NULL DIMENSION (SEE
+--       AI-00313 FOR MULTIDIMENSIONAL CASE)
+--   (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A
+--       CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER
+--       DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.
+--   (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN
+--       UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
+--       OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- CPP 07/19/84
+-- JBG 06/05/85
+-- EG  10/29/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+--               AI-00387.
+-- MRM 03/30/93  REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM;
+WITH REPORT;  USE REPORT;
+PROCEDURE C64103C IS
+
+     BEGIN
+     TEST ("C64103C", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &
+           "TYPE CONVERSIONS OF IN OUT ARRAY PARAMETERS");
+
+     -----------------------------------------------
+
+     DECLARE   -- (A)
+     BEGIN     -- (A)
+
+          DECLARE
+               TYPE SUBINT IS RANGE 0..8;
+               TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+               A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);
+
+               PROCEDURE P2 (X : IN OUT ARRAY_TYPE) IS
+               BEGIN
+                    NULL;
+               END P2;
+          BEGIN
+               P2 (ARRAY_TYPE (A0));                  -- OK.
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED -P2 (A)");
+          END;
+
+     END; -- (A)
+
+     -----------------------------------------------
+
+     DECLARE   -- (B1) NON-NULL ACTUAL PARAMETER
+
+          TYPE SUBINT IS RANGE 0..8;
+          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+          TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+          A1 : AR1 (-1..7) := (-1..7 => TRUE);
+          A2 : AR1 (1..9) := (1..9 => TRUE);
+
+          PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
+          END P1;
+
+     BEGIN     -- (B1)
+
+          BEGIN
+               COMMENT ("CALL TO P1 (B1) ON A1");
+               P1 (ARRAY_TYPE (A1));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
+          END;
+
+          BEGIN
+               COMMENT ("CALL TO P1 (B1) ON A2");
+               P1 (ARRAY_TYPE (A2));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
+          END;
+
+     END; -- (B1)
+
+     DECLARE   -- (B2) NULL ACTUAL PARAMETER; MULTIDIMENSIONAL
+
+          TYPE SUBINT IS RANGE 0..8;
+          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>,
+                                    SUBINT RANGE <>) OF BOOLEAN;
+          TYPE AR1 IS ARRAY (INTEGER RANGE <>,
+                             INTEGER RANGE <>)OF BOOLEAN;
+          A1 : AR1 (IDENT_INT(-1)..7, 5..4) :=
+                                           (OTHERS => (OTHERS => TRUE));
+          A2 : AR1 (5..4, 1..IDENT_INT(9)) :=
+                                           (OTHERS => (OTHERS => TRUE));
+          PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
+          END P1;
+
+     BEGIN     -- (B2)
+
+          BEGIN
+               COMMENT ("CALL TO P1 (B2) ON A1");
+               P1 (ARRAY_TYPE (A1));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
+          END;
+
+          BEGIN
+               COMMENT ("CALL TO P1 (B2) ON A2");
+               P1 (ARRAY_TYPE (A2));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
+          END;
+
+     END; -- (B2)
+
+     -----------------------------------------------
+
+     BEGIN     -- (C)
+
+          DECLARE
+               TYPE INDEX1 IS RANGE 1..3;
+               TYPE INDEX2 IS RANGE 1..4;
+               TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;
+               A0 : AR_TYPE := (1..3 => (1..4 => FALSE));
+
+               TYPE I1 IS RANGE 1..4;
+               TYPE I2 IS RANGE 1..3;
+               TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;
+
+               PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
+               BEGIN
+                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");
+               END P1;
+          BEGIN
+               P1 (ARRAY_TYPE (A0));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (C)");
+          END;
+
+     END; -- (C)
+
+     -----------------------------------------------
+
+     DECLARE   -- (D)
+     BEGIN     -- (D)
+
+          DECLARE
+               TYPE SM_INT IS RANGE 0..2;
+               TYPE LG IS RANGE 0 .. SYSTEM.MAX_INT;
+               SUBTYPE LG_INT IS LG RANGE SYSTEM.MAX_INT - 3 ..
+                                          SYSTEM.MAX_INT;
+               TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;
+               TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;
+               A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=
+                    (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);
+
+               PROCEDURE P1 (X : IN OUT AR_SMALL) IS
+               BEGIN
+                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");
+               END P1;
+          BEGIN
+               IF LG (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN
+                    P1 (AR_SMALL (A0));
+               ELSE
+                    COMMENT ("NOT APPLICABLE -P1 (D)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - P1 (D)");
+          END;
+
+     END; -- (D)
+
+     -----------------------------------------------
+
+     RESULT;
+
+END C64103C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103d.ada
new file mode 100644
index 000000000..180dab077
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103d.ada
@@ -0,0 +1,187 @@
+-- C64103D.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 APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS
+-- ON OUT ARRAY PARAMETERS.  IN PARTICULAR:
+--   (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL
+--       COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S
+--       CONSTRAINTS.
+--   (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO
+--       AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
+--       OUTSIDE OF A FORMAL INDEX SUBTYPE.
+--   (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A
+--       CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER
+--       DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.
+--   (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN
+--       UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
+--       OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- CPP 07/19/84
+-- EG  10/29/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+--               AI-00387.
+-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM;
+WITH REPORT;  USE REPORT;
+PROCEDURE C64103D IS
+
+     BEGIN
+     TEST ("C64103D", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &
+           "TYPE CONVERSIONS OF OUT ARRAY PARAMETERS");
+
+     -----------------------------------------------
+
+     DECLARE   -- (A)
+     BEGIN     -- (A)
+
+          DECLARE
+               TYPE SUBINT IS RANGE 0..8;
+               TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+               A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);
+
+               PROCEDURE P2 (X : OUT ARRAY_TYPE) IS
+               BEGIN
+                    NULL;
+               END P2;
+          BEGIN
+               P2 (ARRAY_TYPE (A0));                  -- OK.
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED -P2 (A)");
+          END;
+
+     END; -- (A)
+
+     -----------------------------------------------
+
+     DECLARE   -- (B)
+
+          TYPE SUBINT IS RANGE 0..8;
+          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+          TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+          A1 : AR1 (-1..7) := (-1..7 => TRUE);
+          A2 : AR1 (1..9) := (1..9 => TRUE);
+
+          PROCEDURE P1 (X : OUT ARRAY_TYPE) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
+          END P1;
+
+     BEGIN     -- (B)
+
+          BEGIN
+               COMMENT ("CALL TO P1 (B) ON A1");
+               P1 (ARRAY_TYPE (A1));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
+          END;
+
+          BEGIN
+               COMMENT ("CALL TO P1 (B) ON A2");
+               P1 (ARRAY_TYPE (A2));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
+          END;
+
+     END; -- (B)
+
+     -----------------------------------------------
+
+     DECLARE   -- (C)
+     BEGIN     -- (C)
+
+          DECLARE
+               TYPE INDEX1 IS RANGE 1..3;
+               TYPE INDEX2 IS RANGE 1..4;
+               TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;
+               A0 : AR_TYPE := (1..3 => (1..4 => FALSE));
+
+               TYPE I1 IS RANGE 1..4;
+               TYPE I2 IS RANGE 1..3;
+               TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;
+
+               PROCEDURE P1 (X : OUT ARRAY_TYPE) IS
+               BEGIN
+                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");
+               END P1;
+          BEGIN
+               P1 (ARRAY_TYPE (A0));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (C)");
+          END;
+
+     END; -- (C)
+
+     -----------------------------------------------
+
+     DECLARE   -- (D)
+     BEGIN     -- (D)
+
+          DECLARE
+               TYPE SM_INT IS RANGE 0..2;
+               TYPE LG_INT IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT;
+               TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;
+               TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;
+               A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=
+                    (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);
+
+               PROCEDURE P1 (X : OUT AR_SMALL) IS
+               BEGIN
+                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");
+               END P1;
+          BEGIN
+               IF LG_INT (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN
+                    P1 (AR_SMALL (A0));
+               ELSE
+                    COMMENT ("NOT APPLICABLE -P1 (D)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - P1 (D)");
+          END;
+
+     END; -- (D)
+
+     -----------------------------------------------
+
+     RESULT;
+
+END C64103D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103e.ada
new file mode 100644
index 000000000..7f022dfdf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103e.ada
@@ -0,0 +1,219 @@
+-- C64103E.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, FOR IN-OUT PARAMETERS OF AN ACCESS TYPE,
+--     CONSTRAINT_ERROR IS RAISED:
+--          BEFORE A SUBPROGRAM CALL WHEN THE BOUNDS OR DISCRIMINANTS
+--          OF THE ACTUAL DESIGNATED PARAMETER ARE DIFFERENT FROM
+--          THOSE OF THE FORMAL DESIGNATED PARAMETER;
+--          AFTER A SUBPROGRAM CALL WHEN THE BOUNDS OR DISCRIMINANTS
+--          OF THE FORMAL DESIGNATED PARAMETER ARE DIFFERENT FROM
+--          THOSE OF THE ACTUAL DESIGNATED PARAMETER.
+
+-- HISTORY:
+--     CPP  07/23/84  CREATED ORIGINAL TEST.
+--     VCL  10/27/87  MODIFIED THIS HEADER; ADDED STATEMENTS WHICH
+--                    REFERENCED THE ACTUAL PARAMETERS IN THE SECOND
+--                    SUBTEST.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64103E IS
+BEGIN
+     TEST ("C64103E", "FOR IN-OUT PARAMETERS OF AN ACCESS TYPE, " &
+                      "CONSTRAINT_ERROR IS RAISED:  BEFORE A " &
+                      "SUBPROGRAM CALL WHEN THE BOUNDS OR " &
+                      "DISCRIMINANTS OF THE ACTUAL DESIGNATED " &
+                      "PARAMETER ARE DIFFERENT FROM THOSE OF THE " &
+                      "FORMAL DESIGNATED PARAMETER;  AFTER A " &
+                      "SUBPROGRAM CALL WHEN THE BOUNDS OR " &
+                      "DISCRIMINANTS OF THE FORMAL DESIGNATED " &
+                      "PARAMETER ARE DIFFERENT FROM THOSE OF THE " &
+                      "ACTUAL DESIGNATED PARAMETER");
+
+
+     BEGIN
+          DECLARE
+               TYPE AST IS ACCESS STRING;
+               SUBTYPE AST_3 IS AST(1..3);
+               SUBTYPE AST_5 IS AST(3..5);
+               X_3 : AST_3 := NEW STRING(1..IDENT_INT(3));
+
+               PROCEDURE P1 (X : IN OUT AST_5) IS
+               BEGIN
+                    FAILED("EXCEPTION NOT RAISED BEFORE CALL -P1 (A)");
+               END P1;
+          BEGIN
+               P1 (AST_5 (X_3));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (A)");
+          END;
+
+          DECLARE
+               TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+               TYPE A_ARRAY IS ACCESS ARRAY_TYPE;
+               SUBTYPE A1_ARRAY IS A_ARRAY (1..IDENT_INT(3));
+               TYPE A2_ARRAY IS NEW A_ARRAY (2..4);
+               A0 : A1_ARRAY := NEW ARRAY_TYPE (1..3);
+
+               PROCEDURE P2 (X : IN OUT A2_ARRAY) IS
+               BEGIN
+                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P2 (A)");
+               END P2;
+          BEGIN
+               P2 (A2_ARRAY (A0));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P2 (A)");
+          END;
+
+          DECLARE
+               TYPE SUBINT IS RANGE 0..8;
+               TYPE REC1 (DISC : SUBINT := 8) IS
+                    RECORD
+                         FIELD : SUBINT := DISC;
+                    END RECORD;
+               TYPE A1_REC IS ACCESS REC1;
+               TYPE A2_REC IS NEW A1_REC(3);
+               A0 : A1_REC := NEW REC1(4);
+
+               PROCEDURE P3 (X : IN OUT A2_REC) IS
+               BEGIN
+                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL " &
+                            "-P3 (A)");
+               END P3;
+
+          BEGIN
+               P3 (A2_REC (A0));
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P3 (A)");
+          END;
+
+     END;
+
+
+     BEGIN
+          DECLARE
+               TYPE AST IS ACCESS STRING;
+               SUBTYPE AST_3 IS AST(IDENT_INT(1)..IDENT_INT(3));
+               X_3 : AST_3 := NEW STRING'(1..IDENT_INT(3) => 'A');
+               CALLED : BOOLEAN := FALSE;
+
+               PROCEDURE P1 (X : IN OUT AST) IS
+               BEGIN
+                    CALLED := TRUE;
+                    X := NEW STRING'(3..5 => 'C');
+               END P1;
+          BEGIN
+               P1 (AST (X_3));
+               IF X_3.ALL = STRING'(1 .. 3 => 'A') THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B1)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (B2)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL" &
+                                 "-P1 (B)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
+          END;
+
+          DECLARE
+               TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+               TYPE A_ARRAY IS ACCESS ARRAY_TYPE;
+               SUBTYPE A1_ARRAY IS A_ARRAY (1..IDENT_INT(3));
+               A0 : A1_ARRAY := NEW ARRAY_TYPE'(1..3 => TRUE);
+               CALLED : BOOLEAN := FALSE;
+
+               PROCEDURE P2 (X : IN OUT A_ARRAY) IS
+               BEGIN
+                    CALLED := TRUE;
+                    X := NEW ARRAY_TYPE'(2..4 => FALSE);
+               END P2;
+          BEGIN
+               P2 (A_ARRAY (A0));
+               IF A0.ALL = ARRAY_TYPE'(1 .. 3 => TRUE) THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B1)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (B2)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL" &
+                                 "-P1 (B)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P2 (B)");
+          END;
+
+          DECLARE
+               TYPE SUBINT IS RANGE 0..8;
+               TYPE REC1 (DISC : SUBINT := 8) IS
+                    RECORD
+                         FIELD : SUBINT := DISC;
+                    END RECORD;
+               TYPE A1_REC IS ACCESS REC1;
+               TYPE A2_REC IS NEW A1_REC;
+               A0 : A1_REC(4) := NEW REC1(4);
+               CALLED : BOOLEAN := FALSE;
+
+               PROCEDURE P3 (X : IN OUT A2_REC) IS
+               BEGIN
+                    CALLED := TRUE;
+                    X := NEW REC1;
+               END P3;
+
+          BEGIN
+               P3 (A2_REC (A0));
+               IF A0.ALL = REC1'(4,4) THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (B1)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (B2)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL" &
+                                 "-P1 (B)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P3 (B)");
+          END;
+
+     END;
+
+     RESULT;
+END C64103E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103f.ada
new file mode 100644
index 000000000..ac26400e2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64103f.ada
@@ -0,0 +1,144 @@
+-- C64103F.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, FOR OUT PARAMETERS OF AN ACCESS TYPE,
+--     CONSTRAINT_ERROR IS RAISED:
+--          AFTER A SUBPROGRAM CALL WHEN THE BOUNDS OR DISCRIMINANTS
+--          OF THE FORMAL DESIGNATED PARAMETER ARE DIFFERENT FROM
+--          THOSE OF THE ACTUAL DESIGNATED PARAMETER.
+
+-- HISTORY:
+--     CPP  07/23/84  CREATED ORIGINAL TEST.
+--     VCL  10/27/87  MODIFIED THIS HEADER; ADDED STATEMENTS WHICH
+--                    REFERENCE THE ACTUAL PARAMETERS.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64103F IS
+BEGIN
+     TEST ("C64103F", "FOR OUT PARAMETERS OF AN ACCESS TYPE, " &
+                      "CONSTRAINT_ERROR IS RAISED:  AFTER A " &
+                      "SUBPROGRAM CALL WHEN THE BOUNDS OR " &
+                      "DISCRIMINANTS OF THE FORMAL DESIGNATED " &
+                      "PARAMETER ARE DIFFERENT FROM THOSE OF THE " &
+                      "ACTUAL DESIGNATED PARAMETER");
+
+
+     BEGIN
+          DECLARE
+               TYPE AST IS ACCESS STRING;
+               SUBTYPE AST_3 IS AST(IDENT_INT(1)..IDENT_INT(3));
+               SUBTYPE AST_5 IS AST(3..5);
+               X_3 : AST_3 := NEW STRING'(1..IDENT_INT(3) => 'A');
+               CALLED : BOOLEAN := FALSE;
+
+               PROCEDURE P1 (X : OUT AST_5) IS
+               BEGIN
+                    CALLED := TRUE;
+                    X := NEW STRING'(3..5 => 'C');
+               END P1;
+          BEGIN
+               P1 (AST_5 (X_3));
+               IF X_3.ALL = STRING'(1 .. 3 => 'A') THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (A1)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P1 (A2)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P1 (A)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P1 (A)");
+          END;
+
+          DECLARE
+               TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+               TYPE A_ARRAY IS ACCESS ARRAY_TYPE;
+               SUBTYPE A1_ARRAY IS A_ARRAY (1..IDENT_INT(3));
+               TYPE A2_ARRAY IS NEW A_ARRAY (2..4);
+               A0 : A1_ARRAY := NEW ARRAY_TYPE'(1..3 => TRUE);
+               CALLED : BOOLEAN := FALSE;
+
+               PROCEDURE P2 (X : OUT A2_ARRAY) IS
+               BEGIN
+                    CALLED := TRUE;
+                    X := NEW ARRAY_TYPE'(2..4 => FALSE);
+               END P2;
+          BEGIN
+               P2 (A2_ARRAY (A0));
+               IF A0.ALL = ARRAY_TYPE'(1 .. 3 => TRUE) THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (A1)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P2 (A2)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P1 (A)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P2 (A)");
+          END;
+
+          DECLARE
+               TYPE SUBINT IS RANGE 0..8;
+               TYPE REC1 (DISC : SUBINT := 8) IS
+                    RECORD
+                         FIELD : SUBINT := DISC;
+                    END RECORD;
+               TYPE A1_REC IS ACCESS REC1;
+               TYPE A2_REC IS NEW A1_REC (3);
+               A0 : A1_REC(4) := NEW REC1(4);
+               CALLED : BOOLEAN := FALSE;
+
+               PROCEDURE P3 (X : OUT A2_REC) IS
+               BEGIN
+                    CALLED := TRUE;
+                    X := NEW REC1(3);
+               END P3;
+
+          BEGIN
+               P3 (A2_REC (A0));
+               IF A0.ALL = REC1'(4,4) THEN
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (A1)");
+               ELSE
+                    FAILED ("EXCEPTION NOT RAISED AFTER CALL -P3 (A2)");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                                 "-P1 (A)");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED -P3 (A)");
+          END;
+     END;
+
+     RESULT;
+END C64103F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104a.ada
new file mode 100644
index 000000000..4a66476ca
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104a.ada
@@ -0,0 +1,215 @@
+-- C64104A.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 CONSTRAINT_ERROR IS RAISED FOR OUT OF RANGE SCALAR
+--      ARGUMENTS.  SUBTESTS ARE:
+--           (A) STATIC IN ARGUMENT.
+--           (B) DYNAMIC IN ARGUMENT.
+--           (C) IN OUT, OUT OF RANGE ON CALL.
+--           (D) OUT, OUT OF RANGE ON RETURN.
+--           (E) IN OUT, OUT OF RANGE ON RETURN.
+
+-- HISTORY:
+--    DAS  01/14/81
+--    CPP  07/03/84
+--    LB   11/20/86  ADDED CODE TO ENSURE IN SUBTESTS WHICH CHECK
+--                     RETURNED VALUES, THAT SUBPROGRAMS ARE ACTUALLY
+--                     CALLED.
+--    JET  08/04/87  FIXED HEADER FOR STANDARD FORMAT.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64104A IS
+
+     SUBTYPE DIGIT IS INTEGER RANGE 0..9;
+
+     CALLED : BOOLEAN;
+     D    : DIGIT;
+     I    : INTEGER;
+     M1 : CONSTANT INTEGER := IDENT_INT(-1);
+     COUNT     : INTEGER := 0;
+     SUBTYPE SI IS INTEGER RANGE M1 .. 10;
+
+     PROCEDURE P1 (PIN : IN DIGIT; WHO : STRING) IS         -- (A), (B)
+     BEGIN
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - P1 " & WHO);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN P1 FOR " & WHO);
+     END P1;
+
+     PROCEDURE P2 (PINOUT : IN OUT DIGIT; WHO : STRING) IS  -- (C)
+     BEGIN
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - P2 " & WHO);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN P2 FOR " & WHO);
+     END P2;
+
+     PROCEDURE P3 (POUT : OUT SI; WHO : STRING) IS          -- (D)
+     BEGIN
+          IF WHO = "10" THEN
+               POUT := IDENT_INT(10);    -- (10 IS NOT A DIGIT)
+          ELSE
+               POUT := -1;
+          END IF;
+          CALLED := TRUE;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN P3 FOR " & WHO);
+     END P3;
+
+     PROCEDURE P4 (PINOUT : IN OUT INTEGER; WHO : STRING) IS     -- (E)
+     BEGIN
+          IF WHO = "10" THEN
+               PINOUT := 10;       -- (10 IS NOT A DIGIT)
+          ELSE
+               PINOUT := IDENT_INT(-1);
+          END IF;
+          CALLED := TRUE;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN P4 FOR" & WHO);
+     END P4;
+
+BEGIN
+
+     TEST ("C64104A", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "FOR OUT OF RANGE SCALAR ARGUMENTS");
+
+     BEGIN  -- (A)
+          P1 (10, "10");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P1 (10)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR P1 (10)");
+     END;  -- (A)
+
+     BEGIN  -- (B)
+          P1 (IDENT_INT (-1), "-1");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P1 (" &
+                  "IDENT_INT (-1))");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR P1 (" &
+                       "IDENT_INT (-1))");
+     END;  --(B)
+
+     BEGIN  -- (C)
+          I := IDENT_INT (10);
+          P2 (I, "10");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P2 (10)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR P2 (10)");
+     END;  -- (C)
+
+     BEGIN -- (C1)
+          I := IDENT_INT (-1);
+          P2 (I, "-1");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR P2 (-1)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR P2 (-1)");
+     END; -- (C1)
+
+     BEGIN  -- (D)
+          CALLED := FALSE;
+          D := IDENT_INT (1);
+          P3 (D, "10");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
+                  " P3 (10)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+               IF NOT CALLED THEN
+                    FAILED ("SUBPROGRAM P3 WAS NOT CALLED");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR P3 (10)");
+     END;  -- (D)
+
+     BEGIN -- (D1)
+          CALLED := FALSE;
+          D := IDENT_INT (1);
+          P3 (D, "-1");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
+                  " P3 (-1)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+               IF NOT CALLED THEN
+                    FAILED ("SUBPROGRAM P3 WAS NOT CALLED");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR P3 (-1)");
+     END; -- (D1)
+
+     BEGIN  -- (E)
+          CALLED := FALSE;
+          D := 9;
+          P4 (D, "10");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
+                  " P4 (10)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+               IF NOT CALLED THEN
+                    FAILED ("SUBPROGRAM P4 WAS NOT CALLED");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR P4 (10)");
+     END;  -- (E)
+
+     BEGIN -- (E1)
+          CALLED := FALSE;
+          D := 0;
+          P4 (D, "-1");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM" &
+                  " P4 (-1)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+               IF NOT CALLED THEN
+                    FAILED ("SUBPROGRAM P4 WAS NOT CALLED");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR P4 (-1)");
+     END; -- (E1)
+
+     IF (COUNT /= 8) THEN
+          FAILED ("INCORRECT NUMBER OF CONSTRAINT_ERRORS RAISED");
+     END IF;
+
+     RESULT;
+
+END C64104A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104b.ada
new file mode 100644
index 000000000..dc23f70eb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104b.ada
@@ -0,0 +1,136 @@
+-- C64104B.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 UNDER APPROPRIATE CIRCUMSTANCES
+--    WITH RESPECT TO PARAMETERS OF RECORD TYPES.  SUBTESTS INVOLVE 
+--    ACTUAL RECORD PARAMETERS WHOSE CONSTRAINT VALUES ARE NOT EQUAL 
+--    TO THE CONSTRAINTS ON THEIR CORRESPONDING FORMAL PARAMETERS:
+--        (A) IN PARAMETER, STATIC AGGREGATE.
+--        (B) IN PARAMETER, DYNAMIC AGGREGATE.
+--        (C) IN PARAMETER, VARIABLE.
+--        (D) IN OUT PARAMETER, EXCEPTION RAISED ON CALL.
+--        (E) OUT PARAMETER, EXCEPTION RAISED ON CALL.
+
+-- DAS 2/11/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C64104B IS
+
+     USE REPORT;
+     SUBTYPE INT IS INTEGER RANGE 0..10;
+     TYPE REC (N : INT := 0) IS
+          RECORD
+               A : STRING (1..N);
+          END RECORD;
+     SUBTYPE SREC IS REC(N=>3);
+     PROCEDURE P1 (R : IN SREC) IS
+     BEGIN
+          FAILED ("EXCEPTION NOT RAISED ON CALL TO P1");
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+     END P1;
+
+     PROCEDURE P2 (R : IN OUT SREC) IS
+     BEGIN
+          FAILED ("EXCEPTION NOT RAISED ON CALL TO P2");
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
+     END P2;
+
+     PROCEDURE P3 (R : OUT SREC) IS
+     BEGIN
+          FAILED ("EXCEPTION NOT RAISED ON CALL TO P3");
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
+     END P3;
+
+BEGIN
+
+     TEST ("C64104B", "CHECK RAISING OF CONSTRAINT_ERROR FOR " &
+                      "PARAMETERS OF RECORD TYPES");
+
+     BEGIN     -- (A)
+          P1 ((2,"AA"));
+          FAILED ("EXCEPTION NOT RAISED IN SUBTEST (A)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (A)");
+     END; -- (A)
+
+     BEGIN     -- (B)
+          P1 ((IDENT_INT(2), "AA"));
+          FAILED ("EXCEPTION NOT RAISED IN SUBTEST (B)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (B)");
+     END; -- (B)
+
+     DECLARE   -- (C)
+          R : REC     := (IDENT_INT(2), "AA");
+     BEGIN     -- (C)
+          P1 (R);
+          FAILED ("EXCEPTION NOT RAISED IN SUBTEST (C)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (C)");
+     END; -- (C)
+
+     DECLARE   -- (D)
+          R : REC     := (IDENT_INT(2), "AA");
+     BEGIN     -- (D)
+          P2 (R);
+          FAILED ("EXCEPTION NOT RAISED IN SUBTEST (D)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (D)");
+     END; -- (D)
+
+
+     DECLARE   -- (E)
+          R  : REC;
+     BEGIN     -- (E)
+          P3 (R);
+          FAILED ("EXCEPTION NOT RAISED IN SUBTEST (E)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (E)");
+     END; -- (E)
+
+     RESULT;
+
+END C64104B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104c.ada
new file mode 100644
index 000000000..894182cb9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104c.ada
@@ -0,0 +1,200 @@
+-- C64104C.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 UNDER THE
+--   APPROPRIATE CIRCUMSTANCES FOR ARRAY PARAMETERS, NAMELY
+--   WHEN THE ACTUAL BOUNDS DON'T MATCH THE FORMAL BOUNDS
+--   (BEFORE THE CALL FOR ALL MODES).
+--   SUBTESTS ARE:
+--      (A) IN MODE, ONE DIMENSION, STATIC AGGREGATE.
+--      (B) IN MODE, TWO DIMENSIONS, DYNAMIC AGGREGATE.
+--      (C) IN MODE, TWO DIMENSIONS, DYNAMIC VARIABLE.
+--      (D) IN OUT MODE, THREE DIMENSIONS, STATIC VARIABLE.
+--      (E) OUT MODE, ONE DIMENSION, DYNAMIC VARIABLE.
+--      (F) IN OUT MODE, NULL STRING AGGREGATE.
+--      (G) IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE (OK CASE).
+--          IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE.
+
+-- JRK 3/17/81
+-- SPS 10/26/82
+-- CPP 8/6/84
+-- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
+
+WITH REPORT;
+PROCEDURE C64104C IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104C", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+           "ACTUAL ARRAY BOUNDS DON'T MATCH FORMAL BOUNDS");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+          SUBTYPE ST IS STRING (1..3);
+
+          PROCEDURE P (A : ST) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED ON CALL - (A)");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (A)");
+          END P;
+
+     BEGIN -- (A)
+
+          P ("AB");
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (A)");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - (A)");
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          SUBTYPE S IS INTEGER RANGE 1..3;
+          TYPE T IS ARRAY (S,S) OF INTEGER;
+
+          PROCEDURE P (A : T) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED ON CALL - (B)");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (B)");
+          END P;
+
+     BEGIN -- (B)
+
+          P ((1..3 => (1..IDENT_INT(2) => 0)));
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (B)");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - (B)");
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          SUBTYPE S IS INTEGER RANGE 1..5;
+          TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF INTEGER;
+          SUBTYPE ST IS T (1..3,1..3);
+          V : T (1..IDENT_INT(2), 1..3) :=
+                (1..IDENT_INT(2) => (1..3 => 0));
+
+          PROCEDURE P (A :ST) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED ON CALL - (C)");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
+          END P;
+
+     BEGIN -- (C)
+
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (C)");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - (C)");
+     END; -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D)
+
+          SUBTYPE S IS INTEGER RANGE 1..5;
+          TYPE T IS ARRAY (S RANGE <>, S RANGE <>, S RANGE <>) OF
+                    INTEGER;
+          SUBTYPE ST IS T (1..3, 1..3, 1..3);
+          V : T (1..3, 1..2, 1..3) :=
+                (1..3 => (1..2 => (1..3 => 0)));
+
+          PROCEDURE P (A : IN OUT ST) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED ON CALLL - (D)");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
+          END P;
+
+     BEGIN -- (D)
+
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (D)");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - (D)");
+     END; -- (D)
+
+     --------------------------------------------------
+
+
+     DECLARE -- (G)
+
+          SUBTYPE S IS INTEGER RANGE 1..5;
+          TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF CHARACTER;
+          SUBTYPE ST IS T (2..1, 2..1);
+          V : T (2..1, 2..1) := (2..1 => (2..1 => ' '));
+
+          PROCEDURE P (A : IN OUT ST) IS
+          BEGIN
+               COMMENT ("OK CASE CALLED CORRECTLY");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (G)");
+          END P;
+
+     BEGIN -- (G)
+
+          P (V);
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED ON OK CASE - (G)");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED ON OK CASE - (G)");
+     END; -- (G)
+
+     --------------------------------------------------
+
+     --------------------------------------------------
+
+     RESULT;
+END C64104C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104d.ada
new file mode 100644
index 000000000..10dea0ef6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104d.ada
@@ -0,0 +1,93 @@
+-- C64104D.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 UNDER THE APPROPRIATE
+--   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+--   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+--   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+--   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+--   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (A) BEFORE CALL, IN MODE, STATIC PRIVATE DISCRIMINANT.
+
+-- JRK 3/18/81
+-- NL 10/13/81
+-- ABW 6/11/82
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C64104D IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104D", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+           "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          PACKAGE PKG IS
+               TYPE E IS (E1, E2, E3);
+               TYPE T (D : E := E1) IS PRIVATE;
+               TYPE AR IS ARRAY (E1 .. E3) OF INTEGER;
+          PRIVATE
+               TYPE T (D : E := E1) IS
+                    RECORD
+                         I : INTEGER;
+                         A : AR;
+                    END RECORD;
+          END PKG;
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE A1 IS A(E3);
+          V : A (E2) := NEW T (E2);
+
+          PROCEDURE P (X : A1) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED ON CALL");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE");
+          END P;
+
+     BEGIN
+
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     ------------------------------------------------
+
+     RESULT;
+
+END C64104D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104e.ada
new file mode 100644
index 000000000..c64634613
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104e.ada
@@ -0,0 +1,82 @@
+-- C64104E.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 UNDER THE APPROPRIATE
+--   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+--   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+--   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+--   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+--   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (B) BEFORE CALL, IN MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
+
+-- JRK 3/18/81
+-- NL 10/13/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C64104E IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104E", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+           "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          TYPE T IS ARRAY (BOOLEAN RANGE <>, CHARACTER RANGE <>) OF
+                    INTEGER;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE A1 IS A(BOOLEAN, 'A'..'C');
+          V : A := NEW T (BOOLEAN, 'A'..IDENT_CHAR('B'));
+
+          PROCEDURE P (X : A1) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED ON CALL");
+          EXCEPTION
+              WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE");
+          END P;
+
+     BEGIN
+
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64104E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104f.ada
new file mode 100644
index 000000000..f54e1169d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104f.ada
@@ -0,0 +1,79 @@
+-- C64104F.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 UNDER THE APPROPRIATE
+--   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+--   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+--   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+--   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+--   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (C) BEFORE CALL, IN OUT MODE, STATIC ONE DIMENSIONAL BOUNDS.
+
+-- JRK 3/18/81
+-- NL 10/13/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C64104F IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104F", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+           "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          TYPE A IS ACCESS STRING;
+          SUBTYPE A1 IS A(1..3);
+          V : A (2..4) := NEW STRING (2..4);
+
+          PROCEDURE P (X : IN OUT A1) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED ON CALL");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE");
+          END P;
+
+     BEGIN
+
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64104F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104g.ada
new file mode 100644
index 000000000..76550651f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104g.ada
@@ -0,0 +1,93 @@
+-- C64104G.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 UNDER THE APPROPRIATE
+--   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+--   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+--   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+--   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+--   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (D) BEFORE CALL, IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
+
+-- JRK 3/18/81
+-- NL 10/13/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C64104G IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104G", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+           "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+          SUBTYPE INT IS INTEGER RANGE 0..10;
+          TYPE T (C : CHARACTER := 'A';
+                  B : BOOLEAN := FALSE;
+                  I : INT := 0
+                 ) IS
+               RECORD
+                    J : INTEGER;
+                    CASE B IS
+                         WHEN FALSE =>
+                              K : INTEGER;
+                         WHEN TRUE =>
+                              S : STRING (1 .. I);
+                    END CASE;
+               END RECORD;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A ('Z', TRUE, 5);
+          V : A := NEW T ('Z', IDENT_BOOL(FALSE), 5);
+
+          PROCEDURE P (X : IN OUT SA ) IS
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED ON CALL");
+          EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN PROCEDURE");
+          END P;
+
+     BEGIN
+
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64104G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104h.ada
new file mode 100644
index 000000000..4d522806f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104h.ada
@@ -0,0 +1,111 @@
+-- C64104H.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 CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+--     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+--     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+--     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+--     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+--     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--         (E) AFTER RETURN, IN OUT MODE, STATIC LIMITED PRIVATE
+--             DISCRIMINANTS.
+
+-- HISTORY:
+--     JRK 03/18/81  CREATED ORIGINAL TEST.
+--     NL  10/13/81
+--     LB  11/25/86  ADDED CODE TO ENSURE THAT SUBPROGRAMS ARE
+--                   ACTUALLY BEING CALLED.
+--     BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.
+
+
+WITH REPORT;
+PROCEDURE C64104H IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104H", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+           "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          PACKAGE PKG IS
+               SUBTYPE INT IS INTEGER RANGE 0..10;
+               SUBTYPE CHAR IS CHARACTER RANGE 'A' .. 'C';
+               TYPE T (I : INT := 0; C : CHAR := 'A') IS
+                    LIMITED PRIVATE;
+          PRIVATE
+               TYPE T (I : INT := 0; C : CHAR := 'A') IS
+                    RECORD
+                         J : INTEGER;
+                         CASE C IS
+                              WHEN 'A' =>
+                                   K : INTEGER;
+                              WHEN 'B' =>
+                                   S : STRING (1..I);
+                              WHEN OTHERS =>
+                                   NULL;
+                         END CASE;
+                    END RECORD;
+          END PKG;
+          USE PKG;
+
+          CALLED : BOOLEAN;
+          TYPE A IS ACCESS T;
+
+          V : A (2,'B') := NEW T (2,'B');
+
+          PROCEDURE P (X : IN OUT A) IS
+          BEGIN
+               CALLED := TRUE;
+               X := NEW T (2,'A');
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE");
+          END P;
+
+     BEGIN
+
+          CALLED := FALSE;
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("SUBPROGRAM P WAS NOT CALLED");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64104H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104i.ada
new file mode 100644
index 000000000..ecd24e00f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104i.ada
@@ -0,0 +1,101 @@
+-- C64104I.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 CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+--     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+--     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+--     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+--     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+--     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--         (F) AFTER RETURN, IN OUT MODE, DYNAMIC THREE DIMENSIONAL
+--             BOUNDS.
+
+-- HISTORY:
+--     JRK 03/18/81  CREATED ORIGINAL TEST.
+--     NL  10/13/81
+--     LB  11/25/86  ADDED CODE TO ENSURE THAT SUBPROGRAMS ARE
+--                   ACTUALLY BEING CALLED.
+--     BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.
+
+
+WITH REPORT;
+PROCEDURE C64104I IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104I", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+           "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          CALLED : BOOLEAN;
+
+          TYPE E IS (E1, E2, E3);
+
+          TYPE T IS ARRAY (CHARACTER RANGE <>,
+                           E RANGE <>,
+                           BOOLEAN RANGE <>
+                          ) OF INTEGER;
+
+          TYPE A IS ACCESS T;
+
+          V : A ('A'..'Z', E1..E2, BOOLEAN) :=
+                    NEW T ('A'..'Z', E1..E2, BOOLEAN);
+
+          PROCEDURE P (X : IN OUT A) IS
+          BEGIN
+               CALLED := TRUE;
+               IF EQUAL (3,3) THEN
+                    X := NEW T ('A'..'Z', E2..E3, BOOLEAN);
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE");
+          END P;
+
+     BEGIN
+
+          CALLED := FALSE;
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("SUBPROGRAM P WAS NOT CALLED");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64104I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104j.ada
new file mode 100644
index 000000000..1577fc07b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104j.ada
@@ -0,0 +1,88 @@
+-- C64104J.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 CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+--     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+--     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+--     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+--     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+--     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--         (G) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, STATIC ONE
+--             DIMENSIONAL BOUNDS.
+
+-- HISTORY:
+--     JRK 03/18/81  CREATED ORIGINAL TEST.
+--     NL  10/13/81
+--     BCB 11/12/87  CHANGED HEADING TO STANDARD FORMAT.  ADDED CODE TO
+--                   ENSURE THAT SUBPROGRAMS ARE ACTUALLY CALLED.
+
+WITH REPORT;
+PROCEDURE C64104J IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104J", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+           "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          TYPE A IS ACCESS STRING;
+
+          CALLED : BOOLEAN := FALSE;
+
+          V : A (1..3) := NEW STRING (1..3);
+
+          PROCEDURE P (X : OUT A) IS
+          BEGIN
+               CALLED := TRUE;
+               X := NEW STRING (2..3);
+          EXCEPTION
+              WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE");
+          END P;
+
+     BEGIN
+
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("SUBPROGRAM P WAS NOT CALLED");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64104J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104k.ada
new file mode 100644
index 000000000..8819d3ce0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104k.ada
@@ -0,0 +1,95 @@
+-- C64104K.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 CONSTRAINT_ERROR IS RAISED UNDER THE APPROPRIATE
+--     CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+--     ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+--     TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+--     MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+--     ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--         (H) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, DYNAMIC
+--             RECORD DISCRIMINANT.
+
+-- HISTORY:
+--     JRK 03/18/81  CREATED ORIGINAL TEST.
+--     NL  10/13/81
+--     SPS 10/26/82
+--     BCB 11/12/87  CHANGED HEADING TO STANDARD FORMAT.  ADDED CODE TO
+--                   ENSURE THAT SUBPROGRAMS ARE ACTUALLY CALLED.
+
+WITH REPORT;
+PROCEDURE C64104K IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104K", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+           "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+          TYPE ARR IS ARRAY (BOOLEAN RANGE <>) OF INTEGER;
+          TYPE T (B : BOOLEAN := FALSE) IS
+               RECORD
+                    I : INTEGER;
+                    A : ARR (FALSE..B);
+               END RECORD;
+
+          TYPE A IS ACCESS T;
+
+          CALLED : BOOLEAN := FALSE;
+
+          V : A (IDENT_BOOL(FALSE)) := NEW T (IDENT_BOOL(FALSE));
+
+          PROCEDURE P (X : OUT A) IS
+          BEGIN
+               CALLED := TRUE;
+               X := NEW T (TRUE);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE");
+          END P;
+
+     BEGIN
+
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("SUBPROGRAM P WAS NOT CALLED");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64104K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104l.ada
new file mode 100644
index 000000000..1ecabfbbd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104l.ada
@@ -0,0 +1,109 @@
+-- C64104L.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 UNDER THE APPROPRIATE
+--   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+--   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+--   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+--   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+--   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (I) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, STATIC
+--           PRIVATE DISCRIMINANTS.
+
+-- JRK 3/18/81
+-- NL 10/13/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C64104L IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104L", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+           "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          PACKAGE PKG IS
+               TYPE E IS (E1, E2, E3);
+               TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
+                    PRIVATE;
+          PRIVATE
+               TYPE ARR IS ARRAY (E RANGE <>) OF INTEGER;
+               TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
+                    RECORD
+                         I : INTEGER;
+                         CASE B IS
+                              WHEN FALSE =>
+                                   J : INTEGER;
+                              WHEN TRUE =>
+                                   A : ARR (E1 .. D);
+                         END CASE;
+                    END RECORD;
+          END PKG;
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A(E2, TRUE);
+          V : A (E2, FALSE) := NEW T (E2, FALSE);
+
+          ENTERED : BOOLEAN := FALSE;
+
+          PROCEDURE P (X : OUT SA ) IS
+          BEGIN
+               ENTERED := TRUE;
+               X := NEW T (E2, TRUE);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE");
+          END P;
+
+     BEGIN
+
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT ENTERED THEN
+                    FAILED ("CONSTRAINT_ERROR RAISED BEFORE " & 
+                            "CALL");
+               END IF;
+          WHEN OTHERS =>
+               IF NOT ENTERED THEN
+                   FAILED ("OTHER EXCEPTION RAISED BEFORE CALL");
+               ELSE FAILED ("WRONG EXCEPTION RAISED AFTER " & 
+                            "RETURN");
+               END IF;
+     END;
+
+     ------------------------------------------------
+
+     RESULT;
+
+END C64104L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104m.ada
new file mode 100644
index 000000000..e08932120
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104m.ada
@@ -0,0 +1,95 @@
+-- C64104M.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 UNDER THE APPROPRIATE
+--   CIRCUMSTANCES FOR ACCESS PARAMETERS, NAMELY WHEN THE
+--   ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+--   TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+--   MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE 
+--   ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (J) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, DYNAMIC TWO
+--           DIMENSIONAL BOUNDS.
+
+-- JRK 3/18/81
+-- NL 10/13/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C64104M IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64104M", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+           "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          TYPE T IS ARRAY (INTEGER RANGE <>,
+                           CHARACTER RANGE <>
+                          ) OF INTEGER;
+
+          TYPE A IS ACCESS T;
+
+          V : A (1..10, 'A'..'Z') := NEW T (1..10, 'A'..'Z');
+
+          ENTERED : BOOLEAN := FALSE;
+          Y : CONSTANT CHARACTER := IDENT_CHAR('Y');
+          SUBTYPE SA IS A(1..10, 'A'..Y);
+          PROCEDURE P (X : OUT SA ) IS
+          BEGIN
+               ENTERED := TRUE;
+               X := NEW T (1..10, 'A'..IDENT_CHAR('Y'));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE");
+          END P;
+
+     BEGIN
+
+          P (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT ENTERED THEN
+                    FAILED ("CONSTRAINT_ERROR RAISED BEFORE " & 
+                            "CALL");
+               END IF;
+          WHEN OTHERS =>
+               IF NOT ENTERED THEN
+                    FAILED ("OTHER EXCEPTION RAISED BEFORE CALL");
+               ELSE FAILED ("WRONG EXCEPTION RAISED AFTER " & 
+                            "RETURN");
+               END IF;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64104M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104n.ada
new file mode 100644
index 000000000..6ee8ac403
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104n.ada
@@ -0,0 +1,116 @@
+-- C64104N.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 CONSTRAINT_ERROR IS RAISED AT THE PLACE OF THE CALL
+--     FOR THE CASE OF A PRIVATE TYPE IMPLEMENTED AS A SCALAR TYPE
+--     WHERE THE VALUE OF THE FORMAL PARAMETER DOES NOT BELONG TO THE
+--     SUBTYPE OF THE ACTUAL PARAMETER.
+
+-- HISTORY:
+--     DAVID A. TAFFS
+--     CPP 07/23/84
+--     RDH 04/18/90  REVISED TO CHECK THAT SUBPROGRAM IS ACTUALLY
+--                   CALLED.
+--     THS 09/21/90  REWORDED COMMENT STATING THAT THE TEST DOES NOT
+--                   ACCEPT THE LITERAL INTERPRETATION OF 6.4.1(9).
+
+WITH REPORT; USE REPORT;
+PROCEDURE C64104N IS
+
+BEGIN
+     TEST ("C64104N", "CHECK THAT PRIVATE TYPE (SCALAR) RAISES " &
+           "CONSTRAINT_ERROR WHEN ACTUAL AND FORMAL PARAMETER " &
+           "BOUNDS DIFFER");
+
+     DECLARE
+
+          CALLED : BOOLEAN := FALSE;
+
+          PACKAGE P IS
+               TYPE T IS PRIVATE;
+               DC : CONSTANT T;
+
+               GENERIC PACKAGE PP IS
+               END PP;
+          PRIVATE
+               TYPE T IS NEW INTEGER;
+               DC : CONSTANT T := -1;
+          END P;
+
+          PROCEDURE Q (X : IN OUT P.T) IS
+          BEGIN
+               CALLED := TRUE;
+               X := P.DC;
+               IF P. "=" (X, P.DC) THEN
+                    COMMENT("PROCEDURE Q WAS CALLED");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED("EXCEPTION RAISED INSIDE SUBPROGRAM");
+          END Q;
+
+          GENERIC
+               Y : IN OUT P.T;
+          PACKAGE CALL IS
+          END CALL;
+
+          PACKAGE BODY CALL IS
+          BEGIN
+               Q (Y);
+          END CALL;
+
+-- NOTE CALL HAS VARIABLE OF A PRIVATE TYPE AS AN OUT PARAMETER.  
+-- THIS TEST DOES NOT ACCEPT THE LITERAL INTERPRETATION OF 6.4.1(9).
+-- REFER TO ADA IMPLEMENTOR'S GUIDE 6.4.1 SEMANTIC RAMIFICATION 19
+-- AND AI-00025 FOR CLARIFICATION AS TO WHY THE LITERAL
+-- INTERPRETATION IS REJECTED.
+
+          PACKAGE BODY P IS
+               Z : T RANGE 0..1 := 0;
+               PACKAGE BODY PP IS
+                    PACKAGE CALL_Q IS NEW CALL(Z);
+               END PP;
+          END P;
+
+     BEGIN
+          BEGIN
+               DECLARE
+                    PACKAGE CALL_Q_NOW IS NEW P.PP;    -- EXCEPTION
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED("SUBPROGRAM Q WAS NOT CALLED");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED");
+          END;
+
+          RESULT;
+
+     END;
+END C64104N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104o.ada
new file mode 100644
index 000000000..5d390b0b0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64104o.ada
@@ -0,0 +1,112 @@
+-- C64104O.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 CONSTRAINT_ERROR IS RAISED AT THE PLACE OF THE CALL
+--    FOR THE CASE OF A PRIVATE TYPE IMPLEMENTED AS AN ACCESS TYPE WHERE
+--    THE ACTUAL BOUNDS OR DISCRIMINANTS OF THE DESIGNATED OBJECT DIFFER
+--    FROM THOSE OF THE FORMAL.
+
+-- HISTORY
+--    CPP 7/23/84 CREATED ORIGINAL TEST.
+--    DHH 8/31/87 ADDED COMMENT IN PROCEDURE Q SO THAT CODE WILL NOT BE
+--                OPTIMIZED OUT OF EXISTENCE.
+
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64104O IS
+
+BEGIN
+
+     TEST ("C64104O", "CHECK THAT PRIVATE TYPE (ACCESS) RAISES " &
+           "CONSTRAINT_ERROR WHEN ACTUAL AND FORMAL PARAMETER BOUNDS " &
+           "DIFFER");
+
+     DECLARE
+
+
+          CALLED : BOOLEAN := FALSE;
+
+          PACKAGE P IS
+               TYPE T IS PRIVATE;
+               DC : CONSTANT T;
+               GENERIC PACKAGE PP IS
+               END PP;
+          PRIVATE
+               TYPE T IS ACCESS STRING;
+               DC : CONSTANT T := NEW STRING'("AAA");
+          END P;
+
+          PROCEDURE Q (X : IN OUT P.T) IS
+
+          BEGIN
+
+               CALLED := TRUE;
+               X := P.DC;
+               IF P. "=" (X, P.DC) THEN
+                    COMMENT("PROCEDURE Q WAS CALLED");
+               END IF;
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED INSIDE SUBPROGRAM");
+          END Q;
+
+          GENERIC
+               Y : IN OUT P.T;
+          PACKAGE CALL IS
+          END CALL;
+
+          PACKAGE BODY CALL IS
+          BEGIN
+               Q(Y);
+          END CALL;
+
+          PACKAGE BODY P IS
+               Z : T(1..5) := NEW STRING'("CCCCC");
+               PACKAGE BODY PP IS
+                    PACKAGE CALL_Q IS NEW CALL(Z);
+               END PP;
+          END P;
+
+     BEGIN
+          BEGIN
+               DECLARE
+                    PACKAGE CALL_Q_NOW IS NEW P.PP;
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("SUBPROGRAM Q WAS NOT CALLED");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED");
+          END;
+
+          RESULT;
+     END;
+
+END C64104O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105a.ada
new file mode 100644
index 000000000..a1739097c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105a.ada
@@ -0,0 +1,84 @@
+-- C64105A.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 NOT RAISED AT THE TIME OF CALL WHEN 
+--   THE VALUE OF AN ACTUAL OUT SCALAR PARAMETER DOES NOT SATISFY THE 
+--   RANGE CONSTRAINTS OF THE FORMAL PARAMETER.
+
+-- DAS  1/29/81
+-- CPP  8/6/84
+
+WITH REPORT;
+PROCEDURE C64105A IS
+
+     USE REPORT;
+
+     SUBTYPE SUBINT1 IS INTEGER RANGE -10..10;
+     SUBTYPE SUBINT2 IS INTEGER RANGE -20..20;
+
+     I10  : SUBINT1 := 10;
+     I20  : SUBINT2 := 20;
+
+     PROCEDURE P1 (I : OUT SUBINT1) IS
+     BEGIN
+          I := SUBINT1'FIRST;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+     END P1;
+
+BEGIN
+
+     TEST ("C64105A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED" &
+                      " AT THE TIME OF CALL WHEN THE VALUE OF AN" &
+                      " ACTUAL OUT SCALAR PARAMETER DOES NOT" &
+                      " SATISFY THE RANGE CONSTRAINTS OF THE FORMAL" &
+                      " PARAMETER");
+
+     DECLARE
+     BEGIN
+          P1 (SUBINT1(I20));
+          IF I20 /= IDENT_INT(-10) THEN
+               FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 1");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED ON CALL TO P1 - 1");
+     END;
+
+     DECLARE
+     BEGIN
+          I20 := IDENT_INT(20);
+          P1 (I20);
+          IF I20 /= IDENT_INT(-10) THEN
+               FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 2");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED ON CALL TO P1 - 2");
+     END;
+
+     RESULT;
+
+END C64105A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105b.ada
new file mode 100644
index 000000000..4eb217a72
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105b.ada
@@ -0,0 +1,184 @@
+-- C64105B.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 NOT RAISED FOR ACCESS PARAMETERS
+--   IN THE FOLLOWING CIRCUMSTANCES:
+--       (1) BEFORE THE CALL, WHEN AN IN OR IN OUT ACTUAL ACCESS
+--           PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS DIFFERENT 
+--           FROM THE FORMAL PARAMETER.
+--       (2)
+--       (3)
+--   SUBTESTS ARE:
+--       (A) CASE 1, IN MODE, STATIC ONE DIMENSIONAL BOUNDS.
+--       (B) CASE 1, IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
+--       (C) CASE (A), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
+--       (D) CASE (B), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
+
+-- JRK 3/20/81
+-- SPS 10/26/82
+-- CPP 8/6/84
+
+WITH REPORT;
+PROCEDURE C64105B IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64105B", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+           "BEFORE THE CALL, WHEN AN IN OR IN OUT ACTUAL ACCESS " &
+           "PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS DIFFERENT " &
+           "FROM THE FORMAL PARAMETER" );
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          TYPE E IS (E1, E2, E3, E4);
+          TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A(E2..E4);
+          V : A (E1..E2) := NULL;
+
+          PROCEDURE P (X : SA ) IS
+          BEGIN
+               NULL;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (A)");
+          END P;
+     
+     BEGIN -- (A)
+
+          P (V);
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (A)");
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+          TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
+          TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
+               RECORD
+                    I : INTEGER;
+                    CASE B IS
+                         WHEN FALSE =>
+                              J : INTEGER;
+                         WHEN TRUE =>
+                              A : ARR ('A' .. C);
+                    END CASE;
+               END RECORD;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A(TRUE, 'C');
+          V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
+
+          PROCEDURE P (X : IN OUT SA ) IS
+          BEGIN
+               NULL;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (B)");
+          END P;
+
+     BEGIN -- (B)
+
+          P (V);
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (B)");
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          TYPE E IS (E1, E2, E3, E4);
+          TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A(E2..E4);
+          V : A (E1..E2) := NULL;
+
+          PROCEDURE P (X : SA ) IS
+          BEGIN
+               NULL;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
+          END P;
+     
+     BEGIN -- (C)
+
+          P (SA(V));
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (C)");
+     END; -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D)
+          TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
+          TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
+               RECORD
+                    I : INTEGER;
+                    CASE B IS
+                         WHEN FALSE =>
+                              J : INTEGER;
+                         WHEN TRUE =>
+                              A : ARR ('A' .. C);
+                    END CASE;
+               END RECORD;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A(TRUE, 'C');
+          V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
+
+          PROCEDURE P (X : IN OUT SA ) IS
+          BEGIN
+               NULL;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
+          END P;
+
+     BEGIN -- (D)
+
+          P (SA(V));
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (D)");
+     END; -- (D)
+
+     --------------------------------------------------
+
+     RESULT;
+END C64105B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105c.ada
new file mode 100644
index 000000000..32fc9b635
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105c.ada
@@ -0,0 +1,230 @@
+-- C64105C.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 NOT RAISED FOR ACCESS PARAMETERS
+--   IN THE FOLLOWING CIRCUMSTANCES:
+--       (1)
+--       (2) AFTER THE CALL, WHEN AN IN OUT OR OUT FORMAL 
+--           ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS 
+--           DIFFERENT CONSTRAINTS.
+--       (3)
+--   SUBTESTS ARE:
+--       (C) CASE 2, IN OUT MODE, STATIC PRIVATE DISCRIMINANT.
+--       (D) CASE 2, OUT MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
+--       (E) SAME AS (C), WITH TYPE CONVERSION.
+--       (F) SAME AS (D), WITH TYPE CONVERSION.
+
+-- JRK 3/20/81
+-- SPS 10/26/82
+-- CPP 8/8/84
+
+WITH REPORT;
+PROCEDURE C64105C IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64105C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+           "AFTER THE CALL, WHEN AN IN OUT OR OUT FORMAL " &
+           "ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS " &
+           "DIFFERENT CONSTRAINTS" );
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          PACKAGE PKG IS
+               TYPE E IS (E1, E2);
+               TYPE T (D : E := E1) IS PRIVATE;
+          PRIVATE
+               TYPE T (D : E := E1) IS
+                    RECORD
+                         I : INTEGER;
+                         CASE D IS
+                              WHEN E1 =>
+                                   B : BOOLEAN;
+                              WHEN E2 =>
+                                   C : CHARACTER;
+                         END CASE;
+                    END RECORD;
+          END PKG;
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A(E2);
+          V : A (E1) := NULL;
+          ENTERED : BOOLEAN := FALSE;
+
+          PROCEDURE P (X : IN OUT SA) IS
+          BEGIN
+               ENTERED := TRUE;
+               X := NULL;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
+          END P;
+
+     BEGIN -- (C)
+
+          P (V);
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT ENTERED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (C)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (C)");
+     END; -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D)
+
+          TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
+                    INTEGER;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
+          V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
+                 IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
+          ENTERED : BOOLEAN := FALSE;
+
+          PROCEDURE P (X : OUT SA) IS
+          BEGIN
+               ENTERED := TRUE;
+               X := NULL;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
+          END P;
+
+     BEGIN -- (D)
+
+          P (V);
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT ENTERED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (D)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (D)");
+     END; -- (D)
+
+     --------------------------------------------------
+
+     DECLARE -- (E)
+
+          PACKAGE PKG IS
+               TYPE E IS (E1, E2);
+               TYPE T (D : E := E1) IS PRIVATE;
+          PRIVATE
+               TYPE T (D : E := E1) IS
+                    RECORD
+                         I : INTEGER;
+                         CASE D IS
+                              WHEN E1 =>
+                                   B : BOOLEAN;
+                              WHEN E2 =>
+                                   C : CHARACTER;
+                         END CASE;
+                    END RECORD;
+          END PKG;
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A(E2);
+          V : A (E1) := NULL;
+          ENTERED : BOOLEAN := FALSE;
+
+          PROCEDURE P (X : IN OUT SA) IS
+          BEGIN
+               ENTERED := TRUE;
+               X := NULL;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
+          END P;
+
+     BEGIN -- (E)
+
+          P (SA(V));
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT ENTERED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (E)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (E)");
+     END; -- (E)
+
+     --------------------------------------------------
+
+     DECLARE -- (F)
+
+          TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
+                    INTEGER;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
+          V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
+                 IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
+          ENTERED : BOOLEAN := FALSE;
+
+          PROCEDURE P (X : OUT SA) IS
+          BEGIN
+               ENTERED := TRUE;
+               X := NULL;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
+          END P;
+
+     BEGIN -- (D)
+
+          P (SA(V));
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT ENTERED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (F)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (F)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (F)");
+     END; -- (F)
+
+     --------------------------------------------------
+
+     RESULT;
+END C64105C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105d.ada
new file mode 100644
index 000000000..f70b49a2c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64105d.ada
@@ -0,0 +1,134 @@
+-- C64105D.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 NOT RAISED FOR ACCESS PARAMETERS
+--   IN THE FOLLOWING CIRCUMSTANCES:
+--       (1)
+--       (2)
+--       (3) BEFORE OR AFTER THE CALL, WHEN AN UNCONSTRAINED ACTUAL 
+--           OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR TO THE
+--           CALL) WITH CONSTRAINTS DIFFERENT FROM THE FORMAL
+--           PARAMETER.
+--   SUBTESTS ARE:
+--       (G) CASE 3, STATIC LIMITED PRIVATE DISCRIMINANT.
+--       (H) CASE 3, DYNAMIC ONE DIMENSIONAL BOUNDS.
+
+-- JRK 3/20/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C64105D IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64105D", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+           "BEFORE AND AFTER THE CALL, WHEN AN UNCONSTRAINED ACTUAL " &
+           "OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR TO THE " &
+           "CALL) WITH CONSTRAINTS DIFFERENT FROM THE FORMAL " &
+           "PARAMETER" );
+
+     --------------------------------------------------
+
+     DECLARE -- (G)
+
+          PACKAGE PKG IS
+               SUBTYPE INT IS INTEGER RANGE 0..5;
+               TYPE T (I : INT := 0) IS LIMITED PRIVATE; 
+          PRIVATE          
+               TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+               TYPE T (I : INT := 0) IS 
+                    RECORD
+                         J : INTEGER;
+                         A : ARR (1..I);
+                    END RECORD;
+          END PKG;
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A(3);
+          V : A := NEW T (2);
+          CALLED : BOOLEAN := FALSE;
+
+          PROCEDURE P (X : OUT SA) IS
+          BEGIN
+               CALLED := TRUE;
+               X := NEW T (3);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (G)");
+          END P;
+
+     BEGIN -- (G)
+ 
+          P (V);
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (G)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (G)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (G)");
+     END; -- (G)
+
+     --------------------------------------------------
+
+     DECLARE -- (H)
+
+          TYPE A IS ACCESS STRING;
+          SUBTYPE SA IS A (1..2);
+          V : A := NEW STRING (IDENT_INT(5) .. IDENT_INT(7));
+          CALLED : BOOLEAN := FALSE;
+
+          PROCEDURE P (X : OUT SA) IS
+          BEGIN
+               CALLED := TRUE;
+               X := NEW STRING (IDENT_INT(1) .. IDENT_INT(2));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (H)");
+          END P;
+
+     BEGIN -- (H)
+
+          P (V);
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (H)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (H)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (H)");
+     END; -- (H)
+
+     --------------------------------------------------
+
+     RESULT;
+END C64105D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106a.ada
new file mode 100644
index 000000000..a74a91b68
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106a.ada
@@ -0,0 +1,351 @@
+-- C64106A.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 UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
+--   FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
+--   SUBTESTS ARE:
+--        (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
+--        (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
+--        (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
+--        (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
+
+-- DAS  1/15/81
+-- JBG  5/16/83
+-- CPP  5/22/84
+
+WITH REPORT;
+PROCEDURE C64106A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C64106A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
+                      "UNCONSTRAINED FORMAL PARAMETERS");
+
+     DECLARE  -- (A)
+
+          PACKAGE PKG IS
+
+              SUBTYPE INT IS INTEGER RANGE 0..100;
+
+              TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                    RECORD
+                         INTFIELD  : INTEGER;
+                         STRFIELD  : STRING (1..CONSTRAINT);
+                    END RECORD;
+
+               REC1  : RECTYPE   := (10,10,"0123456789");
+               REC2  : RECTYPE   := (17,7,"C64106A..........");
+               REC3  : RECTYPE   := (1,1,"A");
+               REC4  : RECTYPE;  -- 80
+
+               PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE := (2,0,"AB");
+                                       REC2 : OUT RECTYPE;
+                                       REC3 : IN OUT RECTYPE);
+
+               PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
+          END PKG;
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE := (2,0,"AB");
+                                       REC2 : OUT RECTYPE;
+                                       REC3 : IN OUT RECTYPE) IS
+               BEGIN
+                    IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
+                         FAILED ("RECORD TYPE IN PARAMETER DID " &
+                                 "NOT USE CONSTRAINT OF ACTUAL");
+                    END IF;
+                    IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
+                         FAILED ("RECORD TYPE OUT PARAMETER DID " &
+                                 "NOT USE CONSTRAINT OF ACTUAL");
+                    END IF;
+                    IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
+                         FAILED ("RECORD TYPE IN OUT PARAMETER DID " &
+                                 "NOT USE CONSTRAINT OF ACTUAL");
+                    END IF;
+                    REC2 := PKG.REC2;
+               END CHK_RECTYPE1;
+
+               PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
+               BEGIN
+                    IF (REC.CONSTRAINT /= IDENT_INT(80)) THEN
+                         FAILED ("RECORD TYPE OUT PARAMETER DID " &
+                                 "NOT USE CONSTRAINT OF " &
+                                 "UNINITIALIZED ACTUAL");
+                    END IF;
+                    REC := (10,10,"9876543210");
+               END CHK_RECTYPE2;
+          END PKG;
+
+     BEGIN  -- (A)
+
+          PKG.CHK_RECTYPE1 (PKG.REC1, PKG.REC2, PKG.REC3);
+          PKG.CHK_RECTYPE2 (PKG.REC4);
+
+     END;   -- (A)
+
+     ---------------------------------------------
+
+B :  DECLARE  -- (B)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INT IS INTEGER RANGE 0..100;
+
+               TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
+
+
+               PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
+                                       REC2 : OUT RECTYPE;
+                                       REC3 : IN OUT RECTYPE);
+
+               PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
+
+          PRIVATE
+               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                    RECORD
+                         INTFIELD  : INTEGER;
+                         STRFIELD  : STRING (1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC1  : PKG.RECTYPE(10);
+          REC2  : PKG.RECTYPE(17);   
+          REC3  : PKG.RECTYPE(1);    
+          REC4  : PKG.RECTYPE(10);
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
+                                       REC2 : OUT RECTYPE;
+                                       REC3 : IN OUT RECTYPE) IS
+               BEGIN
+                    IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
+                         FAILED ("PRIVATE TYPE IN PARAMETER DID " &
+                                 "NOT USE CONSTRAINT OF ACTUAL");
+                    END IF;
+                    IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
+                         FAILED ("PRIVATE TYPE OUT PARAMETER DID " &
+                                 "NOT USE CONSTRAINT OF ACTUAL");
+                    END IF;
+                    IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
+                         FAILED ("PRIVATE TYPE IN OUT PARAMETER DID " &
+                                 "NOT USE CONSTRAINT OF ACTUAL");
+                    END IF;
+                    REC2 := B.REC2;
+               END CHK_RECTYPE1;
+
+               PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
+               BEGIN
+                    IF (REC.CONSTRAINT /= IDENT_INT(10)) THEN
+                         FAILED ("PRIVATE TYPE OUT PARAMETER DID " &
+                                 "NOT USE CONSTRAINT OF " &
+                                 "UNINITIALIZED ACTUAL");
+                    END IF;
+                    REC := (10,10,"9876543210");
+               END CHK_RECTYPE2;
+
+          BEGIN
+               REC1 := (10,10,"0123456789");
+               REC2 := (17,7,"C64106A..........");
+               REC3 := (1,1,"A");
+
+          END PKG;
+
+     BEGIN  -- (B)
+
+          PKG.CHK_RECTYPE1 (REC1, REC2, REC3);
+          PKG.CHK_RECTYPE2 (REC4);
+
+     END B;  -- (B)
+
+     ---------------------------------------------
+
+C :  DECLARE  -- (C)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INT IS INTEGER RANGE 0..100;
+
+               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                    LIMITED PRIVATE;
+
+               PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
+                                       REC2 : OUT RECTYPE;
+                                       REC3 : IN OUT RECTYPE);
+
+               PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
+
+          PRIVATE
+               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                    RECORD
+                         INTFIELD  : INTEGER;
+                         STRFIELD  : STRING (1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC1  : PKG.RECTYPE;     -- 10   
+          REC2  : PKG.RECTYPE;     -- 17
+          REC3  : PKG.RECTYPE;     --  1
+          REC4  : PKG.RECTYPE;     -- 80
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
+                                       REC2 : OUT RECTYPE;
+                                       REC3 : IN OUT RECTYPE) IS
+               BEGIN
+                    IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
+                         FAILED ("LIMITED PRIVATE TYPE IN PARAMETER " &
+                                 "DID NOT USE CONSTRAINT OF " &
+                                 "ACTUAL");
+                    END IF;
+                    IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
+                         FAILED ("LIMITED PRIVATE TYPE OUT PARAMETER " &
+                                 "DID NOT USE CONSTRAINT OF " &
+                                 "ACTUAL");
+                    END IF;
+                    IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
+                         FAILED ("LIMITED PRIVATE TYPE IN OUT " &
+                                 "PARAMETER DID NOT USE " &
+                                 "CONSTRAINT OF ACTUAL");
+                    END IF;
+                    REC2 := C.REC2;
+               END CHK_RECTYPE1;
+
+               PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
+               BEGIN
+                    IF (REC.CONSTRAINT /= IDENT_INT(80)) THEN
+                         FAILED ("LIMITED PRIVATE TYPE OUT " &
+                                 "PARAMETER DID NOT USE " &
+                                 "CONSTRAINT OF UNINITIALIZED ACTUAL");
+                    END IF;
+                    REC := (10,10,"9876543210");
+               END CHK_RECTYPE2;
+
+          BEGIN
+               REC1 := (10,10,"0123456789");
+               REC2 := (17,7,"C64106A..........");
+               REC3 := (1,1,"A");
+          END PKG;
+
+     BEGIN  -- (C)
+
+          PKG.CHK_RECTYPE1 (REC1, REC2, REC3);
+          PKG.CHK_RECTYPE2 (REC4);
+
+     END C;   -- (C)
+
+     ---------------------------------------------
+
+D :  DECLARE  -- (D)
+
+          TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
+               CHARACTER;
+
+          A1, A2, A3  : ATYPE(-1..1, 4..5)  := (('A','B'),
+                                                ('C','D'),
+                                                ('E','F'));
+
+          A4  : ATYPE(-1..1, 4..5);
+
+          CA1 : CONSTANT ATYPE(8..9, -7..INTEGER'FIRST) := 
+                              (8..9 => (-7..INTEGER'FIRST => 'A'));
+
+          S1  : STRING(1..INTEGER'FIRST) := "";
+          S2  : STRING(-5..-7) := "";
+          S3  : STRING(1..0) := "";
+
+          PROCEDURE CHK_ARRAY1 (A1 : IN ATYPE := CA1;  A2 : OUT ATYPE;
+                                A3 : IN OUT ATYPE) IS
+          BEGIN
+               IF ((A1'FIRST(1) /= IDENT_INT(-1)) OR
+                   (A1'LAST(1)  /= IDENT_INT(1)) OR
+                   (A1'FIRST(2) /= IDENT_INT(4)) OR
+                   (A1'LAST(2)  /= IDENT_INT(5))) THEN
+                    FAILED ("ARRAY TYPE IN PARAMETER DID NOT " &
+                            "USE CONSTRAINTS OF ACTUAL");
+               END IF;
+               IF ((A2'FIRST(1) /= IDENT_INT(-1)) OR
+                   (A2'LAST(1)  /= IDENT_INT(1)) OR
+                   (A2'FIRST(2) /= IDENT_INT(4)) OR
+                   (A2'LAST(2)  /= IDENT_INT(5))) THEN
+                    FAILED ("ARRAY TYPE OUT PARAMETER DID NOT USE" &
+                            "CONSTRAINTS OF ACTUAL");
+               END IF;
+               IF ((A3'FIRST(1) /= IDENT_INT(-1)) OR
+                   (A3'LAST(1)  /= IDENT_INT(1)) OR
+                   (A3'FIRST(2) /= IDENT_INT(4)) OR
+                   (A3'LAST(2)  /= IDENT_INT(5))) THEN
+                    FAILED ("ARRAY TYPE IN OUT PARAMETER DID NOT " &
+                            "USE CONSTRAINTS OF ACTUAL");
+               END IF;
+               A2 := D.A2;
+          END CHK_ARRAY1;
+
+          PROCEDURE CHK_ARRAY2 (A4 : OUT ATYPE) IS
+          BEGIN
+               IF ((A4'FIRST(1) /= IDENT_INT(-1)) OR
+                   (A4'LAST(1)  /= IDENT_INT(1)) OR
+                   (A4'FIRST(2) /= IDENT_INT(4)) OR
+                   (A4'LAST(2)  /= IDENT_INT(5))) THEN
+                    FAILED ("ARRAY TYPE OUT PARAMETER DID NOT " &
+                            "USE CONSTRAINTS OF UNINITIALIZED " &
+                            "ACTUAL");
+               END IF;
+               A4 := A2;
+          END CHK_ARRAY2;
+
+          PROCEDURE CHK_STRING (S1 : IN STRING;
+                                S2 : IN OUT STRING;
+                                S3 : OUT STRING) IS
+          BEGIN
+               IF ((S1'FIRST /= IDENT_INT(1)) OR
+                   (S1'LAST  /= IDENT_INT(INTEGER'FIRST))) THEN
+                    FAILED ("STRING TYPE IN PARAMETER DID NOT " &
+                            "USE CONSTRAINTS OF ACTUAL NULL " &
+                            "STRING");
+               END IF;
+               IF ((S2'FIRST /= IDENT_INT(-5)) OR
+                   (S2'LAST  /= IDENT_INT(-7))) THEN 
+                    FAILED ("STRING TYPE IN OUT PARAMETER DID NOT " &
+                            "USE CONSTRAINTS OF ACTUAL NULL STRING");
+               END IF;
+               IF ((S3'FIRST /= IDENT_INT(1)) OR
+                   (S3'LAST  /= IDENT_INT(0))) THEN
+                    FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
+                            "USE CONSTRAINTS OF ACTUAL NULL STRING");
+               END IF;
+               S3 := "";
+          END CHK_STRING;
+
+     BEGIN  -- (D)
+          CHK_ARRAY1 (A1, A2, A3);
+          CHK_ARRAY2 (A4);
+          CHK_STRING (S1, S2, S3);
+     END D;  -- (D)
+
+     RESULT;
+END C64106A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106b.ada
new file mode 100644
index 000000000..95d6fe195
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106b.ada
@@ -0,0 +1,237 @@
+-- C64106B.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 ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED RECORD,
+--   PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT DEFAULT CONSTRAINTS
+--   RAISE CONSTRAINT_ERROR IF AN ATTEMPT IS MADE TO CHANGE THE 
+--   CONSTRAINT OF THE ACTUAL PARAMETER.
+--   SUBTESTS ARE:
+--        (A) RECORD TYPE.
+--        (B) PRIVATE TYPE.
+--        (C) LIMITED PRIVATE TYPE.
+
+-- DAS  1/15/81
+-- CPP  8/9/84
+
+WITH REPORT;
+PROCEDURE C64106B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST ("C64106B", "CHECK ASSIGNMENT TO FORMAL PARAMETERS OF " &
+                      "UNCONSTRAINED TYPE (WITH NO DEFAULT)");
+
+     --------------------------------------------------
+
+     DECLARE  -- (A)
+
+          PACKAGE PKG IS
+
+               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                    RECORD
+                         INTFIELD  : INTEGER;
+                         STRFIELD  : STRING (1..CONSTRAINT);
+                    END RECORD;
+
+               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                      REC6 : IN OUT RECTYPE);
+          END PKG;
+
+          REC9 : PKG.RECTYPE(IDENT_INT(9))    :=
+                 (IDENT_INT(9), 9, "123456789");
+          REC6 : PKG.RECTYPE(IDENT_INT(6))    :=
+                 (IDENT_INT(6), 5, "AEIOUY");
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                      REC6 : IN OUT RECTYPE) IS
+
+                    REC4 : CONSTANT RECTYPE(IDENT_INT(4)) :=
+                           (IDENT_INT(4), 4, "OOPS"); 
+
+               BEGIN
+                    BEGIN  -- (A.1)
+                         REC9 := REC6;
+                         FAILED ("CONSTRAINT_ERROR NOT RAISED - A.1");
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION RAISED - A.1");
+                    END;   -- (A.1)
+
+                    BEGIN  -- (A.2)
+                         REC6 := REC4;
+                         FAILED ("CONSTRAINT_ERROR NOT RAISED - A.2");
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION RAISED - A.2");
+                    END;   -- (A.2)
+
+                    REC9 := (IDENT_INT(9), 9, "987654321");
+
+               END CHK_RECTYPE;
+          END PKG;
+
+     BEGIN  -- (A)
+
+          PKG.CHK_RECTYPE (REC9, REC6);
+          IF REC9.STRFIELD /= IDENT_STR("987654321") THEN
+               FAILED ("ASSIGNMENT TO REC9 FAILED - (A)");
+          END IF;
+
+     END;   -- (A)
+
+     --------------------------------------------------
+
+     DECLARE  -- (B)
+
+          PACKAGE PKG IS
+
+               TYPE RECTYPE (CONSTRAINT : INTEGER) IS PRIVATE;
+
+               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                      REC6 : IN OUT RECTYPE);
+          PRIVATE
+               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                    RECORD
+                         INTFIELD  : INTEGER;
+                         STRFIELD  : STRING (1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC9 : PKG.RECTYPE(9);
+          REC6 : PKG.RECTYPE(6);
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                      REC6 : IN OUT RECTYPE) IS
+
+                    REC4 : CONSTANT RECTYPE(4)  := (4, 4, "OOPS"); 
+
+               BEGIN
+                    BEGIN  -- (B.1)
+                         REC9 := REC6;
+                         FAILED ("CONSTRAINT_ERROR NOT RAISED - B.1");
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION RAISED - B.1");
+                    END;   -- (B.1)
+
+                    BEGIN  -- (B.2)
+                         REC6 := REC4;
+                         FAILED ("CONSTRAINT_ERROR NOT RAISED - B.2");
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION RAISED - B.2");
+                    END;   -- (B.2)
+               END CHK_RECTYPE;
+
+          BEGIN
+               REC9 := (9, 9, "123456789");
+               REC6 := (6, 5, "AEIOUY");
+          END PKG;
+
+     BEGIN  -- (B)
+
+          PKG.CHK_RECTYPE (REC9, REC6);
+
+     END;   -- (B)
+
+     --------------------------------------------------
+
+     DECLARE  -- (C)
+
+          PACKAGE PKG IS
+
+               TYPE RECTYPE (CONSTRAINT : INTEGER) IS LIMITED PRIVATE;
+
+               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                      REC6 : IN OUT RECTYPE);
+          PRIVATE
+               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                    RECORD
+                         INTFIELD  : INTEGER;
+                         STRFIELD  : STRING (1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC6 : PKG.RECTYPE(IDENT_INT(6));
+          REC9 : PKG.RECTYPE(IDENT_INT(9));
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
+                                      REC6 : IN OUT RECTYPE) IS
+
+                    REC4 : CONSTANT RECTYPE(4)  := (4, 4, "OOPS"); 
+
+               BEGIN
+                    BEGIN  -- (C.1)
+                         REC9 := REC6;
+                         FAILED ("CONSTRAINT_ERROR NOT RAISED - C.1");
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION RAISED - C.1");
+                    END;   -- (C.1)
+
+                    BEGIN  -- (C.2)
+                         REC6 := REC4;
+                         FAILED ("CONSTRAINT_ERROR NOT RAISED - C.2");
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION RAISED - C.2");
+                    END;   -- (C.2)
+               END CHK_RECTYPE;
+
+          BEGIN
+               REC6 := (6, 5, "AEIOUY");
+               REC9 := (9, 9, "123456789");
+          END PKG;
+
+     BEGIN  -- (C)
+
+          PKG.CHK_RECTYPE (REC9, REC6);
+
+     END;   -- (C)
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64106B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106c.ada
new file mode 100644
index 000000000..9adfa4d81
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106c.ada
@@ -0,0 +1,309 @@
+-- C64106C.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 ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED
+--    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
+--    CONSTRAINTS RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER IS
+--    CONSTRAINED AND THE CONSTRAINT VALUES OF THE OBJECT BEING
+--    ASSIGNED TO DO NOT SATISFY THOSE OF THE ACTUAL PARAMETER.  
+
+--    SUBTESTS ARE:
+--        (A) CONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
+--        (B) CONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
+--        (C) CONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
+
+-- DAS  1/16/81
+-- VKG  1/7/83
+-- CPP  8/9/84
+
+WITH REPORT;
+PROCEDURE C64106C IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST ("C64106C", "CHECK ASSIGNMENTS TO FORMAL PARAMETERS OF " &
+                      "UNCONSTRAINED TYPES (WITH DEFAULTS)");
+
+     --------------------------------------------------
+
+     DECLARE  -- (A)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+
+               REC91,REC92,REC93  : RECTYPE(9);
+               REC_OOPS           : RECTYPE(4);
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE);
+          END PKG;
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE) IS
+
+                    PROCEDURE P1 (REC11 : IN RECTYPE;
+                                  REC12 : IN OUT RECTYPE;
+                                  REC13 : OUT RECTYPE) IS
+                    BEGIN
+                         IF (NOT REC11'CONSTRAINED) OR
+                            (REC11.CONSTRAINT /= IDENT_INT(9)) THEN
+                              FAILED ("CONSTRAINT ON RECORD " &
+                                      "TYPE IN PARAMETER " &
+                                      "NOT RECOGNIZED");
+                         END IF;
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                              REC12 := REC_OOPS;
+                              FAILED ("CONSTRAINT ERROR NOT RAISED - " &
+                                      "A.1");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED - " &
+                                           "A.1");
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                              REC13 := REC_OOPS;
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                                      "A.2");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED - " &
+                                           "A.2");
+                         END;
+                    END P1;
+
+               BEGIN
+                    P1 (REC1, REC2, REC3);
+               END P;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+     BEGIN  -- (A)
+
+          PKG.P (PKG.REC91, PKG.REC92, PKG.REC93);
+
+     END;   -- (A)
+
+     --------------------------------------------------
+
+     DECLARE  -- (B)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE);
+
+          PRIVATE
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC91, REC92, REC93  : PKG.RECTYPE(9);
+          REC_OOPS             : PKG.RECTYPE(4);
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE) IS
+
+                    PROCEDURE P1 (REC11 : IN RECTYPE;
+                                  REC12 : IN OUT RECTYPE;
+                                  REC13 : OUT RECTYPE) IS
+                    BEGIN
+                         IF (NOT REC11'CONSTRAINED) OR
+                            (REC11.CONSTRAINT /= IDENT_INT(9)) THEN
+                              FAILED ("CONSTRAINT ON PRIVATE " &
+                                      "TYPE IN PARAMETER " &
+                                      "NOT RECOGNIZED");
+                         END IF;
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                              REC12 := REC_OOPS;
+                              FAILED ("CONSTRAINT ERROR NOT RAISED - " &
+                                      "B.1");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED - " &
+                                           "B.1");
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                              REC13 := REC_OOPS;
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                                      "B.2");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED - " &
+                                           "B.2");
+                         END;
+                    END P1;
+
+               BEGIN
+                    P1 (REC1, REC2, REC3);
+               END P;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+     BEGIN  -- (B)
+
+          PKG.P (REC91, REC92, REC93);
+
+     END;   -- (B)
+
+     --------------------------------------------------
+
+     DECLARE  -- (C)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    LIMITED PRIVATE;
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE);
+
+          PRIVATE
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC91,REC92,REC93  : PKG.RECTYPE(9);
+          REC_OOPS           : PKG.RECTYPE(4);
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE) IS
+
+                    PROCEDURE P1 (REC11 : IN RECTYPE;
+                                  REC12 : IN OUT RECTYPE;
+                                  REC13 : OUT RECTYPE) IS
+                    BEGIN
+                         IF (NOT REC11'CONSTRAINED) OR
+                            (REC11.CONSTRAINT /= 9) THEN
+                              FAILED ("CONSTRAINT ON LIMITED PRIVATE " &
+                                      "TYPE IN PARAMETER " &
+                                      "NOT RECOGNIZED");
+                         END IF;
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                              REC12 := REC_OOPS;
+                              FAILED ("CONSTRAINT ERROR NOT RAISED - " &
+                                      "C.1");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED - " &
+                                           "C.1");
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                              REC13 := REC_OOPS;
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                                      "C.2");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED - " &
+                                           "C.2");
+                         END;
+                    END P1;
+
+               BEGIN
+                    P1 (REC1, REC2, REC3);
+               END P;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+     BEGIN  -- (C)
+
+          PKG.P (REC91, REC92, REC93);
+
+     END;   -- (C)
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64106C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106d.ada
new file mode 100644
index 000000000..0b3670842
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64106d.ada
@@ -0,0 +1,280 @@
+-- C64106D.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 ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED
+--    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
+--    CONSTRAINTS DO NOT RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER
+--    IS UNCONSTRAINED, EVEN IF THE CONSTRAINT VALUES OF THE OBJECT 
+--    BEING ASSIGNED ARE DIFFERENT THAN THOSE OF THE ACTUAL PARAMETER.  
+
+--    SUBTESTS ARE:
+--        (A) UNCONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
+--        (B) UNCONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
+--        (C) UNCONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
+
+-- JRK  4/16/81
+-- CPP  8/9/84
+-- JRK 11/28/84
+
+WITH REPORT;
+PROCEDURE C64106D IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST ("C64106D", "CHECK ASSIGNMENTS TO FORMAL PARAMETERS OF " &
+                      "UNCONSTRAINED TYPES WITH UNCONSTRAINED " &
+                      "ACTUAL PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE  -- (A)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE);
+          END PKG;
+
+          REC91, REC92, REC93 : PKG.RECTYPE :=
+               (IDENT_INT(5), 5, IDENT_STR("12345"));
+          REC_OOPS            : PKG.RECTYPE;
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE) IS
+
+                    PROCEDURE P1 (REC11 : IN RECTYPE;
+                                  REC12 : IN OUT RECTYPE;
+                                  REC13 : OUT RECTYPE) IS
+                    BEGIN
+
+                         IF NOT REC11'CONSTRAINED THEN
+                              FAILED ("REC11 IS NOT CONSTRAINED - A.1");
+                         END IF;
+                         IF REC11.CONSTRAINT /= IDENT_INT(9) THEN
+                              FAILED ("REC11 CONSTRAINT IS NOT 9 " &
+                                      "- A.1");
+                         END IF;
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                              REC12 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ("EXCEPTION RAISED - A.1");
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                              REC13 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ("EXCEPTION RAISED - A.2");
+                         END;
+                    END P1;
+
+               BEGIN
+                    P1 (REC1, REC2, REC3);
+               END P;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+          USE PKG;
+
+     BEGIN  -- (A)
+
+          PKG.P (REC91, REC92, REC93);
+          IF (REC92 /= REC_OOPS) OR (REC93 /= REC_OOPS) THEN
+               FAILED ("RESULTANT VALUE OF REC92 OR REC93 INCORRECT");
+          END IF;
+
+     END;   -- (A)
+
+     --------------------------------------------------
+
+     DECLARE  -- (B)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE);
+
+          PRIVATE
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC91, REC92, REC93  : PKG.RECTYPE;
+          REC_OOPS             : PKG.RECTYPE;
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE) IS
+
+                    PROCEDURE P1 (REC11 : IN RECTYPE;
+                                  REC12 : IN OUT RECTYPE;
+                                  REC13 : OUT RECTYPE) IS
+                    BEGIN
+
+                         IF REC3'CONSTRAINED THEN
+                              FAILED ("REC3 IS CONSTRAINED - B.1");
+                         END IF;
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                              REC12 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ("EXCEPTION RAISED - B.1");
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                              REC13 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ("EXCEPTION RAISED - B.2");
+                         END;
+                    END P1;
+
+               BEGIN
+                    P1 (REC1, REC2, REC3);
+               END P;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+     BEGIN  -- (B)
+
+          PKG.P (REC91, REC92, REC93);
+
+     END;   -- (B)
+
+     --------------------------------------------------
+
+     DECLARE  -- (C)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    LIMITED PRIVATE;
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE);
+
+          PRIVATE
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC91, REC92, REC93  : PKG.RECTYPE;
+          REC_OOPS             : PKG.RECTYPE;
+
+          PACKAGE BODY PKG IS
+
+               PROCEDURE P (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                            REC3 : OUT RECTYPE) IS
+
+                    PROCEDURE P1 (REC11 : IN RECTYPE;
+                                  REC12 : IN OUT RECTYPE;
+                                  REC13 : OUT RECTYPE) IS
+                    BEGIN
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER
+                              REC12 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ("EXCEPTION RAISED - C.1");
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER
+                              REC13 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ("EXCEPTION RAISED - C.2");
+                         END;
+                    END P1;
+
+               BEGIN
+                    P1 (REC1, REC2, REC3);
+               END P;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+     BEGIN  -- (C)
+
+          PKG.P (REC91, REC92, REC93);
+
+     END;   -- (C)
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C64106D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64107a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64107a.ada
new file mode 100644
index 000000000..fd846e86d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64107a.ada
@@ -0,0 +1,73 @@
+-- C64107A.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 ACTUAL PARAMETERS ARE EVALUATED AND IDENTIFIED AT THE
+--   TIME OF CALL.
+
+-- DAS  1/29/81
+-- SPS 12/13/82
+
+WITH REPORT;
+PROCEDURE C64107A IS
+
+     USE REPORT;
+
+     TYPE VECTOR IS ARRAY (1..10) OF INTEGER;
+     TYPE PTRINT IS ACCESS INTEGER;
+
+     I    : INTEGER := 1;
+     A    : VECTOR  := (1,2,3,4,5,6,7,8,9,10);
+     P1   : PTRINT  := NEW INTEGER'(2);
+     P2   : PTRINT  := P1;
+
+     PROCEDURE PROC1 (I : OUT INTEGER; J : OUT INTEGER) IS
+     BEGIN
+          I := 10;
+          J := -1;
+     END PROC1;
+
+     PROCEDURE PROC2 (P : OUT PTRINT; I : OUT INTEGER) IS
+     BEGIN
+          P := NEW INTEGER'(3);
+          I := 5;
+     END PROC2;
+
+BEGIN
+
+     TEST ("C64107A", "CHECK THAT ACTUAL PARAMETERS ARE EVALUATED" &
+                      " AND IDENTIFIED AT THE TIME OF CALL");
+
+     PROC1 (I, A(I));
+     IF (A /= (-1,2,3,4,5,6,7,8,9,10)) THEN
+          FAILED ("A(I) EVALUATED UPON RETURN");
+     END IF;
+
+     PROC2 (P1, P1.ALL);
+     IF (P2.ALL /= 5) THEN
+          FAILED ("P1.ALL EVALUATED UPON RETURN");
+     END IF;
+
+     RESULT;
+
+END C64107A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64108a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64108a.ada
new file mode 100644
index 000000000..ae69d6632
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64108a.ada
@@ -0,0 +1,148 @@
+-- C64108A.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 PERMITTED FORMS OF VARIABLE NAMES ARE PERMITTED
+--   AS ACTUAL PARAMETERS.
+
+-- DAS 2/10/81
+-- SPS 10/26/82
+-- SPS 11/5/82
+
+WITH REPORT;
+PROCEDURE C64108A IS
+
+     USE REPORT;
+     SUBTYPE INT IS INTEGER RANGE 1..3;
+     TYPE REC (N : INT) IS
+          RECORD
+               S : STRING (1..N);
+          END RECORD;
+     TYPE PTRSTR IS ACCESS STRING;
+
+     R1,R2,R3 : REC(3);
+     S1,S2,S3 : STRING (1..3);
+     PTRTBL   : ARRAY (1..3) OF PTRSTR;
+
+     PROCEDURE P1 (S1 : IN STRING; S2: IN OUT STRING; 
+                   S3 : OUT STRING) IS
+     BEGIN
+          S3 := S2;
+          S2 := S1;
+     END P1;
+
+     PROCEDURE P2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER;
+                   C3 : OUT CHARACTER) IS
+     BEGIN
+          C3 := C2;
+          C2 := C1;
+     END P2;
+
+     FUNCTION F1 (X : INT) RETURN PTRSTR IS
+     BEGIN
+          RETURN PTRTBL(X);
+     END F1;
+
+     FUNCTION "+" (S1,S2 : STRING) RETURN PTRSTR IS
+     BEGIN
+          RETURN PTRTBL(CHARACTER'POS(S1(1))-CHARACTER'POS('A')+1);
+     END "+";
+
+BEGIN
+
+     TEST ("C64108A", "CHECK THAT ALL PERMITTED FORMS OF VARIABLE" &
+                      " NAMES ARE PERMITTED AS ACTUAL PARAMETERS");
+
+     S1 := "AAA";
+     S2 := "BBB";
+     P1 (S1, S2, S3);
+     IF (S2 /= "AAA") OR (S3 /= "BBB") THEN
+          FAILED ("SIMPLE VARIABLE AS AN ACTUAL PARAMETER NOT WORKING");
+     END IF;
+
+     S1 := "AAA";
+     S2 := "BBB";
+     S3 := IDENT_STR("CCC");
+     P2 (S1(1), S2(IDENT_INT(1)), S3(1));
+     IF (S2 /= "ABB") OR (S3 /= "BCC") THEN
+          FAILED ("INDEXED COMPONENT AS AN ACTUAL PARAMETER NOT " &
+                  "WORKING");
+     END IF;
+
+     R1.S := "AAA";
+     R2.S := "BBB";
+     P1 (R1.S, R2.S, R3.S);
+     IF (R2.S /= "AAA") OR (R3.S /= "BBB") THEN
+          FAILED ("SELECTED COMPONENT AS AN ACTUAL PARAMETER" &
+                  " NOT WORKING");
+     END IF;
+
+     S1 := "AAA";
+     S2 := "BBB";
+     P1 (S1(1..IDENT_INT(2)), S2(1..2), S3(IDENT_INT(1)..IDENT_INT(2)));
+     IF (S2 /= "AAB") OR (S3 /= "BBC") THEN
+          FAILED ("SLICE AS AN ACTUAL PARAMETER NOT WORKING");
+     END IF;
+
+     PTRTBL(1) := NEW STRING'("AAA");
+     PTRTBL(2) := NEW STRING'("BBB");
+     PTRTBL(3) := NEW STRING'("CCC");
+     P1 (F1(1).ALL, F1(2).ALL, F1(IDENT_INT(3)).ALL);
+     IF (PTRTBL(2).ALL /= "AAA") OR (PTRTBL(3).ALL /= "BBB") THEN
+          FAILED ("SELECTED COMPONENT OF FUNCTION VALUE AS AN ACTUAL" &
+                  " PARAMETER NOT WORKING");
+     END IF;
+
+     PTRTBL(1) := NEW STRING'("AAA");
+     PTRTBL(2) := NEW STRING'("BBB");
+     PTRTBL(3) := NEW STRING'("CCC");
+     S1 := IDENT_STR("AAA");
+     S2 := IDENT_STR("BBB");
+     S3 := IDENT_STR("CCC");
+     P1 ("+"(S1,S1).ALL, "+"(S2,S2).ALL, "+"(S3,S3).ALL);
+     IF (PTRTBL(2).ALL /= "AAA") OR (PTRTBL(3).ALL /= "BBB") THEN
+          FAILED ("SELECTED COMPONENT OF OVERLOADED OPERATOR FUNCTION" &
+                  " VALUE AS AN ACTUAL PARAMETER NOT WORKING");
+     END IF;
+
+     PTRTBL(1) := NEW STRING'("AAA");
+     PTRTBL(2) := NEW STRING'("BBB");
+     PTRTBL(3) := NEW STRING'("CCC");
+     P2 (F1(1)(1), F1(IDENT_INT(2))(1), F1(3)(IDENT_INT(1)));
+     IF (PTRTBL(2).ALL /= "ABB") OR (PTRTBL(3).ALL /= "BCC") THEN
+          FAILED ("INDEXED COMPONENT OF FUNCTION VALUE AS AN ACTUAL" &
+                  " PARAMETER NOT WORKING");
+     END IF;
+
+     PTRTBL(1) := NEW STRING'("AAA");
+     PTRTBL(2) := NEW STRING'("BBB");
+     PTRTBL(3) := NEW STRING'("CCC");
+     P1 (F1(1)(2..3), F1(2)(IDENT_INT(2)..3), F1(3)(2..IDENT_INT(3)));
+     IF (PTRTBL(2).ALL /= "BAA") OR (PTRTBL(3).ALL /= "CBB") THEN
+          FAILED ("SLICE OF FUNCTION VALUE AS AN ACTUAL PARAMETER" &
+                  " NOT WORKING");
+     END IF;
+
+     RESULT;
+
+END C64108A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109a.ada
new file mode 100644
index 000000000..19c3f69d2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109a.ada
@@ -0,0 +1,128 @@
+-- C64109A.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 ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+-- TO SUBPROGRAMS.  SPECIFICALLY,
+--   (A) CHECK ALL PARAMETER MODES.
+
+-- CPP 8/20/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64109A IS
+
+BEGIN
+     TEST ("C64109A", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+           "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS");
+
+     --------------------------------------------
+
+     DECLARE   -- (A)
+
+          TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+          SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(5));
+          TYPE RECORD_TYPE IS
+               RECORD
+                    I : INTEGER;
+                    A : ARRAY_SUBTYPE;
+               END RECORD;
+          REC : RECORD_TYPE := (I => 23,
+                                A => (1..3 => IDENT_INT(7), 4..5 => 9));
+          BOOL : BOOLEAN;
+
+          PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (7, 7, 7, 9, 9) THEN
+                    FAILED ("IN PARAMETER NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= IDENT_INT(1) OR
+                  ARR'LAST /= IDENT_INT(5) THEN
+                    FAILED ("WRONG BOUNDS FOR IN PARAMETER");
+               END IF;
+          END P1;
+
+          FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+          BEGIN
+               IF ARR /= (7, 7, 7, 9, 9) THEN
+                    FAILED ("IN PARAMETER NOT PASSED CORRECTLY TO FN");
+               END IF;
+               IF ARR'FIRST /= IDENT_INT(1) OR
+                  ARR'LAST /= IDENT_INT(5) THEN
+                    FAILED ("WRONG BOUNDS FOR IN PARAMETER FOR FN");
+               END IF;
+
+               RETURN TRUE;
+          END F1;
+
+          PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (7, 7, 7, 9, 9) THEN
+                    FAILED ("IN OUT PARAMETER NOT PASSED " &
+                            "CORRECTLY");
+               END IF;
+               IF ARR'FIRST /= IDENT_INT(1) OR
+                  ARR'LAST /= IDENT_INT(5) THEN
+                    FAILED ("WRONG BOUNDS FOR IN OUT PARAMETER");
+               END IF;
+               ARR := (ARR'RANGE => 5);
+          END P2;
+
+          PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR'FIRST /= IDENT_INT(1) OR
+                  ARR'LAST /= IDENT_INT(5) THEN
+                    FAILED ("WRONG BOUNDS FOR OUT PARAMETER");
+               END IF;
+
+               ARR := (ARR'RANGE => 3);
+          END P3;
+
+     BEGIN     -- (A)
+
+          P1 (REC.A);
+          IF REC.A /= (7, 7, 7, 9, 9) THEN
+               FAILED ("IN PARAM CHANGED BY PROCEDURE");
+          END IF;
+
+          BOOL := F1 (REC.A);
+          IF REC.A /= (7, 7, 7, 9, 9) THEN
+               FAILED ("IN PARAM CHANGED BY FUNCTION");
+          END IF;
+
+          P2 (REC.A);
+          IF REC.A /= (5, 5, 5, 5, 5) THEN
+               FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
+          END IF;
+
+          P3 (REC.A);
+          IF REC.A /= (3, 3, 3, 3, 3) THEN
+               FAILED ("OUT PARAM RETURNED INCORRECTLY");
+          END IF;
+
+     END; -- (A)
+
+     --------------------------------------------
+
+     RESULT;
+END C64109A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109b.ada
new file mode 100644
index 000000000..a644974d6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109b.ada
@@ -0,0 +1,155 @@
+-- C64109B.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 ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+-- TO SUBPROGRAMS.  SPECIFICALLY,
+--   (B) CHECK MULTIDIMENSIONAL ARRAYS.
+
+-- CPP 8/20/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64109B IS
+
+BEGIN
+     TEST ("C64109B", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+           "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
+           "MULTIDIMENSIONAL ARRAYS");
+
+     DECLARE   -- (B)
+
+          TYPE MULTI_TYPE IS ARRAY (POSITIVE RANGE <>, 
+                                    POSITIVE RANGE <>) OF BOOLEAN;
+          SUBTYPE MULTI_SUBTYPE IS MULTI_TYPE (1..2, 1..3);
+          TYPE RECORD_TYPE IS
+               RECORD
+                    I : BOOLEAN;
+                    A : MULTI_SUBTYPE;
+               END RECORD;
+          REC : RECORD_TYPE :=
+                    (I => FALSE,
+                     A => (1..2 => (1..3 => IDENT_BOOL(TRUE))));
+          BOOL : BOOLEAN;
+
+          PROCEDURE P1 (ARR : MULTI_TYPE) IS
+          BEGIN
+               IF ARR /= (1..2 => (1..3 => TRUE)) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
+                    FAILED ("FIRST DIM NOT CORRECT - IN PARAMETER");
+               ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
+                  THEN 
+                    FAILED ("2ND DIM NOT CORRECT - IN PARAMETER");
+               END IF;                  
+          END P1;
+
+          FUNCTION F1 (ARR : MULTI_TYPE) RETURN BOOLEAN IS
+          BEGIN
+               IF ARR /= (1..2 => (1..3 => TRUE)) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+               END IF;
+
+               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
+                    FAILED ("FIRST DIM NOT CORRECT - IN PARAMETER FN");
+               ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
+                  THEN 
+                    FAILED ("2ND DIM NOT CORRECT - IN PARAMETER FN");
+               END IF;                  
+               RETURN TRUE;
+          END F1;
+
+          PROCEDURE P2 (ARR : IN OUT MULTI_TYPE) IS
+          BEGIN
+               IF ARR /= (1..2 => (1..3 => TRUE)) THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
+                    FAILED ("FIRST DIM NOT CORRECT - IN OUT PARAMETER");
+               ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
+                  THEN 
+                    FAILED ("2ND DIM NOT CORRECT - IN OUT PARAMETER");
+               END IF;                  
+               ARR := (ARR'RANGE(1) => (ARR'RANGE(2) => FALSE));
+          END P2;
+
+          PROCEDURE P3 (ARR : OUT MULTI_TYPE) IS
+          BEGIN
+               FOR I IN 1 .. 2 LOOP
+                    FOR J IN 1 .. 3 LOOP
+                         IF (J MOD 2) = 0 THEN
+                              ARR(I, J) := TRUE;
+                         ELSE
+                              ARR(I, J) := FALSE;
+                         END IF;
+                    END LOOP;
+               END LOOP;
+
+               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
+                    FAILED ("FIRST DIM NOT CORRECT - OUT PARAMETER");
+               ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
+                  THEN 
+                    FAILED ("2ND DIM NOT CORRECT - OUT PARAMETER");
+               END IF;                  
+          END P3;
+
+     BEGIN     -- (B)
+
+          P1 (REC.A);
+          IF REC.A /= (1..2 => (1..3 => TRUE)) THEN
+               FAILED ("IN PARAM CHANGED BY PROCEDURE");
+          END IF;
+
+          BOOL := F1 (REC.A);
+          IF REC.A /= (1..2 => (1..3 => TRUE)) THEN
+               FAILED ("IN PARAM CHANGED BY FUNCTION");
+          END IF;
+
+          P2 (REC.A);
+          IF REC.A /= (1..2 => (1..3 => FALSE)) THEN
+               FAILED ("IN OUT PARAM CHANGED BY PROCEDURE");
+          END IF;
+
+          P3 (REC.A);
+          FOR I IN 1 .. 2 LOOP
+               FOR J IN 1 .. 3 LOOP
+                    IF (J MOD 2) = 0 THEN
+                         IF REC.A(I, J) /= TRUE THEN
+                              FAILED ("OUT PARAM RETURNED " &
+                                      "INCORRECTLY - (B)");
+                         END IF;
+                    ELSE
+                         IF REC.A(I, J) /= FALSE THEN
+                              FAILED ("OUT PARAM RETURNED " &
+                                      "INCORRECTLY - (B)2");
+                         END IF;
+                    END IF;
+               END LOOP;
+          END LOOP;
+
+     END; -- (B)
+
+     RESULT;
+END C64109B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109c.ada
new file mode 100644
index 000000000..1845f9e61
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109c.ada
@@ -0,0 +1,127 @@
+-- C64109C.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 ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+-- TO SUBPROGRAMS.  SPECIFICALLY,
+--   (C) CHECK RECORDS HAVING A DISCRIMINANT, WITH MORE THAN ONE ARRAY
+--       COMPONENT, WHERE THE BOUNDS OF THE ARRAY DEPEND ON THE
+--       DISCRIMINANT.
+
+-- CPP 8/20/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64109C IS
+
+BEGIN
+     TEST ("C64109C", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+           "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
+           "RECORDS WITH DISCRIMINANTS");
+
+     DECLARE   -- (C)
+
+          SUBTYPE SUBINT IS INTEGER RANGE 1..6;
+          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF INTEGER;
+          TYPE RECORD_TYPE (BOUND : INTEGER) IS
+               RECORD
+                    B : BOOLEAN;
+                    A : ARRAY_TYPE (1..BOUND);
+                    AA : ARRAY_TYPE (BOUND..6);
+               END RECORD;
+          REC : RECORD_TYPE (BOUND => IDENT_INT(4)) :=
+                               (BOUND => 4,
+                                B => TRUE,
+                                A => (1..IDENT_INT(4) => 6),
+                                AA => (4..6 => 8));
+          BOOL : BOOLEAN;
+
+          PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (6, 6, 6, 6) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(4) THEN
+                    FAILED ("WRONG BOUNDS - IN PARAMETER");
+               END IF;
+          END P1;
+
+          FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+          BEGIN
+               IF ARR /= (6, 6, 6, 6) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+               END IF;
+
+               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(4) THEN
+                    FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
+               END IF;
+               RETURN TRUE;
+          END F1;
+
+          PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (8, 8, 8) THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= 4 OR ARR'LAST /= IDENT_INT(6) THEN
+                    FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
+               END IF;
+
+               ARR := (ARR'RANGE => 10);
+          END P2;
+
+          PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(4) THEN
+                    FAILED ("WRONG BOUNDS - OUT PARAMETER");
+               END IF;
+               ARR := (ARR'RANGE => 4);
+          END P3;
+
+     BEGIN     -- (C)
+
+          P1 (REC.A);
+          IF REC.A /= (6, 6, 6, 6) THEN
+               FAILED ("IN PARAM CHANGED BY PROCEDURE");
+          END IF;
+
+          BOOL := F1 (REC.A);
+          IF REC.A /= (6, 6, 6, 6) THEN
+               FAILED ("IN PARAM CHANGED BY FUNCTION");
+          END IF;
+
+          P2 (REC.AA);
+          IF REC.AA /= (10, 10, 10) THEN
+               FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+          END IF;
+
+          P3 (REC.A);
+          IF REC.A /= (4, 4, 4, 4) THEN
+               FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
+          END IF;
+
+     END; -- (C)
+
+     RESULT;
+END C64109C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109d.ada
new file mode 100644
index 000000000..c8469bef1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109d.ada
@@ -0,0 +1,128 @@
+-- C64109D.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 ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+-- TO SUBPROGRAMS.  SPECIFICALLY,
+--   (D) CHECK OBJECTS DESIGNATED BY ACCESS TYPES.
+
+-- CPP 8/20/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64109D IS
+
+BEGIN
+     TEST ("C64109D", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+           "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
+           "OBJECTS DESIGNATED BY ACCESS TYPES");
+
+     DECLARE   -- (D)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..3;
+          TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>) OF INTEGER;
+          SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(3));
+          TYPE NODE_TYPE;
+          TYPE ACCESS_TYPE IS ACCESS NODE_TYPE;
+          TYPE NODE_TYPE IS
+               RECORD
+                    A    : ARRAY_SUBTYPE;
+                    NEXT : ACCESS_TYPE;
+               END RECORD;
+          PTR : ACCESS_TYPE := NEW NODE_TYPE'
+                    (A => (IDENT_INT(1)..3 => IDENT_INT(5)),
+                     NEXT => NULL);
+          BOOL : BOOLEAN;
+
+          PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (5, 5, 5) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                    FAILED ("WRONG BOUNDS - IN PARAMETER");
+               END IF;
+          END P1;
+
+          FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+          BEGIN
+               IF ARR /= (5, 5, 5) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+               END IF;
+
+               IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                    FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
+               END IF;
+
+               RETURN TRUE;
+          END F1;
+
+          PROCEDURE P2 (ARR : IN OUT ARRAY_SUBTYPE) IS
+          BEGIN
+               IF ARR /= (5, 5, 5) THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                    FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
+               END IF;
+
+               ARR := (OTHERS => 6);
+          END P2;
+
+          PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+          BEGIN
+
+               IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                    FAILED ("WRONG BOUNDS - OUT PARAMETER");
+               END IF;
+
+               ARR := (ARR'RANGE => 7);
+          END P3;
+
+     BEGIN     -- (D)
+
+          P1 (PTR.A);
+          IF PTR.A /= (5, 5, 5) THEN
+               FAILED ("IN PARAM CHANGED BY PROCEDURE");
+          END IF;
+
+          BOOL := F1 (PTR.A);
+          IF PTR.A /= (5, 5, 5) THEN
+               FAILED ("IN PARAM CHANGED BY FUNCTION");
+          END IF;
+
+          P2 (PTR.A);
+          IF PTR.A /= (6, 6, 6) THEN
+               FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+          END IF;
+
+          P3 (PTR.A);
+          IF PTR.A /= (7, 7, 7) THEN
+               FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
+          END IF;
+
+     END; -- (D)
+
+     RESULT;
+END C64109D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109e.ada
new file mode 100644
index 000000000..5860ac7d7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109e.ada
@@ -0,0 +1,156 @@
+-- C64109E.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 ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+-- TO SUBPROGRAMS.  SPECIFICALLY,
+--   (E) CHECK THE CASE WHERE THE FORMAL IS UNCONSTRAINED, AND ARRAYS
+--       WITH DIFFERENT BOUNDS ARE PASSED AS ACTUALS.
+
+-- CPP 8/20/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64109E IS
+
+BEGIN
+     TEST ("C64109E", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+           "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
+           "ARRAYS WITH DIFFERENT BOUNDS PASSED TO UNCONSTRAINED " &
+           "FORMAL");
+
+     DECLARE   -- (E)
+
+          SUBTYPE SUBINT IS INTEGER RANGE 0..5;
+          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+          TYPE RECORD_TYPE IS
+               RECORD
+                    A : ARRAY_TYPE (IDENT_INT(0)..IDENT_INT(2));
+                    B : ARRAY_TYPE (1..3);
+               END RECORD;
+          REC : RECORD_TYPE := (A => (0..2 => IDENT_BOOL(TRUE)),
+                                B => (1..3 => IDENT_BOOL(FALSE)));
+          BOOL : BOOLEAN;
+
+          PROCEDURE P1 (ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (TRUE, TRUE, TRUE) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY");
+               END IF;
+               IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                    FAILED ("WRONG IN PARAMETER BOUNDS - 1");
+               END IF;
+               IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY - 2");
+               END IF;
+               IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                    FAILED ("WRONG IN PARAMETER BOUNDS - 2");
+               END IF;
+          END P1;
+
+          FUNCTION F1 ( ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) 
+               RETURN BOOLEAN IS
+          BEGIN
+               IF ARR /= (TRUE, TRUE, TRUE) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+               END IF;
+               IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                    FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 1");
+               END IF;
+               IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+               END IF;
+               IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                    FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 2");
+               END IF;
+               RETURN TRUE;
+          END F1;
+
+          PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE;
+                        ARR2 : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (TRUE, TRUE, TRUE) THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+               END IF;
+               IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                    FAILED ("WRONG IN OUT PARAMETER BOUNDS - 1");
+               END IF;
+               IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+               END IF;
+               IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                    FAILED ("WRONG IN OUT PARAMETER BOUNDS - 2");
+               END IF;
+               ARR := (ARR'RANGE => FALSE);
+               ARR2 := (ARR2'RANGE => TRUE);
+          END P2;
+
+          PROCEDURE P3 (ARR : OUT ARRAY_TYPE; ARR2 : OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                    FAILED ("WRONG OUT PARAMETER BOUNDS - 1");
+               END IF;
+               IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                    FAILED ("WRONG OUT  PARAMETER BOUNDS - 2");
+               END IF;
+               ARR := (ARR'RANGE => FALSE);
+               ARR2 := (ARR2'RANGE => TRUE);
+          END P3;
+
+     BEGIN     -- (E)
+
+          P1 (REC.A, REC.B);
+          IF REC.A /= (TRUE, TRUE, TRUE) THEN
+               FAILED ("IN PARAM CHANGED BY PROCEDURE");
+          END IF;
+          IF REC.B /= (FALSE, FALSE, FALSE) THEN
+               FAILED ("IN PARAM CHANGED BY PROCEDURE - 2");
+          END IF;
+
+          BOOL := F1 (REC.A, REC.B);
+          IF REC.A /= (TRUE, TRUE, TRUE) THEN
+               FAILED ("IN PARAM CHANGED BY FUNCTION");
+          END IF;
+          IF REC.B /= (FALSE, FALSE, FALSE) THEN
+               FAILED ("IN PARAM CHANGED BY FUNCTION - 2");
+          END IF;
+
+          P2 (REC.A, REC.B);
+          IF REC.A /= (FALSE, FALSE, FALSE) THEN
+               FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
+          END IF;
+          IF REC.B /= (TRUE, TRUE, TRUE) THEN
+               FAILED ("IN OUT PARAM RETURNED INCORRECTLY - 2");
+          END IF;
+
+          P3 (REC.A, REC.B);
+          IF REC.A /= (FALSE, FALSE, FALSE) THEN
+               FAILED ("OUT PARAM RETURNED INCORRECTLY");
+          END IF;
+          IF REC.B /= (TRUE, TRUE, TRUE) THEN
+               FAILED ("OUT PARAM RETURNED INCORRECTLY - 2");
+          END IF;
+
+     END; -- (E)
+
+     RESULT;
+END C64109E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109f.ada
new file mode 100644
index 000000000..48a202c2d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109f.ada
@@ -0,0 +1,126 @@
+-- C64109F.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 ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+-- TO SUBPROGRAMS.  SPECIFICALLY,
+--   (F) CHECK THAT A FORMAL PARAMETER CAN BE USED AS AN ACTUAL IN
+--       ANOTHER CALL.
+
+-- CPP 8/20/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64109F IS
+
+BEGIN
+     TEST ("C64109F", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+           "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
+           "FORMAL AS AN ACTUAL");
+
+     DECLARE   -- (F)
+
+          TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+          SUBTYPE ARRAY_SUBTYPE IS 
+                    ARRAY_TYPE (IDENT_INT(1)..IDENT_INT(5));
+          TYPE RECORD_TYPE IS
+               RECORD
+                    I : INTEGER;
+                    A : ARRAY_SUBTYPE;
+               END RECORD;
+          REC : RECORD_TYPE := (I => 23,
+                                A => (1..3 => 7, 4..5 => 9));
+          BOOL : BOOLEAN;
+
+          PROCEDURE P_CALLED (A : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               IF A /= (7, 7, 7, 9, 9) THEN
+                    FAILED ("IN OUT PARAM NOT RECEIVED CORRECTLY");
+               END IF;
+               IF A'FIRST /= 1 OR A'LAST /= 5 THEN
+                    FAILED ("BOUNDS WRONG - IN OUT");
+               END IF;
+               A := (6, 6, 6, 6, 6);
+          END P_CALLED;
+
+          PROCEDURE P (A : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               P_CALLED (A);
+          END P;
+
+          FUNCTION F_CALLED (A : ARRAY_SUBTYPE) RETURN BOOLEAN IS
+               GOOD : BOOLEAN;
+          BEGIN
+               GOOD := (A = (7, 7, 7, 9, 9));
+               IF NOT GOOD THEN
+                    FAILED ("IN PARAMETER NOT RECEIVED CORRECTLY");
+               END IF;
+               IF A'FIRST /= 1 OR A'LAST /= IDENT_INT(5) THEN
+                    FAILED ("BOUNDS WRONG - FUNCTION");
+               END IF;
+               RETURN GOOD;
+          END F_CALLED;
+
+          FUNCTION F (A : ARRAY_TYPE) RETURN BOOLEAN IS
+          BEGIN
+               RETURN (F_CALLED (A));
+          END F;
+
+          PROCEDURE P_OUT_CALLED (A : OUT ARRAY_TYPE) IS
+          BEGIN
+               IF A'FIRST /= 1 OR A'LAST /= 5 THEN
+                    FAILED ("BOUNDS WRONG - OUT");
+               END IF;
+               A := (8, 8, 8, 8, 8);
+          END P_OUT_CALLED;
+
+          PROCEDURE P_OUT (A : OUT ARRAY_TYPE) IS
+          BEGIN
+               P_OUT_CALLED (A);
+               A := (9, 9, 9, 9, 9);
+          END P_OUT;
+
+     BEGIN     -- (F)
+
+          P (REC.A);
+          IF REC.A /= (6, 6, 6, 6, 6) THEN
+               FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+          END IF;
+
+          REC.A := (7, 7, 7, 9, 9);
+          BOOL := F (REC.A);
+          IF NOT BOOL THEN
+               FAILED ("IN PARAM NOT RETURNED CORRECTLY");
+          END IF;
+
+          REC.A := (7, 7, 7, 9, 9);
+          P_OUT (REC.A);
+          IF REC.A /= (9, 9, 9, 9, 9) THEN
+               FAILED ("OUT PARAM NOT RETURNED CORRECTLY - 2");
+          END IF;
+
+     END; -- (F)
+
+     --------------------------------------------
+
+     RESULT;
+END C64109F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109g.ada
new file mode 100644
index 000000000..df6a827e7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109g.ada
@@ -0,0 +1,125 @@
+-- C64109G.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 SLICES OF ARRAYS ARE PASSED CORRECTLY TO SUBPROGRAMS.
+-- SPECIFICALLY,
+--   (A) CHECK ALL PARAMETER MODES.
+
+-- CPP 8/28/84
+-- PWN 05/31/96  Corrected spelling problem.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64109G IS
+
+BEGIN
+     TEST ("C64109G", "CHECK THAT SLICES OF ARRAYS ARE PASSED " &
+           "CORRECTLY TO SUBPROGRAMS");
+
+     --------------------------------------------
+
+     DECLARE   -- (A)
+
+          SUBTYPE SUBINT IS INTEGER RANGE 1..5;
+          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF INTEGER;
+          ARR : ARRAY_TYPE (1..5) := (1..3 => 7, 4..5 => 9);
+          BOOL : BOOLEAN;
+
+          PROCEDURE P1 (S : ARRAY_TYPE) IS
+          BEGIN
+               IF S(IDENT_INT(3)) /= 7 THEN
+                    FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)");
+               END IF;
+               IF S(4) /= 9 THEN
+                    FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)2");
+               END IF;
+          END P1;
+
+          FUNCTION F1 (S : ARRAY_TYPE) RETURN BOOLEAN IS
+          BEGIN
+               IF S(3) /= 7 THEN
+                    FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)");
+               END IF;
+               IF S(IDENT_INT(4)) /= 9 THEN
+                    FAILED ("IN PARAMETER NOT PASSED CORRECTLY - (A)2");
+               END IF;
+               RETURN TRUE;
+          END F1;
+
+          PROCEDURE P2 (S : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               IF S(3) /= 7 THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY - (A)");
+               END IF;
+               IF S(4) /= 9 THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY - (A)2");
+               END IF;
+               FOR I IN 3 .. 4 LOOP
+                    S(I) := 5;
+               END LOOP;
+          END P2;
+
+          PROCEDURE P3 (S : OUT ARRAY_TYPE) IS
+          BEGIN
+               FOR I IN 3 .. 4 LOOP
+                    S(I) := 3;
+               END LOOP;
+          END P3;
+
+     BEGIN     -- (A)
+
+          P1 (ARR(3..4));
+          IF ARR(3) /= 7 THEN
+               FAILED ("IN PARAM CHANGED BY PROCEDURE - (A)");
+          END IF;
+          IF ARR(4) /= 9 THEN
+               FAILED ("IN PARAM CHANGED BY PROCEDURE - (A)2");
+          END IF;
+
+          BOOL := F1 (ARR(IDENT_INT(3)..IDENT_INT(4)));
+          IF ARR(3) /= 7 THEN
+               FAILED ("IN PARAM CHANGED BY FUNCTION - (A)");
+          END IF;
+          IF ARR(4) /= 9 THEN
+               FAILED ("IN PARAM CHANGED BY FUNCTION - (A)2");
+          END IF;
+
+          P2 (ARR(3..4));
+          FOR I IN 3 .. 4 LOOP
+               IF ARR(I) /= 5 THEN
+                    FAILED ("IN OUT PARAM RETURNED INCORRECTLY - (A)");
+               END IF;
+          END LOOP;
+
+          P3 (ARR(IDENT_INT(3)..4));
+          FOR I IN 3 .. 4 LOOP
+               IF ARR(I) /= 3 THEN
+                    FAILED ("OUT PARAM RETURNED INCORRECTLY - (A)");
+               END IF;
+          END LOOP;
+
+     END;
+
+     RESULT;
+
+END C64109G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109h.ada
new file mode 100644
index 000000000..182856329
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109h.ada
@@ -0,0 +1,160 @@
+-- C64109H.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 SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
+--    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
+--       (A) CHECK ALL PARAMETER MODES.
+
+-- HISTORY:
+--    TBN 07/11/86          CREATED ORIGINAL TEST.
+--    JET 08/04/87          MODIFIED REC.A REFERENCES.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C64109H IS
+
+BEGIN
+     TEST ("C64109H", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
+                      "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
+                      "TO SUBPROGRAMS");
+
+     DECLARE   -- (A)
+
+          TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+          SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(5));
+          TYPE RECORD_TYPE IS
+               RECORD
+                    I : INTEGER;
+                    A : ARRAY_SUBTYPE;
+               END RECORD;
+          REC : RECORD_TYPE := (I => 23,
+                                A => (1..3 => IDENT_INT(7), 4..5 => 9));
+          BOOL : BOOLEAN;
+
+          PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (7, 9, 9) THEN
+                    FAILED ("IN PARAMETER NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= IDENT_INT(3) OR
+                  ARR'LAST /= IDENT_INT(5) THEN
+                    FAILED ("WRONG BOUNDS FOR IN PARAMETER");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+          END P1;
+
+          FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+          BEGIN
+               IF ARR /= (7, 7, 9) THEN
+                    FAILED ("IN PARAMETER NOT PASSED CORRECTLY TO FN");
+               END IF;
+               IF ARR'FIRST /= IDENT_INT(2) OR
+                  ARR'LAST /= IDENT_INT(4) THEN
+                    FAILED ("WRONG BOUNDS FOR IN PARAMETER FOR FN");
+               END IF;
+
+               RETURN TRUE;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN FUNCTION F1");
+          END F1;
+
+          PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (7, 7, 7, 9) THEN
+                    FAILED ("IN OUT PARAMETER NOT PASSED " &
+                            "CORRECTLY");
+               END IF;
+               IF ARR'FIRST /= IDENT_INT(1) OR
+                  ARR'LAST /= IDENT_INT(4) THEN
+                    FAILED ("WRONG BOUNDS FOR IN OUT PARAMETER");
+               END IF;
+               ARR := (ARR'RANGE => 5);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
+          END P2;
+
+          PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR'FIRST /= IDENT_INT(3) OR
+                  ARR'LAST /= IDENT_INT(4) THEN
+                    FAILED ("WRONG BOUNDS FOR OUT PARAMETER");
+               END IF;
+
+               ARR := (ARR'RANGE => 3);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
+          END P3;
+
+     BEGIN     -- (A)
+
+          BEGIN     -- (B)
+               P1 (REC.A (3..5));
+               IF REC.A /= (7, 7, 7, 9, 9) THEN
+                    FAILED ("IN PARAM CHANGED BY PROCEDURE");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P1");
+          END;     -- (B)
+
+          BEGIN     -- (C)
+               BOOL := F1 (REC.A (2..4));
+               IF REC.A /= (7, 7, 7, 9, 9) THEN
+                    FAILED ("IN PARAM CHANGED BY FUNCTION");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF F1");
+          END;     -- (C)
+
+          BEGIN     -- (D)
+               P2 (REC.A (1..4));
+               IF REC.A /= (5, 5, 5, 5, 9) THEN
+                    FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P2");
+          END;     -- (D)
+
+          BEGIN     -- (E)
+               P3 (REC.A (3..4));
+               IF REC.A /= (5, 5, 3, 3, 9) THEN
+                    FAILED ("OUT PARAM RETURNED INCORRECTLY");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P3");
+          END;     -- (E)
+
+     END; -- (A)
+
+     RESULT;
+END C64109H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109i.ada
new file mode 100644
index 000000000..de7ede6b0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109i.ada
@@ -0,0 +1,163 @@
+-- C64109I.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 SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
+--    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
+--    (C) CHECK RECORDS HAVING A DISCRIMINANT, WITH MORE THAN ONE ARRAY
+--       COMPONENT, WHERE THE BOUNDS OF THE ARRAY DEPEND ON THE
+--       DISCRIMINANT.
+
+-- HISTORY:
+--    TBN 07/10/86          CREATED ORIGINAL TEST.
+--    JET 08/04/87          REMOVED PARTIAL ARRAY REFERENCES IN
+--                          RECORD FIELDS.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64109I IS
+
+BEGIN
+     TEST ("C64109I", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
+                      "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
+                      "TO SUBPROGRAMS - RECORDS WITH DISCRIMINANTS");
+
+     DECLARE   -- (C)
+
+          SUBTYPE SUBINT IS INTEGER RANGE 1..6;
+          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF INTEGER;
+          TYPE RECORD_TYPE (BOUND : INTEGER) IS
+               RECORD
+                    B : BOOLEAN;
+                    A : ARRAY_TYPE (1..BOUND);
+                    AA : ARRAY_TYPE (BOUND..6);
+               END RECORD;
+          REC : RECORD_TYPE (BOUND => IDENT_INT(4)) :=
+                               (BOUND => 4,
+                                B => TRUE,
+                                A => (1..IDENT_INT(4) => 6),
+                                AA => (4..6 => 8));
+          BOOL : BOOLEAN;
+
+          PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (6, 6, 6) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(3) THEN
+                    FAILED ("WRONG BOUNDS - IN PARAMETER");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+          END P1;
+
+          FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+          BEGIN
+               IF ARR /= (6, 6, 6) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+               END IF;
+
+               IF ARR'FIRST /= 2 OR ARR'LAST /= IDENT_INT(4) THEN
+                    FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
+               END IF;
+               RETURN TRUE;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN FUNCTION F1");
+          END F1;
+
+          PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (8, 8) THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= 4 OR ARR'LAST /= IDENT_INT(5) THEN
+                    FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
+               END IF;
+
+               ARR := (ARR'RANGE => 10);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
+          END P2;
+
+          PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR'FIRST /= 2 OR ARR'LAST /= IDENT_INT(3) THEN
+                    FAILED ("WRONG BOUNDS - OUT PARAMETER");
+               END IF;
+               ARR := (ARR'RANGE => 4);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
+          END P3;
+
+     BEGIN     -- (C)
+
+          BEGIN     -- (D)
+               P1 (REC.A (1..3));
+               IF REC.A /= (6, 6, 6, 6) THEN
+                    FAILED ("IN PARAM CHANGED BY PROCEDURE");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P1");
+          END;     -- (D)
+
+          BEGIN     -- (E)
+               BOOL := F1 (REC.A (2..4));
+               IF REC.A /= (6, 6, 6, 6) THEN
+                    FAILED ("IN PARAM CHANGED BY FUNCTION");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF F1");
+          END;     -- (E)
+
+          BEGIN     -- (F)
+               P2 (REC.AA (4..5));
+               IF REC.AA /= (10, 10, 8) THEN
+                    FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P2");
+          END;     -- (F)
+
+          BEGIN     -- (G)
+               P3 (REC.A (2..3));
+               IF REC.A /= (6, 4, 4, 6) THEN
+                    FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P3");
+          END;     -- (G)
+
+     END; -- (C)
+
+     RESULT;
+END C64109I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109j.ada
new file mode 100644
index 000000000..c326ef2c4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109j.ada
@@ -0,0 +1,164 @@
+-- C64109J.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 SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
+--    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
+--      (D) CHECK OBJECTS DESIGNATED BY ACCESS TYPES.
+
+-- HISTORY:
+--    TBN 07/10/86          CREATED ORIGINAL TEST.
+--    JET 08/04/87          MODIFIED PTR.A REFERENCES.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C64109J IS
+
+BEGIN
+     TEST ("C64109J", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
+                      "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
+                      "TO SUBPROGRAMS - OBJECTS DESIGNATED BY ACCESS " &
+                      "TYPES");
+
+     DECLARE   -- (D)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..5;
+          TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>) OF INTEGER;
+          SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE(1..IDENT_INT(5));
+          TYPE NODE_TYPE;
+          TYPE ACCESS_TYPE IS ACCESS NODE_TYPE;
+          TYPE NODE_TYPE IS
+               RECORD
+                    A    : ARRAY_SUBTYPE;
+                    NEXT : ACCESS_TYPE;
+               END RECORD;
+          PTR : ACCESS_TYPE := NEW NODE_TYPE'
+                    (A => (IDENT_INT(1)..5 => IDENT_INT(5)),
+                     NEXT => NULL);
+          BOOL : BOOLEAN;
+
+          PROCEDURE P1 (ARR : ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (5, 5, 5) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                    FAILED ("WRONG BOUNDS - IN PARAMETER");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+          END P1;
+
+          FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
+          BEGIN
+               IF ARR /= (5, 5, 5) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+               END IF;
+
+               IF ARR'FIRST /= IDENT_INT(2) OR ARR'LAST /= 4 THEN
+                    FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
+               END IF;
+
+               RETURN TRUE;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN FUNCTION F1");
+          END F1;
+
+          PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (5, 5, 5) THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+               END IF;
+
+               IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                    FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
+               END IF;
+
+               ARR := (ARR'RANGE => 6);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
+          END P2;
+
+          PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
+          BEGIN
+
+               IF ARR'FIRST /= IDENT_INT(3) OR ARR'LAST /= 5 THEN
+                    FAILED ("WRONG BOUNDS - OUT PARAMETER");
+               END IF;
+
+               ARR := (ARR'RANGE => 7);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
+          END P3;
+
+     BEGIN     -- (D)
+
+          BEGIN     -- (E)
+               P1 (PTR.A (1..3));
+               IF PTR.A /= (5, 5, 5, 5, 5) THEN
+                    FAILED ("IN PARAM CHANGED BY PROCEDURE");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P1");
+          END;     -- (E)
+
+          BEGIN     -- (F)
+               BOOL := F1 (PTR.A (2..4));
+               IF PTR.A /= (5, 5, 5, 5, 5) THEN
+                    FAILED ("IN PARAM CHANGED BY FUNCTION");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF F1");
+          END;     -- (F)
+
+          BEGIN     -- (G)
+               P2 (PTR.A (1..3));
+               IF PTR.A /= (6, 6, 6, 5, 5) THEN
+                    FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P2");
+          END;     -- (G)
+
+          BEGIN     -- (H)
+               P3 (PTR.A (3..5));
+               IF PTR.A /= (6, 6, 7, 7, 7) THEN
+                    FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P3");
+          END;     -- (H)
+
+     END; -- (D)
+
+     RESULT;
+END C64109J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109k.ada
new file mode 100644
index 000000000..d72d8ec6c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109k.ada
@@ -0,0 +1,191 @@
+-- C64109K.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 SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
+--    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
+--    (E) CHECK THE CASE WHERE THE FORMAL IS UNCONSTRAINED, AND ARRAYS
+--       WITH DIFFERENT BOUNDS ARE PASSED AS ACTUALS.
+
+-- HISTORY:
+--    TBN 07/11/86          CREATED ORIGINAL TEST.
+--    JET 08/04/87          MODIFIED REC.A REFERENCES.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C64109K IS
+
+BEGIN
+     TEST ("C64109K", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
+                      "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
+                      "TO SUBPROGRAMS - ARRAYS WITH DIFFERENT BOUNDS " &
+                      "PASSED TO UNCONSTRAINED FORMAL");
+
+     DECLARE   -- (E)
+
+          SUBTYPE SUBINT IS INTEGER RANGE 0..5;
+          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
+          TYPE RECORD_TYPE IS
+               RECORD
+                    A : ARRAY_TYPE (IDENT_INT(0)..IDENT_INT(4));
+                    B : ARRAY_TYPE (1..5);
+               END RECORD;
+          REC : RECORD_TYPE := (A => (0..4 => IDENT_BOOL(TRUE)),
+                                B => (1..5 => IDENT_BOOL(FALSE)));
+          BOOL : BOOLEAN;
+
+          PROCEDURE P1 (ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (TRUE, TRUE, TRUE) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY");
+               END IF;
+               IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                    FAILED ("WRONG IN PARAMETER BOUNDS - 1");
+               END IF;
+               IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY - 2");
+               END IF;
+               IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                    FAILED ("WRONG IN PARAMETER BOUNDS - 2");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
+          END P1;
+
+          FUNCTION F1 ( ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE)
+               RETURN BOOLEAN IS
+          BEGIN
+               IF ARR /= (TRUE, TRUE, TRUE) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+               END IF;
+               IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
+                    FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 1");
+               END IF;
+               IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
+               END IF;
+               IF ARR2'FIRST /= 3 OR ARR2'LAST /= IDENT_INT(5) THEN
+                    FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 2");
+               END IF;
+               RETURN TRUE;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN FUNCTION F1");
+          END F1;
+
+          PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE;
+                        ARR2 : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR /= (TRUE, TRUE, TRUE) THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+               END IF;
+               IF ARR'FIRST /= IDENT_INT(2) OR ARR'LAST /= 4 THEN
+                    FAILED ("WRONG IN OUT PARAMETER BOUNDS - 1");
+               END IF;
+               IF ARR2 /= (FALSE, FALSE, FALSE) THEN
+                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
+               END IF;
+               IF ARR2'FIRST /= 2 OR ARR2'LAST /= IDENT_INT(4) THEN
+                    FAILED ("WRONG IN OUT PARAMETER BOUNDS - 2");
+               END IF;
+               ARR := (ARR'RANGE => FALSE);
+               ARR2 := (ARR2'RANGE => TRUE);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
+          END P2;
+
+          PROCEDURE P3 (ARR : OUT ARRAY_TYPE; ARR2 : OUT ARRAY_TYPE) IS
+          BEGIN
+               IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
+                    FAILED ("WRONG OUT PARAMETER BOUNDS - 1");
+               END IF;
+               IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
+                    FAILED ("WRONG OUT  PARAMETER BOUNDS - 2");
+               END IF;
+               ARR := (ARR'RANGE => FALSE);
+               ARR2 := (ARR2'RANGE => TRUE);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
+          END P3;
+
+     BEGIN     -- (E)
+
+          BEGIN     -- (F)
+               P1 (REC.A (0..2), REC.B (1..3));
+               IF REC.A /= (TRUE, TRUE, TRUE, TRUE, TRUE) THEN
+                    FAILED ("IN PARAM CHANGED BY PROCEDURE");
+               END IF;
+               IF REC.B /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
+                    FAILED ("IN PARAM CHANGED BY PROCEDURE - 2");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P1");
+          END;     -- (F)
+
+          BEGIN     -- (G)
+               BOOL := F1 (REC.A (1..3), REC.B (3..5));
+               IF REC.A /= (TRUE, TRUE, TRUE, TRUE, TRUE) THEN
+                    FAILED ("IN PARAM CHANGED BY FUNCTION");
+               END IF;
+               IF REC.B /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
+                    FAILED ("IN PARAM CHANGED BY FUNCTION - 2");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF F1");
+          END;     -- (G)
+
+          BEGIN     -- (H)
+               P2 (REC.A (2..4), REC.B (2..4));
+               IF REC.A /= (TRUE, TRUE, FALSE, FALSE, FALSE) THEN
+                    FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
+               END IF;
+               IF REC.B /= (FALSE, TRUE, TRUE, TRUE, FALSE) THEN
+                    FAILED ("IN OUT PARAM RETURNED INCORRECTLY - 2");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P2");
+          END;     -- (H)
+
+          BEGIN     -- (I)
+               P3 (REC.A (0..2), REC.B (1..3));
+               IF REC.A /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
+                    FAILED ("OUT PARAM RETURNED INCORRECTLY");
+               END IF;
+               IF REC.B /= (TRUE, TRUE, TRUE, TRUE, FALSE) THEN
+                    FAILED ("OUT PARAM RETURNED INCORRECTLY - 2");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P3");
+          END;     -- (I)
+
+     END; -- (E)
+
+     RESULT;
+END C64109K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109l.ada
new file mode 100644
index 000000000..7bdb17040
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64109l.ada
@@ -0,0 +1,158 @@
+-- C64109L.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 SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
+--    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
+--       (F) CHECK THAT A FORMAL PARAMETER CAN BE USED AS AN ACTUAL IN
+--       ANOTHER SUBPROGRAM CALL.
+
+-- HISTORY:
+--    TBN 07/11/86          CREATED ORIGINAL TEST.
+--    JET 08/04/87          MODIFIED REC.A REFERENCES.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C64109L IS
+
+BEGIN
+     TEST ("C64109L", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
+                      "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
+                      "TO SUBPROGRAMS - FORMAL AS AN ACTUAL");
+
+     DECLARE   -- (F)
+
+          TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+          SUBTYPE ARRAY_SUBTYPE IS
+                    ARRAY_TYPE (IDENT_INT(1)..IDENT_INT(5));
+          TYPE RECORD_TYPE IS
+               RECORD
+                    I : INTEGER;
+                    A : ARRAY_SUBTYPE;
+               END RECORD;
+          REC : RECORD_TYPE := (I => 23,
+                                A => (1..3 => 7, 4..5 => 9));
+          BOOL : BOOLEAN;
+
+          PROCEDURE P_CALLED (A : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               IF A /= (7, 7, 7) THEN
+                    FAILED ("IN OUT PARAM NOT RECEIVED CORRECTLY");
+               END IF;
+               IF A'FIRST /= 1 OR A'LAST /= IDENT_INT(3) THEN
+                    FAILED ("BOUNDS WRONG - IN OUT");
+               END IF;
+               A := (A'RANGE => 6);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P_CALLED");
+          END P_CALLED;
+
+          PROCEDURE P (A : IN OUT ARRAY_TYPE) IS
+          BEGIN
+               P_CALLED (A);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P");
+          END P;
+
+          FUNCTION F_CALLED (A : ARRAY_TYPE) RETURN BOOLEAN IS
+               GOOD : BOOLEAN;
+          BEGIN
+               GOOD := (A = (6, 9, 9));
+               IF NOT GOOD THEN
+                    FAILED ("IN PARAMETER NOT RECEIVED CORRECTLY");
+               END IF;
+               IF A'FIRST /= 3 OR A'LAST /= IDENT_INT(5) THEN
+                    FAILED ("BOUNDS WRONG - FUNCTION");
+               END IF;
+               RETURN GOOD;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN FUNCTION F_CALLED");
+          END F_CALLED;
+
+          FUNCTION F (A : ARRAY_TYPE) RETURN BOOLEAN IS
+          BEGIN
+               RETURN (F_CALLED (A));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN FUNCTION F");
+          END F;
+
+          PROCEDURE P_OUT_CALLED (A : OUT ARRAY_TYPE) IS
+          BEGIN
+               IF A'FIRST /= IDENT_INT(2) OR A'LAST /= 4 THEN
+                    FAILED ("BOUNDS WRONG - OUT");
+               END IF;
+               A := (8, 8, 8);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE " &
+                                 "P_OUT_CALLED");
+          END P_OUT_CALLED;
+
+          PROCEDURE P_OUT (A : OUT ARRAY_TYPE) IS
+          BEGIN
+               P_OUT_CALLED (A);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN PROCEDURE P_OUT");
+          END P_OUT;
+
+     BEGIN     -- (F)
+
+          BEGIN     -- (G)
+               P (REC.A (1..3));
+               IF REC.A /= (6, 6, 6, 9, 9) THEN
+                    FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P");
+          END;     -- (G)
+
+          BEGIN     -- (H)
+               BOOL := F (REC.A (3..5));
+               IF NOT BOOL THEN
+                    FAILED ("IN PARAM NOT RETURNED CORRECTLY");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF F");
+          END;     -- (H)
+
+          BEGIN     -- (I)
+               P_OUT (REC.A (2..4));
+               IF REC.A /= (6, 8, 8, 8, 9) THEN
+                    FAILED ("OUT PARAM NOT RETURNED CORRECTLY - 2");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED DURING CALL OF P_OUT");
+          END;     -- (I)
+
+     END; -- (F)
+
+     RESULT;
+END C64109L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201b.ada
new file mode 100644
index 000000000..e550b34ca
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201b.ada
@@ -0,0 +1,101 @@
+-- C64201B.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 INITALIZATION OF IN PARAMETERS OF A TASK
+-- TYPE IS PERMITTED.
+-- (SEE ALSO 7.4.4/T2 FOR TESTS OF LIMITED PRIVATE TYPES.)
+
+-- CVP 5/14/81
+-- ABW 7/1/82
+-- BHS 7/9/84
+
+WITH REPORT;
+PROCEDURE C64201B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST( "C64201B" , "CHECK THAT INITIALIZATION OF IN PARAMETERS " &
+                       "OF A TASK TYPE IS PERMITTED" );
+
+     DECLARE
+
+          GLOBAL : INTEGER := 10;
+
+          TASK TYPE T_TYPE IS
+               ENTRY E (X : IN OUT INTEGER);
+          END;
+
+          TSK1, TSK2 : T_TYPE;
+
+          TASK BODY T_TYPE IS
+          BEGIN
+               ACCEPT E (X : IN OUT INTEGER) DO
+                    X := X - 1;
+               END E;
+               ACCEPT E (X : IN OUT INTEGER) DO
+                    X := X + 1;
+               END E;
+          END T_TYPE;
+
+
+          PROCEDURE PROC1 (T : T_TYPE := TSK1) IS
+          BEGIN
+               T.E (X => GLOBAL);
+          END PROC1;
+
+          PROCEDURE PROC2 (T : T_TYPE := TSK1) IS
+          BEGIN
+               T.E (X => GLOBAL);
+               IF (GLOBAL /= IDENT_INT(8)) THEN
+                    FAILED( "TASK NOT PASSED IN PROC1, " &
+                            "DEFAULT TSK1 EMPLOYED" );
+               END IF;
+          END PROC2;
+
+          PROCEDURE TERM (T : T_TYPE; NUM : CHARACTER) IS
+          BEGIN
+               IF NOT T'TERMINATED THEN
+                    ABORT T;
+                    COMMENT ("ABORTING TASK " & NUM);
+               END IF;
+          END TERM;
+
+     BEGIN
+
+          PROC1(TSK2);
+          IF GLOBAL /= 9 THEN
+               FAILED ("INCORRECT GLOBAL VALUE AFTER PROC1");
+          ELSE
+               PROC2;
+          END IF;
+
+          TERM(TSK1, '1');
+          TERM(TSK2, '2');
+     END;
+
+     RESULT;
+
+END C64201B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201c.ada
new file mode 100644
index 000000000..ac7fec806
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201c.ada
@@ -0,0 +1,196 @@
+-- C64201C.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 INITIALIZATION OF IN PARAMETERS OF A COMPOSITE
+--   TYPE HAVING AT LEAST ONE COMPONENT (INCLUDING COMPONENTS
+--   OF COMPONENTS) OF A TASK TYPE IS PERMITTED.
+--  (SEE ALSO 7.4.4/T2 FOR TESTS OF LIMITED PRIVATE TYPES.)
+
+-- CVP 5/14/81
+-- ABW 7/1/82
+-- BHS 7/9/84
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C64201C IS
+
+
+     GLOBAL : INTEGER := 10;
+
+
+     TASK TYPE T IS
+          ENTRY E (X : IN OUT INTEGER);
+     END;
+
+     TYPE REC_T IS
+          RECORD
+               TT : T;
+               BB : BOOLEAN := TRUE;
+          END RECORD;
+
+     TYPE REC_REC_T IS
+          RECORD
+               RR : REC_T;
+          END RECORD;
+
+     TYPE ARR_T IS ARRAY (1 .. 2) OF T;
+
+     TYPE ARR_REC_T IS ARRAY (1 .. 2) OF REC_T;
+
+     RT1, RT2   : REC_T;
+     RRT1, RRT2 : REC_REC_T;
+     AT1, AT2   : ARR_T;
+     ART1, ART2 : ARR_REC_T;
+
+     
+     TASK BODY T IS
+     BEGIN
+          ACCEPT E (X : IN OUT INTEGER) DO
+               X := X - 1;
+          END E;
+          ACCEPT E (X : IN OUT INTEGER) DO
+               X := X + 1;
+          END E;
+     END T;
+
+
+     PROCEDURE PROC1A (P1X : REC_T := RT1) IS
+     BEGIN
+          IF P1X.BB THEN                 -- EXPECT RT2 PASSED.
+               FAILED( "RECORD OF TASK NOT PASSED, DEFAULT EMPLOYED" );
+          END IF;
+     END PROC1A;
+
+     PROCEDURE PROC1B (P1X : REC_T := RT1) IS
+     BEGIN
+          IF NOT P1X.BB THEN             -- EXPECT DEFAULT USED.
+               FAILED( "DEFAULT RECORD OF TASK NOT EMPLOYED" );
+          END IF;
+     END PROC1B;
+
+
+     PROCEDURE PROC2A (P2X : REC_REC_T := RRT1) IS
+     BEGIN
+          IF P2X.RR.BB THEN             -- EXPECT RRT2 PASSED.
+               FAILED( "RECORD OF RECORD OF TASK NOT PASSED, " &
+                       "DEFAULT EMPLOYED" );
+          END IF;
+     END PROC2A;
+
+     PROCEDURE PROC2B (P2X : REC_REC_T := RRT1) IS
+     BEGIN
+          IF NOT P2X.RR.BB THEN         -- EXPECT DEFAULT USED.
+               FAILED( "DEFAULT RECORD OF RECORD OF TASK " &
+                       "NOT EMPLOYED" );
+          END IF;
+     END PROC2B;
+
+
+     PROCEDURE PROC3 (P3X : ARR_T := AT1) IS
+     BEGIN
+          P3X(1).E (X => GLOBAL);        -- CALL TO AT2(1).E,
+                                         -- GLOBAL => GLOBAL - 1.
+     END PROC3;
+
+     PROCEDURE PROC4 (P4X : ARR_T := AT1) IS
+     BEGIN
+          P4X(1).E (X => GLOBAL);     -- CALL TO DEFAULT AT1(1).E,
+                                      -- GLOBAL => GLOBAL - 1.
+          IF GLOBAL /= IDENT_INT(8) THEN
+               FAILED( "ARRAY OF TASKS NOT PASSED " &
+                       "CORRECTLY IN PROC3" );
+          END IF;
+     END PROC4;
+
+     PROCEDURE PROC5 (P5X : ARR_REC_T := ART1) IS
+     BEGIN
+          P5X(1).TT.E (X => GLOBAL);      -- CALL TO ART2(1).TT.E,
+                                          -- GLOBAL => GLOBAL - 1.
+     END PROC5;
+
+     PROCEDURE PROC6 (P6X : ARR_REC_T := ART1) IS
+     BEGIN
+          P6X(1).TT.E (X => GLOBAL);      -- CALL DEFAULT ART1(1).TT.E,
+                                          -- GLOBAL => GLOBAL - 1.
+          IF GLOBAL /= IDENT_INT(8) THEN
+               FAILED( "ARRAY OF RECORDS OF TASKS NOT " &
+                       "PASSED IN PROC5" );
+          END IF;
+     END PROC6;
+
+     PROCEDURE TERM (TSK : T; NUM : CHARACTER) IS
+     BEGIN
+          IF NOT TSK'TERMINATED THEN
+               ABORT TSK;
+               COMMENT ("ABORTING TASK " & NUM);
+          END IF;
+     END TERM;
+
+
+BEGIN
+
+     TEST( "C64201C" , "CHECK THAT INITIALIZATION OF IN " &
+                       "PARAMETERS OF A COMPOSITE TYPE " &
+                       "IS PERMITTED" );
+
+     RT2.BB := FALSE;
+     RRT2.RR.BB := FALSE;
+
+     PROC1A(RT2);                               -- NO ENTRY CALL
+     PROC1B;                                    -- NO ENTRY CALL
+     PROC2A(RRT2);                              -- NO ENTRY CALL
+     PROC2B;                                    -- NO ENTRY CALL
+
+     PROC3(AT2);                                -- CALL AT2(1).E
+     IF GLOBAL /= 9 THEN
+          FAILED ("INCORRECT GLOBAL VALUE AFTER PROC3");
+     ELSE
+          PROC4;                                -- CALL AT1(1).E
+     END IF;
+
+     GLOBAL := 10;
+     PROC5(ART2);                              -- CALL ART2(1).TT.E
+     IF GLOBAL /= 9 THEN
+          FAILED ("INCORRECT GLOBAL VALUE AFTER PROC5");
+     ELSE
+          PROC6;                               -- CALL ART1(1).TT.E
+     END IF;
+
+-- MAKE SURE ALL TASKS TERMINATED
+     TERM (RT1.TT, '1');
+     TERM (RT2.TT, '2');
+     TERM (RRT1.RR.TT, '3');
+     TERM (RRT2.RR.TT, '4');
+     TERM (AT1(1), '5');
+     TERM (AT2(1), '6');
+     TERM (AT1(2), '7');
+     TERM (AT2(2), '8');
+     TERM (ART1(1).TT, '9');
+     TERM (ART2(1).TT, 'A');
+     TERM (ART1(2).TT, 'B');
+     TERM (ART2(2).TT, 'C');
+
+     RESULT;
+
+END C64201C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64202a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64202a.ada
new file mode 100644
index 000000000..3c4af8ef9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64202a.ada
@@ -0,0 +1,72 @@
+-- C64202A.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 DEFAULT EXPRESSIONS OF FORMAL PARAMETERS ARE EVALUATED
+-- EACH TIME THEY ARE NEEDED.
+
+-- SPS 2/22/84
+
+WITH REPORT; USE REPORT;
+PROCEDURE C64202A IS
+BEGIN
+
+     TEST ("C64202A", "CHECK THAT THE DEFAULT EXPRESSION IS EVALUATED" &
+           " EACH TIME IT IS NEEDED");
+
+     DECLARE
+          X : INTEGER := 1;
+          FUNCTION F RETURN INTEGER IS
+          BEGIN
+               X := X + 1;
+               RETURN X;
+          END F;
+
+          PROCEDURE P (CALL : POSITIVE; X, Y : INTEGER := F) IS 
+          BEGIN
+               IF CALL = 1 THEN
+                    IF X = Y OR Y /= 2 THEN
+                         FAILED ("DEFAULT NOT EVALUATED CORRECTLY - 1" &
+                                 " X =" & INTEGER'IMAGE(X) & " Y =" &
+                                 INTEGER'IMAGE(Y));
+                    END IF;
+               ELSIF CALL = 2 THEN
+                    IF X = Y OR 
+                       NOT ((X = 3 AND Y = 4) OR (X = 4 AND Y = 3)) THEN
+                         FAILED ("DEFAULT NOT EVALUATED CORRECTLY - 2" &
+                                 " X =" & INTEGER'IMAGE(X) & " Y =" &
+                                 INTEGER'IMAGE(Y));
+                    END IF;
+               END IF;
+          END P;
+
+     BEGIN
+          COMMENT ("FIRST CALL");
+          P (1, 3);
+          COMMENT ("SECOND CALL");
+          P(2);
+     END;
+
+     RESULT;
+
+END C64202A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c650001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c650001.a
new file mode 100644
index 000000000..595e81dad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c650001.a
@@ -0,0 +1,412 @@
+-- C650001.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, for a function result type that is a return-by-reference
+--      type, Program_Error is raised if the return expression is a name that
+--      denotes an object view whose accessibility level is deeper than that
+--      of the master that elaborated the function body.
+--      
+--      Check for cases where the result type is:
+--         (a) A tagged limited type.
+--         (b) A task type.
+--         (c) A protected type.
+--         (d) A composite type with a subcomponent of a
+--             return-by-reference type (task type).
+--      
+-- TEST DESCRIPTION:
+--      The accessibility level of the master that elaborates the body of a
+--      return-by-reference function will always be less deep than that of
+--      the function (which is itself a master). 
+--
+--      Thus, the return object may not be any of the following, since each
+--      has an accessibility level at least as deep as that of the function:
+--
+--         (1) An object declared local to the function. 
+--         (2) The result of a local function.           
+--         (3) A parameter of the function.              
+--
+--      Verify that Program_Error is raised within the return-by-reference
+--      function if the return object is any of (1)-(3) above, for various
+--      subsets of the return types (a)-(d) above. Include cases where (1)-(3)
+--      are operands of parenthesized expressions.
+--
+--      Verify that no exception is raised if the return object is any of the
+--      following:
+--
+--         (4) An object declared at a less deep level than that of the
+--             master that elaborated the function body.
+--         (5) The result of a function declared at the same level as the
+--             original function (assuming the new function is also legal).
+--         (6) A parameter of the master that elaborated the function body.
+--
+--      For (5), pass the new function as an actual via an access-to-
+--      subprogram parameter of the original function. Check for cases where
+--      the new function does and does not raise an exception.
+--
+--      Since the functions to be tested cannot be part of an assignment
+--      statement (since they return values of a limited type), pass each
+--      function result as an actual parameter to a dummy procedure, e.g.,
+--
+--         Dummy_Proc ( Function_Call );
+--
+--
+-- CHANGE HISTORY:
+--      03 May 95   SAIC    Initial prerelease version.
+--      08 Feb 99   RLB     Removed subcase with two errors.
+--
+--!
+
+package C650001_0 is
+
+   type Tagged_Limited is tagged limited record
+      C: String (1 .. 10);
+   end record;
+
+   task type Task_Type;
+
+   protected type Protected_Type is
+      procedure Op;
+   end Protected_Type;
+
+   type Task_Array is array (1 .. 10) of Task_Type;
+
+   type Variant_Record (Toggle: Boolean) is record
+      case Toggle is
+         when True  =>
+            T: Task_Type;  -- Return-by-reference component.
+         when False =>
+            I: Integer;    -- Non-return-by-reference component.
+      end case;
+   end record;
+
+   -- Limited type even though variant contains no limited components:
+   type Non_Task_Variant is new Variant_Record (Toggle => False);
+
+end C650001_0;
+
+
+     --==================================================================--
+
+
+package body C650001_0 is
+
+   task body Task_Type is
+   begin
+      null;
+   end Task_Type;
+
+   protected body Protected_Type is
+      procedure Op is
+      begin
+         null;
+      end Op;
+   end Protected_Type;
+
+end C650001_0;
+
+
+     --==================================================================--
+
+
+with C650001_0;
+package C650001_1 is
+
+   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);
+
+   -- Dummy procedures:
+
+   procedure Check_Tagged    (P: C650001_0.Tagged_Limited);
+   procedure Check_Task      (P: C650001_0.Task_Type);
+   procedure Check_Protected (P: C650001_0.Protected_Type);
+   procedure Check_Composite (P: C650001_0.Non_Task_Variant);
+
+end C650001_1;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C650001_1 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;
+
+
+   procedure Check_Tagged (P: C650001_0.Tagged_Limited) is
+   begin
+      null;
+   end;
+
+   procedure Check_Task (P: C650001_0.Task_Type) is
+   begin
+      null;
+   end;
+
+   procedure Check_Protected (P: C650001_0.Protected_Type) is
+   begin
+      null;
+   end;
+
+   procedure Check_Composite (P: C650001_0.Non_Task_Variant) is
+   begin
+      null;
+   end;
+
+end C650001_1;
+
+
+
+     --==================================================================--
+
+
+with C650001_0;
+with C650001_1;
+
+with Report;
+procedure C650001 is
+begin
+
+   Report.Test ("C650001", "Check that, for a function result type that " &
+                "is a return-by-reference type, Program_Error is raised " &
+                "if the return expression is a name that denotes an "     &
+                "object view whose accessibility level is deeper than "   &
+                "that of the master that elaborated the function body");
+
+
+
+   SUBTEST1:
+   declare
+
+      Result: C650001_1.TC_Result_Kind;
+      PO    : C650001_0.Protected_Type;
+
+      function Return_Prot (P: C650001_0.Protected_Type)
+        return C650001_0.Protected_Type is
+      begin
+         Result := C650001_1.OK;
+         return P;                                     -- Formal parameter (3).
+      exception
+         when Program_Error =>
+            Result := C650001_1.P_E;                        -- Expected result.
+            return PO;
+         when others        =>
+            Result := C650001_1.O_E;
+            return PO;
+      end Return_Prot;
+
+   begin  -- SUBTEST1.
+      C650001_1.Check_Protected ( Return_Prot(PO) );
+      C650001_1.TC_Display_Results (Result, C650001_1.P_E, "SUBTEST #1");
+   exception
+      when others =>
+         Report.Failed ("SUBTEST #1: Unexpected exception in outer block");
+   end SUBTEST1;
+
+
+
+   SUBTEST2:
+   declare
+
+      Result: C650001_1.TC_Result_Kind;
+      Comp  : C650001_0.Non_Task_Variant;
+
+      function Return_Composite return C650001_0.Non_Task_Variant is
+         Local: C650001_0.Non_Task_Variant;
+      begin
+         Result := C650001_1.OK;
+         return (Local);                     -- Parenthesized local object (1).
+      exception
+         when Program_Error =>
+            Result := C650001_1.P_E;                        -- Expected result.
+            return Comp;
+         when others        =>
+            Result := C650001_1.O_E;
+            return Comp;
+      end Return_Composite;
+
+   begin -- SUBTEST2.
+      C650001_1.Check_Composite ( Return_Composite );
+      C650001_1.TC_Display_Results (Result, C650001_1.P_E, "SUBTEST #2");
+   exception
+      when others =>
+         Report.Failed ("SUBTEST #2: Unexpected exception in outer block");
+   end SUBTEST2;
+
+
+
+   SUBTEST3:
+   declare
+
+      Result: C650001_1.TC_Result_Kind;
+      Tsk   : C650001_0.Task_Type;
+      TskArr: C650001_0.Task_Array;
+
+      function Return_Task (P: C650001_0.Task_Array)
+        return C650001_0.Task_Type is
+
+         function Inner return C650001_0.Task_Type is
+         begin
+            return P(P'First);           -- OK: should not raise exception (6).
+         exception
+            when Program_Error =>
+               Report.Failed ("SUBTEST #3: Program_Error incorrectly " &
+                              "raised within function Inner");
+               return Tsk;
+            when others        =>
+               Report.Failed ("SUBTEST #3: Unexpected exception " &
+                              "raised within function Inner");
+               return Tsk;
+         end Inner;
+
+      begin -- Return_Task.
+         Result := C650001_1.OK;
+         return Inner;                           -- Call to local function (2).
+      exception
+         when Program_Error =>
+            Result := C650001_1.P_E;                        -- Expected result.
+            return Tsk;
+         when others        =>
+            Result := C650001_1.O_E;
+            return Tsk;
+      end Return_Task;
+
+   begin -- SUBTEST3.
+      C650001_1.Check_Task ( Return_Task(TskArr) );
+      C650001_1.TC_Display_Results (Result, C650001_1.P_E, "SUBTEST #3");
+   exception
+      when others =>
+         Report.Failed ("SUBTEST #3: Unexpected exception in outer block");
+   end SUBTEST3;
+
+
+
+   SUBTEST4:
+   declare
+
+      Result: C650001_1.TC_Result_Kind;
+      TagLim: C650001_0.Tagged_Limited;
+
+      function Return_TagLim (P: C650001_0.Tagged_Limited'Class)
+        return C650001_0.Tagged_Limited is
+      begin
+         Result := C650001_1.OK;
+         return C650001_0.Tagged_Limited(P); -- Conversion of formal param (3).
+      exception
+         when Program_Error =>
+            Result := C650001_1.P_E;                        -- Expected result.
+            return TagLim;
+         when others        =>
+            Result := C650001_1.O_E;
+            return TagLim;
+      end Return_TagLim;
+
+   begin -- SUBTEST4.
+      C650001_1.Check_Tagged ( Return_TagLim(TagLim) );
+      C650001_1.TC_Display_Results (Result, C650001_1.P_E,
+                                    "SUBTEST #4 (root type)");
+   exception
+      when others =>
+         Report.Failed ("SUBTEST #4: Unexpected exception in outer block");
+   end SUBTEST4;
+
+
+
+   SUBTEST5:
+   declare
+      Tsk : C650001_0.Task_Type;
+   begin  -- SUBTEST5.
+
+      declare
+         Result: C650001_1.TC_Result_Kind;
+
+         type AccToFunc is access function return C650001_0.Task_Type;
+
+         function Return_Global return C650001_0.Task_Type is
+         begin
+            return Tsk;                  -- OK: should not raise exception (4).
+         end Return_Global;
+
+         function Return_Local return C650001_0.Task_Type is
+            Local : C650001_0.Task_Type;
+         begin
+            return Local;                           -- Propagate Program_Error.
+         end Return_Local;
+
+
+         function Return_Func (P: AccToFunc) return C650001_0.Task_Type is
+         begin
+            Result := C650001_1.OK;
+            return P.all;                                 -- Function call (5).
+         exception
+            when Program_Error =>
+               Result := C650001_1.P_E;
+               return Tsk;
+            when others        =>
+               Result := C650001_1.O_E;
+               return Tsk;
+         end Return_Func;
+
+         RG : AccToFunc := Return_Global'Access;
+         RL : AccToFunc := Return_Local'Access;
+
+      begin
+         C650001_1.Check_Task ( Return_Func(RG) );
+         C650001_1.TC_Display_Results (Result, C650001_1.OK,
+                                       "SUBTEST #5 (global task)");
+
+         C650001_1.Check_Task ( Return_Func(RL) );
+         C650001_1.TC_Display_Results (Result, C650001_1.P_E,
+                                       "SUBTEST #5 (local task)");
+      exception
+         when others =>
+            Report.Failed ("SUBTEST #5: Unexpected exception in outer block");
+      end;
+
+   end SUBTEST5;
+
+
+
+   Report.Result;
+
+end C650001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c65003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c65003a.ada
new file mode 100644
index 000000000..49cd2b55e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c65003a.ada
@@ -0,0 +1,100 @@
+-- C65003A.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 NO RETURN STATEMENT IS EXECUTED, A FUNCTION RAISES
+-- PROGRAM_ERROR.  DETERMINE WHERE THE EXCEPTION IS RAISED.
+
+-- THIS LACK OF AN EXECUTABLE RETURN IS DETECTABLE AT COMPILE TIME IN
+-- THIS TEST.
+
+-- JBG 10/14/83
+-- SPS 2/22/84
+
+WITH REPORT; USE REPORT;
+PROCEDURE C65003A IS
+
+     EXCEPTION_RAISED : BOOLEAN := FALSE;
+     FUNCTION RETURN_IN_EXCEPTION RETURN INTEGER IS
+     BEGIN
+          IF FALSE THEN
+               RETURN 5;
+          END IF;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED IN FUNCTION BODY - " &
+                        "RETURN_IN_EXCEPTION");
+               EXCEPTION_RAISED := TRUE;
+               RETURN 5;
+     END RETURN_IN_EXCEPTION;
+
+     FUNCTION NO_RETURN RETURN INTEGER IS
+          NO_RETURN_EXCEPTION : EXCEPTION;
+     BEGIN
+          RAISE NO_RETURN_EXCEPTION;
+          RETURN 5;
+     EXCEPTION
+          WHEN NO_RETURN_EXCEPTION =>
+               NULL;
+     END NO_RETURN;
+
+BEGIN
+
+     TEST ("C65003A", "CHECK THAT PROGRAM_ERROR IS RAISED IF A " &
+                      "FUNCTION RETURNS WITHOUT EXECUTING A RETURN " &
+                      "STATEMENT");
+
+     BEGIN
+
+          IF RETURN_IN_EXCEPTION = RETURN_IN_EXCEPTION THEN
+               IF NOT EXCEPTION_RAISED THEN
+                    FAILED ("PROGRAM_ERROR NOT RAISED - " &
+                            "RETURN_IN_EXCEPTION");
+               END IF;
+          END IF;
+
+     EXCEPTION
+     
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED AT POINT OF CALL " &
+                        "- RETURN_IN_EXCEPTION");
+
+     END;
+
+
+     BEGIN
+
+          IF NO_RETURN = NO_RETURN THEN
+               FAILED ("PROGRAM_ERROR NOT RAISED - NO_RETURN");
+          END IF;
+
+     EXCEPTION
+     
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED WHEN NO RETURN IN " &
+                        "EXCEPTION HANDLER");
+     END;
+
+     RESULT;
+
+END C65003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c65003b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c65003b.ada
new file mode 100644
index 000000000..d93d1b480
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c65003b.ada
@@ -0,0 +1,73 @@
+-- C65003B.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 NO RETURN STATEMENT IS EXECUTED, A FUNCTION RAISES
+-- PROGRAM_ERROR.  DETERMINE WHERE THE EXCEPTION IS RAISED.
+
+-- THIS LACK OF AN EXECUTABLE RETURN IS NOT DETECTABLE AT COMPILE TIME.
+
+-- JBG 10/14/83
+-- SPS 2/22/84
+
+WITH REPORT; USE REPORT;
+PROCEDURE C65003B IS
+
+     EXCEPTION_RAISED : BOOLEAN := FALSE;
+
+     FUNCTION RETURN_IN_EXCEPTION RETURN INTEGER IS
+     BEGIN
+          WHILE NOT EQUAL (1, 1) LOOP
+               RETURN 5;
+          END LOOP;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED IN FUNCTION BODY");
+               EXCEPTION_RAISED := TRUE;
+               RETURN 5;
+     END RETURN_IN_EXCEPTION;
+
+BEGIN
+
+     TEST ("C65003B", "CHECK THAT PROGRAM_ERROR IS RAISED IF A " &
+                      "FUNCTION RETURNS WITHOUT EXECUTING A RETURN " &
+                      "STATEMENT");
+
+     BEGIN
+
+          IF RETURN_IN_EXCEPTION = RETURN_IN_EXCEPTION THEN
+               IF NOT EXCEPTION_RAISED THEN
+                    FAILED ("PROGRAM_ERROR NOT RAISED");
+               END IF;
+          END IF;
+
+     EXCEPTION
+     
+          WHEN PROGRAM_ERROR =>
+               COMMENT ("PROGRAM_ERROR RAISED AT POINT OF CALL");
+
+     END;
+
+     RESULT;
+
+END C65003B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002a.ada
new file mode 100644
index 000000000..8afec993a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002a.ada
@@ -0,0 +1,104 @@
+-- C66002A.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 OVERLOADED SUBPROGRAM DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (A) ONE SUBPROGRAM IS A FUNCTION; THE OTHER IS A PROCEDURE.
+
+-- CVP 5/4/81
+-- JRK 5/8/81
+-- NL 10/13/81
+-- SPS 11/2/82
+
+WITH REPORT;
+PROCEDURE C66002A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C66002A", "SUBPROGRAM OVERLOADING WITH " &
+           "MINIMAL DIFFERENCES ALLOWED");
+
+     --------------------------------------------------
+
+     -- ONE SUBPROGRAM IS A PROCEDURE; THE OTHER IS
+     -- A FUNCTION. BOTH PARAMETERIZED AND PARAMETERLESS
+     -- SUBPROGRAMS ARE TESTED.
+
+     DECLARE
+          I, J, K : INTEGER := 0;
+          S : STRING (1..2) := "12";
+
+          PROCEDURE P1 (I1, I2 : INTEGER) IS
+          BEGIN
+               S(1) := 'A';
+          END P1;
+
+          FUNCTION P1 (I1, I2 : INTEGER) RETURN INTEGER IS
+          BEGIN
+               S(2) := 'B';
+               RETURN I1; -- RETURNED VALUE IS IRRELEVENT.
+          END P1;
+
+          PROCEDURE P2 IS
+          BEGIN
+               S(1) := 'C';
+          END P2;
+
+          FUNCTION P2 RETURN INTEGER IS
+          BEGIN
+               S(2) := 'D';
+               RETURN I; -- RETURNED VALUE IS IRRELEVENT.
+          END P2;
+
+     BEGIN
+          P1 (I, J);
+          K := P1 (I, J);
+
+          IF S /= "AB" THEN
+               FAILED ("PARAMETERIZED OVERLOADED " &
+                       "SUBPROGRAMS, ONE A PROCEDURE AND " &
+                       "THE OTHER A FUNCTION, CAUSED " &
+                       "CONFUSION");
+          END IF;
+
+          S := "12";
+          P2;
+          K := P2 ;
+
+          IF S /= "CD" THEN 
+               FAILED ("PARAMETERLESS OVERLOADED " &
+                       "SUBPROGRAMS, ONE A PROCEDURE AND " &
+                       "THE OTHER A FUNCTION, CAUSED " &
+                       "CONFUSION");
+          END IF;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C66002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002c.ada
new file mode 100644
index 000000000..d646f0603
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002c.ada
@@ -0,0 +1,102 @@
+-- C66002C.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 OVERLOADED SUBPROGRAM DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (C) ONE SUBPROGRAM HAS ONE LESS PARAMETER THAN THE OTHER.
+
+-- CVP 5/4/81
+-- JRK 5/8/81
+-- NL 10/13/81
+
+WITH REPORT;
+PROCEDURE C66002C IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C66002C", "SUBPROGRAM OVERLOADING WITH " &
+           "MINIMAL DIFFERENCES ALLOWED");
+
+     --------------------------------------------------
+
+     -- ONE PROCEDURE HAS ONE MORE PARAMETER
+     -- THAN THE OTHER.  THIS IS TESTED IN THE
+     -- CASE IN WHICH THAT PARAMETER HAS A DEFAULT
+     -- VALUE, AND THE CASE IN WHICH IT DOES NOT.
+
+     DECLARE
+          I, J : INTEGER := 0;
+          B : BOOLEAN := TRUE;
+          S : STRING (1..2) := "12";
+
+          PROCEDURE P1 (I1, I2 : INTEGER; B1 : IN OUT BOOLEAN) IS
+          BEGIN
+               S(1) := 'A';
+          END P1;
+
+          PROCEDURE P1 (I1, I2 : INTEGER) IS
+          BEGIN
+               S(2) := 'B';
+          END P1;
+
+          PROCEDURE P2 (B1 : IN OUT BOOLEAN; I1 : INTEGER := 0) IS
+          BEGIN
+               S(1) := 'C';
+          END P2;
+
+          PROCEDURE P2 (B1 : IN OUT BOOLEAN) IS
+          BEGIN
+               S(2) := 'D';
+          END P2;
+
+     BEGIN
+          P1 (I, J, B);
+          P1 (I, J);
+
+          IF S /= "AB" THEN
+               FAILED ("PROCEDURES DIFFERING ONLY IN " &
+                       "NUMBER OF PARAMETERS (NO DEFAULTS) " &
+                       "CAUSED CONFUSION");
+          END IF;
+
+          S := "12";
+          P2 (B, I);
+          -- NOTE THAT A CALL TO P2 WITH ONLY
+          -- ONE PARAMETER IS AMBIGUOUS.
+
+          IF S /= "C2" THEN
+               FAILED ("PROCEDURES DIFFERING ONLY IN " &
+                       "EXISTENCE OF ONE PARAMETER (WITH " &
+                       "DEFAULT) CAUSED CONFUSION");
+          END IF;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C66002C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002d.ada
new file mode 100644
index 000000000..fe4209894
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002d.ada
@@ -0,0 +1,85 @@
+-- C66002D.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 OVERLOADED SUBPROGRAM DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (D) THE BASE TYPE OF A PARAMETER IS DIFFERENT FROM THAT
+--         OF THE CORRESPONDING ONE.
+
+-- CVP 5/4/81
+-- JRK 5/8/81
+-- NL 10/13/81
+
+WITH REPORT;
+PROCEDURE C66002D IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C66002D", "SUBPROGRAM OVERLOADING WITH " &
+           "MINIMAL DIFFERENCES ALLOWED");
+
+     --------------------------------------------------
+
+     -- THE BASE TYPE OF ONE PARAMETER IS
+     -- DIFFERENT FROM THAT OF THE CORRESPONDING
+     -- ONE.
+
+     DECLARE
+          I, J, K : INTEGER := 0;
+          B : BOOLEAN;
+          S : STRING (1..2) := "12";
+
+          PROCEDURE P (I1 : INTEGER; BI : OUT BOOLEAN;
+                       I2 : IN OUT INTEGER) IS
+          BEGIN
+               S(1) := 'A';
+               BI := TRUE; -- THIS VALUE IS IRRELEVENT.
+          END P;
+
+          PROCEDURE P (I1 : INTEGER; BI : OUT INTEGER;
+               I2 : IN OUT INTEGER) IS
+          BEGIN
+               S(2) := 'B';
+               BI := 0; -- THIS VALUE IS IRRELEVENT.
+          END P;
+
+     BEGIN
+          P (I, B, K);
+          P (I, J, K);
+
+          IF S /= "AB" THEN
+               FAILED ("PROCEDURES DIFFERING ONLY BY " &
+                       "THE BASE TYPE OF A PARAMETER " &
+                       "CAUSED CONFUSION");
+          END IF;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C66002D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002e.ada
new file mode 100644
index 000000000..d2b509639
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002e.ada
@@ -0,0 +1,91 @@
+-- C66002E.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 OVERLOADED SUBPROGRAM DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (E) ONE SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE
+--         PART, THE OTHER IN AN INNER PART, AND THE PARAMETERS ARE 
+--         ORDERED DIFFERENTLY.
+
+-- CVP 5/4/81
+-- JRK 5/8/81
+-- NL 10/13/81
+
+WITH REPORT;
+PROCEDURE C66002E IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C66002E", "SUBPROGRAM OVERLOADING WITH " &
+           "MINIMAL DIFFERENCES ALLOWED");
+
+     --------------------------------------------------
+
+     -- ONE SUBPROGRAM IS DECLARED IN AN OUTER
+     -- DECLARATIVE PART, THE OTHER IN AN INNER
+     -- PART, AND THE PARAMETERS ARE ORDERED
+     -- DIFFERENTLY.
+
+     DECLARE
+          S : STRING (1..2) := "12";
+
+          PROCEDURE P (I1 : INTEGER; I2 : IN OUT INTEGER;
+                       B1 : BOOLEAN) IS
+          BEGIN
+               S(1) := 'A';
+          END P;
+
+     BEGIN
+          DECLARE
+               I : INTEGER := 0;
+
+               PROCEDURE P (B1 : BOOLEAN; I1 : INTEGER;
+                            I2 : IN OUT INTEGER) IS
+               BEGIN
+                    S(2) := 'B';
+               END P;
+
+          BEGIN
+               P (5, I, TRUE);
+               P (TRUE, 5, I);
+               -- NOTE THAT A CALL IN WHICH ALL ACTUAL PARAMETERS 
+               -- ARE NAMED_ASSOCIATIONS IS AMBIGUOUS.
+
+               IF S /= "AB" THEN
+                    FAILED ("PROCEDURES IN " &
+                            "ENCLOSING-ENCLOSED SCOPES " &
+                            "DIFFERING ONLY IN PARAMETER " &
+                            "TYPE ORDER CAUSED CONFUSION");
+               END IF;
+          END;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C66002E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002f.ada
new file mode 100644
index 000000000..a62897786
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002f.ada
@@ -0,0 +1,92 @@
+-- C66002F.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 OVERLOADED SUBPROGRAM DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (F) ONE SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE PART,
+--         THE OTHER IN AN INNER PART, AND ONE HAS ONE MORE PARAMETER
+--         THAN THE OTHER; THE OMITTED PARAMETER HAS A DEFAULT VALUE.
+
+-- CVP 5/4/81
+-- JRK 5/8/81
+-- NL 10/13/81
+
+WITH REPORT;
+PROCEDURE C66002F IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C66002F", "SUBPROGRAM OVERLOADING WITH " &
+           "MINIMAL DIFFERENCES ALLOWED");
+
+     --------------------------------------------------
+
+     -- ONE SUBPROGRAM IS IN AN OUTER DECLARATIVE 
+     -- PART, THE OTHER IN AN INNER PART, AND ONE
+     -- HAS ONE MORE PARAMETER (WITH A DEFAULT
+     -- VALUE) THAN THE OTHER.
+
+     BF : 
+     DECLARE
+          S : STRING (1..3) := "123";
+
+          PROCEDURE P (I1, I2, I3 : INTEGER := 1) IS
+               C : CONSTANT STRING := "CXA";
+          BEGIN
+               S(I3) := C(I3);
+          END P;
+
+          PROCEDURE ENCLOSE IS
+ 
+               PROCEDURE P (I1, I2 : INTEGER := 1) IS
+               BEGIN
+                    S(2) := 'B';
+               END P;
+
+          BEGIN -- ENCLOSE
+               P (1, 2, 3);
+               ENCLOSE.P (1, 2); -- NOTE THAT THESE CALLS
+               BF.P (1, 2);      -- MUST BE DISAMBIGUATED.
+
+               IF S /= "CBA" THEN
+                    FAILED ("PROCEDURES IN ENCLOSING-" &
+                            "ENCLOSED SCOPES DIFFERING " &
+                            "ONLY IN EXISTENCE OF ONE " &
+                            "DEFAULT-VALUED PARAMETER CAUSED " &
+                            "CONFUSION");
+               END IF;
+          END ENCLOSE;
+
+     BEGIN
+          ENCLOSE;
+     END BF;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C66002F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002g.ada
new file mode 100644
index 000000000..06c6ea33d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c66002g.ada
@@ -0,0 +1,82 @@
+-- C66002G.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 OVERLOADED SUBPROGRAM DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (G) THE RESULT TYPE OF TWO FUNCTION DECLARATIONS IS DIFFERENT.
+
+-- CVP 5/4/81
+-- JRK 5/8/81
+-- NL 10/13/81
+-- SPS 10/26/82
+
+WITH REPORT;
+PROCEDURE C66002G IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C66002G", "SUBPROGRAM OVERLOADING WITH " &
+           "MINIMAL DIFFERENCES ALLOWED");
+
+     --------------------------------------------------
+
+     -- THE RESULT TYPES OF TWO FUNCTION
+     -- DECLARATIONS ARE DIFFERENT.
+
+     DECLARE
+          I : INTEGER;
+          B : BOOLEAN;
+          S : STRING (1..2) := "12";
+
+          FUNCTION F RETURN INTEGER IS
+          BEGIN
+               S(1) := 'A';
+               RETURN IDENT_INT (0); -- THIS VALUE IS IRRELEVENT.
+          END F;
+
+          FUNCTION F RETURN BOOLEAN IS
+          BEGIN
+               S(2) := 'B';
+               RETURN IDENT_BOOL (TRUE); -- THIS VALUE IS IRRELEVANT.
+          END F;
+
+     BEGIN
+          I := F;
+          B := F;
+
+          IF S /= "AB" THEN
+               FAILED ("FUNCTIONS DIFFERING ONLY IN " &
+                       "BASE TYPE OF RETURNED VALUE " &
+                       "CAUSED CONFUSION");
+          END IF;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C66002G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002a.ada
new file mode 100644
index 000000000..da295994e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002a.ada
@@ -0,0 +1,426 @@
+-- C67002A.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 OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
+--   FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
+--   SUBTESTS ARE:
+--        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
+--             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
+--             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
+--        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
+--             WITH ONE PARAMETER.
+
+-- CVP 5/7/81
+-- JRK 6/1/81
+-- CPP 6/25/84
+
+WITH REPORT;
+PROCEDURE C67002A IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C67002A", "USE OF OPERATOR SYMBOLS IN " &
+           "(OVERLOADED) FUNCTION SPECIFICATIONS");
+
+     -------------------------------------------------
+
+     DECLARE -- (A)
+          PACKAGE EQU IS
+               TYPE  LP IS LIMITED PRIVATE;
+               FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
+          PRIVATE
+               TYPE LP IS NEW INTEGER;
+          END EQU;
+          USE EQU;
+
+          LP1, LP2 : LP;
+
+          PACKAGE BODY EQU IS
+               FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN LPA > LPB;
+               END "=";
+          BEGIN
+               LP1 := LP (IDENT_INT (7));
+               LP2 := LP (IDENT_INT (8));
+          END EQU;
+
+     BEGIN -- (A)
+          IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
+             (LP1 = LP1) OR (LP2 /= LP1) THEN
+               FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (A)
+
+     -------------------------------------------------
+
+     DECLARE -- (B)
+          FUNCTION "AND" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "AND";
+
+     BEGIN -- (B)
+          IF (IDENT_INT (10) AND 1) /= 'G' OR
+             (5 AND 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (B)
+
+     -------------------------------------------------
+
+     DECLARE -- (C)
+          FUNCTION "OR" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "OR";
+
+     BEGIN -- (C)
+          IF (IDENT_INT (10) OR 1) /= 'G' OR
+             (5 OR 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (C)
+
+     -------------------------------------------------
+
+     DECLARE -- (D)
+          FUNCTION "XOR" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "XOR";
+
+     BEGIN -- (D)
+          IF (IDENT_INT (10) XOR 1) /= 'G' OR
+             (5 XOR 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (D)
+
+     -------------------------------------------------
+
+     DECLARE -- (E)
+          FUNCTION "<" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "<";
+
+     BEGIN -- (E)
+          IF (IDENT_INT (10) < 1) /= 'G' OR
+             (5 < 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (E)
+
+     -------------------------------------------------
+
+     DECLARE -- (F)
+          FUNCTION "<=" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "<=";
+
+     BEGIN -- (F)
+          IF (IDENT_INT (10) <= 1) /= 'G' OR
+             (5 <= 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (F)
+
+     -------------------------------------------------
+
+     DECLARE -- (G)
+          FUNCTION ">" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END ">";
+
+     BEGIN -- (G)
+          IF (IDENT_INT (10) > 1) /= 'G' OR
+             (5 > 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (G)
+
+     -------------------------------------------------
+
+     DECLARE -- (H)
+          FUNCTION ">=" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END ">=";
+
+     BEGIN -- (H)
+          IF (IDENT_INT (10) >= 1) /= 'G' OR
+             (5 >= 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (H)
+
+     -------------------------------------------------
+
+     DECLARE -- (I)
+          FUNCTION "&" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "&";
+
+     BEGIN -- (I)
+          IF (IDENT_INT (10) & 1) /= 'G' OR
+             (5 & 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (I)
+
+     -------------------------------------------------
+
+     DECLARE -- (J)
+          FUNCTION "*" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "*";
+
+     BEGIN -- (J)
+          IF (IDENT_INT (10) * 1) /= 'G' OR
+             (5 * 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (J)
+
+     -------------------------------------------------
+
+     DECLARE -- (K)
+          FUNCTION "/" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "/";
+
+     BEGIN -- (K)
+          IF (IDENT_INT (10) / 1) /= 'G' OR
+             (5 / 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (K)
+
+     -------------------------------------------------
+
+     DECLARE -- (L)
+          FUNCTION "MOD" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "MOD";
+
+     BEGIN -- (L)
+          IF (IDENT_INT (10) MOD 1) /= 'G' OR
+             (5 MOD 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (L)
+
+     -------------------------------------------------
+
+     DECLARE -- (M)
+          FUNCTION "REM" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "REM";
+
+     BEGIN -- (M)
+          IF (IDENT_INT (10) REM 1) /= 'G' OR
+             (5 REM 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (M)
+
+     -------------------------------------------------
+
+     DECLARE -- (N)
+          FUNCTION "**" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "**";
+
+     BEGIN -- (N)
+          IF (IDENT_INT (10) ** 1) /= 'G' OR
+             (5 ** 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (N)
+
+     -------------------------------------------------
+
+     DECLARE -- (O)
+          FUNCTION "+" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "+";
+
+     BEGIN -- (O)
+          IF (IDENT_INT (10) + 1) /= 'G' OR
+             (5 + 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (O)
+
+     -------------------------------------------------
+
+     DECLARE -- (P)
+          FUNCTION "-" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "-";
+
+     BEGIN -- (P)
+          IF (IDENT_INT (10) - 1) /= 'G' OR
+             (5 - 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (P)
+
+     -------------------------------------------------
+
+     DECLARE -- (Q)
+          FUNCTION "+" (I1 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 < IDENT_INT (0) THEN
+                    RETURN 'N';
+               ELSE RETURN 'P';
+               END IF;
+          END "+";
+
+     BEGIN -- (Q)
+          IF (+ IDENT_INT(25) /= 'P') OR
+             (+ (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""+"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (Q)
+
+     -------------------------------------------------
+
+     DECLARE -- (R)
+          FUNCTION "-" (I1 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 < IDENT_INT (0) THEN
+                    RETURN 'N';
+               ELSE RETURN 'P';
+               END IF;
+          END "-";
+
+     BEGIN -- (R)
+          IF (- IDENT_INT(25) /= 'P') OR
+             (- (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""-"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (R)
+
+     -------------------------------------------------
+
+     DECLARE -- (S)
+          FUNCTION "NOT" (I1 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 < IDENT_INT (0) THEN
+                    RETURN 'N';
+               ELSE RETURN 'P';
+               END IF;
+          END "NOT";
+
+     BEGIN -- (S)
+          IF (NOT IDENT_INT(25) /= 'P') OR
+             (NOT (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""NOT"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (S)
+
+     -------------------------------------------------
+
+     DECLARE -- (T)
+          FUNCTION "ABS" (I1 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 < IDENT_INT (0) THEN
+                    RETURN 'N';
+               ELSE RETURN 'P';
+               END IF;
+          END "ABS";
+
+     BEGIN -- (T)
+          IF (ABS IDENT_INT(25) /= 'P') OR
+             (ABS (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""ABS"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (T)
+
+     -------------------------------------------------
+
+     RESULT;
+END C67002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002b.ada
new file mode 100644
index 000000000..d716fb33e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002b.ada
@@ -0,0 +1,176 @@
+-- C67002B.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 OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
+--   FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
+--   THIS TEST CHECKS THE CASE OF CERTAIN OPERATOR SYMBOLS.
+--   SUBTESTS ARE:
+--        (A) THROUGH (E): "AND", "OR", "XOR", "MOD", "REM"
+--            RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
+--        (F) AND (G): "NOT" AND "ABS", RESPECTIVELY,
+--             WITH ONE PARAMETER.
+
+-- CPP 6/26/84
+
+WITH REPORT;
+PROCEDURE C67002B IS
+
+     USE REPORT;
+
+BEGIN
+     TEST ("C67002B", "USE OF OPERATOR SYMBOLS IN " &
+           "(OVERLOADED) FUNCTION SPECIFICATIONS");
+
+     -------------------------------------------------
+
+     DECLARE -- (A)
+          FUNCTION "And" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "And";
+
+     BEGIN -- (A)
+          IF (IDENT_INT (10) AND 1) /= 'G' OR
+             (5 AnD 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""And"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (A)
+
+     -------------------------------------------------
+
+     DECLARE -- (B)
+          FUNCTION "or" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "or";
+
+     BEGIN -- (B)
+          IF (IDENT_INT (10) Or 1) /= 'G' OR
+             (5 OR 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""or"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (B)
+
+     -------------------------------------------------
+
+     DECLARE -- (C)
+          FUNCTION "xOR" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "xOR";
+
+     BEGIN -- (C)
+          IF (IDENT_INT (10) XoR 1) /= 'G' OR
+             (5 xOR 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""xOR"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (C)
+
+     -------------------------------------------------
+
+     DECLARE -- (D)
+          FUNCTION "mOd" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "mOd";
+
+     BEGIN -- (D)
+          IF (IDENT_INT (10) MoD 1) /= 'G' OR
+             (5 moD 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""mOd"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (D)
+
+     -------------------------------------------------
+
+     DECLARE -- (E)
+          FUNCTION "REM" (I1, I2 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 > I2 THEN
+                    RETURN 'G';
+               ELSE RETURN 'L';
+               END IF;
+          END "REM";
+
+     BEGIN -- (E)
+          IF (IDENT_INT (10) rem 1) /= 'G' OR
+             (5 Rem 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (E)
+
+     -------------------------------------------------
+
+     DECLARE -- (F)
+          FUNCTION "NOT" (I1 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 < IDENT_INT (0) THEN
+                    RETURN 'N';
+               ELSE RETURN 'P';
+               END IF;
+          END "NOT";
+
+     BEGIN -- (F)
+          IF (Not IDENT_INT(25) /= 'P') OR
+             (noT (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""NOT"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (F)
+
+     -------------------------------------------------
+
+     DECLARE -- (G)
+          FUNCTION "ABS" (I1 : INTEGER) RETURN CHARACTER IS
+          BEGIN
+               IF I1 < IDENT_INT (0) THEN
+                    RETURN 'N';
+               ELSE RETURN 'P';
+               END IF;
+          END "ABS";
+
+     BEGIN -- (G)
+          IF (abs IDENT_INT(25) /= 'P') OR
+             (Abs (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""ABS"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (T)
+
+     -------------------------------------------------
+
+     RESULT;
+END C67002B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002c.ada
new file mode 100644
index 000000000..4a40231c7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002c.ada
@@ -0,0 +1,548 @@
+-- C67002C.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 OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
+-- FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
+-- THIS TEST CHECKS FORMAL SUBPROGRAM PARAMETERS.
+--   SUBTESTS ARE:
+--        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
+--             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
+--             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
+--        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
+--             WITH ONE PARAMETER.
+
+-- CPP 6/26/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C67002C IS
+
+     FUNCTION TWO_PARAMS (I1, I2 : INTEGER) RETURN CHARACTER IS
+     BEGIN
+          IF I1 > I2 THEN
+               RETURN 'G';
+          ELSE RETURN 'L';
+          END IF;
+     END TWO_PARAMS;
+
+     FUNCTION ONE_PARAM (I1 : INTEGER) RETURN CHARACTER IS
+     BEGIN
+          IF I1 < IDENT_INT(0) THEN
+               RETURN 'N';
+          ELSE RETURN 'P';
+          END IF;
+     END ONE_PARAM;
+
+BEGIN
+     TEST ("C67002C", "USE OF OPERATOR SYMBOLS IN " &
+           "(OVERLOADED) FUNCTION SPECIFICATIONS");
+
+     -------------------------------------------------
+
+     DECLARE -- (A)
+
+          PACKAGE EQU IS
+               TYPE  LP IS LIMITED PRIVATE;
+               FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
+          PRIVATE
+               TYPE LP IS NEW INTEGER;
+          END EQU;
+          USE EQU;
+
+          LP1, LP2 : LP;
+
+          PACKAGE BODY EQU IS
+               FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN LPA > LPB;
+               END "=";
+          BEGIN
+               LP1 := LP (IDENT_INT (7));
+               LP2 := LP (IDENT_INT (8));
+          END EQU;
+
+          GENERIC
+               WITH FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
+                  (LP1 = LP1) OR (LP2 /= LP1) THEN
+                    FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE EQUAL IS NEW PKG ("=" => EQU."=");
+
+     BEGIN -- (A)
+          NULL;
+     END; -- (A)
+
+     -------------------------------------------------
+
+     DECLARE -- (B)
+
+          GENERIC
+               WITH FUNCTION "AND" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) AND 1) /= 'G' OR
+                  (5 AND 10) /= 'L' THEN
+                   FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("AND" => TWO_PARAMS);
+
+     BEGIN -- (B)
+          NULL;
+     END; -- (B)
+
+     -------------------------------------------------
+
+     DECLARE -- (C)
+
+          GENERIC
+               WITH FUNCTION "OR" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) OR 1) /= 'G' OR
+                  (5 OR 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("OR" => TWO_PARAMS);
+
+     BEGIN -- (C)
+          NULL;
+     END; -- (C)
+
+     -------------------------------------------------
+
+     DECLARE -- (D)
+
+          GENERIC
+               WITH FUNCTION "XOR" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) XOR 1) /= 'G' OR
+                  (5 XOR 10) /= 'L' THEN
+                   FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("XOR" => TWO_PARAMS);
+
+     BEGIN -- (D)
+          NULL;
+     END; -- (D)
+
+     -------------------------------------------------
+
+     DECLARE -- (E)
+
+          GENERIC
+               WITH FUNCTION "<" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) < 1) /= 'G' OR
+                  (5 < 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("<" => TWO_PARAMS);
+
+     BEGIN -- (E)
+          NULL;
+     END; -- (E)
+
+     -------------------------------------------------
+
+     DECLARE -- (F)
+
+          GENERIC
+               WITH FUNCTION "<=" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) <= 1) /= 'G' OR
+                  (5 <= 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("<=" => TWO_PARAMS);
+
+     BEGIN -- (F)
+          NULL;
+     END; -- (F)
+
+     -------------------------------------------------
+
+     DECLARE -- (G)
+
+          GENERIC
+               WITH FUNCTION ">" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) > 1) /= 'G' OR
+                  (5 > 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG (">" => TWO_PARAMS);
+
+     BEGIN -- (G)
+          NULL;
+     END; -- (G)
+
+     -------------------------------------------------
+
+     DECLARE -- (H)
+
+          GENERIC
+               WITH FUNCTION ">=" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) >= 1) /= 'G' OR
+                  (5 >= 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG (">=" => TWO_PARAMS);
+
+     BEGIN -- (H)
+          NULL;
+     END; -- (H)
+
+     -------------------------------------------------
+
+     DECLARE -- (I)
+
+          GENERIC
+               WITH FUNCTION "&" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) & 1) /= 'G' OR
+                  (5 & 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("&" => TWO_PARAMS);
+
+     BEGIN -- (I)
+          NULL;
+     END; -- (I)
+
+     -------------------------------------------------
+
+     DECLARE -- (J)
+
+          GENERIC
+               WITH FUNCTION "*" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) * 1) /= 'G' OR
+                  (5 * 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("*" => TWO_PARAMS);
+
+     BEGIN -- (J)
+          NULL;
+     END; -- (J)
+
+     -------------------------------------------------
+
+     DECLARE -- (K)
+
+          GENERIC
+               WITH FUNCTION "/" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) / 1) /= 'G' OR
+                  (5 / 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("/" => TWO_PARAMS);
+
+     BEGIN -- (K)
+          NULL;
+     END; -- (K)
+
+     -------------------------------------------------
+
+     DECLARE -- (L)
+
+          GENERIC
+               WITH FUNCTION "MOD" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) MOD 1) /= 'G' OR
+                  (5 MOD 10) /= 'L' THEN
+                   FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("MOD" => TWO_PARAMS);
+
+     BEGIN -- (L)
+          NULL;
+     END; -- (L)
+
+     -------------------------------------------------
+
+     DECLARE -- (M)
+
+          GENERIC
+               WITH FUNCTION "REM" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) REM 1) /= 'G' OR
+                  (5 REM 10) /= 'L' THEN
+                   FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("REM" => TWO_PARAMS);
+
+     BEGIN -- (M)
+          NULL;
+     END; -- (M)
+
+     -------------------------------------------------
+
+     DECLARE -- (N)
+
+          GENERIC
+               WITH FUNCTION "**" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) ** 1) /= 'G' OR
+                  (5 ** 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("**" => TWO_PARAMS);
+
+     BEGIN -- (N)
+          NULL;
+     END; -- (N)
+
+     -------------------------------------------------
+
+     DECLARE -- (O)
+
+          GENERIC
+               WITH FUNCTION "+" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) + 1) /= 'G' OR
+                  (5 + 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("+" => TWO_PARAMS);
+
+     BEGIN -- (O)
+          NULL;
+     END; -- (O)
+
+     -------------------------------------------------
+
+     DECLARE -- (P)
+
+          GENERIC
+               WITH FUNCTION "-" (I1, I2 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (IDENT_INT (10) - 1) /= 'G' OR
+                  (5 - 10) /= 'L' THEN
+                    FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("-" => TWO_PARAMS);
+
+     BEGIN -- (P)
+          NULL;
+     END; -- (P)
+
+     -------------------------------------------------
+
+     DECLARE -- (Q)
+
+          GENERIC
+               WITH FUNCTION "+" (I1 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (+ IDENT_INT(25) /= 'P') OR
+                  (+ (0-25) /= 'N') THEN
+                    FAILED ("OVERLOADING OF ""+"" " &
+                            "OPERATOR (ONE OPERAND) DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("+" => ONE_PARAM);
+
+     BEGIN -- (Q)
+          NULL;
+     END; -- (Q)
+
+     -------------------------------------------------
+
+     DECLARE -- (R)
+
+          GENERIC
+               WITH FUNCTION "-" (I1 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (- IDENT_INT(25) /= 'P') OR
+                  (- (0-25) /= 'N') THEN
+                    FAILED ("OVERLOADING OF ""-"" " &
+                            "OPERATOR (ONE OPERAND) DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("-" => ONE_PARAM);
+
+     BEGIN -- (R)
+          NULL;
+     END; -- (R)
+
+     -------------------------------------------------
+
+     DECLARE -- (S)
+
+          GENERIC
+               WITH FUNCTION "NOT" (I1 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (NOT IDENT_INT(25) /= 'P') OR
+                  (NOT (0-25) /= 'N') THEN
+                    FAILED ("OVERLOADING OF ""NOT"" " &
+                            "OPERATOR (ONE OPERAND) DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("NOT" => ONE_PARAM);
+
+     BEGIN -- (S)
+          NULL;
+     END; -- (S)
+
+     -------------------------------------------------
+
+     DECLARE -- (T)
+
+          GENERIC
+               WITH FUNCTION "ABS" (I1 : INTEGER) RETURN CHARACTER;
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF (ABS IDENT_INT(25) /= 'P') OR
+                  (ABS (0-25) /= 'N') THEN
+                    FAILED ("OVERLOADING OF ""ABS"" " &
+                            "OPERATOR (ONE OPERAND) DEFECTIVE");
+               END IF;
+          END PKG;
+
+          PACKAGE PACK IS NEW PKG ("ABS" => ONE_PARAM);
+
+     BEGIN -- (T)
+          NULL;
+     END; -- (T)
+
+     -------------------------------------------------
+
+     RESULT;
+END C67002C;
+  
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002d.ada
new file mode 100644
index 000000000..3d829802f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002d.ada
@@ -0,0 +1,354 @@
+-- C67002D.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 OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
+-- FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
+-- THIS TEST CHECKS GENERIC INSTANTIATIONS FOR THESE FUNCTIONS.
+--   SUBTESTS ARE:
+--        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
+--             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
+--             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
+--        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
+--             WITH ONE PARAMETER.
+
+-- CPP 6/25/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C67002D IS
+
+     GENERIC
+          TYPE ELEMENT IS (<>);
+     FUNCTION TWO_PARAMS (I1, I2 : ELEMENT) RETURN CHARACTER;
+     FUNCTION TWO_PARAMS (I1, I2 : ELEMENT) RETURN CHARACTER IS
+     BEGIN
+          IF I1 > I2 THEN
+               RETURN 'G';
+          ELSE RETURN 'L';
+          END IF;
+     END TWO_PARAMS;
+
+     GENERIC
+          TYPE ELEMENT IS (<>);
+     FUNCTION ONE_PARAM (I1 : ELEMENT) RETURN CHARACTER;
+     FUNCTION ONE_PARAM (I1 : ELEMENT) RETURN CHARACTER IS
+     BEGIN
+          IF I1 < ELEMENT'VAL(IDENT_INT(0)) THEN
+               RETURN 'N';
+          ELSE RETURN 'P';
+          END IF;
+     END ONE_PARAM;
+     
+BEGIN
+     TEST ("C67002D", "USE OF OPERATOR SYMBOLS IN " &
+           "(OVERLOADED) FUNCTION SPECIFICATIONS");
+
+     -------------------------------------------------
+
+     DECLARE -- (A)
+          GENERIC
+               TYPE LP IS LIMITED PRIVATE;
+               WITH FUNCTION ">" (L, R : LP) RETURN BOOLEAN IS <>;
+          PACKAGE PKG IS
+               LP1, LP2 : LP;
+               FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
+          END PKG;
+
+          PACKAGE BODY PKG IS
+               FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN LPA > LPB;
+               END "=";
+          END PKG;
+
+     BEGIN -- (A)
+          DECLARE
+               PACKAGE PACK IS NEW PKG (LP => INTEGER);
+               USE PACK;
+               FUNCTION "=" (L, R : INTEGER) RETURN BOOLEAN
+                    RENAMES PACK."=";
+          BEGIN
+               LP1 := IDENT_INT(7);
+               LP2 := IDENT_INT(8);
+               IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
+                  (LP1 = LP1) OR (LP2 /= LP1) THEN
+                    FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
+               END IF;
+          END;
+     END; -- (A)
+
+     -------------------------------------------------
+
+     DECLARE -- (B)
+          FUNCTION "AND" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (B)
+          IF (IDENT_INT (10) AND 1) /= 'G' OR
+             (5 AND 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (B)
+
+     -------------------------------------------------
+
+     DECLARE -- (C)
+          FUNCTION "OR" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (C)
+          IF (IDENT_INT (10) OR 1) /= 'G' OR
+             (5 OR 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (C)
+
+     -------------------------------------------------
+
+     DECLARE -- (D)
+          FUNCTION "XOR" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (D)
+          IF (IDENT_INT (10) XOR 1) /= 'G' OR
+             (5 XOR 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (D)
+
+     -------------------------------------------------
+
+     DECLARE -- (E)
+          FUNCTION "<" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (E)
+          IF (IDENT_INT (10) < 1) /= 'G' OR
+             (5 < 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (E)
+
+     -------------------------------------------------
+
+     DECLARE -- (F)
+          FUNCTION "<=" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (F)
+          IF (IDENT_INT (10) <= 1) /= 'G' OR
+             (5 <= 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (F)
+
+     -------------------------------------------------
+
+     DECLARE -- (G)
+          FUNCTION ">" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (G)
+          IF (IDENT_INT (10) > 1) /= 'G' OR
+             (5 > 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (G)
+
+     -------------------------------------------------
+
+     DECLARE -- (H)
+          FUNCTION ">=" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (H)
+          IF (IDENT_INT (10) >= 1) /= 'G' OR
+             (5 >= 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (H)
+
+     -------------------------------------------------
+
+     DECLARE -- (I)
+          FUNCTION "&" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (I)
+          IF (IDENT_INT (10) & 1) /= 'G' OR
+             (5 & 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (I)
+
+     -------------------------------------------------
+
+     DECLARE -- (J)
+          FUNCTION "*" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (J)
+          IF (IDENT_INT (10) * 1) /= 'G' OR
+             (5 * 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (J)
+
+     -------------------------------------------------
+
+     DECLARE -- (K)
+          FUNCTION "/" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (K)
+          IF (IDENT_INT (10) / 1) /= 'G' OR
+             (5 / 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (K)
+
+     -------------------------------------------------
+
+     DECLARE -- (L)
+          FUNCTION "MOD" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (L)
+          IF (IDENT_INT (10) MOD 1) /= 'G' OR
+             (5 MOD 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (L)
+
+     -------------------------------------------------
+
+     DECLARE -- (M)
+          FUNCTION "REM" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (M)
+          IF (IDENT_INT (10) REM 1) /= 'G' OR
+             (5 REM 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (M)
+
+     -------------------------------------------------
+
+     DECLARE -- (N)
+          FUNCTION "**" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (N)
+          IF (IDENT_INT (10) ** 1) /= 'G' OR
+             (5 ** 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (N)
+
+     -------------------------------------------------
+
+     DECLARE -- (O)
+          FUNCTION "+" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (O)
+          IF (IDENT_INT (10) + 1) /= 'G' OR
+             (5 + 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (O)
+
+     -------------------------------------------------
+
+     DECLARE -- (P)
+          FUNCTION "-" IS NEW TWO_PARAMS
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (P)
+          IF (IDENT_INT (10) - 1) /= 'G' OR
+             (5 - 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (P)
+
+     -------------------------------------------------
+
+     DECLARE -- (Q)
+          FUNCTION "+" IS NEW ONE_PARAM
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (Q)
+          IF (+ IDENT_INT(25) /= 'P') OR
+             (+ (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""+"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (Q)
+
+     -------------------------------------------------
+
+     DECLARE -- (R)
+          FUNCTION "-" IS NEW ONE_PARAM
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (R)
+          IF (- IDENT_INT(25) /= 'P') OR
+             (- (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""-"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (R)
+
+     -------------------------------------------------
+
+     DECLARE -- (S)
+          FUNCTION "NOT" IS NEW ONE_PARAM
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (S)
+          IF (NOT IDENT_INT(25) /= 'P') OR
+             (NOT (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""NOT"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (S)
+
+     -------------------------------------------------
+
+     DECLARE -- (T)
+          FUNCTION "ABS" IS NEW ONE_PARAM
+               (ELEMENT => INTEGER);
+
+     BEGIN -- (T)
+          IF (ABS IDENT_INT(25) /= 'P') OR
+             (ABS (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""ABS"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (T)
+
+     -------------------------------------------------
+
+     RESULT;
+END C67002D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002e.ada
new file mode 100644
index 000000000..aa3695239
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67002e.ada
@@ -0,0 +1,348 @@
+-- C67002E.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 OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
+-- FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
+-- THIS TEST CHECKS RENAMING DECLARATIONS FOR THESE FUNCTIONS.
+--   SUBTESTS ARE:
+--        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
+--             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
+--             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
+--        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
+--             WITH ONE PARAMETER.
+
+-- CPP 6/26/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C67002E IS
+
+     FUNCTION TWO_PARAMS (I1, I2 : INTEGER) RETURN CHARACTER IS
+     BEGIN
+          IF I1 > I2 THEN
+               RETURN 'G';
+          ELSE RETURN 'L';
+          END IF;
+     END TWO_PARAMS;
+
+     FUNCTION ONE_PARAM (I1 : INTEGER) RETURN CHARACTER IS
+     BEGIN
+          IF I1 < IDENT_INT(0) THEN
+               RETURN 'N';
+          ELSE RETURN 'P';
+          END IF;
+     END ONE_PARAM;
+
+BEGIN
+     TEST ("C67002E", "USE OF OPERATOR SYMBOLS IN " &
+           "(OVERLOADED) FUNCTION SPECIFICATIONS");
+
+     -------------------------------------------------
+
+     DECLARE -- (A)
+
+          PACKAGE PKG IS
+               TYPE LP IS LIMITED PRIVATE;
+               FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
+          PRIVATE
+               TYPE LP IS NEW INTEGER;
+          END PKG;
+          USE PKG;
+
+          LP1, LP2 : LP;
+
+          FUNCTION "=" (LPA, LPB : LP)
+               RETURN BOOLEAN RENAMES PKG."=";
+
+          PACKAGE BODY PKG IS
+               FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN LPA > LPB;
+               END "=";
+          BEGIN
+               LP1 := LP (IDENT_INT (7));
+               LP2 := LP (IDENT_INT (8));
+          END PKG;
+
+     BEGIN -- (A)
+          IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
+             (LP1 = LP1) OR (LP2 /= LP1) THEN
+               FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (A)
+
+     -------------------------------------------------
+
+     DECLARE -- (B)
+          FUNCTION "AND" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (B)
+          IF (IDENT_INT (10) AND 1) /= 'G' OR
+             (5 AND 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (B)
+
+     -------------------------------------------------
+
+     DECLARE -- (C)
+          FUNCTION "OR" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (C)
+          IF (IDENT_INT (10) OR 1) /= 'G' OR
+             (5 OR 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (C)
+
+     -------------------------------------------------
+
+     DECLARE -- (D)
+          FUNCTION "XOR" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (D)
+          IF (IDENT_INT (10) XOR 1) /= 'G' OR
+             (5 XOR 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (D)
+
+     -------------------------------------------------
+
+     DECLARE -- (E)
+          FUNCTION "<" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (E)
+          IF (IDENT_INT (10) < 1) /= 'G' OR
+             (5 < 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (E)
+
+     -------------------------------------------------
+
+     DECLARE -- (F)
+          FUNCTION "<=" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (F)
+          IF (IDENT_INT (10) <= 1) /= 'G' OR
+             (5 <= 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (F)
+
+     -------------------------------------------------
+
+     DECLARE -- (G)
+          FUNCTION ">" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (G)
+          IF (IDENT_INT (10) > 1) /= 'G' OR
+             (5 > 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (G)
+
+     -------------------------------------------------
+
+     DECLARE -- (H)
+          FUNCTION ">=" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (H)
+          IF (IDENT_INT (10) >= 1) /= 'G' OR
+             (5 >= 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (H)
+
+     -------------------------------------------------
+
+     DECLARE -- (I)
+          FUNCTION "&" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (I)
+          IF (IDENT_INT (10) & 1) /= 'G' OR
+             (5 & 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (I)
+
+     -------------------------------------------------
+
+     DECLARE -- (J)
+          FUNCTION "*" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (J)
+          IF (IDENT_INT (10) * 1) /= 'G' OR
+             (5 * 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (J)
+
+     -------------------------------------------------
+
+     DECLARE -- (K)
+          FUNCTION "/" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (K)
+          IF (IDENT_INT (10) / 1) /= 'G' OR
+             (5 / 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (K)
+
+     -------------------------------------------------
+
+     DECLARE -- (L)
+          FUNCTION "MOD" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (L)
+          IF (IDENT_INT (10) MOD 1) /= 'G' OR
+             (5 MOD 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (L)
+
+     -------------------------------------------------
+
+     DECLARE -- (M)
+          FUNCTION "REM" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (M)
+          IF (IDENT_INT (10) REM 1) /= 'G' OR
+             (5 REM 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (M)
+
+     -------------------------------------------------
+
+     DECLARE -- (N)
+          FUNCTION "**" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (N)
+          IF (IDENT_INT (10) ** 1) /= 'G' OR
+             (5 ** 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (N)
+
+     -------------------------------------------------
+
+     DECLARE -- (O)
+          FUNCTION "+" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (O)
+          IF (IDENT_INT (10) + 1) /= 'G' OR
+             (5 + 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (O)
+
+     -------------------------------------------------
+
+     DECLARE -- (P)
+          FUNCTION "-" (I1, I2 : INTEGER)
+               RETURN CHARACTER RENAMES TWO_PARAMS;
+
+     BEGIN -- (P)
+          IF (IDENT_INT (10) - 1) /= 'G' OR
+             (5 - 10) /= 'L' THEN
+               FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
+          END IF;
+     END; -- (P)
+
+     -------------------------------------------------
+
+     DECLARE -- (Q)
+          FUNCTION "+" (I1 : INTEGER)
+               RETURN CHARACTER RENAMES ONE_PARAM;
+
+     BEGIN -- (Q)
+          IF (+ IDENT_INT(25) /= 'P') OR
+             (+ (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""+"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (Q)
+
+     -------------------------------------------------
+
+     DECLARE -- (R)
+          FUNCTION "-" (I1 : INTEGER)
+               RETURN CHARACTER RENAMES ONE_PARAM;
+
+     BEGIN -- (R)
+          IF (- IDENT_INT(25) /= 'P') OR
+             (- (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""-"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (R)
+
+     -------------------------------------------------
+
+     DECLARE -- (S)
+          FUNCTION "NOT" (I1 : INTEGER)
+               RETURN CHARACTER RENAMES ONE_PARAM;
+
+     BEGIN -- (S)
+          IF (NOT IDENT_INT(25) /= 'P') OR
+             (NOT (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""NOT"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (S)
+
+     -------------------------------------------------
+
+     DECLARE -- (T)
+          FUNCTION "ABS" (I1 : INTEGER)
+               RETURN CHARACTER RENAMES ONE_PARAM;
+
+     BEGIN -- (T)
+          IF (ABS IDENT_INT(25) /= 'P') OR
+             (ABS (0-25) /= 'N') THEN
+               FAILED ("OVERLOADING OF ""ABS"" " &
+                       "OPERATOR (ONE OPERAND) DEFECTIVE");
+          END IF;
+     END; -- (T)
+
+     -------------------------------------------------
+
+     RESULT;
+END C67002E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67003f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67003f.ada
new file mode 100644
index 000000000..fde865c08
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67003f.ada
@@ -0,0 +1,319 @@
+-- C67003F.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 PREDEFINED OPERATORS FOR THE PREDEFINED TYPES CAN BE 
+--   REDEFINED.
+-- CHECK THAT THE REDEFINED OPERATOR IS INVOKED WHEN INFIX OR PREFIX
+--   NOTATION IS USED.
+
+-- HISTORY:
+--   WMC 03/21/92   TEST CREATED FROM CONSOLIDATION OF C67003[A-E].ADA
+
+
+WITH REPORT;
+
+PROCEDURE C67003F IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST ("C67003F", "CHECK THAT REDEFINITION OF " &
+           "OPERATORS FOR PREDEFINED TYPES WORKS");
+
+     DECLARE     -- INTEGER OPERATORS.
+
+          -- INTEGER INFIX OPERATORS.
+
+          FUNCTION "*" (X, Y : INTEGER) RETURN INTEGER IS
+          BEGIN
+               IF X /= Y THEN
+                    RETURN 1;
+               ELSE RETURN 0;
+               END IF;
+          END "*";
+
+          FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER IS
+          BEGIN
+               IF X /= Y THEN
+                    RETURN 2;
+               ELSE RETURN 0;
+               END IF;
+          END "+";
+     
+          FUNCTION "REM" (X, Y : INTEGER) RETURN INTEGER IS
+          BEGIN
+               IF X /= Y THEN
+                    RETURN 3;
+               ELSE RETURN 0;
+               END IF;
+          END "REM";
+     
+          -- INTEGER PREFIX OPERATORS.
+
+          FUNCTION "+" (X : INTEGER) RETURN INTEGER IS
+          BEGIN
+               IF X /= 0 THEN
+                    RETURN 4;
+               ELSE RETURN 0;
+               END IF;
+          END "+";
+
+          FUNCTION "ABS" (X : INTEGER) RETURN INTEGER IS
+          BEGIN
+               IF X /= 0 THEN
+                    RETURN 5;
+               ELSE RETURN 0;
+               END IF;
+          END "ABS";
+
+          -- INTEGER RELATIONAL OPERATOR.
+
+          FUNCTION "<" (X, Y : INTEGER) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END "<";
+
+     BEGIN
+
+          IF IDENT_INT (3) * IDENT_INT (5) /= 1 THEN
+               FAILED ("REDEFINITION OF INTEGER ""*"" IS DEFECTIVE");
+          END IF;
+
+          IF IDENT_INT (1) + IDENT_INT (30) /= 2 THEN
+               FAILED ("REDEFINITION OF INTEGER ""+"" IS DEFECTIVE");
+          END IF;
+
+          IF IDENT_INT (7) REM IDENT_INT (8) /= 3 THEN
+               FAILED ("REDEFINITION OF ""REM"" IS DEFECTIVE");
+          END IF;
+
+          IF + (IDENT_INT (10)) /= 4 THEN
+               FAILED ("REDEFINITION OF INTEGER UNARY ""+"" IS DEFECTIVE");
+          END IF;
+
+          IF ABS (IDENT_INT (2)) /= 5 THEN
+               FAILED ("REDEFINITION OF INTEGER ""ABS"" IS DEFECTIVE");
+          END IF;
+
+          IF IDENT_INT (7) < IDENT_INT (8) THEN
+               FAILED ("REDEFINITION OF INTEGER ""<"" IS DEFECTIVE");
+          END IF;
+
+     END;
+
+     DECLARE   -- FLOAT OPERATORS.
+
+          -- NOTE THAT ALL LITERAL VALUES USED SHOULD BE
+          --   REPRESENTABLE EXACTLY.
+
+          FUNCTION IDENT_FLOAT (X : FLOAT) RETURN FLOAT IS
+             I : INTEGER := INTEGER (X);
+          BEGIN
+             IF EQUAL (I, I) THEN          -- ALWAYS EQUAL.
+                  RETURN X;
+             END IF;
+             RETURN 0.0;
+          END IDENT_FLOAT;
+
+          -- FLOAT INFIX OPERATORS.
+
+          FUNCTION "-" (X, Y : FLOAT) RETURN FLOAT IS
+          BEGIN
+               IF X /= Y THEN
+                    RETURN 1.0;
+               ELSE RETURN 0.0;
+               END IF;
+          END "-";
+
+          FUNCTION "/" (X, Y : FLOAT) RETURN FLOAT IS
+          BEGIN
+               IF X /= Y THEN
+                    RETURN 2.0;
+               ELSE RETURN 0.0;
+               END IF;
+          END "/";
+
+          FUNCTION "**" (X : FLOAT; Y : INTEGER) RETURN FLOAT IS
+          BEGIN
+               IF INTEGER (X) /= Y THEN
+                    RETURN 3.0;
+               ELSE RETURN 0.0;
+               END IF;
+          END "**";
+
+          -- FLOAT PREFIX OPERATOR.
+
+          FUNCTION "-" (X : FLOAT) RETURN FLOAT IS
+          BEGIN
+               IF X /= 0.0 THEN
+                    RETURN 4.0;
+               ELSE RETURN 0.0;
+               END IF;
+          END "-";
+
+          -- FLOAT RELATIONAL OPERATOR.
+
+          FUNCTION "<=" (X, Y : FLOAT) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END "<=";
+
+     BEGIN
+
+          IF IDENT_FLOAT (50.0) - IDENT_FLOAT (100.0) /= 1.0 THEN
+               FAILED ("REDEFINITION OF FLOAT ""-"" IS DEFECTIVE");
+          END IF;
+
+          IF IDENT_FLOAT (5.0) / IDENT_FLOAT (1.0) /= 2.0 THEN
+               FAILED ("REDEFINITION OF FLOAT ""/"" IS DEFECTIVE");
+          END IF;
+
+          IF IDENT_FLOAT (3.0) ** IDENT_INT (2) /= 3.0 THEN
+               FAILED ("REDEFINITION OF FLOAT ""**"" IS DEFECTIVE");
+          END IF;
+
+          IF -(IDENT_FLOAT (5.0)) /= 4.0 THEN
+               FAILED ("REDEFINITION OF FLOAT UNARY ""-"" IS DEFECTIVE");
+          END IF;
+
+          IF IDENT_FLOAT (1.0) <= IDENT_FLOAT (5.0) THEN
+               FAILED ("REDEFINITION OF FLOAT ""<="" IS DEFECTIVE");
+          END IF;
+
+     END;
+
+     DECLARE     -- BOOLEAN OPERATORS.
+
+          -- BOOLEAN LOGICAL OPERATORS.
+
+          FUNCTION "AND" (X, Y : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               IF X AND THEN Y THEN
+                    RETURN FALSE;
+               ELSE RETURN TRUE;
+               END IF;
+          END "AND";
+
+          FUNCTION "XOR" (X, Y : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END "XOR";
+
+          -- BOOLEAN RELATIONAL OPERATOR.
+
+          FUNCTION ">" (X, Y : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END ">";
+
+     BEGIN
+
+          IF IDENT_BOOL (TRUE) AND IDENT_BOOL (TRUE) THEN
+               FAILED ("REDEFINITION OF ""AND"" IS DEFECTIVE");
+          END IF;
+
+          IF IDENT_BOOL (TRUE) XOR IDENT_BOOL (FALSE) THEN
+               FAILED ("REDEFINITION OF ""XOR"" IS DEFECTIVE");
+          END IF;
+
+          IF IDENT_BOOL (TRUE) > IDENT_BOOL (FALSE) THEN
+               FAILED ("REDEFINITION OF BOOLEAN "">"" IS DEFECTIVE");
+          END IF;
+
+     END;
+    
+     DECLARE     -- STRING OPERATORS.
+
+          S1 : STRING (1..2) := "A" & IDENT_CHAR ('B');
+          S2 : STRING (1..2) := "C" & IDENT_CHAR ('D');
+
+          FUNCTION "&" (X, Y : STRING) RETURN STRING IS
+               Z : STRING (1 .. X'LENGTH + Y'LENGTH);
+          BEGIN
+               Z (1 .. Y'LENGTH) := Y;
+               Z (Y'LENGTH + 1 .. Z'LAST) := X;
+               RETURN Z;
+          END "&";
+
+          FUNCTION "&" (X : CHARACTER; Y : STRING) RETURN STRING IS
+               Z : STRING (1 .. Y'LENGTH + 1);
+          BEGIN
+               Z (1 .. Y'LENGTH) := Y;
+               Z (Z'LAST) := X;
+               RETURN Z;
+          END "&";
+
+          -- STRING RELATIONAL OPERATOR.
+
+          FUNCTION ">=" (X, Y : STRING) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END ">=";
+
+     BEGIN
+
+          IF S1 & S2 /= "CDAB" THEN
+               FAILED ("BAD REDEFINITION OF ""&"" (S,S)");
+          END IF;
+
+          IF IDENT_CHAR ('C') & S1 /= "ABC" THEN
+               FAILED ("BAD REDEFINITION OF ""&"" (C,S)");
+          END IF;
+
+          IF S2 >= S1 THEN
+               FAILED ("BAD REDEFINITION OF STRING "">=""");
+          END IF;
+
+     END;
+
+     DECLARE      -- CHARACTER OPERATORS.
+
+          -- CHARACTER RELATIONAL OPERATORS.
+
+          FUNCTION ">" (X, Y : CHARACTER) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END ">";
+
+          FUNCTION "<=" (X, Y : CHARACTER) RETURN BOOLEAN IS
+          BEGIN
+               RETURN X = Y;
+          END "<=";
+
+     BEGIN
+
+          IF IDENT_CHAR ('C') > IDENT_CHAR ('B') THEN
+               FAILED ("REDEFINITION OF CHARACTER "">"" IS DEFECTIVE");
+          END IF;
+
+          IF IDENT_CHAR ('A') <= IDENT_CHAR ('E') THEN
+               FAILED ("REDEFINITION OF CHARACTER ""<="" IS DEFECTIVE");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C67003F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005a.ada
new file mode 100644
index 000000000..e83d8d1d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005a.ada
@@ -0,0 +1,96 @@
+-- C67005A.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 IF A RENAMING DECLARATION DECLARES AN EQUALITY OPERATOR, THE
+-- TYPES OF THE PARAMETERS NEED NOT BE LIMITED TYPES. 
+
+-- JBG 9/28/83
+
+WITH REPORT; USE REPORT;
+PROCEDURE C67005A IS
+BEGIN
+     TEST ("C67005A", "CHECK THAT AN EQUALITY OPERATOR DECLARED BY " &
+                      "A RENAMING DECLARATION NEED NOT HAVE " &
+                      "PARAMETERS OF A LIMITED TYPE");
+     DECLARE
+          GENERIC
+               TYPE LP IS LIMITED PRIVATE;
+               WITH FUNCTION EQUAL (L, R : LP) RETURN BOOLEAN;
+          PACKAGE EQUALITY_OPERATOR IS
+               FUNCTION "=" (L, R : LP) RETURN BOOLEAN;
+          END EQUALITY_OPERATOR;
+
+          PACKAGE BODY EQUALITY_OPERATOR IS
+               FUNCTION "=" (L, R : LP) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN EQUAL(L, R);
+               END "=";
+          END EQUALITY_OPERATOR;
+
+          PACKAGE POLAR_COORDINATES IS
+               TYPE POLAR_COORD IS
+                    RECORD
+                         R     : INTEGER;
+                         THETA : INTEGER;
+                    END RECORD;
+               FUNCTION EQUAL (L, R : POLAR_COORD) RETURN BOOLEAN;
+               PACKAGE POLAR_EQUAL IS NEW EQUALITY_OPERATOR
+                         (POLAR_COORD, EQUAL);
+               FUNCTION "=" (L, R : POLAR_COORD) RETURN BOOLEAN
+                         RENAMES POLAR_EQUAL."=";
+          END POLAR_COORDINATES;
+
+          PACKAGE BODY POLAR_COORDINATES IS
+               FUNCTION EQUAL (L, R : POLAR_COORD) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN (L.THETA MOD 360) = (R.THETA MOD 360) AND
+                           L.R = R.R;
+               END EQUAL;
+          END POLAR_COORDINATES;
+
+          USE POLAR_COORDINATES;
+
+          PACKAGE VARIABLES IS
+               P270 : POLAR_COORD := (R => 3, THETA => 270);
+               P360 : POLAR_COORD := (R => 3, THETA => IDENT_INT(360));
+          END VARIABLES;
+
+          USE VARIABLES;
+
+     BEGIN
+
+          IF P270 /= (3, -90) THEN
+               FAILED ("INCORRECT INEQUALITY OPERATOR");
+          END IF;
+
+          IF P360 = (3, 0) THEN
+               NULL;
+          ELSE
+               FAILED ("INCORRECT EQUALITY OPERATOR");
+          END IF;
+
+          RESULT;
+
+     END;
+END C67005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005b.ada
new file mode 100644
index 000000000..27579605d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005b.ada
@@ -0,0 +1,124 @@
+-- C67005B.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 EQUALITY IS REDEFINED FOR A SCALAR TYPE, CASE
+-- STATEMENTS STILL USE THE PREDEFINED EQUALITY OPERATION.
+
+-- JBG 9/28/83
+
+WITH REPORT; USE REPORT;
+PROCEDURE C67005B IS
+
+     GENERIC
+          TYPE LP IS LIMITED PRIVATE;
+          WITH FUNCTION EQUAL (L, R : LP) RETURN BOOLEAN;
+     PACKAGE EQUALITY_OPERATOR IS
+          FUNCTION "=" (L, R : LP) RETURN BOOLEAN;
+     END EQUALITY_OPERATOR;
+     
+     PACKAGE BODY EQUALITY_OPERATOR IS
+          FUNCTION "=" (L, R : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN EQUAL(L, R);
+          END "=";
+     END EQUALITY_OPERATOR;
+
+BEGIN
+     TEST ("C67005B", "CHECK THAT REDEFINING EQUALITY FOR A " &
+                      "SCALAR TYPE DOES NOT AFFECT CASE STATEMENTS");
+
+     DECLARE
+          TYPE MY IS NEW INTEGER;
+          CHECK : MY;
+
+          VAR : INTEGER RANGE 1..3 := 3;
+
+          PACKAGE INTEGER_EQUALS IS
+               FUNCTION EQUAL (L, R : INTEGER) RETURN BOOLEAN;
+               PACKAGE INTEGER_EQUAL IS NEW EQUALITY_OPERATOR
+                         (INTEGER, EQUAL);
+          END INTEGER_EQUALS;
+
+          FUNCTION "=" (L, R : INTEGER) RETURN BOOLEAN RENAMES
+                       INTEGER_EQUALS.INTEGER_EQUAL."=";
+
+          PACKAGE BODY INTEGER_EQUALS IS
+               FUNCTION EQUAL (L, R : INTEGER) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN FALSE;
+               END EQUAL;
+          END INTEGER_EQUALS;
+
+     BEGIN
+
+          IF VAR = 3 THEN
+               FAILED ("DID NOT USE REDEFINED '=' - 1");
+          END IF;
+
+          IF VAR /= 3 THEN
+               NULL;
+          ELSE
+               FAILED ("DID NOT USE REDEFINED '/=' - 1");
+          END IF;
+
+          IF VAR = IDENT_INT(3) THEN
+               FAILED ("DID NOT USE REDEFINED '=' - 2");
+          END IF;
+
+          IF VAR /= IDENT_INT(3) THEN
+               NULL;
+          ELSE
+               FAILED ("DID NOT USE REDEFINED '/=' - 2");
+          END IF;
+
+          CHECK := MY(IDENT_INT(0));
+          IF CHECK /= 0 THEN
+               FAILED ("USING WRONG EQUALITY FOR DERIVED TYPE");
+          END IF;
+
+          CASE VAR IS
+               WHEN 1..3 => CHECK := MY(IDENT_INT(1));
+               WHEN OTHERS => NULL;
+          END CASE;
+
+          IF CHECK /= 1 THEN
+               FAILED ("DID NOT USE PREDEFINED EQUALS IN CASE - 1");
+          END IF;
+
+          CASE IDENT_INT(VAR) IS
+               WHEN 1 => CHECK := 4;
+               WHEN 2 => CHECK := 5;
+               WHEN 3 => CHECK := 6;
+               WHEN OTHERS => CHECK := 7;
+          END CASE;
+
+          IF CHECK /= 6 THEN
+               FAILED ("DID NOT USE PREDEFINED EQUALS IN CASE - 2");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C67005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005c.ada
new file mode 100644
index 000000000..b52c40d64
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005c.ada
@@ -0,0 +1,109 @@
+-- C67005C.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 DECLARATION OF "=" NEED NOT HAVE PARAMETERS
+-- OF A LIMITED TYPE IN A RENAMING DECLARATION. THIS TEST CHECKS
+-- ACCESS TYPES.
+
+-- BRYCE BARDIN (HUGHES AIRCRAFT) 7/2/84
+-- CPP 7/12/84
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C67005C IS
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+          WITH FUNCTION EQUAL (LEFT, RIGHT : T) RETURN BOOLEAN IS <>;
+     PACKAGE EQUALITY IS
+          FUNCTION "=" (LEFT, RIGHT : T) RETURN BOOLEAN;
+          -- PRAGMA INLINE ("=");
+     END EQUALITY;
+
+     PACKAGE BODY EQUALITY IS
+          FUNCTION "=" (LEFT, RIGHT : T) RETURN BOOLEAN IS
+          BEGIN
+               RETURN EQUAL (LEFT, RIGHT);
+          END "=";
+     END EQUALITY;
+
+     PACKAGE STARTER IS
+          TYPE INT IS PRIVATE;
+          FUNCTION VALUE_OF (I : INTEGER) RETURN INT;
+          FUNCTION EQUAL (LEFT, RIGHT : INT) RETURN BOOLEAN;
+     PRIVATE
+          TYPE INT IS ACCESS INTEGER;
+     END STARTER;
+
+     PACKAGE BODY STARTER IS
+          FUNCTION VALUE_OF (I : INTEGER) RETURN INT IS
+          BEGIN
+               RETURN NEW INTEGER'(I);
+          END VALUE_OF;
+
+          FUNCTION EQUAL (LEFT, RIGHT : INT) RETURN BOOLEAN IS
+          BEGIN
+               RETURN LEFT.ALL = RIGHT.ALL;
+          END EQUAL;
+     END STARTER;
+
+     PACKAGE ABSTRACTION IS
+          TYPE INT IS NEW STARTER.INT;
+          PACKAGE INT_EQUALITY IS NEW EQUALITY (INT, EQUAL);
+          FUNCTION "=" (LEFT, RIGHT : INT) RETURN BOOLEAN
+               RENAMES INT_EQUALITY."=";
+     END ABSTRACTION;    
+     USE ABSTRACTION;
+
+BEGIN
+
+     TEST ("C67005C", "RENAMING OF EQUALITY OPERATOR WITH " &
+           "NON-LIMITED PARAMETERS");
+
+     DECLARE
+
+          I : INT := VALUE_OF(1);
+          J : INT := VALUE_OF(0);
+
+          PROCEDURE CHECK (B : BOOLEAN) IS
+          BEGIN
+               IF I = J AND B THEN
+                    COMMENT ("I = J");
+               ELSIF I /= J AND NOT B THEN
+                    COMMENT ("I /= J");
+               ELSE
+                    FAILED ("WRONG ""="" OPERATOR");
+               END IF;
+          END CHECK;
+
+     BEGIN
+
+          CHECK(FALSE);
+          I := VALUE_OF(0);
+          CHECK(TRUE);
+     
+          RESULT;
+
+     END;
+
+END C67005C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005d.ada
new file mode 100644
index 000000000..95eafe243
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c67005d.ada
@@ -0,0 +1,78 @@
+-- C67005D.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 EQUALITY CAN BE REDEFINED FOR AN ARBITRARY TYPE BY USING A
+-- SEQUENCE OF RENAMING DECLARATIONS.
+
+-- JBG 9/11/84
+
+WITH REPORT; USE REPORT;
+PROCEDURE C67005D IS
+
+     FUNCTION MY_EQUALS  (L, R : INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          RETURN FALSE;
+     END MY_EQUALS;
+
+     GENERIC
+          TYPE LP IS LIMITED PRIVATE;
+          WITH FUNCTION "=" (L, R : LP) RETURN BOOLEAN;
+     PACKAGE EQUALITY_OPERATOR IS
+          PACKAGE INNER IS
+               FUNCTION "=" (L, R : LP) RETURN BOOLEAN RENAMES
+                             EQUALITY_OPERATOR."=";
+          END INNER;
+     END EQUALITY_OPERATOR;
+
+BEGIN
+     TEST ("C67005D", "CHECK REDEFINITION OF ""="" BY RENAMING");
+
+     DECLARE
+
+          CHK1 : BOOLEAN := 3 = IDENT_INT(3);     -- PREDEFINED "="
+
+          -- REDEFINE INTEGER "=".
+
+          PACKAGE INT_EQUALITY IS NEW
+               EQUALITY_OPERATOR (INTEGER, MY_EQUALS);
+          FUNCTION "=" (L, R : INTEGER) RETURN BOOLEAN RENAMES
+               INT_EQUALITY.INNER."=";
+
+          CHK2 : BOOLEAN := 3 = IDENT_INT(3);     -- REDEFINED "=".
+
+     BEGIN
+
+          IF NOT CHK1 THEN
+               FAILED ("PREDEFINED ""="" NOT USED");
+          END IF;
+
+          IF CHK2 THEN
+               FAILED ("REDEFINED ""="" NOT USED");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C67005D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c72001b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c72001b.ada
new file mode 100644
index 000000000..41a1a2c6e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c72001b.ada
@@ -0,0 +1,96 @@
+-- C72001B.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 PACKAGE BODY CAN BE PROVIDED FOR A PACKAGE SPECIFICATION
+--    THAT DOES NOT CONTAIN ANY SUBPROGRAM OR TASK DECLARATIONS AND THAT
+--    STATEMENTS WITHIN THE PACKAGE BODIES CAN BE USED TO INITIALIZE
+--    VARIABLES VISIBLE WITHIN THE PACKAGE BODY.
+
+-- RM 04/30/81
+-- RM 05/07/81 (TO INCORPORATE OLD TEST OBJECTIVE  7.1/T1 )
+-- ABW 6/10/82
+-- SPS 11/4/82
+-- JBG 9/15/83
+
+WITH REPORT;
+PROCEDURE  C72001B  IS
+
+     USE  REPORT;
+
+BEGIN
+
+     TEST( "C72001B" , "CHECK: PACKAGE BODIES CAN INITIALIZE VISIBLE" &
+                       " VARIABLES" );
+
+     DECLARE
+
+
+          PACKAGE  P5  IS
+
+               A : CHARACTER := 'B';
+               B : BOOLEAN   := FALSE;
+
+               PACKAGE  P6  IS
+                    I : INTEGER := IDENT_INT(6);
+               END  P6;
+
+          END  P5;
+
+
+          PACKAGE BODY  P5  IS
+               PACKAGE BODY  P6  IS
+               BEGIN
+                    A := 'C';
+                    I := 17;
+                    B := IDENT_BOOL(TRUE);
+               END  P6;
+          BEGIN
+               A := 'A';
+          END  P5;
+
+
+          USE  P5;
+          USE  P6;
+
+     BEGIN
+
+          IF A /= 'A' THEN
+               FAILED ("INITIALIZATIONS NOT CORRECT - 1");
+          END IF;
+
+          IF B /= TRUE THEN
+               FAILED ("INITIALIZATIONS NOT CORRECT - 2");
+          END IF;
+
+          IF I /= 17 THEN
+               FAILED ("INITIALIZATIONS NOT CORRECT - 3");
+          END IF;
+
+     END;
+
+
+     RESULT;
+
+
+END C72001B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c72002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c72002a.ada
new file mode 100644
index 000000000..491f074f3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c72002a.ada
@@ -0,0 +1,229 @@
+-- C72002A.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 DECLARATIVE ITEMS IN A PACKAGE SPECIFICATION ARE
+--     ELABORATED IN THE ORDER DECLARED.
+
+-- HISTORY:
+--     DHH 03/09/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C72002A IS
+
+     A : INTEGER := 0;
+     TYPE ORDER_ARRAY IS ARRAY(1 .. 14) OF INTEGER;
+     OBJECT_ARRAY : ORDER_ARRAY;
+     TYPE REAL IS DIGITS 4;
+     TYPE ENUM IS (RED,YELLOW,BLUE);
+
+     TYPE ARR IS ARRAY(1 ..2) OF BOOLEAN;
+     D : ARR := (TRUE, TRUE);
+     E : ARR := (FALSE, FALSE);
+
+     TYPE REC IS
+          RECORD
+               I : INTEGER;
+          END RECORD;
+     B : REC := (I => IDENT_INT(1));
+     C : REC := (I => IDENT_INT(2));
+
+     FUNCTION GIVEN_ORDER(X : INTEGER) RETURN INTEGER IS
+          Y : INTEGER;
+     BEGIN
+          Y := X + 1;
+          RETURN Y;
+     END GIVEN_ORDER;
+
+     FUNCTION BOOL(X : INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          IF X = IDENT_INT(1) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN TRUE;
+          ELSIF X = IDENT_INT(8) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN FALSE;
+          END IF;
+     END BOOL;
+
+     FUNCTION INT(X : INTEGER) RETURN INTEGER IS
+     BEGIN
+          IF X = IDENT_INT(2) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN IDENT_INT(1);
+          ELSIF X = IDENT_INT(9) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN IDENT_INT(2);
+          END IF;
+     END INT;
+
+     FUNCTION FLOAT(X : INTEGER) RETURN REAL IS
+     BEGIN
+          IF X = IDENT_INT(3) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN 1.0;
+          ELSIF X = IDENT_INT(10) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN 2.0;
+          END IF;
+     END FLOAT;
+
+     FUNCTION CHAR(X : INTEGER) RETURN CHARACTER IS
+     BEGIN
+          IF X = IDENT_INT(4) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN 'A';
+          ELSIF X = IDENT_INT(11) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN 'Z';
+          END IF;
+     END CHAR;
+
+     FUNCTION ENUMR(X : INTEGER) RETURN ENUM IS
+     BEGIN
+          IF X = IDENT_INT(5) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN RED;
+          ELSIF X = IDENT_INT(12) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN YELLOW;
+          END IF;
+     END ENUMR;
+
+     FUNCTION ARRY(X : INTEGER) RETURN ARR IS
+     BEGIN
+          IF X = IDENT_INT(6) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN D;
+          ELSIF X = IDENT_INT(13) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN E;
+          END IF;
+     END ARRY;
+
+     FUNCTION RECOR(X : INTEGER) RETURN REC IS
+     BEGIN
+          IF X = IDENT_INT(7) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN B;
+          ELSIF X = IDENT_INT(14) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN C;
+          END IF;
+     END RECOR;
+
+     PACKAGE PACK IS
+          A : BOOLEAN   := BOOL(1);
+          B : INTEGER   := INT(2);
+          C : REAL      := FLOAT(3);
+          D : CHARACTER := CHAR(4);
+          E : ENUM      := ENUMR(5);
+          F : ARR       := ARRY(6);
+          G : REC       := RECOR(7);
+          H : BOOLEAN   := BOOL(8);
+          I : INTEGER   := INT(9);
+          J : REAL      := FLOAT(10);
+          K : CHARACTER := CHAR(11);
+          L : ENUM      := ENUMR(12);
+          M : ARR       := ARRY(13);
+          N : REC       := RECOR(14);
+     END PACK;
+
+BEGIN
+     TEST("C72002A", "CHECK THAT THE DECLARATIVE ITEMS IN A PACKAGE " &
+                     "SPECIFICATION ARE ELABORATED IN THE ORDER " &
+                     "DECLARED");
+
+     IF OBJECT_ARRAY(1) /= IDENT_INT(1) THEN
+          FAILED("BOOLEAN 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(2) /= IDENT_INT(2) THEN
+          FAILED("INTEGER 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(3) /= IDENT_INT(3) THEN
+          FAILED("REAL 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(4) /= IDENT_INT(4) THEN
+          FAILED("CHARACTER 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(5) /= IDENT_INT(5) THEN
+          FAILED("ENUMERATION 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(6) /= IDENT_INT(6) THEN
+          FAILED("ARRAY 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(7) /= IDENT_INT(7) THEN
+          FAILED("RECORD 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(8) /= IDENT_INT(8) THEN
+          FAILED("BOOLEAN 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(9) /= IDENT_INT(9) THEN
+          FAILED("INTEGER 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(10) /= IDENT_INT(10) THEN
+          FAILED("REAL 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(11) /= IDENT_INT(11) THEN
+          FAILED("CHARACTER 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(12) /= IDENT_INT(12) THEN
+          FAILED("ENUMERATION 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(13) /= IDENT_INT(13) THEN
+          FAILED("ARRAY 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(14) /= IDENT_INT(14) THEN
+          FAILED("RECORD 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     RESULT;
+END C72002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730001.a
new file mode 100644
index 000000000..24cf8e0fd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730001.a
@@ -0,0 +1,437 @@
+-- C730001.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 full view of a private extension may be derived
+--      indirectly from the ancestor type (i.e., the parent type of the full
+--      type may be any descendant of the ancestor type). Check that, for
+--      a primitive subprogram of the private extension that is inherited from
+--      the ancestor type and not overridden, the formal parameter names and
+--      default expressions come from the corresponding primitive subprogram
+--      of the ancestor type, while the body comes from that of the parent
+--      type.  Check both dispatching and non-dispatching cases.
+--
+-- TEST DESCRIPTION:
+--      Consider:
+--
+--      package P is
+--         type Ancestor is tagged ...
+--         procedure Op (P1: Ancestor; P2: Boolean := True);
+--      end P;
+--
+--      with P;
+--      package Q is
+--         type Derived is new P.Ancestor with ...
+--         procedure Op (X: Ancestor; Y: Boolean := False);
+--      end Q;
+--
+--      with P, Q;
+--      package R is
+--         type Priv_Ext is new P.Ancestor with private;   -- (A)
+--         -- Inherits procedure Op (P1: Priv_Ext; P2: Boolean := True);
+--         -- But body executed is that of Q.Op.
+--      private
+--         type Priv_Ext is new Q.Derived with record ...  -- (B)
+--      end R;
+--
+--      The ancestor type in (A) differs from the parent type in (B); the
+--      parent of the full type is descended from the ancestor type of the
+--      private extension. For a call to Op (from outside the scope of the
+--      full view) with an operand of type Priv_Ext, the formal parameter
+--      names and default expression come from that of P.Op (the ancestor
+--      type's version), but the body executed will be that of 
+--      Q.Op (the parent type's version)
+--
+--      One half of the test mirrors the above template, where an inherited
+--      subprogram (Set_Display) is called using the formal parameter 
+--      name (C) and default parameter expression of the ancestor type's 
+--      version (type Clock), but the version of the body executed is from
+--      the parent type.
+--
+--      The test also includes an examination of the dynamic evaluation
+--      case, where correct body associations are required through dispatching 
+--      calls.  As described for the non-dispatching case above, the formal
+--      parameter name and default values of the ancestor type's (Phone) 
+--      version of the inherited subprogram (Answer) are used in the 
+--      dispatching call, but the body executed is from the parent type.
+--      
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C730001_0 is
+
+   type Display_Kind      is (None, Analog, Digital);
+   type Illumination_Type is (None, Light, Phosphorescence);
+   type Capability_Type   is (Available, In_Use, Call_Waiting, Conference);
+   type Indicator_Type    is (None, Light, Bell, Buzzer, Click, Modem);
+
+   type Clock is abstract tagged record           -- ancestor type associated
+      Display      : Display_Kind      := None;   -- with non-dispatching case.
+      Illumination : Illumination_Type := None;
+   end record;
+
+   type Phone is tagged record                    -- ancestor type associated
+      Status    : Capability_Type := Available;   -- with dispatching case.
+      Indicator : Indicator_Type  := None;
+   end record;
+
+   -- The Set_Display procedure for type Clock implements a basic, no-frills
+   -- clock display.
+   procedure Set_Display (C   : in out Clock;
+                          Disp: in     Display_Kind := Digital);
+
+   -- The Answer procedure for type Phone implements a phone status change
+   -- operation.
+   procedure Answer (The_Phone : in out Phone;
+                     Ind       : in     Indicator_Type := Light);
+   -- ...Other general clock and/or phone operations (not specified in this
+   -- test scenario).
+
+end C730001_0;
+
+
+     --==================================================================--
+
+
+package body C730001_0 is
+
+   procedure Set_Display (C   : in out Clock;
+                          Disp: in     Display_Kind := Digital) is
+   begin
+      C.Display      := Disp;
+      C.Illumination := Light;
+   end Set_Display;
+
+   procedure Answer (The_Phone : in out Phone;
+                     Ind       : in     Indicator_Type := Light) is
+   begin
+      The_Phone.Status    := In_Use;
+      The_Phone.Indicator := Ind;
+   end Answer;
+
+end C730001_0;
+
+
+     --==================================================================--
+
+
+with C730001_0; use C730001_0;
+package C730001_1 is
+
+   type Power_Supply_Type is (Spring, Battery, AC_Current);
+   type Speaker_Type      is (None, Present, Adjustable, Stereo);
+
+   type Wall_Clock is new Clock with record
+      Power_Source : Power_Supply_Type := Spring;
+   end record;
+
+   type Office_Phone is new Phone with record
+      Speaker : Speaker_Type := Present;
+   end record;
+
+   -- Note: Both procedures below, parameter names and defaults differ from
+   --       parent's version.
+
+   -- The Set_Display procedure for type Wall_Clock improves upon the
+   -- basic Set_Display procedure of type Clock.
+
+   procedure Set_Display (WC: in out Wall_Clock;
+                          D : in     Display_Kind := Analog);
+
+   procedure Answer (OP : in out Office_Phone;
+                     OI : in     Indicator_Type := Buzzer);
+
+   -- ...Other wall clock and/or Office_Phone operations (not specified in
+   -- this test scenario).
+
+end C730001_1;
+
+
+     --==================================================================--
+
+
+package body C730001_1 is
+
+   -- Note: This body is the one that should be executed in the test block
+   --       below, not the version of the body corresponding to type Clock.
+
+   procedure Set_Display (WC: in out Wall_Clock;
+                          D : in     Display_Kind := Analog) is
+   begin
+      WC.Display      := D;
+      WC.Illumination := Phosphorescence;
+   end Set_Display;
+
+
+   procedure Answer (OP : in out Office_Phone;
+                     OI : in     Indicator_Type := Buzzer) is
+   begin
+      OP.Status    := Call_Waiting;
+      OP.Indicator := OI;
+   end Answer;
+
+end C730001_1;
+
+
+     --==================================================================--
+
+
+with C730001_0; use C730001_0;
+with C730001_1; use C730001_1;
+package C730001_2 is
+
+   type Alarm_Type  is (Buzzer, Radio, Both);
+   type Video_Type  is (None, TV_Monitor, Wall_Projection);
+
+   type Alarm_Clock is new Clock with private;
+   -- Inherits proc Set_Display (C   : in out Clock;
+   --                            Disp: in     Display_Kind := Digital); -- (A)
+   --
+   -- Would also inherit other general clock operations (if present).
+
+
+   type Conference_Room_Phone is new Office_Phone with record
+      Display : Video_Type := TV_Monitor;
+   end record;
+
+   procedure Answer (CP : in out Conference_Room_Phone;
+                     CI : in     Indicator_Type := Modem);
+
+
+   function TC_Get_Display              (C: Alarm_Clock) return Display_Kind;
+   function TC_Get_Display_Illumination (C: Alarm_Clock) 
+     return Illumination_Type;
+
+private
+
+   -- ...however, certain of the wall clock's operations (Set_Display, in 
+   -- this example) improve on the implementations provided for the general
+   -- clock. We want to call the improved implementations, so we
+   -- derive from Wall_Clock in the private part.
+
+   type Alarm_Clock is new Wall_Clock with record
+      Alarm : Alarm_Type := Buzzer;
+   end record;
+
+   -- Inherits proc Set_Display (WC: in out Wall_Clock;
+   --                            D : in     Display_Kind := Analog);    -- (B)
+
+   -- The implicit Set_Display at (B) overrides the implicit Set_Display at 
+   -- (A), but only within the scope of the full view. 
+   --
+   -- Outside the scope of the full view, only (A) is visible, so calls
+   -- from outside the scope will get the formal parameter names and default
+   -- from (A). Both inside and outside the scope, however, the body executed
+   -- will be that corresponding to Set_Display of the parent type.
+
+end C730001_2;
+
+
+     --==================================================================--
+
+
+package body C730001_2 is
+
+   procedure Answer (CP : in out Conference_Room_Phone;
+                     CI : in     Indicator_Type := Modem)is
+   begin
+      CP.Status    := Conference;
+      CP.Indicator := CI;
+   end Answer;
+
+
+   function TC_Get_Display (C: Alarm_Clock) return Display_Kind is
+   begin
+      return C.Display;
+   end TC_Get_Display;
+
+
+   function TC_Get_Display_Illumination (C: Alarm_Clock) 
+     return Illumination_Type is
+   begin
+      return C.Illumination;
+   end TC_Get_Display_Illumination;
+
+end C730001_2;
+
+
+     --==================================================================--
+
+
+with C730001_0; use C730001_0;
+with C730001_1; use C730001_1;
+with C730001_2; use C730001_2;
+
+package C730001_3 is
+
+   -- Types extended from the ancestor (Phone) type in the specification.
+
+   type Secure_Phone_Type     is new Phone with private;
+   type Auditorium_Phone_Type is new Phone with private;
+   -- Inherit versions of Answer from ancestor (Phone).
+
+   function TC_Get_Phone_Status (P : Phone'Class) return Capability_Type;
+   function TC_Get_Indicator    (P : Phone'Class) return Indicator_Type;
+
+private
+
+   -- Types extended from descendents of Phone_Type in the private part.
+
+   type Secure_Phone_Type is new Office_Phone with record
+      Scrambled_Communication : Boolean := True;
+   end record;
+
+   type Auditorium_Phone_Type is new Conference_Room_Phone with record
+      Volume_Control : Boolean := True;
+   end record;
+
+end C730001_3;
+
+     --==================================================================--
+
+package body C730001_3 is
+
+   function TC_Get_Phone_Status (P : Phone'Class) return Capability_Type is
+   begin
+      return P.Status;
+   end TC_Get_Phone_Status;
+
+   function TC_Get_Indicator (P : Phone'Class) return Indicator_Type is
+   begin
+      return P.Indicator;
+   end TC_Get_Indicator;
+
+end C730001_3;
+
+     --==================================================================--
+
+with C730001_0; use C730001_0;
+with C730001_1; use C730001_1;
+with C730001_2; use C730001_2;
+with C730001_3; use C730001_3;
+
+with Report;
+
+procedure C730001 is
+begin
+
+   Report.Test ("C730001","Check that the full view of a private extension " &
+                          "may be derived indirectly from the ancestor "     &
+                          "type. Check that, for a primitive subprogram "    &
+                          "of the private extension that is inherited from " &
+                          "the ancestor type and not overridden, the "       &
+                          "formal parameter names and default expressions "  &
+                          "come from the corresponding primitive "           &
+                          "subprogram of the ancestor type, while the body " &
+                          "comes from that of the parent type");
+
+   Test_Block:
+   declare
+
+      Alarm                : Alarm_Clock;
+      Hot_Line             : Secure_Phone_Type;
+      TeleConference_Phone : Auditorium_Phone_Type;
+
+   begin
+
+   -- Evaluate non-dispatching case:
+
+      -- Call Set_Display using formal parameter name from 
+      -- C730001_0.Set_Display.
+      -- Give no 2nd parameter so that default expression must be used.
+
+      Set_Display (C => Alarm);
+    
+      -- The value of the Display component should equal Digital, which is
+      -- the default value from the ancestor's version of Set_Display,
+      -- and not the default value from the parent's version of Set_Display.
+
+      if TC_Get_Display (Alarm) /= Digital then
+         Report.Failed ("Default expression for ancestor op not used " &
+                        "in non-dispatching case");
+      end if;
+
+      -- However, the value of the Illumination component should equal
+      -- Phosphorescence, which is assigned in the parent type's version of
+      -- the body of Set_Display.
+
+      if TC_Get_Display_Illumination (Alarm) /= Phosphorescence then
+         Report.Failed ("Wrong body was executed in non-dispatching case");
+      end if;
+
+
+   -- Evaluate dispatching case:
+      declare
+
+         Hot_Line             : Secure_Phone_Type;
+         TeleConference_Phone : Auditorium_Phone_Type;
+
+         procedure Answer_The_Phone (P : in out Phone'Class) is
+         begin
+            -- Give no 2nd parameter so that default expression must be used.
+            Answer (P);
+         end Answer_The_Phone;
+
+      begin
+
+         Answer_The_Phone (Hot_Line);
+         Answer_The_Phone (TeleConference_Phone);
+
+         -- The value of the Indicator field shold equal "Light", the default
+         -- value from the ancestor's version of Answer, and not the default
+         -- from either of the parent versions of Answer.
+
+         if TC_Get_Indicator(Hot_Line)             /= Light   or
+            TC_Get_Indicator(TeleConference_Phone) /= Light
+         then
+            Report.Failed("Default expression from ancestor operation " &
+                          "not used in dispatching case");
+         end if;
+
+         -- However, the value of the Status component should equal
+         -- Call_Waiting or Conference respectively, based on the assignment
+         -- in the parent type's version of the body of Answer.
+
+         if TC_Get_Phone_Status(Hot_Line)  /=  Call_Waiting then
+            Report.Failed("Wrong body executed in dispatching case - 1");
+         end if;
+
+         if TC_Get_Phone_Status(TeleConference_Phone) /= Conference then
+            Report.Failed("Wrong body executed in dispatching case - 2");
+         end if;
+
+      end;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end C730001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730002.a
new file mode 100644
index 000000000..9213a7d92
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730002.a
@@ -0,0 +1,383 @@
+-- C730002.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 full view of a private extension may be derived
+--      indirectly from the ancestor type (i.e., the parent type of the full
+--      type may be any descendant of the ancestor type). Check that, for
+--      a primitive subprogram of the private extension that is inherited from
+--      the ancestor type and not overridden, the formal parameter names and
+--      default expressions come from the corresponding primitive subprogram
+--      of the ancestor type, while the body comes from that of the parent
+--      type.
+--      Check for a case where the parent type is derived from the ancestor
+--      type through a series of types produced by generic instantiations.
+--      Examine both the static and dynamic binding cases.
+--
+-- TEST DESCRIPTION:
+--      Consider:
+--
+--      package P is
+--         type Ancestor is tagged ...
+--         procedure Op (P1: Ancestor; P2: Boolean := True);
+--      end P;
+--
+--      with P;
+--      generic
+--         type T is new P.Ancestor with private;  
+--      package Gen1 is
+--         type Enhanced is new T with private;
+--         procedure Op (A: Enhanced; B: Boolean := True);
+--         -- other specific procedures...
+--      private
+--         type Enhanced is new T with ...
+--      end Gen1;
+--
+--      with P, Gen1;
+--      package N is new Gen1 (P.Ancestor);
+--
+--      with N;
+--      generic
+--         type T is new N.Enhanced with private;
+--      package Gen2 is
+--         type Enhanced_Again is new T with private;
+--         procedure Op (X: Enhanced_Again; Y: Boolean := False);
+--         -- other specific procedures...
+--      private
+--         type Enhanced_Again is new T with ...
+--      end Gen2;
+--
+--      with N, Gen2;
+--      package Q is new Gen2 (N.Enhanced);
+--
+--      with P, Q;
+--      package R is
+--         type Priv_Ext is new P.Ancestor with private;         -- (A)
+--         -- Inherits procedure Op (P1: Priv_Ext; P2: Boolean := True);
+--         -- But body executed is that of Q.Op.
+--      private
+--         type Priv_Ext is new Q.Enhanced_Again with record ... -- (B)
+--      end R;
+--
+--      The ancestor type in (A) differs from the parent type in (B); the
+--      parent of the full type is descended from the ancestor type of the
+--      private extension, in this case through a series of types produced
+--      by generic instantiations.  Gen1 redefines the implementation of Op
+--      for any type that has one.  N is an instance of Gen1 for the ancestor
+--      type. Gen2 again redefines the implementation of Op for any type that
+--      has one. Q is an instance of Gen2 for the extension of the P.Ancestor
+--      declared in N.  Both N and Q could define other operations which we
+--      don't want to be available in R.  For a call to Op (from outside the
+--      scope of the full view) with an operand of type R.Priv_Ext, the body
+--      executed will be that of Q.Op (the parent type's version), but the
+--      formal parameter names and default expression come from that of P.Op
+--      (the ancestor type's version).
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      27 Feb 97   CTA.PWB Added elaboration pragmas.
+--!
+
+package C730002_0 is
+
+   type Hours_Type      is range 0..1000;
+   type Personnel_Type  is range 0..10;
+   type Specialist_ID is (Manny, Moe, Jack, Curly, Joe, Larry);
+
+   type Engine_Type is tagged record
+      Ave_Repair_Time    : Hours_Type     := 0;     -- Default init. for
+      Personnel_Required : Personnel_Type := 0;     -- component fields.
+      Specialist         : Specialist_ID  := Manny;
+   end record;
+
+   procedure Routine_Maintenance (Engine     : in out Engine_Type ; 
+                                  Specialist : in     Specialist_ID := Moe);
+
+   -- The Routine_Maintenance procedure implements the processing required
+   -- for an engine.
+
+end C730002_0;
+
+     --==================================================================--
+
+package body C730002_0 is
+
+   procedure Routine_Maintenance (Engine     : in out Engine_Type ; 
+                                  Specialist : in     Specialist_ID := Moe) is
+   begin
+      Engine.Ave_Repair_Time     := 3;
+      Engine.Personnel_Required  := 1;
+      Engine.Specialist := Specialist;
+   end Routine_Maintenance;
+
+end C730002_0;
+
+     --==================================================================--
+
+with C730002_0; use C730002_0;
+generic
+   type T is new C730002_0.Engine_Type with private;
+package C730002_1 is
+
+   -- This generic package contains types/procedures specific to engines 
+   -- of the diesel variety.
+
+   type Repair_Facility_Type is (On_Site, Repair_Shop, Factory);
+
+   type Diesel_Series is new T with private;
+
+   procedure Routine_Maintenance (Eng      : in out Diesel_Series;
+                                  Spec_Req : in     Specialist_ID := Jack);
+  
+   -- Other diesel specific operations... (not required in this test).
+
+private
+
+   type Diesel_Series is new T with record
+      Repair_Facility_Required : Repair_Facility_Type := On_Site;
+   end record;
+
+end C730002_1;
+
+     --==================================================================--
+
+package body C730002_1 is
+
+   procedure Routine_Maintenance (Eng      : in out Diesel_Series;
+                                  Spec_Req : in     Specialist_ID := Jack) is
+   begin
+      Eng.Ave_Repair_Time          := 6;
+      Eng.Personnel_Required       := 2;
+      Eng.Specialist               := Spec_Req;
+      Eng.Repair_Facility_Required := On_Site;
+   end Routine_Maintenance;
+
+end C730002_1;
+
+     --==================================================================--
+
+with C730002_0;
+with C730002_1;
+pragma Elaborate (C730002_1);
+package C730002_2 is new C730002_1 (C730002_0.Engine_Type);
+
+     --==================================================================--
+
+with C730002_0; use C730002_0;
+with C730002_2; use C730002_2;
+generic
+  type T is new C730002_2.Diesel_Series with private;
+package C730002_3 is
+
+   type Time_Of_Operation_Type is range 0..100_000;
+
+   type Electric_Series is new T with private;
+
+   procedure Routine_Maintenance (E  : in out Electric_Series;
+                                  SR : in     Specialist_ID := Curly);
+
+   -- Other electric specific operations... (not required in this test).
+
+private
+
+   type Electric_Series is new T with record
+      Mean_Time_Between_Repair : Time_Of_Operation_Type := 0;
+   end record; 
+
+end C730002_3;
+
+     --==================================================================--
+
+package body C730002_3 is
+
+   procedure Routine_Maintenance (E  : in out Electric_Series;
+                                  SR : in     Specialist_ID := Curly) is
+   begin
+      E.Ave_Repair_Time          := 9;
+      E.Personnel_Required       := 3;
+      E.Specialist               := SR;
+      E.Mean_Time_Between_Repair := 1000;
+   end Routine_Maintenance;
+
+end C730002_3;
+
+     --==================================================================--
+
+with C730002_2;
+with C730002_3;
+pragma Elaborate (C730002_3);
+package C730002_4 is new C730002_3 (C730002_2.Diesel_Series);
+
+     --==================================================================--
+
+with C730002_0;  use C730002_0;
+with C730002_4;  use C730002_4;
+
+package C730002_5 is
+
+   type Inspection_Type is (AAA, MIL_STD, NRC);
+
+   type Nuclear_Series is new Engine_Type with private;              -- (A)
+
+   -- Inherits procedure Routine_Maintenance from ancestor; does not override.
+   --                      (Engine     : in out Nuclear_Series; 
+   --                       Specialist : in     Specialist_ID := Moe);
+   -- But body executed will be that of C730002_4.Routine_Maintenance, 
+   -- the parent type.
+
+   function TC_Specialist         (E : Nuclear_Series) return Specialist_ID;
+   function TC_Personnel_Required (E : Nuclear_Series) return Personnel_Type;
+   function TC_Time_Required      (E : Nuclear_Series) return Hours_Type;
+
+   -- Dispatching subprogram.
+   procedure Maintain_The_Engine (The_Engine : in out Engine_Type'Class);
+
+private
+
+   type Nuclear_Series is new Electric_Series with record           -- (B)
+      Inspector_Rep : Inspection_Type := NRC;
+   end record;
+
+   -- The ancestor type is used in the type extension (A), while the parent
+   -- of the full type (B) is a descendent of the ancestor type, through a
+   -- series of types produced by generic instantiation.
+
+end C730002_5;
+
+     --==================================================================--
+
+package body C730002_5 is
+
+   function TC_Specialist (E : Nuclear_Series) return Specialist_ID is
+   begin
+      return E.Specialist;
+   end TC_Specialist;
+
+   function TC_Personnel_Required (E : Nuclear_Series) 
+     return Personnel_Type is
+   begin
+      return E.Personnel_Required;
+   end TC_Personnel_Required;
+
+   function TC_Time_Required (E : Nuclear_Series) return Hours_Type is
+   begin
+      return E.Ave_Repair_Time;
+   end TC_Time_Required;
+
+   -- Dispatching subprogram.
+   procedure Maintain_The_Engine (The_Engine : in out Engine_Type'Class) is
+   begin
+      Routine_Maintenance (The_Engine);
+   end Maintain_The_Engine;
+
+
+end C730002_5;
+
+     --==================================================================--
+
+with Report;
+with C730002_0;  use C730002_0;
+with C730002_2;  use C730002_2;
+with C730002_4;  use C730002_4;
+with C730002_5;  use C730002_5;
+
+procedure C730002 is
+begin
+
+   Report.Test ("C730002", "Check that the full view of a private "        &
+                           "extension may be derived indirectly from "     &
+                           "the ancestor type.  Check for a case where "   &
+                           "the parent type is derived from the ancestor " &
+                           "type through a series of types produced by "   &
+                           "generic instantiations");
+
+   Test_Block:
+   declare
+      Nuclear_Drive : Nuclear_Series;
+      Warp_Drive    : Nuclear_Series;
+   begin
+
+      -- Non-Dispatching Case:
+      -- Call Routine_Maintenance using formal parameter name from
+      -- C730002_0.Routine_Maintenance (ancestor version).
+      -- Give no second parameter so that the default expression must be
+      -- used.
+
+      Routine_Maintenance (Engine => Nuclear_Drive);
+
+      -- The value of the Specialist component should equal "Moe",
+      -- which is the default value from the ancestor's version of
+      -- Routine_Maintenance, and not the default value from the parent's
+      -- version of Routine_Maintenance.
+
+      if TC_Specialist (Nuclear_Drive) /= Moe then
+         Report.Failed
+           ("Default expression for ancestor op not used " &
+            " - non-dispatching case");
+      end if;
+
+      -- However the value of the Ave_Repair_Time and Personnel_Required 
+      -- components should be those assigned in the parent type's version 
+      -- of the body of Routine_Maintenance.
+      -- Note: Only components associated with the ancestor type are
+      --       evaluated for the purposes of this test.
+
+      if TC_Personnel_Required (Nuclear_Drive) /= 3  or
+         TC_Time_Required (Nuclear_Drive)      /= 9
+      then
+         Report.Failed("Wrong body was executed - non-dispatching case");
+      end if;
+
+      -- Dispatching Case:
+      -- Use a dispatching subprogram to ensure that the correct body is 
+      -- used at runtime.
+
+      Maintain_The_Engine (Warp_Drive);
+
+      -- The resulting assignments to the fields of the Warp_Drive variable
+      -- should be the same as those of the Nuclear_Drive above, indicating
+      -- that the body of the parent version of the inherited subprogram
+      -- was used.
+
+      if TC_Specialist (Warp_Drive) /= Moe then
+         Report.Failed
+           ("Default expression for ancestor op not used - dispatching case");
+      end if;
+
+      if TC_Personnel_Required (Nuclear_Drive) /= 3  or
+         TC_Time_Required (Nuclear_Drive)      /= 9
+      then
+         Report.Failed("Wrong body was executed - dispatching case");
+      end if;
+
+
+   exception
+      when others => Report.Failed("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end C730002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730003.a
new file mode 100644
index 000000000..47002f3aa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730003.a
@@ -0,0 +1,283 @@
+-- C730003.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--      Check that the characteristics of a type derived from a private
+--      extension (outside the scope of the full view) are those defined by
+--      the partial view of the private extension.
+--      In particular, check that a component of the derived type may be
+--      explicitly declared with the same name as a component declared for
+--      the full view of the private extension.
+--      Check that a component defined in the private extension of a type
+--      may be updated through a view conversion of a type derived from
+--      the type.
+--
+-- TEST DESCRIPTION:
+--      Consider:
+--
+--      package Parent is
+--         type T is tagged record
+--            ...
+--         end record;
+--
+--         type DT is new T with private;
+--         procedure Op1 (P: in out DT);
+--
+--      private
+--         type DT is new T with record
+--            Y: ...;                                             -- (A)
+--         end record;
+--      end Parent;
+--
+--      package body Parent is
+--         function Op1 (P: in DT) return ... is
+--         begin
+--            return P.Y;
+--         end Op1;
+--      end Parent;
+--
+--      package Unrelated is
+--         type Intermediate is new DT with record
+--            Y: ...;  -- Note: same name as component of         -- (B)
+--                     --       parent's full view.
+--         end record;
+--      end Unrelated;
+--
+--      package Parent.Child is
+--         type DDT is new Intermediate with null record;
+--         -- Implicit declared Op1 (P.DDT);                      -- (C)
+--
+--         procedure Op2 (P: in out DDT);
+--      end Parent.Child;
+--
+--      package body Parent.Child is
+--         procedure Op2 (P: in out DDT) is
+--            Obj : DT renames DT(P);
+--         begin
+--            ...
+--            P.Y := ...;      -- Updates DDT's Y.                -- (D)
+--            DT(P).Y := ...;  -- Updates DT's Y.                 -- (E)
+--            Obj.Y := ...;    -- Updates DT's Y.                 -- (F)
+--         end Op2;
+--      end Parent.Child;
+--
+--      Types DT and DDT both declare a component Y at (A) and (B),
+--      respectively. The component Y of the full view of DT is not visible
+--      at the place where DDT is declared. Therefore, it is invisible for
+--      all views of DDT (although it still exists for objects of DDT), and
+--      it is legal to declare another component for DDT with the same name.
+--
+--      DDT inherits the primitive subprogram Op1 from DT at (C). Op1 returns
+--      the component Y; for calls with an operand of type DDT, Op1 returns
+--      the Y inherited from DT, not the new Y explicitly declared for DDT,
+--      even though the inherited Y is not visible for any view of DDT.
+--
+--      Within the body of Op2, the assignment statement at (D) updates the
+--      Y explicitly declared for DDT. At (E) and (F), however, a view
+--      conversion denotes a new view of P as an object of type DT, which
+--      enables access to the Y from the full view of DT. Thus, the
+--      assignment statements at (E) and (F) update the (invisible) Y from DT.
+--
+--      Note that the above analysis would be wrong if the new component Y
+--      were declared directly in Child.  In that case, the two same-named
+--      components would be illegal -- see AI-150.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 1994   SAIC    ACVC 2.0
+--      29 JUN 1999   RAD     Declare same-named component in an
+--                            unrelated package -- see AI-150.
+--
+--!
+
+package C730003_0 is
+
+   type Suit_Kind is (Clubs, Diamonds, Hearts, Spades);
+   type Face_Kind is (Up, Down);
+
+   type Playing_Card is tagged record
+      Face: Face_Kind;
+      Suit: Suit_Kind;
+   end record;
+
+   procedure Turn_Over_Card (Card : in out Playing_Card);
+
+   type Disp_Card is new Playing_Card with private;
+
+   subtype ASCII_Representation is Natural range 1..14;
+
+   function Get_Private_View (A_Card : Disp_Card) return ASCII_Representation;
+
+private
+
+   type Disp_Card is new Playing_Card with record
+      View: ASCII_Representation;                                       -- (A)
+   end record;
+
+end C730003_0;
+
+--==================================================================--
+
+package body C730003_0 is
+
+   procedure Turn_Over_Card (Card: in out Playing_Card) is
+   begin
+      Card.Face := Up;
+   end Turn_Over_Card;
+
+   function Get_Private_View (A_Card : Disp_Card)
+     return ASCII_Representation is
+   begin
+      return A_Card.View;
+   end Get_Private_View;
+
+end C730003_0;
+
+--==================================================================--
+
+with C730003_0; use C730003_0;
+package C730003_1 is
+
+   subtype Graphic_Representation is String (1 .. 2);
+
+   type Graphic_Card is new Disp_Card with record
+      View : Graphic_Representation;                                    -- (B)
+                                          -- "Duplicate" component field name.
+   end record;
+
+end C730003_1;
+
+--==================================================================--
+
+with C730003_1; use C730003_1;
+package C730003_0.C730003_2 is
+
+   Queen_Of_Spades   : constant C730003_0.ASCII_Representation := 12;
+   Ace_Of_Hearts     : constant String := "AH";
+   Close_To_The_Vest : constant C730003_0.ASCII_Representation := 14;
+   Read_Em_And_Weep  : constant String := "AA";
+
+   type Graphic_Card is new C730003_1.Graphic_Card with null record;
+
+   -- Implicit function Get_Private_View                                -- (C)
+   --           (A_Card : Graphic_Card) return C730003_0.ASCII_Representation;
+
+   function  Get_View       (Card : Graphic_Card) return String;
+   procedure Update_View    (Card : in out Graphic_Card);
+   procedure Hide_From_View (Card : in out Graphic_Card);
+
+end C730003_0.C730003_2;
+
+--==================================================================--
+
+package body C730003_0.C730003_2 is
+
+   function Get_View (Card : Graphic_Card) return String is
+   begin
+      return Card.View;
+   end Get_View;
+
+   procedure Update_View (Card : in out Graphic_Card) is
+      ASCII_View      : Disp_Card renames Disp_Card(Card); -- View conversion.
+   begin
+      ASCII_View.View := Queen_Of_Spades;                               -- (F)
+                                              -- Assignment to "hidden" field.
+      Card.View       := Ace_Of_Hearts;                                 -- (D)
+                                 -- Assignment to Graphic_Card declared field.
+   end Update_View;
+
+   procedure Hide_From_View (Card : in out Graphic_Card) is
+   begin
+      -- Update both of Card's View components.
+      Disp_Card(Card).View := Close_To_The_Vest;                        -- (E)
+                                              -- Assignment to "hidden" field.
+      Card.View            := Read_Em_And_Weep;                         -- (D)
+                                 -- Assignment to Graphic_Card declared field.
+   end Hide_From_View;
+
+end C730003_0.C730003_2;
+
+--==================================================================--
+
+with C730003_0;
+with C730003_0.C730003_2;
+with Report;
+
+procedure C730003 is
+begin
+
+   Report.Test ("C730003", "Check that the characteristics of a type "   &
+                           "derived from a private extension (outside "  &
+                           "the scope of the full view) are those "      &
+                           "defined by the partial view of the private " &
+                           "extension");
+
+   Check_Your_Cards:
+   declare
+      use C730003_0;
+      use C730003_0.C730003_2;
+
+      Top_Card_On_The_Deck : Graphic_Card;
+
+   begin
+
+      -- Update value in the components of the card.  There are two
+      -- component fields named View, although one is not visible for
+      -- any view of a Graphic_Card.
+
+      Update_View(Top_Card_On_The_Deck);
+
+      -- Verify that both "View" components of the card have been updated.
+
+      if Get_View(Top_Card_On_The_Deck) /= Ace_Of_Hearts then
+         Report.Failed ("Incorrect value in visible component - 1");
+      end if;
+
+      if Get_Private_View(Top_Card_On_The_Deck) /= Queen_Of_Spades
+      then
+         Report.Failed ("Incorrect value in non-visible component - 1");
+      end if;
+
+      -- Again, update the components of the card (to blank values).
+
+      Hide_From_View(Top_Card_On_The_Deck);
+
+      -- Verify that both components have been updated.
+
+      if Get_View(Top_Card_On_The_Deck) /= Read_Em_And_Weep then
+         Report.Failed ("Incorrect value in visible component - 2");
+      end if;
+
+      if Get_Private_View(Top_Card_On_The_Deck) /= Close_To_The_Vest
+      then
+         Report.Failed ("Incorrect value in non-visible component - 2");
+      end if;
+
+   exception
+      when others => Report.Failed("Exception raised in test block");
+   end Check_Your_Cards;
+
+   Report.Result;
+
+end C730003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730004.a
new file mode 100644
index 000000000..c2a23230a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730004.a
@@ -0,0 +1,327 @@
+-- C730004.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 for a type declared in a package, descendants of the package
+--      use the full view of type.  Specifically check that full view of the
+--      limited type is visible only in private descendants (children) and in
+--      the private parts and bodies of public descendants (children).
+--      Check that a limited type may be used as an out parameter outside
+--      the package that defines the type.
+--
+-- TEST DESCRIPTION:
+--      This test defines a parent package containing limited private type 
+--      definitions. Children packages are defined (one public, one private) 
+--      that use the nonlimited full view of the types defined in the private 
+--      part of the parent specification.
+--      The main declares a procedure with an out parameter that was defined
+--      as limited in the specification of the parent package.
+--
+--
+-- CHANGE HISTORY:
+--      15 Sep 95   SAIC    Initial prerelease version.
+--      23 Apr 96   SAIC    Added prefix for parameter in Call_Modify_File.
+--      02 Nov 96   SAIC    ACVC 2.1: Modified prologue and Test.Report. 
+--
+--!
+
+package C730004_0 is 
+
+   -- Full views of File_Descriptor, File_Mode, File_Name, and File_Type are
+   -- are nonlimited.
+
+   type File_Descriptor is limited private;
+
+   type File_Mode is limited private;
+
+   Active_Mode  : constant File_Mode;
+
+   type File_Name is limited private;
+
+   type File_Type is limited private;
+
+   function Next_Available_File return File_Descriptor;
+
+private
+
+   type File_Descriptor is new Integer;
+
+   Null_File    : constant File_Descriptor := 0;
+   First_File   : constant File_Descriptor := 1;
+
+   type File_Mode is 
+     (Read_Only, Write_Only, Read_Write, Archived, Corrupt, Lost);
+
+   Default_Mode : constant File_Mode       := Read_Only;
+   Active_Mode  : constant File_Mode       := Read_Write;
+
+   type File_Name is array (1 .. 6) of Character;
+
+   Null_String : File_Name := "      ";
+   String1     : File_Name := "ACVC  ";
+   String2     : File_Name := "  1995";
+
+   type File_Type is 
+     record
+        Descriptor : File_Descriptor := Null_File;
+        Mode       : File_Mode       := Default_Mode;
+        Name       : File_Name       := Null_String;
+     end record;
+
+end C730004_0;       
+
+     --=================================================================--
+
+package body C730004_0 is     
+
+   File_Count : Integer := 0;
+
+   function Next_Available_File return File_Descriptor is
+   begin
+      File_Count := File_Count + 1;
+      return (File_Descriptor(File_Count));    -- Type conversion.
+   end Next_Available_File;
+
+end C730004_0;     
+
+     --=================================================================--
+
+private
+package C730004_0.C730004_1 is                             -- private child
+
+   -- Since full view of the nontagged File_Name is nonlimited in the parent 
+   -- package, it is not limited in the private child, so concatenation is 
+   -- available.
+
+   System_File_Name :  constant File_Name
+                    := String1(1..4) & String2(5..6);
+
+   -- Since full view of the nontagged File_Type is nonlimited in the parent 
+   -- package, it is not limited in the private child, so a default expression
+   -- is available.
+
+   function New_File_Validated (File :  File_Type 
+                                     := (Descriptor => First_File,
+                                         Mode       => Active_Mode,
+                                         Name       => System_File_Name))
+     return Boolean;
+
+   -- Since full view of the nontagged File_Type is nonlimited in the parent 
+   -- package, it is not limited in the private child, so initialization
+   -- expression in an object declaration is available.
+
+   System_File      :  File_Type 
+                    := (Null_File, Read_Only, System_File_Name);
+
+
+end C730004_0.C730004_1;    
+
+     --=================================================================--
+
+package body C730004_0.C730004_1 is 
+
+   function New_File_Validated (File :  File_Type 
+                                     := (Descriptor => First_File,
+                                         Mode       => Active_Mode,
+                                         Name       => System_File_Name))
+     return Boolean is                                   
+      Result : Boolean := False;                         
+   begin                                                 
+      if (File.Descriptor > System_File.Descriptor) and  
+         (File.Mode in Read_Only .. Read_Write) and (File.Name = "ACVC95")
+      then
+         Result := True;
+      end if;
+
+      return (Result);
+
+   end New_File_Validated;
+
+end C730004_0.C730004_1;       
+
+     --=================================================================--
+
+package C730004_0.C730004_2 is                   -- public child
+
+   -- File_Type is limited here.
+
+   procedure Create_File (File : out File_Type);    
+                          
+   procedure Modify_File (File : out File_Type);
+
+   type File_Dir is limited private;
+
+   -- The following three validation functions provide the capability to 
+   -- check the limited private types defined in the parent and the
+   -- private child package from within the client program.
+                                   
+   function  Validate_Create (File : in File_Type) return Boolean;
+
+   function  Validate_Modification (File : in File_Type) 
+     return Boolean;
+
+   function  Validate_Dir (Dir : in File_Dir) return Boolean;
+
+private
+
+   -- Since full view of the nontagged File_Type is nonlimited in the parent 
+   -- package, it is not limited in the private part of the public child, so 
+   -- aggregates are available.
+
+   Child_File :  File_Type 
+              := File_Type'(Descriptor => Null_File, 
+                            Mode       => Write_Only,
+                            Name       => String2);
+                     
+   -- Since full view of the nontagged component File_Type is nonlimited in 
+   -- the parent package, it is not limited in the private part of the public 
+   -- child, so default expressions are available.
+
+   type File_Dir is 
+     record
+        Comp : File_Type := Child_File;
+     end record;
+
+end C730004_0.C730004_2;             
+
+     --=================================================================--
+
+with C730004_0.C730004_1;
+
+package body C730004_0.C730004_2 is  
+
+   procedure Create_File (File : out File_Type) is
+      New_File : File_Type;
+
+   begin
+      New_File.Descriptor := Next_Available_File;       
+      New_File.Mode       := Default_Mode;
+      New_File.Name       := C730004_0.C730004_1.System_File_Name;
+
+      if C730004_0.C730004_1.New_File_Validated (New_File) then
+         File := New_File;
+      else 
+         File := (Null_File, Lost, "MISSED");
+      end if;
+
+   end Create_File;
+
+   --------------------------------------------------------------
+   procedure Modify_File (File : out File_Type) is
+   begin
+      File.Descriptor := Next_Available_File;      
+      File.Mode       := Active_Mode;
+      File.Name       := String1;
+   end Modify_File;     
+
+   --------------------------------------------------------------
+   function  Validate_Create (File : in File_Type) return Boolean is
+   begin
+      if ((File.Descriptor /= Child_File.Descriptor) and
+          (File.Mode = Read_Only) and (File.Name = "ACVC95"))
+      then
+         return True;
+      else
+         return False;
+      end if;
+   end Validate_Create;
+  
+   ------------------------------------------------------------------------
+   function  Validate_Modification (File : in File_Type) 
+      return Boolean is      
+   begin
+      if ((File.Descriptor /= C730004_0.C730004_1.System_File.Descriptor) and 
+          (File.Mode = Read_Write) and (File.Name = "ACVC  "))
+      then
+         return True;
+      else
+         return False;
+      end if;
+   end Validate_Modification;
+
+   ------------------------------------------------------------------------
+   function  Validate_Dir (Dir : in File_Dir) return Boolean is      
+   begin
+      if ((Dir.Comp.Descriptor = C730004_0.C730004_1.System_File.Descriptor) 
+        and (Dir.Comp.Mode = Write_Only) and (Dir.Comp.Name = String2))
+      then
+         return True;
+      else
+         return False;
+      end if;
+   end Validate_Dir;
+
+end C730004_0.C730004_2;
+
+     --=================================================================--
+
+with C730004_0.C730004_2; 
+with Report;
+
+procedure C730004 is
+
+   package File      renames C730004_0;
+   package File_Ops  renames C730004_0.C730004_2;            
+
+   Validation_File : File.File_Type;     
+
+   Validation_Dir  : File_Ops.File_Dir;
+
+   ------------------------------------------------------------------------ 
+   -- Limited File_Type is allowed as an out parameter outside package File.
+
+   procedure Call_Modify_File (Modified_File : out File.File_Type) is
+   begin
+      File_Ops.Modify_File (Modified_File);
+   end Call_Modify_File;     
+  
+begin
+
+   Report.Test ("C730004", "Check that for a type declared in a package, "   &
+                           "descendants of the package use the full view "   &
+                           "of the type.  Specifically check that full "     &
+                           "view of the limited type is visible only in "    &
+                           "private children and in the private parts and "  &
+                           "bodies of public children");
+
+   File_Ops.Create_File (Validation_File);
+
+   if not File_Ops.Validate_Create (Validation_File) then
+      Report.Failed ("Incorrect creation of file");
+   end if;
+
+   Call_Modify_File (Validation_File);
+
+   if not File_Ops.Validate_Modification (Validation_File) then 
+      Report.Failed ("Incorrect modification of file");
+   end if;
+
+   if not File_Ops.Validate_Dir (Validation_Dir) then
+      Report.Failed ("Incorrect creation of directory");
+   end if;
+
+   Report.Result;
+
+end C730004; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c73002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c73002a.ada
new file mode 100644
index 000000000..8bbc4afb0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c73002a.ada
@@ -0,0 +1,110 @@
+-- C73002A.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 STATEMENTS IN A PACKAGE BODY ARE EXECUTED AFTER THE
+--    ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).
+
+
+-- RM 05/15/81
+-- JBG 9/21/83
+
+WITH REPORT;
+PROCEDURE  C73002A  IS
+
+     USE  REPORT;
+
+BEGIN
+
+     TEST( "C73002A" , "CHECK: EXECUTION OF STATEMENTS IN A PACKAGE " &
+                       "BODY FOLLOWS ELABORATION OF THE DECLARATIONS");
+
+     DECLARE
+
+          PACKAGE  P1  IS
+
+               A : INTEGER := IDENT_INT(7);
+
+               PACKAGE  P2  IS
+                    B : INTEGER := IDENT_INT(11);
+               END  P2;
+
+          END  P1;
+
+
+          PACKAGE BODY  P1  IS               --   A  AA   B  BB
+
+               AA : INTEGER := IDENT_INT(7); --   7   7  11 (11)
+
+               PACKAGE BODY  P2  IS
+                    BB : INTEGER := IDENT_INT(11);--  7  11  11
+               BEGIN
+
+                    B  := 2*B ;             --   7   7  22  11
+                    BB := 2*BB;             --   7   7  22  22
+                    A  := 5*A ;             --  35   7  22  22
+                    AA := 2*AA;             --  35  14  22  22
+
+                    IF  BB /=  22  OR
+                        AA /=  14  OR
+                        A  /=  35  OR
+                        B  /=  22
+                    THEN
+                         FAILED( "ASSIGNED VALUES INCORRECT  -  1" );
+                    END IF;
+
+               END  P2;
+
+          BEGIN
+
+               A  :=  A  + 20;              --  55  14  22  22
+               AA :=  AA + 20;              --  55  34  22  22
+
+               IF  AA /=  34  OR
+                   A  /=  55  OR
+                   P2.B /=  22
+               THEN
+                    FAILED( "ASSIGNED VALUES INCORRECT  -  2" );
+               END IF;
+
+          END  P1;
+
+
+          USE  P1;
+          USE  P2;
+
+     BEGIN
+
+          IF  A  /=  55  OR
+              B  /=  22
+          THEN
+               FAILED( "ASSIGNED VALUES INCORRECT  -  3" );
+          END IF;
+
+     END;
+
+
+     RESULT;
+
+
+END C73002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730a01.a
new file mode 100644
index 000000000..43f16f928
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730a01.a
@@ -0,0 +1,176 @@
+-- C730A01.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 tagged type declared in a package specification
+--      may be passed as a generic formal (tagged) private type to a generic
+--      package declaration. Check that the formal type may be extended with
+--      a private extension in the generic package.
+--
+--      Check that, in the instance, the private extension inherits the
+--      user-defined primitive subprograms of the tagged actual.
+--
+-- TEST DESCRIPTION:
+--      Declare a tagged type and an associated primitive subprogram in a
+--      package specification (foundation code). Declare a generic package
+--      which takes a tagged type as a formal parameter, and then extends
+--      it with a private extension (foundation code).
+--      
+--      Instantiate the generic package with the tagged type from the first
+--      package (the "generic" extension should now have inherited
+--      the primitive subprogram of the tagged type from the first
+--      package).
+-- 
+--      In the main program, call the primitive subprogram inherited by the
+--      "generic" extension, and verify the correctness of the components.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F730A000.A
+--         F730A001.A
+--      => C730A01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+with F730A001;        -- Book definitions.
+package C730A01_0 is  -- Raw data to be used in creating book elements.
+
+
+   Book_Count : constant := 3;
+
+   subtype Number_Of_Books is Integer range 1 .. Book_Count;
+
+   type Data_List is array (Number_Of_Books) of F730A001.Text_Ptr;
+
+   Title_List  : Data_List := (new String'("Wuthering Heights"),
+                               new String'("Heart of Darkness"),
+                               new String'("Ulysses"));
+
+   Author_List : Data_List := (new String'("Bronte, Emily"),
+                               new String'("Conrad, Joseph"),
+                               new String'("Joyce, James"));
+
+end C730A01_0;
+
+
+     --==================================================================--
+
+
+
+
+     --==================================================================--
+
+
+-- Library-level instantiation. Actual parameter is tagged record.
+
+with F730A001;  -- Book definitions.
+with F730A000;  -- Singly-linked list abstraction.
+package C730A01_1 is new F730A000 (Parent_Type => F730A001.Book_Type);
+
+
+     --==================================================================--
+
+
+with Report;
+
+with F730A001;   -- Book definitions.
+with C730A01_0;  -- Raw book data.
+with C730A01_1;  -- Instance.
+
+use  F730A001;   -- Primitive operations of Book_Type directly visible.
+use  C730A01_1;  -- Operations inherited by Node_Type directly visible.
+
+procedure C730A01 is
+
+
+   List_Of_Books : Priv_Node_Ptr := null;  -- Head of linked list of books.
+
+
+          --========================================================--
+
+
+   procedure Create_List (Title, Author : in     C730A01_0.Data_List;
+                          Head          : in out Priv_Node_Ptr) is
+
+      Book     : Priv_Node_Type;  -- Object of extended type.
+      Book_Ptr : Priv_Node_Ptr;
+
+   begin
+      for I in C730A01_0.Number_Of_Books loop
+         Create_Book (Title (I), Author (I), Book);    -- Call inherited
+                                                       -- operation.
+         Book_Ptr := new Priv_Node_Type'(Book);
+         Add (Book_Ptr, Head);
+      end loop;
+   end Create_List;
+
+
+          --========================================================--
+
+
+   function Bad_List_Contents return Boolean is
+      Book1_Ptr : Priv_Node_Ptr;
+      Book2_Ptr : Priv_Node_Ptr;
+      Book3_Ptr : Priv_Node_Ptr;
+   begin
+      Remove (List_Of_Books, Book1_Ptr);
+      Remove (List_Of_Books, Book2_Ptr);
+      Remove (List_Of_Books, Book3_Ptr);
+      return (Book1_Ptr.Title.all  /= "Ulysses"           or   -- Inherited
+              Book1_Ptr.Author.all /= "Joyce, James"      or   -- components
+              Book2_Ptr.Title.all  /= "Heart of Darkness" or   -- should still
+              Book2_Ptr.Author.all /= "Conrad, Joseph"    or   -- be visible in
+              Book3_Ptr.Title.all  /= "Wuthering Heights" or   -- private
+              Book3_Ptr.Author.all /= "Bronte, Emily");        -- extension.
+
+   end Bad_List_Contents;
+
+
+          --========================================================--
+
+
+begin  -- Main program.
+
+   Report.Test ("C730A01", "Inheritance of primitive operations: private " &
+                "extension of formal tagged private type; actual is " &
+                "an ultimate ancestor type");
+
+   -- Create linked list using inherited operation:
+   Create_List (C730A01_0.Title_List, C730A01_0.Author_List, List_Of_Books);
+
+   -- Verify results:
+   if Bad_List_Contents then
+      Report.Failed ("Wrong values after call to inherited operation");
+   end if;
+
+   Report.Result;
+
+end C730A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730a02.a
new file mode 100644
index 000000000..97d04b6db
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c730a02.a
@@ -0,0 +1,252 @@
+-- C730A02.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 private extension (declared in a package specification) of
+--      a tagged type (declared in a different package specification) may be
+--      passed as a generic formal (tagged) private type to a generic package
+--      declaration. Check that the formal type may be further extended with a
+--      private extension in the generic package.
+--
+--      Check that the (visible) components inherited by the "generic"
+--      extension are visible outside the generic package.
+--
+--      Check that, in the instance, the private extension inherits the
+--      user-defined primitive subprograms of the tagged actual, including
+--      those inherited by the actual from its parent.
+--
+-- TEST DESCRIPTION:
+--      Declare a tagged type and an associated primitive subprogram in a
+--      package specification (foundation code). Declare a private extension
+--      of the tagged type and an associated primitive subprogram in a second
+--      package specification. Declare a generic package which takes a tagged
+--      type as a formal parameter, and then extends it with a private
+--      extension (foundation code).
+--      
+--      Instantiate the generic package with the private extension from the
+--      second package (the "generic" extension should now have inherited
+--      the primitive subprograms of the private extension from the second
+--      package).
+-- 
+--      In the main program, call the primitive subprograms inherited by the
+--      "generic" extension. There are two: (1) Create_Book, declared for
+--      the root tagged type in the first package (inherited by the private
+--      extension of the second package, and then in turn by the "generic"
+--      extension), and (2) Update_Pages, declared for the private extension
+--      in the second package. Verify the correctness of the components.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         F730A000.A
+--         F730A001.A
+--      => C730A02.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with F730A001;        -- Book definitions.
+package C730A02_0 is  -- Extended book abstraction.
+
+
+   type Detailed_Book_Type is new F730A001.Book_Type          -- Private ext.
+     with private;                                            -- of root tagged
+                                                              -- type.
+
+   -- Inherits Create_Book from Book_Type.
+
+   procedure Update_Pages (Book  : in out Detailed_Book_Type; -- Primitive op.
+                           Pages : in     Natural);           -- of extension.
+
+
+   -- The following function is needed to verify the value of the
+   -- extension's private component. It will be inherited by extensions
+   -- of Detailed_Book_Type.
+
+   function Get_Pages (Book : in Detailed_Book_Type) return Natural;
+                                                   
+private
+
+   type Detailed_Book_Type is new F730A001.Book_Type with record
+      Pages : Natural;
+   end record;
+
+end C730A02_0;
+
+
+     --==================================================================--
+
+
+package body C730A02_0 is
+
+
+   procedure Update_Pages (Book  : in out Detailed_Book_Type;
+                           Pages : in     Natural) is
+   begin
+      Book.Pages := Pages;
+   end Update_Pages;
+
+
+   function Get_Pages (Book : in Detailed_Book_Type) return Natural is
+   begin
+      return (Book.Pages);
+   end Get_Pages;
+
+
+end C730A02_0;
+
+
+     --==================================================================--
+
+
+with F730A001;        -- Book definitions. 
+package C730A02_1 is  -- Raw data to be used in creating book elements.
+
+
+   Book_Count : constant := 3;
+
+   subtype Number_Of_Books is Integer range 1 .. Book_Count;
+
+   type Data_List   is array (Number_Of_Books) of F730A001.Text_Ptr;
+   type Page_Counts is array (Number_Of_Books) of Natural;
+
+   Title_List  : Data_List   := (new String'("Wuthering Heights"),
+                                 new String'("Heart of Darkness"),
+                                 new String'("Ulysses"));
+
+   Author_List : Data_List   := (new String'("Bronte, Emily"),
+                                 new String'("Conrad, Joseph"),
+                                 new String'("Joyce, James"));
+
+   Page_List   : Page_Counts := (237, 215, 456);
+
+end C730A02_1;
+
+
+-- No body for C730A02_1.
+
+
+     --==================================================================--
+
+
+-- Library-level instantiation. Actual parameter is private extension.
+
+with C730A02_0;  -- Extended book abstraction.
+with F730A000;   -- Singly-linked list abstraction.
+package C730A02_2 is new F730A000
+  (Parent_Type => C730A02_0.Detailed_Book_Type);
+
+
+     --==================================================================--
+
+
+with Report;
+
+with C730A02_0; -- Extended book abstraction.
+with C730A02_1; -- Raw book data.
+with C730A02_2; -- Instance.
+
+use  C730A02_0; -- Primitive operations of Detailed_Book_Type directly visible.
+use  C730A02_2; -- Operations inherited by Priv_Node_Type directly visible.
+
+procedure C730A02 is
+
+
+   List_Of_Books : Priv_Node_Ptr := null;  -- Head of linked list of books.
+
+
+          --========================================================--
+
+
+   procedure Create_List (Title, Author : in     C730A02_1.Data_List;
+                          Pages         : in     C730A02_1.Page_Counts;
+                          Head          : in out Priv_Node_Ptr) is
+
+      Book     : Priv_Node_Type;  -- Object of extended type.
+      Book_Ptr : Priv_Node_Ptr;
+
+   begin
+      for I in C730A02_1.Number_Of_Books loop
+         Create_Book (Title (I), Author (I), Book);    -- Call twice-inherited
+                                                       -- operation.
+         Update_Pages (Book, Pages (I));               -- Call inherited op.
+         Book_Ptr := new Priv_Node_Type'(Book);
+         Add (Book_Ptr, Head);
+      end loop;
+   end Create_List;
+
+
+          --========================================================--
+
+
+   function Bad_List_Contents return Boolean is
+      Book1_Ptr : Priv_Node_Ptr;
+      Book2_Ptr : Priv_Node_Ptr;
+      Book3_Ptr : Priv_Node_Ptr;
+   begin
+
+      Remove (List_Of_Books, Book1_Ptr);
+      Remove (List_Of_Books, Book2_Ptr);
+      Remove (List_Of_Books, Book3_Ptr);
+
+      return (Book1_Ptr.Title.all   /= "Ulysses"           or   -- Inherited
+              Book1_Ptr.Author.all  /= "Joyce, James"      or   -- components
+              Book2_Ptr.Title.all   /= "Heart of Darkness" or   -- should still
+              Book2_Ptr.Author.all  /= "Conrad, Joseph"    or   -- be visible
+              Book3_Ptr.Title.all   /= "Wuthering Heights" or   -- in private
+              Book3_Ptr.Author.all  /= "Bronte, Emily"     or   -- "generic"
+                                                                -- extension.
+              -- Call inherited operations using dereferenced pointers.
+              Get_Pages (Book1_Ptr.all) /= 456             or
+              Get_Pages (Book2_Ptr.all) /= 215             or
+              Get_Pages (Book3_Ptr.all) /= 237);
+
+   end Bad_List_Contents;
+
+
+          --========================================================--
+
+
+begin  -- Main program.
+
+   Report.Test ("C730A02", "Inheritance of primitive operations: private " &
+                "extension of formal tagged private type; actual is " &
+                "a private extension");
+
+   -- Create linked list using inherited operation:
+   Create_List (C730A02_1.Title_List, C730A02_1.Author_List,
+                C730A02_1.Page_List,  List_Of_Books);
+
+   -- Verify results:
+   if Bad_List_Contents then
+      Report.Failed ("Wrong values after call to inherited operations");
+   end if;
+
+   Report.Result;
+
+end C730A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c731001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c731001.a
new file mode 100644
index 000000000..0cfce32bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c731001.a
@@ -0,0 +1,407 @@
+-- C731001.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE
+--     Check that inherited operations can be overridden, even when they are
+--     inherited in a body.
+--     The test cases here are inspired by the AARM examples given in
+--     the discussion of AARM-7.3.1(7.a-7.v).
+--     This discussion was confirmed by AI95-00035.
+--
+-- TEST DESCRIPTION
+--     See AARM-7.3.1.
+--
+-- CHANGE HISTORY:
+--      29 JUN 1999   RAD   Initial Version
+--      23 SEP 1999   RLB   Improved comments, renamed, issued.
+--      20 AUG 2001   RLB   Corrected 'verbose' flag.
+--
+--!
+
+with Report; use Report; pragma Elaborate_All(Report);
+package C731001_1 is
+    pragma Elaborate_Body;
+private
+    procedure Check_String(X, Y: String);
+    function Check_String(X, Y: String) return String;
+        -- This one is a function, so we can call it in package specs.
+end C731001_1;
+
+package body C731001_1 is
+
+    Verbose: Boolean := False;
+
+    procedure Check_String(X, Y: String) is
+    begin
+        if Verbose then
+            Comment("""" & X & """ = """ & Y & """?");
+        end if;
+        if X /= Y then
+            Failed("""" & X & """ should be """ & Y & """");
+        end if;
+    end Check_String;
+
+    function Check_String(X, Y: String) return String is
+    begin
+        Check_String(X, Y);
+        return X;
+    end Check_String;
+
+end C731001_1;
+
+private package C731001_1.Parent is
+
+    procedure Call_Main;
+
+    type Root is tagged null record;
+    subtype Renames_Root is Root;
+    subtype Root_Class is Renames_Root'Class;
+    function Make return Root;
+    function Op1(X: Root) return String;
+    function Call_Op2(X: Root'Class) return String;
+private
+    function Op2(X: Root) return String;
+end C731001_1.Parent;
+
+procedure C731001_1.Parent.Main;
+
+with C731001_1.Parent.Main;
+package body C731001_1.Parent is
+
+    procedure Call_Main is
+    begin
+        Main;
+    end Call_Main;
+
+    function Make return Root is
+        Result: Root;
+    begin
+        return Result;
+    end Make;
+
+    function Op1(X: Root) return String is
+    begin
+        return "Parent.Op1 body";
+    end Op1;
+
+    function Op2(X: Root) return String is
+    begin
+        return "Parent.Op2 body";
+    end Op2;
+
+    function Call_Op2(X: Root'Class) return String is
+    begin
+        return Op2(X);
+    end Call_Op2;
+
+begin
+
+    Check_String(Op1(Root'(Make)), "Parent.Op1 body");
+    Check_String(Op1(Root_Class(Root'(Make))), "Parent.Op1 body");
+
+    Check_String(Op2(Root'(Make)), "Parent.Op2 body");
+    Check_String(Op2(Root_Class(Root'(Make))), "Parent.Op2 body");
+
+end C731001_1.Parent;
+
+with C731001_1.Parent; use C731001_1.Parent;
+private package C731001_1.Unrelated is
+
+    type T2 is new Root with null record;
+    subtype T2_Class is T2'Class;
+    function Make return T2;
+    function Op2(X: T2) return String;
+end C731001_1.Unrelated;
+
+with C731001_1.Parent; use C731001_1.Parent;
+    pragma Elaborate(C731001_1.Parent);
+package body C731001_1.Unrelated is
+
+    function Make return T2 is
+        Result: T2;
+    begin
+        return Result;
+    end Make;
+
+    function Op2(X: T2) return String is
+    begin
+        return "Unrelated.Op2 body";
+    end Op2;
+begin
+
+    Check_String(Op1(T2'(Make)), "Parent.Op1 body");
+    Check_String(Op1(T2_Class(T2'(Make))), "Parent.Op1 body");
+    Check_String(Op1(Root_Class(T2'(Make))), "Parent.Op1 body");
+
+    Check_String(Op2(T2'(Make)), "Unrelated.Op2 body");
+    Check_String(Op2(T2_Class(T2'(Make))), "Unrelated.Op2 body");
+    Check_String(Call_Op2(T2'(Make)), "Parent.Op2 body");
+    Check_String(Call_Op2(T2_Class(T2'(Make))), "Parent.Op2 body");
+    Check_String(Call_Op2(Root_Class(T2'(Make))), "Parent.Op2 body");
+
+end C731001_1.Unrelated;
+
+package C731001_1.Parent.Child is
+    pragma Elaborate_Body;
+
+    type T3 is new Root with null record;
+    subtype T3_Class is T3'Class;
+    function Make return T3;
+
+    T3_Obj: T3;
+    T3_Class_Obj: T3_Class := T3_Obj;
+    T3_Root_Class_Obj: Root_Class := T3_Obj;
+
+    X3: constant String :=
+      Check_String(Op1(T3_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
+
+      Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body");
+
+    package Nested is
+        type T4 is new Root with null record;
+        subtype T4_Class is T4'Class;
+        function Make return T4;
+
+        T4_Obj: T4;
+        T4_Class_Obj: T4_Class := T4_Obj;
+        T4_Root_Class_Obj: Root_Class := T4_Obj;
+
+        X4: constant String :=
+          Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+          Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+          Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+
+          Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+          Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+          Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+
+    private
+
+        XX4: constant String :=
+          Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+          Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+          Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+
+          Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+          Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+          Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+
+    end Nested;
+
+    use Nested;
+
+    XXX4: constant String :=
+      Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+
+      Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+
+private
+
+    XX3: constant String :=
+      Check_String(Op1(T3_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
+
+      Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body") &
+
+      Check_String(Op2(T3_Obj), "Parent.Op2 body") &
+      Check_String(Op2(T3_Class_Obj), "Parent.Op2 body") &
+      Check_String(Op2(T3_Root_Class_Obj), "Parent.Op2 body");
+
+    XXXX4: constant String :=
+      Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+
+      Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
+
+      Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+
+end C731001_1.Parent.Child;
+
+with C731001_1.Unrelated; use C731001_1.Unrelated;
+    pragma Elaborate(C731001_1.Unrelated);
+package body C731001_1.Parent.Child is
+
+    XXX3: constant String :=
+      Check_String(Op1(T3_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
+
+      Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body") &
+
+      Check_String(Op2(T3_Obj), "Parent.Op2 body") &
+      Check_String(Op2(T3_Class_Obj), "Parent.Op2 body") &
+      Check_String(Op2(T3_Root_Class_Obj), "Parent.Op2 body");
+
+    XXXXX4: constant String :=
+      Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+
+      Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
+
+      Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+
+    function Make return T3 is
+        Result: T3;
+    begin
+        return Result;
+    end Make;
+
+    package body Nested is
+        function Make return T4 is
+            Result: T4;
+        begin
+            return Result;
+        end Make;
+
+        XXXXXX4: constant String :=
+          Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+          Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+          Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+
+          Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+          Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+          Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
+
+          Check_String(Op2(T4_Obj), "Parent.Op2 body") &
+          Check_String(Op2(T4_Class_Obj), "Parent.Op2 body") &
+          Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+
+    end Nested;
+
+    type T5 is new T2 with null record;
+    subtype T5_Class is T5'Class;
+    function Make return T5;
+
+    function Make return T5 is
+        Result: T5;
+    begin
+        return Result;
+    end Make;
+
+    XXXXXXX4: constant String :=
+      Check_String(Op1(T4_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
+      Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
+
+      Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
+      Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
+
+      Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+
+end C731001_1.Parent.Child;
+
+procedure C731001_1.Main;
+
+with C731001_1.Parent;
+procedure C731001_1.Main is
+begin
+    C731001_1.Parent.Call_Main;
+end C731001_1.Main;
+
+with C731001_1.Parent.Child;
+    use C731001_1.Parent;
+    use C731001_1.Parent.Child;
+    use C731001_1.Parent.Child.Nested;
+with C731001_1.Unrelated; use C731001_1.Unrelated;
+procedure C731001_1.Parent.Main is
+
+    Root_Obj: Root := Make;
+    Root_Class_Obj: Root_Class := Root'(Make);
+
+    T2_Obj: T2 := Make;
+    T2_Class_Obj: T2_Class := T2_Obj;
+    T2_Root_Class_Obj: Root_Class := T2_Class_Obj;
+
+    T3_Obj: T3 := Make;
+    T3_Class_Obj: T3_Class := T3_Obj;
+    T3_Root_Class_Obj: Root_Class := T3_Obj;
+
+    T4_Obj: T4 := Make;
+    T4_Class_Obj: T4_Class := T4_Obj;
+    T4_Root_Class_Obj: Root_Class := T4_Obj;
+
+begin
+    Test("C731001_1", "Check that inherited operations can be overridden, even"
+                    & " when they are inherited in a body");
+
+    Check_String(Op1(Root_Obj), "Parent.Op1 body");
+    Check_String(Op1(Root_Class_Obj), "Parent.Op1 body");
+
+    Check_String(Call_Op2(Root_Obj), "Parent.Op2 body");
+    Check_String(Call_Op2(Root_Class_Obj), "Parent.Op2 body");
+
+    Check_String(Op1(T2_Obj), "Parent.Op1 body");
+    Check_String(Op1(T2_Class_Obj), "Parent.Op1 body");
+    Check_String(Op1(T2_Root_Class_Obj), "Parent.Op1 body");
+
+    Check_String(Op2(T2_Obj), "Unrelated.Op2 body");
+    Check_String(Op2(T2_Class_Obj), "Unrelated.Op2 body");
+    Check_String(Call_Op2(T2_Obj), "Parent.Op2 body");
+    Check_String(Call_Op2(T2_Class_Obj), "Parent.Op2 body");
+    Check_String(Call_Op2(T2_Root_Class_Obj), "Parent.Op2 body");
+
+    Check_String(Op1(T3_Obj), "Parent.Op1 body");
+    Check_String(Op1(T3_Class_Obj), "Parent.Op1 body");
+    Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body");
+
+    Check_String(Call_Op2(T3_Obj), "Parent.Op2 body");
+    Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body");
+    Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body");
+
+    Check_String(Op1(T4_Obj), "Parent.Op1 body");
+    Check_String(Op1(T4_Class_Obj), "Parent.Op1 body");
+    Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body");
+
+    Check_String(Call_Op2(T4_Obj), "Parent.Op2 body");
+    Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body");
+    Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
+
+    Result;
+end C731001_1.Parent.Main;
+
+with C731001_1.Main;
+procedure C731001 is
+begin
+    C731001_1.Main;
+end C731001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74004a.ada
new file mode 100644
index 000000000..f2a016b09
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74004a.ada
@@ -0,0 +1,375 @@
+-- C74004A.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 OPERATIONS DEPENDING ON THE FULL DECLARATION OF A
+--     PRIVATE TYPE ARE AVAILABLE WITHIN THE PACKAGE BODY.
+
+-- HISTORY:
+--     BCB 04/05/88  CREATED ORIGINAL TEST.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C74004A IS
+
+     PACKAGE P IS
+          TYPE PR IS PRIVATE;
+          TYPE ARR1 IS LIMITED PRIVATE;
+          TYPE ARR2 IS PRIVATE;
+          TYPE REC (D : INTEGER) IS PRIVATE;
+          TYPE ACC IS PRIVATE;
+          TYPE TSK IS LIMITED PRIVATE;
+          TYPE FLT IS LIMITED PRIVATE;
+          TYPE FIX IS LIMITED PRIVATE;
+
+          TASK TYPE T IS
+               ENTRY ONE(V : IN OUT INTEGER);
+          END T;
+
+          PROCEDURE CHECK (V : ARR2);
+     PRIVATE
+          TYPE PR IS NEW INTEGER;
+
+          TYPE ARR1 IS ARRAY(1..5) OF INTEGER;
+
+          TYPE ARR2 IS ARRAY(1..5) OF BOOLEAN;
+
+          TYPE REC (D : INTEGER) IS RECORD
+               COMP1 : INTEGER;
+               COMP2 : BOOLEAN;
+          END RECORD;
+
+          TYPE ACC IS ACCESS INTEGER;
+
+          TYPE TSK IS NEW T;
+
+          TYPE FLT IS DIGITS 5;
+
+          TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
+     END P;
+
+     PACKAGE BODY P IS
+          X1, X2, X3 : PR;
+          BOOL : BOOLEAN := IDENT_BOOL(FALSE);
+          VAL : INTEGER := IDENT_INT(0);
+          FVAL : FLOAT := 0.0;
+          ST : STRING(1..2);
+          O1 : ARR1 := (1,2,3,4,5);
+          Y1 : ARR2 := (FALSE,TRUE,FALSE,TRUE,FALSE);
+          Y2 : ARR2 := (OTHERS => TRUE);
+          Y3 : ARR2 := (OTHERS => FALSE);
+          Z1 : REC(0) := (0,1,FALSE);
+          W1, W2 : ACC := NEW INTEGER'(0);
+          V1 : TSK;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT ONE(V : IN OUT INTEGER) DO
+                    V := IDENT_INT(10);
+               END ONE;
+          END T;
+
+          PROCEDURE CHECK (V : ARR2) IS
+          BEGIN
+               IF V /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
+                    FAILED ("IMPROPER VALUE PASSED AS AGGREGATE");
+               END IF;
+          END CHECK;
+     BEGIN
+          TEST ("C74004A", "CHECK THAT OPERATIONS DEPENDING ON THE " &
+                           "FULL DECLARATION OF A PRIVATE TYPE ARE " &
+                           "AVAILABLE WITHIN THE PACKAGE BODY");
+
+          X1 := 10;
+          X2 := 5;
+
+          X3 := X1 + X2;
+
+          IF X3 /= 15 THEN
+               FAILED ("IMPROPER RESULT FROM ADDITION OPERATOR");
+          END IF;
+
+          X3 := X1 - X2;
+
+          IF X3 /= 5 THEN
+               FAILED ("IMPROPER RESULT FROM SUBTRACTION OPERATOR");
+          END IF;
+
+          X3 := X1 * X2;
+
+          IF X3 /= 50 THEN
+               FAILED ("IMPROPER RESULT FROM MULTIPLICATION OPERATOR");
+          END IF;
+
+          X3 := X1 / X2;
+
+          IF X3 /= 2 THEN
+               FAILED ("IMPROPER RESULT FROM DIVISION OPERATOR");
+          END IF;
+
+          X3 := X1 ** 2;
+
+          IF X3 /= 100 THEN
+               FAILED ("IMPROPER RESULT FROM EXPONENTIATION OPERATOR");
+          END IF;
+
+          BOOL := X1 < X2;
+
+          IF BOOL THEN
+               FAILED ("IMPROPER RESULT FROM LESS THAN OPERATOR");
+          END IF;
+
+          BOOL := X1 > X2;
+
+          IF NOT BOOL THEN
+               FAILED ("IMPROPER RESULT FROM GREATER THAN OPERATOR");
+          END IF;
+
+          BOOL := X1 <= X2;
+
+          IF BOOL THEN
+               FAILED ("IMPROPER RESULT FROM LESS THAN OR EQUAL TO " &
+                       "OPERATOR");
+          END IF;
+
+          BOOL := X1 >= X2;
+
+          IF NOT BOOL THEN
+               FAILED ("IMPROPER RESULT FROM GREATER THAN OR EQUAL " &
+                       "TO OPERATOR");
+          END IF;
+
+          X3 := X1 MOD X2;
+
+          IF X3 /= 0 THEN
+               FAILED ("IMPROPER RESULT FROM MOD OPERATOR");
+          END IF;
+
+          X3 := X1 REM X2;
+
+          IF X3 /= 0 THEN
+               FAILED ("IMPROPER RESULT FROM REM OPERATOR");
+          END IF;
+
+          X3 := ABS(X1);
+
+          IF X3 /= 10 THEN
+               FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 1");
+          END IF;
+
+          X1 := -10;
+
+          X3 := ABS(X1);
+
+          IF X3 /= 10 THEN
+               FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 2");
+          END IF;
+
+          X3 := PR'BASE'FIRST;
+
+          IF X3 /= PR(INTEGER'FIRST) THEN
+               FAILED ("IMPROPER RESULT FROM 'BASE'FIRST");
+          END IF;
+
+          X3 := PR'FIRST;
+
+          IF X3 /= PR(INTEGER'FIRST) THEN
+               FAILED ("IMPROPER RESULT FROM 'FIRST");
+          END IF;
+
+          VAL := PR'WIDTH;
+
+          IF NOT EQUAL(VAL,INTEGER'WIDTH) THEN
+               FAILED ("IMPROPER RESULT FROM 'WIDTH");
+          END IF;
+
+          VAL := PR'POS(X3);
+
+          IF NOT EQUAL(VAL,INTEGER'FIRST) THEN
+               FAILED ("IMPROPER RESULT FROM 'POS");
+          END IF;
+
+          X3 := PR'VAL(VAL);
+
+          IF X3 /= PR(INTEGER'FIRST) THEN
+               FAILED ("IMPROPER RESULT FROM 'VAL");
+          END IF;
+
+          X3 := PR'SUCC(X2);
+
+          IF X3 /= 6 THEN
+               FAILED ("IMPROPER RESULT FROM 'SUCC");
+          END IF;
+
+          X3 := PR'PRED(X2);
+
+          IF X3 /= 4 THEN
+               FAILED ("IMPROPER RESULT FROM 'PRED");
+          END IF;
+
+          ST := PR'IMAGE(X3);
+
+          IF ST /= INTEGER'IMAGE(INTEGER(X3)) THEN
+               FAILED ("IMPROPER RESULT FROM 'IMAGE");
+          END IF;
+
+          X3 := PR'VALUE(ST);
+
+          IF X3 /= PR(INTEGER'VALUE(ST)) THEN
+               FAILED ("IMPROPER RESULT FROM 'VALUE");
+          END IF;
+
+          CHECK ((TRUE,FALSE,TRUE,FALSE,TRUE));
+
+          IF O1(2) /= IDENT_INT(2) THEN
+               FAILED ("IMPROPER VALUE FROM INDEXING");
+          END IF;
+
+          IF O1(2..4) /= (2,3,4) THEN
+               FAILED ("IMPROPER VALUES FROM SLICING");
+          END IF;
+
+          IF VAL IN O1'RANGE THEN
+               FAILED ("IMPROPER RESULT FROM 'RANGE");
+          END IF;
+
+          VAL := O1'LENGTH;
+
+          IF NOT EQUAL(VAL,5) THEN
+               FAILED ("IMPROPER RESULT FROM 'LENGTH");
+          END IF;
+
+          Y3 := Y1(1..2) & Y2(3..5);
+
+          IF Y3 /= (FALSE,TRUE,TRUE,TRUE,TRUE) THEN
+               FAILED ("IMPROPER RESULT FROM CATENATION");
+          END IF;
+
+          Y3 := NOT Y1;
+
+          IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
+               FAILED ("IMPROPER RESULT FROM NOT OPERATOR");
+          END IF;
+
+          Y3 := Y1 AND Y2;
+
+          IF Y3 /= (FALSE,TRUE,FALSE,TRUE,FALSE) THEN
+               FAILED ("IMPROPER RESULT FROM AND OPERATOR");
+          END IF;
+
+          Y3 := Y1 OR Y2;
+
+          IF Y3 /= (TRUE,TRUE,TRUE,TRUE,TRUE) THEN
+               FAILED ("IMPROPER RESULT FROM OR OPERATOR");
+          END IF;
+
+          Y3 := Y1 XOR Y2;
+
+          IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
+               FAILED ("IMPROPER RESULT FROM XOR OPERATOR");
+          END IF;
+
+          VAL := Z1.COMP1;
+
+          IF NOT EQUAL(VAL,1) THEN
+               FAILED ("IMPROPER RESULT FROM SELECTION OF RECORD " &
+                       "COMPONENTS");
+          END IF;
+
+          W1 := NEW INTEGER'(0);
+
+          IF NOT EQUAL(W1.ALL,0) THEN
+               FAILED ("IMPROPER RESULT FROM ALLOCATION");
+          END IF;
+
+          W1 := NULL;
+
+          IF W1 /= NULL THEN
+               FAILED ("IMPROPER RESULT FROM NULL LITERAL");
+          END IF;
+
+          VAL := W2.ALL;
+
+          IF NOT EQUAL(VAL,0) THEN
+               FAILED ("IMPROPER RESULT FROM SELECTED COMPONENT");
+          END IF;
+
+          BOOL := V1'CALLABLE;
+
+          IF NOT BOOL THEN
+               FAILED ("IMPROPER RESULT FROM 'CALLABLE");
+          END IF;
+
+          BOOL := V1'TERMINATED;
+
+          IF BOOL THEN
+               FAILED ("IMPROPER RESULT FROM 'TERMINATED");
+          END IF;
+
+          V1.ONE(VAL);
+
+          IF NOT EQUAL(VAL,10) THEN
+               FAILED ("IMPROPER RESULT RETURNED FROM ENTRY SELECTION");
+          END IF;
+
+          IF NOT (FLT(1.0) IN FLT) THEN
+               FAILED ("IMPROPER RESULT FROM IMPLICIT CONVERSION");
+          END IF;
+
+          VAL := FLT'DIGITS;
+
+          IF NOT EQUAL(VAL,5) THEN
+               FAILED ("IMPROPER RESULT FROM 'DIGITS");
+          END IF;
+
+          BOOL := FLT'MACHINE_ROUNDS;
+
+          BOOL := FLT'MACHINE_OVERFLOWS;
+
+          VAL := FLT'MACHINE_RADIX;
+
+          VAL := FLT'MACHINE_MANTISSA;
+
+          VAL := FLT'MACHINE_EMAX;
+
+          VAL := FLT'MACHINE_EMIN;
+
+          FVAL := FIX'DELTA;
+
+          IF FVAL /= 2.0**(-1) THEN
+               FAILED ("IMPROPER RESULT FROM 'DELTA");
+          END IF;
+
+          VAL := FIX'FORE;
+
+          VAL := FIX'AFT;
+
+     END P;
+
+     USE P;
+
+BEGIN
+     RESULT;
+END C74004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74203a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74203a.ada
new file mode 100644
index 000000000..82cfe9269
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74203a.ada
@@ -0,0 +1,263 @@
+-- C74203A.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 MEMBERSHIP TESTS, QUALIFICATION, AND EXPLICIT
+--     CONVERSION ARE AVAILABLE FOR LIMITED AND NON-LIMITED PRIVATE
+--     TYPES.  INCLUDE TYPES WITH DISCRIMINANTS AND TYPES
+--     WITH LIMITED COMPONENTS.
+
+-- HISTORY:
+--     BCB 03/10/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C74203A IS
+
+     PACKAGE PP IS
+          TYPE LIM IS LIMITED PRIVATE;
+          PROCEDURE INIT (Z1 : OUT LIM; Z2 : INTEGER);
+
+          TYPE A IS PRIVATE;
+          SUBTYPE SUBA IS A;
+          A1 : CONSTANT A;
+
+          TYPE B IS LIMITED PRIVATE;
+          B1 : CONSTANT B;
+
+          TYPE C IS PRIVATE;
+          C1 : CONSTANT C;
+
+          TYPE D IS LIMITED PRIVATE;
+          D1 : CONSTANT D;
+
+          TYPE E (DISC1 : INTEGER := 5) IS PRIVATE;
+          SUBTYPE SUBE IS E;
+          E1 : CONSTANT E;
+
+          TYPE F (DISC2 : INTEGER := 15) IS LIMITED PRIVATE;
+          F1 : CONSTANT F;
+
+          TYPE G (DISC3 : INTEGER) IS PRIVATE;
+          G1 : CONSTANT G;
+
+          TYPE H (DISC4 : INTEGER) IS LIMITED PRIVATE;
+          H1 : CONSTANT H;
+
+          TYPE I IS RECORD
+               COMPI : LIM;
+          END RECORD;
+          SUBTYPE SUBI IS I;
+
+          TYPE J IS ARRAY(1..5) OF LIM;
+          SUBTYPE SUBJ IS J;
+
+          TYPE S1 IS (VINCE, TOM, PHIL, JODIE, ROSA, TERESA);
+          TYPE S2 IS (THIS, THAT, THESE, THOSE, THEM);
+          TYPE S3 IS RANGE 1 .. 100;
+          TYPE S4 IS RANGE 1 .. 100;
+     PRIVATE
+          TYPE LIM IS RANGE 1 .. 100;
+
+          TYPE A IS (RED, BLUE, GREEN, YELLOW, BLACK, WHITE);
+          A1 : CONSTANT A := BLUE;
+
+          TYPE B IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
+          B1 : CONSTANT B := THREE;
+
+          TYPE C IS RANGE 1 .. 100;
+          C1 : CONSTANT C := 50;
+
+          TYPE D IS RANGE 1 .. 100;
+          D1 : CONSTANT D := 50;
+
+          TYPE E (DISC1 : INTEGER := 5) IS RECORD
+               COMPE : S1;
+          END RECORD;
+          E1 : CONSTANT E := (DISC1 => 5, COMPE => TOM);
+
+          TYPE F (DISC2 : INTEGER := 15) IS RECORD
+               COMPF : S2;
+          END RECORD;
+          F1 : CONSTANT F := (DISC2 => 15, COMPF => THAT);
+
+          TYPE G (DISC3 : INTEGER) IS RECORD
+               COMPG : S3;
+          END RECORD;
+          G1 : CONSTANT G := (DISC3 => 25, COMPG => 50);
+
+          TYPE H (DISC4 : INTEGER) IS RECORD
+               COMPH : S4;
+          END RECORD;
+          H1 : CONSTANT H := (DISC4 => 30, COMPH => 50);
+     END PP;
+
+     USE PP;
+
+     AVAR : SUBA := A1;
+     EVAR : SUBE := E1;
+
+     IVAR : SUBI;
+     JVAR : SUBJ;
+
+     PACKAGE BODY PP IS
+          PROCEDURE INIT (Z1 : OUT LIM; Z2 : INTEGER) IS
+          BEGIN
+               Z1 := LIM (Z2);
+          END INIT;
+     BEGIN
+          NULL;
+     END PP;
+
+     PROCEDURE QUAL_PRIV (W : A) IS
+     BEGIN
+          NULL;
+     END QUAL_PRIV;
+
+     PROCEDURE QUAL_LIM_PRIV (X : B) IS
+     BEGIN
+          NULL;
+     END QUAL_LIM_PRIV;
+
+     PROCEDURE EXPL_CONV_PRIV_1 (Y : C) IS
+     BEGIN
+          NULL;
+     END EXPL_CONV_PRIV_1;
+
+     PROCEDURE EXPL_CONV_LIM_PRIV_1 (Z : D) IS
+     BEGIN
+          NULL;
+     END EXPL_CONV_LIM_PRIV_1;
+
+     PROCEDURE EXPL_CONV_PRIV_2 (Y2 : G) IS
+     BEGIN
+          NULL;
+     END EXPL_CONV_PRIV_2;
+
+     PROCEDURE EXPL_CONV_LIM_PRIV_2 (Z2 : H) IS
+     BEGIN
+          NULL;
+     END EXPL_CONV_LIM_PRIV_2;
+
+     PROCEDURE EXPL_CONV_PRIV_3 (Y3 : I) IS
+     BEGIN
+          NULL;
+     END EXPL_CONV_PRIV_3;
+
+     PROCEDURE EXPL_CONV_PRIV_4 (Y4 : J) IS
+     BEGIN
+          NULL;
+     END EXPL_CONV_PRIV_4;
+
+BEGIN
+     TEST ("C74203A", "CHECK THAT MEMBERSHIP TESTS, QUALIFICATION, " &
+                      "AND EXPLICIT CONVERSION ARE AVAILABLE FOR " &
+                      "LIMITED AND NON-LIMITED PRIVATE TYPES.  " &
+                      "INCLUDE TYPES WITH DISCRIMINANTS AND " &
+                      "TYPES WITH LIMITED COMPONENTS");
+
+     INIT (IVAR.COMPI, 50);
+
+     FOR K IN IDENT_INT (1) .. IDENT_INT (5) LOOP
+          INIT (JVAR(K), 25);
+     END LOOP;
+
+     IF NOT (AVAR IN A) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                  "PRIVATE TYPE - 1");
+     END IF;
+
+     IF (AVAR NOT IN A) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                  "PRIVATE TYPE - 1");
+     END IF;
+
+     IF NOT (B1 IN B) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                  "LIMITED PRIVATE TYPE - 1");
+     END IF;
+
+     IF (B1 NOT IN B) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                  "LIMITED PRIVATE TYPE - 1");
+     END IF;
+
+     QUAL_PRIV (A'(AVAR));
+
+     QUAL_LIM_PRIV (B'(B1));
+
+     EXPL_CONV_PRIV_1 (C(C1));
+
+     EXPL_CONV_LIM_PRIV_1 (D(D1));
+
+     IF NOT (EVAR IN E) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                  "PRIVATE TYPE - 2");
+     END IF;
+
+     IF (EVAR NOT IN E) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                  "PRIVATE TYPE - 2");
+     END IF;
+
+     IF NOT (F1 IN F) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                  "LIMITED PRIVATE TYPE - 2");
+     END IF;
+
+     IF (F1 NOT IN F) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                  "LIMITED PRIVATE TYPE - 2");
+     END IF;
+
+     EXPL_CONV_PRIV_2 (G(G1));
+
+     EXPL_CONV_LIM_PRIV_2 (H(H1));
+
+     IF NOT (IVAR IN I) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                  "PRIVATE TYPE - 3");
+     END IF;
+
+     IF (IVAR NOT IN I) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                  "PRIVATE TYPE - 3");
+     END IF;
+
+     EXPL_CONV_PRIV_3 (I(IVAR));
+
+     IF NOT (JVAR IN J) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'IN' FOR " &
+                  "PRIVATE TYPE - 4");
+     END IF;
+
+     IF (JVAR NOT IN J) THEN
+          FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST 'NOT IN' FOR " &
+                  "PRIVATE TYPE - 4");
+     END IF;
+
+     EXPL_CONV_PRIV_4 (J(JVAR));
+
+     RESULT;
+END C74203A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74206a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74206a.ada
new file mode 100644
index 000000000..6a0dfbfc6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74206a.ada
@@ -0,0 +1,144 @@
+-- C74206A.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 COMPOSITE TYPE IS DECLARED IN THE PACKAGE AS A
+-- PRIVATE TYPE AND CONTAINS A COMPONENT OF THE PRIVATE TYPE, OPERATIONS
+-- OF THE COMPOSITE TYPE WHICH DO NOT DEPEND ON CHARACTERISTICS OF THE
+-- PRIVATE TYPE ARE AVAILABLE AFTER THE FULL DECLARATION OF THE PRIVATE
+-- TYPE, BUT BEFORE THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE
+-- DECLARATION OF THE COMPOSITE TYPE THAT IS AFTER THE FULL DECLARATION
+-- OF THE PRIVATE TYPE.  IN PARTICULAR, CHECK FOR THE FOLLOWING :
+
+--   'FIRST, 'LAST, 'RANGE, AND 'LENGTH FOR ARRAY TYPES
+--   SELECTED COMPONENTS FOR DISCRIMINANTS AND COMPONENTS OF RECORDS
+--   INDEXED COMPONENTS AND SLICES FOR ARRAYS
+
+-- DSJ 5/5/83
+-- JBG 3/8/84
+
+WITH REPORT; 
+PROCEDURE C74206A IS
+
+     USE REPORT; 
+
+BEGIN
+
+     TEST("C74206A", "CHECK THAT ADDITIONAL OPERATIONS FOR "
+                   & "COMPOSITE TYPES OF PRIVATE TYPES ARE "
+                   & "AVAILABLE AT THE EARLIEST PLACE AFTER THE "
+                   & "FULL DECLARATION OF THE PRIVATE TYPE EVEN "
+                   & "IF BEFORE THE EARLIEST PLACE WITHIN THE "
+                   & "IMMEDIATE SCOPE OF THE COMPOSITE TYPE"); 
+
+     DECLARE
+
+          PACKAGE PACK1 IS
+               TYPE P1  IS PRIVATE; 
+               TYPE LP1 IS LIMITED PRIVATE; 
+
+               PACKAGE PACK_LP IS
+                    TYPE LP_ARR IS ARRAY (1 .. 2) OF LP1; 
+                    TYPE LP_REC (D : INTEGER) IS
+                         RECORD
+                              C1, C2 : LP1; 
+                         END RECORD; 
+               END PACK_LP; 
+
+               PACKAGE PACK2 IS
+                    TYPE ARR IS ARRAY ( 1 .. 2 ) OF P1; 
+                    TYPE REC (D : INTEGER) IS
+                         RECORD
+                              C1, C2 : P1; 
+                         END RECORD; 
+               END PACK2; 
+          PRIVATE
+               TYPE P1  IS NEW BOOLEAN; 
+               TYPE LP1 IS NEW BOOLEAN; 
+          END PACK1; 
+
+          PACKAGE BODY PACK1 IS
+
+               USE PACK_LP; 
+               USE PACK2; 
+
+               A1 : ARR; 
+               L1 : LP_ARR; 
+
+               N1 : INTEGER := ARR'FIRST;           -- LEGAL
+               N2 : INTEGER := ARR'LAST;            -- LEGAL
+               N3 : INTEGER := A1'LENGTH;           -- LEGAL
+               N4 : INTEGER := LP_ARR'FIRST;        -- LEGAL
+               N5 : INTEGER := LP_ARR'LAST;         -- LEGAL
+               N6 : INTEGER := L1'LENGTH;           -- LEGAL
+               B1 : BOOLEAN := 1 IN ARR'RANGE;      -- LEGAL
+               B2 : BOOLEAN := 5 IN LP_ARR'RANGE;   -- LEGAL
+
+               N7 : INTEGER := A1(1)'SIZE;          -- LEGAL: A1(1)
+               N8 : INTEGER := L1(2)'SIZE;          -- LEGAL: L1(2)
+
+               R1 : REC(1); 
+               Q1 : LP_REC(1); 
+
+               K1 : INTEGER := R1.D'SIZE;           -- LEGAL: R1.D
+               K2 : INTEGER := R1.C1'SIZE;          -- LEGAL: R1.C1
+               K3 : INTEGER := Q1.D'SIZE;           -- LEGAL: Q1.D
+               K4 : INTEGER := Q1.C2'SIZE;          -- LEGAL: Q1.C2
+
+          BEGIN
+
+               IF N1 /= 1 OR N4 /= 1 THEN
+                    FAILED ("WRONG VALUE FOR 'FIRST"); 
+               END IF; 
+
+               IF N2 /= 2 OR N5 /= 2 THEN
+                    FAILED ("WRONG VALUE FOR 'LAST"); 
+               END IF; 
+
+               IF N3 /= 2 OR N6 /= 2 THEN
+                    FAILED ("WRONG VALUE FOR 'LENGTH"); 
+               END IF; 
+
+               IF B1 /= TRUE OR B2 /= FALSE THEN
+                    FAILED ("INCORRECT RANGE TEST"); 
+               END IF; 
+
+               IF N7 /= N8 THEN
+                    FAILED ("INCORRECT INDEXED COMPONENTS"); 
+               END IF; 
+
+               IF K1 /= K3 OR K2 /= K4 THEN
+                    FAILED ("INCORRECT COMPONENT SELECTION"); 
+               END IF; 
+
+          END PACK1; 
+
+     BEGIN
+
+          NULL; 
+
+     END; 
+
+     RESULT; 
+
+END C74206A; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74207b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74207b.ada
new file mode 100644
index 000000000..a5284a6de
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74207b.ada
@@ -0,0 +1,75 @@
+-- C74207B.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 'CONSTRAINED CAN BE APPLIED AFTER THE FULL DECLARATION OF
+-- A PRIVATE TYPE THAT IS DERIVED FROM A PRIVATE TYPE.
+
+-- BHS 6/18/84
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C74207B IS
+BEGIN
+     TEST ("C74207B", "AFTER THE FULL DECLARATION OF A PRIVATE " &
+                      "TYPE DERIVED FROM A PRIVATE TYPE, " &
+                      "'CONSTRAINED MAY BE APPLIED");
+
+     DECLARE
+          PACKAGE P1 IS
+               TYPE PREC (D : INTEGER) IS PRIVATE;
+               TYPE P IS PRIVATE;
+          PRIVATE
+               TYPE PREC (D : INTEGER) IS RECORD
+                         NULL; 
+                    END RECORD;
+               TYPE P IS NEW INTEGER;
+          END P1;
+
+          PACKAGE P2 IS
+               TYPE LP1 IS LIMITED PRIVATE;
+               TYPE LP2 IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE LP1 IS NEW P1.PREC(3);
+               TYPE LP2 IS NEW P1.P;
+               B1 : BOOLEAN := LP1'CONSTRAINED;
+               B2 : BOOLEAN := LP2'CONSTRAINED;
+          END P2;
+
+          PACKAGE BODY P2 IS
+          BEGIN
+               IF NOT IDENT_BOOL(B1) THEN
+                    FAILED ("WRONG VALUE FOR LP1'CONSTRAINED");
+               END IF;
+               IF NOT IDENT_BOOL(B2) THEN
+                    FAILED ("WRONG VALUE FOR LP2'CONSTRAINED");
+               END IF;
+          END P2;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+
+END C74207B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74208a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74208a.ada
new file mode 100644
index 000000000..36607d285
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74208a.ada
@@ -0,0 +1,116 @@
+-- C74208A.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 'SIZE AND 'ADDRESS FOR OBJECTS OF LIMITED AND
+--     NON-LIMITED TYPES ARE AVAILABLE BOTH INSIDE AND OUTSIDE THE
+--     PACKAGE DECLARING THE TYPES.
+
+-- HISTORY:
+--     BCB 03/14/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+
+PROCEDURE C74208A IS
+
+     PACKAGE P IS
+          TYPE T IS PRIVATE;
+          TYPE U IS LIMITED PRIVATE;
+     PRIVATE
+          TYPE T IS RANGE 1 .. 100;
+          TYPE U IS RANGE 1 .. 100;
+     END P;
+
+     A : P.T;
+     B : P.U;
+     ASIZE, BSIZE : INTEGER;
+     AADDRESS, BADDRESS : ADDRESS;
+
+     FUNCTION IDENT_ADR(X : ADDRESS) RETURN ADDRESS IS
+          Y : P.T;
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN X;
+          END IF;
+          RETURN Y'ADDRESS;
+     END IDENT_ADR;
+
+     PACKAGE BODY P IS
+          X : T;
+          Y : U;
+          XSIZE, YSIZE : INTEGER;
+          XADDRESS, YADDRESS : ADDRESS;
+     BEGIN
+          TEST ("C74208A", "CHECK THAT 'SIZE AND 'ADDRESS FOR " &
+                           "OBJECTS OF LIMITED AND NON-LIMITED TYPES " &
+                           "ARE AVAILABLE BOTH INSIDE AND OUTSIDE " &
+                           "THE PACKAGE DECLARING THE TYPES");
+
+          XSIZE := X'SIZE;
+          YSIZE := Y'SIZE;
+          XADDRESS := X'ADDRESS;
+          YADDRESS := Y'ADDRESS;
+
+          IF NOT EQUAL(XSIZE,X'SIZE) THEN
+               FAILED ("IMPROPER VALUE FOR X'SIZE");
+          END IF;
+
+          IF XADDRESS /= IDENT_ADR(X'ADDRESS) THEN
+               FAILED ("IMPROPER VALUE FOR X'ADDRESS");
+          END IF;
+
+          IF NOT EQUAL(YSIZE,Y'SIZE) THEN
+               FAILED ("IMPROPER VALUE FOR Y'SIZE");
+          END IF;
+
+          IF YADDRESS /= IDENT_ADR(Y'ADDRESS) THEN
+               FAILED ("IMPROPER VALUE FOR Y'ADDRESS");
+          END IF;
+     END P;
+
+BEGIN
+     ASIZE := A'SIZE;
+     BSIZE := B'SIZE;
+     AADDRESS := A'ADDRESS;
+     BADDRESS := B'ADDRESS;
+
+     IF NOT EQUAL(ASIZE,A'SIZE) THEN
+          FAILED ("IMPROPER VALUE FOR A'SIZE");
+     END IF;
+
+     IF AADDRESS /= IDENT_ADR(A'ADDRESS) THEN
+          FAILED ("IMPROPER VALUE FOR A'ADDRESS");
+     END IF;
+
+     IF NOT EQUAL(BSIZE,B'SIZE) THEN
+          FAILED ("IMPROPER VALUE FOR B'SIZE");
+     END IF;
+
+     IF BADDRESS /= IDENT_ADR(B'ADDRESS) THEN
+          FAILED ("IMPROPER VALUE FOR B'ADDRESS");
+     END IF;
+
+     RESULT;
+END C74208A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74208b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74208b.ada
new file mode 100644
index 000000000..c4c00bfc3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74208b.ada
@@ -0,0 +1,106 @@
+-- C74208B.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 'CONSTRAINED FOR OBJECTS OF A PRIVATE TYPE WITH
+--     VISIBLE DISCRIMINANTS IS AVAILABLE OUTSIDE THE PACKAGE DECLARING
+--     THE TYPE AND IS AVAILABLE BEFORE AND AFTER THE FULL DECLARATION.
+
+-- HISTORY:
+--     BCB 07/14/88  CREATED ORIGINAL TEST.
+--     GJD 11/15/95  MOVED REC2_VAR OUT OF P DUE TO ADA 95 FREEZING RULES.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C74208B IS
+
+     PACKAGE P IS
+          TYPE REC (D : INTEGER := 0) IS PRIVATE;
+          R1 : CONSTANT REC;
+          TYPE REC2 IS RECORD
+               COMP : BOOLEAN := R1'CONSTRAINED;
+          END RECORD;
+     PRIVATE
+          TYPE REC (D : INTEGER := 0) IS RECORD
+               NULL;
+          END RECORD;
+          R1 : CONSTANT REC := (D => 5);
+          R2 : REC := (D => 0);
+          R2A : REC(3);
+          R2CON : CONSTANT REC := (D => 3);
+          C : BOOLEAN := R2'CONSTRAINED;
+          D : BOOLEAN := R2A'CONSTRAINED;
+          E : BOOLEAN := R2CON'CONSTRAINED;
+     END P;
+
+     REC2_VAR : P.REC2;
+     
+     R3 : P.REC(0);
+     R3A : P.REC;
+
+     A : BOOLEAN := R3'CONSTRAINED;
+     B : BOOLEAN := R3A'CONSTRAINED;
+
+     PACKAGE BODY P IS
+     BEGIN
+          TEST ("C74208B", "CHECK THAT 'CONSTRAINED FOR OBJECTS OF A " &
+                           "PRIVATE TYPE WITH VISIBLE DISCRIMINANTS " &
+                           "IS AVAILABLE OUTSIDE THE PACKAGE " &
+                           "DECLARING THE TYPE AND IS AVAILABLE " &
+                           "BEFORE AND AFTER THE FULL DECLARATION");
+
+          IF NOT REC2_VAR.COMP THEN
+               FAILED ("IMPROPER VALUE FOR 'CONSTRAINED BEFORE THE " &
+                       "FULL DECLARATION OF THE PRIVATE TYPE");
+          END IF;
+
+          IF C THEN
+               FAILED ("IMPROPER VALUE FOR 'CONSTRAINED AFTER THE " &
+                       "FULL DECLARATION OF THE PRIVATE TYPE - 1");
+          END IF;
+
+          IF NOT D THEN
+               FAILED ("IMPROPER VALUE FOR 'CONSTRAINED AFTER THE " &
+                       "FULL DECLARATION OF THE PRIVATE TYPE - 2");
+          END IF;
+
+          IF NOT E THEN
+               FAILED ("IMPROPER VALUE FOR 'CONSTRAINED AFTER THE " &
+                       "FULL DECLARATION OF THE PRIVATE TYPE - 3");
+          END IF;
+     END P;
+
+BEGIN
+     IF NOT A THEN
+          FAILED ("IMPROPER VALUE FOR 'CONSTRAINED OUTSIDE THE " &
+                  "PACKAGE DECLARING THE PRIVATE TYPE - 1");
+     END IF;
+
+     IF B THEN
+          FAILED ("IMPROPER VALUE FOR 'CONSTRAINED OUTSIDE THE " &
+                  "PACKAGE DECLARING THE PRIVATE TYPE - 2");
+     END IF;
+
+     RESULT;
+END C74208B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74209a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74209a.ada
new file mode 100644
index 000000000..eef77fde9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74209a.ada
@@ -0,0 +1,224 @@
+-- C74209A.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 OUTSIDE A PACKAGE WHICH DEFINES PRIVATE TYPES AND LIMITED
+--    PRIVATE TYPES  IT IS POSSIBLE TO DECLARE SUBPROGRAMS WHICH USE
+--    THOSE TYPES AS TYPES FOR PARAMETERS (OF ANY MODE EXCEPT OUT FOR A
+--    LIMITED TYPE) OR AS THE TYPE FOR THE RESULT (FOR FUNCTION
+--    SUBPROGRAMS). 
+
+-- RM 07/14/81
+
+
+WITH REPORT;
+PROCEDURE  C74209A  IS
+
+     USE  REPORT;
+
+BEGIN
+
+     TEST( "C74209A" , "CHECK THAT PROCEDURE SIGNATURES CAN USE " &
+                       "PRIVATE TYPES" );
+
+     DECLARE
+
+          PACKAGE  PACK  IS
+
+               TYPE  LIM_PRIV  IS LIMITED PRIVATE;
+               TYPE  PRIV      IS         PRIVATE;
+               PRIV_CONST_IN   :  CONSTANT  PRIV;
+               PRIV_CONST_OUT  :  CONSTANT  PRIV;
+               FUNCTION  PACKAGED( X: IN INTEGER )  RETURN LIM_PRIV;
+               FUNCTION  EQUALS( X , Y : LIM_PRIV ) RETURN BOOLEAN ;
+               PROCEDURE ASSIGN( X : IN  LIM_PRIV; Y : OUT LIM_PRIV );
+
+          PRIVATE
+
+               TYPE  LIM_PRIV  IS NEW INTEGER;
+               TYPE  PRIV      IS NEW STRING( 1..5 );
+               PRIV_CONST_IN   :  CONSTANT  PRIV :=  "ABCDE";
+               PRIV_CONST_OUT  :  CONSTANT  PRIV :=  "FGHIJ";
+
+          END  PACK;
+
+
+          PRIV_VAR_1 ,     PRIV_VAR_2      :  PACK.PRIV;
+          LIM_PRIV_VAR_1 , LIM_PRIV_VAR_2  :  PACK.LIM_PRIV;
+
+
+          USE  PACK;
+
+
+          PACKAGE BODY  PACK  IS
+
+               FUNCTION  PACKAGED( X: IN INTEGER )  RETURN LIM_PRIV  IS
+               BEGIN
+                    RETURN  LIM_PRIV(X);
+               END  PACKAGED;
+
+               FUNCTION  EQUALS( X , Y : LIM_PRIV ) RETURN BOOLEAN  IS
+               BEGIN
+                    RETURN  X = Y ;
+               END  EQUALS;
+
+               PROCEDURE ASSIGN( X : IN  LIM_PRIV; Y : OUT LIM_PRIV) IS
+               BEGIN
+                    Y := X;
+               END  ASSIGN;
+
+          END  PACK;
+
+
+          PROCEDURE  PROC1( X : IN OUT PACK.PRIV;
+                            Y : IN     PACK.PRIV := PACK.PRIV_CONST_IN;
+                            Z : OUT    PACK.PRIV;
+                            U :        PACK.PRIV )  IS
+          BEGIN
+
+               IF  X /= PACK.PRIV_CONST_IN  OR
+                   Y /= PACK.PRIV_CONST_IN  OR
+                   U /= PACK.PRIV_CONST_IN
+               THEN
+                    FAILED( "WRONG INPUT VALUES  -  PROC1" );
+               END IF;
+
+               X := PACK.PRIV_CONST_OUT;
+               Z := PACK.PRIV_CONST_OUT;
+
+          END  PROC1;
+
+
+          PROCEDURE  PROC2( X : IN OUT LIM_PRIV;
+                            Y : IN     LIM_PRIV;
+                            Z : IN OUT LIM_PRIV;
+                            U :        LIM_PRIV )  IS
+          BEGIN
+
+               IF  NOT(EQUALS( X , PACKAGED(17) ))  OR
+                   NOT(EQUALS( Y , PACKAGED(17) ))  OR
+                   NOT(EQUALS( U , PACKAGED(17) ))
+               THEN
+                    FAILED( "WRONG INPUT VALUES  -  PROC2" );
+               END IF;
+
+               ASSIGN( PACKAGED(13) , X );
+               ASSIGN( PACKAGED(13) , Z );
+
+          END  PROC2;
+
+
+          FUNCTION  FUNC1( Y : IN  PRIV  :=  PRIV_CONST_IN;
+                           U :     PRIV  )   RETURN  PRIV  IS
+          BEGIN
+
+               IF  Y /= PRIV_CONST_IN  OR
+                   U /= PRIV_CONST_IN
+               THEN
+                    FAILED( "WRONG INPUT VALUES  -  FUNC1" );
+               END IF;
+
+               RETURN  PRIV_CONST_OUT;
+
+          END  FUNC1;
+
+
+          FUNCTION  FUNC2( Y : IN  LIM_PRIV;
+                           U :     LIM_PRIV )  RETURN  LIM_PRIV  IS
+          BEGIN
+
+               IF  NOT(EQUALS( Y , PACKAGED(17) ))  OR
+                   NOT(EQUALS( U , PACKAGED(17) ))
+               THEN
+                    FAILED( "WRONG INPUT VALUES  -  FUNC2" );
+               END IF;
+
+               RETURN  PACKAGED(13);
+
+          END  FUNC2;
+
+
+     BEGIN
+
+          --------------------------------------------------------------
+
+          PRIV_VAR_1 := PRIV_CONST_IN;
+          PRIV_VAR_2 := PRIV_CONST_IN;
+
+          PROC1( PRIV_VAR_1 , Z => PRIV_VAR_2 , U => PRIV_CONST_IN );
+
+          IF  PRIV_VAR_1 /= PACK.PRIV_CONST_OUT  OR
+              PRIV_VAR_2 /= PACK.PRIV_CONST_OUT
+          THEN
+               FAILED( "WRONG OUTPUT VALUES  -  PROC1" );
+          END IF;
+
+          --------------------------------------------------------------
+
+          ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_1 );
+          ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_2 );
+
+          PROC2( LIM_PRIV_VAR_1 , PACKAGED(17) ,
+                 LIM_PRIV_VAR_2 , PACKAGED(17) );
+
+          IF  NOT(EQUALS( LIM_PRIV_VAR_1 , PACKAGED(13) ))  OR
+              NOT(EQUALS( LIM_PRIV_VAR_2 , PACKAGED(13) ))
+          THEN
+               FAILED( "WRONG OUTPUT VALUES  -  PROC2" );
+          END IF;
+
+          --------------------------------------------------------------
+
+          PRIV_VAR_1 := PRIV_CONST_IN;
+          PRIV_VAR_2 := PRIV_CONST_IN;
+
+          PRIV_VAR_1 :=
+              FUNC1( PRIV_VAR_1 , U => PRIV_CONST_IN );
+
+          IF  PRIV_VAR_1 /= PACK.PRIV_CONST_OUT  
+          THEN
+               FAILED( "WRONG OUTPUT VALUES  -  FUNC1" );
+          END IF;
+
+          --------------------------------------------------------------
+
+          ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_1 );
+          ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_2 );
+
+          ASSIGN( FUNC2( LIM_PRIV_VAR_1 , PACKAGED(17)) ,
+                  LIM_PRIV_VAR_1 );
+
+          IF  NOT(EQUALS( LIM_PRIV_VAR_1 , PACKAGED(13) ))
+          THEN
+               FAILED( "WRONG OUTPUT VALUES  -  FUNC2" );
+          END IF;
+
+          --------------------------------------------------------------
+
+     END;
+
+
+     RESULT;
+
+
+END C74209A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74210a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74210a.ada
new file mode 100644
index 000000000..f3496b31c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74210a.ada
@@ -0,0 +1,117 @@
+-- C74210A.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 OPERATOR SYMBOLS OVERLOADED IN A PACKAGE ARE
+--   USED AND DERIVED IN PREFERENCE TO THOSE OF THE PARENT OF A DERIVED
+--   PRIVATE TYPE. 
+
+-- CHECK THAT OPERATOR DEFINITIONS FOR A PRIVATE TYPE MAY BE
+--   OVERLOADED OUTSIDE THE PACKAGE.
+
+-- CHECK THAT EQUALITY CAN BE DEFINED FOR LIMITED TYPES AND COMPOSITE
+--   TYPES WITH LIMITED COMPONENTS. 
+
+-- DAT 5/11/81
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C74210A IS
+BEGIN
+     TEST ("C74210A", "OVERLOADED OPERATORS FOR PRIVATE TYPES");
+
+     DECLARE
+          PACKAGE P IS
+               TYPE T IS PRIVATE;
+               FUNCTION "+" (X, Y : T) RETURN T;
+               ONE, TWO : CONSTANT T;
+
+               TYPE L IS LIMITED PRIVATE;
+               TYPE A IS ARRAY (0 .. 0) OF L;
+               TYPE R IS RECORD
+                    C : L;
+               END RECORD;
+               FUNCTION "=" (X, Y : L) RETURN BOOLEAN;
+          PRIVATE
+               TYPE T IS NEW INTEGER;
+               ONE : CONSTANT T := T(IDENT_INT(1));
+               TWO : CONSTANT T := T(IDENT_INT(2));
+               TYPE L IS (ENUM);
+          END P;
+          USE P;
+
+          VR : R;
+          VA : A;
+
+          PACKAGE BODY P IS
+               FUNCTION "+" (X, Y : T) RETURN T IS
+               BEGIN
+                    RETURN 1;
+               END "+";
+
+               FUNCTION "=" (X, Y : L) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN IDENT_BOOL(FALSE);
+               END "=";
+          BEGIN
+               VR := (C => ENUM);
+               VA := (0 => VR.C);
+          END P;
+     BEGIN
+          IF ONE + TWO /= ONE THEN
+               FAILED ("WRONG ""+"" OPERATOR");
+          END IF;
+
+          DECLARE
+               TYPE NEW_T IS NEW T;
+
+               FUNCTION "=" (X, Y : A) RETURN BOOLEAN;
+               FUNCTION "=" (X, Y : R) RETURN BOOLEAN;
+
+               FUNCTION "+" (X, Y : T) RETURN T IS
+               BEGIN
+                    RETURN TWO;
+               END "+";
+
+               FUNCTION "=" (X, Y : A) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN X(0) = Y(0);
+               END "=";
+
+               FUNCTION "=" (X, Y : R) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN X.C = Y.C;
+               END "=";
+          BEGIN
+               IF ONE + TWO /= TWO THEN
+                    FAILED ("WRONG DERIVED ""+"" OPERATOR");
+               END IF;
+
+               IF VR = VR OR VA = VA THEN
+                    FAILED ("CANNOT OVERLOAD ""="" CORRECTLY");
+               END IF;
+          END;
+     END;
+
+     RESULT;
+END C74210A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74211a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74211a.ada
new file mode 100644
index 000000000..d4a1caf05
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74211a.ada
@@ -0,0 +1,195 @@
+-- C74211A.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 WITHIN THE PACKAGE SPECIFICATION AND BODY, ANY EXPLICIT
+-- DECLARATIONS OF OPERATORS AND SUBPROGRAMS HIDE ANY OPERATIONS WHICH
+-- ARE IMPLICITLY DECLARED AT THE POINT OF THE FULL DECLARATION,
+-- REGARDLESS OF THE ORDER OF OCCURENCE OF THE DECLARATIONS.
+
+-- CHECK THAT IMPLICITLY DECLARED DERIVED SUBPROGRAMS HIDE IMPLICITLY
+-- DECLARED PREDEFINED OPERATORS, REGARDLESS OF THE ORDER OF OCCURENCE
+-- OF THE DECLARATIONS.
+
+-- DSJ 4/28/83
+-- JBG 9/23/83
+
+--   A) EXPLICIT DECLARATION HIDES LATER IMPLICIT DECL OF PREDEFINED OP.
+--   B)     "        "         "   LATER     "      "  "  DERIVED OP.
+--   C)     "        "         "   EARLIER   "      "  "  PREDEFINED OP.
+--   D)     "        "         "   EARLIER   "      "  "  DERIVED OP.
+
+WITH REPORT;
+PROCEDURE C74211A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST ("C74211A", "CHECK THAT HIDING OF IMPLICITLY DECLARED " &
+                      "OPERATORS AND DERIVED SUBPROGRAMS IS DONE " &
+                      "CORRECTLY REGARDLESS OF ORDER OF DECL'S");
+
+     DECLARE
+
+          PACKAGE P1 IS 
+               TYPE T1 IS RANGE 1 .. 50;
+               C1 : CONSTANT T1 := T1(IDENT_INT(2));
+               D1 : CONSTANT T1 := C1 + C1;        -- PREDEFINED "+"
+               FUNCTION "+" (L, R : T1) RETURN T1; -- C) FOR "+".
+               FUNCTION "-" (L, R : T1) RETURN T1; -- C) FOR "-".
+               FUNCTION "/" (L, R : T1) RETURN T1; 
+          END P1;
+
+          USE P1;
+
+          PACKAGE BODY P1 IS
+               A,B : T1 := 3;
+
+               FUNCTION "+" (L, R : T1) RETURN T1 IS
+               BEGIN
+                    IF L = R THEN
+                         RETURN 1;
+                    ELSE RETURN 2;
+                    END IF;
+               END "+";
+
+               FUNCTION "-" (L, R : T1) RETURN T1 IS
+               BEGIN
+                    IF L = R THEN
+                         RETURN 3;
+                    ELSE RETURN 4;
+                    END IF;
+               END "-";
+
+               FUNCTION "/" (L, R : T1) RETURN T1 IS
+               BEGIN
+                    IF L = R THEN
+                         RETURN T1(IDENT_INT(INTEGER(L)));
+                    ELSE
+                         RETURN T1(IDENT_INT(50));
+                    END IF;
+               END "/";
+
+          BEGIN
+               IF D1 /= 4 THEN
+                    FAILED ("WRONG PREDEFINED OPERATION - '+' ");
+               END IF;
+
+               IF D1 + C1 /= 2 THEN
+                    FAILED ("IMPLICIT '+' NOT HIDDEN BY EXPLICIT '+'");
+               END IF;
+
+               IF A + B /= 1 THEN
+                    FAILED ("IMPLICIT DECLARATION NOT HIDDEN " &
+                            "BY EXPLICIT DECLARATION - '+' ");
+               END IF;
+
+               IF A - B /= 3 THEN
+                    FAILED ("IMPLICIT DECLARATION NOT HIDDEN " &
+                            "BY EXPLICIT DECLARATION - '-' ");
+               END IF;
+
+               IF A * B /= 9 THEN
+                    FAILED ("WRONG PREDEFINED OPERATION - '*' ");
+               END IF;
+
+               IF B / A  /=  T1(IDENT_INT(3)) THEN
+                    FAILED ("NOT REDEFINED '/' ");
+               END IF;
+          END P1;
+
+          PACKAGE P2 IS
+               TYPE T2 IS PRIVATE;
+               X , Y : CONSTANT T2;
+               FUNCTION "+" (L, R : T2) RETURN T2;     -- B)
+               FUNCTION "*" (L, R : T2) RETURN T2;     -- A)
+          PRIVATE
+               TYPE T2 IS NEW T1;                 -- B) +; A) *
+               Z : T2 := T2(IDENT_INT(3))/4;      -- Z = 50 USING
+                                                  -- DERIVED /
+               FUNCTION "/" (L, R : T2) RETURN T2;  -- D) FOR /
+               X , Y : CONSTANT T2 := 3;
+          END P2;
+
+          PACKAGE BODY P2 IS
+               FUNCTION "+" (L, R : T2) RETURN T2 IS
+               BEGIN
+                    IF L = R THEN
+                         RETURN T2(IDENT_INT(5));
+                    ELSE RETURN T2(IDENT_INT(6));
+                    END IF;
+               END "+";
+
+               FUNCTION "*" (L, R : T2) RETURN T2 IS
+               BEGIN
+                    IF L = R THEN
+                         RETURN T2(IDENT_INT(7));
+                    ELSE RETURN T2(IDENT_INT(8));
+                    END IF;
+               END "*";
+
+               FUNCTION "/" (L, R : T2) RETURN T2 IS
+               BEGIN
+                    IF L = R THEN
+                         RETURN T2(IDENT_INT(9));
+                    ELSE RETURN T2(IDENT_INT(10));
+                    END IF;
+               END "/";
+          BEGIN
+               IF X + Y /= 5 THEN
+                         FAILED ("DERIVED SUBPROGRAM NOT HIDDEN BY " &
+                                 "EXPLICIT DECLARATION - '+' ");
+               END IF;
+
+               IF Y - X /= 3 THEN
+                         FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
+                                 "DERIVED SUBPROGRAM - '-' ");
+               END IF;
+
+               IF X * Y /= 7 THEN
+                         FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
+                                 "EXPLICIT DECLARATION - '*' ");
+               END IF;
+
+               IF Y / X /= T2(IDENT_INT(9)) THEN
+                         FAILED ("DERIVED OPERATOR NOT HIDDEN BY " &
+                                 "EXPLICIT DECLARATION - '/' ");
+               END IF;
+
+               IF Z /= 50 THEN
+                    FAILED ("DERIVED OPERATOR HIDDEN PREMATURELY " &
+                            " BY REDECLARED OPERATOR");
+               END IF;
+
+          END P2;
+
+     BEGIN
+
+          NULL;
+
+     END;
+
+     RESULT;
+
+END C74211A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74211b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74211b.ada
new file mode 100644
index 000000000..d4b9ef73f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74211b.ada
@@ -0,0 +1,156 @@
+-- C74211B.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 IMPLICITLY DECLARED INEQUALITY WHICH ACCOMPANIES AN
+-- EXPLICIT DECLARATION OF EQUALITY HIDES OTHER IMPLICITLY DECLARED
+-- HOMOGRAPHS, AND THAT DERIVED INEQUALITY HIDES PREDEFINED INEQUALITY.
+
+-- DSJ 4/29/83
+-- JBG 9/23/83
+
+WITH REPORT;
+PROCEDURE C74211B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST( "C74211B", "CHECK THAT HIDING OF IMPLICITLY DECLARED " &
+                      "OPERATORS AND DERIVED SUBPROGRAMS IS DONE " &
+                      "CORRECTLY REGARDLESS OF ORDER OF DECL'S");
+
+     DECLARE
+
+          PACKAGE P1 IS 
+               TYPE LT1 IS LIMITED PRIVATE;
+               FUNCTION "="(L, R : LT1) RETURN BOOLEAN;
+               FUNCTION LT1_VALUE_2 RETURN LT1;
+               FUNCTION LT1_VALUE_4 RETURN LT1;
+               TYPE LT2 IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE LT1 IS RANGE 1 .. 10;
+               TYPE LT2 IS RANGE 1 .. 10;
+          END P1;
+
+          USE P1;
+
+          PACKAGE P2 IS
+               TYPE LT3 IS LIMITED PRIVATE;
+               TYPE LT4 IS NEW LT1;
+          PRIVATE
+               FUNCTION "=" (L, R : LT3) RETURN BOOLEAN;
+               TYPE LT3 IS NEW LT1;
+          END P2;
+
+          USE P2;
+
+          PACKAGE BODY P1 IS
+               A , B : CONSTANT LT1 := 4;
+               C , D : CONSTANT LT2 := 6;
+
+               FUNCTION "=" (L, R : LT1) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN INTEGER(L) /= INTEGER(R);
+               END "=";
+
+               FUNCTION LT1_VALUE_2 RETURN LT1 IS
+               BEGIN
+                    RETURN 2;
+               END LT1_VALUE_2;
+
+               FUNCTION LT1_VALUE_4 RETURN LT1 IS
+               BEGIN
+                    RETURN 4;
+               END LT1_VALUE_4;
+
+          BEGIN
+               IF A = B THEN
+                    FAILED ("PREDEFINED EQUALITY NOT HIDDEN BY " &
+                            "EXPLICIT DECLARATION - LT1");
+               END IF;
+
+               IF C /= D  THEN
+                    FAILED ("WRONG PREDEFINED OPERATION - T2");
+               END IF;
+          END P1;
+
+          PACKAGE BODY P2 IS
+               FUNCTION U RETURN LT3 IS
+               BEGIN
+                    RETURN LT1_VALUE_2;
+               END U;
+
+               FUNCTION V RETURN LT3 IS
+               BEGIN
+                    RETURN LT1_VALUE_4;
+               END V;
+
+               FUNCTION W RETURN LT4 IS
+               BEGIN
+                    RETURN LT1_VALUE_2;
+               END W;
+
+               FUNCTION X RETURN LT4 IS
+               BEGIN
+                    RETURN LT1_VALUE_4;
+               END X;
+
+               FUNCTION "=" (L, R : LT3) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN NOT (LT1(L) = LT1(R));
+               END "=";
+
+          BEGIN
+               IF NOT (U /= V) THEN
+                    FAILED ("DERIVED SUBPROGRAM NOT HIDDEN BY " &
+                            "IMPLICITLY DECLARED INEQUALITY " &
+                            "FROM EXPLICITLY DECLARED EQUALITY"); 
+               END IF;
+
+               IF NOT (LT3(W) = U) THEN
+                    FAILED ("DERIVED SUBPROGRAM NOT HIDDEN BY " &
+                            "EXPLICIT DECLARATION - '=' ");
+               END IF;
+
+               IF W /= X THEN
+                    FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
+                            "DERIVED SUBPROGRAM - '/=' ");
+               END IF;
+
+               IF NOT ( X = W ) THEN
+                    FAILED ("PREDEFINED OPERATOR NOT HIDDEN BY " &
+                            "DERIVED SUBPROGRAM - '=' ");
+               END IF;
+
+          END P2;
+
+     BEGIN
+
+          NULL;
+
+     END;
+
+     RESULT;
+
+END C74211B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74302a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74302a.ada
new file mode 100644
index 000000000..a772e5087
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74302a.ada
@@ -0,0 +1,81 @@
+-- C74302A.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 MULTIPLE DECLARATIONS MAY BE USED FOR DEFERRED CONSTANT
+-- DECLARATIONS, EVEN IF THE FULL DECLARATIONS ARE GIVEN INDIVIDUALLY.
+
+-- CHECK THAT MULTIPLE DECLARATIONS MAY BE USED FOR THE FULL
+-- DECLARATIONS, EVEN IF THE DEFERRED CONSTANT DECLARATIONS ARE GIVEN
+-- INDIVIDUALLY.
+
+
+-- DSJ  5/09/83
+-- SPS 10/24/83
+-- EG  12/19/83
+-- JRK 12/20/83
+
+-- DTN 11/19/91     DELETED SUBPART (C).
+
+WITH REPORT;
+PROCEDURE C74302A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C74302A", "CHECK THAT MULTIPLE DECLARATIONS MAY BE USED " &
+                     "FOR DEFERRED CONSTANT DECLARATIONS");
+
+     DECLARE
+
+          PACKAGE PACK1 IS
+
+               TYPE T IS PRIVATE;
+
+               B, E : CONSTANT T;
+
+               F : CONSTANT T;
+          PRIVATE
+
+               TYPE T IS NEW INTEGER;
+
+               E : CONSTANT T := T(IDENT_INT(4));
+
+               B, F : CONSTANT T := T(IDENT_INT(2));
+
+          END PACK1;
+
+          USE PACK1;
+
+     BEGIN
+
+          IF B/=F THEN
+               FAILED("VALUES OF DEFERRED CONSTANTS B AND F NOT EQUAL");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C74302A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74302b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74302b.ada
new file mode 100644
index 000000000..16b0803cd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74302b.ada
@@ -0,0 +1,308 @@
+-- C74302B.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 THE FULL DECLARATION OF A DEFERRED CONSTANT IS
+--     GIVEN AS A MULTIPLE DECLARATION, THE INITIALIZATION EXPRESSION
+--     IS EVALUATED ONCE FOR EACH DEFERRED CONSTANT.  (USE ENUMERATION,
+--     INTEGER, FIXED POINT, FLOATING POINT, ARRAY, RECORD (INCLUDING
+--     USE OF DEFAULT EXPRESSIONS FOR COMPONENTS), ACCESS, AND PRIVATE
+--     TYPES AS FULL DECLARATION OF PRIVATE TYPE)
+
+-- HISTORY:
+--     BCB 07/25/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C74302B IS
+
+     TYPE ARR_RAN IS RANGE 1..2;
+
+     BUMP : INTEGER := IDENT_INT(0);
+
+     GENERIC
+          TYPE DT IS (<>);
+     FUNCTION F1 RETURN DT;
+
+     GENERIC
+          TYPE FE IS DELTA <>;
+     FUNCTION F2 RETURN FE;
+
+     GENERIC
+          TYPE FLE IS DIGITS <>;
+     FUNCTION F3 RETURN FLE;
+
+     GENERIC
+          TYPE CA IS ARRAY(ARR_RAN) OF INTEGER;
+     FUNCTION F4 RETURN CA;
+
+     GENERIC
+          TYPE GP IS LIMITED PRIVATE;
+     FUNCTION F5 (V : GP) RETURN GP;
+
+     GENERIC
+          TYPE GP1 IS LIMITED PRIVATE;
+     FUNCTION F6 (V1 : GP1) RETURN GP1;
+
+     GENERIC
+          TYPE AC IS ACCESS INTEGER;
+     FUNCTION F7 RETURN AC;
+
+     GENERIC
+          TYPE PP IS PRIVATE;
+     FUNCTION F8 (P1 : PP) RETURN PP;
+
+     FUNCTION F1 RETURN DT IS
+     BEGIN
+          BUMP := BUMP + 1;
+          RETURN DT'VAL(BUMP);
+     END F1;
+
+     FUNCTION F2 RETURN FE IS
+     BEGIN
+          BUMP := BUMP + 1;
+          RETURN FE(BUMP);
+     END F2;
+
+     FUNCTION F3 RETURN FLE IS
+     BEGIN
+          BUMP := BUMP + 1;
+          RETURN FLE(BUMP);
+     END F3;
+
+     FUNCTION F4 RETURN CA IS
+     BEGIN
+          BUMP := BUMP + 1;
+          RETURN ((BUMP,BUMP-1));
+     END F4;
+
+     FUNCTION F5 (V : GP) RETURN GP IS
+     BEGIN
+          BUMP := BUMP + 1;
+          RETURN V;
+     END F5;
+
+     FUNCTION F6 (V1 : GP1) RETURN GP1 IS
+     BEGIN
+          BUMP := BUMP + 1;
+          RETURN V1;
+     END F6;
+
+     FUNCTION F7 RETURN AC IS
+          VAR : AC;
+     BEGIN
+          BUMP := BUMP + 1;
+          VAR := NEW INTEGER'(BUMP);
+          RETURN VAR;
+     END F7;
+
+     FUNCTION F8 (P1 : PP) RETURN PP IS
+     BEGIN
+          BUMP := BUMP + 1;
+          RETURN P1;
+     END F8;
+
+     PACKAGE PACK IS
+          TYPE SP IS PRIVATE;
+          CONS : CONSTANT SP;
+     PRIVATE
+          TYPE SP IS RANGE 1 .. 100;
+          CONS : CONSTANT SP := 50;
+     END PACK;
+
+     USE PACK;
+
+     PACKAGE P IS
+          TYPE INT IS PRIVATE;
+          TYPE ENUM IS PRIVATE;
+          TYPE FIX IS PRIVATE;
+          TYPE FLT IS PRIVATE;
+          TYPE CON_ARR IS PRIVATE;
+          TYPE REC IS PRIVATE;
+          TYPE REC1 IS PRIVATE;
+          TYPE ACC IS PRIVATE;
+          TYPE PRIV IS PRIVATE;
+
+          GENERIC
+               TYPE LP IS PRIVATE;
+          FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN;
+
+          I1, I2, I3, I4 : CONSTANT INT;
+          E1, E2, E3, E4 : CONSTANT ENUM;
+          FI1, FI2, FI3, FI4 : CONSTANT FIX;
+          FL1, FL2, FL3, FL4 : CONSTANT FLT;
+          CA1, CA2, CA3, CA4 : CONSTANT CON_ARR;
+          R1, R2, R3, R4 : CONSTANT REC;
+          R1A, R2A, R3A, R4A : CONSTANT REC1;
+          A1, A2, A3, A4 : CONSTANT ACC;
+          PR1, PR2, PR3, PR4 : CONSTANT PRIV;
+     PRIVATE
+          TYPE INT IS RANGE 1 .. 100;
+
+          TYPE ENUM IS (ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE);
+
+          TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
+
+          TYPE FLT IS DIGITS 5 RANGE -100.0 .. 100.0;
+
+          TYPE CON_ARR IS ARRAY(ARR_RAN) OF INTEGER;
+
+          TYPE REC IS RECORD
+               COMP1 : INTEGER;
+               COMP2 : INTEGER;
+               COMP3 : BOOLEAN;
+          END RECORD;
+
+          TYPE REC1 IS RECORD
+               COMP1 : INTEGER := 10;
+               COMP2 : INTEGER := 20;
+               COMP3 : BOOLEAN := FALSE;
+          END RECORD;
+
+          TYPE ACC IS ACCESS INTEGER;
+
+          TYPE PRIV IS NEW SP;
+
+          FUNCTION DDT IS NEW F1 (INT);
+          FUNCTION EDT IS NEW F1 (ENUM);
+          FUNCTION FDT IS NEW F2 (FIX);
+          FUNCTION FLDT IS NEW F3 (FLT);
+          FUNCTION CADT IS NEW F4 (CON_ARR);
+          FUNCTION RDT IS NEW F5 (REC);
+          FUNCTION R1DT IS NEW F6 (REC1);
+          FUNCTION ADT IS NEW F7 (ACC);
+          FUNCTION PDT IS NEW F8 (PRIV);
+
+          REC_OBJ : REC := (1,2,TRUE);
+          REC1_OBJ : REC1 := (3,4,FALSE);
+
+          I1, I2, I3, I4 : CONSTANT INT := DDT;
+          E1, E2, E3, E4 : CONSTANT ENUM := EDT;
+          FI1, FI2, FI3, FI4 : CONSTANT FIX := FDT;
+          FL1, FL2, FL3, FL4 : CONSTANT FLT := FLDT;
+          CA1, CA2, CA3, CA4 : CONSTANT CON_ARR := CADT;
+          R1, R2, R3, R4 : CONSTANT REC := RDT(REC_OBJ);
+          R1A, R2A, R3A, R4A : CONSTANT REC1 := R1DT(REC1_OBJ);
+          A1, A2, A3, A4 : CONSTANT ACC := ADT;
+          PR1, PR2, PR3, PR4 : CONSTANT PRIV := PDT(PRIV(CONS));
+     END P;
+
+     PACKAGE BODY P IS
+          AVAR1 : ACC := NEW INTEGER'(29);
+          AVAR2 : ACC := NEW INTEGER'(30);
+          AVAR3 : ACC := NEW INTEGER'(31);
+          AVAR4 : ACC := NEW INTEGER'(32);
+
+          FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN Z1 = Z2;
+          END GEN_EQUAL;
+
+          FUNCTION INT_EQUAL IS NEW GEN_EQUAL (INT);
+          FUNCTION ENUM_EQUAL IS NEW GEN_EQUAL (ENUM);
+          FUNCTION FIX_EQUAL IS NEW GEN_EQUAL (FIX);
+          FUNCTION FLT_EQUAL IS NEW GEN_EQUAL (FLT);
+          FUNCTION ARR_EQUAL IS NEW GEN_EQUAL (CON_ARR);
+          FUNCTION REC_EQUAL IS NEW GEN_EQUAL (REC);
+          FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
+          FUNCTION ACC_EQUAL IS NEW GEN_EQUAL (INTEGER);
+          FUNCTION PRIV_EQUAL IS NEW GEN_EQUAL (PRIV);
+     BEGIN
+          TEST ("C74302B", "CHECK THAT WHEN THE FULL DECLARATION OF " &
+                           "A DEFERRED CONSTANT IS GIVEN AS A " &
+                           "MULTIPLE DECLARATION, THE INITIALIZATION " &
+                           "EXPRESSION IS EVALUATED ONCE FOR EACH " &
+                           "DEFERRED CONSTANT");
+
+          IF NOT EQUAL(BUMP,36) THEN
+               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                       "DEFERRED CONSTANTS IN A MULIPLE DECLARATION");
+          END IF;
+
+          IF NOT INT_EQUAL(I1,1) OR NOT INT_EQUAL(I2,2) OR
+             NOT INT_EQUAL(I3,3) OR NOT INT_EQUAL(I4,4) THEN
+               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                       "DEFERRED INTEGER CONSTANTS");
+          END IF;
+
+          IF NOT ENUM_EQUAL(E1,SIX) OR NOT ENUM_EQUAL(E2,SEVEN) OR
+             NOT ENUM_EQUAL(E3,EIGHT) OR NOT ENUM_EQUAL(E4,NINE) THEN
+               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                       "DEFERRED ENUMERATION CONSTANTS");
+          END IF;
+
+          IF NOT FIX_EQUAL(FI1,9.0) OR NOT FIX_EQUAL(FI2,10.0) OR
+             NOT FIX_EQUAL(FI3,11.0) OR NOT FIX_EQUAL(FI4,12.0) THEN
+               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                       "DEFERRED FIXED POINT CONSTANTS");
+          END IF;
+
+          IF NOT FLT_EQUAL(FL1,13.0) OR NOT FLT_EQUAL(FL2,14.0) OR
+             NOT FLT_EQUAL(FL3,15.0) OR NOT FLT_EQUAL(FL4,16.0) THEN
+               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                       "DEFERRED FLOATING POINT CONSTANTS");
+          END IF;
+
+          IF NOT ARR_EQUAL(CA1,(17,16)) OR NOT ARR_EQUAL(CA2,(18,17))
+           OR NOT ARR_EQUAL(CA3,(19,18)) OR NOT ARR_EQUAL(CA4,(20,19))
+               THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                            "DEFERRED ARRAY CONSTANTS");
+          END IF;
+
+          IF NOT REC_EQUAL(R1,REC_OBJ) OR NOT REC_EQUAL(R2,REC_OBJ)
+             OR NOT REC_EQUAL(R3,REC_OBJ) OR NOT REC_EQUAL(R4,REC_OBJ)
+               THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                            "DEFERRED RECORD CONSTANTS");
+          END IF;
+
+          IF NOT REC1_EQUAL(R1A,REC1_OBJ) OR NOT REC1_EQUAL(R2A,
+             REC1_OBJ) OR NOT REC1_EQUAL(R3A,REC1_OBJ) OR NOT
+             REC1_EQUAL(R4A,REC1_OBJ) THEN
+               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                       "DEFERRED RECORD CONSTANTS WITH DEFAULT " &
+                       "EXPRESSIONS");
+          END IF;
+
+          IF NOT ACC_EQUAL(A1.ALL,AVAR1.ALL) OR NOT ACC_EQUAL(A2.ALL,
+             AVAR2.ALL) OR NOT ACC_EQUAL(A3.ALL,AVAR3.ALL) OR NOT
+             ACC_EQUAL(A4.ALL,AVAR4.ALL) THEN
+               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                       "DEFERRED ACCESS CONSTANTS");
+          END IF;
+
+          IF NOT PRIV_EQUAL(PR1,PRIV(CONS)) OR NOT PRIV_EQUAL(PR2,
+             PRIV(CONS)) OR NOT PRIV_EQUAL(PR3,PRIV(CONS)) OR NOT
+             PRIV_EQUAL(PR4,PRIV(CONS)) THEN
+               FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
+                       "DEFERRED PRIVATE CONSTANTS");
+          END IF;
+
+          RESULT;
+     END P;
+
+     USE P;
+
+BEGIN
+     NULL;
+END C74302B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74305a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74305a.ada
new file mode 100644
index 000000000..b1233cbd1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74305a.ada
@@ -0,0 +1,160 @@
+-- C74305A.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 DEFERRED CONSTANT CAN BE USED AS A DEFAULT
+--    INITIALIZATION FOR A PARAMETER OR AS A DEFAULT INITIA-
+--    LIZATION FOR A COMPONENT (NON GENERIC CASE).
+
+-- DAT  4/06/81
+-- RM   5/21/81
+-- SPS  8/23/82
+-- SPS  2/10/83
+-- SPS 10/20/83
+-- EG  12/20/83
+-- GJD 11/15/95  REMOVED ADA 95 INCOMPATIBILITY.
+
+WITH REPORT;
+
+PROCEDURE C74305A IS
+
+     USE REPORT;
+
+     PACKAGE PK IS
+          TYPE T1 IS PRIVATE;
+          TYPE T2 IS PRIVATE; 
+          C1 : CONSTANT T1;                   -- OK.
+
+          PROCEDURE P1 (P : T1 := C1);        -- OK.                
+
+          TYPE R1 IS RECORD
+               C : T1 := C1;                  -- OK.                
+          END RECORD;
+     PRIVATE
+          PROCEDURE PROC2 (P : T1 := C1);     -- OK.                
+
+          TYPE R2 IS RECORD
+               C : T1 := C1;                  -- OK.                
+               D : INTEGER := C1'SIZE;        -- OK.                
+          END RECORD;
+
+          FUNCTION F1 (P : T1) RETURN T1;
+
+          TYPE T1 IS NEW INTEGER;
+          TYPE T2 IS ARRAY (1..2) OF INTEGER; -- OK.
+
+          FUNCTION F2 (P : T1) RETURN T1;
+
+          PROCEDURE P3 (P : T1 := C1+1);      -- OK.
+
+          PROCEDURE P4 (P : T1 := F1(C1));
+  
+          TYPE R5 IS RECORD
+               C : T1 := F2(C1);
+          END RECORD;
+
+          PROCEDURE P5 (P : T1 := C1+2) RENAMES P3;
+
+          TYPE R3 IS RECORD
+               C : T1 := C1;                  -- OK.
+          END RECORD;
+
+          C1 : CONSTANT T1 := 1;              -- OK.
+          C2 : CONSTANT T2 := (1,1);          -- OK. 
+     END PK;
+
+     USE PK;
+
+     PACKAGE BODY PK IS
+
+          R11 : R1;
+
+          PROCEDURE P1 (P : T1 := C1) IS
+          BEGIN
+               IF ( P /= 1 ) THEN
+                    FAILED ("PARAMETER DEFAULT OF P1 NOT PROPERLY " &
+                            "INITIALIZED");
+               END IF;
+          END P1;
+
+          PROCEDURE PROC2 (P : T1 := C1) IS
+          BEGIN NULL; END PROC2;
+
+          PROCEDURE P3 (P : T1 := C1+1) IS
+          BEGIN
+               IF ( P /= 3 ) THEN
+                    FAILED ("PARAMETER DEFAULT OF P5 NOT PROPERLY " &
+                            "INITIALIZED");
+               END IF;
+          END P3;
+
+          FUNCTION F1 (P : T1) RETURN T1 IS
+          BEGIN
+               RETURN P+10;
+          END F1;
+
+          PROCEDURE P4 (P : T1 := F1(C1)) IS
+          BEGIN
+               IF ( P /= 11 ) THEN
+                    FAILED ("WRONG ACTUAL PARAMETER RECEIVED");
+               END IF;
+          END P4;
+
+          FUNCTION F2 (P : T1) RETURN T1 IS
+          BEGIN
+               RETURN P+20;
+          END F2;
+
+     BEGIN -- PK BODY.
+
+          DECLARE
+
+               R55 : R5;
+
+          BEGIN
+               TEST ("C74305A","CHECK THAT A DEFERRED CONSTANT CAN " &
+                               "BE USED AS A DEFAULT INITIALIZATION " &
+                               "FOR A PARAMETER OR AS A DEFAULT " &
+                               "INITIALIZATION FOR A COMPONENT (NON " &
+                               "GENERIC CASE)");
+
+               IF ( R11.C /= 1 ) THEN
+                    FAILED ("RECORD R11 NOT PROPERLY INITIALIZED");
+               END IF;
+
+               P4;
+
+               IF ( R55.C /= 21 ) THEN
+                    FAILED ("RECORD R55 NOT PROPERLY INITIALIZED");
+               END IF;
+
+               P5;
+          END;
+     END PK;
+
+BEGIN
+
+     P1;
+
+     RESULT;
+END C74305A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74305b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74305b.ada
new file mode 100644
index 000000000..fa9ae1ea4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74305b.ada
@@ -0,0 +1,101 @@
+-- C74305B.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 DEFERRED CONSTANT CAN BE USED AS A DEFAULT
+--    INITIALIZATION FOR A PARAMETER OR AS A DEFAULT INITIA-
+--    LIZATION FOR A COMPONENT (GENERIC CASE).
+
+-- EG  12/20/83
+
+WITH REPORT;
+
+PROCEDURE C74305B IS
+
+     USE REPORT;
+
+     PACKAGE PK IS
+          TYPE TD IS PRIVATE;
+          CD : CONSTANT TD;
+          DD : CONSTANT TD;
+
+          GENERIC
+               TYPE T1 IS PRIVATE;
+               C1 : T1;
+               WITH PROCEDURE P2 (A1 : T1 := C1; A2 : TD := CD);
+          PROCEDURE P1 (A1 : TD := CD);
+
+     PRIVATE
+          TYPE TD IS NEW INTEGER;
+          CD : CONSTANT TD := 2;
+          DD : CONSTANT TD := 3;
+     END PK;
+
+     USE PK;
+
+     PACKAGE BODY PK IS
+
+          PROCEDURE P1 (A1 : TD := CD) IS
+          BEGIN
+              IF ( A1 /= 2 ) THEN
+                   FAILED ("WRONG ACTUAL PARAMETER RECEIVED (1)");
+              END IF;
+              P2;
+          END P1;
+
+          PROCEDURE P3 (X : TD := DD; Y : TD := DD) IS
+          BEGIN
+              IF ( X /= 2 ) THEN
+                   FAILED ("WRONG ACTUAL PARAMETER RECEIVED (2)");
+              END IF;
+              IF ( Y /= 2 ) THEN
+                   FAILED ("WRONG ACTUAL PARAMETER RECEIVED (3)");
+              END IF;
+          END P3;
+
+          PROCEDURE P4 IS NEW P1 (TD,CD,P3);
+
+     BEGIN
+          TEST ("C74305B","CHECK THAT A DEFERRED CONSTANT CAN BE "    &
+                          "USED AS A DEFAULT INITIALIZATION FOR A "   &
+                          "PARAMETER OR AS A DEFAULT INITIALIZATION " &
+                          "FOR A COMPONENT (GENERIC CASE)");
+          P4;
+     END PK;
+
+     PROCEDURE P5 (X : TD := DD; Y : TD := DD) IS
+     BEGIN
+          IF ( X /= CD ) THEN
+               FAILED ("WRONG ACTUAL PARAMETER RECEIVED (4)");
+          END IF;
+          IF ( Y /= CD ) THEN
+               FAILED ("WRONG ACTUAL PARAMETER RECEIVED (5)");
+          END IF;
+     END P5;
+
+     PROCEDURE P6 IS NEW P1 (TD,CD,P5);
+
+BEGIN
+     P6;
+     RESULT;
+END C74305B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74306a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74306a.ada
new file mode 100644
index 000000000..c6ebad3c8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74306a.ada
@@ -0,0 +1,279 @@
+-- C74306A.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:
+--     AFTER THE FULL DECLARATION OF A DEFERRED CONSTANT, THE VALUE OF
+--     THE CONSTANT MAY BE USED IN ANY EXPRESSION, PARTICULARLY
+--     EXPRESSIONS IN WHICH THE USE WOULD BE ILLEGAL BEFORE THE FULL
+--     DECLARATION.
+
+-- HISTORY:
+--     BCB 03/14/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C74306A IS
+
+     GENERIC
+          TYPE GENERAL_PURPOSE IS LIMITED PRIVATE;
+          Y : IN OUT GENERAL_PURPOSE;
+     FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;
+
+     FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN X;
+          END IF;
+          RETURN Y;
+     END IDENT;
+
+     PACKAGE P IS
+          TYPE T IS PRIVATE;
+          C : CONSTANT T;
+     PRIVATE
+          TYPE T IS RANGE 1 .. 100;
+
+          TYPE A IS ARRAY(1..2) OF T;
+
+          TYPE B IS ARRAY(INTEGER RANGE <>) OF T;
+
+          TYPE D (DISC : T) IS RECORD
+               NULL;
+          END RECORD;
+
+          C : CONSTANT T := 50;
+
+          PARAM : T := 99;
+
+          FUNCTION IDENT_T IS NEW IDENT (T, PARAM);
+
+          FUNCTION F (X : T := C) RETURN T;
+
+          SUBTYPE RAN IS T RANGE 1 .. C;
+
+          SUBTYPE IND IS B(1..INTEGER(C));
+
+          SUBTYPE DIS IS D (DISC => C);
+
+          OBJ : T := C;
+
+          CON : CONSTANT T := C;
+
+          ARR : A := (5, C);
+
+          PAR : T := IDENT_T (C);
+
+          RANOBJ : T RANGE 1 .. C := C;
+
+          INDOBJ : B(1..INTEGER(C));
+
+          DIS_VAL : DIS;
+
+          REN : T RENAMES C;
+
+          GENERIC
+               FOR_PAR : T := C;
+          PACKAGE GENPACK IS
+               VAL : T;
+          END GENPACK;
+
+          GENERIC
+               IN_PAR : IN T;
+          PACKAGE NEWPACK IS
+               IN_VAL : T;
+          END NEWPACK;
+     END P;
+
+     USE P;
+
+     PACKAGE BODY P IS
+          TYPE A1 IS ARRAY(1..2) OF T;
+
+          TYPE B1 IS ARRAY(INTEGER RANGE <>) OF T;
+
+          TYPE D1 (DISC1 : T) IS RECORD
+               NULL;
+          END RECORD;
+
+          SUBTYPE RAN1 IS T RANGE 1 .. C;
+
+          SUBTYPE IND1 IS B1(1..INTEGER(C));
+
+          SUBTYPE DIS1 IS D1 (DISC1 => C);
+
+          OBJ1 : T := C;
+
+          FUNCVAR : T;
+
+          CON1 : CONSTANT T := C;
+
+          ARR1 : A1 := (5, C);
+
+          PAR1 : T := IDENT_T (C);
+
+          RANOBJ1 : T RANGE 1 .. C := C;
+
+          INDOBJ1 : B1(1..INTEGER(C));
+
+          DIS_VAL1 : DIS1;
+
+          REN1 : T RENAMES C;
+
+          FUNCTION F (X : T := C) RETURN T IS
+          BEGIN
+               RETURN C;
+          END F;
+
+          PACKAGE BODY GENPACK IS
+          BEGIN
+               VAL := FOR_PAR;
+          END GENPACK;
+
+          PACKAGE BODY NEWPACK IS
+          BEGIN
+               IN_VAL := IN_PAR;
+          END NEWPACK;
+
+          PACKAGE PACK IS NEW GENPACK (FOR_PAR => C);
+
+          PACKAGE NPACK IS NEW NEWPACK (IN_PAR => C);
+     BEGIN
+          TEST ("C74306A", "AFTER THE FULL DECLARATION OF A DEFERRED " &
+                           "CONSTANT, THE VALUE OF THE CONSTANT MAY " &
+                           "BE USED IN ANY EXPRESSION, PARTICULARLY " &
+                           "EXPRESSIONS IN WHICH THE USE WOULD BE " &
+                           "ILLEGAL BEFORE THE FULL DECLARATION");
+
+          IF OBJ /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR OBJ");
+          END IF;
+
+          IF CON /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR CON");
+          END IF;
+
+          IF ARR /= (IDENT_T(5), IDENT_T(50)) THEN
+               FAILED ("IMPROPER VALUES FOR ARR");
+          END IF;
+
+          IF PAR /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR PAR");
+          END IF;
+
+          IF OBJ1 /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR OBJ1");
+          END IF;
+
+          IF CON1 /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR CON1");
+          END IF;
+
+          IF ARR1 /= (IDENT_T(5), IDENT_T(50)) THEN
+               FAILED ("IMPROPER VALUES FOR ARR1");
+          END IF;
+
+          IF PAR1 /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR PAR1");
+          END IF;
+
+          IF PACK.VAL /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR PACK.VAL");
+          END IF;
+
+          IF NPACK.IN_VAL /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR NPACK.IN_VAL");
+          END IF;
+
+          IF RAN'LAST /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR RAN'LAST");
+          END IF;
+
+          IF RANOBJ /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR RANOBJ");
+          END IF;
+
+          IF IND'LAST /= IDENT_INT(50) THEN
+               FAILED ("IMPROPER VALUE FOR IND'LAST");
+          END IF;
+
+          IF INDOBJ'LAST /= IDENT_INT(50) THEN
+               FAILED ("IMPROPER VALUE FOR INDOBJ'LAST");
+          END IF;
+
+          IF DIS_VAL.DISC /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR DIS_VAL.DISC");
+          END IF;
+
+          IF REN /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR REN");
+          END IF;
+
+          IF RAN1'LAST /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR RAN1'LAST");
+          END IF;
+
+          IF RANOBJ1 /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR RANOBJ1");
+          END IF;
+
+          IF IND1'LAST /= IDENT_INT(50) THEN
+               FAILED ("IMPROPER VALUE FOR IND1'LAST");
+          END IF;
+
+          IF INDOBJ1'LAST /= IDENT_INT(50) THEN
+               FAILED ("IMPROPER VALUE FOR INDOBJ1'LAST");
+          END IF;
+
+          IF DIS_VAL1.DISC1 /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR DIS_VAL1.DISC1");
+          END IF;
+
+          IF REN1 /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR REN1");
+          END IF;
+
+          FUNCVAR := F(C);
+
+          IF FUNCVAR /= IDENT_T(50) THEN
+               FAILED ("IMPROPER VALUE FOR FUNCVAR");
+          END IF;
+
+          RESULT;
+     END P;
+
+BEGIN
+     DECLARE
+          TYPE ARR IS ARRAY(1..2) OF T;
+
+          VAL1 : T := C;
+
+          VAL2 : ARR := (C, C);
+
+          VAL3 : T RENAMES C;
+     BEGIN
+          NULL;
+     END;
+
+     NULL;
+END C74306A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74307a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74307a.ada
new file mode 100644
index 000000000..aaddc0505
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74307a.ada
@@ -0,0 +1,58 @@
+-- C74307A.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 EXPLICIT CONSTRAINT MAY BE GIVEN IN THE SUBTYPE
+--     INDICATION OF THE FULL DECLARATION OF A DEFERRED CONSTANT.
+
+-- HISTORY:
+--     BCB 03/14/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C74307A IS
+
+     PACKAGE P IS
+          TYPE T (D : INTEGER) IS PRIVATE;
+          C : CONSTANT T;
+     PRIVATE
+          TYPE T (D : INTEGER) IS RECORD
+               NULL;
+          END RECORD;
+          C : CONSTANT T(2) := (D => 2);
+     END P;
+
+     USE P;
+
+BEGIN
+     TEST ("C74307A", "CHECK THAT AN EXPLICIT CONSTRAINT MAY BE " &
+                      "GIVEN IN THE SUBTYPE INDICATION OF THE FULL " &
+                      "DECLARATION OF A DEFERRED CONSTANT");
+
+     IF C.D /= 2 THEN
+          FAILED ("IMPROPER RESULTS FOR C.D");
+     END IF;
+
+     RESULT;
+END C74307A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401d.ada
new file mode 100644
index 000000000..024e677ba
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401d.ada
@@ -0,0 +1,111 @@
+-- C74401D.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 OUT PARAMETER HAVING A LIMITED TYPE IS ALLOWED FOR
+-- FORMAL SUBPROGRAM PARAMETERS.  (ONLY THE CASE OF PRACTICAL INTEREST,
+-- NAMELY, LIMITED PRIVATE TYPES, IS CHECKED HERE.)
+
+-- CHECK THAT AN OUT PARAMETER IN A RENAMING DECLARATION CAN HAVE A
+-- LIMITED PRIVATE TYPE WHEN IT RENAMES A GENERIC FORMAL SUBPROGRAM.
+
+-- JBG 5/1/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C74401D IS
+
+     PACKAGE P IS
+          TYPE LP IS LIMITED PRIVATE;
+          PROCEDURE P1 (X : OUT LP);
+          PROCEDURE P2 (X : OUT LP);
+          FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
+          VAL1 : CONSTANT LP;
+          VAL2 : CONSTANT LP;
+     PRIVATE
+          TYPE LP IS NEW INTEGER;
+          VAL1 : CONSTANT LP := LP(IDENT_INT(3));
+          VAL2 : CONSTANT LP := LP(IDENT_INT(-3));
+     END P;
+
+     PACKAGE BODY P IS
+          PROCEDURE P1 (X : OUT LP) IS
+          BEGIN
+               X := 3;
+          END P1;
+
+          PROCEDURE P2 (X : OUT LP) IS
+          BEGIN
+               X := -3;
+          END P2;
+
+          FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN L = R;
+          END EQ;
+     END P;
+
+     GENERIC
+          WITH PROCEDURE P3 (Y : OUT P.LP);
+          TYPE GLP IS LIMITED PRIVATE;
+          WITH PROCEDURE P4 (Y : OUT GLP);
+          VAL_P3 : IN OUT P.LP;
+          VAL_P4 : IN OUT GLP;
+     PACKAGE GPACK IS
+          PROCEDURE RENAMED (X : OUT GLP) RENAMES P4;   -- OK. RENAMING.
+     END GPACK;
+
+     PACKAGE BODY GPACK IS
+     BEGIN
+          P3 (VAL_P3);
+          P4 (VAL_P4);
+     END GPACK;
+
+BEGIN
+
+     TEST ("C74401D", "CHECK THAT GENERIC FORMAL SUBPROGRAMS CAN HAVE "&
+                      "LIMITED PRIVATE OUT PARAMETERS");
+
+     DECLARE
+          VAR1 : P.LP;
+          VAR2 : P.LP;
+          PACKAGE PACK IS NEW GPACK (P.P1, P.LP, P.P2, VAR1, VAR2);
+     BEGIN
+          IF NOT P.EQ (VAR1, P.VAL1) THEN
+               FAILED ("P1 INVOCATION INCORRECT");
+          END IF;
+
+          IF NOT P.EQ (VAR2, P.VAL2) THEN
+               FAILED ("P2 INVOCATION INCORRECT");
+          END IF;
+
+          P.P1 (VAR2);        -- RESET VALUE OF VAR2.
+          PACK.RENAMED (VAR2);
+
+          IF NOT P.EQ (VAR2, P.VAL2) THEN
+               FAILED ("RENAMED INVOCATION INCORRECT");
+          END IF;
+     END;
+
+     RESULT;
+
+END C74401D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401e.ada
new file mode 100644
index 000000000..df0c99007
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401e.ada
@@ -0,0 +1,120 @@
+-- C74401E.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 OUT PARAMETERS HAVING A LIMITED PRIVATE TYPE CAN BE
+-- DECLARED IN A PACKAGE SPECIFICATION, INCLUDING WITHIN PACKAGES
+-- NESTED IN A VISIBLE PART.
+
+-- CHECK THAT A RENAMING DECLARATION CAN RENAME A PROCEDURE DECLARED
+-- WITH AN OUT PARAMETER.
+
+-- JBG 5/1/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C74401E IS
+
+     PACKAGE PKG IS
+          TYPE LP IS LIMITED PRIVATE;
+          PROCEDURE P20 (X : OUT LP);        -- OK.
+          PROCEDURE RESET (X : OUT LP);
+          FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
+          VAL1 : CONSTANT LP;
+
+          PACKAGE NESTED IS
+               PROCEDURE NEST1 (X : OUT LP);
+          PRIVATE
+               PROCEDURE NEST2 (X : OUT LP);
+          END NESTED;
+     PRIVATE
+          TYPE LP IS NEW INTEGER;
+          VAL1 : CONSTANT LP := LP(IDENT_INT(3));
+     END PKG;
+
+     VAR : PKG.LP;
+
+     PACKAGE BODY PKG IS
+          PROCEDURE P20 (X : OUT LP) IS
+          BEGIN
+               X := 3;
+          END P20;
+
+          PROCEDURE RESET (X : OUT LP) IS
+          BEGIN
+               X := LP(IDENT_INT(0));
+          END RESET;
+
+          FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN L = R;
+          END EQ;
+
+          PACKAGE BODY NESTED IS
+               PROCEDURE NEST1 (X : OUT LP) IS
+               BEGIN
+                    X := 3;
+               END NEST1;
+
+               PROCEDURE NEST2 (X : OUT LP) IS
+               BEGIN
+                    X := LP(IDENT_INT(3));
+               END NEST2;
+          END NESTED;
+     BEGIN
+          VAR := LP(IDENT_INT(0));
+     END PKG;
+
+     PACKAGE PKG1 IS
+          PROCEDURE P21 (X : OUT PKG.LP) RENAMES PKG.P20;   -- OK:
+                                                            -- RENAMING.
+     END PKG1;
+
+BEGIN
+
+     TEST ("C74401E", "CHECK THAT A PROCEDURE CAN HAVE AN OUT " &
+                      "PARAMETER WITH A LIMITED PRIVATE TYPE");
+
+     PKG.RESET (VAR);
+     PKG.P20 (VAR);
+
+     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+          FAILED ("DIRECT CALL NOT CORRECT");
+     END IF;
+
+     PKG.RESET (VAR);
+     PKG1.P21 (VAR);
+
+     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+          FAILED ("RENAMED CALL NOT CORRECT");
+     END IF;
+
+     PKG.RESET (VAR);
+     PKG.NESTED.NEST1 (VAR);
+
+     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+          FAILED ("NESTED CALL NOT CORRECT");
+     END IF;
+
+     RESULT;
+
+END C74401E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401k.ada
new file mode 100644
index 000000000..55f153e0d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401k.ada
@@ -0,0 +1,136 @@
+-- C74401K.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 OUT PARAMETERS OF AN ENTRY DECLARATION CAN HAVE A LIMITED
+-- PRIVATE TYPE IF THE ENTRY DECLARATION OCCURS IN THE VISIBLE PART OF A
+-- PACKAGE SPECIFICATION, INCLUDING WITHIN PACKAGES NESTED IN A VISIBLE
+-- PART.
+
+-- CHECK THAT A RENAMING DECLARATION CAN RENAME AN ENTRY DECLARED
+-- WITH AN OUT PARAMETER.
+
+-- JBG 5/1/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C74401K IS
+
+     PACKAGE PKG IS
+          TYPE LP IS LIMITED PRIVATE;
+          TASK P20 IS
+               ENTRY TP20 (X : OUT LP);        -- OK.
+               ENTRY RESET (X : OUT LP);
+          END P20;
+          FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
+          VAL1 : CONSTANT LP;
+
+          PACKAGE NESTED IS
+               TASK NEST1 IS
+                    ENTRY TNEST1 (X : OUT LP);
+               END NEST1;
+          PRIVATE
+               TASK NEST2 IS
+                    ENTRY TNEST2 (X : OUT LP);
+               END NEST2;
+          END NESTED;
+     PRIVATE
+          TYPE LP IS NEW INTEGER;
+          VAL1 : CONSTANT LP := LP(IDENT_INT(3));
+     END PKG;
+
+     VAR : PKG.LP;
+
+     PACKAGE BODY PKG IS
+          TASK BODY P20 IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT TP20 (X : OUT LP) DO
+                              X := 3;
+                         END TP20;
+                    OR   
+                         ACCEPT RESET (X : OUT LP) DO
+                              X := 0;
+                         END RESET;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END P20;
+
+          FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN L = R;
+          END EQ;
+
+          PACKAGE BODY NESTED IS
+               TASK BODY NEST1 IS
+               BEGIN
+                    ACCEPT TNEST1 (X : OUT LP) DO
+                         X := 3;
+                    END TNEST1;
+               END NEST1;
+
+               TASK BODY NEST2 IS
+               BEGIN
+                    NULL;
+               END NEST2;
+          END NESTED;
+     BEGIN
+          VAR := LP(IDENT_INT(0));
+     END PKG;
+
+     PACKAGE PKG1 IS
+          PROCEDURE P21 (X : OUT PKG.LP) RENAMES PKG.P20.TP20;   -- OK:
+                                                            -- RENAMING.
+     END PKG1;
+
+BEGIN
+
+     TEST ("C74401K", "CHECK THAT A PROCEDURE CAN HAVE AN OUT " &
+                      "PARAMETER WITH A LIMITED PRIVATE TYPE");
+
+     PKG.P20.RESET (VAR);
+     PKG.P20.TP20 (VAR);
+
+     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+          FAILED ("DIRECT CALL NOT CORRECT");
+     END IF;
+
+     PKG.P20.RESET (VAR);
+     PKG1.P21 (VAR);
+
+     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+          FAILED ("RENAMED CALL NOT CORRECT");
+     END IF;
+
+     PKG.P20.RESET (VAR);
+     PKG.NESTED.NEST1.TNEST1 (VAR);
+
+     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+          FAILED ("NESTED CALL NOT CORRECT");
+     END IF;
+
+     RESULT;
+
+END C74401K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401q.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401q.ada
new file mode 100644
index 000000000..7576721a2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74401q.ada
@@ -0,0 +1,119 @@
+-- C74401Q.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 OUT PARAMETERS HAVING A LIMITED PRIVATE TYPE CAN BE
+-- DECLARED FOR A GENERIC SUBPROGRAM IN A PACKAGE SPECIFICATION,
+-- INCLUDING WITHIN PACKAGES NESTED IN A VISIBLE PART.
+
+-- JBG 5/1/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C74401Q IS
+
+     PACKAGE PKG IS
+          TYPE LP IS LIMITED PRIVATE;
+
+          GENERIC
+          PROCEDURE P20 (X : OUT LP);        -- OK.
+          PROCEDURE RESET (X : OUT LP);
+          FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
+          VAL1 : CONSTANT LP;
+
+          PACKAGE NESTED IS
+               GENERIC
+               PROCEDURE NEST1 (X : OUT LP);
+          PRIVATE
+               GENERIC
+               PROCEDURE NEST2 (X : OUT LP);
+          END NESTED;
+     PRIVATE
+          TYPE LP IS NEW INTEGER;
+          VAL1 : CONSTANT LP := LP(IDENT_INT(3));
+     END PKG;
+
+     VAR : PKG.LP;
+
+     PACKAGE BODY PKG IS
+          PROCEDURE P20 (X : OUT LP) IS
+          BEGIN
+               X := 3;
+          END P20;
+
+          PROCEDURE RESET (X : OUT LP) IS
+          BEGIN
+               X := 0;
+          END RESET;
+
+          FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN L = R;
+          END EQ;
+
+          PACKAGE BODY NESTED IS
+               PROCEDURE NEST1 (X : OUT LP) IS
+               BEGIN
+                    X := 3;
+               END NEST1;
+
+               PROCEDURE NEST2 (X : OUT LP) IS
+               BEGIN
+                    X := LP(IDENT_INT(3));
+               END NEST2;
+          END NESTED;
+     BEGIN
+          VAR := LP(IDENT_INT(0));
+     END PKG;
+
+     PACKAGE INSTANCES IS
+          PROCEDURE NP20 IS NEW PKG.P20;
+          PROCEDURE NNEST1 IS NEW PKG.NESTED.NEST1;
+     END INSTANCES;
+     USE INSTANCES;
+
+     PACKAGE PKG1 IS
+          PROCEDURE P21 (X : OUT PKG.LP) RENAMES INSTANCES.NP20;
+     END PKG1;
+
+BEGIN
+
+     TEST ("C74401Q", "CHECK THAT A PROCEDURE CAN HAVE AN OUT " &
+                      "PARAMETER WITH A LIMITED PRIVATE TYPE");
+
+     PKG.RESET (VAR);
+     NP20 (VAR);
+
+     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+          FAILED ("DIRECT CALL NOT CORRECT");
+     END IF;
+
+     PKG.RESET (VAR);
+     PKG1.P21 (VAR);
+
+     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
+          FAILED ("RENAMED CALL NOT CORRECT");
+     END IF;
+
+     RESULT;
+
+END C74401Q;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74402a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74402a.ada
new file mode 100644
index 000000000..3dac5c75a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74402a.ada
@@ -0,0 +1,154 @@
+-- C74402A.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 SUBPROGRAM PARAMETER OF A LIMITED TYPE MAY HAVE A
+-- DEFAULT EXPRESSION, EVEN IF THE SUBPROGRAM IS DECLARED OUTSIDE
+-- THE PACKAGE THAT DECLARES THE LIMITED TYPE.
+-- (SEE ALSO 6.4.2/T1 FOR TESTS OF OTHER LIMITED TYPES.)
+
+-- DSJ 5/6/83
+-- SPS 10/24/83
+
+WITH REPORT;
+PROCEDURE C74402A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C74402A", "CHECK THAT A SUBPROGRAM PARAMETER OF A LIMITED " &
+                     "TYPE MAY HAVE A DEFAULT EXPRESSION, EVEN IF "    &
+                     "THE SUBPROGRAM IS DECLARED OUTSIDE THE PACKAGE " &
+                     "THAT DECLARES THE LIMITED TYPE");
+
+     DECLARE
+
+          PACKAGE PACK1 IS
+
+               TYPE LP1 IS LIMITED PRIVATE;
+               TYPE LP2 IS ARRAY (1 .. 2) OF LP1;
+               TYPE LP3 IS
+                    RECORD
+                         C1, C2 : LP2;
+                    END RECORD;
+
+               FUNCTION F1 RETURN LP1;
+               FUNCTION F2 RETURN LP2;
+               FUNCTION F3 RETURN LP3;
+
+               PROCEDURE G1 (X : LP1 := F1);      -- LEGAL
+               PROCEDURE G2 (X : LP2 := F2);      -- LEGAL
+               PROCEDURE G3 (X : LP3 := F3);      -- LEGAL
+
+          PRIVATE
+
+               TYPE LP1 IS NEW INTEGER;
+
+          END PACK1;
+
+          PACKAGE BODY PACK1 IS
+
+               FUNCTION F1 RETURN LP1 IS
+               BEGIN
+                    RETURN LP1'(1);
+               END F1;
+
+               FUNCTION F2 RETURN LP2 IS
+               BEGIN
+                    RETURN LP2'(2,3);
+               END F2;
+
+               FUNCTION F3 RETURN LP3 IS
+               BEGIN
+                    RETURN LP3'((4,5),(6,7));
+               END F3;
+
+               PROCEDURE G1 (X : LP1 := F1) IS
+               BEGIN
+                    IF X /= LP1'(1) THEN
+                         FAILED("WRONG DEFAULT VALUE - LP1");
+                    END IF;
+               END G1;
+
+               PROCEDURE G2 (X : LP2 := F2) IS
+               BEGIN
+                    IF X /= LP2'(2,3) THEN
+                         FAILED("WRONG DEFAULT VALUE - LP2");
+                    END IF;
+               END G2;
+
+               PROCEDURE G3 (X : LP3 := F3) IS
+               BEGIN
+                    IF X /= LP3'((4,5),(6,7)) THEN
+                         FAILED("WRONG DEFAULT VALUE - LP3");
+                    END IF;
+               END G3;
+
+          BEGIN
+
+               G1;            -- LEGAL, DEFAULT USED
+               G2;            -- LEGAL, DEFAULT USED
+               G3;            -- LEGAL, DEFAULT USED
+
+               G1(F1);        -- LEGAL
+               G2(F2);        -- LEGAL
+               G3(F3);        -- LEGAL
+
+          END PACK1;
+
+          USE PACK1;
+
+          PROCEDURE G4 (X : LP1 := F1) IS
+          BEGIN
+               G1;            -- LEGAL, DEFAULT USED
+               G1(X);
+          END G4;
+
+          PROCEDURE G5 (X : LP2 := F2) IS
+          BEGIN
+               G2;            -- LEGAL, DEFAULT USED
+               G2(X);
+          END G5;
+
+          PROCEDURE G6 (X : LP3 := F3) IS
+          BEGIN
+               G3;            -- DEFAULT USED
+               G3(X);
+          END G6;
+
+     BEGIN
+
+          G4;                 -- LEGAL, DEFAULT USED
+          G5;                 -- LEGAL, DEFAULT USED
+          G6;                 -- LEGAL, DEFAULT USED
+
+          G4(F1);             -- LEGAL
+          G5(F2);             -- LEGAL
+          G6(F3);             -- LEGAL
+
+     END;
+
+     RESULT;
+
+END C74402A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74402b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74402b.ada
new file mode 100644
index 000000000..45597a908
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74402b.ada
@@ -0,0 +1,103 @@
+-- C74402B.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 INITIALIZATION OF IN PARAMETERS THAT ARE OF
+-- LIMITED PRIVATE TYPE IS PERMITTED.
+-- (SEE ALSO 6.4.2/T1 FOR TESTS OF OTHER LIMITED TYPES.)
+
+-- DAS  1/21/81
+-- ABW  6/30/82
+-- BHS  7/10/84
+
+WITH REPORT;
+PROCEDURE C74402B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST( "C74402B" , "CHECK THAT INITIALIZATION OF IN PARAMETERS " &
+                       "OF LIMITED PRIVATE TYPE IS PERMITTED" );
+
+     DECLARE
+
+          PACKAGE PKG IS
+
+               TYPE LPTYPE IS LIMITED PRIVATE;
+               CLP : CONSTANT LPTYPE;
+               XLP : CONSTANT LPTYPE;
+               FUNCTION EQCLP (L : IN LPTYPE) RETURN BOOLEAN;
+               FUNCTION EQXLP (L : IN LPTYPE) RETURN BOOLEAN;
+
+          PRIVATE
+
+               TYPE LPTYPE IS NEW INTEGER RANGE 0..127;
+               CLP : CONSTANT LPTYPE := 127;
+               XLP : CONSTANT LPTYPE := 0;
+
+          END;
+
+          PACKAGE BODY PKG IS
+
+               FUNCTION EQCLP (L : IN LPTYPE) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN (L = CLP);
+               END EQCLP;
+
+               FUNCTION EQXLP (L : IN LPTYPE) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN (L = XLP);
+               END EQXLP;
+
+          END PKG;
+
+          USE PKG;
+
+          PROCEDURE PROC1 (Y : IN LPTYPE := CLP) IS
+          BEGIN
+               IF (EQCLP (Y)) THEN
+                    FAILED( "LIMITED PRIVATE NOT PASSED, " &
+                            "DEFAULT CLP EMPLOYED" );
+               ELSIF (NOT EQXLP (Y)) THEN
+                    FAILED( "NO LIMITED PRIVATE FOUND" );
+               END IF;
+          END PROC1;
+
+          PROCEDURE PROC2 (Y : IN LPTYPE := CLP) IS
+          BEGIN
+               IF (NOT EQCLP(Y)) THEN
+                    FAILED( "DEFAULT NOT EMPLOYED" );
+               END IF;
+          END PROC2;
+
+     BEGIN
+
+          PROC1(XLP);
+          PROC2;
+
+     END;
+
+     RESULT;
+
+END C74402B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74406a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74406a.ada
new file mode 100644
index 000000000..69ddd41b5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74406a.ada
@@ -0,0 +1,130 @@
+-- C74406A.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 FULL DECLARATION OF A LIMITED PRIVATE TYPE CAN
+--     DECLARE A TASK TYPE, A TYPE DERIVED FROM A LIMITED PRIVATE TYPE,
+--     AND A COMPOSITE TYPE WITH A COMPONENT OF A LIMITED TYPE.
+
+-- HISTORY:
+--     BCB 03/10/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C74406A IS
+
+     PACKAGE TP IS
+          TYPE T IS LIMITED PRIVATE;
+          PROCEDURE INIT (Z1 : OUT T; Z2 : INTEGER);
+          FUNCTION EQUAL_T (ONE, TWO : T) RETURN BOOLEAN;
+     PRIVATE
+          TYPE T IS RANGE 1 .. 100;
+     END TP;
+
+     PACKAGE BODY TP IS
+          PROCEDURE INIT (Z1 : OUT T; Z2 : INTEGER) IS
+          BEGIN
+               Z1 := T (Z2);
+          END INIT;
+
+          FUNCTION EQUAL_T (ONE, TWO : T) RETURN BOOLEAN IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN ONE = TWO;
+               ELSE
+                    RETURN ONE /= TWO;
+               END IF;
+          END EQUAL_T;
+     BEGIN
+          NULL;
+     END TP;
+
+     USE TP;
+
+     PACKAGE P IS
+          TYPE T1 IS LIMITED PRIVATE;
+          TYPE T2 IS LIMITED PRIVATE;
+          TYPE T3 IS LIMITED PRIVATE;
+          TYPE T4 IS LIMITED PRIVATE;
+     PRIVATE
+          TASK TYPE T1 IS
+               ENTRY HERE(VAL1 : IN OUT INTEGER);
+          END T1;
+
+          TYPE T2 IS NEW T;
+
+          TYPE T3 IS RECORD
+               INT : T;
+          END RECORD;
+
+          TYPE T4 IS ARRAY(1..5) OF T;
+     END P;
+
+     PACKAGE BODY P IS
+          X1 : T1;
+          X3 : T3;
+          X4 : T4;
+          VAR : INTEGER := 25;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT HERE(VAL1 : IN OUT INTEGER) DO
+                    VAL1 := VAL1 * 2;
+               END HERE;
+          END T1;
+
+     BEGIN
+          TEST ("C74406A", "CHECK THAT THE FULL DECLARATION OF A " &
+                           "LIMITED PRIVATE TYPE CAN DECLARE A TASK " &
+                           "TYPE, A TYPE DERIVED FROM A LIMITED " &
+                           "PRIVATE TYPE, AND A COMPOSITE TYPE WITH " &
+                           "A COMPONENT OF A LIMITED TYPE");
+
+          X1.HERE(VAR);
+
+          IF NOT EQUAL(VAR,IDENT_INT(50)) THEN
+               FAILED ("IMPROPER VALUE FOR VAL");
+          END IF;
+
+          INIT (X3.INT, 50);
+
+          IF X3.INT NOT IN T THEN
+               FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+          END IF;
+
+          INIT (X4(3), 17);
+
+          IF NOT EQUAL_T(T'(X4(3)),T(X4(3))) THEN
+               FAILED ("IMPROPER RESULT FROM QUALIFICATION AND " &
+                       "EXPLICIT CONVERSION");
+          END IF;
+
+          RESULT;
+     END P;
+
+     USE P;
+
+BEGIN
+     NULL;
+END C74406A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74407b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74407b.ada
new file mode 100644
index 000000000..d8f65084c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74407b.ada
@@ -0,0 +1,195 @@
+-- C74407B.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, FOR A LIMITED PRIVATE TYPE, THAT PRE-DEFINED EQUALITY AND
+--     ASSIGNMENT ARE DEFINED AND AVAILABLE WITHIN THE PRIVATE PART AND
+--     THE BODY OF A PACKAGE, AFTER THE FULL DECLARATION, IF THE FULL
+--     DECLARATION IS NOT LIMITED.
+
+-- HISTORY:
+--     BCB 07/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C74407B IS
+
+     PACKAGE PP IS
+          TYPE PRIV IS PRIVATE;
+          C1 : CONSTANT PRIV;
+          C2 : CONSTANT PRIV;
+     PRIVATE
+          TYPE PRIV IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
+          C1 : CONSTANT PRIV := ONE;
+          C2 : CONSTANT PRIV := TWO;
+     END PP;
+
+     USE PP;
+
+     PACKAGE P IS
+          TYPE INT IS LIMITED PRIVATE;
+          TYPE COMP IS LIMITED PRIVATE;
+          TYPE DER IS LIMITED PRIVATE;
+     PRIVATE
+          TYPE INT IS RANGE 1 .. 100;
+          TYPE COMP IS ARRAY(1..5) OF INTEGER;
+          TYPE DER IS NEW PRIV;
+          D, E : INT := 10;
+          F : INT := 20;
+          CONS_INT1 : CONSTANT INT := 30;
+          G : BOOLEAN := D = E;
+          H : BOOLEAN := D /= F;
+          CONS_BOOL1 : CONSTANT BOOLEAN := D = E;
+          CONS_BOOL2 : CONSTANT BOOLEAN := D /= F;
+          I : COMP := (1,2,3,4,5);
+          CONS_COMP1 : CONSTANT COMP := (6,7,8,9,10);
+          J : DER := DER(C1);
+          CONS_DER1 : CONSTANT DER := DER(C2);
+     END P;
+
+     PACKAGE BODY P IS
+          A, B, C : INT;
+          X, Y, Z : COMP;
+          L, M, N : DER;
+          CONS_INT2 : CONSTANT INT := 10;
+          CONS_COMP2 : CONSTANT COMP := (1,2,3,4,5);
+          CONS_DER2 : CONSTANT DER := DER(C1);
+     BEGIN
+          TEST ("C74407B", "CHECK, FOR A LIMITED PRIVATE TYPE, THAT " &
+                           "PRE-DEFINED EQUALITY AND ASSIGNMENT ARE " &
+                           "DEFINED AND AVAILABLE WITHIN THE PRIVATE " &
+                           "PART AND THE BODY OF A PACKAGE, AFTER " &
+                           "THE FULL DECLARATION, IF THE FULL " &
+                           "DECLARATION IS NOT LIMITED");
+
+          A := 10;
+
+          B := 10;
+
+          C := 20;
+
+          IF A = C THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 1");
+          END IF;
+
+          IF A /= B THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 1");
+          END IF;
+
+          IF CONS_INT2 = C THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 2");
+          END IF;
+
+          IF CONS_INT2 /= B THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 2");
+          END IF;
+
+          IF NOT G THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                       "OPERATION WITHIN THE PRIVATE PART OF THE " &
+                       "PACKAGE - 1");
+          END IF;
+
+          IF NOT H THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                       "OPERATION WITHIN THE PRIVATE PART OF THE " &
+                       "PACKAGE - 1");
+          END IF;
+
+          IF NOT CONS_BOOL1 THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                       "OPERATION WITHIN THE PRIVATE PART OF THE " &
+                       "PACKAGE - 2");
+          END IF;
+
+          IF NOT CONS_BOOL2 THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                       "OPERATION WITHIN THE PRIVATE PART OF THE " &
+                       "PACKAGE - 2");
+          END IF;
+
+          X := (1,2,3,4,5);
+
+          Y := (1,2,3,4,5);
+
+          Z := (5,4,3,2,1);
+
+          IF X = Z THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 3");
+          END IF;
+
+          IF X /= Y THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 3");
+          END IF;
+
+          IF CONS_COMP2 = Z THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 4");
+          END IF;
+
+          IF CONS_COMP2 /= Y THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 4");
+          END IF;
+
+          L := DER(C1);
+
+          M := DER(C1);
+
+          N := DER(C2);
+
+          IF L = N THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 5");
+          END IF;
+
+          IF L /= M THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 5");
+          END IF;
+
+          IF CONS_DER2 = N THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 6");
+          END IF;
+
+          IF CONS_DER2 /= M THEN
+               FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
+                       "OPERATION WITHIN THE PACKAGE BODY - 6");
+          END IF;
+
+          RESULT;
+     END P;
+
+     USE P;
+
+BEGIN
+     NULL;
+END C74407B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74409b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74409b.ada
new file mode 100644
index 000000000..0bd2a065b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c74409b.ada
@@ -0,0 +1,93 @@
+-- C74409B.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 COMPOSITE TYPE IS DECLARED IN THE SAME PACKAGE 
+-- AS A LIMITED PRIVATE TYPE AND HAS A COMPONENT OF THAT TYPE, 
+-- THE COMPOSITE TYPE IS TREATED AS A LIMITED TYPE UNTIL THE 
+-- EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE DECLARATION 
+-- OF THE COMPOSITE TYPE AND AFTER THE FULL DECLARATION OF THE 
+-- LIMITED PRIVATE TYPE
+
+-- DSJ 5/5/83
+-- JBG 9/23/83
+
+WITH REPORT;
+PROCEDURE C74409B IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C74409B", "CHECK THAT A COMPOSITE TYPE WITH A LIMITED " &
+                     "PRIVATE COMPONENT IS TREATED AS A LIMITED " &
+                     "TYPE UNTIL ASSIGNMENT AND EQUALITY ARE BOTH " &
+                     "AVAILABLE FOR THE COMPOSITE TYPE");
+
+     DECLARE
+
+          PACKAGE P IS
+               TYPE LP IS LIMITED PRIVATE;
+               PACKAGE Q IS
+                    TYPE LP_ARRAY IS ARRAY (1 .. 2) OF LP;
+               END Q;
+          PRIVATE
+               TYPE LP IS NEW INTEGER;
+          END P;
+
+          PACKAGE BODY P IS
+               USE Q;
+               FUNCTION "=" (L,R : LP_ARRAY) RETURN BOOLEAN IS  -- LEGAL
+               BEGIN
+                    RETURN TRUE;
+               END;
+
+               GENERIC
+                    TYPE T IS PRIVATE;     -- NOTE: NOT LIMITED PRIVATE
+                    C, D : T;
+               PACKAGE A IS
+                    -- IRRELEVANT DETAILS
+               END A;
+
+               PACKAGE BODY A IS
+               BEGIN
+                    IF C = D THEN
+                         FAILED ("USED WRONG EQUALITY OPERATOR");
+                    END IF;
+               END A;
+
+               PACKAGE BODY Q IS
+                    PACKAGE ANOTHER_NEW_A IS 
+                         NEW A (LP_ARRAY, (2,3), (4,5)); -- LEGAL
+               END Q;
+          END P;
+
+     BEGIN
+
+          NULL;
+
+     END;
+
+     RESULT;
+
+END C74409B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760001.a
new file mode 100644
index 000000000..be9ff8194
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760001.a
@@ -0,0 +1,390 @@
+-- C760001.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 Initialize is called for objects and components of
+--      a controlled type when the objects and components are not
+--      assigned explicit initial values.  Check this for "simple" controlled
+--      objects, controlled record components and arrays with controlled
+--      components.
+--
+--      Check that if an explicit initial value is assigned to an object
+--      or component of a controlled type then Initialize is not called.
+--
+-- TEST DESCRIPTION:
+--      This test derives a type for Ada.Finalization.Controlled, and
+--      overrides the Initialize and Adjust operations for the type.  The
+--      intent of the type is that it should carry incremental values
+--      indicating the ordering of events with respect to these (and default
+--      initialization) operations.  The body of the test uses these values
+--      to determine that the implicit calls to these subprograms happen
+--      (or don't) at the appropriate times.
+--
+--      The test further derives types from this "root" type, which are the
+--      actual types used in the test.  One of the types is "simply" derived
+--      from the "root" type, the other contains a component of the first
+--      type, thus nesting a controlled object as a record component in
+--      controlled objects.
+--
+--      The main program declares objects of these types and checks the
+--      values of the components to ascertain that they have been touched
+--      as expected.
+--
+--      Note that Finalization procedures are provided.  This test does not
+--      test that the calls to Finalization are made correctly.  The
+--      Finalization procedures are provided to catch an implementation that
+--      calls Finalization at an incorrect time.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Oct 95   SAIC    Update and repair for ACVC 2.0.1
+--
+--!
+
+---------------------------------------------------------------- C760001_0
+
+with Ada.Finalization;
+package C760001_0 is
+  subtype Unique_ID is Natural;
+  function Unique_Value return Unique_ID;
+  -- increments each time it's called
+
+  function Most_Recent_Unique_Value return Unique_ID;
+  -- returns the same value as the most recent call to Unique_Value
+
+  type Root_Controlled is new Ada.Finalization.Controlled with record
+    My_ID      : Unique_ID := Unique_Value;
+    My_Init_ID : Unique_ID := Unique_ID'First;
+    My_Adj_ID  : Unique_ID := Unique_ID'First;
+  end record;
+
+  procedure Initialize( R: in out Root_Controlled );
+  procedure Adjust    ( R: in out Root_Controlled );
+
+  TC_Initialize_Calls_Is_Failing : Boolean := False;
+
+end C760001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body C760001_0 is
+
+  Global_Unique_Counter : Unique_ID := 0;
+  
+  function Unique_Value return Unique_ID is
+  begin
+    Global_Unique_Counter := Global_Unique_Counter +1;
+    return Global_Unique_Counter;
+  end Unique_Value;
+  
+  function Most_Recent_Unique_Value return Unique_ID is
+  begin
+    return Global_Unique_Counter;
+  end Most_Recent_Unique_Value;
+  
+  procedure Initialize( R: in out Root_Controlled ) is
+  begin
+    if TC_Initialize_Calls_Is_Failing then
+      Report.Failed("Initialized incorrectly called");
+    end if;
+    R.My_Init_ID := Unique_Value;
+  end Initialize;
+
+  procedure Adjust( R: in out Root_Controlled ) is
+  begin
+    R.My_Adj_ID := Unique_Value;
+  end Adjust;
+
+end C760001_0;
+
+---------------------------------------------------------------- C760001_1
+
+with Ada.Finalization;
+with C760001_0;
+package C760001_1 is
+
+  type Proc_ID is (None, Init, Adj, Fin);
+
+  type Test_Controlled is new C760001_0.Root_Controlled with record
+    Last_Proc_Called: Proc_ID := None;
+  end record;
+
+  procedure Initialize( TC: in out Test_Controlled );
+  procedure Adjust    ( TC: in out Test_Controlled );
+  procedure Finalize  ( TC: in out Test_Controlled );
+
+  type Nested_Controlled is new C760001_0.Root_Controlled with record
+    Nested : C760001_0.Root_Controlled;
+    Last_Proc_Called: Proc_ID := None;
+  end record;
+
+  procedure Initialize( TC: in out Nested_Controlled );
+  procedure Adjust    ( TC: in out Nested_Controlled );
+  procedure Finalize  ( TC: in out Nested_Controlled );
+
+end C760001_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body C760001_1 is
+
+  procedure Initialize( TC: in out Test_Controlled ) is
+  begin
+    if TC.Last_Proc_Called /= None then
+      Report.Failed("Initialize for Test_Controlled");
+    end if;
+    TC.Last_Proc_Called := Init;
+    C760001_0.Initialize(C760001_0.Root_Controlled(TC));
+  end Initialize;
+
+  procedure Adjust    ( TC: in out Test_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Adj;
+    C760001_0.Adjust(C760001_0.Root_Controlled(TC));
+  end Adjust;
+
+  procedure Finalize  ( TC: in out Test_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Fin;
+  end Finalize;
+
+  procedure Initialize( TC: in out Nested_Controlled ) is
+  begin
+    if TC.Last_Proc_Called /= None then
+      Report.Failed("Initialize for Nested_Controlled");
+    end if;
+    TC.Last_Proc_Called := Init;
+    C760001_0.Initialize(C760001_0.Root_Controlled(TC));
+  end Initialize;
+
+  procedure Adjust    ( TC: in out Nested_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Adj;
+    C760001_0.Adjust(C760001_0.Root_Controlled(TC));
+  end Adjust;
+
+  procedure Finalize  ( TC: in out Nested_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Fin;
+  end Finalize;
+
+end C760001_1;
+
+---------------------------------------------------------------- C760001
+
+with Report;
+with TCTouch;
+with C760001_0;
+with C760001_1;
+with Ada.Finalization;
+procedure C760001 is
+
+  use type C760001_1.Proc_ID;
+
+  -- in the first test, test the simple case.  Check that a controlled object
+  -- causes a call to the procedure Initialize.
+  -- Also check that assignment causes a call to Adjust.
+
+  procedure Check_Simple_Objects is
+    S,T : C760001_1.Test_Controlled;
+  begin
+    TCTouch.Assert(S.My_ID < S.My_Init_ID,"Default before dispatch");
+    TCTouch.Assert((S.Last_Proc_Called = C760001_1.Init) and
+                                        (T.Last_Proc_Called = C760001_1.Init),
+                   "Initialize for simple object");
+    S := T;
+    TCTouch.Assert((S.Last_Proc_Called = C760001_1.Adj),
+                   "Adjust for simple object");
+    TCTouch.Assert((S.My_ID = T.My_ID),
+                   "Simple object My_ID's don't match");
+    TCTouch.Assert((S.My_Init_ID = T.My_Init_ID),
+                   "Simple object My_Init_ID's don't match");
+    TCTouch.Assert((S.My_Adj_ID > T.My_Adj_ID),
+                   "Simple object My_Adj_ID's in wrong order");
+  end Check_Simple_Objects;
+
+  -- in the second test, test a more complex case, check that a controlled
+  -- component of a controlled object gets processed correctly
+
+  procedure Check_Nested_Objects is
+    NO1 : C760001_1.Nested_Controlled;
+  begin
+    TCTouch.Assert((NO1.My_ID < NO1.My_Init_Id),
+                   "Default value order incorrect");
+    TCTouch.Assert((NO1.My_Init_Id > NO1.Nested.My_Init_ID),
+                   "Initialization call order incorrect");
+  end Check_Nested_Objects;
+
+  -- check that objects assigned an initial value at declaration are Adjusted
+  -- and NOT Initialized
+
+  procedure Check_Objects_With_Initial_Values is
+
+    TC_Now : constant C760001_0.Unique_ID := C760001_0.Unique_Value;
+
+    A: C760001_1.Test_Controlled := 
+      ( Ada.Finalization.Controlled
+        with TC_Now,
+             TC_Now,
+             TC_Now,
+             C760001_1.None);
+
+    B: C760001_1.Nested_Controlled := 
+      ( Ada.Finalization.Controlled
+        with TC_Now,
+             TC_Now,
+             TC_Now,
+             C760001_0.Root_Controlled(A),
+             C760001_1.None);
+
+  begin
+    -- the implementation may or may not call Adjust for the values
+    -- assigned into A and B,
+    -- but should NOT call Initialize.
+    -- if the value used in the aggregate is overwritten by Initialize,
+    -- this indicates failure
+    TCTouch.Assert(A.My_Init_Id = TC_Now,
+                   "Initialize was called for A with initial value");
+    TCTouch.Assert(B.My_Init_Id = TC_Now,
+                   "Initialize was called for B with initial value");
+    TCTouch.Assert(B.Nested.My_Init_ID = TC_Now,
+                   "Initialize was called for B.Nested initial value");
+  end Check_Objects_With_Initial_Values;
+
+  procedure Check_Array_Case is
+    type Array_Simple is array(1..4) of C760001_1.Test_Controlled;
+    type Array_Nested is array(1..4) of C760001_1.Nested_Controlled;
+
+    Simple_Array_Default : Array_Simple;
+
+    Nested_Array_Default : Array_Nested;
+
+    TC_A_Bit_Later : C760001_0.Unique_ID;
+
+  begin
+    TC_A_Bit_Later := C760001_0.Unique_Value;
+    for N in 1..4 loop
+      TCTouch.Assert(Simple_Array_Default(N).Last_Proc_Called
+                     = C760001_1.Init,
+                     "Initialize for array initial value");
+
+      TCTouch.Assert( (Simple_Array_Default(N).My_Init_ID
+                       > C760001_0.Unique_ID'First)
+                      and (Simple_Array_Default(N).My_Init_ID
+                       < TC_A_Bit_Later),
+                     "Initialize timing for simple array");
+
+      TCTouch.Assert( (Nested_Array_Default(N).My_Init_ID
+                       > C760001_0.Unique_ID'First)
+                      and (Nested_Array_Default(N).My_Init_ID
+                       < TC_A_Bit_Later),
+                     "Initialize timing for container array");
+
+      TCTouch.Assert(Nested_Array_Default(N).Last_Proc_Called
+                     = C760001_1.Init,
+                     "Initialize for nested array (outer) initial value");
+
+      TCTouch.Assert( (Nested_Array_Default(N).Nested.My_Init_ID
+                       > C760001_0.Unique_ID'First)
+                      and (Nested_Array_Default(N).Nested.My_Init_ID
+                       < Nested_Array_Default(N).My_Init_ID),
+                     "Initialize timing for array content");
+    end loop;
+  end Check_Array_Case;
+
+  procedure Check_Array_Case_With_Initial_Values is
+
+    TC_Now : constant C760001_0.Unique_ID := C760001_0.Unique_Value;
+
+    type Array_Simple is array(1..4) of C760001_1.Test_Controlled;
+    type Array_Nested is array(1..4) of C760001_1.Nested_Controlled;
+
+    Simple_Array_Explicit : Array_Simple := ( 1..4 => (
+        Ada.Finalization.Controlled
+        with TC_Now,
+             TC_Now,
+             TC_Now,
+             C760001_1.None                 )         );
+
+    A : constant C760001_0.Root_Controlled := 
+      ( Ada.Finalization.Controlled
+        with others => TC_Now);
+
+    Nested_Array_Explicit : Array_Nested := ( 1..4 => (
+        Ada.Finalization.Controlled
+        with TC_Now,
+             TC_Now,
+             TC_Now,
+             A,
+             C760001_1.None                 )         );
+
+  begin
+    -- the implementation may or may not call Adjust for the values
+    -- assigned into Simple_Array_Explicit and Nested_Array_Explicit,
+    -- but should NOT call Initialize.
+    -- if the value used in the aggregate is overwritten by Initialize,
+    -- this indicates failure
+    for N in 1..4 loop
+      TCTouch.Assert(Simple_Array_Explicit(N).My_Init_ID
+                     = TC_Now,
+                     "Initialize was called for array with initial value");
+      TCTouch.Assert(Nested_Array_Explicit(N).My_Init_ID
+                     = TC_Now,
+        "Initialize was called for nested array (outer) with initial value");
+      TCTouch.Assert(Nested_Array_Explicit(N).Nested.My_Init_ID = TC_Now,
+        "Initialize was called for nested array (inner) with initial value");
+    end loop;
+  end Check_Array_Case_With_Initial_Values;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+begin  -- Main test procedure.
+
+  Report.Test ("C760001", "Check that Initialize is called for objects " &
+                          "and components of a controlled type when the " &
+                          "objects and components are not assigned " &
+                          "explicit initial values.  Check that if an " &
+                          "explicit initial value is assigned to an " &
+                          "object or component of a controlled type " &
+                          "then Initialize is not called" );
+
+  Check_Simple_Objects;
+
+  Check_Nested_Objects;
+
+  Check_Array_Case;
+
+  C760001_0.TC_Initialize_Calls_Is_Failing := True;
+
+  Check_Objects_With_Initial_Values;
+
+  Check_Array_Case_With_Initial_Values;
+
+  Report.Result;
+
+end C760001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760002.a
new file mode 100644
index 000000000..4601873be
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760002.a
@@ -0,0 +1,489 @@
+-- C760002.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 assignment to an object of a (non-limited) controlled
+--      type causes the Adjust operation of the type to be called.
+--      Check that Adjust is called after copying the value of the
+--      source expression to the target object.
+--
+--      Check that Adjust is called for all controlled components when
+--      the containing object is assigned.  (Test this for the cases
+--      where the type of the containing object is controlled and
+--      noncontrolled; test this for initialization as well as
+--      assignment statements.)
+--
+--      Check that for an object of a controlled type with controlled
+--      components, Adjust for each of the components is called before
+--      the containing object is adjusted.
+--
+--      Check that an Adjust procedure for a Limited_Controlled type is
+--      not called by the implementation.
+--
+-- TEST DESCRIPTION:
+--      This test is loosely "derived" from C760001.
+--
+--      Visit Tags:
+--        D - Default value at declaration
+--        d - Default value at declaration, limited root
+--        I - initialize at root controlled
+--        i - initialize at root limited controlled
+--        A - adjust at root controlled
+--        X,Y,Z,x,y,z - used in test body
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Correct test assertion logic for Sinister case
+--
+--!
+
+---------------------------------------------------------------- C760002_0
+
+with Ada.Finalization;
+package C760002_0 is
+  subtype Unique_ID is Natural;
+  function Unique_Value return Unique_ID;
+  -- increments each time it's called
+
+  function Most_Recent_Unique_Value return Unique_ID;
+  -- returns the same value as the most recent call to Unique_Value
+
+  type Root is tagged record
+    My_ID      : Unique_ID := Unique_Value;
+    Visit_Tag  : Character := 'D';  -- Default
+  end record;
+
+  procedure Initialize( R: in out Root );
+  procedure Adjust    ( R: in out Root );
+
+  type Root_Controlled is new Ada.Finalization.Controlled with record
+    My_ID      : Unique_ID := Unique_Value;
+    Visit_Tag  : Character := 'D'; ---------------------------------------- D
+  end record;
+
+  procedure Initialize( R: in out Root_Controlled );
+  procedure Adjust    ( R: in out Root_Controlled );
+
+  type Root_Limited_Controlled is
+       new Ada.Finalization.Limited_Controlled with record
+    My_ID      : Unique_ID := Unique_Value;
+    Visit_Tag  : Character := 'd'; ---------------------------------------- d
+  end record;
+
+  procedure Initialize( R: in out Root_Limited_Controlled );
+  procedure Adjust    ( R: in out Root_Limited_Controlled );
+
+end C760002_0;
+
+with Report;
+package body C760002_0 is
+
+  Global_Unique_Counter : Unique_ID := 0;
+  
+  function Unique_Value return Unique_ID is
+  begin
+    Global_Unique_Counter := Global_Unique_Counter +1;
+    return Global_Unique_Counter;
+  end Unique_Value;
+  
+  function Most_Recent_Unique_Value return Unique_ID is
+  begin
+    return Global_Unique_Counter;
+  end Most_Recent_Unique_Value;
+
+  procedure Initialize( R: in out Root ) is
+  begin
+    Report.Failed("Initialize called for Non_Controlled type");
+  end Initialize;
+
+  procedure Adjust    ( R: in out Root ) is
+  begin
+    Report.Failed("Adjust called for Non_Controlled type");
+  end Adjust;
+
+  procedure Initialize( R: in out Root_Controlled ) is
+  begin
+    R.Visit_Tag := 'I'; --------------------------------------------------- I
+  end Initialize;
+
+  procedure Adjust( R: in out Root_Controlled ) is
+  begin
+    R.Visit_Tag := 'A'; --------------------------------------------------- A
+  end Adjust;
+
+  procedure Initialize( R: in out Root_Limited_Controlled ) is
+  begin
+    R.Visit_Tag := 'i'; --------------------------------------------------- i
+  end Initialize;
+
+  procedure Adjust( R: in out Root_Limited_Controlled ) is
+  begin
+    Report.Failed("Adjust called for Limited_Controlled type");
+  end Adjust;
+
+end C760002_0;
+
+---------------------------------------------------------------- C760002_1
+
+with Ada.Finalization;
+with C760002_0;
+package C760002_1 is
+
+  type Proc_ID is (None, Init, Adj, Fin);
+
+  type Test_Controlled is new C760002_0.Root_Controlled with record
+    Last_Proc_Called: Proc_ID := None;
+  end record;
+
+  procedure Initialize( TC: in out Test_Controlled );
+  procedure Adjust    ( TC: in out Test_Controlled );
+  procedure Finalize  ( TC: in out Test_Controlled );
+
+  type Nested_Controlled is new C760002_0.Root_Controlled with record
+    Nested : C760002_0.Root_Controlled;
+    Last_Proc_Called: Proc_ID := None;
+  end record;
+
+  procedure Initialize( TC: in out Nested_Controlled );
+  procedure Adjust    ( TC: in out Nested_Controlled );
+  procedure Finalize  ( TC: in out Nested_Controlled );
+
+  type Test_Limited_Controlled is
+       new C760002_0.Root_Limited_Controlled with record
+    Last_Proc_Called: Proc_ID := None;
+  end record;
+
+  procedure Initialize( TC: in out Test_Limited_Controlled );
+  procedure Adjust    ( TC: in out Test_Limited_Controlled );
+  procedure Finalize  ( TC: in out Test_Limited_Controlled );
+
+  type Nested_Limited_Controlled is
+       new C760002_0.Root_Limited_Controlled with record
+    Nested : C760002_0.Root_Limited_Controlled;
+    Last_Proc_Called: Proc_ID := None;
+  end record;
+
+  procedure Initialize( TC: in out Nested_Limited_Controlled );
+  procedure Adjust    ( TC: in out Nested_Limited_Controlled );
+  procedure Finalize  ( TC: in out Nested_Limited_Controlled );
+
+end C760002_1;
+
+with Report;
+package body C760002_1 is
+
+  procedure Initialize( TC: in out Test_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Init;
+    C760002_0.Initialize(C760002_0.Root_Controlled(TC));
+  end Initialize;
+
+  procedure Adjust    ( TC: in out Test_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Adj;
+    C760002_0.Adjust(C760002_0.Root_Controlled(TC));
+  end Adjust;
+
+  procedure Finalize  ( TC: in out Test_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Fin;
+  end Finalize;
+
+  procedure Initialize( TC: in out Nested_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Init;
+    C760002_0.Initialize(C760002_0.Root_Controlled(TC));
+  end Initialize;
+
+  procedure Adjust    ( TC: in out Nested_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Adj;
+    C760002_0.Adjust(C760002_0.Root_Controlled(TC));
+  end Adjust;
+
+  procedure Finalize  ( TC: in out Nested_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Fin;
+  end Finalize;
+
+  procedure Initialize( TC: in out Test_Limited_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Init;
+    C760002_0.Initialize(C760002_0.Root_Limited_Controlled(TC));
+  end Initialize;
+
+  procedure Adjust    ( TC: in out Test_Limited_Controlled ) is
+  begin
+    Report.Failed("Adjust called for Test_Limited_Controlled");
+  end Adjust;
+
+  procedure Finalize  ( TC: in out Test_Limited_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Fin;
+  end Finalize;
+
+  procedure Initialize( TC: in out Nested_Limited_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Init;
+    C760002_0.Initialize(C760002_0.Root_Limited_Controlled(TC));
+  end Initialize;
+
+  procedure Adjust    ( TC: in out Nested_Limited_Controlled ) is
+  begin
+    Report.Failed("Adjust called for Nested_Limited_Controlled");
+  end Adjust;
+
+  procedure Finalize  ( TC: in out Nested_Limited_Controlled ) is
+  begin
+    TC.Last_Proc_Called := Fin;
+  end Finalize;
+
+end C760002_1;
+
+---------------------------------------------------------------- C760002
+
+with Report;
+with TCTouch;
+with C760002_0;
+with C760002_1;
+with Ada.Finalization;
+procedure C760002 is
+
+  use type C760002_1.Proc_ID;
+
+  -- in the first test, test the simple cases.
+  -- Also check that assignment causes a call to Adjust for a controlled
+  -- object.  Check that assignment of a non-controlled object does not call
+  -- an Adjust procedure.
+
+  procedure Check_Simple_Objects is
+
+    A,B : C760002_0.Root;
+    S,T : C760002_1.Test_Controlled;
+    Q   : C760002_1.Test_Limited_Controlled;  -- Adjust call shouldn't happen
+  begin
+
+    S := T;
+
+    TCTouch.Assert((S.Last_Proc_Called = C760002_1.Adj),
+                   "Adjust for simple object");
+    TCTouch.Assert((S.My_ID = T.My_ID),
+                   "Assignment failed for simple object");
+
+    -- Check that adjust was called
+    TCTouch.Assert((S.Visit_Tag = 'A'), "Adjust timing incorrect");
+
+    -- Check that Adjust has not been called
+    TCTouch.Assert_Not((T.Visit_Tag = 'A'), "Adjust incorrectly called");
+
+    -- Check that Adjust does not get called
+    A.My_ID := A.My_ID +1;
+    B := A;  -- see: Adjust: Report.Failed
+
+  end Check_Simple_Objects;
+
+  -- in the second test, test a more complex case, check that a controlled
+  -- component of a controlled object gets processed correctly
+
+  procedure Check_Nested_Objects is
+    NO1 : C760002_1.Nested_Controlled;
+    NO2 : C760002_1.Nested_Controlled := NO1;
+
+  begin
+
+    -- NO2 should be flagged with adjust markers
+    TCTouch.Assert((NO2.Last_Proc_Called = C760002_1.Adj),
+                   "Adjust not called for NO2 enclosure declaration");
+    TCTouch.Assert((NO2.Nested.Visit_Tag = 'A'),
+                   "Adjust not called for NO2 enclosed declaration");
+
+    NO2.Visit_Tag := 'x';
+    NO2.Nested.Visit_Tag := 'y';
+
+    NO1 := NO2;
+
+    -- NO1 should be flagged with adjust markers
+    TCTouch.Assert((NO1.Visit_Tag = 'A'),
+                   "Adjust not called for NO1 enclosure declaration");
+    TCTouch.Assert((NO1.Nested.Visit_Tag = 'A'),
+                   "Adjust not called for NO1 enclosed declaration");
+
+  end Check_Nested_Objects;
+
+  procedure Check_Array_Case is
+    type Array_Simple is array(1..4) of C760002_1.Test_Controlled;
+    type Array_Nested is array(1..4) of C760002_1.Nested_Controlled;
+
+    Left,Right      : Array_Simple;
+    Overlap         : Array_Simple := Left;
+
+    Sinister,Dexter : Array_Nested;
+    Underlap        : Array_Nested := Sinister;
+
+    Now : Natural;
+
+  begin
+
+    -- get a current unique value since initializations
+    Now := C760002_0.Unique_Value;
+
+    -- check results of declarations
+    for N in 1..4 loop
+      TCTouch.Assert(Left(N).My_Id < Now,
+                     "Initialize for array initial value");
+      TCTouch.Assert(Overlap(N).My_Id < Now,
+                     "Adjust for nested array (outer) initial value");
+      TCTouch.Assert(Sinister(N).Nested.My_Id < Now,
+                     "Initialize for nested array (inner) initial value");
+      TCTouch.Assert(Sinister(N).My_Id < Sinister(N).Nested.My_Id,
+                     "Initialize for enclosure should be after enclosed");
+      TCTouch.Assert(Overlap(N).Visit_Tag = 'A',"Adjust at declaration");
+      TCTouch.Assert(Underlap(N).Nested.Visit_Tag = 'A',
+                     "Adjust at declaration, nested object");
+    end loop;
+
+    -- set visit tags
+    for O in 1..4 loop
+      Overlap(O).Visit_Tag         := 'X';
+      Underlap(O).Visit_Tag        := 'Y';
+      Underlap(O).Nested.Visit_Tag := 'y';
+    end loop;
+
+    -- check that overlapping assignments don't cause odd grief
+    Overlap(1..3)  := Overlap(2..4);
+    Underlap(2..4) := Underlap(1..3);
+
+    for M in 2..3 loop
+      TCTouch.Assert(Overlap(M).Last_Proc_Called = C760002_1.Adj,
+                     "Adjust for overlap");
+      TCTouch.Assert(Overlap(M).Visit_Tag = 'A',
+                     "Adjust for overlap ID");
+      TCTouch.Assert(Underlap(M).Last_Proc_Called = C760002_1.Adj,
+                     "Adjust for Underlap");
+      TCTouch.Assert(Underlap(M).Nested.Visit_Tag = 'A',
+                     "Adjust for Underlaps nested ID");
+    end loop;
+
+  end Check_Array_Case;
+
+  procedure Check_Access_Case is
+    type TC_Ref is access C760002_1.Test_Controlled;
+    type NC_Ref is access C760002_1.Nested_Controlled;
+    type TL_Ref is access C760002_1.Test_Limited_Controlled;
+    type NL_Ref is access C760002_1.Nested_Limited_Controlled;
+
+    A,B : TC_Ref;
+    C,D : NC_Ref;
+    E   : TL_Ref;
+    F   : NL_Ref;
+
+  begin
+
+    A := new C760002_1.Test_Controlled;
+    B := new C760002_1.Test_Controlled'( A.all );
+
+    C := new C760002_1.Nested_Controlled;
+    D := new C760002_1.Nested_Controlled'( C.all );
+
+    E := new C760002_1.Test_Limited_Controlled;
+    F := new C760002_1.Nested_Limited_Controlled;
+
+    TCTouch.Assert(A.Visit_Tag = 'I',"TC Allocation");
+    TCTouch.Assert(B.Visit_Tag = 'A',"TC Allocation, with value");
+
+    TCTouch.Assert(C.Visit_Tag = 'I',"NC Allocation");
+    TCTouch.Assert(C.Nested.Visit_Tag = 'I',"NC Allocation, Nested");
+    TCTouch.Assert(D.Visit_Tag = 'A',"NC Allocation, with value");
+    TCTouch.Assert(D.Nested.Visit_Tag = 'A',
+                   "NC Allocation, Nested, with value");
+
+    TCTouch.Assert(E.Visit_Tag = 'i',"TL Allocation");
+    TCTouch.Assert(F.Visit_Tag = 'i',"NL Allocation");
+
+    A.all := B.all;
+    C.all := D.all;
+
+    TCTouch.Assert(A.Visit_Tag = 'A',"TC Assignment");
+    TCTouch.Assert(C.Visit_Tag = 'A',"NC Assignment");
+    TCTouch.Assert(C.Nested.Visit_Tag = 'A',"NC Assignment, Nested");
+
+  end Check_Access_Case;
+
+  procedure Check_Access_Limited_Array_Case is
+    type Array_Simple is array(1..4) of C760002_1.Test_Limited_Controlled;
+    type AS_Ref is access Array_Simple;
+    type Array_Nested is array(1..4) of C760002_1.Nested_Limited_Controlled;
+    type AN_Ref is access Array_Nested;
+
+    Simple_Array_Limited : AS_Ref;
+
+    Nested_Array_Limited : AN_Ref;
+
+  begin
+
+    Simple_Array_Limited := new Array_Simple;
+
+    Nested_Array_Limited := new Array_Nested;
+    
+    for N in 1..4 loop
+      TCTouch.Assert(Simple_Array_Limited(N).Last_Proc_Called
+                     = C760002_1.Init,  
+                     "Initialize for array initial value");
+      TCTouch.Assert(Nested_Array_Limited(N).Last_Proc_Called
+                     = C760002_1.Init,
+                     "Initialize for nested array (outer) initial value");
+      TCTouch.Assert(Nested_Array_Limited(N).Nested.Visit_Tag = 'i',
+                     "Initialize for nested array (inner) initial value");
+    end loop;
+  end Check_Access_Limited_Array_Case;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C760002", "Check that assignment causes the Adjust " &
+                          "operation of the type to be called.  Check " &
+                          "that Adjust is called after copying the " &
+                          "value of the source expression to the target " &
+                          "object.  Check that Adjust is called for all " &
+                          "controlled components when the containing " &
+                          "object is assigned.  Check that Adjust is " &
+                          "called for components before the containing " &
+                          "object is adjusted.  Check that Adjust is not " &
+                          "called for a Limited_Controlled type by the " &
+                          "implementation" );
+
+  Check_Simple_Objects;
+
+  Check_Nested_Objects;
+
+  Check_Array_Case;
+
+  Check_Access_Case;
+
+  Check_Access_Limited_Array_Case;
+
+  Report.Result;
+
+end C760002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760007.a
new file mode 100644
index 000000000..c1ddfcb93
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760007.a
@@ -0,0 +1,247 @@
+-- C760007.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 Adjust is called for the execution of a return
+--      statement for a function returning a result of a (non-limited)
+--      controlled type.
+--
+--      Check that Adjust is called when evaluating an aggregate
+--      component association for a controlled component.
+--
+--      Check that Adjust is called for the assignment of the ancestor
+--      expression of an extension aggregate when the type of the
+--      aggregate is controlled.
+--
+-- TEST DESCRIPTION:
+--      A type is derived from Ada.Finalization.Controlled; the dispatching
+--      procedure Adjust is defined for the new type.  Structures and
+--      subprograms to model the test objectives are used to check that
+--      Adjust is called at the right time.  For the sake of simplicity,
+--      globally accessible data is used to check that the calls are made.
+--
+--
+-- CHANGE HISTORY:
+--      06 DEC 94   SAIC    ACVC 2.0
+--      14 OCT 95   SAIC    Update and repair for ACVC 2.0.1
+--      05 APR 96   SAIC    Add RM reference
+--      06 NOV 96   SAIC    Reduce adjust requirement
+--      25 NOV 97   EDS     Allowed zero calls to adjust at line 144
+--!
+
+---------------------------------------------------------------- C760007_0
+
+with Ada.Finalization;
+package C760007_0 is
+
+  type Controlled is new Ada.Finalization.Controlled with record
+    TC_ID : Natural := Natural'Last;
+  end record;
+  procedure Adjust( Object: in out Controlled );
+
+  type Structure is record
+    Controlled_Component : Controlled;
+  end record;
+
+  type Child is new Controlled with record
+    TC_XX : Natural := Natural'Last;
+  end record;
+  procedure Adjust( Object: in out Child );
+
+  Adjust_Count       : Natural := 0;
+  Child_Adjust_Count : Natural := 0;
+
+end C760007_0;
+ 
+package body C760007_0 is
+
+  procedure Adjust( Object: in out Controlled ) is
+  begin
+    Adjust_Count := Adjust_Count +1;
+  end Adjust;
+
+  procedure Adjust( Object: in out Child ) is
+  begin
+    Child_Adjust_Count := Child_Adjust_Count +1;
+  end Adjust;
+
+end C760007_0;
+
+------------------------------------------------------------------ C760007
+
+with Report;
+with C760007_0;
+procedure C760007 is
+
+  procedure Check_Adjust_Count(Message: String;
+                               Min: Natural := 1;
+                               Max: Natural := 2) is
+  begin
+
+     -- in order to allow for the anonymous objects referred to in
+     -- the reference manual, the check for calls to Adjust must be
+     -- in a range.  This number must then be further adjusted
+     -- to allow for the optimization that does not call for an adjust
+     -- of an aggregate initial value built directly in the object
+
+     if C760007_0.Adjust_Count not in Min..Max then
+       Report.Failed(Message
+                   & " = " & Natural'Image(C760007_0.Adjust_Count));
+     end if;
+     C760007_0.Adjust_Count := 0;
+  end Check_Adjust_Count;
+
+  procedure Check_Child_Adjust_Count(Message: String;
+                                     Min: Natural := 1;
+                                     Max: Natural := 2) is
+  begin
+     -- ditto above
+
+     if C760007_0.Child_Adjust_Count not in Min..Max then
+       Report.Failed(Message
+                   & " = " & Natural'Image(C760007_0.Child_Adjust_Count));
+     end if;
+     C760007_0.Child_Adjust_Count := 0;
+  end Check_Child_Adjust_Count;
+
+  Object : C760007_0.Controlled;
+
+--      Check that Adjust is called for the execution of a return
+--      statement for a function returning a result of a (non-limited)
+--      controlled type or a result of a noncontrolled type with
+--      controlled components.
+
+  procedure Subtest_1 is
+    function Create return C760007_0.Controlled is
+      New_Object : C760007_0.Controlled;
+    begin
+      return New_Object;
+    end Create;
+
+    procedure Examine( Thing : in C760007_0.Controlled ) is
+    begin
+      Check_Adjust_Count("Function call passed as parameter",0);
+    end Examine;
+
+  begin
+    -- this assignment must call Adjust:
+    --   1: on the value resulting from the function
+    --      ** unless this is optimized out by building the result directly
+    --         in the target object.
+    --   2: on Object once it's been assigned
+    -- may call adjust
+    --   1: for a anonymous object created in the evaluation of the function
+    --   2: for a anonymous object created in the assignment operation
+
+    Object := Create;
+
+    Check_Adjust_Count("Function call",1,4);
+
+    Examine( Create );
+
+  end Subtest_1;
+
+--      Check that Adjust is called when evaluating an aggregate
+--      component association for a controlled component.
+
+  procedure Subtest_2 is
+    S : C760007_0.Structure;
+
+    procedure Examine( Thing : in C760007_0.Structure ) is
+    begin
+      Check_Adjust_Count("Aggregate passed as parameter");
+    end Examine;
+
+  begin
+    -- this assignment must call Adjust:
+    --   1: on the value resulting from the aggregate
+    --      ** unless this is optimized out by building the result directly
+    --         in the target object.
+    --   2: on Object once it's been assigned
+    -- may call adjust
+    --   1: for a anonymous object created in the evaluation of the aggregate
+    --   2: for a anonymous object created in the assignment operation
+    S := ( Controlled_Component => Object );
+    Check_Adjust_Count("Aggregate and Assignment", 1, 4);
+
+    Examine( C760007_0.Structure'(Controlled_Component => Object) );
+  end Subtest_2;
+
+--      Check that Adjust is called for the assignment of the ancestor
+--      expression of an extension aggregate when the type of the
+--      aggregate is controlled.
+
+  procedure Subtest_3 is
+    Bambino : C760007_0.Child;
+
+    procedure Examine( Thing : in C760007_0.Child ) is
+    begin
+      Check_Adjust_Count("Extension aggregate as parameter (ancestor)", 0, 2);
+      Check_Child_Adjust_Count("Extension aggregate as parameter", 0, 4);
+    end Examine;
+
+  begin
+    -- implementation permissions make all of the following calls to adjust
+    -- optional:
+    -- these assignments may call Adjust:
+    --   1: on the value resulting from the aggregate
+    --   2: on Object once it's been assigned
+    --   3: for a anonymous object created in the evaluation of the aggregate
+    --   4: for a anonymous object created in the assignment operation
+    Bambino := ( Object with TC_XX => 10 );
+    Check_Adjust_Count("Ancestor (expression) part of aggregate", 0, 2);
+    Check_Child_Adjust_Count("Child aggregate assignment 1", 0, 4 );
+
+    Bambino := ( C760007_0.Controlled with TC_XX => 11 );
+    Check_Adjust_Count("Ancestor (subtype_mark) part of aggregate", 0, 2);
+    Check_Child_Adjust_Count("Child aggregate assignment 2", 0, 4 );
+
+    Examine( ( Object with TC_XX => 21 ) );
+
+    Examine( ( C760007_0.Controlled with TC_XX => 37 ) );
+
+  end Subtest_3;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C760007", "Check that Adjust is called for the " &
+                          "execution of a return statement for a " &
+                          "function returning a result containing a " &
+                          "controlled type.  Check that Adjust is " &
+                          "called when evaluating an aggregate " &
+                          "component association for a controlled " &
+                          "component.  " &
+                          "Check that Adjust is called for the " &
+                          "assignment of the ancestor expression of an " &
+                          "extension aggregate when the type of the " &
+                          "aggregate is controlled" );
+
+  Subtest_1;
+  Subtest_2;
+  Subtest_3;
+
+  Report.Result;
+
+end C760007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760009.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760009.a
new file mode 100644
index 000000000..8c3b80b36
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760009.a
@@ -0,0 +1,533 @@
+-- C760009.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 for an extension_aggregate whose ancestor_part is a
+--      subtype_mark (i.e. Typemark'( Subtype with Field => x, etc.) )
+--      Initialize is called on all controlled subcomponents of the
+--      ancestor part; if the type of the ancestor part is itself controlled,
+--      the Initialize procedure of the ancestor type is called, unless that
+--      Initialize procedure is abstract.
+--
+--      Check that the utilization of a controlled type for a generic actual
+--      parameter supports the correct behavior in the instantiated package.
+--
+-- TEST DESCRIPTION:
+--      Declares a generic package instantiated to check that controlled
+--      types are not impacted by the "generic boundary."
+--      This instance is then used to perform the tests of various
+--      aggregate formations of the controlled type.  After each operation
+--      in the main program that should cause implicit calls, the "state" of
+--      the software is checked.  The "state" of the software is maintained in
+--      several variables which count the calls to the Initialize, Adjust and
+--      Finalize procedures in each context.  Given the nature of the
+--      language rules, the test specifies a minimum number of times that
+--      these subprograms should have been called.  The test also checks cases
+--      where the subprograms should not have been called.
+--     
+--      As per the example in AARM 7.6(11a..d);6.0, the distinctions between
+--      the presence/absence of default values is tested.
+--
+-- DATA STRUCTURES
+--
+--      C760009_3.Master_Control is derived from
+--        C760009_2.Control is derived from
+--          Ada.Finalization.Controlled
+--
+--      C760009_1.Simple_Control is derived from
+--        Ada.Finalization.Controlled
+--
+--      C760009_3.Master_Control contains
+--        Standard.Integer
+--
+--      C760009_2.Control contains
+--        C760009_1.Simple_Control (default value)
+--        C760009_1.Simple_Control (default initialized)
+--
+--
+-- CHANGE HISTORY:
+--      01 MAY 95   SAIC    Initial version
+--      19 FEB 96   SAIC    Fixed elaboration Initialize count
+--      14 NOV 96   SAIC    Allowed for 7.6(21) optimizations
+--      13 FEB 97   PWB.CTA Initialized counters at lines 127-129
+--      26 JUN 98   EDS     Added pragma Elaborate_Body to C760009_0
+--                          to avoid possible instantiation error
+--!
+
+---------------------------------------------------------------- C760009_0
+
+with Ada.Finalization;
+generic
+
+  type Private_Formal is private;
+
+  with procedure TC_Validate( APF: in out Private_Formal );
+
+package C760009_0 is -- Check_1
+
+  pragma Elaborate_Body;
+  procedure TC_Check_1( APF: in     Private_Formal );
+  procedure TC_Check_2( APF:    out Private_Formal );
+  procedure TC_Check_3( APF: in out Private_Formal );
+
+end C760009_0;
+ 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body C760009_0 is -- Check_1
+
+    procedure TC_Check_1( APF: in     Private_Formal ) is
+      Local : Private_Formal;
+    begin
+      Local := APF;
+      TC_Validate( Local );
+    end TC_Check_1;
+
+    procedure TC_Check_2( APF:    out Private_Formal ) is
+      Local : Private_Formal;  -- initialized by virtue of actual being
+                               -- Controlled
+    begin
+      APF := Local;
+      TC_Validate( APF );
+    end TC_Check_2;
+
+    procedure TC_Check_3( APF: in out Private_Formal ) is
+      Local : Private_Formal;
+    begin
+      Local := APF;
+      TC_Validate( Local );
+    end TC_Check_3;
+
+end C760009_0;
+ 
+---------------------------------------------------------------- C760009_1
+
+with Ada.Finalization;
+package C760009_1 is
+
+  Initialize_Called : Natural := 0;
+  Adjust_Called     : Natural := 0;
+  Finalize_Called   : Natural := 0;
+
+  procedure Reset_Counters;
+
+  type Simple_Control is new Ada.Finalization.Controlled with private;
+
+  procedure Initialize( AV: in out Simple_Control );
+  procedure Adjust    ( AV: in out Simple_Control );
+  procedure Finalize  ( AV: in out Simple_Control );
+  procedure Validate  ( AV: in out Simple_Control );
+
+  function Item( AV: Simple_Control'Class ) return String;
+
+  Empty : constant Simple_Control;
+
+  procedure TC_Trace( Message: String );
+
+private
+  type Simple_Control is new Ada.Finalization.Controlled with record
+    Item: Natural;
+  end record;
+
+  Empty : constant Simple_Control := ( Ada.Finalization.Controlled with 0 );
+
+end C760009_1;
+ 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body C760009_1 is
+
+  -- Maintenance_Mode and TC_Trace are for the test writers and compiler
+  -- developers to get more information from this test as it executes.
+  -- Maintenance_Mode is always False for validation purposes.
+
+  Maintenance_Mode : constant Boolean := False;
+
+  procedure TC_Trace( Message: String ) is
+  begin
+    if Maintenance_Mode then
+      Report.Comment( Message );
+    end if;
+  end TC_Trace;
+
+  procedure Reset_Counters is
+  begin
+    Initialize_Called := 0;
+    Adjust_Called     := 0;
+    Finalize_Called   := 0;
+  end Reset_Counters;
+
+  Master_Count : Natural := 100;  -- Help distinguish values
+
+  procedure Initialize( AV: in out Simple_Control ) is
+  begin
+    Initialize_Called := Initialize_Called +1;
+    AV.Item := Master_Count;
+    Master_Count := Master_Count +100;
+    TC_Trace( "Initialize _1.Simple_Control" );
+  end Initialize;
+
+  procedure Adjust    ( AV: in out Simple_Control ) is
+  begin
+    Adjust_Called := Adjust_Called +1;
+    AV.Item := AV.Item +1;
+    TC_Trace( "Adjust _1.Simple_Control" );
+  end Adjust;
+
+  procedure Finalize  ( AV: in out Simple_Control ) is
+  begin
+    Finalize_Called := Finalize_Called +1;
+    AV.Item := AV.Item +1;
+    TC_Trace( "Finalize _1.Simple_Control" );
+  end Finalize;
+
+  procedure Validate  ( AV: in out Simple_Control ) is
+  begin
+    Report.Failed("Attempt to Validate at Simple_Control level");
+  end Validate;
+
+  function Item( AV: Simple_Control'Class ) return String is
+  begin
+    return Natural'Image(AV.Item);
+  end Item;
+
+end C760009_1;
+ 
+---------------------------------------------------------------- C760009_2
+
+with C760009_1;
+with Ada.Finalization;
+package C760009_2 is
+
+  type Control is new Ada.Finalization.Controlled with record
+    Element_1 : C760009_1.Simple_Control;
+    Element_2 : C760009_1.Simple_Control := C760009_1.Empty;
+  end record;
+
+  procedure Initialize( AV: in out Control );
+  procedure Finalize  ( AV: in out Control );
+
+  Initialized : Natural := 0;
+  Finalized   : Natural := 0;
+
+end C760009_2;
+ 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body C760009_2 is
+
+  procedure Initialize( AV: in out Control ) is
+  begin
+    Initialized := Initialized +1;
+    C760009_1.TC_Trace( "Initialize _2.Control" );
+  end Initialize;
+
+  procedure Finalize  ( AV: in out Control ) is
+  begin
+    Finalized := Finalized +1;
+    C760009_1.TC_Trace( "Finalize _2.Control" );
+  end Finalize;
+
+end C760009_2;
+ 
+---------------------------------------------------------------- C760009_3
+
+with C760009_0;
+with C760009_2;
+package C760009_3 is
+
+  type Master_Control is new C760009_2.Control with record
+    Data: Integer;
+  end record;
+
+  procedure Initialize( AC: in out Master_Control );
+  -- calls C760009_2.Initialize
+  -- embedded data causes 1 call to C760009_1.Initialize
+
+  -- Adjusting operation will
+  -- make 1 call to C760009_2.Adjust 
+  -- make 2 call to C760009_1.Adjust 
+
+  -- Finalize operation will
+  -- make 1 call to C760009_2.Finalize 
+  -- make 2 call to C760009_1.Finalize 
+
+  procedure Validate( AC: in out Master_Control );
+
+  package Check_1 is
+    new C760009_0(Master_Control, Validate);
+
+end C760009_3;
+ 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with C760009_1;
+package body C760009_3 is
+
+  procedure Initialize( AC: in out Master_Control ) is
+  begin
+    AC.Data := 42;
+    C760009_2.Initialize(C760009_2.Control(AC));
+    C760009_1.TC_Trace( "Initialize Master_Control" );
+  end Initialize;
+
+  procedure Validate( AC: in out Master_Control ) is
+  begin
+    if AC.Data not in 0..1000 then
+      Report.Failed("C760009_3.Control did not Initialize" );
+    end if;
+  end Validate;
+
+end C760009_3;
+ 
+--------------------------------------------------------------------- C760009
+
+with Report;
+with C760009_1;
+with C760009_2;
+with C760009_3;
+procedure C760009 is
+
+  -- Comment following declaration indicates expected calls in the order:
+  -- Initialize of a C760009_2 value
+  -- Finalize   of a C760009_2 value
+  -- Initialize of a C760009_1 value
+  -- Adjust     of a C760009_1 value
+  -- Finalize   of a C760009_1 value
+
+  Global_Control : C760009_3.Master_Control;
+  -- 1, 0, 1, 1, 0
+
+  Parent_Control : C760009_2.Control;
+  -- 1, 0, 1, 1, 0
+
+  -- Global_Control is a derived tagged type, the parent type
+  --   of Master_Control, Control, is derived from Controlled, and contains
+  --   two components of a Controlled type, Simple_Control.  One of these
+  --   components has a default value, the other does not.
+
+  procedure Fail( Which: String; Expect, Got: Natural ) is
+  begin
+    Report.Failed(Which & " Expected" & Natural'Image(Expect)
+                        & " got" & Natural'Image(Got) );
+  end Fail;
+
+  procedure Master_Assertion( Layer_2_Inits   : Natural;
+                              Layer_2_Finals  : Natural;
+                              Layer_1_Inits   : Natural;
+                              Layer_1_Adjs    : Natural;
+                              Layer_1_Finals  : Natural;
+                              Failing_Message : String ) is
+
+  begin
+
+
+
+   if C760009_2.Initialized /= Layer_2_Inits then
+     Fail("C760009_2.Initialize " & Failing_Message,
+          Layer_2_Inits, C760009_2.Initialized );
+   end if;
+
+   if C760009_2.Finalized not in Layer_2_Finals..Layer_2_Finals*2 then
+     Fail("C760009_2.Finalize " & Failing_Message,
+           Layer_2_Finals, C760009_2.Finalized );
+   end if;
+
+   if C760009_1.Initialize_Called /= Layer_1_Inits then
+     Fail("C760009_1.Initialize " & Failing_Message,
+           Layer_1_Inits,
+          C760009_1.Initialize_Called );
+   end if;
+
+   if C760009_1.Adjust_Called not in Layer_1_Adjs..Layer_1_Adjs*2 then
+     Fail("C760009_1.Adjust " & Failing_Message,
+           Layer_1_Adjs, C760009_1.Adjust_Called );
+   end if;
+
+   if C760009_1.Finalize_Called not in Layer_1_Finals..Layer_1_Finals*2 then
+     Fail("C760009_1.Finalize " & Failing_Message,
+           Layer_1_Finals, C760009_1.Finalize_Called );
+   end if;
+
+   C760009_1.Reset_Counters;
+   C760009_2.Initialized := 0;
+   C760009_2.Finalized   := 0;
+
+  end Master_Assertion;
+
+  procedure Lesser_Assertion( Layer_2_Inits   : Natural;
+                              Layer_2_Finals  : Natural;
+                              Layer_1_Inits   : Natural;
+                              Layer_1_Adjs    : Natural;
+                              Layer_1_Finals  : Natural;
+                              Failing_Message : String ) is
+  begin
+
+
+   if C760009_2.Initialized > Layer_2_Inits then
+     Fail("C760009_2.Initialize " & Failing_Message,
+           Layer_2_Inits, C760009_2.Initialized );
+   end if;
+
+   if C760009_2.Finalized < Layer_2_Inits 
+      or C760009_2.Finalized > Layer_2_Finals*2 then
+     Fail("C760009_2.Finalize " & Failing_Message,
+           Layer_2_Finals, C760009_2.Finalized );
+   end if;
+
+   if C760009_1.Initialize_Called > Layer_1_Inits then
+     Fail("C760009_1.Initialize " & Failing_Message,
+           Layer_1_Inits,
+          C760009_1.Initialize_Called );
+   end if;
+
+   if C760009_1.Adjust_Called > Layer_1_Adjs*2 then
+     Fail("C760009_1.Adjust " & Failing_Message,
+           Layer_1_Adjs, C760009_1.Adjust_Called );
+   end if;
+
+   if C760009_1.Finalize_Called < Layer_1_Inits
+      or C760009_1.Finalize_Called > Layer_1_Finals*2 then
+     Fail("C760009_1.Finalize " & Failing_Message,
+           Layer_1_Finals, C760009_1.Finalize_Called );
+   end if;
+
+   C760009_1.Reset_Counters;
+   C760009_2.Initialized := 0;
+   C760009_2.Finalized   := 0;
+
+  end Lesser_Assertion;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C760009", "Check that for an extension_aggregate whose " &
+                          "ancestor_part is a subtype_mark, Initialize " &
+                          "is called on all controlled subcomponents of " &
+                          "the ancestor part.  Also check that the " &
+                          "utilization of a controlled type for a generic " &
+                          "actual parameter supports the correct behavior " &
+                          "in the instantiated software" );
+
+  C760009_1.TC_Trace( "=====> Case 0 <=====" );
+
+  C760009_1.Reset_Counters;
+  C760009_2.Initialized := 0;
+  C760009_2.Finalized   := 0;
+
+  C760009_3.Validate( Global_Control ); -- check that it Initialized correctly
+
+  C760009_1.TC_Trace( "=====> Case 1 <=====" );
+
+  C760009_3.Check_1.TC_Check_1( ( C760009_2.Control with Data => 1 ) );
+  Lesser_Assertion( 2, 3, 2, 3, 6, "Check_1.TC_Check_1" );
+  --                |  |  |  |  + Finalize 2 embedded in aggregate
+  --                |  |  |  |  + Finalize 2 at assignment in TC_Check_1
+  --                |  |  |  |  + Finalize 2 embedded in local variable
+  --                |  |  |  + Adjust 2 caused by assignment in TC_Check_1
+  --                |  |  |  + Adjust at declaration in TC_Check_1
+  --                |  |  + Initialize at declaration in TC_Check_1
+  --                |  |  + Initialize of aggregate object
+  --                |  + Finalize of assignment target
+  --                |  + Finalize of local variable
+  --                |  + Finalize of aggregate object
+  --               + Initialize of aggregate object
+  --               + Initialize of local variable
+
+
+  C760009_1.TC_Trace( "=====> Case 2 <=====" );
+
+  C760009_3.Check_1.TC_Check_2( Global_Control );
+  Master_Assertion( 1, 2, 1, 3, 4, "Check_1.TC_Check_2" );
+  --                |  |  |  |  + Finalize 2 at assignment in TC_Check_2
+  --                |  |  |  |  + Finalize 2 embedded in local variable
+  --                |  |  |  + Adjust 2 caused by assignment in TC_Check_2
+  --                |  |  |  + Adjust at declaration in TC_Check_2
+  --                |  |  + Initialize at declaration in TC_Check_2
+  --                |  + Finalize of assignment target
+  --                |  + Finalize of local variable
+  --               + Initialize of local variable
+
+
+  C760009_1.TC_Trace( "=====> Case 3 <=====" );
+
+  Global_Control := ( C760009_2.Control with Data => 2 );
+  Lesser_Assertion( 1, 1, 1, 3, 2, "Aggregate -> object" );
+  --                |  |  |  |  + Finalize 2 by assignment
+  --                |  |  |  + Adjust 2 caused by assignment
+  --                |  |  |  + Adjust in aggregate creation
+  --                |  |  + Initialize of aggregate object
+  --                |  + Finalize of assignment target
+  --               + Initialize of aggregate object
+
+
+  C760009_1.TC_Trace( "=====> Case 4 <=====" );
+
+  C760009_3.Check_1.TC_Check_3( Global_Control );
+  Master_Assertion( 1, 2, 1, 3, 4, "Check_1.TC_Check_3" );
+  --                |  |  |  |  + Finalize 2 at assignment in TC_Check_3
+  --                |  |  |  |  + Finalize 2 embedded in local variable
+  --                |  |  |  + Adjust 2 at assignment in TC_Check_3
+  --                |  |  |  + Adjust in local variable creation
+  --                |  |  + Initialize of local variable in TC_Check_3
+  --                |  + Finalize of assignment target
+  --                |  + Finalize of local variable
+  --               + Initialize of local variable
+
+
+  C760009_1.TC_Trace( "=====> Case 5 <=====" );
+
+  Global_Control := ( Parent_Control with Data => 3 );
+  Lesser_Assertion( 1, 1, 1, 3, 2, "Object Aggregate -> object" );
+  --                |  |  |  |  + Finalize 2 by assignment
+  --                |  |  |  + Adjust 2 caused by assignment
+  --                |  |  |  + Adjust in aggregate creation
+  --                |  |  + Initialize of aggregate object
+  --                |  + Finalize of assignment target
+  --               + Initialize of aggregate object
+
+
+
+  C760009_1.TC_Trace( "=====> Case 6 <=====" );
+
+  -- perform this check a second time to make sure nothing is "remembered"
+
+  C760009_3.Check_1.TC_Check_3( Global_Control );
+  Master_Assertion( 1, 2, 1, 3, 4, "Check_1.TC_Check_3 second time" );
+  --                |  |  |  |  + Finalize 2 at assignment in TC_Check_3
+  --                |  |  |  |  + Finalize 2 embedded in local variable
+  --                |  |  |  + Adjust 2 at assignment in TC_Check_3
+  --                |  |  |  + Adjust in local variable creation
+  --                |  |  + Initialize of local variable in TC_Check_3
+  --                |  + Finalize of assignment target
+  --                |  + Finalize of local variable
+  --               + Initialize of local variable
+
+
+  Report.Result;
+
+end C760009;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760010.a
new file mode 100644
index 000000000..08fe62b9f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760010.a
@@ -0,0 +1,418 @@
+-- C760010.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 explicit calls to Initialize, Adjust and Finalize
+--      procedures that raise exceptions propagate the exception raised,
+--      not Program_Error.  Check this for both a user defined exception
+--      and a language defined exception.  Check that implicit calls to
+--      initialize procedures that raise an exception propagate the
+--      exception raised, not Program_Error;
+--
+--      Check that the utilization of a controlled type as the actual for
+--      a generic formal tagged private parameter supports the correct
+--      behavior in the instantiated software.
+--
+-- TEST DESCRIPTION:
+--      Declares a generic package instantiated to check that controlled
+--      types are not impacted by the "generic boundary."
+--      This instance is then used to perform the tests of various calls to
+--      the procedures.  After each operation in the main program that should
+--      cause implicit calls where an exception is raised, the program handles
+--      Program_Error.  After each explicit call, the program handles the
+--      Expected_Error.  Handlers for the opposite exception are provided to
+--      catch the obvious failure modes.  The predefined exception
+--      Tasking_Error is used to be certain that some other reason has not
+--      raised a predefined exception.
+--
+--     
+-- DATA STRUCTURES
+--
+--      C760010_1.Simple_Control is derived from
+--        Ada.Finalization.Controlled
+--
+--      C760010_2.Embedded_Derived is derived from C760010_1.Simple_Control
+--        by way of generic instantiation
+--
+--
+-- CHANGE HISTORY:
+--      01 MAY 95   SAIC    Initial version
+--      23 APR 96   SAIC    Fix visibility problem for 2.1
+--      14 NOV 96   SAIC    Revisit for 2.1 release
+--      26 JUN 98   EDS     Added pragma Elaborate_Body to
+--                          package C760010_0.Check_Formal_Tagged
+--                          to avoid possible instantiation error
+--!
+
+---------------------------------------------------------------- C760010_0
+
+package C760010_0 is
+
+  User_Defined_Exception : exception;
+
+  type Actions is ( No_Action,
+                    Init_Raise_User_Defined, Init_Raise_Standard,
+                    Adj_Raise_User_Defined,  Adj_Raise_Standard,
+                    Fin_Raise_User_Defined,  Fin_Raise_Standard );
+
+  Action : Actions := No_Action;
+
+  function Unique return Natural;
+
+end C760010_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body C760010_0 is
+
+  Value : Natural := 101;
+
+  function Unique return Natural is
+  begin
+    Value := Value +1;
+    return Value;
+  end Unique;
+
+end C760010_0;
+
+---------------------------------------------------------------- C760010_0
+------------------------------------------------------ Check_Formal_Tagged
+
+generic
+
+  type Formal_Tagged is tagged private;
+
+package C760010_0.Check_Formal_Tagged is
+
+  pragma Elaborate_Body;
+
+  type Embedded_Derived is new Formal_Tagged with record
+    TC_Meaningless_Value : Natural := Unique;
+  end record;
+
+  procedure Initialize( ED: in out Embedded_Derived );
+  procedure Adjust    ( ED: in out Embedded_Derived );
+  procedure Finalize  ( ED: in out Embedded_Derived );
+
+end C760010_0.Check_Formal_Tagged;
+
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body C760010_0.Check_Formal_Tagged is
+
+
+  procedure Initialize( ED: in out Embedded_Derived ) is
+  begin
+    ED.TC_Meaningless_Value := Unique;
+    case Action is
+      when Init_Raise_User_Defined => raise User_Defined_Exception;
+      when Init_Raise_Standard     => raise Tasking_Error;
+      when others                  => null;
+    end case;
+  end Initialize;
+
+  procedure Adjust    ( ED: in out Embedded_Derived ) is
+  begin
+    ED.TC_Meaningless_Value := Unique;
+    case Action is
+      when Adj_Raise_User_Defined => raise User_Defined_Exception;
+      when Adj_Raise_Standard     => raise Tasking_Error;
+      when others                 => null;
+    end case;
+  end Adjust;
+
+  procedure Finalize  ( ED: in out Embedded_Derived ) is
+  begin
+    ED.TC_Meaningless_Value := Unique;
+    case Action is
+      when Fin_Raise_User_Defined => raise User_Defined_Exception;
+      when Fin_Raise_Standard     => raise Tasking_Error;
+      when others                 => null;
+    end case;
+  end Finalize;
+
+end C760010_0.Check_Formal_Tagged;
+ 
+---------------------------------------------------------------- C760010_1
+
+with Ada.Finalization;
+package C760010_1 is
+
+  procedure Check_Counters(Init,Adj,Fin : Natural; Message: String);
+  procedure Reset_Counters;
+
+  type Simple_Control is new Ada.Finalization.Controlled with record
+    Item: Integer;
+  end record;
+  procedure Initialize( AV: in out Simple_Control );
+  procedure Adjust    ( AV: in out Simple_Control );
+  procedure Finalize  ( AV: in out Simple_Control );
+
+end C760010_1;
+ 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body C760010_1 is
+
+  Initialize_Called : Natural;
+  Adjust_Called     : Natural;
+  Finalize_Called   : Natural;
+
+  procedure Check_Counters(Init,Adj,Fin : Natural; Message: String) is
+  begin
+    if Init /= Initialize_Called then
+      Report.Failed("Initialize mismatch " & Message);
+    end if;
+    if Adj /= Adjust_Called then
+      Report.Failed("Adjust mismatch " & Message);
+    end if;
+    if Fin /= Finalize_Called then
+      Report.Failed("Finalize mismatch " & Message);
+    end if;
+  end Check_Counters;
+
+  procedure Reset_Counters is
+  begin
+    Initialize_Called := 0;
+    Adjust_Called     := 0;
+    Finalize_Called   := 0;
+  end Reset_Counters;
+
+  procedure Initialize( AV: in out Simple_Control ) is
+  begin
+    Initialize_Called := Initialize_Called +1;
+    AV.Item := 0;
+  end Initialize;
+
+  procedure Adjust    ( AV: in out Simple_Control ) is
+  begin
+    Adjust_Called := Adjust_Called +1;
+    AV.Item := AV.Item +1;
+  end Adjust;
+
+  procedure Finalize  ( AV: in out Simple_Control ) is
+  begin
+    Finalize_Called := Finalize_Called +1;
+    AV.Item := AV.Item +1;
+  end Finalize;
+
+end C760010_1;
+ 
+---------------------------------------------------------------- C760010_2
+
+with C760010_0.Check_Formal_Tagged;
+with C760010_1;
+package C760010_2 is
+  new C760010_0.Check_Formal_Tagged(C760010_1.Simple_Control);
+ 
+---------------------------------------------------------------------------
+
+with Report;
+with C760010_0;
+with C760010_1;
+with C760010_2;
+procedure C760010 is
+
+  use type C760010_0.Actions;
+
+  procedure Case_Failure(Message: String) is
+  begin
+    Report.Failed(Message & " for case "
+                  & C760010_0.Actions'Image(C760010_0.Action) );
+  end Case_Failure;
+
+  procedure Check_Implicit_Initialize is
+    Item   : C760010_2.Embedded_Derived;  -- exception here propagates to
+    Gadget : C760010_2.Embedded_Derived;  -- caller
+  begin
+    if C760010_0.Action
+       in C760010_0.Init_Raise_User_Defined..C760010_0.Init_Raise_Standard
+    then
+      Case_Failure("Anticipated exception at implicit init");
+    end if;
+    begin
+      Item := Gadget;                     -- exception here handled locally
+      if C760010_0.Action in C760010_0.Adj_Raise_User_Defined
+                                   .. C760010_0.Fin_Raise_Standard then
+        Case_Failure ("Anticipated exception at assignment");
+      end if;
+    exception
+      when Program_Error =>
+        if C760010_0.Action not in C760010_0.Adj_Raise_User_Defined
+                                   .. C760010_0.Fin_Raise_Standard then
+          Report.Failed("Program_Error in Check_Implicit_Initialize");
+        end if;
+      when Tasking_Error =>
+        Report.Failed("Tasking_Error in Check_Implicit_Initialize");
+      when C760010_0.User_Defined_Exception =>
+        Report.Failed("User_Error in Check_Implicit_Initialize");
+      when others =>
+        Report.Failed("Wrong exception Check_Implicit_Initialize");
+    end;
+  end Check_Implicit_Initialize;
+
+---------------------------------------------------------------------------
+
+  Global_Item : C760010_2.Embedded_Derived;
+
+---------------------------------------------------------------------------
+
+  procedure Check_Explicit_Initialize is
+  begin
+    begin
+      C760010_2.Initialize( Global_Item );
+    if C760010_0.Action
+       in C760010_0.Init_Raise_User_Defined..C760010_0.Init_Raise_Standard
+    then
+      Case_Failure("Anticipated exception at explicit init");
+    end if;
+    exception
+      when Program_Error =>
+        Report.Failed("Program_Error in Check_Explicit_Initialize");
+      when Tasking_Error =>
+        if C760010_0.Action /= C760010_0.Init_Raise_Standard then
+          Report.Failed("Tasking_Error in Check_Explicit_Initialize");
+        end if;
+      when C760010_0.User_Defined_Exception =>
+        if C760010_0.Action /= C760010_0.Init_Raise_User_Defined then
+          Report.Failed("User_Error in Check_Explicit_Initialize");
+        end if;
+      when others =>
+        Report.Failed("Wrong exception in Check_Explicit_Initialize");
+    end;
+  end Check_Explicit_Initialize;
+
+---------------------------------------------------------------------------
+
+  procedure Check_Explicit_Adjust is
+  begin
+    begin
+      C760010_2.Adjust( Global_Item );
+    if C760010_0.Action
+       in C760010_0.Adj_Raise_User_Defined..C760010_0.Adj_Raise_Standard
+    then
+      Case_Failure("Anticipated exception at explicit Adjust");
+    end if;
+    exception
+      when Program_Error =>
+        Report.Failed("Program_Error in Check_Explicit_Adjust");
+      when Tasking_Error =>
+        if C760010_0.Action /= C760010_0.Adj_Raise_Standard then
+          Report.Failed("Tasking_Error in Check_Explicit_Adjust");
+        end if;
+      when C760010_0.User_Defined_Exception =>
+        if C760010_0.Action /= C760010_0.Adj_Raise_User_Defined then
+          Report.Failed("User_Error in Check_Explicit_Adjust");
+        end if;
+      when others =>
+        Report.Failed("Wrong exception in Check_Explicit_Adjust");
+    end;
+  end Check_Explicit_Adjust;
+
+---------------------------------------------------------------------------
+
+  procedure Check_Explicit_Finalize is
+  begin
+    begin
+      C760010_2.Finalize( Global_Item );
+    if C760010_0.Action
+       in C760010_0.Fin_Raise_User_Defined..C760010_0.Fin_Raise_Standard
+    then
+      Case_Failure("Anticipated exception at explicit Finalize");
+    end if;
+    exception
+      when Program_Error =>
+        Report.Failed("Program_Error in Check_Explicit_Finalize");
+      when Tasking_Error =>
+        if C760010_0.Action /= C760010_0.Fin_Raise_Standard then
+          Report.Failed("Tasking_Error in Check_Explicit_Finalize");
+        end if;
+      when C760010_0.User_Defined_Exception =>
+        if C760010_0.Action /= C760010_0.Fin_Raise_User_Defined then
+          Report.Failed("User_Error in Check_Explicit_Finalize");
+        end if;
+      when others =>
+        Report.Failed("Wrong exception in Check_Explicit_Finalize");
+    end;
+  end Check_Explicit_Finalize;
+
+---------------------------------------------------------------------------
+
+begin  -- Main test procedure.
+
+  Report.Test ("C760010", "Check that explicit calls to finalization " &
+                          "procedures that raise exceptions propagate " &
+                          "the exception raised.  Check the utilization " &
+                          "of a controlled type as the actual for a " &
+                          "generic formal tagged private parameter" );
+
+  for Act in C760010_0.Actions loop
+    C760010_1.Reset_Counters;
+    C760010_0.Action := Act;
+
+    begin
+      Check_Implicit_Initialize;
+      if Act in
+         C760010_0.Init_Raise_User_Defined..C760010_0.Init_Raise_Standard then
+        Case_Failure("No exception at Check_Implicit_Initialize");
+      end if;
+    exception
+      when Tasking_Error =>
+        if Act /= C760010_0.Init_Raise_Standard then
+          Case_Failure("Tasking_Error at Check_Implicit_Initialize");
+        end if;
+      when C760010_0.User_Defined_Exception =>
+        if Act /= C760010_0.Init_Raise_User_Defined then
+          Case_Failure("User_Error at Check_Implicit_Initialize");
+        end if;
+      when Program_Error =>
+         -- If finalize raises an exception, all other object are finalized
+         -- first and Program_Error is raised upon leaving the master scope.
+         -- 7.6.1:14
+         if Act not in C760010_0.Fin_Raise_User_Defined..
+                       C760010_0.Fin_Raise_Standard then
+            Case_Failure("Program_Error at Check_Implicit_Initialize");
+         end if;
+      when others =>
+        Case_Failure("Wrong exception at Check_Implicit_Initialize");
+    end;
+
+    Check_Explicit_Initialize;
+    Check_Explicit_Adjust;
+    Check_Explicit_Finalize;
+
+    C760010_1.Check_Counters(0,0,0, C760010_0.Actions'Image(Act));
+
+  end loop;
+
+  -- Set to No_Action to avoid exception in finalizing Global_Item
+  C760010_0.Action := C760010_0.No_Action;
+
+  Report.Result;
+
+end C760010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760011.a
new file mode 100644
index 000000000..8df37fa3c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760011.a
@@ -0,0 +1,291 @@
+-- C760011.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 anonymous objects of a controlled type associated with
+--      function results and aggregates are finalized no later than the
+--      end of the innermost enclosing declarative_item or statement.  Also
+--      check this for function calls and aggregates of a noncontrolled type
+--      with controlled components.
+--
+-- TEST DESCRIPTION:
+--      This test defines a controlled type with a discriminant, the
+--      discriminant is use as an index into a global table to indicate that
+--      the object has been finalized.  The controlled type is used as the
+--      component of a non-controlled type, and the non-controlled type is
+--      used for the same set of tests.  Following is a table of the tests
+--      performed and their associated tag character.
+--
+--      7.6(21) allows for the optimizations that remove these temporary
+--      objects from ever existing.  As such this test checks that in the
+--      case the object was initialized (the only access we have to
+--      determining if it ever existed) it must subsequently be finalized.
+--
+-- CASE TABLE:
+--      A - aggregate test, controlled
+--      B - aggregate test, controlled
+--      C - aggregate test, non_controlled
+--      D - function test, controlled
+--      E - function test, non_controlled
+--      F - formal parameter function test, controlled
+--      G - formal parameter aggregate test, controlled
+--      H - formal parameter function test, non_controlled
+--      I - formal parameter aggregate test, non_controlled
+--
+--      X - scratch object, not consequential to the objective
+--      Y - scratch object, not consequential to the objective
+--      Z - scratch object, not consequential to the objective
+--
+--
+-- CHANGE HISTORY:
+--      22 MAY 95   SAIC    Initial version
+--      24 APR 96   SAIC    Minor doc fixes, visibility patch
+--      14 NOV 96   SAIC    Revised for release 2.1
+--
+--!
+
+------------------------------------------------------------------- C760011_0
+
+with Ada.Finalization;
+package C760011_0 is
+  type Tracking_Array is array(Character range 'A'..'Z') of Boolean;
+
+  Initialized : Tracking_Array := (others => False);
+  Finalized   : Tracking_Array := (others => False);
+
+  type Controlled_Type(Tag : Character) is
+    new Ada.Finalization.Controlled with record
+      TC_Component : String(1..4) := "ACVC";
+    end record;
+  procedure Initialize( It: in out Controlled_Type );
+  procedure Finalize  ( It: in out Controlled_Type );
+  function Create(With_Tag: Character) return Controlled_Type;
+
+  type Non_Controlled(Tag : Character := 'Y') is record
+    Controlled_Component : Controlled_Type(Tag);
+  end record;
+  procedure Initialize( It: in out Non_Controlled );
+  procedure Finalize  ( It: in out Non_Controlled );
+  function Create(With_Tag: Character) return Non_Controlled;
+
+  Under_Debug : constant Boolean := False;  -- construction lines
+
+end C760011_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body C760011_0 is
+
+  procedure Initialize( It: in out Controlled_Type ) is
+  begin
+    It.TC_Component := (others => It.Tag);
+    if It.Tag in Tracking_Array'Range then 
+      Initialized(It.Tag) := True;
+    end if;
+    if Under_Debug then
+      Report.Comment("Initializing Tag: " & It.Tag );
+    end if;
+  end Initialize;
+  
+  procedure Finalize( It: in out Controlled_Type ) is
+  begin
+    if Under_Debug then
+      Report.Comment("Finalizing for Tag: " & It.Tag );
+    end if;
+    if It.Tag in Finalized'Range then 
+      Finalized(It.Tag) := True;
+    end if;
+  end Finalize;
+
+  function Create(With_Tag: Character) return Controlled_Type is
+  begin
+    return Controlled_Type'(Ada.Finalization.Controlled
+                            with Tag          => With_Tag,
+                                 TC_Component => "*CON" );
+  end Create;
+
+  procedure Initialize( It: in out Non_Controlled ) is
+  begin
+    Report.Failed("Called Initialize for Non_Controlled");
+  end Initialize;
+  
+  procedure Finalize( It: in out Non_Controlled ) is
+  begin
+    Report.Failed("Called Finalize for Non_Controlled");
+  end Finalize;
+
+  function Create(With_Tag: Character) return Non_Controlled is
+  begin
+    return Non_Controlled'(Tag => With_Tag, Controlled_Component => (
+                                  Ada.Finalization.Controlled
+                                    with Tag          => With_Tag,
+                                         TC_Component => "#NON" ) );
+  end Create;
+
+end C760011_0;
+
+--------------------------------------------------------------------- C760011
+
+with Report;
+with TCTouch;
+with C760011_0;
+with Ada.Finalization; -- needed to be able to create extension aggregates
+procedure C760011 is
+
+  use type C760011_0.Controlled_Type;
+  use type C760011_0.Controlled_Type'Class;
+  use type C760011_0.Non_Controlled;
+
+  subtype AFC is Ada.Finalization.Controlled;
+
+  procedure Check_Result( Tag : Character; Message : String ) is
+  -- make allowance for 7.6(21) optimizations
+  begin
+    if C760011_0.Initialized(Tag) then
+      TCTouch.Assert(C760011_0.Finalized(Tag),Message);
+    elsif C760011_0.Under_Debug then
+      Report.Comment("Optimized away: " & Tag );
+    end if;
+  end Check_Result;
+
+  procedure Subtest_1 is
+
+
+    procedure Subtest_1_Local_1 is
+      An_Object : C760011_0.Controlled_Type'Class
+                := C760011_0.Controlled_Type'(AFC with 'X', "ONE*");
+                   -- initialize An_Object
+    begin
+      if C760011_0.Controlled_Type(An_Object)   
+         = C760011_0.Controlled_Type'(AFC with 'A', "ONE*") then
+        Report.Failed("Comparison bad");  -- A = X !!!
+      end if;
+    end Subtest_1_Local_1;
+    -- An_Object must be Finalized by this point.
+
+    procedure Subtest_1_Local_2 is
+      An_Object : C760011_0.Controlled_Type('B');
+    begin
+      An_Object := (AFC with 'B',  "TWO!" );
+      if Report.Ident_Char(An_Object.Tag) /= 'B' then
+        Report.Failed("Subtest_1_Local_2 Optimization Foil: Bad Data!");
+      end if;
+    exception
+      when others => Report.Failed("Bad controlled assignment");
+    end Subtest_1_Local_2;
+    -- An_Object must be Finalized by this point.
+
+    procedure Subtest_1_Local_3 is
+      An_Object : C760011_0.Non_Controlled('C');
+    begin
+      TCTouch.Assert_Not(C760011_0.Finalized('C'),
+                           "Non_Controlled declaration C");
+      An_Object := C760011_0.Non_Controlled'('C', Controlled_Component
+                                     => (AFC with 'C', "TEE!"));
+      if Report.Ident_Char(An_Object.Tag) /= 'C' then
+        Report.Failed("Subtest_1_Local_3 Optimization Foil: Bad Data!");
+      end if;
+    end Subtest_1_Local_3;
+    -- Only controlled components of An_Object must be finalized; it is an
+    -- error to call Finalize for An_Object
+
+  begin
+    Subtest_1_Local_1;
+    Check_Result( 'A', "Aggregate in subprogram 1" );
+
+    Subtest_1_Local_2;
+    Check_Result( 'B', "Aggregate in subprogram 2" );
+
+    Subtest_1_Local_3;
+    Check_Result( 'C', "Embedded aggregate in subprogram 3" );
+  end Subtest_1;
+
+
+  procedure Subtest_2 is
+    -- using 'Z' for both evades order issues
+    Con_Object : C760011_0.Controlled_Type('Z');
+    Non_Object : C760011_0.Non_Controlled('Z');
+  begin
+    if Report.Ident_Bool( Con_Object = C760011_0.Create('D') ) then
+      Report.Failed("Con_Object catastrophe");
+    end if;
+     -- Controlled function result should be finalized by now
+    Check_Result( 'D', "Function Result" );
+
+    if Report.Ident_Bool( Non_Object = C760011_0.Create('E') ) then
+      Report.Failed("Non_Object catastrophe");
+    end if;
+     -- Controlled component of function result should be finalized by now
+    Check_Result( 'E', "Function Result" );
+  end Subtest_2;
+
+
+  procedure Subtest_3(Con : in C760011_0.Controlled_Type) is
+  begin
+    if Con.Tag not in 'F'..'G' then  
+      Report.Failed("Bad value passed to subtest 3 " & Con.Tag & ' ' 
+                    & Report.Ident_Str(Con.TC_Component));
+    end if;
+  end Subtest_3;
+
+
+  procedure Subtest_4(Non : in C760011_0.Non_Controlled) is
+  begin
+    if Non.Tag not in 'H'..'I' then  
+      Report.Failed("Bad value passed to subtest 4 "
+                   & Non.Tag & ' ' 
+                   & Report.Ident_Str(Non.Controlled_Component.TC_Component));
+    end if;
+  end Subtest_4;
+
+
+begin  -- Main test procedure.
+
+  Report.Test ("C760011", "Check that anonymous objects of controlled " &
+                          "types or types containing controlled types " &
+                          "are finalized no later than the end of the " &
+                          "innermost enclosing declarative_item or " &
+                          "statement" );
+
+  Subtest_1;
+
+  Subtest_2;
+
+  Subtest_3(C760011_0.Create('F'));
+  Check_Result( 'F', "Function as formal F" );
+
+  Subtest_3(C760011_0.Controlled_Type'(AFC with 'G',"GIGI"));
+  Check_Result( 'G', "Aggregate as formal G" );
+
+  Subtest_4(C760011_0.Create('H'));
+  Check_Result( 'H', "Function as formal H" );
+
+  Subtest_4(C760011_0.Non_Controlled'('I', (AFC with 'I',"IAGO")));
+  Check_Result( 'I', "Aggregate as formal I" );
+
+  Report.Result;
+
+end C760011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760012.a
new file mode 100644
index 000000000..08986a838
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760012.a
@@ -0,0 +1,256 @@
+-- C760012.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 record components that have per-object access discriminant
+--      constraints are initialized in the order of their component
+--      declarations, and after any components that are not so constrained.
+--
+--      Check that record components that have per-object access discriminant
+--      constraints are finalized in the reverse order of their component
+--      declarations, and before any components that are not so constrained.
+--
+-- TEST DESCRIPTION:
+--      The type List_Item is the "container" type.  It holds two fields that
+--      have per-object access discriminant constraints, and two fields that
+--      are not discriminated.  These four fields are all controlled types.
+--      A fifth field is a pointer used to maintain a linked list of these
+--      data objects.  Each component is of a unique type which allows for
+--      the test to simply track the order of initialization and finalization.
+--
+--      The types and their purpose are:
+--        Constrained_First  - a controlled discriminated type
+--        Constrained_Second - a controlled discriminated type
+--        Simple_First       - a controlled type with no discriminant
+--        Simple_Second      - a controlled type with no discriminant
+--
+--      The required order of operations:
+--        Initialize
+--          ( Simple_First | Simple_Second )   -- no "internal order" required
+--          Constrained_First
+--          Constrained_Second
+--        Finalize
+--          Constrained_Second
+--          Constrained_First
+--          ( Simple_First | Simple_Second )   -- must be inverse of init.
+--
+--
+-- CHANGE HISTORY:
+--      23 MAY 95   SAIC    Initial version
+--      02 MAY 96   SAIC    Reorganized for 2.1
+--      05 DEC 96   SAIC    Simplified for 2.1; added init/fin ordering check
+--      31 DEC 97   EDS     Remove references to and uses of
+--                          Initialization_Sequence
+--!
+
+---------------------------------------------------------------- C760012_0
+
+with Ada.Finalization;
+with Ada.Unchecked_Deallocation;
+package C760012_0 is
+
+  type List_Item;
+
+  type List is access all List_Item;
+
+  package Firsts is  -- distinguish first from second
+    type Constrained_First(Container : access List_Item) is 
+           new Ada.Finalization.Limited_Controlled with null record;
+    procedure Initialize( T : in out Constrained_First );
+    procedure Finalize  ( T : in out Constrained_First );
+
+    type Simple_First is new Ada.Finalization.Controlled with
+      record
+        My_Init_Seq_Number : Natural;
+      end record;
+    procedure Initialize( T : in out Simple_First );
+    procedure Finalize  ( T : in out Simple_First );
+
+  end Firsts;
+
+  type Constrained_Second(Container : access List_Item) is
+         new Ada.Finalization.Limited_Controlled with null record;
+  procedure Initialize( T : in out Constrained_Second );
+  procedure Finalize  ( T : in out Constrained_Second );
+
+  type Simple_Second is new Ada.Finalization.Controlled with
+    record
+      My_Init_Seq_Number : Natural;
+    end record; 
+  procedure Initialize( T : in out Simple_Second );
+  procedure Finalize  ( T : in out Simple_Second );
+
+  -- by 3.8(18);6.0 the following type contains components constrained
+  -- by per-object expressions
+
+
+  type List_Item is new Ada.Finalization.Limited_Controlled
+    with record
+      ContentA : Firsts.Constrained_First( List_Item'Access ); -- C S
+      SimpleA  : Firsts.Simple_First;                          -- A T
+      SimpleB  : Simple_Second;                                -- A T
+      ContentB : Constrained_Second( List_Item'Access );       -- D R
+      Next     : List;                                         -- | |
+    end record;                                                -- | |
+  procedure Initialize( L : in out List_Item ); ------------------+ |
+  procedure Finalize  ( L : in out List_Item ); --------------------+
+
+  -- the tags are the same for SimpleA and SimpleB due to the fact that
+  -- the language does not specify an ordering with respect to this
+  -- component pair. 7.6(12) does specify the rest of the ordering.
+
+  procedure Deallocate is new Ada.Unchecked_Deallocation(List_Item,List);
+
+end C760012_0;
+ 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+package body C760012_0 is
+
+  package body Firsts is
+
+    procedure Initialize( T : in out Constrained_First ) is
+    begin
+      TCTouch.Touch('C');   ----------------------------------------------- C
+    end Initialize;
+
+    procedure Finalize  ( T : in out Constrained_First ) is
+    begin
+      TCTouch.Touch('S');   ----------------------------------------------- S
+    end Finalize;
+
+    procedure Initialize( T : in out Simple_First ) is
+    begin
+      T.My_Init_Seq_Number := 0;
+      TCTouch.Touch('A');   ----------------------------------------------- A
+    end Initialize;
+
+    procedure Finalize  ( T : in out Simple_First ) is
+    begin
+      TCTouch.Touch('T');   ----------------------------------------------- T
+    end Finalize;
+
+  end Firsts;
+
+  procedure Initialize( T : in out Constrained_Second ) is
+  begin
+    TCTouch.Touch('D');   ------------------------------------------------- D
+  end Initialize;
+
+  procedure Finalize  ( T : in out Constrained_Second ) is
+  begin
+    TCTouch.Touch('R');   ------------------------------------------------- R
+  end Finalize;
+
+
+  procedure Initialize( T : in out Simple_Second ) is
+  begin
+    T.My_Init_Seq_Number := 0;
+    TCTouch.Touch('A');   ------------------------------------------------- A
+  end Initialize;
+
+  procedure Finalize  ( T : in out Simple_Second ) is
+  begin
+    TCTouch.Touch('T');   ------------------------------------------------- T
+  end Finalize;
+
+  procedure Initialize( L : in out List_Item ) is
+  begin
+    TCTouch.Touch('F');   ------------------------------------------------- F
+  end Initialize;
+
+  procedure Finalize  ( L : in out List_Item ) is
+  begin
+    TCTouch.Touch('Q');   ------------------------------------------------- Q
+  end Finalize;
+
+end C760012_0;
+ 
+--------------------------------------------------------------------- C760012
+
+with Report;
+with TCTouch;
+with C760012_0;
+procedure C760012 is
+
+  use type C760012_0.List;
+
+  procedure Subtest_1 is
+  -- by 3.8(18);6.0 One_Of_Them is constrained by per-object constraints
+  -- 7.6.1(9);6.0 dictates the order of finalization of the components
+
+    One_Of_Them : C760012_0.List_Item;
+  begin
+    if One_Of_Them.Next /= null then  -- just to hold the subtest in place
+      Report.Failed("No default value for Next");
+    end if;
+  end Subtest_1;
+
+  List : C760012_0.List;
+
+  procedure Subtest_2 is
+  begin
+
+    List := new C760012_0.List_Item;
+
+    List.Next := new C760012_0.List_Item;
+
+  end Subtest_2;
+
+  procedure Subtest_3 is
+  begin
+
+    C760012_0.Deallocate( List.Next );
+
+    C760012_0.Deallocate( List );
+
+  end Subtest_3;
+  
+begin  -- Main test procedure.
+
+  Report.Test ("C760012", "Check that record components that have " &
+                          "per-object access discriminant constraints " &
+                          "are initialized in the order of their " &
+                          "component declarations, and after any " &
+                          "components that are not so constrained.  " &
+                          "Check that record components that have " &
+                          "per-object access discriminant constraints " &
+                          "are finalized in the reverse order of their " &
+                          "component declarations, and before any " &
+                          "components that are not so constrained" );
+
+  Subtest_1;
+  TCTouch.Validate("AACDFQRSTT", "One object");
+
+  Subtest_2;
+  TCTouch.Validate("AACDFAACDF", "Two objects dynamically allocated");
+
+  Subtest_3;
+  TCTouch.Validate("QRSTTQRSTT", "Two objects deallocated");
+
+  Report.Result;
+
+end C760012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760013.a
new file mode 100644
index 000000000..6921bf027
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760013.a
@@ -0,0 +1,108 @@
+-- C760013.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that Initialize is not called for default-initialized subcomponents
+--    of the ancestor type of an extension aggregate.  (Defect Report
+--    8652/0021, Technical Corrigendum 7.6(11/1)).
+--
+-- CHANGE HISTORY:
+--    25 JAN 2001   PHL   Initial version.
+--    29 JUN 2001   RLB   Reformatted for ACATS.
+--
+--!
+with Ada.Finalization;
+use Ada.Finalization;
+package C760013_0 is
+
+    type Ctrl1 is new Controlled with
+	record
+	    C : Integer := 0;
+	end record;
+    type Ctrl2 is new Controlled with
+	record
+	    C : Integer := 0;
+	end record;
+
+    procedure Initialize (Obj1 : in out Ctrl1);
+    procedure Initialize (Obj2 : in out Ctrl2);
+
+end C760013_0;
+
+with Report;
+use Report;
+package body C760013_0 is
+
+    procedure Initialize (Obj1 : in out Ctrl1) is
+    begin
+	Obj1.C := Ident_Int (47);
+    end Initialize;
+
+    procedure Initialize (Obj2 : in out Ctrl2) is
+    begin
+	Failed ("Initialize called for type Ctrl2");
+    end Initialize;
+
+end C760013_0;
+
+with Ada.Finalization;
+with C760013_0;
+use C760013_0;
+with Report;
+use Report;
+procedure C760013 is
+
+    type T is tagged
+	record
+	    C1 : Ctrl1;
+	    C2 : Ctrl2 := (Ada.Finalization.Controlled with
+			   C => Ident_Int (23));
+	end record;
+
+    type Nt is new T with
+	record
+	    C3 : Float;
+	end record;
+
+    X : Nt;
+
+begin
+    Test ("C760013",
+	  "Check that Initialize is not called for " &
+	     "default-initialized subcomponents of the ancestor type of an " &
+	     "extension aggregate");
+
+    X := (T with C3 => 5.0);
+
+    if X.C1.C /= Ident_Int (47) then
+	Failed ("Initialize not called for type Ctrl1");
+    end if;
+    if X.C2.C /= Ident_Int (23) then
+	Failed ("Initial value not assigned for type Ctrl2");
+    end if;
+
+    Result;
+end C760013;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761001.a
new file mode 100644
index 000000000..7be1ee07a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761001.a
@@ -0,0 +1,117 @@
+-- C761001.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 controlled objects declared immediately within a library
+--      package are finalized following the completion of the environment
+--      task (and prior to termination of the program).
+--
+-- TEST DESCRIPTION:
+--      This test derives a type from Ada.Finalization.Controlled, and
+--      declares an object of that type in the body of a library package.
+--      The dispatching procedure Finalize is redefined for the derived
+--      type to perform a check that it has been called only once, and in
+--      turn calls Report.Result.  This test may fail by not calling
+--      Report.Result.  This test may also fail by calling Report.Result
+--      twice, the first call will report a false pass.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      13 Nov 95   SAIC    Updated for ACVC 2.0.1
+--
+--!
+
+with Ada.Finalization;
+package C761001_0 is
+
+  type Global is new Ada.Finalization.Controlled with null record;
+  procedure Finalize( It: in out Global );
+
+end C761001_0;
+
+package C761001_1 is
+
+  task Library_Task is
+    entry Never_Called;
+  end Library_Task;
+
+end C761001_1;
+
+with Report;
+with C761001_1;
+package body C761001_0 is
+
+  My_Object : Global;
+
+  Done : Boolean := False;
+
+  procedure Finalize( It: in out Global ) is
+  begin
+    if not C761001_1.Library_Task'Terminated then
+      Report.Failed("Library task not terminated before finalize");
+    end if;
+    if Done then  -- checking included "just in case"
+      Report.Comment("Test FAILED, even if previously reporting passed");
+      Report.Failed("Unwarranted multiple call to finalize");
+    end if;
+    Report.Result;
+    Done := True;
+  end Finalize;
+
+end C761001_0;
+
+with Report;
+package body C761001_1 is
+
+  task body Library_Task is
+  begin
+    if Report.Ident_Int( 1 ) /= 1 then
+      Report.Failed( "Baseline failure in Library_Task");
+    end if;
+  end Library_Task;
+
+end C761001_1;
+
+with Report;
+with C761001_0;
+
+procedure C761001 is
+
+begin  -- Main test procedure.
+
+  Report.Test ("C761001", "Check that controlled objects declared "
+                        & "immediately within a library package are "
+                        & "finalized following the completion of the "
+                        & "environment task (and prior to termination "
+                        & "of the program)");
+
+  -- note that if the test DOES call report twice, the first will report a
+  -- false pass, the second call will correctly fail the test.
+
+  -- not calling Report.Result;
+  -- Result is called as part of the finalization of C761001_0.My_Object.
+
+end C761001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761002.a
new file mode 100644
index 000000000..5b807bba7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761002.a
@@ -0,0 +1,245 @@
+-- C761002.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 objects of a controlled type that are created
+--      by an allocator are finalized at the appropriate time.  In 
+--      particular, check that such objects are not finalized due to 
+--      completion of the master in which they were allocated if the 
+--      corresponding access type is declared outside of that master.
+--
+--      Check that Unchecked_Deallocation of a controlled 
+--      object causes finalization of that object.
+--
+-- TEST DESCRIPTION:
+--      This test derives a type from Ada.Finalization.Controlled, and
+--      declares access types to that type in various scope scenarios.
+--      The dispatching procedure Finalize is redefined for the derived
+--      type to perform a check that it has been called at the 
+--      correct time.  This is accomplished using a global variable 
+--      which indicates what state the software is currently 
+--      executing.  The test utilizes the TCTouch facilities to 
+--      verify that Finalize is called the correct number of times, at 
+--      the correct times.  Several calls are made to validate passing 
+--      the null string to check that Finalize has NOT been called at 
+--      that point.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Ada.Finalization;
+package C761002_0 is
+  type Global is new Ada.Finalization.Controlled with null record;
+  procedure Finalize( It: in out Global );
+  
+  type Second is new Ada.Finalization.Limited_Controlled with null record;
+  procedure Finalize( It: in out Second );
+end C761002_0;
+
+with Report;
+with TCTouch;
+package body C761002_0 is
+
+  procedure Finalize( It: in out Global ) is
+  begin
+    TCTouch.Touch('F');  ------------------------------------------------- F
+  end Finalize;
+
+  procedure Finalize( It: in out Second ) is
+  begin
+    TCTouch.Touch('S');  ------------------------------------------------- S
+  end Finalize;
+end C761002_0;
+
+with Report;
+with TCTouch;
+with C761002_0;
+with Unchecked_Deallocation;
+procedure C761002 is
+
+  -- check the straightforward case
+  procedure Subtest_1 is
+    type Access_1 is access C761002_0.Global;
+    V1 : Access_1;
+    procedure Allocate is
+      V2 : Access_1;
+    begin
+      V2 := new C761002_0.Global;
+      V1 := V2;  -- "dead" assignment must not be optimized away due to
+                 -- finalization "side effects", many more of these follow
+    end Allocate;
+  begin
+    Allocate;
+    -- no calls to Finalize should have occurred at this point
+    TCTouch.Validate("","Allocated nested, retained");
+  end Subtest_1;
+  
+  -- check Unchecked_Deallocation
+  procedure Subtest_2 is
+    type Access_2 is access C761002_0.Global;
+    procedure Free is
+              new Unchecked_Deallocation(C761002_0.Global, Access_2);
+    V1 : Access_2;
+    V2 : Access_2;
+
+    procedure Allocate is
+    begin
+      V1 := new C761002_0.Global;
+      V2 := new C761002_0.Global;
+    end Allocate;
+
+  begin
+    Allocate;
+    -- no calls to Finalize should have occurred at this point.
+    TCTouch.Validate("","Allocated nested, non-local");
+    
+    Free(V1); -- instance of Unchecked_Deallocation
+    -- should cause the finalization of V1.all
+    TCTouch.Validate("F","Unchecked Deallocation");
+  end Subtest_2; -- leaving this scope should cause the finalization of V2.all
+  
+  -- check various master-exit scenarios
+  -- the "Fake" parameters are used to avoid unwanted optimizations
+  procedure Subtest_3 is
+    procedure With_Local_Block is
+      type Access_3 is access C761002_0.Global;
+      V1 : Access_3;
+    begin
+      declare
+        V2 : Access_3 := new C761002_0.Global;
+      begin
+        V1 := V2;
+      end;
+      TCTouch.Validate("","Local Block, normal exit");
+      -- the allocated object should be finalized on leaving this scope
+    end With_Local_Block;
+    
+    procedure With_Local_Block_Return(Fake: Integer) is
+      type Access_4 is access C761002_0.Global;
+      V1 : Access_4 := new C761002_0.Global;
+    begin
+      if Fake = 0 then
+        declare
+          V2 : Access_4;
+        begin
+          V2 := new C761002_0.Global;
+          return; -- the two allocated objects should be finalized
+        end;      -- upon leaving this scope
+      else
+        V1 := null;
+      end if;
+    end With_Local_Block_Return;
+
+    procedure With_Goto(Fake: Integer) is
+      type Access_5 is access C761002_0.Global;
+      V1 : Access_5 := new C761002_0.Global;
+      V2 : Access_5;
+      V3 : Access_5;
+    begin
+      if Fake = 0 then
+        declare
+          type Access_6 is access C761002_0.Second;
+          V6 : Access_6;
+        begin
+          V6 := new C761002_0.Second;
+          goto check;
+        end;
+      else
+        V2 := V1;
+      end if;
+      V3 := V2;
+<<check>>
+      TCTouch.Validate("S","goto past master end");
+     end With_Goto;
+
+  begin
+    With_Local_Block;
+    TCTouch.Validate("F","Local Block, normal exit, after master");
+
+    With_Local_Block_Return( Report.Ident_Int(0) );
+    TCTouch.Validate("FF","Local Block, return from block");
+
+    With_Goto( Report.Ident_Int(0) );
+    TCTouch.Validate("F","With Goto");
+
+  end Subtest_3;
+
+  procedure Subtest_4 is
+
+    Oops : exception;
+    
+    procedure Alley( Fake: Integer ) is
+      type Access_1 is access C761002_0.Global;
+      V1 : Access_1;
+    begin
+      V1 := new C761002_0.Global;
+      if Fake = 1 then
+        raise Oops;
+      end if;
+      V1 := null;
+    end Alley;
+  
+  begin
+    Catch: begin
+      Alley( Report.Ident_Int(1) );
+    exception
+      when Oops   => TCTouch.Validate("F","leaving via exception");
+      when others => Report.Failed("Wrong exception");
+    end Catch;
+  end Subtest_4;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C761002", "Check that objects of a controlled type created "
+                        & "by an allocator are finalized appropriately. " 
+                        & "Check that Unchecked_Deallocation of a "
+                        & "controlled object causes finalization " 
+                        & "of that object" );
+  
+  Subtest_1;
+  -- leaving the scope of the access type should finalize the 
+  -- collection
+  TCTouch.Validate("F","Allocated nested, Subtest 1");
+  
+  Subtest_2;
+  -- Unchecked_Deallocation already finalized one of the two 
+  -- objects allocated, the other should be the only one finalized 
+  -- at leaving the scope of the access type.
+  TCTouch.Validate("F","Allocated non-local");
+
+  Subtest_3;
+  -- there should be no remaining finalizations from this subtest
+  TCTouch.Validate("","Localized objects");
+
+  Subtest_4;
+  -- there should be no remaining finalizations from this subtest
+  TCTouch.Validate("","Exception testing");
+
+  Report.Result;
+
+end C761002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761003.a
new file mode 100644
index 000000000..77051ee4a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761003.a
@@ -0,0 +1,447 @@
+-- C761003.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 an object of a controlled type is finalized when the
+--      enclosing master is complete.
+--      Check this for controlled types where the derived type has a
+--      discriminant.
+--      Check this for subprograms of abstract types derived from the
+--      types in Ada.Finalization.
+--
+--      Check that finalization of controlled objects is
+--      performed in the correct order.  In particular, check that if
+--      multiple objects of controlled types are declared immediately
+--      within the same declarative part then type are finalized in the
+--      reverse order of their creation.
+--
+-- TEST DESCRIPTION:
+--      This test checks these conditions for subprograms and
+--      block statements; both variables and constants of controlled
+--      types; cases of a controlled component of a record type, as
+--      well as an array with controlled components.
+--
+--      The base controlled types used for the test are defined
+--      with a character discriminant.  The initialize procedure for
+--      the types will record the order of creation in a globally
+--      accessible array, the finalize procedure for the types will call
+--      TCTouch with that tag character.  The test can then check that
+--      the order of finalization is indeed the reverse of the order of
+--      creation (assuming that the implementation calls Initialize in
+--      the order that the objects are created).
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      02 Nov 95   SAIC    ACVC 2.0.1
+--
+--!
+
+------------------------------------------------------------ C761003_Support
+
+package C761003_Support is
+  
+  function Pick_Char return Character;
+  -- successive calls to Pick_Char return distinct characters which may
+  -- be assigned to objects to track an order sequence.  These characters
+  -- are then used in calls to TCTouch.Touch.
+
+  procedure Validate(Initcount   : Natural;
+                     Testnumber  : Natural;
+                     Check_Order : Boolean := True);
+  -- does a little extra processing prior to calling TCTouch.Validate,
+  -- specifically, it reverses the stored string of characters, and checks
+  -- for a correct count.
+
+  Inits_Order  : String(1..255);
+  Inits_Called : Natural := 0;
+
+end C761003_Support;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with TCTouch;
+package body C761003_Support is
+  type Pick_Rotation is mod 52;
+  type Pick_String is array(Pick_Rotation) of Character;
+
+  From : constant Pick_String  := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                & "abcdefghijklmnopqrstuvwxyz";
+  Recent_Pick : Pick_Rotation := Pick_Rotation'Last;
+
+  function Pick_Char return Character is
+  begin
+    Recent_Pick := Recent_Pick +1;
+    return From(Recent_Pick);
+  end Pick_Char;
+
+  function Invert(S:String) return String is
+    T: String(1..S'Length);
+  begin
+    for SI in reverse S'Range loop
+      T(S'Last - SI + 1) := S(SI);
+    end loop;
+    return T;
+  end Invert;
+
+  procedure Validate(Initcount   : Natural;
+                     Testnumber  : Natural;
+                     Check_Order : Boolean := True) is
+    Number : constant String := Natural'Image(Testnumber);
+  begin
+    if Inits_Called /= Initcount then
+      Report.Failed("Got" & Natural'Image(Inits_Called) & " inits, expected"
+                    & Natural'Image(Initcount) & ", Subtest " & Number);
+      TCTouch.Flush;
+    else
+      TCTouch.Validate(
+        Invert(Inits_Order(1..Inits_Called)),
+               "Subtest " & Number, Order_Meaningful => Check_Order );
+    end if;
+    Inits_Called := 0;  -- reset for the next batch
+  end Validate;
+
+end C761003_Support;
+
+------------------------------------------------------------------ C761003_0
+
+with Ada.Finalization;
+package C761003_0 is
+
+  type Global(Tag: Character) is new Ada.Finalization.Controlled
+    with null record;
+
+  procedure Initialize( It: in out Global );
+  procedure Finalize  ( It: in out Global );
+
+  Null_Global : Global('1') := (Ada.Finalization.Controlled with Tag => '1');
+
+  type Second(Tag: Character) is new Ada.Finalization.Limited_Controlled
+    with null record;
+
+  procedure Initialize( It: in out Second );
+  procedure Finalize  ( It: in out Second );
+
+end C761003_0;
+
+------------------------------------------------------------------ C761003_1
+
+with Ada.Finalization;
+package C761003_1 is
+
+  type Global is abstract new Ada.Finalization.Controlled with record
+    Tag: Character;
+  end record;
+
+  procedure Initialize( It: in out Global );
+  procedure Finalize  ( It: in out Global );
+
+  type Second is abstract new Ada.Finalization.Limited_Controlled with record
+    Tag: Character;
+  end record;
+
+  procedure Initialize( It: in out Second );
+  procedure Finalize  ( It: in out Second );
+
+end C761003_1;
+
+------------------------------------------------------------------ C761003_2
+
+with C761003_1;
+package C761003_2 is
+
+  type Global is new C761003_1.Global with null record;
+  -- inherits Initialize and Finalize
+
+  type Second is new C761003_1.Second with null record;
+  -- inherits Initialize and Finalize
+
+end C761003_2;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --  C761003_0
+
+with TCTouch;
+with C761003_Support;
+package body C761003_0 is
+
+  package Sup renames C761003_Support;
+
+  procedure Initialize( It: in out Global ) is
+  begin
+    Sup.Inits_Called := Sup.Inits_Called +1;
+    Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+  end Initialize;
+
+  procedure Finalize( It: in out Global ) is
+  begin
+    TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+  end Finalize;
+
+  procedure Initialize( It: in out Second ) is
+  begin
+    Sup.Inits_Called := Sup.Inits_Called +1;
+    Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+  end Initialize;
+
+  procedure Finalize( It: in out Second ) is
+  begin
+    TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+  end Finalize;
+
+end C761003_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --  C761003_1
+
+with TCTouch;
+with C761003_Support;
+package body C761003_1 is
+
+  package Sup renames C761003_Support;
+
+  procedure Initialize( It: in out Global ) is
+  begin
+    Sup.Inits_Called := Sup.Inits_Called +1;
+    It.Tag := Sup.Pick_Char;
+    Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+  end Initialize;
+
+  procedure Finalize( It: in out Global ) is
+  begin
+    TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+  end Finalize;
+
+  procedure Initialize( It: in out Second ) is
+  begin
+    Sup.Inits_Called := Sup.Inits_Called +1;
+    It.Tag := Sup.Pick_Char;
+    Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+  end Initialize;
+
+  procedure Finalize( It: in out Second ) is
+  begin
+    TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+  end Finalize;
+
+end C761003_1;
+
+-------------------------------------------------------------------- C761003
+
+with Report;
+with TCTouch;
+with C761003_0;
+with C761003_2;
+with C761003_Support;
+procedure C761003 is
+
+  package Sup renames C761003_Support;
+
+---------------------------------------------------------------- Subtest_1
+
+  Subtest_1_Inits_Expected : constant := 5;  -- includes 1 previous
+
+  procedure Subtest_1 is
+
+    -- the constant will take its constraint from the value.
+    -- must be declared first to be finalized last (and take the
+    -- initialize from before calling subtest_1)
+    Item_1 : constant C761003_0.Global := C761003_0.Null_Global;
+
+    -- Item_2, declared second, should be finalized second to last.
+    Item_2 : C761003_0.Global(Sup.Pick_Char);
+
+    -- Item_3 and Item_4 will be created in the order of the
+    -- list.
+    Item_3, Item_4 : C761003_0.Global(Sup.Pick_Char);
+
+   -- Item_5 will be finalized first.
+    Item_5 : C761003_0.Second(Sup.Pick_Char);
+
+  begin
+    if Item_3.Tag >= Item_4.Tag then
+      Report.Failed("Controlled objects created by list in wrong order");
+    end if;
+    -- check that nothing has happened yet!
+    TCTouch.Validate("","Subtest 1 body");
+  end Subtest_1;
+
+---------------------------------------------------------------- Subtest_2
+
+  -- These declarations should cause calls to initialize and
+  -- finalize.  The expected operations are the subprograms associated
+  -- with the abstract types.  Note that for these objects, the
+  -- Initialize and Finalize are visible only by inheritance.
+
+  Subtest_2_Inits_Expected : constant := 4;
+
+  procedure Subtest_2 is
+
+    Item_1 : C761003_2.Global;
+    Item_2, Item_3 : C761003_2.Global;
+    Item_4 : C761003_2.Second;
+
+  begin
+    -- check that nothing has happened yet!
+    TCTouch.Validate("","Subtest 2 body");
+  end Subtest_2;
+
+---------------------------------------------------------------- Subtest_3
+
+  -- Test for controlled objects embedded in arrays.  Using structures
+  -- that will cause a checkable order.
+
+  Subtest_3_Inits_Expected : constant := 8;
+
+  procedure Subtest_3 is
+
+    type Global_List is array(Natural range <>)
+                          of C761003_0.Global(Sup.Pick_Char);
+
+    Items : Global_List(1..4);  -- components have the same tag
+
+    type Second_List is array(Natural range <>)
+                          of C761003_0.Second(Sup.Pick_Char);
+
+    Second_Items : Second_List(1..4);  -- components have the same tag,
+                                       -- distinct from the tag used in Items
+
+  begin
+    -- check that nothing has happened yet!
+    TCTouch.Validate("","Subtest 3 body");
+  end Subtest_3;
+
+---------------------------------------------------------------- Subtest_4
+
+  -- These declarations should cause dispatching calls to initialize and
+  -- finalize.  The expected operations are the subprograms associated
+  -- with the abstract types.
+
+  Subtest_4_Inits_Expected : constant := 2;
+
+  procedure Subtest_4 is
+
+    type Global_Rec is record
+      Item1: C761003_0.Global(Sup.Pick_Char);
+    end record;
+
+    type Second_Rec is record
+      Item2: C761003_2.Second;
+    end record;
+
+    G : Global_Rec;
+    S : Second_Rec;
+
+  begin
+    -- check that nothing has happened yet!
+    TCTouch.Validate("","Subtest 4 body");
+  end Subtest_4;
+
+---------------------------------------------------------------- Subtest_5
+
+  -- Test for controlled objects embedded in arrays.  In these cases, the
+  -- order of the finalization of the components is not defined by the
+  -- language.
+
+  Subtest_5_Inits_Expected : constant := 8;
+
+  procedure Subtest_5 is
+
+
+    type Another_Global_List is array(Natural range <>)
+                          of C761003_2.Global;
+
+    More_Items : Another_Global_List(1..4);
+
+    type Another_Second_List is array(Natural range <>)
+                          of C761003_2.Second;
+
+    Second_More_Items : Another_Second_List(1..4);
+
+  begin
+    -- check that nothing has happened yet!
+    TCTouch.Validate("","Subtest 5 body");
+  end Subtest_5;
+
+---------------------------------------------------------------- Subtest_6
+
+  -- These declarations should cause dispatching calls to initialize and
+  -- finalize.  The expected operations are the subprograms associated
+  -- with the abstract types.
+
+  Subtest_6_Inits_Expected : constant := 2;
+
+  procedure Subtest_6 is
+
+    type Global_Rec is record
+     Item2: C761003_2.Global;
+    end record;
+
+    type Second_Rec is record
+      Item1: C761003_0.Second(Sup.Pick_Char);
+   end record;
+
+    G : Global_Rec;
+    S : Second_Rec;
+
+  begin
+    -- check that nothing has happened yet!
+    TCTouch.Validate("","Subtest 6 body");
+  end Subtest_6;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C761003", "Check that an object of a controlled type "
+                        & "is finalized when the enclosing master is "
+                        & "complete, left by a transfer of control, "
+                        & "and performed in the correct order" );
+
+  -- adjust for optional adjusts and initializes for C761003_0.Null_Global
+  TCTouch.Flush; -- clear the optional adjust
+  if Sup.Inits_Called /= 1 then
+    -- C761003_0.Null_Global did not get "initialized"
+    C761003_0.Initialize(C761003_0.Null_Global);  -- prime the pump
+  end if;
+
+  Subtest_1;
+  Sup.Validate(Subtest_1_Inits_Expected, 1);
+
+  Subtest_2;
+  Sup.Validate(Subtest_2_Inits_Expected, 2);
+
+  Subtest_3;
+  Sup.Validate(Subtest_3_Inits_Expected, 3);
+
+  Subtest_4;
+  Sup.Validate(Subtest_4_Inits_Expected, 4);
+
+  Subtest_5;
+  Sup.Validate(Subtest_5_Inits_Expected, 5, Check_Order => False);
+
+  Subtest_6;
+  Sup.Validate(Subtest_6_Inits_Expected, 6);
+
+  Report.Result;
+
+end C761003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761004.a
new file mode 100644
index 000000000..9b88382b4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761004.a
@@ -0,0 +1,305 @@
+-- C761004.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 an object of a controlled type is finalized with the
+--      enclosing master is complete.
+--      Check that finalization occurs in the case where the master is
+--      left by a transfer of control.
+--      Specifically check for types where the derived types do not have
+--      discriminants.
+--      
+--      Check that finalization of controlled objects is 
+--      performed in the correct order.  In particular, check that if 
+--      multiple objects of controlled types are declared immediately 
+--      within the same declarative part then they are finalized in the 
+--      reverse order of their creation.
+--
+-- TEST DESCRIPTION:
+--      This test checks these conditions for subprograms and 
+--      block statements; both variables and constants of controlled 
+--      types; cases of a controlled component of a record type, as 
+--      well as an array with controlled components.
+--
+--      The base controlled types used for the test are defined 
+--      with a character discriminant.  The initialize procedure for 
+--      the types will record the order of creation in a globally 
+--      accessible array, the finalize procedure for the types will call
+--      TCTouch with that tag character.  The test can then check that 
+--      the order of finalization is indeed the reverse of the order of 
+--      creation (assuming that the implementation calls Initialize in 
+--      the order that the objects are created).
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1
+--
+--! 
+
+package C761004_Support is
+  
+  function Pick_Char return Character;
+  -- successive calls to Pick_Char return distinct characters which may
+  -- be assigned to objects to track an order sequence.  These characters
+  -- are then used in calls to TCTouch.Touch.
+
+  procedure Validate(Initcount: Natural; Testnumber:Natural);
+  -- does a little extra processing prior to calling TCTouch.Validate,
+  -- specifically, it reverses the stored string of characters, and checks
+  -- for a correct count.
+
+  Inits_Order  : String(1..255);
+  Inits_Called : Natural := 0;
+
+end C761004_Support;
+
+with Report;
+with TCTouch;
+package body C761004_Support is
+  type Pick_Rotation is mod 52;
+  type Pick_String is array(Pick_Rotation) of Character;
+
+  From : constant Pick_String  := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                & "abcdefghijklmnopqrstuvwxyz";
+  Recent_Pick : Pick_Rotation := Pick_Rotation'Last;
+
+  function Pick_Char return Character is
+  begin
+    Recent_Pick := Recent_Pick +1;
+    return From(Recent_Pick);
+  end Pick_Char;
+
+  function Invert(S:String) return String is
+    T: String(1..S'Length);
+    TI: Positive := 1;
+  begin
+    for SI in reverse S'Range loop
+      T(TI) := S(SI);
+      TI := TI +1;
+    end loop;
+    return T;
+  end Invert;
+
+  procedure Validate(Initcount: Natural; Testnumber:Natural) is
+    Number : constant String := Natural'Image(Testnumber);
+  begin
+    if Inits_Called /= Initcount then
+      Report.Failed("Wrong number of inits, Subtest " & Number);
+      TCTouch.Flush;
+    else
+      TCTouch.Validate(
+        Invert(Inits_Order(1..Inits_Called)),
+               "Subtest " & Number, True);
+    end if;
+  end Validate;
+
+end C761004_Support;
+
+----------------------------------------------------------------- C761004_0
+
+with Ada.Finalization;
+package C761004_0 is
+  type Global is new Ada.Finalization.Controlled with record
+    Tag : Character;
+  end record;
+  procedure Initialize( It: in out Global );
+  procedure Finalize  ( It: in out Global );
+
+  type Second is new Ada.Finalization.Limited_Controlled with record
+    Tag : Character;
+  end record;
+  procedure Initialize( It: in out Second );
+  procedure Finalize  ( It: in out Second );
+
+end C761004_0;
+
+with TCTouch;
+with C761004_Support;
+package body C761004_0 is
+  
+  package Sup renames C761004_Support;
+
+  procedure Initialize( It: in out Global ) is
+  begin
+    Sup.Inits_Called := Sup.Inits_Called +1;
+    It.Tag := Sup.Pick_Char;
+    Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+  end Initialize;
+  
+  procedure Finalize( It: in out Global ) is
+  begin
+    TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+  end Finalize;
+
+  procedure Initialize( It: in out Second ) is
+  begin
+    Sup.Inits_Called := Sup.Inits_Called +1;
+    It.Tag := Sup.Pick_Char;
+    Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+  end Initialize;
+  
+  procedure Finalize( It: in out Second ) is
+  begin
+    TCTouch.Touch(It.Tag);  --------------------------------------------- Tag
+  end Finalize;
+end C761004_0;
+
+------------------------------------------------------------------- C761004
+
+with Report;
+with TCTouch;
+with C761004_0;
+with C761004_Support;
+with Ada.Finalization; -- needed to be able to create extension aggregates
+procedure C761004 is
+
+  Verbose : constant Boolean := False;
+
+  package Sup renames C761004_Support;
+
+  -- Subtest 1, general case.  Check that several objects declared in a
+  -- subprogram are created, and finalized in opposite order.
+
+  Subtest_1_Expected_Inits : constant := 3;
+
+  procedure Subtest_1 is
+    Item_1 : C761004_0.Global;
+    Item_2, Item_3 : C761004_0.Global;
+ begin
+    if Item_2.Tag = Item_3.Tag then  -- not germane to the test
+      Report.Failed("Duplicate tag");-- but helps prevent code elimination
+    end if;
+  end Subtest_1;
+
+  -- Subtest 2, extension of the general case.  Check that several objects
+  -- created identically on the stack (via a recursive procedure) are
+  -- finalized in the opposite order of their creation.
+  Subtest_2_Expected_Inits : constant := 12;
+  User_Exception : exception;
+  
+  procedure Subtest_2 is
+    
+    Item_1 : C761004_0.Global;
+
+    -- combine recursion and exit by exception:
+
+    procedure Nested(Recurs: Natural) is
+      Item_3 : C761004_0.Global;
+    begin
+      if Verbose then
+        Report.Comment("going in: " & Item_3.Tag);
+      end if;
+      if Recurs = 1 then
+        raise User_Exception;
+      else
+        Nested(Recurs -1);
+      end if;
+    end Nested;
+    
+    Item_2 : C761004_0.Global;
+  
+  begin
+    Nested(10);
+  end Subtest_2;
+
+  -- subtest 3, check the case of objects embedded in structures:
+  -- an array
+  -- a record
+  Subtest_3_Expected_Inits : constant := 3;
+  procedure Subtest_3 is
+    type G_List is array(Positive range <>) of C761004_0.Global;
+    type Pandoras_Box is record
+      G : G_List(1..1);
+    end record;
+
+    procedure Nested(Recursions: Natural) is
+      Merlin : Pandoras_Box;
+    begin
+      if Recursions > 1 then
+        Nested(Recursions-1);
+      else
+        TCTouch.Validate("","Final Nested call");
+      end if;
+    end Nested;
+
+  begin
+    Nested(3);
+  end Subtest_3;
+
+  -- subtest 4, check the case of objects embedded in structures:
+  -- an array
+  -- a record
+  Subtest_4_Expected_Inits : constant := 3;
+  procedure Subtest_4 is
+    type S_List is array(Positive range <>) of C761004_0.Second;
+    type Pandoras_Box is record
+      S : S_List(1..1);
+    end record;
+
+    procedure Nested(Recursions: Natural) is
+      Merlin : Pandoras_Box;
+    begin
+      if Recursions > 1 then
+        Nested(Recursions-1);
+      else
+        TCTouch.Validate("","Final Nested call");
+      end if;
+    end Nested;
+
+  begin
+    Nested(3);
+  end Subtest_4;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C761004", "Check that an object of a controlled type "
+                        & "is finalized when the enclosing master is "
+                        & "complete, left by a transfer of control, "
+                        & "and performed in the correct order" );
+
+  Subtest_1;
+  Sup.Validate(Subtest_1_Expected_Inits,1); 
+
+  Subtest_2_Frame: begin
+    Sup.Inits_Called := 0;
+    Subtest_2;
+  exception           
+    when User_Exception => null;
+    when others => Report.Failed("Wrong Exception, Subtest 2");
+  end Subtest_2_Frame;
+  Sup.Validate(Subtest_2_Expected_Inits,2);
+  
+  Sup.Inits_Called := 0;
+  Subtest_3;
+  Sup.Validate(Subtest_3_Expected_Inits,3);
+  
+  Sup.Inits_Called := 0;
+  Subtest_4;
+  Sup.Validate(Subtest_4_Expected_Inits,4);
+  
+  Report.Result;
+
+end C761004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761005.a
new file mode 100644
index 000000000..acac59b48
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761005.a
@@ -0,0 +1,288 @@
+-- C761005.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 deriving abstract types from the types in Ada.Finalization
+--      does not negatively impact the implicit operations.
+--      Check that an object of a controlled type is finalized when the
+--      enclosing master is complete.
+--      Check that finalization occurs in the case where the master is
+--      left by a transfer of control.
+--      Check this for controlled types where the derived type has a
+--      discriminant.
+--      Check this for cases where the type is defined as private,  
+--      and the full type is derived from the types in Ada.Finalization.
+--      
+--      Check that finalization of controlled objects is 
+--      performed in the correct order.  In particular, check that if 
+--      multiple objects of controlled types are declared immediately 
+--      within the same declarative part then type are finalized in the 
+--      reverse order of their creation.
+--
+-- TEST DESCRIPTION:
+--      This test checks these conditions for subprograms and 
+--      block statements; both variables and constants of controlled 
+--      types; cases of a controlled component of a record type, as 
+--      well as an array with controlled components.
+--
+--      The base controlled types used for the test are defined 
+--      with a character discriminant.  The initialize procedure for 
+--      the types will record the order of creation in a globally 
+--      accessible array, the finalize procedure for the types will call
+--      TCTouch with that tag character.  The test can then check that 
+--      the order of finalization is indeed the reverse of the order of 
+--      creation (assuming that the implementation calls Initialize in 
+--      the order that the objects are created).
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
+--
+--!
+
+package C761005_Support is  
+  
+  function Pick_Char return Character;
+  procedure Validate(Initcount: Natural; Testnumber:Natural);
+
+  Inits_Order  : String(1..255);
+  Inits_Called : Natural := 0;
+
+end C761005_Support;
+
+with Report;
+with TCTouch;
+package body C761005_Support is
+  type Pick_Rotation is mod 52;
+  type Pick_String is array(Pick_Rotation) of Character;
+
+  From : constant Pick_String  := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                & "abcdefghijklmnopqrstuvwxyz";
+  Recent_Pick : Pick_Rotation := Pick_Rotation'Last;
+
+  function Pick_Char return Character is
+  begin
+    Recent_Pick := Recent_Pick +1;
+    return From(Recent_Pick);
+  end Pick_Char;
+
+  function Invert(S:String) return String is
+    T: String(1..S'Length);
+    TI: Positive := 1;
+  begin
+    for SI in reverse S'Range loop
+      T(TI) := S(SI);
+      TI := TI +1;
+    end loop;
+    return T;
+  end Invert;
+
+  procedure Validate(Initcount: Natural; Testnumber:Natural) is
+    Number : constant String := Natural'Image(Testnumber);
+  begin
+    if Inits_Called /= Initcount then
+      Report.Failed("Wrong number of inits, Subtest " & Number);
+    else
+      TCTouch.Validate(
+        Invert(Inits_Order(1..Inits_Called)),
+               "Subtest " & Number, True);
+    end if;
+    Inits_Called := 0;
+  end Validate;
+
+end C761005_Support;
+
+-----------------------------------------------------------------------------
+with Ada.Finalization;
+package C761005_0 is
+  type Final_Root(Tag: Character) is private;
+
+  type Ltd_Final_Root(Tag: Character) is limited private; 
+  
+  Inits_Order  : String(1..255);
+  Inits_Called : Natural := 0;
+private
+  type Final_Root(Tag: Character) is new Ada.Finalization.Controlled 
+    with null record;
+  procedure Initialize( It: in out Final_Root );
+  procedure Finalize  ( It: in out Final_Root );
+  
+  type Ltd_Final_Root(Tag: Character) is new
+Ada.Finalization.Limited_Controlled 
+    with null record;
+  procedure Initialize( It: in out Ltd_Final_Root );
+  procedure Finalize  ( It: in out Ltd_Final_Root );
+end C761005_0;
+
+-----------------------------------------------------------------------------
+with Ada.Finalization;
+package C761005_1 is
+  type Final_Abstract is abstract tagged private;
+
+  type Ltd_Final_Abstract_Child is abstract tagged limited private;
+  
+  Inits_Order  : String(1..255);
+  Inits_Called : Natural := 0;
+
+private
+  type Final_Abstract is abstract new Ada.Finalization.Controlled with record
+    Tag: Character;
+  end record;
+  procedure Initialize( It: in out Final_Abstract );
+  procedure Finalize  ( It: in out Final_Abstract );
+
+  type Ltd_Final_Abstract_Child is
+       abstract new Ada.Finalization.Limited_Controlled with record
+    Tag: Character;
+  end record;
+  procedure Initialize( It: in out Ltd_Final_Abstract_Child );
+  procedure Finalize  ( It: in out Ltd_Final_Abstract_Child );
+
+end C761005_1;
+
+-----------------------------------------------------------------------------
+with C761005_1;
+package C761005_2 is
+  
+  type Final_Child is new C761005_1.Final_Abstract with null record;
+  type Ltd_Final_Child is
+       new C761005_1.Ltd_Final_Abstract_Child with null record;
+
+end C761005_2;
+
+-----------------------------------------------------------------------------
+with Report;        
+with TCTouch;
+with C761005_Support;
+package body C761005_0 is
+
+  package Sup renames C761005_Support;
+
+  procedure Initialize( It: in out Final_Root ) is
+  begin
+    Sup.Inits_Called := Sup.Inits_Called +1;
+    Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+  end Initialize;
+  
+  procedure Finalize( It: in out Final_Root ) is
+  begin
+    TCTouch.Touch(It.Tag);
+  end Finalize;
+
+  procedure Initialize( It: in out Ltd_Final_Root ) is
+  begin
+    Sup.Inits_Called := Sup.Inits_Called +1;
+    Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+  end Initialize;
+  
+  procedure Finalize( It: in out Ltd_Final_Root ) is
+  begin
+    TCTouch.Touch(It.Tag);
+  end Finalize;
+end C761005_0;
+
+-----------------------------------------------------------------------------
+with Report;        
+with TCTouch;
+with C761005_Support;
+package body C761005_1 is
+
+  package Sup renames C761005_Support;
+
+  procedure Initialize( It: in out Final_Abstract ) is
+  begin
+    Sup.Inits_Called := Sup.Inits_Called +1;
+    It.Tag := Sup.Pick_Char;
+    Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+  end Initialize;
+  
+  procedure Finalize( It: in out Final_Abstract ) is
+  begin
+    TCTouch.Touch(It.Tag);
+  end Finalize;
+
+  procedure Initialize( It: in out Ltd_Final_Abstract_Child ) is
+  begin
+    Sup.Inits_Called := Sup.Inits_Called +1;
+    It.Tag := Sup.Pick_Char;
+    Sup.Inits_Order(Sup.Inits_Called) := It.Tag;
+  end Initialize;
+  
+  procedure Finalize( It: in out Ltd_Final_Abstract_Child ) is
+  begin
+    TCTouch.Touch(It.Tag);
+  end Finalize;
+end C761005_1;
+
+-----------------------------------------------------------------------------
+with Report;
+with TCTouch;
+with C761005_0;
+with C761005_2;
+with C761005_Support;
+procedure C761005 is
+
+  package Sup renames C761005_Support;
+
+  Subtest_1_Inits_Expected : constant := 4;
+  procedure Subtest_1 is
+    Item_1 : C761005_0.Final_Root(Sup.Pick_Char);
+    Item_2, Item_3 : C761005_0.Final_Root(Sup.Pick_Char);
+    Item_4 : C761005_0.Ltd_Final_Root(Sup.Pick_Char);
+  begin
+    -- check that nothing has happened yet!
+    TCTouch.Validate("","Subtest 1 body");
+  end Subtest_1;
+
+  -- These declarations should cause calls to initialize and
+  -- finalize.  The expected operations are the subprograms associated
+  -- with the abstract types.
+  Subtest_2_Inits_Expected : constant := 4;
+  procedure Subtest_2 is
+    Item_1 : C761005_2.Final_Child;
+    Item_2, Item_3 : C761005_2.Final_Child;
+    Item_4 : C761005_2.Ltd_Final_Child;
+  begin
+    -- check that nothing has happened yet!
+    TCTouch.Validate("","Subtest 2 body");
+  end Subtest_2;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C761005", "Check that an object of a controlled type "
+                        & "is finalized when the enclosing master is "
+                        & "complete, left by a transfer of control, "
+                        & "and performed in the correct order" );
+
+  Subtest_1;
+  Sup.Validate(Subtest_1_Inits_Expected,1); 
+  
+  Subtest_2;
+  Sup.Validate(Subtest_2_Inits_Expected,2);
+
+  Report.Result;
+
+end C761005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761006.a
new file mode 100644
index 000000000..771e625d1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761006.a
@@ -0,0 +1,425 @@
+-- C761006.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 Program_Error is raised when:
+--        * an exception is raised if Finalize invoked as part of an
+--          assignment operation; or
+--        * an exception is raised if Adjust invoked as part of an assignment
+--          operation, after any other adjustment due to be performed are
+--          performed; or
+--        * an exception is raised if Finalize invoked as part of a call on
+--          Unchecked_Deallocation, after any other finalizations to be
+--          performed are performed.
+--
+-- TEST DESCRIPTION:
+--      This test defines these four controlled types:
+--        Good
+--        Bad_Initialize
+--        Bad_Adjust
+--        Bad_Finalize
+--      The type name conveys the associated failure.  The operations in type
+--      good will "touch" the boolean array indicating correct path
+--      utilization for the purposes of checking "other <operations> are
+--      performed", where <operations> ::= initialization, adjusting, and
+--      finalization
+--
+--
+--
+-- CHANGE HISTORY:
+--      12 APR 94   SAIC   Initial version
+--      02 MAY 96   SAIC   Visibility fixed for 2.1
+--      13 FEB 97   PWB.CTA Corrected value of Events_Occurring at line 286
+--      01 DEC 97   EDS    Made correction wrt RM 7.6(21)
+--      16 MAR 01   RLB    Corrected Adjust cases to avoid problems with
+--                         RM 7.6.1(16/1) from Technical Corrigendum 1.
+--
+--!
+
+------------------------------------------------------------- C761006_Support
+
+package C761006_Support is
+
+  type Events is ( Good_Initialize, Good_Adjust, Good_Finalize );
+
+  type Event_Array is array(Events) of Boolean;
+
+  Events_Occurring : Event_Array := (others => False);
+
+  Propagating_Exception : exception;
+
+  procedure Raise_Propagating_Exception(Do_It: Boolean);
+
+  function Unique_Value return Natural;
+
+end C761006_Support;
+
+------------------------------------------------------------- C761006_Support
+
+with Report;
+package body C761006_Support is
+
+  procedure Raise_Propagating_Exception(Do_It: Boolean) is
+  begin
+     if Report.Ident_Bool(Do_It) then
+       raise Propagating_Exception;
+     end if;
+  end Raise_Propagating_Exception;
+
+  Seed : Natural := 0;
+
+  function Unique_Value return Natural is
+  begin
+    Seed := Seed +1;
+    return Seed;
+  end Unique_Value;
+
+end C761006_Support;
+
+------------------------------------------------------------------- C761006_0
+
+with Ada.Finalization;
+with C761006_Support;
+package C761006_0 is
+
+  type Good is new Ada.Finalization.Controlled
+    with record
+      Initialized : Boolean := False;
+      Adjusted    : Boolean := False;
+      Unique      : Natural := C761006_Support.Unique_Value;
+    end record;
+
+  procedure Initialize( It: in out Good );
+  procedure Adjust    ( It: in out Good );
+  procedure Finalize  ( It: in out Good );
+
+  type Bad_Initialize is private;
+
+  type Bad_Adjust     is private;
+
+  type Bad_Finalize   is private;
+
+  Inits_Order  : String(1..255);
+  Inits_Called : Natural := 0;
+private
+  type Bad_Initialize is new Ada.Finalization.Controlled
+                                             with null record;
+  procedure Initialize( It: in out Bad_Initialize );
+
+  type Bad_Adjust is new Ada.Finalization.Controlled
+                                         with null record;
+  procedure Adjust    ( It: in out Bad_Adjust );
+
+  type Bad_Finalize is
+       new Ada.Finalization.Controlled with null record;
+  procedure Finalize  ( It: in out Bad_Finalize );
+end C761006_0;
+
+------------------------------------------------------------------- C761006_1
+
+with Ada.Finalization;
+with C761006_0;
+package C761006_1 is
+
+  type Init_Check_Root is new Ada.Finalization.Controlled with record
+    Good_Component : C761006_0.Good;
+    Init_Fails     : C761006_0.Bad_Initialize;
+  end record;
+
+  type Adj_Check_Root is new Ada.Finalization.Controlled with record
+    Good_Component : C761006_0.Good;
+    Adj_Fails      : C761006_0.Bad_Adjust;
+  end record;
+
+  type Fin_Check_Root is new Ada.Finalization.Controlled with record
+    Good_Component : C761006_0.Good;
+    Fin_Fails      : C761006_0.Bad_Finalize;
+  end record;
+
+end C761006_1;
+
+------------------------------------------------------------------- C761006_2
+
+with C761006_1;
+package C761006_2 is
+
+  type Init_Check is new C761006_1.Init_Check_Root with null record;
+  type Adj_Check is  new C761006_1.Adj_Check_Root  with null record;
+  type Fin_Check is  new C761006_1.Fin_Check_Root  with null record;
+
+end C761006_2;
+
+------------------------------------------------------------------- C761006_0
+
+with Report;
+with C761006_Support;
+package body C761006_0 is
+
+  package Sup renames C761006_Support;
+
+  procedure Initialize( It: in out Good ) is
+  begin
+    Sup.Events_Occurring( Sup.Good_Initialize ) := True;
+    It.Initialized := True;
+  end Initialize;
+
+  procedure Adjust    ( It: in out Good ) is
+  begin
+    Sup.Events_Occurring( Sup.Good_Adjust ) := True;
+    It.Adjusted := True;
+    It.Unique := C761006_Support.Unique_Value;
+  end Adjust;
+
+  procedure Finalize  ( It: in out Good ) is
+  begin
+    Sup.Events_Occurring( Sup.Good_Finalize ) := True;
+  end Finalize;
+
+  procedure Initialize( It: in out Bad_Initialize ) is
+  begin
+    Sup.Raise_Propagating_Exception(Report.Ident_Bool(True));
+  end Initialize;
+
+  procedure Adjust( It: in out Bad_Adjust ) is
+  begin
+    Sup.Raise_Propagating_Exception(Report.Ident_Bool(True));
+  end Adjust;
+
+  procedure Finalize( It: in out Bad_Finalize ) is
+  begin
+    Sup.Raise_Propagating_Exception(Report.Ident_Bool(True));
+  end Finalize;
+
+end C761006_0;
+
+--------------------------------------------------------------------- C761006
+
+with Report;
+with C761006_0;
+with C761006_2;
+with C761006_Support;
+with Ada.Exceptions;
+with Ada.Finalization;
+with Unchecked_Deallocation;
+procedure C761006 is
+
+  package Sup renames C761006_Support;
+  use type Sup.Event_Array;
+
+  type Procedure_Handle is access procedure;
+
+  type Test_ID is ( Simple, Initialize, Adjust, Finalize );
+
+  Sub_Tests : array(Test_ID) of Procedure_Handle;
+
+  procedure Simple_Test is
+    A_Good_Object : C761006_0.Good; -- should call Initialize
+  begin
+    if not A_Good_Object.Initialized then
+      Report.Failed("Good object not initialized");
+    end if;
+
+    -- should call Adjust
+    A_Good_Object := ( Ada.Finalization.Controlled
+                       with Unique => 0, others => False );
+    if not A_Good_Object.Adjusted then
+      Report.Failed("Good object not adjusted");
+    end if;
+
+    -- should call Finalize before end of scope
+  end Simple_Test;
+
+  procedure Initialize_Test is
+  begin
+    declare
+      This_Object_Fails_In_Initialize : C761006_2.Init_Check;
+    begin
+      Report.Failed("Exception in Initialize did not occur");
+    exception
+      when others =>
+        Report.Failed("Initialize caused exception at wrong lex");
+    end;
+
+    Report.Failed("Error in execution sequence");
+
+  exception
+    when Sup.Propagating_Exception => -- this is correct
+      if not Sup.Events_Occurring(Sup.Good_Initialize) then
+        Report.Failed("Initialization of Good Component did not occur");
+      end if;
+  end Initialize_Test;
+
+  procedure Adjust_Test is
+    This_Object_OK     : C761006_2.Adj_Check;
+    This_Object_Target : C761006_2.Adj_Check;
+  begin
+
+    Check_Adjust_Due_To_Assignment: begin
+      This_Object_Target := This_Object_OK;
+      Report.Failed("Adjust did not propagate any exception");
+    exception
+      when Program_Error =>  -- expected case
+             if not This_Object_Target.Good_Component.Adjusted then
+               Report.Failed("other adjustment not performed");
+             end if;
+      when others =>
+             Report.Failed("Adjust propagated wrong exception");
+    end Check_Adjust_Due_To_Assignment;
+
+    C761006_Support.Events_Occurring := (True, False, False);
+
+    Check_Adjust_Due_To_Initial_Assignment: declare
+      Another_Target : C761006_2.Adj_Check := This_Object_OK;
+    begin
+      Report.Failed("Adjust did not propagate any exception");
+    exception
+      when others => Report.Failed("Adjust caused exception at wrong lex");
+    end Check_Adjust_Due_To_Initial_Assignment;
+
+  exception
+    when Program_Error =>  -- expected case
+           if Sup.Events_Occurring(Sup.Good_Finalize) /=
+              Sup.Events_Occurring(Sup.Good_Adjust) then
+              -- RM 7.6.1(16/1) says that the good Adjust may or may not
+              -- be performed; but if it is, then the Finalize must be
+              -- performed; and if it is not, then the Finalize must not
+              -- performed.
+              if Sup.Events_Occurring(Sup.Good_Finalize) then
+                 Report.Failed("Good adjust not performed with bad adjust, " &
+                               "but good finalize was");
+              else
+                 Report.Failed("Good adjust performed with bad adjust, " &
+                               "but good finalize was not");
+              end if;
+           end if;
+    when others =>
+           Report.Failed("Adjust propagated wrong exception");
+  end Adjust_Test;
+
+  procedure Finalize_Test is
+
+    Fin_Not_Perf : constant String := "other finalizations not performed";
+
+    procedure Finalize_15 is
+      Item   : C761006_2.Fin_Check;
+      Target : C761006_2.Fin_Check;
+    begin
+
+      Item := Target;
+      -- finalization of Item should cause PE
+      -- ARM7.6:21 allows the implementation to omit the assignment of the
+      -- value into an anonymous object, which is the point at which Adjust
+      -- is normally called.  However, this would result in Program_Error's
+      -- being raised before the call to Adjust, with the consequence that
+      -- Adjust is never called.
+
+    exception
+      when Program_Error => -- expected case
+             if not Sup.Events_Occurring(Sup.Good_Finalize) then
+               Report.Failed("Assignment: " & Fin_Not_Perf);
+             end if;
+      when others =>
+             Report.Failed("Other exception in Finalize_15");
+
+    -- finalization of Item/Target should cause PE
+    end Finalize_15;
+
+  -- check failure in finalize due to Unchecked_Deallocation
+
+  type Shark is access C761006_2.Fin_Check;
+
+  procedure Catch is
+    new Unchecked_Deallocation( C761006_2.Fin_Check, Shark );
+
+  procedure Finalize_17 is
+    White : Shark := new C761006_2.Fin_Check;
+  begin
+    Catch( White );
+  exception
+    when Program_Error =>
+           if not Sup.Events_Occurring(Sup.Good_Finalize) then
+             Report.Failed("Unchecked_Deallocation: " & Fin_Not_Perf);
+           end if;
+  end Finalize_17;
+
+  begin
+
+    Exception_In_Finalization: begin
+      Finalize_15;
+    exception
+      when Program_Error => null; -- anticipated
+    end Exception_In_Finalization;
+
+    Use_Of_Unchecked_Deallocation: begin
+      Finalize_17;
+    exception
+      when others =>
+        Report.Failed("Unchecked_Deallocation check, unwanted exception");
+    end Use_Of_Unchecked_Deallocation;
+
+  end Finalize_Test;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C761006", "Check that exceptions raised in Initialize, " &
+                          "Adjust and Finalize are processed correctly" );
+
+  Sub_Tests := (Simple_Test'Access, Initialize_Test'Access,
+                Adjust_Test'Access, Finalize_Test'Access);
+
+  for Test in Sub_Tests'Range loop
+    begin
+
+      Sup.Events_Occurring := (others => False);
+
+      Sub_Tests(Test).all;
+
+      case Test is
+        when Simple | Adjust =>
+          if Sup.Events_Occurring /= Sup.Event_Array ' ( others => True ) then
+            Report.Failed ( "Other operation missing in " &
+                            Test_ID'Image ( Test ) );
+          end if;
+        when  Initialize =>
+          null;
+        when Finalize  =>
+          -- Note that for Good_Adjust, we may get either True or False
+          if Sup.Events_Occurring ( Sup.Good_Initialize ) = False or
+             Sup.Events_Occurring ( Sup.Good_Finalize ) = False
+          then
+            Report.Failed ( "Other operation missing in " &
+                            Test_ID'Image ( Test ) );
+          end if;
+      end case;
+
+    exception
+       when How: others => Report.Failed( Ada.Exceptions.Exception_Name( How )
+                                        & " from " & Test_ID'Image( Test ) );
+    end;
+  end loop;
+
+  Report.Result;
+
+end C761006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761007.a
new file mode 100644
index 000000000..7b3dbfb9b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761007.a
@@ -0,0 +1,419 @@
+-- C761007.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 finalize procedure invoked by a transfer of control
+--      due to selection of a terminate alternative attempts to propagate an
+--      exception, the exception is ignored, but any other finalizations due
+--      to be performed are performed.
+--
+--
+-- TEST DESCRIPTION:
+--      This test declares a nested controlled data type, and embeds an object
+--      of that type within a protected type.  Objects of the protected type
+--      are created and destroyed, and the actions of the embedded controlled
+--      object are checked.  The container controlled type causes an exception
+--      as the last part of it's finalization operation.
+--
+--      This test utilizes several tasks to accomplish the objective.  The
+--      tasks contain delays to ensure that the expected order of processing
+--      is indeed accomplished.
+--
+--      Subtest 1:
+--        local task object runs to normal completion
+--
+--      Subtest 2:
+--        local task aborts a nested task to cause finalization
+--
+--      Subtest 3: 
+--        local task sleeps long enough to allow procedure started
+--        asynchronously to go into infinite loop.  Procedure is then aborted
+--        via ATC, causing finalization of objects.
+--
+--      Subtest 4:
+--        local task object takes terminate alternative, causing finalization
+--
+--
+-- CHANGE HISTORY:
+--      06 JUN 95   SAIC    Initial version
+--      05 APR 96   SAIC    Documentation changes
+--      03 MAR 97   PWB.CTA Allowed two finalization orders for ATC test
+--      02 DEC 97   EDS     Remove duplicate characters from check string.
+--!
+
+---------------------------------------------------------------- C761007_0
+
+with Ada.Finalization;
+package C761007_0 is
+
+  type Internal is new Ada.Finalization.Controlled
+    with record
+      Effect : Character;
+    end record;
+
+  procedure Finalize( I: in out Internal );
+
+  Side_Effect : String(1..80);  -- way bigger than needed
+  Side_Effect_Finger : Natural := 0;
+
+end C761007_0;
+ 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+package body C761007_0 is
+
+  procedure Finalize( I : in out Internal ) is
+    Previous_Side_Effect : Boolean := False;
+  begin
+    -- look to see if this character has been finalized yet
+    for SEI in 1..Side_Effect_Finger loop
+      Previous_Side_Effect := Previous_Side_Effect
+                              or Side_Effect(Side_Effect_Finger) = I.Effect;
+    end loop;
+
+    -- if not, then tack it on to the string, and touch the character
+    if not Previous_Side_Effect then
+      Side_Effect_Finger := Side_Effect_Finger +1;
+      Side_Effect(Side_Effect_Finger) := I.Effect;
+      TCTouch.Touch(I.Effect);
+    end if;
+
+  end Finalize;
+
+end C761007_0;
+
+---------------------------------------------------------------- C761007_1
+
+with C761007_0;
+with Ada.Finalization;
+package C761007_1 is
+
+  type Container is new Ada.Finalization.Controlled
+    with record
+      Effect   : Character;
+      Content  : C761007_0.Internal;
+    end record;
+
+  procedure Finalize( C: in out Container );
+
+  Side_Effect : String(1..80);  -- way bigger than needed
+  Side_Effect_Finger : Natural := 0;
+
+  This_Exception_Is_Supposed_To_Be_Ignored : exception;
+
+end C761007_1;
+ 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+package body C761007_1 is
+
+  procedure Finalize( C: in out Container ) is
+    Previous_Side_Effect : Boolean := False;
+  begin
+    -- look to see if this character has been finalized yet
+    for SEI in 1..Side_Effect_Finger loop
+      Previous_Side_Effect := Previous_Side_Effect
+                              or Side_Effect(Side_Effect_Finger) = C.Effect;
+    end loop;
+
+    -- if not, then tack it on to the string, and touch the character
+    if not Previous_Side_Effect then
+      Side_Effect_Finger := Side_Effect_Finger +1;
+      Side_Effect(Side_Effect_Finger) := C.Effect;
+      TCTouch.Touch(C.Effect);
+    end if;
+
+    raise This_Exception_Is_Supposed_To_Be_Ignored;
+
+  end Finalize;
+
+end C761007_1;
+ 
+---------------------------------------------------------------- C761007_2
+with C761007_1;
+package C761007_2 is
+
+  protected type Prot_W_Fin_Obj is
+    procedure Set_Effects( Container, Filling: Character );
+  private
+    The_Data_Under_Test : C761007_1.Container;
+    -- finalization for this will occur when the Prot_W_Fin_Obj object
+    --  "goes out of existence" for whatever reason.
+  end Prot_W_Fin_Obj;
+
+end C761007_2;
+ 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body C761007_2 is
+
+  protected body Prot_W_Fin_Obj is
+    procedure Set_Effects( Container, Filling: Character ) is
+    begin
+      The_Data_Under_Test.Effect := Container;           -- A, etc.
+      The_Data_Under_Test.Content.Effect := Filling;     -- B, etc.
+    end Set_Effects;
+  end Prot_W_Fin_Obj;
+
+end C761007_2;
+
+------------------------------------------------------------------ C761007
+
+with Report;
+with Impdef;
+with TCTouch;
+with C761007_0;
+with C761007_1;
+with C761007_2;
+procedure C761007 is
+
+  task type Subtests( Outer, Inner : Character) is
+    entry Ready;
+    entry Complete;
+  end Subtests;
+
+  task body Subtests is
+    Local_Prot_W_Fin_Obj : C761007_2.Prot_W_Fin_Obj;
+  begin
+    Local_Prot_W_Fin_Obj.Set_Effects( Outer, Inner );
+
+    accept Ready;
+
+    select
+      accept Complete;
+    or terminate;       -- used in Subtest 4
+    end select;
+  exception
+    -- the exception caused by the finalization of Local_Prot_W_Fin_Obj
+    --  should never be visible to this scope.
+    when others => Report.Failed("Exception in a Subtest object "
+                                 & Outer & Inner);
+  end Subtests;
+
+  procedure Subtest_1 is
+    -- check the case where "nothing special" happens.
+
+    This_Subtest : Subtests( 'A', 'B' );
+  begin
+
+    This_Subtest.Ready;
+    This_Subtest.Complete;
+
+    while not This_Subtest'Terminated loop -- wait for finalization
+      delay Impdef.Clear_Ready_Queue;
+    end loop;
+
+    -- in the finalization of This_Subtest, the controlled object embedded in
+    -- the Prot_W_Fin_Obj will finalize.  An exception is raised in the
+    -- container object, after "touching" it's tag character.
+    -- The finalization of the contained controlled object must be performed.
+
+
+    TCTouch.Validate( "AB", "Item embedded in task" );
+
+
+  exception
+    when others => Report.Failed("Undesirable exception in Subtest_1");
+
+  end Subtest_1;
+
+  procedure Subtest_2 is
+    -- check for explicit abort
+
+    task Subtest_Task is
+      entry Complete;
+    end Subtest_Task;
+
+    task body Subtest_Task is
+
+      task Nesting;
+      task body Nesting is
+        Deep_Nesting : Subtests( 'E', 'F' );
+      begin
+        if Report.Ident_Bool( True ) then
+          -- controlled objects have been created in the elaboration of
+          -- Deep_Nesting.  Deep_Nesting must call the Set_Effects operation
+          -- in the Prot_W_Fin_Obj, and then hang waiting for the Complete
+          -- entry call.
+          Deep_Nesting.Ready;
+          abort Deep_Nesting;
+        else
+          Report.Failed("Dead code in Nesting");
+        end if;
+      exception
+        when others => Report.Failed("Exception in Subtest_Task.Nesting");
+      end Nesting;
+
+      Local_2 : C761007_2.Prot_W_Fin_Obj;
+
+    begin
+      -- Nesting has activated at this point, which implies the activation
+      -- of Deep_Nesting as well.
+
+      Local_2.Set_Effects( 'C', 'D' );
+
+      -- wait for Nesting to terminate
+
+      while not Nesting'Terminated loop
+        delay Impdef.Clear_Ready_Queue;
+      end loop;
+
+      accept Complete;
+
+    exception
+      when others => Report.Failed("Exception in Subtest_Task");
+    end Subtest_Task;
+
+  begin
+
+    -- wait for everything in Subtest_Task to happen
+    Subtest_Task.Complete;
+
+    while not Subtest_Task'Terminated loop -- wait for finalization
+      delay Impdef.Clear_Ready_Queue;
+    end loop;
+
+    TCTouch.Validate( "EFCD", "Aborted nested task" );
+
+  exception
+    when others => Report.Failed("Undesirable exception in Subtest_2");
+  end Subtest_2;
+
+  procedure Subtest_3 is
+    -- check abort caused by asynchronous transfer of control
+
+    task Subtest_3_Task is
+      entry Complete;
+    end Subtest_3_Task;
+
+    procedure Check_Atc_Operation is
+      Check_Atc : C761007_2.Prot_W_Fin_Obj;
+    begin
+
+      Check_Atc.Set_Effects( 'G', 'H' );
+
+
+      while Report.Ident_Bool( True ) loop -- wait to be aborted
+        if Report.Ident_Bool( True ) then
+          Impdef.Exceed_Time_Slice;
+          delay Impdef.Switch_To_New_Task;
+        else
+          Report.Failed("Optimization prevention");
+        end if;
+      end loop;
+
+      Report.Failed("Check_Atc_Operation loop completed");
+
+    end Check_Atc_Operation;
+
+    task body Subtest_3_Task is
+      task Nesting is
+        entry Complete;
+      end Nesting;
+
+      task body Nesting is
+        Nesting_3 : C761007_2.Prot_W_Fin_Obj;
+      begin
+        Nesting_3.Set_Effects( 'G', 'H' );
+
+        -- give Check_Atc_Operation sufficient time to perform it's
+        -- Set_Effects on it's local Prot_W_Fin_Obj object
+        delay Impdef.Clear_Ready_Queue;
+
+        accept Complete;
+      exception
+        when others => Report.Failed("Exception in Subtest_3_Task.Nesting");
+      end Nesting;
+
+      Local_3 : C761007_2.Prot_W_Fin_Obj;
+
+    begin -- Subtest_3_Task
+
+      Local_3.Set_Effects( 'I', 'J' );
+
+      select
+        Nesting.Complete;
+      then abort ---------------------------------------------------- cause KL
+        Check_ATC_Operation;
+      end select;
+
+      accept Complete;
+
+    exception
+      when others => Report.Failed("Exception in Subtest_3_Task");
+    end Subtest_3_Task;
+
+  begin -- Subtest_3
+    Subtest_3_Task.Complete;
+
+    while not Subtest_3_Task'Terminated loop -- wait for finalization
+      delay Impdef.Clear_Ready_Queue;
+    end loop;
+
+    TCTouch.Validate( "GHIJ", "Asynchronously aborted operation" );
+
+  exception
+    when others => Report.Failed("Undesirable exception in Subtest_3");
+  end Subtest_3;
+
+  procedure Subtest_4 is
+    -- check the case where transfer is caused by terminate alternative
+    -- highly similar to Subtest_1
+
+    This_Subtest : Subtests( 'M', 'N' );
+  begin
+
+    This_Subtest.Ready;
+    -- don't call This_Subtest.Complete;
+
+  exception
+    when others => Report.Failed("Undesirable exception in Subtest_4");
+
+  end Subtest_4;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C761007", "Check that if a finalize procedure invoked by " &
+                          "a transfer of control or selection of a " &
+                          "terminate alternative attempts to propagate " &
+                          "an exception, the exception is ignored, but " &
+                          "any other finalizations due to be performed " &
+                          "are performed" );
+
+  Subtest_1;  -- checks internal
+
+  Subtest_2;  -- checks internal
+
+  Subtest_3;  -- checks internal
+
+  Subtest_4;
+  TCTouch.Validate( "MN", "transfer due to terminate alternative" );
+
+  Report.Result;
+
+end C761007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761010.a
new file mode 100644
index 000000000..7784c6da5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761010.a
@@ -0,0 +1,447 @@
+-- C761010.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 WHATSOVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE
+--     Check the requirements of the new 7.6(17.1/1) from Technical
+--     Corrigendum 1 (originally discussed as AI95-00083).
+--     This new paragraph requires that the initialization of an object with
+--     an aggregate does not involve calls to Adjust.
+--
+-- TEST DESCRIPTION
+--     We include several cases of initialization:
+--        - Explicit initialization of an object declared by an
+--          object declaration.
+--        - Explicit initialization of a heap object.
+--        - Default initialization of a record component.
+--        - Initialization of a formal parameter during a call.
+--        - Initialization of a formal parameter during a call with
+--          a defaulted parameter.
+--        - Lots of nested records, arrays, and pointers.
+--     In this test, Initialize should never be called, because we
+--     never declare a default-initialized controlled object (although
+--     we do declare default-initialized records containing controlled
+--     objects, with default expressions for the components).
+--     Adjust should never be called, because every initialization
+--     is via an aggregate.  Finalize is called, because the objects
+--     themselves need to be finalized.
+--     Thus, Initialize and Adjust call Failed.
+--     In some of the cases, these procedures will not yet be elaborated,
+--     anyway.
+--
+-- CHANGE HISTORY:
+--      29 JUN 1999   RAD   Initial Version
+--      23 SEP 1999   RLB   Improved comments, renamed, issued.
+--      10 APR 2000   RLB   Corrected errors in comments and text, fixed
+--                          discriminant error. Fixed so that Report.Test
+--                          is called before any Report.Failed call. Added
+--                          a marker so that the failed subtest can be
+--                          determined.
+--      26 APR 2000   RAD   Try to defeat optimizations.
+--      04 AUG 2000   RLB   Corrected error in Check_Equal.
+--      18 AUG 2000   RLB   Removed dubious main subprogram renames (see AI-172).
+--      19 JUL 2002   RLB   Fixed to avoid calling comment after Report.Result.
+--
+--!
+
+with Ada; use Ada;
+with Report; use Report; pragma Elaborate_All(Report);
+with Ada.Finalization;
+package C761010_1 is
+    pragma Elaborate_Body;
+    function Square(X: Integer) return Integer;
+private
+    type TC_Control is new Ada.Finalization.Limited_Controlled with null record;
+    procedure Initialize (Object : in out TC_Control);
+    procedure Finalize (Object : in out TC_Control);
+    TC_Finalize_Called : Boolean := False;
+end C761010_1;
+
+package body C761010_1 is
+    function Square(X: Integer) return Integer is
+    begin
+        return X**2;
+    end Square;
+
+    procedure Initialize (Object : in out TC_Control) is
+    begin
+        Test("C761010_1",
+             "Check that Adjust is not called"
+              & " when aggregates are used to initialize objects");
+    end Initialize;
+
+    procedure Finalize (Object : in out TC_Control) is
+    begin
+        if not TC_Finalize_Called then
+            Failed("Var_Strings Finalize never called");
+        end if;
+        Result;
+    end Finalize;
+
+    TC_Test : TC_Control; -- Starts test; finalization ends test.
+end C761010_1;
+
+with Ada.Finalization;
+package C761010_1.Var_Strings is
+    type Var_String(<>) is private;
+
+    Some_String: constant Var_String;
+
+    function "=" (X, Y: Var_String) return Boolean;
+
+    procedure Check_Equal(X, Y: Var_String);
+        -- Calls to this are used to defeat optimizations
+        -- that might otherwise defeat the purpose of the
+        -- test.  I'm talking about the optimization of removing
+        -- unused controlled objects.
+
+private
+
+    type String_Ptr is access constant String;
+
+    type Var_String(Length: Natural) is new Finalization.Controlled with
+        record
+            Comp_1: String_Ptr := new String'(2..Square(Length)-1 => 'x');
+            Comp_2: String_Ptr(1..Length) := null;
+            Comp_3: String(Length..Length) := (others => '.');
+            TC_Lab: Character := '1';
+        end record;
+    procedure Initialize(X: in out Var_String);
+    procedure Adjust(X: in out Var_String);
+    procedure Finalize(X: in out Var_String);
+
+    Some_String: constant Var_String
+      := (Finalization.Controlled with Length => 1,
+          Comp_1 => null,
+          Comp_2 => null,
+          Comp_3 => "x",
+          TC_Lab => 'A');
+
+    Another_String: constant Var_String
+      := (Finalization.Controlled with Length => 10,
+          Comp_1 => Some_String.Comp_2,
+          Comp_2 => new String'("1234567890"),
+          Comp_3 => "x",
+          TC_Lab => 'B');
+
+end C761010_1.Var_Strings;
+
+package C761010_1.Var_Strings.Types is
+
+    type Ptr is access all Var_String;
+    Ptr_Const: constant Ptr;
+
+    type Ptr_Arr is array(Positive range <>) of Ptr;
+    Ptr_Arr_Const: constant Ptr_Arr;
+
+    type Ptr_Rec(N_Strings: Natural) is
+        record
+            Ptrs: Ptr_Arr(1..N_Strings);
+        end record;
+    Ptr_Rec_Const: constant Ptr_Rec;
+
+private
+
+    Ptr_Const: constant Ptr := new Var_String'
+      (Finalization.Controlled with
+       Length => 1,
+       Comp_1 => null,
+       Comp_2 => null,
+       Comp_3 => (others => ' '),
+       TC_Lab => 'C');
+
+    Ptr_Arr_Const: constant Ptr_Arr :=
+      (1 => new Var_String'
+       (Finalization.Controlled with
+        Length => 1,
+        Comp_1 => new String'("abcdefghij"),
+        Comp_2 => null,
+        Comp_3 => (2..2 => ' '),
+        TC_Lab => 'D'));
+
+    Ptr_Rec_Var: Ptr_Rec :=
+      (3,
+       (1..2 => null,
+        3 => new Var_String'
+        (Finalization.Controlled with
+         Length => 2,
+         Comp_1 => new String'("abcdefghij"),
+         Comp_2 => null,
+         Comp_3 => (2..2 => ' '),
+         TC_Lab => 'E')));
+
+    Ptr_Rec_Const: constant Ptr_Rec :=
+      (3,
+       (1..2 => null,
+        3 => new Var_String'
+        (Finalization.Controlled with
+         Length => 2,
+         Comp_1 => new String'("abcdefghij"),
+         Comp_2 => null,
+         Comp_3 => (2..2 => ' '),
+         TC_Lab => 'F')));
+
+    type Arr is array(Positive range <>) of Var_String(Length => 2);
+
+    Arr_Var: Arr :=
+      (1 => (Finalization.Controlled with
+         Length => 2,
+         Comp_1 => new String'("abcdefghij"),
+         Comp_2 => null,
+         Comp_3 => (2..2 => ' '),
+         TC_Lab => 'G'));
+
+    type Rec(N_Strings: Natural) is
+        record
+            Ptrs: Ptr_Rec(N_Strings);
+            Strings: Arr(1..N_Strings) :=
+              (others =>
+                 (Finalization.Controlled with
+                  Length => 2,
+                  Comp_1 => new String'("abcdefghij"),
+                  Comp_2 => null,
+                  Comp_3 => (2..2 => ' '),
+                  TC_Lab => 'H'));
+        end record;
+
+    Default_Init_Rec_Var: Rec(N_Strings => 10);
+    Empty_Default_Init_Rec_Var: Rec(N_Strings => 0);
+
+    Rec_Var: Rec(N_Strings => 2) :=
+      (N_Strings => 2,
+       Ptrs =>
+         (2,
+          (1..1 => null,
+           2 => new Var_String'
+           (Finalization.Controlled with
+            Length => 2,
+            Comp_1 => new String'("abcdefghij"),
+            Comp_2 => null,
+            Comp_3 => (2..2 => ' '),
+            TC_Lab => 'J'))),
+       Strings =>
+         (1 =>
+            (Finalization.Controlled with
+             Length => 2,
+             Comp_1 => new String'("abcdefghij"),
+             Comp_2 => null,
+             Comp_3 => (2..2 => ' '),
+             TC_Lab => 'K'),
+          others =>
+            (Finalization.Controlled with
+             Length => 2,
+             Comp_1 => new String'("abcdefghij"),
+             Comp_2 => null,
+             Comp_3 => (2..2 => ' '),
+             TC_Lab => 'L')));
+
+    procedure Check_Equal(X, Y: Rec);
+
+end C761010_1.Var_Strings.Types;
+
+package body C761010_1.Var_Strings.Types is
+
+    -- Check that parameter passing doesn't create new objects,
+    -- and therefore doesn't need extra Adjusts or Finalizes.
+
+    procedure Check_Equal(X, Y: Rec) is
+        -- We assume that the arguments should be equal.
+        -- But we cannot assume that pointer values are the same.
+    begin
+        if X.N_Strings /= Y.N_Strings then
+            Failed("Records should be equal (1)");
+        else
+            for I in 1 .. X.N_Strings loop
+                if X.Ptrs.Ptrs(I) /= Y.Ptrs.Ptrs(I) then
+                    if X.Ptrs.Ptrs(I) = null or else
+                       Y.Ptrs.Ptrs(I) = null or else
+                       X.Ptrs.Ptrs(I).all /= Y.Ptrs.Ptrs(I).all then
+                       Failed("Records should be equal (2)");
+                    end if;
+                end if;
+                if X.Strings(I) /= Y.Strings(I) then
+                    Failed("Records should be equal (3)");
+                end if;
+            end loop;
+        end if;
+    end Check_Equal;
+
+    procedure My_Check_Equal
+              (X: Rec := Rec_Var;
+               Y: Rec :=
+      (N_Strings => 2,
+       Ptrs =>
+         (2,
+          (1..1 => null,
+           2 => new Var_String'
+           (Finalization.Controlled with
+            Length => 2,
+            Comp_1 => new String'("abcdefghij"),
+            Comp_2 => null,
+            Comp_3 => (2..2 => ' '),
+            TC_Lab => 'M'))),
+       Strings =>
+         (1 =>
+            (Finalization.Controlled with
+             Length => 2,
+             Comp_1 => new String'("abcdefghij"),
+             Comp_2 => null,
+             Comp_3 => (2..2 => ' '),
+             TC_Lab => 'N'),
+          others =>
+            (Finalization.Controlled with
+             Length => 2,
+             Comp_1 => new String'("abcdefghij"),
+             Comp_2 => null,
+             Comp_3 => (2..2 => ' '),
+             TC_Lab => 'O'))))
+              renames Check_Equal;
+begin
+
+    My_Check_Equal;
+
+    Check_Equal(Rec_Var,
+      (N_Strings => 2,
+       Ptrs =>
+         (2,
+          (1..1 => null,
+           2 => new Var_String'
+           (Finalization.Controlled with
+            Length => 2,
+            Comp_1 => new String'("abcdefghij"),
+            Comp_2 => null,
+            Comp_3 => (2..2 => ' '),
+            TC_Lab => 'P'))),
+       Strings =>
+         (1 =>
+            (Finalization.Controlled with
+             Length => 2,
+             Comp_1 => new String'("abcdefghij"),
+             Comp_2 => null,
+             Comp_3 => (2..2 => ' '),
+             TC_Lab => 'Q'),
+          others =>
+            (Finalization.Controlled with
+             Length => 2,
+             Comp_1 => new String'("abcdefghij"),
+             Comp_2 => null,
+             Comp_3 => (2..2 => ' '),
+             TC_Lab => 'R'))));
+
+    -- Use the objects to avoid optimizations.
+
+    Check_Equal(Ptr_Const.all, Ptr_Const.all);
+    Check_Equal(Ptr_Arr_Const(1).all, Ptr_Arr_Const(1).all);
+    Check_Equal(Ptr_Rec_Const.Ptrs(Ptr_Rec_Const.N_Strings).all,
+                Ptr_Rec_Const.Ptrs(Ptr_Rec_Const.N_Strings).all);
+    Check_Equal(Ptr_Rec_Var.Ptrs(Ptr_Rec_Var.N_Strings).all,
+                Ptr_Rec_Var.Ptrs(Ptr_Rec_Var.N_Strings).all);
+
+    if Report.Equal (3, 2) then
+       -- Can't get here.
+       Check_Equal (Arr_Var(1), Default_Init_Rec_Var.Strings(1));
+       Check_Equal (Arr_Var(1), Empty_Default_Init_Rec_Var.Strings(1));
+    end if;
+
+end C761010_1.Var_Strings.Types;
+
+with C761010_1.Var_Strings;
+with C761010_1.Var_Strings.Types;
+procedure C761010_1.Main is
+begin
+    -- Report.Test is called by the elaboration of C761010_1, and
+    -- Report.Result is called by the finalization of C761010_1.
+    -- This will happen before any objects are created, and after any
+    -- are finalized.
+    null;
+end C761010_1.Main;
+
+with C761010_1.Main;
+procedure C761010 is
+begin
+    C761010_1.Main;
+end C761010;
+
+package body C761010_1.Var_Strings is
+
+    Some_Error: exception;
+
+    procedure Initialize(X: in out Var_String) is
+    begin
+        Failed("Initialize should never be called");
+        raise Some_Error;
+    end Initialize;
+
+    procedure Adjust(X: in out Var_String) is
+    begin
+        Failed("Adjust should never be called - case " & X.TC_Lab);
+        raise Some_Error;
+    end Adjust;
+
+    procedure Finalize(X: in out Var_String) is
+    begin
+        Comment("Finalize called - case " & X.TC_Lab);
+	C761010_1.TC_Finalize_Called := True;
+    end Finalize;
+
+    function "=" (X, Y: Var_String) return Boolean is
+        -- Don't check the TC_Lab component, but do check the contents of the
+	-- access values.
+    begin
+        if X.Length /= Y.Length then
+            return False;
+        end if;
+        if X.Comp_3 /= Y.Comp_3 then
+            return False;
+        end if;
+        if X.Comp_1 /= Y.Comp_1 then
+            -- Still OK if the values are the same.
+            if X.Comp_1 = null or else
+               Y.Comp_1 = null or else
+               X.Comp_1.all /= Y.Comp_1.all then
+               return False;
+            --else OK.
+            end if;
+        end if;
+        if X.Comp_2 /= Y.Comp_2 then
+            -- Still OK if the values are the same.
+            if X.Comp_2 = null or else
+               Y.Comp_2 = null or else
+               X.Comp_2.all /= Y.Comp_2.all then
+               return False;
+            end if;
+        end if;
+        return True;
+    end "=";
+
+    procedure Check_Equal(X, Y: Var_String) is
+    begin
+        if X /= Y then
+            Failed("Check_Equal of Var_String");
+        end if;
+    end Check_Equal;
+
+begin
+    Check_Equal(Another_String, Another_String);
+end C761010_1.Var_Strings;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761011.a
new file mode 100644
index 000000000..1d447c755
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761011.a
@@ -0,0 +1,410 @@
+-- C761011.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that if a Finalize propagates an exception, other Finalizes due
+--    to be performed are performed.
+--        Case 1: A Finalize invoked due to the end of execution of
+--        a master. (Defect Report 8652/0023, as reflected in Technical
+--        Corrigendum 1).
+--        Case 2: A Finalize invoked due to finalization of an anonymous
+--        object. (Defect Report 8652/0023, as reflected in Technical
+--        Corrigendum 1).
+--        Case 3: A Finalize invoked due to the transfer of control
+--        due to an exit statement.
+--        Case 4: A Finalize invoked due to the transfer of control
+--        due to a goto statement.
+--        Case 5: A Finalize invoked due to the transfer of control
+--        due to a return statement.
+--        Case 6: A Finalize invoked due to the transfer of control
+--        due to raises an exception.
+--
+--
+-- CHANGE HISTORY:
+--    29 JAN 2001   PHL   Initial version
+--    15 MAR 2001   RLB   Readied for release; added optimization blockers.
+--                        Added test cases for paragraphs 18 and 19 of the
+--                        standard (the previous tests were withdrawn).
+--
+--!
+with Ada.Finalization;
+use Ada.Finalization;
+package C761011_0 is
+
+    type Ctrl (D : Boolean) is new Ada.Finalization.Controlled with
+        record
+            Finalized : Boolean := False;
+            case D is
+                when False =>
+                    C1 : Integer;
+                when True =>
+                    C2 : Float;
+            end case;
+        end record;
+
+    function Create (Id : Integer) return Ctrl;
+    procedure Finalize (Obj : in out Ctrl);
+    function Was_Finalized (Id : Integer) return Boolean;
+    procedure Use_It (Obj : in Ctrl);
+       -- Use Obj to prevent optimization.
+
+end C761011_0;
+
+with Report;
+use Report;
+package body C761011_0 is
+
+    User_Error : exception;
+
+    Finalize_Called : array (0 .. 50) of Boolean := (others => False);
+
+    function Create (Id : Integer) return Ctrl is
+        Obj : Ctrl (Boolean'Val (Id mod Ident_Int (2)));
+    begin
+        case Obj.D is
+            when False =>
+                Obj.C1 := Ident_Int (Id);
+            when True =>
+                Obj.C2 := Float (Ident_Int (Id + Ident_Int (Id)));
+        end case;
+        return Obj;
+    end Create;
+
+    procedure Finalize (Obj : in out Ctrl) is
+    begin
+        if not Obj.Finalized then
+            Obj.Finalized := True;
+            if Obj.D then
+                if Integer (Obj.C2 / 2.0) mod Ident_Int (10) =
+                   Ident_Int (3) then
+                    raise User_Error;
+                else
+                    Finalize_Called (Integer (Obj.C2) / 2) := True;
+                end if;
+            else
+                if Obj.C1 mod Ident_Int (10) = Ident_Int (0) then
+                    raise Tasking_Error;
+                else
+                    Finalize_Called (Obj.C1) := True;
+                end if;
+            end if;
+        end if;
+    end Finalize;
+
+    function Was_Finalized (Id : Integer) return Boolean is
+    begin
+        return Finalize_Called (Ident_Int (Id));
+    end Was_Finalized;
+
+    procedure Use_It (Obj : in Ctrl) is
+       -- Use Obj to prevent optimization.
+    begin
+        case Obj.D is
+            when True =>
+                if not Equal (Boolean'Pos(Obj.Finalized),
+                              Boolean'Pos(Obj.Finalized)) then
+                    Failed ("Identity check - 1");
+                end if;
+            when False =>
+                if not Equal (Obj.C1, Obj.C1) then
+                    Failed ("Identity check - 2");
+                end if;
+        end case;
+    end Use_It;
+
+end C761011_0;
+
+with Ada.Exceptions;
+use Ada.Exceptions;
+with Ada.Finalization;
+with C761011_0;
+use C761011_0;
+with Report;
+use Report;
+procedure C761011 is
+begin
+    Test
+       ("C761011",
+        " Check that if a finalize propagates an exception, other finalizes " &
+         "due to be performed are performed");
+
+    Normal: -- Case 1
+        begin
+            declare
+                Obj1 : Ctrl := Create (Ident_Int (1));
+                Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
+                                         D => False,
+                                         Finalized => Ident_Bool (False),
+                                         C1 => Ident_Int (2));
+                Obj3 : Ctrl :=
+                   (Ada.Finalization.Controlled with
+                    D => True,
+                    Finalized => Ident_Bool (False),
+                    C2 => 2.0 * Float (Ident_Int
+                                          (3))); -- Finalization: User_Error
+                Obj4 : Ctrl := Create (Ident_Int (4));
+            begin
+                Comment ("Finalization of normal object");
+                Use_It (Obj1); -- Prevent optimization of Objects.
+                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                Use_It (Obj3);
+                Use_It (Obj4);
+            end;
+            Failed ("No exception raised by finalization of normal object");
+        exception
+            when Program_Error =>
+                if not Was_Finalized (Ident_Int (1)) or
+                   not Was_Finalized (Ident_Int (2)) or
+                   not Was_Finalized (Ident_Int (4)) then
+                    Failed ("Missing finalizations - 1");
+                end if;
+            when E: others =>
+                Failed ("Exception " & Exception_Name (E) &
+                        " raised - " & Exception_Message (E) & " - 1");
+        end Normal;
+
+    Anon: -- Case 2
+        begin
+            declare
+                Obj1 : Ctrl := (Ada.Finalization.Controlled with
+                                D => True,
+                                Finalized => Ident_Bool (False),
+                                C2 => 2.0 * Float (Ident_Int (5)));
+                Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
+                                         D => False,
+                                         Finalized => Ident_Bool (False),
+                                         C1 => Ident_Int (6));
+                Obj3 : Ctrl := (Ada.Finalization.Controlled with
+                                D => True,
+                                Finalized => Ident_Bool (False),
+                                C2 => 2.0 * Float (Ident_Int (7)));
+                Obj4 : Ctrl := Create (Ident_Int (8));
+            begin
+                Comment ("Finalization of anonymous object");
+
+                -- The finalization of the anonymous object below will raise
+                -- Tasking_Error.
+                if Create (Ident_Int (10)).C1 /= Ident_Int (10) then
+                    Failed ("Incorrect construction of an anonymous object");
+                end if;
+                Failed ("Anonymous object not finalized at the end of the " &
+                        "enclosing statement");
+                Use_It (Obj1); -- Prevent optimization of Objects.
+                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                Use_It (Obj3);
+                Use_It (Obj4);
+            end;
+            Failed ("No exception raised by finalization of an anonymous " &
+                    "object of a function");
+        exception
+            when Program_Error =>
+                if not Was_Finalized (Ident_Int (5)) or
+                   not Was_Finalized (Ident_Int (6)) or
+                   not Was_Finalized (Ident_Int (7)) or
+                   not Was_Finalized (Ident_Int (8)) then
+                    Failed ("Missing finalizations - 2");
+                end if;
+            when E: others =>
+                Failed ("Exception " & Exception_Name (E) &
+                        " raised - " & Exception_Message (E) & " - 2");
+        end Anon;
+
+    An_Exit: -- Case 3
+        begin
+            for Counter in 1 .. 4 loop
+                declare
+                    Obj1 : Ctrl := Create (Ident_Int (11));
+                    Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
+                                             D => False,
+                                             Finalized => Ident_Bool (False),
+                                             C1 => Ident_Int (12));
+                    Obj3 : Ctrl :=
+                        (Ada.Finalization.Controlled with
+                         D => True,
+                         Finalized => Ident_Bool (False),
+                         C2 => 2.0 * Float (
+                               Ident_Int(13))); -- Finalization: User_Error
+                    Obj4 : Ctrl := Create (Ident_Int (14));
+                begin
+                    Comment ("Finalization because of exit of loop");
+
+                    Use_It (Obj1); -- Prevent optimization of Objects.
+                    Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                    Use_It (Obj3);
+                    Use_It (Obj4);
+
+                    exit when not Ident_Bool (Obj2.D);
+
+                    Failed ("Exit not taken");
+                end;
+            end loop;
+            Failed ("No exception raised by finalization on exit");
+        exception
+            when Program_Error =>
+                if not Was_Finalized (Ident_Int (11)) or
+                   not Was_Finalized (Ident_Int (12)) or
+                   not Was_Finalized (Ident_Int (14)) then
+                    Failed ("Missing finalizations - 3");
+                end if;
+            when E: others =>
+                Failed ("Exception " & Exception_Name (E) &
+                        " raised - " & Exception_Message (E) & " - 3");
+        end An_Exit;
+
+    A_Goto: -- Case 4
+        begin
+            declare
+                Obj1 : Ctrl := Create (Ident_Int (15));
+                Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
+                                         D => False,
+                                         Finalized => Ident_Bool (False),
+                                         C1 => Ident_Int (0));
+                             -- Finalization: Tasking_Error
+                Obj3 : Ctrl := Create (Ident_Int (16));
+                Obj4 : Ctrl := (Ada.Finalization.Controlled with
+                                D => True,
+                                Finalized => Ident_Bool (False),
+                                C2 => 2.0 * Float (Ident_Int (17)));
+            begin
+                Comment ("Finalization because of goto statement");
+
+                Use_It (Obj1); -- Prevent optimization of Objects.
+                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                Use_It (Obj3);
+                Use_It (Obj4);
+
+                if Ident_Bool (Obj4.D) then
+                   goto Continue;
+                end if;
+
+                Failed ("Goto not taken");
+            end;
+         <<Continue>>
+            Failed ("No exception raised by finalization on goto");
+        exception
+            when Program_Error =>
+                if not Was_Finalized (Ident_Int (15)) or
+                   not Was_Finalized (Ident_Int (16)) or
+                   not Was_Finalized (Ident_Int (17)) then
+                    Failed ("Missing finalizations - 4");
+                end if;
+            when E: others =>
+                Failed ("Exception " & Exception_Name (E) &
+                        " raised - " & Exception_Message (E) & " - 4");
+        end A_Goto;
+
+    A_Return: -- Case 5
+        declare
+            procedure Do_Something is
+                Obj1 : Ctrl := Create (Ident_Int (18));
+                Obj2 : Ctrl := (Ada.Finalization.Controlled with
+                                D => True,
+                                Finalized => Ident_Bool (False),
+                                C2 => 2.0 * Float (Ident_Int (19)));
+                Obj3 : constant Ctrl := (Ada.Finalization.Controlled with
+                                         D => False,
+                                         Finalized => Ident_Bool (False),
+                                         C1 => Ident_Int (20));
+                             -- Finalization: Tasking_Error
+            begin
+                Comment ("Finalization because of return statement");
+
+                Use_It (Obj1); -- Prevent optimization of Objects.
+                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                Use_It (Obj3);
+
+                if not Ident_Bool (Obj3.D) then
+                   return;
+                end if;
+
+                Failed ("Return not taken");
+            end Do_Something;
+        begin
+            Do_Something;
+            Failed ("No exception raised by finalization on return statement");
+        exception
+            when Program_Error =>
+                if not Was_Finalized (Ident_Int (18)) or
+                   not Was_Finalized (Ident_Int (19)) then
+                    Failed ("Missing finalizations - 5");
+                end if;
+            when E: others =>
+                Failed ("Exception " & Exception_Name (E) &
+                        " raised - " & Exception_Message (E) & " - 5");
+        end A_Return;
+
+    Except: -- Case 6
+        declare
+            Funky_Error : exception;
+
+            procedure Do_Something is
+                Obj1 : Ctrl :=
+                    (Ada.Finalization.Controlled with
+                     D => True,
+                     Finalized => Ident_Bool (False),
+                     C2 => 2.0 * Float (
+                           Ident_Int(23))); -- Finalization: User_Error
+                Obj2 : Ctrl := Create (Ident_Int (24));
+                Obj3 : Ctrl := Create (Ident_Int (25));
+                Obj4 : constant Ctrl := (Ada.Finalization.Controlled with
+                                         D => False,
+                                         Finalized => Ident_Bool (False),
+                                         C1 => Ident_Int (26));
+            begin
+                Comment ("Finalization because of exception propagation");
+
+                Use_It (Obj1); -- Prevent optimization of Objects.
+                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
+                Use_It (Obj3);
+                Use_It (Obj4);
+
+                if not Ident_Bool (Obj4.D) then
+                   raise Funky_Error;
+                end if;
+
+                Failed ("Exception not raised");
+            end Do_Something;
+        begin
+            Do_Something;
+            Failed ("No exception raised by finalization on exception " &
+                    "propagation");
+        exception
+            when Program_Error =>
+                if not Was_Finalized (Ident_Int (24)) or
+                   not Was_Finalized (Ident_Int (25)) or
+                   not Was_Finalized (Ident_Int (26)) then
+                    Failed ("Missing finalizations - 6");
+                end if;
+            when Funky_Error =>
+                Failed ("Wrong exception propagated");
+                    -- Should be Program_Error (7.6.1(19)).
+            when E: others =>
+                Failed ("Exception " & Exception_Name (E) &
+                        " raised - " & Exception_Message (E) & " - 6");
+        end Except;
+
+    Result;
+end C761011;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761012.a
new file mode 100644
index 000000000..77b9e2253
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c761012.a
@@ -0,0 +1,151 @@
+-- C761012.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that an anonymous object is finalized with its enclosing master if
+--    a transfer of control or exception occurs prior to performing its normal
+--    finalization.  (Defect Report 8652/0023, as reflected in
+--    Technical Corrigendum 1, RM95 7.6.1(13.1/1)).
+--
+-- CHANGE HISTORY:
+--    29 JAN 2001   PHL   Initial version.
+--     5 DEC 2001   RLB   Reformatted for ACATS.
+--
+--!
+with Ada.Finalization;
+use Ada.Finalization;
+package C761012_0 is
+
+    type Ctrl (D : Boolean) is new Controlled with
+        record
+            case D is
+                when False =>
+                    C1 : Integer;
+                when True =>
+                    C2 : Float;
+            end case;
+        end record;
+
+    function Create return Ctrl;
+    procedure Finalize (Obj : in out Ctrl);
+    function Finalize_Was_Called return Boolean;
+
+end C761012_0;
+
+with Report;
+use Report;
+package body C761012_0 is
+
+    Finalization_Flag : Boolean := False;
+
+    function Create return Ctrl is
+        Obj : Ctrl (Ident_Bool (True));
+    begin
+        Obj.C2 := 3.0;
+        return Obj;
+    end Create;
+
+    procedure Finalize (Obj : in out Ctrl) is
+    begin
+        Finalization_Flag := True;
+    end Finalize;
+
+    function Finalize_Was_Called return Boolean is
+    begin
+        if Finalization_Flag then
+            Finalization_Flag := False;
+            return True;
+        else
+            return False;
+        end if;
+    end Finalize_Was_Called;
+
+end C761012_0;
+
+with Ada.Exceptions;
+use Ada.Exceptions;
+with C761012_0;
+use C761012_0;
+with Report;
+use Report;
+procedure C761012 is
+begin
+    Test ("C761012",
+          "Check that an anonymous object is finalized with its enclosing " &
+             "master if a transfer of control or exception occurs prior to " &
+             "performing its normal finalization");
+
+    Excep:
+        begin
+
+            declare
+                I : Integer := Create.C1; -- Raises Constraint_Error
+            begin
+                Failed
+                   ("Improper component selection did not raise Constraint_Error, I =" &
+                    Integer'Image (I));
+            exception
+                when Constraint_Error =>
+                    Failed ("Constraint_Error caught by the wrong handler");
+            end;
+
+            Failed ("Transfer of control did not happen correctly");
+
+        exception
+            when Constraint_Error =>
+                if not Finalize_Was_Called then
+                    Failed ("Finalize wasn't called when the master was left " &
+                            "- Constraint_Error");
+                end if;
+            when E: others =>
+                Failed ("Exception " & Exception_Name (E) &
+                        " raised - " & Exception_Information (E));
+        end Excep;
+
+    Transfer:
+        declare
+            Finalize_Was_Called_Before_Leaving_Exit : Boolean;
+        begin
+
+            begin
+                loop
+                    exit when Create.C2 = 3.0;
+                end loop;
+                Finalize_Was_Called_Before_Leaving_Exit := Finalize_Was_Called;
+                if Finalize_Was_Called_Before_Leaving_Exit then
+                    Comment ("Finalize called before the transfer of control");
+                end if;
+            end;
+
+            if not Finalize_Was_Called and then
+               not Finalize_Was_Called_Before_Leaving_Exit then
+                Failed ("Finalize wasn't called when the master was left " &
+                        "- transfer of control");
+            end if;
+        end Transfer;
+
+    Result;
+end C761012;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83007a.ada
new file mode 100644
index 000000000..f33d907af
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83007a.ada
@@ -0,0 +1,95 @@
+-- C83007A.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 FORMAL PARAMETER OF A SUBPROGRAM DECLARED BY A
+--     RENAMING DECLARATION CAN HAVE THE SAME IDENTIFIER AS A
+--     DECLARATION IN THE BODY OF THE RENAMED SUBPROGRAM.
+
+-- HISTORY:
+--     VCL  02/18/88  CREATED ORIGINAL TEST.
+
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C83007A IS
+BEGIN
+     TEST ("C83007A", "A FORMAL PARAMETER OF A SUBPROGRAM DECLARED " &
+                      "BY A RENAMING DECLARATION CAN HAVE THE SAME " &
+                      "IDENTIFIER AS A DECLARATION IN THE BODY OF " &
+                      "THE RENAMED SUBPROGRAM");
+     DECLARE
+          PROCEDURE P (ONE : INTEGER; TWO : FLOAT; THREE : STRING);
+
+          PROCEDURE R (D1 : INTEGER;
+                       D2 : FLOAT;
+                       D3 : STRING)  RENAMES P;
+
+          PROCEDURE P (ONE : INTEGER; TWO : FLOAT; THREE : STRING) IS
+               TYPE D1 IS RANGE 1..10;
+               I : D1 := D1(IDENT_INT (7));
+
+               D2 : FLOAT;
+
+               FUNCTION D3 RETURN STRING IS
+               BEGIN
+                    RETURN "D3";
+               END D3;
+
+               FUNCTION IDENT_FLOAT (VAL : FLOAT) RETURN FLOAT IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN VAL;
+                    ELSE
+                         RETURN 0.0;
+                    END IF;
+               END IDENT_FLOAT;
+
+          BEGIN
+               IF ONE /= 5 THEN
+                    FAILED ("INCORRECT VALUE FOR PARAMETER ONE");
+               END IF;
+               IF TWO /= 4.5 THEN
+                    FAILED ("INCORRECT VALUE FOR PARAMETER TWO");
+               END IF;
+               IF THREE /= "R1" THEN
+                    FAILED ("INCORRECT VALUE FOR PARAMETER THREE");
+               END IF;
+
+               IF I /= 7 THEN
+                    FAILED ("INCORRECT VALUE FOR OBJECT I");
+               END IF;
+               D2 := IDENT_FLOAT (3.5);
+               IF D2 /= 3.5 THEN
+                    FAILED ("INCORRECT VALUE FOR OBJECT D2");
+               END IF;
+               IF D3 /= "D3" THEN
+                    FAILED ("INCORRECT VALUE FOR FUNCTION D3");
+               END IF;
+          END P;
+     BEGIN
+          R (D1=>5, D2=>4.5, D3=>"R1");
+     END;
+
+     RESULT;
+END C83007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83012d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83012d.ada
new file mode 100644
index 000000000..a73639c6c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83012d.ada
@@ -0,0 +1,116 @@
+-- C83012D.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 PACKAGE INSTANTIATION, A DECLARATION
+--     HAVING THE SAME IDENTIFIER AS THE PACKAGE IS VISIBLE BY
+--     SELECTION.
+
+-- HISTORY:
+--     JET 08/11/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83012D IS
+
+     PACKAGE PACK IS
+          SUBTYPE PACK1 IS INTEGER;
+          PACK2 : INTEGER := 2;
+     END PACK;
+
+     TYPE REC IS RECORD
+          PACK3 : INTEGER;
+          PACK4 : INTEGER;
+     END RECORD;
+
+     R : REC := (PACK3 => 3, PACK4 => 1);
+
+     GENERIC
+          TYPE T IS RANGE <>;
+     PACKAGE GEN1 IS
+          J : INTEGER := IDENT_INT(1);
+     END GEN1;
+
+     GENERIC
+          I : INTEGER;
+     PACKAGE GEN2 IS
+          J : INTEGER := IDENT_INT(I);
+     END GEN2;
+
+     GENERIC
+          R : REC;
+     PACKAGE GEN3 IS
+          J : INTEGER := IDENT_INT(R.PACK4);
+     END GEN3;
+
+     GENERIC
+          PACK6 : INTEGER;
+     PACKAGE GEN4 IS
+          J : INTEGER := IDENT_INT(PACK6);
+     END GEN4;
+
+     FUNCTION FUNC (PACK5: INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN IDENT_INT(PACK5);
+     END FUNC;
+
+     PACKAGE PACK1 IS NEW GEN1(PACK.PACK1);
+     PACKAGE PACK2 IS NEW GEN2(PACK.PACK2);
+     PACKAGE PACK3 IS NEW GEN2(R.PACK3);
+     PACKAGE PACK4 IS NEW GEN3((1, PACK4 => 4));
+     PACKAGE PACK5 IS NEW GEN2(FUNC(PACK5 => 5));
+     PACKAGE PACK6 IS NEW GEN4(PACK6 => 6);
+
+BEGIN
+     TEST ("C83012D", "CHECK THAT WITHIN A GENERIC PACKAGE " &
+                      "INSTANTIATION, A DECLARATION HAVING THE SAME " &
+                      "IDENTIFIER AS THE PACKAGE IS VISIBLE BY " &
+                      "SELECTION");
+
+     IF PACK1.J /= 1 THEN
+          FAILED ("INCORRECT VALUE OF PACK1.J");
+     END IF;
+
+     IF PACK2.J /= 2 THEN
+          FAILED ("INCORRECT VALUE OF PACK2.J");
+     END IF;
+
+     IF PACK3.J /= 3 THEN
+          FAILED ("INCORRECT VALUE OF PACK3.J");
+     END IF;
+
+     IF PACK4.J /= 4 THEN
+          FAILED ("INCORRECT VALUE OF PACK4.J");
+     END IF;
+
+     IF PACK5.J /= 5 THEN
+          FAILED ("INCORRECT VALUE OF PACK5.J");
+     END IF;
+
+     IF PACK6.J /= 6 THEN
+          FAILED ("INCORRECT VALUE OF PACK6.J");
+     END IF;
+
+     RESULT;
+
+END C83012D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83022a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83022a.ada
new file mode 100644
index 000000000..391c9dda5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83022a.ada
@@ -0,0 +1,338 @@
+-- C83022A.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 A SUBPROGRAM FORMAL PART OR BODY
+--     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
+--     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
+--     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
+--     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+--     HOMOGRAH DECLARATION.
+
+-- HISTORY:
+--     TBN 08/01/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83022A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          X : T;
+     FUNCTION GEN_FUN RETURN T;
+
+     FUNCTION GEN_FUN RETURN T IS
+     BEGIN
+          RETURN X;
+     END GEN_FUN;
+
+BEGIN
+     TEST ("C83022A", "CHECK THAT A DECLARATION IN A SUBPROGRAM " &
+                      "FORMAL PART OR BODY HIDES AN OUTER " &
+                      "DECLARATION OF A HOMOGRAPH");
+
+     ONE:
+     DECLARE                      -- SUBPROGRAM DECLARATIVE REGION.
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+
+          PROCEDURE INNER (X : IN OUT INTEGER) IS
+               C : INTEGER := A;
+               A : INTEGER := IDENT_INT(3);
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+               END IF;
+               IF ONE.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+               END IF;
+               IF ONE.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+               END IF;
+               IF C /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+               END IF;
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 5");
+               END IF;
+               IF EQUAL(1,1) THEN
+                    X := A;
+               ELSE
+                    X := ONE.A;
+               END IF;
+          END INNER;
+
+     BEGIN  -- ONE
+          INNER (A);
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 6");
+          END IF;
+     END ONE;
+
+     TWO:
+     DECLARE                     -- FORMAL PARAMETER OF SUBPROGRAM.
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+          OBJ : INTEGER := IDENT_INT(3);
+
+          PROCEDURE INNER (X : IN INTEGER := A;
+                           A : IN OUT INTEGER) IS
+               C : INTEGER := A;
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
+               END IF;
+               IF TWO.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+               END IF;
+               IF TWO.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+               END IF;
+               IF C /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+               END IF;
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 14");
+               END IF;
+               IF EQUAL(1,1) THEN
+                    A := IDENT_INT(4);
+               ELSE
+                    A := 1;
+               END IF;
+          END INNER;
+
+     BEGIN  -- TWO
+          INNER (A => OBJ);
+          IF OBJ /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 15");
+          END IF;
+     END TWO;
+
+     THREE:
+     DECLARE            -- AFTER THE SPECIFICATION OF SUBPROGRAM.
+          A : INTEGER := IDENT_INT(2);
+
+          FUNCTION INNER (X : INTEGER) RETURN INTEGER;
+
+          B : INTEGER := A;
+
+          FUNCTION INNER (X : INTEGER) RETURN INTEGER IS
+               C : INTEGER := A;
+               A : INTEGER := IDENT_INT(3);
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+               END IF;
+               IF THREE.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+               END IF;
+               IF THREE.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+               END IF;
+               IF C /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+               END IF;
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 24");
+               END IF;
+               IF EQUAL(1,1) THEN
+                    RETURN A;
+               ELSE
+                    RETURN X;
+               END IF;
+          END INNER;
+
+     BEGIN  -- THREE
+          IF INNER(A) /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 25");
+          END IF;
+     END THREE;
+
+     FOUR:
+     DECLARE                              -- RENAMING DECLARATION.
+          A : INTEGER := IDENT_INT(2);
+
+          PROCEDURE TEMPLATE (X : IN INTEGER := A;
+                              Y : IN OUT INTEGER);
+
+          PROCEDURE INNER (Z : IN INTEGER := A;
+                           A : IN OUT INTEGER) RENAMES TEMPLATE;
+
+          B : INTEGER := A;
+          OBJ : INTEGER := 5;
+
+          PROCEDURE TEMPLATE (X : IN INTEGER := A;
+                              Y : IN OUT INTEGER) IS
+          BEGIN  -- TEMPLATE
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RESULTS FOR VARIABLE - 30");
+               END IF;
+               IF Y /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT RESULTS FOR VARIABLE - 31");
+               END IF;
+               Y := IDENT_INT(2 * X);
+               IF FOUR.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RESULTS FOR OUTER HOMOGRAPH - " &
+                            "32");
+               END IF;
+          END TEMPLATE;
+
+     BEGIN  -- FOUR
+          IF B /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 32");
+          END IF;
+          INNER (A => OBJ);
+          IF OBJ /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 33");
+          END IF;
+     END FOUR;
+
+     FIVE:
+     DECLARE                         -- GENERIC FORMAL SUBPROGRAM.
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+
+          PROCEDURE INNER (X : IN OUT INTEGER);
+
+          GENERIC
+               WITH PROCEDURE SUBPR (Y : IN OUT INTEGER) IS <>;
+          PACKAGE P IS
+               PAC_VAR : INTEGER := 1;
+          END P;
+
+          PROCEDURE INNER (X : IN OUT INTEGER) IS
+               C : INTEGER := A;
+               A : INTEGER := IDENT_INT(3);
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 41");
+               END IF;
+               IF FIVE.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 42");
+               END IF;
+               IF FIVE.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 43");
+               END IF;
+               IF C /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 44");
+               END IF;
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 45");
+               END IF;
+               IF EQUAL(1,1) THEN
+                    X := A;
+               ELSE
+                    X := FIVE.A;
+               END IF;
+          END INNER;
+
+          PACKAGE BODY P IS
+          BEGIN
+               SUBPR (A);
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE PASSED OUT - 46");
+               END IF;
+               IF PAC_VAR /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT VALUE FOR PAC_VAR - 47");
+               END IF;
+          END P;
+
+          PACKAGE NEW_P IS NEW P (INNER);
+
+     BEGIN  -- FIVE
+          NULL;
+     END FIVE;
+
+     SIX:
+     DECLARE                              -- GENERIC INSTANTIATION.
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+          OBJ : INTEGER := IDENT_INT(3);
+
+          GENERIC
+          PROCEDURE INNER (X : IN INTEGER := A;
+                           A : IN OUT INTEGER);
+
+          PROCEDURE INNER (X : IN INTEGER := SIX.A;
+                           A : IN OUT INTEGER) IS
+               C : INTEGER := A;
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -50");
+               END IF;
+               IF SIX.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 51");
+               END IF;
+               IF SIX.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 52");
+               END IF;
+               IF C /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 53");
+               END IF;
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 54");
+               END IF;
+               IF EQUAL(1,1) THEN
+                    A := IDENT_INT(4);
+               ELSE
+                    A := 1;
+               END IF;
+          END INNER;
+
+          PROCEDURE SUBPR IS NEW INNER;
+
+     BEGIN  -- SIX
+          SUBPR (A => OBJ);
+          IF OBJ /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 55");
+          END IF;
+     END SIX;
+
+     SEVEN:
+     DECLARE                 --  OVERLOADING OF FUNCTIONS.
+
+          OBJ : INTEGER := 1;
+          FLO : FLOAT := 5.0;
+
+          FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+
+          PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT);
+
+          FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+
+          PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT) IS
+          BEGIN
+               X := INTEGER(F);
+          END INNER;
+
+     BEGIN
+          FLO := 6.25;
+          INNER (OBJ, FLO);
+          IF OBJ /= IDENT_INT(6) THEN
+               FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60");
+          END IF;
+     END SEVEN;
+
+
+     RESULT;
+END C83022A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83022g0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83022g0.ada
new file mode 100644
index 000000000..36f3f9065
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83022g0.ada
@@ -0,0 +1,165 @@
+-- C83022G0M.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 A SUBPROGRAM FORMAL PART OR BODY
+--     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
+--     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
+--     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
+--     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+--     HOMOGRAPH DECLARATION, IF THE SUBPROGRAM BODY IS COMPILED
+--     SEPARATELY AS A SUBUNIT.
+
+-- SEPARATE FILES ARE:
+--     C83022G0M.ADA - (THIS FILE) MAIN PROGRAM.
+--     C83022G1.ADA -- SUBPROGRAM BODIES.
+
+-- HISTORY:
+--     BCB 08/26/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C83022G0M IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          X : T;
+     FUNCTION GEN_FUN RETURN T;
+
+     A : INTEGER := IDENT_INT(2);
+     B : INTEGER := A;
+
+     OBJ : INTEGER := IDENT_INT(3);
+
+     FLO : FLOAT := 5.0;
+
+     PROCEDURE TEMPLATE (X : IN INTEGER := A;
+                         Y : IN OUT INTEGER);
+
+     PROCEDURE INNER4 (Z : IN INTEGER := A;
+                       A : IN OUT INTEGER) RENAMES TEMPLATE;
+
+     PROCEDURE INNER (X : IN OUT INTEGER) IS SEPARATE;
+
+     PROCEDURE INNER2 (X : IN INTEGER := A;
+                       A : IN OUT INTEGER) IS SEPARATE;
+
+     FUNCTION INNER3 (X : INTEGER) RETURN INTEGER IS SEPARATE;
+
+     PROCEDURE TEMPLATE (X : IN INTEGER := A;
+                         Y : IN OUT INTEGER) IS SEPARATE;
+
+     PROCEDURE INNER5 (X : IN OUT INTEGER) IS SEPARATE;
+
+     GENERIC
+          WITH PROCEDURE SUBPR (Y : IN OUT INTEGER) IS <>;
+     PACKAGE P IS
+          PAC_VAR : INTEGER := 1;
+     END P;
+
+     PACKAGE BODY P IS
+     BEGIN
+          SUBPR (A);
+
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 1");
+          END IF;
+
+          IF PAC_VAR /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE FOR PAC_VAR - 2");
+          END IF;
+     END P;
+
+     PACKAGE NEW_P IS NEW P (INNER5);
+
+     FUNCTION GEN_FUN RETURN T IS
+     BEGIN
+          RETURN X;
+     END GEN_FUN;
+
+     FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+
+     PROCEDURE INNER6 (X : IN OUT INTEGER; F : IN FLOAT);
+
+     FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+
+     PROCEDURE INNER6 (X : IN OUT INTEGER; F : IN FLOAT) IS SEPARATE;
+
+BEGIN
+     TEST ("C83022G", "CHECK THAT A DECLARATION IN A SUBPROGRAM " &
+                      "FORMAL PART OR BODY HIDES AN OUTER " &
+                      "DECLARATION OF A HOMOGRAPH");
+
+     A := IDENT_INT(2);
+     B := A;
+
+     INNER (A);
+
+     IF A /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE PASSED OUT - 3");
+     END IF;
+
+     A := IDENT_INT(2);
+
+     INNER2 (A => OBJ);
+
+     IF OBJ /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT VALUE PASSED OUT - 4");
+     END IF;
+
+     A := IDENT_INT(2);
+
+     B := A;
+
+     IF INNER3(A) /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE PASSED OUT - 5");
+     END IF;
+
+     A := IDENT_INT(2);
+
+     B := A;
+     OBJ := 5;
+
+     IF B /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 6");
+     END IF;
+
+     INNER4 (A => OBJ);
+
+     IF OBJ /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT VALUE PASSED OUT - 7");
+     END IF;
+
+     OBJ := 1;
+
+     FLO := 6.25;
+
+     INNER6 (OBJ, FLO);
+
+     IF OBJ /= IDENT_INT(6) THEN
+          FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 8");
+     END IF;
+
+     RESULT;
+END C83022G0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83022g1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83022g1.ada
new file mode 100644
index 000000000..e25bdc982
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83022g1.ada
@@ -0,0 +1,189 @@
+-- C83022G1.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 A SUBPROGRAM FORMAL PART OR BODY
+--     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
+--     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
+--     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
+--     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+--     HOMOGRAPH DECLARATION, IF THE SUBPROGRAM BODY IS COMPILED
+--     SEPARATELY AS A SUBUNIT.
+
+-- HISTORY:
+--     BCB 08/26/88  CREATED ORIGINAL TEST.
+
+SEPARATE (C83022G0M)
+PROCEDURE INNER (X : IN OUT INTEGER) IS
+     C : INTEGER := A;
+     A : INTEGER := IDENT_INT(3);
+BEGIN
+     IF A /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+     END IF;
+
+     IF C83022G0M.A /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+     END IF;
+
+     IF C83022G0M.B /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+     END IF;
+
+     IF C /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+     END IF;
+
+     IF X /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE PASSED IN - 5");
+     END IF;
+
+     IF EQUAL(1,1) THEN
+          X := A;
+     ELSE
+          X := C83022G0M.A;
+     END IF;
+END INNER;
+
+SEPARATE (C83022G0M)
+PROCEDURE INNER2 (X : IN INTEGER := C83022G0M.A;
+                  A : IN OUT INTEGER) IS
+     C : INTEGER := A;
+BEGIN
+     IF A /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
+     END IF;
+
+     IF C83022G0M.A /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+     END IF;
+
+     IF C83022G0M.B /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+     END IF;
+
+     IF C /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+     END IF;
+
+     IF X /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE PASSED IN - 14");
+     END IF;
+
+     IF EQUAL(1,1) THEN
+          A := IDENT_INT(4);
+     ELSE
+          A := 1;
+     END IF;
+END INNER2;
+
+SEPARATE (C83022G0M)
+FUNCTION INNER3 (X : INTEGER) RETURN INTEGER IS
+     C : INTEGER := A;
+     A : INTEGER := IDENT_INT(3);
+BEGIN
+     IF A /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+     END IF;
+
+     IF C83022G0M.A /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+     END IF;
+
+     IF C83022G0M.B /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+     END IF;
+
+     IF C /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+     END IF;
+
+     IF X /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE PASSED IN - 24");
+     END IF;
+
+     IF EQUAL(1,1) THEN
+          RETURN A;
+     ELSE
+          RETURN X;
+     END IF;
+END INNER3;
+
+SEPARATE (C83022G0M)
+PROCEDURE TEMPLATE (X : IN INTEGER := A;
+                    Y : IN OUT INTEGER) IS
+BEGIN  -- TEMPLATE
+     IF X /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT RESULTS FOR VARIABLE - 30");
+     END IF;
+
+     IF Y /= IDENT_INT(5) THEN
+          FAILED ("INCORRECT RESULTS FOR VARIABLE - 31");
+     END IF;
+
+     Y := IDENT_INT(2 * X);
+
+     IF C83022G0M.A /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT RESULTS FOR OUTER HOMOGRAPH - " &
+                  "32");
+     END IF;
+END TEMPLATE;
+
+SEPARATE (C83022G0M)
+PROCEDURE INNER5 (X : IN OUT INTEGER) IS
+     C : INTEGER := A;
+     A : INTEGER := IDENT_INT(3);
+BEGIN
+     IF A /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 41");
+     END IF;
+
+     IF C83022G0M.A /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 42");
+     END IF;
+
+     IF C83022G0M.B /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 43");
+     END IF;
+
+     IF C /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 44");
+     END IF;
+
+     IF X /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE PASSED IN - 45");
+     END IF;
+
+     IF EQUAL(1,1) THEN
+          X := A;
+     ELSE
+          X := C83022G0M.A;
+     END IF;
+END INNER5;
+
+SEPARATE (C83022G0M)
+PROCEDURE INNER6 (X : IN OUT INTEGER; F : IN FLOAT) IS
+BEGIN
+     X := INTEGER(F);
+END INNER6;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83023a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83023a.ada
new file mode 100644
index 000000000..18f80c3c0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83023a.ada
@@ -0,0 +1,194 @@
+-- C83023A.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 A DECLARATIVE REGION OF A TASK
+--     HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE
+--     OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE
+--     REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE
+--     OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+--     HOMOGRAPH DECLARATION.
+
+-- HISTORY:
+--     BCB 08/29/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83023A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          X : T;
+     FUNCTION GEN_FUN RETURN T;
+
+     FUNCTION GEN_FUN RETURN T IS
+     BEGIN
+          RETURN X;
+     END GEN_FUN;
+
+BEGIN
+     TEST ("C83023A", "CHECK THAT A DECLARATION IN A DECLARATIVE " &
+                      "REGION OF A TASK HIDES AN OUTER " &
+                      "DECLARATION OF A HOMOGRAPH");
+
+     ONE:
+     DECLARE                      -- DECLARATIVE REGION.
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+
+          TASK INNER IS
+               ENTRY HERE (X : IN OUT INTEGER);
+          END INNER;
+
+          TASK BODY INNER IS
+               C : INTEGER := A;
+               A : INTEGER := IDENT_INT(3);
+          BEGIN
+               ACCEPT HERE (X : IN OUT INTEGER) DO
+                    IF A /= IDENT_INT(3) THEN
+                         FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH" &
+                                 " - 1");
+                    END IF;
+
+                    IF ONE.A /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH" &
+                                 " - 2");
+                    END IF;
+
+                    IF ONE.B /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT VALUE FOR OUTER VARIABLE " &
+                                 "- 3");
+                    END IF;
+
+                    IF C /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT VALUE FOR INNER VARIABLE " &
+                                 "- 4");
+                    END IF;
+
+                    IF X /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT VALUE PASSED IN - 5");
+                    END IF;
+
+                    IF EQUAL(1,1) THEN
+                         X := A;
+                    ELSE
+                         X := ONE.A;
+                    END IF;
+               END HERE;
+          END INNER;
+
+     BEGIN  -- ONE
+          INNER.HERE(A);
+
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 6");
+          END IF;
+     END ONE;
+
+     TWO:
+     DECLARE            -- AFTER THE SPECIFICATION OF TASK.
+          TASK INNER IS
+               ENTRY HERE (X : IN OUT INTEGER);
+          END INNER;
+
+          A : INTEGER := IDENT_INT(2);
+
+          B : INTEGER := A;
+
+          TASK BODY INNER IS
+               C : INTEGER := A;
+               A : INTEGER := IDENT_INT(3);
+          BEGIN
+               ACCEPT HERE (X : IN OUT INTEGER) DO
+                    IF A /= IDENT_INT(3) THEN
+                         FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH" &
+                                 " - 10");
+                    END IF;
+
+                    IF TWO.A /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH" &
+                                 " - 11");
+                    END IF;
+
+                    IF TWO.B /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT VALUE FOR OUTER VARIABLE " &
+                                 "- 12");
+                    END IF;
+
+                    IF C /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT VALUE FOR INNER VARIABLE " &
+                                 "- 13");
+                    END IF;
+
+                    IF X /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT VALUE PASSED IN - 14");
+                    END IF;
+
+                    IF EQUAL(1,1) THEN
+                         X := A;
+                    ELSE
+                         NULL;
+                    END IF;
+               END HERE;
+          END INNER;
+
+     BEGIN  -- TWO
+          INNER.HERE(A);
+
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 15");
+          END IF;
+     END TWO;
+
+     THREE:
+     DECLARE                 --  OVERLOADING OF FUNCTIONS.
+
+          OBJ : INTEGER := 1;
+          FLO : FLOAT := 5.0;
+
+          FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+
+          TASK INNER IS
+               ENTRY HERE (X : IN OUT INTEGER);
+          END INNER;
+
+          FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+
+          TASK BODY INNER IS
+               F : FLOAT := 6.25;
+          BEGIN
+               ACCEPT HERE (X : IN OUT INTEGER) DO
+                    X := INTEGER(F);
+               END HERE;
+          END INNER;
+
+     BEGIN
+          INNER.HERE (OBJ);
+
+          IF OBJ /= IDENT_INT(6) THEN
+               FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 20");
+          END IF;
+     END THREE;
+
+     RESULT;
+END C83023A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83024a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83024a.ada
new file mode 100644
index 000000000..0ad06b3a1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83024a.ada
@@ -0,0 +1,185 @@
+-- C83024A.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 A DECLARATIVE REGION FOR A GENERIC
+--     PACKAGE HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
+--     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
+--     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
+--     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+--     HOMOGRAH DECLARATION.
+
+-- HISTORY:
+--     BCB 08/30/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C83024A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          X : T;
+     FUNCTION GEN_FUN RETURN T;
+
+     FUNCTION GEN_FUN RETURN T IS
+     BEGIN
+          RETURN X;
+     END GEN_FUN;
+
+BEGIN
+     TEST ("C83024A", "CHECK THAT A DECLARATION IN A DECLARATIVE " &
+                      "REGION FOR A GENERIC PACKAGE HIDES AN OUTER " &
+                      "DECLARATION OF A HOMOGRAPH");
+
+     ONE:
+     DECLARE
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+          OBJ : INTEGER := IDENT_INT(3);
+
+          GENERIC
+               X : IN INTEGER := A;
+               A : IN OUT INTEGER;
+          PACKAGE INNER IS
+               C : INTEGER := A;
+          END INNER;
+
+          PACKAGE BODY INNER IS
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
+               END IF;
+
+               IF ONE.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+               END IF;
+
+               IF ONE.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+               END IF;
+
+               IF C /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+               END IF;
+
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 14");
+               END IF;
+
+               IF EQUAL(1,1) THEN
+                    A := IDENT_INT(4);
+               ELSE
+                    A := 1;
+               END IF;
+          END INNER;
+
+          PACKAGE NEW_INNER IS NEW INNER (A => OBJ);
+
+     BEGIN  -- ONE
+          IF OBJ /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 15");
+          END IF;
+     END ONE;
+
+     TWO:
+     DECLARE            -- AFTER THE SPECIFICATION OF PACKAGE.
+          A : INTEGER := IDENT_INT(2);
+
+          GENERIC
+               X : IN OUT INTEGER;
+          PACKAGE INNER IS
+               A : INTEGER := IDENT_INT(3);
+          END INNER;
+
+          B : INTEGER := A;
+
+          PACKAGE BODY INNER IS
+               C : INTEGER := TWO.A;
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+               END IF;
+
+               IF TWO.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+               END IF;
+
+               IF TWO.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+               END IF;
+
+               IF C /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+               END IF;
+
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 24");
+               END IF;
+
+               IF EQUAL(1,1) THEN
+                    X := A;
+               ELSE
+                    NULL;
+               END IF;
+          END INNER;
+
+          PACKAGE NEW_INNER IS NEW INNER (A);
+
+     BEGIN  -- TWO
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 25");
+          END IF;
+     END TWO;
+
+     THREE:
+     DECLARE                 --  OVERLOADING OF FUNCTIONS.
+
+          OBJ : INTEGER := 1;
+          FLO : FLOAT := 6.25;
+
+          FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+
+          GENERIC
+               X : IN OUT INTEGER;
+               F : IN FLOAT;
+          PACKAGE INNER IS
+          END INNER;
+
+          FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+
+          PACKAGE BODY INNER IS
+          BEGIN
+               X := INTEGER(F);
+          END INNER;
+
+          PACKAGE NEW_INNER IS NEW INNER (OBJ, FLO);
+
+     BEGIN
+          IF OBJ /= IDENT_INT(6) THEN
+               FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60");
+          END IF;
+     END THREE;
+
+     RESULT;
+END C83024A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83024e0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83024e0.ada
new file mode 100644
index 000000000..e92cffb9d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83024e0.ada
@@ -0,0 +1,112 @@
+-- C83024E0.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 THE DECLARATIVE REGION OF A GENERIC
+--     PACKAGE HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
+--     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
+--     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
+--     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+--     HOMOGRAPH DECLARATION, IF THE GENERIC PACKAGE BODY IS SEPARATELY
+--     COMPILED, BUT NOT AS A SUBUNIT.
+
+-- HISTORY:
+--     BCB 08/30/88  CREATED ORIGINAL TEST.
+-- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+GENERIC
+     TYPE T IS PRIVATE;
+     X : T;
+FUNCTION C83024E_GEN_FUN RETURN T;
+
+FUNCTION C83024E_GEN_FUN RETURN T IS
+BEGIN
+     RETURN X;
+END C83024E_GEN_FUN;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE(REPORT);
+PACKAGE C83024E_P1 IS
+     A : INTEGER := IDENT_INT(2);
+     B : INTEGER := A;
+
+     PROCEDURE REQUIRE_BODY;
+
+     GENERIC
+          X : IN OUT INTEGER;
+     PACKAGE C83024E_PACK1 IS
+          C : INTEGER := A;
+          A : INTEGER := IDENT_INT(3);
+     END C83024E_PACK1;
+END C83024E_P1;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE(REPORT);
+PACKAGE C83024E_P2 IS
+     A : INTEGER := IDENT_INT(2);
+     B : INTEGER := A;
+     OBJ : INTEGER := IDENT_INT(3);
+
+     PROCEDURE REQUIRE_BODY;
+
+     GENERIC
+          X : IN INTEGER := A;
+          A : IN OUT INTEGER;
+     PACKAGE C83024E_PACK2 IS
+          C : INTEGER := A;
+     END C83024E_PACK2;
+END C83024E_P2;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE(REPORT);
+PACKAGE C83024E_P3 IS
+     A : INTEGER := IDENT_INT(2);
+     B : INTEGER := A;
+
+     PROCEDURE REQUIRE_BODY;
+
+     GENERIC
+          X : IN OUT INTEGER;
+     PACKAGE C83024E_PACK3 IS
+     END C83024E_PACK3;
+END C83024E_P3;
+
+WITH REPORT; USE REPORT;
+WITH C83024E_GEN_FUN;
+PRAGMA ELABORATE(REPORT,C83024E_GEN_FUN);
+PACKAGE C83024E_P4 IS
+     OBJ : INTEGER := IDENT_INT(1);
+     FLO : FLOAT := 6.25;
+
+     PROCEDURE REQUIRE_BODY;
+
+     FUNCTION F IS NEW C83024E_GEN_FUN (INTEGER, OBJ);
+     FUNCTION F IS NEW C83024E_GEN_FUN (FLOAT, FLO);
+
+     GENERIC
+          X : IN OUT INTEGER;
+          F : IN FLOAT;
+     PACKAGE C83024E_PACK4 IS
+     END C83024E_PACK4;
+END C83024E_P4;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83024e1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83024e1.ada
new file mode 100644
index 000000000..d7c1c5b23
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83024e1.ada
@@ -0,0 +1,220 @@
+-- C83024E1M.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 THE DECLARATIVE REGION OF A GENERIC
+--     PACKAGE HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
+--     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
+--     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
+--     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+--     HOMOGRAPH DECLARATION, IF THE GENERIC PACKAGE BODY IS SEPARATELY
+--     COMPILED, BUT NOT AS A SUBUNIT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS THAT SUPPORT SEPARATE
+--     COMPILATIONS OF GENERIC SPECIFICATIONS AND BODIES.
+
+-- SEPARATE FILES ARE:
+--     C83024E0.ADA -- GENERIC PACKAGE SPECIFICATIONS.
+--     C83024E1M.ADA - (THIS FILE) GENERIC PACKAGE BODIES AND
+--                     MAIN PROGRAM.
+
+-- HISTORY:
+--     BCB 08/30/88  CREATED ORIGINAL TEST.
+-- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+PACKAGE BODY C83024E_P1 IS
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+       NULL;
+     END;
+
+     PACKAGE BODY C83024E_PACK1 IS
+     BEGIN
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+          END IF;
+
+          IF C83024E_P1.A /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+          END IF;
+
+          IF C83024E_P1.B /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+          END IF;
+
+          IF C /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+          END IF;
+
+          IF X /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE PASSED IN - 5");
+          END IF;
+
+          IF EQUAL(1,1) THEN
+               X := A;
+          ELSE
+               X := C83024E_P1.A;
+          END IF;
+     END C83024E_PACK1;
+END C83024E_P1;
+
+PACKAGE BODY C83024E_P2 IS
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+       NULL;
+     END;
+
+     PACKAGE BODY C83024E_PACK2 IS
+     BEGIN
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
+          END IF;
+
+          IF C83024E_P2.A /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+          END IF;
+
+          IF C83024E_P2.B /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+          END IF;
+
+          IF C /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+          END IF;
+
+          IF X /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE PASSED IN - 14");
+          END IF;
+
+          IF EQUAL(1,1) THEN
+               A := IDENT_INT(4);
+          ELSE
+               A := 1;
+          END IF;
+     END C83024E_PACK2;
+END C83024E_P2;
+
+PACKAGE BODY C83024E_P3 IS
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+       NULL;
+     END;
+
+     PACKAGE BODY C83024E_PACK3 IS
+          C : INTEGER := A;
+          A : INTEGER := IDENT_INT(3);
+     BEGIN
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+          END IF;
+
+          IF C83024E_P3.A /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+          END IF;
+
+          IF C83024E_P3.B /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+          END IF;
+
+          IF C /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+          END IF;
+
+          IF X /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE PASSED IN - 24");
+          END IF;
+
+          IF EQUAL(1,1) THEN
+               X := A;
+          ELSE
+               NULL;
+          END IF;
+     END C83024E_PACK3;
+END C83024E_P3;
+
+PACKAGE BODY C83024E_P4 IS
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+       NULL;
+     END;
+
+     PACKAGE BODY C83024E_PACK4 IS
+     BEGIN
+          X := INTEGER(F);
+     END C83024E_PACK4;
+END C83024E_P4;
+
+WITH REPORT; USE REPORT;
+WITH C83024E_P1; WITH C83024E_P2;
+WITH C83024E_P3; WITH C83024E_P4;
+USE C83024E_P1; USE C83024E_P2;
+USE C83024E_P3; USE C83024E_P4;
+PROCEDURE C83024E1M IS
+
+BEGIN
+     TEST ("C83024E", "CHECK THAT A DECLARATION IN THE DECLARATIVE " &
+                      "REGION OF A GENERIC PACKAGE HIDES AN OUTER " &
+                      "DECLARATION OF A HOMOGRAPH");
+
+     DECLARE
+          PACKAGE NEW_C83024E_PACK1 IS NEW C83024E_PACK1 (C83024E_P1.A);
+     BEGIN
+          IF C83024E_P1.A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 6");
+          END IF;
+     END;
+
+     DECLARE
+          PACKAGE NEW_C83024E_PACK2 IS
+               NEW C83024E_PACK2 (A => C83024E_P2.OBJ);
+     BEGIN
+          IF C83024E_P2.OBJ /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 15");
+          END IF;
+     END;
+
+     DECLARE
+          PACKAGE NEW_C83024E_PACK3 IS NEW C83024E_PACK3 (C83024E_P3.A);
+     BEGIN
+          IF C83024E_P3.A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 25");
+          END IF;
+     END;
+
+     DECLARE
+          PACKAGE NEW_C83024E_PACK4 IS
+               NEW C83024E_PACK4 (C83024E_P4.OBJ, FLO);
+     BEGIN
+          IF C83024E_P4.OBJ /= IDENT_INT(6) THEN
+               FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60");
+          END IF;
+     END;
+
+     RESULT;
+END C83024E1M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83025a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83025a.ada
new file mode 100644
index 000000000..aff1914eb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83025a.ada
@@ -0,0 +1,283 @@
+-- C83025A.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 THE DECLARATIVE REGION OF A GENERIC
+--     SUBPROGRAM HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
+--     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
+--     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
+--     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+--     HOMOGRAPH DECLARATION.
+
+-- HISTORY:
+--     BCB 08/31/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C83025A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          X : T;
+     FUNCTION GEN_FUN RETURN T;
+
+     FUNCTION GEN_FUN RETURN T IS
+     BEGIN
+          RETURN X;
+     END GEN_FUN;
+
+BEGIN
+     TEST ("C83025A", "CHECK THAT A DECLARATION IN THE DECLARATIVE " &
+                      "REGION OF A GENERIC SUBPROGRAM HIDES AN OUTER " &
+                      "DECLARATION OF A HOMOGRAPH");
+
+     ONE:
+     DECLARE                      -- SUBPROGRAM DECLARATIVE REGION.
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+
+          GENERIC
+          PROCEDURE INNER (X : IN OUT INTEGER);
+
+          PROCEDURE INNER (X : IN OUT INTEGER) IS
+               C : INTEGER := A;
+               A : INTEGER := IDENT_INT(3);
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+               END IF;
+
+               IF ONE.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+               END IF;
+
+               IF ONE.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+               END IF;
+
+               IF C /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+               END IF;
+
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 5");
+               END IF;
+
+               IF EQUAL(1,1) THEN
+                    X := A;
+               ELSE
+                    X := ONE.A;
+               END IF;
+          END INNER;
+
+          PROCEDURE NEW_INNER IS NEW INNER;
+
+     BEGIN  -- ONE
+          NEW_INNER (A);
+
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 6");
+          END IF;
+     END ONE;
+
+     TWO:
+     DECLARE               -- FORMAL PARAMETER OF GENERIC SUBPROGRAM.
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+          OBJ : INTEGER := IDENT_INT(3);
+
+          GENERIC
+          PROCEDURE INNER (X : IN INTEGER := A;
+                           A : IN OUT INTEGER);
+
+          PROCEDURE INNER (X : IN INTEGER := TWO.A;
+                           A : IN OUT INTEGER) IS
+               C : INTEGER := A;
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
+               END IF;
+
+               IF TWO.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+               END IF;
+
+               IF TWO.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+               END IF;
+
+               IF C /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+               END IF;
+
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 14");
+               END IF;
+
+               IF EQUAL(1,1) THEN
+                    A := IDENT_INT(4);
+               ELSE
+                    A := 1;
+               END IF;
+          END INNER;
+
+          PROCEDURE NEW_INNER IS NEW INNER;
+
+     BEGIN  -- TWO
+          NEW_INNER (A => OBJ);
+
+          IF OBJ /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 15");
+          END IF;
+     END TWO;
+
+     THREE:
+     DECLARE      -- AFTER THE SPECIFICATION OF GENERIC SUBPROGRAM.
+          GENERIC
+               A : INTEGER := IDENT_INT(3);
+          FUNCTION INNER (X : INTEGER) RETURN INTEGER;
+
+          A : INTEGER := IDENT_INT(2);
+
+          B : INTEGER := A;
+
+          FUNCTION INNER (X : INTEGER) RETURN INTEGER IS
+               C : INTEGER := THREE.A;
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+               END IF;
+
+               IF THREE.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+               END IF;
+
+               IF THREE.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+               END IF;
+
+               IF C /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+               END IF;
+
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 24");
+               END IF;
+
+               IF EQUAL(1,1) THEN
+                    RETURN A;
+               ELSE
+                    RETURN X;
+               END IF;
+          END INNER;
+
+          FUNCTION NEW_INNER IS NEW INNER;
+
+     BEGIN  -- THREE
+          IF NEW_INNER(A) /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 25");
+          END IF;
+     END THREE;
+
+     FOUR:
+     DECLARE
+          A : INTEGER := IDENT_INT(2);
+
+          GENERIC
+               A : INTEGER;
+               B : INTEGER := A;
+          PROCEDURE INNER (X : IN OUT INTEGER);
+
+          PROCEDURE INNER (X : IN OUT INTEGER) IS
+               C : INTEGER := FOUR.A;
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 30");
+               END IF;
+
+               IF B /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 31");
+               END IF;
+
+               IF FOUR.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 32");
+               END IF;
+
+               IF C /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 33");
+               END IF;
+
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 34");
+               END IF;
+
+               IF EQUAL(1,1) THEN
+                    X := A;
+               ELSE
+                    X := FOUR.A;
+               END IF;
+          END INNER;
+
+          PROCEDURE NEW_INNER IS NEW INNER (A => IDENT_INT(3));
+
+     BEGIN
+          NEW_INNER (A);
+
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 35");
+          END IF;
+     END FOUR;
+
+     FIVE:
+     DECLARE                 --  OVERLOADING OF FUNCTIONS.
+
+          OBJ : INTEGER := 1;
+          FLO : FLOAT := 5.0;
+
+          FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+
+          GENERIC
+          PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT);
+
+          FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+
+          PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT) IS
+          BEGIN
+               X := INTEGER(F);
+          END INNER;
+
+          PROCEDURE NEW_INNER IS NEW INNER;
+
+     BEGIN  -- FIVE
+          FLO := 6.25;
+
+          NEW_INNER (OBJ, FLO);
+
+          IF OBJ /= IDENT_INT(6) THEN
+               FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 40");
+          END IF;
+     END FIVE;
+
+     RESULT;
+END C83025A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83025c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83025c.ada
new file mode 100644
index 000000000..b21d26898
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83025c.ada
@@ -0,0 +1,345 @@
+-- C83025C.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 A DECLARATIVE REGION OF A GENERIC
+--     SUBPROGRAM HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
+--     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
+--     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
+--     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
+--     HOMOGRAPH DECLARATION, IF THE GENERIC SUBPROGRAM BODY IS COMPILED
+--     AS A SUBUNIT IN THE SAME COMPILATION.
+
+-- HISTORY:
+--     BCB 09/01/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE(REPORT);
+PACKAGE C83025C_PACK IS
+     Y : INTEGER := IDENT_INT(5);
+     Z : INTEGER := Y;
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          X : T;
+     FUNCTION GEN_FUN RETURN T;
+
+     A : INTEGER := IDENT_INT(2);
+     B : INTEGER := A;
+
+     OBJ : INTEGER := IDENT_INT(3);
+
+     FLO : FLOAT := 5.0;
+
+     TYPE ENUM IS (ONE, TWO, THREE, FOUR);
+
+     EOBJ : ENUM := ONE;
+
+     GENERIC
+          Y : FLOAT := 2.0;
+     PROCEDURE INNER (X : IN OUT INTEGER);
+
+     GENERIC
+          Y : BOOLEAN := TRUE;
+     PROCEDURE INNER2 (X : IN INTEGER := A;
+                       A : IN OUT INTEGER);
+
+     GENERIC
+          Y : ENUM := ONE;
+     FUNCTION INNER3 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER;
+
+     GENERIC
+          Y : ENUM;
+     FUNCTION INNER4 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER;
+
+     GENERIC
+          Y : CHARACTER := 'A';
+     PROCEDURE INNER5 (X : IN OUT INTEGER; F : IN FLOAT;
+                       Z : CHARACTER := Y);
+END C83025C_PACK;
+
+PACKAGE BODY C83025C_PACK IS
+     FUNCTION GEN_FUN RETURN T IS
+     BEGIN
+          RETURN X;
+     END GEN_FUN;
+
+     FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+
+     FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+
+     PROCEDURE INNER (X : IN OUT INTEGER) IS SEPARATE;
+
+     PROCEDURE INNER2 (X : IN INTEGER := C83025C_PACK.A;
+                       A : IN OUT INTEGER) IS SEPARATE;
+
+     FUNCTION INNER3 (X : INTEGER;
+                      Z : ENUM := Y) RETURN INTEGER IS SEPARATE;
+
+     FUNCTION INNER4 (X : INTEGER;
+                      Z : ENUM := Y) RETURN INTEGER IS SEPARATE;
+
+     PROCEDURE INNER5 (X : IN OUT INTEGER; F : IN FLOAT;
+                       Z : CHARACTER := Y) IS SEPARATE;
+END C83025C_PACK;
+
+SEPARATE (C83025C_PACK)
+PROCEDURE INNER (X : IN OUT INTEGER) IS
+     C : INTEGER := A;
+     A : INTEGER := IDENT_INT(3);
+BEGIN
+     IF A /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+     END IF;
+
+     IF C83025C_PACK.A /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+     END IF;
+
+     IF C83025C_PACK.B /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+     END IF;
+
+     IF C /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+     END IF;
+
+     IF X /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE PASSED IN - 5");
+     END IF;
+
+     IF Y /= 2.0 THEN
+          FAILED ("INCORRECT VALUE INNER HOMOGRAPH - 6");
+     END IF;
+
+     IF EQUAL(1,1) THEN
+          X := A;
+     ELSE
+          X := C83025C_PACK.A;
+     END IF;
+END INNER;
+
+SEPARATE (C83025C_PACK)
+PROCEDURE INNER2 (X : IN INTEGER := C83025C_PACK.A;
+                 A : IN OUT INTEGER) IS
+     C : INTEGER := A;
+BEGIN
+     IF A /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
+     END IF;
+
+     IF C83025C_PACK.A /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+     END IF;
+
+     IF C83025C_PACK.B /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+     END IF;
+
+     IF C /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+     END IF;
+
+     IF X /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE PASSED IN - 14");
+     END IF;
+
+     IF Y /= TRUE THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 15");
+     END IF;
+
+     IF EQUAL(1,1) THEN
+          A := IDENT_INT(4);
+     ELSE
+          A := 1;
+     END IF;
+END INNER2;
+
+SEPARATE (C83025C_PACK)
+FUNCTION INNER3 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER IS
+     C : INTEGER := A;
+     A : INTEGER := IDENT_INT(3);
+BEGIN
+     IF A /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
+     END IF;
+
+     IF C83025C_PACK.A /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
+     END IF;
+
+     IF C83025C_PACK.B /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
+     END IF;
+
+     IF C /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+     END IF;
+
+     IF X /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE PASSED IN - 24");
+     END IF;
+
+     IF Y /= ONE THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 25");
+     END IF;
+
+     IF Z /= ONE THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 26");
+     END IF;
+
+     IF EQUAL(1,1) THEN
+          RETURN A;
+     ELSE
+          RETURN X;
+     END IF;
+END INNER3;
+
+SEPARATE (C83025C_PACK)
+FUNCTION INNER4 (X : INTEGER; Z : ENUM := Y) RETURN INTEGER IS
+     C : INTEGER := A;
+     A : INTEGER := IDENT_INT(3);
+BEGIN
+     IF A /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 30");
+     END IF;
+
+     IF C83025C_PACK.A /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 31");
+     END IF;
+
+     IF C83025C_PACK.B /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 32");
+     END IF;
+
+     IF C /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 33");
+     END IF;
+
+     IF X /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE PASSED IN - 34");
+     END IF;
+
+     IF Y /= ONE THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 35");
+     END IF;
+
+     IF Z /= ONE THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 36");
+     END IF;
+
+     IF EQUAL(1,1) THEN
+          RETURN A;
+     ELSE
+          RETURN X;
+     END IF;
+END INNER4;
+
+SEPARATE (C83025C_PACK)
+PROCEDURE INNER5 (X : IN OUT INTEGER; F : IN FLOAT;
+                  Z : CHARACTER := Y) IS
+BEGIN
+     X := INTEGER(F);
+
+     IF Y /= 'A' THEN
+          FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 40");
+     END IF;
+
+     IF Z /= 'A' THEN
+          FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 41");
+     END IF;
+END INNER5;
+
+WITH REPORT; USE REPORT;
+WITH C83025C_PACK; USE C83025C_PACK;
+PROCEDURE C83025C IS
+
+     PROCEDURE NEW_INNER IS NEW INNER;
+
+     PROCEDURE NEW_INNER2 IS NEW INNER2;
+
+     FUNCTION NEW_INNER3 IS NEW INNER3;
+
+     FUNCTION NEW_INNER4 IS NEW INNER4 (Y => EOBJ);
+
+     PROCEDURE NEW_INNER5 IS NEW INNER5;
+
+BEGIN
+     TEST ("C83025C", "CHECK THAT A DECLARATION IN A DECLARATIVE " &
+                      "REGION OF A GENERIC SUBPROGRAM HIDES AN OUTER " &
+                      "DECLARATION OF A HOMOGRAPH");
+
+     A := IDENT_INT(2);
+     B := A;
+
+     NEW_INNER (A);
+
+     IF A /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE PASSED OUT - 7");
+     END IF;
+
+     A := IDENT_INT(2);
+
+     NEW_INNER2 (A => OBJ);
+
+     IF OBJ /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT VALUE PASSED OUT - 16");
+     END IF;
+
+     A := IDENT_INT(2);
+
+     B := A;
+
+     IF NEW_INNER3(A) /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE PASSED OUT - 27");
+     END IF;
+
+     A := IDENT_INT(2);
+
+     B := A;
+
+     IF NEW_INNER4(A) /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE PASSED OUT - 37");
+     END IF;
+
+     OBJ := 1;
+
+     FLO := 6.25;
+
+     NEW_INNER5 (OBJ, FLO);
+
+     IF OBJ /= IDENT_INT(6) THEN
+          FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 42");
+     END IF;
+
+     IF Y /= 5 THEN
+          FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 50");
+     END IF;
+
+     IF Z /= 5 THEN
+          FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 51");
+     END IF;
+
+     RESULT;
+END C83025C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83027a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83027a.ada
new file mode 100644
index 000000000..ba7c12386
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83027a.ada
@@ -0,0 +1,188 @@
+-- C83027A.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 A RECORD DECLARATION HIDES AN OUTER
+--     DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE OUTER DECLARATION
+--     IS DIRECTLY VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE
+--     DECLARATION OF THE INNER HOMOGRAPH AND THE OUTER DECLARATION IS
+--     VISIBLE BY SELECTION AFTER THE INNER HOMOGRAPH DECLARATION.
+
+-- HISTORY:
+--     BCB 09/02/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83027A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          X : T;
+     FUNCTION GEN_FUN RETURN T;
+
+     FUNCTION GEN_FUN RETURN T IS
+     BEGIN
+          RETURN X;
+     END GEN_FUN;
+
+BEGIN
+     TEST ("C83027A", "CHECK THAT A DECLARATION IN A RECORD " &
+                      "DECLARATION HIDES AN OUTER DECLARATION OF " &
+                      "A HOMOGRAPH");
+
+     ONE:
+     DECLARE
+          A : INTEGER := IDENT_INT(2);
+          OBJ : INTEGER := IDENT_INT(3);
+
+          TYPE INNER2 (A : INTEGER := IDENT_INT(3)) IS RECORD
+               C : INTEGER := ONE.A;
+               D : INTEGER := A;
+          END RECORD;
+
+          E : INTEGER := A;
+
+          RECVAR : INNER2;
+
+     BEGIN  -- ONE
+          IF A /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 1");
+          END IF;
+
+          IF RECVAR.A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 2");
+          END IF;
+
+          IF E /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+          END IF;
+
+          IF RECVAR.C /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+          END IF;
+
+          IF RECVAR.D /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 5");
+          END IF;
+
+          IF EQUAL(1,1) THEN
+               OBJ := RECVAR.A;
+          ELSE
+               OBJ := 1;
+          END IF;
+
+          IF OBJ /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 6");
+          END IF;
+     END ONE;
+
+     TWO:
+     DECLARE
+
+          GENERIC
+               A : INTEGER := IDENT_INT(2);
+               B : INTEGER := A;
+          PACKAGE P IS
+               TYPE INNER (C : INTEGER := A;
+                           A : INTEGER := IDENT_INT(3)) IS RECORD
+                    D : INTEGER := A;
+               END RECORD;
+          END P;
+
+          PACKAGE BODY P IS
+               RECVAR : INNER;
+          BEGIN
+               IF RECVAR.A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
+               END IF;
+
+               IF A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+               END IF;
+
+               IF B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+               END IF;
+
+               IF RECVAR.C /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+               END IF;
+
+               IF RECVAR.D /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 14");
+               END IF;
+          END P;
+
+          PACKAGE PACK IS NEW P;
+
+     BEGIN  -- TWO
+          NULL;
+     END TWO;
+
+     THREE:
+     DECLARE
+          A : INTEGER := IDENT_INT(2);
+          OBJ : INTEGER := IDENT_INT(3);
+
+          TYPE INNER4 (C : INTEGER := A;
+                       A : INTEGER := IDENT_INT(3);
+                       X : INTEGER := THREE.A) IS RECORD
+               D : INTEGER := A;
+          END RECORD;
+
+          RECVAR : INNER4;
+
+     BEGIN  -- THREE
+          IF A /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 20");
+          END IF;
+
+          IF RECVAR.A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 21");
+          END IF;
+
+          IF RECVAR.C /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 22");
+          END IF;
+
+          IF RECVAR.D /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
+          END IF;
+
+          IF RECVAR.X /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 24");
+          END IF;
+
+          IF EQUAL(1,1) THEN
+               OBJ := RECVAR.A;
+          ELSE
+               OBJ := 1;
+          END IF;
+
+          IF OBJ /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 25");
+          END IF;
+     END THREE;
+
+     RESULT;
+END C83027A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83027c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83027c.ada
new file mode 100644
index 000000000..2950135d1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83027c.ada
@@ -0,0 +1,157 @@
+-- C83027C.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 WITHIN THE DISCRIMINANT PART OF A
+--     PRIVATE TYPE DECLARATION, AN INCOMPLETE TYPE DECLARATION, AND A
+--     GENERIC FORMAL TYPE DECLARATION HIDES AN OUTER DECLARATION OF A
+--     HOMOGRAPH.  ALSO, CHECK THAT THE OUTER DECLARATION IS DIRECTLY
+--     VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE
+--     INNER HOMOGRAPH AND THE OUTER DECLARATION IS VISIBLE BY SELECTION
+--     AFTER THE INNER HOMOGRAPH DECLARATION.
+
+-- HISTORY:
+--     BCB 09/06/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83027C IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          X : T;
+     FUNCTION GEN_FUN RETURN T;
+
+     FUNCTION GEN_FUN RETURN T IS
+     BEGIN
+          RETURN X;
+     END GEN_FUN;
+
+BEGIN
+     TEST ("C83027C", "CHECK THAT A DECLARATION IN THE DISCRIMINANT " &
+                      "PART OF A PRIVATE TYPE DECLARATION, AN " &
+                      "INCOMPLETE TYPE DECLARATION, AND A GENERIC " &
+                      "FORMAL TYPE DECLARATION HIDES AN OUTER " &
+                      "DECLARATION OF A HOMOGRAPH");
+
+     ONE:
+     DECLARE
+          A : INTEGER := IDENT_INT(2);
+
+          D : INTEGER := IDENT_INT(2);
+
+          G : INTEGER := IDENT_INT(2);
+          H : INTEGER := G;
+
+          TYPE REC (Z : INTEGER) IS RECORD
+               NULL;
+          END RECORD;
+
+          GENERIC
+               TYPE INNER3 (G : INTEGER) IS PRIVATE;
+          PACKAGE P_ONE IS
+               TYPE INNER (X : INTEGER := A;
+                           A : INTEGER := IDENT_INT(3);
+                           C : INTEGER := ONE.A) IS PRIVATE;
+               TYPE INNER2 (Y : INTEGER := D;
+                            D : INTEGER := IDENT_INT(3);
+                            F : INTEGER := ONE.D);
+               TYPE INNER2 (Y : INTEGER := D;
+                            D : INTEGER := IDENT_INT(3);
+                            F : INTEGER := ONE.D) IS RECORD
+                    E : INTEGER := D;
+               END RECORD;
+          PRIVATE
+               TYPE INNER (X : INTEGER := A;
+                           A : INTEGER := IDENT_INT(3);
+                           C : INTEGER := ONE.A) IS RECORD
+                    B : INTEGER := A;
+               END RECORD;
+          END P_ONE;
+
+          PACKAGE BODY P_ONE IS
+               RECVAR : INNER;
+               RECVAR2 : INNER2;
+               RECVAR3 : INNER3(3);
+          BEGIN
+               IF RECVAR.A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+               END IF;
+
+               IF A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+               END IF;
+
+               IF RECVAR.B /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 3");
+               END IF;
+
+               IF RECVAR.C /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+               END IF;
+
+               IF RECVAR.X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 5");
+               END IF;
+
+               IF RECVAR2.D /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 6");
+               END IF;
+
+               IF D /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 7");
+               END IF;
+
+               IF RECVAR2.E /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 8");
+               END IF;
+
+               IF RECVAR2.F /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 9");
+               END IF;
+
+               IF RECVAR2.Y /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 10");
+               END IF;
+
+               IF RECVAR3.G /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 11");
+               END IF;
+
+               IF G /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 12");
+               END IF;
+
+               IF H /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 13");
+               END IF;
+          END P_ONE;
+
+          PACKAGE NEW_P_ONE IS NEW P_ONE (REC);
+
+     BEGIN  -- ONE
+          NULL;
+     END ONE;
+
+     RESULT;
+END C83027C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83028a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83028a.ada
new file mode 100644
index 000000000..7aa7af033
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83028a.ada
@@ -0,0 +1,156 @@
+-- C83028A.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 A BLOCK STATEMENT HIDES AN OUTER
+--     DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE OUTER DECLARATION
+--     IS DIRECTLY VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE
+--     DECLARATION OF THE INNER HOMOGRAPH AND THE OUTER DECLARATION IS
+--     VISIBLE BY SELECTION AFTER THE INNER HOMOGRAPH DECLARATION.
+
+-- HISTORY:
+--     BCB 09/06/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83028A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          X : T;
+     FUNCTION GEN_FUN RETURN T;
+
+     FUNCTION GEN_FUN RETURN T IS
+     BEGIN
+          RETURN X;
+     END GEN_FUN;
+
+BEGIN
+     TEST ("C83028A", "CHECK THAT A DECLARATION IN A BLOCK " &
+                      "STATEMENT HIDES AN OUTER " &
+                      "DECLARATION OF A HOMOGRAPH");
+
+     ONE:
+     DECLARE
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+
+     BEGIN  -- ONE
+          DECLARE
+               C : INTEGER := A;
+               A : INTEGER := IDENT_INT(3);
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+               END IF;
+
+               IF ONE.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+               END IF;
+
+               IF ONE.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+               END IF;
+
+               IF C /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+               END IF;
+
+               IF EQUAL(1,1) THEN
+                    ONE.A := A;
+               END IF;
+          END;
+
+          IF A /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 6");
+          END IF;
+     END ONE;
+
+     TWO:
+     DECLARE
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+          OBJ : INTEGER := IDENT_INT(3);
+
+     BEGIN  -- TWO
+          DECLARE
+               X : INTEGER := A;
+               A : INTEGER := OBJ;
+               C : INTEGER := A;
+          BEGIN
+               IF A /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
+               END IF;
+
+               IF TWO.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
+               END IF;
+
+               IF TWO.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
+               END IF;
+
+               IF C /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
+               END IF;
+
+               IF X /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE PASSED IN - 14");
+               END IF;
+
+               IF EQUAL(1,1) THEN
+                    TWO.OBJ := IDENT_INT(4);
+               ELSE
+                    TWO.OBJ := 1;
+               END IF;
+          END;
+
+          IF OBJ /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 15");
+          END IF;
+     END TWO;
+
+     THREE:
+     DECLARE                 --  OVERLOADING OF FUNCTIONS.
+
+          OBJ : INTEGER := 1;
+          FLO : FLOAT := 5.0;
+
+          FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+
+          FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+
+     BEGIN
+          DECLARE
+               F : FLOAT := 6.25;
+          BEGIN
+               THREE.OBJ := INTEGER(F);
+          END;
+
+          IF OBJ /= IDENT_INT(6) THEN
+               FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 20");
+          END IF;
+     END THREE;
+
+     RESULT;
+END C83028A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83029a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83029a.ada
new file mode 100644
index 000000000..1460a5317
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83029a.ada
@@ -0,0 +1,110 @@
+-- C83029A.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 LOOP PARAMETER HIDES AN OUTER DECLARATION OF A
+--     HOMOGRAPH. ALSO CHECK THAT THE OUTER DECLARATION IS DIRECTLY
+--     VISIBLE IN BOTH DECLARATIVE REGIONS BEFORE THE DECLARATION OF
+--     THE INNER HOMOGRAPH AND THE OUTER DECLARATION IS VISIBLE BY
+--     SELECTION AFTER THE INNER HOMOGRAPH DECLARATION.
+
+-- HISTORY:
+--     BCB 09/06/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83029A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          X : T;
+     FUNCTION GEN_FUN RETURN T;
+
+     FUNCTION GEN_FUN RETURN T IS
+     BEGIN
+          RETURN X;
+     END GEN_FUN;
+
+BEGIN
+     TEST ("C83029A", "CHECK THAT A LOOP PARAMETER HIDES AN OUTER " &
+                      "DECLARATION OF A HOMOGRAPH");
+
+     ONE:
+     DECLARE
+          A : INTEGER := IDENT_INT(2);
+          B : INTEGER := A;
+          C : INTEGER;
+
+     BEGIN  -- ONE
+
+          FOR A IN 1 .. 1 LOOP
+               C := A;
+
+               IF A /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
+               END IF;
+
+               IF ONE.A /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
+               END IF;
+
+               IF ONE.B /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
+               END IF;
+
+               IF C /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
+               END IF;
+
+               IF EQUAL(1,1) THEN
+                    ONE.A := A;
+               END IF;
+          END LOOP;
+
+          IF A /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE PASSED OUT - 6");
+          END IF;
+     END ONE;
+
+     TWO:
+     DECLARE                 --  OVERLOADING OF FUNCTIONS.
+
+          OBJ : INTEGER := 1;
+          FLO : FLOAT := 5.0;
+
+          FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
+
+          FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
+
+     BEGIN
+          FOR F IN 1 .. 1 LOOP
+               OBJ := INTEGER(F);
+          END LOOP;
+
+          IF OBJ /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE RETURNED - 10");
+          END IF;
+     END TWO;
+
+     RESULT;
+END C83029A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83030a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83030a.ada
new file mode 100644
index 000000000..d992f7b28
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83030a.ada
@@ -0,0 +1,234 @@
+-- C83030A.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 BODY, NO SUBPROGRAM
+--     DECLARED IN AN OUTER DECLARATIVE REGION IS HIDDEN (UNLESS THE
+--     SUBPROGRAM IS A HOMOGRAPH OF THE GENERIC SUBPROGRAM).
+
+-- HISTORY:
+--     TBN 08/03/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83030A IS
+
+     GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
+     SWITCH1 : BOOLEAN := TRUE;
+
+     PROCEDURE P IS
+     BEGIN
+          GLOBAL := IDENT_INT(1);
+     END P;
+
+     PROCEDURE P (X : INTEGER) IS
+     BEGIN
+          GLOBAL := IDENT_INT(X);
+     END P;
+
+BEGIN
+     TEST ("C83030A", "CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY, " &
+                      "NO SUBPROGRAM DECLARED IN AN OUTER " &
+                      "DECLARATIVE REGION IS HIDDEN " &
+                      "(UNLESS THE SUBPROGRAM IS A HOMOGRAPH OF THE " &
+                      "GENERIC SUBPROGRAM)");
+
+     ONE:
+     DECLARE
+          GENERIC
+          PROCEDURE P;
+
+          PROCEDURE P IS
+               A : INTEGER := IDENT_INT(2);
+          BEGIN
+               IF SWITCH1 THEN
+                    SWITCH1 := FALSE;
+                    P;
+                    IF GLOBAL /= IDENT_INT(3) THEN
+                         FAILED ("INCORRECT VALUE FOR PROCEDURE CALL " &
+                                 "- 1");
+                    END IF;
+               END IF;
+               P(A);
+               IF GLOBAL /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 2");
+               END IF;
+               GLOBAL := IDENT_INT(3);
+          END P;
+
+          PROCEDURE NEW_P IS NEW P;
+
+     BEGIN
+          IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
+               FAILED ("INCORRECT VALUE FOR START OF TEST ONE");
+          END IF;
+          NEW_P;
+          IF GLOBAL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR END OF TEST ONE");
+          END IF;
+     END ONE;
+
+
+     TWO:
+     DECLARE
+          GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
+          SWITCH : BOOLEAN := TRUE;
+
+          GENERIC
+               TYPE T IS (<>);
+          PROCEDURE P (X : T);
+
+          PROCEDURE P (X : T) IS
+               A : T := T'FIRST;
+          BEGIN
+               IF SWITCH THEN
+                    SWITCH := FALSE;
+                    P (X);
+                    IF GLOBAL /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT VALUE FOR PROCEDURE CALL " &
+                                 "- 20");
+                    END IF;
+                    GLOBAL := IDENT_INT(3);
+               ELSE
+                    GLOBAL := IDENT_INT(2);
+               END IF;
+          END P;
+
+          PROCEDURE NEW_P IS NEW P (INTEGER);
+
+     BEGIN
+          IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
+               FAILED ("INCORRECT VALUE FOR START OF TEST TWO");
+          END IF;
+          NEW_P (1);
+          IF GLOBAL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR END OF TEST TWO");
+          END IF;
+     END TWO;
+
+
+     THREE:
+     DECLARE
+          SWITCH : BOOLEAN := TRUE;
+
+          FUNCTION F RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT(1);
+          END F;
+
+          FUNCTION F RETURN BOOLEAN IS
+          BEGIN
+               RETURN IDENT_BOOL(FALSE);
+          END F;
+
+          FUNCTION F (X : INTEGER) RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT(X);
+          END F;
+
+     BEGIN
+          DECLARE
+               GENERIC
+               FUNCTION F RETURN INTEGER;
+
+               FUNCTION F RETURN INTEGER IS
+                    A : INTEGER := INTEGER'LAST;
+               BEGIN
+                    IF SWITCH THEN
+                         SWITCH := FALSE;
+                         IF F /= IDENT_INT(3) THEN
+                              FAILED ("INCORRECT VALUE FROM FUNCTION " &
+                                      "CALL - 30");
+                         END IF;
+                    END IF;
+                    IF F(A) /= IDENT_INT(INTEGER'LAST) THEN
+                         FAILED ("INCORRECT VALUE FROM FUNCTION CALL " &
+                                 "- 31");
+                    END IF;
+                    IF F THEN
+                         FAILED ("INCORRECT VALUE FROM FUNCTION CALL " &
+                                 "- 32");
+                    END IF;
+                    RETURN IDENT_INT(3);
+               END F;
+
+               FUNCTION NEW_F IS NEW F;
+
+          BEGIN
+               IF NEW_F /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE FOR END OF TEST THREE");
+               END IF;
+          END;
+     END THREE;
+
+
+     FOUR:
+     DECLARE
+          SWITCH : BOOLEAN := TRUE;
+
+          FUNCTION F RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT(1);
+          END F;
+
+          FUNCTION F RETURN BOOLEAN IS
+          BEGIN
+               RETURN IDENT_BOOL(FALSE);
+          END F;
+
+     BEGIN
+          DECLARE
+               GENERIC
+                    TYPE T IS (<>);
+               FUNCTION F RETURN T;
+
+               FUNCTION F RETURN T IS
+                    A : T := T'LAST;
+               BEGIN
+                    IF SWITCH THEN
+                         SWITCH := FALSE;
+                         IF F /= T'LAST THEN
+                              FAILED ("INCORRECT VALUE FROM FUNCTION " &
+                                      "CALL - 40");
+                         END IF;
+                         RETURN T'FIRST;
+                    ELSE
+                         IF F THEN
+                              FAILED ("INCORRECT VALUE FROM FUNCTION " &
+                                      "CALL - 41");
+                         END IF;
+                         RETURN T'LAST;
+                    END IF;
+               END F;
+
+               FUNCTION NEW_F IS NEW F (INTEGER);
+
+          BEGIN
+               IF NEW_F /= IDENT_INT(INTEGER'FIRST) THEN
+                    FAILED ("INCORRECT VALUE FOR END OF TEST FOUR");
+               END IF;
+          END;
+     END FOUR;
+
+     RESULT;
+END C83030A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83030c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83030c.ada
new file mode 100644
index 000000000..914bd6465
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83030c.ada
@@ -0,0 +1,263 @@
+-- C83030C.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 BODY COMPILED AS A SUBUNIT
+--     IN THE SAME COMPILATION, NON-HOMOGRAPH SUBPROGRAMS DECLARED
+--     OUTSIDE THE GENERIC UNIT, AND HAVING THE SAME IDENTIFIER, ARE NOT
+--     HIDDEN.
+
+-- HISTORY:
+--     JET 10/17/88  CREATED ORIGINAL TEST.
+--     BCB 10/03/90  ADDED "PRAGMA ELABORATE (REPORT);".
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PACKAGE C83030C_DECL1 IS
+     GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
+     SWITCH : BOOLEAN := TRUE;
+
+     PROCEDURE C83030C_PROC1;
+     PROCEDURE C83030C_PROC1 (X : INTEGER);
+     PROCEDURE C83030C_PROC2;
+     PROCEDURE C83030C_PROC2 (X : INTEGER);
+     FUNCTION C83030C_FUNC3 RETURN INTEGER;
+     FUNCTION C83030C_FUNC3 RETURN BOOLEAN;
+     FUNCTION C83030C_FUNC3 (X : INTEGER) RETURN INTEGER;
+     FUNCTION C83030C_FUNC4 RETURN INTEGER;
+     FUNCTION C83030C_FUNC4 RETURN BOOLEAN;
+END C83030C_DECL1;
+
+WITH REPORT; USE REPORT;
+WITH C83030C_DECL1; USE C83030C_DECL1;
+PACKAGE C83030C_DECL2 IS
+     GENERIC
+     PROCEDURE C83030C_PROC1;
+
+     GENERIC
+          TYPE T IS (<>);
+     PROCEDURE C83030C_PROC2 (X : T);
+
+     GENERIC
+     FUNCTION C83030C_FUNC3 RETURN INTEGER;
+
+     GENERIC
+          TYPE T IS (<>);
+     FUNCTION C83030C_FUNC4 RETURN T;
+END C83030C_DECL2;
+
+WITH REPORT; USE REPORT;
+PACKAGE BODY C83030C_DECL1 IS
+     PROCEDURE C83030C_PROC1 IS
+     BEGIN
+          GLOBAL := IDENT_INT(1);
+     END C83030C_PROC1;
+
+     PROCEDURE C83030C_PROC1 (X : INTEGER) IS
+     BEGIN
+          GLOBAL := IDENT_INT(X);
+     END C83030C_PROC1;
+
+     PROCEDURE C83030C_PROC2 IS
+     BEGIN
+          GLOBAL := IDENT_INT(1);
+     END C83030C_PROC2;
+
+     PROCEDURE C83030C_PROC2 (X : INTEGER) IS
+     BEGIN
+          GLOBAL := IDENT_INT(X);
+     END C83030C_PROC2;
+
+     FUNCTION C83030C_FUNC3 RETURN INTEGER IS
+     BEGIN
+          RETURN IDENT_INT(1);
+     END C83030C_FUNC3;
+
+     FUNCTION C83030C_FUNC3 RETURN BOOLEAN IS
+     BEGIN
+          RETURN IDENT_BOOL(FALSE);
+     END C83030C_FUNC3;
+
+     FUNCTION C83030C_FUNC3 (X : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN IDENT_INT(X);
+     END C83030C_FUNC3;
+
+     FUNCTION C83030C_FUNC4 RETURN INTEGER IS
+     BEGIN
+          RETURN IDENT_INT(1);
+     END C83030C_FUNC4;
+
+     FUNCTION C83030C_FUNC4 RETURN BOOLEAN IS
+     BEGIN
+          RETURN IDENT_BOOL(FALSE);
+     END C83030C_FUNC4;
+END C83030C_DECL1;
+
+WITH REPORT; USE REPORT;
+WITH C83030C_DECL1; USE C83030C_DECL1;
+PACKAGE BODY C83030C_DECL2 IS
+     PROCEDURE C83030C_PROC1 IS SEPARATE;
+     PROCEDURE C83030C_PROC2 (X : T) IS SEPARATE;
+     FUNCTION C83030C_FUNC3 RETURN INTEGER IS SEPARATE;
+     FUNCTION C83030C_FUNC4 RETURN T IS SEPARATE;
+END C83030C_DECL2;
+
+SEPARATE (C83030C_DECL2)
+PROCEDURE C83030C_PROC1 IS
+     A : INTEGER := IDENT_INT(2);
+BEGIN
+     IF SWITCH THEN
+          SWITCH := FALSE;
+          C83030C_PROC1;
+          IF GLOBAL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 1");
+          END IF;
+     END IF;
+     C83030C_PROC1(A);
+     IF GLOBAL /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 2");
+     END IF;
+     GLOBAL := IDENT_INT(3);
+END C83030C_PROC1;
+
+SEPARATE (C83030C_DECL2)
+PROCEDURE C83030C_PROC2 (X : T) IS
+     A : T := T'FIRST;
+BEGIN
+     IF SWITCH THEN
+          SWITCH := FALSE;
+          C83030C_PROC2 (X);
+          IF GLOBAL /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 20");
+          END IF;
+          GLOBAL := IDENT_INT(3);
+     ELSE
+          GLOBAL := IDENT_INT(2);
+     END IF;
+END C83030C_PROC2;
+
+SEPARATE (C83030C_DECL2)
+FUNCTION C83030C_FUNC3 RETURN INTEGER IS
+     A : INTEGER := INTEGER'LAST;
+BEGIN
+     IF SWITCH THEN
+          SWITCH := FALSE;
+          IF C83030C_FUNC3 /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 30");
+          END IF;
+     END IF;
+     IF C83030C_FUNC3(A) /= IDENT_INT(INTEGER'LAST) THEN
+          FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 31");
+     END IF;
+     IF C83030C_FUNC3 THEN
+          FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 32");
+     END IF;
+     RETURN IDENT_INT(3);
+END C83030C_FUNC3;
+
+SEPARATE (C83030C_DECL2)
+FUNCTION C83030C_FUNC4 RETURN T IS
+     A : T := T'LAST;
+BEGIN
+     IF SWITCH THEN
+          SWITCH := FALSE;
+          IF C83030C_FUNC4 /= T'LAST THEN
+               FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 40");
+          END IF;
+          RETURN T'FIRST;
+     ELSE
+          IF C83030C_FUNC4 THEN
+               FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 41");
+          END IF;
+          RETURN T'LAST;
+     END IF;
+END C83030C_FUNC4;
+
+WITH REPORT; USE REPORT;
+WITH C83030C_DECL1, C83030C_DECL2; USE C83030C_DECL1, C83030C_DECL2;
+PROCEDURE C83030C IS
+BEGIN
+     TEST ("C83030C", "CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY " &
+                      "COMPILED AS A SUBUNIT IN THE SAME COMPILATION," &
+                      " NON-HOMOGRAPH SUBPROGRAMS DECLARED OUTSIDE " &
+                      "THE GENERIC UNIT, AND HAVING THE SAME " &
+                      "IDENTIFIER, ARE NOT HIDDEN");
+
+     ONE:
+     DECLARE
+          PROCEDURE PROC1 IS NEW C83030C_DECL2.C83030C_PROC1;
+     BEGIN
+          IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
+               FAILED ("INCORRECT VALUE FOR START OF TEST ONE");
+          END IF;
+          PROC1;
+          IF GLOBAL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR END OF TEST ONE");
+          END IF;
+
+          GLOBAL := IDENT_INT(INTEGER'FIRST);
+          SWITCH := TRUE;
+     END ONE;
+
+     TWO:
+     DECLARE
+          PROCEDURE PROC2 IS NEW C83030C_DECL2.C83030C_PROC2(INTEGER);
+     BEGIN
+          IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
+               FAILED ("INCORRECT VALUE FOR START OF TEST TWO");
+          END IF;
+          PROC2 (1);
+          IF GLOBAL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR END OF TEST TWO");
+          END IF;
+
+          SWITCH := TRUE;
+     END TWO;
+
+     THREE:
+     DECLARE
+          FUNCTION FUNC3 IS NEW C83030C_DECL2.C83030C_FUNC3;
+     BEGIN
+          IF FUNC3 /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE FOR END OF TEST THREE");
+          END IF;
+
+          SWITCH := TRUE;
+     END THREE;
+
+     FOUR:
+     DECLARE
+          FUNCTION FUNC4 IS NEW C83030C_DECL2.C83030C_FUNC4 (INTEGER);
+     BEGIN
+          IF FUNC4 /= IDENT_INT(INTEGER'FIRST) THEN
+               FAILED ("INCORRECT VALUE FOR END OF TEST FOUR");
+          END IF;
+
+          GLOBAL := INTEGER'FIRST;
+          SWITCH := TRUE;
+     END FOUR;
+
+     RESULT;
+END C83030C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83031a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83031a.ada
new file mode 100644
index 000000000..13b90bbc5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83031a.ada
@@ -0,0 +1,163 @@
+-- C83031A.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 IMPLICIT DECLARATION OF A PREDEFINED OPERATOR OR
+--     AN ENUMERATION LITERAL IS HIDDEN BY A SUBPROGRAM DECLARATION OR
+--     A RENAMING DECLARATION WHICH DECLARES A HOMOGRAPH OF THE
+--     OPERATOR OR LITERAL.
+
+-- HISTORY:
+--     VCL  08/10/88  CREATED ORIGINAL TEST.
+--     JRL  03/20/92  ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C83031A IS
+BEGIN
+     TEST ("C83031A", "AN IMPLICIT DECLARATION OF A PREDEFINED " &
+                      "OPERATOR OR AN ENUMERATION LITERAL IS HIDDEN " &
+                      "BY A SUBPROGRAM DECLARATION OR A RENAMING " &
+                      "DECLARATION WHICH DECLARES A HOMOGRAPH OF THE " &
+                      "OPERATOR OR LITERAL");
+
+     DECLARE             -- CHECK SUBPROGRAM DECLARATIONS OF OPERATORS
+          PACKAGE P IS
+               TYPE INT IS RANGE -20 .. 20;
+
+               M : INT := 3 * INT(IDENT_INT(3));
+               N : INT := 4 + INT(IDENT_INT(4));
+
+               FUNCTION "*" (LEFT, RIGHT : INT) RETURN INT;
+               TYPE INT2 IS PRIVATE;
+               FUNCTION "+" (LEFT, RIGHT : INT2) RETURN INT2;
+          PRIVATE
+               FUNCTION "+" (LEFT, RIGHT : INT) RETURN INT
+                            RENAMES "/" ;
+
+               TYPE INT2 IS RANGE -20 .. 20;
+          END P;
+          USE P;
+
+          PACKAGE BODY P IS
+               FUNCTION "*" (LEFT, RIGHT : INT) RETURN INT IS
+               BEGIN
+                    RETURN LEFT / RIGHT;
+               END "*";
+
+               FUNCTION "+" (LEFT, RIGHT : INT2) RETURN INT2 IS
+               BEGIN
+                    RETURN LEFT - RIGHT;
+               END "+";
+
+          BEGIN
+               IF 2 * INT(IDENT_INT(2)) /= 1 THEN
+                    FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
+                            "EXPLICIT '*' OPERATOR - 1");
+               END IF;
+
+               IF N /= 8 THEN
+                    FAILED ("INCORRECT INITIAL VALUE FOR N - 1");
+               END IF;
+               N := 2 + 2;
+               IF N /= INT(IDENT_INT (1)) THEN
+               FAILED ("INCORRECT VALUE FOR N AFTER CALL TO " &
+                       "EXPLICIT '+' OPERATOR - 1");
+               END IF;
+
+               DECLARE
+                    Q : INT2 := 8 + 9;
+               BEGIN
+                    IF Q /= -1 THEN
+                         FAILED ("INCORRECT VALUE FOR Q");
+                    END IF;
+               END;
+          END P;
+     BEGIN
+          IF M /= 9 THEN
+               FAILED ("INCORRECT INITIAL VALUE FOR M - 2");
+          END IF;
+          IF 2 * INT(IDENT_INT(2)) /= 1 THEN
+               FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
+                       "EXPLICIT '*' OPERATOR - 2");
+          END IF;
+
+          N := 2 + 2;
+          IF N /= INT(IDENT_INT (4)) THEN
+               FAILED ("INCORRECT VALUE FOR N AFTER CALL TO " &
+                       "IMPLICIT '+' OPERATOR - 2");
+          END IF;
+
+     END;
+
+     DECLARE   -- CHECK SUBPROGRAM DECLARATIONS OF ENUMERATION LITERALS.
+
+          PACKAGE P1 IS
+               TYPE ENUM1 IS (E11, E12, E13);
+               TYPE PRIV1 IS PRIVATE;
+               FUNCTION E11 RETURN PRIV1;
+          PRIVATE
+               TYPE PRIV1 IS NEW ENUM1;
+               FUNCTION E12 RETURN PRIV1 RENAMES E13;
+          END P1;
+          USE P1;
+
+          E13 : INTEGER := IDENT_INT (5);
+
+          FUNCTION E12 RETURN ENUM1 RENAMES E11 ;
+
+          FUNCTION CHECK (E: ENUM1) RETURN INTEGER IS
+          BEGIN
+               RETURN ENUM1'POS (E);
+          END CHECK;
+
+          FUNCTION CHECK (E: INTEGER) RETURN INTEGER IS
+          BEGIN
+               RETURN INTEGER'POS (E);
+          END CHECK;
+
+          PACKAGE BODY P1 IS
+               FUNCTION E11 RETURN PRIV1 IS
+               BEGIN
+                    RETURN E13;
+               END E11;
+          BEGIN
+               IF PRIV1'(E11) /= E13 THEN
+                    FAILED ("INCORRECT VALUE FOR E11");
+               END IF;
+
+               IF E12 /= PRIV1'LAST THEN
+                    FAILED ("INCORRECT VALUE FOR E12 - 1");
+               END IF;
+          END P1;
+     BEGIN
+          IF E12 /= ENUM1'FIRST THEN
+               FAILED ("INCORRECT VALUE FOR E12 - 2");
+          END IF;
+
+          IF CHECK (E13) /= 5 THEN
+               FAILED ("INCORRECT VALUE FOR E13");
+          END IF;
+     END;
+     RESULT;
+END C83031A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83031c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83031c.ada
new file mode 100644
index 000000000..1327a2546
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83031c.ada
@@ -0,0 +1,101 @@
+-- C83031C.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 IMPLICIT DECLARATION OF A PREDEFINED OPERATOR OR
+--     ENUMERATION LITERAL IS HIDDEN BY A GENERIC INSTANTIATION WHICH
+--     DECLARES A HOMOGRAPH OF THE OPERATOR OR LITERAL.
+
+-- HISTORY:
+--     BCB 09/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83031C IS
+
+BEGIN
+     TEST ("C83031C", "CHECK THAT AN IMPLICIT DECLARATION OF A " &
+                      "PREDEFINED OPERATOR OR ENUMERATION LITERAL IS " &
+                      "HIDDEN BY A GENERIC INSTANTIATION WHICH " &
+                      "DECLARES A HOMOGRAPH OF THE OPERATOR OR " &
+                      "LITERAL");
+
+     DECLARE             -- CHECK SUBPROGRAM DECLARATIONS OF OPERATORS
+          PACKAGE P IS
+               TYPE INT IS RANGE -20 .. 20;
+
+               GENERIC
+                    TYPE X IS RANGE <>;
+               FUNCTION GEN_FUN (LEFT, RIGHT : X) RETURN X;
+          END P;
+          USE P;
+
+          PACKAGE BODY P IS
+               FUNCTION GEN_FUN (LEFT, RIGHT : X) RETURN X IS
+               BEGIN
+                    RETURN LEFT / RIGHT;
+               END GEN_FUN;
+
+               FUNCTION "*" IS NEW GEN_FUN (INT);
+          BEGIN
+               IF 2 * INT(IDENT_INT(2)) /= 1 THEN
+                    FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
+                            "EXPLICIT '*' OPERATOR - 1");
+               END IF;
+          END P;
+     BEGIN
+          NULL;
+     END;
+
+     DECLARE   -- CHECK SUBPROGRAM DECLARATIONS OF ENUMERATION LITERALS.
+
+          PACKAGE P1 IS
+               TYPE ENUM1 IS (E11, E12, E13);
+               TYPE PRIV1 IS PRIVATE;
+
+               GENERIC
+                    TYPE X IS (<>);
+               FUNCTION GEN_FUN RETURN X;
+          PRIVATE
+               TYPE PRIV1 IS NEW ENUM1;
+          END P1;
+          USE P1;
+
+          PACKAGE BODY P1 IS
+               FUNCTION GEN_FUN RETURN X IS
+               BEGIN
+                    RETURN X'LAST;
+               END GEN_FUN;
+
+               FUNCTION E11 IS NEW GEN_FUN (PRIV1);
+          BEGIN
+               IF PRIV1'(E11) /= E13 THEN
+                    FAILED ("INCORRECT VALUE FOR E11");
+               END IF;
+          END P1;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C83031C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83031e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83031e.ada
new file mode 100644
index 000000000..7742678af
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83031e.ada
@@ -0,0 +1,70 @@
+-- C83031E.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 IMPLICIT DECLARATION OF A PREDEFINED OPERATOR IS
+--     HIDDEN BY A GENERIC FORMAL SUBPROGRAM DECLARATION WHICH DECLARES
+--     A HOMOGRAPH OF THE OPERATOR.
+
+-- HISTORY:
+--     BCB 09/19/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C83031E IS
+
+BEGIN
+     TEST ("C83031E", "CHECK THAT AN IMPLICIT DECLARATION OF A " &
+                      "PREDEFINED OPERATOR IS HIDDEN BY A GENERIC " &
+                      "FORMAL SUBPROGRAM DECLARATION WHICH DECLARES " &
+                      "A HOMOGRAPH OF THE OPERATOR");
+
+     DECLARE             -- CHECK SUBPROGRAM DECLARATIONS OF OPERATORS
+          TYPE INT IS RANGE -20 .. 20;
+
+          GENERIC
+               WITH FUNCTION "*" (LEFT, RIGHT : INT) RETURN INT;
+          PACKAGE P IS
+          END P;
+
+          PACKAGE BODY P IS
+          BEGIN
+               IF 2 * INT(IDENT_INT(2)) /= 1 THEN
+                    FAILED ("INCORRECT VALUE RETURNED IN CALL TO " &
+                            "EXPLICIT '*' OPERATOR - 1");
+               END IF;
+          END P;
+
+          FUNCTION MULT (X, Y : INT) RETURN INT IS
+          BEGIN
+               RETURN X / Y;
+          END MULT;
+
+          PACKAGE NEW_P IS NEW P (MULT);
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C83031E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83032a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83032a.ada
new file mode 100644
index 000000000..b1920ee21
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83032a.ada
@@ -0,0 +1,111 @@
+-- C83032A.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 IMPLICIT DECLARATION OF A PREDEFINED OPERATOR OR
+--     AN ENUMERATION LITERAL IS HIDDEN BY A DERIVED SUBPROGRAM
+--     HOMOGRAPH.
+
+-- HISTORY:
+--     VCL  08/10/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83032A IS
+BEGIN
+     TEST ("C83032A", "AN IMPLICIT DECLARATION OF A PREDEFINED " &
+                      "OPERATOR OR AN ENUMERATION LITERAL IS HIDDEN " &
+                      "BY A DERIVED SUBPROGRAM HOMOGRAPH");
+
+     DECLARE             -- CHECK PREDEFINED OPERATOR.
+          PACKAGE P IS
+               TYPE INT IS RANGE -20 .. 20;
+               FUNCTION "ABS" (X : INT) RETURN INT;
+          END P;
+          USE P;
+
+          TYPE NINT IS NEW INT;
+
+          I2 : NINT := -5;
+
+          PACKAGE BODY P IS
+               I1 : NINT := 5;
+
+               FUNCTION "ABS" (X : INT) RETURN INT IS
+               BEGIN
+                    RETURN INT (- (ABS (INTEGER (X))));
+               END "ABS";
+
+          BEGIN
+               IF "ABS"(I1) /= -5 THEN
+                    FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
+                            "TO DERIVED ""ABS"" - 1");
+               END IF;
+
+               I1 := ABS (-10);
+               IF ABS I1 /= NINT(IDENT_INT (-10)) THEN
+                    FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
+                            "TO DERIVED ""ABS"" - 2");
+               END IF;
+          END P;
+     BEGIN
+          IF "ABS"(I2) /= -5 THEN
+               FAILED ("INCORRECT VALUE FOR 'I2' AFTER CALL " &
+                    "TO DERIVED ""ABS"" - 1");
+          END IF;
+
+          I2 := ABS (10);
+          IF ABS I2 /= NINT (IDENT_INT (-10)) THEN
+               FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
+                        "TO DERIVED ""ABS"" - 2");
+          END IF;
+     END;
+
+     DECLARE   -- CHECK ENUMERATION LITERALS.
+
+          PACKAGE P1 IS
+               TYPE ENUM1 IS (E11, E12, E13);
+               TYPE PRIV1 IS PRIVATE;
+               FUNCTION E11 RETURN PRIV1;
+          PRIVATE
+               TYPE PRIV1 IS NEW ENUM1;
+               TYPE NPRIV1 IS NEW PRIV1;
+          END P1;
+          USE P1;
+
+          PACKAGE BODY P1 IS
+               FUNCTION E11 RETURN PRIV1 IS
+               BEGIN
+                    RETURN E13;
+               END E11;
+          BEGIN
+               IF NPRIV1'(E11) /= E13 THEN
+                    FAILED ("INCORRECT VALUE FOR E11");
+               END IF;
+          END P1;
+
+     BEGIN
+          NULL;
+     END;
+     RESULT;
+END C83032A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83033a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83033a.ada
new file mode 100644
index 000000000..6cfca9326
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83033a.ada
@@ -0,0 +1,146 @@
+-- C83033A.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 IMPLICIT DECLARATION OF A BLOCK NAME, A LOOP NAME,
+--     OR A STATEMENT LABEL HIDES THE DECLARATION OF AN ENUMERATION
+--     LITERAL OR OF A DERIVED SUBPROGRAM DECLARED BY A DERIVED TYPE
+--     DEFINITION.
+
+-- HISTORY:
+--     DHH 09/21/88  CREATED ORIGINAL TEST.
+--     WMC 03/25/92  REMOVED TEST REDUNDANCIES.
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE C83033A IS
+
+     PACKAGE BASE_P IS
+          TYPE A IS (RED, BLUE, YELO);
+          FUNCTION RED(T : INTEGER; X : A) RETURN A;
+          FUNCTION BLUE(T : INTEGER; X : A) RETURN A;
+     END BASE_P;
+
+     PACKAGE BODY BASE_P IS
+          FUNCTION RED(T : INTEGER; X : A) RETURN A IS
+          BEGIN
+               IF EQUAL(T, T) THEN
+                    RETURN X;
+               ELSE
+                    RETURN YELO;
+               END IF;
+          END RED;
+
+          FUNCTION BLUE(T : INTEGER; X : A) RETURN A IS
+          BEGIN
+               IF EQUAL(T, T) THEN
+                    RETURN X;
+               ELSE
+                    RETURN YELO;
+               END IF;
+          END BLUE;
+
+     END BASE_P;
+BEGIN
+     TEST ("C83033A", "CHECK THAT AN IMPLICIT DECLARATION OF A BLOCK " &
+                      "NAME, A LOOP NAME, OR A STATEMENT LABEL HIDES " &
+                      "THE DECLARATION OF AN ENUMERATION LITERAL OR " &
+                      "OF A DERIVED SUBPROGRAM DECLARED BY A DERIVED " &
+                      "TYPE DEFINITION");
+
+     B1:
+     DECLARE
+          TYPE STMT2 IS NEW BASE_P.A;
+     BEGIN
+
+          DECLARE
+               C, D : STMT2;
+          BEGIN
+               C := C83033A.B1.RED(3, C83033A.B1.RED);
+               D := C83033A.B1.RED;
+
+               GOTO RED;              -- DEMONSTRATES USE OF STATEMENT LABEL.
+               FAILED("STATEMENT LABEL - 1");
+
+     <<RED>>   IF C /= D THEN
+                  FAILED("STATEMENT LABEL - 2");
+               END IF;
+          END;
+     END B1;
+
+     B2:
+     DECLARE
+          TYPE STMT2 IS NEW BASE_P.A;
+     BEGIN
+
+          DECLARE
+               A : STMT2 := BLUE;
+               B : STMT2 := BLUE(3, BLUE);
+          BEGIN
+
+               BLUE:
+               FOR I IN 1 .. 1 LOOP
+                    IF A /= B THEN
+                         FAILED("LOOP NAME - 1");
+                    END IF;
+                    EXIT BLUE;                -- DEMONSTRATES USE OF LOOP LABEL.
+                    FAILED("LOOP NAME - 2");
+               END LOOP BLUE;
+          END;
+     END B2;
+
+     B4:
+     DECLARE
+          PACKAGE P IS
+               GLOBAL : INTEGER := 1;
+               TYPE ENUM IS (GREEN, BLUE);
+               TYPE PRIV IS PRIVATE;
+               FUNCTION GREEN RETURN PRIV;
+          PRIVATE
+               TYPE PRIV IS NEW ENUM;
+          END P;
+
+          PACKAGE BODY P IS
+               FUNCTION GREEN RETURN PRIV IS
+               BEGIN
+                    GLOBAL := GLOBAL + 1;
+                    RETURN BLUE;
+               END GREEN;
+          BEGIN
+               NULL;
+          END P;
+          USE P;
+     BEGIN
+          GREEN:
+          DECLARE
+               COLOR : PRIV := C83033A.B4.P.GREEN;
+          BEGIN
+               IF GREEN.COLOR /= C83033A.B4.P.GREEN OR ELSE GLOBAL /= 3 THEN
+                  FAILED("BLOCK NAME");
+               END IF;
+          END GREEN;
+     END B4;
+
+     RESULT;
+END C83033A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83051a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83051a.ada
new file mode 100644
index 000000000..0dc215260
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83051a.ada
@@ -0,0 +1,397 @@
+-- C83051A.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 DECLARATIONS IN THE VISIBLE PART OF A PACKAGE NESTED
+--     WITHIN THE VISIBLE PART OF A PACKAGE ARE VISIBLE BY SELECTION
+--     FROM OUTSIDE THE OUTERMOST PACKAGE.
+
+-- HISTORY:
+--     GMT 09/07/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C83051A IS
+
+BEGIN
+     TEST ("C83051A", "CHECK THAT DECLARATIONS IN THE VISIBLE " &
+                      "PART OF A PACKAGE NESTED WITHIN THE VISIBLE " &
+                      "PART OF A PACKAGE ARE VISIBLE BY SELECTION " &
+                      "FROM OUTSIDE THE OUTERMOST PACKAGE");
+     A_BLOCK:
+     DECLARE
+          PACKAGE APACK IS
+               PACKAGE BPACK  IS
+                    TYPE    T1  IS (RED,GREEN);
+                    TYPE    T2A IS ('A', 'B', 'C', 'D');
+                    TYPE    T3  IS NEW BOOLEAN;
+                    TYPE    T4  IS NEW INTEGER RANGE -3 .. 8;
+                    TYPE    T5  IS DIGITS 5;
+                    TYPE    T67 IS DELTA 0.5 RANGE -2.0 .. 10.0;
+                    TYPE    T9A IS ARRAY (INTEGER RANGE <>) OF T3;
+                    SUBTYPE T9B IS T9A (1..10);
+                    TYPE    T9C IS ACCESS T9B;
+                    TYPE    T10 IS PRIVATE;
+                    V1       : T3 := FALSE;
+                    ZERO     : CONSTANT T4 := 0;
+                    A_FLT    : T5 := 3.0;
+                    A_FIX    : T67 := -1.0;
+                    ARY      : T9A(1..4) := (TRUE,TRUE,TRUE,FALSE);
+                    P1 : T9C := NEW T9B'( 1..5  => T3'(TRUE),
+                                          6..10 => T3'(FALSE) );
+                    C1 : CONSTANT T10;
+
+                    FUNCTION RET_T1 (X : T1) RETURN T1;
+
+                    FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
+
+                    GENERIC
+                    PROCEDURE DO_NOTHING (X : IN OUT T3);
+               PRIVATE
+                    TYPE T10 IS NEW CHARACTER;
+                    C1 : CONSTANT T10 := 'J';
+               END BPACK;
+          END APACK;
+
+     PACKAGE BODY APACK IS
+          PACKAGE BODY BPACK IS
+               FUNCTION RET_T1 (X : T1) RETURN T1 IS
+               BEGIN
+                    IF X = RED THEN
+                         RETURN GREEN;
+                    ELSE
+                         RETURN RED;
+                    END IF;
+               END RET_T1;
+
+               FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
+               BEGIN
+                    RETURN T10(X);
+               END RET_CHAR;
+
+               PROCEDURE DO_NOTHING (X : IN OUT T3) IS
+               BEGIN
+                    IF X = TRUE THEN
+                         X := FALSE;
+                    ELSE
+                         X := TRUE;
+                    END IF;
+               END DO_NOTHING;
+          END BPACK;
+     END APACK;
+
+     PROCEDURE NEW_DO_NOTHING IS NEW APACK.BPACK.DO_NOTHING;
+
+     BEGIN
+
+          -- A1: VISIBILITY FOR UNOVERLOADED ENUMERATION LITERALS
+
+          IF  APACK.BPACK.">"(APACK.BPACK.RED, APACK.BPACK.GREEN) THEN
+               FAILED ("VISIBILITY FOR UNOVERLOADED ENUMERATION " &
+                       "LITERAL BAD - A1");
+          END IF;
+
+
+          -- A2: VISIBILITY FOR OVERLOADED
+          --     ENUMERATION CHARACTER LITERALS
+
+          IF  APACK.BPACK."<"(APACK.BPACK.T2A'(APACK.BPACK.'C'),
+                              APACK.BPACK.T2A'(APACK.BPACK.'B')) THEN
+               FAILED ("VISIBILITY FOR OVERLOADED ENUMERATION " &
+                       "LITERAL BAD - A2");
+          END IF;
+
+
+          -- A3: VISIBILITY FOR A DERIVED BOOLEAN TYPE
+
+          IF APACK.BPACK."<"(APACK.BPACK.T3'(APACK.BPACK.TRUE),
+                             APACK.BPACK.FALSE) THEN
+               FAILED ("VISIBILITY FOR DERIVED BOOLEAN BAD - A3");
+          END IF;
+
+
+          -- A4: VISIBILITY FOR AN INTEGER TYPE
+
+          IF APACK.BPACK."/="(APACK.BPACK."MOD"(6,2),APACK.BPACK.ZERO)
+               THEN FAILED ("VISIBILITY FOR INTEGER TYPE BAD - A4");
+          END IF;
+
+
+          -- A5: VISIBILITY FOR A FLOATING POINT TYPE
+
+          IF APACK.BPACK.">"(APACK.BPACK.T5'(2.7),APACK.BPACK.A_FLT)
+               THEN FAILED ("VISIBILITY FOR FLOATING POINT BAD - A5");
+          END IF;
+
+
+          -- A6: VISIBILITY FOR A FIXED POINT INVOLVING UNARY MINUS
+
+          IF APACK.BPACK."<"(APACK.BPACK.A_FIX,APACK.BPACK.T67'
+                            (APACK.BPACK."-"(1.5))) THEN
+               FAILED ("VISIBILITY FOR FIXED POINT WITH UNARY MINUS " &
+                       "BAD - A6");
+          END IF;
+
+
+          -- A7: VISIBILITY FOR A FIXED POINT DIVIDED BY INTEGER
+
+          IF APACK.BPACK."/="(APACK.BPACK.T67(-0.5),APACK.BPACK."/"
+                             (APACK.BPACK.A_FIX,2)) THEN
+               FAILED ("VISIBILITY FOR FIXED POINT DIVIDED BY " &
+                       "INTEGER BAD - A7");
+          END IF;
+
+
+          -- A8: VISIBILITY FOR ARRAY EQUALITY
+
+          IF APACK.BPACK."/="(APACK.BPACK.ARY,(APACK.BPACK.T3(TRUE),
+             APACK.BPACK.T3(TRUE),APACK.BPACK.T3(TRUE),
+             APACK.BPACK.T3(FALSE))) THEN
+               FAILED ("VISIBILITY FOR ARRAY EQUALITY BAD - A8");
+          END IF;
+
+
+          -- A9: VISIBILITY FOR ACCESS EQUALITY
+
+          IF APACK.BPACK."/="(APACK.BPACK.P1(3),
+                              APACK.BPACK.T3(IDENT_BOOL(TRUE)))
+               THEN FAILED ("VISIBILITY FOR ACCESS EQUALITY BAD - A9");
+          END IF;
+
+
+          -- A10: VISIBILITY FOR PRIVATE TYPE
+
+          IF APACK.BPACK."/="(APACK.BPACK.C1,
+                              APACK.BPACK.RET_CHAR('J')) THEN
+               FAILED ("VISIBILITY FOR PRIVATE TYPE BAD - A10");
+          END IF;
+
+
+          -- A11: VISIBILITY FOR DERIVED SUBPROGRAM
+
+          IF APACK.BPACK."/="(APACK.BPACK.RET_T1(APACK.BPACK.RED),
+                              APACK.BPACK.GREEN) THEN
+               FAILED ("VISIBILITY FOR DERIVED SUBPROGRAM BAD - A11");
+          END IF;
+
+          -- A12: VISIBILITY FOR GENERIC SUBPROGRAM
+
+          NEW_DO_NOTHING (APACK.BPACK.V1);
+
+          IF APACK.BPACK."/="(APACK.BPACK.V1,APACK.BPACK.T3(TRUE)) THEN
+               FAILED ("VISIBILITY FOR GENERIC SUBPROGRAM BAD - A12");
+          END IF;
+
+     END A_BLOCK;
+
+     B_BLOCK:
+     DECLARE
+          GENERIC
+               TYPE T1 IS (<>);
+          PACKAGE GENPACK IS
+               PACKAGE APACK IS
+                    PACKAGE BPACK  IS
+                         TYPE    T1  IS (ORANGE,GREEN);
+                         TYPE    T2A IS ('E', 'F', 'G');
+                         TYPE    T3  IS NEW BOOLEAN;
+                         TYPE    T4  IS NEW INTEGER RANGE -3 .. 8;
+                         TYPE    T5  IS DIGITS 5;
+                         TYPE    T67 IS DELTA 0.5 RANGE -3.0 .. 25.0;
+                         TYPE    T9A IS ARRAY (INTEGER RANGE <>) OF T3;
+                         SUBTYPE T9B IS T9A (2 .. 8);
+                         TYPE    T9C IS ACCESS T9B;
+                         TYPE    T10 IS PRIVATE;
+                         V1    : T3 := TRUE;
+                         SIX   : T4 := 6;
+                         B_FLT : T5 := 4.0;
+                         ARY   : T9A(1..4) := (TRUE,FALSE,TRUE,FALSE);
+                         P1    : T9C := NEW T9B'( 2..4 => T3'(FALSE),
+                                                  5..8 => T3'(TRUE));
+                         K1 : CONSTANT T10;
+
+                         FUNCTION RET_T1 (X : T1) RETURN T1;
+
+                         FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
+
+                         GENERIC
+                         PROCEDURE DO_NOTHING (X : IN OUT T3);
+                    PRIVATE
+                         TYPE T10 IS NEW CHARACTER;
+                         K1 : CONSTANT T10 := 'V';
+                    END BPACK;
+               END APACK;
+          END GENPACK;
+
+          PACKAGE BODY GENPACK IS
+               PACKAGE BODY APACK IS
+                    PACKAGE BODY BPACK IS
+                         FUNCTION RET_T1 (X : T1) RETURN T1 IS
+                         BEGIN
+                              IF X = ORANGE THEN
+                                   RETURN GREEN;
+                              ELSE
+                                   RETURN ORANGE;
+                              END IF;
+                         END RET_T1;
+
+                         FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
+                         BEGIN
+                              RETURN T10(X);
+                         END RET_CHAR;
+
+                         PROCEDURE DO_NOTHING (X : IN OUT T3) IS
+                         BEGIN
+                              IF X = TRUE THEN
+                                   X := FALSE;
+                              ELSE
+                                   X := TRUE;
+                              END IF;
+                         END DO_NOTHING;
+                    END BPACK;
+               END APACK;
+          END GENPACK;
+
+          PACKAGE MYPACK IS NEW GENPACK (T1 => INTEGER);
+
+          PROCEDURE MY_DO_NOTHING IS NEW MYPACK.APACK.BPACK.DO_NOTHING;
+
+     BEGIN
+
+          -- B1: GENERIC INSTANCE OF UNOVERLOADED ENUMERATION LITERAL
+
+          IF MYPACK.APACK.BPACK."<"(MYPACK.APACK.BPACK.GREEN,
+                                    MYPACK.APACK.BPACK.ORANGE) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
+                       "UNOVERLOADED ENUMERATION LITERAL BAD - B1");
+          END IF;
+
+
+          -- B2: GENERIC INSTANCE OF OVERLOADED ENUMERATION LITERAL
+
+          IF  MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T2A'(MYPACK.
+             APACK.BPACK.'F'),MYPACK.APACK.BPACK.T2A'(MYPACK.APACK.
+             BPACK.'G')) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
+                       "OVERLOADED ENUMERATION LITERAL BAD - B2");
+          END IF;
+
+
+          -- B3: VISIBILITY FOR GENERIC INSTANCE OF DERIVED BOOLEAN
+
+          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."NOT"(MYPACK.
+             APACK.BPACK.T3'(MYPACK.APACK.BPACK.TRUE)),MYPACK.APACK.
+             BPACK.FALSE) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
+                       "BOOLEAN BAD - B3");
+          END IF;
+
+
+          -- B4: VISIBILITY FOR GENERIC INSTANCE OF DERIVED INTEGER
+
+          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."MOD"(MYPACK.
+             APACK.BPACK.SIX,2),0) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF INTEGER " &
+                       "BAD - B4");
+          END IF;
+
+
+          -- B5: VISIBILITY FOR GENERIC INSTANCE OF FLOATING POINT
+
+          IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T5'(1.9),MYPACK.
+             APACK.BPACK.B_FLT) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FLOATING " &
+                       "POINT BAD - B5");
+          END IF;
+
+
+          -- B6: VISIBILITY FOR GENERIC INSTANCE OF
+          --     FIXED POINT UNARY PLUS
+
+          IF MYPACK.APACK.BPACK."<"(2.5,MYPACK.APACK.BPACK.T67'(MYPACK.
+             APACK.BPACK."+"(1.75))) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
+                       "POINT UNARY PLUS BAD - B6");
+          END IF;
+
+
+          -- B7: VISIBILITY FOR GENERIC INSTANCE OF
+          --     FIXED POINT DIVIDED BY INTEGER
+
+          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."/"(2.5,4),
+             0.625) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
+                       "POINT DIVIDED BY INTEGER BAD - B7");
+          END IF;
+
+
+          -- B8: VISIBILITY FOR GENERIC INSTANCE OF ARRAY EQUALITY
+
+          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.ARY,(MYPACK.
+             APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE),MYPACK.
+             APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE))) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ARRAY " &
+                       "EQUALITY BAD - B8");
+          END IF;
+
+
+          -- B9: VISIBILITY FOR GENERIC INSTANCE OF ACCESS EQUALITY
+
+          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.P1(3),MYPACK.
+             APACK.BPACK.T3(IDENT_BOOL(FALSE))) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ACCESS " &
+                       "EQUALITY BAD - B9");
+          END IF;
+
+
+          -- B10: VISIBILITY FOR GENERIC INSTANCE OF PRIVATE EQUALITY
+
+          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.K1,MYPACK.APACK.
+             BPACK.RET_CHAR('V')) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF PRIVATE " &
+                       "EQUALITY BAD - B10");
+          END IF;
+
+
+          -- B11: VISIBILITY FOR GENERIC INSTANCE OF DERIVED SUBPROGRAM
+
+          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.RET_T1(MYPACK.
+             APACK.BPACK.ORANGE),MYPACK.APACK.BPACK.GREEN) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
+                       "SUBPROGRAM BAD - B11");
+          END IF;
+
+          -- B12: VISIBILITY FOR GENERIC INSTANCE OF GENERIC SUBPROGRAM
+
+          MY_DO_NOTHING (MYPACK.APACK.BPACK.V1);
+
+          IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.V1,
+                                     MYPACK.APACK.BPACK.T3(FALSE)) THEN
+               FAILED ("VISIBILITY FOR GENERIC INSTANCE OF GENERIC " &
+                       "SUBPROGRAM BAD - B12");
+          END IF;
+
+     END B_BLOCK;
+
+     RESULT;
+END C83051A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83b02a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83b02a.ada
new file mode 100644
index 000000000..c982d3f9a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83b02a.ada
@@ -0,0 +1,79 @@
+-- C83B02A.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 NESTED LOOPS CAN HAVE IDENTICALLY NAMED PARAMETERS,
+--    AND REFERENCES IN THE INNERMOST LOOP ARE ASSOCIATED WITH THE
+--    INNERMOST PARAMETER, ETC.
+
+
+--    RM     4 JUNE 1980
+
+
+WITH REPORT;
+PROCEDURE  C83B02A  IS
+
+     USE REPORT;
+
+     I , J , K : INTEGER := 1 ;
+
+BEGIN
+
+     TEST ( "C83B02A" ,
+            "CHECK THAT NESTED LOOPS CAN HAVE IDENTICALLY NAMED" &
+            " PARAMETERS" );
+
+                                                        --   I    J    K
+     FOR  LOOP_PAR  IN  2..2  LOOP
+          I := I * LOOP_PAR ;                           --   2    1    1
+          FOR  LOOP_PAR  IN  3..3  LOOP
+               I := I * LOOP_PAR ;                      --   6    1    1
+               FOR  LOOP_PAR  IN  5..5  LOOP
+                    I := I * LOOP_PAR ;                 --  30    1    1
+                    FOR  SECOND_LOOP_PAR  IN  7..7  LOOP
+                         J := J * SECOND_LOOP_PAR ;     --  30    7    1
+                         FOR  SECOND_LOOP_PAR  IN  11..11  LOOP
+                              J := J * SECOND_LOOP_PAR ;--  30   77    1
+                              FOR  SECOND_LOOP_PAR  IN  13..13  LOOP
+                                   J := J *
+                                        SECOND_LOOP_PAR;--  30 1001    1
+                              END LOOP;
+                              K := K * LOOP_PAR ;       --  30 1001    5
+                         END LOOP;
+                         K := K * LOOP_PAR ;            --  30 1001   25
+                    END LOOP;
+                    K := K * LOOP_PAR ;                 --  30 1001  125
+               END LOOP;
+               K := K * LOOP_PAR ;                      --  30 1001  375
+          END LOOP;
+          K := K * LOOP_PAR ;                           --  30 1001  750
+     END LOOP;
+
+     IF  I /= 30 OR J /= 1001 OR K /= 750  THEN
+           FAILED ( "DID NOT ACCESS INNERMOST ENCLOSING IDENTICALLY " &
+                    "NAMED LOOP PARAMETER IN NESTED LOOPS" );
+     END IF;
+
+     RESULT;
+
+END C83B02A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83b02b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83b02b.ada
new file mode 100644
index 000000000..817647a94
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83b02b.ada
@@ -0,0 +1,112 @@
+-- C83B02B.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-NESTED LOOPS CAN HAVE IDENTICALLY NAMED PARAMETERS,
+--    AND REFERENCES IN EACH LOOP ARE ASSOCIATED WITH THAT LOOP'S
+--    LOOP PARAMETER.  (THIS IS PART  B  OF THE OBJECTIVE.)
+-- CHECK ALSO THAT A LOOP PARAMETER CAN HAVE THE SAME IDENTIFIER
+--    AS A VARIABLE DECLARED IN THE SCOPE IMMEDIATELY CONTAINING
+--    THE LOOP.  (THIS IS PART  C  OF THE OBJECTIVE.)
+
+
+
+--    RM     6 JUNE 1980
+
+
+WITH REPORT;
+PROCEDURE  C83B02B  IS
+
+     USE REPORT;
+
+     I , J : INTEGER := 1 ;
+
+BEGIN
+
+     TEST ( "C83B02B" ,
+            "CHECK THAT NON-NESTED LOOPS CAN HAVE IDENTICALLY NAMED" &
+            " PARAMETERS" );
+
+     COMMENT ( "THE NAME MAY BE THE SAME AS THAT OF A VARIABLE" &
+               " KNOWN OUTSIDE THE LOOP" );
+
+     -- CHECK PART B OF THE OBJECTIVE
+     DECLARE
+          TYPE  WEEKDAY  IS  ( MON , TUE , WED , THU , FRI );
+     BEGIN
+
+          FOR  LOOP_PAR  IN  3..3  LOOP
+               I := I * LOOP_PAR ;              --    3
+          END LOOP;
+
+          FOR  LOOP_PAR  IN  FRI..FRI  LOOP
+               I := I * WEEKDAY'POS(LOOP_PAR) ; --   12
+          END LOOP;
+
+          FOR  LOOP_PAR  IN  7..7  LOOP
+               I := I * LOOP_PAR ;              --  84
+          END LOOP;
+
+     END;
+
+     IF I /= 84 THEN
+          FAILED ("DID NOT ACCESS ENCLOSING IDENTICALLY NAMED " &
+                  "LOOP PARAMETER IN NON-NESTED LOOPS");
+     END IF;
+
+     -- CHECK PART C OF THE OBJECTIVE
+     DECLARE
+          LOOP_PAR : INTEGER := 2 ;
+     BEGIN
+
+          J := J * LOOP_PAR ;                          --    2
+
+          FOR  LOOP_PAR  IN  3..3  LOOP
+               J := J * LOOP_PAR ;                     --    6
+          END LOOP;
+
+          J := J * LOOP_PAR ;                          --   12
+
+          FOR  LOOP_PAR  IN  5..5  LOOP
+               J := J * LOOP_PAR ;                     --   60
+          END LOOP;
+
+          J := J * LOOP_PAR ;                          --  120
+
+          FOR  LOOP_PAR  IN  7..7  LOOP
+               J := J * LOOP_PAR ;                     --  840
+          END LOOP;
+
+          J := J * LOOP_PAR ;                          -- 1680
+
+     END;
+
+     IF J /= 1680 THEN
+          FAILED ("DID NOT ACCESS IDENTICALLY NAMED LOOP PARAMETER " &
+                  "INSIDE NON-NESTED LOOPS OR IDENTICALLY NAMED " &
+                  "VARIABLE OUTSIDE LOOPS");
+     END IF;
+
+     RESULT;
+
+END C83B02B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83e02a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83e02a.ada
new file mode 100644
index 000000000..a99c70b46
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83e02a.ada
@@ -0,0 +1,84 @@
+-- C83E02A.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 WITHIN THE BODY OF A SUBPROGRAM A FORMAL PARAMETER CAN BE
+--    USED DIRECTLY IN A RANGE CONSTRAINT, A DISCRIMINANT CONSTRAINT,
+--    AND AN INDEX CONSTRAINT.
+
+--    RM    8 JULY 1980
+
+
+WITH REPORT;
+PROCEDURE  C83E02A  IS
+
+     USE REPORT;
+
+     Z : INTEGER := 0 ;
+
+     PROCEDURE  P1 ( A , B : INTEGER;  C : IN OUT INTEGER ) IS
+          X : INTEGER RANGE A+1..1+B ;
+     BEGIN
+          X := A + 1 ;
+          C := X * B + B * X * A ;         -- 4*3+3*4*3=48
+     END ;
+
+     PROCEDURE  P2 ( A , B : INTEGER;  C : IN OUT INTEGER ) IS
+          TYPE  T (MAX : INTEGER)  IS
+               RECORD
+                    VALUE : INTEGER RANGE 1..3 ;
+               END RECORD ;
+          X : T(A);
+     BEGIN
+          X := ( MAX => 4 , VALUE => B ) ; -- ( 4 , 3 )
+          C := 10*C + X.VALUE + 2 ;        -- 10*48+3+2=485
+     END ;
+
+     FUNCTION  F3 ( A , B : INTEGER )  RETURN INTEGER  IS
+          TYPE  TABLE  IS  ARRAY( A..B ) OF INTEGER ;
+          X : TABLE ;
+          Y : ARRAY( A..B ) OF INTEGER ;
+     BEGIN
+          X(A) := A ;                      -- 5
+          Y(B) := B ;                      -- 6
+          RETURN X(A)-Y(B)+4 ;             -- 3
+     END ;
+
+
+BEGIN
+
+     TEST( "C83E02A" , "CHECK THAT WITHIN THE BODY OF A SUBPROGRAM " &
+                       " A FORMAL PARAMETER CAN BE USED DIRECTLY IN" &
+                       " A RANGE CONSTRAINT, A DISCRIMINANT CONSTRAINT"&
+                       ", AND AN INDEX CONSTRAINT" ) ;
+
+     P1 ( 3 , 3 , Z );                     --  Z  BECOMES  48
+     P2 ( 4 , F3( 5 , 6 ) , Z );           --  Z  BECOMES 485
+
+     IF  Z /= 485  THEN
+          FAILED( "ACCESSING ERROR OR COMPUTATION ERROR" );
+     END IF;
+
+     RESULT;
+
+END C83E02A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83e02b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83e02b.ada
new file mode 100644
index 000000000..ba157672f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83e02b.ada
@@ -0,0 +1,65 @@
+-- C83E02B.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 WITHIN THE BODY OF A SUBPROGRAM A FORMAL PARAMETER CAN BE
+--    USED IN AN EXCEPTION HANDLER.
+
+--    RM   10 JULY 1980
+
+
+WITH REPORT;
+PROCEDURE  C83E02B  IS
+
+     USE REPORT;
+
+     Z : INTEGER := 0 ;
+
+     PROCEDURE  P1 ( A , B : INTEGER;  C : IN OUT INTEGER ) IS
+          E : EXCEPTION ;
+     BEGIN
+          RAISE  E ;
+          FAILED( "FAILURE TO RAISE  E " );
+     EXCEPTION
+          WHEN  E  =>
+               C := A + B ;
+          WHEN  OTHERS  =>
+               FAILED( "WRONG EXCEPTION RAISED" );
+     END ;
+
+
+BEGIN
+
+     TEST( "C83E02B" , "CHECK THAT WITHIN THE BODY OF A SUBPROGRAM " &
+                       " A FORMAL PARAMETER CAN BE USED IN AN EXCEP" &
+                       "TION HANDLER" ) ;
+
+     P1 ( 3 , 14 , Z );
+
+     IF  Z /= 17  THEN
+          FAILED( "ACCESSING ERROR OR COMPUTATION ERROR" );
+     END IF;
+
+     RESULT;
+
+END C83E02B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83e03a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83e03a.ada
new file mode 100644
index 000000000..0a46f34dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83e03a.ada
@@ -0,0 +1,81 @@
+-- C83E03A.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 FORMAL PARAMETER IN A NAMED PARAMETER ASSOCIATION
+--    IS NOT CONFUSED WITH AN ACTUAL PARAMETER IDENTIFIER  HAVING THE
+--    SAME SPELLING.
+
+
+--    RM    23 JULY 1980
+
+
+WITH REPORT;
+PROCEDURE  C83E03A  IS
+
+     USE REPORT;
+
+     P : INTEGER RANGE 1..23 := 17 ;
+     FLOW_INDEX : INTEGER := 0 ;
+
+BEGIN
+
+     TEST( "C83E03A" , "CHECK THAT A FORMAL PARAMETER IN A NAMED" &
+                       " PARAMETER ASSOCIATION  IS NOT CONFUSED" &
+                       " WITH AN ACTUAL PARAMETER HAVING THE" &
+                       " SAME SPELLING" );
+
+     DECLARE
+
+          PROCEDURE  BUMP  IS
+          BEGIN
+               FLOW_INDEX := FLOW_INDEX + 1 ;
+          END BUMP ;
+
+          PROCEDURE  P1 ( P : INTEGER )  IS
+          BEGIN
+               IF  P = 17  THEN  BUMP ; END IF ;
+          END ;
+
+          FUNCTION  F1 ( P : INTEGER ) RETURN INTEGER  IS
+          BEGIN
+               RETURN  P ;
+          END ;
+
+     BEGIN
+
+          P1 ( P );
+          P1 ( P => P );
+
+          IF  F1 ( P + 1 )      = 17 + 1  THEN  BUMP ;  END IF;
+          IF  F1 ( P => P + 1 ) = 17 + 1  THEN  BUMP ;  END IF;
+
+     END ;
+
+     IF  FLOW_INDEX /= 4  THEN
+          FAILED( "INCORRECT ACCESSING OR INCORRECT FLOW" );
+     END IF;
+
+     RESULT;
+
+END C83E03A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01a.ada
new file mode 100644
index 000000000..abf1d7499
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01a.ada
@@ -0,0 +1,109 @@
+-- C83F01A.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 INSIDE A PACKAGE BODY,  AN ATTEMPT TO REFERENCE AN IDENTI-
+--    FIER DECLARED IN THE CORRESPONDING PACKAGE SPECIFICATION
+--    IS SUCCESSFUL, EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
+--    ENVIRONMENT SURROUNDING THE PACKAGE BODY.
+
+-- NESTED PACKAGE BODIES ARE TESTED IN  C83F01B , C83F01C , C83F01D
+
+
+--    RM    05 AUGUST 1980
+--    JRK   13 NOV    1980
+
+
+WITH REPORT;
+PROCEDURE  C83F01A  IS
+
+     USE REPORT;
+
+     X1 , X2 : INTEGER RANGE 1..23 := 17 ;
+
+     TYPE  T1  IS  ( A , B , C) ;
+
+     Z : T1 := A ;
+
+
+BEGIN
+
+     TEST( "C83F01A" , "CHECK THAT INSIDE A PACKAGE BODY, " &
+                       "AN ATTEMPT TO REFERENCE AN IDENTIFIER " &
+                       "DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
+                       "FICATION IS SUCCESSFUL EVEN IF THE SAME IDEN" &
+                       "TIFIER IS DECLARED IN THE ENVIRONMENT SURROUND"&
+                       "ING THE PACKAGE BODY" ) ;
+
+     COMMENT( "NESTED PACKAGE BODIES ARE TESTED IN  C83F01B , -C , -D");
+
+
+     DECLARE
+
+
+          PACKAGE  P  IS
+
+               X1 : BOOLEAN := FALSE ;
+               X2 : INTEGER RANGE 1..23 := 11 ;
+               Y1 : BOOLEAN := TRUE ;
+               Y2 : INTEGER := 5 ;
+               T1 : INTEGER := 6 ;
+               Z  : INTEGER := 7 ;
+
+          END  P ;
+
+
+          Y1 , Y2 : INTEGER := 13 ;
+
+
+          PACKAGE BODY  P  IS
+          BEGIN
+
+               X1 := X1 OR Y1 ;
+               Z  :=  Z + T1 ;
+               Y2 := X2 * Y2 ;
+
+               -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
+               --    ASSIGNMENTS  MANIFEST THEMSELVES AT
+               --    COMPILE TIME AS TYPE ERRORS.
+
+          END P ;
+
+
+     BEGIN
+
+          IF  X1 /= 17  OR
+              Z  /= A   OR
+              Y2 /= 13   OR
+              NOT P.X1    OR
+              P.Z  /= 13  OR
+              P.Y2 /= 55
+          THEN  FAILED( "INCORRECT ACCESSING" );
+          END IF;
+
+     END ;
+
+
+     RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
+
+END C83F01A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01b.ada
new file mode 100644
index 000000000..3dca9fc9a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01b.ada
@@ -0,0 +1,129 @@
+-- C83F01B.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 INSIDE A PACKAGE BODY NESTED WITHIN ANOTHER PACKAGE BODY
+--    AN ATTEMPT TO REFERENCE AN IDENTIFIER DECLARED IN THE
+--    CORRESPONDING PACKAGE SPECIFICATION
+--    IS SUCCESSFUL EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
+--    OUTER PACKAGE (SPECIFICATION OR BODY)  OR  IN THE
+--    ENVIRONMENT SURROUNDING THE OUTER PACKAGE BODY.
+
+-- INTERACTIONS WITH SEPARATE COMPILATION ARE TESTED IN  C83F01C ,
+--    C83F01D .
+
+
+--    RM    08 AUGUST 1980
+--    JRK   13 NOV    1980
+
+
+WITH REPORT;
+PROCEDURE  C83F01B  IS
+
+     USE REPORT;
+
+     X1 , X2 : INTEGER RANGE 1..23 := 17 ;
+
+     TYPE  T1  IS  ( A , B , C) ;
+
+     Z : T1 := A ;
+
+
+BEGIN
+
+     TEST( "C83F01B" , "CHECK THAT INSIDE A NESTED PACKAGE BODY" &
+                       " AN ATTEMPT TO REFERENCE AN IDENTIFIER" &
+                       " DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
+                       "FICATION  IS SUCCESSFUL EVEN IF THE SAME IDEN" &
+                       "TIFIER IS DECLARED IN THE ENVIRONMENT SURROUND"&
+                       "ING THE PACKAGE BODY" ) ;
+
+     COMMENT("SEPARATELY COMPILED PACKAGES ARE TESTED IN  C83F01C, -D");
+
+
+     DECLARE
+
+
+          Y1 , Y2 : INTEGER := 100 ;
+
+
+          PACKAGE  OUTER  IS
+
+               Y3 : INTEGER := 100 ;
+
+               PACKAGE  P  IS
+
+                    X1 : BOOLEAN := FALSE ;
+                    X2 : INTEGER RANGE 1..23 := 11 ;
+                    Y1 , Y3 : BOOLEAN := TRUE ;
+                    Y2 , Y4 : INTEGER := 5 ;
+                    T1 : INTEGER := 6 ;
+                    Z  : INTEGER := 7 ;
+
+               END  P ;
+
+          END  OUTER ;
+
+
+          X2 : INTEGER := 100 ;
+
+
+          PACKAGE BODY  OUTER  IS
+
+               Y4 : INTEGER := 200 ;
+
+               PACKAGE BODY  P  IS
+               BEGIN
+
+                    X1 :=  NOT X1  AND  Y1  AND  Y3 ;
+                    Z  :=  Z + T1 ;
+                    Y2 := X2 * Y2 ;
+                    Y4 := X2 * Y4 ;
+
+                    -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
+                    --    ASSIGNMENTS  MANIFEST THEMSELVES AT
+                    --    COMPILE TIME AS TYPE ERRORS
+
+               END P ;
+
+          END OUTER ;
+
+
+     BEGIN
+
+          IF  X1 /= 17   OR
+              Z  /= A    OR
+              Y2 /= 100  OR
+              NOT OUTER.P.X1    OR
+              OUTER.P.Z  /= 13  OR
+              OUTER.P.Y2 /= 55  OR
+              OUTER.P.Y4 /= 55
+          THEN FAILED( "INCORRECT ACCESSING" );
+          END IF;
+
+     END ;
+
+
+     RESULT;   --  POSSIBLE ERROR DURING ELABORATION OF  P
+
+END C83F01B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01c0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01c0.ada
new file mode 100644
index 000000000..9b8c2da17
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01c0.ada
@@ -0,0 +1,55 @@
+-- C83F01C0.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.
+--*
+-- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F01C2M
+
+-- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
+--    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F01D0M ,
+--    C83F01D1 ). THE PRESENT FILE CONTAINS THE SPECIFICATION
+--    OF THE PACKAGE. THE BODY IS IN FILE C83F01C1.
+
+
+--    RM    13 AUGUST 1980
+--    RM    22 AUGUST 1980
+-- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+
+PACKAGE  C83F01C0  IS
+
+     Y3 : INTEGER := 100 ;
+
+     PACKAGE  P  IS
+     
+          X1 : BOOLEAN := FALSE ;
+          X2 : INTEGER RANGE 1..23 := 11 ;
+          Y1 , Y3 : BOOLEAN := TRUE ;
+          Y2 , Y4 : INTEGER := 5 ;
+          T1 : INTEGER := 6 ;
+          Z  : INTEGER := 7 ;
+     
+     END  P ;
+
+     PROCEDURE REQUIRE_BODY;
+
+END  C83F01C0 ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01c1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01c1.ada
new file mode 100644
index 000000000..bd27d1671
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01c1.ada
@@ -0,0 +1,69 @@
+-- C83F01C1.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.
+--*
+-- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F01C2M
+
+-- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
+--    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F01D0M ,
+--    C83F01D1 ). THE PRESENT FILE CONTAINS THE BODY OF THE PACKAGE.
+
+-- FOR THIS FILE, THE FILE NAME AND THE UNIT NAME ARE NOT THE SAME.
+
+
+--    RM    13 AUGUST 1980
+--    RM    22 AUGUST 1980
+--    RM    28 AUGUST 1980  ('FAILED(.)' MOVED TO MAIN)
+-- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+
+PACKAGE BODY  C83F01C0  IS
+
+     Y4 : INTEGER := 200 ;
+
+     PACKAGE BODY  P  IS
+     BEGIN
+
+          X1 :=  NOT X1  AND  Y1  AND  Y3 ;
+          Z  :=  Z + T1 ;
+          Y2 := X2 * Y2 ;
+          Y4 := X2 * Y4 ;
+
+          -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
+          --    ASSIGNMENTS  MANIFEST THEMSELVES AT
+          --    COMPILE TIME AS TYPE ERRORS.
+
+          -- ALL 4 ASSIGNMENTS ARE TESTED IN THE MAIN PROGRAM (RATHER
+          --    THAN HERE) TO PRECLUDE FALSE NEGATIVES (WHERE THE LACK
+          --    OF ELABORATION-TIME ERROR MESSAGES SIMPLY MEANS THAT THE
+          --    PACKAGE WAS NOT ELABORATED).
+
+
+     END P ;
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+       NULL;
+     END;
+
+END C83F01C0 ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01c2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01c2.ada
new file mode 100644
index 000000000..dbce105fe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01c2.ada
@@ -0,0 +1,69 @@
+-- C83F01C2M.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.
+--*
+-- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE
+--    ( C83F01C0 ; SPECIFICATION IN  C83F01C0.ADA ,
+--                 BODY IN           C83F01C1.ADA )
+
+-- CHECK THAT INSIDE A PACKAGE BODY NESTED WITHIN A SEPARATELY COMPILED
+--    PACKAGE BODY AN ATTEMPT TO REFERENCE AN IDENTIFIER DECLARED IN THE
+--    CORRESPONDING PACKAGE SPECIFICATION
+--    IS SUCCESSFUL EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
+--    OUTER PACKAGE (SPECIFICATION OR BODY).
+
+-- CASE 1:  PACKAGE IS A FULL-FLEDGED COMPILATION UNIT
+
+
+--    RM    11 AUGUST 1980
+--    RM    22 AUGUST 1980
+--    RM    29 AUGUST 1980 (MOVED 'FAILED(.)' FROM C83F01C1.ADA TO HERE)
+
+
+WITH REPORT , C83F01C0 ;
+PROCEDURE  C83F01C2M  IS
+
+     USE  REPORT , C83F01C0 ;
+
+BEGIN
+
+     TEST( "C83F01C" , "CHECK THAT INSIDE A  PACKAGE BODY" &
+                       " NESTED WITHIN A SEPARATELY" &
+                       " COMPILED PACKAGE BODY LIBRARY UNIT," &
+                       " AN ATTEMPT TO REFERENCE AN IDENTIFIER" &
+                       " DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
+                       "FICATION  IS SUCCESSFUL EVEN IF THE SAME IDEN" &
+                       "TIFIER IS DECLARED IN THE OUTER PACKAGE" &
+                       " (SPECIFICATION OR BODY)" ) ;
+
+     IF  NOT P.X1    OR
+         P.Z  /= 13  OR
+         P.Y2 /= 55  OR
+         P.Y4 /= 55
+     THEN FAILED( "INCORRECT ACCESSING" );
+     END IF;
+
+     RESULT ;
+
+
+END C83F01C2M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01d0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01d0.ada
new file mode 100644
index 000000000..c73f0bce9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01d0.ada
@@ -0,0 +1,103 @@
+-- C83F01D0M.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.
+--*
+-- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE BODY SUBUNIT
+--    ( C83F01D1.ADA )
+
+-- CHECK THAT INSIDE A PACKAGE BODY NESTED WITHIN A SEPARATELY COMPILED
+--    PACKAGE BODY AN ATTEMPT TO REFERENCE AN IDENTIFIER DECLARED IN THE
+--    CORRESPONDING PACKAGE SPECIFICATION
+--    IS SUCCESSFUL EVEN IF THE SAME IDENTIFIER IS DECLARED IN THE
+--    OUTER PACKAGE (SPECIFICATION OR BODY).
+
+-- CASE 2:  PACKAGE BODY IS A COMPILATION SUBUNIT
+
+
+--    RM    13 AUGUST 1980
+--    RM    29 AUGUST 1980
+--    JRK   13 NOV    1980
+
+
+WITH REPORT;
+PROCEDURE  C83F01D0M  IS
+
+     USE REPORT ;
+
+     X1 , X2 : INTEGER RANGE 1..23 := 17 ;
+     Y1      : INTEGER := 157 ;
+
+     TYPE  T1  IS  ( A , B , C) ;
+
+     Z : T1 := A ;
+
+
+     PACKAGE  C83F01D1  IS
+
+          Y3 : INTEGER := 100 ;
+
+          PACKAGE  P  IS
+
+               X1 : BOOLEAN := FALSE ;
+               X2 : INTEGER RANGE 1..23 := 11 ;
+               Y1 , Y3 : BOOLEAN := TRUE ;
+               Y2 , Y4 : INTEGER := 5 ;
+               T1 : INTEGER := 23 ;
+               Z  : INTEGER := 0 ;
+
+          END  P ;
+
+     END  C83F01D1 ;
+
+
+     Y2 : INTEGER := 200 ;
+
+
+     PACKAGE BODY  C83F01D1  IS SEPARATE ;
+
+
+BEGIN
+
+     TEST( "C83F01D" , "CHECK THAT INSIDE A  PACKAGE BODY" &
+                       " NESTED WITHIN A SEPARATELY" &
+                       " COMPILED PACKAGE BODY SUBUNIT," &
+                       " AN ATTEMPT TO REFERENCE AN IDENTIFIER" &
+                       " DECLARED IN THE CORRESPONDING PACKAGE SPECI" &
+                       "FICATION  IS SUCCESSFUL EVEN IF THE SAME IDEN" &
+                       "TIFIER IS DECLARED IN THE OUTER PACKAGE" &
+                       " (SPECIFICATION OR BODY)" ) ;
+
+     IF  X1 /= 17   OR
+         Z  /= A    OR
+         Y2 /= 200  OR
+         NOT C83F01D1.P.X1    OR
+         C83F01D1.P.Z  /= 23  OR
+         C83F01D1.P.Y2 /= 55  OR
+         C83F01D1.P.Y4 /= 55
+     THEN FAILED( "INCORRECT ACCESSING" );
+     END IF;
+
+     RESULT ;
+
+
+END C83F01D0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01d1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01d1.ada
new file mode 100644
index 000000000..fb0d9f508
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f01d1.ada
@@ -0,0 +1,57 @@
+-- C83F01D1.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.
+--*
+-- SEPARATELY COMPILED PACKAGE BODY FOR USE WITH  C83F01D0M
+
+
+--    RM    13 AUGUST 1980
+--    RM    29 AUGUST 1980
+
+
+
+SEPARATE (C83F01D0M)
+PACKAGE BODY  C83F01D1  IS
+
+     Y4 : INTEGER := 200 ;
+
+     PACKAGE BODY  P  IS
+     BEGIN
+
+          X1 :=  NOT X1  AND  Y1  AND  Y3 ;
+          Z  :=  Z + T1 ;
+          Y2 := X2 * Y2 ;
+          Y4 := X2 * Y4 ;
+
+          -- ALL 4 ASSIGNMENTS ARE TESTED IN THE MAIN PROGRAM (RATHER
+          --    THAN HERE) TO PRECLUDE FALSE NEGATIVES (WHERE THE LACK
+          --    OF ELABORATION-TIME ERROR MESSAGES SIMPLY MEANS THAT THE
+          --    PACKAGE WAS NOT ELABORATED).
+
+          -- INCORRECT INTERPRETATIONS IN THE FIRST TWO
+          --    ASSIGNMENTS  MANIFEST THEMSELVES AT
+          --    COMPILE TIME AS TYPE ERRORS.
+
+     END P ;
+
+END C83F01D1 ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03a.ada
new file mode 100644
index 000000000..a24f03863
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03a.ada
@@ -0,0 +1,113 @@
+-- C83F03A.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 INSIDE A PACKAGE BODY  AN ATTEMPT TO PLACE AND REFERENCE
+--    A LABEL IS SUCCESSFUL EVEN IF ITS IDENTIFIER IS DECLARED IN THE
+--    ENVIRONMENT SURROUNDING THE PACKAGE BODY.
+
+-- NESTED PACKAGE BODIES ARE TESTED IN  C83F03B , C83F03C , C83F03D
+
+
+--    RM    03 SEPTEMBER 1980
+
+
+WITH REPORT;
+PROCEDURE  C83F03A  IS
+
+     USE REPORT;
+
+     X1 , X2 : INTEGER RANGE 1..23 := 17 ;
+
+     TYPE  T1  IS  ( A , B , C) ;
+
+     Z : T1 := A ;
+
+     FLOW_INDEX : INTEGER := 0 ;
+
+BEGIN
+
+     TEST( "C83F03A" , "CHECK THAT INSIDE A PACKAGE BODY " &
+                       " AN ATTEMPT TO PLACE AND REFERENCE A LABEL" &
+                       " IS SUCCESSFUL EVEN IF ITS IDEN" &
+                       "TIFIER IS DECLARED IN THE ENVIRONMENT SURROUND"&
+                       "ING THE PACKAGE BODY" ) ;
+
+
+     DECLARE
+
+
+          Y1 , Y2 : INTEGER := 13 ;
+
+
+          PROCEDURE  BUMP  IS
+          BEGIN
+               FLOW_INDEX := FLOW_INDEX + 1 ;
+          END BUMP ;
+
+
+          PACKAGE  P  IS
+
+               AA : BOOLEAN := FALSE ;
+
+          END  P ;
+
+
+          PACKAGE BODY  P  IS
+          BEGIN
+
+               GOTO  X1 ;
+
+               BUMP ;
+               BUMP ;
+
+               <<X1>>   BUMP ;  GOTO  X2 ;
+               BUMP ;
+               <<T1>>   BUMP ;  GOTO  Z ;
+               BUMP ;
+               <<Y1>>   BUMP ;  GOTO  Y2 ;
+               BUMP ;
+               <<Y2>>   BUMP ;  GOTO  T1 ;
+               BUMP ;
+               <<X2>>   BUMP ;  GOTO  Y1 ;
+               BUMP ;
+               <<Z >>   BUMP ;  GOTO  ENDING ;
+               BUMP ;
+
+               << ENDING >>  NULL;
+
+          END P ;
+
+
+     BEGIN
+
+          IF  FLOW_INDEX /= 6
+          THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
+          END IF;
+
+     END ;
+
+
+     RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
+
+END C83F03A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03b.ada
new file mode 100644
index 000000000..4b5afea76
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03b.ada
@@ -0,0 +1,157 @@
+-- C83F03B.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 PACKAGE BODY IS NESTED INSIDE ANOTHER PACKAGE BODY
+--    THE INNER PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER IDENTICAL
+--    TO A LABEL IDENTIFIER IN THE OUTER PACKAGE BODY, TO AN IDENTI-
+--    FIER DECLARED IN THE OUTER PACKAGE BODY OR IN ITS SPECIFICATION,
+--    OR TO A LABEL IDENTIFIER OR OTHER IDENTIFIER IN THE
+--    ENVIRONMENT SURROUNDING THE OUTER PACKAGE BODY.
+
+
+-- INTERACTIONS WITH SEPARATE COMPILATION ARE TESTED IN  C83F03C ,
+--    C83F03D .
+
+
+--    RM    04 SEPTEMBER 1980
+
+
+WITH REPORT;
+PROCEDURE  C83F03B  IS
+
+     USE REPORT;
+
+     X1 , X2 : INTEGER RANGE 1..23 := 17 ;
+
+     TYPE  T1  IS  ( A , B , C) ;
+
+     Z : T1 := A ;
+
+     FLOW_INDEX : INTEGER := 0 ;
+
+BEGIN
+
+     TEST( "C83F03B" , "CHECK THAT IF A PACKAGE BODY IS NESTED" &
+                       " INSIDE ANOTHER PACKAGE BODY, THE INNER" &
+                       " PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER" &
+                       " IDENTICAL TO A LABEL IDENTIFIER IN THE OUTER" &
+                       " PACKAGE BODY, TO AN IDENTIFIER DECLARED IN" &
+                       " THE OUTER PACKAGE BODY OR IN ITS SPECIFICA" &
+                       "TION, OR TO A LABEL IDENTIFIER OR OTHER" &
+                       " IDENTIFIER IN THE ENVIRONMENT SURROUNDING" &
+                       " THE OUTER PACKAGE BODY" ) ;
+
+
+     DECLARE
+
+
+          Y1 , Y2 : INTEGER := 100 ;
+
+          X2 : INTEGER := 100 ;
+
+
+          PROCEDURE  BUMP  IS
+          BEGIN
+               FLOW_INDEX := FLOW_INDEX + 1 ;
+          END BUMP ;
+
+
+          PACKAGE  OUTER  IS
+
+               Y3 : INTEGER := 100 ;
+
+               TYPE  T3  IS  ( D , E , F ) ;
+
+               PACKAGE  P  IS
+                    AA : BOOLEAN := FALSE ;
+               END  P ;
+
+          END  OUTER ;
+
+
+          PACKAGE BODY  OUTER  IS
+
+               Y4 : INTEGER := 200 ;
+
+               TYPE  T4  IS  ( G , H , I ) ;
+
+               PACKAGE BODY  P  IS
+               BEGIN
+
+
+                    GOTO  X1 ;
+
+                    BUMP ;
+                    BUMP ;
+
+                    <<X1>>   BUMP ;  GOTO  X2 ;
+                    BUMP ;
+                    <<T1>>   BUMP ;  GOTO  Z ;
+                    BUMP ;
+                    <<Y1>>   BUMP ;  GOTO  Y2 ;
+                    BUMP ;
+                    <<Y2>>   BUMP ;  GOTO  T1 ;
+                    BUMP ;
+                    <<X2>>   BUMP ;  GOTO  Y1 ;
+                    BUMP ;
+                    <<Z >>   BUMP ;  GOTO  T3 ;
+                    BUMP ;
+                    <<T3>>   BUMP ;  GOTO  T4 ;
+                    BUMP ;
+                    <<LABEL_IN_OUTER>>   BUMP ;  GOTO  LABEL_IN_MAIN ;
+                    BUMP ;
+                    <<Y3>>   BUMP ;  GOTO  Y4 ;
+                    BUMP ;
+                    <<Y4>>   BUMP ;  GOTO  LABEL_IN_OUTER ;
+                    BUMP ;
+                    <<T4>>   BUMP ;  GOTO  Y3 ;
+                    BUMP ;
+                    <<LABEL_IN_MAIN >>   BUMP ;  GOTO  ENDING ;
+                    BUMP ;
+
+                    << ENDING >>  NULL;
+
+               END P ;
+
+          BEGIN
+
+               << LABEL_IN_OUTER >>  NULL ;
+
+          END OUTER ;
+
+
+     BEGIN
+
+          << LABEL_IN_MAIN >>
+
+          IF  FLOW_INDEX /= 12
+          THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
+          END IF;
+
+     END ;
+
+
+     RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
+
+END C83F03B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03c0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03c0.ada
new file mode 100644
index 000000000..15962eb50
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03c0.ada
@@ -0,0 +1,53 @@
+-- C83F03C0.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.
+--*
+-- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F03C2M
+
+-- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
+--    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F03D0M ,
+--    C83F03D1 ). THE PRESENT FILE CONTAINS THE SPECIFICATION
+--    OF THE PACKAGE.  THE PACKAGE BODY IS IN  C83F03C1.ADA .
+
+
+--    RM    04 SEPTEMBER 1980
+-- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+
+PACKAGE  C83F03C0  IS
+
+     Y3 : INTEGER := 100 ;
+
+     TYPE  T3  IS  ( D , E , F ) ;
+
+     FLOW_INDEX : INTEGER := 0 ;
+
+     PROCEDURE REQUIRE_BODY;
+
+     PACKAGE  P  IS
+     
+          AA : BOOLEAN := FALSE ;
+     
+     END  P ;
+
+END  C83F03C0 ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03c1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03c1.ada
new file mode 100644
index 000000000..fa4dbf037
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03c1.ada
@@ -0,0 +1,81 @@
+-- C83F03C1.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.
+--*
+-- SEPARATELY COMPILED PACKAGE FOR USE WITH  C83F03C2M
+
+-- THIS PACKAGE IS A FULL-FLEDGED COMPILATION UNIT (AS OPPOSED TO
+--    BEING A SUBUNIT; SUBUNITS ARE TESTED IN  C83F03D0M ,
+--    C83F03D1 ). THE PRESENT FILE CONTAINS THE BODY OF THE PACKAGE.
+
+-- FOR THIS FILE, THE FILE NAME AND THE UNIT NAME ARE NOT THE SAME.
+
+
+--    RM    05 SEPTEMBER 1980
+-- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+
+PACKAGE BODY  C83F03C0  IS
+
+     Y4 : INTEGER := 200 ;
+
+     TYPE  T4  IS  ( G , H , I ) ;
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          FLOW_INDEX := FLOW_INDEX + 1 ;
+     END BUMP ;
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+       NULL;
+     END;
+
+     PACKAGE BODY  P  IS
+     BEGIN
+
+          GOTO  T3 ;
+
+          BUMP ;
+          BUMP ;
+
+          <<T3>>   BUMP ;  GOTO  T4 ;
+          BUMP ;
+          <<LABEL_IN_OUTER>>   BUMP ;  GOTO  ENDING ;
+          BUMP ;
+          <<Y3>>   BUMP ;  GOTO  Y4 ;
+          BUMP ;
+          <<Y4>>   BUMP ;  GOTO  LABEL_IN_OUTER ;
+          BUMP ;
+          <<T4>>   BUMP ;  GOTO  Y3 ;
+          BUMP ;
+
+          << ENDING >>  NULL;
+
+     END P ;
+
+BEGIN
+
+     << LABEL_IN_OUTER >>  NULL ;
+
+END  C83F03C0 ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03c2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03c2.ada
new file mode 100644
index 000000000..978f834bf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03c2.ada
@@ -0,0 +1,64 @@
+-- C83F03C2M.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.
+--*
+-- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE
+--    ( C83F03C0 ; SPECIFICATION IN  C83F03C0.ADA ,
+--                 BODY IN           C83F03C1.ADA )
+
+-- CHECK THAT IF A PACKAGE BODY IS NESTED INSIDE A SEPARATELY COMPILED
+--    PACKAGE BODY
+--    THE INNER PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER IDENTICAL
+--    TO A LABEL IDENTIFIER IN THE OUTER PACKAGE BODY OR TO AN IDENTI-
+--    FIER DECLARED IN THE OUTER PACKAGE BODY OR IN ITS SPECIFICATION.
+
+-- CASE 1:  PACKAGE IS A FULL-FLEDGED COMPILATION UNIT
+
+
+--    RM    05 SEPTEMBER 1980
+
+
+WITH REPORT , C83F03C0 ;
+PROCEDURE  C83F03C2M  IS
+
+     USE  REPORT , C83F03C0 ;
+
+BEGIN
+
+     TEST( "C83F03C" , "CHECK THAT IF A PACKAGE BODY IS NESTED" &
+                       " INSIDE A SEPARATELY COMPILED PACKAGE BODY" &
+                       " LIBRARY UNIT, THE INNER" &
+                       " PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER" &
+                       " IDENTICAL TO A LABEL IDENTIFIER IN THE OUTER" &
+                       " PACKAGE BODY OR TO AN IDENTIFIER DECLARED IN" &
+                       " THE OUTER PACKAGE BODY OR IN ITS SPECIFICA" &
+                       "TION" ) ;
+
+     IF  FLOW_INDEX /= 5
+     THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
+     END IF;
+
+     RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
+
+
+END C83F03C2M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03d0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03d0.ada
new file mode 100644
index 000000000..e2ecd76fd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03d0.ada
@@ -0,0 +1,89 @@
+-- C83F03D0M.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.
+--*
+-- MAIN PROGRAM REQUIRING A SEPARATELY COMPILED PACKAGE BODY SUBUNIT
+--    ( C83F03D1.ADA )
+
+-- CHECK THAT IF A PACKAGE BODY IS NESTED INSIDE A SEPARATELY COMPILED
+--    PACKAGE BODY
+--    THE INNER PACKAGE BODY CAN CONTAIN A LABEL IDENTIFIER IDENTICAL
+--    TO A LABEL IDENTIFIER IN THE OUTER PACKAGE BODY OR TO AN IDENTI-
+--    FIER DECLARED IN THE OUTER PACKAGE BODY OR IN ITS SPECIFICATION
+--    OR IN ITS ENVIRONMENT.
+
+-- CASE 2:  PACKAGE BODY IS A COMPILATION SUBUNIT
+
+
+--    RM    08 SEPTEMBER 1980
+--    JRK   14 NOVEMBER  1980
+
+
+WITH REPORT;
+PROCEDURE  C83F03D0M  IS
+
+     USE REPORT ;
+
+     X1 : INTEGER := 17 ;
+
+     TYPE  T1  IS  ( A, B, C ) ;
+
+     Z : T1 := A ;
+
+     FLOW_INDEX : INTEGER := 0 ;
+
+
+     PACKAGE  C83F03D1  IS
+
+          Y3 : INTEGER := 100 ;
+
+          TYPE  T3  IS  ( D , E , F ) ;
+
+          PACKAGE  P  IS
+               AA : BOOLEAN := FALSE ;
+          END  P ;
+
+     END  C83F03D1 ;
+
+
+     Y1 : INTEGER := 100 ;
+
+
+     PACKAGE BODY  C83F03D1  IS SEPARATE ;
+
+
+BEGIN
+
+     TEST( "C83F03D" , "CHECK THE RECOGNITION OF LABELS IN NESTED" &
+                       " PACKAGES SEPARATELY COMPILED AS SUBUNITS" );
+
+     << LABEL_IN_MAIN >>
+
+     IF  FLOW_INDEX /= 10
+     THEN  FAILED( "INCORRECT FLOW OF CONTROL" );
+     END IF;
+
+     RESULT;   --  POSS. ERROR DURING ELABORATION OF  P
+
+
+END C83F03D0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03d1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03d1.ada
new file mode 100644
index 000000000..aac2cf939
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c83f03d1.ada
@@ -0,0 +1,82 @@
+-- C83F03D1.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.
+--*
+-- SEPARATELY COMPILED PACKAGE BODY FOR USE WITH  C83F03D0M
+
+
+--    RM    08 SEPTEMBER 1980
+--    JRK   14 NOVEMBER  1980
+
+
+
+SEPARATE (C83F03D0M)
+PACKAGE BODY  C83F03D1  IS
+
+     Y4 : INTEGER := 200 ;
+
+     TYPE  T4  IS  ( G , H , I ) ;
+
+     PROCEDURE  BUMP  IS
+     BEGIN
+          FLOW_INDEX := FLOW_INDEX + 1 ;
+     END BUMP ;
+
+     PACKAGE BODY  P  IS
+     BEGIN
+
+          GOTO  X1 ;
+
+          BUMP ;
+          BUMP ;
+
+          <<LABEL_IN_MAIN>>   BUMP ;  GOTO  T3 ;
+          BUMP ;
+          <<T1>>   BUMP ;  GOTO  Z ;
+          BUMP ;
+          <<Y1>>   BUMP ;  GOTO  LABEL_IN_MAIN ;
+          BUMP ;
+          <<X1>>   BUMP ;  GOTO  T1 ;
+          BUMP ;
+          <<Z>>    BUMP ;  GOTO  Y1 ;
+          BUMP ;
+          <<T3>>   BUMP ;  GOTO  T4 ;
+          BUMP ;
+          <<LABEL_IN_OUTER>>   BUMP ;  GOTO  ENDING ;
+          BUMP ;
+          <<Y3>>   BUMP ;  GOTO  Y4 ;
+          BUMP ;
+          <<Y4>>   BUMP ;  GOTO  LABEL_IN_OUTER ;
+          BUMP ;
+          <<T4>>   BUMP ;  GOTO  Y3 ;
+          BUMP ;
+
+          << ENDING >>  NULL;
+
+     END P ;
+
+BEGIN
+
+     << LABEL_IN_OUTER >>  NULL ;
+
+END C83F03D1 ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c840001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c840001.a
new file mode 100644
index 000000000..2a1df1640
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c840001.a
@@ -0,0 +1,257 @@
+-- C840001.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, for the type determined by the subtype mark of a use type
+--      clause, the declaration of each primitive operator is use-visible
+--      within the scope of the clause, even if explicit operators with the
+--      same names as the type's operators are declared for the subtype. Check
+--      that a call to such an operator executes the body of the type's
+--      operation.
+--
+-- TEST DESCRIPTION:
+--      A type may declare a primitive operator, and a subtype of that type
+--      may overload the operator. If a use type clause names the subtype,
+--      it is the primitive operator of the type (not the subtype) which
+--      is made directly visible, and the primitive operator may be called
+--      unambiguously. Such a call executes the body of the type's operation.
+--
+--      In a package, declare a type for which a predefined operator is
+--      overridden.  In another package, declare a subtype of the type in the
+--      previous package.  Declare another version of the predefined operator
+--      for the subtype.
+--
+--      The main program declares objects of both the type and the explicit
+--      subtype, and uses the "**" operator for both.  In all cases, the
+--      operator declared for the 1st subtype should be the one executed,
+--      since it is the primitive operators of the *type* that are made
+--      visible; the operators which were declared for the explicit subtype
+--      are not primitive operators of the type, since they were declared in
+--      a separate package from the original type.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      23 Sep 99   RLB     Added test case where operator made visible is
+--                          not visible by selection (as in AI-00122).
+--
+--!
+
+package C840001_0 is
+-- Usage scenario: the predefined operators for a floating point type
+-- are overridden in order to take advantage of improved algorithms.
+
+   type Precision_Float is new Float range -100.0 .. 100.0;
+   -- Implicit: function "**" (Left: Precision_Float; Right: Integer'Base)
+   -- return Precision_Float;
+
+   function "**" (Left: Precision_Float; Right: Integer'Base)
+     return Precision_Float;
+   -- Overrides predefined operator.
+
+   function "+" (Right: Precision_Float)
+     return Precision_Float;
+   -- Overrides predefined operator.
+
+   -- ... Other overridden operations.
+
+   TC_Expected : constant Precision_Float := 68.0;
+
+end C840001_0;
+
+
+     --==================================================================--
+
+package body C840001_0 is
+
+   function "**" (Left: Precision_Float; Right: Integer'Base)
+     return Precision_Float is
+   begin
+      -- ... Utilize desired algorithm.
+      return (TC_Expected);  -- Artificial for testing purposes.
+   end "**";
+
+   function "+" (Right: Precision_Float)
+     return Precision_Float is
+   -- Overrides predefined operator.
+   begin
+      return Right*2.0;
+   end "+";
+
+end C840001_0;
+
+
+     --==================================================================--
+
+-- Take advantage of some even better algorithms designed for positive
+-- floating point values.
+
+with C840001_0;
+package C840001_1 is
+
+   subtype Precision_Pos_Float is C840001_0.Precision_Float
+     range 0.0 .. 100.0;
+
+-- This is not a new type, so it has no primitives of it own. However, it
+-- can declare another version of the operator and call it as long as both it
+-- and the corresponding operator of the 1st subtype are not directly visible
+-- in the same place.
+
+   function "**" (Left: Precision_Pos_Float; Right: Natural'Base)
+     return Precision_Pos_Float;           -- Accepts only positive exponent.
+
+end C840001_1;
+
+
+     --==================================================================--
+
+package body C840001_1 is
+
+   function "**" (Left: Precision_Pos_Float; Right: Natural'Base)
+     return Precision_Pos_Float is
+   begin
+      -- ... Utilize some other algorithms.
+      return 57.0;           -- Artificial for testing purposes.
+   end "**";
+
+end C840001_1;
+
+
+     --==================================================================--
+
+with Report;
+with C840001_1;
+procedure C840001_2 is
+
+   -- Note that C840001_0 and it's contents is not visible in any form here.
+
+   TC_Operand   : C840001_1.Precision_Pos_Float := 41.0;
+
+   TC_Operand2  : C840001_1.Precision_Pos_Float;
+
+   use type C840001_1.Precision_Pos_Float;
+      -- Makes the operators of its parent type directly visible, even though
+      -- the parent type and operators are not otherwise visible at all.
+
+begin
+
+   TC_Operand2 := +TC_Operand; -- Overridden operator is visible and called.
+
+   if TC_Operand2 /= 82.0 then -- Predefined equality.
+      Report.Failed ("3rd test: type's overridden operation not called for " &
+                     "operand of 1st subtype");
+   end if;
+   if TC_Operand + 3.0 >= TC_Operand2 - 13.0 then -- Various predefined operators.
+      Report.Failed ("3rd test: wrong result from predefined operators");
+   end if;
+
+end C840001_2;
+
+     --==================================================================--
+
+
+with C840001_0;
+with C840001_1;
+with C840001_2;
+
+with Report;
+
+procedure C840001 is
+
+begin
+   Report.Test ("C840001", "Check that, for the type determined by the "   &
+                "subtype mark of a use type clause, the declaration of "   &
+                "each primitive operator is use-visible within the scope " &
+                "of the clause, even if explicit operators with the same " &
+                "names as the type's operators are declared for the subtype");
+
+
+   Use_Type_Precision_Pos_Float:
+   declare
+      TC_Operand          : C840001_0.Precision_Float
+                          := C840001_0.Precision_Float(-2.0);
+      TC_Positive_Operand : C840001_1.Precision_Pos_Float :=  6.0;
+
+      TC_Actual_Type      : C840001_0.Precision_Float;
+      TC_Actual_Subtype   : C840001_1.Precision_Pos_Float;
+
+      use type C840001_1.Precision_Pos_Float;
+      -- Both calls to "**" should return 68.0 (that is, Precision_Float's
+      -- operation should be called).
+
+   begin
+
+      TC_Actual_Type := TC_Operand**2;
+
+      if C840001_0."/="(TC_Actual_Type, C840001_0.TC_Expected) then
+         Report.Failed ("1st block: type's operation not called for " &
+                        "operand of 1st subtype");
+      end if;
+
+      TC_Actual_Subtype := TC_Positive_Operand**2;
+
+      if not (C840001_0."="
+             (TC_Actual_Subtype, C840001_0.TC_Expected)) then
+         Report.Failed ("1st block: type's operation not called for " &
+                        "operand of explicit subtype");
+      end if;
+
+   end Use_Type_Precision_Pos_Float;
+
+   Use_Type_Precision_Float:
+   declare
+      TC_Operand          : C840001_0.Precision_Float
+                          := C840001_0.Precision_Float(4.0);
+      TC_Positive_Operand : C840001_1.Precision_Pos_Float :=  7.0;
+
+      TC_Actual_Type      : C840001_0.Precision_Float;
+      TC_Actual_Subtype   : C840001_1.Precision_Pos_Float;
+
+      use type C840001_0.Precision_Float;
+      -- Again, both calls to "**" should return 68.0.
+
+  begin
+
+      TC_Actual_Type := TC_Operand**2;
+
+      if C840001_0."/="(TC_Actual_Type, C840001_0.TC_Expected) then
+         Report.Failed ("2nd block: type's operation not called for " &
+                        "operand of 1st subtype");
+      end if;
+
+      TC_Actual_Subtype := TC_Positive_Operand**2;
+
+      if not C840001_0."=" (TC_Actual_Subtype, C840001_0.TC_Expected) then
+         Report.Failed ("2nd block: type's operation not called for " &
+                        "operand of explicit subtype");
+      end if;
+
+   end Use_Type_Precision_Float;
+
+   C840001_2; -- 3rd test.
+
+   Report.Result;
+
+end C840001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84002a.ada
new file mode 100644
index 000000000..ed421e9bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84002a.ada
@@ -0,0 +1,267 @@
+-- C84002A.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) IF A USE CLAUSE NAMES AN ENCLOSING PACKAGE, THE USE CLAUSE
+--      HAS NO EFFECT.
+
+--   B) IF A DECLARATION IS DIRECTLY VISIBLE PRIOR TO THE OCCURRENCE
+--      OF A USE CLAUSE, AND IS NOT IN THE SET OF POTENTIALLY
+--      VISIBLE DECLARATIONS, IT REMAINS DIRECTLY VISIBLE AFTER THE
+--      USE CLAUSE.
+
+--   C) IF A HOMOGRAPH FOR A POTENTIALLY VISIBLE SUBPROGRAM OR
+--      OBJECT IS DECLARED AFTER A USE CLAUSE, THE POTENTIALLY
+--      VISIBLE ENTITY IS NO LONGER VISIBLE.
+
+-- EG  02/16/84
+
+WITH REPORT;
+
+PROCEDURE C84002A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C84002A","CHECK THAT DECLARATIONS DIRECTLY VISIBLE PRIOR " &
+                    "TO THE USE CLAUSE REMAIN VISIBLE AFTERWARDS");
+
+     BEGIN
+
+          COMMENT ("CASE A : CHECK THAT IF A USE CLAUSE NAMES AN " &
+                   "ENCLOSING PACKAGE, THE USE CLAUSE HAS NO EFFECT");
+
+CASE_A :  DECLARE
+
+               PACKAGE P1 IS
+                    X : FLOAT := 1.5;
+               END P1;
+               PACKAGE P2 IS
+                    X : INTEGER := 15;
+
+                    USE P1;
+                    USE P2;
+
+                    A : INTEGER := X;
+               END P2;
+               PACKAGE BODY P1 IS
+               BEGIN
+                    NULL;
+               END P1;
+               PACKAGE BODY P2 IS
+               BEGIN
+                    IF X /= IDENT_INT(15) OR X /= P2.X OR
+                       A /= P2.X THEN
+                         FAILED ("CASE A : USE CLAUSE HAS AN EFFECT");
+                    END IF;
+               END P2;
+
+          BEGIN
+
+               NULL;
+
+          END CASE_A;
+
+          COMMENT ("CASE B : CHECK THAT IF A DECLARATION IS DIRECTLY " &
+                   "VISIBLE PRIOR TO THE OCCURRENCE OF A USE CLAUSE, " &
+                   "AND IS NOT IN THE SET OF POTENTIALLY VISIBLE "     &
+                   "DECLARATIONS, IT REMAINS DIRECTLY VISIBLE");
+
+CASE_B :  BEGIN
+
+     CASE_B1 : DECLARE
+
+                    PACKAGE P1 IS
+                         Y : FLOAT := 1.5;
+                    END P1;
+                    PACKAGE P2 IS
+                         X : INTEGER := 15;
+
+                         USE P1;
+
+                         A : INTEGER := X;
+                    END P2;
+
+                    PACKAGE BODY P1 IS
+                    BEGIN
+                         NULL;
+                    END P1;
+                    PACKAGE BODY P2 IS
+                    BEGIN
+                         IF X /= IDENT_INT(15) OR X /= P2.X OR
+                            A /= P2.X THEN
+                              FAILED ("CASE B1 : DECLARATION NO " &
+                                      "LONGER DIRECTLY VISIBLE");
+                         END IF;
+                    END P2;
+
+               BEGIN
+
+                    NULL;
+
+               END CASE_B1;
+
+     CASE_B2 : DECLARE
+
+                    PROCEDURE PROC1 (X : STRING) IS
+                    BEGIN
+                         NULL;
+                    END PROC1;
+
+                    PACKAGE P1 IS
+                         PROCEDURE PROC1 (X : STRING);
+                    END P1;
+                    PACKAGE BODY P1 IS
+                         PROCEDURE PROC1 (X : STRING) IS
+                         BEGIN
+                              FAILED ("CASE B2 : WRONG PROCEDURE " &
+                                      "DIRECTLY VISIBLE");
+                         END PROC1;
+                    END P1;
+
+                    USE P1;
+
+               BEGIN
+
+                    PROC1 ("ABC");
+
+               END CASE_B2;
+
+     CASE_B3 : DECLARE
+
+                    PROCEDURE PROC1 (X : STRING) IS
+                    BEGIN
+                         NULL;
+                    END PROC1;
+
+                    PACKAGE P1 IS
+                         PROCEDURE PROC1 (Y : STRING);
+                    END P1;
+                    PACKAGE BODY P1 IS
+                         PROCEDURE PROC1 (Y : STRING) IS
+                         BEGIN
+                              FAILED ("CASE B3 : WRONG PROCEDURE " &
+                                      "DIRECTLY VISIBLE");
+                         END PROC1;
+                    END P1;
+
+                    USE P1;
+
+               BEGIN
+
+                    PROC1 ("ABC");
+
+               END CASE_B3;
+
+          END CASE_B;
+
+          COMMENT ("CASE C : IF A HOMOGRAPH FOR A POTENTIALLY "      &
+                   "VISIBLE SUBPROGRAM OR OBJECT IS DECLARED AFTER " &
+                   "A USE CLAUSE, THE POTENTIALLY VISIBLE ENTITY "   &
+                   "IS NO LONGER VISIBLE");
+
+CASE_C :  BEGIN
+
+     CASE_C1 : DECLARE
+
+                    PACKAGE P1 IS
+                         PROCEDURE PROC1 (X : FLOAT);
+                    END P1;
+
+                    USE P1;
+
+                    PACKAGE BODY P1 IS
+                         PROCEDURE PROC1 (X : FLOAT) IS
+                         BEGIN
+                              IF X = -1.5 THEN
+                                   FAILED ("CASE C1 : WRONG PROCEDURE" &
+                                           " CALLED (A)");
+                              ELSIF X /= 1.5 THEN
+                                   FAILED ("CASE C1 : WRONG VALUE " &
+                                           "PASSED (A)");
+                              END IF;
+                         END PROC1;
+                    BEGIN
+                         NULL;
+                    END P1;
+
+                    PROCEDURE PROC2 IS
+                    BEGIN
+                         PROC1 (1.5);
+                    END PROC2;
+
+                    PROCEDURE PROC1 (X : FLOAT) IS
+                    BEGIN
+                         IF X = 1.5 THEN
+                              FAILED ("CASE C1 : WRONG PROCEDURE" &
+                                      " CALLED (B)");
+                         ELSIF X /= -1.5 THEN
+                              FAILED ("CASE C1 : WRONG VALUE " &
+                                      "PASSED (B)");
+                         END IF;
+                    END PROC1;
+
+               BEGIN
+
+                    PROC2;
+                    PROC1 (-1.5);
+
+               END CASE_C1;
+
+     CASE_C2 : DECLARE
+
+                    PACKAGE P1 IS
+                         X : INTEGER := 15;
+                    END P1;
+
+                    USE P1;
+
+                    A : INTEGER := X;
+
+                    X : BOOLEAN := TRUE;
+
+                    B : BOOLEAN := X;
+
+               BEGIN
+
+                    IF A /= IDENT_INT(15) THEN
+                         FAILED ("CASE C2 : VARIABLE A DOES NOT " &
+                                 "CONTAIN THE CORRECT VALUE");
+                    END IF;
+                    IF B /= IDENT_BOOL(TRUE) THEN
+                         FAILED ("CASE C2 : VARIABLE B DOES NOT " &
+                                 "CONTAIN THE CORRECT VALUE");
+                    END IF;
+
+               END CASE_C2;
+
+          END CASE_C;
+
+     END;
+
+     RESULT;
+
+END C84002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84005a.ada
new file mode 100644
index 000000000..53bd64a3d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84005a.ada
@@ -0,0 +1,117 @@
+-- C84005A.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 TWO POTENTIALLY VISIBLE HOMOGRAPHS OF A SUBPROGRAM
+--     IDENTIFIER CAN BE MADE DIRECTLY VISIBLE BY A USE CLAUSE, AND THAT
+--     WHEN DIFFERENT FORMAL PARAMETER NAMES ARE USED THE SUBPROGRAMS
+--     ARE REFERENCED CORRECTLY.
+
+-- HISTORY:
+--     JET 03/10/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C84005A IS
+
+     PACKAGE PACK1 IS
+          FUNCTION FUNK(A : INTEGER) RETURN INTEGER;
+          PROCEDURE PROK(A : INTEGER; B : OUT INTEGER);
+     END PACK1;
+
+     PACKAGE PACK2 IS
+          FUNCTION FUNK(X : INTEGER) RETURN INTEGER;
+          PROCEDURE PROK(X : INTEGER; Y : OUT INTEGER);
+     END PACK2;
+
+     USE PACK1, PACK2;
+     VAR1, VAR2 : INTEGER;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION FUNK(A : INTEGER) RETURN INTEGER IS
+          BEGIN
+               IF EQUAL (A,A) THEN
+                    RETURN (1);
+               ELSE
+                    RETURN (0);
+               END IF;
+          END FUNK;
+
+          PROCEDURE PROK(A : INTEGER; B : OUT INTEGER) IS
+          BEGIN
+               IF EQUAL (A,A) THEN
+                    B := 1;
+               ELSE
+                    B := 0;
+               END IF;
+          END PROK;
+     END PACK1;
+
+     PACKAGE BODY PACK2 IS
+          FUNCTION FUNK(X : INTEGER) RETURN INTEGER IS
+          BEGIN
+               IF EQUAL (X,X) THEN
+                    RETURN (2);
+               ELSE
+                    RETURN (0);
+               END IF;
+          END FUNK;
+
+          PROCEDURE PROK(X : INTEGER; Y : OUT INTEGER) IS
+          BEGIN
+               IF EQUAL (X,X) THEN
+                    Y := 2;
+               ELSE
+                    Y := 0;
+               END IF;
+          END PROK;
+     END PACK2;
+
+BEGIN
+     TEST ("C84005A", "CHECK THAT TWO POTENTIALLY VISIBLE HOMOGRAPHS " &
+                      "OF A SUBPROGRAM IDENTIFIER CAN BE MADE " &
+                      "DIRECTLY VISIBLE BY A USE CLAUSE, AND THAT " &
+                      "WHEN DIFFERENT FORMAL PARAMETER NAMES ARE " &
+                      "USED, THE SUBPROGRAMS ARE REFERENCED CORRECTLY");
+
+     IF FUNK(A => 3) /= IDENT_INT(1) THEN
+          FAILED("PACK1.FUNK RETURNS INCORRECT RESULT");
+     END IF;
+
+     IF FUNK(X => 3) /= IDENT_INT(2) THEN
+          FAILED("PACK2.FUNK RETURNS INCORRECT RESULT");
+     END IF;
+
+     PROK(A => 3, B => VAR1);
+     PROK(X => 3, Y => VAR2);
+
+     IF VAR1 /= IDENT_INT(1) THEN
+          FAILED("PACK1.PROK RETURNS INCORRECT RESULT");
+     END IF;
+
+     IF VAR2 /= IDENT_INT(2) THEN
+          FAILED("PACK2.PROK RETURNS INCORRECT RESULT");
+     END IF;
+
+     RESULT;
+END C84005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84008a.ada
new file mode 100644
index 000000000..fb760eddc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84008a.ada
@@ -0,0 +1,83 @@
+-- C84008A.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 NAMES MADE VISIBLE BY A USE CLAUSE IN THE VISIBLE
+--     PART OF A PACKAGE ARE VISIBLE IN THE PRIVATE PART AND BODY OF
+--     THE PACKAGE.
+
+-- HISTORY:
+--     JET 03/10/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C84008A IS
+
+     PACKAGE PACK1 IS
+          TYPE A IS RANGE 0..100;
+          TYPE B IS RANGE -100..0;
+     END PACK1;
+
+     PACKAGE PACK2 IS
+          USE PACK1;
+          TYPE C IS PRIVATE;
+          PROCEDURE PROC (X : OUT A; Y : OUT B);
+     PRIVATE
+          TYPE C IS NEW A RANGE 0..9;
+     END PACK2;
+
+     VAR1 : PACK1.A;
+     VAR2 : PACK1.B;
+
+     PACKAGE BODY PACK2 IS
+          PROCEDURE PROC (X : OUT A; Y : OUT B) IS
+               SUBTYPE D IS B RANGE -9..0;
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    X := A'(2);
+                    Y := D'(-2);
+               ELSE
+                    X := A'(0);
+                    Y := D'(0);
+               END IF;
+          END PROC;
+     END PACK2;
+
+BEGIN
+     TEST ("C84008A", "CHECK THAT THE NAMES MADE VISIBLE BY A USE " &
+                      "CLAUSE IN THE VISIBLE PART OF A PACKAGE ARE " &
+                      "VISIBLE IN THE PRIVATE PART AND BODY OF " &
+                      "THE PACKAGE");
+
+     PACK2.PROC (VAR1,VAR2);
+
+     IF PACK1."/=" (VAR1, 2) THEN
+          FAILED("INCORRECT RETURN VALUE FOR VAR1");
+     END IF;
+
+     IF PACK1."/=" (VAR2, PACK1."-"(2)) THEN
+          FAILED("INCORRECT RETURN VALUE FOR VAR2");
+     END IF;
+
+     RESULT;
+END C84008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84009a.ada
new file mode 100644
index 000000000..afc5fe0da
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c84009a.ada
@@ -0,0 +1,99 @@
+-- C84009A.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 USE CLAUSE MAKES AN IMPLICITLY OR EXPLICITLY
+--     DECLARED OPERATOR DIRECTLY VISIBLE IF NO HOMOGRAPH OF THE
+--     OPERATOR IS ALREADY DIRECTLY VISIBLE.
+
+-- HISTORY:
+--     JET 03/10/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C84009A IS
+
+     TYPE INT IS NEW INTEGER RANGE -100 .. 100;
+
+     PACKAGE PACK IS
+          FUNCTION "+" (LEFT : INTEGER; RIGHT : INT) RETURN INTEGER;
+          FUNCTION "-" (LEFT, RIGHT : INT) RETURN INT;
+          FUNCTION "-" (RIGHT : INT) RETURN INTEGER;
+          FUNCTION "+" (RIGHT : INT) RETURN INTEGER;
+     END PACK;
+
+     FUNCTION "+" (RIGHT : INT) RETURN INTEGER IS
+     BEGIN
+          RETURN INTEGER'(1) + INTEGER(RIGHT);
+     END "+";
+
+     PACKAGE BODY PACK IS
+          FUNCTION "+" (LEFT : INTEGER; RIGHT : INT) RETURN INTEGER IS
+          BEGIN
+               RETURN LEFT + INTEGER(RIGHT);
+          END "+";
+
+          FUNCTION "-" (LEFT, RIGHT : INT) RETURN INT IS
+          BEGIN
+               FAILED ("BINARY ""-"" ALREADY VISIBLE FOR TYPE INT");
+               RETURN LEFT + (-RIGHT);
+          END "-";
+
+          FUNCTION "-" (RIGHT : INT) RETURN INTEGER IS
+          BEGIN
+               RETURN INTEGER'(0) - INTEGER(RIGHT);
+          END "-";
+
+          FUNCTION "+" (RIGHT : INT) RETURN INTEGER IS
+          BEGIN
+               FAILED ("UNARY ""+"" ALREADY VISIBLE FOR TYPE INT");
+               RETURN INTEGER'(0) + INTEGER(RIGHT);
+          END "+";
+     END PACK;
+
+     USE PACK;
+
+BEGIN
+     TEST ("C84009A", "CHECK THAT A USE CLAUSE MAKES AN IMPLICITLY " &
+                      "OR EXPLICITLY DECLARED OPERATOR DIRECTLY " &
+                      "VISIBLE IF NO HOMOGRAPH OF THE OPERATOR IS " &
+                      "ALREADY DIRECTLY VISIBLE");
+
+     IF INTEGER'(10) + INT'(10) /= IDENT_INT(20) THEN
+          FAILED ("INCORRECT RESULT FROM BINARY ""+""");
+     END IF;
+
+     IF INT'(5) - INT'(3) /= INT'(2) THEN
+          FAILED ("INCORRECT RESULT FROM BINARY ""-""");
+     END IF;
+
+     IF -INT'(20) /= IDENT_INT(-INTEGER'(20)) THEN
+          FAILED ("INCORRECT RESULT FROM UNARY ""-""");
+     END IF;
+
+     IF +INT'(20) /= IDENT_INT(+INTEGER'(21)) THEN
+          FAILED ("INCORRECT RESULT FROM UNARY ""+""");
+     END IF;
+
+     RESULT;
+END C84009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85004b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85004b.ada
new file mode 100644
index 000000000..515936fe9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85004b.ada
@@ -0,0 +1,164 @@
+-- C85004B.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 RENAMED CONSTANT OBJECT, "IN" PARAMETER OF A
+--     SUBPROGRAM OR ENTRY, "IN" FORMAL GENERIC, RECORD DISCRIMINANT,
+--     LOOP PARAMETER, DEFERRED CONSTANT, OR RENAMED CONSTANT HAS THE
+--     CORRECT VALUE.
+
+-- HISTORY:
+--     JET 07/25/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85004B IS
+
+     TYPE A IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     SUBTYPE P IS POSITIVE RANGE 1 .. 10;
+
+     C1 : CONSTANT INTEGER := 1;
+     X1 : INTEGER RENAMES C1;
+     X2 : INTEGER RENAMES X1;
+
+     TYPE REC (D : P := 1) IS
+          RECORD
+               I : A(1..D);
+          END RECORD;
+     TYPE ACCREC1 IS ACCESS REC;
+     TYPE ACCREC2 IS ACCESS REC(10);
+
+     R1 : REC;
+     R2 : REC(10);
+     AR1 : ACCREC1 := NEW REC;
+     AR2 : ACCREC2 := NEW REC(10);
+
+     X3 : P RENAMES R1.D;
+     X4 : P RENAMES R2.D;
+     X5 : P RENAMES AR1.D;
+     X6 : P RENAMES AR2.D;
+
+     C2 : CONSTANT A(1..3) := (1, 2, 3);
+     X7 : INTEGER RENAMES C2(1);
+
+     GENERIC
+          K1 : IN INTEGER;
+     PACKAGE GENPKG IS
+          TYPE K IS PRIVATE;
+          K2 : CONSTANT K;
+     PRIVATE
+          TYPE K IS RANGE 1..100;
+          K2 : CONSTANT K := 5;
+     END GENPKG;
+
+     TASK FOOEY IS
+          ENTRY ENT1 (I : IN INTEGER);
+     END FOOEY;
+
+     TASK BODY FOOEY IS
+     BEGIN
+          ACCEPT ENT1 (I : IN INTEGER) DO
+               DECLARE
+                    TX1 : INTEGER RENAMES I;
+               BEGIN
+                    IF TX1 /= IDENT_INT(2) THEN
+                         FAILED ("INCORRECT VALUE");
+                    END IF;
+               END;
+          END ENT1;
+     END FOOEY;
+
+     PACKAGE BODY GENPKG IS
+          KX1 : INTEGER RENAMES K1;
+          KX2 : K RENAMES K2;
+     BEGIN
+          IF KX1 /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF KX1");
+          END IF;
+
+          IF KX2 /= K(IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF KX2");
+          END IF;
+     END GENPKG;
+
+     PROCEDURE PROC (I : IN INTEGER) IS
+          PX1 : INTEGER RENAMES I;
+     BEGIN
+          IF PX1 /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF PX1");
+          END IF;
+     END PROC;
+
+     PACKAGE PKG IS NEW GENPKG(4);
+
+BEGIN
+     TEST ("C85004B", "CHECK THAT A RENAMED CONSTANT OBJECT, 'IN' " &
+           "PARAMETER OF A SUBPROGRAM OR ENTRY, 'IN' FORMAL GENERIC, " &
+           "RECORD DISCRIMINANT, LOOP PARAMETER, DEFERRED CONSTANT, " &
+           "OR RENAMED CONSTANT HAS THE CORRECT VALUE");
+
+     FOOEY.ENT1(2);
+
+     PROC(3);
+
+     IF X1 /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE OF X1");
+     END IF;
+
+     IF X2 /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE OF X2");
+     END IF;
+
+     IF X3 /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE OF X3");
+     END IF;
+
+     IF X4 /= IDENT_INT(10) THEN
+          FAILED ("INCORRECT VALUE OF X4");
+     END IF;
+
+     IF X5 /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE OF X5");
+     END IF;
+
+     IF X6 /= IDENT_INT(10) THEN
+          FAILED ("INCORRECT VALUE OF X6");
+     END IF;
+
+     IF X7 /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE OF X7");
+     END IF;
+
+     FOR I IN 1..IDENT_INT(2) LOOP
+          DECLARE
+               X8 : INTEGER RENAMES I;
+          BEGIN
+               IF X8 /= IDENT_INT(I) THEN
+                    FAILED ("INCORRECT VALUE OF X8");
+               END IF;
+          END;
+     END LOOP;
+
+     RESULT;
+
+END C85004B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005a.ada
new file mode 100644
index 000000000..05dc328bd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005a.ada
@@ -0,0 +1,391 @@
+-- C85005A.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 VARIABLE CREATED BY AN OBJECT DECLARATION CAN BE
+--     RENAMED AND HAS THE CORRECT VALUE, AND THAT THE NEW NAME CAN
+--     BE USED IN AN ASSIGNMENT STATEMENT AND PASSED ON AS AN ACTUAL
+--     SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN
+--     ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE VALUE OF
+--     THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS REFLECTED
+--     BY THE VALUE OF THE NEW NAME.
+
+-- HISTORY:
+--     JET 03/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85005A IS
+
+     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     TYPE RECORD1 (D : INTEGER) IS
+          RECORD
+               FIELD1 : INTEGER := 1;
+          END RECORD;
+     TYPE POINTER1 IS ACCESS INTEGER;
+
+     PACKAGE PACK1 IS
+          K1 : INTEGER := 0;
+          TYPE PRIVY IS PRIVATE;
+          ZERO : CONSTANT PRIVY;
+          ONE : CONSTANT PRIVY;
+          TWO : CONSTANT PRIVY;
+          THREE : CONSTANT PRIVY;
+          FOUR : CONSTANT PRIVY;
+          FIVE : CONSTANT PRIVY;
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+     PRIVATE
+          TYPE PRIVY IS RANGE 0..127;
+          ZERO : CONSTANT PRIVY := 0;
+          ONE : CONSTANT PRIVY := 1;
+          TWO : CONSTANT PRIVY := 2;
+          THREE : CONSTANT PRIVY := 3;
+          FOUR : CONSTANT PRIVY := 4;
+          FIVE : CONSTANT PRIVY := 5;
+     END PACK1;
+
+     TASK TYPE TASK1 IS
+          ENTRY ASSIGN (J : IN INTEGER);
+          ENTRY VALU (J : OUT INTEGER);
+          ENTRY NEXT;
+          ENTRY STOP;
+     END TASK1;
+
+     TASK TYPE TASK2 IS
+          ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                        TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                        TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;
+                        TK1 : IN OUT INTEGER);
+     END TASK2;
+
+     I1 : INTEGER := 0;
+     A1 : ARRAY1(1..3) := (OTHERS => 0);
+     R1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+     P1 : POINTER1 := NEW INTEGER'(0);
+     V1 : PACK1.PRIVY := PACK1.ZERO;
+     T1 : TASK1;
+
+     XI1 : INTEGER RENAMES I1;
+     XA1 : ARRAY1 RENAMES A1;
+     XR1 : RECORD1 RENAMES R1;
+     XP1 : POINTER1 RENAMES P1;
+     XV1 : PACK1.PRIVY RENAMES V1;
+     XT1 : TASK1 RENAMES T1;
+     XK1 : INTEGER RENAMES PACK1.K1;
+
+     I : INTEGER;
+     CHK_TASK : TASK2;
+
+     GENERIC
+          GI1 : IN OUT INTEGER;
+          GA1 : IN OUT ARRAY1;
+          GR1 : IN OUT RECORD1;
+          GP1 : IN OUT POINTER1;
+          GV1 : IN OUT PACK1.PRIVY;
+          GT1 : IN OUT TASK1;
+          GK1 : IN OUT INTEGER;
+     PACKAGE GENERIC1 IS
+     END GENERIC1;
+
+     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN P;
+          ELSE
+               RETURN NULL;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
+                      PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
+                      PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1;
+                      PK1 : OUT INTEGER) IS
+
+     BEGIN
+          PI1 := PI1 + 1;
+          PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
+          PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
+          PP1 := NEW INTEGER'(P1.ALL + 1);
+          PV1 := PACK1.NEXT(V1);
+          PT1.NEXT;
+          PK1 := PACK1.K1 + 1;
+     END PROC1;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN I;
+               ELSE
+                    RETURN PRIVY'(0);
+               END IF;
+          END IDENT;
+
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               RETURN I+1;
+          END NEXT;
+     END PACK1;
+
+     PACKAGE BODY GENERIC1 IS
+     BEGIN
+          GI1 := GI1 + 1;
+          GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+          GR1 := (D => 1, FIELD1 => GR1.FIELD1+1);
+          GP1 := NEW INTEGER'(GP1.ALL + 1);
+          GV1 := PACK1.NEXT(GV1);
+          GT1.NEXT;
+          GK1 := GK1 + 1;
+     END GENERIC1;
+
+     TASK BODY TASK1 IS
+          TASK_VALUE : INTEGER := 0;
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ASSIGN (J : IN INTEGER) DO
+                         TASK_VALUE := J;
+                    END ASSIGN;
+               OR
+                    ACCEPT VALU (J : OUT INTEGER) DO
+                         J := TASK_VALUE;
+                    END VALU;
+               OR
+                    ACCEPT NEXT DO
+                         TASK_VALUE := TASK_VALUE + 1;
+                    END NEXT;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END TASK1;
+
+     TASK BODY TASK2 IS
+     BEGIN
+          ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                         TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                         TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1;
+                         TK1 : IN OUT INTEGER) DO
+
+               TI1 := I1 + 1;
+               TA1 := (A1(1)+1, A1(2)+1, A1(3)+1);
+               TR1 := (D => 1, FIELD1 => R1.FIELD1 + 1);
+               TP1 := NEW INTEGER'(TP1.ALL + 1);
+               TV1 := PACK1.NEXT(TV1);
+               TT1.NEXT;
+               TK1 := TK1 + 1;
+          END ENTRY1;
+     END TASK2;
+
+BEGIN
+     TEST ("C85005A", "CHECK THAT A VARIABLE CREATED BY AN OBJECT " &
+                      "DECLARATION CAN BE RENAMED AND HAS THE " &
+                      "CORRECT VALUE, AND THAT THE NEW NAME CAN " &
+                      "BE USED IN AN ASSIGNMENT STATEMENT " &
+                      "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
+                      "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
+                      "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
+                      "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
+                      "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
+                      "VALUE OF THE NEW NAME");
+
+     DECLARE
+          PACKAGE GENPACK1 IS NEW
+               GENERIC1 (XI1, XA1, XR1, XP1, XV1, XT1, XK1);
+     BEGIN
+          NULL;
+     END;
+
+     IF XI1 /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE OF XI1 (1)");
+     END IF;
+
+     IF XA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+          FAILED ("INCORRECT VALUE OF XA1 (1)");
+     END IF;
+
+     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+          FAILED ("INCORRECT VALUE OF XR1 (1)");
+     END IF;
+
+     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE OF XP1 (1)");
+     END IF;
+
+     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.ONE)) THEN
+          FAILED ("INCORRECT VALUE OF XV1 (1)");
+     END IF;
+
+     XT1.VALU(I);
+     IF I /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (1)");
+     END IF;
+
+     IF XK1 /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE OF XK1 (1)");
+     END IF;
+
+     PROC1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);
+
+     IF XI1 /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE OF XI1 (2)");
+     END IF;
+
+     IF XA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+          FAILED ("INCORRECT VALUE OF XA1 (2)");
+     END IF;
+
+     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+          FAILED ("INCORRECT VALUE OF XR1 (2)");
+     END IF;
+
+     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE OF XP1 (2)");
+     END IF;
+
+     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.TWO)) THEN
+          FAILED ("INCORRECT VALUE OF XV1 (2)");
+     END IF;
+
+     XT1.VALU(I);
+     IF I /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT RETURN VALUE FROM XT1.VALU (2)");
+     END IF;
+
+     IF XK1 /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE OF XK1 (2)");
+     END IF;
+
+     CHK_TASK.ENTRY1(XI1, XA1, XR1, XP1, XV1, XT1, XK1);
+
+     IF XI1 /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE OF XI1 (3)");
+     END IF;
+
+     IF XA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+          FAILED ("INCORRECT VALUE OF XA1 (3)");
+     END IF;
+
+     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+          FAILED ("INCORRECT VALUE OF XR1 (3)");
+     END IF;
+
+     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE OF XP1 (3)");
+     END IF;
+
+     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.THREE)) THEN
+          FAILED ("INCORRECT VALUE OF XV1 (3)");
+     END IF;
+
+     XT1.VALU(I);
+     IF I /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (3)");
+     END IF;
+
+     IF XK1 /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE OF XK1 (3)");
+     END IF;
+
+     XI1 := XI1 + 1;
+     XA1 := (XA1(1)+1, XA1(2)+1, XA1(3)+1);
+     XR1 := (D => 1, FIELD1 => XR1.FIELD1 + 1);
+     XP1 := NEW INTEGER'(XP1.ALL + 1);
+     XV1 := PACK1.NEXT(XV1);
+     XT1.NEXT;
+     XK1 := XK1 + 1;
+
+     IF XI1 /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT VALUE OF XI1 (4)");
+     END IF;
+
+     IF XA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+          FAILED ("INCORRECT VALUE OF XA1 (4)");
+     END IF;
+
+     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+          FAILED ("INCORRECT VALUE OF XR1 (4)");
+     END IF;
+
+     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT VALUE OF XP1 (4)");
+     END IF;
+
+     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FOUR)) THEN
+          FAILED ("INCORRECT VALUE OF XV1 (4)");
+     END IF;
+
+     XT1.VALU(I);
+     IF I /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (4)");
+     END IF;
+
+     IF XK1 /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT VALUE OF XK1 (4)");
+     END IF;
+
+     I1 := I1 + 1;
+     A1 := (A1(1)+1, A1(2)+1, A1(3)+1);
+     R1 := (D => 1, FIELD1 => R1.FIELD1 + 1);
+     P1 := NEW INTEGER'(P1.ALL + 1);
+     V1 := PACK1.NEXT(V1);
+     T1.NEXT;
+     PACK1.K1 := PACK1.K1 + 1;
+
+     IF XI1 /= IDENT_INT(5) THEN
+          FAILED ("INCORRECT VALUE OF XI1 (5)");
+     END IF;
+
+     IF XA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+          FAILED ("INCORRECT VALUE OF XA1 (5)");
+     END IF;
+
+     IF XR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+          FAILED ("INCORRECT VALUE OF XR1 (5)");
+     END IF;
+
+     IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(5) THEN
+          FAILED ("INCORRECT VALUE OF XP1 (5)");
+     END IF;
+
+     IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FIVE)) THEN
+          FAILED ("INCORRECT VALUE OF XV1 (5)");
+     END IF;
+
+     XT1.VALU(I);
+     IF I /= IDENT_INT(5) THEN
+          FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (5)");
+     END IF;
+
+     IF XK1 /= IDENT_INT(5) THEN
+          FAILED ("INCORRECT VALUE OF XK1 (5)");
+     END IF;
+
+     T1.STOP;
+
+     RESULT;
+END C85005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005b.ada
new file mode 100644
index 000000000..9c4f6fe96
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005b.ada
@@ -0,0 +1,366 @@
+-- C85005B.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 VARIABLE CREATED BY A SUBPROGRAM 'IN OUT' FORMAL
+--     PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND THAT
+--     THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND PASSED
+--     ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER,
+--     AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE
+--     VALUE OF THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS
+--     REFLECTED BY THE VALUE OF THE NEW NAME.
+
+-- HISTORY:
+--     JET 03/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85005B IS
+
+     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     TYPE RECORD1 (D : INTEGER) IS
+          RECORD
+               FIELD1 : INTEGER := 1;
+          END RECORD;
+     TYPE POINTER1 IS ACCESS INTEGER;
+
+     PACKAGE PACK1 IS
+          TYPE PRIVY IS PRIVATE;
+          ZERO : CONSTANT PRIVY;
+          ONE : CONSTANT PRIVY;
+          TWO : CONSTANT PRIVY;
+          THREE : CONSTANT PRIVY;
+          FOUR : CONSTANT PRIVY;
+          FIVE : CONSTANT PRIVY;
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+     PRIVATE
+          TYPE PRIVY IS RANGE 0..127;
+          ZERO : CONSTANT PRIVY := 0;
+          ONE : CONSTANT PRIVY := 1;
+          TWO : CONSTANT PRIVY := 2;
+          THREE : CONSTANT PRIVY := 3;
+          FOUR : CONSTANT PRIVY := 4;
+          FIVE : CONSTANT PRIVY := 5;
+     END PACK1;
+
+     TASK TYPE TASK1 IS
+          ENTRY ASSIGN (J : IN INTEGER);
+          ENTRY VALU (J : OUT INTEGER);
+          ENTRY NEXT;
+          ENTRY STOP;
+     END TASK1;
+
+     DI1 : INTEGER := 0;
+     DA1 : ARRAY1(1..3) := (OTHERS => 0);
+     DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+     DP1 : POINTER1 := NEW INTEGER'(0);
+     DV1 : PACK1.PRIVY := PACK1.ZERO;
+     DT1 : TASK1;
+
+     I : INTEGER;
+
+     GENERIC
+          GI1 : IN OUT INTEGER;
+          GA1 : IN OUT ARRAY1;
+          GR1 : IN OUT RECORD1;
+          GP1 : IN OUT POINTER1;
+          GV1 : IN OUT PACK1.PRIVY;
+          GT1 : IN OUT TASK1;
+     PACKAGE GENERIC1 IS
+     END GENERIC1;
+
+     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN P;
+          ELSE
+               RETURN NULL;
+          END IF;
+     END IDENT;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN I;
+               ELSE
+                    RETURN PRIVY'(0);
+               END IF;
+          END IDENT;
+
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               RETURN I+1;
+          END NEXT;
+     END PACK1;
+
+     PACKAGE BODY GENERIC1 IS
+     BEGIN
+          GI1 := GI1 + 1;
+          GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+          GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
+          GP1 := NEW INTEGER'(GP1.ALL + 1);
+          GV1 := PACK1.NEXT(GV1);
+          GT1.NEXT;
+     END GENERIC1;
+
+     TASK BODY TASK1 IS
+          TASK_VALUE : INTEGER := 0;
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ASSIGN (J : IN INTEGER) DO
+                         TASK_VALUE := J;
+                    END ASSIGN;
+               OR
+                    ACCEPT VALU (J : OUT INTEGER) DO
+                         J := TASK_VALUE;
+                    END VALU;
+               OR
+                    ACCEPT NEXT DO
+                         TASK_VALUE := TASK_VALUE + 1;
+                    END NEXT;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END TASK1;
+
+     PROCEDURE PROC (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
+                     PR1 : IN OUT RECORD1; PP1 : IN OUT POINTER1;
+                     PV1 : IN OUT PACK1.PRIVY; PT1 : IN OUT TASK1) IS
+          XPI1 : INTEGER RENAMES PI1;
+          XPA1 : ARRAY1 RENAMES PA1;
+          XPR1 : RECORD1 RENAMES PR1;
+          XPP1 : POINTER1 RENAMES PP1;
+          XPV1 : PACK1.PRIVY RENAMES PV1;
+          XPT1 : TASK1 RENAMES PT1;
+
+          TASK TYPE TASK2 IS
+               ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                             TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                             TV1 : IN OUT PACK1.PRIVY;
+                             TT1 : IN OUT TASK1);
+          END TASK2;
+
+          CHK_TASK : TASK2;
+
+          PROCEDURE PROC1 (PPI1 : IN OUT INTEGER; PPA1 : IN OUT ARRAY1;
+                           PPR1 : IN OUT RECORD1; PPP1 : OUT POINTER1;
+                           PPV1 : OUT PACK1.PRIVY;
+                           PPT1 : IN OUT TASK1) IS
+          BEGIN
+               PPI1 := PPI1 + 1;
+               PPA1 := (PPA1(1)+1, PPA1(2)+1, PPA1(3)+1);
+               PPR1 := (D => 1, FIELD1 => PPR1.FIELD1 + 1);
+               PPP1 := NEW INTEGER'(PP1.ALL + 1);
+               PPV1 := PACK1.NEXT(PV1);
+               PPT1.NEXT;
+          END PROC1;
+
+          TASK BODY TASK2 IS
+          BEGIN
+               ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                              TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                              TV1 : IN OUT PACK1.PRIVY;
+                              TT1 : IN OUT TASK1)
+               DO
+                    TI1 := PI1 + 1;
+                    TA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
+                    TR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
+                    TP1 := NEW INTEGER'(TP1.ALL + 1);
+                    TV1 := PACK1.NEXT(TV1);
+                    TT1.NEXT;
+               END ENTRY1;
+          END TASK2;
+
+          PACKAGE GENPACK1 IS NEW GENERIC1
+               (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
+
+     BEGIN
+          IF XPI1 /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XPI1 (1)");
+          END IF;
+
+          IF XPA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XPA1 (1)");
+          END IF;
+
+          IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XPR1 (1)");
+          END IF;
+
+          IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XPP1 (1)");
+          END IF;
+
+          IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.ONE)) THEN
+               FAILED ("INCORRECT VALUE OF XPV1 (1)");
+          END IF;
+
+          XPT1.VALU(I);
+          IF I /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (1)");
+          END IF;
+
+          PROC1(XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
+
+          IF XPI1 /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XPI1 (2)");
+          END IF;
+
+          IF XPA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XPA1 (2)");
+          END IF;
+
+          IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XPR1 (2)");
+          END IF;
+
+          IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XPP1 (2)");
+          END IF;
+
+          IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.TWO)) THEN
+               FAILED ("INCORRECT VALUE OF XPV1 (2)");
+          END IF;
+
+          XPT1.VALU(I);
+          IF I /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT RETURN VALUE FROM XPT1.VALU (2)");
+          END IF;
+
+          CHK_TASK.ENTRY1 (XPI1, XPA1, XPR1, XPP1, XPV1, XPT1);
+
+          IF XPI1 /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XPI1 (3)");
+          END IF;
+
+          IF XPA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XPA1 (3)");
+          END IF;
+
+          IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XPR1 (3)");
+          END IF;
+
+          IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XPP1 (3)");
+          END IF;
+
+          IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.THREE)) THEN
+               FAILED ("INCORRECT VALUE OF XPV1 (3)");
+          END IF;
+
+          XPT1.VALU(I);
+          IF I /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (3)");
+          END IF;
+
+          XPI1 := XPI1 + 1;
+          XPA1 := (XPA1(1)+1, XPA1(2)+1, XPA1(3)+1);
+          XPR1 := (D => 1, FIELD1 => XPR1.FIELD1 + 1);
+          XPP1 := NEW INTEGER'(XPP1.ALL + 1);
+          XPV1 := PACK1.NEXT(XPV1);
+          XPT1.NEXT;
+
+          IF XPI1 /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XPI1 (4)");
+          END IF;
+
+          IF XPA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XPA1 (4)");
+          END IF;
+
+          IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XPR1 (4)");
+          END IF;
+
+          IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XPP1 (4)");
+          END IF;
+
+          IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FOUR)) THEN
+               FAILED ("INCORRECT VALUE OF XPV1 (4)");
+          END IF;
+
+          XPT1.VALU(I);
+          IF I /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (4)");
+          END IF;
+
+          PI1 := PI1 + 1;
+          PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
+          PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
+          PP1 := NEW INTEGER'(PP1.ALL + 1);
+          PV1 := PACK1.NEXT(PV1);
+          PT1.NEXT;
+
+          IF XPI1 /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XPI1 (5)");
+          END IF;
+
+          IF XPA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XPA1 (5)");
+          END IF;
+
+          IF XPR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XPR1 (5)");
+          END IF;
+
+          IF XPP1 /= IDENT(PP1) OR XPP1.ALL /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XPP1 (5)");
+          END IF;
+
+          IF PACK1."/=" (XPV1, PACK1.IDENT(PACK1.FIVE)) THEN
+               FAILED ("INCORRECT VALUE OF XPV1 (5)");
+          END IF;
+
+          XPT1.VALU(I);
+          IF I /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XPT1.VALU (5)");
+          END IF;
+     END PROC;
+
+BEGIN
+     TEST ("C85005B", "CHECK THAT A VARIABLE CREATED BY A SUBPROGRAM " &
+                      "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
+                      "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
+                      "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
+                      "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
+                      "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
+                      "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
+                      "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
+                      "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
+                      "VALUE OF THE NEW NAME");
+
+     PROC (DI1, DA1, DR1, DP1, DV1, DT1);
+
+     DT1.STOP;
+
+     RESULT;
+END C85005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005c.ada
new file mode 100644
index 000000000..fe2acb035
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005c.ada
@@ -0,0 +1,416 @@
+-- C85005C.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 VARIABLE CREATED BY AN ENTRY 'IN OUT' FORMAL
+--     PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND THAT
+--     THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND PASSED
+--     ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER,
+--     AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE
+--     VALUE OF THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS
+--     REFLECTED BY THE VALUE OF THE NEW NAME.
+
+-- HISTORY:
+--     JET 03/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85005C IS
+
+     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     TYPE RECORD1 (D : INTEGER) IS
+          RECORD
+               FIELD1 : INTEGER := 1;
+          END RECORD;
+     TYPE POINTER1 IS ACCESS INTEGER;
+
+     PACKAGE PACK1 IS
+          TYPE PRIVY IS PRIVATE;
+          ZERO : CONSTANT PRIVY;
+          ONE : CONSTANT PRIVY;
+          TWO : CONSTANT PRIVY;
+          THREE : CONSTANT PRIVY;
+          FOUR : CONSTANT PRIVY;
+          FIVE : CONSTANT PRIVY;
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+     PRIVATE
+          TYPE PRIVY IS RANGE 0..127;
+          ZERO : CONSTANT PRIVY := 0;
+          ONE : CONSTANT PRIVY := 1;
+          TWO : CONSTANT PRIVY := 2;
+          THREE : CONSTANT PRIVY := 3;
+          FOUR : CONSTANT PRIVY := 4;
+          FIVE : CONSTANT PRIVY := 5;
+     END PACK1;
+
+     TASK TYPE TASK1 IS
+          ENTRY ASSIGN (J : IN INTEGER);
+          ENTRY VALU (J : OUT INTEGER);
+          ENTRY NEXT;
+          ENTRY STOP;
+     END TASK1;
+
+     DI1 : INTEGER := 0;
+     DA1 : ARRAY1(1..3) := (OTHERS => 0);
+     DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+     DP1 : POINTER1 := NEW INTEGER'(0);
+     DV1 : PACK1.PRIVY := PACK1.ZERO;
+     DT1 : TASK1;
+
+     I : INTEGER;
+
+     GENERIC
+          GI1 : IN OUT INTEGER;
+          GA1 : IN OUT ARRAY1;
+          GR1 : IN OUT RECORD1;
+          GP1 : IN OUT POINTER1;
+          GV1 : IN OUT PACK1.PRIVY;
+          GT1 : IN OUT TASK1;
+     PACKAGE GENERIC1 IS
+     END GENERIC1;
+
+     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN P;
+          ELSE
+               RETURN NULL;
+          END IF;
+     END IDENT;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN I;
+               ELSE
+                    RETURN PRIVY'(0);
+               END IF;
+          END IDENT;
+
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               RETURN I+1;
+          END NEXT;
+     END PACK1;
+
+     PACKAGE BODY GENERIC1 IS
+     BEGIN
+          GI1 := GI1 + 1;
+          GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+          GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
+          GP1 := NEW INTEGER'(GP1.ALL + 1);
+          GV1 := PACK1.NEXT(GV1);
+          GT1.NEXT;
+     END GENERIC1;
+
+     TASK BODY TASK1 IS
+          TASK_VALUE : INTEGER := 0;
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ASSIGN (J : IN INTEGER) DO
+                         TASK_VALUE := J;
+                    END ASSIGN;
+               OR
+                    ACCEPT VALU (J : OUT INTEGER) DO
+                         J := TASK_VALUE;
+                    END VALU;
+               OR
+                    ACCEPT NEXT DO
+                         TASK_VALUE := TASK_VALUE + 1;
+                    END NEXT;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END TASK1;
+
+BEGIN
+     TEST ("C85005C", "CHECK THAT A VARIABLE CREATED BY AN ENTRY " &
+                      "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
+                      "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
+                      "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
+                      "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
+                      "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
+                      "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
+                      "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
+                      "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
+                      "VALUE OF THE NEW NAME");
+
+     DECLARE
+          TASK MAIN_TASK IS
+               ENTRY START (TI1 : IN OUT INTEGER; TA1 : IN OUT ARRAY1;
+                            TR1 : IN OUT RECORD1; TP1 : IN OUT POINTER1;
+                            TV1 : IN OUT PACK1.PRIVY;
+                            TT1 : IN OUT TASK1);
+          END MAIN_TASK;
+
+          TASK BODY MAIN_TASK IS
+          BEGIN
+               ACCEPT START (TI1: IN OUT INTEGER; TA1: IN OUT ARRAY1;
+                             TR1: IN OUT RECORD1; TP1: IN OUT POINTER1;
+                             TV1: IN OUT PACK1.PRIVY;
+                             TT1: IN OUT TASK1) DO
+                    DECLARE
+                         XTI1 : INTEGER RENAMES TI1;
+                         XTA1 : ARRAY1 RENAMES TA1;
+                         XTR1 : RECORD1 RENAMES TR1;
+                         XTP1 : POINTER1 RENAMES TP1;
+                         XTV1 : PACK1.PRIVY RENAMES TV1;
+                         XTT1 : TASK1 RENAMES TT1;
+
+                         TASK TYPE TASK2 IS
+                              ENTRY ENTRY1 (TTI1 : OUT INTEGER;
+                                            TTA1 : OUT ARRAY1;
+                                            TTR1 : OUT RECORD1;
+                                            TTP1 : IN OUT POINTER1;
+                                            TTV1 : IN OUT PACK1.PRIVY;
+                                            TTT1 : IN OUT TASK1);
+                         END TASK2;
+
+                         CHK_TASK : TASK2;
+
+                         PROCEDURE PROC1 (PTI1 : IN OUT INTEGER;
+                                          PTA1 : IN OUT ARRAY1;
+                                          PTR1 : IN OUT RECORD1;
+                                          PTP1 : OUT POINTER1;
+                                          PTV1 : OUT PACK1.PRIVY;
+                                          PTT1 : IN OUT TASK1) IS
+                         BEGIN
+                              PTI1 := PTI1 + 1;
+                              PTA1 := (PTA1(1)+1, PTA1(2)+1, PTA1(3)+1);
+                              PTR1 := (D => 1,
+                                       FIELD1 => PTR1.FIELD1 + 1);
+                              PTP1 := NEW INTEGER'(TP1.ALL + 1);
+                              PTV1 := PACK1.NEXT(TV1);
+                              PTT1.NEXT;
+                         END PROC1;
+
+                         TASK BODY TASK2 IS
+                         BEGIN
+                              ACCEPT ENTRY1 (TTI1 : OUT INTEGER;
+                                             TTA1 : OUT ARRAY1;
+                                             TTR1 : OUT RECORD1;
+                                             TTP1 : IN OUT POINTER1;
+                                             TTV1 : IN OUT PACK1.PRIVY;
+                                             TTT1 : IN OUT TASK1)
+                              DO
+                                   TTI1 := TI1 + 1;
+                                   TTA1 := (TA1(1)+1,
+                                   TA1(2)+1, TA1(3)+1);
+                                   TTR1 := (D => 1,
+                                            FIELD1 => TR1.FIELD1 + 1);
+                                   TTP1 := NEW INTEGER'(TTP1.ALL + 1);
+                                   TTV1 := PACK1.NEXT(TTV1);
+                                   TTT1.NEXT;
+                              END ENTRY1;
+                         END TASK2;
+
+                         PACKAGE GENPACK1 IS NEW GENERIC1
+                              (XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
+                    BEGIN
+                         IF XTI1 /= IDENT_INT(1) THEN
+                              FAILED ("INCORRECT VALUE OF XTI1 (1)");
+                         END IF;
+
+                         IF XTA1 /= (IDENT_INT(1),IDENT_INT(1),
+                                     IDENT_INT(1)) THEN
+                              FAILED ("INCORRECT VALUE OF XTA1 (1)");
+                         END IF;
+
+                         IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(1))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XTR1 (1)");
+                         END IF;
+
+                         IF XTP1 /= IDENT(TP1) OR
+                            XTP1.ALL /= IDENT_INT(1) THEN
+                              FAILED ("INCORRECT VALUE OF XTP1 (1)");
+                         END IF;
+
+                         IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.ONE))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XTV1 (1)");
+                         END IF;
+
+                         XTT1.VALU(I);
+                         IF I /= IDENT_INT(1) THEN
+                              FAILED ("INCORRECT RETURN VALUE OF " &
+                                      "XTT1.VALU (1)");
+                         END IF;
+
+                         PROC1(XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
+
+                         IF XTI1 /= IDENT_INT(2) THEN
+                              FAILED ("INCORRECT VALUE OF XTI1 (2)");
+                         END IF;
+
+                         IF XTA1 /= (IDENT_INT(2),IDENT_INT(2),
+                                     IDENT_INT(2)) THEN
+                              FAILED ("INCORRECT VALUE OF XTA1 (2)");
+                         END IF;
+
+                         IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(2))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XTR1 (2)");
+                         END IF;
+
+                         IF XTP1 /= IDENT(TP1) OR
+                            XTP1.ALL /= IDENT_INT(2) THEN
+                              FAILED ("INCORRECT VALUE OF XTP1 (2)");
+                         END IF;
+
+                         IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.TWO))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XTV1 (2)");
+                         END IF;
+
+                         XTT1.VALU(I);
+                         IF I /= IDENT_INT(2) THEN
+                              FAILED ("INCORRECT RETURN VALUE FROM " &
+                                      "XTT1.VALU (2)");
+                         END IF;
+
+                         CHK_TASK.ENTRY1
+                              (XTI1, XTA1, XTR1, XTP1, XTV1, XTT1);
+
+                         IF XTI1 /= IDENT_INT(3) THEN
+                              FAILED ("INCORRECT VALUE OF XTI1 (3)");
+                         END IF;
+
+                         IF XTA1 /= (IDENT_INT(3),IDENT_INT(3),
+                                     IDENT_INT(3)) THEN
+                              FAILED ("INCORRECT VALUE OF XTA1 (3)");
+                         END IF;
+
+                         IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(3))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XTR1 (3)");
+                         END IF;
+
+                         IF XTP1 /= IDENT(TP1) OR
+                            XTP1.ALL /= IDENT_INT(3) THEN
+                              FAILED ("INCORRECT VALUE OF XTP1 (3)");
+                         END IF;
+
+                         IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.THREE))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XTV1 (3)");
+                         END IF;
+
+                         XTT1.VALU(I);
+                         IF I /= IDENT_INT(3) THEN
+                              FAILED ("INCORRECT RETURN VALUE OF " &
+                                      "XTT1.VALU (3)");
+                         END IF;
+
+                         XTI1 := XTI1 + 1;
+                         XTA1 := (XTA1(1)+1, XTA1(2)+1, XTA1(3)+1);
+                         XTR1 := (D => 1, FIELD1 => XTR1.FIELD1 + 1);
+                         XTP1 := NEW INTEGER'(XTP1.ALL + 1);
+                         XTV1 := PACK1.NEXT(XTV1);
+                         XTT1.NEXT;
+
+                         IF XTI1 /= IDENT_INT(4) THEN
+                              FAILED ("INCORRECT VALUE OF XTI1 (4)");
+                         END IF;
+
+                         IF XTA1 /= (IDENT_INT(4),IDENT_INT(4),
+                                     IDENT_INT(4)) THEN
+                              FAILED ("INCORRECT VALUE OF XTA1 (4)");
+                         END IF;
+
+                         IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(4))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XTR1 (4)");
+                         END IF;
+
+                         IF XTP1 /= IDENT(TP1) OR
+                            XTP1.ALL /= IDENT_INT(4) THEN
+                              FAILED ("INCORRECT VALUE OF XTP1 (4)");
+                         END IF;
+
+                         IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.FOUR))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XTV1 (4)");
+                         END IF;
+
+                         XTT1.VALU(I);
+                         IF I /= IDENT_INT(4) THEN
+                              FAILED ("INCORRECT RETURN VALUE OF " &
+                                      "XTT1.VALU (4)");
+                         END IF;
+
+                         TI1 := TI1 + 1;
+                         TA1 := (TA1(1)+1, TA1(2)+1, TA1(3)+1);
+                         TR1 := (D => 1, FIELD1 => TR1.FIELD1 + 1);
+                         TP1 := NEW INTEGER'(TP1.ALL + 1);
+                         TV1 := PACK1.NEXT(TV1);
+                         TT1.NEXT;
+
+                         IF XTI1 /= IDENT_INT(5) THEN
+                              FAILED ("INCORRECT VALUE OF XTI1 (5)");
+                         END IF;
+
+                         IF XTA1 /= (IDENT_INT(5),IDENT_INT(5),
+                                     IDENT_INT(5)) THEN
+                              FAILED ("INCORRECT VALUE OF XTA1 (5)");
+                         END IF;
+
+                         IF XTR1 /= (D => 1, FIELD1 => IDENT_INT(5))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XTR1 (5)");
+                         END IF;
+
+                         IF XTP1 /= IDENT(TP1) OR
+                            XTP1.ALL /= IDENT_INT(5) THEN
+                              FAILED ("INCORRECT VALUE OF XTP1 (5)");
+                         END IF;
+
+                         IF PACK1."/=" (XTV1, PACK1.IDENT(PACK1.FIVE))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XTV1 (5)");
+                         END IF;
+
+                         XTT1.VALU(I);
+                         IF I /= IDENT_INT(5) THEN
+                              FAILED ("INCORRECT RETURN VALUE OF " &
+                                      "XTT1.VALU (5)");
+                         END IF;
+                    END;
+               END START;
+          END MAIN_TASK;
+
+     BEGIN
+          MAIN_TASK.START (DI1, DA1, DR1, DP1, DV1, DT1);
+     END;
+
+     DT1.STOP;
+
+     RESULT;
+END C85005C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005d.ada
new file mode 100644
index 000000000..c745aee44
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005d.ada
@@ -0,0 +1,378 @@
+-- C85005D.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 VARIABLE CREATED BY A GENERIC 'IN OUT' FORMAL
+--     PARAMETER CAN BE RENAMED AND HAS THE CORRECT VALUE, AND
+--     THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT AND
+--     PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT'
+--     PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
+--     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
+--     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+
+-- HISTORY:
+--     JET 03/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85005D IS
+
+     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     TYPE RECORD1 (D : INTEGER) IS
+          RECORD
+               FIELD1 : INTEGER := 1;
+          END RECORD;
+     TYPE POINTER1 IS ACCESS INTEGER;
+
+     PACKAGE PACK1 IS
+          TYPE PRIVY IS PRIVATE;
+          ZERO : CONSTANT PRIVY;
+          ONE : CONSTANT PRIVY;
+          TWO : CONSTANT PRIVY;
+          THREE : CONSTANT PRIVY;
+          FOUR : CONSTANT PRIVY;
+          FIVE : CONSTANT PRIVY;
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+     PRIVATE
+          TYPE PRIVY IS RANGE 0..127;
+          ZERO : CONSTANT PRIVY := 0;
+          ONE : CONSTANT PRIVY := 1;
+          TWO : CONSTANT PRIVY := 2;
+          THREE : CONSTANT PRIVY := 3;
+          FOUR : CONSTANT PRIVY := 4;
+          FIVE : CONSTANT PRIVY := 5;
+     END PACK1;
+
+     TASK TYPE TASK1 IS
+          ENTRY ASSIGN (J : IN INTEGER);
+          ENTRY VALU (J : OUT INTEGER);
+          ENTRY NEXT;
+          ENTRY STOP;
+     END TASK1;
+
+     DI1 : INTEGER := 0;
+     DA1 : ARRAY1(1..3) := (OTHERS => 0);
+     DR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+     DP1 : POINTER1 := NEW INTEGER'(0);
+     DV1 : PACK1.PRIVY := PACK1.ZERO;
+     DT1 : TASK1;
+
+     I : INTEGER;
+
+     GENERIC
+          GI1 : IN OUT INTEGER;
+          GA1 : IN OUT ARRAY1;
+          GR1 : IN OUT RECORD1;
+          GP1 : IN OUT POINTER1;
+          GV1 : IN OUT PACK1.PRIVY;
+          GT1 : IN OUT TASK1;
+     PACKAGE GENERIC1 IS
+     END GENERIC1;
+
+     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN P;
+          ELSE
+               RETURN NULL;
+          END IF;
+     END IDENT;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN I;
+               ELSE
+                    RETURN PRIVY'(0);
+               END IF;
+          END IDENT;
+
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               RETURN I+1;
+          END NEXT;
+     END PACK1;
+
+     PACKAGE BODY GENERIC1 IS
+          XGI1 : INTEGER RENAMES GI1;
+          XGA1 : ARRAY1 RENAMES GA1;
+          XGR1 : RECORD1 RENAMES GR1;
+          XGP1 : POINTER1 RENAMES GP1;
+          XGV1 : PACK1.PRIVY RENAMES GV1;
+          XGT1 : TASK1 RENAMES GT1;
+
+          TASK TYPE TASK2 IS
+               ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                             TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                             TV1 : IN OUT PACK1.PRIVY;
+                             TT1 : IN OUT TASK1);
+          END TASK2;
+
+          G_CHK_TASK : TASK2;
+
+          GENERIC
+               GGI1 : IN OUT INTEGER;
+               GGA1 : IN OUT ARRAY1;
+               GGR1 : IN OUT RECORD1;
+               GGP1 : IN OUT POINTER1;
+               GGV1 : IN OUT PACK1.PRIVY;
+               GGT1 : IN OUT TASK1;
+          PACKAGE GENERIC2 IS
+          END GENERIC2;
+
+          PACKAGE BODY GENERIC2 IS
+          BEGIN
+               GGI1 := GGI1 + 1;
+               GGA1 := (GGA1(1)+1, GGA1(2)+1, GGA1(3)+1);
+               GGR1 := (D => 1, FIELD1 => GGR1.FIELD1 + 1);
+               GGP1 := NEW INTEGER'(GGP1.ALL + 1);
+               GGV1 := PACK1.NEXT(GGV1);
+               GGT1.NEXT;
+          END GENERIC2;
+
+          TASK BODY TASK2 IS
+          BEGIN
+               ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                              TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                              TV1 : IN OUT PACK1.PRIVY;
+                              TT1 : IN OUT TASK1)
+               DO
+                    TI1 := GI1 + 1;
+                    TA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+                    TR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
+                    TP1 := NEW INTEGER'(TP1.ALL + 1);
+                    TV1 := PACK1.NEXT(TV1);
+                    TT1.NEXT;
+               END ENTRY1;
+          END TASK2;
+
+          PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
+                           PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
+                           PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1) IS
+          BEGIN
+               PI1 := PI1 + 1;
+               PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
+               PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
+               PP1 := NEW INTEGER'(GP1.ALL + 1);
+               PV1 := PACK1.NEXT(GV1);
+               PT1.NEXT;
+          END PROC1;
+
+          PACKAGE GENPACK2 IS NEW GENERIC2
+               (XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
+
+     BEGIN
+          IF XGI1 /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XGI1 (1)");
+          END IF;
+
+          IF XGA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XGA1 (1)");
+          END IF;
+
+          IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XGR1 (1)");
+          END IF;
+
+          IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XGP1 (1)");
+          END IF;
+
+          IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.ONE)) THEN
+               FAILED ("INCORRECT VALUE OF XGV1 (1)");
+          END IF;
+
+          XGT1.VALU(I);
+          IF I /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (1)");
+          END IF;
+
+          PROC1(XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
+
+          IF XGI1 /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XGI1 (2)");
+          END IF;
+
+          IF XGA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XGA1 (2)");
+          END IF;
+
+          IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XGR1 (2)");
+          END IF;
+
+          IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XGP1 (2)");
+          END IF;
+
+          IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.TWO)) THEN
+               FAILED ("INCORRECT VALUE OF XGV1 (2)");
+          END IF;
+
+          XGT1.VALU(I);
+          IF I /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (2)");
+          END IF;
+
+          G_CHK_TASK.ENTRY1(XGI1, XGA1, XGR1, XGP1, XGV1, XGT1);
+
+          IF XGI1 /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XGI1 (3)");
+          END IF;
+
+          IF XGA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XGA1 (3)");
+          END IF;
+
+          IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XGR1 (3)");
+          END IF;
+
+          IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XGP1 (3)");
+          END IF;
+
+          IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.THREE)) THEN
+               FAILED ("INCORRECT VALUE OF XGV1 (3)");
+          END IF;
+
+          XGT1.VALU(I);
+          IF I /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (3)");
+          END IF;
+
+          XGI1 := XGI1 + 1;
+          XGA1 := (XGA1(1)+1, XGA1(2)+1, XGA1(3)+1);
+          XGR1 := (D => 1, FIELD1 => XGR1.FIELD1 + 1);
+          XGP1 := NEW INTEGER'(XGP1.ALL + 1);
+          XGV1 := PACK1.NEXT(XGV1);
+          XGT1.NEXT;
+
+          IF XGI1 /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XGI1 (4)");
+          END IF;
+
+          IF XGA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XGA1 (4)");
+          END IF;
+
+          IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XGR1 (4)");
+          END IF;
+
+          IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XGP1 (4)");
+          END IF;
+
+          IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.FOUR)) THEN
+               FAILED ("INCORRECT VALUE OF XGV1 (4)");
+          END IF;
+
+          XGT1.VALU(I);
+          IF I /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (4)");
+          END IF;
+
+          GI1 := GI1 + 1;
+          GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+          GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
+          GP1 := NEW INTEGER'(GP1.ALL + 1);
+          GV1 := PACK1.NEXT(GV1);
+          GT1.NEXT;
+
+          IF XGI1 /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XGI1 (5)");
+          END IF;
+
+          IF XGA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XGA1 (5)");
+          END IF;
+
+          IF XGR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XGR1 (5)");
+          END IF;
+
+          IF XGP1 /= IDENT(GP1) OR XGP1.ALL /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XGP1 (5)");
+          END IF;
+
+          IF PACK1."/=" (XGV1, PACK1.IDENT(PACK1.FIVE)) THEN
+               FAILED ("INCORRECT VALUE OF XGV1 (5)");
+          END IF;
+
+          XGT1.VALU(I);
+          IF I /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XGT1.VALU (5)");
+          END IF;
+     END GENERIC1;
+
+     TASK BODY TASK1 IS
+          TASK_VALUE : INTEGER := 0;
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ASSIGN (J : IN INTEGER) DO
+                         TASK_VALUE := J;
+                    END ASSIGN;
+               OR
+                    ACCEPT VALU (J : OUT INTEGER) DO
+                         J := TASK_VALUE;
+                    END VALU;
+               OR
+                    ACCEPT NEXT DO
+                         TASK_VALUE := TASK_VALUE + 1;
+                    END NEXT;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END TASK1;
+
+BEGIN
+     TEST ("C85005D", "CHECK THAT A VARIABLE CREATED BY A GENERIC " &
+                      "'IN OUT' FORMAL PARAMETER CAN BE RENAMED " &
+                      "AND HAS THE CORRECT VALUE, AND THAT THE NEW " &
+                      "NAME CAN BE USED IN AN ASSIGNMENT STATEMENT " &
+                      "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " &
+                      "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " &
+                      "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " &
+                      "WHEN THE VALUE OF THE RENAMED VARIABLE IS " &
+                      "CHANGED, THE NEW VALUE IS REFLECTED BY THE " &
+                      "VALUE OF THE NEW NAME");
+
+     DECLARE
+          PACKAGE GENPACK1 IS NEW
+               GENERIC1 (DI1, DA1, DR1, DP1, DV1, DT1);
+     BEGIN
+          NULL;
+     END;
+
+     DT1.STOP;
+
+     RESULT;
+END C85005D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005e.ada
new file mode 100644
index 000000000..1f6ffc37d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005e.ada
@@ -0,0 +1,397 @@
+-- C85005E.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 VARIABLE CREATED BY AN ALLOCATOR CAN BE RENAMED AND
+--     HAS THE CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN
+--     ASSIGNMENT STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR
+--     ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC
+--     'IN OUT' PARAMETER, AND THAT WHEN THE VALUE OF THE RENAMED
+--     VARIABLE IS CHANGED, THE NEW VALUE IS REFLECTED BY THE VALUE OF
+--     THE NEW NAME.
+
+-- HISTORY:
+--     JET 03/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85005E IS
+
+     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     TYPE RECORD1 (D : INTEGER) IS
+          RECORD
+               FIELD1 : INTEGER := 1;
+          END RECORD;
+     TYPE POINTER1 IS ACCESS INTEGER;
+
+     PACKAGE PACK1 IS
+          TYPE PACKACC IS ACCESS INTEGER;
+          AK1 : PACKACC := NEW INTEGER'(0);
+          TYPE PRIVY IS PRIVATE;
+          ZERO : CONSTANT PRIVY;
+          ONE : CONSTANT PRIVY;
+          TWO : CONSTANT PRIVY;
+          THREE : CONSTANT PRIVY;
+          FOUR : CONSTANT PRIVY;
+          FIVE : CONSTANT PRIVY;
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+     PRIVATE
+          TYPE PRIVY IS RANGE 0..127;
+          ZERO : CONSTANT PRIVY := 0;
+          ONE : CONSTANT PRIVY := 1;
+          TWO : CONSTANT PRIVY := 2;
+          THREE : CONSTANT PRIVY := 3;
+          FOUR : CONSTANT PRIVY := 4;
+          FIVE : CONSTANT PRIVY := 5;
+     END PACK1;
+
+     TASK TYPE TASK1 IS
+          ENTRY ASSIGN (J : IN INTEGER);
+          ENTRY VALU (J : OUT INTEGER);
+          ENTRY NEXT;
+          ENTRY STOP;
+     END TASK1;
+
+     GENERIC
+          GI1 : IN OUT INTEGER;
+          GA1 : IN OUT ARRAY1;
+          GR1 : IN OUT RECORD1;
+          GP1 : IN OUT POINTER1;
+          GV1 : IN OUT PACK1.PRIVY;
+          GT1 : IN OUT TASK1;
+          GK1 : IN OUT INTEGER;
+     PACKAGE GENERIC1 IS
+     END GENERIC1;
+
+     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN P;
+          ELSE
+               RETURN NULL;
+          END IF;
+     END IDENT;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN I;
+               ELSE
+                    RETURN PRIVY'(0);
+               END IF;
+          END IDENT;
+
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               RETURN I+1;
+          END NEXT;
+     END PACK1;
+
+     PACKAGE BODY GENERIC1 IS
+     BEGIN
+          GI1 := GI1 + 1;
+          GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1);
+          GR1 := (D => 1, FIELD1 => GR1.FIELD1 + 1);
+          GP1 := NEW INTEGER'(GP1.ALL + 1);
+          GV1 := PACK1.NEXT(GV1);
+          GT1.NEXT;
+          GK1 := GK1 + 1;
+     END GENERIC1;
+
+     TASK BODY TASK1 IS
+          TASK_VALUE : INTEGER := 0;
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ASSIGN (J : IN INTEGER) DO
+                         TASK_VALUE := J;
+                    END ASSIGN;
+               OR
+                    ACCEPT VALU (J : OUT INTEGER) DO
+                         J := TASK_VALUE;
+                    END VALU;
+               OR
+                    ACCEPT NEXT DO
+                         TASK_VALUE := TASK_VALUE + 1;
+                    END NEXT;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END TASK1;
+
+BEGIN
+     TEST ("C85005E", "CHECK THAT A VARIABLE CREATED BY AN ALLOCATOR " &
+                      "CAN BE RENAMED AND HAS THE CORRECT VALUE, AND " &
+                      "THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT" &
+                      " STATEMENT AND PASSED ON AS AN ACTUAL " &
+                      "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                      "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                      "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                      "RENAMED VARIABLE IS CHANGED, THE NEW VALUE " &
+                      "IS REFLECTED BY THE VALUE OF THE NEW NAME");
+
+     DECLARE
+          TYPE ACCINT IS ACCESS INTEGER;
+          TYPE ACCARR IS ACCESS ARRAY1;
+          TYPE ACCREC IS ACCESS RECORD1;
+          TYPE ACCPTR IS ACCESS POINTER1;
+          TYPE ACCPVT IS ACCESS PACK1.PRIVY;
+          TYPE ACCTSK IS ACCESS TASK1;
+
+          AI1 : ACCINT := NEW INTEGER'(0);
+          AA1 : ACCARR := NEW ARRAY1'(0, 0, 0);
+          AR1 : ACCREC := NEW RECORD1'(D => 1, FIELD1 => 0);
+          AP1 : ACCPTR := NEW POINTER1'(NEW INTEGER'(0));
+          AV1 : ACCPVT := NEW PACK1.PRIVY'(PACK1.ZERO);
+          AT1 : ACCTSK := NEW TASK1;
+
+          XAI1 : INTEGER RENAMES AI1.ALL;
+          XAA1 : ARRAY1 RENAMES AA1.ALL;
+          XAR1 : RECORD1 RENAMES AR1.ALL;
+          XAP1 : POINTER1 RENAMES AP1.ALL;
+          XAV1 : PACK1.PRIVY RENAMES AV1.ALL;
+          XAK1 : INTEGER RENAMES PACK1.AK1.ALL;
+          XAT1 : TASK1 RENAMES AT1.ALL;
+
+          TASK TYPE TASK2 IS
+               ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                             TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                             TV1 : IN OUT PACK1.PRIVY;
+                             TT1 : IN OUT TASK1; TK1 : IN OUT INTEGER);
+          END TASK2;
+
+          I : INTEGER;
+          A_CHK_TASK : TASK2;
+
+          PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1;
+                           PR1 : IN OUT RECORD1; PP1 : OUT POINTER1;
+                           PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1;
+                           PK1 : OUT INTEGER) IS
+
+          BEGIN
+               PI1 := PI1 + 1;
+               PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1);
+               PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1);
+               PP1 := NEW INTEGER'(AP1.ALL.ALL + 1);
+               PV1 := PACK1.NEXT(AV1.ALL);
+               PT1.NEXT;
+               PK1 := PACK1.AK1.ALL + 1;
+          END PROC1;
+
+          TASK BODY TASK2 IS
+          BEGIN
+               ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1;
+                              TR1 : OUT RECORD1; TP1 : IN OUT POINTER1;
+                              TV1 : IN OUT PACK1.PRIVY;
+                              TT1 : IN OUT TASK1;
+                              TK1 : IN OUT INTEGER) DO
+                    TI1 := AI1.ALL + 1;
+                    TA1 := (AA1.ALL(1)+1, AA1.ALL(2)+1, AA1.ALL(3)+1);
+                    TR1 := (D => 1, FIELD1 => AR1.ALL.FIELD1 + 1);
+                    TP1 := NEW INTEGER'(TP1.ALL + 1);
+                    TV1 := PACK1.NEXT(TV1);
+                    TT1.NEXT;
+                    TK1 := TK1 + 1;
+               END ENTRY1;
+          END TASK2;
+
+          PACKAGE GENPACK2 IS NEW
+               GENERIC1 (XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
+
+     BEGIN
+          IF XAI1 /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XAI1 (1)");
+          END IF;
+
+          IF XAA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XAA1 (1)");
+          END IF;
+
+          IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XAR1 (1)");
+          END IF;
+
+          IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XAP1 (1)");
+          END IF;
+
+          IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.ONE)) THEN
+               FAILED ("INCORRECT VALUE OF XAV1 (1)");
+          END IF;
+
+          XAT1.VALU(I);
+          IF I /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (1)");
+          END IF;
+
+          IF XAK1 /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XAK1 (1)");
+          END IF;
+
+          PROC1(XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
+
+          IF XAI1 /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XAI1 (2)");
+          END IF;
+
+          IF XAA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XAA1 (2)");
+          END IF;
+
+          IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XAR1 (2)");
+          END IF;
+
+          IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XAP1 (2)");
+          END IF;
+
+          IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.TWO)) THEN
+               FAILED ("INCORRECT VALUE OF XAV1 (2)");
+          END IF;
+
+          XAT1.VALU(I);
+          IF I /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (2)");
+          END IF;
+
+          IF XAK1 /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XAK1 (2)");
+          END IF;
+
+          A_CHK_TASK.ENTRY1(XAI1, XAA1, XAR1, XAP1, XAV1, XAT1, XAK1);
+
+          IF XAI1 /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XAI1 (3)");
+          END IF;
+
+          IF XAA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XAA1 (3)");
+          END IF;
+
+          IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XAR1 (3)");
+          END IF;
+
+          IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XAP1 (3)");
+          END IF;
+
+          IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.THREE)) THEN
+               FAILED ("INCORRECT VALUE OF XAV1 (3)");
+          END IF;
+
+          XAT1.VALU(I);
+          IF I /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (3)");
+          END IF;
+
+          IF XAK1 /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XAK1 (3)");
+          END IF;
+
+          XAI1 := XAI1 + 1;
+          XAA1 := (XAA1(1)+1, XAA1(2)+1, XAA1(3)+1);
+          XAR1 := (D => 1, FIELD1 => XAR1.FIELD1 + 1);
+          XAP1 := NEW INTEGER'(XAP1.ALL + 1);
+          XAV1 := PACK1.NEXT(XAV1);
+          XAT1.NEXT;
+          XAK1 := XAK1 + 1;
+
+          IF XAI1 /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XAI1 (4)");
+          END IF;
+
+          IF XAA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XAA1 (4)");
+          END IF;
+
+          IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XAR1 (4)");
+          END IF;
+
+          IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XAP1 (4)");
+          END IF;
+
+          IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.FOUR)) THEN
+               FAILED ("INCORRECT VALUE OF XAV1 (4)");
+          END IF;
+
+          XAT1.VALU(I);
+          IF I /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (4)");
+          END IF;
+
+          IF XAK1 /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XAK1 (4)");
+          END IF;
+
+          AI1.ALL := AI1.ALL + 1;
+          AA1.ALL := (AA1.ALL(1)+1, AA1.ALL(2)+1, AA1.ALL(3)+1);
+          AR1.ALL := (D => 1, FIELD1 => AR1.ALL.FIELD1 + 1);
+          AP1.ALL := NEW INTEGER'(AP1.ALL.ALL + 1);
+          AV1.ALL := PACK1.NEXT(AV1.ALL);
+          AT1.NEXT;
+          PACK1.AK1.ALL := PACK1.AK1.ALL + 1;
+
+          IF XAI1 /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XAI1 (5)");
+          END IF;
+
+          IF XAA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XAA1 (5)");
+          END IF;
+
+          IF XAR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XAR1 (5)");
+          END IF;
+
+          IF XAP1 /= IDENT(AP1.ALL) OR XAP1.ALL /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XAP1 (5)");
+          END IF;
+
+          IF PACK1."/=" (XAV1, PACK1.IDENT(PACK1.FIVE)) THEN
+               FAILED ("INCORRECT VALUE OF XAV1 (5)");
+          END IF;
+
+          XAT1.VALU(I);
+          IF I /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XAT1.VALU (5)");
+          END IF;
+
+          IF XAK1 /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XAK1 (5)");
+          END IF;
+
+          AT1.STOP;
+     END;
+
+     RESULT;
+END C85005E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005f.ada
new file mode 100644
index 000000000..adc87f996
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005f.ada
@@ -0,0 +1,71 @@
+-- C85005F.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, FOR A RENAMED VARIABLE DESIGNATED BY AN ACCESS VALUE,
+--     A CHANGE IN THE ACCESS VALUE DOES NOT AFFECT WHICH VARIABLE IS
+--     DENOTED BY THE NEW NAME.
+
+-- HISTORY:
+--     JET 07/26/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85005F IS
+     TYPE ACC IS ACCESS INTEGER;
+
+     BUMP : INTEGER := 0;
+
+     A : ACC := NULL;
+
+     FUNCTION GET_POINTER RETURN ACC IS
+     BEGIN
+          BUMP := IDENT_INT(BUMP) + 1;
+          RETURN NEW INTEGER'(BUMP);
+     END GET_POINTER;
+
+BEGIN
+     TEST ("C85005F", "CHECK THAT, FOR A RENAMED VARIABLE DESIGNATED " &
+                      "BY AN ACCESS VALUE, A CHANGE IN THE ACCESS " &
+                      "VALUE DOES NOT AFFECT WHICH VARIABLE IS " &
+                      "DENOTED BY THE NEW NAME");
+
+     A := GET_POINTER;
+
+     DECLARE
+          X1 : INTEGER RENAMES A.ALL;
+          X2 : INTEGER RENAMES GET_POINTER.ALL;
+     BEGIN
+          A := GET_POINTER;
+
+          IF X1 /= 1 THEN
+               FAILED("CHANGING ACCESS VALUE CHANGED RENAMED VARIABLE");
+          END IF;
+
+          IF X2 /= 2 THEN
+               FAILED("INCORRECT RESULT FROM FUNCTION AS PREFIX");
+          END IF;
+     END;
+
+     RESULT;
+END C85005F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005g.ada
new file mode 100644
index 000000000..2c1f7f02a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85005g.ada
@@ -0,0 +1,145 @@
+-- C85005G.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 ANY SUBTYPE CONSTRAINT IMPOSED BY THE TYPE MARK USED
+--     IN THE RENAMING DECLARATION IS IGNORED, AND THE SUBTYPE
+--     CONSTRAINT ASSOCIATED WITH THE RENAMED VARIABLE IS USED INSTEAD.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     JET 07/26/88  CREATED ORIGINAL TEST.
+--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85005G IS
+
+     SUBTYPE INT IS INTEGER RANGE -100 .. 100;
+
+     I : INTEGER := IDENT_INT(INTEGER'LAST);
+     J : INT := IDENT_INT(INT'LAST);
+
+     DG1 : INTEGER := IDENT_INT(INTEGER'LAST);
+     DG2 : INT := IDENT_INT(INT'LAST);
+
+     XI : INT RENAMES I;
+     XJ : INTEGER RENAMES J;
+
+     GENERIC
+          G1 : IN OUT INT;
+          G2 : IN OUT INTEGER;
+     PROCEDURE GEN;
+
+     PROCEDURE GEN IS
+          XG1 : INT RENAMES G1;
+          XG2 : INTEGER RENAMES G2;
+     BEGIN
+          IF XG1 /= INTEGER'LAST THEN
+               FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G1");
+          END IF;
+
+          XG1 := IDENT_INT(INTEGER'FIRST);
+
+          IF XG1 /= INTEGER'FIRST THEN
+               FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G2");
+          END IF;
+
+          IF XG2 /= INT'LAST THEN
+               FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G3");
+          END IF;
+
+          XG2 := IDENT_INT(INT'FIRST);
+
+          IF XG2 /= INT'FIRST THEN
+               FAILED("INCORRECT VALUE OF RENAMING VARIABLE - G4");
+          END IF;
+
+          BEGIN
+               XG2 := IDENT_INT(INTEGER'LAST);
+               FAILED ("NO EXCEPTION RAISED BY XG2 := INTEGER'LAST");
+               IF NOT EQUAL(XG2,XG2) THEN
+                    COMMENT ("DON'T OPTIMIZE XG2");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION (G)");
+          END;
+     END GEN;
+
+     PROCEDURE PROC IS NEW GEN(DG1, DG2);
+
+BEGIN
+     TEST ("C85005G", "CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY " &
+                      "THE TYPE MARK USED IN THE RENAMING " &
+                      "DECLARATION IS IGNORED, AND THE SUBTYPE " &
+                      "CONSTRAINT ASSOCIATED WITH THE RENAMED " &
+                      "VARIABLE IS USED INSTEAD");
+
+     IF XI /= INTEGER'LAST THEN
+          FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 1");
+     END IF;
+
+     XI := IDENT_INT(INTEGER'FIRST);
+
+     IF XI /= INTEGER'FIRST THEN
+          FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 2");
+     END IF;
+
+     IF XJ /= INT'LAST THEN
+          FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 3");
+     END IF;
+
+     XJ := IDENT_INT(INT'FIRST);
+
+     IF XJ /= INT'FIRST THEN
+          FAILED("INCORRECT VALUE OF RENAMING VARIABLE - 4");
+     END IF;
+
+     BEGIN
+          XJ := IDENT_INT(INTEGER'LAST);
+          FAILED ("NO EXCEPTION RAISED BY XJ := INTEGER'LAST");
+          IF NOT EQUAL(XJ,XJ) THEN
+               COMMENT ("DON'T OPTIMIZE XJ");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+                NULL;
+          WHEN OTHERS =>
+                FAILED ("UNEXPECTED EXCEPTION - 1");
+     END;
+
+     PROC;
+
+     RESULT;
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED("UNEXPECTED EXCEPTION - 2");
+          RESULT;
+END C85005G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006a.ada
new file mode 100644
index 000000000..be04e4dbe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006a.ada
@@ -0,0 +1,681 @@
+-- C85006A.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 COMPONENT OR SLICE OF A VARIABLE CREATED BY AN
+--     OBJECT DECLARATION CAN BE RENAMED AND HAS THE CORRECT VALUE,
+--     AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT
+--     AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT'
+--     PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
+--     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
+--     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+
+-- HISTORY:
+--     JET 03/22/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85006A IS
+
+     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     TYPE RECORD1 (D : INTEGER) IS
+          RECORD
+               FIELD1 : INTEGER := 1;
+          END RECORD;
+     TYPE POINTER1 IS ACCESS INTEGER;
+
+     PACKAGE PACK1 IS
+          TYPE PRIVY IS PRIVATE;
+          ZERO : CONSTANT PRIVY;
+          ONE : CONSTANT PRIVY;
+          TWO : CONSTANT PRIVY;
+          THREE : CONSTANT PRIVY;
+          FOUR : CONSTANT PRIVY;
+          FIVE : CONSTANT PRIVY;
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+     PRIVATE
+          TYPE PRIVY IS RANGE 0..127;
+          ZERO : CONSTANT PRIVY := 0;
+          ONE : CONSTANT PRIVY := 1;
+          TWO : CONSTANT PRIVY := 2;
+          THREE : CONSTANT PRIVY := 3;
+          FOUR : CONSTANT PRIVY := 4;
+          FIVE : CONSTANT PRIVY := 5;
+     END PACK1;
+
+     TASK TYPE TASK1 IS
+          ENTRY ASSIGN (J : IN INTEGER);
+          ENTRY VALU (J : OUT INTEGER);
+          ENTRY NEXT;
+          ENTRY STOP;
+     END TASK1;
+
+     TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
+     TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
+     TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
+     TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
+     TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
+     TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
+
+     TASK TYPE TASK2 IS
+          ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                        TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
+                        TRV1 : IN OUT PACK1.PRIVY; TRT1 : IN OUT TASK1;
+                        TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                        TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                        TAV1 : IN OUT ARR_PVT; TAT1 : IN OUT ARR_TSK);
+     END TASK2;
+
+     TYPE REC_TYPE IS RECORD
+          RI1 : INTEGER := 0;
+          RA1 : ARRAY1(1..3) := (OTHERS => 0);
+          RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+          RP1 : POINTER1 := NEW INTEGER'(0);
+          RV1 : PACK1.PRIVY := PACK1.ZERO;
+          RT1 : TASK1;
+     END RECORD;
+
+     REC : REC_TYPE;
+
+     AI1 : ARR_INT(1..8) := (OTHERS => 0);
+     AA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
+     AR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
+     AP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
+     AV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
+     AT1 : ARR_TSK(1..8);
+
+     XRI1 : INTEGER RENAMES REC.RI1;
+     XRA1 : ARRAY1 RENAMES REC.RA1;
+     XRR1 : RECORD1 RENAMES REC.RR1;
+     XRP1 : POINTER1 RENAMES REC.RP1;
+     XRV1 : PACK1.PRIVY RENAMES REC.RV1;
+     XRT1 : TASK1 RENAMES REC.RT1;
+     XAI1 : ARR_INT RENAMES AI1(1..3);
+     XAA1 : ARR_ARR RENAMES AA1(2..4);
+     XAR1 : ARR_REC RENAMES AR1(3..5);
+     XAP1 : ARR_PTR RENAMES AP1(4..6);
+     XAV1 : ARR_PVT RENAMES AV1(5..7);
+     XAT1 : ARR_TSK RENAMES AT1(6..8);
+
+     I : INTEGER;
+     CHK_TASK : TASK2;
+
+     GENERIC
+          GRI1 : IN OUT INTEGER;
+          GRA1 : IN OUT ARRAY1;
+          GRR1 : IN OUT RECORD1;
+          GRP1 : IN OUT POINTER1;
+          GRV1 : IN OUT PACK1.PRIVY;
+          GRT1 : IN OUT TASK1;
+          GAI1 : IN OUT ARR_INT;
+          GAA1 : IN OUT ARR_ARR;
+          GAR1 : IN OUT ARR_REC;
+          GAP1 : IN OUT ARR_PTR;
+          GAV1 : IN OUT ARR_PVT;
+          GAT1 : IN OUT ARR_TSK;
+     PACKAGE GENERIC1 IS
+     END GENERIC1;
+
+     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN P;
+          ELSE
+               RETURN NULL;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
+                      PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
+                      PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
+                      PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
+                      PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
+                      PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
+
+     BEGIN
+          PRI1 := PRI1 + 1;
+          PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
+          PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
+          PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+          PRV1 := PACK1.NEXT(REC.RV1);
+          PRT1.NEXT;
+          PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
+          PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
+          PAR1 := (OTHERS => (D => 1,
+                              FIELD1 => (PAR1(PAR1'FIRST).FIELD1 + 1)));
+          PAP1 := (OTHERS => NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
+          FOR J IN PAV1'RANGE LOOP
+               PAV1(J) := PACK1.NEXT(AV1(J));
+          END LOOP;
+          FOR J IN PAT1'RANGE LOOP
+               PAT1(J).NEXT;
+          END LOOP;
+     END PROC1;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN I;
+               ELSE
+                    RETURN PRIVY'(0);
+               END IF;
+          END IDENT;
+
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               RETURN I+1;
+          END NEXT;
+     END PACK1;
+
+     PACKAGE BODY GENERIC1 IS
+     BEGIN
+          GRI1 := GRI1 + 1;
+          GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
+          GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
+          GRP1 := NEW INTEGER'(GRP1.ALL + 1);
+          GRV1 := PACK1.NEXT(GRV1);
+          GRT1.NEXT;
+          GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
+          GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
+          GAR1 := (OTHERS => (D => 1,
+                              FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
+          GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
+          FOR J IN GAV1'RANGE LOOP
+               GAV1(J) := PACK1.NEXT(GAV1(J));
+          END LOOP;
+          FOR J IN GAT1'RANGE LOOP
+               GAT1(J).NEXT;
+          END LOOP;
+     END GENERIC1;
+
+     TASK BODY TASK1 IS
+          TASK_VALUE : INTEGER := 0;
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ASSIGN (J : IN INTEGER) DO
+                         TASK_VALUE := J;
+                    END ASSIGN;
+               OR
+                    ACCEPT VALU (J : OUT INTEGER) DO
+                         J := TASK_VALUE;
+                    END VALU;
+               OR
+                    ACCEPT NEXT DO
+                         TASK_VALUE := TASK_VALUE + 1;
+                    END NEXT;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END TASK1;
+
+     TASK BODY TASK2 IS
+     BEGIN
+          ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                         TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
+                         TRV1 : IN OUT PACK1.PRIVY; TRT1: IN OUT TASK1;
+                         TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                         TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                         TAV1 : IN OUT ARR_PVT; TAT1 : IN OUT ARR_TSK)
+          DO
+               TRI1 := REC.RI1 + 1;
+               TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+               TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+               TRP1 := NEW INTEGER'(TRP1.ALL + 1);
+               TRV1 := PACK1.NEXT(TRV1);
+               TRT1.NEXT;
+               TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
+               TAA1 := (OTHERS => (OTHERS => AA1(TAA1'FIRST)(1) + 1));
+               TAR1 := (OTHERS => (D => 1,
+                              FIELD1 => (AR1(TAR1'FIRST).FIELD1 + 1)));
+               TAP1 := (OTHERS => NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
+               FOR J IN TAV1'RANGE LOOP
+                    TAV1(J) := PACK1.NEXT(TAV1(J));
+               END LOOP;
+               FOR J IN TAT1'RANGE LOOP
+                    TAT1(J).NEXT;
+               END LOOP;
+          END ENTRY1;
+     END TASK2;
+
+BEGIN
+     TEST ("C85006A", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+                      "CREATED BY AN OBJECT DECLARATION CAN BE " &
+                      "RENAMED AND HAS THE CORRECT VALUE, AND THAT " &
+                      "THE NEW NAME CAN BE USED IN AN ASSIGNMENT " &
+                      "STATEMENT AND PASSED ON AS AN ACTUAL " &
+                      "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                      "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                      "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                      "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
+                      "REFLECTED BY THE VALUE OF THE NEW NAME");
+
+     DECLARE
+          PACKAGE GENPACK1 IS NEW
+               GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                         XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+     BEGIN
+          NULL;
+     END;
+
+     IF XRI1 /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE OF XRI1 (1)");
+     END IF;
+
+     IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+          FAILED ("INCORRECT VALUE OF XRA1 (1)");
+     END IF;
+
+     IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+          FAILED ("INCORRECT VALUE OF XRR1 (1)");
+     END IF;
+
+     IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT VALUE OF XRP1 (1)");
+     END IF;
+
+     IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
+          FAILED ("INCORRECT VALUE OF XRV1 (1)");
+     END IF;
+
+     XRT1.VALU(I);
+     IF I /= IDENT_INT(1) THEN
+          FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
+     END IF;
+
+     FOR J IN XAI1'RANGE LOOP
+          IF XAI1(J) /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
+                       ") (1)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAA1'RANGE LOOP
+          IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
+                       ") (1)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAR1'RANGE LOOP
+          IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
+                       ") (1)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAP1'RANGE LOOP
+          IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(1)
+          THEN
+               FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
+                       ") (1)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAV1'RANGE LOOP
+          IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
+               FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
+                       ") (1)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAT1'RANGE LOOP
+          XAT1(J).VALU(I);
+          IF I /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                       INTEGER'IMAGE(J) & ").VALU (1)");
+          END IF;
+     END LOOP;
+
+     PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+            XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+     IF XRI1 /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE OF XRI1 (2)");
+     END IF;
+
+     IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+          FAILED ("INCORRECT VALUE OF XRA1 (2)");
+     END IF;
+
+     IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+          FAILED ("INCORRECT VALUE OF XRR1 (2)");
+     END IF;
+
+     IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT VALUE OF XRP1 (2)");
+     END IF;
+
+     IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
+          FAILED ("INCORRECT VALUE OF XRV1 (2)");
+     END IF;
+
+     XRT1.VALU(I);
+     IF I /= IDENT_INT(2) THEN
+          FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
+     END IF;
+
+     FOR J IN XAI1'RANGE LOOP
+          IF XAI1(J) /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
+                       ") (2)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAA1'RANGE LOOP
+          IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
+                       ") (2)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAR1'RANGE LOOP
+          IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
+                       ") (2)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAP1'RANGE LOOP
+          IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(2)
+          THEN
+               FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
+                       ") (2)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAV1'RANGE LOOP
+          IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
+               FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
+                       ") (2)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAT1'RANGE LOOP
+          XAT1(J).VALU(I);
+          IF I /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                       INTEGER'IMAGE(J) & ").VALU (2)");
+          END IF;
+     END LOOP;
+
+     CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                     XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+     IF XRI1 /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE OF XRI1 (3)");
+     END IF;
+
+     IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+          FAILED ("INCORRECT VALUE OF XRA1 (3)");
+     END IF;
+
+     IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+          FAILED ("INCORRECT VALUE OF XRR1 (3)");
+     END IF;
+
+     IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT VALUE OF XRP1 (3)");
+     END IF;
+
+     IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
+          FAILED ("INCORRECT VALUE OF XRV1 (3)");
+     END IF;
+
+     XRT1.VALU(I);
+     IF I /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
+     END IF;
+
+     FOR J IN XAI1'RANGE LOOP
+          IF XAI1(J) /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
+                       ") (3)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAA1'RANGE LOOP
+          IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
+                       ") (3)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAR1'RANGE LOOP
+          IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
+                       ") (3)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAP1'RANGE LOOP
+          IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(3)
+          THEN
+               FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
+                       ") (3)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAV1'RANGE LOOP
+          IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
+               FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
+                       ") (3)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAT1'RANGE LOOP
+          XAT1(J).VALU(I);
+          IF I /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                       INTEGER'IMAGE(J) & ").VALU (3)");
+          END IF;
+     END LOOP;
+
+     XRI1 := XRI1 + 1;
+     XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
+     XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
+     XRP1 := NEW INTEGER'(XRP1.ALL + 1);
+     XRV1 := PACK1.NEXT(XRV1);
+     XRT1.NEXT;
+     XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
+     XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
+     XAR1 := (OTHERS => (D => 1,
+                         FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
+     XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
+     FOR J IN XAV1'RANGE LOOP
+          XAV1(J) := PACK1.NEXT(XAV1(J));
+     END LOOP;
+     FOR J IN XAT1'RANGE LOOP
+          XAT1(J).NEXT;
+     END LOOP;
+
+     IF XRI1 /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT VALUE OF XRI1 (4)");
+     END IF;
+
+     IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+          FAILED ("INCORRECT VALUE OF XRA1 (4)");
+     END IF;
+
+     IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+          FAILED ("INCORRECT VALUE OF XRR1 (4)");
+     END IF;
+
+     IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT VALUE OF XRP1 (4)");
+     END IF;
+
+     IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
+          FAILED ("INCORRECT VALUE OF XRV1 (4)");
+     END IF;
+
+     XRT1.VALU(I);
+     IF I /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
+     END IF;
+
+     FOR J IN XAI1'RANGE LOOP
+          IF XAI1(J) /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
+                       ") (4)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAA1'RANGE LOOP
+          IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
+                       ") (4)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAR1'RANGE LOOP
+          IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
+                       ") (4)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAP1'RANGE LOOP
+          IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(4)
+          THEN
+               FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
+                       ") (4)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAV1'RANGE LOOP
+          IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
+               FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
+                       ") (4)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAT1'RANGE LOOP
+          XAT1(J).VALU(I);
+          IF I /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                       INTEGER'IMAGE(J) & ").VALU (4)");
+          END IF;
+     END LOOP;
+
+     REC.RI1 := REC.RI1 + 1;
+     REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+     REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+     REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+     REC.RV1 := PACK1.NEXT(REC.RV1);
+     REC.RT1.NEXT;
+     AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
+     AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
+     AR1 := (OTHERS => (D => 1,
+                        FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
+     AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
+     FOR J IN XAV1'RANGE LOOP
+          AV1(J) := PACK1.NEXT(AV1(J));
+     END LOOP;
+     FOR J IN XAT1'RANGE LOOP
+          AT1(J).NEXT;
+     END LOOP;
+
+     IF XRI1 /= IDENT_INT(5) THEN
+          FAILED ("INCORRECT VALUE OF XRI1 (5)");
+     END IF;
+
+     IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+          FAILED ("INCORRECT VALUE OF XRA1 (5)");
+     END IF;
+
+     IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+          FAILED ("INCORRECT VALUE OF XRR1 (5)");
+     END IF;
+
+     IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
+          FAILED ("INCORRECT VALUE OF XRP1 (5)");
+     END IF;
+
+     IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
+          FAILED ("INCORRECT VALUE OF XRV1 (5)");
+     END IF;
+
+     XRT1.VALU(I);
+     IF I /= IDENT_INT(5) THEN
+          FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
+     END IF;
+
+     FOR J IN XAI1'RANGE LOOP
+          IF XAI1(J) /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XAI1(" & INTEGER'IMAGE(J) &
+                       ") (5)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAA1'RANGE LOOP
+          IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XAA1(" & INTEGER'IMAGE(J) &
+                       ") (5)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAR1'RANGE LOOP
+          IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XAR1(" & INTEGER'IMAGE(J) &
+                       ") (5)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAP1'RANGE LOOP
+          IF XAP1(J) /= IDENT(AP1(J)) OR XAP1(J).ALL /= IDENT_INT(5)
+          THEN
+               FAILED ("INCORRECT VALUE OF XAP1(" & INTEGER'IMAGE(J) &
+                       ") (5)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAV1'RANGE LOOP
+          IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
+               FAILED ("INCORRECT VALUE OF XAV1(" & INTEGER'IMAGE(J) &
+                       ") (5)");
+          END IF;
+     END LOOP;
+
+     FOR J IN XAT1'RANGE LOOP
+          XAT1(J).VALU(I);
+          IF I /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                       INTEGER'IMAGE(J) & ").VALU (5)");
+          END IF;
+     END LOOP;
+
+     REC.RT1.STOP;
+
+     FOR I IN AT1'RANGE LOOP
+          AT1(I).STOP;
+     END LOOP;
+
+     RESULT;
+END C85006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006b.ada
new file mode 100644
index 000000000..885d8393a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006b.ada
@@ -0,0 +1,699 @@
+-- C85006B.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 COMPONENT OR SLICE OF A VARIABLE CREATED BY A
+--     SUBPROGRAM 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE
+--     CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
+--     STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT'
+--     OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
+--     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
+--     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+
+-- HISTORY:
+--     JET 03/22/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85006B IS
+
+     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     TYPE RECORD1 (D : INTEGER) IS
+          RECORD
+               FIELD1 : INTEGER := 1;
+          END RECORD;
+     TYPE POINTER1 IS ACCESS INTEGER;
+
+     PACKAGE PACK1 IS
+          TYPE PRIVY IS PRIVATE;
+          ZERO : CONSTANT PRIVY;
+          ONE : CONSTANT PRIVY;
+          TWO : CONSTANT PRIVY;
+          THREE : CONSTANT PRIVY;
+          FOUR : CONSTANT PRIVY;
+          FIVE : CONSTANT PRIVY;
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+     PRIVATE
+          TYPE PRIVY IS RANGE 0..127;
+          ZERO : CONSTANT PRIVY := 0;
+          ONE : CONSTANT PRIVY := 1;
+          TWO : CONSTANT PRIVY := 2;
+          THREE : CONSTANT PRIVY := 3;
+          FOUR : CONSTANT PRIVY := 4;
+          FIVE : CONSTANT PRIVY := 5;
+     END PACK1;
+
+     TASK TYPE TASK1 IS
+          ENTRY ASSIGN (J : IN INTEGER);
+          ENTRY VALU (J : OUT INTEGER);
+          ENTRY NEXT;
+          ENTRY STOP;
+     END TASK1;
+
+     TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
+     TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
+     TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
+     TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
+     TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
+     TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
+
+     TYPE REC_TYPE IS RECORD
+          RI1 : INTEGER := 0;
+          RA1 : ARRAY1(1..3) := (OTHERS => 0);
+          RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+          RP1 : POINTER1 := NEW INTEGER'(0);
+          RV1 : PACK1.PRIVY := PACK1.ZERO;
+          RT1 : TASK1;
+     END RECORD;
+
+     DREC : REC_TYPE;
+
+     DAI1 : ARR_INT(1..8) := (OTHERS => 0);
+     DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
+     DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
+     DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
+     DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
+     DAT1 : ARR_TSK(1..8);
+
+     GENERIC
+          GRI1 : IN OUT INTEGER;
+          GRA1 : IN OUT ARRAY1;
+          GRR1 : IN OUT RECORD1;
+          GRP1 : IN OUT POINTER1;
+          GRV1 : IN OUT PACK1.PRIVY;
+          GRT1 : IN OUT TASK1;
+          GAI1 : IN OUT ARR_INT;
+          GAA1 : IN OUT ARR_ARR;
+          GAR1 : IN OUT ARR_REC;
+          GAP1 : IN OUT ARR_PTR;
+          GAV1 : IN OUT ARR_PVT;
+          GAT1 : IN OUT ARR_TSK;
+     PACKAGE GENERIC1 IS
+     END GENERIC1;
+
+     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN P;
+          ELSE
+               RETURN NULL;
+          END IF;
+     END IDENT;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN I;
+               ELSE
+                    RETURN PRIVY'(0);
+               END IF;
+          END IDENT;
+
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               RETURN I+1;
+          END NEXT;
+     END PACK1;
+
+     PACKAGE BODY GENERIC1 IS
+     BEGIN
+          GRI1 := GRI1 + 1;
+          GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
+          GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
+          GRP1 := NEW INTEGER'(GRP1.ALL + 1);
+          GRV1 := PACK1.NEXT(GRV1);
+          GRT1.NEXT;
+          GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
+          GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
+          GAR1 := (OTHERS => (D => 1,
+                              FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
+          GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
+          FOR J IN GAV1'RANGE LOOP
+               GAV1(J) := PACK1.NEXT(GAV1(J));
+          END LOOP;
+          FOR J IN GAT1'RANGE LOOP
+               GAT1(J).NEXT;
+          END LOOP;
+     END GENERIC1;
+
+     TASK BODY TASK1 IS
+          TASK_VALUE : INTEGER := 0;
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ASSIGN (J : IN INTEGER) DO
+                         TASK_VALUE := J;
+                    END ASSIGN;
+               OR
+                    ACCEPT VALU (J : OUT INTEGER) DO
+                         J := TASK_VALUE;
+                    END VALU;
+               OR
+                    ACCEPT NEXT DO
+                         TASK_VALUE := TASK_VALUE + 1;
+                    END NEXT;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END TASK1;
+
+     PROCEDURE PROC (REC : IN OUT REC_TYPE;
+                     AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
+                     AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
+                     AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK) IS
+
+          XRI1 : INTEGER RENAMES REC.RI1;
+          XRA1 : ARRAY1 RENAMES REC.RA1;
+          XRR1 : RECORD1 RENAMES REC.RR1;
+          XRP1 : POINTER1 RENAMES REC.RP1;
+          XRV1 : PACK1.PRIVY RENAMES REC.RV1;
+          XRT1 : TASK1 RENAMES REC.RT1;
+          XAI1 : ARR_INT RENAMES AI1(1..3);
+          XAA1 : ARR_ARR RENAMES AA1(2..4);
+          XAR1 : ARR_REC RENAMES AR1(3..5);
+          XAP1 : ARR_PTR RENAMES AP1(4..6);
+          XAV1 : ARR_PVT RENAMES AV1(5..7);
+          XAT1 : ARR_TSK RENAMES AT1(6..8);
+
+          TASK TYPE TASK2 IS
+               ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                             TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
+                             TRV1 : IN OUT PACK1.PRIVY;
+                             TRT1 : IN OUT TASK1;
+                             TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                             TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                             TAV1 : IN OUT ARR_PVT;
+                             TAT1 : IN OUT ARR_TSK);
+          END TASK2;
+
+          I : INTEGER;
+          CHK_TASK : TASK2;
+
+          TASK BODY TASK2 IS
+          BEGIN
+               ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                              TRR1 : OUT RECORD1;
+                              TRP1 : IN OUT POINTER1;
+                              TRV1 : IN OUT PACK1.PRIVY;
+                              TRT1: IN OUT TASK1;
+                              TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                              TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                              TAV1 : IN OUT ARR_PVT;
+                              TAT1 : IN OUT ARR_TSK)
+               DO
+                    TRI1 := REC.RI1 + 1;
+                    TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+                    TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+                    TRP1 := NEW INTEGER'(TRP1.ALL + 1);
+                    TRV1 := PACK1.NEXT(TRV1);
+                    TRT1.NEXT;
+                    TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
+                    TAA1 := (OTHERS => (OTHERS =>
+                                        AA1(TAA1'FIRST)(1) + 1));
+                    TAR1 := (OTHERS => (D => 1,
+                              FIELD1 => (AR1(TAR1'FIRST).FIELD1 + 1)));
+                    TAP1 := (OTHERS =>
+                              NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
+                    FOR J IN TAV1'RANGE LOOP
+                         TAV1(J) := PACK1.NEXT(TAV1(J));
+                    END LOOP;
+                    FOR J IN TAT1'RANGE LOOP
+                         TAT1(J).NEXT;
+                    END LOOP;
+               END ENTRY1;
+          END TASK2;
+
+          PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
+                           PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
+                           PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
+                           PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
+                           PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
+                           PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
+          BEGIN
+               PRI1 := PRI1 + 1;
+               PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
+               PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
+               PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+               PRV1 := PACK1.NEXT(REC.RV1);
+               PRT1.NEXT;
+               PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
+               PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
+               PAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                   (PAR1(PAR1'FIRST).FIELD1 + 1)));
+               PAP1 := (OTHERS => NEW INTEGER'(AP1(PAP1'FIRST).ALL+1));
+               FOR J IN PAV1'RANGE LOOP
+                    PAV1(J) := PACK1.NEXT(AV1(J));
+               END LOOP;
+               FOR J IN PAT1'RANGE LOOP
+                    PAT1(J).NEXT;
+               END LOOP;
+          END PROC1;
+
+          PACKAGE GENPACK1 IS NEW
+               GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                         XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+     BEGIN
+          IF XRI1 /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (1)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (1)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (1)");
+          END IF;
+
+          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (1)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (1)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(1)
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (1)");
+               END IF;
+          END LOOP;
+
+          PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+          IF XRI1 /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (2)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (2)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (2)");
+          END IF;
+
+          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (2)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (2)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (2)");
+               END IF;
+          END LOOP;
+
+          CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+          IF XRI1 /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (3)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (3)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (3)");
+          END IF;
+
+          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (3)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (3)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (3)");
+               END IF;
+          END LOOP;
+
+          XRI1 := XRI1 + 1;
+          XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
+          XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
+          XRP1 := NEW INTEGER'(XRP1.ALL + 1);
+          XRV1 := PACK1.NEXT(XRV1);
+          XRT1.NEXT;
+          XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
+          XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
+          XAR1 := (OTHERS => (D => 1,
+                         FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
+          XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
+          FOR J IN XAV1'RANGE LOOP
+               XAV1(J) := PACK1.NEXT(XAV1(J));
+          END LOOP;
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).NEXT;
+          END LOOP;
+
+          IF XRI1 /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (4)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (4)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (4)");
+          END IF;
+
+          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (4)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (4)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (4)");
+               END IF;
+          END LOOP;
+
+          REC.RI1 := REC.RI1 + 1;
+          REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+          REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+          REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+          REC.RV1 := PACK1.NEXT(REC.RV1);
+          REC.RT1.NEXT;
+          AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
+          AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
+          AR1 := (OTHERS => (D => 1,
+                             FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
+          AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
+          FOR J IN XAV1'RANGE LOOP
+               AV1(J) := PACK1.NEXT(AV1(J));
+          END LOOP;
+          FOR J IN XAT1'RANGE LOOP
+               AT1(J).NEXT;
+          END LOOP;
+
+          IF XRI1 /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (5)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (5)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (5)");
+          END IF;
+
+          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (5)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (5)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+               XAP1(J).ALL /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (5)");
+               END IF;
+          END LOOP;
+
+     END PROC;
+
+BEGIN
+     TEST ("C85006B", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+                      "CREATED BY A SUBPROGRAM 'IN OUT' FORMAL " &
+                      "PARAMETER CAN BE RENAMED AND HAS THE CORRECT " &
+                      "VALUE, AND THAT THE NEW NAME CAN BE USED IN " &
+                      "AN ASSIGNMENT STATEMENT AND PASSED ON AS AN " &
+                      "ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                      "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                      "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                      "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
+                      "REFLECTED BY THE VALUE OF THE NEW NAME");
+
+     PROC (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
+
+     DREC.RT1.STOP;
+
+     FOR I IN DAT1'RANGE LOOP
+          DAT1(I).STOP;
+     END LOOP;
+
+     RESULT;
+END C85006B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006c.ada
new file mode 100644
index 000000000..74a7dbfb5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006c.ada
@@ -0,0 +1,778 @@
+-- C85006C.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 COMPONENT OR SLICE OF A VARIABLE CREATED BY AN ENTRY
+--     'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE CORRECT
+--     VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
+--     STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY
+--     'IN OUT' OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT'
+--     PARAMETER, AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS
+--     CHANGED, THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+
+-- HISTORY:
+--     JET 03/22/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85006C IS
+
+     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     TYPE RECORD1 (D : INTEGER) IS
+          RECORD
+               FIELD1 : INTEGER := 1;
+          END RECORD;
+     TYPE POINTER1 IS ACCESS INTEGER;
+
+     PACKAGE PACK1 IS
+          TYPE PRIVY IS PRIVATE;
+          ZERO : CONSTANT PRIVY;
+          ONE : CONSTANT PRIVY;
+          TWO : CONSTANT PRIVY;
+          THREE : CONSTANT PRIVY;
+          FOUR : CONSTANT PRIVY;
+          FIVE : CONSTANT PRIVY;
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+     PRIVATE
+          TYPE PRIVY IS RANGE 0..127;
+          ZERO : CONSTANT PRIVY := 0;
+          ONE : CONSTANT PRIVY := 1;
+          TWO : CONSTANT PRIVY := 2;
+          THREE : CONSTANT PRIVY := 3;
+          FOUR : CONSTANT PRIVY := 4;
+          FIVE : CONSTANT PRIVY := 5;
+     END PACK1;
+
+     TASK TYPE TASK1 IS
+          ENTRY ASSIGN (J : IN INTEGER);
+          ENTRY VALU (J : OUT INTEGER);
+          ENTRY NEXT;
+          ENTRY STOP;
+     END TASK1;
+
+     TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
+     TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
+     TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
+     TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
+     TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
+     TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
+
+     TYPE REC_TYPE IS RECORD
+          RI1 : INTEGER := 0;
+          RA1 : ARRAY1(1..3) := (OTHERS => 0);
+          RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+          RP1 : POINTER1 := NEW INTEGER'(0);
+          RV1 : PACK1.PRIVY := PACK1.ZERO;
+          RT1 : TASK1;
+     END RECORD;
+
+     DREC : REC_TYPE;
+
+     DAI1 : ARR_INT(1..8) := (OTHERS => 0);
+     DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
+     DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
+     DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
+     DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
+     DAT1 : ARR_TSK(1..8);
+
+     I : INTEGER;
+
+     GENERIC
+          GRI1 : IN OUT INTEGER;
+          GRA1 : IN OUT ARRAY1;
+          GRR1 : IN OUT RECORD1;
+          GRP1 : IN OUT POINTER1;
+          GRV1 : IN OUT PACK1.PRIVY;
+          GRT1 : IN OUT TASK1;
+          GAI1 : IN OUT ARR_INT;
+          GAA1 : IN OUT ARR_ARR;
+          GAR1 : IN OUT ARR_REC;
+          GAP1 : IN OUT ARR_PTR;
+          GAV1 : IN OUT ARR_PVT;
+          GAT1 : IN OUT ARR_TSK;
+     PACKAGE GENERIC1 IS
+     END GENERIC1;
+
+     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN P;
+          ELSE
+               RETURN NULL;
+          END IF;
+     END IDENT;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN I;
+               ELSE
+                    RETURN PRIVY'(0);
+               END IF;
+          END IDENT;
+
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               RETURN I+1;
+          END NEXT;
+     END PACK1;
+
+     PACKAGE BODY GENERIC1 IS
+     BEGIN
+          GRI1 := GRI1 + 1;
+          GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
+          GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
+          GRP1 := NEW INTEGER'(GRP1.ALL + 1);
+          GRV1 := PACK1.NEXT(GRV1);
+          GRT1.NEXT;
+          GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
+          GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
+          GAR1 := (OTHERS => (D => 1,
+                              FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
+          GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
+          FOR J IN GAV1'RANGE LOOP
+               GAV1(J) := PACK1.NEXT(GAV1(J));
+          END LOOP;
+          FOR J IN GAT1'RANGE LOOP
+               GAT1(J).NEXT;
+          END LOOP;
+     END GENERIC1;
+
+     TASK BODY TASK1 IS
+          TASK_VALUE : INTEGER := 0;
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ASSIGN (J : IN INTEGER) DO
+                         TASK_VALUE := J;
+                    END ASSIGN;
+               OR
+                    ACCEPT VALU (J : OUT INTEGER) DO
+                         J := TASK_VALUE;
+                    END VALU;
+               OR
+                    ACCEPT NEXT DO
+                         TASK_VALUE := TASK_VALUE + 1;
+                    END NEXT;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END TASK1;
+
+BEGIN
+     TEST ("C85006C", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+                      "CREATED BY AN ENTRY 'IN OUT' FORMAL PARAMETER " &
+                      "CAN BE RENAMED AND HAS THE CORRECT VALUE, AND " &
+                      "THAT THE NEW NAME CAN BE USED IN AN ASSIGN" &
+                      "MENT STATEMENT AND PASSED ON AS AN ACTUAL " &
+                      "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                      "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                      "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                      "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
+                      "REFLECTED BY THE VALUE OF THE NEW NAME");
+
+     DECLARE
+          TASK MAIN_TASK IS
+               ENTRY START (REC : IN OUT REC_TYPE;
+                            AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
+                            AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
+                            AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK);
+          END MAIN_TASK;
+
+          TASK BODY MAIN_TASK IS
+          BEGIN
+             ACCEPT START (REC : IN OUT REC_TYPE;
+                           AI1 : IN OUT ARR_INT; AA1 : IN OUT ARR_ARR;
+                           AR1 : IN OUT ARR_REC; AP1 : IN OUT ARR_PTR;
+                           AV1 : IN OUT ARR_PVT; AT1 : IN OUT ARR_TSK)
+                DO
+                DECLARE
+                   XRI1 : INTEGER RENAMES REC.RI1;
+                   XRA1 : ARRAY1 RENAMES REC.RA1;
+                   XRR1 : RECORD1 RENAMES REC.RR1;
+                   XRP1 : POINTER1 RENAMES REC.RP1;
+                   XRV1 : PACK1.PRIVY RENAMES REC.RV1;
+                   XRT1 : TASK1 RENAMES REC.RT1;
+                   XAI1 : ARR_INT RENAMES AI1(1..3);
+                   XAA1 : ARR_ARR RENAMES AA1(2..4);
+                   XAR1 : ARR_REC RENAMES AR1(3..5);
+                   XAP1 : ARR_PTR RENAMES AP1(4..6);
+                   XAV1 : ARR_PVT RENAMES AV1(5..7);
+                   XAT1 : ARR_TSK RENAMES AT1(6..8);
+
+                   TASK TYPE TASK2 IS
+                      ENTRY ENTRY1 (TRI1 : OUT INTEGER;
+                                    TRA1 : OUT ARRAY1;
+                                    TRR1 : OUT RECORD1;
+                                    TRP1 : IN OUT POINTER1;
+                                    TRV1 : IN OUT PACK1.PRIVY;
+                                    TRT1 : IN OUT TASK1;
+                                    TAI1 : OUT ARR_INT;
+                                    TAA1 : OUT ARR_ARR;
+                                    TAR1 : OUT ARR_REC;
+                                    TAP1 : IN OUT ARR_PTR;
+                                    TAV1 : IN OUT ARR_PVT;
+                                    TAT1 : IN OUT ARR_TSK);
+                   END TASK2;
+
+                   CHK_TASK : TASK2;
+
+                   TASK BODY TASK2 IS
+                   BEGIN
+                      ACCEPT ENTRY1 (TRI1 : OUT INTEGER;
+                                     TRA1 : OUT ARRAY1;
+                                     TRR1 : OUT RECORD1;
+                                     TRP1 : IN OUT POINTER1;
+                                     TRV1 : IN OUT PACK1.PRIVY;
+                                     TRT1: IN OUT TASK1;
+                                     TAI1 : OUT ARR_INT;
+                                     TAA1 : OUT ARR_ARR;
+                                     TAR1 : OUT ARR_REC;
+                                     TAP1 : IN OUT ARR_PTR;
+                                     TAV1 : IN OUT ARR_PVT;
+                                     TAT1 : IN OUT ARR_TSK)
+                      DO
+                         TRI1 := REC.RI1 + 1;
+                         TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
+                                  REC.RA1(3)+1);
+                         TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+                         TRP1 := NEW INTEGER'(TRP1.ALL + 1);
+                         TRV1 := PACK1.NEXT(TRV1);
+                         TRT1.NEXT;
+                         TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
+                         TAA1 := (OTHERS => (OTHERS =>
+                                             AA1(TAA1'FIRST)(1) + 1));
+                         TAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                        (AR1(TAR1'FIRST).FIELD1 + 1)));
+                         TAP1 := (OTHERS =>
+                                  NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
+                         FOR J IN TAV1'RANGE LOOP
+                            TAV1(J) := PACK1.NEXT(TAV1(J));
+                         END LOOP;
+                         FOR J IN TAT1'RANGE LOOP
+                            TAT1(J).NEXT;
+                         END LOOP;
+                      END ENTRY1;
+                   END TASK2;
+
+                   PROCEDURE PROC1 (PRI1 : IN OUT INTEGER;
+                                    PRA1 : IN OUT ARRAY1;
+                                    PRR1 : IN OUT RECORD1;
+                                    PRP1 : OUT POINTER1;
+                                    PRV1 : OUT PACK1.PRIVY;
+                                    PRT1 : IN OUT TASK1;
+                                    PAI1 : IN OUT ARR_INT;
+                                    PAA1 : IN OUT ARR_ARR;
+                                    PAR1 : IN OUT ARR_REC;
+                                    PAP1 : OUT ARR_PTR;
+                                    PAV1 : OUT ARR_PVT;
+                                    PAT1 : IN OUT ARR_TSK) IS
+                   BEGIN
+                      PRI1 := PRI1 + 1;
+                      PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
+                      PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
+                      PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+                      PRV1 := PACK1.NEXT(REC.RV1);
+                      PRT1.NEXT;
+                      PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
+                      PAA1 := (OTHERS => (OTHERS =>
+                                          PAA1(PAA1'FIRST)(1) + 1));
+                      PAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                         (PAR1(PAR1'FIRST).FIELD1+1)));
+                      PAP1 := (OTHERS =>
+                               NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
+                      FOR J IN PAV1'RANGE LOOP
+                         PAV1(J) := PACK1.NEXT(AV1(J));
+                      END LOOP;
+                      FOR J IN PAT1'RANGE LOOP
+                         PAT1(J).NEXT;
+                      END LOOP;
+                   END PROC1;
+
+                   PACKAGE GENPACK2 IS NEW GENERIC1
+                      (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                       XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+                BEGIN
+                         IF XRI1 /= IDENT_INT(1) THEN
+                              FAILED ("INCORRECT VALUE OF XRI1 (1)");
+                         END IF;
+
+                         IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),
+                                     IDENT_INT(1)) THEN
+                              FAILED ("INCORRECT VALUE OF XRA1 (1)");
+                         END IF;
+
+                         IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XRR1 (1)");
+                         END IF;
+
+                         IF XRP1 /= IDENT(REC.RP1) OR
+                            XRP1.ALL /= IDENT_INT(1) THEN
+                              FAILED ("INCORRECT VALUE OF XRP1 (1)");
+                         END IF;
+
+                         IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XRV1 (1)");
+                         END IF;
+
+                         XRT1.VALU(I);
+                         IF I /= IDENT_INT(1) THEN
+                              FAILED ("INCORRECT RETURN VALUE OF " &
+                                      "XRT1.VALU (1)");
+                         END IF;
+
+                         FOR J IN XAI1'RANGE LOOP
+                              IF XAI1(J) /= IDENT_INT(1) THEN
+                                   FAILED ("INCORRECT VALUE OF XAI1(" &
+                                           INTEGER'IMAGE(J) & ") (1)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAA1'RANGE LOOP
+                              IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),
+                                             IDENT_INT(1)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAA1(" &
+                                           INTEGER'IMAGE(J) & ") (1)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAR1'RANGE LOOP
+                              IF XAR1(J) /= (D => 1,
+                                      FIELD1 => IDENT_INT(1)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAR1(" &
+                                           INTEGER'IMAGE(J) & ") (1)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAP1'RANGE LOOP
+                              IF XAP1(J) /= IDENT(AP1(J)) OR
+                                 XAP1(J).ALL /= IDENT_INT(1) THEN
+                                   FAILED ("INCORRECT VALUE OF XAP1(" &
+                                           INTEGER'IMAGE(J) & ") (1)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAV1'RANGE LOOP
+                              IF PACK1."/=" (XAV1(J),
+                                        PACK1.IDENT(PACK1.ONE)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAV1(" &
+                                           INTEGER'IMAGE(J) & ") (1)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAT1'RANGE LOOP
+                              XAT1(J).VALU(I);
+                              IF I /= IDENT_INT(1) THEN
+                                   FAILED ("INCORRECT RETURN VALUE " &
+                                      "FROM XAT1(" & INTEGER'IMAGE(J) &
+                                      ").VALU (1)");
+                              END IF;
+                         END LOOP;
+
+                         PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                                XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+                         IF XRI1 /= IDENT_INT(2) THEN
+                              FAILED ("INCORRECT VALUE OF XRI1 (2)");
+                         END IF;
+
+                         IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),
+                                     IDENT_INT(2)) THEN
+                              FAILED ("INCORRECT VALUE OF XRA1 (2)");
+                         END IF;
+
+                         IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XRR1 (2)");
+                         END IF;
+
+                         IF XRP1 /= IDENT(REC.RP1) OR
+                            XRP1.ALL /= IDENT_INT(2) THEN
+                              FAILED ("INCORRECT VALUE OF XRP1 (2)");
+                         END IF;
+
+                         IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XRV1 (2)");
+                         END IF;
+
+                         XRT1.VALU(I);
+                         IF I /= IDENT_INT(2) THEN
+                              FAILED ("INCORRECT RETURN VALUE FROM " &
+                                      "XRT1.VALU (2)");
+                         END IF;
+
+                         FOR J IN XAI1'RANGE LOOP
+                              IF XAI1(J) /= IDENT_INT(2) THEN
+                                   FAILED ("INCORRECT VALUE OF XAI1(" &
+                                           INTEGER'IMAGE(J) & ") (2)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAA1'RANGE LOOP
+                              IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),
+                                             IDENT_INT(2)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAA1(" &
+                                           INTEGER'IMAGE(J) & ") (2)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAR1'RANGE LOOP
+                              IF XAR1(J) /= (D => 1,
+                                       FIELD1 => IDENT_INT(2)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAR1(" &
+                                           INTEGER'IMAGE(J) & ") (2)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAP1'RANGE LOOP
+                              IF XAP1(J) /= IDENT(AP1(J)) OR
+                                 XAP1(J).ALL /= IDENT_INT(2) THEN
+                                   FAILED ("INCORRECT VALUE OF XAP1(" &
+                                           INTEGER'IMAGE(J) & ") (2)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAV1'RANGE LOOP
+                              IF PACK1."/=" (XAV1(J),
+                                      PACK1.IDENT(PACK1.TWO)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAV1(" &
+                                           INTEGER'IMAGE(J) & ") (2)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAT1'RANGE LOOP
+                              XAT1(J).VALU(I);
+                              IF I /= IDENT_INT(2) THEN
+                                   FAILED ("INCORRECT RETURN VALUE " &
+                                      "FROM XAT1(" & INTEGER'IMAGE(J) &
+                                      ").VALU (2)");
+                              END IF;
+                         END LOOP;
+
+                         CHK_TASK.ENTRY1
+                              (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                               XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+                         IF XRI1 /= IDENT_INT(3) THEN
+                              FAILED ("INCORRECT VALUE OF XRI1 (3)");
+                         END IF;
+
+                         IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),
+                                     IDENT_INT(3)) THEN
+                              FAILED ("INCORRECT VALUE OF XRA1 (3)");
+                         END IF;
+
+                         IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XRR1 (3)");
+                         END IF;
+
+                         IF XRP1 /= IDENT(REC.RP1) OR
+                            XRP1.ALL /= IDENT_INT(3) THEN
+                              FAILED ("INCORRECT VALUE OF XRP1 (3)");
+                         END IF;
+
+                         IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XRV1 (3)");
+                         END IF;
+
+                         XRT1.VALU(I);
+                         IF I /= IDENT_INT(3) THEN
+                              FAILED ("INCORRECT RETURN VALUE OF " &
+                                      "XRT1.VALU (3)");
+                         END IF;
+
+                         FOR J IN XAI1'RANGE LOOP
+                              IF XAI1(J) /= IDENT_INT(3) THEN
+                                   FAILED ("INCORRECT VALUE OF XAI1(" &
+                                           INTEGER'IMAGE(J) & ") (3)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAA1'RANGE LOOP
+                              IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),
+                                             IDENT_INT(3))
+                              THEN
+                                   FAILED ("INCORRECT VALUE OF XAA1(" &
+                                           INTEGER'IMAGE(J) & ") (3)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAR1'RANGE LOOP
+                              IF XAR1(J) /= (D => 1,
+                                      FIELD1 => IDENT_INT(3)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAR1(" &
+                                           INTEGER'IMAGE(J) & ") (3)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAP1'RANGE LOOP
+                              IF XAP1(J) /= IDENT(AP1(J)) OR
+                                 XAP1(J).ALL /= IDENT_INT(3) THEN
+                                   FAILED ("INCORRECT VALUE OF XAP1(" &
+                                           INTEGER'IMAGE(J) & ") (3)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAV1'RANGE LOOP
+                              IF PACK1."/=" (XAV1(J),
+                                      PACK1.IDENT(PACK1.THREE)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAV1(" &
+                                           INTEGER'IMAGE(J) & ") (3)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAT1'RANGE LOOP
+                              XAT1(J).VALU(I);
+                              IF I /= IDENT_INT(3) THEN
+                                   FAILED ("INCORRECT RETURN VALUE " &
+                                      "FROM XAT1(" &
+                                      INTEGER'IMAGE(J) & ").VALU (3)");
+                              END IF;
+                         END LOOP;
+
+                         XRI1 := XRI1 + 1;
+                         XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
+                         XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
+                         XRP1 := NEW INTEGER'(XRP1.ALL + 1);
+                         XRV1 := PACK1.NEXT(XRV1);
+                         XRT1.NEXT;
+                         XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
+                         XAA1 := (OTHERS =>
+                                  (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
+                         XAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                  (XAR1(XAR1'FIRST).FIELD1 + 1)));
+                         XAP1 := (OTHERS =>
+                              NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
+                         FOR J IN XAV1'RANGE LOOP
+                              XAV1(J) := PACK1.NEXT(XAV1(J));
+                         END LOOP;
+                         FOR J IN XAT1'RANGE LOOP
+                              XAT1(J).NEXT;
+                         END LOOP;
+
+                         IF XRI1 /= IDENT_INT(4) THEN
+                              FAILED ("INCORRECT VALUE OF XRI1 (4)");
+                         END IF;
+
+                         IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),
+                                     IDENT_INT(4)) THEN
+                              FAILED ("INCORRECT VALUE OF XRA1 (4)");
+                         END IF;
+
+                         IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XRR1 (4)");
+                         END IF;
+
+                         IF XRP1 /= IDENT(REC.RP1) OR
+                            XRP1.ALL /= IDENT_INT(4) THEN
+                              FAILED ("INCORRECT VALUE OF XRP1 (4)");
+                         END IF;
+
+                         IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XRV1 (4)");
+                         END IF;
+
+                         XRT1.VALU(I);
+                         IF I /= IDENT_INT(4) THEN
+                              FAILED ("INCORRECT RETURN VALUE OF " &
+                                      "XRT1.VALU (4)");
+                         END IF;
+
+                         FOR J IN XAI1'RANGE LOOP
+                              IF XAI1(J) /= IDENT_INT(4) THEN
+                                   FAILED ("INCORRECT VALUE OF XAI1(" &
+                                           INTEGER'IMAGE(J) & ") (4)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAA1'RANGE LOOP
+                              IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),
+                                             IDENT_INT(4)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAA1(" &
+                                           INTEGER'IMAGE(J) & ") (4)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAR1'RANGE LOOP
+                              IF XAR1(J) /= (D => 1, FIELD1 =>
+                                      IDENT_INT(4)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAR1(" &
+                                           INTEGER'IMAGE(J) & ") (4)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAP1'RANGE LOOP
+                              IF XAP1(J) /= IDENT(AP1(J)) OR
+                                 XAP1(J).ALL /= IDENT_INT(4) THEN
+                                   FAILED ("INCORRECT VALUE OF XAP1(" &
+                                           INTEGER'IMAGE(J) & ") (4)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAV1'RANGE LOOP
+                              IF PACK1."/=" (XAV1(J),
+                                        PACK1.IDENT(PACK1.FOUR)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAV1(" &
+                                           INTEGER'IMAGE(J) & ") (4)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAT1'RANGE LOOP
+                              XAT1(J).VALU(I);
+                              IF I /= IDENT_INT(4) THEN
+                                   FAILED ("INCORRECT RETURN VALUE " &
+                                      "FROM XAT1(" &
+                                      INTEGER'IMAGE(J) & ").VALU (4)");
+                              END IF;
+                         END LOOP;
+
+                         REC.RI1 := REC.RI1 + 1;
+                         REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1,
+                                     REC.RA1(3)+1);
+                         REC.RR1 := (D => 1, FIELD1 =>
+                                        REC.RR1.FIELD1 + 1);
+                         REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+                         REC.RV1 := PACK1.NEXT(REC.RV1);
+                         REC.RT1.NEXT;
+                         AI1(XAI1'RANGE) := (OTHERS =>
+                                             AI1(XAI1'FIRST) + 1);
+                         AA1(XAA1'RANGE) := (OTHERS =>
+                                    (OTHERS => AA1(XAA1'FIRST)(1) + 1));
+                         AR1(XAR1'RANGE) := (OTHERS => (D => 1,
+                               FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
+                         AP1(XAP1'RANGE) := (OTHERS =>
+                               NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
+                         FOR J IN XAV1'RANGE LOOP
+                              AV1(J) := PACK1.NEXT(AV1(J));
+                         END LOOP;
+                         FOR J IN XAT1'RANGE LOOP
+                              AT1(J).NEXT;
+                         END LOOP;
+
+                         IF XRI1 /= IDENT_INT(5) THEN
+                              FAILED ("INCORRECT VALUE OF XRI1 (5)");
+                         END IF;
+
+                         IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),
+                                     IDENT_INT(5)) THEN
+                              FAILED ("INCORRECT VALUE OF XRA1 (5)");
+                         END IF;
+
+                         IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XRR1 (5)");
+                         END IF;
+
+                         IF XRP1 /= IDENT(REC.RP1) OR
+                            XRP1.ALL /= IDENT_INT(5) THEN
+                              FAILED ("INCORRECT VALUE OF XRP1 (5)");
+                         END IF;
+
+                         IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE))
+                         THEN
+                              FAILED ("INCORRECT VALUE OF XRV1 (5)");
+                         END IF;
+
+                         XRT1.VALU(I);
+                         IF I /= IDENT_INT(5) THEN
+                              FAILED ("INCORRECT RETURN VALUE OF " &
+                                      "XRT1.VALU (5)");
+                         END IF;
+
+                         FOR J IN XAI1'RANGE LOOP
+                              IF XAI1(J) /= IDENT_INT(5) THEN
+                                   FAILED ("INCORRECT VALUE OF XAI1(" &
+                                           INTEGER'IMAGE(J) & ") (5)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAA1'RANGE LOOP
+                              IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),
+                                             IDENT_INT(5)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAA1(" &
+                                           INTEGER'IMAGE(J) & ") (5)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAR1'RANGE LOOP
+                              IF XAR1(J) /= (D => 1, FIELD1 =>
+                                      IDENT_INT(5)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAR1(" &
+                                           INTEGER'IMAGE(J) & ") (5)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAP1'RANGE LOOP
+                              IF XAP1(J) /= IDENT(AP1(J)) OR
+                                 XAP1(J).ALL /= IDENT_INT(5) THEN
+                                   FAILED ("INCORRECT VALUE OF XAP1(" &
+                                           INTEGER'IMAGE(J) & ") (5)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAV1'RANGE LOOP
+                              IF PACK1."/=" (XAV1(J),
+                                           PACK1.IDENT(PACK1.FIVE)) THEN
+                                   FAILED ("INCORRECT VALUE OF XAV1(" &
+                                           INTEGER'IMAGE(J) & ") (5)");
+                              END IF;
+                         END LOOP;
+
+                         FOR J IN XAT1'RANGE LOOP
+                              XAT1(J).VALU(I);
+                              IF I /= IDENT_INT(5) THEN
+                                   FAILED ("INCORRECT RETURN VALUE " &
+                                      "FROM XAT1(" &
+                                      INTEGER'IMAGE(J) & ").VALU (5)");
+                              END IF;
+                         END LOOP;
+                    END;
+               END START;
+          END MAIN_TASK;
+
+     BEGIN
+          MAIN_TASK.START (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
+     END;
+
+     DREC.RT1.STOP;
+
+     FOR I IN DAT1'RANGE LOOP
+          DAT1(I).STOP;
+     END LOOP;
+
+     RESULT;
+END C85006C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006d.ada
new file mode 100644
index 000000000..b93640214
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006d.ada
@@ -0,0 +1,712 @@
+-- C85006D.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 COMPONENT OR SLICE OF A VARIABLE CREATED BY A
+--     GENERIC 'IN OUT' FORMAL PARAMETER CAN BE RENAMED AND HAS THE
+--     CORRECT VALUE, AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT
+--     STATEMENT AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT'
+--     OR 'OUT' PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
+--     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
+--     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+
+-- HISTORY:
+--     JET 03/22/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85006D IS
+
+     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     TYPE RECORD1 (D : INTEGER) IS
+          RECORD
+               FIELD1 : INTEGER := 1;
+          END RECORD;
+     TYPE POINTER1 IS ACCESS INTEGER;
+
+     PACKAGE PACK1 IS
+          TYPE PRIVY IS PRIVATE;
+          ZERO : CONSTANT PRIVY;
+          ONE : CONSTANT PRIVY;
+          TWO : CONSTANT PRIVY;
+          THREE : CONSTANT PRIVY;
+          FOUR : CONSTANT PRIVY;
+          FIVE : CONSTANT PRIVY;
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+     PRIVATE
+          TYPE PRIVY IS RANGE 0..127;
+          ZERO : CONSTANT PRIVY := 0;
+          ONE : CONSTANT PRIVY := 1;
+          TWO : CONSTANT PRIVY := 2;
+          THREE : CONSTANT PRIVY := 3;
+          FOUR : CONSTANT PRIVY := 4;
+          FIVE : CONSTANT PRIVY := 5;
+     END PACK1;
+
+     TASK TYPE TASK1 IS
+          ENTRY ASSIGN (J : IN INTEGER);
+          ENTRY VALU (J : OUT INTEGER);
+          ENTRY NEXT;
+          ENTRY STOP;
+     END TASK1;
+
+     TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
+     TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
+     TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
+     TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
+     TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
+     TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
+
+     TYPE REC_TYPE IS RECORD
+          RI1 : INTEGER := 0;
+          RA1 : ARRAY1(1..3) := (OTHERS => 0);
+          RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+          RP1 : POINTER1 := NEW INTEGER'(0);
+          RV1 : PACK1.PRIVY := PACK1.ZERO;
+          RT1 : TASK1;
+     END RECORD;
+
+     DREC : REC_TYPE;
+
+     DAI1 : ARR_INT(1..8) := (OTHERS => 0);
+     DAA1 : ARR_ARR(1..8) := (OTHERS => (OTHERS => 0));
+     DAR1 : ARR_REC(1..8) := (OTHERS => (D => 1, FIELD1 => 0));
+     DAP1 : ARR_PTR(1..8) := (OTHERS => NEW INTEGER'(0));
+     DAV1 : ARR_PVT(1..8) := (OTHERS => PACK1.ZERO);
+     DAT1 : ARR_TSK(1..8);
+
+     GENERIC
+          REC : IN OUT REC_TYPE;
+          AI1 : IN OUT ARR_INT;
+          AA1 : IN OUT ARR_ARR;
+          AR1 : IN OUT ARR_REC;
+          AP1 : IN OUT ARR_PTR;
+          AV1 : IN OUT ARR_PVT;
+          AT1 : IN OUT ARR_TSK;
+     PACKAGE GENERIC1 IS
+     END GENERIC1;
+
+     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN P;
+          ELSE
+               RETURN NULL;
+          END IF;
+     END IDENT;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN I;
+               ELSE
+                    RETURN PRIVY'(0);
+               END IF;
+          END IDENT;
+
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               RETURN I+1;
+          END NEXT;
+     END PACK1;
+
+     PACKAGE BODY GENERIC1 IS
+          XRI1 : INTEGER RENAMES REC.RI1;
+          XRA1 : ARRAY1 RENAMES REC.RA1;
+          XRR1 : RECORD1 RENAMES REC.RR1;
+          XRP1 : POINTER1 RENAMES REC.RP1;
+          XRV1 : PACK1.PRIVY RENAMES REC.RV1;
+          XRT1 : TASK1 RENAMES REC.RT1;
+          XAI1 : ARR_INT RENAMES AI1(1..3);
+          XAA1 : ARR_ARR RENAMES AA1(2..4);
+          XAR1 : ARR_REC RENAMES AR1(3..5);
+          XAP1 : ARR_PTR RENAMES AP1(4..6);
+          XAV1 : ARR_PVT RENAMES AV1(5..7);
+          XAT1 : ARR_TSK RENAMES AT1(6..8);
+
+          TASK TYPE TASK2 IS
+               ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                             TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
+                             TRV1 : IN OUT PACK1.PRIVY;
+                             TRT1 : IN OUT TASK1;
+                             TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                             TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                             TAV1 : IN OUT ARR_PVT;
+                             TAT1 : IN OUT ARR_TSK);
+          END TASK2;
+
+          CHK_TASK : TASK2;
+          I : INTEGER;
+
+          GENERIC
+               GRI1 : IN OUT INTEGER;
+               GRA1 : IN OUT ARRAY1;
+               GRR1 : IN OUT RECORD1;
+               GRP1 : IN OUT POINTER1;
+               GRV1 : IN OUT PACK1.PRIVY;
+               GRT1 : IN OUT TASK1;
+               GAI1 : IN OUT ARR_INT;
+               GAA1 : IN OUT ARR_ARR;
+               GAR1 : IN OUT ARR_REC;
+               GAP1 : IN OUT ARR_PTR;
+               GAV1 : IN OUT ARR_PVT;
+               GAT1 : IN OUT ARR_TSK;
+          PACKAGE GENERIC2 IS
+          END GENERIC2;
+
+          PACKAGE BODY GENERIC2 IS
+          BEGIN
+               GRI1 := GRI1 + 1;
+               GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
+               GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
+               GRP1 := NEW INTEGER'(GRP1.ALL + 1);
+               GRV1 := PACK1.NEXT(GRV1);
+               GRT1.NEXT;
+               GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
+               GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
+               GAR1 := (OTHERS => (D => 1,
+                              FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
+               GAP1 := (OTHERS =>
+                         NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
+               FOR J IN GAV1'RANGE LOOP
+                    GAV1(J) := PACK1.NEXT(GAV1(J));
+               END LOOP;
+               FOR J IN GAT1'RANGE LOOP
+                    GAT1(J).NEXT;
+               END LOOP;
+          END GENERIC2;
+
+          PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
+                           PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
+                           PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
+                           PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
+                           PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
+                           PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
+          BEGIN
+               PRI1 := PRI1 + 1;
+               PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
+               PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
+               PRP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+               PRV1 := PACK1.NEXT(REC.RV1);
+               PRT1.NEXT;
+               PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
+               PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
+               PAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                   (PAR1(PAR1'FIRST).FIELD1 + 1)));
+               PAP1 := (OTHERS =>
+                        NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
+               FOR J IN PAV1'RANGE LOOP
+                    PAV1(J) := PACK1.NEXT(AV1(J));
+               END LOOP;
+               FOR J IN PAT1'RANGE LOOP
+                    PAT1(J).NEXT;
+               END LOOP;
+          END PROC1;
+
+          TASK BODY TASK2 IS
+          BEGIN
+               ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                              TRR1 : OUT RECORD1;
+                              TRP1 : IN OUT POINTER1;
+                              TRV1 : IN OUT PACK1.PRIVY;
+                              TRT1: IN OUT TASK1;
+                              TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                              TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                              TAV1 : IN OUT ARR_PVT;
+                              TAT1 : IN OUT ARR_TSK)
+               DO
+                    TRI1 := REC.RI1 + 1;
+                    TRA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+                    TRR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+                    TRP1 := NEW INTEGER'(TRP1.ALL + 1);
+                    TRV1 := PACK1.NEXT(TRV1);
+                    TRT1.NEXT;
+                    TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
+                    TAA1 := (OTHERS => (OTHERS =>
+                                        AA1(TAA1'FIRST)(1) + 1));
+                    TAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                        (AR1(TAR1'FIRST).FIELD1 + 1)));
+                    TAP1 := (OTHERS =>
+                             NEW INTEGER'(TAP1(TAP1'FIRST).ALL + 1));
+                    FOR J IN TAV1'RANGE LOOP
+                         TAV1(J) := PACK1.NEXT(TAV1(J));
+                    END LOOP;
+                    FOR J IN TAT1'RANGE LOOP
+                         TAT1(J).NEXT;
+                    END LOOP;
+               END ENTRY1;
+          END TASK2;
+
+          PACKAGE GENPACK2 IS NEW
+               GENERIC2 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                         XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+     BEGIN
+          IF XRI1 /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (1)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (1)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (1)");
+          END IF;
+
+          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (1)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (1)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(1)
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (1)");
+               END IF;
+          END LOOP;
+
+          PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+          IF XRI1 /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (2)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (2)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (2)");
+          END IF;
+
+          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (2)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (2)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (2)");
+               END IF;
+          END LOOP;
+
+          CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+          IF XRI1 /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (3)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (3)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (3)");
+          END IF;
+
+          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (3)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (3)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (3)");
+               END IF;
+          END LOOP;
+
+          XRI1 := XRI1 + 1;
+          XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
+          XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
+          XRP1 := NEW INTEGER'(XRP1.ALL + 1);
+          XRV1 := PACK1.NEXT(XRV1);
+          XRT1.NEXT;
+          XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
+          XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
+          XAR1 := (OTHERS => (D => 1,
+                         FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
+          XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
+          FOR J IN XAV1'RANGE LOOP
+               XAV1(J) := PACK1.NEXT(XAV1(J));
+          END LOOP;
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).NEXT;
+          END LOOP;
+
+          IF XRI1 /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (4)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (4)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (4)");
+          END IF;
+
+          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (4)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (4)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (4)");
+               END IF;
+          END LOOP;
+
+          REC.RI1 := REC.RI1 + 1;
+          REC.RA1 := (REC.RA1(1)+1, REC.RA1(2)+1, REC.RA1(3)+1);
+          REC.RR1 := (D => 1, FIELD1 => REC.RR1.FIELD1 + 1);
+          REC.RP1 := NEW INTEGER'(REC.RP1.ALL + 1);
+          REC.RV1 := PACK1.NEXT(REC.RV1);
+          REC.RT1.NEXT;
+          AI1 := (OTHERS => AI1(XAI1'FIRST) + 1);
+          AA1 := (OTHERS => (OTHERS => AA1(XAA1'FIRST)(1) + 1));
+          AR1 := (OTHERS => (D => 1,
+                             FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
+          AP1 := (OTHERS => NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
+          FOR J IN XAV1'RANGE LOOP
+               AV1(J) := PACK1.NEXT(AV1(J));
+          END LOOP;
+          FOR J IN XAT1'RANGE LOOP
+               AT1(J).NEXT;
+          END LOOP;
+
+          IF XRI1 /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (5)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (5)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (5)");
+          END IF;
+
+          IF XRP1 /= IDENT(REC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (5)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (5)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+               XAP1(J).ALL /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (5)");
+               END IF;
+          END LOOP;
+     END GENERIC1;
+
+     TASK BODY TASK1 IS
+          TASK_VALUE : INTEGER := 0;
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ASSIGN (J : IN INTEGER) DO
+                         TASK_VALUE := J;
+                    END ASSIGN;
+               OR
+                    ACCEPT VALU (J : OUT INTEGER) DO
+                         J := TASK_VALUE;
+                    END VALU;
+               OR
+                    ACCEPT NEXT DO
+                         TASK_VALUE := TASK_VALUE + 1;
+                    END NEXT;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END TASK1;
+
+BEGIN
+     TEST ("C85006D", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+                      "CREATED BY A GENERIC 'IN OUT' FORMAL " &
+                      "PARAMETER CAN BE RENAMED AND HAS THE CORRECT " &
+                      "VALUE, AND THAT THE NEW NAME CAN BE USED IN " &
+                      "AN ASSIGNMENT STATEMENT AND PASSED ON AS AN " &
+                      "ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                      "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                      "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                      "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
+                      "REFLECTED BY THE VALUE OF THE NEW NAME");
+
+     DECLARE
+          PACKAGE GENPACK IS NEW
+               GENERIC1 (DREC, DAI1, DAA1, DAR1, DAP1, DAV1, DAT1);
+     BEGIN
+          NULL;
+     END;
+
+     DREC.RT1.STOP;
+
+     FOR I IN DAT1'RANGE LOOP
+          DAT1(I).STOP;
+     END LOOP;
+
+     RESULT;
+END C85006D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006e.ada
new file mode 100644
index 000000000..3c920039d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006e.ada
@@ -0,0 +1,702 @@
+-- C85006E.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 COMPONENT OR SLICE OF A VARIABLE CREATED BY AN
+--     ALLOCATOR CAN BE RENAMED AND HAS THE CORRECT VALUE,
+--     AND THAT THE NEW NAME CAN BE USED IN AN ASSIGNMENT STATEMENT
+--     AND PASSED ON AS AN ACTUAL SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT'
+--     PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' PARAMETER,
+--     AND THAT WHEN THE VALUE OF THE RENAMED VARIABLE IS CHANGED,
+--     THE NEW VALUE IS REFLECTED BY THE VALUE OF THE NEW NAME.
+
+-- HISTORY:
+--     JET 03/22/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85006E IS
+
+     TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+     TYPE RECORD1 (D : INTEGER) IS
+          RECORD
+               FIELD1 : INTEGER := 1;
+          END RECORD;
+     TYPE POINTER1 IS ACCESS INTEGER;
+
+     PACKAGE PACK1 IS
+          TYPE PRIVY IS PRIVATE;
+          ZERO : CONSTANT PRIVY;
+          ONE : CONSTANT PRIVY;
+          TWO : CONSTANT PRIVY;
+          THREE : CONSTANT PRIVY;
+          FOUR : CONSTANT PRIVY;
+          FIVE : CONSTANT PRIVY;
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY;
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY;
+     PRIVATE
+          TYPE PRIVY IS RANGE 0..127;
+          ZERO : CONSTANT PRIVY := 0;
+          ONE : CONSTANT PRIVY := 1;
+          TWO : CONSTANT PRIVY := 2;
+          THREE : CONSTANT PRIVY := 3;
+          FOUR : CONSTANT PRIVY := 4;
+          FIVE : CONSTANT PRIVY := 5;
+     END PACK1;
+
+     TASK TYPE TASK1 IS
+          ENTRY ASSIGN (J : IN INTEGER);
+          ENTRY VALU (J : OUT INTEGER);
+          ENTRY NEXT;
+          ENTRY STOP;
+     END TASK1;
+
+     TYPE ARR_INT IS ARRAY(POSITIVE RANGE <>) OF INTEGER;
+     TYPE ARR_ARR IS ARRAY(POSITIVE RANGE <>) OF ARRAY1(1..3);
+     TYPE ARR_REC IS ARRAY(POSITIVE RANGE <>) OF RECORD1(1);
+     TYPE ARR_PTR IS ARRAY(POSITIVE RANGE <>) OF POINTER1;
+     TYPE ARR_PVT IS ARRAY(POSITIVE RANGE <>) OF PACK1.PRIVY;
+     TYPE ARR_TSK IS ARRAY(POSITIVE RANGE <>) OF TASK1;
+
+     TYPE REC_TYPE IS RECORD
+          RI1 : INTEGER := 0;
+          RA1 : ARRAY1(1..3) := (OTHERS => 0);
+          RR1 : RECORD1(1) := (D => 1, FIELD1 => 0);
+          RP1 : POINTER1 := NEW INTEGER'(0);
+          RV1 : PACK1.PRIVY := PACK1.ZERO;
+          RT1 : TASK1;
+     END RECORD;
+
+     GENERIC
+          GRI1 : IN OUT INTEGER;
+          GRA1 : IN OUT ARRAY1;
+          GRR1 : IN OUT RECORD1;
+          GRP1 : IN OUT POINTER1;
+          GRV1 : IN OUT PACK1.PRIVY;
+          GRT1 : IN OUT TASK1;
+          GAI1 : IN OUT ARR_INT;
+          GAA1 : IN OUT ARR_ARR;
+          GAR1 : IN OUT ARR_REC;
+          GAP1 : IN OUT ARR_PTR;
+          GAV1 : IN OUT ARR_PVT;
+          GAT1 : IN OUT ARR_TSK;
+     PACKAGE GENERIC1 IS
+     END GENERIC1;
+
+     FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS
+     BEGIN
+          IF EQUAL (3,3) THEN
+               RETURN P;
+          ELSE
+               RETURN NULL;
+          END IF;
+     END IDENT;
+
+     PACKAGE BODY PACK1 IS
+          FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN I;
+               ELSE
+                    RETURN PRIVY'(0);
+               END IF;
+          END IDENT;
+
+          FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS
+          BEGIN
+               RETURN I+1;
+          END NEXT;
+     END PACK1;
+
+     PACKAGE BODY GENERIC1 IS
+     BEGIN
+          GRI1 := GRI1 + 1;
+          GRA1 := (GRA1(1)+1, GRA1(2)+1, GRA1(3)+1);
+          GRR1 := (D => 1, FIELD1 => GRR1.FIELD1+1);
+          GRP1 := NEW INTEGER'(GRP1.ALL + 1);
+          GRV1 := PACK1.NEXT(GRV1);
+          GRT1.NEXT;
+          GAI1 := (OTHERS => GAI1(GAI1'FIRST) + 1);
+          GAA1 := (OTHERS => (OTHERS => GAA1(GAA1'FIRST)(1) + 1));
+          GAR1 := (OTHERS => (D => 1,
+                              FIELD1 => (GAR1(GAR1'FIRST).FIELD1 + 1)));
+          GAP1 := (OTHERS => NEW INTEGER'(GAP1(GAP1'FIRST).ALL + 1));
+          FOR J IN GAV1'RANGE LOOP
+               GAV1(J) := PACK1.NEXT(GAV1(J));
+          END LOOP;
+          FOR J IN GAT1'RANGE LOOP
+               GAT1(J).NEXT;
+          END LOOP;
+     END GENERIC1;
+
+     TASK BODY TASK1 IS
+          TASK_VALUE : INTEGER := 0;
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ASSIGN (J : IN INTEGER) DO
+                         TASK_VALUE := J;
+                    END ASSIGN;
+               OR
+                    ACCEPT VALU (J : OUT INTEGER) DO
+                         J := TASK_VALUE;
+                    END VALU;
+               OR
+                    ACCEPT NEXT DO
+                         TASK_VALUE := TASK_VALUE + 1;
+                    END NEXT;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END TASK1;
+
+BEGIN
+     TEST ("C85006E", "CHECK THAT A COMPONENT OR SLICE OF A VARIABLE " &
+                      "CREATED BY AN ALLOCATOR CAN BE " &
+                      "RENAMED AND HAS THE CORRECT VALUE, AND THAT " &
+                      "THE NEW NAME CAN BE USED IN AN ASSIGNMENT " &
+                      "STATEMENT AND PASSED ON AS AN ACTUAL " &
+                      "SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' " &
+                      "PARAMETER, AND AS AN ACTUAL GENERIC 'IN OUT' " &
+                      "PARAMETER, AND THAT WHEN THE VALUE OF THE " &
+                      "RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS " &
+                      "REFLECTED BY THE VALUE OF THE NEW NAME");
+
+     DECLARE
+          TYPE AREC_TYPE IS ACCESS REC_TYPE;
+          AREC : AREC_TYPE := NEW REC_TYPE;
+
+          TYPE ACC_INT IS ACCESS ARR_INT;
+          TYPE ACC_ARR IS ACCESS ARR_ARR;
+          TYPE ACC_REC IS ACCESS ARR_REC;
+          TYPE ACC_PTR IS ACCESS ARR_PTR;
+          TYPE ACC_PVT IS ACCESS ARR_PVT;
+          TYPE ACC_TSK IS ACCESS ARR_TSK;
+
+          AI1 : ACC_INT := NEW ARR_INT'(1..8 => 0);
+          AA1 : ACC_ARR := NEW ARR_ARR'(1..8 => (OTHERS => 0));
+          AR1 : ACC_REC := NEW ARR_REC'(1..8 => (D => 1, FIELD1 => 0));
+          AP1 : ACC_PTR := NEW ARR_PTR'(1..8 => NEW INTEGER'(0));
+          AV1 : ACC_PVT := NEW ARR_PVT'(1..8 => PACK1.ZERO);
+          AT1 : ACC_TSK := NEW ARR_TSK(1..8);
+
+          XRI1 : INTEGER RENAMES AREC.RI1;
+          XRA1 : ARRAY1 RENAMES AREC.RA1;
+          XRR1 : RECORD1 RENAMES AREC.RR1;
+          XRP1 : POINTER1 RENAMES AREC.RP1;
+          XRV1 : PACK1.PRIVY RENAMES AREC.RV1;
+          XRT1 : TASK1 RENAMES AREC.RT1;
+          XAI1 : ARR_INT RENAMES AI1(1..3);
+          XAA1 : ARR_ARR RENAMES AA1(2..4);
+          XAR1 : ARR_REC RENAMES AR1(3..5);
+          XAP1 : ARR_PTR RENAMES AP1(4..6);
+          XAV1 : ARR_PVT RENAMES AV1(5..7);
+          XAT1 : ARR_TSK RENAMES AT1(6..8);
+
+          TASK TYPE TASK2 IS
+               ENTRY ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                             TRR1 : OUT RECORD1; TRP1 : IN OUT POINTER1;
+                             TRV1 : IN OUT PACK1.PRIVY;
+                             TRT1 : IN OUT TASK1;
+                             TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                             TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                             TAV1 : IN OUT ARR_PVT;
+                             TAT1 : IN OUT ARR_TSK);
+          END TASK2;
+
+          I : INTEGER;
+          CHK_TASK : TASK2;
+
+          PROCEDURE PROC1 (PRI1 : IN OUT INTEGER; PRA1 : IN OUT ARRAY1;
+                           PRR1 : IN OUT RECORD1; PRP1 : OUT POINTER1;
+                           PRV1 : OUT PACK1.PRIVY; PRT1 : IN OUT TASK1;
+                           PAI1 : IN OUT ARR_INT; PAA1 : IN OUT ARR_ARR;
+                           PAR1 : IN OUT ARR_REC; PAP1 : OUT ARR_PTR;
+                           PAV1 : OUT ARR_PVT; PAT1 : IN OUT ARR_TSK) IS
+          BEGIN
+               PRI1 := PRI1 + 1;
+               PRA1 := (PRA1(1)+1, PRA1(2)+1, PRA1(3)+1);
+               PRR1 := (D => 1, FIELD1 => PRR1.FIELD1 + 1);
+               PRP1 := NEW INTEGER'(AREC.RP1.ALL + 1);
+               PRV1 := PACK1.NEXT(AREC.RV1);
+               PRT1.NEXT;
+               PAI1 := (OTHERS => PAI1(PAI1'FIRST) + 1);
+               PAA1 := (OTHERS => (OTHERS => PAA1(PAA1'FIRST)(1) + 1));
+               PAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                   (PAR1(PAR1'FIRST).FIELD1 + 1)));
+               PAP1 := (OTHERS =>
+                        NEW INTEGER'(AP1(PAP1'FIRST).ALL + 1));
+               FOR J IN PAV1'RANGE LOOP
+                    PAV1(J) := PACK1.NEXT(AV1(J));
+               END LOOP;
+               FOR J IN PAT1'RANGE LOOP
+                    PAT1(J).NEXT;
+               END LOOP;
+          END PROC1;
+
+          TASK BODY TASK2 IS
+          BEGIN
+               ACCEPT ENTRY1 (TRI1 : OUT INTEGER; TRA1 : OUT ARRAY1;
+                              TRR1 : OUT RECORD1;
+                              TRP1 : IN OUT POINTER1;
+                              TRV1 : IN OUT PACK1.PRIVY;
+                              TRT1: IN OUT TASK1;
+                              TAI1 : OUT ARR_INT; TAA1 : OUT ARR_ARR;
+                              TAR1 : OUT ARR_REC; TAP1 : IN OUT ARR_PTR;
+                              TAV1 : IN OUT ARR_PVT;
+                              TAT1 : IN OUT ARR_TSK)
+               DO
+                    TRI1 := AREC.RI1 + 1;
+                    TRA1 := (AREC.RA1(1)+1, AREC.RA1(2)+1,
+                             AREC.RA1(3)+1);
+                    TRR1 := (D => 1, FIELD1 => AREC.RR1.FIELD1 + 1);
+                    TRP1 := NEW INTEGER'(TRP1.ALL + 1);
+                    TRV1 := PACK1.NEXT(TRV1);
+                    TRT1.NEXT;
+                    TAI1 := (OTHERS => AI1(TAI1'FIRST) + 1);
+                    TAA1 := (OTHERS => (OTHERS =>
+                                        AA1(TAA1'FIRST)(1) + 1));
+                    TAR1 := (OTHERS => (D => 1, FIELD1 =>
+                                        (AR1(TAR1'FIRST).FIELD1 + 1)));
+                    TAP1 := (OTHERS =>
+                             NEW INTEGER'(TAP1(TAP1'FIRST).ALL+1));
+                    FOR J IN TAV1'RANGE LOOP
+                         TAV1(J) := PACK1.NEXT(TAV1(J));
+                    END LOOP;
+                    FOR J IN TAT1'RANGE LOOP
+                         TAT1(J).NEXT;
+                    END LOOP;
+               END ENTRY1;
+          END TASK2;
+
+          PACKAGE GENPACK2 IS NEW
+               GENERIC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                         XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+     BEGIN
+          IF XRI1 /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (1)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (1)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (1)");
+          END IF;
+
+          IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (1)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.ONE)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (1)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (1)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(1)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.ONE)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (1)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(1) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (1)");
+               END IF;
+          END LOOP;
+
+          PROC1 (XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                 XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+          IF XRI1 /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (2)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (2)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (2)");
+          END IF;
+
+          IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (2)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.TWO)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (2)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(2) THEN
+               FAILED ("INCORRECT RETURN VALUE FROM XRT1.VALU (2)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(2)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.TWO)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (2)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (2)");
+               END IF;
+          END LOOP;
+
+          CHK_TASK.ENTRY1(XRI1, XRA1, XRR1, XRP1, XRV1, XRT1,
+                          XAI1, XAA1, XAR1, XAP1, XAV1, XAT1);
+
+          IF XRI1 /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (3)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (3)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (3)");
+          END IF;
+
+          IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (3)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.THREE)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (3)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(3) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (3)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(3)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.THREE)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (3)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (3)");
+               END IF;
+          END LOOP;
+
+          XRI1 := XRI1 + 1;
+          XRA1 := (XRA1(1)+1, XRA1(2)+1, XRA1(3)+1);
+          XRR1 := (D => 1, FIELD1 => XRR1.FIELD1 + 1);
+          XRP1 := NEW INTEGER'(XRP1.ALL + 1);
+          XRV1 := PACK1.NEXT(XRV1);
+          XRT1.NEXT;
+          XAI1 := (OTHERS => XAI1(XAI1'FIRST) + 1);
+          XAA1 := (OTHERS => (OTHERS => XAA1(XAA1'FIRST)(1) + 1));
+          XAR1 := (OTHERS => (D => 1,
+                              FIELD1 => (XAR1(XAR1'FIRST).FIELD1 + 1)));
+          XAP1 := (OTHERS => NEW INTEGER'(XAP1(XAP1'FIRST).ALL + 1));
+          FOR J IN XAV1'RANGE LOOP
+               XAV1(J) := PACK1.NEXT(XAV1(J));
+          END LOOP;
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).NEXT;
+          END LOOP;
+
+          IF XRI1 /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (4)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (4)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (4)");
+          END IF;
+
+          IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (4)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FOUR)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (4)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(4) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (4)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(4)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FOUR)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (4)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (4)");
+               END IF;
+          END LOOP;
+
+          AREC.RI1 := AREC.RI1 + 1;
+          AREC.RA1 := (AREC.RA1(1)+1, AREC.RA1(2)+1, AREC.RA1(3)+1);
+          AREC.RR1 := (D => 1, FIELD1 => AREC.RR1.FIELD1 + 1);
+          AREC.RP1 := NEW INTEGER'(AREC.RP1.ALL + 1);
+          AREC.RV1 := PACK1.NEXT(AREC.RV1);
+          AREC.RT1.NEXT;
+          AI1(XAI1'RANGE) := (OTHERS => AI1(XAI1'FIRST) + 1);
+          AA1(XAA1'RANGE) := (OTHERS =>
+                        (OTHERS => AA1(XAA1'FIRST)(1) + 1));
+          AR1(XAR1'RANGE) := (OTHERS => (D => 1,
+                        FIELD1 => (AR1(XAR1'FIRST).FIELD1 + 1)));
+          AP1(XAP1'RANGE) := (OTHERS =>
+                             NEW INTEGER'(AP1(XAP1'FIRST).ALL + 1));
+          FOR J IN XAV1'RANGE LOOP
+               AV1(J) := PACK1.NEXT(AV1(J));
+          END LOOP;
+          FOR J IN XAT1'RANGE LOOP
+               AT1(J).NEXT;
+          END LOOP;
+
+          IF XRI1 /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XRI1 (5)");
+          END IF;
+
+          IF XRA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XRA1 (5)");
+          END IF;
+
+          IF XRR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+               FAILED ("INCORRECT VALUE OF XRR1 (5)");
+          END IF;
+
+          IF XRP1 /= IDENT(AREC.RP1) OR XRP1.ALL /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT VALUE OF XRP1 (5)");
+          END IF;
+
+          IF PACK1."/=" (XRV1, PACK1.IDENT(PACK1.FIVE)) THEN
+               FAILED ("INCORRECT VALUE OF XRV1 (5)");
+          END IF;
+
+          XRT1.VALU(I);
+          IF I /= IDENT_INT(5) THEN
+               FAILED ("INCORRECT RETURN VALUE OF XRT1.VALU (5)");
+          END IF;
+
+          FOR J IN XAI1'RANGE LOOP
+               IF XAI1(J) /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT VALUE OF XAI1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAA1'RANGE LOOP
+               IF XAA1(J) /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5))
+               THEN
+                    FAILED ("INCORRECT VALUE OF XAA1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAR1'RANGE LOOP
+               IF XAR1(J) /= (D => 1, FIELD1 => IDENT_INT(5)) THEN
+                    FAILED ("INCORRECT VALUE OF XAR1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAP1'RANGE LOOP
+               IF XAP1(J) /= IDENT(AP1(J)) OR
+                  XAP1(J).ALL /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT VALUE OF XAP1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAV1'RANGE LOOP
+               IF PACK1."/=" (XAV1(J), PACK1.IDENT(PACK1.FIVE)) THEN
+                    FAILED ("INCORRECT VALUE OF XAV1(" &
+                            INTEGER'IMAGE(J) & ") (5)");
+               END IF;
+          END LOOP;
+
+          FOR J IN XAT1'RANGE LOOP
+               XAT1(J).VALU(I);
+               IF I /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT RETURN VALUE FROM XAT1(" &
+                            INTEGER'IMAGE(J) & ").VALU (5)");
+               END IF;
+          END LOOP;
+
+          AREC.RT1.STOP;
+
+          FOR I IN AT1'RANGE LOOP
+               AT1(I).STOP;
+          END LOOP;
+     END;
+
+     RESULT;
+END C85006E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006f.ada
new file mode 100644
index 000000000..bbfe63e92
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006f.ada
@@ -0,0 +1,70 @@
+-- C85006F.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 RENAMED SLICE CAN BE SLICED AND INDEXED FOR PURPOSES
+--     OF ASSIGNMENT AND TO READ THE VALUE.
+
+-- HISTORY:
+--     JET 07/26/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85006F IS
+
+     S : STRING(1..30) := "IT WAS A DARK AND STORMY NIGHT";
+
+     ADJECTIVES : STRING RENAMES S(10..24);
+
+BEGIN
+     TEST ("C85006F", "CHECK THAT A RENAMED SLICE CAN BE SLICED AND " &
+                      "INDEXED FOR PURPOSES OF ASSIGNMENT AND TO " &
+                      "READ THE VALUE");
+
+     ADJECTIVES(19..24) := "STARRY";
+
+     IF ADJECTIVES /= IDENT_STR("DARK AND STARRY") THEN
+          FAILED ("INCORRECT VALUE OF SLICE AFTER ASSIGNMENT (1)");
+     END IF;
+
+     IF S /= IDENT_STR("IT WAS A DARK AND STARRY NIGHT") THEN
+          FAILED ("INCORRECT VALUE OF ORIGINAL STRING (1)");
+     END IF;
+
+     ADJECTIVES(17) := ''';
+
+     IF ADJECTIVES /= IDENT_STR("DARK AN' STARRY") THEN
+          FAILED ("INCORRECT VALUE OF SLICE AFTER ASSIGNMENT (2)");
+     END IF;
+
+     IF S /= IDENT_STR("IT WAS A DARK AN' STARRY NIGHT") THEN
+          FAILED ("INCORRECT VALUE OF ORIGINAL STRING (2)");
+     END IF;
+
+     IF ADJECTIVES(10..13) /= IDENT_STR("DARK") THEN
+          FAILED ("INCORRECT VALUE OF SLICE WHEN READING");
+     END IF;
+
+     RESULT;
+
+END C85006F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006g.ada
new file mode 100644
index 000000000..9d6d59f5e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85006g.ada
@@ -0,0 +1,136 @@
+-- C85006G.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 ANY SUBTYPE CONSTRAINT IMPOSED BY THE TYPE MARK USED
+--     IN THE SLICE RENAMING DECLARATION IS IGNORED, AND THAT THE
+--     SUBTYPE CONSTRAINT ASSOCIATED WITH THE RENAMED VARIABLE IS
+--     USED INSTEAD.
+
+-- HISTORY:
+--     JET 07/26/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85006G IS
+
+     SUBTYPE STR IS STRING(1..10);
+
+     S : STRING(1..30) := IDENT_STR("IT WAS A DARK AND STORMY NIGHT");
+     T : STR := IDENT_STR("0123456789");
+
+     DG1 : STRING(1..30) := IDENT_STR("IT WAS A DARK AND STORMY NIGHT");
+     DG2 : STR := IDENT_STR("0123456789");
+
+     XS : STR RENAMES S(10..24);
+     XT : STRING RENAMES T(1..5);
+
+     GENERIC
+          G1 : IN OUT STR;
+          G2 : IN OUT STRING;
+     PACKAGE GEN IS
+          XG1 : STR RENAMES G1(10..24);
+          XG2 : STRING RENAMES G2(1..5);
+     END GEN;
+
+     PACKAGE PACK IS NEW GEN(DG1, DG2);
+     USE PACK;
+
+BEGIN
+     TEST ("C85006G", "CHECK THAT ANY SUBTYPE CONSTRAINT IMPOSED BY " &
+                      "THE TYPE MARK USED IN THE SLICE RENAMING " &
+                      "DECLARATION IS IGNORED, AND THAT THE SUBTYPE " &
+                      "CONSTRAINT ASSOCIATED WITH THE RENAMED " &
+                      "VARIABLE IS USED INSTEAD");
+
+     IF XS'FIRST /= IDENT_INT(10) OR
+        XS'LAST /= IDENT_INT(24) OR
+        XS'LENGTH /= IDENT_INT(15) THEN
+          FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - 1");
+     END IF;
+
+     IF XS /= "DARK AND STORMY" THEN
+          FAILED("INCORRECT VALUE OF RENAMING SLICE - 1");
+     END IF;
+
+     XS := IDENT_STR("STORMY AND DARK");
+
+     IF S /= "IT WAS A STORMY AND DARK NIGHT" THEN
+          FAILED("INCORRECT VALUE OF ORIGINAL STRING - 1");
+     END IF;
+
+     IF XT'FIRST /= IDENT_INT(1) OR
+        XT'LAST /= IDENT_INT(5) OR
+        XT'LENGTH /= IDENT_INT(5) THEN
+          FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - 2");
+     END IF;
+
+     IF XT /= "01234" THEN
+          FAILED("INCORRECT VALUE OF RENAMING SLICE - 2");
+     END IF;
+
+     XT := IDENT_STR("43210");
+
+     IF T /= "4321056789" THEN
+          FAILED("INCORRECT VALUE OF ORIGINAL STRING - 2");
+     END IF;
+
+     IF XG1'FIRST /= IDENT_INT(10) OR
+        XG1'LAST /= IDENT_INT(24) OR
+        XG1'LENGTH /= IDENT_INT(15) THEN
+          FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - G1");
+     END IF;
+
+     IF XG1 /= "DARK AND STORMY" THEN
+          FAILED("INCORRECT VALUE OF RENAMING SLICE - G1");
+     END IF;
+
+     XG1 := IDENT_STR("STORMY AND DARK");
+
+     IF DG1 /= "IT WAS A STORMY AND DARK NIGHT" THEN
+          FAILED("INCORRECT VALUE OF ORIGINAL STRING - G1");
+     END IF;
+
+     IF XG2'FIRST /= IDENT_INT(1) OR
+        XG2'LAST /= IDENT_INT(5) OR
+        XG2'LENGTH /= IDENT_INT(5) THEN
+          FAILED("INCORRECT VALUE OF SLICE ATTRIBUTES - G2");
+     END IF;
+
+     IF XG2 /= "01234" THEN
+          FAILED("INCORRECT VALUE OF RENAMING SLICE - G2");
+     END IF;
+
+     XG2 := IDENT_STR("43210");
+
+     IF DG2 /= "4321056789" THEN
+          FAILED("INCORRECT VALUE OF ORIGINAL STRING - G2");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED("UNEXPECTED EXCEPTION RAISED");
+          RESULT;
+END C85006G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85007a.ada
new file mode 100644
index 000000000..87eda143f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85007a.ada
@@ -0,0 +1,115 @@
+-- C85007A.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 DISCRIMINANTS OF A RENAMED OUT FORMAL PARAMETER, AS
+-- WELL AS THE DISCRIMINANTS OF THE RENAMED SUBCOMPONENTS OF AN OUT
+-- FORMAL PARAMETER, MAY BE READ INSIDE THE PROCEDURE.
+
+-- SPS 02/17/84 (SEE C62006A-B.ADA)
+-- EG  02/21/84
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C85007A IS
+
+BEGIN
+
+     TEST ("C85007A", "CHECK THAT THE DISCRIMINANTS OF A RENAMED OUT " &
+           "FORMAL PARAMETER CAN BE READ INSIDE THE PROCEDURE");
+
+     DECLARE
+
+          TYPE R1 (D1 : INTEGER) IS RECORD
+               NULL;
+          END RECORD;
+
+          TYPE R2 (D2 : POSITIVE) IS RECORD
+               C : R1 (2);
+          END RECORD;
+
+          SUBTYPE R1_2 IS R1(2);
+
+          R : R2 (5);
+
+          PROCEDURE PROC (REC : OUT R2) IS
+
+               REC1 : R2   RENAMES REC;
+               REC2 : R1_2 RENAMES REC.C;
+               REC3 : R2   RENAMES REC1;
+               REC4 : R1_2 RENAMES REC1.C;
+               REC5 : R1_2 RENAMES REC4;
+
+          BEGIN
+
+               IF REC1.D2 /= 5 THEN
+                    FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT OF" &
+                            " A RENAMED OUT PARAMETER");
+               END IF;
+
+               IF REC1.C.D1 /= 2 THEN
+                    FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                            "OF THE SUBCOMPONENT OF A RENAMED OUT "  &
+                            "PARAMETER");
+               END IF;
+
+               IF REC2.D1 /= 2 THEN
+                    FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                            "OF A RENAMED SUBCOMPONENT OF AN OUT "   &
+                            "PARAMETER");
+               END IF;
+
+               IF REC3.D2 /= 5 THEN
+                    FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT OF" &
+                            " A RENAME OF A RENAMED OUT PARAMETER");
+               END IF;
+
+               IF REC3.C.D1 /= 2 THEN
+                    FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                            "OF THE SUBCOMPONENT OF A RENAME OF A "  &
+                            "RENAMED OUT PARAMETER");
+               END IF;
+
+               IF REC4.D1 /= 2 THEN
+                    FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                            "OF A RENAMED SUBCOMPONENT OF A RENAMED" &
+                            " OUT PARAMETER");
+               END IF;
+
+               IF REC5.D1 /= 2 THEN
+                    FAILED ("UNABLE TO CORRECTLY READ DISCRIMINANT " &
+                            "OF A RENAME OF RENAMED SUBCOMPONENT OF" &
+                            " A RENAMED OUT PARAMETER");
+               END IF;
+
+          END PROC;
+
+     BEGIN
+
+          PROC (R);
+
+     END;
+
+     RESULT;
+
+END C85007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85007e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85007e.ada
new file mode 100644
index 000000000..da1f9559c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85007e.ada
@@ -0,0 +1,102 @@
+-- C85007E.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 RENAMED OUT PARAMETER, OUT PARAMETER COMPONENT, OR
+-- OUT PARAMETER SLICE CAN BE ASSIGNED TO.
+
+-- EG  02/22/84
+
+WITH REPORT;
+
+PROCEDURE C85007E IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C85007E","CHECK THAT A RENAMED OUT PARAMETER, PARAMETER " &
+                    "COMPONENT, OR PARAMETER SLICE CAN BE ASSIGNED TO");
+
+     DECLARE
+
+          TYPE AT1 IS ARRAY(1 .. 3) OF INTEGER;
+          TYPE RT (A : INTEGER) IS
+               RECORD
+                    B : AT1;
+                    C : INTEGER;
+               END RECORD;
+
+          A1, B1 : INTEGER;
+          A2, B2 : AT1;
+          A3, B3 : RT(1);
+
+          PROCEDURE PROC1 (A : OUT INTEGER;
+                           B : OUT AT1;
+                           C : OUT RT) IS
+
+               AA : INTEGER RENAMES A;
+               BB : AT1     RENAMES B;
+               CC : RT      RENAMES C;
+
+          BEGIN
+
+               AA := -1;
+               BB := (1 .. 3 => -2);
+               CC := (1, (2, 3, 4), 5);
+
+          END PROC1;
+
+          PROCEDURE PROC2 (X : OUT AT1;
+                           Y : OUT INTEGER;
+                           Z : OUT RT) IS
+
+               XX : AT1     RENAMES X;
+               YY : INTEGER RENAMES Y;
+               ZZ : RT      RENAMES Z;
+
+          BEGIN
+
+               PROC1 (YY, XX, ZZ);
+
+          END PROC2;
+
+     BEGIN
+
+          PROC1 (A1, A2, A3);
+          IF A1 /= IDENT_INT(-1) OR A2 /= (1 .. 3 => IDENT_INT(-2)) OR
+             A3 /= (1, (2, 3, 4), IDENT_INT(5)) THEN
+               FAILED ("CASE 1 : ERROR IN ASSIGNMENT");
+          END IF;
+
+          PROC2 (B2, B1, B3);
+          IF B1 /= IDENT_INT(-1) OR B2 /= (1 .. 3 => IDENT_INT(-2)) OR
+             B3 /= (1, (2, 3, 4), IDENT_INT(5)) THEN
+               FAILED ("CASE 2 : ERROR IN ASSIGNMENT");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C85007E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85009a.ada
new file mode 100644
index 000000000..23d3c60d2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85009a.ada
@@ -0,0 +1,109 @@
+-- C85009A.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 PREDEFINED AND USER-DEFINED EXCEPTIONS CAN BE RENAMED
+--     AND THAT HANDLERS REFERRING TO EITHER NAME ARE INVOKED WHEN THE
+--     EXCEPTION IS RAISED, EVEN BY AN EXPLICIT 'RAISE' STATEMENT
+--     REFERRING TO THE OTHER NAME.
+
+-- HISTORY:
+--     JET 03/24/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85009A IS
+
+     MY_EXCEPTION : EXCEPTION;
+
+     MY_EXCEPTION2 : EXCEPTION RENAMES MY_EXCEPTION;
+
+     CONSTRAINT_ERROR2 : EXCEPTION RENAMES CONSTRAINT_ERROR;
+
+     I : INTEGER := 1;
+
+BEGIN
+     TEST ("C85009A", "CHECK THAT PREDEFINED AND USER-DEFINED " &
+                      "EXCEPTIONS CAN BE RENAMED AND THAT HANDLERS " &
+                      "REFERRING TO EITHER NAME ARE INVOKED WHEN " &
+                      "THE EXCEPTION IS RAISED, EVEN BY AN EXPLICIT " &
+                      "'RAISE' STATEMENT REFERRING TO THE OTHER NAME");
+
+     BEGIN
+          RAISE MY_EXCEPTION;
+          FAILED ("MY_EXCEPTION NOT RAISED");
+     EXCEPTION
+          WHEN MY_EXCEPTION2 =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY MY_EXCEPTION");
+     END;
+
+     BEGIN
+          RAISE MY_EXCEPTION2;
+          FAILED ("MY_EXCEPTION2 NOT RAISED");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY MY_EXCEPTION2");
+     END;
+
+     DECLARE
+          TYPE COLORS IS (RED, BLUE, YELLOW);
+          E : COLORS := RED;
+     BEGIN
+          E := COLORS'PRED(E);
+          IF NOT EQUAL(COLORS'POS(E),COLORS'POS(E)) THEN
+               COMMENT("DON'T OPTIMIZE E");
+          END IF;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED BY PRED(RED)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR2 =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY PRED(RED)");
+     END;
+
+     BEGIN
+          RAISE CONSTRAINT_ERROR;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR2 =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY CONSTRAINT_ERROR");
+     END;
+
+     BEGIN
+          RAISE CONSTRAINT_ERROR2;
+          FAILED ("CONSTRAINT_ERROR2 NOT RAISED");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY CONSTRAINT_ERROR2");
+     END;
+
+     RESULT;
+END C85009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85011a.ada
new file mode 100644
index 000000000..538f9c235
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85011a.ada
@@ -0,0 +1,145 @@
+-- C85011A.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 PACKAGE CAN BE RENAMED AND THE NEW NAME CAN APPEAR
+--     IN A RENAMING DECLARATION, AND THAT A 'USE' CLAUSE CAN REFER TO
+--     THE PACKAGE BY EITHER NAME, INCLUDING RENAMINGS OF GENERIC AND
+--     NONGENERIC PACKAGES INSIDE THEMSELVES.
+
+-- HISTORY:
+--     JET 04/28/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85011A IS
+
+     PACKAGE PACK1 IS
+          I : NATURAL := 0;
+          PACKAGE PACKA RENAMES PACK1;
+     END PACK1;
+
+     GENERIC
+          TYPE T IS RANGE <>;
+     PACKAGE GPACK IS
+          J : T := T'FIRST;
+          PACKAGE PACKB RENAMES GPACK;
+     END GPACK;
+
+     PACKAGE PACK2 IS NEW GPACK(NATURAL);
+
+     PACKAGE PACK3 RENAMES PACK1;
+     PACKAGE PACK4 RENAMES PACK2;
+     PACKAGE PACK5 RENAMES PACK3;
+     PACKAGE PACK6 RENAMES PACK4;
+
+BEGIN
+     TEST ("C85011A", "CHECK THAT A PACKAGE CAN BE RENAMED AND THE " &
+                      "NEW NAME CAN APPEAR IN A RENAMING " &
+                      "DECLARATION, AND THAT A 'USE' CLAUSE CAN " &
+                      "REFER TO THE PACKAGE BY EITHER NAME, " &
+                      "INCLUDING RENAMINGS OF GENERIC AND NONGENERIC " &
+                      "PACKAGES INSIDE THEMSELVES");
+
+     IF PACK1.I /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT VALUE OF PACK1.I");
+     END IF;
+
+     IF PACK2.J /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT VALUE OF PACK2.J");
+     END IF;
+
+     IF PACK3.I /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT VALUE OF PACK3.I");
+     END IF;
+
+     IF PACK4.J /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT VALUE OF PACK4.J");
+     END IF;
+
+     IF PACK5.I /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT VALUE OF PACK5.I");
+     END IF;
+
+     IF PACK6.J /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT VALUE OF PACK6.J");
+     END IF;
+
+     IF PACK1.PACKA.I /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT VALUE OF PACK1.PACKA.I");
+     END IF;
+
+     IF PACK2.PACKB.J /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT VALUE OF PACK2.PACKB.J");
+     END IF;
+
+     DECLARE
+          USE PACK1, PACK2;
+     BEGIN
+          IF I /= IDENT_INT(0) THEN
+               FAILED ("INCORRECT VALUE OF I (1)");
+          END IF;
+
+          IF J /= IDENT_INT(0) THEN
+               FAILED ("INCORRECT VALUE OF J (1)");
+          END IF;
+     END;
+
+     DECLARE
+          USE PACK3, PACK4;
+     BEGIN
+          IF I /= IDENT_INT(0) THEN
+               FAILED ("INCORRECT VALUE OF I (2)");
+          END IF;
+
+          IF J /= IDENT_INT(0) THEN
+               FAILED ("INCORRECT VALUE OF J (2)");
+          END IF;
+     END;
+
+     DECLARE
+          USE PACK5, PACK6;
+     BEGIN
+          IF I /= IDENT_INT(0) THEN
+               FAILED ("INCORRECT VALUE OF I (3)");
+          END IF;
+
+          IF J /= IDENT_INT(0) THEN
+               FAILED ("INCORRECT VALUE OF J (3)");
+          END IF;
+     END;
+
+     DECLARE
+          USE PACK1.PACKA, PACK2.PACKB;
+     BEGIN
+          IF I /= IDENT_INT(0) THEN
+               FAILED ("INCORRECT VALUE OF I (4)");
+          END IF;
+
+          IF J /= IDENT_INT(0) THEN
+               FAILED ("INCORRECT VALUE OF J (4)");
+          END IF;
+     END;
+
+     RESULT;
+END C85011A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85013a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85013a.ada
new file mode 100644
index 000000000..9877760e4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85013a.ada
@@ -0,0 +1,150 @@
+-- C85013A.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 WITH:
+--        A1) DIFFERENT PARAMETER NAMES;
+--        A2) DIFFERENT DEFAULT VALUES;
+--        A3) DIFFERENT PARAMETERS HAVING DEFAULT VALUES;
+--      AND THAT THE NEW NAMES/DEFAULTS ARE USED WHEN THE NEW NAME
+--      IS USED IN A CALL.
+
+--   B) FORMAL PARAMETER CONSTRAINTS FOR THE NEW NAME ARE IGNORED IN
+--      FAVOR OF THE CONSTRAINTS ASSOCIATED WITH THE RENAMED ENTITY.
+
+-- EG  02/22/84
+
+WITH REPORT;
+
+PROCEDURE C85013A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST("C85013A","CHECK THAT A SUBPROGRAM CAN BE RENAMED AND " &
+                    "THAT THE NEW NAMES/DEFAULTS ARE USED WITH "  &
+                    "THE CONSTRAINTS ASSOCIATED WITH THE RENAMED" &
+                    " ENTITY");
+
+     DECLARE
+
+          TYPE TA IS ARRAY(1 .. 5) OF INTEGER;
+
+          FUNCTION PROC1 (A : INTEGER := 1;
+                          B : TA := (1 .. 5 => 1)) RETURN INTEGER;
+          FUNCTION PROCA (C : INTEGER := 1;
+                          D : TA := (1 .. 5 => 1)) RETURN INTEGER
+                          RENAMES PROC1;
+          FUNCTION PROCB (B : INTEGER := 1;
+                          A : TA := (1 .. 5 => 1)) RETURN INTEGER
+                          RENAMES PROC1;
+          FUNCTION PROCC (A : INTEGER := 2;
+                          B : TA := (1, 2, 3, 4, 5)) RETURN INTEGER
+                          RENAMES PROC1;
+          FUNCTION PROCD (C : INTEGER := 2;
+                          D : TA := (1, 2, 3, 4, 5))RETURN INTEGER
+                          RENAMES PROC1;
+
+          FUNCTION PROC1 (A : INTEGER := 1;
+                          B : TA := (1 .. 5 => 1)) RETURN INTEGER IS
+          BEGIN
+               FOR I IN 1 .. 5 LOOP
+                    IF A = B(I) THEN
+                         RETURN I;
+                    END IF;
+               END LOOP;
+               RETURN 0;
+          END PROC1;
+
+     BEGIN
+
+          IF PROC1 /= 1 THEN
+               FAILED ("CASE A : PARAMETERS NOT PROPERLY INITIALIZED");
+          END IF;
+          IF PROC1(A => 2) /= 0 THEN
+               FAILED ("CASE A : INCORRECT RESULT");
+          END IF;
+          IF PROCA /= 1 THEN
+               FAILED ("CASE A1 : INCORRECT RESULT (DEFAULT)");
+          END IF;
+          IF PROCA(D => (5, 4, 3, 2, 1)) /= 5 THEN
+               FAILED ("CASE A1 : INCORRECT RESULT");
+          END IF;
+          IF PROCB /= 1 THEN
+               FAILED ("CASE A1 : INCORRECT RESULT (DEFAULT)");
+          END IF;
+          IF PROCB(A => (5, 4, 3, 2, 1), B => 2) /= 4 THEN
+               FAILED ("CASE A1 : INCORRECT RESULT ");
+          END IF;
+          IF PROCC /= 2 THEN
+               FAILED ("CASE A2 : INCORRECT RESULT (DEFAULT)");
+          END IF;
+          IF PROCC(3) /= 3 THEN
+               FAILED ("CASE A2 : INCORRECT RESULT ");
+          END IF;
+          IF PROCD /= 2 THEN
+               FAILED ("CASE A2 : INCORRECT RESULT (DEFAULT)");
+          END IF;
+          IF PROCD(4) /= 4 THEN
+               FAILED ("CASE A2 : INCORRECT RESULT ");
+          END IF;
+
+     END;
+
+     DECLARE
+
+          TYPE TA IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          SUBTYPE STA1 IS TA(1 .. 5);
+          SUBTYPE STA2 IS TA(11 .. 15);
+
+          PROCEDURE PROC1 (A : STA1;
+                           ID : STRING);
+          PROCEDURE PROC2 (A : STA2;
+                           ID : STRING) RENAMES PROC1;
+
+          PROCEDURE PROC1 (A : STA1;
+                           ID : STRING) IS
+          BEGIN
+               IF A'FIRST /= IDENT_INT(1) THEN
+                    FAILED ("CASE B : INCORRECT LOWER BOUND " &
+                            "GENERATED BY " & ID);
+               END IF;
+               IF A'LAST /= IDENT_INT(5) THEN
+                    FAILED ("CASE B : INCORRECT UPPER BOUND " &
+                            "GENERATED BY " & ID);
+               END IF;
+          END PROC1;
+
+     BEGIN
+
+          PROC1 ((1, 2, 3, 4, 5),"PROC1");
+          PROC2 ((6, 7, 8, 9, 10),"PROC2");
+
+     END;
+
+     RESULT;
+
+END C85013A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85014a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85014a.ada
new file mode 100644
index 000000000..cd924ac80
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85014a.ada
@@ -0,0 +1,142 @@
+-- C85014A.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 NUMBER OF FORMAL PARAMETERS IS USED TO DETERMINE
+--     WHICH SUBPROGRAM OR ENTRY IS BEING RENAMED.
+
+-- HISTORY:
+--     JET 03/24/88  CREATED ORIGINAL TEST.
+--     BCB 04/18/90  CORRECTED ERROR MESSAGE FOR ENTRY2.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85014A IS
+
+     TASK TYPE T1 IS
+          ENTRY ENTER (I1: IN OUT INTEGER);
+          ENTRY STOP;
+     END T1;
+
+     TASK TYPE T2 IS
+          ENTRY ENTER (I1, I2: IN OUT INTEGER);
+          ENTRY STOP;
+     END T2;
+
+     TASK1 : T1;
+     TASK2 : T2;
+
+     FUNCTION F RETURN T1 IS
+     BEGIN
+          RETURN TASK1;
+     END F;
+
+     FUNCTION F RETURN T2 IS
+     BEGIN
+          RETURN TASK2;
+     END F;
+
+     PROCEDURE PROC (I1: IN OUT INTEGER) IS
+     BEGIN
+          I1 := I1 + 1;
+     END PROC;
+
+     PROCEDURE PROC (I1, I2: IN OUT INTEGER) IS
+     BEGIN
+          I1 := I1 + 2;
+          I2 := I2 + 2;
+     END PROC;
+
+     TASK BODY T1 IS
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ENTER (I1 : IN OUT INTEGER) DO
+                         I1 := I1 + 1;
+                    END ENTER;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END T1;
+
+     TASK BODY T2 IS
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ENTER (I1, I2 : IN OUT INTEGER) DO
+                         I1 := I1 + 2;
+                         I2 := I2 + 2;
+                    END ENTER;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END T2;
+
+BEGIN
+     TEST ("C85014A", "CHECK THAT THE NUMBER OF FORMAL PARAMETERS IS " &
+                      "USED TO DETERMINE WHICH SUBPROGRAM OR ENTRY " &
+                      "IS BEING RENAMED");
+
+     DECLARE
+          PROCEDURE PROC1 (J1: IN OUT INTEGER) RENAMES PROC;
+          PROCEDURE PROC2 (J1, J2: IN OUT INTEGER) RENAMES PROC;
+
+          PROCEDURE ENTRY1 (J1: IN OUT INTEGER) RENAMES F.ENTER;
+          PROCEDURE ENTRY2 (J1, J2: IN OUT INTEGER) RENAMES F.ENTER;
+
+          K1, K2 : INTEGER := 0;
+     BEGIN
+          PROC1(K1);
+          IF K1 /= IDENT_INT(1) THEN
+               FAILED("INCORRECT RETURN VALUE FROM PROC1");
+          END IF;
+
+          ENTRY1(K2);
+          IF K2 /= IDENT_INT(1) THEN
+               FAILED("INCORRECT RETURN VALUE FROM ENTRY1");
+          END IF;
+
+          PROC2(K1, K2);
+          IF K1 /= IDENT_INT(3) OR K2 /= IDENT_INT(3) THEN
+               FAILED("INCORRECT RETURN VALUE FROM PROC2");
+          END IF;
+
+          ENTRY2(K1, K2);
+          IF K1 /= IDENT_INT(5) OR K2 /= IDENT_INT(5) THEN
+               FAILED("INCORRECT RETURN VALUE FROM ENTRY2");
+          END IF;
+     END;
+
+     TASK1.STOP;
+     TASK2.STOP;
+
+     RESULT;
+END C85014A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85014b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85014b.ada
new file mode 100644
index 000000000..ba195613e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85014b.ada
@@ -0,0 +1,192 @@
+-- C85014B.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 BASE TYPE OF THE FORMAL PARAMETER AND THE RESULT
+--     TYPE ARE USED TO DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING
+--     RENAMED.
+
+-- HISTORY:
+--     JET 03/24/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85014B IS
+
+     TYPE INT IS NEW INTEGER;
+     SUBTYPE SUBINT0 IS INT RANGE 0..INT'LAST;
+     SUBTYPE SUBINT1 IS INT RANGE 1..INT'LAST;
+
+     TASK TYPE T1 IS
+          ENTRY ENTER (I1: IN OUT INTEGER);
+          ENTRY STOP;
+     END T1;
+
+     TASK TYPE T2 IS
+          ENTRY ENTER (I1: IN OUT INT);
+          ENTRY STOP;
+     END T2;
+
+     TASK1 : T1;
+     TASK2 : T2;
+
+     FUNCTION F RETURN T1 IS
+     BEGIN
+          RETURN TASK1;
+     END F;
+
+     FUNCTION F RETURN T2 IS
+     BEGIN
+          RETURN TASK2;
+     END F;
+
+     PROCEDURE PROC (I1: IN OUT INTEGER) IS
+     BEGIN
+          I1 := I1 + 1;
+     END PROC;
+
+     PROCEDURE PROC (I1: IN OUT INT) IS
+     BEGIN
+          I1 := I1 + 2;
+     END PROC;
+
+     FUNCTION FUNK (I1: INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN I1 + 1;
+     END FUNK;
+
+     FUNCTION FUNK (I1: INTEGER) RETURN INT IS
+     BEGIN
+          RETURN INT(I1) + 2;
+     END FUNK;
+
+     FUNCTION FUNKX (N : NATURAL) RETURN POSITIVE IS
+     BEGIN
+          RETURN N + 1;
+     END FUNKX;
+
+     FUNCTION FUNKX (N : SUBINT0) RETURN SUBINT1 IS
+     BEGIN
+          RETURN N + 2;
+     END FUNKX;
+
+     TASK BODY T1 IS
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ENTER (I1 : IN OUT INTEGER) DO
+                         I1 := I1 + 1;
+                    END ENTER;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END T1;
+
+     TASK BODY T2 IS
+          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
+     BEGIN
+          WHILE ACCEPTING_ENTRIES LOOP
+               SELECT
+                    ACCEPT ENTER (I1 : IN OUT INT) DO
+                         I1 := I1 + 2;
+                    END ENTER;
+               OR
+                    ACCEPT STOP DO
+                         ACCEPTING_ENTRIES := FALSE;
+                    END STOP;
+               END SELECT;
+          END LOOP;
+     END T2;
+
+BEGIN
+     TEST ("C85014B", "CHECK THAT THE BASE TYPE OF THE FORMAL " &
+                      "PARAMETER AND THE RESULT TYPE ARE USED TO " &
+                      "DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING " &
+                      "RENAMED");
+
+     DECLARE
+          PROCEDURE PROC1 (J1: IN OUT INTEGER) RENAMES PROC;
+          PROCEDURE PROC2 (J1: IN OUT INT) RENAMES PROC;
+
+          FUNCTION FUNK1 (J1: INTEGER) RETURN INTEGER RENAMES FUNK;
+          FUNCTION FUNK2 (J1: INTEGER) RETURN INT RENAMES FUNK;
+
+          PROCEDURE ENTRY1 (J1: IN OUT INTEGER) RENAMES F.ENTER;
+          PROCEDURE ENTRY2 (J1: IN OUT INT) RENAMES F.ENTER;
+
+          FUNCTION FUNK3 (J1: POSITIVE) RETURN NATURAL RENAMES FUNKX;
+          FUNCTION FUNK4 (J1: SUBINT1) RETURN SUBINT0 RENAMES FUNKX;
+
+          K1 : INTEGER := 0;
+          K2 : INT := 0;
+     BEGIN
+          PROC1(K1);
+          IF K1 /= IDENT_INT(1) THEN
+               FAILED("INCORRECT RETURN VALUE FROM PROC1");
+          END IF;
+
+          K1 := FUNK1(K1);
+          IF K1 /= IDENT_INT(2) THEN
+               FAILED("INCORRECT RETURN VALUE FROM FUNK1");
+          END IF;
+
+          ENTRY1(K1);
+          IF K1 /= IDENT_INT(3) THEN
+               FAILED("INCORRECT RETURN VALUE FROM ENTRY1");
+          END IF;
+
+          K1 := FUNK3(K1);
+          IF K1 /= IDENT_INT(4) THEN
+               FAILED("INCORRECT RETURN VALUE FROM FUNK3");
+          END IF;
+
+          PROC2(K2);
+          IF INTEGER(K2) /= IDENT_INT(2) THEN
+               FAILED("INCORRECT RETURN VALUE FROM PROC2");
+          END IF;
+
+          K2 := FUNK2(INTEGER(K2));
+          IF INTEGER(K2) /= IDENT_INT(4) THEN
+               FAILED("INCORRECT RETURN VALUE FROM FUNK2");
+          END IF;
+
+          ENTRY2(K2);
+          IF INTEGER(K2) /= IDENT_INT(6) THEN
+               FAILED("INCORRECT RETURN VALUE FROM ENTRY2");
+          END IF;
+
+          K2 := FUNK4(K2);
+          IF INTEGER(K2) /= IDENT_INT(8) THEN
+               FAILED("INCORRECT RETURN VALUE FROM FUNK4");
+          END IF;
+     END;
+
+     TASK1.STOP;
+     TASK2.STOP;
+
+     RESULT;
+END C85014B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85014c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85014c.ada
new file mode 100644
index 000000000..6e91f8f63
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85014c.ada
@@ -0,0 +1,118 @@
+-- C85014C.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 PRESENCE OR ABSENCE OF A RESULT TYPE IS USED TO
+--     DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING RENAMED.
+
+-- HISTORY:
+--     JET 03/24/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85014C IS
+
+     I, J : INTEGER;
+
+     TASK TYPE T IS
+          ENTRY Q (I1 : INTEGER);
+     END T;
+
+     TASK0 : T;
+
+     PACKAGE FUNC IS
+          FUNCTION Q (I1 : INTEGER) RETURN INTEGER;
+          FUNCTION FUNC RETURN T;
+     END FUNC;
+     USE FUNC;
+
+     PROCEDURE PROC (I1: INTEGER) IS
+     BEGIN
+          I := I1;
+     END PROC;
+
+     FUNCTION PROC (I1: INTEGER) RETURN INTEGER IS
+     BEGIN
+          I := I1 + 1;
+          RETURN 0;
+     END PROC;
+
+     TASK BODY T IS
+     BEGIN
+          ACCEPT Q (I1 : INTEGER) DO
+               I := I1;
+          END Q;
+     END T;
+
+     PACKAGE BODY FUNC IS
+          FUNCTION Q (I1 : INTEGER) RETURN INTEGER IS
+          BEGIN
+               I := I1 + 1;
+               RETURN 0;
+          END Q;
+
+          FUNCTION FUNC RETURN T IS
+          BEGIN
+               RETURN TASK0;
+          END FUNC;
+     END FUNC;
+
+BEGIN
+     TEST ("C85014C", "CHECK THAT THE PRESENCE OR ABSENCE OF A " &
+                      "RESULT TYPE IS USED TO DETERMINE WHICH " &
+                      "SUBPROGRAM OR ENTRY IS BEING RENAMED");
+
+     DECLARE
+          PROCEDURE PROC1 (J1: INTEGER) RENAMES PROC;
+
+          FUNCTION PROC2 (J1: INTEGER) RETURN INTEGER RENAMES PROC;
+     BEGIN
+          PROC1(1);
+          IF I /= IDENT_INT(1) THEN
+               FAILED("INCORRECT VALUE OF I AFTER PROC1");
+          END IF;
+
+          J := PROC2(1);
+          IF I /= IDENT_INT(2) THEN
+               FAILED("INCORRECT VALUE OF I AFTER PROC2");
+          END IF;
+     END;
+
+     DECLARE
+          PROCEDURE FUNC1 (J1 : INTEGER) RENAMES FUNC.FUNC.Q;
+
+          FUNCTION FUNC2 (J1 : INTEGER) RETURN INTEGER RENAMES FUNC.Q;
+     BEGIN
+          FUNC1(1);
+          IF I /= IDENT_INT(1) THEN
+               FAILED("INCORRECT VALUE OF I AFTER FUNC1");
+          END IF;
+
+          J := FUNC2(1);
+          IF I /= IDENT_INT(2) THEN
+               FAILED("INCORRECT VALUE OF I AFTER FUNC2");
+          END IF;
+     END;
+
+     RESULT;
+END C85014C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85017a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85017a.ada
new file mode 100644
index 000000000..4424a6582
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85017a.ada
@@ -0,0 +1,61 @@
+-- C85017A.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 RENAMING A PREDEFINED OPERATION WITH AN IDENTIFIER
+--     AND THEN RENAMING THE IDENTIFIER AS AN OPERATOR SYMBOL ALLOWS THE
+--     NEW NAME TO BE USED IN A STATIC EXPRESSION.
+
+-- HISTORY:
+--     JET 03/24/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C85017A IS
+
+     FUNCTION PLUS (L,R : INTEGER) RETURN INTEGER RENAMES "+";
+     FUNCTION MINUS (L,R : INTEGER) RETURN INTEGER RENAMES "-";
+
+     FUNCTION "-" (L,R : INTEGER) RETURN INTEGER RENAMES PLUS;
+     FUNCTION "+" (L,R : INTEGER) RETURN INTEGER RENAMES MINUS;
+
+     I1 : CONSTANT INTEGER := 10 + 10;
+     I2 : CONSTANT INTEGER := 10 - 10;
+
+     TYPE INT IS RANGE I1 .. I2;
+BEGIN
+     TEST("C85017A","CHECK THAT RENAMING A PREDEFINED OPERATION WITH " &
+                    "AN IDENTIFIER AND THEN RENAMING THE IDENTIFIER " &
+                    "AS AN OPERATOR SYMBOL ALLOWS THE NEW NAME TO BE " &
+                    "USED IN A STATIC EXPRESSION");
+
+     IF I1 /= IDENT_INT(0) THEN
+          FAILED ("INCORRECT VALUE OF I1: " & INTEGER'IMAGE(I1));
+     END IF;
+
+     IF I2 /= IDENT_INT(20) THEN
+          FAILED ("INCORRECT VALUE OF I2: " & INTEGER'IMAGE(I2));
+     END IF;
+
+     RESULT;
+END C85017A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85018a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85018a.ada
new file mode 100644
index 000000000..e82680818
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85018a.ada
@@ -0,0 +1,140 @@
+-- C85018A.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 ENTRY FAMILY MEMBER CAN BE RENAMED WITH:
+--           1) DIFFERENT PARAMETER NAMES;
+--           2) DIFFERENT DEFAULT VALUES;
+--      AND THAT THE NEW NAMES/DEFAULTS ARE USED WHEN THE NEW NAME
+--      IS USED IN A CALL.
+
+-- RJW 6/3/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C85018A IS
+
+BEGIN
+
+     TEST( "C85018A", "CHECK THAT AN ENTRY FAMILY MEMBER CAN BE " &
+                      "RENAMED AND THAT THE NEW NAMES/DEFAULTS ARE "  &
+                      "THOSE ASSOCIATED WITH THE RENAMED ENTITY" );
+
+     DECLARE
+
+          RESULTS : INTEGER;
+
+          TYPE TA IS ARRAY(1 .. 5) OF INTEGER;
+
+          TASK T IS 
+               ENTRY ENT1 (BOOLEAN)
+                    (A : INTEGER := 1; B : TA := (1 .. 5 => 1));
+          END T;
+
+          PROCEDURE ENTA (C : INTEGER := 1; D : TA := (1 .. 5 => 1))
+                          RENAMES T.ENT1 (TRUE);
+
+          PROCEDURE ENTB (B : INTEGER := 1; A : TA := (1 .. 5 => 1))
+                          RENAMES T.ENT1 (TRUE);
+
+          PROCEDURE ENTC (A : INTEGER := 2; B : TA := (1, 2, 3, 4, 5))
+                          RENAMES T.ENT1 (TRUE);
+
+          PROCEDURE ENTD (C : INTEGER := 2; D : TA := (1, 2, 3, 4, 5))
+                          RENAMES T.ENT1 (TRUE);
+
+          TASK BODY T IS 
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT ENT1 (IDENT_BOOL (TRUE)) 
+                                     (A : INTEGER := 1; 
+                                      B : TA := (1 .. 5 => 1)) DO
+                              IF A IN 1 .. 5 THEN
+                                   RESULTS := B(A);
+                              ELSE
+                                   RESULTS := 0;
+                              END IF;
+                         END;
+                    OR 
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T;
+
+     BEGIN
+
+          T.ENT1 (TRUE);
+          IF RESULTS /= 1 THEN
+               FAILED ( "PARAMETERS NOT PROPERLY INITIALIZED" );
+          END IF;
+
+          T.ENT1 (TRUE) (A => 6);
+          IF RESULTS /= 0 THEN
+               FAILED ( "INCORRECT RESULTS" );
+          END IF;
+
+          ENTA;
+          IF RESULTS /= 1 THEN
+               FAILED ( "CASE 1 : INCORRECT RESULTS (DEFAULT)" );
+          END IF;
+
+          ENTA(D => (5, 4, 3, 2, 1));
+          IF RESULTS /= 5 THEN
+               FAILED ( "CASE 1 : INCORRECT RESULTS" );
+          END IF;
+
+          ENTB;
+          IF RESULTS /= 1 THEN
+               FAILED ( "CASE 1 : INCORRECT RESULTS (DEFAULT)" );
+          END IF;
+
+          ENTB(A => (5, 4, 3, 2, 1), B => 2);
+          IF RESULTS /= 4 THEN
+               FAILED ( "CASE 1 : INCORRECT RESULTS " );
+          END IF;
+
+          ENTC;
+          IF RESULTS /= 2 THEN
+               FAILED ( "CASE 2 : INCORRECT RESULTS (DEFAULT)" );
+          END IF;
+
+          ENTC(3);
+          IF RESULTS /= 3 THEN
+               FAILED ( "CASE 2 : INCORRECT RESULTS " );
+          END IF;
+
+          ENTD;
+          IF RESULTS /= 2 THEN
+               FAILED ( "CASE 2 : INCORRECT RESULTS (DEFAULT)" );
+          END IF;
+
+          ENTD(4);
+          IF RESULTS /= 4 THEN
+               FAILED ( "CASE 2 : INCORRECT RESULTS " );
+          END IF;
+
+     END;
+     RESULT;
+
+END C85018A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85018b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85018b.ada
new file mode 100644
index 000000000..44fbb5668
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85018b.ada
@@ -0,0 +1,288 @@
+-- C85018B.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 AN ENTRY FAMILY MEMBER IS RENAMED THE FORMAL
+--     PARAMETER CONSTRAINTS FOR THE NEW NAME ARE IGNORED IN
+--     FAVOR OF THE CONSTRAINTS ASSOCIATED WITH THE RENAMED ENTITY.
+
+-- HISTORY:
+--     RJW 06/03/86 CREATED ORIGINAL TEST.
+--     DHH 10/15/87 CORRECTED RANGE ERRORS.
+--     GJD 11/15/95 REMOVED ADA 95 INCOMPATIBILITY (INDEX CONSTRAINT).
+--     PWN 10/24/96 RESTORED CHECKS WITH ADA 95 RESULTS NOW EXPECTED.
+--     PWN 12/11/96 ADJUSTED VALUES FOR ADA 95 COMPATIBILITY.
+--     PWB.CTA 2/17/97 CHANGED CALL TO ENT2 TO NOT EXPECT EXCEPTION
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C85018B IS
+
+BEGIN
+
+     TEST( "C85018B", "CHECK THAT WHEN AN ENTRY FAMILY MEMBER IS " &
+                      "RENAMED THE FORMAL PARAMETER CONSTRAINTS "  &
+                      "FOR THE NEW NAME ARE IGNORED IN FAVOR OF " &
+                      "THE CONSTRAINTS ASSOCIATED WITH THE RENAMED " &
+                      "ENTITY" );
+
+     DECLARE
+          TYPE INT IS RANGE 1 .. 10;
+          SUBTYPE INT1 IS INT RANGE 1 .. 5;
+          SUBTYPE INT2 IS INT RANGE 6 .. 10;
+
+          OBJ1 : INT1 := 5;
+          OBJ2 : INT2 := 6;
+
+          SUBTYPE SHORTCHAR IS CHARACTER RANGE 'A' .. 'C';
+
+          TASK T IS
+               ENTRY ENT1 (SHORTCHAR)
+                    (A : INT1; OK : BOOLEAN);
+          END T;
+
+          PROCEDURE ENT2 (A : INT2; OK : BOOLEAN)
+               RENAMES T.ENT1 ('C');
+
+          TASK BODY T IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT ENT1 ('C')
+                                     (A : INT1; OK : BOOLEAN) DO
+                              IF NOT OK THEN
+                                   FAILED ( "WRONG CALL EXECUTED " &
+                                            "WITH INTEGER TYPE" );
+                              END IF;
+                         END;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T;
+     BEGIN
+          BEGIN
+               ENT2 (OBJ1, TRUE);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR  =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                             "INTEGER TYPE" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                             "INTEGER TYPE - 1" );
+          END;
+
+          BEGIN
+               ENT2 (OBJ2, TRUE);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                             "INTEGER TYPE - 2" );
+          END;
+     END;
+
+     DECLARE
+          TYPE REAL IS DIGITS 3;
+          SUBTYPE REAL1 IS REAL RANGE -2.0 .. 0.0;
+          SUBTYPE REAL2 IS REAL RANGE  0.0 .. 2.0;
+
+          OBJ1 : REAL1 := -0.25;
+          OBJ2 : REAL2 :=  0.25;
+
+          SUBTYPE SHORTINT IS INTEGER RANGE 9 .. 11;
+
+          TASK T IS
+               ENTRY ENT1 (SHORTINT)
+                    (A : REAL1; OK : BOOLEAN);
+          END T;
+
+          PROCEDURE ENT2 (A : REAL2; OK : BOOLEAN)
+               RENAMES T.ENT1 (10);
+
+          TASK BODY T IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT ENT1 (10)
+                                     (A : REAL1; OK : BOOLEAN) DO
+                              IF NOT OK THEN
+                                   FAILED ( "WRONG CALL EXECUTED " &
+                                            "WITH FLOATING POINT " &
+                                            "TYPE" );
+                              END IF;
+                         END;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T;
+     BEGIN
+          BEGIN
+               ENT2 (OBJ1, TRUE);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR  =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                             "FLOATING POINT " &
+                             "TYPE" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                             "FLOATING POINT " &
+                             "TYPE - 1" );
+          END;
+
+          BEGIN
+               ENT2 (OBJ2, FALSE);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                             "FLOATING POINT " &
+                             "TYPE - 2" );
+          END;
+     END;
+
+     DECLARE
+          TYPE COLOR IS (RED, YELLOW, BLUE, GREEN);
+
+          TYPE FIXED IS DELTA  0.125 RANGE -1.0 .. 1.0;
+          SUBTYPE FIXED1 IS FIXED RANGE  0.0 .. 0.5;
+          SUBTYPE FIXED2 IS FIXED RANGE -0.5 .. 0.0;
+
+          OBJ1 : FIXED1 :=  0.125;
+          OBJ2 : FIXED2 := -0.125;
+
+          TASK T IS
+               ENTRY ENT1 (COLOR)
+                    (A : FIXED1; OK : BOOLEAN);
+          END T;
+
+          PROCEDURE ENT2 (A : FIXED2; OK : BOOLEAN)
+               RENAMES T.ENT1 (BLUE);
+
+          TASK BODY T IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT ENT1 (BLUE)
+                                     (A : FIXED1; OK : BOOLEAN) DO
+                              IF NOT OK THEN
+                                   FAILED ( "WRONG CALL EXECUTED " &
+                                            "WITH FIXED POINT " &
+                                            "TYPE" );
+                              END IF;
+                         END;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T;
+     BEGIN
+          BEGIN
+               ENT2 (OBJ1, TRUE);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR  =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                             "FIXED POINT " &
+                             "TYPE" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                             "FIXED POINT " &
+                             "TYPE - 1" );
+          END;
+
+          BEGIN
+               ENT2 (OBJ2, FALSE);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                             "FIXED POINT " &
+                             "TYPE - 2" );
+          END;
+     END;
+
+     DECLARE
+          TYPE TA IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+          SUBTYPE STA1 IS TA(1 .. 5);
+          SUBTYPE STA2 IS TA(6 .. 10);
+
+          OBJ1 : STA1 := (1, 2, 3, 4, 5);
+          OBJ2 : STA2 := (6, 7, 8, 9, 10);
+
+          TASK T IS
+               ENTRY ENT1 (BOOLEAN)
+                    (A : STA1; OK : BOOLEAN);
+          END T;
+
+          PROCEDURE ENT2 (A : STA2; OK : BOOLEAN)
+               RENAMES T.ENT1 (FALSE);
+
+          TASK BODY T IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT ENT1 (FALSE)
+                                     (A : STA1; OK : BOOLEAN) DO
+                              IF NOT OK THEN
+                                   FAILED ( "WRONG CALL EXECUTED " &
+                                            "WITH CONSTRAINED " &
+                                            "ARRAY" );
+                              END IF;
+                         END;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T;
+     BEGIN
+          BEGIN
+               ENT2 (OBJ1, TRUE);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR  =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                             "CONSTRAINED ARRAY" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                             "CONSTRAINED ARRAY - 1" );
+          END;
+
+          BEGIN
+               ENT2 (OBJ2, TRUE);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                             "CONSTRAINED ARRAY" );
+               WHEN OTHERS =>
+                    FAILED ( "OTHER EXCEPTION RAISED WITH " &
+                             "CONSTRAINED ARRAY - 2" );
+          END;
+     END;
+
+     RESULT;
+
+END C85018B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85019a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85019a.ada
new file mode 100644
index 000000000..6aec3ae67
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c85019a.ada
@@ -0,0 +1,59 @@
+-- C85019A.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 CHARACTER OR OTHER ENUMERATION LITERAL MAY BE RENAMED 
+-- AS A FUNCTION.
+
+-- RJW 6/4/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C85019A IS
+
+BEGIN
+
+     TEST( "C85019A", "CHECK THAT A CHARACTER OR OTHER ENUMERATION " &
+                      "LITERAL MAY BE RENAMED AS A FUNCTION" );
+
+     DECLARE
+          FUNCTION SEA RETURN CHARACTER RENAMES 'C';
+
+          TYPE COLOR IS (RED, YELLOW, BLUE, GREEN);
+          
+          FUNCTION TEAL RETURN COLOR RENAMES BLUE;
+
+     BEGIN
+          IF SEA /= 'C' THEN
+               FAILED ( "SEA IS NOT EQUAL TO 'C'" );
+          END IF;
+
+          IF TEAL /= BLUE THEN
+               FAILED ( "TEAL IS NOT EQUAL TO BLUE" );
+          END IF;
+
+     END;
+
+     RESULT;
+
+END C85019A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c854001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c854001.a
new file mode 100644
index 000000000..5a128ba69
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c854001.a
@@ -0,0 +1,277 @@
+-- C854001.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 subprogram declaration can be completed by a
+--      subprogram renaming declaration. In particular, check that such a
+--      renaming-as-body can be given in a package body to complete a
+--      subprogram declared in the package specification. Check that calls
+--      to the subprogram invoke the body of the renamed subprogram.  Check
+--      that a renaming allows a copy of an inherited or predefined subprogram
+--      before overriding it later.  Check that renaming a dispatching 
+--      operation calls the correct body in case of overriding.
+--
+-- TEST DESCRIPTION:
+--      This test declares a record type, an integer type, and a tagged type
+--      with a set of operations in a package. A renaming of a predefined 
+--      equality operation of a tagged type is also defined in this package.
+--      The predefined operation is overridden in the private part. In a 
+--      separate package, a subtype of the record type and integer type 
+--      are declared.  Subset of the full set of operations for the record 
+--      and types is reexported using renamings-as-bodies. Other operations 
+--      are given explicit bodies.  The test verifies that the appropriate 
+--      body is executed for each operation on the subtype.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      07 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+--
+--!
+
+package C854001_0 is
+
+   type Component is (Op_Of_Type, Op_Of_Subtype, Initial_Value);
+
+   type Root is record
+      Called : Component := Op_Of_Subtype;
+   end record;
+
+   procedure Root_Proc (P: in out Root);
+   procedure Over_Proc (P: in out Root);
+
+   function Root_Func return Root;
+   function Over_Func return Root;
+
+   type Short_Int is range 1 .. 98;
+
+   function "+" (P1, P2 : Short_Int) return Short_Int;
+   function Name (P1, P2 : Short_Int) return Short_Int;
+
+   type Tag_Type is tagged record
+      C : Component := Initial_Value;
+   end record;
+   -- Inherits predefined operator "=" and others.
+
+   function Predefined_Equal (P1, P2 : Tag_Type) return Boolean
+     renames "=";             
+   -- Renames predefined operator "=" before overriding.
+
+private
+   function "=" (P1, P2 : Tag_Type) 
+     return Boolean;                   -- Overrides predefined operator "=".
+
+
+end C854001_0;
+
+
+     --==================================================================--
+
+
+package body C854001_0 is
+
+   procedure Root_Proc (P: in out Root) is
+   begin
+      P.Called := Initial_Value;
+   end Root_Proc;
+
+   ---------------------------------------
+   procedure Over_Proc (P: in out Root) is
+   begin
+      P.Called := Op_Of_Type;
+   end Over_Proc;
+
+   ---------------------------------------
+   function Root_Func return Root is
+   begin
+      return (Called => Op_Of_Type);
+   end Root_Func;
+ 
+   ---------------------------------------
+   function Over_Func return Root is
+   begin
+      return (Called => Initial_Value);
+   end Over_Func;
+
+   ---------------------------------------
+   function "+" (P1, P2 : Short_Int) return Short_Int is
+   begin
+      return 15;
+   end "+";
+
+   ---------------------------------------
+   function Name (P1, P2 : Short_Int) return Short_Int is
+   begin
+      return 47;
+   end Name;
+
+   ---------------------------------------
+   function "=" (P1, P2 : Tag_Type) return Boolean is
+   begin
+      return False;
+   end "=";
+
+end C854001_0;
+
+     --==================================================================--
+
+
+with C854001_0;
+package C854001_1 is
+
+   subtype Root_Subtype is C854001_0.Root;
+   subtype Short_Int_Subtype is C854001_0.Short_Int;
+   
+   procedure Ren_Proc  (P: in out Root_Subtype);       
+   procedure Same_Proc (P: in out Root_Subtype);       
+
+   function Ren_Func  return Root_Subtype;             
+   function Same_Func return Root_Subtype;             
+
+   function Other_Name (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype;
+   function "-" (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype;
+
+   function User_Defined_Equal (P1, P2 : C854001_0.Tag_Type) return Boolean 
+     renames C854001_0."=";                       -- Executes body of the
+                                                  -- overriding declaration in
+                                                  -- the private part.
+end C854001_1;
+
+
+     --==================================================================--
+
+
+with C854001_0;
+package body C854001_1 is
+
+   --
+   -- Renaming-as-body for procedure:
+   --
+
+   procedure Ren_Proc  (P: in out Root_Subtype)  
+     renames C854001_0.Root_Proc;
+   procedure Same_Proc (P: in out Root_Subtype) 
+     renames C854001_0.Over_Proc;
+
+   --
+   -- Renaming-as-body for function:
+   --
+
+   function Ren_Func  return Root_Subtype renames C854001_0.Root_Func;
+   function Same_Func return Root_Subtype renames C854001_0.Over_Func;
+ 
+   function Other_Name (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype
+     renames C854001_0."+";
+   function "-" (P1, P2 : Short_Int_Subtype) return Short_Int_Subtype 
+     renames C854001_0.Name;
+
+end C854001_1;
+
+
+     --==================================================================--
+
+with C854001_0;
+with C854001_1;  -- Subtype and associated operations.
+use  C854001_1;
+
+with Report;
+
+procedure C854001 is
+   Operand1  : Root_Subtype;
+   Operand2  : Root_Subtype;
+   Operand3  : Root_Subtype;
+   Operand4  : Root_Subtype;
+   Operand5  : Short_Int_Subtype := 55;
+   Operand6  : Short_Int_Subtype := 46;
+   Operand7  : Short_Int_Subtype;
+   Operand8  : C854001_0.Tag_Type;         -- Both Operand8 & Operand9 have
+   Operand9  : C854001_0.Tag_Type;         -- the same default values.
+
+   -- Direct visibility to operator symbols
+   use type C854001_0.Component;
+   use type C854001_0.Short_Int;
+
+begin
+   Report.Test ("C854001", "Check that a renaming-as-body can be given " &
+                           "in a package body to complete a subprogram " &
+                           "declared in the package specification. "     &
+                           "Check that calls to the subprogram invoke "  &
+                           "the body of the renamed subprogram");
+
+   --
+   -- Only operations of the subtype are available.
+   --
+
+   Ren_Proc  (Operand1);
+   if Operand1.Called /= C854001_0.Initial_Value then
+      Report.Failed ("Error calling procedure Ren_Proc");
+   end if;
+
+   ---------------------------------------
+   Same_Proc (Operand2);
+   if Operand2.Called /= C854001_0.Op_Of_Type then
+      Report.Failed ("Error calling procedure Same_Proc");
+   end if;
+
+   ---------------------------------------
+   Operand3 := Ren_Func;
+   if Operand3.Called /= C854001_0.Op_Of_Type then
+      Report.Failed ("Error calling function Ren_Func");
+   end if;
+
+   ---------------------------------------
+   Operand4 := Same_Func;
+   if Operand4.Called /= C854001_0.Initial_Value then
+      Report.Failed ("Error calling function Same_Func");
+   end if;
+   
+   ---------------------------------------
+   Operand7 := C854001_1."-" (Operand5, Operand6);
+   if Operand7 /= 47 then
+      Report.Failed ("Error calling function & ""-""");
+   end if;
+
+   ---------------------------------------
+   Operand7 := Other_Name (Operand5, Operand6);
+   if Operand7 /= 15 then
+      Report.Failed ("Error calling function Other_Name");
+   end if;
+
+   ---------------------------------------
+   -- Executes body of the overriding declaration in the private part
+   -- of C854001_0.
+   if User_Defined_Equal (Operand8, Operand9) then
+      Report.Failed ("Error calling function User_Defined_Equal");
+   end if;
+
+   ---------------------------------------
+   -- Executes predefined operation.
+   if not C854001_0.Predefined_Equal (Operand8, Operand9) then
+      Report.Failed ("Error calling function Predefined_Equal");
+   end if;
+
+   Report.Result;
+
+end C854001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c854002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c854002.a
new file mode 100644
index 000000000..19bca3598
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c854002.a
@@ -0,0 +1,185 @@
+-- C854002.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE
+--     Check the requirements of the new 8.5.4(8.A) from Technical
+--     Corrigendum 1 (originally discussed as AI95-00064).
+--     This paragraph requires an elaboration check on renamings-as-body:
+--     even if the body of the ultimately-called subprogram has been
+--     elaborated, the check should fail if the renaming-as-body
+--     itself has not yet been elaborated.
+--
+-- TEST DESCRIPTION
+--     We declare two functions F and G, and ensure that they are
+--     elaborated before anything else, by using pragma Pure.  Then we
+--     declare two renamings-as-body: the renaming of F is direct, and
+--     the renaming of G is via an access-to-function object.  We call
+--     the renamings during elaboration, and check that they raise
+--     Program_Error.  We then call them again after elaboration; this
+--     time, they should work.
+--
+-- CHANGE HISTORY:
+--      29 JUN 1999   RAD   Initial Version
+--      23 SEP 1999   RLB   Improved comments, renamed, issued.
+--      28 JUN 2002   RLB   Added pragma Elaborate_All for Report.
+--!
+
+package C854002_1 is
+    pragma Pure;
+    -- Empty.
+end C854002_1;
+
+package C854002_1.Pure is
+    pragma Pure;
+    function F return String;
+    function G return String;
+end C854002_1.Pure;
+
+with C854002_1.Pure;
+package C854002_1.Renamings is
+
+    F_Result: constant String := C854002_1.Pure.F; -- Make sure we can call F.
+    function Renamed_F return String;
+
+    G_Result: constant String := C854002_1.Pure.G;
+    type String_Function is access function return String;
+    G_Pointer: String_Function := null;
+        -- Will be set to C854002_1.Pure.G'Access in the body.
+    function Renamed_G return String;
+
+end C854002_1.Renamings;
+
+package C854002_1.Caller is
+
+    -- These procedures call the renamings; when called during elaboration,
+    -- we pass Should_Fail => True, which checks that Program_Error is
+    -- raised.  Later, we use Should_Fail => False.
+
+    procedure Call_Renamed_F(Should_Fail: Boolean);
+    procedure Call_Renamed_G(Should_Fail: Boolean);
+
+end C854002_1.Caller;
+
+with Report; use Report; pragma Elaborate_All (Report);
+with C854002_1.Renamings;
+package body C854002_1.Caller is
+
+    Some_Error: exception;
+
+    procedure Call_Renamed_F(Should_Fail: Boolean) is
+    begin
+        if Should_Fail then
+            begin
+                Failed(C854002_1.Renamings.Renamed_F);
+                raise Some_Error;
+                    -- This raise statement is necessary, because the
+                    -- Report package has a bug -- if Failed is called
+                    -- before Test, then the failure is ignored, and the
+                    -- test prints "PASSED".
+                    -- Presumably, this raise statement will cause the
+                    -- program to crash, thus avoiding the PASSED message.
+            exception
+                when Program_Error =>
+                    Comment("Program_Error -- OK");
+            end;
+        else
+            if C854002_1.Renamings.F_Result /= C854002_1.Renamings.Renamed_F then
+                Failed("Bad result from renamed F");
+            end if;
+        end if;
+    end Call_Renamed_F;
+
+    procedure Call_Renamed_G(Should_Fail: Boolean) is
+    begin
+        if Should_Fail then
+            begin
+                Failed(C854002_1.Renamings.Renamed_G);
+                raise Some_Error;
+            exception
+                when Program_Error =>
+                    Comment("Program_Error -- OK");
+            end;
+        else
+            if C854002_1.Renamings.G_Result /= C854002_1.Renamings.Renamed_G then
+                Failed("Bad result from renamed G");
+            end if;
+        end if;
+    end Call_Renamed_G;
+
+begin
+    -- At this point, the bodies of Renamed_F and Renamed_G have not yet
+    -- been elaborated, so calling them should raise Program_Error:
+    Call_Renamed_F(Should_Fail => True);
+    Call_Renamed_G(Should_Fail => True);
+end C854002_1.Caller;
+
+package body C854002_1.Pure is
+
+    function F return String is
+    begin
+        return "This is function F";
+    end F;
+
+    function G return String is
+    begin
+        return "This is function G";
+    end G;
+
+end C854002_1.Pure;
+
+with C854002_1.Pure;
+with C854002_1.Caller; pragma Elaborate(C854002_1.Caller);
+    -- This pragma ensures that this package body (Renamings)
+    -- will be elaborated after Caller, so that when Caller calls
+    -- the renamings during its elaboration, the renamings will
+    -- not have been elaborated (although what the rename have been).
+package body C854002_1.Renamings is
+
+    function Renamed_F return String renames C854002_1.Pure.F;
+
+    package Dummy is end; -- So we can insert statements here.
+    package body Dummy is
+    begin
+        G_Pointer := C854002_1.Pure.G'Access;
+    end Dummy;
+
+    function Renamed_G return String renames G_Pointer.all;
+
+end C854002_1.Renamings;
+
+with Report; use Report;
+with C854002_1.Caller;
+procedure C854002 is
+begin
+    Test("C854002",
+         "An elaboration check is performed for a call to a subprogram"
+         & " whose body is given as a renaming-as-body");
+
+    -- By the time we get here, all library units have been elaborated,
+    -- so the following calls should not raise Program_Error:
+    C854002_1.Caller.Call_Renamed_F(Should_Fail => False);
+    C854002_1.Caller.Call_Renamed_G(Should_Fail => False);
+
+    Result;
+end C854002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c854003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c854003.a
new file mode 100644
index 000000000..9ab2364a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c854003.a
@@ -0,0 +1,64 @@
+-- C854003.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that a renaming-as-body used before the subprogram is frozen only
+--    requires mode conformance.  (Defect Report 8652/0028, as reflected in
+--    Technical Corrigendum 1, RM95 8.5.4(5/1)).
+--
+-- CHANGE HISTORY:
+--    29 JAN 2001   PHL   Initial version.
+--     5 DEC 2001   RLB   Reformatted for ACATS.
+--
+--!
+with Report;
+use Report;
+procedure C854003 is
+
+    package P is
+        type T is private;
+        C1 : constant T;
+        C2 : constant T;
+    private
+        type T is new Integer'Base;
+        C1 : constant T := T (Ident_Int (1));
+        C2 : constant T := T (Ident_Int (1));
+    end P;
+
+    function Equals (X, Y : P.T) return Boolean;
+    function Equals (X, Y : P.T) return Boolean renames P."=";
+
+begin
+    Test ("C854003",
+          "Check that a renaming-as-body used before the subprogram " &
+             "is frozen only requires mode conformance");
+
+    if not Equals (P.C1, P.C2) then
+        Failed ("Equality returned an unexpected result");
+    end if;
+
+    Result;
+end C854003;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86003a.ada
new file mode 100644
index 000000000..92b36638e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86003a.ada
@@ -0,0 +1,122 @@
+-- C86003A.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  'STANDARD'  IS NOT TREATED AS A RESERVED WORD IN
+--    SELECTED COMPONENT NAMES.
+
+-- RM  01/21/80
+-- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- RLB 06/29/01  CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION.
+
+WITH REPORT ;
+PROCEDURE  C86003A  IS
+
+     USE REPORT ;
+
+BEGIN
+
+     TEST("C86003A" , "CHECK THAT  'STANDARD'  IS NOT TREATED AS A" &
+                      " RESERVED WORD IN SELECTED COMPONENT NAMES" );
+
+     DECLARE    -- A
+     BEGIN
+
+          DECLARE
+
+               PACKAGE  STANDARD  IS
+                    CHARACTER      :  BOOLEAN ;
+                    TYPE  INTEGER  IS (FALSE, TRUE) ;
+                    CONSTRAINT_ERROR :  EXCEPTION ;
+               END  STANDARD ;
+
+               TYPE  REC2  IS
+                    RECORD
+                         AA , BB  :  BOOLEAN  := FALSE ;
+                    END RECORD;
+
+               TYPE  REC1  IS
+                    RECORD
+                         STANDARD : REC2 ;
+                    END RECORD;
+
+               A    :  REC1 ;
+               TYPE  ASI  IS  ACCESS STANDARD.INTEGER ;
+               VASI  :  ASI ;
+               VI : INTEGER RANGE 1 .. 10;   -- THE "REAL" STANDARD
+                                             -- TYPE 'INTEGER'
+
+          BEGIN
+
+               VASI  :=  NEW STANDARD.INTEGER'(STANDARD.FALSE);
+               STANDARD.CHARACTER  :=  A.STANDARD.BB ;
+
+               IF  STANDARD.CHARACTER  THEN FAILED( "RES. (VAR.)" );
+               END IF;
+
+               VI  :=  IDENT_INT(11);   -- TO CAUSE THE "REAL"
+                                        -- (PREDEFINED) CONSTRAINT_ERROR
+                                        -- EXCEPTION.
+               IF VI /= IDENT_INT(11) THEN
+                   FAILED ("WRONG VALUE - V1");
+               ELSE
+                   FAILED ("OUT OF RANGE VALUE - V1");
+               END IF;
+          EXCEPTION
+
+               WHEN STANDARD.CONSTRAINT_ERROR => FAILED ("RES. (EXC.)");
+
+               WHEN CONSTRAINT_ERROR => NULL;
+
+               WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED - A");
+
+          END ;
+
+     EXCEPTION
+
+          WHEN  OTHERS  =>  FAILED( "EXCEPTION RAISED BY DECL. (A)" );
+
+     END ;    -- A
+
+
+     DECLARE    -- B
+
+          TYPE  REC  IS
+               RECORD
+                    INTEGER  :  BOOLEAN  := FALSE ;
+               END RECORD;
+
+          STANDARD :  REC ;
+
+     BEGIN
+
+          IF  STANDARD.INTEGER  THEN  FAILED( "RESERVED  -  REC.,INT.");
+          END IF;
+
+     END ;    -- B
+
+
+     RESULT ;
+
+
+END C86003A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004a.ada
new file mode 100644
index 000000000..937e5f3fb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004a.ada
@@ -0,0 +1,100 @@
+-- C86004A.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 LIBRARY SUBPROGRAM DECLARATION IS PRECEDED BY A
+--     "WITH" CLAUSE FOR A GENERIC LIBRARY PROCEDURE M, THEN IN THE
+--     BODY OF THE SUBPROGRAM, "STANDARD.M" IS A LEGAL NAME
+--     FOR THE GENERIC PROCEDURE.
+
+-- HISTORY:
+--     DHH 03/14/88 CREATED ORIGINAL TEST.
+
+-- BEGIN BUILDING LIBRARY PROCEDURES
+
+GENERIC
+     TYPE ITEM IS (<>);
+PROCEDURE C86004A_SWAP(X,Y: IN OUT ITEM);
+
+PROCEDURE C86004A_SWAP(X,Y: IN OUT ITEM) IS
+     T : ITEM;
+BEGIN
+     T := X;
+     X := Y;
+     Y := T;
+END C86004A_SWAP;
+
+WITH C86004A_SWAP; WITH REPORT; USE REPORT;
+PROCEDURE C86004A1 IS
+     SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+     A : INT := IDENT_INT(10);
+     B : INT := IDENT_INT(0);
+     PROCEDURE SWITCH IS NEW STANDARD.C86004A_SWAP(INT);
+BEGIN
+     SWITCH(A,B);
+
+     IF A /= IDENT_INT(0) THEN
+          FAILED("STANDARD.GENERIC PROCEDURE - 1");
+     END IF;
+
+     IF B /= IDENT_INT(10) THEN
+          FAILED("STANDARD.GENERIC PROCEDURE - 2");
+     END IF;
+END C86004A1;
+
+WITH C86004A_SWAP; WITH REPORT; USE REPORT;
+PROCEDURE C86004A2;
+
+PROCEDURE C86004A2 IS
+     SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+     A : INT := IDENT_INT(10);
+     B : INT := IDENT_INT(0);
+BEGIN
+     DECLARE
+          PROCEDURE SWITCH IS NEW STANDARD.C86004A_SWAP(INT);
+     BEGIN
+          SWITCH(A,B);
+     END;
+     IF A /= IDENT_INT(0) THEN
+          FAILED("STANDARD.GENERIC PROCEDURE - B-0");
+     END IF;
+     IF B /= IDENT_INT(10) THEN
+          FAILED("STANDARD.GENERIC PROCEDURE - B-10");
+     END IF;
+END C86004A2;
+
+WITH C86004A1; WITH C86004A2;
+WITH REPORT; USE REPORT;
+PROCEDURE C86004A IS
+BEGIN
+     TEST("C86004A", "CHECK THAT IF A LIBRARY SUBPROGRAM DECLARATION " &
+                     "IS PRECEDED BY A ""WITH"" CLAUSE FOR A GENERIC " &
+                     "LIBRARY PROCEDURE M, THEN IN THE BODY OF THE " &
+                     "SUBPROGRAM, ""STANDARD.M"" IS A " &
+                     "LEGAL NAME FOR THE GENERIC PROCEDURE");
+     C86004A1;
+     C86004A2;
+
+     RESULT;
+END C86004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004b0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004b0.ada
new file mode 100644
index 000000000..5b9d7c533
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004b0.ada
@@ -0,0 +1,44 @@
+-- C86004B0.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:
+--     INDEPENDENT FUNCTION AND SUBPROGRAM SPECIFICATION FOR C86004B
+--     TEST.
+
+-- HISTORY:
+--     DHH 08/15/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+FUNCTION C86004B0(X : INTEGER) RETURN INTEGER IS
+BEGIN
+     IF EQUAL(3,3) THEN
+          RETURN X;
+     ELSE
+          RETURN 0;
+     END IF;
+END C86004B0;
+
+WITH C86004B0;
+WITH REPORT; USE REPORT;                          -- SPEC
+PROCEDURE C86004B1(INTGR : INTEGER := STANDARD.C86004B0(4));
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004b1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004b1.ada
new file mode 100644
index 000000000..09ae4faf6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004b1.ada
@@ -0,0 +1,53 @@
+-- C86004B1.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:
+--     LIBRARY SUBPROGRAM BODY FOR C86004B TEST.
+
+-- HISTORY:
+--     DHH 08/15/88 CREATED ORIGINAL TEST.
+
+PROCEDURE C86004B1(INTGR : INTEGER := STANDARD.C86004B0(4)) IS
+
+     SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+     A : INT := STANDARD.C86004B0(10);
+     B : INT := STANDARD.C86004B0(INTGR);
+
+BEGIN
+     TEST("C86004B", "CHECK THAT IF THE SPECIFICATION OF A LIBRARY " &
+                     "SUBPROGRAM HAS A ""WITH"" CLAUSE FOR A LIBRARY " &
+                     "SUBPROGRAM M, THEN IN THE FORMAL PART AND IN " &
+                     "THE BODY (IN ANOTHER FILE), ""STANDARD.M"" IS " &
+                      "A LEGAL NAME FOR THE SUBPROGRAM M");
+
+     IF B /= STANDARD.C86004B0(0) THEN
+          FAILED("STANDARD.SUBPROGRAM - B");
+     END IF;
+
+     IF A /= STANDARD.C86004B0(10) THEN
+          FAILED("STANDARD.SUBPROGRAM - A");
+     END IF;
+
+     RESULT;
+END C86004B1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004b2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004b2.ada
new file mode 100644
index 000000000..cb9cd23a0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004b2.ada
@@ -0,0 +1,46 @@
+-- C86004B2M.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 THE SPECIFICATION OF A LIBRARY SUBPROGRAM HAS A
+--     "WITH" CLAUSE FOR A LIBRARY SUBPROGRAM M, THEN IN THE FORMAL PART
+--     AND IN THE BODY (IN ANOTHER FILE), "STANDARD.M" IS A LEGAL NAME
+--     FOR THE SUBPROGRAM M.
+
+-- SEPARATE FILES ARE:
+--     C86004B0  A LIBRARY FUNCTION AND A LIBRARY SUBPROGRAM
+--               SPECIFICATION.
+--     C86004B1  A LIBRARY SUBPROGRAM BODY FOR THE C86004B0
+--               SPECIFICATION.
+--     C86004B2M MAIN PROCEDURE USING THE SUBPROGRAM OF C86004B1.
+
+-- HISTORY:
+--     DHH 08/15/88 CREATED ORIGINAL TEST.
+
+WITH C86004B1;
+WITH REPORT; USE REPORT;
+PROCEDURE C86004B2M IS
+BEGIN
+     C86004B1(IDENT_INT(0));
+END C86004B2M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004c0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004c0.ada
new file mode 100644
index 000000000..f3a1b3e71
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004c0.ada
@@ -0,0 +1,60 @@
+-- C86004C0.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:
+--     INDEPENDENT GENERIC FUNCTION AND SUBPROGRAM FOR C86004C TEST.
+
+-- HISTORY:
+--     DHH 09/14/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+GENERIC
+FUNCTION C86004C0_GEN(X : INTEGER) RETURN INTEGER;
+
+FUNCTION C86004C0_GEN(X : INTEGER) RETURN INTEGER IS
+BEGIN
+     IF EQUAL(3,3) THEN
+          RETURN X;
+     ELSE
+          RETURN 0;
+     END IF;
+END C86004C0_GEN;
+
+WITH C86004C0_GEN;
+PRAGMA ELABORATE(C86004C0_GEN);
+FUNCTION C86004C0 IS NEW C86004C0_GEN;
+
+WITH C86004C0;
+WITH REPORT; USE REPORT;
+PROCEDURE C86004C01(INTGR : INTEGER := STANDARD.C86004C0(4)) IS
+
+     SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+     A : INT := STANDARD.C86004C0(10);
+     B : INT := STANDARD.C86004C0(INTGR);
+
+     PROCEDURE C86004C1 IS SEPARATE;
+
+BEGIN
+     C86004C1;
+END;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004c1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004c1.ada
new file mode 100644
index 000000000..b896a8e26
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004c1.ada
@@ -0,0 +1,50 @@
+-- C86004C1.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:
+--     SUBUNIT FOR THE C86004C01 PARENT.
+
+-- HISTORY:
+--     DHH 09/14/88 CREATED ORIGINAL TEST.
+
+SEPARATE (C86004C01)
+PROCEDURE C86004C1 IS
+BEGIN
+     TEST("C86004C", "CHECK THAT IF THE SPECIFICATION OF A " &
+                     "SUBPROGRAM HAS A ""WITH"" CLAUSE FOR A GENERIC " &
+                     "SUBPROGRAM INSTANTIANTION M, THEN IN THE " &
+                     "FORMAL PART AND IN THE BODY (A SUBUNIT IN " &
+                     "ANOTHER FILE), ""STANDARD.M"" IS " &
+                     "A LEGAL NAME FOR THE SUBPROGRAM M");
+
+     IF B /= STANDARD.C86004C0(0) THEN
+          FAILED("STANDARD.SUBPROGRAM - B");
+     END IF;
+
+     IF A /= STANDARD.C86004C0(10) THEN
+          FAILED("STANDARD.SUBPROGRAM - A");
+     END IF;
+
+     RESULT;
+END C86004C1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004c2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004c2.ada
new file mode 100644
index 000000000..ffe1e0592
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86004c2.ada
@@ -0,0 +1,45 @@
+-- C86004C2M.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 THE SPECIFICATION OF A LIBRARY SUBPROGRAM HAS A
+--     "WITH" CLAUSE FOR A GENERIC SUBPROGRAM INSTANTIATION M, THEN IN
+--     THE FORMAL PART AND IN THE BODY (A SUBUNIT IN ANOTHER FILE),
+--     "STANDARD.M" IS A LEGAL NAME FOR THE SUBPROGRAM M.
+
+-- SEPARATE FILES ARE:
+--     C86004C0  A GENERIC LIBRARY FUNCTION AND A LIBRARY SUBPROGRAM
+--               DECLARING A SEPARATE SUBUNIT.
+--     C86004C1  A SUBUNIT FOR THE C86004C0 PARENT.
+--     C86004C2M MAIN PROCEDURE USING THE SUBPROGRAM OF C86004C0.
+
+-- HISTORY:
+--     DHH 09/14/88 CREATED ORIGINAL TEST.
+
+WITH C86004C01;
+WITH REPORT; USE REPORT;
+PROCEDURE C86004C2M IS
+BEGIN
+     C86004C01(IDENT_INT(0));
+END C86004C2M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86006i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86006i.ada
new file mode 100644
index 000000000..38778f97c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86006i.ada
@@ -0,0 +1,103 @@
+-- C86006I.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 IDENTIFIERS "BOOLEAN, TRUE, AND FALSE" AND THE 
+--     IDENTIFIERS "INTEGER, NATURAL, AND POSITIVE" ARE DECLARED IN 
+--     THE PACKAGE "STANDARD", ALONG WITH THE OPERATORS OF THE TYPE 
+--     BOOLEAN AND THE TYPE INTEGER.                                          
+
+-- HISTORY:
+--     DTN 04/15/92 CONSOLIDATION OF C86006A AND C86006B.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C86006I IS
+     
+     ABOOL, BBOOL : STANDARD.BOOLEAN := STANDARD.FALSE;
+     CBOOL : STANDARD.BOOLEAN := STANDARD.TRUE;
+     INT1 : STANDARD.INTEGER := -2;
+     NAT1 : STANDARD.NATURAL := 0;
+     POS1, POS2 : STANDARD.POSITIVE := 2;
+
+BEGIN
+
+     TEST("C86006I", "CHECK THAT THE IDENTIFIERS ""BOOLEAN, TRUE, AND " &
+                     "FALSE"" AND THE IDENTIFIERS ""INTEGER, NATURAL, " &
+                     "AND POSITIVE"" ARE DECLARED IN THE PACKAGE " &
+                     """STANDARD"", ALONG WITH THE OPERATORS OF THE " &
+                     "TYPE BOOLEAN AND THE TYPE INTEGER");
+
+     -- STANDARD.">" OPERATOR.
+
+     IF STANDARD.">"(ABOOL,BBOOL) THEN
+          FAILED("STANDARD.> FAILED FOR BOOLEAN TYPE");
+     END IF;
+
+     IF STANDARD.">"(INT1,NAT1) THEN
+          FAILED("STANDARD.> FAILED FOR INTEGER-NATURAL TYPE");
+     END IF;
+
+     -- STANDARD."/=" OPERATOR.
+
+     IF STANDARD."/="(ABOOL,BBOOL) THEN
+          FAILED("STANDARD./= FAILED FOR BOOLEAN TYPE");
+     END IF;
+
+     IF STANDARD."/="(POS1,POS2) THEN
+          FAILED("STANDARD./= FAILED FOR INTEGER-POSITIVE TYPE");
+     END IF;
+
+     -- STANDARD."AND" OPERATOR.
+
+     IF STANDARD."AND"(CBOOL,ABOOL) THEN
+          FAILED("STANDARD.AND FAILED");
+     END IF;
+
+     -- STANDARD."-" BINARY OPERATOR.
+
+     IF STANDARD."-"(INT1,POS1) /= IDENT_INT(-4) THEN
+          FAILED("STANDARD.- FAILED");
+     END IF;
+
+     -- STANDARD."-" UNARY OPERATOR.
+
+     IF STANDARD."-"(INT1) /= IDENT_INT(2) THEN
+          FAILED("STANDARD.UNARY - FAILED");
+     END IF;
+
+     -- STANDARD."REM" OPERATOR.
+
+     IF STANDARD."REM"(IDENT_INT(14),IDENT_INT(5)) /= IDENT_INT(4) THEN
+          FAILED("STANDARD.REM (++=+) FAILED");
+     END IF;
+
+     -- STANDARD."MOD" OPERATOR.
+
+     IF STANDARD."MOD"(IDENT_INT(14),IDENT_INT(-5)) /= IDENT_INT(-1) THEN
+          FAILED("STANDARD.MOD (+-=-) FAILED");
+     END IF;
+
+     RESULT;
+
+END C86006I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86007a.ada
new file mode 100644
index 000000000..ba41e176c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c86007a.ada
@@ -0,0 +1,79 @@
+-- C86007A.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 EXPANDED NAME FOR AN ENTITY DECLARED IN THE VISIBLE
+--     PART OF A LIBRARY PACKAGE CAN START WITH THE NAME "STANDARD".
+
+-- HISTORY:
+--     DHH 03/15/88 CREATED ORIGINAL TEST.
+--     RJW 10/26/89 ADDED "PRAGMA ELABORATE (REPORT);"
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PACKAGE C86007A_PACK IS
+     SUBTYPE ITEM IS INTEGER RANGE 0 .. 10;
+     Y : STANDARD.C86007A_PACK.ITEM := IDENT_INT(5);
+     TYPE ACC IS ACCESS STANDARD.C86007A_PACK.ITEM;
+     PROCEDURE SWAP(X,Y: IN OUT ITEM);
+     PROCEDURE PROC;
+END C86007A_PACK;
+
+PACKAGE BODY C86007A_PACK IS
+     PROCEDURE SWAP(X,Y: IN OUT STANDARD.C86007A_PACK.ITEM) IS
+          T : STANDARD.C86007A_PACK.ITEM;
+     BEGIN
+          T := X;
+          X := Y;
+          Y := T;
+     END SWAP;
+
+     PROCEDURE PROC IS
+          X : STANDARD.C86007A_PACK.ITEM := IDENT_INT(10);
+          W : STANDARD.C86007A_PACK.ACC;
+     BEGIN
+
+          W := NEW STANDARD.C86007A_PACK.ITEM;
+          W.ALL := X;
+          STANDARD.C86007A_PACK.SWAP(X, STANDARD.C86007A_PACK.Y);
+          IF STANDARD.C86007A_PACK.Y /= IDENT_INT(10) THEN
+               FAILED("FAILED STANDARD.NAME CALL PROCEDURE - B-10");
+          END IF;
+          IF X /= IDENT_INT(5) THEN
+               FAILED("FAILED STANDARD.NAME CALL PROCEDURE - B-5");
+          END IF;
+     END PROC;
+END C86007A_PACK;
+
+WITH C86007A_PACK; WITH REPORT; USE REPORT;
+PROCEDURE C86007A IS
+BEGIN
+     TEST("C86007A", "CHECK THAT AN EXPANDED NAME FOR AN ENTITY " &
+                     "DECLARED IN THE VISIBLE PART OF A LIBRARY " &
+                     "PACKAGE CAN START WITH THE NAME ""STANDARD""");
+
+     STANDARD.C86007A_PACK.PROC;
+
+     RESULT;
+END C86007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87a05a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87a05a.ada
new file mode 100644
index 000000000..8efbbdeec
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87a05a.ada
@@ -0,0 +1,108 @@
+-- C87A05A.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 FUNCTION CALLS AND INDEXED COMPONENT EXPRESSIONS CAN BE 
+-- DISTINGUISHED BY THE RULES OF OVERLOADING RESOLUTION.
+--
+-- PART 1 : CORRECT RESOLUTION IS INDEXED COMPONENT EXPRESSION
+  
+-- TRH  13 JULY 82
+-- DSJ  09 JUNE 83
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87A05A IS
+     
+     OK : BOOLEAN := TRUE;
+     TYPE VECTOR IS ARRAY (1 .. 5) OF BOOLEAN;
+  
+     PROCEDURE P (ARG : BOOLEAN) IS          -- THIS IS CORRECT P
+     BEGIN 
+          OK := ARG;
+     END P;
+  
+     PROCEDURE P (ARG : CHARACTER) IS
+     BEGIN 
+          OK := FALSE;
+     END P;
+
+     FUNCTION Y RETURN VECTOR IS             -- THIS IS CORRECT Y
+     BEGIN
+          RETURN (VECTOR'RANGE => TRUE);
+     END Y;
+
+     FUNCTION Y (ARG : INTEGER) RETURN FLOAT IS
+     BEGIN 
+          OK := FALSE;
+          RETURN 0.0;
+     END Y;
+       
+     FUNCTION Y (ARG : CHARACTER) RETURN CHARACTER IS
+     BEGIN 
+          OK := FALSE;
+          RETURN 'A';
+     END Y;
+   
+     FUNCTION Y (ARG : FLOAT) RETURN FLOAT IS
+     BEGIN 
+          OK := FALSE;
+          RETURN 0.0;
+     END Y;
+       
+     FUNCTION Y RETURN BOOLEAN IS
+     BEGIN 
+          OK := FALSE;
+          RETURN FALSE;
+     END Y;
+       
+     FUNCTION Y (ARG : CHARACTER := 'A') RETURN BOOLEAN IS
+     BEGIN 
+          OK := FALSE;
+          RETURN FALSE;
+     END Y;
+    
+     FUNCTION Z RETURN INTEGER IS            -- THIS IS CORRECT Z
+     BEGIN 
+          RETURN 3;
+     END Z;
+       
+     FUNCTION Z RETURN FLOAT IS
+     BEGIN 
+          OK := FALSE;
+          RETURN 3.0;
+     END Z;
+   
+BEGIN
+     TEST ("C87A05A","OVERLOADING RESOLUTION FOR DISTINGUISHING " &
+           "FUNCTION CALLS FROM INDEXED COMPONENTS WHERE INDEXED " &
+           "COMPONENTS ARE CORRECT");
+  
+     P (Y (Z) );
+  
+     IF NOT OK THEN 
+          FAILED ("RESOLUTION INCORRECT");
+     END IF;
+    
+     RESULT;
+END C87A05A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87a05b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87a05b.ada
new file mode 100644
index 000000000..7d99c9578
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87a05b.ada
@@ -0,0 +1,107 @@
+-- C87A05B.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 FUNCTION CALLS AND INDEXED COMPONENT EXPRESSIONS CAN BE 
+-- DISTINGUISHED BY THE RULES OF OVERLOADING RESOLUTION.
+--
+-- PART 2 : CORRECT RESOLUTION IS FUNCTION CALL
+  
+-- TRH  15 JULY 82
+-- DSJ  09 JUNE 83
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87A05B IS
+     
+     OK : BOOLEAN := TRUE;
+     TYPE VECTOR IS ARRAY (1 .. 5) OF BOOLEAN;
+  
+     PROCEDURE P (ARG : CHARACTER := 'A') IS
+     BEGIN 
+          OK := FALSE;
+     END P;
+     
+     PROCEDURE P IS
+     BEGIN 
+          OK := FALSE;
+     END P;
+  
+     PROCEDURE P (ARG : INTEGER) IS               -- THIS IS CORRECT P
+     BEGIN 
+          OK := (ARG = 1);
+     END P;
+
+     FUNCTION Y RETURN VECTOR IS
+     BEGIN
+          OK := FALSE;
+          RETURN (VECTOR'RANGE => TRUE);
+     END Y;
+     
+     FUNCTION Y RETURN CHARACTER IS
+     BEGIN
+          OK := FALSE;
+          RETURN 'A';
+     END Y;
+       
+     FUNCTION Y (ARG : FLOAT) RETURN FLOAT IS
+     BEGIN 
+          OK := FALSE;
+          RETURN 0.0;
+     END Y;
+   
+     FUNCTION Y (ARG : CHARACTER) RETURN INTEGER IS
+     BEGIN 
+          OK := FALSE;
+          RETURN 0;
+     END Y;
+    
+     FUNCTION Y (ARG : FLOAT) RETURN INTEGER IS   -- THIS IS CORRECT Y
+     BEGIN 
+          RETURN 1;
+     END Y;
+       
+     FUNCTION Z RETURN INTEGER IS
+     BEGIN 
+          OK := FALSE;
+          RETURN 3;
+     END Z;
+       
+     FUNCTION Z RETURN FLOAT IS                   -- THIS IS CORRECT Z
+     BEGIN 
+          RETURN 3.0;
+     END Z;
+   
+BEGIN
+     TEST ("C87A05B","OVERLOADING RESOLUTION FOR DISTINGUISHING " &
+           "FUNCTION CALLS FROM INDEXED COMPONENTS WHERE CORRECT " &
+           "RESOLUTION IS FUNCTION CALL");
+  
+     P (Y (Z) );
+  
+     IF NOT OK THEN 
+          FAILED ("RESOLUTION INCORRECT");
+     END IF;
+    
+     RESULT;
+END C87A05B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b02a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b02a.ada
new file mode 100644
index 000000000..9f789c9b2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b02a.ada
@@ -0,0 +1,124 @@
+-- C87B02A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN A CONSTANT DECLARATION, THE TYPE OF THE INITIALIZATION
+-- EXPRESSION MUST MATCH THE CONSTANT'S EXPLICIT TYPEMARK.
+--      
+-- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+-- 
+--    (A): A CALL TO AN OVERLOADED FUNCTION.
+--    (B): AN OVERLOADED OPERATOR SYMBOL.
+--    (C): AN OVERLOADED (INFIX) OPERATOR.
+--    (D): AN OVERLOADED ENUMERATION LITERAL.
+  
+-- TRH  17 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B02A IS
+  
+     TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+     TYPE CITRUS IS (LEMON, LIME, ORANGE);
+     TYPE HUE    IS (RED, ORANGE, YELLOW);
+     
+     FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN -1;
+     END F1;
+
+     FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+     BEGIN
+          RETURN 0;
+     END F1;
+    
+     FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+
+     FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+   
+BEGIN
+     TEST ("C87B02A","OVERLOADED INITIALIZATION EXPRESSIONS" &
+          " IN CONSTANT DECLARATIONS");
+     DECLARE
+
+          FUNCTION "*" (X, Y : INTEGER) RETURN INTEGER
+               RENAMES F1;
+    
+          FUNCTION "*" (X, Y : WHOLE)   RETURN WHOLE
+               RENAMES F1;
+     
+          FUNCTION "*" (X, Y : INTEGER) RETURN HUE
+               RENAMES F1;
+   
+          FUNCTION "*" (X, Y : INTEGER) RETURN CITRUS
+               RENAMES F1;
+      
+          I1 : CONSTANT INTEGER := F1 (0, 0);
+          W1 : CONSTANT WHOLE   := F1 (0, 0);
+          C1 : CONSTANT CITRUS  := F1 (0, 0);
+          H1 : CONSTANT HUE     := F1 (0, 0);
+   
+          I2 : CONSTANT INTEGER := "*" (0, 0);
+          W2 : CONSTANT WHOLE   := "*" (0, 0);
+          C2 : CONSTANT CITRUS  := "*" (0, 0);
+          H2 : CONSTANT HUE     := "*" (0, 0);
+      
+          I3 : CONSTANT INTEGER := (0 * 0);
+          W3 : CONSTANT WHOLE   := (0 * 0);
+          C3 : CONSTANT CITRUS  := (0 * 0);
+          H3 : CONSTANT HUE     := (0 * 0);
+      
+          C4 : CONSTANT CITRUS  := ORANGE;
+          H4 : CONSTANT HUE     := ORANGE;
+
+     BEGIN
+          IF I1              /= -1 OR W1           /= 0 OR
+             CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
+             FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+          END IF;
+    
+          IF I2              /= -1 OR W2           /= 0 OR
+             CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
+             FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
+          END IF;
+    
+          IF I3              /= -1 OR W3           /= 0 OR
+             CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
+             FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+          END IF;
+    
+          IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
+             FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
+          END IF;
+     END;
+    
+     RESULT;
+END C87B02A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b02b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b02b.ada
new file mode 100644
index 000000000..5f2db7c40
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b02b.ada
@@ -0,0 +1,124 @@
+-- C87B02B.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN A VARIABLE DECLARATION, THE TYPE OF THE INITIALIZATION
+-- EXPRESSION MUST MATCH THE VARIABLE'S EXPLICIT TYPEMARK.
+--      
+-- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+-- 
+--    (A): A CALL TO AN OVERLOADED FUNCTION.
+--    (B): AN OVERLOADED OPERATOR SYMBOL.
+--    (C): AN OVERLOADED (INFIX) OPERATOR.
+--    (D): AN OVERLOADED ENUMERATION LITERAL.
+  
+-- TRH  17 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B02B IS
+  
+     TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+     TYPE CITRUS IS (LEMON, LIME, ORANGE);
+     TYPE HUE    IS (RED, ORANGE, YELLOW);
+     
+     FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN -1;
+     END F1;
+
+     FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+     BEGIN
+          RETURN 0;
+     END F1;
+    
+     FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+
+     FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+   
+BEGIN
+     TEST ("C87B02B","OVERLOADED INITIALIZATION EXPRESSIONS" &
+           " IN VARIABLE DECLARATIONS");
+     DECLARE
+
+          FUNCTION "REM" (X, Y : INTEGER) RETURN INTEGER
+               RENAMES F1;
+    
+          FUNCTION "REM" (X, Y : WHOLE)   RETURN WHOLE
+               RENAMES F1;
+     
+          FUNCTION "REM" (X, Y : INTEGER) RETURN HUE
+               RENAMES F1;
+   
+          FUNCTION "REM" (X, Y : INTEGER) RETURN CITRUS
+               RENAMES F1;
+      
+          I1 : INTEGER := F1 (0, 0);
+          W1 : WHOLE   := F1 (0, 0);
+          C1 : CITRUS  := F1 (0, 0);
+          H1 : HUE     := F1 (0, 0);
+   
+          I2 : INTEGER := "REM" (0, 0);
+          W2 : WHOLE   := "REM" (0, 0);
+          C2 : CITRUS  := "REM" (0, 0);
+          H2 : HUE     := "REM" (0, 0);
+      
+          I3 : INTEGER := (0 REM 0);
+          W3 : WHOLE   := (0 REM 0);
+          C3 : CITRUS  := (0 REM 0);
+          H3 : HUE     := (0 REM 0);
+      
+          C4 : CITRUS  := ORANGE;
+          H4 : HUE     := ORANGE;
+
+     BEGIN
+          IF I1              /= -1 OR W1           /= 0 OR
+             CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
+             FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+          END IF;
+    
+          IF I2              /= -1 OR W2           /= 0 OR
+             CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
+             FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
+          END IF;
+    
+          IF I3              /= -1 OR W3           /= 0 OR
+             CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
+             FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+          END IF;
+    
+          IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
+             FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
+          END IF;
+     END;
+    
+     RESULT;
+END C87B02B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b03a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b03a.ada
new file mode 100644
index 000000000..d0b372237
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b03a.ada
@@ -0,0 +1,61 @@
+-- C87B03A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE EXPRESSION IN A NUMBER DECLARATION MUST BE EITHER OF THE TYPE
+-- UNIVERSAL_INTEGER OR UNIVERSAL_REAL.
+   
+-- TRH  16 JUNE 82
+     
+WITH REPORT; USE REPORT;
+    
+PROCEDURE C87B03A IS
+    
+BEGIN
+     TEST ("C87B03A","OVERLOADED EXPRESSIONS IN NUMBER DECLARATIONS");
+  
+     DECLARE
+          FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
+               RENAMES STANDARD."-";
+           
+          FUNCTION "+" (X, Y : FLOAT)   RETURN FLOAT
+               RENAMES STANDARD."-";
+  
+          I1 : CONSTANT         := 1 + 1;
+          I2 : CONSTANT INTEGER := 1 + 1;
+   
+          R1 : CONSTANT       := 1.0 + 1.0;
+          R2 : CONSTANT FLOAT := 1.0 + 1.0;
+  
+     BEGIN
+          IF I1 /= 2   OR I2 /= 0   OR 
+             R1 /= 2.0 OR R2 /= 0.0 THEN
+             FAILED ("OVERLOADED EXPRESSIONS IN NUMBER DECLARATIONS" &
+                     " RESOLVED INCORRECTLY");
+          END IF;
+     END;
+   
+     RESULT;
+END C87B03A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b04a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b04a.ada
new file mode 100644
index 000000000..ea2e65c1a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b04a.ada
@@ -0,0 +1,79 @@
+-- C87B04A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN A RANGE CONSTRAINT OF A SUBTYPE INDICATION, THE EXPRESSIONS
+-- FOR THE LOWER AND UPPER BOUNDS MUST BE COMPATIBLE WITH THE SUBTYPE'S
+-- EXPLICIT TYPEMARK.
+  
+-- TRH  28 JUNE 82
+-- JBG 3/8/84
+
+WITH REPORT; USE REPORT;
+PROCEDURE C87B04A IS
+  
+     TYPE AGE    IS NEW INTEGER RANGE 1 .. 120;
+     TYPE BASE10 IS NEW INTEGER RANGE 0 .. 9;
+     
+     FUNCTION F1 RETURN AGE IS
+     BEGIN
+          RETURN 18;
+     END F1;
+
+     FUNCTION F1 RETURN INTEGER IS
+     BEGIN
+          FAILED ("RESOLUTION INCORRECT - RANGE CONSTRAINT OF " &
+                  "SUBTYPE INDICATION");
+          RETURN 0;
+     END F1;
+    
+     FUNCTION "+" (X : INTEGER) RETURN BASE10 IS
+     BEGIN
+          RETURN 1;
+     END "+";
+
+     FUNCTION "+" (X : INTEGER) RETURN INTEGER IS
+     BEGIN
+          FAILED ("RESOLUTION INCORRECT - RANGE CONSTRAINT OF " &
+                  "SUBTYPE INDICATION");
+          RETURN -X;
+     END "+";
+  
+BEGIN
+     TEST ("C87B04A","OVERLOADED EXPRESSIONS IN RANGE CONTRAINTS" &
+           " OF SUBTYPE INDICATIONS");
+   
+     DECLARE
+          SUBTYPE MINOR IS AGE RANGE 1 .. F1;
+  
+     BEGIN
+          FOR I IN BASE10 RANGE +(INTEGER'(0)) .. 0 LOOP
+               FAILED ("RESOLUTION INCORRECT - SUBTYPE INDICATION " &
+                       " IN LOOP CONSTRUCT");
+          END LOOP;
+     END;
+    
+     RESULT;
+END C87B04A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b04b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b04b.ada
new file mode 100644
index 000000000..681011ba3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b04b.ada
@@ -0,0 +1,82 @@
+-- C87B04B.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+
+--      IN AN ACCURACY CONSTRAINT OF A SUBTYPE INDICATION, THE
+--      EXPRESSIONS FOR THE LOWER AND UPPER BOUNDS MUST BE COMPATIBLE
+--      WITH THE SUBTYPE'S EXPLICIT TYPEMARK.
+
+-- HISTORY:
+--      TRH 06/29/82  CREATED ORIGINAL TEST.
+--      BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.  CORRECTED
+--                    CONSTRAINT ERRORS.
+--      KAS 11/24/95  DELETED SUBTYPE DIGITS CONSTRAINT
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C87B04B IS
+
+     TYPE EXACT IS DIGITS 5     RANGE -1.0 .. 1.0;
+     TYPE HEX IS DELTA  2.0 ** (-4) RANGE -1.0 .. 1.0;
+
+     FUNCTION F1 RETURN EXACT IS
+     BEGIN
+          RETURN 0.0;
+     END F1;
+
+     FUNCTION F1 RETURN FLOAT IS
+     BEGIN
+          FAILED ("RESOLUTION INCORRECT - ACCURACY CONSTRAINT OF " &
+                  "SUBTYPE INDICATION - F1");
+          RETURN 0.0;
+     END F1;
+
+     FUNCTION "+" (X : INTEGER) RETURN HEX IS
+     BEGIN
+          RETURN 0.0;
+     END "+";
+
+     FUNCTION "+" (X : INTEGER) RETURN FLOAT IS
+     BEGIN
+          FAILED ("RESOLUTION INCORRECT - ACCURACY CONSTRAINT OF " &
+                  "SUBTYPE INDICATION - +");
+          RETURN 0.0;
+     END "+";
+
+BEGIN
+     TEST ("C87B04B","OVERLOADED EXPRESSIONS IN ACCURACY CONTRAINTS" &
+           " OF FLOATING/FIXED POINT SUBTYPE INDICATIONS");
+
+     DECLARE
+          SUBTYPE CLOSE IS EXACT RANGE -1.0 .. F1;
+          SUBTYPE BIN IS HEX DELTA 2.0 ** (-1) RANGE "+" (0) .. 0.5;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C87B04B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b04c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b04c.ada
new file mode 100644
index 000000000..df67059b5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b04c.ada
@@ -0,0 +1,60 @@
+-- C87B04C.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN A RANGE CONSTRAINT OF A SUBTYPE INDICATION, THE EXPRESSIONS
+-- FOR THE LOWER AND UPPER BOUNDS MUST BE COMPATIBLE WITH THE SUBTYPE'S
+-- EXPLICIT TYPEMARK.
+  
+-- TRH  29 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B04C IS
+  
+     TYPE DAY IS (MON, TUE, WED, THU, FRI, SAT, SUN);
+     TYPE ORB IS (SUN, MOON, MARS, EARTH);
+  
+     TYPE GRADE IS ('A', 'B', 'C', 'D', 'F');
+     TYPE VOWEL IS ('C', 'E', 'A', 'O', 'I', 'U', 'Y');
+  
+BEGIN
+     TEST ("C87B04C","OVERLOADED EXPRESSIONS IN RANGE CONSTRAINTS" &
+          " OF ENUMERATION SUBTYPE INDICATIONS");
+  
+     DECLARE
+          SUBTYPE PASSING IS GRADE RANGE 'A' .. 'C';
+          SUBTYPE DISTANT IS ORB   RANGE SUN .. MARS;
+  
+     BEGIN
+          IF DISTANT'POS (DISTANT'FIRST) /= 0 OR
+             PASSING'POS (PASSING'FIRST) /= 0 THEN 
+             FAILED ("RESOLUTION INCORRECT FOR OVERLOADED " &
+                     " ENUMERATION LITERALS");
+          END IF;
+     END;
+    
+     RESULT;
+END C87B04C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b05a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b05a.ada
new file mode 100644
index 000000000..f50ce379b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b05a.ada
@@ -0,0 +1,70 @@
+-- C87B05A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN AN INTEGER TYPE DEFINITION WITH A RANGE CONSTRAINT, THE BOUNDS
+-- OF THE RANGE MUST BE OF SOME INTEGER TYPE.
+  
+-- TRH  1 JULY 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B05A IS
+  
+     ERR : BOOLEAN := FALSE;
+     TYPE WHOLE IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+     TYPE AGE   IS NEW INTEGER RANGE 0 .. 120;
+     
+     FUNCTION "+" (X : WHOLE) RETURN FLOAT IS
+     BEGIN 
+          ERR := TRUE;
+          RETURN 2.0;
+     END "+";
+
+     FUNCTION "-" (X : AGE) RETURN BOOLEAN IS
+     BEGIN 
+          ERR := TRUE;
+          RETURN FALSE;
+     END "-";
+  
+BEGIN
+     TEST ("C87B05A","OVERLOADED EXPRESSIONS IN RANGE BOUNDS " &
+           " OF INTEGER TYPE DEFINITIONS");
+   
+     DECLARE
+          TYPE ADULT IS RANGE 18 .. "+" (WHOLE'(120));
+          TYPE MINOR IS RANGE "-" (AGE'(0))  .. "+" (WHOLE'(17));
+          TYPE NEG10 IS RANGE "-" (AGE'(10)) .. "-" (AGE'(1));
+  
+     BEGIN
+          IF ERR THEN 
+               FAILED ("RESOLUTION INCORRECT - INTEGER TYPE " &
+                       "DEFINITIONS MUST HAVE INTEGER TYPE "  &
+                       "RANGE BOUNDS");
+          END IF;
+     END;
+    
+     RESULT;
+END C87B05A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b06a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b06a.ada
new file mode 100644
index 000000000..a5c64b4b4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b06a.ada
@@ -0,0 +1,90 @@
+-- C87B06A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+--     FOR EACH INTEGER TYPE, THERE EXISTS AN IMPLICIT CONVERSION THAT
+--     CONVERTS A UNIVERSAL INTEGER VALUE INTO THE CORRESPONDING VALUE
+--     OF THE INTEGER TYPE. THIS TEST USES LITERALS AS UNIVERSAL INTEGER
+--     VALUES.
+
+-- HISTORY:
+--     TRH 08/11/82 CREATED ORIGINAL TEST.
+--     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C87B06A IS
+
+     TYPE MINOR IS NEW INTEGER RANGE 0 .. 17;
+     TYPE FIXED IS NEW DURATION;
+     TYPE REAL  IS NEW FLOAT;
+
+     ERR : BOOLEAN := FALSE;
+
+     PROCEDURE P (X : BOOLEAN) IS
+     BEGIN
+          ERR := TRUE;
+     END P;
+     PROCEDURE P (X : FIXED) IS
+     BEGIN
+          ERR := TRUE;
+     END P;
+
+     PROCEDURE P (X : REAL) IS
+     BEGIN
+          ERR := TRUE;
+     END P;
+
+     PROCEDURE P (X : FLOAT) IS
+     BEGIN
+          ERR := TRUE;
+     END P;
+
+     PROCEDURE P (X : STRING) IS
+     BEGIN
+          ERR := TRUE;
+     END P;
+
+     PROCEDURE P (X : MINOR) IS
+     BEGIN
+          NULL;
+     END P;
+
+BEGIN
+     TEST("C87B06A","OVERLOADING RESOLUTION WITH IMPLICIT CONVERSION " &
+          "OF UNIVERSAL INTEGER VALUES TO INTEGER VALUES. " &
+          "CONVERSIONS TO INTEGER VALUES EXISTS FOR ANY INTEGER TYPE");
+
+     P (2);
+     P (2 * 2 + 2);
+
+     IF ERR THEN
+          FAILED("INCORRECT IMPLICIT CONVERSION FROM UNIVERSAL " &
+                 " INTEGER VALUES TO INTEGER TYPE VALUES");
+     END IF;
+
+     RESULT;
+END C87B06A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07a.ada
new file mode 100644
index 000000000..635a8fc65
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07a.ada
@@ -0,0 +1,64 @@
+-- C87B07A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- FOR THE ATTRIBUTE OF THE FORM T'POS (X), THE OPERAND X MUST 
+-- BE A VALUE OF TYPE T. THE RESULT IS OF TYPE UNIVERSAL_INTEGER.
+  
+-- TRH  13 SEPT 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B07A IS
+ 
+     TYPE NATURAL IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
+     TYPE WHOLE   IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+     TYPE COLOR   IS (BROWN, RED, WHITE);
+     TYPE SCHOOL  IS (HARVARD, BROWN, YALE);
+     TYPE SUGAR   IS (DEXTROSE, CANE, BROWN);
+ 
+     FUNCTION "+" (X, Y : NATURAL) RETURN NATURAL
+          RENAMES "*";
+     FUNCTION "+" (X, Y : WHOLE) RETURN WHOLE
+          RENAMES "-";
+    
+BEGIN
+     TEST ("C87B07A","OVERLOADED OPERANDS TO THE 'POS' ATTRIBUTE");
+  
+     IF NATURAL'POS (1 + 1) /= 1 OR COLOR'POS  (BROWN) /= 0 OR
+        WHOLE'POS   (1 + 1) /= 0 OR SCHOOL'POS (BROWN) /= 1 OR
+        INTEGER'POS (1 + 1) /= 2 OR SUGAR'POS  (BROWN) /= 2 THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERAND TO 'POS' ATTRIBUTE");
+     END IF;
+ 
+     IF NATURAL'POS (3 + 3) + 1 /= 10 OR    -- SECOND "+" IS UNIVERSAL.
+        WHOLE'POS   (3 + 3) + 1 /=  1 OR    -- SECOND "+" IS UNIVERSAL.
+        INTEGER'POS (3 + 3) + 1 /=  7 THEN  -- SECOND "+" IS UNIVERSAL.
+        FAILED ("RESOLUTION INCORRECT - 'POS' ATTRIBUTE RETURNS " &
+                "A UNIVERSAL_INTEGER VALUE");
+     END IF;
+
+     RESULT;
+END C87B07A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07b.ada
new file mode 100644
index 000000000..ec2c0a193
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07b.ada
@@ -0,0 +1,101 @@
+-- C87B07B.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- FOR THE ATTRIBUTE OF THE FORM T'VAL (X), THE OPERAND X MAY
+-- BE OF ANY INTEGER TYPE. THE RESULT IS OF TYPE T.
+  
+-- TRH  15 SEPT 82
+-- DSJ  06 JUNE 83
+-- PWN  01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B07B IS
+ 
+     TYPE NEW_INT IS NEW INTEGER;
+     TYPE WHOLE   IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+     TYPE FLAG IS (PASS, FAIL);
+     
+     FUNCTION "+" (X, Y : NEW_INT) RETURN NEW_INT
+          RENAMES "-";
+     FUNCTION "+" (X, Y : WHOLE)   RETURN WHOLE
+          RENAMES "*";
+ 
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : IN FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          IF STAT = FAIL THEN 
+               FAILED ("THE 'VAL' ATTRIBUTE TAKES AN OPERAND " &
+                       "OF AN INTEGER TYPE");
+          END IF;
+          RETURN ARG;
+     END F1;
+  
+     FUNCTION F IS NEW F1 (CHARACTER, '1', FAIL);
+     FUNCTION F IS NEW F1 (DURATION,  1.0, FAIL);
+     FUNCTION F IS NEW F1 (FLOAT,     1.0, FAIL);
+     FUNCTION F IS NEW F1 (NEW_INT,   1,   PASS);
+    
+BEGIN
+     TEST ("C87B07B","OVERLOADED OPERANDS TO THE 'VAL' ATTRIBUTE");
+    
+     IF (INTEGER'VAL (F) /= 1)          THEN
+          FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                  "MUST RETURN A VALUE OF TYPE T - 1");
+     END IF;
+
+     IF (INTEGER'VAL (3 + 3) + 1 /= 7)  THEN
+          FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                  "MUST RETURN A VALUE OF TYPE T - 2");
+     END IF;
+
+     IF (NEW_INT'VAL (F) /= 1)          THEN
+          FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                  "MUST RETURN A VALUE OF TYPE T - 3");
+     END IF;
+
+     IF (NEW_INT'VAL  (3 + 3) + 1 /= 5) THEN
+          FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                  "MUST RETURN A VALUE OF TYPE T - 4");
+     END IF;
+
+     IF (WHOLE'VAL    (F) /= 1)         THEN
+          FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                  "MUST RETURN A VALUE OF TYPE T - 5");
+     END IF;
+
+     IF (WHOLE'VAL    (3 + 3) + 1 /= 6) THEN
+          FAILED ("RESOLUTION INCORRECT - THE 'VAL' ATTRIBUTE " &
+                  "MUST RETURN A VALUE OF TYPE T - 6");
+     END IF;
+ 
+     RESULT;
+END C87B07B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07c.ada
new file mode 100644
index 000000000..851143a50
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07c.ada
@@ -0,0 +1,85 @@
+-- C87B07C.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- FOR THE ATTRIBUTE OF THE FORM T'VALUE (X), THE OPERAND X MUST 
+-- BE OF THE PREDEFINED TYPE STRING. THE RESULT IS OF TYPE T.
+  
+-- TRH  13 SEPT 82
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B07C IS
+ 
+     TYPE CHAR IS NEW CHARACTER;
+     TYPE LITS IS (' ', '+', '1');
+     TYPE WORD IS ARRAY (POSITIVE RANGE 1..4) OF CHARACTER;
+     TYPE LINE IS ARRAY (POSITIVE RANGE 1..4) OF CHAR;
+     TYPE LIST IS ARRAY (POSITIVE RANGE 1..4) OF LITS;
+     TYPE STR  IS ARRAY (POSITIVE RANGE 1..4) OF STRING (1 .. 1);
+     TYPE STR2 IS NEW STRING (1..4);
+     TYPE FLAG IS (PASS, FAIL);
+     SUBTYPE MY_STRING IS STRING (1..4);
+     
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : IN FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          IF STAT = FAIL THEN 
+               FAILED ("THE 'VALUE' ATTRIBUTE TAKES AN OPERAND" &
+                       " OF THE TYPE PREDEFINED STRING");
+          END IF;
+          RETURN ARG;
+     END F1;
+  
+     FUNCTION F IS NEW F1 (STR2,   " +1 ",               FAIL);
+     FUNCTION F IS NEW F1 (LIST,   " +1 ",               FAIL);
+     FUNCTION F IS NEW F1 (WORD,   (' ', '+', '1', ' '), FAIL);
+     FUNCTION F IS NEW F1 (STR,    (" ", "+", "1", " "), FAIL);
+     FUNCTION F IS NEW F1 (LINE,   (' ', '+', '1', ' '), FAIL);
+     FUNCTION F IS NEW F1 (MY_STRING, " +1 ",               PASS);
+    
+BEGIN
+     TEST ("C87B07C","OVERLOADED OPERANDS TO THE 'VALUE' ATTRIBUTE");
+    
+     DECLARE
+          TYPE INT IS NEW INTEGER;
+          FUNCTION "-" (X : INT) RETURN INT 
+               RENAMES "+";
+ 
+     BEGIN
+          IF INT'VALUE (F) /= -1 THEN
+               FAILED ("THE ATTRIBUTE T'VALUE MUST RETURN A VALUE" &
+                       " OF TYPE T");
+          END IF;
+     END;
+ 
+     RESULT;
+END C87B07C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07d.ada
new file mode 100644
index 000000000..0e93649d7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07d.ada
@@ -0,0 +1,59 @@
+-- C87B07D.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE ATTRIBUTES OF THE FORM T'SUCC (X) AND T'PRED (X) TAKE AN
+-- OPERAND X OF TYPE T AND RETURN A VALUE OF TYPE T.
+  
+-- TRH  15 SEPT 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B07D IS
+ 
+     TYPE NEW_INT IS NEW INTEGER;
+     TYPE WHOLE   IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+  
+     FUNCTION "+" (X, Y : WHOLE)   RETURN WHOLE 
+          RENAMES "*";
+     FUNCTION "+" (X, Y : NEW_INT) RETURN NEW_INT
+          RENAMES "-";
+    
+BEGIN
+     TEST ("C87B07D","OVERLOADED OPERANDS TO THE ATTRIBUTES " &
+           "'PRED' AND 'SUCC'");
+    
+     IF INTEGER'SUCC (1 + 1) /= 3  OR INTEGER'SUCC (3 + 3) + 1 /= 8  OR
+        NEW_INT'SUCC (1 + 1) /= 1  OR NEW_INT'SUCC (3 + 3) + 1 /= 0  OR
+        WHOLE'SUCC   (1 + 1) /= 2  OR WHOLE'SUCC   (3 + 3) + 1 /= 10 OR
+        INTEGER'PRED (1 + 1) /= 1  OR INTEGER'PRED (3 + 3) + 1 /= 6  OR
+        NEW_INT'PRED (1 + 1) /= -1 OR NEW_INT'PRED (3 + 3) + 1 /= -2 OR
+        WHOLE'PRED   (1 + 1) /= 0  OR WHOLE'PRED   (3 + 3) + 1 /= 8  
+        THEN FAILED ("RESOLUTION INCORRECT FOR OPERAND OR RESULT OF" &
+                     " THE 'PRED' OR 'SUCC' ATTRIBUTE");
+     END IF;
+     
+     RESULT;
+END C87B07D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07e.ada
new file mode 100644
index 000000000..83e5c906a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b07e.ada
@@ -0,0 +1,69 @@
+-- C87B07E.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- FOR THE ATTRIBUTE OF THE FORM T'IMAGE (X), THE OPERAND X MUST
+-- BE OF TYPE T. THE RESULT IS OF THE PREDEFINED TYPE STRING.
+  
+-- TRH  15 SEPT 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B07E IS
+ 
+     TYPE NEW_INT IS NEW INTEGER;
+     TYPE NUMBER  IS NEW INTEGER;
+     TYPE NEW_STR IS NEW STRING;
+  
+     FUNCTION "+" (X : NEW_INT) RETURN NEW_INT
+          RENAMES "-";
+     FUNCTION "-" (X : NUMBER)  RETURN NUMBER
+          RENAMES "+";
+ 
+     PROCEDURE P (X : NEW_STR) IS
+     BEGIN
+          FAILED ("THE IMAGE ATTRIBUTE MUST RETURN A VALUE OF THE" &
+                  " PREDEFINED TYPE STRING");
+     END P;
+ 
+     PROCEDURE P (X : STRING) IS
+     BEGIN
+          NULL;
+     END P;
+    
+BEGIN
+     TEST ("C87B07E","OVERLOADED OPERANDS TO THE IMAGE ATTRIBUTE");
+    
+     IF INTEGER'IMAGE (+12) & INTEGER'IMAGE (-12) &
+        NEW_INT'IMAGE (+12) & NEW_INT'IMAGE (-12) &
+        NUMBER'IMAGE  (+12) & NUMBER'IMAGE  (-12)  /=
+        " 12-12-12-12 12 12" THEN
+        FAILED ("RESOLUTION INCORRECT FOR THE 'IMAGE' ATTRIBUTE");
+     END IF;
+   
+     P (INTEGER'IMAGE (+1) & NEW_INT'IMAGE (+1) & NUMBER'IMAGE (-1));
+     
+     RESULT;
+END C87B07E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b08a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b08a.ada
new file mode 100644
index 000000000..b9998455e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b08a.ada
@@ -0,0 +1,72 @@
+-- C87B08A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- FOR EACH REAL TYPE, THERE EXISTS AN IMPLICIT CONVERSION THAT
+-- CONVERTS A UNIVERSAL REAL VALUE INTO THE CORRESPONDING VALUE 
+-- OF THE REAL TYPE. THIS TEST USES LITERALS AS UNIVERSAL REAL
+-- VALUES.
+  
+-- TRH  16 AUG 82
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B08A IS
+ 
+     TYPE FIXED IS DELTA 0.1 RANGE -2.0 .. 2.0;
+     TYPE FLT   IS DIGITS  2 RANGE -2.0 .. 2.0;
+     TYPE FLAG  IS (PASS, FAIL);
+ 
+     GENERIC
+          TYPE T IS PRIVATE;
+          STAT : IN FLAG;
+     PROCEDURE P1 (X : T);
+  
+     PROCEDURE P1 (X : T) IS
+     BEGIN
+          IF STAT = FAIL THEN
+               FAILED ("INCORRECT IMPLICIT CONVERSION FROM UNIVERSAL" &
+                       " REAL VALUES TO REAL TYPE VALUES");
+          END IF;
+     END P1;
+ 
+     PROCEDURE P IS NEW P1 (INTEGER,   FAIL);
+     PROCEDURE P IS NEW P1 (FLT,       PASS);
+     PROCEDURE Q IS NEW P1 (FIXED,     PASS);
+     PROCEDURE Q IS NEW P1 (BOOLEAN,   FAIL);
+     PROCEDURE Q IS NEW P1 (CHARACTER, FAIL);
+ 
+BEGIN
+     TEST ("C87B08A","IMPLICIT CONVERSION OF UNIVERSAL REAL " &
+           "VALUES TO REAL VALUES EXISTS FOR ANY REAL TYPE");
+    
+     P (0.0);
+     P (1.0 + 1.0);
+     Q (1.0);
+     Q (1.0 - 1.0);
+ 
+     RESULT;
+END C87B08A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b09a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b09a.ada
new file mode 100644
index 000000000..bcdcad642
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b09a.ada
@@ -0,0 +1,55 @@
+-- C87B09A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN A FLOATING POINT TYPE DEFINITION, THE DIGITS EXPRESSION MUST 
+-- BE OF SOME INTEGER TYPE.
+  
+-- TRH  30 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B09A IS
+     
+     FUNCTION "+" (X : INTEGER) RETURN FLOAT IS
+     BEGIN 
+           FAILED ("DIGITS EXPRESSION MUST BE OF AN INTEGER TYPE");
+           RETURN 2.0;
+     END "+";
+
+BEGIN
+     TEST ("C87B09A","OVERLOADED DIGITS EXPRESSIONS IN " &
+           "FLOATING POINT TYPE DEFINITIONS");
+   
+     DECLARE
+          TYPE EXACT IS DIGITS "+" (3);
+          TYPE CLOSE IS DIGITS "+" (1) RANGE -1.0 .. 1.0;
+  
+     BEGIN
+          NULL;
+     END;
+    
+     RESULT;
+END C87B09A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b09c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b09c.ada
new file mode 100644
index 000000000..4a7ce12cd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b09c.ada
@@ -0,0 +1,64 @@
+-- C87B09C.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN A FLOATING POINT TYPE DEFINITION, THE DIGITS EXPRESSION MUST
+-- BE OF SOME INTEGRAL TYPE. SIMILARLY, THE DELTA EXPRESSION IN A
+-- FIXED POINT TYPE DEFINITION MUST BE OF SOME REAL TYPE.
+  
+-- TRH  30 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B09C IS
+     
+     FUNCTION "+" (X : INTEGER) RETURN FLOAT IS
+     BEGIN 
+           FAILED ("DIGITS EXPRESSION MUST BE OF AN INTEGRAL TYPE");
+           RETURN 2.0;
+     END "+";
+
+     FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
+     BEGIN 
+           FAILED ("DELTA EXPRESSION MUST BE OF A REAL TYPE");
+           RETURN 2;
+     END "+";
+  
+BEGIN
+     TEST ("C87B09C","OVERLOADED DIGITS/DELTA EXPRESSIONS IN " &
+           "REAL TYPE DEFINITIONS");
+   
+     DECLARE
+          TYPE EXACT IS DIGITS "+" (4);
+          TYPE CENTI IS DELTA  "+" (0.01) RANGE -2.0 .. 2.0;
+          TYPE CLOSE IS DIGITS "+" (2)    RANGE -1.0 .. 1.0;
+          TYPE DECI  IS DELTA  "+" (0.1)  RANGE -1.0 .. 1.0;
+  
+     BEGIN
+          NULL;
+     END;
+    
+     RESULT;
+END C87B09C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b10a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b10a.ada
new file mode 100644
index 000000000..a09db6052
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b10a.ada
@@ -0,0 +1,75 @@
+-- C87B10A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN A RANGE CONSTRAINT OF A FIXED POINT OR FLOATING POINT TYPE
+-- DEFINITION, BOTH BOUNDS MUST BE OF SOME REAL TYPE, ALTHOUGH
+-- THE TWO BOUNDS DO NOT HAVE TO BE OF THE SAME TYPE.
+  
+-- TRH 7/28/82
+-- DSJ 6/10/83
+-- JBG 9/19/84
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B10A IS
+
+     SUBTYPE DUR IS DURATION;
+
+     FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
+     BEGIN
+          FAILED ("RANGE CONSTRAINT FOR REAL TYPE DEFINITIONS " &
+                  "MUST HAVE REAL BOUNDS");
+          RETURN -10;
+     END "+";
+
+     FUNCTION "+" (X, Y : FLOAT) RETURN INTEGER IS
+     BEGIN 
+          FAILED ("RANGE CONSTRAINT FOR REAL TYPE DEFINITIONS " &
+                  "MUST HAVE REAL BOUNDS");
+          RETURN -10;
+     END "+";
+  
+BEGIN
+     TEST ("C87B10A","RANGE BOUNDS IN REAL TYPE DEFINITIONS MUST BE" &
+           " OF SOME (NOT NECESSARILY THE SAME) REAL TYPE");
+   
+     DECLARE
+          TYPE R1 IS DIGITS  2 RANGE 0.0 .. 1.0 + FLOAT'(1.0);
+          TYPE R2 IS DELTA 0.1 RANGE FLOAT'(1.0) + 1.0 .. DUR'(2.0);
+          TYPE R3 IS DIGITS  2 RANGE +1.0 .. "+" (FLOAT'(2.0), 2.0);
+          TYPE R4 IS DELTA 0.1 RANGE 0.0 + FLOAT'(0.0) .. +1.0;
+ 
+  
+     BEGIN
+          IF 2.0 NOT IN R1 OR -1.0 IN R2 OR
+               -1.0 IN R3 OR -0.9 IN R4 THEN
+               FAILED ("RANGE BOUNDS IN REAL TYPE DEFINITIONS DO NOT "
+                    & "HAVE TO BE OF THE SAME REAL TYPE");
+          END IF;
+     END;
+    
+     RESULT;
+END C87B10A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b11a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b11a.ada
new file mode 100644
index 000000000..07a373723
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b11a.ada
@@ -0,0 +1,55 @@
+-- C87B11A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN A FIXED POINT TYPE DEFINITION, THE DELTA EXPRESSION MUST
+-- BE OF SOME REAL TYPE.
+  
+-- TRH  30 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B11A IS
+     
+     FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
+     BEGIN 
+           FAILED ("DELTA EXPRESSION MUST BE OF A REAL TYPE");
+           RETURN 2;
+     END "+";
+  
+BEGIN
+     TEST ("C87B11A","OVERLOADED DELTA EXPRESSIONS IN " &
+           "FIXED POINT TYPE DEFINITIONS");
+   
+     DECLARE
+          TYPE SEMI IS DELTA "+" (0.5) RANGE -2.0 .. 2.0;
+          TYPE DECI IS DELTA "+" (0.1) RANGE -1.0 .. 1.0;
+  
+     BEGIN
+          NULL;
+     END;
+    
+     RESULT;
+END C87B11A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b11b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b11b.ada
new file mode 100644
index 000000000..654603aff
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b11b.ada
@@ -0,0 +1,57 @@
+-- C87B11B.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN A SUBTYPE INDICATION, THE DELTA EXPRESSION FOR A FIXED POINT
+-- NUMBER MUST BE OF SOME REAL TYPE. 
+  
+-- TRH  29 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B11B IS
+  
+     TYPE DELT3 IS DELTA 3.0 RANGE -30.0 .. 30.0;
+     
+     FUNCTION "+" (X : FLOAT) RETURN INTEGER IS
+     BEGIN 
+           FAILED ("DELTA EXPRESSION MUST BE OF A REAL TYPE");
+           RETURN 2;
+     END "+";
+  
+BEGIN
+     TEST ("C87B11B","OVERLOADED DELTA EXPRESSIONS IN " &
+           "FIXED POINT SUBTYPE INDICATIONS");
+   
+     DECLARE
+          SUBTYPE DELT2 IS DELT3 DELTA "+"(6.0);
+          SUBTYPE DELT1 IS DELT3 DELTA "+"(10.0) RANGE -10.0 .. 10.0;
+  
+     BEGIN
+          NULL;
+     END;
+    
+     RESULT;
+END C87B11B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b13a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b13a.ada
new file mode 100644
index 000000000..c46b6f093
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b13a.ada
@@ -0,0 +1,71 @@
+-- C87B13A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE LOWER AND UPPER BOUNDS OF AN INDEX CONSTRAINT IN A CONSTRAINED
+-- ARRAY TYPE DEFINITION MUST BE DISCRETE AND OF THE SAME TYPE.
+  
+-- TRH  1 JULY 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B13A IS
+     
+     TYPE CENTI IS DELTA 0.01 RANGE -1.0 .. 1.0;
+   
+     FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
+     BEGIN 
+          RETURN X;
+     END F1;
+
+     FUNCTION F1 (X : INTEGER) RETURN CENTI IS
+     BEGIN 
+          FAILED ("INDEX CONSTRAINT BOUNDS MUST BE DISCRETE AND " &
+                  " OF THE SAME TYPE");
+          RETURN 0.0;
+     END F1;
+  
+     FUNCTION F1 (X : INTEGER) RETURN FLOAT IS
+     BEGIN 
+          FAILED ("INDEX CONSTRAINT BOUNDS MUST BE DISCRETE AND " &
+                  " OF THE SAME TYPE");
+          RETURN 1.0;
+     END F1;
+  
+BEGIN
+     TEST ("C87B13A","OVERLOADED INDEX CONSTRAINTS IN " &
+           "CONSTRAINED ARRAY TYPE DEFINITIONS");
+   
+     DECLARE
+          TYPE A1 IS ARRAY (F1 (1) .. F1 (1)) OF BOOLEAN;
+          TYPE A2 IS ARRAY (1      .. F1 (2)) OF BOOLEAN;
+          TYPE A3 IS ARRAY (F1 (1) ..     2)  OF BOOLEAN;
+  
+     BEGIN
+          NULL;
+     END;
+    
+     RESULT;
+END C87B13A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14a.ada
new file mode 100644
index 000000000..1ef05163e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14a.ada
@@ -0,0 +1,87 @@
+-- C87B14A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, THE LOWER AND UPPER
+-- BOUNDS MUST BE OF THE INDEX BASE TYPE.
+--
+-- TEST (A): INDEX CONSTRAINTS WITH OVERLOADED FUNCTIONS.
+  
+-- TRH  30 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B14A IS
+     
+     SUBTYPE WHOLE  IS INTEGER RANGE 0 .. INTEGER'LAST;
+     SUBTYPE BASE10 IS INTEGER RANGE 0 .. 9;
+     TYPE LIST IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+     TYPE GRID IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF BOOLEAN;
+   
+     FUNCTION F1 RETURN WHOLE IS
+     BEGIN 
+          RETURN 1;
+     END F1;
+
+     FUNCTION F1 RETURN BOOLEAN IS
+     BEGIN 
+          FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                  " IN SUBTYPE INDICATIONS");
+          RETURN TRUE;
+     END F1;
+  
+     FUNCTION F2 RETURN BASE10 IS
+     BEGIN 
+          RETURN 2;
+     END F2;
+
+     FUNCTION F2 RETURN FLOAT IS
+     BEGIN 
+          FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                  " IN SUBTYPE INDICATIONS");
+          RETURN 2.0;
+     END F2;
+  
+BEGIN
+     TEST ("C87B14A","OVERLOADED EXPRESSIONS IN INDEX CONSTRAINTS " &
+           "OF SUBTYPE INDICATIONS");
+   
+     DECLARE
+          SUBTYPE LIST1 IS LIST (1  .. F1);
+          SUBTYPE LIST2 IS LIST (F1 ..  1);
+          SUBTYPE LIST3 IS LIST (F2 .. F2);
+          SUBTYPE LIST4 IS LIST (F1 .. F2);
+   
+          SUBTYPE GRID1 IS GRID (1  .. F1, F1 ..  1);
+          SUBTYPE GRID2 IS GRID (F1 ..  2, 2  .. F2);
+          SUBTYPE GRID3 IS GRID (F1 .. F1, F2 .. F2);
+          SUBTYPE GRID4 IS GRID (F1 .. F2, 1  ..  2);
+  
+     BEGIN
+          NULL;
+     END;
+    
+     RESULT;
+END C87B14A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14b.ada
new file mode 100644
index 000000000..2d6a512fc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14b.ada
@@ -0,0 +1,90 @@
+-- C87B14B.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, THE LOWER AND UPPER
+-- BOUNDS MUST BE OF THE INDEX BASE TYPE.
+--
+-- TEST (B): INDEX CONSTRAINTS WITH OVERLOADED OPERATOR SYMBOLS.
+  
+-- TRH  30 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B14B IS
+     
+     SUBTYPE CHAR IS CHARACTER;
+     SUBTYPE VAR  IS CHAR RANGE 'X' .. 'Z';
+     SUBTYPE NOTE IS CHAR RANGE 'A' .. 'G';
+     TYPE LIST IS ARRAY (CHAR RANGE <>) OF CHAR;
+     TYPE GRID IS ARRAY (CHAR RANGE <>, CHAR RANGE <>) OF CHAR;
+   
+     FUNCTION "*" (X, Y : INTEGER) RETURN VAR IS
+     BEGIN 
+          RETURN 'X';
+     END "*";
+
+     FUNCTION "*" (X, Y : INTEGER) RETURN BOOLEAN IS
+     BEGIN 
+          FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                  " IN SUBTYPE INDICATIONS");
+          RETURN TRUE;
+     END "*";
+  
+     FUNCTION "+" (X, Y : INTEGER) RETURN NOTE IS
+     BEGIN 
+          RETURN 'A';
+     END "+";
+
+     FUNCTION "+" (X, Y : INTEGER) RETURN FLOAT IS
+     BEGIN 
+          FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                  " IN SUBTYPE INDICATIONS");
+          RETURN 2.0;
+     END "+";
+  
+BEGIN
+     TEST ("C87B14B","OVERLOADED OPERATOR SYMBOLS IN INDEX " &
+           "CONSTRAINTS OF SUBTYPE INDICATIONS");
+   
+     DECLARE
+
+          SUBTYPE LIST1 IS LIST ('W' .. "*" (0, 0));
+          SUBTYPE LIST2 IS LIST ("+" (0, 0) .. 'C');
+          SUBTYPE LIST3 IS LIST ("+" (0, 0) .. "*" (0, 0));
+          SUBTYPE LIST4 IS LIST ("*" (0, 0) .. "*" (0, 0));
+   
+          SUBTYPE GRID1 IS GRID ('V' .. "*" (0, 0), "*" (0, 0) .. 'Y');
+          SUBTYPE GRID2 IS GRID ("*" (0, 0) .. 'W', 'H' .. "+" (0, 0));
+          SUBTYPE GRID3 IS GRID
+              ("*" (0, 0) .. "*" (0, 0), "+" (0, 0) .. "+" (0, 0));
+          SUBTYPE GRID4 IS GRID ("+" (0, 0) .. "*" (0, 0),'L' .. 'N');
+  
+     BEGIN
+          NULL;
+     END;
+    
+     RESULT;
+END C87B14B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14c.ada
new file mode 100644
index 000000000..9bdb041c9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14c.ada
@@ -0,0 +1,89 @@
+-- C87B14C.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, THE LOWER AND UPPER
+-- BOUNDS MUST BE OF THE INDEX BASE TYPE.
+--
+-- TEST (C): INDEX CONSTRAINTS WITH OVERLOADED INFIX OPERATORS.
+  
+-- TRH  30 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B14C IS
+     
+     TYPE DAY  IS (MON, TUE, WED, THU, FRI, SAT, SUN);
+     TYPE LIST IS ARRAY (DAY RANGE <>) OF BOOLEAN;
+     TYPE GRID IS ARRAY (DAY RANGE <>, DAY RANGE <>) OF BOOLEAN;
+     SUBTYPE WEEKEND IS DAY RANGE SAT .. SUN;
+     SUBTYPE WEEKDAY IS DAY RANGE MON .. FRI;
+   
+     FUNCTION "*" (X, Y : INTEGER) RETURN WEEKDAY IS
+     BEGIN 
+          RETURN MON;
+     END "*";
+
+     FUNCTION "*" (X, Y : INTEGER) RETURN BOOLEAN IS
+     BEGIN 
+          FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                  " IN SUBTYPE INDICATIONS");
+          RETURN TRUE;
+     END "*";
+  
+     FUNCTION "+" (X, Y : INTEGER) RETURN WEEKEND IS
+     BEGIN 
+          RETURN SAT;
+     END "+";
+
+     FUNCTION "+" (X, Y : INTEGER) RETURN FLOAT IS
+     BEGIN 
+          FAILED ("RESOLUTION INCORRECT - INDEX CONSTRAINTS " &
+                  " IN SUBTYPE INDICATIONS");
+          RETURN 2.0;
+     END "+";
+  
+BEGIN
+     TEST ("C87B14C","OVERLOADED EXPRESSIONS IN INDEX CONSTRAINTS " &  
+           "OF SUBTYPE INDICATIONS");
+   
+     DECLARE
+          SUBTYPE LIST1 IS LIST (WED .. (0 + 0));
+          SUBTYPE LIST2 IS LIST ( 0 * 0 .. TUE);
+          SUBTYPE LIST3 IS LIST ((0 + 0) .. (0 + 0));
+          SUBTYPE LIST4 IS LIST ((0 * 0) .. (0 + 0));
+   
+          SUBTYPE GRID1 IS GRID (MON .. (0 * 0), (0 * 0) .. TUE);
+          SUBTYPE GRID2 IS GRID ((0 * 0) .. WED, FRI .. (0 + 0));
+          SUBTYPE GRID3 IS GRID
+              ((0 * 0) .. (0 * 0), (0 + 0) .. (0 + 0));
+          SUBTYPE GRID4 IS GRID ((0 * 0) .. (0 + 0), TUE .. THU);
+  
+     BEGIN
+          NULL;
+     END;
+    
+     RESULT;
+END C87B14C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14d.ada
new file mode 100644
index 000000000..cf1c4d3df
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b14d.ada
@@ -0,0 +1,63 @@
+-- C87B14D.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN SUBTYPE INDICATIONS WITH INDEX CONSTRAINTS, IF A BOUND IS OF
+-- TYPE UNIVERSAL_INTEGER, IT IS IMPLICITLY CONVERTED TO THE
+-- INDEX BASE TYPE.
+  
+-- TRH  7 JULY 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B14D IS
+     
+     TYPE WHOLE IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+     TYPE LIST  IS ARRAY (WHOLE RANGE <>) OF BOOLEAN;
+  
+BEGIN
+     TEST ("C87B14D","OVERLOADED EXPRESSIONS IN INDEX CONSTRAINTS " &
+           "OF SUBTYPE INDICATIONS WITH UNIVERSAL_INTEGER BOUNDS");
+   
+     DECLARE
+          FUNCTION "+" (X, Y : WHOLE) RETURN WHOLE 
+               RENAMES "*";
+   
+          SUBTYPE LIST1 IS LIST (1 + 1 .. 1 + 1);
+          SUBTYPE LIST2 IS LIST (1     .. 3 + 3);
+          SUBTYPE LIST3 IS LIST (1 + 1 ..     2);
+  
+     BEGIN
+          IF LIST1'FIRST /= 1 OR LIST1'LAST /= 1 OR
+             LIST2'FIRST /= 1 OR LIST2'LAST /= 9 OR
+             LIST3'FIRST /= 1 OR LIST3'LAST /= 2 THEN 
+             FAILED ("RESOLUTION INCORRECT - IMPLICIT CONVERSION " &
+                     "OF UNIVERSAL_INTEGER TYPE TO INDEX CONSTRAINT " &
+                     "BASE TYPE");
+          END IF;
+     END;
+    
+     RESULT;
+END C87B14D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b15a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b15a.ada
new file mode 100644
index 000000000..92a14de89
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b15a.ada
@@ -0,0 +1,108 @@
+-- C87B15A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE ARRAY ATTRIBUTES OF THE FORM: A'FIRST (N), A'LAST (N), 
+-- A'RANGE (N) AND A'LENGTH (N) MUST HAVE A PARAMETER (N) WHICH IS OF
+-- THE TYPE UNIVERSAL_INTEGER.
+  
+-- TRH  26 JULY 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B15A IS
+ 
+     FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
+          RENAMES STANDARD."*";
+ 
+     TYPE BOX IS ARRAY (0 .. 1, 3 .. 6, 5 .. 11) OF BOOLEAN;
+     B1 : BOX;
+ 
+BEGIN
+     TEST ("C87B15A","ARRAY ATTRIBUTES: FIRST (N), LAST (N), RANGE " &
+           "(N) AND LENGTH (N) TAKE UNIVERSAL_INTEGER OPERANDS");
+ 
+     IF BOX'FIRST  (1 + 0) /= 0    THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 1");
+     END IF;
+
+     IF B1'FIRST   (1 + 1) /= 3    THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 2");
+     END IF;
+
+     IF B1'FIRST   (2 + 1) /= 5    THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 3");
+     END IF;
+
+     IF BOX'LAST   (0 + 1) /= 1    THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 4");
+     END IF;
+
+     IF B1'LAST    (1 + 1) /= 6    THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 5");
+     END IF;
+
+     IF B1'LAST    (1 + 2) /= 11   THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 6");
+     END IF;
+
+     IF BOX'LENGTH (0 + 1) /= 2    THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 7");
+     END IF;
+
+     IF B1'LENGTH  (1 + 1) /= 4    THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 8");
+     END IF;
+
+     IF B1'LENGTH  (2 + 1) /= 7    THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 9");
+     END IF;
+
+     IF 1 NOT IN BOX'RANGE (0 + 1) THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 10");
+     END IF;
+
+     IF 4 NOT IN B1'RANGE  (1 + 1) THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 11");
+     END IF;
+
+     IF 9 NOT IN B1'RANGE  (2 + 1) THEN
+          FAILED ("ARRAY ATTRIBUTE OPERAND MUST BE OF TYPE " &
+                  "UNIVERSAL_INTEGER - 12");
+     END IF;
+
+     RESULT;
+END C87B15A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b16a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b16a.ada
new file mode 100644
index 000000000..307ca0e05
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b16a.ada
@@ -0,0 +1,129 @@
+-- C87B16A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- FOR A DEFAULT RECORD COMPONENT, THE TYPE OF THE INITIALIZATION
+-- EXPRESSION MUST MATCH THE COMPONENTS'S EXPLICIT TYPEMARK.
+--      
+-- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+-- 
+--    (A): A CALL TO AN OVERLOADED FUNCTION.
+--    (B): AN OVERLOADED OPERATOR SYMBOL.
+--    (C): AN OVERLOADED (INFIX) OPERATOR.
+--    (D): AN OVERLOADED ENUMERATION LITERAL.
+  
+-- TRH  23 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B16A IS
+  
+     TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+     TYPE CITRUS IS (LEMON, LIME, ORANGE);
+     TYPE HUE    IS (RED, ORANGE, YELLOW);
+     
+     FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN -1;
+     END F1;
+
+     FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+     BEGIN
+          RETURN 0;
+     END F1;
+    
+     FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+
+     FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+   
+BEGIN
+     TEST ("C87B16A","OVERLOADED INITIALIZATION EXPRESSIONS" &
+           " IN DEFAULT RECORD COMPONENTS");
+     DECLARE
+
+          FUNCTION "-" (X, Y : INTEGER) RETURN INTEGER
+               RENAMES F1;
+    
+          FUNCTION "-" (X, Y : WHOLE)   RETURN WHOLE
+               RENAMES F1;
+     
+          FUNCTION "-" (X, Y : INTEGER) RETURN HUE
+               RENAMES F1;
+   
+          FUNCTION "-" (X, Y : INTEGER) RETURN CITRUS
+               RENAMES F1;
+      
+          TYPE REC IS
+               RECORD
+                    I1 : INTEGER := F1  (0, 0);
+                    W1 : WHOLE   := F1  (0, 0);
+                    C1 : CITRUS  := F1  (0, 0);
+                    H1 : HUE     := F1  (0, 0);
+   
+                    I2 : INTEGER := "-" (0, 0);
+                    W2 : WHOLE   := "-" (0, 0);
+                    C2 : CITRUS  := "-" (0, 0);
+                    H2 : HUE     := "-" (0, 0);
+      
+                    I3 : INTEGER := (0 - 0);
+                    W3 : WHOLE   := (0 - 0);
+                    C3 : CITRUS  := (0 - 0);
+                    H3 : HUE     := (0 - 0);
+      
+                    C4 : CITRUS  := ORANGE;
+                    H4 : HUE     := ORANGE;
+               END RECORD;
+
+          R1 : REC;
+  
+     BEGIN
+          IF R1.I1              /= -1 OR R1.W1           /= 0 OR
+             CITRUS'POS (R1.C1) /=  2 OR HUE'POS (R1.H1) /= 1 THEN
+             FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+          END IF;
+    
+          IF R1.I2              /= -1 OR R1.W2           /= 0 OR
+             CITRUS'POS (R1.C2) /=  2 OR HUE'POS (R1.H2) /= 1 THEN
+             FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
+          END IF;
+    
+          IF R1.I3              /= -1 OR R1.W3           /= 0 OR
+             CITRUS'POS (R1.C3) /=  2 OR HUE'POS (R1.H3) /= 1 THEN
+             FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+          END IF;
+    
+          IF CITRUS'POS (R1.C4) /=  2 OR HUE'POS (R1.H4) /= 1 THEN
+             FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
+          END IF;
+     END;
+    
+     RESULT;
+END C87B16A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b17a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b17a.ada
new file mode 100644
index 000000000..96405d631
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b17a.ada
@@ -0,0 +1,130 @@
+-- C87B17A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+  
+-- THE INITIALIZATION EXPRESSION FOR A DEFAULT DISCRIMINANT
+-- IN A TYPE DECLARATION MUST MATCH THE DISCRIMINANT'S EXPLICIT
+-- TYPEMARK.
+--
+-- THE THREE KINDS OF TYPE DECLARATIONS TESTED HERE ARE:
+--
+--    (A): RECORD TYPE.
+--    (B): PRIVATE TYPE.
+--    (C): INCOMPLETE RECORD TYPE.
+    
+-- TRH  18 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B17A IS
+  
+     TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+     TYPE CITRUS IS (LEMON, LIME, ORANGE);
+     TYPE HUE    IS (RED, ORANGE, YELLOW);
+   
+     FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN -1;
+     END F1;
+
+     FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+     BEGIN
+          RETURN 0;
+     END F1;
+    
+     FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+
+     FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+   
+BEGIN
+     TEST ("C87B17A","OVERLOADED INITIALIZATION EXPRESSIONS" &
+           " IN DEFAULT DISCRIMINANTS");
+   
+     DECLARE
+
+          FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
+               RENAMES F1;
+    
+          FUNCTION "+" (X, Y : WHOLE)   RETURN WHOLE
+               RENAMES F1;
+     
+          FUNCTION "+" (X, Y : INTEGER) RETURN HUE
+               RENAMES F1;
+   
+          FUNCTION "+" (X, Y : INTEGER) RETURN CITRUS
+               RENAMES F1;
+
+          TYPE REC1 (I1 : INTEGER := 0 + 0; H1 : HUE := F1 (0, 0) ) IS
+               RECORD
+                    NULL;
+               END RECORD;
+    
+          PACKAGE PVT IS 
+               TYPE REC2 (H2 : HUE := ORANGE; W2 : WHOLE := 0 + 0 )
+                    IS PRIVATE;
+          PRIVATE
+               TYPE REC2 (H2 : HUE := ORANGE; W2 : WHOLE := 0 + 0 ) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+          END PVT;
+          USE PVT;
+  
+          TYPE REC3 (C1 : CITRUS := ORANGE; W1 : WHOLE := "+" (0, 0));
+  
+          TYPE LINK IS ACCESS REC3;
+   
+          TYPE REC3 (C1 : CITRUS := ORANGE; W1 : WHOLE := "+" (0, 0)) IS
+               RECORD
+                    NULL;
+               END RECORD;
+   
+          R1 : REC1;
+          R2 : REC2;
+          R3 : REC3;
+   
+     BEGIN
+          IF R1.I1 /= -1 OR HUE'POS (R1.H1) /= 1 THEN 
+             FAILED ("(A): RESOLUTION INCORRECT FOR RECORD TYPES");
+          END IF;
+   
+          IF HUE'POS (R2.H2) /=  1 OR R2.W2 /= 0 THEN
+             FAILED ("(B): RESOLUTION INCORRECT FOR PRIVATE TYPES");
+          END IF;
+  
+          IF CITRUS'POS (R3.C1) /= 2 OR R3.W1 /= 0 THEN
+             FAILED ("(C): RESOLUTION INCORRECT FOR INCOMPLETE" &
+                     " RECORD TYPES");
+          END IF;
+     END;
+    
+     RESULT;
+END C87B17A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b18a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b18a.ada
new file mode 100644
index 000000000..fdb2ad352
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b18a.ada
@@ -0,0 +1,82 @@
+-- C87B18A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE TYPES OF THE EXPRESSIONS IN A DISCRIMINANT CONSTRAINT IN
+-- A SUBTYPE INDICATION MUST MATCH THE DISCRIMINANT'S EXPLICIT
+-- TYPEMARK.
+  
+-- TRH  1 JULY 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B18A IS
+     
+     ERR : BOOLEAN := FALSE;
+ 
+     FUNCTION F1 RETURN INTEGER IS
+     BEGIN 
+          RETURN 1;
+     END F1;
+
+     FUNCTION F1 RETURN FLOAT IS
+     BEGIN 
+          ERR := TRUE;
+          RETURN 0.0;
+     END F1;
+ 
+     FUNCTION F2 RETURN BOOLEAN IS
+     BEGIN
+          RETURN TRUE;
+     END F2;
+
+     FUNCTION F2 RETURN STRING IS
+     BEGIN 
+          ERR := TRUE;
+          RETURN "STRING";
+     END F2;
+  
+BEGIN
+     TEST ("C87B18A","OVERLOADED EXPRESSIONS IN DISCRIMINANT " &
+           "CONSTRAINTS");
+   
+     DECLARE
+          TYPE REC (X : INTEGER := 0; Y : BOOLEAN := TRUE) IS
+               RECORD
+                    NULL;
+               END RECORD;
+ 
+          R1 : REC (F1, F2);
+          R2 : REC (Y => F2, X => F1);
+
+     BEGIN
+          IF ERR THEN 
+               FAILED ("RESOLUTION INCORRECT - DISCRIMINANT " &
+                       "CONSTRAINT MUST MATCH DISCRIMINANT TYPE");
+          END IF;
+     END;
+    
+     RESULT;
+END C87B18A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b18b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b18b.ada
new file mode 100644
index 000000000..f0824b94b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b18b.ada
@@ -0,0 +1,83 @@
+-- C87B18B.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE EXPRESSION IN A NAMED OR POSITIONAL DISCRIMINANT ASSOCIATION
+-- MUST MATCH THE TYPE OF THE CORRESPONDING DISCRIMINANT.
+  
+-- TRH  9 AUG 82
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B18B IS
+ 
+     TYPE REC (W, X : CHARACTER; Y, Z : BOOLEAN) IS
+          RECORD
+               NULL;
+          END RECORD;
+ 
+     TYPE FLAG IS (PASS, FAIL);
+     
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : IN FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          IF STAT = FAIL THEN 
+               FAILED ("DISCRIMINANT ASSOCIATION EXPRESSION MUST " &
+                       "MATCH THE TYPE OF THE CORRESPONDING " &
+                       "DISCRIMINANT");
+          END IF;
+          RETURN ARG;
+     END F1;
+  
+     FUNCTION F IS NEW F1 (FLOAT,     2.0, FAIL);
+     FUNCTION F IS NEW F1 (INTEGER,     5, FAIL);
+     FUNCTION F IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+     FUNCTION F IS NEW F1 (CHARACTER, 'E', PASS);
+ 
+     FUNCTION G IS NEW F1 (FLOAT,     2.0, FAIL);
+     FUNCTION G IS NEW F1 (INTEGER,     5, FAIL);
+     FUNCTION G IS NEW F1 (BOOLEAN,  TRUE, PASS);
+     FUNCTION G IS NEW F1 (CHARACTER, 'E', FAIL);
+    
+BEGIN
+     TEST ("C87B18B","OVERLOADED DISCRIMINANT ASSOCIATIONS");
+    
+     DECLARE
+          SUBTYPE R1 IS REC (F, F, G, G);
+          SUBTYPE R2 IS REC (X => F, Y => G, Z => G, W => F);
+          SUBTYPE R3 IS REC (F, F, Z => G, Y => G);
+   
+     BEGIN
+          NULL;
+     END;
+ 
+     RESULT;
+END C87B18B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b19a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b19a.ada
new file mode 100644
index 000000000..aa1960d19
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b19a.ada
@@ -0,0 +1,110 @@
+-- C87B19A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+--     SIMPLE EXPRESSIONS AND RANGE BOUNDS OF VARIANT CHOICES MUST MATCH
+--     THE TYPE OF THE DISCRIMINANT'S EXPLICIT TYPEMARK.
+
+--HISTORY:
+--     DSJ 06/15/83 CREATED ORIGINAL TEST.
+--     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C87B19A IS
+
+     TYPE COLOR  IS (YELLOW, RED, BLUE, GREEN, BROWN);
+     TYPE SCHOOL IS (YALE, HARVARD, PRINCETON, BROWN, STANFORD);
+     TYPE COOK   IS (BROIL, BAKE, BROWN, TOAST, FRY);
+     TYPE MIXED  IS (GREEN, BROWN, YALE, BAKE, BLUE, FRY);
+
+     RATING : INTEGER := 0;
+
+     FUNCTION OK RETURN BOOLEAN IS
+     BEGIN
+          RATING := RATING + 1;
+          RETURN FALSE;
+     END OK;
+
+     FUNCTION ERR RETURN BOOLEAN IS
+     BEGIN
+          FAILED ("VARIANT CHOICES MUST MATCH TYPE OF DISCRIMINANT");
+          RETURN FALSE;
+     END ERR;
+
+BEGIN
+     TEST ("C87B19A","OVERLOADED EXPRESSIONS AND RANGE BOUNDS" &
+           " OF VARIANT CHOICES");
+     DECLARE
+
+          TYPE REC (X : MIXED := BROWN) IS
+               RECORD
+                    CASE X IS
+                         WHEN GREEN .. BROWN  => NULL;
+                         WHEN BLUE            => NULL;
+                         WHEN FRY             => NULL;
+                         WHEN YALE            => NULL;
+                         WHEN OTHERS          => NULL;
+                    END CASE;
+               END RECORD;
+
+          R1 : REC (X => FRY);
+          R2 : REC (X => BLUE);
+          R3 : REC (X => BAKE);
+          R4 : REC (X => YALE);
+          R5 : REC (X => BROWN);
+          R6 : REC (X => GREEN);
+
+     BEGIN
+          IF MIXED'POS(R1.X) /= 5 THEN
+             FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                     "DISCRIMINANT-R1");
+          END IF;
+          IF MIXED'POS(R2.X) /= 4 THEN
+             FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                     "DISCRIMINANT-R2");
+          END IF;
+          IF MIXED'POS(R3.X) /= 3 THEN
+             FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                     "DISCRIMINANT-R3");
+          END IF;
+          IF MIXED'POS(R4.X) /= 2 THEN
+             FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                     "DISCRIMINANT-R4");
+          END IF;
+          IF MIXED'POS(R5.X) /= 1 THEN
+             FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                     "DISCRIMINANT-R5");
+          END IF;
+          IF MIXED'POS(R6.X) /= 0 THEN
+             FAILED ("VARIANT CHOICES MUST MATCH TYPE OF " &
+                     "DISCRIMINANT-R6");
+          END IF;
+
+     END;
+
+     RESULT;
+END C87B19A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b23a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b23a.ada
new file mode 100644
index 000000000..5cfa1d825
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b23a.ada
@@ -0,0 +1,100 @@
+-- C87B23A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- FOR AN INDEXED COMPONENT OF AN ARRAY, THE PREFIX MUST BE 
+-- APPROPRIATE FOR AN ARRAY TYPE. EACH EXPRESSION FOR THE INDEXED 
+-- COMPONENT MUST BE OF THE TYPE OF THE CORRESPONDING INDEX AND
+-- THERE MUST BE ONE SUCH EXPRESSION FOR EACH INDEX POSITION OF THE 
+-- ARRAY TYPE.
+  
+-- TRH  15 SEPT 82
+-- DSJ  07 JUNE 83
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B23A IS
+
+     SUBTYPE CHAR IS CHARACTER;
+     TYPE GRADE IS (A, B, C, D, F);
+     TYPE NOTE  IS (A, B, C, D, E, F, G);
+     TYPE INT   IS NEW INTEGER;
+     TYPE POS   IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
+     TYPE NAT   IS NEW POS;
+     TYPE BOOL  IS NEW BOOLEAN;
+     TYPE BIT   IS NEW BOOL;
+     TYPE LIT   IS (FALSE, TRUE);
+     TYPE FLAG  IS (PASS, FAIL);
+
+     TYPE NUM2 IS DIGITS(2);
+     TYPE NUM3 IS DIGITS(2);
+     TYPE NUM4 IS DIGITS(2);
+
+     TYPE A1 IS ARRAY (POS'(1)..5, NOTE'(A)..D, BOOL'(FALSE)..TRUE)
+          OF FLOAT;
+     TYPE A2 IS ARRAY (INT'(1)..5, NOTE'(A)..D, BIT'(FALSE)..TRUE)
+          OF NUM2;
+     TYPE A3 IS ARRAY (POS'(1)..5, GRADE'(A)..D, BOOL'(FALSE)..TRUE)
+          OF NUM3;
+     TYPE A4 IS ARRAY (NAT'(1)..5, NOTE'(A)..D, LIT'(FALSE)..TRUE)
+          OF NUM4;
+     
+     OBJ1 : A1 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
+     OBJ2 : A2 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
+     OBJ3 : A3 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
+     OBJ4 : A4 := (OTHERS => (OTHERS => (OTHERS => 0.0)));
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : IN FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          IF STAT = FAIL THEN 
+               FAILED ("PREFIX OR INDEX IS NOT APPROPRIATE FOR" &
+                       " INDEXED COMPONENT");
+          END IF;
+          RETURN ARG;
+     END F1;
+  
+     FUNCTION A IS NEW F1 (A1, OBJ1, PASS);
+     FUNCTION A IS NEW F1 (A2, OBJ2, FAIL);
+     FUNCTION A IS NEW F1 (A3, OBJ3, FAIL);
+     FUNCTION A IS NEW F1 (A4, OBJ4, FAIL);
+  
+BEGIN
+     TEST ("C87B23A","OVERLOADED ARRAY INDEXES");
+    
+     DECLARE
+          F1 : FLOAT := A (3, C, TRUE);
+   
+     BEGIN
+          NULL;
+     END;
+ 
+     RESULT;
+END C87B23A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b24a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b24a.ada
new file mode 100644
index 000000000..abfaad633
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b24a.ada
@@ -0,0 +1,79 @@
+-- C87B24A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+    
+-- THE PREFIX OF A SLICE MUST BE APPROPRIATE FOR A ONE DIMENSIONAL
+-- ARRAY TYPE.
+  
+-- TRH  26 JULY 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B24A IS
+ 
+     TYPE LIST IS ARRAY (1 .. 5) OF INTEGER;
+     TYPE GRID IS ARRAY (1 .. 5, 1 .. 5) OF INTEGER;
+     TYPE CUBE IS ARRAY (1 .. 5, 1 .. 5, 1 .. 5) OF INTEGER;
+     TYPE HYPE IS ARRAY (1 .. 5, 1 .. 5, 1 .. 5, 1 .. 5) OF INTEGER;
+     TYPE FLAG IS (PASS, FAIL);
+   
+     L : LIST := (1 .. 5 => 0);
+     G : GRID := (1 .. 5 => (1 .. 5 => 0));
+     C : CUBE := (1 .. 5 => (1 .. 5 => (1 .. 5 => 0)));
+     H : HYPE := (1 .. 5 => (1 .. 5 => (1 .. 5 => (1 .. 5 => 0))));
+ 
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : IN FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN
+          IF STAT = FAIL THEN 
+             FAILED ("SLICE PREFIX MUST BE APPROPRIATE FOR ONE " &
+                     "DIMENSIONAL ARRAY");
+          END IF;
+          RETURN ARG;
+     END F1;
+ 
+     FUNCTION F2 IS NEW F1 (LIST, L, PASS);
+     FUNCTION F2 IS NEW F1 (GRID, G, FAIL);
+     FUNCTION F2 IS NEW F1 (CUBE, C, FAIL);
+     FUNCTION F2 IS NEW F1 (HYPE, H, FAIL);
+    
+BEGIN
+     TEST ("C87B24A","OVERLOADED PREFIX FOR SLICE RESOLVED TO " &
+           "ONE DIMENSIONAL ARRAY TYPE");
+ 
+     DECLARE
+          S1 : INTEGER;
+ 
+     BEGIN
+          S1 := F2 (2 .. 3)(2);
+     END;
+ 
+     RESULT;
+END C87B24A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b24b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b24b.ada
new file mode 100644
index 000000000..537cf9b48
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b24b.ada
@@ -0,0 +1,98 @@
+-- C87B24B.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+    
+-- THE RANGE BOUNDS FOR A SLICE MUST BE DISCRETE AND OF THE SAME BASE
+-- TYPE AS THE ARRAY INDEX.
+  
+-- TRH  15 JULY 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B24B IS
+ 
+     TYPE PIECE IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+ 
+     PI  : PIECE (1 .. 8) := (3, 1, 4, 1, 5, 9, 2, 6);
+     S1  : PIECE (1 .. 3);
+     S2  : PIECE (4 .. 8);
+     ERR : BOOLEAN := FALSE;
+       
+     FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
+     BEGIN 
+          RETURN X;
+     END F1;
+       
+     FUNCTION F1 (X : INTEGER) RETURN FLOAT IS
+     BEGIN 
+          ERR := TRUE;
+          RETURN 0.0;
+     END F1;
+    
+     FUNCTION F2 (X : INTEGER) RETURN INTEGER IS
+     BEGIN 
+          RETURN X;
+     END F2;
+    
+     FUNCTION F2 (X :INTEGER) RETURN CHARACTER IS
+     BEGIN 
+          ERR := TRUE;
+          RETURN 'A';
+     END F2;
+    
+BEGIN
+     TEST ("C87B24B","OVERLOADING RESOLUTION OF RANGE " &
+           "CONSTRAINTS FOR SLICES");
+ 
+     DECLARE
+          FUNCTION "+" (X : INTEGER) RETURN INTEGER 
+               RENAMES F1;
+   
+          FUNCTION "+" (X : INTEGER) RETURN FLOAT 
+               RENAMES F1;
+   
+          FUNCTION "-" (X : INTEGER) RETURN INTEGER 
+               RENAMES F2;
+ 
+          FUNCTION "-" (X : INTEGER) RETURN CHARACTER
+               RENAMES F2;
+  
+     BEGIN 
+          S1 := PI ("+" (3) .. "-" (5));
+          S1 := PI (F2  (2) .. "+" (4));
+          S1 := PI ("-" (6) .. F1  (8));
+          S1 := PI (F2  (1) .. F2  (3));
+          S2 := PI (F2  (4) .. F1  (8));
+          S2 := PI (2       .. "+" (6));
+          S2 := PI (F1  (1) ..       5);
+          S2 := PI ("+" (3) .. "+" (7));
+  
+          IF ERR THEN
+               FAILED (" OVERLOADING RESOLUTION INCORRECT FOR SLICES");
+          END IF;
+     END;
+ 
+     RESULT;
+END C87B24B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b26b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b26b.ada
new file mode 100644
index 000000000..41f6ca4f5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b26b.ada
@@ -0,0 +1,149 @@
+-- C87B26B.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, AND 'STORAGE_SIZE MAY BE
+-- USED WITH THE DESIGNATED OBJECTS OF ACCESS VALUES RETURNED FROM
+-- OVERLOADED FUNCTIONS, AND THAT EXPLICIT DEREFERENCING IS USED BY
+-- OVERLOADING RESOLUTION TO RESOLVE THE PREFIXES OF THE ATTRIBUTES.
+
+-- DSJ 22 JUN 83
+-- JBG 11/22/83
+-- JBG 4/23/84
+-- JBG 5/25/85
+
+WITH REPORT;  WITH SYSTEM;
+USE  REPORT;  USE  SYSTEM;
+
+PROCEDURE C87B26B IS
+
+     TYPE REC (D : INTEGER) IS
+          RECORD
+               C1, C2 : INTEGER;
+          END RECORD;
+     TYPE P_REC IS ACCESS REC;
+
+     P_REC_OBJECT : P_REC := NEW REC'(1,1,1);
+
+     TYPE BIG_INT IS RANGE 0..SYSTEM.MAX_INT;
+     TASK TYPE TASK_TYPE IS
+          -- NOTHING AT ALL
+     END TASK_TYPE;
+
+     TYPE P_TASK IS ACCESS TASK_TYPE;
+
+     P_TASK_OBJECT : P_TASK;
+
+     TASK BODY TASK_TYPE IS
+     BEGIN
+          NULL;
+     END TASK_TYPE;
+
+     ------------------------------------------------------------
+
+     FUNCTION F RETURN REC IS
+     BEGIN
+          RETURN (0,0,0);
+     END F;
+
+     FUNCTION F RETURN P_REC IS
+     BEGIN
+          RETURN P_REC_OBJECT;
+     END F;
+
+     ------------------------------------------------------------
+
+     FUNCTION G RETURN TASK_TYPE IS
+          NEW_TASK : TASK_TYPE;
+     BEGIN
+          RETURN NEW_TASK;
+     END G;
+
+     FUNCTION G RETURN P_TASK IS
+     BEGIN
+          RETURN P_TASK_OBJECT;
+     END G;
+
+     ------------------------------------------------------------
+
+BEGIN
+
+     TEST("C87B26B","CHECK THAT EXPLICIT DEREFERENCING IN AN " &
+          "ATTRIBUTE PREFIX IS USED IN OVERLOADING RESOLUTION " &
+          "WITH 'ADDRESS, 'CONSTRAINED, 'SIZE, AND 'STORAGE_SIZE");
+
+     DECLARE
+
+          A : ADDRESS;   -- FOR 'ADDRESS OF RECORD
+          B : BOOLEAN;   -- FOR 'CONSTRAINED OF RECORD
+          C : INTEGER;   -- FOR 'SIZE OF RECORD
+          D : ADDRESS;   -- FOR 'ADDRESS OF TASK
+          E : BIG_INT;   -- FOR 'STORAGE_SIZE OF TASK
+
+     BEGIN
+
+          P_TASK_OBJECT := NEW TASK_TYPE;
+          A := F.ALL'ADDRESS;
+          B := F.ALL'CONSTRAINED;
+          C := F.ALL'SIZE;
+          D := G.ALL'ADDRESS;
+          E := G.ALL'STORAGE_SIZE;
+
+          IF A /= P_REC_OBJECT.ALL'ADDRESS THEN
+               FAILED("INCORRECT RESOLUTION FOR 'ADDRESS - REC");
+          END IF;
+
+          IF B /= P_REC_OBJECT.ALL'CONSTRAINED THEN
+               FAILED("INCORRECT RESOLUTION FOR 'CONSTRAINED");
+          END IF;
+
+          IF C /= P_REC_OBJECT.ALL'SIZE THEN
+               FAILED("INCORRECT RESOLUTION FOR 'SIZE");
+          END IF;
+
+          IF D /= P_TASK_OBJECT.ALL'ADDRESS THEN
+               FAILED("INCORRECT RESOLUTION FOR 'ADDRESS - TASK");
+          END IF;
+
+          IF E /= P_TASK_OBJECT.ALL'STORAGE_SIZE THEN
+               FAILED("INCORRECT RESOLUTION FOR 'STORAGE_SIZE");
+          END IF;
+
+          IF A = P_REC_OBJECT'ADDRESS THEN
+               FAILED("INCORRECT DEREFERENCING FOR 'ADDRESS - REC");
+          END IF;
+
+          IF C = P_REC_OBJECT'SIZE AND C /= P_REC_OBJECT.ALL'SIZE THEN
+               FAILED("INCORRECT DEREFERENCING FOR 'SIZE");
+          END IF;
+
+          IF D = P_TASK_OBJECT'ADDRESS THEN
+               FAILED("INCORRECT DEREFERENCING FOR 'ADDRESS - TASK");
+          END IF;
+
+
+     END;
+
+     RESULT;
+
+END C87B26B; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b27a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b27a.ada
new file mode 100644
index 000000000..4b99792cd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b27a.ada
@@ -0,0 +1,80 @@
+-- C87B27A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE TYPE OF A STRING LITERAL MUST BE DETERMINED FROM THE FACT
+-- THAT A STRING LITERAL IS A VALUE OF A ONE DIMENSIONAL ARRAY OF
+-- CHARACTER COMPONENTS.
+  
+-- TRH  18 AUG 82
+-- DSJ  07 JUN 83
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B27A IS
+ 
+     TYPE ENUMLIT   IS (A, B, C, D, E, F);
+     TYPE NEW_CHAR  IS NEW CHARACTER RANGE 'G' .. 'Z';
+     TYPE CHARS3    IS ('G','H','I','K','M','N','P','R','S','T');
+     TYPE CHARS4    IS ('S','T','R','I','N','G','Z','A','P');
+     TYPE NEW_STR   IS ARRAY  (A .. F) OF NEW_CHAR;
+     TYPE STRING3   IS ARRAY  (11..16) OF CHARS3;
+     TYPE STRING4   IS ARRAY  (21..26) OF CHARS4;
+     TYPE ENUM_VEC  IS ARRAY  (1 .. 6) OF ENUMLIT;
+     TYPE CHAR_GRID IS ARRAY  (D .. F, 1 .. 3) OF NEW_CHAR;
+     TYPE STR_LIST  IS ARRAY  (1 .. 6) OF STRING (1 .. 1);
+     ERR : BOOLEAN  := FALSE;
+ 
+     PROCEDURE P (X : NEW_STR) IS
+     BEGIN
+          NULL;
+     END P;
+ 
+     PROCEDURE P (X : ENUM_VEC) IS
+     BEGIN
+          ERR := TRUE;
+     END P;
+ 
+     PROCEDURE P (X : CHAR_GRID) IS
+     BEGIN
+          ERR := TRUE;
+     END P;
+ 
+     PROCEDURE P (X : STR_LIST) IS
+     BEGIN
+          ERR := TRUE;
+     END P;
+ 
+BEGIN
+     TEST ("C87B27A","OVERLOADING RESOLUTION OF STRING LITERALS");
+    
+     P ("STRING");
+ 
+     IF ERR THEN
+          FAILED ("RESOLUTION INCORRECT FOR STRING LITERALS");
+     END IF;
+ 
+     RESULT;
+END C87B27A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b28a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b28a.ada
new file mode 100644
index 000000000..dfde694bb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b28a.ada
@@ -0,0 +1,71 @@
+-- C87B28A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE TYPE OF THE LITERAL "NULL" MUST BE DETERMINED FROM THE FACT 
+-- THAT "NULL" IS A VALUE OF AN ACCESS TYPE.
+  
+-- TRH  13 AUG 82
+-- JRK 2/2/84
+
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B28A IS
+ 
+     ERR : BOOLEAN := FALSE;
+ 
+     TYPE A2 IS ACCESS BOOLEAN;
+     TYPE A3 IS ACCESS INTEGER;
+     TYPE A1 IS ACCESS A2;
+ 
+     FUNCTION F RETURN A1 IS
+     BEGIN 
+          RETURN NEW A2;
+     END F;
+ 
+     FUNCTION F RETURN A2 IS
+     BEGIN
+          ERR := TRUE;
+          RETURN NEW BOOLEAN;
+     END F;
+ 
+     FUNCTION F RETURN A3 IS
+     BEGIN
+          ERR := TRUE;
+          RETURN (NEW INTEGER);
+     END F;
+ 
+BEGIN
+     TEST ("C87B28A", "OVERLOADING OF THE ACCESS TYPE LITERAL 'NULL'");
+    
+     F.ALL := NULL;
+ 
+     IF ERR THEN
+          FAILED ("RESOLUTION INCORRECT FOR THE ACCESS TYPE LITERAL " &
+                  "'NULL'");
+     END IF;
+ 
+     RESULT;
+END C87B28A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b29a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b29a.ada
new file mode 100644
index 000000000..594f71987
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b29a.ada
@@ -0,0 +1,72 @@
+-- C87B29A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- AGGREGATES CONTAINING A SINGLE COMPONENT ASSOCIATION MUST
+-- USE ONLY NAMED NOTATION.
+  
+-- TRH  4 AUG 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B29A IS
+     
+     TYPE VECTOR IS ARRAY (1 .. 1) OF INTEGER;
+ 
+     TYPE REC IS
+          RECORD
+               X : INTEGER;
+          END RECORD;
+ 
+     ERR : BOOLEAN := FALSE;
+ 
+     PROCEDURE P1 (X : INTEGER) IS
+     BEGIN
+          NULL;
+     END P1;
+ 
+     PROCEDURE P1 (X : VECTOR) IS
+     BEGIN
+          ERR := TRUE;
+     END P1;
+ 
+     PROCEDURE P1 (X : REC) IS
+     BEGIN
+          ERR := TRUE;
+     END P1;
+ 
+BEGIN
+     TEST ("C87B29A","AGGREGATES CONTAINING A SINGLE COMPONENT " &
+           "ASSOCIATION MUST USE NAMED NOTATION");
+   
+     P1 ( (0) );  -- INTEGER PARAMETER, NOT AN AGGREGATE PARAMETER
+ 
+     IF ERR THEN
+        FAILED ("RESOLUTION INCORRECT - AGGREGATES WITH A SINGLE " &
+                "COMPONENT ASSOCIATION MUST USE NAMED NOTATION");
+     END IF;
+    
+     RESULT;
+END C87B29A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b30a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b30a.ada
new file mode 100644
index 000000000..da574513e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b30a.ada
@@ -0,0 +1,84 @@
+-- C87B30A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE EXPRESSION OF A COMPONENT ASSOCIATION MUST MATCH THE TYPE OF THE 
+-- ASSOCIATED RECORD COMPONENT.
+  
+-- TRH  9 AUG 82
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B30A IS
+ 
+     TYPE REC IS
+          RECORD
+               W, X : FLOAT;
+               Y, Z : INTEGER;
+          END RECORD;
+ 
+     TYPE FLAG IS (PASS, FAIL);
+     
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : IN FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          IF STAT = FAIL THEN 
+               FAILED ("COMPONENT ASSOCIATION EXPRESSION MUST MATCH " &
+                       "RECORD COMPONENT TYPE");
+          END IF;
+          RETURN ARG;
+     END F1;
+  
+     FUNCTION F IS NEW F1 (FLOAT,     2.0, PASS);
+     FUNCTION F IS NEW F1 (INTEGER,     5, FAIL);
+     FUNCTION F IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+     FUNCTION F IS NEW F1 (CHARACTER, 'E', FAIL);
+ 
+     FUNCTION G IS NEW F1 (FLOAT,     2.0, FAIL);
+     FUNCTION G IS NEW F1 (INTEGER,     5, PASS);
+     FUNCTION G IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+     FUNCTION G IS NEW F1 (CHARACTER, 'E', FAIL);
+    
+BEGIN
+     TEST ("C87B30A","OVERLOADED EXPRESSIONS IN RECORD AGGREGATE " &
+           "COMPONENT ASSOCIATIONS");
+    
+     DECLARE
+          R1 : REC := (F, F, G, G);
+          R2 : REC := (X => F, Y => G, Z => G, W => F);
+          R3 : REC := (F, F, Z => G, Y => G);
+   
+     BEGIN
+          NULL;
+     END;
+ 
+     RESULT;
+END C87B30A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b31a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b31a.ada
new file mode 100644
index 000000000..7aebd41dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b31a.ada
@@ -0,0 +1,137 @@
+-- C87B31A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IF THE TYPE OF AN AGGREGATE IS A ONE-DIMENSIONAL ARRAY TYPE
+-- THEN EACH CHOICE MUST SPECIFY VALUES OF THE INDEX TYPE, AND
+-- THE EXPRESSION OF EACH COMPONENT ASSOCIATION MUST BE OF THE
+-- COMPONENT TYPE.
+  
+-- TRH  8 AUG 82
+-- DSJ 15 JUN 83
+-- JRK  2 FEB 84
+-- JBG 4/23/84
+
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B31A IS
+ 
+     TYPE LETTER  IS NEW CHARACTER RANGE 'A' .. 'Z';
+     TYPE NOTE    IS (A, B, C, D, E, F, G, H);
+     TYPE STR     IS NEW STRING (1 .. 1);
+     TYPE BIT     IS NEW BOOLEAN;
+     TYPE YES     IS NEW BOOLEAN RANGE TRUE  .. TRUE;
+     TYPE NO      IS NEW BOOLEAN RANGE FALSE .. FALSE;
+     TYPE BOOLEAN IS (FALSE, TRUE);
+     TYPE LIST    IS ARRAY (CHARACTER RANGE <>) OF BIT;
+     TYPE FLAG    IS (PASS,  FAIL);
+     
+     SUBTYPE LIST_A  IS LIST('A'..'A');
+     SUBTYPE LIST_E  IS LIST('E'..'E');
+     SUBTYPE LIST_AE IS LIST('A'..'E');
+
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : IN FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          IF STAT = FAIL THEN 
+               FAILED ("RESOLUTION INCORRECT FOR EXPRESSIONS " &
+                       "IN ARRAY AGGREGATES");
+          END IF;
+          RETURN ARG;
+     END F1;
+  
+     FUNCTION F IS NEW F1 (BOOLEAN, FALSE, FAIL);
+     FUNCTION F IS NEW F1 (YES,     TRUE,  FAIL);
+     FUNCTION F IS NEW F1 (NO,      FALSE, FAIL);
+     FUNCTION F IS NEW F1 (BIT,     TRUE,  PASS);
+  
+     FUNCTION G IS NEW F1 (CHARACTER, 'A', PASS);
+     FUNCTION G IS NEW F1 (LETTER,    'A', FAIL);
+     FUNCTION G IS NEW F1 (STR,       "A", FAIL);
+  
+     FUNCTION H IS NEW F1 (CHARACTER, 'E', PASS);
+     FUNCTION H IS NEW F1 (LETTER,    'E', FAIL);
+     FUNCTION H IS NEW F1 (STR,       "E", FAIL);
+    
+BEGIN
+     TEST ("C87B31A", "OVERLOADED EXPRESSIONS IN ARRAY AGGREGATES");
+    
+     DECLARE
+          L1, L2 : LIST_A :=  (OTHERS => FALSE);
+          L3, L4 : LIST_E :=  (OTHERS => FALSE);
+          L5, L6 : LIST_AE := (OTHERS => FALSE);
+          L7, L8 : LIST_AE := (OTHERS => FALSE);
+
+     BEGIN
+          L1 := ('A' => F);
+          L2 := ( G  => F);
+          L3 := ('E' => F);
+          L4 := ( H  => F);
+          L5 := ('A'..'E' => F);
+          L6 := (F,F,F,F,F);
+          L7 := (F,F,F, OTHERS => F);
+          L8 := LIST_AE'('E' => F, 'B' => F, OTHERS => F);
+  
+          IF L1 /= LIST_A'(OTHERS => TRUE) THEN
+                 FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                         " EXPRESSIONS IN ARRAY AGGREGATES - L1");
+          END IF;
+          IF L2 /= LIST_A'(OTHERS => TRUE) THEN
+                 FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                         " EXPRESSIONS IN ARRAY AGGREGATES - L2");
+          END IF;
+          IF L3 /= LIST_E'(OTHERS => TRUE) THEN
+                 FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                         " EXPRESSIONS IN ARRAY AGGREGATES - L3");
+          END IF;
+          IF L4 /= LIST_E'(OTHERS => TRUE) THEN
+                 FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                         " EXPRESSIONS IN ARRAY AGGREGATES - L4");
+          END IF;
+          IF L5 /= LIST_AE'(OTHERS => TRUE) THEN
+                 FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                         " EXPRESSIONS IN ARRAY AGGREGATES - L5");
+          END IF;
+          IF L6 /= LIST_AE'(OTHERS => TRUE) THEN
+                 FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                         " EXPRESSIONS IN ARRAY AGGREGATES - L6");
+          END IF;
+          IF L7 /= LIST_AE'(OTHERS => TRUE) THEN
+                 FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                         " EXPRESSIONS IN ARRAY AGGREGATES - L7");
+          END IF;
+          IF L8 /= LIST_AE'(OTHERS => TRUE) THEN
+                 FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
+                         " EXPRESSIONS IN ARRAY AGGREGATES - L8");
+          END IF;
+     END;
+ 
+     RESULT;
+END C87B31A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b32a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b32a.ada
new file mode 100644
index 000000000..1a31f113d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b32a.ada
@@ -0,0 +1,199 @@
+-- C87B32A.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 OVERLOADING RESOLUTION USES THE FOLLOWING RULES:
+    
+-- FOR ATTRIBUTES OF THE FORM: T'SUCC (X), T'PRED (X), T'POS (X),
+-- AND T'IMAGE (X) , THE OPERAND X MUST BE OF TYPE T.
+--
+-- FOR THE ATTRIBUTE OF THE FORM T'VAL (X), THE OPERAND X MUST BE
+-- OF AN INTEGER TYPE.
+--
+-- FOR THE ATTRIBUTE OF THE FORM T'VALUE (X), THE OPERAND X MUST 
+-- BE OF THE PREDEFINED TYPE STRING.
+  
+-- TRH  13 SEPT 82
+-- JRK  12 JAN  84
+
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B32A IS
+ 
+     TYPE COLOR  IS (BROWN, RED, WHITE);
+     TYPE SCHOOL IS (HARVARD, BROWN, YALE);
+     TYPE COOK   IS (SIMMER, SAUTE, BROWN, BOIL);
+     TYPE SUGAR  IS (DEXTROSE, CANE, GLUCOSE, BROWN);
+     TYPE WHOLE  IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+     TYPE LIT_CHAR IS ('+', '-', '0', '1', '2', '3', '4', '5', '6', '7',
+                       '8', '9');
+     TYPE LIT_STRING IS ARRAY (POSITIVE RANGE <>) OF LIT_CHAR;
+
+     FUNCTION "+" (X, Y : WHOLE) RETURN WHOLE 
+          RENAMES "*";
+ 
+     FUNCTION F1 RETURN STRING IS
+     BEGIN 
+          RETURN "+10";
+     END F1;
+  
+     FUNCTION F1 RETURN LIT_STRING IS
+     BEGIN 
+          FAILED ("THE VALUE ATTRIBUTE TAKES A PREDEFINED STRING " &
+                  "OPERAND");
+          RETURN "+3";
+     END F1;
+  
+     FUNCTION F1 RETURN CHARACTER IS
+     BEGIN
+          FAILED ("THE VALUE ATTRIBUTE TAKES A STRING OPERAND");
+          RETURN '2';
+     END F1;
+   
+     FUNCTION F2 (X : INTEGER) RETURN FLOAT IS
+     BEGIN
+          FAILED ("THE VAL ATTRIBUTE TAKES AN INTEGER TYPE OPERAND");
+          RETURN 0.0;
+     END F2;
+  
+     FUNCTION F2 (X : INTEGER := 1) RETURN INTEGER IS
+     BEGIN 
+          RETURN X;
+     END F2;
+ 
+BEGIN
+     TEST ("C87B32A","OVERLOADED OPERANDS FOR THE ATTRIBUTES " &
+           "T'PRED, T'SUCC, T'POS, T'VAL, T'IMAGE AND T'VALUE");
+  
+     IF COLOR'POS   (BROWN) /= 0        THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 1");
+     END IF;
+ 
+     IF SCHOOL'POS (BROWN) /= 1         THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 2");
+     END IF;
+ 
+     IF COOK'POS    (BROWN) /= 2        THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 3");
+     END IF;
+ 
+     IF SUGAR'POS  (BROWN) /= 3         THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 4");
+     END IF;
+ 
+     IF SCHOOL'PRED (BROWN) /= HARVARD  THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 5");
+     END IF;
+ 
+     IF COOK'PRED  (BROWN) /= SAUTE     THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 6");
+     END IF;
+ 
+     IF SUGAR'PRED  (BROWN) /= GLUCOSE  THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 7");
+     END IF;
+ 
+     IF COLOR'SUCC (BROWN) /= RED       THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 8");
+     END IF;
+ 
+     IF SCHOOL'SUCC (BROWN) /= YALE     THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 9");
+     END IF;
+ 
+     IF COOK'SUCC  (BROWN) /= BOIL      THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 10");
+     END IF;
+ 
+     IF COLOR'VAL (F2 (0))  /= BROWN    THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 11");
+     END IF;
+ 
+     IF SCHOOL'VAL (F2)    /= BROWN     THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 12");
+     END IF;
+ 
+     IF COOK'VAL  (F2 (2))  /= BROWN    THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 13");
+     END IF;
+ 
+     IF SUGAR'VAL  (F2)    /= CANE      THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 14");
+     END IF;
+ 
+     IF WHOLE'POS   (1 + 1)   /= 1      THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 15");
+     END IF;
+ 
+     IF WHOLE'VAL   (1 + 1) /= 2        THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 16");
+     END IF;
+ 
+     IF WHOLE'SUCC  (1 + 1)   /= 2      THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 17");
+     END IF;
+ 
+     IF WHOLE'PRED  (1 + 1) /= 0        THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 18");
+     END IF;
+ 
+     IF WHOLE'VALUE ("+1") + 1 /= 1     THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 19");
+     END IF;
+ 
+     IF WHOLE'IMAGE (1 + 1) /= " 1"     THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 20");
+     END IF;
+ 
+     IF WHOLE'VALUE (F1) + 1  /= 10     THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 21");
+     END IF;
+ 
+     IF WHOLE'VAL (1) + 1   /= 1        THEN
+        FAILED ("RESOLUTION INCORRECT FOR OPERANDS OF THE ATTRIBUTES" &
+                " PRED, SUCC, VAL, POS, IMAGE AND VALUE - 22");
+     END IF;
+ 
+     RESULT;
+END C87B32A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b33a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b33a.ada
new file mode 100644
index 000000000..5c398d463
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b33a.ada
@@ -0,0 +1,117 @@
+-- C87B33A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE SHORT CIRCUIT CONTROL FORMS "AND THEN" AND "OR ELSE" ARE
+-- DEFINED AS BINARY BOOLEAN OPERATORS WHICH RETURN A BOOLEAN VALUE
+-- OF THE SAME TYPE AS THE OPERANDS.
+  
+-- TRH  13 SEPT 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B33A IS
+     
+     TYPE ON   IS NEW BOOLEAN RANGE TRUE  .. TRUE;
+     TYPE OFF  IS NEW BOOLEAN RANGE FALSE .. FALSE;
+     TYPE YES  IS NEW ON;
+     TYPE NO   IS NEW OFF;
+     TYPE BIT  IS NEW BOOLEAN;
+     TYPE FLAG IS (PASS, FAIL);
+ 
+     TYPE BOOLEAN IS (FALSE, TRUE);  -- STANDARD BOOLEAN HIDDEN.
+ 
+     GENERIC 
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : FLAG;
+     FUNCTION F1 RETURN T;
+     
+     FUNCTION F1 RETURN T IS
+     BEGIN
+          IF STAT = FAIL THEN
+               FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT " &
+                       "CONTROL FORMS 'AND THEN' AND 'OR ELSE' ");
+          END IF;
+          RETURN ARG;
+     END F1;
+ 
+     FUNCTION A IS NEW F1 (BOOLEAN, TRUE,  FAIL);
+     FUNCTION A IS NEW F1 (NO,      FALSE, PASS);
+     FUNCTION A IS NEW F1 (ON,      TRUE,  FAIL);
+     FUNCTION A IS NEW F1 (YES,     TRUE,  FAIL);
+     FUNCTION B IS NEW F1 (BOOLEAN, TRUE,  FAIL);
+     FUNCTION B IS NEW F1 (NO,      FALSE, FAIL);
+     FUNCTION B IS NEW F1 (OFF,     FALSE, FAIL);
+     FUNCTION B IS NEW F1 (BIT,     TRUE,  FAIL);
+     FUNCTION C IS NEW F1 (BOOLEAN, FALSE, FAIL);
+     FUNCTION C IS NEW F1 (YES,     TRUE,  PASS);
+     FUNCTION C IS NEW F1 (ON,      TRUE,  FAIL);
+     FUNCTION C IS NEW F1 (NO,      FALSE, FAIL);
+     FUNCTION D IS NEW F1 (BOOLEAN, FALSE, FAIL);
+     FUNCTION D IS NEW F1 (OFF,     FALSE, FAIL);
+     FUNCTION D IS NEW F1 (YES,     TRUE,  FAIL);
+     FUNCTION D IS NEW F1 (BIT,     TRUE,  FAIL);
+     FUNCTION E IS NEW F1 (BOOLEAN, FALSE, FAIL);
+     FUNCTION E IS NEW F1 (BIT,     TRUE,  PASS);
+     FUNCTION E IS NEW F1 (YES,     TRUE,  FAIL);
+     FUNCTION E IS NEW F1 (NO,      FALSE, FAIL);
+     FUNCTION F IS NEW F1 (BOOLEAN, FALSE, FAIL);
+     FUNCTION F IS NEW F1 (BIT,     TRUE,  PASS);
+     FUNCTION F IS NEW F1 (ON,      TRUE,  FAIL);
+     FUNCTION F IS NEW F1 (OFF,     FALSE, FAIL);
+     FUNCTION G IS NEW F1 (BOOLEAN, TRUE,  FAIL);
+     FUNCTION G IS NEW F1 (BIT,     FALSE, PASS);
+     FUNCTION G IS NEW F1 (NO,      FALSE, FAIL);
+     FUNCTION G IS NEW F1 (YES,     TRUE,  FAIL);
+     FUNCTION H IS NEW F1 (BOOLEAN, TRUE,  FAIL);
+     FUNCTION H IS NEW F1 (BIT,     FALSE, PASS);
+     FUNCTION H IS NEW F1 (OFF,     FALSE, FAIL);
+     FUNCTION H IS NEW F1 (ON,      TRUE,  FAIL);
+ 
+BEGIN
+     TEST ("C87B33A","OVERLOADED OPERANDS FOR SHORT CIRCUIT CONTROL " &
+           "FORMS 'AND THEN' AND 'OR ELSE' ");
+    
+     IF (A AND THEN B)                        THEN
+          FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - A&B");
+     END IF;
+
+     IF NOT (C OR ELSE D) THEN
+          FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - C&D");
+     END IF;
+
+     IF NOT (E AND THEN F AND THEN E
+          AND THEN F AND THEN E AND THEN F)   THEN
+          FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - E&F");
+     END IF;
+
+     IF (G OR ELSE H OR ELSE G
+          OR ELSE H OR ELSE G OR ELSE H)      THEN
+          FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - G&H");
+     END IF;
+    
+     RESULT;
+END C87B33A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b34a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b34a.ada
new file mode 100644
index 000000000..4291197af
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b34a.ada
@@ -0,0 +1,68 @@
+-- C87B34A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE MEMBERSHIP TESTS "IN" AND "NOT IN" RESULT IN THE PREDEFINED
+-- TYPE BOOLEAN. 
+  
+-- TRH  4 AUG 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B34A IS
+     
+     TYPE BIT   IS NEW BOOLEAN;
+     TYPE FLAG  IS NEW BOOLEAN;
+ 
+     ERR : BOOLEAN := FALSE;
+ 
+     PROCEDURE P1 (X : BIT) IS
+     BEGIN
+          ERR := TRUE;
+     END P1;
+ 
+     PROCEDURE P1 (X : FLAG) IS
+     BEGIN
+          ERR := TRUE;
+     END P1;
+ 
+     PROCEDURE P1 (X : BOOLEAN) IS
+     BEGIN
+          NULL;
+     END P1;
+  
+BEGIN
+     TEST ("C87B34A","MEMBERSHIP TESTS 'IN' AND 'NOT IN' RETURN " &
+           "TYPE PREDEFINED BOOLEAN");
+   
+     P1 (3 IN 1 .. 5);
+     P1 (3 NOT IN 1 .. 5);
+ 
+     IF ERR THEN
+        FAILED ("MEMBERSHIP TESTS MUST RETURN PREDEFINED BOOLEAN TYPE");
+     END IF;
+    
+     RESULT;
+END C87B34A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b34b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b34b.ada
new file mode 100644
index 000000000..17cdbcea0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b34b.ada
@@ -0,0 +1,71 @@
+-- C87B34B.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+    
+-- THE "IN" (OR MEMBERSHIP) OPERATOR OF THE FORM:  X IN L .. R
+-- REQUIRES THE OPERANDS X, L AND R TO BE OF THE SAME SCALAR TYPE.
+  
+-- TRH  19 JULY 82
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B34B IS
+ 
+     TYPE FLAG IS (PASS, FAIL);
+  
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : IN FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          IF STAT = FAIL THEN 
+             FAILED ("RESOLUTION INCORRECT FOR 'IN' MEMBERSHIP TEST");
+          END IF;
+          RETURN ARG;
+     END F1;
+  
+     FUNCTION X IS NEW F1 (FLOAT,     2.0, PASS);
+     FUNCTION L IS NEW F1 (FLOAT,    -1.0, PASS);
+     FUNCTION R IS NEW F1 (FLOAT,     1.0, PASS);
+     FUNCTION X IS NEW F1 (INTEGER,     5, FAIL);
+     FUNCTION L IS NEW F1 (INTEGER,     1, FAIL);
+     FUNCTION L IS NEW F1 (CHARACTER, 'A', FAIL);
+     FUNCTION R IS NEW F1 (CHARACTER, 'E', FAIL);
+     FUNCTION X IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+     FUNCTION R IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+    
+BEGIN
+     TEST ("C87B34B","OVERLOADED MEMBERSHIP OPERANDS");
+ 
+     IF X IN L .. R THEN 
+        FAILED ("RESOLUTION INCORRECT FOR MEMBERSHIP OPERATOR");
+     END IF;
+ 
+     RESULT;
+END C87B34B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b34c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b34c.ada
new file mode 100644
index 000000000..7b8dc5930
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b34c.ada
@@ -0,0 +1,75 @@
+-- C87B34C.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+    
+-- FOR A MEMBERSHIP RELATION WITH A TYPEMARK, THE TYPE OF THE
+-- SIMPLE EXPRESSION MUST BE THE BASE TYPE OF THE TYPEMARK.
+  
+-- TRH  15 SEPT 82
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B34C IS
+ 
+     TYPE VOWEL IS (A, E, I, O, U, VOCALIC_Y);
+     TYPE ALPHA IS (A, 'A');
+     TYPE GRADE IS (A, B, C, D, F);
+     SUBTYPE BAD_GRADE IS GRADE RANGE D .. F;
+     SUBTYPE PASSING   IS GRADE RANGE A .. C;
+ 
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          FAILED ("RESOLUTION INCORRECT - EXPRESSION IN MEMBER" &
+                  "SHIP TEST WITH TYPEMARK MUST MATCH TYPEMARK");
+          RETURN ARG;
+     END F1;
+ 
+     FUNCTION F IS NEW F1 (CHARACTER, 'A');
+     FUNCTION F IS NEW F1 (DURATION,  1.0);
+     FUNCTION F IS NEW F1 (INTEGER,   -10);
+     FUNCTION F IS NEW F1 (BOOLEAN,   TRUE);
+     FUNCTION F IS NEW F1 (FLOAT,     1.0);
+     FUNCTION F IS NEW F1 (VOWEL,     A);
+     FUNCTION F IS NEW F1 (ALPHA,     A);
+    
+BEGIN
+     TEST ("C87B34C","OVERLOADED EXPRESSION IN MEMBERSHIP TEST " &
+           "WITH A TYPEMARK");
+ 
+     IF (F NOT IN GRADE) OR (F NOT IN BAD_GRADE)
+          OR (F IN PASSING) THEN 
+          FAILED ("RESOLUTION INCORRECT FOR MEMBERSHIP TEST " &
+                  "WITH TYPEMARK");
+     END IF;
+    
+     RESULT;
+ 
+END C87B34C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b35c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b35c.ada
new file mode 100644
index 000000000..89a839f6d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b35c.ada
@@ -0,0 +1,82 @@
+-- C87B35C.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE EXPONENT OPERAND OF A FLOATING POINT EXPONENTIATION MUST BE
+-- OF THE TYPE PREDEFINED INTEGER.
+  
+-- TRH  4 AUG 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B35C IS
+ 
+     TYPE FIXED IS DELTA 0.01 RANGE 0.0 .. 4.0;
+     ERR : BOOLEAN := FALSE;
+   
+     FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
+     BEGIN 
+          RETURN X;
+     END F1;
+       
+     FUNCTION F1 (X : INTEGER) RETURN FLOAT IS
+     BEGIN 
+          ERR := TRUE;
+          RETURN 1.0;
+     END F1;
+    
+     FUNCTION F1 (X : INTEGER) RETURN FIXED IS
+     BEGIN 
+          ERR := TRUE;
+          RETURN 1.0;
+     END F1;
+ 
+BEGIN
+     TEST ("C87B35C","EXPONENT OPERAND FOR FLOATING POINT " &
+           "EXPONENTIATION MUST BE OF TYPE PREDEFINED INTEGER");
+  
+     DECLARE
+          FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER
+               RENAMES STANDARD."*";
+    
+     BEGIN
+          IF ( FLOAT'(2.0) ** F1(3)   /= 8.0 OR
+               FLOAT'(2.0) ** (3 + 1) /= 8.0 ) THEN
+               FAILED ("EXPONENT OF FLOATING POINT EXPONENTIATION "
+                    & "MUST BE PREDEFINED INTEGER (A)");
+          END IF;
+          IF ( 2.0 ** F1(3)   /= FLOAT'(8.0) OR
+               2.0 ** (3 + 1) /= FLOAT'(8.0) ) THEN
+               FAILED ("EXPONENT OF FLOATING POINT EXPONENTIATION"
+                    & "MUST BE PREDEFINED INTEGER (B)");
+          END IF;
+          IF ERR THEN
+               FAILED ("EXPONENT OF FLOATING POINT EXPONENTIATION"
+                    & "MUST BE PREDEFINED INTEGER (C)");
+          END IF;
+     END;
+ 
+     RESULT;
+END C87B35C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b38a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b38a.ada
new file mode 100644
index 000000000..46ba65185
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b38a.ada
@@ -0,0 +1,76 @@
+-- C87B38A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+    
+-- IN A QUALIFIED EXPRESSION, THE OPERAND MUST HAVE THE SAME TYPE
+-- AS THE BASE TYPE OF THE TYPEMARK.
+  
+-- TRH  13 SEPT 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B38A IS
+ 
+     SUBTYPE BOOL IS BOOLEAN;
+     TYPE YES  IS NEW BOOLEAN RANGE TRUE  .. TRUE;
+     TYPE NO   IS NEW BOOLEAN RANGE FALSE .. FALSE;
+     TYPE BIT  IS NEW BOOLEAN;
+     TYPE LIT  IS (FALSE, TRUE);   
+     TYPE FLAG IS (PASS,  FAIL);
+ 
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          IF STAT = FAIL THEN 
+               FAILED ("RESOLUTION INCORRECT FOR OVERLOADED " &
+                       " OPERANDS OF QUALIFIED EXPRESSIONS");
+          END IF;
+          RETURN ARG;
+     END F1;
+  
+     FUNCTION F IS NEW F1 (LIT,     FALSE, FAIL);
+     FUNCTION F IS NEW F1 (BIT,     TRUE,  FAIL);
+     FUNCTION F IS NEW F1 (BOOLEAN, TRUE,  PASS);
+     FUNCTION F IS NEW F1 (YES,     TRUE,  FAIL);
+     FUNCTION F IS NEW F1 (NO,      FALSE, FAIL);
+    
+BEGIN
+     TEST ("C87B38A","OVERLOADED OPERANDS IN QUALIFIED EXPRESSIONS ");
+ 
+     DECLARE 
+          B : BOOL;
+ 
+     BEGIN
+          B := BOOL' (F);
+          B := BOOL' ((NOT F) OR ELSE (F AND THEN F));
+     END;
+ 
+     RESULT;
+END C87B38A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b39a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b39a.ada
new file mode 100644
index 000000000..75c855962
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b39a.ada
@@ -0,0 +1,106 @@
+-- C87B39A.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) AN OVERLOADED CALL CAN BE RESOLVED BECAUSE AN ALLOCATOR RETURNS
+--      AN ACCESS TYPE WHOSE DESIGNATED TYPE IS THE TYPE REFERRED TO IN
+--      THE ALLOCATOR.
+--
+--   B) IF THE NAME OF THE DESIGNATED TYPE IN AN ALLOCATOR DOES NOT
+--      UNIQUELY DETERMINE THE ACCESS TYPE OF AN ALLOCATOR, THE CONTEXT
+--      MUST DETERMINE THE TYPE.
+
+-- JBG 1/30/84
+
+WITH REPORT; USE REPORT;
+PROCEDURE C87B39A IS
+
+     TYPE S IS (M, F);
+     TYPE R (D : S) IS
+          RECORD NULL; END RECORD;
+     SUBTYPE M1 IS R(M);
+     SUBTYPE M2 IS R(M);
+
+     TYPE ACC_M1 IS ACCESS M1;
+     TYPE ACC_M2 IS ACCESS M2;
+     TYPE ACC_BOOL IS ACCESS BOOLEAN;
+     TYPE ACC_ACC_M1 IS ACCESS ACC_M1;
+     
+     TYPE WHICH IS (IS_M1, IS_M2, IS_BOOL);
+
+     PROCEDURE P (X : ACC_M1; RESOLUTION : WHICH) IS
+     BEGIN
+          IF RESOLUTION /= IS_M1 THEN
+               FAILED ("INCORRECT RESOLUTION -- ACC_M1");
+          END IF;
+     END P;    -- ACC_M1
+
+     PROCEDURE P (X : ACC_M2; RESOLUTION : WHICH) IS
+     BEGIN
+          IF RESOLUTION /= IS_M2 THEN
+               FAILED ("INCORRECT RESOLUTION -- ACC_M2");
+          END IF;
+     END P;    -- ACC_M2
+
+     PROCEDURE P (X : ACC_BOOL; RESOLUTION : WHICH) IS
+     BEGIN
+          IF RESOLUTION /= IS_BOOL THEN
+               FAILED ("INCORRECT RESOLUTION -- ACC_BOOL");
+          END IF;
+     END P;    -- ACC_BOOL
+
+     PROCEDURE P (X : ACC_ACC_M1; RESOLUTION : WHICH) IS
+     BEGIN
+          FAILED ("INCORRECT RESOLUTION -- ACC_ACC_M1");
+     END P;    -- ACC_ACC_M1
+
+     PROCEDURE Q (X : ACC_M1) IS
+     BEGIN
+          NULL;
+     END Q;    -- ACC_M1
+
+     PROCEDURE Q (X : ACC_BOOL) IS
+     BEGIN
+          FAILED ("INCORRECT RESOLUTION -- ACC_BOOL: Q");
+     END Q;    -- ACC_BOOL
+
+BEGIN
+
+     TEST ("C87B39A", "OVERLOADING RESOLUTION FOR ALLOCATORS");
+
+     P (ACC_M1'(NEW R(M)), IS_M1);    -- B
+
+     P (ACC_M2'(NEW M1), IS_M2);      -- B
+
+     P (NEW BOOLEAN'(TRUE), IS_BOOL); -- A
+
+     Q (NEW M2);              -- A
+     Q (NEW M1);              -- A
+     Q (NEW R(M));            -- A
+     Q (NEW R'(D => M));      -- A
+
+     RESULT;
+
+END C87B39A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b40a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b40a.ada
new file mode 100644
index 000000000..5fd04a16b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b40a.ada
@@ -0,0 +1,106 @@
+-- C87B40A.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 OVERLOADING RESOLUTION USES THE FOLLOWING RULES:
+--
+-- THE SAME OPERATIONS ARE PREDEFINED FOR THE TYPE UNIVERSAL_INTEGER
+-- AS FOR ANY INTEGER TYPE. THE SAME OPERATIONS ARE PREDEFINED FOR THE
+-- TYPE UNIVERSAL_REAL AS FOR ANY FLOATING POINT TYPE. IN ADDITION
+-- THESE OPERATIONS INCLUDE THE FOLLOWING MULTIPLICATION AND DIVISION
+-- OPERATORS:
+--
+--   "*" (UNIVERSAL_REAL, UNIVERSAL_INTEGER) RETURN UNIVERSAL_REAL
+--   "*" (UNIVERSAL_INTEGER, UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
+--   "*" (UNIVERSAL_REAL,    UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
+--   "*" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
+--   "/" (UNIVERSAL_REAL, UNIVERSAL_INTEGER) RETURN UNIVERSAL_REAL
+--  "**" (UNIVERSAL_INTEGER, INTEGER) RETURN UNIVERSAL_INTEGER
+--  "**" (UNIVERSAL_REAL, INTEGER) RETURN UNIVERSAL_REAL
+-- "MOD" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
+-- "DIV" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
+-- "ABS" (UNIVERSAL_INTEGER) RETURN UNIVERSAL INTEGER
+-- "ABS" (UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
+
+-- TRH  15 SEPT 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B40A IS
+  
+     ERR : BOOLEAN := FALSE;
+     B : ARRAY (1 .. 12) OF BOOLEAN := (1 .. 12 => TRUE);
+
+     FUNCTION "-" (X : INTEGER) RETURN INTEGER
+          RENAMES STANDARD."+";
+
+     FUNCTION "+" (X : INTEGER) RETURN INTEGER IS
+     BEGIN 
+          ERR := TRUE;
+          RETURN X;
+     END "+";
+ 
+     FUNCTION "+" (X : FLOAT) RETURN FLOAT IS
+     BEGIN 
+          ERR := TRUE;
+          RETURN X;
+     END "+";
+ 
+BEGIN
+     TEST ("C87B40A","OVERLOADING RESOLUTION OF UNIVERSAL " &
+           "EXPRESSIONS");
+ 
+     B(1)  := 1.0 * (+1) IN 0.0 .. 0.0;       -- 1.0 * 1
+     B(2)  := (+1) * 1.0 IN 0.0 .. 0.0;       -- 1 * 1.0
+     B(3)  := 1.0 / (+1) IN 0.0 .. 0.0;       -- 1.0 / 1
+     B(4)  := (+1)  +  (+1) <= (+1)  -  (+1); -- 1+1< 1 - 1
+     B(5)  := (+1)  *  (+1) >  (+1)  /  (+1); -- 1*1 > 1/1
+     B(6)  := (+1) MOD (+1) /= (+1) REM (+1); -- 1 MOD 1 /= 1 REM 1
+
+     BEGIN
+          B(7)  := (+2) **  (-2) <  "-"  (-1);     -- 2**2 < 1
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED("INCORRECT RESOLUTION FOR INTEGER EXPONENT - 7");
+     END;
+
+     B(8)  := (+1) REM (+1) > "ABS" (+1);     -- 1 REM 1 > ABS 1
+     B(9)  := (+1.0)  +  (+1.0) <= (+1.0)  -  (+1.0); -- 2.0 <= 0.0
+     B(10) := (+1.0)  *  (+1.0) >  (+1.0)  /  (+1.0); -- 1.0 > 1.0
+     B(11) := (+2.0) **  (-1)   <  "-"  (-1.0);       -- 2.0 < 1.0
+     B(12) := (+2.0) **  (-1)  <= "ABS" (+1.0);       -- 2.0 <= 1.0
+
+     FOR I IN B'RANGE
+     LOOP
+          IF B(I) /= FALSE THEN
+               FAILED("RESOLUTION OR OPERATIONS INCORRECT FOR "
+               & "UNIVERSAL EXPRESSIONS - " & INTEGER'IMAGE(I) );
+          END IF;
+     END LOOP;
+ 
+     IF ERR THEN 
+          FAILED ("RESOLUTION INCORRECT FOR UNIVERSAL EXPRESSIONS");
+     END IF;
+ 
+     RESULT;
+END C87B40A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b41a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b41a.ada
new file mode 100644
index 000000000..ae60c8d51
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b41a.ada
@@ -0,0 +1,112 @@
+-- C87B41A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE NAMED VARIABLE AND THE RIGHT HAND SIDE EXPRESSION
+-- IN AN ASSIGNMENT STATEMENT MUST BE OF THE SAME TYPE. THIS TYPE
+-- MUST NOT BE A LIMITED TYPE.
+  
+-- TRH  15 SEPT 82
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B41A IS
+     
+     TYPE NOTE IS (A, B, C, D, E, F, G);
+     TYPE POSITIVE IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
+     TYPE ACC_CHAR IS ACCESS CHARACTER;
+     TYPE ACC_DUR  IS ACCESS DURATION;
+     TYPE ACC_POS  IS ACCESS POSITIVE;
+     TYPE ACC_INT  IS ACCESS INTEGER;
+     TYPE ACC_BOOL IS ACCESS BOOLEAN;
+     TYPE ACC_STR  IS ACCESS STRING;
+     TYPE ACC_FLT  IS ACCESS FLOAT;
+     TYPE ACC_NOTE IS ACCESS NOTE;
+   
+     TYPE NEW_CHAR IS NEW CHARACTER;
+     TYPE NEW_DUR  IS NEW DURATION;
+     TYPE NEW_POS  IS NEW POSITIVE;
+     TYPE NEW_INT  IS NEW INTEGER;
+     TYPE NEW_BOOL IS NEW BOOLEAN;
+     TYPE NEW_FLT  IS NEW FLOAT;
+     TYPE NEW_NOTE IS NEW NOTE RANGE A .. F;
+     TASK TYPE T;
+   
+     TASK BODY T IS
+     BEGIN
+          NULL;
+     END T;
+  
+     FUNCTION G RETURN T IS
+          T1 : T;
+     BEGIN
+          FAILED ("LIMITED TYPES MAY NOT OCCUR IN ASSIGNMENT " &
+                  "STATEMENTS");
+          RETURN T1;
+     END G;
+  
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          FAILED ("RESOLUTION INCORRECT - RIGHT HAND SIDE OF " &
+                  "ASSIGNMENT STATEMENT MUST MATCH TYPE OF VARIABLE");
+          RETURN ARG;
+     END F1;
+  
+     FUNCTION F IS NEW F1 (ACC_CHAR, NEW CHARACTER);
+     FUNCTION F IS NEW F1 (ACC_DUR,  NEW DURATION);
+     FUNCTION F IS NEW F1 (ACC_POS,  NEW POSITIVE);
+     FUNCTION F IS NEW F1 (ACC_INT,  NEW INTEGER);
+     FUNCTION F IS NEW F1 (ACC_BOOL, NEW BOOLEAN);
+     FUNCTION F IS NEW F1 (ACC_STR,  NEW STRING(1..2) );
+     FUNCTION F IS NEW F1 (ACC_FLT,  NEW FLOAT);
+
+     FUNCTION F RETURN ACC_NOTE IS
+     BEGIN
+          RETURN  (NEW NOTE);
+     END F;
+ 
+     FUNCTION G IS NEW F1 (NEW_CHAR, 'G');
+     FUNCTION G IS NEW F1 (NEW_DUR,  1.0);
+     FUNCTION G IS NEW F1 (NEW_POS,  +10);
+     FUNCTION G IS NEW F1 (NEW_INT,  -10);
+     FUNCTION G IS NEW F1 (NEW_BOOL, TRUE);
+     FUNCTION G IS NEW F1 (NEW_FLT,  1.0);
+     FUNCTION G IS NEW F1 (NEW_NOTE, F);
+    
+BEGIN
+     TEST ("C87B41A","OVERLOADED CONSTRUCTS ON BOTH SIDES OF THE " &
+           "ASSIGNMENT STATEMENT");
+ 
+     F.ALL := G;
+    
+     RESULT;
+ 
+END C87B41A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b42a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b42a.ada
new file mode 100644
index 000000000..9365d5852
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b42a.ada
@@ -0,0 +1,77 @@
+-- C87B42A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- A CONDITIONAL EXPRESSION MUST BE OF A BOOLEAN TYPE.
+  
+-- TRH  27 JULY 82
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B42A IS
+ 
+     TYPE BIT     IS NEW BOOLEAN;
+     TYPE BOOLEAN IS (FALSE, TRUE);
+     TYPE LIT     IS (FALSE, TRUE);
+     TYPE FLAG    IS (PASS, FAIL);
+ 
+     GENERIC 
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS 
+     BEGIN
+          IF STAT = FAIL THEN 
+               FAILED ("CONDITIONAL EXPRESSION MUST BE OF A BOOLEAN" &
+                       " TYPE");
+          END IF;
+          RETURN ARG;
+     END F1;
+ 
+     FUNCTION F IS NEW F1 (BOOLEAN, FALSE,  FAIL);
+     FUNCTION F IS NEW F1 (BIT,     FALSE,  PASS);
+     FUNCTION F IS NEW F1 (LIT,     FALSE,  FAIL);
+     FUNCTION F IS NEW F1 (INTEGER,   -11,  FAIL);
+     FUNCTION F IS NEW F1 (FLOAT,    +0.0,  FAIL);
+    
+BEGIN
+     TEST ("C87B42A","OVERLOADED CONDITIONAL EXPRESSIONS");
+ 
+     WHILE (F OR NOT F)
+     LOOP
+          IF (F OR ELSE NOT F) THEN
+               NULL;
+          END IF;
+          EXIT WHEN (F AND NOT F);
+          EXIT WHEN (F OR  NOT F);
+          EXIT WHEN (F);
+          EXIT WHEN (NOT F);
+     END LOOP;
+ 
+     RESULT;
+END C87B42A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b43a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b43a.ada
new file mode 100644
index 000000000..9bb11fd6e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b43a.ada
@@ -0,0 +1,60 @@
+-- C87B43A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- IN A CASE STATEMENT, THE TYPE OF EACH CHOICE MUST MATCH THE TYPE 
+-- OF THE EXPRESSION.
+  
+-- TRH  3 AUG 82
+-- DSJ 10 JUN 83
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B43A IS
+     
+     TYPE WHOLE IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+ 
+     FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER 
+          RENAMES "*";
+ 
+     ERR : BOOLEAN := FALSE;
+     X   : WHOLE   := 6;
+  
+BEGIN
+     TEST ("C87B43A","TYPE OF CASE CHOICE MUST MATCH TYPE OF " &
+           "EXPRESSION");
+   
+     CASE X IS
+          WHEN (2 + 3) => ERR := TRUE;
+          WHEN (3 + 3) => NULL; 
+          WHEN OTHERS  => ERR := TRUE;
+     END CASE;
+ 
+     IF ERR THEN
+        FAILED ("CASE STATEMENT CHOICE MUST MATCH TYPE OF EXPRESSION");
+     END IF;
+    
+     RESULT;
+END C87B43A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b44a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b44a.ada
new file mode 100644
index 000000000..66acd0340
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b44a.ada
@@ -0,0 +1,112 @@
+-- C87B44A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE TYPE OF THE EXPRESSION IN A RETURN STATEMENT MUST MATCH THE
+-- EXPLICIT TYPEMARK IN THE RETURN CLAUSE OF THE FUNCTION'S
+-- SPECIFICATION.
+--
+-- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+-- 
+--    (A): A CALL TO AN OVERLOADED FUNCTION.
+--    (B): AN OVERLOADED OPERATOR SYMBOL.
+--    (C): AN OVERLOADED (INFIX) OPERATOR.
+--    (D): AN OVERLOADED ENUMERATION LITERAL.
+  
+-- TRH  25 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B44A IS
+  
+     TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+     TYPE CITRUS IS (LEMON, LIME, ORANGE);
+     TYPE HUE    IS (RED, ORANGE, YELLOW);
+     
+     FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN -1;
+     END F1;
+
+     FUNCTION "*" (X, Y : WHOLE) RETURN WHOLE IS
+     BEGIN
+          RETURN 0;
+     END "*";
+    
+     FUNCTION "*" (X, Y : INTEGER) RETURN HUE IS
+     BEGIN
+          RETURN ORANGE;
+     END "*";
+
+     FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+   
+BEGIN
+     TEST ("C87B44A","OVERLOADED EXPRESSIONS IN RETURN STATEMENTS");
+     DECLARE
+
+          FUNCTION F2 (X, Y : INTEGER) RETURN INTEGER IS
+          BEGIN
+               RETURN F1 (X, Y);
+          END F2;
+   
+          FUNCTION F2 (X, Y : WHOLE) RETURN WHOLE IS
+          BEGIN
+               RETURN "*" (X, Y);
+          END F2;
+   
+          FUNCTION F2 (X, Y : INTEGER) RETURN HUE IS
+          BEGIN
+               RETURN (X * Y);
+          END F2;
+   
+          FUNCTION F2 (X, Y : INTEGER) RETURN CITRUS IS
+          BEGIN
+               RETURN ORANGE;
+          END F2;
+   
+
+     BEGIN
+          IF INTEGER'(F2 (0, 0)) /= -1 THEN
+             FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+          END IF;
+    
+          IF WHOLE'(F2 (0, 0)) /= 0 THEN
+             FAILED ("(B): RESOLUTION INCORRECT - OPERATOR SYMBOL");
+          END IF;
+    
+          IF HUE'POS (F2 (0, 0)) /= 1 THEN 
+             FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+          END IF;
+    
+          IF CITRUS'POS (F2 (0, 0)) /= 2 THEN 
+             FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION LITERAL");
+          END IF;
+     END;
+    
+     RESULT;
+END C87B44A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b45a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b45a.ada
new file mode 100644
index 000000000..497de84f7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b45a.ada
@@ -0,0 +1,126 @@
+-- C87B45A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- FOR A DEFAULT SUBPROGRAM PARAMETER, THE TYPE OF THE INITIALIZATION
+-- EXPRESSION MUST MATCH THE PARAMETERS'S EXPLICIT TYPEMARK.
+--      
+-- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+-- 
+--    (A): A CALL TO AN OVERLOADED FUNCTION.
+--    (B): AN OVERLOADED OPERATOR SYMBOL.
+--    (C): AN OVERLOADED (INFIX) OPERATOR.
+--    (D): AN OVERLOADED ENUMERATION LITERAL.
+  
+-- TRH  24 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B45A IS
+  
+     TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+     TYPE CITRUS IS (LEMON, LIME, ORANGE);
+     TYPE HUE    IS (RED, ORANGE, YELLOW);
+     
+     FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN -1;
+     END F1;
+
+     FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+     BEGIN
+          RETURN 0;
+     END F1;
+    
+     FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+
+     FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+   
+BEGIN
+     TEST ("C87B45A","OVERLOADED INITIALIZATION EXPRESSIONS" &
+           " IN DEFAULT SUBPROGRAM PARAMETERS");
+     DECLARE
+
+          FUNCTION "/" (X, Y : INTEGER) RETURN INTEGER
+               RENAMES F1;
+    
+          FUNCTION "/" (X, Y : WHOLE)   RETURN WHOLE
+               RENAMES F1;
+     
+          FUNCTION "/" (X, Y : INTEGER) RETURN HUE
+               RENAMES F1;
+   
+          FUNCTION "/" (X, Y : INTEGER) RETURN CITRUS
+               RENAMES F1;
+      
+          PROCEDURE P1 (I1 : INTEGER := F1  (0, 0);
+                        W1 : WHOLE   := F1  (0, 0);
+                        C1 : CITRUS  := F1  (0, 0);
+                        H1 : HUE     := F1  (0, 0);
+                        I2 : INTEGER := "/" (0, 0);
+                        W2 : WHOLE   := "/" (0, 0);
+                        C2 : CITRUS  := "/" (0, 0);
+                        H2 : HUE     := "/" (0, 0);
+                        I3 : INTEGER := (0 / 0);
+                        W3 : WHOLE   := (0 / 0);
+                        C3 : CITRUS  := (0 / 0);
+                        H3 : HUE     := (0 / 0);
+                        C4 : CITRUS  := ORANGE;
+                        H4 : HUE     := ORANGE)  IS
+          BEGIN
+               IF I1              /= -1 OR W1           /= 0 OR
+                  CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
+                  FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+               END IF;
+    
+               IF I2              /= -1 OR W2           /= 0 OR
+                  CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
+                  FAILED ("(B): RESOLUTION INCORRECT " &
+                          "- OPERATOR SYMBOL");
+               END IF;
+    
+               IF I3              /= -1 OR W3           /= 0 OR
+                  CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
+                  FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+               END IF;
+    
+               IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
+                  FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION " &
+                          "LITERAL");
+               END IF;
+          END P1;
+
+     BEGIN
+          P1;
+     END;
+    
+     RESULT;
+END C87B45A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b45c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b45c.ada
new file mode 100644
index 000000000..d70687a7e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b45c.ada
@@ -0,0 +1,148 @@
+-- C87B45C.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- FOR A DEFAULT ENTRY PARAMETER, THE TYPE OF THE INITIALIZATION
+-- EXPRESSION MUST MATCH THE PARAMETERS'S EXPLICIT TYPEMARK.
+--      
+-- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+-- 
+--    (A): A CALL TO AN OVERLOADED FUNCTION.
+--    (B): AN OVERLOADED OPERATOR SYMBOL.
+--    (C): AN OVERLOADED (INFIX) OPERATOR.
+--    (D): AN OVERLOADED ENUMERATION LITERAL.
+  
+-- TRH  7 JULY 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B45C IS
+  
+     TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+     TYPE CITRUS IS (LEMON, LIME, ORANGE);
+     TYPE HUE    IS (RED, ORANGE, YELLOW);
+     
+     FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN -1;
+     END F1;
+
+     FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+     BEGIN
+          RETURN 0;
+     END F1;
+    
+     FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+
+     FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+   
+BEGIN
+     TEST ("C87B45C","OVERLOADED INITIALIZATION EXPRESSIONS" &
+           " IN DEFAULT ENTRY PARAMETERS");
+     DECLARE
+
+          FUNCTION "*" (X, Y : INTEGER) RETURN INTEGER
+               RENAMES F1;
+    
+          FUNCTION "*" (X, Y : WHOLE)   RETURN WHOLE
+               RENAMES F1;
+     
+          FUNCTION "*" (X, Y : INTEGER) RETURN HUE
+               RENAMES F1;
+   
+          FUNCTION "*" (X, Y : INTEGER) RETURN CITRUS
+               RENAMES F1;
+      
+          TASK T1 IS
+               ENTRY E1 (I1 : INTEGER := F1  (0, 0);
+                         W1 : WHOLE   := F1  (0, 0);
+                         C1 : CITRUS  := F1  (0, 0);
+                         H1 : HUE     := F1  (0, 0);
+                         I2 : INTEGER := "*" (0, 0);
+                         W2 : WHOLE   := "*" (0, 0);
+                         C2 : CITRUS  := "*" (0, 0);
+                         H2 : HUE     := "*" (0, 0);
+                         I3 : INTEGER := (0 * 0);
+                         W3 : WHOLE   := (0 * 0);
+                         C3 : CITRUS  := (0 * 0);
+                         H3 : HUE     := (0 * 0);
+                         C4 : CITRUS  := ORANGE;
+                         H4 : HUE     := ORANGE);  
+          END T1;
+    
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT E1 (I1 : INTEGER := F1  (0, 0);
+                          W1 : WHOLE   := F1  (0, 0);
+                          C1 : CITRUS  := F1  (0, 0);
+                          H1 : HUE     := F1  (0, 0);
+                          I2 : INTEGER := "*" (0, 0);
+                          W2 : WHOLE   := "*" (0, 0);
+                          C2 : CITRUS  := "*" (0, 0);
+                          H2 : HUE     := "*" (0, 0);
+                          I3 : INTEGER := (0 * 0);
+                          W3 : WHOLE   := (0 * 0);
+                          C3 : CITRUS  := (0 * 0);
+                          H3 : HUE     := (0 * 0);
+                          C4 : CITRUS  := ORANGE;
+                          H4 : HUE     := ORANGE) DO
+    
+                    IF I1              /= -1 OR W1           /= 0 OR
+                       CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
+                       FAILED ("(A): RESOLUTION INCORRECT - FUNCTION");
+                    END IF;
+    
+                    IF I2              /= -1 OR W2           /= 0 OR
+                       CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
+                       FAILED ("(B): RESOLUTION INCORRECT " &
+                               "- OPERATOR SYMBOL");
+                    END IF;
+    
+                    IF I3              /= -1 OR W3           /= 0 OR
+                       CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
+                       FAILED ("(C): RESOLUTION INCORRECT - INFIX " &
+                               "OPERATOR");
+                    END IF;
+    
+                    IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
+                       FAILED ("(D): RESOLUTION INCORRECT - " &
+                          "ENUMERATION LITERAL");
+                    END IF;
+   
+               END E1;
+          END T1;
+
+     BEGIN
+          T1.E1;
+     END;
+    
+     RESULT;
+END C87B45C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b47a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b47a.ada
new file mode 100644
index 000000000..c9a426f10
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b47a.ada
@@ -0,0 +1,74 @@
+-- C87B47A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- ACTUAL PARAMETERS MUST MATCH THE EXPLICIT TYPEMARK OF THE
+-- PARAMETER.
+  
+-- TRH  8 AUG 82
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B47A IS
+ 
+     TYPE FLAG IS (PASS, FAIL);
+     
+     GENERIC
+          TYPE T IS PRIVATE;
+          ARG  : IN T;
+          STAT : IN FLAG;
+     FUNCTION F1 RETURN T;
+ 
+     FUNCTION F1 RETURN T IS
+     BEGIN 
+          IF STAT = FAIL THEN 
+             FAILED ("ACTUAL PARAMETER MUST MATCH PARAMETER TYPE");
+          END IF;
+          RETURN ARG;
+     END F1;
+  
+     FUNCTION F IS NEW F1 (FLOAT,     2.0, PASS);
+     FUNCTION F IS NEW F1 (INTEGER,     5, FAIL);
+     FUNCTION F IS NEW F1 (BOOLEAN,  TRUE, FAIL);
+     FUNCTION F IS NEW F1 (DURATION,  1.0, FAIL);
+     FUNCTION F IS NEW F1 (CHARACTER, 'E', FAIL);
+    
+BEGIN
+     TEST ("C87B47A","OVERLOADED ACTUAL PARAMETERS");
+    
+     DECLARE
+          PROCEDURE P (X : FLOAT) IS
+          BEGIN
+               NULL;
+          END P;
+   
+     BEGIN
+          P (F);
+          P (X => F);
+     END;
+ 
+     RESULT;
+END C87B47A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b48a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b48a.ada
new file mode 100644
index 000000000..d8d79b5c3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b48a.ada
@@ -0,0 +1,94 @@
+-- C87B48A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- NAMED ACTUAL PARAMETERS CAN RESOLVE OVERLOADING OF SUBPROGRAMS.
+-- THIS TEST USES FUNCTIONS AND OPERATOR SYMBOLS ONLY.
+  
+-- TRH  13 AUG 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B48A IS
+ 
+     ERR, B1, B2 : BOOLEAN := FALSE;
+ 
+     PACKAGE A IS
+          FUNCTION "-"    (X : BOOLEAN) RETURN BOOLEAN;
+          FUNCTION TOGGLE (X : BOOLEAN) RETURN BOOLEAN
+               RENAMES "-";
+     END A;
+     
+     PACKAGE BODY A IS
+          FUNCTION "-" (X : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               RETURN NOT X;
+          END "-";
+     END A;
+ 
+     PACKAGE B IS
+          FUNCTION "-"    (Y : BOOLEAN) RETURN BOOLEAN;
+          FUNCTION TOGGLE (Y : BOOLEAN) RETURN BOOLEAN
+               RENAMES "-";
+     END B;
+     
+     PACKAGE BODY B IS
+          FUNCTION "-" (Y : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               ERR := TRUE;
+               RETURN NOT Y;
+          END "-";
+     END B;
+ 
+     PACKAGE C IS
+          FUNCTION "-"    (Z : BOOLEAN) RETURN BOOLEAN;
+          FUNCTION TOGGLE (Z : BOOLEAN) RETURN BOOLEAN
+               RENAMES "-";
+     END C;
+     
+     PACKAGE BODY C IS
+          FUNCTION "-" (Z : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN
+               ERR := TRUE;
+               RETURN NOT Z;
+          END "-";
+     END C;
+   
+     USE A, B, C;
+ 
+BEGIN
+     TEST ("C87B48A","RESOLUTION OF OVERLOADED SUBPROGRAMS BY NAMED " &
+           "ACTUAL PARAMETERS");
+ 
+     B1 := "-"    (X => FALSE);
+     B2 := TOGGLE (X => FALSE);
+   
+     IF ERR OR ELSE NOT B1 OR ELSE NOT B2 THEN 
+          FAILED ("RESOLUTION INCORRECT FOR OVERLOADED SUBPROGRAMS" &
+                  " WITH NAMED ACTUAL PARAMETERS");
+     END IF;
+ 
+     RESULT;
+END C87B48A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b48b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b48b.ada
new file mode 100644
index 000000000..45037ecd9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b48b.ada
@@ -0,0 +1,72 @@
+-- C87B48B.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- POSITIONAL ACTUAL PARAMETERS CAN RESOLVE OVERLOADING OF SUBPROGRAMS.
+  
+-- TRH  16 AUG 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B48B IS
+ 
+     TYPE FLAG IS (PASS, FAIL);
+     TYPE INT  IS NEW INTEGER;
+     TYPE BIT  IS NEW BOOLEAN;
+     TYPE WHL  IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+     
+     GENERIC
+          TYPE T1 IS PRIVATE;
+          TYPE T2 IS PRIVATE;
+          TYPE T3 IS PRIVATE;
+          TYPE T4 IS PRIVATE;
+          STAT : IN FLAG;
+     PROCEDURE P1 (W : T1; X : T2; Y : T3; Z : T4);
+ 
+     PROCEDURE P1 (W : T1; X : T2; Y : T3; Z : T4) IS
+     BEGIN 
+          IF STAT = FAIL THEN 
+               FAILED ("RESOLUTION INCORRECT FOR OVERLOADED SUB" &
+                       "PROGRAMS WITH POSITIONAL ACTUAL PARAMETERS");
+          END IF;
+     END P1;
+  
+     PROCEDURE P IS NEW P1 (WHL, INT, WHL, BIT, PASS);
+     PROCEDURE P IS NEW P1 (WHL, WHL, BIT, INT, FAIL);
+     PROCEDURE P IS NEW P1 (WHL, INT, BIT, WHL, FAIL);
+     PROCEDURE P IS NEW P1 (INT, BIT, WHL, WHL, FAIL);
+     PROCEDURE P IS NEW P1 (BIT, WHL, WHL, INT, FAIL);
+     PROCEDURE P IS NEW P1 (BIT, INT, WHL, WHL, FAIL);
+    
+BEGIN
+     TEST ("C87B48B","OVERLOADING RESOLUTION OF SUBPROGRAMS WITH" &
+           " POSITIONAL ACTUAL PARAMETERS");
+    
+     BEGIN
+          P (0, 0, 0, TRUE);
+     END;
+ 
+     RESULT;
+END C87B48B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b50a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b50a.ada
new file mode 100644
index 000000000..ee287af1d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b50a.ada
@@ -0,0 +1,64 @@
+-- C87B50A.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 FUNCTION RENAMING DECLARATION CAN RESOLVE AND RENAME AN
+-- OVERLOADED ENUMERATION LITERAL.
+
+-- GOM 11/29/84
+-- JWC 7/12/85
+-- PWB 03/06/86  CORRECTED ERROR: ADDED "USE" CLAUSE TO MAKE
+--               "/=" VISIBLE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C87B50A IS
+
+BEGIN
+     TEST ("C87B50A", "CHECK THAT A FUNCTION RENAMING DECLARATION " &
+                      "CAN RESOLVE AND RENAME AN OVERLOADED " &
+                      "ENUMERATION LITERAL");
+
+     DECLARE
+
+          PACKAGE A IS
+               TYPE COLORS IS (RED,GREEN);
+               TYPE LIGHT  IS (BLUE,RED);
+          END A;
+
+          PACKAGE B IS
+               FUNCTION RED RETURN A.COLORS RENAMES A.RED;
+               FUNCTION GREEN RETURN A.COLORS RENAMES A.GREEN;
+          END B;
+
+          USE A;      -- TO MAKE /= VISIBLE.
+
+     BEGIN
+
+          IF (A.RED /= B.RED) OR (A.GREEN /= B.GREEN) THEN
+               FAILED ("RENAMED VALUES NOT EQUAL");
+          END IF;
+
+     END;
+
+     RESULT;
+END C87B50A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b54a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b54a.ada
new file mode 100644
index 000000000..26b4b1498
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b54a.ada
@@ -0,0 +1,87 @@
+-- C87B54A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- THE ARGUMENT OF THE DELAY STATEMENT IS OF THE PREDEFINED FIXED 
+-- POINT TYPE DURATION.
+  
+-- TRH  7 SEPT 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B54A IS
+ 
+     TYPE TEMPS  IS NEW DURATION;
+     TYPE REAL   IS NEW FLOAT;
+     TYPE TEMPUS IS DELTA 0.1 RANGE -1.0 .. 1.0;
+     ERR : BOOLEAN := FALSE;
+ 
+     FUNCTION F (X : TEMPS) RETURN TEMPS IS
+     BEGIN
+          ERR := TRUE;
+          RETURN X;
+     END F;
+    
+     FUNCTION F (X : REAL) RETURN REAL IS
+     BEGIN
+          ERR := TRUE;
+          RETURN X;
+     END F;
+ 
+     FUNCTION F (X : TEMPUS) RETURN TEMPUS IS
+     BEGIN
+          ERR := TRUE;
+          RETURN X;
+     END F;
+    
+     FUNCTION F (X : DURATION) RETURN DURATION IS
+     BEGIN
+          RETURN X;
+     END F;
+    
+BEGIN
+     TEST ("C87B54A","OVERLOADED EXPRESSION WITHIN DELAY STATEMENT");
+    
+     DECLARE
+          TASK T IS
+               ENTRY E;
+          END T;
+  
+          TASK BODY T IS
+          BEGIN
+               DELAY F (0.0);
+               DELAY F (1.0);
+               DELAY F (-1.0);
+          END T;
+  
+     BEGIN
+          IF ERR THEN FAILED ("DELAY STATEMENT TAKES AN ARGUMENT OF " &
+                              "THE PREDEFINED FIXED POINT TYPE " &
+                              "DURATION");
+          END IF;
+     END;
+ 
+     RESULT;
+END C87B54A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b57a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b57a.ada
new file mode 100644
index 000000000..31d3b8ad5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b57a.ada
@@ -0,0 +1,134 @@
+-- C87B57A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+-- FOR A DEFAULT GENERIC IN PARAMETER, THE TYPE OF THE INITIALIZATION
+-- EXPRESSION MUST MATCH THE PARAMETERS'S EXPLICIT TYPEMARK.
+--      
+-- THE FOUR KINDS OF EXPRESSIONS TESTED HERE ARE:
+-- 
+--    (A): A CALL TO AN OVERLOADED FUNCTION.
+--    (B): AN OVERLOADED OPERATOR SYMBOL.
+--    (C): AN OVERLOADED (INFIX) OPERATOR.
+--    (D): AN OVERLOADED ENUMERATION LITERAL.
+  
+-- TRH  25 JUNE 82
+  
+WITH REPORT; USE REPORT;
+   
+PROCEDURE C87B57A IS
+  
+     TYPE WHOLE  IS NEW INTEGER RANGE 0..INTEGER'LAST;
+     TYPE CITRUS IS (LEMON, LIME, ORANGE);
+     TYPE HUE    IS (RED, ORANGE, YELLOW);
+     
+     FUNCTION F1 (X, Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN -1;
+     END F1;
+
+     FUNCTION F1 (X, Y : WHOLE) RETURN WHOLE IS
+     BEGIN
+          RETURN 0;
+     END F1;
+    
+     FUNCTION F1 (X, Y : INTEGER) RETURN HUE IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+
+     FUNCTION F1 (X, Y : INTEGER) RETURN CITRUS IS
+     BEGIN
+          RETURN ORANGE;
+     END F1;
+   
+BEGIN
+     TEST ("C87B57A","OVERLOADED INITIALIZATION EXPRESSIONS" &
+           " IN DEFAULT GENERIC IN PARAMETERS");
+     DECLARE
+
+          FUNCTION "/" (X, Y : INTEGER) RETURN INTEGER
+               RENAMES F1;
+    
+          FUNCTION "/" (X, Y : WHOLE)   RETURN WHOLE
+               RENAMES F1;
+     
+          FUNCTION "/" (X, Y : INTEGER) RETURN HUE
+               RENAMES F1;
+   
+          FUNCTION "/" (X, Y : INTEGER) RETURN CITRUS
+               RENAMES F1;
+      
+          GENERIC
+               I1 : INTEGER := F1  (0, 0);
+               W1 : WHOLE   := F1  (0, 0);
+               C1 : CITRUS  := F1  (0, 0);
+               H1 : HUE     := F1  (0, 0);
+               I2 : INTEGER := "/" (0, 0);
+               W2 : WHOLE   := "/" (0, 0);
+               C2 : CITRUS  := "/" (0, 0);
+               H2 : HUE     := "/" (0, 0);
+               I3 : INTEGER := (0 / 0);
+               W3 : WHOLE   := (0 / 0);
+               C3 : CITRUS  := (0 / 0);
+               H3 : HUE     := (0 / 0);
+               C4 : CITRUS  := ORANGE;
+               H4 : HUE     := ORANGE;
+ 
+          PACKAGE P IS
+          END P;
+  
+          PACKAGE BODY P IS
+          BEGIN
+               IF I1              /= -1 OR W1           /= 0 OR
+                  CITRUS'POS (C1) /=  2 OR HUE'POS (H1) /= 1 THEN
+                  FAILED ("(A): RESOLUTION INCORRECT - FUNCTION CALL");
+               END IF;
+    
+               IF I2              /= -1 OR W2           /= 0 OR
+                  CITRUS'POS (C2) /=  2 OR HUE'POS (H2) /= 1 THEN
+                  FAILED ("(B): RESOLUTION INCORRECT " &
+                          "- OPERATOR SYMBOL");
+               END IF;
+    
+               IF I3              /= -1 OR W3           /= 0 OR
+                  CITRUS'POS (C3) /=  2 OR HUE'POS (H3) /= 1 THEN
+                  FAILED ("(C): RESOLUTION INCORRECT - INFIX OPERATOR");
+               END IF;
+    
+               IF CITRUS'POS (C4) /=  2 OR HUE'POS (H4) /= 1 THEN
+                  FAILED ("(D): RESOLUTION INCORRECT - ENUMERATION " &
+                          "LITERAL");
+               END IF;
+          END P;
+  
+          PACKAGE P1 IS NEW P;
+  
+     BEGIN 
+          NULL;
+     END;
+    
+     RESULT;
+END C87B57A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62a.ada
new file mode 100644
index 000000000..550d20bbf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62a.ada
@@ -0,0 +1,79 @@
+-- C87B62A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+--       IN A LENGTH CLAUSE THAT SPECIFIES 'SIZE,
+--       THE EXPRESSION MUST BE OF SOME INTEGER TYPE.
+
+-- HISTORY:
+--     TRH 09/08/82  CREATED ORIGINAL TEST.
+--     PWB 02/19/85  ADDED COMMENTS CLARIFYING NON-APPLICABILITY;
+--                   DELETED TEXT NOT RELATED TO TEST OBJECTIVE.
+--     BCB 01/04/88  MODIFIED HEADER.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C87B62A IS
+
+     TYPE POS_INT IS RANGE 1 .. INTEGER'LAST;
+     TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
+     ERR : BOOLEAN := FALSE;
+
+     FUNCTION "+" (X : POS_INT) RETURN POS_FIX IS
+     BEGIN
+          ERR := TRUE;
+          RETURN POS_FIX (X);
+     END "+";
+
+     FUNCTION "+" (X : POS_FIX) RETURN POS_INT IS
+     BEGIN
+          ERR := TRUE;
+          RETURN POS_INT (X);
+     END "+";
+
+BEGIN
+     TEST ("C87B62A","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
+           "- SPECIFICATION OF ATTRIBUTE T'SIZE");
+
+     DECLARE
+          TYPE DECEM IS NEW INTEGER RANGE    1 .. 10;
+          TYPE JUST_LIKE_DECEM IS NEW INTEGER RANGE 1 .. 10;
+          DECEM_SIZE :  CONSTANT  := JUST_LIKE_DECEM'SIZE;
+          TYPE CHECK IS NEW INTEGER RANGE 1 .. 10;
+
+          FOR CHECK'SIZE USE DECEM_SIZE;
+          FOR DECEM'SIZE        USE + DECEM_SIZE;
+
+     BEGIN
+          IF ERR THEN
+               FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
+                       "LENGTH CLAUSE USING 'SIZE");
+          END IF;
+     END;
+
+     RESULT;
+END C87B62A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62b.ada
new file mode 100644
index 000000000..2b03442a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62b.ada
@@ -0,0 +1,99 @@
+-- C87B62B.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+--       IN A LENGTH CLAUSE THAT SPECIFIES 'STORAGE_SIZE,
+--       THE EXPRESSION MUST BE OF SOME INTEGER TYPE.
+--       ACCESS TYPES ARE HERE; TASK TYPES ARE IN C87B62D.DEP.
+
+-- HISTORY:
+--     TRH 09/08/82  CREATED ORIGINAL TEST.
+--     EG  06/04/84
+--     PWB 01/19/86  CLARIFIED COMMENTS REGARDING NON-APPLICABILITY;
+--                   REMOVED TEXT NOT RELATED TO TEST OBJECTIVE
+--                   MOVED TASK TYPES TO C87B62D.DEP.
+--     BCB 01/04/88  MODIFIED HEADER.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C87B62B IS
+
+     TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
+     TYPE POS_INT IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+     TYPE NUMERAL IS NEW CHARACTER RANGE '0' .. '9';
+     TYPE BASE_5  IS ('0', '1', '2', '3', '4');
+     ERR : BOOLEAN := FALSE;
+
+     FUNCTION F (X : INTEGER) RETURN NUMERAL IS
+     BEGIN
+          ERR := TRUE;
+          RETURN ('9');
+     END F;
+
+     FUNCTION F (X : INTEGER) RETURN BASE_5 IS
+     BEGIN
+          ERR := TRUE;
+          RETURN ('4');
+     END F;
+
+     FUNCTION F (X : INTEGER) RETURN POS_FIX IS
+     BEGIN
+          ERR := TRUE;
+          RETURN POS_FIX (X);
+     END F;
+
+     FUNCTION F (X : INTEGER) RETURN POS_INT IS
+     BEGIN
+          RETURN POS_INT (X);
+     END F;
+
+BEGIN
+     TEST ("C87B62B","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
+                     "- SPECIFICATION OF ATTRIBUTE T'STORAGE_SIZE " &
+                     "FOR ACCESS TYPES");
+
+     DECLARE
+
+          TYPE DECEM IS NEW INTEGER RANGE    1 .. 10;
+          TYPE LINK  IS ACCESS DECEM;
+
+          TYPE JUST_LIKE_LINK IS ACCESS DECEM;
+          TYPE CHECK IS ACCESS DECEM;
+
+          FOR CHECK'STORAGE_SIZE
+               USE 1024;
+          FOR LINK'STORAGE_SIZE USE F (1024);
+
+     BEGIN
+          IF ERR THEN
+               FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
+                       "LENGTH CLAUSE USING 'STORAGE_SIZE");
+          END IF;
+     END;
+
+     RESULT;
+END C87B62B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62c.ada
new file mode 100644
index 000000000..fb5d4ef60
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62c.ada
@@ -0,0 +1,80 @@
+-- C87B62C.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+--       IN A LENGTH CLAUSE THAT SPECIFIES 'SMALL, THE EXPRESSION
+--       MUST BE OF SOME REAL TYPE.
+
+-- HISTORY:
+--     TRH 09/08/82  CREATED ORIGINAL TEST.
+--     PWB 02/19/86  ADDED COMMENTS TO CLARIFY NON-APPLICABILITY;
+--                   REMOVED TEXT NOT RELATED TO TEST OBJECTIVE.
+--     BCB 01/04/88  MODIFIED HEADER.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C87B62C IS
+
+     TYPE POS_INT IS NEW INTEGER RANGE 1 .. INTEGER'LAST;
+     TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
+     ERR : BOOLEAN := FALSE;
+
+     FUNCTION "+" (X : POS_INT) RETURN POS_FIX IS
+     BEGIN
+          ERR := TRUE;
+          RETURN POS_FIX (X);
+     END "+";
+
+     FUNCTION "+" (X : POS_FIX) RETURN POS_INT IS
+     BEGIN
+          ERR := TRUE;
+          RETURN POS_INT (X);
+     END "+";
+
+BEGIN
+     TEST ("C87B62C","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
+           "- SPECIFICATION OF ATTRIBUTE T'SMALL");
+
+     DECLARE
+          TYPE JUST_LIKE_FIXED IS DELTA 0.1 RANGE -1.0 .. 1.0;
+          TYPE FIXED IS DELTA 0.1   RANGE -1.0 .. 1.0;
+
+          FIKST_SMALL : CONSTANT := JUST_LIKE_FIXED'SMALL;
+          TYPE CHECK IS DELTA 0.1 RANGE -1.0 .. 1.0;
+
+          FOR CHECK'SMALL USE FIKST_SMALL;
+          FOR FIXED'SMALL       USE + FIKST_SMALL;
+
+     BEGIN
+          IF ERR THEN
+               FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
+                       "LENGTH CLAUSE USING 'SMALL");
+          END IF;
+     END;
+
+     RESULT;
+END C87B62C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62d.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62d.tst
new file mode 100644
index 000000000..296402a6d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c8/c87b62d.tst
@@ -0,0 +1,105 @@
+-- C87B62D.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 OVERLOADING RESOLUTION USES THE RULE THAT:
+--
+--       IN A LENGTH CLAUSE THAT SPECIFIES 'STORAGE_SIZE,
+--       THE EXPRESSION MUST BE OF SOME INTEGER TYPE.
+--       TASK TYPE IS HERE; ACCESS TYPE IS IN C87B62B.DEP.
+
+-- MACRO SUBSTITUTION:
+--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+--     THE ACTIVATION OF A TASK.
+
+-- HISTORY:
+--     TRH 09/08/82  CREATED ORIGINAL TEST.
+--     EG  06/04/84
+--     PWB 01/19/86  CREATED THIS TEST FILE FROM THE TASK TYPE PART
+--                   OF THE OLD C87B62B;
+--                   CLARIFIED COMMENTS REGARDING NON-APPLICABILITY.
+--     BCB 01/04/88  MODIFIED HEADER.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.TST'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C87B62D IS
+
+     TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+
+     TYPE POS_INT IS NEW INTEGER RANGE 0 .. INTEGER'LAST;
+     TYPE POS_FIX IS DELTA 0.1 RANGE 0.0 .. 10.0;
+     TYPE NUMERAL IS NEW CHARACTER RANGE '0' .. '9';
+     TYPE BASE_5  IS ('0', '1', '2', '3', '4');
+     ERR : BOOLEAN := FALSE;
+
+     FUNCTION F (X : INTEGER) RETURN NUMERAL IS
+     BEGIN
+          ERR := TRUE;
+          RETURN ('9');
+     END F;
+
+     FUNCTION F (X : INTEGER) RETURN BASE_5 IS
+     BEGIN
+          ERR := TRUE;
+          RETURN ('4');
+     END F;
+
+     FUNCTION F (X : INTEGER) RETURN POS_FIX IS
+     BEGIN
+          ERR := TRUE;
+          RETURN POS_FIX (X);
+     END F;
+
+     FUNCTION F (X : INTEGER) RETURN POS_INT IS
+     BEGIN
+          RETURN POS_INT (X);
+     END F;
+
+BEGIN
+     TEST ("C87B62D","OVERLOADED EXPRESSION WITHIN LENGTH CLAUSE " &
+           "- SPECIFICATION OF ATTRIBUTE T'STORAGE_SIZE " &
+           "FOR TASK TYPES ");
+
+     DECLARE
+
+          TASK TYPE TSK1  IS
+          END TSK1;
+
+          FOR TSK1'STORAGE_SIZE USE F (TASK_STORAGE_SIZE);
+
+          TASK BODY TSK1 IS
+          BEGIN
+               NULL;
+          END TSK1;
+
+     BEGIN
+          IF ERR THEN
+               FAILED ("RESOLUTION INCORRECT FOR EXPRESSION IN " &
+                       "LENGTH CLAUSE USING 'STORAGE_SIZE");
+          END IF;
+     END;
+
+     RESULT;
+END C87B62D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c910001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c910001.a
new file mode 100644
index 000000000..416e13ca8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c910001.a
@@ -0,0 +1,224 @@
+-- C910001.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 tasks may have discriminants.  Specifically, check where
+--      the subtype of the discriminant is a discrete subtype and where it is
+--      an access subtype.  Check the case where the default values of the
+--      discriminants are used.
+--
+-- TEST DESCRIPTION:
+--      A task is defined with two discriminants, one a discrete subtype and
+--      another that is an access subtype.  Tasks are created with various
+--      values for discriminants and code within the task checks that these
+--      are passed in correctly.  One instance of a default is used.  The
+--      values passed to the task as the discriminants are taken from an
+--      array of test data and the values received are checked against the
+--      same array.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+
+procedure C910001 is
+ 
+
+   type App_Priority is range 1..10;
+   Default_Priority : App_Priority := 5;
+
+   type Message_ID is range 1..10_000; 
+
+   type TC_Number_of_Messages is range 1..5;
+
+   type TC_rec is record
+      TC_ID       : Message_ID;
+      A_Priority  : App_Priority;
+      TC_Checked  : Boolean;
+   end record;
+
+   -- This table is used to create the messages and to check them
+   TC_table : array (1..TC_Number_of_Messages'Last) of TC_Rec := 
+                              (  ( 10, 6, false ),
+                                 ( 20, 2, false ),
+                                 ( 30, 9, false ),
+                                 ( 40, 1, false ),
+                                 ( 50, Default_Priority, false ) );
+
+begin -- C910001
+
+   Report.Test ("C910001", "Check that tasks may have discriminants");
+
+      
+   declare     -- encapsulate the test
+
+      type Transaction_Record is 
+         record
+            ID               : Message_ID;
+            Account_Number   : integer := 0;
+            Stock_Number     : integer := 0;
+            Quantity         : integer := 0;
+            Return_Value     : integer := 0;
+         end record;
+      -- 
+      type acc_Transaction_Record is access Transaction_Record;
+
+
+      task type Message_Task
+                   (In_Message  : acc_Transaction_Record := null;
+                    In_Priority : App_Priority := Default_Priority) is
+         entry Start;
+      end Message_Task;
+      type acc_Message_Task is access Message_Task;
+      --
+      --
+      task body Message_Task is
+         This_Message   : acc_Transaction_Record := In_Message;
+         This_Priority  : App_Priority           := In_Priority; 
+         TC_Match_Found : Boolean                := false;
+      begin 
+         accept Start;
+         -- In the example envisioned this task would then queue itself
+         -- upon some Distributor task which would send it off (requeue) to
+         -- the message processing tasks according to the priority of the 
+         -- message and the current load on the system.  For the test we
+         -- just verify the data passed in as discriminants and exit the task
+         -- 
+         -- Check for the special case of default discriminants
+         if This_Message = null then
+            -- The default In_Message has been passed, check that the
+            -- default priority was also passed
+            if This_Priority /= Default_Priority then
+               Report.Failed ("Incorrect Default Priority");
+            end if;
+            if TC_Table (TC_Number_of_Messages'Last).TC_Checked then
+               Report.Failed ("Duplicate Default messages");
+            else
+               -- Mark that default has been seen
+               TC_Table (TC_Number_of_Messages'Last).TC_Checked := True;
+            end if; 
+            TC_Match_Found := true;
+         else
+            -- Check the data against the table
+            for i in TC_Number_of_Messages loop
+               if TC_Table(i).TC_ID = This_Message.ID then
+                  -- this is the right slot in the table
+                  if TC_Table(i).TC_checked then
+                     -- Already checked
+                     Report.Failed ("Duplicate Data");
+                  else 
+                     TC_Table(i).TC_checked := true;
+                  end if;
+                  TC_Match_Found := true;
+                  if TC_Table(i).A_Priority /= This_Priority then
+                     Report.Failed ("ID/Priority mismatch");
+                  end if;
+                  exit;
+               end if;
+            end loop;
+         end if;
+
+         if not TC_Match_Found then
+            Report.Failed ("No ID match in table");
+         end if;
+
+         -- Allow the task to terminate
+
+      end Message_Task;
+
+
+      -- The Line Driver task accepts data from an external source and 
+      -- builds them into a transaction record.  It then generates a
+      -- message task.  This message "contains" the record and is given 
+      -- a priority according to the contents of the message.  The priority 
+      -- and transaction records are passed to the task as discriminants.
+      --    In this test we use a dummy record.  Only the ID is of interest 
+      --    so we pick that and the required priority from an array of 
+      --    test data.  We artificially limit the endless driver-loop to 
+      --    the number of messages required for the test and add a special
+      --    case to check the defaults.
+      --
+      task Driver_Task;
+      --
+      task body Driver_Task is
+      begin
+
+         -- Create all but one of the required tasks
+         --
+         for i in 1..TC_Number_of_Messages'Last - 1   loop
+            declare
+               -- Create a record for the next message
+               Next_Transaction : acc_Transaction_Record := 
+                                                new Transaction_Record;
+               -- Create a task for the next message
+               Next_Message_Task : acc_Message_Task := 
+                                 new Message_Task( Next_Transaction,  
+                                                   TC_Table(i).A_Priority );
+
+            begin
+               -- Artificially plug the ID with the next from the table
+               --    In reality the whole record would be built here
+               Next_Transaction.ID := TC_Table(i).TC_ID;
+               
+               -- Ensure the task does not start executing till the 
+               -- transaction record is properly constructed
+               Next_Message_Task.Start;
+
+            end;  -- declare
+         end loop;
+
+         -- For this subtest create one task with the default discriminants
+         --
+         declare 
+
+            -- Create the task 
+            Next_Message_Task : acc_Message_Task := new Message_Task;
+
+         begin
+            
+            Next_Message_Task.Start;
+
+         end; -- declare
+
+
+      end Driver_Task;
+
+   begin    
+      null;
+   end;     -- encapsulation
+
+   -- Now verify that all the tasks executed and checked in
+   for i in TC_Number_of_Messages loop
+      if not TC_Table(i).TC_Checked then 
+         Report.Failed 
+                 ("Task" & integer'image(integer (i) ) & " did not verify");
+      end if;
+   end loop; 
+   Report.Result;
+
+end C910001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c910002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c910002.a
new file mode 100644
index 000000000..dc0b9b36b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c910002.a
@@ -0,0 +1,143 @@
+-- C910002.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 contents of a task object include the values
+--      of its discriminants.
+--      Check that selected_component notation can be used to
+--      denote a discriminant of a task.
+--
+-- TEST DESCRIPTION:
+--      This test declares a task type that contains discriminants.
+--      Objects of the task type are created with different values.
+--      The task type has nested tasks that are used to check that
+--      the discriminate values are the expected values.
+--      Note that the names of the discriminants in the body of task
+--      type DTT denote the current instance of the unit.
+--
+--
+-- CHANGE HISTORY:
+--      12 OCT 95   SAIC    Initial release for 2.1
+--       8 MAY 96   SAIC    Incorporated Reviewer comments.
+--
+--!
+
+
+with Report;
+procedure C910002 is
+  Verbose : constant Boolean := False;
+begin
+  Report.Test ("C910002",
+               "Check that selected_component notation can be" &
+               " used to access task discriminants");
+  declare
+
+    task type DTT
+         (IA, IB : Integer;
+          CA, CB : Character) is
+      entry Check_Values (First_Int : Integer;
+                          First_Char : Character);
+    end DTT;
+
+    task body DTT is
+       Int1 : Integer;
+       Char1 : Character;
+
+       -- simple nested task to check the character values
+       task Check_Chars is
+          entry Start_Check;
+       end Check_Chars;
+       task body Check_Chars is
+       begin
+          accept Start_Check;
+          if DTT.CA /= Char1 or
+             DTT.CB /= Character'Succ (Char1) then
+            Report.Failed ("character check failed.  Expected: '" &
+                     Char1 & Character'Succ (Char1) &
+                     "' but found '" &
+                     DTT.CA & DTT.CB & "'");
+          elsif Verbose then
+            Report.Comment ("char check for " & Char1);
+          end if;
+       exception
+          when others => Report.Failed ("exception in Check_Chars");
+       end Check_Chars;
+
+       -- use a discriminated task to check the integer values
+       task type Check_Ints (First : Integer);
+       task body Check_Ints is
+       begin
+          if DTT.IA /= Check_Ints.First or
+             IB     /= First+1 then
+            Report.Failed ("integer check failed.  Expected:" &
+                     Integer'Image (Check_Ints.First) & 
+                     Integer'Image (First+1) &
+                     " but found" &
+                     Integer'Image (DTT.IA) & Integer'Image (IB) );
+          elsif Verbose then
+            Report.Comment ("int check for" & Integer'Image (First));
+          end if;
+       exception
+          when others => Report.Failed ("exception in Check_Ints");
+       end Check_Ints;
+    begin
+      accept Check_Values (First_Int : Integer;
+                           First_Char : Character) do
+        Int1 := First_Int;
+        Char1 := First_Char;
+      end Check_Values;
+
+      -- kick off the character check
+      Check_Chars.Start_Check;
+
+      -- do the integer check
+      declare
+         Int_Checker : Check_Ints (Int1);
+      begin
+        null;  -- let task do its thing
+      end;
+
+      -- do one test here too
+      if DTT.IA /= Int1 then
+        Report.Failed ("DTT check failed.  Expected:" &
+              Integer'Image (Int1) &
+              " but found:" &
+              Integer'Image (DTT.IA));
+      elsif Verbose then
+        Report.Comment ("DTT check for" & Integer'Image (Int1));
+      end if;
+    exception
+      when others => Report.Failed ("exception in DTT");
+    end DTT;
+
+    T1a : DTT (1,  2, 'a', 'b');
+    T9C : DTT (9, 10, 'C', 'D');
+  begin   -- test encapsulation
+    T1a.Check_Values (1, 'a');
+    T9C.Check_Values (9, 'C');
+  end;
+
+  Report.Result;
+end C910002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c910003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c910003.a
new file mode 100644
index 000000000..b2e11cef8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c910003.a
@@ -0,0 +1,185 @@
+-- C910003.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER 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 task discriminants that have an access subtype may be
+--      dereferenced.
+--
+--      Note that discriminants in Ada 83 never can be dereferenced with
+--      selection or indexing, as they cannot have an access type.
+--
+-- TEST DESCRIPTION:
+--      A protected object is defined to create a simple buffer.
+--      Two task types are defined, one to put values into the buffer,
+--      and one to remove them. The tasks are passed a buffer object as
+--      a discriminant with an access subtype. The producer task type includes
+--      a discriminant to determine the values to product. The consumer task
+--      type includes a value to save the results.
+--      Two producer and one consumer tasks are declared, and the results
+--      are checked.
+--
+-- CHANGE HISTORY:
+--      10 Mar 99   RLB    Created test.
+--
+--!
+
+package C910003_Pack is
+
+    type Item_Type is range 1 .. 100; -- In a real application, this probably
+                                      -- would be a record type.
+
+    type Item_Array is array (Positive range <>) of Item_Type;
+
+    protected type Buffer is
+       entry Put (Item  : in Item_Type);
+       entry Get (Item  : out Item_Type);
+       function TC_Items_Buffered return Item_Array;
+    private
+       Saved_Item : Item_Type;
+       Empty : Boolean := True;
+       TC_Items : Item_Array (1 .. 10);
+       TC_Last  : Natural := 0;
+    end Buffer;
+
+    type Buffer_Access_Type is access Buffer;
+
+    PRODUCE_COUNT : constant := 2; -- Number of items to produce.
+
+    task type Producer (Buffer_Access : Buffer_Access_Type;
+                        Start_At : Item_Type);
+        -- Produces PRODUCE_COUNT items. Starts when activated.
+
+    type TC_Item_Array_Access_Type is access Item_Array (1 .. PRODUCE_COUNT*2);
+
+    task type Consumer (Buffer_Access : Buffer_Access_Type;
+                        Results : TC_Item_Array_Access_Type) is
+        -- Stores PRODUCE_COUNT*2 items consumed in Results. Starts when
+        -- activated.
+        entry Wait_until_Done;
+    end Consumer;
+
+end C910003_Pack;
+
+
+with Report;
+package body C910003_Pack is
+
+    protected body Buffer is
+       entry Put (Item  : in Item_Type) when Empty is
+       begin
+           Empty := False;
+           Saved_Item := Item;
+           TC_Last := TC_Last + 1;
+           TC_Items(TC_Last) := Item;
+       end Put;
+
+       entry Get (Item  : out Item_Type) when not Empty is
+       begin
+           Empty := True;
+           Item := Saved_Item;
+       end Get;
+
+       function TC_Items_Buffered return Item_Array is
+       begin
+           return TC_Items(1..TC_Last);
+       end TC_Items_Buffered;
+
+    end Buffer;
+
+
+    task body Producer is
+        -- Produces PRODUCE_COUNT items. Starts when activated.
+    begin
+        for I in 1 .. Report.Ident_Int(PRODUCE_COUNT) loop
+           Buffer_Access.Put (Start_At + (Item_Type(I)-1)*2);
+        end loop;
+    end Producer;
+
+
+    task body Consumer is
+        -- Stores PRODUCE_COUNT*2 items consumed in Results. Starts when
+        -- activated.
+    begin
+        for I in 1 .. Report.Ident_Int(PRODUCE_COUNT*2) loop
+            Buffer_Access.Get (Results (I));
+            -- Buffer_Access and Results are both dereferenced.
+        end loop;
+
+        -- Check the results (and function call with a prefix dereference).
+        if Results.all(Report.Ident_Int(1)) /= Buffer_Access.all.TC_Items_Buffered(Report.Ident_Int(1)) then
+           Report.Failed ("First item mismatch");
+        end if;
+        if Results(Report.Ident_Int(2)) /= Buffer_Access.TC_Items_Buffered(Report.Ident_Int(2)) then
+           Report.Failed ("Second item mismatch");
+        end if;
+        accept Wait_until_Done; -- Tell main that we're done.
+    end Consumer;
+
+end C910003_Pack;
+
+
+with Report;
+with C910003_Pack;
+
+procedure C910003 is
+
+begin -- C910003
+
+   Report.Test ("C910003", "Check that tasks discriminants of access types can be dereferenced");
+
+
+   declare     -- encapsulate the test
+
+      Buffer_Access : C910003_Pack.Buffer_Access_Type :=
+         new C910003_Pack.Buffer;
+
+      TC_Results : C910003_Pack.TC_Item_Array_Access_Type :=
+         new C910003_Pack.Item_Array (1 .. C910003_Pack.PRODUCE_COUNT*2);
+
+      Producer_1 : C910003_Pack.Producer (Buffer_Access, 12);
+      Producer_2 : C910003_Pack.Producer (Buffer_Access, 23);
+
+      Consumer : C910003_Pack.Consumer (Buffer_Access, TC_Results);
+
+      use type C910003_Pack.Item_Array; -- For /=.
+
+   begin
+      Consumer.Wait_until_Done;
+      if TC_Results.all /= Buffer_Access.TC_Items_Buffered then
+           Report.Failed ("Different items buffered than returned - Main");
+      end if;
+      if (TC_Results.all /= (12, 14, 23, 25) and
+          TC_Results.all /= (12, 23, 14, 25) and
+          TC_Results.all /= (12, 23, 25, 14) and
+          TC_Results.all /= (23, 12, 14, 25) and
+          TC_Results.all /= (23, 12, 25, 14) and
+          TC_Results.all /= (23, 25, 12, 14)) then
+          -- Above are the only legal results.
+           Report.Failed ("Wrong results");
+      end if;
+   end;     -- encapsulation
+
+   Report.Result;
+
+end C910003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91004b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91004b.ada
new file mode 100644
index 000000000..16a17cf32
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91004b.ada
@@ -0,0 +1,108 @@
+-- C91004B.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 TASK (TYPE) IDENTIFIER, WHEN USED WITHIN ITS OWN
+--     BODY, REFERS TO THE EXECUTING TASK.
+
+--      TEST USING IDENTIFIER IN ABORT STATEMENT, AS AN EXPRESSION IN
+--      A MEMBERSHIP TEST, AND THE PREFIX OF 'CALLABLE AND
+--      'TERMINATED.
+
+-- HISTORY:
+--     WEI  3/ 4/82  CREATED ORIGINAL TEST.
+--     RJW 11/13/87  RENAMED TEST FROM C910BDA.ADA.  ADDED CHECKS FOR
+--                   MEMBERSHIP TEST, AND 'CALLABLE AND 'TERMINATED
+--                   ATTRIBUTES.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C91004B IS
+
+     TYPE I0 IS RANGE 0..1;
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     TASK TYPE TT1 IS
+          ENTRY E1 (P1 : IN I0; P2 : ARG);
+          ENTRY BYE;
+     END TT1;
+
+     SUBTYPE SUB_TT1 IS TT1;
+
+     OBJ_TT1 : ARRAY (NATURAL RANGE 1..2) OF TT1;
+
+     PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+     END PSPY_NUMB;
+
+     TASK BODY TT1 IS
+     BEGIN
+          IF TT1 NOT IN SUB_TT1 THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST");
+          END IF;
+
+          IF NOT TT1'CALLABLE THEN
+               FAILED ("INCORRECT RESULTS FOR 'CALLABLE");
+          END IF;
+
+          IF TT1'TERMINATED THEN
+               FAILED ("INCORRECT RESULTS FOR 'TERMINATED");
+          END IF;
+
+          ACCEPT E1 (P1 : IN I0; P2 : ARG) DO
+               IF P1 = 1 THEN
+                    ABORT TT1;
+                    ACCEPT BYE;    -- WILL DEADLOCK IF NOT ABORTED.
+               END IF;
+               PSPY_NUMB (ARG (P2));
+          END E1;
+
+     END TT1;
+
+BEGIN
+
+     TEST ("C91004B", "TASK IDENTIFIER IN OWN BODY");
+
+     BEGIN
+          OBJ_TT1 (1).E1 (1,1);
+          FAILED ("NO TASKING_ERROR RAISED");
+-- ABORT DURING RENDEVOUS RAISES TASKING ERROR
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED");
+     END;
+
+     OBJ_TT1 (2).E1 (0,2);
+
+     IF SPYNUMB /= 2 THEN
+          FAILED ("WRONG TASK OBJECT REFERENCED");
+          COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+     END IF;
+
+     RESULT;
+
+END C91004B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91004c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91004c.ada
new file mode 100644
index 000000000..a07543370
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91004c.ada
@@ -0,0 +1,82 @@
+-- C91004C.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 TASK (TYPE) IDENTIFIER, WHEN USED WITHIN ITS OWN BODY
+-- REFERS TO THE EXECUTING TASK.
+--
+-- TEST USING CONDITIONAL ENTRY CALL.
+
+-- WEI  3/ 4/82
+-- TLB 10/30/87  RENAMED FROM C910BDB.ADA.
+
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C91004C IS
+
+     TASK TYPE TT1 IS
+          ENTRY E1;
+          ENTRY BYE;
+     END TT1;
+
+     OBJ_TT1 : ARRAY (NATURAL RANGE 1..2) OF TT1;
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+     END PSPY_NUMB;
+
+     TASK BODY TT1 IS
+     BEGIN
+          ACCEPT E1 DO
+               PSPY_NUMB (1);
+          END E1;
+
+          SELECT
+               TT1.E1;
+          ELSE
+               PSPY_NUMB (2);
+          END SELECT;
+
+          ACCEPT BYE;
+     END TT1;
+
+BEGIN
+
+     TEST ("C91004C", "TASK IDENTIFIER IN OWN BODY");
+     OBJ_TT1 (1).E1;
+     OBJ_TT1 (1).BYE;
+
+     IF SPYNUMB /=12 THEN
+          FAILED ("WRONG TASK OBJECT REFERENCED");
+          COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+     END IF;
+
+     ABORT OBJ_TT1 (2);
+
+     RESULT;
+
+END C91004C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91006a.ada
new file mode 100644
index 000000000..1217d1459
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91006a.ada
@@ -0,0 +1,82 @@
+-- C91006A.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 TASK SPECIFICATION ENTRY DECLARATIONS ARE ELABORATED
+-- WHEN THE SPECIFICATION IS ELABORATED, AND IN TEXTUAL ORDER.
+
+-- WEI  3/04/82
+-- BHS  7/13/84
+-- TBN 12/17/85     RENAMED FROM C910AHA-B.ADA;
+--                  ADDED DECLARATIONS OF FIRST AND LAST.
+-- PWB  5/15/86     MOVED DECLARATIONS OF FIRST, TASK T1, AND LAST
+--                  INTO A DECLARE/BEGIN/END BLOCK.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C91006A IS
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     INDEX : INTEGER RANGE 0..5 := 0;
+     SPYNUMB : STRING(1..5) := (1..5 => ' ');
+
+     FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
+          TEMP : STRING(1..2);
+     BEGIN
+          TEMP := ARG'IMAGE(DIGT);
+          INDEX := INDEX + 1;
+          SPYNUMB(INDEX) := TEMP(2);
+          RETURN DIGT;
+     END FINIT_POS;
+
+BEGIN
+     TEST ("C91006A", "CHECK THAT IN A TASK SPEC, ELABORATION IS IN " &
+                      "TEXTUAL ORDER");
+     DECLARE
+
+          FIRST : INTEGER := FINIT_POS (1);
+
+          TASK T1 IS
+               ENTRY E2 (NATURAL RANGE 1 .. FINIT_POS (2));
+               ENTRY E3 (NATURAL RANGE 1 .. FINIT_POS (3));
+               ENTRY E4 (NATURAL RANGE 1 .. FINIT_POS (4));
+          END T1;
+
+          LAST : INTEGER := FINIT_POS (5);
+
+          TASK BODY T1 IS
+          BEGIN
+               NULL;
+          END T1;
+
+     BEGIN
+           NULL;
+     END;
+
+     IF SPYNUMB /= "12345" THEN 
+          FAILED ("TASK SPEC T1 NOT ELABORATED IN TEXTUAL ORDER");
+          COMMENT ("ACTUAL ORDER WAS: " & SPYNUMB);
+     END IF;
+
+     RESULT;
+
+END C91006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91007a.ada
new file mode 100644
index 000000000..d2b21b302
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c91007a.ada
@@ -0,0 +1,97 @@
+-- C91007A.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:
+--     IF THE ELABORATION OF AN ENTRY DECLARATION RAISES
+--     "CONSTRAINT_ERROR", THEN NO TASKS ARE ACTIVATED, AND
+--     "TASKING_ERROR" IS NOT RAISED.
+
+-- HISTORY:
+--     LDC 06/17/88  CREATED ORGINAL TEST
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE C91007A IS
+
+     TYPE ENUM IS (TERESA, BRIAN, PHIL, JOLEEN, LYNN, DOUG, JODIE,
+                   VINCE, TOM, DAVE, JOHN, ROSA);
+     SUBTYPE ENUM_SUB IS ENUM RANGE BRIAN..LYNN;
+
+BEGIN
+     TEST("C91007A","IF THE ELABORATION OF AN ENTRY DECLARATION " &
+                    "RAISES 'CONSTRAINT_ERROR', THEN NO TASKS ARE " &
+                    "ACTIVATED, AND 'TASKING_ERROR' IS NOT RAISED");
+
+     BEGIN
+          DECLARE
+               TASK TYPE TSK1;
+               T1 : TSK1;
+               TASK BODY TSK1 IS
+               BEGIN
+                    FAILED("TSK1 WAS ACTIVATED");
+               END TSK1;
+
+
+               TASK TSK2 IS
+                    ENTRY ENT(ENUM_SUB RANGE TERESA..LYNN);
+               END TSK2;
+
+               TASK BODY TSK2 IS
+               BEGIN
+                    FAILED("TASK BODY WAS ACTIVATED");
+               END TSK2;
+
+               TASK TSK3;
+               TASK BODY TSK3 IS
+               BEGIN
+                    FAILED("TSK3 WAS ACTIVATED");
+               END TSK3;
+
+          BEGIN
+               NULL;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED("CONSTRAINT_ERROR WAS RAISED IN THE " &
+                           "BEGIN BLOCK");
+               WHEN TASKING_ERROR =>
+                    FAILED("TASKING_ERROR WAS RAISED INSTEAD OF " &
+                           "CONSTRAINT_ERROR IN THE BEGIN BLOCK");
+               WHEN OTHERS =>
+                    FAILED("OTHER EXCEPTION WAS RAISED IN " &
+                           "THE BEGIN BLOCK");
+          END;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN TASKING_ERROR =>
+               FAILED("TASKING_ERROR WAS RAISED INSTEAD OF " &
+                      "CONSTRAINT_ERROR");
+          WHEN OTHERS =>
+               FAILED("WRONG EXCEPTION WAS RAISED");
+     END;
+
+     RESULT;
+
+END C91007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92002a.ada
new file mode 100644
index 000000000..879cf36b9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92002a.ada
@@ -0,0 +1,73 @@
+-- C92002A.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 ASSIGNMENT TO A COMPONENT (FOR WHICH ASSIGNMENT IS
+--   AVAILABLE) OF A RECORD CONTAINING A TASK IS AVAILABLE.
+
+-- JRK 9/17/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT; USE REPORT;
+PROCEDURE C92002A IS
+
+BEGIN
+     TEST ("C92002A", "CHECK THAT CAN ASSIGN TO ASSIGNABLE " &
+                      "COMPONENTS OF RECORDS WITH TASK " &
+                      "COMPONENTS");
+
+     DECLARE
+
+          TASK TYPE TT IS
+               ENTRY E;
+          END TT;
+
+          TYPE RT IS
+               RECORD
+                    I : INTEGER := 0;
+                    T : TT;
+                    J : INTEGER := 0;
+               END RECORD;
+
+          R : RT;
+
+          TASK BODY TT IS
+          BEGIN
+               NULL;
+          END TT;
+
+     BEGIN
+
+          R.I := IDENT_INT (7);
+          R.J := IDENT_INT (9);
+
+          IF R.I /= 7 AND R.J /= 9 THEN
+               FAILED ("WRONG VALUE(S) WHEN ASSIGNING TO " &
+                       "INTEGER COMPONENTS OF RECORDS WITH " &
+                       "TASK COMPONENTS");
+          END IF;
+
+     END;
+
+     RESULT;
+END C92002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92003a.ada
new file mode 100644
index 000000000..ff42680b0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92003a.ada
@@ -0,0 +1,117 @@
+-- C92003A.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 TASK CAN BE PASSED AS AN ACTUAL IN OR IN OUT PARAMETER
+-- IN A SUBPROGRAM CALL AND THAT THE ACTUAL AND FORMAL PARAMETERS DENOTE
+-- THE SAME TASK OBJECT.
+
+-- JRK  1/17/81
+-- TBN 12/19/85  ADDED IN OUT PARAMETER CASE.
+-- PWB  8/04/86  ADDED CHECK THAT FORMAL AND ACTUAL PARAMETERS DENOTE
+--               THE SAME TASK OBJECT.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C92003A IS
+
+BEGIN
+
+     TEST ("C92003A", "CHECK TASKS PASSED AS ACTUAL IN OR IN OUT " &
+                       "PARAMETERS TO SUBPROGRAMS");
+
+     DECLARE
+
+          TASK TYPE TT IS
+               ENTRY E (I : INTEGER);
+          END TT;
+
+          T, S : TT;
+
+          TASK BODY TT IS
+               SOURCE : INTEGER;
+          BEGIN
+
+               SELECT
+                    ACCEPT E (I : INTEGER) DO
+                         SOURCE := I;
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+
+               IF SOURCE /= 1 THEN
+                    FAILED ("EXPECTED 1, GOT " & INTEGER'IMAGE(SOURCE));
+               END IF;
+
+               SELECT
+                    ACCEPT E (I : INTEGER) DO
+                         SOURCE := I;
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+
+               IF SOURCE /= 2 THEN
+                    FAILED ("EXPECTED 2, GOT " & INTEGER'IMAGE(SOURCE));
+               END IF;
+
+               SELECT
+                    ACCEPT E (I : INTEGER) DO
+                         SOURCE := I;
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+
+               IF SOURCE /= 3 THEN
+                    FAILED ("EXPECTED 3, GOT " & INTEGER'IMAGE(SOURCE));
+               END IF;
+
+          END TT;
+
+          PROCEDURE P (T : TT) IS
+          BEGIN
+               T.E(2);
+          END P;
+
+          PROCEDURE Q (S : IN OUT TT) IS
+          BEGIN
+               S.E(2);
+          END Q;
+
+     BEGIN
+
+          T.E(1);                  -- FIRST CALL TO T.E
+          P(T);                    -- SECOND CALL TO T.E
+          T.E(3);                  -- THIRD CALL TO T.E
+
+          S.E(1);                  -- FIRST CALL TO S.E
+          Q(S);                    -- SECOND CALL TO S.E
+          S.E(3);                  -- THIRD CALL TO S.E
+
+     END;
+
+     RESULT;
+
+END C92003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92005a.ada
new file mode 100644
index 000000000..6766c573e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92005a.ada
@@ -0,0 +1,75 @@
+-- C92005A.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 A NON-SINGLE TASK THE OBJECT VALUE IS SET DURING
+-- ELABORATION OF THE CORRESPONDING OBJECT DECLARATION.
+
+-- WEI  3/ 4/82
+-- JBG 5/25/85
+-- PWB  2/3/86    CORRECTED TEST ERROR; ADDED 'USE' CLAUSE TO MAKE "/="
+--                FOR BIG_INT VISIBLE.
+
+WITH REPORT, SYSTEM;
+ USE REPORT;
+PROCEDURE C92005A IS
+BEGIN
+
+     TEST ("C92005A", "TASK OBJECT VALUE DURING ELABORATION");
+
+     DECLARE
+          TASK TYPE TT1;
+
+          OBJ_TT1 : TT1;
+
+          PACKAGE PACK IS
+               TYPE BIG_INT IS RANGE 0 .. SYSTEM.MAX_INT;
+               I : BIG_INT;
+          END PACK;
+
+          PACKAGE BODY PACK IS
+          BEGIN
+               I := OBJ_TT1'STORAGE_SIZE;  -- O.K.
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("TASK OBJECT RAISED EXCEPTION");
+          END PACK;
+
+          USE PACK;
+
+          TASK BODY TT1 IS
+          BEGIN
+               NULL;
+          END TT1;
+
+     BEGIN
+          IF PACK.I /= OBJ_TT1'STORAGE_SIZE THEN
+               COMMENT ("STORAGE SIZE CHANGED AFTER TASK ACTIVATED");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY STORAGE_SIZE");
+     END;
+
+     RESULT;
+END C92005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92005b.ada
new file mode 100644
index 000000000..e5672a7c7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92005b.ada
@@ -0,0 +1,72 @@
+-- C92005B.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 A TASK OBJECT CREATED BY AN ALLOCATOR THE
+-- OBJECT VALUE IS SET DURING EXECUTION OF THE ALLOCATOR.
+
+-- WEI  3/ 4/82
+-- JBG  5/25/85
+-- RLB  1/ 7/05
+
+WITH REPORT;
+ USE REPORT;
+WITH SYSTEM;
+PROCEDURE C92005B IS
+     TYPE BIG_INT IS RANGE 0..SYSTEM.MAX_INT;
+BEGIN
+     TEST ("C92005B", "TASK VALUE SET BY EXECUTION OF ALLOCATOR");
+
+BLOCK:
+     DECLARE
+          TASK TYPE TT1;
+
+          TYPE ATT1 IS ACCESS TT1;
+
+          TASK BODY TT1 IS
+          BEGIN
+               NULL;
+          END TT1;
+
+          PACKAGE PACK IS
+          END PACK;
+
+          PACKAGE BODY PACK IS
+               POINTER_TT1 : ATT1 := NEW TT1;
+               I : BIG_INT := POINTER_TT1.ALL'STORAGE_SIZE;
+          BEGIN
+               IF NOT EQUAL(INTEGER(I MOD 1024), INTEGER(I MOD 1024)) THEN
+                    FAILED ("UNEXPECTED PROBLEM");
+               END IF;
+          END PACK;
+     BEGIN
+          NULL;
+     EXCEPTION
+          WHEN PROGRAM_ERROR | CONSTRAINT_ERROR =>
+               FAILED ("TASK OBJECT VALUE NOT SET DURING " &
+                       "EXECUTION OF ALLOCATOR");
+     END BLOCK;
+
+     RESULT;
+
+END C92005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92006a.ada
new file mode 100644
index 000000000..f0fd0c8c7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c92006a.ada
@@ -0,0 +1,93 @@
+-- C92006A.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 TASK OBJECTS CAN BE INTERCHANGED BY ASSIGNMENT OF
+-- CORRESPONDING ACCESS TYPE OBJECTS.
+
+-- WEI  3/ 4/82
+-- JWC 6/28/85   RENAMED FROM C920BIA-B.ADA
+
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C92006A IS
+
+     TASK TYPE TT1 IS
+          ENTRY E1;
+          ENTRY E2;
+     END TT1;
+
+     TYPE ATT1 IS ACCESS TT1;
+     POINTER_TT1_1, POINTER_TT1_2 : ATT1;
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+     END PSPY_NUMB;
+
+     PROCEDURE PROC (P1, P2 : IN OUT ATT1) IS
+     -- SWAP TASK OBJECTS P1, P2.
+          SCRATCH : ATT1;
+     BEGIN
+          SCRATCH := P1;
+          P1 := P2;
+          P2 := SCRATCH;
+
+          P1.E2;  -- ENTRY2 SECOND OBJECT.
+          P2.E1;  -- VICE VERSA.
+
+     END PROC;
+
+     TASK BODY TT1 IS
+     BEGIN
+          ACCEPT E1 DO
+               PSPY_NUMB (1);
+          END E1;
+          ACCEPT E2 DO
+               PSPY_NUMB (2);
+          END E2;
+     END TT1;
+
+BEGIN
+
+     TEST ("C92006A", "INTERCHANGING TASK OBJECTS");
+     POINTER_TT1_1 := NEW TT1;
+     POINTER_TT1_2 := NEW TT1;
+
+     POINTER_TT1_2.ALL.E1;
+     PROC (POINTER_TT1_1, POINTER_TT1_2);
+     POINTER_TT1_2.E2;        -- E2 OF FIRST OBJECT
+-- EACH ENTRY OF EACH TASK OBJECT SHOULD HAVE BEEN CALLED.
+
+     IF SPYNUMB /= 1212 THEN
+          FAILED ("FAILURE TO SWAP TASK OBJECTS " &
+                  "IN PROCEDURE PROC");
+          COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+     END IF;
+
+     RESULT;
+
+END C92006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c930001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c930001.a
new file mode 100644
index 000000000..874518990
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c930001.a
@@ -0,0 +1,153 @@
+-- C930001.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check when a dependent task and its master both
+--      terminate as a result of a terminate alternative that
+--      finalization is performed and that the finalization is
+--      performed in the proper order.
+--
+-- TEST DESCRIPTION:
+--      A controlled type with finalization is used to determine
+--      the order in which finalization occurs.  The finalization
+--      procedure records the identity of the object being
+--      finalized.
+--      Two tasks, one nested inside the other, both contain 
+--      objects of the above finalization type.  These tasks
+--      cooperatively terminate so the termination and finalization
+--      order can be noted.
+--
+--
+-- CHANGE HISTORY:
+--      08 Jan 96   SAIC    ACVC 2.1
+--      09 May 96   SAIC    Addressed Reviewer comments.
+--
+--!
+
+
+with Ada.Finalization;
+package C930001_0 is
+    Verbose : constant Boolean := False;
+
+    type Ids is range 0..10;
+    Finalization_Order : array (Ids) of Ids := (Ids => 0);
+    Finalization_Cnt : Ids := 0;
+
+    protected Note is
+       -- serializes concurrent access to Finalization_* above
+       procedure Done (Id : Ids);
+    end Note;
+
+    -- Objects of the following type are used to note the order in
+    -- which finalization occurs.
+    type Has_Finalization is new Ada.Finalization.Limited_Controlled with
+          record
+             Id : Ids;
+          end record;
+    procedure Finalize (Object : in out Has_Finalization);
+end C930001_0;
+
+
+with Report;
+package body C930001_0 is
+
+    protected body Note is
+        procedure Done (Id : Ids) is
+        begin
+            Finalization_Cnt := Finalization_Cnt + 1;
+            Finalization_Order (Finalization_Cnt) := Id;
+        end Done;
+    end Note;
+
+    procedure Finalize (Object : in out Has_Finalization) is
+    begin
+        Note.Done (Object.Id);
+        if Verbose then
+            Report.Comment ("in Finalize for" & Ids'Image (Object.Id));
+        end if;
+    end Finalize;
+end C930001_0;
+
+
+with Report;
+with ImpDef;
+with C930001_0;   use C930001_0;
+procedure C930001 is
+begin
+ 
+    Report.Test ("C930001", "Check that dependent tasks are terminated" &
+                            " before the remaining finalization");
+
+    declare
+        task Level_1;
+        task body Level_1 is
+            V1a : C930001_0.Has_Finalization;        -------> 4
+            task Level_2 is
+                entry Not_Taken;
+            end Level_2;
+            task body Level_2 is
+                V2 : C930001_0.Has_Finalization;     -------> 2
+            begin
+                V2.Id := 2;
+                C930001_0.Note.Done (1);             -------> 1
+                select
+                    accept Not_Taken;
+                or
+                    terminate;
+                    -- cooperative termination at this point of
+                    -- both tasks
+                end select;
+            end Level_2;
+
+            -- 7.6.1(11) requires that V1b be finalized before V1a
+            V1b : C930001_0.Has_Finalization;        -------> 3
+        begin
+            V1a.Id := 4;
+            V1b.Id := 3;
+        end Level_1;
+    begin  -- declare
+        while not Level_1'Terminated loop
+             delay ImpDef.Switch_To_New_Task;
+        end loop;
+        C930001_0.Note.Done (5);                     -------> 5
+        
+        -- now check the order
+        for I in Ids range 1..5 loop
+            if Verbose then
+                Report.Comment (Ids'Image (I) & 
+                       Ids'Image (Finalization_Order (I)));
+            end if;
+            if Finalization_Order (I) /= I then
+                Report.Failed ("Finalization occurred out of order" &
+                   " expected:" &
+                   Ids'Image (I) &
+                   " actual:" &
+                   Ids'Image (Finalization_Order (I)));
+            end if;
+        end loop;
+    end;
+
+    Report.Result;
+end C930001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93001a.ada
new file mode 100644
index 000000000..3a3b9833b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93001a.ada
@@ -0,0 +1,296 @@
+-- C93001A.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 DECLARED TASK OBJECTS ARE NOT ACTIVATED BEFORE
+--   THE END OF THE DECLARATIVE PART.
+-- SUBTESTS ARE:
+--   (A)  A SIMPLE TASK OBJECT, IN A BLOCK.
+--   (B)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
+--   (C)  A RECORD OF TASK OBJECT, IN A PACKAGE SPECIFICATION.
+--   (D)  A RECORD OF ARRAY OF TASK OBJECT, IN A PACKAGE BODY.
+--   (E)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
+
+-- THIS TEST ASSUMES THAT ACTIVATION IS A SEQUENTIAL STEP
+--   IN THE FLOW OF CONTROL OF THE PARENT (AS IS REQUIRED BY THE
+--   ADA RM).  IF AN IMPLEMENTATION (ILLEGALLY) ACTIVATES A
+--   TASK IN PARALLEL WITH ITS PARENT, THIS TEST
+--   IS NOT GUARANTEED TO DETECT THE VIOLATION, DUE TO A
+--   RACE CONDITION.
+
+-- JRK 9/23/81
+-- SPS 11/1/82
+-- SPS 11/21/82
+-- R.WILLIAMS 10/8/86  ADDED CHECKS ON INITIALIZATIONS OF NON-TASK
+--                     COMPONENTS OF RECORD TYPES.
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93001A IS
+
+     GLOBAL : INTEGER;
+
+     FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
+     BEGIN
+          GLOBAL := IDENT_INT (I);
+          RETURN 0;
+     END SIDE_EFFECT;
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TASK BODY TT IS
+          I : INTEGER := SIDE_EFFECT (1);
+     BEGIN
+          NULL;
+     END TT;
+
+
+BEGIN
+     TEST ("C93001A", "CHECK THAT DECLARED TASK OBJECTS ARE NOT " &
+                      "ACTIVATED BEFORE THE END OF THE DECLARATIVE " &
+
+                      "PART");
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (A)
+
+          T : TT;
+          I : INTEGER := GLOBAL;
+
+     BEGIN -- (A)
+
+          IF I /= 0 THEN
+               FAILED ("A SIMPLE TASK OBJECT IN A BLOCK WAS " &
+                       "ACTIVATED TOO SOON - (A)");
+          END IF;
+
+     END; -- (A)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (B)
+
+          J : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+               A : ARRAY (1..1) OF TT;
+               I : INTEGER := GLOBAL;
+          BEGIN
+               IF I /= 0 THEN
+                    FAILED ("AN ARRAY OF TASK OBJECT IN A FUNCTION " &
+                            "WAS ACTIVATED TOO SOON - (B)");
+               END IF;
+               RETURN 0;
+          END F;
+
+     BEGIN -- (B)
+
+          J := F ;
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C)
+
+          PACKAGE P IS
+
+               TYPE REC IS
+                    RECORD
+                         T  : TT;
+                         N1 : INTEGER := GLOBAL;
+                    END RECORD;
+
+               TYPE RT IS
+                    RECORD
+                         M : INTEGER := GLOBAL;
+                         T : TT;
+                         N : REC;
+                    END RECORD;
+               R : RT;
+               I : INTEGER := GLOBAL;
+          END P;
+
+          PACKAGE Q IS
+               J : INTEGER;
+          PRIVATE
+               TYPE RT IS
+                    RECORD
+                         N : P.REC;
+                         T : TT;
+                         M : INTEGER := GLOBAL;
+                    END RECORD;
+               R : RT;
+          END Q;
+
+          K : INTEGER := GLOBAL;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF R.M /= 0  OR R.N.N1 /= 0 THEN
+                    FAILED ( "NON-TASK COMPONENTS OF RECORD R NOT " &
+                             "INITIALIZED BEFORE TASKS ACTIVATED " &
+                             "- (C.1)" );
+               END IF;
+          END Q;
+
+     BEGIN -- (C)
+
+          IF P.R.M /= 0 OR P.R.N.N1 /= 0 THEN
+               FAILED ( "NON-TASK COMPONENTS OF RECORDS NOT " &
+                        "INITIALIZED BEFORE TASKS ACTIVATED " &
+                        "- (C.2)" );
+          END IF;
+
+          IF P.I /= 0 OR K /= 0 THEN
+               FAILED ("A RECORD OF TASK OBJECT IN A PACKAGE " &
+                       "SPECIFICATION WAS ACTIVATED TOO SOON - (C)");
+          END IF;
+
+     END; -- (C)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (D)
+
+          PACKAGE P IS
+
+               TYPE GRADE IS (GOOD, FAIR, POOR);
+     
+               TYPE REC (G : GRADE) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               TYPE ACCR IS ACCESS REC;
+               TYPE ACCI IS ACCESS INTEGER;
+
+               TYPE ARR IS ARRAY (1..1) OF TT;
+               TYPE RAT IS
+                    RECORD
+                         M : ACCR := NEW REC (GRADE'VAL (GLOBAL));
+                         A : ARR;
+                         N : ACCI := NEW INTEGER'(GLOBAL);
+                    END RECORD;
+               RA1 : RAT;
+          PRIVATE
+               RA2 : RAT;
+          END P;
+
+          PACKAGE BODY P IS
+               RA3 : RAT;
+               I : INTEGER := GLOBAL;
+          BEGIN
+               IF RA1.M.G /= GOOD  OR RA1.N.ALL /= 0 THEN
+                    FAILED ( "NON-TASK COMPONENTS OF RECORD RA1 NOT " &
+                             "INITIALIZED BEFORE TASKS ACTIVATED " &
+                             "- (D)" );
+               END IF;
+               
+               IF RA2.M.G /= GOOD  OR RA2.N.ALL /= 0 THEN
+                    FAILED ( "NON-TASK COMPONENTS OF RECORD RA2 NOT " &
+                             "INITIALIZED BEFORE TASKS ACTIVATED " &
+                             "- (D)" );
+               END IF;
+               
+               IF RA3.M.G /= GOOD  OR RA3.N.ALL /= 0 THEN
+                    FAILED ( "NON-TASK COMPONENTS OF RECORD RA3 NOT " &
+                             "INITIALIZED BEFORE TASKS ACTIVATED " &
+                             "- (D)" );
+               END IF;
+               
+               IF I /= 0 THEN
+                    FAILED ("A RECORD OF ARRAY OF TASK OBJECT IN A " &
+                            "PACKAGE SPEC OR BODY WAS ACTIVATED " &
+                            "TOO SOON - (D)");
+               END IF;
+          END P;
+
+     BEGIN -- (D)
+
+          NULL;
+
+     END; -- (D)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (E)
+
+          TYPE REC IS
+               RECORD
+                    B : BOOLEAN := BOOLEAN'VAL (GLOBAL);
+                    T : TT;
+                    C :CHARACTER :=CHARACTER'VAL (GLOBAL);
+               END RECORD;
+
+          TASK T IS
+               ENTRY E;
+          END T;
+
+          TASK BODY T IS
+               TYPE RT IS
+                    RECORD
+                         M : REC;
+                         T : TT;
+                         N : REC;
+                    END RECORD;
+               AR : ARRAY (1..1) OF RT;
+               I : INTEGER := GLOBAL;
+          BEGIN
+               IF AR (1).M.B /= FALSE OR AR (1).M.C /= ASCII.NUL OR
+                  AR (1).N.B /= FALSE OR AR (1).N.C /= ASCII.NUL THEN
+                    FAILED ( "NON-TASK COMPONENTS OF RECORD RT NOT " &
+                             "INITIALIZED BEFORE TASKS ACTIVATED " &
+                             "- (E)" );
+               END IF;
+               
+               IF I /= 0 THEN
+                    FAILED ("AN ARRAY OF RECORD OF TASK OBJECT IN A " &
+                            "TASK BODY WAS ACTIVATED TOO SOON - (E)");
+               END IF;
+          END T;
+
+     BEGIN -- (E)
+
+          NULL;
+
+     END; -- (E)
+
+     --------------------------------------------------
+
+     RESULT;
+END C93001A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93002a.ada
new file mode 100644
index 000000000..a9999ad2a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93002a.ada
@@ -0,0 +1,231 @@
+-- C93002A.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 DECLARED TASK OBJECTS ARE ACTIVATED BEFORE EXECUTION
+--   OF THE FIRST STATEMENT FOLLOWING THE DECLARATIVE PART.
+-- SUBTESTS ARE:
+--   (A)  A SIMPLE TASK OBJECT, IN A BLOCK.
+--   (B)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
+--   (C)  A RECORD OF TASK OBJECT, IN A PACKAGE SPECIFICATION.
+--   (D)  A RECORD OF ARRAY OF TASK OBJECT, IN A PACKAGE BODY.
+--   (E)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
+
+-- JRK 9/28/81
+-- SPS 11/1/82
+-- SPS 11/21/82
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93002A IS
+
+     GLOBAL : INTEGER;
+
+     FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
+     BEGIN
+          GLOBAL := IDENT_INT (I);
+          RETURN 0;
+     END SIDE_EFFECT;
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TASK BODY TT IS
+          I : INTEGER := SIDE_EFFECT (1);
+     BEGIN
+          NULL;
+     END TT;
+
+
+BEGIN
+     TEST ("C93002A", "CHECK THAT DECLARED TASK OBJECTS ARE " &
+                      "ACTIVATED BEFORE EXECUTION OF THE FIRST " &
+                      "STATEMENT FOLLOWING THE DECLARATIVE PART");
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (A)
+
+          T : TT;
+
+     BEGIN -- (A)
+
+          IF GLOBAL /= 1 THEN
+               FAILED ("A SIMPLE TASK OBJECT IN A BLOCK WAS " &
+                       "ACTIVATED TOO LATE - (A)");
+          END IF;
+
+     END; -- (A)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (B)
+
+          J : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+               A : ARRAY (1..1) OF TT;
+          BEGIN
+               IF GLOBAL /= 1 THEN
+                    FAILED ("AN ARRAY OF TASK OBJECT IN A FUNCTION " &
+                            "WAS ACTIVATED TOO LATE - (B)");
+               END IF;
+               RETURN 0;
+          END F;
+
+     BEGIN -- (B)
+
+          J := F ;
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C1)
+
+          PACKAGE P IS
+               TYPE ARR IS ARRAY (1..1) OF TT;
+               TYPE RT IS
+                    RECORD
+                         A : ARR;
+                    END RECORD;
+               R : RT;
+          END P;
+
+          PACKAGE BODY P IS
+          BEGIN
+               IF GLOBAL /= 1 THEN
+                    FAILED ("A RECORD OF TASK OBJECT IN A PACKAGE " &
+                            "SPECIFICATION WAS ACTIVATED TOO LATE " &
+                            "- (C1)");
+               END IF;
+          END P;
+
+     BEGIN -- (C1)
+
+          NULL;
+
+     END; -- (C1)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C2)
+
+          PACKAGE Q IS
+               J : INTEGER;
+          PRIVATE
+               TYPE RT IS
+                    RECORD
+                         T : TT;
+                    END RECORD;
+               R : RT;
+          END Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF GLOBAL /= 1 THEN
+                    FAILED ("A RECORD OF TASK OBJECT IN A PACKAGE " &
+                            "SPECIFICATION WAS ACTIVATED TOO LATE " &
+                            "- (C2)");
+               END IF;
+          END Q;
+
+     BEGIN -- (C2)
+
+          NULL;
+
+     END; -- (C2)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (D)
+
+          PACKAGE P IS
+               TYPE ARR IS ARRAY (1..1) OF TT;
+               TYPE RAT IS
+                    RECORD
+                         A : ARR;
+                    END RECORD;
+          END P;
+
+          PACKAGE BODY P IS
+               RA : RAT;
+          BEGIN
+               IF GLOBAL /= 1 THEN
+                    FAILED ("A RECORD OF ARRAY OF TASK OBJECT IN A " &
+                            "PACKAGE BODY WAS ACTIVATED " &
+                            "TOO LATE - (D)");
+               END IF;
+          END P;
+
+     BEGIN -- (D)
+
+          NULL;
+
+     END; -- (D)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (E)
+
+          TASK T IS
+               ENTRY E;
+          END T;
+
+          TASK BODY T IS
+               TYPE RT IS
+                    RECORD
+                         T : TT;
+                    END RECORD;
+               AR : ARRAY (1..1) OF RT;
+          BEGIN
+               IF GLOBAL /= 1 THEN
+                    FAILED ("AN ARRAY OF RECORD OF TASK OBJECT IN A " &
+                            "TASK BODY WAS ACTIVATED TOO LATE - (E)");
+               END IF;
+          END T;
+
+     BEGIN -- (E)
+
+          NULL;
+
+     END; -- (E)
+
+     --------------------------------------------------
+
+     RESULT;
+END C93002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93003a.ada
new file mode 100644
index 000000000..48dced34e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93003a.ada
@@ -0,0 +1,351 @@
+-- C93003A.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 ACTIVATION OF TASKS CREATED BY ALLOCATORS PRESENT IN A
+--   DECLARATIVE PART TAKES PLACE DURING ELABORATION OF THE
+--   CORRESPONDING DECLARATION.
+-- SUBTESTS ARE:
+--   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+--   (B)  AN ARRAY OF TASK ALLOCATOR, IN A FUNCTION.
+--   (C)  A RECORD OF TASK ALLOCATOR, IN A PACKAGE SPECIFICATION.
+--   (D)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A PACKAGE BODY.
+--   (E)  AN ARRAY OF RECORD OF TASK ALLOCATOR, IN A TASK BODY.
+
+-- JRK 9/28/81
+-- SPS 11/11/82
+-- SPS 11/21/82
+-- RJW 8/4/86    ADDED CHECKS ON INITIALIZATIONS OF NON-TASK COMPONENTS
+--               OF RECORD TYPES.
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93003A IS
+
+     GLOBAL : INTEGER;
+
+     FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
+     BEGIN
+          GLOBAL := IDENT_INT (I);
+          RETURN 0;
+     END SIDE_EFFECT;
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TASK BODY TT IS
+          I : INTEGER := SIDE_EFFECT (1);
+     BEGIN
+          NULL;
+     END TT;
+
+
+BEGIN
+     TEST ("C93003A", "CHECK THAT ACTIVATION OF TASKS CREATED BY " &
+                      "ALLOCATORS PRESENT IN A DECLARATIVE PART " &
+                      "TAKES PLACE DURING ELABORATION OF THE " &
+                      "CORRESPONDING DECLARATION");
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (A)
+
+          TYPE A IS ACCESS TT;
+          T1 : A := NEW TT;
+          I1 : INTEGER := GLOBAL;
+          J  : INTEGER := SIDE_EFFECT (0);
+          T2 : A := NEW TT;
+          I2 : INTEGER := GLOBAL;
+
+     BEGIN -- (A)
+
+          IF I1 /= 1 OR I2 /= 1 THEN
+               FAILED ("A SIMPLE TASK ALLOCATOR IN A BLOCK WAS " &
+                       "ACTIVATED TOO LATE - (A)");
+          END IF;
+
+     END; -- (A)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (B)
+
+          J : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+
+               TYPE A_T IS ARRAY (1 .. 1) OF TT;
+               TYPE A IS ACCESS A_T;
+               A1 : A := NEW A_T;
+               I1 : INTEGER := GLOBAL;
+               J  : INTEGER := SIDE_EFFECT (0);
+               A2 : A := NEW A_T;
+               I2 : INTEGER := GLOBAL;
+
+          BEGIN
+               IF I1 /= 1 OR I2 /= 1 THEN
+                    FAILED ("AN ARRAY OF TASK ALLOCATOR IN A " &
+                            "FUNCTION WAS ACTIVATED TOO LATE - (B)");
+               END IF;
+               RETURN 0;
+          END F;
+
+     BEGIN -- (B)
+
+          J := F ;
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C1)
+
+          PACKAGE P IS
+
+               TYPE INTREC IS
+                    RECORD
+                         N1 : INTEGER := GLOBAL;
+                    END RECORD;
+
+               TYPE RT IS
+                    RECORD
+                         M : INTEGER := GLOBAL;
+                         T : TT;
+                         N : INTREC;
+                    END RECORD;
+
+               TYPE A IS ACCESS RT;
+
+               R1 : A := NEW RT;
+               I1 : INTEGER := GLOBAL;
+               J  : INTEGER := SIDE_EFFECT (0);
+               R2 : A := NEW RT;
+               I2 : INTEGER := GLOBAL;
+
+          END P;
+
+     BEGIN -- (C1)
+
+          IF P.R1.M /= 0 OR P.R1.N.N1 /= 0 THEN 
+               FAILED ("NON-TASK COMPONENTS OF RECORD R1 NOT " &
+                       "INITIALIZED BEFORE TASK ACTIVATED - (C1)" );
+          END IF;
+
+          IF P.R2.M /= 0 OR P.R2.N.N1 /= 0 THEN 
+               FAILED ("NON-TASK COMPONENTS OF RECORD R2 NOT " &
+                       "INITIALIZED BEFORE TASK ACTIVATED - (C1)" );
+          END IF;
+
+          IF P.I1 /= 1 OR P.I2 /= 1 THEN
+               FAILED ("A RECORD OF TASK ALLOCATOR IN A PACKAGE " &
+                       "SPECIFICATION WAS ACTIVATED TOO LATE - (C1)");
+          END IF;
+
+     END; -- (C1)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C2)
+
+          PACKAGE Q IS
+               J1 : INTEGER;
+          PRIVATE
+               
+               TYPE GRADE IS (GOOD, FAIR, POOR);
+     
+               TYPE REC (G : GRADE) IS
+                    RECORD
+                         NULL;
+                    END RECORD;
+
+               TYPE ACCR IS ACCESS REC;
+
+               TYPE ACCI IS ACCESS INTEGER;
+
+               TYPE RT IS
+                    RECORD
+                         M : ACCR := NEW REC (GRADE'VAL (GLOBAL));
+                         T : TT;
+                         N : ACCI := NEW INTEGER'(GLOBAL);
+                    END RECORD;
+
+               TYPE A IS ACCESS RT;
+
+               R1 : A := NEW RT;
+               I1 : INTEGER := GLOBAL;
+               J2 : INTEGER := SIDE_EFFECT (0);
+               R2 : A := NEW RT;
+               I2 : INTEGER := GLOBAL;
+
+          END Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               IF R1.M.G /= GOOD OR R1.N.ALL /= 0 THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD R1 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (C2)" );
+               END IF;
+
+               IF R2.M.G /= GOOD OR R2.N.ALL /= 0 THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD R2 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (C2)" );
+               END IF;
+
+               IF I1 /= 1 OR I2 /= 1 THEN
+                    FAILED ("A RECORD OF TASK ALLOCATOR IN A PACKAGE " &
+                            "SPECIFICATION WAS ACTIVATED TOO LATE " &
+                            "- (C2)");
+               END IF;
+          END Q;
+
+     BEGIN -- (C2)
+
+          NULL;
+
+     END; -- (C2)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (D)
+
+          PACKAGE P IS
+
+               TYPE ARR IS ARRAY (1 .. 1) OF TT;
+               TYPE INTARR IS ARRAY (1 .. 1) OF INTEGER;
+
+               TYPE RAT IS
+                    RECORD
+                         M : INTARR := (1 => GLOBAL);
+                         A : ARR;
+                         N : INTARR := (1 => GLOBAL);
+                    END RECORD;
+          END P;
+
+          PACKAGE BODY P IS
+
+               TYPE A IS ACCESS RAT;
+
+               RA1 : A := NEW RAT;
+               I1  : INTEGER := GLOBAL;
+               J   : INTEGER := SIDE_EFFECT (0);
+               RA2 : A := NEW RAT;
+               I2  : INTEGER := GLOBAL;
+
+          BEGIN
+               IF RA1.M (1) /= 0 OR RA1.N (1) /= 0 THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD RA1 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (D)" );
+               END IF;
+
+               IF RA2.M (1) /= 0 OR RA2.N (1) /= 0 THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD RA2 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (D)" );
+               END IF;
+
+               IF I1 /= 1 OR I2 /= 1 THEN
+                    FAILED ("A RECORD OF ARRAY OF TASK ALLOCATOR IN " &
+                            "A PACKAGE BODY WAS ACTIVATED " &
+                            "TOO LATE - (D)");
+               END IF;
+          END P;
+
+     BEGIN -- (D)
+
+          NULL;
+
+     END; -- (D)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (E)
+
+          TASK T IS
+               ENTRY E;
+          END T;
+
+          TASK BODY T IS
+               TYPE RT IS
+                    RECORD
+                         M : BOOLEAN := BOOLEAN'VAL (GLOBAL);
+                         T : TT;
+                         N : CHARACTER := CHARACTER'VAL (GLOBAL);
+                    END RECORD;
+
+               TYPE ART IS ARRAY (1 .. 1) OF RT;
+               TYPE A IS ACCESS ART;
+
+               AR1 : A := NEW ART;
+               I1  : INTEGER := GLOBAL;
+               J   : INTEGER := SIDE_EFFECT (0);
+               AR2 : A := NEW ART;
+               I2  : INTEGER := GLOBAL;
+
+          BEGIN
+               IF AR1.ALL (1).M /= FALSE     OR 
+                  AR1.ALL (1).N /= ASCII.NUL THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD AR1 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (E)" );
+               END IF;
+
+               IF AR2.ALL (1).M /= FALSE     OR 
+                  AR2.ALL (1).N /= ASCII.NUL THEN 
+                    FAILED ("NON-TASK COMPONENTS OF RECORD AR2 NOT " &
+                            "INITIALIZED BEFORE TASK ACTIVATED " &
+                            "- (E)" );
+               END IF;
+
+               IF I1 /= 1 OR I2 /= 1 THEN
+                    FAILED ("AN ARRAY OF RECORD OF TASK ALLOCATOR IN " &
+                            "A TASK BODY WAS ACTIVATED TOO LATE - (E)");
+               END IF;
+          END T;
+
+     BEGIN -- (E)
+
+          NULL;
+
+     END; -- (E)
+
+     --------------------------------------------------
+
+     RESULT;
+END C93003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004a.ada
new file mode 100644
index 000000000..688bec139
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004a.ada
@@ -0,0 +1,67 @@
+-- C93004A.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 TASK BECOMES COMPLETED WHEN AN EXCEPTION OCCURS DURING
+-- ITS ACTIVATION.
+
+-- WEI  3/ 4/82
+
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C93004A IS
+BEGIN
+
+     TEST ("C93004A", "TASK COMPLETION CAUSED BY EXCEPTION");
+
+BLOCK:
+     DECLARE
+          TYPE I0 IS RANGE 0..1;
+
+          TASK T1 IS
+               ENTRY BYE;
+          END T1;
+
+          TASK BODY T1 IS
+               SUBTYPE I1 IS I0 RANGE 0 .. 2;     -- CONSTRAINT ERROR.
+          BEGIN
+               ACCEPT BYE;
+          END T1;
+     BEGIN
+          FAILED ("NO EXCEPTION RAISED");
+          IF NOT T1'TERMINATED THEN 
+               FAILED ("TASK NOT TERMINATED");
+               T1.BYE;
+          END IF;
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               NULL;
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED");
+     END BLOCK;
+
+     RESULT;
+
+END C93004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004b.ada
new file mode 100644
index 000000000..0b140f59c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004b.ada
@@ -0,0 +1,132 @@
+-- C93004B.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 WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
+-- TASK, OTHER TASKS ARE UNAFFECTED.
+
+-- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
+
+-- CHECK THAT TASKS WAITING ON ENTRIES OF SUCH TASKS RECEIVE
+-- TASKING_ERROR
+
+-- JEAN-PIERRE ROSEN 09-MAR-1984
+-- JBG 06/01/84
+-- JBG 05/23/85
+-- EG  10/29/85 ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93004B IS
+
+BEGIN
+     TEST("C93004B", "EXCEPTIONS DURING ACTIVATION");
+
+     DECLARE
+
+          TASK TYPE T1 IS
+          END T1;
+
+          TASK TYPE T2 IS
+               ENTRY E;
+          END T2;
+
+          ARR_T2: ARRAY(INTEGER RANGE 1..1) OF T2;
+
+          TYPE AT1 IS ACCESS T1;
+
+          PACKAGE START_T1 IS  -- THIS PACKAGE TO AVOID ACCESS BEFORE
+          END START_T1;        -- ELABORATION ON T1.
+
+          TASK BODY T1 IS
+          BEGIN
+               DECLARE    -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES.
+                    TASK T1BIS IS
+                    END T1BIS;
+
+                    TASK BODY T1BIS IS
+                    BEGIN
+                         ARR_T2(IDENT_INT(1)).E;
+                         FAILED ("RENDEZVOUS COMPLETED - T1BIS");
+                    EXCEPTION
+                         WHEN TASKING_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("ABNORMAL EXCEPTION - T1BIS");
+                    END T1BIS;
+               BEGIN
+                    NULL;
+               END;
+
+               ARR_T2(IDENT_INT(1)).E;  -- ARR_T2(1) IS NOW TERMINATED.
+
+               FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
+
+          EXCEPTION
+               WHEN TASKING_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("ABNORMAL EXCEPTION - T1");
+          END;
+
+          PACKAGE BODY START_T1 IS
+               V_AT1 : AT1 := NEW T1;
+          END START_T1;
+
+          TASK BODY T2 IS
+               I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+          BEGIN
+               IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
+                    FAILED("T2 ACTIVATED OK");
+               END IF;
+          END T2;
+
+          TASK T3 IS
+               ENTRY E;
+          END T3;
+
+          TASK BODY T3 IS
+          BEGIN     -- T3 MUST BE ACTIVATED OK.
+               ACCEPT E;
+          END T3;
+
+     BEGIN
+          FAILED ("TASKING_ERROR NOT RAISED IN MAIN");
+          T3.E;          -- CLEAN UP.
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               BEGIN
+                    T3.E;
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         FAILED ("T3 NOT ACTIVATED");
+               END;
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED IN MAIN");
+          WHEN OTHERS =>
+               FAILED ("ABNORMAL EXCEPTION IN MAIN-2");
+     END;
+
+     RESULT;
+END C93004B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004c.ada
new file mode 100644
index 000000000..bb4d68b5b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004c.ada
@@ -0,0 +1,136 @@
+-- C93004C.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 WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
+-- TASK, OTHER TASKS ARE UNAFFECTED.
+
+-- IF SEVERAL TASKS FAIL THEIR ACTIVATION, ONLY ONE TASKING_ERROR IS
+-- RAISED.
+
+-- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
+
+-- CHECK THAT TASKS WAITING ON ENTRIES OF SUCH TASKS RECEIVE
+-- TASKING_ERROR
+
+-- JEAN-PIERRE ROSEN 09-MAR-1984
+-- JBG 06/01/84
+-- JBG 05/23/85
+-- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93004C IS
+
+BEGIN
+     TEST("C93004C", "EXCEPTIONS DURING ACTIVATION");
+
+     DECLARE
+
+          TASK TYPE T1 IS
+          END T1;
+
+          TASK TYPE T2 IS
+               ENTRY E;
+          END T2;
+
+          ARR_T2: ARRAY(INTEGER RANGE 1..4) OF T2;
+
+          TYPE AT1 IS ACCESS T1;
+
+          PACKAGE START_T1 IS      -- THIS PACKAGE TO AVOID ACCESS
+          END START_T1;            -- BEFORE ELABORATION ON T1.
+
+          TASK BODY T1 IS
+          BEGIN
+               DECLARE   -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES.
+                    TASK T1BIS IS
+                    END T1BIS;
+
+                    TASK BODY T1BIS IS
+                    BEGIN
+                         ARR_T2(IDENT_INT(2)).E;
+                         FAILED ("RENDEZVOUS COMPLETED - T3");
+                    EXCEPTION
+                         WHEN TASKING_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("ABNORMAL EXCEPTION - T3");
+                    END T1BIS;
+               BEGIN
+                    NULL;
+               END;
+
+               ARR_T2(IDENT_INT(2)).E;   -- ARR_T2(2) IS NOW TERMINATED.
+
+               FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
+
+          EXCEPTION
+               WHEN TASKING_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("ABNORMAL EXCEPTION - T1");
+          END;
+
+          PACKAGE BODY START_T1 IS
+               V_AT1 : AT1 := NEW T1;
+          END START_T1;
+
+          TASK BODY T2 IS
+               I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+          BEGIN
+               IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
+                    FAILED("T2 ACTIVATED OK");
+               END IF;
+          END T2;
+
+          TASK T3 IS
+               ENTRY E;
+          END T3;
+
+          TASK BODY T3 IS
+          BEGIN     -- T3 MUST BE ACTIVATED OK.
+               ACCEPT E;
+          END T3;
+
+     BEGIN
+          FAILED ("TASKING_ERROR NOT RAISED IN MAIN");
+          T3.E;          -- CLEAN UP.
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               BEGIN
+                    T3.E;
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         FAILED ("T3 NOT ACTIVATED");
+               END;
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED IN MAIN");
+          WHEN OTHERS =>
+               FAILED ("ABNORMAL EXCEPTION IN MAIN-2");
+     END;
+
+     RESULT;
+
+END C93004C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004d.ada
new file mode 100644
index 000000000..40eb01fba
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004d.ada
@@ -0,0 +1,152 @@
+-- C93004D.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 WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
+-- TASK, OTHER TASKS ARE UNAFFECTED.
+
+-- THIS TEST CHECKS THE CASE IN WHICH SOME OF THE OTHER TASKS ARE 
+-- PERHAPS ACTIVATED BEFORE THE EXCEPTION OCCURS AND SOME TASKS ARE 
+-- PERHAPS ACTIVATED AFTER.
+
+-- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
+
+-- CHECK THAT TASKS WAITING FOR ENTRIES OF SUCH TASKS RECEIVE
+-- TASKING_ERROR.
+
+-- R. WILLIAMS 8/6/86
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE C93004D IS
+
+          
+BEGIN
+     TEST ( "C93004D", "CHECK THAT WHEN AN EXCEPTION IS RAISED " &
+                       "DURING ACTIVATION OF A TASK, OTHER TASKS " &
+                       "ARE NOT AFFECTED. IN THIS TEST, SOME OF THE " &
+                       "TASKS ARE PERHAPS ACTIVATED BEFORE THE " &
+                       "EXCEPTION OCCURS AND SOME PERHAPS AFTER" );
+
+
+     DECLARE
+
+          TASK T0 IS
+               ENTRY E;
+          END T0;
+
+          TASK TYPE T1 IS
+          END T1;
+
+          TASK TYPE T2 IS
+               ENTRY E;
+          END T2;     
+
+          ARR_T2: ARRAY(INTEGER RANGE 1..4) OF T2;
+
+          TYPE AT1 IS ACCESS T1;
+
+          TASK BODY T0 IS
+          BEGIN
+               ACCEPT E;
+          END T0;
+
+          PACKAGE START_T1 IS      -- THIS PACKAGE TO AVOID ACCESS
+          END START_T1;            -- BEFORE ELABORATION ON T1.
+
+          TASK BODY T1 IS
+          BEGIN
+               DECLARE   -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES.
+                    TASK T1BIS IS
+                    END T1BIS;
+
+                    TASK BODY T1BIS IS
+                    BEGIN
+                         ARR_T2(IDENT_INT(2)).E;
+                         FAILED ("RENDEZVOUS COMPLETED - T3");
+                    EXCEPTION
+                         WHEN TASKING_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("ABNORMAL EXCEPTION - T3");
+                    END T1BIS;
+               BEGIN
+                    NULL;
+               END;
+
+               ARR_T2(IDENT_INT(2)).E;   -- ARR_T2(2) IS NOW 
+                                         -- TERMINATED.
+
+               FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
+
+          EXCEPTION
+               WHEN TASKING_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("ABNORMAL EXCEPTION - T1");
+          END;
+
+          PACKAGE BODY START_T1 IS
+               V_AT1 : AT1 := NEW T1;
+          END START_T1;
+
+          TASK BODY T2 IS
+               I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+          BEGIN
+               IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
+                    FAILED("T2 ACTIVATED OK");
+               END IF;
+          END T2;
+
+          TASK T3 IS
+               ENTRY E;
+          END T3;
+
+          TASK BODY T3 IS
+          BEGIN     -- T3 MUST BE ACTIVATED OK.
+               ACCEPT E;
+          END T3;
+
+     BEGIN -- T0, ARR_T2 (1 .. 4), T3 ACTIVATED HERE.
+
+          FAILED ("TASKING_ERROR NOT RAISED IN MAIN");
+          T3.E;          -- CLEAN UP.
+          T0.E;
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               BEGIN
+                    T3.E;
+                    T0.E;
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         FAILED ("T0 OR T3 NOT ACTIVATED");
+               END;
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED IN MAIN");
+          WHEN OTHERS =>
+               FAILED ("ABNORMAL EXCEPTION IN MAIN-2");
+     END;
+
+     RESULT;
+END C93004D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004f.ada
new file mode 100644
index 000000000..9267d3ec8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93004f.ada
@@ -0,0 +1,130 @@
+-- C93004F.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 WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
+-- TASK, OTHER TASKS ARE UNAFFECTED.
+
+-- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
+
+-- THIS TESTS CHECKS THE CASE IN WHICH THE TASKS ARE CREATED BY THE
+-- ALLOCATION OF A RECORD OF TASKS OR AN ARRAY OF TASKS.
+
+-- R. WILLIAMS 8/7/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C93004F IS
+
+BEGIN
+     TEST ( "C93004F", "CHECK THAT WHEN AN EXCEPTION IS RAISED " &
+                       "DURING THE ACTIVATION OF A TASK, OTHER " &
+                       "TASKS ARE UNAFFECTED. IN THIS TEST, THE " &
+                       "TASKS ARE CREATED BY THE ALLOCATION OF A " &
+                       "RECORD OR AN ARRAY OF TASKS" );
+
+     DECLARE
+
+          TASK TYPE T IS 
+               ENTRY E;
+          END T;
+
+          TASK TYPE TT;
+
+          TASK TYPE TX IS 
+               ENTRY E;
+          END TX;
+
+          TYPE REC IS
+               RECORD
+                    TR : T;
+               END RECORD;
+
+          TYPE ARR IS ARRAY (IDENT_INT (1) .. IDENT_INT (1)) OF T;
+
+          TYPE RECX IS
+               RECORD 
+                    TTX1 : TX;
+                    TTT  : TT;
+                    TTX2 : TX;
+               END RECORD;
+
+          TYPE ACCR IS ACCESS REC;
+          AR : ACCR;
+
+          TYPE ACCA IS ACCESS ARR;
+          AA : ACCA;
+               
+          TYPE ACCX IS ACCESS RECX;
+          AX : ACCX;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E;
+          END T;
+
+          TASK BODY TT IS
+          BEGIN
+               AR.TR.E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "TASK AR.TR NOT ACTIVE" );
+          END TT;
+
+          TASK BODY TX IS
+               I : POSITIVE := IDENT_INT (0); -- RAISE 
+                                              -- CONSTRAINT_ERROR.
+          BEGIN
+               IF I /= IDENT_INT (2) OR I = IDENT_INT (1) + 1 THEN
+                    FAILED ( "TX ACTIVATED OK" );
+               END IF;
+          END TX;
+
+     BEGIN
+          AR := NEW REC;
+          AA := NEW ARR;
+          AX := NEW RECX;
+
+          FAILED ( "TASKING_ERROR NOT RAISED IN MAIN" );
+          
+          AA.ALL (1).E;        -- CLEAN UP.
+
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+
+               BEGIN
+                    AA.ALL (1).E;
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         FAILED ( "AA.ALL (1) NOT ACTIVATED" );
+               END;
+
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ( "CONSTRAINT_ERROR RAISED IN MAIN" );
+          WHEN OTHERS =>
+               FAILED ( "ABNORMAL EXCEPTION IN MAIN" );
+     END;
+
+     RESULT;
+
+END C93004F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005a.ada
new file mode 100644
index 000000000..95626f688
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005a.ada
@@ -0,0 +1,130 @@
+-- C93005A.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 WHEN AN EXCEPTION IS RAISED IN A DECLARATIVE PART, A TASK
+-- DECLARED IN THE SAME DECLARATIVE PART BECOMES TERMINATED.
+
+-- CHECK THAT A TASK WAITING ON ENTRIES OF SUCH A
+-- TERMINATED-BEFORE-ACTIVATION TASK RECEIVES TASKING_ERROR.
+
+-- JEAN-PIERRE ROSEN 3/9/84
+-- JBG 06/01/84
+-- JBG 05/23/85
+-- EG  10/29/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93005A IS
+
+BEGIN
+     TEST("C93005A", "EXCEPTIONS RAISED IN A DECLARATIVE PART " &
+                     "CONTAINING TASKS");
+
+     BEGIN
+
+          DECLARE
+               TASK TYPE T1 IS     -- CHECKS THAT T2 TERMINATES.
+               END T1;
+
+               TYPE AT1 IS ACCESS T1;
+
+               TASK T2 IS          -- WILL NEVER BE ACTIVATED.
+                    ENTRY E;
+               END T2;
+
+               PACKAGE RAISE_IT IS
+               END RAISE_IT;
+
+               TASK BODY T2 IS
+               BEGIN
+                    FAILED ("T2 ACTIVATED");
+                    -- IN CASE OF FAILURE
+                    LOOP
+                         SELECT
+                              ACCEPT E;
+                         OR
+                              TERMINATE;
+                         END SELECT;
+                    END LOOP;
+               END T2;
+
+               TASK BODY T1 IS
+               BEGIN
+                    DECLARE  -- THIS BLOCK TO CHECK THAT T3 TERMINATES.
+                         TASK T3 IS
+                         END T3;
+
+                         TASK BODY T3 IS
+                         BEGIN
+                              T2.E;
+                              FAILED ("RENDEZVOUS COMPLETED WITHOUT " &
+                                      "ERROR - T3");
+                         EXCEPTION
+                              WHEN TASKING_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED("ABNORMAL EXCEPTION - T3");
+                         END T3;
+                    BEGIN
+                         NULL;
+                    END;
+
+                    T2.E;    --T2 IS NOW TERMINATED
+
+                    FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
+
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("ABNORMAL EXCEPTION - T1");
+               END;
+
+               PACKAGE BODY RAISE_IT IS
+                    PT1 : AT1 := NEW T1;
+                    I   : POSITIVE := IDENT_INT(0); -- RAISE
+                                                    -- CONSTRAINT_ERROR.
+               BEGIN
+                    IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
+                         FAILED ("PACKAGE DIDN'T RAISE EXCEPTION");
+                    END IF;
+               END RAISE_IT;
+
+          BEGIN     -- CAN'T LEAVE BLOCK UNTIL T1, T2, AND T3 ARE TERM.
+               FAILED ("EXCEPTION NOT RAISED");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR IN MAIN PROGRAM");
+          WHEN OTHERS =>
+               FAILED ("ABNORMAL EXCEPTION IN MAIN-1");
+     END;
+
+     RESULT;
+
+END C93005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005b.ada
new file mode 100644
index 000000000..1b621c0de
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005b.ada
@@ -0,0 +1,273 @@
+-- C93005B.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 WHEN AN EXCEPTION IS RAISED IN A DECLARATIVE PART, A TASK
+-- DECLARED IN THE SAME DECLARATIVE PART BECOMES TERMINATED.
+
+-- CHECK THAT A TASK WAITING ON ENTRIES OF SUCH A
+-- TERMINATED-BEFORE-ACTIVATION TASK RECEIVES TASKING_ERROR.
+
+-- THIS TEST CHECKS THE CASE IN WHICH SEVERAL TASKS ARE WAITING FOR
+-- ACTIVATION WHEN THE EXCEPTION OCCURS.
+
+-- R. WILLIAMS 8/7/86
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE C93005B IS
+
+
+BEGIN
+     TEST ( "C93005B", "CHECK THAT WHEN AN EXCEPTION IS RAISED IN A " &
+                       "DECLARATIVE PART, A TASK DECLARED IN THE " &
+                       "SAME DECLARATIVE PART BECOMES TERMINATED. " &
+                       "IN THIS CASE, SEVERAL TASKS ARE WAITING FOR " &
+                       "ACTIVATION WHEN THE EXCEPTION OCCURS" );
+ 
+     BEGIN
+ 
+          DECLARE
+               TASK TYPE TA IS      -- CHECKS THAT TX TERMINATES.
+               END TA;
+  
+               TYPE ATA IS ACCESS TA;
+ 
+               TASK TYPE TB IS      -- CHECKS THAT TY TERMINATES.
+               END TB;
+                 
+               TYPE TBREC IS
+                    RECORD
+                         TTB: TB;
+                    END RECORD;
+  
+               TASK TX IS          -- WILL NEVER BE ACTIVATED.
+                    ENTRY E;
+               END TX;
+
+               TASK BODY TA IS
+               BEGIN
+                    DECLARE  -- THIS BLOCK TO CHECK THAT TAB 
+                             -- TERMINATES.
+                         TASK TAB IS
+                         END TAB;
+
+                         TASK BODY TAB IS
+                         BEGIN
+                              TX.E;
+                              FAILED ( "RENDEZVOUS COMPLETED " &
+                                       "WITHOUT ERROR - TAB" );
+                         EXCEPTION
+                              WHEN TASKING_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ( "ABNORMAL EXCEPTION " &
+                                            "- TAB" );
+                         END TAB;
+                    BEGIN
+                         NULL;
+                    END;
+  
+                    TX.E;    --TX IS NOW TERMINATED.
+ 
+                    FAILED ( "RENDEZVOUS COMPLETED WITHOUT ERROR " &
+                             "- TA" );
+  
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "ABNORMAL EXCEPTION - TA" );
+               END TA;
+ 
+               PACKAGE RAISE_IT IS 
+                    TASK TY IS             -- WILL NEVER BE ACTIVATED.
+                         ENTRY E;
+                    END TY;                                         
+               END RAISE_IT;
+ 
+               TASK BODY TB IS
+               BEGIN
+                    DECLARE  -- THIS BLOCK TO CHECK THAT TBB 
+                             -- TERMINATES.
+                         TASK TBB IS
+                         END TBB;
+ 
+                         TASK BODY TBB IS
+                         BEGIN
+                              RAISE_IT.TY.E;
+                              FAILED ( "RENDEZVOUS COMPLETED " &
+                                       "WITHOUT ERROR - TBB" );
+                         EXCEPTION
+                              WHEN TASKING_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ( "ABNORMAL EXCEPTION " &
+                                            "- TBB" );
+                         END TBB;
+                    BEGIN
+                         NULL;
+                    END;
+
+                    RAISE_IT.TY.E;    -- TY IS NOW TERMINATED.
+
+                    FAILED ( "RENDEZVOUS COMPLETED WITHOUT ERROR " &
+                             "- TB" );
+
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "ABNORMAL EXCEPTION - TB" );
+               END TB;
+
+               PACKAGE START_TC IS END START_TC;
+
+               TASK BODY TX IS
+               BEGIN
+                    FAILED ( "TX ACTIVATED" );
+                    -- IN CASE OF FAILURE.
+                    LOOP
+                         SELECT
+                              ACCEPT E;
+                         OR
+                              TERMINATE;
+                         END SELECT;
+                    END LOOP;
+               END TX;
+
+               PACKAGE START_TZ IS
+                    TASK TZ IS             -- WILL NEVER BE ACTIVATED.
+                         ENTRY E;
+                    END TZ;
+               END START_TZ;
+
+               PACKAGE BODY START_TC IS
+                    TBREC1 : TBREC;     -- CHECKS THAT TY TERMINATES.
+
+                    TASK TC IS -- CHECKS THAT TZ TERMINATES.
+                    END TC;
+                
+                    TASK BODY TC IS
+                    BEGIN
+                         DECLARE  -- THIS BLOCK TO CHECK THAT TCB 
+                                  -- TERMINATES.
+ 
+                              TASK TCB IS
+                              END TCB;
+          
+                              TASK BODY TCB IS
+                              BEGIN
+                                   START_TZ.TZ.E;
+                                   FAILED ( "RENDEZVOUS COMPLETED " &
+                                            "WITHOUT " &
+                                            "ERROR - TCB" );
+                              EXCEPTION
+                                   WHEN TASKING_ERROR =>
+                                        NULL;
+                                   WHEN OTHERS =>
+                                        FAILED ( "ABNORMAL " &
+                                                 "EXCEPTION - TCB" );
+                              END TCB;
+                         BEGIN
+                              NULL;
+                         END;
+
+                         START_TZ.TZ.E;    -- TZ IS NOW TERMINATED.
+      
+                         FAILED ( "RENDEZVOUS COMPLETED WITHOUT " &
+                                  "ERROR - TC" );
+      
+                    EXCEPTION
+                         WHEN TASKING_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ( "ABNORMAL EXCEPTION - TC" );
+                    END TC;
+               END START_TC;     -- TBREC1 AND TC ACTIVATED HERE.
+                     
+               PACKAGE BODY RAISE_IT IS
+                    NTA : ATA := NEW TA;  -- NTA.ALL ACTIVATED HERE.
+ 
+                    TASK BODY TY IS
+                    BEGIN
+                         FAILED ( "TY ACTIVATED" );
+                         -- IN CASE OF FAILURE.
+                         LOOP
+                              SELECT
+                                   ACCEPT E;
+                              OR
+                                   TERMINATE;
+                              END SELECT;
+                         END LOOP;
+                    END TY;
+ 
+                    PACKAGE XCEPTION IS
+                         I : POSITIVE := IDENT_INT (0); -- RAISE
+                                                   -- CONSTRAINT_ERROR.
+                    END XCEPTION;
+                
+                    USE XCEPTION;
+ 
+               BEGIN   -- TY WOULD BE ACTIVATED HERE.
+
+                    IF I /= IDENT_INT (2) OR I = IDENT_INT (1) + 1 THEN
+                         FAILED ( "PACKAGE DIDN'T RAISE EXCEPTION" );
+                    END IF;
+               END RAISE_IT;
+ 
+               PACKAGE BODY START_TZ IS
+                    TASK BODY TZ IS
+                    BEGIN
+                         FAILED ( "TZ ACTIVATED" );
+                         -- IN CASE OF FAILURE.
+                         LOOP
+                              SELECT
+                                   ACCEPT E;
+                              OR
+                                   TERMINATE;
+                              END SELECT;
+                         END LOOP;
+                    END TZ;
+               END START_TZ;    -- TZ WOULD BE ACTIVATED HERE.
+ 
+          BEGIN     -- TX WOULD BE ACTIVATED HERE.
+                    -- CAN'T LEAVE BLOCK UNTIL TA, TB, AND TC ARE TERM.
+
+               FAILED ( "EXCEPTION NOT RAISED" );
+          END;
+ 
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN TASKING_ERROR =>
+               FAILED ( "TASKING_ERROR IN MAIN PROGRAM" );
+          WHEN OTHERS =>
+               FAILED ( "ABNORMAL EXCEPTION IN MAIN" );
+     END;
+ 
+     RESULT;
+ 
+END C93005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005c.ada
new file mode 100644
index 000000000..87322ee91
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005c.ada
@@ -0,0 +1,250 @@
+-- C93005C.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 AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+-- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+-- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+-- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+
+-- CASE 1: TASKS IN DECLARATIVE PART OF A BLOCK AND PACKAGE
+-- SPECIFICATION.  THE TASKS DEPEND ON THE DECLARATIVE PART.
+
+-- RAC 19-MAR-1985
+-- JBG 06/03/85
+-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PRAGMA ELABORATE (REPORT);
+
+with Impdef;
+
+PACKAGE C93005C_PK1 IS
+
+     -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+     TASK TYPE UNACTIVATED IS
+          ENTRY E;
+     END UNACTIVATED;
+
+     TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+
+     -- *******************************************
+     -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+     --
+     -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+     -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+     -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+     -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+     -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+     -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+     -- DECREMENT).
+
+     -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+     -- BY ANYONE BUT THEMSELVES.
+     --
+     TASK TYPE MNT_TASK IS
+     END MNT_TASK;
+
+     FUNCTION F RETURN INTEGER;
+
+     -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+     -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+     -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+     -- COUNT.
+     --
+     TYPE MNT IS
+          RECORD
+               DUMMY : INTEGER :=  F;
+               T     : MNT_TASK;
+          END RECORD;
+
+     PROCEDURE CHECK;
+
+
+     -- *******************************************
+     -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+
+END C93005C_PK1;
+
+
+PACKAGE BODY C93005C_PK1 IS
+
+-- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+-- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+
+     TASK T IS
+          ENTRY E;
+     END;
+
+     -- ***********************************************
+     -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+-- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+-- ARE STILL ACTIVE.
+
+     MNT_COUNT : INTEGER := 0;
+
+-- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+
+     TASK MNT_COUNTER IS
+          ENTRY INCR;
+          ENTRY DECR;
+     END MNT_COUNTER;
+
+-- SYNCHRONIZING TASK
+
+     TASK BODY MNT_COUNTER IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT INCR DO
+                         MNT_COUNT := MNT_COUNT +1;
+                    END INCR;
+
+               OR  ACCEPT DECR DO
+                         MNT_COUNT := MNT_COUNT -1;
+                    END DECR;
+
+               OR  TERMINATE;
+
+               END SELECT;
+          END LOOP;
+     END MNT_COUNTER;
+
+-- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+--
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+          MNT_COUNTER.INCR;
+          RETURN 0;
+     END F;
+
+-- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+-- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+-- ITSELF IS NOT TERMINATED.
+--
+     PROCEDURE CHECK IS
+     BEGIN
+          IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+               FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                       "TERMINATED");
+          END IF;
+-- RESET THE COUNT FOR THE NEXT SUBTEST:
+          MNT_COUNT := 0;
+     END CHECK;
+
+-- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+-- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+-- DECREMENT THE COUNTER.
+--
+     TASK BODY MNT_TASK IS
+     BEGIN
+          DELAY 5.0 * Impdef.One_Second;
+          MNT_COUNTER.DECR;
+     END MNT_TASK;
+
+     -- ***********************************************
+     -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+     TASK BODY T IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT E DO
+                         FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                    END E;
+
+               OR   TERMINATE;
+               END SELECT;
+          END LOOP;
+     END T;
+
+     -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+     --
+     TASK BODY UNACTIVATED IS
+     BEGIN
+          T.E;
+     END UNACTIVATED;
+END C93005C_PK1;
+
+WITH REPORT, C93005C_PK1;
+USE  REPORT, C93005C_PK1;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93005C IS
+
+
+BEGIN
+
+     TEST("C93005C", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                     "TASKS");
+
+     COMMENT("SUBTEST 1: TASKS IN DECL PART OF A BLOCK AND A PACKAGE " &
+             "SPEC");
+     COMMENT("  THE TASKS DEPEND ON THE DECLARATIVE PART");
+B1:  DECLARE
+          X : MNT;
+     BEGIN
+B2:       BEGIN
+B3:            DECLARE
+                    TYPE ACC_MNT IS ACCESS MNT;
+                    T1 : UNACTIVATED;
+                    M2 : ACC_MNT := NEW MNT;
+
+                    PACKAGE RAISES_EXCEPTION IS
+                         T2 : UNACTIVATED;
+                         M3 : ACC_MNT := NEW MNT;
+                         I  : POSITIVE := IDENT_INT(0); -- RAISE
+                                          -- CONSTRAINT_ERROR EXCEPTION
+                    END RAISES_EXCEPTION;
+                    USE RAISES_EXCEPTION;
+               BEGIN  -- WOULD HAVE BEEN ACTIVATED HERE
+                    IF EQUAL (I, I) THEN
+                         FAILED ("EXCEPTION NOT RAISED");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN WRONG SCOPE");
+               END B3;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("SUBTEST 1 COMPLETED");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN B2");
+          END B2;
+     END B1;
+
+     CHECK;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("EXCEPTION NOT ABSORBED");
+          RESULT;
+END C93005C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005d.ada
new file mode 100644
index 000000000..70925a1f6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005d.ada
@@ -0,0 +1,289 @@
+-- C93005D.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 AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+-- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+-- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+-- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+
+-- CASE 2: TASKS IN DECLARATIVE PART OF A BLOCK AND PACKAGE
+-- SPECIFICATION.  THE TASKS DEPEND ON THE DECLARATIVE PART.
+-- OTHER TASKS HAVE BEEN QUEUED ON THE TASKS' ENTRIES.
+
+-- RAC 19-MAR-1985
+-- JBG 06/03/85
+-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+--               ADDED PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+with Impdef;
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PRAGMA ELABORATE (REPORT);
+PACKAGE C93005D_PK1 IS
+
+     -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+     TASK TYPE UNACTIVATED IS
+          ENTRY E;
+     END UNACTIVATED;
+
+     TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+
+     -- *******************************************
+     -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+     --
+     -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+     -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+     -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+     -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+     -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+     -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+     -- DECREMENT).
+
+     -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+     -- BY ANYONE BUT THEMSELVES.
+     --
+     TASK TYPE MNT_TASK IS
+     END MNT_TASK;
+
+     FUNCTION F RETURN INTEGER;
+
+     -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+     -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+     -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+     -- COUNT.
+     --
+     TYPE MNT IS
+          RECORD
+               DUMMY : INTEGER :=  F;
+               T     : MNT_TASK;
+          END RECORD;
+
+     PROCEDURE CHECK;
+
+
+     -- *******************************************
+     -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+
+END C93005D_PK1;
+
+
+PACKAGE BODY C93005D_PK1 IS
+
+-- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+-- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+
+     TASK T IS
+          ENTRY E;
+     END;
+
+     -- ***********************************************
+     -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+-- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+-- ARE STILL ACTIVE.
+
+     MNT_COUNT : INTEGER := 0;
+
+-- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+
+     TASK MNT_COUNTER IS
+          ENTRY INCR;
+          ENTRY DECR;
+     END MNT_COUNTER;
+
+-- SYNCHRONIZING TASK
+
+     TASK BODY MNT_COUNTER IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT INCR DO
+                         MNT_COUNT := MNT_COUNT +1;
+                    END INCR;
+
+               OR  ACCEPT DECR DO
+                         MNT_COUNT := MNT_COUNT -1;
+                    END DECR;
+
+               OR  TERMINATE;
+
+               END SELECT;
+          END LOOP;
+     END MNT_COUNTER;
+
+-- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+--
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+          MNT_COUNTER.INCR;
+          RETURN 0;
+     END F;
+
+-- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+-- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+-- ITSELF IS NOT TERMINATED.
+--
+     PROCEDURE CHECK IS
+     BEGIN
+          IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+               FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                       "TERMINATED");
+          END IF;
+-- RESET THE COUNT FOR THE NEXT SUBTEST:
+          MNT_COUNT := 0;
+     END CHECK;
+
+-- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+-- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+-- DECREMENT THE COUNTER.
+--
+     TASK BODY MNT_TASK IS
+     BEGIN
+          DELAY 5.0 * Impdef.One_Second;
+          MNT_COUNTER.DECR;
+     END MNT_TASK;
+
+     -- ***********************************************
+     -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+     TASK BODY T IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT E DO
+                         FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                    END E;
+
+               OR   TERMINATE;
+               END SELECT;
+          END LOOP;
+     END T;
+
+     -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+     --
+     TASK BODY UNACTIVATED IS
+     BEGIN
+          T.E;
+     END UNACTIVATED;
+END C93005D_PK1;
+
+WITH C93005D_PK1; USE C93005D_PK1;
+PRAGMA ELABORATE (C93005D_PK1);
+GENERIC
+     T1 : IN OUT UNACTIVATED;
+PACKAGE C93005D_ENQUEUE IS
+     PROCEDURE REQUIRE_BODY;
+END;
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY C93005D_ENQUEUE IS
+
+     TASK T3 IS
+     END T3;
+
+     TASK BODY T3 IS
+     BEGIN
+          T1.E;
+          FAILED ("ENQUEUED CALLER DID NOT GET EXCEPTION");
+     EXCEPTION
+          WHEN TASKING_ERROR => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED");
+     END T3;
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+          NULL;
+     END;
+BEGIN                    -- T3 CALLS T1 HERE
+     DELAY 1.0 * Impdef.One_Second;            -- ENSURE THAT T3 EXECUTES
+END C93005D_ENQUEUE;
+
+WITH REPORT, C93005D_PK1, C93005D_ENQUEUE;
+USE  REPORT, C93005D_PK1;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93005D IS
+
+
+BEGIN
+
+     TEST("C93005D", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                     "TASKS");
+
+     COMMENT("SUBTEST 2: TASKS IN DECL PART OF A BLOCK AND A PACKAGE " &
+             "SPEC");
+     COMMENT("  THE TASKS DEPEND ON THE DECLARATIVE PART");
+     COMMENT("  OTHER TASKS HAVE BEEN ENQUEUED ON THE TASKS' ENTRIES");
+B21: DECLARE
+          X : MNT;
+     BEGIN
+B22:      BEGIN
+B23:           DECLARE
+                    TYPE ACC_MNT IS ACCESS MNT;
+                    T1 : UNACTIVATED;
+                    Y  : ACC_MNT := NEW MNT;
+
+                    PACKAGE HAS_UNACTIVATED IS
+                         T2 : UNACTIVATED;
+                         Z  : ACC_MNT := NEW MNT;
+                         PACKAGE ENQUEUE1 IS NEW C93005D_ENQUEUE(T1);
+                         PACKAGE ENQUEUE2 IS NEW C93005D_ENQUEUE(T2);
+                         I : POSITIVE := IDENT_INT(0); -- RAISE
+                                         -- CONSTRAINT_ERROR EXCEPTION.
+                    -- TERMINATES T1 AND T2 AND INDIRECTLY THE 2 T3'S
+                    END HAS_UNACTIVATED;
+                    USE HAS_UNACTIVATED;
+               BEGIN  -- WOULD HAVE BEEN ACTIVATED HERE
+                    IF EQUAL (I, I) THEN
+                         FAILED ("EXCEPTION NOT RAISED");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN WRONG SCOPE");
+               END B23;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT("SUBTEST 2 COMPLETED");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN B22");
+          END B22;
+     END B21;
+
+     CHECK;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("EXCEPTION NOT ABSORBED");
+          RESULT;
+END C93005D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005e.ada
new file mode 100644
index 000000000..c5d6e29e1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005e.ada
@@ -0,0 +1,247 @@
+-- C93005E.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 AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+-- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+-- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+-- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+
+-- CASE 3: TASKS IN PACKAGE SPECIFICATION.
+--         THE TASKS DON'T DEPEND ON THE PACKAGE SPECIFICATION.
+
+-- RAC 19-MAR-1985
+-- JBG 06/03/85
+-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PRAGMA ELABORATE (REPORT);
+PACKAGE C93005E_PK1 IS
+
+     -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+     TASK TYPE UNACTIVATED IS
+          ENTRY E;
+     END UNACTIVATED;
+
+     TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+
+     TYPE BAD_REC IS
+          RECORD
+               T : UNACTIVATED;
+               I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+          END RECORD;
+
+     TYPE ACC_BAD_REC IS ACCESS BAD_REC;
+
+
+     -- *******************************************
+     -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+     --
+     -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+     -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+     -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+     -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+     -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+     -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+     -- DECREMENT).
+
+     -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+     -- BY ANYONE BUT THEMSELVES.
+     --
+     TASK TYPE MNT_TASK IS
+     END MNT_TASK;
+
+     FUNCTION F RETURN INTEGER;
+
+     -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+     -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+     -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+     -- COUNT.
+     --
+     TYPE MNT IS
+          RECORD
+               DUMMY : INTEGER :=  F;
+               T     : MNT_TASK;
+          END RECORD;
+
+     PROCEDURE CHECK;
+
+
+     -- *******************************************
+     -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+
+END C93005E_PK1;
+
+with Impdef;
+PACKAGE BODY C93005E_PK1 IS
+
+-- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+-- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+
+     TASK T IS
+          ENTRY E;
+     END;
+
+     -- ***********************************************
+     -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+-- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+-- ARE STILL ACTIVE.
+
+     MNT_COUNT : INTEGER := 0;
+
+-- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+
+     TASK MNT_COUNTER IS
+          ENTRY INCR;
+          ENTRY DECR;
+     END MNT_COUNTER;
+
+-- SYNCHRONIZING TASK
+
+     TASK BODY MNT_COUNTER IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT INCR DO
+                         MNT_COUNT := MNT_COUNT +1;
+                    END INCR;
+
+               OR  ACCEPT DECR DO
+                         MNT_COUNT := MNT_COUNT -1;
+                    END DECR;
+
+               OR  TERMINATE;
+
+               END SELECT;
+          END LOOP;
+     END MNT_COUNTER;
+
+-- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+--
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+          MNT_COUNTER.INCR;
+          RETURN 0;
+     END F;
+
+-- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+-- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+-- ITSELF IS NOT TERMINATED.
+--
+     PROCEDURE CHECK IS
+     BEGIN
+          IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+               FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                       "TERMINATED");
+          END IF;
+-- RESET THE COUNT FOR THE NEXT SUBTEST:
+          MNT_COUNT := 0;
+     END CHECK;
+
+-- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+-- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+-- DECREMENT THE COUNTER.
+--
+     TASK BODY MNT_TASK IS
+     BEGIN
+          DELAY 5.0 * Impdef.One_Second;
+          MNT_COUNTER.DECR;
+     END MNT_TASK;
+
+     -- ***********************************************
+     -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+     TASK BODY T IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT E DO
+                         FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                    END E;
+
+               OR   TERMINATE;
+               END SELECT;
+          END LOOP;
+     END T;
+
+     -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+     --
+     TASK BODY UNACTIVATED IS
+     BEGIN
+          T.E;
+     END UNACTIVATED;
+END C93005E_PK1;
+
+WITH REPORT, C93005E_PK1;
+USE  REPORT, C93005E_PK1;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93005E IS
+
+
+BEGIN
+
+     TEST("C93005E", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                     "TASKS");
+
+     COMMENT("SUBTEST 3: TASK IN DECL PART OF PACKAGE SPEC");
+     COMMENT("  THE TASKS DON'T DEPEND ON THE DECLARATIVE PART");
+B31: DECLARE
+          X : MNT;
+     BEGIN
+B32:      BEGIN
+B33:           DECLARE
+                    PACKAGE RAISES_EXCEPTION IS
+                         TYPE ACC_MNT IS ACCESS MNT;
+                         Y   : ACC_MNT := NEW MNT;
+                         PTR : ACC_BAD_REC := NEW BAD_REC;
+                    END RAISES_EXCEPTION;
+               BEGIN  -- WOULD HAVE BEEN ACTIVATED HERE
+                    FAILED("EXCEPTION NOT RAISED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN WRONG SCOPE");
+               END B33;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT("SUBTEST 3 COMPLETED");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN B32");
+          END B32;
+     END B31;
+
+     CHECK;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("EXCEPTION NOT ABSORBED");
+          RESULT;
+END C93005E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005f.ada
new file mode 100644
index 000000000..c6d6aeb17
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005f.ada
@@ -0,0 +1,255 @@
+-- C93005F.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 AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+-- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+-- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+-- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+
+-- CASE 4: TASKS IN STATEMENT PART OF A BLOCK.  THE TASKS DEPEND ON THE
+--         DECLARATIVE PART.
+
+-- RAC 19-MAR-1985
+-- JBG 06/03/85
+-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+-- RLB 06/29/01  CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PRAGMA ELABORATE (REPORT);
+PACKAGE C93005F_PK1 IS
+
+     -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+     TASK TYPE UNACTIVATED IS
+          ENTRY E;
+     END UNACTIVATED;
+
+     TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+
+     TYPE BAD_REC IS
+          RECORD
+               T : UNACTIVATED;
+               I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+          END RECORD;
+
+     TYPE ACC_BAD_REC IS ACCESS BAD_REC;
+
+
+     -- *******************************************
+     -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+     --
+     -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+     -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+     -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+     -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+     -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+     -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+     -- DECREMENT).
+
+     -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+     -- BY ANYONE BUT THEMSELVES.
+     --
+     TASK TYPE MNT_TASK IS
+     END MNT_TASK;
+
+     FUNCTION F RETURN INTEGER;
+
+     -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+     -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+     -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+     -- COUNT.
+     --
+     TYPE MNT IS
+          RECORD
+               DUMMY : INTEGER :=  F;
+               T     : MNT_TASK;
+          END RECORD;
+
+     PROCEDURE CHECK;
+
+
+     -- *******************************************
+     -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+
+END C93005F_PK1;
+
+with Impdef;
+PACKAGE BODY C93005F_PK1 IS
+
+-- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+-- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+
+     TASK T IS
+          ENTRY E;
+     END;
+
+     -- ***********************************************
+     -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+-- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+-- ARE STILL ACTIVE.
+
+     MNT_COUNT : INTEGER := 0;
+
+-- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+
+     TASK MNT_COUNTER IS
+          ENTRY INCR;
+          ENTRY DECR;
+     END MNT_COUNTER;
+
+-- SYNCHRONIZING TASK
+
+     TASK BODY MNT_COUNTER IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT INCR DO
+                         MNT_COUNT := MNT_COUNT +1;
+                    END INCR;
+
+               OR  ACCEPT DECR DO
+                         MNT_COUNT := MNT_COUNT -1;
+                    END DECR;
+
+               OR  TERMINATE;
+
+               END SELECT;
+          END LOOP;
+     END MNT_COUNTER;
+
+-- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+--
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+          MNT_COUNTER.INCR;
+          RETURN 0;
+     END F;
+
+-- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+-- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+-- ITSELF IS NOT TERMINATED.
+--
+     PROCEDURE CHECK IS
+     BEGIN
+          IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+               FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                       "TERMINATED");
+          END IF;
+-- RESET THE COUNT FOR THE NEXT SUBTEST:
+          MNT_COUNT := 0;
+     END CHECK;
+
+-- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+-- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+-- DECREMENT THE COUNTER.
+--
+     TASK BODY MNT_TASK IS
+     BEGIN
+          DELAY 5.0 * Impdef.One_Second;
+          MNT_COUNTER.DECR;
+     END MNT_TASK;
+
+     -- ***********************************************
+     -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+     TASK BODY T IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT E DO
+                         FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                    END E;
+
+               OR   TERMINATE;
+               END SELECT;
+          END LOOP;
+     END T;
+
+     -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+     --
+     TASK BODY UNACTIVATED IS
+     BEGIN
+          T.E;
+     END UNACTIVATED;
+END C93005F_PK1;
+
+WITH REPORT, C93005F_PK1;
+USE  REPORT, C93005F_PK1;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93005F IS
+
+
+BEGIN
+
+     TEST("C93005F", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                     "TASKS");
+
+     COMMENT("SUBTEST 4: TASK IN STATEMENT PART OF BLOCK");
+     COMMENT("  THE TASKS DEPEND ON THE DECLARATIVE PART");
+B41: DECLARE
+          X : MNT;
+     BEGIN
+B42:      DECLARE
+               TYPE LOCAL_ACC IS ACCESS BAD_REC;
+               Y : MNT;
+               PTR : LOCAL_ACC;
+
+               TYPE ACC_MNT IS ACCESS MNT;
+               Z : ACC_MNT;
+
+          BEGIN
+               Z  := NEW MNT;
+               PTR := NEW BAD_REC;
+               IF PTR.I /= REPORT.IDENT_INT(0) THEN
+                  FAILED ("EXCEPTION NOT RAISED, VALUE CHANGED");
+               ELSE
+                  FAILED ("EXCEPTION NOT RAISED, CONSTRAINT IGNORED");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION IN B42");
+          END B42;
+
+          COMMENT("SUBTEST 4: COMPLETED");
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION NOT ABSORBED");
+     END B41;
+
+     CHECK;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("EXCEPTION NOT ABSORBED");
+          RESULT;
+END C93005F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005g.ada
new file mode 100644
index 000000000..c46a7309d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005g.ada
@@ -0,0 +1,245 @@
+-- C93005G.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 AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+-- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+-- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+-- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+
+-- CASE 5: TASKS IN STATEMENT PART OF A BLOCK.  THE TASKS DON'T DEPEND
+--         ON THE DECLARATIVE PART.
+
+-- RAC 19-MAR-1985
+-- JBG 06/03/85
+-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PRAGMA ELABORATE (REPORT);
+PACKAGE C93005G_PK1 IS
+
+     -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+     TASK TYPE UNACTIVATED IS
+          ENTRY E;
+     END UNACTIVATED;
+
+     TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+
+     TYPE BAD_REC IS
+          RECORD
+               T : UNACTIVATED;
+               I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+          END RECORD;
+
+     TYPE ACC_BAD_REC IS ACCESS BAD_REC;
+
+
+     -- *******************************************
+     -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+     --
+     -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+     -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+     -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+     -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+     -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+     -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+     -- DECREMENT).
+
+     -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+     -- BY ANYONE BUT THEMSELVES.
+     --
+     TASK TYPE MNT_TASK IS
+     END MNT_TASK;
+
+     FUNCTION F RETURN INTEGER;
+
+     -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+     -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+     -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+     -- COUNT.
+     --
+     TYPE MNT IS
+          RECORD
+               DUMMY : INTEGER :=  F;
+               T     : MNT_TASK;
+          END RECORD;
+
+     PROCEDURE CHECK;
+
+
+     -- *******************************************
+     -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+
+END C93005G_PK1;
+
+with Impdef;
+PACKAGE BODY C93005G_PK1 IS
+
+-- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+-- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+
+     TASK T IS
+          ENTRY E;
+     END;
+
+     -- ***********************************************
+     -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+-- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+-- ARE STILL ACTIVE.
+
+     MNT_COUNT : INTEGER := 0;
+
+-- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+
+     TASK MNT_COUNTER IS
+          ENTRY INCR;
+          ENTRY DECR;
+     END MNT_COUNTER;
+
+-- SYNCHRONIZING TASK
+
+     TASK BODY MNT_COUNTER IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT INCR DO
+                         MNT_COUNT := MNT_COUNT +1;
+                    END INCR;
+
+               OR  ACCEPT DECR DO
+                         MNT_COUNT := MNT_COUNT -1;
+                    END DECR;
+
+               OR  TERMINATE;
+
+               END SELECT;
+          END LOOP;
+     END MNT_COUNTER;
+
+-- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+--
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+          MNT_COUNTER.INCR;
+          RETURN 0;
+     END F;
+
+-- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+-- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+-- ITSELF IS NOT TERMINATED.
+--
+     PROCEDURE CHECK IS
+     BEGIN
+          IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+               FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                       "TERMINATED");
+          END IF;
+-- RESET THE COUNT FOR THE NEXT SUBTEST:
+          MNT_COUNT := 0;
+     END CHECK;
+
+-- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+-- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+-- DECREMENT THE COUNTER.
+--
+     TASK BODY MNT_TASK IS
+     BEGIN
+          DELAY 5.0 * Impdef.One_Second;
+          MNT_COUNTER.DECR;
+     END MNT_TASK;
+
+     -- ***********************************************
+     -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+     TASK BODY T IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT E DO
+                         FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                    END E;
+
+               OR   TERMINATE;
+               END SELECT;
+          END LOOP;
+     END T;
+
+     -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+     --
+     TASK BODY UNACTIVATED IS
+     BEGIN
+          T.E;
+     END UNACTIVATED;
+END C93005G_PK1;
+
+WITH REPORT, C93005G_PK1;
+USE  REPORT, C93005G_PK1;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93005G IS
+
+
+BEGIN
+
+     TEST("C93005G", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                     "TASKS");
+
+     COMMENT("SUBTEST 5: TASK IN STATEMENT PART OF BLOCK");
+     COMMENT("  THE TASKS DON'T DEPEND ON THE DECLARATIVE PART");
+B51: DECLARE
+          X : MNT;
+     BEGIN
+B52:      DECLARE
+               Y   : MNT;
+               PTR : ACC_BAD_REC;
+          BEGIN
+               PTR := NEW BAD_REC;
+               FAILED ("EXCEPTION NOT RAISED");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION IN B52");
+          END B52;
+
+          COMMENT ("SUBTEST 5: COMPLETED");
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION NOT ABSORBED");
+     END B51;
+
+     CHECK;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("EXCEPTION NOT ABSORBED");
+          RESULT;
+END C93005G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005h.ada
new file mode 100644
index 000000000..6641347b1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93005h.ada
@@ -0,0 +1,250 @@
+-- C93005H.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 AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
+-- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
+-- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
+-- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
+
+-- CASE 6: TASK IN STATEMENT PART OF PACKAGE AND THE TASKS DON'T DEPEND
+--         ON THE PACKAGE SPECIFICATION.
+
+-- RAC 19-MAR-1985
+-- JBG 06/03/85
+-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PRAGMA ELABORATE (REPORT);
+PACKAGE C93005H_PK1 IS
+
+     -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
+     TASK TYPE UNACTIVATED IS
+          ENTRY E;
+     END UNACTIVATED;
+
+     TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
+
+     TYPE BAD_REC IS
+          RECORD
+               T : UNACTIVATED;
+               I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
+          END RECORD;
+
+     TYPE ACC_BAD_REC IS ACCESS BAD_REC;
+
+
+     -- *******************************************
+     -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+     --
+     -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
+     -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
+     -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
+     -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
+     -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
+     -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
+     -- DECREMENT).
+
+     -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
+     -- BY ANYONE BUT THEMSELVES.
+     --
+     TASK TYPE MNT_TASK IS
+     END MNT_TASK;
+
+     FUNCTION F RETURN INTEGER;
+
+     -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
+     -- AND FORCE CALLING F BEFORE CREATING THE TASK.
+     -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
+     -- COUNT.
+     --
+     TYPE MNT IS
+          RECORD
+               DUMMY : INTEGER :=  F;
+               T     : MNT_TASK;
+          END RECORD;
+
+     PROCEDURE CHECK;
+
+
+     -- *******************************************
+     -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
+     -- *******************************************
+
+END C93005H_PK1;
+
+with Impdef;
+PACKAGE BODY C93005H_PK1 IS
+
+-- THIS TASK IS CALLED IF AN UNACTIVATED TASK
+-- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
+
+     TASK T IS
+          ENTRY E;
+     END;
+
+     -- ***********************************************
+     -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+-- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
+-- ARE STILL ACTIVE.
+
+     MNT_COUNT : INTEGER := 0;
+
+-- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
+
+     TASK MNT_COUNTER IS
+          ENTRY INCR;
+          ENTRY DECR;
+     END MNT_COUNTER;
+
+-- SYNCHRONIZING TASK
+
+     TASK BODY MNT_COUNTER IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT INCR DO
+                         MNT_COUNT := MNT_COUNT +1;
+                    END INCR;
+
+               OR  ACCEPT DECR DO
+                         MNT_COUNT := MNT_COUNT -1;
+                    END DECR;
+
+               OR  TERMINATE;
+
+               END SELECT;
+          END LOOP;
+     END MNT_COUNTER;
+
+-- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
+--
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+          MNT_COUNTER.INCR;
+          RETURN 0;
+     END F;
+
+-- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
+-- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
+-- ITSELF IS NOT TERMINATED.
+--
+     PROCEDURE CHECK IS
+     BEGIN
+          IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
+               FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
+                       "TERMINATED");
+          END IF;
+-- RESET THE COUNT FOR THE NEXT SUBTEST:
+          MNT_COUNT := 0;
+     END CHECK;
+
+-- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
+-- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
+-- DECREMENT THE COUNTER.
+--
+     TASK BODY MNT_TASK IS
+     BEGIN
+          DELAY 5.0 * Impdef.One_Second;
+          MNT_COUNTER.DECR;
+     END MNT_TASK;
+
+     -- ***********************************************
+     -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
+     -- ***********************************************
+
+     TASK BODY T IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT E DO
+                         FAILED ("SOME TYPE U TASK WAS ACTIVATED");
+                    END E;
+
+               OR   TERMINATE;
+               END SELECT;
+          END LOOP;
+     END T;
+
+     -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
+     --
+     TASK BODY UNACTIVATED IS
+     BEGIN
+          T.E;
+     END UNACTIVATED;
+END C93005H_PK1;
+
+WITH REPORT, C93005H_PK1;
+USE  REPORT, C93005H_PK1;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C93005H IS
+
+
+BEGIN
+
+     TEST("C93005H", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
+                     "TASKS");
+
+     COMMENT("SUBTEST 6: TASK IN STATEMENT PART OF PACKAGE");
+     COMMENT("  THE TASKS DON'T DEPEND ON THE DECLARATIVE PART");
+B61: DECLARE
+          X : MNT;
+
+          PACKAGE P IS
+               Y : MNT;
+          END P;
+
+          PACKAGE BODY P IS
+               PTR : ACC_BAD_REC;
+               Z   : MNT;
+          BEGIN
+               PTR := NEW BAD_REC;
+               FAILED("EXCEPTION NOT RAISED");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN P");
+          END P;
+
+     BEGIN
+          COMMENT ("SUBTEST 6: COMPLETED");
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION NOT ABSORBED");
+     END B61;
+
+     CHECK;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED ("EXCEPTION NOT ABSORBED");
+          RESULT;
+END C93005H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93006a.ada
new file mode 100644
index 000000000..81954f247
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93006a.ada
@@ -0,0 +1,69 @@
+-- C93006A.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 TASK OBJECT DECLARED IN A LIBRARY PACKAGE SPEC IS
+-- ACTIVATED EVEN IF THE PACKAGE HAS NO BODY.
+
+-- JEAN-PIERRE ROSEN 16-MAR-1984
+-- JBG 6/1/84
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+PACKAGE C93006A0 IS
+     TASK TYPE TT IS
+          ENTRY E;
+     END;
+END C93006A0;
+
+PACKAGE BODY C93006A0 IS
+     TASK BODY TT IS
+     BEGIN
+          ACCEPT E;
+     END;
+END C93006A0;
+
+WITH C93006A0; USE C93006A0;
+PRAGMA ELABORATE(C93006A0);
+PACKAGE C93006A1 IS
+     T : TT;
+END C93006A1;
+
+with Impdef;
+WITH REPORT, C93006A1, SYSTEM;
+USE  REPORT, C93006A1, SYSTEM;
+PROCEDURE C93006A IS
+BEGIN
+
+     TEST("C93006A", "CHECK ACTIVATION OF TASK DECLARED IN PACKAGE " &
+                     "SPECIFICATION");
+
+     SELECT
+          T.E;
+     OR 
+          DELAY 60.0 * Impdef.One_Second;
+          FAILED("RENDEZVOUS NOT ACCEPTED WITHIN 60 SECONDS");
+     END SELECT;
+
+     RESULT;
+END C93006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93007a.ada
new file mode 100644
index 000000000..9653d662e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93007a.ada
@@ -0,0 +1,113 @@
+-- C93007A.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 AN ATTEMPT IS MADE TO ACTIVATE A TASK BEFORE ITS
+--     BODY HAS BEEN ELABORATED, THE TASK IS COMPLETED AND "PROGRAM_
+--     ERROR" (RATHER THAN "TASKING_ERROR") IS RAISED.
+
+-- HISTORY:
+--     DHH 03/16/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C93007A IS
+
+BEGIN
+
+     TEST("C93007A", "CHECK THAT IF AN ATTEMPT IS MADE TO ACTIVATE " &
+                     "A TASK BEFORE ITS BODY HAS BEEN ELABORATED, " &
+                     "THE TASK IS COMPLETED AND ""PROGRAM_ERROR"" " &
+                     "(RATHER THAN ""TASKING_ERROR"") IS RAISED");
+
+     DECLARE
+          TASK TYPE PROG_ERR IS
+               ENTRY START;
+          END PROG_ERR;
+
+          TYPE REC IS
+               RECORD
+                    B : PROG_ERR;
+               END RECORD;
+
+          TYPE ACC IS ACCESS PROG_ERR;
+
+          PACKAGE P IS
+               OBJ : REC;
+          END P;
+
+          PACKAGE BODY P IS
+          BEGIN
+               FAILED("EXCEPTION NOT RAISED - 1");
+               OBJ.B.START;
+          EXCEPTION
+               WHEN PROGRAM_ERROR =>
+                    NULL;
+               WHEN TASKING_ERROR =>
+                    FAILED("TASKING ERROR RAISED INCORRECTLY");
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED");
+          END P;
+
+          PACKAGE Q IS
+               OBJ : ACC;
+          END Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               OBJ := NEW PROG_ERR;
+               FAILED("EXCEPTION NOT RAISED - 2");
+               OBJ.START;
+          EXCEPTION
+               WHEN PROGRAM_ERROR =>
+                    NULL;
+               WHEN TASKING_ERROR =>
+                    FAILED("ACCESS TASKING ERROR RAISED INCORRECTLY");
+               WHEN OTHERS =>
+                    FAILED("ACCESS UNEXPECTED EXCEPTION RAISED");
+          END;
+
+          TASK BODY PROG_ERR IS
+          BEGIN
+               ACCEPT START DO
+                    IF TRUE THEN
+                         COMMENT("IRRELEVANT");
+                    END IF;
+               END START;
+          END PROG_ERR;
+     BEGIN
+          NULL;
+     END; -- DECLARE
+
+     RESULT;
+
+EXCEPTION
+     WHEN PROGRAM_ERROR =>
+          FAILED("PROGRAM_ERROR RAISED AT INCORRECT POSITION");
+          RESULT;
+
+     WHEN OTHERS =>
+          FAILED("UNEXPECTED EXCEPTION RAISED");
+          RESULT;
+
+END C93007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93008a.ada
new file mode 100644
index 000000000..633d17dbc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93008a.ada
@@ -0,0 +1,108 @@
+-- C93008A.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 A TASK CREATED BY AN OBJECT DECLARATION, EXECUTION 
+-- DOES NOT PROCEED IN PARALLEL WITH ACTIVATION.
+
+-- R.WILLIAMS 8/20/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C93008A IS
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     TASK T IS
+          ENTRY FINIT_POS (DIGT : IN ARG);
+     END T;
+
+     TASK BODY T IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT FINIT_POS (DIGT : IN ARG) DO
+                         SPYNUMB := 10*SPYNUMB+DIGT;
+                    END FINIT_POS;
+               OR
+                    TERMINATE;
+               END SELECT;          
+          END LOOP;
+     END T;
+
+BEGIN
+
+     TEST ("C93008A", "CHECK THAT EXECUTION DOES NOT PROCEED IN  " &
+                      "PARALLEL WITH ACTIVATION OF A TASK CREATED " &
+                      "BY AN OBJECT DECLARATION");
+
+BLOCK:
+     DECLARE
+
+          TASK TYPE TT1;
+
+          TASK TT2;
+
+          T1 : TT1;
+
+          TASK BODY TT1 IS
+               PACKAGE DUMMY IS
+               END DUMMY;
+
+               PACKAGE BODY DUMMY IS
+               BEGIN
+                    DELAY 2.0 * Impdef.One_Second;
+                    T.FINIT_POS(1);
+               END DUMMY;
+          BEGIN
+               NULL;
+          END TT1;
+
+          TASK BODY TT2 IS
+               PACKAGE DUMMY IS
+               END DUMMY;
+
+               PACKAGE BODY DUMMY IS
+               BEGIN
+                    DELAY 2.0 * Impdef.One_Second;
+                    T.FINIT_POS(2);
+               END DUMMY;
+          BEGIN
+               NULL;
+          END TT2;
+          
+
+     BEGIN               -- TASKS ACTIVATED NOW.
+
+          IF SPYNUMB = 12 OR SPYNUMB = 21 THEN
+               NULL;
+          ELSE
+               FAILED ("TASKS NOT ACTIVATED PROPERLY - SPYNUMB HAS " &
+                       "ACTUAL VALUE OF: " & INTEGER'IMAGE(SPYNUMB));
+          END IF;
+     END BLOCK;
+
+     RESULT;
+
+END C93008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93008b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93008b.ada
new file mode 100644
index 000000000..2853acd4e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c93008b.ada
@@ -0,0 +1,103 @@
+-- C93008B.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 AFTER CREATION OF A TASK OBJECT BY AN ALLOCATOR, ANY
+-- OPERATION INVOLVING THE RESULT DELIVERED BY THE ALLOCATOR IS
+-- EXECUTED ONLY AFTER THE ACTIVATION OF THE TASK HAS COMPLETED.
+
+-- WEI  3/ 4/82
+-- TBN 12/20/85     RENAMED FROM C930AJA-B.ADA. ADDED DELAY STATEMENT
+--                  DURING TASK ACTIVATION.
+-- RJW 4/11/86      ADDED PACKAGE DUMMY.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C93008B IS
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+          RETURN DIGT;
+     END FINIT_POS;
+
+BEGIN
+
+     TEST ("C93008B", "USE OF RESULT AFTER CREATION OF " &
+                      "A TASK BY ALLOCATOR");
+
+BLOCK:
+     DECLARE
+
+          TASK TYPE TT1;
+
+          TYPE ATT1 IS ACCESS TT1;
+          TYPE ARRAY_ATT1 IS ARRAY (NATURAL RANGE 2 .. 3) OF ATT1;
+          MY_ARRAY : ARRAY_ATT1;
+          POINTER_TT1 : ATT1;
+
+          TASK BODY TT1 IS
+               PACKAGE DUMMY IS
+               END DUMMY;
+
+               PACKAGE BODY DUMMY IS
+               BEGIN
+                    DELAY 2.0 * Impdef.One_Second;
+                    DECLARE
+                         IDUMMY1 : NATURAL := FINIT_POS (1);
+                    BEGIN
+                         NULL;
+                    END;
+               END DUMMY;
+          BEGIN
+               NULL;
+          END TT1;
+
+     BEGIN
+
+          MY_ARRAY := (2 => NEW TT1, 3 => NULL);  -- TASK ACTIVATED NOW.
+          POINTER_TT1 := MY_ARRAY (FINIT_POS (2));
+
+          MY_ARRAY (FINIT_POS (3)) := POINTER_TT1;
+
+          IF SPYNUMB /= 123 THEN
+               IF SPYNUMB = 132 OR SPYNUMB = 13 OR
+                  SPYNUMB = 12  OR SPYNUMB = 1  OR
+                  SPYNUMB = 0
+               THEN
+                    FAILED ("TASK ACTIVATION RIGHT IN TIME, " &
+                            "BUT OTHER ERROR");
+               ELSE
+                    FAILED ("RESULT OF ALLOCATOR ACCESSED BEFORE " &
+                            "TASK ACTIVATION HAS COMPLETED");
+               END IF;
+               COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+          END IF;
+     END BLOCK;
+
+     RESULT;
+
+END C93008B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940001.a
new file mode 100644
index 000000000..2bc1a9ffd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940001.a
@@ -0,0 +1,212 @@
+-- C940001.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 protected object provides coordinated access to
+--      shared data.  Check that it can be used to sequence a number of tasks.
+--      Use the protected object to control a single token for which three 
+--      tasks compete.  Check that only one task is running at a time and that
+--      all tasks get a chance to run sometime.
+--
+-- TEST DESCRIPTION:
+--      Declare a protected type with two entries.  A task may call the Take
+--      entry to get a token which allows it to continue processing.  If it 
+--      has the token, it may call the Give entry to return it.  The tasks 
+--      implement a discipline whereby only the task with the token may be 
+--      active.  The test does not require any specific order for the tasks 
+--      to run.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      07 Jul 96   SAIC    Fixed spelling nits.
+--
+--!
+
+package C940001_0 is
+
+  type Token_Type is private;
+  True_Token : constant Token_Type;   -- Create a deferred constant in order 
+                                      -- to provide a component init for the
+                                      -- protected object
+
+  protected type Token_Mgr_Prot_Unit is
+    entry Take (T : out Token_Type);
+    entry Give (T : in out  Token_Type);
+  private
+    Token : Token_Type := True_Token;
+  end Token_Mgr_Prot_Unit;
+
+  function Init_Token return Token_Type;   -- call to initialize an 
+                                           -- object of Token_Type
+  function Token_Value (T : Token_Type) return Boolean;
+                                           -- call to inspect the value of an
+                                           -- object of Token_Type
+private
+  type Token_Type is new boolean;
+  True_Token : constant Token_Type := true;
+end C940001_0;
+
+--=================================================================--
+
+package body C940001_0 is
+  protected body  Token_Mgr_Prot_Unit is
+    entry Take (T : out Token_Type) when Token = true is
+      begin                   -- Calling task will Take the token, so
+        T := Token;           -- check first that token_mgr owns the
+        Token := false;       -- token to give, then give it to caller
+      end Take;
+
+    entry Give (T : in out Token_Type)  when Token = false is
+      begin                   -- Calling task will Give the token back,
+        if T = true then      -- so first check that token_mgr does not
+          Token := T;         -- own the token, then check that the task has
+          T := false;         -- the token to give, then take it from the
+        end if;               -- task
+                              -- if caller does not own the token, then
+      end Give;               -- it falls out of the entry body with no
+  end Token_Mgr_Prot_Unit;    -- action
+
+  function Init_Token return Token_Type is
+    begin
+      return false;
+    end Init_Token;
+
+  function Token_Value (T : Token_Type) return Boolean is
+    begin
+      return Boolean (T);
+    end Token_Value;
+
+end C940001_0;
+
+--===============================================================--
+
+with Report;
+with ImpDef;
+with C940001_0;
+
+procedure C940001 is
+
+  type TC_Int_Type is range 0..2;
+              -- range is very narrow so that erroneous execution may
+              -- raise Constraint_Error
+
+  type TC_Artifact_Type is record
+     TC_Int : TC_Int_Type := 1;
+     Number_of_Accesses : integer := 0;
+  end record;
+
+  TC_Artifact : TC_Artifact_Type;
+
+  Sequence_Mgr : C940001_0.Token_Mgr_Prot_Unit;
+    
+  procedure Bump (Item : in out TC_Int_Type) is
+    begin
+      Item := Item + 1;
+    exception
+      when Constraint_Error =>
+        Report.Failed ("Incremented without corresponding decrement");
+      when others =>
+        Report.Failed ("Bump raised Unexpected Exception");
+   end Bump;
+
+  procedure Decrement (Item : in out TC_Int_Type) is
+    begin
+      Item := Item - 1;
+    exception
+      when Constraint_Error =>
+        Report.Failed ("Decremented without corresponding increment");
+      when others =>
+        Report.Failed ("Decrement raised Unexpected Exception");
+    end Decrement;
+    
+    --==============--
+
+  task type Network_Node_Type;
+
+  task body Network_Node_Type is
+
+    Slot_for_Token : C940001_0.Token_Type := C940001_0.Init_Token;
+
+    begin
+ 
+      -- Ask for token - if request is not granted, task will be queued
+      Sequence_Mgr.Take (Slot_for_Token);        
+
+      -- Task now has token and may perform its work
+
+      --==========================--
+      -- in this case, the work is to ensure that the test results
+      -- are the expected ones!
+      --==========================--
+      Bump (TC_Artifact.TC_Int);   -- increment when request is granted
+      TC_Artifact.Number_Of_Accesses := 
+        TC_Artifact.Number_Of_Accesses + 1;
+      if not C940001_0.Token_Value ( Slot_for_Token) then
+        Report.Failed ("Incorrect results from entry Take");
+      end if;
+ 
+      -- give a chance for other tasks to (incorrectly) run
+      delay ImpDef.Minimum_Task_Switch;
+
+      Decrement (TC_Artifact.TC_Int); -- prepare to return token
+
+      -- Task has completed its work and will return token
+
+      Sequence_Mgr.Give (Slot_for_Token);   -- return token to sequence manager
+
+      if c940001_0.Token_Value (Slot_for_Token) then
+        Report.Failed ("Incorrect results from entry Give");
+      end if;
+
+    exception
+      when others => Report.Failed ("Unexpected exception raised in task");
+
+    end Network_Node_Type; 
+
+    --==============--
+
+begin
+
+  Report.Test ("C940001", "Check that a protected object can control " &
+                          "tasks by coordinating access to shared data");
+
+  declare
+     Node_1, Node_2, Node_3 : Network_Node_Type;
+                           -- declare three tasks which will compete for
+                           -- a single token, managed by Sequence Manager
+
+  begin                    -- tasks start
+    null;
+  end; -- wait for all tasks to terminate before reporting result
+
+  if TC_Artifact.Number_of_Accesses /= 3 then
+    Report.Failed ("Not all tasks got through");
+  end if;
+
+  Report.Result;
+
+end C940001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940002.a
new file mode 100644
index 000000000..420f54440
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940002.a
@@ -0,0 +1,309 @@
+-- C940002.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 protected object provides coordinated access to shared 
+--      data.  Check that it can implement a semaphore-like construct using a
+--      parameterless procedure which allows a specific maximum number of tasks
+--      to run and excludes all others
+--
+-- TEST DESCRIPTION:
+--      Implement a counting semaphore type that can be initialized to a 
+--      specific number of available resources.  Declare an entry for 
+--      requesting a resource and a procedure for releasing it.  Declare an 
+--      object of this type, initialized to two resources.  Declare and start 
+--      three tasks each of which asks for a resource.  Verify that only two 
+--      resources are granted and that the last task in is queued.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+package C940002_0 is
+     -- Semaphores
+
+  protected type Semaphore_Type (Resources_Available : Integer :=1) is
+    entry Request;
+    procedure Release;
+    function Available return Integer;
+  private
+    Currently_Available : Integer := Resources_Available;
+  end Semaphore_Type;
+
+  Max_Resources : constant Integer := 2;
+  Resource      : Semaphore_Type (Max_Resources);
+
+end C940002_0;
+ -- Semaphores;
+
+
+          --========================================================--
+
+
+package body C940002_0 is
+          -- Semaphores
+
+  protected body Semaphore_Type is
+
+    entry Request when Currently_Available >0 is  -- when granted, secures
+    begin                                         -- a resource
+      Currently_Available := Currently_Available - 1;
+    end Request;
+
+    procedure Release is                          -- when called, releases
+    begin                                         -- a resource
+      Currently_Available := Currently_Available + 1;
+    end Release;
+
+    function Available return Integer is          -- returns number of
+    begin                                         -- available resources
+      return Currently_Available;
+    end Available;
+
+  end Semaphore_Type;
+
+end C940002_0;
+ -- Semaphores;
+
+
+          --========================================================--
+
+
+package C940002_1 is
+     -- Task_Pkg
+
+  task type Requesting_Task is
+     entry Done;                        -- call on Done instructs the task
+  end Requesting_Task;                  -- to release resource
+
+  type Task_Ptr is access Requesting_Task;
+
+  protected Counter is
+    procedure Increment;
+    procedure Decrement;
+    function Number return integer;
+  private
+    Count : Integer := 0;
+  end Counter;
+
+  protected Hold_Lock is
+    procedure Lock;
+    procedure Unlock;
+    function  Locked return Boolean;
+  private
+    Lock_State  : Boolean := true;        -- starts out locked
+  end Hold_Lock;
+
+
+end C940002_1;
+ -- Task_Pkg
+
+
+          --========================================================--
+
+
+with Report;
+with C940002_0;
+  -- Semaphores;    
+
+package body C940002_1 is
+          -- Task_Pkg is
+  
+  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;
+
+
+  protected body Hold_Lock is
+
+    procedure Lock is 
+    begin
+      Lock_State := true;
+    end Lock;
+
+    procedure Unlock is 
+    begin
+      Lock_State := false;
+    end Unlock;
+
+    function  Locked return Boolean is 
+    begin
+      return Lock_State;
+    end Locked;
+
+  end Hold_Lock;
+
+
+  task body Requesting_Task is
+  begin
+    C940002_0.Resource.Request;        -- request a resource
+                                       -- if resource is not available, 
+                                       -- task will be queued to wait
+    Counter.Increment;                 -- add to count of resources obtained
+    Hold_Lock.Unlock;                  -- and unlock Lock - system is stable;
+                                       -- status may now be queried
+
+    accept Done do                     -- hold resource until Done is called
+      C940002_0.Resource.Release;      -- release the resource and
+      Counter.Decrement;               -- note release
+    end Done;                           
+
+  exception
+    when others => Report.Failed ("Unexpected Exception in Requesting_Task");
+  end Requesting_Task;
+
+end C940002_1;
+ -- Task_Pkg;
+
+
+          --========================================================--
+
+
+with Report;
+with ImpDef;
+with C940002_0,
+  -- Semaphores, 
+     C940002_1;
+  -- Task_Pkg;
+
+procedure C940002 is
+
+  package Semaphores renames C940002_0;
+  package Task_Pkg renames C940002_1;
+
+  Ptr1,
+  Ptr2, 
+  Ptr3 : Task_Pkg.Task_Ptr;
+  Num  : Integer;
+
+  procedure Spinlock is
+    begin
+      -- loop until unlocked
+      while Task_Pkg.Hold_Lock.Locked loop
+        delay ImpDef.Minimum_Task_Switch;   
+      end loop;
+      Task_Pkg.Hold_Lock.Lock;
+    end Spinlock;
+
+begin
+
+  Report.Test ("C940002", "Check that a protected record can be used to " &
+                          "control access to resources");
+
+  if (Task_Pkg.Counter.Number /=0)
+  or (Semaphores.Resource.Available /= 2) then
+    Report.Failed ("Wrong initial conditions");
+  end if;
+                                  
+  Ptr1 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests 
+                                   -- resource; request for resource should 
+                                   -- be granted
+  Spinlock;                        -- ensure that task obtains resource
+
+                                   -- Task 1 waiting for call to Done
+                                   -- One resource assigned to task 1
+                                   -- One resource still available
+  if (Task_Pkg.Counter.Number /= 1) 
+  or (Semaphores.Resource.Available /= 1) then
+    Report.Failed ("Resource not assigned to task 1");
+  end if;
+
+  Ptr2 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests 
+                                   -- resource; request for resource should 
+                                   -- be granted
+  Spinlock;                        -- ensure that task obtains resource  
+
+                                   -- Task 1 waiting for call to Done
+                                   -- Task 2 waiting for call to Done
+                                   -- Resources held by tasks 1 and 2
+                                   -- No resources available
+  if (Task_Pkg.Counter.Number /= 2) 
+  or (Semaphores.Resource.Available /= 0) then
+    Report.Failed ("Resource not assigned to task 2");
+  end if;
+
+  Ptr3 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests 
+                                   -- resource; request for resource should 
+                                   -- be denied and task queued to wait for 
+                                   -- next available resource
+
+
+  Ptr1.all.Done;                   -- Task 1 releases resource and lock
+                                   -- Resource should be given to queued task
+  Spinlock;                        -- ensure that resource is released
+
+
+                                   -- Task 1 holds no resource
+                                   -- One resource still assigned to task 2
+                                   -- One resource assigned to task 3
+                                   -- No resources available
+  if (Task_Pkg.Counter.Number /= 2) 
+  or (Semaphores.Resource.Available /= 0) then
+    Report.Failed ("Resource not properly released/assigned to task 3");
+  end if;
+
+  Ptr2.all.Done;                   -- Task 2 releases resource and lock
+                                   -- No outstanding request for resource
+
+                                   -- Tasks 1 and 2 hold no resources
+                                   -- One resource assigned to task 3
+                                   -- One resource available
+  if (Task_Pkg.Counter.Number /= 1)
+  or (Semaphores.Resource.Available /= 1) then 
+    Report.Failed ("Resource not properly released from task 2");
+  end if;
+
+  Ptr3.all.Done;                   -- Task 3 releases resource and lock
+
+                                   -- All resources released
+                                   -- All tasks terminated (or close)
+                                   -- Two resources available
+  if (Task_Pkg.Counter.Number /=0) 
+  or (Semaphores.Resource.Available /= 2) then 
+    Report.Failed ("Resource not properly released from task 3");
+  end if;
+
+  Report.Result;
+
+end C940002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940004.a
new file mode 100644
index 000000000..059c97f41
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940004.a
@@ -0,0 +1,416 @@
+-- C940004.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that a protected record can be used to control access to
+--      resources (data internal to the protected record).
+--
+-- TEST DESCRIPTION:
+--      Declare a resource descriptor tagged type.  Extend the type and
+--      use the extended type in a protected data structure.
+--      Implement a binary semaphore type.  Declare an entry for
+--      requesting a specific resource and an procedure for releasing the
+--      same resource.  Declare an object of this (protected) type.
+--      Declare and start three tasks each of which asks for a resource
+--      when directed to.  Verify that resources are properly allocated
+--      and deallocated.
+--
+--
+-- CHANGE HISTORY:
+--
+--      12 DEC 93   SAIC    Initial PreRelease version
+--      23 JUL 95   SAIC    Second PreRelease version
+--      16 OCT 95   SAIC    ACVC 2.1
+--      13 MAR 03   RLB     Fixed race condition in test.
+--
+--!
+
+package C940004_0 is
+-- Resource_Pkg
+
+   type ID_Type is new Integer range 0..10;
+   type User_Descriptor_Type is tagged record
+      Id : ID_Type := 0;
+   end record;
+
+end C940004_0; -- Resource_Pkg
+
+--============================--
+-- no body for C940004_0
+--=============================--
+
+with C940004_0; -- Resource_Pkg
+
+-- This generic package implements a semaphore to control a single resource
+
+generic
+
+  type Generic_Record_Type is new C940004_0.User_Descriptor_Type
+                                                         with private;
+
+package C940004_1 is
+-- Generic_Semaphore_Pkg
+                -- generic package extends the tagged formal generic
+                -- type with some implementation relevant details, and
+                -- it provides a semaphore with operations that work
+                -- on that type
+   type User_Rec_Type is new Generic_Record_Type with private;
+
+   protected type Semaphore_Type is
+      function  TC_Count return Integer;
+      entry     Request (R : in out User_Rec_Type);
+      procedure Release (R : in out User_Rec_Type);
+   private
+      In_Use : Boolean := false;
+   end Semaphore_Type;
+
+   function Has_Access (R : User_Rec_Type) return Boolean;
+
+private
+
+   type User_Rec_Type is new Generic_Record_Type with record
+      Access_To_Resource : boolean := false;
+   end record;
+
+end C940004_1;        -- Generic_Semaphore_Pkg
+
+--===================================================--
+
+package body C940004_1 is
+-- Generic_Semaphore_Pkg
+
+   protected body Semaphore_Type is
+
+      function TC_Count return Integer is
+      begin
+         return Request'Count;
+      end TC_Count;
+
+      entry Request (R : in out User_Rec_Type)
+                                               when not In_Use is
+      begin
+         In_Use := true;
+         R.Access_To_Resource := true;
+      end Request;
+
+      procedure Release (R : in out User_Rec_Type) is
+      begin
+         In_Use := false;
+         R.Access_To_Resource := false;
+      end Release;
+
+   end Semaphore_Type;
+
+   function Has_Access (R : User_Rec_Type) return Boolean is
+   begin
+      return R.Access_To_Resource;
+   end Has_Access;
+
+end C940004_1;       -- Generic_Semaphore_Pkg
+
+--=============================================--
+
+with Report;
+with C940004_0; -- Resource_Pkg,
+with C940004_1; -- Generic_Semaphore_Pkg;
+
+package C940004_2 is
+-- Printer_Mgr_Pkg
+
+   -- Instantiate the generic to get code to manage a single printer;
+   -- User processes contend for the printer, asking for it by a call
+   -- to Request, and relinquishing it by a call to Release
+
+   -- This package extends a tagged type to customize it for the printer
+   -- in question, then it uses the type to instantiate the generic and
+   -- declare a semaphore specific to the particular resource
+
+   package Resource_Pkg          renames C940004_0;
+
+   type User_Desc_Type is new Resource_Pkg.User_Descriptor_Type with record
+       New_Details : Integer := 0;    -- for example
+   end record;
+
+   package Instantiation is new C940004_1   -- Generic_Semaphore_Pkg
+                                   (Generic_Record_Type => User_Desc_Type);
+
+   Printer_Access_Mgr : Instantiation.Semaphore_Type;
+
+
+end C940004_2; -- Printer_Mgr_Pkg
+
+--============================--
+-- no body for C940004_2
+--============================--
+
+with C940004_0; -- Resource_Pkg,
+with C940004_2; -- Printer_Mgr_Pkg;
+
+package C940004_3 is
+-- User_Task_Pkg
+
+-- This package models user tasks  that will request and release
+-- the printer
+   package Resource_Pkg    renames C940004_0;
+   package Printer_Mgr_Pkg renames C940004_2;
+
+   task type User_Task_Type (ID : Resource_Pkg.ID_Type) is
+      entry Get_Printer;   -- instructs task to request resource
+
+      entry Release_Printer    -- instructs task to release printer
+          (Descriptor : in out Printer_Mgr_pkg.Instantiation.User_Rec_Type);
+
+      --==================--
+      -- Test management machinery
+      --==================--
+      entry TC_Get_Descriptor       -- returns descriptor
+            (Descriptor :  out Printer_Mgr_Pkg.Instantiation.User_Rec_Type);
+
+   end User_Task_Type;
+
+   --==================--
+   -- Test management machinery
+   --==================--
+   TC_Times_Obtained : Integer := 0;
+   TC_Times_Released : Integer := 0;
+
+end C940004_3; -- User_Task_Pkg;
+
+--==============================================--
+
+with Report;
+with C940004_0; -- Resource_Pkg,
+with C940004_2; -- Printer_Mgr_Pkg,
+
+package body C940004_3 is
+-- User_Task_Pkg
+
+   task body User_Task_Type is
+      D : Printer_Mgr_Pkg.Instantiation.User_Rec_Type;
+   begin
+      D.Id := ID;
+            -----------------------------------
+      Main:
+      loop
+         select
+            accept Get_Printer;
+            Printer_Mgr_Pkg.Printer_Access_Mgr.Request (D);
+                      -- request resource; if resource is not available,
+                      -- task will be queued to wait
+            --===================--
+            -- Test management machinery
+            --===================--
+            TC_Times_Obtained := TC_Times_Obtained + 1;
+                      -- when request granted, note it and post a message
+
+         or
+           accept Release_Printer  (Descriptor : in out
+                             Printer_Mgr_Pkg.Instantiation.User_Rec_Type) do
+
+              Printer_Mgr_Pkg.Printer_Access_Mgr.Release (D);
+                          -- release the resource, note its release
+              TC_Times_Released := TC_Times_Released + 1;
+              Descriptor := D;
+           end Release_Printer;
+           exit Main;
+
+         or
+           accept TC_Get_Descriptor  (Descriptor : out
+                            Printer_Mgr_Pkg.Instantiation.User_Rec_Type) do
+
+              Descriptor := D;
+           end TC_Get_Descriptor;
+
+         end select;
+      end loop main;
+
+   exception
+      when others => Report.Failed ("exception raised in User_Task");
+   end User_Task_Type;
+
+end C940004_3;   -- User_Task_Pkg;
+
+--==========================================================--
+
+with Report;
+with ImpDef;
+
+with C940004_0; -- Resource_Pkg,
+with C940004_2; -- Printer_Mgr_Pkg,
+with C940004_3; -- User_Task_Pkg;
+
+procedure C940004 is
+   Verbose : constant Boolean := False;
+   package Resource_Pkg    renames C940004_0;
+   package Printer_Mgr_Pkg renames C940004_2;
+   package User_Task_Pkg   renames C940004_3;
+
+   Task1 : User_Task_Pkg.User_Task_Type (1);
+   Task2 : User_Task_Pkg.User_Task_Type (2);
+   Task3 : User_Task_Pkg.User_Task_Type (3);
+
+   User_Rec_1,
+   User_Rec_2,
+   User_Rec_3 : Printer_Mgr_Pkg.Instantiation.User_Rec_Type;
+
+begin
+
+   Report.Test ("C940004", "Check that a protected record can be used to " &
+                           "control access to resources");
+
+   if    (User_Task_Pkg.TC_Times_Obtained /= 0)
+      or (User_Task_Pkg.TC_Times_Released /= 0)
+      or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1)
+      or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2)
+      or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
+         Report.Failed ("Wrong initial conditions");
+   end if;
+
+   Task1.Get_Printer;           -- ask for resource
+                                -- request for resource should be granted
+   Task1.TC_Get_Descriptor (User_Rec_1);-- wait here 'til task gets resource
+
+   if        (User_Task_Pkg.TC_Times_Obtained /= 1)
+      or     (User_Task_Pkg.TC_Times_Released /= 0)
+      or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1) then
+         Report.Failed ("Resource not assigned to task 1");
+   end if;
+
+   Task2.Get_Printer;              -- ask for resource
+                                   -- request for resource should be denied
+                                   -- and task queued to wait
+
+   -- Task 1 still waiting to accept Release_Printer, still holds resource
+   -- Task 2 queued on Semaphore.Request
+
+   -- Ensure that Task2 is queued before continuing to make checks and queue
+   -- Task3. We use a for loop here to avoid hangs in broken implementations.
+   for TC_Cnt in 1 .. 20 loop
+      exit when Printer_Mgr_Pkg.Printer_Access_Mgr.TC_Count >= 1;
+      delay Impdef.Minimum_Task_Switch;
+   end loop;
+
+   if    (User_Task_Pkg.TC_Times_Obtained /= 1)
+      or (User_Task_Pkg.TC_Times_Released /= 0) then
+        Report.Failed ("Resource assigned to task 2");
+   end if;
+
+   Task3.Get_Printer;        -- ask for resource
+                             -- request for resource should be denied
+                             -- and task 3 queued on Semaphore.Request
+
+   Task1.Release_Printer (User_Rec_1);-- task 1 releases resource
+                                      -- released resource should be given to
+                                      -- queued task 2.
+
+   Task2.TC_Get_Descriptor (User_Rec_2);-- wait here for task 2
+
+   -- Task 1 has released resource and completed
+   -- Task 2 has seized the resource
+   -- Task 3 is queued on Semaphore.Request
+
+   if        (User_Task_Pkg.TC_Times_Obtained /= 2)
+      or     (User_Task_Pkg.TC_Times_Released /= 1)
+      or     Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1)
+      or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2) then
+          Report.Failed ("Resource not properly released/assigned" &
+                         " to task 2");
+          if Verbose then
+             Report.Comment ("TC_Times_Obtained: " &
+                 Integer'Image (User_Task_Pkg.TC_Times_Obtained));
+             Report.Comment ("TC_Times_Released: " &
+                 Integer'Image (User_Task_Pkg.TC_Times_Released));
+             Report.Comment ("User 1 Has_Access:" &
+                Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                               Has_Access (User_Rec_1)));
+             Report.Comment ("User 2 Has_Access:" &
+                Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                               Has_Access (User_Rec_2)));
+          end if;
+   end if;
+
+   Task2.Release_Printer (User_Rec_2);-- task 2 releases resource
+
+   -- task 3 is released from queue, and is given resource
+
+   Task3.TC_Get_Descriptor (User_Rec_3);-- wait for task 3
+
+   if        (User_Task_Pkg.TC_Times_Obtained /= 3)
+      or     (User_Task_Pkg.TC_Times_Released /= 2)
+      or     Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2)
+      or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
+        Report.Failed ("Resource not properly released/assigned " &
+                       "to task 3");
+          if Verbose then
+             Report.Comment ("TC_Times_Obtained: " &
+                Integer'Image (User_Task_Pkg.TC_Times_Obtained));
+             Report.Comment ("TC_Times_Released: " &
+                Integer'Image (User_Task_Pkg.TC_Times_Released));
+             Report.Comment ("User 1 Has_Access:" &
+                Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                               Has_Access (User_Rec_1)));
+             Report.Comment ("User 2 Has_Access:" &
+                Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                               Has_Access (User_Rec_2)));
+             Report.Comment ("User 3 Has_Access:" &
+                Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                               Has_Access (User_Rec_3)));
+          end if;
+   end if;
+
+   Task3.Release_Printer (User_Rec_3);-- task 3 releases resource
+
+   if    (User_Task_Pkg.TC_Times_Obtained /=3)
+      or (User_Task_Pkg.TC_Times_Released /=3)
+      or Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
+         Report.Failed ("Resource not properly released by task 3");
+         if Verbose then
+             Report.Comment ("TC_Times_Obtained: " &
+                Integer'Image (User_Task_Pkg.TC_Times_Obtained));
+             Report.Comment ("TC_Times_Released: " &
+                Integer'Image (User_Task_Pkg.TC_Times_Released));
+             Report.Comment ("User 1 Has_Access:" &
+                Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                               Has_Access (User_Rec_1)));
+             Report.Comment ("User 2 Has_Access:" &
+                Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                               Has_Access (User_Rec_2)));
+             Report.Comment ("User 3 Has_Access:" &
+                Boolean'Image (Printer_Mgr_Pkg.Instantiation.
+                               Has_Access (User_Rec_3)));
+         end if;
+
+   end if;
+
+   -- Ensure that all tasks have terminated before reporting the result
+   while not (Task1'terminated
+              and Task2'terminated
+              and Task3'terminated) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+   Report.Result;
+
+end C940004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940005.a
new file mode 100644
index 000000000..47a97bf2d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940005.a
@@ -0,0 +1,370 @@
+-- C940005.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 body of a protected function can have internal calls
+--      to other protected functions and that the body of a protected
+--      procedure can have internal calls to protected procedures and to 
+--      protected functions.
+--
+-- TEST DESCRIPTION:
+--      Simulate a meter at a freeway on-ramp which, when real-time sensors
+--      determine that the freeway is becoming saturated, triggers stop lights
+--      which control the access of vehicles to prevent further saturation. 
+--      Each on-ramp is represented by a protected object - in this case only
+--      one is shown (Test_Ramp).  The routines to sample and alter the states
+--      of the various sensors, to queue the vehicles on the meter and to
+--      release them are all part of the  protected object and can be shared
+--      by various tasks. Apart from the function/procedure tests this example
+--      has a mix of other tasking features. 
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      13 Nov 95   SAIC    Updated and fixed bugs ACVC 2.0.1
+--
+--!
+
+
+with Report;
+with ImpDef;
+with Ada.Calendar;
+                
+procedure C940005 is
+
+begin
+
+   Report.Test ("C940005", "Check internal calls of protected functions" &
+                        " and procedures");
+
+   declare  -- encapsulate the test
+
+      function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                            return Ada.Calendar.Time renames Ada.Calendar."+";
+
+      -- Weighted load given to each potential problem area and accumulated
+      type Load_Factor is range 0..8;
+      Clear_Level    : constant Load_Factor := 0;
+      Minimum_Level  : constant Load_Factor := 1;
+      Moderate_Level : constant Load_Factor := 2;
+      Serious_Level  : constant Load_Factor := 4;
+      Critical_Level : constant Load_Factor := 6;
+
+      -- Weighted loads given to each  Sample Point (pure weights, not levels)
+      Local_Overload_wt         : constant Load_Factor := 1;
+      Next_Ramp_in_Overload_wt  : constant Load_Factor := 1;
+      Ramp_Junction_in_Overload_wt : constant Load_Factor :=2; --higher wght
+      -- ::::  other weighted loads
+          
+      TC_Multiplier : integer := 1;  -- changed half way through
+      TC_Expected_Passage_Total : constant integer := 486;
+
+      -- This is the time between synchronizing pulses to the ramps.
+      -- In reality one would expect a time of 5 to 10 seconds.  In
+      -- the interests of speeding up the test suite a shorter time
+      -- is used
+      Pulse_Time_Delta : constant duration := ImpDef.Long_Switch_To_New_Task;
+
+      -- control over stopping tasks
+      protected Control is
+         procedure Stop_Now;
+         function Stop return Boolean;
+      private
+         Halt : Boolean := False;
+      end Control;
+
+      protected body Control is
+         procedure Stop_Now is
+         begin
+            Halt := True;
+         end Stop_Now;
+
+         function Stop return Boolean is
+         begin
+            return Halt;
+         end Stop;
+      end Control;
+
+      task Pulse_Task;       -- task to generate a pulse for each ramp
+
+      -- Carrier task. One is created for each vehicle arriving at the ramp
+      task type Vehicle;      
+      type acc_Vehicle is access Vehicle;
+
+      --================================================================
+      protected Test_Ramp is
+         function Next_Ramp_in_Overload return Load_Factor;
+         function Local_Overload        return Load_Factor;
+         function Freeway_Overload      return Load_Factor;
+         function Freeway_Breakdown     return Boolean;
+         function Meter_in_use_State    return Boolean; 
+         procedure Set_Local_Overload;
+         procedure Add_Meter_Queue;
+         procedure Subtract_Meter_Queue;
+         procedure Time_Pulse_Received;
+         entry Wait_at_Meter;
+         procedure TC_Passage (Pass_Point : Integer);
+         function TC_Get_Passage_Total return integer;
+         -- ::::::::: many routines are not shown (for example none of the
+         --            clears, none of the real-time-sensor handlers)
+   
+      private
+
+         Release_One_Vehicle : Boolean := false;
+         Meter_in_Use        : Boolean := false;
+         Fwy_Break_State     : Boolean := false;
+               
+   
+         Ramp_Count : integer range 0..20 := 0;
+         Ramp_Count_Threshold : integer := 15;
+   
+         -- Current state of the various Sample Points
+         Local_State     : Load_Factor := Clear_Level;
+         Next_Ramp_State : Load_Factor := Clear_Level;
+            -- ::::  other Sample Point states not shown
+   
+         TC_Passage_Total : integer := 0;
+      end Test_Ramp;  
+      --================================================================
+      protected body Test_Ramp is
+   
+            procedure Start_Meter is
+            begin
+               Meter_in_Use := True;
+               null;  -- stub  :::: trigger the metering hardware
+            end Start_Meter;
+         
+         -- External call for Meter_in_Use
+         function Meter_in_Use_State return Boolean is
+         begin
+            return Meter_in_Use;
+         end Meter_in_Use_State;
+   
+         -- Trace the paths through the various routines by totaling the
+         -- weighted call parameters
+         procedure TC_Passage (Pass_Point : Integer) is
+         begin
+            TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
+         end TC_Passage;
+   
+         -- For the final check of the whole test
+         function TC_Get_Passage_Total return integer is
+         begin
+            return TC_Passage_Total;
+         end TC_Get_Passage_Total;
+   
+         -- These Set/Clear routines are triggered by real-time sensors that
+         -- reflect traffic state
+         procedure Set_Local_Overload is
+         begin
+            Local_State := Local_Overload_wt;
+            if not Meter_in_Use then
+               Start_Meter;   -- LOCAL INTERNAL PROCEDURE FROM PROCEDURE
+            end if;
+         end Set_Local_Overload;
+   
+         --::::: Set/Clear routines for all the other sensors not shown
+
+         function Local_Overload return Load_Factor is
+         begin
+            return Local_State;
+         end Local_Overload;
+   
+         function Next_Ramp_in_Overload return Load_Factor is
+         begin
+            return Next_Ramp_State;
+         end Next_Ramp_in_Overload;
+   
+         -- ::::::::  other overload factor states not shown
+   
+         -- return the summation of all the load factors
+         function Freeway_Overload return Load_Factor is
+         begin
+            return    Local_Overload                    -- EACH IS A CALL OF A
+                      -- + :::: others                  -- FUNCTION FROM WITHIN
+                      + Next_Ramp_in_Overload;          -- A FUNCTION
+         end Freeway_Overload;
+
+         -- Freeway Breakdown is defined as traffic moving < 5mph
+         function Freeway_Breakdown return Boolean is
+         begin
+            return Fwy_Break_State;
+         end Freeway_Breakdown;
+   
+         -- Keep count of vehicles currently on meter queue - we can't use
+         -- the 'count because we need the outcall trigger
+         procedure Add_Meter_Queue is
+            TC_Pass_Point : constant integer := 22;
+         begin
+            Ramp_Count := Ramp_Count + 1;  
+            TC_Passage ( TC_Pass_Point );  -- note passage through here
+            if Ramp_Count > Ramp_Count_Threshold then
+               null;  -- :::: stub, trigger surface street notification
+            end if;
+         end Add_Meter_Queue;  
+         --
+         procedure Subtract_Meter_Queue is
+            TC_Pass_Point : constant integer := 24;
+         begin
+            Ramp_Count := Ramp_Count - 1;  
+            TC_Passage ( TC_Pass_Point );  -- note passage through here
+         end Subtract_Meter_Queue;  
+   
+         -- Here each Vehicle task queues itself awaiting release
+         entry Wait_at_Meter when Release_One_Vehicle is
+         -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
+            TC_Pass_Point : constant integer := 23;
+         begin
+            TC_Passage ( TC_Pass_Point );   -- note passage through here
+            Release_One_Vehicle := false;   -- Consume the signal
+            -- Decrement number of vehicles on ramp 
+            Subtract_Meter_Queue;  -- CALL PROCEDURE FROM WITHIN ENTRY BODY
+         end Wait_at_Meter;      
+   
+   
+         procedure Time_Pulse_Received is
+            Load : Load_factor := Freeway_Overload; -- CALL MULTILEVEL
+                                                    -- FUNCTION 
+                                                    -- FROM WITHIN PROCEDURE
+         begin
+            -- if broken down, no vehicles are released
+            if not Freeway_Breakdown then    -- CALL FUNCTION FROM A PROCEDURE
+               if Load < Moderate_Level then
+                  Release_One_Vehicle := true;
+               end if;
+               null;    -- stub  ::: If other levels, release every other
+                        --           pulse, every third pulse  etc.
+            end if;
+         end Time_Pulse_Received;
+       
+      end Test_Ramp;  
+      --================================================================
+       
+
+      -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
+      -- generation of an accompanying carrier task
+      procedure New_Arrival is
+         Next_Vehicle_Task: acc_Vehicle := new Vehicle;
+         TC_Pass_Point : constant integer := 3; 
+      begin
+         Test_Ramp.TC_Passage ( TC_Pass_Point );  -- Note passage through here
+         null;
+      end New_arrival;
+
+
+      -- Carrier task. One is created for each vehicle arriving at the ramp
+      task body Vehicle is
+         TC_Pass_point   : constant integer :=  1;
+         TC_Pass_Point_2 : constant integer := 21;
+         TC_Pass_Point_3 : constant integer :=  2;
+      begin
+         Test_Ramp.TC_Passage ( TC_Pass_Point );  -- note passage through here
+         if Test_Ramp.Meter_in_Use_State then  
+            Test_Ramp.TC_Passage ( TC_Pass_Point_2 );  -- note passage
+            -- Increment count of number of vehicles on ramp 
+            Test_Ramp.Add_Meter_Queue;    -- CALL a protected PROCEDURE
+                                          -- which is also called from within
+            -- enter the meter queue
+            Test_Ramp.Wait_at_Meter;      -- CALL a protected ENTRY   
+         end if;
+         Test_Ramp.TC_Passage ( TC_Pass_Point_3 );  -- note passage thru here
+         null;  --:::: call to the first in the series of the Ramp_Sensors
+                --     this "passes" the vehicle from one sensor to the next
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Vehicle Task");
+      end Vehicle;
+
+
+      -- Task transmits a synchronizing "pulse" to all ramps
+      --
+      task body Pulse_Task is
+         Pulse_Time : Ada.Calendar.Time := Ada.Calendar.Clock;
+      begin
+         While not Control.Stop loop
+            delay until Pulse_Time;  
+            Test_Ramp.Time_Pulse_Received;  -- causes INTERNAL CALLS
+            -- ::::::::::  and to all the others
+            Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next
+         end loop;
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Pulse_Task");
+      end Pulse_Task;
+
+
+   begin -- declare
+
+      -- Test driver.  This is ALL test control code
+
+      -- First simulate calls to the protected functions and procedures
+      -- from without the protected object
+      --
+      -- CALL FUNCTIONS
+      if Test_Ramp.Local_Overload /= Clear_Level then
+         Report.Failed ("External Call to Local_Overload incorrect");
+      end if;
+      if Test_Ramp.Next_Ramp_in_Overload /= Clear_Level then
+         Report.Failed ("External Call to Next_Ramp_in_Overload incorrect");
+      end if;
+      if Test_Ramp.Freeway_Overload /= Clear_Level then
+         Report.Failed ("External Call to Freeway_Overload incorrect");
+      end if;
+
+      -- Now Simulate the arrival of a vehicle to verify path through test
+      New_Arrival; 
+      delay Pulse_Time_Delta*2;  -- allow it to pass through the complex
+
+      TC_Multiplier := 5;  -- change the weights for the paths for the next
+                           -- part of the test
+      
+      -- Simulate a real-time sensor reporting overload
+      Test_Ramp.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
+
+      -- CALL FUNCTIONS again
+      if Test_Ramp.Local_Overload /= Minimum_Level then
+         Report.Failed ("External Call to Local_Overload incorrect - 2");
+      end if;
+      if Test_Ramp.Freeway_Overload /= Minimum_Level then
+         Report.Failed ("External Call to Freeway_Overload incorrect -2");
+      end if;
+
+      -- Now Simulate the arrival of another vehicle again causing
+      -- INTERNAL CALLS but following different paths (queuing on the 
+      -- meter etc.)
+      New_Arrival; 
+      delay Pulse_Time_Delta*2;  -- allow it to pass through the complex
+
+      Control.Stop_Now;  -- finish test
+
+      if TC_Expected_Passage_Total /= Test_Ramp.TC_Get_Passage_Total then
+         Report.Failed ("Unexpected paths taken");
+      end if;
+
+   end; -- declare
+
+   Report.Result;
+
+end C940005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940006.a
new file mode 100644
index 000000000..36e6c9171
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940006.a
@@ -0,0 +1,223 @@
+-- C940006.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 body of a protected function can have external calls
+--      to other protected functions and that the body of a protected
+--      procedure can have external calls to protected procedures and to 
+--      protected functions.
+--
+-- TEST DESCRIPTION:
+--      Use a subset of the simulation of the freeway on-ramp described in
+--      c940005.  In this case two protected objects are used but only a
+--      minimum of routines are shown in each.  Both objects are hard coded
+--      and detail two adjacent on-ramps (Ramp_31 & Ramp_32) with routines in 
+--      each which use external calls to the  other.  
+
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+
+procedure C940006 is
+
+begin
+
+   Report.Test ("C940006", "Check external calls of protected functions" &
+                        " and procedures");
+
+   declare  -- encapsulate the test
+
+      -- Weighted load given to each potential problem area and accumulated
+      type Load_Factor is range 0..8;
+      -- 
+      Clear_Level    : constant Load_Factor := 0;
+      Minimum_Level  : constant Load_Factor := 1;
+      Moderate_Level : constant Load_Factor := 3;
+      Serious_Level  : constant Load_Factor := 4;
+      Critical_Level : constant Load_Factor := 6;
+
+      --================================================================
+      -- Only the Routines that are used in this test are shown
+      --
+      protected Ramp_31 is
+
+         function Local_Overload        return Load_Factor;
+         procedure Set_Local_Overload(Sensor_Level : Load_Factor);
+         procedure Notify;
+         function Next_Ramp_Overload    return Load_Factor;
+         function Freeway_Overload      return Load_Factor;
+         procedure Downstream_Ramps;
+         function Get_DSR_Accumulate    return Load_Factor;
+
+      private
+         Next_Ramp_Alert : Boolean  := false;  -- Next Ramp is in trouble?
+
+         -- Current state of the various Sample Points
+         Local_State     : Load_Factor := Clear_Level;
+         -- Accumulated load for next three downstream ramps
+         DSR_Accumulate  : Load_Factor := Clear_Level;  
+   
+      end Ramp_31;  
+      --================================================================
+      -- Only the Routines that are used in this test are shown
+      --
+      protected Ramp_32 is
+      
+         function Local_Overload return Load_Factor;
+         procedure Set_Local_Overload (Sensor_Level : Load_Factor); 
+
+      private
+
+         Local_State : Load_Factor := Clear_Level;
+
+      end Ramp_32;  
+      --================================================================
+      protected body Ramp_31 is
+   
+         -- These Set/Clear routines are triggered by real-time sensors that
+         -- reflect traffic state
+         procedure Set_Local_Overload (Sensor_Level : Load_Factor) is
+         begin
+            -- Notify "previous" ramp to check this one for current state.
+            -- Subsequent changes in state will not send an alert 
+            null;   --::::: (see Ramp_32 for this code)
+            Local_State := Sensor_Level;
+            null;   --::::: Start local meter if not already started
+         end Set_Local_Overload;
+   
+         function Local_Overload return Load_Factor is
+         begin
+            return Local_State;
+         end Local_Overload;
+   
+         -- This is notification from the next ramp that it is in
+         -- overload.  With this provision we only need to sample the next
+         -- ramp during adverse conditions.  
+         procedure Notify is
+         begin
+            Next_Ramp_Alert := true;
+         end Notify;
+
+         function Next_Ramp_Overload return Load_Factor is
+         begin
+            if Next_Ramp_Alert then
+               -- EXTERNAL FUNCTION CALL FROM FUNCTION
+               -- Get next ramp's current state
+               return Ramp_32.Local_Overload;
+            else
+               return Clear_Level;  
+            end if;
+         end Next_Ramp_Overload;
+   
+         -- return the summation of all the load factors
+         function Freeway_Overload return Load_Factor is
+         begin
+            return    Local_Overload                   
+                      -- + :::: others                  
+                      + Next_Ramp_Overload;             
+         end Freeway_Overload;
+
+         -- Snapshot the states of the next three downstream ramps
+         procedure Downstream_Ramps is
+         begin
+            DSR_Accumulate := Ramp_32.Local_Overload;    -- EXTERNAL FUNCTION
+            -- ::::         + Ramp_33.Local_Overload     -- FROM  PROCEDURE
+            -- ::::         + Ramp_34.Local_Overload
+         end Downstream_Ramps;
+
+         -- Get last snapshot
+         function Get_DSR_Accumulate return Load_Factor is
+         begin
+            return DSR_Accumulate;
+         end Get_DSR_Accumulate;
+
+      end Ramp_31;  
+      --================================================================
+      protected body Ramp_32 is
+
+         function Local_Overload return Load_Factor is
+         begin
+            return Local_State;
+         end;
+   
+   
+         -- These Set/Clear routines are triggered by real-time sensors that
+         -- reflect traffic state
+         procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
+         begin
+            if Local_State = Clear_Level then
+               -- Notify "previous" ramp to check this one for current state.
+               -- Subsequent changes in state will not send an alert
+               -- When the situation clears another routine performs the 
+               -- all_clear notification. (not shown)
+               -- EXTERNAL CALL OF PROCEDURE FROM PROCEDURE
+               Ramp_31.Notify;
+            end if;
+            Local_State := Sensor_Level;
+            null;   --::::: Start local meter if not already started
+         end;
+
+      end Ramp_32;  
+      --================================================================
+
+
+
+   begin -- declare
+
+      -- Test driver.  This is ALL test control code
+      -- Simulate calls to the protected functions and procedures
+      -- from without the protected object, these will, in turn make the
+      -- external calls.
+
+      -- Check initial conditions, exercising the simple calls
+      if not (Ramp_31.Local_Overload     = Clear_Level  and
+              Ramp_31.Next_Ramp_Overload = Clear_Level  and
+              Ramp_31.Freeway_Overload   = Clear_Level) and
+              Ramp_32.Local_Overload     = Clear_Level    then
+                  Report.Failed ("Initial Calls provided unexpected Results");
+      end if;
+      
+      -- Simulate real-time sensors reporting overloads at a hardware level
+      Ramp_31.Set_Local_Overload (1);
+      Ramp_32.Set_Local_Overload (3);
+     
+      Ramp_31.Downstream_Ramps;   -- take the current snapshot
+
+      if not (Ramp_31.Local_Overload     = Minimum_Level  and
+              Ramp_31.Get_DSR_Accumulate = Moderate_Level and
+              Ramp_31.Freeway_Overload   = Serious_Level)   then
+         Report.Failed ("Secondary Calls provided unexpected Results");
+      end if;
+      
+   end; -- declare
+
+   Report.Result;
+
+end C940006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940007.a
new file mode 100644
index 000000000..41e80f4e2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940007.a
@@ -0,0 +1,427 @@
+-- C940007.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 body of a protected function declared as an object of a
+--      given type can have internal calls to other protected functions and
+--      that a protected procedure in such an object can have internal calls
+--      to protected procedures and to  protected functions. 
+--
+-- TEST DESCRIPTION:
+--      Simulate a meter at a freeway on-ramp which, when real-time sensors
+--      determine that the freeway is becoming saturated, triggers stop lights
+--      which control the access of vehicles to prevent further saturation. 
+--      Each on-ramp is represented by a protected object of the type Ramp. 
+--      The routines to sample and alter the states of the various sensors, to
+--      queue the vehicles on the meter and to release them are all part of
+--      the  protected object and can be shared by various tasks. Apart from
+--      the function/procedure tests this example has a mix of other tasking
+--      features.  In this test two objects representing two adjacent ramps
+--      are created from the same type.  The same "traffic" is simulated for
+--      each ramp.  The results should be identical.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      13 Nov 95   SAIC    Replaced shared global variable Pulse_Stop
+--                          with a protected object.
+--                          ACVC 2.0.1
+--
+--!
+
+
+with Report;
+with ImpDef;
+with Ada.Calendar;
+        
+                
+procedure C940007 is
+
+begin
+
+   Report.Test ("C940007", "Check internal calls of protected functions" &
+                        " and procedures in objects declared as a type");
+
+   declare  -- encapsulate the test
+
+      function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                          return Ada.Calendar.Time renames Ada.Calendar."+";
+
+      -- Weighted load given to each potential problem area and accumulated
+      type Load_Factor is range 0..8;
+      Clear_Level    : constant Load_Factor := 0;
+      Minimum_Level  : constant Load_Factor := 1;
+      Moderate_Level : constant Load_Factor := 2;
+      Serious_Level  : constant Load_Factor := 4;
+      Critical_Level : constant Load_Factor := 6;
+
+      -- Weighted loads given to each  Sample Point (pure weights, not levels)
+      Local_Overload_wt            : constant Load_Factor := 1;
+      Next_Ramp_in_Overload_wt     : constant Load_Factor := 1;
+      Ramp_Junction_in_Overload_wt : constant Load_Factor :=2; --higher wght
+      -- ::::  other weighted loads
+          
+      TC_Expected_Passage_Total : integer := 486;
+
+
+      -- This is the time between synchronizing pulses to the ramps.
+      -- In reality one would expect a time of 5 to 10 seconds.  In
+      -- the interests of speeding up the test suite a shorter time
+      -- is used
+      Pulse_Time_Delta : constant duration := ImpDef.Long_Switch_To_New_Task;
+
+
+      -- control over stopping tasks
+      protected Control is
+         procedure Stop_Now;
+         function Stop return Boolean;
+      private
+         Halt : Boolean := False;
+      end Control;
+
+      protected body Control is
+         procedure Stop_Now is
+         begin
+            Halt := True;
+         end Stop_Now;
+
+         function Stop return Boolean is
+         begin
+            return Halt;
+         end Stop;
+      end Control;
+
+
+      task Pulse_Task;       -- task to generate a pulse for each ramp
+
+      -- Carrier tasks. One is created for each vehicle arriving at each ramp
+      task type Vehicle_31;            -- For Ramp_31
+      type acc_Vehicle_31 is access Vehicle_31;
+      --
+      task type Vehicle_32;            -- For Ramp_32
+      type acc_Vehicle_32 is access Vehicle_32;
+                
+      --================================================================
+      protected type Ramp is
+         function Next_Ramp_in_Overload return Load_Factor;
+         function Local_Overload        return Load_Factor;
+         function Freeway_Overload      return Load_Factor;
+         function Freeway_Breakdown     return Boolean;
+         function Meter_in_Use_State    return Boolean;
+         procedure Set_Local_Overload;
+         procedure Add_Meter_Queue;
+         procedure Subtract_Meter_Queue;
+         procedure Time_Pulse_Received;
+         entry Wait_at_Meter;
+         procedure TC_Passage (Pass_Point : Integer);
+         function TC_Get_Passage_Total return integer;
+         -- ::::::::: many routines are not shown (for example none of the
+         --            clears, none of the real-time-sensor handlers)
+   
+      private
+
+         Release_One_Vehicle : Boolean := false;
+         Meter_in_Use        : Boolean := false;
+         Fwy_Break_State     : Boolean := false;
+               
+   
+         Ramp_Count : integer range 0..20 := 0;
+         Ramp_Count_Threshold : integer := 15;
+   
+         -- Current state of the various Sample Points
+         Local_State     : Load_Factor := Clear_Level;
+         Next_Ramp_State : Load_Factor := Clear_Level;
+            -- ::::  other Sample Point states not shown
+   
+         TC_Multiplier    : integer := 1;  -- changed half way through
+         TC_Passage_Total : integer := 0;
+      end Ramp;  
+      --================================================================
+      protected body Ramp is
+   
+            procedure Start_Meter is
+            begin
+               Meter_in_Use := True;
+               null;  -- stub  :::: trigger the metering hardware
+            end Start_Meter;
+   
+         function Meter_in_Use_State return Boolean is
+         begin
+            return Meter_in_Use;
+         end Meter_in_Use_State;
+
+         -- Trace the paths through the various routines by totaling the
+         -- weighted call parameters
+         procedure TC_Passage (Pass_Point : Integer) is
+         begin
+            TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
+         end TC_Passage;
+   
+         -- For the final check of the whole test
+         function TC_Get_Passage_Total return integer is
+         begin
+            return TC_Passage_Total;
+         end TC_Get_Passage_Total;
+   
+         -- These Set/Clear routines are triggered by real-time sensors that
+         -- reflect traffic state
+         procedure Set_Local_Overload is
+         begin
+            Local_State := Local_Overload_wt;
+            if not Meter_in_Use then
+               Start_Meter;   -- LOCAL INTERNAL PROCEDURE FROM PROCEDURE
+            end if;
+            -- Change the weights for the paths for the next part of the test
+            TC_Multiplier :=5;
+         end Set_Local_Overload;
+   
+         --::::: Set/Clear routines for all the other sensors not shown
+
+         function Local_Overload return Load_Factor is
+         begin
+            return Local_State;
+         end Local_Overload;
+   
+         function Next_Ramp_in_Overload return Load_Factor is
+         begin
+            return Next_Ramp_State;
+         end Next_Ramp_in_Overload;
+   
+         -- ::::::::  other overload factor states not shown
+   
+         -- return the summation of all the load factors
+         function Freeway_Overload return Load_Factor is
+         begin
+            return    Local_Overload                    -- EACH IS A CALL OF A
+                      -- + :::: others                  -- FUNCTION FROM WITHIN
+                      + Next_Ramp_in_Overload;          -- A FUNCTION
+         end Freeway_Overload;
+
+         -- Freeway Breakdown is defined as traffic moving < 5mph
+         function Freeway_Breakdown return Boolean is
+         begin
+            return Fwy_Break_State;
+         end Freeway_Breakdown;
+   
+         -- Keep count of vehicles currently on meter queue - we can't use
+         -- the 'count because we need the outcall trigger
+         procedure Add_Meter_Queue is
+            TC_Pass_Point : constant integer := 22;
+         begin
+            Ramp_Count := Ramp_Count + 1;  
+            TC_Passage ( TC_Pass_Point );  -- note passage through here
+            if Ramp_Count > Ramp_Count_Threshold then
+               null;  -- :::: stub, trigger surface street notification
+            end if;
+         end Add_Meter_Queue;  
+         --
+         procedure Subtract_Meter_Queue is
+            TC_Pass_Point : constant integer := 24;
+         begin
+            Ramp_Count := Ramp_Count - 1;  
+            TC_Passage ( TC_Pass_Point );  -- note passage through here
+         end Subtract_Meter_Queue;  
+   
+         -- Here each Vehicle task queues itself awaiting release
+         entry Wait_at_Meter when Release_One_Vehicle is
+         -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
+            TC_Pass_Point : constant integer := 23;
+         begin
+            TC_Passage ( TC_Pass_Point );   -- note passage through here
+            Release_One_Vehicle := false;   -- Consume the signal
+            -- Decrement number of vehicles on ramp 
+            Subtract_Meter_Queue;  -- CALL PROCEDURE FROM WITHIN ENTRY BODY
+         end Wait_at_Meter;      
+   
+   
+         procedure Time_Pulse_Received is
+            Load : Load_factor := Freeway_Overload; -- CALL MULTILEVEL FUNCTN 
+                                                    -- FROM WITHIN PROCEDURE
+         begin
+            -- if broken down, no vehicles are released
+            if not Freeway_Breakdown then    -- CALL FUNCTION FROM A PROCEDURE
+               if Load < Moderate_Level then
+                  Release_One_Vehicle := true;
+               end if;
+               null;    -- stub  ::: If other levels, release every other
+                        --           pulse, every third pulse  etc.
+            end if;
+         end Time_Pulse_Received;
+       
+      end Ramp;  
+      --================================================================
+
+      -- Now create two Ramp objects from this type
+      Ramp_31 : Ramp;
+      Ramp_32 : Ramp;
+
+       
+
+      -- Simulate the arrival of a vehicle at the Ramp_Receiver of Ramp_31
+      -- and the generation of an accompanying carrier task
+      procedure New_Arrival_31 is
+         Next_Vehicle_Task_31: acc_Vehicle_31 := new Vehicle_31;
+         TC_Pass_Point : constant integer := 3; 
+      begin
+         Ramp_31.TC_Passage ( TC_Pass_Point );  -- Note passage through here
+         null;   --::: stub
+      end New_arrival_31;
+
+
+      -- Carrier task. One is created for each vehicle arriving at Ramp_31
+      task body Vehicle_31 is
+         TC_Pass_point   : constant integer :=  1;
+         TC_Pass_Point_2 : constant integer := 21;
+         TC_Pass_Point_3 : constant integer :=  2;
+      begin
+         Ramp_31.TC_Passage ( TC_Pass_Point );  -- note passage through here
+         if Ramp_31.Meter_in_Use_State then  
+            Ramp_31.TC_Passage ( TC_Pass_Point_2 );  -- note passage
+            -- Increment count of number of vehicles on ramp 
+            Ramp_31.Add_Meter_Queue;    -- CALL a protected PROCEDURE
+                                          -- which is also called from within
+            -- enter the meter queue
+            Ramp_31.Wait_at_Meter;      -- CALL a protected ENTRY   
+         end if;
+         Ramp_31.TC_Passage ( TC_Pass_Point_3 );  -- note passage through here
+         null;  --:::: call to the first in the series of the Ramp_Sensors
+                --     this "passes" the vehicle from one sensor to the next
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Vehicle Task");
+      end Vehicle_31;
+
+
+      -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
+      -- generation of an accompanying carrier task
+      procedure New_Arrival_32 is
+         Next_Vehicle_Task_32 : acc_Vehicle_32 := new Vehicle_32;
+         TC_Pass_Point : constant integer := 3; 
+      begin
+         Ramp_32.TC_Passage ( TC_Pass_Point );  -- Note passage through here
+         null;  --::: stub
+      end New_arrival_32;
+
+
+      -- Carrier task. One is created for each vehicle arriving at Ramp_32
+      task body Vehicle_32 is
+         TC_Pass_point   : constant integer :=  1;
+         TC_Pass_Point_2 : constant integer := 21;
+         TC_Pass_Point_3 : constant integer :=  2;
+      begin
+         Ramp_32.TC_Passage ( TC_Pass_Point );  -- note passage through here
+         if Ramp_32.Meter_in_Use_State then  
+            Ramp_32.TC_Passage ( TC_Pass_Point_2 );  -- note passage
+            -- Increment count of number of vehicles on ramp 
+            Ramp_32.Add_Meter_Queue;    -- CALL a protected PROCEDURE
+                                          -- which is also called from within
+            -- enter the meter queue
+            Ramp_32.Wait_at_Meter;      -- CALL a protected ENTRY   
+         end if;
+         Ramp_32.TC_Passage ( TC_Pass_Point_3 );  -- note passage through here
+         null;  --:::: call to the first in the series of the Ramp_Sensors
+                --     this "passes" the vehicle from one sensor to the next
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Vehicle Task");
+      end Vehicle_32;
+
+
+      -- Task transmits a synchronizing "pulse" to all ramps
+      --
+      task body Pulse_Task is
+         Pulse_Time : Ada.Calendar.Time := Ada.Calendar.Clock;
+      begin
+         While not Control.Stop loop
+            delay until Pulse_Time;  
+            Ramp_31.Time_Pulse_Received;    -- CALL OF PROCEDURE CAUSES
+            Ramp_32.Time_Pulse_Received;    -- INTERNAL CALLS
+            -- ::::::::::  and to all the others
+            Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next
+         end loop;
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Pulse_Task");
+      end Pulse_Task;
+
+
+   begin -- declare
+
+      -- Test driver.  This is ALL test control code
+
+      -- First simulate calls to the protected functions and procedures
+      -- from without the protected object
+      --
+      -- CALL FUNCTIONS
+      if not ( Ramp_31.Local_Overload = Clear_Level and
+               Ramp_31.Next_Ramp_in_Overload = Clear_Level and
+               Ramp_31.Freeway_Overload = Clear_Level ) then
+         Report.Failed ("Initial Calls to Ramp_31 incorrect");
+      end if;
+      if not ( Ramp_32.Local_Overload = Clear_Level and
+               Ramp_32.Next_Ramp_in_Overload = Clear_Level and
+               Ramp_32.Freeway_Overload = Clear_Level ) then
+         Report.Failed ("Initial Calls to Ramp_32 incorrect");
+      end if;
+
+      -- Now Simulate the arrival of a vehicle at each ramp to verify 
+      -- basic paths through the test
+      New_Arrival_31; 
+      New_Arrival_32; 
+      delay Pulse_Time_Delta*2;  -- allow them to pass through the complex
+
+      -- Simulate real-time sensors reporting overload
+      Ramp_31.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
+      Ramp_32.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
+
+      -- CALL FUNCTIONS again
+      if not ( Ramp_31.Local_Overload = Minimum_Level and
+               Ramp_31.Freeway_Overload = Minimum_Level ) then
+         Report.Failed ("Secondary Calls to Ramp_31 incorrect");
+      end if;
+      if not ( Ramp_32.Local_Overload = Minimum_Level and
+               Ramp_32.Freeway_Overload = Minimum_Level ) then
+         Report.Failed ("Secondary Calls to Ramp_32 incorrect");
+      end if;
+
+      -- Now Simulate the arrival of another vehicle at each ramp again causing
+      -- INTERNAL CALLS but following different paths (queuing on the 
+      -- meter etc.)
+      New_Arrival_31; 
+      New_Arrival_32; 
+      delay Pulse_Time_Delta*2;  -- allow them to pass through the complex
+
+      Control.Stop_Now;  -- finish test
+
+      if not (TC_Expected_Passage_Total = Ramp_31.TC_Get_Passage_Total and
+              TC_Expected_Passage_Total = Ramp_32.TC_Get_Passage_Total) then
+         Report.Failed ("Unexpected paths taken");
+      end if;
+
+   end; -- declare
+
+   Report.Result;
+
+end C940007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940010.a
new file mode 100644
index 000000000..c4a670552
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940010.a
@@ -0,0 +1,269 @@
+-- C940010.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 an exception is raised during the execution of an 
+--      entry body it is propagated back to the caller
+--
+-- TEST DESCRIPTION:
+--      Use a small fragment of code from the simulation of a freeway meter
+--      used in c940007. Create three individual tasks which will be queued on
+--      the entry as the barrier is set.  Release them one at a time.  A
+--      procedure which is called within the entry has been modified for this
+--      test to raise a different exception for each pass through.  Check that
+--      all expected exceptions are raised and propagated.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+with Report;
+with ImpDef;
+                
+procedure C940010 is
+
+    TC_Failed_1 : Boolean := false; 
+
+begin
+
+   Report.Test ("C940010", "Check that an exception raised in an entry " &
+                        "body is propagated back to the caller");
+
+   declare  -- encapsulate the test
+
+      TC_Defined_Error : Exception;    -- User defined exception
+      TC_Expected_Passage_Total : constant integer := 669;
+      TC_Int                    : constant integer := 5;
+
+      -- Carrier tasks. One is created for each vehicle arriving at each ramp
+      task type Vehicle_31;            -- For Ramp_31
+      type acc_Vehicle_31 is access Vehicle_31;
+
+
+      --================================================================
+      protected Ramp_31 is
+
+         function Meter_in_Use_State return Boolean;
+         procedure Add_Meter_Queue;
+         procedure Subtract_Meter_Queue;
+         entry Wait_at_Meter;
+         procedure Pulse;
+         --
+         procedure TC_Passage (Pass_Point : Integer);
+         function TC_Get_Passage_Total return integer;
+         function TC_Get_Current_Exception return integer;
+
+      private
+
+         Release_One_Vehicle : Boolean := false;
+         Meter_in_Use        : Boolean := true;  -- TC: set true for this test
+         --
+         TC_Multiplier       : integer := 1;
+         TC_Passage_Total    : integer := 0;
+         -- Use this to cycle through the required exceptions
+         TC_Current_Exception : integer range 0..3 := 0;
+
+      end Ramp_31;  
+      --================================================================
+      protected body Ramp_31 is
+               
+   
+         -- Trace the paths through the various routines by totaling the
+         -- weighted call parameters
+         procedure TC_Passage (Pass_Point : Integer) is
+         begin
+            TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
+         end TC_Passage;
+   
+         -- For the final check of the whole test
+         function TC_Get_Passage_Total return integer is
+         begin
+            return TC_Passage_Total;
+         end TC_Get_Passage_Total;
+
+         function TC_Get_Current_Exception return integer is
+         begin 
+            return TC_Current_Exception;
+         end TC_Get_Current_Exception;
+
+   
+         -----------------
+
+         function Meter_in_Use_State return Boolean is
+         begin
+            return Meter_in_Use;
+         end Meter_in_Use_State;
+       
+         -- Simulate the effects of the regular signal pulse 
+         procedure Pulse is
+         begin
+            Release_one_Vehicle := true;
+         end Pulse;
+
+         -- Keep count of vehicles currently on meter queue - we can't use
+         -- the 'count because we need the outcall trigger
+         procedure Add_Meter_Queue is
+         begin
+            null;    --::: stub
+         end Add_Meter_Queue;  
+
+         -- TC: This routine has been modified to raise the required 
+         --     exceptions
+         procedure Subtract_Meter_Queue is
+            TC_Pass_Point1 : constant integer := 10;
+            TC_Pass_Point2 : constant integer := 20;
+            TC_Pass_Point3 : constant integer := 30;
+            TC_Pass_Point9 : constant integer := 1000;  -- error
+         begin
+            -- Cycle through the required exceptions, one per call
+            TC_Current_Exception := TC_Current_Exception + 1;
+            case TC_Current_Exception is
+               when 1 => 
+                     TC_Passage (TC_Pass_Point1);  -- note passage through here
+                     raise Storage_Error;    -- PREDEFINED EXCEPTION
+               when 2 => 
+                     TC_Passage (TC_Pass_Point2);  -- note passage through here
+                     raise TC_Defined_Error;    -- USER DEFINED EXCEPTION
+               when 3 => 
+                     TC_Passage (TC_Pass_Point3);  -- note passage through here
+                     -- RUN TIME EXCEPTION (Constraint_Error)
+                     -- Add the value 3 to 5 then try to assign it to an object
+                     -- whose range is 0..3  - this causes the exception.
+                     -- Disguise the values which cause the Constraint_Error
+                     -- so that the optimizer will not eliminate this code
+                     --    Note: the variable is checked at the end to ensure
+                     --    that the actual assignment is attempted.  Also note
+                     --    the value remains at 3 as the assignment does not
+                     --    take place.  This is the value that is checked at
+                     --    the end of the test.
+                     -- Otherwise the optimizer could decide that the result 
+                     -- of the assignment was not used so why bother to do it?
+                     TC_Current_Exception := 
+                               Report.Ident_Int (TC_Current_Exception) + 
+                               Report.Ident_Int (TC_Int);
+               when others =>
+                     -- Set flag for Report.Failed which cannot be called from
+                     -- within a Protected Object 
+                     TC_Failed_1 := True;
+            end case;
+
+            TC_Passage ( TC_Pass_Point9 );  -- note passage through here
+         end Subtract_Meter_Queue;  
+   
+         -- Here each Vehicle task queues itself awaiting release
+         entry Wait_at_Meter when Release_One_Vehicle is
+         -- Example of entry with barriers and persistent signal
+            TC_Pass_Point : constant integer := 2;
+         begin
+            TC_Passage ( TC_Pass_Point );   -- note passage through here
+            Release_One_Vehicle := false;   -- Consume the signal
+            -- Decrement number of vehicles on ramp 
+            Subtract_Meter_Queue;  -- Call procedure from within entry body
+         end Wait_at_Meter;      
+   
+      end Ramp_31;  
+      --================================================================
+        
+      -- Carrier task. One is created for each vehicle arriving at Ramp_31
+      task body Vehicle_31 is
+         TC_Pass_Point_1 : constant integer := 100;
+         TC_Pass_Point_2 : constant integer := 200;
+         TC_Pass_Point_3 : constant integer := 300;
+      begin
+         if Ramp_31.Meter_in_Use_State then  
+            -- Increment count of number of vehicles on ramp 
+            Ramp_31.Add_Meter_Queue;    -- Call a protected procedure
+                                          -- which is also called from within
+            -- enter the meter queue
+            Ramp_31.Wait_at_Meter;      -- Call a protected entry   
+            Report.Failed ("Exception not propagated back");
+         end if;
+         null;  --:::: call to the first in the series of the Ramp_Sensors
+                --     this "passes" the vehicle from one sensor to the next
+      exception
+         when Storage_Error =>
+               Ramp_31.TC_Passage ( TC_Pass_Point_1 );  -- note passage
+         when TC_Defined_Error =>  
+               Ramp_31.TC_Passage ( TC_Pass_Point_2 );  -- note passage
+         when Constraint_Error =>
+               Ramp_31.TC_Passage ( TC_Pass_Point_3 );  -- note passage
+         when others => 
+               Report.Failed ("Unexpected exception in Vehicle Task");
+      end Vehicle_31;
+
+      -- Simulate the arrival of a vehicle at the Ramp_Receiver of Ramp_31
+      -- and the generation of an accompanying carrier task
+      procedure New_Arrival_31 is
+         Next_Vehicle_Task_31: acc_Vehicle_31 := new Vehicle_31;
+         TC_Pass_Point : constant integer := 1; 
+      begin
+         Ramp_31.TC_Passage ( TC_Pass_Point );  -- Note passage through here
+         null;  --::: stub
+      end New_arrival_31;
+
+
+
+   begin -- declare
+
+      -- Test driver.  This is ALL test control code
+
+      -- Create three independent tasks which will queue themselves on the
+      -- entry.  Each task will get a different exception
+      New_Arrival_31;
+      New_Arrival_31;
+      New_Arrival_31;
+
+      delay ImpDef.Clear_Ready_Queue;
+
+      -- Set the barrier condition of the entry true, releasing one task
+      Ramp_31.Pulse; 
+      delay ImpDef.Clear_Ready_Queue;
+      
+      Ramp_31.Pulse; 
+      delay ImpDef.Clear_Ready_Queue;
+      
+      Ramp_31.Pulse; 
+      delay ImpDef.Clear_Ready_Queue;
+
+      if (TC_Expected_Passage_Total /= Ramp_31.TC_Get_Passage_Total)  or
+         -- Note: We are not really interested in this next check.  It is 
+         --       here to ensure the earlier statements which raised the 
+         --       Constraint_Error are not optimized out
+         (Ramp_31.TC_Get_Current_Exception /= 3) then
+            Report.Failed ("Unexpected paths taken");
+      end if;
+      
+   end; -- declare
+
+   if TC_Failed_1 then 
+      Report.Failed ("Bad path through Subtract_Meter_Queue");
+   end if;
+
+   Report.Result;
+
+end C940010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940011.a
new file mode 100644
index 000000000..65228666c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940011.a
@@ -0,0 +1,175 @@
+-- C940011.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, in the body of a protected object created by the execution
+--      of an allocator, external calls to other protected objects via 
+--      the access type are correctly performed
+--
+-- TEST DESCRIPTION:
+--      Use a subset of the simulation of the freeway on-ramp described in
+--      c940005.  In this case an array of access types is built with pointers
+--      to successive ramps.  The external calls within the protected
+--      objects are made via the index into the array.  Routines which refer
+--      to the "previous" ramp and the "next" ramp are exercised.  (Note: The
+--      first and last ramps are assumed to be dummies and no first/last
+--      condition code is included)
+--      
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+with Report;
+
+
+procedure C940011 is
+
+   type Ramp;     
+   type acc_Ramp is access Ramp;
+
+   subtype Ramp_Index is integer range 1..4;
+   
+
+   -- Weighted load given to each potential problem area and accumulated
+   type Load_Factor is range 0..8;
+   Clear_Level    : constant Load_Factor := 0;
+   Moderate_Level : constant Load_Factor := 3;
+   
+   --================================================================
+   -- Only the Routines that are used in this test are shown
+   --
+   protected type Ramp is
+
+      procedure Set_Index (Index : Ramp_Index);
+      procedure Set_Local_Overload (Sensor_Level : Load_Factor);
+      function Local_Overload        return Load_Factor;
+      procedure Notify;
+      function Next_Ramp_Overload    return Load_Factor;
+
+   private
+
+      This_Ramp : Ramp_Index;
+
+      Next_Ramp_Alert : Boolean  := false;  -- Next Ramp is in trouble?
+
+      -- Current state of the various Sample Points
+      Local_State     : Load_Factor := Clear_Level;
+   
+   end Ramp;
+   --================================================================
+
+   -- Build a set of Ramp objects and an array of pointers to them
+   --
+   Ramp_Array : array (Ramp_Index) of acc_Ramp := (Ramp_Index => new Ramp);
+
+   --================================================================
+   protected body Ramp is
+   
+      procedure Set_Index (Index : Ramp_Index) is
+      begin
+         This_Ramp := Index;            
+      end Set_Index;
+
+      -- These Set/Clear routines are triggered by real-time sensors that
+      -- reflect traffic state
+      procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
+      begin
+         if Local_State = Clear_Level then
+            -- Notify "previous" ramp to check this one for current state.
+            -- Subsequent changes in state will not send an alert
+            -- When the situation clears another routine performs the 
+            -- all_clear notification. (not shown)
+            -- EXTERNAL CALL OF PROCEDURE FROM PROCEDURE
+            Ramp_Array(This_Ramp - 1).Notify;   -- index to previous ramp
+         end if;
+         Local_State := Sensor_Level;
+         null;   --::::: Start local meter if not already started
+      end Set_Local_Overload;
+
+      function Local_Overload return Load_Factor is
+      begin
+         return Local_State;
+      end Local_Overload;
+   
+      -- This is notification from the next ramp that it is in
+      -- overload.  With this provision we only need to sample the next
+      -- ramp during adverse conditions.  
+      procedure Notify is
+      begin
+         Next_Ramp_Alert := true;
+      end Notify;
+
+      function Next_Ramp_Overload return Load_Factor is
+      begin
+         if Next_Ramp_Alert then
+            -- EXTERNAL FUNCTION CALL FROM FUNCTION
+            -- Get next ramp's current state
+            return Ramp_Array(This_Ramp + 1).Local_Overload;
+         else
+            return Clear_Level;  
+         end if;
+      end Next_Ramp_Overload;
+   end Ramp;
+
+   --================================================================
+
+
+begin
+
+
+   Report.Test ("C940011", "Protected Objects created by allocators: " &
+                     "external calls via access types");
+
+   -- Initialize each Ramp 
+   for i in Ramp_Index loop
+      Ramp_Array(i).Set_Index (i);
+   end loop;      
+
+   -- Test driver.  This is ALL test control code
+   
+   -- Simulate calls to the protected functions and procedures
+   -- external calls. (do not call the "dummy" end ramps)
+
+   -- Simple Call
+   if Ramp_Array(2).Next_Ramp_Overload /= Clear_level then
+      Report.Failed ("Primary call incorrect");
+   end if;
+   
+   -- Call which results in an external procedure call via the array
+   -- index from within the protected object
+   Ramp_Array(3).Set_Local_Overload (Moderate_Level);
+   
+   -- Call which results in an external function call via the array
+   -- index from within the protected object
+   if Ramp_Array(2).Next_Ramp_Overload /= Moderate_level then
+      Report.Failed ("Secondary call incorrect");
+   end if;
+      
+   Report.Result;
+
+end C940011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940012.a
new file mode 100644
index 000000000..d4bd2079c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940012.a
@@ -0,0 +1,174 @@
+-- C940012.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 protected object can have discriminants
+--
+-- TEST DESCRIPTION:
+--      Use a subset of the simulation of the freeway on-ramp described in
+--      c940005.  In this case an array of access types is built with pointers
+--      to successive ramps.  Each ramp has its Ramp_Number specified by 
+--      discriminant and this corresponds to the index in the array.  The test
+--      checks that the ramp numbers are assigned as expected then uses calls
+--      to  procedures within the objects (ramps) to verify external calls to
+--      ensure the structures are valid.  The external references within the
+--      protected objects are made via the index into the array.  Routines
+--      which refer to the "previous" ramp and the "next" ramp are exercised. 
+--      (Note: The first and last ramps are assumed to be dummies and no
+--      first/last condition code is included)
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+with Report;
+
+
+procedure C940012 is
+
+   type Ramp_Index is range 1..4;
+
+   type Ramp;
+   type a_Ramp is access Ramp;
+
+   Ramp_Array : array (Ramp_Index) of a_Ramp;
+
+   -- Weighted load given to each potential problem area and accumulated
+   type Load_Factor is range 0..8;
+   Clear_Level    : constant Load_Factor := 0;
+   Moderate_Level : constant Load_Factor := 3;
+   
+   --================================================================
+   -- Only the Routines that are used in this test are shown
+   --
+   protected type Ramp (Ramp_In : Ramp_Index) is
+
+      function Ramp_Number           return Ramp_Index;
+      function Local_Overload        return Load_Factor;
+      function Next_Ramp_Overload    return Load_Factor;
+      procedure Set_Local_Overload(Sensor_Level : Load_Factor);
+      procedure Notify;
+
+   private
+
+      Next_Ramp_Alert : Boolean  := false;  -- Next Ramp is in trouble?
+
+      -- Current state of the various Sample Points
+      Local_State     : Load_Factor := Clear_Level;
+   
+   end Ramp;
+   --================================================================
+   protected body Ramp is
+   
+      function Ramp_Number return Ramp_Index is
+      begin
+         return Ramp_In;
+      end Ramp_Number;
+
+      -- These Set/Clear routines are triggered by real-time sensors that
+      -- reflect traffic state
+      procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
+      begin
+         if Local_State = Clear_Level then
+            -- Notify "previous" ramp to check this one for current state.
+            -- Subsequent changes in state will not send an alert
+            -- When the situation clears another routine performs the 
+            -- all_clear notification. (not shown)
+            Ramp_Array(Ramp_In - 1).Notify;   -- index to previous ramp
+         end if;
+         Local_State := Sensor_Level;
+         null;   --::::: Start local meter if not already started
+      end;
+
+      function Local_Overload return Load_Factor is
+      begin
+         return Local_State;
+      end Local_Overload;
+   
+      -- This is notification from the next ramp that it is in
+      -- overload.  With this provision we only need to sample the next
+      -- ramp during adverse conditions.  
+      procedure Notify is
+      begin
+         Next_Ramp_Alert := true;
+      end Notify;
+
+      function Next_Ramp_Overload return Load_Factor is
+      begin
+         if Next_Ramp_Alert then
+            -- Get next ramp's current state
+            return Ramp_Array(Ramp_In + 1).Local_Overload;
+         else
+            return Clear_Level;  
+         end if;
+      end Next_Ramp_Overload;
+   end Ramp;
+   --================================================================
+   
+begin
+
+
+   Report.Test ("C940012", "Check that a protected object " &
+                        "can have discriminants");
+
+   -- Build the ramps and populate the ramp array
+   for i in Ramp_Index loop
+      Ramp_Array(i) := new Ramp (i);
+   end loop;      
+
+   -- Test driver.  This is ALL test control code
+
+   -- Check the assignment of the index
+   for i in Ramp_Index loop
+      if Ramp_Array(i).Ramp_Number /= i then
+         Report.Failed ("Ramp_Number assignment incorrect");
+      end if;
+   end loop;      
+
+   -- Simulate calls to the protected functions and procedures
+   -- external calls. (do not call the "dummy" end ramps)
+
+   -- Simple Call
+   if Ramp_Array(2).Next_Ramp_Overload /= Clear_level then
+      Report.Failed ("Primary call incorrect");
+   end if;
+   
+   -- Call which results in an external procedure call via the array
+   -- index from within the protected object
+   Ramp_Array(3).Set_Local_Overload (Moderate_Level);
+      
+   -- Call which results in an external function call via the array
+   -- index from within the protected object
+   if Ramp_Array(2).Next_Ramp_Overload /= Moderate_level then
+      Report.Failed ("Secondary call incorrect");
+   end if;
+      
+      
+   Report.Result;
+
+end C940012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940013.a
new file mode 100644
index 000000000..58d34bc96
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940013.a
@@ -0,0 +1,379 @@
+-- C940013.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 items queued on a protected entry are handled FIFO and that
+--      the  'count attribute of that entry reflects the length of the queue.
+-- 
+-- TEST DESCRIPTION:
+--      Use a small subset of the freeway ramp simulation shown in other
+--      tests.  With the timing pulse off (which prevents items from being
+--      removed from the queue) queue up a small number of calls.  Start the
+--      timing pulse and, at the first execution of the entry code, check the
+--      'count attribute. Empty the queue.   Pass the items being removed from
+--      the queue to the Ramp_Sensor_01 task; there check that the items are
+--      arriving in FIFO order.  Check the final 'count value  
+--      
+--      Send another batch of items at a rate which will, if the delay timing
+--      of the implementation is reasonable, cause the queue length to
+--      fluctuate in both directions.   Again check that all items arrive
+--      FIFO.  At the end check that the 'count returned to zero reflecting
+--      the empty queue.  
+--      
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with ImpDef;
+with Ada.Calendar;
+                
+procedure C940013 is
+
+   TC_Failed_1 : Boolean := false;
+
+begin
+
+   Report.Test ("C940013", "Check that queues on protected entries are " &
+                           "handled FIFO and that 'count is correct");
+
+   declare  -- encapsulate the test
+
+      function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                            return Ada.Calendar.Time renames Ada.Calendar."+";
+
+      -- Weighted load given to each potential problem area and accumulated
+      type Load_Factor is range 0..8;
+      Clear_Level    : constant Load_Factor := 0;
+      Minimum_Level  : constant Load_Factor := 1;
+      Moderate_Level : constant Load_Factor := 2;
+      Serious_Level  : constant Load_Factor := 4;
+      Critical_Level : constant Load_Factor := 6;
+
+      TC_Expected_Passage_Total : constant integer := 624;
+
+      -- For this test give each vehicle an integer ID incremented
+      -- by one for each successive vehicle.  In reality this would be
+      -- a more complex alpha-numeric ID assigned at pickup time.
+      type Vehicle_ID is range 1..5000;
+      Next_ID : Vehicle_ID := Vehicle_ID'first;  
+
+      -- In reality this would be about 5 seconds. The default value of 
+      -- this constant in the implementation defined package is similar
+      -- but could, of course be considerably different - it would not 
+      -- affect the test 
+      -- 
+      Pulse_Time_Delta : duration := ImpDef.Clear_Ready_Queue;
+
+
+      task Pulse_Task;       -- task to generate a pulse for each ramp
+
+      -- Carrier task. One is created for each vehicle arriving at the ramp
+      task type Vehicle is
+         entry Get_ID (Input_ID : in Vehicle_ID);
+      end Vehicle;      
+      type acc_Vehicle is access Vehicle;
+
+      task Ramp_Sensor_01 is
+         entry  Accept_Vehicle (Input_ID : in Vehicle_ID);
+         entry  TC_First_Three_Handled;
+         entry  TC_All_Done;
+      end Ramp_Sensor_01;
+
+      protected Pulse_State is 
+         procedure Start_Pulse;
+         procedure Stop_Pulse;
+         function Pulsing return Boolean;
+      private
+         State : Boolean := false;   -- start test will pulse off
+      end Pulse_State;
+
+      protected body Pulse_State is 
+
+         procedure Start_Pulse is
+         begin
+            State := true;
+         end Start_Pulse;
+
+         procedure Stop_Pulse is
+         begin 
+            State := false;
+         end Stop_Pulse;
+
+         function Pulsing return Boolean is
+         begin 
+            return State;
+         end Pulsing;
+     
+      end Pulse_State;
+
+      --================================================================
+      protected Test_Ramp is 
+      
+         function Meter_in_use_State    return Boolean; 
+         procedure Time_Pulse_Received;
+         entry Wait_at_Meter;
+         procedure TC_Passage (Pass_Point : Integer);
+         function TC_Get_Passage_Total return integer;
+         function TC_Get_Count return integer;
+   
+      private
+
+         Release_One_Vehicle : Boolean := false;
+         -- For this test have Meter_in_Use already set
+         Meter_in_Use        : Boolean := true;
+
+         TC_Wait_at_Meter_First : Boolean := true;
+         TC_Entry_Queue_Count   : integer := 0; -- 'count of Wait_at_Meter
+         TC_Passage_Total       : integer := 0;
+         TC_Pass_Point_WAM      : integer := 23;
+
+      end Test_Ramp;  
+      --================================================================
+      protected body Test_Ramp is
+   
+         -- External call for Meter_in_Use
+         function Meter_in_Use_State return Boolean is
+         begin
+            return Meter_in_Use;
+         end Meter_in_Use_State;
+   
+         -- Trace the paths through the various routines by totalling the
+         -- weighted call parameters
+         procedure TC_Passage (Pass_Point : Integer) is
+         begin
+            TC_Passage_Total := TC_Passage_Total + Pass_Point;
+         end TC_Passage;
+   
+         -- For the final check of the whole test
+         function TC_Get_Passage_Total return integer is
+         begin
+            return TC_Passage_Total;
+         end TC_Get_Passage_Total;
+   
+         function TC_Get_Count return integer is
+         begin
+            return TC_Entry_Queue_Count;
+         end TC_Get_Count;
+   
+
+         -- Here each Vehicle task queues itself awaiting release
+         --
+         entry Wait_at_Meter when Release_One_Vehicle is
+         -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
+         begin
+            --
+            TC_Passage ( TC_Pass_Point_WAM );   -- note passage
+            -- For this test three vehicles are queued before the first
+            -- is released.  If the queueing mechanism is working correctly
+            -- the first time we pass through here the entry'count should
+            -- reflect this
+            if TC_Wait_at_Meter_First then
+               if Wait_at_Meter'count /= 2 then
+                  TC_Failed_1 := true;
+               end if;
+               TC_Wait_at_Meter_First := false;
+            end if;
+            TC_Entry_Queue_Count := Wait_at_Meter'count;  -- note for later
+               
+            Release_One_Vehicle := false;   -- Consume the signal
+            null; -- stub ::: Decrement count of number of vehicles on ramp 
+         end Wait_at_Meter;      
+
+   
+         procedure Time_Pulse_Received is
+            Load : Load_factor := Minimum_Level;   -- for this version of the 
+            Freeway_Breakdown : Boolean := false;  -- test, freeway is Minimum
+         begin
+            -- if broken down, no vehicles are released
+            if not Freeway_Breakdown then 
+               if Load < Moderate_Level then
+                  Release_One_Vehicle := true;
+               end if;
+               null;    -- stub  ::: If other levels, release every other
+                        --           pulse, every third pulse  etc.
+            end if;
+         end Time_Pulse_Received;
+       
+      end Test_Ramp;  
+      --================================================================
+
+      -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
+      -- generation of an accompanying carrier task
+      procedure New_Arrival is
+         Next_Vehicle_Task: acc_Vehicle := new Vehicle;
+         TC_Pass_Point : constant integer := 3; 
+      begin
+         Next_ID := Next_ID + 1;
+         Next_Vehicle_Task.Get_ID(Next_ID);
+         Test_Ramp.TC_Passage ( TC_Pass_Point );  -- Note passage through here
+         null;
+      end New_arrival;
+
+
+      -- Carrier task. One is created for each vehicle arriving at the ramp
+      task body Vehicle is
+         This_ID : Vehicle_ID;
+         TC_Pass_Point_2 : constant integer := 21;
+      begin
+         accept Get_ID (Input_ID : in Vehicle_ID) do 
+            This_ID := Input_ID;
+         end Get_ID;
+
+         if Test_Ramp.Meter_in_Use_State then  
+            Test_Ramp.TC_Passage ( TC_Pass_Point_2 );  -- note passage
+            null;  -- stub::: Increment count of number of vehicles on ramp 
+            Test_Ramp.Wait_at_Meter;      -- Queue on the meter entry
+         end if;
+
+         -- Call to the first in the series of the Ramp_Sensors
+         --     this "passes" the vehicle from one sensor to the next
+         --     Each sensor will requeue the call to the next thus this
+         --     rendezvous will only be completed as the vehicle is released
+         --     by the last sensor on the ramp.
+         Ramp_Sensor_01.Accept_Vehicle (This_ID);
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Vehicle Task");
+      end Vehicle;
+
+      task body Ramp_Sensor_01 is
+         TC_Pass_Point : constant integer := 31; 
+         This_ID    : Vehicle_ID;
+         TC_Last_ID : Vehicle_ID := Vehicle_ID'first;
+      begin
+         loop
+            select
+               accept Accept_Vehicle (Input_ID : in Vehicle_ID) do 
+                  null;   -- stub:::: match up with next Real-Time notification
+                          -- from the sensor.  Requeue to next ramp sensor
+                  This_ID := Input_ID;
+                  
+                  -- The following is all Test_Control code
+                  Test_Ramp.TC_Passage ( TC_Pass_Point );  -- note passage
+                  -- The items arrive in the order they are taken from
+                  -- the Wait_at_Meter entry queue
+                  if ( This_ID - TC_Last_ID ) /= 1 then
+                     -- The tasks are being queued (or unqueued) in the
+                     -- wrong order
+                     Report.Failed
+                              ("Queueing on the Wait_at_Meter queue failed");
+                  end if;
+                  TC_Last_ID := This_ID;    -- for the next check
+                  if TC_Last_ID = 4 then
+                     -- rendezvous with the test driver
+                     accept TC_First_Three_Handled;
+                  elsif TC_Last_ID = 9 then
+                     -- rendezvous with the test driver
+                     accept TC_All_Done;
+                  end if;
+               end Accept_Vehicle;
+            or
+               terminate;
+            end select;
+         end loop;
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Ramp_Sensor_01");
+      end Ramp_Sensor_01;
+
+
+      -- Task transmits a synchronizing "pulse" to all ramps
+      --
+      task body Pulse_Task is
+         Pulse_Time : Ada.Calendar.Time;
+      begin
+         While not Pulse_State.Pulsing loop
+            -- Starts up in the quiescent state
+            delay ImpDef.Minimum_Task_Switch; 
+         end loop;
+         Pulse_Time := Ada.Calendar.Clock;
+         While Pulse_State.Pulsing loop
+            delay until Pulse_Time;  
+            Test_Ramp. Time_Pulse_Received;   -- Transmit pulse to test_ramp
+            -- ::::::::::  and to all the other ramps
+            Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next
+         end loop;
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Pulse_Task");
+      end Pulse_Task;
+
+
+   begin -- declare
+
+      -- Test driver.  This is ALL test control code
+
+      -- Arrange to queue three vehicles on the Wait_at_Meter queue.  The 
+      -- timing pulse is quiescent so the queue will build
+      for i in 1..3 loop
+         New_Arrival; 
+      end loop;
+
+      delay Pulse_Time_Delta;  -- ensure all is settled
+
+      Pulse_State.Start_Pulse;     -- Start the timing pulse, the queue will 
+                                   -- be serviced
+      
+      -- wait here until the first three are complete
+      Ramp_Sensor_01.TC_First_Three_Handled;
+
+      if Test_Ramp.TC_Get_Count /= 0 then
+         Report.Failed ("Intermediate Wait_at_Entry'count is incorrect");
+      end if;
+
+      -- generate new arrivals at a rate that will make the queue increase
+      -- and decrease "randomly"
+      for i in 1..5 loop
+         New_Arrival; 
+         delay Pulse_Time_Delta/2;
+      end loop;
+
+      -- wait here till all have been handled
+      Ramp_Sensor_01.TC_All_Done;
+
+      if Test_Ramp.TC_Get_Count /= 0 then
+         Report.Failed ("Final Wait_at_Entry'count is incorrect");
+      end if;
+
+      Pulse_State.Stop_Pulse;       -- finish test
+
+
+      if TC_Expected_Passage_Total /= Test_Ramp.TC_Get_Passage_Total then
+         Report.Failed ("Unexpected paths taken");
+      end if;
+
+
+   end; -- declare
+
+   if TC_Failed_1 then 
+      Report.Failed ("Wait_at_Meter'count incorrect");
+   end if;
+
+   Report.Result;
+
+end C940013;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940014.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940014.a
new file mode 100644
index 000000000..0eb53ea51
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940014.a
@@ -0,0 +1,177 @@
+-- C940014.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that as part of the finalization of a protected object
+--      each call remaining on an entry queue of the objet is removed
+--      from its queue and Program_Error is raised at the place of
+--      the corresponding entry_call_statement.
+--
+-- TEST DESCRIPTION:
+--      The example in 9.4(20a-20f);6.0 demonstrates how to cause a
+--      protected object to finalize while tasks are still waiting
+--      on its entry queues.  The first part of this test mirrors
+--      that example.  The second part of the test expands upon
+--      the example code to add an object with finalization code
+--      to the protected object.  The finalization code should be
+--      executed after Program_Error is raised in the callers left
+--      on the entry queues.
+--
+--
+-- CHANGE HISTORY:
+--      08 Jan 96   SAIC    Initial Release for 2.1
+--      10 Jul 96   SAIC    Incorporated Reviewer comments to fix race 
+--                          condition.
+--
+--!
+
+
+with Ada.Finalization;
+package C940014_0 is
+    Verbose : constant Boolean := False;
+    Finalization_Occurred : Boolean := False;
+
+    type Has_Finalization is new Ada.Finalization.Limited_Controlled with
+          record
+             Placeholder : Integer;
+          end record;
+    procedure Finalize (Object : in out Has_Finalization);
+end C940014_0;
+
+
+with Report;
+with ImpDef;
+package body C940014_0 is
+    procedure Finalize (Object : in out Has_Finalization) is
+    begin
+	delay ImpDef.Clear_Ready_Queue;
+        Finalization_Occurred := True;
+        if Verbose then
+            Report.Comment ("in Finalize");
+        end if;
+    end Finalize;
+end C940014_0;
+
+
+
+with Report;
+with ImpDef;
+with Ada.Finalization;
+with C940014_0;
+
+procedure C940014 is
+   Verbose : constant Boolean := C940014_0.Verbose;
+
+begin
+ 
+   Report.Test ("C940014", "Check that the finalization of a protected" &
+                           " object results in program_error being raised" &
+                           " at the point of the entry call statement for" &
+                           " any tasks remaining on any entry queue");
+
+   First_Check: declare
+       -- example from ARM 9.4(20a-f);6.0 with minor mods
+       task T is
+           entry E;
+       end T;
+       task body T is
+           protected PO is
+               entry Ee;
+           end PO;
+           protected body PO is
+               entry Ee when Report.Ident_Bool (False) is
+               begin
+                   null;
+               end Ee;
+           end PO;
+       begin
+           accept E do
+                requeue PO.Ee;
+           end E;
+           if Verbose then
+                Report.Comment ("task about to terminate");
+           end if;
+       end T;
+   begin  -- First_Check
+       begin
+           T.E;
+           delay ImpDef.Clear_Ready_Queue;
+           Report.Failed ("exception not raised in First_Check");
+       exception
+           when Program_Error =>
+               if Verbose then
+                   Report.Comment ("ARM Example passed");
+               end if;
+           when others =>
+               Report.Failed ("wrong exception in First_Check");
+       end;
+   end First_Check;
+ 
+
+   Second_Check : declare
+      -- here we want to check that the raising of Program_Error
+      -- occurs before the other finalization actions.
+       task T is
+           entry E;
+       end T;
+       task body T is
+           protected PO is
+               entry Ee;
+           private
+               Component : C940014_0.Has_Finalization;
+           end PO;
+           protected body PO is
+               entry Ee when Report.Ident_Bool (False) is
+               begin
+                   null;
+               end Ee;
+           end PO;
+       begin
+           accept E do
+                requeue PO.Ee;
+           end E;
+           if Verbose then
+                Report.Comment ("task about to terminate");
+           end if;
+       end T;
+   begin  -- Second_Check
+       T.E;
+       delay ImpDef.Clear_Ready_Queue;
+       Report.Failed ("exception not raised in Second_Check");
+   exception
+       when Program_Error =>
+           if C940014_0.Finalization_Occurred then
+               Report.Failed ("wrong order for finalization");
+           elsif Verbose then
+               Report.Comment ("Second_Check passed");
+           end if;
+       when others =>
+           Report.Failed ("Wrong exception in Second_Check");
+   end Second_Check;
+
+
+   Report.Result;
+ 
+end C940014;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940015.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940015.a
new file mode 100644
index 000000000..92a6699c3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940015.a
@@ -0,0 +1,149 @@
+-- C940015.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that the component_declarations of a protected_operation
+--      are elaborated in the proper order.
+--
+-- TEST DESCRIPTION:
+--      A discriminated protected object is declared with some
+--      components that depend upon the discriminant and some that
+--      do not depend upon the discriminant.  All the components
+--      are initialized with a function call.  As a side-effect of
+--      the function call the parameter passed to the function is
+--      recorded in an elaboration order array.  
+--      Two objects of the protected type are declared.  The 
+--      elaboration order is recorded and checked against the
+--      expected order.
+--
+--
+-- CHANGE HISTORY:
+--      09 Jan 96   SAIC    Initial Version for 2.1
+--      09 Jul 96   SAIC    Addressed reviewer comments.
+--      13 Feb 97   PWB.CTA Removed doomed attempt to check per-object
+--                          constraint elaborations.
+--!
+
+
+with Report;
+
+procedure C940015 is
+    Verbose : constant Boolean := False;
+    Do_Display : Boolean := Verbose;
+     
+    type Index is range 0..10;
+
+    type List is array (1..10) of Integer;
+    Last : Natural range 0 .. List'Last := 0;
+    E_List : List := (others => 0);
+
+    function Elaborate (Id : Integer) return Index is
+    begin
+        Last := Last + 1;
+        E_List (Last) := Id;
+        if Verbose then
+            Report.Comment ("Elaborating" & Integer'Image (Id));
+        end if;
+        return Index(Id mod 10);
+    end Elaborate;
+
+    function Elaborate (Id, Per_Obj_Expr : Integer) return Index is
+    begin
+        return Elaborate (Id);
+    end Elaborate;
+
+begin
+ 
+    Report.Test ("C940015", "Check that the component_declarations of a" &
+                            " protected object are elaborated in the" &
+                            " proper order");
+    declare
+        -- an unprotected queue type
+        type Storage is array (Index range <>) of Integer;
+        type Queue (Size, Flag : Index := 1) is
+            record
+                Head : Index := 1;
+                Tail : Index := 1;
+                Count : Index := 0;
+                Buffer : Storage (1..Size);
+            end record;
+
+        -- protected group of queues type
+        protected type Prot_Queues (Size : Index := Elaborate (104)) is 
+            procedure Clear;
+            -- other needed procedures not provided at this time
+        private
+               -- elaborate at type elaboration
+            Fixed_Queue_1    : Queue (3,  
+                                      Elaborate (105));
+               -- elaborate at type elaboration
+            Fixed_Queue_2    : Queue (6,    
+                                      Elaborate (107));
+        end Prot_Queues;
+        protected body Prot_Queues is
+            procedure Clear is
+            begin 
+                Fixed_Queue_1.Count := 0;
+                Fixed_Queue_1.Head := 1;
+                Fixed_Queue_1.Tail := 1;
+                Fixed_Queue_2.Count := 0;
+                Fixed_Queue_2.Head := 1;
+                Fixed_Queue_2.Tail := 1;
+            end Clear;
+        end Prot_Queues;
+          
+        PO1 : Prot_Queues(9);
+        PO2 : Prot_Queues;
+
+        Expected_Elab_Order : List := (
+           -- from the elaboration of the protected type Prot_Queues
+           105, 107,
+           -- from the unconstrained object PO2
+           104,
+           others => 0);
+    begin
+        for I in List'Range loop
+            if E_List (I) /= Expected_Elab_Order (I) then
+                Report.Failed ("wrong elaboration order"); 
+                Do_Display := True;
+            end if;
+        end loop;
+        if Do_Display then
+            Report.Comment ("Expected  Actual");
+            for I in List'Range loop
+                Report.Comment (
+                   Integer'Image (Expected_Elab_Order(I)) &
+                   Integer'Image (E_List(I)));
+            end loop;
+        end if;
+
+        -- make use of the protected objects
+        PO1.Clear;
+        PO2.Clear;
+    end;
+
+    Report.Result;
+ 
+end C940015;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940016.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940016.a
new file mode 100644
index 000000000..2226eefb4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940016.a
@@ -0,0 +1,211 @@
+-- C940016.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that an Unchecked_Deallocation of a protected object
+--      performs the required finalization on the protected object.
+--
+-- TEST DESCRIPTION:
+--      Test that finalization takes place when an Unchecked_Deallocation
+--      deallocates a protected object with queued callers. 
+--      Try protected objects that have no other finalization code and
+--      protected objects with user defined finalization.
+--
+--
+-- CHANGE HISTORY:
+--      16 Jan 96   SAIC    ACVC 2.1
+--      10 Jul 96   SAIC    Fixed race condition noted by reviewers.
+--
+--!
+
+
+with Ada.Finalization;
+package C940016_0 is
+    Verbose : constant Boolean := False;
+    Finalization_Occurred : Boolean := False;
+
+    type Has_Finalization is new Ada.Finalization.Limited_Controlled with
+          record
+             Placeholder : Integer;
+          end record;
+    procedure Finalize (Object : in out Has_Finalization);
+end C940016_0;
+
+
+with Report;
+with ImpDef;
+package body C940016_0 is
+    procedure Finalize (Object : in out Has_Finalization) is
+    begin
+	delay ImpDef.Clear_Ready_Queue;
+        Finalization_Occurred := True;
+        if Verbose then
+            Report.Comment ("in Finalize");
+        end if;
+    end Finalize;
+end C940016_0;
+
+
+
+with Report;
+with Ada.Finalization;
+with C940016_0;
+with Ada.Unchecked_Deallocation;
+with ImpDef;
+
+procedure C940016 is
+   Verbose : constant Boolean := C940016_0.Verbose;
+
+begin
+ 
+   Report.Test ("C940016", "Check that Unchecked_Deallocation of a" &
+                           " protected object finalizes the" &
+                           " protected object");
+
+   First_Check: declare
+       protected type Semaphore is
+           entry Wait;
+           procedure Signal;
+       private
+           Count : Integer := 0;
+       end Semaphore;
+       protected body Semaphore is
+           entry Wait when Count > 0 is
+           begin
+               Count := Count - 1;
+           end Wait;
+
+           procedure Signal is
+           begin
+              Count := Count + 1;
+           end Signal;
+       end Semaphore;
+
+       type pSem is access Semaphore;
+       procedure Zap_Semaphore is new 
+           Ada.Unchecked_Deallocation (Semaphore, pSem);
+       Sem_Ptr : pSem := new Semaphore;
+
+       -- positive confirmation that Blocker got the exception
+       Ok : Boolean := False;
+
+       task Blocker;
+
+       task body Blocker is
+       begin
+           Sem_Ptr.Wait;
+           Report.Failed ("Program_Error not raised in waiting task");
+       exception
+           when Program_Error =>
+               Ok := True;
+               if Verbose then
+                   Report.Comment ("Blocker received Program_Error");
+               end if;
+           when others =>
+               Report.Failed ("Wrong exception in Blocker");
+       end Blocker;
+
+   begin  -- First_Check
+       -- wait for Blocker to get blocked on the semaphore
+       delay ImpDef.Clear_Ready_Queue;
+       Zap_Semaphore (Sem_Ptr);
+       -- make sure Blocker has time to complete
+       delay ImpDef.Clear_Ready_Queue * 2;
+       if not Ok then
+           Report.Failed ("finalization not properly performed");
+           -- Blocker is probably hung so kill it
+           abort Blocker;
+       end if;
+   end First_Check;
+ 
+
+   Second_Check : declare
+      -- here we want to check that the raising of Program_Error
+      -- occurs before the other finalization actions.
+       protected type Semaphore is
+           entry Wait;
+           procedure Signal;
+       private
+           Count : Integer := 0;
+           Component : C940016_0.Has_Finalization;
+       end Semaphore;
+       protected body Semaphore is
+           entry Wait when Count > 0 is
+           begin
+               Count := Count - 1;
+           end Wait;
+
+           procedure Signal is
+           begin
+              Count := Count + 1;
+           end Signal;
+       end Semaphore;
+
+       type pSem is access Semaphore;
+       procedure Zap_Semaphore is new 
+           Ada.Unchecked_Deallocation (Semaphore, pSem);
+       Sem_Ptr : pSem := new Semaphore;
+
+       -- positive confirmation that Blocker got the exception
+       Ok : Boolean := False;
+
+       task Blocker;
+
+       task body Blocker is
+       begin
+           Sem_Ptr.Wait;
+           Report.Failed ("Program_Error not raised in waiting task 2");
+       exception
+           when Program_Error =>
+               Ok := True;
+               if C940016_0.Finalization_Occurred then
+                   Report.Failed ("wrong order for finalization 2");
+               elsif Verbose then
+                   Report.Comment ("Blocker received Program_Error 2");
+               end if;
+           when others =>
+               Report.Failed ("Wrong exception in Blocker 2");
+       end Blocker;
+
+   begin  -- Second_Check
+       -- wait for Blocker to get blocked on the semaphore
+       delay ImpDef.Clear_Ready_Queue;
+       Zap_Semaphore (Sem_Ptr);
+       -- make sure Blocker has time to complete
+       delay ImpDef.Clear_Ready_Queue * 2;
+       if not Ok then
+           Report.Failed ("finalization not properly performed 2");
+           -- Blocker is probably hung so kill it
+           abort Blocker;
+       end if;
+       if not C940016_0.Finalization_Occurred then
+           Report.Failed ("user defined finalization didn't happen");
+       end if;
+   end Second_Check;
+ 
+
+   Report.Result;
+ 
+end C940016;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001a.ada
new file mode 100644
index 000000000..e23a3b86d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001a.ada
@@ -0,0 +1,259 @@
+-- C94001A.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 UNIT WITH DEPENDENT TASKS CREATED BY OBJECT
+--   DECLARATIONS IS NOT TERMINATED UNTIL ALL DEPENDENT TASKS BECOME
+--   TERMINATED.
+-- SUBTESTS ARE:
+--   (A, B)  A SIMPLE TASK OBJECT, IN A BLOCK.
+--   (C, D)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
+--   (E, F)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
+
+-- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
+
+-- JRK 10/2/81
+-- SPS 11/21/82
+-- JRK 11/29/82
+-- TBN  8/22/86     REVISED; ADDED CASES THAT EXIT BY RAISING AN
+--                  EXCEPTION.
+-- PWN 01/31/95     REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94001A IS
+
+     MY_EXCEPTION : EXCEPTION;
+     GLOBAL : INTEGER;
+
+     TASK TYPE TT IS
+          ENTRY E (I : INTEGER);
+     END TT;
+
+     TASK BODY TT IS
+          LOCAL : INTEGER;
+     BEGIN
+          ACCEPT E (I : INTEGER) DO
+               LOCAL := I;
+          END E;
+          DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
+                         -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
+                         -- TERMINATE IF THE ERROR IS PRESENT.
+          GLOBAL := LOCAL;
+     END TT;
+
+
+BEGIN
+     TEST ("C94001A", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
+                      "CREATED BY OBJECT DECLARATIONS IS NOT " &
+                      "TERMINATED UNTIL ALL DEPENDENT TASKS " &
+                      "BECOME TERMINATED");
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (A)
+
+          T : TT;
+
+     BEGIN -- (A)
+
+          T.E (IDENT_INT(1));
+
+     END; -- (A)
+
+     IF GLOBAL /= 1 THEN
+          FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                  "BLOCK EXIT - 1");
+     END IF;
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     BEGIN -- (B)
+          DECLARE
+               T : TT;
+          BEGIN
+               T.E (IDENT_INT(1));
+               RAISE MY_EXCEPTION;
+          END;
+
+          FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL /= 1 THEN
+                    FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                            "BLOCK EXIT - 2");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION - 2");
+     END; -- (B)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C)
+
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+               A : ARRAY (1..1) OF TT;
+          BEGIN
+               A(1).E (IDENT_INT(2));
+               RETURN 0;
+          END F;
+
+     BEGIN -- (C)
+
+          I := F;
+
+          IF GLOBAL /= 2 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "FUNCTION EXIT - 3");
+          END IF;
+
+     END; -- (C)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (D)
+
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+               A : ARRAY (1..1) OF TT;
+          BEGIN
+               A(1).E (IDENT_INT(2));
+               IF EQUAL (3, 3) THEN
+                    RAISE MY_EXCEPTION;
+               END IF;
+               RETURN 0;
+          END F;
+
+     BEGIN -- (D)
+          I := F;
+          FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL /= 2 THEN
+                    FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                            "FUNCTION EXIT - 4");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION - 4");
+     END; -- (D)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (E)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+               TYPE RT IS
+                    RECORD
+                         T : TT;
+                    END RECORD;
+               AR : ARRAY (1..1) OF RT;
+          BEGIN
+               AR(1).T.E (IDENT_INT(3));
+          END TSK;
+
+     BEGIN -- (E)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 1.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
+                       "HOUR - 5");
+          ELSIF GLOBAL /= 3 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "TASK EXIT - 5");
+          END IF;
+
+     END; -- (E)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (F)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+               TYPE RT IS
+                    RECORD
+                         T : TT;
+                    END RECORD;
+               AR : ARRAY (1..1) OF RT;
+          BEGIN
+               AR(1).T.E (IDENT_INT(3));
+               IF EQUAL (3, 3) THEN
+                    RAISE MY_EXCEPTION;
+               END IF;
+               FAILED ("EXCEPTION WAS NOT RAISED - 6");
+          END TSK;
+
+     BEGIN -- (F)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 1.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
+                       "HOUR - 6");
+          ELSIF GLOBAL /= 3 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "TASK EXIT - 6");
+          END IF;
+
+     END; -- (F)
+
+     --------------------------------------------------
+
+     RESULT;
+END C94001A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001b.ada
new file mode 100644
index 000000000..e3e2edaa3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001b.ada
@@ -0,0 +1,268 @@
+-- C94001B.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 UNIT WITH DEPENDENT TASKS CREATED BY AN OBJECT
+-- DECLARATION OF LIMITED PRIVATE TYPE IS NOT TERMINATED UNTIL ALL
+-- DEPENDENT TASKS BECOME TERMINATED.
+-- SUBTESTS ARE:
+--   (A, B)  A SIMPLE TASK OBJECT, IN A BLOCK.
+--   (C, D)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
+--   (E, F)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
+
+-- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
+
+-- TBN  8/22/86
+-- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94001B IS
+
+     PACKAGE P IS
+          MY_EXCEPTION : EXCEPTION;
+          GLOBAL : INTEGER;
+          TYPE TT IS LIMITED PRIVATE;
+          PROCEDURE CALL_ENTRY (A : TT; B : INTEGER);
+     PRIVATE
+          TASK TYPE TT IS
+               ENTRY E (I : INTEGER);
+          END TT;
+     END P;
+
+     PACKAGE BODY P IS
+
+          PROCEDURE CALL_ENTRY (A : TT; B : INTEGER) IS
+          BEGIN
+               A.E (B);
+          END CALL_ENTRY;
+
+          TASK BODY TT IS
+               LOCAL : INTEGER;
+          BEGIN
+               ACCEPT E (I : INTEGER) DO
+                    LOCAL := I;
+               END E;
+               DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER
+                              -- PRIORITY AT THIS POINT, IT WILL
+                              -- RECEIVE CONTROL AND TERMINATE IF
+                              -- THE ERROR IS PRESENT.
+               GLOBAL := LOCAL;
+          END TT;
+     END P;
+
+     USE P;
+
+
+BEGIN
+     TEST ("C94001B", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
+                      "CREATED BY AN OBJECT DECLARATION OF LIMITED " &
+                      "PRIVATE TYPE IS NOT TERMINATED UNTIL ALL " &
+                      "DEPENDENT TASKS BECOME TERMINATED");
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (A)
+
+          T : TT;
+
+     BEGIN -- (A)
+
+          CALL_ENTRY (T, IDENT_INT(1));
+
+     END; -- (A)
+
+     IF GLOBAL /= 1 THEN
+          FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                  "BLOCK EXIT - 1");
+     END IF;
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     BEGIN -- (B)
+          DECLARE
+               T : TT;
+          BEGIN
+               CALL_ENTRY (T, IDENT_INT(2));
+               RAISE MY_EXCEPTION;
+          END;
+
+          FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL /= 2 THEN
+                    FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                            "BLOCK EXIT - 2");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION - 2");
+     END; -- (B)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C)
+
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+               A : ARRAY (1..1) OF TT;
+          BEGIN
+               CALL_ENTRY (A(1), IDENT_INT(3));
+               RETURN 0;
+          END F;
+
+     BEGIN -- (C)
+
+          I := F;
+
+          IF GLOBAL /= 3 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "FUNCTION EXIT - 3");
+          END IF;
+
+     END; -- (C)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (D)
+
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+               A : ARRAY (1..1) OF TT;
+          BEGIN
+               CALL_ENTRY (A(1), IDENT_INT(4));
+               IF EQUAL (3, 3) THEN
+                    RAISE MY_EXCEPTION;
+               END IF;
+               RETURN 0;
+          END F;
+
+     BEGIN -- (D)
+          I := F;
+          FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL /= 4 THEN
+                    FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                            "FUNCTION EXIT - 4");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION - 4");
+     END; -- (D)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (E)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+               TYPE RT IS
+                    RECORD
+                         T : TT;
+                    END RECORD;
+               AR : ARRAY (1..1) OF RT;
+          BEGIN
+               CALL_ENTRY (AR(1).T, IDENT_INT(5));
+          END TSK;
+
+     BEGIN -- (E)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 1.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
+                       "HOUR - 5");
+          ELSIF GLOBAL /= 5 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "TASK EXIT - 5");
+          END IF;
+
+     END; -- (E)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (F)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 60 * 60;     -- ONE HOUR DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+               TYPE RT IS
+                    RECORD
+                         T : TT;
+                    END RECORD;
+               AR : ARRAY (1..1) OF RT;
+          BEGIN
+               CALL_ENTRY (AR(1).T, IDENT_INT(6));
+               IF EQUAL (3, 3) THEN
+                    RAISE MY_EXCEPTION;
+               END IF;
+               FAILED ("EXCEPTION WAS NOT RAISED - 6");
+          END TSK;
+
+     BEGIN -- (F)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 1.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN ONE " &
+                       "HOUR - 6");
+          ELSIF GLOBAL /= 6 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "TASK EXIT - 6");
+          END IF;
+
+     END; -- (F)
+
+     RESULT;
+END C94001B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001c.ada
new file mode 100644
index 000000000..1d0625559
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001c.ada
@@ -0,0 +1,267 @@
+-- C94001C.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 UNIT WITH INDIRECT DEPENDENT TASKS CREATED BY OBJECT
+-- DECLARATIONS IS NOT TERMINATED UNTIL ALL INDIRECT DEPENDENT TASKS
+-- BECOME TERMINATED.
+-- SUBTESTS ARE:
+--   (A, B)  A BLOCK CONTAINING A SIMPLE TASK OBJECT, IN A BLOCK.
+--   (C, D)  A FUNCTION CONTAINING AN ARRAY OF TASK OBJECT, IN A
+--           FUNCTION.
+--   (E, F)  A TASK CONTAINING AN ARRAY OF RECORD OF TASK OBJECT,
+--           IN A TASK BODY.
+--   CASES (B, D, F) EXIT BY RAISING AN EXCEPTION.
+
+-- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
+
+-- TBN  8/25/86
+-- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94001C IS
+
+     MY_EXCEPTION : EXCEPTION;
+     GLOBAL : INTEGER;
+
+     TASK TYPE TT IS
+          ENTRY E (I : INTEGER);
+     END TT;
+
+     TASK BODY TT IS
+          LOCAL : INTEGER;
+     BEGIN
+          ACCEPT E (I : INTEGER) DO
+               LOCAL := I;
+          END E;
+          DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
+                         -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
+                         -- TERMINATE IF THE ERROR IS PRESENT.
+          GLOBAL := LOCAL;
+     END TT;
+
+
+BEGIN
+     TEST ("C94001C", "CHECK THAT A UNIT WITH INDIRECT DEPENDENT " &
+                      "TASKS CREATED BY OBJECT DECLARATIONS IS NOT " &
+                      "TERMINATED UNTIL ALL INDIRECT DEPENDENT TASKS " &
+                      "BECOME TERMINATED");
+
+     --------------------------------------------------
+     GLOBAL := IDENT_INT (0);
+
+     BEGIN -- (A)
+
+          DECLARE
+               T : TT;
+          BEGIN
+               T.E (IDENT_INT(1));
+          END;
+
+     END; -- (A)
+
+     IF GLOBAL /= 1 THEN
+          FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                  "BLOCK EXIT - 1");
+     END IF;
+
+     --------------------------------------------------
+
+     BEGIN -- (B)
+          GLOBAL := IDENT_INT (0);
+
+          BEGIN
+               DECLARE
+                    T : TT;
+               BEGIN
+                    T.E (IDENT_INT(2));
+                    RAISE MY_EXCEPTION;
+               END;
+          END;
+
+          FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL /= 2 THEN
+                    FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                            "BLOCK EXIT - 2");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION - 2");
+     END; -- (B)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C)
+
+          OBJ_INT : INTEGER;
+
+          FUNCTION F1 RETURN INTEGER IS
+               I : INTEGER;
+
+               FUNCTION F2 RETURN INTEGER IS
+                    A : ARRAY (1..1) OF TT;
+               BEGIN
+                    A(1).E (IDENT_INT(3));
+                    RETURN 0;
+               END F2;
+          BEGIN
+               I := F2;
+               RETURN (0);
+          END F1;
+
+     BEGIN -- (C)
+          OBJ_INT := F1;
+          IF GLOBAL /= 3 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "FUNCTION EXIT - 3");
+          END IF;
+     END; -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D)
+
+          OBJ_INT : INTEGER;
+
+          FUNCTION F1 RETURN INTEGER IS
+               I : INTEGER;
+
+               FUNCTION F2 RETURN INTEGER IS
+                    A : ARRAY (1..1) OF TT;
+               BEGIN
+                    A(1).E (IDENT_INT(4));
+                    IF EQUAL (3, 3) THEN
+                         RAISE MY_EXCEPTION;
+                    END IF;
+                    RETURN 0;
+               END F2;
+          BEGIN
+               I := F2;
+               RETURN (0);
+          END F1;
+
+     BEGIN -- (D)
+          GLOBAL := IDENT_INT (0);
+          OBJ_INT := F1;
+          FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL /= 4 THEN
+                    FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                            "FUNCTION EXIT - 4");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION - 4");
+     END; -- (D)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (E)
+          DELAY_COUNT : INTEGER := 0;
+          TASK OUT_TSK;
+
+          TASK BODY OUT_TSK IS
+
+               TASK TSK IS
+                    ENTRY ENT;
+               END TSK;
+
+               TASK BODY TSK IS
+                    TYPE RT IS
+                         RECORD
+                              T : TT;
+                         END RECORD;
+                    AR : ARRAY (1..1) OF RT;
+               BEGIN
+                    AR(1).T.E (IDENT_INT(5));
+               END TSK;
+
+          BEGIN
+               NULL;
+          END OUT_TSK;
+
+     BEGIN -- (E)
+          WHILE NOT(OUT_TSK'TERMINATED) AND DELAY_COUNT < 60 LOOP
+               DELAY 1.0 * Impdef.One_Long_Second;
+               DELAY_COUNT := DELAY_COUNT + 1;
+          END LOOP;
+          IF DELAY_COUNT = 60 THEN
+               FAILED ("OUT_TSK HAS NOT TERMINATED - 5");
+          ELSIF GLOBAL /= 5 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "BLOCK EXIT - 5");
+          END IF;
+     END; -- (E)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE
+          DELAY_COUNT : INTEGER := 0;
+
+          TASK OUT_TSK;
+     
+          TASK BODY OUT_TSK IS
+
+               TASK TSK IS
+                    ENTRY ENT;
+               END TSK;
+
+               TASK BODY TSK IS
+                    TYPE RT IS
+                         RECORD
+                              T : TT;
+                         END RECORD;
+                    AR : ARRAY (1..1) OF RT;
+               BEGIN
+                    AR(1).T.E (IDENT_INT(6));
+                    RAISE MY_EXCEPTION;
+               END TSK;
+
+          BEGIN
+               RAISE MY_EXCEPTION;
+          END OUT_TSK;
+
+     BEGIN
+          WHILE NOT(OUT_TSK'TERMINATED) AND DELAY_COUNT < 60 LOOP
+               DELAY 1.0 * Impdef.One_Long_Second;
+               DELAY_COUNT := DELAY_COUNT + 1;
+          END LOOP;
+          IF DELAY_COUNT = 60 THEN
+               FAILED ("OUT_TSK HAS NOT TERMINATED - 6");
+          ELSIF GLOBAL /= 6 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "BLOCK EXIT - 6");
+          END IF;
+     END;
+
+     RESULT;
+END C94001C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001e.ada
new file mode 100644
index 000000000..4ab502cd5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001e.ada
@@ -0,0 +1,81 @@
+-- C94001E.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 TASK IS ALSO COMPLETED IF AN EXCEPTION IS RAISED BY
+-- THE EXECUTION OF ITS SEQUENCE OF STATEMENTS.
+-- THIS MUST HOLD FOR BOTH CASES WHERE A HANDLER IS PRESENT OR NOT.
+--    VERSION WITH EXCEPTION HANDLER.
+
+-- WEI  3/ 4/82
+-- JWC 6/28/85   RENAMED FROM C940AGA-B.ADA
+-- RLB 06/29/01  CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION.
+
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C94001E IS
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+     END PSPY_NUMB;
+
+BEGIN
+
+     TEST ("C94001E", "TASK COMPLETION BY EXCEPTION");
+
+BLOCK:
+     DECLARE
+
+          TASK T1;
+
+          TASK BODY T1 IS
+               TYPE I1 IS RANGE 0 .. 1;
+               OBJ_I1 : I1;
+          BEGIN
+               OBJ_I1 := I1(IDENT_INT(2));  -- CONSTRAINT_ERROR.
+               IF OBJ_I1 /= I1(IDENT_INT(0)) THEN
+                  PSPY_NUMB (1);
+               ELSE
+                  PSPY_NUMB (2);
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+               WHEN OTHERS => FAILED ("OTHER EXCEPTION RAISED");
+          END T1;
+
+     BEGIN
+          NULL;
+     END BLOCK;
+
+     IF SPYNUMB /= 0 THEN
+          FAILED ("TASK T1 NOT COMPLETED AFTER EXCEPTION");
+          COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+     END IF;
+
+     RESULT;
+
+END C94001E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001f.ada
new file mode 100644
index 000000000..82adc32f6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001f.ada
@@ -0,0 +1,80 @@
+-- C94001F.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 TASK IS ALSO COMPLETED IF AN EXCEPTION IS RAISED BY
+-- THE EXECUTION OF ITS SEQUENCE OF STATEMENTS.
+-- THIS MUST HOLD FOR BOTH CASES WHERE A HANDLER IS PRESENT OR NOT.
+--   VERSION WITHOUT EXCEPTION HANDLER.
+
+-- WEI  3/ 4/82
+-- JWC 6/28/85   RENAMED FROM C940AGB-B.ADA
+
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C94001F IS
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+     END PSPY_NUMB;
+
+BEGIN
+
+     TEST ("C94001F", "TASK COMPLETION BY EXCEPTION -- NO HANDLER");
+
+BLOCK:
+     DECLARE
+
+          TASK T1;
+
+          TASK BODY T1 IS
+               TYPE I1 IS RANGE 0 .. 1;
+               OBJ_I1 : I1;
+          BEGIN
+               OBJ_I1 := I1(IDENT_INT(2));  -- CONSTRAINT_ERROR.
+               PSPY_NUMB (1);
+          END T1;
+
+     BEGIN
+          NULL;          -- WAIT FOR TERMINATION.
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("PROPAGATED CONSTRAINT_ERROR OUT OF TASK");
+          WHEN TASKING_ERROR =>
+               FAILED ("RAISED TASKING_ERROR");
+          WHEN OTHERS =>
+               FAILED ("RAISED OTHER EXCEPTION");
+     END BLOCK;
+
+     IF SPYNUMB /= 0 THEN
+          FAILED ("TASK T1 NOT COMPLETED AFTER EXCEPTION IN SEQUENCE " &
+                  "OF STATEMENTS");
+     END IF;
+
+     RESULT;
+
+END C94001F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001g.ada
new file mode 100644
index 000000000..294bb53a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94001g.ada
@@ -0,0 +1,124 @@
+-- C94001G.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 COMPLETED TASK WITH DEPENDENT TASKS TERMINATES WHEN
+-- A L L  DEPENDENT TASKS HAVE TERMINATED.
+
+-- WEI  3/ 4/82
+-- JBG 4/2/84
+-- JWC 6/28/85   RENAMED FROM C940AIA-B.ADA
+
+with Impdef;
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C94001G IS
+
+     PACKAGE SPY IS      -- PROVIDE PROTECTED ACCESS TO SPYNUMB
+          SUBTYPE ARG IS NATURAL RANGE 0..9;
+          FUNCTION SPYNUMB RETURN NATURAL;                      -- READ
+          FUNCTION FINIT_POS (DIGT : IN ARG) RETURN NATURAL;    -- WRITE
+          PROCEDURE PSPY_NUMB (DIGT : IN ARG);                  -- WRITE
+     END SPY;
+
+     USE SPY;
+
+     PACKAGE BODY SPY IS
+
+          TASK GUARD IS
+               ENTRY READ  (NUMB : OUT NATURAL);
+               ENTRY WRITE (NUMB : IN NATURAL);
+          END GUARD;
+
+          TASK BODY GUARD IS
+               SPYNUMB : NATURAL := 0;
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT READ (NUMB : OUT NATURAL) DO
+                              NUMB := SPYNUMB;
+                         END READ;
+                    OR   ACCEPT WRITE (NUMB : IN NATURAL) DO
+                              SPYNUMB := 10*SPYNUMB+NUMB;
+                         END WRITE;
+                    OR   TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END GUARD;
+
+          FUNCTION SPYNUMB RETURN NATURAL IS
+               TEMP : NATURAL;
+          BEGIN
+               GUARD.READ (TEMP);
+               RETURN TEMP;
+          END SPYNUMB;
+
+          FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
+          BEGIN
+               GUARD.WRITE (DIGT);
+               RETURN DIGT;
+          END FINIT_POS;
+
+          PROCEDURE PSPY_NUMB (DIGT : IN ARG) IS
+          BEGIN
+               GUARD.WRITE (DIGT);
+          END PSPY_NUMB;
+     END SPY;
+
+BEGIN
+     TEST ("C94001G", "TERMINATION WHEN ALL DEPENDENT TASKS " &
+                      "HAVE TERMINATED");
+
+BLOCK:
+     DECLARE
+
+          TASK TYPE TT1;
+
+          TASK BODY TT1 IS
+          BEGIN
+               DELAY 1.0 * Impdef.One_Second;
+               PSPY_NUMB (1);
+          END TT1;
+
+          TASK T1 IS
+          END T1;
+
+          TASK BODY T1 IS
+               OBJ_TT1_1, OBJ_TT1_2, OBJ_TT1_3 : TT1;
+          BEGIN
+               NULL;
+          END T1;
+
+     BEGIN
+          NULL;
+     END BLOCK;               -- WAIT HERE FOR TERMINATION.
+
+     IF SPYNUMB /= 111 THEN
+          FAILED ("TASK T1 TERMINATED BEFORE " &
+                  "ALL DEPENDENT TASKS HAVE TERMINATED");
+          COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+     END IF;
+
+     RESULT;
+
+END C94001G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002a.ada
new file mode 100644
index 000000000..6db8f962b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002a.ada
@@ -0,0 +1,331 @@
+-- C94002A.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 UNIT WITH DEPENDENT TASKS CREATED BY (LOCAL)
+--   ALLOCATORS DOES NOT TERMINATE UNTIL ALL DEPENDENT TASKS ARE
+--   TERMINATED.
+-- SUBTESTS ARE:
+--   (A, B)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+--   (C, D)  A RECORD OF TASK ALLOCATOR, IN A FUNCTION.
+--   (E, F)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
+
+-- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
+
+-- JRK 10/2/81
+-- SPS 11/2/82
+-- SPS 11/21/82
+-- JRK 11/29/82
+-- TBN  8/25/86     REDUCED DELAYS; ADDED LIMITED PRIVATE TYPES; 
+--                  INCLUDED EXITS BY RAISING AN EXCEPTION.
+-- PWN 01/31/95     REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94002A IS
+
+     PACKAGE P IS
+          MY_EXCEPTION : EXCEPTION;
+          GLOBAL : INTEGER;
+          TASK TYPE T1 IS
+               ENTRY E (I : INTEGER);
+          END T1;
+          TYPE T2 IS LIMITED PRIVATE;
+          PROCEDURE CALL_ENTRY (A : T2; B : INTEGER);
+     PRIVATE
+          TASK TYPE T2 IS
+               ENTRY E (I : INTEGER);
+          END T2;
+     END P;
+
+     PACKAGE BODY P IS
+          TASK BODY T1 IS
+               LOCAL : INTEGER;
+          BEGIN
+               ACCEPT E (I : INTEGER) DO
+                    LOCAL := I;
+               END E;
+               DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER
+                              -- PRIORITY AT THIS POINT, IT WILL
+                              -- RECEIVE CONTROL AND TERMINATE IF
+                              -- THE ERROR IS PRESENT.
+               GLOBAL := LOCAL;
+          END T1;
+
+          TASK BODY T2 IS
+               LOCAL : INTEGER;
+          BEGIN
+               ACCEPT E (I : INTEGER) DO
+                    LOCAL := I;
+               END E;
+               DELAY 30.0 * Impdef.One_Second;
+               GLOBAL := LOCAL;
+          END T2;
+
+          PROCEDURE CALL_ENTRY (A : T2; B : INTEGER) IS
+          BEGIN
+               A.E (B);
+          END CALL_ENTRY;
+     END P;
+
+     USE P;
+
+
+BEGIN
+     TEST ("C94002A", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
+                      "CREATED BY (LOCAL) ALLOCATORS DOES NOT " &
+                      "TERMINATE UNTIL ALL DEPENDENT TASKS " &
+                      "ARE TERMINATED");
+
+     --------------------------------------------------
+     GLOBAL := IDENT_INT (0);
+     BEGIN -- (A)
+          DECLARE
+               TYPE A_T IS ACCESS T1;
+               A : A_T;
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    A := NEW T1;
+                    A.ALL.E (IDENT_INT(1));
+                    RAISE MY_EXCEPTION;
+               END IF;
+          END;
+
+          FAILED ("MY_EXCEPTION WAS NOT RAISED - 1");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL /= 1 THEN
+                    FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                            "BLOCK EXIT - 1");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+     END; -- (A)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (B)
+          TYPE A_T IS ACCESS T2;
+          A : A_T;
+     BEGIN -- (B)
+          IF EQUAL (3, 3) THEN
+               A := NEW T2;
+               CALL_ENTRY (A.ALL, IDENT_INT(2));
+          END IF;
+     END; -- (B)
+
+     IF GLOBAL /= 2 THEN
+          FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                  "BLOCK EXIT - 2");
+     END IF;
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C)
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+               TYPE RT;
+               TYPE ART IS ACCESS RT;
+               TYPE RT IS
+                    RECORD
+                         A : ART;
+                         T : T1;
+                    END RECORD;
+               LIST : ART;
+               TEMP : ART;
+          BEGIN
+               FOR I IN 1 .. IDENT_INT (1) LOOP
+                    TEMP := NEW RT;
+                    TEMP.A := LIST;
+                    LIST := TEMP;
+                    LIST.T.E (IDENT_INT(3));
+               END LOOP;
+               RETURN 0;
+          END F;
+     BEGIN -- (C)
+          I := F;
+
+          IF GLOBAL /= 3 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "FUNCTION EXIT - 3");
+          END IF;
+     END; -- (C)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (D)
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+               TYPE RT;
+               TYPE ART IS ACCESS RT;
+               TYPE RT IS
+                    RECORD
+                         A : ART;
+                         T : T2;
+                    END RECORD;
+               LIST : ART;
+               TEMP : ART;
+          BEGIN
+               FOR I IN 1 .. IDENT_INT (1) LOOP
+                    TEMP := NEW RT;
+                    TEMP.A := LIST;
+                    LIST := TEMP;
+                    CALL_ENTRY (LIST.T, IDENT_INT(4));
+                    IF EQUAL (3, 3) THEN
+                         RAISE MY_EXCEPTION;
+                    END IF;
+               END LOOP;
+               RETURN 0;
+          END F;
+     BEGIN -- (D)
+          I := F;
+
+          FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL /= 4 THEN
+                    FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                            "FUNCTION EXIT - 4");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+     END; -- (D)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (E)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 5 * 60;     -- FIVE MINUTE DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+               TYPE ARR IS ARRAY (1..1) OF T1;
+               TYPE RAT;
+               TYPE ARAT IS ACCESS RAT;
+               TYPE RAT IS
+                    RECORD
+                         A : ARAT;
+                         T : ARR;
+                    END RECORD;
+               LIST : ARAT;
+               TEMP : ARAT;
+          BEGIN
+               FOR I IN 1 .. IDENT_INT (1) LOOP
+                    TEMP := NEW RAT;
+                    TEMP.A := LIST;
+                    LIST := TEMP;
+                    LIST.T(1).E (IDENT_INT(5));
+                    IF EQUAL (3, 3) THEN
+                         RAISE MY_EXCEPTION;
+                    END IF;
+               END LOOP;
+          END TSK;
+
+     BEGIN -- (E)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 1.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " &
+                       "MINUTES - 5");
+          END IF;
+
+          IF GLOBAL /= 5 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "TASK EXIT - 5");
+          END IF;
+
+     END; -- (E)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (F)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 5 * 60;     -- FIVE MINUTE DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+               TYPE ARR IS ARRAY (1..1) OF T2;
+               TYPE RAT;
+               TYPE ARAT IS ACCESS RAT;
+               TYPE RAT IS
+                    RECORD
+                         A : ARAT;
+                         T : ARR;
+                    END RECORD;
+               LIST : ARAT;
+               TEMP : ARAT;
+          BEGIN
+               FOR I IN 1 .. IDENT_INT (1) LOOP
+                    TEMP := NEW RAT;
+                    TEMP.A := LIST;
+                    LIST := TEMP;
+                    CALL_ENTRY (LIST.T(1), IDENT_INT(6));
+               END LOOP;
+          END TSK;
+
+     BEGIN -- (F)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 1.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " &
+                       "MINUTES - 6");
+          END IF;
+
+          IF GLOBAL /= 6 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "TASK EXIT - 6");
+          END IF;
+
+     END; -- (F)
+
+     RESULT;
+END C94002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002b.ada
new file mode 100644
index 000000000..1f226f7c5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002b.ada
@@ -0,0 +1,208 @@
+-- C94002B.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 MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL ACCESS
+--   TYPE MAY TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS TO
+--   TERMINATE.
+
+-- SUBTESTS ARE:
+--   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+--   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
+--   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
+
+-- JRK 10/8/81
+-- SPS 11/2/82
+-- SPS 11/21/82
+-- JRK 11/29/82
+-- TBN 1/20/86     REPLACED WITH C94006A-B.ADA AFTER LOWERING THE DELAY
+--                 VALUES, AND MODIFYING THE COMMENTS.
+-- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94002B IS
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TASK BODY TT IS
+     BEGIN
+          ACCEPT E;
+          ACCEPT E;
+     END TT;
+
+
+BEGIN
+     TEST ("C94002B", "CHECK THAT A MASTER UNIT, WHICH ALLOCATES " &
+                      "TASKS OF A GLOBAL ACCESS TYPE MAY TERMINATE " &
+                      "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
+                      "TERMINATE");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          TYPE A_T IS ACCESS TT;
+          A1 : A_T;
+
+     BEGIN -- (A)
+
+          DECLARE
+               A2 : A_T;
+          BEGIN
+               A2 := NEW TT;
+               A2.ALL.E;
+               A1 := A2;
+          END;
+
+          IF A1.ALL'TERMINATED THEN
+               FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
+          END IF;
+
+          A1.ALL.E;
+
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+
+               TYPE RT IS
+                    RECORD
+                         T : TT;
+                    END RECORD;
+               TYPE ART IS ACCESS RT;
+               AR1 : ART;
+
+               PROCEDURE P (AR : OUT ART) IS
+                    AR2 : ART;
+               BEGIN
+                    AR2 := NEW RT;
+                    AR2.T.E;
+                    AR := AR2;
+               END P;
+
+          BEGIN
+               P (AR1);
+
+               IF AR1.T'TERMINATED THEN
+                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                            "- (B)");
+               END IF;
+
+               AR1.T.E;
+               RETURN 0;
+          END F;
+
+     BEGIN -- (B)
+
+          I := F;
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 60;                -- DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+
+               LOOP_COUNT1 : INTEGER := 0;
+               CUT_OFF1 : CONSTANT := 60;          -- DELAY.
+
+               TYPE RAT;
+               TYPE ARAT IS ACCESS RAT;
+               TYPE ARR IS ARRAY (1..1) OF TT;
+               TYPE RAT IS
+                    RECORD
+                         A : ARAT;
+                         T : ARR;
+                    END RECORD;
+               ARA1 : ARAT;
+
+               TASK TSK1 IS
+                    ENTRY ENT1 (ARA : OUT ARAT);
+               END TSK1;
+
+               TASK BODY TSK1 IS
+                    ARA2 : ARAT;
+               BEGIN
+                    ARA2 := NEW RAT;
+                    ARA2.T(1).E;
+                    ACCEPT ENT1 (ARA : OUT ARAT) DO
+                         ARA := ARA2;
+                    END ENT1;
+               END TSK1;
+
+          BEGIN
+               TSK1.ENT1 (ARA1);
+
+               WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+                    LOOP_COUNT1 := LOOP_COUNT1 + 1;
+               END LOOP;
+
+               IF LOOP_COUNT1 >= CUT_OFF1 THEN
+                    FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
+                            "WITHIN ONE MINUTE - (C)");
+               END IF;
+
+               IF ARA1.T(1)'TERMINATED THEN
+                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                            "- (C)");
+               END IF;
+
+               ARA1.T(1).E;
+          END TSK;
+
+     BEGIN -- (C)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 2.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
+                       "TWO MINUTES - (C)");
+          END IF;
+
+     END; -- (C)
+
+     --------------------------------------------------
+
+     RESULT;
+END C94002B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002d.ada
new file mode 100644
index 000000000..372fac0bf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002d.ada
@@ -0,0 +1,74 @@
+-- C94002D.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 TASK DOES  N O T  DEPEND ON A UNIT IF IT IS DESIGNATED
+-- BY A LOCAL ACCESS VARIABLE (OF THIS UNIT) WHOSE TYPE IS DECLARED
+-- OUTSIDE THIS UNIT.
+
+-- WEI  3/ 4/82
+-- JBG 2/20/84
+-- TBN 11/25/85     RENAMED FROM C940ACB-B.ADA.
+
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C94002D IS
+
+     TASK TYPE TT1 IS
+          ENTRY E1;
+          ENTRY E2;
+     END TT1;
+
+     TYPE ATT1 IS ACCESS TT1;
+     OUTER_TT1 : ATT1;
+
+     TASK BODY TT1 IS
+     BEGIN
+          ACCEPT E1;
+          ACCEPT E2;
+     END TT1;
+
+BEGIN
+     TEST ("C94002D", "DEPENDENCY IS INDEPENDENT OF WHERE ACCESS " &
+                      "VARIABLE IS DECLARED");
+
+BLOCK1 :
+     DECLARE
+          POINTER_TT1 : ATT1 := NEW TT1;
+     BEGIN
+          OUTER_TT1 := POINTER_TT1;
+          POINTER_TT1.ALL.E1;
+     END BLOCK1;         -- MAY DEADLOCK HERE IF INCORRECT DEPENDENCY
+                         -- RULE IS IMPLEMENTED.
+
+     IF OUTER_TT1.ALL'TERMINATED THEN
+          FAILED ("NON-DEPENDENT TASK IS TERMINATED " &
+                  "IMMEDIATELY AFTER ENCLOSING UNIT HAS " &
+                  "BEEN COMPLETED");
+     END IF;
+
+     OUTER_TT1.E2;       -- RELEASE TASK
+
+     RESULT;
+
+END C94002D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002e.ada
new file mode 100644
index 000000000..940fd3289
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002e.ada
@@ -0,0 +1,207 @@
+-- C94002E.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 NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
+--   ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS
+--   TO TERMINATE.
+
+-- SUBTESTS ARE:
+--   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+--   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
+--   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
+
+-- JRK 10/8/81
+-- SPS 11/2/82
+-- SPS 11/21/82
+-- JRK 11/29/82
+-- TBN 1/20/86     RENAMED FROM C94006A-B.ADA.  LOWERED THE DELAY VALUES
+--                 AND MODIFIED THE COMMENTS.
+-- JRK 5/1/86      IMPROVED ERROR RECOVERY LOGIC.
+-- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94002E IS
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TASK BODY TT IS
+     BEGIN
+          ACCEPT E;
+          ACCEPT E;
+     END TT;
+
+
+BEGIN
+     TEST ("C94002E", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
+                      "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
+                      "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
+                      "TERMINATE");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          TYPE A_T IS ACCESS TT;
+          A1 : A_T;
+
+     BEGIN -- (A)
+
+          DECLARE
+               A2 : A_T;
+          BEGIN
+               A2 := NEW TT;
+               A2.ALL.E;
+               A1 := A2;
+          END;
+
+          IF A1.ALL'TERMINATED THEN
+               FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
+          ELSE A1.ALL.E;
+          END IF;
+
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+
+               TYPE RT IS
+                    RECORD
+                         T : TT;
+                    END RECORD;
+               TYPE ART IS ACCESS RT;
+               AR1 : ART;
+
+               PROCEDURE P (AR : OUT ART) IS
+                    AR2 : ART;
+               BEGIN
+                    AR2 := NEW RT;
+                    AR2.T.E;
+                    AR := AR2;
+               END P;
+
+          BEGIN
+               P (AR1);
+
+               IF AR1.T'TERMINATED THEN
+                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                            "- (B)");
+               ELSE AR1.T.E;
+               END IF;
+
+               RETURN 0;
+          END F;
+
+     BEGIN -- (B)
+
+          I := F;
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 60;                -- DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+
+               LOOP_COUNT1 : INTEGER := 0;
+               CUT_OFF1 : CONSTANT := 60;          -- DELAY.
+
+               TYPE RAT;
+               TYPE ARAT IS ACCESS RAT;
+               TYPE ARR IS ARRAY (1..1) OF TT;
+               TYPE RAT IS
+                    RECORD
+                         A : ARAT;
+                         T : ARR;
+                    END RECORD;
+               ARA1 : ARAT;
+
+               TASK TSK1 IS
+                    ENTRY ENT1 (ARA : OUT ARAT);
+               END TSK1;
+
+               TASK BODY TSK1 IS
+                    ARA2 : ARAT;
+               BEGIN
+                    ARA2 := NEW RAT;
+                    ARA2.T(1).E;
+                    ACCEPT ENT1 (ARA : OUT ARAT) DO
+                         ARA := ARA2;
+                    END ENT1;
+               END TSK1;
+
+          BEGIN
+               TSK1.ENT1 (ARA1);
+
+               WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+                    LOOP_COUNT1 := LOOP_COUNT1 + 1;
+               END LOOP;
+
+               IF LOOP_COUNT1 >= CUT_OFF1 THEN
+                    FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
+                            "WITHIN ONE MINUTE - (C)");
+               END IF;
+
+               IF ARA1.T(1)'TERMINATED THEN
+                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                            "- (C)");
+               ELSE ARA1.T(1).E;
+               END IF;
+          END TSK;
+
+     BEGIN -- (C)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 2.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
+                       "TWO MINUTES - (C)");
+          END IF;
+
+     END; -- (C)
+
+     --------------------------------------------------
+
+     RESULT;
+END C94002E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002f.ada
new file mode 100644
index 000000000..47f0b4df2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002f.ada
@@ -0,0 +1,227 @@
+-- C94002F.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 NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
+--   ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS
+--   TO TERMINATE IF AN EXCEPTION IS RAISED AND HANDLED IN THE
+--   NON-MASTER UNIT.
+
+-- SUBTESTS ARE:
+--   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+--   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
+--   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
+
+-- TBN 1/20/86
+-- JRK 5/1/86   IMPROVED ERROR RECOVERY.  FIXED EXCEPTION HANDLING.
+-- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94002F IS
+
+     MY_EXCEPTION : EXCEPTION;
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TASK BODY TT IS
+     BEGIN
+          ACCEPT E;
+          ACCEPT E;
+     END TT;
+
+
+BEGIN
+     TEST ("C94002F", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
+                      "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
+                      "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
+                      "TERMINATE IF AN EXCEPTION IS RAISED AND " &
+                      "HANDLED IN THE NON-MASTER UNIT");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          TYPE A_T IS ACCESS TT;
+          A1 : A_T;
+
+     BEGIN -- (A)
+
+          DECLARE
+               A2 : A_T;
+          BEGIN
+               A2 := NEW TT;
+               A2.ALL.E;
+               A1 := A2;
+               RAISE MY_EXCEPTION;
+               FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)");
+          EXCEPTION
+               WHEN MY_EXCEPTION =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION IN (A)");
+          END;
+
+          IF A1.ALL'TERMINATED THEN
+               FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
+          ELSE A1.ALL.E;
+          END IF;
+
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+
+               TYPE RT IS
+                    RECORD
+                         T : TT;
+                    END RECORD;
+               TYPE ART IS ACCESS RT;
+               AR1 : ART;
+
+               PROCEDURE P (AR : OUT ART) IS
+                    AR2 : ART;
+               BEGIN
+                    AR2 := NEW RT;
+                    AR2.T.E;
+                    AR := AR2;
+                    RAISE MY_EXCEPTION;
+                    FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)");
+               EXCEPTION
+                    WHEN MY_EXCEPTION =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION IN (B)");
+               END P;
+
+          BEGIN
+               P (AR1);
+
+               IF AR1.T'TERMINATED THEN
+                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                            "- (B)");
+               ELSE AR1.T.E;
+               END IF;
+
+               RETURN 0;
+          END F;
+
+     BEGIN -- (B)
+
+          I := F;
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 60;                -- DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+
+               LOOP_COUNT1 : INTEGER := 0;
+               CUT_OFF1 : CONSTANT := 60;          -- DELAY.
+
+               TYPE RAT;
+               TYPE ARAT IS ACCESS RAT;
+               TYPE ARR IS ARRAY (1..1) OF TT;
+               TYPE RAT IS
+                    RECORD
+                         A : ARAT;
+                         T : ARR;
+                    END RECORD;
+               ARA1 : ARAT;
+
+               TASK TSK1 IS
+                    ENTRY ENT1 (ARA : OUT ARAT);
+               END TSK1;
+
+               TASK BODY TSK1 IS
+                    ARA2 : ARAT;
+               BEGIN
+                    ARA2 := NEW RAT;         -- INITIATE TASK ARA2.T(1).
+                    ARA2.T(1).E;
+                    ACCEPT ENT1 (ARA : OUT ARAT) DO
+                         ARA := ARA2;
+                    END ENT1;
+                    RAISE MY_EXCEPTION;
+                    FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)");
+               EXCEPTION
+                    WHEN MY_EXCEPTION =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION IN (C)");
+               END TSK1;
+
+          BEGIN
+               TSK1.ENT1 (ARA1);     -- ARA1.T BECOMES ALIAS FOR ARA2.T.
+
+               WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+                    LOOP_COUNT1 := LOOP_COUNT1 + 1;
+               END LOOP;
+
+               IF LOOP_COUNT1 >= CUT_OFF1 THEN
+                    FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
+                            "WITHIN ONE MINUTE - (C)");
+               END IF;
+
+               IF ARA1.T(1)'TERMINATED THEN
+                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                            "- (C)");
+               ELSE ARA1.T(1).E;
+               END IF;
+          END TSK;
+
+     BEGIN -- (C)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 2.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
+                       "TWO MINUTES - (C)");
+          END IF;
+
+     END; -- (C)
+
+     ---------------------------------------------------------------
+
+     RESULT;
+END C94002F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002g.ada
new file mode 100644
index 000000000..1b6108fe5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94002g.ada
@@ -0,0 +1,350 @@
+-- C94002G.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 NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
+--     ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED
+--     TASKS TO TERMINATE IF AN EXCEPTION IS RAISED BUT NOT HANDLED IN
+--     THE NON-MASTER UNIT.
+
+--     SUBTESTS ARE:
+--        (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
+--        (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
+--        (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY, NOT
+--             DURING RENDEZVOUS.
+--        (D)  A LIMITED PRIVATE TASK ALLOCATOR, IN A TASK BODY, DURING
+--             RENDEZVOUS.
+
+-- HISTORY:
+--     TBN 01/20/86  CREATED ORIGINAL TEST.
+--      JRK 05/01/86  IMPROVED ERROR RECOVERY.  FIXED EXCEPTION
+--                    HANDLING.  ADDED CASE (D).
+--      BCB 09/24/87  ADDED A RETURN STATEMENT TO THE HANDLER FOR OTHERS
+--                    IN FUNCTION F, CASE B.
+--      PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94002G IS
+
+     MY_EXCEPTION : EXCEPTION;
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TASK BODY TT IS
+     BEGIN
+          ACCEPT E;
+          ACCEPT E;
+     END TT;
+
+
+BEGIN
+     TEST ("C94002G", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
+                      "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
+                      "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
+                      "TERMINATE IF AN EXCEPTION IS RAISED BUT NOT " &
+                      "HANDLED IN THE NON-MASTER UNIT");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          TYPE A_T IS ACCESS TT;
+          A1 : A_T;
+
+     BEGIN -- (A)
+
+          DECLARE
+               A2 : A_T;
+          BEGIN
+               A2 := NEW TT;
+               A2.ALL.E;
+               A1 := A2;
+               RAISE MY_EXCEPTION;
+               FAILED ("MY_EXCEPTION WAS NOT RAISED IN (A)");
+          END;
+
+          ABORT A1.ALL;
+
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF A1.ALL'TERMINATED THEN
+                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - " &
+                            "(A)");
+               ELSE A1.ALL.E;
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION IN (A)");
+               IF A1 /= NULL THEN
+                    ABORT A1.ALL;
+               END IF;
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+
+               TYPE RT IS
+                    RECORD
+                         T : TT;
+                    END RECORD;
+               TYPE ART IS ACCESS RT;
+               AR1 : ART;
+
+               PROCEDURE P IS
+                    AR2 : ART;
+               BEGIN
+                    AR2 := NEW RT;
+                    AR2.T.E;
+                    AR1 := AR2;
+                    RAISE MY_EXCEPTION;
+                    FAILED ("MY_EXCEPTION WAS NOT RAISED IN (B)");
+               END P;
+
+          BEGIN
+               P;
+               ABORT AR1.T;
+               RETURN 0;
+          EXCEPTION
+               WHEN MY_EXCEPTION =>
+                    IF AR1.T'TERMINATED THEN
+                         FAILED ("ALLOCATED TASK PREMATURELY " &
+                                 "TERMINATED - (B)");
+                    ELSE AR1.T.E;
+                    END IF;
+                    RETURN 0;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION IN (B)");
+                    IF AR1 /= NULL THEN
+                         ABORT AR1.T;
+                    END IF;
+                    RETURN 0;
+          END F;
+
+     BEGIN -- (B)
+
+          I := F;
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 60;                -- DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+
+               LOOP_COUNT1 : INTEGER := 0;
+               CUT_OFF1 : CONSTANT := 60;          -- DELAY.
+
+               TYPE RAT;
+               TYPE ARAT IS ACCESS RAT;
+               TYPE ARR IS ARRAY (1..1) OF TT;
+               TYPE RAT IS
+                    RECORD
+                         A : ARAT;
+                         T : ARR;
+                    END RECORD;
+               ARA1 : ARAT;
+
+               TASK TSK1 IS
+                    ENTRY ENT1 (ARA : OUT ARAT);
+               END TSK1;
+
+               TASK BODY TSK1 IS
+                    ARA2 : ARAT;
+               BEGIN
+                    ARA2 := NEW RAT;         -- INITIATE TASK ARA2.T(1).
+                    ARA2.T(1).E;
+                    ACCEPT ENT1 (ARA : OUT ARAT) DO
+                         ARA := ARA2;
+                    END ENT1;
+                    RAISE MY_EXCEPTION;       -- NOT PROPOGATED.
+                    FAILED ("MY_EXCEPTION WAS NOT RAISED IN (C)");
+               END TSK1;
+
+          BEGIN
+               TSK1.ENT1 (ARA1);     -- ARA1.T BECOMES ALIAS FOR ARA2.T.
+
+               WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+                    LOOP_COUNT1 := LOOP_COUNT1 + 1;
+               END LOOP;
+
+               IF LOOP_COUNT1 >= CUT_OFF1 THEN
+                    FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
+                            "WITHIN ONE MINUTE - (C)");
+               END IF;
+
+               IF ARA1.T(1)'TERMINATED THEN
+                    FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
+                            "- (C)");
+               ELSE ARA1.T(1).E;
+               END IF;
+          END TSK;
+
+     BEGIN -- (C)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 2.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
+                       "TWO MINUTES - (C)");
+          END IF;
+
+     END; -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D)
+
+          LOOP_COUNT : INTEGER := 0;
+          CUT_OFF : CONSTANT := 60;                -- DELAY.
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+
+               LOOP_COUNT1 : INTEGER := 0;
+               CUT_OFF1 : CONSTANT := 60;          -- DELAY.
+
+               PACKAGE PKG IS
+                    TYPE LPT IS LIMITED PRIVATE;
+                    PROCEDURE CALL (X : LPT);
+                    PROCEDURE KILL (X : LPT);
+                    FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN;
+               PRIVATE
+                    TYPE LPT IS NEW TT;
+               END PKG;
+
+               USE PKG;
+
+               TYPE ALPT IS ACCESS LPT;
+               ALP1 : ALPT;
+
+               PACKAGE BODY PKG IS
+                    PROCEDURE CALL (X : LPT) IS
+                    BEGIN
+                         X.E;
+                    END CALL;
+
+                    PROCEDURE KILL (X : LPT) IS
+                    BEGIN
+                         ABORT X;
+                    END KILL;
+
+                    FUNCTION TERMINATED (X : LPT) RETURN BOOLEAN IS
+                    BEGIN
+                         RETURN X'TERMINATED;
+                    END TERMINATED;
+               END PKG;
+
+               TASK TSK1 IS
+                    ENTRY ENT1 (ALP : OUT ALPT);
+                    ENTRY DIE;
+               END TSK1;
+
+               TASK BODY TSK1 IS
+                    ALP2 : ALPT;
+               BEGIN
+                    ALP2 := NEW LPT;         -- INITIATE TASK ALP2.ALL.
+                    CALL (ALP2.ALL);
+                    ACCEPT ENT1 (ALP : OUT ALPT) DO
+                         ALP := ALP2;
+                    END ENT1;
+                    ACCEPT DIE DO
+                         RAISE MY_EXCEPTION;       -- PROPOGATED.
+                         FAILED ("MY_EXCEPTION WAS NOT RAISED IN (D)");
+                    END DIE;
+               END TSK1;
+
+          BEGIN
+               TSK1.ENT1 (ALP1); -- ALP1.ALL BECOMES ALIAS FOR ALP2.ALL.
+               TSK1.DIE;
+               FAILED ("MY_EXCEPTION WAS NOT PROPOGATED TO CALLING " &
+                       "TASK - (D)");
+               KILL (ALP1.ALL);
+               ABORT TSK1;
+          EXCEPTION
+               WHEN MY_EXCEPTION =>
+                    WHILE NOT TSK1'TERMINATED AND
+                          LOOP_COUNT1 < CUT_OFF1 LOOP
+                         DELAY 1.0 * Impdef.One_Second;
+                         LOOP_COUNT1 := LOOP_COUNT1 + 1;
+                    END LOOP;
+
+                    IF LOOP_COUNT1 >= CUT_OFF1 THEN
+                         FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
+                                 "WITHIN ONE MINUTE - (D)");
+                    END IF;
+
+                    IF TERMINATED (ALP1.ALL) THEN
+                         FAILED ("ALLOCATED TASK PREMATURELY " &
+                                 "TERMINATED - (D)");
+                    ELSE CALL (ALP1.ALL);
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION IN (D)");
+                    IF ALP1 /= NULL THEN
+                         KILL (ALP1.ALL);
+                    END IF;
+                    ABORT TSK1;
+          END TSK;
+
+     BEGIN -- (D)
+
+          WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
+               DELAY 2.0 * Impdef.One_Second;
+               LOOP_COUNT := LOOP_COUNT + 1;
+          END LOOP;
+
+          IF LOOP_COUNT >= CUT_OFF THEN
+               FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
+                       "TWO MINUTES - (D)");
+          END IF;
+
+     END; -- (D)
+
+     --------------------------------------------------
+
+     RESULT;
+END C94002G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94004a.ada
new file mode 100644
index 000000000..b895f8c87
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94004a.ada
@@ -0,0 +1,95 @@
+-- C94004A.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 MAIN PROGRAM TERMINATES WITHOUT WAITING FOR TASKS THAT
+-- DEPEND ON A LIBRARY PACKAGE AND THAT SUCH TASKS ARE NOT TERMINATED BY
+-- MAIN PROGRAM TERMINATION.
+
+-- CASE A:  TASK OBJECT DECLARED IN LIBRARY PACKAGE USED BY MAIN
+--          PROGRAM.
+
+-- JRK 10/8/81
+-- SPS 11/21/82
+-- JBG 12/6/84
+-- JRK 11/21/85  RENAMED FROM C94004A-B.ADA; REVISED ACCORDING TO
+--               AI-00399.
+-- JRK 10/24/86  RENAMED FROM E94004A-B.ADA; REVISED ACCORDING TO
+--               REVISED AI-00399.
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+PACKAGE C94004A_PKG IS
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+END C94004A_PKG;
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY C94004A_PKG IS
+
+     TASK BODY TT IS
+          I : INTEGER := IDENT_INT (120);
+     BEGIN
+          ACCEPT E;
+          COMMENT ("DELAY LIBRARY TASK FOR TWO MINUTES");
+          DELAY DURATION(I) * Impdef.One_Second;
+          -- MAIN PROGRAM SHOULD NOW BE TERMINATED.
+          RESULT;
+     END TT;
+
+END C94004A_PKG;
+
+WITH C94004A_PKG; USE C94004A_PKG;
+PRAGMA ELABORATE (C94004A_PKG);
+PACKAGE C94004A_TASK IS
+     T : TT;
+END;
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH C94004A_TASK;
+PROCEDURE C94004A IS
+
+
+BEGIN
+     TEST ("C94004A", "CHECK THAT A MAIN PROGRAM TERMINATES " &
+                      "WITHOUT WAITING FOR TASKS THAT DEPEND " &
+                      "ON A LIBRARY PACKAGE AND THAT SUCH TASKS " &
+                      "CONTINUE TO EXECUTE");
+
+     COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
+              "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
+
+     C94004A_TASK.T.E;      -- ALLOW TASK TO PROCEED.
+     IF C94004A_TASK.T'TERMINATED THEN
+          FAILED ("LIBRARY DECLARED TASK PREMATURELY TERMINATED");
+     END IF;
+
+     -- RESULT PROCEDURE IS CALLED BY LIBRARY TASK.
+
+END C94004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94004b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94004b.ada
new file mode 100644
index 000000000..3a578fd8b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94004b.ada
@@ -0,0 +1,97 @@
+-- C94004B.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 MAIN PROGRAM TERMINATES WITHOUT WAITING FOR TASKS THAT
+-- DEPEND ON A LIBRARY PACKAGE AND THAT SUCH TASKS ARE NOT TERMINATED BY
+-- MAIN PROGRAM TERMINATION.
+
+-- CASE B:  ACCESS TO TASK TYPE DECLARED IN LIBRARY PACKAGE; TASK
+--          ACTIVATED IN MAIN PROGRAM.
+
+-- JRK 10/8/81
+-- SPS 11/21/82
+-- JBG 12/6/84
+-- JRK 11/21/85  RENAMED FROM C94004B-B.ADA; REVISED ACCORDING TO
+--               AI-00399.
+-- JRK 10/24/86  RENAMED FROM E94004B-B.ADA; REVISED ACCORDING TO
+--               REVISED AI-00399.
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+PACKAGE C94004B_PKG IS
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+END C94004B_PKG;
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY C94004B_PKG IS
+
+     TASK BODY TT IS
+          I : INTEGER := IDENT_INT (120);
+     BEGIN
+          ACCEPT E;
+          COMMENT ("DELAY LIBRARY TASK FOR TWO MINUTES");
+          DELAY DURATION(I) * Impdef.One_Second;
+          -- MAIN PROGRAM SHOULD NOW BE TERMINATED.
+          RESULT;
+     END TT;
+
+END C94004B_PKG;
+
+WITH C94004B_PKG; USE C94004B_PKG;
+PRAGMA ELABORATE (C94004B_PKG);
+PACKAGE C94004B_TASK IS
+     TYPE ACC_TASK IS ACCESS C94004B_PKG.TT;
+END;
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH C94004B_TASK; WITH C94004B_PKG;
+PROCEDURE C94004B IS
+
+     T : C94004B_TASK.ACC_TASK;
+
+BEGIN
+     TEST ("C94004B", "CHECK THAT A MAIN PROGRAM TERMINATES " &
+                      "WITHOUT WAITING FOR TASKS THAT DEPEND " &
+                      "ON A LIBRARY PACKAGE AND THAT SUCH TASKS " &
+                      "CONTINUE TO EXECUTE");
+
+     COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
+              "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
+
+     T := NEW C94004B_PKG.TT;
+     T.E;      -- ALLOW TASK TO PROCEED.
+     IF T'TERMINATED THEN
+          FAILED ("LIBRARY DECLARED TASK PREMATURELY TERMINATED");
+     END IF;
+
+     -- RESULT PROCEDURE IS CALLED BY LIBRARY TASK.
+
+END C94004B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94004c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94004c.ada
new file mode 100644
index 000000000..321bfee72
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94004c.ada
@@ -0,0 +1,104 @@
+-- C94004C.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 MAIN PROGRAM TERMINATES WITHOUT WAITING FOR TASKS THAT
+-- DEPEND ON A LIBRARY PACKAGE AND THAT SUCH TASKS ARE NOT TERMINATED BY
+-- MAIN PROGRAM TERMINATION.
+
+-- CASE C:  TASK OBJECT DECLARED IN LIBRARY PACKAGE USED BY MAIN PROGRAM
+--          AND WAITING AT A SELECTIVE WAIT WITH TERMINATE.
+
+-- JRK 10/8/81
+-- SPS 11/21/82
+-- JBG 12/6/84
+-- JRK 11/21/85  RENAMED FROM C94004C-B.ADA; REVISED ACCORDING TO
+--               AI-00399.
+-- JRK 10/24/86  RENAMED FROM E94004C-B.ADA; REVISED ACCORDING TO
+--               REVISED AI-00399.
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+PACKAGE C94004C_PKG IS
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+END C94004C_PKG;
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY C94004C_PKG IS
+
+     TASK BODY TT IS
+          I : INTEGER := IDENT_INT (120);
+     BEGIN
+          ACCEPT E;
+          COMMENT ("DELAY LIBRARY TASK FOR TWO MINUTES");
+          DELAY DURATION(I) * Impdef.One_Second;
+          -- MAIN PROGRAM SHOULD NOW BE TERMINATED.
+          RESULT;
+          -- USE LOOP FOR SELECTIVE WAIT WITH TERMINATE.
+          LOOP
+               SELECT
+                    ACCEPT E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          END LOOP;
+          -- FAILS IF JOB HANGS UP WITHOUT TERMINATING.
+     END TT;
+
+END C94004C_PKG;
+
+WITH C94004C_PKG; USE C94004C_PKG;
+PRAGMA ELABORATE (C94004C_PKG);
+PACKAGE C94004C_TASK IS
+     T : TT;
+END;
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH C94004C_TASK;
+PROCEDURE C94004C IS
+
+
+BEGIN
+     TEST ("C94004C", "CHECK THAT A MAIN PROGRAM TERMINATES " &
+                      "WITHOUT WAITING FOR TASKS THAT DEPEND " &
+                      "ON A LIBRARY PACKAGE AND THAT SUCH TASKS " &
+                      "CONTINUE TO EXECUTE");
+
+     COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
+              "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
+
+     C94004C_TASK.T.E;      -- ALLOW TASK TO PROCEED.
+     IF C94004C_TASK.T'TERMINATED THEN
+          FAILED ("LIBRARY DECLARED TASK PREMATURELY TERMINATED");
+     END IF;
+
+     -- RESULT PROCEDURE IS CALLED BY LIBRARY TASK.
+
+END C94004C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94005a.ada
new file mode 100644
index 000000000..71c5846f4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94005a.ada
@@ -0,0 +1,90 @@
+-- C94005A.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 TASK TYPE IS DECLARED IN A LIBRARY PACKAGE, A MAIN
+--   PROGRAM THAT DECLARES OBJECTS OF THAT TYPE DOES WAIT FOR
+--   TERMINATION OF SUCH OBJECTS.
+
+-- THIS TEST CONTAINS RACE CONDITIONS.
+
+-- JRK 10/8/81
+-- SPS 11/21/82
+-- JWC 11/15/85    MADE THE LIBRARY PACKAGE NAME UNIQUE, C94005A_PKG.
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+
+WITH SYSTEM; USE SYSTEM;
+PACKAGE C94005A_PKG IS
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+END C94005A_PKG;
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PACKAGE BODY C94005A_PKG IS
+
+     TASK BODY TT IS
+          I : INTEGER := IDENT_INT (0);
+     BEGIN
+          ACCEPT E;
+          FOR J IN 1..60 LOOP
+               I := IDENT_INT (I);
+               DELAY 1.0 * Impdef.One_Second;
+          END LOOP;
+          RESULT;   -- FAILURE IF THIS MESSAGE IS NOT WRITTEN.
+     END TT;
+
+END C94005A_PKG;
+
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH C94005A_PKG;
+PROCEDURE C94005A IS
+
+     T : C94005A_PKG.TT;
+
+
+BEGIN
+     TEST ("C94005A", "CHECK THAT IF A TASK TYPE IS DECLARED IN A " &
+                      "LIBRARY PACKAGE, A MAIN PROGRAM THAT " &
+                      "DECLARES OBJECTS OF THAT TYPE DOES WAIT FOR " &
+                      "TERMINATION OF SUCH OBJECTS");
+
+     COMMENT ("THE INVOKING SYSTEM'S JOB CONTROL LOG MUST BE " &
+              "EXAMINED TO SEE IF THIS TEST REALLY TERMINATES");
+
+     T.E;
+
+     IF T'TERMINATED THEN
+          COMMENT ("TEST INCONCLUSIVE BECAUSE TASK T PREMATURELY " &
+                   "TERMINATED");
+     END IF;
+
+     -- TASK T SHOULD WRITE THE RESULT MESSAGE.
+
+END C94005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94005b.ada
new file mode 100644
index 000000000..2a481b313
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94005b.ada
@@ -0,0 +1,168 @@
+-- C94005B.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 TASK TYPE IS DECLARED IN A LIBRARY PACKAGE, ANY
+--   BLOCKS, SUBPROGRAMS, OR TASKS THAT DECLARE OBJECTS OF THAT TYPE
+--   DO WAIT FOR TERMINATION OF SUCH OBJECTS.
+-- SUBTESTS ARE:
+--   (A)  IN A MAIN PROGRAM BLOCK.
+--   (B)  IN A LIBRARY FUNCTION.
+--   (C)  IN A MAIN PROGRAM TASK BODY.
+
+-- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
+
+-- JRK 10/8/81
+-- SPS 11/2/82
+-- SPS 11/21/82
+-- JWC 11/15/85    MADE THE LIBRARY PACKAGE NAME UNIQUE, C94005B_PKG.
+-- PWN 01/31/95    REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+
+WITH SYSTEM; USE SYSTEM;
+PACKAGE C94005B_PKG IS
+
+     GLOBAL : INTEGER;
+
+     TASK TYPE TT IS
+          ENTRY E (I : INTEGER);
+     END TT;
+
+END C94005B_PKG;
+
+with Impdef;
+PACKAGE BODY C94005B_PKG IS
+
+     TASK BODY TT IS
+          LOCAL : INTEGER;
+     BEGIN
+          ACCEPT E (I : INTEGER) DO
+               LOCAL := I;
+          END E;
+          DELAY 60.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
+                         -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
+                         -- TERMINATE IF THE ERROR IS PRESENT.
+          GLOBAL := LOCAL;
+     END TT;
+
+END C94005B_PKG;
+
+
+WITH REPORT; USE REPORT;
+WITH C94005B_PKG; USE C94005B_PKG;
+FUNCTION F RETURN INTEGER IS
+
+     T : TT;
+
+BEGIN
+
+     T.E (IDENT_INT(2));
+     RETURN 0;
+
+END F;
+
+with Impdef;
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH C94005B_PKG; USE C94005B_PKG;
+WITH F;
+PROCEDURE C94005B IS
+
+
+BEGIN
+     TEST ("C94005B", "CHECK THAT IF A TASK TYPE IS DECLARED IN A " &
+                      "LIBRARY PACKAGE, ANY BLOCKS, SUBPROGRAMS, OR " &
+                      "TASKS THAT DECLARE OBJECTS OF THAT TYPE DO " &
+                      "WAIT FOR TERMINATION OF SUCH OBJECTS");
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (A)
+
+          T : TT;
+
+     BEGIN -- (A)
+
+          T.E (IDENT_INT(1));
+
+     END; -- (A)
+
+     IF GLOBAL /= 1 THEN
+          FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                  "BLOCK EXIT - (A)");
+     END IF;
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (B)
+
+          I : INTEGER;
+
+     BEGIN -- (B)
+
+          I := F ;
+
+          IF GLOBAL /= 2 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "FUNCTION EXIT - (B)");
+          END IF;
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     GLOBAL := IDENT_INT (0);
+
+     DECLARE -- (C)
+
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          TASK BODY TSK IS
+               T : TT;
+          BEGIN
+               T.E (IDENT_INT(3));
+          END TSK;
+
+     BEGIN -- (C)
+
+          WHILE NOT TSK'TERMINATED LOOP
+               DELAY 0.1 * Impdef.One_Second;
+          END LOOP;
+
+          IF GLOBAL /= 3 THEN
+               FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
+                       "TASK EXIT - (C)");
+          END IF;
+
+     END; -- (C)
+
+     --------------------------------------------------
+
+     RESULT;
+END C94005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94006a.ada
new file mode 100644
index 000000000..cac5fc6e0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94006a.ada
@@ -0,0 +1,136 @@
+-- C94006A.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 DECLARATION THAT RENAMES A TASK DOES NOT CREATE A NEW
+-- MASTER FOR THE TASK.
+
+-- TBN  9/17/86
+-- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94006A IS
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TASK BODY TT IS
+     BEGIN
+          SELECT
+               ACCEPT E;
+          OR
+               DELAY 30.0 * Impdef.One_Long_Second;
+          END SELECT;
+     END TT;
+
+
+BEGIN
+     TEST ("C94006A", "CHECK THAT A DECLARATION THAT RENAMES A TASK " &
+                      "DOES NOT CREATE A NEW MASTER FOR THE TASK");
+
+     -------------------------------------------------------------------
+     DECLARE
+          T1 : TT;
+     BEGIN
+          DECLARE
+               RENAME_TASK : TT RENAMES T1;
+          BEGIN
+               NULL;
+          END;
+          IF T1'TERMINATED THEN
+               FAILED ("TASK DEPENDENT ON WRONG UNIT - 1");
+          ELSE
+               T1.E;
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+
+     DECLARE
+          T2 : TT;
+
+          PACKAGE P IS
+               Q : TT RENAMES T2;
+          END P;
+
+          PACKAGE BODY P IS
+          BEGIN
+               NULL;
+          END P;
+
+          USE P;
+     BEGIN
+          IF Q'TERMINATED THEN
+               FAILED ("TASK DEPENDENT ON WRONG UNIT - 2");
+          ELSE
+               Q.E;
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+
+     DECLARE
+          TYPE ACC_TT IS ACCESS TT;
+          P1 : ACC_TT;
+     BEGIN
+          DECLARE
+               RENAME_ACCESS : ACC_TT RENAMES P1;
+          BEGIN
+               RENAME_ACCESS := NEW TT;
+          END;
+          IF P1'TERMINATED THEN
+               FAILED ("TASK DEPENDENT ON WRONG UNIT - 3");
+          ELSE
+               P1.E;
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+
+     DECLARE
+          TYPE ACC_TT IS ACCESS TT;
+          P2 : ACC_TT;
+
+          PACKAGE Q IS
+               RENAME_ACCESS : ACC_TT RENAMES P2;
+          END Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               RENAME_ACCESS := NEW TT;
+          END Q;
+
+          USE Q;
+     BEGIN
+          IF RENAME_ACCESS'TERMINATED THEN
+               FAILED ("TASK DEPENDENT ON WRONG UNIT - 4");
+          ELSE
+               RENAME_ACCESS.E;
+          END IF;
+     END;
+
+     RESULT;
+END C94006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94007a.ada
new file mode 100644
index 000000000..e0a2c3f76
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94007a.ada
@@ -0,0 +1,270 @@
+-- C94007A.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 TASK THAT IS DECLARED IN A NON-LIBRARY PACKAGE
+--     (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
+--     BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
+--     OR TASK BODY.
+--     SUBTESTS ARE:
+--       (A)  A SIMPLE TASK OBJECT, IN A VISIBLE PART, IN A BLOCK.
+--       (B)  AN ARRAY OF TASK OBJECT, IN A PRIVATE PART, IN A FUNCTION.
+--       (C)  AN ARRAY OF RECORD OF TASK OBJECT, IN A PACKAGE BODY,
+--            IN A TASK BODY.
+
+-- HISTORY:
+--     JRK 10/13/81
+--     SPS 11/21/82
+--     DHH 09/07/88 REVISED HEADER, ADDED EXCEPTION HANDLERS ON OUTER
+--                  BLOCKS, AND ADDED CASE TO INSURE THAT LEAVING A
+--                  PACKAGE VIA AN EXCEPTION WOULD NOT ABORT TASKS.
+--     PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94007A IS
+
+     TASK TYPE SYNC IS
+          ENTRY ID (C : CHARACTER);
+          ENTRY INNER;
+          ENTRY OUTER;
+     END SYNC;
+
+     TASK BODY SYNC IS
+          ID_C : CHARACTER;
+     BEGIN
+          ACCEPT ID (C : CHARACTER) DO
+               ID_C := C;
+          END ID;
+          DELAY 1.0 * Impdef.One_Second;
+          SELECT
+               ACCEPT OUTER;
+          OR
+               DELAY 120.0 * Impdef.One_Second;
+               FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
+          END SELECT;
+          ACCEPT INNER;
+     END SYNC;
+
+
+BEGIN
+     TEST ("C94007A", "CHECK THAT A TASK THAT IS DECLARED IN A " &
+                      "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
+                      "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
+                      "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
+                      "BODY, OR TASK BODY");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          S : SYNC;
+
+     BEGIN -- (A)
+
+          S.ID ('A');
+
+          DECLARE
+
+               PACKAGE PKG IS
+                    TASK T IS
+                         ENTRY E;
+                    END T;
+               END PKG;
+
+               PACKAGE BODY PKG IS
+                    TASK BODY T IS
+                    BEGIN
+                         S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                    END T;
+               END PKG;            -- PROBABLE OUTER BLOCK POINT.
+
+          BEGIN
+
+               S.OUTER;
+
+          EXCEPTION
+               WHEN TASKING_ERROR => NULL;
+          END;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED - A");
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          S : SYNC;
+
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+
+               PACKAGE PKG IS
+               PRIVATE
+                    TASK TYPE TT IS
+                         ENTRY E;
+                    END TT;
+                    A : ARRAY (1..1) OF TT;
+               END PKG;
+
+               PACKAGE BODY PKG IS
+                    TASK BODY TT IS
+                    BEGIN
+                         S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                    END TT;
+               END PKG;            -- PROBABLE OUTER BLOCK POINT.
+
+          BEGIN -- F
+
+               S.OUTER;
+               RETURN 0;
+
+          EXCEPTION
+               WHEN TASKING_ERROR => RETURN 0;
+          END F;
+
+     BEGIN -- (B)
+
+          S.ID ('B');
+          I := F;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED - B");
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          S : SYNC;
+
+     BEGIN -- (C)
+
+          S.ID ('C');
+
+          DECLARE
+
+               TASK TSK IS
+               END TSK;
+
+               TASK BODY TSK IS
+
+                    PACKAGE PKG IS
+                    END PKG;
+
+                    PACKAGE BODY PKG IS
+                         TASK TYPE TT IS
+                              ENTRY E;
+                         END TT;
+
+                         TYPE RT IS
+                              RECORD
+                                   T : TT;
+                              END RECORD;
+
+                         AR : ARRAY (1..1) OF RT;
+
+                         TASK BODY TT IS
+                         BEGIN
+                              S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                         END TT;
+                    END PKG;            -- PROBABLE OUTER BLOCK POINT.
+
+               BEGIN -- TSK
+
+                    S.OUTER;
+
+               EXCEPTION
+                    WHEN TASKING_ERROR => NULL;
+               END TSK;
+
+          BEGIN
+               NULL;
+          END;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED - C");
+     END; -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D)
+
+     GLOBAL : INTEGER := IDENT_INT(5);
+
+     BEGIN -- (D)
+
+          DECLARE
+
+               PACKAGE PKG IS
+                    TASK T IS
+                         ENTRY E;
+                    END T;
+
+                    TASK T1 IS
+                    END T1;
+               END PKG;
+
+               PACKAGE BODY PKG IS
+                    TASK BODY T IS
+                    BEGIN
+                         ACCEPT E DO
+                              RAISE CONSTRAINT_ERROR;
+                         END E;
+                    END T;
+
+                    TASK BODY T1 IS
+                    BEGIN
+                         DELAY 120.0 * Impdef.One_Second;
+                         GLOBAL := IDENT_INT(1);
+                    END T1;
+
+               BEGIN
+                    T.E;
+
+               END PKG;
+               USE PKG;
+          BEGIN
+               NULL;
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF GLOBAL /= IDENT_INT(1) THEN
+                    FAILED("TASK NOT COMPLETED");
+               END IF;
+
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED - D");
+     END; -- (D)
+
+     RESULT;
+END C94007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94007b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94007b.ada
new file mode 100644
index 000000000..87e45b352
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94007b.ada
@@ -0,0 +1,224 @@
+-- C94007B.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 TASK THAT IS ALLOCATED IN A NON-LIBRARY PACKAGE
+--   (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
+--   BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
+--   OR TASK BODY.
+-- SUBTESTS ARE:
+--   (A)  A SIMPLE TASK ALLOCATOR, IN A VISIBLE PART, IN A BLOCK.
+--   (B)  A RECORD OF TASK ALLOCATOR, IN A PRIVATE PART, IN A FUNCTION.
+--   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A PACKAGE BODY,
+--           IN A TASK BODY.
+
+-- JRK 10/16/81
+-- SPS 11/2/82
+-- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94007B IS
+
+     TASK TYPE SYNC IS
+          ENTRY ID (C : CHARACTER);
+          ENTRY INNER;
+          ENTRY OUTER;
+     END SYNC;
+
+     TASK BODY SYNC IS
+          ID_C : CHARACTER;
+     BEGIN
+          ACCEPT ID (C : CHARACTER) DO
+               ID_C := C;
+          END ID;
+          DELAY 1.0 * Impdef.One_Second;
+          SELECT
+               ACCEPT OUTER;
+          OR
+               DELAY 120.0 * Impdef.One_Second;
+               FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
+          END SELECT;
+          ACCEPT INNER;
+     END SYNC;
+
+
+BEGIN
+     TEST ("C94007B", "CHECK THAT A TASK THAT IS ALLOCATED IN A " &
+                      "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
+                      "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
+                      "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
+                      "BODY, OR TASK BODY");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          S : SYNC;
+
+     BEGIN -- (A)
+
+          S.ID ('A');
+
+          DECLARE
+
+               PACKAGE PKG IS
+                    TASK TYPE TT IS
+                         ENTRY E;
+                    END TT;
+                    TYPE A_T IS ACCESS TT;
+                    A : A_T;
+               END PKG;
+
+               PACKAGE BODY PKG IS
+                    TASK BODY TT IS
+                    BEGIN
+                         S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                    END TT;
+               BEGIN
+                    A := NEW TT;
+               END PKG;            -- PROBABLE OUTER BLOCK POINT.
+
+          BEGIN
+
+               S.OUTER;
+
+          EXCEPTION
+               WHEN TASKING_ERROR => NULL;
+          END;
+
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          S : SYNC;
+
+          I : INTEGER;
+
+          FUNCTION F RETURN INTEGER IS
+
+               PACKAGE PKG IS
+               PRIVATE
+                    TASK TYPE TT IS
+                         ENTRY E;
+                    END TT;
+
+                    TYPE RT IS
+                         RECORD
+                              T : TT;
+                         END RECORD;
+
+                    TYPE ART IS ACCESS RT;
+
+                    AR : ART;
+               END PKG;
+
+               PACKAGE BODY PKG IS
+                    TASK BODY TT IS
+                    BEGIN
+                         S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                    END TT;
+               BEGIN
+                    AR := NEW RT;
+               END PKG;            -- PROBABLE OUTER BLOCK POINT.
+
+          BEGIN -- F
+
+               S.OUTER;
+               RETURN 0;
+
+          EXCEPTION
+               WHEN TASKING_ERROR => RETURN 0;
+          END F;
+
+     BEGIN -- (B)
+
+          S.ID ('B');
+          I := F ;
+
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          S : SYNC;
+
+     BEGIN -- (C)
+
+          S.ID ('C');
+
+          DECLARE
+
+               TASK TSK IS
+               END TSK;
+
+               TASK BODY TSK IS
+
+                    PACKAGE PKG IS
+                    END PKG;
+
+                    PACKAGE BODY PKG IS
+                         TASK TYPE TT IS
+                              ENTRY E;
+                         END TT;
+                         
+                         TYPE ARR IS ARRAY (1..1) OF TT;
+                         TYPE RAT IS
+                              RECORD
+                                   T : ARR;
+                              END RECORD;
+
+                         TYPE ARAT IS ACCESS RAT;
+
+                         ARA : ARAT;
+
+                         TASK BODY TT IS
+                         BEGIN
+                              S.INNER;  -- PROBABLE INNER BLOCK POINT.
+                         END TT;
+                    BEGIN
+                         ARA := NEW RAT;
+                    END PKG;            -- PROBABLE OUTER BLOCK POINT.
+
+               BEGIN -- TSK
+
+                    S.OUTER;
+
+               EXCEPTION
+                    WHEN TASKING_ERROR => NULL;
+               END TSK;
+
+          BEGIN
+               NULL;
+          END;
+
+     END; -- (C)
+
+     --------------------------------------------------
+
+     RESULT;
+END C94007B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008a.ada
new file mode 100644
index 000000000..90b31d315
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008a.ada
@@ -0,0 +1,61 @@
+-- C94008A.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 TASK WAITING AT AN OPEN TERMINATE ALTERNATIVE
+-- DOES  N O T  TERMINATE WHILE THE UNIT THE TASK DEPENDS ON
+-- HAS NOT COMPLETED ITS EXECUTION.
+
+-- WEI  3/ 4/82
+-- TBN  11/25/85     RENAMED FROM C940BAA-B.ADA.
+
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C94008A IS
+BEGIN
+     TEST ("C94008A", "TERMINATION WHILE WAITING AT " &
+                      "AN OPEN TERMINATE ALTERNATIVE");
+
+BLOCK1 :
+     DECLARE
+          TASK T1 IS
+               ENTRY E1;
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               SELECT
+                    WHEN TRUE => TERMINATE;
+                    OR WHEN FALSE => ACCEPT E1;
+               END SELECT;
+          END T1;
+     BEGIN  -- BLOCK1
+          IF T1'TERMINATED THEN
+               FAILED ("TASK T1 TERMINATED BEFORE OUTER UNIT HAS " &
+                       "BEEN LEFT");
+          END IF;
+     END BLOCK1;
+
+     RESULT;
+
+END C94008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008b.ada
new file mode 100644
index 000000000..e72d4890e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008b.ada
@@ -0,0 +1,81 @@
+-- C94008B.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 TASK WAITING AT AN OPEN TERMINATE ALTERNATIVE
+-- DOES  N O T  TERMINATE UNTIL ALL OTHER TASKS DEPENDING ON THE SAME
+-- UNIT EITHER ARE TERMINATED OR ARE WAITING AT AN OPEN TERMINATE.
+
+-- WEI  3/ 4/82
+-- TBN 11/25/85     RENAMED FROM C940BBA-B.ADA.
+
+with Impdef;
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C94008B IS
+BEGIN
+     TEST ("C94008B", "TERMINATION WHILE WAITING AT AN OPEN TERMINATE");
+
+BLOCK1 :
+     DECLARE
+
+          TASK TYPE TT1 IS
+               ENTRY E1;
+          END TT1;
+
+          NUMB_TT1 : CONSTANT NATURAL := 3;
+          DELAY_TIME : DURATION := 0.0;
+          ARRAY_TT1 : ARRAY (1 .. NUMB_TT1) OF TT1;
+
+          TASK BODY TT1 IS
+          BEGIN
+               DELAY_TIME := DELAY_TIME + 1.0 * Impdef.One_Second;
+               DELAY DELAY_TIME;
+               FOR I IN 1 .. NUMB_TT1
+               LOOP
+                    IF ARRAY_TT1 (I)'TERMINATED THEN
+                         FAILED ("TOO EARLY TERMINATION OF " &
+                                 "TASK TT1 INDEX" & INTEGER'IMAGE(I));
+                    END IF;
+               END LOOP;
+
+               SELECT
+                    WHEN TRUE => TERMINATE;
+                 OR WHEN FALSE => ACCEPT E1;
+               END SELECT;
+          END TT1;
+
+     BEGIN  -- BLOCK1.
+          FOR I IN 1 .. NUMB_TT1
+          LOOP
+               IF ARRAY_TT1 (I)'TERMINATED THEN
+                    FAILED ("TERMINATION BEFORE OUTER " &
+                            "UNIT HAS BEEN LEFT OF TASK TT1 INDEX " &
+                            INTEGER'IMAGE(I));
+               END IF;
+          END LOOP;
+     END BLOCK1;
+
+     RESULT;
+
+END C94008B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008c.ada
new file mode 100644
index 000000000..fb2eee97f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008c.ada
@@ -0,0 +1,265 @@
+-- C94008C.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 SELECT WITH TERMINATE ALTERNATIVE WORKS CORRECTLY WITH
+-- NESTED TASKS.
+
+-- THIS TEST CONTAINS RACE CONDITIONS AND USES A GENERIC INSTANCE THAT
+-- CONTAINS TASKS.
+
+-- JEAN-PIERRE ROSEN 24 FEBRUARY 1984
+-- JRK 4/7/86
+-- JBG 8/29/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94008C IS
+
+
+-- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
+     GENERIC
+          TYPE HOLDER_TYPE IS PRIVATE;
+          TYPE VALUE_TYPE IS PRIVATE;
+          INITIAL_VALUE : HOLDER_TYPE;
+          WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
+                              VALUE  : IN  HOLDER_TYPE) IS <>;
+          WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
+                                 VALUE  : IN  VALUE_TYPE) IS <>;
+     PACKAGE SHARED IS
+          PROCEDURE SET (VALUE : IN HOLDER_TYPE);
+          PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
+          FUNCTION GET RETURN HOLDER_TYPE;
+     END SHARED;
+
+     PACKAGE BODY SHARED IS
+          TASK SHARE IS
+               ENTRY SET    (VALUE : IN HOLDER_TYPE);
+               ENTRY UPDATE (VALUE : IN VALUE_TYPE);
+               ENTRY READ   (VALUE : OUT HOLDER_TYPE);
+          END SHARE;
+
+          TASK BODY SHARE IS
+               VARIABLE : HOLDER_TYPE;
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
+                              SHARED.SET (VARIABLE, VALUE);
+                         END SET;
+                    OR
+                         ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
+                              SHARED.UPDATE (VARIABLE, VALUE);
+                         END UPDATE;
+                    OR
+                         ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
+                              VALUE := VARIABLE;
+                         END READ;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END SHARE;
+
+          PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
+          BEGIN
+               SHARE.SET (VALUE);
+          END SET;
+
+          PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
+          BEGIN
+               SHARE.UPDATE (VALUE);
+          END UPDATE;
+
+          FUNCTION GET RETURN HOLDER_TYPE IS
+               VALUE : HOLDER_TYPE;
+          BEGIN
+               SHARE.READ (VALUE);
+               RETURN VALUE;
+          END GET;
+
+     BEGIN
+          SHARE.SET (INITIAL_VALUE);    -- SET INITIAL VALUE
+     END SHARED;
+
+     PACKAGE EVENTS IS
+
+          TYPE EVENT_TYPE IS
+               RECORD
+                    TRACE  : STRING (1..4) := "....";
+                    LENGTH : NATURAL := 0;
+               END RECORD;
+
+          PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
+          PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
+     END EVENTS;
+
+     PACKAGE COUNTER IS
+          PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
+          PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
+     END COUNTER;
+
+     PACKAGE BODY COUNTER IS
+          PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
+          BEGIN
+               VAR := VAR + VAL;
+          END UPDATE;
+
+          PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
+          BEGIN
+               VAR := VAL;
+          END SET;
+     END COUNTER;
+
+     PACKAGE BODY EVENTS IS
+          PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
+          BEGIN
+               VAR.LENGTH := VAR.LENGTH + 1;
+               VAR.TRACE(VAR.LENGTH) := VAL;
+          END UPDATE;
+
+          PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
+          BEGIN
+               VAR := VAL;
+          END SET;
+
+     END EVENTS;
+
+     USE EVENTS, COUNTER;
+
+     PACKAGE TRACE IS NEW SHARED (EVENT_TYPE, CHARACTER, ("....", 0));
+     PACKAGE TERMINATE_COUNT IS NEW SHARED (INTEGER, INTEGER, 0);
+
+     FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
+     BEGIN
+          TERMINATE_COUNT.UPDATE (1);
+          RETURN TRUE;
+     END ENTER_TERMINATE;
+
+BEGIN -- C94008C
+
+     TEST ("C94008C", "CHECK CORRECT OPERATION OF SELECT WITH " &
+                      "TERMINATE ALTERNATIVE");
+
+     DECLARE
+
+          PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
+
+          TASK T1 IS
+               ENTRY E1;
+          END T1;
+
+          TASK BODY T1 IS
+
+               TASK T2 IS
+                    ENTRY E2;
+               END T2;
+
+               TASK BODY T2 IS
+
+                    TASK T3 IS
+                         ENTRY E3;
+                    END T3;
+
+                    TASK BODY T3 IS
+                    BEGIN
+                         SELECT
+                              ACCEPT E3;
+                         OR WHEN ENTER_TERMINATE => TERMINATE;
+                         END SELECT;
+                         EVENT ('D');
+                    END T3;
+
+               BEGIN -- T2
+
+                    SELECT
+                         ACCEPT E2;
+                    OR WHEN ENTER_TERMINATE => TERMINATE;
+                    END SELECT;
+
+                    DELAY 10.0 * Impdef.One_Second;
+
+                    IF TERMINATE_COUNT.GET /= 1 THEN
+                         DELAY 20.0 * Impdef.One_Long_Second;
+                    END IF;
+
+                    IF TERMINATE_COUNT.GET /= 1 THEN
+                         FAILED ("30 SECOND DELAY NOT ENOUGH - 1 ");
+                    END IF;
+
+                    EVENT ('C');
+                    T1.E1;
+                    T3.E3;
+               END T2;
+
+          BEGIN -- T1;
+
+               SELECT
+                    ACCEPT E1;
+               OR WHEN ENTER_TERMINATE => TERMINATE;
+               END SELECT;
+
+               EVENT ('B');
+               TERMINATE_COUNT.SET (0);
+               T2.E2;
+
+               SELECT
+                    ACCEPT E1;
+               OR WHEN ENTER_TERMINATE => TERMINATE;
+               END SELECT;
+
+               SELECT
+                    ACCEPT E1;
+               OR TERMINATE;  -- ONLY THIS ONE EVER CHOSEN.
+               END SELECT;
+
+               FAILED ("TERMINATE NOT SELECTED IN T1");
+          END T1;
+
+     BEGIN
+
+          DELAY 10.0 * Impdef.One_Second; -- WAIT FOR T1, T2, AND T3 TO GET TO SELECT STMTS.
+
+           IF TERMINATE_COUNT.GET /= 3 THEN
+                DELAY 20.0 * Impdef.One_Long_Second;
+           END IF;
+
+           IF TERMINATE_COUNT.GET /= 3 THEN
+                FAILED ("30 SECOND DELAY NOT ENOUGH - 2");
+           END IF;
+
+          EVENT ('A');
+          T1.E1;
+
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION IN MAIN BLOCK");
+     END;
+
+     IF TRACE.GET.TRACE /= "ABCD" THEN
+          FAILED ("INCORRECT ORDER OF EVENTS: " & TRACE.GET.TRACE);
+     END IF;
+
+     RESULT;
+END C94008C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008d.ada
new file mode 100644
index 000000000..15ca61618
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94008d.ada
@@ -0,0 +1,235 @@
+-- C94008D.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 CORRECT OPERATION OF SELECT WITH TERMINATE ALTERNATIVE WHEN
+-- EXECUTED FROM AN INNER BLOCK WITH OUTER DEPENDING TASKS.
+
+-- JEAN-PIERRE ROSEN 03-MAR-84
+-- JRK 4/7/86
+-- JBG 9/4/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT/SUBUNIT
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+-- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
+GENERIC
+     TYPE HOLDER_TYPE IS PRIVATE;
+     TYPE VALUE_TYPE IS PRIVATE;
+     INITIAL_VALUE : HOLDER_TYPE;
+     WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
+                         VALUE  : IN  HOLDER_TYPE) IS <>;
+     WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
+                            VALUE  : IN  VALUE_TYPE) IS <>;
+PACKAGE SHARED_C94008D IS
+     PROCEDURE SET (VALUE : IN HOLDER_TYPE);
+     PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
+     FUNCTION GET RETURN HOLDER_TYPE;
+END SHARED_C94008D;
+
+PACKAGE BODY SHARED_C94008D IS
+     TASK SHARE IS
+          ENTRY SET    (VALUE : IN HOLDER_TYPE);
+          ENTRY UPDATE (VALUE : IN VALUE_TYPE);
+          ENTRY READ   (VALUE : OUT HOLDER_TYPE);
+     END SHARE;
+
+     TASK BODY SHARE IS SEPARATE;
+
+     PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
+     BEGIN
+          SHARE.SET (VALUE);
+     END SET;
+
+     PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
+     BEGIN
+          SHARE.UPDATE (VALUE);
+     END UPDATE;
+
+     FUNCTION GET RETURN HOLDER_TYPE IS
+          VALUE : HOLDER_TYPE;
+     BEGIN
+          SHARE.READ (VALUE);
+          RETURN VALUE;
+     END GET;
+
+BEGIN
+     SHARE.SET (INITIAL_VALUE);    -- SET INITIAL VALUE
+END SHARED_C94008D;
+
+PACKAGE EVENTS_C94008D IS
+
+     TYPE EVENT_TYPE IS
+          RECORD
+               TRACE  : STRING (1..4) := "....";
+               LENGTH : NATURAL := 0;
+          END RECORD;
+
+     PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
+     PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
+END EVENTS_C94008D;
+
+PACKAGE COUNTER_C94008D IS
+     PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
+     PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
+END COUNTER_C94008D;
+
+PACKAGE BODY COUNTER_C94008D IS
+     PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
+     BEGIN
+          VAR := VAR + VAL;
+     END UPDATE;
+
+     PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
+     BEGIN
+          VAR := VAL;
+     END SET;
+END COUNTER_C94008D;
+
+PACKAGE BODY EVENTS_C94008D IS
+     PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
+     BEGIN
+          VAR.LENGTH := VAR.LENGTH + 1;
+          VAR.TRACE(VAR.LENGTH) := VAL;
+     END UPDATE;
+
+     PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
+     BEGIN
+          VAR := VAL;
+     END SET;
+
+END EVENTS_C94008D;
+
+SEPARATE (SHARED_C94008D)
+TASK BODY SHARE IS
+     VARIABLE : HOLDER_TYPE;
+BEGIN
+     LOOP
+          SELECT
+               ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
+                    SHARED_C94008D.SET (VARIABLE, VALUE);
+               END SET;
+          OR
+               ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
+                    SHARED_C94008D.UPDATE (VARIABLE, VALUE);
+               END UPDATE;
+          OR
+               ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
+                    VALUE := VARIABLE;
+               END READ;
+          OR
+               TERMINATE;
+          END SELECT;
+     END LOOP;
+END SHARE;
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+WITH SHARED_C94008D, COUNTER_C94008D, EVENTS_C94008D;
+USE  COUNTER_C94008D, EVENTS_C94008D;
+PROCEDURE C94008D IS
+
+     PACKAGE TRACE IS
+          NEW SHARED_C94008D (EVENT_TYPE, CHARACTER, ("....", 0));
+     PACKAGE TERMINATE_COUNT IS
+          NEW SHARED_C94008D (INTEGER, INTEGER, 0);
+
+     PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
+
+     FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
+     BEGIN
+          TERMINATE_COUNT.UPDATE (1);
+          RETURN TRUE;
+     END ENTER_TERMINATE;
+
+BEGIN
+     TEST ("C94008D", "CHECK CORRECT OPERATION OF SELECT WITH " &
+                      "TERMINATE ALTERNATIVE FROM AN INNER BLOCK");
+
+     DECLARE
+
+          TASK T1 IS
+               ENTRY E1;
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               DECLARE
+
+                    TASK T2 IS
+                         ENTRY E2;
+                    END T2;
+
+                    TASK BODY T2 IS
+                    BEGIN
+                         DELAY 10.0 * Impdef.One_Second;
+
+                         IF TERMINATE_COUNT.GET /= 1 THEN
+                              DELAY 20.0 * Impdef.One_Second;
+                         END IF;
+
+                         IF TERMINATE_COUNT.GET /= 1 THEN
+                              FAILED ("30 SECOND DELAY NOT ENOUGH");
+                         END IF;
+
+                         IF T1'TERMINATED OR NOT T1'CALLABLE THEN
+                              FAILED ("T1 PREMATURELY TERMINATED");
+                         END IF;
+
+                         EVENT ('A');
+
+                         SELECT
+                              ACCEPT E2;
+                         OR TERMINATE;
+                         END SELECT;
+
+                         FAILED ("TERMINATE NOT SELECTED IN T2");
+                    END T2;
+
+               BEGIN
+                    BEGIN
+                         EVENT ('B');
+
+                         SELECT
+                              ACCEPT E1;
+                         OR WHEN ENTER_TERMINATE => TERMINATE;
+                         END SELECT;
+
+                         FAILED ("TERMINATE NOT SELECTED IN T1");
+                    END;
+               END;
+          END T1;
+
+     BEGIN
+          EVENT ('C');
+     EXCEPTION
+          WHEN OTHERS => FAILED ("EXCEPTION RECEIVED IN MAIN");
+     END;
+
+     IF TRACE.GET.TRACE(3) = '.' OR TRACE.GET.TRACE(4) /= '.' THEN
+          FAILED ("ALL EVENTS NOT PROCESSED CORRECTLY");
+     END IF;
+
+     COMMENT ("EXECUTION ORDER WAS " & TRACE.GET.TRACE);
+
+     RESULT;
+END C94008D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94010a.ada
new file mode 100644
index 000000000..3fe4bd6f2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94010a.ada
@@ -0,0 +1,243 @@
+-- C94010A.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 GENERIC UNIT HAS A FORMAL LIMITED PRIVATE TYPE AND
+-- DECLARES AN OBJECT OF THAT TYPE (OR HAS A SUBCOMPONENT OF THAT TYPE),
+-- AND IF THE UNIT IS INSTANTIATED WITH A TASK TYPE OR AN OBJECT HAVING
+-- A SUBCOMPONENT OF A TASK TYPE, THEN THE USUAL RULES APPLY TO THE
+-- INSTANTIATED UNIT, NAMELY:
+--     A) IF THE GENERIC UNIT IS A SUBPROGRAM, CONTROL CANNOT LEAVE THE
+--        SUBPROGRAM UNTIL THE TASK CREATED BY THE OBJECT DECLARATION IS
+--        TERMINATED.
+
+-- THIS TEST CONTAINS RACE CONDITIONS AND SHARED VARIABLES.
+
+-- TBN  9/22/86
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C94010A IS
+
+     GLOBAL_INT : INTEGER := 0;
+     MY_EXCEPTION : EXCEPTION;
+
+     PACKAGE P IS
+          TYPE LIM_PRI_TASK IS LIMITED PRIVATE;
+     PRIVATE
+          TASK TYPE LIM_PRI_TASK IS
+          END LIM_PRI_TASK;
+     END P;
+
+     USE P;
+
+     TASK TYPE TT IS
+     END TT;
+
+     TYPE REC IS
+          RECORD
+               A : INTEGER := 1;
+               B : TT;
+          END RECORD;
+
+     TYPE LIM_REC IS
+          RECORD
+               A : INTEGER := 1;
+               B : LIM_PRI_TASK;
+          END RECORD;
+
+     PACKAGE BODY P IS
+          TASK BODY LIM_PRI_TASK IS
+          BEGIN
+               DELAY 30.0 * Impdef.One_Second;
+               GLOBAL_INT := IDENT_INT (2);
+          END LIM_PRI_TASK;
+     END P;
+
+     TASK BODY TT IS
+     BEGIN
+          DELAY 30.0 * Impdef.One_Second;
+          GLOBAL_INT := IDENT_INT (1);
+     END TT;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+     PROCEDURE PROC (A : INTEGER);
+
+     PROCEDURE PROC (A : INTEGER) IS
+          OBJ_T : T;
+     BEGIN
+          IF A = IDENT_INT (1) THEN
+               RAISE MY_EXCEPTION;
+          END IF;
+     END PROC;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+     FUNCTION FUNC (A : INTEGER) RETURN INTEGER;
+
+     FUNCTION FUNC (A : INTEGER) RETURN INTEGER IS
+          OBJ_T : T;
+     BEGIN
+          IF A = IDENT_INT (1) THEN
+               RAISE MY_EXCEPTION;
+          END IF;
+          RETURN 1;
+     END FUNC;
+
+
+BEGIN
+     TEST ("C94010A", "CHECK TERMINATION RULES FOR INSTANTIATIONS OF " &
+                      "GENERIC SUBPROGRAM UNITS WHICH CREATE TASKS");
+
+     -------------------------------------------------------------------
+     DECLARE
+          PROCEDURE PROC1 IS NEW PROC (TT);
+     BEGIN
+          PROC1 (0);
+          IF GLOBAL_INT = IDENT_INT (0) THEN
+               FAILED ("TASK NOT DEPENDENT ON MASTER - 1");
+               DELAY 35.0;
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+     GLOBAL_INT := IDENT_INT (0);
+
+     DECLARE
+          PROCEDURE PROC2 IS NEW PROC (REC);
+     BEGIN
+          PROC2 (1);
+          FAILED ("EXCEPTION WAS NOT RAISED - 2");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL_INT = IDENT_INT (0) THEN
+                    FAILED ("TASK NOT DEPENDENT ON MASTER - 2");
+                    DELAY 35.0 * Impdef.One_Second;
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+     END;
+
+     -------------------------------------------------------------------
+     GLOBAL_INT := IDENT_INT (0);
+
+     DECLARE
+          PROCEDURE PROC3 IS NEW PROC (LIM_PRI_TASK);
+     BEGIN
+          PROC3 (1);
+          FAILED ("EXCEPTION WAS NOT RAISED - 3");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL_INT = IDENT_INT (0) THEN
+                    FAILED ("TASK NOT DEPENDENT ON MASTER - 3");
+                    DELAY 35.0 * Impdef.One_Second;
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+     END;
+
+     -------------------------------------------------------------------
+     GLOBAL_INT := IDENT_INT (0);
+
+     DECLARE
+          PROCEDURE PROC4 IS NEW PROC (LIM_REC);
+     BEGIN
+          PROC4 (0);
+          IF GLOBAL_INT = IDENT_INT (0) THEN
+               FAILED ("TASK NOT DEPENDENT ON MASTER - 4");
+               DELAY 35.0 * Impdef.One_Second;
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+     GLOBAL_INT := IDENT_INT (0);
+
+     DECLARE
+          A : INTEGER;
+          FUNCTION FUNC1 IS NEW FUNC (TT);
+     BEGIN
+          A := FUNC1 (1);
+          FAILED ("EXCEPTION NOT RAISED - 5");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL_INT = IDENT_INT (0) THEN
+                    FAILED ("TASK NOT DEPENDENT ON MASTER - 5");
+                    DELAY 35.0 * Impdef.One_Second;
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+     END;
+
+     -------------------------------------------------------------------
+     GLOBAL_INT := IDENT_INT (0);
+
+     DECLARE
+          A : INTEGER;
+          FUNCTION FUNC2 IS NEW FUNC (REC);
+     BEGIN
+          A := FUNC2 (0);
+          IF GLOBAL_INT = IDENT_INT (0) THEN
+               FAILED ("TASK NOT DEPENDENT ON MASTER - 6");
+               DELAY 35.0 * Impdef.One_Second;
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+     GLOBAL_INT := IDENT_INT (0);
+
+     DECLARE
+          A : INTEGER;
+          FUNCTION FUNC3 IS NEW FUNC (LIM_PRI_TASK);
+     BEGIN
+          A := FUNC3 (0);
+          IF GLOBAL_INT = IDENT_INT (0) THEN
+               FAILED ("TASK NOT DEPENDENT ON MASTER - 7");
+               DELAY 35.0 * Impdef.One_Second;
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+     GLOBAL_INT := IDENT_INT (0);
+
+     DECLARE
+          A : INTEGER;
+          FUNCTION FUNC4 IS NEW FUNC (LIM_REC);
+     BEGIN
+          A := FUNC4 (1);
+          FAILED ("EXCEPTION NOT RAISED - 8");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL_INT = IDENT_INT (0) THEN
+                    FAILED ("TASK NOT DEPENDENT ON MASTER - 8");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 8");
+     END;
+
+     -------------------------------------------------------------------
+          
+     RESULT;
+END C94010A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94011a.ada
new file mode 100644
index 000000000..c504f0692
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94011a.ada
@@ -0,0 +1,268 @@
+-- C94011A.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 FORMAL ACCESS TYPE OF A GENERIC UNIT DESIGNATES A
+-- FORMAL LIMITED PRIVATE TYPE, THEN WHEN THE UNIT IS INSTANTIATED WITH
+-- A TASK TYPE OR A TYPE HAVING A SUBCOMPONENT OF A TASK TYPE, THE
+-- MASTER FOR ANY TASKS ALLOCATED WITHIN THE INSTANTIATED UNIT IS
+-- DETERMINED BY THE ACTUAL PARAMETER.
+
+-- TBN  9/22/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C94011A IS
+
+     GLOBAL_INT : INTEGER := 0;
+     MY_EXCEPTION : EXCEPTION;
+
+     PACKAGE P IS
+          TYPE LIM_PRI_TASK IS LIMITED PRIVATE;
+          PROCEDURE E (T : LIM_PRI_TASK);
+     PRIVATE
+          TASK TYPE LIM_PRI_TASK IS
+               ENTRY E;
+          END LIM_PRI_TASK;
+     END P;
+
+     USE P;
+
+     TASK TYPE TT IS
+          ENTRY E;
+     END TT;
+
+     TYPE REC IS
+          RECORD
+               A : INTEGER := 1;
+               B : TT;
+          END RECORD;
+
+     TYPE LIM_REC IS
+          RECORD
+               A : INTEGER := 1;
+               B : LIM_PRI_TASK;
+          END RECORD;
+
+     PACKAGE BODY P IS
+          TASK BODY LIM_PRI_TASK IS
+          BEGIN
+               ACCEPT E;
+               GLOBAL_INT := IDENT_INT (2);
+          END LIM_PRI_TASK;
+
+          PROCEDURE E (T : LIM_PRI_TASK) IS
+          BEGIN
+               T.E;
+          END E;
+     END P;
+
+     TASK BODY TT IS
+     BEGIN
+          ACCEPT E;
+          GLOBAL_INT := IDENT_INT (1);
+     END TT;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+          TYPE ACC_T IS ACCESS T;
+     PROCEDURE PROC (A : OUT ACC_T);
+
+     PROCEDURE PROC (A : OUT ACC_T) IS
+     BEGIN
+          A := NEW T;
+     END PROC;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+          TYPE ACC_T IS ACCESS T;
+     FUNCTION FUNC RETURN ACC_T;
+
+     FUNCTION FUNC RETURN ACC_T IS
+     BEGIN
+          RETURN NEW T;
+     END FUNC;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+          TYPE ACC_T IS ACCESS T;
+     PACKAGE PAC IS
+          PTR_T : ACC_T := NEW T;
+     END PAC;
+
+BEGIN
+     TEST ("C94011A", "CHECK THAT IF A FORMAL ACCESS TYPE OF A " &
+                      "GENERIC UNIT DESIGNATES A FORMAL LIMITED " &
+                      "PRIVATE TYPE, THEN WHEN THE UNIT IS " &
+                      "INSTANTIATED, THE MASTER FOR ANY TASKS " &
+                      "ALLOCATED WITHIN THE INSTANTIATED UNIT IS " &
+                      "DETERMINED BY THE ACTUAL PARAMETER");
+
+     -------------------------------------------------------------------
+     DECLARE
+          TYPE ACC_TT IS ACCESS TT;
+          ACC1 : ACC_TT;
+          PROCEDURE PROC1 IS NEW PROC (TT, ACC_TT);
+     BEGIN
+          PROC1 (ACC1);
+          ACC1.E;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TASK DEPENDENT ON WRONG MASTER - 1");
+     END;
+     IF GLOBAL_INT = IDENT_INT (0) THEN
+          FAILED ("TASK NOT DEPENDENT ON MASTER - 1");
+     END IF;
+     
+     -------------------------------------------------------------------
+     BEGIN
+          GLOBAL_INT := IDENT_INT (0);
+          DECLARE
+               TYPE ACC_REC IS ACCESS REC;
+               A : ACC_REC;
+               FUNCTION FUNC1 IS NEW FUNC (REC, ACC_REC);
+          BEGIN
+               A := FUNC1;
+               A.B.E;
+               RAISE MY_EXCEPTION;
+          EXCEPTION
+               WHEN MY_EXCEPTION =>
+                    RAISE MY_EXCEPTION;
+               WHEN OTHERS =>
+                    FAILED ("TASK DEPENDENT ON WRONG MASTER - 2");
+          END;
+          FAILED ("MY_EXCEPTION NOT RAISED - 2");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL_INT = IDENT_INT (0) THEN
+                    FAILED ("TASK NOT DEPENDENT ON MASTER - 2");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+     END;
+     
+     -------------------------------------------------------------------
+     GLOBAL_INT := IDENT_INT (0);
+
+     BEGIN
+          DECLARE
+               TYPE ACC_LIM_TT IS ACCESS LIM_PRI_TASK;
+          BEGIN
+               DECLARE
+                    A : ACC_LIM_TT;
+                    FUNCTION FUNC2 IS NEW FUNC (LIM_PRI_TASK,
+                                                            ACC_LIM_TT);
+               BEGIN
+                    A := FUNC2;
+                    E (A.ALL);
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("TASK DEPENDENT ON WRONG MASTER - 3");
+          END;
+          IF GLOBAL_INT = IDENT_INT (0) THEN
+               FAILED ("TASK NOT DEPENDENT ON MASTER - 3");
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+     GLOBAL_INT := IDENT_INT (0);
+
+     BEGIN
+          DECLARE
+               TYPE ACC_LIM_REC IS ACCESS LIM_REC;
+          BEGIN
+               DECLARE
+                    ACC2 : ACC_LIM_REC;
+                    PROCEDURE PROC2 IS NEW PROC (LIM_REC, ACC_LIM_REC);
+               BEGIN
+                    PROC2 (ACC2);
+                    E (ACC2.B);
+               END;
+               RAISE MY_EXCEPTION;
+          EXCEPTION
+               WHEN MY_EXCEPTION =>
+                    RAISE MY_EXCEPTION;
+               WHEN OTHERS =>
+                    FAILED ("TASK DEPENDENT ON WRONG MASTER - 4");
+          END;
+          FAILED ("MY_EXCEPTION NOT RAISED - 4");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL_INT = IDENT_INT (0) THEN
+                    FAILED ("TASK NOT DEPENDENT ON MASTER - 4");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
+     END;
+
+     -------------------------------------------------------------------
+     BEGIN
+           GLOBAL_INT := IDENT_INT (0);
+
+          DECLARE
+               TYPE ACC_TT IS ACCESS TT;
+               PACKAGE PAC1 IS NEW PAC (TT, ACC_TT);
+               USE PAC1; 
+          BEGIN
+               PTR_T.E;
+               RAISE MY_EXCEPTION;
+          EXCEPTION
+               WHEN MY_EXCEPTION =>
+                    RAISE MY_EXCEPTION;
+               WHEN OTHERS =>
+                    FAILED ("TASK DEPENDENT ON WRONG MASTER - 5");
+          END;
+          FAILED ("MY_EXCEPTION NOT RAISED - 5");
+     EXCEPTION
+          WHEN MY_EXCEPTION =>
+               IF GLOBAL_INT = IDENT_INT (0) THEN
+                    FAILED ("TASK NOT DEPENDENT ON MASTER - 5");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+     END;
+     
+     -------------------------------------------------------------------
+     GLOBAL_INT := IDENT_INT (0);
+
+     DECLARE
+          TYPE ACC_LIM_REC IS ACCESS LIM_REC;
+     BEGIN
+          DECLARE
+               PACKAGE PAC2 IS NEW PAC (LIM_REC, ACC_LIM_REC);
+               USE PAC2;
+          BEGIN
+               E (PTR_T.B);
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TASK DEPENDENT ON WRONG MASTER - 6");
+     END;
+     IF GLOBAL_INT = IDENT_INT (0) THEN
+          FAILED ("TASK NOT DEPENDENT ON MASTER - 6");
+     END IF;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+END C94011A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94020a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94020a.ada
new file mode 100644
index 000000000..4a5037ecd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c94020a.ada
@@ -0,0 +1,111 @@
+-- C94020A.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 CONDITIONS FOR TERMINATION ARE RECOGNIZED WHEN THE
+-- LAST MISSING TASK TERMINATES DUE TO AN ABORT
+
+-- JEAN-PIERRE ROSEN 08-MAR-1984
+-- JBG 6/1/84
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE C94020A IS
+
+     TASK TYPE T2 IS
+     END T2;
+     
+     TASK TYPE T3 IS
+          ENTRY E;
+     END T3;
+     
+     TASK BODY T2 IS
+     BEGIN
+          COMMENT("T2");
+     END;
+     
+     TASK BODY T3 IS
+     BEGIN
+          COMMENT("T3");
+          SELECT
+               ACCEPT E;
+          OR TERMINATE;
+          END SELECT;
+          FAILED("T3 EXITED SELECT OR TERMINATE");
+     END;
+
+BEGIN
+
+     TEST ("C94020A", "TEST OF TASK DEPENDENCES, TERMINATE, ABORT");
+
+     DECLARE
+          TASK TYPE T1 IS
+          END T1;
+          
+          V1 : T1;
+          TYPE A_T1 IS ACCESS T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ABORT T1;
+               DELAY 0.0;          --SYNCHRONIZATION POINT
+               FAILED("T1 NOT ABORTED");
+          END;
+          
+     BEGIN
+          DECLARE
+               V2 : T2;
+               A1 : A_T1;
+          BEGIN
+               DECLARE
+                    V3 : T3;
+                    TASK T4 IS
+                    END T4;
+                    TASK BODY T4 IS
+                         TASK T41 IS
+                         END T41;
+                         TASK BODY T41 IS
+                         BEGIN
+                              COMMENT("T41");
+                              ABORT T4;
+                              DELAY 0.0;       --SYNCHRONIZATION POINT
+                              FAILED("T41 NOT ABORTED");
+                         END;
+                    BEGIN  --T4
+                         COMMENT("T4");
+                    END;
+               BEGIN
+                    COMMENT("BLOC 3");
+               END;
+               COMMENT("BLOC 2");
+               A1 := NEW T1;
+          END;
+          COMMENT("BLOC 1");
+     EXCEPTION
+          WHEN OTHERS => FAILED("SOME EXCEPTION RAISED");
+     END;
+
+     RESULT;
+
+END C94020A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940a03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940a03.a
new file mode 100644
index 000000000..22876d26b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940a03.a
@@ -0,0 +1,350 @@
+-- C940A03.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 protected object provides coordinated access to
+--      shared data.  Check that it can implement a semaphore-like construct
+--      controlling access to shared data through procedure parameters to
+--      allow a specific maximum number of tasks to run and exclude all
+--      others.
+--
+-- TEST DESCRIPTION:
+--      Declare a resource descriptor tagged type.  Extend the type and
+--      use the extended type in a protected data structure.
+--      Implement a counting semaphore type that can be initialized to a 
+--      specific number of available resources.  Declare an entry for 
+--      requesting a specific resource and an procedure for releasing the 
+--      same resource it.  Declare an object of this (protected) type, 
+--      initialized to two resources.  Declare and start three tasks each 
+--      of which asks for a resource.  Verify that only two resources are 
+--      granted and that the last task in is queued.
+--
+--      This test models a multi-user operating system that allows a limited
+--      number of logins.  Users requesting login are modeled by tasks.
+--
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         F940A00
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      13 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1
+--
+--!
+
+package C940A03_0 is
+      --Resource_Pkg
+
+  -- General type declarations that will be extended to model available
+  -- logins
+
+  type Resource_ID_Type is range 0..10;
+  type Resource_Type is tagged record 
+    Id : Resource_ID_Type := 0;
+  end record;
+
+end C940A03_0;
+  --Resource_Pkg
+
+--======================================--
+-- no body for C940A3_0
+--======================================--
+
+with F940A00;     -- Interlock_Foundation
+with C940A03_0;   -- Resource_Pkg;
+
+package C940A03_1 is
+     -- Semaphores
+
+  -- Models a counting semaphore that will allow up to a specific 
+  -- number of logins
+  -- Users (tasks) request a login slot by calling the Request_Login
+  -- entry and logout by calling the Release_Login procedure
+
+  Max_Logins : constant Integer := 2;
+  
+
+  type Key_Type is range 0..100;
+                                      -- When a user requests a login, an
+                                      -- identifying key will be returned
+  Init_Key : constant Key_Type := 0;
+
+  type Login_Record_Type is new C940A03_0.Resource_Type with record
+    Key  : Key_Type := Init_Key;
+  end record;
+
+
+  protected type Login_Semaphore_Type (Resources_Available : Integer :=1) is
+
+    entry     Request_Login   (Resource_Key : in out Login_Record_Type);
+    procedure Release_Login;
+    function  Available return Integer;  -- how many logins are available?
+  private
+    Logins_Avail : Integer  := Resources_Available;
+    Next_Key     : Key_Type := Init_Key;
+
+  end Login_Semaphore_Type;
+
+  Login_Semaphore      : Login_Semaphore_Type (Max_Logins);
+
+  --====== machinery for the test, not the model =====--
+  TC_Control_Message : F940A00.Interlock_Type;    
+  function TC_Key_Val (Login_Rec : Login_Record_Type) return Integer;
+
+
+end C940A03_1;
+ -- Semaphores;
+
+--=========================================================--
+
+package body C940A03_1 is
+          -- Semaphores is
+
+  protected body Login_Semaphore_Type is
+
+    entry Request_Login (Resource_Key : in out Login_Record_Type)
+                                             when Logins_Avail > 0 is
+    begin
+      Next_Key := Next_Key + 1;        -- login process returns a key
+      Resource_Key.Key := Next_Key;     -- to the requesting user
+      Logins_Avail := Logins_Avail - 1;
+    end Request_Login;
+
+    procedure Release_Login is
+    begin
+      Logins_Avail := Logins_Avail + 1;
+    end Release_Login;
+
+    function Available return Integer is
+      begin
+        return Logins_Avail;
+      end Available;
+
+  end Login_Semaphore_Type;
+
+  function TC_Key_Val (Login_Rec : Login_Record_Type) return Integer is
+    begin
+      return Integer (Login_Rec.Key);
+    end TC_Key_Val;
+
+end C940A03_1;
+ -- Semaphores;
+
+--=========================================================--
+
+with C940A03_0;    -- Resource_Pkg,
+with C940A03_1;    -- Semaphores;
+
+package C940A03_2 is
+     -- Task_Pkg
+
+  package Semaphores renames C940A03_1;
+
+  task type User_Task_Type is
+
+     entry Login  (user_id : C940A03_0.Resource_Id_Type);
+                      -- instructs the task to ask for a login
+     entry Logout;    -- instructs the task to release the login
+     --=======================--
+     -- this entry is used to get information to verify test operation
+     entry Get_Status (User_Record : out Semaphores.Login_Record_Type);
+
+  end User_Task_Type;
+
+end C940A03_2;
+ -- Task_Pkg
+
+--=========================================================--
+
+with Report;
+with C940A03_0;   -- Resource_Pkg,
+with C940A03_1;   -- Semaphores,
+with F940A00;     -- Interlock_Foundation;
+    
+package body C940A03_2 is
+          -- Task_Pkg 
+
+  -- This task models a user requesting a login from the system
+  -- For control of this test, we can ask the task to login, logout, or
+  -- give us the current user record (containing login information)
+
+  task body User_Task_Type is
+    Rec  : Semaphores.Login_Record_Type;
+  begin
+    loop
+      select
+        accept Login (user_id : C940A03_0.Resource_Id_Type) do
+          Rec.Id := user_id;
+        end Login;
+
+        Semaphores.Login_Semaphore.Request_Login (Rec);
+                      -- request a resource; if resource is not available, 
+                      -- task will be queued to wait
+
+        --== following is test control machinery ==--
+        F940A00.Counter.Increment;
+        Semaphores.TC_Control_Message.Post;   
+               -- after resource is obtained, post message
+
+      or
+        accept Logout do  
+          Semaphores.Login_Semaphore.Release_Login;
+                      -- release the resource
+          --== test control machinery ==--
+          F940A00.Counter.Decrement;
+        end Logout;
+        exit;
+
+      or
+        accept Get_Status (User_Record : out Semaphores.Login_Record_Type) do
+          User_Record := Rec;
+        end Get_Status;
+
+      end select;  
+    end loop;
+
+  exception
+    when others => Report.Failed ("Exception raised in model user task");
+  end User_Task_Type;
+
+end C940A03_2;
+ -- Task_Pkg
+
+--=========================================================--
+
+with Report;
+with ImpDef;
+with C940A03_1;   -- Semaphores, 
+with C940A03_2;   -- Task_Pkg,
+with F940A00;     -- Interlock_Foundation;
+
+procedure C940A03 is
+
+  package Semaphores renames C940A03_1;
+  package Users      renames C940A03_2;  
+
+  Task1, Task2, Task3 : Users.User_Task_Type;
+  User_Rec            : Semaphores.Login_Record_Type;
+
+begin      -- Tasks start here
+
+  Report.Test ("C940A03", "Check that a protected object can coordinate " &
+                          "shared data access using procedure parameters");
+
+  if F940A00.Counter.Number /=0 then
+    Report.Failed ("Wrong initial conditions");
+  end if;
+                                 
+  Task1.Login (1);               -- request resource; request should be granted
+  Semaphores.TC_Control_Message.Consume;  
+                                 -- ensure that task obtains resource by
+                                 -- waiting for task to post message
+
+                                 -- Task 1 waiting for call to Logout
+                                 -- Others still available
+  Task1.Get_Status (User_Rec);
+  if (F940A00.Counter.Number /= 1)
+  or (Semaphores.Login_Semaphore.Available /=1)
+  or (Semaphores.TC_Key_Val (User_Rec) /= 1) then
+    Report.Failed ("Resource not assigned to task 1");
+  end if;
+ 
+  Task2.Login (2);               -- Request for resource should be granted  
+  Semaphores.TC_Control_Message.Consume;  
+                                 -- ensure that task obtains resource by
+                                 -- waiting for task to post message
+ 
+  Task2.Get_Status (User_Rec);
+  if (F940A00.Counter.Number /= 2)
+  or (Semaphores.Login_Semaphore.Available /=0)
+  or (Semaphores.TC_Key_Val (User_Rec) /= 2) then
+    Report.Failed ("Resource not assigned to task 2");
+  end if;
+ 
+
+  Task3.Login (3);               -- request for resource should be denied
+                                 -- and task queued
+
+
+                                 -- Tasks 1 and 2 holds resources
+                                 -- and are waiting for a call to Logout
+                                 -- Task 3 is queued
+
+  if (F940A00.Counter.Number /= 2)
+  or (Semaphores.Login_Semaphore.Available /=0) then
+    Report.Failed ("Resource incorrectly assigned to task 3");
+  end if;
+
+  Task1.Logout;                  -- released resource should be given to
+                                 -- queued task
+  Semaphores.TC_Control_Message.Consume;  
+                                 -- wait for confirming message from task
+
+                                 -- Task 1 holds no resources
+                                 --   and is terminated (or will soon)
+                                 -- Tasks 2 and 3 hold resources
+                                 --   and are waiting for a call to Logout
+
+  Task3.Get_Status (User_Rec);
+  if (F940A00.Counter.Number /= 2)
+                      or (Semaphores.Login_Semaphore.Available /=0)
+                      or (Semaphores.TC_Key_Val (User_Rec) /= 3) then
+    Report.Failed ("Resource not properly released/assigned to task 3");
+  end if;
+
+  Task2.Logout;                  -- no outstanding request for released
+                                 -- resource
+                                 -- Tasks 1 and 2 hold no resources
+                                 -- Task 3 holds a resource
+                                 --   and is waiting for a call to Logout
+
+  if (F940A00.Counter.Number /= 1)
+                        or (Semaphores.Login_Semaphore.Available /=1) then
+    Report.Failed ("Resource not properly released from task 2");
+  end if;
+
+  Task3.Logout;
+
+                                 -- all resources have been returned
+                                 -- all tasks have terminated or will soon
+
+  if (F940A00.Counter.Number /=0)
+                          or (Semaphores.Login_Semaphore.Available /=2) then
+    Report.Failed ("Resource not properly released from task 3");
+  end if;
+
+  -- Ensure all tasks have terminated before calling Result
+  while not (Task1'terminated and     
+             Task2'terminated and
+             Task3'terminated)     loop
+    delay ImpDef.Minimum_Task_Switch;   
+  end loop;
+
+  Report.Result;
+
+end C940A03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95008a.ada
new file mode 100644
index 000000000..4343e651b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95008a.ada
@@ -0,0 +1,426 @@
+-- C95008A.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 EXCEPTION CONSTRAINT_ERROR IS RAISED FOR AN
+--   OUT-OF-RANGE INDEX VALUE WHEN REFERENCING AN ENTRY FAMILY,
+--   EITHER IN AN ACCEPT_STATEMENT OR IN AN ENTRY_CALL.
+
+-- SUBTESTS ARE:
+--   (A)  INTEGER TYPE, STATIC LOWER BOUND, NO PARAMETERS.
+--   (B)  CHARACTER TYPE, DYNAMIC UPPER BOUND, NO PARAMETERS.
+--   (C)  BOOLEAN TYPE, STATIC NULL RANGE, NO PARAMETERS.
+--   (D)  USER-DEFINED ENUMERATED TYPE, DYNAMIC LOWER BOUND, ONE
+--           PARAMETER.
+--   (E)  DERIVED INTEGER TYPE, DYNAMIC NULL RANGE, ONE PARAMETER.
+--   (F)  DERIVED USER-DEFINED ENUMERATED TYPE, STATIC UPPER BOUND,
+--           ONE PARAMETER.
+
+-- JRK 11/4/81
+-- JBG 11/11/84
+-- SAIC 11/14/95 fixed test for 2.0.1
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C95008A IS
+
+     C_E_NOT_RAISED : BOOLEAN;
+     WRONG_EXC_RAISED : BOOLEAN;
+
+BEGIN
+     TEST ("C95008A", "OUT-OF-RANGE ENTRY FAMILY INDICES IN " &
+                      "ACCEPT_STATEMENTS AND ENTRY_CALLS");
+
+     --------------------------------------------------
+
+     C_E_NOT_RAISED := FALSE;
+     WRONG_EXC_RAISED := FALSE;
+
+     DECLARE -- (A)
+
+          TASK T IS
+               ENTRY E (1..10);
+               ENTRY CONTINUE;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT CONTINUE;
+               SELECT
+                    ACCEPT E (0);
+               OR
+                    DELAY 1.0 * Impdef.One_Second;
+               END SELECT;
+               C_E_NOT_RAISED := TRUE;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    WRONG_EXC_RAISED := TRUE;
+          END T;
+
+     BEGIN -- (A)
+
+          SELECT
+               T.E (0);
+          OR
+               DELAY 15.0 * Impdef.One_Second;
+          END SELECT;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ENTRY_CALL - (A)");
+          T.CONTINUE;
+
+     EXCEPTION -- (A)
+
+          WHEN CONSTRAINT_ERROR =>
+               T.CONTINUE;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN " &
+                       "ENTRY_CALL - (A)");
+               T.CONTINUE;
+
+     END; -- (A)
+
+     IF C_E_NOT_RAISED THEN
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ACCEPT_STATEMENT - (A)");
+     END IF;
+
+     IF WRONG_EXC_RAISED THEN
+          FAILED ("WRONG EXCEPTION RAISED IN " &
+                  "ACCEPT_STATEMENT - (A)");
+     END IF;
+
+     --------------------------------------------------
+
+     C_E_NOT_RAISED := FALSE;
+     WRONG_EXC_RAISED := FALSE;
+
+     DECLARE -- (B)
+
+          TASK T IS
+               ENTRY E (CHARACTER RANGE 'A'..'Y');
+               ENTRY CONTINUE;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT CONTINUE;
+               SELECT
+                    ACCEPT E (IDENT_CHAR('Z'));
+               OR
+                    DELAY 1.0 * Impdef.One_Second;
+               END SELECT;
+               C_E_NOT_RAISED := TRUE;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    WRONG_EXC_RAISED := TRUE;
+          END T;
+
+     BEGIN -- (B)
+
+          SELECT
+               T.E (IDENT_CHAR('Z'));
+          OR
+               DELAY 15.0 * Impdef.One_Second;
+          END SELECT;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ENTRY_CALL - (B)");
+          T.CONTINUE;
+
+     EXCEPTION -- (B)
+
+          WHEN CONSTRAINT_ERROR =>
+               T.CONTINUE;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN " &
+                       "ENTRY_CALL - (B)");
+               T.CONTINUE;
+
+     END; -- (B)
+
+     IF C_E_NOT_RAISED THEN
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ACCEPT_STATEMENT - (B)");
+     END IF;
+
+     IF WRONG_EXC_RAISED THEN
+          FAILED ("WRONG EXCEPTION RAISED IN " &
+                  "ACCEPT_STATEMENT - (B)");
+     END IF;
+
+     --------------------------------------------------
+
+     C_E_NOT_RAISED := FALSE;
+     WRONG_EXC_RAISED := FALSE;
+
+     DECLARE -- (C)
+
+          TASK T IS
+               ENTRY E (TRUE..FALSE);
+               ENTRY CONTINUE;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT CONTINUE;
+               SELECT
+                    ACCEPT E (FALSE);
+               OR
+                    DELAY 1.0 * Impdef.One_Second;
+               END SELECT;
+               C_E_NOT_RAISED := TRUE;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    WRONG_EXC_RAISED := TRUE;
+          END T;
+
+     BEGIN -- (C)
+
+          SELECT
+               T.E (TRUE);
+          OR
+               DELAY 15.0 * Impdef.One_Second;
+          END SELECT;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ENTRY_CALL - (C)");
+          T.CONTINUE;
+
+     EXCEPTION -- (C)
+
+          WHEN CONSTRAINT_ERROR =>
+               T.CONTINUE;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN " &
+                       "ENTRY_CALL - (C)");
+               T.CONTINUE;
+
+     END; -- (C)
+
+     IF C_E_NOT_RAISED THEN
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ACCEPT_STATEMENT - (C)");
+     END IF;
+
+     IF WRONG_EXC_RAISED THEN
+          FAILED ("WRONG EXCEPTION RAISED IN " &
+                  "ACCEPT_STATEMENT - (C)");
+     END IF;
+
+     --------------------------------------------------
+
+     C_E_NOT_RAISED := FALSE;
+     WRONG_EXC_RAISED := FALSE;
+
+     DECLARE -- (D)
+
+          TYPE ET IS (E0, E1, E2);
+          DLB : ET := ET'VAL (IDENT_INT(1));      -- E1.
+
+          TASK T IS
+               ENTRY E (ET RANGE DLB..E2) (I : INTEGER);
+               ENTRY CONTINUE;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT CONTINUE;
+               SELECT
+                    ACCEPT E (E0) (I : INTEGER);
+               OR
+                    DELAY 1.0 * Impdef.One_Second;
+               END SELECT;
+               C_E_NOT_RAISED := TRUE;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    WRONG_EXC_RAISED := TRUE;
+          END T;
+
+     BEGIN -- (D)
+
+          SELECT
+               T.E (E0) (0);
+          OR
+               DELAY 15.0 * Impdef.One_Second;
+          END SELECT;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ENTRY_CALL - (D)");
+          T.CONTINUE;
+
+     EXCEPTION -- (D)
+
+          WHEN CONSTRAINT_ERROR =>
+               T.CONTINUE;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN " &
+                       "ENTRY_CALL - (D)");
+               T.CONTINUE;
+
+     END; -- (D)
+
+     IF C_E_NOT_RAISED THEN
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ACCEPT_STATEMENT - (D)");
+     END IF;
+
+     IF WRONG_EXC_RAISED THEN
+          FAILED ("WRONG EXCEPTION RAISED IN " &
+                  "ACCEPT_STATEMENT - (D)");
+     END IF;
+
+     --------------------------------------------------
+
+     C_E_NOT_RAISED := FALSE;
+     WRONG_EXC_RAISED := FALSE;
+
+     DECLARE -- (E)
+
+          TYPE D_I IS NEW INTEGER;
+          SUBTYPE DI IS D_I RANGE 3 .. D_I(IDENT_INT(2));
+
+          TASK T IS
+               ENTRY E (DI) (I : INTEGER);
+               ENTRY CONTINUE;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT CONTINUE;
+               SELECT
+                    ACCEPT E (D_I(3)) (I : INTEGER);
+               OR
+                    DELAY 1.0 * Impdef.One_Second;
+               END SELECT;
+               C_E_NOT_RAISED := TRUE;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    WRONG_EXC_RAISED := TRUE;
+          END T;
+
+     BEGIN -- (E)
+
+          SELECT
+               T.E (D_I(2)) (0);
+          OR
+               DELAY 15.0 * Impdef.One_Second;
+          END SELECT;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ENTRY_CALL - (E)");
+          T.CONTINUE;
+
+     EXCEPTION -- (E)
+
+          WHEN CONSTRAINT_ERROR =>
+               T.CONTINUE;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN " &
+                       "ENTRY_CALL - (E)");
+               T.CONTINUE;
+
+     END; -- (E)
+
+     IF C_E_NOT_RAISED THEN
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ACCEPT_STATEMENT - (E)");
+     END IF;
+
+     IF WRONG_EXC_RAISED THEN
+          FAILED ("WRONG EXCEPTION RAISED IN " &
+                  "ACCEPT_STATEMENT - (E)");
+     END IF;
+
+     --------------------------------------------------
+
+     C_E_NOT_RAISED := FALSE;
+     WRONG_EXC_RAISED := FALSE;
+
+     DECLARE -- (F)
+
+          TYPE ET IS (E0, E1, E2);
+          TYPE D_ET IS NEW ET;
+
+          TASK T IS
+               ENTRY E (D_ET RANGE E0..E1) (I : INTEGER);
+               ENTRY CONTINUE;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT CONTINUE;
+               SELECT
+                    ACCEPT E (D_ET'(E2)) (I : INTEGER);
+               OR
+                    DELAY 1.0 * Impdef.One_Second;
+               END SELECT;
+               C_E_NOT_RAISED := TRUE;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    WRONG_EXC_RAISED := TRUE;
+          END T;
+
+     BEGIN -- (F)
+
+          SELECT
+               T.E (D_ET'(E2)) (0);
+          OR
+               DELAY 15.0 * Impdef.One_Second;
+          END SELECT;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ENTRY_CALL - (F)");
+          T.CONTINUE;
+
+     EXCEPTION -- (F)
+
+          WHEN CONSTRAINT_ERROR =>
+               T.CONTINUE;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN " &
+                       "ENTRY_CALL - (F)");
+               T.CONTINUE;
+
+     END; -- (F)
+
+     IF C_E_NOT_RAISED THEN
+          FAILED ("CONSTRAINT_ERROR NOT RAISED IN " &
+                  "ACCEPT_STATEMENT - (F)");
+     END IF;
+
+     IF WRONG_EXC_RAISED THEN
+          FAILED ("WRONG EXCEPTION RAISED IN " &
+                  "ACCEPT_STATEMENT - (F)");
+     END IF;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95009a.ada
new file mode 100644
index 000000000..30830e96c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95009a.ada
@@ -0,0 +1,121 @@
+-- C95009A.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 TASK OBJECT CAN CALL ENTRIES OF OTHER TASKS.
+
+-- THIS TEST CONTAINS SHARED VARIABLES.
+
+-- JRK 11/5/81
+-- JRK 8/3/84
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95009A IS
+
+     V1 : INTEGER := 0;
+     V2 : INTEGER := 0;
+
+     PI : INTEGER := 0;
+     PO : INTEGER := 0;
+
+BEGIN
+     TEST ("C95009A", "CHECK THAT A TASK OBJECT CAN CALL ENTRIES " &
+                      "OF OTHER TASKS");
+
+     DECLARE
+
+          SUBTYPE INT IS INTEGER RANGE 1..5;
+
+          TASK T1 IS
+               ENTRY E1N;
+               ENTRY EF1P (INT) (I : OUT INTEGER);
+          END T1;
+
+          TASK TYPE T2T IS
+               ENTRY E2P (I : INTEGER);
+               ENTRY EF2N (INT);
+          END T2T;
+
+          TYPE AT2T IS ACCESS T2T;
+          AT2 : AT2T;
+
+          TASK BODY T1 IS
+          BEGIN
+               V1 := 1;
+               ACCEPT E1N;
+               V1 := 2;
+               AT2.E2P (1);
+               V1 := 3;
+               ACCEPT EF1P (2) (I : OUT INTEGER) DO
+                    I := 2;
+               END EF1P;
+               V1 := 4;
+               AT2.EF2N (IDENT_INT(3));
+               V1 := 5;
+          END T1;
+
+          TASK BODY T2T IS
+          BEGIN
+               V2 := 1;
+               T1.E1N;
+               V2 := 2;
+               ACCEPT E2P (I : INTEGER) DO
+                    PI := I;
+               END E2P;
+               V2 := 3;
+               T1.EF1P (2) (PO);
+               V2 := 4;
+               ACCEPT EF2N (1+IDENT_INT(2));
+               V2 := 5;
+          END T2T;
+
+          PACKAGE DUMMY IS
+          END DUMMY;
+
+          PACKAGE BODY DUMMY IS
+          BEGIN
+               AT2 := NEW T2T;
+          END DUMMY;
+
+     BEGIN
+          NULL;
+     END;
+
+     IF V1 /= 5 THEN
+          FAILED ("TASK T1 ONLY REACHED V1 = " & INTEGER'IMAGE(V1));
+     END IF;
+
+     IF V2 /= 5 THEN
+          FAILED ("TASK AT2 ONLY REACHED V2 = " & INTEGER'IMAGE(V2));
+     END IF;
+
+     IF PI /= 1 THEN
+          FAILED ("ENTRY IN PARAMETER NOT PASSED CORRECTLY");
+     END IF;
+
+     IF PO /= 2 THEN
+          FAILED ("ENTRY OUT PARAMETER NOT PASSED CORRECTLY");
+     END IF;
+
+     RESULT;
+END C95009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95010a.ada
new file mode 100644
index 000000000..362956058
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95010a.ada
@@ -0,0 +1,82 @@
+-- C95010A.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 TASK MAY CONTAIN MORE THAN ONE ACCEPT_STATEMENT
+--   FOR AN ENTRY.
+
+-- THIS TEST CONTAINS SHARED VARIABLES.
+
+-- JRK 11/5/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95010A IS
+
+     V : INTEGER := 0;
+
+BEGIN
+     TEST ("C95010A", "CHECK THAT A TASK MAY CONTAIN MORE THAN " &
+                      "ONE ACCEPT_STATEMENT FOR AN ENTRY");
+
+     DECLARE
+
+          SUBTYPE INT IS INTEGER RANGE 1..5;
+
+          TASK T IS
+               ENTRY E;
+               ENTRY EF (INT) (I : INTEGER);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               V := 1;
+               ACCEPT E;
+               V := 2;
+               ACCEPT E;
+               V := 3;
+               ACCEPT EF (2) (I : INTEGER) DO
+                    V := I;
+               END EF;
+               V := 5;
+               ACCEPT EF (2) (I : INTEGER) DO
+                    V := I;
+               END EF;
+               V := 7;
+          END T;
+
+     BEGIN
+
+          T.E;
+          T.E;
+          T.EF (2) (4);
+          T.EF (2) (6);
+
+     END;
+
+     IF V /= 7 THEN
+          FAILED ("WRONG CONTROL FLOW VALUE");
+     END IF;
+
+     RESULT;
+END C95010A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95011a.ada
new file mode 100644
index 000000000..1e91a847c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95011a.ada
@@ -0,0 +1,67 @@
+-- C95011A.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 TASK NEED NOT CONTAIN ANY ACCEPT_STATEMENTS FOR AN
+--   ENTRY.
+
+-- THIS TEST CONTAINS SHARED VARIABLES.
+
+-- JRK 11/5/81
+-- JWC 6/28/85   RENAMED TO -AB
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95011A IS
+
+     V : INTEGER := 0;
+
+BEGIN
+     TEST ("C95011A", "CHECK THAT A TASK NEED NOT CONTAIN ANY " &
+                      "ACCEPT_STATEMENTS FOR AN ENTRY");
+
+     DECLARE
+
+          SUBTYPE INT IS INTEGER RANGE 1..5;
+
+          TASK T IS
+               ENTRY E;
+               ENTRY EF (INT) (I : INTEGER);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               V := 1;
+          END T;
+
+     BEGIN
+
+          NULL;
+
+     END;
+
+     IF V /= 1 THEN
+          FAILED ("WRONG CONTROL FLOW VALUE");
+     END IF;
+
+     RESULT;
+END C95011A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95012a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95012a.ada
new file mode 100644
index 000000000..2f7efaacb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95012a.ada
@@ -0,0 +1,106 @@
+-- C95012A.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 CALL TO AN ENTRY OF A TASK THAT HAS NOT BEEN ACTIVATED
+--   DOES NOT RAISE EXCEPTIONS.
+
+-- THIS TEST CONTAINS RACE CONDITIONS.
+
+-- JRK 11/6/81
+-- SPS 11/21/82
+-- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C95012A IS
+
+     I : INTEGER := 0;
+
+
+BEGIN
+     TEST ("C95012A", "CHECK THAT A CALL TO AN ENTRY OF A TASK " &
+                      "THAT HAS NOT BEEN ACTIVATED DOES NOT " &
+                      "RAISE EXCEPTIONS");
+
+     DECLARE
+
+          TASK T1 IS
+               ENTRY E1 (I : OUT INTEGER);
+          END T1;
+
+          TASK TYPE T2T IS
+               ENTRY E2 (I : OUT INTEGER);
+          END T2T;
+
+          TYPE AT2T IS ACCESS T2T;
+          AT2 : AT2T;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT E1 (I : OUT INTEGER) DO
+                    I := IDENT_INT (1);
+               END E1;
+          END T1;
+
+          TASK BODY T2T IS
+               J : INTEGER := 0;
+          BEGIN
+               BEGIN
+                    T1.E1 (J);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         J := -1;
+               END;
+               ACCEPT E2 (I : OUT INTEGER) DO
+                    I := J;
+               END E2;
+          END T2T;
+
+          PACKAGE PKG IS
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               AT2 := NEW T2T;
+               DELAY 60.0 * Impdef.One_Second;
+          END PKG;
+
+     BEGIN
+
+          AT2.ALL.E2 (I);
+
+          IF I = -1 THEN 
+               FAILED ("EXCEPTION RAISED");
+               T1.E1 (I);
+          END IF;
+
+          IF I /= 1 THEN
+               FAILED ("WRONG VALUE PASSED");
+          END IF;
+
+     END;
+
+     RESULT;
+END C95012A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95021a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95021a.ada
new file mode 100644
index 000000000..a0c047bad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95021a.ada
@@ -0,0 +1,182 @@
+-- C95021A.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 CALLS TO AN ENTRY ARE PLACED IN A FIFO QUEUE.
+
+-- JBG 2/22/84
+-- DAS 10/8/90  ADDED PRAGMA PRIORITY TO ENSURE THAT THE FIFO
+--              DISCIPLINE MUST BE FOLLOWED (OTHERWISE THE
+--              IMPLEMENTATION MIGHT PROHIBIT QUEUES FROM
+--              FORMING SO THAT E'COUNT IS ALWAYS ZERO FOR
+--              AN ENTRY E).
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+-- THE TASK QUEUE IS THE TASK THAT CHECKS THE QUEUEING DISCIPLINE.
+--
+-- THIS TEST PLACES TWO CALLS ON AN ENTRY, WAITS UNTIL ONE OF THE CALLS
+-- IS ACCEPTED, AND THEN PLACES A THIRD CALL ON THE ENTRY.  THE TEST
+-- CHECKS THAT THE SECOND CALL IS HANDLED BEFORE THE THIRD.  (IT IS
+-- NONDETERMINISTIC WHICH CALL WILL BE THE FIRST ONE ON THE QUEUE, SO
+-- THIS MORE COMPLICATED APPROACH IS NECESSARY.)
+--
+-- THE TASK DISPATCH FIRES UP THE TWO TASKS THAT MAKE THE FIRST TWO
+-- CALLS AND THEN WAITS UNTIL QUEUE SAYS IT IS READY FOR THE THIRD CALL.
+--
+-- THE TASK TYPE CALLERS IS USED TO CREATE TASKS THAT WILL CALL THE
+-- ENTRY IN THE TASK QUEUE.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM;
+PROCEDURE C95021A IS
+BEGIN
+
+     TEST ("C95021A", "CHECK THAT ENTRY CALLS ARE PUT IN FIFO QUEUES");
+
+-- DO THIS TEST 3 TIMES TO ALLOW FOR RANDOM VARIATIONS IN TIMING.
+     FOR I IN 1..3 LOOP  
+          COMMENT ("ITERATION" & INTEGER'IMAGE(I));
+
+     DECLARE
+
+          TASK TYPE CALLERS IS
+               ENTRY NAME (N : NATURAL);
+          END CALLERS;
+
+          TASK QUEUE IS
+               ENTRY GO;
+               ENTRY E1 (NAME : NATURAL);
+          END QUEUE;
+
+          TASK DISPATCH IS
+               ENTRY READY;
+          END DISPATCH;
+
+          TASK BODY CALLERS IS
+               MY_NAME : NATURAL;
+          BEGIN
+
+-- GET NAME OF THIS TASK OBJECT
+               ACCEPT NAME (N : NATURAL) DO
+                    MY_NAME := N;
+               END NAME;
+
+-- PUT THIS TASK ON QUEUE FOR QUEUE.E1
+               QUEUE.E1 (MY_NAME);
+          END CALLERS;
+
+          TASK BODY DISPATCH IS
+               TYPE ACC_CALLERS IS ACCESS CALLERS;
+               OBJ : ACC_CALLERS;
+          BEGIN
+
+-- FIRE UP TWO CALLERS FOR QUEUE.E1
+               OBJ := NEW CALLERS;
+               OBJ.NAME(1);
+               OBJ := NEW CALLERS;
+               OBJ.NAME(2);
+
+-- ALLOW THESE CALLS TO BE PROCESSED (ONLY ONE WILL BE ACCEPTED).
+               QUEUE.GO;
+
+-- WAIT TILL ONE CALL HAS BEEN PROCESSED.
+               ACCEPT READY;       -- CALLED FROM QUEUE
+
+-- FIRE UP THIRD CALLER
+               OBJ := NEW CALLERS;
+               OBJ.NAME(3);
+
+          END DISPATCH;
+
+          TASK BODY QUEUE IS
+               NEXT : NATURAL;     -- NUMBER OF SECOND CALLER IN QUEUE.
+          BEGIN
+
+-- WAIT UNTIL TWO TASKS CALLING E1 HAVE BEEN ACTIVATED.
+               ACCEPT GO;
+
+-- WAIT FOR TWO CALLS TO BE AVAILABLE.  THIS WAIT ASSUMES THAT THE
+-- CALLER TASKS WILL PROCEED IF THIS TASK IS EXECUTING A DELAY
+-- STATEMENT, ALTHOUGH THIS IS NOT STRICTLY REQUIRED BY THE STANDARD.
+               FOR I IN 1..6       -- WILL WAIT FOR ONE MINUTE
+               LOOP
+                    EXIT WHEN E1'COUNT = 2;
+                    DELAY 10.0 * Impdef.One_Second;    -- WAIT FOR CALLS TO ARRIVE
+               END LOOP;
+
+               IF E1'COUNT /= 2 THEN
+                    FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
+                            "MINUTE - 1");
+               END IF;
+
+-- ASSUMING NO FAILURE, PROCESS ONE OF THE QUEUED CALLS.
+               ACCEPT E1 (NAME : NATURAL) DO
+
+-- GET NAME OF NEXT CALLER
+                    CASE NAME IS
+                         WHEN 1 => 
+                              NEXT := 2;
+                         WHEN 2 => 
+                              NEXT := 1;
+                         WHEN OTHERS => 
+                              FAILED ("UNEXPECTED ERROR");
+                    END CASE;
+               END E1;
+
+-- TELL DISPATCH TO FIRE UP NEXT CALLER (ONE IS STILL IN QUEUE).
+               DISPATCH.READY;
+
+-- WAIT FOR CALL TO ARRIVE.
+               FOR I IN 1..6       -- WILL WAIT FOR ONE MINUTE
+               LOOP
+                    EXIT WHEN E1'COUNT = 2;
+                    DELAY 10.0 * Impdef.One_Second;    -- WAIT FOR CALLS TO ARRIVE
+               END LOOP;
+
+               IF E1'COUNT /= 2 THEN
+                    FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
+                            "MINUTE - 2");
+               END IF;
+
+-- ASSUMING NO FAILURE, ACCEPT SECOND CALL AND CHECK THAT IT IS FROM THE
+-- CORRECT TASK.
+               ACCEPT E1 (NAME : NATURAL) DO
+                    IF NAME /= NEXT THEN
+                         FAILED ("FIFO DISCIPLINE NOT OBEYED");
+                    END IF;
+               END E1;
+
+-- ACCEPT THE LAST CALLER
+               ACCEPT E1 (NAME : NATURAL);
+
+          END QUEUE;
+
+     BEGIN
+          NULL;
+     END;           -- ALL TASKS NOW TERMINATED.
+     END LOOP;
+
+     RESULT;
+
+END C95021A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95022a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95022a.ada
new file mode 100644
index 000000000..c7e4bcbe2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95022a.ada
@@ -0,0 +1,115 @@
+--C95022A.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 IT IS POSSIBLE TO ACCEPT AN ENTRY CALL FROM INSIDE THE
+--THE BODY OF AN ACCEPT STATEMENT.
+
+--CHECK THE CASE OF NORMAL ENTRY TERMINATION.
+
+-- JEAN-PIERRE ROSEN 25-FEB-1984
+-- JBG 6/1/84
+
+-- FOUR CLIENT TASKS CALL ONE SERVER TASK.  EACH CLIENT CALLS JUST ONE
+-- ENTRY OF THE SERVER TASK.  THE TEST CHECKS TO BE SURE THAT CALLS FROM
+-- DIFFERENT TASKS ARE NOT MIXED UP.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95022A IS
+
+BEGIN
+     TEST("C95022A", "CHECK THAT EMBEDDED RENDEZVOUS ARE PROCESSED " &
+                     "CORRECTLY");
+     DECLARE
+
+          TASK TYPE CLIENT IS
+               ENTRY GET_ID (I : INTEGER);
+               ENTRY RESTART;
+          END CLIENT;
+     
+          T_ARR : ARRAY (1..4) OF CLIENT;
+     
+          TASK SERVER IS
+               ENTRY E1 (I : IN OUT INTEGER);
+               ENTRY E2 (I : IN OUT INTEGER);
+               ENTRY E3 (I : IN OUT INTEGER);
+               ENTRY E4 (I : IN OUT INTEGER);
+          END SERVER;
+     
+          TASK BODY SERVER IS
+          BEGIN
+     
+               ACCEPT E1 (I : IN OUT INTEGER) DO
+                    ACCEPT E2 (I : IN OUT INTEGER) DO
+                         I := IDENT_INT(I);
+                         ACCEPT E3 (I : IN OUT INTEGER) DO
+                              ACCEPT E4 (I : IN OUT INTEGER) DO
+                                   I := IDENT_INT(I);
+                              END E4;
+                              I := IDENT_INT(I);
+                         END E3;
+                    END E2;
+                    I := IDENT_INT(I);
+               END E1;
+     
+               FOR I IN 1 .. 4 LOOP
+                    T_ARR(I).RESTART;
+               END LOOP;
+          END SERVER;
+     
+          TASK BODY CLIENT IS
+               ID      : INTEGER;
+               SAVE_ID : INTEGER;
+          BEGIN
+               ACCEPT GET_ID (I : INTEGER) DO
+                    ID := I;
+               END GET_ID;
+     
+               SAVE_ID := ID;
+     
+               CASE ID IS
+                    WHEN 1      => SERVER.E1(ID);
+                    WHEN 2      => SERVER.E2(ID);
+                    WHEN 3      => SERVER.E3(ID);
+                    WHEN 4      => SERVER.E4(ID);
+                    WHEN OTHERS => FAILED("INCORRECT ID");
+               END CASE;
+
+               ACCEPT RESTART;  -- WAIT FOR ALL TASKS TO HAVE COMPLETED
+                                -- RENDEZVOUS
+               IF ID /= SAVE_ID THEN
+                    FAILED("SCRAMBLED EMBEDDED RENDEZVOUS");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS => FAILED("EXCEPTION IN CLIENT");
+          END CLIENT;
+     
+     BEGIN
+          FOR I IN 1 .. 4 LOOP
+               T_ARR(I).GET_ID(I);
+          END LOOP;
+     END;
+
+     RESULT;
+
+END C95022A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95022b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95022b.ada
new file mode 100644
index 000000000..cd1e3ff5b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95022b.ada
@@ -0,0 +1,112 @@
+-- C95022B.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 IT IS POSSIBLE TO ACCEPT AN ENTRY CALL FROM INSIDE
+-- THE BODY OF AN ACCEPT STATEMENT.
+
+-- CHECK THE CASE OF ABORT DURING THE INNERMOST ACCEPT.
+
+-- JEAN-PIERRE ROSEN 25-FEB-1984
+-- JBG 6/1/84
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95022B IS
+
+BEGIN
+
+     TEST("C95022B", "CHECK THAT EMBEDDED RENDEZVOUS ARE PROCESSED " &
+                     "CORRECTLY (ABORT CASE)");
+     DECLARE
+          TASK TYPE CLIENT IS
+               ENTRY GET_ID (I : INTEGER);
+          END CLIENT;
+     
+          T_ARR : ARRAY (1..4) OF CLIENT;
+     
+          TASK KILL IS
+               ENTRY ME;
+          END KILL;
+     
+          TASK SERVER IS
+               ENTRY E1;
+               ENTRY E2;
+               ENTRY E3;
+               ENTRY E4;
+          END SERVER;
+     
+          TASK BODY SERVER IS
+          BEGIN
+     
+               ACCEPT E1 DO
+                    ACCEPT E2 DO
+                         ACCEPT E3 DO
+                              ACCEPT E4 DO
+                                   KILL.ME;
+                                   E1;  -- WILL DEADLOCK UNTIL ABORT.
+                              END E4;
+                         END E3;
+                    END E2;
+               END E1;
+     
+          END SERVER;
+     
+          TASK BODY KILL IS
+          BEGIN
+               ACCEPT ME;
+               ABORT SERVER;
+          END;
+
+          TASK BODY CLIENT IS
+               ID : INTEGER;
+          BEGIN
+               ACCEPT GET_ID( I : INTEGER) DO
+                    ID := I;
+               END GET_ID;
+     
+               CASE ID IS
+                    WHEN 1      => SERVER.E1;
+                    WHEN 2      => SERVER.E2;
+                    WHEN 3      => SERVER.E3;
+                    WHEN 4      => SERVER.E4;
+                    WHEN OTHERS => FAILED ("INCORRECT ID");
+               END CASE;
+     
+               FAILED ("TASKING_ERROR NOT RAISED IN CLIENT" & 
+                       INTEGER'IMAGE(ID));
+     
+          EXCEPTION
+               WHEN TASKING_ERROR => 
+                    NULL;
+               WHEN OTHERS => 
+                    FAILED("EXCEPTION IN CLIENT" & INTEGER'IMAGE(ID));
+          END CLIENT;
+     BEGIN
+          FOR I IN 1 .. 4 LOOP
+               T_ARR(I).GET_ID(I);
+          END LOOP;
+     END;
+
+     RESULT;
+
+END C95022B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95033a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95033a.ada
new file mode 100644
index 000000000..53c354856
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95033a.ada
@@ -0,0 +1,74 @@
+-- C95033A.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 THE CASE OF AN ENTRY FAMILY - EXECUTION OF AN
+-- ACCEPT STATEMENT STARTS WITH THE EVALUATION OF AN ENTRY INDEX.
+
+-- WEI  3/ 4/82
+-- JWC 6/28/85   RENAMED FROM C950BGA-B.ADA
+
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C95033A IS
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+     END PSPY_NUMB;
+
+     FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+          RETURN DIGT;
+     END FINIT_POS;
+
+     TASK T1 IS
+          ENTRY E1 (NATURAL RANGE 1 .. 2);
+          ENTRY BYE;
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          ACCEPT E1 (FINIT_POS (1)) DO
+               PSPY_NUMB (2);
+          END E1;
+          ACCEPT BYE;
+     END T1;
+
+BEGIN
+     TEST ("C95033A", "EVALUATION OF ENTRY INDEX");
+
+     T1.E1 (1);
+     T1.BYE;
+     IF SPYNUMB /= 12 THEN
+          FAILED ("ENTRY INDEX NOT EVALUATED FIRST");
+          COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+     END IF;
+
+     RESULT;
+
+END C95033A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95033b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95033b.ada
new file mode 100644
index 000000000..a72f3b6a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95033b.ada
@@ -0,0 +1,67 @@
+-- C95033B.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 EXECUTION OF AN ENTRY CALL STARTS WITH THE EVALUATION OF
+-- ANY ENTRY INDEX, FOLLOWED BY THE EVALUATION OF ANY EXPRESSION IN
+-- THE PARAMETER LIST.
+
+-- WEI  3/ 4/82
+-- JWC 6/28/85   RENAMED FROM C950BHA-B.ADA
+
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C95033B IS
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     FUNCTION FINIT_POS (DIGT: IN ARG) RETURN NATURAL IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+          RETURN DIGT;
+     END FINIT_POS;
+
+     TASK T1 IS
+          ENTRY E1 (NATURAL RANGE 1 .. 2) (P1 : IN NATURAL);
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          ACCEPT E1 (1) (P1 : IN NATURAL);
+     END T1;
+
+BEGIN
+
+     TEST ("C95033B", "EVALUATION OF ENTRY INDEX AND OF " &
+                      "EXPRESSIONS IN PARAMETER LIST");
+
+     T1.E1 (FINIT_POS (1)) (FINIT_POS (2));
+     IF SPYNUMB /= 12 THEN
+          FAILED ("ENTRY INDEX NOT EVALUATED FIRST");
+          COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+     END IF;
+
+     RESULT;
+
+END C95033B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95034a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95034a.ada
new file mode 100644
index 000000000..c597bf25f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95034a.ada
@@ -0,0 +1,85 @@
+-- C95034A.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 CALLING TASK IS SUSPENDED IF THE RECEIVING TASK
+-- HAS NOT REACHED A CORRESPONDING ACCEPT STATEMENT.
+
+-- WEI  3/ 4/82
+-- JWC 6/28/85   RENAMED FROM C950BJA-B.ADA
+
+with Impdef;
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C95034A IS
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+     END PSPY_NUMB;
+
+     TASK T1 IS
+          ENTRY E1;
+          ENTRY E2;
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          ACCEPT E1 DO
+               PSPY_NUMB (1);
+               DELAY 1.0 * Impdef.One_Second;
+          END E1;
+          ACCEPT E2 DO
+               PSPY_NUMB (2);
+          END E2;
+     END T1;
+
+     TASK T2 IS
+          ENTRY BYE;
+     END T2;
+
+     TASK BODY T2 IS
+     BEGIN
+          T1.E2;
+          PSPY_NUMB (3);
+          ACCEPT BYE;
+     END T2;
+
+BEGIN
+
+     TEST ("C95034A", "SUSPENSION OF CALLING TASK");
+
+     T1.E1;
+     T2.BYE;
+
+     IF SPYNUMB /= 123 THEN
+          FAILED ("ERROR DURING TASK EXECUTION");
+          COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+     END IF;
+
+     RESULT;
+
+END C95034A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95034b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95034b.ada
new file mode 100644
index 000000000..3c491e70a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95034b.ada
@@ -0,0 +1,83 @@
+-- C95034B.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 CALLING TASK REMAINS SUSPENDED UNTIL THE ACCEPT
+-- STATEMENT RECEIVING THIS ENTRY CALL HAS COMPLETED THE EXECUTION OF
+-- ITS SEQUENCE OF STATEMENTS.
+
+-- WEI  3/ 4/82
+-- JWC 6/28/85   RENAMED FROM C950CBA-B.ADA
+
+with Impdef;
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C95034B IS
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+     END PSPY_NUMB;
+
+     TASK T1 IS
+          ENTRY E1;
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          ACCEPT E1 DO
+               PSPY_NUMB (1);
+               DELAY 1.0 * Impdef.One_Second;
+               PSPY_NUMB (2);
+          END E1;
+     END T1;
+
+     TASK T2 IS
+          ENTRY BYE;
+     END T2;
+
+     TASK BODY T2 IS
+     BEGIN
+          T1.E1;
+          PSPY_NUMB (3);
+          ACCEPT BYE;
+     END T2;
+
+BEGIN
+
+     TEST ("C95034B", "TASK SUSPENSION UNTIL COMPLETION OF ACCEPT " &
+                      "STATEMENT");
+
+     T2.BYE;
+
+     IF SPYNUMB /= 123 THEN
+          FAILED ("ERROR DURING TASK EXECUTION");
+          COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+     END IF;
+
+     RESULT;
+
+END C95034B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95035a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95035a.ada
new file mode 100644
index 000000000..ce7816628
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95035a.ada
@@ -0,0 +1,78 @@
+-- C95035A.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 TASK IS SUSPENDED IF IT REACHES AN ACCEPT STATEMENT
+-- PRIOR TO ANY CALL OF THE CORRESPONDING ENTRY.
+
+-- WEI  3/ 4/82
+-- JWC 6/28/85   RENAMED FROM C950CAA-B.ADA
+
+with Impdef;
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C95035A IS
+
+     SUBTYPE ARG IS NATURAL RANGE 0..9;
+     SPYNUMB : NATURAL := 0;
+
+     PROCEDURE PSPY_NUMB (DIGT: IN ARG) IS
+     BEGIN
+          SPYNUMB := 10*SPYNUMB+DIGT;
+     END PSPY_NUMB;
+
+     TASK T1 IS
+          ENTRY E1;
+          ENTRY BYE;
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          ACCEPT E1;
+          PSPY_NUMB (2);
+          ACCEPT BYE;
+     END T1;
+
+     TASK T2;
+
+     TASK BODY T2 IS
+     BEGIN
+          DELAY 1.0 * Impdef.One_Second;
+          PSPY_NUMB (1);
+          T1.E1;
+     END T2;
+
+BEGIN
+
+     TEST ("C95035A", "TASK SUSPENSION PRIOR TO ENTRY CALL");
+
+     T1.BYE;
+
+     IF SPYNUMB /= 12 THEN
+          FAILED ("ERROR DURING TASK EXECUTION");
+          COMMENT ("ACTUAL ORDER WAS:" & INTEGER'IMAGE(SPYNUMB));
+     END IF;
+
+     RESULT;
+
+END C95035A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040a.ada
new file mode 100644
index 000000000..aa302bd1e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040a.ada
@@ -0,0 +1,59 @@
+-- C95040A.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 EXCEPTION TASKING_ERROR IS RAISED IF AN ENTRY OF A
+-- COMPLETED TASK IS CALLED.
+
+-- WEI  3/ 4/82
+-- JWC 6/28/85   RENAMED FROM C950CHA-B.ADA
+
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C95040A IS
+BEGIN
+
+     TEST ("C95040A", "ENTRY CALL OF COMPLETED TASK");
+
+BLOCK1 :
+     DECLARE
+          TASK T1 IS
+               ENTRY E1;
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT E1;
+          END T1;
+     BEGIN  -- BLOCK1
+          T1.E1;
+          T1.E1;
+
+          FAILED ("DID NOT RAISE TASKING_ERROR");
+     EXCEPTION
+          WHEN TASKING_ERROR => NULL;
+     END BLOCK1;
+
+     RESULT;
+
+END C95040A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040b.ada
new file mode 100644
index 000000000..aee275f28
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040b.ada
@@ -0,0 +1,63 @@
+-- C95040B.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 EXCEPTION TASKING_ERROR IS RAISED BY A TASK IF THE
+-- TASK BECOMES COMPLETED OR ABNORMAL BEFORE ACCEPTING THE CALL.
+
+-- WEI  3/ 4/82
+-- TLB 10/30/87  RENAMED FROM C950CHC.ADA.
+
+with Impdef;
+WITH REPORT;
+ USE REPORT;
+PROCEDURE C95040B IS
+
+     TASK T1 IS
+          ENTRY E1;
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          DELAY 1.0 * Impdef.One_Second;
+          IF EQUAL (1, 1) THEN
+               ABORT T1;
+          END IF;
+          ACCEPT E1;
+     END T1;
+
+BEGIN
+
+     TEST ("C95040B", "TASK COMPLETION BEFORE ACCEPTING AN ENTRY CALL");
+
+     T1.E1;
+
+     FAILED ("NO EXCEPTION TASKING_ERROR RAISED");
+
+     RESULT;
+
+EXCEPTION
+     WHEN TASKING_ERROR =>
+          RESULT;
+
+END C95040B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040c.ada
new file mode 100644
index 000000000..cc7db5804
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040c.ada
@@ -0,0 +1,86 @@
+-- C95040C.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.
+--*
+-- CHECKS THAT A TASK COMPLETED, BUT NOT TERMINATED (I.E. WAITING
+-- FOR TERMINATION OF A DEPENDENT TASK) IS NEITHER 'TERMINATED NOR
+-- 'CALLABLE.  CALLS TO ENTRIES BELONGING TO SUCH A TASK RAISE
+-- TASKING_ERROR.
+
+-- J.P. ROSEN, ADA PROJECT, NYU
+-- JBG 6/1/84
+-- JWC 6/28/85   RENAMED FROM C9A009A-B.ADA
+-- PWN 9/11/94   REMOVED PRAGMA PRIORITY FOR ADA 9X
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C95040C IS
+BEGIN
+
+     TEST ("C95040C", "TASKING_ERROR RAISED WHEN CALLING COMPLETED " &
+                      "BUT UNTERMINATED TASK");
+
+     DECLARE
+
+          TASK T1 IS
+               ENTRY E;
+          END T1;
+
+          TASK BODY T1 IS
+
+               TASK T2 IS
+               END T2;
+
+               TASK BODY T2 IS
+               BEGIN
+                    COMMENT ("BEGIN T2");
+                    T1.E;          -- T1 WILL COMPLETE BEFORE THIS CALL
+                                   -- OR WHILE WAITING FOR THIS CALL TO
+                                   -- BE ACCEPTED.  WILL DEADLOCK IF
+                                   -- TASKING_ERROR IS NOT RAISED.
+                    FAILED ("NO TASKING_ERROR RAISED");
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         IF T1'CALLABLE THEN
+                              FAILED ("T1 STILL CALLABLE");
+                         END IF;
+
+                         IF T1'TERMINATED THEN    -- T1 CAN'T TERMINATE
+                                                  -- UNTIL T2 HAS
+                                                  -- TERMINATED.
+                              FAILED ("T1 TERMINATED");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION");
+               END T2;
+          BEGIN
+               NULL;
+          END;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+
+END C95040C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040d.ada
new file mode 100644
index 000000000..cfe0a772d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040d.ada
@@ -0,0 +1,122 @@
+-- C95040D.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 TASKING_ERROR IS RAISED IN A CALLING
+-- TASK WHEN THE TASK OWNING THE ENTRY TERMINATES BEFORE RENDEZVOUS
+-- CAN OCCUR.
+
+-- CHECK THAT RE-RAISING TASKING_ERROR, ONCE TRAPPED IN THE CALLER,
+-- DOES NOT PROPAGATE OUTSIDE THE TASK BODY.
+
+-- GOM 11/29/84
+-- JWC 05/14/85
+-- PWB 02/11/86  CORRECTED CALL TO TEST TO SHOW CORRECT TEST NAME.
+-- RLB 12/15/99  REMOVED POTENTIALLY ERRONEOUS CALLS TO REPORT.COMMENT.
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE C95040D IS
+
+     PROCEDURE DRIVER IS
+
+          TASK NEST IS
+               ENTRY OUTER;
+               ENTRY INNER;
+          END NEST;
+
+          TASK SLAVE;
+
+          TASK BODY NEST IS
+          BEGIN
+               --COMMENT("AT TOP OF 'NEST' TASK WAITING ON 'OUTER' " &
+               --        "RENDEZVOUS");
+
+               ACCEPT OUTER DO
+                    --COMMENT("IN 'OUTER' RENDEZVOUS OF 'NEST' TASK " &
+                    --        "ABOUT TO 'RETURN'");
+
+                    RETURN;  -- CAUSES 'INNER' RENDEZVOUS TO BE SKIPPED.
+
+                    ACCEPT INNER DO
+                         FAILED("'INNER' RENDEZVOUS OF 'NEST' TASK " &
+                                "SHOULD NEVER BE PERFORMED");
+                    END INNER;
+               END OUTER;
+
+               --COMMENT("'OUTER' RENDEZVOUS COMPLETED IN 'NEST' TASK " &
+               --        "AND NOW TERMINATING");
+          END NEST;
+
+          TASK BODY SLAVE IS
+          BEGIN
+               --COMMENT("AT TOP OF 'SLAVE' TASK. CALLING 'INNER' " &
+               --        "RENDEZVOUS");
+
+               NEST.INNER;
+
+               FAILED("SHOULD HAVE RAISED 'TASKING_ERROR' IN 'SLAVE' " &
+                      "TASK");
+          EXCEPTION
+               WHEN TASKING_ERROR =>
+                    --COMMENT("'SLAVE' TASK CORRECTLY TRAPPING " &
+                    --        "'TASKING_ERROR' AND RE-RAISING IT (BUT " &
+                    --        "SHOULD NOT BE PROPAGATED)");
+                    RAISE;
+          END SLAVE;
+
+     BEGIN  -- START OF DRIVER PROCEDURE.
+
+          --COMMENT("AT TOP OF 'DRIVER'. CALLING 'OUTER' ENTRY OF " &
+          --        "'NEST' TASK");
+
+          NEST.OUTER;
+
+          --COMMENT("'OUTER' RENDEZVOUS COMPLETED. 'DRIVER' AWAITING " &
+          --        "TERMINATION OF 'NEST' AND 'SLAVE' TASKS");
+
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               FAILED("'TASKING_ERROR' CAUGHT IN 'DRIVER' WHEN IT " &
+                      "SHOULD HAVE BEEN CAUGHT IN 'SLAVE' TASK, OR " &
+                      "'TASKING_ERROR' WAS INCORRECTLY PROPAGATED BY " &
+                      "'SLAVE' TASK");
+     END DRIVER;
+
+BEGIN  -- START OF MAIN PROGRAM.
+
+     TEST("C95040D","CHECK THAT 'TASKING_ERROR' IS RAISED IN A " &
+                    "CALLER TASK WHEN TASK OWNING THE ENTRY CANNOT " &
+                    "PERFORM RENDEZVOUS. ALSO CHECK THAT " &
+                    "'TASKING_ERROR', ONCE RAISED, IS NOT PROPAGATED " &
+                    "OUTSIDE THE TASK BODY");
+
+     --COMMENT("MAIN PROGRAM CALLING 'DRIVER' PROCEDURE");
+
+     DRIVER;
+
+     --COMMENT("MAIN PROGRAM NOW TERMINATING");
+
+     RESULT;
+END C95040D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95041a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95041a.ada
new file mode 100644
index 000000000..4f676b3c4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95041a.ada
@@ -0,0 +1,97 @@
+-- C95041A.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 ENTRY FAMILY INDEX CAN BE SPECIFIED WITH THE FORM
+--     A'RANGE.
+
+-- HISTORY:
+--     DHH 03/17/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95041A IS
+
+     GLOBAL_A, GLOBAL_B : INTEGER;
+     GLOBAL_C, GLOBAL_D : INTEGER;
+     TYPE COLOR IS (RED, BLUE, YELLOW);
+     TYPE ARR IS ARRAY(COLOR RANGE RED .. BLUE) OF BOOLEAN;
+     ARRY : ARR;
+
+     TASK CHECK IS
+          ENTRY CHECK_LINK(ARR'RANGE)(I : INTEGER);
+     END CHECK;
+
+     TASK CHECK_OBJ IS
+          ENTRY CHECK_OBJ_LINK(ARRY'RANGE)(I : INTEGER);
+     END CHECK_OBJ;
+
+     TASK BODY CHECK IS
+     BEGIN
+               ACCEPT CHECK_LINK(RED)(I : INTEGER) DO
+                    GLOBAL_A := IDENT_INT(I);
+               END;
+
+               ACCEPT CHECK_LINK(BLUE)(I : INTEGER) DO
+                    GLOBAL_B := IDENT_INT(I);
+               END;
+     END CHECK;
+
+     TASK BODY CHECK_OBJ IS
+     BEGIN
+               ACCEPT CHECK_OBJ_LINK(RED)(I : INTEGER) DO
+                    GLOBAL_C := IDENT_INT(I);
+               END;
+
+               ACCEPT CHECK_OBJ_LINK(BLUE)(I : INTEGER) DO
+                    GLOBAL_D := IDENT_INT(I);
+               END;
+     END CHECK_OBJ;
+
+BEGIN
+     TEST("C95041A", "CHECK THAT AN ENTRY FAMILY INDEX CAN BE " &
+                     "SPECIFIED WITH THE FORM A'RANGE");
+     CHECK.CHECK_LINK(RED)(10);
+     CHECK.CHECK_LINK(BLUE)(5);
+
+     CHECK_OBJ.CHECK_OBJ_LINK(RED)(10);
+     CHECK_OBJ.CHECK_OBJ_LINK(BLUE)(5);
+
+     IF GLOBAL_A /= IDENT_INT(10) THEN
+          FAILED("ENTRY CHECK_LINK(RED) HAS INCORRECT VALUE");
+     END IF;
+
+     IF GLOBAL_B /= IDENT_INT(5) THEN
+          FAILED("ENTRY CHECK_LINK(BLUE) HAS INCORRECT VALUE");
+     END IF;
+
+     IF GLOBAL_C /= IDENT_INT(10) THEN
+          FAILED("ENTRY CHECK_LINK(RED) HAS INCORRECT VALUE");
+     END IF;
+
+     IF GLOBAL_D /= IDENT_INT(5) THEN
+          FAILED("ENTRY CHECK_LINK(BLUE) HAS INCORRECT VALUE");
+     END IF;
+
+     RESULT;
+END C95041A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065a.ada
new file mode 100644
index 000000000..2224dddcd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065a.ada
@@ -0,0 +1,91 @@
+-- C95065A.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 NOT RAISED WHEN AN ENTRY IS DECLARED
+-- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+-- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+-- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+
+-- CASE (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
+--          INITIALIZED WITH A STATIC AGGREGATE.
+
+-- JWC 6/19/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95065A IS
+
+BEGIN
+
+     TEST ("C95065A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                      "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                      "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                      "FORMAL PART IS ELABORATED");
+
+     BEGIN
+
+          DECLARE
+
+               TYPE A1 IS ARRAY (1 .. IDENT_INT(1), 1 .. IDENT_INT(10))
+                                OF INTEGER;
+
+               TASK T IS
+                    ENTRY E1 (A : A1 := ((1, 0), (0, 1)));
+               END T;
+
+               TASK BODY T IS
+               BEGIN
+                    SELECT
+                         ACCEPT E1 (A : A1 := ((1, 0), (0, 1))) DO
+                              FAILED ("ACCEPT E1 EXECUTED");
+                         END E1;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN TASK T");
+               END T;
+
+          BEGIN
+               T.E1;
+               FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - E1");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+
+END C95065A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065b.ada
new file mode 100644
index 000000000..81226af3a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065b.ada
@@ -0,0 +1,91 @@
+-- C95065B.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 NOT RAISED WHEN AN ENTRY IS DECLARED
+-- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+-- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+-- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+
+-- CASE (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
+--          INITIALIZED WITH A STATIC VALUE.
+
+-- JWC 6/19/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95065B IS
+
+BEGIN
+
+     TEST ("C95065B", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                      "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                      "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                      "FORMAL PART IS ELABORATED");
+
+     BEGIN
+
+          DECLARE
+
+               SUBTYPE INT IS INTEGER
+                              RANGE IDENT_INT(0) .. IDENT_INT(63);
+
+               TASK T IS
+                    ENTRY E1 (I : INT := -1);
+               END T;
+
+               TASK BODY T IS
+               BEGIN
+                    SELECT
+                         ACCEPT E1 (I : INT := -1) DO
+                              FAILED ("ACCEPT E1 EXECUTED");
+                         END E1;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN TASK T");
+               END T;
+
+          BEGIN
+               T.E1;
+               FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - E1");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+
+END C95065B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065c.ada
new file mode 100644
index 000000000..3a7732e87
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065c.ada
@@ -0,0 +1,97 @@
+-- C95065C.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 NOT RAISED WHEN AN ENTRY IS DECLARED
+-- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+-- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+-- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+
+-- CASE (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
+--          CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
+
+-- JWC 6/19/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95065C IS
+
+BEGIN
+
+     TEST ("C95065C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                      "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                      "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                      "FORMAL PART IS ELABORATED");
+
+     BEGIN
+
+          DECLARE
+
+               TYPE A1 IS ARRAY (1 .. 3) OF INTEGER
+                                RANGE IDENT_INT(1) .. IDENT_INT(3);
+
+               TYPE REC IS
+                    RECORD
+                         I : INTEGER RANGE IDENT_INT(1)..IDENT_INT(3);
+                         A : A1;
+                    END RECORD;
+
+               TASK T IS
+                    ENTRY E1 (R : REC := (-3,(0,2,3)));
+               END T;
+
+               TASK BODY T IS
+               BEGIN
+                    SELECT
+                         ACCEPT E1 (R : REC := (-3,(0,2,3))) DO
+                              FAILED ("ACCEPT E1 EXECUTED");
+                         END E1;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN TASK T");
+               END T;
+
+          BEGIN
+               T.E1;
+               FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - E1");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+
+END C95065C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065d.ada
new file mode 100644
index 000000000..36fc22c27
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065d.ada
@@ -0,0 +1,92 @@
+-- C95065D.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 NOT RAISED WHEN AN ENTRY IS DECLARED
+-- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+-- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+-- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+
+-- CASE (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON
+--          SUBSCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+--          WITH A STATIC AGGREGATE.
+
+-- JWC 6/19/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95065D IS
+
+BEGIN
+
+     TEST ("C95065D", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                      "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                      "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                      "FORMAL PART IS ELABORATED");
+
+     BEGIN
+
+          DECLARE
+
+               TYPE A1 IS ARRAY (1 .. 2, 1 .. 2) OF INTEGER
+                                RANGE IDENT_INT(1) .. IDENT_INT(2);
+
+               TASK T IS
+                    ENTRY E1 (A : A1 := ((1, -1), (1, 2)));
+               END T;
+
+               TASK BODY T IS
+               BEGIN
+                    SELECT
+                         ACCEPT E1 (A : A1 := ((1, -1), (1, 2))) DO
+                              FAILED ("ACCEPT E1 EXECUTED");
+                         END E1;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN TASK T");
+               END T;
+
+          BEGIN
+               T.E1;
+               FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - E1");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+
+END C95065D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065e.ada
new file mode 100644
index 000000000..95086f073
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065e.ada
@@ -0,0 +1,92 @@
+-- C95065E.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 NOT RAISED WHEN AN ENTRY IS DECLARED
+-- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+-- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+-- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+
+-- CASE (E) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON
+--          SUBSCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+--          WITH A STATIC AGGREGATE.
+
+-- JWC 6/19/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95065E IS
+
+BEGIN
+
+     TEST ("C95065E", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                      "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                      "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                      "FORMAL PART IS ELABORATED");
+
+     BEGIN
+
+          DECLARE
+
+               TYPE A1 IS ARRAY (1 .. 2, 1 .. 2) OF INTEGER
+                                RANGE IDENT_INT(1) .. IDENT_INT(2);
+
+               TASK T IS
+                    ENTRY E1 (A : A1 := (3 .. 4 => (1, 2)));
+               END T;
+
+               TASK BODY T IS
+               BEGIN
+                    SELECT
+                         ACCEPT E1 (A : A1 := (3 .. 4 => (1, 2))) DO
+                              FAILED ("ACCEPT E1 EXECUTED");
+                         END E1;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN TASK T");
+               END T;
+
+          BEGIN
+               T.E1;
+               FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - E1");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+
+END C95065E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065f.ada
new file mode 100644
index 000000000..3451707af
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95065f.ada
@@ -0,0 +1,97 @@
+-- C95065F.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 NOT RAISED WHEN AN ENTRY IS DECLARED
+-- IF THE VALUE OF THE DEFAULT EXPRESSION FOR THE FORMAL PARAMETER DOES
+-- NOT SATISFY THE CONSTRAINTS OF THE TYPE MARK, BUT IS RAISED WHEN THE
+-- ENTRY IS CALLED AND THE DEFAULT VALUE IS USED.
+
+-- CASE (F) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
+--          INITIALIZED WITH A STATIC AGGREGATE.
+
+-- JWC 6/19/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95065F IS
+
+BEGIN
+
+     TEST ("C95065F", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                      "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                      "CONSTRAINTS ON A FORMAL PARAMETER WHEN THE " &
+                      "FORMAL PART IS ELABORATED");
+
+     BEGIN
+
+          DECLARE
+
+               SUBTYPE INT IS INTEGER RANGE 0 .. 10;
+               TYPE A1 IS ARRAY (1 .. 3) OF INT;
+               TYPE REC (I : INT) IS
+                    RECORD
+                         A : A1;
+                    END RECORD;
+
+               SUBTYPE REC4 IS REC (IDENT_INT(4));
+
+               TASK T IS
+                    ENTRY E1 (R : REC4 := (3,(1,2,3)));
+               END T;
+
+               TASK BODY T IS
+               BEGIN
+                    SELECT
+                         ACCEPT E1 (R : REC4 := (3,(1,2,3))) DO
+                              FAILED ("ACCEPT E1 EXECUTED");
+                         END E1;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN TASK T");
+               END T;
+
+          BEGIN
+               T.E1;
+               FAILED ("CONSTRAINT ERROR NOT RAISED ON CALL TO T.E1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - E1");
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED (BY ENTRY DECL)");
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED");
+     END;
+
+     RESULT;
+
+END C95065F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95066a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95066a.ada
new file mode 100644
index 000000000..f9405d99b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95066a.ada
@@ -0,0 +1,214 @@
+-- C95066A.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 STATIC EXPRESSION, CONSTANT NAME, ATTRIBUTE NAME,
+-- VARIABLE, DEREFERENCED ACCESS, USER-DEFINED OPERATOR, USER-
+-- DEFINED FUNCTION, OR ALLOCATOR CAN BE USED IN THE INITIALIZATION
+-- EXPRESSION OF A FORMAL PARAMETER, AND THAT THE APPROPRIATE
+-- VALUE IS USED AS A DEFAULT PARAMETER VALUE WHEN THE ENTRY
+-- IS CALLED.
+
+-- GLH  6/19/85
+
+WITH REPORT;
+PROCEDURE C95066A IS
+
+     USE REPORT;
+
+     TYPE INT IS RANGE 1 .. 10;
+
+     TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+
+     TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+          RECORD
+               A : ARR (0..CONSTRAINT);
+          END RECORD;
+
+     C7   : CONSTANT INTEGER  := 7;
+     V7   : INTEGER  := 7;
+
+     TYPE  A_INT IS ACCESS INTEGER;
+     C_A  : CONSTANT A_INT  := NEW INTEGER'(7);
+
+     SUBTYPE RECTYPE1 IS RECTYPE (2 + 5);
+     SUBTYPE RECTYPE2 IS RECTYPE (C7);
+     SUBTYPE RECTYPE3 IS RECTYPE (V7);
+
+     FUNCTION "&" (X,Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN 10;
+     END "&";
+
+     FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN X;
+     END FUNC;
+
+      -- STATIC EXPRESSION.
+
+     TASK T1 IS
+          ENTRY E1 (REC : RECTYPE1 := (3+4,(0,1,2,3,4,5,6,7)));
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          ACCEPT E1 (REC : RECTYPE1 := (3+4,(0,1,2,3,4,5,6,7))) DO
+               IF (REC /= (7,(0,1,2,3,4,5,6,7))) THEN
+                    FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                            "E1 PARAMETER");
+               END IF;
+          END E1;
+     END T1;
+
+     -- CONSTANT NAME.
+
+     TASK T2 IS
+          ENTRY E2 (REC : RECTYPE2 := (C7,(0,1,2,3,4,5,6,7)));
+     END T2;
+
+     TASK BODY T2 IS
+     BEGIN
+          ACCEPT E2 (REC : RECTYPE2 := (C7,(0,1,2,3,4,5,6,7))) DO
+               IF (REC /= (C7,(0,1,2,3,4,5,6,7))) THEN
+                    FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                            "E2 PARAMETER");
+               END IF;
+          END E2;
+     END T2;
+
+     -- ATTRIBUTE NAME.
+
+     TASK T3 IS
+          ENTRY E3 (P1 : INT := INT'LAST);
+     END T3;
+
+     TASK BODY T3 IS
+     BEGIN
+          ACCEPT E3 (P1 : INT := INT'LAST) DO
+               IF (P1 /= INT (10)) THEN
+                    FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                            "E3 PARAMETER");
+               END IF;
+          END E3;
+     END T3;
+
+     -- VARIABLE.
+
+     TASK T4 IS
+          ENTRY E4 (P4 : RECTYPE3 := (V7,(0,1,2,3,4,5,6,7)));
+     END T4;
+
+     TASK BODY T4 IS
+     BEGIN
+          ACCEPT E4 (P4 : RECTYPE3 := (V7,(0,1,2,3,4,5,6,7))) DO
+               IF (P4 /= (V7,(0,1,2,3,4,5,6,7))) THEN
+                    FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                            "E4 PARAMETER");
+               END IF;
+          END E4;
+     END T4;
+
+     -- DEREFERENCED ACCESS.
+
+     TASK T5 IS
+          ENTRY E5 (P5 : INTEGER := C_A.ALL);
+     END T5;
+
+     TASK BODY T5 IS
+     BEGIN
+          ACCEPT E5 (P5 : INTEGER := C_A.ALL) DO
+               IF (P5 /= C_A.ALL) THEN
+                    FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                            "E5 PARAMETER");
+               END IF;
+          END E5;
+     END T5;
+
+     -- USER-DEFINED OPERATOR.
+
+     TASK T6 IS
+          ENTRY E6 (P6 : INTEGER := 6&4);
+     END T6;
+
+     TASK BODY T6 IS
+     BEGIN
+          ACCEPT E6 (P6 : INTEGER := 6&4) DO
+               IF (P6 /= IDENT_INT(10)) THEN
+                    FAILED ("INCORRECT DEFAULT VALUE " &
+                            "FOR E6 PARAMETER");
+               END IF;
+          END E6;
+     END T6;
+
+     -- USER-DEFINED FUNCTION.
+
+     TASK T7 IS
+          ENTRY E7 (P7 : INTEGER := FUNC(10));
+     END T7;
+
+     TASK BODY T7 IS
+     BEGIN
+          ACCEPT E7 (P7 : INTEGER := FUNC(10)) DO
+               IF (P7 /= IDENT_INT(10)) THEN
+                    FAILED ("INCORRECT DEFAULT VALUE FOR " &
+                            "E7 PARAMETER");
+               END IF;
+          END E7;
+     END T7;
+
+     -- ALLOCATOR.
+
+     TASK T8 IS
+          ENTRY E8 (P8 : A_INT := NEW INTEGER'(7));
+     END T8;
+
+     TASK BODY T8 IS
+     BEGIN
+          ACCEPT E8 (P8 : A_INT := NEW INTEGER'(7)) DO
+               IF (P8.ALL /= IDENT_INT(7)) THEN
+                    FAILED ("INCORRECT DEFAULT VALUE " &
+                            "FOR E8 PARAMETER");
+               END IF;
+          END E8;
+     END T8;
+
+BEGIN
+     TEST ("C95066A", "CHECK USE OF STATIC EXPRESSIONS, CONSTANT " &
+                      "NAMES, ATTRIBUTE NAMES, VARIABLES, USER- " &
+                      "DEFINED OPERATORS, USER-DEFINED FUNCTIONS, " &
+                      "DEREFERENCED ACCESSES, AND ALLOCATORS IN " &
+                      "THE FORMAL PART OF A TASK SPECIFICATION");
+
+     T1.E1;
+     T2.E2;
+     T3.E3;
+     T4.E4;
+     T5.E5;
+     T6.E6;
+     T7.E7;
+     T8.E8;
+
+     RESULT;
+
+END C95066A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95067a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95067a.ada
new file mode 100644
index 000000000..d4393d51d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95067a.ada
@@ -0,0 +1,302 @@
+-- C95067A.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 FORMAL PARAMETER OF MODE IN OR IN OUT CAN BE OF A
+-- LIMITED TYPE, INCLUDING A COMPOSITE LIMITED TYPE.
+
+-- JWC 6/20/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95067A IS
+
+     PACKAGE PKG IS
+
+          TYPE ITYPE IS LIMITED PRIVATE;
+
+          TASK T1 IS
+
+               ENTRY LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
+
+               ENTRY LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
+                                   M : STRING);
+
+               ENTRY SET_I (X : IN OUT ITYPE; V : INTEGER);
+
+          END T1;
+
+          SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
+          TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
+
+          TASK T2 IS
+
+               ENTRY LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
+                                 I : INTEGER; S : STRING; M : STRING);
+
+               ENTRY LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
+                                    I : INTEGER; S : STRING;
+                                    M : STRING);
+
+               ENTRY SET_VR (X : IN OUT VRTYPE; C : INTEGER;
+                             I : INTEGER; S : STRING);
+
+          END T2;
+
+     PRIVATE
+
+          TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
+
+          TYPE VRTYPE (C : INT_0_20 := 20) IS
+               RECORD
+                    I : INTEGER;
+                    S : STRING (1 .. C);
+               END RECORD;
+
+     END PKG;
+
+     USE PKG;
+
+     I1 : ITYPE;
+
+     TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
+
+     A1 : ATYPE;
+
+     VR1 : VRTYPE;
+
+     D : CONSTANT INT_0_20 := 10;
+
+     TYPE RTYPE IS
+          RECORD
+               J : ITYPE;
+               R : VRTYPE (D);
+          END RECORD;
+
+     R1 : RTYPE;
+
+     PACKAGE BODY PKG IS
+
+          TASK BODY T1 IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT LOOK_IN_I (X : IN ITYPE; V : INTEGER;
+                                           M : STRING) DO
+                              IF INTEGER (X) /= V THEN
+                                   FAILED ("WRONG SCALAR VALUE - " & M);
+                              END IF;
+                         END LOOK_IN_I;
+                    OR
+                         ACCEPT LOOK_INOUT_I (X : IN OUT ITYPE;
+                                              V : INTEGER;
+                                              M : STRING) DO
+                              IF INTEGER (X) /= V THEN
+                                   FAILED ("WRONG SCALAR VALUE - " & M);
+                              END IF;
+                         END LOOK_INOUT_I;
+                    OR
+                         ACCEPT SET_I (X : IN OUT ITYPE; V : INTEGER) DO
+                              X := ITYPE (IDENT_INT (V));
+                         END SET_I;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T1;
+
+          TASK BODY T2 IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
+                                            I : INTEGER; S : STRING;
+                                            M : STRING) DO
+                              IF (X.C /= C OR X.I /= I) OR ELSE
+                                 X.S /= S THEN
+                                   FAILED ("WRONG COMPOSITE VALUE - " &
+                                           M);
+                              END IF;
+                         END LOOK_IN_VR;
+                    OR
+                         ACCEPT LOOK_INOUT_VR (X : IN OUT VRTYPE;
+                                               C : INTEGER; I : INTEGER;
+                                               S : STRING;
+                                               M : STRING) DO
+                              IF (X.C /= C OR X.I /= I) OR ELSE
+                                 X.S /= S THEN
+                                   FAILED ("WRONG COMPOSITE VALUE - " &
+                                           M);
+                              END IF;
+                         END LOOK_INOUT_VR;
+                    OR
+                         ACCEPT SET_VR (X : IN OUT VRTYPE; C : INTEGER;
+                                        I : INTEGER; S : STRING) DO
+                              X := (IDENT_INT(C), IDENT_INT(I),
+                                    IDENT_STR(S));
+                         END SET_VR;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T2;
+
+     BEGIN
+          I1 := ITYPE (IDENT_INT(2));
+
+          FOR I IN A1'RANGE LOOP
+               A1 (I) := ITYPE (3 + IDENT_INT(I));
+          END LOOP;
+
+          VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
+
+          R1.J := ITYPE (IDENT_INT(6));
+          R1.R := (IDENT_INT(D), IDENT_INT(19),
+                   IDENT_STR("ABCDEFGHIJ"));
+     END PKG;
+
+     TASK T3 IS
+          ENTRY CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
+
+          ENTRY CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
+                               NV : INTEGER; M : STRING);
+
+          ENTRY CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING);
+
+          ENTRY CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
+                               NV : INTEGER; M : STRING);
+
+          ENTRY CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+                             S : STRING; M : STRING);
+
+          ENTRY CHECK_INOUT_VR (X : IN OUT VRTYPE;
+                               OC : INTEGER; OI : INTEGER; OS : STRING;
+                               NC : INTEGER; NI : INTEGER; NS : STRING;
+                               M : STRING);
+
+          ENTRY CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
+                            I : INTEGER; S : STRING; M : STRING);
+
+          ENTRY CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
+                              OC : INTEGER; OI : INTEGER; OS : STRING;
+                              NJ : INTEGER;
+                              NC : INTEGER; NI : INTEGER; NS : STRING;
+                              M : STRING);
+     END T3;
+
+     TASK BODY T3 IS
+     BEGIN
+          ACCEPT CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) DO
+               T1.LOOK_IN_I (X, V, M);
+          END CHECK_IN_I;
+
+          ACCEPT CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
+                                NV : INTEGER; M : STRING) DO
+               T1.LOOK_INOUT_I (X, OV, M & " - A");
+               T1.SET_I (X, NV);
+               T1.LOOK_INOUT_I (X, NV, M & " - B");
+               T1.LOOK_IN_I (X, NV, M & " - C");
+          END CHECK_INOUT_I;
+
+          ACCEPT CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) DO
+               FOR I IN X'RANGE LOOP
+                    T1.LOOK_IN_I (X(I), V+I, M & " -" &
+                                             INTEGER'IMAGE (I));
+               END LOOP;
+          END CHECK_IN_A;
+
+          ACCEPT CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
+                                NV : INTEGER; M : STRING) DO
+               FOR I IN X'RANGE LOOP
+                    T1.LOOK_INOUT_I (X(I), OV+I, M & " - A" &
+                                                 INTEGER'IMAGE (I));
+                    T1.SET_I (X(I), NV+I);
+                    T1.LOOK_INOUT_I (X(I), NV+I, M & " - B" &
+                                                 INTEGER'IMAGE (I));
+                    T1.LOOK_IN_I (X(I), NV+I, M & " - C" &
+                                              INTEGER'IMAGE (I));
+               END LOOP;
+          END CHECK_INOUT_A;
+
+          ACCEPT CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+                              S : STRING; M : STRING) DO
+               T2.LOOK_IN_VR (X, C, I, S, M);
+          END CHECK_IN_VR;
+
+          ACCEPT CHECK_INOUT_VR (X : IN OUT VRTYPE;
+                                 OC : INTEGER; OI : INTEGER;
+                                 OS : STRING;
+                                 NC : INTEGER; NI : INTEGER;
+                                 NS : STRING;
+                                 M : STRING) DO
+               T2.LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
+               T2.SET_VR (X, NC, NI, NS);
+               T2.LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
+               T2.LOOK_IN_VR (X, NC, NI, NS, M & " - C");
+          END CHECK_INOUT_VR;
+
+          ACCEPT CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
+                             I : INTEGER; S : STRING; M : STRING) DO
+               T1.LOOK_IN_I (X.J, J, M & " - A");
+               T2.LOOK_IN_VR (X.R, C, I, S, M & " - B");
+          END CHECK_IN_R;
+
+          ACCEPT CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
+                                OC : INTEGER; OI : INTEGER; OS : STRING;
+                                NJ : INTEGER;
+                                NC : INTEGER; NI : INTEGER; NS : STRING;
+                                M : STRING) DO
+               T1.LOOK_INOUT_I (X.J, OJ, M & " - A");
+               T2.LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
+               T1.SET_I (X.J, NJ);
+               T2.SET_VR (X.R, NC, NI, NS);
+               T1.LOOK_INOUT_I (X.J, NJ, M & " - C");
+               T2.LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
+               T1.LOOK_IN_I (X.J, NJ, M & " - E");
+               T2.LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
+          END CHECK_INOUT_R;
+     END T3;
+
+BEGIN
+     TEST ("C95067A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
+                      "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
+
+     T3.CHECK_IN_I (I1, 2, "IN I");
+
+     T3.CHECK_INOUT_I (I1, 2, 5, "INOUT I");
+
+     T3.CHECK_IN_A (A1, 3, "IN A");
+
+     T3.CHECK_INOUT_A (A1, 3, 17, "INOUT A");
+
+     T3.CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
+
+     T3.CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
+                        "INOUT VR");
+
+     T3.CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
+
+     T3.CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5,
+                       "ZYXWVUTSRQ", "INOUT R");
+
+     RESULT;
+END C95067A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95071a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95071a.ada
new file mode 100644
index 000000000..a7153993d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95071a.ada
@@ -0,0 +1,230 @@
+-- C95071A.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 OBJECTS DESIGNATED BY IN PARAMETERS OF ACCESS TYPES CAN
+-- BE USED AS THE TARGET OF AN ASSIGNMENT STATEMENT AND AS AN ACTUAL
+-- PARAMETER OF ANY MODE.  SUBTESTS ARE:
+--        (A) INTEGER ACCESS TYPE.
+--        (B) ARRAY ACCESS TYPE.
+--        (C) RECORD ACCESS TYPE.
+
+-- JWC 7/11/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95071A IS
+
+BEGIN
+
+     TEST ("C95071A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS " &
+                      "MAY BE USED IN ASSIGNMENT CONTEXTS");
+
+     --------------------------------------------------
+
+     DECLARE   -- (A)
+
+          TYPE PTRINT IS ACCESS INTEGER;
+          PI : PTRINT;
+
+          TASK TA IS
+               ENTRY EA (PI : IN PTRINT);
+          END TA;
+
+          TASK BODY TA IS
+          BEGIN
+               ACCEPT EA (PI : IN PTRINT) DO
+                    DECLARE
+                         TASK TA1 IS
+                              ENTRY EA1 (I : OUT INTEGER);
+                              ENTRY EA2 (I : IN OUT INTEGER);
+                         END TA1;
+
+                         TASK BODY TA1 IS
+                         BEGIN
+                              ACCEPT EA1 (I : OUT INTEGER) DO
+                                   I := 7;
+                              END EA1;
+
+                              ACCEPT EA2 (I : IN OUT INTEGER) DO
+                                   I := I + 1;
+                              END EA2;
+                         END TA1;
+
+                    BEGIN
+                         TA1.EA1 (PI.ALL);
+                         TA1.EA2 (PI.ALL);
+                         PI.ALL := PI.ALL + 1;
+                         IF (PI.ALL /= 9) THEN
+                              FAILED ("ASSIGNMENT TO COMPONENT OF " &
+                                      "INTEGER ACCESS PARAMETER " &
+                                      "FAILED");
+                         END IF;
+                    END;
+               END EA;
+          END TA;
+
+     BEGIN     -- (A)
+
+          PI := NEW INTEGER'(0);
+          TA.EA (PI);
+
+     END;      -- (A)
+
+     ---------------------------------------------
+
+     DECLARE   -- (B)
+
+          TYPE TBL IS ARRAY (1..3) OF INTEGER;
+          TYPE PTRTBL IS ACCESS TBL;
+          PT : PTRTBL;
+
+          TASK TB IS
+               ENTRY EB (PT : IN PTRTBL);
+          END TB;
+
+          TASK BODY TB IS
+          BEGIN
+               ACCEPT EB (PT : IN PTRTBL) DO
+                    DECLARE
+                         TASK TB1 IS
+                              ENTRY EB1 (T : OUT TBL);
+                              ENTRY EB2 (T : IN OUT TBL);
+                              ENTRY EB3 (I : OUT INTEGER);
+                              ENTRY EB4 (I : IN OUT INTEGER);
+                         END TB1;
+
+                         TASK BODY TB1 IS
+                         BEGIN
+                              ACCEPT EB1 (T : OUT TBL) DO
+                                   T := (1,2,3);
+                              END EB1;
+
+                              ACCEPT EB2 (T : IN OUT TBL) DO
+                                   T(3) := T(3) - 1;
+                              END EB2;
+
+                              ACCEPT EB3 (I : OUT INTEGER) DO
+                                   I := 7;
+                              END EB3;
+
+                              ACCEPT EB4 (I : IN OUT INTEGER) DO
+                                   I := I + 1;
+                              END EB4;
+                         END TB1;
+
+                    BEGIN
+                         TB1.EB1 (PT.ALL);         -- (1,2,3)
+                         TB1.EB2 (PT.ALL);         -- (1,2,2)
+                         TB1.EB3 (PT(2));          -- (1,7,2)
+                         TB1.EB4 (PT(1));          -- (2,7,2)
+                         PT(3) := PT(3) + 7;      -- (2,7,9)
+                         IF (PT.ALL /= (2,7,9)) THEN
+                              FAILED ("ASSIGNMENT TO COMPONENT OF " &
+                                      "ARRAY ACCESS PARAMETER FAILED");
+                         END IF;
+                    END;
+               END EB;
+          END TB;
+
+     BEGIN     -- (B)
+
+          PT := NEW TBL'(0,0,0);
+          TB.EB (PT);
+
+     END;      -- (B)
+
+     ---------------------------------------------
+
+     DECLARE   -- (C)
+
+          TYPE REC IS
+               RECORD
+                    I1   : INTEGER;
+                    I2   : INTEGER;
+                    I3   : INTEGER;
+               END RECORD;
+
+          TYPE PTRREC IS ACCESS REC;
+          PR : PTRREC;
+
+          TASK TC IS
+               ENTRY EC (PR : IN PTRREC);
+          END TC;
+
+          TASK BODY TC IS
+          BEGIN
+               ACCEPT EC (PR : IN PTRREC) DO
+                    DECLARE
+                         TASK TC1 IS
+                              ENTRY EC1 (R : OUT REC);
+                              ENTRY EC2 (R : IN OUT REC);
+                              ENTRY EC3 (I : OUT INTEGER);
+                              ENTRY EC4 (I : IN OUT INTEGER);
+                         END TC1;
+
+                         TASK BODY TC1 IS
+                         BEGIN
+                              ACCEPT EC1 (R : OUT REC) DO
+                                   R := (1,2,3);
+                              END EC1;
+
+                              ACCEPT EC2 (R : IN OUT REC) DO
+                                   R.I3 := R.I3 - 1;
+                              END EC2;
+
+                              ACCEPT EC3 (I : OUT INTEGER) DO
+                                   I := 7;
+                              END  EC3;
+
+                              ACCEPT EC4 (I : IN OUT INTEGER) DO
+                                   I := I + 1;
+                              END EC4;
+                         END TC1;
+
+                    BEGIN
+                         TC1.EC1 (PR.ALL);         -- (1,2,3)
+                         TC1.EC2 (PR.ALL);         -- (1,2,2)
+                         TC1.EC3 (PR.I2);          -- (1,7,2)
+                         TC1.EC4 (PR.I1);          -- (2,7,2)
+                         PR.I3 := PR.I3 + 7;       -- (2,7,9)
+                         IF (PR.ALL /= (2,7,9)) THEN
+                              FAILED ("ASSIGNMENT TO COMPONENT OF " &
+                                      "RECORD ACCESS PARAMETER " &
+                                      "FAILED");
+                         END IF;
+                    END;
+               END EC;
+          END TC;
+
+     BEGIN     -- (C)
+
+          PR := NEW REC'(0,0,0);
+          TC.EC (PR);
+
+     END;      -- (C)
+
+     ---------------------------------------------
+
+     RESULT;
+
+END C95071A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95072a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95072a.ada
new file mode 100644
index 000000000..261007b27
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95072a.ada
@@ -0,0 +1,197 @@
+-- C95072A.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 SCALAR AND ACCESS PARAMETERS ARE COPIED FOR ALL THREE
+-- PARAMETER MODES.
+-- SUBTESTS ARE:
+--   (A)  SCALAR PARAMETERS TO ENTRIES.
+--   (B)  ACCESS PARAMETERS TO ENTRIES.
+
+-- JWC 7/22/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95072A IS
+
+BEGIN
+     TEST ("C95072A", "CHECK THAT SCALAR AND ACCESS PARAMETERS ARE " &
+                      "COPIED");
+
+     --------------------------------------------------
+
+     DECLARE  -- (A)
+
+          I : INTEGER;
+          E : EXCEPTION;
+
+          TASK TA IS
+               ENTRY EA (EI : IN INTEGER; EO : OUT INTEGER;
+                         EIO : IN OUT INTEGER);
+          END TA;
+
+          TASK BODY TA IS
+
+               TMP : INTEGER;
+
+          BEGIN
+
+               ACCEPT EA (EI : IN INTEGER; EO : OUT INTEGER;
+                          EIO : IN OUT INTEGER) DO
+
+                    TMP := EI;     -- SAVE VALUE OF EI AT ACCEPT.
+
+                    EO := 10;
+                    IF EI /= TMP THEN
+                         FAILED ("ASSIGNMENT TO SCALAR OUT " &
+                                 "PARAMETER CHANGES THE VALUE OF " &
+                                 "INPUT PARAMETER");
+                         TMP := EI;     -- RESET TMP FOR NEXT CASE.
+                    END IF;
+
+                    EIO := EIO + 100;
+                    IF EI /= TMP THEN
+                         FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
+                                 "PARAMETER CHANGES THE VALUE OF " &
+                                 "INPUT PARAMETER");
+                         TMP := EI;     -- RESET TMP FOR NEXT CASE.
+                    END IF;
+
+                    I := I + 1;
+                    IF EI /= TMP THEN
+                         FAILED ("ASSIGNMENT TO SCALAR ACTUAL " &
+                                 "PARAMETER CHANGES THE VALUE OF " &
+                                 "INPUT PARAMETER");
+                    END IF;
+
+                    RAISE E;            -- CHECK EXCEPTION HANDLING.
+               END EA;
+
+          EXCEPTION
+               WHEN OTHERS => NULL;
+          END TA;
+
+     BEGIN  -- (A)
+
+          I := 0;   -- INITIALIZE I SO VARIOUS CASES CAN BE DETECTED.
+          TA.EA (I, I, I);
+          FAILED ("EXCEPTION NOT RAISED - A");
+
+     EXCEPTION
+          WHEN E =>
+               IF I /= 1 THEN
+                    CASE I IS
+                         WHEN 11  =>
+                              FAILED ("OUT ACTUAL SCALAR PARAMETER " &
+                                      "CHANGED GLOBAL VALUE");
+                         WHEN 101 =>
+                              FAILED ("IN OUT ACTUAL SCALAR " &
+                                      "PARAMETER CHANGED GLOBAL VALUE");
+                         WHEN 111 =>
+                              FAILED ("OUT AND IN OUT ACTUAL SCALAR " &
+                                      "PARAMETERS CHANGED GLOBAL " &
+                                      "VALUE");
+                         WHEN OTHERS =>
+                              FAILED ("UNDETERMINED CHANGE TO GLOBAL " &
+                                      "VALUE");
+                    END CASE;
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - A");
+     END;  -- (A)
+
+     --------------------------------------------------
+
+     DECLARE  -- (B)
+
+          TYPE ACCTYPE IS ACCESS INTEGER;
+
+          I : ACCTYPE;
+          E : EXCEPTION;
+
+          TASK TB IS
+               ENTRY EB (EI : IN ACCTYPE; EO : OUT ACCTYPE;
+                         EIO : IN OUT ACCTYPE);
+          END TB;
+
+          TASK BODY TB IS
+
+               TMP : ACCTYPE;
+
+          BEGIN
+
+               ACCEPT EB (EI : IN ACCTYPE; EO : OUT ACCTYPE;
+                          EIO : IN OUT ACCTYPE) DO
+
+                    TMP := EI;     -- SAVE VALUE OF EI AT ACCEPT.
+
+                    I := NEW INTEGER'(101);
+                    IF EI /= TMP THEN
+                         FAILED ("ASSIGNMENT TO ACCESS ACTUAL " &
+                                 "PARAMETER CHANGES THE VALUE OF " &
+                                 "INPUT PARAMETER");
+                         TMP := EI;     -- RESET TMP FOR NEXT CASE.
+                    END IF;
+
+                    EO := NEW INTEGER'(1);
+                    IF EI /= TMP THEN
+                         FAILED ("ASSIGNMENT TO ACCESS OUT " &
+                                 "PARAMETER CHANGES THE VALUE OF " &
+                                 "INPUT PARAMETER");
+                         TMP := EI;     -- RESET TMP FOR NEXT CASE.
+                    END IF;
+
+                    EIO := NEW INTEGER'(10);
+                    IF EI /= TMP THEN
+                         FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
+                                 "PARAMETER CHANGES THE VALUE OF " &
+                                 "INPUT PARAMETER");
+                    END IF;
+
+                    RAISE E;            -- CHECK EXCEPTION HANDLING.
+               END EB;
+
+          EXCEPTION
+               WHEN OTHERS => NULL;
+          END TB;
+
+     BEGIN  -- (B)
+
+          I := NEW INTEGER'(100);
+          TB.EB (I, I, I);
+          FAILED ("EXCEPTION NOT RAISED - B");
+
+     EXCEPTION
+          WHEN E =>
+               IF I.ALL /= 101 THEN
+                    FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
+                            "PARAMETER VALUE CHANGED DESPITE " &
+                            "RAISED EXCEPTION");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - B");
+     END;  -- (B)
+
+     --------------------------------------------------
+
+     RESULT;
+END C95072A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95072b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95072b.ada
new file mode 100644
index 000000000..ba1b91ed1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95072b.ada
@@ -0,0 +1,278 @@
+-- C95072B.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 PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
+-- PASSED BY COPY FOR ALL MODES.
+-- SUBTESTS ARE:
+--   (A)  PRIVATE SCALAR PARAMETERS TO ENTRIES.
+--   (B)  PRIVATE ACCESS PARAMETERS TO ENTRIES.
+
+-- JWC 7/22/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95072B IS
+
+BEGIN
+     TEST("C95072B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
+                     "PARAMETERS ARE COPIED");
+
+     ---------------------------------------------------
+
+     DECLARE  -- (A)
+
+          PACKAGE SCALAR_PKG IS
+
+               TYPE T IS PRIVATE;
+               C0 : CONSTANT T;
+               C1 : CONSTANT T;
+               C10 : CONSTANT T;
+               C100 : CONSTANT T;
+
+               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
+               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;
+
+          PRIVATE
+
+               TYPE T IS NEW INTEGER;
+               C0 : CONSTANT T := 0;
+               C1 : CONSTANT T := 1;
+               C10 : CONSTANT T := 10;
+               C100 : CONSTANT T := 100;
+
+          END SCALAR_PKG;
+
+          PACKAGE BODY SCALAR_PKG IS
+
+               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
+               BEGIN
+                    RETURN T (INTEGER(OLD) + INTEGER(INCREMENT));
+               END "+";
+
+               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
+               BEGIN
+                    RETURN INTEGER (OLD_PRIVATE);
+               END CONVERT;
+
+          END SCALAR_PKG;
+
+          USE SCALAR_PKG;
+
+     BEGIN  -- (A)
+
+          DECLARE  -- (A1)
+
+               I : T;
+               E : EXCEPTION;
+
+               TASK TA IS
+                    ENTRY EA (EI : IN T; EO : OUT T;
+                              EIO : IN OUT T);
+               END TA;
+
+               TASK BODY TA IS
+
+                    TEMP : T;
+
+               BEGIN
+
+                    ACCEPT EA (EI : IN T; EO : OUT T;
+                               EIO : IN OUT T) DO
+
+                         TEMP := EI;    -- SAVE VALUE OF EI AT ACCEPT.
+
+                         EO := C10;
+                         IF EI /= TEMP THEN
+                              FAILED ("ASSIGNMENT TO PRIVATE " &
+                                      "(SCALAR) OUT PARAMETER " &
+                                      "CHANGES THE VALUE OF INPUT " &
+                                      "PARAMETER");
+                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
+                         END IF;
+
+                         EIO := EIO + C100;
+                         IF EI /= TEMP THEN
+                              FAILED ("ASSIGNMENT TO PRIVATE " &
+                                      "(SCALAR) IN OUT PARAMETER " &
+                                      "CHANGES THE VALUE OF INPUT " &
+                                      "PARAMETER");
+                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
+                         END IF;
+
+                         I := I + C1;
+                         IF EI /= TEMP THEN
+                              FAILED ("ASSIGNMENT TO PRIVATE " &
+                                      "(SCALAR) ACTUAL PARAMETER " &
+                                      "CHANGES THE VALUE OF " &
+                                      "INPUT PARAMETER");
+                         END IF;
+
+                         RAISE E;              -- CHECK EXCEPTION
+                                               -- HANDLING.
+                    END EA;
+
+               EXCEPTION
+                    WHEN OTHERS => NULL;
+               END TA;
+
+          BEGIN    -- (A1)
+
+               I := C0;  -- INITIALIZE I SO VARIOUS CASES CAN BE
+                         -- DETECTED.
+               TA.EA (I, I, I);
+               FAILED ("EXCEPTION NOT RAISED - A");
+
+          EXCEPTION
+               WHEN E =>
+                    IF I /= C1 THEN
+                         CASE CONVERT (I) IS
+                              WHEN 11 =>
+                                   FAILED ("OUT ACTUAL PRIVATE " &
+                                           "(SCALAR) PARAMETER " &
+                                           "CHANGED GLOBAL VALUE");
+                              WHEN 101 =>
+                                   FAILED ("IN OUT ACTUAL PRIVATE " &
+                                           "(SCALAR) PARAMETER " &
+                                           "CHANGED GLOBAL VALUE");
+                              WHEN 111 =>
+                                   FAILED ("OUT AND IN OUT ACTUAL " &
+                                           "PRIVATE (SCALAR) " &
+                                           "PARAMETER CHANGED " &
+                                           "GLOBAL VALUE");
+                              WHEN OTHERS =>
+                                   FAILED ("UNDETERMINED CHANGE TO " &
+                                           "GLOBAL VALUE");
+                         END CASE;
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - A");
+          END;  -- (A1)
+
+     END;  -- (A)
+
+     ---------------------------------------------------
+
+     DECLARE  -- (B)
+
+          PACKAGE ACCESS_PKG IS
+
+               TYPE T IS PRIVATE;
+               C_NULL : CONSTANT T;
+               C1 : CONSTANT T;
+               C10 : CONSTANT T;
+               C100 : CONSTANT T;
+               C101 : CONSTANT T;
+
+          PRIVATE
+
+               TYPE T IS ACCESS INTEGER;
+               C_NULL : CONSTANT T := NULL;
+               C1 : CONSTANT T := NEW INTEGER'(1);
+               C10 : CONSTANT T := NEW INTEGER'(10);
+               C100 : CONSTANT T := NEW INTEGER'(100);
+               C101 : CONSTANT T := NEW INTEGER'(101);
+
+          END ACCESS_PKG;
+
+          USE ACCESS_PKG;
+
+     BEGIN    -- (B)
+
+          DECLARE  -- (B1)
+
+               I : T;
+               E : EXCEPTION;
+
+               TASK TB IS
+                    ENTRY EB (EI : IN T; EO : OUT T;
+                              EIO : IN OUT T);
+               END TB;
+
+               TASK BODY TB IS
+
+                    TEMP : T;
+
+               BEGIN
+
+                    ACCEPT EB (EI : IN T; EO : OUT T;
+                               EIO : IN OUT T) DO
+
+                         TEMP := EI;  -- SAVE VALUE OF EI AT ACCEPT.
+
+                         I := C101;
+                         IF EI /= TEMP THEN
+                              FAILED ("ASSIGNMENT TO PRIVATE " &
+                                      "(ACCESS) ACTUAL VARIABLE " &
+                                      "CHANGES THE VALUE OF INPUT " &
+                                      "PARAMETER");
+                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
+                         END IF;
+
+                         EO := C1;
+                         IF EI /= TEMP THEN
+                              FAILED ("ASSIGNMENT TO PRIVATE " &
+                                      "(ACCESS) OUT PARAMETER " &
+                                      "CHANGES THE VALUE OF INPUT " &
+                                      "PARAMETER");
+                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
+                         END IF;
+
+                         EIO := C10;
+                         IF EI /= TEMP THEN
+                              FAILED ("ASSIGNMENT TO PRIVATE " &
+                                      "(ACCESS) IN OUT PARAMETER " &
+                                      "CHANGES THE VALUE OF INPUT " &
+                                      "PARAMETER");
+                         END IF;
+
+                         RAISE E;                 -- CHECK EXCEPTION
+                                                  -- HANDLING.
+                    END EB;
+
+               EXCEPTION
+                    WHEN OTHERS => NULL;
+               END TB;
+
+          BEGIN     -- (B1)
+
+               I := C100;
+               TB.EB (I, I, I);
+               FAILED ("EXCEPTION NOT RAISED - B");
+
+          EXCEPTION
+               WHEN E =>
+                    IF I /= C101 THEN
+                         FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
+                                 "PARAMETER VALUE CHANGED DESPITE " &
+                                 "RAISED EXCEPTION");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - B");
+          END;  -- (B1)
+
+     END;  -- (B)
+
+     ---------------------------------------------------
+
+     RESULT;
+END C95072B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95073a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95073a.ada
new file mode 100644
index 000000000..f8b1e0daf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95073a.ada
@@ -0,0 +1,66 @@
+-- C95073A.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 ALIASING IS PERMITTED FOR PARAMETERS OF COMPOSITE TYPES,
+-- E.G., THAT A MATRIX ADDITION PROCEDURE CAN BE CALLED WITH THREE
+-- IDENTICAL ARGUMENTS.
+
+-- JWC 7/29/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95073A IS
+
+     TYPE MATRIX IS ARRAY (1..3, 1..3) OF INTEGER;
+
+     A : MATRIX := ((1,2,3), (4,5,6), (7,8,9));
+
+     TASK T IS
+          ENTRY MAT_ADD (X,Y : IN MATRIX; SUM : OUT MATRIX);
+     END T;
+
+     TASK BODY T IS
+     BEGIN
+          ACCEPT MAT_ADD (X,Y : IN MATRIX; SUM : OUT MATRIX) DO
+               FOR I IN 1..3 LOOP
+                    FOR J IN 1..3 LOOP
+                         SUM (I,J) := X (I,J) + Y (I,J);
+                    END LOOP;
+               END LOOP;
+          END MAT_ADD;
+     END T;
+
+BEGIN
+
+     TEST ("C95073A", "CHECK THAT ALIASING IS PERMITTED FOR " &
+                      "PARAMETERS OF COMPOSITE TYPES");
+
+     T.MAT_ADD (A, A, A);
+
+     IF A /= ((2,4,6), (8,10,12), (14,16,18)) THEN
+          FAILED ("THE RESULT OF THE MATRIX ADDITION IS INCORRECT");
+     END IF;
+
+     RESULT;
+
+END C95073A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95074c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95074c.ada
new file mode 100644
index 000000000..872a5928d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95074c.ada
@@ -0,0 +1,103 @@
+-- C95074C.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, AND 'RANGE, 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;
+PROCEDURE C95074C IS
+
+BEGIN
+
+     TEST ("C95074C", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " &
+                      "NON-ACCESS FORMAL OUT PARAMETERS");
+
+     DECLARE
+
+          TYPE ARR IS ARRAY (1 .. 10) OF NATURAL;
+
+          TYPE REC IS RECORD
+               A : ARR;
+          END RECORD;
+
+          A1 : ARR;
+          R1 : REC;
+
+          TASK T1 IS
+               ENTRY E (A2 : OUT ARR; R2 : OUT REC);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT E (A2 : OUT ARR; R2 : OUT REC) DO
+
+                    IF A2'FIRST /= 1 THEN
+                         FAILED ("WRONG VALUE FOR A2'FIRST");
+                    END IF;
+
+                    IF A2'LAST /= 10 THEN
+                         FAILED ("WRONG VALUE FOR A2'LAST");
+                    END IF;
+
+                    IF A2'LENGTH /= 10 THEN
+                         FAILED ("WRONG VALUE FOR A2'LENGTH");
+                    END IF;
+
+                    IF (1 NOT IN A2'RANGE) OR
+                       (10 NOT IN A2'RANGE) OR
+                       (0 IN A2'RANGE) OR
+                       (11 IN A2'RANGE) THEN
+                         FAILED ("WRONG VALUE FOR A2'RANGE");
+                    END IF;
+
+                    IF R2.A'FIRST /= 1 THEN
+                         FAILED ("WRONG VALUE FOR R2.A'FIRST");
+                    END IF;
+
+                    IF R2.A'LAST /= 10 THEN
+                         FAILED ("WRONG VALUE FOR R2.A'LAST");
+                    END IF;
+
+                    IF R2.A'LENGTH /= 10 THEN
+                         FAILED ("WRONG VALUE FOR R2.A'LENGTH");
+                    END IF;
+
+                    IF (1 NOT IN R2.A'RANGE) OR
+                       (10 NOT IN R2.A'RANGE) OR
+                       (0 IN R2.A'RANGE) OR
+                       (11 IN R2.A'RANGE) THEN
+                         FAILED ("WRONG VALUE FOR R2.A'RANGE");
+                    END IF;
+               END E;
+          END T1;
+
+     BEGIN
+          T1.E (A1,R1);
+     END;
+
+     RESULT;
+END C95074C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95076a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95076a.ada
new file mode 100644
index 000000000..ba00cee68
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95076a.ada
@@ -0,0 +1,85 @@
+-- C95076A.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 ACCEPT STATEMENT WITH AND WITHOUT A RETURN
+-- STATEMENT RETURNS CORRECTLY.
+
+-- GLH  7/11/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C95076A IS
+
+     I : INTEGER;
+
+     TASK T1 IS
+          ENTRY E1 (N : IN OUT INTEGER);
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          ACCEPT E1 (N : IN OUT INTEGER) DO
+               IF (N = 5) THEN
+                    N := N + 5;
+               ELSE
+                    N := 0;
+               END IF;
+          END E1;
+     END T1;
+
+     TASK T2 IS
+          ENTRY E2 (N : IN OUT INTEGER);
+     END T2;
+
+     TASK BODY T2 IS
+     BEGIN
+          ACCEPT E2 (N : IN OUT INTEGER) DO
+               IF (N = 10) THEN
+                    N := N + 5;
+                    RETURN;
+               END IF;
+               N := 0;
+          END E2;
+     END T2;
+
+BEGIN
+
+     TEST ("C95076A", "CHECK THAT AN ACCEPT STATEMENT WITH AND " &
+                      "WITHOUT A RETURN STATEMENT RETURNS CORRECTLY");
+
+     I := 5;
+     T1.E1 (I);
+     IF (I /= 10) THEN
+          FAILED ("INCORRECT RENDEVOUS WITHOUT A RETURN");
+     END IF;
+
+     I := 10;
+     T2.E2 (I);
+     IF (I /= 15) THEN
+          FAILED ("INCORRECT RENDEVOUS WITH A RETURN");
+     END IF;
+
+     RESULT;
+
+END C95076A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95078a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95078a.ada
new file mode 100644
index 000000000..399be9602
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95078a.ada
@@ -0,0 +1,195 @@
+-- C95078A.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 EXCEPTION RAISED DURING THE EXECUTION OF AN ACCEPT
+--     STATEMENT CAN BE HANDLED WITHIN THE ACCEPT BODY.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     DHH 03/21/88 CREATED ORIGINAL TEST.
+--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95078A IS
+
+BEGIN
+
+     TEST("C95078A", "CHECK THAT AN EXCEPTION RAISED DURING THE " &
+                     "EXECUTION OF AN ACCEPT STATEMENT CAN BE " &
+                     "HANDLED WITHIN THE ACCEPT BODY");
+
+     DECLARE
+          O,PT,QT,R,S,TP,B,C,D :INTEGER := 0;
+          TASK TYPE PROG_ERR IS
+               ENTRY START(M,N,A : IN OUT INTEGER);
+               ENTRY STOP;
+          END PROG_ERR;
+
+          TASK T IS
+               ENTRY START(M,N,A : IN OUT INTEGER);
+               ENTRY STOP;
+          END T;
+
+          TYPE REC IS
+               RECORD
+                    B : PROG_ERR;
+               END RECORD;
+
+          TYPE ACC IS ACCESS PROG_ERR;
+
+          SUBTYPE X IS INTEGER RANGE 1 .. 10;
+
+          PACKAGE P IS
+               OBJ : REC;
+          END P;
+
+          TASK BODY PROG_ERR IS
+               FAULT : X;
+          BEGIN
+               ACCEPT START(M,N,A : IN OUT INTEGER) DO
+                    BEGIN
+                         M := IDENT_INT(1);
+                         FAULT := IDENT_INT(11);
+                         FAULT := IDENT_INT(FAULT);
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("UNEXPECTED ERROR RAISED - " &
+                                     "CONSTRAINT - TASK TYPE");
+                    END; -- EXCEPTION
+                    BEGIN
+                         N := IDENT_INT(1);
+                         FAULT := IDENT_INT(5);
+                         FAULT := FAULT/IDENT_INT(0);
+                         FAULT := IDENT_INT(FAULT);
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("UNEXPECTED ERROR RAISED - " &
+                                     "CONSTRAINT - TASK TYPE");
+                    END; -- EXCEPTION
+                    A := IDENT_INT(1);
+               END START;
+
+               ACCEPT STOP;
+          END PROG_ERR;
+
+          TASK BODY T IS
+               FAULT : X;
+          BEGIN
+               ACCEPT START(M,N,A : IN OUT INTEGER) DO
+                    BEGIN
+                         M := IDENT_INT(1);
+                         FAULT := IDENT_INT(11);
+                         FAULT := IDENT_INT(FAULT);
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("UNEXPECTED ERROR RAISED - " &
+                                     "CONSTRAINT - TASK");
+                    END; -- EXCEPTION
+                    BEGIN
+                         N := IDENT_INT(1);
+                         FAULT := IDENT_INT(5);
+                         FAULT := FAULT/IDENT_INT(0);
+                         FAULT := IDENT_INT(FAULT);
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("UNEXPECTED ERROR RAISED - " &
+                                     "CONSTRAINT - TASK");
+                    END; -- EXCEPTION
+                    A := IDENT_INT(1);
+               END START;
+
+               ACCEPT STOP;
+          END T;
+
+          PACKAGE BODY P IS
+          BEGIN
+               OBJ.B.START(O,PT,B);
+               OBJ.B.STOP;
+
+               IF O /= IDENT_INT(1) OR PT /= IDENT_INT(1) THEN
+                    FAILED("EXCEPTION HANDLER NEVER ENTERED " &
+                           "PROPERLY - TASK TYPE OBJECT");
+               END IF;
+
+               IF B /= IDENT_INT(1) THEN
+                    FAILED("TASK NOT EXITED PROPERLY - TASK TYPE " &
+                           "OBJECT");
+               END IF;
+          END P;
+
+          PACKAGE Q IS
+               OBJ : ACC;
+          END Q;
+
+          PACKAGE BODY Q IS
+          BEGIN
+               OBJ := NEW PROG_ERR;
+               OBJ.START(QT,R,C);
+               OBJ.STOP;
+
+               IF QT /= IDENT_INT(1) OR R /= IDENT_INT(1) THEN
+                    FAILED("EXCEPTION HANDLER NEVER ENTERED " &
+                           "PROPERLY - ACCESS TASK TYPE");
+               END IF;
+
+               IF C /= IDENT_INT(1) THEN
+                    FAILED("TASK NOT EXITED PROPERLY - ACCESS TASK " &
+                           "TYPE");
+               END IF;
+          END;
+
+     BEGIN
+          T.START(S,TP,D);
+          T.STOP;
+
+          IF S /= IDENT_INT(1) OR TP /= IDENT_INT(1) THEN
+               FAILED("EXCEPTION HANDLER NEVER ENTERED PROPERLY " &
+                      "- TASK");
+          END IF;
+
+          IF D /= IDENT_INT(1) THEN
+               FAILED("TASK NOT EXITED PROPERLY - TASK");
+          END IF;
+     END; -- DECLARE
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED("EXCEPTION NOT HANDLED INSIDE ACCEPT BODY");
+          RESULT;
+END C95078A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95080b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95080b.ada
new file mode 100644
index 000000000..1c3c3b8b0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95080b.ada
@@ -0,0 +1,71 @@
+-- C95080B.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 PARAMETERLESS ENTRIES CAN BE CALLED WITH THE APPROPRIATE
+-- NOTATION.
+
+-- JWC 7/15/85
+-- JRK 8/21/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95080B IS
+
+     I : INTEGER := 1;
+
+     TASK T IS
+          ENTRY E;
+          ENTRY EF (1..3);
+     END T;
+
+     TASK BODY T IS
+     BEGIN
+          ACCEPT E DO
+               I := 15;
+          END E;
+          ACCEPT EF (2) DO
+               I := 20;
+          END EF;
+     END T;
+
+BEGIN
+
+     TEST ("C95080B", "CHECK THAT PARAMETERLESS ENTRIES CAN BE " &
+                      "CALLED");
+
+     T.E;
+     IF I /= 15 THEN
+          FAILED ("PARAMETERLESS ENTRY CALL YIELDS INCORRECT " &
+                  "RESULT");
+     END IF;
+
+     I := 0;
+     T.EF (2);
+     IF I /= 20 THEN
+          FAILED ("PARAMETERLESS ENTRY FAMILY CALL YIELDS " &
+                  "INCORRECT RESULT");
+     END IF;
+
+     RESULT;
+
+END C95080B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95082g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95082g.ada
new file mode 100644
index 000000000..f02e35db0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95082g.ada
@@ -0,0 +1,91 @@
+-- C95082G.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 CALLS TO ENTRIES HAVING AT LEAST ONE DEFAULT
+-- PARAMETER, THE CORRECT ASSOCIATION IS MADE BETWEEN ACTUAL AND
+-- FORMAL PARAMETERS.
+
+-- JWC 7/17/85
+
+WITH REPORT;USE REPORT;
+PROCEDURE C95082G IS
+
+     Y1,Y2,Y3  : INTEGER := 0;
+
+     TASK T IS
+          ENTRY E (I1: INTEGER; I2: INTEGER := 2; I3: INTEGER := 3;
+                   O1,O2,O3: OUT INTEGER);
+     END T;
+
+     TASK BODY T IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT E (I1: INTEGER; I2: INTEGER := 2;
+                              I3: INTEGER := 3;
+                              O1,O2,O3: OUT INTEGER) DO
+                         O1 := I1;
+                         O2 := I2;
+                         O3 := I3;
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          END LOOP;
+     END T;
+
+
+BEGIN
+
+     TEST ("C95082G", "CHECK ASSOCIATIONS BETWEEN ACTUAL AND FORMAL " &
+                      "PARAMETERS (HAVING DEFAULT VALUES)");
+
+     T.E (I1=>11, I2=>12, I3=>13, O1=>Y1, O2=>Y2, O3=>Y3);
+     IF (Y1 /= 11) OR (Y2 /= 12) OR (Y3 /= 13) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 1");
+     END IF;
+
+     T.E (I1=>21, O1=>Y1, O2=>Y2, O3=>Y3);
+     IF (Y1 /= 21) OR (Y2 /= 2) OR (Y3 /= 3) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 2");
+     END IF;
+
+     T.E (O1=>Y1, O3=>Y3, I1=>31, I3=>33, O2=>Y2);
+     IF (Y1 /= 31) OR (Y2 /= 2) OR (Y3 /= 33) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 3");
+     END IF;
+
+     T.E (41, 42, O1=>Y1, O2=>Y2, O3=>Y3);
+     IF (Y1 /= 41) OR (Y2 /= 42) OR (Y3 /= 3) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 4");
+     END IF;
+
+     T.E (51, O3=>Y3, O1=>Y1, O2=>Y2, I3=>53);
+     IF (Y1 /= 51) OR (Y2 /= 2) OR (Y3 /= 53) THEN
+          FAILED ("INCORRECT PARAMETER ASSOCIATION - 5");
+     END IF;
+
+     RESULT;
+
+END C95082G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085a.ada
new file mode 100644
index 000000000..fc7e0dc9e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085a.ada
@@ -0,0 +1,279 @@
+-- C95085A.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 OUT OF RANGE SCALAR
+-- ARGUMENTS.  SUBTESTS ARE:
+--        (A) STATIC IN ARGUMENT.
+--        (B) DYNAMIC IN ARGUMENT.
+--        (C) IN OUT, OUT OF RANGE ON CALL.
+--        (D) OUT, OUT OF RANGE ON RETURN.
+--        (E) IN OUT, OUT OF RANGE ON RETURN.
+
+-- GLH 7/15/85
+-- JRK 8/23/85
+-- JWC 11/15/85     ADDED VARIABLE "CALLED" TO ENSURE THAT THE ENTRY
+--                  CALL WAS MADE FOR THOSE CASES THAT ARE APPLICABLE.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE C95085A IS
+
+     SUBTYPE DIGIT IS INTEGER RANGE 0..9;
+
+     D      : DIGIT;
+     I      : INTEGER;
+     M1     : CONSTANT INTEGER := IDENT_INT (-1);
+     COUNT  : INTEGER := 0;
+     CALLED : BOOLEAN;
+
+     SUBTYPE SI IS INTEGER RANGE M1 .. 10;
+
+     TASK T1 IS
+          ENTRY E1 (PIN : IN DIGIT; WHO : STRING);  -- (A), (B).
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          LOOP
+               BEGIN
+                    SELECT
+                         ACCEPT E1 (PIN : IN DIGIT;
+                                    WHO : STRING) DO  -- (A), (B).
+                              FAILED ("EXCEPTION NOT RAISED BEFORE " &
+                                      "CALL - E1 " & WHO);
+                         END E1;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN E1");
+               END;
+          END LOOP;
+     END T1;
+
+     TASK T2 IS
+          ENTRY E2 (PINOUT : IN OUT DIGIT; WHO : STRING);  -- (C).
+     END T2;
+
+     TASK BODY T2 IS
+     BEGIN
+          LOOP
+               BEGIN
+                    SELECT
+                         ACCEPT E2 (PINOUT : IN OUT DIGIT;
+                                    WHO : STRING) DO  -- (C).
+                              FAILED ("EXCEPTION NOT RAISED BEFORE " &
+                                      "CALL - E2 " & WHO);
+                         END E2;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN E2");
+               END;
+          END LOOP;
+     END T2;
+
+     TASK T3 IS
+          ENTRY E3 (POUT : OUT SI; WHO : STRING);  -- (D).
+     END T3;
+
+     TASK BODY T3 IS
+     BEGIN
+          LOOP
+               BEGIN
+                    SELECT
+                         ACCEPT E3 (POUT : OUT SI;
+                                    WHO : STRING) DO  -- (D).
+                              CALLED := TRUE;
+                              IF WHO = "10" THEN
+                                   POUT := IDENT_INT (10);  -- 10 IS NOT
+                                                            -- A DIGIT.
+                              ELSE
+                                   POUT := -1;
+                              END IF;
+                         END E3;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN E3");
+               END;
+          END LOOP;
+     END T3;
+
+     TASK T4 IS
+          ENTRY E4 (PINOUT : IN OUT INTEGER; WHO : STRING);  -- (E).
+     END T4;
+
+     TASK BODY T4 IS
+     BEGIN
+          LOOP
+               BEGIN
+                    SELECT
+                         ACCEPT E4 (PINOUT : IN OUT INTEGER;
+                                    WHO : STRING) DO  -- (E).
+                              CALLED := TRUE;
+                              IF WHO = "10" THEN
+                                   PINOUT := 10;  -- 10 IS NOT A DIGIT.
+                              ELSE
+                                   PINOUT := IDENT_INT (-1);
+                              END IF;
+                         END E4;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN E4");
+               END;
+          END LOOP;
+     END T4;
+
+BEGIN
+
+     TEST ("C95085A", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "FOR OUT OF RANGE SCALAR ARGUMENTS");
+
+     BEGIN  -- (A)
+          T1.E1 (10, "10");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E1 (10)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR E1 (10)");
+     END;  -- (A)
+
+     BEGIN  -- (B)
+          T1.E1 (IDENT_INT (-1), "-1");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E1 (" &
+                  "IDENT_INT (-1))");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR E1 (" &
+                       "IDENT_INT (-1))");
+     END;  -- (B)
+
+     BEGIN  -- (C)
+          I := IDENT_INT (10);
+          T2.E2 (I, "10");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E2 (10)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR E2 (10)");
+     END;  -- (C)
+
+     BEGIN -- (C1)
+          I := IDENT_INT (-1);
+          T2.E2 (I, "-1");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E2 (-1)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR E2 (-1)");
+     END; -- (C1)
+
+     BEGIN  -- (D)
+          CALLED := FALSE;
+          D := IDENT_INT (1);
+          T3.E3 (D, "10");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
+                  "E3 (10)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                            "E3 (10)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR E3 (10)");
+     END;  -- (D)
+
+     BEGIN -- (D1)
+          CALLED := FALSE;
+          D := IDENT_INT (1);
+          T3.E3 (D, "-1");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
+                  "E3 (-1)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                            "E3 (-1)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR E3 (-1)");
+     END; -- (D1)
+
+     BEGIN  -- (E)
+          CALLED := FALSE;
+          D := 9;
+          T4.E4 (D, "10");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
+                  "E4 (10)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                            "E4 (10)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR E4 (10)");
+     END;  -- (E)
+
+     BEGIN -- (E1)
+          CALLED := FALSE;
+          D := 0;
+          T4.E4 (D, "-1");
+          FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
+                  "E4 (-1)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               COUNT := COUNT + 1;
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL " &
+                            "E4 (-1)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR E4 (-1)");
+     END; -- (E1)
+
+     IF COUNT /= 8 THEN
+          FAILED ("INCORRECT NUMBER OF CONSTRAINT_ERRORS RAISED");
+     END IF;
+
+     RESULT;
+
+END C95085A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085b.ada
new file mode 100644
index 000000000..27ef17052
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085b.ada
@@ -0,0 +1,183 @@
+-- C95085B.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 UNDER APPROPRIATE CIRCUMSTANCES
+-- WITH RESPECT TO PARAMETERS OF RECORD TYPES IN ENTRY CALLS.  SUBTESTS
+-- INVOLVE ACTUAL RECORD PARAMETERS WHOSE CONSTRAINT VALUES ARE NOT
+-- EQUAL TO THE CONSTRAINTS ON THEIR CORRESPONDING FORMAL PARAMETERS:
+--        (A) IN PARAMETER, STATIC AGGREGATE.
+--        (B) IN PARAMETER, DYNAMIC AGGREGATE.
+--        (C) IN PARAMETER, VARIABLE.
+--        (D) IN OUT PARAMETER, EXCEPTION RAISED ON CALL.
+--        (E) OUT PARAMETER, EXCEPTION RAISED ON CALL.
+
+-- JWC 10/25/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085B IS
+
+     SUBTYPE INT IS INTEGER RANGE 0..10;
+
+     TYPE REC (N : INT := 0) IS
+          RECORD
+               A : STRING (1..N);
+          END RECORD;
+
+     SUBTYPE SREC IS REC(N=>3);
+
+BEGIN
+
+     TEST ("C95085B", "CHECK RAISING OF CONSTRAINT_ERROR FOR " &
+                      "PARAMETERS OF RECORD TYPES");
+
+     DECLARE
+
+          TASK TSK1 IS
+               ENTRY E (R : IN SREC);
+          END TSK1;
+
+          TASK BODY TSK1 IS
+          BEGIN
+               LOOP
+                    BEGIN
+                         SELECT
+                              ACCEPT E (R : IN SREC) DO
+                                   FAILED ("EXCEPTION NOT RAISED ON " &
+                                           "CALL TO TSK1");
+                              END E;
+                         OR
+                              TERMINATE;
+                         END SELECT;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("EXCEPTION RAISED IN TSK1");
+                    END;
+               END LOOP;
+          END TSK1;
+
+     BEGIN
+
+          BEGIN -- (A)
+               TSK1.E ((2,"AA"));
+               FAILED ("EXCEPTION NOT RAISED IN SUBTEST (A)");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (A)");
+          END; -- (A)
+
+          BEGIN -- (B)
+               TSK1.E ((IDENT_INT(2), "AA"));
+               FAILED ("EXCEPTION NOT RAISED IN SUBTEST (B)");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (B)");
+          END; -- (B)
+
+          DECLARE -- (C)
+               R : REC     := (IDENT_INT(2), "AA");
+          BEGIN -- (C)
+               TSK1.E (R);
+               FAILED ("EXCEPTION NOT RAISED IN SUBTEST (C)");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (C)");
+          END; -- (C)
+
+     END;
+
+     DECLARE -- (D)
+
+          R : REC := (IDENT_INT(2), "AA");
+
+          TASK TSK2 IS
+               ENTRY E (R : IN OUT SREC);
+          END TSK2;
+
+          TASK BODY TSK2 IS
+          BEGIN
+               SELECT
+                    ACCEPT E (R : IN OUT SREC) DO
+                         FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
+                                 "TSK2");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TSK2");
+          END TSK2;
+
+     BEGIN -- (D)
+          TSK2.E (R);
+          FAILED ("EXCEPTION NOT RAISED IN SUBTEST (D)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (D)");
+     END; -- (D)
+
+     DECLARE -- (E)
+
+          R : REC;
+
+          TASK TSK3 IS
+               ENTRY E (R : OUT SREC);
+          END TSK3;
+
+          TASK BODY TSK3 IS
+          BEGIN
+               SELECT
+                    ACCEPT E (R : OUT SREC) DO
+                         FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
+                                 "TSK3");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TSK3");
+          END TSK3;
+
+     BEGIN -- (E)
+          TSK3.E (R);
+          FAILED ("EXCEPTION NOT RAISED IN SUBTEST (E)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (E)");
+     END; -- (E)
+
+     RESULT;
+
+END C95085B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085c.ada
new file mode 100644
index 000000000..f2875e340
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085c.ada
@@ -0,0 +1,245 @@
+-- C95085C.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 UNDER THE
+-- APPROPRIATE CIRCUMSTANCES FOR ARRAY PARAMETERS IN ENTRY CALLS,
+-- NAMELY WHEN THE ACTUAL BOUNDS DON'T MATCH THE FORMAL BOUNDS
+-- (BEFORE THE CALL FOR ALL MODES).
+-- SUBTESTS ARE:
+--      (A) IN MODE, ONE DIMENSION, STATIC AGGREGATE.
+--      (B) IN MODE, TWO DIMENSIONS, DYNAMIC AGGREGATE.
+--      (C) IN MODE, TWO DIMENSIONS, DYNAMIC VARIABLE.
+--      (D) IN OUT MODE, THREE DIMENSIONS, STATIC VARIABLE.
+--      (E) OUT MODE, ONE DIMENSION, DYNAMIC VARIABLE.
+--      (F) IN OUT MODE, NULL STRING AGGREGATE.
+--      (G) IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE (OK CASE).
+--          IN OUT MODE, TWO DIMENSIONS, NULL AGGREGATE.
+
+-- JWC 10/28/85
+-- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085C IS
+
+BEGIN
+     TEST ("C95085C", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
+                      "ACTUAL ARRAY BOUNDS DON'T MATCH FORMAL BOUNDS");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+          SUBTYPE ST IS STRING (1..3);
+
+          TASK TSK IS
+               ENTRY E (A : ST);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (A : ST) DO
+                         FAILED ("EXCEPTION NOT RAISED ON CALL - (A)");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (A)");
+          END TSK;
+
+     BEGIN -- (A)
+
+          TSK.E ("AB");
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (A)");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - (A)");
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          SUBTYPE S IS INTEGER RANGE 1..3;
+          TYPE T IS ARRAY (S,S) OF INTEGER;
+
+          TASK TSK IS
+               ENTRY E (A : T);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (A : T) DO
+                         FAILED ("EXCEPTION NOT RAISED ON CALL - (B)");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (B)");
+          END TSK;
+
+     BEGIN -- (B)
+
+          TSK.E ((1..3 => (1..IDENT_INT(2) => 0)));
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (B)");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - (B)");
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          SUBTYPE S IS INTEGER RANGE 1..5;
+          TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF INTEGER;
+          SUBTYPE ST IS T (1..3,1..3);
+          V : T (1..IDENT_INT(2), 1..3) :=
+                (1..IDENT_INT(2) => (1..3 => 0));
+
+          TASK TSK IS
+               ENTRY E (A :ST);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (A :ST) DO
+                         FAILED ("EXCEPTION NOT RAISED ON CALL - (C)");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (C)");
+          END TSK;
+
+     BEGIN -- (C)
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (C)");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - (C)");
+     END; -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D)
+
+          SUBTYPE S IS INTEGER RANGE 1..5;
+          TYPE T IS ARRAY (S RANGE <>, S RANGE <>, S RANGE <>) OF
+                    INTEGER;
+          SUBTYPE ST IS T (1..3, 1..3, 1..3);
+          V : T (1..3, 1..2, 1..3) :=
+                (1..3 => (1..2 => (1..3 => 0)));
+
+          TASK TSK IS
+               ENTRY E (A : IN OUT ST);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (A : IN OUT ST) DO
+                         FAILED ("EXCEPTION NOT RAISED ON CALL - (D)");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (D)");
+          END TSK;
+
+     BEGIN -- (D)
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL - (D)");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - (D)");
+     END; -- (D)
+
+     --------------------------------------------------
+
+
+     DECLARE -- (G)
+
+          SUBTYPE S IS INTEGER RANGE 1..5;
+          TYPE T IS ARRAY (S RANGE <>, S RANGE <>) OF CHARACTER;
+          SUBTYPE ST IS T (2..1, 2..1);
+          V : T (2..1, 2..1) := (2..1 => (2..1 => ' '));
+
+          TASK TSK IS
+               ENTRY E (A : IN OUT ST);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (A : IN OUT ST)  DO
+                         COMMENT ("OK CASE CALLED CORRECTLY");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (G)");
+          END TSK;
+
+     BEGIN -- (G)
+
+          TSK.E (V);
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED ON OK CASE - (G)");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED ON OK CASE - (G)");
+     END; -- (G)
+
+     --------------------------------------------------
+
+
+     RESULT;
+END C95085C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085d.ada
new file mode 100644
index 000000000..059298180
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085d.ada
@@ -0,0 +1,97 @@
+-- C95085D.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 UNDER THE APPROPRIATE
+-- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+-- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+-- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+-- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+-- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (A) BEFORE CALL, IN MODE, STATIC PRIVATE DISCRIMINANT.
+
+-- JWC 10/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085D IS
+
+BEGIN
+     TEST ("C95085D", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          PACKAGE PKG IS
+               TYPE E IS (E1, E2, E3);
+               TYPE T (D : E := E1) IS PRIVATE;
+               TYPE AR IS ARRAY (E1 .. E3) OF INTEGER;
+          PRIVATE
+               TYPE T (D : E := E1) IS
+                    RECORD
+                         I : INTEGER;
+                         A : AR;
+                    END RECORD;
+          END PKG;
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE A1 IS A (E3);
+          V : A (E2) := NEW T (E2);
+
+          TASK TSK IS
+               ENTRY E (X : A1);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : A1) DO
+                         FAILED ("EXCEPTION NOT RAISED ON CALL");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+     BEGIN
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     ------------------------------------------------
+
+     RESULT;
+END C95085D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085e.ada
new file mode 100644
index 000000000..86c446c8b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085e.ada
@@ -0,0 +1,87 @@
+-- C95085E.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 UNDER THE APPROPRIATE
+-- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+-- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+-- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+-- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+-- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (B) BEFORE CALL, IN MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
+
+-- JWC 10/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085E IS
+
+BEGIN
+     TEST ("C95085E", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          TYPE T IS ARRAY (BOOLEAN RANGE <>, CHARACTER RANGE <>) OF
+                    INTEGER;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE A1 IS A (BOOLEAN, 'A'..'C');
+          V : A := NEW T (BOOLEAN, 'A'..IDENT_CHAR('B'));
+
+          TASK TSK IS
+               ENTRY E (X : A1);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : A1) DO
+                         FAILED ("EXCEPTION NOT RAISED ON CALL");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+              WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+     BEGIN
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+                FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95085E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085f.ada
new file mode 100644
index 000000000..7a716595d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085f.ada
@@ -0,0 +1,84 @@
+-- C95085F.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 UNDER THE APPROPRIATE
+-- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY
+-- WHEN THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+-- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+-- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+-- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (C) BEFORE CALL, IN OUT MODE, STATIC ONE DIMENSIONAL BOUNDS.
+
+-- JWC 10/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085F IS
+
+BEGIN
+     TEST ("C95085F", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          TYPE A IS ACCESS STRING;
+          SUBTYPE A1 IS A (1..3);
+          V : A (2..4) := NEW STRING (2..4);
+
+          TASK TSK IS
+               ENTRY E (X : IN OUT A1);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : IN OUT A1) DO
+                         FAILED ("EXCEPTION NOT RAISED ON CALL");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+     BEGIN
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95085F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085g.ada
new file mode 100644
index 000000000..2004164d2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085g.ada
@@ -0,0 +1,98 @@
+-- C95085G.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 UNDER THE APPROPRIATE
+-- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+-- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+-- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+-- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+-- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (D) BEFORE CALL, IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
+
+-- JWC 10/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085G IS
+
+BEGIN
+     TEST ("C95085G", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          SUBTYPE INT IS INTEGER RANGE 0..10;
+          TYPE T (C : CHARACTER := 'A';
+                  B : BOOLEAN := FALSE;
+                  I : INT := 0) IS
+               RECORD
+                    J : INTEGER;
+                    CASE B IS
+                         WHEN FALSE =>
+                              K : INTEGER;
+                         WHEN TRUE =>
+                              S : STRING (1 .. I);
+                    END CASE;
+               END RECORD;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A ('Z', TRUE, 5);
+          V : A := NEW T ('Z', IDENT_BOOL(FALSE), 5);
+
+          TASK TSK IS
+               ENTRY E (X : IN OUT SA);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : IN OUT SA) DO
+                         FAILED ("EXCEPTION NOT RAISED ON CALL");
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                     FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+     BEGIN
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED BEFORE CALL");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95085G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085h.ada
new file mode 100644
index 000000000..a46720474
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085h.ada
@@ -0,0 +1,111 @@
+-- C95085H.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 UNDER THE APPROPRIATE
+-- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+-- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+-- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+-- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+-- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (E) AFTER RETURN, IN OUT MODE, STATIC LIMITED PRIVATE
+--           DISCRIMINANTS.
+
+-- JWC 10/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085H IS
+
+BEGIN
+     TEST ("C95085H", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          CALLED : BOOLEAN := FALSE;
+
+          PACKAGE PKG IS
+               SUBTYPE INT IS INTEGER RANGE 0..10;
+               SUBTYPE CHAR IS CHARACTER RANGE 'A' .. 'C';
+               TYPE T (I : INT := 0; C : CHAR := 'A') IS
+                    LIMITED PRIVATE;
+          PRIVATE
+               TYPE T (I : INT := 0; C : CHAR := 'A') IS
+                    RECORD
+                         J : INTEGER;
+                         CASE C IS
+                              WHEN 'A' =>
+                                   K : INTEGER;
+                              WHEN 'B' =>
+                                   S : STRING (1..I);
+                              WHEN OTHERS =>
+                                   NULL;
+                         END CASE;
+                    END RECORD;
+          END PKG;
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+
+          V : A (2,'B') := NEW T (2,'B');
+
+          TASK TSK IS
+               ENTRY E (X : IN OUT A);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : IN OUT A) DO
+                         CALLED := TRUE;
+                         X := NEW T (2,'A');
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+     BEGIN
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95085H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085i.ada
new file mode 100644
index 000000000..b2b08543c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085i.ada
@@ -0,0 +1,100 @@
+-- C95085I.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 UNDER THE APPROPRIATE
+-- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+-- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+-- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+-- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+-- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (F) AFTER RETURN, IN OUT MODE, DYNAMIC THREE DIMENSIONAL
+--           BOUNDS.
+
+-- JWC 10/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085I IS
+
+BEGIN
+     TEST ("C95085I", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          CALLED : BOOLEAN := FALSE;
+
+          TYPE E IS (E1, E2, E3);
+
+          TYPE T IS ARRAY (CHARACTER RANGE <>,
+                           E RANGE <>,
+                           BOOLEAN RANGE <>
+                          ) OF INTEGER;
+
+          TYPE A IS ACCESS T;
+
+          V : A ('A'..'Z', E1..E2, BOOLEAN) :=
+                    NEW T ('A'..'Z', E1..E2, BOOLEAN);
+
+          TASK TSK IS
+               ENTRY E (X : IN OUT A);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : IN OUT A) DO
+                         CALLED := TRUE;
+                         IF EQUAL (3,3) THEN
+                              X := NEW T ('A'..'Z', E2..E3, BOOLEAN);
+                         END IF;
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+     BEGIN
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95085I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085j.ada
new file mode 100644
index 000000000..d1ea3ce2e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085j.ada
@@ -0,0 +1,90 @@
+-- C95085J.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 UNDER THE APPROPRIATE
+-- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+-- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+-- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+-- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+-- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (G) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, STATIC ONE
+--           DIMENSIONAL BOUNDS.
+
+-- JWC 10/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085J IS
+
+BEGIN
+     TEST ("C95085J", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          CALLED : BOOLEAN := FALSE;
+
+          TYPE A IS ACCESS STRING;
+
+          V : A (1..3) := NEW STRING (1..3);
+
+          TASK TSK IS
+               ENTRY E (X : OUT A);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : OUT A) DO
+                         CALLED := TRUE;
+                         X := NEW STRING (2..3);
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+              WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+     BEGIN
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95085J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085k.ada
new file mode 100644
index 000000000..37952f0ae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085k.ada
@@ -0,0 +1,97 @@
+-- C95085K.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 UNDER THE APPROPRIATE
+-- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+-- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+-- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+-- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+-- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (H) AFTER RETURN, OUT MODE, UNCONSTRAINED FORMAL, DYNAMIC
+--           RECORD DISCRIMINANT.
+
+-- JWC 10/24/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085K IS
+
+BEGIN
+     TEST ("C95085K", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          CALLED : BOOLEAN := FALSE;
+
+          TYPE ARR IS ARRAY (BOOLEAN RANGE <>) OF INTEGER;
+          TYPE T (B : BOOLEAN := FALSE) IS
+               RECORD
+                    I : INTEGER;
+                    A : ARR (FALSE..B);
+               END RECORD;
+
+          TYPE A IS ACCESS T;
+
+          V : A (IDENT_BOOL(FALSE)) := NEW T (IDENT_BOOL(FALSE));
+
+          TASK TSK IS
+               ENTRY E (X : OUT A);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : OUT A) DO
+                         CALLED := TRUE;
+                         X := NEW T (TRUE);
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+     BEGIN
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95085K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085l.ada
new file mode 100644
index 000000000..cb62ff249
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085l.ada
@@ -0,0 +1,109 @@
+-- C95085L.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 UNDER THE APPROPRIATE
+-- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN
+-- THE ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+-- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+-- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+-- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (I) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, STATIC
+--           PRIVATE DISCRIMINANTS.
+
+-- JWC 10/24/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085L IS
+
+BEGIN
+     TEST ("C95085L", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          CALLED : BOOLEAN := FALSE;
+
+          PACKAGE PKG IS
+               TYPE E IS (E1, E2, E3);
+               TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
+                    PRIVATE;
+          PRIVATE
+               TYPE ARR IS ARRAY (E RANGE <>) OF INTEGER;
+               TYPE T (D : E := E1; B : BOOLEAN := FALSE) IS
+                    RECORD
+                         I : INTEGER;
+                         CASE B IS
+                              WHEN FALSE =>
+                                   J : INTEGER;
+                              WHEN TRUE =>
+                                   A : ARR (E1 .. D);
+                         END CASE;
+                    END RECORD;
+          END PKG;
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A (E2, TRUE);
+          V : A (E2, FALSE) := NEW T (E2, FALSE);
+
+          TASK TSK IS
+               ENTRY E (X : OUT SA);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : OUT SA) DO
+                         CALLED := TRUE;
+                         X := NEW T (E2, TRUE);
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+     BEGIN
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     ------------------------------------------------
+
+     RESULT;
+END C95085L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085m.ada
new file mode 100644
index 000000000..45e73fffa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085m.ada
@@ -0,0 +1,96 @@
+-- C95085M.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 UNDER THE APPROPRIATE
+-- CIRCUMSTANCES FOR ACCESS PARAMETERS IN ENTRY CALLS, NAMELY WHEN THE
+-- ACTUAL INDEX BOUNDS OR DISCRIMINANTS ARE NOT EQUAL
+-- TO THE FORMAL CONSTRAINTS BEFORE THE CALL (FOR IN AND IN OUT
+-- MODES), AND WHEN THE FORMAL CONSTRAINTS ARE NOT EQUAL TO THE
+-- ACTUAL CONSTRAINTS UPON RETURN (FOR IN OUT AND OUT MODES).
+
+--       (J) AFTER RETURN, OUT MODE, CONSTRAINED FORMAL, DYNAMIC TWO
+--           DIMENSIONAL BOUNDS.
+
+-- JWC 10/24/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085M IS
+
+BEGIN
+     TEST ("C95085M", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
+                      "APPROPRIATELY FOR ACCESS PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE
+
+          CALLED : BOOLEAN := FALSE;
+
+          TYPE T IS ARRAY (INTEGER RANGE <>,
+                           CHARACTER RANGE <>) OF INTEGER;
+
+          TYPE A IS ACCESS T;
+
+          V : A (1..10, 'A'..'Z') := NEW T (1..10, 'A'..'Z');
+
+          Y : CONSTANT CHARACTER := IDENT_CHAR('Y');
+          SUBTYPE SA IS A (1..10, 'A'..Y);
+
+          TASK TSK IS
+               ENTRY E (X : OUT SA);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : OUT SA) DO
+                         CALLED := TRUE;
+                         X := NEW T (1..10, 'A'..IDENT_CHAR('Y'));
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+     BEGIN
+
+          TSK.E (V);
+          FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95085M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085n.ada
new file mode 100644
index 000000000..7f7e3a63b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085n.ada
@@ -0,0 +1,117 @@
+-- C95085N.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 AFTER AN ENTRY CALL FOR THE
+-- CASE OF A PRIVATE TYPE IMPLEMENTED AS A SCALAR TYPE WHERE THE VALUE
+-- OF THE FORMAL PARAMETER DOES NOT BELONG TO THE SUBTYPE OF THE ACTUAL
+-- PARAMETER.
+
+-- JWC 10/29/85
+-- JRK 1/15/86      ENSURE THAT EXCEPTION RAISED AFTER CALL, NOT BEFORE
+--                  CALL.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085N IS
+
+BEGIN
+     TEST ("C95085N", "CHECK THAT PRIVATE TYPE (SCALAR) RAISES " &
+                      "CONSTRAINT_ERROR AFTER CALL WHEN FORMAL " &
+                      "PARAMETER VALUE IS NOT IN ACTUAL'S SUBTYPE");
+
+     DECLARE
+
+          CALLED : BOOLEAN := FALSE;
+
+          PACKAGE P IS
+               TYPE T IS PRIVATE;
+               DC : CONSTANT T;
+
+               GENERIC PACKAGE PP IS
+               END PP;
+          PRIVATE
+               TYPE T IS NEW INTEGER;
+               DC : CONSTANT T := -1;
+          END P;
+
+          TASK TSK IS
+               ENTRY E (X : OUT P.T);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : OUT P.T) DO
+                         CALLED := TRUE;
+                         X := P.DC;
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+          GENERIC
+               Y : IN OUT P.T;
+          PACKAGE CALL IS
+          END CALL;
+
+          PACKAGE BODY CALL IS
+          BEGIN
+               TSK.E (Y);
+               FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED");
+          END CALL;
+
+          PACKAGE BODY P IS
+               Z : T RANGE 0..1 := 0;
+               PACKAGE BODY PP IS
+                    PACKAGE CALL_Q IS NEW CALL (Z);
+               END PP;
+          END P;
+
+     BEGIN
+
+          BEGIN
+               DECLARE
+                    PACKAGE CALL_Q_NOW IS NEW P.PP;    -- START HERE.
+               BEGIN
+                    NULL;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER INVOKED");
+          END;
+
+     END;
+
+     RESULT;
+END C95085N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085o.ada
new file mode 100644
index 000000000..f5cd288a3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95085o.ada
@@ -0,0 +1,118 @@
+-- C95085O.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 AFTER AN ENTRY CALL FOR THE
+-- CASE OF A PRIVATE TYPE IMPLEMENTED AS AN ACCESS TYPE WHERE THE VALUE
+-- OF THE FORMAL PARAMETER DOES NOT BELONG TO THE SUBTYPE OF THE ACTUAL
+-- PARAMETER.
+
+-- JWC 10/30/85
+-- JRK 1/15/86      ENSURE THAT EXCEPTION RAISED AFTER CALL, NOT BEFORE
+--                  CALL.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95085O IS
+
+BEGIN
+
+     TEST ("C95085O", "CHECK THAT PRIVATE TYPE (ACCESS) RAISES " &
+                      "CONSTRAINT_ERROR AFTER CALL WHEN FORMAL " &
+                      "PARAMETER VALUE IS NOT IN ACTUAL'S SUBTYPE");
+
+     DECLARE
+
+          CALLED : BOOLEAN := FALSE;
+
+          PACKAGE P IS
+               TYPE T IS PRIVATE;
+               DC : CONSTANT T;
+
+               GENERIC PACKAGE PP IS
+               END PP;
+          PRIVATE
+               TYPE T IS ACCESS STRING;
+               DC : CONSTANT T := NEW STRING'("AAA");
+          END P;
+
+          TASK TSK IS
+               ENTRY E (X : IN OUT P.T);
+          END TSK;
+
+          TASK BODY TSK IS
+          BEGIN
+               SELECT
+                    ACCEPT E (X : IN OUT P.T) DO
+                         CALLED := TRUE;
+                         X := P.DC;
+                    END E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK BODY");
+          END TSK;
+
+          GENERIC
+               Y : IN OUT P.T;
+          PACKAGE CALL IS
+          END CALL;
+
+          PACKAGE BODY CALL IS
+          BEGIN
+               TSK.E (Y);
+               FAILED ("EXCEPTION NOT RAISED AFTER RETURN");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF NOT CALLED THEN
+                         FAILED ("EXCEPTION RAISED BEFORE CALL");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED");
+          END CALL;
+
+          PACKAGE BODY P IS
+               Z : T (1..5) := NEW STRING'("CCCCC");
+               PACKAGE BODY PP IS
+                    PACKAGE CALL_Q IS NEW CALL (Z);
+               END PP;
+          END P;
+
+     BEGIN
+
+          BEGIN
+               DECLARE
+                    PACKAGE CALL_Q_NOW IS NEW P.PP;    -- START HERE.
+               BEGIN
+                    NULL;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER INVOKED");
+          END;
+
+     END;
+
+     RESULT;
+END C95085O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086a.ada
new file mode 100644
index 000000000..e26e8b872
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086a.ada
@@ -0,0 +1,94 @@
+-- C95086A.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 NOT RAISED AT THE TIME OF CALL WHEN
+-- THE VALUE OF AN ACTUAL OUT SCALAR PARAMETER DOES NOT SATISFY THE
+-- RANGE CONSTRAINTS OF THE FORMAL PARAMETER.
+
+-- GLH 7/16/85
+-- JRK 8/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95086A IS
+
+     SUBTYPE SUBINT1 IS INTEGER RANGE -10..10;
+     SUBTYPE SUBINT2 IS INTEGER RANGE -20..20;
+
+     I10  : SUBINT1 := 10;
+     I20  : SUBINT2 := 20;
+
+     TASK T1 IS
+          ENTRY E1 (I : OUT SUBINT1);
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          LOOP
+               BEGIN
+                    SELECT
+                         ACCEPT E1 (I : OUT SUBINT1) DO
+                              I := SUBINT1'FIRST;
+                         END E1;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN ACCEPT E1");
+               END;
+          END LOOP;
+     END T1;
+
+BEGIN
+
+     TEST ("C95086A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+                      "AT THE TIME OF CALL WHEN THE VALUE OF AN " &
+                      "ACTUAL OUT SCALAR PARAMETER DOES NOT " &
+                      "SATISFY THE RANGE CONSTRAINTS OF THE FORMAL " &
+                      "PARAMETER");
+
+     BEGIN
+          T1.E1 (SUBINT1(I20));
+          IF I20 /= IDENT_INT (-10) THEN
+               FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 1");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED ON CALL TO E1 - 1");
+     END;
+
+     BEGIN
+          I20 := IDENT_INT (20);
+          T1.E1 (I20);
+          IF I20 /= IDENT_INT (-10) THEN
+               FAILED ("OUT PARAM DID NOT GET CORRECT VALUE - 2");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED ON CALL TO E1 - 2");
+     END;
+
+     RESULT;
+
+END C95086A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086b.ada
new file mode 100644
index 000000000..bc222ebc3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086b.ada
@@ -0,0 +1,202 @@
+-- C95086B.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 NOT RAISED FOR ACCESS PARAMETERS
+--   BEFORE AN ENTRY CALL, WHEN AN IN OR IN OUT ACTUAL ACCESS
+--   PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS DIFFERENT
+--   FROM THE FORMAL PARAMETER.
+--
+--   SUBTESTS ARE:
+--       (A) IN MODE, STATIC ONE DIMENSIONAL BOUNDS.
+--       (B) IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
+--       (C) CASE (A), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
+--       (D) CASE (B), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
+
+-- RJW 1/27/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95086B IS
+
+BEGIN
+     TEST ( "C95086B", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+            "BEFORE AN ENTRY CALL, WHEN AN IN OR IN OUT ACTUAL " &
+            "ACCESS PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS " &
+            "DIFFERENT FROM THE FORMAL PARAMETER" );
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          TYPE E IS (E1, E2, E3, E4);
+          TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A (E2..E4);
+          V : A (E1..E2) := NULL;
+
+          TASK T1 IS
+               ENTRY P (X : SA);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT P (X : SA);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED IN TASK - (A)" );
+          END T1;
+
+     BEGIN -- (A)
+
+          T1.P (V);
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - (A)" );
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
+
+          TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
+               RECORD
+                    I : INTEGER;
+                    CASE B IS
+                         WHEN FALSE =>
+                              J : INTEGER;
+                         WHEN TRUE =>
+                              A : ARR ('A' .. C);
+                    END CASE;
+               END RECORD;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A (TRUE, 'C');
+          V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
+
+          TASK T1 IS
+               ENTRY P (X : IN OUT SA);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT P (X : IN OUT SA) DO
+                    NULL;
+               END P;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED IN TASK - (B)" );
+          END T1;
+
+     BEGIN -- (B)
+
+          T1.P (V);
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - (B)" );
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          TYPE E IS (E1, E2, E3, E4);
+          TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A (E2..E4);
+          V : A (E1..E2) := NULL;
+
+          TASK T1 IS
+               ENTRY P (X : SA);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT P (X : SA) DO
+                    NULL;
+               END P;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED IN TASK - (C)" );
+          END T1;
+
+     BEGIN -- (C)
+
+          T1.P (SA(V));
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - (C)" );
+     END; -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D)
+
+          TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
+
+          TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
+               RECORD
+                    I : INTEGER;
+                    CASE B IS
+                         WHEN FALSE =>
+                              J : INTEGER;
+                         WHEN TRUE =>
+                              A : ARR ('A' .. C);
+                    END CASE;
+               END RECORD;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A (TRUE, 'C');
+          V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
+
+          TASK T1 IS
+               ENTRY P (X : IN OUT SA);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT P (X : IN OUT SA);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED IN TASK - (D)" );
+          END T1;
+
+     BEGIN -- (D)
+
+          T1.P (SA(V));
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ( "EXCEPTION RAISED - (D)" );
+     END; -- (D)
+
+     --------------------------------------------------
+
+     RESULT;
+END C95086B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086c.ada
new file mode 100644
index 000000000..9c2050b71
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086c.ada
@@ -0,0 +1,250 @@
+-- C95086C.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 NOT RAISED FOR ACCESS PARAMETERS
+--   AFTER THE ENTRY CALL, WHEN AN IN OUT OR OUT FORMAL
+--   ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS
+--   DIFFERENT CONSTRAINTS.
+--
+--   SUBTESTS ARE:
+--       (A) IN OUT MODE, STATIC PRIVATE DISCRIMINANT.
+--       (B) OUT MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
+--       (C) SAME AS (A), WITH TYPE CONVERSION.
+--       (D) SAME AS (B), WITH TYPE CONVERSION.
+
+-- RJW 1/29/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95086C IS
+
+BEGIN
+     TEST ("C95086C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+           "AFTER THE ENTRY CALL, WHEN AN IN OUT OR OUT FORMAL " &
+           "ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS " &
+           "DIFFERENT CONSTRAINTS" );
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          PACKAGE PKG IS
+               TYPE E IS (E1, E2);
+               TYPE T (D : E := E1) IS PRIVATE;
+          PRIVATE
+               TYPE T (D : E := E1) IS
+                    RECORD
+                         I : INTEGER;
+                         CASE D IS
+                              WHEN E1 =>
+                                   B : BOOLEAN;
+                              WHEN E2 =>
+                                   C : CHARACTER;
+                         END CASE;
+                    END RECORD;
+          END PKG;
+
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A (E2);
+          V : A (E1) := NULL;
+          ENTERED : BOOLEAN := FALSE;
+
+          TASK T1 IS
+               ENTRY P (X : IN OUT SA);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT P (X : IN OUT SA) DO
+                    ENTERED := TRUE;
+                    X := NULL;
+               END P;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (A)");
+          END T1;
+
+     BEGIN -- (A)
+
+          T1.P (V);
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT ENTERED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (A)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (A)");
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
+                    INTEGER;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
+          V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
+                 IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
+          ENTERED : BOOLEAN := FALSE;
+
+          TASK T1 IS
+               ENTRY P (X : OUT SA);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT P (X : OUT SA) DO
+                    ENTERED := TRUE;
+                    X := NULL;
+               END P;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (B)");
+          END T1;
+
+     BEGIN -- (B)
+
+          T1.P (V);
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT ENTERED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (B)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (B)");
+     END; -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          PACKAGE PKG IS
+               TYPE E IS (E1, E2);
+               TYPE T (D : E := E1) IS PRIVATE;
+          PRIVATE
+               TYPE T (D : E := E1) IS
+                    RECORD
+                         I : INTEGER;
+                         CASE D IS
+                              WHEN E1 =>
+                                   B : BOOLEAN;
+                              WHEN E2 =>
+                                   C : CHARACTER;
+                         END CASE;
+                    END RECORD;
+          END PKG;
+
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A (E2);
+          V : A (E1) := NULL;
+          ENTERED : BOOLEAN := FALSE;
+
+          TASK T1 IS
+               ENTRY P (X : IN OUT SA);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT P (X : IN OUT SA) DO
+                    ENTERED := TRUE;
+                    X := NULL;
+               END P;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (C)");
+          END T1;
+
+     BEGIN -- (C)
+
+          T1.P (SA(V));
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT ENTERED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (C)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (C)");
+     END; -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D)
+
+          TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
+                    INTEGER;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
+          V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
+                 IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
+          ENTERED : BOOLEAN := FALSE;
+
+          TASK T1 IS
+               ENTRY P (X : OUT SA);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT P (X : OUT SA) DO
+                    ENTERED := TRUE;
+                    X := NULL;
+               END P;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (D)");
+          END T1;
+
+     BEGIN -- (D)
+
+          T1.P (SA(V));
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT ENTERED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (D)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (D)");
+     END; -- (D)
+
+     --------------------------------------------------
+
+     RESULT;
+END C95086C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086d.ada
new file mode 100644
index 000000000..616c025fb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086d.ada
@@ -0,0 +1,142 @@
+-- C95086D.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 NOT RAISED FOR ACCESS PARAMETERS
+--    BEFORE OR AFTER THE ENTRY CALL, WHEN AN UNCONSTRAINED ACTUAL
+--    OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR TO THE
+--    ENTRY CALL) WITH CONSTRAINTS DIFFERENT FROM THE FORMAL
+--    PARAMETER.
+--
+--   SUBTESTS ARE:
+--       (A) STATIC LIMITED PRIVATE DISCRIMINANT.
+--       (B) DYNAMIC ONE DIMENSIONAL BOUNDS.
+
+-- RJW 2/3/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95086D IS
+
+BEGIN
+     TEST ("C95086D", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+           "BEFORE AND AFTER THE ENTRY CALL, WHEN AN UNCONSTRAINED " &
+           "ACTUAL OUT ACCESS PARAMETER DESIGNATES AN OBJECT (PRIOR " &
+           "TO THE ENTRY CALL) WITH CONSTRAINTS DIFFERENT FROM THE " &
+           "FORMAL PARAMETER");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          PACKAGE PKG IS
+               SUBTYPE INT IS INTEGER RANGE 0..5;
+               TYPE T (I : INT := 0) IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+               TYPE T (I : INT := 0) IS
+                    RECORD
+                         J : INTEGER;
+                         A : ARR (1..I);
+                    END RECORD;
+          END PKG;
+
+          USE PKG;
+
+          TYPE A IS ACCESS T;
+          SUBTYPE SA IS A (3);
+          V : A := NEW T (2);
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T1 IS
+               ENTRY P (X : OUT SA);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT P (X : OUT SA) DO
+                    CALLED := TRUE;
+                    X := NEW T (3);
+               END P;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (A)");
+          END T1;
+
+     BEGIN -- (A)
+
+          T1.P (V);
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE ENTRY CALL - (A)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (A)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (A)");
+     END; -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          TYPE A IS ACCESS STRING;
+          SUBTYPE SA IS A (1..2);
+          V : A := NEW STRING (IDENT_INT(5) .. IDENT_INT(7));
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T1 IS
+               ENTRY P (X : OUT SA);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT P (X : OUT SA) DO
+                    CALLED := TRUE;
+                    X := NEW STRING (IDENT_INT(1) .. IDENT_INT(2));
+               END P;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (B)");
+          END T1;
+
+     BEGIN -- (B)
+
+          T1.P (V);
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE ENTRY CALL - (B)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (B)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (B)");
+     END; -- (B)
+
+     --------------------------------------------------
+
+     RESULT;
+END C95086D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086e.ada
new file mode 100644
index 000000000..4e4f42b95
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086e.ada
@@ -0,0 +1,282 @@
+-- C95086E.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 NOT RAISED BEFORE OR AFTER THE ENTRY
+-- CALL FOR IN OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE
+-- FORM OF A TYPE CONVERSION.  THE FOLLOWING CASES ARE TESTED:
+--   (A) OK CASE.
+--   (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER
+--       COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE
+--       FORMAL INDEX SUBTYPE.
+--   (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER
+--       COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL
+--       ARRAYS.
+--   (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
+--       FORMAL INDEX SUBTYPE.
+--   (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
+--       FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY.
+
+-- RJW 2/3/86
+-- TMB 11/15/95 ELIMINATED INCOMPATIBILITY WITH ADA95
+-- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95086E IS
+
+BEGIN
+     TEST ("C95086E", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+           "BEFORE OR AFTER THE ENTRY CALL FOR IN OUT ARRAY " &
+           "PARAMETERS, WITH THE ACTUAL HAVING THE FORM OF A TYPE " &
+           "CONVERSION");
+
+     ---------------------------------------------
+
+     DECLARE -- (A)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..5;
+          TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+               OF BOOLEAN;
+          SUBTYPE FORMAL IS ARRAY_TYPE (1..3, 1..3);
+          SUBTYPE ACTUAL IS ARRAY_TYPE (1..3, 1..3);
+          AR : ACTUAL := (1..3 => (1..3 => TRUE));
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T IS
+               ENTRY E (X : IN OUT FORMAL);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (X : IN OUT FORMAL) DO
+                    CALLED := TRUE;
+               END E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (A)");
+          END T;
+
+     BEGIN -- (A)
+
+          T.E (FORMAL (AR));
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (A)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (A)");
+     END; -- (A)
+
+     ---------------------------------------------
+
+     DECLARE -- (B)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..3;
+          TYPE FORMAL IS ARRAY (INDEX, INDEX) OF BOOLEAN;
+          TYPE ACTUAL IS ARRAY (3..5, 3..5) OF BOOLEAN;
+          AR : ACTUAL := (3..5 => (3..5 => FALSE));
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T IS
+               ENTRY E (X : IN OUT FORMAL);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (X : IN OUT FORMAL) DO
+                    CALLED := TRUE;
+                    X(3, 3) := TRUE;
+               END E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (B)");
+          END T;
+
+     BEGIN -- (B)
+
+          T.E (FORMAL (AR));
+          IF AR(5, 5) /= TRUE THEN
+               FAILED ("INCORRECT RETURNED VALUE - (B)");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (B)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (B)");
+     END; -- (B)
+
+     ---------------------------------------------
+
+     DECLARE -- (C)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..5;
+          TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+               OF CHARACTER;
+          SUBTYPE FORMAL IS ARRAY_TYPE (2..0, 1..3);
+          AR : ARRAY_TYPE (2..1, 1..3) := (2..1 => (1..3 => ' '));
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T IS
+               ENTRY E (X : IN OUT FORMAL);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (X : IN OUT FORMAL) DO
+                    IF X'LAST /= 0 AND X'LAST(2) /= 3 THEN
+                         FAILED ("WRONG BOUNDS PASSED - (C)");
+                    END IF;
+                    CALLED := TRUE;
+                    X := (2..0 => (1..3 => 'A'));
+               END E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (C)");
+          END T;
+
+     BEGIN -- (C)
+
+          T.E (FORMAL (AR));
+          IF AR'LAST /= 1 AND AR'LAST(2) /= 3 THEN
+               FAILED ("BOUNDS CHANGED - (C)");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (C)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (C)");
+     END; -- (C)
+
+     ---------------------------------------------
+
+     DECLARE -- (D)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..3;
+          TYPE FORMAL IS ARRAY (INDEX RANGE 1..3, INDEX RANGE 3..1)
+               OF CHARACTER;
+          TYPE ACTUAL IS ARRAY (3..5, 5..3) OF CHARACTER;
+          AR : ACTUAL := (3..5 => (5..3 => ' '));
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T IS
+               ENTRY E (X : IN OUT FORMAL);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (X : IN OUT FORMAL) DO
+                    IF X'LAST /= 3 AND X'LAST(2) /= 1 THEN
+                         FAILED ("WRONG BOUNDS PASSED - (D)");
+                    END IF;
+                    CALLED := TRUE;
+                    X := (1..3 => (3..1 => 'A'));
+               END E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (D)");
+          END T;
+
+     BEGIN -- (D)
+
+          T.E (FORMAL (AR));
+          IF AR'LAST /= 5 AND AR'LAST(2) /= 3 THEN
+               FAILED ("BOUNDS CHANGED - (D)");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (D)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (D)");
+     END; -- (D)
+
+     ---------------------------------------------
+
+     DECLARE -- (E)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..3;
+          TYPE FORMAL IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+               OF CHARACTER;
+          TYPE ACTUAL IS ARRAY (POSITIVE RANGE 5..2,
+                                POSITIVE RANGE 1..3) OF CHARACTER;
+          AR : ACTUAL := (5..2 => (1..3 => ' '));
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T IS
+               ENTRY E (X : IN OUT FORMAL);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (X : IN OUT FORMAL) DO
+                    IF X'LAST /= 2 AND X'LAST(2) /= 3 THEN
+                         FAILED ("WRONG BOUNDS PASSED - (E)");
+                    END IF;
+                    CALLED := TRUE;
+                    X := (3..1 => (1..3 => ' '));
+               END E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (E)");
+          END T;
+
+     BEGIN -- (E)
+
+          T.E (FORMAL (AR));
+          IF AR'LAST /= 2 AND AR'LAST(2) /= 3 THEN
+               FAILED ("BOUNDS CHANGED - (E)");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (E)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (E)");
+     END; -- (E)
+
+     ---------------------------------------------
+
+     RESULT;
+END C95086E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086f.ada
new file mode 100644
index 000000000..00b84441b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95086f.ada
@@ -0,0 +1,282 @@
+-- C95086F.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 NOT RAISED BEFORE OR AFTER THE ENTRY
+-- CALL FOR OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE
+-- FORM OF A TYPE CONVERSION.  THE FOLLOWING CASES ARE TESTED:
+--   (A) OK CASE.
+--   (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER
+--       COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE
+--       FORMAL INDEX SUBTYPE.
+--   (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER
+--       COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL
+--       ARRAYS.
+--   (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
+--       FORMAL INDEX SUBTYPE.
+--   (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE
+--       FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY.
+
+-- RJW 2/3/86
+-- TMB 11/15/95 FIXED INCOMPATIBILITIES WITH ADA95
+-- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95086F IS
+
+BEGIN
+     TEST ("C95086F", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
+           "BEFORE OR AFTER THE ENTRY CALL FOR OUT ARRAY PARAMETERS, " &
+           "WITH THE ACTUAL HAVING THE FORM OF A TYPE CONVERSION");
+
+     ---------------------------------------------
+
+     DECLARE -- (A)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..5;
+          TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+               OF BOOLEAN;
+          SUBTYPE FORMAL IS ARRAY_TYPE (1..3, 1..3);
+          SUBTYPE ACTUAL IS ARRAY_TYPE (1..3, 1..3);
+          AR : ACTUAL;
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T IS
+               ENTRY E (X : OUT FORMAL);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (X : OUT FORMAL) DO
+                    CALLED := TRUE;
+                    X := (1..3 => (1..3 => TRUE));
+               END E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (A)");
+          END T;
+
+     BEGIN -- (A)
+
+          T.E (FORMAL (AR));
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (A)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (A)");
+     END; -- (A)
+
+     ---------------------------------------------
+
+     DECLARE -- (B)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..3;
+          TYPE FORMAL IS ARRAY (INDEX, INDEX) OF BOOLEAN;
+          TYPE ACTUAL IS ARRAY (3..5, 3..5) OF BOOLEAN;
+          AR : ACTUAL;
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T IS
+               ENTRY E (X : OUT FORMAL);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (X : OUT FORMAL) DO
+                    CALLED := TRUE;
+                    X(3, 3) := TRUE;
+               END E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (B)");
+          END T;
+
+     BEGIN -- (B)
+
+          T.E (FORMAL (AR));
+          IF AR(5, 5) /= TRUE THEN
+               FAILED ("INCORRECT RETURNED VALUE - (B)");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (B)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (B)");
+     END; -- (B)
+
+     ---------------------------------------------
+
+     DECLARE -- (C)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..5;
+          TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+               OF CHARACTER;
+          SUBTYPE FORMAL IS ARRAY_TYPE (2..0, 1..3);
+          AR : ARRAY_TYPE (2..1, 1..3);
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T IS
+               ENTRY E (X : OUT FORMAL);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (X : OUT FORMAL) DO
+                    IF X'LAST /= 0 AND X'LAST(2) /= 3 THEN
+                         FAILED ("WRONG BOUNDS PASSED - (C)");
+                    END IF;
+                    CALLED := TRUE;
+                    X := (2..0 => (1..3 => 'A'));
+               END E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (C)");
+          END T;
+
+     BEGIN -- (C)
+
+          T.E (FORMAL (AR));
+          IF AR'LAST /= 1 AND AR'LAST(2) /= 3 THEN
+               FAILED ("BOUNDS CHANGED - (C)");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (C)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (C)");
+     END; -- (C)
+
+     ---------------------------------------------
+
+     DECLARE -- (D)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..3;
+          TYPE FORMAL IS ARRAY (INDEX RANGE 1..3, INDEX RANGE 3..1)
+               OF CHARACTER;
+          TYPE ACTUAL IS ARRAY (3..5, 5..3) OF CHARACTER;
+          AR : ACTUAL;
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T IS
+               ENTRY E (X : OUT FORMAL);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (X : OUT FORMAL) DO
+                    IF X'LAST /= 3 AND X'LAST(2) /= 1 THEN
+                         FAILED ("WRONG BOUNDS PASSED - (D)");
+                    END IF;
+                    CALLED := TRUE;
+                    X := (1..3 => (3..1 => 'A'));
+               END E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (D)");
+          END T;
+
+     BEGIN -- (D)
+
+          T.E (FORMAL (AR));
+          IF AR'LAST /= 5 AND AR'LAST(2) /= 3 THEN
+               FAILED ("BOUNDS CHANGED - (D)");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (D)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (D)");
+     END; -- (D)
+
+     ---------------------------------------------
+
+     DECLARE -- (E)
+
+          SUBTYPE INDEX IS INTEGER RANGE 1..3;
+          TYPE FORMAL IS ARRAY (INDEX RANGE <>, INDEX RANGE <>)
+               OF CHARACTER;
+          TYPE ACTUAL IS ARRAY (POSITIVE RANGE 5..2,
+                                POSITIVE RANGE 1..3) OF CHARACTER;
+          AR : ACTUAL;
+          CALLED : BOOLEAN := FALSE;
+
+          TASK T IS
+               ENTRY E (X : OUT FORMAL);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (X : OUT FORMAL) DO
+                    IF X'LAST /= 2 AND X'LAST(2) /= 3 THEN
+                         FAILED ("WRONG BOUNDS PASSED - (E)");
+                    END IF;
+                    CALLED := TRUE;
+                    X := (3..1 => (1..3 => ' ' ));
+               END E;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TASK - (E)");
+          END T;
+
+     BEGIN -- (E)
+
+          T.E (FORMAL (AR));
+          IF AR'LAST /= 2 AND AR'LAST(2) /= 3 THEN
+               FAILED ("BOUNDS CHANGED - (E)");
+          END IF;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               IF NOT CALLED THEN
+                    FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
+               ELSE
+                    FAILED ("EXCEPTION RAISED ON RETURN - (E)");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (E)");
+     END; -- (E)
+
+     ---------------------------------------------
+
+     RESULT;
+END C95086F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087a.ada
new file mode 100644
index 000000000..535cea40d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087a.ada
@@ -0,0 +1,412 @@
+-- C95087A.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 UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
+--   FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
+--   SUBTESTS ARE:
+--        (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
+--        (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
+--        (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
+--        (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
+
+-- GLH  7/19/85
+-- JRK 8/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95087A IS
+
+BEGIN
+     TEST ("C95087A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
+                      "UNCONSTRAINED FORMAL PARAMETERS");
+
+     DECLARE  -- (A)
+
+          PACKAGE PKG IS
+
+              SUBTYPE INT IS INTEGER RANGE 0..100;
+
+              TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                    RECORD
+                         INTFIELD : INTEGER;
+                         STRFIELD : STRING (1..CONSTRAINT);
+                    END RECORD;
+
+               REC1 : RECTYPE := (10,10,"0123456789");
+               REC2 : RECTYPE := (17,7,"C95087A..........");
+               REC3 : RECTYPE := (1,1,"A");
+               REC4 : RECTYPE;  -- 80.
+
+               TASK T1 IS
+                    ENTRY E1 (REC1 : IN RECTYPE := (2,0,"AB");
+                              REC2 : OUT RECTYPE;
+                              REC3 : IN OUT RECTYPE);
+               END T1;
+
+               TASK T2 IS
+                    ENTRY E2 (REC : OUT RECTYPE);
+               END T2;
+          END PKG;
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T1 IS
+               BEGIN
+                    ACCEPT E1 (REC1 : IN RECTYPE := (2,0,"AB");
+                               REC2 : OUT RECTYPE;
+                               REC3 : IN OUT RECTYPE) DO
+
+                         IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
+                              FAILED ("RECORD TYPE IN PARAMETER " &
+                                      "DID NOT USE CONSTRAINT " &
+                                      "OF ACTUAL");
+                         END IF;
+                         IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
+                              FAILED ("RECORD TYPE OUT " &
+                                      "PARAMETER DID NOT USE " &
+                                      "CONSTRAINT OF ACTUAL");
+                         END IF;
+                         IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
+                              FAILED ("RECORD TYPE IN OUT " &
+                                      "PARAMETER DID NOT USE " &
+                                      "CONSTRAINT OF ACTUAL");
+                         END IF;
+                         REC2 := PKG.REC2;
+                    END E1;
+               END T1;
+
+               TASK BODY T2 IS
+               BEGIN
+                    ACCEPT E2 (REC : OUT RECTYPE) DO
+                         IF REC.CONSTRAINT /= IDENT_INT (80) THEN
+                              FAILED ("RECORD TYPE OUT " &
+                                      "PARAMETER DID " &
+                                      "NOT USE CONSTRAINT OF " &
+                                      "UNINITIALIZED ACTUAL");
+                         END IF;
+                         REC := (10,10,"9876543210");
+                    END E2;
+               END T2;
+          END PKG;
+
+     BEGIN  -- (A)
+
+          PKG.T1.E1 (PKG.REC1, PKG.REC2, PKG.REC3);
+          PKG.T2.E2 (PKG.REC4);
+
+     END;   -- (A)
+
+     ---------------------------------------------
+
+B :  DECLARE  -- (B)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INT IS INTEGER RANGE 0..100;
+
+               TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
+
+
+               TASK T1 IS
+                    ENTRY E1 (REC1 : IN RECTYPE;
+                              REC2 : OUT RECTYPE;
+                              REC3 : IN OUT RECTYPE);
+               END T1;
+
+               TASK T2 IS
+                    ENTRY E2  (REC : OUT RECTYPE);
+               END T2;
+
+          PRIVATE
+               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                    RECORD
+                         INTFIELD : INTEGER;
+                         STRFIELD : STRING (1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC1 : PKG.RECTYPE (10);
+          REC2 : PKG.RECTYPE (17);
+          REC3 : PKG.RECTYPE (1);
+          REC4 : PKG.RECTYPE (10);
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T1 IS
+               BEGIN
+                    ACCEPT E1 (REC1 : IN RECTYPE;
+                               REC2 : OUT RECTYPE;
+                               REC3 : IN OUT RECTYPE) DO
+                         IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
+                              FAILED ("PRIVATE TYPE IN " &
+                                      "PARAMETER DID " &
+                                      "NOT USE CONSTRAINT OF " &
+                                      "ACTUAL");
+                         END IF;
+                         IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
+                              FAILED ("PRIVATE TYPE OUT " &
+                                      "PARAMETER DID " &
+                                      "NOT USE CONSTRAINT OF " &
+                                      "ACTUAL");
+                         END IF;
+                         IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
+                              FAILED ("PRIVATE TYPE IN OUT " &
+                                      "PARAMETER DID " &
+                                      "NOT USE CONSTRAINT OF " &
+                                      "ACTUAL");
+                         END IF;
+                         REC2 := B.REC2;
+                    END E1;
+               END T1;
+
+               TASK BODY T2 IS
+               BEGIN
+                    ACCEPT E2 (REC : OUT RECTYPE) DO
+                         IF REC.CONSTRAINT /= IDENT_INT (10) THEN
+                              FAILED ("PRIVATE TYPE OUT " &
+                                      "PARAMETER DID " &
+                                      "NOT USE CONSTRAINT OF " &
+                                      "UNINITIALIZED ACTUAL");
+                         END IF;
+                         REC := (10,10,"9876543210");
+                    END E2;
+               END T2;
+
+          BEGIN
+               REC1 := (10,10,"0123456789");
+               REC2 := (17,7,"C95087A..........");
+               REC3 := (1,1,"A");
+          END PKG;
+
+     BEGIN  -- (B)
+
+          PKG.T1.E1 (REC1, REC2, REC3);
+          PKG.T2.E2 (REC4);
+
+     END B;  -- (B)
+
+     ---------------------------------------------
+
+C :  DECLARE  -- (C)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INT IS INTEGER RANGE 0..100;
+
+               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                    LIMITED PRIVATE;
+
+               TASK T1 IS
+                    ENTRY E1 (REC1 : IN RECTYPE;
+                              REC2 : OUT RECTYPE;
+                              REC3 : IN OUT RECTYPE);
+               END T1;
+
+               TASK T2 IS
+                    ENTRY E2 (REC : OUT RECTYPE);
+               END T2;
+
+          PRIVATE
+               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
+                    RECORD
+                         INTFIELD : INTEGER;
+                         STRFIELD : STRING (1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC1 : PKG.RECTYPE;     -- 10.
+          REC2 : PKG.RECTYPE;     -- 17.
+          REC3 : PKG.RECTYPE;     --  1.
+          REC4 : PKG.RECTYPE;     -- 80.
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T1 IS
+               BEGIN
+                    ACCEPT E1 (REC1 : IN RECTYPE;
+                               REC2 : OUT RECTYPE;
+                               REC3 : IN OUT RECTYPE) DO
+                         IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
+                              FAILED ("LIMITED PRIVATE TYPE IN " &
+                                      "PARAMETER DID NOT USE " &
+                                      "CONSTRAINT OF ACTUAL");
+                         END IF;
+                         IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
+                              FAILED ("LIMITED PRIVATE TYPE OUT " &
+                                      "PARAMETER DID NOT USE " &
+                                      "CONSTRAINT OF " &
+                                      "ACTUAL");
+                         END IF;
+                         IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
+                              FAILED ("LIMITED PRIVATE TYPE IN " &
+                                      "OUT PARAMETER DID NOT " &
+                                      "USE CONSTRAINT OF ACTUAL");
+                         END IF;
+                         REC2 := C.REC2;
+                    END E1;
+               END T1;
+
+               TASK BODY T2 IS
+               BEGIN
+                    ACCEPT E2 (REC : OUT RECTYPE) DO
+                         IF REC.CONSTRAINT /= IDENT_INT (80) THEN
+                              FAILED ("LIMITED PRIVATE TYPE OUT " &
+                                      "PARAMETER DID NOT USE " &
+                                      "CONSTRAINT OF UNINITIALIZED " &
+                                      "ACTUAL");
+                         END IF;
+                         REC := (10,10,"9876543210");
+                    END E2;
+               END T2;
+
+          BEGIN
+               REC1 := (10,10,"0123456789");
+               REC2 := (17,7,"C95087A..........");
+               REC3 := (1,1,"A");
+          END PKG;
+
+     BEGIN  -- (C)
+
+          PKG.T1.E1 (REC1, REC2, REC3);
+          PKG.T2.E2 (REC4);
+
+     END C;   -- (C)
+
+     ---------------------------------------------
+
+D :  DECLARE  -- (D)
+
+          TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
+               CHARACTER;
+
+          A1, A2, A3 : ATYPE (-1..1, 4..5) := (('A','B'),
+                                               ('C','D'),
+                                               ('E','F'));
+
+          A4  : ATYPE (-1..1, 4..5);
+
+          CA1 : CONSTANT ATYPE (8..9, -7..INTEGER'FIRST) :=
+                               (8..9 => (-7..INTEGER'FIRST => 'A'));
+
+          S1  : STRING (1..INTEGER'FIRST) := "";
+          S2  : STRING (-5..-7)           := "";
+          S3  : STRING (1..0)             := "";
+
+          TASK T1 IS
+               ENTRY E1 (A1 : IN ATYPE := CA1;
+                         A2 : OUT ATYPE;
+                         A3 : IN OUT ATYPE);
+          END T1;
+
+          TASK T2 IS
+               ENTRY E2 (A4 : OUT ATYPE);
+          END T2;
+
+          TASK T3 IS
+               ENTRY E3 (S1 : IN STRING;
+                         S2 : IN OUT STRING;
+                         S3 : OUT STRING);
+          END T3;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT E1 (A1 : IN ATYPE := CA1;  A2 : OUT ATYPE;
+                          A3 : IN OUT ATYPE) DO
+                    IF A1'FIRST(1) /= IDENT_INT (-1) OR
+                       A1'LAST(1)  /= IDENT_INT (1)  OR
+                       A1'FIRST(2) /= IDENT_INT (4)  OR
+                       A1'LAST(2)  /= IDENT_INT (5)  THEN
+                         FAILED ("ARRAY TYPE IN PARAMETER DID " &
+                                 "NOT USE CONSTRAINTS OF ACTUAL");
+                    END IF;
+                    IF A2'FIRST(1) /= IDENT_INT (-1) OR
+                       A2'LAST(1)  /= IDENT_INT (1)  OR
+                       A2'FIRST(2) /= IDENT_INT (4)  OR
+                       A2'LAST(2)  /= IDENT_INT (5)  THEN
+                         FAILED ("ARRAY TYPE OUT PARAMETER DID " &
+                                 "NOT USE CONSTRAINTS OF ACTUAL");
+                    END IF;
+                    IF A3'FIRST(1) /= IDENT_INT (-1) OR
+                       A3'LAST(1)  /= IDENT_INT (1)  OR
+                       A3'FIRST(2) /= IDENT_INT (4)  OR
+                       A3'LAST(2)  /= IDENT_INT (5)  THEN
+                         FAILED ("ARRAY TYPE IN OUT PARAMETER " &
+                                 "DID NOT USE CONSTRAINTS OF " &
+                                 "ACTUAL");
+                    END IF;
+                    A2 := D.A2;
+               END E1;
+          END T1;
+
+          TASK BODY T2 IS
+          BEGIN
+               ACCEPT E2 (A4 : OUT ATYPE) DO
+                    IF A4'FIRST(1) /= IDENT_INT (-1) OR
+                       A4'LAST(1)  /= IDENT_INT (1)  OR
+                       A4'FIRST(2) /= IDENT_INT (4)  OR
+                       A4'LAST(2)  /= IDENT_INT (5)  THEN
+                         FAILED ("ARRAY TYPE OUT PARAMETER DID " &
+                                 "NOT USE CONSTRAINTS OF " &
+                                 "UNINITIALIZED ACTUAL");
+                    END IF;
+                    A4 := A2;
+               END E2;
+          END T2;
+
+          TASK BODY T3 IS
+          BEGIN
+               ACCEPT E3 (S1 : IN STRING;
+                          S2 : IN OUT STRING;
+                          S3 : OUT STRING) DO
+                    IF S1'FIRST /= IDENT_INT (1) OR
+                       S1'LAST  /= IDENT_INT (INTEGER'FIRST) THEN
+                         FAILED ("STRING TYPE IN PARAMETER DID " &
+                                 "NOT USE CONSTRAINTS OF ACTUAL " &
+                                 "NULL STRING");
+                    END IF;
+                    IF S2'FIRST /= IDENT_INT (-5) OR
+                       S2'LAST  /= IDENT_INT (-7) THEN
+                         FAILED ("STRING TYPE IN OUT PARAMETER " &
+                                 "DID NOT USE CONSTRAINTS OF " &
+                                 "ACTUAL NULL STRING");
+                    END IF;
+                    IF S3'FIRST /= IDENT_INT (1) OR
+                       S3'LAST  /= IDENT_INT (0) THEN
+                         FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
+                                 "USE CONSTRAINTS OF ACTUAL NULL " &
+                                 "STRING");
+                    END IF;
+                    S3 := "";
+               END E3;
+          END T3;
+
+     BEGIN  -- (D)
+
+          T1.E1 (A1, A2, A3);
+          T2.E2 (A4);
+          T3.E3 (S1, S2, S3);
+
+     END D;  -- (D)
+
+     RESULT;
+END C95087A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087b.ada
new file mode 100644
index 000000000..1d6c87826
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087b.ada
@@ -0,0 +1,267 @@
+-- C95087B.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 ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
+--   RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT DEFAULT
+--   CONSTRAINTS RAISE CONSTRAINT_ERROR IF AN ATTEMPT IS MADE TO CHANGE
+--   THE CONSTRAINT OF THE ACTUAL PARAMETER.
+--   SUBTESTS ARE:
+--        (A) RECORD TYPE.
+--        (B) PRIVATE TYPE.
+--        (C) LIMITED PRIVATE TYPE.
+
+-- RJW  1/10/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95087B IS
+
+BEGIN
+
+     TEST ( "C95087B", "CHECK ASSIGNMENT TO ENTRY FORMAL PARAMETERS " &
+                       "OF UNCONSTRAINED TYPE (WITH NO DEFAULT)" );
+
+     --------------------------------------------------
+
+     DECLARE  -- (A)
+
+          PACKAGE PKG IS
+
+               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                    RECORD
+                         INTFIELD  : INTEGER;
+                         STRFIELD  : STRING (1..CONSTRAINT);
+                    END RECORD;
+
+               TASK T IS
+                    ENTRY E (REC9 : OUT RECTYPE;
+                             REC6 : IN OUT RECTYPE);
+               END T;
+
+          END PKG;
+
+          REC9 : PKG.RECTYPE(IDENT_INT(9))    :=
+                 (IDENT_INT(9), 9, "123456789");
+          REC6 : PKG.RECTYPE(IDENT_INT(6))    :=
+                 (IDENT_INT(6), 5, "AEIOUY");
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T IS
+
+                    REC4 : CONSTANT RECTYPE(IDENT_INT(4)) :=
+                           (IDENT_INT(4), 4, "OOPS");
+
+               BEGIN
+                    ACCEPT E (REC9 : OUT RECTYPE;
+                              REC6 : IN OUT RECTYPE) DO
+
+                         BEGIN  -- (A.1)
+                              REC9 := REC6;
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                      "- A.1");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED " &
+                                           "- A.1");
+                         END;   -- (A.1)
+
+                         BEGIN  -- (A.2)
+                              REC6 := REC4;
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                      "- A.2");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED " &
+                                           "- A.2");
+                         END;   -- (A.2)
+
+                         REC9 := (IDENT_INT(9), 9, "987654321");
+
+                    END E;
+               END T;
+          END PKG;
+
+     BEGIN  -- (A)
+
+          PKG.T.E (REC9, REC6);
+
+          IF REC9.STRFIELD /= IDENT_STR("987654321") THEN
+               FAILED ("ASSIGNMENT TO REC9 FAILED - (A)");
+          END IF;
+
+     END;   -- (A)
+
+     --------------------------------------------------
+
+     DECLARE  -- (B)
+
+          PACKAGE PKG IS
+
+               TYPE RECTYPE (CONSTRAINT : INTEGER) IS PRIVATE;
+
+               TASK T IS
+                    ENTRY  E (REC9 : OUT RECTYPE;
+                              REC6 : IN OUT RECTYPE);
+               END T;
+
+          PRIVATE
+               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                    RECORD
+                         INTFIELD  : INTEGER;
+                         STRFIELD  : STRING (1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC9 : PKG.RECTYPE(9);
+          REC6 : PKG.RECTYPE(6);
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T IS
+
+                    REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS");
+
+               BEGIN
+                    ACCEPT E (REC9 : OUT RECTYPE;
+                              REC6 : IN OUT RECTYPE) DO
+
+                         BEGIN  -- (B.1)
+                              REC9 := REC6;
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                      "- B.1");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED " &
+                                           "- B.1");
+                         END;   -- (B.1)
+
+                         BEGIN  -- (B.2)
+                              REC6 := REC4;
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                      "- B.2");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED " &
+                                           "- B.2");
+                         END;   -- (B.2)
+
+                    END E;
+               END T;
+
+          BEGIN
+               REC9 := (9, 9, "123456789");
+               REC6 := (6, 5, "AEIOUY");
+          END PKG;
+
+     BEGIN  -- (B)
+
+          PKG.T.E (REC9, REC6);
+
+     END;   -- (B)
+
+     --------------------------------------------------
+
+     DECLARE  -- (C)
+
+          PACKAGE PKG IS
+
+               TYPE RECTYPE (CONSTRAINT : INTEGER) IS LIMITED PRIVATE;
+
+               TASK T IS
+                    ENTRY  E (REC9 : OUT RECTYPE;
+                              REC6 : IN OUT RECTYPE);
+               END T;
+
+          PRIVATE
+               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
+                    RECORD
+                         INTFIELD  : INTEGER;
+                         STRFIELD  : STRING (1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC6 : PKG.RECTYPE(IDENT_INT(6));
+          REC9 : PKG.RECTYPE(IDENT_INT(9));
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T IS
+
+                    REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS");
+
+               BEGIN
+                    ACCEPT E (REC9 : OUT RECTYPE;
+                              REC6 : IN OUT RECTYPE) DO
+
+                         BEGIN  -- (C.1)
+                              REC9 := REC6;
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                      "- C.1");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED " &
+                                           "- C.1");
+                         END;   -- (C.1)
+
+                         BEGIN  -- (C.2)
+                              REC6 := REC4;
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
+                                      "- C.2");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ("WRONG EXCEPTION RAISED " &
+                                           "- C.2");
+                         END;   -- (C.2)
+
+                    END E;
+               END T;
+
+          BEGIN
+               REC6 := (6, 5, "AEIOUY");
+               REC9 := (9, 9, "123456789");
+          END PKG;
+
+     BEGIN  -- (C)
+
+          PKG.T.E (REC9, REC6);
+
+     END;   -- (C)
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C95087B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087c.ada
new file mode 100644
index 000000000..2061af4bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087c.ada
@@ -0,0 +1,299 @@
+-- C95087C.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 ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
+--    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
+--    CONSTRAINTS RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER IS
+--    CONSTRAINED AND THE CONSTRAINT VALUES OF THE OBJECT BEING
+--    ASSIGNED TO DO NOT SATISFY THOSE OF THE ACTUAL PARAMETER.
+
+--    SUBTESTS ARE:
+--        (A) CONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
+--        (B) CONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
+--        (C) CONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
+
+-- RJW  1/15/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95087C IS
+
+BEGIN
+
+     TEST ( "C95087C", "CHECK ASSIGNMENTS TO ENTRY FORMAL " &
+                       "PARAMETERS OF UNCONSTRAINED TYPES " &
+                       "(WITH DEFAULTS)" );
+
+     --------------------------------------------------
+
+     DECLARE  -- (A)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+
+               REC91,REC92,REC93  : RECTYPE(9);
+               REC_OOPS           : RECTYPE(4);
+
+               TASK T IS
+                    ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+               END T;
+
+          END PKG;
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T IS
+               BEGIN
+                    ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE) DO
+
+                         IF (NOT REC1'CONSTRAINED) OR
+                            (REC1.CONSTRAINT /= IDENT_INT(9)) THEN
+                              FAILED ( "CONSTRAINT ON RECORD TYPE " &
+                                       "IN PARAMETER NOT RECOGNIZED" );
+                         END IF;
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                              REC2 := REC_OOPS;
+                              FAILED ( "CONSTRAINT_ERROR NOT " &
+                                       "RAISED - A.1" );
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ( "WRONG EXCEPTION " &
+                                            "RAISED - A.1" );
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                              REC3 := REC_OOPS;
+                              FAILED ( "CONSTRAINT_ERROR NOT " &
+                                       "RAISED - A.2" );
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ( "WRONG EXCEPTION " &
+                                            "RAISED - A.2" );
+                         END;
+
+                    END E;
+               END T;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+     BEGIN  -- (A)
+
+          PKG.T.E (PKG.REC91, PKG.REC92, PKG.REC93);
+
+     END;   -- (A)
+
+     --------------------------------------------------
+
+     DECLARE  -- (B)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
+
+               TASK T IS
+                    ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+               END T;
+
+          PRIVATE
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC91, REC92, REC93  : PKG.RECTYPE(9);
+          REC_OOPS             : PKG.RECTYPE(4);
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T IS
+               BEGIN
+                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                               REC3 : OUT RECTYPE) DO
+
+                         IF (NOT REC1'CONSTRAINED) OR
+                            (REC1.CONSTRAINT /= IDENT_INT(9)) THEN
+                              FAILED ( "CONSTRAINT ON PRIVATE TYPE " &
+                                       "IN PARAMETER NOT RECOGNIZED" );
+                         END IF;
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                              REC2 := REC_OOPS;
+                              FAILED ( "CONSTRAINT_ERROR NOT " &
+                                       "RAISED - B.1" );
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ( "WRONG EXCEPTION " &
+                                            "RAISED - B.1" );
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                              REC3 := REC_OOPS;
+                              FAILED ( "CONSTRAINT_ERROR NOT " &
+                                       "RAISED - B.2" );
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ( "WRONG EXCEPTION " &
+                                            "RAISED - B.2" );
+                         END;
+
+                    END E;
+              END T;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+     BEGIN  -- (B)
+
+          PKG.T.E (REC91, REC92, REC93);
+
+     END;   -- (B)
+
+     --------------------------------------------------
+
+     DECLARE  -- (C)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    LIMITED PRIVATE;
+
+               TASK T IS
+                    ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+               END T;
+
+          PRIVATE
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC91,REC92,REC93  : PKG.RECTYPE(9);
+          REC_OOPS           : PKG.RECTYPE(4);
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T IS
+               BEGIN
+                    ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE) DO
+
+                         IF (NOT REC1'CONSTRAINED) OR
+                            (REC1.CONSTRAINT /= 9) THEN
+                              FAILED ( "CONSTRAINT ON LIMITED " &
+                                       "PRIVATE TYPE IN PARAMETER " &
+                                       "NOT RECOGNIZED" );
+                         END IF;
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                              REC2 := REC_OOPS;
+                              FAILED ( "CONSTRAINT_ERROR NOT " &
+                                       "RAISED - C.1" );
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ( "WRONG EXCEPTION " &
+                                            "RAISED - C.1" );
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                              REC3 := REC_OOPS;
+                              FAILED ( "CONSTRAINT_ERROR NOT RAISED " &
+                                       "- C.2" );
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR =>
+                                   NULL;
+                              WHEN OTHERS =>
+                                   FAILED ( "WRONG EXCEPTION " &
+                                            "RAISED - C.2" );
+                         END;
+
+                    END E;
+               END T;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+     BEGIN  -- (C)
+
+          PKG.T.E (REC91, REC92, REC93);
+
+     END;   -- (C)
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C95087C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087d.ada
new file mode 100644
index 000000000..6e44913b4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95087d.ada
@@ -0,0 +1,268 @@
+-- C95087D.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 ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
+--    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
+--    CONSTRAINTS DO NOT RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER
+--    IS UNCONSTRAINED, EVEN IF THE CONSTRAINT VALUES OF THE OBJECT
+--    BEING ASSIGNED ARE DIFFERENT THAN THOSE OF THE ACTUAL PARAMETER.
+
+--    SUBTESTS ARE:
+--        (A) UNCONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
+--        (B) UNCONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
+--        (C) UNCONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
+
+-- RJW  1/17/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95087D IS
+
+BEGIN
+
+     TEST ( "C95087D", "CHECK ASSIGNMENTS TO ENTRY FORMAL PARAMETERS " &
+                       "OF UNCONSTRAINED TYPES WITH UNCONSTRAINED " &
+                       "ACTUAL PARAMETERS");
+
+     --------------------------------------------------
+
+     DECLARE  -- (A)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+
+               TASK T IS
+                    ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+               END T;
+
+          END PKG;
+
+          REC91, REC92, REC93 : PKG.RECTYPE :=
+               (IDENT_INT(5), 5, IDENT_STR( "12345"));
+          REC_OOPS            : PKG.RECTYPE;
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T IS
+               BEGIN
+                    ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE) DO
+
+                         IF NOT REC1'CONSTRAINED THEN
+                              FAILED ( "REC1 IS NOT CONSTRAINED - A.1");
+                         END IF;
+                         IF REC1.CONSTRAINT /= IDENT_INT(9) THEN
+                              FAILED ( "REC1 CONSTRAINT IS NOT 9 " &
+                                 "- A.1");
+                         END IF;
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                              REC2 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ( "EXCEPTION RAISED - A.1");
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                              REC3 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ( "EXCEPTION RAISED - A.2");
+                         END;
+
+                    END E;
+               END T;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+          USE PKG;
+
+     BEGIN  -- (A)
+
+          PKG.T.E  (REC91, REC92, REC93);
+          IF (REC92 /= REC_OOPS) OR (REC93 /= REC_OOPS) THEN
+               FAILED ( "RESULTANT VALUE OF REC92 OR REC93 INCORRECT");
+          END IF;
+
+     END;   -- (A)
+
+     --------------------------------------------------
+
+     DECLARE  -- (B)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
+
+               TASK T IS
+                    ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+               END T;
+
+          PRIVATE
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC91, REC92, REC93  : PKG.RECTYPE;
+          REC_OOPS             : PKG.RECTYPE;
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T IS
+               BEGIN
+                    ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE) DO
+
+                         IF REC3'CONSTRAINED THEN
+                              FAILED ( "REC3 IS CONSTRAINED - B.1");
+                         END IF;
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                              REC2 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ( "EXCEPTION RAISED - B.1");
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                              REC3 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ( "EXCEPTION RAISED - B.2");
+                         END;
+
+                    END E;
+               END T;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+     BEGIN  -- (B)
+
+          PKG.T.E (REC91, REC92, REC93);
+
+     END;   -- (B)
+
+     --------------------------------------------------
+
+     DECLARE  -- (C)
+
+          PACKAGE PKG IS
+
+               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    LIMITED PRIVATE;
+
+               TASK T IS
+                    ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                             REC3 : OUT RECTYPE);
+               END T;
+
+          PRIVATE
+
+               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
+                    RECORD
+                         INTFLD   : INTRANGE;
+                         STRFLD   : STRING(1..CONSTRAINT);
+                    END RECORD;
+          END PKG;
+
+          REC91, REC92, REC93  : PKG.RECTYPE;
+          REC_OOPS             : PKG.RECTYPE;
+
+          PACKAGE BODY PKG IS
+
+               TASK BODY T IS
+               BEGIN
+                    ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
+                              REC3 : OUT RECTYPE) DO
+
+                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
+                              REC2 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ( "EXCEPTION RAISED - C.1");
+                         END;
+
+                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
+                              REC3 := REC_OOPS;
+                         EXCEPTION
+                              WHEN OTHERS =>
+                                   FAILED ( "EXCEPTION RAISED - C.2");
+                         END;
+
+                    END E;
+               END T;
+
+          BEGIN
+
+               REC91 := (9, 9, "123456789");
+               REC92 := REC91;
+               REC93 := REC91;
+
+               REC_OOPS := (4, 4, "OOPS");
+
+          END PKG;
+
+     BEGIN  -- (C)
+
+          PKG.T.E (REC91, REC92, REC93);
+
+     END;   -- (C)
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C95087D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95088a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95088a.ada
new file mode 100644
index 000000000..053abebdd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95088a.ada
@@ -0,0 +1,85 @@
+-- C95088A.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 ACTUAL PARAMETERS ARE EVALUATED AND IDENTIFIED AT THE
+--   TIME OF CALL.
+
+-- GLH 7/10/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C95088A IS
+
+     TYPE VECTOR IS ARRAY (1..10) OF INTEGER;
+     TYPE PTRINT IS ACCESS INTEGER;
+
+     I    : INTEGER := 1;
+     A    : VECTOR  := (1,2,3,4,5,6,7,8,9,10);
+     P1   : PTRINT  := NEW INTEGER'(2);
+     P2   : PTRINT  := P1;
+
+     TASK T1 IS
+          ENTRY E1 (I : OUT INTEGER; J : OUT INTEGER);
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          ACCEPT E1 (I : OUT INTEGER; J : OUT INTEGER) DO
+               I := 10;
+               J := -1;
+          END E1;
+     END T1;
+
+     TASK T2 IS
+          ENTRY E2 (P : OUT PTRINT; I : OUT INTEGER);
+     END T2;
+
+     TASK BODY T2 IS
+     BEGIN
+          ACCEPT E2 (P : OUT PTRINT; I : OUT INTEGER) DO
+               P := NEW INTEGER'(3);
+               I := 5;
+          END E2;
+     END T2;
+
+BEGIN
+
+     TEST ("C95088A", "CHECK THAT ACTUAL PARAMETERS ARE EVALUATED " &
+                      "AND IDENTIFIED AT THE TIME OF CALL");
+
+     COMMENT ("FIRST CALL");
+     T1.E1 (I, A(I));
+     IF (A /= (-1,2,3,4,5,6,7,8,9,10)) THEN
+          FAILED ("A(I) EVALUATED UPON RETURN");
+     END IF;
+
+     COMMENT ("SECOND CALL");
+     T2.E2 (P1, P1.ALL);
+     IF (P2.ALL /= 5) THEN
+          FAILED ("P1.ALL EVALUATED UPON RETURN");
+     END IF;
+
+     RESULT;
+
+END C95088A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95089a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95089a.ada
new file mode 100644
index 000000000..b66897cc7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95089a.ada
@@ -0,0 +1,175 @@
+-- C95089A.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 PERMITTED FORMS OF VARIABLE NAMES ARE PERMITTED
+-- AS ACTUAL PARAMETERS.
+
+-- GLH 7/25/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95089A IS
+
+     SUBTYPE INT IS INTEGER RANGE 1..3;
+
+     TYPE REC (N : INT) IS
+          RECORD
+               S : STRING (1..N);
+          END RECORD;
+
+     TYPE PTRSTR IS ACCESS STRING;
+
+     R1, R2, R3 : REC (3);
+     S1, S2, S3 : STRING (1..3);
+     PTRTBL     : ARRAY (1..3) OF PTRSTR;
+
+     TASK T1 IS
+          ENTRY E1 (S1 : IN STRING; S2: IN OUT STRING;
+                    S3 : OUT STRING);
+     END T1;
+
+     TASK BODY T1 IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT E1 (S1 : IN STRING; S2: IN OUT STRING;
+                               S3 : OUT STRING) DO
+                         S3 := S2;
+                         S2 := S1;
+                    END E1;
+               OR
+                    TERMINATE;
+               END SELECT;
+          END LOOP;
+     END T1;
+
+     TASK T2 IS
+          ENTRY E2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER;
+                    C3 : OUT CHARACTER);
+     END T2;
+
+     TASK BODY T2 IS
+     BEGIN
+          LOOP
+               SELECT
+                    ACCEPT E2 (C1 : IN CHARACTER; C2 : IN OUT CHARACTER;
+                               C3 : OUT CHARACTER) DO
+                         C3 := C2;
+                         C2 := C1;
+                    END E2;
+               OR
+                    TERMINATE;
+               END SELECT;
+          END LOOP;
+     END T2;
+
+     FUNCTION F1 (X : INT) RETURN PTRSTR IS
+     BEGIN
+          RETURN PTRTBL (X);
+     END F1;
+
+     FUNCTION "+" (S1, S2 : STRING) RETURN PTRSTR IS
+     BEGIN
+          RETURN PTRTBL (CHARACTER'POS(S1(1))-CHARACTER'POS('A')+1);
+     END "+";
+
+BEGIN
+
+     TEST ("C95089A", "CHECK THAT ALL PERMITTED FORMS OF VARIABLE " &
+                      "NAMES ARE PERMITTED AS ACTUAL PARAMETERS");
+
+     S1 := "AAA";
+     S2 := "BBB";
+     T1.E1 (S1, S2, S3);
+     IF S2 /= "AAA" OR S3 /= "BBB" THEN
+          FAILED ("SIMPLE VARIABLE AS AN ACTUAL PARAMETER NOT WORKING");
+     END IF;
+
+     S1 := "AAA";
+     S2 := "BBB";
+     S3 := IDENT_STR ("CCC");
+     T2.E2 (S1(1), S2(IDENT_INT(1)), S3(1));
+     IF S2 /= "ABB" OR S3 /= "BCC" THEN
+          FAILED ("INDEXED COMPONENT AS AN ACTUAL PARAMETER NOT " &
+                  "WORKING");
+     END IF;
+
+     R1.S := "AAA";
+     R2.S := "BBB";
+     T1.E1 (R1.S, R2.S, R3.S);
+     IF R2.S /= "AAA" OR R3.S /= "BBB" THEN
+          FAILED ("SELECTED COMPONENT AS AN ACTUAL PARAMETER " &
+                  "NOT WORKING");
+     END IF;
+
+     S1 := "AAA";
+     S2 := "BBB";
+     T1.E1 (S1(1..IDENT_INT(2)), S2(1..2),
+            S3(IDENT_INT(1)..IDENT_INT(2)));
+     IF S2 /= "AAB" OR S3 /= "BBC" THEN
+          FAILED ("SLICE AS AN ACTUAL PARAMETER NOT WORKING");
+     END IF;
+
+     PTRTBL(1) := NEW STRING'("AAA");
+     PTRTBL(2) := NEW STRING'("BBB");
+     PTRTBL(3) := NEW STRING'("CCC");
+     T1.E1 (F1(1).ALL, F1(2).ALL, F1(IDENT_INT(3)).ALL);
+     IF PTRTBL(2).ALL /= "AAA" OR PTRTBL(3).ALL /= "BBB" THEN
+          FAILED ("SELECTED COMPONENT OF FUNCTION VALUE AS AN ACTUAL " &
+                  "PARAMETER NOT WORKING");
+     END IF;
+
+     PTRTBL(1) := NEW STRING'("AAA");
+     PTRTBL(2) := NEW STRING'("BBB");
+     PTRTBL(3) := NEW STRING'("CCC");
+     S1 := IDENT_STR("AAA");
+     S2 := IDENT_STR("BBB");
+     S3 := IDENT_STR("CCC");
+     T1.E1 ("+"(S1,S1).ALL, "+"(S2,S2).ALL, "+"(S3,S3).ALL);
+     IF PTRTBL(2).ALL /= "AAA" OR PTRTBL(3).ALL /= "BBB" THEN
+          FAILED ("SELECTED COMPONENT OF OVERLOADED OPERATOR " &
+                  "FUNCTION VALUE AS AN ACTUAL PARAMETER NOT WORKING");
+     END IF;
+
+     PTRTBL(1) := NEW STRING'("AAA");
+     PTRTBL(2) := NEW STRING'("BBB");
+     PTRTBL(3) := NEW STRING'("CCC");
+     T2.E2 (F1(1)(1), F1(IDENT_INT(2))(1), F1(3)(IDENT_INT(1)));
+     IF PTRTBL(2).ALL /= "ABB" OR PTRTBL(3).ALL /= "BCC" THEN
+          FAILED ("INDEXED COMPONENT OF FUNCTION VALUE AS AN ACTUAL " &
+                  "PARAMETER NOT WORKING");
+     END IF;
+
+     PTRTBL(1) := NEW STRING'("AAA");
+     PTRTBL(2) := NEW STRING'("BBB");
+     PTRTBL(3) := NEW STRING'("CCC");
+     T1.E1 (F1(1)(2..3), F1(2)(IDENT_INT(2)..3),
+            F1(3)(2..IDENT_INT(3)));
+     IF PTRTBL(2).ALL /= "BAA" OR PTRTBL(3).ALL /= "CBB" THEN
+          FAILED ("SLICE OF FUNCTION VALUE AS AN ACTUAL PARAMETER " &
+                  "NOT WORKING");
+     END IF;
+
+     RESULT;
+
+END C95089A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95090a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95090a.ada
new file mode 100644
index 000000000..24dc17981
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95090a.ada
@@ -0,0 +1,128 @@
+-- C95090A.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 ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
+-- TO ENTRIES.  SPECIFICALLY,
+--   (A) CHECK ALL PARAMETER MODES.
+
+-- GLH 7/25/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95090A IS
+
+BEGIN
+     TEST ("C95090A", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
+                      "RECORDS ARE PASSED CORRECTLY TO ENTRIES");
+
+     --------------------------------------------
+
+     DECLARE   -- (A)
+
+          TYPE ARRAY_TYPE IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+          SUBTYPE ARRAY_SUBTYPE IS ARRAY_TYPE (1..IDENT_INT(5));
+
+          TYPE RECORD_TYPE IS
+               RECORD
+                    I : INTEGER;
+                    A : ARRAY_SUBTYPE;
+               END RECORD;
+
+          REC : RECORD_TYPE := (I => 23,
+                                A => (1..3 => IDENT_INT(7), 4..5 => 9));
+          BOOL : BOOLEAN;
+
+          TASK T1 IS
+               ENTRY E1 (ARR : ARRAY_TYPE);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT E1 (ARR : ARRAY_TYPE) DO
+                    IF ARR /= (7, 7, 7, 9, 9) THEN
+                         FAILED ("IN PARAMETER NOT PASSED CORRECTLY");
+                    END IF;
+                    IF ARR'FIRST /= IDENT_INT (1) OR
+                       ARR'LAST /= IDENT_INT (5) THEN
+                         FAILED ("WRONG BOUNDS FOR IN PARAMETER");
+                    END IF;
+               END E1;
+          END T1;
+
+          TASK T2 IS
+               ENTRY E2 (ARR : IN OUT ARRAY_TYPE);
+          END T2;
+
+          TASK BODY T2 IS
+          BEGIN
+               ACCEPT E2 (ARR : IN OUT ARRAY_TYPE) DO
+                    IF ARR /= (7, 7, 7, 9, 9) THEN
+                         FAILED ("IN OUT PARAMETER NOT PASSED " &
+                                 "CORRECTLY");
+                    END IF;
+                    IF ARR'FIRST /= IDENT_INT (1) OR
+                       ARR'LAST /= IDENT_INT (5) THEN
+                         FAILED ("WRONG BOUNDS FOR IN OUT PARAMETER");
+                    END IF;
+                    ARR := (ARR'RANGE => 5);
+               END E2;
+          END T2;
+
+          TASK T3 IS
+               ENTRY E3 (ARR : OUT ARRAY_TYPE);
+          END T3;
+
+          TASK BODY T3 IS
+          BEGIN
+               ACCEPT E3 (ARR : OUT ARRAY_TYPE) DO
+                    IF ARR'FIRST /= IDENT_INT (1) OR
+                       ARR'LAST /= IDENT_INT (5) THEN
+                         FAILED ("WRONG BOUNDS FOR OUT PARAMETER");
+                    END IF;
+                    ARR := (ARR'RANGE => 3);
+               END E3;
+          END T3;
+
+     BEGIN     -- (A)
+
+          T1.E1 (REC.A);
+          IF REC.A /= (7, 7, 7, 9, 9) THEN
+               FAILED ("IN PARAM CHANGED BY PROCEDURE");
+          END IF;
+
+          T2.E2 (REC.A);
+          IF REC.A /= (5, 5, 5, 5, 5) THEN
+               FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
+          END IF;
+
+          T3.E3 (REC.A);
+          IF REC.A /= (3, 3, 3, 3, 3) THEN
+               FAILED ("OUT PARAM RETURNED INCORRECTLY");
+          END IF;
+
+     END; -- (A)
+
+     --------------------------------------------
+
+     RESULT;
+END C95090A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95092a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95092a.ada
new file mode 100644
index 000000000..47e96b548
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95092a.ada
@@ -0,0 +1,193 @@
+-- C95092A.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 FOR ENTRIES OF TASKS, DEFAULT VALUES OF ALL TYPES CAN
+--     BE GIVEN FOR A FORMAL PARAMETER.
+
+-- HISTORY:
+--     DHH 03/22/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95092A IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 ..10;
+     TYPE FLT IS DIGITS 5;
+     TYPE FIX IS DELTA 0.125 RANGE 0.0 .. 10.0;
+     TYPE ENUM IS (RED, BLUE, YELLOW);
+     SUBTYPE CHAR IS CHARACTER RANGE 'A' .. 'F';
+     TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
+     TYPE REC IS
+          RECORD
+               A : INT;
+               B : ENUM;
+               C : CHAR;
+          END RECORD;
+
+     FUNCTION IDENT_FLT(E : FLT) RETURN FLT IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN E;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT_FLT;
+
+     FUNCTION IDENT_FIX(E : FIX) RETURN FIX IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN E;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT_FIX;
+
+     FUNCTION IDENT_ENUM(E : ENUM) RETURN ENUM IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN E;
+          ELSE
+               RETURN YELLOW;
+          END IF;
+     END IDENT_ENUM;
+
+     FUNCTION IDENT_CHAR(E : CHAR) RETURN CHAR IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN E;
+          ELSE
+               RETURN 'F';
+          END IF;
+     END IDENT_CHAR;
+
+     FUNCTION IDENT_ARR(E : ARR) RETURN ARR IS
+          Z : ARR := (3,2,1);
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN E;
+          ELSE
+               RETURN Z;
+          END IF;
+     END IDENT_ARR;
+
+     FUNCTION IDENT_REC(E : REC) RETURN REC IS
+          Z : REC := (10, YELLOW, 'F');
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RETURN E;
+          ELSE
+               RETURN Z;
+          END IF;
+     END IDENT_REC;
+
+     TASK TEST_DEFAULTS IS
+          ENTRY BOOL(G : BOOLEAN := TRUE);
+          ENTRY INTEGR(X : IN INT := 5);
+          ENTRY FLOAT(Y : IN FLT := 1.25);
+          ENTRY FIXED(Z : IN FIX := 1.0);
+          ENTRY ENUMERAT(A : IN ENUM := RED);
+          ENTRY CHARACTR(B : IN CHAR := 'A');
+          ENTRY ARRY(C : IN ARR := (1, 2, 3));
+          ENTRY RECD(D : IN REC := (5, RED, 'A'));
+     END TEST_DEFAULTS;
+
+     TASK BODY TEST_DEFAULTS IS
+     BEGIN
+
+          ACCEPT BOOL(G : BOOLEAN := TRUE) DO
+               IF G /= IDENT_BOOL(TRUE) THEN
+                    FAILED("BOOLEAN DEFAULT FAILED");
+               END IF;
+          END BOOL;
+
+          ACCEPT INTEGR(X : IN INT := 5) DO
+               IF X /= IDENT_INT(5) THEN
+                    FAILED("INTEGER DEFAULT FAILED");
+               END IF;
+          END INTEGR;
+
+          ACCEPT FLOAT(Y : IN FLT := 1.25) DO
+               IF Y /= IDENT_FLT(1.25) THEN
+                    FAILED("FLOAT DEFAULT FAILED");
+               END IF;
+          END FLOAT;
+
+          ACCEPT FIXED(Z : IN FIX := 1.0) DO
+               IF Z /= IDENT_FIX(1.0) THEN
+                    FAILED("FIXED DEFAULT FAILED");
+               END IF;
+          END FIXED;
+
+          ACCEPT ENUMERAT(A : IN ENUM := RED) DO
+               IF A /= IDENT_ENUM(RED) THEN
+                    FAILED("ENUMERATION DEFAULT FAILED");
+               END IF;
+          END ENUMERAT;
+
+          ACCEPT CHARACTR(B : IN CHAR := 'A') DO
+               IF B /= IDENT_CHAR('A') THEN
+                    FAILED("CHARACTER DEFAULT FAILED");
+               END IF;
+          END CHARACTR;
+
+          ACCEPT ARRY(C : IN ARR := (1, 2, 3)) DO
+               FOR I IN 1 ..3 LOOP
+                    IF C(I) /= IDENT_INT(I) THEN
+                         FAILED("ARRAY " & INTEGER'IMAGE(I) &
+                                "DEFAULT FAILED");
+                    END IF;
+               END LOOP;
+          END ARRY;
+
+          ACCEPT RECD(D : IN REC := (5, RED, 'A')) DO
+               IF D.A /= IDENT_INT(5) THEN
+                    FAILED("RECORD INTEGER DEFAULT FAILED");
+               END IF;
+               IF D.B /= IDENT_ENUM(RED) THEN
+                    FAILED("RECORD ENUMERATION DEFAULT FAILED");
+               END IF;
+               IF D.C /= IDENT_CHAR('A') THEN
+                    FAILED("RECORD CHARACTER DEFAULT FAILED");
+               END IF;
+          END RECD;
+
+     END TEST_DEFAULTS;
+
+BEGIN
+
+     TEST("C95092A", "CHECK THAT FOR ENTRIES OF TASKS, DEFAULT " &
+                     "VALUES OF ALL TYPES CAN BE GIVEN FOR A FORMAL " &
+                     "PARAMETER");
+
+          TEST_DEFAULTS.BOOL;
+          TEST_DEFAULTS.INTEGR;
+          TEST_DEFAULTS.FLOAT;
+          TEST_DEFAULTS.FIXED;
+          TEST_DEFAULTS.ENUMERAT;
+          TEST_DEFAULTS.CHARACTR;
+          TEST_DEFAULTS.ARRY;
+          TEST_DEFAULTS.RECD;
+
+     RESULT;
+END C95092A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95093a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95093a.ada
new file mode 100644
index 000000000..9c443faae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95093a.ada
@@ -0,0 +1,87 @@
+-- C95093A.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 DEFAULT EXPRESSIONS OF FORMAL PARAMETERS ARE EVALUATED
+-- EACH TIME THEY ARE NEEDED.
+
+-- GLH 7/2/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE C95093A IS
+BEGIN
+
+     TEST ("C95093A", "CHECK THAT THE DEFAULT EXPRESSION IS " &
+                      "EVALUATED EACH TIME IT IS NEEDED");
+
+     DECLARE
+
+          X : INTEGER := 1;
+
+          FUNCTION F RETURN INTEGER IS
+          BEGIN
+               X := X + 1;
+               RETURN X;
+          END F;
+
+          TASK T1 IS
+               ENTRY E1 (X, Y : INTEGER := F);
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+
+               ACCEPT E1 (X, Y : INTEGER := F) DO
+                    IF X = Y OR Y /= 2 THEN
+                         FAILED ("DEFAULT NOT EVALUATED CORRECTLY - " &
+                                 "1, X =" & INTEGER'IMAGE(X) &
+                                 ", Y =" & INTEGER'IMAGE(Y));
+                    END IF;
+               END E1;
+
+               ACCEPT E1 (X, Y : INTEGER := F) DO
+                    IF X = Y OR
+                       NOT ((X = 3 AND Y = 4) OR
+                            (X = 4 AND Y = 3)) THEN
+                         FAILED ("DEFAULT NOT EVALUATED CORRECTLY - " &
+                                 "2, X =" & INTEGER'IMAGE(X) &
+                                 ", Y =" & INTEGER'IMAGE(Y));
+                    END IF;
+               END E1;
+
+          END T1;
+
+     BEGIN
+
+          COMMENT ("FIRST CALL");
+          T1.E1 (3);
+
+          COMMENT ("SECOND CALL");
+          T1.E1;
+
+     END;
+
+     RESULT;
+
+END C95093A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095a.ada
new file mode 100644
index 000000000..0cd02958d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095a.ada
@@ -0,0 +1,108 @@
+-- C95095A.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 OVERLOADED SUBPROGRAM AND ENTRY DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (A) A FUNCTION AND AN ENTRY.
+
+-- JWC 7/24/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95095A IS
+
+BEGIN
+     TEST ("C95095A", "SUBPROGRAM/ENTRY OVERLOADING WITH " &
+                      "MINIMAL DIFFERENCES");
+
+     --------------------------------------------------
+
+     -- BOTH PARAMETERIZED AND PARAMETERLESS SUBPROGRAMS AND ENTRIES
+     -- ARE TESTED.
+
+     DECLARE
+          I, J, K : INTEGER := 0;
+          S : STRING (1..2) := "12";
+
+          TASK T IS
+               ENTRY E1 (I1, I2 : INTEGER);
+               ENTRY E2;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT E1 (I1, I2 : INTEGER) DO
+                              S (1) := 'A';
+                         END E1;
+                    OR
+                         ACCEPT E2 DO
+                              S (1) := 'C';
+                         END E2;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T;
+
+          FUNCTION E1 (I1, I2 : INTEGER) RETURN INTEGER IS
+          BEGIN
+               S (2) := 'B';
+               RETURN I1; -- RETURNED VALUE IS IRRELEVENT.
+          END E1;
+
+
+          FUNCTION E2 RETURN INTEGER IS
+          BEGIN
+               S (2) := 'D';
+               RETURN I; -- RETURNED VALUE IS IRRELEVENT.
+          END E2;
+
+     BEGIN
+          T.E1 (I, J);
+          K := E1 (I, J);
+
+          IF S /= "AB" THEN
+               FAILED ("PARAMETERIZED OVERLOADED " &
+                       "SUBPROGRAM AND ENTRY " &
+                       "CAUSED CONFUSION");
+          END IF;
+
+          S := "12";
+          T.E2;
+          K := E2;
+
+          IF S /= "CD" THEN
+               FAILED ("PARAMETERLESS OVERLOADED " &
+                       "SUBPROGRAM AND ENTRY " &
+                       "CAUSED CONFUSION");
+          END IF;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95095A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095b.ada
new file mode 100644
index 000000000..f3c9c0df5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095b.ada
@@ -0,0 +1,112 @@
+-- C95095B.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 OVERLOADED ENTRY DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (B) ONE ENTRY HAS ONE LESS PARAMETER THAN THE OTHER.
+
+-- JWC 7/24/85
+-- JRK 10/2/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95095B IS
+
+BEGIN
+     TEST ("C95095B", "ENTRY OVERLOADING WITH " &
+                      "MINIMAL DIFFERENCES");
+
+     --------------------------------------------------
+
+     -- ONE ENTRY HAS ONE MORE PARAMETER
+     -- THAN THE OTHER.  THIS IS TESTED IN THE
+     -- CASE IN WHICH THAT PARAMETER HAS A DEFAULT
+     -- VALUE, AND THE CASE IN WHICH IT DOES NOT.
+
+     DECLARE
+          I, J : INTEGER := 0;
+          B : BOOLEAN := TRUE;
+          S : STRING (1..2) := "12";
+
+          TASK T IS
+               ENTRY E1 (I1, I2 : INTEGER; B1 : IN OUT BOOLEAN);
+               ENTRY E1 (I1, I2 : INTEGER);
+               ENTRY E2 (B1 : IN OUT BOOLEAN; I1 : INTEGER := 0);
+               ENTRY E2 (B1 : IN OUT BOOLEAN);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT E1 (I1, I2 : INTEGER;
+                                    B1 : IN OUT BOOLEAN) DO
+                              S (1) := 'A';
+                         END E1;
+                    OR
+                         ACCEPT E1 (I1, I2 : INTEGER) DO
+                              S (2) := 'B';
+                         END E1;
+                    OR
+                         ACCEPT E2 (B1 : IN OUT BOOLEAN;
+                                    I1 : INTEGER := 0) DO
+                              S (1) := 'C';
+                         END E2;
+                    OR
+                         ACCEPT E2 (B1 : IN OUT BOOLEAN) DO
+                              S (2) := 'D';
+                         END E2;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T;
+
+     BEGIN
+          T.E1 (I, J, B);
+          T.E1 (I, J);
+
+          IF S /= "AB" THEN
+               FAILED ("ENTRIES DIFFERING ONLY IN " &
+                       "NUMBER OF PARAMETERS (NO DEFAULTS) " &
+                       "CAUSED CONFUSION");
+          END IF;
+
+          S := "12";
+          T.E2 (B, I);
+          -- NOTE THAT A CALL TO T.E2 WITH ONLY
+          -- ONE PARAMETER IS AMBIGUOUS.
+
+          IF S /= "C2" THEN
+               FAILED ("ENTRIES DIFFERING ONLY IN " &
+                       "EXISTENCE OF ONE PARAMETER (WITH " &
+                       "DEFAULT) CAUSED CONFUSION");
+          END IF;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95095B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095c.ada
new file mode 100644
index 000000000..694c7d31e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095c.ada
@@ -0,0 +1,97 @@
+-- C95095C.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 OVERLOADED ENTRY DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (C) THE BASE TYPE OF A PARAMETER IS DIFFERENT FROM THAT
+--         OF THE CORRESPONDING ONE.
+
+-- JWC 7/24/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95095C IS
+
+BEGIN
+     TEST ("C95095C", "ENTRY OVERLOADING WITH " &
+                      "MINIMAL DIFFERENCES");
+
+     --------------------------------------------------
+
+     -- THE BASE TYPE OF ONE PARAMETER IS
+     -- DIFFERENT FROM THAT OF THE CORRESPONDING
+     -- ONE.
+
+     DECLARE
+
+          TYPE NEWINT IS NEW INTEGER;
+
+          I, J, K : INTEGER := 0;
+          N : NEWINT;
+          S : STRING (1..2) := "12";
+
+          TASK T IS
+               ENTRY E (I1 : INTEGER; N1 : OUT NEWINT;
+                        I2 : IN OUT INTEGER);
+               ENTRY E (I1 : INTEGER; N1 : OUT INTEGER;
+                        I2 : IN OUT INTEGER);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT E (I1 : INTEGER; N1 : OUT NEWINT;
+                                   I2 : IN OUT INTEGER) DO
+                              S (1) := 'A';
+                              N1 := 0; -- THIS VALUE IS IRRELEVENT.
+                         END E;
+                    OR
+                         ACCEPT E (I1 : INTEGER; N1 : OUT INTEGER;
+                                   I2 : IN OUT INTEGER) DO
+                              S (2) := 'B';
+                              N1 := 0; -- THIS VALUE IS IRRELEVENT.
+                         END E;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T;
+
+     BEGIN
+          T.E (I, N, K);
+          T.E (I, J, K);
+
+          IF S /= "AB" THEN
+               FAILED ("ENTRIES DIFFERING ONLY BY " &
+                       "THE BASE TYPE OF A PARAMETER " &
+                       "CAUSED CONFUSION");
+          END IF;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95095C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095d.ada
new file mode 100644
index 000000000..f2ad7d95a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095d.ada
@@ -0,0 +1,99 @@
+-- C95095D.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 OVERLOADED SUBPROGRAM AND ENTRY DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (D) A SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE
+--         PART, AN ENTRY IS DECLARED IN A TASK, AND THE
+--         PARAMETERS ARE ORDERED DIFFERENTLY.
+
+-- JWC 7/24/85
+-- JRK 10/2/85
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C95095D IS
+
+
+BEGIN
+     TEST ("C95095D", "SUBPROGRAM/ENTRY OVERLOADING WITH " &
+                      "MINIMAL DIFFERENCES");
+
+     --------------------------------------------------
+
+     -- A SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE
+     -- PART, AN ENTRY IS DECLARED IN A TASK, AND THE
+     -- PARAMETERS ARE ORDERED DIFFERENTLY.
+
+     DECLARE
+          S : STRING (1..2) := "12";
+
+          I : INTEGER := 0;
+
+          PROCEDURE E (I1 : INTEGER; I2 : IN OUT INTEGER;
+                       B1 : BOOLEAN) IS
+          BEGIN
+               S (1) := 'A';
+          END E;
+
+          TASK T IS
+               ENTRY E (B1 : BOOLEAN; I1 : INTEGER;
+                        I2 : IN OUT INTEGER);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               E (5, I, TRUE);          -- PROCEDURE CALL.
+               ACCEPT E (B1 : BOOLEAN; I1 : INTEGER;
+                         I2 : IN OUT INTEGER) DO
+                    S (2) := 'B';
+               END E;
+               E (TRUE, 5, I);          -- ENTRY CALL; SELF-BLOCKING.
+               -- NOTE THAT A CALL IN WHICH ALL ACTUAL PARAMETERS
+               -- ARE NAMED_ASSOCIATIONS IS AMBIGUOUS.
+               FAILED ("TASK DID NOT BLOCK ITSELF");
+          END T;
+
+     BEGIN
+
+          T.E (TRUE, 5, I);
+
+          DELAY 10.0 * Impdef.One_Second;
+          ABORT T;
+
+          IF S /= "AB" THEN
+               FAILED ("PROCEDURES/ENTRIES " &
+                       "DIFFERING ONLY IN PARAMETER " &
+                       "TYPE ORDER CAUSED CONFUSION");
+          END IF;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95095D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095e.ada
new file mode 100644
index 000000000..01951691f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95095e.ada
@@ -0,0 +1,88 @@
+-- C95095E.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 OVERLOADED SUBPROGRAM AND ENTRY DECLARATIONS
+-- ARE PERMITTED IN WHICH THERE IS A MINIMAL
+-- DIFFERENCE BETWEEN THE DECLARATIONS.
+
+--     (E) A SUBPROGRAM IS DECLARED IN AN OUTER DECLARATIVE PART,
+--         AN ENTRY IN A TASK, AND ONE HAS ONE MORE PARAMETER
+--         THAN THE OTHER; THE OMITTED PARAMETER HAS A DEFAULT VALUE.
+
+-- JWC 7/30/85
+-- JRK 10/2/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95095E IS
+
+BEGIN
+     TEST ("C95095E", "SUBPROGRAM/ENTRY OVERLOADING WITH " &
+                      "MINIMAL DIFFERENCES ALLOWED");
+
+     --------------------------------------------------
+
+     -- A SUBPROGRAM IS IN AN OUTER DECLARATIVE
+     -- PART, AN ENTRY IN A TASK, AND ONE
+     -- HAS ONE MORE PARAMETER (WITH A DEFAULT
+     -- VALUE) THAN THE OTHER.
+
+     DECLARE
+          S : STRING (1..3) := "123";
+
+          PROCEDURE E (I1, I2, I3 : INTEGER := 1) IS
+               C : CONSTANT STRING := "CXA";
+          BEGIN
+               S (I3) := C (I3);
+          END E;
+
+          TASK T IS
+               ENTRY E (I1, I2 : INTEGER := 1);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (I1, I2 : INTEGER := 1) DO
+                    S (2) := 'B';
+               END E;
+          END T;
+
+     BEGIN
+
+          E (1, 2, 3);
+          T.E (1, 2);
+          E (1, 2);
+
+          IF S /= "CBA" THEN
+               FAILED ("PROCEDURES/ENTRIES DIFFERING " &
+                       "ONLY IN EXISTENCE OF ONE " &
+                       "DEFAULT-VALUED PARAMETER CAUSED " &
+                       "CONFUSION");
+          END IF;
+
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END C95095E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951001.a
new file mode 100644
index 000000000..c1cf96593
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951001.a
@@ -0,0 +1,192 @@
+-- C951001.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 two procedures in a protected object will not be 
+--      executed concurrently.
+--
+-- TEST DESCRIPTION:
+--      A very simple example of two tasks calling two procedures in the same 
+--      protected object is used.  Test control code has been added to the
+--      procedures such that, whichever gets called first executes a lengthy
+--      calculation giving sufficient time (on a multiprocessor or a
+--      time-slicing machine) for the other task to get control and call the
+--      other procedure.  The control code verifies that entry to the second
+--      routine is postponed until the first is complete.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with ImpDef;
+
+procedure C951001 is
+
+   protected Ramp_31 is
+
+      procedure Add_Meter_Queue;
+      procedure Subtract_Meter_Queue;
+      function  TC_Failed return Boolean;
+   
+   private
+
+      Ramp_Count : integer range 0..20 := 4;  -- Start test with some
+                                              -- vehicles on the ramp
+   
+      TC_Add_Started       : Boolean := false;
+      TC_Subtract_Started  : Boolean := false;
+      TC_Add_Finished      : Boolean := false;
+      TC_Subtract_Finished : Boolean := false;
+      TC_Concurrent_Running: Boolean := false;
+      
+   end Ramp_31;
+
+   
+   protected body Ramp_31 is
+
+      function TC_Failed return Boolean is
+      begin
+         -- this indicator will have been set true if any instance
+         -- of concurrent running has been proved
+         return TC_Concurrent_Running;
+      end TC_Failed;
+
+
+      procedure Add_Meter_Queue is
+      begin
+         --==================================================
+         -- This section is all Test_Control code
+         TC_Add_Started := true;
+         if TC_Subtract_Started then 
+            if not TC_Subtract_Finished then
+               TC_Concurrent_Running := true;
+            end if;
+         else
+            -- Subtract has not started. 
+            -- Execute a lengthy routine to give it a chance to do so
+            ImpDef.Exceed_Time_Slice;
+
+            if TC_Subtract_Started then 
+               -- Subtract was able to start so we have concurrent 
+               -- running and the test has failed
+               TC_Concurrent_Running := true;
+            end if;
+         end if;
+         TC_Add_Finished := true;
+         --==================================================
+         Ramp_Count := Ramp_Count + 1;
+      end Add_Meter_Queue;
+
+      procedure Subtract_Meter_Queue is
+      begin
+         --==================================================
+         -- This section is all Test_Control code
+         TC_Subtract_Started := true;
+         if TC_Add_Started then 
+            if not TC_Add_Finished then
+               -- We already have concurrent running
+               TC_Concurrent_Running := true;
+            end if;
+         else
+            -- Add has not started. 
+            -- Execute a lengthy routine to give it a chance to do so
+            ImpDef.Exceed_Time_Slice;
+
+            if TC_Add_Started then 
+               -- Add was able to start so we have concurrent 
+               -- running and the test has failed
+               TC_Concurrent_Running := true;
+            end if;
+         end if;
+         TC_Subtract_Finished := true;
+         --==================================================
+         Ramp_Count := Ramp_Count - 1;
+      end Subtract_Meter_Queue;
+   
+   end Ramp_31;
+
+begin
+
+   Report.Test ("C951001", "Check that two procedures in a protected" &
+                           " object will not be executed concurrently");
+
+   declare -- encapsulate the test
+
+      task Vehicle_1;
+      task Vehicle_2;
+
+
+      -- Vehicle_1 and Vehicle_2 are simulations of Instances of the task
+      -- of type Vehicle in different stages of execution
+
+      task body Vehicle_1 is
+      begin
+         null;  -- ::::: stub.  preparation code
+         
+         -- Add to the count of vehicles on the queue   
+         Ramp_31.Add_Meter_Queue;
+
+         null;  -- ::::: stub:  wait at the meter then pass to first sensor
+
+         -- Reduce the count of vehicles on the queue
+         null;  -- ::::: stub: Ramp_31.Subtract_Meter_Queue
+      exception
+         when others =>
+               Report.Failed ("Unexpected Exception in Vehicle_1 task");
+      end Vehicle_1;
+
+
+      task body Vehicle_2 is
+      begin
+         null;  -- ::::: stub.  preparation code
+         
+         -- Add to the count of vehicles on the queue   
+         null;  -- ::::: stub Ramp_31.Add_Meter_Queue;  
+
+         null;  -- ::::: stub:  wait at the meter then pass to first sensor
+
+         -- Reduce the count of vehicles on the queue
+         Ramp_31.Subtract_Meter_Queue;
+      exception
+         when others =>
+               Report.Failed ("Unexpected Exception in Vehicle_2 task");
+      end Vehicle_2;
+
+  
+
+   begin
+      null;
+   end;   -- encapsulation
+
+   if Ramp_31.TC_Failed then
+      Report.Failed ("Concurrent Running detected");
+   end if;
+
+   Report.Result;
+
+end C951001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951002.a
new file mode 100644
index 000000000..65b696c4a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951002.a
@@ -0,0 +1,334 @@
+-- C951002.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 an entry and a procedure within the same protected object
+--      will not be executed simultaneously.
+--
+-- TEST DESCRIPTION:
+--      Two tasks are used.  The first calls an entry who's barrier is set
+--      and is thus queued.  The second calls a procedure in the same 
+--      protected object.  This procedure clears the entry barrier of the 
+--      first then executes a lengthy compute bound procedure.  This is 
+--      intended to allow a multiprocessor, or a time-slicing implementation 
+--      of a uniprocessor, to (erroneously) permit the first task to continue
+--      while the second is still computing.  Flags in each process in the 
+--      PO are checked to ensure that they do not run out of sequence or in 
+--      parallel.  
+--      In the second part of the test another entry and procedure are used
+--      but in this case the procedure is started first.  A different task
+--      calls the entry AFTER the procedure has started.  If the entry 
+--      completes before the procedure the test fails.
+--
+--      This test will not be effective on a uniprocessor without time-slicing
+--      It is designed to increase the chances of failure on a multiprocessor,
+--      or a uniprocessor with time-slicing, if the entry and procedure in a 
+--      Protected Object are not forced to acquire a single execution 
+--      resource.  It is not guaranteed to fail.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with ImpDef;
+
+procedure C951002 is
+   
+   -- These global error flags are used for failure conditions within
+   -- the protected object.  We cannot call Report.Failed (thus Text_io)
+   -- which would result in a bounded error.
+   --
+   TC_Error_01 : Boolean := false;
+   TC_Error_02 : Boolean := false;
+   TC_Error_03 : Boolean := false;
+   TC_Error_04 : Boolean := false;
+   TC_Error_05 : Boolean := false;
+   TC_Error_06 : Boolean := false;
+
+begin
+
+   Report.Test ("C951002", "Check that a procedure and an entry body " &
+                           "in a protected object will not run concurrently");
+
+   declare -- encapsulate the test
+      
+      task Credit_Message is
+         entry TC_Start;
+      end Credit_Message;
+
+      task Credit_Task is
+         entry TC_Start;
+      end Credit_Task;
+
+      task Debit_Message is
+         entry TC_Start;
+      end Debit_Message;
+
+      task Debit_Task is
+         entry TC_Start;
+      end Debit_Task;
+
+      --====================================
+
+      protected Hold is
+
+         entry Wait_for_CR_Underload;
+         procedure Clear_CR_Overload;
+         entry Wait_for_DB_Underload;
+         procedure Set_DB_Overload;
+         procedure Clear_DB_Overload;
+         --
+         function TC_Message_is_Queued return Boolean;
+
+      private
+         Credit_Overloaded     : Boolean := true;  -- Test starts in overload
+         Debit_Overloaded      : Boolean := false; 
+         -- 
+         TC_CR_Proc_Finished   : Boolean := false;
+         TC_CR_Entry_Finished  : Boolean := false;
+         TC_DB_Proc_Finished   : Boolean := false;
+         TC_DB_Entry_Finished  : Boolean := false;
+      end Hold;
+      --====================
+      protected body Hold is
+   
+         entry Wait_for_CR_Underload when not Credit_Overloaded is
+         begin
+            -- The barrier must only be re-evaluated at the end of the 
+            -- of the execution of the procedure, also while the procedure
+            -- is executing this entry body must not be executed
+            if not TC_CR_Proc_Finished then
+               TC_Error_01 := true;  -- Set error indicator
+            end if;
+            TC_CR_Entry_Finished := true;
+         end Wait_for_CR_Underload ;
+   
+         -- This is the procedure which should NOT be able to run in 
+         -- parallel with the entry body
+         --
+         procedure Clear_CR_Overload is
+         begin
+
+            -- The entry body must not be executed until this procedure
+            -- is completed.  
+            if TC_CR_Entry_Finished then
+               TC_Error_02 := true;  -- Set error indicator
+            end if;
+            Credit_Overloaded := false;   -- clear the entry barrier
+
+            -- Execute an implementation defined compute bound routine which 
+            -- is designed to run long enough to allow a task switch on a
+            -- time-sliced uniprocessor, or for a multiprocessor to pick up
+            -- another task.
+            -- 
+            ImpDef.Exceed_Time_Slice;
+            
+            -- Again, the entry body must not be executed until the current 
+            -- procedure is completed.  
+            --
+            if TC_CR_Entry_Finished then
+               TC_Error_03 := true;  -- Set error indicator
+            end if;
+            TC_CR_Proc_Finished := true;
+
+         end Clear_CR_Overload;
+   
+         --============
+         -- The following subprogram and entry body are used in the second
+         -- part of the test
+         
+         entry Wait_for_DB_Underload when not Debit_Overloaded is
+         begin
+            -- By the time the task that calls this entry is allowed access to
+            -- the queue the barrier, which starts off as open, will be closed
+            -- by the Set_DB_Overload procedure.  It is only reopened 
+            -- at the end of the test
+            if not TC_DB_Proc_Finished then
+               TC_Error_04 := true;  -- Set error indicator
+            end if;
+            TC_DB_Entry_Finished := true;
+         end Wait_for_DB_Underload ;
+   
+   
+         procedure Set_DB_Overload is
+         begin
+            -- The task timing is such that this procedure should be started
+            -- before the entry is called.  Thus the entry should be blocked
+            -- until the end of this procedure which then sets the barrier
+            --
+            if TC_DB_Entry_Finished then
+               TC_Error_05 := true;  -- Set error indicator
+            end if;
+
+            -- Execute an implementation defined compute bound routine which 
+            -- is designed to run long enough to allow a task switch on a
+            -- time-sliced uniprocessor, or for a multiprocessor to pick up
+            -- another task
+            -- 
+            ImpDef.Exceed_Time_Slice;
+            
+            Debit_Overloaded := true;   -- set the entry barrier
+
+            if TC_DB_Entry_Finished then
+               TC_Error_06 := true;  -- Set error indicator
+            end if;
+            TC_DB_Proc_Finished := true;
+
+         end Set_DB_Overload;
+   
+         procedure Clear_DB_Overload is
+         begin
+            Debit_Overloaded := false;  -- open the entry barrier
+         end Clear_DB_Overload;
+
+         function TC_Message_is_Queued return Boolean is
+         begin
+   
+            -- returns true when one message arrives on the queue
+            return (Wait_for_CR_Underload'Count = 1);   
+                                                    
+         end TC_Message_is_Queued ;
+
+      end Hold;
+
+      --====================================
+
+      task body Credit_Message is
+      begin
+         accept TC_Start;
+         --::  some application processing.  Part of the process finds that
+         --    the Overload threshold has been exceeded for the Credit
+         --    application.  This message task queues itself on a queue
+         --    waiting till the overload in no longer in effect 
+         Hold.Wait_for_CR_Underload;
+      exception
+         when others =>
+            Report.Failed ("Unexpected Exception in Credit_Message Task");
+      end Credit_Message;
+
+      task body Credit_Task is
+      begin
+         accept TC_Start;
+         --  Application code here (not shown) determines that the
+         --  underload threshold has been reached
+         Hold.Clear_CR_Overload;
+      exception
+         when others =>
+            Report.Failed ("Unexpected Exception in Credit_Task");
+      end Credit_Task;
+
+      --============== 
+
+      -- The following two tasks are used in the second part of the test
+
+      task body Debit_Message is
+      begin
+         accept TC_Start;
+         --::  some application processing.  Part of the process finds that
+         --    the Overload threshold has been exceeded for the Debit 
+         --    application.  This message task queues itself on a queue
+         --    waiting till the overload is no longer in effect 
+         --
+         Hold.Wait_for_DB_Underload;
+      exception
+         when others =>
+            Report.Failed ("Unexpected Exception in Debit_Message Task");
+      end Debit_Message;
+
+      task body Debit_Task is
+      begin
+         accept TC_Start;
+         --  Application code here (not shown) determines that the
+         --  underload threshold has been reached
+         Hold.Set_DB_Overload;
+      exception
+         when others =>
+            Report.Failed ("Unexpected Exception in Debit_Task");
+      end Debit_Task;
+   
+   begin -- declare
+
+      Credit_Message.TC_Start;
+      
+      -- Wait until the message is queued on the entry before starting
+      -- the Credit_Task
+      while not Hold.TC_Message_is_Queued loop
+         delay ImpDef.Long_Minimum_Task_Switch;   
+      end loop;
+      --
+      Credit_Task.TC_Start;
+
+      -- Ensure the first part of the test is complete before continuing
+      while not (Credit_Message'terminated and Credit_Task'terminated) loop
+         delay ImpDef.Long_Minimum_Task_Switch;   
+      end loop;
+
+      --======================================================
+      -- Second part of the test
+
+
+      Debit_Task.TC_Start;
+      
+      -- Delay long enough to allow a task switch to the Debit_Task and
+      -- for it to reach the accept statement and call Hold.Set_DB_Overload
+      -- before starting Debit_Message
+      --
+      delay ImpDef.Long_Switch_To_New_Task;
+
+      Debit_Message.TC_Start;
+
+      while not Debit_Task'terminated loop
+         delay ImpDef.Long_Minimum_Task_Switch;   
+      end loop;    
+  
+      Hold.Clear_DB_Overload;  -- Allow completion 
+   
+   end; -- declare (encapsulation)
+
+   if TC_Error_01 then
+      Report.Failed ("Wait_for_CR_Underload executed out of sequence");
+   end if;
+   if TC_Error_02 then
+      Report.Failed ("Credit: Entry executed before procedure");
+   end if;
+   if TC_Error_03 then
+      Report.Failed ("Credit: Entry executed in parallel");
+   end if;
+   if TC_Error_04 then
+      Report.Failed ("Wait_for_DB_Underload executed out of sequence");
+   end if;
+   if TC_Error_05 then
+      Report.Failed ("Debit: Entry executed before procedure");
+   end if;
+   if TC_Error_06 then
+      Report.Failed ("Debit: Entry executed in parallel");
+   end if;
+   
+   Report.Result;
+
+end C951002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c953001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c953001.a
new file mode 100644
index 000000000..bc9c85f30
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c953001.a
@@ -0,0 +1,188 @@
+-- C953001.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 the evaluation of an entry_barrier condition
+--      propagates an exception, the exception Program_Error
+--      is propagated to all current callers of all entries of the
+--      protected object.
+--
+-- TEST DESCRIPTION:
+--      This test declares a protected object (PO) with two entries and
+--      a 5 element entry family.
+--      All the entries are always closed.  However, one of the entries
+--      (Oh_No) will get a constraint_error in its barrier_evaluation
+--      whenever the global variable Blow_Up is true.
+--      An array of tasks is created where the tasks wait on the various
+--      entries of the protected object.  Once all the tasks are waiting
+--      the main procedure calls the entry Oh_No and causes an exception
+--      to be propagated to all the tasks.  The tasks record the fact 
+--      that they got the correct exception in global variables that
+--      can be checked after the tasks complete.
+--
+--
+-- CHANGE HISTORY:
+--      19 OCT 95   SAIC    ACVC 2.1
+--
+--!
+
+
+with Report;
+with ImpDef;
+procedure C953001 is
+    Verbose : constant Boolean := False;
+    Max_Tasks : constant := 12;
+
+      -- note status and error conditions
+    Blocked_Entry_Taken : Boolean := False;
+    In_Oh_No            : Boolean := False;
+    Task_Passed : array (1..Max_Tasks) of Boolean := (1..Max_Tasks => False);
+
+begin
+  Report.Test ("C953001",
+               "Check that an exception in an entry_barrier condition" &
+               " causes Program_Error to be propagated to all current" &
+               " callers of all entries of the protected object");
+
+  declare -- test encapsulation
+    -- miscellaneous values
+    Cows : Integer := Report.Ident_Int (1);
+    Came_Home : Integer := Report.Ident_Int (2);
+
+    -- make the Barrier_Condition fail only when we want it to
+    Blow_Up : Boolean := False;
+
+    function Barrier_Condition return Boolean is
+    begin
+      if Blow_Up then
+         return 5 mod Report.Ident_Int(0) = 1;
+      else
+         return False;
+      end if;
+    end Barrier_Condition;
+
+    subtype Family_Index is Integer range 1..5;
+
+    protected PO is
+      entry Block1;
+      entry Oh_No;
+      entry Family (Family_Index);
+    end PO;
+
+    protected body PO is
+      entry Block1 when Report.Ident_Int(0) = Report.Ident_Int(1) is
+      begin
+        Blocked_Entry_Taken := True;
+      end Block1;
+
+      -- barrier will get a Constraint_Error (divide by 0)
+      entry Oh_No when Barrier_Condition is
+      begin
+        In_Oh_No := True;
+      end Oh_No;
+
+      entry Family (for Member in Family_Index) when Cows = Came_Home is
+      begin
+        Blocked_Entry_Taken := True;
+      end Family;
+    end PO;
+     
+
+    task type Waiter is
+      entry Take_Id (Id : Integer);
+    end Waiter;
+
+    Bunch_of_Waiters : array (1..Max_Tasks) of Waiter;
+
+    task body Waiter is
+      Me : Integer;
+      Action : Integer;
+    begin
+      accept Take_Id (Id : Integer) do
+         Me := Id;
+      end Take_Id;
+
+      Action := Me mod (Family_Index'Last + 1);
+      begin
+        if Action = 0 then
+          PO.Block1; 
+        else
+          PO.Family (Action);
+        end if;
+        Report.Failed ("no exception for task" & Integer'Image (Me));
+      exception
+         when Program_Error =>
+           Task_Passed (Me) := True;
+           if Verbose then
+             Report.Comment ("pass for task" & Integer'Image (Me));
+           end if;
+         when others =>
+           Report.Failed ("wrong exception raised in task" &
+                          Integer'Image (Me));
+      end;
+    end Waiter;
+
+
+  begin   -- test encapsulation
+    for I in 1..Max_Tasks loop
+      Bunch_Of_Waiters(I).Take_Id (I);
+    end loop;
+
+    -- give all the Waiters time to get queued
+    delay 2*ImpDef.Clear_Ready_Queue;
+
+    -- cause the protected object to fail
+    begin
+      Blow_Up := True;
+      PO.Oh_No;
+      Report.Failed ("no exception in call to PO.Oh_No");
+    exception
+      when Constraint_Error =>
+         Report.Failed ("Constraint_Error instead of Program_Error");
+      when Program_Error =>
+         if Verbose then
+           Report.Comment ("main exception passed");
+         end if;
+      when others =>
+         Report.Failed ("wrong exception in main");
+    end;
+  end;    -- test encapsulation
+
+  -- all the tasks have now completed.
+  -- check the flags for pass/fail info
+  if Blocked_Entry_Taken then
+     Report.Failed ("blocked entry taken");
+  end if;
+  if In_Oh_No then
+     Report.Failed ("entry taken with exception in barrier");
+  end if;
+  for I in 1..Max_Tasks loop
+    if not Task_Passed (I) then
+      Report.Failed ("task" & Integer'Image (I) & " did not pass");
+    end if;
+  end loop;
+
+  Report.Result;
+end C953001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c953002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c953002.a
new file mode 100644
index 000000000..d821bb24e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c953002.a
@@ -0,0 +1,242 @@
+-- C953002.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 servicing of entry queues of a protected object 
+--      continues until there are no open entries with queued calls
+--      and that this takes place as part of a single protected 
+--      operation.
+--
+-- TEST DESCRIPTION:
+--      This test enqueues a bunch of tasks on the entries of the
+--      protected object Main_PO.  At the same time another bunch of
+--      of tasks are queued on the single entry of protected object
+--      Holding_Pen.
+--      Once all the tasks have had time to block, the main procedure
+--      opens all the entries for Main_PO by calling the 
+--      Start_Protected_Operation protected procedure.  This should
+--      process all the pending callers as part of a single protected
+--      operation.
+--      During this protected operation, the entries of Main_PO release
+--      the tasks blocked on Holding_Pen by calling the protected 
+--      procedure Release.
+--      Once released from Holding_Pen, the task immediately calls
+--      an entry in Main_PO.
+--      These new calls should not gain access to Main_PO until
+--      the initial protected operation on that object completes.
+--      The order in which the entry calls on Main_PO are taken is
+--      recorded in a global array and checked after all the tasks
+--      have terminated.
+--
+--
+-- CHANGE HISTORY:
+--      25 OCT 95   SAIC    ACVC 2.1
+--      15 JAN 95   SAIC    Fixed deadlock problem.
+--
+--!
+
+with Report;
+procedure C953002 is
+  Verbose : constant Boolean := False;
+
+  Half_Tasks : constant := 15;   -- how many tasks of each group 
+  Max_Tasks : constant := Half_Tasks * 2;  -- total number of tasks
+
+  Note_Order : array (1..Max_Tasks) of Integer := (1..Max_Tasks => 0);
+  Note_Cnt : Integer := 0;
+begin
+  Report.Test ("C953002",
+               "Check that the servicing of entry queues handles all" &
+               " open entries as part of a single protected operation");
+  declare
+     task type Assault_PO is
+        entry Take_ID (Id : Integer);
+     end Assault_PO;
+
+     First_Wave  : array (1 .. Half_Tasks) of Assault_PO;
+     Second_Wave : array (1 .. Half_Tasks) of Assault_PO;
+
+     protected Main_PO is
+        entry E0 (Who : Integer);
+        entry E1 (Who : Integer);
+        entry E2 (Who : Integer);
+        entry E3 (Who : Integer);
+        entry All_Present;
+        procedure Start_Protected_Operation;
+     private
+        Open : Boolean := False;
+     end Main_PO;
+
+     protected Holding_Pen is
+        -- Note that Release is called by tasks executing in 
+        -- the protected object Main_PO.
+        entry Wait (Who : Integer);
+        entry All_Present;
+        procedure Release;
+     private
+        Open : Boolean := False;
+     end Holding_Pen;
+
+     
+     protected body Main_PO is
+        procedure Start_Protected_Operation is
+        begin
+           Open := True;
+           -- at this point all the First_Wave tasks are
+           -- waiting at the entries and all of them should
+           -- be processed as part of the protected operation.
+        end Start_Protected_Operation;
+
+        entry All_Present when E0'Count + E1'Count + E2'Count + E3'Count =
+                               Max_Tasks / 2  is
+        begin
+           null;   -- all tasks are waiting
+        end All_Present; 
+
+        entry E0 (Who : Integer) when Open is
+        begin
+           Holding_Pen.Release;
+           -- note the order in which entry calls are handled.
+           Note_Cnt := Note_Cnt + 1;
+           Note_Order (Note_Cnt) := Who;
+        end E0;
+
+        entry E1 (Who : Integer) when Open is
+        begin
+           Holding_Pen.Release;
+           Note_Cnt := Note_Cnt + 1;
+           Note_Order (Note_Cnt) := Who;
+        end E1;
+
+        entry E2 (Who : Integer) when Open is
+        begin
+           Holding_Pen.Release;
+           Note_Cnt := Note_Cnt + 1;
+           Note_Order (Note_Cnt) := Who;
+        end E2;
+
+        entry E3 (Who : Integer) when Open is
+        begin
+           Holding_Pen.Release;
+           Note_Cnt := Note_Cnt + 1;
+           Note_Order (Note_Cnt) := Who;
+        end E3;
+     end Main_PO;
+
+
+     protected body Holding_Pen is
+        procedure Release is
+        begin
+           Open := True;
+        end Release;
+
+        entry All_Present when Wait'Count = Max_Tasks / 2 is
+        begin
+           null;  -- all tasks waiting
+        end All_Present;
+
+        entry Wait (Who : Integer) when Open is
+        begin
+           null;  -- unblock the task
+        end Wait;
+     end Holding_Pen;
+
+     task body Assault_PO is
+        Me : Integer;
+     begin
+        accept Take_Id (Id : Integer) do
+           Me := Id;
+        end Take_Id;
+        if Me >= 200 then
+           Holding_Pen.Wait (Me);
+        end if;
+        case Me mod 4 is
+           when 0 => Main_PO.E0 (Me);
+           when 1 => Main_PO.E1 (Me);
+           when 2 => Main_PO.E2 (Me);
+           when 3 => Main_PO.E3 (Me);
+           when others => null;  -- cant happen
+        end case;
+        if Verbose then
+           Report.Comment ("task" & Integer'Image (Me) &
+                           " done");
+        end if;
+     exception
+        when others =>
+           Report.Failed ("exception in task");
+     end Assault_PO;
+
+  begin   -- test encapsulation
+     for I in First_Wave'Range loop
+        First_Wave (I).Take_ID (100 + I);
+     end loop;
+     for I in Second_Wave'Range loop
+        Second_Wave (I).Take_ID (200 + I);
+     end loop;
+     
+     -- let all the tasks get blocked
+     Main_PO.All_Present;
+     Holding_Pen.All_Present; 
+
+     -- let the games begin
+     if Verbose then
+        Report.Comment ("starting protected operation");
+     end if;
+     Main_PO.Start_Protected_Operation;
+
+     -- wait for all the tasks to complete
+     if Verbose then
+        Report.Comment ("waiting for tasks to complete");
+     end if;
+  end;
+
+  -- make sure all tasks registered their order
+  if Note_Cnt /= Max_Tasks then
+     Report.Failed ("task registration count wrong. " &
+                    Integer'Image (Note_Cnt));
+  end if;
+
+  -- check the order in which entries were handled.
+  -- all the 100 level items should be handled as part of the
+  -- first protected operation and thus should be completed
+  -- before any 200 level item.
+
+  if Verbose then
+     for I in 1..Max_Tasks loop
+        Report.Comment ("order" & Integer'Image (I) & " is" &
+                        Integer'Image (Note_Order (I))); 
+     end loop;
+  end if;
+  for I in 2 .. Max_Tasks loop
+     if Note_Order (I)   <  200 and
+        Note_Order (I-1) >= 200 then
+        Report.Failed ("protected operation failure" &
+                       Integer'Image (Note_Order (I-1)) &
+                       Integer'Image (Note_Order (I)));
+     end if;
+  end loop;
+  
+  Report.Result;
+end C953002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c953003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c953003.a
new file mode 100644
index 000000000..4ac91169e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c953003.a
@@ -0,0 +1,189 @@
+-- C953003.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 servicing of entry queues of a protected object 
+--      continues until there are no open entries with queued (or 
+--      requeued) calls and that internal requeues are handled 
+--      as part of a single protected operation.
+--
+-- TEST DESCRIPTION:
+--      A number of tasks are created and blocked on a protected object
+--      so that they can all be released at one time.  When released,
+--      these tasks make an entry call to an entry in the Main_PO 
+--      protected object.  As part of the servicing of this entry
+--      call the call is passed through the remaining entries of the
+--      protected object by using internal requeues.  The protected
+--      object checks that no other entry call is accepted until 
+--      after all the internal requeuing has completed.
+--
+--
+-- CHANGE HISTORY:
+--      12 JAN 96   SAIC    Initial version for 2.1
+--
+--!
+
+with Report;
+procedure C953003 is
+  Verbose : constant Boolean := False;
+
+  Order_Error : Boolean := False;
+
+  Max_Tasks : constant := 10;  -- total number of tasks
+  Max_Entries : constant := 4;  -- number of entries in Main_PO
+  Note_Cnt : Integer := 0;
+  Note_Order : array (1..Max_Tasks*Max_Entries) of Integer;
+begin
+  Report.Test ("C953003",
+               "Check that the servicing of entry queues handles all" &
+               " open entries as part of a single protected operation," &
+               " including those resulting from an internal requeue");
+  declare
+     task type Assault_PO is
+        entry Take_ID (Id : Integer);
+     end Assault_PO;
+
+     Marines  : array (1 .. Max_Tasks) of Assault_PO;
+
+     protected Main_PO is
+        entry E0 (Who : Integer);
+     private
+        entry E3 (Who : Integer);
+        entry E2 (Who : Integer);
+        entry E1 (Who : Integer);
+        Expected_Next : Integer := 0;
+     end Main_PO;
+
+     
+     protected body Main_PO is
+
+        entry E0 (Who : Integer) when True is
+        begin
+           Order_Error := Order_Error or Expected_Next /= 0;
+           Expected_Next := 1;
+           Note_Cnt := Note_Cnt + 1;
+           Note_Order (Note_Cnt) := Who;
+           requeue E1;
+        end E0;
+
+        entry E1 (Who : Integer) when True is
+        begin
+           Order_Error := Order_Error or Expected_Next /= 1;
+           Expected_Next := 2;
+           Note_Cnt := Note_Cnt + 1;
+           Note_Order (Note_Cnt) := Who;
+           requeue E2;
+        end E1;
+
+        entry E3 (Who : Integer) when True is
+        begin
+           Order_Error := Order_Error or Expected_Next /= 3;
+           Expected_Next := 0;
+           Note_Cnt := Note_Cnt + 1;
+           Note_Order (Note_Cnt) := Who;
+           -- all done - return now
+        end E3;
+
+        entry E2 (Who : Integer) when True is
+        begin
+           Order_Error := Order_Error or Expected_Next /= 2;
+           Expected_Next := 3;
+           Note_Cnt := Note_Cnt + 1;
+           Note_Order (Note_Cnt) := Who;
+           requeue E3;
+        end E2;
+     end Main_PO;
+
+     protected Holding_Pen is
+        entry Wait_For_All_Present;
+        entry Wait;
+     private
+        Open : Boolean := False;
+     end Holding_Pen;
+
+     protected body Holding_Pen is
+        entry Wait_For_All_Present when Wait'Count = Max_Tasks is
+        begin
+           Open := True;
+        end Wait_For_All_Present;
+
+        entry Wait when Open is
+        begin
+           null;  -- just go
+        end Wait;
+     end Holding_Pen;
+
+
+     task body Assault_PO is
+        Me : Integer;
+     begin
+        accept Take_Id (Id : Integer) do
+           Me := Id;
+        end Take_Id;
+        Holding_Pen.Wait;
+        Main_PO.E0 (Me);
+        if Verbose then
+           Report.Comment ("task" & Integer'Image (Me) &
+                           " done");
+        end if;
+     exception
+        when others =>
+           Report.Failed ("exception in task");
+     end Assault_PO;
+
+  begin   -- test encapsulation
+     for I in Marines'Range loop
+        Marines (I).Take_ID (100 + I);
+     end loop;
+     
+     -- let all the tasks get blocked so we can release them all
+     -- at one time
+     Holding_Pen.Wait_For_All_Present; 
+
+     -- wait for all the tasks to complete
+     if Verbose then
+        Report.Comment ("waiting for tasks to complete");
+     end if;
+  end;
+
+  -- make sure all tasks registered their order
+  if Note_Cnt /= Max_Tasks * Max_Entries then
+     Report.Failed ("task registration count wrong. " &
+                    Integer'Image (Note_Cnt));
+  end if;
+
+  if Order_Error then
+     Report.Failed ("internal requeue not handled as part of operation");
+  end if;
+
+  if Verbose or Order_Error then
+     for I in 1..Max_Tasks * Max_Entries loop
+        Report.Comment ("order" & Integer'Image (I) & " is" &
+                        Integer'Image (Note_Order (I))); 
+     end loop;
+  end if;
+
+  Report.Result;
+end C953003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954001.a
new file mode 100644
index 000000000..3112cce2b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954001.a
@@ -0,0 +1,273 @@
+-- C954001.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 requeue statement within an entry_body with parameters
+--      may requeue the entry call to a protected entry with a subtype-
+--      conformant parameter profile. Check that, if the call is queued on the
+--      new entry's queue, the original caller remains blocked after the
+--      requeue, but the entry_body containing the requeue is completed.
+--
+-- TEST DESCRIPTION:
+--      Declare a protected object which simulates a disk device. Declare an
+--      entry that requeues the caller to a second entry if the disk head is
+--      not in the proper location, but first sets the second entry's barrier
+--      to false. Declare a procedure which sets the second entry's barrier
+--      to true.
+--
+--      Declare a task which calls the first entry such that the requeue is
+--      called. This task should be queued on the second entry and remain
+--      blocked, and the first entry should be complete. Call the procedure
+--      which releases the second entry's queue. The second entry should
+--      complete, after which the task should complete.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C954001_0 is  -- Disk management abstraction.
+
+
+   -- Simulate a read-only disk device with a head that may be moved to
+   -- different tracks. If a read request is issued for the current
+   -- track, the request can be satisfied immediately. Otherwise, the head
+   -- must be moved to the correct track, during which time the calling task
+   -- is blocked. When the head reaches the correct track, the disk generates
+   -- an interrupt, after which the request can be satisfied, and the
+   -- calling task can proceed.
+
+   Buffer_Size : constant := 100;
+
+   type Disk_Buffer is new String (1 .. Buffer_Size);
+   type Disk_Track  is new Natural;
+
+   type Disk_Address is record
+      Track : Disk_Track;
+      -- Additional components.
+   end record;
+
+   Initial_Track : constant Disk_Track := 0;
+   New_Track     : constant Disk_Track := 5;
+
+               --==============================================--
+
+   protected Disk_Device is
+
+      entry Read (Where :     Disk_Address;            -- Read data from disk
+                  Data  : out Disk_Buffer);            -- track.
+
+      procedure Disk_Interrupt;                        -- Handle interrupt 
+                                                       -- from disk.
+
+      function TC_Track return Disk_Track;             -- Return current track.
+
+      function TC_Pending_Queued return Boolean;       -- True when there is
+                                                       -- an entry in queue
+
+   private
+
+      entry Pending_Read (Where :     Disk_Address;    -- Wait for head to 
+                          Data  : out Disk_Buffer);    -- move then read data.
+
+      Current_Track     : Disk_Track := Initial_Track; -- Current disk track.
+      Operation_Pending : Boolean    := False;         -- Vis.  entry barrier.
+      Disk_Interrupted  : Boolean    := False;         -- Priv. entry barrier.
+
+   end Disk_Device;
+
+
+end C954001_0;
+
+
+     --==================================================================--
+
+
+package body C954001_0 is  -- Disk management abstraction.
+
+
+   protected body Disk_Device is
+
+      entry Read (Where : Disk_Address; Data : out Disk_Buffer)
+        when not Operation_Pending is
+      begin
+         if (Where.Track = Current_Track) then      -- If the head is over the
+            -- Read data from disk...               -- requested track, read
+            null;                                   -- the data.
+
+         else                                       -- Otherwise, defer read
+            Operation_Pending := True;              -- while head is moved to
+                                                    -- correct track (signaled
+            --                        --            -- by a disk interrupt).
+            -- Requeue is tested here --
+            --                        --
+
+            requeue Pending_Read;                  
+
+         end if;
+      end Read;
+
+
+      procedure Disk_Interrupt is                   -- Called when the disk
+      begin                                         -- interrupts, indicating
+         Disk_Interrupted := True;                  -- that the head is over
+      end Disk_Interrupt;                           -- the correct track.
+
+
+      function TC_Track return Disk_Track is        -- Artifice required for
+      begin                                         -- testing purposes.
+         return (Current_Track);
+      end TC_Track;
+
+
+      entry Pending_Read (Where : Disk_Address; Data : out Disk_Buffer)
+        when Disk_Interrupted is
+      begin
+         Current_Track := Where.Track;              -- Head is now over the
+         -- Read data from disk...                  -- correct track; read
+         Operation_Pending := False;                -- the data.
+         Disk_Interrupted := False;
+      end Pending_Read;
+
+      function TC_Pending_Queued return Boolean is
+      begin
+         -- Return true when there is something on the Pending_Read queue
+         return (Pending_Read'Count /=0);   
+      end TC_Pending_Queued;
+
+   end Disk_Device;
+
+
+end C954001_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with C954001_0;  -- Disk management abstraction.
+use  C954001_0;
+
+procedure C954001 is
+
+
+   task type Read_Task is        -- an unusual (but legal) declaration
+   end Read_Task;
+   --
+   --
+   task body Read_Task is
+      Location : constant Disk_Address := (Track => New_Track);
+      Data     :          Disk_Buffer  := (others => ' ');
+   begin
+      Disk_Device.Read (Location, Data);   -- Invoke requeue statement.
+   exception
+      when others =>
+         Report.Failed ("Exception raised in task");
+   end Read_Task;
+
+               --==============================================--
+
+begin  -- Main program.
+
+   Report.Test ("C954001", "Requeue from an entry within a P.O. " &
+                           "to a private entry within the same P.O.");
+
+
+   declare
+
+      IO_Request : Read_Task;                  -- Request a read from other
+                                               -- than the current track.
+                                               -- IO_Request will be requeued
+                                               -- from Read to Pending_Read.
+   begin
+
+      -- To pass this test, the following must be true:
+      --
+      --    (A) The Read entry call made by the task IO_Request must be
+      --        completed by the requeue.
+      --    (B) IO_Request must remain blocked following the requeue.
+      --    (C) IO_Request must be queued on the Pending_Read entry queue.
+      --    (D) IO_Request must continue execution after the Pending_Read
+      --        entry completes.
+      --
+      -- First, verify (A): that the Read entry call is complete.
+      --
+      -- Call a protected operation (Disk_Device.TC_Track). Since no two
+      -- protected actions may proceed concurrently unless both are protected
+      -- function calls, a call to a protected operation at this point can
+      -- proceed only if the Read entry call is already complete.
+      --
+      -- Note that if Read is NOT complete, the test will likely hang here.
+      --
+      -- Next, verify (B): that IO_Request remains blocked following the
+      -- requeue. Also verify that Pending_Read (the entry to which
+      -- IO_Request should have been queued) has not yet executed.
+
+      -- Wait until the task had made the call and the requeue has been
+      -- effected.  
+      while not Disk_Device.TC_Pending_Queued loop
+         delay ImpDef.Minimum_Task_Switch;
+      end loop;
+
+      if Disk_Device.TC_Track /= Initial_Track then
+         Report.Failed ("Target entry of requeue executed prematurely");
+      elsif IO_Request'Terminated then
+         Report.Failed ("Caller did not remain blocked after " &
+                        "the requeue or was never requeued");
+      else
+
+         -- Verify (C): that IO_Request is queued on the
+         -- Pending_Read entry queue.
+         --
+         -- Set the barrier for Pending_Read to true. Check that the
+         -- current track is updated and that IO_Request terminates.
+
+         Disk_Device.Disk_Interrupt;           -- Simulate a disk interrupt,
+                                               -- signaling that the head is
+                                               -- over the correct track.
+
+         -- The Pending_Read entry body will complete before the next
+         -- protected action is called (Disk_Device.TC_Track).
+
+         if Disk_Device.TC_Track /= New_Track then
+            Report.Failed ("Caller was not requeued on target entry");
+         end if;
+
+         -- Finally, verify (D): that Read_Task continues after Pending_Read
+         -- completes.
+         -- 
+         -- Note that the test will hang here if Read_Task does not continue
+         -- executing following the completion of the requeued entry call.
+
+      end if;
+
+   end;  -- We will not exit the declare block until the task completes
+
+   Report.Result;
+
+end C954001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954010.a
new file mode 100644
index 000000000..ac39c89a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954010.a
@@ -0,0 +1,286 @@
+-- C954010.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 requeue within an accept statement does not block.
+--      This test uses: Requeue to an entry in a different task
+--                      Parameterless call
+--                      Requeue with abort
+--
+-- TEST DESCRIPTION:
+--      In the Distributor task, requeue two successive calls on the entries
+--      of two separate target tasks.  Verify that the target tasks are
+--      run in parallel proving that the first requeue does not block
+--      while the first target rendezvous takes place.                 
+--
+--      This series of tests uses a simulation of a transaction driven 
+--      processing system.  Line Drivers accept input from an external source
+--      and build them into transaction records.  These records are then 
+--      encapsulated in message tasks which remain extant for the life of the
+--      transaction in the system. The message tasks put themselves on the 
+--      input queue of a Distributor which, from information in the 
+--      transaction and/or system load conditions forwards them to other 
+--      operating tasks. These in turn might forward the transactions to yet 
+--      other tasks for further action.  The  routing is, in real life, 
+--      dynamic and unpredictable at the time of message generation. All 
+--      rerouting in this  model is done by means of requeues.
+--
+--      This test is directed towards the BLOCKING of the REQUEUE only
+--      If the original caller does not block, the outcome of the test will
+--      not be affected.  If the original caller does not continue after
+--      the return, the test will not pass.  
+--      If the requeue gets placed on the wrong entry a failing test could
+--      pass (eg. if the first message is delivered to the second
+--      computation task and the second message to the first) - a check for
+--      this condition is made in other tests
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with ImpDef;
+
+procedure C954010 is
+
+   -- Mechanism to count the number of Message tasks completed
+   protected TC_Tasks_Completed is
+      procedure Increment;
+      function  Count return integer;
+   private
+      Number_Complete : integer := 0;
+   end TC_Tasks_Completed;
+   --
+   TC_Expected_To_Complete   : constant integer := 2;
+
+
+   task type Message_Task;
+   type acc_Message_Task is access Message_Task;
+
+   task Line_Driver is
+      entry Start;
+   end Line_Driver;
+
+   task Distributor is 
+      entry Input;
+   end Distributor;
+
+   task Credit_Computation is
+      entry Input;
+   end Credit_Computation;
+
+   task Debit_Computation is
+      entry Input;
+      entry TC_Artificial_Rendezvous_1;      -- test purposes only
+      entry TC_Artificial_Rendezvous_2;      -- test purposes only
+   end Debit_Computation;
+
+   
+   -- Mechanism to count the number of Message tasks completed
+   protected body TC_Tasks_Completed is
+      procedure Increment is
+      begin
+         Number_Complete := Number_Complete + 1;
+      end Increment;
+
+      function Count return integer is
+      begin
+         return Number_Complete;
+      end Count;
+   end TC_Tasks_Completed;
+
+
+
+   -- Assemble messages received from an external source
+   --   Creates a message task for each and sends this to a Distributor 
+   --   for appropriate disposal around the network of tasks
+   --      Such a task would normally be designed to loop continuously
+   --      creating the messages as input is received.  Simulate this 
+   --      but limit it to two dummy messages for this test and allow it
+   --      to terminate at that point
+   --
+   task body Line_Driver is
+
+   begin
+
+      accept Start;      -- Wait for trigger from main
+
+      for i in 1..2 loop
+         declare
+            -- create a new message task 
+            N : acc_Message_Task := new Message_Task; 
+         begin
+            -- preparation code
+            null; -- stub
+
+         end;   -- declare
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Line_Driver");
+   end Line_Driver;
+
+
+   task body Message_Task is
+   begin
+      -- Queue up on Distributor's Input queue
+      Distributor.Input;
+      
+      -- After the required computations have been performed
+      -- return the message appropriately (probably to an output
+      -- line driver
+      null;            -- stub
+
+      -- Increment to show completion of this task
+      TC_Tasks_Completed.Increment;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Message_Task");
+
+   end Message_Task;
+
+
+   -- Dispose each input message to the appropriate computation tasks
+   --    Normally this would be according to some parameters in the entry
+   --    but this simple test is using parameterless entries.  
+   --
+   task body Distributor is
+     Last_was_for_Credit_Computation : Boolean := false;   -- switch
+   begin
+      loop
+         select
+            accept Input do
+               -- Determine to which task the message should be 
+               -- distributed
+               --      For this test arbitrarily send the first to 
+               --      Credit_Computation and the second to Debit_Computation
+               if Last_was_for_Credit_Computation then
+                  requeue Debit_Computation.Input with abort;
+               else 
+                  Last_was_for_Credit_Computation := true;
+                  requeue Credit_Computation.Input with abort;
+               end if;
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Distributor");
+   end Distributor;
+                                          
+                                                
+   -- Computation task.  After the computation is performed the rendezvous
+   -- in the original message task is completed.                              
+   task body Credit_Computation is
+   begin
+      loop
+         select 
+            accept Input do
+               -- Perform the computations required for this message
+               --
+               null;     -- stub
+
+               --   For the test:
+               --   Artificially rendezvous with Debit_Computation.
+               --   If the first requeue in Distributor has blocked 
+               --   waiting for the current rendezvous to complete then the
+               --   second message will not be sent to Debit_Computation 
+               --   which will still be waiting on its Input accept.  
+               --   This task will HANG
+               --
+               Debit_Computation.TC_Artificial_Rendezvous_1;
+               --
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Computation");
+   end Credit_Computation;
+
+                                                
+   -- Computation task.  After the computation is performed the rendezvous
+   -- in the original message task is completed.                              
+   task body Debit_Computation is
+      Message_Count      : integer := 0;
+      TC_AR1_is_complete : Boolean := false;
+   begin
+      loop
+         select
+            accept Input do
+               -- Perform the computations required for this message
+               null;    -- stub
+            end Input;
+            Message_Count := Message_Count + 1;
+         or
+            -- Guard until the rendezvous with the message for this task
+            -- has completed
+            when Message_Count > 0 =>
+            accept TC_Artificial_Rendezvous_1;    -- see comments in
+                                                  -- Credit_Computation above
+            TC_AR1_is_complete := true; 
+         or
+            -- Completion rendezvous with the main procedure
+            when TC_AR1_is_complete =>
+            accept TC_Artificial_Rendezvous_2;
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Debit_Computation");
+
+
+   end Debit_Computation;
+
+
+begin -- c954010
+   Report.Test ("C954010", "Requeue in an accept body does not block");
+
+   Line_Driver.Start;
+
+   -- Ensure that both messages were delivered to the computation tasks
+   -- This shows that both requeues were effective.
+   -- 
+   Debit_Computation.TC_Artificial_Rendezvous_2;
+
+   -- Ensure that the message tasks completed
+   while (TC_Tasks_Completed.Count < TC_Expected_To_Complete) loop
+      delay ImpDef.Minimum_Task_Switch;   
+   end loop;
+
+   Report.Result;
+
+end C954010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954011.a
new file mode 100644
index 000000000..159b32dba
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954011.a
@@ -0,0 +1,384 @@
+-- C954011.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 requeue is placed on the correct entry; that the 
+--      original caller waits for the completion of the requeued rendezvous;
+--      that the original caller continues after the rendezvous.
+--      Specifically, this test checks requeue to an entry in a different
+--      task, requeue where the entry has parameters, and requeue with
+--      abort.
+--
+-- TEST DESCRIPTION:
+--      In the Distributor task, requeue two successive calls on the entries
+--      of two separate target tasks.  Each task in each of the  paths adds 
+--      identifying information in the transaction being passed.  This
+--      information is checked by the Message tasks on completion ensuring that
+--      the requeues have been placed on the correct queues.
+--
+--      This series of tests uses a simulation of a transaction driven 
+--      processing system.  Line Drivers accept input from an external source
+--      and build them into transaction records.  These records are then 
+--      encapsulated in message tasks which remain extant for the life of the
+--      transaction in the system. The message tasks put themselves on the 
+--      input queue of a Distributor which, from information in the 
+--      transaction and/or system load conditions forwards them to other 
+--      operating tasks. These in turn might forward the transactions to yet 
+--      other tasks for further action.  The routing is, in real life, 
+--      dynamic and unpredictable at the time of message generation. All 
+--      rerouting in this  model is done by means of requeues.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      26 Nov 95   SAIC    Fixed problems with shared global variables
+--                          for ACVC 2.0.1
+--
+--!
+
+with Report;
+with ImpDef;
+         
+procedure C954011 is
+ 
+
+   -- Arbitrary test values
+   Credit_Return : constant := 1;
+   Debit_Return  : constant := 2;
+
+   type Transaction_Code is (Credit, Debit);
+
+   type Transaction_Record;
+   type acc_Transaction_Record is access Transaction_Record;
+   type Transaction_Record is 
+      record
+         ID               : integer := 0;
+         Code             : Transaction_Code := Debit;
+         Account_Number   : integer := 0;
+         Stock_Number     : integer := 0;
+         Quantity         : integer := 0;
+         Return_Value     : integer := 0;
+         TC_Message_Count : integer := 0;  
+         TC_Thru_Distrib  : Boolean := false;
+      end record;
+
+   protected type Message_Mgr is
+      procedure Mark_Complete;
+      function Is_Complete return Boolean;
+   private
+      Complete : Boolean := False;
+   end Message_Mgr;
+
+   protected body Message_Mgr is
+      procedure Mark_Complete is
+      begin
+         Complete := True;
+      end Mark_Complete;
+
+      Function Is_Complete return Boolean is
+      begin
+         return Complete;
+      end Is_Complete;
+   end Message_Mgr;
+
+   TC_Debit_Message  : Message_Mgr;
+   TC_Credit_Message : Message_Mgr;
+
+
+   task type Message_Task is 
+      entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+   end Message_Task;
+   type acc_Message_Task is access Message_Task;
+
+   task Line_Driver is 
+      entry Start;
+   end Line_Driver;   
+
+   task Distributor is 
+      entry Input(Transaction : acc_Transaction_Record);
+   end Distributor;
+
+   task Credit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Computation;
+
+   task Debit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Debit_Computation;
+
+
+
+   -- Assemble messages received from an external source
+   --   Creates a message task for each. The message tasks remain extant
+   --   for the life of the messages in the system.
+   --      The Line Driver task would normally be designed to loop continuously
+   --      creating the messages as input is received.  Simulate this 
+   --      but limit it to two dummy messages for this test and allow it
+   --      to terminate at that point
+   --
+   task body Line_Driver is
+      Current_ID : integer := 1;
+      TC_Last_was_for_credit : Boolean := false;
+
+      procedure Build_Credit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 100;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Credit; 
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Credit_Record;     
+
+
+      procedure Build_Debit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 200;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Debit; 
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Debit_Record;     
+
+   begin
+
+      accept Start;      -- Wait for trigger from Main
+
+      for i in 1..2 loop  -- arbitrarily limit to two messages for the test
+         declare 
+            -- Create a task for the next message
+            Next_Message_Task : acc_Message_Task := new Message_Task;
+            -- Create a record for it
+            Next_Transaction : acc_Transaction_Record 
+                                                 := new Transaction_Record;
+         begin
+            if TC_Last_was_for_credit then
+               Build_Debit_Record ( Next_Transaction );            
+            else
+               Build_Credit_Record( Next_Transaction );
+               TC_Last_was_for_credit := true;
+            end if;
+            Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+         end;   -- declare
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Line_Driver");
+   end Line_Driver;
+
+   
+
+
+   task body Message_Task is
+
+      TC_Original_Transaction_Code : Transaction_Code;  
+      This_Transaction : acc_Transaction_Record := new Transaction_Record;
+
+   begin
+      accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+         This_Transaction.all := In_Transaction.all;
+      end Accept_Transaction;
+
+      -- Note the original code to ensure correct return
+      TC_Original_Transaction_Code := This_Transaction.Code;
+ 
+      -- Queue up on Distributor's Input queue
+      Distributor.Input ( This_Transaction );
+      -- This task will now wait for the requeued rendezvous 
+      -- to complete before proceeding
+
+      -- After the required computations have been performed
+      -- return the Transaction_Record appropriately (probably to an output
+      -- line driver)
+      null;            -- stub
+
+      
+      -- The following is all Test Control Code
+
+      -- Check that the return values are as expected
+      if TC_Original_Transaction_Code /= This_Transaction.Code then
+         -- Incorrect rendezvous
+         Report.Failed ("Message Task: Incorrect code returned");
+      end if;
+
+      if This_Transaction.Code = Credit then
+         if This_Transaction.Return_Value     /= Credit_Return or   
+            This_Transaction.TC_Message_Count /= 1             or not
+            This_Transaction.TC_Thru_Distrib     then
+               Report.Failed ("Expected path not traversed");
+         end if;
+         TC_Credit_Message.Mark_Complete;
+      else
+         if This_Transaction.Return_Value     /= Debit_Return or   
+            This_Transaction.TC_Message_Count /= 1             or not
+            This_Transaction.TC_Thru_Distrib      then
+               Report.Failed ("Expected path not traversed");
+         end if;
+         TC_Debit_Message.Mark_Complete;
+      end if;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Message_Task");
+
+   end Message_Task;
+
+
+
+   -- Dispose each input Transaction_Record to the appropriate
+   -- computation tasks
+   --
+   task body Distributor is
+
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Mark the message as having passed through the distributor
+               Transaction.TC_Thru_Distrib := true;
+
+               -- Pass this transaction on the appropriate computation
+               -- task
+               case Transaction.Code is 
+                  when Credit =>
+                     requeue Credit_Computation.Input with abort;
+                  when Debit => 
+                     requeue Debit_Computation.Input with abort;
+               end case;
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Distributor");
+   end Distributor;
+                                          
+
+
+   -- Computation task.
+   --   Note:  After the computation is performed in this task and the 
+   --          accept body is completed the rendezvous in the original
+   --          message task is completed.                              
+   --                                           
+   task body Credit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select 
+            accept Input ( Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this transaction
+               null;      -- stub
+
+               -- For the test: 
+               if not Transaction.TC_Thru_Distrib then
+                  Report.Failed 
+                         ("Credit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Credit then
+                  Report.Failed
+                         ("Credit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Credit_Return;
+               -- one, and only one message should pass through
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+            end Input;            
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Computation");
+   end Credit_Computation;
+
+
+
+   -- Computation task.
+   --   Note:  After the computation is performed in this task and the 
+   --          accept body is completed the rendezvous in the original
+   --          message task is completed.                              
+   --                                                
+   task body Debit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this message
+               null;      -- stub
+
+               -- For the test: 
+               if not Transaction.TC_Thru_Distrib then
+                  Report.Failed 
+                         ("Debit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Debit then
+                  Report.Failed
+                         ("Debit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Debit_Return;
+               -- one, and only one, message should pass through
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+            end Input;            
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Debit_Computation");
+
+
+   end Debit_Computation;
+
+
+begin -- c954011
+
+   Report.Test ("C954011", "Requeue from task body to task entry");
+
+   Line_Driver.Start;        -- Start the test
+
+   -- Ensure that the message tasks complete before reporting the result
+   while not (TC_Credit_Message.Is_Complete and 
+              TC_Debit_Message.Is_Complete) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+   Report.Result;
+
+end C954011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954012.a
new file mode 100644
index 000000000..44575b1b1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954012.a
@@ -0,0 +1,496 @@
+-- C954012.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 a requeue within an accept body to another entry in the same task
+--     Specifically, check a call with parameters and a requeue with abort.
+--
+-- TEST DESCRIPTION:
+--      One transaction is sent through to check the paths. After
+--      processing this the Credit task sets the "overloaded" indicator.  Once
+--      this indicator is set the Distributor queues low priority transactions
+--      on a Wait_for_Underload queue in the same task using a requeue.  The
+--      Distributor still delivers high priority transactions.  After two high
+--      priority transactions have been processed by the Credit task it clears
+--      the overload condition.  The low priority transactions should now be
+--      delivered.
+--
+--      This series of tests uses a simulation of a transaction driven
+--      processing system.  Line Drivers accept input from an external source
+--      and build them into transaction records.  These records are then
+--      encapsulated in message tasks which remain extant for the life of the
+--      transaction in the system.  The message tasks put themselves on the
+--      input queue of a Distributor which, from information in the
+--      transaction and/or system load conditions forwards them to other
+--      operating tasks. These in turn might forward the transactions to yet
+--      other tasks for further action.  The routing is, in real life, dynamic
+--      and unpredictable at the time of message generation.  All rerouting in
+--      this  model is done by means of requeues.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Nov 95   SAIC    Fixed shared global variable problem for
+--                          ACVC 2.0.1
+--      14 Mar 03   RLB     Fixed a race condition and an incorrect termination
+--                          condition in the test.
+--!
+
+with Report;
+with ImpDef;
+with Ada.Calendar;
+
+procedure C954012 is
+
+   function "=" (X,Y: Ada.Calendar.Time) return Boolean
+                                                   renames Ada.Calendar."=";
+
+   -- Arbitrary test values
+   Credit_Return : constant := 1;
+   Debit_Return  : constant := 2;
+
+
+   -- This is used as an "initializing" time for the messages as they are
+   -- created.  As they pass through the Distributor they get a time_stamp
+   -- of the current time. An arbitrary base time is chosen.
+   --    TC: this fact is used, incidentally, to check that the messages have,
+   --    indeed, passed through the Distributor as expected.
+   --
+   Base_Time : Ada.Calendar.Time := Ada.Calendar.Time_of(1959,3,9);
+
+
+   -- Mechanism to count the number of Credit Message tasks completed
+   protected TC_Tasks_Completed is
+      procedure Increment;
+      function  Count return integer;
+   private
+      Number_Complete : integer := 0;
+   end TC_Tasks_Completed;
+
+   protected type Shared_Boolean (Initial_Value : Boolean := False) is
+      procedure Set_True;
+      procedure Set_False;
+      function  Value return Boolean;
+   private
+      Current_Value : Boolean := Initial_Value;
+   end Shared_Boolean;
+
+   protected body Shared_Boolean is
+      procedure Set_True is
+      begin
+         Current_Value := True;
+      end Set_True;
+
+      procedure Set_False is
+      begin
+         Current_Value := False;
+      end Set_False;
+
+      function Value return Boolean is
+      begin
+         return Current_Value;
+      end Value;
+   end Shared_Boolean;
+
+   TC_Debit_Message_Complete    : Shared_Boolean (False);
+   -- Handshaking mechanism between the Line Driver and the Credit task
+   TC_First_Message_Has_Arrived : Shared_Boolean (False);
+   Credit_Overloaded : Shared_Boolean (False);
+
+   TC_Credit_Messages_Expected  : constant integer := 5;
+
+   type Transaction_Code is (Credit, Debit);
+   type Transaction_Priority is (High, Low);
+
+   type Transaction_Record;
+   type acc_Transaction_Record is access Transaction_Record;
+   type Transaction_Record is
+      record
+         ID               : integer := 0;
+         Code             : Transaction_Code := Debit;
+         Priority         : Transaction_Priority := High;
+         Account_Number   : integer := 0;
+         Stock_Number     : integer := 0;
+         Quantity         : integer := 0;
+         Return_Value     : integer := 0;
+         Message_Count    : integer := 0;          -- for test
+         Time_Stamp       : Ada.Calendar.Time := Base_Time;
+      end record;
+
+
+   task type Message_Task is
+      entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+   end Message_Task;
+   type acc_Message_Task is access Message_Task;
+
+   task Line_Driver is
+      entry Start;
+   end Line_Driver;
+
+   task Distributor is
+      entry Input (Transaction : acc_Transaction_Record);
+      entry Wait_for_Underload (Transaction : acc_Transaction_Record);
+      entry TC_Credit_OK;
+   end Distributor;
+
+   task Credit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Computation;
+
+   task Debit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Debit_Computation;
+
+
+   -- Mechanism to count the number of Message tasks completed (Credit)
+   protected body TC_Tasks_Completed is
+      procedure Increment is
+      begin
+         Number_Complete := Number_Complete + 1;
+      end Increment;
+
+      function Count return integer is
+      begin
+         return Number_Complete;
+      end Count;
+   end TC_Tasks_Completed;
+
+
+   -- Assemble messages received from an external source
+   --   Creates a message task for each. The message tasks remain extant
+   --   for the life of the messages in the system.
+   --      The Line Driver task would normally be designed to loop continuously
+   --      creating the messages as input is received.  Simulate this
+   --      but limit it to the required number of dummy messages needed for
+   --      this test and allow it to terminate at that point.  Artificially
+   --      alternate High and Low priority Credit transactions for this test.
+   --
+   task body Line_Driver is
+      Current_ID       : integer := 1;
+      Current_Priority : Transaction_Priority := High;
+
+      -- Artificial: number of messages required for this test
+      type TC_Trans_Range is range 1..6;
+
+      procedure Build_Credit_Record
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 100;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Credit;
+            Next_Transaction.Priority := Current_Priority;
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Credit_Record;
+
+
+      procedure Build_Debit_Record
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 200;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Debit;
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Debit_Record;
+
+   begin
+
+      accept Start;   -- Wait for trigger from Main
+
+      for Transaction_Numb in TC_Trans_Range loop  -- TC: limit the loop
+         declare
+            -- Create a task for the next message
+            Next_Message_Task : acc_Message_Task := new Message_Task;
+            -- Create a record for it
+            Next_Transaction : acc_Transaction_Record
+                                                 := new Transaction_Record;
+         begin
+            if Transaction_Numb = TC_Trans_Range'first then
+               -- Send the first Credit message
+               Build_Credit_Record ( Next_Transaction );
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );
+               -- TC: Wait until the first message has been received by the
+               -- Credit task and it has set the Overload indicator for the
+               -- Distributor
+               while not TC_First_Message_Has_Arrived.Value loop
+                  delay ImpDef.Minimum_Task_Switch;
+               end loop;
+            elsif Transaction_Numb = TC_Trans_Range'last then
+               -- For this test send the last transaction to the Debit task
+               -- to improve the mix
+               Build_Debit_Record( Next_Transaction );
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );
+            else
+               -- TC: Alternate high and low priority transactions
+               if Current_Priority = High then
+                  Current_Priority := Low;
+               else
+                  Current_Priority := High;
+               end if;
+               Build_Credit_Record( Next_Transaction );
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );
+            end if;
+         end;   -- declare
+      end loop;
+
+      -- TC: Wait for Credit_Overloaded to be cleared, then insure that the
+      -- Distributor has evalated all tasks. Otherwise, some tasks may never
+      -- be evaluated.
+      while Credit_Overloaded.Value loop
+        delay ImpDef.Minimum_Task_Switch;
+      end loop;
+      Distributor.TC_Credit_OK;
+
+   exception
+      when others =>
+         Report.Failed ("Unexpected exception in Line_Driver");
+   end Line_Driver;
+
+
+
+
+   task body Message_Task is
+
+      TC_Original_Transaction_Code : Transaction_Code;
+      This_Transaction : acc_Transaction_Record := new Transaction_Record;
+
+   begin
+
+      accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+         This_Transaction.all := In_Transaction.all;
+      end Accept_Transaction;
+
+      -- Note the original code to ensure correct return
+      TC_Original_Transaction_Code := This_Transaction.Code;
+
+      -- Queue up on Distributor's Input queue
+      Distributor.Input ( This_Transaction );
+      -- This task will now wait for the requeued rendezvous
+      -- to complete before proceeding
+
+      -- After the required computations have been performed
+      -- return the Transaction_Record appropriately (probably to an output
+      -- line driver)
+      null;            -- stub
+
+      -- For the test check that the return values are as expected
+      if TC_Original_Transaction_Code /= This_Transaction.Code then
+         -- Incorrect rendezvous
+         Report.Failed ("Message Task: Incorrect code returned");
+      end if;
+
+      if This_Transaction.Code = Credit then
+         if This_Transaction.Return_Value  /= Credit_Return or
+            This_Transaction.Time_Stamp     = Base_Time     then
+               Report.Failed ("Expected path not traversed");
+         end if;
+            TC_Tasks_Completed.Increment;
+      else
+         if This_Transaction.Return_Value  /= Debit_Return or
+            This_Transaction.Message_Count /= 1             or
+            This_Transaction.Time_Stamp     = Base_Time     then
+               Report.Failed ("Expected path not traversed");
+         end if;
+         TC_Debit_Message_Complete.Set_True;
+      end if;
+
+   exception
+      when others =>
+         Report.Failed ("Unexpected exception in Message_Task");
+
+   end Message_Task;
+
+
+
+
+   -- Dispose each input Transaction_Record to the appropriate
+   -- computation tasks
+   --
+   task body Distributor is
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Time_Stamp the messages with the current time
+               --    TC: Used, incidentally, by the test to check that the
+               --    message did pass through the Distributor Task
+               Transaction.Time_Stamp := Ada.Calendar.Clock;
+
+               -- Pass this transaction on to the appropriate computation
+               -- task but temporarily hold low-priority transactions under
+               -- overload conditions
+               case Transaction.Code is
+                  when Credit =>
+                     if Credit_Overloaded.Value and
+                        Transaction.Priority = Low then
+                        requeue Wait_for_Underload with abort;
+                     else
+                        requeue Credit_Computation.Input with abort;
+                     end if;
+                  when Debit =>
+                     requeue Debit_Computation.Input with abort;
+               end case;
+            end Input;
+         or
+            when not Credit_Overloaded.Value =>
+            accept Wait_for_Underload (Transaction : acc_Transaction_Record) do
+               requeue Credit_Computation.Input with abort;
+            end Wait_for_Underload;
+         or
+            accept TC_Credit_OK;
+               -- We need this to insure that we evaluate the guards at least
+               -- once when Credit_Overloaded is False. Otherwise, tasks
+               -- could stay queued on Wait_for_Underload forever (starvation).
+         or
+            terminate;
+         end select;
+      end loop;
+
+   exception
+      when others =>
+         Report.Failed ("Unexpected exception in Distributor");
+   end Distributor;
+
+
+
+   -- Computation task.  After the computation is performed the rendezvous
+   -- in the original message task is completed.
+   --
+   task body Credit_Computation is
+
+      Message_Count   : integer := 0;
+
+   begin
+      loop
+         select
+            accept Input ( Transaction : acc_Transaction_Record) do
+               if Credit_Overloaded.Value and
+                  Transaction.Priority = Low then
+                  -- We should not be getting any Low Priority messages. They
+                  -- should be waiting on the Distributor's Wait_for_Underload
+                  -- queue
+                  Report.Failed
+                     ("Credit Task: Low priority transaction during overload");
+               end if;
+               -- Perform the computations required for this transaction
+               null; -- stub
+
+               -- For the test:
+               if Transaction.Time_Stamp = Base_Time then
+                  Report.Failed
+                         ("Credit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Credit then
+                  Report.Failed
+                         ("Credit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- The following is all Test Control code:
+               Transaction.Return_Value := Credit_Return;
+               Message_Count := Message_Count + 1;
+               --
+               -- Now take special action depending on which Message
+               if Message_Count = 1 then
+                  -- After the first message :
+                  Credit_Overloaded.Set_True;
+                  -- Now flag the Line_Driver that the second and subsequent
+                  -- messages may now be sent
+                  TC_First_Message_Has_Arrived.Set_True;
+               end if;
+               if Message_Count = 3 then
+                  -- The two high priority transactions created subsequent
+                  -- to the overload have now been processed
+                  Credit_Overloaded.Set_False;
+               end if;
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others =>
+         Report.Failed ("Unexpected exception in Credit_Computation");
+   end Credit_Computation;
+
+
+
+   -- Computation task.  After the computation is performed the rendezvous
+   -- in the original message task is completed.
+   --
+   task body Debit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this message
+               null;      -- stub
+
+               -- For the test:
+               if Transaction.Time_Stamp = Base_Time then
+                  Report.Failed
+                         ("Debit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Debit then
+                  Report.Failed
+                         ("Debit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Debit_Return;
+               -- one, and only one, message should pass through
+               Message_Count := Message_Count + 1;
+               Transaction.Message_Count := Message_Count;
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others =>
+         Report.Failed ("Unexpected exception in Debit_Computation");
+
+
+   end Debit_Computation;
+
+
+begin -- c954012
+   Report.Test ("C954012", "Requeue within an accept body" &
+                           " to another entry in the same task");
+
+   Line_Driver.Start;  -- Start the test
+
+   -- Ensure that the message tasks complete before reporting the result
+   while (TC_Tasks_Completed.Count < TC_Credit_Messages_Expected)
+         or (not TC_Debit_Message_Complete.Value) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+   Report.Result;
+
+end C954012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954013.a
new file mode 100644
index 000000000..70ea3f559
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954013.a
@@ -0,0 +1,521 @@
+-- C954013.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 requeue is cancelled and that the requeuing task is
+--      unaffected when the calling task is aborted. 
+--      Specifically, check requeue to an entry in a different task,
+--      requeue where the entry has parameters, and requeue with abort.
+--
+-- TEST DESCRIPTION:
+--      Abort a task that has a call requeued to the entry queue of another
+--      task.  We do this by sending two messages to the Distributor which 
+--      requeues them to the Credit task.  In the accept body of the Credit 
+--      task we wait for the second message to arrive then check that an 
+--      abort of the second message task does result in the requeue being 
+--      removed.  The Line Driver task which generates the messages and the 
+--      Credit task communicate artificially in this test to arrange for the 
+--      proper timing of the messages and the abort.  One extra message is 
+--      sent to the Debit task to ensure that the Distributor is still viable
+--      and has been unaffected by the abort.
+--
+--      This series of tests uses a simulation of a transaction driven 
+--      processing system.  Line Drivers accept input from an external source
+--      and build them into transaction records.  These records are then 
+--      encapsulated in message tasks which remain extant for the life of the
+--      transaction in the system.  The message tasks put themselves on the 
+--      input queue of a Distributor which, from information in the 
+--      transaction and/or system load conditions forwards them to other 
+--      operating tasks. These in turn might forward the transactions to yet 
+--      other tasks for further action.  The routing is, in real life, dynamic
+--      and unpredictable at the time of message generation.  All rerouting in
+--      this  model is done by means of requeues.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Nov 95   SAIC    Fixed shared global variable problems for
+--                          ACVC 2.0.1
+--
+--!
+
+with Report;
+with ImpDef;
+         
+procedure C954013 is
+ 
+
+   -- Arbitrary test values
+   Credit_Return : constant := 1;
+   Debit_Return  : constant := 2;
+
+
+   protected type Shared_Boolean (Initial_Value : Boolean := False) is
+      procedure Set_True;
+      procedure Set_False;
+      function  Value return Boolean;
+   private
+      Current_Value : Boolean := Initial_Value;
+   end Shared_Boolean;
+
+   protected body Shared_Boolean is
+      procedure Set_True is
+      begin
+         Current_Value := True;
+      end Set_True;
+
+      procedure Set_False is
+      begin
+         Current_Value := False;
+      end Set_False;
+
+      function Value return Boolean is
+      begin
+         return Current_Value;
+      end Value;
+   end Shared_Boolean;
+ 
+
+   TC_Debit_Message_Complete  : Shared_Boolean (False);
+   TC_Credit_Message_Complete : Shared_Boolean (False);
+
+
+   type Transaction_Code is (Credit, Debit);
+
+   type Transaction_Record;
+   type acc_Transaction_Record is access Transaction_Record;
+   type Transaction_Record is 
+      record
+         ID               : integer := 0;
+         Code             : Transaction_Code := Debit;
+         Account_Number   : integer := 0;
+         Stock_Number     : integer := 0;
+         Quantity         : integer := 0;
+         Return_Value     : integer := 0;
+         TC_Message_Count : integer := 0;
+         TC_Thru_Dist     : Boolean := false;
+      end record;
+
+   
+   task type Message_Task is 
+      entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+   end Message_Task;
+   type acc_Message_Task is access Message_Task;
+
+   task Line_Driver is
+      entry Start;   
+   end Line_Driver;
+
+   task Distributor is 
+      entry Input(Transaction : acc_Transaction_Record);
+   end Distributor;
+
+   task Credit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Computation;
+
+   task Debit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Debit_Computation;
+
+   -- This protected object is here for Test Control purposes only
+   protected TC_Prt is 
+      procedure Set_First_Has_Arrived;
+      procedure Set_Second_Has_Arrived;
+      procedure Set_Abort_Has_Completed;
+      function  First_Has_Arrived   return Boolean;
+      function  Second_Has_Arrived  return Boolean;
+      function  Abort_Has_Completed return Boolean;
+   private 
+      First_Flag, Second_Flag, Abort_Flag : Boolean := false;
+   end TC_Prt;
+
+   protected body TC_Prt is
+
+      Procedure Set_First_Has_Arrived is
+      begin
+         First_Flag := true;
+      end Set_First_Has_Arrived;
+
+      Procedure Set_Second_Has_Arrived is
+      begin
+         Second_Flag := true;
+      end Set_Second_Has_Arrived;
+
+      Procedure Set_Abort_Has_Completed is
+      begin
+         Abort_Flag := true;
+      end Set_Abort_Has_Completed;
+   
+      Function First_Has_Arrived return boolean is
+      begin
+         return First_Flag;
+      end First_Has_Arrived;
+
+      Function Second_Has_Arrived return boolean is
+      begin
+         return Second_Flag;
+      end Second_has_Arrived;
+
+      Function Abort_Has_Completed return boolean is
+      begin
+         return Abort_Flag;
+      end Abort_Has_Completed;
+   
+   end TC_PRT;
+
+   -- Assemble messages received from an external source
+   --   Creates a message task for each. The message tasks remain extant
+   --   for the life of the messages in the system.
+   --      TC: The Line Driver task would normally be designed to loop
+   --      continuously creating the messages as input is received.  Simulate
+   --      this  but limit it to three dummy messages for this test and use
+   --      special artificial checks to pace the messages out under controlled
+   --      conditions for the test; allow it to terminate at the end
+   --
+   task body Line_Driver is
+      Current_ID : integer := 1;
+      TC_First_message_sent: Boolean := false;
+
+      procedure Build_Credit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 100;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Credit; 
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Credit_Record;     
+
+
+      procedure Build_Debit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 200;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Debit; 
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Debit_Record;     
+
+   begin
+      
+      accept Start;       -- Wait for trigger from main
+
+      for i in 1..3 loop  -- TC: arbitrarily limit to two credit messages
+                          --     and one debit, then complete
+         declare 
+            -- Create a task for the next message
+            Next_Message_Task : acc_Message_Task := new Message_Task;
+            -- Create a record for it
+            Next_Transaction : acc_Transaction_Record :=
+                                                       new Transaction_Record;
+         begin
+            if not TC_First_Message_Sent then
+               -- send out the first message to start up the Credit task
+               Build_Credit_Record ( Next_Transaction );            
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+               TC_First_Message_Sent := true;
+            elsif not TC_Prt.Abort_Has_Completed then
+               -- We have not yet processed the second message
+               -- Wait to send the second message until we know the first
+               -- has arrived at the Credit task and that task is in the 
+               -- accept body 
+               while not TC_Prt.First_Has_Arrived loop
+                  delay ImpDef.Minimum_Task_Switch;   
+               end loop;
+
+               -- We can now send the second message
+               Build_Credit_Record( Next_Transaction );
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+               
+               -- Now wait for the second to arrive on the Credit input queue
+               while not TC_Prt.Second_Has_Arrived loop
+                  delay ImpDef.Minimum_Task_Switch;   
+               end loop;
+               
+               -- At this point: The Credit task is in the accept block 
+               -- dealing with the first message and the second message is
+               -- is on the input queue
+               abort Next_Message_Task.all;  -- Note: we are still in the 
+                                             -- declare block for the 
+                                             -- second message task
+
+               -- Make absolutely certain that all the actions
+               -- associated with the abort have been completed, that the
+               -- task has gone from Abnormal right through to
+               -- Termination.  All requeues that are to going to be
+               -- cancelled will have been by the point of Termination.
+               while not Next_Message_Task.all'terminated loop
+                  delay ImpDef.Minimum_Task_Switch;   
+               end loop;
+
+
+               -- We now signal the Credit task that the abort has taken place
+               -- so that it can check that the entry queue is empty as the
+               -- requeue should have been cancelled
+               TC_Prt.Set_Abort_Has_Completed;
+            else
+               -- The main part of the test is complete. Send one Debit message
+               -- as further exercise of the Distributor to ensure it has not
+               -- been affected by the cancellation of the requeue.
+               Build_Debit_Record ( Next_Transaction );            
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+            end if;
+         end;   -- declare
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Line_Driver");
+   end Line_Driver;
+
+   
+
+
+   task body Message_Task is
+
+      TC_Original_Transaction_Code : Transaction_Code;  
+      This_Transaction : acc_Transaction_Record := new Transaction_Record;
+
+   begin
+      
+      accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+         This_Transaction.all := In_Transaction.all;
+      end Accept_Transaction;      
+
+      -- Note the original code to ensure correct return
+      TC_Original_Transaction_Code := This_Transaction.Code;
+                                                                  
+      -- Queue up on Distributor's Input queue
+      Distributor.Input ( This_Transaction );
+      -- This task will now wait for the requeued rendezvous 
+      -- to complete before proceeding
+                                             
+      -- After the required computations have been performed
+      -- return the Transaction_Record appropriately (probably to an output
+      -- line driver)
+      null;            -- stub
+      
+      -- For the test check that the return values are as expected
+      if TC_Original_Transaction_Code /= This_Transaction.Code then
+         -- Incorrect rendezvous
+         Report.Failed ("Message Task: Incorrect code returned");
+      end if;
+
+      if This_Transaction.Code = Credit then
+         if This_Transaction.Return_Value     /= Credit_Return or   
+            This_Transaction.TC_Message_Count /= 1             or not
+            This_Transaction.TC_Thru_Dist                      then 
+               Report.Failed ("Expected path not traversed");
+         end if;
+         TC_Credit_Message_Complete.Set_True;
+      else
+         if This_Transaction.Return_Value     /= Debit_Return  or   
+            This_Transaction.TC_Message_Count /= 1             or not
+            This_Transaction.TC_Thru_Dist                      then 
+               Report.Failed ("Expected path not traversed");
+         end if;
+         TC_Debit_Message_Complete.Set_True;
+      end if;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Message_Task");
+
+   end Message_Task;
+
+
+
+   -- Dispose each input Transaction_Record to the appropriate
+   -- computation tasks
+   --
+   task body Distributor is
+
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Show that this message did pass through the Distributor Task
+               Transaction.TC_Thru_Dist := true;
+
+               -- Pass this transaction on the appropriate computation
+               -- task
+               case Transaction.Code is 
+                  when Credit =>
+                     requeue Credit_Computation.Input with abort;
+                  when Debit => 
+                     requeue Debit_Computation.Input with abort;
+               end case;
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Distributor");
+   end Distributor;
+                                          
+
+
+   -- Computation task.
+   --   Note:  After the computation is performed in this task and the 
+   --          accept body is completed the rendezvous in the original
+   --          message task is completed.                              
+   task body Credit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select 
+            accept Input ( Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this transaction
+               --
+               null;     -- stub
+
+               -- The rest of this code is for Test Control
+               --
+               if not Transaction.TC_Thru_Dist then 
+                  Report.Failed 
+                         ("Credit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Credit then
+                  Report.Failed
+                         ("Credit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Credit_Return;
+               -- one, and only one message should pass through
+               if Message_Count /= 0 then
+                  Report.Failed ("Aborted Requeue was not cancelled -1");
+               end if;
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+         
+               
+               -- Having done the basic housekeeping we now need to signal
+               -- that we are in the accept body of the credit task.  The
+               -- first message has arrived and the Line Driver may now send
+               -- the second one
+               TC_Prt.Set_First_Has_Arrived;
+
+               -- Now wait for the second to arrive
+
+               while Input'Count = 0 loop
+                  delay ImpDef.Minimum_Task_Switch;   
+               end loop;
+               -- Second message has been requeued - the Line driver may 
+               -- now abort the calling task
+               TC_Prt.Set_Second_Has_Arrived;
+
+               -- Now wait for the Line Driver to signal that the abort of
+               -- the first task is complete - the requeue should be cancelled
+               -- at this time
+               while not TC_Prt.Abort_Has_Completed loop
+                  delay ImpDef.Minimum_Task_Switch;   
+               end loop;
+               
+               if Input'Count /=0 then
+                  Report.Failed ("Aborted Requeue was not cancelled -2");
+               end if;
+               -- We can now complete the rendezvous with the first caller
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Computation");
+   end Credit_Computation;
+
+
+
+   -- Computation task.
+   --   Note:  After the computation is performed in this task and the 
+   --          accept body is completed the rendezvous in the original
+   --          message task is completed.                              
+   task body Debit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this message
+               --
+               null;      -- stub
+
+               -- The rest of this code is for Test Control
+               --
+               if not Transaction.TC_Thru_Dist then 
+                  Report.Failed 
+                         ("Debit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Debit then
+                  Report.Failed
+                         ("Debit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Debit_Return;
+               -- one, and only one, message should pass through
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+            end Input;            
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Debit_Computation");
+
+
+   end Debit_Computation;
+
+
+begin -- c954013
+
+   Report.Test ("C954013", "Abort a task that has a call requeued");
+
+   Line_Driver.Start;   -- start the test
+
+   -- Wait for the message tasks to complete before calling Report.Result.
+   -- Although two Credit tasks are generated one is aborted so only
+   -- one completes, thus a single flag is sufficient
+   -- Note: the test will hang here if there is a problem with the 
+   -- completion of the tasks
+   while not (TC_Credit_Message_Complete.Value and 
+              TC_Debit_Message_Complete.Value) loop
+      delay ImpDef.Minimum_Task_Switch;   
+   end loop;
+
+   Report.Result;
+
+end C954013;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954014.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954014.a
new file mode 100644
index 000000000..53e45a090
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954014.a
@@ -0,0 +1,485 @@
+-- C954014.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 requeue is not canceled and that the requeueing 
+--     task is unaffected when a calling task is aborted. Check that the
+--     abort is deferred until the entry call is complete.
+--     Specifically, check requeue to an entry in a different task,
+--     requeue where the entry call has parameters, and requeue
+--     without the abort option.
+--
+-- TEST DESCRIPTION
+--     In the Driver create a task that places a call on the
+--     Distributor.  In the Distributor requeue this call on the Credit task.
+--     Abort the calling task when it is known to be in rendezvous with the
+--     Credit task. (We arrange this by using artificial synchronization
+--     points in the Driver and the accept body of the Credit task) Ensure
+--     that the abort is deferred (the task is not terminated) until the
+--     accept body completes.   Afterwards, send one extra message through
+--     the Distributor to check that the requeueing task has not been
+--     disrupted. 
+--
+--     This series of tests uses a simulation of a transaction driven
+--     processing system.  Line Drivers accept input from an external source
+--     and build them into transaction records.  These records are then
+--     encapsulated in message tasks which remain extant for the life of the
+--     transaction in the system.  The message tasks put themselves on the
+--     input queue of a Distributor which, from information in the
+--     transaction and/or system load conditions forwards them to other
+--     operating tasks. These in turn might forward the transactions to yet
+--     other tasks for further action.  The routing is, in real life, dynamic
+--     and unpredictable at the time of message generation.  All rerouting in
+--     this  model is done by means of requeues.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Nov 95   SAIC    Replaced global variables with protected objects
+--                          for ACVC 2.0.1.
+--
+--!
+
+with Report;
+with ImpDef;
+         
+procedure C954014 is
+ 
+   -- Arbitrary test values
+   Credit_Return : constant := 1;
+   Debit_Return  : constant := 2;
+
+
+   protected type Shared_Boolean (Initial_Value : Boolean := False) is
+      procedure Set_True;
+      procedure Set_False;
+      function  Value return Boolean;
+   private
+      Current_Value : Boolean := Initial_Value;
+   end Shared_Boolean;
+
+   protected body Shared_Boolean is
+      procedure Set_True is
+      begin
+         Current_Value := True;
+      end Set_True;
+
+      procedure Set_False is
+      begin
+         Current_Value := False;
+      end Set_False;
+
+      function Value return Boolean is
+      begin
+         return Current_Value;
+      end Value;
+   end Shared_Boolean;
+ 
+
+   TC_Debit_Message_Complete  : Shared_Boolean (False);
+   
+   -- Synchronization flags for handshaking between the Line_Driver
+   -- and the Accept body in the Credit Task
+   TC_Handshake_A : Shared_Boolean (False);
+   TC_Handshake_B : Shared_Boolean (False);
+   TC_Handshake_C : Shared_Boolean (False);
+   TC_Handshake_D : Shared_Boolean (False);
+   TC_Handshake_E : Shared_Boolean (False);
+   TC_Handshake_F : Shared_Boolean (False);
+
+
+   type Transaction_Code is (Credit, Debit);
+
+   type Transaction_Record;
+   type acc_Transaction_Record is access Transaction_Record;
+   type Transaction_Record is 
+      record
+         ID               : integer := 0;
+         Code             : Transaction_Code := Debit;
+         Account_Number   : integer := 0;
+         Stock_Number     : integer := 0;
+         Quantity         : integer := 0;
+         Return_Value     : integer := 0;
+         TC_Message_Count : integer := 0; 
+         TC_Thru_Distrib  : Boolean;
+      end record;
+
+   
+   task type Message_Task is 
+      entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+   end Message_Task;
+   type acc_Message_Task is access Message_Task;
+
+   task Line_Driver is
+      entry start;
+   end Line_Driver;   
+
+   task Distributor is 
+      entry Input(Transaction : acc_Transaction_Record);
+   end Distributor;
+
+   task Credit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Computation;
+
+   task Debit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Debit_Computation;
+
+
+   -- Assemble messages received from an external source
+   --   Creates a message task for each. The message tasks remain extant
+   --   for the life of the messages in the system.
+   --      TC: The Line Driver task would normally be designed to loop
+   --      continuously creating the messages as input is received.  Simulate
+   --      this  but limit it to two dummy messages for this test and use
+   --      special artificial handshaking checks with the Credit accept body
+   --      to control the test. Allow it to terminate at the end
+   --
+   task body Line_Driver is
+      Current_ID : integer := 1;
+      TC_First_message_sent: Boolean := false;
+
+      procedure Build_Credit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 100;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Credit; 
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Credit_Record;     
+
+
+      procedure Build_Debit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 200;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Debit; 
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Debit_Record;     
+
+   begin
+   
+      accept Start;       -- Wait for trigger from main
+
+      for i in 1..2 loop  -- TC: arbitrarily limit to one credit message
+                          --     and one debit, then complete
+         declare 
+            -- Create a task for the next message
+            Next_Message_Task : acc_Message_Task := new Message_Task;
+            -- Create a record for it
+            Next_Transaction : acc_Transaction_Record := 
+                                                   new Transaction_Record;
+         begin
+            if not TC_First_Message_Sent then
+               -- send out the first message which will be aborted
+               Build_Credit_Record ( Next_Transaction );            
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+               TC_First_Message_Sent := true;
+
+               -- Wait for Credit task to get into the accept body
+               --   The call from the Message Task has been requeued by
+               --   the distributor
+               while not TC_Handshake_A.Value loop
+                  delay ImpDef.Minimum_Task_Switch;
+               end loop;
+
+               -- Abort the calling task; the Credit task is guaranteed to 
+               -- be in the accept body
+               abort Next_Message_Task.all;     -- We are still in this declare
+                                                -- block
+              
+               -- Inform the Credit task that the abort has been initiated
+               TC_Handshake_B.Set_True;
+               
+               -- Now wait for the "acknowledgment" from the Credit task
+               -- this ensures a complete task switch (at least) 
+               while not TC_Handshake_C.Value loop
+                  delay ImpDef.Minimum_Task_Switch;
+               end loop;
+
+               -- The aborted task must not terminate till the accept body
+               -- has completed
+               if Next_Message_Task'terminated then
+                  Report.Failed ("The abort was not deferred");
+               end if;
+
+               -- Inform the Credit task that the termination has been checked
+               TC_Handshake_D.Set_True;
+               
+               -- Now wait for the completion of the accept body in the 
+               -- Credit task
+               while not TC_Handshake_E.Value loop
+                  delay ImpDef.Minimum_Task_Switch;
+               end loop;
+               
+               while not ( Next_Message_Task'terminated ) loop
+                  delay ImpDef.Minimum_Task_Switch;
+               end loop;
+
+               -- Indicate to the Main program that this section is complete
+               TC_Handshake_F.Set_True;
+
+            else
+               -- The main part of the test is complete. Send one Debit message
+               -- as further exercise of the Distributor to ensure it has not
+               -- been affected by the abort of the requeue;
+               Build_Debit_Record ( Next_Transaction );            
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+            end if;
+         end;   -- declare
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Line_Driver");
+   end Line_Driver;
+
+   
+
+   task body Message_Task is
+
+      TC_Original_Transaction_Code : Transaction_Code;  
+      This_Transaction : acc_Transaction_Record := new Transaction_Record;
+
+   begin
+      
+      accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+         This_Transaction.all := In_Transaction.all;
+      end Accept_Transaction;      
+
+      -- Note the original code to ensure correct return
+      TC_Original_Transaction_Code := This_Transaction.Code;
+                                                                  
+      -- Queue up on Distributor's Input queue
+      Distributor.Input ( This_Transaction );
+      -- This task will now wait for the requeued rendezvous 
+      -- to complete before proceeding
+                                             
+      -- After the required computations have been performed
+      -- return the Transaction_Record appropriately (probably to an output
+      -- line driver)
+      null;            -- stub
+      
+      -- For the test check that the return values are as expected
+      if TC_Original_Transaction_Code /= This_Transaction.Code then
+         -- Incorrect rendezvous
+         Report.Failed ("Message Task: Incorrect code returned");
+      end if;
+
+      if This_Transaction.Code = Credit then
+         -- The only Credit message was the one that should have been aborted
+         Report.Failed ("Abort was not effective");
+      else
+         if This_Transaction.Return_Value     /= Debit_Return or   
+            This_Transaction.TC_Message_Count /= 1            or not
+            This_Transaction.TC_Thru_Distrib       then
+               Report.Failed ("Expected path not traversed");
+         end if;
+         TC_Debit_Message_Complete.Set_True;
+      end if;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Message_Task");
+
+   end Message_Task;
+
+
+
+   -- Dispose each input Transaction_Record to the appropriate 
+   -- computation tasks
+   --
+   task body Distributor is
+
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+
+               -- Indicate that the  message did pass through the
+               -- Distributor Task
+               Transaction.TC_Thru_Distrib := true;
+
+               -- Pass this transaction on the appropriate computation
+               -- task
+               case Transaction.Code is 
+                  when Credit =>
+                     requeue Credit_Computation.Input;   -- without abort
+                  when Debit => 
+                     requeue Debit_Computation.Input;    -- without abort
+               end case;
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Distributor");
+   end Distributor;
+                                          
+
+
+   -- Computation task.
+   --   Note:  After the computation is performed in this task and the 
+   --          accept body is completed the rendezvous in the original
+   --          message task is completed.                              
+   task body Credit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select 
+            accept Input ( Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this transaction
+               --
+               null;     -- stub
+
+               -- The rest of this code is for Test Control
+               --
+               if not Transaction.TC_Thru_Distrib then
+                  Report.Failed 
+                         ("Credit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Credit then
+                  Report.Failed
+                         ("Credit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Credit_Return;
+               -- one, and only one message should pass through
+               if Message_Count /= 0 then
+                  Report.Failed ("Aborted Requeue was not canceled -1");
+               end if;
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+                        
+               -- Having done the basic housekeeping we now need to signal
+               -- that we are in the accept body of the credit task.  The
+               -- message has arrived and the Line Driver may now abort the
+               -- calling task
+               TC_Handshake_A.Set_True;
+
+               -- Now wait for the Line Driver to inform us the calling 
+               -- task has been aborted
+               while not TC_Handshake_B.Value loop
+                  delay ImpDef.Minimum_Task_Switch;
+               end loop;
+
+               -- The abort has taken place
+               -- Inform the Line Driver that we are still running in the
+               -- accept body
+               TC_Handshake_C.Set_True;
+
+               -- Now wait for the Line Driver to digest this information
+               while not TC_Handshake_D.Value loop
+                  delay ImpDef.Minimum_Task_Switch;
+               end loop;
+
+               -- The Line driver has checked that the caller is not terminated
+               -- We can now complete the accept
+               
+            end Input;
+            -- We are out of the accept
+            TC_Handshake_E.Set_True; 
+                   
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Computation");
+   end Credit_Computation;
+
+
+
+   -- Computation task.
+   --   Note:  After the computation is performed in this task and the 
+   --          accept body is completed the rendezvous in the original
+   --          message task is completed.                              
+   task body Debit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this message
+               --
+               null;      -- stub
+
+               -- The rest of this code is for Test Control
+               --
+               if not Transaction.TC_Thru_Distrib then
+                  Report.Failed 
+                         ("Debit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Debit then
+                  Report.Failed
+                         ("Debit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Debit_Return;
+               -- one, and only one, message should pass through
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+            end Input;            
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Debit_Computation");
+
+
+   end Debit_Computation;
+
+
+begin -- c954014
+   Report.Test ("C954014", "Abort a task that has a call" &
+                                          " requeued_without_abort");
+
+   Line_Driver.Start;   -- Start the test
+
+   -- Wait for the message tasks to complete before reporting the result
+   --
+   while not (TC_Handshake_F.Value                  -- abort not effective?
+              and TC_Debit_Message_Complete.Value   -- Distributor affected?
+              and TC_Handshake_E.Value ) loop       -- accept not completed?
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+   Report.Result;
+
+end C954014;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954015.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954015.a
new file mode 100644
index 000000000..c86e1078e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954015.a
@@ -0,0 +1,549 @@
+-- C954015.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 requeued calls to task entries may, in turn, be requeued.  
+--      Check that the intermediate requeues are not blocked and that the
+--      original caller remains blocked until the last requeue is complete.
+--         This test uses: 
+--                      Call with parameters
+--                      Requeue with abort
+--      
+-- TEST DESCRIPTION
+--      A call is placed on the input queue of the Distributor.  The
+--      Distributor requeues to the Credit task; the Credit task requeues to a
+--      secondary task which, in turn requeues to yet another task.  This
+--      continues down the chain.  At the furthest point of the chain the
+--      rendezvous is completed.  To verify the action, the furthest task
+--      waits in the accept statement for a second message to arrive before
+--      completing.  This second message can only arrive if none of the earlier
+--      tasks in the chain are blocked waiting for completion.   Apart from
+--      the two Credit messages which are used to check the requeue chain one
+--      Debit message is sent to validate the mix.
+--
+--                                                    
+--      This series of tests uses a simulation of a transaction driven
+--      processing system.  Line Drivers accept input from an external source
+--      and build them into transaction records.  These records are then
+--      encapsulated in message tasks which remain extant for the life of the
+--      transaction in the system.  The message tasks put themselves on the
+--      input queue of a Distributor which, from information in the
+--      transaction and/or system load conditions forwards them to other
+--      operating tasks. These in turn might forward the transactions to yet
+--      other tasks for further action.  The routing is, in real life, dynamic
+--      and unpredictable at the time of message generation.  All rerouting in
+--      this  model is done by means of requeues.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+with Report;
+with ImpDef;
+         
+procedure C954015 is
+ 
+   -- Arbitrary test values
+   Credit_Return : constant := 1;
+   Debit_Return  : constant := 2;
+
+   -- Mechanism to count the number of Credit Message tasks completed
+   protected TC_Tasks_Completed is
+      procedure Increment;
+      function  Count return integer;
+   private
+      Number_Complete : integer := 0;
+   end TC_Tasks_Completed;
+   
+   TC_Expected_To_Complete   : constant integer := 3;
+
+
+   -- Values added to the Return_Value indicating passage through the
+   -- particular task
+   TC_Credit_Value :  constant integer := 1;
+   TC_Sub_1_Value  :  constant integer := 2;
+   TC_Sub_2_Value  :  constant integer := 3;
+   TC_Sub_3_Value  :  constant integer := 4;
+   TC_Sub_4_Value  :  constant integer := 5;
+   --
+   TC_Full_Value   :  integer := TC_Credit_Value + TC_Sub_1_Value + 
+                                 TC_Sub_2_Value  + TC_Sub_3_Value +
+                                 TC_Sub_4_Value;
+
+   type Transaction_Code is (Credit, Debit);
+
+   type Transaction_Record;
+   type acc_Transaction_Record is access Transaction_Record;
+   type Transaction_Record is 
+      record
+         ID               : integer := 0;
+         Code             : Transaction_Code := Debit;
+         Account_Number   : integer := 0;
+         Stock_Number     : integer := 0;
+         Quantity         : integer := 0;
+         Return_Value     : integer := 0;
+         TC_Message_Count : integer := 0;
+         TC_Thru_Distrib  : Boolean := false;
+      end record;
+
+
+   task type Message_Task is 
+      entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+   end Message_Task;
+   type acc_Message_Task is access Message_Task;
+
+   task Line_Driver is
+      entry Start;
+   end Line_Driver;   
+
+   task Distributor is 
+      entry Input(Transaction : acc_Transaction_Record);
+   end Distributor;
+
+   task Credit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Computation;
+
+   task Debit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Debit_Computation;
+
+   -- The following are almost identical for the purpose of the test
+   task Credit_Sub_1 is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Sub_1;
+   --
+   task Credit_Sub_2 is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Sub_2;
+   --
+   task Credit_Sub_3 is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Sub_3;
+
+   -- This is the last in the chain
+   task Credit_Sub_4 is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Sub_4;
+  
+   
+   -- Mechanism to count the number of Message tasks completed (Credit)
+   protected body TC_Tasks_Completed is
+      procedure Increment is
+      begin
+         Number_Complete := Number_Complete + 1;
+      end Increment;
+
+      function Count return integer is
+      begin
+         return Number_Complete;
+      end Count;
+   end TC_Tasks_Completed;
+
+
+
+   -- Assemble messages received from an external source
+   --   Creates a message task for each. The message tasks remain extant
+   --   for the life of the messages in the system.
+   --      The Line Driver task would normally be designed to loop continuously
+   --      creating the messages as input is received.  Simulate this 
+   --      but limit it to the number of dummy messages needed for this 
+   --      test and allow it to terminate at that point. 
+   --
+   task body Line_Driver is
+      Current_ID : integer := 1;
+      TC_Last_was_for_credit : Boolean := false;
+
+       -- Arbitrary limit for the number of messages sent for this test
+      type TC_Trans_Range is range 1..3;
+
+      procedure Build_Credit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 100;
+      begin
+         Next_Transaction.ID := Current_ID;
+         Next_Transaction.Code := Credit; 
+         Next_Transaction.Account_Number := Dummy_Account;
+         Current_ID := Current_ID + 1;
+      end Build_Credit_Record;     
+
+      procedure Build_Debit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 200;
+      begin
+         Next_Transaction.ID := Current_ID;
+         Next_Transaction.Code := Debit; 
+         Next_Transaction.Account_Number := Dummy_Account;
+         Current_ID := Current_ID + 1;
+      end Build_Debit_Record;     
+
+
+   begin
+
+      accept Start;   -- wait for trigger from Main
+      
+      -- Arbitrarily limit the loop to the number needed for this test only
+      for Transaction_Numb in TC_Trans_Range  loop
+         declare 
+            -- Create a task for the next message
+            Next_Message_Task : acc_Message_Task := new Message_Task;
+            -- Create a record for it
+            Next_Transaction : acc_Transaction_Record := 
+                                                new Transaction_Record;
+         begin
+            -- Artificially send out in the order required
+            case Transaction_Numb is
+               when 1 => 
+                  Build_Credit_Record( Next_Transaction );
+               when 2 =>
+                  Build_Credit_Record( Next_Transaction );
+               when 3 =>
+                  Build_Debit_Record ( Next_Transaction );            
+            end case;
+
+            -- Present the record to the message task
+            Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+         end;   -- declare
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Line_Driver");
+   end Line_Driver;
+
+
+
+   task body Message_Task is
+
+      TC_Original_Transaction_Code : Transaction_Code;  
+      This_Transaction : acc_Transaction_Record := new Transaction_Record;
+
+   begin
+      
+      accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+         This_Transaction.all := In_Transaction.all;
+      end Accept_Transaction;
+
+      -- Note the original code to ensure correct return
+      TC_Original_Transaction_Code := This_Transaction.Code;
+ 
+      -- Queue up on Distributor's Input queue
+      Distributor.Input ( This_Transaction );
+      -- This task will now wait for the requeued rendezvous 
+      -- to complete before proceeding
+
+      -- After the required computations have been performed
+      -- return the Transaction_Record appropriately (probably to an output
+      -- line driver)
+      null;            -- stub
+
+      
+      -- The following is all Test Control Code
+
+      -- Check that the return values are as expected
+      if TC_Original_Transaction_Code /= This_Transaction.Code then
+         -- Incorrect rendezvous
+         Report.Failed ("Message Task: Incorrect code returned");
+      end if;
+
+      if This_Transaction.Code = Credit then
+         if This_Transaction.Return_Value  /= TC_Full_Value or not  
+            This_Transaction.TC_Thru_Distrib       then
+               Report.Failed ("Expected path not traversed - CR");
+         end if;
+         if 
+            This_Transaction.TC_Message_Count not in 1..2 then
+               Report.Failed ("Incorrect Message Count");
+         end if;
+      else
+         if This_Transaction.Return_Value  /= Debit_Return or   
+            This_Transaction.TC_Message_Count /= 1            or not
+            This_Transaction.TC_Thru_Distrib     then
+               Report.Failed ("Expected path not traversed - DB");
+         end if;
+      end if;
+      TC_Tasks_Completed.Increment;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Message_Task");
+
+   end Message_Task;
+
+
+
+   -- Dispose each input Transaction_Record to the appropriate 
+   -- computation tasks
+   --
+   task body Distributor is
+
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Show that the message did pass through the Distributor Task
+               Transaction.TC_Thru_Distrib := true;
+
+               -- Pass this transaction on to the appropriate computation
+               -- task
+               case Transaction.Code is 
+                  when Credit =>
+                     requeue Credit_Computation.Input with abort;
+                  when Debit => 
+                     requeue Debit_Computation.Input with abort;
+               end case;
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Distributor");
+   end Distributor;
+                                          
+
+
+                                                
+   -- Computation task.
+   --   Note:  After the computation is performed in this task the message is
+   --   passed on for further processing to some subsidiary task.  The choice
+   --   of subsidiary task is made according to criteria not specified in
+   --   this test.  
+   --                                           
+   task body Credit_Computation is
+      Message_Count   : integer := 0;   
+   begin
+      loop
+         select 
+            accept Input ( Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this transaction
+               null;      -- stub
+
+               -- For the test: 
+               if not Transaction.TC_Thru_Distrib then
+                  Report.Failed 
+                         ("Credit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Credit then
+                  Report.Failed
+                         ("Credit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test, plug a known value and count
+               Transaction.Return_Value := TC_Credit_Value;
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+
+               -- Depending on transaction content send it on to the
+               -- some other task for further processing
+               -- TC: Arbitrarily send the message on to Credit_Sub_1
+               requeue Credit_Sub_1.Input with abort;
+            end Input;            
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Computation");
+   end Credit_Computation;
+
+
+
+   task body Credit_Sub_1 is
+   begin
+      loop
+         select
+            accept Input(Transaction : acc_Transaction_Record) do
+               -- Process this transaction
+               null;   -- stub
+            
+               -- Add the value showing passage through this task
+               Transaction.Return_Value := 
+                                    Transaction.Return_Value + TC_Sub_1_Value;
+               -- Depending on transaction content send it on to the
+               -- some other task for further processing
+               -- Arbitrarily send the message on to Credit_Sub_2
+               requeue Credit_Sub_2.Input with abort;  
+            end Input;
+         or 
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Sub_1");
+
+   end Credit_Sub_1;
+
+   task body Credit_Sub_2 is
+   begin
+      loop
+         select
+            accept Input(Transaction : acc_Transaction_Record) do
+               -- Process this transaction
+               null;   -- stub
+            
+               -- Add the value showing passage through this task
+               Transaction.Return_Value := 
+                                    Transaction.Return_Value + TC_Sub_2_Value;
+               -- Depending on transaction content send it on to the
+               -- some other task for further processing
+               -- Arbitrarily send the message on to Credit_Sub_3
+               requeue Credit_Sub_3.Input with abort;  
+            end Input;
+         or 
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Sub_2");
+   end Credit_Sub_2;
+
+   task body Credit_Sub_3 is
+   begin
+      loop
+         select
+            accept Input(Transaction : acc_Transaction_Record) do
+               -- Process this transaction
+               null;   -- stub
+            
+               -- Add the value showing passage through this task
+               Transaction.Return_Value := 
+                                    Transaction.Return_Value + TC_Sub_3_Value;
+               -- Depending on transaction content send it on to the
+               -- some other task for further processing
+               -- Arbitrarily send the message on to Credit_Sub_4
+               requeue Credit_Sub_4.Input with abort;  
+            end Input;
+         or 
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Sub_3");
+   end Credit_Sub_3;
+
+   -- This is the last in the chain of tasks to which transactions will
+   -- be requeued
+   --
+   task body Credit_Sub_4 is
+   
+      TC_First_Message : Boolean := true;
+
+   begin
+      loop
+         select
+            accept Input(Transaction : acc_Transaction_Record) do
+               -- Process this transaction
+               null;   -- stub
+            
+               -- Add the value showing passage through this task
+               Transaction.Return_Value := 
+                                    Transaction.Return_Value + TC_Sub_4_Value;
+               -- TC: stay in the accept body dealing with the first message
+               -- until the second arrives.  If any of the requeues are 
+               -- blocked the test will hang here indicating failure
+               if TC_First_Message then
+                  while Input'count = 0 loop
+                     delay ImpDef.Minimum_Task_Switch;
+                  end loop;
+               TC_First_Message := false;
+               end if;
+               -- for the second message, just complete the rendezvous
+            end Input;
+         or 
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Sub_4");
+   end Credit_Sub_4;
+
+
+                                                
+   -- Computation task.
+   --   Note:  After the computation is performed in this task and the 
+   --          accept body is completed the rendezvous in the original
+   --          message task is completed.                              
+   --                                                
+   task body Debit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this message
+               null;      -- stub
+
+               -- For the test: 
+               if not Transaction.TC_Thru_Distrib then
+                  Report.Failed 
+                         ("Debit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Debit then
+                  Report.Failed
+                         ("Debit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Debit_Return;
+               -- one, and only one, message should pass through
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+            end Input;            
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Debit_Computation");
+
+
+   end Debit_Computation;
+
+
+begin 
+
+   Report.Test ("C954015", "Test multiple levels of requeue to task entry");
+
+   Line_Driver.Start;  -- Start the test
+
+   -- Ensure that the message tasks completed before calling Result
+   while (TC_Tasks_Completed.Count < TC_Expected_To_Complete) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+   Report.Result;
+
+end C954015;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954016.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954016.a
new file mode 100644
index 000000000..1390801ee
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954016.a
@@ -0,0 +1,182 @@
+-- C954016.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 when a task that is called by a requeue is aborted, the 
+--      original caller receives Tasking_Error and the requeuing task is 
+--      unaffected.
+--
+-- TEST DESCRIPTION:
+--      The Intermediate task requeues a call from the Original_Caller to the
+--      Receiver.  While the Receiver is in the accept body for this
+--      rendezvous the Main aborts it.  Check that Tasking_Error is raised in
+--      the Original_Caller, that the Receiver does, indeed, get aborted and
+--      the Intermediate task is undisturbed.
+--      There are several delay loops in this test any one of which could 
+--      cause it to hang which would constitute failure.  
+--      
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Nov 95   SAIC    Replaced shared global variable with protected
+--                          object for ACVC 2.0.1
+--
+--!
+
+with Report;
+with ImpDef;
+
+procedure C954016 is
+
+   TC_Original_Caller_Complete  : Boolean := false;
+   TC_Intermediate_Complete     : Boolean := false;
+
+
+   protected type Shared_Boolean (Initial_Value : Boolean := False) is
+      procedure Set_True;
+      procedure Set_False;
+      function  Value return Boolean;
+   private
+      Current_Value : Boolean := Initial_Value;
+   end Shared_Boolean;
+
+   protected body Shared_Boolean is
+      procedure Set_True is
+      begin
+         Current_Value := True;
+      end Set_True;
+
+      procedure Set_False is
+      begin
+         Current_Value := False;
+      end Set_False;
+
+      function Value return Boolean is
+      begin
+         return Current_Value;
+      end Value;
+   end Shared_Boolean;
+ 
+   TC_Receiver_in_Accept        : Shared_Boolean (False);
+
+
+   task Original_Caller is
+      entry Start;
+   end Original_Caller;
+
+   task Intermediate is
+      entry Input;
+      entry TC_Abort_Process_Complete;
+   end Intermediate;
+   
+   task Receiver is
+      entry Input;
+      entry TC_Never_Called;
+   end Receiver;
+
+   
+   task body Original_Caller is
+   begin 
+      accept Start;    -- wait for the trigger from Main
+
+      Intermediate.Input;
+      Report.Failed ("Tasking_Error not raised in Original_Caller task");
+
+   exception
+      when tasking_error => 
+               TC_Original_Caller_Complete := true;     -- expected behavior
+      when others        => 
+               Report.Failed ("Unexpected Exception in Original_Caller task");
+   end Original_Caller;
+   
+   
+   task body Intermediate is
+   begin
+      accept Input do
+         -- Within this accept call another task
+         requeue Receiver.Input with abort;
+      end Input;
+
+      -- Wait for Main to ensure that the abort housekeeping is finished
+      accept TC_Abort_Process_Complete;
+
+      TC_Intermediate_Complete := true;
+
+   exception
+      when others => 
+                Report.Failed ("Unexpected exception in Intermediate task");
+   end Intermediate;
+
+
+   task body Receiver is
+   begin
+      accept Input do
+         TC_Receiver_in_Accept.Set_True;
+         -- Hang within the accept body to allow Main to abort this task
+         accept TC_Never_Called;  
+      end Input;
+   exception
+      when others  =>
+            Report.Failed ("Unexpected Exception in Receiver Task");
+                                                          
+   end Receiver;
+   
+   
+begin
+   Report.Test ("C954016", "Requeue: abort the called task");
+
+   Original_Caller.Start;
+
+   -- Wait till the rendezvous with Receiver is started
+   while not TC_Receiver_in_Accept.Value loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+   -- At this point the Receiver is guaranteed to be in its accept
+   --
+   abort Receiver;
+
+   -- Wait for the whole of the abort process to complete
+   while not ( Original_Caller'terminated and Receiver'terminated ) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+   -- Inform the Intermediate task that the process is complete to allow
+   -- it to continue to completion itself
+   Intermediate.TC_Abort_Process_Complete;
+
+   -- Wait for everything to settle before reporting the result
+   while not ( Intermediate'terminated ) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+
+   if not ( TC_Original_Caller_Complete and TC_Intermediate_Complete ) then
+      Report.Failed ("Proper paths not traversed");
+   end if;
+
+   Report.Result;
+
+end C954016;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954017.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954017.a
new file mode 100644
index 000000000..a5447a756
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954017.a
@@ -0,0 +1,184 @@
+-- C954017.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 when an exception is raised in the rendezvous of a task 
+--      that was called by a requeue the exception is propagated to the 
+--      original caller and that the requeuing task is unaffected.  
+--
+-- TEST DESCRIPTION:
+--      The Intermediate task requeues a call from the Original_Caller to the
+--      Receiver.  While the Receiver is in the accept body for this
+--      rendezvous a Constraint_Error exception is raised.  Check that the 
+--      exception is propagated to the Original_Caller, that the Receiver's 
+--      normal exception logic is employed and that the Intermediate task
+--      is undisturbed.
+--      There are several delay loops in this test any one of which could 
+--      cause it to hang (and thus fail).
+--      
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Nov 95   SAIC    Fixed shared global variable problem for
+--                          ACVC 2.0.1
+--
+--!
+
+with Report;
+with ImpDef;
+
+
+procedure C954017 is
+
+   TC_Original_Caller_Complete   : Boolean := false;
+   TC_Intermediate_Complete      : Boolean := false;
+   TC_Receiver_Complete          : Boolean := false;
+   TC_Exception                  : Exception;
+
+
+   protected type Shared_Boolean (Initial_Value : Boolean := False) is
+      procedure Set_True;
+      procedure Set_False;
+      function  Value return Boolean;
+   private
+      Current_Value : Boolean := Initial_Value;
+   end Shared_Boolean;
+
+   protected body Shared_Boolean is
+      procedure Set_True is
+      begin
+         Current_Value := True;
+      end Set_True;
+
+      procedure Set_False is
+      begin
+         Current_Value := False;
+      end Set_False;
+
+      function Value return Boolean is
+      begin
+         return Current_Value;
+      end Value;
+   end Shared_Boolean;
+ 
+   TC_Exception_Process_Complete : Shared_Boolean (False);
+
+   task Original_Caller is
+      entry Start;
+   end Original_Caller;
+
+   task Intermediate is
+      entry Input;
+   end Intermediate;
+   
+   task Receiver is
+      entry Input;
+   end Receiver;
+
+   
+   task body Original_Caller is
+   begin 
+      accept Start;    -- wait for the trigger from Main
+
+      Intermediate.Input;
+      Report.Failed ("Exception not propagated to Original_Caller");
+
+   exception
+      when TC_Exception => 
+               TC_Original_Caller_Complete := true;     -- Expected behavior
+      when others        => 
+               Report.Failed ("Unexpected Exception in Original_Caller task");
+   end Original_Caller;
+   
+   
+   task body Intermediate is
+   begin
+      accept Input do
+         -- Within this accept call another task
+         requeue Receiver.Input with abort;
+      end Input;
+
+      -- Wait for Main to ensure that the exception housekeeping is finished
+      while not TC_Exception_Process_Complete.Value loop
+         delay ImpDef.Minimum_Task_Switch;
+      end loop;
+
+      TC_Intermediate_Complete := true;
+
+   exception
+      when others => 
+                  Report.Failed ("Unexpected exception in Intermediate task");
+   end Intermediate;
+
+
+   task body Receiver is
+   --
+   begin
+      accept Input do
+         null;  -- the user code for the rendezvous is stubbed out
+
+         -- Test Control: Raise an exception in the destination task which
+         -- should then be propagated
+         raise TC_Exception;
+
+      end Input;
+   exception
+      when TC_Exception =>
+            TC_Receiver_Complete := true;  -- expected behavior
+      when others        =>
+            Report.Failed ("Unexpected Exception in Receiver Task");
+   end Receiver;
+   
+   
+begin
+
+   Report.Test ("C954017", "Requeue: exception processing");
+
+   Original_Caller.Start;   -- Start the test after the Report.Test
+   
+   -- Wait for the whole of the exception process to complete
+   while not ( Original_Caller'terminated and Receiver'terminated ) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+   -- Inform the Intermediate task that the process is complete to allow
+   -- it to continue to completion itself
+   TC_Exception_Process_Complete.Set_True;
+
+   -- Wait for everything to settle before reporting the result
+   while not ( Intermediate'terminated ) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+
+   if not ( TC_Original_Caller_Complete and 
+            TC_Intermediate_Complete    and
+            TC_Receiver_Complete)       then
+      Report.Failed ("Proper paths not traversed");
+   end if;
+
+   Report.Result;
+
+end C954017;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954018.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954018.a
new file mode 100644
index 000000000..a9da1e06b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954018.a
@@ -0,0 +1,227 @@
+-- C954018.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 task is aborted while a requeued call is queued 
+--      on one of its entries the original caller receives Tasking_Error
+--      and the requeuing task is unaffected.
+--         This test uses: Requeue to an entry in a different task
+--                         Parameterless call
+--                         Requeue with abort
+--
+-- TEST DESCRIPTION:
+--      The Intermediate task requeues a call from the Original_Caller to the
+--      Receiver on an entry with a guard that is always false.  While the 
+--      Original_Caller is still queued the Receiver is aborted.
+--      Check that Tasking_Error is raised in the Original_Caller, that the 
+--      Receiver does, indeed, get aborted and the Intermediate task 
+--      is undisturbed.
+--      There are several delay loops in this test any one of which could 
+--      cause it to hang and thus indicate failure.  
+--      
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+with Report;
+with ImpDef;
+
+
+procedure C954018 is
+
+
+   -- Protected object to control the shared test variables
+   --
+   protected TC_State is
+      function  On_Entry_Queue return Boolean;
+      procedure Set_On_Entry_Queue; 
+      function  Original_Caller_Complete return Boolean;
+      procedure Set_Original_Caller_Complete;
+      function  Intermediate_Complete return Boolean;
+      procedure Set_Intermediate_Complete;
+   private
+      On_Entry_Queue_Flag           : Boolean := false;
+      Original_Caller_Complete_Flag : Boolean := false;
+      Intermediate_Complete_Flag    : Boolean := false;
+   end TC_State;
+   --
+   --
+   protected body TC_State is
+      function On_Entry_Queue return Boolean is
+      begin 
+         return On_Entry_Queue_Flag;
+      end On_Entry_Queue;
+      
+      procedure Set_On_Entry_Queue is
+      begin
+         On_Entry_Queue_Flag := true; 
+      end Set_On_Entry_Queue; 
+
+      function Original_Caller_Complete return Boolean is
+      begin
+         return Original_Caller_Complete_Flag;
+      end Original_Caller_Complete;
+
+      procedure Set_Original_Caller_Complete is
+      begin
+         Original_Caller_Complete_Flag := true;
+      end Set_Original_Caller_Complete;
+
+      function Intermediate_Complete return Boolean is
+      begin
+         return Intermediate_Complete_Flag;
+      end Intermediate_Complete;
+
+      procedure Set_Intermediate_Complete is
+      begin
+         Intermediate_Complete_Flag := true;
+      end Set_Intermediate_Complete;
+
+   end TC_State;
+
+   --================================
+
+   task Original_Caller is
+      entry Start;
+   end Original_Caller;
+
+   task Intermediate is
+      entry Input;
+      entry TC_Abort_Process_Complete;
+   end Intermediate;
+   
+   task Receiver is
+      entry Input;
+   end Receiver;
+
+   
+   task body Original_Caller is
+   begin 
+      accept Start;    -- wait for the trigger from Main
+
+      Intermediate.Input;
+      Report.Failed ("Tasking_Error not raised in Original_Caller task");
+
+   exception
+      when tasking_error => 
+               TC_State.Set_Original_Caller_Complete; -- expected behavior
+      when others        => 
+               Report.Failed ("Unexpected Exception in Original_Caller task");
+   end Original_Caller;
+   
+   
+   task body Intermediate is
+   begin
+      accept Input do
+         -- Within this accept call another task
+         TC_State.Set_On_Entry_Queue;
+         requeue Receiver.Input with abort;  
+         Report.Failed ("Requeue did not complete the Accept");
+      end Input;
+
+      -- Wait for Main to ensure that the abort housekeeping is finished
+      accept TC_Abort_Process_Complete;
+
+      TC_State.Set_Intermediate_Complete;
+
+   exception
+      when others => 
+              Report.Failed ("Unexpected exception in Intermediate task");
+   end Intermediate;
+
+
+   task body Receiver is
+   begin
+      loop
+         select
+            -- A call to Input will be placed on the queue and never serviced
+            when Report.Equal (1,2) =>     -- Always false
+            accept Input do
+               Report.Failed ("Receiver in Accept");  
+            end Input;
+         or 
+            delay ImpDef.Minimum_Task_Switch;
+         end select;
+      end loop;
+   exception
+      when others =>
+            Report.Failed ("Unexpected Exception in Receiver Task");
+                                                          
+   end Receiver;
+   
+   
+begin
+
+   Report.Test ("C954018", "Requeue: abort the called task" &
+                           " while Caller is still queued");
+
+   Original_Caller.Start;
+
+
+   -- This is the main part of the test  
+
+   -- Wait for the requeue
+   while not TC_State.On_Entry_Queue loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+   -- Delay long enough to ensure that the requeue has "arrived" on 
+   -- the entry queue.  Note: TC_State.Set_On_Entry_Queue is called the
+   -- statement before the requeue
+   --
+   delay ImpDef.Switch_To_New_Task;
+
+   -- At this point the Receiver is guaranteed to have the requeue on
+   -- the entry queue
+   --
+   abort Receiver;
+   
+   -- Wait for the whole of the abort process to complete
+   while not ( Original_Caller'terminated and Receiver'terminated ) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+
+   -- Inform the Intermediate task that the process is complete to allow
+   -- it to continue to completion itself
+   Intermediate.TC_Abort_Process_Complete;
+
+   -- Wait for everything to settle before reporting the result
+   while not ( Intermediate'terminated ) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+   
+
+   if not ( TC_State.Original_Caller_Complete and 
+            TC_State.Intermediate_Complete )       then
+      Report.Failed ("Proper paths not traversed");
+   end if;
+
+   Report.Result;
+
+end C954018;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954019.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954019.a
new file mode 100644
index 000000000..fafc6aa59
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954019.a
@@ -0,0 +1,314 @@
+-- C954019.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 when a requeue is to the same entry the items go to the
+--      right queue and that they are placed back on the end of the queue.
+--
+-- TEST DESCRIPTION:
+--      Simulate part of a message handling application where the messages are
+--      composed of several segments.  The sequence of the segments within the
+--      message is specified by Seg_Sequence_No.   The segments are handled by
+--      different tasks  and finally forwarded to an output driver.  The
+--      segments can arrive in any order but must be assembled into the proper
+--      sequence for final output.  There is a Sequencer task interposed
+--      before the Driver.  This takes the segments of the message off the
+--      Ordering_Queue and those that are in the right order it sends on to
+--      the driver; those that are out of order it places back on the end of
+--      the queue.
+--
+--      The test just simulates the arrival of the segments at the Sequencer.
+--      The task generating the segments handshakes with the Sequencer during
+--      the  "Await Arrival" phase  ensuring that the three segments of a
+--      message arrive in REVERSE order (the End-of-Message segment arrives
+--      first and the Header last).  In the first cycle the sequencer pulls
+--      segments off the queue and puts them back on the end till it
+--      encounters the header.  It checks the sequence of the ones it pulls
+--      off in case the segments are being put back on in the wrong part of
+--      the queue. Having cycled once through it no longer verifies the
+--      sequence - it just executes the "application" code for the correct
+--      order for dispatch to the driver.
+-- 
+--      In this simple example no attempt is made to address segments of
+--      another message arriving or any other error conditions (such as
+--      missing segments, timing etc.)
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Dec 94   SAIC    Remove parameter from requeue statement
+--
+--!
+
+with Report;
+with ImpDef;
+
+procedure C954019 is
+begin
+
+
+   Report.Test ("C954019", "Check Requeue to the same Accept");
+   
+   declare  -- encapsulate the test
+
+      type Segment_Sequence is range 1..8;
+      Header : constant Segment_Sequence := Segment_Sequence'first;
+
+      type Message_Segment is record
+         ID              : integer;            -- Message ID
+         Seg_Sequence_No : Segment_Sequence;   -- Within the message
+         Alpha           : string (1..128);
+         EOM             : Boolean := false;   -- true for final msg segment
+      end record;
+      type acc_Message_Segment is access Message_Segment;
+
+      task TC_Simulate_Arrival;
+   
+      task type Carrier_Task is
+         entry Input ( Segment : acc_Message_Segment );
+      end Carrier_Task;
+      type acc_Carrier_Task is access Carrier_Task;
+   
+      task Sequencer is
+         entry Ordering_Queue ( Segment : acc_Message_Segment );
+         entry TC_Handshake_1;
+         entry TC_Handshake_2;
+      end Sequencer;
+   
+      task Output_Driver is
+         entry Input ( Segment : acc_Message_Segment );
+      end Output_Driver;
+   
+
+      -- Simulate the arrival of three message segments in REVERSE order
+      --
+      task body TC_Simulate_Arrival is
+         begin
+
+            for i in 1..3 loop
+               declare
+                  -- Create a task for the next message segment
+                  Next_Segment_Task : acc_Carrier_Task := new Carrier_Task;
+                  -- Create a record for the next segment
+                  Next_Segment : acc_Message_Segment := new Message_Segment;
+               begin
+                  if i = 1 then 
+                     -- Build the EOM segment as the first to "send"
+                     Next_Segment.Seg_Sequence_No := Header + 2;
+                     Next_Segment.EOM := true;
+                  elsif i = 2 then
+                     -- Wait for the first segment to arrive at the Sequencer
+                     -- before "sending" the second
+                     Sequencer.TC_Handshake_1;
+                     -- Build the segment
+                     Next_Segment.Seg_Sequence_No := Header + 1;
+                  else 
+                     -- Wait for the second segment to arrive at the Sequencer
+                     -- before "sending" the third
+                     Sequencer.TC_Handshake_2;
+                     -- Build the segment. The last segment in order to 
+                     -- arrive will be the "header" segment
+                     Next_Segment.Seg_Sequence_No := Header;
+                  end if;
+                  -- pass the record to its carrier
+                  Next_Segment_Task.Input ( Next_Segment );
+               end;
+            end loop;
+      exception
+         when others => 
+              Report.Failed ("Unexpected Exception in TC_Simulate_Arrival");
+      end TC_Simulate_Arrival;
+   
+
+      -- One of these is generated for each message segment and the flow 
+      -- of the segments through the system is controlled by the calls the
+      -- task makes and the requeues of those calls
+      --
+      task body Carrier_Task is
+         This_Segment : acc_Message_Segment := new Message_Segment;
+      begin
+         accept Input ( Segment : acc_Message_Segment ) do
+            This_Segment.all := Segment.all;
+         end Input;
+         null; --:: stub.  Pass the segment around the application as needed
+
+         -- Now output the segment to the Output_Driver.  First we have to 
+         -- go through the Sequencer.  
+         Sequencer.Ordering_Queue ( This_Segment );
+      exception
+         when others => 
+              Report.Failed ("Unexpected Exception in Carrier_Task");
+      end Carrier_Task;
+   
+
+      -- Pull segments off the Ordering_Queue and deliver them in the correct
+      -- sequence to the Output_Driver.
+      --
+      task body Sequencer is
+         Next_Needed : Segment_Sequence := Header;
+   
+         TC_Await_Arrival     : Boolean := true;
+         TC_First_Cycle       : Boolean := true;  
+         TC_Expected_Sequence : Segment_Sequence := Header+2;
+      begin
+         loop
+            select
+               accept Ordering_Queue ( Segment : acc_Message_Segment ) do
+
+                  --=====================================================
+                  -- This part is all Test_Control code
+
+                  if TC_Await_Arrival then
+                     -- We have to arrange that the segments arrive on the 
+                     -- queue in the right order, so we handshake with the 
+                     -- TC_Simulate_Arrival task to "send" only one at 
+                     -- a time
+                     accept TC_Handshake_1;   -- the first  has arrived
+                                              -- and has been pulled off the
+                                              -- queue
+
+                     -- Wait for the second to arrive (the first has already
+                     -- been pulled off the queue
+                     while Ordering_Queue'count < 1 loop
+                        delay ImpDef.Minimum_Task_Switch;
+                     end loop;
+                     --
+                     accept TC_Handshake_2;   -- the second has arrived
+
+                     -- Wait for the third to arrive
+                     while Ordering_Queue'count < 2 loop
+                        delay ImpDef.Minimum_Task_Switch;
+                     end loop;
+
+                     -- Subsequent passes through the loop, bypass this code
+                     TC_Await_Arrival := false; 
+                              
+
+                  end if; -- await arrival
+
+                  if TC_First_Cycle then 
+                     -- Check the order of the original three 
+                     if Segment.Seg_Sequence_No /= TC_Expected_Sequence then
+                        -- The segments are not being pulled off in the 
+                        -- expected sequence.  This could occur if the 
+                        -- requeue is not putting them back on the end.
+                        Report.Failed ("Sequencer: Segment out of sequence");
+                     end if; -- sequence check
+                     -- Decrement the expected sequence
+                     if TC_Expected_Sequence /= Header then
+                        TC_Expected_Sequence := TC_Expected_Sequence - 1;
+                     else 
+                        TC_First_Cycle := false; -- This is the Header - the
+                                                 -- first two segments are
+                                                 -- back on the queue
+                                                 
+                     end if; -- decrementing
+                  end if; -- first pass
+                  --=====================================================
+
+                  -- And this is the Application code
+                  if Segment.Seg_Sequence_No = Next_Needed then
+                     if Segment.EOM then
+                        Next_Needed := Header;  -- reset for next message
+                     else
+                        Next_Needed := Next_Needed + 1;
+                     end if;
+                     requeue Output_Driver.Input with abort;
+                     Report.Failed ("Requeue did not complete accept body");
+                  else
+                     -- Not the next needed - put it back on the queue
+                     requeue Sequencer.Ordering_Queue;
+                     Report.Failed ("Requeue did not complete accept body");
+                  end if;   
+               end Ordering_Queue;
+            or
+               terminate;
+            end select;
+         end loop;
+      exception
+         when others => 
+              Report.Failed ("Unexpected Exception in Sequencer");
+      end Sequencer;
+   
+
+      task body Output_Driver is
+         This_Segment : acc_Message_Segment := new Message_Segment;
+
+         TC_Expected_Sequence : Segment_Sequence := Segment_Sequence'first;
+         TC_Segment_Total     : integer := 0;
+         TC_Expected_Total    : integer := 3;
+      begin
+         loop
+            -- Note: normally we would expect this Accept to be in a select 
+            -- with terminate.  For the test we exit the loop on completion
+            -- to give better control
+            accept Input ( Segment : acc_Message_Segment ) do 
+               This_Segment.all := Segment.all;
+            end Input;
+   
+            null;  --::: stub - output the next segment of the message
+
+            -- The following is all test control code
+            --
+            if This_Segment.Seg_Sequence_No /= TC_Expected_Sequence then
+               Report.Failed ("Output_Driver: Segment out of sequence");
+            end if;
+            TC_Expected_Sequence := TC_Expected_Sequence + 1;
+
+            -- Now count the number of segments
+            TC_Segment_Total := TC_Segment_Total + 1;
+
+            -- Check the number and exit loop when complete
+            -- There must be exactly TC_Expected_Total in number and
+            --    the last one must be EOM
+            --    (test will hang if < TC_Expected_Total arrive
+            --    without EOM)
+            if This_Segment.EOM then
+               -- This is the last segment.
+               if TC_Segment_Total /= TC_Expected_Total then
+                  Report.Failed ("EOM and wrong number of segments");
+               end if;
+               exit;   -- the loop and terminate the task
+            elsif TC_Segment_Total = TC_Expected_Total then
+               Report.Failed ("No EOM found");
+               exit;
+            end if;
+         end loop;
+      exception
+         when others => 
+              Report.Failed ("Unexpected Exception in Output_Driver");
+      end Output_Driver;
+
+
+
+   begin  
+
+      null;
+
+   end; -- encapsulation
+
+   Report.Result;
+   
+end C954019;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954020.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954020.a
new file mode 100644
index 000000000..bc08a6bd4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954020.a
@@ -0,0 +1,422 @@
+-- C954020.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 call to a protected entry can be requeued to a task
+--      entry. Check that the requeue is placed on the correct entry; that the
+--      original caller waits for the completion of the requeue and continues
+--      after the requeued rendezvous.  Check that the requeue does not block.
+--      Specifically, check a requeue with abort from a protected entry to
+--      an entry in a task.
+--
+-- TEST DESCRIPTION:
+--
+--      In the Distributor protected object, requeue two successive calls on
+--      the entries of two separate target tasks.  Each task in each of the 
+--      paths adds identifying information in the transaction being passed. 
+--      This information is checked by the Message tasks on completion
+--      ensuring that the requeues have been placed on the correct queues.
+--      There is an artificial guard on the Credit Task to ensure that the
+--      input is queued; this guard is released by the Debit task which 
+--      handles its input immediately.  This ensures that we have one of the
+--      requeued items actually queued for later handling and also verifies
+--      that the requeuing process (in the protected object) is not blocked.
+--
+--      This series of tests uses a simulation of a transaction driven 
+--      processing system.  Line Drivers accept input from an external source
+--      and build them into transaction records.  These records are then 
+--      encapsulated in message tasks which remain extant for the life of the
+--      transaction in the system. The message tasks put themselves on the 
+--      input queue of a Distributor object which, from information in the
+--      transaction and/or system load conditions forwards them to other 
+--      operating tasks. These in turn might forward the transactions to yet 
+--      other tasks for further action.  The routing is, in real life, 
+--      dynamic and unpredictable at the time of message generation. All 
+--      rerouting in this  model is done by means of requeues.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      06 Nov 95   SAIC    Fixed problems for ACVC 2.0.1
+--
+--!
+
+with Report;
+with ImpDef;
+         
+procedure C954020 is
+   Verbose : constant Boolean := False;
+ 
+   -- Arbitrary test values
+   Credit_Return : constant := 1;
+   Debit_Return  : constant := 2;
+
+   protected type Message_Status is
+      procedure Set_Complete;
+      function Complete return Boolean;
+   private
+      Is_Complete : Boolean := False;
+   end Message_Status;
+
+   protected body Message_Status is
+      procedure Set_Complete is
+      begin
+         Is_Complete := True;
+      end Set_Complete;
+
+      function Complete return Boolean is
+      begin
+         return Is_Complete;
+      end Complete;
+   end Message_Status;
+
+   TC_Debit_Message : Message_Status;
+   TC_Credit_Message : Message_Status;
+
+   type Transaction_Code is (Credit, Debit);
+
+   type Transaction_Record;
+   type acc_Transaction_Record is access Transaction_Record;
+   type Transaction_Record is 
+      record
+         ID               : integer := 0;
+         Code             : Transaction_Code := Debit;
+         Account_Number   : integer := 0;
+         Stock_Number     : integer := 0;
+         Quantity         : integer := 0;
+         Return_Value     : integer := 0;
+         TC_Message_Count : integer := 0; 
+         TC_Thru_Dist     : Boolean := false;
+      end record;
+
+
+   task type Message_Task is 
+      entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+   end Message_Task;
+   type acc_Message_Task is access Message_Task;
+
+   task Line_Driver is 
+      entry Start;
+   end Line_Driver;   
+
+   task Credit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Computation;
+
+   task Debit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Debit_Computation;
+
+   protected Time_Lock is
+      procedure Credit_Start;
+      function  Credit_Enabled return Boolean;
+   private
+      Credit_OK : Boolean := false;
+   end Time_Lock;
+
+   protected body Time_Lock is
+      procedure Credit_Start is
+      begin
+         Credit_OK := true;
+      end Credit_Start;
+
+      function  Credit_Enabled return Boolean is 
+      begin
+         return Credit_OK;
+      end Credit_Enabled;
+   end Time_Lock;
+
+
+
+   protected Distributor is
+      entry Input (Transaction : acc_Transaction_Record);
+   end Distributor;
+   --
+   --
+   -- Dispose each input Transaction_Record to the appropriate
+   -- computation tasks
+   --
+   protected body Distributor is
+      entry Input (Transaction : acc_Transaction_Record) when true is
+                                                      -- barrier is always open
+      begin
+         -- Test Control: Set the indicator in the message to show it has
+         -- passed through the Distributor object
+         Transaction.TC_thru_Dist := true;
+             
+         -- Pass this transaction on to the appropriate computation
+         -- task
+         case Transaction.Code is
+            when Credit =>
+               requeue Credit_Computation.Input with abort;
+            when Debit =>
+               requeue Debit_Computation.Input with abort;
+         end case;
+      end Input;
+   end Distributor;
+
+
+
+
+   -- Assemble messages received from an external source
+   --   Creates a message task for each. The message tasks remain extant
+   --   for the life of the messages in the system.
+   --      The Line Driver task would normally be designed to loop continuously
+   --      creating the messages as input is received.  Simulate this 
+   --      but limit it to two dummy messages for this test and allow it
+   --      to terminate at that point
+   --
+   task body Line_Driver is
+      Current_ID : integer := 1;
+      TC_Last_was_for_credit : Boolean := false;
+
+      procedure Build_Credit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 100;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Credit; 
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Credit_Record;     
+
+
+      procedure Build_Debit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 200;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Debit; 
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Debit_Record;     
+
+   begin
+
+      accept Start;      -- Wait for trigger from Main
+
+      for i in 1..2 loop  -- arbitrarily limit to two messages for the test
+         declare 
+            -- Create a task for the next message
+            Next_Message_Task : acc_Message_Task := new Message_Task;
+            -- Create a record for it
+            Next_Transaction : acc_Transaction_Record 
+                                                 := new Transaction_Record;
+         begin
+            if TC_Last_was_for_credit then
+               Build_Debit_Record ( Next_Transaction );            
+            else
+               Build_Credit_Record( Next_Transaction );
+               TC_Last_was_for_credit := true;
+            end if;
+            Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+         end;   -- declare
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Line_Driver");
+   end Line_Driver;
+
+   
+
+
+   task body Message_Task is
+
+      TC_Original_Transaction_Code : Transaction_Code;  
+      This_Transaction : acc_Transaction_Record := new Transaction_Record;
+
+   begin
+      accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+         This_Transaction.all := In_Transaction.all;
+      end Accept_Transaction;
+
+      if Verbose then
+         Report.Comment ("message task got " &
+                         Transaction_Code'Image (This_Transaction.Code));
+      end if;
+
+      -- Note the original code to ensure correct return
+      TC_Original_Transaction_Code := This_Transaction.Code;
+ 
+      -- Queue up on Distributor's Input queue
+      Distributor.Input ( This_Transaction );
+      -- This task will now wait for the requeued rendezvous 
+      -- to complete before proceeding
+
+      -- After the required computations have been performed
+      -- return the Transaction_Record appropriately (probably to an output
+      -- line driver)
+      null;            -- stub
+
+      
+      -- The following is all Test Control Code
+
+      -- Check that the return values are as expected
+      if TC_Original_Transaction_Code /= This_Transaction.Code then
+         -- Incorrect rendezvous
+         Report.Failed ("Message Task: Incorrect code returned");
+      end if;
+
+      if This_Transaction.Code = Credit then
+         if This_Transaction.Return_Value  /= Credit_Return or   
+            This_Transaction.TC_Message_Count /= 1          or 
+            not This_Transaction.TC_thru_Dist       then
+               Report.Failed ("Expected path not traversed");
+         end if;
+         TC_Credit_Message.Set_Complete;
+      else
+         if This_Transaction.Return_Value  /= Debit_Return or   
+            This_Transaction.TC_Message_Count /= 1         or 
+            not This_Transaction.TC_thru_Dist       then
+               Report.Failed ("Expected path not traversed");
+         end if;
+         TC_Debit_Message.Set_Complete;
+      end if;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Message_Task");
+
+   end Message_Task;
+
+
+
+   -- Computation task.
+   --   Note:  After the computation is performed in this task and the 
+   --          accept body is completed the rendezvous in the original
+   --          message task is completed.                              
+   --                                           
+   task body Credit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select 
+            when  Time_Lock.Credit_enabled =>
+            accept Input ( Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this transaction
+               null;      -- stub
+
+               if Verbose then
+                  Report.Comment ("Credit_Computation in accept");
+               end if;
+
+               -- For the test: 
+               if not Transaction.TC_thru_Dist then
+                  Report.Failed 
+                         ("Credit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Credit then
+                  Report.Failed
+                         ("Credit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Credit_Return;
+               -- one, and only one message should pass through
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+
+            end Input;            
+            exit;   -- only handle 1 transaction
+         else
+            -- poll until we can accept credit transaction
+            delay ImpDef.Clear_Ready_Queue;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Computation");
+   end Credit_Computation;
+
+
+
+   -- Computation task.
+   --   Note:  After the computation is performed in this task and the 
+   --          accept body is completed the rendezvous in the original
+   --          message task is completed.                              
+   --                                                
+   task body Debit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this message
+               null;      -- stub
+
+               if Verbose then
+                  Report.Comment ("Debit_Computation in accept");
+               end if;
+
+               -- For the test: 
+               if not Transaction.TC_thru_Dist then
+                  Report.Failed
+                         ("Debit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Debit then
+                  Report.Failed
+                         ("Debit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Debit_Return;
+               -- one, and only one, message should pass through
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+               -- for the test: once we have completed the only Debit
+               -- message release the Credit Messages which are queued
+               -- on the Credit Input queue
+               Time_Lock.Credit_Start;
+            end Input;            
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Debit_Computation");
+
+
+   end Debit_Computation;
+
+
+begin -- C954020
+
+   Report.Test ("C954020", "Requeue, with abort, from protected entry " &
+                                                         "to task entry");
+
+   Line_Driver.Start;        -- Start the test
+
+   -- Ensure that the message tasks complete before reporting the result
+   while not (TC_Credit_Message.Complete and TC_Debit_Message.Complete) loop
+      delay ImpDef.Minimum_Task_Switch;   
+   end loop;
+
+   Report.Result;
+
+end C954020;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954021.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954021.a
new file mode 100644
index 000000000..626f2f970
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954021.a
@@ -0,0 +1,524 @@
+-- C954021.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 requeue within a protected entry to an entry in a
+--     different protected object is queued correctly.
+--
+-- TEST DESCRIPTION: 
+--      One transaction is sent through to check the paths. After processing
+--      this the Credit task sets the "overloaded" indicator.  Once this
+--      indicator is set the Distributor (a protected object) queues low
+--      priority transactions on a Wait_for_Underload queue in another
+--      protected object using a requeue. The Distributor still delivers high
+--      priority transactions.  After two high priority transactions have been
+--      processed by the Credit task it clears the overload condition.  The
+--      low priority transactions should now be delivered. 
+--     
+--      This series of tests uses a simulation of a transaction driven
+--      processing system.  Line Drivers accept input from an external source
+--      and build them into transaction records.  These records are then
+--      encapsulated in message tasks which remain extant for the life of the
+--      transaction in the system.  The message tasks put themselves on the
+--      input queue of a Distributor which, from information in the
+--      transaction and/or system load conditions forwards them to other
+--      operating tasks. These in turn might forward the transactions to yet
+--      other tasks for further action.  The routing is, in real life, dynamic
+--      and unpredictable at the time of message generation.  All rerouting in
+--      this  model is done by means of requeues.
+--     
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      26 Nov 95   SAIC    Fixed shared global variable for ACVC 2.0.1
+--
+--!
+
+with Report;
+with ImpDef;
+         
+procedure C954021 is
+ 
+   -- Arbitrary test values
+   Credit_Return : constant := 1;
+   Debit_Return  : constant := 2;
+
+
+   -- Mechanism to count the number of Credit Message tasks completed
+   protected TC_Tasks_Completed is
+      procedure Increment;
+      function  Count return integer;
+   private
+      Number_Complete : integer := 0;
+   end TC_Tasks_Completed;
+   
+   
+   TC_Credit_Messages_Expected  : constant integer := 5;
+
+   protected TC_Handshake is
+      procedure Set;
+      function First_Message_Arrived return Boolean;
+   private
+      Arrived_Flag : Boolean := false;
+   end TC_Handshake;
+
+   -- Handshaking mechanism between the Line Driver and the Credit task
+   -- 
+   protected body TC_Handshake is
+      --
+      procedure Set is
+      begin 
+         Arrived_Flag := true;
+      end Set;
+      --
+      function First_Message_Arrived return Boolean is
+      begin
+         return Arrived_Flag;
+      end First_Message_Arrived;
+      -- 
+   end TC_Handshake;
+
+
+   protected type Shared_Boolean (Initial_Value : Boolean := False) is
+      procedure Set_True;
+      procedure Set_False;
+      function  Value return Boolean;
+   private
+      Current_Value : Boolean := Initial_Value;
+   end Shared_Boolean;
+
+   protected body Shared_Boolean is
+      procedure Set_True is
+      begin
+         Current_Value := True;
+      end Set_True;
+
+      procedure Set_False is
+      begin
+         Current_Value := False;
+      end Set_False;
+
+      function Value return Boolean is
+      begin
+         return Current_Value;
+      end Value;
+   end Shared_Boolean;
+ 
+   TC_Debit_Message_Complete    : Shared_Boolean (False);
+
+   type Transaction_Code is (Credit, Debit);
+   type Transaction_Priority is (High, Low);
+
+   type Transaction_Record;
+   type acc_Transaction_Record is access Transaction_Record;
+   type Transaction_Record is 
+      record
+         ID               : integer := 0;
+         Code             : Transaction_Code := Debit;
+         Priority         : Transaction_Priority := High;
+         Account_Number   : integer := 0;
+         Stock_Number     : integer := 0;
+         Quantity         : integer := 0;
+         Return_Value     : integer := 0;
+         TC_Message_Count : integer := 0;  
+         TC_Thru_Dist     : Boolean := false;
+      end record;
+
+
+   task type Message_Task is 
+      entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+   end Message_Task;
+   type acc_Message_Task is access Message_Task;
+
+   task Line_Driver is
+      entry Start;
+   end Line_Driver;
+
+   protected Distributor is
+      procedure Set_Credit_Overloaded;
+      procedure Clear_Credit_Overloaded;
+      function  Credit_is_Overloaded return Boolean;
+      entry     Input (Transaction : acc_Transaction_Record);
+   private
+      Credit_Overloaded : Boolean := false;
+   end Distributor;
+
+   protected Hold is
+      procedure Underloaded;
+      entry Wait_for_Underload (Transaction : acc_Transaction_Record);
+   private
+      Release_All : Boolean := false;
+   end Hold;
+
+   task Credit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Credit_Computation;
+
+   task Debit_Computation is
+      entry Input(Transaction : acc_Transaction_Record);
+   end Debit_Computation;
+
+   --
+   -- Dispose each input Transaction_Record to the appropriate
+   -- computation tasks
+   --
+   protected body Distributor is
+
+      procedure Set_Credit_Overloaded is
+      begin
+         Credit_Overloaded := true;
+      end Set_Credit_Overloaded;
+
+      procedure Clear_Credit_Overloaded is
+      begin
+         Credit_Overloaded := false;
+         Hold.Underloaded;       -- Release all held messages
+      end Clear_Credit_Overloaded;
+  
+      function  Credit_is_Overloaded return Boolean is
+      begin
+         return Credit_Overloaded;
+      end Credit_is_Overloaded;
+
+
+      entry Input (Transaction : acc_Transaction_Record) when true is
+                                                     -- barrier is always open
+      begin
+         -- Test Control: Set the indicator in the message to show it has
+         -- passed through the Distributor object
+         Transaction.TC_thru_Dist := true;
+ 
+         -- Pass this transaction on to the appropriate computation
+         -- task but temporarily hold low-priority transactions under
+         -- overload conditions
+         case Transaction.Code is
+            when Credit =>
+               if Credit_Overloaded and Transaction.Priority = Low then
+                  requeue Hold.Wait_for_Underload with abort;
+               else
+                  requeue Credit_Computation.Input with abort;
+              end if;
+            when Debit =>
+              requeue Debit_Computation.Input with abort;
+         end case;
+      end Input;
+   end Distributor;
+
+
+   -- Low priority Message tasks are held on the Wait_for_Underload queue
+   -- while the Credit computation system is overloaded.  Once the Credit
+   -- system reached underload send all queued messages immediately
+   --
+   protected body Hold is
+      
+      -- Once this is executed the barrier condition for the entry is 
+      -- evaluated 
+      procedure Underloaded is
+      begin 
+         Release_All := true;
+      end Underloaded;
+
+      entry Wait_for_Underload (Transaction : acc_Transaction_Record)
+                                                     when Release_All is
+      begin
+         requeue Credit_Computation.Input with abort;
+         if Wait_for_Underload'count = 0 then
+            -- Queue is purged.  Set up to hold next batch
+            Release_All := false;
+         end if; 
+      end Wait_for_Underload;
+
+   end Hold;
+   
+   -- Mechanism to count the number of Message tasks completed (Credit)
+   protected body TC_Tasks_Completed is
+      procedure Increment is
+      begin
+         Number_Complete := Number_Complete + 1;
+      end Increment;
+
+      function Count return integer is
+      begin
+         return Number_Complete;
+      end Count;
+   end TC_Tasks_Completed;
+
+
+   -- Assemble messages received from an external source
+   --   Creates a message task for each. The message tasks remain extant
+   --   for the life of the messages in the system.
+   --      The Line Driver task would normally be designed to loop continuously
+   --      creating the messages as input is received.  Simulate this 
+   --      but limit it to the required number of dummy messages needed for
+   --      this test and allow it to terminate at that point.  Artificially
+   --      alternate High and Low priority Credit transactions for this test.
+   --
+   task body Line_Driver is
+      Current_ID       : integer := 1;
+      Current_Priority : Transaction_Priority := High;      
+
+      -- Artificial: number of messages required for this test
+      type TC_Trans_Range is range 1..6;
+
+      procedure Build_Credit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 100;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Credit; 
+            Next_Transaction.Priority := Current_Priority;
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Credit_Record;     
+
+
+      procedure Build_Debit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+         Dummy_Account : constant integer := 200;
+      begin
+            Next_Transaction.ID := Current_ID;
+            Next_Transaction.Code := Debit; 
+
+            Next_Transaction.Account_Number := Dummy_Account;
+            Current_ID := Current_ID + 1;
+      end Build_Debit_Record;     
+
+   begin
+      
+      accept Start;   -- Wait for trigger from Main
+
+      for Transaction_Numb in TC_Trans_Range loop  -- TC: limit the loop
+         declare 
+            -- Create a task for the next message
+            Next_Message_Task : acc_Message_Task := new Message_Task;
+            -- Create a record for it
+            Next_Transaction : acc_Transaction_Record := 
+                                                new Transaction_Record;
+         begin
+            if Transaction_Numb = TC_Trans_Range'first then
+               -- Send the first Credit message
+               Build_Credit_Record ( Next_Transaction );
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+               -- TC: Wait until the first message has been received by the
+               -- Credit task and it has set the Overload indicator for the 
+               -- Distributor
+               while not TC_Handshake.First_Message_Arrived loop
+                  delay ImpDef.Minimum_Task_Switch;   
+               end loop;
+            elsif Transaction_Numb = TC_Trans_Range'last then
+               -- For this test send the last transaction to the Debit task
+               -- to improve the mix
+               Build_Debit_Record( Next_Transaction );
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+            else
+               -- TC: Alternate high and low priority transactions
+               if Current_Priority = High then
+                  Current_Priority := Low;
+               else
+                  Current_Priority := High;
+               end if;
+               Build_Credit_Record( Next_Transaction );
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+            end if;
+         end;   -- declare
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Line_Driver");
+   end Line_Driver;
+
+   
+
+
+   task body Message_Task is
+
+      TC_Original_Transaction_Code : Transaction_Code;  
+      This_Transaction : acc_Transaction_Record := new Transaction_Record;
+
+   begin
+      
+      accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
+         This_Transaction.all := In_Transaction.all;
+      end Accept_Transaction;
+
+      -- Note the original code to ensure correct return
+      TC_Original_Transaction_Code := This_Transaction.Code;
+ 
+      -- Queue up on Distributor's Input queue
+      Distributor.Input ( This_Transaction );
+      -- This task will now wait for the requeued rendezvous 
+      -- to complete before proceeding
+
+      -- After the required computations have been performed
+      -- return the Transaction_Record appropriately (probably to an output
+      -- line driver)
+      null;            -- stub
+      
+      -- For the test check that the return values are as expected
+      if TC_Original_Transaction_Code /= This_Transaction.Code then
+         -- Incorrect rendezvous
+         Report.Failed ("Message Task: Incorrect code returned");
+      end if;
+
+      if This_Transaction.Code = Credit then
+         if This_Transaction.Return_Value  /= Credit_Return   or
+         not This_Transaction.TC_thru_Dist                    then
+            Report.Failed ("Expected path not traversed - Credit");
+         end if;
+         TC_Tasks_Completed.Increment;
+      else
+         if This_Transaction.Return_Value  /= Debit_Return or   
+            This_Transaction.TC_Message_Count /= 1         or
+            not This_Transaction.TC_thru_Dist               then
+               Report.Failed ("Expected path not traversed - Debit");
+         end if;
+         TC_Debit_Message_Complete.Set_True;
+      end if;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Message_Task");
+   end Message_Task;
+
+
+
+
+  
+   -- Computation task.  After the computation is performed the rendezvous
+   -- in the original message task is completed.                              
+   task body Credit_Computation is
+
+      Message_Count   : integer := 0;
+      
+   begin
+      loop
+         select 
+            accept Input ( Transaction : acc_Transaction_Record) do
+               if Distributor.Credit_is_Overloaded
+                                    and Transaction.Priority = Low  then 
+                  -- We should not be getting any Low Priority messages. They
+                  -- should be waiting on the Hold.Wait_for_Underload 
+                  -- queue
+                  Report.Failed 
+                     ("Credit Task: Low priority transaction during overload");
+               end if;
+               -- Perform the computations required for this transaction
+               null; -- stub
+
+               -- For the test: 
+               if not Transaction.TC_thru_Dist then
+                  Report.Failed 
+                         ("Credit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Credit then
+                  Report.Failed
+                         ("Credit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- The following is all Test Control code:
+               Transaction.Return_Value := Credit_Return;
+               Message_Count := Message_Count + 1;
+               --
+               -- Now take special action depending on which Message
+               if Message_Count = 1 then 
+                  -- After the first message :
+                  Distributor.Set_Credit_Overloaded;
+                  -- Now flag the Line_Driver that the second and subsequent
+                  -- messages may now be sent
+                  TC_Handshake.Set;
+               end if;
+               if Message_Count = 3 then
+                  -- The two high priority transactions created subsequent
+                  -- to the overload have now been processed
+                  Distributor.Clear_Credit_Overloaded;
+               end if;
+            end Input;            
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Computation");
+   end Credit_Computation;
+
+
+
+   -- Computation task.  After the computation is performed the rendezvous
+   -- in the original message task is completed.        
+   --                      
+   task body Debit_Computation is
+      Message_Count   : integer := 0;
+   begin
+      loop
+         select
+            accept Input (Transaction : acc_Transaction_Record) do
+               -- Perform the computations required for this message
+               null;      -- stub
+
+               -- For the test: 
+               if not Transaction.TC_thru_Dist then
+                  Report.Failed 
+                         ("Debit Task: Wrong queue, Distributor bypassed");
+               end if;
+               if Transaction.code /= Debit then
+                  Report.Failed
+                         ("Debit Task: Requeue delivered to the wrong queue");
+               end if;
+
+               -- for the test plug a known value and count
+               Transaction.Return_Value := Debit_Return;
+               -- one, and only one, message should pass through
+               Message_Count := Message_Count + 1;
+               Transaction.TC_Message_Count := Message_Count;
+            end Input;            
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Debit_Computation");
+   end Debit_Computation;
+
+
+begin 
+   Report.Test ("C954021", "Requeue from one entry body to an entry in" &
+                                       " another protected object");
+
+   Line_Driver.Start;  -- Start the test
+
+
+   -- Ensure that the message tasks have completed before reporting result
+   while (TC_Tasks_Completed.Count < TC_Credit_Messages_Expected) 
+         and not TC_Debit_Message_Complete.Value loop
+      delay ImpDef.Minimum_Task_Switch;   
+   end loop;
+
+   Report.Result;
+
+end C954021;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954022.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954022.a
new file mode 100644
index 000000000..5ebff8dcb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954022.a
@@ -0,0 +1,351 @@
+-- C954022.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:
+--      In an entry body requeue the call to the same entry.  Check that the
+--      items go to the right queue and that they are placed back on the end 
+--      of the queue
+--
+-- TEST DESCRIPTION:
+--      Simulate part of a message handling application where the messages are
+--      composed of several segments.  The sequence of the segments within the
+--      message is specified by Seg_Sequence_No.   The segments are handled by
+--      different tasks and finally forwarded to an output driver.  The
+--      segments can arrive in any order but must be assembled into the proper
+--      sequence for final output.  There is a Sequencer task interposed
+--      before the Driver.  This takes the segments of the message off the
+--      Ordering_Queue and those that are in the right order it sends on to
+--      the driver; those that are out of order it places back on the end of
+--      the queue.
+--
+--      The test just simulates the arrival of the segments at the Sequencer.
+--      The task generating the segments handshakes with the Sequencer during
+--      the  "Await Arrival" phase  ensuring that the three segments of a
+--      message arrive in REVERSE order (the End-of-Message segment arrives
+--      first and the Header last).  In the first cycle the sequencer pulls
+--      segments off the queue and puts them back on the end till it
+--      encounters the header.  It checks the sequence of the ones it pulls
+--      off in case the segments are being put back on in the wrong part of
+--      the queue.  Having cycled once through it no longer verifies the
+--      sequence - it just executes the "application" code for the correct
+--      order for dispatch to the driver.
+-- 
+--      In this simple example no attempt is made to address segments of
+--      another message arriving or any other error conditions (such as
+--      missing segments, timing etc.)
+-- 
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      07 Nov 95   SAIC    ACVC 2.0.1
+--
+--!
+
+with Report;
+with ImpDef;
+
+procedure C954022 is
+
+   -- These global Booleans are set when failure conditions inside Protected
+   -- objects are encountered.  Report.Failed cannot be called within
+   -- the object or a Bounded Error would occur
+   --
+   TC_Failed_1 : Boolean := false;
+   TC_Failed_2 : Boolean := false;
+   TC_Failed_3 : Boolean := false;
+
+begin
+
+
+   Report.Test ("C954022", "Check Requeue to the same Protected Entry");
+   
+   declare  -- encapsulate the test
+
+      type Segment_Sequence is range 1..8;
+      Header : constant Segment_Sequence := Segment_Sequence'first;
+
+      type Message_Segment is record
+         ID              : integer;            -- Message ID
+         Seg_Sequence_No : Segment_Sequence;   -- Within the message
+         Segs_In_Message : integer;            -- Total segs this message
+         EOM             : Boolean := false;   -- true for final msg segment
+         Alpha           : string (1..128);
+      end record;
+      type acc_Message_Segment is access Message_Segment;
+
+      task TC_Simulate_Arrival;
+   
+      task type Carrier_Task is
+         entry Input ( Segment : acc_Message_Segment );
+      end Carrier_Task;
+      type acc_Carrier_Task is access Carrier_Task;
+   
+      protected Sequencer is
+         function  TC_Arrivals return integer;
+         entry Input          ( Segment : acc_Message_Segment );
+         entry Ordering_Queue ( Segment : acc_Message_Segment );
+      private
+         Number_of_Segments_Arrived  : integer := 0;
+         Number_of_Segments_Expected : integer := 0;
+         Next_Needed : Segment_Sequence := Header;
+         All_Segments_Arrived : Boolean := false;
+         Seen_EOM             : Boolean := false;
+
+         TC_First_Cycle       : Boolean := true;
+         TC_Expected_Sequence : Segment_Sequence := Header+2;
+
+      end Sequencer;
+   
+
+      task Output_Driver is
+         entry Input ( Segment : acc_Message_Segment );
+      end Output_Driver;
+   
+
+      -- Simulate the arrival of three message segments in REVERSE order
+      --
+      task body TC_Simulate_Arrival is
+         begin
+            for i in 1..3 loop
+               declare
+                  -- Create a task for the next message segment
+                  Next_Segment_Task : acc_Carrier_Task := new Carrier_Task;
+                  -- Create a record for the next segment
+                  Next_Segment : acc_Message_Segment := new Message_Segment;
+               begin
+                  if i = 1 then 
+                     -- Build the EOM segment as the first to "send"
+                     Next_Segment.Seg_Sequence_No := Header + 2;
+                     Next_Segment.Segs_In_Message := 3;
+                     Next_Segment.EOM := true;
+                  elsif i = 2 then
+                     -- Wait for the first segment to arrive at the Sequencer
+                     -- before "sending" the second
+                     while Sequencer.TC_Arrivals < 1 loop
+                        delay ImpDef.Minimum_Task_Switch;
+                     end loop;
+                     -- Build the segment
+                     Next_Segment.Seg_Sequence_No := Header +1;
+                  else
+                     -- Wait for the second segment to arrive at the Sequencer
+                     -- before "sending" the third
+                     while Sequencer.TC_Arrivals < 2 loop
+                        delay ImpDef.Minimum_Task_Switch;
+                     end loop;                  
+                     -- Build the segment. The last segment (in order) to
+                     -- arrive will be the "header" segment
+                     Next_Segment.Seg_Sequence_No := Header;
+                  end if;
+                  -- pass the record to its carrier
+                  Next_Segment_Task.Input ( Next_Segment );
+               end;
+            end loop;
+ 
+
+      exception
+         when others => 
+              Report.Failed ("Unexpected Exception in TC_Simulate_Arrival");
+      end TC_Simulate_Arrival;
+   
+
+      -- One of these is generated for each message segment and the flow 
+      -- of the segments through the system is controlled by the calls the
+      -- task makes and the requeues of those calls
+      --
+      task body Carrier_Task is
+         This_Segment : acc_Message_Segment := new Message_Segment;
+      begin
+         accept Input ( Segment : acc_Message_Segment ) do
+            This_Segment.all := Segment.all;
+         end Input;
+         null; --:: stub.  Pass the segment around the application as needed
+
+         -- Now output the segment to the Output_Driver.  First we have to 
+         -- go through the Sequencer.  
+         Sequencer.Input ( This_Segment );
+      exception
+         when others => 
+              Report.Failed ("Unexpected Exception in Carrier_Task");
+      end Carrier_Task;
+   
+      -- Store segments on the Ordering_Queue then deliver them in the correct
+      -- sequence to the Output_Driver.
+      --
+      protected body Sequencer is
+
+         function  TC_Arrivals return integer is
+         begin
+            return Number_of_Segments_Arrived;
+         end TC_Arrivals;
+
+         
+         -- Segments arriving at the Input queue are counted and checked
+         -- against the total number of segments for the message.  They
+         -- are requeued onto the ordering queue where they are held until
+         -- all the segments have arrived.
+         entry Input ( Segment : acc_Message_Segment ) when true is
+         begin
+            -- check for EOM, if so get the number of segments in the message
+            -- Note: in this portion of code no attempt is made to address
+            -- reset for new message , end conditions, missing segments, 
+            -- segments of a different message etc.
+            Number_of_Segments_Arrived := Number_of_Segments_Arrived + 1;
+            if Segment.EOM then
+               Number_of_Segments_Expected := Segment.Segs_In_Message;
+               Seen_EOM := true;
+            end if;
+
+            if Seen_EOM then
+               if Number_of_Segments_Arrived = Number_of_Segments_Expected then
+                  -- This is the last segment for this message
+                  All_Segments_Arrived := true;    -- clear the barrier
+               end if;
+            end if;
+
+            requeue Ordering_Queue;
+
+            -- At this exit point the entry queue barriers are evaluated
+
+         end Input;
+
+
+         entry Ordering_Queue ( Segment : acc_Message_Segment )
+                                                  when All_Segments_Arrived is
+            begin
+
+            --=====================================================
+            -- This part is all Test_Control code
+
+            if TC_First_Cycle then 
+               -- Check the order of the original three
+               if Segment.Seg_Sequence_No /= TC_Expected_Sequence then
+                  -- The segments are not being pulled off in the 
+                  -- expected sequence.  This could occur if the 
+                  -- requeue is not putting them back on the end.
+                  TC_Failed_3 := true;
+               end if; -- sequence check
+               -- Decrement the expected sequence
+               if TC_Expected_Sequence /= Header then
+                  TC_Expected_Sequence := TC_Expected_Sequence - 1;
+               else 
+                  TC_First_Cycle := false; -- This is the Header - the
+                                           -- first two segments are
+                                           -- back on the queue
+               end if; -- decrementing
+            end if; -- first cycle 
+            --=====================================================
+
+            -- And this is the Application code
+            if Segment.Seg_Sequence_No = Next_Needed then
+               if Segment.EOM then
+                  Next_Needed := Header;  -- reset for next message
+                  -- :: other resets not shown
+               else
+                  Next_Needed := Next_Needed + 1;
+               end if;
+               requeue Output_Driver.Input  with abort;
+               -- set to Report Failed - Requeue did not complete entry body
+               TC_Failed_1 := true;
+            else
+               -- Not the next needed - put it back on the queue
+               --    NOTE: here we are requeueing to the same entry
+               requeue Sequencer.Ordering_Queue;
+               -- set to Report Failed - Requeue did not complete entry body
+               TC_Failed_2 := true;
+            end if;
+         end Ordering_Queue;
+      end Sequencer;
+   
+
+      task body Output_Driver is
+         This_Segment : acc_Message_Segment := new Message_Segment;
+
+         TC_Expected_Sequence : Segment_Sequence := Segment_Sequence'first;
+         TC_Segment_Total : integer := 0;
+         TC_Expected_Total : integer := 3;
+      begin
+         loop
+            -- Note: normally we would expect this Accept to be in a select 
+            -- with terminate.  For the test we exit the loop on completion
+            -- to give better control
+            accept Input ( Segment : acc_Message_Segment ) do 
+               This_Segment.all := Segment.all;
+            end Input;
+   
+            null;  --::: stub - output the next segment of the message
+
+            -- The following is all test control code
+            --
+            if This_Segment.Seg_Sequence_No /= TC_Expected_Sequence then
+               Report.Failed ("Output_Driver: Segment out of sequence");
+            end if;
+            TC_Expected_Sequence := TC_Expected_Sequence + 1;
+
+            -- Now count the number of segments
+            TC_Segment_Total := TC_Segment_Total + 1;
+
+            -- Check the number and exit loop when complete
+            -- There must be exactly TC_Expected_Total in number and
+            --    the last one must be EOM
+            --    (test will hang if < TC_Expected_Total arrive
+            --    without EOM)
+            if This_Segment.EOM then
+               -- This is the last segment.
+               if TC_Segment_Total /= TC_Expected_Total then
+                  Report.Failed ("EOM and wrong number of segments");
+               end if;
+               exit;   -- the loop and terminate the task
+            elsif TC_Segment_Total = TC_Expected_Total then
+               Report.Failed ("No EOM found");
+               exit;
+            end if;
+         end loop;
+      exception
+         when others => 
+              Report.Failed ("Unexpected Exception in Output_Driver");
+      end Output_Driver;
+
+
+   begin  
+
+      null;
+
+   end; -- encapsulation
+
+   if TC_Failed_1 then
+      Report.Failed ("Requeue did not complete entry body - 1");
+   end if;
+
+   if TC_Failed_2 then
+      Report.Failed ("Requeue did not complete entry body - 2");
+   end if;
+
+   if TC_Failed_3 then
+      Report.Failed ("Sequencer: Segment out of sequence");
+   end if;
+
+   Report.Result;
+   
+end C954022;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954023.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954023.a
new file mode 100644
index 000000000..bfa69dc60
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954023.a
@@ -0,0 +1,558 @@
+-- C954023.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 requeue within a protected entry to a family of entries 
+--     in a different protected object is queued correctly
+--                      Call with parameters
+--                      Requeue with abort
+--
+-- TEST DESCRIPTION: 
+--      One transaction is sent through to check the paths.  After processing
+--      this, the Credit task sets the "overloaded" indicator.  Once this
+--      indicator is set the Distributor (a protected object) queues lower
+--      priority transactions on a family of queues (Wait_for_Underload) in
+--      another protected object using a requeue.  The Distributor still
+--      delivers high priority transactions. After two more high priority
+--      transactions have been processed by the Credit task the artificial
+--      test code clears the overload condition to the threshold level that
+--      allows only the items on the Medium priority queue of the family to be
+--      released.  When these have been processed and checked the test code
+--      then lowers the priority threshold once again, allowing the Low
+--      priority items from the last queue in the family to be released,
+--      processed and checked. Note: the High priority queue in the family is 
+--      not used.   
+--     
+--      This series of tests uses a simulation of a transaction driven
+--      processing system.  Line Drivers accept input from an external source
+--      and build them into transaction records.  These records are then
+--      encapsulated in message tasks which remain extant for the life of the
+--      transaction in the system.  The message tasks put themselves on the
+--      input queue of a Distributor which, from information in the
+--      transaction and/or system load conditions forwards them to other
+--      operating tasks. These in turn might forward the transactions to yet
+--      other tasks for further action.  The routing is, in real life, dynamic
+--      and unpredictable at the time of message generation.  All rerouting in
+--      this  model is done by means of requeues.
+--     
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with ImpDef;
+         
+procedure C954023 is
+
+   -- Artificial: number of messages required for this test
+   subtype TC_Trans_Range is integer range 1..8;
+
+   TC_Credit_Messages_Expected  : constant integer 
+                                          := TC_Trans_Range'Last - 1;
+
+   TC_Debit_Message_Complete    : Boolean := false;
+
+
+   -- Mechanism for handshaking between tasks
+   protected TC_PO is
+      procedure Increment_Tasks_Completed_Count;
+      function  Tasks_Completed_Count return integer;
+      function  First_Message_Has_Arrived return Boolean;
+      procedure  Set_First_Message_Has_Arrived;
+   private
+      Number_Complete : integer := 0;
+         Message_Arrived_Flag  : Boolean := false;
+   end TC_PO;
+   -- 
+   protected body TC_PO is
+      procedure Increment_Tasks_Completed_Count is
+      begin
+         Number_Complete := Number_Complete + 1;
+      end Increment_Tasks_Completed_Count;
+  
+      function Tasks_Completed_Count return integer is
+      begin
+         return Number_Complete;
+      end Tasks_Completed_Count;
+
+      function  First_Message_Has_Arrived return Boolean is
+         begin
+            return Message_Arrived_Flag;
+         end First_Message_Has_Arrived;
+
+      procedure  Set_First_Message_Has_Arrived is
+         begin
+            Message_Arrived_Flag := true;
+      end Set_First_Message_Has_Arrived;
+
+   end TC_PO;
+
+begin
+   
+   Report.Test ("C954023", "Requeue from within a protected object" &
+                      " to a family of entries in another protected object");
+
+ 
+   declare -- encapsulate the test
+   
+      -- Arbitrary test values
+      Credit_Return : constant := 1;
+      Debit_Return  : constant := 2;
+
+      type Transaction_Code is (Credit, Debit);
+      type App_Priority     is (Low, Medium, High);
+      type Priority_Block   is array (App_Priority) of Boolean;
+
+      type Transaction_Record;
+      type acc_Transaction_Record is access Transaction_Record;
+      type Transaction_Record is 
+         record
+            ID               : integer := 0;
+            Code             : Transaction_Code := Debit;
+            Priority         : App_Priority := High;
+            Account_Number   : integer := 0;
+            Stock_Number     : integer := 0;
+            Quantity         : integer := 0;
+            Return_Value     : integer := 0;
+            TC_Message_Count : integer := 0;
+            TC_Thru_Distrib  : Boolean := false;
+         end record;
+   
+   
+      task type Message_Task is 
+         entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+      end Message_Task;
+      type acc_Message_Task is access Message_Task;
+   
+      task Line_Driver is
+         entry Start;
+      end Line_Driver;
+   
+      protected Distributor is
+         procedure Set_Credit_Overloaded;
+         procedure Clear_Overload_to_Medium;
+         procedure Clear_Overload_to_Low;
+         entry     Input (Transaction : acc_Transaction_Record);
+      private
+         Credit_Overloaded : Boolean := false;
+      end Distributor;
+   
+      protected Hold is
+         procedure Release_Medium;
+         procedure Release_Low;
+         -- Family of entry queues indexed by App_Priority
+         entry Wait_for_Underload (App_Priority)
+                                     (Transaction : acc_Transaction_Record);
+      private
+         Release : Priority_Block := (others => false);
+      end Hold;
+   
+      task Credit_Computation is
+         entry Input(Transaction : acc_Transaction_Record);
+      end Credit_Computation;
+   
+      task Debit_Computation is
+         entry Input(Transaction : acc_Transaction_Record);
+      end Debit_Computation;
+   
+      --
+      -- Dispose each input Transaction_Record to the appropriate
+      -- computation tasks
+      --
+      protected body Distributor is
+   
+         procedure Set_Credit_Overloaded is
+         begin
+            Credit_Overloaded := true;
+         end Set_Credit_Overloaded;
+   
+         procedure Clear_Overload_to_Medium is
+         begin
+            Credit_Overloaded := false;
+            Hold.Release_Medium;       -- Release all held messages on Medium
+                                       -- priority queue
+         end Clear_Overload_to_Medium;
+     
+         procedure Clear_Overload_to_Low is
+         begin
+            Credit_Overloaded := false;
+            Hold.Release_Low;          -- Release all held messages on Low
+                                       -- priority queue
+         end Clear_Overload_to_Low;
+     
+   
+   
+         entry Input (Transaction : acc_Transaction_Record)   when true is
+                                                   -- barrier is always open
+         begin
+            -- Test Control: Set the indicator in the message to show it has
+            -- passed through the Distributor object
+            Transaction.TC_thru_Distrib := true;
+    
+            -- Pass this transaction on to the appropriate computation
+            -- task but temporarily hold low-priority transactions under
+            -- overload conditions
+            case Transaction.Code is
+               when Credit =>
+                  if Credit_Overloaded and Transaction.Priority /= High then
+                     -- use the appropriate queue in the family 
+                     requeue Hold.Wait_for_Underload(Transaction.Priority)
+                                                         with abort;
+                  else
+                     requeue Credit_Computation.Input with abort;
+                 end if;
+               when Debit =>
+                 requeue Debit_Computation.Input with abort;
+            end case;
+         end Input;
+      end Distributor;
+   
+   
+      -- Low priority Message tasks are held on the Wait_for_Underload queue
+      -- while the Credit computation system is overloaded.  Once the Credit
+      -- system reached underload send all queued messages immediately
+      --
+      protected body Hold is
+         
+         -- Once these are executed the barrier conditions for the entries
+         -- are evaluated 
+         procedure Release_Medium is
+         begin 
+            Release(Medium) := true;
+         end Release_Medium;
+         --
+         procedure Release_Low is
+         begin 
+            Release(Low) := true;
+         end Release_Low;
+   
+         -- This is a family of entry queues indexed by App_Priority
+         entry Wait_for_Underload  (for AP in App_Priority)
+                                   (Transaction : acc_Transaction_Record)
+                                                when Release(AP) is
+         begin
+            requeue Credit_Computation.Input with abort;
+            if Wait_for_Underload(AP)'count = 0 then
+               -- Queue is purged.  Set up to hold next batch
+               Release(AP) := false;
+            end if; 
+         end Wait_for_Underload;
+   
+      end Hold;
+      
+   
+   
+   
+      -- Assemble messages received from an external source
+      --   Creates a message task for each. The message tasks remain extant
+      --   for the life of the messages in the system.
+      --      The Line Driver task would normally be designed to loop 
+      --      creating the messages as input is received.  Simulate this 
+      --      but limit it to the required number of dummy messages needed for
+      --      this test and allow it to terminate at that point.  Artificially
+      --      cycle the generation of High medium and Low priority Credit 
+      --      transactions for this test. Send out one final Debit message
+      --
+      task body Line_Driver is
+         Current_ID       : integer := 1;
+         Current_Priority : App_Priority := High;      
+   
+         procedure Build_Credit_Record 
+                              ( Next_Transaction : acc_Transaction_Record ) is
+            Dummy_Account : constant integer := 100;
+         begin
+               Next_Transaction.ID := Current_ID;
+               Next_Transaction.Code := Credit; 
+               Next_Transaction.Priority := Current_Priority;
+   
+               Next_Transaction.Account_Number := Dummy_Account;
+               Current_ID := Current_ID + 1;
+         end Build_Credit_Record;     
+   
+   
+         procedure Build_Debit_Record 
+                            ( Next_Transaction : acc_Transaction_Record ) is
+            Dummy_Account : constant integer := 200;
+         begin
+               Next_Transaction.ID := Current_ID;
+               Next_Transaction.Code := Debit; 
+   
+               Next_Transaction.Account_Number := Dummy_Account;
+               Current_ID := Current_ID + 1;
+         end Build_Debit_Record;     
+   
+      begin
+         
+         for Transaction_Numb in TC_Trans_Range loop  -- TC: limit the loop
+            declare 
+               -- Create a task for the next message
+               Next_Message_Task : acc_Message_Task := new Message_Task;
+               -- Create a record for it
+               Next_Transaction : acc_Transaction_Record := 
+                                                   new Transaction_Record;
+            begin
+               if Transaction_Numb = TC_Trans_Range'first then
+                  -- Send the first Credit message
+                  Build_Credit_Record ( Next_Transaction );
+                  Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+                  -- TC: Wait until the first message has been received by the
+                  -- Credit task and it has set the Overload indicator for the 
+                  -- Distributor
+                  while not TC_PO.First_Message_Has_Arrived loop
+                     delay ImpDef.Minimum_Task_Switch;   
+                  end loop;
+               elsif Transaction_Numb = TC_Trans_Range'last then
+                  -- For this test send the last transaction to the Debit task
+                  -- to improve the mix
+                  Build_Debit_Record( Next_Transaction );
+                  Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+               else
+                  -- TC: Cycle generation of  high medium and low priority 
+                  -- transactions
+                  if Current_Priority = High then
+                     Current_Priority := Medium;
+                  elsif  
+                     Current_Priority = Medium then
+                     Current_Priority := Low;
+                  else
+                     Current_Priority := High;
+                  end if;
+                  Build_Credit_Record( Next_Transaction );
+                  Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+               end if;
+            end;   -- declare
+         end loop;
+   
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception in Line_Driver");
+      end Line_Driver;
+   
+      
+   
+   
+      task body Message_Task is
+   
+         TC_Original_Transaction_Code : Transaction_Code;  
+         This_Transaction : acc_Transaction_Record := new Transaction_Record;
+   
+      begin
+         
+         accept Accept_Transaction(In_Transaction : acc_Transaction_Record) do
+            This_Transaction.all := In_Transaction.all;
+         end Accept_Transaction;
+   
+         -- Note the original code to ensure correct return
+         TC_Original_Transaction_Code := This_Transaction.Code;
+    
+         -- Queue up on Distributor's Input queue
+         Distributor.Input ( This_Transaction );
+         -- This task will now wait for the requeued rendezvous 
+         -- to complete before proceeding
+   
+         -- After the required computations have been performed
+         -- return the Transaction_Record appropriately (probably to an output
+         -- line driver)
+         null;            -- stub
+         
+         -- For the test check that the return values are as expected
+         if TC_Original_Transaction_Code /= This_Transaction.Code then
+            -- Incorrect rendezvous
+            Report.Failed ("Message Task: Incorrect code returned");
+         end if;
+   
+         if This_Transaction.Code = Credit then
+            if This_Transaction.Return_Value  /= Credit_Return   or
+            not This_Transaction.TC_thru_Distrib                 then
+               Report.Failed ("Expected path not traversed - Credit");
+            end if;
+            TC_PO.Increment_Tasks_Completed_Count;
+         else
+            if This_Transaction.Return_Value  /= Debit_Return or   
+               This_Transaction.TC_Message_Count /= 1         or
+               not This_Transaction.TC_thru_Distrib           then
+                  Report.Failed ("Expected path not traversed - Debit");
+            end if;
+            TC_Debit_Message_Complete := true;
+         end if;
+   
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception in Message_Task");
+      end Message_Task;
+   
+   
+   
+   
+     
+      -- Computation task.  After the computation is performed the rendezvous
+      -- in the original message task is completed.                              
+      task body Credit_Computation is
+   
+         Message_Count   : integer := 0;
+         
+      begin
+         loop
+            select 
+               accept Input ( Transaction : acc_Transaction_Record) do
+                  
+                  -- Perform the computations required for this transaction
+                  null; -- stub
+   
+                  
+                  -- The following is all Test Control code:
+                 
+                  if not Transaction.TC_thru_Distrib then
+                     Report.Failed 
+                            ("Credit Task: Wrong queue, Distributor bypassed");
+                  end if;
+   
+                  if Transaction.code /= Credit then
+                     Report.Failed
+                         ("Credit Task: Requeue delivered to the wrong queue");
+                  end if;
+   
+                  -- This is checked by the Message_Task:
+                  Transaction.Return_Value := Credit_Return;
+   
+                  -- Now take special action depending on which Message.
+                  -- Note: The count gives the order in which the messages are
+                  --       arriving at this task NOT the order in which they
+                  --       were originally generated and sent out.
+   
+                  Message_Count := Message_Count + 1;
+   
+                  if Message_Count < 4 then 
+                     -- This is one of the first three messages which must 
+                     -- be High priority because we will set "Overload" after 
+                     -- the first, which is known to be High. The lower
+                     -- priority should be waiting on the queues
+                     if Transaction.Priority /= High then  
+                     Report.Failed 
+                        ("Credit Task: Lower priority trans. during overload");
+                     end if;
+                     if Message_Count = 1 then 
+                        -- After the first message :
+                        Distributor.Set_Credit_Overloaded;
+                        -- Now flag the Line_Driver that the second and 
+                        -- subsequent messages may now be sent
+                        TC_PO.Set_First_Message_Has_Arrived;
+                     elsif
+                        Message_Count = 3 then
+                        -- The two high priority transactions created 
+                        -- subsequent to the overload have now been processed,
+                        --  release the Medium priority items
+                        Distributor.Clear_Overload_to_Medium; 
+                     end if;
+                  elsif Message_Count < 6 then
+                     -- This must be one of the Medium priority messages
+                     if Transaction.Priority /= Medium then  
+                     Report.Failed 
+                           ("Credit Task: Second group not Medium Priority");
+                     end if;
+                     if Message_Count = 5 then 
+                        -- The two medium priority transactions
+                        -- have now been processed - release the
+                        -- Low priority items
+                        Distributor.Clear_Overload_to_Low; 
+                     end if;
+                  elsif Message_Count < TC_Trans_Range'Last then
+                     -- This must be one of the Low priority messages
+                     if Transaction.Priority /= Low then  
+                     Report.Failed 
+                           ("Credit Task: Third group not Low Priority");
+                     end if;
+                  else
+                     -- Too many transactions have arrived.  Duplicates?
+                     -- the Debit transaction?
+                     Report.Failed 
+                           ("Credit Task: Too many transactions");
+                  end if;
+               end Input;            
+            or
+               terminate;
+            end select;
+         end loop;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception in Credit_Computation");
+      end Credit_Computation;
+   
+   
+   
+      -- Computation task.  After the computation is performed the rendezvous
+      -- in the original message task is completed.        
+      --                      
+      task body Debit_Computation is
+         Message_Count   : integer := 0;
+      begin
+         loop
+            select
+               accept Input (Transaction : acc_Transaction_Record) do
+                  -- Perform the computations required for this message
+                  null;      -- stub
+   
+                  -- For the test: 
+                  if not Transaction.TC_thru_Distrib then
+                     Report.Failed 
+                         ("Debit Task: Wrong queue, Distributor bypassed");
+                  end if;
+                  if Transaction.code /= Debit then
+                     Report.Failed
+                         ("Debit Task: Requeue delivered to the wrong queue");
+                  end if;
+   
+                  -- for the test plug a known value and count
+                  Transaction.Return_Value := Debit_Return;
+                  -- one, and only one, message should pass through
+                  Message_Count := Message_Count + 1;
+                  Transaction.TC_Message_Count := Message_Count;
+               end Input;            
+            or
+               terminate;
+            end select;
+         end loop;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception in Debit_Computation");
+      end Debit_Computation;
+   
+
+   begin -- declare 
+
+      null;
+
+   end; -- declare (test encapsulation)
+
+   if (TC_PO.Tasks_Completed_Count /= TC_Credit_Messages_Expected) 
+                                    and not TC_Debit_Message_Complete then
+      Report.Failed ("Incorrect number of Message Tasks completed");
+   end if;
+
+   Report.Result;
+
+end C954023;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954024.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954024.a
new file mode 100644
index 000000000..7f19a8183
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954024.a
@@ -0,0 +1,380 @@
+-- C954024.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 call to a protected entry can be requeued to a task
+--      entry. Check that the requeue is placed on the correct entry; that the
+--      original caller waits for the completion of the requeue and continues
+--      after the requeued rendezvous.  Check that the requeue does not block.
+--      Specifically, check a requeue without abort from a protected entry to
+--      an entry in a task.
+--
+-- TEST DESCRIPTION:
+--      In the Distributor protected object, requeue two successive calls on
+--      the entries of two separate target tasks.  Each task in each of the 
+--      paths adds identifying information in the transaction being passed. 
+--      This information is checked by the Message tasks on completion
+--      ensuring that the requeues have been placed on the correct queues.
+--      There is an artificial guard on the Credit Task to ensure that the
+--      input is queued; this guard is released by the Debit task which 
+--      handles its input immediately.  This ensures that we have one of the
+--      requeued items actually queued for later handling and also verifies
+--      that the requeuing process (in the protected object) is not blocked.
+--
+--      This series of tests uses a simulation of a transaction driven 
+--      processing system.  Line Drivers accept input from an external source
+--      and build them into transaction records.  These records are then 
+--      encapsulated in message tasks which remain extant for the life of the
+--      transaction in the system. The message tasks put themselves on the 
+--      input queue of a Distributor object which, from information in the
+--      transaction and/or system load conditions forwards them to other 
+--      operating tasks. These in turn might forward the transactions to yet 
+--      other tasks for further action.  The routing is, in real life, 
+--      dynamic and unpredictable at the time of message generation. All 
+--      rerouting in this  model is done by means of requeues.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      08 Nov 95   SAIC    Fixed reported problems for ACVC 2.0.1
+--
+--!
+
+with Report;
+with ImpDef;         
+procedure C954024 is
+    
+   
+begin -- C954024
+
+   Report.Test ("C954024", "Requeue from protected entry to task entry");
+
+   declare -- encapsulate the test
+
+      -- Arbitrary test values
+      Credit_Return : constant := 1;
+      Debit_Return  : constant := 2;
+   
+      type Transaction_Code is (Credit, Debit);
+   
+      type Transaction_Record;
+      type acc_Transaction_Record is access Transaction_Record;
+      type Transaction_Record is 
+         record
+            ID               : integer := 0;
+            Code             : Transaction_Code := Debit;
+            Account_Number   : integer := 0;
+            Stock_Number     : integer := 0;
+            Quantity         : integer := 0;
+            Return_Value     : integer := 0;
+            TC_Message_Count : integer := 0;       
+            TC_Thru_Dist     : Boolean := false;
+         end record;
+   
+   
+      task type Message_Task is 
+         entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
+      end Message_Task;
+      type acc_Message_Task is access Message_Task;
+   
+      task Line_Driver is 
+         entry Start;
+      end Line_Driver;   
+   
+      task Credit_Computation is
+         entry Input(Transaction : acc_Transaction_Record);
+      end Credit_Computation;
+   
+      task Debit_Computation is
+         entry Input(Transaction : acc_Transaction_Record);
+      end Debit_Computation;
+   
+      protected Time_Lock is
+         procedure Credit_Start;
+         function  Credit_Enabled return Boolean;
+      private
+         Credit_OK : Boolean := false;
+      end Time_Lock;
+   
+      protected body Time_Lock is
+         procedure Credit_Start is
+         begin
+            Credit_OK := true;
+         end Credit_Start;
+   
+         function  Credit_Enabled return Boolean is 
+         begin
+            return Credit_OK;
+         end Credit_Enabled;
+      end Time_Lock;
+   
+   
+   
+      protected Distributor is
+         entry Input (Transaction : acc_Transaction_Record);
+      end Distributor;
+      --
+      --
+      -- Dispose each input Transaction_Record to the appropriate
+      -- computation tasks
+      --
+      protected body Distributor is
+         entry Input (Transaction : acc_Transaction_Record) when true is
+                                                   -- barrier is always open
+         begin
+            -- Test Control: Set the indicator in the message to show it has
+            -- passed through the Distributor object
+            Transaction.TC_thru_Dist := true;
+                
+            -- Pass this transaction on to the appropriate computation
+            -- task
+            case Transaction.Code is
+               when Credit =>
+                  requeue Credit_Computation.Input;
+               when Debit =>
+                  requeue Debit_Computation.Input;
+            end case;
+         end Input;
+      end Distributor;
+   
+   
+   
+   
+      -- Assemble messages received from an external source
+      --   Creates a message task for each. The message tasks remain extant
+      --   for the life of the messages in the system.
+      --   NOTE:
+      --   The Line Driver task would normally be designed to loop continuously
+      --   creating the messages as input is received.  Simulate this 
+      --   but limit it to two dummy messages for this test and allow it
+      --   to terminate at that point
+      --
+      task body Line_Driver is
+         Current_ID : integer := 1;
+         TC_Last_was_for_credit : Boolean := false;
+   
+         procedure Build_Credit_Record 
+                          ( Next_Transaction : acc_Transaction_Record ) is
+            Dummy_Account : constant integer := 100;
+         begin
+               Next_Transaction.ID := Current_ID;
+               Next_Transaction.Code := Credit; 
+   
+               Next_Transaction.Account_Number := Dummy_Account;
+               Current_ID := Current_ID + 1;
+         end Build_Credit_Record;     
+   
+   
+         procedure Build_Debit_Record 
+                          ( Next_Transaction : acc_Transaction_Record ) is
+            Dummy_Account : constant integer := 200;
+         begin
+               Next_Transaction.ID := Current_ID;
+               Next_Transaction.Code := Debit; 
+   
+               Next_Transaction.Account_Number := Dummy_Account;
+               Current_ID := Current_ID + 1;
+         end Build_Debit_Record;     
+   
+      begin
+   
+         accept Start;      -- Wait for trigger from Main
+   
+         for i in 1..2 loop  -- arbitrarily limit to two messages for the test
+            declare 
+               -- Create a task for the next message
+               Next_Message_Task : acc_Message_Task := new Message_Task;
+               -- Create a record for it
+               Next_Transaction : acc_Transaction_Record 
+                                                    := new Transaction_Record;
+            begin
+               if TC_Last_was_for_credit then
+                  Build_Debit_Record ( Next_Transaction );            
+               else
+                  Build_Credit_Record( Next_Transaction );
+                  TC_Last_was_for_credit := true;
+               end if;
+               Next_Message_Task.Accept_Transaction ( Next_Transaction );  
+            end;   -- declare
+         end loop;
+   
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception in Line_Driver");
+      end Line_Driver;
+   
+      
+   
+   
+      task body Message_Task is
+   
+         TC_Original_Transaction_Code : Transaction_Code;  
+         This_Transaction : acc_Transaction_Record := new Transaction_Record;
+   
+      begin
+         accept Accept_Transaction
+                            (In_Transaction : acc_Transaction_Record) do
+            This_Transaction.all := In_Transaction.all;
+         end Accept_Transaction;
+   
+         -- Note the original code to ensure correct return
+         TC_Original_Transaction_Code := This_Transaction.Code;
+    
+         -- Queue up on Distributor's Input queue
+         Distributor.Input ( This_Transaction );
+         -- This task will now wait for the requeued rendezvous 
+         -- to complete before proceeding
+   
+         -- After the required computations have been performed
+         -- return the Transaction_Record appropriately (probably to an output
+         -- line driver)
+         null;            -- stub
+   
+         
+         -- The following is all Test Control Code
+   
+         -- Check that the return values are as expected
+         if TC_Original_Transaction_Code /= This_Transaction.Code then
+            -- Incorrect rendezvous
+            Report.Failed ("Message Task: Incorrect code returned");
+         end if;
+   
+         if This_Transaction.Code = Credit then
+            if This_Transaction.Return_Value     /= Credit_Return or   
+               This_Transaction.TC_Message_Count /= 1             or 
+               not This_Transaction.TC_thru_Dist       then
+                  Report.Failed ("Expected path not traversed");
+            end if;
+         else
+            if This_Transaction.Return_Value  /= Debit_Return or   
+               This_Transaction.TC_Message_Count /= 1         or 
+               not This_Transaction.TC_thru_Dist       then
+                  Report.Failed ("Expected path not traversed");
+            end if;
+         end if;
+   
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception in Message_Task");
+   
+      end Message_Task;
+   
+   
+   
+      -- Computation task.
+      --   Note:  After the computation is performed in this task and the 
+      --          accept body is completed the rendezvous in the original
+      --          message task is completed.                              
+      --                                           
+      task body Credit_Computation is
+         Message_Count   : integer := 0;
+      begin
+         loop
+            select 
+               when  Time_Lock.Credit_enabled =>
+               accept Input ( Transaction : acc_Transaction_Record) do
+                  -- Perform the computations required for this transaction
+                  null;      -- stub
+   
+                  -- For the test: 
+                  if not Transaction.TC_thru_Dist then
+                     Report.Failed 
+                          ("Credit Task: Wrong queue, Distributor bypassed");
+                  end if;
+                  if Transaction.code /= Credit then
+                     Report.Failed
+                       ("Credit Task: Requeue delivered to the wrong queue");
+                  end if;
+   
+                  -- for the test plug a known value and count
+                  Transaction.Return_Value := Credit_Return;
+                  -- one, and only one message should pass through
+                  Message_Count := Message_Count + 1;
+                  Transaction.TC_Message_Count := Message_Count;
+               end Input;            
+               exit;  -- one message is enough
+            else
+               delay ImpDef.Clear_Ready_Queue;  -- poll
+            end select;
+         end loop;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception in Credit_Computation");
+      end Credit_Computation;
+   
+   
+   
+      -- Computation task.
+      --   Note:  After the computation is performed in this task and the 
+      --          accept body is completed the rendezvous in the original
+      --          message task is completed.                              
+      --                                                
+      task body Debit_Computation is
+         Message_Count   : integer := 0;
+      begin
+         loop
+            select
+               accept Input (Transaction : acc_Transaction_Record) do
+                  -- Perform the computations required for this message
+                  null;      -- stub
+   
+                  -- For the test: 
+                  if not Transaction.TC_thru_Dist then
+                     Report.Failed
+                            ("Debit Task: Wrong queue, Distributor bypassed");
+                  end if;
+                  if Transaction.code /= Debit then
+                     Report.Failed
+                         ("Debit Task: Requeue delivered to the wrong queue");
+                  end if;
+   
+                  -- for the test plug a known value and count
+                  Transaction.Return_Value := Debit_Return;
+                  -- one, and only one, message should pass through
+                  Message_Count := Message_Count + 1;
+                  Transaction.TC_Message_Count := Message_Count;
+                  -- for the test: once we have completed the only Debit
+                  -- message release the Credit Messages which are queued
+                  -- on the Credit Input queue
+                  Time_Lock.Credit_Start;
+                  
+               end Input;            
+            or
+               terminate;
+            end select;
+         end loop;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception in Debit_Computation");
+   
+      end Debit_Computation;
+   
+   begin -- declare block
+      Line_Driver.Start;
+   end;  -- test encapsulation
+
+   Report.Result;
+
+end C954024;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954025.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954025.a
new file mode 100644
index 000000000..c4993f7ed
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954025.a
@@ -0,0 +1,237 @@
+-- C954025.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 the original entry call was a conditional entry call,
+--      the call is cancelled if a requeue-with-abort of the call is not
+--      selected immediately.
+--      Check that if the original entry call was a timed entry call, the 
+--      expiration time for a requeue-with-abort is the original expiration 
+--      time.
+--
+-- TEST DESCRIPTION:
+--      This test declares two tasks: Launch_Control and Mission_Control.
+--      Mission_Control instructs Launch_Control to start its countdown
+--      and then requeues (with abort) to the Launch_Control.Launch 
+--      entry.  This call to Launch will be accepted at the end of the
+--      countdown (if the task is still waiting).
+--      The main task does an unconditional, conditional, and timed 
+--      entry call to Mission_Control and checks to see if the launch
+--      was accepted.
+--
+--
+-- CHANGE HISTORY:
+--      18 OCT 95   SAIC    ACVC 2.1
+--      10 JUL 96   SAIC    Incorporated reviewer's comments.
+--
+--!
+
+with Calendar;   use type Calendar.Time;
+with Report;
+with ImpDef;
+procedure C954025 is
+  Verbose : constant Boolean := False;
+  Countdown_Amount : constant Duration := 2.0 * Impdef.One_Long_Second;
+  Plenty_Of_Time : constant Duration := 
+         Countdown_Amount + ImpDef.Clear_Ready_Queue + 1.0 * Impdef.One_Long_Second;
+  Not_Enough_Time : constant Duration :=
+         Countdown_Amount - 0.5 * Impdef.One_Long_Second;
+begin
+  Report.Test ("C954025",
+               "Check that if the original entry" &
+               " call was a conditional or timed entry call, the" &
+               " expiration time for a requeue with abort is the" &
+               " original expiration time");
+  declare
+     -- note that the following object is a shared object and its use
+     -- governed by the rules of 9.10(3,4,8);6.0
+     Launch_Accepted : Boolean := False;
+
+     task Launch_Control is
+        entry Enable_Launch_Control;
+        entry Start_Countdown (How_Long : Duration);
+        -- Launch will be accepted if a call is waiting when the countdown
+        -- reaches 0
+        entry Launch;
+     end Launch_Control;
+
+     task body Launch_Control is
+        Wait_Amount : Duration := 0.0;
+     begin
+        loop
+           select
+              accept Enable_Launch_Control do
+                 Launch_Accepted := False;
+              end Enable_Launch_Control;
+           or
+              terminate;
+           end select;
+
+           accept Start_Countdown (How_Long : Duration) do
+                 Wait_Amount := How_Long;
+           end Start_Countdown;
+
+           delay Wait_Amount;
+
+           select
+              accept Launch do
+                 Launch_Accepted := True;
+              end Launch;
+           else
+              null;
+              -- note that Launch_Accepted is False here
+           end select;
+        end loop;
+     end Launch_Control;
+
+     task Mission_Control is
+        --  launch will occur if we are given enough time to complete
+        --  a standard countdown.  We will not be rushed!
+        entry Do_Launch;
+     end Mission_Control;
+
+     task body Mission_Control is
+     begin
+        loop
+           select
+              accept Do_Launch do
+                 Launch_Control.Start_Countdown (Countdown_Amount);
+                 requeue Launch_Control.Launch with abort;
+              end Do_Launch;
+           or
+              terminate;
+           end select;
+        end loop;
+     end Mission_Control;
+     
+  begin   -- test encapsulation
+     -- unconditional entry call to check the simple case
+     Launch_Control.Enable_Launch_Control;
+     Mission_Control.Do_Launch;
+     if Launch_Accepted then
+        if Verbose then
+           Report.Comment ("simple case passed");
+        end if;
+      else
+         Report.Failed ("simple case");
+      end if;
+
+  
+     -- timed but with plenty of time - delay relative
+     Launch_Control.Enable_Launch_Control;
+     select
+        Mission_Control.Do_Launch;
+     or 
+        delay Plenty_Of_Time;
+        if Launch_Accepted then
+           Report.Failed ("plenty of time timed out after accept (1)");
+        end if;
+     end select;
+     if Launch_Accepted then
+        if Verbose then
+           Report.Comment ("plenty of time case passed (1)");
+        end if;
+      else
+         Report.Failed ("plenty of time (1)");
+      end if;
+
+  
+     -- timed but with plenty of time  -- delay until
+     Launch_Control.Enable_Launch_Control;
+     select
+        Mission_Control.Do_Launch;
+     or 
+        delay until Calendar.Clock + Plenty_Of_Time;
+        if Launch_Accepted then
+           Report.Failed ("plenty of time timed out after accept(2)");
+        end if;
+     end select;
+     if Launch_Accepted then
+        if Verbose then
+           Report.Comment ("plenty of time case passed (2)");
+        end if;
+      else
+         Report.Failed ("plenty of time (2)");
+      end if;
+
+  
+     -- timed without enough time - delay relative
+     Launch_Control.Enable_Launch_Control;
+     select
+        Mission_Control.Do_Launch;
+        Report.Failed ("not enough time completed accept (1)");
+     or 
+        delay Not_Enough_Time;
+     end select;
+     if Launch_Accepted then
+        Report.Failed ("not enough time (1)");
+      else
+        if Verbose then
+           Report.Comment ("not enough time case passed (1)");
+        end if;
+      end if;
+
+  
+     -- timed without enough time - delay until
+     Launch_Control.Enable_Launch_Control;
+     select
+        Mission_Control.Do_Launch;
+        Report.Failed ("not enough time completed accept (2)");
+     or 
+        delay until Calendar.Clock + Not_Enough_Time;
+     end select;
+     if Launch_Accepted then
+        Report.Failed ("not enough time (2)");
+      else
+        if Verbose then
+           Report.Comment ("not enough time case passed (2)");
+        end if;
+      end if;
+
+  
+     -- conditional case
+     Launch_Control.Enable_Launch_Control;
+     -- make sure Mission_Control is ready to accept immediately
+     delay ImpDef.Clear_Ready_Queue; 
+     select
+        Mission_Control.Do_Launch;
+        Report.Failed ("no time completed accept");
+     else
+        if Verbose then
+           Report.Comment ("conditional case - else taken");
+         end if;
+     end select;
+     if Launch_Accepted then
+        Report.Failed ("no time");
+      else
+        if Verbose then
+           Report.Comment ("no time case passed");
+        end if;
+      end if;
+
+  end;
+
+  Report.Result;
+end C954025;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954026.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954026.a
new file mode 100644
index 000000000..9e261247b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954026.a
@@ -0,0 +1,269 @@
+-- C954026.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 the original protected entry call was a conditional
+--      entry call, the call is cancelled if a requeue-with-abort of the 
+--      call is not selected immediately.
+--      Check that if the original protected entry call was a timed entry 
+--      call, the expiration time for a requeue-with-abort is the original 
+--      expiration time.
+--
+-- TEST DESCRIPTION:
+--      In this test the main task makes a variety of calls to the protected
+--      object Initial_PO.  These calls include a simple call, a conditional 
+--      call, and a timed call.  The timed calls include calls with enough
+--      time and those with less than the needed amount of time to get through
+--      the requeue performed by Initial_PO.
+--      Initial_PO requeues its entry call to Final_PO.
+--      Final_PO does not accept the requeued call until the protected 
+--      procedure Ok_To_Take_Requeue is called.
+--      A separate task, Delayed_Opener, is used to call Ok_To_Take_Requeue
+--      after a delay amount specified by the main task has expired. 
+--
+--
+-- CHANGE HISTORY:
+--      15 DEC 95   SAIC    ACVC 2.1
+--      10 JUL 96   SAIC    Incorporated reviewer comments.
+--      10 OCT 96   SAIC    Incorporated fix provided by vendor.
+--
+--!
+
+with Calendar;
+use type Calendar.Time;
+with Report;
+with Impdef;
+procedure C954026 is
+    Verbose : constant Boolean := False;
+    Final_Po_Reached : Boolean := False;
+    Allowed_Time : constant Duration := 2.0 * Impdef.One_Long_Second;
+    Plenty_Of_Time : constant Duration :=
+       Allowed_Time + Impdef.Clear_Ready_Queue + 1.0 * Impdef.One_Long_Second;
+    Not_Enough_Time : constant Duration := Allowed_Time - 0.5 * Impdef.One_Long_Second;
+begin
+    Report.Test ("C954026",
+                 "Check that if the original entry" &
+                    " call was a conditional or timed entry call," &
+                    " the expiration time for a requeue with" &
+                    " abort to a protected" &
+                    " entry is the original expiration time");
+    declare
+
+        protected Initial_Po is
+            entry Start_Here;
+        end Initial_Po;
+
+        protected Final_Po is
+            entry Requeue_Target;
+            procedure Ok_To_Take_Requeue;
+            procedure Close_Requeue;
+        private
+            Open : Boolean := False;
+        end Final_Po;
+
+        -- the Delayed_Opener task is used to notify Final_PO that it can
+        -- accept the Requeue_Target entry.
+        task Delayed_Opener is
+            entry Start_Timer (Amt : Duration);
+            entry Cancel_Timer;
+        end Delayed_Opener;
+
+        task body Delayed_Opener is
+            Wait_Amt : Duration;
+        begin
+            loop
+                accept Start_Timer (Amt : Duration) do
+                    Wait_Amt := Amt;
+                end Start_Timer;
+                exit when Wait_Amt < 0.0;
+                if Verbose then
+                    Report.Comment ("Timer started");
+                end if;
+                select
+                    accept Cancel_Timer do
+                        Final_Po.Close_Requeue;
+                    end Cancel_Timer;   
+                or              
+                    delay Wait_Amt;
+                    Final_Po.Ok_To_Take_Requeue;
+                    accept Cancel_Timer do
+                        Final_Po.Close_Requeue;
+                    end Cancel_Timer;   
+                end select;     
+            end loop;
+        exception
+            when others =>
+                Report.Failed ("exception in Delayed_Opener");
+        end Delayed_Opener;
+
+        protected body Initial_Po is
+            entry Start_Here when True is
+            begin
+                Final_Po_Reached := False;
+                requeue Final_Po.Requeue_Target with abort;
+            end Start_Here;
+        end Initial_Po;
+
+        protected body Final_Po is
+            entry Requeue_Target when Open is
+            begin
+                Open := False;
+                Final_Po_Reached := True;
+            end Requeue_Target;
+
+            procedure Ok_To_Take_Requeue is
+            begin
+                Open := True;
+            end Ok_To_Take_Requeue;
+
+            procedure Close_Requeue is          
+            begin                       
+                Open := False;  
+            end Close_Requeue;
+        end Final_Po;
+
+    begin   -- test encapsulation
+        -- unconditional entry call to check the simple case
+        Delayed_Opener.Start_Timer (0.0);
+        Initial_Po.Start_Here;
+        if Final_Po_Reached then
+            if Verbose then
+                Report.Comment ("simple case passed");
+            end if;
+        else
+            Report.Failed ("simple case");
+        end if;
+        Delayed_Opener.Cancel_Timer;
+
+
+        -- timed but with plenty of time - delay relative
+        Delayed_Opener.Start_Timer (Allowed_Time);
+        select
+            Initial_Po.Start_Here;
+        or
+            delay Plenty_Of_Time;
+            Report.Failed ("plenty of time timed out (1)");
+            if Final_Po_Reached then
+                Report.Failed (
+                   "plenty of time timed out after accept (1)");
+            end if;
+        end select;
+        if Final_Po_Reached then
+            if Verbose then
+                Report.Comment ("plenty of time case passed (1)");
+            end if;
+        else
+            Report.Failed ("plenty of time (1)");
+        end if;
+        Delayed_Opener.Cancel_Timer;
+
+
+        -- timed but with plenty of time  -- delay until
+        Delayed_Opener.Start_Timer (Allowed_Time);
+        select
+            Initial_Po.Start_Here;
+        or
+            delay until Calendar.Clock + Plenty_Of_Time;
+            Report.Failed ("plenty of time timed out (2)");
+            if Final_Po_Reached then
+                Report.Failed (
+                  "plenty of time timed out after accept(2)");
+            end if;
+        end select;
+        if Final_Po_Reached then
+            if Verbose then
+                Report.Comment ("plenty of time case passed (2)");
+            end if;
+        else
+            Report.Failed ("plenty of time (2)");
+        end if;
+        Delayed_Opener.Cancel_Timer;
+
+
+        -- timed without enough time - delay relative
+        Delayed_Opener.Start_Timer (Allowed_Time);
+        select
+            Initial_Po.Start_Here;
+            Report.Failed ("not enough time completed accept (1)");
+        or
+            delay Not_Enough_Time;
+        end select;
+        if Final_Po_Reached then
+            Report.Failed ("not enough time (1)");
+        else
+            if Verbose then
+                Report.Comment ("not enough time case passed (1)");
+            end if;
+        end if;
+        Delayed_Opener.Cancel_Timer;
+
+
+        -- timed without enough time - delay until
+        Delayed_Opener.Start_Timer (Allowed_Time);
+        select
+            Initial_Po.Start_Here;
+            Report.Failed ("not enough time completed accept (2)");
+        or
+            delay until Calendar.Clock + Not_Enough_Time;
+        end select;
+        if Final_Po_Reached then
+            Report.Failed ("not enough time (2)");
+        else
+            if Verbose then
+                Report.Comment ("not enough time case passed (2)");
+            end if;
+        end if;
+        Delayed_Opener.Cancel_Timer;
+
+
+        -- conditional case
+        Delayed_Opener.Start_Timer (Allowed_Time);
+        select
+            Initial_Po.Start_Here;
+            Report.Failed ("no time completed accept");
+        else
+            if Verbose then
+                Report.Comment ("conditional case - else taken");
+            end if;
+        end select;
+        if Final_Po_Reached then
+            Report.Failed ("no time");
+        else
+            if Verbose then
+                Report.Comment ("no time case passed");
+            end if;
+        end if;
+        Delayed_Opener.Cancel_Timer;
+
+        -- kill off the Delayed_Opener task
+        Delayed_Opener.Start_Timer (-10.0);
+
+    exception
+        when others =>
+            Report.Failed ("exception in main");
+    end;
+
+    Report.Result;
+end C954026;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954a01.a
new file mode 100644
index 000000000..3ea545a8f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954a01.a
@@ -0,0 +1,262 @@
+-- C954A01.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 task requeued without abort on a protected entry queue
+--      is aborted, the abort is deferred until the entry call completes,
+--      after which the task becomes completed.
+--
+-- TEST DESCRIPTION:
+--      Declare a protected type which simulates a printer device driver
+--      (foundation code).
+--
+--      Declare a task which simulates a printer server for multiple printers.
+--
+--      For the protected type, declare an entry with a barrier that is set
+--      false by a protected procedure (which simulates starting a print job
+--      on the printer), and is set true by a second protected procedure (which
+--      simulates a handler called when the printer interrupts, indicating
+--      that printing is done).
+--
+--      For the task, declare an entry whose corresponding accept statement
+--      contains a call to first protected procedure of the protected type
+--      (which sets the barrier of the protected entry to false), followed by
+--      a requeue with abort to the protected entry. Declare a second entry
+--      which does nothing.
+--
+--      Declare a "requesting" task which calls the printer server task entry
+--      (and thus executes the requeue). Attempt to abort the requesting
+--      task. Verify that it is not aborted. Call the second protected
+--      procedure of the protected type (the interrupt handler) and verify that
+--      the protected entry completes for the requesting task. Verify that
+--      the requesting task is then aborted.
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         F954A00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Oct 96   SAIC    Added pragma elaborate.
+--
+--!
+
+package C954A01_0 is  -- Printer server abstraction.
+
+   -- Simulate a system with multiple printers. The entry Print requests
+   -- that data be printed on the next available printer. The entry call
+   -- is accepted when a printer is available, and completes when printing
+   -- is done.
+
+
+   task Printer_Server is
+      entry Print (File_Name : String);        -- Test the requeue statement.
+      entry Verify_Results;                    -- Artifice for test purposes.
+   end Printer_Server;
+
+end C954A01_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with F954A00;              -- Printer device abstraction.
+use  F954A00;
+pragma Elaborate(F954A00);
+
+package body C954A01_0 is  -- Printer server abstraction.
+
+   task body Printer_Server is
+      Printers_Busy  : Boolean    := True;
+      Index          : Printer_ID := 1;
+      Print_Accepted : Boolean    := False;
+   begin
+
+      loop
+         -- Wait for a printer to become available:
+
+         while Printers_Busy loop
+            Printers_Busy := False;                        -- Exit loop if
+                                                           -- entry accepted.
+            select
+               Printer(Index).Done_Printing;               -- Accepted immed.
+                                                           -- when printer is
+                                                           -- available.
+            else
+               Index := 1 + (Index mod Number_Of_Printers);-- Entry not immed.
+               Printers_Busy := True;                      -- accepted; keep
+            end select;                                    -- looping.
+         end loop;
+                                                           -- Value of Index
+                                                           -- at loop exit
+                                                           -- identifies the
+                                                           -- avail. printer.
+
+         -- Wait for a print request or terminate:
+
+         select
+            accept Print (File_Name : String) do
+               Print_Accepted := True;                     -- Allow
+                                                           -- Verify_Results
+                                                           -- to be accepted.
+
+               Printer(Index).Start_Printing (File_Name);  -- Begin printing on
+                                                           -- the available
+               --                        --                -- printer.
+               -- Requeue is tested here --
+               --                        --
+                                                           -- Requeue caller so
+               requeue Printer(Index).Done_Printing;       -- server task free
+                                                           -- to accept other
+            end Print;                                     -- requests.
+         or
+            --  Guard ensures that Verify_Results cannot be accepted
+            --  until after Print has been accepted. This avoids a
+            --  race condition in the main program.
+
+            when Print_Accepted => accept Verify_Results;  -- Artifice for
+                                                           -- testing purposes.
+         or
+            terminate;
+         end select;
+
+         -- Allow other tasks to get control
+         delay ImpDef.Long_Minimum_Task_Switch;
+
+      end loop;
+
+   exception
+      when others =>
+         Report.Failed ("Exception raised in Printer_Server task");
+   end Printer_Server;
+
+
+end C954A01_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with F954A00;    -- Printer device abstraction.
+with C954A01_0;  -- Printer server abstraction.
+
+use  C954A01_0;
+use  F954A00;
+
+procedure C954A01 is
+
+   Long_Enough : constant Duration := ImpDef.Long_Switch_To_New_Task;
+
+               --==============================================--
+
+   task Print_Request;                       -- Send a print request.
+
+   task body Print_Request is
+      My_File : constant String := "MYFILE.DAT";
+   begin
+      Printer_Server.Print (My_File);          -- Invoke requeue statement.
+      Report.Failed ("Task continued execution following entry call");
+   exception
+      when others =>
+         Report.Failed ("Exception raised in Print_Request task");
+   end Print_Request;
+
+               --==============================================--
+
+begin  -- Main program.
+
+   Report.Test ("C954A01", "Requeue without abort - check that the abort " &
+            "is deferred until after the rendezvous completes. (Task to PO)");
+
+   --  To pass this test, the following must be true:
+   -- 
+   --     (A) The abort of Print_Request is deferred until after the
+   --         Done_Printing entry body completes.
+   --     (B) Print_Request aborts after the Done_Printing entry call
+   --         completes.
+   -- 
+   --  Call the entry Verify_Results. The entry call will not be accepted
+   --  until after Print_Request has been requeued to Done_Printing.
+
+   Printer_Server.Verify_Results;           -- Accepted after Print_Request is
+                                            -- requeued to Done_Printing.
+
+   -- Simulate an application which needs access to the printer within
+   -- a specified time, and which aborts the current printer job if time
+   -- runs out.
+
+   select
+      Printer(1).Done_Printing;             -- Wait for printer to come free.
+   or
+      delay Long_Enough;                    -- Print job took too long.
+      abort Print_Request;                  -- Abort print job.
+   end select;
+
+   Printer_Server.Verify_Results;           -- Abortion completion point: force
+                                            -- abort to complete (if it's going
+                                            -- to).
+
+   --  Verify that the Done_Printing entry body has not yet completed,
+   --  and thus that Print_Request has not been aborted.
+
+   if Printer(1).Is_Done then
+      Report.Failed ("Target entry of requeue executed prematurely");
+   elsif Print_Request'Terminated then
+      Report.Failed ("Caller was aborted before entry was complete");
+   else
+
+      Printer(1).Handle_Interrupt;          -- Simulate a printer interrupt,
+                                            -- signaling that printing is
+                                            -- done.
+
+      --  The Done_Printing entry body will complete before the next protected
+      --  action is called (Printer(1).Is_Done). Verify (A) and (B): that the
+      --  Print_Request is aborted.
+
+      Printer_Server.Verify_Results;        -- Abortion completion point: force
+                                            -- Print_Request abort to complete.
+
+      if not Printer(1).Is_Done then
+         Report.Failed ("Target entry of requeue did not complete");
+      end if;
+
+      if not Print_Request'Terminated then
+         Report.Failed ("Task not aborted following completion of entry call");
+         abort Print_Request;               -- Try to kill hung task.
+      end if;
+
+   end if;
+
+   Report.Result;
+
+end C954A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954a02.a
new file mode 100644
index 000000000..7d61aea8c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954a02.a
@@ -0,0 +1,259 @@
+-- C954A02.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 task requeued with abort on a protected entry queue
+--      is aborted, the protected entry call is canceled and the aborted
+--      task becomes completed.
+--
+-- TEST DESCRIPTION:
+--      Declare a protected type which simulates a printer device driver
+--      (foundation code).
+--
+--      Declare a task which simulates a printer server for multiple printers.
+--
+--      For the protected type, declare an entry with a barrier that is set
+--      false by a protected procedure (which simulates starting a print job
+--      on the printer), and is set true by a second protected procedure (which
+--      simulates a handler called when the printer interrupts, indicating
+--      that printing is done).
+--
+--      For the task, declare an entry whose corresponding accept statement
+--      contains a call to first protected procedure of the protected type
+--      (which sets the barrier of the protected entry to false), followed by
+--      a requeue with abort to the protected entry. Declare a second entry
+--      which does nothing.
+--
+--      Declare a "requesting" task which calls the printer server task entry
+--      (and thus executes the requeue). Attempt to abort the requesting
+--      task. Verify that it is aborted, that the requeued entry call is
+--      canceled, and that the corresponding entry body is not executed.
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         F954A00.A
+--
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Oct 96   SAIC    Added pragma elaborate
+--
+--!
+
+package C954A02_0 is  -- Printer server abstraction.
+
+   -- Simulate a system with multiple printers. The entry Print requests
+   -- that data be printed on the next available printer. The entry call
+   -- is accepted when a printer is available, and completes when printing
+   -- is done.
+
+
+   task Printer_Server is
+      entry Print (File_Name : String);        -- Test the requeue statement.
+      entry Verify_Results;                    -- Artifice for test purposes.
+   end Printer_Server;
+
+end C954A02_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with F954A00;              -- Printer device abstraction.
+use  F954A00;
+pragma Elaborate(F954a00);
+
+package body C954A02_0 is  -- Printer server abstraction.
+
+   task body Printer_Server is
+      Printers_Busy  : Boolean    := True;
+      Index          : Printer_ID := 1;
+      Print_Accepted : Boolean    := False;
+   begin
+
+      loop
+         -- Wait for a printer to become available:
+
+         while Printers_Busy loop
+            Printers_Busy := False;                        -- Exit loop if
+                                                           -- entry accepted.
+            select
+               Printer(Index).Done_Printing;               -- Accepted immed.
+                                                           -- when printer is
+                                                           -- available.
+            else
+               Index := 1 + (Index mod Number_Of_Printers);-- Entry not immed.
+               Printers_Busy := True;                      -- accepted; keep
+            end select;                                    -- looping.
+
+            -- Allow other task to get control
+            delay ImpDef.Minimum_Task_Switch;  
+
+         end loop;                                         -- Value of Index
+                                                           -- at loop exit
+                                                           -- identifies the
+                                                           -- avail. printer.
+
+         -- Wait for a print request or terminate:
+
+         select
+            accept Print (File_Name : String) do
+               Print_Accepted := True;                     -- Allow
+                                                           -- Verify_Results
+                                                           -- to be accepted.
+
+               Printer(Index).Start_Printing (File_Name);  -- Begin printing on
+                                                           -- the available
+               --                        --                -- printer.
+               -- Requeue is tested here --
+               --                        --
+                                                           -- Requeue caller so
+               requeue Printer(Index).Done_Printing        -- server task free
+                 with abort;                               -- to accept other
+            end Print;                                     -- requests.
+         or
+            -- Guard ensures that Verify_Results cannot be accepted
+            -- until after Print has been accepted. This avoids a
+            -- race condition in the main program.
+
+            when Print_Accepted => accept Verify_Results;  -- Artifice for
+                                                           -- testing purposes.
+         or
+            terminate;
+         end select;
+
+      end loop;
+
+   exception
+      when others =>
+         Report.Failed ("Exception raised in Printer_Server task");
+   end Printer_Server;
+
+
+end C954A02_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with F954A00;    -- Printer device abstraction.
+with C954A02_0;  -- Printer server abstraction.
+
+use  C954A02_0;
+use  F954A00;
+
+procedure C954A02 is
+
+   -- Length of time which simulates a very long process
+   Long_Enough : constant Duration := ImpDef.Clear_Ready_Queue;
+
+               --==============================================--
+
+   task Print_Request;                       -- Send a print request.
+
+   task body Print_Request is
+      My_File : constant String := "MYFILE.DAT";
+   begin
+      Printer_Server.Print (My_File);          -- Invoke requeue statement.
+      Report.Failed ("Task continued execution following entry call");
+   exception
+      when others =>
+         Report.Failed ("Exception raised in Print_Request task");
+   end Print_Request;
+
+               --==============================================--
+
+begin  -- Main program.
+
+   Report.Test ("C954A02", "Abort a requeue on a Protected entry");
+
+   -- To pass this test, the following must be true:
+   --
+   --    (A) The abort of Print_Request takes place immediately.
+   --    (B) The Done_Printing entry call is canceled, and the corresponding
+   --        entry body is not executed.
+   --
+   -- Call the entry Verify_Results. The entry call will not be accepted
+   -- until after Print_Request has been requeued to Done_Printing.
+
+   Printer_Server.Verify_Results;           -- Accepted after Print_Request is
+                                            -- requeued to Done_Printing.
+
+   -- Verify that the Done_Printing entry call has not been completed.
+   --
+   if Printer(1).Is_Done then
+      Report.Failed ("Target entry of requeue executed prematurely");
+   else
+
+      -- Simulate an application which needs access to the printer within
+      -- a specified time, and which aborts the current printer job if time
+      -- runs out.
+
+      select
+         Printer(1).Done_Printing;          -- Wait for printer to come free.
+      or
+         delay Long_Enough;                 -- Print job took too long.
+         abort Print_Request;               -- Abort print job.
+      end select;
+
+      Printer_Server.Verify_Results;        -- Abortion completion point: force
+                                            -- Print_Request abort to complete.
+
+      -- Verify (A): that Print_Request has been aborted.
+      -- Note: the test will hang if the task as not been aborted
+      --
+      while not Print_Request'Terminated loop
+         delay ImpDef.Minimum_Task_Switch;  
+      end loop;
+
+      -- Verify (B): that the Done_Printing entry call was canceled, and
+      -- the corresponding entry body was not executed.
+      --
+      -- Set the barrier of the entry to true, then check that the entry
+      -- body is not executed. If the entry call is NOT canceled, the
+      -- entry body will execute when the barrier is set true.
+
+      Printer(1).Handle_Interrupt;       -- Simulate a printer interrupt,
+                                         -- signaling that printing is
+                                         -- done.
+      if Printer(1).Is_Done then
+         Report.Failed ("Entry call was not canceled");
+      end if;
+
+
+   end if;
+
+
+   Report.Result;
+
+end C954A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954a03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954a03.a
new file mode 100644
index 000000000..13d21311c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c954a03.a
@@ -0,0 +1,322 @@
+-- C954A03.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 requeue statement in an accept_statement with
+--      parameters may requeue the entry call to a protected entry with no
+--      parameters. Check that, if the call is queued on the new entry's
+--      queue, the original caller remains blocked after the requeue, but
+--      the accept_statement containing the requeue is completed.
+--
+--      Note that this test uses a requeue "with abort," although it does not
+--      check that such a requeued caller can be aborted; that feature is
+--      tested elsewhere.
+--
+-- TEST DESCRIPTION:
+--      Declare a protected type which simulates a printer device driver
+--      (foundation code).
+--
+--      Declare a task which simulates a printer server for multiple printers.
+--
+--      For the protected type, declare an entry with a barrier that is set
+--      false by a protected procedure (which simulates starting a print job
+--      on the printer), and is set true by a second protected procedure (which
+--      simulates a handler called when the printer interrupts, indicating
+--      that printing is done).
+--
+--      For the task, declare an entry whose corresponding accept statement
+--      contains a call to first protected procedure of the protected type
+--      (which sets the barrier of the protected entry to false), followed by
+--      a requeue with abort to the protected entry. Declare a second entry
+--      which does nothing.
+--
+--      Declare a "requesting" task which calls the printer server task entry
+--      (and thus executes the requeue). Verify that, following the requeue,
+--      the requesting task remains blocked. Call the second entry of the
+--      printer server task (the acceptance of this entry call verifies that
+--      the requeue statement completed the entry call by the requesting task.
+--      Call the second protected procedure of the protected type (the
+--      interrupt handler) and verify that the protected entry completes for
+--      the requesting task (which verifies that the requeue statement queued
+--      the first task object to the protected entry).
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         F954A00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Oct 96   SAIC    Added pragma elaborate.
+--
+--!
+
+package C954A03_0 is  -- Printer server abstraction.
+
+   -- Simulate a system with multiple printers. The entry Print requests
+   -- that data be printed on the next available printer. The entry call
+   -- is accepted when a printer is available, and completes when printing
+   -- is done.
+
+   task Printer_Server is
+      entry Print (File_Name : String);        -- Test the requeue statement.
+      entry Verify_Results;                    -- Artifice for test purposes.
+   end Printer_Server;
+
+end C954A03_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with F954A00;              -- Printer device abstraction.
+use  F954A00;
+pragma Elaborate(F954a00);
+
+package body C954A03_0 is  -- Printer server abstraction.
+
+
+   task body Printer_Server is
+      Printers_Busy  : Boolean    := True;
+      Index          : Printer_ID := 1;
+      Print_Accepted : Boolean    := False;
+   begin
+
+      loop
+         -- Wait for a printer to become available:
+
+         while Printers_Busy loop
+            Printers_Busy := False;                        -- Exit loop if
+                                                           -- entry accepted.
+            select
+               Printer(Index).Done_Printing;               -- Accepted immed.
+                                                           -- when printer is
+                                                           -- available.
+            else
+               Index := 1 + (Index mod Number_Of_Printers);-- Entry not immed.
+               Printers_Busy := True;                      -- accepted; keep
+            end select;                                    -- looping.
+
+            -- Allow other tasks to get control
+            delay ImpDef.Minimum_Task_Switch;   
+
+         end loop;
+                                                           -- Value of Index
+                                                           -- at loop exit
+                                                           -- identifies the
+                                                           -- avail. printer.
+
+         -- Wait for a print request or terminate:
+
+         select
+            accept Print (File_Name : String) do
+               Print_Accepted := True;                     -- Allow
+                                                           -- Verify_Results
+                                                           -- to be accepted.
+
+               Printer(Index).Start_Printing (File_Name);  -- Begin printing on
+                                                           -- the available
+               --                        --                -- printer.
+               -- Requeue is tested here --
+               --                        --
+                                                           -- Requeue caller so
+               requeue Printer(Index).Done_Printing        -- server task free
+                 with abort;                               -- to accept other
+            end Print;                                     -- requests.
+         or
+            -- Guard ensures that Verify_Results cannot be accepted
+            -- until after Print has been accepted. This avoids a
+            -- race condition in the main program.
+
+            when Print_Accepted => accept Verify_Results;  -- Artifice for
+                                                           -- testing purposes.
+         or
+            terminate;
+         end select;
+
+      end loop;
+
+   exception
+      when others =>
+         Report.Failed ("Exception raised in Printer_Server task");
+   end Printer_Server;
+
+
+end C954A03_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with F954A00;    -- Printer device abstraction.
+with C954A03_0;  -- Printer server abstraction.
+
+use  C954A03_0;
+use  F954A00;
+
+procedure C954A03 is
+
+   Long_Enough : constant Duration := ImpDef.Clear_Ready_Queue;
+
+
+               --==============================================--
+
+   Task_Completed : Boolean := False;          -- Testing flag.
+
+   protected Interlock is                      -- Artifice for test purposes.
+      entry Wait;                              -- Wait for lock to be released.
+      procedure Release;                       -- Release the lock.
+   private
+      Locked : Boolean := True;
+   end Interlock;
+
+
+   protected body Interlock is
+
+      entry Wait when not Locked is            -- Calls are queued until after
+      --                                       -- Release is called.
+      begin
+         Task_Completed := True;               
+      end Wait;
+
+      procedure Release is                     -- Called by Print_Request.
+      begin
+         Locked := False;
+      end Release;
+
+   end Interlock;
+
+               --==============================================--
+
+   task Print_Request is                       -- Send a print request.
+   end Print_Request;
+
+   task body Print_Request is
+      My_File : constant String := "MYFILE.DAT";
+   begin
+      Printer_Server.Print (My_File);          -- Invoke requeue statement.
+      Interlock.Release;                       -- Allow main to continue.
+   exception
+      when others =>
+         Report.Failed ("Exception raised in Print_Request task");
+   end Print_Request;
+
+               --==============================================--
+
+begin  -- Main program.
+
+   Report.Test ("C954A03", "Requeue from an Accept with parameters" &
+                              " to a Protected Entry without parameters");
+
+   -- To pass this test, the following must be true:
+   --
+   --    (A) The Print entry call made by the task Print_Request must be
+   --        completed by the requeue statement.
+   --    (B) Print_Request must remain blocked following the requeue.
+   --    (C) Print_Request must be queued on the Done_Printing queue of
+   --        Printer(1).
+   --    (D) Print_Request must continue execution after Done_Printing is
+   --        complete.
+   --
+   -- First, verify (A): that the Print entry call is complete.
+   --
+   -- Call the entry Verify_Results. If the requeue statement completed the
+   -- entry call to Print, the entry call to Verify_Results should be
+   -- accepted. Since the main will hang if this is NOT the case, make this
+   -- a timed entry call.
+
+   select
+      Printer_Server.Verify_Results;        -- Accepted if requeue completed
+                                            -- entry call to Print.
+   or
+      delay Long_Enough;                    -- Time out otherwise.
+      Report.Failed ("Requeue did not complete entry call");
+   end select;
+
+   -- Now verify (B): that Print_Request remains blocked following the
+   -- requeue. Also verify that Done_Printing (the entry to which
+   -- Print_Request should have been queued) has not yet executed.
+
+   if Printer(1).Is_Done then
+      Report.Failed ("Target entry of requeue executed prematurely");
+   elsif Print_Request'Terminated then
+      Report.Failed ("Caller did not remain blocked after the requeue");
+   else
+
+      -- Verify (C): that Print_Request is queued on the
+      -- Done_Printing queue of Printer(1).
+      --
+      -- Set the barrier for Printer(1).Done_Printing to true. Check
+      -- that the Done flag is updated and that Print_Request terminates.
+
+      Printer(1).Handle_Interrupt;             -- Simulate a printer interrupt,
+                                               -- signaling that printing is
+                                               -- done.
+
+      -- The Done_Printing entry body will complete before the next
+      -- protected action is called (Printer(1).Is_Done).
+
+      if not Printer(1).Is_Done then
+         Report.Failed ("Caller was not requeued on target entry");
+      end if;
+
+      -- Finally, verify (D): that Print_Request continues after Done_Printing
+      -- completes.
+      --
+      -- After Done_Printing completes, there is a potential race condition
+      -- between the main program and Print_Request. The protected object
+      -- Interlock is provided to ensure that the check of whether
+      -- Print_Request continued is made *after* it has had a chance to do so.
+      -- The main program waits until the statement in Print_Request following
+      -- the requeue-causing statement has executed, then checks to see
+      -- whether Print_Request did in fact continue executing.
+      --
+      -- Note that the test will hang here if Print_Request does not continue
+      -- executing following the completion of the requeued entry call.
+
+      Interlock.Wait;                          -- Wait until Print_Request is
+                                               -- done.
+      if not Task_Completed then
+         Report.Failed ("Caller remained blocked after target " &
+                        "entry released");
+      end if;
+
+      -- Wait for Print_Request to finish before calling Report.Result.
+      while not Print_Request'Terminated loop
+         delay ImpDef.Minimum_Task_Switch;   
+      end loop;                             
+
+   end if;
+
+   Report.Result;
+
+end C954A03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960001.a
new file mode 100644
index 000000000..4eaa1f49f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960001.a
@@ -0,0 +1,164 @@
+-- C960001.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:
+--      Confirm that a simple Delay Until statement is performed.  Check
+--      that the delay does not complete before the requested time and that it
+--      does complete thereafter
+--
+-- TEST DESCRIPTION:
+--      Simulate a task that sends a "pulse" at regular intervals.  The Delay
+--      Until statement is used to avoid accumulated drift.  For the
+--      test, we expect the delay to return very close to the requested time;
+--      we use an additional Pulse_Time_Delta for the limit.  The test
+--      driver (main) artificially limits the number of iterations by setting
+--      the Stop_Pulse Boolean after a small number.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Nov 95   SAIC    Fixed global variable problem for ACVC 2.0.1
+--
+--!
+
+with Report;
+with Ada.Calendar;
+with ImpDef;
+         
+procedure C960001 is
+
+begin
+
+   Report.Test ("C960001", "Simple Delay Until");
+
+   declare  -- To get the Report.Result after all has completed
+
+      function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                            return Ada.Calendar.Time renames Ada.Calendar."+";
+      function "<" (Left, Right : Ada.Calendar.Time)
+                            return Boolean       renames Ada.Calendar."<";
+      function ">" (Left, Right : Ada.Calendar.Time)
+                            return Boolean       renames Ada.Calendar.">";
+
+      TC_Loop_Count : integer range 0..4 := 0; 
+     
+
+      -- control over stopping tasks
+      protected Control is
+         procedure Stop_Now;
+         function Stop return Boolean;
+      private
+         Halt : Boolean := False;
+      end Control;
+
+      protected body Control is
+         procedure Stop_Now is
+         begin
+            Halt := True;
+         end Stop_Now;
+
+         function Stop return Boolean is
+         begin
+            return Halt;
+         end Stop;
+      end Control;
+ 
+      task Pulse_Task is 
+         entry Trigger;
+      end Pulse_Task;
+   
+
+      -- Task to synchronize all qualified receivers.  
+      -- The entry Trigger starts the synchronization; Control.Stop 
+      -- becoming true terminates the task.
+      --
+      task body Pulse_Task is
+
+         Pulse_Time       : Ada.Calendar.Time;
+
+         Pulse_Time_Delta : duration :=  ImpDef.Clear_Ready_Queue;
+
+         TC_Last_Time : Ada.Calendar.Time;
+         TC_Current   : Ada.Calendar.Time;
+
+
+         -- This routine transmits a synchronizing "pulse" to
+         -- all receivers
+         procedure Pulse is
+         begin
+            null;  -- Stub
+            Report.Comment (".......PULSE........");
+         end Pulse;
+         
+      begin
+         accept Trigger;
+
+         Pulse_Time   := Ada.Calendar.Clock + Pulse_Time_Delta; 
+         TC_Last_Time := Pulse_Time;
+
+         while not Control.Stop loop
+            delay until Pulse_Time;
+            Pulse;
+
+            -- Calculate time for next pulse.  Note: this is based on the
+            -- last pulse time, not the time we returned from the delay
+            --
+            Pulse_Time := Pulse_Time + Pulse_Time_Delta;
+            
+            -- Test Control:
+            TC_Current := Ada.Calendar.Clock;
+            if TC_Current < TC_Last_Time then
+               Report.Failed ("Delay expired before requested time");
+            end if;
+            if TC_Current > Pulse_Time then
+               Report.Failed ("Delay too long");
+            end if;               
+            TC_Last_Time := Pulse_Time;
+            TC_Loop_Count := TC_Loop_Count +1;
+         end loop; 
+
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Pulse_Task");
+      end Pulse_Task;
+
+
+
+   begin -- declare
+
+      Pulse_Task.Trigger;      -- Start test                            
+
+      -- Artificially limit the number of iterations
+      while TC_Loop_Count < 3 loop
+         delay ImpDef.Minimum_Task_Switch;
+      end loop;
+      --
+      Control.Stop_Now;      -- End test
+
+   end; -- declare
+
+   Report.Result;
+
+end C960001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960002.a
new file mode 100644
index 000000000..06edaf0c9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960002.a
@@ -0,0 +1,171 @@
+-- C960002.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 simple "delay until" when the request time is "now" and
+--      also some time already in the past is obeyed and returns immediately
+--
+-- TEST DESCRIPTION:
+--      Simulate a task that sends a "pulse" at regular intervals.  The Delay
+--      Until statement is used to avoid accumulated drift.  In this test
+--      three simple situations simulating the start of drift are used:  the
+--      next pulse being called for at the normal time, the next pulse being
+--      called for at exactly the current time and then at some time which has
+--      already past.  We assume the delay is within a While Loop and, to
+--      simplify the test, we "unfold" the While Loop and  execute the Delays
+--      in a serial fashion.  This loop is shown in test C960001.
+--      It is not possible to test the actual immediacy of the expiration. We
+--      can only check that it returns in a "reasonable" time.  In this case
+--      we check that it expires before the next "pulse" should have been 
+--      issued.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with ImpDef;
+
+with Ada.Calendar;
+with System;                                       
+         
+procedure C960002 is
+
+begin
+
+   Report.Test ("C960002", "Simple Delay Until with requested time being" &
+                        " ""now"" and time already in the past");
+
+   declare  -- To get the Report.Result after all has completed
+
+      function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                            return Ada.Calendar.Time renames Ada.Calendar."+";
+      function "-" (Left : Ada.Calendar.Time; Right: Duration)
+                            return Ada.Calendar.Time renames Ada.Calendar."-";
+      function "-" (Left, Right : Ada.Calendar.Time)
+                            return duration      renames Ada.Calendar."-";
+      function ">" (Left, Right : Ada.Calendar.Time)
+                            return Boolean       renames Ada.Calendar.">";
+
+      
+      task Pulse_Task is 
+         entry Trigger;
+      end Pulse_Task;
+   
+
+      -- Task to synchronize all qualified receivers.  
+      -- The entry Trigger starts the synchronization. 
+      --
+      task body Pulse_Task is
+         Pulse_Time       : Ada.Calendar.Time;
+         Pulse_Time_Delta : constant duration := ImpDef.Clear_Ready_Queue; 
+
+
+
+         TC_Time_Back     : Ada.Calendar.Time;
+
+
+         -- This routine transmits a synchronizing "pulse" to
+         -- all receivers
+         procedure Pulse is
+         begin
+            null;  -- Stub
+            Report.Comment (".......PULSE........");      
+         end Pulse;
+         
+      begin
+         accept Trigger;
+         Pulse;
+         ---------------
+         -- normal calculation for "next"
+         Pulse_Time := Ada.Calendar.Clock + Pulse_Time_Delta; 
+
+         -- TC:  unfold the "while" loop in C960001.  Four passes through 
+         -- the loop are shown
+
+            delay until Pulse_Time;  
+
+            Pulse;
+            ---------------
+            -- TC: the normal calculation for "next" would be
+            -- Pulse_Time := Pulse_Time + Pulse_Time_Delta;
+            -- Instead of this normal pulse time calculation simulate
+            -- the new pulse time to be exactly "now"  (or, as exactly as 
+            -- we can)
+            Pulse_Time := Ada.Calendar.Clock; 
+            delay until  Ada.Calendar.Clock; 
+
+            TC_Time_Back := Ada.Calendar.Clock;
+
+            -- Now check for reasonableness
+            if TC_Time_Back > Pulse_Time + Pulse_Time_Delta then
+               Report.Failed 
+                     ("""Now"" delayed for more than Pulse_Time_Delta - A");
+            end if;
+            Pulse;
+            ---------------
+            -- normal calculation for "next" would be
+            Pulse_Time := Pulse_Time + Pulse_Time_Delta;
+
+            -- TC: Instead of this, simulate the new calculated pulse time
+            -- being already past
+            Pulse_Time := Ada.Calendar.Clock - System.Tick;
+            delay until Pulse_Time;
+
+            TC_Time_Back := Ada.Calendar.Clock;
+
+            -- Now check for reasonableness
+            if TC_Time_Back > Pulse_Time + Pulse_Time_Delta then
+               Report.Failed 
+                     ("""Now"" delayed for more than Pulse_Time_Delta - B");
+            end if;
+            Pulse;
+            ---------------
+            -- normal calculation for "next"
+            Pulse_Time := Pulse_Time + Pulse_Time_Delta;
+            -- Now simulate getting back into synch
+            delay until Pulse_Time;
+            Pulse;
+            ---------------
+         -- This would be the end of the "while" loop
+
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Pulse_Task");
+      end Pulse_Task;
+
+
+
+   begin -- declare
+
+      Pulse_Task.Trigger;      -- Start test                            
+
+   end; -- declare
+
+   Report.Result;
+
+end C960002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960004.a
new file mode 100644
index 000000000..f394aab66
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960004.a
@@ -0,0 +1,206 @@
+-- C960004.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:
+--      With the triggering statement being a delay and with the Asynchronous
+--      Select statement being in a tasking situation complete the abortable
+--      part before the delay expires.  Check that the delay is cancelled 
+--      and that the optional statements in the triggering part are not
+--      executed.
+--
+-- TEST DESCRIPTION:
+--      Simulate the creation of a carrier task to control the output of 
+--      a message via a line driver.  If the message sending process is 
+--      not complete (the completion of the rendezvous) within a
+--      specified time the carrier task is designed to take corrective action.
+--      Use an asynchronous select to control the timing; arrange that
+--      the abortable part (the rendezvous) completes almost immediately.
+--      Check that the optional statements are not executed and that the
+--      test completes well before the time of the trigger delay request thus
+--      showing that it has been cancelled.
+--                 
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+         
+                   
+with Report;
+with Ada.Calendar;
+         
+procedure C960004 is
+
+   function "-" (Left, Right : Ada.Calendar.Time)
+                                    return Duration  renames Ada.Calendar."-";
+   TC_Start_Time      : Ada.Calendar.Time := Ada.Calendar.Clock;
+   TC_Elapsed_Time    : duration;
+
+   -- Note: a properly executing test will complete immediately.   
+   Allowable_ACK_Time : duration := 600.0;         
+
+begin
+
+   Report.Test ("C960004", "ATC: When abortable part completes before " &
+                             "a triggering delay, check that the delay " &
+                             "is cancelled & optional statements " &
+                             "are not performed. Tasking situation"); 
+
+   declare  -- To get the Report.Result after all has completed
+
+      type Sequence_Number is range 1..1_999_999;   -- Message Number
+      subtype S_length_subtype  is integer range 1..80;
+
+      type Message_Type (Max_String : S_length_subtype := 1) is
+         record
+            Message_Number    : Sequence_Number;
+            Alpha             : string(1..Max_String);
+         end record;
+
+      -- TC:  Dummy message for the test
+      Dummy_Alpha     : constant string := "This could be printed";
+      Message_to_Send : Message_Type (Max_string => Dummy_Alpha'length);
+
+
+      -- This is the carrier task.  One of these is created for each
+      -- message that requires ACK
+      --
+      task type Require_ACK_task is 
+         entry Message_In (Message_to_Send: Message_Type);
+      end Require_ACK_task;      
+      type acc_Require_ACK_task is access Require_ACK_task;
+
+
+      --:::::::::::::::::::::::::::::::::
+      -- There would also be another task type "No_ACK_Task" which would
+      -- be the carrier task for those messages not requiring an ACK. 
+      -- This task would call Send_Message.ACK_Not_Required.  It is not
+      -- shown in this test as it is not used.
+      --:::::::::::::::::::::::::::::::::
+
+
+   
+      task Send_Message is 
+         entry ACK_Required     (Message_to_Send: Message_Type);
+         entry ACK_Not_Required (Message_to_Send: Message_Type);
+      end Send_Message;
+
+
+      -- This is the carrier task.  One of these is created for each
+      -- message that requires ACK
+      --
+      task body Require_ACK_task is 
+         Hold_Message : Message_Type;
+
+         procedure Time_Out (Failed_Message_Number : Sequence_Number) is
+         begin
+            -- Take remedial action on the timed-out message
+            null;    -- stub
+
+            Report.Failed ("Optional statements in triggering part" &
+                                    " were performed");
+         end Time_out;
+
+      begin   
+         accept Message_In (Message_to_Send: Message_Type) do
+            Hold_Message := Message_to_Send;    -- to release caller
+         end Message_In;
+
+         -- Now put the message out to the Send_Message task and 
+         -- wait (no more than Allowable_Ack_Time) for its completion
+         --
+         select
+            delay Allowable_ACK_Time;
+            -- ACK not received in specified time
+            Time_out (Hold_Message.Message_Number);
+         then abort
+            -- If the rendezvous is not completed in the above time, this
+            -- call is cancelled
+            --    Note: for this test this call will complete immediately
+            --          and thus the trigger should be cancelled
+            Send_Message.ACK_Required (Hold_Message);
+         end select;
+
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Require_ACK_task");
+      end Require_ACK_task;      
+
+
+      -- This is the Line Driver task
+      --
+      task body Send_Message is
+         Hold_Non_ACK_Message : Message_Type;   
+      begin
+         loop
+            select
+               accept ACK_Required (Message_to_Send: Message_Type) do
+                  -- Here send the message from within the rendezvous 
+                  -- waiting for full transmission to complete
+                  null;  -- stub
+                  -- Note: In this test this accept will complete immediately
+               end ACK_Required;
+            or
+               accept ACK_Not_Required (Message_to_Send: Message_Type) do
+                  Hold_Non_ACK_Message := Message_to_Send;
+               end ACK_Not_Required;
+               -- Here send the message from outside the rendezvous
+               null;  -- stub
+            or 
+               terminate;
+            end select;
+         end loop;
+      exception
+         when others => Report.Failed ("Unexpected exception in Send_Message");
+      end Send_Message;
+
+   begin -- declare
+      -- Build a dummy message 
+      Message_to_Send.Alpha          := Dummy_Alpha;
+      Message_to_Send.Message_Number := 110_693;
+
+      declare
+         New_Require_ACK_task : acc_Require_ACK_task := 
+                                             new Require_ACK_task;
+      begin
+         -- Create a carrier task for this message and pass the latter in
+         New_Require_ACK_task.Message_In (Message_to_Send);
+      end; -- declare
+
+   end; -- declare
+
+   --Once we are out of the above declarative region, all tasks have completed
+
+   TC_Elapsed_Time := Ada.Calendar.Clock - TC_Start_Time;
+   
+   -- Check that the test has completed well before the time of the requested
+   -- delay to ensure the delay was cancelled
+   --
+   if (TC_Elapsed_Time > Allowable_ACK_Time/2) then
+      Report.Failed ("Triggering delay statement was not cancelled");
+   end if;
+
+   Report.Result;
+end C960004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96001a.ada
new file mode 100644
index 000000000..f958ea107
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96001a.ada
@@ -0,0 +1,163 @@
+-- C96001A.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 DELAY STATEMENT DELAYS EXECUTION FOR AT LEAST THE
+--      SPECIFIED TIME. SPECIFICALLY,
+--        (A) POSITIVE DELAY ARGUMENT.
+--        (B) NEGATIVE DELAY ARGUMENT.
+--        (C) ZERO DELAY ARGUMENT.
+--        (D) DURATION'SMALL DELAY ARGUMENT.
+--        (E) EXPRESSION OF TYPE DURATION AS DELAY ARGUMENT.
+
+-- HISTORY:
+--     CPP  8/14/84  CREATED ORIGINAL TEST.
+--     RJW 11/13/87  ADDED CODE WHICH ALLOWS TEST TO REPORT "PASSED"
+--                   IF TICK > DURATION'SMALL.
+
+with Impdef;
+WITH CALENDAR;  USE CALENDAR;
+WITH SYSTEM;    USE SYSTEM;
+WITH REPORT;    USE REPORT;
+PROCEDURE C96001A IS
+
+     SUBTYPE INT IS INTEGER RANGE 0 .. 20_000;
+
+BEGIN
+     TEST ("C96001A", "CHECK THAT DELAY STATEMENT DELAYS " &
+           "EXECUTION FOR AT LEAST THE SPECIFIED TIME");
+
+     ---------------------------------------------
+
+     DECLARE   -- (A)
+          X : DURATION := 5.0 * Impdef.One_Second;
+          OLD_TIME : TIME;
+          LAPSE : DURATION;
+     BEGIN     -- (A)
+          LOOP
+               OLD_TIME := CLOCK;
+               DELAY X;
+               LAPSE := CLOCK - OLD_TIME;
+               EXIT;
+          END LOOP;
+          IF LAPSE < X THEN
+               FAILED ("DELAY DID NOT LAPSE AT LEAST 5.0 " &
+                       "SECONDS - (A)");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (A)");
+     END;
+
+     ---------------------------------------------
+
+     DECLARE   -- (B)
+          OLD_TIME : TIME;
+          LAPSE : DURATION;
+     BEGIN     -- (B)
+          LOOP
+               OLD_TIME := CLOCK;
+               DELAY -5.0;
+               LAPSE := CLOCK - OLD_TIME;
+               EXIT;
+          END LOOP;
+          COMMENT ("(B) - NEGATIVE DELAY LAPSED FOR " &
+                   INT'IMAGE (INT (LAPSE * 1_000)) & " MILLISECONDS");
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (B)");
+     END;
+
+     ---------------------------------------------
+
+     DECLARE   -- (C)
+          X : DURATION := 0.0;
+          OLD_TIME : TIME;
+          LAPSE : DURATION;
+     BEGIN     -- (C)
+          LOOP
+               OLD_TIME := CLOCK;
+               DELAY X;
+               LAPSE := CLOCK - OLD_TIME;
+               EXIT;
+          END LOOP;
+          COMMENT ("(C) - ZERO DELAY LAPSED FOR " &
+                   INT'IMAGE (INT (LAPSE * 1_000)) & " MILLISECONDS");
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (C)");
+     END;
+
+     ---------------------------------------------
+
+     DECLARE   -- (D)
+          X : DURATION := DURATION'SMALL;
+          OLD_TIME : TIME;
+          LAPSE : DURATION;
+     BEGIN     -- (D)
+          LOOP
+               OLD_TIME := CLOCK;
+               DELAY X;
+               LAPSE := CLOCK - OLD_TIME;
+               EXIT;
+          END LOOP;
+          IF LAPSE < X THEN
+               IF TICK < DURATION'SMALL THEN
+                    FAILED ("DELAY DID NOT LAPSE AT LEAST " &
+                            "DURATION'SMALL SECONDS - (D)");
+               ELSE
+                    COMMENT ("TICK > DURATION'SMALL SO DELAY IN " &
+                             "'(D)' IS NOT MEASURABLE");
+               END IF;
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (D)");
+     END;
+
+     ---------------------------------------------
+
+     DECLARE   -- (E)
+          INC1 : DURATION := 2.0 * Impdef.One_Second;
+          INC2 : DURATION := 3.0 * Impdef.One_Second;
+          OLD_TIME : TIME;
+          LAPSE : DURATION;
+     BEGIN     -- (E)
+          LOOP
+               OLD_TIME := CLOCK;
+               DELAY INC1 + INC2;
+               LAPSE := CLOCK - OLD_TIME;
+               EXIT;
+          END LOOP;
+          IF LAPSE < (INC1 + INC2) THEN
+               FAILED ("DELAY DID NOT LAPSE AT LEAST " &
+                       "INC1 + INC2 SECONDS - (E)");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED - (E)");
+     END;
+
+     RESULT;
+END C96001A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96004a.ada
new file mode 100644
index 000000000..f5357fc51
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96004a.ada
@@ -0,0 +1,258 @@
+-- C96004A.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 PRE-DEFINED SUBTYPES FROM THE PACKAGE CALENDAR,
+--     NAMELY YEAR_NUMBER, MONTH_NUMBER, DAY_NUMBER, AND DAY_DURATION,
+--     HAVE THE CORRECT RANGE CONSTRAINTS. SUBTESTS ARE:
+--       (A) YEAR_NUMBER.
+--       (B) MONTH_NUMBER.
+--       (C) DAY_NUMBER.
+--       (D) DAY_DURATION.
+
+-- HISTORY:
+--     CPP 08/15/84  CREATED ORIGINAL TEST.
+--     JET 01/06/88  UPDATED HEADER FORMAT AND ADDED CODE TO PREVENT
+--                   OPTIMIZATION.
+
+WITH CALENDAR;  USE CALENDAR;
+WITH REPORT;  USE REPORT;
+PROCEDURE C96004A IS
+
+BEGIN
+     TEST("C96004A", "CHECK THAT PRE-DEFINED SUBTYPES FROM THE " &
+          "CALENDAR PACKAGE HAVE CORRECT RANGE CONSTRAINTS");
+
+     ---------------------------------------------
+
+     DECLARE   -- (A)
+
+          YR : YEAR_NUMBER;
+
+     BEGIN     -- (A)
+
+          BEGIN
+               YR := 1900;
+               FAILED ("EXCEPTION NOT RAISED - (A)1");
+               IF NOT EQUAL (YR, YR) THEN
+                    COMMENT ("NO EXCEPTION RAISED");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (A)1");
+          END;
+
+          BEGIN
+               YR := 84;
+               FAILED ("EXCEPTION NOT RAISED - (A)2");
+               IF NOT EQUAL (YR, YR) THEN
+                    COMMENT ("NO EXCEPTION RAISED");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (A)2");
+          END;
+
+          BEGIN
+               YR := 2099;
+               IF NOT EQUAL (YR, YR) THEN
+                    COMMENT ("NO EXCEPTION RAISED");
+               END IF;
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("OK CASE RAISED EXCEPTION ON 2099 - (A)");
+          END;
+
+          BEGIN
+               YR := IDENT_INT(YEAR_NUMBER'LAST + 1);
+               FAILED ("EXCEPTION NOT RAISED - (A)3");
+               IF NOT EQUAL (YR, YR) THEN
+                    COMMENT ("NO EXCEPTION RAISED");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (A)3");
+          END;
+
+     END; -- (A)
+
+     ---------------------------------------------
+
+     DECLARE   -- (B)
+
+          MO : MONTH_NUMBER;
+
+     BEGIN     -- (B)
+
+          BEGIN
+               MO := IDENT_INT(0);
+               FAILED ("EXCEPTION NOT RAISED - (B)1");
+               IF NOT EQUAL (MO, MO) THEN
+                    COMMENT ("NO EXCEPTION RAISED");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (B)1");
+          END;
+
+          BEGIN
+               MO := 12;
+               IF NOT EQUAL (MO, MO) THEN
+                    COMMENT ("NO EXCEPTION RAISED");
+               END IF;
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("OK CASE RAISED EXCEPTION ON 12 - (B)");
+          END;
+
+          BEGIN
+               MO := 13;
+               FAILED ("EXCEPTION NOT RAISED - (B)2");
+               IF NOT EQUAL (MO, MO) THEN
+                    COMMENT ("NO EXCEPTION RAISED");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (B)2");
+          END;
+
+     END; -- (B)
+
+     ---------------------------------------------
+
+     DECLARE   -- (C)
+
+          DY : DAY_NUMBER;
+
+     BEGIN     -- (C)
+
+          BEGIN
+               DY := 0;
+               FAILED ("EXCEPTION NOT RAISED - (C)1");
+               IF NOT EQUAL (DY, DY) THEN
+                    COMMENT ("NO EXCEPTION RAISED");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (C)1");
+          END;
+
+          BEGIN
+               DY := IDENT_INT(32);
+               FAILED ("EXCEPTION NOT RAISED - (C)2");
+               IF NOT EQUAL (DY, DY) THEN
+                    COMMENT ("NO EXCEPTION RAISED");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (C)2");
+          END;
+
+     END; -- (C)
+
+     ---------------------------------------------
+
+     DECLARE   -- (D)
+
+          SEGMENT : DAY_DURATION;
+
+          FUNCTION CHECK_OK (X : DAY_DURATION) RETURN BOOLEAN IS
+               I : INTEGER := INTEGER (X);
+          BEGIN
+               RETURN EQUAL (I,I);
+          END CHECK_OK;
+
+     BEGIN     -- (D)
+
+          BEGIN
+               SEGMENT := 86_400.0;
+               IF CHECK_OK (SEGMENT - 86_000.0) THEN
+                    COMMENT ("NO EXCEPTION RAISED (D1)");
+               ELSE
+                    COMMENT ("NO EXCEPTION RAISED (D2)");
+               END IF;
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("OK CASE RAISED EXCEPTION ON 86_400 - (D)");
+          END;
+
+          BEGIN
+               SEGMENT := -4.0;
+               FAILED ("EXCEPTION NOT RAISED - (D)1");
+               IF NOT EQUAL (INTEGER(SEGMENT), INTEGER(SEGMENT)) THEN
+                    COMMENT ("NO EXCEPTION RAISED (D3)");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (D)1");
+          END;
+
+          BEGIN
+               SEGMENT := 86_401.00;
+               IF CHECK_OK (SEGMENT - 86_000.0) THEN
+                    FAILED ("NO EXCEPTION RAISED (D4)");
+               ELSE
+                    FAILED ("NO EXCEPTION RAISED (D5)");
+               END IF;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (D)2");
+          END;
+
+     END; -- (D)
+
+     ---------------------------------------------
+
+     RESULT;
+END C96004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005a.ada
new file mode 100644
index 000000000..ca6fc5b83
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005a.ada
@@ -0,0 +1,239 @@
+-- C96005A.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 CORRECTNESS OF THE ADDITION AND SUBTRACTION FUNCTIONS IN
+-- THE PREDEFINED PACKAGE CALENDAR, AND APPROPRIATE EXCEPTION HANDLING.
+-- SPECIFICALLY,
+--   (A) CHECK THAT ADDITION AND SUBTRACTION OPERATORS WORK CORRECTLY ON
+--       VALUES OF TYPE TIME.
+
+-- CPP 8/16/84
+
+WITH CALENDAR;  USE CALENDAR;
+WITH REPORT;  USE REPORT;
+-- WITH TEXT_IO;  USE TEXT_IO;
+PROCEDURE C96005A IS
+
+     -- PACKAGE DURATION_IO IS NEW FIXED_IO (DURATION);
+     -- USE DURATION_IO;
+
+BEGIN
+     TEST ("C96005A", "CHECK THAT THE ADDITION AND SUBTRACTION " &
+           "FUNCTIONS FOR VALUES OF TYPE TIME WORK CORRECTLY");
+
+     -----------------------------------------------
+
+     BEGIN     -- (A)
+
+          -- ADDITION TESTS FOLLOW.
+          DECLARE
+               NOW, NEW_TIME : TIME;
+               INCREMENT : DURATION := 1.0;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 13, 0.0);
+               NEW_TIME := NOW + INCREMENT;
+               IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
+                    FAILED ("SUM OF TIMES IS INCORRECT - (A)1");
+               END IF;
+          END;
+
+
+          DECLARE
+               NOW, NEW_TIME : TIME;
+               INCREMENT : DURATION := 1.0;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 13, 0.0);
+               NEW_TIME :=  INCREMENT + NOW;
+               IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
+                    FAILED ("SUM OF TIMES IS INCORRECT - (A)2");
+               END IF;
+          END;
+
+
+          DECLARE
+               NOW, NEW_TIME : TIME;
+               INCREMENT : DURATION := 1.0;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 13, 0.0);
+               NEW_TIME := "+"(INCREMENT, NOW);
+               IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
+                    FAILED ("SUM OF TIMES IS INCORRECT - (A)3");
+               END IF;
+          END;
+
+
+          DECLARE
+               NOW, NEW_TIME : TIME;
+               INCREMENT : DURATION := 1.0;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 13, 0.0);
+               NEW_TIME := "+"(LEFT => NOW,
+                               RIGHT => INCREMENT);
+               IF NEW_TIME /= TIME_OF (1984, 8, 13, 1.0) THEN
+                    FAILED ("SUM OF TIMES IS INCORRECT - (A)4");
+               END IF;
+          END;
+
+
+          -- SUBTRACTION TESTS FOLLOW.
+          DECLARE
+               NOW, ONCE : TIME;
+               DIFFERENCE : DURATION;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 13, 45_000.0);
+               ONCE := TIME_OF (1984, 8, 12, 45_000.0);
+               DIFFERENCE := NOW - ONCE;
+               IF DIFFERENCE /= 86_400.0 THEN
+                    FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)1");
+                    -- COMMENT ("DIFFERENCE YIELDS: ");
+                    -- PUT (DIFFERENCE);
+               END IF;
+          END;
+
+
+          DECLARE
+          -- TIMES IN DIFFERENT MONTHS.
+               NOW, ONCE : TIME;
+               DIFFERENCE : DURATION;
+          BEGIN
+               NOW := TIME_OF (1984, 8, IDENT_INT(1), 60.0);
+               ONCE := TIME_OF (1984, 7, 31, 86_399.0);
+               DIFFERENCE := "-"(NOW, ONCE);
+               IF DIFFERENCE /= 61.0 THEN
+                    FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)2");
+                    -- COMMENT ("DIFFERENCE YIELDS: ");
+                    -- PUT (DIFFERENCE);
+               END IF;
+          END;
+
+
+          DECLARE
+          -- TIMES IN DIFFERENT YEARS.
+               NOW, AFTER : TIME;
+               DIFFERENCE : DURATION;
+          BEGIN
+               NOW := TIME_OF (IDENT_INT(1999), 12, 31, 86_399.0);
+               AFTER := TIME_OF (2000, 1, 1, 1.0);
+               DIFFERENCE := "-"(LEFT => AFTER,
+                                 RIGHT => NOW);
+               IF DIFFERENCE /= 2.0 THEN
+                    FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)3");
+                    -- COMMENT ("DIFFERENCE YIELDS: ");
+                    -- PUT (DIFFERENCE);
+               END IF;
+          END;
+
+
+          DECLARE
+          -- TIMES IN A LEAP YEAR.
+               NOW, LEAP : TIME;
+               DIFFERENCE : DURATION;
+          BEGIN
+               NOW := TIME_OF (1984, 3, 1);
+               LEAP := TIME_OF (1984, 2, 29, 86_399.0);
+               DIFFERENCE := NOW - LEAP;
+               IF DIFFERENCE /= 1.0 THEN
+                    FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)4");
+                    -- COMMENT ("DIFFERENCE YIELDS: ");
+                    -- PUT (DIFFERENCE);
+               END IF;
+          END;
+
+
+          DECLARE
+          -- TIMES IN A NON-LEAP YEAR.
+               NOW, NON_LEAP : TIME;
+               DIFFERENCE : DURATION;
+          BEGIN
+               NOW := TIME_OF (1983, 3, 1);
+               NON_LEAP := TIME_OF (1983, 2, 28, 86_399.0);
+               DIFFERENCE := NOW - NON_LEAP;
+               IF DIFFERENCE /= 1.0 THEN
+                    FAILED ("DIFFERENCE OF TIMES IS INCORRECT - (A)5");
+                    -- COMMENT ("DIFFERENCE YIELDS: ");
+                    -- PUT (DIFFERENCE);
+               END IF;
+          END;
+
+
+          -- SUBTRACTION TESTS FOLLOW: TIME - DURATION.
+          DECLARE
+               NOW, NEW_TIME : TIME;
+               INCREMENT : DURATION := 1.0;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 13, 0.0);
+               NEW_TIME := NOW - INCREMENT;
+               IF NEW_TIME /= TIME_OF (1984, 8, 12, 86_399.0) THEN
+                    FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
+                            "INCORRECT - (A)6");
+               END IF;
+          END;
+
+
+          DECLARE
+               NOW, NEW_TIME : TIME;
+               INCREMENT : DURATION := 1.0;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 1, 0.0);
+               NEW_TIME := NOW - INCREMENT;
+               IF NEW_TIME /= TIME_OF (1984, 7, 31, 86_399.0) THEN
+                    FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
+                            "INCORRECT - (A)7");
+               END IF;
+          END;
+
+
+          DECLARE
+               NOW, NEW_TIME : TIME;
+               INCREMENT : DURATION := 1.0;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 1, 0.0);
+               NEW_TIME := "-"(LEFT => NOW,
+                               RIGHT => INCREMENT);
+               IF NEW_TIME /= TIME_OF (1984, 7, 31, 86_399.0) THEN
+                    FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
+                            "INCORRECT - (A)8");
+               END IF;
+          END;
+
+
+          DECLARE
+               NOW, NEW_TIME : TIME;
+               INCREMENT : DURATION := 1.0;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 1, 0.0);
+               NEW_TIME := "-"(NOW, INCREMENT);
+               IF NEW_TIME /= TIME_OF (1984, 7, 31, 86_399.0) THEN
+                    FAILED ("DIFFERENCE OF TIME AND DURATION IS " &
+                            "INCORRECT - (A)7");
+               END IF;
+          END;
+
+
+     END; -- (A)
+
+     -----------------------------------------------
+
+     RESULT;
+END C96005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005b.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005b.tst
new file mode 100644
index 000000000..f4665b136
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005b.tst
@@ -0,0 +1,135 @@
+-- C96005B.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 THE CORRECTNESS OF THE ADDITION AND SUBTRACTION FUNCTIONS IN
+-- THE PREDEFINED PACKAGE CALENDAR, AND APPROPRIATE EXCEPTION HANDLING.
+-- SPECIFICALLY,
+--   (B) ADDITION AND SUBTRACTION OPERATORS RAISE CONSTRAINT_ERROR WHEN
+--       CALLED WITH AN OUT OF RANGE DURATION PARAMETER.
+
+-- CPP 8/16/84
+
+WITH CALENDAR;  USE CALENDAR;
+WITH REPORT;  USE REPORT;
+PROCEDURE C96005B IS
+
+BEGIN
+     TEST ("C96005B", "CHECK THAT ADDITION AND SUBTRACTION " &
+           "OPERATORS RAISE CONSTRAINT_ERROR WHEN CALLED WITH " &
+           "OUT OF RANGE DURATION PARAMETER");
+
+     -----------------------------------------------
+
+     BEGIN     -- (B)
+
+          -- ADDITION TESTS FOLLOW.
+          DECLARE
+               BEFORE : TIME := CLOCK;
+          BEGIN
+               IF DURATION'BASE'FIRST < DURATION'FIRST THEN
+                    COMMENT("LOW VALUES EXIST - (B)1");
+                    BEFORE := BEFORE + ($LESS_THAN_DURATION);
+                    FAILED ("EXCEPTION NOT RAISED - (B)1");
+               ELSE
+                    NOT_APPLICABLE ("NO LOW VALUES EXIST - (B)1");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN TIME_ERROR =>
+                    FAILED ("TIME_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - (B)1");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (B)1");
+          END;
+
+          DECLARE
+               BEFORE : TIME := CLOCK;
+          BEGIN
+               IF DURATION'LAST < DURATION'BASE'LAST THEN
+                    COMMENT("HIGH VALUES EXIST - (B)2");
+                    BEFORE := $GREATER_THAN_DURATION + BEFORE;
+                    FAILED ("EXCEPTION NOT RAISED - (B)2");
+               ELSE
+                    NOT_APPLICABLE ("NO HIGH VALUES EXIST - (B)2");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN TIME_ERROR =>
+                    FAILED ("TIME_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - (B)2");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (B)2");
+          END;
+
+
+          -- SUBTRACTION TESTS FOLLOW.
+          DECLARE
+               BEFORE : TIME := CLOCK;
+          BEGIN
+               IF DURATION'BASE'FIRST < DURATION'FIRST THEN
+                    COMMENT("LOW VALUES EXIST - (B)3");
+                    BEFORE := BEFORE - ($LESS_THAN_DURATION);
+                    FAILED ("EXCEPTION NOT RAISED - (B)3");
+               ELSE
+                    NOT_APPLICABLE ("NO LOW VALUES EXIST - (B)3");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN TIME_ERROR =>
+                    FAILED ("TIME_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - (B)3");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (B)3");
+          END;
+
+          DECLARE
+               BEFORE : TIME := CLOCK;
+          BEGIN
+               IF DURATION'LAST < DURATION'BASE'LAST THEN
+                    COMMENT("HIGH VALUES EXIST - (B)4");
+                    BEFORE := BEFORE - $GREATER_THAN_DURATION;
+                    FAILED ("EXCEPTION NOT RAISED - (B)4");
+               ELSE
+                    NOT_APPLICABLE ("NO HIGH VALUES EXIST - (B)4");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN TIME_ERROR =>
+                    FAILED ("TIME_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - (B)4");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (B)4");
+          END;
+
+
+     END; -- (B)
+
+     -----------------------------------------------
+
+     RESULT;
+END C96005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005d.ada
new file mode 100644
index 000000000..8caba3e36
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005d.ada
@@ -0,0 +1,81 @@
+-- C96005D.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 CORRECTNESS OF THE ADDITION AND SUBTRACTION FUNCTIONS IN
+-- THE PREDEFINED PACKAGE CALENDAR, AND APPROPRIATE EXCEPTION HANDLING.
+-- SPECIFICALLY,
+--   (D) THE EXCEPTION TIME_ERROR IS RAISED WHEN THE FUNCTION "-"
+--       RETURNS A VALUE NOT IN THE SUBTYPE RANGE DURATION.
+
+-- CPP 8/16/84
+
+WITH CALENDAR;  USE CALENDAR;
+WITH REPORT;  USE REPORT;
+PROCEDURE C96005D IS
+
+BEGIN
+     TEST ("C96005D", "CHECK THAT THE SUBTRACTION OPERATOR RAISES " &
+           "TIME_ERROR APPROPRIATELY");
+
+     ---------------------------------------------
+
+     BEGIN     -- (D)
+
+          DECLARE
+               NOW, LATER : TIME;
+               WAIT : DURATION;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 13, 0.0);
+               LATER := (NOW + DURATION'LAST) + 1.0;
+               WAIT := LATER - NOW;
+               FAILED ("EXCEPTION NOT RAISED - (D)1");
+          EXCEPTION
+               WHEN TIME_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (D)1");
+          END;
+
+
+          DECLARE
+               NOW, LATER : TIME;
+               WAIT : DURATION;
+          BEGIN
+               NOW := TIME_OF (1984, 8, 13, 0.0);
+               LATER := (NOW + DURATION'FIRST) - 1.0;
+               WAIT := NOW - LATER;
+               FAILED ("EXCEPTION NOT RAISED - (D)2");
+          EXCEPTION
+               WHEN TIME_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (D)2");
+          END;
+
+     END; -- (D)
+
+     ---------------------------------------------
+
+     RESULT;
+END C96005D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005f.ada
new file mode 100644
index 000000000..89e3d574b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96005f.ada
@@ -0,0 +1,93 @@
+-- C96005F.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 PACKAGE CALENDAR + AND - FUNCTIONS WORK PROPERLY,
+-- ESPECIALLY WITH VALUES AT MIDNIGHT.
+ 
+-- GOM 02/18/85
+-- JWC 05/14/85
+ 
+WITH REPORT;
+USE REPORT;
+WITH CALENDAR;
+USE CALENDAR;
+ 
+PROCEDURE C96005F IS
+
+     CURR_DAY1 : CONSTANT TIME := TIME_OF(1984,1,1,0.0);
+     CURR_DAY2 : CONSTANT TIME := TIME_OF(1984,1,1,DAY_DURATION'LAST);
+     CURR_DAY3 : CONSTANT TIME := TIME_OF(1984,1,1,10000.0);
+
+     TOMORROW1 : CONSTANT TIME := TIME_OF(1984,1,2,0.0);
+     TOMORROW2 : CONSTANT TIME := TIME_OF(1984,1,2,DAY_DURATION'LAST);
+     TOMORROW3 : CONSTANT TIME := TIME_OF(1984,1,2,10000.0);
+
+     YESTERDAY1 : CONSTANT TIME := TIME_OF(1983,12,31,0.0);
+     YESTERDAY2 : CONSTANT TIME := TIME_OF(1983,12,31,
+                                           DAY_DURATION'LAST);
+     YESTERDAY3 : CONSTANT TIME := TIME_OF(1983,12,31,10000.0);
+
+BEGIN
+     TEST("C96005F","CHECKING PACKAGE CALENDAR + AND - FUNCTIONS");
+
+     -- CHECK IF ADDING ONE DAY TO 'CURR_DAY#' TIMES YIELDS
+     -- TIMES EQUAL TO 'TOMORROW'.
+
+     IF (CURR_DAY1 + DAY_DURATION'LAST) /= TOMORROW1 THEN
+          FAILED("FAILURE IN ADDING 1 DAY TO 'CURR_DAY1'");
+     END IF;
+
+     IF (CURR_DAY2 + DAY_DURATION'LAST) /= TOMORROW2 THEN
+          FAILED("FAILURE IN ADDING 1 DAY TO 'CURR_DAY2'");
+     END IF;
+ 
+     IF (CURR_DAY3 + DAY_DURATION'LAST) /= TOMORROW3 THEN
+          FAILED("FAILURE IN ADDING 1 DAY TO 'CURR_DAY3'");
+     END IF;
+
+     IF (CURR_DAY1 + DAY_DURATION'LAST) /= CURR_DAY2 THEN
+          FAILED("'CURR_DAY1' + 1 /= 'CURR_DAY2'");
+     END IF;
+ 
+     -- CHECK IF SUBTRACTING ONE DAY FROM 'CURR_DAY#' TIMES YIELDS
+     -- TIMES EQUAL TO 'YESTERDAY'.
+
+     IF (CURR_DAY1 - DAY_DURATION'LAST) /= YESTERDAY1 THEN
+          FAILED("FAILURE IN SUBTRACTING 1 DAY FROM 'CURR_DAY1'");
+     END IF;
+
+     IF (CURR_DAY2 - DAY_DURATION'LAST) /= YESTERDAY2 THEN
+          FAILED("FAILURE IN SUBTRACTING 1 DAY FROM 'CURR_DAY2'");
+     END IF;
+
+     IF (CURR_DAY3 - DAY_DURATION'LAST) /= YESTERDAY3 THEN
+          FAILED("FAILURE IN SUBTRACTING 1 DAY FROM 'CURR_DAY3'");
+     END IF;
+
+     IF (CURR_DAY2 - DAY_DURATION'LAST) /= CURR_DAY1 THEN
+          FAILED("'CURR_DAY2' - 1 /= 'CURR_DAY1'");
+     END IF;
+ 
+     RESULT;
+END C96005F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96006a.ada
new file mode 100644
index 000000000..0f6448bd2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96006a.ada
@@ -0,0 +1,298 @@
+-- C96006A.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 THE PACKAGE CALENDAR, THE RELATIONAL OPERATORS WORK
+-- CORRECTLY FOR OPERANDS OF TYPE TIME AND TYPE DURATION. PARTICULARLY,
+--   (A) RELATIONS BASED ON YEARS.
+--   (B) RELATIONS BASED ON MONTH.
+--   (C) RELATIONS BASED ON SECONDS.
+--   (D) RELATIONS AT EXTREMES OF THE PERMITTED RANGE OF TIME.
+
+-- CPP 8/16/84
+
+WITH CALENDAR;  USE CALENDAR;
+WITH REPORT;  USE REPORT;
+PROCEDURE C96006A IS
+
+BEGIN
+     TEST ("C96006A", "CHECK THAT RELATIONAL OPERATORS WORK " &
+           "CORRECTLY IN THE PACKAGE CALENDAR");
+
+     --------------------------------------------
+
+     DECLARE   -- (A)
+     -- RELATIONS BASED ON YEARS.
+          NOW, LATER : TIME;
+     BEGIN     -- (A)
+          NOW := TIME_OF (1984, 8, 12, 500.0);
+          LATER := TIME_OF (1985, 8, 12, 500.0);
+
+          IF NOW < LATER THEN
+               COMMENT ("< OPERATOR OK - (A)");
+          ELSE
+               FAILED ("< OPERATOR INCORRECT - (A)");
+          END IF;
+
+          IF NOW <= LATER THEN
+               COMMENT ("<= OPERATOR OK - (A)");
+          ELSE
+               FAILED ("<= OPERATOR INCORRECT - (A)");
+          END IF;
+
+          IF NOW <= NOW THEN
+               COMMENT ("<= OPERATOR OK - (A)2");
+          ELSE
+               FAILED ("<= OPERATOR INCORRECT - (A)2");
+          END IF;
+
+          IF LATER > NOW THEN
+               COMMENT ("> OPERATOR OK - (A)");
+          ELSE
+               FAILED ("> OPERATOR INCORRECT - (A)");
+          END IF;
+
+          IF LATER >= NOW THEN
+               COMMENT (">= OPERATOR OK - (A)");
+          ELSE
+               FAILED (">= OPERATOR INCORRECT - (A)");
+          END IF;
+
+          IF LATER >= LATER THEN
+               COMMENT (">= OPERATOR OK - (A)2");
+          ELSE
+               FAILED (">= OPERATOR INCORRECT - (A)2");
+          END IF;
+
+     END; -- (A)
+
+     --------------------------------------------
+
+     DECLARE   -- (B)
+     -- RELATIONS BASED ON MONTH.
+          NOW, LATER : TIME;
+     BEGIN     -- (B)
+          NOW := TIME_OF (1984, 8, 12, 500.0);
+          LATER := TIME_OF (1984, 9, 12, 500.0);
+
+          IF NOW < LATER THEN
+               COMMENT ("< OPERATOR OK - (B)");
+          ELSE
+               FAILED ("< OPERATOR INCORRECT - (B)");
+          END IF;
+
+          IF NOW <= LATER THEN
+               COMMENT ("<= OPERATOR OK - (B)");
+          ELSE
+               FAILED ("<= OPERATOR INCORRECT - (B)");
+          END IF;
+
+          IF NOW <= NOW THEN
+               COMMENT ("<= OPERATOR OK - (B)2");
+          ELSE
+               FAILED ("<= OPERATOR INCORRECT - (B)2");
+          END IF;
+
+          IF LATER > NOW THEN
+               COMMENT ("> OPERATOR OK - (B)");
+          ELSE
+               FAILED ("> OPERATOR INCORRECT - (B)");
+          END IF;
+
+          IF LATER >= NOW THEN
+               COMMENT (">= OPERATOR OK - (B)");
+          ELSE
+               FAILED (">= OPERATOR INCORRECT - (B)");
+          END IF;
+
+          IF LATER >= LATER THEN
+               COMMENT (">= OPERATOR OK - (B)2");
+          ELSE
+               FAILED (">= OPERATOR INCORRECT - (B)2");
+          END IF;
+
+          IF NOW = NOW THEN
+               COMMENT ("= OPERATOR OK - (B)");
+          ELSE
+               FAILED ("= OPERATOR INCORRECT - (B)");
+          END IF;
+
+          IF LATER /= NOW THEN
+               COMMENT ("/= OPERATOR OK - (B)");
+          ELSE
+               FAILED ("/= OPERATOR INCORRECT - (B)");
+          END IF;
+
+     END; -- (B)
+
+     --------------------------------------------
+
+     DECLARE   -- (C)
+     -- RELATIONS BASED ON SECONDS.
+          NOW, LATER : TIME;
+          INCREMENT : DURATION := 99.9;
+     BEGIN     -- (C)
+          NOW := TIME_OF (1984, 8, 12, 500.0);
+          LATER := NOW + INCREMENT;
+
+          IF NOW < LATER THEN
+               COMMENT ("< OPERATOR OK - (C)");
+          ELSE
+               FAILED ("< OPERATOR INCORRECT - (C)");
+          END IF;
+
+          IF NOW <= LATER THEN
+               COMMENT ("<= OPERATOR OK - (C)");
+          ELSE
+               FAILED ("<= OPERATOR INCORRECT - (C)");
+          END IF;
+
+          IF NOW <= NOW THEN
+               COMMENT ("<= OPERATOR OK - (C)2");
+          ELSE
+               FAILED ("<= OPERATOR INCORRECT - (C)2");
+          END IF;
+
+          IF LATER > NOW THEN
+               COMMENT ("> OPERATOR OK - (C)");
+          ELSE
+               FAILED ("> OPERATOR INCORRECT - (C)");
+          END IF;
+
+          IF LATER >= NOW THEN
+               COMMENT (">= OPERATOR OK - (C)");
+          ELSE
+               FAILED (">= OPERATOR INCORRECT - (C)");
+          END IF;
+
+          IF LATER >= LATER THEN
+               COMMENT (">= OPERATOR OK - (C)2");
+          ELSE
+               FAILED (">= OPERATOR INCORRECT - (C)2");
+          END IF;
+
+          IF LATER = LATER THEN
+               COMMENT ("= OPERATOR OK - (C)");
+          ELSE
+               FAILED ("= OPERATOR INCORRECT - (C)");
+          END IF;
+
+          IF NOW /= LATER THEN
+               COMMENT ("/= OPERATOR OK - (C)");
+          ELSE
+               FAILED ("/= OPERATOR INCORRECT - (C)");
+          END IF;
+
+          IF NOW < NOW THEN
+               FAILED ("NOW < NOW INCORRECT - (C)");
+          ELSIF NOW /= NOW THEN
+               FAILED ("NOW = NOW INCORRECT - (C)");
+          ELSIF LATER < NOW THEN
+               FAILED ("LATER < NOW INCORRECT - (C)");
+          ELSIF LATER <= NOW THEN
+               FAILED ("LATER <= NOW INCORRECT - (C)");
+          ELSIF LATER = NOW THEN
+               FAILED ("NOW = LATER INCORRECT - (C)");
+          ELSIF NOW > LATER THEN
+               FAILED ("NOW > LATER INCORRECT - (C)");
+          ELSIF NOW > NOW THEN
+               FAILED ("NOW > NOW INCORRECT - (C)");
+          ELSIF NOW >= LATER THEN
+               FAILED ("NOW >= LATER INCORRECT - (C)");
+          ELSIF NOW = LATER THEN
+               FAILED ("NOW = LATER INCORRECT - (C)");
+          END IF;
+
+     END; -- (C)
+
+     --------------------------------------------
+
+     DECLARE   -- (D)
+
+          NOW, WAY_BACK_THEN : TIME;
+
+     BEGIN     -- (D)
+
+          NOW := TIME_OF (2099, 12, 31);
+          WAY_BACK_THEN := TIME_OF (1901, 1, 1);
+
+          BEGIN
+               IF NOW < WAY_BACK_THEN THEN
+                    FAILED ("TEST < AT EXTREMES INCORRECT - (D)");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("< AT EXTREMES RAISED EXCEPTION - (D)");
+          END;
+
+          BEGIN
+               IF NOW <= WAY_BACK_THEN THEN
+                    FAILED ("TEST <= AT EXTREMES INCORRECT - (D)");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("<= AT EXTREMES RAISED EXCEPTION - (D)");
+          END;
+
+          BEGIN
+               IF WAY_BACK_THEN > NOW THEN
+                    FAILED ("TEST > AT EXTREMES INCORRECT - (D)");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("> AT EXTREMES RAISED EXCEPTION - (D)");
+          END;
+
+          BEGIN
+               IF WAY_BACK_THEN >= NOW THEN
+                    FAILED ("TEST >= AT EXTREMES INCORRECT - (D)");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED (">= AT EXTREMES RAISED EXCEPTION - (D)");
+          END;
+
+          BEGIN
+               IF WAY_BACK_THEN /= WAY_BACK_THEN THEN
+                    FAILED ("TEST /= AT EXTREMES INCORRECT - (D)");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("/= AT EXTREMES RAISED EXCEPTION - (D)");
+          END;
+
+          BEGIN
+               IF NOW = WAY_BACK_THEN THEN
+                    FAILED ("TEST = AT EXTREMES INCORRECT - (D)");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("= AT EXTREMES RAISED EXCEPTION - (D)");
+          END;
+
+     END; -- (D)
+
+     --------------------------------------------
+
+     RESULT;
+END C96006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96007a.ada
new file mode 100644
index 000000000..beda25fd5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96007a.ada
@@ -0,0 +1,203 @@
+-- C96007A.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 APPROPRIATE EXCEPTIONS ARE RAISED FOR THE TIME_OF()
+-- FUNCTION IN THE PACKAGE CALENDAR. PARTICULARLY,
+--   (A) TIME_ERROR IS RAISED ON INVALID DATES.
+--   (B) CONSTRAINT_ERROR IS RAISED FOR OUT-OF-RANGE PARAMETERS.
+
+-- CPP 8/16/84
+
+WITH CALENDAR;  USE CALENDAR;
+WITH REPORT;  USE REPORT;
+PROCEDURE C96007A IS
+
+BEGIN
+     TEST ("C96007A", "CHECK THAT APPROPRIATE EXCEPTIONS ARE RAISED " &
+           "FOR THE TIME_OF FUNCTION IN THE PACKAGE CALENDAR");
+
+     --------------------------------------------
+
+     DECLARE   -- (A)
+
+          BAD_TIME : TIME;
+
+     BEGIN     -- (A)
+
+          BEGIN
+               BAD_TIME := TIME_OF (1984, 2, 30);
+               FAILED ("EXCEPTION NOT RAISED - 2/30 (A)");
+          EXCEPTION
+               WHEN TIME_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 2/30 (A)");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (1984, 2, 31);
+               FAILED ("EXCEPTION NOT RAISED - 2/31 (A)");
+          EXCEPTION
+               WHEN TIME_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 2/31 (A)");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (1984, 4, 31);
+               FAILED ("EXCEPTION NOT RAISED - 4/31 (A)");
+          EXCEPTION
+               WHEN TIME_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 4/31 (A)");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (1984, 6, 31);
+               FAILED ("EXCEPTION NOT RAISED - 6/31 (A)");
+          EXCEPTION
+               WHEN TIME_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 6/31 (A)");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (1984, 9, 31);
+               FAILED ("EXCEPTION NOT RAISED - 9/31 (A)");
+          EXCEPTION
+               WHEN TIME_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 9/31 (A)");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (1984, 11, 31);
+               FAILED ("EXCEPTION NOT RAISED - 11/31 (A)");
+          EXCEPTION
+               WHEN TIME_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 11/31 (A)");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (1983, 2, 29);
+               FAILED ("EXCEPTION NOT RAISED - 2/29 (A)");
+          EXCEPTION
+               WHEN TIME_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 2/29 (A)");
+          END;
+
+     END; -- (A)
+
+     --------------------------------------------
+
+     DECLARE   -- (B)
+
+          BAD_TIME : TIME;
+
+     BEGIN     -- (B)
+
+          BEGIN
+               BAD_TIME := TIME_OF (1900, 8, 13);
+               FAILED ("EXCEPTION NOT RAISED - 1900 (B)");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 1900 (B)");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (YEAR_NUMBER'LAST + 1, 8, 13);
+               FAILED ("EXCEPTION NOT RAISED - 2100 (B)");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 2100 (B)");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (1984, 0, 13);
+               FAILED ("EXCEPTION NOT RAISED - MONTH (B)1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - MONTH (B)1");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (1984, 13, 13);
+               FAILED ("EXCEPTION NOT RAISED - MONTH (B)2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - MONTH (B)2");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (1984, 8, 0);
+               FAILED ("EXCEPTION NOT RAISED - DAY (B)1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - DAY (B)1");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (19784, 8, 32);
+               FAILED ("EXCEPTION NOT RAISED - DAY (B)2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - DAY (B)2");
+          END;
+
+          BEGIN
+               BAD_TIME := TIME_OF (1984, 8, 13, -0.5);
+               FAILED ("EXCEPTION NOT RAISED - SECONDS (B)1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - SECONDS (B)1");
+          END;
+
+     END; -- (B)
+
+     --------------------------------------------
+
+     RESULT;
+END C96007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96008a.ada
new file mode 100644
index 000000000..33b59d8c1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96008a.ada
@@ -0,0 +1,203 @@
+-- C96008A.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.
+--*
+-- MISCELLANEOUS CHECKS ON THE PRE-DEFINED FUNCTIONS IN THE PACKAGE
+-- CALENDAR.  SUBTESTS ARE:
+--   (A) TIME_OF() AND SPLIT() ARE INVERSE FUNCTIONS.
+--   (B) FORMAL PARAMETERS OF TIME_OF() AND SPLIT() ARE NAMED CORRECTLY.
+--   (C) TIME_OF() GIVES THE PARAMETER SECONDS A DEFAULT VALUE OF 0.0.
+--   (D) THE FUNCTIONS YEAR(), MONTH(), DAY(), AND SECONDS() RETURN
+--       CORRECT VALUES USING NAMED NOTATION.
+--   (E) A VALUE RETURNED FROM CLOCK() CAN BE PROCESSED BY SPLIT().
+--   (F) DURATION'SMALL MEETS REQUIRED LIMIT.
+
+-- CPP 8/16/84
+
+WITH SYSTEM;
+WITH CALENDAR;  USE CALENDAR;
+WITH REPORT;  USE REPORT;
+PROCEDURE C96008A IS
+
+BEGIN
+     TEST ("C96008A", "CHECK MISCELLANEOUS FUNCTIONS IN THE " &
+           "PACKAGE CALENDAR");
+
+     ---------------------------------------------
+
+     DECLARE   -- (A)
+          NOW : TIME;
+          YR : YEAR_NUMBER;
+          MO : MONTH_NUMBER;
+          DY : DAY_NUMBER;
+          SEC : DAY_DURATION;
+     BEGIN     -- (A)
+          BEGIN
+               NOW := TIME_OF (1984, 8, 13, DURATION(1.0/3.0));
+               SPLIT (NOW, YR, MO, DY, SEC);
+               IF NOW /= TIME_OF (YR, MO, DY, SEC) THEN
+                    COMMENT ("TIME_OF AND SPLIT ARE NOT INVERSES " &
+                             "WHEN SECONDS IS A NON-MODEL NUMBER " &
+                             "- (A)");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("TIME_OF(SPLIT) RAISED EXCEPTION - (A)");
+          END;
+
+
+          BEGIN
+               -- RESET VALUES.
+               YR := 1984;
+               MO := 8;
+               DY := 13;
+               SEC := 1.0;
+
+               SPLIT (TIME_OF (YR, MO, DY, SEC), YR, MO, DY, SEC);
+
+               IF YR /= 1984 THEN
+                    FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF YR - (A)");
+               END IF;
+
+               IF MO /= 8 THEN
+                    FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF MO - (A)");
+               END IF;
+
+               IF DY /= 13 THEN
+                    FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF DY - (A)");
+               END IF;
+
+               IF SEC /= 1.0 THEN
+                    FAILED ("SPLIT(TIME_OF) CHANGED VALUE OF " &
+                            "SEC - (A)");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("SPLIT(TIME_OF) PROCESSING RAISED " &
+                            "EXCEPTION - (A)");
+          END;
+     END; -- (A)
+
+     ---------------------------------------------
+
+     BEGIN     -- (B)
+          DECLARE
+               NOW : TIME;
+          BEGIN
+               NOW := TIME_OF (YEAR => 1984,
+                               MONTH => 8,
+                               DAY => 13,
+                               SECONDS => 60.0);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NAMED ASSOCIATION ON TIME_OF() RAISED " &
+                            "EXCEPTION - (B)");
+          END;
+
+
+          DECLARE
+               NOW : TIME := CLOCK;
+               YR : YEAR_NUMBER := 1984;
+               MO : MONTH_NUMBER := 8;
+               DY : DAY_NUMBER := 13;
+               SEC : DAY_DURATION := 0.0;
+          BEGIN
+               SPLIT (DATE => NOW,
+                      YEAR => YR,
+                      MONTH => MO,
+                      DAY => DY,
+                      SECONDS => SEC);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("NAMED ASSOCIATION ON SPLIT() RAISED " &
+                            "EXCEPTION - (B)2");
+          END;
+     END; -- (B)
+
+     ---------------------------------------------
+
+     DECLARE   -- (C)
+          NOW : TIME;
+     BEGIN     -- (C)
+          NOW := TIME_OF (1984, 8, 13);
+          IF SECONDS (NOW) /= 0.0 THEN
+               FAILED ("TIME_OF() DID NOT ZERO SECONDS - (C)");
+          END IF;
+     END; -- (C)
+
+     ---------------------------------------------
+
+     DECLARE   -- (D)
+     -- ASSUMES TIME_OF() WORKS CORRECTLY.
+          HOLIDAY : TIME;
+     BEGIN     -- (D)
+          HOLIDAY := TIME_OF (1958, 9, 9, 1.0);
+
+          IF YEAR (DATE => HOLIDAY) /= 1958 THEN
+               FAILED ("YEAR() DID NOT RETURN CORRECT VALUE - (D)");
+          END IF;
+
+          IF MONTH (DATE => HOLIDAY) /= 9 THEN
+               FAILED ("MONTH() DID NOT RETURN CORRECT VALUE - (D)");
+          END IF;
+
+          IF DAY (DATE => HOLIDAY) /= 9 THEN
+               FAILED ("DAY() DID NOT RETURN CORRECT VALUE - (D)");
+          END IF;
+
+          IF SECONDS (HOLIDAY) /= 1.0 THEN
+               FAILED ("SECONDS() DID NOT RETURN CORRECT VALUE - (D)");
+          END IF;
+     END; -- (D)
+
+     ---------------------------------------------
+
+     DECLARE   -- (E)
+          YR : YEAR_NUMBER;
+          MO : MONTH_NUMBER;
+          DY : DAY_NUMBER;
+          SEC : DAY_DURATION;
+     BEGIN     -- (E)
+          SPLIT (CLOCK, YR, MO, DY, SEC);
+          DELAY SYSTEM.TICK;
+
+          IF TIME_OF (YR, MO, DY, SEC) > CLOCK THEN
+               FAILED ("SPLIT() ON CLOCK INCORRECT - (E)");
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("SPLIT() ON CLOCK RAISED EXCEPTION - (E)");
+     END; -- (E)
+
+     ---------------------------------------------
+
+     BEGIN     -- (F)
+          IF DURATION'SMALL > 0.020 THEN
+               FAILED ("DURATION'SMALL LARGER THAN SPECIFIED - (F)");
+          END IF;
+     END; -- (F)
+
+     ---------------------------------------------
+
+     RESULT;
+END C96008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96008b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96008b.ada
new file mode 100644
index 000000000..7a23bcfb4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c96008b.ada
@@ -0,0 +1,71 @@
+-- C96008B.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.
+--*
+-- MISCELLANEOUS CHECKS ON THE PRE-DEFINED FUNCTIONS IN THE PACKAGE
+-- CALENDAR.  SUBTESTS ARE:
+--   (A) THE FUNCTION TIME_OF() MUST ADVANCE DAY WHEN CALLED WITH THE
+--       SECONDS ARGUMENT HAVING THE VALUE 86_400.
+
+-- CPP 8/16/84
+-- JRK 12/4/84
+
+WITH CALENDAR;  USE CALENDAR;
+WITH REPORT;  USE REPORT;
+PROCEDURE C96008B IS
+
+     NOW1, NOW2 : TIME;
+     YR : YEAR_NUMBER;
+     MO : MONTH_NUMBER;
+     DY : DAY_NUMBER;
+     SEC : DAY_DURATION;
+
+BEGIN
+
+     TEST ("C96008B", "CHECK THAT TIME_OF() ADVANCES DAY");
+
+     NOW1 := TIME_OF (1984, 8, 13, 86_400.0);
+     NOW2 := TIME_OF (1984, 8, 14, 0.0);
+
+     IF NOW1 /= NOW2 THEN
+          FAILED ("TIME_OF DID NOT CONVERT 86_400 SECONDS TO A DAY");
+     END IF;
+
+     SPLIT (NOW2, YR, MO, DY, SEC);
+
+     IF DY /= 14 THEN
+          FAILED ("DAY OF NOW2 INCORRECT");
+     END IF;
+     IF SEC /= 0.0 THEN
+          FAILED ("SECONDS OF NOW2 INCORRECT");
+     END IF;
+
+     SPLIT (NOW1, YR, MO, DY, SEC);
+
+     IF DY /= 14 OR SEC /= 0.0 OR
+        DAY (NOW1) /= 14 OR SECONDS (NOW1) /= 0.0 THEN
+          FAILED ("TIME_OF DID NOT ADVANCE DAY");
+     END IF;
+
+     RESULT;
+END C96008B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97112a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97112a.ada
new file mode 100644
index 000000000..ef7dca2d4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97112a.ada
@@ -0,0 +1,134 @@
+-- C97112A.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 DELAY STATEMENT IS ALLOWED IN THE SEQUENCE OF STATEMENTS
+-- OF A SELECT ALTERNATIVE OF A SELECTIVE WAIT CONTAINING A TERMINATE
+-- ALTERNATIVE OR AN ELSE PART.
+
+-- WRG 7/9/86
+
+with Impdef;
+WITH REPORT;   USE REPORT;
+WITH CALENDAR; USE CALENDAR;
+PROCEDURE C97112A IS
+
+     ACCEPT_ALTERNATIVE_TAKEN : BOOLEAN := FALSE;
+
+BEGIN
+
+     TEST ("C97112A", "CHECK THAT A DELAY STATEMENT IS ALLOWED IN " &
+                      "THE SEQUENCE OF STATEMENTS OF A SELECT " &
+                      "ALTERNATIVE OF A SELECTIVE WAIT CONTAINING A " &
+                      "TERMINATE ALTERNATIVE OR AN ELSE PART");
+
+     --------------------------------------------------
+
+  A: DECLARE
+
+          TASK T IS
+               ENTRY E;
+          END T;
+
+          TASK BODY T IS
+               BEFORE, AFTER : TIME;
+          BEGIN
+               SELECT
+                    ACCEPT E;
+                    ACCEPT_ALTERNATIVE_TAKEN := TRUE;
+                    BEFORE := CLOCK;
+                    DELAY 10.0 * Impdef.One_Second;
+                    AFTER  := CLOCK;
+                    IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
+                         FAILED ("INSUFFICIENT DELAY (A)");
+                    END IF;
+               OR
+                    TERMINATE;
+               END SELECT;
+          END T;
+
+     BEGIN
+
+          T.E;
+
+     END A;
+
+     IF NOT ACCEPT_ALTERNATIVE_TAKEN THEN
+          FAILED ("ACCEPT ALTERNATIVE NOT TAKEN");
+     END IF;
+
+     --------------------------------------------------
+
+  B: DECLARE
+
+          TASK T IS
+               ENTRY E;
+          END T;
+
+          TASK BODY T IS
+               BEFORE, AFTER : TIME;
+          BEGIN
+               --ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
+               WHILE E'COUNT = 0 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+               SELECT
+                    ACCEPT E;
+                    BEFORE := CLOCK;
+                    DELAY 10.0 * Impdef.One_Second;
+                    AFTER  := CLOCK;
+                    IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
+                         FAILED ("INSUFFICIENT DELAY (B-1)");
+                    END IF;
+               ELSE
+                    FAILED ("ELSE PART EXECUTED (B-1)");
+               END SELECT;
+
+               SELECT
+                    ACCEPT E;
+                    FAILED ("ACCEPT STATEMENT EXECUTED (B-2)");
+               ELSE
+                    BEFORE := CLOCK;
+                    DELAY 10.0 * Impdef.One_Second;
+                    AFTER  := CLOCK;
+                    IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
+                         FAILED ("INSUFFICIENT DELAY (B-2)");
+                    END IF;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED");
+          END T;
+
+     BEGIN
+
+          T.E;
+
+     END B;
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C97112A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97113a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97113a.ada
new file mode 100644
index 000000000..f05d4380c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97113a.ada
@@ -0,0 +1,113 @@
+-- C97113A.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 CONDITIONS, OPEN DELAY ALTERNATIVE EXPRESSIONS, AND
+--   OPEN ENTRY FAMILY INDICES ARE EVALUATED (EVEN WHEN SOME (PERHAPS
+--   ALL BUT ONE) OF THE ALTERNATIVES CAN BE RULED OUT WITHOUT
+--   COMPLETING THE EVALUATIONS).
+
+-- RM 5/06/82
+-- SPS 11/21/82
+-- WRG 7/9/86    ADDED DELAY EXPRESSIONS AND ENTRY FAMILY INDICES.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C97113A IS
+
+     EXPR1_EVALUATED : BOOLEAN := FALSE;
+     EXPR2_EVALUATED : BOOLEAN := FALSE;
+     EXPR3_EVALUATED : BOOLEAN := FALSE;
+
+     FUNCTION F1 RETURN BOOLEAN IS
+     BEGIN
+          EXPR1_EVALUATED := TRUE;
+          RETURN TRUE;
+     END F1;
+
+     FUNCTION F2 (X : INTEGER) RETURN INTEGER IS
+     BEGIN
+          EXPR2_EVALUATED := TRUE;
+          RETURN X;
+     END F2;
+
+     FUNCTION F3 (X : DURATION) RETURN DURATION IS
+     BEGIN
+          EXPR3_EVALUATED := TRUE;
+          RETURN X;
+     END F3;
+
+BEGIN
+
+     TEST ("C97113A", "CHECK THAT ALL CONDITIONS, OPEN DELAY " &
+                      "ALTERNATIVE EXPRESSIONS, AND OPEN ENTRY " &
+                      "FAMILY INDICES ARE EVALUATED");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E1;
+               ENTRY E2;
+               ENTRY E3 (1..1);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               --ENSURE THAT E1 HAS BEEN CALLED BEFORE PROCEEDING:
+               WHILE E1'COUNT = 0 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+               SELECT
+                    ACCEPT E1;
+               OR
+                    WHEN F1 =>
+                         ACCEPT E2;
+               OR
+                    ACCEPT E3 ( F2(1) );
+               OR
+                    DELAY F3 ( 1.0 ) * Impdef.One_Second;
+               END SELECT;
+          END T;
+
+     BEGIN
+
+          T.E1;
+
+     END;
+
+     IF NOT EXPR1_EVALUATED THEN
+          FAILED ("GUARD NOT EVALUATED");
+     END IF;
+
+     IF NOT EXPR2_EVALUATED THEN
+          FAILED ("ENTRY FAMILY INDEX NOT EVALUATED");
+     END IF;
+
+     IF NOT EXPR3_EVALUATED THEN
+          FAILED ("OPEN DELAY ALTERNATIVE EXPRESSION NOT EVALUATED");
+     END IF;
+
+     RESULT;
+
+END C97113A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97114a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97114a.ada
new file mode 100644
index 000000000..2a28fe8e8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97114a.ada
@@ -0,0 +1,196 @@
+-- C97114A.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 WHETHER A DELAY EXPRESSION FOLLOWING AN OPEN GUARD IS EVALUATED
+-- DIRECTLY AFTER THE GUARD OR ONLY AFTER ALL GUARDS HAVE BEEN
+-- EVALUATED, OR IN SOME MIXED ORDER SUCH THAT DELAY EXPRESSIONS ARE
+-- EVALUATED AFTER THEIR GUARDS ARE DETERMINED TO BE OPEN.
+
+-- RM 5/10/82
+-- SPS 11/21/82
+-- JBG 10/24/83
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C97114A IS
+
+
+     -- THE TASK WILL HAVE LAST PRIORITY ( PRIORITY'FIRST )
+
+     EVAL_ORDER  :  STRING (1..6)       := ( 1..6 => '*' );
+     EVAL_ORD    :  STRING (1..6)       := ( 1..6 => '*' );
+     INDEX       :  INTEGER             := 0; 
+     DUMMY       :  INTEGER             := 0; 
+
+
+     FUNCTION F1 (X:INTEGER) RETURN INTEGER IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'F';    -- 123: FGH
+          EVAL_ORD   (INDEX) := 'G';    -- 123: GGG ( 'G' FOR 'GUARD' )
+          RETURN ( IDENT_INT(7) ); 
+     END F1; 
+
+
+     FUNCTION F2 (X:INTEGER) RETURN INTEGER IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'G'; 
+          EVAL_ORD   (INDEX) := 'G'; 
+          RETURN ( IDENT_INT(7) ); 
+     END F2; 
+
+
+     FUNCTION F3 (X:INTEGER) RETURN INTEGER IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'H'; 
+          EVAL_ORD   (INDEX) := 'G'; 
+          RETURN ( IDENT_INT(7) ); 
+     END F3; 
+
+
+     FUNCTION  D1( X:INTEGER )  RETURN DURATION IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'A';    -- 123: ABC
+          EVAL_ORD   (INDEX) := 'D';    -- 123: DDD ( 'D' FOR 'DELAY' )
+          RETURN ( 1.0 );
+     END D1; 
+
+
+     FUNCTION  D2( X:INTEGER )  RETURN DURATION IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'B'; 
+          EVAL_ORD   (INDEX) := 'D'; 
+          RETURN ( 2.0 );
+     END D2; 
+
+
+     FUNCTION  D3( X:INTEGER )  RETURN DURATION IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'C'; 
+          EVAL_ORD   (INDEX) := 'D'; 
+          RETURN ( 3.0 );
+     END D3; 
+
+     FUNCTION POS_OF (FUNC : CHARACTER) RETURN INTEGER  IS
+     BEGIN
+          FOR I IN EVAL_ORDER'RANGE LOOP
+               IF EVAL_ORDER(I) = FUNC THEN
+                    RETURN I;
+               END IF;
+          END LOOP;
+          FAILED ("DID NOT FIND LETTER " & FUNC);
+          RETURN 0;
+     END POS_OF;
+
+BEGIN
+
+
+     TEST ("C97114A", "CHECK THAT THE DELAY EXPRESSIONS ARE" &
+                      " EVALUATED AFTER THE GUARDS BUT"      &
+                      " BEFORE THE RENDEZVOUS IS ATTEMPTED"  );
+
+
+     DECLARE
+ 
+
+          TASK T IS
+
+
+               ENTRY E1; 
+
+          END T; 
+
+
+          TASK BODY T IS
+          BEGIN
+
+
+               WHILE  E1'COUNT = 0  -- IF  E1  NOT YET CALLED, THEN GIVE
+               LOOP                 --     THE MAIN TASK AN OPPORTUNITY
+                    DELAY  10.01 * Impdef.One_Second;   --     TO ISSUE THE CALL.
+               END LOOP;
+
+
+               SELECT               
+
+                         ACCEPT  E1; 
+
+               OR
+
+                    WHEN  6 + F1(7) = 13  =>
+                         DELAY  D1( DUMMY ) * Impdef.One_Second;
+
+               OR
+
+                    WHEN  6 + F2(7) = 13  =>
+                         DELAY  D2( DUMMY ) * Impdef.One_Second;
+
+               OR
+
+                    WHEN  6 + F3(7) = 13  =>
+                         DELAY  D3( DUMMY ) * Impdef.One_Second;
+
+               END SELECT;
+
+
+          END T; 
+
+
+     BEGIN
+
+          T.E1; 
+
+     END; -- END OF BLOCK CONTAINING THE ENTRY CALLS
+
+
+     COMMENT ("EVALUATIONS WERE DONE IN THE ORDER " & EVAL_ORD);
+     COMMENT ("FUNCTIONS WERE CALLED IN THE ORDER " & EVAL_ORDER);
+
+     IF EVAL_ORD = "GGGDDD" THEN
+          COMMENT ("ALL GUARDS EVALUATED FIRST");
+     ELSIF EVAL_ORD = "GDGDGD" THEN
+          COMMENT ("DELAY EXPRESSION EVALUATED AFTER EACH GUARD");
+     END IF;
+
+-- CHECK THAT GUARDS ARE ALWAYS EVALUATED BEFORE DELAY EXPRESSIONS
+
+     IF   POS_OF ('F') > POS_OF ('A') OR
+          POS_OF ('G') > POS_OF ('B') OR
+          POS_OF ('H') > POS_OF ('C') THEN
+               FAILED ("A DELAY EXPRESSION WAS EVALUATED BEFORE ITS " &
+                       "GUARD");
+     END IF;
+
+
+     RESULT;
+
+
+END  C97114A;  
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97115a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97115a.ada
new file mode 100644
index 000000000..8e9845ea6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97115a.ada
@@ -0,0 +1,189 @@
+-- C97115A.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 WHETHER AN ENTRY FAMILY INDEX EXPRESSION FOLLOWING AN OPEN
+-- GUARD IS EVALUATED DIRECTLY AFTER THE GUARD, OR ONLY AFTER ALL GUARDS
+-- HAVE BEEN EVALUATED, OR IN SOME MIXED ORDER SUCH THAT INDEX
+-- EXPRESSIONS ARE EVALUATED AFTER THEIR GUARDS ARE DETERMINED TO BE
+-- OPEN. 
+
+-- RM 5/11/82
+-- SPS 11/21/82
+-- JBG 10/24/83
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C97115A IS
+
+
+     -- THE TASK WILL HAVE LAST PRIORITY ( PRIORITY'FIRST )
+
+     EVAL_ORDER  :  STRING (1..6)       := ( 1..6 => '*' );
+     EVAL_ORD    :  STRING (1..6)       := ( 1..6 => '*' );
+     INDEX       :  INTEGER             := 0; 
+
+
+     FUNCTION F1 (X:INTEGER) RETURN INTEGER IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'F';    -- 123: FGH
+          EVAL_ORD   (INDEX) := 'G';    -- 123: GGG ( 'G' FOR 'GUARD' )
+          RETURN ( IDENT_INT(7) ); 
+     END F1; 
+
+
+     FUNCTION F2 (X:INTEGER) RETURN INTEGER IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'G'; 
+          EVAL_ORD   (INDEX) := 'G'; 
+          RETURN ( IDENT_INT(7) ); 
+     END F2; 
+
+
+     FUNCTION F3 (X:INTEGER) RETURN INTEGER IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'H'; 
+          EVAL_ORD   (INDEX) := 'G'; 
+          RETURN ( IDENT_INT(7) ); 
+     END F3; 
+
+
+     FUNCTION  I1 ( X:INTEGER )  RETURN BOOLEAN  IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'A';  -- 123: ABC
+          EVAL_ORD   (INDEX) := 'I';  -- 123: III ( 'I' FOR 'INDEX' )
+          RETURN ( IDENT_BOOL(TRUE) );    -- (THAT'S ENTRY-FAMILY INDEX)
+     END I1; 
+
+
+     FUNCTION  I2 ( X:INTEGER )  RETURN BOOLEAN  IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'B'; 
+          EVAL_ORD   (INDEX) := 'I'; 
+          RETURN ( IDENT_BOOL(TRUE) );
+     END I2; 
+
+
+     FUNCTION  I3 ( X:INTEGER )  RETURN BOOLEAN  IS
+     BEGIN
+          INDEX := INDEX + 1; 
+          EVAL_ORDER (INDEX) := 'C'; 
+          EVAL_ORD   (INDEX) := 'I'; 
+          RETURN ( IDENT_BOOL(TRUE) );
+     END I3; 
+
+     FUNCTION POS_OF (FUNC : CHARACTER) RETURN INTEGER  IS
+     BEGIN
+          FOR I IN EVAL_ORDER'RANGE LOOP
+               IF EVAL_ORDER(I) = FUNC THEN
+                    RETURN I;
+               END IF;
+          END LOOP;
+          FAILED ("DID NOT FIND LETTER " & FUNC);
+          RETURN 0;
+     END POS_OF;
+
+
+BEGIN
+
+
+     TEST ("C97115A", "CHECK THAT THE INDEX EXPRESSIONS ARE" &
+                      " EVALUATED AFTER THE GUARDS BUT"      &
+                      " BEFORE THE RENDEZVOUS IS ATTEMPTED"  );
+
+
+     DECLARE
+ 
+
+          TASK T IS
+
+
+               ENTRY E ( BOOLEAN );
+               ENTRY E1; 
+
+          END T; 
+
+
+          TASK BODY T IS
+          BEGIN
+
+
+               WHILE  E1'COUNT = 0  -- IF  E1  NOT YET CALLED, THEN GIVE
+               LOOP                 --     THE MAIN TASK AN OPPORTUNITY
+                    DELAY  10.01 * Impdef.One_Second;   --     TO ISSUE THE CALL.
+               END LOOP;
+
+
+               SELECT               
+
+                         ACCEPT  E1; 
+
+               OR
+
+                    WHEN  6 + F1(7) = 13  =>
+                         ACCEPT  E ( I1(17) );
+
+               OR
+
+                    WHEN  6 + F2(7) = 13  =>
+                         ACCEPT  E ( I2(17) );
+
+               OR
+
+                    WHEN  6 + F3(7) = 13  =>
+                         ACCEPT  E ( I3(17) );
+
+               END SELECT;
+
+
+          END T; 
+
+
+     BEGIN
+
+          T.E1; 
+
+     END; -- END OF BLOCK CONTAINING THE ENTRY CALLS
+
+
+     COMMENT ("GUARD AND INDEX FUNCTIONS WERE CALLED IN ORDER " & 
+               EVAL_ORDER);
+     COMMENT ("GUARD AND INDEX EXPRESSIONS WERE EVALUATED IN THE " &
+              "ORDER " & EVAL_ORD);
+
+     IF POS_OF ('F') > POS_OF ('A') OR
+        POS_OF ('G') > POS_OF ('B') OR
+        POS_OF ('H') > POS_OF ('C') THEN
+          FAILED ("AN INDEX EXPRESSION WAS EVALUATED TOO EARLY");
+     END IF;
+
+     RESULT;
+
+END  C97115A;  
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97116a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97116a.ada
new file mode 100644
index 000000000..737d2528e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97116a.ada
@@ -0,0 +1,102 @@
+-- C97116A.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 GUARD CONDITIONS IN A SELECTIVE WAIT STATEMENT
+--     ARE NOT RE-EVALUATED DURING THE WAIT.
+
+-- HISTORY:
+--     WRG 7/10/86  CREATED ORIGINAL TEST.
+--     RJW 5/15/90  REMOVED SHARED VARIABLES.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C97116A IS
+
+     GUARD_EVALUATIONS : NATURAL := 0;
+
+     FUNCTION GUARD RETURN BOOLEAN IS
+     BEGIN
+          GUARD_EVALUATIONS := GUARD_EVALUATIONS + 1;
+          RETURN FALSE;
+     END GUARD;
+
+     FUNCTION SO_LONG RETURN DURATION IS
+     BEGIN
+          RETURN 20.0;
+     END SO_LONG;
+
+BEGIN
+
+     TEST ("C97116A", "CHECK THAT THE GUARD CONDITIONS IN A " &
+                      "SELECTIVE WAIT STATEMENT ARE NOT RE-EVALUATED " &
+                      "DURING THE WAIT");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               SELECT
+                    ACCEPT E;
+                    FAILED ("ACCEPTED NONEXISTENT CALL TO E");
+               OR WHEN GUARD     =>
+                    DELAY 0.0;
+                    FAILED ("EXECUTED ALTERNATIVE CLOSED BY FALSE " &
+                            "GUARD FUNCTION" );
+               OR
+                    DELAY SO_LONG * Impdef.One_Second;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED");
+          END T;
+
+          TASK GET_CPU;
+
+          TASK BODY GET_CPU IS
+          BEGIN
+               WHILE NOT T'TERMINATED LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+          END GET_CPU;
+
+     BEGIN
+
+          NULL;
+
+     END;
+
+     IF GUARD_EVALUATIONS /= 1 THEN
+          FAILED ("GUARD EVALUATED" &
+                  NATURAL'IMAGE(GUARD_EVALUATIONS) & " TIMES");
+     END IF;
+
+     RESULT;
+
+END C97116A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97117a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97117a.ada
new file mode 100644
index 000000000..cf5e1b911
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97117a.ada
@@ -0,0 +1,72 @@
+-- C97117A.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 PROGRAM_ERROR IS RAISED IF ALL ALTERNATIVES ARE CLOSED AND
+-- NO ELSE PART IS PRESENT.
+
+-- WRG 7/10/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97117A IS
+
+BEGIN
+
+     TEST ("C97117A", "CHECK THAT PROGRAM_ERROR IS RAISED IF ALL " &
+                      "ALTERNATIVES ARE CLOSED AND NO ELSE PART IS " &
+                      "PRESENT");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               SELECT
+                    WHEN IDENT_BOOL (FALSE) =>
+                         ACCEPT E;
+                         FAILED ("CLOSED ACCEPT ALTERNATIVE TAKEN " &
+                                 "FOR NONEXISTENT ENTRY CALL");
+               OR   WHEN IDENT_BOOL (FALSE) =>
+                         DELAY 0.0;
+                         FAILED ("CLOSED ALTERNATIVE TAKEN");
+               END SELECT;
+               FAILED ("PROGRAM_ERROR NOT RAISED");
+          EXCEPTION
+               WHEN PROGRAM_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED");
+          END T;
+
+     BEGIN
+
+          NULL;
+
+     END;
+
+     RESULT;
+
+END C97117A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97117b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97117b.ada
new file mode 100644
index 000000000..bc05ebf35
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97117b.ada
@@ -0,0 +1,88 @@
+-- C97117B.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 ELSE PART IS EXECUTED IF ALL ALTERNATIVES ARE CLOSED OR
+-- IF THERE ARE NO TASKS QUEUED FOR OPEN ALTERNATIVES.
+
+-- WRG 7/10/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C97117B IS
+
+BEGIN
+
+     TEST ("C97117B", "CHECK THAT AN ELSE PART IS EXECUTED IF ALL " &
+                      "ALTERNATIVES ARE CLOSED OR IF THERE ARE NO " &
+                      "TASKS QUEUED FOR OPEN ALTERNATIVES");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E;
+               ENTRY NO_GO;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               -- ENSURE THAT NO_GO HAS BEEN CALLED BEFORE PROCEEDING:
+               WHILE NO_GO'COUNT = 0 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+               SELECT
+                    WHEN IDENT_BOOL (FALSE) =>
+                         ACCEPT E;
+                         FAILED ("CLOSED ACCEPT ALTERNATIVE TAKEN " &
+                                 "FOR NONEXISTENT ENTRY CALL - 1");
+               OR
+                    WHEN IDENT_BOOL (FALSE) =>
+                         ACCEPT NO_GO;
+                         FAILED ("CLOSED ALTERNATIVE TAKEN - 1");
+               ELSE
+                    COMMENT ("ELSE PART EXECUTED - 1");
+               END SELECT;
+
+               SELECT
+                    ACCEPT E;
+                    FAILED ("ACCEPTED NONEXISTENT ENTRY CALL - 2");
+               OR WHEN IDENT_BOOL (FALSE) =>
+                    ACCEPT NO_GO;
+                    FAILED ("CLOSED ALTERNATIVE TAKEN - 2");
+               ELSE
+                    COMMENT ("ELSE PART EXECUTED - 2");
+               END SELECT;
+
+               ACCEPT NO_GO;
+          END T;
+
+     BEGIN
+
+          T.NO_GO;
+
+     END;
+
+     RESULT;
+
+END C97117B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97117c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97117c.ada
new file mode 100644
index 000000000..cda428029
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97117c.ada
@@ -0,0 +1,74 @@
+-- C97117C.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 ELSE PART IS NOT EXECUTED IF A TASK IS QUEUED AT AN
+-- OPEN ALTERNATIVE.
+
+-- WRG 7/10/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C97117C IS
+
+BEGIN
+
+     TEST ("C97117C", "CHECK THAT AN ELSE PART IS NOT EXECUTED IF A " &
+                      "TASK IS QUEUED AT AN OPEN ALTERNATIVE");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E;
+               ENTRY NO_GO;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               --ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
+               WHILE E'COUNT = 0 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+               SELECT
+                    ACCEPT NO_GO;
+                    FAILED ("ACCEPTED NONEXISTENT ENTRY CALL");
+               OR WHEN IDENT_BOOL (TRUE)  =>
+                    ACCEPT E;
+               OR WHEN IDENT_BOOL (FALSE) =>
+                    ACCEPT E;
+                    FAILED ("CLOSED ALTERNATIVE TAKEN");
+               ELSE
+                    FAILED ("ELSE PART EXECUTED");
+               END SELECT;
+          END T;
+
+     BEGIN
+
+          T.E;
+
+     END;
+
+     RESULT;
+
+END C97117C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97118a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97118a.ada
new file mode 100644
index 000000000..e1eceaf67
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97118a.ada
@@ -0,0 +1,73 @@
+-- C97118A.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 CALL TO A CLOSED ALTERNATIVE OF A SELECTIVE WAIT IS NOT
+-- ACCEPTED.
+
+-- WRG 7/11/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C97118A IS
+
+BEGIN
+
+     TEST ("C97118A", "CHECK THAT A CALL TO A CLOSED ALTERNATIVE OF " &
+                      "A SELECTIVE WAIT IS NOT ACCEPTED");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               -- ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
+               WHILE E'COUNT = 0 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+               SELECT
+                    WHEN IDENT_BOOL (FALSE) =>
+                         ACCEPT E;
+                         FAILED ("ACCEPTED CALL TO CLOSED ALTERNATIVE");
+                    ELSE
+                         NULL;
+               END SELECT;
+
+               IF E'COUNT = 1 THEN
+                    ACCEPT E;
+               END IF;
+          END T;
+
+     BEGIN
+
+          T.E;
+
+     END;
+
+     RESULT;
+
+END C97118A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97120a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97120a.ada
new file mode 100644
index 000000000..4fd5293c1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97120a.ada
@@ -0,0 +1,81 @@
+-- C97120A.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 DELAYS AT LEAST AS LONG AS IS SPECIFIED
+-- IN A DELAY ALTERNATIVE.
+
+-- WRG 7/11/86
+
+with Impdef;
+WITH REPORT;   USE REPORT;
+WITH CALENDAR; USE CALENDAR;
+PROCEDURE C97120A IS
+
+BEGIN
+
+     TEST ("C97120A", "CHECK THAT A SELECTIVE WAIT DELAYS AT LEAST " &
+                      "AS LONG AS IS SPECIFIED IN A DELAY ALTERNATIVE");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY NO_GO;
+               ENTRY SYNCH;
+          END T;
+
+          TASK BODY T IS
+               BEFORE, AFTER : TIME;
+          BEGIN
+               -- ENSURE THAT SYNCH HAS BEEN CALLED BEFORE PROCEEDING:
+               WHILE SYNCH'COUNT = 0 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+               BEFORE := CLOCK;
+               SELECT
+                    ACCEPT NO_GO;
+                    FAILED ("ACCEPTED NONEXISTENT ENTRY CALL");
+               OR
+                    DELAY 10.0 * Impdef.One_Second;
+                    AFTER := CLOCK;
+                    IF AFTER - BEFORE < 10.0 * Impdef.One_Second THEN
+                         FAILED ("INSUFFICIENT DELAY");
+                    END IF;
+               END SELECT;
+
+               ACCEPT SYNCH;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED");
+          END T;
+
+     BEGIN
+
+          T.SYNCH;  -- SUSPEND MAIN TASK BEFORE READING CLOCK.
+
+     END;
+
+     RESULT;
+
+END C97120A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97120b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97120b.ada
new file mode 100644
index 000000000..5cc9806bb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97120b.ada
@@ -0,0 +1,103 @@
+-- C97120B.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 SPECIFIED DELAY IS ZERO OR NEGATIVE AND AN ENTRY CALL
+-- IS WAITING AT AN OPEN ALTERNATIVE WHEN THE SELECTIVE WAIT IS
+-- EXECUTED, THE CALL IS ACCEPTED.
+
+-- WRG 7/11/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C97120B IS
+
+     ZERO, NEG : DURATION := 1.0;
+
+BEGIN
+
+     TEST ("C97120B", "CHECK THAT IF A SPECIFIED DELAY IS ZERO OR " &
+                      "NEGATIVE AND AN ENTRY CALL IS WAITING AT AN " &
+                      "OPEN ALTERNATIVE WHEN THE SELECTIVE WAIT IS " &
+                      "EXECUTED, THE CALL IS ACCEPTED");
+
+     IF EQUAL (3, 3) THEN
+          ZERO :=  0.0;
+          NEG  := -1.0;
+     END IF;
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               WHILE E'COUNT = 0 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+            A: BEGIN
+                    SELECT
+                         WHEN IDENT_BOOL (TRUE) =>
+                              ACCEPT E;
+                    OR
+                         DELAY ZERO * Impdef.One_Second;
+                         FAILED ("ZERO DELAY ALTERNATIVE TAKEN");
+                         ACCEPT E;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED (A)");
+               END A;
+
+               WHILE E'COUNT = 0 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+            B: BEGIN
+                    SELECT
+                         ACCEPT E;
+                    OR
+                         DELAY NEG;
+                         FAILED ("NEGATIVE DELAY ALTERNATIVE TAKEN");
+                         ACCEPT E;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED (B)");
+               END B;
+
+          END T;
+
+     BEGIN
+
+          T.E;
+          T.E;
+
+     END;
+
+     RESULT;
+
+END C97120B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201a.ada
new file mode 100644
index 000000000..18186cbc3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201a.ada
@@ -0,0 +1,151 @@
+-- C97201A.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 RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
+--     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
+
+-- CASE  A:  THE TASK TO BE CALLED IS NOT YET ACTIVE AS OF THE
+--     MOMENT OF CALL (CONDITIONAL_ENTRY_CALL),
+--     AND THIS FACT CAN BE DETERMINED STATICALLY.
+
+
+-- RM 4/20/82
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97201A IS
+
+     ELSE_BRANCH_TAKEN    :  INTEGER  :=  3 ;
+
+BEGIN
+
+
+     TEST ("C97201A", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
+                      " A CONDITIONAL_ENTRY_CALL CAN OCCUR  WHILE" &
+                      " THE CALLED TASK IS NOT YET ACTIVE"         );
+
+
+     -------------------------------------------------------------------
+
+
+     DECLARE
+
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_ORELSE ( AUTHORIZED : IN BOOLEAN ) ;
+          END  T ;
+
+
+          TASK BODY  T  IS
+
+               PACKAGE       SECOND_ATTEMPT  IS    END  SECOND_ATTEMPT ;
+               PACKAGE BODY  SECOND_ATTEMPT  IS
+               BEGIN
+
+                    SELECT
+                         DO_IT_NOW_ORELSE (FALSE) ;--CALLING (OWN) ENTRY
+                    ELSE    -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                            --      THEREFORE THIS BRANCH MUST BE CHOSEN
+                         ELSE_BRANCH_TAKEN := 2 * ELSE_BRANCH_TAKEN ;
+                         COMMENT( "ELSE_BRANCH  TAKEN  (#2)" );
+                    END SELECT;
+
+               END  SECOND_ATTEMPT ;
+
+          BEGIN
+
+               ACCEPT DO_IT_NOW_ORELSE ( AUTHORIZED : IN BOOLEAN )  DO
+
+                    IF  AUTHORIZED  THEN
+                         COMMENT(  "AUTHORIZED ENTRY_CALL" );
+                    ELSE
+                         FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                    END IF;
+
+               END DO_IT_NOW_ORELSE ;
+
+
+          END  T ;
+
+
+          PACKAGE       FIRST_ATTEMPT  IS      END  FIRST_ATTEMPT ;
+          PACKAGE BODY  FIRST_ATTEMPT  IS
+          BEGIN
+               SELECT
+                    T.DO_IT_NOW_ORELSE (FALSE) ;
+               ELSE        -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                            --      THEREFORE THIS BRANCH MUST BE CHOSEN
+                    ELSE_BRANCH_TAKEN := 1 + ELSE_BRANCH_TAKEN ;
+                    COMMENT( "ELSE_BRANCH  TAKEN  (#1)" );
+               END SELECT;
+
+          END  FIRST_ATTEMPT ;
+
+
+     BEGIN
+
+          T.DO_IT_NOW_ORELSE ( TRUE );   -- TO SATISFY THE SERVER'S
+                                          --     WAIT FOR SUCH A CALL
+
+     EXCEPTION
+
+          WHEN  TASKING_ERROR  =>
+               FAILED( "TASKING ERROR" );
+
+     END  ;
+
+
+     -------------------------------------------------------------------
+
+
+     -- BY NOW, THE TASK IS TERMINATED  (AND THE NONLOCALS UPDATED)
+
+
+     CASE  ELSE_BRANCH_TAKEN  IS
+
+          WHEN  3  =>
+               FAILED( "NO 'ELSE'; BOTH (?) RENDEZVOUS ATTEMPTED?" );
+
+          WHEN  4  =>
+               FAILED( "'ELSE' #1 ONLY; RENDEZVOUS (#2) ATTEMPTED?" );
+
+          WHEN  6  =>
+               FAILED( "'ELSE' #2 ONLY; RENDEZVOUS (#1) ATTEMPTED?" );
+
+          WHEN  7  =>
+               FAILED( "WRONG ORDER FOR 'ELSE':  #2,#1 " );
+
+          WHEN  8  =>
+               NULL ;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG CASE_VALUE" );
+
+     END CASE;
+
+
+     RESULT;
+
+
+END  C97201A ; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201b.ada
new file mode 100644
index 000000000..d8e44b055
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201b.ada
@@ -0,0 +1,108 @@
+-- C97201B.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 CONDITIONAL ENTRY CALL IS NOT ACCEPTED IF THERE IS
+-- ANOTHER TASK QUEUED FOR THE ENTRY.
+
+-- WRG 7/11/86
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C97201B IS
+
+
+BEGIN
+
+     TEST ("C97201B", "CHECK THAT A CONDITIONAL ENTRY CALL IS NOT " &
+                      "ACCEPTED IF THERE IS ANOTHER TASK QUEUED " &
+                      "FOR THE ENTRY");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E;
+               ENTRY SYNCH;
+               ENTRY DONE;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               -- ENSURE THAT E HAS BEEN CALLED BEFORE PROCEEDING:
+               WHILE E'COUNT = 0 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+
+               ACCEPT SYNCH;
+
+               SELECT
+                    WHEN IDENT_BOOL (FALSE) =>
+                         ACCEPT E;
+                         FAILED ("CLOSED ALTERNATIVE TAKEN");
+               OR
+                    ACCEPT DONE DO
+                         IF E'COUNT /= 1 THEN
+                              FAILED (NATURAL'IMAGE(E'COUNT) &
+                                      " CALLS WERE QUEUED FOR ENTRY " &
+                                      "E OF TASK T");
+                         END IF;
+                    END DONE;
+               OR
+                    DELAY 1000.0 * Impdef.One_Second;
+                    FAILED ("DELAY EXPIRED; E'COUNT =" &
+                            NATURAL'IMAGE(E'COUNT) );
+               END SELECT;
+
+               WHILE E'COUNT > 0 LOOP
+                    ACCEPT E;
+               END LOOP;
+          END T;
+
+          TASK AGENT;
+
+          TASK BODY AGENT IS
+          BEGIN
+               T.E;
+          END AGENT;
+
+     BEGIN
+
+          T.SYNCH;
+
+          DELAY 10.0 * Impdef.One_Second;
+
+          SELECT
+               T.E;
+               FAILED ("CONDITIONAL ENTRY CALL ACCEPTED" );
+          ELSE
+               COMMENT ("ELSE PART EXECUTED");
+               T.DONE;
+          END SELECT;
+
+     END;
+
+     RESULT;
+
+END C97201B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201c.ada
new file mode 100644
index 000000000..e09d01ee3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201c.ada
@@ -0,0 +1,70 @@
+-- C97201C.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 CONDITIONAL ENTRY CALL IS NOT ACCEPTED IF AN ACCEPT
+-- STATEMENT FOR THE CALLED ENTRY HAS NOT YET BEEN REACHED.
+
+-- WRG 7/11/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97201C IS
+
+BEGIN
+
+     TEST ("C97201C", "CHECK THAT A CONDITIONAL ENTRY CALL IS NOT " &
+                      "ACCEPTED IF AN ACCEPT STATEMENT FOR THE " &
+                      "CALLED ENTRY HAS NOT YET BEEN REACHED");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E;
+               ENTRY BARRIER;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT BARRIER;
+               IF E'COUNT > 0 THEN
+                    FAILED ("ENTRY CALL WAS QUEUED");
+                    ACCEPT E;
+               END IF;
+          END T;
+
+     BEGIN
+
+          SELECT
+               T.E;
+               FAILED ("CONDITIONAL ENTRY CALL ACCEPTED");
+          ELSE
+               COMMENT ("ELSE PART EXECUTED");
+          END SELECT;
+
+          T.BARRIER;
+
+     END;
+
+     RESULT;
+
+END C97201C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201d.ada
new file mode 100644
index 000000000..2ea7ba01a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201d.ada
@@ -0,0 +1,102 @@
+-- C97201D.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 RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
+--     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
+
+-- CASE  D:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
+--     DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY  -
+--     AND THIS FACT IS DETERMINED STATICALLY.
+
+
+-- RM 4/12/82
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97201D IS
+
+     ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
+
+BEGIN
+
+
+     TEST ("C97201D", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
+                      " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
+                      " IN THE ABSENCE OF A CORRESPONDING "        &
+                      " ACCEPT_STATEMENT "                         );
+
+
+     DECLARE
+
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_ORELSE ;
+               ENTRY  KEEP_ALIVE ;
+          END  T ;
+          
+
+          TASK BODY  T  IS
+          BEGIN
+
+               -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED
+
+               ACCEPT  KEEP_ALIVE ;  -- TO PREVENT THIS SERVER TASK FROM
+                                     --     TERMINATING IF
+                                     --     UPON ACTIVATION
+                                     --     IT GETS TO RUN    
+                                     --     AHEAD OF THE CALLER (WHICH
+                                     --     WOULD LEAD TO A SUBSEQUENT
+                                     --     TASKING_ERROR AT THE TIME OF
+                                     --     THE NO-WAIT CALL).
+
+          END ;
+
+
+     BEGIN
+
+          SELECT
+               T.DO_IT_NOW_ORELSE ;
+          ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                            --      THEREFORE THIS BRANCH MUST BE CHOSEN
+               ELSE_BRANCH_TAKEN := TRUE ;
+               COMMENT( "ELSE_BRANCH  TAKEN" );
+          END SELECT;
+
+          T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
+
+     END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
+
+
+     -- BY NOW, THE TASK IS TERMINATED
+
+     IF  ELSE_BRANCH_TAKEN  THEN
+          NULL ;
+     ELSE
+          FAILED( "RENDEZVOUS ATTEMPTED?" );
+     END IF;
+
+     RESULT;
+
+
+END  C97201D ; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201e.ada
new file mode 100644
index 000000000..5473b572a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201e.ada
@@ -0,0 +1,107 @@
+-- C97201E.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 RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
+--     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
+
+-- CASE  E:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
+--     DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY  -
+--     AND THIS FACT CAN NOT BE DETERMINED STATICALLY.
+--     (THE ENTRY BELONGS TO AN ENTRY FAMILY; SOME FAMILY MEMBERS
+--     ARE "ACCEPTABLE", BUT NOT THE CALLED ONE.)
+
+
+-- RM 4/13/82
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97201E IS
+
+     ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
+
+BEGIN
+
+
+     TEST ("C97201E", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
+                      " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
+                      " IN THE ABSENCE OF A CORRESPONDING "        &
+                      " ACCEPT_STATEMENT "                         );
+
+
+     DECLARE
+
+          SUBTYPE  SHORT  IS  INTEGER RANGE 10..20 ;
+
+          KEEP_ALIVE  :  INTEGER  := 15 ;
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_ORELSE ( SHORT ) ;
+          END  T ;
+          
+
+          TASK BODY  T  IS
+          BEGIN
+
+               -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED
+               ACCEPT  DO_IT_NOW_ORELSE ( IDENT_INT(15) );
+
+                                     -- THIS ALSO PREVENTS THIS SERVER
+                                     --     TASK FROM TERMINATING IF
+                                     --     UPON ACTIVATION
+                                     --     IT GETS TO RUN    
+                                     --     AHEAD OF THE CALLER (WHICH
+                                     --     WOULD LEAD TO A SUBSEQUENT
+                                     --     TASKING_ERROR AT THE TIME OF
+                                     --     THE NO-WAIT CALL).
+
+          END ;
+
+
+     BEGIN
+
+          SELECT
+               T.DO_IT_NOW_ORELSE (10) ;  -- ACCEPT_STATEMENT HAS  15
+          ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                            --      THEREFORE THIS BRANCH MUST BE CHOSEN
+               ELSE_BRANCH_TAKEN := TRUE ;
+               COMMENT( "ELSE_BRANCH  TAKEN" );
+          END SELECT;
+
+          T.DO_IT_NOW_ORELSE(KEEP_ALIVE) ;-- THIS ALSO UPDATES NONLOCALS
+
+     END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
+
+
+     -- BY NOW, THE TASK IS TERMINATED
+
+     IF  ELSE_BRANCH_TAKEN  THEN
+          NULL ;
+     ELSE
+          FAILED( "RENDEZVOUS ATTEMPTED?" );
+     END IF;
+
+     RESULT;
+
+
+END  C97201E ; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201g.ada
new file mode 100644
index 000000000..ae5fad3bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201g.ada
@@ -0,0 +1,133 @@
+-- C97201G.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 RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
+--     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
+
+-- CASE  G:  THE CORRESPONDING ACCEPT_STATEMENT IS CLOSED
+--     AND THIS FACT IS STATICALLY DETERMINABLE.
+
+
+-- RM 4/21/82
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97201G IS
+
+     ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
+     RENDEZVOUS_OCCURRED  :  BOOLEAN  :=  FALSE ;
+     QUEUE_NOT_EMPTY      :  BOOLEAN  :=  FALSE ;
+     X                    :  INTEGER  :=  17 ;
+
+BEGIN
+
+
+     TEST ("C97201G", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
+                      " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
+                      " IF THE CORRESPONDING ACCEPT_STATEMENT IS"  &
+                      " CLOSED"                                    );
+
+
+     -------------------------------------------------------------------
+
+
+     DECLARE
+
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_ORELSE( DID_YOU_DO_IT : IN OUT BOOLEAN);
+               ENTRY  KEEP_ALIVE ;
+          END  T ;
+          
+
+          TASK BODY  T  IS
+          BEGIN
+
+               IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                    QUEUE_NOT_EMPTY := TRUE ;
+               END IF;
+
+
+               SELECT
+                    WHEN  3 = 5  =>
+                         ACCEPT  DO_IT_NOW_ORELSE
+                                      ( DID_YOU_DO_IT : IN OUT BOOLEAN)
+                         DO
+                              DID_YOU_DO_IT := TRUE ;
+                         END;
+               OR
+                         ACCEPT  KEEP_ALIVE ; -- TO PREVENT SELECT_ERROR
+               END SELECT;
+
+
+               IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                    QUEUE_NOT_EMPTY := TRUE ;
+               END IF;
+
+
+          END  T ;
+
+
+     BEGIN
+
+          COMMENT( "PERMANENTLY CLOSED" );
+
+          SELECT
+               T.DO_IT_NOW_ORELSE( RENDEZVOUS_OCCURRED );
+          ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                            --      THEREFORE THIS BRANCH MUST BE CHOSEN
+               ELSE_BRANCH_TAKEN := TRUE ;
+               COMMENT( "ELSE_BRANCH  TAKEN" );
+          END SELECT;
+
+          T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
+
+     END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
+
+
+     -------------------------------------------------------------------
+
+
+     -- BY NOW, THE TASK IS TERMINATED
+
+     IF  RENDEZVOUS_OCCURRED
+     THEN
+          FAILED( "RENDEZVOUS OCCURRED" );
+     END IF;
+
+     IF  QUEUE_NOT_EMPTY
+     THEN
+          FAILED( "ENTRY QUEUE NOT EMPTY" );
+     END IF;
+
+     IF  ELSE_BRANCH_TAKEN  THEN
+          NULL ;
+     ELSE
+          FAILED( "RENDEZVOUS ATTEMPTED?" );
+     END IF;
+
+     RESULT;
+
+
+END  C97201G ; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201h.ada
new file mode 100644
index 000000000..ad4a46189
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201h.ada
@@ -0,0 +1,133 @@
+-- C97201H.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 RENDEZVOUS REQUESTED BY A CONDITIONAL_ENTRY_CALL
+--     IS PERFORMED ONLY IF IMMEDIATELY POSSIBLE.
+
+-- CASE  H:  THE CORRESPONDING ACCEPT_STATEMENT IS CLOSED
+--     AND THIS FACT IS NOT STATICALLY DETERMINABLE.
+
+
+-- RM 4/22/82
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97201H IS
+
+     ELSE_BRANCH_TAKEN    :  BOOLEAN  :=  FALSE ;
+     RENDEZVOUS_OCCURRED  :  BOOLEAN  :=  FALSE ;
+     QUEUE_NOT_EMPTY      :  BOOLEAN  :=  FALSE ;
+     X                    :  INTEGER  :=  17 ;
+
+BEGIN
+
+
+     TEST ("C97201H", "CHECK THAT NO RENDEZVOUS REQUESTED BY"      &
+                      " A CONDITIONAL_ENTRY_CALL CAN EVER OCCUR"   &
+                      " IF THE CORRESPONDING ACCEPT_STATEMENT IS"  &
+                      " CLOSED"                                    );
+
+
+     -------------------------------------------------------------------
+
+
+     DECLARE
+
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_ORELSE( DID_YOU_DO_IT : IN OUT BOOLEAN);
+               ENTRY  KEEP_ALIVE ;
+          END  T ;
+          
+
+          TASK BODY  T  IS
+          BEGIN
+
+               IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                    QUEUE_NOT_EMPTY := TRUE ;
+               END IF;
+
+
+               SELECT
+                    WHEN  3 = IDENT_INT(5)  =>
+                         ACCEPT  DO_IT_NOW_ORELSE
+                                      ( DID_YOU_DO_IT : IN OUT BOOLEAN)
+                         DO
+                              DID_YOU_DO_IT := TRUE ;
+                         END;
+               OR
+                         ACCEPT  KEEP_ALIVE ; -- TO PREVENT SELECT_ERROR
+               END SELECT;
+
+
+               IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                    QUEUE_NOT_EMPTY := TRUE ;
+               END IF;
+
+
+          END  T ;
+
+
+     BEGIN
+
+          COMMENT( "PERMANENTLY CLOSED" );
+
+          SELECT
+               T.DO_IT_NOW_ORELSE( RENDEZVOUS_OCCURRED );
+          ELSE              -- (I.E. CALLER ADOPTS A NO-WAIT POLICY)
+                            --      THEREFORE THIS BRANCH MUST BE CHOSEN
+               ELSE_BRANCH_TAKEN := TRUE ;
+               COMMENT( "ELSE_BRANCH  TAKEN" );
+          END SELECT;
+
+          T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
+
+     END;   -- END OF BLOCK CONTAINING THE ENTRY CALL
+
+
+     -------------------------------------------------------------------
+
+
+     -- BY NOW, THE TASK IS TERMINATED
+
+     IF  RENDEZVOUS_OCCURRED
+     THEN
+          FAILED( "RENDEZVOUS OCCURRED" );
+     END IF;
+
+     IF  QUEUE_NOT_EMPTY
+     THEN
+          FAILED( "ENTRY QUEUE NOT EMPTY" );
+     END IF;
+
+     IF  ELSE_BRANCH_TAKEN  THEN
+          NULL ;
+     ELSE
+          FAILED( "RENDEZVOUS ATTEMPTED?" );
+     END IF;
+
+     RESULT;
+
+
+END  C97201H ; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201x.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201x.ada
new file mode 100644
index 000000000..e7f74d982
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97201x.ada
@@ -0,0 +1,170 @@
+-- C97201X.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 NO RENDEZVOUS CAN EVER OCCUR IF BOTH PARTNERS REFUSE TO
+--     WAIT (THAT IS, IF THE ENTRY CALL IS ISSUED BY A
+--     "CONDITIONAL_ENTRY_CALL" AND THUS FOLLOWS A NO-WAIT POLICY
+--     (DEMANDING UNCONDITIONALLY THAT "YOU DO IT   N O W  , OR ELSE"),
+--     WHILE THE CALLEE IS ALSO COMMITTED TO A NO-WAIT POLICY,
+--     BY VIRTUE OF A SELECTIVE_WAIT STATEMENT OF THE THIRD KIND
+--     (WITH AN "ELSE" PART) IN WHICH THE CORRESPONDING ACCEPT_STATEMENT
+--     IS EMBEDDED).
+--     ("CLOSE ENCOUNTERS OF THE THIRD KIND"  --  ARE THEY POSSIBLE?)
+
+
+-- THE SEMANTICS OF THIS ENTRY CALL REQUIRES THAT THE CALLING TASK
+--     N O T   ENTER ITSELF ON ANY QUEUE BUT RATHER ATTEMPT AN IMMEDIATE
+--     RENDEZVOUS WHICH IS TO TAKE PLACE IF AND ONLY IF THE CALLED TASK
+--     HAS REACHED A POINT WHERE IT IS READY TO ACCEPT THE CALL (I.E.
+--     IT IS EITHER WAITING AT AN ACCEPT STATEMENT FOR THE CORRESPONDING
+--     ENTRY OR IT IS WAITING AT A SELECTIVE_WAIT STATEMENT WITH AN OPEN
+--     ALTERNATIVE STARTING WITH SUCH AN ACCEPT STATEMENT).  IT ALSO
+--     REQUIRES THAT THE ENTRY CALL BE CANCELLED IF THE CALLED TASK 
+--     IS NOT AT SUCH A POINT.  ON THE OTHER HAND, THE SEMANTICS OF THE
+--     SELECTIVE_WAIT STATEMENT WITH AN  'ELSE'  PART  SPECIFIES THAT
+--     THE  'ELSE'  PART  MUST BE SELECTED IF NO 'ACCEPT' ALTERNATIVE
+--     CAN BE IMMEDIATELY SELECTED,  AND THAT SUCH AN ALTERNATIVE
+--     IS DEEMED TO BE IMMEDIATELY SELECTABLE ("SELECTION OF ONE SUCH
+--     ALTERNATIVE OCCURS IMMEDIATELY"), AND A CORRESPONDING RENDEZVOUS
+--     POSSIBLE,  IF AND ONLY IF THERE IS A CORRESPONDING ENTRY CALL
+--     W A I T I N G   TO BE ACCCEPTED.  A "CONDITIONAL ENTRY CALL"
+--     NEVER WAITS, AND IS NEVER ENTERED IN WAIT QUEUES; IT TAKES
+--     THE 'ELSE' PART INSTEAD.
+
+
+-- NOTE: IF THIS TEST PROGRAM HANGS UP, THE COMPILER WILL BE DEEMED
+--     TO HAVE FAILED.
+
+
+-- RM 3/19/82
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97201X IS
+
+     RENDEZVOUS_OCCURRED        :  BOOLEAN  :=  FALSE ;
+
+     CALLER_TAKES_WRONG_BRANCH  :  BOOLEAN  :=  TRUE  ;
+     SERVER_TAKES_WRONG_BRANCH  :  BOOLEAN  :=  TRUE  ;
+     QUEUE_NOT_EMPTY            :  BOOLEAN  :=  FALSE ;
+
+BEGIN
+
+
+     TEST ("C97201X", "CHECK THAT NO RENDEZVOUS CAN EVER OCCUR IF" &
+                      " BOTH PARTNERS REFUSE TO WAIT" );
+
+
+     DECLARE
+
+
+          TASK  T  IS
+               ENTRY  SYNCHRONIZE ;
+               ENTRY  DO_IT_NOW_ORELSE( DID_YOU_DO_IT : IN OUT BOOLEAN);
+               ENTRY  KEEP_ALIVE  ;
+          END  T ;
+          
+
+          TASK BODY  T  IS
+          BEGIN
+
+
+               ACCEPT  SYNCHRONIZE ;
+
+
+               IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                    QUEUE_NOT_EMPTY := TRUE ;
+               END IF;
+
+
+               SELECT
+                         ACCEPT  DO_IT_NOW_ORELSE
+                                      ( DID_YOU_DO_IT : IN OUT BOOLEAN )
+                         DO
+                              DID_YOU_DO_IT  :=  TRUE ;
+                         END ;
+               ELSE         -- (I.E. TASK ADOPTS NO-WAIT POLICY)
+                            -- 'ELSE' BRANCH MUST THEREFORE BE CHOSEN
+                    SERVER_TAKES_WRONG_BRANCH := FALSE ;
+               END SELECT;
+
+
+               IF  DO_IT_NOW_ORELSE'COUNT /= 0  THEN
+                    QUEUE_NOT_EMPTY := TRUE ;
+               END IF;
+
+
+               ACCEPT  KEEP_ALIVE ;  -- TO PREVENT THIS SERVER TASK FROM
+                                     --     TERMINATING IF IT GETS TO
+                                     --     THE NO-WAIT MEETING-PLACE
+                                     --     AHEAD OF THE CALLER (WHICH
+                                     --     WOULD LEAD TO A SUBSEQUENT
+                                     --     TASKING_ERROR AT THE TIME OF
+                                     --     THE NO-WAIT CALL).
+
+
+          END  T ;
+
+
+     BEGIN
+
+
+          T.SYNCHRONIZE ;  -- TO MINIMIZE THE   N E E D   TO WAIT
+
+
+          SELECT
+               T.DO_IT_NOW_ORELSE ( RENDEZVOUS_OCCURRED );
+          ELSE              -- (I.E. CALLER TOO ADOPTS A NO-WAIT POLICY)
+                                    -- MUST THEREFORE CHOOSE THIS BRANCH
+               CALLER_TAKES_WRONG_BRANCH := FALSE ;
+          END SELECT;
+
+
+          T.KEEP_ALIVE ;    -- THIS ALSO UPDATES THE NONLOCALS
+
+
+     END;   -- END OF BLOCK CONTAINING THE NO-WAIT ENTRY CALL
+
+
+     IF  RENDEZVOUS_OCCURRED
+     THEN
+          FAILED( "RENDEZVOUS OCCURRED" );
+     END IF;
+
+     IF  CALLER_TAKES_WRONG_BRANCH  OR
+         SERVER_TAKES_WRONG_BRANCH
+     THEN
+          FAILED( "WRONG BRANCH TAKEN" );
+     END IF;
+
+     IF  QUEUE_NOT_EMPTY
+     THEN
+          FAILED( "ENTRY QUEUE NOT EMPTY" );
+     END IF;
+
+
+     RESULT;
+
+
+END  C97201X ; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97202a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97202a.ada
new file mode 100644
index 000000000..3856e7fd2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97202a.ada
@@ -0,0 +1,100 @@
+-- C97202A.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 INDEX IS EVALUATED BEFORE THE ENTRY PARAMETER AND BOTH
+-- THE INDEX AND THE ENTRY PARAMETER ARE EVALUATED BEFORE THE RENDEZVOUS
+-- IS ATTEMPED.
+
+-- RM 4/05/82
+-- TBN 2/3/86     ADDED A CHECK THAT INDEX IS EVALUATED BEFORE THE ENTRY
+--                PARAMETER AND FIXED APPROPRIATE COMMENTS.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97202A IS
+
+     INDEX_COMPUTED   :  BOOLEAN  :=  FALSE ;
+     FORMAL_COMPUTED  :  BOOLEAN  :=  FALSE ;
+
+BEGIN
+
+     TEST ("C97202A", "CHECK THAT THE INDEX IS EVALUATED BEFORE THE " &
+                      "ENTRY PARAMETER AND BOTH INDEX AND THE ENTRY " &
+                      "PARAMETER ARE EVALUATED BEFORE THE RENDEZVOUS " &
+                      "IS ATTEMPTED");
+
+     DECLARE
+          SUBTYPE  SHORT  IS  INTEGER RANGE 10..20 ;
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_ORELSE (SHORT)
+                                       (DID_YOU_DO_IT : IN BOOLEAN);
+               ENTRY  KEEP_ALIVE ;
+          END  T ;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT  KEEP_ALIVE ;
+          END  T ;
+
+          FUNCTION  F1 (X:INTEGER) RETURN INTEGER  IS
+          BEGIN
+               IF FORMAL_COMPUTED THEN
+                    FAILED ("INDEX WAS NOT EVALUATED FIRST");
+               END IF;
+               INDEX_COMPUTED  :=  TRUE ;
+               RETURN (7) ;
+          END  F1 ;
+
+          FUNCTION  F2 (X:INTEGER) RETURN BOOLEAN  IS
+          BEGIN
+               FORMAL_COMPUTED  :=  TRUE ;
+               RETURN (FALSE) ;
+          END  F2 ;
+
+     BEGIN
+          SELECT
+               T.DO_IT_NOW_ORELSE ( 6 + F1(7)  )
+                                  ( NOT(F2(7)) ) ;
+          ELSE
+               NULL ;
+          END SELECT;
+
+          T.KEEP_ALIVE ;
+     END;   -- END OF BLOCK CONTAINING THE ENTRY CALLS.
+
+     IF  INDEX_COMPUTED  THEN
+          NULL ;
+     ELSE
+          FAILED( "ENTRY INDEX WAS NOT COMPUTED" );
+     END IF;
+
+     IF  FORMAL_COMPUTED  THEN
+          NULL ;
+     ELSE
+          FAILED( "ENTRY PARAMETER WAS NOT COMPUTED" );
+     END IF;
+
+     RESULT;
+
+END  C97202A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97203a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97203a.ada
new file mode 100644
index 000000000..64510dd9e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97203a.ada
@@ -0,0 +1,125 @@
+-- C97203A.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 CONDITIONAL_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
+--     SELECTIVE_WAIT  CANNOT.
+
+-- PART 1: PACKAGE BODY EMBEDDED IN TASK BODY.
+
+
+-- RM 4/01/1982
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE  C97203A  IS
+
+
+BEGIN
+
+
+     TEST ( "C97203A" , "CHECK THAT A  CONDITIONAL_ENTRY_CALL  CAN" &
+                        " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
+
+
+     -------------------------------------------------------------------
+
+
+     DECLARE
+
+
+          TASK  TT  IS
+               ENTRY  A ( AUTHORIZED : IN BOOLEAN );
+          END  TT ;
+
+
+          TASK BODY  TT  IS
+
+
+               PACKAGE  WITHIN_TASK_BODY  IS
+                    -- NOTHING HERE
+               END  WITHIN_TASK_BODY ;
+
+
+               PACKAGE BODY  WITHIN_TASK_BODY  IS
+               BEGIN
+
+                    SELECT  -- NOT A SELECTIVE_WAIT
+                         A ( FALSE ) ;  -- CALLING (OWN) ENTRY
+                    ELSE 
+                         COMMENT( "ALTERNATIVE BRANCH TAKEN" );
+                    END SELECT;
+                    
+               END  WITHIN_TASK_BODY ;
+
+
+          BEGIN
+
+               ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
+
+                    IF  AUTHORIZED  THEN
+                         COMMENT(  "AUTHORIZED ENTRY_CALL" );
+                    ELSE
+                         FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                    END IF;
+
+               END  A ;
+
+          END  TT ;
+
+
+          PACKAGE  OUTSIDE_TASK_BODY  IS
+               -- NOTHING HERE
+          END  OUTSIDE_TASK_BODY ;
+
+
+          PACKAGE BODY  OUTSIDE_TASK_BODY  IS
+          BEGIN
+
+               SELECT  -- NOT A SELECTIVE_WAIT
+                    TT.A ( FALSE ) ;  -- UNBORN
+               ELSE 
+                    COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
+               END SELECT;
+
+          END  OUTSIDE_TASK_BODY ;
+
+
+     BEGIN
+
+          TT.A ( TRUE );
+
+     EXCEPTION
+
+          WHEN  TASKING_ERROR  =>
+               FAILED( "TASKING ERROR" );
+
+     END  ;
+
+     -------------------------------------------------------------------
+
+     RESULT ;
+
+
+END  C97203A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97203b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97203b.ada
new file mode 100644
index 000000000..089815495
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97203b.ada
@@ -0,0 +1,131 @@
+-- C97203B.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 CONDITIONAL_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
+--     SELECTIVE_WAIT  CANNOT.
+
+-- PART 2: PROCEDURE BODY EMBEDDED IN TASK BODY.
+
+
+-- RM 4/09/1982
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE  C97203B  IS
+
+
+BEGIN
+
+
+     TEST ( "C97203B" , "CHECK THAT A  CONDITIONAL_ENTRY_CALL  CAN" &
+                        " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
+
+
+     -------------------------------------------------------------------
+
+
+     DECLARE
+
+
+          TASK  TT  IS
+               ENTRY  A ( AUTHORIZED : IN BOOLEAN );
+          END  TT ;
+
+
+          TASK BODY  TT  IS
+
+
+               PROCEDURE  WITHIN_TASK_BODY ;
+
+
+               PROCEDURE  WITHIN_TASK_BODY  IS
+               BEGIN
+
+                    SELECT  -- NOT A SELECTIVE_WAIT
+                         A ( FALSE ) ;  -- CALLING (OWN) ENTRY
+                    ELSE 
+                         COMMENT( "ALTERNATIVE BRANCH TAKEN" );
+                    END SELECT;
+                    
+               END  WITHIN_TASK_BODY ;
+
+
+          BEGIN
+
+
+               -- CALL THE INNER PROC. TO FORCE EXEC. OF COND_E_CALL
+               WITHIN_TASK_BODY ;
+
+
+               ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
+
+                    IF  AUTHORIZED  THEN
+                         COMMENT(  "AUTHORIZED ENTRY_CALL" );
+                    ELSE
+                         FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                    END IF;
+
+               END  A ;
+
+          END  TT ;
+
+
+          PROCEDURE  OUTSIDE_TASK_BODY  IS
+          BEGIN
+
+               SELECT  -- NOT A SELECTIVE_WAIT
+                    TT.A ( FALSE ) ;  -- UNBORN
+               ELSE 
+                    COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
+               END SELECT;
+
+          END  OUTSIDE_TASK_BODY ;
+
+
+          PACKAGE       CREATE_OPPORTUNITY_TO_CALL           IS END;   
+          PACKAGE BODY  CREATE_OPPORTUNITY_TO_CALL  IS
+          BEGIN
+               -- CALL THE OTHER PROC. TO FORCE EXEC. OF COND_E_CALL
+               OUTSIDE_TASK_BODY ;
+          END  CREATE_OPPORTUNITY_TO_CALL ;
+
+
+     BEGIN
+
+          TT.A ( TRUE );
+
+     EXCEPTION
+
+          WHEN  TASKING_ERROR  =>
+               FAILED( "TASKING ERROR" );
+
+     END  ;
+
+     -------------------------------------------------------------------
+
+     RESULT ;
+
+
+END  C97203B ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97203c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97203c.ada
new file mode 100644
index 000000000..d8d9bf5a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97203c.ada
@@ -0,0 +1,124 @@
+-- C97203C.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 CONDITIONAL ENTRY CALL CAN APPEAR IN PLACES WHERE A
+-- SELECTIVE WAIT IS NOT ALLOWED.
+
+-- PART 3: TASK BODY NESTED WITHIN A TASK.
+
+-- WRG 7/15/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97203C IS
+
+BEGIN
+
+     TEST ("C97203C", "CHECK THAT A CONDITIONAL ENTRY CALL CAN " &
+                      "APPEAR IN PLACES WHERE A SELECTIVE WAIT " &
+                      "IS NOT ALLOWED; CASE: TASK BODY NESTED " &
+                      "WITHIN A TASK");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E;
+               ENTRY SYNCH;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT SYNCH;
+               ACCEPT SYNCH;
+               ACCEPT SYNCH;
+               ACCEPT E;
+          END T;
+
+          TASK OUTER IS
+               ENTRY E;
+               ENTRY SYNCH;
+          END OUTER;
+
+          TASK BODY OUTER IS
+
+               TASK TYPE INNER;
+
+               INNER1 : INNER;
+
+               TASK BODY INNER IS
+               BEGIN
+                    SELECT
+                         T.E;
+                         FAILED ("CONDITIONAL ENTRY CALL ACCEPTED - " &
+                                 "INNER (1)");
+                    ELSE
+                         T.SYNCH;
+                    END SELECT;
+
+                    SELECT
+                         OUTER.E;
+                         FAILED ("CONDITIONAL ENTRY CALL ACCEPTED - " &
+                                 "INNER (2)");
+                    ELSE
+                         OUTER.SYNCH;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED - INNER");
+               END INNER;
+
+               PACKAGE DUMMY IS
+                    TYPE ACC_INNER IS ACCESS INNER;
+                    INNER2 : ACC_INNER := NEW INNER;
+               END DUMMY;
+
+          BEGIN
+
+               SELECT
+                    T.E;
+                    FAILED ("CONDITIONAL ENTRY CALL ACCEPTED - OUTER");
+               ELSE
+                    T.SYNCH;
+               END SELECT;
+
+               ACCEPT SYNCH;
+               ACCEPT SYNCH;
+               ACCEPT E;
+
+          EXCEPTION
+
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - OUTER");
+
+          END OUTER;
+
+     BEGIN
+
+          T.E;
+          OUTER.E;
+
+     END;
+
+     RESULT;
+
+END C97203C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97204a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97204a.ada
new file mode 100644
index 000000000..a1913a0b3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97204a.ada
@@ -0,0 +1,122 @@
+-- C97204A.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 EXCEPTION  TASKING_ERROR  WILL BE RAISED IF THE CALLED
+--     TASK HAS ALREADY COMPLETED ITS EXECUTION AT THE TIME OF THE
+--     CONDITIONAL_ENTRY_CALL.
+
+
+-- RM 5/28/82
+-- SPS 11/21/82
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE  C97204A  IS
+
+     -- THE TASK WILL HAVE HIGHER PRIORITY ( PRIORITY'LAST )
+
+BEGIN
+
+
+     -------------------------------------------------------------------
+
+
+     TEST ("C97204A", "CHECK THAT THE EXCEPTION  TASKING_ERROR  WILL" &
+                      " BE RAISED IF THE CALLED TASK HAS ALREADY"     &
+                      " COMPLETED ITS EXECUTION AT THE TIME OF THE"   &
+                      " CONDITIONAL_ENTRY_CALL"                       );
+
+  
+     DECLARE
+
+
+          TASK TYPE  T_TYPE  IS
+
+
+               ENTRY  E ;
+
+          END  T_TYPE ;
+
+
+          T_OBJECT1 : T_TYPE ;
+
+
+          TASK BODY  T_TYPE  IS
+               BUSY : BOOLEAN := FALSE ;
+          BEGIN
+
+               NULL;
+
+          END  T_TYPE ;
+
+
+     BEGIN
+
+
+          FOR  I  IN  1..5  LOOP
+               EXIT WHEN  T_OBJECT1'TERMINATED ;
+               DELAY 10.0 * Impdef.One_Second;
+          END LOOP;
+
+
+          IF NOT  T_OBJECT1'TERMINATED  THEN
+               COMMENT( "TASK NOT YET TERMINATED (AFTER 50 S.)" );
+          END IF;
+
+
+          BEGIN
+
+               SELECT
+                    T_OBJECT1.E ;
+                    FAILED( "CALL WAS NOT DISOBEYED" );
+               ELSE
+                    FAILED( "'ELSE' BRANCH TAKEN INSTEAD OF TSKG_ERR" );
+               END SELECT;
+
+               FAILED( "EXCEPTION NOT RAISED" );
+
+          EXCEPTION
+
+               WHEN  TASKING_ERROR  =>
+                    NULL ;
+
+               WHEN  OTHERS  =>
+                    FAILED(  "WRONG EXCEPTION RAISED"  );
+
+          END ;
+
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+
+     RESULT;
+
+
+END  C97204A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97204b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97204b.ada
new file mode 100644
index 000000000..9e52a9deb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97204b.ada
@@ -0,0 +1,82 @@
+-- C97204B.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 TASKING_ERROR IS RAISED IF THE CALLED TASK IS ABORTED
+-- BEFORE THE CONDITIONAL ENTRY CALL IS EXECUTED.
+
+-- WRG 7/13/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE C97204B IS
+
+BEGIN
+
+     TEST ("C97204B", "CHECK THAT TASKING_ERROR IS RAISED IF THE " &
+                      "CALLED TASK IS ABORTED BEFORE THE CONDITIONAL " &
+                      "ENTRY CALL IS EXECUTED");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E (I : INTEGER);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (I : INTEGER);
+               FAILED ("ENTRY CALL ACCEPTED");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED");
+          END T;
+
+          FUNCTION F RETURN INTEGER IS
+          BEGIN
+               ABORT T;
+               RETURN 1;
+          END F;
+
+     BEGIN
+
+          SELECT
+               T.E (F);
+               FAILED ("CONDITIONAL ENTRY CALL MADE");
+          ELSE
+               FAILED ("ELSE PART EXECUTED");
+          END SELECT;
+
+          FAILED ("EXCEPTION NOT RAISED");
+
+     EXCEPTION
+
+          WHEN TASKING_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+
+     END;
+
+     RESULT;
+
+END C97204B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97205a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97205a.ada
new file mode 100644
index 000000000..a0bd4d9b2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97205a.ada
@@ -0,0 +1,94 @@
+-- C97205A.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 RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
+-- CONDITIONAL ENTRY CALL), IT IS PERFORMED.
+
+-- CASE A: SINGLE ENTRY; THE CALLED TASK IS EXECUTING AN ACCEPT
+--         STATEMENT.
+
+-- WRG 7/13/86
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C97205A IS
+
+     RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+     STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+     COUNT                          : POSITIVE := 1;
+
+
+BEGIN
+
+     TEST ("C97205A", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
+                      "POSSIBLE (FOR A CONDITIONAL ENTRY CALL), IT " &
+                      "IS PERFORMED");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E (B : IN OUT BOOLEAN);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (B : IN OUT BOOLEAN) DO
+                    B := IDENT_BOOL (TRUE);
+               END E;
+          END T;
+
+     BEGIN
+
+          WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
+               DELAY 1.0 * Impdef.One_Second;
+
+               SELECT
+                    T.E (RENDEZVOUS_OCCURRED);
+                    STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+               ELSE
+                    IF COUNT < 60 * 60 THEN
+                         COUNT := COUNT + 1;
+                    ELSE
+                         FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
+                                 "HOUR ELAPSED");
+                         EXIT;
+                    END IF;
+               END SELECT;
+          END LOOP;
+
+     END;
+
+     IF NOT RENDEZVOUS_OCCURRED THEN
+          FAILED ("RENDEZVOUS DID NOT OCCUR");
+     END IF;
+
+     IF COUNT > 1 THEN
+          COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
+     END IF;
+
+     RESULT;
+
+END C97205A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97205b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97205b.ada
new file mode 100644
index 000000000..ec49ad577
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97205b.ada
@@ -0,0 +1,98 @@
+-- C97205B.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 RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
+-- CONDITIONAL ENTRY CALL), IT IS PERFORMED.
+
+-- CASE B: ENTRY FAMILY; THE CALLED TASK IS EXECUTING A SELECTIVE WAIT.
+
+-- WRG 7/13/86
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C97205B IS
+
+     RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+     STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+     COUNT                          : POSITIVE := 1;
+
+
+BEGIN
+
+     TEST ("C97205B", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
+                      "POSSIBLE (FOR A CONDITIONAL ENTRY CALL), IT " &
+                      "IS PERFORMED");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E (1..3) (B : IN OUT BOOLEAN);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               SELECT
+                    ACCEPT E (2) (B : IN OUT BOOLEAN) DO
+                         B := IDENT_BOOL (TRUE);
+                    END E;
+               OR
+                    ACCEPT E (3) (B : IN OUT BOOLEAN);
+                    FAILED ("NONEXISTENT ENTRY CALL ACCEPTED");
+               END SELECT;
+          END T;
+
+     BEGIN
+
+          WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
+               DELAY 1.0 * Impdef.One_Second;
+
+               SELECT
+                    T.E (2) (RENDEZVOUS_OCCURRED);
+                    STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+               ELSE
+                    IF COUNT < 60 * 60 THEN
+                         COUNT := COUNT + 1;
+                    ELSE
+                         FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
+                                 "HOUR ELAPSED");
+                         EXIT;
+                    END IF;
+               END SELECT;
+          END LOOP;
+
+     END;
+
+     IF NOT RENDEZVOUS_OCCURRED THEN
+          FAILED ("RENDEZVOUS DID NOT OCCUR");
+     END IF;
+
+     IF COUNT > 1 THEN
+          COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
+     END IF;
+
+     RESULT;
+
+END C97205B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301a.ada
new file mode 100644
index 000000000..81c65fb11
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301a.ada
@@ -0,0 +1,158 @@
+-- C97301A.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 TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED
+-- AMOUNT OF TIME IF A RENDEVOUS IS NOT POSSIBLE.
+
+-- CASE  A:  THE TASK TO BE CALLED HAS NOT YET BEEN ACTIVATED AS OF THE
+--           MOMENT OF CALL.
+
+-- RJW 3/31/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH CALENDAR; USE CALENDAR;
+PROCEDURE C97301A IS
+
+     WAIT_TIME : CONSTANT DURATION := 10.0 * Impdef.One_Second;
+     OR_BRANCH_TAKEN : INTEGER := 3;
+
+BEGIN
+
+     TEST ("C97301A", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
+                      "LEAST THE SPECIFIED AMOUNT OF TIME WHEN THE " &
+                      "CALLED TASK IS NOT ACTIVE" );
+
+     ------------------------------------------------------------------
+
+     DECLARE
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_OR_WAIT ( AUTHORIZED : IN BOOLEAN );
+          END  T;
+
+          TASK BODY  T  IS
+
+               PACKAGE       SECOND_ATTEMPT  IS    END  SECOND_ATTEMPT;
+               PACKAGE BODY  SECOND_ATTEMPT  IS
+                    START_TIME : TIME;
+               BEGIN
+                    START_TIME := CLOCK;
+                    SELECT
+                         DO_IT_NOW_OR_WAIT (FALSE); --CALLING OWN ENTRY.
+                    OR
+                                      -- THEREFORE THIS BRANCH
+                                      --    MUST BE CHOSEN.
+                         DELAY WAIT_TIME;
+                         IF CLOCK >= (WAIT_TIME + START_TIME) THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "INSUFFICIENT DELAY (#2)" );
+                         END IF;
+                         OR_BRANCH_TAKEN := 2 * OR_BRANCH_TAKEN;
+                         COMMENT( "OR_BRANCH  TAKEN  (#2)" );
+                    END SELECT;
+               END  SECOND_ATTEMPT;
+
+          BEGIN
+
+               ACCEPT DO_IT_NOW_OR_WAIT ( AUTHORIZED : IN BOOLEAN )  DO
+
+                    IF  AUTHORIZED  THEN
+                         COMMENT( "AUTHORIZED ENTRY_CALL" );
+                    ELSE
+                         FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                    END IF;
+
+               END DO_IT_NOW_OR_WAIT;
+
+
+          END  T;
+
+
+          PACKAGE       FIRST_ATTEMPT  IS      END  FIRST_ATTEMPT;
+          PACKAGE BODY  FIRST_ATTEMPT  IS
+               START_TIME : TIME;
+          BEGIN
+               START_TIME := CLOCK;
+               SELECT
+                    T.DO_IT_NOW_OR_WAIT (FALSE);
+               OR
+                                      -- THIS BRANCH MUST BE CHOSEN.
+                    DELAY WAIT_TIME;
+                    IF CLOCK >= (WAIT_TIME + START_TIME) THEN
+                         NULL;
+                    ELSE
+                         FAILED ( "INSUFFICIENT DELAY (#1)" );
+                    END IF;
+                    OR_BRANCH_TAKEN := 1 + OR_BRANCH_TAKEN;
+                    COMMENT( "OR_BRANCH  TAKEN  (#1)" );
+               END SELECT;
+
+          END  FIRST_ATTEMPT;
+
+     BEGIN
+
+          T.DO_IT_NOW_OR_WAIT ( TRUE );   -- TO SATISFY THE SERVER'S
+                                          --     WAIT FOR SUCH A CALL.
+
+     EXCEPTION
+
+          WHEN  TASKING_ERROR  =>
+               FAILED( "TASKING ERROR" );
+
+     END ;
+
+
+     ------------------------------------------------------------------
+
+
+     -- BY NOW, THE TASK IS TERMINATED  (AND THE NONLOCALS UPDATED).
+
+
+     CASE  OR_BRANCH_TAKEN  IS
+
+          WHEN  3  =>
+               FAILED( "NO 'OR'; BOTH (?) RENDEZVOUS ATTEMPTED?" );
+
+          WHEN  4  =>
+               FAILED( "'OR' #1 ONLY; RENDEZVOUS (#2) ATTEMPTED?" );
+
+          WHEN  6  =>
+               FAILED( "'OR' #2 ONLY; RENDEZVOUS (#1) ATTEMPTED?" );
+
+          WHEN  7  =>
+               FAILED( "WRONG ORDER FOR 'OR':  #2,#1" );
+
+          WHEN  8  =>
+               NULL;
+
+          WHEN  OTHERS  =>
+               FAILED( "WRONG CASE_VALUE" );
+
+     END CASE;
+
+     RESULT;
+
+END  C97301A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301b.ada
new file mode 100644
index 000000000..f6dead392
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301b.ada
@@ -0,0 +1,147 @@
+-- C97301B.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 TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED
+--     AMOUNT OF TIME IF A RENDEZVOUS IS NOT POSSIBLE.
+
+--     CASE  B:  THE QUEUE FOR THE CALLED ENTRY ALREADY CONTAINS
+--           ANOTHER  TASK WHOSE RENDEZVOUS CANNOT BE COMPLETED WITHIN
+--           THE SPECIFIED DELAY.
+
+--HISTORY:
+--     RJW 03/31/86 CREATED ORIGINAL TEST.
+--     DHH 10/20/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH CALENDAR; USE CALENDAR;
+PROCEDURE C97301B IS
+
+     OR_BRANCH_TAKEN : BOOLEAN := FALSE;
+
+BEGIN
+
+     TEST ("C97301B", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
+                      "LEAST THE SPECIFIED AMOUNT OF TIME WHEN THE " &
+                      "QUEUE FOR THE CALLED ENTRY ALREADY CONTAINS " &
+                      "ANOTHER TASK WHOSE RENDEZVOUS CANNOT BE " &
+                      "COMPLETED WITHIN THE SPECIFIED DELAY" );
+
+
+     DECLARE
+          WAIT_TIME  : DURATION :=  3.0 * Impdef.One_Second;
+
+          TASK T1;
+
+          TASK T2 IS
+               ENTRY AWAKEN_T2;
+          END T2;
+
+          TASK T3 IS
+               ENTRY AWAKEN_T3;
+               ENTRY RELEASE_T;
+          END T3;
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_OR_WAIT (X : INTEGER);
+          END  T;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT DO_IT_NOW_OR_WAIT (X : INTEGER) DO
+                    IF X = 1 THEN
+                         T2.AWAKEN_T2;
+                         WHILE DO_IT_NOW_OR_WAIT'COUNT = 0 LOOP
+                              DELAY 1.0 * Impdef.One_Second;
+                         END LOOP;
+                         T3.AWAKEN_T3;
+                         T3.RELEASE_T;
+                    ELSE
+                         FAILED ("WRONG TASK IN RENDEZVOUS - 1");
+                    END IF;
+               END DO_IT_NOW_OR_WAIT;
+               ACCEPT DO_IT_NOW_OR_WAIT (X : INTEGER) DO
+                    IF X /= 2 THEN
+                         FAILED ("WRONG TASK IN RENDEZVOUS - 2");
+                    END IF;
+               END DO_IT_NOW_OR_WAIT;
+          END  T;
+
+          TASK BODY T1 IS
+          BEGIN
+               T.DO_IT_NOW_OR_WAIT (1);
+          END T1;
+
+          TASK BODY T2 IS
+          BEGIN
+               ACCEPT AWAKEN_T2;
+               T.DO_IT_NOW_OR_WAIT (2);
+          END T2;
+
+          TASK BODY T3 IS
+               START_TIME : TIME;
+               STOP_TIME : TIME;
+          BEGIN
+               BEGIN
+                    ACCEPT AWAKEN_T3;
+                    START_TIME := CLOCK;
+                    SELECT
+                         T.DO_IT_NOW_OR_WAIT (3);
+                    OR
+                                         -- THIS BRANCH MUST BE CHOSEN.
+                         DELAY WAIT_TIME;
+                         STOP_TIME := CLOCK;
+                         IF STOP_TIME >= (WAIT_TIME + START_TIME) THEN
+                              NULL;
+                         ELSE
+                              FAILED ( "INSUFFICIENT DELAY" );
+                         END IF;
+                         OR_BRANCH_TAKEN := TRUE;
+                         COMMENT( "OR_BRANCH TAKEN" );
+                         ACCEPT RELEASE_T;
+                    END SELECT;
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         FAILED ( "TASKING ERROR" );
+               END;
+                             -- END OF BLOCK CONTAINING TIMED
+                             -- ENTRY CALL.
+
+                             -- BY NOW, THE TASK T IS EFFECTIVELY
+                             -- TERMINATED (AND THE NONLOCALS UPDATED).
+
+               IF OR_BRANCH_TAKEN THEN
+                    NULL;
+               ELSE
+                    FAILED( "RENDEZVOUS ATTEMPTED" );
+               END IF;
+          END T3;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+
+END C97301B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301c.ada
new file mode 100644
index 000000000..a2b3abbc0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301c.ada
@@ -0,0 +1,101 @@
+-- C97301C.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 TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED 
+-- AMOUNT OF TIME IF A RENDEVOUS IS NOT POSSIBLE.
+
+-- CASE  C:  AN ACCEPT STATEMENT FOR THE CALLED ENTRY HAS NOT BEEN
+--           REACHED.
+
+-- RJW 3/31/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH CALENDAR; USE CALENDAR;
+PROCEDURE C97301C IS
+     
+     OR_BRANCH_TAKEN : BOOLEAN := FALSE;
+     
+BEGIN
+
+     TEST ("C97301C", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
+                      "LEAST THE SPECIFIED AMOUNT OF TIME WHEN AN " &
+                      "ACCEPT STATEMENT FOR THE CALLED ENTRY HAS " &
+                      "NOT BEEN REACHED" );
+
+
+     DECLARE
+          START_TIME : TIME;
+          STOP_TIME : TIME;
+          WAIT_TIME  : DURATION :=  3.0 * Impdef.One_Second;
+
+          TASK  T  IS
+               ENTRY NO_SPIN;
+               ENTRY DO_IT_NOW_OR_WAIT;
+          END  T;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT NO_SPIN;
+               ACCEPT DO_IT_NOW_OR_WAIT;
+          END  T;
+
+     BEGIN
+          START_TIME := CLOCK;
+          SELECT
+               T.DO_IT_NOW_OR_WAIT;
+               FAILED("RENDEZVOUS OCCURRED");
+               ABORT T;
+          OR
+                                      -- THIS BRANCH MUST BE CHOSEN.
+               DELAY WAIT_TIME;
+               STOP_TIME := CLOCK;
+               IF STOP_TIME >= (WAIT_TIME + START_TIME) THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INSUFFICIENT DELAY" );
+               END IF;
+               T.NO_SPIN;
+               OR_BRANCH_TAKEN := TRUE;
+               COMMENT( "OR_BRANCH TAKEN" );
+               T.DO_IT_NOW_OR_WAIT;
+          END SELECT;
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               FAILED ( "TASKING ERROR" );
+     END;
+                                     -- END OF BLOCK CONTAINING TIMED 
+                                     -- ENTRY CALL.
+
+     -- BY NOW, TASK T IS TERMINATED (AND THE NONLOCALS UPDATED).
+          
+     IF OR_BRANCH_TAKEN THEN
+          NULL;
+     ELSE
+          FAILED( "RENDEZVOUS ATTEMPTED" );
+     END IF;
+
+     RESULT;
+
+END C97301C; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301d.ada
new file mode 100644
index 000000000..e473fa772
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301d.ada
@@ -0,0 +1,106 @@
+-- C97301D.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 TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED
+-- AMOUNT OF TIME IF A RENDEVOUS IS NOT POSSIBLE.
+
+-- CASE  D:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
+--           DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY.
+
+-- RJW 3/31/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH CALENDAR; USE CALENDAR;
+PROCEDURE C97301D IS
+
+     OR_BRANCH_TAKEN : BOOLEAN := FALSE;
+
+BEGIN
+
+     TEST ("C97301D", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
+                      "LEAST THE SPECIFIED AMOUNT OF TIME WHEN THE " &
+                      "BODY OF THE TASK CONTAINING THE CALLED ENTRY " &
+                      "DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR " &
+                      "THAT ENTRY" );
+
+     DECLARE
+          START_TIME : TIME;
+          WAIT_TIME : CONSTANT DURATION := 10.0 * Impdef.One_Second;
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_OR_WAIT;
+               ENTRY  KEEP_ALIVE;
+          END  T;
+
+          TASK BODY  T  IS
+          BEGIN
+
+               -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED.
+
+               ACCEPT  KEEP_ALIVE;  -- TO PREVENT THIS SERVER TASK FROM
+                                     --     TERMINATING IF
+                                     --     UPON ACTIVATION
+                                     --     IT GETS TO RUN
+                                     --     AHEAD OF THE CALLER (WHICH
+                                     --     WOULD LEAD TO A SUBSEQUENT
+                                     --     TASKING_ERROR AT THE TIME
+                                     --     OF THE NO-WAIT CALL).
+
+          END;
+
+     BEGIN
+          START_TIME := CLOCK;
+          SELECT
+               T.DO_IT_NOW_OR_WAIT;
+          OR
+                            --  THIS BRANCH MUST BE CHOSEN.
+               DELAY WAIT_TIME;
+               IF CLOCK >= (WAIT_TIME + START_TIME) THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INSUFFICIENT WAITING TIME" );
+               END IF;
+               OR_BRANCH_TAKEN := TRUE;
+               COMMENT( "OR_BRANCH  TAKEN" );
+          END SELECT;
+
+          T.KEEP_ALIVE;
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               FAILED ( "TASKING ERROR RAISED" );
+
+     END;   -- END OF BLOCK CONTAINING THE ENTRY CALL.
+
+     -- BY NOW, THE TASK IS TERMINATED.
+
+     IF  OR_BRANCH_TAKEN  THEN
+          NULL;
+     ELSE
+          FAILED( "RENDEZVOUS ATTEMPTED?" );
+     END IF;
+
+     RESULT;
+
+END  C97301D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301e.ada
new file mode 100644
index 000000000..39bf159de
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97301e.ada
@@ -0,0 +1,118 @@
+-- C97301E.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 TIMED_ENTRY_CALL DELAYS FOR AT LEAST THE SPECIFIED 
+-- AMOUNT OF TIME IF A RENDEZVOUS IS NOT POSSIBLE.
+
+-- CASE  E:  THE BODY OF THE TASK CONTAINING THE CALLED ENTRY
+--           DOES NOT CONTAIN AN ACCEPT_STATEMENT FOR THAT ENTRY  -
+--           (THE ENTRY BELONGS TO AN ENTRY FAMILY; SOME FAMILY MEMBERS
+--           ARE "ACCEPTABLE", BUT NOT THE CALLED ONE.)
+
+-- RJW 3/31/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH CALENDAR; USE CALENDAR;
+PROCEDURE C97301E IS
+     
+     OR_BRANCH_TAKEN : BOOLEAN := FALSE;
+     
+BEGIN
+
+     TEST ("C97301E", "CHECK THAT A TIMED_ENTRY_CALL DELAYS FOR AT " &
+                      "LEAST THE SPECIFIED AMOUNT OF TIME " &
+                      "IN THE ABSENCE OF A CORRESPONDING " &
+                      "ACCEPT_STATEMENT " );
+
+     DECLARE
+          
+          WAIT_TIME : DURATION :=  3.0 * Impdef.One_Second;
+          
+          START_TIME : TIME;
+         
+          STOP_TIME : TIME;
+
+          SUBTYPE  SHORT  IS  INTEGER RANGE 10..20 ;
+
+          KEEP_ALIVE  :  INTEGER  := 15 ;
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_OR_WAIT ( SHORT ) ;
+          END  T ;
+          
+          TASK BODY  T  IS
+          BEGIN
+
+               -- NO ACCEPT_STATEMENT FOR THE ENTRY_CALL BEING TESTED.
+               ACCEPT  DO_IT_NOW_OR_WAIT ( IDENT_INT(15) );
+
+                                     -- THIS ALSO PREVENTS THIS SERVER
+                                     --     TASK FROM TERMINATING IF
+                                     --     UPON ACTIVATION
+                                     --     IT GETS TO RUN    
+                                     --     AHEAD OF THE CALLER (WHICH
+                                     --     WOULD LEAD TO A SUBSEQUENT
+                                     --     TASKING_ERROR AT THE TIME 
+                                     --     OF THE NO-WAIT CALL).
+
+          END ;
+
+
+     BEGIN
+          START_TIME := CLOCK;
+          SELECT
+               T.DO_IT_NOW_OR_WAIT (10) ;  -- ACCEPT_STATEMENT HAS 15.
+          OR              
+                            --   THEREFORE THIS BRANCH MUST BE CHOSEN.
+               DELAY WAIT_TIME;
+               STOP_TIME := CLOCK;
+               IF STOP_TIME >= (WAIT_TIME + START_TIME) THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INSUFFICIENT DELAY" );
+               END IF;
+               OR_BRANCH_TAKEN := TRUE ;
+               COMMENT( "OR_BRANCH TAKEN" );
+          END SELECT;
+
+          T.DO_IT_NOW_OR_WAIT (KEEP_ALIVE) ;
+
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               FAILED ( "TASKING ERROR" );
+
+     END;   -- END OF BLOCK CONTAINING THE TIMED ENTRY CALL.
+
+     -- BY NOW, TASK T IS TERMINATED.
+
+     IF  OR_BRANCH_TAKEN  THEN
+          NULL ;
+     ELSE
+          FAILED( "RENDEZVOUS ATTEMPTED" );
+     END IF;
+
+     RESULT;
+
+END  C97301E ; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97302a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97302a.ada
new file mode 100644
index 000000000..18c7afbd3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97302a.ada
@@ -0,0 +1,116 @@
+-- C97302A.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 WHENEVER AN INDEX IS PRESENT IN A TIMED_ENTRY_CALL, IT
+-- IS EVALUATED BEFORE ANY PARAMETER ASSOCIATIONS ARE EVALUATED, AND 
+-- PARAMETER ASSOCIATIONS ARE EVALUATED BEFORE THE DELAY EXPRESSION.
+-- THEN A RENDEZVOUS IS ATTEMPTED.
+
+-- RJW 3/31/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH CALENDAR; USE CALENDAR;
+PROCEDURE C97302A IS
+     
+     INDEX_COMPUTED  :  BOOLEAN  :=  FALSE;
+     PARAM_COMPUTED  :  BOOLEAN  :=  FALSE;     
+     DELAY_COMPUTED  :  BOOLEAN  :=  FALSE;
+BEGIN
+
+     TEST ("C97302A", "CHECK THAT WHENEVER AN INDEX IS PRESENT IN " &
+                      "A TIMED_ENTRY_CALL, IT IS EVALUATED BEFORE " &
+                      "ANY PARAMETER ASSOCIATIONS ARE EVALUATED, " &
+                      "AND PARAMETER ASSOCIATIONS ARE EVALUATED " & 
+                      "BEFORE THE DELAY EXPRESSION" );
+     DECLARE
+
+          WAIT_TIME : DURATION := 3.0 * Impdef.One_Second;
+          
+          TYPE SHORT IS RANGE 10 .. 20;
+
+          TASK  T  IS
+               ENTRY  DO_IT_NOW_OR_WAIT
+                                      ( SHORT )
+                                      ( DID_YOU_DO_IT : IN BOOLEAN );
+               ENTRY  KEEP_ALIVE;
+          END  T;
+
+          TASK BODY  T  IS
+          BEGIN
+               ACCEPT  KEEP_ALIVE;
+          END  T;
+
+          FUNCTION  F1 (X : SHORT) RETURN SHORT IS
+          BEGIN
+               INDEX_COMPUTED  :=  TRUE;
+               RETURN (15);
+          END  F1;
+
+          FUNCTION  F2 RETURN BOOLEAN  IS
+          BEGIN
+               IF INDEX_COMPUTED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INDEX NOT EVALUATED FIRST" );
+               END IF;
+               PARAM_COMPUTED  :=  TRUE;
+               RETURN (FALSE);
+          END  F2;
+
+          FUNCTION F3 RETURN DURATION IS
+          BEGIN
+               IF PARAM_COMPUTED THEN
+                    NULL;
+               ELSE
+                    FAILED ( "PARAMETERS NOT EVALUATED BEFORE DELAY " &
+                             "EXPRESSION" );
+               END IF;
+               DELAY_COMPUTED := TRUE;
+               RETURN (WAIT_TIME);
+          END;
+     BEGIN
+
+          SELECT
+               T.DO_IT_NOW_OR_WAIT
+                                      ( F1 (15) )
+                                      ( NOT F2 );
+               FAILED ("RENDEZVOUS OCCURRED");
+          OR
+               DELAY F3;          
+          END SELECT;
+
+          T.KEEP_ALIVE;
+
+     END;   -- END OF BLOCK CONTAINING THE ENTRY CALLS.
+
+     IF  DELAY_COMPUTED  THEN
+          NULL;
+     ELSE
+          FAILED( "DELAY EXPRESSION NOT EVALUATED" );
+     END IF;
+
+     RESULT;
+
+END  C97302A; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97303a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97303a.ada
new file mode 100644
index 000000000..67504fcf5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97303a.ada
@@ -0,0 +1,128 @@
+-- C97303A.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 TIMED_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
+--     SELECTIVE_WAIT  CANNOT.
+
+-- PART 1: PACKAGE BODY EMBEDDED IN TASK BODY.
+
+
+-- RM 4/06/1982
+
+with Impdef;
+WITH REPORT;
+USE REPORT;
+PROCEDURE  C97303A  IS
+
+
+BEGIN
+
+
+     TEST ( "C97303A" , "CHECK THAT A  TIMED_ENTRY_CALL  CAN" &
+                        " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
+
+
+     -------------------------------------------------------------------
+
+
+     DECLARE
+
+
+          TASK  TT  IS
+               ENTRY  A ( AUTHORIZED : IN BOOLEAN );
+          END  TT ;
+
+
+          TASK BODY  TT  IS
+
+               PACKAGE  WITHIN_TASK_BODY  IS
+                    -- NOTHING HERE
+               END  WITHIN_TASK_BODY ;
+
+
+               PACKAGE BODY  WITHIN_TASK_BODY  IS
+               BEGIN
+
+                    SELECT  -- NOT A SELECTIVE_WAIT
+                         A ( FALSE ) ;  -- CALLING (OWN) ENTRY
+                    OR
+                         DELAY 1.0 * Impdef.One_Second;
+                         COMMENT( "ALTERNATIVE BRANCH TAKEN" );
+                    END SELECT;
+                    
+               END  WITHIN_TASK_BODY ;
+
+
+          BEGIN
+
+               ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
+
+                    IF  AUTHORIZED  THEN
+                         COMMENT(  "AUTHORIZED ENTRY_CALL" );
+                    ELSE
+                         FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                    END IF;
+
+               END  A ;
+   
+          END  TT ;
+
+
+          PACKAGE  OUTSIDE_TASK_BODY  IS
+               -- NOTHING HERE
+          END  OUTSIDE_TASK_BODY ;
+
+
+          PACKAGE BODY  OUTSIDE_TASK_BODY  IS
+          BEGIN
+
+               SELECT  -- NOT A SELECTIVE_WAIT
+                    TT.A ( FALSE ) ;  -- UNBORN
+               OR 
+                    DELAY  2.0 * Impdef.One_Second;
+                    COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
+               END SELECT;
+
+          END  OUTSIDE_TASK_BODY ;
+
+
+     BEGIN
+
+          TT.A ( TRUE );
+
+     EXCEPTION
+
+          WHEN  TASKING_ERROR  =>
+               FAILED( "TASKING ERROR" );
+
+     END  ;
+
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END  C97303A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97303b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97303b.ada
new file mode 100644
index 000000000..5043fa1db
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97303b.ada
@@ -0,0 +1,133 @@
+-- C97303B.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 TIMED_ENTRY_CALL CAN APPEAR IN PLACES WHERE A
+--     SELECTIVE_WAIT  CANNOT.
+
+-- PART 2: PROCEDURE BODY EMBEDDED IN TASK BODY.
+
+
+-- RM 4/12/1982
+
+with Impdef;
+WITH REPORT;
+USE REPORT;
+PROCEDURE  C97303B  IS
+
+
+BEGIN
+
+
+     TEST ( "C97303B" , "CHECK THAT A  TIMED_ENTRY_CALL  CAN" &
+                        " APPEAR WHERE A  SELECTIVE_WAIT  CANNOT" );
+
+
+     -------------------------------------------------------------------
+
+
+     DECLARE
+
+
+          TASK  TT  IS
+               ENTRY  A ( AUTHORIZED : IN BOOLEAN );
+          END  TT ;
+
+
+          TASK BODY  TT  IS
+
+
+               PROCEDURE  WITHIN_TASK_BODY ;
+
+
+               PROCEDURE  WITHIN_TASK_BODY  IS
+               BEGIN
+
+                    SELECT  -- NOT A SELECTIVE_WAIT
+                         A ( FALSE ) ;  -- CALLING (OWN) ENTRY
+                    OR
+                         DELAY 1.0 * Impdef.One_Second;
+                         COMMENT( "ALTERNATIVE BRANCH TAKEN" );
+                    END SELECT;
+                    
+               END  WITHIN_TASK_BODY ;
+
+
+          BEGIN
+
+
+               -- CALL THE INNER PROC. TO FORCE EXEC. OF TIMED_E_CALL
+               WITHIN_TASK_BODY ;
+
+
+               ACCEPT  A ( AUTHORIZED : IN BOOLEAN )  DO
+
+                    IF  AUTHORIZED  THEN
+                         COMMENT(  "AUTHORIZED ENTRY_CALL" );
+                    ELSE
+                         FAILED( "UNAUTHORIZED ENTRY_CALL" );
+                    END IF;
+
+               END  A ;
+
+          END  TT ;
+
+
+          PROCEDURE  OUTSIDE_TASK_BODY  IS
+          BEGIN
+
+               SELECT  -- NOT A SELECTIVE_WAIT
+                    TT.A ( FALSE ) ;  -- UNBORN
+               OR   
+                    DELAY 1.0 * Impdef.One_Second;
+                    COMMENT( "(OUT:) ALTERNATIVE BRANCH TAKEN" );
+               END SELECT;
+
+          END  OUTSIDE_TASK_BODY ;
+
+
+          PACKAGE       CREATE_OPPORTUNITY_TO_CALL           IS END;   
+          PACKAGE BODY  CREATE_OPPORTUNITY_TO_CALL  IS
+          BEGIN
+               -- CALL THE OTHER PROC. TO FORCE EXEC. OF TIMED_E_CALL
+               OUTSIDE_TASK_BODY ;
+          END  CREATE_OPPORTUNITY_TO_CALL ;
+
+
+     BEGIN
+
+          TT.A ( TRUE );
+
+     EXCEPTION
+
+          WHEN  TASKING_ERROR  =>
+               FAILED( "TASKING ERROR" );
+
+     END  ;
+
+     -------------------------------------------------------------------
+
+     RESULT ;
+
+
+END  C97303B ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97303c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97303c.ada
new file mode 100644
index 000000000..a6143037c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97303c.ada
@@ -0,0 +1,128 @@
+-- C97303C.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 TIMED ENTRY CALL CAN APPEAR IN PLACES WHERE A SELECTIVE
+-- WAIT IS NOT ALLOWED.
+
+-- PART 3: TASK BODY NESTED WITHIN A TASK.
+
+-- WRG 7/15/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C97303C IS
+
+BEGIN
+
+     TEST ("C97303C", "CHECK THAT A TIMED ENTRY CALL CAN " &
+                      "APPEAR IN PLACES WHERE A SELECTIVE WAIT " &
+                      "IS NOT ALLOWED; CASE: TASK BODY NESTED " &
+                      "WITHIN A TASK");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E;
+               ENTRY SYNCH;
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT SYNCH;
+               ACCEPT SYNCH;
+               ACCEPT SYNCH;
+               ACCEPT E;
+          END T;
+
+          TASK OUTER IS
+               ENTRY E;
+               ENTRY SYNCH;
+          END OUTER;
+
+          TASK BODY OUTER IS
+
+               TASK TYPE INNER;
+
+               INNER1 : INNER;
+
+               TASK BODY INNER IS
+               BEGIN
+                    SELECT
+                         T.E;
+                         FAILED ("TIMED ENTRY CALL ACCEPTED - " &
+                                 "INNER (1)");
+                    OR
+                         DELAY 1.0 * Impdef.One_Second;
+                         T.SYNCH;
+                    END SELECT;
+
+                    SELECT
+                         OUTER.E;
+                         FAILED ("TIMED ENTRY CALL ACCEPTED - " &
+                                 "INNER (2)");
+                    OR
+                         DELAY 1.0 * Impdef.One_Second;
+                         OUTER.SYNCH;
+                    END SELECT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED - INNER");
+               END INNER;
+
+               PACKAGE DUMMY IS
+                    TYPE ACC_INNER IS ACCESS INNER;
+                    INNER2 : ACC_INNER := NEW INNER;
+               END DUMMY;
+
+          BEGIN
+
+               SELECT
+                    T.E;
+                    FAILED ("TIMED ENTRY CALL ACCEPTED - OUTER");
+               OR
+                    DELAY 1.0 * Impdef.One_Second;
+                    T.SYNCH;
+               END SELECT;
+
+               ACCEPT SYNCH;
+               ACCEPT SYNCH;
+               ACCEPT E;
+
+          EXCEPTION
+
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - OUTER");
+
+          END OUTER;
+
+     BEGIN
+
+          T.E;
+          OUTER.E;
+
+     END;
+
+     RESULT;
+
+END C97303C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97304a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97304a.ada
new file mode 100644
index 000000000..8e4504730
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97304a.ada
@@ -0,0 +1,123 @@
+-- C97304A.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 EXCEPTION  TASKING_ERROR  WILL BE RAISED IF THE CALLED
+--     TASK HAS ALREADY COMPLETED ITS EXECUTION AT THE TIME OF THE
+--     TIMED_ENTRY_CALL.
+
+
+-- RM 5/28/82
+-- SPS 11/21/82
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE  C97304A  IS
+
+     -- THE TASK WILL HAVE HIGHER PRIORITY ( PRIORITY'LAST )
+
+BEGIN
+
+
+     -------------------------------------------------------------------
+
+
+     TEST ("C97304A", "CHECK THAT THE EXCEPTION  TASKING_ERROR  WILL" &
+                      " BE RAISED IF THE CALLED TASK HAS ALREADY"     &
+                      " COMPLETED ITS EXECUTION AT THE TIME OF THE"   &
+                      " TIMED_ENTRY_CALL"                       );
+
+  
+     DECLARE
+
+
+          TASK TYPE  T_TYPE  IS
+
+
+               ENTRY  E ;
+
+          END  T_TYPE ;
+
+
+          T_OBJECT1 : T_TYPE ;
+
+
+          TASK BODY  T_TYPE  IS
+               BUSY : BOOLEAN := FALSE ;
+          BEGIN
+
+               NULL;
+
+          END  T_TYPE ;
+
+
+     BEGIN
+
+
+          FOR  I  IN  1..5  LOOP
+               EXIT WHEN  T_OBJECT1'TERMINATED ;
+               DELAY 10.0 * Impdef.One_Second;
+          END LOOP;
+
+
+          IF NOT  T_OBJECT1'TERMINATED  THEN
+               COMMENT( "TASK NOT YET TERMINATED (AFTER 50 S.)" );
+          END IF;
+
+
+          BEGIN
+
+               SELECT
+                    T_OBJECT1.E ;
+                    FAILED( "CALL WAS NOT DISOBEYED" );
+               OR
+                    DELAY 1.0 * Impdef.One_Second;
+                    FAILED( "'OR' BRANCH TAKEN INSTEAD OF TSKG_ERROR" );
+               END SELECT;
+
+               FAILED( "EXCEPTION NOT RAISED" );
+
+          EXCEPTION
+
+               WHEN  TASKING_ERROR  =>
+                    NULL ;
+
+               WHEN  OTHERS  =>
+                    FAILED(  "WRONG EXCEPTION RAISED"  );
+
+          END ;
+
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+
+     RESULT;
+
+
+END  C97304A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97304b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97304b.ada
new file mode 100644
index 000000000..1d7f4cd06
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97304b.ada
@@ -0,0 +1,84 @@
+-- C97304B.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 TASKING_ERROR IS RAISED IF THE CALLED TASK IS ABORTED
+-- BEFORE THE TIMED ENTRY CALL IS EXECUTED.
+
+-- WRG 7/13/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C97304B IS
+
+BEGIN
+
+     TEST ("C97304B", "CHECK THAT TASKING_ERROR IS RAISED IF THE " &
+                      "CALLED TASK IS ABORTED BEFORE THE TIMED " &
+                      "ENTRY CALL IS EXECUTED");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E (I : INTEGER);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (I : INTEGER);
+               FAILED ("ENTRY CALL ACCEPTED");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED");
+          END T;
+
+          FUNCTION F RETURN INTEGER IS
+          BEGIN
+               ABORT T;
+               RETURN 1;
+          END F;
+
+     BEGIN
+
+          SELECT
+               T.E (F);
+               FAILED ("TIMED ENTRY CALL MADE");
+          OR
+               DELAY 1.0 * Impdef.One_Second;
+               FAILED ("DELAY ALTERNATIVE TAKEN");
+          END SELECT;
+
+          FAILED ("EXCEPTION NOT RAISED");
+
+     EXCEPTION
+
+          WHEN TASKING_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+
+     END;
+
+     RESULT;
+
+END C97304B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305a.ada
new file mode 100644
index 000000000..81349b87d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305a.ada
@@ -0,0 +1,100 @@
+-- C97305A.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 RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
+-- TIMED ENTRY CALL), IT IS PERFORMED.
+
+-- CASE A: SINGLE ENTRY; THE CALLED TASK IS EXECUTING AN ACCEPT
+--         STATEMENT.
+
+-- WRG 7/13/86
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C97305A IS
+
+     RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+     STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+     COUNT                          : POSITIVE := 1;
+     ZERO                           : DURATION := 1.0;
+
+
+BEGIN
+
+     TEST ("C97305A", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
+                      "POSSIBLE (FOR A TIMED ENTRY CALL), IT " &
+                      "IS PERFORMED");
+
+     IF EQUAL (3, 3) THEN
+          ZERO := 0.0;
+     END IF;
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E (B : IN OUT BOOLEAN);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT E (B : IN OUT BOOLEAN) DO
+                    B := IDENT_BOOL (TRUE);
+               END E;
+          END T;
+
+     BEGIN
+
+          WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
+               DELAY 1.0 * Impdef.One_Second;
+
+               SELECT
+                    T.E (RENDEZVOUS_OCCURRED);
+                    STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+               OR
+                    DELAY ZERO;
+                    IF COUNT < 60 * 60 THEN
+                         COUNT := COUNT + 1;
+                    ELSE
+                         FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
+                                 "HOUR ELAPSED");
+                         EXIT;
+                    END IF;
+               END SELECT;
+          END LOOP;
+
+     END;
+
+     IF NOT RENDEZVOUS_OCCURRED THEN
+          FAILED ("RENDEZVOUS DID NOT OCCUR");
+     END IF;
+
+     IF COUNT > 1 THEN
+          COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
+     END IF;
+
+     RESULT;
+
+END C97305A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305b.ada
new file mode 100644
index 000000000..13a28a39e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305b.ada
@@ -0,0 +1,104 @@
+-- C97305B.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 RENDEZVOUS IS IMMEDIATELY POSSIBLE (FOR A
+-- TIMED ENTRY CALL), IT IS PERFORMED.
+
+-- CASE B: ENTRY FAMILY; THE CALLED TASK IS EXECUTING A SELECTIVE WAIT.
+
+-- WRG 7/13/86
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C97305B IS
+
+     RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+     STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+     COUNT                          : POSITIVE := 1;
+     ZERO                           : DURATION := 1.0;
+
+
+BEGIN
+
+     TEST ("C97305B", "CHECK THAT IF THE RENDEZVOUS IS IMMEDIATELY " &
+                      "POSSIBLE (FOR A TIMED ENTRY CALL), IT " &
+                      "IS PERFORMED");
+
+     IF EQUAL (3, 3) THEN
+          ZERO := 0.0;
+     END IF;
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E (1..3) (B : IN OUT BOOLEAN);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               SELECT
+                    ACCEPT E (2) (B : IN OUT BOOLEAN) DO
+                         B := IDENT_BOOL (TRUE);
+                    END E;
+               OR
+                    ACCEPT E (3) (B : IN OUT BOOLEAN);
+                    FAILED ("NONEXISTENT ENTRY CALL ACCEPTED");
+               END SELECT;
+          END T;
+
+     BEGIN
+
+          WHILE NOT STATEMENTS_AFTER_CALL_EXECUTED LOOP
+               DELAY 1.0 * Impdef.One_Second;
+
+               SELECT
+                    T.E (2) (RENDEZVOUS_OCCURRED);
+                    STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+               OR
+                    DELAY ZERO;
+                    IF COUNT < 60 * 60 THEN
+                         COUNT := COUNT + 1;
+                    ELSE
+                         FAILED ("NO RENDEZVOUS AFTER AT LEAST ONE " &
+                                 "HOUR ELAPSED");
+                         EXIT;
+                    END IF;
+               END SELECT;
+          END LOOP;
+
+     END;
+
+     IF NOT RENDEZVOUS_OCCURRED THEN
+          FAILED ("RENDEZVOUS DID NOT OCCUR");
+     END IF;
+
+     IF COUNT > 1 THEN
+          COMMENT ("DELAYED" & POSITIVE'IMAGE(COUNT) & " SECONDS");
+     END IF;
+
+     RESULT;
+
+END C97305B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305c.ada
new file mode 100644
index 000000000..ee9953ba4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305c.ada
@@ -0,0 +1,90 @@
+-- C97305C.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 RENDEZVOUS IS NOT IMMEDIATELY POSSIBLE BUT BECOMES
+-- POSSIBLE BEFORE THE DELAY EXPIRES, THE TIMED ENTRY CALL IS ACCEPTED.
+
+-- CASE A: SINGLE ENTRY; THE CALLED TASK IS EXECUTING AN ACCEPT
+--         STATEMENT.
+
+-- WRG 7/13/86
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C97305C IS
+
+     RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+     STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+     DELAY_IN_MINUTES               : CONSTANT POSITIVE := 30;
+
+
+BEGIN
+
+     TEST ("C97305C", "CHECK THAT IF THE RENDEZVOUS IS NOT " &
+                      "IMMEDIATELY POSSIBLE BUT BECOMES POSSIBLE " &
+                      "BEFORE THE DELAY EXPIRES, THE TIMED ENTRY " &
+                      "CALL IS ACCEPTED");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E (B : IN OUT BOOLEAN);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               DELAY 10.0 * Impdef.One_Long_Second;
+               ACCEPT E (B : IN OUT BOOLEAN) DO
+                    B := IDENT_BOOL (TRUE);
+               END E;
+          END T;
+
+     BEGIN
+
+          SELECT
+               T.E (RENDEZVOUS_OCCURRED);
+               STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+          OR
+               DELAY DELAY_IN_MINUTES * 60.0 * Impdef.One_Long_Second;
+               FAILED ("TIMED ENTRY CALL NOT ACCEPTED AFTER" &
+                       POSITIVE'IMAGE(DELAY_IN_MINUTES) &
+                       " MINUTES ELAPSED");
+
+          END SELECT;
+
+     END;
+
+     IF NOT RENDEZVOUS_OCCURRED THEN
+          FAILED ("RENDEZVOUS DID NOT OCCUR");
+     END IF;
+
+     IF NOT STATEMENTS_AFTER_CALL_EXECUTED THEN
+          FAILED ("STATEMENTS AFTER ENTRY CALL NOT EXECUTED");
+     END IF;
+
+     RESULT;
+
+END C97305C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305d.ada
new file mode 100644
index 000000000..022b0adcb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97305d.ada
@@ -0,0 +1,95 @@
+-- C97305D.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 RENDEZVOUS IS NOT IMMEDIATELY POSSIBLE BUT BECOMES
+-- POSSIBLE BEFORE THE DELAY EXPIRES, THE TIMED ENTRY CALL IS ACCEPTED.
+
+-- CASE B: ENTRY FAMILY; THE CALLED TASK IS EXECUTING A SELECTIVE WAIT.
+
+-- WRG 7/13/86
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE C97305D IS
+
+     RENDEZVOUS_OCCURRED            : BOOLEAN  := FALSE;
+     STATEMENTS_AFTER_CALL_EXECUTED : BOOLEAN  := FALSE;
+     DELAY_IN_MINUTES               : CONSTANT POSITIVE := 30;
+
+
+BEGIN
+
+     TEST ("C97305D", "CHECK THAT IF THE RENDEZVOUS IS NOT " &
+                      "IMMEDIATELY POSSIBLE BUT BECOMES POSSIBLE " &
+                      "BEFORE THE DELAY EXPIRES, THE TIMED ENTRY " &
+                      "CALL IS ACCEPTED");
+
+     DECLARE
+
+          TASK T IS
+               ENTRY E (1..3) (B : IN OUT BOOLEAN);
+          END T;
+
+          TASK BODY T IS
+          BEGIN
+               DELAY 10.0 * Impdef.One_Second;
+
+               SELECT
+                    ACCEPT E (2) (B : IN OUT BOOLEAN) DO
+                         B := IDENT_BOOL (TRUE);
+                    END E;
+               OR
+                    ACCEPT E (3) (B : IN OUT BOOLEAN);
+                    FAILED ("NONEXISTENT ENTRY CALL ACCEPTED");
+               END SELECT;
+          END T;
+
+     BEGIN
+
+          SELECT
+               T.E (2) (RENDEZVOUS_OCCURRED);
+               STATEMENTS_AFTER_CALL_EXECUTED := IDENT_BOOL (TRUE);
+          OR
+               DELAY DELAY_IN_MINUTES * 60.0 * Impdef.One_Second;
+               FAILED ("TIMED ENTRY CALL NOT ACCEPTED AFTER" &
+                       POSITIVE'IMAGE(DELAY_IN_MINUTES) &
+                       " MINUTES ELAPSED");
+
+          END SELECT;
+
+     END;
+
+     IF NOT RENDEZVOUS_OCCURRED THEN
+          FAILED ("RENDEZVOUS DID NOT OCCUR");
+     END IF;
+
+     IF NOT STATEMENTS_AFTER_CALL_EXECUTED THEN
+          FAILED ("STATEMENTS AFTER ENTRY CALL NOT EXECUTED");
+     END IF;
+
+     RESULT;
+
+END C97305D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97307a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97307a.ada
new file mode 100644
index 000000000..32d26e6b3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c97307a.ada
@@ -0,0 +1,209 @@
+-- C97307A.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 TIMED ENTRY CALL THAT IS CANCELED (BECAUSE THE DELAY HAS
+-- EXPIRED) IS REMOVED FROM THE QUEUE OF THE CALLED TASK'S ENTRY.
+
+-- WRG 7/14/86
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C97307A IS
+
+BEGIN
+
+     TEST ("C97307A", "CHECK THAT A TIMED ENTRY CALL THAT IS " &
+                      "CANCELED (BECAUSE THE DELAY HAS EXPIRED) IS " &
+                      "REMOVED FROM THE QUEUE OF THE CALLED TASK'S " &
+                      "ENTRY");
+
+     DECLARE
+
+          DELAY_TIME : CONSTANT DURATION := 2 * 60.0 * Impdef.One_Second;
+
+          TASK EXPIRED IS
+               ENTRY INCREMENT;
+               ENTRY READ (COUNT : OUT NATURAL);
+          END EXPIRED;
+
+          TASK TYPE NON_TIMED_CALLER IS
+               ENTRY NAME (N : NATURAL);
+          END NON_TIMED_CALLER;
+
+          TASK TYPE TIMED_CALLER IS
+               ENTRY NAME (N : NATURAL);
+          END TIMED_CALLER;
+
+          CALLER1 : TIMED_CALLER;
+          CALLER2 : NON_TIMED_CALLER;
+          CALLER3 : TIMED_CALLER;
+          CALLER4 : NON_TIMED_CALLER;
+          CALLER5 : TIMED_CALLER;
+
+          TASK T IS
+               ENTRY E (NAME : NATURAL);
+          END T;
+
+          TASK DISPATCH IS
+               ENTRY READY;
+          END DISPATCH;
+
+          --------------------------------------------------
+
+          TASK BODY EXPIRED IS
+               EXPIRED_CALLS : NATURAL := 0;
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT INCREMENT DO
+                              EXPIRED_CALLS := EXPIRED_CALLS + 1;
+                         END INCREMENT;
+                    OR
+                         ACCEPT READ (COUNT : OUT NATURAL) DO
+                              COUNT := EXPIRED_CALLS;
+                         END READ;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END EXPIRED;
+
+          --------------------------------------------------
+
+          TASK BODY NON_TIMED_CALLER IS
+               MY_NAME : NATURAL;
+          BEGIN
+               ACCEPT NAME (N : NATURAL) DO
+                    MY_NAME := N;
+               END NAME;
+
+               T.E (MY_NAME);
+          END NON_TIMED_CALLER;
+
+          --------------------------------------------------
+
+          TASK BODY TIMED_CALLER IS
+               MY_NAME : NATURAL;
+          BEGIN
+               ACCEPT NAME (N : NATURAL) DO
+                    MY_NAME := N;
+               END NAME;
+
+               SELECT
+                    T.E (MY_NAME);
+                    FAILED ("TIMED ENTRY CALL NOT CANCELED FOR CALLER" &
+                            NATURAL'IMAGE(MY_NAME));
+               OR
+                    DELAY DELAY_TIME;
+                    EXPIRED.INCREMENT;
+               END SELECT;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED IN TIMED_CALLER -- " &
+                            "CALLER" & NATURAL'IMAGE(MY_NAME));
+          END TIMED_CALLER;
+
+          --------------------------------------------------
+
+          TASK BODY DISPATCH IS
+          BEGIN
+               CALLER1.NAME (1);
+               ACCEPT READY;
+
+               CALLER2.NAME (2);
+               ACCEPT READY;
+
+               CALLER3.NAME (3);
+               ACCEPT READY;
+
+               CALLER4.NAME (4);
+               ACCEPT READY;
+
+               CALLER5.NAME (5);
+          END DISPATCH;
+
+          --------------------------------------------------
+
+          TASK BODY T IS
+
+               DESIRED_QUEUE_LENGTH : NATURAL := 1;
+               EXPIRED_CALLS        : NATURAL;
+
+               ACCEPTED             : ARRAY (1..5) OF NATURAL RANGE 0..5
+                                         := (OTHERS => 0);
+               ACCEPTED_INDEX       : NATURAL := 0;
+
+          BEGIN
+               LOOP
+                    LOOP
+                         EXPIRED.READ (EXPIRED_CALLS);
+                    EXIT WHEN E'COUNT >= DESIRED_QUEUE_LENGTH -
+                                         EXPIRED_CALLS;
+                         DELAY 2.0 * Impdef.One_Long_Second;
+                    END LOOP;
+               EXIT WHEN DESIRED_QUEUE_LENGTH = 5;
+                    DISPATCH.READY;
+                    DESIRED_QUEUE_LENGTH := DESIRED_QUEUE_LENGTH + 1;
+               END LOOP;
+
+               -- AT THIS POINT, FIVE TASKS WERE QUEUED.
+               -- LET THE TIMED ENTRY CALLS ISSUED BY CALLER1,
+               -- CALLER3, AND CALLER5 EXPIRE:
+
+               DELAY DELAY_TIME + 10.0 * Impdef.One_Long_Second;
+
+               -- AT THIS POINT, ALL THE TIMED ENTRY CALLS MUST HAVE
+               -- EXPIRED AND BEEN REMOVED FROM THE ENTRY QUEUE FOR E,
+               -- OTHERWISE THE IMPLEMENTATION HAS FAILED THIS TEST.
+
+               WHILE E'COUNT > 0 LOOP
+                    ACCEPT E (NAME : NATURAL) DO
+                         ACCEPTED_INDEX := ACCEPTED_INDEX + 1;
+                         ACCEPTED (ACCEPTED_INDEX) := NAME;
+                    END E;
+               END LOOP;
+
+               IF ACCEPTED /= (2, 4, 0, 0, 0) THEN
+                    FAILED ("SOME TIMED CALLS NOT REMOVED FROM ENTRY " &
+                            "QUEUE");
+                    COMMENT ("ORDER ACCEPTED WAS:" &
+                             NATURAL'IMAGE (ACCEPTED (1))  & ',' &
+                             NATURAL'IMAGE (ACCEPTED (2))  & ',' &
+                             NATURAL'IMAGE (ACCEPTED (3))  & ',' &
+                             NATURAL'IMAGE (ACCEPTED (4))  & ',' &
+                             NATURAL'IMAGE (ACCEPTED (5)) );
+               END IF;
+          END T;
+
+          --------------------------------------------------
+
+     BEGIN
+
+          NULL;
+
+     END;
+
+     RESULT;
+
+END C97307A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974001.a
new file mode 100644
index 000000000..04ac93e6d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974001.a
@@ -0,0 +1,152 @@
+-- C974001.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 abortable part of an asynchronous select statement
+--      is aborted if it does not complete before the triggering statement
+--      completes, where the triggering statement is a delay_relative
+--      statement and check that the sequence of statements of the triggering 
+--      alternative is executed after the abortable part is left.
+--
+-- TEST DESCRIPTION:
+--      Declare a task with an accept statement containing an asynchronous
+--      select with a delay_relative triggering statement. Parameterize
+--      the accept statement with the time to be used in the delay. Simulate a
+--      time-consuming calculation by declaring a procedure containing an
+--      infinite loop. Call this procedure in the abortable part.
+--
+--      The delay will expire before the abortable part completes, at which
+--      time the abortable part is aborted, and the sequence of statements
+--      following the triggering statement is executed.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with ImpDef;
+
+procedure C974001 is
+
+
+          --========================================================--
+
+   -- Medium length delay
+   Allotted_Time : constant Duration :=  ImpDef.Switch_To_New_Task;
+
+   Calculation_Canceled : exception;
+
+
+   Count : Integer := 1234;                          
+                                                    
+   procedure Lengthy_Calculation is
+   begin
+      -- Simulate a non-converging calculation.
+      loop                                           -- Infinite loop.
+         Count := (Count + 1) mod 10;
+         delay ImpDef.Minimum_Task_Switch;           -- allow other task 
+      end loop;
+   end Lengthy_Calculation;
+
+
+          --========================================================--
+
+
+   task type Timed_Calculation is
+      entry Calculation (Time_Limit : in Duration);
+   end Timed_Calculation;
+
+
+   task body Timed_Calculation is
+   --
+   begin
+      loop
+         select
+            accept Calculation (Time_Limit : in Duration) do
+
+               --                                    --
+               -- Asynchronous select is tested here --
+               --                                    --
+
+               select
+                  delay Time_Limit;           -- Time_Limit is not up yet, so
+                                              -- Lengthy_Calculation starts.
+
+                  raise Calculation_Canceled; -- This is executed after
+                                              -- Lengthy_Calculation aborted.
+               then abort
+                  Lengthy_Calculation;        -- Delay expires before complete,
+                                              -- so this call is aborted.
+
+                  -- Check that the whole of the abortable part is aborted,
+                  -- not just the statement in the abortable part that was
+                  -- executing at the time
+                  Report.Failed ("Abortable part not aborted");
+
+               end select;
+
+               Report.Failed ("Triggering alternative sequence of " &
+                              "statements not executed");
+
+            exception    -- New Ada 9x: handler within accept
+               when Calculation_Canceled =>
+                  if Count = 1234 then
+                     Report.Failed ("Abortable part did not execute");
+                  end if;
+            end Calculation;
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Timed_Calculation task");
+   end Timed_Calculation;
+
+
+          --========================================================--
+
+
+begin  -- Main program.
+
+   Report.Test ("C974001", "Asynchronous Select: Trigger is delay_relative" &
+                           " which completes before abortable part");
+
+   declare
+      Timed : Timed_Calculation;  -- Task.
+   begin
+      Timed.Calculation (Time_Limit => Allotted_Time); -- Asynchronous select
+                                                       -- inside accept block.
+   exception
+      when Calculation_Canceled => 
+         null; -- expected behavior
+   end;
+
+   Report.Result;
+
+end C974001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974002.a
new file mode 100644
index 000000000..1138e8da3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974002.a
@@ -0,0 +1,209 @@
+-- C974002.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 sequence of statements of the triggering alternative
+--      of an asynchronous select statement is executed if the triggering
+--      statement is a delay_until statement, and the specified time has
+--      already passed. Check that the abortable part is not executed after
+--      the sequence of statements of the triggering alternative is left.
+--
+--      Check that the sequence of statements of the triggering alternative
+--      of an asynchronous select statement is not executed if the abortable
+--      part completes before the triggering statement, and the triggering
+--      statement is a delay_until statement.
+--
+-- TEST DESCRIPTION:
+--      Declare a task with an accept statement containing an asynchronous
+--      select with a delay_until triggering statement. Parameterize
+--      the accept statement with the time to be used in the delay. Simulate
+--      a quick calculation by declaring a procedure which sets a Boolean
+--      flag. Call this procedure in the abortable part.
+--
+--      Make two calls to the task entry: (1) with a time that has already
+--      expired, and (2) with a time that will not expire before the quick
+--      calculation completes.
+--
+--      For (1), the sequence of statements following the triggering statement
+--      is executed, and the abortable part never starts.
+--
+--      For (2), the abortable part completes before the triggering statement,
+--      the delay is canceled, and the sequence of statements following the
+--      triggering statement never starts.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      26 Nov 95   SAIC    Bug fix for ACVC 2.0.1.
+--
+--!
+
+with Report;
+with Ada.Calendar;
+with ImpDef;
+procedure C974002 is
+
+   function "-" (Left: Ada.Calendar.Time; Right: Duration )
+                          return Ada.Calendar.Time renames Ada.Calendar."-";
+   function "+" (Left: Ada.Calendar.Time; Right: Duration ) 
+                          return Ada.Calendar.Time renames Ada.Calendar."+";
+   
+   Abortable_Part_Executed         : Boolean;
+   Triggering_Alternative_Executed : Boolean;
+
+
+          --========================================================--
+
+
+   procedure Quick_Calculation is
+   begin
+      if Report.Equal (1, 1) then
+         Abortable_Part_Executed := True;
+      end if;
+   end Quick_Calculation;
+
+
+          --========================================================--
+
+
+   task type Timed_Calculation_Task is
+      entry Calculation (Time_Out : in Ada.Calendar.Time);
+   end Timed_Calculation_Task;
+
+
+   task body Timed_Calculation_Task is
+   begin
+      loop
+         select
+            accept Calculation (Time_Out : in Ada.Calendar.Time) do
+
+               --                                    --
+               -- Asynchronous select is tested here --
+               --                                    --
+
+               select
+                  delay until Time_Out;                    -- Triggering 
+                                                           -- statement.
+
+                  Triggering_Alternative_Executed := True; -- Triggering
+                                                           -- alternative.
+               then abort
+                  Quick_Calculation;                       -- Abortable part.
+               end select;
+            end Calculation;
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others =>
+         Report.Failed ("Unexpected exception in Timed_Calculation_Task");
+   end Timed_Calculation_Task;
+
+
+          --========================================================--
+
+
+   Start_Time : constant Ada.Calendar.Time := 
+                         Ada.Calendar.Time_of (1901,1,1);
+   Minute     : constant Duration          := 60.0;
+
+
+          --========================================================--
+
+
+begin  -- Main program.
+
+   Report.Test ("C974002", "Asynchronous Select with Delay_Until");
+  
+   -- take care of implementations that start the clock at 1/1/01 
+   delay ImpDef.Delay_For_Time_Past;
+
+
+   Abortable_Part_Executed         := False;
+   Triggering_Alternative_Executed := False;
+
+   NO_DELAY_SUBTEST:
+
+      declare
+         -- Set Expiry to a time which has already passed
+         Expiry : constant Ada.Calendar.Time := Start_Time; 
+         Timed  : Timed_Calculation_Task;
+      begin
+
+         -- Expiry is the time to be specified in the delay_until statement
+         -- of the asynchronous select. Since it has already passed, the
+         -- abortable part should not execute, and the sequence of statements
+         -- of the triggering alternative should be executed.
+
+         Timed.Calculation (Time_Out => Expiry);   -- Asynchronous select
+                                                   -- inside accept block.
+         if Abortable_Part_Executed then
+            Report.Failed ("No delay: Abortable part was executed");
+         end if;
+
+         if not Triggering_Alternative_Executed then
+            Report.Failed ("No delay: triggering alternative sequence " &
+                           "of statements was not executed");
+         end if;
+      end No_Delay_Subtest;
+
+
+   Abortable_Part_Executed         := False;
+   Triggering_Alternative_Executed := False;
+
+   LONG_DELAY_SUBTEST:
+
+      declare
+
+         -- Quick_Calculation should finish before expiry.
+         Expiry : constant Ada.Calendar.Time := 
+                                            Ada.Calendar.Clock + Minute;
+         Timed  : Timed_Calculation_Task;
+
+      begin
+
+         -- Expiry is the time to be specified in the delay_until statement
+         -- of the asynchronous select. It should not pass before the abortable
+         -- part completes, at which time control should return to the caller;
+         -- the sequence of statements of the triggering alternative should
+         -- not be executed.
+
+         Timed.Calculation (Time_Out => Expiry);  -- Asynchronous select.
+
+         if not Abortable_Part_Executed then
+            Report.Failed ("Long delay: Abortable part was not executed");
+         end if;
+
+         if Triggering_Alternative_Executed then
+            Report.Failed ("Long delay: triggering alternative sequence " &
+                           "of statements was executed");
+         end if;
+      end Long_Delay_Subtest;
+
+
+   Report.Result;
+
+end C974002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974003.a
new file mode 100644
index 000000000..c353a918d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974003.a
@@ -0,0 +1,249 @@
+-- C974003.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 abortable part of an asynchronous select statement
+--      is aborted if it does not complete before the triggering statement
+--      completes, where the triggering statement is a task entry call, and
+--      the entry call is queued.
+--
+--      Check that the sequence of statements of the triggering alternative
+--      is executed after the abortable part is left.
+--
+-- TEST DESCRIPTION:
+--      Declare a main procedure containing an asynchronous select with a task
+--      entry call as triggering statement. Force the entry call to be
+--      queued by having the task call a procedure, prior to the corresponding
+--      accept statement, which simulates a routine waiting for user input
+--      (with a delay). 
+--
+--      Simulate a time-consuming routine in the abortable part by calling a
+--      procedure containing an infinite loop. Meanwhile, simulate input by
+--      the user (the delay expires), which causes the task to execute the
+--      accept statement corresponding to the triggering entry call.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C974003_0 is  -- Automated teller machine abstraction.
+
+
+   -- Flags for testing purposes:
+   --
+   TC_Triggering_Statement_Completed : Boolean := False;
+   TC_Count                          : Integer := 1234;  -- Global to defeat
+                                                         -- optimization.
+
+   type Key_Enum is (None, Cancel, Deposit, Withdraw);
+
+   type Card_Number_Type is private;
+   type Card_PIN_Type    is private;
+   type ATM_Card_Type    is private;
+
+
+   Transaction_Canceled : exception;
+
+
+   task type ATM_Keyboard_Task is
+      entry Cancel_Pressed;
+   end ATM_Keyboard_Task;
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type);
+
+   procedure Validate_Card (Card : in ATM_Card_Type);
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type);
+
+private
+
+   type Card_Number_Type is range   1 .. 9999;
+   type Card_PIN_Type    is range 100 ..  999;
+
+   type ATM_Card_Type is record
+      Number : Card_Number_Type;
+      PIN    : Card_PIN_Type;
+   end record;
+
+end C974003_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+package body C974003_0 is
+
+
+   procedure Listen_For_Input (Key : out Key_Enum) is
+   begin
+      -- Model the situation where the user waits a bit for the card to
+      -- be validated, then presses cancel before it completes.
+
+      -- Delay long enough to force queuing of Keyboard.Cancel_Pressed.
+      delay ImpDef.Minimum_Task_Switch;
+
+      if Report.Equal (3, 3) then  -- Always true.
+         Key := Cancel;
+      end if;
+   end Listen_For_Input;
+
+
+
+   -- One of these gets created as "Keyboard" for each transaction
+   --
+   task body ATM_Keyboard_Task is
+      Key_Pressed : Key_Enum := None;
+   begin
+      loop
+                                                           -- Force entry calls
+         Listen_For_Input (Key_Pressed);                   -- to be queued,
+                                                           -- then set guard to
+                                                           -- true.
+         select
+            when (Key_Pressed = Cancel) =>                 -- Guard is now
+               accept Cancel_Pressed do                    -- true, so accept
+                  TC_Triggering_Statement_Completed := True;  -- queued entry
+               end Cancel_Pressed;                         -- call.
+
+               -- User has cancelled the transaction so we exit the
+               -- loop and allow the task to terminate
+               exit;
+         else
+            Key_Pressed := None;
+         end select;
+
+      end loop;
+   exception
+      when others =>
+          Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+   end ATM_Keyboard_Task;
+
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type) is
+   begin
+      Card.Number := 9999;
+      Card.PIN    := 111;
+   end Read_Card;
+
+
+   procedure Validate_Card (Card : in ATM_Card_Type) is
+   begin
+      -- Simulate an exceedingly long validation activity.
+      loop                                             -- Infinite loop.
+         TC_Count := (TC_Count + 1) mod Integer (Card.PIN);
+         -- Synch. point to allow transfer of control to Keyboard
+         -- task during this simulation
+         delay ImpDef.Minimum_Task_Switch;
+         exit when not Report.Equal (TC_Count, TC_Count);    -- Always false.
+      end loop;
+   end Validate_Card;
+
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type) is
+   begin
+      Report.Failed ("Triggering alternative sequence of statements " &
+                     "not executed");
+      if not TC_Triggering_Statement_Completed then
+         Report.Failed ("Triggering statement did not complete");
+      end if;
+      if TC_Count = 1234 then
+         -- Initial value is unchanged
+         Report.Failed ("Abortable part did not execute");
+      end if;
+   end Perform_Transaction;
+
+
+end C974003_0;
+
+
+     --==================================================================--
+
+
+with Report;
+
+with C974003_0;  -- Automated teller machine abstraction.
+use  C974003_0;
+
+procedure C974003 is
+
+   Card_Data : ATM_Card_Type;
+
+begin  -- Main program.
+
+   Report.Test ("C974003", "Asynchronous Select: Trigger is queued on a " &
+                            "task entry and completes first");
+
+   Read_Card (Card_Data);
+
+   declare
+      -- Create the task for this transaction
+      Keyboard : C974003_0.ATM_Keyboard_Task;    
+   begin
+
+      --                                    --
+      -- Asynchronous select is tested here --
+      --                                    --
+
+      select
+         Keyboard.Cancel_Pressed;      -- Entry call is initially queued, so
+                                       -- abortable part starts.
+
+         raise Transaction_Canceled;   -- This is executed after Validate_Card
+                                       -- is aborted.
+      then abort
+         Validate_Card (Card_Data);    -- Keyboard.Cancel_Pressed is accepted
+                                       -- and completes before this call
+                                       -- finishes; it is then aborted.
+
+         -- Check that the whole of the abortable part is aborted, not
+         -- just the statement in the abortable part that was executing
+         -- at the time
+         Report.Failed ("Abortable part not aborted");
+
+      end select;
+
+      Perform_Transaction (Card_Data); -- Should not be reached.
+   exception
+      when Transaction_Canceled =>
+         if not TC_Triggering_Statement_Completed then
+            Report.Failed ("Triggering alternative sequence of statements " &
+                           "executed but triggering statement not complete");
+         end if;
+         if TC_Count = 1234 then
+            -- Initial value is unchanged
+            Report.Failed ("Abortable part did not execute");
+         end if;
+   end;
+
+   Report.Result;
+
+end C974003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974004.a
new file mode 100644
index 000000000..b1200c103
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974004.a
@@ -0,0 +1,273 @@
+-- C974004.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 abortable part of an asynchronous select statement
+--      is aborted if it does not complete before the triggering statement
+--      completes, where the triggering statement is a task entry call,
+--      the entry call is queued, and the entry call completes by propagating
+--      an exception and that the sequence of statements of the triggering 
+--      alternative is not executed after the abortable part is left and that
+--      the exception propagated by the entry call is re-raised immediately
+--      following the asynchronous select.
+--
+-- TEST DESCRIPTION:
+--      Declare a main procedure containing an asynchronous select with a task
+--      entry call as triggering statement. Force the entry call to be
+--      queued by having the task call a procedure, prior to the corresponding
+--      accept statement, which simulates a routine waiting for user input
+--      (with a delay). 
+--
+--      Simulate a time-consuming routine in the abortable part by calling a
+--      procedure containing an infinite loop. Meanwhile, simulate input by
+--      the user (the delay expires), which causes the task to execute the
+--      accept statement corresponding to the triggering entry call. Raise
+--      an exception in the accept statement which is not handled by the task,
+--      and which is thus propagated to the caller.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C974004_0 is  -- Automated teller machine abstraction.
+
+
+   -- Flags for testing purposes:
+
+   Count                          : Integer := 1234;  -- Global to defeat
+                                                      -- optimization.
+   Propagated_From_Task : exception;
+
+
+   type Key_Enum is (None, Cancel, Deposit, Withdraw);
+
+   type Card_Number_Type is private;
+   type Card_PIN_Type    is private;
+   type ATM_Card_Type    is private;
+
+
+   Transaction_Canceled : exception;
+
+
+   task type ATM_Keyboard_Task is
+      entry Cancel_Pressed;
+   end ATM_Keyboard_Task;
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type);
+
+   procedure Validate_Card (Card : in ATM_Card_Type);
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type);
+
+private
+
+   type Card_Number_Type is range   1 .. 9999;
+   type Card_PIN_Type    is range 100 ..  999;
+
+   type ATM_Card_Type is record
+      Number : Card_Number_Type;
+      PIN    : Card_PIN_Type;
+   end record;
+
+end C974004_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+package body C974004_0 is
+
+
+   procedure Listen_For_Input (Key : out Key_Enum) is
+   begin
+      -- Simulate the situation where a user waits a bit for the card to
+      -- be validated, then presses cancel before it completes.
+
+      -- Delay long enough to force queuing of Keyboard.Cancel_Pressed.
+      delay ImpDef.Clear_Ready_Queue;
+
+      if Report.Equal (3, 3) then  -- Always true.
+         Key := Cancel;
+      end if;
+   end Listen_For_Input;
+
+
+   -- One of these gets created as "Keyboard" for each transaction
+   --
+   task body ATM_Keyboard_Task is
+      Key_Pressed : Key_Enum := None;
+   begin
+      loop
+                                               -- Force entry calls to be
+         Listen_For_Input (Key_Pressed);       -- queued, then set guard to
+                                               -- true.
+         select
+            when (Key_Pressed = Cancel) =>     -- Guard is now true, so accept
+               accept Cancel_Pressed do        -- queued entry call.
+                  null;  --:::: user code for cancel
+                  -- Now simulate an unexpected exception arising in the
+                  -- user code
+                  raise Propagated_From_Task;  -- Propagate an exception.
+                  
+               end Cancel_Pressed;
+
+               Report.Failed 
+                          ("Exception not propagated in ATM_Keyboard_Task");
+               
+               -- User has canceled the transaction so we exit the
+               -- loop and allow the task to terminate
+               exit;
+         else
+            Key_Pressed := None;
+         end select;
+      end loop;
+   exception
+      when Propagated_From_Task =>
+          null;  -- This is the expected test behavior
+      when others =>
+          Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+   end ATM_Keyboard_Task;
+
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type) is
+   begin
+      Card.Number := 9999;
+      Card.PIN    := 111;
+   end Read_Card;
+
+
+   procedure Validate_Card (Card : in ATM_Card_Type) is
+   begin
+      -- Simulate an exceedingly long validation activity.
+      loop                                             -- Infinite loop.
+         Count := (Count + 1) mod Integer (Card.PIN);
+         -- Synch. point to allow transfer of control to Keyboard
+         -- task during this simulation
+         delay ImpDef.Minimum_Task_Switch;
+         exit when not Report.Equal (Count, Count);    -- Always false.
+      end loop;
+   end Validate_Card;
+
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type) is
+   begin
+      Report.Failed ("Exception not re-raised immediately following " &
+                     "asynchronous select");
+      if Count = 1234 then
+         -- Initial value is unchanged
+         Report.Failed ("Abortable part did not execute");
+      end if;
+   end Perform_Transaction;
+
+
+end C974004_0;
+
+
+     --==================================================================--
+
+
+with Report;
+
+with C974004_0;  -- Automated teller machine abstraction.
+use  C974004_0;
+
+procedure C974004 is
+
+   Card_Data : ATM_Card_Type;
+
+begin  -- Main program.
+
+   Report.Test ("C974004", "Asynchronous Select: Trigger is queued on a " &
+                           "task entry and is completed first by an " &
+                           "exception");
+
+   Read_Card (Card_Data);
+
+   begin
+
+      declare
+         -- Create the task for this transaction
+         Keyboard : C974004_0.ATM_Keyboard_Task;
+      begin
+
+         --                                    --
+         -- Asynchronous select is tested here --
+         --                                    --
+
+         select
+            Keyboard.Cancel_Pressed;     -- Entry call initially queued, so
+                                         -- abortable part starts.
+
+            raise Transaction_Canceled;  -- Should not be executed.
+         then abort
+            Validate_Card (Card_Data);   -- Keyboard.Cancel_Pressed is accepted
+                                         -- and propagates an exception before
+                                         -- this call finishes; it is then
+                                         -- aborted.
+
+            -- Check that the whole of the abortable part is aborted, not
+            -- just the statement in the abortable part that was executing
+            -- at the time
+            Report.Failed ("Abortable part not aborted");
+         end select;
+                                         -- The propagated exception is
+                                         -- re-raised here; control passes to
+                                         -- the exception handler.
+
+         Perform_Transaction(Card_Data); -- Should not be reached.
+      exception
+         when Transaction_Canceled =>
+            Report.Failed ("Triggering alternative sequence of statements " &
+                           "executed");
+         when Propagated_From_Task =>
+            -- This is the expected test path
+            if Count = 1234 then
+               -- Initial value is unchanged
+               Report.Failed ("Abortable part did not execute");
+            end if;
+         when Tasking_Error  =>
+            Report.Failed ("Tasking_Error raised");
+         when others  =>
+            Report.Failed ("Wrong exception raised"); 
+      end;
+
+   exception
+      when Propagated_From_Task =>
+         Report.Failed ("Correct exception raised at wrong level");
+      when  others  =>
+         Report.Failed ("Wrong exception raised at wrong level");
+   end;
+
+   Report.Result;
+
+end C974004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974005.a
new file mode 100644
index 000000000..196a8edc0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974005.a
@@ -0,0 +1,259 @@
+-- C974005.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 Tasking_Error is raised at the point of an entry call
+--      which is the triggering statement of an asynchronous select, if
+--      the entry call is queued, but the task containing the entry completes
+--      before it can be accepted or canceled.
+--
+--      Check that the abortable part is aborted if it does not complete
+--      before the triggering statement completes.
+--
+--      Check that the sequence of statements of the triggering alternative
+--      is not executed.
+--
+-- TEST DESCRIPTION:
+--      Declare a main procedure containing an asynchronous select with a task
+--      entry call as triggering statement. Force the entry call to be
+--      queued by having the task call a procedure, prior to the corresponding
+--      accept statement, which simulates a routine waiting for user input
+--      (with a delay). 
+--
+--      Simulate a time-consuming routine in the abortable part by calling a
+--      procedure containing an infinite loop. Meanwhile, simulate input by
+--      the user (the delay expires) which is NOT the input expected by the
+--      guard on the accept statement. The entry remains closed, and the
+--      task completes its execution. Since the entry was not accepted before
+--      its task completed, Tasking_Error is raised at the point of the entry
+--      call.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C974005_0 is  -- Automated teller machine abstraction.
+
+
+   -- Flags for testing purposes:
+
+   Count : Integer := 1234;            
+
+   type Key_Enum is (None, Cancel, Deposit, Withdraw);
+
+   type Card_Number_Type is private;
+   type Card_PIN_Type    is private;
+   type ATM_Card_Type    is private;
+
+
+   Transaction_Canceled : exception;
+
+
+   task type ATM_Keyboard_Task is
+      entry Cancel_Pressed;
+   end ATM_Keyboard_Task;
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type);
+
+   procedure Validate_Card (Card : in ATM_Card_Type);
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type);
+
+private
+
+   type Card_Number_Type is range   1 .. 9999;
+   type Card_PIN_Type    is range 100 ..  999;
+
+   type ATM_Card_Type is record
+      Number : Card_Number_Type;
+      PIN    : Card_PIN_Type;
+   end record;
+
+end C974005_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+package body C974005_0 is
+
+
+   procedure Listen_For_Input (Key : out Key_Enum) is
+   begin
+      -- Simulate the situation where a user waits a bit for the card to
+      -- be validated, then presses a transaction key (NOT Cancel).
+
+      -- Delay long enough to force queuing of Keyboard.Cancel_Pressed.
+      delay ImpDef.Clear_Ready_Queue;
+
+      if Report.Equal (3, 3) then  -- Always true.
+         Key := Deposit;           -- Cancel is NOT pressed.
+      end if;
+   end Listen_For_Input;
+
+
+   task body ATM_Keyboard_Task is
+      Key_Pressed : Key_Enum := None;
+   begin
+
+      -- Note: no loop. If the user does not press Cancel, the task completes.
+      -- In this model of the keyboard monitor, the user only gets one chance
+      -- to cancel the card validation.
+                                                            -- Force entry
+         Listen_For_Input (Key_Pressed);                    -- calls to be
+                                                            -- queued, but do
+                                                            -- NOT set guard
+                                                            -- to true.
+      select
+         when (Key_Pressed = Cancel) =>                     -- Guard is false,
+            accept Cancel_Pressed do                        -- so entry call
+               Report.Failed ("Accept statement executed"); -- remains queued.
+            end Cancel_Pressed;
+      else                                                  -- Else alternative
+         Key_Pressed := None;                               -- executed, then
+      end select;                                           -- task ends.
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in ATM_Keyboard_Task"); 
+   end ATM_Keyboard_Task;
+
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type) is
+   begin
+      Card.Number := 9999;
+      Card.PIN    := 111;
+   end Read_Card;
+
+
+   procedure Validate_Card (Card : in ATM_Card_Type) is
+   begin
+      -- Simulate an exceedingly long validation activity.
+      loop                                             -- Infinite loop.
+         Count := (Count + 1) mod Integer (Card.PIN);
+
+         -- Synch Point to allow transfer of control to Keyboard task
+         -- during this simulation
+         delay ImpDef.Minimum_Task_Switch;
+
+         exit when not Report.Equal (Count, Count);    -- Always false.
+      end loop;
+   end Validate_Card;
+
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type) is
+   begin
+      Report.Failed ("Exception not re-raised immediately following " &
+                     "asynchronous select");
+      if Count = 1234 then
+         -- Additional analysis added to aid developers
+         Report.Failed ("Abortable part did not execute");
+      end if;
+   end Perform_Transaction;
+
+
+end C974005_0;
+
+
+     --==================================================================--
+
+
+with Report;
+
+with C974005_0;  -- Automated teller machine abstraction.
+use  C974005_0;
+
+procedure C974005 is
+
+   Card_Data : ATM_Card_Type;
+
+begin  -- Main program.
+
+   Report.Test ("C974005", "ATC: trigger is queued but task terminates" &
+                             " before call is serviced");
+
+   Read_Card (Card_Data);
+
+   begin
+
+      declare
+         Keyboard : C974005_0.ATM_Keyboard_Task;
+      begin
+
+         --                                    --
+         -- Asynchronous select is tested here --
+         --                                    --
+
+         select
+            Keyboard.Cancel_Pressed;      -- Entry call initially queued, so
+                                          -- abortable part starts.
+
+                                          -- Tasking_Error raised here when
+                                          -- Keyboard completes before entry
+                                          -- call can be accepted, and before
+                                          -- abortable part completes.
+
+            raise Transaction_Canceled;   -- Should not be executed.
+         then abort
+            Validate_Card (Card_Data);    -- Keyboard task completes before
+                                          -- Keyboard.Cancel_Pressed is
+                                          -- accepted, and before this call
+                                          -- finishes. Tasking_Error is raised
+                                          -- at the point of the entry call,
+                                          -- and this call is aborted.
+            -- Check that the whole of the abortable part is aborted, not just
+            -- the statement in the abortable part that was executing at
+            -- the time
+            Report.Failed ("Abortable part not aborted");
+         end select;
+         Perform_Transaction (Card_Data); -- Should not be reached.
+      exception
+         when Transaction_Canceled =>
+            Report.Failed ("Triggering alternative sequence of statements " &
+                           "executed");
+         when Tasking_Error        =>
+            if Count = 1234 then
+               Report.Failed ("Abortable part did not execute");
+            end if;
+         when others       =>
+            Report.Failed ("Wrong exception raised");
+      end;
+
+   exception
+      when Tasking_Error        =>
+         Report.Failed ("Correct exception raised at wrong level");
+      when others       =>
+         Report.Failed ("Wrong exception raised at wrong level");
+   end;
+
+   Report.Result;
+
+end C974005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974006.a
new file mode 100644
index 000000000..f6f4d92e8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974006.a
@@ -0,0 +1,197 @@
+-- C974006.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 sequence of statements of the triggering alternative
+--      of an asynchronous select statement is executed if the triggering
+--      statement is a protected entry call, and the entry is accepted
+--      immediately. Check that the corresponding entry body is executed
+--      before the sequence of statements of the triggering alternative.
+--      Check that the abortable part is not executed.
+--
+-- TEST DESCRIPTION:
+--      Declare a main procedure containing an asynchronous select with a
+--      protected entry call as triggering statement. Declare a protected
+--      procedure which sets the protected entry's barrier true. Force the
+--      entry call to be accepted immediately by calling this protected
+--      procedure prior to the asynchronous select. Since the entry call
+--      is accepted immediately, the abortable part should never start. When
+--      entry call completes, the sequence of statements of the triggering
+--      alternative should execute.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+package C974006_0 is  -- Automated teller machine abstraction.
+
+
+   -- Flag for testing purposes:
+
+   Entry_Body_Executed : Boolean := False;
+
+
+   type Key_Enum is (None, Cancel, Deposit, Withdraw);
+
+   type Card_Number_Type is private;
+   type Card_PIN_Type    is private;
+   type ATM_Card_Type    is private;
+
+
+   Transaction_Canceled : exception;
+
+
+   protected type ATM_Keyboard_Protected is
+      entry Cancel_Pressed;
+      procedure Read_Key;
+   private
+      Last_Key_Pressed : Key_Enum := None;
+   end ATM_Keyboard_Protected;
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type);
+
+   procedure Validate_Card (Card : in ATM_Card_Type);
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type);
+
+private
+
+   type Card_Number_Type is range   1 .. 9999;
+   type Card_PIN_Type    is range 100 ..  999;
+
+   type ATM_Card_Type is record
+      Number : Card_Number_Type;
+      PIN    : Card_PIN_Type;
+   end record;
+
+end C974006_0;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C974006_0 is
+
+
+   protected body ATM_Keyboard_Protected is
+
+      entry Cancel_Pressed when (Last_Key_Pressed = Cancel) is
+      begin
+         Entry_Body_Executed := True;
+      end Cancel_Pressed;
+
+      procedure Read_Key is
+      begin
+         -- Simulate a procedure which processes user keyboard input, and
+         -- which is called by some interrupt handler.
+         Last_Key_Pressed := Cancel;
+      end Read_Key;
+
+   end ATM_Keyboard_Protected;
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type) is
+   begin
+      Card.Number := 9999;
+      Card.PIN    := 111;
+   end Read_Card;
+
+
+   procedure Validate_Card (Card : in ATM_Card_Type) is
+   begin
+      Report.Failed ("Abortable part executed");
+   end Validate_Card;
+
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type) is
+   begin
+      Report.Failed ("Triggering alternative sequence of statements " &
+                      "not fully executed");
+   end Perform_Transaction;
+
+
+end C974006_0;
+
+
+     --==================================================================--
+
+
+with Report;
+
+with C974006_0;  -- Automated teller machine abstraction.
+use  C974006_0;
+
+procedure C974006 is
+
+   Card_Data : ATM_Card_Type;
+
+begin
+
+   Report.Test ("C974006", "ATC: trigger is protected entry call" &
+                              " and completes first");
+
+   Read_Card (Card_Data);
+
+   declare
+      Keyboard : C974006_0.ATM_Keyboard_Protected;
+   begin
+
+      -- Simulate the situation where the user hits cancel before the
+      -- validation process can start:
+      Keyboard.Read_Key;                 -- Force Keyboard.Cancel_Pressed to
+                                         -- be accepted immediately.
+
+      --                                    --
+      -- Asynchronous select is tested here --
+      --                                    --
+
+      select
+         Keyboard.Cancel_Pressed;        -- Entry call is accepted immediately,
+                                         -- so abortable part does NOT start.
+
+         if not Entry_Body_Executed then -- Executes after entry completes.
+            Report.Failed ("Triggering alternative sequence of statements " &
+                           "executed before triggering statement complete");
+         end if;
+
+         raise Transaction_Canceled;     -- Control passes to exception
+                                         -- handler.
+      then abort
+         Validate_Card (Card_Data);      -- Should not be executed.
+      end select;
+      Perform_Transaction (Card_Data);   -- Should not be reached.
+   exception
+      when Transaction_Canceled =>
+         null;
+   end;
+
+   Report.Result;
+
+end C974006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974007.a
new file mode 100644
index 000000000..07007b9bb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974007.a
@@ -0,0 +1,205 @@
+-- C974007.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 sequence of statements of the triggering alternative
+--      of an asynchronous select statement is not executed if the triggering
+--      statement is a protected entry call, and the entry is not accepted
+--      before the abortable part completes. Check that execution continues
+--      immediately following the asynchronous select.
+--
+-- TEST DESCRIPTION:
+--      Declare a main procedure containing an asynchronous select with a
+--      protected entry call as triggering statement. Declare a protected
+--      procedure which sets the protected entry's barrier true. Ensure
+--      that the entry call is never accepted by not calling the protected
+--      procedure; the barrier remains false, and the entry call from
+--      asynchronous select is queued. Since the abortable part will complete
+--      before the entry is accepted, the sequence of statements of the
+--      triggering alternative is never executed.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+package C974007_0 is  -- Automated teller machine abstraction.
+
+
+   -- Flags for testing purposes:
+   -- 
+   Abortable_Part_Executed       : Boolean := False;
+   Perform_Transaction_Executed  : Boolean := False;
+   Triggering_Statement_Executed : Boolean := False;
+
+
+   type Key_Enum is (None, Cancel, Deposit, Withdraw);
+
+   type Card_Number_Type is private;
+   type Card_PIN_Type    is private;
+   type ATM_Card_Type    is private;
+
+
+   Transaction_Canceled : exception;
+
+
+   protected type ATM_Keyboard_Protected is
+      entry Cancel_Pressed;
+      procedure Read_Key;
+   private
+      Last_Key_Pressed : Key_Enum := None;
+   end ATM_Keyboard_Protected;
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type);
+
+   procedure Validate_Card (Card : in ATM_Card_Type);
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type);
+
+private
+
+   type Card_Number_Type is range   1 .. 9999;
+   type Card_PIN_Type    is range 100 ..  999;
+
+   type ATM_Card_Type is record
+      Number : Card_Number_Type;
+      PIN    : Card_PIN_Type;
+   end record;
+
+end C974007_0;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C974007_0 is
+
+
+   protected body ATM_Keyboard_Protected is
+
+      -- Barrier is false for the live of the test
+      entry Cancel_Pressed when (Last_Key_Pressed = Cancel) is  
+      begin                                                     
+      Triggering_Statement_Executed  := true;   -- Test has failed
+      -- (Note: cannot call Report.Failed in the protected entry body]
+      end Cancel_Pressed;
+
+      procedure Read_Key is                                     -- Never
+      begin                                                     -- called.
+         -- Simulate a procedure which reads user keyboard input, and
+         -- which is called by some interrupt handler.
+         Last_Key_Pressed := Cancel;
+      end Read_Key;
+
+   end ATM_Keyboard_Protected;
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type) is
+   begin
+      Card.Number := 9999;
+      Card.PIN    := 111;
+   end Read_Card;
+
+
+   procedure Validate_Card (Card : in ATM_Card_Type) is
+   begin
+      Abortable_Part_Executed := True;
+   end Validate_Card;
+
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type) is
+   begin
+      Perform_Transaction_Executed := True;
+   end Perform_Transaction;
+
+
+end C974007_0;
+
+
+     --==================================================================--
+with Report;
+
+with C974007_0;  -- Automated teller machine abstraction.
+use  C974007_0;
+
+procedure C974007 is
+
+   Card_Data : ATM_Card_Type;
+
+begin
+
+   Report.Test ("C974007", "ATC: trigger is protected entry call" &
+                              " and abortable part completes first");
+
+   Read_Card (Card_Data);
+
+   declare
+      Keyboard : C974007_0.ATM_Keyboard_Protected;
+   begin
+
+      --                                    --
+      -- Asynchronous select is tested here --
+      --                                    --
+
+      select
+         Keyboard.Cancel_Pressed;        -- Barrier is never set true, so
+                                         -- entry call is queued and never
+                                         -- accepted.
+
+         raise Transaction_Canceled;     -- Should not be executed.
+      then abort
+         Validate_Card (Card_Data);      -- This call completes before
+                                         -- Keyboard.Cancel_Pressed can be
+                                         -- accepted.
+      end select;
+      Perform_Transaction (Card_Data);   -- Execution proceeds here after
+                                         -- Validate_Card completes.
+   exception
+      when Transaction_Canceled =>
+         Report.Failed ("Triggering alternative sequence of statements " &
+                        "executed");
+   end;
+   
+   
+   if Triggering_Statement_Executed  then
+      Report.Failed ("Triggering statement was executed");
+   end if;
+
+   if not Abortable_Part_Executed then
+      Report.Failed ("Abortable part not executed");
+   end if;
+
+   if not Perform_Transaction_Executed then
+      Report.Failed ("Statements following asynchronous select not " &
+                     "executed");
+   end if;
+
+   Report.Result;
+
+end C974007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974008.a
new file mode 100644
index 000000000..b76db7bd0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974008.a
@@ -0,0 +1,229 @@
+-- C974008.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 abortable part of an asynchronous select statement
+--      is not started if the triggering statement is a task entry call, and
+--      the entry call is not queued.
+--
+--      Check that the sequence of statements of the triggering alternative
+--      is executed after the abortable part is left.
+--
+-- TEST DESCRIPTION:
+--      Declare a main procedure containing an asynchronous select with a task
+--      entry call as triggering statement.  Ensure that the task is waiting
+--      at the accept statement so the rendezvous is executed immediately (the
+--      entry call is not queued). 
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C974008_0 is  -- Automated teller machine abstraction.
+
+
+   -- Flags for testing purposes:
+
+   Triggering_Statement_Completed : Boolean := False;
+   Count                          : Integer := 1234;  -- Global to defeat
+                                                      -- optimization.
+
+   type Key_Enum is (None, Cancel, Deposit, Withdraw);
+
+   type Card_Number_Type is private;
+   type Card_PIN_Type    is private;
+   type ATM_Card_Type    is private;
+
+
+   Transaction_Canceled : exception;
+
+
+   task type ATM_Keyboard_Task is
+      entry Cancel_Pressed;
+   end ATM_Keyboard_Task;
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type);
+
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type);
+
+private
+
+   type Card_Number_Type is range   1 .. 9999;
+   type Card_PIN_Type    is range 100 ..  999;
+
+   type ATM_Card_Type is record
+      Number : Card_Number_Type;
+      PIN    : Card_PIN_Type;
+   end record;
+
+end C974008_0;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C974008_0 is
+
+
+   procedure Listen_For_Input (Key : out Key_Enum) is
+   begin
+      -- Simulate the situation where the user presses the cancel key
+      -- before the card is validated
+
+      -- press the cancel key immediately
+      Key := Cancel;
+
+   end Listen_For_Input;
+
+
+
+   -- One of these gets created as "Keyboard" for each transaction
+   --
+   task body ATM_Keyboard_Task is
+      Key_Pressed : Key_Enum := None;
+   begin
+      -- NOTE:   Normal usage for this routine would be the loop with 
+      --         the select statement included.  This particular test
+      --         requires that the task be waiting at the accept 
+      --         for the call.  To ensure that this is the case the 
+      --         extraneous commands are commented out (we leave them
+      --         in this form to show the reader the surrounds to the 
+      --         fragment of code remaining)
+ 
+      -- loop
+                                         
+         Listen_For_Input (Key_Pressed); 
+                                         
+         -- select
+            -- when (Key_Pressed = Cancel) =>                 -- Guard is now
+               accept Cancel_Pressed do                    -- true, so accept
+                  Triggering_Statement_Completed := True;  -- queued entry
+               end Cancel_Pressed;                         -- call.
+
+               -- User has cancelled the transaction so we exit the
+               -- loop and allow the task to terminate
+               -- exit;
+         -- else
+            -- Key_Pressed := None;
+         -- end select;
+
+      -- end loop;
+   exception
+      when others =>
+          Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+   end ATM_Keyboard_Task;
+
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type) is
+   begin
+      Card.Number := 9999;
+      Card.PIN    := 111;
+   end Read_Card;
+
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type) is
+   begin
+      Report.Failed ("Triggering alternative sequence of statements " &
+                     "not executed");
+      if not Triggering_Statement_Completed then
+         Report.Failed ("Triggering statement did not complete");
+      end if;
+   end Perform_Transaction;
+
+
+end C974008_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with C974008_0;  -- Automated teller machine abstraction.
+use  C974008_0;
+
+procedure C974008 is
+
+   Card_Data : ATM_Card_Type;
+
+begin  -- Main program.
+
+   Report.Test ("C974008", "Asynchronous Select: Trigger is a call to a " &
+                           "waiting task entry and completes immediately");
+
+   Read_Card (Card_Data);
+
+   declare
+      -- Create the task for this transaction
+      Keyboard : C974008_0.ATM_Keyboard_Task;    
+   begin
+
+      -- Ensure task is waiting at the accept
+      -- This is the time required to activate another task and allow it
+      -- to run to its first accept statement.
+      --
+      delay ImpDef.Switch_To_New_Task;
+
+      --                                    --
+      -- Asynchronous select is tested here --
+      --                                    --
+
+      select
+         Keyboard.Cancel_Pressed;      -- Entry call is executed immediately
+
+         raise Transaction_Canceled;   -- This is executed after Validate_Card
+                                       -- is aborted.
+      then abort
+
+         -- In other similar tests Validate_Card is called here.  In this 
+         -- test we just check to see if the abortable part is called at
+         -- all.  Since the triggering call is not queued the abortable 
+         -- part should not be started
+         --
+         Report.Failed ("Abortable part started");
+
+      end select;
+
+      Perform_Transaction (Card_Data); -- Should not be reached.
+   exception
+      when Transaction_Canceled =>
+
+         if not Triggering_Statement_Completed then
+            Report.Failed ("Triggering alternative sequence of statements " &
+                           "executed but triggering statement not complete");
+         end if;
+
+   end;
+
+   Report.Result;
+
+end C974008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974009.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974009.a
new file mode 100644
index 000000000..419f2a3e9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974009.a
@@ -0,0 +1,206 @@
+-- C974009.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 abortable part of an asynchronous select statement
+--      is not started if the triggering statement is a task entry call, 
+--      the entry call is not queued and the entry call completes by 
+--      propagating an exception.
+--
+--      Check that the exception is properly propagated to the asynchronous
+--      select statement and thus the sequence of statements of the triggering
+--      alternative is not executed after the abortable part is left. 
+--
+--      Check that the exception propagated by the entry call is re-raised
+--      immediately following the asynchronous select.
+--
+-- TEST DESCRIPTION:
+--
+--      Use a small subset of the base Automated teller machine simulation
+--      which is shown in greater detail in other tests of this series.  
+--      Declare a main procedure containing an asynchronous select with a task
+--      entry call as triggering statement.  Force the task to be waiting at
+--      the accept statement so that the call is not queued and the rendezvous
+--      is executed immediately.  Simulate an unexpected exception in the
+--      rendezvous. Use stripped down versions of called procedures to  check
+--      the correct path in the test.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+package C974009_0 is  -- Automated teller machine abstraction.
+
+
+   Propagated_From_Task : exception;
+   Transaction_Canceled : exception;
+
+   type Key_Enum is (None, Cancel, Deposit, Withdraw);
+
+   type Card_Number_Type is private;
+   type Card_PIN_Type    is private;
+   type ATM_Card_Type    is private;
+
+   task type ATM_Keyboard_Task is
+      entry Cancel_Pressed;
+   end ATM_Keyboard_Task;
+
+
+   procedure Validate_Card (Card : in ATM_Card_Type);
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type);
+
+
+private
+
+   type Card_Number_Type is range   1 .. 9999;
+   type Card_PIN_Type    is range 100 ..  999;
+
+   type ATM_Card_Type is record
+      Number : Card_Number_Type;
+      PIN    : Card_PIN_Type;
+   end record;
+
+end C974009_0;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C974009_0 is
+
+
+
+   -- One of these gets created as "Keyboard" for each transaction
+   --
+   task body ATM_Keyboard_Task is
+      Key_Pressed : Key_Enum := None;
+   begin
+      accept Cancel_Pressed do        -- queued entry call.
+         null;  --:::: stub, user code for cancel
+         -- Now simulate an unexpected exception arising in the
+         -- user code
+         raise Propagated_From_Task;  -- Propagate an exception.
+                  
+       end Cancel_Pressed;
+
+       Report.Failed ("Exception not propagated in ATM_Keyboard_Task");
+               
+   exception
+      when Propagated_From_Task =>
+          null;  -- This is the expected test behavior
+      when others =>
+          Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+   end ATM_Keyboard_Task;
+
+   procedure Validate_Card (Card : in ATM_Card_Type) is
+   begin
+      Report.Failed ("Abortable part was executed");
+   end Validate_Card;
+
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type) is
+   begin
+      Report.Failed ("Exception not re-raised immediately following " &
+                     "asynchronous select");
+   end Perform_Transaction;
+
+
+end C974009_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with C974009_0;  -- Automated teller machine abstraction.
+use  C974009_0;
+
+procedure C974009 is
+
+   Card_Data : ATM_Card_Type;
+
+begin  -- Main program.
+
+   Report.Test ("C974009", "Asynchronous Select: Trigger is a call to a " &
+                           "task entry, is not queued and is completed " &
+                           "first by an exception");
+
+
+   begin
+
+      declare
+         -- Create the task for this transaction
+         Keyboard : C974009_0.ATM_Keyboard_Task;
+      begin
+
+         -- Ensure task is waiting a the accept so the call is not queued
+         -- This is the time required to activate another task and allow it
+         -- to run to its first accept statement
+         -- 
+         delay ImpDef.Switch_To_New_Task;
+
+         --                                    --
+         -- Asynchronous select is tested here --
+         --                                    --
+
+         select
+ 
+            Keyboard.Cancel_Pressed;
+
+            raise Transaction_Canceled;  -- Should not be executed.
+         then abort
+            Validate_Card (Card_Data);   -- Keyboard.Cancel_Pressed is accepted
+                                         -- and propagates an exception before
+                                         -- this call is executed
+         end select;
+
+         -- The propagated exception is re-raised here.
+         Perform_Transaction(Card_Data); -- Should not be reached.
+
+      exception
+         when Transaction_Canceled =>
+            Report.Failed ("Triggering alternative sequence of statements " &
+                           "executed");
+         when Propagated_From_Task =>
+            null;  -- This is the expected test path
+         when others =>
+            Report.Failed ("Wrong exception raised");
+      end;
+
+   exception
+      when others =>
+            Report.Failed ("Unexpected exception raised");
+   end;
+
+   Report.Result;
+
+end C974009;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974010.a
new file mode 100644
index 000000000..caeb9d570
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974010.a
@@ -0,0 +1,209 @@
+-- C974010.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 abortable part of an asynchronous select statement
+--      is not started if the triggering statement is a task entry call to
+--      a task that has already terminated.
+--
+--      Check that Tasking_Error is properly propagated to the asynchronous
+--      select statement and thus the sequence of statements of the triggering
+--      alternative is not executed after the abortable part is left. 
+--
+--      Check that Tasking_Error is re-raised immediately following the 
+--      asynchronous select.
+--
+-- TEST DESCRIPTION:
+--
+--      Use a small subset of the base Automated Teller Machine simulation
+--      which is shown in greater detail in other tests of this series.  
+--      Declare a main procedure containing an asynchronous select with a task
+--      entry call as triggering statement.  Ensure that the task is
+--      terminated before the entry call.  Use stripped down versions of
+--      the  called procedures to check the correct path in the test.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C974010_0 is  -- Automated teller machine abstraction.
+
+
+   Transaction_Canceled : exception;
+
+   type Key_Enum is (None, Cancel, Deposit, Withdraw);
+
+   type Card_Number_Type is private;
+   type Card_PIN_Type    is private;
+   type ATM_Card_Type    is private;
+
+   task type ATM_Keyboard_Task is
+      entry Cancel_Pressed;
+   end ATM_Keyboard_Task;
+
+
+   procedure Validate_Card (Card : in ATM_Card_Type);
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type);
+
+
+private
+
+   type Card_Number_Type is range   1 .. 9999;
+   type Card_PIN_Type    is range 100 ..  999;
+
+   type ATM_Card_Type is record
+      Number : Card_Number_Type;
+      PIN    : Card_PIN_Type;
+   end record;
+
+end C974010_0;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C974010_0 is
+
+
+
+   -- One of these gets created as "Keyboard" for each transaction
+   --
+   task body ATM_Keyboard_Task is
+      TC_Suicide  : exception;
+      Key_Pressed : Key_Enum := None;
+   begin
+      raise TC_Suicide;   -- Simulate early, unexpected termination
+
+      accept Cancel_Pressed do        -- queued entry call.
+         null;  --:::: user code for cancel
+                 
+      end Cancel_Pressed;
+
+   exception
+      when TC_Suicide =>
+         null;  -- This is the expected test behavior
+      when others =>
+          Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+   end ATM_Keyboard_Task;
+
+   procedure Validate_Card (Card : in ATM_Card_Type) is
+   begin
+      Report.Failed ("Abortable part was executed");
+   end Validate_Card;
+
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type) is
+   begin
+      Report.Failed ("Exception not re-raised immediately following " &
+                     "asynchronous select");
+   end Perform_Transaction;
+
+
+end C974010_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with C974010_0;  -- Automated teller machine abstraction.
+use  C974010_0;
+
+procedure C974010 is
+
+   Card_Data : ATM_Card_Type;
+   TC_Tasking_Error_Handled : Boolean := false;
+
+begin  -- Main program.
+
+   Report.Test ("C974010", "Asynchronous Select: Trigger is a call to a " &
+                           "task entry of a task that is already completed");
+
+
+   declare
+      -- Create the task for this transaction
+      Keyboard : C974010_0.ATM_Keyboard_Task;
+   begin
+
+      -- Ensure the task is already completed before calling
+      --
+      while not Keyboard'terminated loop
+         delay ImpDef.Minimum_Task_Switch;
+      end loop;
+
+      --                                    --
+      -- Asynchronous select is tested here --
+      --                                    --
+
+      select
+ 
+         Keyboard.Cancel_Pressed;
+
+         raise Transaction_Canceled;  -- Should not be executed.
+
+      then abort
+
+         -- Since the triggering call is not queued the abortable part
+         -- should not be executed.
+         --
+         Validate_Card (Card_Data);  
+
+      end select;
+      --
+      -- The propagated exception is re-raised here.
+
+      Perform_Transaction(Card_Data); -- Should not be reached.
+
+   exception
+      when Transaction_Canceled =>
+         Report.Failed ("Triggering alternative sequence of statements " &
+                        "executed");
+      when Tasking_Error =>
+         -- This is the expected test path
+         TC_Tasking_Error_Handled := true;
+      when others       =>
+         Report.Failed ("Wrong exception raised: ");
+   end;
+
+   
+   if not TC_Tasking_Error_Handled then
+      Report.Failed ("Tasking_Error not properly propagated");
+   end if;
+
+   Report.Result;
+
+exception
+   when Tasking_Error =>
+        Report.Failed ("Tasking_Error propagated to wrong handler");
+        Report.Result;
+
+
+end C974010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974011.a
new file mode 100644
index 000000000..4682db628
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974011.a
@@ -0,0 +1,275 @@
+-- C974011.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 sequence of statements of the triggering alternative
+--      of an asynchronous select statement is not executed if the triggering
+--      statement is a task entry call and the entry is not accepted
+--      before the abortable part completes. 
+--      Check that the call queued on the entry is cancelled
+--
+-- TEST DESCRIPTION:
+--      Declare a main procedure containing an asynchronous select with a task
+--      entry call as triggering statement. Force the entry call to be
+--      queued by having the task call a procedure, prior to the corresponding
+--      accept statement, which simulates (with a delay) a routine waiting
+--      for user input
+--       
+--      Once the call is known to be queued, complete the abortable part. 
+--      Check that the rendezvous (and thus the trigger) does not complete. 
+--      Then clear the barrier and check that the entry has been cancelled
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      28 Nov 95   SAIC    Eliminated shared global variable for ACVC 2.0.1
+--
+--!
+
+with ImpDef;
+--
+package C974011_0 is  -- Automated teller machine abstraction.
+
+
+
+   type Key_Enum is (None, Cancel, Deposit, Withdraw);
+
+   protected Key_PO is
+      procedure Set (K : Key_Enum);
+      function  Value return Key_Enum;
+   private
+      Current : Key_Enum := None;
+   end Key_PO;
+
+
+   -- Flags for testing purposes
+   TC_Abortable_Part_Completed : Boolean := False;
+   TC_Rendezvous_Entered       : Boolean := False;
+   TC_Delay_Time : constant duration := ImpDef.Switch_To_New_Task;
+
+
+   Count  : Integer := 1234;  -- Global to defeat optimization.
+
+
+   type Card_Number_Type is private;
+   type Card_PIN_Type    is private;
+   type ATM_Card_Type    is private;
+
+
+   Transaction_Canceled : exception;
+
+
+   task type ATM_Keyboard_Task is
+      entry Cancel_Pressed;
+   end ATM_Keyboard_Task;
+
+   procedure Read_Card (Card : in out ATM_Card_Type);
+
+   procedure Validate_Card (Card : in ATM_Card_Type);
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type);
+
+private
+
+   type Card_Number_Type is range   1 .. 9999;
+   type Card_PIN_Type    is range 100 ..  999;
+
+   type ATM_Card_Type is record
+      Number : Card_Number_Type;
+      PIN    : Card_PIN_Type;
+   end record;
+
+end C974011_0;
+
+
+     --==================================================================--
+
+
+with Report;
+package body C974011_0 is
+
+   protected body Key_PO is
+      procedure Set (K : Key_Enum) is
+      begin
+         Current := K;
+      end Set;
+
+      function Value return Key_Enum is
+      begin
+        return Current;
+      end Value;
+   end Key_PO;
+
+
+   procedure Listen_For_Input (Key : out Key_Enum) is
+   begin
+      -- Model the situation where the user does not press cancel thus
+      -- allowing validation to complete
+
+      delay TC_Delay_Time;  -- Long enough to force queuing on
+                            -- Keyboard.Cancel_Pressed.
+    
+      Key := Key_PO.Value;
+
+   end Listen_For_Input;
+
+
+
+   -- One of these gets created as "Keyboard" for each transaction
+   --
+   task body ATM_Keyboard_Task is
+      Key_Pressed : Key_Enum;
+   begin
+      loop
+                                                           -- Force entry calls
+         Listen_For_Input (Key_Pressed);                   -- to be queued,
+
+         select
+            when (Key_Pressed = Cancel) =>                 
+               accept Cancel_Pressed do                    
+                  TC_Rendezvous_Entered := True;
+               end Cancel_Pressed;                        
+
+               -- User has cancelled the transaction so we exit the
+               -- loop and allow the task to terminate
+               exit;
+         else
+            delay ImpDef.Switch_To_New_Task;
+         end select;
+
+      end loop;
+   exception
+      when others =>
+          Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
+   end ATM_Keyboard_Task;
+
+
+
+   procedure Read_Card (Card : in out ATM_Card_Type) is
+   begin
+      Card.Number := 9999;
+      Card.PIN    := 111;
+   end Read_Card;
+
+
+   procedure Validate_Card (Card : in ATM_Card_Type) is
+   begin
+      Count := (Count + 1) mod Integer (Card.PIN);
+
+      -- Simulate a validation activity which is longer than the time
+      -- taken in Listen_For_Input but not inordinately so.
+      delay TC_Delay_Time * 2;
+
+   end Validate_Card;
+
+
+   procedure Perform_Transaction (Card : in ATM_Card_Type) is
+   begin
+      if TC_Rendezvous_Entered then
+         Report.Failed ("Triggering statement completed");
+      end if;
+      if Count = 1234 then
+         -- Initial value is unchanged
+         Report.Failed ("Abortable part did not execute");
+      end if;
+      if not TC_Abortable_Part_Completed then
+         Report.Failed ("Abortable part did not complete");
+      end if;
+   end Perform_Transaction;
+
+
+end C974011_0;
+
+
+     --==================================================================--
+
+
+with Report;
+
+with C974011_0;  -- Automated teller machine abstraction.
+use  C974011_0;
+
+procedure C974011 is
+
+   Card_Data : ATM_Card_Type;
+
+begin  -- Main program.
+
+   Report.Test ("C974011", "Asynchronous Select: Trigger is queued on a " &
+                            "task entry and the abortable part " &
+                            "completes first");
+
+   Read_Card (Card_Data);
+
+   declare
+      -- Create the task for this transaction
+      Keyboard : C974011_0.ATM_Keyboard_Task;    
+   begin
+
+      --                                    --
+      -- Asynchronous select is tested here --
+      --                                    --
+
+      select
+      
+         Keyboard.Cancel_Pressed;      -- Entry call is initially queued, so
+                                       -- abortable part starts.
+         raise Transaction_Canceled;   -- This would be executed if we
+                                       -- completed the rendezvous
+      then abort
+      
+         Validate_Card (Card_Data);
+         TC_Abortable_Part_Completed := true;
+
+      end select;
+
+      Perform_Transaction (Card_Data); 
+
+
+      -- Now clear the entry barrier to allow the rendezvous to complete
+      -- if the triggering call has not been cancelled 
+      Key_PO.Set (Cancel);
+      --
+      delay TC_Delay_Time;  -- to allow it all to take place
+
+      if TC_Rendezvous_Entered then 
+         Report.Failed ("Triggering Call was not cancelled");
+      end if;
+      
+      abort Keyboard;    -- clean up.  (Note: the task will only exit the
+                         -- loop and terminate if the call hanging on the 
+                         -- entry is executed.)  
+
+   exception
+      when Transaction_Canceled =>
+         Report.Failed ("Triggering alternative sequence of statements " &
+                           "executed");
+      when Others =>
+         Report.Failed ("Unexpected exception in the Main");
+   end;
+
+   Report.Result;
+       
+end C974011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974012.a
new file mode 100644
index 000000000..4e43c72a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974012.a
@@ -0,0 +1,165 @@
+-- C974012.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 abortable part of an asynchronous select statement is
+--      aborted if it does not complete before the triggering statement
+--      completes, where the triggering statement is a call on a protected
+--      entry which is queued.
+--
+-- TEST DESCRIPTION:
+--      A fraction of in-line code is simulated.  A voltage deficiency causes
+--      the routine to seek an alternate best-cost route on an electrical grid
+--      system.  
+--      
+--      An asynchronous select is used with the triggering alternative being a
+--      call to a protected entry with a barrier.  The abortable part is a
+--      routine simulating the lengthy alternate path negotiation.  The entry
+--      barrier would be cleared if the voltage deficiency is rectified before
+--      the alternate can be found thus nullifying the need for the alternate.  
+--      
+--      The test simulates a return to normal in the middle of the
+--      negotiation.  The barrier is cleared, the triggering alternative
+--      completes first and the abortable part should be aborted.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+with Report;
+with ImpDef;
+
+procedure C974012 is
+
+   subtype Grid_Path is string(1..21);
+   subtype Deficiency is integer range 100..1_000;   -- in MWh
+
+   New_Path         : Grid_Path;
+   Dummy_Deficiency : Deficiency := 520;   
+   Path_Available   : Boolean    := false;
+
+   TC_Terminate_Negotiation_Executed  : Boolean := false;
+   TC_Trigger_Completed               : Boolean := false;
+   TC_Negotiation_Completed           : Boolean := false;
+
+   protected Local_Deficit is
+      procedure Set_Good_Voltage;
+      procedure Bad_Voltage;
+      entry Terminate_Negotiation;
+   private
+      Good_Voltage   : Boolean := false;   -- barrier
+   end Local_Deficit;
+
+   protected body Local_Deficit is
+
+      procedure Set_Good_Voltage is
+      begin
+         Good_Voltage := true;
+      end Set_Good_Voltage;
+
+      procedure Bad_Voltage is
+      begin
+         Good_Voltage := false;
+      end Bad_Voltage;
+
+      -- Trigger is queued on this entry with barrier condition
+      entry Terminate_Negotiation when Good_Voltage is
+      begin
+         -- complete the triggering call thus terminating grid_path
+         -- negotiation.
+         null; --::: stub - signal main board
+         TC_Terminate_Negotiation_Executed := true;   -- show path traversal
+      end Terminate_Negotiation;
+
+   end Local_Deficit;
+
+
+   -- Routine to find the most cost effective grid path for this 
+   -- particular deficiency at this particular time
+   --
+   procedure Path_Negotiation (Requirement : in  Deficiency;
+                               Best_Path   : out Grid_Path  ) is
+      
+      Dummy_Path : Grid_Path := "NYC.425_NY.227_NH.132";
+      Match : Deficiency := Report.Ident_Int (Requirement); 
+  
+   begin
+      -- 
+      null; --::: stub
+      --
+      -- Simulate a lengthy path negotiation 
+      for i in 1..5 loop
+         delay ImpDef.Minimum_Task_Switch;   
+         -- Part of the way through the negotiation simulate some external 
+         -- event returning the voltage to acceptable level 
+         if i = 3 then
+            Local_Deficit.Set_Good_Voltage;   -- clear the barrier
+         end if;
+      end loop; 
+      
+      Best_Path := Dummy_Path;
+      TC_Negotiation_Completed := true;
+   
+   end Path_Negotiation;
+
+  
+
+begin
+
+   Report.Test ("C974012", "Asynchronous Select: Trigger is queued on a " &
+                           "protected entry and completes before the " &
+                           "abortable part");
+
+   -- :::::::::   Fragment of code
+   
+   Local_Deficit.Bad_Voltage;      -- Set barrier condition
+
+   -- For the given voltage deficiency start negotiating the best grid
+   -- path.  If voltage returns to acceptable level cancel the negotiation
+   --
+   select
+      -- Prepare to terminate the Path_Negotiation if voltage improves
+      Local_Deficit.Terminate_Negotiation;
+      TC_Trigger_Completed := true;
+   then abort
+      Path_Negotiation (Dummy_Deficiency, New_Path) ;
+      Path_Available := true;
+   end select;
+   -- :::::::::
+
+   if not TC_Terminate_Negotiation_Executed or else not
+                                               TC_Trigger_Completed then 
+      Report.Failed ("Unexpected test path taken");
+   end if;
+
+   if Path_Available or else TC_Negotiation_Completed then
+      Report.Failed ("Abortable part was not aborted");
+   end if;
+   Report.Result;
+
+end C974012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974013.a
new file mode 100644
index 000000000..4a930da93
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974013.a
@@ -0,0 +1,167 @@
+-- C974013.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 abortable part of an asynchronous select statement
+--      is aborted if it does not complete before the triggering statement
+--      completes, where the triggering statement is a delay_until
+--      statement.
+--
+--      Check that the sequence of statements of the triggering alternative
+--      is executed after the abortable part is left.
+--
+-- TEST DESCRIPTION:
+--      Declare a task with an accept statement containing an asynchronous
+--      select with a delay_until triggering statement.  Parameterize
+--      the accept statement with the amount of time to be added to the
+--      current time to be used for the delay. Simulate a time-consuming 
+--      calculation by declaring a procedure containing an infinite loop.
+--      Call this procedure in the abortable part.
+--
+--      The delay will expire before the abortable part completes, at which
+--      time the abortable part is aborted, and the sequence of statements
+--      following the triggering statement is executed.
+--
+--      Main test logic is identical to c974001 which uses simple delay
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      28 Nov 95   SAIC    Fixed problems for ACVC 2.0.1.
+--
+--!
+
+with Report;
+with ImpDef;
+with Ada.Calendar;
+
+procedure C974013 is
+
+
+          --========================================================--
+
+   function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                            return Ada.Calendar.Time renames Ada.Calendar."+";
+
+
+   Allotted_Time : constant Duration := ImpDef.Switch_To_New_Task;
+   Calculation_Canceled : exception;
+
+   Count : Integer := 1234;                          
+   procedure Lengthy_Calculation is
+   begin
+      -- Simulate a non-converging calculation.
+      loop                                           -- Infinite loop.
+         Count := (Count + 1) mod 10;
+         exit when not Report.Equal (Count, Count);  -- Condition always false.
+         delay 0.0;                                  -- abort completion point
+      end loop;
+   end Lengthy_Calculation;
+
+
+          --========================================================--
+
+
+   task type Timed_Calculation is
+      entry Calculation (Time_Limit : in Duration);
+   end Timed_Calculation;
+
+
+   task body Timed_Calculation is
+      Delay_Time : Ada.Calendar.Time;
+   begin
+      loop
+         select
+            accept Calculation (Time_Limit : in Duration) do
+
+               -- We have to construct an "until" time artificially 
+               -- as we have no control over when the test will be run
+               --
+               Delay_Time := Ada.Calendar.Clock + Time_Limit;
+
+               --                                    --
+               -- Asynchronous select is tested here --
+               --                                    --
+
+               select
+
+                  delay until Delay_Time;     -- Time not reached yet, so
+                                              -- Lengthy_Calculation starts.
+
+                  raise Calculation_Canceled; -- This is executed after
+                                              -- Lengthy_Calculation aborted.
+
+               then abort
+
+                  Lengthy_Calculation;        -- Delay expires before complete,
+                                              -- so this call is aborted.
+                  -- Check that the whole of the abortable part is aborted,
+                  -- not just the statement in the abortable part that was
+                  -- executing at the time
+                  Report.Failed ("Abortable part not aborted");
+
+               end select;
+
+               Report.Failed ("Triggering alternative sequence of " &
+                              "statements not executed");
+
+            exception    -- New Ada 9x: handler within accept
+               when Calculation_Canceled =>
+                  if Count = 1234 then
+                     Report.Failed ("Abortable part did not execute");
+                  end if;
+            end Calculation;
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+            Report.Failed ("Unexpected exception in Timed_Calculation task");
+   end Timed_Calculation;
+
+
+          --========================================================--
+
+
+
+begin  -- Main program.
+
+   Report.Test ("C974013", "Asynchronous Select: Trigger is delay_until " &
+                           "which completes before abortable part");
+
+   declare
+      Timed : Timed_Calculation;  -- Task.
+   begin
+      Timed.Calculation (Time_Limit => Allotted_Time); -- Asynchronous select
+                                                       -- inside accept block.
+   exception
+      when Calculation_Canceled => 
+         Report.Failed ("wrong exception handler used");
+   end;       
+
+   Report.Result;
+
+end C974013;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974014.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974014.a
new file mode 100644
index 000000000..03ca915f8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c974014.a
@@ -0,0 +1,132 @@
+-- C974014.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 the triggering alternative of an asynchronous select 
+--      statement is a delay and the abortable part completes before the delay
+--      expires then the delay is cancelled and the optional statements in the
+--      triggering part are not performed.  In particular, check the case of
+--      the ATC in non-tasking code.
+--
+-- TEST DESCRIPTION:
+--      A fraction of in-line code is simulated.  An asynchronous select
+--      is used with a triggering delay of several minutes.  The abortable
+--      part, which is simulating a very lengthy, time consuming procedure
+--      actually returns almost immediately thus ensuring that it completes
+--      first.  At the conclusion, if a substantial amount of time has passed
+--      the delay is assumed not to have been cancelled. 
+--      (based on example in LRM 9.7.4)
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+with Report;
+with Ada.Calendar;
+         
+procedure C974014 is
+
+   function "-" (Left, Right : Ada.Calendar.Time)
+                              return Duration      renames Ada.Calendar."-";
+
+   TC_Start_Time      : Ada.Calendar.Time := Ada.Calendar.Clock;
+   TC_Elapsed_Time    : duration;
+
+   Maximum_Allowable_Time : duration := 300.0; -- for Calculate_Gamma_Function
+
+begin
+
+   Report.Test ("C974014", "ATC: When abortable part completes before " &
+                             "a triggering delay, check that the delay " &
+                             "is cancelled & optional statements " &
+                             "are not performed"); 
+
+   declare  -- encapsulate test code
+
+      type Gamma_Index is digits 5;   -- float precision
+
+      -- (These two fields are assumed filled elsewhere)
+      Input_Field, Result_of_Beta : Gamma_Index;   
+
+      -- Notify and take corrective action in the event that
+      -- the procedure Calculate_Gamma_Function does not converge.
+      --
+      procedure Non_Convergent is
+      begin
+         null;  -- stub
+
+         Report.Failed ("Optional statements in triggering part" &
+                                    " were performed");       
+      end Non_Convergent;
+
+
+      --  This is a very time consuming calculation.  It is possible,
+      --  that, with certain parameters, it will not converge.  If it
+      --  runs for more than Maximum_Allowable_Time it is considered
+      --  not to be convergent and should be aborted.
+      --
+      Procedure Calculate_Gamma_Function (X, Y : Gamma_Index) is
+      begin
+         null;  -- Stub
+         --
+      end Calculate_Gamma_Function;
+
+   begin  -- declare
+
+      -- .....  Isolated segment of inline code
+
+      -- Now Print Gamma Function (abort and display if not convergent)
+      --
+      select
+         delay Maximum_Allowable_Time;  -- for Calculate_Gamma_Function
+         Non_Convergent;   -- Display error and flag result as failed
+
+      then abort
+         Calculate_Gamma_Function (Input_Field, Result_of_Beta);
+      end select;
+
+      -- .....  End of Isolated segment of inline code
+
+   end; -- declare
+   
+   TC_Elapsed_Time := Ada.Calendar.Clock - TC_Start_Time;
+
+   -- Note: We are not checking for "cancellation within a reasonable time",
+   -- we are checking for cancellation/non-cancellation of the delay.  We
+   -- use a number which, if exceeded, means that the delay was not
+   -- cancelled and has proceeded to  full term.
+   --
+   if ( TC_Elapsed_Time > Maximum_Allowable_Time/2 ) then
+      -- Test time exceeds a reasonable value.
+      Report.Failed ("Triggering delay statement was not cancelled");
+   end if;
+
+
+   Report.Result;
+
+end C974014;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c980001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c980001.a
new file mode 100644
index 000000000..3bd4196f0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c980001.a
@@ -0,0 +1,303 @@
+-- C980001.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 when a construct is aborted the execution of an Initialize
+--      procedure as the last step of the default initialization of a
+--      controlled object is abort-deferred.
+--     
+--      Check that when a construct is aborted the execution of a Finalize
+--      procedure as part of the finalization of a controlled object is
+--      abort-deferred.
+--     
+--      Check that an assignment operation to an object with a controlled
+--      part is an abort-deferred operation.
+--
+-- TEST DESCRIPTION:
+--      The controlled operations which are being tested call a subprogram
+--      which guarantees that the enclosing operation becomes aborted.
+--
+--      Each object is created with a unique value to prevent optimizations
+--      due to the values being the same.
+--
+--      Two protected objects are utilized to warrant that the operations
+--      are delayed in their execution until such time that the abort is
+--      processed.  The object Hold_Up is used to hold the targeted
+--      operation in execution, the object Progress is used to communicate
+--      to the driver software that progress is indeed being made. 
+--
+--
+-- CHANGE HISTORY:
+--      01 MAY 95   SAIC    Initial version
+--      01 MAY 96   SAIC    Revised for 2.1
+--      11 DEC 96   SAIC    Final revision for 2.1
+--      02 DEC 97   EDS     Remove 2 calls to C980001_0.Hold_Up.Lock
+--!
+
+---------------------------------------------------------------- C980001_0
+
+with Impdef;
+with Ada.Finalization;
+package C980001_0 is
+
+  A_Little_While : constant Duration := Impdef.Switch_To_New_Task * 2.0;
+  Enough_Time_For_The_Controlled_Operation_To_Happen : constant Duration
+   := Impdef.Switch_To_New_Task * 4.0;
+
+  function TC_Unique return Integer;
+
+  type Sticks_In_Initialize is new Ada.Finalization.Controlled with record
+    Item: Integer := TC_Unique;
+  end record;
+  procedure Initialize( AV: in out Sticks_In_Initialize );
+
+  type Sticks_In_Adjust is new Ada.Finalization.Controlled with record
+    Item: Integer := TC_Unique;
+  end record;
+  procedure Adjust    ( AV: in out Sticks_In_Adjust );
+
+  type Sticks_In_Finalize is new Ada.Finalization.Controlled with record
+    Item: Integer := TC_Unique;
+  end record;
+  procedure Finalize  ( AV: in out Sticks_In_Finalize );
+
+  Initialize_Called : Boolean := False;
+  Adjust_Called     : Boolean := False;
+  Finalize_Called   : Boolean := False;
+
+  protected type Sticker is
+    entry Lock;
+    procedure Unlock;
+    function Is_Locked return Boolean;
+  private
+    Locked : Boolean := False;
+  end Sticker;
+
+  Hold_Up  : Sticker;
+  Progress : Sticker;
+
+  procedure Fail_And_Clear( Message : String );
+
+
+end C980001_0;
+ 
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with TCTouch;
+package body C980001_0 is
+
+  TC_Master_Value : Integer := 0;
+
+
+  function TC_Unique return Integer is  -- make all values unique.
+  begin
+    TC_Master_Value := TC_Master_Value +1;
+    return TC_Master_Value;
+  end TC_Unique;
+
+  protected body Sticker is
+
+    entry Lock when not Locked is
+    begin
+      Locked := True;
+    end Lock;
+
+    procedure Unlock is
+    begin
+      Locked := False;
+    end Unlock;
+
+    function Is_Locked return Boolean is
+    begin
+      return Locked;
+    end Is_Locked;
+
+  end Sticker;
+
+  procedure Initialize( AV: in out Sticks_In_Initialize ) is
+  begin
+    TCTouch.Touch('I');  -------------------------------------------------- I
+    Hold_Up.Unlock;               -- cause the select to abort
+    Initialize_Called := True;
+    AV.Item := TC_Unique;
+    TCTouch.Touch('i');  -------------------------------------------------- i
+    Progress.Unlock;              -- allows Wait_Your_Turn to continue
+  end Initialize;
+
+  procedure Adjust    ( AV: in out Sticks_In_Adjust ) is
+  begin
+    TCTouch.Touch('A');  -------------------------------------------------- A
+    Hold_Up.Unlock;               -- cause the select to abort
+    Adjust_Called := True;
+    AV.Item := TC_Unique;
+    TCTouch.Touch('a');  -------------------------------------------------- a
+    Progress.Unlock;
+  end Adjust;
+
+  procedure Finalize  ( AV: in out Sticks_In_Finalize ) is
+  begin
+    TCTouch.Touch('F');  -------------------------------------------------- F
+    Hold_Up.Unlock;               -- cause the select to abort
+    Finalize_Called := True;
+    AV.Item := TC_Unique;
+    TCTouch.Touch('f');  -------------------------------------------------- f
+    Progress.Unlock;
+  end Finalize;
+
+  procedure Fail_And_Clear( Message : String ) is
+  begin
+    Report.Failed(Message);
+    Hold_Up.Unlock;
+    Progress.Unlock;
+  end Fail_And_Clear;
+
+end C980001_0;
+ 
+---------------------------------------------------------------------------
+
+with Report;
+with TCTouch;
+with Impdef;
+with C980001_0;
+procedure C980001 is
+
+  procedure Check_Initialize_Conditions is
+  begin
+    if not C980001_0.Initialize_Called then
+      C980001_0.Fail_And_Clear("Initialize did not correctly complete");
+    end if;
+    TCTouch.Validate("Ii", "Initialization Sequence");
+  end Check_Initialize_Conditions;
+
+  procedure Check_Adjust_Conditions is
+  begin
+    if not C980001_0.Adjust_Called then
+      C980001_0.Fail_And_Clear("Adjust did not correctly complete");
+    end if;
+    TCTouch.Validate("Aa", "Adjust Sequence");
+  end Check_Adjust_Conditions;
+
+  procedure Check_Finalize_Conditions is
+  begin
+    if not C980001_0.Finalize_Called then
+      C980001_0.Fail_And_Clear("Finalize did not correctly complete");
+    end if;
+    TCTouch.Validate("FfFfFf", "Finalization Sequence",
+                     Order_Meaningful => False);
+  end Check_Finalize_Conditions;
+
+  procedure Wait_Your_Turn is
+    Overrun : Natural := 0;
+  begin
+    while C980001_0.Progress.Is_Locked loop  -- and waits
+      delay C980001_0.A_Little_While;
+      Overrun := Overrun +1;
+      if Overrun > 10 then  
+        C980001_0.Fail_And_Clear("Overrun expired lock");
+      end if;
+    end loop;
+  end Wait_Your_Turn;
+
+begin  -- Main test procedure.
+
+  Report.Test ("C980001", "Check the interaction between asynchronous " &
+                          "transfer of control and controlled types" );
+
+  C980001_0.Progress.Lock;
+  C980001_0.Hold_Up.Lock;
+
+  select
+    C980001_0.Hold_Up.Lock;  -- Init will unlock
+
+    Wait_Your_Turn;  -- abortable part is stuck in Initialize
+    Check_Initialize_Conditions;
+
+  then abort
+    declare
+      Object : C980001_0.Sticks_In_Initialize;
+    begin
+      delay Impdef.Minimum_Task_Switch;
+      if Report.Ident_Int( Object.Item ) /= Object.Item then
+        Report.Failed("Optimization foil caused failure");
+      end if;
+      C980001_0.Fail_And_Clear(
+                           "Initialize test executed beyond expected region");
+    end;
+  end select;
+
+  C980001_0.Progress.Lock;
+
+  select
+    C980001_0.Hold_Up.Lock;  -- Adjust will unlock
+
+    Wait_Your_Turn;  -- abortable part is stuck in Adjust
+    Check_Adjust_Conditions;
+
+  then abort
+    declare
+      Object1 : C980001_0.Sticks_In_Adjust;
+      Object2 : C980001_0.Sticks_In_Adjust;
+    begin
+      Object1 := Object2;
+      delay Impdef.Minimum_Task_Switch;
+      if Report.Ident_Int( Object2.Item )
+         /= Report.Ident_Int( Object1.Item ) then
+        Report.Failed("Optimization foil 1 caused failure");
+      end if;
+      C980001_0.Fail_And_Clear("Adjust test executed beyond expected region");
+    end;
+  end select;
+
+  C980001_0.Progress.Lock;
+
+  select
+    C980001_0.Hold_Up.Lock;  -- Finalize will unlock
+
+    Wait_Your_Turn;  -- abortable part is stuck in Finalize
+    Check_Finalize_Conditions;
+
+  then abort
+    declare
+      Object1 : C980001_0.Sticks_In_Finalize;
+      Object2 : C980001_0.Sticks_In_Finalize;
+    begin
+      Object1 := Object2;  -- cause a finalize call
+      delay Impdef.Minimum_Task_Switch;
+      if Report.Ident_Int( Object2.Item )
+         /= Report.Ident_Int( Object1.Item ) then
+        Report.Failed("Optimization foil 2 caused failure");
+      end if;
+      C980001_0.Fail_And_Clear(
+                             "Finalize test executed beyond expected region");
+    end;
+  end select;
+
+  Report.Result;
+
+exception
+  when others => C980001_0.Fail_And_Clear("Exception in main");
+                 Report.Result;
+end C980001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c980002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c980002.a
new file mode 100644
index 000000000..f2b9c5247
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c980002.a
@@ -0,0 +1,165 @@
+-- C980002.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 aborts are deferred during protected actions.
+--
+-- TEST DESCRIPTION:
+--      This test uses an asynchronous transfer of control to attempt
+--      to abort a protected operation.  The protected operation
+--      includes several requeues to check that the requeue does not
+--      allow the abort to occur.
+--
+--
+-- CHANGE HISTORY:
+--      30 OCT 95   SAIC    ACVC 2.1
+--
+--!
+
+with Report;
+procedure C980002 is
+
+  Max_Checkpoints : constant := 7;
+  type Checkpoint_ID is range 1..Max_Checkpoints;
+  type Points_Array is array (Checkpoint_ID) of Boolean;
+begin
+  Report.Test ("C980002",
+               "Check that aborts are deferred during a protected action" &
+               " including requeues");
+
+  declare -- test encapsulation
+
+    protected Checkpoint is
+       procedure Got_Here (Id : Checkpoint_ID);
+       function Results return Points_Array;
+    private
+       Reached_Points : Points_Array := (others => False);
+    end Checkpoint;
+
+    protected body Checkpoint is
+       procedure Got_Here (Id : Checkpoint_ID) is
+       begin
+          Reached_Points (Id) := True;
+       end Got_Here;
+
+       function Results return Points_Array is
+       begin
+          return Reached_Points;
+       end Results;
+    end Checkpoint;
+
+
+    protected Start_Here is
+       entry AST_Waits_Here;
+       entry Start_PO;
+    private
+       Open : Boolean := False;
+       entry First_Stop;
+    end Start_Here;
+
+    protected Middle_PO is
+       entry Stop_1;
+       entry Stop_2;
+    end Middle_PO;
+
+    protected Final_PO is
+       entry Final_Stop;
+    end Final_PO;
+
+
+    protected body Start_Here is
+       entry AST_Waits_Here when Open is
+       begin
+          null;
+       end AST_Waits_Here;
+
+       entry Start_PO when True is
+       begin
+          Open := True;
+          Checkpoint.Got_Here (1);
+          requeue First_Stop; 
+       end Start_PO;
+
+       -- make sure the AST has been accepted before continuing
+       entry First_Stop when AST_Waits_Here'Count = 0 is
+       begin
+          Checkpoint.Got_Here (2);
+          requeue Middle_PO.Stop_1;
+       end First_Stop;
+    end Start_Here;
+
+    protected body Middle_PO is
+       entry Stop_1 when True is
+       begin
+          Checkpoint.Got_Here (3);
+          requeue Stop_2;
+       end Stop_1;
+
+       entry Stop_2 when True is
+       begin
+          Checkpoint.Got_Here (4);
+          requeue Final_PO.Final_Stop;
+       end Stop_2;
+    end Middle_PO;
+
+    protected body Final_PO is
+       entry Final_Stop when True is
+       begin
+          Checkpoint.Got_Here (5);
+       end Final_Stop;
+    end Final_PO;
+
+
+  begin   -- test encapsulation
+    select
+       Start_Here.AST_Waits_Here;
+       Checkpoint.Got_Here (6);
+    then abort
+       Start_Here.Start_PO;
+       delay 0.0;  -- abort completion point
+       Checkpoint.Got_Here (7);
+    end select;
+
+    Check_The_Results: declare
+       Chk : constant Points_Array := Checkpoint.Results;
+       Expected : constant Points_Array :=  (1..6 => True,
+                                             7    => False);
+    begin
+       for I in Checkpoint_ID loop
+          if Chk (I) /= Expected (I) then
+             Report.Failed ("checkpoint error" &
+                            Checkpoint_ID'Image (I) &
+                            " actual is " &
+                            Boolean'Image (Chk(I)));
+          end if;         
+       end loop; 
+    end Check_The_Results;
+  exception
+    when others =>
+       Report.Failed ("unexpected exception");
+  end;    -- test encapsulation
+  
+  Report.Result;
+end C980002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c980003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c980003.a
new file mode 100644
index 000000000..dd69fc7ee
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c980003.a
@@ -0,0 +1,294 @@
+-- C980003.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.
+--*
+--
+-- TEST OBJECTIVE:
+--      Check that aborts are deferred during the execution of an 
+--      Initialize procedure (as the last step of the default 
+--      initialization of a controlled object), during the execution 
+--      of a Finalize procedure (as part of the finalization of a 
+--      controlled object), and during an assignment operation to an
+--      object with a controlled part.
+--
+-- TEST DESCRIPTION:
+--      A controlled type is created with Initialize, Adjust, and 
+--      Finalize operations.  These operations note in a protected
+--      object when the operation starts and completes.  This change
+--      in state of the protected object will open the barrier for
+--      the entry in the protected object.
+--      The test contains declarations of objects of the controlled
+--      type.  An asynchronous select is used to attempt to abort
+--      the operations on the controlled type.  The asynchronous select
+--      makes use of the state change to the protected object to 
+--      trigger the abort.
+--
+--
+-- CHANGE HISTORY:
+--      11 Jan 96   SAIC    Initial Release for 2.1
+--       5 May 96   SAIC    Incorporated Reviewer comments.
+--      10 Oct 96   SAIC    Addressed issue where assignment statement
+--                          can be 2 assignment operations.
+--
+--!
+
+with Ada.Finalization;
+package C980003_0 is
+    Verbose : constant Boolean := False;
+
+    -- the following flag is set true whenever the
+    -- Initialize operation is called.
+    Init_Occurred : Boolean;
+
+    type Is_Controlled is new Ada.Finalization.Controlled with
+         record
+             Id : Integer;
+         end record;
+
+     procedure Initialize (Object : in out Is_Controlled);
+     procedure Finalize   (Object : in out Is_Controlled);
+     procedure Adjust     (Object : in out Is_Controlled);
+
+     type States is (Unknown,
+                     Start_Init,   Finished_Init, 
+                     Start_Adjust, Finished_Adjust,
+                     Start_Final,  Finished_Final);
+
+     protected State_Manager is
+        procedure Reset;
+        procedure Set (New_State : States);
+        function Current return States;
+        entry Wait_For_Change;
+     private
+        Current_State : States := Unknown;
+        Changed : Boolean := False;
+     end State_Manager;
+
+end C980003_0;
+
+
+with Report;
+with ImpDef;
+package body C980003_0 is
+     protected body State_Manager is
+         procedure Reset is
+         begin
+             Current_State := Unknown;
+             Changed := False;
+         end Reset;
+
+         procedure Set (New_State : States) is
+         begin
+             Changed := True;
+             Current_State := New_State;
+         end Set;
+
+         function Current return States is
+         begin
+             return Current_State;
+         end Current;
+
+         entry Wait_For_Change when Changed is
+         begin
+             Changed := False;
+         end Wait_For_Change;
+     end State_Manager;
+
+     procedure Initialize (Object : in out Is_Controlled) is
+     begin
+        if Verbose then
+            Report.Comment ("starting initialize");
+        end if;
+        State_Manager.Set (Start_Init);
+        if Verbose then
+            Report.Comment ("in initialize");
+        end if;
+        delay ImpDef.Switch_To_New_Task;  -- tempting place for abort
+        State_Manager.Set (Finished_Init);
+        if Verbose then
+            Report.Comment ("finished initialize");
+        end if;
+        Init_Occurred := True;
+     end Initialize;
+
+     procedure Finalize   (Object : in out Is_Controlled) is
+     begin
+        if Verbose then
+            Report.Comment ("starting finalize");
+        end if;
+        State_Manager.Set (Start_Final);
+        if Verbose then
+            Report.Comment ("in finalize");
+        end if;
+        delay ImpDef.Switch_To_New_Task; -- tempting place for abort
+        State_Manager.Set (Finished_Final);
+        if Verbose then
+            Report.Comment ("finished finalize");
+        end if;
+     end Finalize;
+
+     procedure Adjust     (Object : in out Is_Controlled) is
+     begin
+        if Verbose then
+            Report.Comment ("starting adjust");
+        end if;
+        State_Manager.Set (Start_Adjust);
+        if Verbose then
+            Report.Comment ("in adjust");
+        end if;
+        delay ImpDef.Switch_To_New_Task; -- tempting place for abort
+        State_Manager.Set (Finished_Adjust);
+        if Verbose then
+            Report.Comment ("finished adjust");
+        end if;
+     end Adjust;
+end C980003_0;
+
+
+with Report;
+with ImpDef;
+with C980003_0;  use C980003_0;
+with Ada.Unchecked_Deallocation;
+procedure C980003 is
+
+    procedure Check_State (Should_Be : States;
+                           Msg       : String) is
+        Cur : States := State_Manager.Current;
+    begin
+        if Cur /= Should_Be then
+            Report.Failed (Msg);
+            Report.Comment ("expected: " & States'Image (Should_Be) &
+                            "  found: " & States'Image (Cur));
+        elsif Verbose then
+            Report.Comment ("passed: " & Msg);
+        end if;
+    end Check_State;
+
+begin
+ 
+    Report.Test ("C980003", "Check that aborts are deferred during" &
+                            " initialization, finalization, and assignment" &
+                            " operations on controlled objects");
+
+    Check_State (Unknown, "initial condition");
+
+    -- check that initialization and finalization take place
+    Init_Occurred := False;
+    select
+        State_Manager.Wait_For_Change;
+    then abort
+        declare
+            My_Controlled_Obj : Is_Controlled;
+        begin
+            delay 0.0;   -- abort completion point
+            Report.Failed ("state change did not occur");
+        end; 
+    end select;
+    if not Init_Occurred then
+        Report.Failed ("Initialize did not complete");
+    end if;
+    Check_State (Finished_Final, "init/final for declared item");
+
+    -- check adjust
+    State_Manager.Reset;
+    declare
+        Source, Dest : Is_Controlled;
+    begin
+        Check_State (Finished_Init, "adjust initial state");
+        Source.Id := 3;
+        Dest.Id := 4;
+        State_Manager.Reset;  -- so we will wait for change
+        select
+            State_Manager.Wait_For_Change;
+        then abort
+            Dest := Source;
+        end select;
+
+        -- there are two implementation methods for the 
+        -- assignment statement:
+        --   1.  no temporary was used in the assignment statement 
+        --        thus the entire
+        --        assignment statement is abort deferred.  
+        --   2.  a temporary was used in the assignment statement so
+        --        there are two assignment operations.  An abort may
+        --        occur between the assignment operations
+        -- Various optimizations are allowed by 7.6 that can affect
+        -- how many times Adjust and Finalize are called. 
+        -- Depending upon the implementation, the state can be either
+        -- Finished_Adjust or Finished_Finalize.   If it is any other
+        -- state then the abort took place at the wrong time.
+
+        case State_Manager.Current is
+        when Finished_Adjust =>
+            if Verbose then
+                Report.Comment ("assignment aborted after adjust");
+            end if;
+        when Finished_Final =>
+            if Verbose then
+                Report.Comment ("assignment aborted after finalize");
+            end if;
+        when Start_Adjust =>
+            Report.Failed ("assignment aborted in adjust");
+        when Start_Final =>
+            Report.Failed ("assignment aborted in finalize");
+        when Start_Init =>
+            Report.Failed ("assignment aborted in initialize");
+        when Finished_Init =>
+            Report.Failed ("assignment aborted after initialize");
+        when Unknown =>
+            Report.Failed ("assignment aborted in unknown state");
+        end case;
+
+
+        if Dest.Id /= 3 then
+            if Verbose then
+                Report.Comment ("assignment not performed");
+            end if;
+        end if;
+    end;
+
+
+     -- check dynamically allocated objects
+    State_Manager.Reset;
+    declare
+        type Pointer_Type is access Is_Controlled;
+        procedure Free is new Ada.Unchecked_Deallocation (
+              Is_Controlled, Pointer_Type);
+        Ptr : Pointer_Type;
+    begin
+      -- make sure initialize is done when object is allocated
+      Ptr := new Is_Controlled;
+      Check_State (Finished_Init, "init when item allocated");
+      -- now try aborting the finalize
+      State_Manager.Reset;
+      select
+             State_Manager.Wait_For_Change;
+      then abort
+             Free (Ptr);
+      end select;
+      Check_State (Finished_Final, "finalization in dealloc");
+    end;
+
+    Report.Result;
+ 
+end C980003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c99004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c99004a.ada
new file mode 100644
index 000000000..8774314d5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c99004a.ada
@@ -0,0 +1,166 @@
+-- C99004A.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 'TERMINATED AND 'CALLABLE CAN BE A
+--     FUNCTION CALL RETURNING AN OBJECT HAVING A TASK TYPE.
+
+--     NOTE: SEE TEST C38202A FOR CHECKS INVOLVING PREFIXES WHICH ARE
+--     ACCESS TYPES DENOTING TASK TYPES OR WHICH ARE FUNCTIONS
+--     RETURNING ACCESS TYPES DENOTING TASK TYPES.
+
+-- HISTORY:
+--     RJW 09/16/86 CREATED ORIGINAL TEST.
+--     DHH 10/15/87 CORRECTED HEADER COMMENTS.
+
+with Impdef;
+WITH REPORT; USE REPORT;
+PROCEDURE C99004A IS
+
+     TYPE ENUM IS (A, B, C, D);
+
+     EARRAY : ARRAY (ENUM) OF STRING (1 .. 17) :=
+                                        (A => "BEFORE ACTIVATION",
+                                         B => "DURING ACTIVATION",
+                                         C => "DURING EXECUTION ",
+                                         D => "AFTER TERMINATION" );
+
+     FUNCTION CHECK (S : STRING; CALL, B1, TERM, B2 : BOOLEAN;
+                     E : ENUM) RETURN BOOLEAN IS
+     BEGIN
+          IF CALL /= B1 THEN
+               FAILED ( "INCORRECT VALUE FOR " & S & "'CALLABLE " &
+                         EARRAY (E) & " OF TASK" );
+          END IF;
+
+          IF TERM /= B2 THEN
+               FAILED ( "INCORRECT VALUE FOR " & S & "'TERMINATED " &
+                         EARRAY (E) & " OF TASK" );
+          END IF;
+
+          RETURN IDENT_BOOL (TRUE);
+     END CHECK;
+
+
+BEGIN
+     TEST ( "C99004A", "CHECK THAT THE PREFIX OF 'TERMINATED AND " &
+                       "'CALLABLE CAN BE A FUNCTION CALL RETURNING " &
+                       "AN OBJECT HAVING A TASK TYPE" );
+
+     DECLARE
+
+          TASK TYPE TT IS
+               ENTRY E;
+          END TT;
+
+          PACKAGE PKG1 IS
+               T1 : TT;
+          END PKG1;
+
+          FUNCTION F RETURN TT IS
+          BEGIN
+               RETURN PKG1.T1;
+          END F;
+
+          PACKAGE PKG2 IS
+               A1 : BOOLEAN := CHECK ("F", F'CALLABLE, TRUE,
+                                      F'TERMINATED, FALSE, A);
+          END PKG2;
+
+          TASK MAIN_TASK IS
+               ENTRY E (INTEGER RANGE 1 .. 2);
+          END MAIN_TASK;
+
+          TASK BODY TT IS
+               B1 : BOOLEAN := CHECK ("F", F'CALLABLE, TRUE,
+                                      F'TERMINATED, FALSE, B);
+               C1 : BOOLEAN;
+          BEGIN
+               C1 := CHECK ("F", F'CALLABLE, TRUE,
+                            F'TERMINATED, FALSE, C);
+               MAIN_TASK.E (1);
+               MAIN_TASK.E (2);
+          END TT;
+
+          PACKAGE BODY PKG1 IS
+          BEGIN
+               NULL;
+          END;
+
+          TASK BODY MAIN_TASK IS
+               D1 : BOOLEAN;
+          BEGIN
+               ACCEPT E (1);
+               ABORT PKG1.T1;
+               DELAY 5.0 * Impdef.One_Long_Second;
+               D1 := CHECK ("F", F'CALLABLE, FALSE,
+                             F'TERMINATED, TRUE, D);
+          END MAIN_TASK;
+
+     BEGIN
+          NULL;
+     END;
+
+     DECLARE
+
+          TASK TYPE TT IS
+               ENTRY E;
+          END TT;
+
+          T2 : TT;
+
+          A2 : BOOLEAN := CHECK ("T2", T2'CALLABLE, TRUE,
+                                  T2'TERMINATED, FALSE, A);
+
+          TASK MAIN_TASK IS
+               ENTRY E (INTEGER RANGE 1 .. 2);
+          END MAIN_TASK;
+
+          TASK BODY TT IS
+               B2 : BOOLEAN := CHECK ("T2", T2'CALLABLE, TRUE,
+                                       T2'TERMINATED, FALSE, B);
+               C2 : BOOLEAN;
+          BEGIN
+               C2 := CHECK ("T2", T2'CALLABLE, TRUE,
+                             T2'TERMINATED, FALSE, C);
+               MAIN_TASK.E (1);
+               MAIN_TASK.E (2);
+          END TT;
+
+          TASK BODY MAIN_TASK IS
+               D2 : BOOLEAN;
+          BEGIN
+               ACCEPT E (1);
+               ABORT T2;
+               DELAY 5.0 * Impdef.One_Long_Second;
+               D2 := CHECK ("T2", T2'CALLABLE, FALSE,
+                             T2'TERMINATED, TRUE, D);
+          END MAIN_TASK;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C99004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c99005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c99005a.ada
new file mode 100644
index 000000000..f3bcbaa6e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c99005a.ada
@@ -0,0 +1,183 @@
+-- C99005A.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 ATTRIBUTE 'COUNT RETURNS THE CORRECT VALUE.
+
+-- HISTORY:
+--     DHH 03/24/88 CREATED ORIGINAL TEST.
+
+with Impdef;
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE C99005A IS
+
+BEGIN
+
+     TEST("C99005A", "CHECK THAT THE ATTRIBUTE 'COUNT RETURNS THE " &
+                     "CORRECT VALUE");
+
+     DECLARE
+          TASK A IS
+          END A;
+
+          TASK B IS
+          END B;
+
+          TASK C IS
+          END C;
+
+          TASK D IS
+          END D;
+
+          TASK E IS
+          END E;
+
+          TASK F IS
+          END F;
+
+          TASK G IS
+          END G;
+
+          TASK H IS
+          END H;
+
+          TASK I IS
+          END I;
+
+          TASK J IS
+          END J;
+
+          TASK T IS
+               ENTRY WAIT;
+          END T;
+
+          TASK CHOICE IS
+               ENTRY RETURN_CALL;
+               ENTRY E2;
+               ENTRY E1;
+          END CHOICE;
+
+          TASK BODY A IS
+          BEGIN
+               CHOICE.E1;
+          END A;
+
+          TASK BODY B IS
+          BEGIN
+               CHOICE.E1;
+          END B;
+
+          TASK BODY C IS
+          BEGIN
+               CHOICE.E1;
+          END C;
+
+          TASK BODY D IS
+          BEGIN
+               CHOICE.E1;
+          END D;
+
+          TASK BODY E IS
+          BEGIN
+               CHOICE.E1;
+          END E;
+
+          TASK BODY F IS
+          BEGIN
+               CHOICE.E2;
+          END F;
+
+          TASK BODY G IS
+          BEGIN
+               CHOICE.E2;
+          END G;
+
+          TASK BODY H IS
+          BEGIN
+               CHOICE.E2;
+          END H;
+
+          TASK BODY I IS
+          BEGIN
+               CHOICE.E2;
+          END I;
+
+          TASK BODY J IS
+          BEGIN
+               CHOICE.E2;
+          END J;
+
+          TASK BODY T IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT WAIT DO
+                              DELAY 1.0 * Impdef.One_Second;
+                         END WAIT;
+                         CHOICE.RETURN_CALL;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END T;
+
+          TASK BODY CHOICE IS
+          BEGIN
+               WHILE E1'COUNT + E2'COUNT < 10 LOOP
+                    T.WAIT;
+                    ACCEPT RETURN_CALL;
+               END LOOP;
+
+               FOR I IN REVERSE 1 ..10 LOOP
+                    SELECT
+                         ACCEPT E2 DO
+                              IF (E2'COUNT + E1'COUNT + 1) /= I THEN
+                                   FAILED("'COUNT NOT RETURNING " &
+                                          "CORRECT VALUE FOR LOOP" &
+                                           INTEGER'IMAGE(I) & "VALUE " &
+                                           INTEGER'IMAGE((E2'COUNT
+                                           + E1'COUNT + 1)));
+                              END IF;
+                         END E2;
+                    OR
+                         ACCEPT E1 DO
+                              IF (E2'COUNT + E1'COUNT + 1) /= I THEN
+                                   FAILED("'COUNT NOT RETURNING " &
+                                          "CORRECT VALUE FOR LOOP" &
+                                           INTEGER'IMAGE(I) & "VALUE " &
+                                           INTEGER'IMAGE((E2'COUNT
+                                           + E1'COUNT + 1)));
+                              END IF;
+                         END E1;
+                    END SELECT;
+               END LOOP;
+           END CHOICE;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END C99005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a003a.ada
new file mode 100644
index 000000000..e8d7706cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a003a.ada
@@ -0,0 +1,105 @@
+-- C9A003A.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 ABORTING A TERMINATED TASK DOES NOT CAUSE EXCEPTIONS.
+
+
+-- RM 5/21/82
+-- SPS 11/21/82
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X
+
+with Impdef;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE  C9A003A  IS
+
+     -- THE TASK WILL HAVE HIGHER PRIORITY ( PRIORITY'LAST )
+
+BEGIN
+
+
+     -------------------------------------------------------------------
+
+
+     TEST ("C9A003A", "CHECK THAT  ABORTING A TERMINATED TASK" &
+                      "  DOES NOT CAUSE EXCEPTIONS"   );
+
+  
+     DECLARE
+
+
+          TASK TYPE  T_TYPE  IS
+
+
+               ENTRY  E ;
+
+          END  T_TYPE ;
+
+
+          T_OBJECT1 : T_TYPE ;
+
+
+          TASK BODY  T_TYPE  IS
+               BUSY : BOOLEAN := FALSE ;
+          BEGIN
+
+               NULL;
+
+          END  T_TYPE ;
+
+
+     BEGIN
+
+
+          IF NOT  T_OBJECT1'TERMINATED  THEN
+               DELAY  20.0 * Impdef.One_Second;
+          END IF;
+
+          IF NOT  T_OBJECT1'TERMINATED  THEN
+               COMMENT( "TASK NOT YET TERMINATED (AFTER 20 S.)" );
+          END IF;
+
+
+          BEGIN
+               ABORT T_OBJECT1 ;
+          EXCEPTION
+
+               WHEN  OTHERS  =>
+                    FAILED(  "EXCEPTION RAISED (WHEN ABORTING A" &
+                             "  TERMINATED TASK)"  );
+
+          END ;
+
+
+     END ;
+
+
+     -------------------------------------------------------------------
+
+
+
+     RESULT;
+
+
+END  C9A003A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a004a.ada
new file mode 100644
index 000000000..124724379
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a004a.ada
@@ -0,0 +1,108 @@
+-- C9A004A.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 TASK IS ABORTED BEFORE BEING ACTIVATED, THE TASK IS
+--     TERMINATED.
+
+
+-- RM 5/21/82
+-- SPS 11/21/82
+-- JBG 6/3/85
+-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE  C9A004A  IS
+
+BEGIN
+
+
+     -------------------------------------------------------------------
+
+
+     TEST ("C9A004A", "CHECK THAT IF A TASK IS ABORTED"  &
+                      " BEFORE BEING ACTIVATED,"         &
+                      "  THE TASK IS TERMINATED"         );
+
+  
+     DECLARE
+
+
+          TASK TYPE  T_TYPE  IS
+
+
+               ENTRY  E ;
+
+          END  T_TYPE ;
+
+
+          T_OBJECT1 : T_TYPE ;
+
+
+          TASK BODY  T_TYPE  IS
+               BUSY : BOOLEAN := FALSE ;
+          BEGIN
+
+               NULL;
+
+          END  T_TYPE ;
+
+
+          PACKAGE  P  IS
+               X : INTEGER := 0 ;
+          END  P ;
+
+
+          PACKAGE BODY  P  IS
+          BEGIN
+
+               IF      T_OBJECT1'TERMINATED  OR
+                   NOT T_OBJECT1'CALLABLE
+               THEN
+                    FAILED( "WRONG VALUES FOR ATTRIBUTES" );
+               END IF;
+
+               ABORT  T_OBJECT1 ;  -- ELABORATED BUT NOT YET ACTIVATED.
+
+          END  P ;
+
+
+     BEGIN
+
+
+          IF NOT  T_OBJECT1'TERMINATED  THEN
+               FAILED(  "ABORTED (BEFORE ACTIVATION) TASK"  &
+                        "  NOT TERMINATED"  );
+          END IF;
+
+     EXCEPTION
+
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED");
+
+     END;
+
+     RESULT;
+
+END C9A004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a007a.ada
new file mode 100644
index 000000000..9339930a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a007a.ada
@@ -0,0 +1,293 @@
+-- C9A007A.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 TASK MAY ABORT A TASK IT DEPENDS ON.
+
+
+-- RM 5/26/82
+-- RM 7/02/82
+-- SPS 11/21/82
+-- JBG 2/27/84
+-- JBG 3/8/84
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+-- EDS 08/04/98 ENSURE THAT ABORTED TASKS HAVE TIME TO EFFECT THEIR ABORTIONS.
+
+WITH IMPDEF;
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE  C9A007A  IS
+
+      TASK_NOT_ABORTED : BOOLEAN := FALSE; 
+      TEST_VALID       : BOOLEAN := TRUE ; 
+
+BEGIN
+
+
+     -------------------------------------------------------------------
+
+
+     TEST ( "C9A007A" , "CHECK THAT A TASK MAY ABORT A TASK" &
+                        " IT DEPENDS ON"                     );
+
+  
+     DECLARE
+
+
+          TASK  REGISTER  IS
+
+
+               ENTRY  BIRTHS_AND_DEATHS; 
+
+               ENTRY  SYNC1; 
+               ENTRY  SYNC2; 
+
+
+          END  REGISTER; 
+
+
+          TASK BODY  REGISTER  IS
+
+
+               TASK TYPE  SECONDARY  IS
+
+
+                    ENTRY  WAIT_INDEFINITELY; 
+
+               END  SECONDARY; 
+
+
+               TASK TYPE  T_TYPE1  IS
+
+
+                    ENTRY  E; 
+
+               END  T_TYPE1; 
+
+
+               TASK TYPE  T_TYPE2  IS
+
+
+                    ENTRY  E; 
+
+               END  T_TYPE2; 
+
+
+               T_OBJECT1 : T_TYPE1; 
+               T_OBJECT2 : T_TYPE2; 
+
+
+               TASK BODY  SECONDARY  IS
+               BEGIN
+                    SYNC1; 
+                    ABORT  T_OBJECT1; 
+                    DELAY 0.0; 
+                    TASK_NOT_ABORTED  :=  TRUE; 
+               END  SECONDARY; 
+
+
+               TASK BODY  T_TYPE1  IS
+
+                    TYPE  ACCESS_TO_TASK  IS  ACCESS SECONDARY; 
+  
+               BEGIN
+
+
+                    DECLARE
+                         DEPENDENT_BY_ACCESS   :  ACCESS_TO_TASK  :=
+                                                  NEW  SECONDARY ; 
+                    BEGIN
+                         NULL;
+                    END; 
+
+
+                    BIRTHS_AND_DEATHS; 
+                                     -- DURING THIS SUSPENSION
+                                     --     MOST OF THE TASKS
+                                     --     ARE ABORTED   (FIRST
+                                     --     TASK #1    -- T_OBJECT1 --
+                                     --     THEN  #2 ).
+
+
+                    TASK_NOT_ABORTED := TRUE; 
+
+
+               END  T_TYPE1; 
+
+
+               TASK BODY  T_TYPE2  IS
+
+                    TASK  INNER_TASK  IS
+
+
+                         ENTRY  WAIT_INDEFINITELY; 
+
+                    END  INNER_TASK; 
+
+                    TASK BODY  INNER_TASK  IS
+                    BEGIN
+                         SYNC2; 
+                         ABORT  T_OBJECT2; 
+                         DELAY 0.0; 
+                         TASK_NOT_ABORTED  :=  TRUE; 
+                    END  INNER_TASK; 
+
+               BEGIN
+
+
+                    BIRTHS_AND_DEATHS; 
+                                     -- DURING THIS SUSPENSION
+                                     --     MOST OF THE TASKS
+                                     --     ARE ABORTED   (FIRST
+                                     --     TASK #1     -- T_OBJECT1 --
+                                     --     THEN  #2 ).
+
+
+                    TASK_NOT_ABORTED := TRUE; 
+
+
+               END  T_TYPE2; 
+
+
+          BEGIN
+
+               DECLARE
+                    OLD_COUNT : INTEGER := 0; 
+               BEGIN
+
+
+                    FOR  I  IN  1..5  LOOP
+                         EXIT WHEN  BIRTHS_AND_DEATHS'COUNT = 2; 
+                         DELAY 10.0 * Impdef.One_Second;
+                    END LOOP;
+
+                    OLD_COUNT := BIRTHS_AND_DEATHS'COUNT; 
+
+                    IF  OLD_COUNT = 2  THEN
+
+                         ACCEPT  SYNC1;   -- ALLOWING  ABORT#1
+
+                         DELAY IMPDEF.CLEAR_READY_QUEUE;
+
+                         -- CHECK THAT  #1  WAS ABORTED  -  3 WAYS:
+
+                         BEGIN
+                              T_OBJECT1.E; 
+                              FAILED( "T_OBJECT1.E  DID NOT RAISE" &
+                                                   "  TASKING_ERROR" );
+                         EXCEPTION
+
+                              WHEN TASKING_ERROR  =>
+                                   NULL;
+
+                              WHEN OTHERS  =>
+                                   FAILED("OTHER EXCEPTION RAISED - 1");
+
+                         END; 
+
+                         IF T_OBJECT1'CALLABLE  THEN
+                              FAILED( "T_OBJECT1'CALLABLE = TRUE" );
+                         END IF;
+
+                         IF  OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
+                         THEN
+                              FAILED( "TASK#1 NOT REMOVED FROM QUEUE" );
+                         END IF;
+
+
+                         OLD_COUNT := BIRTHS_AND_DEATHS'COUNT; 
+
+
+                         ACCEPT  SYNC2;   -- ALLOWING  ABORT#2
+                         
+                         DELAY IMPDEF.CLEAR_READY_QUEUE;
+
+                         -- CHECK THAT  #2  WAS ABORTED  -  3 WAYS:
+
+                         BEGIN
+                              T_OBJECT2.E; 
+                              FAILED( "T_OBJECT2.E  DID NOT RAISE" &
+                                                   "  TASKING_ERROR" );
+                         EXCEPTION
+
+                              WHEN TASKING_ERROR  =>
+                                   NULL;
+
+                              WHEN OTHERS  =>
+                                   FAILED("OTHER EXCEPTION RAISED - 2");
+
+                         END; 
+
+                         IF T_OBJECT2'CALLABLE  THEN
+                              FAILED( "T_OBJECT2'CALLABLE = TRUE" );
+                         END IF;
+
+                         IF  OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
+                         THEN
+                              FAILED( "TASK#2 NOT REMOVED FROM QUEUE" );
+                         END IF;
+
+
+                         IF  BIRTHS_AND_DEATHS'COUNT /= 0  THEN
+                              FAILED( "SOME TASKS STILL QUEUED" );
+                         END IF;
+  
+
+                    ELSE
+
+                         COMMENT( "LINEUP NOT COMPLETE (AFTER 50 S.)" );
+                         TEST_VALID  :=  FALSE; 
+
+                    END IF;
+
+
+               END; 
+
+
+               WHILE  BIRTHS_AND_DEATHS'COUNT > 0  LOOP
+                    ACCEPT  BIRTHS_AND_DEATHS; 
+               END LOOP;
+
+
+          END  REGISTER; 
+
+
+     BEGIN
+
+          NULL;
+
+     END; 
+
+
+     -------------------------------------------------------------------
+
+
+     IF  TEST_VALID  AND  TASK_NOT_ABORTED  THEN
+          FAILED( "SOME TASKS NOT ABORTED" );
+     END IF;
+
+
+     RESULT;
+
+
+END  C9A007A; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009a.ada
new file mode 100644
index 000000000..ba3b0845d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009a.ada
@@ -0,0 +1,117 @@
+-- C9A009A.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.
+--*
+-- TEST ABORT DURING RENDEZVOUS
+
+-- CALLING TASK IN RENDEVOUS IS NAMED IN ABORT STATEMENT.
+
+-- JEAN-PIERRE ROSEN 09 MARCH 1984
+-- JBG 6/1/84
+-- JWC 6/28/85   RENAMED FROM C9A009D-B.ADA
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE C9A009A IS
+
+BEGIN
+
+     TEST("C9A009A", "CALLING TASK IS ABORTED DIRECTLY");
+
+     DECLARE
+     -- T1 CALLS T2, WHICH ABORTS T1 WHILE IN RENDEVOUS
+
+          T2_CONTINUED : BOOLEAN := FALSE;
+
+          TASK CONTINUED IS
+               ENTRY GET (T2_CONTINUED : OUT BOOLEAN);
+               ENTRY PUT (T2_CONTINUED : IN  BOOLEAN);
+          END CONTINUED;
+
+          TASK BODY CONTINUED IS
+               CONTINUED : BOOLEAN := FALSE;
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT GET (T2_CONTINUED : OUT BOOLEAN) DO
+                              T2_CONTINUED := CONTINUED;
+                         END GET;
+                    OR
+                         ACCEPT PUT (T2_CONTINUED : IN BOOLEAN) DO
+                              CONTINUED := T2_CONTINUED;
+                         END PUT;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END CONTINUED;
+
+     BEGIN     -- THIS BLOCK WILL MAKE SURE T2 IS TERMINATED, AND SO,
+               -- T2_CONTINUED IS ASSIGNED A VALUE IF T2 CONTINUES
+               -- EXECUTION CORRECTLY.
+
+          DECLARE
+
+               TASK T1;
+
+               TASK T2 IS
+                    ENTRY E1;
+               END T2;
+
+               TASK BODY T1 IS
+               BEGIN
+                    T2.E1;
+                    FAILED ("T1 NOT ABORTED");
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         FAILED ("TASKING_ERROR RAISED IN T1");
+                    WHEN OTHERS =>
+                         FAILED ("OTHER EXCEPTION RAISED - T1");
+               END T1;
+
+               TASK BODY T2 IS
+               BEGIN
+                    ACCEPT E1 DO
+                         ABORT T1;
+                         ABORT T1;
+                         ABORT T1; -- WHY NOT?
+                         IF T1'TERMINATED THEN
+                              FAILED ("T1 PREMATURELY TERMINATED");
+                         END IF;
+                    END E1;
+                    CONTINUED.PUT (T2_CONTINUED => TRUE);
+               END T2;
+          BEGIN
+               NULL;
+          END;
+     -- T2 NOW TERMINATED
+          CONTINUED.GET (T2_CONTINUED);
+          IF NOT T2_CONTINUED THEN
+               FAILED ("WHEN CALLER WAS ABORTED IN RENDEVOUS, CALLED " &
+                       "TASK DID NOT CONTINUE");
+          END IF;
+     END;
+
+     RESULT;
+
+END C9A009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009c.ada
new file mode 100644
index 000000000..89b7390b1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009c.ada
@@ -0,0 +1,95 @@
+-- C9A009C.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.
+--*
+-- TEST ABORT DURING RENDEZVOUS
+
+-- THE CALLING TASK IN THE RENDEVOUS IS DEPENDENT ON THE ABORTED TASK,
+-- SO THE DEPENDENT TASK IS INDIRECTLY ABORTED WHILE IN A RENDEVOUS;
+-- NEITHER THE CALLING TASK NOR ITS MASTER CAN BE TERMINATED WHILE THE
+-- RENDEVOUS CONTINUES.
+
+-- JEAN-PIERRE ROSEN 09 MARCH 1984
+-- JBG 6/1/84
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE C9A009C IS
+
+BEGIN 
+
+     TEST("C9A009C", "DEPENDENT TASK IN RENDEVOUS WHEN MASTER IS " &
+                     "ABORTED");
+
+     DECLARE
+     -- T2 CONTAINS DEPENDENT TASK T3 WHICH CALLS T1.
+     -- T1 ABORTS T2 WHILE IN RENDEVOUS WITH T3.
+
+          TASK T1 IS
+               ENTRY E1;
+          END T1;
+
+          TASK BODY T1 IS
+      
+               TASK T2;
+     
+               TASK BODY T2 IS
+                    TASK T3;
+                    TASK BODY T3 IS
+                    BEGIN
+                         T1.E1;
+                         FAILED ("T3 NOT ABORTED");
+                    EXCEPTION
+                         WHEN TASKING_ERROR =>
+                              FAILED ("TASKING_ERROR IN T3");
+                         WHEN OTHERS =>
+                              FAILED ("OTHER EXCEPTION IN T3");
+                    END;
+               BEGIN     -- T3 ACTIVATED NOW
+                    NULL;
+               END T2;
+     
+          BEGIN     -- T1
+               ACCEPT E1 DO
+                    ABORT T2;
+                    ABORT T2;
+                    ABORT T2; -- WHY NOT?
+                    IF T2'TERMINATED THEN
+                         FAILED ("T2 TERMINATED PREMATURELY");
+                    END IF;
+               END E1;
+          EXCEPTION
+               WHEN TASKING_ERROR =>
+                    FAILED ("TASKING_ERROR IN T1 BECAUSE CALLING TASK "&
+                            "WAS ABORTED");
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION - T1");
+          END T1;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+
+END C9A009C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009f.ada
new file mode 100644
index 000000000..e100a9f0c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009f.ada
@@ -0,0 +1,88 @@
+-- C9A009F.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 TASK ABORTED DURING AN ENTRY CALL IS NOT TERMINATED
+-- BEFORE THE END OF THE RENDEZVOUS.
+
+-- JEAN-PIERRE ROSEN 16-MAR-1984
+-- JBG 6/1/84
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH REPORT,SYSTEM; 
+USE REPORT,SYSTEM;
+PROCEDURE C9A009F IS
+
+
+     TASK BLOCKING IS
+          ENTRY START;
+          ENTRY STOP;
+          ENTRY RESTART;
+          ENTRY NO_CALL;
+     END BLOCKING;
+
+     TASK BODY BLOCKING IS
+     BEGIN
+          SELECT
+               ACCEPT STOP DO
+                    ACCEPT START;
+                    ACCEPT RESTART;
+               END;
+          OR TERMINATE;
+          END SELECT;
+     END;
+
+BEGIN
+
+     TEST("C9A009F", "ABORTED TASK NOT TERMINATED BEFORE END OF " &
+                     "RENDEVOUS");
+
+     DECLARE         -- T1 ABORTED WHILE IN RENDEVOUS WITH BLOCKING.
+
+          TASK T1 IS
+          END T1;                              
+          TASK BODY T1 IS
+          BEGIN
+               BLOCKING.STOP;
+               FAILED ("T1 NOT ABORTED");
+          END;
+     
+     BEGIN
+          BLOCKING.START;          -- ALLOWS T1 TO ENTER RENDEVOUS
+
+          ABORT T1;
+
+          IF T1'CALLABLE THEN
+               FAILED("T1 STILL CALLABLE - 1");
+          END IF;
+
+          IF T1'TERMINATED THEN    -- T1 STILL IN RENDEVOUS
+               FAILED("T1 PREMATURELY TERMINATED - 1");
+          END IF;
+
+          BLOCKING.RESTART;
+     END;
+
+     RESULT;
+
+END C9A009F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009g.ada
new file mode 100644
index 000000000..7dea8a4ba
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009g.ada
@@ -0,0 +1,95 @@
+-- C9A009G.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 MASTER ABORTED WITH SUBTASKS IN AN ENTRY CALL BECOMES
+-- COMPLETED, BUT NOT TERMINATED, BEFORE THE END OF THE RENDEZVOUS.
+
+-- JEAN-PIERRE ROSEN 16-MAR-1984
+-- JBG 6/1/84
+-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
+
+WITH REPORT,SYSTEM; 
+USE REPORT,SYSTEM;
+PROCEDURE C9A009G IS
+
+
+     TASK BLOCKING IS
+          ENTRY START;
+          ENTRY STOP;
+          ENTRY RESTART;
+          ENTRY NO_CALL;
+     END BLOCKING;
+
+     TASK BODY BLOCKING IS
+     BEGIN
+          SELECT
+               ACCEPT STOP DO
+                    ACCEPT START;
+                    ACCEPT RESTART;
+               END;
+          OR TERMINATE;
+          END SELECT;
+     END;
+
+BEGIN
+
+     TEST("C9A009G", "MASTER COMPLETED BUT NOT TERMINATED");
+
+     DECLARE         -- T1 ABORTED WHILE DEPENDENT TASK IN RENDEVOUS 9C?
+
+          TASK T1 IS
+               ENTRY LOCK;
+          END T1;                              
+     
+          TASK BODY T1 IS
+               TASK T2;
+     
+               TASK BODY T2 IS
+               BEGIN
+                    BLOCKING.STOP;
+                    FAILED ("T2 NOT ABORTED");
+               END;
+          BEGIN
+               BLOCKING.NO_CALL;          -- WILL DEADLOCK UNTIL ABORT
+          END T1;
+     
+     BEGIN
+          BLOCKING.START;
+          ABORT T1;
+
+          IF T1'CALLABLE THEN
+               FAILED("T1 STILL CALLABLE - 2");
+          END IF;
+
+          IF T1'TERMINATED THEN    -- T1'S DEPENDENT TASK, T2, STILL IN
+                                   -- RENDEVOUS 
+               FAILED("T1 PREMATURELY TERMINATED - 2");
+          END IF;
+
+          BLOCKING.RESTART;
+     END;
+
+     RESULT;
+
+END C9A009G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009h.ada
new file mode 100644
index 000000000..914fce187
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a009h.ada
@@ -0,0 +1,77 @@
+-- C9A009H.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 TASK ABORTED DURING A RENDEVOUS IS NEITHER CALLABLE NOR
+-- TERMINATED BEFORE THE END OF THE RENDEVOUS.
+
+-- J.P ROSEN, ADA PROJECT, NYU
+-- JBG 6/1/84
+
+WITH REPORT; USE REPORT;
+PROCEDURE C9A009H IS
+BEGIN
+     TEST ("C9A009H", "TASK ABORTED IN RENDEVOUS IS NOT CALLABLE OR " &
+                      "TERMINATED");
+
+     DECLARE
+
+          TASK T1 IS
+               ENTRY E1;
+          END T1;
+
+          TASK T2 IS
+          END T2;
+
+          TASK BODY T2 IS
+          BEGIN
+               T1.E1;
+               FAILED ("T2 NOT ABORTED");
+          EXCEPTION
+               WHEN TASKING_ERROR =>
+                    FAILED ("TASKING_ERROR RAISED IN ABORTED TASK");
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED");
+          END T2;
+
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT E1 DO
+                    ABORT T2;
+                    IF T2'CALLABLE THEN
+                         FAILED ("T2 STILL CALLABLE");
+                    END IF;
+
+                    IF T2'TERMINATED THEN
+                         FAILED ("T2 TERMINATED");
+                    END IF;
+               END E1;
+          END T1;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+
+END C9A009H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a010a.ada
new file mode 100644
index 000000000..553b72d80
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a010a.ada
@@ -0,0 +1,89 @@
+-- C9A010A.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.
+--*
+-- TEST ABORT DURING RENDEZVOUS
+
+-- ABORTING AN ABNORMAL (NOT YET TERMINATED) TASK.
+
+-- JEAN-PIERRE ROSEN 09 MARCH 1984
+-- JBG 6/1/84
+-- JWC 6/28/85   RENAMED FROM C9A009E-B.ADA
+-- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE C9A010A IS
+
+BEGIN
+
+     TEST("C9A010A", "ABORTING AN ABNORMAL TASK");
+
+     DECLARE
+     -- T1 CALLS T2.  WHILE IN RENDEVOUS, T2 ABORTS T1 AND WAITS FOR A
+     -- CALL FROM THE MAIN PROGRAM.  WHEN THE CALL IS ACCEPTED, THE MAIN
+     -- PROGRAM AGAIN ABORTS T1, WHICH IS NOW ABNORMAL, SINCE T1 HAS NOT
+     -- YET COMPLETED ITS RENDEVOUS WITH T2.
+
+          TASK T1 IS
+          END T1;
+
+          TASK T2 IS
+               ENTRY E1;
+               ENTRY E2;
+          END T2;
+
+          TASK BODY T1 IS
+          BEGIN
+               T2.E1;
+               FAILED("T1 NOT ABORTED");
+          EXCEPTION
+               WHEN TASKING_ERROR =>
+                    FAILED ("TASKING_ERROR IN T1");
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION IN T1");
+          END T1;
+
+          TASK BODY T2 IS
+          BEGIN
+               ACCEPT E1 DO
+                    ABORT  T1;
+                    ACCEPT E2;     -- NOTE CALLER REMAINS IN RENDEVOUS
+                    ACCEPT E2;     -- UNTIL TWO ENTRY CALLS ACCEPTED
+               END E1;
+          END T2;
+     BEGIN
+          T2.E2;    -- ONLY ACCEPTED AFTER T1 HAS BEEN ABORTED.
+          ABORT T1; -- T1 IS ABNORMAL BECAUSE IT IS STILL IN RENDEVOUS.
+          IF T1'CALLABLE THEN
+               FAILED ("T1 CALLABLE AFTER BEING ABORTED");
+          END IF;
+          IF T1'TERMINATED THEN
+               FAILED ("T1 TERMINATED ALTHOUGH IN RENDEVOUS");
+          END IF;
+          T2.E2; -- T1'S RENDEVOUS CAN NOW COMPLETE; T1 CAN TERMINATE.
+     END;
+
+     RESULT;
+
+END C9A010A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a011a.ada
new file mode 100644
index 000000000..1d415b07b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a011a.ada
@@ -0,0 +1,71 @@
+-- C9A011A.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 CALLED TASK IS ABORTED WHILE IN RENDEZVOUS, THEN
+--     "TASKING_ERROR" IS RAISED IN THE CALLING TASK.
+
+-- HISTORY:
+--     DHH 03/28/88 CREATED ORIGINAL TEST.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE C9A011A IS
+
+     TASK TYPE CHOICE IS
+          ENTRY E1;
+     END CHOICE;
+
+     T : CHOICE;
+
+     TASK BODY CHOICE IS
+          X : INTEGER;
+     BEGIN
+          ACCEPT E1 DO
+               X := IDENT_INT(3);
+               IF EQUAL(X,X) THEN
+                    ABORT CHOICE;
+               END IF;
+          END E1;
+     END CHOICE;
+
+BEGIN
+
+     TEST("C9A011A", "CHECK THAT IF A CALLED TASK IS ABORTED WHILE " &
+                     "IN RENDEZVOUS, THEN ""TASKING_ERROR"" IS " &
+                     "RAISED IN THE CALLING TASK");
+
+     T.E1;
+     FAILED("EXCEPTION NOT RAISED ON ABORT");
+
+     RESULT;
+
+EXCEPTION
+     WHEN TASKING_ERROR =>
+          RESULT;
+
+     WHEN OTHERS =>
+          FAILED("UNEXPECTED EXCEPTION RAISED ON ABORT");
+          RESULT;
+END C9A011A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a011b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a011b.ada
new file mode 100644
index 000000000..fe1ba1649
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c9a011b.ada
@@ -0,0 +1,102 @@
+-- C9A011B.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 "TASKING_ERROR" IS RAISED BY A TIMED ENTRY CALL IF
+--     THE CALLED TASK IS ABORTED BEFORE THE DELAY EXPIRES BUT NOT
+--     WHEN THE CALL IS FIRST EXECUTED.
+
+-- HISTORY:
+--     DHH 06/14/88 CREATED ORIGINAL TEST.
+
+with Impdef;
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE C9A011B IS
+
+     TASK TIMED_ENTRY IS
+          ENTRY WAIT_AROUND;
+     END TIMED_ENTRY;
+
+     TASK OWNER IS
+          ENTRY START;
+          ENTRY SELF_ABORT;
+     END OWNER;
+
+     TASK BODY TIMED_ENTRY IS
+     BEGIN
+          SELECT
+               OWNER.SELF_ABORT;
+          OR
+               DELAY 60.0 * Impdef.One_Second;
+          END SELECT;
+          FAILED("NO EXCEPTION RAISED");
+
+          ACCEPT WAIT_AROUND;
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               ACCEPT WAIT_AROUND;
+          WHEN OTHERS =>
+               FAILED("WRONG EXCEPTION RAISED");
+               ACCEPT WAIT_AROUND;
+     END TIMED_ENTRY;
+
+     TASK BODY OWNER IS
+     BEGIN
+          ACCEPT START DO
+               WHILE SELF_ABORT'COUNT = 0 LOOP
+                    DELAY 1.0 * Impdef.One_Second;
+               END LOOP;
+          END START;
+
+          ABORT OWNER;
+
+          ACCEPT SELF_ABORT;
+
+     END OWNER;
+
+BEGIN
+
+     TEST("C9A011B", "CHECK THAT ""TASKING_ERROR"" IS RAISED BY A " &
+                     "TIMED ENTRY CALL IF THE CALLED TASK IS " &
+                     "ABORTED BEFORE THE DELAY EXPIRES BUT NOT " &
+                     "WHEN THE CALL IS FIRST EXECUTED");
+
+     OWNER.START;
+     DELAY 5.0 * Impdef.One_Second;
+
+     IF TIMED_ENTRY'CALLABLE THEN
+          TIMED_ENTRY.WAIT_AROUND;
+     ELSE
+          FAILED("TASK ABORTED WHEN TASKING ERROR IS RAISED");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED("EXCEPTION RAISED OUTSIDE OF TASK");
+          RESULT;
+
+END C9A011B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1003a.ada
new file mode 100644
index 000000000..b3476b42f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1003a.ada
@@ -0,0 +1,73 @@
+-- CA1003A.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 MORE THAN ONE COMPLETELY INDEPENDENT COMPILATION
+-- UNIT CAN BE SUBMITTED IN A SINGLE FILE.
+
+-- JRK 5/13/81
+-- JBG 8/25/83
+
+PROCEDURE CA1003A_P (I : IN OUT INTEGER) IS
+BEGIN
+     I := I + 1;
+END CA1003A_P;
+
+
+PACKAGE CA1003A_PKG IS
+     I : INTEGER := 0;
+END CA1003A_PKG;
+
+
+FUNCTION CA1003A_F (I : INTEGER) RETURN INTEGER IS
+BEGIN
+     RETURN -I;
+END CA1003A_F;
+
+
+WITH REPORT, CA1003A_P, CA1003A_PKG, CA1003A_F;
+USE REPORT;
+
+PROCEDURE CA1003A IS
+
+     I : INTEGER := IDENT_INT (0);
+
+BEGIN
+     TEST ("CA1003A", "INDEPENDENT UNITS IN A SINGLE FILE");
+
+     CA1003A_P (I);
+     IF I /= 1 THEN
+          FAILED ("INDEPENDENT PROCEDURE NOT INVOKED");
+     END IF;
+
+     CA1003A_PKG.I := CA1003A_PKG.I + IDENT_INT(10);
+     IF CA1003A_PKG.I /= 10 THEN
+          FAILED ("INDEPENDENT PACKAGE VARIABLE ACCESSED INCORRECTLY");
+     END IF;
+
+     IF CA1003A_F(IDENT_INT(5)) /= -5 THEN
+          FAILED ("INDEPENDENT FUNCTION NOT INVOKED");
+     END IF;
+
+     RESULT;
+END CA1003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1004a.ada
new file mode 100644
index 000000000..def868edf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1004a.ada
@@ -0,0 +1,77 @@
+-- CA1004A.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 PACKAGE DECLARATION AND BODY CAN BE
+-- SUBMITTED TOGETHER FOR COMPILATION.
+
+-- JRK 5/12/81
+
+
+PACKAGE CA1004A_PKG IS
+
+     I : INTEGER := 0;
+
+     PROCEDURE P (I : IN OUT INTEGER);
+
+END CA1004A_PKG;
+
+
+PACKAGE BODY CA1004A_PKG IS
+
+     PROCEDURE P (I : IN OUT INTEGER) IS
+     BEGIN
+          I := I + 1;
+     END P;
+
+BEGIN
+
+     I := 10;
+
+END CA1004A_PKG;
+
+
+WITH REPORT, CA1004A_PKG;
+USE REPORT;
+
+PROCEDURE CA1004A IS
+
+     I : INTEGER := IDENT_INT (0);
+
+BEGIN
+     TEST ("CA1004A", "A PACKAGE DECLARATION AND BODY SUBMITTED " &
+           "TOGETHER");
+
+     CA1004A_PKG.I := CA1004A_PKG.I + IDENT_INT(5);
+     IF CA1004A_PKG.I /= 15 THEN
+          FAILED ("PACKAGED VARIABLE NOT ACCESSIBLE OR " &
+                  "PACKAGE BODY NOT EXECUTED");
+     END IF;
+
+     CA1004A_PKG.P (I);
+     IF I /= 1 THEN
+          FAILED ("PACKAGED PROCEDURE NOT EXECUTED");
+     END IF;
+
+     RESULT;
+END CA1004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1005a.ada
new file mode 100644
index 000000000..9f9e2a283
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1005a.ada
@@ -0,0 +1,70 @@
+-- CA1005A.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 SUBPROGRAM DECLARATION AND BODY CAN BE
+-- SUBMITTED TOGETHER FOR COMPILATION.
+
+-- JRK 5/14/81
+
+
+FUNCTION CA1005A_F (I : INTEGER) RETURN INTEGER;
+
+
+FUNCTION CA1005A_F (I : INTEGER) RETURN INTEGER IS
+BEGIN
+     RETURN I + 1;
+END CA1005A_F;
+
+
+PROCEDURE CA1005A_P (I : IN OUT INTEGER);
+
+
+PROCEDURE CA1005A_P (I : IN OUT INTEGER) IS
+BEGIN
+     I := -I;
+END CA1005A_P;
+
+
+WITH REPORT, CA1005A_F, CA1005A_P;
+USE REPORT;
+
+PROCEDURE CA1005A IS
+
+     I : INTEGER := IDENT_INT (7);
+
+BEGIN
+     TEST ("CA1005A", "SUBPROGRAM DECLARATIONS AND BODIES " &
+           "SUBMITTED TOGETHER");
+
+     IF CA1005A_F (IDENT_INT(2)) /= 3 THEN
+          FAILED ("FUNCTION NOT EXECUTED");
+     END IF;
+
+     CA1005A_P (I);
+     IF I /= -7 THEN
+          FAILED ("PROCEDURE NOT EXECUTED");
+     END IF;
+
+     RESULT;
+END CA1005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1006a.ada
new file mode 100644
index 000000000..7b3527f58
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1006a.ada
@@ -0,0 +1,106 @@
+-- CA1006A.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 LIBRARY UNIT AND ITS SUBUNITS CAN BE
+-- SUBMITTED TOGETHER FOR COMPILATION.
+
+-- JRK 5/14/81
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CA1006A IS
+
+     I : INTEGER := IDENT_INT (0);
+
+     PACKAGE CALL_TEST IS
+     END CALL_TEST;
+
+     PACKAGE BODY CALL_TEST IS
+     BEGIN
+          TEST ("CA1006A", "A LIBRARY UNIT AND ITS SUBUNITS " &
+                "SUBMITTED TOGETHER");
+     END CALL_TEST;
+
+     FUNCTION F (I : INTEGER) RETURN INTEGER IS SEPARATE;
+
+     PACKAGE PKG IS
+          I : INTEGER := IDENT_INT (0);
+          PROCEDURE P (I : IN OUT INTEGER);
+     END PKG;
+
+     PACKAGE BODY PKG IS SEPARATE;
+
+     PROCEDURE P (I : IN OUT INTEGER) IS SEPARATE;
+
+BEGIN
+
+     IF PKG.I /= 10 THEN
+          FAILED ("PACKAGE BODY STATEMENTS NOT EXECUTED");
+     END IF;
+
+     IF F(IDENT_INT(5)) /= -5 THEN
+          FAILED ("FUNCTION NOT ELABORATED/EXECUTED");
+     END IF;
+
+     PKG.P (I);
+     IF I /= 3 THEN
+          FAILED ("PACKAGED PROCEDURE NOT ELABORATED/EXECUTED");
+     END IF;
+
+     I := IDENT_INT (-20);
+     P (I);
+     IF I /= -24 THEN
+          FAILED ("PROCEDURE NOT ELABORATED/EXECUTED");
+     END IF;
+
+     RESULT;
+END CA1006A;
+
+
+SEPARATE (CA1006A)
+FUNCTION F (I : INTEGER) RETURN INTEGER IS
+BEGIN
+     RETURN -I;
+END F;
+
+
+SEPARATE (CA1006A)
+PACKAGE BODY PKG IS
+
+     PROCEDURE P (I : IN OUT INTEGER) IS
+     BEGIN
+          I := I + 3;
+     END P;
+
+BEGIN
+     I := I + 10;
+END PKG;
+
+
+SEPARATE (CA1006A)
+PROCEDURE P (I : IN OUT INTEGER) IS
+BEGIN
+     I := I - 4;
+END P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a0.ada
new file mode 100644
index 000000000..a1c164642
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a0.ada
@@ -0,0 +1,35 @@
+-- CA1011A0.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.
+--*
+-- BHS 7/20/84
+-- JBG 5/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE CA1011A0 (X : IN OUT INTEGER; Y : IN INTEGER := 2) IS
+BEGIN
+
+     X := Y;
+     FAILED ("DID NOT REPLACE CA1011A0");
+
+END CA1011A0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a1.ada
new file mode 100644
index 000000000..791d78238
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a1.ada
@@ -0,0 +1,36 @@
+-- CA1011A1.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.
+--*
+-- BHS 7/20/84
+-- JBG 5/23/85
+
+PROCEDURE CA1011A0 (X : IN OUT INTEGER;
+                    Y : IN INTEGER  := -1;        
+                    Z : IN INTEGER := 2) IS        
+
+BEGIN
+
+     X := 3;
+
+END CA1011A0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a2.ada
new file mode 100644
index 000000000..1125029aa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a2.ada
@@ -0,0 +1,35 @@
+-- CA1011A2.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.
+--*
+-- BHS 7/20/84
+-- JBG 5/23/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE CA1011A2 (X : INTEGER := 1; Y : IN OUT FLOAT) IS
+BEGIN
+
+     Y := 2.0;
+     FAILED ("DID NOT REPLACE CA1011A2");
+
+END CA1011A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a3.ada
new file mode 100644
index 000000000..a37d04c3e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a3.ada
@@ -0,0 +1,34 @@
+-- CA1011A3.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.
+--*
+-- BHS 7/20/84
+-- JBG 5/23/85
+
+PROCEDURE CA1011A2 (X : BOOLEAN := TRUE;
+                    Y : IN OUT FLOAT) IS
+BEGIN
+
+     Y := 3.0;
+
+END CA1011A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a4.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a4.ada
new file mode 100644
index 000000000..68d397240
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a4.ada
@@ -0,0 +1,35 @@
+-- CA1011A4.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.
+--*
+-- BHS 7/20/84
+-- JBG 5/23/85
+
+WITH REPORT; USE REPORT;
+FUNCTION CA1011A4 RETURN INTEGER IS
+BEGIN
+
+     FAILED ("DID NOT REPLACE CA1011A4");
+     RETURN 2;
+
+END CA1011A4;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a5.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a5.ada
new file mode 100644
index 000000000..2485717e1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a5.ada
@@ -0,0 +1,33 @@
+-- CA1011A5.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.
+--*
+-- BHS 7/20/84
+-- JBG 5/23/85
+
+FUNCTION CA1011A4 RETURN FLOAT IS
+BEGIN
+
+     RETURN 3.0;
+
+END CA1011A4;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a6.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a6.ada
new file mode 100644
index 000000000..40c562dd5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1011a6.ada
@@ -0,0 +1,71 @@
+-- CA1011A6M.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 BODY IS INITIALLY COMPILED, SUBSEQUENT
+-- ATTEMPTS TO COMPILE A SUBPROGRAM BODY WITH A DIFFERENT PARAMETER AND
+-- RESULT TYPE PROFILE ARE ACCEPTED (SEE AI-00199).
+
+-- SEPARATE FILES ARE:
+--     CA1011A0  A LIBRARY PROCEDURE (CA1011A0).
+--     CA1011A1  A LIBRARY PROCEDURE (CA1011A0).
+--     CA1011A2  A LIBRARY PROCEDURE (CA1011A2).
+--     CA1011A3  A LIBRARY PROCEDURE (CA1011A2).
+--     CA1011A4  A LIBRARY FUNCTION  (CA1011A4).
+--     CA1011A5  A LIBRARY FUNCTION  (CA1011A4).
+--     CA1011A6M THE MAIN PROCEDURE.
+
+-- BHS 7/20/84
+-- JBG 5/23/85
+
+WITH CA1011A0, CA1011A2, CA1011A4;
+WITH REPORT; USE REPORT;
+PROCEDURE CA1011A6M IS
+
+     I : INTEGER := 5;
+     J : FLOAT := 4.0;
+
+BEGIN
+
+     TEST("CA1011A", "ATTEMPTS TO RECOMPILE A SUBPROGRAM WITH " &
+                     "NONCONFORMING PARAMETER OR RESULT TYPE "  &
+                     "PROFILES ARE ACCEPTED");
+
+     CA1011A0(X => I);             -- EXPECT DEFAULT Y
+     IF I = 3 THEN
+          COMMENT ("SECOND DECLARATION OF CA1011A0 INVOKED CORRECTLY");
+     END IF;
+
+     CA1011A2(Y => J);             -- USE DEFAULT X.
+     IF J = 3.0 THEN
+          COMMENT ("SECOND DECLARATION OF CA1011A2 INVOKED CORRECTLY");
+     END IF;
+
+     I := INTEGER(CA1011A4);
+     IF I = 3 THEN
+          COMMENT ("SECOND DECLARATION OF CA1011A4 INVOKED CORRECTLY");
+     END IF;
+
+     RESULT;
+
+END CA1011A6M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a0.ada
new file mode 100644
index 000000000..eec972d73
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a0.ada
@@ -0,0 +1,41 @@
+-- CA1012A0.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.
+--*
+-- GENERIC PROCEDURE DECLARATION.
+-- BODY IS IN CA1012A1.DEP.
+-- INSTANTIATION IS IN CA1012A4M.DEP.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     WKB 07/20/81  CREATED ORIGINAL TEST.
+--     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
+--                   AND CLARIFY POSSIBLE NON-APPLICABILITY.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+GENERIC
+     TYPE INDEX IS RANGE <>;
+PROCEDURE CA1012A0 (I : IN OUT INDEX);
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a1.ada
new file mode 100644
index 000000000..0e2522f4b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a1.ada
@@ -0,0 +1,45 @@
+-- CA1012A1.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.
+--*
+-- GENERIC PROCEDURE BODY.
+-- DECLARATION IS IN CA1012A0.DEP.
+-- INSTANTIATION IN CA1012A4M.DEP.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     WKB 07/20/81  CREATED ORIGINAL TEST.
+--     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
+--                   IN TEST AND POSSIBLE NON-APPLICABILITY.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+PROCEDURE CA1012A0 (I : IN OUT INDEX) IS
+
+BEGIN
+
+     I := I + 1;
+
+END CA1012A0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a2.ada
new file mode 100644
index 000000000..63300b3ad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a2.ada
@@ -0,0 +1,41 @@
+-- CA1012A2.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.
+--*
+-- GENERIC FUNCTION DECLARATION.
+-- BODY IS IN CA1012A3.DEP.
+-- INSTANTIATION IS IN CA1012A4M.DEP.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     WKB 07/20/81  CREATED ORIGINAL TEST.
+--     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
+--                   AND POSSIBLE NON-APPLICABILITY.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+GENERIC
+     TYPE ELEMENT IS RANGE <>;
+FUNCTION CA1012A2 (J : IN ELEMENT) RETURN ELEMENT;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a3.ada
new file mode 100644
index 000000000..310777514
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a3.ada
@@ -0,0 +1,45 @@
+-- CA1012A3.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.
+--*
+-- GENERIC FUNCTION BODY.
+-- DECLARATION IS IN CA1012AB.DEP.
+-- INSTANTIATION IS IN CA1012A4B.DEP.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     WKB 07/20/81  CREATED ORIGINAL TEST.
+--     PWB 02/19/86  ADDED COMMENTS TO DESCRIBE RELATION TO OTHER FILES
+--                   AND POSSIBLE NON-APPLICABILITY.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+FUNCTION CA1012A2 (J : IN ELEMENT) RETURN ELEMENT IS
+
+BEGIN
+
+     RETURN J + 1;
+
+END CA1012A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a4.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a4.ada
new file mode 100644
index 000000000..f81b97d4b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012a4.ada
@@ -0,0 +1,74 @@
+-- CA1012A4M.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 GENERIC SUBPROGRAM DECLARATIONS AND BODIES CAN BE
+--     COMPILED SEPARATELY.
+
+-- SEPARATE FILES ARE:
+--   CA1012A0  A LIBRARY GENERIC PROCEDURE DECLARATION.
+--   CA1012A1  A LIBRARY GENERIC PROCEDURE BODY (CA1012A0).
+--   CA1012A2  A LIBRARY GENERIC FUNCTION DECLARATION.
+--   CA1012A3  A LIBRARY GENERIC FUNCTION BODY (CA1012A2).
+--   CA1012A4M THE MAIN PROCEDURE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
+--     THIS WAS NOT REQUIRED FOR ADA 83.
+
+-- HISTORY:
+--     WKB 07/20/81  CREATED ORIGINAL TEST.
+--     PWB 02/19/86  ADDED COMMENTS REGARDING NON-APPLICABILITY.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+--     RLB 09/15/99  REMOVED OBSOLETE COMMENT.
+
+WITH REPORT, CA1012A0, CA1012A2;
+USE REPORT;
+PROCEDURE CA1012A4M IS
+
+     N : INTEGER := 1;
+
+     SUBTYPE S50 IS INTEGER RANGE 1..50;
+
+     PROCEDURE P IS NEW CA1012A0 (S50);
+
+     FUNCTION F IS NEW CA1012A2 (INTEGER);
+
+BEGIN
+     TEST ("CA1012A", "SEPARATELY COMPILED GENERIC SUBPROGRAM " &
+                      "DECLARATIONS AND BODIES");
+
+     P(N);
+     IF N /= 2 THEN
+          FAILED ("PROCEDURE NOT INVOKED");
+     END IF;
+
+     N := 1;
+     IF F(N) /= 2 THEN
+          FAILED ("FUNCTION NOT INVOKED");
+     END IF;
+
+     RESULT;
+END CA1012A4M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012b0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012b0.ada
new file mode 100644
index 000000000..b260ca229
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012b0.ada
@@ -0,0 +1,37 @@
+-- CA1012B0.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.
+--*
+-- WKB 7/20/81
+
+GENERIC
+     TYPE INDEX IS RANGE <>;
+PROCEDURE CA1012B0 (I : IN OUT INDEX);
+
+PROCEDURE CA1012B0 (I : IN OUT INDEX) IS
+
+BEGIN
+
+     I := I + 1;
+
+END CA1012B0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012b2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012b2.ada
new file mode 100644
index 000000000..46d2b9301
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012b2.ada
@@ -0,0 +1,37 @@
+-- CA1012B2.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.
+--*
+-- WKB 7/20/81
+
+GENERIC
+     TYPE ELEMENT IS RANGE <>;
+FUNCTION CA1012B2 (J : IN ELEMENT) RETURN ELEMENT;
+
+FUNCTION CA1012B2 (J : IN ELEMENT) RETURN ELEMENT IS
+
+BEGIN
+
+     RETURN J + 1;
+
+END CA1012B2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012b4.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012b4.ada
new file mode 100644
index 000000000..528ace0d1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1012b4.ada
@@ -0,0 +1,63 @@
+-- CA1012B4M.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 GENERIC SUBPROGRAM DECLARATIONS AND BODIES CAN BE
+--   COMPILED SEPARATELY.
+
+-- SEPARATE FILES ARE:
+--   CA1012B0  A LIBRARY GENERIC PROCEDURE DECLARATION AND BODY.
+--   CA1012B2  A LIBRARY GENERIC FUNCTION DECLARATION AND BODY.
+--   CA1012B4M THE MAIN PROCEDURE.
+
+-- WKB 7/20/81
+
+WITH REPORT, CA1012B0, CA1012B2;
+USE REPORT;
+PROCEDURE CA1012B4M IS
+
+     N : INTEGER := 1;
+
+     SUBTYPE S50 IS INTEGER RANGE 1..50;
+
+     PROCEDURE P IS NEW CA1012B0 (S50);
+
+     FUNCTION F IS NEW CA1012B2 (INTEGER);
+
+BEGIN
+     TEST ("CA1012B", "SEPARATELY COMPILED GENERIC SUBPROGRAM " &
+                      "DECLARATIONS AND BODIES");
+
+     P(N);
+     IF N /= 2 THEN
+          FAILED ("PROCEDURE NOT INVOKED");
+     END IF;
+
+     N := 1;
+     IF F(N) /= 2 THEN
+          FAILED ("FUNCTION NOT INVOKED");
+     END IF;
+
+     RESULT;
+
+END CA1012B4M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a0.ada
new file mode 100644
index 000000000..937c25f54
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a0.ada
@@ -0,0 +1,51 @@
+-- CA1013A0.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.
+--*
+-- WKB 7/20/81
+-- PWN 5/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+
+GENERIC
+     TYPE ELEM IS RANGE <>;
+PACKAGE CA1013A0 IS
+
+     I : ELEM;
+
+     PROCEDURE REQUIRE_BODY;
+
+END CA1013A0;
+
+
+PACKAGE BODY CA1013A0 IS
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+          NULL;
+     END;
+
+BEGIN
+
+     I := 1;
+
+END CA1013A0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a1.ada
new file mode 100644
index 000000000..ddea320bf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a1.ada
@@ -0,0 +1,39 @@
+-- CA1013A1.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.
+--*
+-- WKB 7/20/81
+
+
+GENERIC
+     TYPE INDEX IS RANGE <>;
+PROCEDURE CA1013A1 (I : IN OUT INDEX);
+
+
+PROCEDURE CA1013A1 (I : IN OUT INDEX) IS
+
+BEGIN
+ 
+     I := I + 1;
+
+END CA1013A1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a2.ada
new file mode 100644
index 000000000..a6843a8e9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a2.ada
@@ -0,0 +1,39 @@
+-- CA1013A2.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.
+--*
+-- WKB 7/20/81
+
+
+GENERIC
+     TYPE ITEM IS RANGE <>;
+FUNCTION CA1013A2 RETURN ITEM;
+
+
+FUNCTION CA1013A2 RETURN ITEM IS
+
+BEGIN
+
+     RETURN 2;
+
+END CA1013A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a3.ada
new file mode 100644
index 000000000..a4a805b5d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a3.ada
@@ -0,0 +1,31 @@
+-- CA1013A3.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.
+--*
+-- WKB 7/20/81
+-- SPS 10/27/82
+-- JBG 9/15/83
+
+WITH CA1013A0; 
+PRAGMA ELABORATE (CA1013A0);
+PACKAGE CA1013A3 IS NEW CA1013A0 (INTEGER);
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a4.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a4.ada
new file mode 100644
index 000000000..9828c033b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a4.ada
@@ -0,0 +1,31 @@
+-- CA1013A4.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.
+--*
+-- WKB 7/20/81
+-- SPS 10/27/82
+-- JBG 9/15/83
+
+WITH CA1013A1;
+PRAGMA ELABORATE (CA1013A1);
+PROCEDURE CA1013A4 IS NEW CA1013A1 (INTEGER);
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a5.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a5.ada
new file mode 100644
index 000000000..bc858539d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a5.ada
@@ -0,0 +1,30 @@
+-- CA1013A5.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.
+--*
+-- WKB 7/20/81
+-- JBG 9/15/83
+
+WITH CA1013A2;
+PRAGMA ELABORATE (CA1013A2);
+FUNCTION CA1013A5 IS NEW CA1013A2 (INTEGER);
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a6.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a6.ada
new file mode 100644
index 000000000..16c266e45
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1013a6.ada
@@ -0,0 +1,65 @@
+-- CA1013A6M.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 GENERIC PACKAGE OR SUBPROGRAM INSTANTIATION
+-- CAN BE SUBMITTED FOR SEPARATE COMPILATION.
+
+-- SEPARATE FILES ARE:
+--   CA1013A0  A LIBRARY GENERIC PACKAGE.
+--   CA1013A1  A LIBRARY GENERIC PROCEDURE.
+--   CA1013A2  A LIBRARY GENERIC FUNCTION.
+--   CA1013A3  A LIBRARY GENERIC PACKAGE INSTANTIATION.
+--   CA1013A4  A LIBRARY GENERIC PROCEDURE INSTANTIATION.
+--   CA1013A5  A LIBRARY GENERIC FUNCTION INSTANTIATION.
+--   CA1013A6M THE MAIN PROCEDURE.
+
+-- WKB 7/20/81
+-- SPS 11/5/82
+
+WITH REPORT;
+WITH CA1013A3, CA1013A4, CA1013A5;
+USE REPORT;
+PROCEDURE CA1013A6M IS
+
+     J : INTEGER := 1;
+
+BEGIN
+     TEST ("CA1013A", "GENERIC INSTANTIATIONS SUBMITTED " &
+                      "FOR SEPARATE COMPILATION");
+
+     IF CA1013A3.I /= 1 THEN
+          FAILED ("PACKAGE NOT ACCESSED");
+     END IF;
+
+     CA1013A4 (J);
+     IF J /= 2 THEN
+          FAILED ("PROCEDURE NOT INVOKED");
+     END IF;
+
+     IF CA1013A5 /= 2 THEN
+          FAILED ("FUNCTION NOT INVOKED");
+     END IF;
+
+     RESULT;
+END CA1013A6M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a0.ada
new file mode 100644
index 000000000..cf5e93d96
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a0.ada
@@ -0,0 +1,85 @@
+-- CA1014A0M.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 SUBUNIT CAN BE SUBMITTED FOR COMPILATION
+-- SEPARATELY FROM ITS PARENT UNIT.
+
+-- SEPARATE FILES ARE:
+--   CA1014A0M THE MAIN PROCEDURE.
+--   CA1014A1  A SUBUNIT PROCEDURE BODY.
+--   CA1014A2  A SUBUNIT PACKAGE BODY.
+--   CA1014A3  A SUBUNIT FUNCTION BODY.
+
+-- JRK 5/20/81
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CA1014A0M IS
+
+     I : INTEGER := 0;
+
+     PACKAGE CALL_TEST IS
+     END CALL_TEST;
+
+     PACKAGE BODY CALL_TEST IS
+     BEGIN
+          TEST ("CA1014A", "SUBUNITS SUBMITTED FOR COMPILATION " &
+                "SEPARATELY FROM PARENT UNIT");
+     END CALL_TEST;
+
+     PROCEDURE CA1014A1 (I : IN OUT INTEGER) IS SEPARATE;
+
+     PACKAGE CA1014A2 IS
+          I : INTEGER := 10;
+          PROCEDURE P (I : IN OUT INTEGER);
+     END CA1014A2;
+
+     PACKAGE BODY CA1014A2 IS SEPARATE;
+
+     FUNCTION CA1014A3 (I : INTEGER) RETURN INTEGER IS SEPARATE;
+
+BEGIN
+
+     CA1014A1 (I);
+     IF I /= 1 THEN
+          FAILED ("SUBUNIT PROCEDURE NOT ELABORATED/EXECUTED");
+     END IF;
+
+     IF CA1014A2.I /= 15 THEN
+          FAILED ("SUBUNIT PACKAGE BODY NOT ELABORATED/EXECUTED");
+     END IF;
+
+     I := 0;
+     CA1014A2.P (I);
+     IF I /= -20 THEN
+          FAILED ("SUBUNIT PACKAGED PROCEDURE NOT ELABORATED/EXECUTED");
+     END IF;
+
+     IF CA1014A3(50) /= -50 THEN
+          FAILED ("SUBUNIT FUNCTION NOT ELABORATED/EXECUTED");
+     END IF;
+
+     RESULT;
+END CA1014A0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a1.ada
new file mode 100644
index 000000000..d66b677bb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a1.ada
@@ -0,0 +1,34 @@
+-- CA1014A1.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.
+--*
+-- JRK 5/20/81
+
+SEPARATE (CA1014A0M)
+PROCEDURE CA1014A1 (I : IN OUT INTEGER) IS
+
+BEGIN
+
+     I := I + 1;
+
+END CA1014A1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a2.ada
new file mode 100644
index 000000000..9c23ef1f9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a2.ada
@@ -0,0 +1,39 @@
+-- CA1014A2.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.
+--*
+-- JRK 5/20/81
+
+SEPARATE (CA1014A0M)
+PACKAGE BODY CA1014A2 IS
+
+     PROCEDURE P (I : IN OUT INTEGER) IS
+     BEGIN
+          I := I - 20;
+     END P;
+
+BEGIN
+
+     I := I + 5;
+
+END CA1014A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a3.ada
new file mode 100644
index 000000000..cd76acc6f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1014a3.ada
@@ -0,0 +1,34 @@
+-- CA1014A3.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.
+--*
+-- JRK 5/20/81
+
+SEPARATE (CA1014A0M)
+FUNCTION CA1014A3 (I : INTEGER) RETURN INTEGER IS
+
+BEGIN
+ 
+     RETURN -I;
+
+END CA1014A3;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e0.ada
new file mode 100644
index 000000000..93ecc023f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e0.ada
@@ -0,0 +1,53 @@
+-- CA1020E0.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 SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
+--     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
+--     GENERIC UNITS TO BE INSTANTIATED AS LIBRARY UNITS.
+
+-- HISTORY:
+--     JBG 05/28/85  CREATED ORIGINAL TEST.
+--     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
+--                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
+--                   DECLARED WITHOUT A BODY.
+
+GENERIC
+     C : INTEGER;
+PROCEDURE GENPROC_CA1020E (X : OUT INTEGER);
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PROCEDURE GENPROC_CA1020E (X : OUT INTEGER) IS
+BEGIN
+     X := IDENT_INT(C);
+END GENPROC_CA1020E;
+
+GENERIC
+FUNCTION GENFUNC_CA1020E RETURN INTEGER;
+
+FUNCTION GENFUNC_CA1020E RETURN INTEGER IS
+BEGIN
+     RETURN 2;
+END GENFUNC_CA1020E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e1.ada
new file mode 100644
index 000000000..e5df714ea
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e1.ada
@@ -0,0 +1,59 @@
+-- CA1020E1.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 SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
+--     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
+--     SUBPROGRAMS TO BE REPLACED BY LATER GENERIC INSTANTIATIONS.
+
+-- HISTORY:
+--     JBG 05/28/85  CREATED ORIGINAL TEST.
+--     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
+--                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
+--                   DECLARED WITHOUT A BODY.
+
+PROCEDURE CA1020E_PROC1 (X : OUT INTEGER) IS
+BEGIN
+     X := 3;
+END CA1020E_PROC1;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+FUNCTION CA1020E_FUNC1 RETURN INTEGER IS
+BEGIN
+     RETURN IDENT_INT(4);
+END CA1020E_FUNC1;
+
+PROCEDURE CA1020E_PROC2 (X : OUT INTEGER);
+PROCEDURE CA1020E_PROC2 (X : OUT INTEGER) IS
+BEGIN
+     X := 3;
+END CA1020E_PROC2;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+FUNCTION CA1020E_FUNC2 RETURN FLOAT IS
+BEGIN
+     RETURN FLOAT(IDENT_INT(4));
+END CA1020E_FUNC2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e2.ada
new file mode 100644
index 000000000..7497804fe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e2.ada
@@ -0,0 +1,51 @@
+-- CA1020E2.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 SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
+--     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
+--     GENERIC INSTANTIATIONS REPLACING LIBRARY UNITS CREATED IN
+--     CA1020E1.
+
+-- HISTORY:
+--     JBG 05/28/85  CREATED ORIGINAL TEST.
+--     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
+--                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
+--                   DECLARED WITHOUT A BODY.
+
+WITH GENPROC_CA1020E;
+PRAGMA ELABORATE (GENPROC_CA1020E);
+PROCEDURE CA1020E_PROC1 IS NEW GENPROC_CA1020E(1);
+
+WITH GENFUNC_CA1020E;
+PRAGMA ELABORATE (GENFUNC_CA1020E);
+FUNCTION CA1020E_FUNC1 IS NEW GENFUNC_CA1020E;
+
+WITH GENPROC_CA1020E;
+PRAGMA ELABORATE (GENPROC_CA1020E);
+PROCEDURE CA1020E_PROC2 IS NEW GENPROC_CA1020E(5);
+
+WITH GENFUNC_CA1020E;
+PRAGMA ELABORATE (GENFUNC_CA1020E);
+FUNCTION CA1020E_FUNC2 IS NEW GENFUNC_CA1020E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e3.ada
new file mode 100644
index 000000000..e8ad70f17
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1020e3.ada
@@ -0,0 +1,71 @@
+-- CA1020E3M.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 SUBPROGRAM LIBRARY UNIT CAN BE REPLACED BY A GENERIC
+--     INSTANTIATION HAVING THE SAME IDENTIFIER.  THIS FILE CONTAINS
+--     GENERIC UNITS TO BE INSTANTIATED AS LIBRARY UNITS.
+
+-- SEPARATE FILES ARE:
+--     CA1020E0  -- GENERIC UNITS GENPROC_CA1020E AND GENFUNC_CA1020E.
+--     CA1020E1  -- SUBPROGRAM LIBRARY UNIT BODIES (CA1020E_PROC1,
+--                  CA1020E_FUNC1, CA1020E_PROC2, CA1020E_FUNC2).
+--     CA1020E2  -- INSTANTIATIONS REPLACING UNITS COMPILED IN CA1020E1.
+--     CA1020E3M -- MAIN PROGRAM.
+
+-- HISTORY:
+--     JBG 05/28/85  CREATED ORIGINAL TEST.
+--     JET 07/29/88  ADDED CASES IN WHICH SUBPROGRAM PROFILES ARE NOT
+--                   THE SAME AND ALSO WHEN SUBPROGRAM IS FIRST
+--                   DECLARED WITHOUT A BODY.
+
+WITH REPORT; USE REPORT;
+WITH CA1020E_PROC1, CA1020E_FUNC1, CA1020E_PROC2, CA1020E_FUNC2;
+PROCEDURE CA1020E3M IS
+     TEMP : INTEGER := 0;
+BEGIN
+     TEST ("CA1020E", "CHECK THAT A SUBPROGRAM LIBRARY UNIT CAN BE " &
+                      "REPLACED BY A GENERIC INSTANTIATION HAVING " &
+                      "THE SAME IDENTIFIER");
+
+     CA1020E_PROC1 (TEMP);
+     IF TEMP /= IDENT_INT(1) THEN
+          FAILED ("INSTANTIATION DID NOT REPLACE PROCEDURE");
+     END IF;
+
+     IF CA1020E_FUNC1 /= IDENT_INT(2) THEN
+          FAILED ("INSTANTIATION DID NOT REPLACE FUNCTION");
+     END IF;
+
+     CA1020E_PROC2 (TEMP);
+     IF TEMP /= IDENT_INT(5) THEN
+          FAILED ("INSTANTIATION DID NOT REPLACE PROCEDURE");
+     END IF;
+
+     IF CA1020E_FUNC2 /= IDENT_INT(2) THEN
+          FAILED ("INSTANTIATION DID NOT REPLACE FUNCTION");
+     END IF;
+
+     RESULT;
+END CA1020E3M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a0.ada
new file mode 100644
index 000000000..c3788cc04
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a0.ada
@@ -0,0 +1,43 @@
+-- CA1022A0.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.
+--*
+-- BHS 7/23/84
+
+PACKAGE CA1022A0 IS
+
+     I : INTEGER := 2;
+     PROCEDURE P0 (X : IN OUT INTEGER );
+
+END CA1022A0;
+
+PACKAGE BODY CA1022A0 IS
+
+     PROCEDURE P0 (X : IN OUT INTEGER) IS
+     BEGIN
+
+          X := X + 1;
+
+     END P0;
+
+END CA1022A0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a1.ada
new file mode 100644
index 000000000..89ea74851
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a1.ada
@@ -0,0 +1,33 @@
+-- CA1022A1.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.
+--*
+-- BHS 7/23/84
+
+WITH CA1022A0;
+PROCEDURE CA1022A1 (Y : IN OUT INTEGER) IS
+BEGIN
+
+     CA1022A0.P0 (Y);
+
+END CA1022A1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a2.ada
new file mode 100644
index 000000000..c7e874b29
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a2.ada
@@ -0,0 +1,33 @@
+-- CA1022A2.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.
+--*
+-- BHS 7/23/84
+
+WITH CA1022A0;
+FUNCTION CA1022A2 (Z : INTEGER := 1) RETURN BOOLEAN IS
+BEGIN
+
+     RETURN TRUE;
+
+END CA1022A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a3.ada
new file mode 100644
index 000000000..6c5e9deb7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a3.ada
@@ -0,0 +1,53 @@
+-- CA1022A3.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.
+--*
+-- RECOMPILATION OF PACKAGE CA1022A0.
+
+-- BHS 7/23/84
+
+PACKAGE CA1022A0 IS
+
+     I, J : INTEGER;
+     PROCEDURE P0 (X : IN OUT INTEGER);
+     FUNCTION F RETURN INTEGER;
+
+END CA1022A0;
+
+PACKAGE BODY CA1022A0 IS
+
+     PROCEDURE P0 (X : IN OUT INTEGER) IS
+     BEGIN
+
+          X := X + 2;
+
+     END P0;
+
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+
+          RETURN 3;
+
+     END F;
+
+END CA1022A0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a4.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a4.ada
new file mode 100644
index 000000000..17837a659
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a4.ada
@@ -0,0 +1,36 @@
+-- CA1022A4.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.
+--*
+-- RECOMPILATION OF PROCEDURE CA1022A1.
+
+-- BHS 7/23/84
+
+WITH CA1022A0;
+PROCEDURE CA1022A1 (Y : IN OUT INTEGER) IS
+BEGIN
+
+     Y := 3;
+     CA1022A0.P0 (Y);
+
+END CA1022A1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a5.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a5.ada
new file mode 100644
index 000000000..005748ee3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a5.ada
@@ -0,0 +1,34 @@
+-- CA1022A5.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.
+--*
+-- RECOMPILATION OF FUNCTION CA1022A2 (DECL AND BODY).
+
+-- BHS 7/23/84
+
+FUNCTION CA1022A2 (Z : INTEGER := 1) RETURN BOOLEAN IS
+BEGIN
+
+     RETURN Z /= 1;
+
+END CA1022A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a6.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a6.ada
new file mode 100644
index 000000000..b011c9bc5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1022a6.ada
@@ -0,0 +1,66 @@
+-- CA1022A6M.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 BODY IS INITIALLY COMPILED WITH A CONTEXT
+-- CLAUSE AND A UNIT NAMED IN THE CONTEXT CLAUSE IS RECOMPILED, THEN AN
+-- ATTEMPT TO COMPILE THE BODY AGAIN WILL SUCCEED IF THE CONTEXT CLAUSE
+-- IS PRESENT.
+-- CHECK THAT IF THE RECOMPILED UNIT IS NOT NEEDED IN THE SUBPROGRAM
+-- BODY, THE BODY CAN BE SUCCESSFULLY RECOMPILED WITHOUT MENTIONING THE
+-- RECOMPILED UNIT.
+
+-- SEPARATE FILES ARE:
+--     CA1022A0  A LIBRARY PACKAGE.
+--     CA1022A1  A LIBRARY PROCEDURE.
+--     CA1022A2  A LIBRARY FUNCTION.
+--     CA1022A3  A LIBRARY PACKAGE (CA1022A0).
+--     CA1022A4  A LIBRARY PROCEDURE (CA1022A1).
+--     CA1022A5  A LIBRARY FUNCTION (CA1022A2).
+--     CA1022A6M THE MAIN PROCEDURE.
+
+-- BHS 7/23/84
+
+WITH CA1022A1, CA1022A2;
+WITH REPORT; USE REPORT;
+PROCEDURE CA1022A6M IS
+
+     I : INTEGER := 1;
+
+BEGIN
+
+     TEST ("CA1022A", "USE OF CONTEXT CLAUSES NAMING RECOMPILED " &
+                      "UNITS WITH RECOMPILED SUBPROGRAMS");
+
+     CA1022A1(I);
+     IF I /= 5 THEN
+          FAILED ("PROCEDURE CA1022A1 NOT INVOKED CORRECTLY");
+     END IF;
+
+     IF CA1022A2 THEN
+          FAILED ("FUNCTION CA1022A2 NOT INVOKED CORRECTLY");
+     END IF;
+
+     RESULT;
+
+END CA1022A6M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11001.a
new file mode 100644
index 000000000..c9d1e486c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11001.a
@@ -0,0 +1,276 @@
+-- CA11001.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 child unit can be used to provide an alternate view and
+--      operations on a private type in its parent package.  Check that a 
+--      child unit can be a package.  Check that a WITH of a child unit 
+--      includes an implicit WITH of its ancestor unit.  
+--
+-- TEST DESCRIPTION:
+--      Declare a private type in a package specification. Declare 
+--      subprograms for the type.
+--
+--      Add a public child to the above package.  Within the body of this
+--      package, access the private type. Declare operations to read and 
+--      write to its parent private type.
+--
+--      In the main program, "with" the child.  Declare objects of the
+--      parent private type.  Access the subprograms from both parent and
+--      child packages.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CA11001_0 is   -- Cartesian_Complex
+--  This package represents a Cartesian view of a complex number.  It contains 
+--  a private type plus subprograms to construct and decompose a complex 
+--  number.
+
+   type Complex_Int is range 0 .. 100;
+
+   type Complex_Type is private;
+
+   Constant_Complex : constant Complex_Type;
+
+   Complex_Error : exception;
+
+   procedure Cartesian_Assign   (R, I : in     Complex_Int; 
+                                 C    :    out Complex_Type);
+
+   function Cartesian_Real_Part (C : Complex_Type) 
+     return Complex_Int;
+
+   function Cartesian_Imag_Part (C : Complex_Type) 
+     return Complex_Int;
+
+   function Complex (Real, Imaginary : Complex_Int)
+     return Complex_Type;                             
+
+private
+   type Complex_Type is                      -- Parent private type
+      record
+         Real, Imaginary : Complex_Int;
+      end record;
+
+   Constant_Complex : constant Complex_Type := (Real => 0, Imaginary => 0);
+
+end CA11001_0;       -- Cartesian_Complex
+
+--=======================================================================--
+
+package body CA11001_0 is  -- Cartesian_Complex
+
+   procedure Cartesian_Assign (R, I : in     Complex_Int; 
+                               C    :    out Complex_Type) is
+   begin
+      C.Real      := R;
+      C.Imaginary := I;
+   end Cartesian_Assign;
+   -------------------------------------------------------------
+   function Cartesian_Real_Part (C : Complex_Type) 
+     return Complex_Int is
+   begin
+      return C.Real;
+   end Cartesian_Real_Part;
+   -------------------------------------------------------------
+   function Cartesian_Imag_Part (C : Complex_Type) 
+     return Complex_Int is
+   begin
+      return C.Imaginary;
+   end Cartesian_Imag_Part;
+   -------------------------------------------------------------
+   function Complex (Real, Imaginary : Complex_Int)
+     return Complex_Type is
+   begin
+      return (Real, Imaginary);
+   end Complex;
+
+end CA11001_0;      -- Cartesian_Complex
+
+--=======================================================================--
+
+package CA11001_0.CA11001_1 is    -- Polar_Complex
+--  This public child provides a different view of the private type from its
+--  parent.  It provides a polar view by the provision of subprograms which
+--  construct and decompose a complex number.
+
+   procedure Polar_Assign (R, Theta : in     Complex_Int; 
+                           C        :    out Complex_Type);  
+                                             -- Complex_Type is a 
+                                             -- record of CA11001_0
+
+   function Polar_Real_Part (C: Complex_Type) return Complex_Int;           
+
+   function Polar_Imag_Part (C: Complex_Type) return Complex_Int;
+
+   function Equals_Const (Num : Complex_Type) return Boolean;
+
+end CA11001_0.CA11001_1;    -- Polar_Complex
+
+--=======================================================================--
+
+package body CA11001_0.CA11001_1 is   -- Polar_Complex
+
+   function Cos (Angle : Complex_Int) return Complex_Int is
+      Num : constant Complex_Int := 2;
+   begin
+      return (Angle * Num);   -- not true Cosine function
+   end Cos;
+   -------------------------------------------------------------
+   function Sine (Angle : Complex_Int) return Complex_Int is
+   begin
+      return 1;     -- not true Sine function
+   end Sine;
+   -------------------------------------------------------------
+   function Sqrt (Num : Complex_Int) 
+     return Complex_Int is
+   begin
+     return (Num);     -- not true Square root function
+   end Sqrt;
+   -------------------------------------------------------------
+   function Tan  (Angle : Complex_Int) return Complex_Int is
+   begin
+     return Angle;     -- not true Tangent function
+   end Tan;
+   -------------------------------------------------------------
+   procedure Polar_Assign (R, Theta : in     Complex_Int;  
+                           C        :    out Complex_Type) is 
+   begin
+      if R = 0 and Theta = 0 then
+         raise Complex_Error;
+      end if;
+      C.Real := R * Cos (Theta);
+      C.Imaginary := R * Sine (Theta);
+   end Polar_Assign;
+   -------------------------------------------------------------
+   function Polar_Real_Part (C: Complex_Type) return Complex_Int is
+   begin
+      return Sqrt ((Cartesian_Imag_Part (C)) ** 2 + 
+                   (Cartesian_Real_Part (C)) ** 2);
+   end Polar_Real_Part;
+   -------------------------------------------------------------
+   function Polar_Imag_Part (C: Complex_Type) return Complex_Int is
+   begin
+      return (Tan (Cartesian_Imag_Part (C) / 
+              Cartesian_Real_Part (C)));
+   end Polar_Imag_Part;
+   -------------------------------------------------------------
+   function Equals_Const (Num : Complex_Type) return Boolean is
+   begin
+      return Num.Real = Constant_Complex.Real and
+         Num.Imaginary = Constant_Complex.Imaginary;
+   end Equals_Const;
+
+end CA11001_0.CA11001_1;     -- Polar_Complex
+
+--=======================================================================--
+
+with CA11001_0.CA11001_1;        -- Polar_Complex
+with Report;
+
+procedure CA11001 is
+
+   Complex_No  : CA11001_0.Complex_Type;    -- Complex_Type is a
+                                            -- record of CA11001_0
+
+   Complex_5x2 : CA11001_0.Complex_Type := CA11001_0.Complex (5, 2);
+
+   Int_2       :  CA11001_0.Complex_Int 
+               := CA11001_0.Complex_Int (Report.Ident_Int (2));
+
+begin
+
+   Report.Test ("CA11001", "Check that a child unit can be used " &
+                "to provide an alternate view and operations " &
+                "on a private type in its parent package");
+
+   Basic_View_Subtest:
+
+   begin
+      -- Assign using Cartesian coordinates.
+      CA11001_0.Cartesian_Assign 
+        (CA11001_0.Complex_Int (Report.Ident_Int (1)), Int_2, Complex_No);
+
+      -- Read back in Polar coordinates.
+      -- Polar values are surrogates used in checking for correct
+      -- subprogram calls.
+      if CA11001_0."/=" (CA11001_0.CA11001_1.Polar_Real_Part (Complex_No),
+        CA11001_0.Cartesian_Real_Part (Complex_5x2)) and CA11001_0."/="
+          (CA11001_0.CA11001_1.Polar_Imag_Part (Complex_No),  
+            CA11001_0.Cartesian_Imag_Part (Complex_5x2)) then
+           Report.Failed ("Incorrect Cartesian result");
+      end if;
+
+   end Basic_View_Subtest;
+   -------------------------------------------------------------
+   Alternate_View_Subtest:
+   begin
+      -- Assign using Polar coordinates.
+      CA11001_0.CA11001_1.Polar_Assign 
+        (Int_2, CA11001_0.Complex_Int (Report.Ident_Int (3)), Complex_No);
+
+      -- Read back in Cartesian coordinates.
+      if CA11001_0."/=" (CA11001_0.Cartesian_Real_Part 
+        (Complex_No), CA11001_0.Complex_Int (Report.Ident_Int (12))) or 
+          CA11001_0."/=" (CA11001_0.Cartesian_Imag_Part (Complex_No), Int_2) 
+      then
+         Report.Failed ("Incorrect Polar result");
+      end if;
+   end Alternate_View_Subtest;
+   -------------------------------------------------------------
+   Other_Subtest:
+   begin
+      -- Assign using Polar coordinates.
+      CA11001_0.CA11001_1.Polar_Assign 
+        (CA11001_0.Complex_Int (Report.Ident_Int (0)), Int_2, Complex_No);
+
+      -- Compare with Complex_Num in CA11001_0.
+      if not CA11001_0.CA11001_1.Equals_Const (Complex_No)
+        then
+         Report.Failed ("Incorrect result");
+      end if;
+   end Other_Subtest;
+   -------------------------------------------------------------
+   Exception_Subtest:
+   begin
+      -- Raised parent's exception.
+      CA11001_0.CA11001_1.Polar_Assign 
+        (CA11001_0.Complex_Int (Report.Ident_Int (0)), 
+           CA11001_0.Complex_Int (Report.Ident_Int (0)), Complex_No);
+      Report.Failed ("Exception was not raised");
+   exception
+      when CA11001_0.Complex_Error => 
+         null;
+      when others                  =>
+         Report.Failed ("Unexpected exception raised in test");
+   end Exception_Subtest;
+
+   Report.Result;
+
+end CA11001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11002.a
new file mode 100644
index 000000000..189e1944c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11002.a
@@ -0,0 +1,238 @@
+-- CA11002.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 public child can utilize its parent unit's visible 
+--      definitions.
+--      
+-- TEST DESCRIPTION:
+--      Declare a parent package that contains the following: type, object,
+--      constant, exception, and subprograms.  Declare a public child unit
+--      that utilizes the components found in the visible part of its parent.
+--
+--      Demonstrate utilization of the following parent components in the 
+--      child package:
+--
+--                          Parent
+--          Type              X
+--          Constant          X
+--          Object            X           
+--          Subprogram        X           
+--          Exception         X           
+--
+--      This abstraction simulates a portion of a simple operating system.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CA11002_0 is                      -- Package OS.
+
+   type File_Descriptor is new Integer;
+   type File_Mode is (Read_Only, Write_Only, Read_Write);
+
+   Null_File    : constant File_Descriptor := 0;
+   Default_Mode : constant File_Mode       := Read_Only;
+   Active_Mode  : constant File_Mode       := Read_Write;
+
+   type File_Type is 
+     record
+        Descriptor : File_Descriptor := Null_File;
+        Mode       : File_Mode       := Default_Mode;
+     end record;
+
+   System_File     : File_Type;
+   File_Mode_Error : exception;
+
+   function Next_Available_File return File_Descriptor;
+
+   function Mode_Of_File (File : File_Type) return File_Mode;
+
+end CA11002_0;                            -- Package OS. 
+
+     --=================================================================--
+
+package body CA11002_0 is                 -- Package body OS.
+   
+   File_Count : Integer := 0;
+
+   function Next_Available_File return File_Descriptor is
+   begin
+      File_Count := File_Count + 1;
+      return (File_Descriptor(File_Count));    -- Type conversion.
+   end Next_Available_File;
+   --------------------------------------------------------------
+   function Mode_Of_File (File : File_Type) return File_Mode is
+      Mode : File_Mode := File.Mode;
+   begin
+      return (Mode);
+   end Mode_Of_File;
+
+end CA11002_0;                            -- Package body OS.
+
+     --=================================================================--
+
+package CA11002_0.CA11002_1 is            -- Child package OS.Operations.
+
+   -- Dot qualification of types, objects, etc. from parent is not required
+   -- in a child unit.
+
+   procedure Create_File (Mode : in     File_Mode:= Active_Mode;
+                          File :    out File_Type);    
+
+end CA11002_0.CA11002_1;                  -- Child package OS.Operations. 
+
+     --=================================================================--
+
+with Report;
+package body CA11002_0.CA11002_1 is       -- Child package body OS.Operations.
+
+   function New_File_Validated (File : File_Type)        -- Ensure that a newly
+     return Boolean is                                   -- created file has
+      Result : Boolean := False;                         -- appropriate values.
+   begin                                                 
+      if (File.Descriptor > System_File.Descriptor) and  -- Parent object.
+         (File.Mode  in  File_Mode )                     -- Parent type.
+      then
+         Result := True;
+      end if;
+
+      return (Result);
+
+   end New_File_Validated;
+   --------------------------------------------------------------
+   procedure Create_File 
+     (Mode       : in     File_Mode := Active_Mode;     -- Parent constant.
+      File       :    out File_Type) is                 -- Parent type.
+
+      New_File : File_Type;
+
+   begin
+      New_File.Descriptor := Next_Available_File;       -- Parent subprogram.
+      New_File.Mode       := Mode;
+
+      if New_File_Validated (File => New_File) then
+         File := New_File;
+      end if;
+
+   end Create_File;
+
+end CA11002_0.CA11002_1;                  -- Child Package body OS.Operations.
+
+     --=================================================================--
+
+-- Child library subprogram Convert_File_Mode specification.
+procedure CA11002_0.CA11002_2 (File     : in out File_Type;    -- Parent type. 
+                               New_Mode : in     File_Mode);   -- Parent type.
+
+
+     --=================================================================--
+with Report;
+
+-- Child library subprogram Convert_File_Mode body.
+procedure CA11002_0.CA11002_2 (File     : in out File_Type;   
+                               New_Mode : in     File_Mode) is
+begin
+   if File.Mode = New_Mode then
+      raise File_Mode_Error;                               -- Parent exception.
+      Report.Failed ("Exception not raised in child unit");
+   else
+      File.Mode := New_Mode;
+   end if;
+end CA11002_0.CA11002_2;
+
+     --=================================================================--
+
+with Report;
+with CA11002_0.CA11002_1;          -- Child package OS.Operations.
+with CA11002_0.CA11002_2;          -- Child subprogram OS.Convert_File_Mode,
+                                   -- Implicitly with parent, OS.
+use CA11002_0;                     -- All user-defined operators directly
+                                   -- visible.
+procedure CA11002 is
+begin
+
+   Report.Test ("CA11002", "Check that a public child can utilize its " &
+                "parent unit's visible definitions");
+
+   File_Creation:                   -- This processing block will demonstrate
+                                    -- use of child package subroutine that
+                                    -- takes advantage of components declared
+                                    -- in the parent package.
+   declare
+      User_File : File_Type;
+   begin
+      CA11002_0.CA11002_1.Create_File (File => User_File); -- Default mode
+                                                           -- parameter used in
+                                                           -- this call.
+      if (User_File.Descriptor = System_File.Descriptor) or
+         (User_File.Mode       = Default_Mode) 
+      then
+         Report.Failed ("Incorrect file creation");
+      end if;
+
+   end File_Creation;
+
+   --------------------------------------------------------------
+   File_Mode_Conversion:            -- This processing block will demonstrate
+                                    -- the occurrence of a (forced) exception
+                                    -- being raised in a child subprogram, and
+                                    -- propagated to the caller.  The exception
+                                    -- is handled, and the child subprogram
+                                    -- is called again, this time to perform
+                                    -- without error.
+   declare
+      procedure Convert_File_Mode (File : in out File_Type; 
+        New_Mode : in File_Mode) renames CA11002_0.CA11002_2; 
+      New_File : File_Type;
+   begin                               -- Raise an exception with this
+                                       -- illegal conversion operation
+                                       -- (attempt to change to current mode).
+
+      Convert_File_Mode (File     => New_File,
+                         New_Mode => Default_Mode);
+      Report.Failed ("Exception should have been raised in child unit");
+
+   exception
+      when File_Mode_Error =>          -- Perform the conversion again, this
+                                       -- time with a different file mode.
+
+         Convert_File_Mode (File     => New_File,
+                            New_Mode => CA11002_0.Active_Mode);
+
+         if New_File.Mode /= Read_Write then
+            Report.Failed ("Incorrect result from mode conversion operation");
+         end if;
+
+      when others =>
+         Report.Failed ("Unexpected exception raised in File_Mode_Conversion");
+
+   end File_Mode_Conversion;
+
+   Report.Result;
+
+end CA11002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11003.a
new file mode 100644
index 000000000..ff894250e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11003.a
@@ -0,0 +1,290 @@
+-- CA11003.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 public grandchild can utilize its ancestor unit's visible 
+--      definitions.
+--
+-- TEST DESCRIPTION:
+--      Declare a public package, public child package, and public 
+--      grandchild package and library unit function.  Within the 
+--      grandchild package and function, make use of components that are 
+--      declared in the ancestor packages, both parent and grandparent.  
+--
+--      Use the following ancestral components in the grandchildren library
+--      units:
+--                       Grandparent   Parent
+--          Type              X           X
+--          Constant          X           X
+--          Object            X           X
+--          Subprogram        X           X
+--          Exception         X           X
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      21 Dec 94   SAIC    Modified procedure Create_File
+--      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+--
+--!
+   
+package CA11003_0 is      -- Package OS 
+
+   type File_Descriptor is new Integer;
+   type File_Mode       is (Read_Only, Write_Only, Read_Write);
+
+   Null_File       : constant File_Descriptor := 0;
+   Default_Mode    : constant File_Mode       := Read_Only;
+   File_Data_Error : exception;
+
+   type File_Type is tagged
+     record
+        Descriptor : File_Descriptor := Null_File;
+        Mode       : File_Mode       := Read_Write;
+     end record;
+
+   System_File : File_Type;
+
+   function Next_Available_File return File_Descriptor;
+
+   procedure Reclaim_File_Descriptor;
+
+end CA11003_0;               -- Package OS 
+
+     --=================================================================--
+
+package body CA11003_0 is    -- Package body OS 
+   
+   File_Count : Integer := 0;
+
+   function Next_Available_File return File_Descriptor is
+   begin
+      File_Count := File_Count + 1;
+      return (File_Descriptor(File_Count));
+   end Next_Available_File;
+   --------------------------------------------------
+   procedure Reclaim_File_Descriptor is
+   begin
+      null;                                        -- Dummy processing unit.
+   end Reclaim_File_Descriptor;
+
+end CA11003_0;                          -- Package body OS 
+
+     --=================================================================--
+
+package CA11003_0.CA11003_1 is          -- Child package OS.Operations
+
+   subtype File_Length_Type is Integer range 0 .. 1000;
+   Min_File_Size : File_Length_Type := File_Length_Type'First;
+   Max_File_Size : File_Length_Type := File_Length_Type'Last;
+
+   File_Duplication_Error : exception;
+
+   type Extended_File_Type is new File_Type with private;
+
+   procedure Create_File (Mode : in     File_Mode;
+                          File :    out Extended_File_Type);    
+
+   procedure Duplicate_File (Original  : in     Extended_File_Type;
+                             Duplicate :    out Extended_File_Type);
+
+private
+   type Extended_File_Type is new File_Type with
+      record
+         Blocks : File_Length_Type := Min_File_Size;
+      end record;
+
+   System_Extended_File : Extended_File_Type;
+
+end CA11003_0.CA11003_1;                -- Child Package OS.Operations 
+
+     --=================================================================--
+
+package body CA11003_0.CA11003_1 is     -- Child package body OS.Operations
+
+   procedure Create_File 
+     (Mode : in     File_Mode;
+      File :    out Extended_File_Type) is                 
+   begin
+      File.Descriptor := Next_Available_File;           -- Parent subprogram.
+      File.Mode       := Default_Mode;                  -- Parent constant.
+      File.Blocks     := Min_File_Size;
+   end Create_File;
+   --------------------------------------------------
+   procedure Duplicate_File (Original  : in     Extended_File_Type;
+                             Duplicate :    out Extended_File_Type) is
+   begin
+      Duplicate.Descriptor := Next_Available_File;      -- Parent subprogram.
+      Duplicate.Mode       := Original.Mode;
+      Duplicate.Blocks     := Original.Blocks;
+   end Duplicate_File;
+
+end CA11003_0.CA11003_1;                   -- Child package body OS.Operations
+
+     --=================================================================--
+
+-- This package contains menu selectable operations for manipulating files.
+-- This abstraction builds on the capabilities available from ancestor
+-- packages.
+
+package CA11003_0.CA11003_1.CA11003_2 is   
+
+   procedure News (Mode : in     File_Mode;
+                   File :    out Extended_File_Type);    
+
+   procedure Copy (Original  : in     Extended_File_Type;
+                   Duplicate :    out Extended_File_Type);
+
+   procedure Delete   (File : in Extended_File_Type);
+
+end CA11003_0.CA11003_1.CA11003_2;  -- Grandchild package OS.Operations.Menu
+ 
+     --=================================================================--
+
+-- Grandchild subprogram Validate 
+function  CA11003_0.CA11003_1.CA11003_3 (File : in Extended_File_Type) 
+  return Boolean;     
+
+     --=================================================================--
+
+-- Grandchild subprogram Validate 
+function  CA11003_0.CA11003_1.CA11003_3         
+  (File : in Extended_File_Type)                            -- Parent type.
+  return Boolean is      
+
+   function New_File_Validated (File : Extended_File_Type) 
+       return Boolean is  
+   begin                                                
+      if (File.Descriptor > System_File.Descriptor) and     -- Grandparent
+         (File.Mode in File_Mode ) and                      -- object and type
+         not ((File.Blocks < System_Extended_File.Blocks) or       
+              (File.Blocks > Max_File_Size))                -- Parent object
+      then                                                  -- and constant.
+         return True;
+      else
+         return False;
+      end if;
+   end New_File_Validated;
+      
+begin
+   return (New_File_Validated (File)) and    
+          (File.Descriptor /= Null_File);              -- Grandparent constant.
+                                                 
+end CA11003_0.CA11003_1.CA11003_3;      -- Grandchild subprogram Validate
+
+     --=================================================================--
+
+with CA11003_0.CA11003_1.CA11003_3;
+                                 -- Grandchild package body OS.Operations.Menu
+package body CA11003_0.CA11003_1.CA11003_2 is  
+
+   procedure News (Mode : in     File_Mode;
+                   File :    out Extended_File_Type) is   -- Parent type.
+   begin
+      Create_File (Mode, File);                           -- Parent subprogram.
+      if not CA11003_0.CA11003_1.CA11003_3 (File) then                       
+         raise File_Data_Error;                       -- Grandparent exception.
+      end if;
+   end News;
+   --------------------------------------------------
+   procedure Copy (Original  : in     Extended_File_Type;
+                   Duplicate :    out Extended_File_Type) is
+   begin
+      Duplicate_File (Original, Duplicate);               -- Parent subprogram.
+
+      if Original.Descriptor = Duplicate.Descriptor then
+         raise File_Duplication_Error;                    -- Parent exception.
+      end if;
+
+   end Copy;
+   --------------------------------------------------
+   procedure Delete (File : in Extended_File_Type) is
+   begin
+      Reclaim_File_Descriptor;                            -- Grandparent
+   end Delete;                                            -- subprogram.
+
+end CA11003_0.CA11003_1.CA11003_2;  
+
+     --=================================================================--
+
+with CA11003_0.CA11003_1.CA11003_2;  -- Grandchild Pkg OS.Operations.Menu
+with CA11003_0.CA11003_1.CA11003_3;  -- Grandchild Ftn OS.Operations.Validate
+with Report;
+
+procedure CA11003 is
+
+   package Menu renames CA11003_0.CA11003_1.CA11003_2;
+
+begin
+
+   Report.Test ("CA11003", "Check that a public grandchild can utilize " &
+                "its ancestor unit's visible definitions");
+
+   File_Processing:         -- Validate all of the capabilities contained in 
+                            -- the Menu package by exercising them on specific 
+                            -- files.  This will demonstrate the use of child
+                            -- and grandchild functionality based on components
+                            -- that have been declared in the
+                            -- parent/grandparent package.
+   declare
+
+      function Validate (File : CA11003_0.CA11003_1.Extended_File_Type) 
+        return Boolean renames CA11003_0.CA11003_1.CA11003_3;
+
+      MacWrite_File,
+      Backup_Copy : CA11003_0.CA11003_1.Extended_File_Type;        
+      MacWrite_File_Mode : CA11003_0.File_Mode := CA11003_0.Read_Write;
+                                     
+   begin                                                
+                                                        
+      Menu.News (MacWrite_File_Mode, MacWrite_File);                          
+
+      if not Validate (MacWrite_File) then
+         Report.Failed ("Incorrect initialization of files");
+      end if;
+
+      Menu.Copy (MacWrite_File, Backup_Copy);
+
+      if not (Validate (MacWrite_File) and 
+              Validate (Backup_Copy))
+      then
+         Report.Failed ("Incorrect duplication of files");
+      end if;
+
+      Menu.Delete (Backup_Copy);
+
+   exception
+      when CA11003_0.File_Data_Error =>
+          Report.Failed ("Exception raised during file validation");
+      when CA11003_0.CA11003_1.File_Duplication_Error =>
+          Report.Failed ("Exception raised during file duplication");
+      when others =>
+          Report.Failed ("Unexpected exception in test procedure");
+
+   end File_Processing;
+
+   Report.Result;
+
+end CA11003; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110040.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110040.a
new file mode 100644
index 000000000..72cc6682e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110040.a
@@ -0,0 +1,90 @@
+-- CA110040.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:
+--      See CA110042.AM
+--
+-- TEST DESCRIPTION:
+--      See CA110042.AM
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--      => CA110040.A
+--         CA110041.A
+--         CA110042.AM
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      26 Apr 96   SAIC    ACVC 2.1: Modified prologue; Added pragma 
+--                          Elaborate_Body.
+--
+--!
+
+package CA110040 is                              -- Package Computer_System.
+   pragma Elaborate_Body (CA110040);
+
+   -- Types.
+   type ID_Type                 is range 1 .. 4;
+   type System_Account_Capacity is new ID_Type;
+
+   type Account is tagged 
+      record
+         User_ID : ID_Type;
+      end record;
+
+   -- Constants.
+   Maximum_System_Accounts : constant System_Account_Capacity := 
+     System_Account_Capacity'Last;
+
+   System_Administrator    : constant ID_Type := 
+     ID_Type (System_Account_Capacity'First);
+
+   Administrator_Account   : constant Account := 
+     (User_ID => System_Administrator);
+
+   -- Objects.
+   Total_Accounts           : System_Account_Capacity  := 1;
+
+   -- Exceptions.
+   Illegal_Account          : exception;
+   Account_Limit_Exceeded   : exception;
+
+   -- Subprograms.
+   function Next_Available_ID return ID_Type;
+
+end CA110040;                                -- Package Computer_System.
+
+     --=================================================================--
+
+package body CA110040 is                     -- Package body Computer_System.
+
+   function Next_Available_ID return ID_Type is
+   begin
+      Total_Accounts := Total_Accounts + 1;
+      return (ID_Type(Total_Accounts));
+   end Next_Available_ID;
+
+end CA110040;                                -- Package body Computer_System.
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110041.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110041.a
new file mode 100644
index 000000000..954df7f4d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110041.a
@@ -0,0 +1,118 @@
+-- CA110041.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:
+--      See CA110042.AM
+--
+-- TEST DESCRIPTION:
+--      See CA110042.AM
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         CA110040.A
+--      => CA110041.A
+--         CA110042.AM
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+package CA110040.CA110041 is         -- Child Package Computer_System.Manager
+
+   type User_Account is new Account with private;
+
+   procedure Initialize_User_Account (Acct : out User_Account);
+
+private
+
+-- The private portion of this spec demonstrates that components contained
+-- in the visible part of the parent are directly visible in the private 
+-- part of a public child.
+
+   type Account_Access_Type is (None, Guest, User, System);
+
+   type User_Account is new Account with                   -- Parent type.
+      record
+         Privilege : Account_Access_Type := None;
+      end record;
+
+   System_Account : User_Account := 
+     (User_ID   => Administrator_Account.User_ID,          -- Parent constant.
+      Privilege => System);                                -- User_ID has been
+                                                           -- set to 1.
+   Auditor_Account : User_Account :=
+     (User_ID   => Next_Available_ID,                      -- Parent function.
+      Privilege => System);                                -- User_ID has been
+                                                           -- set to 2.
+   Total_Authorized_Accounts : System_Account_Capacity 
+     renames Total_Accounts;                               -- Parent object.
+
+   Unauthorized_Account : exception 
+     renames Illegal_Account;                              -- Parent exception
+
+end CA110040.CA110041;             -- Child Package Computer_System.Manager
+
+     --=================================================================--
+
+                                 -- Child Package body Computer_System.Manager
+package body CA110040.CA110041 is  
+
+   function  Account_Limit_Reached  return Boolean is
+   begin
+      if Total_Authorized_Accounts = Maximum_System_Accounts then
+         return (True);
+      else
+         return (False);
+      end if;
+   end Account_Limit_Reached;
+   ---------------------------------------------------------------
+   function Valid_Account (Acct : User_Account) return Boolean is
+      Result : Boolean := False; 
+   begin
+      if (Acct.User_ID /= System_Account.User_ID) and
+         (Acct.User_ID /= Auditor_Account.User_ID) 
+      then
+         Result := True;
+      end if;
+      return (Result);
+   end Valid_Account;
+   ---------------------------------------------------------------
+   procedure Initialize_User_Account (Acct : out User_Account) is
+   begin
+      if Account_Limit_Reached then
+         raise Account_Limit_Exceeded;           
+      else                                       
+         Acct.User_ID := Next_Available_ID;
+         Acct.Privilege := User;
+      end if;
+      if not Valid_Account (Acct) then
+         raise Unauthorized_Account;
+      end if;
+   end Initialize_User_Account;
+
+end CA110040.CA110041;          -- Child Package body Computer_System.Manager
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110042.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110042.am
new file mode 100644
index 000000000..800ed8aae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110042.am
@@ -0,0 +1,130 @@
+-- CA110042.AM
+--
+--                             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 private part of a child library unit package can
+--      utilize its parent unit's visible definitions.
+--
+-- TEST DESCRIPTION:
+--      Declare a public library unit package and child package, with the
+--      child package having a private part in the specification.  Within
+--      this child private part, make use of components that are declared in
+--      the visible part of the parent.
+--
+--      Demonstrate visibility to the following parent components in the 
+--      child private part:
+--                          Parent
+--          Type              X
+--          Constant          X
+--          Object            X           
+--          Subprogram        X           
+--          Exception         X           
+--
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         CA110040.A
+--         CA110041.A
+--      => CA110042.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+with Report;
+with CA110040.CA110041;
+
+procedure CA110042 is
+
+      package System_Manager renames CA110040.CA110041;
+      use CA110040;
+      User1, User2, User3 : System_Manager.User_Account;
+
+begin
+
+   Report.Test ("CA110042", "Check that the private part of a child "     &
+                            "library unit package can utilize its "       &
+                            "parent unit's visible definitions");
+
+   Assign_New_Accounts:            -- This code simulates the entering of new
+                                   -- user accounts into a computer system.
+                                   -- It also simulates the processing that
+                                   -- could occur when the limit on system
+                                   -- accounts has been exceeded.
+
+                                   -- This processing block demonstrates the
+                                   -- use of child package functionality that
+                                   -- takes advantage of components declared in
+                                   -- the parent package.
+   begin
+
+      if Total_Accounts /= 2 then
+         Report.Failed ("Incorrect number of accounts currently allocated");
+      end if;                                         -- At this point, both
+                                                      -- System_Account and
+                                                      -- Auditor_Account have
+                                                      -- been declared and
+                                                      -- initialized in package
+                                                      -- CA110040.CA110041.
+
+      System_Manager.Initialize_User_Account (User1); -- User_ID has been
+                                                      -- set to 3.
+
+      System_Manager.Initialize_User_Account (User2); -- User_ID has been
+                                                      -- set to 4, which
+                                                      -- is the last value
+                                                      -- defined for the
+                                                      -- CA110040.ID_Type
+                                                      -- range.
+
+      System_Manager.Initialize_User_Account (User3); -- This final call will 
+                                                      -- result in an 
+                                                      -- Account_Limit_Exceeded
+                                                      -- exception being raised.
+
+      Report.Failed ("Control should have transferred with exception");
+
+   exception
+
+      when Account_Limit_Exceeded =>
+         if (not (Administrator_Account.User_ID = ID_Type'First)) or
+           (User2.User_ID /= CA110040.ID_Type'Last)
+         then
+            Report.Failed ("Account initialization failure");
+         end if;
+      when others =>
+         Report.Failed ("Unexpected exception raised");
+
+   end Assign_New_Accounts;
+
+   if (User1.User_ID /= 3) or (User2.User_ID /= 4) then
+      Report.Failed ("Improper initialization of user accounts");
+   end if;
+
+   Report.Result;
+
+end CA110042;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110050.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110050.a
new file mode 100644
index 000000000..88455762c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110050.a
@@ -0,0 +1,99 @@
+-- CA110050.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:
+--      See CA110051.AM
+--
+-- TEST DESCRIPTION:
+--      See CA110051.AM
+--
+-- TEST FILES:
+--      The test consists of the following files:
+--
+--      => CA110050.A
+--         CA110051.AM
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      21 Dec 94   SAIC    Modified discriminant type 
+--      26 Apr 96   SAIC    ACVC 2.1: Modified prologue; Added pragma 
+--                          Elaborate_Body.
+--
+--!
+  
+package CA110050_0 is                   -- Package Messages.
+   pragma Elaborate_Body (CA110050_0);
+
+   type Descriptor is new Integer;
+
+   Null_Descriptor_Value   : constant Descriptor := 0;
+   Null_Message_Descriptor : constant Descriptor := 0;
+
+   type Message_Type is tagged 
+      record
+         Number : Descriptor := Null_Message_Descriptor;
+      end record;
+
+   function Next_Available_Message return Descriptor;
+
+end CA110050_0;                         -- Package Messages.
+
+     --=================================================================--
+
+package body CA110050_0 is              -- Package body Messages.
+
+   Message_Count : Integer := 0;
+
+   function Next_Available_Message return Descriptor is
+   begin
+      Message_Count := Message_Count + 5;
+      return (Descriptor(Message_Count));
+   end Next_Available_Message;
+
+end CA110050_0;                         -- Package body Messages.
+
+     --=================================================================--
+
+package CA110050_0.CA110050_1 is        -- Child package Messages.Text
+
+   subtype Default_Length is Natural range 0 .. 80;
+
+   type Text_Type (Max_Length : Default_Length := 0) is
+      record
+         Length      : Default_Length := Max_Length;
+         Text_Field  : String (1 .. Max_Length);
+      end record;
+
+   type Text_Message_Type is new Message_Type with
+      record
+         Text : Text_Type;
+      end record;
+
+   Null_Text    : Text_Type (0);                     -- Null range for 
+                                                     -- Text_Field component.
+
+end CA110050_0.CA110050_1;              -- Child package Messages.Text
+--
+-- No package body needed for this specification.
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110051.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110051.am
new file mode 100644
index 000000000..91af06823
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca110051.am
@@ -0,0 +1,224 @@
+-- CA110051.AM
+--
+--                             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 entities and operations declared in a package can be used
+--      in the private part of a child of a child of the package.
+--
+-- TEST DESCRIPTION:
+--      Declare a series of library unit packages -- parent, child, and 
+--      grandchild.  The grandchild package will have a private part.
+--      From within the private part of the grandchild, make use of 
+--      components declared in the parent and grandparent packages.
+--
+-- TEST FILES:
+--      The test consists of the following files:
+--
+--         CA110050.A
+--      => CA110051.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+                                    -- Grandchild Package Message.Text.Encoded
+package CA110050_0.CA110050_1.CA110050_2 is  
+
+   type Coded_Message is new Text_Message_Type with private;
+
+   procedure Send (Message : in     Coded_Message;
+                   Confirm :    out Coded_Message;
+                   Status  :    out Boolean);
+
+   function Encode (Message : Text_Message_Type) return Coded_Message;
+   function Decode (Message : Coded_Message)     return Boolean;
+   function Test_Connection                      return Boolean;
+
+private
+
+   Uncoded : Descriptor renames Null_Descriptor_Value; -- Grandparent object.
+
+   type Coded_Message is new Text_Message_Type with    -- Parent type.
+      record
+         Key       : Descriptor := Uncoded;
+         Coded_Key : Descriptor := Next_Available_Message;
+                                 -- Grandparent type, grandparent function.
+         Scrambled : Text_Type  := Null_Text;          -- Parent object.
+      end record;                                      
+
+   Coded_Msg : Coded_Message;
+
+   type Blank_Message is new Message_Type with         -- Grandparent type.
+      record
+         ID        : Descriptor := Next_Available_Message;
+                                 -- Grandparent type, grandparent function.
+      end record;                                      
+
+   Test_Message     : Blank_Message;
+
+   Confirm_String   : constant String := "OK";
+   Scrambled_String : constant String := "KO";
+
+   Confirm_Text : Text_Type (Confirm_String'Length) :=
+     (Max_Length => Confirm_String'Length,
+      Length     => Confirm_String'Length,
+      Text_Field => Confirm_String);
+
+   Scrambled_Text : Text_Type (Scrambled_String'Length) :=
+     (Max_Length => Scrambled_String'Length,
+      Length     => Scrambled_String'Length,
+      Text_Field => Scrambled_String);
+     
+end CA110050_0.CA110050_1.CA110050_2; -- Grandchild Pkg Message.Text.Encoded
+
+     --=================================================================--
+
+                               -- Grandchild Package body Message.Text.Encoded
+package body CA110050_0.CA110050_1.CA110050_2 is 
+
+   procedure Send (Message : in     Coded_Message;
+                   Confirm :    out Coded_Message;
+                   Status  :    out Boolean) is
+
+      Confirmation_Message : Coded_Message :=
+        (Number    => Message.Number,
+         Text      => Confirm_Text,
+         Key       => Message.Number,
+         Coded_Key => Message.Number,
+         Scrambled => Scrambled_Text);  
+
+   begin                                          -- Dummy processing unit.
+      Confirm := Confirmation_Message;
+      if Confirm.Number /= Null_Message_Descriptor then
+         Status := True;                            
+      else
+         Status := False;
+      end if;
+   end Send;
+   -------------------------------------------------------------------------
+   function Encode (Message : Text_Message_Type)  return Coded_Message is
+   begin
+      Coded_Msg.Number       := Message.Number;
+      if Message.Text.Length > 0 then
+         Coded_Msg.Text      := Message.Text;     -- Record assignment.
+         Coded_Msg.Key       := Message.Number;   -- Same as msg number.
+         Coded_Msg.Coded_Key := Message.Number;   -- Same as msg number.
+         Coded_Msg.Scrambled := Message.Text;     -- Dummy processing.
+      end if;
+      return (Coded_Msg);
+   end Encode;
+   -------------------------------------------------------------------------
+   function Decode (Message : Coded_Message) return Boolean is
+      Decoded : Boolean := False;
+   begin                                                       
+      if (Message.Text.Length = Confirm_String'Length)        and then
+         (Message.Text.Text_Field = Confirm_String)           and then
+         (Message.Scrambled.Length = Scrambled_String'Length) and then
+         (Message.Scrambled.Text_Field = Scrambled_String)    and then
+         (Message.Coded_Key = 15)
+      then
+         Decoded := True;
+      end if;
+      return (Decoded);
+   end Decode;
+   -------------------------------------------------------------------------
+   function Test_Connection return Boolean is
+   begin
+      return Test_Message.Id = 10;
+   end Test_Connection;
+
+end CA110050_0.CA110050_1.CA110050_2;        
+                               -- Grandchild Package body Message.Text.Encoded
+ 
+     --=================================================================--
+
+with CA110050_0.CA110050_1.CA110050_2; 
+with Report;
+
+procedure CA110051 is
+
+   package Message_Package renames CA110050_0.CA110050_1;
+   package Code_Package    renames CA110050_0.CA110050_1.CA110050_2; 
+
+   Message_String : constant String := "One if by land, two if by sea";
+
+   Message_Text   : Message_Package.Text_Type (Message_String'Length) := 
+     (Max_Length => Message_String'Length,
+      Length     => Message_String'Length,
+      Text_Field => Message_String);
+
+   Message : Message_Package.Text_Message_Type := 
+     (Number => CA110050_0.Next_Available_Message,
+      Text   => Message_Text);
+
+   Confirmation_Message : Code_Package.Coded_Message;
+   Verification_OK      : Boolean := False;
+   Transmission_OK      : Boolean := False;
+
+begin
+
+-- This test simulates the use of child library unit packages to implement
+-- a message encoding and transmission scheme.  The full capability of the
+-- encoding and transmission mechanisms are not developed here, but the 
+-- intent is to demonstrate that a grandchild library unit package with a
+-- private part will provide the framework for this type of processing.
+
+   Report.Test ("CA110051", "Check that entities and operations declared "  &
+                            "in a package can be used in the private part " & 
+                            "of a child of a child of the package");
+
+                            -- The following code demonstrates the use
+                            -- of functionality contained in a grandchild
+                            -- library unit.  The grandchild unit made use
+                            -- of components declared in the ancestor
+                            -- packages.
+   
+   Code_Package.Send                            -- Message object declared
+     (Message => Code_Package.Encode (Message), -- above in "encoded" by a
+      Confirm => Confirmation_Message,          -- call to grandchild pkg
+      Status  => Transmission_OK);              -- function call, reseting
+                                                -- fields and returning a
+                                                -- coded message to the
+                                                -- parameter.  The confirm
+                                                -- parameter receives an
+                                                -- encoded message value
+                                                -- from proc Send, which is 
+                                                -- "decoded"/verified below.
+
+   if not Code_Package.Test_Connection then
+      Report.Failed ("Bad initialization");
+   end if;
+
+   Verification_OK := Code_Package.Decode (Confirmation_Message);
+
+   if not (Transmission_OK and Verification_OK) then
+      Report.Failed ("Message transmission failure");
+   end if;
+
+   Report.Result;
+
+end CA110051;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11006.a
new file mode 100644
index 000000000..5cd21fe1f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11006.a
@@ -0,0 +1,211 @@
+-- CA11006.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 private part of a child library unit can utilize
+--      its parent unit's private definition.
+--
+-- TEST DESCRIPTION:
+--      Declare a package and public child package, both with private 
+--      parts.  The child package will have a private extension of a type 
+--      declared in the parent's private part.  In addition, the private 
+--      part of the child package specification will make use of some of 
+--      the components declared in the private part of the parent.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+--
+--!
+
+package CA11006_0 is      -- Package File_Package 
+
+   type File_Descriptor is private;
+   type File_Mode       is (Read_Only, Write_Only, Read_Write);
+   type File_Type       is tagged private;
+
+   function  Next_Available_File return File_Descriptor;
+
+private
+
+   type File_Measure    is range 0 .. 1000;
+   type File_Descriptor is new Integer;
+
+   Null_File       : constant File_Descriptor := 0;
+   Default_Mode    : constant File_Mode       := Read_Write;
+
+   type File_Type is tagged
+     record
+        Descriptor : File_Descriptor := Null_File;
+        Mode       : File_Mode       := Default_Mode;
+     end record;
+
+   System_File : File_Type;
+
+end CA11006_0;               -- Package File_Package  
+
+     --=================================================================--
+
+package body CA11006_0 is    -- Package File_Package  
+   
+   File_Count : Integer := 0;
+
+   function Next_Available_File return File_Descriptor is
+   begin
+      File_Count := File_Count + 1;
+      return File_Descriptor (File_Count);
+   end Next_Available_File;
+
+end CA11006_0;               -- Package File_Package   
+
+     --=================================================================--
+
+package CA11006_0.CA11006_1 is        -- Child package File_Package.Operations
+
+   type File_Length_Type   is private;
+   type Extended_File_Type is new File_Type with private;
+
+   System_Extended_File : constant Extended_File_Type;
+
+   procedure Create_File (Mode : in     File_Mode;
+                          File :    out Extended_File_Type);    
+
+   procedure Compress_File (Original        : in     Extended_File_Type;
+                            Compressed_File :    out Extended_File_Type);
+
+   function  Validate (File : in Extended_File_Type) return Boolean;
+
+   function  Validate_Compression (File : in Extended_File_Type) 
+     return Boolean;
+                                   -- These two validation functions provide
+                                   -- the capability to check the private
+                                   -- components defined in the parent and
+                                   -- child packages from within the client
+                                   -- program.
+private
+
+   type File_Length_Type is new File_Measure;       -- Parent private type.
+
+   Min_File_Size : File_Length_Type := File_Length_Type'First;
+   Max_File_Size : File_Length_Type := File_Length_Type'Last;
+
+   type Extended_File_Type is new File_Type with        -- Parent type.
+      record
+         Blocks : File_Length_Type := Min_File_Size;
+      end record;
+
+   System_Extended_File : constant Extended_File_Type :=
+     (Descriptor => System_File.Descriptor,      -- Parent private object.
+      Mode       => Read_Only,                   -- Parent enumeration literal.
+      Blocks     => Min_File_Size);
+
+
+end CA11006_0.CA11006_1;             -- Child Package File_Package.Operations
+
+     --=================================================================--
+
+                                -- Child package body File_Package.Operations
+package body CA11006_0.CA11006_1 is  
+
+   procedure Create_File 
+     (Mode : in     File_Mode; 
+      File :    out Extended_File_Type) is                 
+   begin
+      File.Descriptor := Next_Available_File;    -- Parent subprogram.
+      File.Mode       := Default_Mode;           -- Parent private constant.
+      File.Blocks     := Max_File_Size;
+   end Create_File;
+   ------------------------------------------------------------------------
+   procedure Compress_File (Original        : in     Extended_File_Type;
+                            Compressed_File :    out Extended_File_Type) is
+   begin
+      Compressed_File.Descriptor := Next_Available_File;      
+      Compressed_File.Mode       := Read_Only;
+      Compressed_File.Blocks     := Original.Blocks / 2;  -- Simulated file
+   end Compress_File;                                     -- compression.
+   ------------------------------------------------------------------------
+   function  Validate (File : in Extended_File_Type) return Boolean is      
+   begin
+      if ((File.Descriptor /= System_Extended_File.Descriptor) and    
+          (File.Mode = Read_Write)                             and
+          (File.Blocks = Max_File_Size))                       then
+         return True;
+      else
+         return False;
+      end if;
+   end Validate;
+   ------------------------------------------------------------------------
+   function  Validate_Compression (File : in Extended_File_Type) 
+      return Boolean is      
+   begin
+      if ((File.Descriptor /= System_File.Descriptor) and    
+          (File.Mode = Read_Only)                     and
+          (File.Blocks = Max_File_Size/2))            then
+         return True;
+      else
+         return False;
+      end if;
+   end Validate_Compression;
+
+end CA11006_0.CA11006_1;         -- Child package body File_Package.Operations
+
+     --=================================================================--
+
+with CA11006_0.CA11006_1;        -- with Child package File_Package.Operations
+with Report;
+
+procedure CA11006 is
+
+   package File      renames CA11006_0;
+   package File_Ops  renames CA11006_0.CA11006_1;            
+
+   Validation_File_Mode : File.File_Mode := File.Read_Only;
+   Validation_File,
+   Storage_Copy         : File_Ops.Extended_File_Type;     
+
+begin
+
+   Report.Test ("CA11006", "Check that the private part of a child "  &
+                           "library unit can utilize its parent "     &
+                           "unit's private definition");
+
+   File_Ops.Create_File (Validation_File_Mode, Validation_File);
+
+   if not File_Ops.Validate (Validation_File) then
+      Report.Failed ("Incorrect initialization of file");
+   end if;
+
+   File_Ops.Compress_File (Validation_File, Storage_Copy);
+
+   if not (File_Ops.Validate (Validation_File) and 
+           File_Ops.Validate_Compression (Storage_Copy))
+   then
+      Report.Failed ("Incorrect compression of file");
+   end if;
+
+   Report.Result;
+
+end CA11006; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11007.a
new file mode 100644
index 000000000..c4a6789ab
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11007.a
@@ -0,0 +1,228 @@
+-- CA11007.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 private part of a grandchild library unit can
+--      utilize its grandparent unit's private definition.
+--
+-- TEST DESCRIPTION:
+--      Declare a package, child package, and grandchild package, all 
+--      with private parts in their specifications.  
+--
+--      The private part of the grandchild package will make use of components
+--      that have been declared in the private part of the grandparent
+--      specification.
+--
+--      The child package demonstrates the extension of a parent file type 
+--      into an abstraction of an analog file structure. The grandchild package
+--      extends the grandparent file type into an abstraction of a digital 
+--      file structure, and provides conversion capability to/from the parent 
+--      analog file structure.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+  
+package CA11007_0 is                                -- Package File_Package 
+
+   type File_Descriptor is private;
+   type File_Type       is tagged private;
+
+   function  Next_Available_File return File_Descriptor;
+
+private
+
+   type File_Measure_Type is range 0 .. 1000;
+   type File_Descriptor   is new Integer;
+
+   Null_Measure : constant File_Measure_Type := File_Measure_Type'First;
+   Null_File    : constant File_Descriptor   := 0;
+
+   type File_Type is tagged
+     record
+        Descriptor : File_Descriptor := Null_File;
+     end record;
+
+end CA11007_0;                                 -- Package File_Package  
+
+     --=================================================================--
+
+package body CA11007_0 is                      -- Package body File_Package  
+
+   File_Count : Integer := 0;
+
+   function Next_Available_File return File_Descriptor is
+   begin
+      File_Count := File_Count + 1;
+      return File_Descriptor (File_Count);
+   end Next_Available_File;
+
+end CA11007_0;                                 -- Package body File_Package   
+
+     --=================================================================--
+
+package CA11007_0.CA11007_1 is                 -- Child package Analog
+
+   type    Analog_File_Type is new File_Type with private;
+
+private
+
+   type Wavelength_Type is new File_Measure_Type;
+
+   Min_Wavelength : constant Wavelength_Type := Wavelength_Type'First;
+
+   type Analog_File_Type is new File_Type with          -- Parent type.
+      record                                           
+         Wavelength : Wavelength_Type := Min_Wavelength;
+      end record;
+
+end CA11007_0.CA11007_1;                        -- Child package Analog
+
+     --=================================================================--
+
+package CA11007_0.CA11007_1.CA11007_2 is        -- Grandchild package Digital
+
+   type    Digital_File_Type is new File_Type with private;
+
+   procedure Recording (File : out Digital_File_Type);    
+
+   procedure Convert (From : in     Analog_File_Type;
+                      To   :    out Digital_File_Type);
+
+   function Validate         (File : in Digital_File_Type) return Boolean;
+   function Valid_Conversion (To : Digital_File_Type) return Boolean;
+   function Valid_Initial (From : Analog_File_Type) return Boolean;
+
+private
+
+   type Track_Type is new File_Measure_Type;          -- Grandparent type.
+
+   Min_Tracks : constant Track_Type := 
+     Track_Type (Null_Measure) + Track_Type'First;    -- Grandparent private 
+   Max_Tracks : constant Track_Type :=                -- constant.
+     Track_Type (Null_Measure) + Track_Type'Last;
+
+   type Digital_File_Type is new File_Type with       -- Grandparent type.  
+      record
+         Tracks : Track_Type := Min_Tracks;
+      end record;
+
+end CA11007_0.CA11007_1.CA11007_2;             -- Grandchild package Digital
+
+     --=================================================================--
+
+                                          -- Grandchild package body Digital
+package body CA11007_0.CA11007_1.CA11007_2 is  
+
+   procedure Recording (File : out Digital_File_Type) is
+   begin
+      File.Descriptor := Next_Available_File;    -- Assign new file descriptor.
+      File.Tracks     := Max_Tracks;             -- Change initial value.
+   end Recording;
+   --------------------------------------------------------------------------
+   procedure Convert (From : in     Analog_File_Type;
+                      To   :    out Digital_File_Type) is
+   begin
+      To.Descriptor := From.Descriptor + 100;            -- Dummy conversion.
+      To.Tracks     := Track_Type (From.Wavelength) / 2;
+   end Convert;                                     
+   --------------------------------------------------------------------------
+   function  Validate (File : in Digital_File_Type) return Boolean is
+      Result : Boolean := False;
+   begin
+      if not (File.Tracks /= Max_Tracks) then
+         Result := True;
+      end if;
+      return Result;                     
+   end Validate;
+   --------------------------------------------------------------------------
+   function Valid_Conversion (To : Digital_File_Type) return Boolean is
+   begin
+      return (To.Descriptor = 100) and (To.Tracks = (Min_Tracks / 2));
+   end Valid_Conversion;
+   --------------------------------------------------------------------------
+   function Valid_Initial (From : Analog_File_Type) return Boolean is
+   begin
+      return (From.Wavelength = Min_Wavelength);     -- Validate initial 
+   end Valid_Initial;                                -- conditions.  
+
+end CA11007_0.CA11007_1.CA11007_2;     -- Grandchild package body Digital
+
+     --=================================================================--
+
+with CA11007_0.CA11007_1.CA11007_2;    -- with Grandchild package Digital
+with Report;
+
+procedure CA11007 is
+
+   package Analog  renames CA11007_0.CA11007_1;
+   package Digital renames CA11007_0.CA11007_1.CA11007_2;            
+
+   Original_Digital_File,
+   Converted_Digital_File : Digital.Digital_File_Type;
+
+   Original_Analog_File : Analog.Analog_File_Type;
+
+begin
+   
+   -- This code demonstrates how private extensions could be utilized
+   -- in child packages to allow for recording on different media.  
+   -- The processing contained in the procedures and functions is
+   -- "dummy" processing, not intended to perform actual recording,
+   -- conversion, or validation operations, but simply to demonstrate 
+   -- this type of structural decomposition  as a possible solution to 
+   -- a user's design problem.
+
+   Report.Test ("CA11007", "Check that the private part of a grandchild "  &
+                           "library unit can utilize its grandparent    "  &
+                           "unit's private definition");
+
+   if not Digital.Valid_Initial (Original_Analog_File)
+   then
+      Report.Failed ("Incorrect initialization of Analog File");
+   end if;
+
+   ---
+
+   Digital.Convert (From => Original_Analog_File,        -- Convert file to
+                    To   => Converted_Digital_File);     -- digital format.
+
+   if not Digital.Valid_Conversion (To => Converted_Digital_File) then
+      Report.Failed ("Incorrect conversion of analog file");
+   end if;
+             
+   ---
+
+   Digital.Recording (Original_Digital_File);            -- Create file in
+                                                         -- digital format.
+   if not Digital.Validate (Original_Digital_File) then
+      Report.Failed ("Incorrect recording of digital file");
+   end if;
+
+   Report.Result;
+
+end CA11007; 
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11008.a
new file mode 100644
index 000000000..1161fbe0c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11008.a
@@ -0,0 +1,216 @@
+-- CA11008.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 private child package can use entities declared in the
+--      visible part of its parent unit.
+--      
+-- TEST DESCRIPTION:
+--      Declare a parent package containing types and objects used 
+--      by the system. Declare a private child package that uses the parent
+--      components to provide functionality to the system.  
+--
+--      The tagged file type defined in the parent has defaults for all
+--      component fields.  Prior to initialization, these values are checked
+--      to ensure a correct start condition.  The initial subprogram is
+--      called, which utilizes the functionality provided in the private
+--      child package.  This subprogram changes the fields of the file object
+--      to something other than the default values, and this process is then
+--      verified at the conclusion of the test.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+  
+package CA11008_0 is               -- Package OS.
+
+   type File_Descriptor_Type is new Integer;
+   type File_Name_Type       is new String (1 .. 11);
+   type Permission_Type      is (None, User, System, Bypass);
+   type File_Mode_Type       is (Read_Only, Write_Only, Read_Write);
+   type File_Status_Type     is (Open, Closed);
+
+   Default_Descriptor : constant File_Descriptor_Type := 0;
+   Default_Permission : constant Permission_Type      := None;
+   Default_Mode       : constant File_Mode_Type       := Read_Only;
+   Default_Status     : constant File_Status_Type     := Closed;
+   Default_Filename   : constant File_Name_Type       := "           ";
+
+   Max_Files          : constant File_Descriptor_Type := 100;
+   Constant_Name      : constant File_Name_Type       := "AdaFileName";
+   File_Counter       : Integer                       := 0;
+
+   type File_Type is tagged
+      record
+         Descriptor     : File_Descriptor_Type := Default_Descriptor;
+         Name           : File_Name_Type       := Default_Filename;
+         Acct_Access    : Permission_Type      := Default_Permission;
+         Mode           : File_Mode_Type       := Default_Mode;
+         Current_Status : File_Status_Type     := Default_Status;
+      end record;
+
+   type File_Array_Type is array (1 .. Max_Files) of File_Type;
+
+   File_Table : File_Array_Type;
+
+   --
+
+   function Get_File_Name return File_Name_Type;
+
+   function Initialize_File return File_Descriptor_Type;
+
+end CA11008_0;                     -- Package OS.
+
+     --=================================================================--
+
+-- Subprograms that perform the actual file operations are contained in a
+-- private package so that they are not accessible to any client.
+
+private package CA11008_0.CA11008_1 is  -- Package OS.Internals
+
+   Private_File_Counter : Integer renames File_Counter;          -- Parent 
+                                                                 -- object.
+   function Initialize 
+     (File_Name : File_Name_Type := Get_File_Name;      -- Parent function.
+      File_Mode : File_Mode_Type := Read_Write)         -- Parent literal.
+     return File_Descriptor_Type;                       -- Parent type.
+
+end CA11008_0.CA11008_1;             -- Package OS.Internals
+
+     --=================================================================--
+
+package body CA11008_0.CA11008_1 is  -- Package body OS.Internals
+
+   function Next_Available_File return File_Descriptor_Type is
+   begin
+      Private_File_Counter := Private_File_Counter + 1; 
+      return (File_Descriptor_Type(File_Counter));
+   end Next_Available_File;
+   -----------------------------------------------------------------
+   function Initialize 
+     (File_Name : File_Name_Type := Get_File_Name; -- Parent function
+      File_Mode : File_Mode_Type := Read_Write)    -- Parent literal
+     return File_Descriptor_Type is                -- Parent type
+      Number : File_Descriptor_Type;                         
+   begin
+      Number := Next_Available_File;
+      File_Table(Number).Descriptor := Number;     -- Parent object
+      File_Table(Number).Name := File_Name;        -- Default parameter value 
+      File_Table(Number).Mode := File_Mode;        -- Default parameter value
+      File_Table(Number).Acct_Access := User;
+      File_Table(Number).Current_Status := Open;
+      return (Number);
+   end Initialize;
+
+end CA11008_0.CA11008_1;           -- Package body OS.Internals
+
+     --=================================================================--
+
+with CA11008_0.CA11008_1;          -- Private child package "withed" by
+                                   -- parent body.
+
+package body CA11008_0 is          -- Package body OS
+
+   function Get_File_Name return File_Name_Type is
+   begin
+      return (Constant_Name);   -- Of course if this was a real function, the
+   end Get_File_Name;           -- user would be asked to input a name, or
+                                -- there would be some type of similar process.
+
+   -- This subprogram utilizes a call to a subprogram contained in a private
+   -- child to perform the actual processing.
+
+   function Initialize_File return File_Descriptor_Type is
+   begin
+     return (CA11008_0.CA11008_1.Initialize);    -- No parameters are needed, 
+                                                 -- since defaults have been 
+                                                 -- provided.
+   end Initialize_File;
+
+end CA11008_0;                         -- Package body OS
+
+     --=================================================================--
+
+with CA11008_0;                        -- with Package OS.
+with Report;
+
+procedure CA11008 is
+
+   package OS renames CA11008_0;
+   use OS;
+   Ada_File_Key : File_Descriptor_Type := Default_Descriptor;
+
+begin
+
+   -- This test indicates one approach to file management operations.
+   -- It is not intended to demonstrate full functionality, but rather
+   -- that the use of a private child package can provide a solution
+   -- to a user situation, that being the implementation of certain functions
+   -- being provided in a child package, with the parent package body 
+   -- utilizing these implementations.
+
+   Report.Test ("CA11008", "Check that a private child package can use "   &
+                           "entities declared in the visible part of its " &
+                           "parent unit");
+
+   -- Check initial conditions of the first entry in the file table.
+   -- These are all default values provided in the declaration of the 
+   -- type File_Type.
+
+   if (Ada_File_Key                 /= Default_Descriptor)  or else
+      (File_Table(1).Descriptor     /= (Default_Descriptor) or
+      (File_Table(1).Name           /= Default_Filename))   or else
+      (File_Table(1).Acct_Access    /= (Default_Permission) or
+      (File_Table(1).Mode           /= Default_Mode))       or else
+      (File_Table(1).Current_Status /= Default_Status)
+   then
+      Report.Failed ("Initial condition failure");
+   end if;
+   
+   -- Call the initialization function.  This will result in the resetting
+   -- of the fields associated with the first entry in the File_Table (this
+   -- is the first call of Initialize_File).  
+   -- No parameters are necessary for this call, due to the default values
+   -- provided in the private child package routine Initialize.
+   
+   Ada_File_Key := Initialize_File;
+
+   -- Verify that the initial conditions of the file table component have
+   -- been properly modified by the initialization function.
+
+   if not ((File_Table(1).Descriptor     = Ada_File_Key)         and then
+           (File_Table(1).Name           = Constant_Name) and then
+           (File_Table(1).Acct_Access    = User)              and then
+           not ((File_Table(1).Mode      = Default_Mode)      or else
+                (File_Table(1).Current_Status = Default_Status)))
+   then
+      Report.Failed ("Initialization processing failure");
+   end if;
+
+   Report.Result;
+
+end CA11008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11009.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11009.a
new file mode 100644
index 000000000..84d7dc2b3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11009.a
@@ -0,0 +1,246 @@
+-- CA11009.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 private child package can use entities declared in the
+--      visible part of the parent unit of its parent unit.
+--
+-- TEST DESCRIPTION:
+--      Declare a parent package containing types and objects used by the 
+--      system.  Declare a public child package that provides a visible 
+--      interface to the system functionality.
+--      Declare a private grandchild package that uses the visible grandparent
+--      components to provide the actual functionality to the system. 
+--
+--      The public child (parent of the private grandchild) uses the 
+--      functionality of its private child (grandchild package) to provide 
+--      the visible interface to operations of the system.
+--
+--      The test itself will utilize the visible interface provided in the 
+--      public child package to demonstrate a possible structure for
+--      file management.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate_body.
+--
+--!
+
+package CA11009_0 is               -- Package OS.
+   pragma Elaborate_Body (CA11009_0);
+
+   type File_Descriptor_Type is new Integer;
+   type File_Name_Type       is new String (1 .. 11);
+   type Permission_Type      is (None, User, System, Bypass);
+   type File_Mode_Type       is (Read_Only, Write_Only, Read_Write);
+   type File_Status_Type     is (Open, Closed);
+
+   Default_Descriptor : constant File_Descriptor_Type := 0;
+   Default_Permission : constant Permission_Type      := None;
+   Default_Mode       : constant File_Mode_Type       := Read_Only;
+   Default_Status     : constant File_Status_Type     := Closed;
+   Default_Filename   : constant File_Name_Type       := "           ";
+
+   Max_Files          : constant File_Descriptor_Type := 10;
+   An_Ada_File_Name   : constant File_Name_Type       := "AdaFileName";
+   File_Counter       : Integer                       := 0;
+
+   type File_Type is tagged
+      record
+         Descriptor     : File_Descriptor_Type := Default_Descriptor;
+         Name           : File_Name_Type       := Default_Filename;
+         Acct_Access    : Permission_Type      := Default_Permission;
+         Mode           : File_Mode_Type       := Default_Mode;
+         Current_Status : File_Status_Type     := Default_Status;
+      end record;
+
+   type File_Array_Type is array (1 .. Max_Files) of File_Type;
+
+   File_Table : File_Array_Type;
+
+   --
+
+   function Get_File_Name return File_Name_Type;
+
+end CA11009_0;                     -- Package OS.
+
+     --=================================================================--
+
+package body CA11009_0 is          -- Package body OS.
+
+   function Get_File_Name return File_Name_Type is
+   begin
+      return (An_Ada_File_Name);   -- Processing would be replace by a user
+                                   -- prompt in a functioning system.
+   end Get_File_Name;           
+                                
+end CA11009_0;                     -- Package body OS.
+
+     --=================================================================--
+
+package CA11009_0.CA11009_1 is     -- Child Package OS.File_Manager
+
+   -- This package simulates a visible interface for the Operating System.
+   -- The actual processing performed by this routine is encapsulated
+   -- in the routines of private child package Internals, which is "withed"
+   -- by the body of this package.
+
+   procedure Create_File (Mode      : in     File_Mode_Type;
+                          File_Key  :    out File_Descriptor_Type);
+
+end CA11009_0.CA11009_1;           -- Child Package OS.File_Manager
+
+     --=================================================================--
+
+-- Subprogram that performs the actual file operation is contained in a
+-- private package so that it is not accessible to any client, and can be
+-- modified/extended without requiring recompilation of the clients of the
+-- parent (since this package is "withed" by the parent body only.)
+
+
+                               -- Grandchild Package OS.File_Manager.Internals
+private package CA11009_0.CA11009_1.CA11009_2 is  
+
+   Initial_Permission : constant Permission_Type  := User;  -- Grandparent
+   Initial_Status     : constant File_Status_Type := Open;  -- literals.
+   Initial_Filename   : constant File_Name_Type   :=  -- Grandparent type.
+     Get_File_Name;                                   -- Grandparent function.
+
+   function Create (Mode : File_Mode_Type)                      
+     return File_Descriptor_Type;                     -- Grandparent type.
+
+end CA11009_0.CA11009_1.CA11009_2;   
+                          -- Grandchild Package OS.File_Manager.Internals
+
+     --=================================================================--
+
+                          -- Grandchild Package body OS.File_Manager.Internals
+package body CA11009_0.CA11009_1.CA11009_2 is  
+
+   function Next_Available_File return File_Descriptor_Type is
+   begin
+      File_Counter := File_Counter + 1;              -- Grandparent object.
+      return (File_Descriptor_Type(File_Counter));
+   end Next_Available_File;
+   -------------------------------------------------------------------------
+   function Create (Mode : File_Mode_Type)           -- Grandparent literal.
+     return File_Descriptor_Type is
+      Number : File_Descriptor_Type;                 -- Grandparent type.
+   begin
+      Number := Next_Available_File;
+      File_Table(Number).Descriptor     := Number;   -- Grandparent object.
+      File_Table(Number).Name           := Initial_Filename;
+      File_Table(Number).Mode           := Mode;     -- Parameter.
+      File_Table(Number).Acct_Access    := Initial_Permission;
+      File_Table(Number).Current_Status := Initial_Status;
+      return (Number);
+   end Create;
+
+end CA11009_0.CA11009_1.CA11009_2;  
+                          -- Grandchild Package body OS.File_Manager.Internals
+
+     --=================================================================--
+
+                                     -- "With" of a child package 
+                                     -- by the parent body.
+with CA11009_0.CA11009_1.CA11009_2;  -- Grandchild OS.File_Manager.Internals
+
+package body CA11009_0.CA11009_1 is  -- Child Package body OS.File_Manager
+
+   package Internal renames CA11009_0.CA11009_1.CA11009_2;            
+
+   -- These subprograms utilize calls to subprograms contained in a private
+   -- sibling to perform the actual processing.
+
+   procedure Create_File (Mode      : in     File_Mode_Type;
+                          File_Key  :    out File_Descriptor_Type) is
+   begin
+      File_Key := Internal.Create (Mode);
+   end Create_File;
+
+end CA11009_0.CA11009_1;        -- Child Package body OS.File_Manager
+
+     --=================================================================--
+
+with CA11009_0.CA11009_1;       -- with Child Package OS.File_Manager
+with Report;
+
+procedure CA11009 is
+
+   package OS           renames CA11009_0;
+   use OS;
+   package File_Manager renames CA11009_0.CA11009_1;
+
+   Data_Base_File_Key : File_Descriptor_Type := Default_Descriptor;
+   New_Mode           : File_Mode_Type := Read_Write;
+
+begin
+   
+   -- This test indicates one approach to file management.
+   -- It is not intended to demonstrate full functionality, but rather
+   -- that the use of a private child package could provide a solution
+   -- to this type of situation.
+
+   Report.Test ("CA11009", "Check that a private child package can use "   &
+                           "entities declared in the visible part of the " &
+                           "parent unit of its parent unit");
+
+   -- Check initial conditions of the first entry in the file table.
+   -- These are all default values provided in the declaration of the 
+   -- type File_Type.                           
+
+   if (not (Data_Base_File_Key      = Default_Descriptor)) and then
+      (((not (File_Table(1).Name    = Default_Filename))   or 
+      (File_Table(1).Descriptor     /= Default_Descriptor))  or else
+      ((File_Table(1).Acct_Access   /= Default_Permission)  or
+      (not (File_Table(1).Mode      = Default_Mode))       or
+      (File_Table(1).Current_Status /= Default_Status)))
+   then
+      Report.Failed ("Initial condition failure");
+   end if;
+
+   -- Create/initialize file using the capability provided by the visible 
+   -- interface to the operating system, OS.File_Manager.  The actual 
+   -- processing routine is contained in the private grandchild package 
+   -- Internals, which utilize the components from the grandparent package.
+
+   File_Manager.Create_File (New_Mode, Data_Base_File_Key);
+
+   -- Verify that the initial conditions of the file table component have
+   -- been properly modified by the initialization function.
+
+   if not ((File_Table(1).Descriptor          = Data_Base_File_Key)   and then
+           (File_Table(1).Name                = An_Ada_File_Name)  and then
+           (File_Table(1).Acct_Access         = User)              and then
+           not ((File_Table(1).Mode           = Default_Mode)      or else
+                (File_Table(1).Current_Status = Default_Status)))
+   then
+      Report.Failed ("File creation failure");
+   end if;
+
+   Report.Result;
+
+end CA11009;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11010.a
new file mode 100644
index 000000000..b13efd798
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11010.a
@@ -0,0 +1,254 @@
+-- CA11010.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 private child package can use entities declared in the
+--     private part of its parent unit.
+--
+-- TEST DESCRIPTION:
+--     Declare a parent package containing private types, objects,
+--     and functions used by the system. Declare a private child package that 
+--     uses the parent components to provide functionality to the system.  
+--
+--     Declare an array of files with default values for all 
+--     component fields of the files (records).  Check the initial state of
+--     a specified file for proper default values.  Perform the file "creation"
+--     (initialization), which will modify the fields of the record object.
+--     Again verify the file object to determine whether the fields have been
+--     reset properly.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+   
+package CA11010_0 is               -- Package OS.
+ 
+   type File_Descriptor_Type is private;
+
+   Default_Descriptor  : constant File_Descriptor_Type;
+
+   function  Initialize_File           return File_Descriptor_Type;
+   procedure Verify_Initial_Conditions (Status : out Boolean);
+   function  Final_Conditions_Valid    return Boolean;
+
+private
+
+   type File_Descriptor_Type    is new Integer;
+   type File_Name_Type          is new String (1 .. 11);
+   type Permission_Type         is (None, User, System);
+   type File_Mode_Type          is (Read_Only, Write_Only, Read_Write);
+   type File_Status_Type        is (Open, Closed);
+
+   Default_Descriptor : constant File_Descriptor_Type := 0;
+   Default_Permission : constant Permission_Type      := None;
+   Default_Mode       : constant File_Mode_Type       := Read_Only;
+   Default_Status     : constant File_Status_Type     := Closed;
+   Default_Filename   : constant File_Name_Type       := "           ";
+   An_Ada_File_Name   : constant File_Name_Type       := "AdaFileName";
+   Max_Files          : constant File_Descriptor_Type := 100;
+
+   type File_Type is tagged
+      record
+         Descriptor     : File_Descriptor_Type := Default_Descriptor;
+         Name           : File_Name_Type       := Default_Filename;
+         Acct_Access    : Permission_Type      := Default_Permission;
+         Mode           : File_Mode_Type       := Default_Mode;
+         Current_Status : File_Status_Type     := Default_Status;
+      end record;
+
+   type File_Array_Type is array (1 .. Max_Files) of File_Type;
+
+   File_Table   : File_Array_Type;
+   File_Counter : Integer := 0;
+
+   --
+
+   function Get_File_Name return File_Name_Type;
+
+end CA11010_0;                     -- Package OS.
+
+     --=================================================================--
+
+-- Subprograms that perform the actual file operations are contained in a
+-- private package so that they are not accessible to any client.
+
+private package CA11010_0.CA11010_1 is  -- Package OS.Internals
+
+   Private_File_Counter : Integer renames File_Counter; -- Parent priv. object.
+
+   function Initialize 
+     (File_Name : File_Name_Type := Get_File_Name;  -- Parent priv. function.
+      File_Mode : File_Mode_Type := Read_Write)     -- Parent priv. literal.
+     return File_Descriptor_Type;                   -- Parent type.
+
+end CA11010_0.CA11010_1;             -- Package OS.Internals
+
+     --=================================================================--
+
+package body CA11010_0.CA11010_1 is  -- Package body OS.Internals
+
+   function Next_Available_File return File_Descriptor_Type is
+   begin
+      Private_File_Counter := Private_File_Counter + 1; 
+      return (File_Descriptor_Type(File_Counter));
+   end Next_Available_File;
+   ----------------------------------------------------------------
+   function Initialize 
+     (File_Name : File_Name_Type := Get_File_Name; -- Parent priv. function
+      File_Mode : File_Mode_Type := Read_Write)    -- Parent priv. literal
+     return File_Descriptor_Type is                -- Parent type
+      Number : File_Descriptor_Type;                         
+   begin
+      Number := Next_Available_File;
+      File_Table(Number).Descriptor := Number;     -- Parent priv. object
+      File_Table(Number).Name := File_Name;        -- Default parameter value 
+      File_Table(Number).Mode := File_Mode;        -- Default parameter value
+      File_Table(Number).Acct_Access := User;
+      File_Table(Number).Current_Status := Open;
+      return (Number);
+   end Initialize;
+
+end CA11010_0.CA11010_1;           -- Package body OS.Internals
+
+     --=================================================================--
+
+with CA11010_0.CA11010_1;          -- Private child package "withed" by
+                                   -- parent body.
+
+package body CA11010_0 is          -- Package body OS
+
+   function Get_File_Name return File_Name_Type is
+   begin
+      return (An_Ada_File_Name); -- If this was a real function, the user 
+   end Get_File_Name;            -- would be asked to input a name, or there 
+                                 -- would be some type of similar processing.
+
+   -- This subprogram utilizes a call to a subprogram contained in a private
+   -- child to perform the actual processing.
+
+   function Initialize_File return File_Descriptor_Type is
+   begin
+     return (CA11010_0.CA11010_1.Initialize);    -- No parameters are needed, 
+                                                 -- since defaults have been 
+                                                 -- provided.
+   end Initialize_File;
+
+   --
+   -- Separate subunits.
+   --
+
+   procedure Verify_Initial_Conditions (Status : out Boolean) is separate;
+
+   function  Final_Conditions_Valid return Boolean is separate;
+
+end CA11010_0;                         -- Package body OS
+
+     --=================================================================--
+
+separate (CA11010_0)
+procedure Verify_Initial_Conditions (Status : out Boolean) is
+begin
+   Status := False;
+   if (File_Table(1).Descriptor     = Default_Descriptor) and then
+      (File_Table(1).Name           = Default_Filename)   and then
+      (File_Table(1).Acct_Access    = Default_Permission) and then
+      (File_Table(1).Mode           = Default_Mode)       and then
+      (File_Table(1).Current_Status = Default_Status)
+   then 
+      Status := True;
+   end if;
+end Verify_Initial_Conditions;
+
+     --=================================================================--
+
+separate (CA11010_0)
+function Final_Conditions_Valid return Boolean is 
+begin
+   if  ((File_Table(1).Descriptor         /= Default_Descriptor) and then
+        (File_Table(1).Name                = An_Ada_File_Name)   and then
+        (File_Table(1).Acct_Access         = User)               and then
+        not ((File_Table(1).Mode           = Default_Mode)       or else
+             (File_Table(1).Current_Status = Default_Status)))
+   then
+      return (True);
+   else
+      return (False);
+   end if;
+end Final_Conditions_Valid;
+
+     --=================================================================--
+
+with CA11010_0;                        -- with Package OS.
+with Report;
+
+procedure CA11010 is
+
+   package OS renames CA11010_0;
+
+   Ada_File_Key          : OS.File_Descriptor_Type := OS.Default_Descriptor;
+   Initialization_Status : Boolean := False;
+
+begin
+
+   -- This test indicates one approach to a file management operation.
+   -- It is not intended to demonstrate full functionality, but rather
+   -- that the use of a private child package can provide a solution
+   -- to a user situation, that being the implementation of certain functions
+   -- being provided in a child package, with the parent package body 
+   -- utilizing these implementations.
+
+   Report.Test ("CA11010", "Check that a private child package can use "   &
+                           "entities declared in the private part of its " &
+                           "parent unit");
+
+   -- Check initial conditions of the first entry in the file table.
+   -- These are all default values provided in the declaration of the 
+   -- type File_Type.
+
+   OS.Verify_Initial_Conditions (Initialization_Status);
+
+   if not Initialization_Status then
+      Report.Failed ("Initial condition failure");
+   end if;
+   
+   -- Call the initialization function.  This will result in the resetting
+   -- of the fields associated with the first entry in the File_Table (this
+   -- is the first/only call of Initialize_File).  
+   -- No parameters are necessary for this call, due to the default values
+   -- provided in the private child package routine Initialize.
+   
+   Ada_File_Key := OS.Initialize_File;
+
+   -- Verify that the initial conditions of the file table component have
+   -- been properly modified by the initialization function.
+
+   if not OS.Final_Conditions_Valid then
+      Report.Failed ("Initialization processing failure");
+   end if;
+
+   Report.Result;
+
+end CA11010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11011.a
new file mode 100644
index 000000000..a75261dd8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11011.a
@@ -0,0 +1,271 @@
+-- CA11011.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 private child package can use entities declared in the
+--      private part of the parent unit of its parent unit.
+--
+-- TEST DESCRIPTION:
+--      Declare a parent package containing private types and objects
+--      used by the system.  Declare a public child package that 
+--      provides a visible interface to the system functionality.
+--      Declare a private grandchild package that uses the visible grandparent
+--      components to provide the actual functionality to the system. 
+--
+--      The public child (parent of the private grandchild) uses the 
+--      functionality of its private child (grandchild package) to provide 
+--      the visible interface to operations of the system.
+--
+--      The test itself will utilize the visible interface provided in the 
+--      public child package to demonstrate a possible solution to file 
+--      management.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CA11011_0 is               -- Package OS.
+
+   type File_Descriptor_Type is private;
+
+   Default_Descriptor  : constant File_Descriptor_Type;
+   First_File          : constant File_Descriptor_Type;
+
+   procedure Verify_Initial_Conditions (Key    : in     File_Descriptor_Type;
+                                        Status :    out Boolean);
+
+   function Final_Conditions_Valid (Key : File_Descriptor_Type) 
+     return Boolean;
+
+
+private
+
+   type File_Descriptor_Type    is new Integer;
+   type File_Name_Type          is new String (1 .. 11);
+   type Permission_Type         is (None, User, System);
+   type File_Mode_Type          is (Read_Only, Write_Only, Read_Write);
+   type File_Status_Type        is (Open, Closed);
+
+   Default_Descriptor : constant File_Descriptor_Type := 0;
+   First_File         : constant File_Descriptor_Type := 1;
+   Default_Permission : constant Permission_Type      := None;
+   Default_Mode       : constant File_Mode_Type       := Read_Only;
+   Default_Status     : constant File_Status_Type     := Closed;
+   Default_Filename   : constant File_Name_Type       := "           ";
+
+   Init_Permission    : constant Permission_Type      := User;
+   Init_Mode          : constant File_Mode_Type       := Read_Write;
+   Init_Status        : constant File_Status_Type     := Open;
+   An_Ada_File_Name   : constant File_Name_Type       := "AdaFileName";
+
+   Max_Files          : constant File_Descriptor_Type := 10;
+
+   type File_Type is tagged
+      record
+         Descriptor     : File_Descriptor_Type := Default_Descriptor;
+         Name           : File_Name_Type       := Default_Filename;
+         Acct_Access    : Permission_Type      := Default_Permission;
+         Mode           : File_Mode_Type       := Default_Mode;
+         Current_Status : File_Status_Type     := Default_Status;
+      end record;
+
+   type File_Array_Type is array (1 .. Max_Files) of File_Type;
+
+   File_Table   : File_Array_Type;
+   File_Counter : Integer := 0;
+
+   --
+
+   function  Get_File_Name return File_Name_Type;
+
+end CA11011_0;                     -- Package OS.
+
+     --=================================================================--
+
+package body CA11011_0 is          -- Package body OS.
+
+   function Get_File_Name return File_Name_Type is
+   begin
+      return (An_Ada_File_Name);
+   end Get_File_Name;
+   ---------------------------------------------------------------------
+   procedure Verify_Initial_Conditions (Key    : in     File_Descriptor_Type;
+                                        Status :    out Boolean) is
+   begin
+      Status := False;
+      if (File_Table(Key).Descriptor     = Default_Descriptor) and then
+         (File_Table(Key).Name           = Default_Filename)   and then
+         (File_Table(Key).Acct_Access    = Default_Permission) and then
+         (File_Table(Key).Mode           = Default_Mode)       and then
+         (File_Table(Key).Current_Status = Default_Status)
+      then 
+         Status := True;
+      end if;
+   end Verify_Initial_Conditions;
+   ---------------------------------------------------------------------
+   function Final_Conditions_Valid (Key : File_Descriptor_Type) 
+     return Boolean is
+   begin
+      if  ((File_Table(Key).Descriptor          = First_File)         and then
+           (File_Table(Key).Name                = An_Ada_File_Name)   and then
+           (File_Table(Key).Acct_Access         = Init_Permission)    and then
+           not ((File_Table(Key).Mode           = Default_Mode)       or else
+                (File_Table(Key).Current_Status = Default_Status)))
+      then
+         return (True);
+      else
+         return (False);
+      end if;
+   end Final_Conditions_Valid;
+
+end CA11011_0;                     -- Package body OS.
+
+     --=================================================================--
+
+package CA11011_0.CA11011_1 is     -- Package OS.File_Manager
+
+   procedure Create_File (File_Key : in File_Descriptor_Type);
+
+end CA11011_0.CA11011_1;           -- Package OS.File_Manager
+
+     --=================================================================--
+
+-- The Subprogram that performs the actual file operations is contained in a
+-- private package so that it is not accessible to any client.
+-- Default parameters are used in most cases in the subprogram calls, since
+-- the caller does not have visibility to these private types.
+
+                                   -- Package OS.File_Manager.Internals
+private package CA11011_0.CA11011_1.CA11011_2 is  
+
+   Private_File_Counter : Integer renames File_Counter;         -- Grandparent
+                                                                -- object.
+   procedure Create 
+     (Key         : in     File_Descriptor_Type; 
+      File_Name   : in     File_Name_Type   := Get_File_Name;   -- Grandparent
+                                                                -- prvt type,
+                                                                -- prvt functn.
+      File_Mode   : in     File_Mode_Type   := Init_Mode;       -- Grandparent
+                                                                -- prvt type,
+                                                                -- prvt const.
+      File_Access : in     Permission_Type  := Init_Permission; -- Grandparent
+                                                                -- prvt type,
+                                                                -- prvt const.
+      File_Status : in     File_Status_Type := Init_Status);    -- Grandparent
+                                                                -- prvt type,
+                                                                -- prvt const.
+
+end CA11011_0.CA11011_1.CA11011_2;   -- Package OS.File_Manager.Internals
+
+     --=================================================================--
+
+                                     -- Package Body OS.File_Manager.Internals
+package body CA11011_0.CA11011_1.CA11011_2 is  
+
+   procedure Create 
+     (Key         : in     File_Descriptor_Type; 
+      File_Name   : in     File_Name_Type   := Get_File_Name;
+      File_Mode   : in     File_Mode_Type   := Init_Mode;
+      File_Access : in     Permission_Type  := Init_Permission;
+      File_Status : in     File_Status_Type := Init_Status) is
+   begin
+      Private_File_Counter := Private_File_Counter + 1;
+      File_Table(Key).Descriptor     := Key;            -- Grandparent object.
+      File_Table(Key).Name           := File_Name;            
+      File_Table(Key).Mode           := File_Mode;            
+      File_Table(Key).Acct_Access    := File_Access;            
+      File_Table(Key).Current_Status := File_Status;
+   end Create;
+
+end CA11011_0.CA11011_1.CA11011_2;   -- Package body OS.File_Manager.Internals
+
+     --=================================================================--
+
+with CA11011_0.CA11011_1.CA11011_2;  -- with Child OS.File_Manager.Internals
+
+package body CA11011_0.CA11011_1 is  -- Package body OS.File_Manager
+
+   package Internal renames CA11011_0.CA11011_1.CA11011_2;            
+
+   -- This subprogram utilizes a call to a subprogram contained in a private
+   -- child to perform the actual processing.
+
+   procedure Create_File (File_Key : in File_Descriptor_Type) is
+   begin
+      Internal.Create (Key => File_Key);  -- Other parameters are defaults, 
+                                          -- since they are of private types
+                                          -- from the parent package.
+                                          -- File_Descriptor_Type is private,
+                                          -- but declared in visible part of 
+                                          -- parent spec.
+   end Create_File;
+
+end CA11011_0.CA11011_1;        -- Package body OS.File_Manager
+
+     --=================================================================--
+
+with CA11011_0.CA11011_1;       -- with public Child Package OS.File_Manager
+with Report;
+
+procedure CA11011 is
+
+   package OS           renames CA11011_0;
+   package File_Manager renames CA11011_0.CA11011_1;
+
+   Data_Base_File_Key : OS.File_Descriptor_Type := OS.First_File;
+   TC_Status          : Boolean := False;
+
+begin
+
+   -- This test indicates one approach to file management operations.
+   -- It is not intended to demonstrate full functionality, but rather
+   -- that the use of a private child package can provide a solution
+   -- to a typical user situation.
+
+   Report.Test ("CA11011", "Check that a private child package can use "   &
+                           "entities declared in the private part of the " &
+                           "parent unit of its parent unit");
+
+   OS.Verify_Initial_Conditions (Data_Base_File_Key, TC_Status);
+
+   if not TC_Status then
+      Report.Failed ("Initial condition failure");
+   end if;
+
+   -- Perform file initializations.
+
+   File_Manager.Create_File (File_Key => Data_Base_File_Key);
+
+   TC_Status := OS.Final_Conditions_Valid (Data_Base_File_Key);
+
+   if not TC_Status then
+      Report.Failed ("Bad status return from Create_File");
+   end if;
+
+   Report.Result;
+
+end CA11011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11012.a
new file mode 100644
index 000000000..071b8f813
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11012.a
@@ -0,0 +1,259 @@
+-- CA11012.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 child package of a library level instantiation
+--      of a generic can be the instantiation of a child package of
+--      the generic. Check that the child instance can use its parent's
+--      declarations and operations, including a formal type of the parent. 
+--      
+-- TEST DESCRIPTION:
+--      Declare a generic package which simulates an integer complex 
+--      abstraction.  Declare a generic child package of this package 
+--      which defines additional complex operations. 
+--
+--      Instantiate the first generic package, then instantiate the child 
+--      generic package as a child unit of the first instance.  In the main
+--      program, check that the operations in both instances perform as 
+--      expected.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      21 Dec 94   SAIC    Corrected visibility errors for literals
+--      27 Feb 97   PWB.CTA Added elaboration pragma at package CA11012_3
+--!
+
+generic               -- Complex number abstraction.
+   type Int_Type is range <>;
+
+package CA11012_0 is
+ 
+   -- Simulate a generic complex number support package. Complex numbers
+   -- are treated as coordinates in the Cartesian plane.
+
+   type Complex_Type is private;
+
+   Zero : constant Complex_Type;                      -- Real number (0,0).
+
+   function Complex (Real, Imag : Int_Type)           -- Create a complex
+     return Complex_Type;                             -- number.
+
+   function "-" (Right : Complex_Type)                -- Invert a complex
+     return Complex_Type;                             -- number.
+
+   function "+" (Left, Right : Complex_Type)          -- Add two complex
+     return Complex_Type;                             -- numbers.
+
+private
+   type Complex_Type is record
+      Real : Int_Type;
+      Imag : Int_Type;
+   end record;
+
+   Zero : constant Complex_Type := (Real => 0, Imag => 0);
+
+end CA11012_0;
+
+     --==================================================================--
+
+package body CA11012_0 is
+
+   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 "+";
+
+end CA11012_0;
+
+     --==================================================================--
+
+-- Generic child of complex number package.  Child must be generic since 
+-- parent is generic. 
+
+generic               -- Complex additional operations
+
+package CA11012_0.CA11012_1 is
+ 
+   -- More operations on complex number. This child adds a layer of
+   -- functionality to the parent generic.
+
+   function Real_Part (Complex_No : Complex_Type)
+     return Int_Type;
+
+   function Imag_Part (Complex_No : Complex_Type)
+     return Int_Type;
+
+   function "*" (Factor : Int_Type; 
+                 C      : Complex_Type) return Complex_Type;
+
+   function Vector_Magnitude (Complex_No : Complex_Type)
+     return Int_Type;
+
+end CA11012_0.CA11012_1;
+
+     --==================================================================--
+
+package body CA11012_0.CA11012_1 is
+
+   function Real_Part (Complex_No : Complex_Type) return Int_Type is
+   begin
+      return (Complex_No.Real);
+   end Real_Part;
+   ---------------------------------------------------------------
+   function Imag_Part (Complex_No : Complex_Type) return Int_Type is
+   begin
+      return (Complex_No.Imag);
+   end Imag_Part;
+   ---------------------------------------------------------------
+   function "*" (Factor : Int_Type; 
+                 C      : Complex_Type) return Complex_Type is
+      Result : Complex_Type := Zero;   -- Zero is declared in parent,
+                                       -- Complex_Number
+   begin
+      for I in 1 .. abs (Factor) loop
+         Result := Result + C;         -- Complex_Number "+"
+      end loop;
+
+      if Factor < 0 then
+         Result := - Result;           -- Complex_Number "-"
+      end if;
+
+      return Result;
+   end "*";
+   ---------------------------------------------------------------
+   function Vector_Magnitude (Complex_No : Complex_Type)
+     return Int_Type is                -- Not a real vector magnitude.
+   begin
+      return (Complex_No.Real + Complex_No.Imag);
+   end Vector_Magnitude;  
+
+end CA11012_0.CA11012_1;
+
+     --==================================================================--
+
+package CA11012_2 is
+
+   subtype My_Integer is integer range -100 .. 100;
+
+   -- ... Various other types used by the application.
+
+end CA11012_2;
+
+-- No body for CA11012_2;
+
+     --==================================================================--
+
+-- Declare instances of the generic complex packages for integer type.  
+-- The instance of the child must itself be declared as a child of the 
+-- instance of the parent.
+
+with CA11012_0;                        -- Complex number abstraction
+with CA11012_2;                        -- Package containing integer type
+pragma Elaborate (CA11012_0);
+package CA11012_3 is new CA11012_0 (Int_Type => CA11012_2.My_Integer);
+
+with CA11012_0.CA11012_1;              -- Complex additional operations
+with CA11012_3;
+package CA11012_3.CA11012_4 is new CA11012_3.CA11012_1;
+
+     --==================================================================--
+
+with CA11012_2;                -- Package containing integer type
+with CA11012_3.CA11012_4;      -- Complex abstraction + additional operations
+with Report;
+
+procedure CA11012 is
+
+   package My_Complex_Pkg renames CA11012_3;
+
+   package My_Complex_Operation renames CA11012_3.CA11012_4;
+
+   use My_Complex_Pkg,                                -- All user-defined
+       My_Complex_Operation;                          -- operators directly
+                                                      -- visible.
+   Complex_One, Complex_Two : Complex_Type;
+
+begin
+
+   Report.Test ("CA11012", "Check that child instance can use its parent's "  &
+                           "declarations and operations, including a formal " &
+                           "type of the parent");
+
+   Correct_Range_Test:
+   declare
+      My_Literal  : CA11012_2.My_Integer := -3;
+
+   begin
+      Complex_One := Complex (-4, 7);          -- Operation from the generic 
+                                               -- parent package.
+
+      Complex_Two := My_Literal * Complex_One; -- Operation from the generic 
+                                               -- child package.
+
+      if Real_Part (Complex_Two) /= 12         -- Operation from the generic 
+        or Imag_Part (Complex_Two) /= -21      -- child package.
+          then
+             Report.Failed ("Incorrect results from complex operation");
+      end if;
+
+   end Correct_Range_Test;
+
+   ---------------------------------------------------------------
+
+   Out_Of_Range_Test:
+   declare
+      My_Vector : CA11012_2.My_Integer;
+
+   begin
+      Complex_One := Complex (70, 70);         -- Operation from the generic 
+                                               -- parent package.
+      My_Vector := Vector_Magnitude (Complex_One);         
+                     -- Operation from the generic child package.
+
+      Report.Failed ("Exception not raised in child package");
+
+   exception
+      when Constraint_Error =>
+        Report.Comment ("Exception is raised as expected");
+
+      when others           =>
+        Report.Failed ("Others exception is raised");
+
+   end Out_Of_Range_Test;
+
+   Report.Result;
+
+end CA11012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11013.a
new file mode 100644
index 000000000..c7f442788
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11013.a
@@ -0,0 +1,201 @@
+-- CA11013.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 child function of a library level instantiation
+--      of a generic can be the instantiation of a child function of
+--      the generic. Check that the child instance can use its parent's
+--      declarations and operations, including a formal subprogram of the 
+--      parent.                                                           
+--      
+-- TEST DESCRIPTION:
+--      Declare a generic package which simulates a real complex
+--      abstraction.  Declare a generic child function of this package 
+--      which builds a random complex number.  Declare a second
+--      package which defines a random complex number generator.  This
+--      package provides actual parameters for the generic parent package.
+--
+--      Instantiate the first generic package, then instantiate the child 
+--      generic function as a child unit of the first instance.  In the main
+--      program, check that the operations in both instances perform as 
+--      expected.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+--      19 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
+--                          clause of CA11013_3.
+--      27 Feb 97   CTA.PWB Added elaboration pragma at package CA11013_3
+--!
+  
+generic               -- Complex number abstraction.
+   type Real_Type is digits <>;
+   with function Random_Generator (Seed : Real_Type) return Real_Type;
+
+package CA11013_0 is
+ 
+   -- Simulate a generic complex number support package. Complex numbers
+   -- are treated as coordinates in the Cartesian plane.
+
+   type Complex_Type is
+     record
+        Real : Real_Type;
+        Imag : Real_Type;
+     end record;
+
+   function Make (Real, Imag : Real_Type)           -- Create a complex
+     return Complex_Type;                           -- number.
+
+   procedure Components (Complex_No           : in Complex_Type;
+                         Real_Part, Imag_Part : out Real_Type);
+
+end CA11013_0;
+
+     --==================================================================--
+
+package body CA11013_0 is
+
+   function Make (Real, Imag : Real_Type) return Complex_Type is
+   begin
+      return (Real, Imag);
+   end Make;
+   -------------------------------------------------------------
+   procedure Components (Complex_No           : in Complex_Type;
+                         Real_Part, Imag_Part : out Real_Type) is
+   begin
+      Real_Part := Complex_No.Real;
+      Imag_Part := Complex_No.Imag;
+   end Components;
+
+end CA11013_0;
+
+     --==================================================================--
+
+-- Generic child of complex number package.  This child adds a layer of 
+-- functionality to the parent generic.
+
+generic               -- Random complex number operation.
+
+function CA11013_0.CA11013_1 (Seed : Real_Type) return Complex_Type;
+
+               --==============================================--
+
+function CA11013_0.CA11013_1 (Seed : Real_Type) return Complex_Type is
+
+   Random_Real_Part  :  Real_Type  := Random_Generator (Seed);
+                                      -- parent's formal subprogram
+   Random_Imag_Part  :  Real_Type  
+                     := Random_Generator (Random_Generator (Seed));
+                                      -- parent's formal subprogram
+   Random_Complex_No :  Complex_Type;
+
+begin -- CA11013_0.CA11013_1
+
+   Random_Complex_No := Make (Random_Real_Part, Random_Imag_Part);
+                                      -- operation from parent
+   return (Random_Complex_No); 
+
+end CA11013_0.CA11013_1;
+
+     --==================================================================--
+
+package CA11013_2 is
+ 
+   -- To be used as actual parameters for random number generator
+   -- in the parent package.
+
+   type My_Float is digits 6 range -10.0 .. 100.0;
+
+   function Random_Complex (Seed : My_float) return My_Float;
+
+end CA11013_2;
+
+     --==================================================================--
+
+package body CA11013_2 is
+
+   -- Not a real random number generator.
+   function Random_Complex (Seed : My_float) return My_Float is
+   begin
+      return (Seed + 3.0);    
+   end Random_Complex;
+
+end CA11013_2;
+
+     --==================================================================--
+
+-- Declare instances of the generic complex packages for real type.  
+-- The instance of the child must itself be declared as a child of the 
+-- instance of the parent.
+
+with CA11013_0;                       -- Complex number.
+with CA11013_2;                       -- Random number generator.
+pragma Elaborate (CA11013_0);
+package CA11013_3 is new 
+  CA11013_0 (Random_Generator => CA11013_2.Random_Complex,
+             Real_Type        => CA11013_2.My_Float);
+
+with CA11013_0.CA11013_1;             -- Random complex number operation.
+with CA11013_3;
+pragma Elaborate (CA11013_3);
+function CA11013_3.CA11013_4 is new CA11013_3.CA11013_1;
+  
+     --==================================================================--
+
+with Report;
+with CA11013_2;                       -- Random number generator.
+with CA11013_3.CA11013_4;             -- Complex abstraction + Random complex 
+                                      -- number operation.
+procedure CA11013 is
+
+   package My_Complex_Pkg renames CA11013_3;
+   use type CA11013_2.My_Float;
+
+   My_Complex                 : My_Complex_Pkg.Complex_Type;
+   My_Literal                 : CA11013_2.My_Float := 3.0;
+   My_Real_Part, My_Imag_Part : CA11013_2.My_Float;
+
+begin
+
+   Report.Test ("CA11013", "Check that child instance can use its parent's "  &
+                           "declarations and operations, including a formal " &
+                           "subprogram of the parent");
+
+   My_Complex := CA11013_3.CA11013_4 (My_Literal); 
+                 -- Operation from the generic child function.
+
+   My_Complex_Pkg.Components (My_Complex, My_Real_Part, My_Imag_Part);
+                 -- Operation from the generic parent package.
+
+   if My_Real_Part /= 6.0           -- Operation from the generic 
+     or My_Imag_Part /= 9.0         -- parent package.
+       then
+         Report.Failed ("Incorrect results from complex operation");
+   end if;
+
+   Report.Result;
+
+end CA11013;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11014.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11014.a
new file mode 100644
index 000000000..7847a5067
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11014.a
@@ -0,0 +1,302 @@
+-- CA11014.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 an instantiation of a child package of a generic package
+--      can use its parent's declarations and operations, including a formal 
+--      package of the parent. 
+--
+-- TEST DESCRIPTION:
+--      Declare a list abstraction in a generic package which manages lists of
+--      elements of any discrete type. Declare a generic package which 
+--      operates on lists of elements of integer types.  Declare a generic
+--      child of this package which defines additional list operations. 
+--      Use the formal discrete type as the generic formal actual part for the
+--      parent formal package. 
+--
+--      Declare an instance of parent, then declare an instance of the child 
+--      which is itself a child the parent's instance. In the main program,
+--      check that the operations in both instances perform as expected.  
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+--      07 Sep 96   SAIC    Change formal param E to be out only.
+--      19 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
+--                          clauses of CA11014_0, CA11014_1, and CA11014_5.
+--      27 Feb 97   PWB.CTA Added elaboration pragma at package CA11014_4
+--!
+  
+-- Actual package for the parent's formal.
+generic               
+
+   type Element_Type is (<>);  -- List elems may be of any discrete types.
+
+package CA11014_0 is              
+
+   type Node_Type;
+   type Node_Pointer is access Node_Type;
+
+   type Node_Type is record
+      Item : Element_Type;
+      Next : Node_Pointer := null;
+   end record;
+
+   type List_Type is record
+      First   : Node_Pointer := null;
+      Current : Node_Pointer := null;
+      Last    : Node_Pointer := null;
+   end record;
+
+   -- Return true if current element is last in the list.
+   function End_Of_List (L : List_Type) return boolean;
+
+   -- Set "current" pointer to first list element.
+   procedure Reset (L : in out List_Type);
+
+end CA11014_0;
+
+     --==================================================================--
+
+package body CA11014_0 is
+
+   function End_Of_List (L : List_Type) return boolean is
+   begin
+      return (L.Current = null);
+   end End_Of_List;
+   -------------------------------------------------------
+   procedure Reset (L : in out List_Type) is
+   begin
+      L.Current := L.First;                 -- Set "current" pointer to first
+   end Reset;                               -- list element.
+
+end CA11014_0;
+
+     --==================================================================--
+
+with CA11014_0;            -- Generic list abstraction.
+pragma Elaborate (CA11014_0);
+generic             
+
+   -- Import the list abstraction defined in CA11014_0.
+   with package List_Mgr is new CA11014_0 (<>);
+
+package CA11014_1 is    
+
+   -- Write to current element and advance "current" pointer.
+   procedure Write_Element (L : in out List_Mgr.List_Type; 
+                            E : in     List_Mgr.Element_Type);
+
+   -- Read from current element and advance "current" pointer.
+   procedure Read_Element (L : in out List_Mgr.List_Type; 
+                           E :    out List_Mgr.Element_Type);
+
+   -- Add element to end of list.
+   procedure Add_Element (L : in out List_Mgr.List_Type; 
+                          E : in     List_Mgr.Element_Type);
+
+end CA11014_1;
+
+     --==================================================================--
+
+package body CA11014_1 is
+
+   procedure Write_Element (L : in out List_Mgr.List_Type; 
+                            E : in     List_Mgr.Element_Type) is
+   begin
+      L.Current.Item := E;               -- Write to current element.
+      L.Current      := L.Current.Next;  -- Advance "current" pointer.
+   end Write_Element;
+   -------------------------------------------------------
+   procedure Read_Element (L : in out List_Mgr.List_Type; 
+                           E :    out List_Mgr.Element_Type) is
+   begin
+      E         := L.Current.Item;       -- Retrieve current element.
+      L.Current := L.Current.Next;       -- Advance "current" pointer.
+   end Read_Element;
+   -------------------------------------------------------
+   procedure Add_Element (L : in out List_Mgr.List_Type; 
+                          E : in     List_Mgr.Element_Type) is
+      New_Node : List_Mgr.Node_Pointer := new List_Mgr.Node_Type'(E, null); 
+       use type List_Mgr.Node_Pointer;
+   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;
+
+end CA11014_1;
+
+     --==================================================================--
+
+-- Generic child of list operation.  This child adds a layer of 
+-- functionality to the parent generic.
+
+generic
+
+package CA11014_1.CA11014_2 is
+
+   procedure Write_First_To_List (L : in out List_Mgr.List_Type);
+
+   -- ... Various other operations used by the application.
+
+end CA11014_1.CA11014_2;
+
+     --==================================================================--
+
+package body CA11014_1.CA11014_2 is
+
+   procedure Write_First_To_List (L : in out List_Mgr.List_Type) is
+   begin
+      List_Mgr.Reset (L);    -- Parent's formal package.
+
+      while not List_Mgr.End_Of_List (L) loop     -- Parent's formal package.
+         Write_Element (L, List_Mgr.Element_Type'First);   
+                                                  -- Parent's operation, 
+      end loop;                                   -- parent's formal.
+      
+   end Write_First_To_List;
+
+end CA11014_1.CA11014_2;
+
+     --==================================================================--
+
+package CA11014_3 is
+
+   type Points is range 0 .. 100;
+
+   -- ... Various other types used by the application.
+
+end CA11014_3;
+
+
+-- No body for CA11014_3;
+
+     --==================================================================--
+
+-- Declare instances of the generic list packages for the discrete type.
+-- The instance of the child must itself be declared as a child of the 
+-- instance of the parent.
+
+with CA11014_0;               -- Generic list abstraction.
+with CA11014_3;               -- Package containing discrete type declaration.
+pragma Elaborate (CA11014_0);
+package CA11014_4 is new CA11014_0 (CA11014_3.Points);  -- Points list.
+
+with CA11014_4;               -- Points list.
+with CA11014_1;               -- Generic list operation.
+pragma Elaborate (CA11014_1);
+package CA11014_5 is new CA11014_1 (CA11014_4);         -- Scores list.
+
+with CA11014_1.CA11014_2;     -- Additional generic list operation,
+with CA11014_5;
+pragma Elaborate (CA11014_5);
+package CA11014_5.CA11014_6 is new CA11014_5.CA11014_2;
+                                                   -- Points list operation.
+
+     --==================================================================--
+
+with CA11014_1.CA11014_2;      -- Additional generic list operation,
+                               -- implicitly with list operation.
+with CA11014_3;                -- Package containing discrete type declaration.
+with CA11014_4;                -- Points list.
+with CA11014_5.CA11014_6;      -- Points list operation.
+with Report;
+
+procedure CA11014 is
+
+   package Lists_Of_Scores renames CA11014_4;
+   package Score_Ops renames CA11014_5;
+   package Point_Ops renames CA11014_5.CA11014_6;
+
+   Scores : Lists_Of_Scores.List_Type;                -- List of points.
+
+   type TC_Score_Array is array (1 .. 3) of CA11014_3.Points;
+
+   TC_Initial_Values : constant TC_Score_Array := (10, 21, 49);
+   TC_Final_Values   : constant TC_Score_Array := (0, 0, 0);
+
+   TC_Initial_Values_Are_Correct : boolean := false;
+   TC_Final_Values_Are_Correct   : boolean := false;
+
+               --------------------------------------------------
+
+   -- Initial list contains 3 scores with the values 10, 21, and 49.
+   procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is
+   begin                                  
+      for I in TC_Score_Array'range loop  
+         Score_Ops.Add_Element (L, TC_Initial_Values(I));
+                   -- Operation from generic parent.
+      end loop;
+   end TC_Initialize_List;
+
+               --------------------------------------------------
+
+   -- Verify that all scores have been set to zero.
+   procedure TC_Verify_List (L        : in out Lists_of_Scores.List_Type;
+                             Expected : in     TC_Score_Array;
+                             OK       :    out boolean) is
+      Actual : TC_Score_Array;
+   begin                                  
+      Lists_of_Scores.Reset (L);       -- Operation from parent's formal.
+      for I in TC_Score_Array'range loop
+         Score_Ops.Read_Element (L, Actual(I));
+                   -- Operation from generic parent.
+      end loop;
+      OK := (Actual = Expected);
+   end TC_Verify_List;
+
+               --------------------------------------------------
+
+begin -- CA11014 
+
+   Report.Test ("CA11014", "Check that an instantiation of a child package " &
+                           "of a generic package can use its parent's "      & 
+                           "declarations and operations, including a "       &
+                           "formal package of the parent");
+
+   TC_Initialize_List (Scores);
+   TC_Verify_List (Scores, TC_Initial_Values, TC_Initial_Values_Are_Correct);
+
+   if not TC_Initial_Values_Are_Correct then
+      Report.Failed ("List contains incorrect initial values");
+   end if;
+
+   Point_Ops.Write_First_To_List (Scores);
+                   -- Operation from generic child package.
+
+   TC_Verify_List (Scores, TC_Final_Values, TC_Final_Values_Are_Correct);
+
+   if not TC_Final_Values_Are_Correct then
+      Report.Failed ("List contains incorrect final values");
+   end if;
+
+   Report.Result;
+
+end CA11014;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11015.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11015.a
new file mode 100644
index 000000000..79b99ede8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11015.a
@@ -0,0 +1,312 @@
+-- CA11015.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 generic child of a non-generic package can use its 
+--      parent's declarations and operations.  Check that the instantiation
+--      of the generic child can correctly use the operations.
+--
+-- TEST DESCRIPTION:
+--      Declare a map abstraction in a package which manages basic physical
+--      maps.  Declare a generic child of this package which defines copies
+--      of maps of any discrete type, i.e., population, density, or weather.
+--
+--      In the main program, declare an instance of the child.  Check that
+--      the operations in the parent and instance of the child package 
+--      perform as expected.  
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Simulates map of physical features, i.e., desert, forest, water, 
+-- or plains.
+
+package CA11015_0 is              
+   type Map_Type is private;
+   subtype Latitude is integer range 1 .. 9;
+   subtype Longitude is integer range 1 .. 7;
+
+   type Physical_Features is (Desert, Forest, Water, Plains, Unexplored);
+   type Page_Type is range 0 .. 80;
+   
+   Terra_Incognita : exception;
+
+   -- Use geographic database to initialize the basic map.
+
+   procedure Initialize_Basic_Map (Map  : in out Map_Type);
+
+   function Get_Physical_Feature (Lat  : Latitude;
+                                  Long : Longitude;
+                                  Map  : Map_Type) return Physical_Features;
+
+   function Next_Page return Page_Type;
+
+private
+   type Map_Type is array (Latitude, Longitude) of Physical_Features;
+   Basic_Map : Map_Type;
+   Page      : Page_Type := 0;       -- Location for each copy of Map.
+
+end CA11015_0;
+
+     --==================================================================--
+
+package body CA11015_0 is              
+
+   procedure Initialize_Basic_Map (Map : in out Map_Type) is
+   -- Not a real initialization.  Real application can use geographic
+   -- database to create the basic map.
+   begin
+      for I in Latitude'first .. Latitude'last loop
+         for J in 1 .. 2 loop
+            Map (I, J) := Unexplored;
+         end loop;
+         for J in 3 .. 4 loop
+            Map (I, J) := Desert;
+         end loop;
+         for J in 5 .. 7 loop
+            Map (I, J) := Plains;
+         end loop;
+      end loop;
+
+   end Initialize_Basic_Map;
+   ---------------------------------------------------
+   function Get_Physical_Feature (Lat  : Latitude;
+                                  Long : Longitude;
+                                  Map  : Map_Type) 
+     return Physical_Features is
+   begin
+     return (Map (Lat, Long));
+   end Get_Physical_Feature;
+   ---------------------------------------------------
+   function Next_Page return Page_Type is
+   begin
+      Page := Page + 1;
+      return (Page);
+   end Next_Page;
+
+   ---------------------------------------------------
+   begin -- CA11015_0
+      -- Initialize a basic map.
+      Initialize_Basic_Map (Basic_Map);
+
+end CA11015_0;
+
+     --==================================================================--
+
+-- Generic child package of physical map.  Instantiate this package to
+-- create map copy with a new geographic feature, i.e., population, density,
+-- or weather.
+
+generic               
+
+   type Generic_Feature is (<>);  -- Any geographic feature, i.e., population,
+                                  -- density, or weather that can be
+                                  -- characterized by a scalar value.
+
+package CA11015_0.CA11015_1 is              
+
+   type Feature_Map is private;
+
+   function Get_Feature_Val (Lat  : Latitude;
+                             Long : Longitude;
+                             Map  : Feature_Map) return Generic_Feature;
+
+   procedure Set_Feature_Val (Lat  : in     Latitude;
+                              Long : in     Longitude;
+                              Fea  : in     Generic_Feature;
+                              Map  : in out Feature_Map);
+
+   function Check_Page (Map     : Feature_Map;
+                        Page_No : Page_Type) return boolean;
+
+private
+   type Feature_Type is array (Latitude, Longitude) of Generic_Feature;
+
+   type Feature_Map is
+     record
+        Feature : Feature_Type;
+        Page    : Page_Type := Next_Page;    -- Operation from parent.
+     end record;
+
+end CA11015_0.CA11015_1;
+
+     --==================================================================--
+
+package body CA11015_0.CA11015_1 is              
+
+   function Get_Feature_Val (Lat  : Latitude;
+                             Long : Longitude;
+                             Map  : Feature_Map) return Generic_Feature is
+   begin
+     return (Map.Feature (Lat, Long));
+   end Get_Feature_Val;
+   ---------------------------------------------------
+   procedure Set_Feature_Val (Lat  : in     Latitude;
+                              Long : in     Longitude;
+                              Fea  : in     Generic_Feature;
+                              Map  : in out Feature_Map) is
+   begin
+      if Get_Physical_Feature (Lat, Long, Basic_Map) = Unexplored  
+                                                -- Parent's operation,
+                                                -- Parent's private object.
+      then
+         raise Terra_Incognita;                 -- Exception from parent.
+      else
+         Map.Feature (Lat, Long) := Fea;
+      end if;
+   end Set_Feature_Val;
+   ---------------------------------------------------
+   function Check_Page (Map     : Feature_Map;
+                        Page_No : Page_Type) return boolean is
+   begin
+      return (Map.Page = Page_No);
+   end Check_Page;
+
+end CA11015_0.CA11015_1;
+
+     --==================================================================--
+
+with CA11015_0.CA11015_1;              -- Generic map operation,
+                                       -- implicitly withs parent, basic map
+                                       -- application.
+with Report;
+
+procedure CA11015 is
+
+begin 
+
+   Report.Test ("CA11015", "Check that an instantiation of a child package " &
+                           "of a non-generic package can use its parent's "  &
+                           "declarations and operations");
+
+-- An application creates a population map using an integer type.
+
+           Population_Map_Subtest:
+           declare
+              type Population_Type is range 0 .. 10_000;         
+
+              -- Declare instance of the child generic map package for one 
+              -- particular integer type.            
+
+              package Population is new CA11015_0.CA11015_1 (Population_Type);
+
+              Population_Map_Latitude   : CA11015_0.Latitude := 1;  
+                                                   -- parent's type
+              Population_Map_Longitude : CA11015_0.Longitude := 5;
+                                                   -- parent's type
+              Pop_Map                   : Population.Feature_Map;
+              Pop                       : Population_Type := 1000;
+
+           begin
+              Population.Set_Feature_Val (Population_Map_Latitude, 
+                                          Population_Map_Longitude,
+                                          Pop, 
+                                          Pop_Map);
+
+              If not ( (Population.Get_Feature_Val (Population_Map_Latitude, 
+                Population_Map_Longitude, Pop_Map) = Pop) or  
+                  (Population.Check_Page (Pop_Map, 1)) ) then
+                    Report.Failed ("Population map contains incorrect values");
+              end if;
+
+           end Population_Map_Subtest;
+
+-- An application creates a weather map using an enumeration type.
+
+           Weather_Map_Subtest:
+           declare
+              type Weather_Type is (Hot, Cold, Mild);                    
+
+              -- Declare instance of the child generic map package for one 
+              -- particular enumeration type.            
+
+              package Weather_Pkg is new CA11015_0.CA11015_1 (Weather_Type);
+
+              Weather_Map_Latitude   : CA11015_0.Latitude := 2;
+                                                   -- parent's type
+              Weather_Map_Longitude : CA11015_0.Longitude := 6;
+                                                   -- parent's type
+              Weather_Map            : Weather_Pkg.Feature_Map;
+              Weather                : Weather_Type := Mild;
+
+           begin
+              Weather_Pkg.Set_Feature_Val (Weather_Map_Latitude, 
+                                           Weather_Map_Longitude,
+                                           Weather, 
+                                           Weather_Map);
+
+              if ( (Weather_Pkg.Get_Feature_Val (Weather_Map_Latitude, 
+                    Weather_Map_Longitude, Weather_Map) /= Weather) or
+                not (Weather_Pkg.Check_Page (Weather_Map, 2)) )
+              then
+                 Report.Failed ("Weather map contains incorrect values");
+              end if;
+
+           end Weather_Map_Subtest;
+
+-- During processing, the application may erroneously attempts to create 
+-- a density map on an unexplored area.  This would result in the raising 
+-- of an exception.
+
+           Density_Map_Subtest:
+           declare
+              type Density_Type is (High, Medium, Low);
+
+              -- Declare instance of the child generic map package for one 
+              -- particular enumeration type.            
+
+              package Density_Pkg is new CA11015_0.CA11015_1 (Density_Type);
+
+              Density_Map_Latitude   : CA11015_0.Latitude := 7;
+                                                   -- parent's type
+              Density_Map_Longitude : CA11015_0.Longitude := 2;
+                                                   -- parent's type
+              Density                : Density_Type := Low;
+              Density_Map            : Density_Pkg.Feature_Map;
+
+           begin
+              Density_Pkg.Set_Feature_Val (Density_Map_Latitude, 
+                                           Density_Map_Longitude,
+                                           Density, 
+                                           Density_Map);
+
+              Report.Failed ("Exception not raised in child generic package");
+
+           exception
+
+              when CA11015_0.Terra_Incognita =>   -- parent's exception,
+                  null;                           -- raised in child.
+
+              when others          =>         
+                  Report.Failed ("Others exception is raised");
+
+           end Density_Map_Subtest;
+
+   Report.Result;
+
+end CA11015;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11016.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11016.a
new file mode 100644
index 000000000..d6d4089a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11016.a
@@ -0,0 +1,321 @@
+-- CA11016.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 child of a non-generic package can be a private generic 
+--      package. Check that the private child instance can use its parent's
+--      declarations and operations.  Check that the body of a public child 
+--      package can instantiate its sibling private generic package.
+--
+-- TEST DESCRIPTION:
+--      Declare a map abstraction in a package which manages basic physical
+--      map[s].  Declare a private generic child of this package which can be
+--      instantiated for any display device which has display locations of 
+--      the physical map that can be characterized by any integer type, i.e., 
+--      the intensity of the display point.
+--
+--      Declare a public child of the physical map which specifies the 
+--      display device.  In the body of this child, declare an instance of 
+--      its generic sibling to display the geographic locations.
+--
+--      In the main program, check that the operations in the parent, public 
+--      child and instance of the private child package perform as expected.  
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      17 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate.
+--
+--!
+
+-- Simulates map of physical features, i.e., desert, forest, or water.
+
+package CA11016_0 is              
+   type Map_Type is private;
+   subtype Latitude is integer range 1 .. 9;
+   subtype Longitude is integer range 1 .. 7;
+
+   type Physical_Features is (Desert, Forest, Water);
+   
+   -- Use geographic database to initialize the basic map.
+
+   procedure Initialize_Basic_Map (Map  : in out Map_Type);
+
+   function Get_Physical_Feature (Lat  : Latitude;
+                                  Long : Longitude;
+                                  Map  : Map_Type) return Physical_Features;
+
+private
+   type Map_Type is array (Latitude, Longitude) of Physical_Features;
+   Basic_Map : Map_Type;
+
+end CA11016_0;
+
+     --==================================================================--
+
+package body CA11016_0 is              
+
+   procedure Initialize_Basic_Map (Map : in out Map_Type) is
+   -- Not a real initialization.  Real application can use geographic
+   -- database to create the basic map.
+
+   begin
+      for I in Latitude'first .. Latitude'last loop
+         for J in 1 .. 2 loop
+            Map (I, J) := Desert;
+         end loop;
+         for J in 3 .. 4 loop
+            Map (I, J) := Forest;
+         end loop;
+         for J in 5 .. 7 loop
+            Map (I, J) := Water;
+         end loop;
+      end loop;
+
+   end Initialize_Basic_Map;
+   --------------------------------------------------------
+   function Get_Physical_Feature (Lat  : Latitude;
+                                  Long : Longitude;
+                                  Map  : Map_Type) 
+     return Physical_Features is
+   begin
+     return (Map (Lat, Long));
+   end Get_Physical_Feature;
+   --------------------------------------------------------
+
+   begin
+      -- Initialize a basic map.
+      Initialize_Basic_Map (Basic_Map);
+
+end CA11016_0;
+
+     --==================================================================--
+
+-- Private generic child package of physical map.  This generic package may
+-- be instantiated for any display device which has display locations 
+-- (latitude, longitude) that can be characterized by an integer value.
+-- For example, the intensity of the display point might be so characterized.
+-- It can be instantiated for any desired range of values (which would 
+-- correspond to the range accepted by the display device).
+
+
+private 
+
+generic               
+
+   type Display_Value is range <>;  -- Any display feature that is 
+                                    -- represented by an integer.
+
+package CA11016_0.CA11016_1 is              
+
+   function Get_Display_Value (Lat  : Latitude;
+                               Long : Longitude;
+                               Map  : Map_Type) return Display_Value;
+
+end CA11016_0.CA11016_1;
+
+
+     --==================================================================--
+
+
+package body CA11016_0.CA11016_1 is              
+
+   function Get_Display_Value (Lat  : Latitude;
+                               Long : Longitude;
+                               Map  : Map_Type) 
+     return Display_Value is
+   begin
+      case Get_Physical_Feature (Lat, Long, Map) is
+                                          -- Parent's operation,
+           when Forest => return (Display_Value'first);
+                                          -- Parent's type.
+           when Desert => return (Display_Value'last);
+                                          -- Parent's type.
+           when others => return 
+                            ( (Display_Value'last - Display_Value'first) / 2 );
+                                          -- NOTE: Results are truncated.
+      end case;
+
+   end Get_Display_Value;
+
+end CA11016_0.CA11016_1;
+
+
+     --==================================================================--
+
+-- Map display operation, public child of physical map.
+
+package CA11016_0.CA11016_2 is              
+
+   -- Super-duper Ultra Geographic Display Device (SDUGD) can display 
+   -- geographic locations with light intensity values ranging from 1 to 7.
+
+   type Display_Val is range 1 .. 7;
+
+   type Device_Color is (Brown, Blue, Green);
+
+   type IO_Packet is
+      record
+         Lat       : Latitude;       -- Parent's type.
+         Long      : Longitude;      -- Parent's type.
+         Color     : Device_Color;
+         Intensity : Display_Val;
+      end record;
+
+   procedure Data_For_SDUGD (Lat           : in     Latitude;
+                             Long          : in     Longitude;
+                             Output_Packet : in out IO_Packet);
+
+end CA11016_0.CA11016_2;
+
+     --==================================================================--
+
+
+with CA11016_0.CA11016_1;          -- Private generic sibling.
+pragma Elaborate (CA11016_0.CA11016_1);
+
+package body CA11016_0.CA11016_2 is              
+
+   -- Declare instance of the private generic sibling for 
+   -- an integer type that represents color intensity.
+
+   package SDUGD is new CA11016_0.CA11016_1 (Display_Val);
+
+   procedure Data_For_SDUGD (Lat           : in     Latitude;
+                             Long          : in     Longitude;
+                             Output_Packet : in out IO_Packet) is
+
+   -- Simulates sending control information to a display device.
+   -- Control information consists of latitude, longitude, a
+   -- color, and an intensity.
+
+   begin
+      case Get_Physical_Feature (Lat, Long, Basic_Map) is
+                                           -- Parent's operation.
+         when Water  => Output_Packet.Color     := Blue;
+                        Output_Packet.Intensity := SDUGD.Get_Display_Value 
+                                                   (Lat, Long, Basic_Map);
+                                           -- Sibling's operation.
+         when Forest => Output_Packet.Color     := Green;
+                        Output_Packet.Intensity := SDUGD.Get_Display_Value 
+                                                   (Lat, Long, Basic_Map);
+                                           -- Sibling's operation.
+         when others => Output_Packet.Color     := Brown;
+                        Output_Packet.Intensity := SDUGD.Get_Display_Value 
+                                                   (Lat, Long, Basic_Map);
+                                           -- Sibling's operation.
+       end case;
+
+   end Data_For_SDUGD;
+
+end CA11016_0.CA11016_2;
+
+     --==================================================================--
+
+with CA11016_0.CA11016_2;            -- Map display device operation,
+                                     -- implicitly withs parent, physical map
+                                     -- application.
+
+use CA11016_0.CA11016_2;             -- Allows direct visibility to the simple
+                                     -- name of CA11016_0.CA11016_2.
+
+with Report;
+
+procedure CA11016 is
+
+   TC_Packet : IO_Packet;
+
+begin 
+
+   Report.Test ("CA11016", "Check that body of a public child package can " &
+                           "use its sibling private generic package "       &
+                           "declarations and operations");
+
+-- Simulate control information at coordinates 3 and 7 of the
+-- basic map for the SDUGD.
+         
+         Water_Display_Subtest:
+         begin
+            TC_Packet.Lat  := 3;
+            TC_Packet.Long := 7;
+
+            -- Build color and light intensity of the basic map at 
+            -- latitude 3 and longitude 7.
+
+            Data_For_SDUGD (TC_Packet.Lat, TC_Packet.Long, TC_Packet);
+
+            if ( (TC_Packet.Color     /= Blue) or
+                 (TC_Packet.Intensity /= 3) ) then
+                Report.Failed ("Map display device contains " &
+                               "incorrect values for water subtest");
+            end if;
+
+         end Water_Display_Subtest;
+
+-- Simulate control information at coordinates 2 and 1 of the
+-- basic map for the SDUGD.
+         
+         Desert_Display_Subtest:
+         begin
+            TC_Packet.Lat  := 9;
+            TC_Packet.Long := 2;
+
+            -- Build color and light intensity of the basic map at 
+            -- latitude 9 and longitude 2.
+
+            Data_For_SDUGD (TC_Packet.Lat, TC_Packet.Long, TC_Packet);
+
+            if ( (TC_Packet.Color     /= Brown) or
+                 (TC_Packet.Intensity /= 7) ) then
+                Report.Failed ("Map display device contains " &
+                               "incorrect values for desert subtest");
+            end if;
+
+         end Desert_Display_Subtest;
+
+-- Simulate control information at coordinates 8 and 4 of the
+-- basic map for the SDUGD.
+         
+         Forest_Display_Subtest:
+         begin
+            TC_Packet.Lat  := 8;
+            TC_Packet.Long := 4;
+
+            -- Build color and light intensity of the basic map at 
+            -- latitude 8 and longitude 4.
+
+            Data_For_SDUGD (TC_Packet.Lat, TC_Packet.Long, TC_Packet);
+
+            if ( (TC_Packet.Color     /= Green) or
+                 (TC_Packet.Intensity /= 1) ) then
+                Report.Failed ("Map display device contains " &
+                               "incorrect values for forest subtest");
+            end if;
+
+         end Forest_Display_Subtest;
+
+   Report.Result;
+
+end CA11016;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11017.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11017.a
new file mode 100644
index 000000000..cbcce701d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11017.a
@@ -0,0 +1,246 @@
+-- CA11017.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 body of the parent package may depend on one of its own 
+--      public children.
+--
+-- TEST DESCRIPTION:
+--      A scenario is created that demonstrates the potential of adding a
+--      public child during code maintenance without distubing a large 
+--      subsystem.  After child is added to the subsystem, a maintainer
+--      decides to take advantage of the new functionality and rewrites
+--      the parent's body.
+--
+--      Declare a string abstraction in a package which manipulates string
+--      replacement. Define a parent package which provides operations for 
+--      a record type with discriminant.  Declare a public child of this 
+--      package which adds functionality to the original subsystem.  In the 
+--      parent body, call operations from the public child.
+--
+--      In the main program, check that operations in the parent and public 
+--      child perform as expected.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Simulates application which manipulates strings.
+
+package CA11017_0 is               
+
+   type String_Rec (The_Size : positive) is private;
+
+   type Substring is new string;
+
+   -- ... Various other types used by the application.
+
+   procedure Replace (In_The_String   : in out String_Rec;
+                      At_The_Position : in     positive;
+                      With_The_String : in     String_Rec);
+
+   -- ... Various other operations used by the application.
+
+private
+   -- Different size for each individual record.
+
+   type String_Rec (The_Size : positive) is
+      record
+         The_Length  : natural := 0;
+         The_Content : Substring (1 .. The_Size);
+      end record;
+
+end CA11017_0;
+
+     --=================================================================--
+
+-- Public child added during code maintenance without disturbing a 
+-- large system.  This public child would add functionality to the
+-- original system.
+
+package CA11017_0.CA11017_1 is    
+
+   Position_Error : exception;
+
+   function Equal_Length (Left  : in String_Rec;
+                          Right : in String_Rec) return boolean;
+
+   function Same_Content (Left  : in String_Rec;
+                          Right : in String_Rec) return boolean;
+
+   procedure Copy (From_The_Substring : in     Substring;
+                   To_The_String      : in out String_Rec);
+
+   -- ... Various other operations used by the application.
+
+end CA11017_0.CA11017_1;
+
+     --=================================================================--
+
+package body CA11017_0.CA11017_1 is    
+
+   function Equal_Length (Left  : in String_Rec;
+                          Right : in String_Rec) return boolean is
+   -- Quick comparison between the lengths of the input strings.
+
+   begin
+      return (Left.The_Length = Right.The_Length);  -- Parent's private
+                                                    -- type.
+   end Equal_Length;
+   --------------------------------------------------------------------
+   function Same_Content (Left  : in String_Rec;
+                          Right : in String_Rec) return boolean is
+
+   begin
+      for I in 1 .. Left.The_Length loop
+         if Left.The_Content (I) = Right.The_Content (I) then
+            return true;
+         else
+            return false;
+         end if;
+      end loop;
+
+   end Same_Content;
+   --------------------------------------------------------------------
+   procedure Copy (From_The_Substring : in     Substring;
+                   To_The_String      : in out String_Rec) is
+   begin
+      To_The_String.The_Content        -- Parent's private type.
+        (1 .. From_The_Substring'length) := From_The_Substring;
+
+      To_The_String.The_Length         -- Parent's private type.
+                                         := From_The_Substring'length;
+   end Copy;
+
+end CA11017_0.CA11017_1;
+
+     --=================================================================--
+
+--  After child is added to the subsystem, a maintainer decides
+--  to take advantage of the new functionality and rewrites the
+--  parent's body.
+
+with CA11017_0.CA11017_1;
+
+package body CA11017_0 is
+
+   -- Calls functions from public child for a quick comparison of the
+   -- input strings.  If their lengths are the same, do the replacement.
+
+   procedure Replace (In_The_String   : in out String_Rec;
+                      At_The_Position : in     positive;
+                      With_The_String : in     String_Rec) is
+      End_Position : natural := At_The_Position +
+                                With_The_String.The_Length - 1;
+
+   begin
+      if not CA11017_0.CA11017_1.Equal_Length  -- Public child's operation.
+        (With_The_String, In_The_String) then
+           raise CA11017_0.CA11017_1.Position_Error;                 
+                                               -- Public child's exception.
+      else 
+         In_The_String.The_Content (At_The_Position .. End_Position) :=
+           With_The_String.The_Content (1 .. With_The_String.The_Length);
+      end if;
+
+   end Replace;
+
+end CA11017_0;
+
+     --=================================================================--
+
+with Report;
+
+with CA11017_0.CA11017_1;   -- Explicit with public child package,
+                            -- implicit with parent package (CA11017_0).
+
+procedure CA11017 is
+
+   package String_Pkg renames CA11017_0;
+   use String_Pkg;
+
+begin
+
+   Report.Test ("CA11017", "Check that body of the parent package can " &
+                "depend on one of its own public children");
+
+-- Both input strings have the same size. Replace the first string by the 
+-- second string.  
+
+        Replace_Subtest:
+        declare
+           The_First_String, The_Second_String : String_Rec (16);
+                                                 -- Parent's private type.
+           The_Position                        : positive := 1;
+        begin
+           CA11017_1.Copy ("This is the time", 
+                           To_The_String => The_First_String); 
+
+           CA11017_1.Copy ("For all good men", The_Second_String); 
+
+           Replace (The_First_String, The_Position, The_Second_String);
+  
+           -- Compare results using function from public child since
+           -- the type is private.
+
+           if not CA11017_1.Same_Content
+                            (The_First_String, The_Second_String) then
+              Report.Failed ("Incorrect results");
+           end if;
+
+        end Replace_Subtest;
+
+-- During processing, the application may erroneously attempt to replace
+-- strings of different size. This would result in the raising of an 
+-- exception.                                                       
+
+        Exception_Subtest:
+        declare
+           The_First_String  : String_Rec (17);
+                                                 -- Parent's private type.
+           The_Second_String : String_Rec (13);
+                                                 -- Parent's private type.
+           The_Position      : positive := 2;
+        begin
+           CA11017_1.Copy (" ACVC Version 2.0", The_First_String); 
+
+           CA11017_1.Copy (From_The_Substring => "ACVC 9X Basic", 
+                           To_The_String      => The_Second_String); 
+
+           Replace (The_First_String, The_Position, The_Second_String);
+
+           Report.Failed ("Exception was not raised");
+
+        exception
+           when CA11017_1.Position_Error =>
+                  Report.Comment ("Exception is raised as expected");
+
+        end Exception_Subtest;
+
+   Report.Result;
+
+end CA11017;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11018.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11018.a
new file mode 100644
index 000000000..a01ebfc32
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11018.a
@@ -0,0 +1,366 @@
+-- CA11018.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 body of the parent package may depend on one of its own 
+--      public generic children.
+--
+-- TEST DESCRIPTION:
+--      A scenario is created that demonstrates the potential of adding a
+--      public generic child during code maintenance without distubing a large 
+--      subsystem.  After child is added to the subsystem, a maintainer
+--      decides to take advantage of the new functionality and rewrites
+--      the parent's body.
+--
+--      Declare a message application in a package which highlights some
+--      key words.  Declare a public generic child of this package which adds 
+--      functionality to the original subsystem.  In the parent body, 
+--      instantiate the child.
+--
+--      In the main program, check that the operations in the parent, 
+--      and instances of the public child package perform as expected.  
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      14 Dec 94   SAIC    Modified Copy_Particularly_Designated_Pkg inst.
+--      17 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+--
+--!
+  
+-- Simulates application which displays messages.
+
+package CA11018_0 is               
+
+   type Designated_Num is new Integer range 0 .. 100;
+
+   type Particularly_Designated_Num is new Integer range 0 .. 100;
+
+   type Message is new String;
+
+   type Message_Rec is tagged private;
+
+   type Designated_Msg is new Message_Rec with private;
+
+   type Particularly_Designated_Msg is new Message_Rec with private;
+
+   -- Analyzes message for presence of word in the secret message. If found, 
+   -- word is highlighted.
+
+   procedure Highlight_Designated (The_Word       : in     Message;
+                                   In_The_Message : in out Designated_Msg);
+                               
+
+   -- Analyzes message for presence of word in the secret message. If found, 
+   -- word is highlighted and do other actions.
+
+   procedure Highlight_Particularly_Designated 
+     (The_Word       : in     Message;
+      In_The_Message : in out Particularly_Designated_Msg);
+ 
+
+   -- Begin test code declarations: -----------------------
+
+   TC_Designated_Not_Zero : Boolean := false;
+
+   TC_Particularly_Designated_Not_Zero : Boolean := false;
+
+   -- The following two functions are used to check for function
+   -- calls from the public generic child.
+
+   function TC_Designated_Success return Boolean;
+
+   function TC_Particularly_Designated_Success return Boolean;
+
+   -- End test code declarations. -------------------------
+
+private
+   type Message_Rec is tagged
+      record
+         The_Length  : natural := 0;
+         The_Content : Message (1 .. 60);
+      end record;
+
+   type Designated_Msg is new Message_Rec with null record;
+   -- ... More components in real application.
+
+   type Particularly_Designated_Msg is new Message_Rec with null record;
+   -- ... More components in real application.
+
+end CA11018_0;
+
+     --=================================================================--
+
+
+-- Public generic child package of message display application.  Imagine that 
+-- messages of one security level are associated with a type derived from 
+-- integer.  For overall system security, messages of a different security
+-- level are associated with a different type derived from integer.  By 
+-- instantiating this package for each security level, the results of Count 
+-- applied to one kind of message cannot inadvertently be compared with the 
+-- results applied to a different kind.
+
+generic
+   type Msg_Type is new Message_Rec with private; 
+                                              -- Derived from parent's type.
+   type Count is range <>;
+
+package CA11018_0.CA11018_1 is    
+
+   TC_Function_Called : Boolean := false;
+
+   function Find_Word (Wrd : in Message;
+                       Msg : in Msg_Type) return Count;
+
+end CA11018_0.CA11018_1;
+
+     --=================================================================--
+
+package body CA11018_0.CA11018_1 is    
+
+   function Find_Word (Wrd : in Message;
+                       Msg : in Msg_Type) return Count is
+
+      Num  : Count   := Count'first;
+
+   -- Count how many time the word appears within the given message.
+
+   begin
+      -- ... Error-checking code omitted for brevity.
+
+      for I in 1 .. (Msg.The_Length - Wrd'length + 1) loop
+                                                 -- Parent's private type
+         if Msg.The_Content (I .. I + Wrd'length - 1) = Wrd
+                                                 -- Parent's private type
+           then
+              Num := Num + 1;
+         end if;
+
+      end loop;
+
+      TC_Function_Called := true;
+
+      return (Num);
+
+   end Find_Word;
+
+end CA11018_0.CA11018_1;
+
+     --=================================================================--
+
+with CA11018_0.CA11018_1;   -- Public generic child.
+
+pragma Elaborate (CA11018_0.CA11018_1);
+package body CA11018_0 is
+
+   ----------------------------------------------------
+   -- Parent's body depends on public generic child. --
+   ----------------------------------------------------
+
+   -- Instantiate the public child for the secret message.
+
+   package Designated_Pkg is new CA11018_0.CA11018_1 
+     (Msg_Type => Designated_Msg, Count => Designated_Num);
+
+   -- Instantiate the public child for the top secret message.
+
+   package Particularly_Designated_Pkg is new CA11018_0.CA11018_1 
+     (Particularly_Designated_Msg, Particularly_Designated_Num);
+
+   -- End instantiations. -----------------------------
+
+   
+   function TC_Designated_Success return Boolean is
+   -- Check to see if the function in the public generic child is called.
+
+   begin
+      return Designated_Pkg.TC_Function_Called;
+   end TC_Designated_Success;
+   --------------------------------------------------------------
+   function TC_Particularly_Designated_Success return Boolean is
+   -- Check to see if the function in the public generic child is called.
+
+   begin
+      return Particularly_Designated_Pkg.TC_Function_Called;
+   end TC_Particularly_Designated_Success;
+   --------------------------------------------------------------
+   -- Calls functions from public child to search for a key word.  
+   -- If the word appears more than once in each message, 
+   -- highlight all of them.
+
+   procedure Highlight_Designated (The_Word       : in     Message;
+                                   In_The_Message : in out Designated_Msg) is
+
+   -- Not a real highlight procedure.  Real application can use graphic
+   -- device to highlight all occurrences of words.
+
+   begin
+      --------------------------------------------------------------
+      -- Parent's body uses function from instantiation of public --
+      -- generic child.                                           --
+      --------------------------------------------------------------
+
+      if Designated_Pkg.Find_Word          -- Child's operation.   
+        (The_Word, In_The_Message) > 0 then
+
+          -- Highlight all occurrences in lavender.
+
+          TC_Designated_Not_Zero := true;       
+      end if;
+
+   end Highlight_Designated;
+   --------------------------------------------------------------
+   procedure Highlight_Particularly_Designated 
+     (The_Word       : in     Message;
+      In_The_Message : in out Particularly_Designated_Msg) is
+
+   -- Not a real highlight procedure.  Real application can use graphic
+   -- device to highlight all occurrences of words.
+
+   begin
+      --------------------------------------------------------------
+      -- Parent's body uses function from instantiation of public --
+      -- generic child.                                           --
+      --------------------------------------------------------------
+
+      if Particularly_Designated_Pkg.Find_Word     -- Child's operation.   
+        (The_Word, In_The_Message) > 0 then
+
+          -- Highlight all occurrences in chartreuse.
+          -- Do other more secret stuff.
+
+          TC_Particularly_Designated_Not_Zero := true;       
+      end if;
+
+   end Highlight_Particularly_Designated;
+
+end CA11018_0;
+
+     --=================================================================--
+
+-- Public generic child to copy words to the messages.
+
+generic
+   type Message_Type is new Message_Rec with private; 
+                        -- Derived from parent's type.
+
+package CA11018_0.CA11018_2 is    
+
+   procedure Copy (From_The_Word  : in     Message;
+                   To_The_Message : in out Message_Type);
+
+end CA11018_0.CA11018_2;
+
+     --=================================================================--
+
+package body CA11018_0.CA11018_2 is    
+
+   procedure Copy (From_The_Word  : in     Message;
+                   To_The_Message : in out Message_Type) is
+
+   -- Copy words to the appropriate messages.
+
+   begin
+      To_The_Message.The_Content        -- Parent's private type.
+        (1 .. From_The_Word'length) := From_The_Word;
+
+      To_The_Message.The_Length         -- Parent's private type.
+                                    := From_The_Word'length;
+   end Copy;
+
+end CA11018_0.CA11018_2;
+
+     --=================================================================--
+
+with Report;
+
+with CA11018_0.CA11018_2;   -- Public generic child package, copy words
+                            -- to the message.
+                            -- Implicit with parent package (CA11018_0).
+
+procedure CA11018 is
+
+   package Message_Pkg renames CA11018_0;
+
+begin
+
+   Report.Test ("CA11018", "Check that body of the parent package can " &
+                "depend on one of its own public generic children");
+
+-- Highlight the word "Alert" from the secret message.
+ 
+       Designated_Subtest:
+       declare
+          The_Message : Message_Pkg.Designated_Msg;  -- Parent's private type.
+
+          -- Instantiate the public child to copy words to the secret message.
+
+          package Copy_Designated_Pkg is new CA11018_0.CA11018_2 
+            (Message_Pkg.Designated_Msg);
+
+       begin
+          Copy_Designated_Pkg.Copy ("Alert Level 1 : Alert The Guard", 
+                                To_The_Message => The_Message);
+
+          Message_Pkg.Highlight_Designated ("Alert", The_Message);
+
+          if not Message_Pkg.TC_Designated_Not_Zero and 
+            Message_Pkg.TC_Designated_Success then
+               Report.Failed ("Alert should have been highlighted");
+          end if;
+
+       end Designated_Subtest;
+
+-- Highlight the word "Push The Alarm" from the top secret message.
+
+       Particularly_Designated_Subtest:
+       declare
+          The_Message : Message_Pkg.Particularly_Designated_Msg ;  
+                                         -- Parent's private type.
+
+          -- Instantiate the public child to copy words to the top secret
+          -- message.
+
+          package Copy_Particularly_Designated_Pkg is new 
+            CA11018_0.CA11018_2 (Message_Pkg.Particularly_Designated_Msg);
+
+       begin
+          Copy_Particularly_Designated_Pkg.Copy 
+            ("Alert Level 10 : Alert The Guard and Push The Alarm", 
+             The_Message);
+
+          Message_Pkg.Highlight_Particularly_Designated 
+            ("Push The Alarm", The_Message);
+
+          if not Message_Pkg.TC_Particularly_Designated_Not_Zero and 
+            Message_Pkg.TC_Particularly_Designated_Success then
+               Report.Failed ("Key words should have been highlighted");
+          end if;
+
+       end Particularly_Designated_Subtest;
+
+   Report.Result;
+
+end CA11018;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11019.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11019.a
new file mode 100644
index 000000000..92b3ba535
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11019.a
@@ -0,0 +1,306 @@
+-- CA11019.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 body of the parent package may depend on one of its own
+--      private generic children.
+--
+-- TEST DESCRIPTION:
+--      A scenario is created that demonstrates the potential of adding a
+--      generic private child during code maintenance without distubing a 
+--      large subsystem.  After child is added to the subsystem, a maintainer
+--      decides to take advantage of the new functionality and rewrites
+--      the parent's body.
+--
+--      Declare a data collection abstraction in a package. Declare a private
+--      generic child of this package which provides parameterized code that
+--      have been written once and will be used three times to implement the
+--      services of the parent package. In the parent body, instantiate the 
+--      private child.  
+--
+--      In the main program, check that the operations in the parent, 
+--      and instance of the private child package perform as expected.  
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      17 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+--
+--!
+  
+package CA11019_0 is   
+     -- parent
+
+   type Data_Record is tagged private;
+   type Data_Collection is private;
+   ---
+   ---
+   subtype Data_1 is integer range 0 .. 100;
+   procedure Add_1 (Data : Data_1; To : in out Data_Collection);  
+   function Statistical_Op_1 (Data : Data_Collection) return Data_1;
+   ---
+   subtype Data_2 is integer range -100 .. 1000;
+   procedure Add_2 (Data : Data_2; To : in out Data_Collection);
+   function Statistical_Op_2 (Data : Data_Collection) return Data_2;
+   ---
+   subtype Data_3 is integer range -10_000 .. 10_000;
+   procedure Add_3 (Data : Data_3; To : in out Data_Collection);  
+   function Statistical_Op_3 (Data : Data_Collection) return Data_3;
+   ---
+
+private
+
+   type Data_Ptr is access Data_Record'class;
+   subtype Sequence_Number is positive range 1 .. 512;
+
+   type Data_Record is tagged 
+     record
+        Next  : Data_Ptr := null;
+        Seq   : Sequence_Number;
+     end record;
+   ---
+   type Data_Collection is 
+     record
+        First : Data_Ptr := null;
+        Last  : Data_Ptr := null;
+     end record;
+            
+end CA11019_0;
+ -- parent
+
+    --=================================================================--
+
+-- This generic package provides parameterized code that has been
+-- written once and will be used three times to implement the services
+-- of the parent package.
+
+private
+generic   
+   type Data_Type is range <>;
+
+package CA11019_0.CA11019_1 is    
+     -- parent.child
+
+   type Data_Elem is new Data_Record with
+     record
+        Value : Data_Type;
+     end record;
+
+   Next_Avail_Seq_No : Sequence_Number := 1;
+
+   procedure Sequence (Ptr : Data_Ptr);
+    -- the child must be private for this procedure to know details of
+    -- the implementation of data collections
+
+   procedure Add (Datum : Data_Type; To : in out Data_Collection);
+
+   function  Op  (Data : Data_Collection) return Data_Type;
+    -- op models a complicated operation that whose code can be
+    -- used for various data types
+
+
+end CA11019_0.CA11019_1;
+ -- parent.child
+
+     --=================================================================--
+
+ 
+package body CA11019_0.CA11019_1 is    
+          -- parent.child
+
+   procedure Sequence (Ptr : Data_Ptr) is
+   begin
+      Ptr.Seq := Next_Avail_Seq_No;
+      Next_Avail_Seq_No := Next_Avail_Seq_No + 1;
+   end Sequence;
+
+   ---------------------------------------------------------
+
+   procedure Add (Datum : Data_Type; To : in out Data_Collection) is
+      Ptr : Data_Ptr;
+   begin
+      if To.First = null then
+         -- assign new record with data value to 
+         -- to.next <- null;
+         To.First := new Data_Elem'(Next  => null,
+                                    Value => Datum,
+                                    Seq   => 1);
+         Sequence (To.First);
+         To.Last := To.First;
+      else
+         -- chase to end of list
+         Ptr := To.First;
+         while Ptr.Next /= null loop
+            Ptr := Ptr.Next;
+         end loop;
+         -- and add element there
+         Ptr.Next := new Data_Elem'(Next  => null,
+                                    Value => Datum,
+                                    Seq   => 1);
+         Sequence (Ptr.Next);
+         To.Last := Ptr.Next;
+      end if;
+
+   end Add;
+
+   ---------------------------------------------------------
+
+   function  Op  (Data : Data_Collection) return Data_Type is
+      -- for simplicity, just return the maximum of the data set
+      Max : Data_Type := Data_Elem( Data.First.all ).Value; 
+                              -- assuming non-empty collection
+      Ptr : Data_Ptr  := Data.First;
+
+   begin
+      -- no error checking
+      while Ptr.Next /= null loop
+         if Data_Elem( Ptr.Next.all ).Value > Max then
+            Max := Data_Elem( Ptr.Next.all ).Value;
+         end if;
+         Ptr := Ptr.Next;
+      end loop;
+      return Max;
+   end Op;
+
+end CA11019_0.CA11019_1;
+ -- parent.child
+
+     --=================================================================--
+
+-- parent body depends on private generic child
+with CA11019_0.CA11019_1;     -- Private generic child.
+
+pragma Elaborate (CA11019_0.CA11019_1);
+package body CA11019_0 is
+
+   -- instantiate the generic child with data types needed by the 
+   -- package interface services
+   package Data_1_Ops is new CA11019_1
+     (Data_Type => Data_1);
+ 
+   package Data_2_Ops is new CA11019_1
+     (Data_Type => Data_2);
+
+   package Data_3_Ops is new CA11019_1
+     (Data_Type => Data_3);
+
+   ---------------------------------------------------------
+
+   procedure Add_1 (Data : Data_1; To : in out Data_Collection) is
+   begin
+      -- maybe do other stuff here
+      Data_1_Ops.Add (Data, To);
+      -- and here
+   end;
+
+   ---------------------------------------------------------
+
+   function Statistical_Op_1 (Data : Data_Collection) return Data_1 is
+   begin
+      -- maybe use generic operation(s) in some complicated ways
+      -- (but simplified out, for the sake of testing)
+      return Data_1_Ops.Op (Data);
+   end;
+
+   ---------------------------------------------------------
+
+   procedure Add_2 (Data : Data_2; To : in out Data_Collection) is
+   begin
+      Data_2_Ops.Add (Data, To);
+   end;
+
+   ---------------------------------------------------------
+
+   function Statistical_Op_2 (Data : Data_Collection) return Data_2 is
+   begin
+      return Data_2_Ops.Op (Data);
+   end;
+
+   ---------------------------------------------------------
+
+   procedure Add_3 (Data : Data_3; To : in out Data_Collection) is
+   begin
+      Data_3_Ops.Add (Data, To);
+   end;
+
+   ---------------------------------------------------------
+
+   function Statistical_Op_3 (Data : Data_Collection) return Data_3 is
+   begin
+      return Data_3_Ops.Op (Data);
+   end;
+
+end CA11019_0;
+
+
+     --=================================================--
+
+with CA11019_0,
+  -- Main,    
+  -- Main.Child is private
+     Report;
+
+procedure CA11019 is
+
+   package Main renames CA11019_0;
+
+   Col_1,
+   Col_2,
+   Col_3 : Main.Data_Collection;
+
+begin
+
+   Report.Test ("CA11019", "Check that body of a (non-generic) package " &
+                "may depend on its private generic child");
+
+   -- build a data collection
+
+   for I in 1 .. 10 loop
+      Main.Add_1 ( Main.Data_1(I), Col_1);
+   end loop;
+
+   if Main.Statistical_Op_1 (Col_1) /= 10 then 
+      Report.Failed ("Wrong data_1 value returned");
+   end if;
+
+   for I in reverse 10 .. 20 loop
+      Main.Add_2 ( Main.Data_2(I * 10), Col_2);
+   end loop;
+
+   if Main.Statistical_Op_2 (Col_2) /= 200 then 
+      Report.Failed ("Wrong data_2 value returned");
+   end if;
+
+   for I in 0 .. 10 loop
+      Main.Add_3 ( Main.Data_3(I + 5), Col_3);
+   end loop;
+
+   if Main.Statistical_Op_3 (Col_3) /= 15 then 
+      Report.Failed ("Wrong data_3 value returned");
+   end if;
+
+   Report.Result;
+
+end CA11019;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11020.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11020.a
new file mode 100644
index 000000000..4949ce9fe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11020.a
@@ -0,0 +1,238 @@
+-- CA11020.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 body of the generic parent package can depend on one of 
+--      its own public generic children.
+--
+-- TEST DESCRIPTION:
+--      A scenario is created that demonstrates the potential of adding a
+--      public generic child during code maintenance without distubing a large 
+--      subsystem.  After child is added to the subsystem, a maintainer
+--      decides to take advantage of the new functionality and rewrites
+--      the parent's body.
+--
+--      Declare a bag abstraction in a generic package. Declare a public 
+--      generic child of this package which adds a generic procedure to the 
+--      original subsystem.  In the parent body, instantiate the public
+--      child.  Then instantiate the procedure as a child instance of the
+--      public child instance.  
+--
+--      In the main program, declare an instance of parent.  Check that the 
+--      operations in both parent and child packages perform as expected.  
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Simulates bag application.
+
+generic
+   type Element is private;
+   with function Image (E : Element) return String;
+
+package CA11020_0 is
+
+   type Bag is limited private;
+
+   procedure Add (E : in Element; To_The_Bag : in out Bag);
+
+   function Bag_Image (B : Bag) return string;
+
+private
+   type Node_Type;
+   type Bag is access Node_Type;
+
+   type Node_Type is
+      record
+         The_Element : Element;
+
+         -- Other components in real application, i.e.,
+         -- The_Count   : positive;
+
+         Next        : Bag;
+      end record;
+
+end CA11020_0;
+
+     --==================================================================--
+
+-- More operations on Bag.
+
+generic
+
+-- Parameters go here.
+
+package CA11020_0.CA11020_1 is        
+
+   -- ... Other declarations.
+
+   generic                            -- Generic iterator procedure.
+      with procedure Use_Element (E : in Element);
+
+   procedure Iterate (B : in Bag);    -- Called once per element in the bag.
+
+   -- ... Various other operations.
+
+end CA11020_0.CA11020_1;
+
+     --==================================================================--
+
+package body CA11020_0.CA11020_1 is 
+
+   procedure Iterate (B : in Bag) is
+
+   -- Traverse each element in the bag.
+
+      Elem : Bag := B;
+
+   begin
+      while Elem /= null loop
+         Use_Element (Elem.The_Element);
+         Elem := Elem.Next;
+      end loop;
+
+   end Iterate;      
+
+end CA11020_0.CA11020_1;
+
+     --==================================================================--
+
+with CA11020_0.CA11020_1;    -- Public generic child package.
+
+package body CA11020_0 is
+
+   ----------------------------------------------------
+   -- Parent's body depends on public generic child. --
+   ----------------------------------------------------
+
+   -- Instantiate the public child.
+
+   package MS is new CA11020_1;  
+
+   function Bag_Image (B : Bag) return string is
+
+      Buffer : String (1 .. 10_000);
+      Last   : Integer := 0;
+
+      -----------------------------------------------------
+
+      -- Will be called by the iterator.
+
+      procedure Append_Image (E : in Element) is  
+         Im : constant String := Image (E);
+
+      begin  -- Append_Image
+         if Last /= 0 then        -- Insert a comma.
+            Last := Last + 1;
+            Buffer (Last) := ',';
+         end if;
+
+         Buffer (Last + 1 .. Last + Im'Length) := Im;
+         Last := Last + Im'Length;
+
+      end Append_Image;
+
+      -----------------------------------------------------
+
+      -- Instantiate procedure Iterate as a child of instance MS.
+
+      procedure Append_All is new MS.Iterate (Use_Element => Append_Image);
+
+   begin  -- Bag_Image
+
+      Append_All (B);
+
+      return Buffer (1 .. Last);
+
+   end Bag_Image;
+
+           -----------------------------------------------------
+
+   procedure Add (E : in Element; To_The_Bag : in out Bag) is
+
+      -- Not a real bag addition.
+
+      Index : Bag := To_The_Bag;
+
+   begin
+      -- ... Error-checking code omitted for brevity.
+    
+      if Index = null then
+         To_The_Bag := new Node_Type' (The_Element => E,
+                                       Next        => null);
+      else
+         -- Goto the end of the list.
+
+         while Index.Next /= null loop
+            Index := Index.Next;
+         end loop;
+
+         -- Add element to the end of the list.
+
+         Index.Next := new Node_Type' (The_Element => E,
+                                       Next        => null);
+      end if;
+
+   end Add;
+
+end CA11020_0;
+
+     --==================================================================--
+
+with CA11020_0;               -- Bag application.
+
+with Report;
+
+procedure CA11020 is
+
+    -- Instantiate the bag application for integer type and attribute
+    -- Image.
+
+    package Bag_Of_Integers is new CA11020_0 (Integer, Integer'Image);
+
+    My_Bag : Bag_Of_Integers.Bag;
+
+begin 
+
+   Report.Test ("CA11020", "Check that body of the generic parent package " &
+                "can depend on one of its own public generic children");
+
+   -- Add 10 consecutive integers to the bag.
+
+   for I in 1 .. 10 loop
+      Bag_Of_Integers.Add (I, My_Bag);
+   end loop;
+
+   if Bag_Of_Integers.Bag_Image (My_Bag) 
+      /= " 1, 2, 3, 4, 5, 6, 7, 8, 9, 10" then
+         Report.Failed ("Incorrect results");
+   end if;
+
+   Report.Result;
+
+end CA11020;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11021.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11021.a
new file mode 100644
index 000000000..f4da2f913
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11021.a
@@ -0,0 +1,245 @@
+-- CA11021.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 body of the generic parent package can depend on one of 
+--      its own private generic children.
+--      
+-- TEST DESCRIPTION:
+--      A scenario is created that demonstrates the potential of adding a
+--      public generic child during code maintenance without distubing a large 
+--      subsystem.  After child is added to the subsystem, a maintainer
+--      decides to take advantage of the new functionality and rewrites
+--      the parent's body.
+--
+--      Declare a generic package which declares high level operations for a
+--      complex number abstraction.  Declare a private generic child package 
+--      of this package which defines low level complex operations. In the 
+--      parent body, instantiate the private child.  Use the low level
+--      operation to complete the high level operation.
+--
+--      In the main program, instantiate the parent generic package.
+--      Check that the operations in both packages perform as expected.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+generic               -- Complex number abstraction.
+   type Int_Type is range <>;
+
+package CA11021_0 is
+ 
+   -- Simulate a generic complex number support package. Complex numbers
+   -- are treated as coordinates in the Cartesian plane.
+
+   type Complex_Type is private;
+
+   Zero : constant Complex_Type;                      -- Real number (0,0).
+
+   function Real_Part (Complex_No : Complex_Type)
+     return Int_Type;
+
+   function Imag_Part (Complex_No : Complex_Type)
+     return Int_Type;
+
+   function Complex (Real, Imag : Int_Type)           
+     return Complex_Type;                             
+
+   -- High level operation for complex number.
+   function "*" (Factor : Int_Type; 
+                 C      : Complex_Type) return Complex_Type;
+
+   -- ... and other complicated ones.
+
+private
+   type Complex_Type is record
+      Real : Int_Type;
+      Imag : Int_Type;
+   end record;
+
+   Zero : constant Complex_Type := (Real => 0, Imag => 0);
+
+end CA11021_0;
+
+     --==================================================================--
+
+-- Private generic child of Complex_Number.  
+
+private
+
+generic               
+
+-- No parameter.
+
+package CA11021_0.CA11021_1 is
+ 
+   -- ... Other declarations.
+
+   -- Low level operation on complex number. 
+   function "+" (Left, Right : Complex_Type)              
+     return Complex_Type;                     
+
+   function "-" (Right : Complex_Type)                
+     return Complex_Type;                             
+
+   -- ... Various other operations in real application.
+
+end CA11021_0.CA11021_1;
+
+     --==================================================================--
+
+package body CA11021_0.CA11021_1 is
+
+   function "+" (Left, Right : Complex_Type)              
+     return Complex_Type is
+
+   begin
+      return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
+   end "+";
+
+               --------------------------------------------------
+
+   function "-" (Right : Complex_Type) return Complex_Type is
+   begin
+      return (-Right.Real, -Right.Imag);
+   end "-";
+
+end CA11021_0.CA11021_1;
+
+     --==================================================================--
+
+with CA11021_0.CA11021_1;    -- Private generic child package.
+
+package body CA11021_0 is
+
+   -----------------------------------------------------
+   -- Parent's body depends on private generic child. --
+   -----------------------------------------------------
+
+   -- Instantiate the private child.
+
+   package Complex_Ops is new CA11021_1;  
+   use Complex_Ops;                    -- All user-defined operators 
+                                       -- directly visible.        
+
+               --------------------------------------------------
+
+   function "*" (Factor : Int_Type; 
+                 C      : Complex_Type) return Complex_Type is
+      Result : Complex_Type := Zero;   
+
+   begin
+      for I in 1 .. abs (Factor) loop
+         Result := Result + C;         -- Private generic child "+".
+      end loop;
+
+      if Factor < 0 then
+         Result := - Result;           -- Private generic child "-".
+      end if;
+
+      return Result;
+   end "*";
+
+               --------------------------------------------------
+
+   function Real_Part (Complex_No : Complex_Type) return Int_Type is
+   begin
+      return (Complex_No.Real);
+   end Real_Part;
+
+               --------------------------------------------------
+
+   function Imag_Part (Complex_No : Complex_Type) return Int_Type is
+   begin
+      return (Complex_No.Imag);
+   end Imag_Part;
+
+               --------------------------------------------------
+
+   function Complex (Real, Imag : Int_Type) return Complex_Type is
+   begin
+      return (Real, Imag);
+   end Complex;
+
+end CA11021_0;
+
+     --==================================================================--
+
+with CA11021_0;                        -- Complex number abstraction.
+
+with Report;
+
+procedure CA11021 is
+
+   type My_Integer is range -100 .. 100;
+
+               --------------------------------------------------
+
+-- Declare instance of the generic complex package for one particular 
+-- integer type.  
+
+   package My_Complex_Pkg is new 
+     CA11021_0 (Int_Type => My_Integer);
+
+   use My_Complex_Pkg;                 -- All user-defined operators 
+                                       -- directly visible.
+
+               --------------------------------------------------
+
+   Complex_One, Complex_Two : Complex_Type;
+
+   My_Literal               : My_Integer := -3;
+
+begin
+
+   Report.Test ("CA11021", "Check that body of the generic parent package " &
+                "can depend on its private generic child");
+
+   Complex_One := Complex (11, 6);          
+
+   Complex_Two := 5 * Complex_One; 
+
+   if Real_Part (Complex_Two) /= 55         
+     and Imag_Part (Complex_Two) /= 30     
+        then
+           Report.Failed ("Incorrect results from complex operation");
+   end if;
+
+   Complex_One := Complex (-4, 7);          
+
+   Complex_Two := My_Literal * Complex_One; 
+
+   if Real_Part (Complex_Two) /= 12         
+     and Imag_Part (Complex_Two) /= -21     
+        then
+           Report.Failed ("Incorrect results from complex operation");
+   end if;
+
+   Report.Result;
+
+end CA11021;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11022.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11022.a
new file mode 100644
index 000000000..60cbc08ce
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11022.a
@@ -0,0 +1,242 @@
+-- CA11022.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 body of a child unit can instantiate its generic sibling.
+--      
+-- TEST DESCRIPTION:
+--      Declare a package that provides some types for the graphic 
+--      application.  Add a generic child package with a subprogram parameter
+--      to provide algorithms that can be used by different terminal types
+--      but that have to be customized to the specific terminal. Add child 
+--      packages to take advantage of the parent types and to provide a 
+--      customized operation for each of the different terminals.  The 
+--      customized operation will be passed as a generic subprogram parameter 
+--      to the child package's sibling.
+--
+--      The main program "with"s the child packages.  Check that the
+--      operations in child units perform as expected.  
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CA11022_0 is    -- Graphic Manager
+ 
+   type Row is range 1 .. 66;
+   type Column is range 1 .. 80;
+   type Radius is range 1 .. 3;
+   type Length is range 5 .. 10;
+
+   -- Testing artifice.
+   TC_Screen : array (Row, Column) of boolean := (others => (others => false));
+   TC_Draw_Circle : boolean := false;
+   TC_Draw_Square : boolean := false;
+
+   -- ... and other complicated ones.
+
+end CA11022_0;
+
+-- No bodies required for CA11022_0.
+
+     --==================================================================--
+
+-- Child package to provide general graphic functionalities.
+
+generic               
+
+   with procedure Put_Dot (X : in Column;
+                           Y : in Row);
+
+package CA11022_0.CA11022_1 is     
+
+   procedure Draw_Square (At_Col : in Column;
+                          At_Row : in Row;
+                          Len    : in Length);
+
+   procedure Draw_Circle (At_Col : in Column;
+                          At_Row : in Row;
+                          Rad    : in Radius);
+
+   -- procedure Draw_Ellipse ...
+   -- and other drawings ...
+
+end CA11022_0.CA11022_1;
+
+     --==================================================================--
+
+package body CA11022_0.CA11022_1 is
+
+   procedure Draw_Square (At_Col : in Column;
+                          At_Row : in Row;
+                          Len    : in Length) is
+   begin
+      -- use square drawing algorithm 
+      -- call
+      Put_Dot (At_Col + Column (Len), At_Row + Row(Len));
+      -- as needed in the algorithm.
+      TC_Draw_Square := true;
+   end Draw_Square;
+
+   -------------------------------------------------------
+   procedure Draw_Circle (At_Col : in Column;
+                          At_Row : in Row;
+                          Rad    : in Radius) is
+   begin
+      -- use circle drawing algorithm 
+      -- call
+      for I in 1 .. Rad loop
+         Put_Dot (At_Col + Column(I), At_Row + Row(I));
+      end loop;
+      -- as needed in the algorithm.
+      TC_Draw_Circle := true;
+   end Draw_Circle;
+
+end CA11022_0.CA11022_1;
+
+     --==================================================================--
+
+with CA11022_0.CA11022_1;                -- Generic sibling.
+
+-- Child package to provide customized graphic functions for the
+-- VT100.
+package CA11022_0.CA11022_2 is           -- VT100 Graphic.
+
+   X : Column := 8;
+   Y : Row    := 3;
+   R : Radius := 2;
+   L : Length := 6;
+
+   procedure VT100_Graphic;
+
+end CA11022_0.CA11022_2;
+
+     --==================================================================--
+
+package body CA11022_0.CA11022_2 is    
+
+   procedure VT100_Graphic is
+      procedure VT100_Putdot (X : in Column;
+                              Y : in Row) is
+      begin   
+         -- Light a pixel at location (X, Y);
+         TC_Screen (Y, X) := true;
+      end VT100_Putdot;
+
+                  ------------------------------------
+
+      -- Declare instance of the generic sibling package to draw a circle, 
+      -- a square, or an ellipse customized for the VT100.
+      package VT100_Graphic is new CA11022_0.CA11022_1 (VT100_Putdot);
+   
+   begin  
+      VT100_Graphic.Draw_Circle (X, Y, R);
+      VT100_Graphic.Draw_Square (X, Y, L);
+   end VT100_Graphic;
+
+end CA11022_0.CA11022_2;
+
+     --==================================================================--
+
+with CA11022_0.CA11022_1;                -- Generic sibling.
+
+-- Child package to provide customized graphic functions for the
+-- IBM3270.
+package CA11022_0.CA11022_3 is           -- IBM3270 Graphic.
+
+   X : Column := 39;
+   Y : Row    := 11;
+   R : Radius := 3;
+   L : Length := 7;
+
+   procedure IBM3270_Graphic;
+
+end CA11022_0.CA11022_3;
+
+     --==================================================================--
+
+package body CA11022_0.CA11022_3 is    
+
+   procedure IBM3270_Graphic is
+      procedure IBM3270_Putdot (X : in Column;
+                             Y : in Row) is
+      begin   
+         -- Light a pixel at location (X + 2, Y);
+         TC_Screen (Y, X + Column(2)) := true;
+      end IBM3270_Putdot;
+
+                  ------------------------------------
+
+      -- Declare instance of the generic sibling package to draw a circle, 
+      -- a square, or an ellipse customized for the IBM3270.
+      package IBM3270_Graphic is new CA11022_0.CA11022_1 (IBM3270_Putdot);
+   
+   begin  
+      IBM3270_Graphic.Draw_Circle (X, Y, R);
+      IBM3270_Graphic.Draw_Square (X, Y, L);
+   end IBM3270_Graphic;
+
+end CA11022_0.CA11022_3;
+
+     --==================================================================--
+
+with CA11022_0.CA11022_2;              -- VT100 Graphic, implicitly with
+                                       -- CA11022_0, Graphic Manager.
+with CA11022_0.CA11022_3;              -- IBM3270 Graphic.
+with Report;
+
+procedure CA11022 is
+
+begin
+
+   Report.Test ("CA11022", "Check that body of a child unit can depend on " &
+                "its generic sibling");
+
+   -- Customized graphic functions for the VT100 terminal.
+   CA11022_0.CA11022_2.VT100_Graphic;
+
+   if not CA11022_0.TC_Screen (4,9) and not CA11022_0.TC_Screen (5,10) 
+     and not CA11022_0.TC_Screen (9,14) and not CA11022_0.TC_Draw_Circle 
+       and not CA11022_0.TC_Draw_Square then
+          Report.Failed ("Wrong results for the VT100");
+   end if;
+
+   CA11022_0.TC_Draw_Circle := false;
+   CA11022_0.TC_Draw_Square := false;
+
+   -- Customized graphic functions for the IBM3270 terminal.
+   CA11022_0.CA11022_3.IBM3270_Graphic;
+
+   if not CA11022_0.TC_Screen (12,42) and not CA11022_0.TC_Screen (13,43) 
+     and not CA11022_0.TC_Screen (14,44) and not CA11022_0.TC_Screen (46,18) 
+       and not CA11022_0.TC_Draw_Circle and not CA11022_0.TC_Draw_Square then
+          Report.Failed ("Wrong results for the IBM3270");
+   end if;
+
+   Report.Result;
+
+end CA11022;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1102a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1102a0.ada
new file mode 100644
index 000000000..23f766fb5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1102a0.ada
@@ -0,0 +1,31 @@
+-- CA1102A0.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.
+--*
+-- WKB 6/12/81
+
+PACKAGE CA1102A0 IS          -- BODY IS IN CA1102A1.
+
+     PROCEDURE P (INVOKED : IN OUT BOOLEAN);
+
+END CA1102A0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1102a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1102a1.ada
new file mode 100644
index 000000000..e201a5148
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1102a1.ada
@@ -0,0 +1,36 @@
+-- CA1102A1.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.
+--*
+-- WKB 6/12/81
+
+PACKAGE BODY CA1102A0 IS
+
+     PROCEDURE P (INVOKED : IN OUT BOOLEAN) IS
+     BEGIN
+          INVOKED := TRUE;
+     END P;
+
+BEGIN
+     NULL;
+END CA1102A0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1102a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1102a2.ada
new file mode 100644
index 000000000..b4cffd124
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1102a2.ada
@@ -0,0 +1,58 @@
+-- CA1102A2M.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 MORE THAN ONE WITH_CLAUSE CAN APPEAR IN
+--   A CONTEXT_SPECIFICATION.
+-- CHECK THAT USE_CLAUSES CAN MENTION NAMES MADE
+--   VISIBLE BY PRECEDING WITH_CLAUSES IN THE SAME
+--   CONTEXT_SPECIFICATION.
+-- CHECK THAT CONSECUTIVE USE_CLAUSES ARE ALLOWED.
+
+-- SEPARATE FILES ARE:
+--   CA1102A0  A LIBRARY PACKAGE DECLARATION.
+--   CA1102A1  A LIBRARY PACKAGE BODY (CA1102A0).
+--   CA1102A2M THE MAIN PROCEDURE.
+
+-- WKB 6/12/81
+-- BHS 7/19/84
+
+WITH CA1102A0;
+WITH REPORT; USE CA1102A0; USE REPORT;
+PROCEDURE CA1102A2M IS
+
+
+     INVOKED : BOOLEAN := FALSE;
+
+BEGIN
+     TEST ("CA1102A", "MORE THAN ONE WITH_CLAUSE; ALSO, A " &
+           "USE_CLAUSE REFERING TO A PRECEDING WITH_CLAUSE " &
+           "IN THE SAME CONTEXT_SPECIFICATION");
+
+     P (INVOKED);
+     IF NOT INVOKED THEN
+          FAILED ("COMPILATION UNIT NOT MADE VISIBLE");
+     END IF;
+
+     RESULT;
+END CA1102A2M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1106a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1106a.ada
new file mode 100644
index 000000000..b3da9d102
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1106a.ada
@@ -0,0 +1,112 @@
+-- CA1106A.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 WITH CLAUSE FOR A PACKAGE BODY (GENERIC OR
+--     NONGENERIC) OR FOR A GENERIC SUBPROGRAM BODY CAN NAME THE
+--     CORRESPONDING SPECIFICATION, AND A USE CLAUSE CAN ALSO BE
+--     GIVEN.
+
+-- HISTORY:
+--     JET 07/14/88  CREATED ORIGINAL TEST.
+--     PWN 05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+PACKAGE CA1106A_1 IS
+     I : INTEGER := 0;
+     PROCEDURE REQUIRE_BODY;
+END CA1106A_1;
+
+GENERIC
+     TYPE TG IS RANGE <>;
+PACKAGE CA1106A_2 IS
+     J : TG := 0;
+     PROCEDURE REQUIRE_BODY;
+END CA1106A_2;
+
+GENERIC
+     TYPE TG IS RANGE <>;
+FUNCTION CA1106A_3 RETURN TG;
+
+WITH REPORT; USE REPORT;
+WITH CA1106A_1; USE CA1106A_1;
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY CA1106A_1 IS
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+          NULL;
+     END;
+BEGIN
+     I := IDENT_INT(1);
+END CA1106A_1;
+
+WITH REPORT; USE REPORT;
+WITH CA1106A_2;
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY CA1106A_2 IS
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+          NULL;
+     END;
+BEGIN
+     J := TG(IDENT_INT(2));
+END CA1106A_2;
+
+WITH REPORT; USE REPORT;
+WITH CA1106A_3;
+FUNCTION CA1106A_3 RETURN TG IS
+BEGIN
+     RETURN TG(IDENT_INT(3));
+END CA1106A_3;
+
+WITH REPORT; USE REPORT;
+WITH CA1106A_1, CA1106A_2, CA1106A_3;
+USE CA1106A_1;
+PROCEDURE CA1106A IS
+
+     PACKAGE CA1106A_2X IS NEW CA1106A_2 (INTEGER);
+     FUNCTION CA1106A_3X IS NEW CA1106A_3 (INTEGER);
+
+     USE CA1106A_2X;
+
+BEGIN
+     TEST ("CA1106A", "CHECK THAT A WITH CLAUSE FOR A PACKAGE BODY " &
+                      "(GENERIC OR NONGENERIC) OR FOR A GENERIC " &
+                      "SUBPROGRAM BODY CAN NAME THE CORRESPONDING " &
+                      "SPECIFICATION, AND A USE CLAUSE CAN ALSO BE " &
+                      "GIVEN");
+
+     IF I /= 1 THEN
+          FAILED ("INCORRECT VALUE FROM NONGENERIC PACKAGE");
+     END IF;
+
+     IF J /= 2 THEN
+          FAILED ("INCORRECT VALUE FROM GENERIC PACKAGE");
+     END IF;
+
+     IF CA1106A_3X /= 3 THEN
+          FAILED ("INCORRECT VALUE FROM GENERIC SUBPROGRAM");
+     END IF;
+
+     RESULT;
+END CA1106A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1108a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1108a.ada
new file mode 100644
index 000000000..7059d26c8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1108a.ada
@@ -0,0 +1,136 @@
+-- CA1108A.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 WITH_CLAUSE AND USE_CLAUSE GIVEN FOR A PACKAGE
+-- SPECIFICATION APPLIES TO THE BODY AND SUBUNITS OF THE BODY.
+
+-- BHS 7/27/84
+-- JBG 5/1/85
+
+PACKAGE OTHER_PKG IS
+
+     I : INTEGER := 4;
+     FUNCTION F (X : INTEGER) RETURN INTEGER;
+
+END OTHER_PKG;
+
+PACKAGE BODY OTHER_PKG IS
+
+     FUNCTION F (X : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN X + 1;
+     END F;
+
+END OTHER_PKG;
+
+WITH REPORT, OTHER_PKG;
+USE REPORT, OTHER_PKG;
+PRAGMA ELABORATE (OTHER_PKG);
+PACKAGE CA1108A_PKG IS
+
+     J : INTEGER := 2;
+     PROCEDURE PROC;
+     PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER);
+
+END CA1108A_PKG;
+
+PACKAGE BODY CA1108A_PKG IS
+     
+     PROCEDURE SUB (X, Y : IN OUT INTEGER) IS SEPARATE;
+
+     PROCEDURE PROC IS
+          Y : INTEGER := 2;
+     BEGIN
+          Y := OTHER_PKG.I;
+          IF Y /= 4 THEN
+               FAILED ("OTHER_PKG VARIABLE NOT VISIBLE " &
+                       "IN PACKAGE BODY PROCEDURE");
+          END IF;
+     END PROC;
+
+     PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER) IS
+     BEGIN
+          SUB (X, Y);
+     END CALL_SUBS;
+
+BEGIN  
+
+     J := F(J);            -- J => J + 1.
+     IF J /= 3 THEN
+          FAILED ("OTHER_PKG FUNCTION NOT VISIBLE IN " &
+                  "PACKAGE BODY");
+     END IF;
+
+END CA1108A_PKG;
+
+
+WITH REPORT, CA1108A_PKG;
+USE REPORT, CA1108A_PKG;
+PROCEDURE CA1108A IS
+
+     VAR1, VAR2 : INTEGER;
+
+BEGIN  
+
+     TEST ("CA1108A", "WITH_ AND USE_CLAUSES GIVEN FOR A PACKAGE " &
+                      "SPEC APPLY TO THE BODY AND ITS SUBUNITS");
+
+     PROC;
+
+     VAR1 := 1;
+     VAR2 := 1;
+     CALL_SUBS (VAR1, VAR2);
+     IF VAR1 /= 4 THEN
+          FAILED ("OTHER_PKG VARIABLE NOT VISIBLE IN SUBUNIT");
+     END IF;
+
+     IF VAR2 /= 6 THEN
+          FAILED ("OTHER_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
+                  "OF SUBUNIT");
+     END IF;
+
+     RESULT;
+
+END CA1108A;
+
+
+SEPARATE (CA1108A_PKG)
+PROCEDURE SUB (X, Y : IN OUT INTEGER) IS
+     PROCEDURE SUB2 (Z : IN OUT INTEGER) IS SEPARATE;
+BEGIN
+
+     X := I;
+     SUB2 (Y);
+
+END SUB;
+
+
+SEPARATE (CA1108A_PKG.SUB)
+PROCEDURE SUB2 (Z : IN OUT INTEGER) IS
+     I : INTEGER := 5;
+BEGIN
+
+     Z := OTHER_PKG.F(I);    -- Z => I + 1.
+
+END SUB2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1108b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1108b.ada
new file mode 100644
index 000000000..287772836
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca1108b.ada
@@ -0,0 +1,168 @@
+-- CA1108B.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 WITH_CLAUSES ARE GIVEN FOR BOTH A SPEC AND A BODY, AND
+-- THE CLAUSES NAME DIFFERENT LIBRARY UNITS, THE UNITS NAMED IN ALL THE
+-- CLAUSES ARE VISIBLE IN THE BODY AND IN SUBUNITS OF THE BODY.
+
+-- BHS 7/31/84
+-- JBG 5/1/85
+
+PACKAGE FIRST_PKG IS
+
+     FUNCTION F (X : INTEGER := 1) RETURN INTEGER;
+
+END FIRST_PKG;
+
+PACKAGE BODY FIRST_PKG IS
+
+     FUNCTION F (X : INTEGER := 1) RETURN INTEGER IS
+     BEGIN
+          RETURN X;
+     END F;
+
+END FIRST_PKG;
+
+PACKAGE LATER_PKG IS
+
+     FUNCTION F (Y : INTEGER := 2) RETURN INTEGER;
+
+END LATER_PKG;
+
+PACKAGE BODY LATER_PKG IS
+
+     FUNCTION F (Y : INTEGER := 2) RETURN INTEGER IS
+     BEGIN
+          RETURN Y + 1;
+     END F;
+
+END LATER_PKG;
+
+WITH REPORT, FIRST_PKG;
+USE REPORT;
+PRAGMA ELABORATE (FIRST_PKG);
+PACKAGE CA1108B_PKG IS
+
+     I, J : INTEGER;
+     PROCEDURE PROC;
+     PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER);
+
+END CA1108B_PKG;
+
+WITH LATER_PKG;
+PRAGMA ELABORATE (LATER_PKG);
+PACKAGE BODY CA1108B_PKG IS
+
+     PROCEDURE SUB (X, Y : IN OUT INTEGER) IS SEPARATE;
+
+     PROCEDURE PROC IS
+          I, J : INTEGER;
+     BEGIN
+          I := FIRST_PKG.F;
+          IF I /= 1 THEN
+               FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN " &
+                       "PACKAGE BODY PROCEDURE");
+          END IF;
+          J := LATER_PKG.F;
+          IF J /= 3 THEN
+               FAILED ("LATER_PKG FUNCITON NOT VISIBLE IN " &
+                       "PACKAGE BODY PROCEDURE");
+          END IF;
+     END PROC;
+
+     PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER) IS
+     BEGIN
+          SUB (X, Y);
+     END CALL_SUBS;
+
+BEGIN
+
+     I := FIRST_PKG.F;
+     IF I /= 1 THEN
+          FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN PACKAGE BODY");
+     END IF;
+     J := LATER_PKG.F;
+     IF J /= 3 THEN
+          FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN PACKAGE BODY");
+     END IF;
+
+END CA1108B_PKG;
+
+WITH REPORT, CA1108B_PKG;
+USE REPORT, CA1108B_PKG;
+PROCEDURE CA1108B IS
+
+     VAR1, VAR2 : INTEGER;
+
+BEGIN
+
+     TEST ("CA1108B", "IF DIFFERENT WITH_CLAUSES GIVEN FOR PACKAGE " &
+                      "SPEC AND BODY, ALL NAMED UNITS ARE VISIBLE " &
+                      "IN THE BODY AND ITS SUBUNITS");
+
+     PROC;
+
+     VAR1 := 0;
+     VAR2 := 1;
+     CALL_SUBS (VAR1, VAR2);
+     IF VAR1 /= 1 THEN
+          FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN SUBUNIT");
+     END IF;
+
+     IF VAR2 /= 3 THEN
+          FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN SUBUNIT");
+     END IF;
+
+     RESULT;
+
+END CA1108B;
+
+
+SEPARATE (CA1108B_PKG)
+PROCEDURE SUB (X, Y : IN OUT INTEGER) IS
+     PROCEDURE SUB2 (A, B : IN OUT INTEGER) IS SEPARATE;
+BEGIN
+
+     SUB2 (Y, X);
+     IF Y /= 1 THEN
+          FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
+                  "OF SUBUNIT");
+     END IF;
+     IF X /= 3 THEN
+          FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
+                  "OF SUBUNIT");
+     END IF;
+     X := FIRST_PKG.F;
+     Y := LATER_PKG.F;
+
+END SUB;
+
+SEPARATE (CA1108B_PKG.SUB)
+PROCEDURE SUB2 (A, B : IN OUT INTEGER) IS
+BEGIN
+
+     A := FIRST_PKG.F;
+     B := LATER_PKG.F;
+
+END SUB2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11a01.a
new file mode 100644
index 000000000..a84c6b84f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11a01.a
@@ -0,0 +1,228 @@
+-- CA11A01.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 type extended in a public child inherits primitive 
+--      operations from its ancestor.  
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged type in a package specification. Declare two 
+--      primitive subprograms for the type (foundation code).
+--
+--      Add a public child to the above package.  Extend the root type with 
+--      a record extension in the specification.  Declare a new primitive 
+--      subprogram to write to the child extension.
+--
+--      Add a public grandchild to the above package.  Extend the extension of
+--      the parent type with a record extension in the private part of the 
+--      specification.  Declare a new primitive subprogram for this grandchild
+--      extension.
+--
+--      In the main program, "with" the grandchild.  Access the primitive
+--      operations from grandparent and parent package.
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         FA11A00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package FA11A00.CA11A01_0 is     -- Color_Widget_Pkg
+-- This public child declares an extension from its parent.  It 
+-- represents processing of widgets in a window system.  
+
+   type Widget_Color_Enum is (Black, Green, White);
+
+   type Color_Widget is new Widget with           -- Record extension of
+      record                                      -- parent tagged type.
+         Color : Widget_Color_Enum;
+      end record;
+
+   -- Inherits procedure Set_Width from Widget.
+   -- Inherits procedure Set_Height from Widget.
+
+   -- To be inherited by its derivatives.
+   procedure Set_Color (The_Widget : in out Color_Widget; 
+                        C          : in     Widget_Color_Enum);
+
+   procedure Set_Color_Widget (The_Widget : in out Color_Widget; 
+                               The_Width  : in     Widget_Length;
+                               The_Height : in     Widget_Length; 
+                               The_Color  : in     Widget_Color_Enum);
+
+end FA11A00.CA11A01_0;     -- Color_Widget_Pkg
+
+--=======================================================================--
+
+package body FA11A00.CA11A01_0 is     -- Color_Widget_Pkg
+
+   procedure Set_Color (The_Widget : in out Color_Widget; 
+                        C          : in     Widget_Color_Enum) is
+   begin
+      The_Widget.Color := C;
+   end Set_Color;
+   ---------------------------------------------------------------
+   procedure Set_Color_Widget (The_Widget : in out Color_Widget; 
+                               The_Width  : in     Widget_Length;
+                               The_Height : in     Widget_Length; 
+                               The_Color  : in     Widget_Color_Enum) is
+   begin
+      Set_Width  (The_Widget, The_Width);   -- Inherited from parent.
+      Set_Height (The_Widget, The_Height);  -- Inherited from parent.
+      Set_Color  (The_Widget, The_Color);
+   end Set_Color_Widget;
+
+end FA11A00.CA11A01_0;     -- Color_Widget_Pkg
+
+--=======================================================================--
+
+package FA11A00.CA11A01_0.CA11A01_1 is     -- Label_Widget_Pkg
+-- This public grandchild extends the extension from its parent.  It 
+-- represents processing of widgets in a window system.  
+
+   -- Declaration used by private extension component.
+   subtype Widget_Label_Str is string (1 .. 10);
+
+   type Label_Widget is new Color_Widget with private;  
+                            -- Record extension of parent tagged type.
+
+   -- Inherits (inherited) procedure Set_Width from Color_Widget.
+   -- Inherits (inherited) procedure Set_Height from Color_Widget.
+   -- Inherits procedure Set_Color from Color_Widget.
+   -- Inherits procedure Set_Color_Widget from Color_Widget.
+
+   procedure Set_Label_Widget (The_Widget : in out Label_Widget;
+                               The_Width  : in     Widget_Length;
+                               The_Height : in     Widget_Length; 
+                               The_Color  : in     Widget_Color_Enum;
+                               The_Label  : in     Widget_Label_Str);
+
+   -- The following function is needed to verify the value of the
+   -- extension's private component.
+
+   function Verify_Label (The_Widget : in Label_Widget;
+                          The_Label  : in Widget_Label_Str) return Boolean;
+
+private
+   type Label_Widget is new Color_Widget with
+      record
+         Label : Widget_Label_Str;
+      end record;
+
+end FA11A00.CA11A01_0.CA11A01_1;     -- Label_Widget_Pkg
+
+--=======================================================================--
+
+package body FA11A00.CA11A01_0.CA11A01_1 is     -- Label_Widget_Pkg
+
+   procedure Set_Label (The_Widget : in out Label_Widget; 
+                        L          : in     Widget_Label_Str) is
+   begin
+      The_Widget.Label := L;
+   end Set_Label;
+   --------------------------------------------------------------
+   procedure Set_Label_Widget (The_Widget : in out Label_Widget;
+                               The_Width  : in     Widget_Length;
+                               The_Height : in     Widget_Length; 
+                               The_Color  : in     Widget_Color_Enum;
+                               The_Label  : in     Widget_Label_Str) is
+   begin
+      Set_Width  (The_Widget, The_Width);   -- Twice inherited.
+      Set_Height (The_Widget, The_Height);  -- Twice inherited.
+      Set_Color  (The_Widget, The_Color);   -- Inherited from parent.
+      Set_Label  (The_Widget, The_Label); 
+   end Set_Label_Widget;
+   --------------------------------------------------------------
+   function Verify_Label (The_Widget : in Label_Widget; 
+                          The_Label  : in Widget_Label_Str) return Boolean is
+   begin
+      return (The_Widget.Label = The_Label);
+   end Verify_Label;
+
+end FA11A00.CA11A01_0.CA11A01_1;     -- Label_Widget_Pkg
+
+--=======================================================================--
+
+with FA11A00.CA11A01_0.CA11A01_1;     -- Label_Widget_Pkg, 
+                                      -- implicitly with Widget_Pkg,
+                                      -- implicitly with Color_Widget_Pkg
+with Report;
+
+procedure CA11A01 is
+
+   package Widget_Pkg renames FA11A00;
+   package Color_Widget_Pkg renames FA11A00.CA11A01_0;
+   package Label_Widget_Pkg renames FA11A00.CA11A01_0.CA11A01_1;
+
+   use Widget_Pkg;              -- All user-defined operators directly visible.
+
+   Mail_Label     : Label_Widget_Pkg.Widget_Label_Str := "Quick_Mail";
+
+   Default_Widget : Widget;
+   Black_Widget   : Color_Widget_Pkg.Color_Widget;
+   Mail_Widget    : Label_Widget_Pkg.Label_Widget;
+
+begin
+
+   Report.Test ("CA11A01", "Check that type extended in a public " &
+                "child inherits primitive operations from its " &
+                "ancestor");                                     
+
+   Set_Width (Default_Widget, 9);             -- Call from parent.
+   Set_Height (Default_Widget, 10);           -- Call from parent.
+
+   If Default_Widget.Width /= Widget_Length (Report.Ident_Int (9)) or 
+     Default_Widget.Height /= Widget_Length (Report.Ident_Int (10)) then
+        Report.Failed ("Incorrect result for Default_Widget");
+   end if;
+
+   Color_Widget_Pkg.Set_Color_Widget 
+     (Black_Widget, 17, 18, Color_Widget_Pkg.Black);   -- Explicitly declared.
+
+   If Black_Widget.Width /= Widget_Length (Report.Ident_Int (17)) or 
+     Black_Widget.Height /= Widget_Length (Report.Ident_Int (18)) or 
+       Color_Widget_Pkg."/=" (Black_Widget.Color, Color_Widget_Pkg.Black) then
+          Report.Failed ("Incorrect result for Black_Widget");
+   end if;
+
+   Label_Widget_Pkg.Set_Label_Widget 
+     (Mail_Widget, 15, 21, Color_Widget_Pkg.White, 
+       "Quick_Mail");                                  -- Explicitly declared.
+
+   If Mail_Widget.Width /= Widget_Length (Report.Ident_Int (15)) or 
+     Mail_Widget.Height /= Widget_Length (Report.Ident_Int (21)) or 
+       Color_Widget_Pkg."/=" (Mail_Widget.Color, Color_Widget_Pkg.White) or 
+         not Label_Widget_Pkg.Verify_Label (Mail_Widget, Mail_Label) then
+            Report.Failed ("Incorrect result for Mail_Widget");
+   end if;
+
+   Report.Result;
+
+end CA11A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11a02.a
new file mode 100644
index 000000000..e7c161423
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11a02.a
@@ -0,0 +1,156 @@
+-- CA11A02.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 type extended in a client of a public child inherits 
+--      primitive operations from parent.  
+--
+-- TEST DESCRIPTION:
+--      Declare a root tagged type in a package specification. Declare two 
+--      primitive subprograms for the type (foundation code).
+--
+--      Add a public child to the above package.  Extend the root type with 
+--      a record extension in the specification.  Declare a new primitive 
+--      subprogram to write to the child extension.
+--
+--      In the main program, "with" the child.  Declare an extension of
+--      the child extension.  Access the primitive operations from both 
+--      parent and child packages.
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         FA11A00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      20 Dec 94   SAIC    Moved declaration of Label_Widget to library level
+--
+--!
+
+package FA11A00.CA11A02_0 is     -- Color_Widget_Pkg
+-- This public child declares an extension from its parent.  It 
+-- represents processing of widgets in a window system.  
+
+   type Widget_Color_Enum is (Black, Green, White);
+
+   type Color_Widget is new Widget with           -- Record extension of
+      record                                      -- parent tagged type.
+         Color : Widget_Color_Enum;
+      end record;
+
+   -- Inherits procedure Set_Width from parent.
+   -- Inherits procedure Set_Height from parent.
+
+   -- To be inherited by its derivatives.
+   procedure Set_Color (The_Widget : in out Color_Widget; 
+                        C          : in     Widget_Color_Enum);
+
+end FA11A00.CA11A02_0;     -- Color_Widget_Pkg
+
+--=======================================================================--
+
+package body FA11A00.CA11A02_0 is     -- Color_Widget_Pkg
+
+   procedure Set_Color (The_Widget : in out Color_Widget; 
+                        C          : in     Widget_Color_Enum) is
+   begin
+      The_Widget.Color := C;
+   end Set_Color;
+
+end FA11A00.CA11A02_0;     -- Color_Widget_Pkg
+
+--=======================================================================--
+
+with FA11A00.CA11A02_0;               -- Color_Widget_Pkg.
+
+package CA11A02_1 is
+
+   type Label_Widget (Str_Disc : Integer) is new 
+     FA11A00.CA11A02_0.Color_Widget with
+       record
+         Label : String (1 .. Str_Disc);
+       end record;
+
+   -- Inherits (inherited) procedure Set_Width from Color_Widget.
+   -- Inherits (inherited) procedure Set_Height from Color_Widget.
+   -- Inherits procedure Set_Color from Color_Widget.
+
+end CA11A02_1;
+
+--=======================================================================--
+
+with FA11A00.CA11A02_0;               -- Color_Widget_Pkg, 
+                                      -- implicitly with Widget_Pkg
+with CA11A02_1;
+
+with Report;
+
+procedure CA11A02 is
+
+   package Widget_Pkg renames FA11A00;
+   package Color_Widget_Pkg renames FA11A00.CA11A02_0;
+
+   use Widget_Pkg;              -- All user-defined operators directly visible.
+
+   procedure Set_Label (The_Widget : in out CA11A02_1.Label_Widget; 
+                        L          : in     String) is
+   begin
+      The_Widget.Label := L;
+   end Set_Label;
+   ---------------------------------------------------------
+   procedure Set_Widget (The_Widget : in out CA11A02_1.Label_Widget;
+                         The_Width  : in     Widget_Length;
+                         The_Height : in     Widget_Length; 
+                         The_Color  : in     
+                                          Color_Widget_Pkg.Widget_Color_Enum;
+                         The_Label  : in     String) is
+   begin
+      CA11A02_1.Set_Width  (The_Widget, The_Width);    -- Twice inherited.
+      CA11A02_1.Set_Height (The_Widget, The_Height);   -- Twice inherited.
+      CA11A02_1.Set_Color (The_Widget, The_Color);     -- Inherited.
+      Set_Label  (The_Widget, The_Label);              -- Explicitly declared.
+   end Set_Widget;                                         
+
+   White_Widget : CA11A02_1.Label_Widget (11);
+
+begin
+
+   Report.Test ("CA11A02", "Check that a type extended in a client of " &
+                "a public child inherits primitive operations from parent");
+
+   Set_Widget (White_Widget, 15, 21, Color_Widget_Pkg.White, "Alarm_Clock");  
+
+   If White_Widget.Width /= Widget_Length (Report.Ident_Int (15)) or 
+     White_Widget.Height /= Widget_Length (Report.Ident_Int (21)) or
+       Color_Widget_Pkg."/=" (White_Widget.Color, Color_Widget_Pkg.White) or
+         White_Widget.Label /= "Alarm_Clock" then
+            Report.Failed ("Incorrect result for White_Widget");
+   end if;
+
+   Report.Result;
+
+end CA11A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11b01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11b01.a
new file mode 100644
index 000000000..8d6de02f1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11b01.a
@@ -0,0 +1,208 @@
+-- CA11B01.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 type derived in a public child inherits primitive 
+--      operations from parent.  
+--
+-- TEST DESCRIPTION:
+--      Declare a root record type with discriminant in a package 
+--      specification. Declare a primitive subprogram for the type 
+--      (foundation code).
+--
+--      Add a public child to the above package.  Derive a new type 
+--      with constraint to the discriminant record type from the parent 
+--      package.  Declare a new primitive subprogram to write to the child 
+--      derived type.
+--
+--      Add a new public child to the above package.  This grandchild package
+--      derives a new type using the record type from the above package.  
+--      Declare a new primitive subprogram to write to the grandchild derived 
+--      type.
+--
+--      In the main program, "with" the grandchild.  Access the inherited 
+--      operations from grandparent, parent, and grandchild packages.
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         FA11B00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Child package of FA11B00.
+package FA11B00.CA11B01_0 is          -- Application_Two_Widget
+-- This public child declares a derived type from its parent.  It 
+-- represents processing of widgets in a window system.  
+                                                               
+   type App2_Widget is new App1_Widget (Maximum_Size => 5000); 
+   -- Inherits procedure Create_Widget from parent.
+
+   -- Primitive operation of type App2_Widget.
+   -- To be inherited by its children derivatives.
+   procedure App2_Widget_Specific_Oper (The_Widget : in out App2_Widget;    
+                                        Loc        : in     Widget_Location);
+
+end FA11B00.CA11B01_0;                -- Application_Two_Widget
+
+--=======================================================================--
+
+package body FA11B00.CA11B01_0 is     -- Application_Two_Widget
+
+   procedure App2_Widget_Specific_Oper 
+     (The_Widget : in out App2_Widget;    
+      Loc        : in     Widget_Location) is
+   begin
+      The_Widget.Location := Loc;
+   end App2_Widget_Specific_Oper;
+
+end FA11B00.CA11B01_0;                -- Application_Two_Widget
+
+--=======================================================================--
+
+-- Grandchild package of FA11B00, child package of FA11B00.CA11B01_0.
+package FA11B00.CA11B01_0.CA11B01_1 is     -- Application_Three_Widget
+-- This public grandchild declares a derived type from its parent.  It 
+-- represents processing of widgets in a window system.  
+
+   type App3_Widget is new App2_Widget;    -- Derived record of App2_Widget.
+
+   -- Inherits (inherited) procedure Create_Widget from Application_One_Widget.
+   -- Inherits procedure App2_Widget_Specific_Oper from App2_Widget.
+
+   -- Primitive operation of type App3_Widget.
+   procedure App3_Widget_Specific_Oper (The_Widget : in out App3_Widget; 
+                                        S          : in     Widget_Size);
+
+end FA11B00.CA11B01_0.CA11B01_1;           -- Application_Three_Widget
+
+--=======================================================================--
+
+package body FA11B00.CA11B01_0.CA11B01_1 is     -- Application_Three_Widget
+
+   procedure App3_Widget_Specific_Oper 
+     (The_Widget : in out App3_Widget; 
+      S          : in     Widget_Size) is
+   begin
+      The_Widget.Size := S;
+   end App3_Widget_Specific_Oper;
+
+end FA11B00.CA11B01_0.CA11B01_1;                -- Application_Three_Widget
+
+--=======================================================================--
+
+with FA11B00.CA11B01_0.CA11B01_1; -- Application_Three_Widget, 
+                                  -- implicitly with Application_Two_Widget,
+                                  -- implicitly with Application_Three_Widget.
+with Report;
+
+procedure CA11B01 is
+
+   package Application_One_Widget renames FA11B00;
+   package Application_Two_Widget renames FA11B00.CA11B01_0;
+   package Application_Three_Widget renames FA11B00.CA11B01_0.CA11B01_1;
+
+   use Application_One_Widget;
+   use Application_Two_Widget;
+   use Application_Three_Widget;
+
+begin
+
+   Report.Test ("CA11B01", "Check that a type derived in a public " &
+                "child inherits primitive operations from parent");
+
+   Application_One_Subtest:
+   declare
+      White_Widget : App1_Widget;
+
+   begin
+      -- perform an App1_Widget specific operation.
+      App1_Widget_Specific_Oper (C => White, L => "Line Editor    ",
+                                 The_Widget => White_Widget, I => 10);
+
+      If White_Widget.Color /= White or
+        White_Widget.Id /= Widget_ID 
+          (Report.Ident_Int (10)) or
+            White_Widget.Label  /= "Line Editor    " then
+              Report.Failed ("Incorrect result for White_Widget");
+      end if;
+
+   end Application_One_Subtest;
+   ---------------------------------------------------------------
+   Application_Two_Subtest:
+   declare
+      Amber_Widget : App2_Widget;
+
+   begin
+      App1_Widget_Specific_Oper (Amber_Widget, I => 11, 
+                                 C => Amber, L => "Alarm_Clock    ");  
+                                 -- Inherited from Application_One_Widget.
+                                           
+      -- perform an App2_Widget specific operation.
+      App2_Widget_Specific_Oper (The_Widget => Amber_Widget, Loc => (380,512));
+
+      If Amber_Widget.Color /= Amber or
+        Amber_Widget.Id /= Widget_ID (Report.Ident_Int (11)) or
+            Amber_Widget.Label  /= "Alarm_Clock    " or
+              Amber_Widget.Location /= (380,512) then
+                Report.Failed ("Incorrect result for Amber_Widget");
+      end if;
+
+   end Application_Two_Subtest;
+   ---------------------------------------------------------------
+   Application_Three_Subtest:
+   declare
+      Green_Widget : App3_Widget;
+
+   begin
+      App1_Widget_Specific_Oper (Green_Widget, 100, Green, 
+                                 "Screen Editor  ");  
+                                   -- Inherited (inherited) from Basic_Widget.
+
+      -- perform an App2_Widget specific operation.
+      App2_Widget_Specific_Oper (Loc => (1024,760), 
+                                 The_Widget => Green_Widget);
+                                    -- Inherited from App_1_Widget.
+
+      -- perform an App3_Widget specific operation.
+      App3_Widget_Specific_Oper (Green_Widget, S => (100,100));
+
+      If Green_Widget.Color /= Green or
+        Green_Widget.Id /= Widget_ID (Report.Ident_Int (100)) or
+          Green_Widget.Label  /= "Screen Editor  " or
+            Green_Widget.Location /= (1024,760) or
+              Green_Widget.Size /= (100,100) then
+                Report.Failed ("Incorrect result for Green_Widget");
+      end if;
+
+   end Application_Three_Subtest;
+
+   Report.Result;
+
+end CA11B01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11b02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11b02.a
new file mode 100644
index 000000000..0743f7333
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11b02.a
@@ -0,0 +1,169 @@
+-- CA11B02.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 type derived in a client of a public child inherits 
+--      primitive operations from parent.  
+--
+-- TEST DESCRIPTION:
+--      Declare a root record type with discriminant in a package 
+--      specification. Declare a primitive subprogram for the type 
+--      (foundation code).
+--
+--      Add a public child to the above package.  Derive a new type 
+--      with constraint to the discriminant record type from the parent 
+--      package.  Declare a new primitive subprogram to write to the child 
+--      derived type.
+--
+--      In the main program, "with" the child.  Derive a new type using the 
+--      record type from the child package.  Access the inherited operations 
+--      from both parent and child packages.
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         FA11B00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Child package of FA11B00.
+package FA11B00.CA11B02_0 is     -- Application_Two_Widget
+-- This public child declares a derived type from its parent.  It 
+-- represents processing of widgets in a window system.  
+
+   -- Dimension of app2_widget is limited to 5000 pixels.
+
+   type App2_Widget is new App1_Widget (Maximum_Size => 5000); 
+                           -- Derived record of parent type.
+
+   -- Inherits procedure App1_Widget_Specific_Oper from parent.
+
+
+   -- Primitive operation of type App2_Widget.
+
+   procedure App2_Widget_Specific_Op1 (The_Widget : in out App2_Widget;    
+                                       S          : in     Widget_Size);
+     
+   -- Primitive operation of type App2_Widget.
+
+   procedure App2_Widget_Specific_Op2 (The_Widget : in out App2_Widget;    
+                                       Loc        : in     Widget_Location);
+
+end FA11B00.CA11B02_0;      -- Application_Two_Widget
+
+
+--=======================================================================--
+
+
+package body FA11B00.CA11B02_0 is     -- Application_Two_Widget
+
+   procedure App2_Widget_Specific_Op1 (The_Widget : in out App2_Widget;    
+                                       S          : in     Widget_Size) is
+   begin
+      The_Widget.Size := S;
+   end App2_Widget_Specific_Op1;
+
+               --==============================================--
+
+   procedure App2_Widget_Specific_Op2 (The_Widget : in out App2_Widget;    
+                                       Loc        : in     Widget_Location) is
+   begin
+      The_Widget.Location := Loc;
+   end App2_Widget_Specific_Op2;
+
+end FA11B00.CA11B02_0;     -- Application_Two_Widget
+
+
+--=======================================================================--
+
+with FA11B00.CA11B02_0;      -- Application_Two_Widget
+                             -- implicitly with Application_One_Widget.
+with Report;
+
+procedure CA11B02 is
+                             
+   package Application_One_Widget renames FA11B00;
+
+   package Application_Two_Widget renames FA11B00.CA11B02_0;
+
+   use Application_One_Widget ;
+   use Application_Two_Widget ;
+
+   type Emulator_Widget is new App2_Widget;   -- Derived record of 
+                                              -- parent type.
+
+   White_Widget, Amber_Widget : Emulator_Widget;
+
+
+begin
+
+   Report.Test ("CA11B02", "Check that a type derived in client of a " &
+                "public child inherits primitive operations from parent");
+
+   App1_Widget_Specific_Oper (C => White, L => "Line Editor    ",
+                              The_Widget => White_Widget, I => 10);
+                                  -- Inherited from Application_One_Widget.
+   If White_Widget.Color /= White or
+     White_Widget.Id /= Widget_ID (Report.Ident_Int (10)) or
+     White_Widget.Label  /= "Line Editor    " 
+   then
+      Report.Failed ("Incorrect result for White_Widget");
+   end if;
+
+   -- perform an App2_Widget specific operation.
+
+   App2_Widget_Specific_Op1 (White_Widget, S => (100, 200));
+
+   If White_Widget.Size.X_Length /= 100 or
+     White_Widget.Size.Y_Length /= 200
+   then
+      Report.Failed ("Incorrect size for White_Widget");
+   end if;
+
+   App1_Widget_Specific_Oper (Amber_Widget, 5, Amber, "Screen Editor  ");  
+                                  -- Inherited from Application_One_Widget.
+
+   -- perform an App2_Widget specific operations.
+
+   App2_Widget_Specific_Op1 (S => (1024,100), The_Widget => Amber_Widget);  
+   App2_Widget_Specific_Op2 (Amber_Widget, (1024, 760));
+
+   If Amber_Widget.Color /= Amber or
+     Amber_Widget.Id /= Widget_ID (Report.Ident_Int (5)) or 
+     Amber_Widget.Label  /= "Screen Editor  " or
+     Amber_Widget.Size /= (1024,100) or 
+     Amber_Widget.Location.X_Location /= 1024 or
+     Amber_Widget.Location.Y_Location /= 760
+   then
+      Report.Failed ("Incorrect result for Amber_Widget");
+   end if;
+
+   Report.Result;
+
+end CA11B02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c01.a
new file mode 100644
index 000000000..195ec2d40
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c01.a
@@ -0,0 +1,170 @@
+-- CA11C01.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 when primitive operations declared in a child package
+--      override operations declared in ancestor packages, a client of the
+--      child package inherits the operations correctly.
+--
+-- TEST DESCRIPTION:
+--
+--      This test builds on the foundation code file (FA11C00) that contains
+--      a parent package, child package, and grandchild package.  The parent
+--      package declares a tagged type and primitive operation.  The child
+--      package extends the type, and overrides the primitive operation. The
+--      grandchild package does the same.  
+--
+--      The test procedure "withs" the grandchild package, and receives
+--      visibility to all of its ancestor packages, types and operations.
+--      Three procedures, each with a formal parameter of a specific type are
+--      defined.  Each of these invokes a particular version of the overridden
+--      primitive operation Image.  Calls to these local procedures are made, 
+--      with objects of each of the tagged types as parameters, and the global 
+--      variable is finally examined to ensure that the correct version of 
+--      primitive operation was inherited by the client and invoked by the 
+--      call.
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         FA11C00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FA11C00_0.FA11C00_1.FA11C00_2;    -- Package Animal.Mammal.Primate
+with Report;
+
+procedure CA11C01 is
+
+   package Animal_Package  renames FA11C00_0;
+   package Mammal_Package  renames FA11C00_0.FA11C00_1;
+   package Primate_Package renames FA11C00_0.FA11C00_1.FA11C00_2;
+
+   Max_Animals : constant := 3;
+
+   subtype Data_String is String (1 .. 37);
+   type Data_Base_Type is array  (1 .. Max_Animals) of Data_String;
+
+   Zoo_Data_Base : Data_Base_Type := (others => (others => ' '));
+                                      -- Global variable.
+
+   Salmon   : Animal_Package.Animal := (Common_Name => "Chinook Salmon      ", 
+                                        Weight      => 10);
+
+   Platypus : Mammal_Package.Mammal := (Common_Name => "Tasmanian Platypus  ",
+                                        Weight      => 13,
+                                        Hair_Color  => Mammal_Package.Brown);
+
+   Orangutan : Primate_Package.Primate := 
+                 (Common_Name => "Sumatran Orangutan  ",
+                  Weight      => 220,
+                  Hair_Color  => Mammal_Package.Red,
+                  Habitat     => Primate_Package.Arboreal);
+begin
+
+   Report.Test ("CA11C01", "Check that when primitive operations declared "   &
+                           "in a child package override operations declared " &
+                           "in ancestor packages, a client of the child "     &
+                           "package inherits the operations correctly");
+
+   declare
+
+      use Animal_Package, Mammal_Package, Primate_Package;
+
+      -- The function Image has been overridden in the child and grandchild
+      -- packages, but the client has inherited all versions of the function,
+      -- and can successfully use them to enter data into the database.
+      -- Each of the following procedures updates the global variable 
+      -- Zoo_Data_Base.
+
+      procedure Enter_Animal_Data (A : Animal; I : Integer) is
+      begin
+         Zoo_Data_Base (I) := Image (A);  
+      end Enter_Animal_Data;              
+
+      procedure Enter_Mammal_Data (M : Mammal; I : Integer) is
+      begin
+         Zoo_Data_Base (I) := Image (M);  
+      end Enter_Mammal_Data;
+
+      procedure Enter_Primate_Data (P : Primate; I : Integer) is
+      begin
+         Zoo_Data_Base (I) := Image (P);  
+      end Enter_Primate_Data;
+
+   begin
+
+      -- Verify initial test conditions.
+
+      if not (Zoo_Data_Base(1)(1..6) = "      ") 
+         or else
+             (Zoo_Data_Base(2)(1..6) /= "      ") 
+         or else
+             (Zoo_Data_Base(3)(1..6) /= "      ")
+      then
+         Report.Failed ("Initial condition failure");
+      end if;
+
+
+      -- Enter data from all three animals into the zoo database.
+
+      Enter_Animal_Data  (A => Salmon,    I => 1);  -- First entry in database.
+      Enter_Mammal_Data  (M => Platypus,  I => 2);  -- Second entry.
+      Enter_Primate_Data (P => Orangutan, I => 3);  -- Third entry. 
+
+      -- Verify the correct version of the overridden function Image was used
+      -- for entering the specific data.  
+
+      if  Zoo_Data_Base(1)(1 .. 6) /= "Animal"
+        or else
+          Zoo_Data_Base(1)(26 .. 31) /= "Salmon"
+        then
+           Report.Failed ("Incorrect version of Image for parent type");
+      end if;
+
+      if (Zoo_Data_Base(2)(1 .. 6) /= "Mammal") 
+        or
+          (Zoo_Data_Base(2)(28 .. 35) /= "Platypus") 
+        then
+           Report.Failed ("Incorrect version of Image for child type");
+      end if;
+
+      if ((Zoo_Data_Base(3)(1 .. 7) /= "Primate") 
+        or 
+          (Zoo_Data_Base(3)(27 .. 35) /= "Orangutan"))
+        then
+           Report.Failed ("Incorrect version of Image for grandchild type");
+      end if;
+
+   end;
+
+
+   Report.Result;
+
+end CA11C01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c02.a
new file mode 100644
index 000000000..7d8749328
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c02.a
@@ -0,0 +1,158 @@
+-- CA11C02.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 primitive operations declared in a child package
+--      override operations declared in ancestor packages, and that
+--      operations on class-wide types defined in the ancestor packages 
+--      dispatch as appropriate to these overriding implementations. 
+--
+-- TEST DESCRIPTION:
+--
+--      This test builds on the foundation code file (FA11C00) that contains
+--      a parent package, child package, and grandchild package.  The parent
+--      package declares a tagged type and primitive operation.  The child
+--      package extends the type, and overrides the primitive operation. The
+--      grandchild package does the same.  
+--
+--      The test procedure "withs" the grandchild package, and receives
+--      visibility to all of its ancestor packages, types and operations.
+--      A procedure with a formal class-wide parameter is defined that will
+--      allow for dispatching calls to the overridden primitive operations,
+--      based on the specific type of the actual parameter.  The primitive
+--      operations provide a string value to update a global string array
+--      variable.  Calls to the local procedure are made, with objects of each
+--      of the tagged types as parameters, and the global variable is finally 
+--      examined to ensure that the correct version of primitive operation was 
+--      dispatched correctly.
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         FA11C00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FA11C00_0.FA11C00_1.FA11C00_2;    -- Package Animal.Mammal.Primate
+with Report;
+
+procedure CA11C02 is
+
+   package Animal_Package  renames FA11C00_0;
+   package Mammal_Package  renames FA11C00_0.FA11C00_1;
+   package Primate_Package renames FA11C00_0.FA11C00_1.FA11C00_2;
+
+   Max_Animals : constant := 3;
+
+   type Data_Base_Type is array (1 .. Max_Animals) of String (1 .. 37);
+
+   Zoo_Data_Base : Data_Base_Type := (others => (others => ' '));
+                                      -- Global variable.
+
+   Macaw : Animal_Package.Animal   := (Common_Name => "Scarlet Macaw       ", 
+                                       Weight      => 2);
+
+   Manatee : Mammal_Package.Mammal := (Common_Name => "Southern Manatee    ",
+                                       Weight      => 230,
+                                       Hair_Color  => Mammal_Package.Brown);
+
+   Lemur : Primate_Package.Primate := 
+              (Common_Name => "Ring-Tailed Lemur   ",
+               Weight      => 5,
+               Hair_Color  => Mammal_Package.Black,
+               Habitat     => Primate_Package.Arboreal);
+begin
+
+   Report.Test ("CA11C02", "Check that primitive operations declared "   &
+                           "in a child package override operations declared " &
+                           "in ancestor packages, and that operations " &
+                           "on class-wide types defined in the ancestor " &
+                           "packages dispatch as appropriate to these " &
+                           "overriding implementations");
+
+   declare
+
+      use Animal_Package, Mammal_Package, Primate_Package;
+
+      -- The following procedure updates the global variable Zoo_Data_Base.
+
+      procedure Enter_Data (A : Animal'Class; I : Integer) is
+      begin
+         Zoo_Data_Base (I) := Image (A);  
+      end Enter_Data;              
+
+   begin
+
+      -- Verify initial test conditions.
+
+      if not (Zoo_Data_Base(1)(1..6) = "      ")
+         or not
+             (Zoo_Data_Base(2)(1..6) = "      ")
+         or not 
+             (Zoo_Data_Base(3)(1..6) = "      ")
+      then
+         Report.Failed ("Initial condition failure");
+      end if;
+
+
+      -- Enter data from all three animals into the zoo database.
+
+      Enter_Data (Macaw, 1);                 -- First entry in database.
+      Enter_Data (A => Manatee, I => 2);     -- Second entry.
+      Enter_Data (Lemur, I => 3);            -- Third entry. 
+
+      -- Verify the correct version of the overridden function Image was used
+      -- for entering the specific data.  
+
+      if not (Zoo_Data_Base(1)(1 .. 6)   = "Animal") 
+        or not
+             (Zoo_Data_Base(1)(26 .. 30) = "Macaw") 
+        then
+           Report.Failed ("Incorrect version of Image for parent type");
+      end if;
+
+      if not (Zoo_Data_Base(2)(1 .. 6)   = "Mammal"
+        and 
+          Zoo_Data_Base(2)(27 .. 33) = "Manatee") 
+        then
+           Report.Failed ("Incorrect version of Image for child type");
+      end if;
+
+      if not ((Zoo_Data_Base(3)(1 .. 7)   = "Primate")
+        and 
+          (Zoo_Data_Base(3)(30 .. 34) = "Lemur"))
+        then
+           Report.Failed ("Incorrect version of Image for grandchild type");
+      end if;
+
+   end;
+
+   Report.Result;
+
+end CA11C02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c03.a
new file mode 100644
index 000000000..b75a66034
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11c03.a
@@ -0,0 +1,186 @@
+-- CA11C03.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 when a child unit is "withed", visibility is obtained to 
+--      all ancestor units named in the expanded name of the "withed" child
+--      unit.  Check that when the parent unit is "used", the simple name of 
+--      a "withed" child unit is made directly visible.
+--
+-- TEST DESCRIPTION:
+--      To satisfy the first part of the objective, various references are
+--      made to types and functions declared in the ancestor packages of the
+--      foundation code package hierarchy.  Since the grandchild library unit
+--      package has been "withed" by this test, the visibility of these 
+--      components demonstrates that visibility of the ancestor package names
+--      is provided when the expanded name of a child library unit is "withed". 
+--      
+--      The declare block in the test program includes a "use" clause of the
+--      parent package (FA11C00_0.FA11C00_1) of the "withed" child package.  
+--      As a result, the simple name of the child package (FA11C00_2) is
+--      directly visible.  The type and function declared in the child 
+--      package are now visible when qualified with the simple name of the
+--      "withed" package (FA11C00_2).
+--      
+--      This test simulates the formatting of data strings, based on the
+--      component fields of a "doubly-extended" tagged record type.
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         FA11C00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FA11C00_0.FA11C00_1.FA11C00_2;  -- "with" of child library package 
+                                     -- Animal.Mammal.Primate.
+                                     -- This will be used in conjunction with
+                                     -- a "use" of FA11C00_0.FA11C00_1 below 
+                                     -- to verify a portion of the objective.
+with Report;
+
+procedure CA11C03 is
+
+   Blank_Name_String : constant FA11C00_0.Species_Name_Type := (others => ' ');
+                                     -- Visibility of grandparent package.
+                                     -- The package FA11C00_0 is visible since
+                                     -- it is an ancestor that is mentioned in
+                                     -- the expanded name of its "withed"
+                                     -- grandchild package.
+
+   Blank_Hair_Color : 
+     String (1..FA11C00_0.FA11C00_1.Hair_Color_Type'Width) := (others => ' ');
+                                     -- Visibility of parent package.
+                                     -- The package FA11C00_0.FA11C00_1 is
+                                     -- visible due to the "with" of its 
+                                     -- child package.
+
+   subtype Data_String_Type is String (1 .. 60);
+
+   TC_Result_String : Data_String_Type := (others => ' ');
+
+   --
+
+   function Format_Primate_Data (Name : String := Blank_Name_String;  
+                                 Hair : String := Blank_Hair_Color) 
+     return Data_String_Type is
+
+      Pos                        : Integer := 1;
+      Hair_Color_Field_Separator : constant String := " Hair Color: ";
+
+      Result_String              : Data_String_Type := (others => ' '); 
+
+   begin
+      Result_String (Pos .. Name'Length) := Name;    -- Enter name at start
+                                                     -- of string.
+      Pos := Pos + Name'Length;                      -- Increment counter to
+                                                     -- next blank position.
+      Result_String 
+        (Pos .. Pos + Hair_Color_Field_Separator'Length + Hair'Length - 1) :=
+        Hair_Color_Field_Separator & Hair;           -- Include hair color data
+                                                     -- in result string.
+      return (Result_String);                        
+   end Format_Primate_Data;
+
+
+begin
+
+   Report.Test ("CA11C03", "Check that when a child unit is WITHED, "        &
+                           "visibility is obtained to all ancestor units "   &
+                           "named in the expanded name of the WITHED child " &
+                           "unit. Check that when the parent unit is USED, " &
+                           "the simple name of a WITHED child unit is made " &
+                           "directly visible" );
+
+   declare
+      use FA11C00_0.FA11C00_1;    -- This "use" clause will allow direct 
+                                  -- visibility to the simple name of
+                                  -- package FA11C00_0.FA11C00_1.FA11C00_2,
+                                  -- since this child package was "withed" by
+                                  -- the main program.
+
+      Tarsier : FA11C00_2.Primate := (Common_Name => "East-Indian Tarsier ",
+                                      Weight      => 7,
+                                      Hair_Color  => Brown,
+                                      Habitat     => FA11C00_2.Arboreal);
+
+                                  -- Demonstrates visibility of package
+                                  -- FA11C00_0.FA11C00_1.FA11C00_2.
+                                  --
+                                  -- Type Primate referenced with the simple
+                                  -- name of package FA11C00_2 only.
+                                  --
+                                  -- Simple name of package FA11C00_2 is 
+                                  -- directly visible through "use" of parent.
+
+   begin
+
+      -- Verify that the Format_Primate_Data function will return a blank
+      -- filled string when no parameters are provided in the call.
+
+      TC_Result_String := Format_Primate_Data;
+
+      if (TC_Result_String (1 .. 20)  /= Blank_Name_String) then 
+         Report.Failed ("Incorrect initialization value from function");
+      end if;
+
+
+      -- Use function Format_Primate_Data to return a formatted data string.
+
+      TC_Result_String := 
+        Format_Primate_Data 
+         (Name => FA11C00_2.Image (Tarsier),       
+                                  -- Function returns a 37 character string 
+                                  -- value.
+          Hair => Hair_Color_Type'Image(Tarsier.Hair_Color));
+                                  -- The Hair_Color_Type is referenced 
+                                  -- directly, without package
+                                  -- FA11C00_0.FA11C00_1 qualifier.
+                                  -- No qualification of Hair_Color_Type is
+                                  -- needed due to "use" clause.
+
+                                  -- Note that the result of calling 'Image 
+                                  -- with an enumeration type argument 
+                                  -- results in an upper-case string.
+                                  -- (See conditional statement below.)
+
+      -- Verify the results of the function call.
+
+      if not  (TC_Result_String (1 .. 37) = 
+                "Primate Species: East-Indian Tarsier " and then
+              TC_Result_String (38 .. 55) =
+                " Hair Color: BROWN") then
+        Report.Failed ("Incorrect result returned from function call");
+      end if;
+
+   end;
+
+   Report.Result;
+
+end CA11C03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d010.a
new file mode 100644
index 000000000..7ea0e2267
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d010.a
@@ -0,0 +1,119 @@
+-- CA11D010.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:
+--      See CA11D013.AM
+--
+-- TEST DESCRIPTION:
+--      See CA11D013.AM
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FA11D00.A
+--      => CA11D010.A
+--         CA11D011.A
+--         CA11D012.A
+--         CA11D013.AM
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+-- Child package of FA11D00.
+
+package FA11D00.CA11D010 is     -- Add_Subtract_Complex
+
+   procedure Add (Left, Right : in     Complex_Type;   -- Add two complex
+                  C           :    out Complex_Type);  -- numbers.
+
+   function Subtract (Left, Right : Complex_Type)      -- Subtract two 
+     return Complex_Type;                              -- complex numbers.
+                                                
+                                                       
+                                                       
+end FA11D00.CA11D010;     -- Add_Subtract_Complex
+
+--=======================================================================--
+
+with Report;
+
+package body FA11D00.CA11D010 is     -- Add_Subtract_Complex
+
+   procedure Add (Left, Right : in Complex_Type;
+                  C           :    out Complex_Type) is
+   begin
+      -- Zero is declared in parent package.
+
+      if Left.Real < Zero.Real or else Right.Real < Zero.Real
+        or else Left.Imag < Zero.Imag or else Right.Imag < Zero.Imag then
+          raise Add_Error;     -- Reference to exception in parent package.
+          Report.Failed ("Program control not transferred by raise in " &
+                         "procedure Add");
+      else
+         C.Real := (Left.Real + Right.Real);
+         C.Imag := (Left.Imag + Right.Imag);
+      end if;
+
+   exception
+      when Add_Error => 
+         TC_Handled_In_Child_Pkg_Proc := true;
+         C := Check_Value;           -- Reference to object in parent package.
+         raise;     -- Reraise the Add_Error exception in the subtest.
+         Report.Failed ("Exception not reraised in handler");
+
+      when others    =>
+         Report.Failed ("Unexpected exception raised in Add");
+
+   end Add;
+   -----------------------------------------------------------
+   function Subtract (Left, Right : Complex_Type) 
+     return Complex_Type is
+   begin
+      -- Zero is declared in parent package.
+      if Left.Real < Zero.Real or Right.Real < Zero.Real
+        or Left.Imag < Zero.Imag or Right.Imag < Zero.Imag then
+          raise Subtract_Error;    -- Reference to exception in parent package. 
+          Report.Failed ("Program control not transferred by raise in " &
+                         "function Subtract");
+      else
+         return ( Real => (Left.Real - Right.Real),
+                  Imag => (Left.Imag - Right.Imag) );
+      end if;
+
+   exception
+      when Subtract_Error => 
+         Report.Comment ("Exception is properly handled in Subtract");
+         TC_Handled_In_Child_Pkg_Func := true;
+         return Check_Value;
+
+      when others         =>
+         Report.Failed ("Unexpected exception raised in Subtract");
+
+   end Subtract;
+
+end FA11D00.CA11D010;     -- Add_Subtract_Complex
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d011.a
new file mode 100644
index 000000000..014f74be7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d011.a
@@ -0,0 +1,79 @@
+-- CA11D011.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:
+--      See CA11D013.AM
+--
+-- TEST DESCRIPTION:
+--      See CA11D013.AM
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FA11D00.A
+--         CA11D010.A
+--      => CA11D011.A
+--         CA11D012.A
+--         CA11D013.AM
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      21 Dec 94   SAIC    Declared child procedure specification
+--      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with Report;
+
+
+-- Child procedure of FA11D00.
+
+procedure FA11D00.CA11D011 (Left, Right : in     Complex_Type;
+                            C           :    out Complex_Type);
+
+--=======================================================================--
+
+procedure FA11D00.CA11D011 (Left, Right : in     Complex_Type;
+                            C           :    out Complex_Type) is
+-- Multiply_Complex.
+
+begin
+   -- Zero is declared in parent package.
+
+   if Left.Real < Zero.Real or Right.Imag < Zero.Imag then
+      raise Multiply_Error;  -- Reference to exception in parent package. 
+      Report.Failed ("Program control not transferred by raise in " &
+                     "child procedure FA11D00.CA11D011");
+   else
+      C.Real := (Left.Real * Right.Real);
+      C.Imag := (Left.Imag * Right.Imag);
+   end if;
+
+   exception
+      when others => 
+         TC_Handled_In_Child_Sub := true;
+         C := Check_Value;            -- Reference to object in parent package.
+
+end FA11D00.CA11D011;     -- Multiply_Complex
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d012.a
new file mode 100644
index 000000000..1bb3bd7ac
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d012.a
@@ -0,0 +1,73 @@
+-- CA11D012.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:
+--      See CA11D013.AM
+--
+-- TEST DESCRIPTION:
+--      See CA11D013.AM
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FA11D00.A
+--         CA11D010.A
+--         CA11D011.A
+--      => CA11D012.A
+--         CA11D013.AM
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      21 Dec 94   SAIC    Declared child function specification
+--      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with Report;
+
+-- Child function of FA11D00.
+-- Does not divide zero complex numbers.
+
+function FA11D00.CA11D012 (Left, Right : Complex_Type)
+  return Complex_Type; 
+
+--=======================================================================--
+
+function FA11D00.CA11D012 (Left, Right : Complex_Type)
+  return Complex_Type is                       -- Divide_Complex
+
+begin
+   -- Zero is declared in parent package.
+
+   if Right.Real = Zero.Real or Right.Imag = Zero.Imag then
+      raise Divide_Error;  -- Reference to exception in parent package. 
+      Report.Failed ("Program control not transferred by raise in " &
+                     "child function FA11D00.CA11D012");
+   else
+      return ( Real => (Left.Real / Right.Real),
+               Imag => (Left.Imag / Right.Imag) );
+   end if;
+
+end FA11D00.CA11D012;     -- Divide_Complex
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d013.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d013.am
new file mode 100644
index 000000000..6cbd3bbcc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d013.am
@@ -0,0 +1,256 @@
+-- CA11D013.AM
+--
+--                             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 child unit can raise an exception that is declared in 
+--      parent.                
+--
+-- TEST DESCRIPTION:
+--      Declare a package which defines complex number abstraction with
+--      user-defined exceptions (foundation code).
+--
+--      Add a public child package to the above package. Declare two 
+--      subprograms for the parent type.  Each of the subprograms raises a 
+--      different exception, based on the value of an input parameter.
+--
+--      Add a public child procedure to the foundation package.  This
+--      procedure raises an exception based on the value of an input 
+--      parameter.
+--
+--      Add a public child function to the foundation package.  This
+--      function raises an exception based on the value of an input 
+--      parameter.
+--
+--      In the main program, "with" the child packages, then check that
+--      the exceptions are raised and handled as expected.  Ensure that
+--      exceptions are:
+--         1) raised in the public child package and handled/reraised to
+--            be handled by the main program.
+--         2) raised and handled locally in the public child package.
+--         3) raised and handled locally by "others" in the public child 
+--            procedure.
+--         4) raised in the public child function and propagated to the
+--            main program.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FA11D00.A
+--         CA11D010.A
+--         CA11D011.A
+--         CA11D012.A
+--      => CA11D013.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FA11D00.CA11D010;               -- Add_Subtract_Complex
+with FA11D00.CA11D011;               -- Multiply_Complex
+with FA11D00.CA11D012;               -- Divide_Complex
+
+with Report;
+
+
+procedure CA11D013 is
+
+   package Complex_Pkg renames FA11D00;
+   package Add_Subtract_Complex_Pkg renames FA11D00.CA11D010;
+   use Complex_Pkg;
+
+begin
+
+   Report.Test ("CA11D013", "Check that a child unit can raise an " &
+                "exception that is declared in parent");
+
+
+   Add_Complex_Subtest:
+   declare
+      First       : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 
+                                    Int_Type (Report.Ident_Int (7)));  
+      Second      : Complex_Type := Complex (Int_Type (Report.Ident_Int (5)), 
+                                    Int_Type (Report.Ident_Int (3)));  
+      Add_Result  : Complex_Type := Complex (Int_Type (Report.Ident_Int (8)), 
+                                    Int_Type (Report.Ident_Int (10)));  
+      Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-100)), 
+                                    Int_Type (Report.Ident_Int (100)));  
+      Complex_Num : Complex_Type := Zero;  
+
+   begin
+      Add_Subtract_Complex_Pkg.Add (First, Second, Complex_Num);
+
+      if (Complex_Num /= Add_Result) then
+         Report.Failed ("Incorrect results from addition");
+      end if;
+  
+      -- Error is raised in child package and exception 
+      -- will be handled/reraised to caller.
+
+      Add_Subtract_Complex_Pkg.Add (First, Third, Complex_Num);
+
+      -- Error was not raised in child package.
+      Report.Failed ("Exception was not reraised in addition");
+
+   exception
+      when Add_Error     => 
+         if not TC_Handled_In_Child_Pkg_Proc then
+            Report.Failed ("Exception was not raised in addition");
+         else
+            TC_Handled_In_Caller := true;  -- Exception is reraised from
+                                           -- child package.
+         end if;
+
+      when others => 
+         Report.Failed ("Unexpected exception in addition subtest"); 
+         TC_Handled_In_Caller := false;  -- Improper exception handling
+                                         -- in caller.
+
+   end Add_Complex_Subtest;
+
+
+   Subtract_Complex_Subtest:
+   declare
+      First       : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 
+                                    Int_Type (Report.Ident_Int (6)));  
+      Second      : Complex_Type := Complex (Int_Type (Report.Ident_Int (5)), 
+                                    Int_Type (Report.Ident_Int (7)));  
+      Sub_Result  : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)), 
+                                    Int_Type (Report.Ident_Int (1)));  
+      Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-200)), 
+                                    Int_Type (Report.Ident_Int (1)));  
+      Complex_Num : Complex_Type;
+
+   begin
+      Complex_Num := Add_Subtract_Complex_Pkg.Subtract (Second, First);
+
+      if (Complex_Num /= Sub_Result) then
+         Report.Failed ("Incorrect results from subtraction");
+      end if;
+  
+      -- Error is raised and exception will be handled in child package.
+      Complex_Num := Add_Subtract_Complex_Pkg.Subtract (Second, Third);
+
+   exception
+      when Subtract_Error => 
+         Report.Failed ("Exception raised in subtraction and " &
+                        "propagated to caller");
+         TC_Handled_In_Child_Pkg_Func := false; -- Improper exception handling
+                                                -- in caller.
+
+      when others => 
+         Report.Failed ("Unexpected exception in subtraction subtest"); 
+         TC_Handled_In_Child_Pkg_Func := false; -- Improper exception handling
+                                                -- in caller.
+
+   end Subtract_Complex_Subtest;
+
+
+   Multiply_Complex_Subtest:
+   declare
+      First       : Complex_Type := Complex (Int_Type(Report.Ident_Int(3)), 
+                                    Int_Type (Report.Ident_Int (4)));  
+      Second      : Complex_Type := Complex (Int_Type(Report.Ident_Int(5)), 
+                                    Int_Type (Report.Ident_Int (3)));  
+      Mult_Result : Complex_Type := Complex(Int_Type(Report.Ident_Int(15)), 
+                                    Int_Type(Report.Ident_Int (12)));  
+      Third       : Complex_Type := Complex(Int_Type(Report.Ident_Int(10)), 
+                                    Int_Type(Report.Ident_Int (-10)));  
+      Complex_Num : Complex_Type;
+
+   begin
+      CA11D011 (First, Second, Complex_Num);
+
+      if (Complex_Num /= Mult_Result) then
+         Report.Failed ("Incorrect results from multiplication");
+      end if;
+  
+      -- Error is raised and exception will be handled in child package.
+     CA11D011 (First, Third, Complex_Num);
+
+   exception
+      when Multiply_Error => 
+         Report.Failed ("Exception raised in multiplication and " &
+                        "propagated to caller");
+         TC_Handled_In_Child_Sub := false;     -- Improper exception handling
+                                               -- in caller.
+
+      when others => 
+         Report.Failed ("Unexpected exception in multiplication subtest"); 
+         TC_Handled_In_Child_Sub := false;     -- Improper exception handling
+                                               -- in caller.
+   end Multiply_Complex_Subtest;
+
+
+   Divide_Complex_Subtest:
+   declare
+      First       : Complex_Type := Complex (Int_Type (Report.Ident_Int(10)), 
+                                    Int_Type (Report.Ident_Int (15)));  
+      Second      : Complex_Type := Complex (Int_Type(Report.Ident_Int(5)), 
+                                    Int_Type (Report.Ident_Int (3)));  
+      Div_Result  : Complex_Type := Complex (Int_Type(Report.Ident_Int(2)), 
+                                    Int_Type (Report.Ident_Int (5)));  
+      Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-10)), 
+                                    Int_Type (Report.Ident_Int (0)));  
+      Complex_Num : Complex_Type := Zero;
+
+   begin
+      Complex_Num := CA11D012 (First, Second);
+
+      if (Complex_Num /= Div_Result) then
+         Report.Failed ("Incorrect results from division");
+      end if;
+  
+      -- Error is raised in child package; exception will be
+      -- propagated to caller.
+      Complex_Num := CA11D012 (Second, Third);
+
+      -- Error was not raised in child package.
+      Report.Failed ("Exception was not raised in division subtest ");
+
+   exception
+      when Divide_Error => 
+         TC_Propagated_To_Caller := true;  -- Exception is propagated.
+
+      when others => 
+         Report.Failed ("Unexpected exception in division subtest"); 
+         TC_Propagated_To_Caller := false;  -- Improper exception handling
+                                            -- in caller.
+   end Divide_Complex_Subtest;
+
+
+   if not (TC_Handled_In_Caller         and     -- Check to see that all 
+           TC_Handled_In_Child_Pkg_Proc and     -- exceptions were handled in
+           TC_Handled_In_Child_Pkg_Func and     -- the proper locations.
+           TC_Handled_In_Child_Sub      and     
+           TC_Propagated_To_Caller)
+   then
+      Report.Failed ("Exceptions handled in incorrect locations");
+   end if;
+
+   Report.Result;
+
+end CA11D013;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d02.a
new file mode 100644
index 000000000..7b4f48869
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d02.a
@@ -0,0 +1,393 @@
+-- CA11D02.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 an exception declared in a package can be raised by a 
+--      child of a child package.  Check that it can be renamed in the 
+--      child of the child package and raised with the correct effect.
+--
+-- TEST DESCRIPTION:
+--      Declare a package which defines complex number abstraction with
+--      user-defined exceptions (foundation code).
+--
+--      Add a public child package to the above package. Declare two 
+--      subprograms for the parent type.  
+--
+--      Add a public grandchild package to the foundation package.  Declare
+--      subprograms to raise exceptions.
+--
+--      In the main program, "with" the grandchild package, then check that
+--      the exceptions are raised and handled as expected.  Ensure that
+--      exceptions are:
+--         1) raised in the public grandchild package and handled/reraised to
+--            be handled by the main program.
+--         2) raised and handled locally by the "others" handler in the 
+--            public grandchild package.
+--         3) raised in the public grandchild and propagated to the main 
+--            program.
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         FA11D00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Child package of FA11D00.
+
+package FA11D00.CA11D02_0 is     -- Basic_Complex
+
+   function "+" (Left, Right : Complex_Type) 
+     return Complex_Type;                   -- Add two complex numbers.
+
+   function "*" (Left, Right : Complex_Type) 
+     return Complex_Type;                   -- Multiply two complex numbers.
+
+end FA11D00.CA11D02_0;     -- Basic_Complex
+
+--=======================================================================--
+
+package body FA11D00.CA11D02_0 is     -- Basic_Complex
+
+   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),
+               Imag => (Left.Imag * Right.Imag) );
+   end "*";
+
+end FA11D00.CA11D02_0;     -- Basic_Complex
+
+--=======================================================================--
+
+-- Child package of FA11D00.CA11D02_0.
+-- Grandchild package of FA11D00.
+
+package FA11D00.CA11D02_0.CA11D02_1 is     -- Array_Complex
+
+   Inverse_Error : exception renames Divide_Error;   -- Reference to exception 
+                                                     -- in grandparent package.
+   Array_Size    : constant := 2;
+
+   type Complex_Array_Type is                        
+      array (1 .. Array_Size) of Complex_Type;       -- Reference to type
+                                                     -- in parent package.
+
+   function Multiply (Left  : Complex_Array_Type;    -- Multiply two complex
+                      Right : Complex_Array_Type)    -- arrays.
+     return Complex_Array_Type;
+
+   function Add (Left, Right : Complex_Array_Type)   -- Add two complex
+     return Complex_Array_Type;                      -- arrays.
+
+   procedure Inverse (Right : in     Complex_Array_Type;  -- Invert a complex
+                      Left  : in out Complex_Array_Type); -- array.
+ 
+end FA11D00.CA11D02_0.CA11D02_1;     -- Array_Complex
+
+--=======================================================================--
+
+with Report;
+
+
+package body FA11D00.CA11D02_0.CA11D02_1 is     -- Array_Complex
+
+   function Multiply (Left  : Complex_Array_Type;
+                      Right : Complex_Array_Type)
+     return Complex_Array_Type is
+
+   -- This procedure will raise an exception depending on the input
+   -- parameter.  The exception will be handled locally by the
+   -- "others" handler.
+
+      Result : Complex_Array_Type := (others => Zero);
+
+      subtype Vector_Size is Positive range Left'Range;
+
+   begin  
+      if Left = Result or else Right = Result then -- Do not multiply zero.
+         raise Multiply_Error;                     -- Refence to exception in
+                                                   -- grandparent package.
+         Report.Failed ("Program control not transferred by raise");
+      else
+         for I in Vector_Size loop
+           Result(I) := ( Left(I) * Right(I) );    -- Basic_Complex."*".
+         end loop;
+      end if;
+      return (Result);
+   
+   exception
+      when others =>
+         Report.Comment ("Exception is handled by others in Multiplication");
+         TC_Handled_In_Grandchild_Pkg_Func := true;
+         return (Zero, Zero);
+      
+   end Multiply;
+   --------------------------------------------------------------
+   function Add (Left, Right : Complex_Array_Type)
+     return Complex_Array_Type is
+
+   -- This function will raise an exception depending on the input
+   -- parameter.  The exception will be propagated and handled
+   -- by the caller.
+
+      Result : Complex_Array_Type := (others => Zero);
+
+      subtype Vector_Size is Positive range Left'Range;
+
+   begin  
+      if Left = Result or Right = Result then     -- Do not add zero.
+         raise Add_Error;                         -- Refence to exception in
+                                                  -- grandparent package.
+         Report.Failed ("Program control not transferred by raise");
+      else
+         for I in Vector_Size loop                   
+           Result(I) := ( Left(I) + Right(I) );   -- Basic_Complex."+".
+         end loop;
+      end if;
+      return (Result);
+ 
+   end Add;
+   --------------------------------------------------------------
+   procedure Inverse (Right : in     Complex_Array_Type;
+                      Left  : in out Complex_Array_Type) is
+
+   -- This function will raise an exception depending on the input
+   -- parameter.  The exception will be handled/reraised to be
+   -- handled by the caller.
+
+      Result : Complex_Array_Type := (others => Zero);
+
+      Array_With_Zero : boolean := false;
+
+   begin
+      for I in 1 .. Right'Length loop
+        if Right(I) = Zero then      -- Check for zero.
+          Array_With_Zero := true;
+        end if;
+      end loop;
+
+      If Array_With_Zero then
+         raise Inverse_Error;      -- Do not inverse zero.
+         Report.Failed ("Program control not transferred by raise");
+      else
+         for I in 1 .. Array_Size loop
+           Left(I).Real := - Right(I).Real;
+           Left(I).Imag := - Right(I).Imag;
+        end loop;
+      end if;
+
+   exception
+      when Inverse_Error  => 
+         TC_Handled_In_Grandchild_Pkg_Proc := true;
+         Left := Result;
+         raise;     -- Reraise the Inverse_Error exception in the subtest.
+         Report.Failed ("Exception not reraised in handler");
+
+      when others => 
+         Report.Failed ("Unexpected exception in procedure Inverse");
+   end Inverse;
+
+end FA11D00.CA11D02_0.CA11D02_1;     -- Array_Complex
+
+--=======================================================================--
+
+with FA11D00.CA11D02_0.CA11D02_1;    -- Array_Complex,
+                                     -- implicitly with Basic_Complex.
+with Report;
+
+procedure CA11D02 is
+
+   package Complex_Pkg renames FA11D00;
+   package Array_Complex_Pkg renames FA11D00.CA11D02_0.CA11D02_1;
+
+   use Complex_Pkg;                            
+   use Array_Complex_Pkg;                      
+
+begin
+
+   Report.Test ("CA11D02", "Check that an exception declared in a package " &
+                "can be raised by a child of a child package");
+
+   Multiply_Complex_Subtest:
+   declare
+      Operand_1  : Complex_Array_Type 
+                 := ( Complex (Int_Type (Report.Ident_Int (3)), 
+                      Int_Type (Report.Ident_Int (5))),
+                      Complex (Int_Type (Report.Ident_Int (2)), 
+                      Int_Type (Report.Ident_Int (8))) );
+      Operand_2  : Complex_Array_Type 
+                 := ( Complex (Int_Type (Report.Ident_Int (1)), 
+                      Int_Type (Report.Ident_Int (2))),
+                      Complex (Int_Type (Report.Ident_Int (3)), 
+                      Int_Type (Report.Ident_Int (6))) );
+      Operand_3  : Complex_Array_Type := ( Zero, Zero);
+      Mul_Result : Complex_Array_Type 
+                 := ( Complex (Int_Type (Report.Ident_Int (3)), 
+                      Int_Type (Report.Ident_Int (10))),
+                      Complex (Int_Type (Report.Ident_Int (6)), 
+                      Int_Type (Report.Ident_Int (48))) );
+      Complex_No : Complex_Array_Type := (others => Zero);
+
+   begin
+      If (Multiply (Operand_1, Operand_2) /= Mul_Result) then
+         Report.Failed ("Incorrect results from multiplication");
+      end if;
+
+      -- Error is raised and exception will be handled in grandchild package.
+
+      Complex_No := Multiply (Operand_1, Operand_3);
+
+      if Complex_No /= (Zero, Zero) then
+         Report.Failed ("Exception was not raised in multiplication");
+      end if;
+
+   exception
+      when Multiply_Error     =>
+         Report.Failed ("Exception raised in multiplication and " &
+                        "propagated to caller");
+         TC_Handled_In_Grandchild_Pkg_Func := false;  
+              -- Improper exception handling in caller.
+
+      when others => 
+         Report.Failed ("Unexpected exception in multiplication");
+         TC_Handled_In_Grandchild_Pkg_Func := false;  
+              -- Improper exception handling in caller.
+
+   end Multiply_Complex_Subtest;
+
+
+   Add_Complex_Subtest:
+   declare
+      Operand_1  : Complex_Array_Type 
+                 := ( Complex (Int_Type (Report.Ident_Int (2)), 
+                      Int_Type (Report.Ident_Int (7))),
+                      Complex (Int_Type (Report.Ident_Int (5)), 
+                      Int_Type (Report.Ident_Int (8))) );
+      Operand_2  : Complex_Array_Type 
+                 := ( Complex (Int_Type (Report.Ident_Int (4)), 
+                      Int_Type (Report.Ident_Int (1))),
+                      Complex (Int_Type (Report.Ident_Int (2)), 
+                      Int_Type (Report.Ident_Int (3))) );
+      Operand_3  : Complex_Array_Type := ( Zero, Zero);
+      Add_Result : Complex_Array_Type 
+                 := ( Complex (Int_Type (Report.Ident_Int (6)), 
+                      Int_Type (Report.Ident_Int (8))),
+                      Complex (Int_Type (Report.Ident_Int (7)), 
+                      Int_Type (Report.Ident_Int (11))) );
+      Complex_No : Complex_Array_Type := (others => Zero);
+
+   begin
+      Complex_No := Add (Operand_1, Operand_2);
+
+      If (Complex_No /= Add_Result) then
+         Report.Failed ("Incorrect results from addition");
+      end if;
+
+      -- Error is raised in grandchild package and exception 
+      -- will be propagated to caller.
+
+      Complex_No := Add (Operand_1, Operand_3);
+
+      if Complex_No = Add_Result then
+         Report.Failed ("Exception was not raised in addition");
+      end if;
+
+   exception
+      when Add_Error => 
+         TC_Propagated_To_Caller := true;  -- Exception is propagated.
+
+      when others => 
+         Report.Failed ("Unexpected exception in addition subtest");
+         TC_Propagated_To_Caller := false;  -- Improper exception handling
+                                            -- in caller.
+   end Add_Complex_Subtest;
+
+   Inverse_Complex_Subtest:
+   declare
+      Operand_1  : Complex_Array_Type 
+                 := ( Complex (Int_Type (Report.Ident_Int (1)), 
+                      Int_Type (Report.Ident_Int (5))),
+                      Complex (Int_Type (Report.Ident_Int (3)), 
+                      Int_Type (Report.Ident_Int (11))) );
+      Operand_3  : Complex_Array_Type 
+                 := ( Zero, Complex (Int_Type (Report.Ident_Int (3)), 
+                      Int_Type (Report.Ident_Int (6))) );
+      Inv_Result : Complex_Array_Type 
+                 := ( Complex (Int_Type (Report.Ident_Int (-1)), 
+                      Int_Type (Report.Ident_Int (-5))),
+                      Complex (Int_Type (Report.Ident_Int (-3)), 
+                      Int_Type (Report.Ident_Int (-11))) );
+      Complex_No : Complex_Array_Type := (others => Zero);
+
+   begin
+      Inverse (Operand_1, Complex_No);
+
+      if (Complex_No /= Inv_Result) then
+         Report.Failed ("Incorrect results from inverse");
+      end if;
+
+      -- Error is raised in grandchild package and exception 
+      -- will be handled/reraised to caller.
+
+      Inverse (Operand_3, Complex_No);
+
+      Report.Failed ("Exception was not handled in inverse");
+
+   exception
+      when Inverse_Error => 
+         if not TC_Handled_In_Grandchild_Pkg_Proc then
+            Report.Failed ("Exception was not raised in inverse");
+         else
+            TC_Handled_In_Caller := true;  -- Exception is reraised from
+                                           -- child package.
+         end if;
+
+      when others => 
+         Report.Failed ("Unexpected exception in inverse");
+         TC_Handled_In_Caller := false; 
+                -- Improper exception handling in caller.
+
+   end Inverse_Complex_Subtest;
+
+   if not (TC_Handled_In_Caller               and   -- Check to see that all 
+           TC_Handled_In_Grandchild_Pkg_Proc  and   -- exceptions were handled
+           TC_Handled_In_Grandchild_Pkg_Func  and   -- in proper location.
+           TC_Propagated_To_Caller)        
+   then
+      Report.Failed ("Exceptions handled in incorrect locations");
+   end if;
+
+   Report.Result;
+
+end CA11D02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d03.a
new file mode 100644
index 000000000..901b8d217
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca11d03.a
@@ -0,0 +1,174 @@
+-- CA11D03.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 an exception declared in a package can be raised by a 
+--      client of a child of the package.  Check that it can be renamed in 
+--      the client of the child of the package and raised with the correct 
+--      effect.
+--
+-- TEST DESCRIPTION:
+--      Declare a package which defines complex number abstraction with
+--      user-defined exceptions (foundation code).
+--
+--      Add a public child package to the above package. Declare two 
+--      subprograms for the parent type.  
+--
+--      In the main program, "with" the child package, then check that
+--      an exception can be raised and handled as expected.  
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--
+--         FA11D00.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Child package of FA11D00.
+package FA11D00.CA11D03_0 is     -- Basic_Complex
+
+   function "+" (Left, Right : Complex_Type) 
+     return Complex_Type;                   -- Add two complex numbers.
+
+   function "*" (Left, Right : Complex_Type) 
+     return Complex_Type;                   -- Multiply two complex numbers.
+
+end FA11D00.CA11D03_0;     -- Basic_Complex
+
+--=======================================================================--
+
+package body FA11D00.CA11D03_0 is     -- Basic_Complex
+
+   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),
+               Imag => (Left.Imag * Right.Imag) );
+   end "*";
+
+end FA11D00.CA11D03_0;     -- Basic_Complex
+
+--=======================================================================--
+
+with FA11D00.CA11D03_0;    -- Basic_Complex,
+                           -- implicitly with Complex_Definition.
+with Report;
+
+procedure CA11D03 is
+
+   package Complex_Pkg renames FA11D00;     -- Complex_Definition_Pkg
+   package Basic_Complex_Pkg renames FA11D00.CA11D03_0;   -- Basic_Complex
+
+   use Complex_Pkg;                            
+   use Basic_Complex_Pkg;           
+           
+   TC_Handled_In_Subtest_1,
+   TC_Handled_In_Subtest_2 : boolean := false;
+
+begin
+
+   Report.Test ("CA11D03", "Check that an exception declared in a package " &
+                "can be raised by a client of a child of the package");
+
+   Multiply_Complex_Subtest:
+   declare
+      Operand_1  : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)), 
+                                   Int_Type (Report.Ident_Int (2)));  
+                                   -- Referenced to function in parent package.
+      Operand_2  : Complex_Type := Complex (Int_Type (Report.Ident_Int (10)), 
+                                   Int_Type (Report.Ident_Int (8)));  
+      Mul_Res    : Complex_type := Complex (Int_Type (Report.Ident_Int (30)), 
+                                   Int_Type (Report.Ident_Int (16)));  
+      Complex_No : Complex_Type := Zero;  -- Zero is declared in parent package.
+   begin
+      Complex_No := Operand_1 * Operand_2;   -- Basic_Complex."*".
+      if Complex_No /= Mul_Res then
+         Report.Failed ("Incorrect results from multiplication");
+      end if;
+
+      -- Error is raised and exception will be handled.
+      if Complex_No = Mul_Res then
+         raise Multiply_Error;             -- Reference to exception in
+      end if;                              -- parent package.
+
+   exception
+      when Multiply_Error => 
+         TC_Handled_In_Subtest_1 := true;
+      when others => 
+         TC_Handled_In_Subtest_1 := false;  -- Improper exception handling.
+
+   end Multiply_Complex_Subtest;
+
+   Add_Complex_Subtest:
+   declare
+      Error_In_Client : exception renames Add_Error;  
+                        -- Reference to exception in parent package.
+      Operand_1  : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)), 
+                                   Int_Type (Report.Ident_Int (7)));  
+      Operand_2  : Complex_Type := Complex (Int_Type (Report.Ident_Int (-4)), 
+                                   Int_Type (Report.Ident_Int (1)));  
+      Add_Res    : Complex_type := Complex (Int_Type (Report.Ident_Int (-2)), 
+                                   Int_Type (Report.Ident_Int (8)));  
+      Complex_No : Complex_Type := One;   -- One is declared in parent 
+                                          -- package.
+   begin
+      Complex_No := Operand_1 + Operand_2;   -- Basic_Complex."+".
+
+      if Complex_No /= Add_Res then
+         Report.Failed ("Incorrect results from multiplication");
+      end if;
+
+      -- Error is raised and exception will be handled.
+      if Complex_No = Add_Res then
+         raise Error_In_Client;
+      end if;
+
+   exception
+      when Error_In_Client => 
+         TC_Handled_In_Subtest_2 := true;
+
+      when others => 
+         TC_Handled_In_Subtest_2 := false;  -- Improper exception handling.
+
+   end Add_Complex_Subtest;
+
+   if not (TC_Handled_In_Subtest_1           and   -- Check to see that all 
+           TC_Handled_In_Subtest_2)                -- exceptions were handled
+                                                   -- in the proper location.
+   then
+      Report.Failed ("Exceptions handled in incorrect locations");
+   end if;
+
+   Report.Result;
+
+end CA11D03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13001.a
new file mode 100644
index 000000000..094bd7a88
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13001.a
@@ -0,0 +1,370 @@
+-- CA13001.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 separate protected unit declared in a non-generic child 
+--      unit of a private parent have the same visibility into its parent, 
+--      its siblings, and packages on which its parent depends as is available 
+--      at the point of their declaration.
+--
+-- TEST DESCRIPTION:
+--      A scenario is created that demonstrates the potential of having all
+--      members of one family to take out a transportation.  The restriction
+--      is depend on each member to determine who can get a car, a clunker, 
+--      or a bicycle.  If no transportation is available, that member has to
+--      walk.  
+--      
+--      Declare a package with location for each family member.  Declare
+--      a public parent package.  Declare a private child package. Declare a 
+--      public grandchild of this private package.  Declare a protected unit 
+--      as a subunit in a public grandchild package.  This subunit has 
+--      visibility into it's parent body ancestor and its sibling.
+--
+--      Declare another public parent package.  The body of this package has
+--      visibility into its private sibling's descendants.
+--
+--      In the main program, "with"s the parent package.  Check that the
+--      protected subunit performs as expected.  
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
+--
+--!
+
+package CA13001_0 is                    
+
+   type Location is (School, Work, Beach, Home);
+   type Family is (Father, Mother, Teen);
+   Destination : array (Family) of Location;
+
+   -- Other type definitions and procedure declarations in real application.
+
+end CA13001_0;
+
+-- No bodies required for CA13001_0.
+
+     --==================================================================--
+
+-- Public parent.
+
+package CA13001_1 is                     
+
+   type Transportation is (Bicycle, Clunker, New_Car);
+   type Key_Type is private;
+   Walking : boolean := false;
+
+   -- Other type definitions and procedure declarations in real application.
+
+private
+   type Key_Type 
+     is range Transportation'pos(Bicycle) .. Transportation'pos(New_Car);
+
+end CA13001_1;
+
+-- No bodies required for CA13001_1.
+
+     --==================================================================--
+
+-- Private child. 
+
+private package CA13001_1.CA13001_2 is       
+
+   type Transport is
+      record
+         In_Use : boolean := false;
+      end record;
+   Vehicles : array (Transportation) of Transport;
+
+   -- Other type definitions and procedure declarations in real application.
+
+end CA13001_1.CA13001_2;
+
+-- No bodies required for CA13001_1.CA13001_2.
+
+     --==================================================================--
+
+-- Public grandchild of a private parent.
+
+package CA13001_1.CA13001_2.CA13001_3 is
+
+   Flat_Tire : array (Transportation) of boolean := (others => false);
+
+   -- Other type definitions and procedure declarations in real application.
+
+end CA13001_1.CA13001_2.CA13001_3;
+
+-- No bodies required for CA13001_1.CA13001_2.CA13001_3.
+
+     --==================================================================--
+
+-- Context clauses required for visibility needed by a separate subunit.
+
+with CA13001_0;                           
+use  CA13001_0;
+
+-- Public grandchild of a private parent.
+
+package CA13001_1.CA13001_2.CA13001_4 is
+
+   type Transit is
+      record
+         Available : boolean := false;
+      end record;
+   type Keys_Array is array (Transportation) of Transit;
+   Fuel : array (Transportation) of boolean := (others => true);
+
+   protected Family_Transportation is
+
+      procedure Get_Vehicle (Who : in     Family;
+                             Key :    out Key_Type);
+      procedure Return_Vehicle (Tr : in Transportation);
+      function TC_Verify (What : Transportation) return boolean;
+
+   private
+      Keys : Keys_Array;
+
+   end Family_Transportation;
+
+end CA13001_1.CA13001_2.CA13001_4;
+
+     --==================================================================--
+
+-- Context clause required for visibility needed by a separate subunit.
+
+with CA13001_1.CA13001_2.CA13001_3;    -- Public sibling.
+
+package body CA13001_1.CA13001_2.CA13001_4 is
+
+   protected body Family_Transportation is separate;
+
+end CA13001_1.CA13001_2.CA13001_4;
+
+     --==================================================================--
+
+separate (CA13001_1.CA13001_2.CA13001_4)
+protected body Family_Transportation is
+
+   procedure Get_Vehicle (Who : in     Family;
+                          Key :    out Key_Type) is
+   begin
+      case Who is
+         when Father|Mother => 
+            -- Drive new car to work
+
+            -- Reference package with'ed by the subunit parent's body.
+            if Destination(Who) = Work then
+
+               -- Reference type declared in the private parent of the subunit
+               -- parent's body.
+               -- Reference type declared in the visible part of the 
+               -- subunit parent's body.
+               if not Vehicles(New_Car).In_Use and Fuel(New_Car) 
+
+                 -- Reference type declared in the public sibling of the 
+                 -- subunit parent's body.
+                 and not CA13001_1.CA13001_2.CA13001_3.Flat_Tire(New_Car) then
+                    Vehicles(New_Car).In_Use := true;
+
+                    -- Reference type declared in the private part of the 
+                    -- protected subunit.
+                    Keys(New_Car).Available := false;
+                    Key                     := Transportation'pos(New_Car);
+               else
+                 -- Reference type declared in the grandparent of the subunit
+                 -- parent's body.
+                 Walking := true;
+               end if;
+
+            -- Drive clunker to other destinations.
+            else
+               if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not 
+                 CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
+                    Vehicles(Clunker).In_Use := true;
+                    Keys(Clunker).Available  := false;
+                    Key                      := Transportation'pos(Clunker);
+               else
+                 Walking := true;
+                 Key     := Transportation'pos(Bicycle);
+               end if;
+            end if;
+    
+         -- Similar for Teen.
+         when Teen => 
+            if not Vehicles(Clunker).In_Use and Fuel(Clunker) and not 
+              CA13001_1.CA13001_2.CA13001_3.Flat_Tire(Clunker) then
+                 Vehicles(Clunker).In_Use := true;
+                 Keys(Clunker).Available  := false;
+                 Key                      := Transportation'pos(Clunker);
+            else
+               Walking := true;
+               Key     := Transportation'pos(Bicycle);
+            end if;
+      end case;
+
+   end Get_Vehicle;
+
+   ----------------------------------------------------------------
+
+   -- Any family member can bring back the transportation with the key.
+
+   procedure Return_Vehicle (Tr : in Transportation) is
+   begin
+      Vehicles(Tr).In_Use := false;
+      Keys(Tr).Available  := true;
+   end Return_Vehicle;
+
+   ----------------------------------------------------------------
+
+   function TC_Verify (What : Transportation) return boolean is
+   begin
+      return Keys(What).Available;
+   end TC_Verify;
+   
+end Family_Transportation;
+
+     --==================================================================--
+
+with CA13001_0;
+use  CA13001_0;
+
+-- Public child.
+
+package CA13001_1.CA13001_5 is
+
+   -- In a real application, tasks could be used to demonstrate 
+   -- a family transportation scenario, i.e., each member of
+   -- a family can take a vehicle out concurrently, then return
+   -- them at the same time. For the purposes of the test, family
+   -- transportation happens sequentially.
+
+   procedure Provide_Transportation (Who     : in     Family;
+                                     Get_Key :    out Key_Type;
+                                     Get_Veh :    out boolean);
+   procedure Return_Transportation (What   : in     Transportation;
+                                    Rt_Veh :    out boolean);
+
+end CA13001_1.CA13001_5;
+
+     --==================================================================--
+
+with CA13001_1.CA13001_2.CA13001_4;   -- Public grandchild of a private parent,
+                                      -- implicitly with CA13001_1.CA13001_2.
+package body CA13001_1.CA13001_5 is
+
+   package Transportation_Pkg renames CA13001_1.CA13001_2.CA13001_4;
+   use Transportation_Pkg;
+
+   -- These two validation subprograms provide the capability to check the 
+   -- components defined in the private packages from within the client 
+   -- program.
+
+   procedure Provide_Transportation (Who     : in     Family;
+                                     Get_Key :    out Key_Type;
+                                     Get_Veh :    out boolean) is
+   begin
+      -- Goto work, school, or to the beach.
+      Family_Transportation.Get_Vehicle (Who, Get_Key);
+      if not Family_Transportation.TC_Verify 
+        (Transportation'Val(Get_Key)) then
+           Get_Veh := true;
+      else
+         Get_Veh := false;
+      end if;
+
+   end Provide_Transportation;
+
+   ----------------------------------------------------------------
+
+   procedure Return_Transportation (What   : in     Transportation;
+                                    Rt_Veh :    out boolean) is
+   begin
+      Family_Transportation.Return_Vehicle (What);
+      if Family_Transportation.TC_Verify(What) and 
+        not CA13001_1.CA13001_2.Vehicles(What).In_Use then
+           Rt_Veh := true;
+      else
+         Rt_Veh := false;
+      end if;
+
+   end Return_Transportation;
+
+end CA13001_1.CA13001_5;
+
+     --==================================================================--
+
+with CA13001_0;
+with CA13001_1.CA13001_5;        -- Implicitly with parent, CA13001_1.
+with Report;
+
+procedure CA13001 is
+
+   Mommy           : CA13001_0.Family := CA13001_0.Mother;
+   Daddy           : CA13001_0.Family := CA13001_0.Father;
+   BG              : CA13001_0.Family := CA13001_0.Teen;
+   BG_Clunker      : CA13001_1.Transportation := CA13001_1.Clunker;
+   Get_Key         : CA13001_1.Key_Type;
+   Get_Transit     : boolean := false;
+   Return_Transit  : boolean := false;
+
+begin 
+   Report.Test ("CA13001", "Check that a protected subunit declared in " & 
+                "a child unit of a private parent have the same visibility " &
+                "into its parent, its parent's siblings, and packages on " &
+                "which its parent depends");
+
+   -- Get transportation for mother to go to work.
+   CA13001_0.Destination(CA13001_0.Mother) := CA13001_0.Work;
+   CA13001_1.CA13001_5.Provide_Transportation (Mommy, Get_Key, Get_Transit);
+   if not Get_Transit then
+      Report.Failed ("Failed to get mother transportation");
+   end if;
+
+   -- Get transportation for teen to go to school.
+   CA13001_0.Destination(CA13001_0.Teen) := CA13001_0.School;
+   Get_Transit := false;
+   CA13001_1.CA13001_5.Provide_Transportation (BG, Get_Key, Get_Transit);
+   if not Get_Transit then
+      Report.Failed ("Failed to get teen transportation");
+   end if;
+
+   -- Get transportation for father to go to the beach.
+   CA13001_0.Destination(CA13001_0.Father) := CA13001_0.Beach;
+   Get_Transit := false;
+   CA13001_1.CA13001_5.Provide_Transportation (Daddy, Get_Key, Get_Transit);
+   if Get_Transit and not CA13001_1.Walking then
+      Report.Failed ("Failed to make daddy to walk to the beach");
+   end if;
+
+   -- Return the clunker.
+   CA13001_1.CA13001_5.Return_Transportation (BG_Clunker, Return_Transit);
+   if not Return_Transit then
+      Report.Failed ("Failed to get back the clunker");
+   end if;
+
+   Report.Result;
+
+end CA13001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13002.a
new file mode 100644
index 000000000..e985174af
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13002.a
@@ -0,0 +1,259 @@
+-- CA13002.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 two library child units and/or subunits may have the same 
+--      simple names if they have distinct expanded names.
+--
+-- TEST DESCRIPTION:
+--      Declare a package that provides some primitive functionality (minimal
+--      terminal driver operations in this case).  Add child packages to 
+--      expand the functionality for different but related contexts (different
+--      terminal kinds).  Add child packages, or subunits, to the children to
+--      provide the same high level operation for each of the different 
+--      contexts (terminals).  Since the operations are the same, at the leaf
+--      level they are likely to have the same names.
+--
+--      The main program "with"s the child packages.  Check that the
+--      child units and subunits perform as expected.  
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+   
+-- Public parent.
+package CA13002_0 is                     -- Terminal_Driver.
+
+   type TC_Name is (First_Child, Second_Child, Third_Child, Fourth_Child);
+   type TC_Call_From is (First_Grandchild, Second_Grandchild, First_Subunit, 
+                           Second_Subunit);
+   type TC_Calls_Arr is array (TC_Name, TC_Call_From) of boolean;
+   TC_Calls : TC_Calls_Arr := (others => (others => false));
+
+   -- In real application, Send_Control_Sequence sends keystrokes from
+   -- the terminal, i.e., space, escape, etc.
+   procedure Send_Control_Sequence (Row : in TC_Name;
+                                    Col : in TC_Call_From);
+
+end CA13002_0;
+
+     --==================================================================--
+
+-- First child.
+package CA13002_0.CA13002_1 is           -- Terminal_Driver.VT100
+
+   -- Move cursor up, down, left, or right.
+   procedure Move_Cursor (Col : in TC_Call_From);
+
+end CA13002_0.CA13002_1;
+
+     --==================================================================--
+
+-- First grandchild.
+procedure CA13002_0.CA13002_1.CA13002_5; -- Terminal_Driver.VT100.Cursor_Up
+
+     --==================================================================--
+
+-- Second child.
+package CA13002_0.CA13002_2 is           -- Terminal_Driver.IBM3270
+
+   procedure Move_Cursor (Col : in TC_Call_From);
+
+end CA13002_0.CA13002_2;
+
+     --==================================================================--
+
+-- Second grandchild.
+procedure CA13002_0.CA13002_2.CA13002_5; -- Terminal_Driver.IBM3270.Cursor_Up
+
+     --==================================================================--
+
+-- Third child.
+package CA13002_0.CA13002_3 is           -- Terminal_Driver.DOS_ANSI
+
+   procedure Move_Cursor (Col : in TC_Call_From);
+
+   procedure CA13002_5;                  -- Terminal_Driver.DOS_ANSI.Cursor_Up
+                                         -- implementation will be as a 
+                                         -- separate subunit.
+end CA13002_0.CA13002_3;
+
+     --==================================================================--
+
+-- Fourth child.
+package CA13002_0.CA13002_4 is           -- Terminal_Driver.WYSE
+
+   procedure Move_Cursor (Col : in TC_Call_From);
+
+   procedure CA13002_5;                  -- Terminal_Driver.WYSE.Cursor_Up
+                                         -- implementation will be as a 
+                                         -- separate subunit.
+
+end CA13002_0.CA13002_4;
+
+     --==================================================================--
+
+-- Terminal_Driver.
+package body CA13002_0 is                  
+
+   procedure Send_Control_Sequence (Row : in TC_Name;
+                                    Col : in TC_Call_From) is
+   begin
+      -- Reads a key and takes action.
+      TC_Calls (Row, Col) := true;
+   end Send_Control_Sequence;
+
+end CA13002_0;
+
+     --==================================================================--
+
+-- Terminal_Driver.VT100.
+package body CA13002_0.CA13002_1 is                     
+
+   procedure Move_Cursor (Col : in TC_Call_From) is
+   begin
+      Send_Control_Sequence (First_Child, Col);
+   end Move_Cursor;
+
+end CA13002_0.CA13002_1;
+
+     --==================================================================--
+
+-- Terminal_Driver.VT100.Cursor_Up.
+procedure CA13002_0.CA13002_1.CA13002_5 is 
+begin
+   Move_Cursor (First_Grandchild);        -- from Terminal_Driver.VT100.
+end CA13002_0.CA13002_1.CA13002_5;
+
+     --==================================================================--
+
+-- Terminal_Driver.IBM3270.
+package body CA13002_0.CA13002_2 is                     
+
+   procedure Move_Cursor (Col : in TC_Call_From) is
+   begin
+      Send_Control_Sequence (Second_Child, Col);
+   end Move_Cursor;
+
+end CA13002_0.CA13002_2;
+
+     --==================================================================--
+
+-- Terminal_Driver.IBM3270.Cursor_Up.
+procedure CA13002_0.CA13002_2.CA13002_5 is 
+begin
+   Move_Cursor (Second_Grandchild);       -- from Terminal_Driver.IBM3270.
+end CA13002_0.CA13002_2.CA13002_5;
+
+     --==================================================================--
+
+-- Terminal_Driver.DOS_ANSI.
+package body CA13002_0.CA13002_3 is                     
+
+   procedure Move_Cursor (Col : in TC_Call_From) is
+   begin
+      Send_Control_Sequence (Third_Child, Col);
+   end Move_Cursor;
+
+   procedure CA13002_5 is separate;
+
+end CA13002_0.CA13002_3;
+
+     --==================================================================--
+
+-- Terminal_Driver.DOS_ANSI.Cursor_Up.
+separate (CA13002_0.CA13002_3)
+procedure CA13002_5 is 
+begin
+   Move_Cursor (First_Subunit);           -- from Terminal_Driver.DOS_ANSI.
+end CA13002_5;
+
+     --==================================================================--
+
+-- Terminal_Driver.WYSE.
+package body CA13002_0.CA13002_4 is                     
+
+   procedure Move_Cursor (Col : in TC_Call_From) is
+   begin
+      Send_Control_Sequence (Fourth_Child, Col);
+   end Move_Cursor;
+
+   procedure CA13002_5 is separate;
+
+end CA13002_0.CA13002_4;
+
+     --==================================================================--
+
+-- Terminal_Driver.WYSE.Cursor_Up.
+separate (CA13002_0.CA13002_4)
+procedure CA13002_5 is 
+begin
+   Move_Cursor (Second_Subunit);          -- from Terminal_Driver.WYSE.
+end CA13002_5;
+
+     --==================================================================--
+
+with CA13002_0.CA13002_1.CA13002_5;     -- Terminal_Driver.VT100.Cursor_Up,
+                                        -- implicitly with parent, CA13002_0.
+with CA13002_0.CA13002_2.CA13002_5;     -- Terminal_Driver.IBM3270.Cursor_Up.
+with CA13002_0.CA13002_3;               -- Terminal_Driver.DOS_ANSI.
+with CA13002_0.CA13002_4;               -- Terminal_Driver.WYSE.
+with Report;
+use  CA13002_0;                         -- All primitive subprograms directly
+                                        -- visible.
+
+procedure CA13002 is
+   Expected_Calls : constant CA13002_0.TC_Calls_Arr 
+                  := ((true,  false, false, false),
+                      (false, true , false, false),
+                      (false, false, true , false),
+                      (false, false, false, true ));
+begin
+   Report.Test ("CA13002", "Check that two library units and/or subunits " &
+                "may have the same simple names if they have distinct " &
+                "expanded names");
+
+   -- Note that the leaves all have the same name.
+   -- Call the first grandchild.
+   CA13002_0.CA13002_1.CA13002_5;       
+
+   -- Call the second grandchild.
+   CA13002_0.CA13002_2.CA13002_5;
+
+   -- Call the first subunit.
+   CA13002_0.CA13002_3.CA13002_5;
+
+   -- Call the second subunit.
+   CA13002_0.CA13002_4.CA13002_5;
+
+   if TC_Calls /= Expected_Calls then
+      Report.Failed ("Wrong result");
+   end if;  
+
+   Report.Result;
+
+end CA13002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13003.a
new file mode 100644
index 000000000..607639efe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13003.a
@@ -0,0 +1,256 @@
+-- CA13003.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 separate subunits which share an ancestor may have the
+--      same name if they have different fully qualified names.  Check
+--      the case of separate subunits of separate subunits.
+--      This test is a change in semantics from Ada 83 to Ada 9X.
+--
+-- TEST DESCRIPTION:
+--      Declare a package that provides file processing operations.  Declare
+--      one separate package to do the file processing, and another to do the
+--      auditing.  These packages contain similar functions declared in 
+--      separate subunits.  Verify that the main program can call the 
+--      separate subunits with the same name.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Simulates a file processing application.  The processing package opens
+-- files, reads files, does file processing, and generates reports.
+-- The auditing package opens files, read files, and generates reports.
+
+package CA13003_0 is       
+
+   type File_ID is range 1 .. 100;
+   subtype File_Name is string (1 .. 10);
+
+   TC_Open_For_Process    : boolean := false;
+   TC_Open_For_Audit      : boolean := false;
+   TC_Report_From_Process : boolean := false;
+   TC_Report_From_Audit   : boolean := false;
+
+   type File_Rec is 
+      record
+         Name : File_Name;
+         ID   : File_ID;
+      end record;
+
+   procedure Initialize_File_Rec (Name_In : in     File_Name;
+                                  ID_In   : in     File_ID;
+                                  File_In :    out File_Rec);
+ 
+   ----------------------------------------------------------------------
+
+   package CA13003_1 is    -- File processing
+
+      procedure CA13003_3;                             -- Open files
+      function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
+        return File_Name;                              -- Process files
+      package CA13003_5 is                             -- Generate report
+         procedure Generate_Report;
+      end CA13003_5;
+
+   end CA13003_1;
+
+   ----------------------------------------------------------------------
+
+   package CA13003_2 is    -- File auditing
+
+      procedure CA13003_3;                             -- Open files
+      function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
+        return File_Name;                              -- Process files
+      package CA13003_5 is                             -- Generate report
+         procedure Generate_Report;
+      end CA13003_5;
+
+   end CA13003_2;
+
+end CA13003_0;
+
+     --==================================================================--
+
+package body CA13003_0 is       
+
+   procedure Initialize_File_Rec (Name_In : in     File_Name;
+                                  ID_In   : in     File_ID;
+                                  File_In :    out File_Rec) is
+   -- Not a real initialization.  Real application can use file
+   -- database to create the file record.
+   begin
+      File_In.Name := Name_In;
+      File_In.ID   := ID_In;
+   end Initialize_File_Rec;
+
+   package body CA13003_1 is separate;
+   package body CA13003_2 is separate;
+
+end CA13003_0;
+
+     --==================================================================--
+
+separate (CA13003_0)
+package body CA13003_1 is
+
+   procedure CA13003_3 is separate;                 -- Open files
+   function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
+     return File_Name is separate;                  -- Process files
+   package body CA13003_5 is separate;              -- Generate report
+
+end CA13003_1;
+
+     --==================================================================--
+
+separate (CA13003_0.CA13003_1)
+procedure CA13003_3 is                              -- Open files
+begin
+   -- In real file processing application, open file from database, setup
+   -- data structure, etc.
+   TC_Open_For_Process := true;
+end CA13003_3;
+
+     --==================================================================--
+
+separate (CA13003_0.CA13003_1)
+function CA13003_4 (ID_In : File_ID;                -- Process files
+                    File_In : File_Rec) return File_Name is 
+begin
+   -- In real file processing application, process files for more information.
+   return File_In.Name;
+end CA13003_4;
+
+     --==================================================================--
+
+separate (CA13003_0.CA13003_1)
+package body CA13003_5 is                           -- Generate report
+   procedure Generate_Report is
+   begin
+      -- In real file processing application, generate various report from the
+      -- file database.
+      TC_Report_From_Process := true;
+   end Generate_Report;
+
+end CA13003_5;
+
+     --==================================================================--
+
+separate (CA13003_0)
+package body CA13003_2 is
+
+   procedure CA13003_3 is separate;                 -- Open files
+   function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
+     return File_Name is separate;                  -- Process files
+   package body CA13003_5 is separate;              -- Generate report
+
+end CA13003_2;
+
+     --==================================================================--
+
+separate (CA13003_0.CA13003_2)
+procedure CA13003_3 is                              -- Open files
+begin
+   TC_Open_For_Audit := true;
+end CA13003_3;
+
+     --==================================================================--
+
+separate (CA13003_0.CA13003_2)
+function CA13003_4 (ID_In : File_ID; 
+                    File_In : File_Rec) return File_Name is 
+begin
+   return File_In.Name;
+end CA13003_4;
+
+     --==================================================================--
+
+separate (CA13003_0.CA13003_2)
+package body CA13003_5 is                           -- Generate report
+   procedure Generate_Report is
+   begin
+      TC_Report_From_Audit := true;
+   end Generate_Report;
+
+end CA13003_5;
+
+     --==================================================================--
+
+with CA13003_0;
+with Report;
+
+procedure CA13003 is
+   First_File_Name  : CA13003_0.File_Name := "Joe Smith ";
+   First_File_Id    : CA13003_0.File_ID   := 11;
+   Second_File_Name : CA13003_0.File_Name := "John Schep";
+   Second_File_Id   : CA13003_0.File_ID   := 47;
+   Expected_Name    : CA13003_0.File_Name := "          ";
+   Student_File     : CA13003_0.File_Rec;
+   
+   function Process_Input_Files (ID_In   : CA13003_0.File_ID; 
+                                 File_In : CA13003_0.File_Rec) return 
+     CA13003_0.File_Name renames CA13003_0.CA13003_1.CA13003_4;
+
+   function Process_Audit_Files (ID_In   : CA13003_0.File_ID; 
+                                 File_In : CA13003_0.File_Rec) return 
+     CA13003_0.File_Name renames CA13003_0.CA13003_2.CA13003_4;
+begin
+   Report.Test ("CA13003", "Check that separate subunits which share " &
+                "an ancestor may have the same name if they have " &
+                "different fully qualified names");
+
+   Student_File := (ID => First_File_Id, Name => First_File_Name);
+
+   -- Note that all subunits have the same simple name.
+   -- Generate report from file processing.
+   CA13003_0.CA13003_1.CA13003_3;
+   Expected_Name := Process_Input_Files (First_File_Id, Student_File);
+   CA13003_0.CA13003_1.CA13003_5.Generate_Report;
+
+   if not CA13003_0.TC_Open_For_Process or 
+     not CA13003_0.TC_Report_From_Process or 
+       Expected_Name /= First_File_Name then
+         Report.Failed ("Unexpected results in processing file");
+   end if;
+
+   CA13003_0.Initialize_File_Rec 
+     (Second_File_Name, Second_File_Id, Student_File);
+
+   -- Generate report from file auditing.
+   CA13003_0.CA13003_2.CA13003_3;
+   Expected_Name := Process_Audit_Files (Second_File_Id, Student_File);
+   CA13003_0.CA13003_2.CA13003_5.Generate_Report;
+
+   if not CA13003_0.TC_Open_For_Audit or 
+     not CA13003_0.TC_Report_From_Audit or 
+       Expected_Name /= Second_File_Name then
+         Report.Failed ("Unexpected results in auditing file");
+   end if;
+
+   Report.Result;
+
+end CA13003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13a01.a
new file mode 100644
index 000000000..3963bc61f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13a01.a
@@ -0,0 +1,320 @@
+-- CA13A01.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 subunits declared in non-generic child units of a public 
+--      parent have the same visibility into its parent, its siblings 
+--      (public and private), and packages on which its parent depends 
+--      as is available at the point of their declaration.
+--
+-- TEST DESCRIPTION:
+--      Declare an check system procedure as a subunit in a private child 
+--      package of the basic operation package (FA13A00.A).  This procedure 
+--      has visibility into its parent ancestor and its private sibling.
+--
+--      Declare an emergency procedure as a subunit in a public child package
+--      of the basic operation package (FA13A00.A).  This procedure has 
+--      visibility into its parent ancestor and its private sibling. 
+--
+--      Declare an express procedure as a subunit in a public child subprogram
+--      of the basic operation package (FA13A00.A).  This procedure has 
+--      visibility into its parent ancestor and its public sibling. 
+--
+--      In the main program, "with"s the child package and subprogram.  Check 
+--      that subunits perform as expected.  
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FA13A00.A
+--         CA13A01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Private child package of an elevator application.  This package
+-- provides maintenance operations.
+
+private package FA13A00_1.CA13A01_4 is    -- Maintenance operation
+
+   One_Floor : Floor_No := 1;             -- Type declared in parent.
+
+   procedure Check_System;
+
+   -- other type definitions and procedure declarations in real application.
+
+end FA13A00_1.CA13A01_4;
+
+     --==================================================================--
+
+-- Context clauses required for visibility needed by separate subunit.
+
+with FA13A00_0;                           -- Building Manager
+
+with FA13A00_1.FA13A00_2;                 -- Floor Calculation (private)
+                                         
+with FA13A00_1.FA13A00_3;                 -- Move Elevator
+
+use  FA13A00_0;                           
+
+package body FA13A00_1.CA13A01_4 is              
+
+   procedure Check_System is separate;
+
+end FA13A00_1.CA13A01_4;
+
+     --==================================================================--
+
+separate (FA13A00_1.CA13A01_4)
+
+-- Subunit Check_System declared in Maintenance Operation.
+
+procedure Check_System is
+begin
+   -- See if regular power is on.
+
+   if Power /= V120 then                  -- Reference package with'ed by
+      TC_Operation := false;              -- the subunit parent's body.
+   end if;
+
+   -- Test elevator function.
+
+   FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of
+     (Penthouse, Call_Waiting);           -- the subunit parent's body.
+
+   if not Call_Waiting (Penthouse) then   -- Reference private part of the
+      TC_Operation := false;              -- parent of the subunit package's 
+                                          -- body.
+   end if;
+
+   FA13A00_1.FA13A00_2.Down (One_Floor);  -- Reference private sibling of
+                                          -- the subunit parent's body.
+
+   if Current_Floor /= Floor'pred (Penthouse) then 
+      TC_Operation := false;              -- Reference type declared in the
+   end if;                                -- parent of the subunit parent's
+                                          -- body.
+
+end Check_System;
+
+     --==================================================================--
+
+-- Public child package of an elevator application.  This package provides
+-- an emergency operation.
+
+package FA13A00_1.CA13A01_5 is            -- Emergency Operation
+
+   -- Other type definitions in real application.
+
+   procedure Emergency;
+
+private
+   type Bell_Type is (Inactive, Active);
+
+end FA13A00_1.CA13A01_5;
+
+     --==================================================================--
+
+-- Context clauses required for visibility needed by separate subunit.
+
+with FA13A00_0;                           -- Building Manager
+
+with FA13A00_1.FA13A00_3;                 -- Move Elevator
+
+with FA13A00_1.CA13A01_4;                 -- Maintenance Operation (private)
+
+use  FA13A00_0;
+
+package body FA13A00_1.CA13A01_5 is              
+
+   procedure Emergency is separate;
+
+end FA13A00_1.CA13A01_5;
+
+     --==================================================================--
+
+separate (FA13A00_1.CA13A01_5)
+
+-- Subunit Emergency declared in Maintenance Operation.
+
+procedure Emergency is
+   Bell : Bell_Type;                      -- Reference type declared in the 
+                                          -- subunit parent's body.
+
+begin
+   -- Calls maintenance operation.
+
+   FA13A00_1.CA13A01_4.Check_System;      -- Reference private sibling of the
+                                          -- subunit parent 's body.
+
+   -- Clear all calls to the elevator.
+
+   Clear_Calls (Call_Waiting);            -- Reference subprogram declared
+                                          -- in the parent of the subunit
+                                          -- parent's body.
+   for I in Floor loop                    
+      if Call_Waiting (I) then            -- Reference private part of the
+        TC_Operation := false;            -- parent of the subunit parent's
+      end if;                             -- body.
+   end loop;
+
+   -- Move elevator to the basement.
+
+   FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of the
+     (Basement, Call_Waiting);            -- subunit parent's body.
+
+   if Current_Floor /= Basement then      -- Reference type declared in the
+      TC_Operation := false;              -- parent of the subunit parent's
+   end if;                                -- body.
+
+   -- Shut off power.
+
+   Power := Off;                          -- Reference package with'ed by
+                                          -- the subunit parent's body.
+
+   -- Activate bell.
+
+   Bell := Active;                        -- Reference type declared in the 
+                                          -- subunit parent's body. 
+
+end Emergency;
+
+     --==================================================================--
+
+-- Public child subprogram of an elevator application.  This subprogram 
+-- provides an express operation.
+
+procedure FA13A00_1.CA13A01_6;
+
+     --==================================================================--
+
+-- Context clauses required for visibility needed by separate subunit.
+
+with FA13A00_0;                           -- Building Manager
+
+with FA13A00_1.FA13A00_2;                 -- Floor Calculation (private)
+
+with FA13A00_1.FA13A00_3;                 -- Move Elevator
+
+use  FA13A00_0;
+
+procedure FA13A00_1.CA13A01_6 is          -- Express Operation
+
+   -- Other type definitions in real application.
+
+   procedure GoTo_Penthouse is separate;
+
+begin
+   GoTo_Penthouse;
+
+end FA13A00_1.CA13A01_6;
+
+     --==================================================================--
+
+separate (FA13A00_1.CA13A01_6)
+
+-- Subunit GoTo_Penthouse declared in Express Operation.
+
+procedure GoTo_Penthouse is
+begin
+   -- Go faster.
+
+   Power := V240;                         -- Reference package with'ed by
+                                          -- the subunit parent's body. 
+
+   -- Call elevator.
+
+   Call (Penthouse, Call_Waiting);        -- Reference subprogram declared in
+                                          -- the parent of the subunit 
+                                          -- parent's body.
+
+   if not Call_Waiting (Penthouse) then   -- Reference private part of the
+      TC_Operation := false;              -- parent of the subunit parent's
+   end if;                                -- body.
+
+   -- Move elevator to Penthouse.
+
+   FA13A00_1.FA13A00_3.Move_Elevator      -- Reference public sibling of the
+     (Penthouse, Call_Waiting);           -- subunit parent's body.
+
+   if Current_Floor /= Penthouse then     -- Reference type declared in the
+      TC_Operation := false;              -- parent of the subunit parent's
+   end if;                                -- body.
+
+   -- Return slowly
+
+   while Current_Floor /= Floor1 loop     -- Reference type, subprogram 
+      FA13A00_1.FA13A00_2.Down (1);       -- declared in the parent of the
+                                          -- subunit parent's body.
+   end loop;
+
+   if Current_Floor /= Floor1 then        -- Reference type declared in
+      TC_Operation := false;              -- the parent of the subunit
+   end if;                                -- parent's body.
+
+   -- Back to normal.
+                                          
+   Power := V120;                         -- Reference package with'ed by
+                                          -- the subunit parent's body.
+
+end GoTo_Penthouse;
+
+     --==================================================================--
+
+with FA13A00_1.CA13A01_5;                 -- Emergency Operation
+                                          -- implicitly with Basic Elevator
+                                          -- Operations
+
+with FA13A00_1.CA13A01_6;                 -- Express Operation
+
+with Report;
+
+procedure CA13A01 is
+
+begin
+
+   Report.Test ("CA13A01", "Check that subunits declared in non-generic " &
+                "child units of a public parent have the same visibility " &
+                "into its parent, its parent's siblings, and packages on " &
+                "which its parent depends");
+
+   -- Go to Penthouse.
+
+   FA13A00_1.CA13A01_6;
+
+   -- Call emergency operation.
+
+   FA13A00_1.CA13A01_5.Emergency;
+
+   if not FA13A00_1.TC_Operation then
+      Report.Failed ("Incorrect elevator operation");
+   end if;
+
+   Report.Result;
+
+end CA13A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13a02.a
new file mode 100644
index 000000000..82d1b6ea5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca13a02.a
@@ -0,0 +1,301 @@
+-- CA13A02.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 subunits declared in generic child units of a public 
+--      parent have the same visibility into its parent, its siblings 
+--      (public and private), and packages on which its parent depends 
+--      as is available at the point of their declaration.
+--
+-- TEST DESCRIPTION:
+--      Declare an outside elevator button operation as a subunit in a 
+--      generic child package of the basic operation package (FA13A00.A).  
+--      This procedure has visibility into its parent ancestor and its 
+--      private sibling.
+--
+--      In the main program, instantiate the child package. Check that 
+--      subunits perform as expected.  
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FA13A00.A
+--         CA13A02.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Public generic child package of an elevator application.  This package
+-- provides outside elevator button operations.
+
+generic                           -- Instantiate once for each floor.
+   Our_Floor : in Floor;          -- Reference type declared in parent.
+
+package FA13A00_1.CA13A02_4 is    -- Outside Elevator Button Operations
+
+   type Light is (Up, Down, Express, Off);
+
+   type Direction is (Up, Down, Express);
+
+   function Call_Elevator (D : Direction) return Light;
+
+   -- other type definitions and procedure declarations in real application.
+
+end FA13A00_1.CA13A02_4;
+
+     --==================================================================--
+
+-- Context clauses required for visibility needed by separate subunit.
+
+with FA13A00_0;                   -- Building Manager
+
+with FA13A00_1.FA13A00_2;         -- Floor Calculation (private)
+                                         
+with FA13A00_1.FA13A00_3;         -- Move Elevator
+
+use  FA13A00_0;                           
+
+package body FA13A00_1.CA13A02_4 is              
+
+   function Call_Elevator (D : Direction) return Light is separate;
+
+end FA13A00_1.CA13A02_4;
+
+     --==================================================================--
+
+separate (FA13A00_1.CA13A02_4)
+
+-- Subunit Call_Elevator declared in Outside Elevator Button Operations.
+
+function Call_Elevator (D : Direction) return Light is
+   Elevator_Button : Light;
+
+begin
+   -- See if power is on.
+
+   if Power = Off then                       -- Reference package with'ed by
+      Elevator_Button := Off;                -- the subunit parent's body.
+
+   else
+      case D is
+         when Express =>        
+            FA13A00_1.FA13A00_3.Move_Elevator -- Reference public sibling of
+              (Penthouse, Call_Waiting);      -- the subunit parent's body.
+
+            Elevator_Button := Express;    
+
+         when Up      =>        
+            if Current_Floor < Our_Floor then
+               FA13A00_1.FA13A00_2.Up         -- Reference private sibling of
+                 (Floor'pos (Our_Floor)       -- the subunit parent's body.
+                   - Floor'pos (Current_Floor));
+            else
+               FA13A00_1.FA13A00_2.Down       -- Reference private sibling of
+                 (Floor'pos (Current_Floor)   -- the subunit parent's body.
+                   - Floor'pos (Our_Floor));
+            end if;
+
+            -- Call elevator.
+
+            Call 
+              (Current_Floor, Call_Waiting);  -- Reference subprogram declared
+                                              -- in the parent of the subunit 
+                                              -- parent's body. 
+            Elevator_Button := Up;    
+
+         when Down    =>        
+            if Current_Floor > Our_Floor then
+               FA13A00_1.FA13A00_2.Down       -- Reference private sibling of
+                 (Floor'pos (Current_Floor)   -- the subunit parent's body.
+                   - Floor'pos (Our_Floor));
+            else
+               FA13A00_1.FA13A00_2.Up         -- Reference private sibling of
+                 (Floor'pos (Our_Floor)       -- the subunit parent's body.
+                   - Floor'pos (Current_Floor));
+            end if;
+
+            Elevator_Button := Down;    
+
+            -- Call elevator.
+
+            Call 
+              (Current_Floor, Call_Waiting);  -- Reference subprogram declared
+                                              -- in the parent of the subunit 
+                                              -- parent's body.
+      end case;
+
+      if not Call_Waiting (Current_Floor)     -- Reference private part of the
+      then                                    -- parent of the subunit parent's
+                                              -- body.
+         TC_Operation := false;              
+      end if;
+
+   end if;
+
+   return Elevator_Button;
+
+end Call_Elevator;
+
+     --==================================================================--
+
+with FA13A00_1.CA13A02_4;         -- Outside Elevator Button Operations
+                                  -- implicitly with Basic Elevator
+                                  -- Operations
+with Report;
+
+procedure CA13A02 is
+
+begin
+
+   Report.Test ("CA13A02", "Check that subunits declared in generic child " &
+                "units of a public parent have the same visibility into " & 
+                "its parent, its parent's siblings, and packages on " &
+                "which its parent depends");
+
+-- Going from floor one to penthouse.
+
+   Going_To_Penthouse:
+   declare
+      -- Declare instance of the child generic elevator package for penthouse.
+ 
+      package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
+        (FA13A00_1.Penthouse);
+
+      use Call_Elevator_Pkg;
+
+      Call_Button_Light : Light;
+
+   begin
+
+      Call_Button_Light := Call_Elevator (Express);
+
+      if not FA13A00_1.TC_Operation or Call_Button_Light /= Express then
+         Report.Failed ("Incorrect elevator operation going to penthouse");
+      end if;
+
+   end Going_To_Penthouse;
+
+-- Going from penthouse to basement.
+
+   Going_To_Basement:
+   declare
+      -- Declare instance of the child generic elevator package for basement.
+ 
+      package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
+        (FA13A00_1.Basement);
+
+      use Call_Elevator_Pkg;
+
+      Call_Button_Light : Light;
+
+   begin
+
+      Call_Button_Light := Call_Elevator (Down);
+
+      if not FA13A00_1.TC_Operation or Call_Button_Light /= Down then
+         Report.Failed ("Incorrect elevator operation going to basement");
+      end if;
+
+   end Going_To_Basement;
+  
+-- Going from basement to floor three.
+
+   Going_To_Floor3:
+   declare
+      -- Declare instance of the child generic elevator package for floor 
+      -- three.
+ 
+      package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
+        (FA13A00_1.Floor3);
+
+      use Call_Elevator_Pkg;
+
+      Call_Button_Light : Light;
+
+   begin
+
+      Call_Button_Light := Call_Elevator (Up);
+
+      if not FA13A00_1.TC_Operation or Call_Button_Light /= Up then
+         Report.Failed ("Incorrect elevator operation going to floor 3");
+      end if;
+
+   end Going_To_Floor3;
+  
+-- Going from floor three to floor two.
+
+   Going_To_Floor2:
+   declare
+      -- Declare instance of the child generic elevator package for floor two.
+ 
+      package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
+        (FA13A00_1.Floor2);
+
+      use Call_Elevator_Pkg;
+
+      Call_Button_Light : Light;
+
+   begin
+
+      Call_Button_Light := Call_Elevator (Up);
+
+      if not FA13A00_1.TC_Operation or Call_Button_Light /= Up then
+         Report.Failed ("Incorrect elevator operation going to floor 2");
+      end if;
+
+   end Going_To_Floor2;
+  
+-- Going to floor one.
+
+   Going_To_Floor1:
+   declare
+      -- Declare instance of the child generic elevator package for floor one.
+ 
+      package Call_Elevator_Pkg is new FA13A00_1.CA13A02_4 
+        (FA13A00_1.Floor1);
+
+      use Call_Elevator_Pkg;
+
+      Call_Button_Light : Light;
+
+   begin
+      -- Calling elevator from floor one.
+
+      FA13A00_1.Current_Floor := FA13A00_1.Floor1;
+
+      Call_Button_Light := Call_Elevator (Down);
+
+      if not FA13A00_1.TC_Operation or Call_Button_Light /= Down then
+         Report.Failed ("Incorrect elevator operation going to floor 1");
+      end if;
+
+   end Going_To_Floor1;
+
+   Report.Result;
+
+end CA13A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140230.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140230.a
new file mode 100644
index 000000000..95b72b1ab
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140230.a
@@ -0,0 +1,62 @@
+-- CA140230.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:
+--      See CA140232.AM.
+--
+-- TEST DESCRIPTION:
+--      See CA140232.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> CA140230.A
+--         CA140231.A
+--         CA140232.AM
+--         CA140233.A
+--
+-- PASS/FAIL CRITERIA:
+--      See CA140232.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--     13 SEP 99   RLB         Changed to C-test (by AI-00077).
+--     20 MAR 00   RLB         Removed special requirements, because there
+--                             aren't any.
+--
+--!
+
+package CA14023_0 is
+     subtype Little_float is float digits 4 range 0.0..100.0;
+     type Data_rec is tagged record
+          Data : Little_float;
+     end record;
+end CA14023_0;
+
+--------------------------------------------------------
+
+generic
+     type Data_type is digits <>;
+     Floor : Data_type;
+function CA14023_1 (P1, P2 : Data_type) return Data_type;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140231.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140231.a
new file mode 100644
index 000000000..32504b590
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140231.a
@@ -0,0 +1,59 @@
+-- CA140231.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:
+--      See CA140232.AM.
+--
+-- TEST DESCRIPTION:
+--      See CA140232.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         CA140230.A
+--      -> CA140231.A
+--         CA140232.AM
+--         CA140233.A
+--
+-- PASS/FAIL CRITERIA:
+--      See CA140232.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--     13 SEP 99   RLB         Changed to C-test (by AI-00077).
+--     20 MAR 00   RLB         Removed special requirements, because there
+--                             aren't any.
+--
+--!
+
+function CA14023_1 (P1, P2 : Data_type) return Data_type is
+begin
+     if Floor > P1 and Floor > P2 then
+          return Floor;
+     elsif P2 > P1 then
+          return P2;
+     else
+          return P1;
+     end if;
+end CA14023_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140232.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140232.am
new file mode 100644
index 000000000..d9ffba28f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140232.am
@@ -0,0 +1,139 @@
+-- CA140232.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a generic instantiation depends on
+--      a generic function that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a generic function, a generic
+--      instantiation of the generic function, and a main
+--      procedure that withs the instantiated generic
+--      function.  Then, a new version of the first generic
+--      function is compiled (in a separate file, simulating
+--      editing and modification to the unit).  The test should
+--      link the correct version of the withed function and
+--      report "PASSED" at execution time.
+--
+--      Note that compilers are required by the standard to support
+--      replacement of a generic body without recompilation of the
+--      instantation. The ARG confirmed 10.1.4(10) with AI-00077.
+--
+--      To build this test:
+--         1) Compile the file CA140230 (and include the results in the
+--            program library).
+--         2) Compile the file CA140231 (and include the results in the
+--            program library).
+--         3) Compile the file CA140232 (and include the results in the
+--            program library).
+--         4) Compile the file CA140233 (and include the results in the
+--            program library).
+--         5) Build and run an executable image.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         CA140230.A
+--         CA140231.A
+--      -> CA140232.AM
+--         CA140233.A
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008T baseline version
+--     29 JUN 95   SAIC        Initial version
+--     05 MAR 96   SAIC        First revision after review
+--     18 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Moved CA14023_1 to a separate file.
+--     13 SEP 99   RLB         Changed to C-test (by AI-00077).
+--     20 MAR 00   RLB         Removed special requirements, because there
+--                             aren't any.
+--
+--!
+
+with CA14023_0;
+use CA14023_0;
+
+generic
+     Min : Little_float := 0.0;
+     type Any_rec is new Data_rec with private;
+function CA14023_2 (R1, R2 : Any_rec) return Little_float;
+
+--------------------------------------------------------
+
+with CA14023_1;
+
+function CA14023_2 (R1, R2 : Any_rec) return Little_float is
+     function Max_val is new CA14023_1 (Little_float, Min);
+begin
+     return max_val (R1.Data, R2.Data);
+end CA14023_2;
+
+--------------------------------------------------------
+
+package CA14023_0.CA14023_3 is
+     type New_data_rec is new Data_rec with record
+          Other_val : integer := 100;
+     end record;
+end CA14023_0.CA14023_3;
+
+--------------------------------------------------------
+
+with Report; use Report;
+with CA14023_2;
+with CA14023_0;
+with CA14023_0.CA14023_3;
+
+procedure CA140232 is
+
+     NDR1, NDR2 : CA14023_0.CA14023_3.New_data_rec;
+     Min_value : constant CA14023_0.Little_float := 0.0;
+     TC_result : CA14023_0.Little_float;
+     function Max_Data_Val is new CA14023_2 (Min_value,
+                    CA14023_0.CA14023_3.New_data_rec);
+begin
+     Test ("CA14023", "Check that a compilation unit may not " &
+                      "depend semantically on two different " &
+                      "versions of the same compilation unit.  " &
+                      "Check the case where a generic " &
+                      "instantiation depends on a generic " &
+                      "function that is changed");
+
+     NDR1.Data := 2.0;
+     NDR2.Data := 5.0;
+
+     TC_result := Max_Data_Val (NDR1, NDR2);
+
+     if TC_result = 5.0 then
+          Failed ("Revised generic not used");
+     elsif TC_result /= 0.0 then               -- the minimum, floor
+          Failed ("Incorrect value returned"); -- value of 0.0 should
+     end if;                                   -- be returned rather
+                                               -- than the min of the
+                                               -- two actual parameters
+
+     Result;
+end CA140232;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140233.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140233.a
new file mode 100644
index 000000000..a5334379d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140233.a
@@ -0,0 +1,68 @@
+-- CA140233.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:
+--      See CA140232.AM.
+--
+-- TEST DESCRIPTION:
+--      See CA140232.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         CA140230.A
+--         CA140231.A
+--         CA140232.AM
+--      -> CA140233.A
+--
+-- PASS/FAIL CRITERIA:
+--      See CA140232.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008T baseline version
+--     29 JUN 95   SAIC        Initial version
+--     05 MAR 96   SAIC        First revision after review
+--     18 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Modified prologue to reflect new test
+--                             file organization.
+--     13 SEP 99   RLB         Changed to C-test (by AI-00077).
+--     20 MAR 00   RLB         Removed special requirements, because there
+--                             aren't any.
+--!
+
+-- here is the replacement body, correcting "errors" in
+-- the original
+
+function CA14023_1 (P1, P2 : Data_type) return Data_type is
+begin
+     -- return min rather than max
+     if Floor < P1 and Floor < P2 then
+          return Floor;
+     elsif P2 < P1 then
+          return P2;
+     else
+          return P1;
+     end if;
+end CA14023_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140280.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140280.a
new file mode 100644
index 000000000..1ffe3cbbf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140280.a
@@ -0,0 +1,77 @@
+-- CA140280.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:
+--     See CA140283.AM.
+--
+-- TEST DESCRIPTION
+--     See CA140283.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> CA140280.A
+--         CA140281.A
+--         CA140282.A
+--         CA140283.AM
+--
+-- CHANGE HISTORY:
+--     JBG 05/28/85  CREATED ORGINAL TEST.
+--     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
+--                   NOT THE SAME.
+--     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
+
+GENERIC
+     C : INTEGER;
+PROCEDURE GENPROC_CA14028 (X : OUT INTEGER);
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PROCEDURE GENPROC_CA14028 (X : OUT INTEGER) IS
+BEGIN
+     X := IDENT_INT(C);
+END GENPROC_CA14028;
+
+GENERIC
+FUNCTION GENFUNC_CA14028 RETURN INTEGER;
+
+FUNCTION GENFUNC_CA14028 RETURN INTEGER IS
+BEGIN
+     RETURN 2;
+END GENFUNC_CA14028;
+
+WITH GENPROC_CA14028;
+PRAGMA ELABORATE (GENPROC_CA14028);
+PROCEDURE CA14028_PROC1 IS NEW GENPROC_CA14028(1);
+
+WITH GENFUNC_CA14028;
+PRAGMA ELABORATE (GENFUNC_CA14028);
+FUNCTION CA14028_FUNC2 IS NEW GENFUNC_CA14028;
+
+WITH GENPROC_CA14028;
+PRAGMA ELABORATE (GENPROC_CA14028);
+PROCEDURE CA14028_PROC3 IS NEW GENPROC_CA14028(3);
+
+WITH GENFUNC_CA14028;
+PRAGMA ELABORATE (GENFUNC_CA14028);
+FUNCTION CA14028_FUNC3 IS NEW GENFUNC_CA14028;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140281.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140281.a
new file mode 100644
index 000000000..57360c9eb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140281.a
@@ -0,0 +1,67 @@
+-- CA140281.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:
+--     See CA140283.AM.
+--
+-- TEST DESCRIPTION
+--     See CA140283.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         CA140280.A
+--      -> CA140281.A
+--         CA140282.A
+--         CA140283.AM
+--
+-- CHANGE HISTORY:
+--     JBG 05/28/85  CREATED ORGINAL TEST.
+--     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
+--                   NOT THE SAME.
+--     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
+
+PROCEDURE CA14028_PROC1 (X : OUT INTEGER) IS
+BEGIN
+     X := 3;
+END CA14028_PROC1;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+FUNCTION CA14028_FUNC2 RETURN INTEGER IS
+BEGIN
+     RETURN IDENT_INT(4);
+END CA14028_FUNC2;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PROCEDURE CA14028_PROC3 (X : OUT BOOLEAN; Y : OUT INTEGER) IS
+BEGIN
+     X := FALSE;
+     Y := IDENT_INT(6);
+END CA14028_PROC3;
+
+FUNCTION CA14028_FUNC3 RETURN BOOLEAN IS
+BEGIN
+     RETURN FALSE;
+END CA14028_FUNC3;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140282.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140282.a
new file mode 100644
index 000000000..437f01889
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140282.a
@@ -0,0 +1,64 @@
+-- CA140282.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:
+--     See CA140283.AM.
+--
+-- TEST DESCRIPTION
+--     See CA140283.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         CA140280.A
+--         CA140281.A
+--      -> CA140282.A
+--         CA140283.AM
+--
+-- CHANGE HISTORY:
+--     JBG 05/28/85  CREATED ORIGINAL TEST.
+--     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
+--                   NOT THE SAME.
+--     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
+
+WITH GENPROC_CA14028;
+PRAGMA ELABORATE (GENPROC_CA14028);
+PROCEDURE CA14028_PROC5 IS NEW GENPROC_CA14028 (5);
+
+WITH GENFUNC_CA14028;
+PRAGMA ELABORATE (GENFUNC_CA14028);
+FUNCTION CA14028_FUNC22 IS NEW GENFUNC_CA14028;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PROCEDURE CA14028_PROC3 (X : OUT INTEGER) IS
+BEGIN
+     X := IDENT_INT(4);
+END CA14028_PROC3;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+FUNCTION CA14028_FUNC3 RETURN INTEGER IS
+BEGIN
+     RETURN IDENT_INT(7);
+END CA14028_FUNC3;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140283.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140283.am
new file mode 100644
index 000000000..9a74b8d70
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca140283.am
@@ -0,0 +1,91 @@
+-- CA140283.AM
+--
+--                             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 subprogram body is compiled as a library unit
+--     it is not interpreted as a completion for any previous library
+--     subprogram created by generic instantiation, and it therefore
+--     declares a new library subprogram.
+--
+-- TEST DESCRIPTION
+--     A generic function and procedure plus their instantiations are
+--     created. Then, subprogram bodies which ought to replace the
+--     instantiations are compiled. Following that, additional instantiations
+--     are compiled. Finally the main subprogram is compiled.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         CA140280.A
+--         CA140281.A
+--         CA140282.A
+--      -> CA140283.AM
+--
+-- CHANGE HISTORY:
+--     JBG 05/28/85  CREATED ORIGINAL TEST.
+--     RDH 04/18/90  ADDED CASES WHERE SUBPROGRAM PARAMETER TYPES ARE
+--                   NOT THE SAME.
+--     THS 09/24/90  REWORDED HEADER COMMENTS, ERROR MESSAGES, AND
+--                   CALL TO TEST. CALLED IDENT_INT CONSISTENTLY.
+--     RLB 07/08/99  Reinstated withdrawn test; revised to Ada 95 format.
+
+WITH REPORT; USE REPORT;
+WITH CA14028_PROC1, CA14028_FUNC2, CA14028_PROC5, CA14028_FUNC22,
+     CA14028_PROC3, CA14028_FUNC3;
+PROCEDURE CA140283 IS
+     TEMP : INTEGER := 0;
+BEGIN
+     TEST ("CA14028", "Check that library subprograms created by " &
+                      "generic instantiation are replaced " &
+                      "when new non-generic subprogram bodies are " &
+                      "compiled");
+
+     CA14028_PROC1(TEMP);
+     IF TEMP /= IDENT_INT(3) THEN
+          FAILED ("CA14028_Proc1 instantiation not replaced");
+     END IF;
+
+     IF CA14028_FUNC2 /= IDENT_INT(4) THEN
+          FAILED ("CA14028_Func2 instantiation not replaced");
+     END IF;
+
+     CA14028_PROC5(TEMP);
+     IF TEMP /= IDENT_INT(5) THEN
+          FAILED ("New CA14028_Proc5 instantiation not correct");
+     END IF;
+
+     IF CA14028_FUNC22 /= IDENT_INT(2) THEN
+          FAILED ("New CA14028_Func22 instantiation not correct");
+     END IF;
+
+     CA14028_PROC3(TEMP);
+     IF TEMP /= IDENT_INT(4) THEN
+          FAILED ("CA14028_Proc3 not replaced by correct version");
+     END IF;
+
+     IF CA14028_FUNC3 /= IDENT_INT(7) THEN
+          FAILED ("CA14028_Func3 not replaced by correct version");
+     END IF;
+
+     RESULT;
+END CA140283;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca15003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca15003.a
new file mode 100644
index 000000000..08fe1516d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca15003.a
@@ -0,0 +1,161 @@
+-- CA15003.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 the requirements of 10.1.5(4) and the modified 10.1.5(5)
+--     from Technical Corrigendum 1. (Originally discussed as AI95-00136.)
+--     Specifically:
+--     Check that program unit pragma for a generic package are accepted
+--     when given at the beginning of the package specification.
+--     Check that a program unit pragma can be given for a generic
+--     instantiation by placing the pragma immediately after the instantation.
+--
+-- TEST DESCRIPTION
+--     This test checks the cases that are *not* forbidden by the RM,
+--     and makes sure such legal cases actually work.
+--
+-- CHANGE HISTORY:
+--      29 JUN 1999   RAD   Initial Version
+--      08 JUL 1999   RLB   Cleaned up and added to test suite.
+--      27 AUG 1999   RLB   Repaired errors introduced by me.
+--
+--!
+
+with System;
+package CA15003A is
+    pragma Pure;
+
+    type Big_Int is range -System.Max_Int .. System.Max_Int;
+    type Big_Positive is new Big_Int range 1..Big_Int'Last;
+end CA15003A;
+
+generic
+    type Int is new Big_Int;
+package CA15003A.Pure is
+    pragma Pure;
+    function F(X: access Int) return Int;
+end CA15003A.Pure;
+
+with CA15003A.Pure;
+package CA15003A.Pure_Instance is new CA15003A.Pure(Int => Big_Positive);
+    pragma Pure(CA15003A.Pure_Instance);
+
+package body CA15003A.Pure is
+    function F(X: access Int) return Int is
+    begin
+        X.all := X.all + 1;
+        return X.all;
+    end F;
+end CA15003A.Pure;
+
+generic
+package CA15003A.Pure.Preelaborate is
+    pragma Preelaborate;
+    One: Int := 1;
+    function F(X: access Int) return Int;
+end CA15003A.Pure.Preelaborate;
+
+package body CA15003A.Pure.Preelaborate is
+    function F(X: access Int) return Int is
+    begin
+        X.all := X.all + One;
+        return X.all;
+    end F;
+end CA15003A.Pure.Preelaborate;
+
+with CA15003A.Pure_Instance;
+with CA15003A.Pure.Preelaborate;
+package CA15003A.Pure_Preelaborate_Instance is
+    new CA15003A.Pure_Instance.Preelaborate;
+        pragma Preelaborate(CA15003A.Pure_Preelaborate_Instance);
+
+package CA15003A.Empty_Pure is
+    pragma Pure;
+    pragma Elaborate_Body;
+end CA15003A.Empty_Pure;
+
+package body CA15003A.Empty_Pure is
+end CA15003A.Empty_Pure;
+
+package CA15003A.Empty_Preelaborate is
+    pragma Preelaborate;
+    pragma Elaborate_Body;
+    One: Big_Int := 1;
+end CA15003A.Empty_Preelaborate;
+
+package body CA15003A.Empty_Preelaborate is
+    function F(X: access Big_Int) return Big_Int is
+    begin
+        X.all := X.all + One;
+        return X.all;
+    end F;
+end CA15003A.Empty_Preelaborate;
+
+package CA15003A.Empty_Elaborate_Body is
+    pragma Elaborate_Body;
+    Three: aliased Big_Positive := 1;
+    Two, Tres: Big_Positive'Base := 0;
+end CA15003A.Empty_Elaborate_Body;
+
+with Report; use Report; pragma Elaborate_All(Report);
+with CA15003A.Pure_Instance;
+with CA15003A.Pure_Preelaborate_Instance;
+use CA15003A;
+package body CA15003A.Empty_Elaborate_Body is
+begin
+    if Two /= Big_Positive'Base(Ident_Int(0)) then
+	Failed ("Two should be zero now");
+    end if;
+    if Tres /= Big_Positive'Base(Ident_Int(0)) then
+	Failed ("Tres should be zero now");
+    end if;
+    if Two /= Tres then
+	Failed ("Tres should be zero now");
+    end if;
+    Two := Pure_Instance.F(Three'Access);
+    Tres := Pure_Preelaborate_Instance.F(Three'Access);
+    if Two /= Big_Positive(Ident_Int(2)) then
+	Failed ("Two should be 2 now");
+    end if;
+    if Tres /= Big_Positive(Ident_Int(3)) then
+	Failed ("Tres should be 3 now");
+    end if;
+end CA15003A.Empty_Elaborate_Body;
+
+with Report; use Report;
+with CA15003A.Empty_Pure;
+with CA15003A.Empty_Preelaborate;
+with CA15003A.Empty_Elaborate_Body; use CA15003A.Empty_Elaborate_Body;
+use type CA15003A.Big_Positive'Base;
+procedure CA15003 is
+begin
+    Test("CA15003", "Placement of Program Unit Pragmas in Generic Packages");
+    if Two /= 2 then
+	Failed ("Two should be 2 now");
+    end if;
+    if Tres /= 3 then
+	Failed ("Tres should be 3 now");
+    end if;
+    Result;
+end CA15003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca200020.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca200020.a
new file mode 100644
index 000000000..c9508f4cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca200020.a
@@ -0,0 +1,70 @@
+-- CA200020.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER 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 partition can be created even if the environment contains
+--      two units with the same name. (This is rule 10.2(19)).
+--
+-- TEST DESCRIPTION:
+--      Declare the a parent package (CA20002_0). Declare a child package
+--      (CA20002_0.CA20002_1). Declare a subunit in the parent package body
+--      (CA20002_1). Declare a main subprogram that does NOT include the
+--      child package. Insure that this partition can be created.
+--
+--      This test is intended to test the effects of program maintenance.
+--      After the programmer receives an error from creating a partition
+--      like that tested in test LA20001, the programmer may then repair
+--      the partition by eliminating the reference of the child unit. The
+--      partition should be able to be created.
+--
+--      To build this test:
+--         1) Compile the file CA200020 (and include the results in the
+--            program library).
+--         2) Compile the file CA200021 (and include the results in the
+--            program library).
+--         3) Compile the file CA200022 (and include the results in the
+--            program library).
+--         4) Build an executable image, and run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> CA200020.A
+--         CA200021.A
+--         CA200022.AM
+--
+-- CHANGE HISTORY:
+--      27 Jan 99   RLB     Initial test.
+--      20 Mar 00   RLB     Removed special requirements, because there
+--                          aren't any.
+--!
+
+package CA20002_0 is
+   procedure Do_a_Little (A : out Integer);
+
+end CA20002_0;
+
+package CA20002_0.CA20002_1 is
+   My_Global : Integer;
+end CA20002_0.CA20002_1;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca200021.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca200021.a
new file mode 100644
index 000000000..0c5de3825
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca200021.a
@@ -0,0 +1,66 @@
+-- CA200021.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER 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:
+--      See CA200020.A.
+--
+-- TEST DESCRIPTION:
+--      See CA200020.A.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         CA200020.A
+--      -> CA200021.A
+--         CA200022.AM
+--
+-- PASS/FAIL CRITERIA:
+--      See CA200020.A.
+--
+-- CHANGE HISTORY:
+--     27 JAN 99   RLB       Initial version.
+--     20 MAR 00   RLB       Removed special requirements, because there
+--                           aren't any.
+--
+--!
+
+package body CA20002_0 is
+
+   function CA20002_1 return Integer is separate; -- Has the same expanded name
+                                                  -- as the child.
+      -- Note: An implementation may produce a warning about the child
+      -- unit at this point, but it must accept the subunit declaration.
+
+   procedure Do_a_Little (A : out Integer) is
+   begin
+      A := CA20002_1;
+   end Do_a_Little;
+
+end CA20002_0;
+
+with Report;
+separate (CA20002_0)
+function CA20002_1 return Integer is
+begin
+   return Report.Ident_Int(5);
+end CA20002_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca200022.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca200022.am
new file mode 100644
index 000000000..1e9b773e0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca200022.am
@@ -0,0 +1,64 @@
+-- CA200022.AM
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER 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:
+--      See CA200020.A.
+--
+-- TEST DESCRIPTION:
+--      See CA200020.A.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         CA200020.A
+--         CA200021.A
+--      -> CA200022.AM
+--
+-- PASS/FAIL CRITERIA:
+--      See CA200020.A.
+--
+-- CHANGE HISTORY:
+--     25 JAN 99   RLB       Initial version.
+--     08 JUL 99   RLB       Repaired comments.
+--     20 MAR 00   RLB       Removed special requirements, because there
+--                           aren't any.
+--!
+
+with Report;
+use Report;
+with CA20002_0; -- Child unit not included in the partition.
+procedure CA200022 is
+     Value : Integer := 0;
+begin
+     Test ("CA20002","Check that compiling multiple units with the same " &
+                     "name does not prevent the creation of a partition " &
+                     "using only one of the units.");
+     CA20002_0.Do_a_Little (Value);
+     if Report.Equal (Value, 5) then
+        null; -- OK.
+     else
+        Failed ("Wrong result from subunit");
+     end if;
+
+     Result;
+end CA200022;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h0.ada
new file mode 100644
index 000000000..f40744fbd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h0.ada
@@ -0,0 +1,40 @@
+-- CA2001H0.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.
+--*
+-- WKB 6/25/81
+-- JBG 8/25/83
+
+FUNCTION CA2001H0 RETURN INTEGER IS
+
+     PACKAGE CA2001H1 IS
+          I : INTEGER := 0;
+     END CA2001H1;
+
+     PACKAGE BODY CA2001H1 IS SEPARATE;
+
+BEGIN
+     
+     RETURN CA2001H1.I;
+
+END CA2001H0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h1.ada
new file mode 100644
index 000000000..db0797d72
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h1.ada
@@ -0,0 +1,39 @@
+-- CA2001H1.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.
+--*
+-- WKB 6/25/81
+-- JBG 8/25/83
+-- BHS 7/31/84
+
+SEPARATE (CA2001H0)
+
+PACKAGE BODY CA2001H1 IS
+     PROCEDURE NOT_USED IS SEPARATE;
+
+BEGIN
+
+     I := 1;
+     NOT_USED;
+
+END CA2001H1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h2.ada
new file mode 100644
index 000000000..c6f672b15
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h2.ada
@@ -0,0 +1,38 @@
+-- CA2001H2.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.
+--*
+-- WKB 6/25/81
+-- JBG 8/25/83
+
+FUNCTION CA2001H0 RETURN INTEGER IS
+
+     PACKAGE CA2001H1 IS
+          I : INTEGER := 2;
+     END CA2001H1;
+
+BEGIN
+
+     RETURN CA2001H1.I;
+
+END CA2001H0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h3.ada
new file mode 100644
index 000000000..9da25eea1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2001h3.ada
@@ -0,0 +1,66 @@
+-- CA2001H3M.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 BODY_STUB IS DELETED FROM A COMPILATION UNIT,
+--   THE PREVIOUSLY EXISTING SUBUNIT CAN NO LONGER BE ACCESSED.
+
+-- SEPARATE FILES ARE;
+--   CA2001H0  A LIBRARY FUNCTION (CA2001H0).
+--   CA2001H1  A SUBUNIT PACKAGE BODY.
+--   CA2001H2  A LIBRARY FUNCTION (CA2001H0).
+--   CA2001H3M THE MAIN PROCEDURE.
+
+-- WKB 6/25/81
+-- JRK 6/26/81
+-- SPS 11/2/82
+-- JBG 8/25/83
+
+
+WITH REPORT, CA2001H0;
+USE REPORT;
+PROCEDURE CA2001H3M IS
+
+     I : INTEGER := -1;
+
+BEGIN
+     TEST ("CA2001H", "IF A BODY_STUB IS DELETED FROM A COMPILATION " &
+                      "UNIT, THE PREVIOUSLY EXISTING SUBUNIT CAN NO " &
+                      "LONGER BE ACCESSED");
+
+     I := CA2001H0;
+
+     IF I = 1 THEN
+          FAILED ("SUBUNIT ACCESSED");
+     END IF;
+
+     IF I = 0 THEN
+          FAILED ("OLD LIBRARY UNIT ACCESSED");
+     END IF;
+
+     IF I /= 2 THEN
+          FAILED ("NEW LIBRARY UNIT NOT ACCESSED");
+     END IF;
+
+     RESULT;
+END CA2001H3M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2002a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2002a0.ada
new file mode 100644
index 000000000..f48f58bd3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2002a0.ada
@@ -0,0 +1,139 @@
+-- CA2002A0M.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 SUBUNITS HAVING DIFFERENT ANCESTOR LIBRARY UNITS CAN HAVE
+-- THE SAME NAME.
+
+-- SEPARATE FILES ARE:
+--     CA2002A0M  THE MAIN PROCEDURE, WITH SEPARATE LIBRARY 
+--                     PACKAGES (CA2002A1) AND (CA2002A2).
+--     CA2002A1   SUBUNIT BODIES FOR STUBS IN PACKAGE CA2002A1.
+--     CA2002A2   SUBUNIT BODIES FOR STUBS IN PACKAGE CA2002A2.
+
+-- BHS 8/02/84
+
+PACKAGE CA2002A1 IS
+
+     PROCEDURE PROC (X : OUT INTEGER);
+     FUNCTION FUN RETURN BOOLEAN;
+
+     PACKAGE PKG IS
+          I : INTEGER;
+          PROCEDURE PKG_PROC (XX : IN OUT INTEGER);
+     END PKG;
+
+END CA2002A1;
+
+PACKAGE BODY CA2002A1 IS
+
+     PROCEDURE PROC (X : OUT INTEGER) IS SEPARATE;
+     FUNCTION FUN RETURN BOOLEAN IS SEPARATE;
+     PACKAGE BODY PKG IS SEPARATE;
+
+END CA2002A1;
+
+
+PACKAGE CA2002A2 IS
+
+     PROCEDURE PROC (Y : OUT INTEGER);
+     FUNCTION FUN (Z : INTEGER := 3) RETURN BOOLEAN;
+
+     PACKAGE PKG IS
+          I : INTEGER;
+          PROCEDURE PKG_PROC (YY : IN OUT INTEGER);
+     END PKG;
+
+END CA2002A2;
+
+PACKAGE BODY CA2002A2 IS
+
+     PROCEDURE PROC (Y : OUT INTEGER) IS SEPARATE;
+     FUNCTION FUN (Z : INTEGER := 3) RETURN BOOLEAN IS SEPARATE;
+     PACKAGE BODY PKG IS SEPARATE;
+
+END CA2002A2;
+
+WITH CA2002A1, CA2002A2;
+WITH REPORT; USE REPORT;
+PROCEDURE CA2002A0M IS
+BEGIN
+
+     TEST ("CA2002A", "SUBUNITS WITH DIFFERENT ANCESTORS " &
+                      "CAN HAVE THE SAME NAME");
+
+     DECLARE
+          VAR1 : INTEGER;
+          USE CA2002A1;
+     BEGIN
+
+          PROC (VAR1);
+          IF VAR1 /= 1 THEN 
+               FAILED ("CA2002A1 PROCEDURE NOT INVOKED CORRECTLY");
+          END IF;
+
+          IF NOT FUN THEN
+               FAILED ("CA2002A1 FUNCTION NOT INVOKED CORRECTLY");
+          END IF;
+
+          IF PKG.I /= 1 THEN
+               FAILED ("CA2202A1 PKG VARIABLE NOT ACCESSED CORRECTLY");
+          END IF;
+
+          VAR1 := 5;
+          PKG.PKG_PROC (VAR1);
+          IF VAR1 /= 4 THEN
+               FAILED ("CA2002A1 PKG SUBUNIT NOT INVOKED CORRECTLY");
+          END IF;
+
+     END;
+
+     DECLARE
+          VAR2 : INTEGER;
+          USE CA2002A2;
+     BEGIN
+
+          PROC (VAR2);
+          IF VAR2 /= 2 THEN
+               FAILED ("CA2002A2 PROCEDURE NOT INVOKED CORRECTLY");
+          END IF;
+
+          IF FUN THEN
+               FAILED ("CA2002A2 FUNCTION NOT INVOKED CORRECTLY");
+          END IF;
+
+          IF PKG.I /= 2 THEN
+               FAILED ("CA2002A2 PKG VARIABLE NOT ACCESSED CORRECTLY");
+          END IF;
+
+          VAR2 := 3;
+          PKG.PKG_PROC (VAR2);
+          IF VAR2 /= 4 THEN
+               FAILED ("CA2002A2 PKG SUBUNIT NOT INVOKED CORRECTLY");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END CA2002A0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2002a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2002a1.ada
new file mode 100644
index 000000000..064ec4d0f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2002a1.ada
@@ -0,0 +1,53 @@
+-- CA2002A1.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.
+--*
+-- SUBUNIT BODIES FOR STUBS GIVEN IN PACKAGE CA2002A1 IN FILE
+-- CA2002A0M. 
+
+-- BHS 8/02/84
+
+SEPARATE (CA2002A1)
+PROCEDURE PROC (X : OUT INTEGER) IS
+BEGIN
+     X := 1;
+END PROC;
+
+SEPARATE (CA2002A1)
+FUNCTION FUN RETURN BOOLEAN IS
+BEGIN
+     RETURN TRUE;
+END FUN;
+
+SEPARATE (CA2002A1)
+PACKAGE BODY PKG IS
+     PROCEDURE PKG_PROC (XX : IN OUT INTEGER) IS SEPARATE;
+BEGIN
+     I := 1;
+END PKG;
+
+SEPARATE (CA2002A1.PKG)
+PROCEDURE PKG_PROC (XX : IN OUT INTEGER) IS
+BEGIN
+     XX := XX - 1;
+END PKG_PROC;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2002a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2002a2.ada
new file mode 100644
index 000000000..6a1bc584c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2002a2.ada
@@ -0,0 +1,53 @@
+-- CA2002A2.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.
+--*
+-- SUBUNIT BODIES FOR STUBS GIVEN IN PACKAGE CA2002A2 IN FILE
+-- CA2002A0M. 
+
+-- BHS 8/02/84
+
+SEPARATE (CA2002A2)
+PROCEDURE PROC (Y : OUT INTEGER) IS
+BEGIN
+     Y := 2;
+END PROC;
+
+SEPARATE (CA2002A2)
+FUNCTION FUN (Z : INTEGER := 3) RETURN BOOLEAN IS
+BEGIN
+     RETURN Z /= 3;
+END FUN;
+
+SEPARATE (CA2002A2)
+PACKAGE BODY PKG IS
+     PROCEDURE PKG_PROC (YY : IN OUT INTEGER) IS SEPARATE;
+BEGIN
+     I := 2;
+END PKG;
+
+SEPARATE (CA2002A2.PKG)
+PROCEDURE PKG_PROC (YY : IN OUT INTEGER) IS
+BEGIN
+     YY := YY + 1;
+END PKG_PROC;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2003a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2003a0.ada
new file mode 100644
index 000000000..d6e47b46c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2003a0.ada
@@ -0,0 +1,55 @@
+-- CA2003A0M.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 SUBUNIT HAS VISIBILITY OF IDENTIFIERS DECLARED
+--   PRIOR TO ITS BODY_STUB.
+
+-- SEPARATE FILES ARE:
+--   CA2003A0M THE MAIN PROCEDURE.
+--   CA2003A1  A SUBUNIT PROCEDURE BODY.
+
+-- WKB 6/26/81
+-- JRK 6/26/81
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE CA2003A0M IS
+
+     I : INTEGER := 1;
+
+     PROCEDURE CA2003A1 IS SEPARATE;
+
+     PACKAGE P IS
+          I : INTEGER := 2;
+     END P;
+
+BEGIN
+     TEST ("CA2003A", "A SUBUNIT HAS VISIBILITY OF IDENTIFIERS " &
+                      "DECLARED BEFORE ITS BODY_STUB");
+
+
+     CA2003A1;
+
+     RESULT;
+END CA2003A0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2003a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2003a1.ada
new file mode 100644
index 000000000..ec09f13c8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2003a1.ada
@@ -0,0 +1,35 @@
+-- CA2003A1.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.
+--*
+-- WKB 6/26/81
+
+SEPARATE (CA2003A0M)
+PROCEDURE CA2003A1 IS
+BEGIN
+
+     IF I /= 1 THEN
+          FAILED ("IDENTIFIER IN PARENT NOT VISIBLE");
+     END IF;
+
+END CA2003A1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a0.ada
new file mode 100644
index 000000000..4eae5e241
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a0.ada
@@ -0,0 +1,65 @@
+-- CA2004A0M.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 SUBUNIT HAS VISIBILITY OF IDENTIFIERS DECLARED
+--   IN ANCESTORS OTHER THAN THE PARENT.
+
+-- SEPARATE FILES ARE:
+--   CA2004A0M THE MAIN PROCEDURE.
+--   CA2004A1  A SUBUNIT PACKAGE BODY.
+--   CA2004A2  A SUBUNIT PROCEDURE BODY.
+--   CA2004A3  A SUBUNIT PROCEDURE BODY.
+--   CA2004A4  A SUBUNIT PROCEDURE BODY.
+
+-- WKB 6/26/81
+-- JRK 6/26/81
+-- BHS 7/31/84
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE CA2004A0M IS
+
+     I : INTEGER := 1;
+
+     PACKAGE CA2004A1 IS
+          J : INTEGER := 2;
+          PROCEDURE CA2004A2;
+     END CA2004A1;
+
+     USE CA2004A1;
+     PACKAGE BODY CA2004A1 IS SEPARATE;
+     PROCEDURE CA2004A3 IS SEPARATE;
+
+BEGIN
+     TEST ("CA2004A", "CHECK THAT A SUBUNIT HAS VISIBILITY OF " &
+                      "IDENTIFIERS DECLARED IN ANCESTORS");
+
+
+     CA2004A1.
+     CA2004A2;
+
+     CA2004A3;
+
+     RESULT;
+END CA2004A0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a1.ada
new file mode 100644
index 000000000..2dcfd459f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a1.ada
@@ -0,0 +1,34 @@
+-- CA2004A1.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.
+--*
+-- WKB 6/26/81
+
+SEPARATE (CA2004A0M)
+PACKAGE BODY CA2004A1 IS
+
+     K : INTEGER := 3;
+
+     PROCEDURE CA2004A2 IS SEPARATE;
+
+END CA2004A1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a2.ada
new file mode 100644
index 000000000..739152fcd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a2.ada
@@ -0,0 +1,43 @@
+-- CA2004A2.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.
+--*
+-- WKB 6/26/81
+
+SEPARATE (CA2004A0M.CA2004A1)
+PROCEDURE CA2004A2 IS
+BEGIN
+
+     IF I /= 1 THEN
+          FAILED ("IDENTIFIER NOT VISIBLE - 1");
+     END IF;
+
+     IF J /= 2 THEN
+          FAILED ("IDENTIFIER NOT VISIBLE - 2");
+     END IF;
+
+     IF K /= 3 THEN
+          FAILED ("IDENTIFIER NOT VISIBLE - 3");
+     END IF;
+
+END CA2004A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a3.ada
new file mode 100644
index 000000000..528f4e2d5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a3.ada
@@ -0,0 +1,39 @@
+-- CA2004A3.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.
+--*
+-- BHS 7/31/84
+
+SEPARATE (CA2004A0M)
+PROCEDURE CA2004A3 IS
+
+     PROCEDURE CA2004A4 IS SEPARATE;
+
+BEGIN
+
+     IF I /= IDENT_INT(1) OR
+        J /= IDENT_INT(2) THEN
+          FAILED ("IDENTIFIER NOT VISIBLE - 4");
+     END IF;
+
+END CA2004A3;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a4.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a4.ada
new file mode 100644
index 000000000..a71ca33f6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2004a4.ada
@@ -0,0 +1,36 @@
+-- CA2004A4.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.
+--*
+-- BHS 7/31/84
+
+SEPARATE (CA2004A0M.CA2004A3)
+PROCEDURE CA2004A4 IS
+BEGIN
+
+     IF I /= IDENT_INT(1) OR
+        J /= IDENT_INT(2) THEN
+          FAILED ("IDENTIFIER NOT VISIBLE - 5");
+     END IF;
+
+END CA2004A4;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a0.ada
new file mode 100644
index 000000000..fb9e0b4ce
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a0.ada
@@ -0,0 +1,77 @@
+-- CA2007A0M.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 PACKAGES ARE ELABORATED IN THE ORDER IN
+--   WHICH THEIR BODY STUBS APPEAR, NOT (NECESSARILY) IN THE
+--   ORDER IN WHICH THEY ARE COMPILED.
+
+-- SEPARATE FILES ARE:
+--   CA2007A0M THE MAIN PROCEDURE.
+--   CA2007A1  A SUBUNIT PACKAGE BODY.
+--   CA2007A2  A SUBUNIT PACKAGE BODY.
+--   CA2007A3  A SUBUNIT PACKAGE BODY.
+
+-- WKB 7/1/81
+-- JRK 7/1/81
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE CA2007A0M IS
+
+     ELAB_ORDER : STRING (1..3) := "   ";
+     NEXT : NATURAL := 1;
+
+     PACKAGE CALL_TEST IS 
+     END CALL_TEST;
+
+     PACKAGE BODY CALL_TEST IS
+     BEGIN
+          TEST ("CA2007A", "CHECK THAT SUBUNIT PACKAGES ARE " &
+                           "ELABORATED IN THE ORDER IN WHICH THEIR " &
+                           "BODY STUBS APPEAR");
+     END CALL_TEST;
+
+     PACKAGE CA2007A3 IS
+     END CA2007A3;
+
+     PACKAGE BODY CA2007A3 IS SEPARATE;
+
+     PACKAGE CA2007A2 IS
+     END CA2007A2;
+
+     PACKAGE BODY CA2007A2 IS SEPARATE;
+
+     PACKAGE CA2007A1 IS
+     END CA2007A1;
+
+     PACKAGE BODY CA2007A1 IS SEPARATE;
+
+BEGIN
+
+     IF ELAB_ORDER /= "321" THEN
+          FAILED ("INCORRECT ELABORATION ORDER");
+     END IF;
+
+     RESULT;
+END CA2007A0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a1.ada
new file mode 100644
index 000000000..bef16f5ce
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a1.ada
@@ -0,0 +1,36 @@
+-- CA2007A1.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.
+--*
+-- WKB 7/1/81
+
+SEPARATE (CA2007A0M)
+
+PACKAGE BODY CA2007A1 IS
+
+BEGIN 
+
+     ELAB_ORDER (NEXT) := '1';
+     NEXT := NEXT + 1;
+
+END CA2007A1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a2.ada
new file mode 100644
index 000000000..9429ea4dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a2.ada
@@ -0,0 +1,36 @@
+-- CA2007A2.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.
+--*
+-- WKB 7/1/81
+
+SEPARATE (CA2007A0M)
+
+PACKAGE BODY CA2007A2 IS
+
+BEGIN
+
+     ELAB_ORDER (NEXT) := '2';
+     NEXT := NEXT + 1;
+
+END CA2007A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a3.ada
new file mode 100644
index 000000000..1d4886c6f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2007a3.ada
@@ -0,0 +1,36 @@
+-- CA2007A3.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.
+--*
+-- WKB 7/1/81
+
+SEPARATE (CA2007A0M)
+
+PACKAGE BODY CA2007A3 IS
+
+BEGIN
+
+     ELAB_ORDER (NEXT) := '3';
+     NEXT := NEXT + 1;
+
+END CA2007A3;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2008a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2008a0.ada
new file mode 100644
index 000000000..542591c52
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2008a0.ada
@@ -0,0 +1,81 @@
+-- CA2008A0M.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 OVERLOADED SUBPROGRAM, ONE OF THE
+--   SUBPROGRAM BODIES CAN BE SPECIFIED WITH A BODY_STUB AND
+--   COMPILED SEPARATELY.
+
+-- SEPARATE FILES ARE:
+--   CA2008A0M THE MAIN PROCEDURE.
+--   CA2008A1  A SUBUNIT PROCEDURE BODY.
+--   CA2008A2  A SUBUNIT FUNCTION BODY.
+
+-- WKB 6/26/81
+-- SPS 11/2/82
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE CA2008A0M IS
+
+     I : INTEGER := 0;
+     B : BOOLEAN := TRUE;
+
+     PROCEDURE CA2008A1 (I : IN OUT INTEGER) IS
+     BEGIN
+          I := IDENT_INT (1);
+     END CA2008A1;
+
+     PROCEDURE CA2008A1 (B : IN OUT BOOLEAN) IS SEPARATE;
+
+     FUNCTION CA2008A2 RETURN INTEGER IS SEPARATE;
+
+     FUNCTION CA2008A2 RETURN BOOLEAN IS
+     BEGIN
+          RETURN IDENT_BOOL (FALSE);
+     END CA2008A2;
+
+BEGIN
+     TEST ("CA2008A", "CHECK THAT AN OVERLOADED SUBPROGRAM " &
+                      "CAN HAVE ONE OF ITS BODIES COMPILED SEPARATELY");
+
+     CA2008A1 (I);
+     IF I /= 1 THEN
+          FAILED ("OVERLOADED PROCEDURE NOT INVOKED - 1");
+     END IF;
+
+     CA2008A1 (B);
+     IF B THEN
+          FAILED ("OVERLOADED PROCEDURE NOT INVOKED - 2");
+     END IF;
+
+     IF CA2008A2 /= 2 THEN
+          FAILED ("OVERLOADED FUNCTION NOT INVOKED - 1");
+     END IF;
+
+     IF CA2008A2 THEN
+          FAILED ("OVERLOADED FUNCTION NOT INVOKED - 2");
+     END IF;
+
+     RESULT;
+END CA2008A0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2008a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2008a1.ada
new file mode 100644
index 000000000..7154a8d88
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2008a1.ada
@@ -0,0 +1,35 @@
+-- CA2008A1.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.
+--*
+-- WKB 6/26/81
+
+SEPARATE (CA2008A0M)
+
+PROCEDURE CA2008A1 (B : IN OUT BOOLEAN) IS
+
+BEGIN
+
+     B := FALSE;
+
+END CA2008A1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2008a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2008a2.ada
new file mode 100644
index 000000000..d8fd4399c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2008a2.ada
@@ -0,0 +1,35 @@
+-- CA2008A2.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.
+--*
+-- WKB 6/26/81
+
+SEPARATE (CA2008A0M)
+
+FUNCTION CA2008A2 RETURN INTEGER IS
+
+BEGIN
+
+     RETURN 2;
+
+END CA2008A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009a.ada
new file mode 100644
index 000000000..4953045dc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009a.ada
@@ -0,0 +1,77 @@
+-- CA2009A.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 GENERIC PACKAGE SUBUNIT CAN BE SPECIFIED AND
+-- INSTANTIATED.
+
+-- BHS 8/01/84
+-- JRK 5/24/85  CHANGED TO .ADA, SEE AI-00323.
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE CA2009A IS
+
+     INT1 : INTEGER := 1;
+
+     SUBTYPE STR15 IS STRING (1..15);
+     SVAR : STR15 := "ABCDEFGHIJKLMNO";
+
+     GENERIC 
+          TYPE ITEM IS PRIVATE;
+          CON1 : IN ITEM;
+          VAR1 : IN OUT ITEM;
+     PACKAGE PKG1 IS 
+     END PKG1;
+
+     PACKAGE BODY PKG1 IS SEPARATE;
+     
+     PACKAGE NI_PKG1 IS NEW PKG1 (INTEGER, IDENT_INT(2), INT1);
+     PACKAGE NS_PKG1 IS NEW PKG1 (STR15, IDENT_STR("REINSTANTIATION"),
+                                  SVAR);
+
+BEGIN
+
+     TEST ("CA2009A", "SPECIFICATION AND INSTANTIATION " &
+                      "OF GENERIC PACKAGE SUBUNITS");
+
+     IF INT1 /= 2 THEN
+          FAILED ("INCORRECT INSTANTIATION - INTEGER");
+     END IF;
+
+     IF SVAR /= "REINSTANTIATION" THEN
+          FAILED ("INCORRECT INSTANTIATION - STRING");
+     END IF;
+
+
+     RESULT;
+
+END CA2009A;
+
+
+SEPARATE (CA2009A)
+PACKAGE BODY PKG1 IS
+BEGIN
+     VAR1 := CON1;
+END PKG1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009c0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009c0.ada
new file mode 100644
index 000000000..aedd31ba8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009c0.ada
@@ -0,0 +1,83 @@
+-- CA2009C0M.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 GENERIC PACKAGE SUBUNIT CAN BE SPECIFIED AND
+--     INSTANTIATED.  IN THIS TEST, THE SUBUNIT BODY IS IN A
+--     SEPARATE FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
+
+-- SEPARATE FILES ARE:
+--     CA2009C0M  THE MAIN PROCEDURE.
+--     CA2009C1   A SUBUNIT PACKAGE BODY (PKG1).
+
+-- HISTORY:
+--     BHS 08/01/84  CREATED ORIGINAL TEST.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+--     RLB 09/15/99  REMOVED JUNK COMMENT.
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE CA2009C0M IS
+
+     INT1 : INTEGER := 1;
+
+     SUBTYPE STR15 IS STRING (1..15);
+     SVAR : STR15 := "ABCDEFGHIJKLMNO";
+
+     GENERIC
+          TYPE ITEM IS PRIVATE;
+          CON1 : IN ITEM;
+          VAR1 : IN OUT ITEM;
+     PACKAGE PKG1 IS
+     END PKG1;
+
+     PACKAGE BODY PKG1 IS SEPARATE;
+
+     PACKAGE NI_PKG1 IS NEW PKG1 (INTEGER, IDENT_INT(2), INT1);
+     PACKAGE NS_PKG1 IS NEW PKG1 (STR15, IDENT_STR("REINSTANTIATION"),
+                                  SVAR);
+
+BEGIN
+
+     TEST ("CA2009C", "SPECIFICATION AND INSTANTIATION " &
+                      "OF GENERIC PACKAGE SUBUNITS " &
+                      " -  SEPARATE FILES USED");
+
+     IF INT1 /= 2 THEN
+          FAILED ("INCORRECT INSTANTIATION - INTEGER");
+     END IF;
+
+     IF SVAR /= "REINSTANTIATION" THEN
+          FAILED ("INCORRECT INSTANTIATION - STRING");
+     END IF;
+
+
+     RESULT;
+
+END CA2009C0M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009c1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009c1.ada
new file mode 100644
index 000000000..6bf9a4bb6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009c1.ada
@@ -0,0 +1,43 @@
+-- CA2009C1.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.
+--*
+-- A GENERIC PACKAGE BODY.
+-- THE DECLARATION AND AN INSTANTIATION ARE IN CA2009C0M.DEP.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     BHS 08/09/84  CREATED ORIGINAL TEST.
+--     PWB 02/19/86  ADDED COMMENTS TO RELATE TO OTHER TEST FILES
+--                   AND TO DESCRIBE EXPECTED COMPILER ACTION.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+SEPARATE (CA2009C0M)
+PACKAGE BODY PKG1 IS
+BEGIN
+     VAR1 := CON1;
+END PKG1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009d.ada
new file mode 100644
index 000000000..65b5d8113
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009d.ada
@@ -0,0 +1,95 @@
+-- CA2009D.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 GENERIC SUBPROGRAM SUBUNIT CAN BE SPECIFIED AND
+-- INSTANTIATED.
+
+-- BHS 8/01/84
+-- JRK 5/24/85  CHANGED TO .ADA, SEE AI-00323.
+
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE CA2009D IS
+
+     INT1 : INTEGER := 1;
+     INT2 : INTEGER := 2;
+
+
+     GENERIC
+          TYPE ELEM IS PRIVATE;
+          PCON1 : IN ELEM;
+          PVAR1 : IN OUT ELEM;
+     PROCEDURE PROC1;
+
+
+     GENERIC
+          TYPE OBJ IS PRIVATE;
+          FCON1 : IN OBJ;
+          FVAR1 : IN OUT OBJ;
+     FUNCTION FUNC1 RETURN OBJ;
+
+
+     PROCEDURE PROC1 IS SEPARATE;
+     FUNCTION FUNC1 RETURN OBJ IS SEPARATE;
+
+
+     PROCEDURE NI_PROC1 IS NEW PROC1 (INTEGER, 2, INT1);
+     FUNCTION NI_FUNC1 IS NEW FUNC1 (INTEGER, 3, INT2);
+
+
+BEGIN
+
+     TEST ("CA2009D", "SPECIFICATION AND INSTANTIATION " &
+                      "OF GENERIC SUBPROGRAM SUBUNITS");
+
+     NI_PROC1;
+     IF INT1 /= 2 THEN
+          FAILED ("INCORRECT INSTANTIATION - NI_PROC1");
+     END IF;
+
+
+     IF NI_FUNC1 /= 3 THEN
+          FAILED ("INCORRECT INSTANTIATION - NI_FUNC1");
+     END IF;
+
+
+     RESULT;
+
+END CA2009D;
+
+
+SEPARATE (CA2009D)
+PROCEDURE PROC1 IS
+BEGIN
+     PVAR1 := PCON1;
+END PROC1;
+
+
+SEPARATE (CA2009D)
+FUNCTION FUNC1 RETURN OBJ IS
+BEGIN
+     FVAR1 := FCON1;
+     RETURN FVAR1;
+END FUNC1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009f0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009f0.ada
new file mode 100644
index 000000000..8bc23c11d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009f0.ada
@@ -0,0 +1,134 @@
+-- CA2009F0M.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 GENERIC SUBPROGRAM SUBUNIT CAN BE SPECIFIED AND
+--     INSTANTIATED.  IN THIS TEST, SOME SUBUNIT BODIES ARE
+--     IN SEPARATE FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
+
+-- SEPARATE FILES ARE:
+--     CA2009F0M  THE MAIN PROCEDURE, WITH SUBUNIT BODIES FOR
+--                     PROC2 AND FUNC2.
+--     CA2009F1   A SUBUNIT PROCEDURE BODY (PROC1).
+--     CA2009F2   A SUBUNIT FUNCTION BODY  (FUNC1).
+
+-- HISTORY:
+--     BHS 08/01/84  CREATED ORIGINAL TEST.
+--     PWB 02/19/86  ADDED "SOME" TO FIRST COMMENT.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+--     RLB 09/15/99  REMOVED JUNK COMMENT.
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE CA2009F0M IS
+
+     INT1 : INTEGER := 1;
+     INT2 : INTEGER := 2;
+     INT3 : INTEGER := 3;
+     INT4 : INTEGER := 4;
+
+
+     GENERIC
+          TYPE ELEM IS PRIVATE;
+          PCON1 : IN ELEM;
+          PVAR1 : IN OUT ELEM;
+     PROCEDURE PROC1;
+
+     GENERIC
+          TYPE ELEM IS PRIVATE;
+          PCON2 : IN ELEM;
+          PVAR2 : IN OUT ELEM;
+     PROCEDURE PROC2;
+
+     GENERIC
+          TYPE OBJ IS PRIVATE;
+          FCON1 : IN OBJ;
+          FVAR1 : IN OUT OBJ;
+     FUNCTION FUNC1 RETURN OBJ;
+
+     GENERIC
+          TYPE OBJ IS PRIVATE;
+          FCON2 : IN OBJ;
+          FVAR2 : IN OUT OBJ;
+     FUNCTION FUNC2 RETURN OBJ;
+
+
+     PROCEDURE PROC1 IS SEPARATE;
+     PROCEDURE PROC2 IS SEPARATE;
+     FUNCTION FUNC1 RETURN OBJ IS SEPARATE;
+     FUNCTION FUNC2 RETURN OBJ IS SEPARATE;
+
+
+     PROCEDURE NI_PROC1 IS NEW PROC1 (INTEGER, 2, INT1);
+     PROCEDURE NI_PROC2 IS NEW PROC2 (INTEGER, 3, INT2);
+     FUNCTION NI_FUNC1 IS NEW FUNC1 (INTEGER, 4, INT3);
+     FUNCTION NI_FUNC2 IS NEW FUNC2 (INTEGER, 5, INT4);
+
+
+BEGIN
+
+     TEST ("CA2009F", "SPECIFICATION AND INSTANTIATION " &
+                      "OF GENERIC SUBPROGRAM SUBUNITS");
+
+     NI_PROC1;
+     IF INT1 /= 2 THEN
+          FAILED ("INCORRECT INSTANTIATION - NI_PROC1");
+     END IF;
+
+     NI_PROC2;
+     IF INT2 /= 3 THEN
+          FAILED ("INCORRECT INSTANTIATION - NI_PROC2");
+     END IF;
+
+     IF NI_FUNC1 /= 4 THEN
+          FAILED ("INCORRECT INSTANTIATION - NI_FUNC1");
+     END IF;
+
+     IF NI_FUNC2 /= 5 THEN
+          FAILED ("INCORRECT INSTANTIATION - NI_FUNC2");
+     END IF;
+
+
+     RESULT;
+
+END CA2009F0M;
+
+
+SEPARATE (CA2009F0M)
+PROCEDURE PROC2 IS
+BEGIN
+     PVAR2 := PCON2;
+END PROC2;
+
+SEPARATE (CA2009F0M)
+FUNCTION FUNC2 RETURN OBJ IS
+BEGIN
+     FVAR2 := FCON2;
+     RETURN FVAR2;
+END FUNC2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009f1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009f1.ada
new file mode 100644
index 000000000..e3e13cedb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009f1.ada
@@ -0,0 +1,43 @@
+-- CA2009F1.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.
+--*
+-- SEPARATE GENERIC PROCEDURE BODY.
+-- SPECIFICATION, BODY STUB, AND INSTANTIATION ARE IN A2009F0M.DEP.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     BHS 08/01/84  CREATED ORIGINAL TEST.
+--     PWB 02/19/86  MODIFIED COMMENTS TO SHOW RELATION TO OTHER FILES
+--                   AND TO CLARIFY NON-APPLICABILITY.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+SEPARATE (CA2009F0M)
+PROCEDURE PROC1 IS
+BEGIN
+     PVAR1 := PCON1;
+END PROC1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009f2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009f2.ada
new file mode 100644
index 000000000..201a43835
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2009f2.ada
@@ -0,0 +1,45 @@
+-- CA2009F2.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.
+--*
+-- SEPARATE GENERIC FUNCTION BODY.
+-- SPECIFICATION, BODY STUB, AND AN INSTANTIATION ARE
+-- IN CA2009F0M.DEP.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     BHS 08/01/84  CREATED ORIGINAL TEST.
+--     PWB 02/19/86  MODIFIED COMMENTS TO DESCRIBE RELATION TO OTHER
+--                   FILES AND POSSIBLE NON-APPLICABILITY.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+SEPARATE (CA2009F0M)
+FUNCTION FUNC1 RETURN OBJ IS
+BEGIN
+     FVAR1 := FCON1;
+     RETURN FVAR1;
+END FUNC1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2011b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2011b.ada
new file mode 100644
index 000000000..c1c3be5a0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca2011b.ada
@@ -0,0 +1,118 @@
+-- CA2011B.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 FOR A SUBPROGRAM DECLARATION-STUB-BODY TRIPLE, THE
+--     DECLARATION-STUB AND STUB-BODY SPECIFICATIONS CAN CONFORM, BUT
+--     THE DECLARATION-BODY SPECIFICATIONS NEED NOT.
+
+-- HISTORY:
+--     JET 08/01/88  CREATED ORIGINAL TEST.
+
+PACKAGE CA2011B0 IS
+     SUBTYPE T IS INTEGER RANGE -100 .. 100;
+     I : T := 0;
+END CA2011B0;
+
+WITH CA2011B0; USE CA2011B0;
+PACKAGE CA2011B1 IS
+     PROCEDURE P1 (X : CA2011B0.T);
+     PROCEDURE P2 (X : T);
+END CA2011B1;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY CA2011B1 IS
+     PACKAGE CA2011BX RENAMES CA2011B0;
+     PROCEDURE P1 (X : T) IS SEPARATE;
+     PROCEDURE P2 (X : CA2011BX.T) IS SEPARATE;
+END CA2011B1;
+
+SEPARATE (CA2011B1)
+PROCEDURE P1 (X : CA2011BX.T) IS
+BEGIN
+     I := IDENT_INT(X);
+END P1;
+
+SEPARATE (CA2011B1)
+PROCEDURE P2 (X : CA2011BX.T) IS
+BEGIN
+     I := IDENT_INT(X);
+END P2;
+
+WITH REPORT; USE REPORT;
+WITH CA2011B0, CA2011B1;
+PROCEDURE CA2011B IS
+
+     PACKAGE P1 IS
+          SUBTYPE T IS INTEGER RANGE -100 .. 100;
+     END P1;
+     USE P1;
+
+     FUNCTION F1 RETURN P1.T;
+     FUNCTION F2 RETURN T;
+
+     PACKAGE P2 RENAMES P1;
+
+     FUNCTION F1 RETURN T IS SEPARATE;
+     FUNCTION F2 RETURN P2.T IS SEPARATE;
+
+BEGIN
+     TEST ("CA2011B", "CHECK THAT FOR A SUBPROGRAM DECLARATION-STUB-" &
+                      "BODY TRIPLE, THE DECLARATION-STUB AND STUB-" &
+                      "BODY SPECIFICATIONS CAN CONFORM, BUT THE " &
+                      "DECLARATON-BODY SPECIFICATIONS NEED NOT");
+
+     IF F1 /= IDENT_INT(100) THEN
+          FAILED ("INCORRECT RETURN VALUE FROM FUNCTION 1");
+     END IF;
+
+     IF F2 /= IDENT_INT(-100) THEN
+          FAILED ("INCORRECT RETURN VALUE FROM FUNCTION 2");
+     END IF;
+
+     CA2011B1.P1(3);
+     IF CA2011B0.I /= IDENT_INT(3) THEN
+          FAILED ("INCORRECT RETURN VALUE FROM PROCEDURE 1");
+     END IF;
+
+     CA2011B1.P2(4);
+     IF CA2011B0.I /= IDENT_INT(4) THEN
+          FAILED ("INCORRECT RETURN VALUE FROM PROCEDURE 2");
+     END IF;
+
+     RESULT;
+END CA2011B;
+
+SEPARATE (CA2011B)
+FUNCTION F1 RETURN P2.T IS
+BEGIN
+     RETURN 100;
+END F1;
+
+SEPARATE (CA2011B)
+FUNCTION F2 RETURN P2.T IS
+BEGIN
+     RETURN -100;
+END F2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca21001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca21001.a
new file mode 100644
index 000000000..1056b65bf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca21001.a
@@ -0,0 +1,152 @@
+-- CA21001.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
+--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
+--     software and documentation contained herein.  Unlimited rights are
+--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
+--     the Government intends to confer upon all recipients unlimited rights
+--     equal to those held by the Government.  These rights include rights to
+--     use, duplicate, release or disclose the released technical data and
+--     computer software in whole or in part, in any manner and for any purpose
+--     whatsoever, and to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE
+--     Check the requirements of the revised 10.2.1(11) from Technical
+--     Corrigendum 1 (originally discussed as AI95-00002).
+--     A package subunit whose parent is a preelaborated subprogram need
+--     not be preelaborable.
+--
+-- TEST DESCRIPTION
+--     We create several preelaborated library procedures with
+--     non-preelaborable package body subunits.  We try various levels
+--     of nesting of package and procedure subunits.
+--
+-- CHANGE HISTORY:
+--      29 JUN 1999   RAD   Initial Version
+--      23 SEP 1999   RLB   Improved comments, renamed, issued.
+--
+--!
+
+procedure CA21001_1(X: out Integer);
+    pragma Preelaborate(CA21001_1);
+
+procedure CA21001_1(X: out Integer) is
+    function F return Integer is separate;
+
+    package Sub is
+        function G(X: Integer) return Integer;
+            -- Returns X + 1.
+        Not_Preelaborable: Integer := F; -- OK, by AI-2.
+    end Sub;
+
+    package body Sub is separate;
+
+begin
+    X := -1;
+    X := F;
+    X := Sub.G(X);
+end CA21001_1;
+
+separate(CA21001_1)
+package body Sub is
+    package Sub_Sub is
+        -- Empty.
+    end Sub_Sub;
+    package body Sub_Sub is separate;
+
+    function G(X: Integer) return Integer is separate;
+begin
+    Not_Preelaborable := G(F); -- OK, by AI-2.
+    if Not_Preelaborable /= 101 then
+        raise Program_Error; -- Can't call Report.Failed, here,
+            -- because Report is not preelaborated.
+    end if;
+end Sub;
+
+separate(CA21001_1.Sub)
+package body Sub_Sub is
+begin
+    X := X; -- OK by AI-2.
+end Sub_Sub;
+
+separate(CA21001_1.Sub)
+function G(X: Integer) return Integer is
+
+    package G_Sub is
+        function H(X: Integer) return Integer;
+            -- Returns X + 1.
+        Not_Preelaborable: Integer := F; -- OK, by AI-2.
+    end G_Sub;
+    package body G_Sub is separate;
+
+begin
+    return G_Sub.H(X);
+end G;
+
+separate(CA21001_1.Sub.G)
+package body G_Sub is
+    function H(X: Integer) return Integer is separate;
+begin
+    Not_Preelaborable := H(F); -- OK, by AI-2.
+    if Not_Preelaborable /= 101 then
+        raise Program_Error; -- Can't call Report.Failed, here,
+            -- because Report is not preelaborated.
+    end if;
+end G_Sub;
+
+separate(CA21001_1.Sub.G.G_Sub)
+function H(X: Integer) return Integer is
+begin
+    return X + 1;
+end H;
+
+separate(CA21001_1)
+function F return Integer is
+
+    package F_Sub is
+        -- Empty.
+    end F_Sub;
+
+    package body F_Sub is separate;
+begin
+    return 100;
+end F;
+
+separate(CA21001_1.F)
+package body F_Sub is
+    True_Var: Boolean;
+begin
+    True_Var := True;
+    if True_Var then -- OK by AI-2.
+        X := X;
+    else
+        X := X + 2;
+    end if;
+end F_Sub;
+
+with Report; use Report;
+with CA21001_1;
+procedure CA21001 is
+    X: Integer := 0;
+begin
+    Test("CA21001",
+         "Test that a package subunit whose parent is a preelaborated"
+         & " subprogram need not be preelaborable");
+    CA21001_1(X);
+    if X /= 101 then
+        Failed("Bad value for X");
+    end if;
+    Result;
+end CA21001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a0.ada
new file mode 100644
index 000000000..fdbc141a3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a0.ada
@@ -0,0 +1,74 @@
+-- CA3011A0.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.
+--*
+-- A GENERIC UNIT.
+-- SUBUNITS ARE IN CA3011A1, CA3011A2, AND CA3011A3.
+-- INSTANTIATION IS IN CA3011A4M.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     RJW 09/22/86  CREATED ORIGINAL TEST.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+WITH REPORT; USE REPORT;
+
+GENERIC
+     TYPE T IS (<>);
+     X : T;
+PROCEDURE CA3011A0 (Z : OUT T);
+
+PROCEDURE CA3011A0 (Z : OUT T) IS
+     T1 : T;
+
+     FUNCTION CA3011A1 RETURN T IS SEPARATE;
+
+     PROCEDURE CA3011A2 (Y : OUT T) IS SEPARATE;
+
+     PACKAGE CA3011A3 IS
+          FUNCTION CA3011A3F RETURN T;
+     END CA3011A3;
+
+     PACKAGE BODY CA3011A3 IS SEPARATE;
+
+BEGIN
+     IF CA3011A1 /= X THEN
+          FAILED ( "INCORRECT VALUE RETURNED BY FUNCTION CA3011A1" );
+     END IF;
+
+     CA3011A2 (T1);
+
+     IF T1 /= X THEN
+          FAILED ( "INCORRECT VALUE RETURNED BY PROCEDURE CA3011A2 " );
+     END IF;
+
+     IF CA3011A3.CA3011A3F /= X THEN
+          FAILED ( "INCORRECT VALUE RETURNED BY FUNCTION CA3011A3F " );
+     END IF;
+
+     Z := X;
+
+END CA3011A0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a1.ada
new file mode 100644
index 000000000..5c53cf35b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a1.ada
@@ -0,0 +1,42 @@
+-- CA3011A1.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.
+--*
+-- A SUBUNIT OF A GENERIC UNIT.
+-- THE GENERIC UNIT IS IN CA3011A0.
+-- INSTANTIATION IS IN CA0011A4M.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     RJW 09/22/86  CREATED ORIGINAL TEST.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+SEPARATE (CA3011A0)
+FUNCTION CA3011A1 RETURN T IS
+
+BEGIN
+     RETURN X;
+END CA3011A1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a2.ada
new file mode 100644
index 000000000..87aacfa18
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a2.ada
@@ -0,0 +1,42 @@
+-- CA3011A2.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.
+--*
+-- A SUBUNIT OF A GENERIC UNIT.
+-- THE GENERIC UNIT IS IN CA3011A0.
+-- INSTANTIATION IS IN CA3011A4M.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     RJW 09/22/86  CREATED ORIGINAL TEST.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+SEPARATE (CA3011A0)
+PROCEDURE CA3011A2 (Y : OUT T) IS
+
+BEGIN
+     Y := X;
+END CA3011A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a3.ada
new file mode 100644
index 000000000..eb582b84b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a3.ada
@@ -0,0 +1,43 @@
+-- CA3011A3.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.
+--*
+-- A SUBUNIT OF A GENERIC UNIT.
+-- THE GENERIC UNIT IS IN CA3011A0.
+-- INSTANTIATION IS IN CA3011A4M.
+
+-- APPLICABILITY CRITERIA:
+--     THIS UNIT MUST BE ACCEPTED BY ALL ADA 95 IMPLEMENTATIONS.
+
+-- HISTORY:
+--     RJW 09/22/86  CREATED ORIGINAL TEST.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+
+SEPARATE (CA3011A0)
+PACKAGE BODY CA3011A3 IS
+     FUNCTION CA3011A3F RETURN T IS
+     BEGIN
+          RETURN X;
+     END;
+END CA3011A3;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a4.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a4.ada
new file mode 100644
index 000000000..70cad219c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca3011a4.ada
@@ -0,0 +1,61 @@
+-- CA3011A4M.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 IMPLEMENTATION DOES NOT REQUIRE GENERIC UNIT BODIES AND
+--     SUBUNITS TO BE COMPILED TOGETHER IN THE SAME FILE.
+
+-- SEPARATE FILES ARE:
+--     CA3011A0 - A GENERIC UNIT.
+--     CA3011A1, CA3011A2, CA3011A3 - SUBUNITS OF GENERIC UNIT.
+--     CA3011A4M - THE MAIN PROCEDURE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
+--     THIS WAS NOT REQUIRED FOR ADA 83.
+
+-- HISTORY:
+--     RJW 09/22/86  CREATED ORIGINAL TEST.
+--     BCB 01/05/88  MODIFIED HEADER.
+--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
+--     RLB 09/15/99  REPAIRED OBJECTIVE FOR ADA 95.
+
+WITH REPORT; USE REPORT;
+WITH CA3011A0;
+PROCEDURE CA3011A4M IS
+     I : INTEGER;
+     PROCEDURE P IS NEW CA3011A0 (INTEGER, 22);
+
+BEGIN
+     TEST ( "CA3011A", "CHECK THAT AN IMPLEMENTATION DOES NOT REQUIRE " &
+                       "GENERIC UNIT BODIES AND SUBUNITS TO BE " &
+                       "COMPILED TOGETHER IN THE SAME FILE" );
+
+     P (I);
+     IF I /= 22 THEN
+          FAILED ( "INCORRECT INSTANTIATION" );
+     END IF;
+
+     RESULT;
+END CA3011A4M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a0.ada
new file mode 100644
index 000000000..302314b4e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a0.ada
@@ -0,0 +1,50 @@
+-- CA5003A0.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.
+--*
+-- WKB 7/22/81
+-- JBG 10/6/83
+
+PACKAGE CA5003A0 IS
+
+     ORDER : STRING (1..5) := "     ";
+
+     INDEX : NATURAL := 1;
+
+     FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER;
+
+END CA5003A0;
+
+
+WITH REPORT;
+USE REPORT;
+PACKAGE BODY CA5003A0 IS
+
+     FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER IS
+     BEGIN
+          ORDER (INDEX) := UNIT;
+          INDEX := INDEX + 1;
+          RETURN INDEX - 1;
+     END SHOW_ELAB;
+
+END CA5003A0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a1.ada
new file mode 100644
index 000000000..7f9f3b259
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a1.ada
@@ -0,0 +1,34 @@
+-- CA5003A1.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.
+--*
+-- WKB 7/22/81
+-- JBG 10/6/83
+
+WITH CA5003A0;
+USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
+PACKAGE CA5003A1 IS
+
+     A1 : INTEGER := SHOW_ELAB ('1');
+
+END CA5003A1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a2.ada
new file mode 100644
index 000000000..9d36ab2a0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a2.ada
@@ -0,0 +1,34 @@
+-- CA5003A2.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.
+--*
+-- WKB 7/22/81
+-- JBG 10/6/83
+
+WITH CA5003A0;
+USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
+PACKAGE CA5003A2 IS
+
+     A2 : INTEGER := SHOW_ELAB ('2');
+
+END CA5003A2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a3.ada
new file mode 100644
index 000000000..96145677c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a3.ada
@@ -0,0 +1,34 @@
+-- CA5003A3.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.
+--*
+-- WKB 7/22/81
+-- JBG 10/6/83
+
+WITH CA5003A0, CA5003A2;
+USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
+PACKAGE CA5003A3 IS
+
+     A3 : INTEGER := SHOW_ELAB ('3');
+
+END CA5003A3;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a4.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a4.ada
new file mode 100644
index 000000000..908b39e42
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a4.ada
@@ -0,0 +1,34 @@
+-- CA5003A4.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.
+--*
+-- WKB 7/22/81
+-- JBG 10/6/83
+
+WITH CA5003A0, CA5003A2;
+USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
+PACKAGE CA5003A4 IS
+
+     A4 : INTEGER := SHOW_ELAB ('4');
+
+END CA5003A4;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a5.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a5.ada
new file mode 100644
index 000000000..a8e07fea9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a5.ada
@@ -0,0 +1,34 @@
+-- CA5003A5.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.
+--*
+-- WKB 7/22/81
+-- JBG 10/6/83
+
+WITH CA5003A0, CA5003A3, CA5003A4;
+USE CA5003A0; PRAGMA ELABORATE (CA5003A0);
+PACKAGE CA5003A5 IS
+
+     A5 : INTEGER := SHOW_ELAB ('5');
+
+END CA5003A5;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a6.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a6.ada
new file mode 100644
index 000000000..df12c4e88
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003a6.ada
@@ -0,0 +1,71 @@
+-- CA5003A6M.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 ELABORATION OF LIBRARY UNITS REQUIRED BY
+--   A MAIN PROGRAM IS PERFORMED CONSISTENTLY WITH THE PARTIAL
+--   ORDERING DEFINED BY THE COMPILATION ORDER RULES.
+
+-- SEPARATE FILES ARE:
+--   CA5003A0  A LIBRARY PACKAGE.
+--   CA5003A1  A LIBRARY PACKAGE SPECIFICATION.
+--   CA5003A2  A LIBRARY PACKAGE SPECIFICATION.
+--   CA5003A3  A LIBRARY PACKAGE SPECIFICATION.
+--   CA5003A4  A LIBRARY PACKAGE SPECIFICATION.
+--   CA5003A5  A LIBRARY PACKAGE SPECIFICATION.
+--   CA5003A6M THE MAIN PROCEDURE.
+
+-- PACKAGE A5 MUST BE ELABORATED AFTER A2, A3, AND A4.
+-- PACKAGE A3 MUST BE ELABORATED AFTER A2.
+-- PACKAGE A4 MUST BE ELABORATED AFTER A2.
+
+-- WKB 7/22/81
+-- JBG 10/6/83
+
+WITH REPORT, CA5003A0;
+USE REPORT, CA5003A0;
+WITH CA5003A1, CA5003A5;
+PROCEDURE CA5003A6M IS
+
+BEGIN
+
+     TEST ("CA5003A", "CHECK THAT ELABORATION ORDER IS CONSISTENT " &
+                      "WITH PARTIAL ORDERING REQUIREMENTS");
+
+     COMMENT ("ACTUAL ELABORATION ORDER WAS " & ORDER);
+
+     IF ORDER /= "12345" AND
+        ORDER /= "12435" AND
+        ORDER /= "21345" AND
+        ORDER /= "21435" AND
+        ORDER /= "23145" AND
+        ORDER /= "24135" AND
+        ORDER /= "23415" AND
+        ORDER /= "24315" AND
+        ORDER /= "23451" AND
+        ORDER /= "24351" THEN
+          FAILED ("ILLEGAL ELABORATION ORDER");
+     END IF;
+
+     RESULT;
+END CA5003A6M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b0.ada
new file mode 100644
index 000000000..9851ca328
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b0.ada
@@ -0,0 +1,51 @@
+-- CA5003B0.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.
+--*
+-- WKB 7/22/81
+-- JBG 10/6/83
+-- BHS 8/02/84
+-- JRK 9/20/84
+
+
+PACKAGE CA5003B0 IS
+
+     ORDER : STRING (1..4) := "    ";
+
+     INDEX : NATURAL := 1;
+
+     FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER;
+
+END CA5003B0;
+
+
+PACKAGE BODY CA5003B0 IS
+
+     FUNCTION SHOW_ELAB (UNIT : CHARACTER) RETURN INTEGER IS
+     BEGIN
+          ORDER (INDEX) := UNIT;
+          INDEX := INDEX + 1;
+          RETURN INDEX - 1;
+     END SHOW_ELAB;
+
+END CA5003B0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b1.ada
new file mode 100644
index 000000000..ba70ecc38
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b1.ada
@@ -0,0 +1,46 @@
+-- CA5003B1.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.
+--*
+-- WKB 7/22/81
+-- JBG 10/6/83
+-- BHS 8/02/84
+-- JRK 9/20/84
+
+
+WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
+PACKAGE CA5003B1 IS
+
+     PACKAGE CA5003B2 IS
+          PROCEDURE P1;
+     END CA5003B2;
+
+END CA5003B1;
+
+
+PACKAGE BODY CA5003B1 IS
+
+     A1 : INTEGER := SHOW_ELAB ('1');
+     PACKAGE BODY CA5003B2 IS SEPARATE;
+
+END CA5003B1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b2.ada
new file mode 100644
index 000000000..a524a0088
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b2.ada
@@ -0,0 +1,45 @@
+-- CA5003B2.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.
+--*
+-- BHS 8/02/84
+-- JRK 9/20/84
+
+WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
+SEPARATE (CA5003B1)
+PACKAGE BODY CA5003B2 IS
+
+     A2 : INTEGER := SHOW_ELAB ('2');
+
+     PROCEDURE P1 IS
+     BEGIN
+          NULL;
+     END P1;
+
+     PACKAGE CA5003B4 IS 
+          PROCEDURE P2;
+     END CA5003B4;
+
+     PACKAGE BODY CA5003B4 IS SEPARATE;
+
+END CA5003B2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b3.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b3.ada
new file mode 100644
index 000000000..8706a0637
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b3.ada
@@ -0,0 +1,35 @@
+-- CA5003B3.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.
+--*
+-- WKB 7/22/81
+-- JBG 10/6/83
+-- BHS 8/02/84
+-- JRK 9/20/84
+
+WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
+PACKAGE CA5003B3 IS
+
+     A3 : INTEGER := SHOW_ELAB ('3');
+
+END CA5003B3;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b4.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b4.ada
new file mode 100644
index 000000000..d3c2f7e2d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b4.ada
@@ -0,0 +1,40 @@
+-- CA5003B4.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.
+--*
+-- BHS 8/02/84
+-- JRK 9/20/84
+
+WITH CA5003B3;                -- MUST BE ELABORATED BEFORE CA5003B1.
+WITH CA5003B0; USE CA5003B0; PRAGMA ELABORATE (CA5003B0);
+SEPARATE (CA5003B1.CA5003B2)
+PACKAGE BODY CA5003B4 IS
+
+     A4 : INTEGER := SHOW_ELAB ('4');
+
+     PROCEDURE P2 IS
+     BEGIN
+          NULL;
+     END P2;
+
+END CA5003B4;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b5.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b5.ada
new file mode 100644
index 000000000..4beb61ed1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5003b5.ada
@@ -0,0 +1,65 @@
+-- CA5003B5M.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 ELABORATION OF LIBRARY UNITS REQUIRED BY
+--   A MAIN PROGRAM IS PERFORMED CONSISTENTLY WITH THE PARTIAL
+--   ORDERING DEFINED BY THE COMPILATION ORDER RULES.
+-- IN PARTICULAR, CHECK THAT A LIBRARY UNIT MENTIONED IN THE
+--   WITH_CLAUSE OF A SUBUNIT IS ELABORATED PRIOR TO THE BODY OF 
+--   THE ANCESTOR UNIT.
+
+-- SEPARATE FILES ARE:
+--   CA5003B0  A LIBRARY PACKAGE.
+--   CA5003B1  A LIBRARY PACKAGE.
+--   CA5003B2  A SUBUNIT PACKAGE BODY (_B1._B2).
+--   CA5003B3  A LIBRARY PACKAGE DECLARATION.
+--   CA5003B4  A SUBUNIT PACKAGE BODY (_B1._B2._B4).
+--   CA5003B5M THE MAIN PROCEDURE.
+
+-- LIBRARY PACKAGES MUST BE ELABORATED IN ORDER: _B0, _B3, _B1.
+-- PARENT UNITS MUST BE ELABORATED BEFORE THEIR SUBUNITS.
+
+-- WKB 7/22/81
+-- JBG 10/6/83
+-- BHS 8/02/84
+-- JRK 9/20/84
+
+WITH REPORT, CA5003B0;
+USE REPORT, CA5003B0;
+WITH CA5003B1;
+PROCEDURE CA5003B5M IS
+
+BEGIN
+     TEST ("CA5003B", "CHECK THAT UNITS IN WITH_CLAUSES OF " &
+                      "SUBUNITS ARE ELABORATED PRIOR TO THE " &
+                      "BODY OF THE ANCESTOR UNIT");
+
+     COMMENT ("ACTUAL ELABORATION ORDER WAS " & ORDER);
+
+     IF ORDER /= "3124" THEN
+          FAILED ("ILLEGAL ELABORATION ORDER");
+     END IF;
+
+     RESULT;
+END CA5003B5M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004a.ada
new file mode 100644
index 000000000..34a735ef0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004a.ada
@@ -0,0 +1,105 @@
+-- CA5004A.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 PRAGMA ELABORATE IS APPLIED TO A PACKAGE THAT DECLARES
+-- A TASK OBJECT, THE IMPLICIT PACKAGE BODY IS ELABORATED AND THE TASK
+-- IS ACTIVATED.
+
+-- BHS 8/03/84
+-- JRK 9/20/84
+-- PWN 01/31/95  ADDED A PROCEDURE TO REQUIRE A BODY FOR ADA 9X.
+
+
+PACKAGE CA5004A0 IS
+
+     TASK TYPE TSK IS
+          ENTRY E (VAR : OUT INTEGER);
+     END TSK;
+
+END CA5004A0;
+
+
+PACKAGE BODY CA5004A0 IS
+
+     TASK BODY TSK IS
+     BEGIN
+          ACCEPT E (VAR : OUT INTEGER) DO
+               VAR := 4;
+          END E;
+     END TSK;
+
+END CA5004A0;
+
+
+WITH CA5004A0; USE CA5004A0; PRAGMA ELABORATE (CA5004A0);
+PACKAGE CA5004A1 IS
+
+     T : TSK;
+
+END CA5004A1;
+
+
+PACKAGE CA5004A2 IS
+     PROCEDURE REQUIRE_BODY;
+END CA5004A2;
+
+
+WITH REPORT; USE REPORT;
+WITH CA5004A1; USE CA5004A1;
+PRAGMA ELABORATE (CA5004A1, REPORT);
+PACKAGE BODY CA5004A2 IS
+
+     I : INTEGER := 1;
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+          NULL;
+     END;
+BEGIN
+
+     TEST ("CA5004A", "APPLYING PRAGMA ELABORATE TO A PACKAGE " &
+                      "DECLARING A TASK OBJECT CAUSES IMPLICIT " &
+                      "BODY ELABORATION AND TASK ACTIVATION");
+
+     SELECT
+          T.E(I);
+          IF I /= 4 THEN
+               FAILED ("TASK NOT EXECUTED PROPERLY");
+          END IF;
+     OR
+          DELAY 10.0;
+          FAILED ("TASK NOT ACTIVATED AFTER 10 SECONDS");
+     END SELECT;
+
+END CA5004A2;
+
+
+WITH CA5004A2;
+WITH REPORT; USE REPORT;
+PROCEDURE CA5004A IS
+BEGIN
+
+     RESULT;
+
+END CA5004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004b0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004b0.ada
new file mode 100644
index 000000000..bb7947027
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004b0.ada
@@ -0,0 +1,64 @@
+-- CA5004B0.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: See CA5004B2M.ADA
+--
+-- SPECIAL INSTRUCTIONS:  See CA5004B2M.ADA
+--
+-- TEST FILES:
+--     => CA5004B0.ADA
+--        CA5004B1.ADA
+--        CA5004B2M.ADA
+
+-- PWN 05/31/96 Split test into files without duplicate unit names.
+-- RLB 03/11/99 Split test into files so that units that will be replaced
+--              and units that won't are not in the same source file.
+
+-------------------------------------------------------------
+
+PACKAGE HEADER IS 
+
+     PROCEDURE WRONG (WHY : STRING);
+
+END HEADER;
+
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY HEADER IS
+
+     PROCEDURE WRONG (WHY : STRING) IS
+     BEGIN
+          FAILED ("PACKAGE WITH " & WHY & " NOT ELABORATED " &
+                  "CORRECTLY");
+     END WRONG;
+
+BEGIN
+
+     TEST ("CA5004B", "PRAGMA ELABORATE IS ACCEPTED AND OBEYED " &
+                      "EVEN WHEN THE BODY OF THE UNIT NAMED IS " &
+                      "MISSING OR OBSOLETE");
+
+END HEADER;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004b1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004b1.ada
new file mode 100644
index 000000000..068ae88a0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004b1.ada
@@ -0,0 +1,56 @@
+-- CA5004B1.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: See CA5004B2M.ADA
+--
+-- SPECIAL INSTRUCTIONS:  See CA5004B2M.ADA
+--
+-- TEST FILES:
+--        CA5004B0.ADA
+--     => CA5004B1.ADA
+--        CA5004B2M.ADA
+
+-- PWN 05/31/96 Split test into files without duplicate unit names.
+-- RLB 03/11/99 Split test into files so that units that will be replaced
+--              and units that won't are not in the same source file.
+
+------------------------------------------------------------------
+
+PACKAGE CA5004B0 IS
+
+     I : INTEGER := 1;
+
+     FUNCTION F RETURN BOOLEAN;
+
+END CA5004B0;
+
+
+PACKAGE BODY CA5004B0 IS
+
+     FUNCTION F RETURN BOOLEAN IS
+     BEGIN
+          RETURN TRUE;
+     END F;
+
+END CA5004B0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004b2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004b2.ada
new file mode 100644
index 000000000..bae6280dc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5004b2.ada
@@ -0,0 +1,153 @@
+-- CA5004B2M.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 PRAGMA ELABORATE IS ACCEPTED AND OBEYED EVEN IF THE UNIT
+--    NAMED IN THE PRAGMA DOES NOT YET HAVE A BODY IN THE LIBRARY OR IF 
+--    ITS BODY IS OBSOLETE.
+-- CHECK THAT MORE THAN ONE NAME IS ALLOWED IN A PRAGMA ELABORATE.
+--
+-- SPECIAL INSTRUCTIONS:  
+--     1. Compile CA5004B0.ADA
+--     2. Compile CA5004B1.ADA
+--     3. Compile CA5004B2M.ADA
+--     4. Bind/Link main unit CA5004B2M
+--     5. Execute the resulting file
+--
+-- TEST FILES:
+--        CA5004B0.ADA
+--        CA5004B1.ADA
+--     => CA5004B2M.ADA
+
+-- BHS 8/03/84
+-- JRK 9/20/84
+-- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+-- PWN 05/31/96 Split test into files without duplicate unit names.
+-- TMB 11/20/96 ADDED PROCEDURE DECL TO CA5004B0 TO INSURE IT MAKES
+--               THE OLD BODY OBSOLETE
+-- TMB 12/2/96  MADE NAME OF MAIN PROCEDURE SAME AS FILE NAME
+-- RLB 03/11/99 Split first test file in order to prevent good units
+--              from being made obsolete.
+
+-------------------------------------------------------------
+
+PACKAGE CA5004B0 IS          -- OLD BODY NOW OBSOLETE.
+
+     I : INTEGER := 2;
+     B : BOOLEAN := TRUE;
+
+     FUNCTION F RETURN BOOLEAN;
+     PROCEDURE P;
+
+END CA5004B0;
+
+---------------------------------------------------------
+
+PACKAGE CA5004B1 IS
+
+     J : INTEGER := 3;
+
+     PROCEDURE P (X : INTEGER);
+
+END CA5004B1;                -- NO BODY GIVEN YET.
+
+----------------------------------------------------------
+
+WITH HEADER; USE HEADER;
+WITH CA5004B0, CA5004B1;
+USE CA5004B0, CA5004B1;
+PRAGMA ELABORATE (HEADER, CA5004B0, CA5004B1);
+PACKAGE CA5004B2 IS
+
+     K1 : INTEGER := CA5004B0.I;
+     K2 : INTEGER := CA5004B1.J;
+
+     PROCEDURE REQUIRE_BODY;
+
+END CA5004B2;
+
+
+PACKAGE BODY CA5004B2 IS
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+       NULL;
+     END;
+
+BEGIN
+
+     IF K1 /= 4 THEN
+          WRONG ("OBSOLETE BODY");
+     END IF;
+
+     IF K2 /= 5 THEN
+          WRONG ("NO BODY");
+     END IF;
+
+END CA5004B2;
+
+--------------------------------------------------
+
+WITH REPORT, CA5004B2;
+USE REPORT, CA5004B2;
+PROCEDURE CA5004B2M IS
+BEGIN
+
+     RESULT;
+
+END CA5004B2M;
+
+----------------------------------------------------
+
+PACKAGE BODY CA5004B0 IS
+
+     FUNCTION F RETURN BOOLEAN IS
+     BEGIN
+          RETURN FALSE;
+     END F;
+
+     PROCEDURE P IS
+     BEGIN
+        RETURN;
+     END P;
+
+BEGIN
+
+     I := 4;
+
+END CA5004B0;
+
+---------------------------------------------------
+
+PACKAGE BODY CA5004B1 IS
+
+     PROCEDURE P (X : INTEGER) IS
+     BEGIN
+          NULL;
+     END P;
+
+BEGIN
+
+     J := 5;
+
+END CA5004B1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5006a.ada
new file mode 100644
index 000000000..cc4d3c9dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ca/ca5006a.ada
@@ -0,0 +1,145 @@
+-- CA5006A.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 PROGRAM IS NOT REJECTED JUST BECAUSE THERE IS NO WAY TO
+-- ELABORATE SECONDARY UNITS SO PROGRAM_ERROR WILL BE AVOIDED.
+
+-- R.WILLIAMS 9/22/86
+
+-----------------------------------------------------------------------
+
+PACKAGE CA5006A0 IS
+   FUNCTION P_E_RAISED RETURN BOOLEAN;
+   PROCEDURE SHOW_PE_RAISED;
+END CA5006A0;
+
+-----------------------------------------------------------------------
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY CA5006A0 IS
+   RAISED : BOOLEAN := FALSE;
+
+   FUNCTION P_E_RAISED RETURN BOOLEAN IS
+   BEGIN
+      RETURN RAISED;
+   END P_E_RAISED;
+
+   PROCEDURE SHOW_PE_RAISED IS
+   BEGIN
+      RAISED := TRUE;
+   END SHOW_PE_RAISED;
+
+BEGIN
+     TEST ( "CA5006A", "CHECK THAT A PROGRAM IS NOT REJECTED JUST " &
+                       "BECAUSE THERE IS NO WAY TO ELABORATE " &
+                       "SECONDARY UNITS SO PROGRAM_ERROR WILL BE " &
+                       "AVOIDED" );
+
+                         
+END CA5006A0;
+
+-----------------------------------------------------------------------
+
+PACKAGE CA5006A1 IS
+  FUNCTION F RETURN INTEGER;
+END CA5006A1;
+
+-----------------------------------------------------------------------
+
+PACKAGE CA5006A2 IS
+  FUNCTION G RETURN INTEGER;
+END CA5006A2;
+
+-----------------------------------------------------------------------
+
+WITH REPORT; USE REPORT;
+WITH CA5006A0; USE CA5006A0;
+WITH CA5006A2; USE CA5006A2;
+PRAGMA ELABORATE(CA5006A0);
+
+PACKAGE BODY CA5006A1 IS
+   X : INTEGER;
+
+   FUNCTION F RETURN INTEGER IS
+   BEGIN
+      RETURN IDENT_INT(0);
+   END F;
+
+BEGIN
+   X := G;
+   IF NOT P_E_RAISED THEN
+      FAILED ( "G CALLED" );
+   END IF;
+EXCEPTION
+   WHEN PROGRAM_ERROR =>
+      COMMENT ( "PROGRAM_ERROR RAISED IN CA5006A1" );
+      SHOW_PE_RAISED;
+   WHEN OTHERS =>
+      FAILED ( "OTHER ERROR RAISED IN CA5006A1" );
+END CA5006A1;
+
+-----------------------------------------------------------------------
+
+WITH REPORT; USE REPORT;
+WITH CA5006A0; USE CA5006A0;
+WITH CA5006A1; USE CA5006A1;
+PRAGMA ELABORATE(CA5006A0);
+
+PACKAGE BODY CA5006A2 IS
+   X : INTEGER;
+
+   FUNCTION G RETURN INTEGER IS
+   BEGIN
+      RETURN IDENT_INT(1);
+   END G;
+
+BEGIN
+   X := F;
+   IF NOT P_E_RAISED THEN
+      FAILED ( "F CALLED" );
+   END IF;
+EXCEPTION
+   WHEN PROGRAM_ERROR =>
+      COMMENT ( "PROGRAM_ERROR RAISED IN CA5006A2" );
+      SHOW_PE_RAISED;
+   WHEN OTHERS =>
+      FAILED ( "OTHER ERROR RAISED IN CA5006A2" );
+END CA5006A2;
+
+-----------------------------------------------------------------------
+
+WITH REPORT; USE REPORT; 
+WITH CA5006A0; USE CA5006A0;
+WITH CA5006A1; 
+WITH CA5006A2; 
+
+PROCEDURE CA5006A IS
+BEGIN
+   IF NOT P_E_RAISED THEN
+      FAILED ( "PROGRAM_ERROR NEVER RAISED" );
+   END IF;
+
+   RESULT;
+END CA5006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb10002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb10002.a
new file mode 100644
index 000000000..f3099d4a2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb10002.a
@@ -0,0 +1,128 @@
+-- CB10002.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 Storage_Error is raised when storage for allocated objects
+--      is exceeded.
+--
+-- TEST DESCRIPTION:
+--      This test allocates a very large data structure.
+--
+--      In order to avoid running forever on virtual memory targets, the
+--      data structure is bounded in size, and elements are larger the longer
+--      the program runs.
+--
+--      The program attempts to allocate about 8,600,000 integers, or about
+--      32 Megabytes on a typical 32-bit machine.
+--
+--      If Storage_Error is raised, the data structure is deallocated.
+--      (Otherwise, Report.Result may fail as memory is exhausted).
+
+-- CHANGE HISTORY:
+--      30 Aug 85   JRK     Ada 83 test created.
+--      14 Sep 99   RLB     Created Ada 95 test.
+
+
+with Report;
+with Ada.Unchecked_Deallocation;
+procedure CB10002 is
+
+   type Data_Space is array (Positive range <>) of Integer;
+
+   type Element (Size : Positive);
+
+   type Link is access Element;
+
+   type Element (Size : Positive) is
+      record
+         Parent : Link;
+         Child  : Link;
+         Sibling: Link;
+         Data   : Data_Space (1 .. Size);
+      end record;
+
+    procedure Free is new Ada.Unchecked_Deallocation (Element, Link);
+
+    Holder : array (1 .. 430) of Link;
+    Last_Allocated : Natural := 0;
+
+    procedure Allocator (Count : in Positive) is
+    begin
+	-- Allocate various sized objects similar to what a real application
+	-- would do.
+	if Count in 1 .. 20 then
+	    Holder(Count) := new Element (Report.Ident_Int(10));
+	elsif Count in 21 .. 40 then
+	    Holder(Count) := new Element (Report.Ident_Int(79));
+	elsif Count in 41 .. 60 then
+	    Holder(Count) := new Element (Report.Ident_Int(250));
+	elsif Count in 61 .. 80 then
+	    Holder(Count) := new Element (Report.Ident_Int(520));
+	elsif Count in 81 .. 100 then
+	    Holder(Count) := new Element (Report.Ident_Int(1000));
+	elsif Count in 101 .. 120 then
+	    Holder(Count) := new Element (Report.Ident_Int(2048));
+	elsif Count in 121 .. 140 then
+	    Holder(Count) := new Element (Report.Ident_Int(4200));
+	elsif Count in 141 .. 160 then
+	    Holder(Count) := new Element (Report.Ident_Int(7999));
+	elsif Count in 161 .. 180 then
+	    Holder(Count) := new Element (Report.Ident_Int(15000));
+	else -- 181..430
+	    Holder(Count) := new Element (Report.Ident_Int(32000));
+	end if;
+	Last_Allocated := Count;
+    end Allocator;
+
+
+begin
+   Report.Test ("CB10002", "Check that Storage_Error is raised when " &
+                           "storage for allocated objects is exceeded");
+
+   begin
+      for I in Holder'range loop
+         Allocator (I);
+      end loop;
+      Report.Not_Applicable ("Unable to exhaust memory");
+      for I in 1 .. Last_Allocated loop
+         Free (Holder(I));
+      end loop;
+   exception
+      when Storage_Error =>
+         if Last_Allocated = 0 then
+            Report.Failed ("Unable to allocate anything");
+         else -- Clean up, so we have enough memory to report on the result.
+            for I in 1 .. Last_Allocated loop
+               Free (Holder(I));
+            end loop;
+            Report.Comment (Natural'Image(Last_Allocated) & " items allocated");
+         end if;
+      when others =>
+         Report.Failed ("Wrong exception raised by heap overflow");
+   end;
+
+   Report.Result;
+
+end CB10002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1001a.ada
new file mode 100644
index 000000000..5cd5391e5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1001a.ada
@@ -0,0 +1,102 @@
+-- CB1001A.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 EXCEPTIONS MAY BE RAISED EXPLICITLY
+--    AND MAY HAVE HANDLERS WRITTEN FOR THEM.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- DCB 03/25/80
+-- JRK 11/17/80
+-- SPS 11/2/82
+-- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT;
+PROCEDURE CB1001A IS
+
+     USE REPORT;
+
+     FLOW_COUNT : INTEGER := 0;
+
+BEGIN
+     TEST("CB1001A", "CHECK THAT ALL PREDEFINED EXCEPTIONS MAY BE " &
+          "RAISED EXPLICITLY AND MAY HAVE HANDLERS WRITTEN FOR THEM");
+
+     BEGIN
+          RAISE CONSTRAINT_ERROR;
+          FAILED("NO EXCEPTION RAISED WHEN CONSTRAINT_ERROR EXPECTED");
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FLOW_COUNT := FLOW_COUNT + 1;
+          WHEN OTHERS =>
+               FAILED("WRONG EXCEPTION RAISED WHEN CONSTRAINT_ERROR " &
+                      "EXPECTED");
+     END;
+
+
+     BEGIN
+          RAISE PROGRAM_ERROR;
+          FAILED("NO EXCEPTION RAISED WHEN PROGRAM_ERROR EXPECTED");
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               FLOW_COUNT := FLOW_COUNT + 1;
+          WHEN OTHERS =>
+               FAILED("WRONG EXCEPTION RAISED WHEN PROGRAM_ERROR " &
+                      "EXPECTED");
+     END;
+
+     BEGIN
+          RAISE STORAGE_ERROR;
+          FAILED("NO EXCEPTION RAISED WHEN STORAGE_ERROR EXPECTED");
+
+     EXCEPTION
+          WHEN STORAGE_ERROR =>
+               FLOW_COUNT := FLOW_COUNT + 1;
+          WHEN OTHERS =>
+               FAILED("WRONG EXCEPTION RAISED WHEN STORAGE_ERROR " &
+                      "EXPECTED");
+     END;
+
+     BEGIN
+          RAISE TASKING_ERROR;
+          FAILED("NO EXCEPTION RAISED WHEN TASKING_ERROR EXPECTED");
+
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               FLOW_COUNT := FLOW_COUNT + 1;
+          WHEN OTHERS =>
+               FAILED("WRONG EXCEPTION RAISED WHEN TASKING_ERROR " &
+                      "EXPECTED");
+     END;
+
+     IF FLOW_COUNT /= 4 THEN
+          FAILED("WRONG FLOW_COUNT VALUE");
+     END IF;
+
+     RESULT;
+END CB1001A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1004a.ada
new file mode 100644
index 000000000..d137d0e32
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1004a.ada
@@ -0,0 +1,85 @@
+-- CB1004A.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 EXCEPTIONS DECLARED IN RECURSIVE PROCEDURES ARE NOT
+--    REPLICATED ANEW FOR EACH RECURSIVE ACTIVATION OF THE PROCEDURE.
+
+-- DCB 03/30/80
+-- JRK 11/17/80
+-- SPS 3/23/83
+
+WITH REPORT;
+PROCEDURE CB1004A IS
+
+     USE REPORT;
+
+     FLOW_COUNT : INTEGER := 0;
+
+     PROCEDURE P1(SWITCH1 : IN INTEGER) IS
+
+          E1 : EXCEPTION;
+
+          PROCEDURE P2 IS
+
+          BEGIN
+               FLOW_COUNT := FLOW_COUNT + 1;   -- 3
+               P1(2);
+               FAILED("EXCEPTION NOT PROPAGATED");
+
+          EXCEPTION
+               WHEN E1 =>
+                    FLOW_COUNT := FLOW_COUNT + 1;   -- 6
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED");
+          END P2;
+
+     BEGIN
+          FLOW_COUNT := FLOW_COUNT + 1;   -- 2   -- 4
+          IF SWITCH1 = 1 THEN
+               P2;
+          ELSIF SWITCH1 = 2 THEN
+               FLOW_COUNT := FLOW_COUNT + 1;   -- 5
+               RAISE E1;
+               FAILED("EXCEPTION NOT RAISED");
+          END IF;
+     END P1;
+
+BEGIN
+     TEST("CB1004A","CHECK THAT EXCEPTIONS ARE NOT RECURSIVELY " &
+                    "REPLICATED");
+
+     FLOW_COUNT := FLOW_COUNT + 1;   -- 1
+     P1(1);
+
+     IF FLOW_COUNT /= 6 THEN
+          FAILED("INCORRECT FLOW_COUNT VALUE");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED("EXCEPTION HANDLED IN WRONG SCOPE");
+          RESULT;
+END CB1004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1005a.ada
new file mode 100644
index 000000000..94e5383b3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1005a.ada
@@ -0,0 +1,164 @@
+-- CB1005A.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 EXCEPTIONS DECLARED IN GENERIC PACKAGES AND PROCEDURES ARE
+-- CONSIDERED DISTINCT FOR EACH INSTANTIATION.
+
+-- CHECK THAT AN EXCEPTION NAME DECLARED IN A GENERIC PACKAGE
+-- INSTANTIATION IN A RECURSIVE PROCEDURE DENOTES THE SAME ENTITY
+-- EVEN WHEN THE INSTANTIATION IS ELABORATED MORE THAN ONCE BECAUSE
+-- OF RECURSIVE CALLS.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- TBN  9/23/86
+-- MRM  03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+PROCEDURE CB1005A IS
+
+     PROCEDURE PROP;
+
+     GENERIC
+          PACKAGE PAC IS
+               EXC : EXCEPTION;
+          END PAC;
+
+     GENERIC
+          PROCEDURE PROC (INST_AGAIN : BOOLEAN);
+
+     PROCEDURE PROC (INST_AGAIN : BOOLEAN) IS
+          EXC : EXCEPTION;
+     BEGIN
+          IF INST_AGAIN THEN
+               BEGIN
+                    PROP;
+                    FAILED ("EXCEPTION WAS NOT PROPAGATED - 9");
+               EXCEPTION
+                    WHEN EXC =>
+                         FAILED ("EXCEPTION NOT DISTINCT - 10");
+                    WHEN PROGRAM_ERROR | STORAGE_ERROR |
+                         TASKING_ERROR | CONSTRAINT_ERROR =>
+                         FAILED ("WRONG EXCEPTION PROPAGATED - 11");
+                    WHEN OTHERS =>
+                         NULL;
+               END;
+          ELSE
+               RAISE EXC;
+          END IF;
+     END PROC;
+
+     PROCEDURE RAISE_EXC (CALL_AGAIN : BOOLEAN) IS
+          PACKAGE PAC3 IS NEW PAC;
+     BEGIN
+          IF CALL_AGAIN THEN
+               BEGIN
+                    RAISE_EXC (FALSE);
+                    FAILED ("EXCEPTION WAS NOT PROPAGATED - 12");
+               EXCEPTION
+                    WHEN PAC3.EXC =>
+                         NULL;
+               END;
+          ELSE
+               RAISE PAC3.EXC;
+          END IF;
+     END RAISE_EXC;
+
+     PROCEDURE PROP IS
+          PROCEDURE PROC2 IS NEW PROC;
+     BEGIN
+          PROC2 (FALSE);
+     END PROP;
+
+BEGIN
+     TEST ("CB1005A", "CHECK THAT EXCEPTIONS DECLARED IN GENERIC " &
+                      "PACKAGES AND PROCEDURES ARE CONSIDERED " &
+                      "DISTINCT FOR EACH INSTANTIATION");
+
+     -------------------------------------------------------------------
+     DECLARE
+          PACKAGE PAC1 IS NEW PAC;
+          PACKAGE PAC2 IS NEW PAC;
+          PAC1_EXC_FOUND : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    RAISE PAC2.EXC;
+               END IF;
+               FAILED ("EXCEPTION WAS NOT RAISED - 1");
+
+          EXCEPTION
+               WHEN PAC1.EXC =>
+                    FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 2");
+                    PAC1_EXC_FOUND := TRUE;
+          END;
+          IF NOT PAC1_EXC_FOUND THEN
+               FAILED ("EXCEPTION WAS NOT PROPAGATED - 3");
+          END IF;
+
+     EXCEPTION
+          WHEN PAC1.EXC =>
+               FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 4");
+          WHEN PAC2.EXC =>
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RAISE PAC1.EXC;
+                    END IF;
+                    FAILED ("EXCEPTION WAS NOT RAISED - 5");
+
+               EXCEPTION
+                    WHEN PAC2.EXC =>
+                         FAILED ("PACKAGE EXCEPTIONS NOT DISTINCT - 6");
+                    WHEN PAC1.EXC =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNKNOWN EXCEPTION RAISED - 7");
+               END;
+          WHEN OTHERS =>
+               FAILED ("UNKNOWN EXCEPTION RAISED - 8");
+     END;
+
+     -------------------------------------------------------------------
+     DECLARE
+          PROCEDURE PROC1 IS NEW PROC;
+     BEGIN
+          PROC1 (TRUE);
+     END;
+
+     -------------------------------------------------------------------
+     BEGIN
+          RAISE_EXC (TRUE);
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTIONS ARE DISTINCT FOR RECURSION - 13");
+     END;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+END CB1005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1010a.ada
new file mode 100644
index 000000000..ac0a7793a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1010a.ada
@@ -0,0 +1,179 @@
+-- CB1010A.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 STORAGE_ERROR IS RAISED WHEN STORAGE ALLOCATED TO A TASK
+-- IS EXCEEDED.
+
+-- PNH 8/26/85
+-- JRK 8/30/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB1010A IS
+
+     N : INTEGER := IDENT_INT (1);
+     M : INTEGER := IDENT_INT (0);
+
+     PROCEDURE OVERFLOW_STACK IS
+          A : ARRAY (1 .. 1000) OF INTEGER;
+     BEGIN
+          N := N + M;
+          A (N) := M;
+          IF N > M THEN  -- ALWAYS TRUE.
+               OVERFLOW_STACK;
+          END IF;
+          M := A (N);    -- TO PREVENT TAIL RECURSION OPTIMIZATION.
+     END OVERFLOW_STACK;
+
+BEGIN
+     TEST ("CB1010A", "CHECK THAT STORAGE_ERROR IS RAISED WHEN " &
+                      "STORAGE ALLOCATED TO A TASK IS EXCEEDED");
+
+     --------------------------------------------------
+
+     COMMENT ("CHECK TASKS THAT DO NOT HANDLE STORAGE_ERROR " &
+              "PRIOR TO RENDEZVOUS");
+
+     DECLARE
+
+          TASK T1 IS
+               ENTRY E1;
+          END T1;
+
+          TASK BODY T1 IS
+          BEGIN
+               OVERFLOW_STACK;
+               FAILED ("TASK T1 NOT TERMINATED BY STACK OVERFLOW");
+          END T1;
+
+     BEGIN
+
+          T1.E1;
+          FAILED ("NO EXCEPTION RAISED BY ENTRY CALL T1.E1");
+
+     EXCEPTION
+          WHEN TASKING_ERROR =>
+               IF N /= 1 OR M /= 0 THEN
+                    FAILED ("VALUES OF VARIABLES N OR M ALTERED - 1");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY CALL OF ENTRY E1 " &
+                       "OF TERMINATED TASK T1");
+     END;
+
+     --------------------------------------------------
+
+     COMMENT ("CHECK TASKS THAT DO HANDLE STORAGE_ERROR PRIOR TO " &
+              "RENDEZVOUS");
+
+     N := IDENT_INT (1);
+     M := IDENT_INT (0);
+
+     DECLARE
+
+          TASK T2 IS
+               ENTRY E2;
+          END T2;
+
+          TASK BODY T2 IS
+          BEGIN
+               OVERFLOW_STACK;
+               FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW IN " &
+                       "TASK T2");
+          EXCEPTION
+               WHEN STORAGE_ERROR =>
+                    ACCEPT E2;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN TASK T2 BY " &
+                            "STACK OVERFLOW");
+          END T2;
+
+     BEGIN
+
+          T2.E2;
+          IF N /= 1 OR M /= 0 THEN
+               FAILED ("VALUES OF VARIABLES N OR M ALTERED - 2");
+          END IF;
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED BY ENTRY CALL T2.E2");
+               ABORT T2;
+     END;
+
+     --------------------------------------------------
+
+     COMMENT ("CHECK TASKS THAT DO NOT HANDLE STORAGE_ERROR " &
+              "DURING RENDEZVOUS");
+
+     N := IDENT_INT (1);
+     M := IDENT_INT (0);
+
+     DECLARE
+
+          TASK T3 IS
+               ENTRY E3A;
+               ENTRY E3B;
+          END T3;
+
+          TASK BODY T3 IS
+          BEGIN
+               ACCEPT E3A DO
+                    OVERFLOW_STACK;
+                    FAILED ("EXCEPTION NOT RAISED IN ACCEPT E3A BY " &
+                            "STACK OVERFLOW");
+               END E3A;
+               FAILED ("EXCEPTION NOT PROPOGATED CORRECTLY IN TASK T3");
+          EXCEPTION
+               WHEN STORAGE_ERROR =>
+                    ACCEPT E3B;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED IN TASK T3 BY " &
+                            "STACK OVERFLOW");
+          END T3;
+
+     BEGIN
+
+          T3.E3A;
+          FAILED ("NO EXCEPTION RAISED BY ENTRY CALL T3.E3A");
+
+     EXCEPTION
+          WHEN STORAGE_ERROR =>
+               T3.E3B;
+               IF N /= 1 OR M /= 0 THEN
+                    FAILED ("VALUES OF VARIABLES N OR M ALTERED - 3");
+               END IF;
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED BY ENTRY CALL T3.E3A " &
+                       "INSTEAD OF STORAGE_ERROR");
+               ABORT T3;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY ENTRY CALL T3.E3A");
+               ABORT T3;
+     END;
+
+     --------------------------------------------------
+
+     RESULT;
+END CB1010A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1010c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1010c.ada
new file mode 100644
index 000000000..bcd95041a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1010c.ada
@@ -0,0 +1,70 @@
+-- CB1010C.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 STORAGE_ERROR IS RAISED WHEN STORAGE FOR A DECLARATIVE
+-- ITEM IS INSUFFICIENT.
+
+-- JRK 8/30/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB1010C IS
+
+     N : INTEGER := IDENT_INT (1000);
+     M : INTEGER := IDENT_INT (0);
+
+     PROCEDURE OVERFLOW_STACK IS
+     BEGIN
+          N := N + M;
+          DECLARE
+               A : ARRAY (1 .. N) OF INTEGER;
+          BEGIN
+               A (N) := M;
+               IF N > M THEN  -- ALWAYS TRUE.
+                    OVERFLOW_STACK;
+               END IF;
+               M := A (N);    -- TO PREVENT TAIL RECURSION OPTIMIZATION.
+          END;
+     END OVERFLOW_STACK;
+
+BEGIN
+     TEST ("CB1010C", "CHECK THAT STORAGE_ERROR IS RAISED WHEN " &
+                      "STORAGE FOR A DECLARATIVE ITEM IS INSUFFICIENT");
+
+     BEGIN
+
+          OVERFLOW_STACK;
+          FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW");
+
+     EXCEPTION
+          WHEN STORAGE_ERROR =>
+               IF N /= 1000 OR M /= 0 THEN
+                    FAILED ("VALUES OF VARIABLES N OR M WERE ALTERED");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY STACK OVERFLOW");
+     END;
+
+     RESULT;
+END CB1010C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1010d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1010d.ada
new file mode 100644
index 000000000..e58046c85
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb1010d.ada
@@ -0,0 +1,92 @@
+-- CB1010D.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 STORAGE_ERROR IS RAISED WHEN STORAGE FOR THE EXECUTION OF
+-- A SUBPROGRAM IS INSUFFICIENT.
+
+-- PNH 8/26/85
+-- JRK 8/30/85
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB1010D IS
+
+     N : INTEGER := IDENT_INT (1);
+     M : INTEGER := IDENT_INT (0);
+
+     PROCEDURE OVERFLOW_STACK IS
+     BEGIN
+          N := N + M;
+          IF N > M THEN       -- ALWAYS TRUE.
+               OVERFLOW_STACK;
+          END IF;
+          N := N - M;         -- TO PREVENT TAIL RECURSION OPTIMIZATION.
+     END OVERFLOW_STACK;
+
+BEGIN
+     TEST ("CB1010D", "CHECK THAT STORAGE_ERROR IS RAISED WHEN " &
+                      "STORAGE FOR THE EXECUTION OF A SUBPROGRAM " &
+                      "IS INSUFFICIENT");
+
+     -- CHECK HANDLING OF STORAGE_ERROR IN MAIN PROGRAM.
+
+     BEGIN
+          OVERFLOW_STACK;
+          FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW - 1");
+     EXCEPTION
+          WHEN STORAGE_ERROR =>
+               IF N /= 1 THEN
+                    FAILED ("VALUE OF VARIABLE N ALTERED - 1");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED BY STACK OVERFLOW - 1");
+     END;
+
+     -- CHECK HANDLING OF STORAGE_ERROR IN SUBPROGRAM.
+
+     DECLARE
+
+          PROCEDURE P IS
+          BEGIN
+               OVERFLOW_STACK;
+               FAILED ("EXCEPTION NOT RAISED BY STACK OVERFLOW - 2");
+          EXCEPTION
+               WHEN STORAGE_ERROR =>
+                    IF N /= 1 THEN
+                         FAILED ("VALUE OF VARIABLE N ALTERED - 2");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED BY STACK " &
+                            "OVERFLOW - 2");
+          END P;
+
+     BEGIN
+
+          N := IDENT_INT (1);
+          P;
+
+     END;
+
+     RESULT;
+END CB1010D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20001.a
new file mode 100644
index 000000000..ccfad52e4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20001.a
@@ -0,0 +1,228 @@
+-- CB20001.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 exceptions can be handled in accept bodies, and that a
+--      task object that has an exception handled in an accept body is still
+--      viable for future use.
+--
+-- TEST DESCRIPTION:
+--      Declare a task that has exception handlers within an accept
+--      statement in the task body.  Declare a task object, and make entry
+--      calls with data that will cause various exceptions to be raised
+--      by the accept statement.  Ensure that the exceptions are: 
+--         1) raised and handled locally in the accept body
+--         2) raised in the accept body and handled/reraised to be handled 
+--            by the task body
+--         3) raised in the accept body and propagated to the calling 
+--            procedure. 
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+
+package CB20001_0 is               
+
+   Incorrect_Data,
+   Location_Error,
+   Off_Screen_Data           : exception;
+
+   TC_Handled_In_Accept,
+   TC_Reraised_In_Accept,
+   TC_Handled_In_Task_Block,
+   TC_Handled_In_Caller      : boolean := False;
+
+   type Location_Type is range 0 .. 2000;
+
+   task type Submarine_Type is
+      entry Contact (Location : in Location_Type);
+   end Submarine_Type;
+
+   Current_Position : Location_Type := 0;
+
+end CB20001_0;
+
+
+     --=================================================================--
+
+
+package body CB20001_0 is
+
+
+   task body Submarine_Type is
+   begin
+      loop
+
+         Task_Block:
+         begin
+            select
+               accept Contact (Location : in Location_Type) do
+                  if Location > 1000 then
+                     raise Off_Screen_Data;
+                  elsif (Location > 500) and (Location <= 1000) then
+                     raise Location_Error;
+                  elsif (Location > 100) and (Location <= 500) then
+                     raise Incorrect_Data;
+                  else
+                     Current_Position := Location;
+                  end if;
+               exception
+                  when Off_Screen_Data =>
+                     TC_Handled_In_Accept := True;
+                  when Location_Error =>
+                     TC_Reraised_In_Accept := True;
+                     raise;   -- Reraise the Location_Error exception
+                              -- in the task block.
+               end Contact;
+            or
+               terminate;
+            end select;
+
+         exception
+
+            when Off_Screen_Data =>
+                TC_Handled_In_Accept := False;
+                Report.Failed ("Off_Screen_Data exception " &
+                               "improperly handled in task block");
+
+            when Location_Error =>
+                TC_Handled_In_Task_Block := True;
+         end Task_Block;
+
+      end loop;
+
+   exception
+
+      when Location_Error | Off_Screen_Data =>
+         TC_Handled_In_Accept := False;
+         TC_Handled_In_Task_Block := False;
+         Report.Failed ("Exception improperly propagated out to task body"); 
+      when others =>
+         null;
+   end Submarine_Type;
+
+end CB20001_0;
+
+
+     --=================================================================--
+
+
+with CB20001_0;       
+with Report;
+with ImpDef;
+
+procedure CB20001 is
+
+   package Submarine_Tracking renames CB20001_0;
+
+   Trident       : Submarine_Tracking.Submarine_Type;   -- Declare task
+   Sonar_Contact : Submarine_Tracking.Location_Type;
+
+   TC_LEB_Error,
+   TC_Main_Handler_Used : Boolean := False;
+
+begin
+
+   Report.Test ("CB20001", "Check that exceptions can be handled " &
+                           "in accept bodies");
+
+
+   Off_Screen_Block:
+   begin
+      Sonar_Contact := 1500;
+      Trident.Contact (Sonar_Contact);  -- Cause Off_Screen_Data exception
+                                        -- to be raised and handled in a task 
+                                        -- accept body.
+   exception                            
+      when Submarine_Tracking.Off_Screen_Data =>
+          TC_Main_Handler_Used := True;
+          Report.Failed ("Off_Screen_Data exception improperly handled " &
+                         "in calling procedure");
+      when others =>
+          Report.Failed ("Exception handled unexpectedly in " &
+                         "Off_Screen_Block");
+   end Off_Screen_Block;
+
+
+   Location_Error_Block:
+   begin
+      Sonar_Contact := 700;
+      Trident.Contact (Sonar_Contact);  -- Cause Location_Error exception
+                                        -- to be raised in task accept body,
+                                        -- propogated to a task block, and
+                                        -- handled there.  Corresponding
+                                        -- exception propagated here also.
+      Report.Failed ("Expected exception not raised");
+   exception                            
+      when Submarine_Tracking.Location_Error =>
+          TC_LEB_Error := True;
+      when others =>
+          Report.Failed ("Exception handled unexpectedly in " &
+                         "Location_Error_Block");
+   end Location_Error_Block;
+
+
+   Incorrect_Data_Block:
+   begin
+      Sonar_Contact := 200;
+      Trident.Contact (Sonar_Contact);  -- Cause Incorrect_Data exception
+                                        -- to be raised in task accept body,
+                                        -- propogated to calling procedure.
+      Report.Failed ("Expected exception not raised");
+   exception                            
+      when Submarine_Tracking.Incorrect_Data =>
+          Submarine_Tracking.TC_Handled_In_Caller := True;
+      when others =>
+          Report.Failed ("Exception handled unexpectedly in " &
+                         "Incorrect_Data_Block");
+   end Incorrect_Data_Block;
+
+
+   if TC_Main_Handler_Used or
+      not (Submarine_Tracking.TC_Handled_In_Caller     and -- Check to see that
+           Submarine_Tracking.TC_Handled_In_Task_Block and -- all exceptions
+           Submarine_Tracking.TC_Handled_In_Accept     and -- were handled in
+           Submarine_Tracking.TC_Reraised_In_Accept    and -- proper locations.
+           TC_LEB_Error)       
+   then                                                    
+      Report.Failed ("Exceptions handled in incorrect locations");
+   end if;
+
+   if Integer(Submarine_Tracking.Current_Position) /= 0 then
+      Report.Failed ("Variable incorrectly written in task processing");
+   end if;
+
+   delay ImpDef.Minimum_Task_Switch;
+   if Trident'Callable then
+      Report.Failed ("Task didn't terminate with exception propagation");
+   end if;
+
+   Report.Result;
+
+end CB20001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20003.a
new file mode 100644
index 000000000..daaf9ffe5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20003.a
@@ -0,0 +1,286 @@
+-- CB20003.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 exceptions can be raised, reraised, and handled in an
+--      accessed subprogram.
+--
+--
+-- TEST DESCRIPTION:
+--      Declare a record type, with one component being an access to
+--      subprogram type.  Various subprograms are defined to fit the profile 
+--      of this access type, such that the record component can refer to 
+--      any of the subprograms.  
+--
+--      Each of the subprograms raises a different exception, based on the
+--      value of an input parameter.  Exceptions are 1) raised, handled with
+--      an others handler, reraised and propagated to main to be handled in
+--      a specific handler; 2) raised, handled in a specific handler, reraised 
+--      and propagated to the main to be handled in an others handler there,
+--      and 3) raised and propagated directly to the caller by the subprogram.
+--
+--      Boolean variables are set throughout the test to ensure that correct
+--      exception processing has occurred, and these variables are verified at
+--      the conclusion of the test.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CB20003_0 is                          -- package Push_Buttons 
+
+
+   Non_Default_Priority,
+   Non_Alert_Priority,
+   Non_Emergency_Priority : exception;
+
+   Handled_With_Others,
+   Reraised_In_Subprogram,
+   Handled_In_Caller      : Boolean := False;
+
+   subtype Priority_Type is Integer range 1 .. 10;
+
+   Default_Priority   : Priority_Type := 1;
+   Alert_Priority     : Priority_Type := 3;
+   Emergency_Priority : Priority_Type := 5;
+
+
+   type Button is tagged private;                  -- Private tagged type.
+
+   type Button_Response_Ptr is access procedure (P : in     Priority_Type;
+                                                 B : in out Button);
+
+
+   -- Procedures accessible with Button_Response_Ptr type.
+
+   procedure Default_Response   (P : in     Priority_Type;
+                                 B : in out Button);
+
+   procedure Alert_Response     (P : in     Priority_Type;
+                                 B : in out Button);
+
+   procedure Emergency_Response (P : in     Priority_Type;
+                                 B : in out Button);
+
+
+
+   procedure Push (B : in out Button;
+                   P : in     Priority_Type);
+
+   procedure Set_Response (B : in out Button;       
+                           R : in     Button_Response_Ptr);
+
+private
+
+   type Button is tagged                   
+      record
+         Priority :  Priority_Type       := Default_Priority;
+         Response :  Button_Response_Ptr := Default_Response'Access;   
+      end record;
+
+
+end CB20003_0;                                -- package Push_Buttons
+
+
+     --=================================================================--
+
+
+with Report;
+
+package body CB20003_0 is                     -- package Push_Buttons 
+
+
+   procedure Push (B : in out Button;
+                   P : in     Priority_Type) is
+   begin                                  -- Invoking subprogram designated 
+      B.Response (P, B);                  -- by access value.
+   end Push;
+
+
+   procedure Set_Response (B : in out Button;
+                           R : in     Button_Response_Ptr) is
+   begin
+      B.Response := R;      -- Set procedure value in record
+   end Set_Response;
+
+
+   procedure Default_Response (P : in     Priority_Type;
+                               B : in out Button) is
+   begin
+      if (P > Default_Priority) then
+         raise Non_Default_Priority;
+         Report.Failed ("Exception not raised in procedure body");
+      else
+         B.Priority := P;
+      end if;
+   exception
+      when others =>                    -- Catch exception with others handler
+         Handled_With_Others := True;   -- Successfully caught with "others"
+         raise;
+         Report.Failed ("Exception not reraised in handler");
+   end Default_Response;
+
+
+
+   procedure Alert_Response (P : in     Priority_Type;
+                             B : in out Button) is
+   begin
+      if (P > Alert_Priority) then
+         raise Non_Alert_Priority;
+         Report.Failed ("Exception not raised in procedure body");
+      else
+         B.Priority := P;
+      end if;
+   exception
+      when Non_Alert_Priority =>
+         Reraised_In_Subprogram := True;
+         raise;                                  -- Propagate to caller.
+         Report.Failed ("Exception not reraised in procedure excpt handler");
+      when others =>
+         Report.Failed ("Incorrect exception raised/handled");
+   end Alert_Response;
+
+
+
+   procedure Emergency_Response (P : in     Priority_type;
+                                 B : in out Button) is
+   begin
+      if (P > Emergency_Priority) then
+         raise Non_Emergency_Priority;
+         Report.Failed ("Exception not raised in procedure body");
+      else
+         B.Priority := P;
+      end if;
+      -- No exception handler here, exception will be propagated to caller.
+   end Emergency_Response;
+
+
+end CB20003_0;                                -- package Push_Buttons
+
+
+     --=================================================================--
+
+
+with Report;
+with CB20003_0;                               -- package Push_Buttons
+
+procedure CB20003 is
+      
+   package Push_Buttons renames CB20003_0;
+
+   Console_Button : Push_Buttons.Button;
+
+begin
+
+   Report.Test ("CB20003", "Check that exceptions can be raised, "  &
+                           "reraised, and handled in a subprogram " &
+                           "referenced by an access to subprogram value");
+
+
+   Default_Response_Processing:                 -- The exception
+                                                -- Handled_With_Others is to 
+                                                -- be caught with an others
+                                                -- handler in Default_Resp.,
+                                                -- reraised, and handled with
+                                                -- a specific handler here.
+   begin
+   
+      Push_Buttons.Push (Console_Button,        -- Raise exception that will
+                         Report.Ident_Int(2));  -- be handled in procedure.
+   exception
+      when Push_Buttons.Non_Default_Priority =>
+         if not Push_Buttons.Handled_With_Others then   -- Not reraised in 
+                                                        -- procedure.
+            Report.Failed 
+              ("Exception not handled/reraised in procedure");
+         end if;
+      when others =>
+         Report.Failed ("Exception handled in " &
+                        " Default_Response_Processing block");
+   end Default_Response_Processing;
+
+
+
+   Alert_Response_Processing:
+   begin
+   
+      Push_Buttons.Set_Response (Console_Button,
+                                 Push_Buttons.Alert_Response'access);
+
+      Push_Buttons.Push (Console_Button,        -- Raise exception that will
+                         Report.Ident_Int(4));  -- be handled in procedure, 
+                                                -- reraised, and propagated
+                                                -- to caller.
+      Report.Failed ("Exception not propagated to caller " &
+                     "in Alert_Response_Processing block");
+
+   exception                                    
+      when Push_Buttons.Non_Alert_Priority =>
+         if not Push_Buttons.Reraised_In_Subprogram then  -- Not reraised in 
+                                                          -- procedure.
+            Report.Failed ("Exception not reraised in procedure");
+         end if;
+      when others =>
+         Report.Failed ("Exception handled in " &
+                        " Alert_Response_Processing block");
+   end Alert_Response_Processing;
+
+
+
+   Emergency_Response_Processing:
+   begin
+   
+      Push_Buttons.Set_Response (Console_Button,
+                                 Push_Buttons.Emergency_Response'access);
+
+      Push_Buttons.Push (Console_Button,        -- Raise exception that will
+                         Report.Ident_Int(6));  -- be propagated directly to
+                                                -- caller.
+      Report.Failed ("Exception not propagated to caller " &
+                     "in Emergency_Response_Processing block");
+
+   exception                                   
+      when Push_Buttons.Non_Emergency_Priority =>
+         Push_Buttons.Handled_In_Caller := True;
+      when others =>
+         Report.Failed ("Exception handled in " &
+                        " Emergency_Response_Processing block");
+   end Emergency_Response_Processing;
+
+
+
+   if not (Push_Buttons.Handled_With_Others and
+           Push_Buttons.Reraised_In_Subprogram and
+           Push_Buttons.Handled_In_Caller ) 
+   then
+      Report.Failed ("Incorrect exception handling in referenced subprograms");
+   end if;
+
+
+   Report.Result;
+
+end CB20003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20004.a
new file mode 100644
index 000000000..42c0d7672
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20004.a
@@ -0,0 +1,203 @@
+-- CB20004.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 exceptions propagate correctly from objects of 
+--      protected types. Check propagation from protected entry bodies.
+--
+-- TEST DESCRIPTION:
+--      Declare a package with a protected type, including entries and private
+--      data, simulating a bounded buffer abstraction.  In the main procedure,
+--      perform entry calls on an object of the protected type that raises
+--      exceptions.
+--      Ensure that the exceptions are: 
+--         1) raised and handled locally in the entry body
+--         2) raised in the entry body and handled/reraised to be handled 
+--            by the caller.
+--         3) raised in the entry body and propagated directly to the calling 
+--            procedure. 
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CB20004_0 is               -- Package Buffer.
+
+   Max_Buffer_Size       : constant := 2;
+
+   Handled_In_Body,
+   Propagated_To_Caller,
+   Handled_In_Caller     : Boolean := False;
+
+   Data_Over_5,
+   Data_Degradation      : exception;
+
+   type Data_Item is range 0 .. 100;
+
+   type Item_Array_Type is array (1 .. Max_Buffer_Size) of Data_Item;
+
+   protected type Bounded_Buffer is
+      entry Put (Item : in     Data_Item);
+      entry Get (Item :    out Data_Item);
+   private
+      Item_Array : Item_Array_Type;
+      I, J       : Integer range 1 .. Max_Buffer_Size := 1;
+      Count      : Integer range 0 .. Max_Buffer_Size := 0;
+   end Bounded_Buffer;
+
+end CB20004_0;
+
+     --=================================================================--
+
+with Report;
+
+package body CB20004_0 is               -- Package Buffer.
+
+   protected body Bounded_Buffer is
+
+      entry Put (Item : in Data_Item) when Count < Max_Buffer_Size is
+      begin
+         if Item > 10 then
+            Item_Array (I) := Item * 8;  -- Constraint_Error will be raised
+         elsif Item > 5 then             -- and handled in entry body.
+            raise Data_Over_5;           -- Exception  handled/reraised in
+         else                            -- entry body, propagated to caller.
+            Item_Array (I) := Item;      -- Store data item in buffer.
+            I := (I mod Max_Buffer_Size) + 1;
+            Count := Count + 1;
+         end if;
+      exception
+         when Constraint_Error =>
+            Handled_In_Body := True;
+         when Data_Over_5 =>
+            Propagated_To_Caller := True;
+            raise;    -- Propagate the exception to the caller.
+      end Put;
+
+
+      entry Get (Item : out Data_Item) when Count > 0 is
+      begin
+         Item := Item_Array(J);
+         J := (J mod Max_Buffer_Size) + 1;
+         Count := Count - 1;
+         if Count = 0 then
+            raise Data_Degradation;   -- Exception to propagate to caller.
+         end if;
+      end Get;
+
+   end Bounded_Buffer;
+
+end CB20004_0;
+
+
+     --=================================================================--
+
+
+with CB20004_0;                   -- Package Buffer.
+with Report;
+
+procedure CB20004 is
+
+   package Buffer renames CB20004_0;
+
+   Data        : Buffer.Data_Item := Buffer.Data_Item'First;
+   Data_Buffer : Buffer.Bounded_Buffer;   -- an object of protected type.
+
+   Handled_In_Caller : Boolean := False;  -- same name as boolean declared 
+                                          -- in package Buffer.
+begin
+
+   Report.Test ("CB20004", "Check that exceptions propagate correctly " &
+                           "from objects of protected types" );
+
+   Initial_Data_Block:
+   begin                                    -- Data causes Constraint_Error.
+      Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(51)));
+
+   exception                                  
+      when Constraint_Error => 
+         Buffer.Handled_In_Body := False;     -- Improper exception handling
+                                              -- in entry body.
+         Report.Failed ("Exception propagated to caller " &
+                        " from Initial_Data_Block");
+      when others =>
+         Report.Failed ("Exception raised in processing and " &
+                        "propagated to caller from Initial_Data_Block");
+   end Initial_Data_Block;
+
+
+   Data_Entry_Block:
+   begin
+                                              -- Valid data. No exception.
+      Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(3)));  
+
+                                              -- Data will cause exception.
+      Data_Buffer.Put (7);                    -- Call protected object entry, 
+                                              -- exception to be handled/
+                                              -- reraised in entry body.
+      Report.Failed ("Data_Over_5 Exception not raised in processing");
+   exception
+      when Buffer.Data_Over_5 =>
+         if Buffer.Propagated_To_Caller then   -- Reraised in entry body?
+            Buffer.Handled_In_Caller := True;
+         else
+            Report.Failed ("Exception not reraised in entry body");
+         end if;
+      when others =>
+         Report.Failed ("Exception raised in processing and propagated " &
+                        "to caller from Data_Entry_Block");
+   end Data_Entry_Block;
+
+
+   Data_Retrieval_Block:
+   begin
+
+      Data_Buffer.Get (Data);  -- Retrieval of buffer data, buffer now empty.
+                               -- Exception will be raised in entry body, with
+                               -- propagation to caller.
+      Report.Failed ("Data_Degradation Exception not raised in processing");
+   exception
+      when Buffer.Data_Degradation =>
+         Handled_In_Caller := True;   -- Local Boolean used here.
+      when others =>
+         Report.Failed ("Exception raised in processing and propagated " &
+                        "to caller from Data_Retrieval_Block");
+   end Data_Retrieval_Block;
+
+
+   if not (Buffer.Handled_In_Body      and    -- Validate proper exception
+           Buffer.Propagated_To_Caller and    -- handling in entry bodies.
+           Buffer.Handled_In_Caller    and
+           Handled_In_Caller)
+   then
+      Report.Failed ("Improper exception handling by entry bodies");
+   end if;
+
+
+   Report.Result;
+
+end CB20004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20005.a
new file mode 100644
index 000000000..898d2a2c6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20005.a
@@ -0,0 +1,210 @@
+-- CB20005.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 exceptions are raised and properly handled locally in
+--      protected operations.
+--
+-- TEST DESCRIPTION:
+--      Declare a package with a protected type, including protected operation
+--      declarations and private data, simulating a counting semaphore.
+--      In the main procedure, perform calls on protected operations 
+--      of the protected object designed to induce the raising of exceptions.
+--
+--      Ensure that the exceptions are raised and handled locally in a 
+--      protected procedures and functions, and that in this case the 
+--      exceptions will not propagate to the calling unit.  Use specific 
+--      exception handlers in the protected functions.
+--
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CB20005_0 is               -- Package Semaphore.
+
+   Handled_In_Function,
+   Handled_In_Procedure : Boolean := False;
+
+   Resource_Overflow,
+   Resource_Underflow   : exception;
+
+   protected type Counting_Semaphore (Max_Resources : Integer) is
+      procedure Secure;
+      function  Resource_Limit_Exceeded return Boolean;
+      procedure Release;
+   private
+      Count : Integer := Max_Resources;
+   end Counting_Semaphore;
+
+end CB20005_0;
+
+     --=================================================================--
+
+with Report;
+
+package body CB20005_0 is               -- Package Semaphore.
+
+   protected body Counting_Semaphore is
+
+      procedure Secure is
+      begin
+         if (Count = 0) then               -- No resources left to secure.
+            raise Resource_Underflow;      
+            Report.Failed 
+              ("Program control not transferred by raise in Secure");
+         else
+            Count := Count - 1;             -- Avail resources decremented.
+         end if;                          
+      exception
+         when Resource_Underflow =>         -- Exception handled locally in
+            Handled_In_Procedure := True;   -- this protected operation.
+         when others =>
+            Report.Failed ("Unexpected exception raised in Secure");
+      end Secure;
+
+
+      function Resource_Limit_Exceeded return Boolean is
+      begin
+         if (Count > Max_Resources) then   
+            raise Resource_Overflow;       -- Exception used as control flow
+                                           -- mechanism.
+            Report.Failed 
+              ("Program control not transferred by raise in " &
+               "Resource_Limit_Exceeded");
+         else                              
+            return (False);
+         end if;
+      exception
+         when Resource_Overflow =>         -- Handle its own raised
+            Handled_In_Function := True;   -- exception.
+            return (True);                 
+         when others =>
+            Report.Failed 
+              ("Unexpected exception raised in Resource_Limit_Exceeded");
+      end Resource_Limit_Exceeded;
+
+
+      procedure Release is
+      begin
+         Count := Count + 1;               -- Count of resources available 
+                                           -- incremented.
+         if Resource_Limit_Exceeded then   -- Call to protected operation
+            Count := Count - 1;            -- function that raises/handles
+         end if;                           -- an exception.
+      exception
+         when Resource_Overflow =>
+            Handled_In_Function := False;
+            Report.Failed ("Exception propagated to Function Release");
+         when others =>
+            Report.Failed ("Unexpected exception raised in Function Release");
+      end Release;
+
+
+   end Counting_Semaphore;
+
+end CB20005_0;
+
+
+     --=================================================================--
+
+
+with CB20005_0;                           -- Package Semaphore.
+with Report;
+
+procedure CB20005 is
+begin
+
+   Report.Test ("CB20005", "Check that exceptions are raised and handled " &
+                           "correctly in protected operations" );
+
+   Test_Block:
+   declare
+
+      package Semaphore renames CB20005_0;
+
+      Total_Resources_Available : constant := 1;
+
+      Resources : Semaphore.Counting_Semaphore(Total_Resources_Available);
+                                          -- An object of protected type.
+
+   begin
+
+      Allocate_Resources:
+      declare
+         Loop_Count : Integer := Total_Resources_Available + 1;
+      begin
+         for I in 1..Loop_Count loop -- Force exception.
+            Resources.Secure;
+         end loop;
+      exception                                     
+         when Semaphore.Resource_Underflow =>
+            Semaphore.Handled_In_Procedure := False; -- Excptn not handled 
+            Report.Failed                            -- in prot. operation.
+              ("Resource_Underflow exception not handled " &
+               "in Allocate_Resources");
+         when others =>
+            Report.Failed 
+              ("Exception unexpectedly raised during resource allocation");
+      end Allocate_Resources;
+
+   
+      Deallocate_Resources:
+      declare
+         Loop_Count : Integer := Total_Resources_Available + 1;
+      begin
+         for I in 1..Loop_Count loop -- Force excptn.
+            Resources.Release;  
+         end loop;
+      exception                                     
+         when Semaphore.Resource_Overflow =>
+            Semaphore.Handled_In_Function := False; -- Exception not handled
+               Report.Failed                        -- in prot. operation.
+                 ("Resource overflow not handled by function");
+            when others =>
+               Report.Failed 
+                 ("Exception raised during resource deallocation"); 
+      end Deallocate_Resources;
+
+
+      if not (Semaphore.Handled_In_Procedure and -- Incorrect excpt. handling
+              Semaphore.Handled_In_Function)     -- in protected operations.
+      then
+         Report.Failed 
+           ("Improper exception handling by protected operations");
+      end if;
+
+
+   exception
+      when others =>
+         Report.Failed ("Exception raised and propagated in test");
+
+   end Test_Block;
+
+   Report.Result;
+
+end CB20005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20006.a
new file mode 100644
index 000000000..f2b3c70a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20006.a
@@ -0,0 +1,217 @@
+-- CB20006.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 exceptions are raised and properly handled (including 
+--      propagation by reraise) in protected operations.
+--
+-- TEST DESCRIPTION:
+--      Declare a package with a protected type, including protected operation
+--      declarations and private data, simulating a counting semaphore.
+--      In the main procedure, perform calls on protected operations 
+--      of the protected object designed to induce the raising of exceptions.
+--
+--      The exceptions raised are to be initially handled in the protected
+--      operations, but this handling involves the reraise of the exception
+--      and the propagation of the exception to the caller.
+--
+--      Ensure that the exceptions are raised, handled / reraised successfully
+--      in protected procedures and functions.  Use "others" handlers in the
+--      protected operations.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CB20006_0 is               -- Package Semaphore.
+
+   Reraised_In_Function,
+   Reraised_In_Procedure,
+   Handled_In_Function_Caller,
+   Handled_In_Procedure_Caller   : Boolean := False;
+
+   Resource_Overflow,
+   Resource_Underflow            : exception;
+
+   protected type Counting_Semaphore (Max_Resources : Integer) is
+      procedure Secure;
+      function  Resource_Limit_Exceeded return Boolean;
+      procedure Release;
+   private
+      Count : Integer := Max_Resources;
+   end Counting_Semaphore;
+
+end CB20006_0;
+
+     --=================================================================--
+
+with Report;
+
+package body CB20006_0 is                 -- Package Semaphore.
+
+   protected body Counting_Semaphore is
+
+      procedure Secure is
+      begin
+         if (Count = 0) then              -- No resources left to secure.
+            raise Resource_Underflow;      
+            Report.Failed 
+              ("Program control not transferred by raise in Procedure Secure");
+         else
+            Count := Count - 1;           -- Available resources decremented.
+         end if;                          
+      exception
+         when Resource_Underflow =>
+            Reraised_In_Procedure := True; 
+            raise;                        -- Exception propagated to caller.
+            Report.Failed ("Exception not propagated to caller from Secure");
+         when others =>
+            Report.Failed ("Unexpected exception raised in Secure");
+      end Secure;
+
+
+      function Resource_Limit_Exceeded return Boolean is
+      begin
+         if (Count > Max_Resources) then   
+            raise Resource_Overflow;      -- Exception used as control flow
+                                          -- mechanism.
+            Report.Failed 
+              ("Specific raise did not alter program control" &
+               " from Resource_Limit_Exceeded");
+         else                              
+            return (False);
+         end if;
+      exception
+         when others =>
+            Reraised_In_Function := True; 
+            raise;                         -- Exception propagated to caller.
+            Report.Failed ("Exception not propagated to caller" & 
+                           " from Resource_Limit_Exceeded");
+      end Resource_Limit_Exceeded;
+
+
+      procedure Release is
+      begin
+         Count := Count + 1;               -- Count of resources available 
+                                           -- incremented.
+         if Resource_Limit_Exceeded then   -- Call to protected operation
+            Count := Count - 1;            -- function that raises/reraises
+                                           -- an exception.
+            Report.Failed("Resource limit exceeded");
+         end if;                          
+
+      exception
+         when others =>
+            raise;                         -- Reraised and propagated again.
+             Report.Failed ("Exception not reraised by procedure Release");
+      end Release;
+
+
+   end Counting_Semaphore;
+
+end CB20006_0;
+
+
+     --=================================================================--
+
+
+with CB20006_0;                           -- Package Semaphore.
+with Report;
+
+procedure CB20006 is
+begin
+
+   Report.Test ("CB20006", "Check that exceptions are raised and " &
+                           "handled / reraised and propagated "    &
+                           "correctly by protected operations" );
+
+   Test_Block:
+   declare
+
+      package Semaphore renames CB20006_0;
+
+      Total_Resources_Available : constant := 1;
+
+      Resources : Semaphore.Counting_Semaphore (Total_Resources_Available);
+                                             -- An object of protected type.
+
+   begin
+
+      Allocate_Resources:
+      declare
+         Loop_Count : Integer := Total_Resources_Available + 1;
+      begin
+         for I in 1..Loop_Count loop -- Force exception
+            Resources.Secure;
+         end loop;
+         Report.Failed 
+           ("Exception not propagated from protected operation Secure");
+      exception                                     
+         when Semaphore.Resource_Underflow =>        -- Exception propagated
+           Semaphore.Handled_In_Procedure_Caller := True;  -- from protected
+         when others =>                                    -- procedure.
+           Semaphore.Handled_In_Procedure_Caller := False;
+      end Allocate_Resources;
+
+   
+      Deallocate_Resources:
+      declare
+         Loop_Count : Integer := Total_Resources_Available + 1;
+      begin
+         for I in 1..Loop_Count loop -- Force exception
+            Resources.Release;  
+         end loop;
+         Report.Failed 
+           ("Exception not propagated from protected operation Release");
+      exception                                     
+         when Semaphore.Resource_Overflow =>        -- Exception propagated 
+            Semaphore.Handled_In_Function_Caller := True; -- from protected
+         when others =>                                   -- function.
+            Semaphore.Handled_In_Function_Caller := False;
+      end Deallocate_Resources;
+
+
+      if not (Semaphore.Reraised_In_Procedure and
+              Semaphore.Reraised_In_Function  and
+              Semaphore.Handled_In_Procedure_Caller and
+              Semaphore.Handled_In_Function_Caller) 
+      then                                       -- Incorrect excpt. handling
+         Report.Failed                           -- in protected operations.
+           ("Improper exception handling/reraising by protected operations");
+      end if;
+
+   exception
+
+      when others =>
+         Report.Failed ("Unexpected exception " & 
+                        " raised and propagated in test");
+   end Test_Block;
+
+   Report.Result;
+
+
+end CB20006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20007.a
new file mode 100644
index 000000000..6d052517e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20007.a
@@ -0,0 +1,196 @@
+-- CB20007.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 exceptions are raised and can be directly propagated to
+--      the calling unit by protected operations.
+--
+-- TEST DESCRIPTION:
+--      Declare a package with a protected type, including protected operation
+--      declarations and private data, simulating a counting semaphore.
+--      In the main procedure, perform calls on protected operations 
+--      of the protected object designed to induce the raising of exceptions.
+--
+--      The exceptions raised are to be propagated directly from the protected
+--      operations to the calling unit. 
+--
+--      Ensure that the exceptions are raised and correctly propagated directly
+--      to the calling unit from protected procedures and functions.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CB20007_0 is               -- Package Semaphore.
+
+   Handled_In_Function_Caller,
+   Handled_In_Procedure_Caller : Boolean := False;
+
+   Resource_Overflow,
+   Resource_Underflow          : exception;
+
+   protected type Counting_Semaphore (Max_Resources : Integer) is
+      procedure Secure;
+      function  Resource_Limit_Exceeded return Boolean;
+      procedure Release;
+   private
+      Count : Integer := Max_Resources;
+   end Counting_Semaphore;
+
+end CB20007_0;
+
+     --=================================================================--
+
+with Report;
+
+package body CB20007_0 is                  -- Package Semaphore.
+
+   protected body Counting_Semaphore is
+
+      procedure Secure is
+      begin
+         if (Count = 0) then               -- No resources left to secure.
+            raise Resource_Underflow;      
+            Report.Failed ("Program control not transferred by raise");
+         else
+            Count := Count - 1;            -- Available resources decremented.
+         end if;                          
+         -- No exception handlers here, direct propagation to calling unit.
+      end Secure;
+
+
+      function Resource_Limit_Exceeded return Boolean is
+      begin
+         if (Count > Max_Resources) then   
+            raise Resource_Overflow;       -- Exception used as control flow
+                                           -- mechanism.
+            Report.Failed ("Program control not transferred by raise");
+         else                              
+            return (False);
+         end if;
+         -- No exception handlers here, direct propagation to calling unit.
+      end Resource_Limit_Exceeded;
+
+
+      procedure Release is
+      begin
+         Count := Count + 1;               -- Count of resources available 
+                                           -- incremented.
+         if Resource_Limit_Exceeded then   -- Call to protected operation
+            Count := Count - 1;            -- function that raises an
+                                           -- exception.
+            Report.Failed("Resource limit exceeded");
+         end if;                           
+         -- No exception handler here for exception raised in function.
+         -- Exception will propagate directly to calling unit.
+      end Release;
+
+
+   end Counting_Semaphore;
+
+end CB20007_0;
+
+
+     --=================================================================--
+
+
+with CB20007_0;                           -- Package Semaphore.
+with Report;
+
+procedure CB20007 is
+begin
+
+   Test_Block:
+   declare
+
+      package Semaphore renames CB20007_0;
+
+      Total_Resources_Available : constant := 1;
+
+      Resources : Semaphore.Counting_Semaphore (Total_Resources_Available);
+                                             -- An object of protected type.
+
+   begin
+
+      Report.Test ("CB20007", "Check that exceptions are raised and can "   &
+                              "be directly propagated to the calling unit " &
+                              "by protected operations" );
+
+      Allocate_Resources:
+      declare
+         Loop_Count : Integer := Total_Resources_Available + 1;
+      begin                                   -- Force exception.
+         for I in 1..Loop_Count loop  
+            Resources.Secure;
+         end loop;
+         Report.Failed ("Exception not propagated from protected " &
+                        " operation in Allocate_Resources");
+      exception                                     
+         when Semaphore.Resource_Underflow =>              -- Exception prop.
+            Semaphore.Handled_In_Procedure_Caller := True; -- from protected
+                                                           -- procedure.
+         when others =>
+            Report.Failed ("Unknown exception during resource allocation");
+      end Allocate_Resources;
+
+   
+      Deallocate_Resources:
+      declare
+         Loop_Count : Integer := Total_Resources_Available + 1;
+      begin                                   -- Force exception.
+         for I in 1..Loop_Count loop  
+            Resources.Release;  
+         end loop;
+         Report.Failed ("Exception not propagated from protected " &
+                        "operation in Deallocate_Resources");
+      exception                                     
+         when Semaphore.Resource_Overflow =>              -- Exception prop
+            Semaphore.Handled_In_Function_Caller := True; -- from protected
+                                                          -- function.
+         when others =>
+            Report.Failed ("Exception raised during resource deallocation");
+      end Deallocate_Resources;
+
+
+      if not (Semaphore.Handled_In_Procedure_Caller and -- Incorrect exception
+              Semaphore.Handled_In_Function_Caller)     -- handling in
+      then                                              -- protected ops.
+          Report.Failed                                 
+            ("Improper exception propagation by protected operations");
+      end if;
+
+   exception
+
+      when others =>
+         Report.Failed ("Unexpected exception " &
+                        " raised and propagated in test");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CB20007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2004a.ada
new file mode 100644
index 000000000..e16aeb5d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2004a.ada
@@ -0,0 +1,245 @@
+-- CB2004A.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 PREDEFINED OR A PROGRAMMER DEFINED EXCEPTION
+--    RAISED SEVERAL LEVELS INSIDE A HIERARCHY OF NESTED BLOCKS
+--    CAN BE SUCCESSFULLY HANDLED IN AN OUTER BLOCK.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- DCB 5/12/80
+-- JRK 11/17/80
+-- SPS 11/2/82
+-- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT;
+PROCEDURE CB2004A IS
+
+     USE REPORT;
+
+     FLOW_COUNT : INTEGER := 0;
+
+     E1, E2, E3 : EXCEPTION;
+
+BEGIN
+     TEST("CB2004A","CHECK THAT EXCEPTIONS RAISED INSIDE NESTED " &
+          "BLOCKS CAN BE HANDLED IN OUTER BLOCKS");
+
+     BEGIN
+
+          -- PROGRAMMER-DEFINED EXCEPTION, SINGLE EXCEPTON_CHOICE.
+
+          BEGIN
+               BEGIN
+                    BEGIN
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE E1;
+                         FAILED("PROGRAMMER-DEFINED EXCEPTION " &
+                                "NOT RAISED  #1");
+
+                    EXCEPTION
+                         WHEN E2 | E3 =>
+                              FAILED("WRONG PROGRAMMER-" &
+                                     "DEFINED EXCEPTION HANDLED   #1");
+                    END;
+
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR |
+                         PROGRAM_ERROR | STORAGE_ERROR |
+                         TASKING_ERROR | E2 | E3     =>
+                         FAILED("WRONG  " &
+                                "EXCEPTION HANDLED   #1");
+               END;
+
+          EXCEPTION
+               WHEN E1 =>
+                    FLOW_COUNT := FLOW_COUNT + 1;
+          END;
+
+          -- PROGRAMMER-DEFINED EXCEPTION, MULTIPLE EXCEPTION_CHOICES.
+
+          BEGIN
+               BEGIN
+                    BEGIN
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE E2;
+                         FAILED("PROGRAMMER-DEFINED EXCEPTION " &
+                                "NOT RAISED  #2");
+
+                    EXCEPTION
+                         WHEN E1 | E3 =>
+                              FAILED("WRONG PROGRAMMER-" &
+                                     "DEFINED EXCEPTION HANDLED   #2");
+                    END;
+
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR |
+                         PROGRAM_ERROR | STORAGE_ERROR |
+                         TASKING_ERROR | E1 | E3     =>
+                         FAILED("WRONG  " &
+                                "EXCEPTION HANDLED   #2");
+               END;
+
+          EXCEPTION
+               WHEN E3 =>
+                    FAILED("WRONG EXCEPTION HANDLED  #2A");
+               WHEN E1 | E2 | CONSTRAINT_ERROR =>
+                    FLOW_COUNT := FLOW_COUNT + 1;
+          END;
+
+          -- PROGRAMMER-DEFINED EXCEPTION, 'OTHERS' CHOICE.
+
+          BEGIN
+               BEGIN
+                    BEGIN
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE E1;
+                         FAILED("PROGRAMMER-DEFINED EXCEPTION " &
+                                "NOT RAISED  #3");
+
+                    EXCEPTION
+                         WHEN E2 | E3 =>
+                              FAILED("WRONG PROGRAMMER-" &
+                                     "DEFINED EXCEPTION HANDLED   #3");
+                    END;
+
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR |
+                         PROGRAM_ERROR | STORAGE_ERROR |
+                         TASKING_ERROR | E2 | E3   =>
+                         FAILED("WRONG " &
+                                "EXCEPTION HANDLED   #3");
+               END;
+
+          EXCEPTION
+               WHEN E2 | CONSTRAINT_ERROR =>
+                    FAILED("WRONG EXCEPTION HANDLED  #3A");
+               WHEN OTHERS =>
+                    FLOW_COUNT := FLOW_COUNT + 1;
+          END;
+
+          -- PREDEFINED EXCEPTION, SINGLE EXCEPTION_CHOICE.
+
+          BEGIN
+               BEGIN
+                    BEGIN
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE CONSTRAINT_ERROR;
+                         FAILED("PREDEFINED EXCEPTION NOT RAISED  #4");
+
+                    EXCEPTION
+                         WHEN E1 | E2 | E3 =>
+                              FAILED("WRONG " &
+                                     "EXCEPTION HANDLED   #4");
+                    END;
+
+               EXCEPTION
+                    WHEN PROGRAM_ERROR | STORAGE_ERROR |
+                         TASKING_ERROR     =>
+                         FAILED("WRONG PREDEFINED " &
+                                "EXCEPTION HANDLED   #4");
+               END;
+
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FLOW_COUNT := FLOW_COUNT + 1;
+          END;
+
+          -- PREDEFINED EXCEPTION, MULTIPLE EXCEPTION_CHOICES.
+
+          BEGIN
+               BEGIN
+                    BEGIN
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE CONSTRAINT_ERROR;
+                         FAILED("PREDEFINED EXCEPTION NOT RAISED  #5");
+
+                    EXCEPTION
+                         WHEN E1 | E2 | E3 =>
+                              FAILED("WRONG " &
+                                     "EXCEPTION HANDLED   #5");
+                    END;
+
+               EXCEPTION
+                    WHEN PROGRAM_ERROR | 
+                         STORAGE_ERROR | TASKING_ERROR     =>
+                         FAILED("WRONG PREDEFINED " &
+                                "EXCEPTION HANDLED   #5");
+               END;
+
+          EXCEPTION
+               WHEN E1 | E2 =>
+                    FAILED("WRONG EXCEPTION HANDLED  #5A");
+               WHEN CONSTRAINT_ERROR | E3 =>
+                    FLOW_COUNT := FLOW_COUNT + 1;
+          END;
+
+          -- PREDEFINED EXCEPTION, 'OTHERS' CHOICE.
+
+          BEGIN
+               BEGIN
+                    BEGIN
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE CONSTRAINT_ERROR;
+                         FAILED("PREDEFINED EXCEPTION NOT RAISED  #6");
+
+                    EXCEPTION
+                         WHEN E1 | E2 | E3 =>
+                              FAILED("WRONG " &
+                                     " EXCEPTION HANDLED   #6");
+                    END;
+
+               EXCEPTION
+                    WHEN PROGRAM_ERROR | STORAGE_ERROR |
+                         TASKING_ERROR     =>
+                         FAILED("WRONG PREDEFINED " &
+                                "EXCEPTION HANDLED   #6");
+               END;
+
+          EXCEPTION
+               WHEN E1 =>
+                    FAILED("WRONG EXCEPTION HANDLED  #6A");
+               WHEN OTHERS =>
+                    FLOW_COUNT := FLOW_COUNT + 1;
+          END;
+
+     EXCEPTION
+          WHEN E1 | E2 | E3 =>
+               FAILED("PROGRAMMER-DEFINED EXCEPTION HANDLED IN" &
+                      "WRONG SCOPE");
+          WHEN CONSTRAINT_ERROR =>
+               FAILED("CONSTRAINT_ERROR HANDLED IN WRONG SCOPE");
+          WHEN OTHERS =>
+               FAILED("OTHER EXCEPTIONS HANDLED IN WRONG SCOPE");
+     END;
+
+     IF FLOW_COUNT /= 12 THEN
+          FAILED("INCORRECT FLOW_COUNT VALUE");
+     END IF;
+
+     RESULT;
+END CB2004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2005a.ada
new file mode 100644
index 000000000..64ac5a786
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2005a.ada
@@ -0,0 +1,77 @@
+-- CB2005A.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 RETURN STATEMENT CAN APPEAR IN AN EXCEPTION HANDLER
+-- AND IT CAUSES CONTROL TO LEAVE THE SUBPROGRAM, FOR BOTH
+-- FUNCTIONS AND PROCEDURES.
+
+-- DAT 4/13/81
+-- JRK 4/24/81
+-- SPS 10/26/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB2005A IS
+
+     I : INTEGER RANGE 0 .. 1;
+
+     FUNCTION SETI RETURN INTEGER IS
+     BEGIN
+          I := I + 1;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED 1");
+          RETURN 0;
+     EXCEPTION
+          WHEN OTHERS =>
+               RETURN I;
+               FAILED ("FUNCTION RETURN STMT DID NOT RETURN");
+               RETURN 0;
+     END SETI;
+
+     PROCEDURE ISET IS
+     BEGIN
+          I := 2;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED 2");
+          I := 0;
+     EXCEPTION
+          WHEN OTHERS => 
+               RETURN;
+               FAILED ("PROCEDURE RETURN STMT DID NOT RETURN");
+     END ISET;
+
+BEGIN
+     TEST ("CB2005A", "RETURN IN EXCEPTION HANDLERS");
+
+     I := 1;
+     IF SETI /= 1 THEN
+          FAILED ("WRONG VALUE RETURNED 1");
+     END IF;
+
+     I := 1;
+     ISET;
+     IF I /= 1 THEN
+          FAILED ("WRONG VALUE RETURNED 2");
+     END IF;
+
+     RESULT;
+END CB2005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2006a.ada
new file mode 100644
index 000000000..b4da0e2cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2006a.ada
@@ -0,0 +1,70 @@
+-- CB2006A.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 LOCAL VARIABLES AND PARAMETERS OF A SUBPROGRAM,
+-- OR PACKAGE ARE ACCESSIBLE WITHIN A HANDLER.
+
+-- DAT 4/13/81
+-- SPS 3/23/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB2006A IS
+
+     I : INTEGER RANGE 0 .. 1;
+
+     PACKAGE P IS
+          V2 : INTEGER := 2;
+     END P;
+
+     PROCEDURE PR (J : IN OUT INTEGER) IS
+          K : INTEGER := J;
+     BEGIN
+          I := K;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED 1");
+     EXCEPTION
+          WHEN OTHERS =>
+               J := K + 1;
+     END PR;
+
+     PACKAGE BODY P IS
+          L : INTEGER := 2;
+     BEGIN
+          TEST ("CB2006A", "LOCAL VARIABLES ARE ACCESSIBLE IN"
+               & " HANDLERS");
+
+          I := 1;
+          I := I + 1;
+          FAILED ("CONSTRAINT_ERROR NOT RAISED 2");
+     EXCEPTION
+          WHEN OTHERS =>
+               PR (L);
+               IF L /= V2 + 1 THEN
+                    FAILED ("WRONG VALUE IN LOCAL VARIABLE");
+               END IF;
+     END P;
+BEGIN
+
+     RESULT;
+END CB2006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2007a.ada
new file mode 100644
index 000000000..01e12d834
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb2007a.ada
@@ -0,0 +1,104 @@
+-- CB2007A.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 EXIT STATEMENT IN A HANDLER CAN TRANSFER CONTROL
+-- OUT OF A LOOP.
+
+-- DAT 4/13/81
+--  RM 4/30/81
+-- SPS 3/23/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB2007A IS
+BEGIN
+     TEST ("CB2007A", "EXIT STATEMENTS IN EXCEPTION HANDLERS");
+
+     DECLARE
+          FLOW_INDEX : INTEGER := 0 ;
+     BEGIN
+
+          FOR I IN 1 .. 10 LOOP
+               BEGIN
+                    IF I = 1 THEN
+                         RAISE CONSTRAINT_ERROR;
+                    END IF;
+                    FAILED ("WRONG CONTROL FLOW 1");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR => EXIT;
+               END;
+               FAILED ("WRONG CONTROL FLOW 2");
+               EXIT;
+          END LOOP;
+
+          FOR AAA IN 1..1 LOOP
+               FOR BBB IN 1..1 LOOP
+                    FOR I IN 1 .. 10 LOOP
+                         BEGIN
+                              IF I = 1 THEN
+                                   RAISE CONSTRAINT_ERROR;
+                              END IF;
+                              FAILED ("WRONG CONTROL FLOW A1");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR => EXIT;
+                         END;
+                         FAILED ("WRONG CONTROL FLOW A2");
+                         EXIT;
+                    END LOOP;
+
+                    FLOW_INDEX := FLOW_INDEX + 1 ;
+               END LOOP;
+          END LOOP;
+
+          LOOP1 :
+          FOR AAA IN 1..1 LOOP
+               LOOP2 :
+               FOR BBB IN 1..1 LOOP
+                    LOOP3 :
+                    FOR I IN 1 .. 10 LOOP
+                         BEGIN
+                              IF I = 1 THEN
+                                   RAISE CONSTRAINT_ERROR;
+                              END IF;
+                              FAILED ("WRONG CONTROL FLOW B1");
+                         EXCEPTION
+                              WHEN CONSTRAINT_ERROR => EXIT LOOP2 ;
+                         END;
+                         FAILED ("WRONG CONTROL FLOW B2");
+                         EXIT LOOP2 ;
+                    END LOOP  LOOP3 ;
+
+                    FAILED ("WRONG CONTROL FLOW B3");
+               END LOOP  LOOP2 ;
+
+               FLOW_INDEX := FLOW_INDEX + 1 ;
+          END LOOP  LOOP1 ;
+
+          IF  FLOW_INDEX /= 2  THEN  FAILED( "WRONG FLOW OF CONTROL" );
+          END IF;
+
+     END ;
+
+     RESULT;
+END CB2007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20a02.a
new file mode 100644
index 000000000..4c8537086
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb20a02.a
@@ -0,0 +1,155 @@
+-- CB20A02.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 name and pertinent information about a user defined
+--      exception are available to an enclosing program unit even when the 
+--      enclosing unit has no visibility into the scope where the exception
+--      is declared and raised.
+--
+-- TEST DESCRIPTION:
+--      Declare a subprogram nested within the test subprogram.  The enclosing 
+--      subprogram does not have visibility into the nested subprogram.
+--      Declare and raise an exception in the nested subprogram, and allow
+--      the exception to propagate to the enclosing scope.  Use the function
+--      Exception_Name in the enclosing subprogram to produce exception 
+--      specific information when the exception is handled in an others 
+--      handler.
+--
+-- TEST FILES:
+--
+--      This test depends on the following foundation code file:
+--         FB20A00.A
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FB20A00;             -- Package containing Function Find
+with Ada.Exceptions;
+with Report;
+
+procedure CB20A02 is
+
+   Seed_Number   : Integer;
+   Random_Number : Integer := 0;
+
+     --=================================================================--
+
+   function Random_Number_Generator (Seed : Integer) return Integer is
+
+      Result : Integer := 0;
+
+      HighSeedError,
+      Mid_Seed_Error,
+      L_o_w_S_e_e_d_E_r_r_o_r : exception;
+
+   begin  -- Random_Number_Generator
+
+
+      if (Report.Ident_Int (Seed)    > 1000) then
+         raise HighSeedError;
+      elsif (Report.Ident_Int (Seed) >  100) then
+         raise Mid_Seed_Error;
+      elsif (Report.Ident_Int (Seed) >   10) then
+         raise L_o_w_S_e_e_d_E_r_r_o_r;
+      else
+         Seed_Number := ((Seed_Number * 417) + 231) mod 53;
+         Result := Seed_Number / 52;
+      end if;
+
+      return Result;
+
+   end Random_Number_Generator;
+
+     --=================================================================--
+
+begin
+
+   Report.Test ("CB20A02", "Check that the name "                        &
+                           "of a user defined exception is available "   &
+                           "to an enclosing program unit even when the " &
+                           "enclosing unit has no visibility into the "  &
+                           "scope where the exception is declared and "  &
+                           "raised" );
+
+   High_Seed:
+   begin
+      -- This seed value will result in the raising of a HighSeedError
+      -- exception.
+      Seed_Number   := 1001;
+      Random_Number := Random_Number_Generator (Seed_Number);
+      Report.Failed ("Exception not raised in High_Seed block");
+   exception
+      when Error : others =>
+         if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
+                              "HighSeedError")
+         then
+            Report.Failed ("Expected HighSeedError, but found " &
+                            Ada.Exceptions.Exception_Name (Error));
+         end if;
+   end High_Seed;
+
+
+   Mid_Seed:
+   begin        
+      -- This seed value will generate a Mid_Seed_Error exception.
+      Seed_Number   := 101;
+      Random_Number := Random_Number_Generator (Seed_Number);
+      Report.Failed ("Exception not raised in Mid_Seed block");
+   exception
+      when Error : others =>
+         if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
+                              "Mid_Seed_Error")
+         then
+            Report.Failed ("Expected Mid_Seed_Error, but found " &
+                            Ada.Exceptions.Exception_Name (Error));
+         end if;
+   end Mid_Seed;
+
+
+   Low_Seed:
+   begin
+      -- This seed value will result in the raising of a
+      -- L_o_w_S_e_e_d_E_r_r_o_r exception.
+      Seed_Number   := 11;
+      Random_Number := Random_Number_Generator (Seed_Number);
+      Report.Failed ("Exception not raised in Low_Seed block");
+   exception
+      when Error : others =>
+         if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
+                              "L_o_w_S_e_e_d_E_r_r_o_r")
+         then
+            Report.Failed ("Expected L_o_w_S_e_e_d_E_r_r_o_r but found " &
+                            Ada.Exceptions.Exception_Name (Error));
+         end if;
+   end Low_Seed;
+
+
+   Report.Result;
+
+end CB20A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb3003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb3003a.ada
new file mode 100644
index 000000000..3acdd2eda
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb3003a.ada
@@ -0,0 +1,164 @@
+-- CB3003A.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 NON-SPECIFIC RAISE STATEMENT PROPAGATES THE EXCEPTION
+--    FOR FURTHER PROCESSING(HANDLING) IN ANOTHER HANDLER.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- DCB 04/01/80
+-- JRK 11/19/80
+-- SPS 11/2/82
+-- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT;
+PROCEDURE CB3003A IS
+
+     USE REPORT;
+
+     FLOW_COUNT : INTEGER := 0;
+     E1,E2 : EXCEPTION;
+
+BEGIN
+     TEST("CB3003A","CHECK THAT THE NON-SPECIFIC RAISE STATEMENT" &
+          " PROPAGATES THE ERROR FOR FURTHER HANDLING IN ANOTHER" &
+          " HANDLER");
+
+     -------------------------------------------------------
+
+     BEGIN
+          BEGIN
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 1;
+                    RAISE E1;
+                    FAILED("EXCEPTION NOT RAISED (CASE 1)");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE;
+                         FAILED("EXCEPTION NOT RERAISED (CASE 1; " &
+                                "INNER)");
+               END;
+
+          EXCEPTION
+          -- A HANDLER SPECIFIC TO THE RAISED EXCEPTION (E1).
+               WHEN E1 =>
+                    FLOW_COUNT := FLOW_COUNT + 1;
+                    RAISE;
+                    FAILED("EXCEPTION NOT RERAISED (CASE 1; OUTER)");
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED (CASE 1)");
+          END;
+
+     EXCEPTION
+          WHEN E1 =>
+               FLOW_COUNT := FLOW_COUNT + 1;
+          WHEN OTHERS =>
+               FAILED("WRONG EXCEPTION PASSED (CASE 1)");
+     END;
+
+     -------------------------------------------------------
+
+     BEGIN
+          BEGIN
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 1;
+                    RAISE E1;
+                    FAILED("EXCEPTION NOT RAISED (CASE 2)");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE;
+                         FAILED("EXCEPTION NOT RERAISED (CASE 2; " &
+                                "INNER)");
+               END;
+
+          EXCEPTION
+          -- A HANDLER FOR SEVERAL EXCEPTIONS INCLUDING THE ONE RAISED.
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED("WRONG EXCEPTION RAISED (CONSTRAINT_ERROR)");
+               WHEN E2 =>
+                    FAILED("WRONG EXCEPTION RAISED (E2)");
+               WHEN PROGRAM_ERROR | E1 | TASKING_ERROR =>
+                    FLOW_COUNT := FLOW_COUNT + 1;
+                    RAISE;
+                    FAILED("EXCEPTION NOT RERAISED (CASE 2; OUTER)");
+               WHEN STORAGE_ERROR =>
+                    FAILED("WRONG EXCEPTION RAISED (STORAGE_ERROR)");
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED (OTHERS)");
+          END;
+
+     EXCEPTION
+          WHEN E1 =>
+               FLOW_COUNT := FLOW_COUNT + 1;
+          WHEN OTHERS =>
+               FAILED("WRONG EXCEPTION PASSED (CASE 2)");
+     END;
+
+     -------------------------------------------------------
+
+     BEGIN
+          BEGIN
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 1;
+                    RAISE E1;
+                    FAILED("EXCEPTION NOT RAISED (CASE 3)");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE;
+                         FAILED("EXCEPTION NOT RERAISED (CASE 3; " &
+                                "INNER)");
+               END;
+
+          EXCEPTION
+          -- A NON-SPECIFIC HANDLER.
+               WHEN CONSTRAINT_ERROR | E2 =>
+                    FAILED("WRONG EXCEPTION RAISED " &
+                           "(CONSTRAINT_ERROR | E2)");
+               WHEN OTHERS =>
+                    FLOW_COUNT := FLOW_COUNT + 1;
+                    RAISE;
+                    FAILED("EXCEPTION NOT RERAISED (CASE 3; OUTER)");
+          END;
+
+     EXCEPTION
+          WHEN E1 =>
+               FLOW_COUNT := FLOW_COUNT + 1;
+          WHEN OTHERS =>
+               FAILED("WRONG EXCEPTION PASSED (CASE 3)");
+     END;
+
+     -------------------------------------------------------
+
+     IF FLOW_COUNT /= 12 THEN
+          FAILED("INCORRECT FLOW_COUNT VALUE");
+     END IF;
+
+     RESULT;
+END CB3003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb3003b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb3003b.ada
new file mode 100644
index 000000000..460670f03
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb3003b.ada
@@ -0,0 +1,135 @@
+-- CB3003B.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 NON-EXPLICIT RAISE STATEMENT MAY APPEAR IN A BLOCK
+-- STATEMENT WITHIN AN EXCEPTION HANDLER; IF THE BLOCK STATEMENT
+-- INCLUDES A HANDLER FOR THE CURRENT EXCEPTION, THEN THE INNER
+-- HANDLER RECEIVES CONTROL.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- L.BROWN  10/08/86
+-- MRM  03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  CB3003B  IS
+
+     MY_ERROR : EXCEPTION;
+
+BEGIN
+     TEST("CB3003B","A NON-EXPLICIT RAISE STATEMENT MAY APPEAR IN A "&
+                    "BLOCK STATEMENT WITHIN AN EXCEPTION HANDLER");
+
+     BEGIN
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RAISE MY_ERROR;
+               END IF;
+               FAILED("MY_ERROR WAS NOT RAISED 1");
+          EXCEPTION
+               WHEN MY_ERROR =>
+                    BEGIN
+                         IF EQUAL(3,3) THEN
+                              RAISE;
+                         END IF;
+                         FAILED("MY_ERROR WAS NOT RAISED 2");
+                    EXCEPTION
+                         WHEN MY_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("WRONG EXCEPTION RAISED 1");
+                    END;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED 2");
+          END;
+     EXCEPTION
+          WHEN MY_ERROR =>
+               FAILED("CONTROL PASSED TO OUTER HANDLER 1");
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED 1");
+     END;
+
+     BEGIN
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RAISE MY_ERROR;
+               END IF;
+               FAILED("MY_ERROR WAS NOT RAISED 3");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR | MY_ERROR | TASKING_ERROR =>
+                    BEGIN
+                         IF EQUAL(3,3) THEN
+                              RAISE;
+                         END IF;
+                         FAILED("MY_ERROR WAS NOT RAISED 4");
+                    EXCEPTION
+                         WHEN MY_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("WRONG EXCEPTION RAISED 3");
+                    END;
+               WHEN OTHERS =>
+                    FAILED("WRONG EXCEPTION RAISED 4");
+          END;
+     EXCEPTION
+          WHEN MY_ERROR =>
+               FAILED("CONTROL PASSED TO OUTER HANDLER 2");
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED 2");
+     END;
+
+     BEGIN
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RAISE MY_ERROR;
+               END IF;
+               FAILED("MY_ERROR WAS NOT RAISED 5");
+          EXCEPTION
+               WHEN OTHERS =>
+                    BEGIN
+                         IF EQUAL(3,3) THEN
+                              RAISE;
+                         END IF;
+                         FAILED("MY_ERROR WAS NOT RAISED 6");
+                    EXCEPTION
+                         WHEN MY_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("WRONG EXCEPTION RAISED 5");
+                    END;
+          END;
+     EXCEPTION
+          WHEN MY_ERROR =>
+               FAILED("CONTROL PASSED TO OUTER HANDLER 3");
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION RAISED 3");
+     END;
+
+     RESULT;
+
+END CB3003B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb3004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb3004a.ada
new file mode 100644
index 000000000..b089bc255
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb3004a.ada
@@ -0,0 +1,145 @@
+-- CB3004A.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 WHEN AN INNER UNIT REDECLARES AN EXCEPTION NAME
+--    THE HIDDEN DEFINITION IS STILL AVAILABLE FOR USE.
+
+--  NOTE : WE ASSUME FUNCTIONS ACT LIKE PROCEDURES AND
+--  THAT UNITS, BLOCKS, AND PROCEDURES ACT THE SAME
+--  IN OTHER CONTEXTS (E.G. TASKS AND PACKAGES).
+
+-- DCB 6/2/80
+-- JRK 11/19/80
+-- SPS 3/24/83
+
+WITH REPORT;
+PROCEDURE CB3004A IS
+
+     USE REPORT;
+
+     E1 : EXCEPTION;
+     FLOW_COUNT : INTEGER := 0;
+
+     PROCEDURE P1 IS
+          E1, E2 : EXCEPTION;
+
+          PROCEDURE P2 IS
+               E1 : EXCEPTION;
+          BEGIN
+               FLOW_COUNT := FLOW_COUNT + 1;
+               RAISE E1;
+               FAILED("E1 EXCEPTION NOT RAISED");
+          EXCEPTION
+               WHEN P1.E1 =>
+                    FAILED("P1.E1 EXCEPTION RAISED WHEN " &
+                           "(P2)E1 EXPECTED");
+               WHEN E1 =>
+                    BEGIN
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE P1.E1;
+                         FAILED("P1.E1 EXCEPTION NOT RAISED");
+                    EXCEPTION
+                         WHEN E1 =>
+                              FAILED("(P2)E1 EXCEPTION RAISED WHEN" &
+                                     " P1.E1 EXPECTED");
+                         WHEN P1.E1 =>
+                              FLOW_COUNT := FLOW_COUNT + 1;
+                         WHEN OTHERS =>
+                              FAILED("OTHERS RAISED WHEN P1.E1 " &
+                                     "EXPECTED");
+                    END;
+               WHEN OTHERS =>
+                    FAILED("OTHERS RAISED WHEN (P2)E1 EXPECTED");
+          END P2;
+
+          PROCEDURE P3 IS
+               CONSTRAINT_ERROR : EXCEPTION;
+          BEGIN
+               FLOW_COUNT := FLOW_COUNT + 1;
+               RAISE CONSTRAINT_ERROR;
+               FAILED("CONSTRAINT_ERROR EXCEPTION NOT RAISED");
+          EXCEPTION
+               WHEN STANDARD.CONSTRAINT_ERROR =>
+                    FAILED("STANDARD.CONSTRAINT_ERROR EXCEPTION " &
+                           "RAISED WHEN " &
+                           "(P3)CONSTRAINT_ERROR EXPECTED");
+               WHEN CONSTRAINT_ERROR =>
+                    BEGIN
+                         FLOW_COUNT := FLOW_COUNT + 1;
+                         RAISE STANDARD.CONSTRAINT_ERROR;
+                         FAILED("STANDARD.CONSTRAINT_ERROR " &
+                                "EXCEPTION NOT RAISED");
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              FAILED("(P3)CONSTRAINT_ERROR " &
+                                     "EXCEPTION RAISED WHEN " &
+                                     "STANDARD.CONSTRAINT_ERROR " &
+                                     "EXPECTED");
+                         WHEN STANDARD.CONSTRAINT_ERROR =>
+                              FLOW_COUNT := FLOW_COUNT + 1;
+                         WHEN OTHERS =>
+                               FAILED("OTHERS RAISED WHEN " &
+                                      "STANDARD.CONSTRAINT_ERROR " &
+                                      "EXPECTED");
+                    END;
+               WHEN OTHERS =>
+                    FAILED("OTHERS RAISED WHEN " &
+                           "(P3)CONSTRAINT_ERROR EXPECTED");
+          END P3;
+
+          PROCEDURE P4 IS
+               E2 : EXCEPTION;
+          BEGIN
+               FLOW_COUNT := FLOW_COUNT + 1;
+               RAISE P1.E2;
+               FAILED("P1.E2 EXCEPTION NOT RAISED");
+          EXCEPTION
+               WHEN E2 =>
+                    FAILED("(P4).E2 RAISED WHEN P1.E2 EXPECTED");
+          END P4;
+
+     BEGIN  -- P1
+          P2;
+          P3;
+          P4;
+          FAILED("P1.E2 EXCEPTION NOT PROPAGATED FROM P4");
+     EXCEPTION
+          WHEN E2 =>
+               FLOW_COUNT := FLOW_COUNT + 1;
+          WHEN OTHERS =>
+               FAILED("EXCEPTION RAISED WHERE NONE EXPECTED");
+     END P1;
+
+BEGIN
+     TEST("CB3004A","CHECK THAT WHEN EXCEPTION NAMES" &
+          " ARE REDECLARED THE HIDDEN DEFINITION IS STILL AVAILABLE");
+
+     P1;
+
+     IF FLOW_COUNT /= 8 THEN
+          FAILED("INCORRECT FLOW_COUNT VALUE");
+     END IF;
+
+     RESULT;
+END CB3004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40005.a
new file mode 100644
index 000000000..681ec18ff
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40005.a
@@ -0,0 +1,339 @@
+-- CB40005.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 exceptions raised in non-generic code can be handled by
+--      a procedure in a generic package.  Check that the exception identity
+--      can be properly retrieved from the generic code and used by the
+--      non-generic code.
+--
+-- TEST DESCRIPTION:
+--      This test models a possible usage paradigm for the type:
+--        Ada.Exceptions.Exception_Occurrence.
+--
+--      A generic package takes access to procedure types (allowing it to
+--      be used at any accessibility level) and defines a "fail soft"
+--      procedure that takes designators to a procedure to call, a
+--      procedure to call in the event that it fails, and a function to
+--      call to determine the next action.
+--
+--      In the event an exception occurs on the call to the first procedure,
+--      the exception is stored in a stack; along with the designator to the
+--      procedure that caused it; allowing the procedure to be called again, 
+--      or the exception to be re-raised.
+--
+--      A full implementation of such a tool would use a more robust storage
+--      mechanism, and would provide a more flexible interface.
+--
+--
+-- CHANGE HISTORY:
+--      29 MAR 96   SAIC   Initial version
+--      12 NOV 96   SAIC   Revised for 2.1 release
+--
+--!
+
+----------------------------------------------------------------- CB40005_0
+
+with Ada.Exceptions;
+generic
+  type Proc_Pointer is access procedure;
+  type Func_Pointer is access function return Proc_Pointer;
+package CB40005_0 is -- Fail_Soft
+
+
+  procedure Fail_Soft_Call( Proc_To_Call : Proc_Pointer;
+                            Proc_To_Call_On_Exception : Proc_Pointer := null;
+                            Retry_Routine : Func_Pointer := null );
+
+  function Top_Event_Exception return Ada.Exceptions.Exception_Occurrence;
+
+  function Top_Event_Procedure return Proc_Pointer;
+
+  procedure Pop_Event;
+
+  function Event_Stack_Size return Natural;
+
+end CB40005_0; -- Fail_Soft
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- CB40005_0
+
+with Report;
+package body CB40005_0 is
+
+  type History_Event is record
+    Exception_Event  : Ada.Exceptions.Exception_Occurrence_Access;
+    Procedure_Called : Proc_Pointer;
+  end record;
+
+  procedure Store_Event( Proc_Called : Proc_Pointer;
+                         Error       : Ada.Exceptions.Exception_Occurrence );
+
+  procedure Fail_Soft_Call( Proc_To_Call : Proc_Pointer;
+                            Proc_To_Call_On_Exception : Proc_Pointer := null;
+                            Retry_Routine : Func_Pointer := null ) is
+
+    Current_Proc_To_Call : Proc_Pointer := Proc_To_Call;
+
+  begin
+    while Current_Proc_To_Call /= null loop
+      begin
+        Current_Proc_To_Call.all;  -- call procedure through pointer
+        Current_Proc_To_Call := null;
+      exception
+        when Capture: others =>
+          Store_Event( Current_Proc_To_Call, Capture );
+          if Proc_To_Call_On_Exception /= null then
+            Proc_To_Call_On_Exception.all;
+          end if;
+          if Retry_Routine /= null then
+            Current_Proc_To_Call := Retry_Routine.all;
+          else
+            Current_Proc_To_Call := null;
+          end if;
+      end;
+    end loop;
+  end Fail_Soft_Call;
+  
+  Stack : array(1..10) of History_Event;  -- minimal, sufficient for testing
+
+  Stack_Top : Natural := 0;
+
+  procedure Store_Event( Proc_Called : Proc_Pointer;
+                         Error       : Ada.Exceptions.Exception_Occurrence )
+  is
+  begin
+    Stack_Top := Stack_Top +1;
+    Stack(Stack_Top) := ( Ada.Exceptions.Save_Occurrence(Error),
+                          Proc_Called );
+  end Store_Event;
+
+  function Top_Event_Exception return Ada.Exceptions.Exception_Occurrence is
+  begin
+    if Stack_Top > 0 then
+      return Stack(Stack_Top).Exception_Event.all;
+    else
+      return Ada.Exceptions.Null_Occurrence;
+    end if;
+  end Top_Event_Exception;
+
+  function Top_Event_Procedure return Proc_Pointer is
+  begin
+    if Stack_Top > 0 then
+      return Stack(Stack_Top).Procedure_Called;
+    else
+      return null;
+    end if;
+  end Top_Event_Procedure;
+
+  procedure Pop_Event is
+  begin
+    if Stack_Top > 0 then
+      Stack_Top := Stack_Top -1;
+    else
+      Report.Failed("Stack Error");
+    end if;
+  end Pop_Event;
+
+  function Event_Stack_Size return Natural is
+  begin
+    return Stack_Top;
+  end Event_Stack_Size;
+
+end CB40005_0;
+
+------------------------------------------------------------------- CB40005
+
+with Report;
+with TCTouch;
+with CB40005_0;
+with Ada.Exceptions;
+procedure CB40005 is
+
+  type Proc_Pointer is access procedure;
+  type Func_Pointer is access function return Proc_Pointer;
+
+  package Fail_Soft is new CB40005_0(Proc_Pointer, Func_Pointer);
+
+  procedure Cause_Standard_Exception;
+
+  procedure Cause_Visible_Exception;
+
+  procedure Cause_Invisible_Exception;
+
+  Exception_Procedure_Pointer : Proc_Pointer;
+
+  Visible_Exception : exception;
+
+  procedure Action_On_Exception;
+
+  function Retry_Procedure return Proc_Pointer;
+
+  Raise_Error : Boolean;
+
+  -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  procedure Cause_Standard_Exception is
+  begin
+    TCTouch.Touch('S');  --------------------------------------------------- S
+    if Raise_Error then
+      raise Constraint_Error;
+    end if;
+  end Cause_Standard_Exception;
+
+  procedure Cause_Visible_Exception is
+  begin
+    TCTouch.Touch('V');  --------------------------------------------------- V
+    if Raise_Error then
+      raise Visible_Exception;
+    end if;
+  end Cause_Visible_Exception;
+
+  procedure Cause_Invisible_Exception is
+    Invisible_Exception : exception;
+  begin
+    TCTouch.Touch('I');  --------------------------------------------------- I
+    if Raise_Error then
+      raise Invisible_Exception;
+    end if;
+  end Cause_Invisible_Exception;
+
+  procedure Action_On_Exception is
+  begin
+    TCTouch.Touch('A');  --------------------------------------------------- A
+  end Action_On_Exception;
+
+  function Retry_Procedure return Proc_Pointer is
+  begin
+    TCTouch.Touch('R');  --------------------------------------------------- R
+    return Action_On_Exception'Access;
+  end Retry_Procedure;
+
+         -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 
+
+begin  -- Main test procedure.
+
+  Report.Test ("CB40005", "Check that exceptions raised in non-generic " &
+                          "code can be handled by a procedure in a generic " &
+                          "package.  Check that the exception identity can " &
+                          "be properly retrieved from the generic code and " &
+                          "used by the non-generic code" );
+
+  -- first, check that the no exception cases cause no action on the stack
+  Raise_Error := False;
+
+  Fail_Soft.Fail_Soft_Call( Cause_Standard_Exception'Access );    -- S
+
+  Fail_Soft.Fail_Soft_Call( Cause_Visible_Exception'Access,       -- V
+                            Action_On_Exception'Access,
+                            Retry_Procedure'Access );
+
+  Fail_Soft.Fail_Soft_Call( Cause_Invisible_Exception'Access,     -- I
+                            null,
+                            Retry_Procedure'Access );
+
+  TCTouch.Assert( Fail_Soft.Event_Stack_Size = 0, "Empty stack");
+
+  TCTouch.Validate( "SVI", "Non error case check" );
+
+  -- second, check that error cases add to the stack
+  Raise_Error := True;
+
+  Fail_Soft.Fail_Soft_Call( Cause_Standard_Exception'Access );    -- S
+
+  Fail_Soft.Fail_Soft_Call( Cause_Visible_Exception'Access,       -- V
+                            Action_On_Exception'Access,           -- A
+                            Retry_Procedure'Access );             -- RA
+
+  Fail_Soft.Fail_Soft_Call( Cause_Invisible_Exception'Access,     -- I
+                            null,
+                            Retry_Procedure'Access );             -- RA
+
+  TCTouch.Assert( Fail_Soft.Event_Stack_Size = 3, "Stack = 3");
+
+  TCTouch.Validate( "SVARAIRA", "Error case check" );
+
+  -- check that the exceptions and procedure were stored correctly
+  -- on the stack
+  Raise_Error := False;
+
+  -- return procedure pointer from top of stack and call the procedure
+  -- through that pointer:
+
+  Fail_Soft.Top_Event_Procedure.all;
+
+  TCTouch.Validate( "I", "Invisible case unwind" );
+
+  begin
+    Ada.Exceptions.Raise_Exception( 
+      Ada.Exceptions.Exception_Identity(Fail_Soft.Top_Event_Exception) );
+    Report.Failed("1: Exception not raised");
+  exception
+    when Constraint_Error  => Report.Failed("1: Raised Constraint_Error");
+    when Visible_Exception => Report.Failed("1: Raised Visible_Exception");
+    when others            => null; -- expected case
+  end;
+
+  Fail_Soft.Pop_Event;
+
+  -- return procedure pointer from top of stack and call the procedure
+  -- through that pointer:
+
+  Fail_Soft.Top_Event_Procedure.all;
+
+  TCTouch.Validate( "V", "Visible case unwind" );
+
+  begin
+    Ada.Exceptions.Raise_Exception( 
+      Ada.Exceptions.Exception_Identity(Fail_Soft.Top_Event_Exception) );
+    Report.Failed("2: Exception not raised");
+  exception
+    when Constraint_Error  => Report.Failed("2: Raised Constraint_Error");
+    when Visible_Exception => null; -- expected case
+    when others            => Report.Failed("2: Raised Invisible_Exception");
+  end;
+
+  Fail_Soft.Pop_Event;
+
+  Fail_Soft.Top_Event_Procedure.all;
+
+  TCTouch.Validate( "S", "Standard case unwind" );
+
+  begin
+    Ada.Exceptions.Raise_Exception( 
+      Ada.Exceptions.Exception_Identity(Fail_Soft.Top_Event_Exception) );
+    Report.Failed("3: Exception not raised");
+  exception
+    when Constraint_Error  => null; -- expected case
+    when Visible_Exception => Report.Failed("3: Raised Visible_Exception");
+    when others            => Report.Failed("3: Raised Invisible_Exception");
+  end;
+
+  Fail_Soft.Pop_Event;
+
+  TCTouch.Assert( Fail_Soft.Event_Stack_Size = 0, "Stack empty after pops");
+
+  Report.Result;
+
+end CB40005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4001a.ada
new file mode 100644
index 000000000..010add15c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4001a.ada
@@ -0,0 +1,151 @@
+-- CB4001A.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 ANY EXCEPTION RAISED IN THE STATEMENT SEQUENCE OF A
+-- SUBPROGRAM IS PROPAGATED TO THE CALLER OF THE SUBPROGRAM, NOT TO THE
+-- STATICALLY ENCLOSING LEXICAL ENVIRONMENT.
+
+-- RM  05/30/80
+-- JRK 11/19/80
+-- SPS 03/28/83
+-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+
+WITH REPORT;
+PROCEDURE CB4001A IS
+
+     USE REPORT;
+
+     E1 : EXCEPTION;
+     I9 : INTEGER RANGE 1..10 ;
+     FLOW_COUNT : INTEGER := 0 ;
+
+BEGIN
+     TEST("CB4001A","CHECK THAT ANY EXCEPTION RAISED IN THE " &
+          "STATEMENT SEQUENCE OF A SUBPROGRAM IS " &
+          "PROPAGATED TO THE CALLER, NOT TO THE STATICALLY ENCLOSING" &
+          " LEXICAL ENVIRONMENT");
+
+     BEGIN   --  BLOCK WITH HANDLERS; LEX. ENVIRONMT FOR ALL PROC.DEFS
+
+          DECLARE   --  BLOCK WITH PROCEDURE DEFINITIONS
+
+               PROCEDURE  CALLEE1 ;
+               PROCEDURE  CALLEE2 ;
+               PROCEDURE  CALLEE3 ;
+               PROCEDURE  R ;
+               PROCEDURE  S ;
+
+               PROCEDURE  CALLER1  IS
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 1 ;
+                    CALLEE1 ;
+                    FAILED("EXCEPTION NOT RAISED  (CALLER1)");
+               EXCEPTION
+                    WHEN E1 =>
+                         FLOW_COUNT := FLOW_COUNT + 1 ;
+               END ;
+
+               PROCEDURE  CALLER2  IS
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 1 ;
+                    CALLEE2 ;
+                    FAILED("EXCEPTION NOT RAISED  (CALLER2)");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         FLOW_COUNT := FLOW_COUNT + 1 ;
+               END ;
+
+               PROCEDURE  CALLER3  IS
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 1 ;
+                    CALLEE3 ;
+                    FAILED("EXCEPTION NOT RAISED  (CALLER3)");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         FLOW_COUNT := FLOW_COUNT + 1 ;
+               END ;
+
+               PROCEDURE  CALLEE1  IS
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 1 ;
+                    R ;
+                    FAILED("EXCEPTION NOT RAISED  (CALLEE1)");
+               END ;
+
+               PROCEDURE  CALLEE2  IS
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 1 ;
+                    RAISE  CONSTRAINT_ERROR ;
+                    FAILED("EXCEPTION NOT RAISED  (CALLEE2)");
+               EXCEPTION
+                    WHEN PROGRAM_ERROR =>
+                         FAILED("WRONG EXCEPTION RAISED  (CALLEE2)");
+               END ;
+
+               PROCEDURE  CALLEE3  IS
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 1 ;
+                    I9 := IDENT_INT(20) ;
+                    FAILED("EXCEPTION NOT RAISED  (CALLEE3)");
+               END ;
+
+               PROCEDURE  R  IS
+                    E2 : EXCEPTION;
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 10 ;
+                    S ;
+                    FAILED("EXCEPTION E1 NOT RAISED (PROC R)");
+               EXCEPTION
+                    WHEN E2 =>
+                         FAILED("WRONG EXCEPTION RAISED  (PROC R)");
+               END ;
+
+               PROCEDURE  S  IS
+               BEGIN
+                    FLOW_COUNT := FLOW_COUNT + 10 ;
+                    RAISE  E1 ;
+                    FAILED("EXCEPTION  E1  NOT RAISED  (PROC S)");
+               END ;
+
+          BEGIN   --  (THE BLOCK WITH PROC. DEFS)
+
+               CALLER1;
+               CALLER2;
+               CALLER3;
+
+          END ;   --  (THE BLOCK WITH PROC. DEFS)
+
+     EXCEPTION
+
+          WHEN OTHERS =>
+               FAILED("EXCEPTION PROPAGATED STATICALLY");
+
+     END ;
+
+     IF  FLOW_COUNT /= 29  THEN
+          FAILED("INCORRECT FLOW_COUNT VALUE");
+     END IF;
+
+     RESULT;
+END CB4001A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4002a.ada
new file mode 100644
index 000000000..e37525769
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4002a.ada
@@ -0,0 +1,127 @@
+-- CB4002A.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 EXCEPTIONS RAISED DURING ELABORATION OF THE
+-- DECLARATIVE PART OF A SUBPROGRAM ARE PROPAGATED TO THE
+-- CALLER, FOR CONSTRAINT_ERROR CAUSED BY INITIALIZATION,
+-- AND CONSTRAINT ELABORATION, AND FOR FUNCTION EVALUATIONS
+-- RAISING  CONSTRAINT_ERROR AND A PROGRAMMER-DEFINED EXCEPTION.
+
+-- DAT 4/13/81
+-- SPS 3/28/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB4002A IS
+BEGIN
+     TEST("CB4002A", "EXCEPTIONS IN SUBPROGRAM DECLARATIVE_PARTS"
+          & " ARE PROPAGATED TO CALLER");
+
+     DECLARE
+          SUBTYPE I5 IS INTEGER RANGE -5 .. 5;
+     
+          E : EXCEPTION;
+     
+          FUNCTION RAISE_IT (I : I5) RETURN INTEGER IS
+               J : INTEGER RANGE 0 .. 1 := I;
+          BEGIN
+               IF I = 0 THEN
+                    RAISE CONSTRAINT_ERROR;
+               ELSIF I = 1 THEN
+                    RAISE E;
+               END IF;
+               FAILED ("EXCEPTION NOT RAISED 0");
+               RETURN J;
+          EXCEPTION
+               WHEN OTHERS =>
+                    IF I NOT IN 0 .. 1 THEN
+                         FAILED ("WRONG HANDLER 0");
+                         RETURN 0;
+                    ELSE
+                         RAISE;
+                    END IF;
+          END RAISE_IT;
+     
+          PROCEDURE P1 (P : INTEGER) IS
+               Q : INTEGER := RAISE_IT (P);
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED 1");
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRONG HANDLER 1");
+          END P1;
+
+          PROCEDURE P2 (P : INTEGER) IS
+               Q : I5 RANGE 0 .. P := 1;
+          BEGIN
+               IF P = 0 OR P > 5 THEN
+                    FAILED ("EXCEPTION NOT RAISED 2");
+               END IF;
+          END P2;
+     
+     BEGIN
+     
+          BEGIN
+               P1(-1);
+               FAILED ("EXCEPTION NOT RAISED 2A");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+          END;
+     
+          BEGIN
+               P1(0);
+               FAILED ("EXCEPTION NOT RAISED 3");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+          END;
+     
+          BEGIN
+               P1(1);
+               FAILED ("EXCEPTION NOT RAISED 4");
+          EXCEPTION
+               WHEN E => NULL;
+          END;
+     
+          BEGIN
+               P2(0);
+               FAILED ("EXCEPTION NOT RAISED 5");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+          END;
+     
+          BEGIN
+               P2(6);
+               FAILED ("EXCEPTION NOT RAISED 6");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+          END;
+     
+     EXCEPTION
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION OR HANDLER");
+     END;
+     
+     RESULT;
+EXCEPTION
+     WHEN OTHERS => FAILED ("WRONG HANDLER FOR SURE"); RESULT;
+END CB4002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4003a.ada
new file mode 100644
index 000000000..7f1aaf5e2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4003a.ada
@@ -0,0 +1,119 @@
+-- CB4003A.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 EXCEPTIONS RAISED DURING ELABORATION OF PACKAGE
+--     SPECIFICATIONS, OR DECLARATIVE_PARTS OF BLOCKS AND PACKAGE
+--     BODIES, ARE PROPAGATED TO THE STATIC ENVIRONMENT.  EXCEPTIONS
+--     ARE CAUSED BY INITIALIZATIONS AND FUNCTION CALLS.
+
+-- HISTORY:
+--     DAT 04/14/81  CREATED ORIGINAL TEST.
+--     JET 01/06/88  UPDATED HEADER FORMAT AND ADDED CODE TO
+--                   PREVENT OPTIMIZATION.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB4003A IS
+
+     E : EXCEPTION;
+
+     FUNCTION F (B : BOOLEAN) RETURN INTEGER IS
+     BEGIN
+          IF B THEN
+               RAISE E;
+          ELSE
+               RETURN 1;
+          END IF;
+     END F;
+
+BEGIN
+     TEST ("CB4003A", "CHECK THAT EXCEPTIONS DURING ELABORATION"
+          & " OF DECLARATIVE PARTS"
+          & " IN BLOCKS, PACKAGE SPECS, AND PACKAGE BODIES ARE"
+          & " PROPAGATED TO STATIC ENCLOSING ENVIRONMENT");
+
+     BEGIN
+          DECLARE
+               PACKAGE P1 IS
+                    I : INTEGER RANGE 1 .. 1 := 2;
+               END P1;
+          BEGIN
+               FAILED ("EXCEPTION NOT RAISED 1");
+               IF NOT EQUAL(P1.I,P1.I) THEN
+                    COMMENT ("NO EXCEPTION RAISED");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS => FAILED ("WRONG HANDLER 1");
+          END;
+          FAILED ("EXCEPTION NOT RAISED 1A");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION 1");
+     END;
+
+     FOR L IN IDENT_INT(1) .. IDENT_INT(4) LOOP
+          BEGIN
+               DECLARE
+                    PACKAGE P2 IS
+                    PRIVATE
+                         J : INTEGER RANGE 2 .. 4 := L;
+                    END P2;
+
+                    Q : INTEGER := F(L = 3);
+
+                    PACKAGE BODY P2 IS
+                         K : INTEGER := F(L = 2);
+
+                    BEGIN
+                         IF NOT (EQUAL(J,J) OR EQUAL(K,K)) THEN
+                              COMMENT("CAN'T OPTIMIZE THIS");
+                         END IF;
+                    END P2;
+               BEGIN
+                    IF L /= 4 THEN
+                         FAILED ("EXCEPTION NOT RAISED 2");
+                    END IF;
+
+                    IF NOT EQUAL(Q,Q) THEN
+                         COMMENT("CAN'T OPTIMIZE THIS");
+                    END IF;
+
+                    EXIT;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION HANDLER 2");
+                         EXIT;
+               END;
+               FAILED ("EXCEPTION NOT RAISED 2A");
+          EXCEPTION
+               WHEN E | CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
+          END;
+     END LOOP;
+
+     RESULT;
+
+END CB4003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4004a.ada
new file mode 100644
index 000000000..228d0a4ee
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4004a.ada
@@ -0,0 +1,77 @@
+-- CB4004A.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 VARIOUS EXCEPTIONS IN THE BODY OF A SUBPROGRAM WITH
+-- AN APPLICABLE HANDLER ARE HANDLED LOCALLY.
+
+-- DAT 04/15/81
+-- JRK 04/24/81
+-- SPS 11/02/82
+-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB4004A IS
+
+     E, F : EXCEPTION;
+     STORAGE_ERROR: EXCEPTION;
+
+     I1 : INTEGER RANGE 1 .. 1;
+
+     FUNCTION F1 (I : INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          CASE I IS
+               WHEN 1 => RAISE E;
+               WHEN 2 => RAISE STORAGE_ERROR;
+               WHEN 3 => I1 := 4;
+               WHEN 4 => RAISE TASKING_ERROR;
+               WHEN OTHERS => NULL;
+          END CASE;
+          RETURN FALSE;
+     EXCEPTION
+          WHEN E | F => RETURN I = 1;
+          WHEN STORAGE_ERROR => RETURN I = 2;
+          WHEN PROGRAM_ERROR | CONSTRAINT_ERROR =>
+               RETURN I = 3;
+          WHEN OTHERS => RETURN I = 4;
+     END F1;
+
+BEGIN
+     TEST ("CB4004A", "EXCEPTIONS WITH LOCAL HANDLERS ARE HANDLED"
+          & " THERE");
+
+     BEGIN
+          FOR L IN 1 .. 4 LOOP
+               IF F1(L) /= TRUE THEN
+                    FAILED ("LOCAL EXCEPTIONS DON'T WORK");
+                    EXIT;
+               END IF;
+          END LOOP;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("WRONG HANDLER");
+     END;
+
+     RESULT;
+END CB4004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4005a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4005a.ada
new file mode 100644
index 000000000..5b68ac39b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4005a.ada
@@ -0,0 +1,66 @@
+-- CB4005A.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 EXCEPTIONS PROPAGATED OUT OF A HANDLER ARE PROPAGATED
+-- OUTSIDE THE ENCLOSING UNIT.
+
+-- DAT 4/15/81
+-- SPS 3/28/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB4005A IS
+
+     E , F : EXCEPTION;
+
+     B : BOOLEAN := FALSE;
+
+     PROCEDURE P IS
+     BEGIN
+          RAISE E;
+     EXCEPTION
+          WHEN F => FAILED ("WRONG HANDLER 1");
+          WHEN E =>
+               IF B THEN
+                    FAILED ("WRONG HANDLER 2");
+               ELSE
+                    B := TRUE;
+                    RAISE F;
+               END IF;
+     END P;
+
+BEGIN
+     TEST ("CB4005A", "EXCEPTIONS FROM HANDLERS ARE PROPAGATED " & 
+           "OUTSIDE");
+
+     BEGIN
+          P;
+          FAILED ("EXCEPTION NOT PROPAGATED 1");
+     EXCEPTION
+          WHEN F => NULL;
+          WHEN OTHERS => FAILED ("WRONG HANDLER 3");
+     END;
+
+     RESULT;
+END CB4005A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4006a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4006a.ada
new file mode 100644
index 000000000..b0ddfc57a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4006a.ada
@@ -0,0 +1,97 @@
+-- CB4006A.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 EXCEPTIONS IN A BLOCK IN A HANDLER
+--     ARE HANDLED CORRECTLY.
+
+-- HISTORY:
+--     DAT 04/15/81
+--     SPS 11/02/82
+--     JET 01/06/88  UPDATED HEADER FORMAT AND ADDED CODE TO
+--                   PREVENT OPTIMIZATION.
+--     JRL 05/28/92  CHANGED CODE IN PROGRAM_ERROR BLOCK TO
+--                   PREVENT OPTIMIZATION.
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CB4006A IS
+
+     I1 : INTEGER RANGE 1 .. 2 := 1;
+
+     PROCEDURE P IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               RAISE PROGRAM_ERROR;
+          END IF;
+     EXCEPTION
+          WHEN PROGRAM_ERROR =>
+               DECLARE
+                    I : INTEGER RANGE 1 .. 1 := I1;
+               BEGIN
+                    IF EQUAL(I,I) THEN
+                         I := I1 + 1;
+                    END IF ;
+                    FAILED ("EXCEPTION NOT RAISED 1");
+
+                    IF NOT EQUAL(I,I) THEN
+                         COMMENT ("CAN'T OPTIMIZE THIS");
+                    END IF;
+
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         IF I1 /= 1 THEN
+                              FAILED ("WRONG HANDLER 1");
+                         ELSE
+                              I1 := I1 + 1;
+                         END IF;
+               END;
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("WRONG HANDLER 3");
+     END P;
+
+BEGIN
+     TEST ("CB4006A", "CHECK THAT EXCEPTIONS IN BLOCKS IN " &
+                      "HANDLERS WORK");
+
+     P;
+     IF IDENT_INT(I1) /= 2 THEN
+          FAILED ("EXCEPTION NOT HANDLED CORRECTLY");
+     ELSE
+          BEGIN
+               P;
+               FAILED ("EXCEPTION NOT RAISED CORRECTLY 2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR => NULL;
+          END;
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS => FAILED ("WRONG HANDLER 2");
+          RESULT;
+
+END CB4006A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4007a.ada
new file mode 100644
index 000000000..789d1b330
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4007a.ada
@@ -0,0 +1,115 @@
+-- CB4007A.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 STATEMENT PART OF A PACKAGE CAN RAISE, PROPAGATE,
+--     AND HANDLE EXCEPTIONS. IF THE BODY'S HANDLERS HANDLE ALL
+--     EXCEPTIONS RAISED AND DO NOT RAISE ANY UNHANDLED EXCEPTIONS,
+--     NO EXCEPTION IS PROPAGATED.
+
+-- HISTORY:
+--     DHH 03/28/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CB4007A IS
+BEGIN
+
+     TEST("CB4007A", "CHECK THAT THE STATEMENT PART OF A PACKAGE " &
+                     "CAN RAISE, PROPAGATE, AND HANDLE EXCEPTIONS. " &
+                     "IF THE BODY'S HANDLERS HANDLE ALL EXCEPTIONS " &
+                     "RAISED AND DO NOT RAISE ANY UNHANDLED " &
+                     "EXCEPTIONS, NO EXCEPTION IS PROPAGATED");
+     DECLARE
+
+          PACKAGE OUTSIDE IS
+          END OUTSIDE;
+
+          PACKAGE BODY OUTSIDE IS
+
+          BEGIN
+               DECLARE
+                    PACKAGE HANDLER IS
+                    END HANDLER;
+
+                    PACKAGE BODY HANDLER IS
+                    BEGIN
+                         DECLARE
+                              PACKAGE PROPAGATE IS
+                              END PROPAGATE;
+
+                              PACKAGE BODY PROPAGATE IS
+                              BEGIN
+                                   DECLARE
+                                        PACKAGE RISE IS
+                                        END RISE;
+
+                                        PACKAGE BODY RISE IS
+                                        BEGIN
+                                             RAISE CONSTRAINT_ERROR;
+                                             FAILED("EXCEPTION " &
+                                                    "NOT RAISED");
+                                        END RISE;
+
+                                   BEGIN
+                                        NULL;
+                                   END;   -- PACKAGE PROPAGATE DECLARE.
+                              EXCEPTION
+                                   WHEN CONSTRAINT_ERROR =>
+                                        RAISE CONSTRAINT_ERROR;
+                                   WHEN OTHERS =>
+                                        FAILED("UNEXPECTED EXCEPTION " &
+                                               "RAISED IN PROPAGATE " &
+                                               "PACKAGE");
+                              END PROPAGATE;
+
+                         BEGIN
+                              NULL;
+                         END;               -- PACKAGE HANDLER DECLARE.
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                             NULL;
+                         WHEN OTHERS =>
+                              FAILED("UNEXPECTED EXCEPTION RAISED IN " &
+                                     "HANDLER PACKAGE");
+                    END HANDLER;
+
+               BEGIN
+                    NULL;
+               END;                    -- PACKAGE OUTSIDE DECLARE.
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED IN OUTSIDE " &
+                           "PACKAGE");
+          END OUTSIDE;
+     BEGIN
+         NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED("UNEXPECTED EXCEPTION RAISED");
+          RESULT;
+END CB4007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4008a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4008a.ada
new file mode 100644
index 000000000..741a7a8f0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4008a.ada
@@ -0,0 +1,137 @@
+-- CB4008A.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 NESTED LAST WISHES EXCEPTION HANDLERS WORK 
+-- (FOR PROCEDURES).
+
+-- DAT 4/15/81
+-- SPS 3/28/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB4008A IS
+
+     C : INTEGER := 0;
+
+     E : EXCEPTION;
+
+     DEPTH : CONSTANT := 99;
+
+     PROCEDURE F;
+
+     PROCEDURE I IS
+     BEGIN
+          C := C + 1;
+          IF C >= DEPTH THEN
+               RAISE E;
+          END IF;
+     END I;
+
+     PROCEDURE O IS
+     BEGIN
+          C := C - 1;
+     END O;
+
+     PROCEDURE X IS
+          PROCEDURE X1 IS
+               PROCEDURE X2 IS
+               BEGIN
+                    F;
+               END X2;
+
+               PROCEDURE X3 IS
+               BEGIN
+                    I;
+                    X2;
+               EXCEPTION
+                    WHEN E => O; RAISE;
+               END X3;
+          BEGIN
+               I;
+               X3;
+          EXCEPTION
+               WHEN E => O; RAISE;
+          END X1;
+
+          PROCEDURE X1A IS
+          BEGIN
+               I;
+               X1;
+               FAILED ("INCORRECT EXECUTION SEQUENCE");
+          EXCEPTION
+               WHEN E => O; RAISE;
+          END X1A;
+     BEGIN
+          I;
+          X1A;
+     EXCEPTION
+          WHEN E => O; RAISE;
+     END X;
+
+     PROCEDURE Y IS
+     BEGIN
+          I;
+          X;
+     EXCEPTION WHEN E => O; RAISE;
+     END Y;
+
+     PROCEDURE F IS
+          PROCEDURE F2;
+
+          PROCEDURE F1 IS
+          BEGIN
+               I;
+               F2;
+          EXCEPTION WHEN E => O; RAISE;
+          END F1;
+
+          PROCEDURE F2 IS
+          BEGIN
+               I;
+               Y;
+          EXCEPTION WHEN E => O; RAISE;
+          END F2;
+     BEGIN
+          I;
+          F1;
+     EXCEPTION WHEN E => O; RAISE;
+     END F;
+
+BEGIN
+     TEST ("CB4008A", "(PROCEDURE) LAST WISHES UNWIND PROPERLY");
+
+     BEGIN
+          I;
+          Y;
+          FAILED ("INCORRECT EXECUTION SEQUENCE 2");
+     EXCEPTION
+          WHEN E =>
+               O;
+               IF C /= 0 THEN
+                    FAILED ("EXCEPTION HANDLER MISSED SOMEWHERE");
+               END IF;
+     END;
+
+     RESULT;
+END CB4008A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4009a.ada
new file mode 100644
index 000000000..98f009e4b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4009a.ada
@@ -0,0 +1,114 @@
+-- CB4009A.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 PROGRAMMER DEFINED EXCEPTION AND A REDECLARED
+-- PREDEFINED EXCEPTION MAY BE PROPAGATED OUT OF SCOPE AND BACK IN,
+-- WITH OUT-OF-SCOPE 'OTHERS' HANDLERS HANDLING THE EXCEPTION
+-- INSTEAD OF OTHER HANDLERS. SEPARATELY COMPILED UNITS ARE NOT TESTED.
+
+-- DAT 4/15/81
+-- SPS 1/14/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CB4009A IS
+
+     E : EXCEPTION;
+
+     I : INTEGER := 0;
+
+     PROCEDURE P1 (C : INTEGER);
+     PROCEDURE P2 (C : INTEGER);
+     PROCEDURE P3 (C : INTEGER);
+
+     F : BOOLEAN := FALSE;
+     T : CONSTANT BOOLEAN := TRUE;
+
+     PROCEDURE P1 (C : INTEGER) IS
+     BEGIN
+          P3(C);
+     EXCEPTION
+          WHEN E => F := T;
+          WHEN CONSTRAINT_ERROR => F := T;
+          WHEN OTHERS => I := I + 1; RAISE;
+     END P1;
+
+     PROCEDURE P2 (C : INTEGER) IS
+          E : EXCEPTION;
+          CONSTRAINT_ERROR : EXCEPTION;
+     BEGIN
+          CASE C IS
+               WHEN 0 => FAILED ("WRONG CASE");
+               WHEN 1 => RAISE E;
+               WHEN -1 => RAISE CONSTRAINT_ERROR;
+               WHEN OTHERS => P1 (C - C/ABS(C));
+          END CASE;
+     EXCEPTION
+          WHEN E =>
+               I := I + 100; RAISE;
+          WHEN CONSTRAINT_ERROR =>
+               I := I + 101; RAISE;
+          WHEN OTHERS =>
+               F := T;
+     END P2;
+
+     PROCEDURE P3 (C : INTEGER) IS
+     BEGIN
+          P2(C);
+     EXCEPTION
+          WHEN E => F := T;
+          WHEN CONSTRAINT_ERROR => F := T;
+     END P3;
+
+BEGIN
+     TEST ("CB4009A", "EXCEPTIONS PROPAGATED OUT OF SCOPE");
+
+     I := 0;
+     BEGIN
+          P3 (-2);
+          FAILED ("EXCEPTION NOT RAISED 1");
+     EXCEPTION
+          WHEN OTHERS => NULL;
+     END;
+     IF I /= 203 THEN
+          FAILED ("INCORRECT HANDLER SOMEWHERE 1");
+     END IF;
+
+     I := 0;
+     BEGIN
+          P3(3);
+          FAILED ("EXCEPTION NOT RAISED 2");
+     EXCEPTION
+          WHEN OTHERS => NULL;
+     END;
+     IF I /= 302 THEN
+          FAILED ("INCORRECT HANDLER SOMEWHERE 2");
+     END IF;
+
+     IF F = T THEN
+          FAILED ("WRONG HANDLER SOMEWHERE");
+     END IF;
+
+     RESULT;
+END CB4009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4013a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4013a.ada
new file mode 100644
index 000000000..655b80035
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb4013a.ada
@@ -0,0 +1,80 @@
+-- CB4013A.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 UNHANDLED EXCEPTION RAISED IN A TASK BODY, BUT
+--     OUTSIDE AN ACCEPT STATEMENT, RAISES NO EXCEPTION OUTSIDE THE
+--     TASK.
+
+-- HISTORY:
+--     DHH 03/29/88 CREATED ORIGINAL TEST.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CB4013A IS
+
+     TASK TYPE CHOICE IS
+          ENTRY E1;
+          ENTRY STOP;
+     END CHOICE;
+
+     T : CHOICE;
+
+     TASK BODY CHOICE IS
+     BEGIN
+          ACCEPT E1;
+          IF EQUAL(3,3) THEN
+               RAISE CONSTRAINT_ERROR;
+          END IF;
+          ACCEPT STOP;
+     END CHOICE;
+
+BEGIN
+
+     TEST("CB4013A", "CHECK THAT AN UNHANDLED EXCEPTION RAISED IN " &
+                     "A TASK BODY, BUT OUTSIDE AN ACCEPT STATEMENT, " &
+                     "RAISES NO EXCEPTION OUTSIDE THE TASK");
+
+     T.E1;
+     DELAY 1.0;
+     IF T'CALLABLE THEN
+          FAILED("TASK NOT COMPLETED ON RAISING CONSTRAINT_ERROR");
+          T.STOP;
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN TASKING_ERROR =>
+          FAILED("TASKING_ERROR RAISED OUTSIDE TASK");
+          RESULT;
+
+     WHEN CONSTRAINT_ERROR =>
+          FAILED("CONSTRAINT_ERROR PROPAGATED OUTSIDE TASK");
+          RESULT;
+
+     WHEN OTHERS =>
+          FAILED("UNEXPECTED EXCEPTION RAISED");
+          RESULT;
+END CB4013A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a01.a
new file mode 100644
index 000000000..1c569119a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a01.a
@@ -0,0 +1,135 @@
+-- CB40A01.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 user defined exception is correctly propagated out of
+--      a public child package.
+--
+-- TEST DESCRIPTION:
+--      Declare a public child package containing a procedure used to 
+--      analyze the alphanumeric content of a particular text string.
+--      The procedure contains a processing loop that continues until the
+--      range of the text string is exceeded, at which time a user defined
+--      exception is raised.  This exception propagates out of the procedure
+--      through the parent package, to the main test program.
+--
+--      Exception Type Raised:
+--        * User Defined
+--          Predefined  
+--
+--      Hierarchical Structure Employed For This Test:  
+--        * Parent Package
+--        * Public Child Package
+--          Private Child Package
+--          Public Child Subprogram
+--          Private Child Subprogram
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--         FB40A00.A
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+package FB40A00.CB40A01_0 is    -- package Text_Parser.Processing
+
+   procedure Process_Text (Text : in String_Pointer_Type);
+
+end FB40A00.CB40A01_0;
+
+
+     --=================================================================--
+
+
+with Report;
+
+package body FB40A00.CB40A01_0 is
+
+   procedure Process_Text (Text : in String_Pointer_Type) is
+      Pos : Natural := Text'First - 1;
+   begin
+      loop   -- Process string, raise exception upon completion.
+         Pos := Pos + 1;
+         if Pos > Text.all'Last then
+            raise Completed_Text_Processing; 
+         elsif (Text.all (Pos) in 'A' .. 'Z') or
+               (Text.all (Pos) in 'a' .. 'z') or
+               (Text.all (Pos) in '0' .. '9') then
+            Increment_AlphaNumeric_Count;
+         else
+            Increment_Non_AlphaNumeric_Count;
+         end if;
+      end loop;
+      -- No exception handler here, exception propagates.
+      Report.Failed ("No exception raised in child package subprogram");
+   end Process_Text;
+
+end FB40A00.CB40A01_0;
+
+
+     --=================================================================--
+
+
+with FB40A00.CB40A01_0;
+with Report;
+
+procedure CB40A01 is
+
+   String_Pointer : FB40A00.String_Pointer_Type := 
+     new String'("'Twas the night before Christmas, " &
+                 "and all through the house...");
+
+begin
+
+   Process_Block:
+   begin
+
+      Report.Test ("CB40A01", "Check that a user defined exception " &
+                              "is correctly propagated out of a "    &
+                              "public child package");
+
+      FB40A00.CB40A01_0.Process_Text (String_Pointer);
+
+      Report.Failed ("Exception should have been handled");
+
+   exception
+
+      when FB40A00.Completed_Text_Processing =>      -- Correct exception 
+         if FB40A00.AlphaNumeric_Count /= 48 then    -- propagation.
+            Report.Failed ("Incorrect string processing");
+         end if;
+
+      when others =>
+         Report.Failed ("Exception handled in an others handler");
+
+   end Process_Block;
+
+   Report.Result;
+
+end CB40A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a020.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a020.a
new file mode 100644
index 000000000..09830b87f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a020.a
@@ -0,0 +1,95 @@
+-- CB40A020.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:
+--      See CB40A021.AM.
+--
+-- TEST DESCRIPTION:
+--      See CB40A021.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         FB40A00.A
+--      => CB40A020.A
+--         CB40A021.AM
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+
+package FB40A00.CB40A020_0 is    -- package Text_Parser.Processing 
+
+   function Count_AlphaNumerics (Text : in String) return Natural;
+
+end FB40A00.CB40A020_0;
+
+
+     --=================================================================--
+
+
+-- Text_Parser.Processing.Process_Text 
+with Report;
+private procedure FB40A00.CB40A020_0.CB40A020_1 (Text : in String);
+
+procedure FB40A00.CB40A020_0.CB40A020_1 (Text : in String) is
+   Pos : Natural := Text'First - 1;
+begin
+   loop   -- Process string, raise exception upon completion.
+      Pos := Pos + 1;
+      if Pos > Text'Last then
+         raise Completed_Text_Processing; 
+      elsif (Text (Pos) in 'A' .. 'Z') or
+            (Text (Pos) in 'a' .. 'z') or
+            (Text (Pos) in '0' .. '9') then
+         Increment_AlphaNumeric_Count;
+      else
+         Increment_Non_AlphaNumeric_Count;
+      end if;
+   end loop;
+   -- No exception handler here, exception propagates.
+   Report.Failed ("No exception raised in child package subprogram");
+end FB40A00.CB40A020_0.CB40A020_1;
+
+
+     --=================================================================--
+
+
+with FB40A00.CB40A020_0.CB40A020_1;   -- "with" of  private child subprogram
+                                      -- Text_Parser.Processing.Process_Text 
+package body FB40A00.CB40A020_0 is
+
+   function Count_AlphaNumerics (Text : in String) return Natural is
+   begin
+      FB40A00.CB40A020_0.CB40A020_1 (Text);  -- Call prvt child proc.
+      return (AlphaNumeric_Count);           -- Global maintained in parent.
+      -- No exception handler here, exception propagates.
+   end Count_AlphaNumerics;
+
+end FB40A00.CB40A020_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a021.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a021.am
new file mode 100644
index 000000000..027b7da9d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a021.am
@@ -0,0 +1,103 @@
+-- CB40A021.AM
+--
+--                             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 user defined exception is correctly propagated from a
+--      private child subprogram to its parent and then to a client of the
+--      parent.
+--
+-- TEST DESCRIPTION:
+--      Declare a child package containing a function.  The body of the 
+--      function contains a call to a private child subprogram (child of
+--      the child).  The private child subprogram raises an exception
+--      defined in the root ancestor package, and it is propagated to the
+--      test program.
+--
+--      Exception Type Raised:
+--        * User Defined
+--          Predefined  
+--
+--      Hierarchical Structure Employed For This Test:  
+--        * Parent Package
+--        * Visible Child Package
+--          Private Child Package
+--          Visible Child Subprogram
+--        * Private Child Subprogram
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         FB40A00.A
+--         CB40A020.A
+--      => CB40A021.AM
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+
+with Report;
+with FB40A00.CB40A020_0;   -- Explicit "with" of Text_Parser.Processing
+                           -- Implicit "with" of Text_Parser (FB40A00)
+
+procedure CB40A021 is
+
+   String_Constant : constant String := 
+     "ACVC Version 2.0 will incorporate Ada 9X feature tests."; 
+
+   Number_Of_AlphaNumeric_Characters : Natural := 0;
+
+begin
+
+   Process_Block:
+   begin
+
+      Report.Test ("CB40A021", "Check that a user defined exception " &
+                               "is correctly propagated across "      &
+                               "package and subprogram boundaries");
+
+      Number_Of_AlphaNumeric_Characters := 
+        FB40A00.CB40A020_0.Count_AlphaNumerics (String_Constant);
+
+      Report.Failed ("Exception should have been handled");
+
+   exception
+
+      when FB40A00.Completed_Text_Processing =>      -- Correct exception 
+         if FB40A00.AlphaNumeric_Count /= 45 then    -- propagation.
+            Report.Failed ("Incorrect string processing");
+         end if;
+
+      when others =>
+         Report.Failed ("Exception handled in an others handler");
+
+   end Process_Block;
+
+   Report.Result;
+
+end CB40A021;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a030.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a030.a
new file mode 100644
index 000000000..8b053e2f0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a030.a
@@ -0,0 +1,105 @@
+-- CB40A030.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:
+--      See CB40A031.AM.
+--
+-- TEST DESCRIPTION:
+--      See CB40A031.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         FB40A00.A
+--      => CB40A030.A
+--         CB40A031.AM
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+
+package FB40A00.CB40A030_0 is  -- package Text_Parser.Character_Counting
+
+   function Count_AlphaNumerics (Text : in String) return Natural;
+
+end FB40A00.CB40A030_0;
+
+
+     --=================================================================--
+
+
+private package  FB40A00.CB40A030_1  is    -- package Text_Parser.Processing
+
+   procedure Process_Text (Text : in String);
+
+end FB40A00.CB40A030_1;  
+
+
+     --=================================================================--
+
+
+package body  FB40A00.CB40A030_1  is
+
+   procedure Process_Text (Text : in String) is
+      Loop_Count : Integer := Text'Length + 1;
+   begin
+      for Pos in 1..Loop_Count loop          -- Process string, force the 
+                                             -- raise of Constraint_Error. 
+         if (Text (Pos) in 'a'..'z') or 
+            (Text (Pos) in 'A'..'Z') or
+            (Text (Pos) in '0'..'9') then
+            Increment_AlphaNumeric_Count;
+         else
+            Increment_Non_AlphaNumeric_Count;
+         end if;
+
+      end loop;
+      -- No exception handler here, exception propagates.
+   end Process_Text;
+
+end FB40A00.CB40A030_1;  
+
+
+     --=================================================================--
+
+
+with FB40A00.CB40A030_1;  -- private sibling package Text_Parser.Processing;
+
+package body FB40A00.CB40A030_0 is
+
+   function Count_AlphaNumerics (Text : in String) return Natural is
+   begin
+      FB40A00.CB40A030_1.Process_Text (Text);     -- Call proc in prvt child
+                                                  -- package that is a
+                                                  -- sibling of this package.
+      return (AlphaNumeric_Count);
+      -- No exception handler here, exception propagates.
+   end Count_AlphaNumerics;
+
+end FB40A00.CB40A030_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a031.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a031.am
new file mode 100644
index 000000000..6f2f2aa99
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a031.am
@@ -0,0 +1,102 @@
+-- CB40A031.AM
+--
+--                             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 predefined exception is correctly propagated from
+--      a private child package through a visible child package to a client.
+--
+-- TEST DESCRIPTION:
+--      Declare two child packages from a root package, one visible, one
+--      private.  The visible child package contains a function, whose
+--      body makes a call to a procedure contained in the private sibling
+--      package.  A predefined exception occurring in the subprogram within the
+--      private package is propagated through the visible sibling and ancestor
+--      to the test program.
+--
+--      Exception Type Raised:
+--          User Defined
+--        * Predefined  
+--
+--      Hierarchical Structure Employed For This Test:  
+--        * Parent Package
+--        * Visible Child Package
+--        * Private Child Package
+--          Visible Child Subprogram
+--          Private Child Subprogram
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         FB40A00.A
+--         CB40A030.A
+--      => CB40A031.AM
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      02 Nov 96   SAIC    ACVC 2.1: Modified prologue.
+--
+--!
+
+with Report;
+with FB40A00.CB40A030_0; -- Explicit "with" of Text_Parser.Character_Counting
+                         -- Implicit "with" of Text_Parser
+
+procedure CB40A031 is
+
+   String_Constant : constant String := 
+     "The San Diego Padres will win the World Series in 1999."; 
+
+   Number_Of_AlphaNumeric_Characters : Natural := 0;
+
+begin
+
+   Process_Block:
+   begin
+
+      Report.Test ("CB40A031", "Check that a predefined exception " &
+                               "is correctly propagated across "    &
+                               "package boundaries");
+
+      Number_Of_AlphaNumeric_Characters := 
+        FB40A00.CB40A030_0.Count_AlphaNumerics (String_Constant);
+
+      Report.Failed ("Exception should have been handled");
+
+   exception
+
+      when Constraint_Error =>                       -- Correct exception 
+         if FB40A00.AlphaNumeric_Count /= 44 then    -- propagation.
+            Report.Failed ("Incorrect string processing");
+         end if;
+
+      when others =>
+         Report.Failed ("Exception handled in an others handler");
+
+   end Process_Block;
+
+   Report.Result;
+
+end CB40A031;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a04.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a04.a
new file mode 100644
index 000000000..45209b9be
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb40a04.a
@@ -0,0 +1,119 @@
+-- CB40A04.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 predefined exception is correctly propagated out of a
+--      public child function to a client. 
+--
+-- TEST DESCRIPTION:
+--      Declare a public child subprogram.  Define the processing loop
+--      inside the subprogram to expect a string with index starting at 1.
+--      From the test procedure, call the child subprogram with a slice
+--      from the middle of a string variable.  This will cause an exception
+--      to be raised in the child and propagated to the caller.
+--
+--      Exception Type Raised:
+--          User Defined
+--        * Predefined  
+--
+--      Hierarchical Structure Employed For This Test:  
+--        * Parent Package
+--          Public Child Package
+--          Private Child Package
+--        * Public Child Subprogram
+--          Private Child Subprogram
+--
+-- TEST FILES:
+--      This test depends on the following foundation code:
+--         FB40A00.A
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+-- Child subprogram Text_Parser.Count_AlphaNumerics 
+
+function FB40A00.CB40A04_0 (Text : string) return Natural is
+begin
+
+   for I in 1 .. Text'Last loop          -- Raise immediate Constraint_Error 
+      if (Text (I) in 'a'..'z') or       -- with String slice passed from
+         (Text (I) in 'A'..'Z') or       -- caller. (Slice'first /= 1)
+         (Text (I) in '0'..'9') then
+         Increment_AlphaNumeric_Count;
+      else
+         Increment_Non_AlphaNumeric_Count;
+      end if;
+   end loop;
+
+   return (AlphaNumeric_Count);          -- Global in parent package.
+
+   -- No exception handler here, exception propagates.
+
+end FB40A00.CB40A04_0;
+
+
+     --=================================================================--
+
+
+with FB40A00.CB40A04_0; -- Explicit "with" of Text_Parser.Count_AlphaNumerics
+with Report;            -- Implicit "with" of Text_Parser.
+
+procedure CB40A04 is
+
+   String_Var : String (1..19) := "The quick brown fox";
+
+   Number_Of_AlphaNumeric_Characters : Natural := 0;
+
+begin
+
+   Report.Test ("CB40A04", "Check that a predefined exception is " &
+                           "correctly propagated out of a public " &
+                           "child function to a client");
+
+   Process_Block:
+   begin
+
+      Number_Of_AlphaNumeric_Characters :=       -- Provide slice of string
+        FB40A00.CB40A04_0 (String_Var (5..10));  -- to subprogram.
+                                                           
+      Report.Failed ("Exception should have been handled");
+
+   exception
+
+      when Constraint_Error =>                      -- Correct exception 
+         null;                                      -- propagation.
+
+      when others =>
+         Report.Failed ("Exception handled in an others handler");
+
+   end Process_Block;
+
+   Report.Result;
+
+end CB40A04;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41001.a
new file mode 100644
index 000000000..95ad868fe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41001.a
@@ -0,0 +1,213 @@
+-- CB41001.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 'Identity attribute returns the unique identity of an
+--      exception. Check that the Raise_Exception procedure can raise an 
+--      exception that is specified through the use of the 'Identity attribute,
+--      and that Reraise_Occurrence can re-raise an exception occurrence
+--      using an exception choice parameter.
+--
+-- TEST DESCRIPTION:
+--      This test uses the capability of the 'Identity attribute, which 
+--      returns the unique identity of an exception, as an Exception_Id 
+--      result.  This result is used as an input parameter to the procedure
+--      Raise_Exception.  The exception that results is handled, propagated
+--      using the Reraise_Occurrence procedure, and handled again.
+--      The above actions are performed for both a user-defined and a
+--      predefined exception.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      11 Nov 96   SAIC    ACVC 2.1: Modified Propagate_User_Exception.
+--
+--!
+
+with Report;
+with Ada.Exceptions;
+
+procedure CB41001 is
+
+begin
+
+   Report.Test ("CB41001", "Check that the 'Identity attribute returns " &
+                           "the unique identity of an exception. Check " &
+                           "that the 'Identity attribute is of type "    &
+                           "Exception_Id.  Check that the "              &
+                           "Raise_Exception procedure can raise an "     &
+                           "exception that is specified through the "    &
+                           "use of the 'Identity attribute");
+   Test_Block:
+   declare
+
+      Check_Points : constant := 5;
+
+      type Check_Point_Array_Type is array (1..Check_Points) of Boolean;
+
+      -- Global array used to track the processing path through the test.
+      TC_Check_Points : Check_Point_Array_Type := (others => False);
+
+      A_User_Defined_Exception  : Exception;
+      An_Exception_ID           : Ada.Exceptions.Exception_Id :=
+                                    Ada.Exceptions.Null_Id;
+
+      procedure Propagate_User_Exception is
+         Hidden_Exception : Exception;
+      begin
+         -- Use the 'Identity function to store the unique identity of a
+         -- user defined exception into a variable of type Exception_Id.
+
+         An_Exception_ID := A_User_Defined_Exception'Identity;
+
+         -- Raise this user defined exception using the result of the 
+         -- 'Identity attribute.
+
+         Ada.Exceptions.Raise_Exception(E => An_Exception_Id);
+
+         Report.Failed("User defined exception not raised by " &
+                       "procedure Propagate_User_Exception");
+
+      exception
+         when Proc_Excpt : A_User_Defined_Exception => -- Expected exception.
+            begin
+
+               -- By raising a different exception at this point, the 
+               -- information associated with A_User_Defined_Exception must
+               -- be correctly stacked internally.
+
+               Ada.Exceptions.Raise_Exception(Hidden_Exception'Identity);
+               Report.Failed("Hidden_Exception not raised by " &
+                             "procedure Propagate_User_Exception");
+            exception
+               when others => 
+                  TC_Check_Points(1) := True;
+
+                  -- Reraise the original exception, which will be propagated 
+                  -- outside the scope of this procedure.
+
+                  Ada.Exceptions.Reraise_Occurrence(Proc_Excpt);
+                  Report.Failed("User defined exception not reraised");
+
+            end;
+
+         when others =>
+            Report.Failed("Unexpected exception raised by " &
+                          "Procedure Propagate_User_Exception");
+      end Propagate_User_Exception;
+
+   begin
+
+      User_Exception_Block:
+      begin
+         -- Call procedure to raise, handle, and reraise a user defined 
+         -- exception.
+         Propagate_User_Exception;
+
+         Report.Failed("User defined exception not propagated from " &
+                       "procedure Propagate_User_Exception");
+
+      exception
+         when A_User_Defined_Exception => -- Expected exception.
+            TC_Check_Points(2) := True;
+         when others =>
+            Report.Failed
+              ("Unexpected exception handled in User_Exception_Block");
+      end User_Exception_Block;
+
+
+      Predefined_Exception_Block:
+      begin
+
+         Inner_Block:
+         begin
+
+            begin
+               -- Use the 'Identity attribute as an input parameter to the
+               -- Raise_Exception procedure.
+
+               Ada.Exceptions.Raise_Exception(Constraint_Error'Identity);
+               Report.Failed("Constraint_Error not raised in Inner_Block");
+
+            exception
+               when Excpt : Constraint_Error =>  -- Expected exception.
+                  TC_Check_Points(3) := True;
+
+                  -- Reraise the exception.
+                  Ada.Exceptions.Reraise_Occurrence(X => Excpt);
+                  Report.Failed("Predefined exception not raised from " &
+                                "within the exception handler - 1");
+               when others => 
+                  Report.Failed("Incorrect result from attempt to raise " &
+                                "Constraint_Error using the 'Identity "   &
+                                "attribute - 1");
+            end;
+
+            Report.Failed("Constraint_Error not reraised in Inner_Block");
+
+         exception
+            when Block_Excpt : Constraint_Error =>  -- Expected exception.
+               TC_Check_Points(4) := True;
+
+               -- Reraise the exception in a scope where the exception
+               -- was not originally raised.
+
+               Ada.Exceptions.Reraise_Occurrence(X => Block_Excpt);
+               Report.Failed("Predefined exception not raised from " &
+                             "within the exception handler - 2");
+
+            when others => 
+               Report.Failed("Incorrect result from attempt to raise " &
+                             "Constraint_Error using the 'Identity "   &
+                             "attribute - 2");
+         end Inner_Block;
+
+         Report.Failed("Exception not propagated from Inner_Block");
+
+      exception
+         when Constraint_Error =>  -- Expected exception.
+            TC_Check_Points(5) := True;
+         when others => 
+            Report.Failed("Unexpected exception handled after second " &
+                          "reraise of Constraint_Error");
+      end Predefined_Exception_Block;
+
+
+      -- Verify the processing path taken through the test.
+
+      for i in 1..Check_Points loop
+         if not TC_Check_Points(i) then
+            Report.Failed("Incorrect processing path taken through test, " &
+                          "didn't pass check point #" & Integer'Image(i));
+         end if;
+      end loop;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CB41001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41002.a
new file mode 100644
index 000000000..1b3898154
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41002.a
@@ -0,0 +1,283 @@
+-- CB41002.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 message string input parameter in a call to the
+--      Raise_Exception procedure is associated with the raised exception
+--      occurrence, and that the message string can be obtained using the
+--      Exception_Message function with the associated Exception_Occurrence
+--      object.  Check that Function Exception_Information is available
+--      to provide implementation-defined information about the exception
+--      occurrence.
+--
+-- TEST DESCRIPTION:
+--      This test checks that a message associated with a raised exception
+--      is propagated with the exception, and can be retrieved using the
+--      Exception_Message function.  The exception will be raised using the
+--      'Identity attribute as a parameter to the Raise_Exception procedure,
+--      and an associated message string will be provided.  The exception
+--      will be handled, and the message associated with the occurrence will
+--      be compared to the original source message (non-default).
+--
+--      The test also includes a simulated logging procedure
+--      (Check_Exception_Information) that checks that Exception_Information
+--      can be called.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      22 Jun 00   RLB     Added a check at Exception_Information can be
+--                          called.
+--
+--!
+
+with Report;
+with Ada.Exceptions;
+
+procedure CB41002 is
+begin
+
+   Report.Test ("CB41002", "Check that the message string input parameter " &
+                           "in a call to the Raise_Exception procedure is " &
+                           "associated with the raised exception "          &
+                           "occurrence, and that the message string can "   &
+                           "be obtained using the Exception_Message "       &
+                           "function with the associated "                  &
+                           "Exception_Occurrence object. Also check that "  &
+                           "the Exception_Information function can be called");
+
+   Test_Block:
+   declare
+
+      Number_Of_Exceptions : constant := 3;
+
+      User_Exception_1,
+      User_Exception_2,
+      User_Exception_3 : exception;
+
+      type String_Ptr is access String;
+
+      User_Messages : constant array (1..Number_Of_Exceptions)
+        of String_Ptr :=
+        (new String'("Msg"),
+         new String'("This message will override the default "   &
+                     "message provided by the implementation"),
+         new String'("The message can be captured by procedure"  & -- 200 chars
+                      " Exception_Message.  It is designed to b" &
+                      "e exactly 200 characters in length, sinc" &
+                      "e there is a permission  concerning the " &
+                      "truncation of a message over 200 chars. "));
+
+      procedure Check_Exception_Information (
+                 Occur : in Ada.Exceptions.Exception_Occurrence) is
+          -- Simulates an error logging routine.
+         Info : constant String :=
+              Ada.Exceptions.Exception_Information (Occur);
+         function Is_Substring_of (Target, Search : in String) return Boolean is
+            -- Returns True if Search is a substring of Target, and False
+            -- otherwise.
+         begin
+            for I in Report.Ident_Int(Target'First) ..
+                     Target'Last - Search'Length + 1 loop
+               if Target(I .. I+Search'Length-1) = Search then
+                  return True;
+               end if;
+            end loop;
+            return False;
+         end Is_Substring_of;
+      begin
+         -- We can't display Info, as it often contains line breaks
+         -- (confusing Report), and might look much like the failure of a test
+         -- with an unhandled exception (thus confusing grading tools).
+         --
+         -- We don't particular care if the implementation advice is followed,
+         -- but we make these checks to insure that a compiler cannot optimize
+         -- away Info or the rest of this routine.
+         if not Is_Substring_of (Info,
+                       Ada.Exceptions.Exception_Name (Occur)) then
+             Report.Comment ("Exception_Information does not contain " &
+                             "Exception_Name - see 11.4.1(19)");
+         elsif not Is_Substring_of (Info,
+                       Ada.Exceptions.Exception_Message (Occur)) then
+             Report.Comment ("Exception_Information does not contain " &
+                             "Exception_Message - see 11.4.1(19)");
+         end if;
+      end Check_Exception_Information;
+
+   begin
+
+      for i in 1..Number_Of_Exceptions loop
+         begin
+
+            -- Raise a user-defined exception with a specific message string.
+            case i is
+               when 1 =>
+                  Ada.Exceptions.Raise_Exception(User_Exception_1'Identity,
+                                                 User_Messages(i).all);
+               when 2 =>
+                  Ada.Exceptions.Raise_Exception(User_Exception_2'Identity,
+                                                 User_Messages(i).all);
+               when 3 =>
+                  Ada.Exceptions.Raise_Exception(User_Exception_3'Identity,
+                                                 User_Messages(i).all);
+               when others =>
+                  Report.Failed("Incorrect result from Case statement");
+            end case;
+
+            Report.Failed
+              ("Exception not raised by procedure Exception_With_Message " &
+               "for User_Exception #" & Integer'Image(i));
+
+         exception
+            when Excptn : others =>
+
+               begin
+                  -- The message that is associated with the raising of each
+                  -- exception is captured here using the Exception_Message
+                  -- function.
+
+                  if User_Messages(i).all /=
+                     Ada.Exceptions.Exception_Message(Excptn)
+                  then
+                     Report.Failed
+                       ("Message captured from exception is not the "  &
+                        "message provided when the exception was raised, " &
+                        "User_Exception #" & Integer'Image(i));
+                  end if;
+
+                  Check_Exception_Information(Excptn);
+               end;
+         end;
+      end loop;
+
+
+
+      -- Verify that the exception specific message is carried across
+      -- various boundaries:
+
+      begin
+
+         begin
+            Ada.Exceptions.Raise_Exception(User_Exception_1'Identity,
+                                           User_Messages(1).all);
+            Report.Failed("User_Exception_1 not raised");
+         end;
+         Report.Failed("User_Exception_1 not propagated");
+      exception
+         when Excptn : User_Exception_1 =>
+
+            if User_Messages(1).all /=
+               Ada.Exceptions.Exception_Message(Excptn)
+            then
+               Report.Failed("User_Message_1 not found");
+            end if;
+            Check_Exception_Information(Excptn);
+
+         when others => Report.Failed("Unexpected exception handled - 1");
+      end;
+
+
+
+      begin
+
+         begin
+            Ada.Exceptions.Raise_Exception(User_Exception_2'Identity,
+                                           User_Messages(2).all);
+            Report.Failed("User_Exception_2 not raised");
+         exception
+            when Exc : User_Exception_2 =>
+
+               -- The exception is reraised here; message should propagate
+               -- with exception occurrence.
+
+               Ada.Exceptions.Reraise_Occurrence(Exc);
+            when others => Report.Failed("User_Exception_2 not handled");
+         end;
+         Report.Failed("User_Exception_2 not propagated");
+      exception
+         when Excptn : User_Exception_2 =>
+
+            if User_Messages(2).all /=
+               Ada.Exceptions.Exception_Message(Excptn)
+            then
+               Report.Failed("User_Message_2 not found");
+            end if;
+            Check_Exception_Information(Excptn);
+
+         when others => Report.Failed("Unexpected exception handled - 2");
+      end;
+
+
+      -- Check exception and message propagation across task boundaries.
+
+      declare
+
+         task Raise_An_Exception is  -- single task
+            entry Raise_It;
+         end Raise_An_Exception;
+
+         task body Raise_An_Exception is
+         begin
+            accept Raise_It do
+               Ada.Exceptions.Raise_Exception(User_Exception_3'Identity,
+                                              User_Messages(3).all);
+            end Raise_It;
+            Report.Failed("User_Exception_3 not raised");
+         exception
+            when Excptn : User_Exception_3 =>
+               if User_Messages(3).all /=
+                  Ada.Exceptions.Exception_Message(Excptn)
+               then
+                  Report.Failed
+                    ("User_Message_3 not returned inside task body");
+               end if;
+               Check_Exception_Information(Excptn);
+            when others =>
+               Report.Failed("Incorrect exception raised in task body");
+         end Raise_An_Exception;
+
+      begin
+         Raise_An_Exception.Raise_It;  -- Exception will be propagated here.
+         Report.Failed("User_Exception_3 not propagated to caller");
+      exception
+         when Excptn : User_Exception_3 =>
+            if User_Messages(3).all /=
+               Ada.Exceptions.Exception_Message(Excptn)
+            then
+               Report.Failed("User_Message_3 not returned to caller of task");
+            end if;
+            Check_Exception_Information(Excptn);
+         when others =>
+            Report.Failed("Incorrect exception raised by task");
+      end;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CB41002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41003.a
new file mode 100644
index 000000000..aee0b094c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41003.a
@@ -0,0 +1,358 @@
+-- CB41003.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 an exception occurrence can be saved into an object of
+--      type Exception_Occurrence using the procedure Save_Occurrence.
+--      Check that a saved exception occurrence can be used to reraise 
+--      another occurrence of the same exception using the procedure
+--      Reraise_Occurrence.  Check that the function Save_Occurrence will
+--      allocate a new object of type Exception_Occurrence_Access, and saves
+--      the source exception to the new object which is returned as the 
+--      function result.
+--
+-- TEST DESCRIPTION:
+--      This test verifies that an occurrence of an exception can be saved,
+--      using either of two overloaded versions of Save_Occurrence.  The
+--      procedure version of Save_Occurrence is used to save an occurrence
+--      of a user defined exception into an object of type 
+--      Exception_Occurrence.  This object is then used as an input 
+--      parameter to procedure Reraise_Occurrence, the expected exception is
+--      handled, and the exception id of the handled exception is compared
+--      to the id of the originally raised exception.
+--      The function version of Save_Occurrence returns a result of 
+--      Exception_Occurrence_Access, and is used to store the value of another
+--      occurrence of the user defined exception.  The resulting access value
+--      is dereferenced and used as an input to Reraise_Occurrence.  The
+--      resulting exception is handled, and the exception id of the handled 
+--      exception is compared to the id of the originally raised exception.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with Ada.Exceptions;
+
+procedure CB41003 is
+
+begin
+
+   Report.Test ("CB41003", "Check that an exception occurrence can "   &
+                           "be saved into an object of type "          &
+                           "Exception_Occurrence using the procedure " &
+                           "Save_Occurrence");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+
+      User_Exception_1,
+      User_Exception_2   : Exception;
+
+      Saved_Occurrence   : Exception_Occurrence;
+      Occurrence_Ptr     : Exception_Occurrence_Access;
+
+      User_Message       : constant String :=   -- 200 character string.
+        "The string returned by Exception_Message may be tr" &
+        "uncated (to no less then 200 characters) by the Sa" &
+        "ve_Occurrence procedure (not the function), the Re" &
+        "raise_Occurrence proc, and the re-raise statement.";
+
+   begin
+
+      Raise_And_Save_Block_1 :
+      begin
+
+         -- This nested exception structure is designed to ensure that the
+         -- appropriate exception occurrence is saved using the 
+         -- Save_Occurrence procedure.
+
+         raise Program_Error;
+         Report.Failed("Program_Error not raised");
+
+      exception
+         when Program_Error => 
+
+            begin
+               -- Use the procedure Raise_Exception, along with the 'Identity
+               -- attribute to raise the first user defined exception.  Note
+               -- that a 200 character message is included in the call.
+
+               Raise_Exception(User_Exception_1'Identity, User_Message);
+               Report.Failed("User_Exception_1 not raised");
+
+            exception
+               when Exc : User_Exception_1 => 
+
+                  -- This exception occurrence is saved into a variable using
+                  -- procedure Save_Occurrence.  This saved occurrence should
+                  -- not be confused with the raised occurrence of 
+                  -- Program_Error above.
+
+                  Save_Occurrence(Target => Saved_Occurrence, Source => Exc);
+
+               when others => 
+                  Report.Failed("Unexpected exception handled, expecting " &
+                                "User_Exception_1");
+            end;
+
+         when others => 
+            Report.Failed("Incorrect exception generated by raise statement");
+
+      end Raise_And_Save_Block_1;
+
+
+      Reraise_And_Handle_Saved_Exception_1 :
+      begin
+         -- Reraise the exception that was saved in the previous block.
+
+         Reraise_Occurrence(X => Saved_Occurrence);
+
+      exception
+         when Exc : User_Exception_1 => -- Expected exception.
+            -- Check the exception id of the handled id by using the 
+            -- Exception_Identity function, and compare with the id of the
+            -- originally raised exception.
+
+            if User_Exception_1'Identity /= Exception_Identity(Exc) then
+               Report.Failed("Exception_Ids do not match - 1");
+            end if;
+
+            -- Check that the message associated with this exception occurrence
+            -- has not been truncated (it was originally 200 characters).
+
+            if User_Message /= Exception_Message(Exc) then
+               Report.Failed("Exception messages do not match - 1");
+            end if;
+
+         when others => 
+            Report.Failed
+              ("Incorrect exception raised by Reraise_Occurrence - 1");
+      end Reraise_And_Handle_Saved_Exception_1;
+
+
+      Raise_And_Save_Block_2 :
+      begin
+
+         Raise_Exception(User_Exception_2'Identity, User_Message);
+         Report.Failed("User_Exception_2 not raised");
+
+      exception
+         when Exc : User_Exception_2 => 
+
+            -- This exception occurrence is saved into an access object 
+            -- using function Save_Occurrence.
+
+            Occurrence_Ptr := Save_Occurrence(Source => Exc);
+
+         when others => 
+            Report.Failed("Unexpected exception handled, expecting " &
+                          "User_Exception_2");
+      end Raise_And_Save_Block_2;
+
+
+      Reraise_And_Handle_Saved_Exception_2 :
+      begin
+         -- Reraise the exception that was saved in the previous block.
+         -- Dereference the access object for use as input parameter.
+
+         Reraise_Occurrence(X => Occurrence_Ptr.all);
+
+      exception
+         when Exc : User_Exception_2 => -- Expected exception.
+            -- Check the exception id of the handled id by using the 
+            -- Exception_Identity function, and compare with the id of the
+            -- originally raised exception.
+
+            if User_Exception_2'Identity /= Exception_Identity(Exc) then
+               Report.Failed("Exception_Ids do not match - 2");
+            end if;
+
+            -- Check that the message associated with this exception occurrence
+            -- has not been truncated (it was originally 200 characters).
+
+            if User_Message /= Exception_Message(Exc) then
+               Report.Failed("Exception messages do not match - 2");
+            end if;
+
+         when others => 
+            Report.Failed
+              ("Incorrect exception raised by Reraise_Occurrence - 2");
+       end Reraise_And_Handle_Saved_Exception_2;
+
+
+       -- Another example of the use of saving an exception occurrence
+       -- is demonstrated in the following block, where the ability to 
+       -- save an occurrence into a data structure, for later processing,
+       -- is modeled.
+
+       Store_And_Handle_Block:
+       declare
+          
+          Exc_Number  : constant := 3;
+          Exception_1, 
+          Exception_2, 
+          Exception_3 : exception;
+
+          Exception_Storage : array (1..Exc_Number) of Exception_Occurrence;
+          Messages          : array (1..Exc_Number) of String(1..9) :=
+                                ("Message 1", "Message 2", "Message 3");
+
+       begin
+
+          Outer_Block:
+          begin
+
+             Inner_Block:
+             begin
+
+                for i in 1..Exc_Number loop
+                   begin
+
+                      begin
+                         -- Exceptions all raised in a deep scope.
+                         if i = 1 then
+                            Raise_Exception(Exception_1'Identity, Messages(i));
+                         elsif i = 2 then
+                            Raise_Exception(Exception_2'Identity, Messages(i));
+                         elsif i = 3 then
+                            Raise_Exception(Exception_3'Identity, Messages(i));
+                         end if;
+                         Report.Failed("Exception not raised on loop #" &
+                                       Integer'Image(i));
+                      end;
+                      Report.Failed("Exception not propagated on loop #" &
+                                    Integer'Image(i));
+                   exception
+                      when Exc : others =>
+
+                         -- Save each occurrence into a storage array for 
+                         -- later processing.
+
+                         Save_Occurrence(Exception_Storage(i), Exc);
+                   end;
+                end loop;
+
+             end Inner_Block;
+          end Outer_Block;
+
+          -- Raise the exceptions from the stored occurrences, and handle.
+
+          for i in 1..Exc_Number loop
+             begin
+                Reraise_Occurrence(Exception_Storage(i));
+                Report.Failed("No exception reraised for " &
+                              "exception #" & Integer'Image(i));
+             exception
+                when Exc   : others =>
+                   -- The following sequence of checks ensures that the 
+                   -- correct occurrence was stored, and the associated
+                   -- exception was raised and handled in the proper order.
+                   if i = 1 then
+                      if Exception_1'Identity /= Exception_Identity(Exc) then
+                         Report.Failed("Exception_1 not raised");
+                      end if;
+                   elsif i = 2 then
+                      if Exception_2'Identity /= Exception_Identity(Exc) then
+                         Report.Failed("Exception_2 not raised");
+                      end if;
+                   elsif i = 3 then
+                      if Exception_3'Identity /= Exception_Identity(Exc) then
+                         Report.Failed("Exception_3 not raised");
+                      end if;
+                   end if;
+
+                   if Exception_Message(Exc) /= Messages(i) then
+                      Report.Failed("Incorrect message associated with " &
+                                    "exception #" & Integer'Image(i));
+                   end if;
+             end;
+          end loop;
+       exception
+          when others => 
+            Report.Failed("Unexpected exception in Store_And_Handle_Block");
+       end Store_And_Handle_Block;
+
+
+      Reraise_Out_Of_Scope:
+      declare
+
+         TC_Value      : constant := 5;
+         The_Exception : exception;
+         Saved_Exc_Occ : Exception_Occurrence;
+
+         procedure Handle_It (Exc_Occ : in Exception_Occurrence) is
+            Must_Be_Raised : exception;
+         begin
+            if Exception_Identity(Exc_Occ) = The_Exception'Identity then
+               raise Must_Be_Raised;
+               Report.Failed("Exception Must_Be_Raised was not raised");
+            else
+               Report.Failed("Incorrect exception handled in " &
+                             "Procedure Handle_It");
+            end if;
+         end Handle_It;
+
+      begin
+
+         if Report.Ident_Int(5) = TC_Value then
+            raise The_Exception;
+         end if;
+
+      exception
+         when Exc : others => 
+            Save_Occurrence (Saved_Exc_Occ, Exc);
+            begin
+               Handle_It(Saved_Exc_Occ);   -- Raise another exception, in a
+            exception                      -- different scope.
+               when others =>              -- Handle this new exception.
+                  begin
+                     Reraise_Occurrence (Saved_Exc_Occ);  -- Reraise the
+                                                          -- original excptn.
+                     Report.Failed("Saved Exception was not raised");
+                  exception                               
+                     when Exc_2 : others =>
+                        if Exception_Identity (Exc_2) /= 
+                           The_Exception'Identity 
+                        then
+                           Report.Failed
+                             ("Incorrect exception occurrence reraised");
+                        end if;
+                  end;
+            end;
+      end Reraise_Out_Of_Scope;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CB41003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41004.a
new file mode 100644
index 000000000..5a7b70494
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb41004.a
@@ -0,0 +1,299 @@
+-- CB41004.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 Raise_Exception and Reraise_Occurrence have no effect in
+--      the case of Null_Id or Null_Occurrence.  Check that Exception_Message,
+--      Exception_Identity, Exception_Name, and Exception_Information raise
+--      Constraint_Error for a Null_Occurrence input parameter.
+--      Check that calling the Save_Occurrence subprograms with the
+--      Null_Occurrence input parameter saves the Null_Occurrence to the
+--      appropriate target object, and does not raise Constraint_Error.
+--      Check that Null_Id is the default initial value of type Exception_Id.
+--
+-- TEST DESCRIPTION:
+--      This test performs a series of calls to many of the subprograms
+--      defined in package Ada.Exceptions, using either Null_Id or
+--      Null_Occurrence (based on their parameter profile).  In the cases of
+--      Raise_Exception and Reraise_Occurrence, these null input values
+--      should result in no exceptions being raised, and Constraint_Error
+--      should not be raised in response to these calls.  Test failure will
+--      result if any exception is raised in these cases.
+--      For the Save_Occurrence subprograms, calling them with the
+--      Null_Occurrence input parameter does not raise Constraint_Error, but
+--      simply results in the Null_Occurrence being saved into the appropriate
+--      target (either a Exception_Occurrence out parameter, or as an
+--      Exception_Occurrence_Access value).
+--      In the cases of the other mentioned subprograms, calls performed with
+--      a Null_Occurrence input parameter must result in Constraint_Error
+--      being raised.  This exception will be handled, with test failure the
+--      result if the exception is not raised.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      08 Dec 00   RLB     Removed Exception_Identity subtest, pending
+--                          resolution of AI95-00241.
+--                          Notes for future: Replace Exception_Identity
+--                          subtest with whatever the resolution is.
+--                          Add a subtest for Exception_Name(Null_Id), which
+--                          is missing from this test.
+--!
+
+with Report;
+with Ada.Exceptions;
+
+procedure CB41004 is
+begin
+
+   Report.Test ("CB41004", "Check that Null_Id and Null_Occurrence input " &
+                           "parameters have the appropriate effect when "  &
+                           "used in calls of the subprograms found in "    &
+                           "package Ada.Exceptions");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+
+      -- No initial values given for these two declarations; they default
+      -- to Null_Id and Null_Occurrence respectively.
+      A_Null_Exception_Id         : Ada.Exceptions.Exception_Id;
+      A_Null_Exception_Occurrence : Ada.Exceptions.Exception_Occurrence;
+
+      TC_Flag : Boolean := False;
+
+   begin
+
+      -- Verify that Null_Id is the default initial value of type
+      -- Exception_Id.
+
+      if not (A_Null_Exception_Id = Ada.Exceptions.Null_Id) then
+         Report.Failed("The default initial value of an object of type " &
+                       "Exception_Id was not Null_Id");
+      end if;
+
+
+      -- Verify that Reraise_Occurrence has no effect in the case of
+      -- Null_Occurrence.
+      begin
+         Ada.Exceptions.Reraise_Occurrence(A_Null_Exception_Occurrence);
+         TC_Flag := True;
+      exception
+         when others =>
+            Report.Failed
+              ("Exception raised by procedure Reraise_Occurrence " &
+               "when called with a Null_Occurrence input parameter");
+      end;
+
+      if not TC_Flag then
+         Report.Failed("Incorrect processing following the call to " &
+                       "Reraise_Occurrence with a Null_Occurrence "  &
+                       "input parameter");
+      end if;
+
+
+      -- Verify that function Exception_Message raises Constraint_Error for
+      -- a Null_Occurrence input parameter.
+      begin
+         declare
+            Msg : constant String :=
+              Ada.Exceptions.Exception_Message(A_Null_Exception_Occurrence);
+         begin
+            Report.Failed
+              ("Constraint_Error not raised by Function Exception_Message " &
+               "when called with a Null_Occurrence input parameter");
+         end;
+      exception
+         when Constraint_Error => null; -- OK, expected exception.
+         when others =>
+            Report.Failed
+              ("Unexpected exception raised by Function Exception_Message " &
+               "when called with a Null_Occurrence input parameter");
+      end;
+
+
+--      -- Verify that function Exception_Identity raises Constraint_Error for
+--      -- a Null_Occurrence input parameter.
+--      -- Note: (RLB, 2000/12/08) This behavior may be modified by AI-00241.
+--      -- As such, this test case has been removed pending a resolution.
+--      begin
+--         declare
+--            Id : Ada.Exceptions.Exception_Id :=
+--              Ada.Exceptions.Exception_Identity(A_Null_Exception_Occurrence);
+--         begin
+--            Report.Failed
+--              ("Constraint_Error not raised by Function Exception_Identity " &
+--               "when called with a Null_Occurrence input parameter");
+--         end;
+--      exception
+--         when Constraint_Error => null; -- OK, expected exception.
+--         when others =>
+--            Report.Failed
+--              ("Unexpected exception raised by Function Exception_Identity " &
+--               "when called with a Null_Occurrence input parameter");
+--      end;
+
+
+      -- Verify that function Exception_Name raises Constraint_Error for
+      -- a Null_Occurrence input parameter.
+      begin
+         declare
+            Name : constant String :=
+              Ada.Exceptions.Exception_Name(A_Null_Exception_Occurrence);
+         begin
+            Report.Failed
+              ("Constraint_Error not raised by Function Exception_Name " &
+               "when called with a Null_Occurrence input parameter");
+         end;
+      exception
+         when Constraint_Error => null; -- OK, expected exception.
+         when others =>
+            Report.Failed
+              ("Unexpected exception raised by Function Exception_Null " &
+               "when called with a Null_Occurrence input parameter");
+      end;
+
+
+      -- Verify that function Exception_Information raises Constraint_Error
+      -- for a Null_Occurrence input parameter.
+      begin
+         declare
+            Info : constant String :=
+              Ada.Exceptions.Exception_Information
+                               (A_Null_Exception_Occurrence);
+         begin
+            Report.Failed
+              ("Constraint_Error not raised by Function "  &
+               "Exception_Information when called with a " &
+               "Null_Occurrence input parameter");
+         end;
+      exception
+         when Constraint_Error => null; -- OK, expected exception.
+         when others =>
+            Report.Failed
+              ("Unexpected exception raised by Function Exception_Null " &
+               "when called with a Null_Occurrence input parameter");
+      end;
+
+
+      -- Verify that calling the Save_Occurrence procedure with a
+      -- Null_Occurrence input parameter saves the Null_Occurrence to the
+      -- target object, and does not raise Constraint_Error.
+      declare
+         use Ada.Exceptions;
+         Saved_Occurrence : Exception_Occurrence;
+      begin
+
+         -- Initialize the Saved_Occurrence variable with a value other than
+         -- Null_Occurrence (default).
+         begin
+            raise Program_Error;
+         exception
+            when Exc : others => Save_Occurrence(Saved_Occurrence, Exc);
+         end;
+
+         -- Save a Null_Occurrence input parameter.
+         begin
+            Save_Occurrence(Target => Saved_Occurrence,
+                            Source => Ada.Exceptions.Null_Occurrence);
+         exception
+            when others =>
+               Report.Failed
+                 ("Unexpected exception raised by procedure "           &
+                  "Save_Occurrence when called with a Null_Occurrence " &
+                  "input parameter");
+         end;
+
+         -- Verify that the occurrence that was saved above is a
+         -- Null_Occurrence value.
+
+         begin
+            Reraise_Occurrence(Saved_Occurrence);
+         exception
+            when others =>
+               Report.Failed("Value saved from Procedure Save_Occurrence " &
+                             "resulted in an exception, i.e., was not a "  &
+                             "value of Null_Occurrence");
+         end;
+
+      exception
+         when others =>
+            Report.Failed("Unexpected exception raised during evaluation " &
+                          "of Procedure Save_Occurrence");
+      end;
+
+
+      -- Verify that calling the Save_Occurrence function with a
+      -- Null_Occurrence input parameter returns the Null_Occurrence as the
+      -- function result, and does not raise Constraint_Error.
+      declare
+         Occurrence_Ptr : Ada.Exceptions.Exception_Occurrence_Access;
+      begin
+         -- Save a Null_Occurrence input parameter.
+         begin
+            Occurrence_Ptr :=
+              Ada.Exceptions.Save_Occurrence(Ada.Exceptions.Null_Occurrence);
+         exception
+            when others =>
+               Report.Failed
+                 ("Unexpected exception raised by function "            &
+                  "Save_Occurrence when called with a Null_Occurrence " &
+                  "input parameter");
+         end;
+
+         -- Verify that the occurrence that was saved above is a
+         -- Null_Occurrence value.
+
+         begin
+            -- Dereferenced value of type Exception_Occurrence_Access
+            -- should be a Null_Occurrence value, based on the action
+            -- of Function Save_Occurrence above.  Providing this as an
+            -- input parameter to Reraise_Exception should not result in
+            -- any exception being raised.
+
+            Ada.Exceptions.Reraise_Occurrence(Occurrence_Ptr.all);
+
+         exception
+            when others =>
+               Report.Failed("Value saved from Function Save_Occurrence " &
+                             "resulted in an exception, i.e., was not a "  &
+                             "value of Null_Occurrence");
+         end;
+      exception
+         when others =>
+            Report.Failed("Unexpected exception raised during evaluation " &
+                          "of Function Save_Occurrence");
+      end;
+
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CB41004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb5001a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb5001a.ada
new file mode 100644
index 000000000..5cf563fdc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb5001a.ada
@@ -0,0 +1,87 @@
+-- CB5001A.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 EXCEPTION RAISED IN A RENDEVOUS IS PROPAGATED BOTH TO
+-- THE CALLER AND TO THE CALLED TASK.
+
+-- THIS VERSION CHECKS THAT THE EXCEPTION IS PROPAGATED THROUGH ONE
+-- LEVEL OF RENDEVOUS.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- JEAN-PIERRE ROSEN 09 MARCH 1984
+-- JBG 6/1/84
+-- MRM 03/30/93   REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CB5001A IS
+
+BEGIN
+
+     TEST("CB5001A", "CHECK THAT AN EXCEPTION IN A RENDEVOUS IS " &
+                     "PROPAGATED TO CALLER AND CALLED TASKS -- ONE " &
+                     "LEVEL");
+
+     DECLARE
+          TASK T2 IS
+               ENTRY E2;
+          END T2;
+     
+          TASK BODY T2 IS
+               MY_EXCEPTION: EXCEPTION;
+          BEGIN
+               ACCEPT E2 DO 
+                    IF EQUAL (1,1) THEN
+                         RAISE MY_EXCEPTION; 
+                    END IF;
+               END E2;
+               FAILED ("T2: EXCEPTION NOT RAISED");
+          EXCEPTION
+               WHEN MY_EXCEPTION => 
+                    NULL;
+               WHEN TASKING_ERROR =>
+                    FAILED ("TASKING_ERROR RAISED IN T2");
+               WHEN OTHERS =>
+                    FAILED ("T2 RECEIVED ABNORMAL EXCEPTION");
+          END T2;
+     
+     BEGIN 
+          T2.E2;
+          FAILED ("MAIN: EXCEPTION NOT RAISED");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR | PROGRAM_ERROR | STORAGE_ERROR =>
+               FAILED ("PREDEFINED ERROR RAISED IN MAIN");
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED IN MAIN");
+          WHEN OTHERS => 
+               NULL;
+     END;
+
+     RESULT;
+
+END CB5001A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb5001b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb5001b.ada
new file mode 100644
index 000000000..35dff52f7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb5001b.ada
@@ -0,0 +1,106 @@
+-- CB5001B.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 EXCEPTION RAISED IN A RENDEVOUS IS PROPAGATED BOTH TO
+-- THE CALLER AND TO THE CALLED TASK.
+
+-- THIS VERSION CHECKS THAT THE EXCEPTION IS PROPAGATED THROUGH TWO
+-- LEVELS OF RENDEVOUS.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- JEAN-PIERRE ROSEN 09 MARCH 1984
+-- JBG 6/1/84
+-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CB5001B IS
+
+BEGIN
+
+     TEST("CB5001B", "CHECK THAT AN EXCEPTION IN A RENDEVOUS IS " &
+                     "PROPAGATED TO CALLER AND CALLED TASKS -- TWO " &
+                     "LEVELS");
+
+     DECLARE
+          TASK T1 IS
+               ENTRY E1;
+          END T1;
+     
+          TASK T2 IS
+               ENTRY E2;
+          END T2;
+     
+          TASK BODY T1 IS
+          BEGIN
+               ACCEPT E1 DO 
+                    T2.E2; 
+               END E1;
+               FAILED ("T1: EXCEPTION NOT RAISED");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR | PROGRAM_ERROR =>
+                    FAILED ("PREDEFINED EXCEPTION RAISED IN T1");
+               WHEN TASKING_ERROR =>
+                    FAILED ("TASKING_ERROR RAISED IN T1");
+               WHEN OTHERS => 
+                    NULL;
+          END T1;
+     
+          TASK BODY T2 IS
+               MY_EXCEPTION: EXCEPTION;
+          BEGIN
+               ACCEPT E2 DO 
+                    IF EQUAL (1,1) THEN
+                         RAISE MY_EXCEPTION; 
+                    END IF;
+               END E2;
+               FAILED ("T2: EXCEPTION NOT RAISED");
+          EXCEPTION
+               WHEN MY_EXCEPTION => 
+                    NULL;
+               WHEN TASKING_ERROR =>
+                    FAILED ("TASKING_ERROR RAISED IN T2");
+               WHEN OTHERS =>
+                    FAILED ("T2 RECEIVED ABNORMAL EXCEPTION");
+          END T2;
+     
+     BEGIN 
+          T1.E1;
+          FAILED ("MAIN: EXCEPTION NOT RAISED");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR | PROGRAM_ERROR =>
+               FAILED ("PREDEFINED ERROR RAISED IN MAIN");
+          WHEN TASKING_ERROR =>
+               FAILED ("TASKING_ERROR RAISED IN MAIN");
+          WHEN OTHERS => 
+               NULL;
+     END;
+
+     RESULT;
+
+END CB5001B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb5002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb5002a.ada
new file mode 100644
index 000000000..f4484bcc4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cb/cb5002a.ada
@@ -0,0 +1,168 @@
+-- CB5002A.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 "TASKING_ERROR" IS RAISED EXPLICITLY OR BY
+--     PROPAGATION WITHIN AN ACCEPT STATEMENT, THEN "TASKING_ERROR"
+--     IS RAISED IN BOTH THE CALLING AND THE CALLED TASK.
+
+-- HISTORY:
+--     DHH 03/31/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CB5002A IS
+
+BEGIN
+     TEST("CB5002A", "CHECK THAT WHEN ""TASKING_ERROR"" IS RAISED " &
+                     "EXPLICITLY OR BY PROPAGATION WITHIN AN ACCEPT " &
+                     "STATEMENT, THEN ""TASKING_ERROR"" IS RAISED " &
+                     "IN BOTH THE CALLING AND THE CALLED TASK");
+
+     DECLARE
+          TASK CALLING_EXP IS
+               ENTRY A;
+          END CALLING_EXP;
+
+          TASK CALLED_EXP IS
+               ENTRY B;
+               ENTRY STOP;
+          END CALLED_EXP;
+
+          TASK CALLING_PROP IS
+               ENTRY C;
+          END CALLING_PROP;
+
+          TASK CALLED_PROP IS
+               ENTRY D;
+               ENTRY STOP;
+          END CALLED_PROP;
+
+          TASK PROP IS
+               ENTRY E;
+               ENTRY STOP;
+          END PROP;
+-----------------------------------------------------------------------
+          TASK BODY CALLING_EXP IS
+          BEGIN
+               ACCEPT A DO
+                    BEGIN
+                         CALLED_EXP.B;
+                         FAILED("EXCEPTION NOT RAISED IN CALLING " &
+                                "TASK - EXPLICIT RAISE");
+                    EXCEPTION
+                         WHEN TASKING_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("WRONG EXCEPTION RAISED IN " &
+                                     "CALLING TASK - EXPLICIT RAISE");
+                    END; -- EXCEPTION
+               END A;
+          END CALLING_EXP;
+
+          TASK BODY CALLED_EXP IS
+          BEGIN
+               BEGIN
+                    ACCEPT B DO
+                         RAISE TASKING_ERROR;
+                         FAILED("EXCEPTION NOT RAISED IN CALLED " &
+                                "TASK - EXPLICIT RAISE");
+                    END B;
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("WRONG EXCEPTION RAISED IN CALLED " &
+                                "TASK - EXPLICIT RAISE");
+               END;  -- EXCEPTION BLOCK
+
+               ACCEPT STOP;
+          END CALLED_EXP;
+
+-----------------------------------------------------------------------
+          TASK BODY CALLING_PROP IS
+          BEGIN
+               ACCEPT C DO
+                    BEGIN
+                         CALLED_PROP.D;
+                         FAILED("EXCEPTION NOT RAISED IN CALLING " &
+                                "TASK - PROPAGATED RAISE");
+                    EXCEPTION
+                         WHEN TASKING_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED("WRONG EXCEPTION RAISED IN " &
+                                     "CALLING TASK - PROPAGATED RAISE");
+                    END;  -- EXCEPTION
+               END C;
+          END CALLING_PROP;
+
+          TASK BODY CALLED_PROP IS
+          BEGIN
+               BEGIN
+                    ACCEPT D DO
+                         PROP.E;
+                         FAILED("EXCEPTION NOT RAISED IN CALLED " &
+                                "TASK - PROPAGATED RAISE");
+                    END D;
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("WRONG EXCEPTION RAISED IN CALLED " &
+                                "TASK - PROPAGATED RAISE");
+               END;  -- EXCEPTION BLOCK;
+
+               ACCEPT STOP;
+          END CALLED_PROP;
+
+          TASK BODY PROP IS
+          BEGIN
+               BEGIN
+                    ACCEPT E DO
+                         RAISE TASKING_ERROR;
+                         FAILED("EXCEPTION NOT RAISED IN PROPAGATE " &
+                                "TASK - ACCEPT E");
+                    END E;
+               EXCEPTION
+                    WHEN TASKING_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED("WRONG EXCEPTION RAISED IN PROP. TASK");
+              END;    -- EXCEPTION BLOCK
+
+              ACCEPT STOP;
+
+          END PROP;
+-----------------------------------------------------------------------
+     BEGIN
+          CALLING_EXP.A;
+          CALLING_PROP.C;
+          CALLED_EXP.STOP;
+          CALLED_PROP.STOP;
+          PROP.STOP;
+
+     END;    -- DECLARE
+
+     RESULT;
+END CB5002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1004a.ada
new file mode 100644
index 000000000..f5a148115
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1004a.ada
@@ -0,0 +1,108 @@
+-- CC1004A.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 ELABORATION OF A GENERIC DECLARATION
+--     DOES NOT ELABORATE THE SUBPROGRAM OR PACKAGE SPECIFICATION.
+
+-- HISTORY:
+--     DAT 07/31/81  CREATED ORIGINAL TEST.
+--     SPS 10/18/82
+--     SPS 02/09/83
+--     JET 01/07/88  UPDATED HEADER FORMAT AND ADDED CODE TO
+--                   PREVENT OPTIMIZATION.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1004A IS
+BEGIN
+     TEST ("CC1004A", "THE SPECIFICATION PART OF A GENERIC " &
+                      "SUBPROGRAM IS NOT ELABORATED AT THE " &
+                      "ELABORATION OF THE DECLARATION");
+
+     BEGIN
+          DECLARE
+               SUBTYPE I1 IS INTEGER RANGE 1 .. 1;
+
+               GENERIC
+               PROCEDURE PROC (P1: I1 := IDENT_INT(2));
+
+               PROCEDURE PROC (P1: I1 := IDENT_INT(2)) IS
+               BEGIN
+                    IF NOT EQUAL (P1,P1) THEN
+                         COMMENT ("DON'T OPTIMIZE THIS");
+                    END IF;
+               END PROC;
+          BEGIN
+               BEGIN
+                    DECLARE
+                         PROCEDURE P IS NEW PROC;
+                    BEGIN
+                         IF NOT EQUAL(3,3) THEN
+                              P(1);
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("INSTANTIATION ELABORATES SPEC");
+               END;
+
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("DECL ELABORATED SPEC PART - 1");
+     END;
+
+     BEGIN
+          DECLARE
+               SUBTYPE I1 IS INTEGER RANGE 1 .. 1;
+
+               GENERIC
+               PACKAGE PKG IS
+                    X : INTEGER := I1(IDENT_INT(2));
+               END PKG;
+          BEGIN
+               BEGIN
+                    DECLARE
+                         PACKAGE P IS NEW PKG;
+                    BEGIN
+                         FAILED ("PACKAGE INSTANTIATION FAILED");
+                         IF NOT EQUAL(P.X,P.X) THEN
+                              COMMENT("DON'T OPTIMIZE THIS");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR => NULL;
+                    WHEN OTHERS => FAILED ("WRONG EXCEPTION - 2");
+               END;
+
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("DECL ELABORATED SPEC PART - 2");
+     END;
+
+     RESULT;
+
+END CC1004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1005b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1005b.ada
new file mode 100644
index 000000000..484227fab
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1005b.ada
@@ -0,0 +1,151 @@
+-- CC1005B.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 GENERIC UNIT'S IDENTIFIER CAN BE USED IN ITS
+--     FORMAL PART:
+--
+--     (A) AS THE SELECTOR IN AN EXPANDED NAME TO DENOTE AN ENTITY IN THE
+--         VISIBLE PART OF A PACKAGE, OR TO DENOTE AN ENTITY IMMEDIATELY
+--         ENCLOSED IN A CONSTRUCT OTHER THAN THE CONSTRUCT IMMEDIATELY
+--         ENCLOSING THE GENERIC UNIT.
+--
+--     (B) AS A SELECTOR TO DENOTE A COMPONENT OF A RECORD OBJECT,
+--         AS THE NAME OF A RECORD OR DISCRIMINANT COMPONENT IN A RECORD
+--         AGGREGATE, AND AS THE NAME OF A FORMAL PARAMETER IN A
+--         FUNCTION CALL.
+
+-- HISTORY:
+--     BCB 08/03/88  CREATED ORIGINAL TEST.
+--     JRL 03/20/92  DELETED TEST IN BLOCK STATEMENT; CONSOLIDATED
+--                   WITH CC1005C.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1005B IS
+
+     S : INTEGER := IDENT_INT(0);
+
+     PACKAGE CC1005B IS
+          I : INTEGER;
+          S : INTEGER := IDENT_INT(5);
+          GENERIC
+               S : INTEGER := IDENT_INT(10);
+               V : INTEGER := STANDARD.CC1005B.S;
+               W : INTEGER := STANDARD.CC1005B.CC1005B.S;
+          FUNCTION CC1005B RETURN INTEGER;
+     END CC1005B;
+
+     PACKAGE BODY CC1005B IS
+          FUNCTION CC1005B RETURN INTEGER IS
+          BEGIN
+               IF NOT EQUAL(V,0) THEN
+                    FAILED ("WRONG VALUE OF S USED IN ASSIGNMENT OF V");
+               END IF;
+
+               IF NOT EQUAL(W,5) THEN
+                    FAILED ("WRONG VALUE OF S USED IN ASSIGNMENT OF W");
+               END IF;
+
+               RETURN 0;
+          END CC1005B;
+
+          FUNCTION NEW_CC IS NEW CC1005B;
+
+     BEGIN
+          TEST ("CC1005B", "CHECK THAT A GENERIC UNIT'S IDENTIFIER " &
+                           "CAN BE USED IN ITS FORMAL PART: AS THE " &
+                           "SELECTOR IN AN EXPANDED NAME TO DENOTE " &
+                           "AN ENTITY IN THE VISIBLE PART OF A " &
+                           "PACKAGE, OR TO DENOTE AN ENTITY " &
+                           "IMMEDIATELY ENCLOSED IN A CONSTRUCT " &
+                           "OTHER THAN THE CONSTRUCT IMMEDIATELY " &
+                           "ENCLOSING THE GENERIC UNIT; AND AS A " &
+                           "SELECTOR TO DENOTE A COMPONENT OF A " &
+                           "RECORD OBJECT, AS THE NAME OF A RECORD " &
+                           "OR DISCRIMINANT COMPONENT IN A RECORD " &
+                           "AGGREGATE, AND AS THE NAME OF A FORMAL " &
+                           "PARAMETER IN A FUNCTION CALL");
+
+          I := NEW_CC;
+     END CC1005B;
+
+     FUNCTION F (P : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN P;
+     END F;
+
+BEGIN
+
+     BLOCK1:
+        DECLARE
+             TYPE REC IS RECORD
+                  P : INTEGER := IDENT_INT(0);
+             END RECORD;
+
+             TYPE REC2 (P : INTEGER) IS RECORD
+                  NULL;
+             END RECORD;
+
+             R : REC;
+
+             J : INTEGER;
+
+             GENERIC
+                  V : INTEGER := R.P;
+                  X : REC := (P => IDENT_INT(10));
+                  Y : REC2 := (P => IDENT_INT(15));
+                  Z : INTEGER := F(P => IDENT_INT(20));
+             FUNCTION P RETURN INTEGER;
+
+             FUNCTION P RETURN INTEGER IS
+             BEGIN
+                  IF NOT EQUAL(V,0) THEN
+                       FAILED ("WRONG VALUE OF P USED IN ASSIGNMENT " &
+                               "OF V");
+                  END IF;
+
+                  IF NOT EQUAL(X.P,10) THEN
+                       FAILED ("WRONG VALUE USED IN ASSIGNMENT OF X.P");
+                  END IF;
+
+                  IF NOT EQUAL(Y.P,15) THEN
+                       FAILED ("WRONG VALUE USED IN ASSIGNMENT OF Y.P");
+                  END IF;
+
+                  IF NOT EQUAL(Z,20) THEN
+                       FAILED ("WRONG VALUE OF P USED IN ASSIGNMENT " &
+                               "OF Z");
+                  END IF;
+
+                  RETURN 0;
+             END P;
+
+             FUNCTION NEW_P IS NEW P;
+        BEGIN
+             J := NEW_P;
+        END BLOCK1;
+
+     RESULT;
+END CC1005B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1010a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1010a.ada
new file mode 100644
index 000000000..c04a3253c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1010a.ada
@@ -0,0 +1,66 @@
+-- CC1010A.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 NAMES IN A GENERIC SUBPROGRAM DECLARATION ARE
+-- STATICALLY IDENTIFIED (I.E., BOUND) AT THE POINT WHERE THE
+-- GENERIC DECLARATION TEXTUALLY OCCURS, AND ARE NOT DYNAMICALLY
+-- BOUND AT THE POINT OF INSTANTIATION.
+
+-- ASL 8/12/81
+
+WITH REPORT;
+PROCEDURE CC1010A IS
+     USE REPORT;
+BEGIN
+     TEST ("CC1010A","PROPER VISIBILITY OF FREE IDENTIFIERS IN " &
+           "GENERIC DECLARATIONS, BODIES AND INSTANTIATIONS");
+
+     OUTER:
+          DECLARE
+               FREE : CONSTANT INTEGER := 5;
+          BEGIN
+               DECLARE
+                    GENERIC
+                         GFP : INTEGER := FREE;
+                    PROCEDURE P(PFP : IN INTEGER := FREE);
+          
+                    FREE : CONSTANT INTEGER := 6;
+            
+                    PROCEDURE P(PFP : IN INTEGER := OUTER.FREE) IS
+                    BEGIN
+                         IF FREE /= 6 OR GFP /= 5 OR PFP /= 5 THEN
+                              FAILED ("BINDINGS INCORRECT");
+                         END IF;
+                    END P;
+               BEGIN
+                    DECLARE
+                         FREE : CONSTANT INTEGER := 7;
+                         PROCEDURE INST IS NEW P;
+                    BEGIN
+                         INST;
+                    END;
+               END;
+          END OUTER;
+     RESULT;
+END CC1010A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1010b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1010b.ada
new file mode 100644
index 000000000..74ef437b9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1010b.ada
@@ -0,0 +1,67 @@
+-- CC1010B.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 NAMES IN A GENERIC PACKAGE BODY ARE STATICALLY
+-- IDENTIFIED (I.E., BOUND) AT THE POINT WHERE THE GENERIC BODY
+-- TEXTUALLY OCCURS, AND ARE NOT DYNAMICALLY BOUND AT THE POINT
+-- OF INSTANTIATION.
+
+-- ASL 8/13/81
+
+WITH REPORT;
+PROCEDURE CC1010B IS
+
+     USE REPORT;
+     FREE : CONSTANT INTEGER := 5;
+BEGIN
+     TEST("CC1010B","PROPER VISIBILITY OF FREE IDENTIFIERS IN " &
+          "GENERIC PACKAGE DECLARATIONS, BODIES AND INSTANTIATIONS");
+
+     DECLARE
+          GENERIC
+               GFP : INTEGER := FREE;
+          PACKAGE P IS
+               SPECITEM : CONSTANT INTEGER := FREE;
+          END P;
+          
+          FREE : CONSTANT INTEGER := 6;
+
+          PACKAGE BODY P IS
+               BODYITEM : INTEGER := FREE;
+          BEGIN
+               IF GFP /= 5 OR SPECITEM /= 5 OR BODYITEM /= 6 THEN
+                    FAILED ("BINDINGS INCORRECT");
+               END IF;
+          END P;
+     BEGIN
+          DECLARE
+               FREE : CONSTANT INTEGER := 7;
+               PACKAGE INST IS NEW P;
+          BEGIN
+               NULL;
+          END;
+     END;
+
+     RESULT;
+END CC1010B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1018a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1018a.ada
new file mode 100644
index 000000000..2ea39a928
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1018a.ada
@@ -0,0 +1,83 @@
+-- CC1018A.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 FORMAL OUT PARAMETER OF A GENERIC FORMAL SUBPROGRAM CAN 
+-- HAVE A FORMAL LIMITED TYPE AND AN ARRAY TYPE WITH LIMITED COMPONENTS.
+
+-- AH  10/3/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC1018A IS
+     TYPE INT IS RANGE 1..10;
+     TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INT;
+     INT_OBJ : INT := 4;
+     ARR_OBJ : ARR(1..5) := (2, 8, 2, 8, 2);
+
+     GENERIC
+          TYPE GLP IS LIMITED PRIVATE;
+          TYPE GARR IS ARRAY (INTEGER RANGE <>) OF GLP;
+          LP_OBJ : IN OUT GLP;
+          GA_OBJ : IN OUT GARR;
+          WITH PROCEDURE P (X : OUT GLP; Y : OUT GARR);
+          WITH FUNCTION SAME (LEFT, RIGHT : GLP) RETURN BOOLEAN;
+     PROCEDURE GEN_PROC;
+
+     PROCEDURE GET_VALUES (X1 : OUT INT; Y1 : OUT ARR) IS
+     BEGIN
+          X1 := 4;
+          Y1 := (2, 8, 2, 8, 2);
+     END GET_VALUES;
+
+     FUNCTION SAME_VALUE (LEFT, RIGHT : INT) RETURN BOOLEAN IS 
+     BEGIN
+          RETURN LEFT = RIGHT;
+     END SAME_VALUE;
+
+     PROCEDURE GEN_PROC IS
+          LP : GLP;
+          A : GARR(1..5);
+     BEGIN
+          P(LP, A);
+          IF NOT SAME(LP, LP_OBJ) THEN
+               FAILED ("LIMITED PRIVATE TYPE HAS INCORRECT VALUE");
+          END IF;
+
+          FOR INDEX IN A'RANGE LOOP
+               IF NOT SAME(A(INDEX), GA_OBJ(INDEX)) THEN
+                    FAILED ("LIMITED PRIVATE TYPE COMPONENT " & 
+                            "HAS INCORRECT VALUE");
+               END IF;
+          END LOOP;
+     END GEN_PROC;
+
+     PROCEDURE TEST_LP IS NEW GEN_PROC(INT, ARR, INT_OBJ, ARR_OBJ,
+                                       GET_VALUES, SAME_VALUE);
+
+BEGIN
+     TEST ("CC1018A", "A GENERIC FORMAL SUBPROGRAM OUT PRARAMETER " & 
+                      "CAN HAVE A LIMITED TYPE");
+     TEST_LP;
+
+     RESULT;
+END CC1018A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1104c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1104c.ada
new file mode 100644
index 000000000..a97e7a097
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1104c.ada
@@ -0,0 +1,151 @@
+-- CC1104C.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 GENERIC FORMAL IN OUT PARAMETER CAN HAVE A
+--     LIMITED TYPE.
+
+-- HISTORY:
+--     BCB 08/03/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1104C IS
+
+     TASK TYPE TSK IS
+          ENTRY E;
+     END TSK;
+
+     VAR : INTEGER := IDENT_INT(0);
+     NEW_VAL : INTEGER := IDENT_INT(5);
+
+     TSK_VAR : TSK;
+
+     PACKAGE PP IS
+          TYPE LP IS LIMITED PRIVATE;
+          PROCEDURE INIT (ONE : OUT LP; TWO : INTEGER);
+          FUNCTION EQUAL (ONE : LP; TWO : INTEGER) RETURN BOOLEAN;
+     PRIVATE
+          TYPE LP IS RANGE 1 .. 100;
+     END PP;
+
+     USE PP;
+
+     TYPE REC IS RECORD
+          COMP : LP;
+     END RECORD;
+
+     C : LP;
+
+     REC_VAR : REC;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+          IN_OUT_VAR : IN OUT T;
+          IN_OUT_TSK : IN OUT TSK;
+          VAL : IN OUT T;
+          WITH PROCEDURE INIT (L : IN OUT T; R : T);
+     PROCEDURE P;
+
+     GENERIC
+          VAL : IN OUT LP;
+     PROCEDURE Q;
+
+     GENERIC
+          VAL : IN OUT REC;
+     PROCEDURE R;
+
+     PACKAGE BODY PP IS
+          PROCEDURE INIT(ONE : OUT LP; TWO : INTEGER) IS
+          BEGIN
+               ONE := LP(TWO);
+          END INIT;
+
+          FUNCTION EQUAL(ONE : LP; TWO : INTEGER) RETURN BOOLEAN IS
+          BEGIN
+               RETURN ONE = LP(TWO);
+          END EQUAL;
+     END PP;
+
+     TASK BODY TSK IS
+     BEGIN
+          ACCEPT E;
+     END TSK;
+
+     PROCEDURE P IS
+     BEGIN
+          INIT(IN_OUT_VAR,VAL);
+          IN_OUT_TSK.E;
+          INIT(C,50);
+     END P;
+
+     PROCEDURE Q IS
+     BEGIN
+          INIT(VAL,75);
+          INIT(REC_VAR.COMP,50);
+     END Q;
+
+     PROCEDURE R IS
+     BEGIN
+          INIT(VAL.COMP,75);
+     END R;
+
+     PROCEDURE I (ONE : IN OUT INTEGER; TWO : INTEGER) IS
+     BEGIN
+          ONE := TWO;
+     END I;
+
+     PROCEDURE NEW_P IS NEW P(INTEGER,VAR,TSK_VAR,NEW_VAL,I);
+
+     PROCEDURE NEW_Q IS NEW Q(C);
+
+     PROCEDURE NEW_R IS NEW R(REC_VAR);
+
+BEGIN
+     TEST ("CC1104C", "CHECK THAT A GENERIC FORMAL IN OUT PARAMETER " &
+                      "CAN HAVE A LIMITED TYPE");
+
+     NEW_P;
+
+     IF NOT EQUAL(VAR,5) THEN
+          FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
+                  "GENERIC PACKAGE - 1");
+     END IF;
+
+     NEW_Q;
+
+     IF NOT EQUAL(C,75) THEN
+          FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
+                  "GENERIC PACKAGE - 2");
+     END IF;
+
+     NEW_R;
+
+     IF NOT EQUAL(REC_VAR.COMP,75) THEN
+          FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
+                  "GENERIC PACKAGE - 3");
+     END IF;
+
+     RESULT;
+END CC1104C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1107b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1107b.ada
new file mode 100644
index 000000000..94a177615
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1107b.ada
@@ -0,0 +1,84 @@
+-- CC1107B.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 DEFAULT EXPRESSION MAY REFER TO AN EARLIER FORMAL
+--     PARAMETER OF THE SAME GENERIC FORMAL PART.
+
+-- HISTORY:
+--     BCB 08/03/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1107B IS
+
+     J, I : INTEGER;
+
+     X : INTEGER := IDENT_INT(0);
+
+     VAL : INTEGER := IDENT_INT(10);
+
+     GENERIC
+          X : INTEGER := IDENT_INT(5);
+          Y : INTEGER := X;
+     FUNCTION F RETURN INTEGER;
+
+     GENERIC
+          X : INTEGER;
+          Y : INTEGER := X;
+     FUNCTION G RETURN INTEGER;
+
+     FUNCTION F RETURN INTEGER IS
+     BEGIN
+          IF NOT EQUAL(X,Y) THEN
+               FAILED ("WRONG VALUE FROM EARLIER FORMAL PARAMETER - 1");
+          END IF;
+
+          RETURN 0;
+     END F;
+
+     FUNCTION G RETURN INTEGER IS
+     BEGIN
+          IF NOT EQUAL(X,Y) THEN
+               FAILED ("WRONG VALUE FROM EARLIER FORMAL PARAMETER - 2");
+          END IF;
+
+          RETURN 0;
+     END G;
+
+     FUNCTION NEW_F IS NEW F;
+
+     FUNCTION NEW_G IS NEW G(VAL);
+
+BEGIN
+     TEST ("CC1107B", "CHECK THAT A DEFAULT EXPRESSION MAY REFER " &
+                      "TO AN EARLIER FORMAL PARAMETER OF THE SAME " &
+                      "GENERIC FORMAL PART");
+
+     J := NEW_F;
+
+     I := NEW_G;
+
+     RESULT;
+END CC1107B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1111a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1111a.ada
new file mode 100644
index 000000000..709307d13
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1111a.ada
@@ -0,0 +1,322 @@
+-- CC1111A.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 AFTER A GENERIC UNIT IS INSTANTIATED, THE SUBTYPE OF
+--     AN IN OUT OBJECT PARAMETER IS DETERMINED BY THE ACTUAL PARAMETER
+--     (TESTS INTEGER, ENUMERATION, FLOATING POINT, FIXED POINT, ARRAY,
+--     ACCESS, AND DISCRIMINATED TYPES).
+
+-- HISTORY:
+--     BCB 03/28/88  CREATED ORIGINAL TEST.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1111A IS
+
+     SUBTYPE INT IS INTEGER RANGE 0..5;
+     INTVAR : INTEGER RANGE 1..3;
+
+     TYPE ENUM IS (ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT);
+     SUBTYPE SUBENUM IS ENUM RANGE ONE .. FIVE;
+     ENUMVAR : ENUM RANGE TWO .. THREE;
+
+     TYPE FLT IS DIGITS 5 RANGE -5.0 .. 5.0;
+     SUBTYPE SUBFLT IS FLT RANGE -1.0 .. 1.0;
+     FLTVAR : FLT RANGE 0.0 .. 1.0;
+
+     TYPE FIX IS DELTA 0.5 RANGE -5.0 .. 5.0;
+     SUBTYPE SUBFIX IS FIX RANGE -1.0 .. 1.0;
+     FIXVAR : FIX RANGE 0.0 .. 1.0;
+
+     SUBTYPE STR IS STRING (1..10);
+     STRVAR : STRING (1..5);
+
+     TYPE REC (DISC : INTEGER := 5) IS RECORD
+          NULL;
+     END RECORD;
+     SUBTYPE SUBREC IS REC (6);
+     RECVAR : REC(5);
+     SUBRECVAR : SUBREC;
+
+     TYPE ACCREC IS ACCESS REC;
+     SUBTYPE A1 IS ACCREC(1);
+     SUBTYPE A2 IS ACCREC(2);
+     A1VAR : A1 := NEW REC(1);
+     A2VAR : A2 := NEW REC(2);
+
+     PACKAGE P IS
+          TYPE PRIV IS PRIVATE;
+     PRIVATE
+          TYPE PRIV IS RANGE 1 .. 100;
+          SUBTYPE SUBPRIV IS PRIV RANGE 5 .. 10;
+          PRIVVAR : PRIV RANGE 8 .. 10;
+     END P;
+
+     PACKAGE BODY P IS
+          FUNCTION PRIVEQUAL (ONE, TWO : SUBPRIV) RETURN BOOLEAN;
+
+          FUNCTION PRIVEQUAL (ONE, TWO : SUBPRIV) RETURN BOOLEAN IS
+          BEGIN
+               RETURN ONE = TWO;
+          END PRIVEQUAL;
+
+          GENERIC
+               INPUT : SUBPRIV;
+               OUTPUT : IN OUT SUBPRIV;
+          PROCEDURE I;
+
+          PROCEDURE I IS
+          BEGIN
+               OUTPUT := INPUT;
+               FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                       "PRIVATE TYPE");
+               IF PRIVEQUAL (OUTPUT, OUTPUT) THEN
+                    COMMENT ("DON'T OPTIMIZE OUTPUT");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED");
+          END I;
+
+          PROCEDURE I1 IS NEW I (5, PRIVVAR);
+          PROCEDURE I2 IS NEW I (SUBPRIV'FIRST, PRIVVAR);
+
+     BEGIN
+          TEST ("CC1111A", "CHECK THAT AFTER A GENERIC UNIT IS " &
+                           "INSTANTIATED, THE SUBTYPE OF AN IN OUT " &
+                           "OBJECT PARAMETER IS DETERMINED BY THE " &
+                           "ACTUAL PARAMETER (TESTS INTEGER, " &
+                           "ENUMERATION, FLOATING POINT, FIXED POINT " &
+                           ", ARRAY, ACCESS, AND DISCRIMINATED TYPES)");
+
+          I1;
+          I2;
+     END P;
+
+     USE P;
+
+     GENERIC
+          TYPE GP IS PRIVATE;
+     FUNCTION GEN_IDENT (X : GP) RETURN GP;
+
+     GENERIC
+          INPUT : INT;
+          OUTPUT : IN OUT INT;
+     PROCEDURE B;
+
+     GENERIC
+          INPUT : SUBENUM;
+          OUTPUT : IN OUT SUBENUM;
+     PROCEDURE C;
+
+     GENERIC
+          INPUT : SUBFLT;
+          OUTPUT : IN OUT SUBFLT;
+     PROCEDURE D;
+
+     GENERIC
+          INPUT : SUBFIX;
+          OUTPUT : IN OUT SUBFIX;
+     PROCEDURE E;
+
+     GENERIC
+          INPUT : STR;
+          OUTPUT : IN OUT STR;
+     PROCEDURE F;
+
+     GENERIC
+          INPUT : A1;
+          OUTPUT : IN OUT A1;
+     PROCEDURE G;
+
+     GENERIC
+          INPUT : SUBREC;
+          OUTPUT : IN OUT SUBREC;
+     PROCEDURE H;
+
+     GENERIC
+          TYPE GP IS PRIVATE;
+     FUNCTION GENEQUAL (ONE, TWO : GP) RETURN BOOLEAN;
+
+     FUNCTION GENEQUAL (ONE, TWO : GP) RETURN BOOLEAN IS
+     BEGIN
+          RETURN ONE = TWO;
+     END GENEQUAL;
+
+     FUNCTION GEN_IDENT (X : GP) RETURN GP IS
+     BEGIN
+               RETURN X;
+     END GEN_IDENT;
+
+     FUNCTION INT_IDENT IS NEW GEN_IDENT (INT);
+     FUNCTION SUBENUM_IDENT IS NEW GEN_IDENT (SUBENUM);
+     FUNCTION SUBFLT_IDENT IS NEW GEN_IDENT (SUBFLT);
+     FUNCTION SUBFIX_IDENT IS NEW GEN_IDENT (SUBFIX);
+
+     FUNCTION ENUMEQUAL IS NEW GENEQUAL (SUBENUM);
+     FUNCTION FLTEQUAL IS NEW GENEQUAL (SUBFLT);
+     FUNCTION FIXEQUAL IS NEW GENEQUAL (SUBFIX);
+     FUNCTION STREQUAL IS NEW GENEQUAL (STR);
+     FUNCTION ACCEQUAL IS NEW GENEQUAL (A2);
+     FUNCTION RECEQUAL IS NEW GENEQUAL (REC);
+
+     PROCEDURE B IS
+     BEGIN
+          OUTPUT := INPUT;
+          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                  "INTEGER TYPE");
+          IF EQUAL (OUTPUT, OUTPUT) THEN
+               COMMENT ("DON'T OPTIMIZE OUTPUT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END B;
+
+     PROCEDURE C IS
+     BEGIN
+          OUTPUT := INPUT;
+          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                  "ENUMERATION TYPE");
+          IF ENUMEQUAL (OUTPUT, OUTPUT) THEN
+               COMMENT ("DON'T OPTIMIZE OUTPUT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END C;
+
+     PROCEDURE D IS
+     BEGIN
+          OUTPUT := INPUT;
+          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                  "FLOATING POINT TYPE");
+          IF FLTEQUAL (OUTPUT, OUTPUT) THEN
+               COMMENT ("DON'T OPTIMIZE OUTPUT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END D;
+
+     PROCEDURE E IS
+     BEGIN
+          OUTPUT := INPUT;
+          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                  "FIXED POINT TYPE");
+          IF FIXEQUAL (OUTPUT, OUTPUT) THEN
+               COMMENT ("DON'T OPTIMIZE OUTPUT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END E;
+
+     PROCEDURE F IS
+     BEGIN
+          OUTPUT := INPUT;
+          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                  "ARRAY TYPE");
+          IF STREQUAL (OUTPUT, OUTPUT) THEN
+               COMMENT ("DON'T OPTIMIZE OUTPUT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END F;
+
+     PROCEDURE G IS
+     BEGIN
+          OUTPUT := INPUT;
+          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                  "ACCESS TYPE");
+          IF ACCEQUAL (OUTPUT, OUTPUT) THEN
+               COMMENT ("DON'T OPTIMIZE OUTPUT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END G;
+
+     PROCEDURE H IS
+     BEGIN
+          OUTPUT := INPUT;
+          FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
+                  "DISCRIMINATED RECORD TYPE");
+          IF RECEQUAL (OUTPUT, OUTPUT) THEN
+               COMMENT ("DON'T OPTIMIZE OUTPUT");
+          END IF;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END H;
+
+     PROCEDURE B1 IS NEW B (4, INTVAR);
+     PROCEDURE C1 IS NEW C (FOUR, ENUMVAR);
+     PROCEDURE D1 IS NEW D (-1.0, FLTVAR);
+     PROCEDURE E1 IS NEW E (-1.0, FIXVAR);
+     PROCEDURE F1 IS NEW F ("9876543210", STRVAR);
+     PROCEDURE G1 IS NEW G (A1VAR, A2VAR);
+     PROCEDURE H1 IS NEW H (SUBRECVAR, RECVAR);
+
+     PROCEDURE B2 IS NEW B (INT_IDENT(INT'FIRST), INTVAR);
+     PROCEDURE C2 IS NEW C (SUBENUM_IDENT(SUBENUM'FIRST), ENUMVAR);
+     PROCEDURE D2 IS NEW D (SUBFLT_IDENT(SUBFLT'FIRST), FLTVAR);
+     PROCEDURE E2 IS NEW E (SUBFIX_IDENT(SUBFIX'FIRST), FIXVAR);
+
+BEGIN
+
+     B1;
+     C1;
+     D1;
+     E1;
+     F1;
+     G1;
+     H1;
+
+     B2;
+     C2;
+     D2;
+     E2;
+
+     RESULT;
+END CC1111A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1204a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1204a.ada
new file mode 100644
index 000000000..17e3d7f0f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1204a.ada
@@ -0,0 +1,115 @@
+-- CC1204A.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 GENERIC FORMAL TYPES MAY HAVE A DISCRIMINANT PART,
+-- WHICH MAY BE OF A GENERIC FORMAL TYPE.
+
+-- DAT 8/14/81
+-- SPS 5/12/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1204A IS
+BEGIN
+     TEST ("CC1204A", "DISCRIMINANT PARTS FOR GENERIC FORMAL TYPES");
+
+     DECLARE
+          GENERIC
+               TYPE T IS ( <> );
+               TYPE I IS RANGE <> ;
+               TYPE R1 (C : BOOLEAN) IS PRIVATE;
+               TYPE R2 (C : T) IS PRIVATE;
+               TYPE R3 (C : I) IS LIMITED PRIVATE;
+               P1 : IN R1;
+               P2 : IN R2;
+               V1 : IN OUT R1;
+               V2 : IN OUT R2;
+               V3 : IN OUT R3;
+          PROCEDURE PROC;
+
+          TYPE DD IS NEW INTEGER RANGE 1 .. 10;
+          TYPE ARR IS ARRAY (DD RANGE <>) OF CHARACTER;
+          TYPE RECD (C : DD := DD (IDENT_INT (1))) IS
+               RECORD
+                    C1 : ARR (1..C);
+               END RECORD;
+
+          X1 : RECD;
+          X2 : RECD := (1, "Y");
+
+          TYPE RECB (C : BOOLEAN) IS
+               RECORD
+                    V : INTEGER := 6;
+               END RECORD;
+          RB : RECB (IDENT_BOOL (TRUE));
+          RB1 : RECB (IDENT_BOOL (TRUE));
+
+          PROCEDURE PROC IS
+          BEGIN
+               IF P1.C /= TRUE
+                  OR P2.C /= T'FIRST
+                  OR V1.C /= TRUE
+                  OR V2.C /= T'FIRST
+                  OR V3.C /= I'FIRST
+               THEN
+                    FAILED ("WRONG GENERIC PARAMETER VALUE");
+               END IF;
+
+               V1 := P1;
+               V2 := P2;
+
+               IF V1 /= P1
+                  OR V2 /= P2 
+               THEN
+                    FAILED ("BAD ASSIGNMENT TO GENERIC PARAMETERS");
+               END IF;
+          END PROC;
+
+     BEGIN
+          RB1.V := IDENT_INT (1);
+          X1.C1 := "X";
+
+          DECLARE
+     
+               PROCEDURE PR IS NEW PROC
+                    (T => DD,
+                     I => DD,
+                     R1 => RECB,
+                     R2 => RECD,
+                     R3 => RECD,
+                     P1 => RB1,
+                     P2 => X1,
+                     V1 => RB,
+                     V2 => X2,
+                     V3 => X2);
+          BEGIN
+               PR;
+               IF RB /= (TRUE, 1) OR X2.C1 /= "X" THEN
+                    FAILED ("PR NOT CALLED CORRECTLY");
+               END IF;
+          END;
+     END;
+
+     RESULT;
+END CC1204A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1207b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1207b.ada
new file mode 100644
index 000000000..b8eeae495
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1207b.ada
@@ -0,0 +1,138 @@
+-- CC1207B.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 UNCONSTRAINED FORMAL TYPE WITH DISCRIMINANTS IS
+--     ALLOWED AS THE TYPE OF A SUBPROGRAM OR AN ENTRY FORMAL
+--     PARAMETER, AND AS THE TYPE OF A GENERIC FORMAL OBJECT PARAMETER,
+--     AS A GENERIC ACTUAL PARAMETER, AND IN A MEMBERSHIP TEST, IN A
+--     SUBTYPE DECLARATION, IN AN ACCESS TYPE DEFINITION, AND IN A
+--     DERIVED TYPE DEFINITION.
+
+-- HISTORY:
+--     BCB 08/04/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1207B IS
+
+     GENERIC
+          TYPE X (L : INTEGER) IS PRIVATE;
+     PACKAGE PACK IS
+     END PACK;
+
+BEGIN
+     TEST ("CC1207B", "CHECK THAT AN UNCONSTRAINED FORMAL TYPE WITH " &
+                      "DISCRIMINANTS IS ALLOWED AS THE TYPE OF A " &
+                      "SUBPROGRAM OR AN ENTRY FORMAL PARAMETER, AND " &
+                      "AS THE TYPE OF A GENERIC FORMAL OBJECT " &
+                      "PARAMETER, AS A GENERIC ACTUAL PARAMETER, AND " &
+                      "IN A MEMBERSHIP TEST, IN A SUBTYPE " &
+                      "DECLARATION, IN AN ACCESS TYPE DEFINITION, " &
+                      "AND IN A DERIVED TYPE DEFINITION");
+
+     DECLARE
+          TYPE REC (D : INTEGER := 3) IS RECORD
+               NULL;
+          END RECORD;
+
+          GENERIC
+               TYPE R (D : INTEGER) IS PRIVATE;
+               OBJ : R;
+          PACKAGE P IS
+               PROCEDURE S (X : R);
+
+               TASK T IS
+                    ENTRY E (Y : R);
+               END T;
+
+               SUBTYPE SUB_R IS R;
+
+               TYPE ACC_R IS ACCESS R;
+
+               TYPE NEW_R IS NEW R;
+
+               BOOL : BOOLEAN := (OBJ IN R);
+
+               SUB_VAR : SUB_R(5);
+
+               ACC_VAR : ACC_R := NEW R(5);
+
+               NEW_VAR : NEW_R(5);
+
+               PACKAGE NEW_PACK IS NEW PACK (R);
+          END P;
+
+          REC_VAR : REC(5) := (D => 5);
+
+          PACKAGE BODY P IS
+               PROCEDURE S (X : R) IS
+               BEGIN
+                    IF NOT EQUAL(X.D,5) THEN
+                         FAILED ("WRONG DISCRIMINANT VALUE - S");
+                    END IF;
+               END S;
+
+               TASK BODY T IS
+               BEGIN
+                    ACCEPT E (Y : R) DO
+                         IF NOT EQUAL(Y.D,5) THEN
+                              FAILED ("WRONG DISCRIMINANT VALUE - T");
+                         END IF;
+                    END E;
+               END T;
+          BEGIN
+               IF NOT EQUAL(OBJ.D,5) THEN
+                    FAILED ("IMPROPER DISCRIMINANT VALUE");
+               END IF;
+
+               S (OBJ);
+
+               T.E (OBJ);
+
+               IF NOT EQUAL(SUB_VAR.D,5) THEN
+                    FAILED ("IMPROPER DISCRIMINANT VALUE - SUBTYPE");
+               END IF;
+
+               IF NOT EQUAL(ACC_VAR.D,5) THEN
+                    FAILED ("IMPROPER DISCRIMINANT VALUE - ACCESS");
+               END IF;
+
+               IF NOT EQUAL(NEW_VAR.D,5) THEN
+                    FAILED ("IMPROPER DISCRIMINANT VALUE - DERIVED");
+               END IF;
+
+               IF NOT BOOL THEN
+                    FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+               END IF;
+          END P;
+
+          PACKAGE NEW_P IS NEW P (REC,REC_VAR);
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC1207B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada
new file mode 100644
index 000000000..cabd5911a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada
@@ -0,0 +1,174 @@
+-- CC1220A.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 GENERIC UNIT CAN REFER TO AN IMPLICITLY
+--     DECLARED PREDEFINED OPERATOR.
+
+-- HISTORY:
+--     DAT 08/20/81  CREATED ORIGINAL TEST.
+--     SPS 05/03/82
+--     BCB 08/04/88  MODIFIED HEADER FORMAT AND ADDED CHECKS FOR OTHER
+--                   OPERATIONS OF A DISCRETE TYPE.
+--     RJW 03/27/90  REVISED TEST TO CHECK FOR A GENERIC FORMAL
+--                   DISCRETE TYPE.
+--     CJJ 10/14/90  ADDED CHECKS FOR RELATIONAL OPERATOR (<, <=, >, >=);
+--                   MADE FAILED MESSAGES IN PROCEDURE BODY MORE SPECIFIC.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+
+PROCEDURE CC1220A IS
+
+BEGIN
+     TEST ("CC1220A", "GENERIC UNIT CAN REFER TO IMPLICITLY " &
+           "DECLARED OPERATORS");
+
+
+     DECLARE
+
+          GENERIC
+               TYPE T IS (<>);
+               STR : STRING;
+               P1 : T := T'FIRST;
+               P2 : T := T(T'SUCC (P1));
+               P3 : T := T'(T'PRED (P2));
+               P4 : INTEGER := IDENT_INT(T'WIDTH);
+               P5 : BOOLEAN := (P1 < P2) AND (P2 > P3);
+               P6: BOOLEAN := (P1 <= P3) AND (P2 >= P1);
+               P7 : BOOLEAN := (P3 = P1);
+               P8 : T := T'BASE'FIRST;
+               P10 : T := T'LAST;
+               P11 : INTEGER := T'SIZE;
+               P12 : ADDRESS := P10'ADDRESS;
+               P13 : INTEGER := T'WIDTH;
+               P14 : INTEGER := T'POS(T'LAST);
+               P15 : T := T'VAL(1);
+               P16 : INTEGER := T'POS(P15);
+               P17 : STRING := T'IMAGE(T'BASE'LAST);
+               P18 : T := T'VALUE(P17);
+               P19 : BOOLEAN := (P15 IN T);
+               WITH FUNCTION IDENT (X : T) RETURN T;
+          PACKAGE PKG IS
+               ARR : ARRAY (1 .. 3) OF T := (P1,P2,P3);
+               B1 : BOOLEAN := P7 AND P19;
+               B2 : BOOLEAN := P5 AND P6;
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF P1 /= T(T'FIRST) THEN
+                    FAILED ("IMPROPER VALUE FOR 'FIRST - " & STR);
+               END IF;
+
+               IF T'SUCC (P1) /= IDENT (P2) OR
+                  T'PRED (P2) /= IDENT (P1) THEN
+                    FAILED ("IMPROPER VALUE FOR 'SUCC, PRED - " & STR);
+               END IF;
+
+               IF P10 /= T(T'LAST) THEN
+                    FAILED ("IMPROPER VALUE FOR 'LAST - " & STR);
+               END IF;
+
+               IF NOT EQUAL(P11,T'SIZE) THEN
+                    FAILED ("IMPROPER VALUE FOR 'SIZE - " & STR);
+               END IF;
+
+               IF NOT EQUAL(P13,T'WIDTH) THEN
+                    FAILED ("IMPROPER VALUE FOR 'WIDTH - " & STR);
+               END IF;
+
+               IF NOT EQUAL (P16, T'POS (P15)) OR
+                  T'VAL (P16) /= T(IDENT (P15)) THEN
+                    FAILED ("IMPROPER VALUE FOR 'POS, 'VAL - " & STR);
+               END IF;
+
+               IF T'VALUE (P17) /= T'BASE'LAST OR
+                  T'IMAGE (P18) /= T'IMAGE (T'BASE'LAST) THEN
+                    FAILED ("IMPROPER VALUE FOR 'VALUE, 'IMAGE - " &
+                             STR);
+               END IF;
+          END PKG;
+
+     BEGIN
+          DECLARE
+               TYPE CHAR IS ('A', 'B', 'C', 'D', 'E');
+
+               FUNCTION IDENT (C : CHAR) RETURN CHAR IS
+               BEGIN
+                    RETURN CHAR'VAL (IDENT_INT (CHAR'POS (C)));
+               END IDENT;
+
+               PACKAGE N_CHAR IS NEW PKG (T => CHAR, STR => "CHAR",
+                                          IDENT => IDENT);
+          BEGIN
+               IF N_CHAR.ARR (1) /= IDENT ('A') OR
+                  N_CHAR.ARR (2) /= IDENT ('B') OR
+                  N_CHAR.ARR (3) /= 'A' OR
+                  N_CHAR.B1 /= TRUE OR
+                 N_CHAR.B2 /= TRUE THEN
+                    FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
+                            " IN INSTANTIATION OF N_CHAR.");
+               END IF;
+          END;
+
+          DECLARE
+               TYPE ENUM IS (JOVIAL, ADA, FORTRAN, BASIC);
+
+               FUNCTION IDENT (C : ENUM) RETURN ENUM IS
+               BEGIN
+                    RETURN ENUM'VAL (IDENT_INT (ENUM'POS (C)));
+               END IDENT;
+
+               PACKAGE N_ENUM IS NEW PKG (T => ENUM, STR => "ENUM",
+                                          IDENT => IDENT);
+
+          BEGIN
+               IF N_ENUM.ARR (1) /= IDENT (JOVIAL) OR
+                  N_ENUM.ARR (2) /= IDENT (ADA) OR
+                  N_ENUM.ARR (3) /= JOVIAL OR
+                  N_ENUM.B1 /= TRUE OR
+                  N_ENUM.B2 /= TRUE THEN
+                    FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
+                            " IN INSTANTIATION OF N_ENUM.");
+               END IF;
+          END;
+
+          DECLARE
+
+               PACKAGE N_INT IS NEW PKG (T => INTEGER, STR => "INTEGER",
+                                          IDENT => IDENT_INT);
+          BEGIN
+               IF N_INT.ARR (1) /= IDENT_INT (INTEGER'FIRST) OR
+                  N_INT.ARR (2) /= IDENT_INT (INTEGER'FIRST + 1) OR
+                  N_INT.ARR (3) /= INTEGER'FIRST OR
+                  N_INT.B1 /= TRUE OR
+                  N_INT.B2 /= TRUE THEN
+                    FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
+                            " IN INSTANTIATION OF N_INT.");
+               END IF;
+          END;
+     END;
+     RESULT;
+END CC1220A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221a.ada
new file mode 100644
index 000000000..0749e86f3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221a.ada
@@ -0,0 +1,141 @@
+-- CC1221A.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:
+--     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
+--     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+--     WITHIN THE GENERIC UNIT:  ASSIGNMENT, MEMBERSHIP, QUALIFICATION,
+--     AND EXPLICIT CONVERSION TO AND FROM OTHER INTEGER TYPES.
+
+-- HISTORY:
+--     RJW 09/26/86  CREATED ORIGINAL TEST.
+--     BCB 11/12/87  CHANGED HEADER TO STANDARD FORMAT.  SPLIT TEST
+--                   INTO PARTS A, B, C, AND D.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CC1221A IS
+
+     SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
+     TYPE NEWINT IS NEW INTEGER;
+     TYPE INT IS RANGE -300 .. 300;
+
+BEGIN
+     TEST ( "CC1221A", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
+                       "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
+                       "DECLARED AND ARE THEREFORE AVAILABLE " &
+                       "WITHIN THE GENERIC UNIT:  ASSIGNMENT, " &
+                       "MEMBERSHIP, QUALIFICATION, AND EXPLICIT " &
+                       "CONVERSION TO AND FROM OTHER INTEGER TYPES");
+
+     DECLARE -- (A) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
+             --     PART I.
+
+          GENERIC
+               TYPE T IS RANGE <>;
+               TYPE T1 IS RANGE <>;
+               I  : T;
+               I1 : T1;
+          PROCEDURE P (J : T; STR : STRING);
+
+          PROCEDURE P (J : T; STR : STRING) IS
+               SUBTYPE ST IS T RANGE T'VAL (-1) .. T'VAL (1);
+               K, L  : T;
+
+               FUNCTION F (X : T) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN IDENT_BOOL (TRUE);
+               END F;
+
+               FUNCTION F (X : T1) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN IDENT_BOOL (FALSE);
+               END F;
+
+          BEGIN
+               K := I;
+               L := J;
+               K := L;
+
+               IF K /= J THEN
+                    FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
+                             "WITH TYPE - " & STR);
+               END IF;
+
+               IF I IN ST THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
+                             "TYPE  - " & STR);
+               END IF;
+
+               IF J NOT IN ST THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
+                             "TYPE  - " & STR);
+               END IF;
+
+               IF T'(I) /= I THEN
+                    FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                             "WITH TYPE - " & STR & " - 1" );
+               END IF;
+
+               IF F (T'(1)) THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                             "WITH TYPE - " & STR & " - 2" );
+               END IF;
+
+               IF T (I1) /= I THEN
+                    FAILED ( "INCORRECT RESULTS FOR EXPLICIT " &
+                             "CONVERSION WITH TYPE - " & STR &
+                             " - 1" );
+               END IF;
+
+               IF F (T (I1)) THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INCORRECT RESULTS FOR EXPLICIT  " &
+                             "CONVERSION WITH TYPE - " & STR &
+                             " - 2" );
+               END IF;
+
+          END P;
+
+          PROCEDURE NP1 IS NEW P (SUBINT,  SUBINT,  0, 0);
+          PROCEDURE NP2 IS NEW P (NEWINT,  NEWINT,  0, 0);
+          PROCEDURE NP3 IS NEW P (INT,     INT,     0, 0);
+          PROCEDURE NP4 IS NEW P (INTEGER, INTEGER, 0, 0);
+
+     BEGIN
+          NP1 (2, "SUBINT");
+          NP2 (2, "NEWINT");
+          NP3 (2, "INT");
+          NP4 (2, "INTEGER");
+     END; -- (A).
+
+     RESULT;
+END CC1221A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221b.ada
new file mode 100644
index 000000000..2e4d816d4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221b.ada
@@ -0,0 +1,159 @@
+-- CC1221B.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:
+--     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
+--     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+--     WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, 'LAST, 'WIDTH,
+--     'ADDRESS, AND 'SIZE.
+
+-- HISTORY:
+--     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CC1221B IS
+
+     SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
+     SUBTYPE NOINT IS INTEGER RANGE 1 .. -1;
+     TYPE NEWINT IS NEW INTEGER;
+     TYPE INT IS RANGE -300 .. 300;
+     SUBTYPE SINT1 IS INT
+          RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
+     SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
+     TYPE INT2 IS RANGE 0E8 .. 1E3;
+
+BEGIN
+     TEST ( "CC1221B", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
+                       "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
+                       "DECLARED AND ARE THEREFORE AVAILABLE " &
+                       "WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, " &
+                       "'LAST, 'WIDTH, 'ADDRESS, AND 'SIZE");
+
+     DECLARE -- (B) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
+             --     PART II.
+
+          GENERIC
+               TYPE T IS RANGE <>;
+               F, L : T;
+               W : INTEGER;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+               I : INTEGER := F'SIZE;
+               T1 : T;
+               A : ADDRESS := T1'ADDRESS;
+
+          BEGIN
+               IF T'FIRST /= F THEN
+                    FAILED ( "INCORRECT VALUE FOR " & STR & "'FIRST" );
+               END IF;
+
+               IF T'LAST /= L THEN
+                    FAILED ( "INCORRECT VALUE FOR " & STR & "'LAST" );
+               END IF;
+
+               IF T'BASE'FIRST > T'FIRST THEN
+                    FAILED ( "INCORRECT RESULTS WITH " & STR &
+                             "'BASE'FIRST" );
+               END IF;
+
+               IF T'BASE'LAST < T'LAST THEN
+                    FAILED ( "INCORRECT RESULTS WITH " & STR &
+                             "'BASE'LAST" );
+               END IF;
+
+               IF T'WIDTH /= W THEN
+                    FAILED ( "INCORRECT VALUE FOR " & STR &
+                             "'WIDTH" );
+               END IF;
+
+               IF T'BASE'WIDTH < T'WIDTH THEN
+                    FAILED ( "INCORRECT RESULTS WITH " & STR &
+                             "'BASE'WIDTH" );
+               END IF;
+
+          END P;
+
+          GENERIC
+               TYPE T IS RANGE <>;
+          PROCEDURE Q;
+
+          PROCEDURE Q IS
+          BEGIN
+               IF T'FIRST /= 1 THEN
+                    FAILED ( "INCORRECT VALUE FOR NOINT'FIRST" );
+               END IF;
+
+               IF T'LAST /= -1 THEN
+                    FAILED ( "INCORRECT VALUE FOR NOINT'LAST" );
+               END IF;
+
+               IF T'BASE'FIRST > T'FIRST THEN
+                    FAILED ( "INCORRECT RESULTS WITH " &
+                             "NOINT'BASE'FIRST" );
+               END IF;
+
+               IF T'BASE'LAST < T'LAST THEN
+                    FAILED ( "INCORRECT RESULTS WITH " &
+                             "NOINT'BASE'LAST" );
+               END IF;
+
+               IF T'WIDTH /= 0 THEN
+                    FAILED ( "INCORRECT VALUE FOR " &
+                             "NOINT'WIDTH" );
+               END IF;
+
+               IF T'BASE'WIDTH < T'WIDTH THEN
+                    FAILED ( "INCORRECT RESULTS WITH " &
+                             "NOINT'BASE'WIDTH" );
+               END IF;
+
+          END Q;
+
+          PROCEDURE P1 IS NEW P (INTEGER, INTEGER'FIRST, INTEGER'LAST,
+                                 INTEGER'WIDTH);
+          PROCEDURE P2 IS NEW P (SUBINT, -100, 100, 4);
+          PROCEDURE P3 IS NEW P (NEWINT, NEWINT'FIRST, NEWINT'LAST,
+                                 NEWINT'WIDTH);
+          PROCEDURE P4 IS NEW P (SINT1, -4, 4, 2);
+          PROCEDURE P5 IS NEW P (SINT2, 224, 255, 4);
+          PROCEDURE P6 IS NEW P (INT2 , 0, 1000, 5);
+
+          PROCEDURE Q1 IS NEW Q (NOINT);
+
+     BEGIN
+           P1 ( "INTEGER" );
+           P2 ( "SUBINT" );
+           P3 ( "NEWINT" );
+           P4 ( "SINT1" );
+           P5 ( "SINT2" );
+           P6 ( "INT2" );
+
+           Q1;
+
+     END; -- (B).
+
+     RESULT;
+END CC1221B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221c.ada
new file mode 100644
index 000000000..21738858e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221c.ada
@@ -0,0 +1,195 @@
+-- CC1221C.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:
+--     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
+--     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+--     WITHIN THE GENERIC UNIT:  ATTRIBUTES 'POS, 'VAL, 'PRED, 'SUCC,
+--     'IMAGE, AND 'VALUE.
+
+-- HISTORY:
+--     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CC1221C IS
+
+     SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
+     TYPE NEWINT IS NEW INTEGER;
+     TYPE INT IS RANGE -300 .. 300;
+     SUBTYPE SINT1 IS INT
+          RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
+     TYPE INT1 IS RANGE -6 .. 6;
+
+BEGIN
+     TEST ( "CC1221C", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
+                       "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
+                       "DECLARED AND ARE THEREFORE AVAILABLE " &
+                       "WITHIN THE GENERIC UNIT:  ATTRIBUTES 'POS, " &
+                       "'VAL, 'PRED, 'SUCC, 'IMAGE, AND 'VALUE");
+
+     DECLARE -- (C1) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
+             --      PART III.
+
+          GENERIC
+               TYPE T IS RANGE <>;
+               F : INTEGER;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+               I : INTEGER;
+               Y : T;
+
+               FUNCTION IDENT (X : T) RETURN T IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN X;
+                    ELSE
+                         RETURN T'SUCC (T'FIRST);
+                    END IF;
+               END IDENT;
+
+          BEGIN
+               I := F;
+               FOR X IN T LOOP
+                    IF T'VAL (I) /= X THEN
+                         FAILED ( "WRONG VALUE FOR " & STR &
+                                  "'VAL OF " & INTEGER'IMAGE (I));
+                    END IF;
+
+                    IF T'POS (X) /= I THEN
+                         FAILED ( "WRONG VALUE FOR " & STR &
+                                  "'POS OF " & T'IMAGE (X));
+                    END IF;
+
+                    I := I + 1;
+               END LOOP;
+
+               FOR X IN T LOOP
+                    IF T'SUCC (X) /= T'VAL (T'POS (X) + 1) THEN
+                         FAILED ( "WRONG VALUE FOR " & STR &
+                                  "'SUCC OF " & T'IMAGE (X));
+                    END IF;
+
+                    IF T'PRED (X) /= T'VAL (T'POS (X) - 1) THEN
+                         FAILED ( "WRONG VALUE FOR " & STR &
+                                  "'PRED OF " & T'IMAGE (X));
+                    END IF;
+               END LOOP;
+
+               BEGIN
+                    Y := T'SUCC (IDENT (T'BASE'LAST));
+                    FAILED ( "NO EXCEPTION RAISED FOR " &
+                              STR & "'SUCC (IDENT (" & STR &
+                             "'BASE'LAST))" );
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                   STR & "'SUCC (IDENT (" & STR &
+                                  "'BASE'LAST))" );
+               END;
+
+               BEGIN
+                    Y := T'PRED (IDENT (T'BASE'FIRST));
+                    FAILED ( "NO EXCEPTION RAISED FOR " &
+                              STR & "'PRED (IDENT (" & STR &
+                             "'BASE'FIRST))" );
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ( "WRONG EXCEPTION RAISED FOR " &
+                                   STR & "'PRED (IDENT (" & STR &
+                                  "'BASE'FIRST))" );
+               END;
+
+          END P;
+
+          PROCEDURE P1 IS NEW P (SUBINT, -100);
+          PROCEDURE P2 IS NEW P (SINT1, -4);
+          PROCEDURE P3 IS NEW P (INT1, -6);
+
+     BEGIN
+           P1 ( "SUBINT" );
+           P2 ( "SINT" );
+           P3 ( "INT1" );
+     END; -- (C1).
+
+     DECLARE -- (C2) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
+             --      PART IV.
+
+          GENERIC
+               TYPE T IS RANGE <>;
+               STR : STRING;
+          PACKAGE PKG IS END PKG;
+
+          PACKAGE BODY PKG IS
+               PROCEDURE P (IM : STRING; VA : T) IS
+               BEGIN
+                    IF T'IMAGE (VA) /= IM THEN
+                         FAILED ( "INCORRECT RESULTS FOR " & STR &
+                                  "'IMAGE OF " &
+                                   INTEGER'IMAGE (INTEGER (VA)));
+                    END IF;
+               END P;
+
+               PROCEDURE Q (IM : STRING; VA : T) IS
+               BEGIN
+                    IF T'VALUE (IM) /= VA THEN
+                         FAILED ( "INCORRECT RESULTS FOR " & STR &
+                                  "'VALUE OF " & IM);
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
+                                   STR &"'VALUE OF " & IM);
+                    WHEN OTHERS =>
+                         FAILED ( "OTHER EXCEPTION RAISED FOR " &
+                                   STR &"'VALUE OF " & IM);
+
+               END Q;
+
+          BEGIN
+               P (" 2", 2);
+               P ("-1", -1);
+
+               Q (" 2", 2);
+               Q ("-1", -1);
+               Q ("        2", 2);
+               Q ("-1     ", -1);
+          END PKG;
+
+          PACKAGE PKG1 IS NEW PKG (SUBINT, "SUBINT");
+          PACKAGE PKG2 IS NEW PKG (SINT1, "SINT1");
+          PACKAGE PKG3 IS NEW PKG (INT1, "INT1");
+          PACKAGE PKG4 IS NEW PKG (NEWINT, "NEWINT");
+
+     BEGIN
+          NULL;
+     END; -- (C2).
+
+     RESULT;
+END CC1221C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221d.ada
new file mode 100644
index 000000000..931d01627
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1221d.ada
@@ -0,0 +1,173 @@
+-- CC1221D.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:
+--     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
+--     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+--     WITHIN THE GENERIC UNIT:  EXPLICIT CONVERSION TO AND FROM REAL
+--     TYPES AND IMPLICIT CONVERSION FROM INTEGER LITERALS.
+
+-- HISTORY:
+--     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CC1221D IS
+
+     SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
+     TYPE INT IS RANGE -300 .. 300;
+     SUBTYPE SINT1 IS INT
+          RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
+     TYPE INT1 IS RANGE -6 .. 6;
+
+BEGIN
+     TEST ( "CC1221D", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
+                       "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
+                       "DECLARED AND ARE THEREFORE AVAILABLE " &
+                       "WITHIN THE GENERIC UNIT:  EXPLICIT " &
+                       "CONVERSION TO AND FROM REAL TYPES AND " &
+                       "IMPLICIT CONVERSION FROM INTEGER LITERALS");
+
+     DECLARE -- (D) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER
+             --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM
+             --     INTEGER LITERALS.
+
+          GENERIC
+               TYPE T IS RANGE <>;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+
+               TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;
+               FI0  : FIXED := 0.0;
+               FI2  : FIXED := 2.0;
+               FIN2 : FIXED := -2.0;
+
+               FL0  : FLOAT := 0.0;
+               FL2  : FLOAT := 2.0;
+               FLN2 : FLOAT := -2.0;
+
+               T0  : T := 0;
+               T2  : T := 2;
+               TN2 : T := -2;
+
+               FUNCTION IDENT (X : T) RETURN T IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN X;
+                    ELSE
+                         RETURN T'FIRST;
+                    END IF;
+               END IDENT;
+
+          BEGIN
+               IF T0 + 1 /= 1 THEN
+                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                             "CONVERSION WITH TYPE " & STR & " - 1" );
+               END IF;
+
+               IF T2 + 1 /= 3 THEN
+                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                             "CONVERSION WITH TYPE " & STR & " - 2" );
+               END IF;
+
+               IF TN2 + 1 /= -1 THEN
+                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                             "CONVERSION WITH TYPE " & STR & " - 3" );
+               END IF;
+
+               IF T (FI0) /= T0 THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FIXED VALUE 0.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (FI2) /= IDENT (T2) THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FIXED VALUE 2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (FIN2) /= TN2 THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FIXED VALUE -2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (FL0) /= IDENT (T0) THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FLOAT VALUE 0.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (FL2) /= T2 THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FLOAT VALUE 2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (FLN2) /= IDENT (TN2) THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FLOAT VALUE -2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF FIXED (T0) /= FI0 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FIXED VALUE 0.0 WITH TYPE " & STR);
+               END IF;
+
+               IF FIXED (IDENT (T2)) /= FI2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FIXED VALUE 2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF FIXED (TN2) /= FIN2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FIXED VALUE -2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF FLOAT (IDENT (T0)) /= FL0 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FLOAT VALUE 0.0 WITH TYPE " & STR);
+               END IF;
+
+               IF FLOAT (T2) /= FL2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FLOAT VALUE 2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF FLOAT (IDENT (TN2)) /= FLN2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FLOAT VALUE -2.0 WITH TYPE " & STR);
+               END IF;
+
+          END P;
+
+          PROCEDURE P1 IS NEW P (SUBINT);
+          PROCEDURE P2 IS NEW P (SINT1);
+          PROCEDURE P3 IS NEW P (INT1);
+
+     BEGIN
+           P1 ( "SUBINT" );
+           P2 ( "SINT" );
+           P3 ( "INT1" );
+     END; -- (D).
+
+     RESULT;
+END CC1221D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1222a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1222a.ada
new file mode 100644
index 000000000..f6f65896c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1222a.ada
@@ -0,0 +1,290 @@
+-- CC1222A.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 A FORMAL FLOATING POINT TYPE, CHECK THAT THE FOLLOWING BASIC 
+-- OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+-- WITHIN THE GENERIC UNIT: ASSIGNMENT, MEMBERSHIP TESTS, 
+-- QUALIFICATION, EXPLICIT CONVERSION TO AND FROM OTHER NUMERIC TYPES, 
+-- AND REAL LITERALS (IMPLICIT CONVERSION FROM UNIVERSAL REAL TO THE 
+-- FORMAL TYPE), 'FIRST, 'LAST, 'SIZE, 'ADDRESS, 'DIGITS, 'MACHINE_RADIX,
+-- 'MACHINE_MANTISSA, 'MACHINE_EMAX, 'MACHINE_EMIN, 'MACHINE_ROUNDS,
+-- 'MACHINE_OVERFLOWS.
+
+-- R.WILLIAMS 9/30/86
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+PROCEDURE CC1222A IS
+
+     TYPE NEWFLT IS NEW FLOAT;
+
+BEGIN
+     TEST ( "CC1222A",  "FOR A FORMAL FLOATING POINT TYPE, CHECK " &
+                        "THAT THE BASIC OPERATIONS ARE " &
+                        "IMPLICITLY DECLARED AND ARE THEREFORE " &
+                        "AVAILABLE WITHIN THE GENERIC UNIT" );
+
+     DECLARE -- (A). CHECKS FOR ASSIGNMENT, MEMBERSHIP TESTS AND 
+             --      QUALIFICATION.
+
+          GENERIC
+               TYPE T IS DIGITS <>;
+               TYPE T1 IS DIGITS <>;
+               F  : T;               
+               F1 : T1;
+          PROCEDURE P (F2 : T; STR : STRING);
+
+          PROCEDURE P (F2 : T; STR : STRING) IS
+               SUBTYPE ST IS T RANGE -1.0 .. 1.0; 
+               F3, F4  : T;
+
+               FUNCTION FUN (X : T) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN IDENT_BOOL (TRUE);
+               END FUN;
+
+               FUNCTION FUN (X : T1) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN IDENT_BOOL (FALSE);
+               END FUN;
+
+          BEGIN
+               F3 := F;
+               F4 := F2;
+               F3 := F4;
+       
+               IF F3 /= F2 THEN
+                    FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
+                             "WITH TYPE - " & STR);
+               END IF;
+
+               IF F IN ST THEN
+                    NULL;
+               ELSE                                        
+                    FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
+                             "TYPE  - " & STR);
+               END IF;
+
+               IF F2 NOT IN ST THEN
+                    NULL;
+               ELSE                                        
+                    FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
+                             "TYPE  - " & STR);
+               END IF;
+               
+               IF T'(F) /= F THEN                              
+                    FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                             "WITH TYPE - " & STR & " - 1" );
+               END IF;
+
+               IF FUN (T'(1.0)) THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                             "WITH TYPE - " & STR & " - 2" );
+               END IF;
+
+          END P;
+
+          PROCEDURE P1 IS NEW P (FLOAT,  FLOAT,  0.0, 0.0);
+          PROCEDURE P2 IS NEW P (NEWFLT, NEWFLT, 0.0, 0.0);
+     
+     BEGIN
+          P1 (2.0, "FLOAT");
+          P2 (2.0, "NEWFLT");
+     END; -- (A).         
+
+     DECLARE -- (B) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER 
+             --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM 
+             --     REAL LITERAL.
+
+          GENERIC
+               TYPE T IS DIGITS <>;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+
+               TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;
+               FI0  : FIXED := 0.0;
+               FI2  : FIXED := 2.0;
+               FIN2 : FIXED := -2.0; 
+
+               I0  : INTEGER := 0;
+               I2  : INTEGER := 2;
+               IN2 : INTEGER := -2; 
+
+               T0  : T := 0.0;
+               T2  : T := 2.0;
+               TN2 : T := -2.0; 
+               
+               FUNCTION IDENT (X : T) RETURN T IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN X;
+                    ELSE
+                         RETURN T'FIRST;
+                    END IF;
+               END IDENT;
+
+          BEGIN
+               IF T0 + 1.0 /= 1.0 THEN
+                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                             "CONVERSION WITH TYPE " & STR & " - 1" );
+               END IF;
+
+               IF T2 + 1.0 /= 3.0 THEN
+                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                             "CONVERSION WITH TYPE " & STR & " - 2" );
+               END IF;
+
+               IF TN2 + 1.0 /= -1.0 THEN
+                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                             "CONVERSION WITH TYPE " & STR & " - 3" );
+               END IF;
+
+               IF T (FI0) /= T0 THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FIXED VALUE 0.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (FI2) /= IDENT (T2) THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FIXED VALUE 2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (FIN2) /= TN2 THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FIXED VALUE -2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (I0) /= IDENT (T0) THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "INTEGER VALUE 0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (I2) /= T2 THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "INTEGER VALUE 2 WITH TYPE " & STR);
+               END IF;
+
+               IF T (IN2) /= IDENT (TN2) THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "INTEGER VALUE -2 WITH TYPE " & STR);
+               END IF;
+
+               IF FIXED (T0) /= FI0 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FIXED VALUE 0.0 WITH TYPE " & STR);
+               END IF;
+
+               IF FIXED (IDENT (T2)) /= FI2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FIXED VALUE 2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF FIXED (TN2) /= FIN2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FIXED VALUE -2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF INTEGER (IDENT (T0)) /= I0 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "INTEGER VALUE 0 WITH TYPE " & STR);
+               END IF;
+
+               IF INTEGER (T2) /= I2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "INTEGER VALUE 2 WITH TYPE " & STR);
+               END IF;
+
+               IF INTEGER (IDENT (TN2)) /= IN2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "INTEGER VALUE -2 WITH TYPE " & STR);
+               END IF;
+
+          END P;
+
+          PROCEDURE P1 IS NEW P (FLOAT);
+          PROCEDURE P2 IS NEW P (NEWFLT);
+
+     BEGIN
+           P1 ( "FLOAT" );
+           P2 ( "NEWFLT" );
+     END; -- (B).         
+
+     DECLARE -- (C) CHECKS FOR ATTRIBUTES.
+
+          GENERIC
+               TYPE T IS DIGITS <>;
+               F, L : T;
+               D : INTEGER;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+
+               F1 : T;
+               A  : ADDRESS := F'ADDRESS;
+               S  : INTEGER := F'SIZE;
+
+               I  : INTEGER;
+               I1 : INTEGER := T'MACHINE_RADIX;
+               I2 : INTEGER := T'MACHINE_MANTISSA;
+               I3 : INTEGER := T'MACHINE_EMAX;
+               I4 : INTEGER := T'MACHINE_EMIN;
+
+               B1 : BOOLEAN := T'MACHINE_ROUNDS;
+               B2 : BOOLEAN := T'MACHINE_OVERFLOWS;
+
+          BEGIN
+               IF T'DIGITS /= D THEN
+                    FAILED ( "INCORRECT VALUE FOR " &
+                              STR & "'DIGITS" );
+               END IF;
+
+               IF T'FIRST /= F THEN
+                    FAILED ( "INCORRECT VALUE FOR " &
+                              STR & "'FIRST" );
+               END IF;
+
+               IF T'LAST /= L THEN
+                    FAILED ( "INCORRECT VALUE FOR " &
+                              STR & "'LAST" );
+               END IF;
+
+          END P;
+
+          PROCEDURE P1 IS 
+               NEW P (FLOAT, FLOAT'FIRST, FLOAT'LAST, FLOAT'DIGITS);
+          PROCEDURE P2 IS 
+               NEW P (NEWFLT, NEWFLT'FIRST, NEWFLT'LAST, 
+                      NEWFLT'DIGITS);
+
+     BEGIN
+           P1 ( "FLOAT" );
+           P2 ( "NEWFLT" );
+     END; -- (C).         
+
+     RESULT;
+END CC1222A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1223a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1223a.ada
new file mode 100644
index 000000000..1f9b0052f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1223a.ada
@@ -0,0 +1,297 @@
+-- CC1223A.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:
+--     FOR A FORMAL FIXED POINT TYPE, CHECK THAT THE FOLLOWING BASIC
+--     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
+--     WITHIN THE GENERIC UNIT: ASSIGNMENT, MEMBERSHIP TESTS,
+--     QUALIFICATION, EXPLICIT CONVERSION TO AND FROM OTHER NUMERIC
+--     TYPES, AND REAL LITERALS (IMPLICIT CONVERSION FROM UNIVERSAL REAL
+--     TO THE FORMAL TYPE), 'FIRST, 'LAST, 'SIZE, 'ADDRESS, 'DELTA, 'FORE, 
+--     'AFT, 'MACHINE_ROUNDS, 'MACHINE_OVERFLOWS.
+
+-- HISTORY:
+--     RJW 09/30/86  CREATED ORIGINAL TEST.
+--     JLH 09/25/87  REFORMATTED HEADER.
+--     RJW 08/21/89  MODIFIED CHECKS FOR 'MANTISSA AND 'AFT.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1223A IS
+
+     TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;
+
+BEGIN
+     TEST ( "CC1223A",  "FOR A FORMAL FIXED POINT TYPE, CHECK " &
+                        "THAT THE BASIC OPERATIONS ARE " &
+                        "IMPLICITLY DECLARED AND ARE THEREFORE " &
+                        "AVAILABLE WITHIN THE GENERIC UNIT" );
+
+     DECLARE -- (A). CHECKS FOR ASSIGNMENT, MEMBERSHIP TESTS AND
+             --      QUALIFICATION.
+
+          GENERIC
+               TYPE T IS DELTA <>;
+               TYPE T1 IS DELTA <>;
+               F  : T;
+               F1 : T1;
+          PROCEDURE P (F2 : T; STR : STRING);
+
+          PROCEDURE P (F2 : T; STR : STRING) IS
+               SUBTYPE ST IS T RANGE -1.0 .. 1.0;
+               F3, F4  : T;
+
+               FUNCTION FUN (X : T) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN IDENT_BOOL (TRUE);
+               END FUN;
+
+               FUNCTION FUN (X : T1) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN IDENT_BOOL (FALSE);
+               END FUN;
+
+          BEGIN
+               F3 := F;
+               F4 := F2;
+               F3 := F4;
+
+               IF F3 /= F2 THEN
+                    FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
+                             "WITH TYPE - " & STR);
+               END IF;
+
+               IF F IN ST THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
+                             "TYPE  - " & STR);
+               END IF;
+
+               IF F2 NOT IN ST THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
+                             "TYPE  - " & STR);
+               END IF;
+
+               IF T'(F) /= F THEN
+                    FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                             "WITH TYPE - " & STR & " - 1" );
+               END IF;
+
+               IF FUN (T'(1.0)) THEN
+                    NULL;
+               ELSE
+                    FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
+                             "WITH TYPE - " & STR & " - 2" );
+               END IF;
+
+          END P;
+
+          PROCEDURE P1 IS NEW P (FIXED, FIXED, 0.0, 0.0);
+          PROCEDURE P2 IS NEW P (DURATION, DURATION, 0.0, 0.0);
+
+     BEGIN
+          P1 (2.0, "FIXED");
+          P2 (2.0, "DURATION");
+     END; -- (A).
+
+     DECLARE -- (B) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER
+             --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM
+             --     REAL LITERAL.
+
+          GENERIC
+               TYPE T IS DELTA <>;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+
+               FL0  : FLOAT := 0.0;
+               FL2  : FLOAT := 2.0;
+               FLN2 : FLOAT := -2.0;
+
+               I0  : INTEGER := 0;
+               I2  : INTEGER := 2;
+               IN2 : INTEGER := -2;
+
+               T0  : T := 0.0;
+               T2  : T := 2.0;
+               TN2 : T := -2.0;
+
+               FUNCTION IDENT (X : T) RETURN T IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN X;
+                    ELSE
+                         RETURN T'FIRST;
+                    END IF;
+               END IDENT;
+
+          BEGIN
+               IF T0 + 1.0 /= 1.0 THEN
+                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                             "CONVERSION WITH TYPE " & STR & " - 1" );
+               END IF;
+
+               IF T2 + 1.0 /= 3.0 THEN
+                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                             "CONVERSION WITH TYPE " & STR & " - 2" );
+               END IF;
+
+               IF TN2 + 1.0 /= -1.0 THEN
+                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
+                             "CONVERSION WITH TYPE " & STR & " - 3" );
+               END IF;
+
+               IF T (FL0) /= T0 THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FLOAT VALUE 0.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (FL2) /= IDENT (T2) THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FLOAT VALUE 2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (FLN2) /= TN2 THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "FLOAT VALUE -2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (I0) /= IDENT (T0) THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "INTEGER VALUE 0 WITH TYPE " & STR);
+               END IF;
+
+               IF T (I2) /= T2 THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "INTEGER VALUE 2 WITH TYPE " & STR);
+               END IF;
+
+               IF T (IN2) /= IDENT (TN2) THEN
+                    FAILED ( "INCORRECT CONVERSION FROM " &
+                             "INTEGER VALUE -2 WITH TYPE " & STR);
+               END IF;
+
+               IF FLOAT (T0) /= FL0 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FLOAT VALUE 0.0 WITH TYPE " & STR);
+               END IF;
+
+               IF FLOAT (IDENT (T2)) /= FL2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FLOAT VALUE 2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF FLOAT (TN2) /= FLN2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "FLOAT VALUE -2.0 WITH TYPE " & STR);
+               END IF;
+
+               IF INTEGER (IDENT (T0)) /= I0 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "INTEGER VALUE 0 WITH TYPE " & STR);
+               END IF;
+
+               IF INTEGER (T2) /= I2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "INTEGER VALUE 2 WITH TYPE " & STR);
+               END IF;
+
+               IF INTEGER (IDENT (TN2)) /= IN2 THEN
+                    FAILED ( "INCORRECT CONVERSION TO " &
+                             "INTEGER VALUE -2 WITH TYPE " & STR);
+               END IF;
+
+          END P;
+
+          PROCEDURE P1 IS NEW P (FIXED);
+          PROCEDURE P2 IS NEW P (DURATION);
+
+     BEGIN
+           P1 ( "FIXED" );
+           P2 ( "DURATION" );
+     END; -- (B).
+
+     DECLARE -- (C) CHECKS FOR ATTRIBUTES.
+
+          GENERIC
+               TYPE T IS DELTA <>;
+               F, L, D : T;
+          PROCEDURE P (STR : STRING);
+
+          PROCEDURE P (STR : STRING) IS
+
+               F1 : T;
+               A  : ADDRESS := F'ADDRESS;
+               S  : INTEGER := F'SIZE;
+
+               I  : INTEGER;
+
+               B1 : BOOLEAN := T'MACHINE_ROUNDS;
+               B2 : BOOLEAN := T'MACHINE_OVERFLOWS;
+
+          BEGIN
+               IF T'DELTA /= D THEN
+                    FAILED ( "INCORRECT VALUE FOR " &
+                              STR & "'DELTA" );
+               END IF;
+
+               IF T'FIRST /= F THEN
+                    FAILED ( "INCORRECT VALUE FOR " &
+                              STR & "'FIRST" );
+               END IF;
+
+               IF T'LAST /= L THEN
+                    FAILED ( "INCORRECT VALUE FOR " &
+                              STR & "'LAST" );
+               END IF;
+
+               IF T'FORE < 2 THEN
+                    FAILED ( "INCORRECT VALUE FOR " &
+                              STR & "'FORE" );
+               END IF;
+
+               IF T'AFT <= 0 THEN
+                    FAILED ( "INCORRECT VALUE FOR " & STR & "'AFT" );
+               END IF;
+
+          END P;
+
+          PROCEDURE P1 IS
+               NEW P (FIXED, FIXED'FIRST, FIXED'LAST, FIXED'DELTA);
+          PROCEDURE P2 IS
+               NEW P (DURATION, DURATION'FIRST, DURATION'LAST,
+                      DURATION'DELTA);
+
+     BEGIN
+           P1 ( "FIXED" );
+           P2 ( "DURATION" );
+     END; -- (C).
+
+     RESULT;
+END CC1223A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1224a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1224a.ada
new file mode 100644
index 000000000..c419fb7e4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1224a.ada
@@ -0,0 +1,558 @@
+-- CC1224A.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:
+--     FOR ARRAY TYPES WITH A NONLIMITED COMPONENT TYPE (OF A FORMAL
+--     AND NONFORMAL GENERIC TYPE), CHECK THAT THE FOLLOWING OPERATIONS
+--     ARE IMPLICITY DECLARED AND ARE, THEREFORE, AVAILABLE WITHIN THE
+--     GENERIC UNIT: ASSIGNMENT, THE OPERATION ASSOCIATED WITH
+--     AGGREGATE NOTATION, MEMBERSHIP TESTS, THE OPERATION ASSOCIATED
+--     WITH INDEXED COMPONENTS, QUALIFICATION, EXPLICIT CONVERSION,
+--     'SIZE, 'ADDRESS, 'FIRST, 'FIRST (N), 'LAST, 'LAST (N),
+--     'RANGE, 'RANGE (N), 'LENGTH, 'LENGTH (N).
+
+-- HISTORY:
+--     R.WILLIAMS  10/6/86
+--     EDWARD V. BERARD  8/10/90  ADDED CHECKS FOR MULTI-DIMENSIONAL
+--                                ARRAYS
+--     LDC  10/10/90  CHANGED DECLARATIONS OF AD1 - AD6 TO PROCEDURE
+--                    CALLS OF FA1 - FA6 TO ADDRESS_CHECK AS SUGGESTED
+--                    BY THE CRG. 
+--     PWN  01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH SYSTEM ;
+WITH REPORT ;
+
+PROCEDURE CC1224A IS
+
+     SHORT_START : CONSTANT := -10 ;
+     SHORT_END   : CONSTANT := 10 ;
+
+     TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+     SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
+
+     MEDIUM_START    : CONSTANT := 1 ;
+     MEDIUM_END      : CONSTANT := 15 ;
+
+     TYPE MEDIUM_RANGE IS RANGE MEDIUM_START .. MEDIUM_END ;
+     MEDIUM_LENGTH   : CONSTANT NATURAL := 
+                                (MEDIUM_END - MEDIUM_START + 1) ;
+
+     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                         SEP, OCT, NOV, DEC) ;
+     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+     TYPE DATE IS RECORD
+          MONTH : MONTH_TYPE ;
+          DAY   : DAY_TYPE ;
+          YEAR  : YEAR_TYPE ;
+     END RECORD ;
+
+     TODAY : DATE := (AUG, 10, 1990) ;
+
+     TYPE FIRST_TEMPLATE IS ARRAY (SHORT_RANGE RANGE <>,
+                                   MEDIUM_RANGE RANGE <>) OF DATE ;
+
+     TYPE SECOND_TEMPLATE IS ARRAY (SHORT_RANGE, MEDIUM_RANGE) 
+                                   OF DATE ;
+
+     FIRST_ARRAY     : FIRST_TEMPLATE (-10 .. 10, 6 .. 10) ;
+     SECOND_ARRAY    : FIRST_TEMPLATE (0 .. 7, 1 .. 15) ;
+     THIRD_ARRAY     : SECOND_TEMPLATE ;
+     FOURTH_ARRAY    : SECOND_TEMPLATE ;
+
+     SUBTYPE SUBINT IS INTEGER RANGE REPORT.IDENT_INT (1) .. 
+                                     REPORT.IDENT_INT (6);
+
+     TYPE ARRA IS ARRAY (SUBINT) OF SUBINT;
+     A1 : ARRA := (REPORT.IDENT_INT (1) .. REPORT.IDENT_INT (6) => 1);
+     A2 : ARRA := (A1'RANGE => 2);
+
+     TYPE ARRB IS ARRAY (SUBINT RANGE <>) OF DATE ;
+     A3 : ARRB (1 .. 6) := 
+               (REPORT.IDENT_INT (1) .. REPORT.IDENT_INT (6) => TODAY);
+
+     TYPE ARRC IS ARRAY (SUBINT RANGE <>, SUBINT RANGE <>) OF SUBINT;
+     A4 : CONSTANT ARRC := (1 .. 6 => (1 .. 6 => 4));
+
+     TYPE ARRD IS ARRAY (SUBINT, SUBINT) OF SUBINT;
+     A5 : ARRD := (A4'RANGE (1) => (A4'RANGE (2) => 5));
+
+     TYPE ARRE IS ARRAY (SUBINT) OF DATE ;
+     A6 : ARRE := (A1'RANGE => TODAY);
+
+     FUNCTION "=" (LEFT  : IN SYSTEM.ADDRESS ;
+                   RIGHT : IN SYSTEM.ADDRESS ) RETURN BOOLEAN
+              RENAMES SYSTEM."=" ;
+
+     GENERIC
+
+          TYPE T1 IS (<>);
+          TYPE T2 IS PRIVATE;
+          X2 : T2;
+
+          TYPE FARR1 IS ARRAY (SUBINT) OF T1;
+          FA1 : FARR1;
+
+          TYPE FARR2 IS ARRAY (SUBINT) OF SUBINT;
+          FA2 : FARR2;
+
+          TYPE FARR3 IS ARRAY (SUBINT RANGE <>) OF T2;
+          FA3 : FARR3;
+
+          TYPE FARR4 IS ARRAY (SUBINT RANGE <>, SUBINT RANGE <>) OF T1;
+          FA4 : FARR4;
+
+          TYPE FARR5 IS ARRAY (SUBINT, SUBINT) OF SUBINT;
+          FA5 : FARR5;
+
+          TYPE FARR6 IS ARRAY (T1) OF T2;
+          FA6 : FARR6;
+
+          TYPE FARR7 IS ARRAY (T1) OF T2;
+          FA7 : FARR7;
+
+     PROCEDURE P ;
+
+     GENERIC
+
+          TYPE FIRST_INDEX IS (<>) ;
+          TYPE SECOND_INDEX IS (<>) ;
+          TYPE UNCONSTRAINED_ARRAY IS ARRAY 
+               (FIRST_INDEX RANGE <>, SECOND_INDEX RANGE <>) OF DATE ;
+
+     PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
+                               FFIFS        : IN FIRST_INDEX ;
+                               FFILS        : IN FIRST_INDEX ;
+                               FSIFS        : IN SECOND_INDEX ;
+                               FSILS        : IN SECOND_INDEX ;
+                               FFLEN        : IN NATURAL ;
+                               FSLEN        : IN NATURAL ;
+                               FFIRT        : IN FIRST_INDEX ;
+                               FSIRT        : IN SECOND_INDEX ;
+                               SECOND       : IN UNCONSTRAINED_ARRAY ;
+                               SFIFS        : IN FIRST_INDEX ;
+                               SFILS        : IN FIRST_INDEX ;
+                               SSIFS        : IN SECOND_INDEX ;
+                               SSILS        : IN SECOND_INDEX ;
+                               SFLEN        : IN NATURAL ;
+                               SSLEN        : IN NATURAL ;
+                               SFIRT        : IN FIRST_INDEX ;
+                               SSIRT        : IN SECOND_INDEX ;
+                               REMARKS      : IN STRING) ;
+     GENERIC
+
+          TYPE FIRST_INDEX IS (<>) ;
+          TYPE SECOND_INDEX IS (<>) ;
+          TYPE COMPONENT_TYPE IS PRIVATE ;
+          TYPE CONSTRAINED_ARRAY IS ARRAY 
+               (FIRST_INDEX,SECOND_INDEX) OF COMPONENT_TYPE ;
+
+     PROCEDURE CTEST_PROCEDURE (FIRST        : IN CONSTRAINED_ARRAY ;
+                                FFIRT        : IN FIRST_INDEX ;
+                                FSIRT        : IN SECOND_INDEX ;
+                                SECOND       : IN CONSTRAINED_ARRAY ;
+                                SFIRT        : IN FIRST_INDEX ;
+                                SSIRT        : IN SECOND_INDEX ;
+                                REMARKS      : IN STRING) ;
+
+
+     PROCEDURE P IS
+
+          IN1 : INTEGER := FA1'SIZE;
+          IN2 : INTEGER := FA2'SIZE;
+          IN3 : INTEGER := FA3'SIZE;
+          IN4 : INTEGER := FA4'SIZE;
+          IN5 : INTEGER := FA5'SIZE;
+          IN6 : INTEGER := FA6'SIZE;
+
+          B1 : FARR1;
+
+          B2 : FARR2;
+
+          SUBTYPE SARR3 IS FARR3 (FA3'RANGE);
+          B3 : SARR3;
+
+          SUBTYPE SARR4 IS FARR4 (FA4'RANGE (1), FA4'RANGE (2));
+          B4 : SARR4;
+
+          B5 : FARR5;
+
+          B6 : FARR6 ;
+
+          PROCEDURE ADDRESS_CHECK(ADDRESS : SYSTEM.ADDRESS) IS
+
+          BEGIN
+               IF REPORT.EQUAL(1, REPORT.IDENT_INT(2)) THEN
+                    REPORT.COMMENT("DON'T OPTIMIZE OUT ADDRESS_CHECK");
+               END IF;
+          END ADDRESS_CHECK;
+
+     BEGIN  -- P
+
+          ADDRESS_CHECK(FA1'ADDRESS);
+          ADDRESS_CHECK(FA2'ADDRESS);
+          ADDRESS_CHECK(FA3'ADDRESS);
+          ADDRESS_CHECK(FA4'ADDRESS);
+          ADDRESS_CHECK(FA5'ADDRESS);
+          ADDRESS_CHECK(FA6'ADDRESS);
+
+          B1 := FA1;
+
+          IF B1 /= FARR1 (FA1) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 1" );
+          END IF;
+
+          B2 := FA2;
+
+          IF B2 /= FARR2 (A2) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 2" );
+          END IF;
+
+          B3 := FA3;
+
+          IF B3 /= FARR3 (FA3) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 3" );
+          END IF;
+
+          B4 := FA4;
+
+          IF B4 /= FARR4 (FA4) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 4" );
+          END IF;
+
+          B5 := FA5;
+
+          IF B5 /= FARR5 (A5) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 5" );
+          END IF;
+
+          B6 := FA6;
+
+          IF B6 /= FARR6 (FA6) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 6" );
+          END IF;
+
+          IF FA7 /= FARR7 (FA6) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 7" );
+          END IF;
+
+          B1 := FARR1'(FA1'RANGE => T1'VAL (1));
+
+          IF B1 (1) /= FA1 (1) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 8" );
+          END IF;
+
+          B1 := FARR1'(1 => T1'VAL (1), 2 => T1'VAL (1), 
+                       3 .. 6 => T1'VAL (2));
+
+          IF B1 (1) /= FA1 (1) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 9" );
+          END IF;
+
+          B2 := FARR2'(FA2'RANGE => 2);
+
+          IF B2 (2) /= FA2 (2) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 10" );
+          END IF;
+
+          B3 := FARR3'(1|2|3 => X2, 4|5|6 => X2);
+
+          IF B3 (3) /= FA3 (3) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 11" );
+          END IF;
+
+          B4 := FARR4'(FA5'RANGE (1) => (FA5'RANGE (2) => T1'VAL (4)));
+
+          IF B4 (4, 4) /= FA4 (4, 4) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 12" );
+          END IF;
+
+          B5 := FARR5'(REPORT.IDENT_INT (1) .. 
+                       REPORT.IDENT_INT (6) =>  (1 .. 6 => 5));
+
+          IF B5 (5, 5) /= FA5 (5, 5) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 13" );
+          END IF;
+
+          B6 := FARR6'(FA6'RANGE => X2);
+
+          IF B6 (T1'FIRST) /= FA6 (T1'FIRST) THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 14" );
+          END IF;
+
+          IF B1 NOT IN FARR1 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 15" );
+          END IF;
+
+          IF FA2 NOT IN FARR2 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 16" );
+          END IF;
+
+          IF FA3 NOT IN FARR3 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 17" );
+          END IF;
+
+          IF B4 NOT IN FARR4 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 18" );
+          END IF;
+
+          IF B5 NOT IN FARR5 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 19" );
+          END IF;
+
+          IF FA6 NOT IN FARR6 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 20" );
+          END IF;
+
+          IF FA1'LENGTH /= FA1'LAST - FA1'FIRST + 1 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 27" );
+          END IF;
+
+          IF FA2'LENGTH /= FA2'LAST - FA2'FIRST + 1 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 28" );
+          END IF;
+
+          IF FA3'LENGTH /= FA3'LAST - FA3'FIRST + 1 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 29" );
+          END IF;
+
+          IF FA4'LENGTH /= FA4'LAST - FA4'FIRST + 1 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 30" );
+          END IF;
+
+          IF FA4'LENGTH (2) /= FA4'LAST (2) - FA4'FIRST (2) + 1 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 31" );
+          END IF;
+
+          IF FA5'LENGTH /= FA5'LAST - FA5'FIRST + 1 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 32" );
+          END IF;
+
+          IF FA5'LENGTH (2) /= FA5'LAST (2) - FA5'FIRST (2) + 1 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 33" );
+          END IF;
+
+          IF FA6'LENGTH /= T1'POS (FA6'LAST) - 
+             T1'POS (FA6'FIRST) + 1 THEN
+               REPORT.FAILED ("INCORRECT RESULTS - 34" );
+          END IF;
+
+     END P ;
+
+     PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
+                               FFIFS        : IN FIRST_INDEX ;
+                               FFILS        : IN FIRST_INDEX ;
+                               FSIFS        : IN SECOND_INDEX ;
+                               FSILS        : IN SECOND_INDEX ;
+                               FFLEN        : IN NATURAL ;
+                               FSLEN        : IN NATURAL ;
+                               FFIRT        : IN FIRST_INDEX ;
+                               FSIRT        : IN SECOND_INDEX ;
+                               SECOND       : IN UNCONSTRAINED_ARRAY ;
+                               SFIFS        : IN FIRST_INDEX ;
+                               SFILS        : IN FIRST_INDEX ;
+                               SSIFS        : IN SECOND_INDEX ;
+                               SSILS        : IN SECOND_INDEX ;
+                               SFLEN        : IN NATURAL ;
+                               SSLEN        : IN NATURAL ;
+                               SFIRT        : IN FIRST_INDEX ;
+                               SSIRT        : IN SECOND_INDEX ;
+                               REMARKS      : IN STRING) IS
+
+     BEGIN -- TEST_PROCEDURE
+
+          IF (FIRST'FIRST /= FFIFS) OR
+             (FIRST'FIRST (1) /= FFIFS) OR
+             (FIRST'FIRST (2) /= FSIFS) OR
+             (SECOND'FIRST /= SFIFS) OR
+             (SECOND'FIRST (1) /= SFIFS) OR
+             (SECOND'FIRST (2) /= SSIFS) THEN
+               REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
+          END IF ;
+
+          IF (FIRST'LAST /= FFILS) OR
+             (FIRST'LAST (1) /= FFILS) OR
+             (FIRST'LAST (2) /= FSILS) OR
+             (SECOND'LAST /= SFILS) OR
+             (SECOND'LAST (1) /= SFILS) OR
+             (SECOND'LAST (2) /= SSILS) THEN
+               REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
+          END IF ;
+
+          IF (FIRST'LENGTH /= FFLEN) OR
+             (FIRST'LENGTH (1) /= FFLEN) OR
+             (FIRST'LENGTH (2) /= FSLEN) OR
+             (SECOND'LENGTH /= SFLEN) OR
+             (SECOND'LENGTH (1) /= SFLEN) OR
+             (SECOND'LENGTH (2) /= SSLEN) THEN
+               REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
+          END IF ;
+
+          IF (FFIRT NOT IN FIRST'RANGE (1)) OR
+             (FFIRT NOT IN FIRST'RANGE) OR
+             (SFIRT NOT IN SECOND'RANGE (1)) OR
+             (SFIRT NOT IN SECOND'RANGE) OR
+             (FSIRT NOT IN FIRST'RANGE (2)) OR
+             (SSIRT NOT IN SECOND'RANGE (2)) THEN
+               REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUE. " &
+                              REMARKS) ;
+          END IF ;
+
+     END TEST_PROCEDURE ;
+
+     PROCEDURE CTEST_PROCEDURE (FIRST        : IN CONSTRAINED_ARRAY ;
+                                FFIRT        : IN FIRST_INDEX ;
+                                FSIRT        : IN SECOND_INDEX ;
+                                SECOND       : IN CONSTRAINED_ARRAY ;
+                                SFIRT        : IN FIRST_INDEX ;
+                                SSIRT        : IN SECOND_INDEX ;
+                                REMARKS      : IN STRING) IS
+
+     BEGIN -- CTEST_PROCEDURE
+
+          IF (FIRST'FIRST /= FIRST_INDEX'FIRST) OR
+             (FIRST'FIRST (1) /= FIRST_INDEX'FIRST) OR
+             (FIRST'FIRST (2) /= SECOND_INDEX'FIRST) OR
+             (SECOND'FIRST /= FIRST_INDEX'FIRST) OR
+             (SECOND'FIRST (1) /= FIRST_INDEX'FIRST) OR
+             (SECOND'FIRST (2) /= SECOND_INDEX'FIRST) THEN
+               REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
+          END IF ;
+
+          IF (FIRST'LAST /= FIRST_INDEX'LAST) OR
+             (FIRST'LAST (1) /= FIRST_INDEX'LAST) OR
+             (FIRST'LAST (2) /= SECOND_INDEX'LAST) OR
+             (SECOND'LAST /= FIRST_INDEX'LAST) OR
+             (SECOND'LAST (1) /= FIRST_INDEX'LAST) OR
+             (SECOND'LAST (2) /= SECOND_INDEX'LAST) THEN
+               REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
+          END IF ;
+
+          IF (FIRST'LENGTH /=
+              FIRST_INDEX'POS (FIRST_INDEX'LAST)
+              - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
+             (FIRST'LENGTH (1) /= 
+              FIRST_INDEX'POS (FIRST_INDEX'LAST)
+              - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
+             (FIRST'LENGTH (2) /=
+              SECOND_INDEX'POS (SECOND_INDEX'LAST)
+              - SECOND_INDEX'POS (SECOND_INDEX'FIRST) + 1) OR
+             (SECOND'LENGTH /= 
+              FIRST_INDEX'POS (FIRST_INDEX'LAST)
+              - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
+             (SECOND'LENGTH (1) /=
+              FIRST_INDEX'POS (FIRST_INDEX'LAST)
+              - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
+             (SECOND'LENGTH (2) /=
+              SECOND_INDEX'POS (SECOND_INDEX'LAST)
+              - SECOND_INDEX'POS (SECOND_INDEX'FIRST) + 1) THEN
+               REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
+          END IF ;
+
+          IF (FFIRT NOT IN FIRST'RANGE (1)) OR
+             (FFIRT NOT IN FIRST'RANGE) OR
+             (SFIRT NOT IN SECOND'RANGE (1)) OR
+             (SFIRT NOT IN SECOND'RANGE) OR
+             (FSIRT NOT IN FIRST'RANGE (2)) OR
+             (SSIRT NOT IN SECOND'RANGE (2)) THEN
+                REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUE. " &
+                               REMARKS) ;
+          END IF ;
+
+          IF CONSTRAINED_ARRAY'SIZE <= 0 THEN
+               REPORT.FAILED ("PROBLEMS WITH THE 'SIZE ATTRIBUTE. " &
+                              REMARKS) ;
+          END IF ;
+
+          IF FIRST'ADDRESS = SECOND'ADDRESS THEN
+               REPORT.FAILED ("PROBLEMS WITH THE 'ADDRESS ATTRIBUTE. " &
+                              REMARKS) ;
+          END IF ;
+
+     END CTEST_PROCEDURE ;
+
+     PROCEDURE FIRST_TEST_PROCEDURE IS NEW TEST_PROCEDURE 
+               (FIRST_INDEX            => SHORT_RANGE,
+                SECOND_INDEX           => MEDIUM_RANGE,
+                UNCONSTRAINED_ARRAY    => FIRST_TEMPLATE) ;
+
+     PROCEDURE NEW_CTEST_PROCEDURE IS NEW CTEST_PROCEDURE 
+               (FIRST_INDEX           => SHORT_RANGE,
+                SECOND_INDEX          => MEDIUM_RANGE,
+                COMPONENT_TYPE        => DATE,
+                CONSTRAINED_ARRAY     => SECOND_TEMPLATE) ;
+
+     PROCEDURE NP IS NEW P (SUBINT, DATE, TODAY, ARRA, A1, 
+                            ARRA, A2, ARRB, A3, ARRC, A4, ARRD,
+                            A5, ARRE, A6, ARRE, A6);
+
+BEGIN  -- CC1224A
+
+     REPORT.TEST ("CC1224A", "FOR ARRAY TYPES WITH A NONLIMITED " &
+                  "COMPONENT TYPE (OF A FORMAL AND NONFORMAL GENERIC " &
+                  "TYPE), CHECK THAT THE FOLLOWING OPERATIONS " &
+                  "ARE IMPLICITY DECLARED AND ARE, THEREFORE, " &
+                  "AVAILABLE WITHIN THE GENERIC -- UNIT: " &
+                  "ASSIGNMENT, THE OPERATION ASSOCIATED WITH " &
+                  "AGGREGATE NOTATION, MEMBERSHIP TESTS, THE " &
+                  "OPERATION ASSOCIATED WITH INDEXED " &
+                  "COMPONENTS, QUALIFICATION, EXPLICIT " &
+                  "CONVERSION, 'SIZE, 'ADDRESS, 'FIRST, " &
+                  "'FIRST (N), 'LAST, 'LAST (N), 'RANGE, " &
+                  "'RANGE (N), 'LENGTH, 'LENGTH (N)" ) ;
+
+     NP ;
+
+     FIRST_TEST_PROCEDURE (FIRST        => FIRST_ARRAY,
+                           FFIFS        => -10,
+                           FFILS        => 10,
+                           FSIFS        => 6,
+                           FSILS        => 10,
+                           FFLEN        => 21,
+                           FSLEN        => 5,
+                           FFIRT        => 0,
+                           FSIRT        => 8,
+                           SECOND       => SECOND_ARRAY,
+                           SFIFS        => 0,
+                           SFILS        => 7,
+                           SSIFS        => 1,
+                           SSILS        => 15,
+                           SFLEN        => 8,
+                           SSLEN        => 15,
+                           SFIRT        => 5,
+                           SSIRT        => 13,
+                           REMARKS      => "FIRST_TEST_PROCEDURE") ;
+
+     NEW_CTEST_PROCEDURE (FIRST         => THIRD_ARRAY,
+                          FFIRT         => -5,
+                          FSIRT         => 11,
+                          SECOND        => FOURTH_ARRAY,
+                          SFIRT         => 0,
+                          SSIRT         => 14,
+                          REMARKS       => "NEW_CTEST_PROCEDURE") ;
+
+     REPORT.RESULT ;
+
+END CC1224A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1225a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1225a.tst
new file mode 100644
index 000000000..dfad3b0ed
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1225a.tst
@@ -0,0 +1,350 @@
+-- CC1225A.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, FOR A FORMAL ACCESS TYPE, THAT ALL ALLOWABLE OPERATIONS
+--     ARE IMPLICITLY DECLARED.
+
+-- MACRO SUBSTITUTION:
+--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+--     THE ACTIVATION OF A TASK.
+
+-- HISTORY:
+--     BCB 03/29/88  CREATED ORIGINAL TEST.
+--     RDH 04/09/90  ADDED 'STORAGE_SIZE CLAUSES.  CHANGED EXTENSION TO
+--                   'TST'.
+--     LDC 09/26/90  REMOVED 'USE PACK' AFTER THE WITH SINCE IT ISN'T 
+--                   NEEDED, ADDED CHECK FOR NULL AFTER ASSIGMENT TO
+--                   NULL, ADDED CHECKS FOR OTHER RELATION OPERATORS,
+--                   CHANGED CHECK FOR 'ADDRESS TO A PROCEDURE CALL.
+--     LDC 10/13/90  CHANGED CHECK FOR 'SIZE TO ONLY CHECK FOR 
+--                   AVAILABILITY.  CHANGED CHECK FOR 'ADDRESS TO A 
+--                   MEMBERSHIP TEST.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+
+PROCEDURE CC1225A IS
+
+     TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+
+     TYPE AI IS ACCESS INTEGER;
+
+     TYPE ACCINTEGER IS ACCESS INTEGER;
+
+     TYPE REC IS RECORD
+          COMP : INTEGER;
+     END RECORD;
+
+     TYPE DISCREC (DISC : INTEGER := 1) IS RECORD
+          COMPD : INTEGER;
+     END RECORD;
+
+     TYPE AREC IS ACCESS REC;
+
+     TYPE ADISCREC IS ACCESS DISCREC;
+
+     TYPE ARR IS ARRAY(1..2,1..2) OF INTEGER;
+
+     TYPE ONEDIM IS ARRAY(1..10) OF INTEGER;
+
+     TYPE AA IS ACCESS ARR;
+
+     TYPE AONEDIM IS ACCESS ONEDIM;
+
+     TYPE ENUM IS (ONE, TWO, THREE);
+
+     TASK TYPE T IS
+          ENTRY HERE(VAL : IN OUT INTEGER);
+     END T;
+
+     TYPE ATASK IS ACCESS T;
+
+     TYPE ANOTHERTASK IS ACCESS T;
+     FOR ANOTHERTASK'STORAGE_SIZE USE 2 * TASK_STORAGE_SIZE;
+
+     TASK TYPE T1 IS
+          ENTRY HERE1(ENUM)(VAL1 : IN OUT INTEGER);
+     END T1;
+
+     TYPE ATASK1 IS ACCESS T1;
+
+     TASK BODY T IS
+     BEGIN
+          ACCEPT HERE(VAL : IN OUT INTEGER) DO
+               VAL := VAL * 2;
+          END HERE;
+     END T;
+
+     TASK BODY T1 IS
+     BEGIN
+          SELECT
+               ACCEPT HERE1(ONE)(VAL1 : IN OUT INTEGER) DO
+                    VAL1 := VAL1 * 1;
+               END HERE1;
+          OR
+               ACCEPT HERE1(TWO)(VAL1 : IN OUT INTEGER) DO
+                    VAL1 := VAL1 * 2;
+               END HERE1;
+          OR
+               ACCEPT HERE1(THREE)(VAL1 : IN OUT INTEGER) DO
+                    VAL1 := VAL1 * 3;
+               END HERE1;
+          END SELECT;
+     END T1;
+
+     GENERIC
+          TYPE FORM IS (<>);
+          TYPE ACCFORM IS ACCESS FORM;
+          TYPE ACC IS ACCESS INTEGER;
+          TYPE ACCREC IS ACCESS REC;
+          TYPE ACCDISCREC IS ACCESS DISCREC;
+          TYPE ACCARR IS ACCESS ARR;
+          TYPE ACCONE IS ACCESS ONEDIM;
+          TYPE ACCTASK IS ACCESS T;
+          TYPE ACCTASK1 IS ACCESS T1;
+          TYPE ANOTHERTASK1 IS ACCESS T;
+     PACKAGE P IS
+     END P;
+
+     PACKAGE BODY P IS
+          AF : ACCFORM;
+          TYPE DER_ACC IS NEW ACC;
+          A, B : ACC;
+          DERA : DER_ACC;
+          R : ACCREC;
+          DR : ACCDISCREC;
+          C : ACCARR;
+          D, E : ACCONE;
+          F : ACCTASK;
+          G : ACCTASK1;
+          INT : INTEGER := 5;
+
+     BEGIN
+          TEST ("CC1225A", "CHECK, FOR A FORMAL ACCESS TYPE, THAT " &
+                           "ALL ALLOWABLE OPERATIONS ARE IMPLICITLY " &
+                           "DECLARED");
+
+          IF AF'ADDRESS NOT IN ADDRESS THEN
+               FAILED ("IMPROPER RESULT FROM AF'ADDRESS TEST");
+          END IF;
+
+          DECLARE
+               AF_SIZE : INTEGER := ACCFORM'SIZE;
+          BEGIN
+               IF AF_SIZE NOT IN INTEGER THEN
+                    FAILED ("IMPROPER RESULT FROM AF'SIZE");
+               END IF;
+          END;
+
+          IF ANOTHERTASK1'STORAGE_SIZE < TASK_STORAGE_SIZE THEN
+               FAILED ("IMPROPER VALUE FOR ANOTHERTASK1'STORAGE_SIZE");
+          END IF;
+
+          B := NEW INTEGER'(25);
+
+          A := B;
+
+          IF A.ALL /= 25 THEN
+               FAILED ("IMPROPER VALUE FOR ASSIGNMENT OF VARIABLE " &
+                       "OF A FORMAL ACCESS TYPE FROM ANOTHER " &
+                       "VARIABLE OF A FORMAL ACCESS TYPE");
+          END IF;
+
+          A := NEW INTEGER'(10);
+
+          IF A.ALL /= 10 THEN
+               FAILED ("IMPROPER VALUE FOR VARIABLE OF FORMAL ACCESS " &
+                       "TYPE");
+          END IF;
+
+          IF A NOT IN ACC THEN
+               FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+          END IF;
+
+          B := ACC'(A);
+
+          IF B.ALL /= 10 THEN
+               FAILED ("IMPROPER VALUE FROM QUALIFICATION");
+          END IF;
+
+          DERA := NEW INTEGER'(10);
+          A := ACC(DERA);
+
+          IF A.ALL /= IDENT_INT(10) THEN
+               FAILED ("IMPROPER VALUE FROM EXPLICIT CONVERSION");
+          END IF;
+
+          IF A.ALL > IDENT_INT(10) THEN
+               FAILED ("IMPROPER VALUE USED IN LESS THAN");
+          END IF;
+
+          IF A.ALL < IDENT_INT(10) THEN
+               FAILED ("IMPROPER VALUE USED IN GREATER THAN");
+          END IF;
+
+          IF A.ALL >= IDENT_INT(11) THEN
+               FAILED ("IMPROPER VALUE USED IN LESS THAN OR EQUAL");
+          END IF;
+
+          IF A.ALL <= IDENT_INT(9) THEN
+               FAILED ("IMPROPER VALUE USED IN GREATER THAN OR EQUAL");
+          END IF;
+
+          IF NOT (A.ALL + A.ALL = IDENT_INT(20)) THEN
+               FAILED ("IMPROPER VALUE FROM ADDITION");
+          END IF;
+
+          IF NOT (A.ALL - IDENT_INT(2) = IDENT_INT(8)) THEN
+               FAILED ("IMPROPER VALUE FROM SUBTRACTION");
+          END IF;
+
+          IF NOT (A.ALL * IDENT_INT(3) = IDENT_INT(30)) THEN
+               FAILED ("IMPROPER VALUE FROM MULTIPLICATION");
+          END IF;
+
+          IF NOT (A.ALL / IDENT_INT(3) = IDENT_INT(3)) THEN
+               FAILED ("IMPROPER VALUE FROM DIVISION");
+          END IF;
+
+          IF NOT (A.ALL MOD IDENT_INT(3) = IDENT_INT(1)) THEN
+               FAILED ("IMPROPER VALUE FROM MODULO");
+          END IF;
+
+          IF NOT (A.ALL REM IDENT_INT(7) = IDENT_INT(3)) THEN
+               FAILED ("IMPROPER VALUE FROM REMAINDER");
+          END IF;
+
+          IF NOT (A.ALL ** IDENT_INT(2) = IDENT_INT(100)) THEN
+               FAILED ("IMPROPER VALUE FROM EXPONENTIATION");
+          END IF;
+
+          IF NOT (+A.ALL = IDENT_INT(10)) THEN
+               FAILED ("IMPROPER VALUE FROM IDENTITY");
+          END IF;
+
+          IF NOT (-A.ALL = IDENT_INT(-10)) THEN
+               FAILED ("IMPROPER VALUE FROM NEGATION");
+          END IF;
+
+          A := NULL;
+
+          IF A /= NULL THEN
+               FAILED ("IMPROPER VALUE FROM ACCESS SET TO NULL");
+          END IF;
+
+          IF A'ADDRESS NOT IN ADDRESS THEN
+               FAILED ("IMPROPER RESULT FROM A'ADDRESS TEST");
+          END IF;
+
+
+          DECLARE
+               ACC_SIZE : INTEGER := ACC'SIZE;
+          BEGIN
+               IF ACC_SIZE NOT IN INTEGER THEN
+                    FAILED ("IMPROPER RESULT FROM ACC'SIZE");
+               END IF;
+          END;
+
+          R := NEW REC'(COMP => 5);
+
+          IF NOT EQUAL(R.COMP,5) THEN
+               FAILED ("IMPROPER VALUE FOR RECORD COMPONENT");
+          END IF;
+
+          DR := NEW DISCREC'(DISC => 1, COMPD => 5);
+
+          IF NOT EQUAL(DR.DISC,1) OR NOT EQUAL(DR.COMPD,5) THEN
+               FAILED ("IMPROPER VALUES FOR DISCRIMINATED RECORD " &
+                       "COMPONENTS");
+          END IF;
+
+          C := NEW ARR'(1 => (1,2), 2 => (3,4));
+
+          IF C(1,1) /= 1 OR C(1,2) /= 2 OR C(2,1) /= 3 OR C(2,2) /= 4
+               THEN FAILED ("IMPROPER ARRAY COMPONENT VALUES");
+          END IF;
+
+          D := NEW ONEDIM'(1,2,3,4,5,6,7,8,9,10);
+          E := NEW ONEDIM'(10,9,8,7,6,5,4,3,2,1);
+
+          D(1..5) := E(1..5);
+
+          IF D(1) /= 10 OR D(2) /= 9 OR D(3) /= 8
+               OR D(4) /= 7 OR D(5) /= 6 THEN
+               FAILED ("IMPROPER RESULTS FROM SLICE ASSIGNMENT");
+          END IF;
+
+          IF C'FIRST /= 1 OR C'FIRST(2) /= 1 THEN
+               FAILED ("IMPROPER LOWER BOUNDS FOR CONSTRAINED ARRAY");
+          END IF;
+
+          IF C'LAST /= 2 OR C'LAST(2) /= 2 THEN
+               FAILED ("IMPROPER UPPER BOUNDS FOR CONSTRAINED ARRAY");
+          END IF;
+
+          IF 1 NOT IN C'RANGE THEN
+               FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 1");
+          END IF;
+
+          IF 1 NOT IN C'RANGE(2) THEN
+               FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 2");
+          END IF;
+
+          IF C'LENGTH /= 2 THEN
+               FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " &
+                       "ARRAY - 1");
+          END IF;
+
+          IF C'LENGTH(2) /= 2 THEN
+               FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " &
+                       "ARRAY - 2");
+          END IF;
+
+          F := NEW T;
+
+          F.HERE(INT);
+
+          IF NOT EQUAL(INT,IDENT_INT(10)) THEN
+               FAILED ("IMPROPER RESULTS FROM ENTRY SELECTION");
+          END IF;
+
+          G := NEW T1;
+
+          G.HERE1(TWO)(INT);
+
+          IF NOT EQUAL(INT,IDENT_INT(20)) THEN
+               FAILED ("IMPROPER RESULTS FROM FAMILY ENTRY SELECTION");
+          END IF;
+
+          RESULT;
+     END P;
+
+     PACKAGE PACK IS NEW P(INTEGER,ACCINTEGER,AI,AREC,ADISCREC,
+                           AA,AONEDIM,ATASK,ATASK1,ANOTHERTASK);
+
+BEGIN
+     NULL;
+END CC1225A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1226b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1226b.ada
new file mode 100644
index 000000000..c127dc15b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1226b.ada
@@ -0,0 +1,176 @@
+-- CC1226B.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, FOR A FORMAL NONLIMITED PRIVATE TYPE, THAT ALL ALLOWABLE
+--     OPERATIONS ARE IMPLICITLY DECLARED.
+
+-- HISTORY:
+--     BCB 04/04/88  CREATED ORIGINAL TEST.
+--     RJW 03/28/90  INITIALIZED PREVIOUSLY UNINITIALIZED VARIABLES.
+--     LDC 09/19/90  INITALIZED NLPVAR & NLPVAR2 TO DIFFERENT VALUES,
+--                   REMOVED USE CLAUSE.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+
+PROCEDURE CC1226B IS
+
+     TYPE DISCREC(DISC1 : INTEGER := 1;
+                  DISC2 : BOOLEAN := FALSE) IS RECORD
+          NULL;
+     END RECORD;
+
+     GENERIC
+          TYPE NLP IS PRIVATE;
+          TYPE NLPDISC(DISC1 : INTEGER;
+                       DISC2 : BOOLEAN) IS PRIVATE;
+          WITH PROCEDURE INITIALIZE (N : OUT NLPDISC);
+          WITH FUNCTION INITIALIZE RETURN NLP;
+          WITH FUNCTION INITIALIZE_2 RETURN NLP;
+     PACKAGE P IS
+          FUNCTION IDENT(X : NLP) RETURN NLP;
+          FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS;
+     END P;
+
+     PACKAGE BODY P IS
+          TYPE DER_NLP IS NEW NLP;
+          NLPVAR : NLP := INITIALIZE_2;
+          NLPVAR2, NLPVAR3 : NLP := INITIALIZE;
+          DERNLP : DER_NLP := DER_NLP (INITIALIZE);
+          NDVAR : NLPDISC(DISC1 => 5, DISC2 => TRUE);
+          NLPVARADDRESS : ADDRESS;
+          NLPSIZE : INTEGER;
+          NLPBASESIZE : INTEGER;
+
+          FUNCTION IDENT(X : NLP) RETURN NLP IS
+               Z : NLP := INITIALIZE;
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN X;
+               END IF;
+               RETURN Z;
+          END IDENT;
+
+          FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS IS
+               I : INTEGER;
+               Z : ADDRESS := I'ADDRESS;
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN Y;
+               END IF;
+               RETURN Z;
+          END IDENT_ADR;
+
+     BEGIN
+          TEST ("CC1226B", "CHECK, FOR A FORMAL NONLIMITED PRIVATE " &
+                           "TYPE THAT ALL ALLOWABLE OPERATIONS ARE " &
+                           "IMPLICITLY DECLARED");
+
+          INITIALIZE (NDVAR);
+
+          NLPVAR := NLPVAR2;
+
+          IF NLPVAR /= NLPVAR2 THEN
+               FAILED ("IMPROPER VALUE FROM ASSIGNMENT");
+          END IF;
+
+          IF NLPVAR NOT IN NLP THEN
+               FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+          END IF;
+
+          NLPVAR := NLP'(NLPVAR2);
+
+          IF NLPVAR /= NLPVAR2 THEN
+               FAILED ("IMPROPER RESULT FROM QUALIFICATION");
+          END IF;
+
+          NLPVAR := NLP(DERNLP);
+
+          IF NLPVAR /= IDENT(NLP(DERNLP)) THEN
+               FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION");
+          END IF;
+
+          NLPSIZE := IDENT_INT(NLP'SIZE);
+
+          IF NLPSIZE /= INTEGER(NLP'SIZE) THEN
+               FAILED ("IMPROPER VALUE FOR NLP'SIZE");
+          END IF;
+
+          NLPVARADDRESS := NLPVAR'ADDRESS;
+
+          IF NLPVAR'ADDRESS /= IDENT_ADR(NLPVARADDRESS) THEN
+               FAILED ("IMPROPER VALUE FOR NLPVAR'ADDRESS");
+          END IF;
+
+          IF NDVAR.DISC1 /= IDENT_INT(5) THEN
+               FAILED ("IMPROPER DISCRIMINANT VALUE - 1");
+          END IF;
+
+          IF NOT NDVAR.DISC2 THEN
+               FAILED ("IMPROPER DISCRIMINANT VALUE - 2");
+          END IF;
+
+          IF NOT NDVAR'CONSTRAINED THEN
+               FAILED ("IMPROPER VALUE FOR NDVAR'CONSTRAINED");
+          END IF;
+
+          NLPVAR := NLPVAR3;
+
+          IF NOT (NLPVAR = IDENT(NLPVAR3)) THEN
+               FAILED ("IMPROPER VALUE FROM EQUALITY OPERATION");
+          END IF;
+
+          IF NLPVAR /= IDENT(NLPVAR3) THEN
+               FAILED ("IMPROPER VALUE FROM INEQUALITY OPERATION");
+          END IF;
+
+          RESULT;
+     END P;
+
+     PROCEDURE INITIALIZE (I : OUT DISCREC) IS
+     BEGIN
+          I := (5, TRUE);
+     END INITIALIZE;
+
+     FUNCTION INITIALIZE RETURN INTEGER IS
+     BEGIN
+          RETURN 5;
+     END INITIALIZE;
+
+     FUNCTION INITIALIZE_OTHER RETURN INTEGER IS
+     BEGIN
+          RETURN 3;
+     END INITIALIZE_OTHER;
+
+     PACKAGE PACK IS NEW P(INTEGER, 
+                           DISCREC, 
+                           INITIALIZE, 
+                           INITIALIZE, 
+                           INITIALIZE_OTHER);
+
+BEGIN
+     NULL;
+END CC1226B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1227a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1227a.ada
new file mode 100644
index 000000000..39b453287
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1227a.ada
@@ -0,0 +1,289 @@
+-- CC1227A.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, WHEN DERIVING FROM A FORMAL TYPE, THAT ALL THE PREDEFINED
+--     OPERATIONS ASSOCIATED WITH THE CLASS OF THE FORMAL TYPE ARE
+--     DECLARED FOR THE DERIVED TYPE.
+
+-- HISTORY:
+--     BCB 04/04/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+
+PROCEDURE CC1227A IS
+
+     GENERIC
+          TYPE FORM IS RANGE <>;
+     PACKAGE P IS
+          TYPE DER_FORM IS NEW FORM;
+          FUNCTION IDENT_DER(X : DER_FORM) RETURN DER_FORM;
+          FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS;
+     END P;
+
+     PACKAGE BODY P IS
+          DER_VAR : DER_FORM;
+          DER_FORM_BASE_FIRST : DER_FORM;
+          DER_FORM_FIRST : DER_FORM;
+          DER_FORM_LAST : DER_FORM;
+          DER_FORM_SIZE : DER_FORM;
+          DER_FORM_WIDTH : DER_FORM;
+          DER_FORM_POS : DER_FORM;
+          DER_FORM_VAL : DER_FORM;
+          DER_FORM_SUCC : DER_FORM;
+          DER_FORM_PRED : DER_FORM;
+          DER_FORM_IMAGE : STRING(1..5);
+          DER_FORM_VALUE : DER_FORM;
+          DER_VAR_SIZE : DER_FORM;
+          DER_VAR_ADDRESS : ADDRESS;
+          DER_EQUAL, DER_UNEQUAL : DER_FORM;
+          DER_GREATER : DER_FORM;
+          DER_MOD, DER_REM : DER_FORM;
+          DER_ABS, DER_EXP : DER_FORM;
+          INT : INTEGER := 5;
+          FUNCTION IDENT_DER(X : DER_FORM) RETURN DER_FORM IS
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN X;
+               END IF;
+               RETURN 0;
+          END IDENT_DER;
+          FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS IS
+               X : DER_FORM;
+          BEGIN
+               IF EQUAL(3,3) THEN
+                    RETURN Y;
+               END IF;
+               RETURN X'ADDRESS;
+          END IDENT_ADR;
+     BEGIN
+          TEST ("CC1227A", "CHECK, WHEN DERIVING FROM A FORMAL TYPE, " &
+                           "THAT ALL THE PREDEFINED OPERATIONS " &
+                           "ASSOCIATED WITH THE CLASS OF THE FORMAL " &
+                           "TYPE ARE DECLARED FOR THE DERIVED TYPE");
+
+          DER_VAR := IDENT_DER(1);
+
+          IF DER_VAR /= 1 THEN
+               FAILED ("IMPROPER VALUE FROM ASSIGNMENT OPERATION");
+          END IF;
+
+          IF DER_VAR NOT IN DER_FORM THEN
+               FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+          END IF;
+
+          DER_VAR := DER_FORM'(2);
+
+          IF DER_VAR /= IDENT_DER(2) THEN
+               FAILED ("IMPROPER RESULT FROM QUALIFICATION");
+          END IF;
+
+          DER_VAR := DER_FORM(INT);
+
+          IF DER_VAR /= IDENT_DER(5) THEN
+               FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION - " &
+                       "INTEGER");
+          END IF;
+
+          DER_VAR := DER_FORM(3.0);
+
+          IF DER_VAR /= IDENT_DER(3) THEN
+               FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION - " &
+                        "FLOAT");
+          END IF;
+
+          DER_VAR := 1_000;
+
+          IF DER_VAR /= IDENT_DER(1000) THEN
+               FAILED ("IMPROPER RESULT FROM IMPLICIT CONVERSION");
+          END IF;
+
+          DER_FORM_BASE_FIRST := DER_FORM'BASE'FIRST;
+
+          DER_FORM_FIRST := DER_FORM'FIRST;
+
+          IF DER_FORM_BASE_FIRST /= IDENT_DER(DER_FORM_FIRST) THEN
+               FAILED ("IMPROPER VALUE FOR DER_FORM'BASE'FIRST");
+          END IF;
+
+          IF DER_FORM_FIRST /= IDENT_DER(DER_FORM'FIRST) THEN
+               FAILED ("IMPROPER VALUE FOR DER_FORM'FIRST");
+          END IF;
+
+          DER_FORM_LAST := DER_FORM'LAST;
+
+          IF DER_FORM_LAST /= IDENT_DER(DER_FORM'LAST) THEN
+               FAILED ("IMPROPER VALUE FOR DER_FORM'LAST");
+          END IF;
+
+          DER_FORM_SIZE := DER_FORM(DER_FORM'SIZE);
+
+          IF DER_FORM_SIZE /= IDENT_DER(DER_FORM(DER_FORM'SIZE)) THEN
+               FAILED ("IMPROPER VALUE FOR DER_FORM'SIZE");
+          END IF;
+
+          DER_FORM_WIDTH := DER_FORM(DER_FORM'WIDTH);
+
+          IF DER_FORM_WIDTH /= IDENT_DER(DER_FORM(DER_FORM'WIDTH)) THEN
+               FAILED ("IMPROPER VALUE FOR DER_FORM'WIDTH");
+          END IF;
+
+          DER_FORM_POS := DER_FORM(DER_FORM'POS(DER_VAR));
+
+          IF DER_FORM_POS /= IDENT_DER(DER_FORM(DER_FORM'POS(DER_VAR)))
+               THEN FAILED ("IMPROPER VALUE FOR DER_FORM'POS(DER_VAR)");
+          END IF;
+
+          DER_FORM_VAL := DER_FORM'VAL(DER_VAR);
+
+          IF DER_FORM_VAL /= IDENT_DER(DER_FORM'VAL(DER_VAR)) THEN
+               FAILED ("IMPROPER VALUE FOR DER_FORM'VAL(DER_VAR)");
+          END IF;
+
+          DER_FORM_SUCC := DER_FORM'SUCC(DER_VAR);
+
+          IF DER_FORM_SUCC /= IDENT_DER(DER_FORM'SUCC(DER_VAR)) THEN
+               FAILED ("IMPROPER VALUE FOR DER_FORM'SUCC(DER_VAR)");
+          END IF;
+
+          DER_FORM_PRED := DER_FORM'PRED(DER_VAR);
+
+          IF DER_FORM_PRED /= IDENT_DER(DER_FORM'PRED(DER_VAR)) THEN
+               FAILED ("IMPROPER VALUE FOR DER_FORM'PRED(DER_VAR)");
+          END IF;
+
+          DER_FORM_IMAGE := DER_FORM'IMAGE(DER_VAR);
+
+          IF DER_FORM_IMAGE(2..5) /= "1000" THEN
+               FAILED ("IMPROPER VALUE FOR DER_FORM'IMAGE(DER_VAR)");
+          END IF;
+
+          DER_FORM_VALUE := DER_FORM'VALUE(DER_FORM_IMAGE);
+
+          IF DER_FORM_VALUE /= IDENT_DER(1000) THEN
+               FAILED ("IMPROPER VALUE FOR DER_FORM'VALUE" &
+                       "(DER_FORM_IMAGE)");
+          END IF;
+
+          DER_VAR_SIZE := DER_FORM(DER_VAR'SIZE);
+
+          IF DER_VAR_SIZE /= IDENT_DER(DER_FORM(DER_VAR'SIZE)) THEN
+               FAILED ("IMPROPER VALUE FOR DER_VAR'SIZE");
+          END IF;
+
+          DER_VAR_ADDRESS := DER_VAR'ADDRESS;
+
+          IF DER_VAR_ADDRESS /= IDENT_ADR(DER_VAR'ADDRESS) THEN
+               FAILED ("IMPROPER VALUE FOR DER_VAR'ADDRESS");
+          END IF;
+
+          DER_EQUAL := IDENT_DER(1000);
+
+          IF DER_VAR /= DER_EQUAL THEN
+               FAILED ("IMPROPER RESULT FROM INEQUALITY OPERATOR");
+          END IF;
+
+          DER_UNEQUAL := IDENT_DER(500);
+
+          IF DER_VAR = DER_UNEQUAL THEN
+               FAILED ("IMPROPER RESULT FROM EQUALITY OPERATOR");
+          END IF;
+
+          IF DER_VAR < DER_UNEQUAL THEN
+               FAILED ("IMPROPER RESULT FROM LESS THAN OPERATOR");
+          END IF;
+
+          IF DER_VAR <= DER_UNEQUAL THEN
+               FAILED ("IMPROPER RESULT FROM LESS THAN OR EQUAL TO " &
+                       "OPERATOR");
+          END IF;
+
+          DER_GREATER := IDENT_DER(1500);
+
+          IF DER_VAR > DER_GREATER THEN
+               FAILED ("IMPROPER RESULT FROM GREATER THAN OPERATOR");
+          END IF;
+
+          IF DER_VAR >= DER_GREATER THEN
+               FAILED ("IMPROPER RESULT FROM GREATER THAN OR EQUAL " &
+                       "TO OPERATOR");
+          END IF;
+
+          DER_VAR := DER_VAR + DER_EQUAL;
+
+          IF DER_VAR /= IDENT_DER(2000) THEN
+               FAILED ("IMPROPER RESULT FROM ADDITION OPERATOR");
+          END IF;
+
+          DER_VAR := DER_VAR - DER_EQUAL;
+
+          IF DER_VAR /= IDENT_DER(1000) THEN
+               FAILED ("IMPROPER RESULT FROM SUBTRACTION OPERATOR");
+          END IF;
+
+          DER_VAR := DER_VAR * IDENT_DER(2);
+
+          IF DER_VAR /= IDENT_DER(2000) THEN
+               FAILED ("IMPROPER RESULT FROM MULTIPLICATION OPERATOR");
+          END IF;
+
+          DER_VAR := DER_VAR / IDENT_DER(2);
+
+          IF DER_VAR /= IDENT_DER(1000) THEN
+               FAILED ("IMPROPER RESULT FROM DIVISION OPERATOR");
+          END IF;
+
+          DER_MOD := DER_GREATER MOD DER_VAR;
+
+          IF DER_MOD /= IDENT_DER(500) THEN
+               FAILED ("IMPROPER RESULT FROM MOD OPERATOR");
+          END IF;
+
+          DER_REM := DER_GREATER REM DER_VAR;
+
+          IF DER_REM /= IDENT_DER(500) THEN
+               FAILED ("IMPROPER RESULT FROM REM OPERATOR");
+          END IF;
+
+          DER_ABS := ABS(IDENT_DER(-1500));
+
+          IF DER_ABS /= IDENT_DER(DER_GREATER) THEN
+               FAILED ("IMPROPER RESULT FROM ABS OPERATOR");
+          END IF;
+
+          DER_EXP := IDENT_DER(2) ** IDENT_INT(2);
+
+          IF DER_EXP /= IDENT_DER(4) THEN
+               FAILED ("IMPROPER RESULT FROM EXPONENTIATION OPERATOR");
+          END IF;
+
+          RESULT;
+     END P;
+
+     PACKAGE PACK IS NEW P(INTEGER);
+
+BEGIN
+     NULL;
+END CC1227A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1301a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1301a.ada
new file mode 100644
index 000000000..92c94d033
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1301a.ada
@@ -0,0 +1,164 @@
+-- CC1301A.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 GENERIC SUBPROGRAM PARAMETERS WORK CORRECTLY,
+-- INCLUDING OVERLOADED AND PREDEFINED OPERATOR_SYMBOLS,
+-- AND SUBPROGRAMS HIDDEN AT THE INSTANTIATION.
+-- BOTH KINDS OF DEFAULTS ARE TESTED, FOR BOTH PROCEDURES
+-- AND FUNCTIONS.
+
+-- DAT 8/14/81
+-- JBG 5/5/83
+-- JBG 8/3/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1301A IS
+
+     FUNCTION "-" (R, S : INTEGER) RETURN INTEGER;
+
+     FUNCTION NEXT (X : INTEGER) RETURN INTEGER;
+
+     PROCEDURE BUMP (X : IN OUT INTEGER);
+
+     GENERIC
+          WITH FUNCTION "*" (A, B : INTEGER) RETURN INTEGER IS "-";
+          WITH FUNCTION "+" (R, S: INTEGER) RETURN INTEGER IS 
+                                                       STANDARD."+";
+          WITH FUNCTION "-" (A, B : INTEGER) RETURN INTEGER IS <> ;
+          WITH FUNCTION NEXTO (Q : INTEGER) RETURN INTEGER IS NEXT ;
+          WITH PROCEDURE BUMPO (A : IN OUT INTEGER) IS BUMP;
+          WITH FUNCTION NEXT (Q : INTEGER) RETURN INTEGER  IS <> ;
+          WITH PROCEDURE BUMP (Q : IN OUT INTEGER) IS <> ;
+          TYPE INTEGER IS RANGE <> ;
+          WITH FUNCTION "*" (A , B : INTEGER) RETURN INTEGER IS <> ;
+          WITH FUNCTION "-" (A, B : INTEGER) RETURN INTEGER IS <> ;
+          WITH FUNCTION NEXT (Q : INTEGER) RETURN INTEGER IS <> ;
+          WITH PROCEDURE BUMP (Z : IN OUT INTEGER) IS <> ;
+     PACKAGE PKG IS
+          SUBTYPE INT IS STANDARD.INTEGER;
+          DIFF : INT := -999;
+     END PKG;
+
+     TYPE NEWINT IS NEW INTEGER RANGE -1000 .. 1000;
+
+     FUNCTION PLUS (Q1, Q2 : INTEGER) RETURN INTEGER RENAMES "+";
+
+     FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN PLUS (X, PLUS (Y, -10));
+          -- (X + Y - 10)
+     END "+";
+
+     FUNCTION "-" (R, S : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN - R + S;
+          -- (-R + S - 10)
+     END "-";
+
+     FUNCTION NEXT (X : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN X + 1;
+          -- (X + 1 - 10)
+          -- (X - 9)
+     END NEXT;
+
+     PROCEDURE BUMP (X : IN OUT INTEGER) IS
+     BEGIN
+          X := NEXT (X);
+          -- (X := X - 9)
+     END BUMP;
+
+     PACKAGE BODY PKG IS
+          W : INTEGER;
+          WI : INT;
+     BEGIN
+          W := NEXT (INTEGER'(3) * 4 - 2);
+          -- (W := (4 ** 3 - 2) - 1)
+          -- (W := 61)
+          BUMP (W);
+          -- (W := 61 + 7)
+          -- (W := 68)
+          WI := NEXT (INT'(3) * 4 - 2 + NEXTO (0));
+          -- (3 * 4) => (3 - 4) => (-3 + 4 - 10) = -9
+          -- ((-9) - 2) => (2 + 2 - (-9) - 20) = -7
+          -- (-7 + (-9)) => -16
+          -- (WI := 7 - (-16)) => (WI := 23)
+          BUMPO (WI);
+          -- (WI := 23 - 9) (= 14)
+          BUMP (WI);
+          -- (WI := 14 - 9) (= 5)
+          DIFF := STANDARD."-" (INT(W), WI);
+          -- (DIFF := 68 - 5) (= 63)
+     END PKG;
+
+     FUNCTION "*" (Y, X : NEWINT) RETURN NEWINT IS
+     BEGIN
+          RETURN X ** INTEGER(Y);
+          -- (X,Y) (Y ** X)
+     END "*";
+
+     FUNCTION NEXT (Z : NEWINT) RETURN NEWINT IS
+     BEGIN
+          RETURN Z - 1;
+          -- (Z - 1)
+     END NEXT;
+
+     PROCEDURE BUMP (ZZ : IN OUT NEWINT) IS
+     BEGIN
+          FAILED ("WRONG PROCEDURE CALLED");
+     END BUMP;
+BEGIN
+     TEST ("CC1301A", "DEFAULT GENERIC SUBPROGRAM PARAMETERS");
+
+     DECLARE
+          PROCEDURE BUMP (QQQ : IN OUT NEWINT) IS
+          BEGIN
+               QQQ := QQQ + 7;
+               -- (QQQ + 7)
+          END BUMP;
+
+          FUNCTION NEXT (Q7 : INTEGER) RETURN INTEGER IS
+          BEGIN
+               RETURN Q7 - 17;
+               -- (-Q7 + 17 - 10)
+               -- (7 - Q7)
+          END NEXT;
+
+          FUNCTION "-" (Q3, Q4 : INTEGER) RETURN INTEGER IS
+          BEGIN
+               RETURN -Q3 + Q4 + Q4;
+               -- (-Q3 + Q4 - 10 + Q4 - 10) = (Q4 + Q4 - Q3 - 20)
+          END "-";
+
+          PACKAGE P1 IS NEW PKG (INTEGER => NEWINT);
+
+     BEGIN
+          IF P1.DIFF /= 63 THEN
+               FAILED ("WRONG DEFAULT SUBPROGRAM PARAMETERS");
+          END IF;
+     END;
+
+     RESULT;
+END CC1301A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1302a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1302a.ada
new file mode 100644
index 000000000..c61a310d5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1302a.ada
@@ -0,0 +1,174 @@
+-- CC1302A.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 GENERIC DEFAULT SUBPROGRAM PARAMETERS MAY BE ATTRIBUTES
+-- OF TYPES, INCLUDING GENERIC FORMAL TYPES IN SAME GENERIC PART,
+-- OR IN GENERIC PART OF ENCLOSING UNIT.
+
+-- DAT 8/27/81
+-- SPS 2/9/83
+-- JBG 2/15/83
+-- JBG 4/29/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1302A IS
+BEGIN
+     TEST ("CC1302A", "GENERIC DEFAULT SUBPROGRAMS MAY BE"
+          & " FUNCTION ATTRIBUTES OF TYPES");
+
+     DECLARE
+          GENERIC 
+               TYPE T IS ( <> );
+               T_LAST : T;
+               WITH FUNCTION SUCC (X : T) RETURN T IS T'SUCC;
+          PACKAGE PK1 IS
+          END PK1;
+
+          SUBTYPE CH IS CHARACTER RANGE CHARACTER'FIRST .. '~';
+          SUBTYPE BL IS BOOLEAN RANGE FALSE .. FALSE;
+          SUBTYPE INT IS INTEGER RANGE -10 .. 10;
+
+          PACKAGE BODY PK1 IS
+               GENERIC 
+                    TYPE TT IS ( <> );
+                    TT_LAST : TT;
+                    WITH FUNCTION PRED (X : TT) RETURN TT IS TT'PRED;
+                    WITH FUNCTION IM(X : T) RETURN STRING IS T'IMAGE;
+                    WITH FUNCTION VAL(X : STRING) RETURN TT IS TT'VALUE;
+               PACKAGE PK2 IS END PK2;
+
+               PACKAGE BODY PK2 IS
+               BEGIN
+
+-- CHECK THAT 'LAST GIVES RIGHT ANSWER
+                    IF T'LAST /= T_LAST THEN
+                         FAILED ("T'LAST INCORRECT");
+                    END IF;
+
+                    IF TT'LAST /= TT_LAST THEN
+                         FAILED ("TT'LAST INCORRECT");
+                    END IF;
+
+-- CHECK SUCC FUNCTION
+                    BEGIN
+                         IF T'PRED(SUCC(T'LAST)) /= T'LAST THEN
+                              FAILED ("'PRED OR SUCC GIVES WRONG " &
+                                      "RESULT");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              FAILED ("SUCC HAS CONSTRAINTS OF " &
+                                      "SUBTYPE");
+                         WHEN OTHERS =>
+                              FAILED ("SOME EXCEPTION RAISED - 1");
+                    END;
+
+-- CHECK 'SUCC ATTRIBUTE
+                    BEGIN
+                         IF T'PRED(T'SUCC(T'LAST)) /= T'LAST THEN
+                              FAILED ("'PRED OR 'SUCC GIVES WRONG " &
+                                      "RESULT");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              FAILED ("'PRED OR 'SUCC HAS CONSTRAINTS "&
+                                      "OF SUBTYPE");
+                         WHEN OTHERS =>
+                              FAILED ("SOME EXCEPTION RAISED - 2");
+                    END;
+
+-- CHECK VAL ATTRIBUTE
+                    BEGIN
+                         IF T'VAL(T'POS(T'SUCC(T'LAST))) /=
+                            T'VAL(T'POS(T'LAST)+1) THEN
+                              FAILED ("VAL OR POS ATTRIBUTE HAS " &
+                                      "INCONSISTENT RESULTS");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              FAILED ("VAL OR POS ATTRIBUTE HAS " &
+                                      "CONSTRAINTS OF SUBTYPE");
+                         WHEN OTHERS =>
+                              FAILED ("SOME EXCEPTION RAISED - 4");
+                    END;
+
+-- CHECK VAL FUNCTION
+                    BEGIN
+                         IF TT'VAL(TT'POS(TT'SUCC(TT'LAST))) /= 
+                            TT'VAL(TT'POS(TT'LAST)+1) THEN
+                              FAILED ("VAL FUNCTION GIVES INCORRECT " &
+                                      "RESULTS");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              FAILED ("VAL FUNCTION HAS CONSTRAINTS " &
+                                      "OF SUBTYPE");
+                         WHEN OTHERS =>
+                              FAILED ("SOME EXCEPTION RAISED - 6");
+                    END;
+
+-- CHECK IM FUNCTION
+                    BEGIN
+                         IF T'IMAGE(T'SUCC(T'LAST)) /= 
+                              IM   (T'SUCC(T'LAST)) THEN
+                              FAILED ("IM FUNCTION GIVES INCORRECT " &
+                                      "RESULTS");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              FAILED ("IM FUNCTION HAS CONSTRAINTS " &
+                                      "OF SUBTYPE");
+                         WHEN OTHERS =>
+                              FAILED ("SOME EXCEPTION RAISED - 7");
+                    END;
+
+-- CHECK PRED FUNCTION
+                    BEGIN
+                         IF PRED(TT'SUCC(TT'LAST)) /= TT'LAST THEN
+                              FAILED ("PRED FUNCTION GIVES INCORRECT " &
+                                      "RESULTS");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              FAILED ("PRED FUNCTION HAS CONSTRAINTS " &
+                                      "OF SUBTYPE");
+                         WHEN OTHERS =>
+                              FAILED ("SOME EXCEPTION RAISED - 8");
+                    END;
+
+               END PK2;
+
+               PACKAGE PK3 IS NEW PK2 (T, T'LAST);
+          END PK1;
+
+          PACKAGE PKG1 IS NEW PK1 (CH, CH'LAST);
+          PACKAGE PKG2 IS NEW PK1 (BL, BL'LAST);
+          PACKAGE PKG3 IS NEW PK1 (INT, INT'LAST);
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC1302A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1304a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1304a.ada
new file mode 100644
index 000000000..2556c9d38
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1304a.ada
@@ -0,0 +1,122 @@
+-- CC1304A.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 GENERIC FORMAL SUBPROGRAMS MAY HAVE A PARAMETER
+-- OF A GENERIC FORMAL TYPE, AND MAY RETURN A GENERIC FORMAL
+-- TYPE.
+
+-- DAT 8/27/81
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1304A IS
+BEGIN
+     TEST ("CC1304A", "GENERIC FORMAL SUBPROGRAMS MAY HAVE PARAMETERS"
+          & " OF (AND RETURN) A FORMAL TYPE");
+
+     DECLARE
+          GENERIC
+               TYPE T IS ( <> );
+               WITH FUNCTION S (P : T) RETURN T;
+               WITH PROCEDURE P (P : T);
+          PROCEDURE PR (PARM : T);
+
+          PROCEDURE PR (PARM: T) IS
+          BEGIN
+               P(P=>S(P=>PARM));
+          END PR;
+     BEGIN
+          DECLARE
+               C : CHARACTER := 'A';
+               B : BOOLEAN := FALSE;
+               I : INTEGER := 5;
+               TYPE ENUM IS (E1, E2, E3);
+               E : ENUM := E2;
+
+               FUNCTION FC (P : CHARACTER) RETURN CHARACTER IS
+               BEGIN
+                    RETURN 'B';
+               END FC;
+
+               FUNCTION FB (P : BOOLEAN) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN NOT P;
+               END FB;
+     
+               FUNCTION FI (P : INTEGER) RETURN INTEGER IS
+               BEGIN
+                    RETURN P + 1;
+               END FI;
+
+               FUNCTION FE (P : ENUM) RETURN ENUM IS
+               BEGIN
+                    RETURN ENUM'SUCC (P);
+               END FE;
+
+               PROCEDURE  PC (P : CHARACTER) IS
+               BEGIN
+                    C := P;
+               END PC;
+
+               PROCEDURE PB (P : BOOLEAN) IS
+               BEGIN
+                    B := P;
+               END PB;
+
+               PROCEDURE PI (P : INTEGER) IS
+               BEGIN
+                   I := P;
+               END PI;
+ 
+               PROCEDURE PE (P : ENUM) IS
+               BEGIN
+                    E := P;
+               END PE;
+
+               PACKAGE PKG2 IS
+                    PROCEDURE P1 IS NEW PR (CHARACTER, FC, PC);
+                    PROCEDURE P2 IS NEW PR (BOOLEAN, FB, PB);
+                    PROCEDURE P3 IS NEW PR (INTEGER, FI, PI);
+                    PROCEDURE P4 IS NEW PR (ENUM, FE, PE);
+               END PKG2;
+
+               PACKAGE BODY PKG2 IS
+               BEGIN
+                    P1 (C);
+                    P2 (B);
+                    P3 (I);
+                    P4 (E);
+               END  PKG2;
+          BEGIN
+               IF C /= 'B'
+               OR B /= TRUE
+               OR I /= 6
+               OR E /= E3 THEN
+                    FAILED ("SUBPROGRAM PARAMETERS OF FORMAL TYPES");
+               END IF;
+          END;
+     END;
+     
+     RESULT;
+END CC1304A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1304b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1304b.ada
new file mode 100644
index 000000000..10086e829
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1304b.ada
@@ -0,0 +1,166 @@
+-- CC1304B.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 GENERIC FORMAL SUBPROGRAMS MAY HAVE A PARAMETER
+--     OF A GENERIC FORMAL TYPE, AND MAY RETURN A GENERIC FORMAL
+--     TYPE.  CHECK MODES IN OUT AND OUT.
+
+-- HISTORY:
+--     BCB 08/04/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1304B IS
+
+BEGIN
+     TEST ("CC1304B", "GENERIC FORMAL SUBPROGRAMS MAY HAVE A " &
+                      "PARAMETER OF A GENERIC FORMAL TYPE, AND MAY  " &
+                      "RETURN A GENERIC FORMAL TYPE.  CHECK MODES IN " &
+                      "OUT AND OUT");
+
+     DECLARE
+          GENERIC
+               TYPE T IS ( <> );
+               WITH PROCEDURE S (P : OUT T);
+               WITH PROCEDURE P (P : IN OUT T);
+               WITH FUNCTION L RETURN T;
+          PROCEDURE PR (PARM1, PARM2, PARM3 : IN OUT T);
+
+          PROCEDURE PR (PARM1, PARM2, PARM3 : IN OUT T) IS
+          BEGIN
+               S (P => PARM1);
+               P (P => PARM2);
+               PARM3 := L;
+          END PR;
+     BEGIN
+          DECLARE
+               C : CHARACTER := 'A';
+               C1 : CHARACTER := 'Y';
+               C2 : CHARACTER := 'I';
+               B : BOOLEAN := FALSE;
+               B1 : BOOLEAN := TRUE;
+               B2 : BOOLEAN := FALSE;
+               I : INTEGER := 5;
+               I1 : INTEGER := 10;
+               I2 : INTEGER := 0;
+               TYPE ENUM IS (E1, E2, E3);
+               F : ENUM := E2;
+               F1 : ENUM := E1;
+               F2 : ENUM := E2;
+
+               PROCEDURE FC (P : OUT CHARACTER) IS
+               BEGIN
+                    P := 'B';
+               END FC;
+
+               PROCEDURE FB (P : OUT BOOLEAN) IS
+               BEGIN
+                    P := NOT B;
+               END FB;
+
+               PROCEDURE FI (P : OUT INTEGER) IS
+               BEGIN
+                    P :=  I + 1;
+               END FI;
+
+               PROCEDURE FE (P : OUT ENUM) IS
+               BEGIN
+                    P := ENUM'SUCC (F);
+               END FE;
+
+               PROCEDURE  PC (P : IN OUT CHARACTER) IS
+               BEGIN
+                    P := 'Z';
+               END PC;
+
+               PROCEDURE PB (P : IN OUT BOOLEAN) IS
+               BEGIN
+                    P := NOT B1;
+               END PB;
+
+               PROCEDURE PI (P : IN OUT INTEGER) IS
+               BEGIN
+                   P := I1 + 1;
+               END PI;
+
+               PROCEDURE PE (P : IN OUT ENUM) IS
+               BEGIN
+                    P := ENUM'SUCC (F1);
+               END PE;
+
+               FUNCTION LC RETURN CHARACTER IS
+               BEGIN
+                    RETURN 'J';
+               END LC;
+
+               FUNCTION LB RETURN BOOLEAN IS
+               BEGIN
+                    RETURN TRUE;
+               END LB;
+
+               FUNCTION LI RETURN INTEGER IS
+               BEGIN
+                    RETURN IDENT_INT(5);
+               END LI;
+
+               FUNCTION LE RETURN ENUM IS
+               BEGIN
+                    RETURN ENUM'SUCC(F2);
+               END LE;
+
+               PACKAGE PKG2 IS
+                    PROCEDURE P1 IS NEW PR (CHARACTER, FC, PC, LC);
+                    PROCEDURE P2 IS NEW PR (BOOLEAN, FB, PB, LB);
+                    PROCEDURE P3 IS NEW PR (INTEGER, FI, PI, LI);
+                    PROCEDURE P4 IS NEW PR (ENUM, FE, PE, LE);
+               END PKG2;
+
+               PACKAGE BODY PKG2 IS
+               BEGIN
+                    P1 (C,C1,C2);
+                    P2 (B,B1,B2);
+                    P3 (I,I1,I2);
+                    P4 (F,F1,F2);
+               END  PKG2;
+          BEGIN
+               IF C /= 'B' OR B /= TRUE OR I /= 6 OR F /= E3 THEN
+                    FAILED ("SUBPROGRAM PARAMETERS OF FORMAL TYPES - " &
+                            "MODE OUT");
+               END IF;
+
+               IF C1 /= 'Z' OR B1 /= FALSE OR I1 /= 11 OR F1 /= E2 THEN
+                    FAILED ("SUBPROGRAM PARAMETERS OF FORMAL TYPES - " &
+                            "MODE IN OUT");
+               END IF;
+
+               IF C2 /= 'J' OR B2 /= TRUE OR I2 /= 5 OR F2 /= E3 THEN
+                    FAILED ("GENERIC FORMAL SUBPROGRAMS RETURNING A " &
+                            "GENERIC FORMAL TYPE");
+               END IF;
+          END;
+     END;
+
+     RESULT;
+END CC1304B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1307a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1307a.ada
new file mode 100644
index 000000000..932b5ffcf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1307a.ada
@@ -0,0 +1,54 @@
+-- CC1307A.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 SUBPROGRAM PARAMETERS MAY HAVE AN OPERATOR_SYMBOL DEFAULT,
+-- WHICH LOOKS THE SAME AS A DEFAULT STRING PARAMETER.
+
+-- DAT 9/8/81
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1307A IS
+BEGIN
+     TEST ("CC1307A", "GENERIC SUBPROGRAM AND STRING DEFAULT PARAMETERS"
+          & " MAY LOOK THE SAME");
+
+     DECLARE
+          GENERIC
+               WITH FUNCTION CAT (X, Y : STRING) RETURN STRING
+                    IS "&";
+               S : STRING := "&";
+          PACKAGE PK IS
+               VAL : CONSTANT STRING := CAT (S, S);
+          END PK;
+
+          PACKAGE PK1 IS NEW PK;
+     BEGIN
+          IF PK1.VAL /= "&&" THEN
+               FAILED ("INCORRECT GENERIC INSTANTIATION WITH DEFAULTS");
+          END IF;
+     END;
+
+     RESULT;
+END CC1307A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1307b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1307b.ada
new file mode 100644
index 000000000..c5eb15a42
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1307b.ada
@@ -0,0 +1,88 @@
+-- CC1307B.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 ENUMERATION LITERAL (BOTH AN IDENTIFIER AND A
+--     CHARACTER LITERAL) MAY BE USED AS A DEFAULT SUBPROGRAM NAME
+--     AND AS A DEFAULT INITIAL VALUE FOR AN OBJECT PARAMETER.
+
+-- HISTORY:
+--     BCB 08/09/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1307B IS
+
+     TYPE ENUM IS (R, 'S', R1);
+
+BEGIN
+     TEST ("CC1307B", "CHECK THAT AN ENUMERATION LITERAL (BOTH AN " &
+                      "IDENTIFIER AND A CHARACTER LITERAL) MAY BE " &
+                      "USED AS A DEFAULT SUBPROGRAM NAME AND AS A " &
+                      "DEFAULT INITIAL VALUE FOR AN OBJECT PARAMETER");
+
+     DECLARE
+          GENERIC
+               WITH FUNCTION J RETURN ENUM IS R;
+               WITH FUNCTION K RETURN ENUM IS 'S';
+               OBJ1 : ENUM := R;
+               OBJ2 : ENUM := 'S';
+          PACKAGE P IS
+          END P;
+
+          PACKAGE BODY P IS
+               VAR1, VAR2 : ENUM := R1;
+          BEGIN
+               VAR1 := J;
+
+               IF VAR1 /= R THEN
+                    FAILED ("WRONG VALUE FOR DEFAULT SUBPROGRAM " &
+                            "NAME - IDENTIFIER");
+               END IF;
+
+               VAR2 := K;
+
+               IF VAR2 /= 'S' THEN
+                    FAILED ("WRONG VALUE FOR DEFAULT SUBPROGRAM " &
+                            "NAME - CHARACTER LITERAL");
+               END IF;
+
+               IF OBJ1 /= R THEN
+                    FAILED ("WRONG VALUE FOR OBJECT PARAMETER - " &
+                            "IDENTIFIER");
+               END IF;
+
+               IF OBJ2 /= 'S' THEN
+                    FAILED ("WRONG VALUE FOR OBJECT PARAMETER - " &
+                            "CHARACTER LITERAL");
+               END IF;
+          END P;
+
+          PACKAGE NEW_P IS NEW P;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC1307B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1308a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1308a.ada
new file mode 100644
index 000000000..69a558f72
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1308a.ada
@@ -0,0 +1,266 @@
+-- CC1308A.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 FORMAL SUBPROGRAM PARAMETERS MAY OVERLOAD EACH OTHER
+--     AND OTHER VISIBLE SUBPROGRAMS AND ENUMERATION LITERALS WITHIN AND
+--     OUTSIDE OF THE GENERIC UNIT.
+
+-- HISTORY:
+--     DAT 09/08/81  CREATED ORIGINAL TEST.
+--     SPS 10/26/82
+--     SPS 02/09/83
+--     BCB 08/09/88  REPLACED THE OLD TEST WITH A VERSION BASED ON
+--                   AIG 6.6/T2.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1308A IS
+
+     TYPE ENUM IS (F1,F2,F3,F4,F5,F6,F7);
+
+     FUNCTION F1 (X : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN 2*X;
+     END F1;
+
+     PROCEDURE F1 (X : IN OUT INTEGER) IS
+     BEGIN
+          X := 3*X;
+     END F1;
+
+     PROCEDURE F2 (Y : IN OUT INTEGER; Z : IN OUT BOOLEAN) IS
+     BEGIN
+          Y := 2*Y;
+          Z := NOT Z;
+     END F2;
+
+     PROCEDURE F2 (Y : IN OUT INTEGER) IS
+     BEGIN
+          Y := 3*Y;
+     END F2;
+
+     PROCEDURE F3 (B : BOOLEAN := FALSE; A : IN OUT INTEGER) IS
+     BEGIN
+          A := 2*A;
+     END F3;
+
+     PROCEDURE F3 (A : IN OUT INTEGER) IS
+     BEGIN
+          A := 3*A;
+     END F3;
+
+     PROCEDURE F4 (C : IN OUT INTEGER) IS
+     BEGIN
+          C := 2*C;
+     END F4;
+
+     PROCEDURE F4 (C : IN OUT BOOLEAN) IS
+     BEGIN
+          C := NOT C;
+     END F4;
+
+     PROCEDURE F5 (D : IN OUT INTEGER; E : IN OUT BOOLEAN) IS
+     BEGIN
+          D := 2*D;
+          E := NOT E;
+     END F5;
+
+     PROCEDURE F5 (E : IN OUT BOOLEAN; D : IN OUT INTEGER) IS
+     BEGIN
+          E := NOT E;
+          D := 3*D;
+     END F5;
+
+     FUNCTION F6 (G : INTEGER) RETURN INTEGER IS
+     BEGIN
+          RETURN 2*G;
+     END F6;
+
+     FUNCTION F6 (G : INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          RETURN TRUE;
+     END F6;
+
+     FUNCTION F7 RETURN INTEGER IS
+     BEGIN
+          RETURN 25;
+     END F7;
+
+     FUNCTION F7 RETURN BOOLEAN IS
+     BEGIN
+          RETURN FALSE;
+     END F7;
+
+BEGIN
+     TEST ("CC1308A", "CHECK THAT FORMAL SUBPROGRAM PARAMETERS MAY " &
+                      "OVERLOAD EACH OTHER AND OTHER VISIBLE " &
+                      "SUBPROGRAMS AND ENUMERATION LITERALS WITHIN " &
+                      "AND OUTSIDE OF THE GENERIC UNIT");
+
+     DECLARE
+          GENERIC
+               WITH FUNCTION F1 (X : INTEGER) RETURN INTEGER;
+               WITH PROCEDURE F1 (X : IN OUT INTEGER);
+
+               WITH PROCEDURE F2 (Y : IN OUT INTEGER;
+                                  Z : IN OUT BOOLEAN);
+               WITH PROCEDURE F2 (Y : IN OUT INTEGER);
+
+               WITH PROCEDURE F3 (B : BOOLEAN := FALSE;
+                                  A : IN OUT INTEGER);
+               WITH PROCEDURE F3 (A : IN OUT INTEGER);
+
+               WITH PROCEDURE F4 (C : IN OUT INTEGER);
+               WITH PROCEDURE F4 (C : IN OUT BOOLEAN);
+
+               WITH PROCEDURE F5 (D : IN OUT INTEGER;
+                                  E : IN OUT BOOLEAN);
+               WITH PROCEDURE F5 (E : IN OUT BOOLEAN;
+                                  D : IN OUT INTEGER);
+
+               WITH FUNCTION F6 (G : INTEGER) RETURN INTEGER;
+               WITH FUNCTION F6 (G : INTEGER) RETURN BOOLEAN;
+
+               WITH FUNCTION F7 RETURN INTEGER;
+               WITH FUNCTION F7 RETURN BOOLEAN;
+          PACKAGE P IS
+               TYPE EN IS (F1,F2,F3,F4,F5,F6,F7);
+          END P;
+
+          PACKAGE BODY P IS
+               X1, X2, Y1, Y2, A1, A2, C1, D1, D2, G1
+                  : INTEGER := IDENT_INT(5);
+
+               VAL : INTEGER := IDENT_INT(0);
+
+               Z1, B1, C2, E1, E2, BOOL : BOOLEAN := IDENT_BOOL(FALSE);
+          BEGIN
+               VAL := F1(X1);
+
+               IF NOT EQUAL(VAL,10) THEN
+                    FAILED ("CASE 1 - WRONG VALUE RETURNED FROM " &
+                            "FUNCTION");
+               END IF;
+
+               F1(X2);
+
+               IF NOT EQUAL(X2,15) THEN
+                    FAILED ("CASE 1 - WRONG VALUE ASSIGNED INSIDE " &
+                            "PROCEDURE");
+               END IF;
+
+               F2(Y1,Z1);
+
+               IF NOT EQUAL(Y1,10) OR Z1 /= TRUE THEN
+                    FAILED ("CASE 2 - WRONG VALUES ASSIGNED INSIDE " &
+                            "PROCEDURE");
+               END IF;
+
+               F2(Y2);
+
+               IF NOT EQUAL(Y2,15) THEN
+                    FAILED ("CASE 2 - WRONG VALUE ASSIGNED INSIDE " &
+                            "PROCEDURE");
+               END IF;
+
+               F3(B1,A1);
+
+               IF NOT EQUAL(A1,10) OR B1 /= FALSE THEN
+                    FAILED ("CASE 3 - WRONG VALUES ASSIGNED INSIDE " &
+                            "PROCEDURE");
+               END IF;
+
+               F3(A2);
+
+               IF NOT EQUAL(A2,15) THEN
+                    FAILED ("CASE 3 - WRONG VALUE ASSIGNED INSIDE " &
+                            "PROCEDURE");
+               END IF;
+
+               F4(C1);
+
+               IF NOT EQUAL(C1,10) THEN
+                    FAILED ("CASE 4 - WRONG VALUE ASSIGNED INSIDE " &
+                            "PROCEDURE - BASE TYPE INTEGER");
+               END IF;
+
+               F4(C2);
+
+               IF C2 /= TRUE THEN
+                    FAILED ("CASE 4 - WRONG VALUE ASSIGNED INSIDE " &
+                            "PROCEDURE - BASE TYPE BOOLEAN");
+               END IF;
+
+               F5(D1,E1);
+
+               IF NOT EQUAL(D1,10) OR E1 /= TRUE THEN
+                    FAILED ("CASE 5 - WRONG VALUES ASSIGNED INSIDE " &
+                            "PROCEDURE - ORDER WAS INTEGER, BOOLEAN");
+               END IF;
+
+               F5(E2,D2);
+
+               IF E2 /= TRUE OR NOT EQUAL(D2,15) THEN
+                    FAILED ("CASE 5 - WRONG VALUES ASSIGNED INSIDE " &
+                            "PROCEDURE - ORDER WAS BOOLEAN, INTEGER");
+               END IF;
+
+               VAL := F6(G1);
+
+               IF NOT EQUAL(VAL,10) THEN
+                    FAILED ("CASE 6 - WRONG VALUE RETURNED FROM " &
+                            "FUNCTION - TYPE INTEGER");
+               END IF;
+
+               BOOL := F6(G1);
+
+               IF BOOL /= TRUE THEN
+                    FAILED ("CASE 6 - WRONG VALUE RETURNED FROM " &
+                            "FUNCTION - TYPE BOOLEAN");
+               END IF;
+
+               VAL := F7;
+
+               IF NOT EQUAL(VAL,25) THEN
+                    FAILED ("CASE 7 - WRONG VALUE RETURNED FROM " &
+                            "PARAMETERLESS FUNCTION - TYPE INTEGER");
+               END IF;
+
+               BOOL := F7;
+
+               IF BOOL /= FALSE THEN
+                    FAILED ("CASE 7 - WRONG VALUE RETURNED FROM " &
+                            "PARAMETERLESS FUNCTION - TYPE BOOLEAN");
+               END IF;
+          END P;
+
+          PACKAGE NEW_P IS NEW P (F1, F1, F2, F2, F3, F3,
+                                  F4, F4, F5, F5, F6, F6, F7, F7);
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC1308A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1310a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1310a.ada
new file mode 100644
index 000000000..28ea40941
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1310a.ada
@@ -0,0 +1,88 @@
+-- CC1310A.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 GENERIC SUBPROGRAM PARAMETERS MAY BE ENTRIES.
+
+-- DAT 9/8/81
+-- SPS 2/7/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1310A IS
+BEGIN
+     TEST ("CC1310A", "DEFAULT GENERIC SUBPROGRAM PARAMETERS MAY BE"
+          & " ENTRIES");
+
+     DECLARE
+          TASK T IS
+               ENTRY ENT1;
+               ENTRY ENT2 (I : IN INTEGER);
+          END T;
+
+          PROCEDURE P1 RENAMES T.ENT1;
+          
+          PROCEDURE P4 (I : IN INTEGER) RENAMES T.ENT2;
+
+          INT : INTEGER := 0;
+
+          TASK BODY T IS
+          BEGIN
+               ACCEPT ENT1;
+               ACCEPT ENT2 (I : IN INTEGER) DO
+                    INT := INT + I;
+               END ENT2;
+               ACCEPT ENT2 (I : IN INTEGER) DO
+                    INT := INT + I;
+               END ENT2;
+               ACCEPT ENT1;
+          END T;
+
+     BEGIN
+          DECLARE
+               GENERIC 
+                    WITH PROCEDURE P1 IS <> ;
+                    WITH PROCEDURE P2 IS T.ENT1;
+                    WITH PROCEDURE P3 (I : IN INTEGER) IS T.ENT2;
+                    WITH PROCEDURE P4 (I : IN INTEGER) IS <> ;
+               PACKAGE PKG IS END PKG;
+
+               PACKAGE BODY PKG IS
+               BEGIN
+                    P1;
+                    P4 (3);
+                    P3 (6);
+                    P2;
+               END PKG;
+
+               PACKAGE PP IS NEW PKG;
+
+          BEGIN
+               IF INT /= 9 THEN
+                    FAILED ("ENTRIES AS DEFAULT GENERIC PARAMETERS");
+               END IF;
+          END;
+     END;
+
+     RESULT;
+END CC1310A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1311a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1311a.ada
new file mode 100644
index 000000000..ce38abe55
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1311a.ada
@@ -0,0 +1,480 @@
+-- CC1311A.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 DEFAULT EXPRESSIONS OF THE PARAMETERS OF A FORMAL
+--     SUBPROGRAM ARE USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE
+--     ACTUAL SUBPROGRAM PARAMETER.
+
+-- HISTORY:
+--     RJW 06/05/86  CREATED ORIGINAL TEST.
+--     VCL 08/18/87  CHANGED A COUPLE OF STATIC DEFAULT EXPRESSIONS FOR
+--                   FORMAL SUBPROGRAM PARAMETERS TO DYNAMIC 
+--                   EXPRESSIONS VIA THE USE OF THE IDENTITY FUNCTION.
+--     EDWARD V. BERARD 08/13/90  
+--                   ADDED CHECKS FOR MULTI-DIMENSIONAL ARRAYS.
+
+WITH REPORT ;
+
+PROCEDURE CC1311A IS
+
+     TYPE NUMBERS IS (ZERO, ONE ,TWO);
+
+     SHORT_START : CONSTANT := -100 ;
+     SHORT_END   : CONSTANT := 100 ;
+     TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+    
+     SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
+    
+     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                         SEP, OCT, NOV, DEC) ;
+                        
+     SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
+    
+     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+     TYPE DATE IS RECORD
+          MONTH : MONTH_TYPE ;
+          DAY   : DAY_TYPE ;
+          YEAR  : YEAR_TYPE ;
+     END RECORD ;
+    
+     TODAY         : DATE := (MONTH => AUG,
+                              DAY   => 8,
+                              YEAR  => 1990) ;
+                            
+     FIRST_DATE     : DATE := (DAY   => 6,
+                               MONTH => JUN,
+                               YEAR  => 1967) ;
+     
+     SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
+                            
+     TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
+                                      FIRST_HALF,
+                                      FIRST_FIVE) OF DATE ;
+                            
+     GENERIC
+    
+          TYPE FIRST_INDEX IS (<>) ;
+          TYPE SECOND_INDEX IS (<>) ;
+          TYPE THIRD_INDEX IS (<>) ;
+          TYPE COMPONENT_TYPE IS PRIVATE ;
+          DEFAULT_VALUE : IN COMPONENT_TYPE ;
+          TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                              SECOND_INDEX,
+                              THIRD_INDEX) OF COMPONENT_TYPE ;
+          WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
+                                                (CUBE'RANGE (2) =>
+                                                (CUBE'RANGE (3) =>
+                                                     DEFAULT_VALUE))))
+                        RETURN CUBE ;
+                        
+     PROCEDURE PROC_WITH_3D_FUNC ;
+    
+     PROCEDURE PROC_WITH_3D_FUNC IS
+    
+     BEGIN  -- PROC_WITH_3D_FUNC
+    
+          IF FUN /= CUBE'(CUBE'RANGE =>
+                         (CUBE'RANGE (2) =>
+                         (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
+               REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
+                              "ARRAY, FUNCTION, AND PROCEDURE.") ;
+          END IF ;
+        
+     END PROC_WITH_3D_FUNC ;
+    
+     GENERIC
+    
+          TYPE FIRST_INDEX IS (<>) ;
+          TYPE SECOND_INDEX IS (<>) ;
+          TYPE THIRD_INDEX IS (<>) ;
+          TYPE COMPONENT_TYPE IS PRIVATE ;
+          DEFAULT_VALUE : IN COMPONENT_TYPE ;
+          TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                              SECOND_INDEX,
+                              THIRD_INDEX) OF COMPONENT_TYPE ;
+          WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
+                                                (CUBE'RANGE (2) =>
+                                                (CUBE'RANGE (3) =>
+                                                     DEFAULT_VALUE))))
+                        RETURN CUBE ;
+                        
+     PACKAGE PKG_WITH_3D_FUNC IS
+     END PKG_WITH_3D_FUNC ;
+    
+     PACKAGE BODY PKG_WITH_3D_FUNC IS
+     BEGIN  -- PKG_WITH_3D_FUNC
+
+          REPORT.TEST("CC1311A","CHECK THAT THE DEFAULT EXPRESSIONS " &
+                      "OF THE PARAMETERS OF A FORMAL SUBPROGRAM ARE " &
+                      "USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE " &
+                      "ACTUAL SUBPROGRAM PARAMETER" ) ;
+    
+          IF FUN /= CUBE'(CUBE'RANGE =>
+                         (CUBE'RANGE (2) =>
+                         (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
+               REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
+                              "ARRAY, FUNCTION, AND PACKAGE.") ;
+          END IF ;
+        
+     END PKG_WITH_3D_FUNC ;
+    
+     GENERIC
+    
+          TYPE FIRST_INDEX IS (<>) ;
+          TYPE SECOND_INDEX IS (<>) ;
+          TYPE THIRD_INDEX IS (<>) ;
+          TYPE COMPONENT_TYPE IS PRIVATE ;
+          DEFAULT_VALUE : IN COMPONENT_TYPE ;
+          TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                              SECOND_INDEX,
+                              THIRD_INDEX) OF COMPONENT_TYPE ;
+          WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE =>
+                                                (CUBE'RANGE (2) =>
+                                                (CUBE'RANGE (3) =>
+                                                     DEFAULT_VALUE))))
+                        RETURN CUBE ;
+                        
+     FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN ;
+    
+     FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN IS
+     BEGIN  -- FUNC_WITH_3D_FUNC
+     
+          RETURN FUN = CUBE'(CUBE'RANGE =>
+                            (CUBE'RANGE (2) =>
+                            (CUBE'RANGE (3) => DEFAULT_VALUE))) ;
+                       
+     END FUNC_WITH_3D_FUNC ;
+    
+     GENERIC
+    
+          TYPE FIRST_INDEX IS (<>) ;
+          TYPE SECOND_INDEX IS (<>) ;
+          TYPE THIRD_INDEX IS (<>) ;
+          TYPE COMPONENT_TYPE IS PRIVATE ;
+          DEFAULT_VALUE : IN COMPONENT_TYPE ;
+          TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                              SECOND_INDEX,
+                              THIRD_INDEX) OF COMPONENT_TYPE ;
+          WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
+                                                    (CUBE'RANGE (2) =>
+                                                    (CUBE'RANGE (3) =>
+                                                     DEFAULT_VALUE))) ;
+                               OUTPUT : OUT CUBE) ;
+                        
+     PROCEDURE PROC_WITH_3D_PROC ;
+    
+     PROCEDURE PROC_WITH_3D_PROC IS
+    
+          RESULTS : CUBE ;
+        
+     BEGIN  -- PROC_WITH_3D_PROC
+    
+          PROC (OUTPUT => RESULTS) ;
+        
+          IF RESULTS /= CUBE'(CUBE'RANGE =>
+                             (CUBE'RANGE (2) =>
+                             (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
+               REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
+                              "ARRAY, PROCEDURE, AND PROCEDURE.") ;
+          END IF ;
+        
+     END PROC_WITH_3D_PROC ;
+
+     GENERIC
+    
+          TYPE FIRST_INDEX IS (<>) ;
+          TYPE SECOND_INDEX IS (<>) ;
+          TYPE THIRD_INDEX IS (<>) ;
+          TYPE COMPONENT_TYPE IS PRIVATE ;
+          DEFAULT_VALUE : IN COMPONENT_TYPE ;
+          TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                              SECOND_INDEX,
+                              THIRD_INDEX) OF COMPONENT_TYPE ;
+          WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
+                                                    (CUBE'RANGE (2) =>
+                                                    (CUBE'RANGE (3) =>
+                                                     DEFAULT_VALUE))) ;
+                               OUTPUT : OUT CUBE) ;
+                        
+     PACKAGE PKG_WITH_3D_PROC IS
+     END PKG_WITH_3D_PROC ;
+    
+     PACKAGE BODY PKG_WITH_3D_PROC IS
+    
+          RESULTS : CUBE ;
+        
+     BEGIN  -- PKG_WITH_3D_PROC
+    
+          PROC (OUTPUT => RESULTS) ;
+        
+          IF RESULTS /= CUBE'(CUBE'RANGE =>
+                             (CUBE'RANGE (2) =>
+                             (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN
+               REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " &
+                              "ARRAY, PROCEDURE, AND PACKAGE.") ;
+          END IF ;
+        
+     END PKG_WITH_3D_PROC ;
+    
+     GENERIC
+    
+          TYPE FIRST_INDEX IS (<>) ;
+          TYPE SECOND_INDEX IS (<>) ;
+          TYPE THIRD_INDEX IS (<>) ;
+          TYPE COMPONENT_TYPE IS PRIVATE ;
+          DEFAULT_VALUE : IN COMPONENT_TYPE ;
+          TYPE CUBE IS ARRAY (FIRST_INDEX, 
+                              SECOND_INDEX,
+                              THIRD_INDEX) OF COMPONENT_TYPE ;
+          WITH PROCEDURE PROC (INPUT  : IN  CUBE := (CUBE'RANGE =>
+                                                    (CUBE'RANGE (2) =>
+                                                    (CUBE'RANGE (3) =>
+                                                     DEFAULT_VALUE))) ;
+                               OUTPUT : OUT CUBE) ;
+                        
+     FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN ;
+    
+     FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN IS
+    
+          RESULTS : CUBE ;
+        
+     BEGIN  -- FUNC_WITH_3D_PROC
+    
+          PROC (OUTPUT => RESULTS) ;
+          RETURN RESULTS = CUBE'(CUBE'RANGE =>
+                                (CUBE'RANGE (2) =>
+                                (CUBE'RANGE (3) => DEFAULT_VALUE))) ;
+                         
+     END FUNC_WITH_3D_PROC ;
+    
+     GENERIC
+          TYPE T IS (<>);
+          WITH FUNCTION F (X : T := T'VAL (0)) RETURN T;
+     FUNCTION FUNC1 RETURN BOOLEAN;
+
+     FUNCTION FUNC1 RETURN BOOLEAN IS
+     BEGIN  -- FUNC1
+         RETURN F = T'VAL (0);
+     END FUNC1;
+
+     GENERIC
+          TYPE T IS (<>);
+          WITH FUNCTION F (X : T := T'VAL (REPORT.IDENT_INT(0)))
+                        RETURN T;
+     PACKAGE PKG1 IS END PKG1;
+
+     PACKAGE BODY PKG1 IS
+     BEGIN  -- PKG1
+          IF F /= T'VAL (0) THEN
+               REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
+                              "FUNCTION 'F' AND PACKAGE 'PKG1'" );
+          END IF;
+     END PKG1;
+     GENERIC
+          TYPE T IS (<>);
+          WITH FUNCTION F (X : T := T'VAL (0)) RETURN T;
+     PROCEDURE PROC1;
+
+     PROCEDURE PROC1 IS
+     BEGIN  -- PROC1
+          IF F /= T'VAL (0) THEN
+               REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
+                              "FUNCTION 'F' AND PROCEDURE 'PROC1'" );
+          END IF;
+     END PROC1;
+
+     GENERIC
+          TYPE T IS (<>);
+          WITH PROCEDURE P (RESULTS : OUT T ; 
+                            X       : T := T'VAL (0)) ;
+     FUNCTION FUNC2 RETURN BOOLEAN;
+
+     FUNCTION FUNC2 RETURN BOOLEAN IS
+          RESULTS : T;
+     BEGIN  -- FUNC2
+          P (RESULTS);
+          RETURN RESULTS = T'VAL (0);
+     END FUNC2;
+
+     GENERIC
+          TYPE T IS (<>);
+          WITH PROCEDURE P (RESULTS : OUT T;
+                            X       : T := T'VAL(REPORT.IDENT_INT(0)));
+     PACKAGE PKG2 IS END PKG2 ;
+
+     PACKAGE BODY PKG2 IS
+          RESULTS : T;
+     BEGIN  -- PKG2
+          P (RESULTS);
+          IF RESULTS /= T'VAL (0) THEN
+                REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
+                               "PROCEDURE 'P' AND PACKAGE 'PKG2'" );
+          END IF;
+     END PKG2;
+
+     GENERIC
+          TYPE T IS (<>);
+          WITH PROCEDURE P (RESULTS :OUT T; X : T := T'VAL (0));
+     PROCEDURE PROC2;
+
+     PROCEDURE PROC2 IS
+          RESULTS : T;
+     BEGIN  -- PROC2
+          P (RESULTS);
+          IF RESULTS /= T'VAL (0) THEN
+               REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " &
+                             "PROCEDURE 'P' AND PROCEDURE 'PROC2'" );
+          END IF;
+     END PROC2;
+
+     FUNCTION F1 (A : NUMBERS := ONE) RETURN NUMBERS IS
+     BEGIN  -- F1
+          RETURN A;
+     END;
+
+     PROCEDURE P2 (OUTVAR : OUT NUMBERS; INVAR : NUMBERS := TWO) IS
+     BEGIN  -- P2
+          OUTVAR := INVAR;
+     END;
+
+     FUNCTION TD_FUNC (FIRST : IN THREE_DIMENSIONAL :=
+                                       (THREE_DIMENSIONAL'RANGE =>
+                                       (THREE_DIMENSIONAL'RANGE (2) =>
+                                       (THREE_DIMENSIONAL'RANGE (3) =>
+                                            FIRST_DATE))))
+              RETURN THREE_DIMENSIONAL IS 
+                
+     BEGIN  -- TD_FUNC
+    
+          RETURN FIRST ;
+        
+     END TD_FUNC ;
+    
+     PROCEDURE TD_PROC (INPUT  : IN  THREE_DIMENSIONAL := 
+                                        (THREE_DIMENSIONAL'RANGE =>
+                                        (THREE_DIMENSIONAL'RANGE (2) =>
+                                        (THREE_DIMENSIONAL'RANGE (3) =>
+                                             FIRST_DATE))) ;
+                        OUTPUT : OUT THREE_DIMENSIONAL) IS
+     BEGIN  -- TD_PROC
+    
+          OUTPUT := INPUT ;
+        
+     END TD_PROC ;
+    
+     PROCEDURE NEW_PROC_WITH_3D_FUNC IS NEW 
+          PROC_WITH_3D_FUNC (FIRST_INDEX    => REALLY_SHORT,
+                             SECOND_INDEX   => FIRST_HALF,
+                             THIRD_INDEX    => FIRST_FIVE,
+                             COMPONENT_TYPE => DATE,
+                             DEFAULT_VALUE  => TODAY,
+                             CUBE           => THREE_DIMENSIONAL,
+                             FUN            => TD_FUNC) ;
+
+     PACKAGE NEW_PKG_WITH_3D_FUNC IS NEW 
+          PKG_WITH_3D_FUNC (FIRST_INDEX     => REALLY_SHORT,
+                            SECOND_INDEX    => FIRST_HALF,
+                            THIRD_INDEX     => FIRST_FIVE,
+                            COMPONENT_TYPE  => DATE,
+                            DEFAULT_VALUE   => TODAY,
+                            CUBE            => THREE_DIMENSIONAL,
+                            FUN             => TD_FUNC) ;
+
+      FUNCTION NEW_FUNC_WITH_3D_FUNC IS NEW 
+          FUNC_WITH_3D_FUNC (FIRST_INDEX    => REALLY_SHORT,
+                             SECOND_INDEX   => FIRST_HALF,
+                             THIRD_INDEX    => FIRST_FIVE,
+                             COMPONENT_TYPE => DATE,
+                             DEFAULT_VALUE  => TODAY,
+                             CUBE           => THREE_DIMENSIONAL,
+                             FUN            => TD_FUNC) ;
+
+     PROCEDURE NEW_PROC_WITH_3D_PROC IS NEW 
+          PROC_WITH_3D_PROC (FIRST_INDEX    => REALLY_SHORT,
+                             SECOND_INDEX   => FIRST_HALF,
+                             THIRD_INDEX    => FIRST_FIVE,
+                             COMPONENT_TYPE => DATE,
+                             DEFAULT_VALUE  => TODAY,
+                             CUBE           => THREE_DIMENSIONAL,
+                             PROC           => TD_PROC) ;
+
+     PACKAGE NEW_PKG_WITH_3D_PROC IS NEW 
+          PKG_WITH_3D_PROC (FIRST_INDEX     => REALLY_SHORT,
+                            SECOND_INDEX   => FIRST_HALF,
+                            THIRD_INDEX    => FIRST_FIVE,
+                            COMPONENT_TYPE => DATE,
+                            DEFAULT_VALUE  => TODAY,
+                            CUBE           => THREE_DIMENSIONAL,
+                            PROC           => TD_PROC) ;
+
+     FUNCTION NEW_FUNC_WITH_3D_PROC IS NEW 
+          FUNC_WITH_3D_PROC (FIRST_INDEX    => REALLY_SHORT,
+                             SECOND_INDEX   => FIRST_HALF,
+                             THIRD_INDEX    => FIRST_FIVE,
+                             COMPONENT_TYPE => DATE,
+                             DEFAULT_VALUE  => TODAY,
+                             CUBE           => THREE_DIMENSIONAL,
+                             PROC           => TD_PROC) ;
+
+     FUNCTION  NFUNC1 IS NEW FUNC1 (NUMBERS, F1);
+     PACKAGE   NPKG1  IS NEW PKG1  (NUMBERS, F1);
+     PROCEDURE NPROC1 IS NEW PROC1 (NUMBERS, F1);
+
+     FUNCTION  NFUNC2 IS NEW FUNC2 (NUMBERS, P2);
+     PACKAGE   NPKG2  IS NEW PKG2  (NUMBERS, P2);
+     PROCEDURE NPROC2 IS NEW PROC2 (NUMBERS, P2);
+
+BEGIN  -- CC1311A
+
+     IF NOT NFUNC1 THEN
+          REPORT.FAILED ("INCORRECT DEFAULT VALUE " &
+                         "WITH FUNCTION 'NFUNC1'" ) ;
+     END IF ;
+
+     IF NOT NFUNC2 THEN
+          REPORT.FAILED ("INCORRECT DEFAULT VALUE " &
+                         "WITH FUNCTION 'NFUNC2'" ) ;
+     END IF ;
+
+     NPROC1 ;
+     NPROC2 ;
+    
+     NEW_PROC_WITH_3D_FUNC ;
+    
+     IF NOT NEW_FUNC_WITH_3D_FUNC THEN
+          REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " &
+                         "FUNCTION, AND FUNCTION.") ;
+     END IF ;
+    
+     NEW_PROC_WITH_3D_PROC ;
+    
+     IF NOT NEW_FUNC_WITH_3D_PROC THEN
+          REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " &
+                         "FUNCTION, AND PROCEDURE.") ;
+     END IF ;
+        
+     REPORT.RESULT ;
+
+END CC1311A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1311b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1311b.ada
new file mode 100644
index 000000000..eb30726b8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1311b.ada
@@ -0,0 +1,332 @@
+-- CC1311B.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 PARAMETERS OF DEFAULT AND FORMAL SUBPROGRAMS HAVE
+--     THE SAME TYPE BUT NOT THE SAME SUBTYPE, THE PARAMETER SUBTYPES OF
+--     THE SUBPROGRAM DENOTED BY THE DEFAULT ARE USED INSTEAD OF
+--     SUBTYPES SPECIFIED IN THE FORMAL SUBPROGRAM DECLARATION.
+
+-- HISTORY:
+--     RJW 06/11/86 CREATED ORIGINAL TEST.
+--     DHH 10/20/86 CORRECTED RANGE ERRORS.
+--     PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
+--     PWN 10/27/95 REMOVED CHECKS AGAINST ARRAY SLIDING RULES THAT
+--                  HAVE BEEN RELAXED.
+--     PWN 10/25/96 RESTORED CHECKS WITH NEW ADA 95 EXPECTED RESULTS.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1311B IS
+
+BEGIN
+     TEST ("CC1311B", "CHECK THAT IF PARAMETERS OF DEFAULT AND " &
+                      "FORMAL SUBPROGRAMS HAVE THE SAME TYPE BUT " &
+                      "NOT THE SAME SUBTYPE, THE PARAMETER SUBTYPES " &
+                      "OF THE SUBPROGRAM DENOTED BY THE DEFAULT ARE " &
+                      "USED INSTEAD OF SUBTYPES SPECIFIED IN THE " &
+                      "FORMAL SUBPROGRAM DECLARATION" );
+
+     DECLARE
+          TYPE NUMBERS IS (ZERO, ONE ,TWO);
+          SUBTYPE ZERO_TWO IS NUMBERS;
+          SUBTYPE ZERO_ONE IS NUMBERS RANGE ZERO .. ONE;
+
+          FUNCTION FSUB (X : ZERO_ONE) RETURN ZERO_ONE IS
+          BEGIN
+               RETURN NUMBERS'VAL (IDENT_INT (NUMBERS'POS (ONE)));
+          END FSUB;
+
+          GENERIC
+               WITH FUNCTION F (X : ZERO_TWO := TWO) RETURN ZERO_TWO
+                    IS FSUB;
+          FUNCTION FUNC  RETURN ZERO_TWO;
+
+          FUNCTION FUNC RETURN ZERO_TWO IS
+          BEGIN
+               RETURN F;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    RETURN ZERO;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                             "NFUNC1" );
+                    RETURN ZERO;
+          END FUNC;
+
+          FUNCTION NFUNC1 IS NEW FUNC;
+
+     BEGIN
+          IF NFUNC1 = ONE THEN
+               FAILED ( "NO EXCEPTION RAISED WITH NFUNC1" );
+          END IF;
+     END;
+
+     DECLARE
+          TYPE GENDER IS (MALE, FEMALE);
+
+          TYPE PERSON (SEX : GENDER) IS
+               RECORD
+                   CASE SEX IS
+                         WHEN MALE =>
+                              BEARDED : BOOLEAN;
+                         WHEN FEMALE =>
+                              CHILDREN : INTEGER;
+                    END CASE;
+               END RECORD;
+
+          SUBTYPE MAN IS PERSON (SEX => MALE);
+          SUBTYPE TESTWRITER IS PERSON (FEMALE);
+
+          ROSA : TESTWRITER := (FEMALE, 4);
+
+          FUNCTION F (X : MAN) RETURN PERSON IS
+               TOM : PERSON (MALE) := (MALE, FALSE);
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    RETURN X;
+               ELSE
+                    RETURN TOM;
+               END IF;
+          END F;
+
+          GENERIC
+               TYPE T IS PRIVATE;
+               X1 : T;
+               WITH FUNCTION F (X : T) RETURN T IS <> ;
+          PACKAGE PKG IS END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               IF F(X1) = X1 THEN
+                    FAILED ( "NO EXCEPTION RAISED WITH " &
+                             "FUNCTION 'F' AND PACKAGE " &
+                             "'PKG' - 1" );
+               ELSE
+                    FAILED ( "NO EXCEPTION RAISED WITH " &
+                             "FUNCTION 'F' AND PACKAGE " &
+                             "'PKG' - 2" );
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                             "FUNCTION 'F' AND PACKAGE 'PKG'" );
+          END PKG;
+
+          PACKAGE NPKG IS NEW PKG (TESTWRITER, ROSA);
+
+     BEGIN
+          COMMENT ( "PACKAGE BODY ELABORATED - 1" );
+     END;
+
+     DECLARE
+          TYPE VECTOR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+          SUBTYPE SUBV1 IS VECTOR (1 .. 5);
+          SUBTYPE SUBV2 IS VECTOR (2 .. 6);
+
+          V1 : SUBV1 := (1, 2, 3, 4, 5);
+
+          FUNCTION FSUB (Y : SUBV2) RETURN VECTOR IS
+               Z : SUBV2;
+          BEGIN
+               FOR I IN Y'RANGE LOOP
+                    Z (I) := IDENT_INT (Y (I));
+               END LOOP;
+               RETURN Z;
+          END;
+
+          GENERIC
+           WITH FUNCTION F (X : SUBV1 := V1) RETURN SUBV1 IS FSUB;
+          PROCEDURE PROC;
+
+          PROCEDURE PROC IS
+          BEGIN
+               IF F = V1 THEN
+                    COMMENT ( "NO EXCEPTION RAISED WITH " &
+                              "FUNCTION 'F' AND PROCEDURE " &
+                              "'PROC' - 1" );
+               ELSE
+                    COMMENT ( "NO EXCEPTION RAISED WITH " &
+                              "FUNCTION 'F' AND PROCEDURE " &
+                              "'PROC' - 2" );
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ( "CONSTRAINT_ERROR RAISED WITH " &
+                             "FUNCTION 'F' AND PROCEDURE " &
+                             "'PROC'" );
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                             "FUNCTION 'F' AND PROCEDURE " &
+                             "'PROC'" );
+          END PROC;
+
+          PROCEDURE NPROC IS NEW PROC;
+     BEGIN
+          NPROC;
+     END;
+
+     DECLARE
+
+          TYPE ACC IS ACCESS STRING;
+
+          SUBTYPE INDEX1 IS INTEGER RANGE 1 .. 5;
+          SUBTYPE INDEX2 IS INTEGER RANGE 2 .. 6;
+
+          SUBTYPE ACC1 IS ACC (INDEX1);
+          SUBTYPE ACC2 IS ACC (INDEX2);
+
+          AC2 : ACC2 := NEW STRING'(2 .. 6 => 'A');
+          AC  : ACC;
+
+          PROCEDURE P (RESULTS : OUT ACC1; X : ACC1) IS
+          BEGIN
+               RESULTS := NULL;
+          END P;
+
+          GENERIC
+           WITH PROCEDURE P1 (RESULTS : OUT ACC2; X : ACC2 := AC2)
+                    IS P;
+          FUNCTION FUNC RETURN ACC;
+
+          FUNCTION FUNC RETURN ACC IS
+               RESULTS : ACC;
+          BEGIN
+               P1 (RESULTS);
+               RETURN RESULTS;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    RETURN NEW STRING'("ABCDE");
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                             "NFUNC2" );
+                    RETURN NULL;
+          END FUNC;
+
+          FUNCTION NFUNC2 IS NEW FUNC;
+
+     BEGIN
+          AC := NFUNC2;
+          IF AC = NULL OR ELSE AC.ALL /= "ABCDE" THEN
+            FAILED ( "NO OR WRONG EXCEPTION RAISED WITH NFUNC2" );
+          END IF;
+     END;
+
+     DECLARE
+          SUBTYPE FLOAT1 IS FLOAT RANGE -1.0 .. 0.0;
+          SUBTYPE FLOAT2 IS FLOAT RANGE  0.0 .. 1.0;
+
+          PROCEDURE PSUB (RESULTS : OUT FLOAT2; X : FLOAT2) IS
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    RESULTS := X;
+               ELSE
+                    RESULTS := 0.0;
+               END IF;
+          END PSUB;
+
+          GENERIC
+               WITH PROCEDURE P (RESULTS : OUT FLOAT1;
+                                 X : FLOAT1 := -0.0625) IS PSUB;
+          PACKAGE PKG IS END PKG;
+
+          PACKAGE BODY PKG IS
+               RESULTS : FLOAT1;
+          BEGIN
+               P (RESULTS);
+               IF RESULTS = 1.0 THEN
+                    FAILED ( "NO EXCEPTION RAISED WITH " &
+                             "PROCEDURE 'P' AND PACKAGE " &
+                             "'PKG' - 1" );
+               ELSE
+                    FAILED ( "NO EXCEPTION RAISED WITH " &
+                             "PROCEDURE 'P' AND PACKAGE " &
+                             "'PKG' - 2" );
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                             "PROCEDURE 'P' AND PACKAGE 'PKG'" );
+          END PKG;
+
+          PACKAGE NPKG IS NEW PKG;
+     BEGIN
+          COMMENT ( "PACKAGE BODY ELABORATED - 2" );
+     END;
+
+     DECLARE
+          TYPE FIXED IS DELTA 0.125 RANGE -1.0 .. 1.0;
+          SUBTYPE FIXED1 IS FIXED RANGE -0.5 .. 0.0;
+          SUBTYPE FIXED2 IS FIXED RANGE  0.0 .. 0.5;
+
+          PROCEDURE P (RESULTS : OUT FIXED1; X : FIXED1) IS
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    RESULTS := X;
+               ELSE
+                    RESULTS := X;
+               END IF;
+          END P;
+
+          GENERIC
+               TYPE F IS DELTA <>;
+               F1 : F;
+               WITH PROCEDURE P (RESULTS : OUT F; X : F) IS <> ;
+          PROCEDURE PROC;
+
+          PROCEDURE PROC IS
+               RESULTS : F;
+          BEGIN
+               P (RESULTS, F1);
+               IF RESULTS = 0.0 THEN
+                    FAILED ( "NO EXCEPTION RAISED WITH " &
+                             "PROCEDURE 'P' AND PROCEDURE " &
+                             "'PROC' - 1" );
+               ELSE
+                    FAILED ( "NO EXCEPTION RAISED WITH " &
+                             "PROCEDURE 'P' AND PROCEDURE " &
+                             "'PROC' - 2" );
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ( "WRONG EXCEPTION RAISED WITH " &
+                             "PROCEDURE 'P' AND PROCEDURE " &
+                             "'PROC'" );
+          END PROC;
+
+          PROCEDURE NPROC IS NEW PROC (FIXED2, 0.125);
+
+     BEGIN
+          NPROC;
+     END;
+
+     RESULT;
+
+END CC1311B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc2002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc2002a.ada
new file mode 100644
index 000000000..95b9e91ef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc2002a.ada
@@ -0,0 +1,77 @@
+-- CC2002A.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 ELABORATION OF A GENERIC BODY HAS NO EFFECT OTHER
+-- THAN TO ESTABLISH THE TEMPLATE BODY TO BE USED FOR THE
+-- CORRESPONDING INSTANTIATIONS.
+
+-- ASL 09/02/81
+-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
+-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC2002A IS
+
+     GLOBAL : INTEGER := 0;
+     Q : INTEGER RANGE 1..1 := 1;
+BEGIN
+     TEST ("CC2002A","NO SIDE EFFECTS OF ELABORATION OF GENERIC BODY");
+
+     BEGIN
+          DECLARE
+               GENERIC
+                    PACKAGE P IS
+                    END P;
+
+               GENERIC PROCEDURE PROC;
+
+                    PROCEDURE PROC IS
+                         C : CONSTANT INTEGER RANGE 1 .. 1 := 2;
+                    BEGIN
+                         RAISE PROGRAM_ERROR;
+                    END PROC;
+
+                    PACKAGE BODY P IS
+                         C : CONSTANT BOOLEAN := 
+                              BOOLEAN'SUCC(IDENT_BOOL(TRUE));
+                    BEGIN
+                         GLOBAL := 1;
+                         Q := Q + 1;
+                    END P;
+          BEGIN
+               NULL;
+          END;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED DURING ELABORATION OF " &
+                       "GENERIC BODY");
+     END;
+
+     IF GLOBAL /= 0 THEN
+          FAILED ("VALUE OF GLOBAL VARIABLE CHANGED BY ELABORATION " &
+                  "OF GENERIC BODY");
+     END IF;
+
+     RESULT;
+END CC2002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc30001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc30001.a
new file mode 100644
index 000000000..69010e421
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc30001.a
@@ -0,0 +1,219 @@
+-- CC30001.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 non-overriding primitive subprogram is declared for
+--      a type derived from a formal derived tagged type, the copy of that
+--      subprogram in an instance can override a subprogram inherited from the
+--      actual type.
+--
+-- TEST DESCRIPTION:
+--      User writes program to handle both mail messages and system messages.
+--
+--      Mail messages are created by instantiating a generic "mail" package
+--      with a root message type. System messages are created by
+--      instantiating the generic with a system message type derived from the
+--      root in a separate package. The system message type has a primitive
+--      subprogram called Send.
+--
+--      Inside the generic, a "mail" type is derived from the generic formal
+--      derived type, and a "Send" operation is declared.
+--
+--      Declare a root tagged type T. Declare a generic package with a formal
+--      derived type using the root tagged type as ancestor. In the generic,
+--      derive a type from the formal derived type and declare a primitive
+--      subprogram for it. In a separate package, declare a derivative DT of
+--      the root tagged type T and declare a primitive subprogram which is
+--      type conformant with (and hence, overridable for) the primitive
+--      declared in the generic. Instantiate the generic for DT. Make both
+--      dispatching and non-dispatching calls to the primitive subprogram. In
+--      both cases the version of the subprogram in the instance should be
+--      called (since it overrides the implementation inherited from the
+--      actual).
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      13 Apr 95   SAIC    Replaced call involving instance for root tagged
+--                          type with a dispatching call involving instance
+--                          for derived type. Updated commentary. Moved
+--                          instantiations (and related commentary) to
+--                          library-level to avoid accessibility violation.
+--                          Commented out instantiation for root tagged type.
+--      27 Feb 97   PWB.CTA Added elaboration pragma.
+--!
+
+package CC30001_0 is  -- Root message type.
+
+   type Msg_Type is tagged record
+      Text         : String (1 .. 20);
+      Message_Sent : Boolean;
+   end record;
+
+end CC30001_0;
+
+
+     --==================================================================--
+
+
+with CC30001_0;  -- Root message type.
+generic          -- Generic "mail" package.
+   type Message is new CC30001_0.Msg_Type with private;
+package CC30001_1 is
+
+   type Mail_Type is new Message with record   -- Derived from formal type.
+      To : String (1 .. 8);
+   end record;
+
+   procedure Send (M : in out Mail_Type);      -- For this test, this version
+                                               -- of Send should be called in
+   -- ... Other operations.                    -- all cases.
+
+end CC30001_1;
+
+
+     --==================================================================--
+
+
+package body CC30001_1 is
+
+   procedure Send (M : in out Mail_Type) is
+   begin
+      -- ... Code to send message omitted for brevity.
+      M.Message_Sent := True;
+   end Send;
+
+end CC30001_1;
+
+
+     --==================================================================--
+
+
+with CC30001_0;       -- Root message type.
+package CC30001_2 is  -- System message type and operations.
+
+   type Signal_Type is (Note, Warning, Error);
+
+   type Sys_Message is new CC30001_0.Msg_Type with record   -- Derived from
+      Signal : Signal_Type := Warning;                      -- root type.
+   end record;
+
+   procedure Send (Item : in out Sys_Message); -- For this test, this version
+                                               -- of Send should never be
+   -- ... Other operations.                    -- called (it will have been
+                                               -- overridden).
+end CC30001_2;
+
+
+     --==================================================================--
+
+
+package body CC30001_2 is
+
+   procedure Send (Item : in out Sys_Message) is
+   begin
+      -- ... Code to send message omitted for brevity.
+      Item.Message_Sent := False;  -- Ensure this procedure gives a different
+   end Send;                       -- result than CC30001_1.Send.
+
+end CC30001_2;
+
+
+     --==================================================================--
+
+
+-- User first sets up support for mail messages by instantiating the
+-- generic mail package for the root message type. An operation "Send" is
+-- declared for the mail message type in the instance.
+--
+-- with CC30001_0;  -- Root message type.
+-- with CC30001_1;  -- Generic "mail" package.
+-- package Mail_Messages is new CC30001_1 (CC30001_0.Msg_Type);
+
+
+     --==================================================================--
+
+
+-- Next, the user sets up support for system messages by instantiating the
+-- generic mail package with the system message type. An operation "Send"
+-- is declared for the "system" mail message type in the instance. This
+-- operation overrides the "Send" operation inherited from the system
+-- message type actual (a situation the user may not have intended).
+
+with CC30001_1;  -- Generic "mail" package.
+with CC30001_2;  -- System message type and operations.
+pragma Elaborate (CC30001_1);
+package CC30001_3 is new CC30001_1 (CC30001_2.Sys_Message);
+
+
+     --==================================================================--
+
+with CC30001_2;  -- System message type and operations.
+with CC30001_3;  -- Instance with mail type and operations.
+
+with Report;
+procedure CC30001 is
+
+   package System_Messages renames CC30001_3;
+
+
+   Sys_Msg1 : System_Messages.Mail_Type := (Text   => "System shutting down",
+                                            Signal => CC30001_2.Warning,
+                                            To     => "AllUsers",
+                                            Message_Sent => False);
+
+   Sys_Msg2 : System_Messages.Mail_Type'Class := Sys_Msg1;
+
+
+   use System_Messages, CC30001_2;                 -- All versions of "Send"
+                                                   -- directly visible.
+
+begin
+
+   Report.Test ("CC30001", "Check that if a non-overriding primitive "     &
+                "subprogram is declared for a type derived from a formal " &
+                "derived tagged type, the copy of that subprogram in an "  &
+                "instance can override a subprogram inherited from the "   &
+                "actual type");
+
+
+   Send (Sys_Msg1);   -- Calls version declared in instance (version declared
+                      -- in CC30001_2 has been overridden).
+
+   if not Sys_Msg1.Message_Sent then
+      Report.Failed ("Non-dispatching call: instance operation not called");
+   end if;
+
+
+   Send (Sys_Msg2);   -- Calls version declared in instance (version declared
+                      -- in CC30001_2 has been overridden).
+
+   if not Sys_Msg2.Message_Sent then
+      Report.Failed ("Dispatching call: instance operation not called");
+   end if;
+
+
+   Report.Result;
+end CC30001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc30002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc30002.a
new file mode 100644
index 000000000..5132f8cae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc30002.a
@@ -0,0 +1,349 @@
+-- CC30002.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 an explicit declaration in the private part of an instance
+--      does not override an implicit declaration in the instance, unless the
+--	corresponding explicit declaration in the generic overrides a
+--      corresponding implicit declaration in the generic. Check for primitive
+--      subprograms of tagged types.
+--
+-- TEST DESCRIPTION:
+--      Consider the following:
+--
+--         type Ancestor is tagged null record;
+--         procedure R (X: in Ancestor);
+--
+--         generic
+--            type Formal is new Ancestor with private;
+--         package G is
+--            type T is new Formal with null record;
+--            -- Implicit procedure R (X: in T);
+--            procedure P (X: in T);  -- (1)
+--         private
+--            procedure Q (X: in T);  -- (2)
+--            procedure R (X: in T);  -- (3) Overrides implicit R in generic.
+--         end G;
+--
+--         type Actual is new Ancestor with null record;
+--         procedure P (X: in Actual);
+--         procedure Q (X: in Actual);
+--         procedure R (X: in Actual);
+--
+--         package Instance is new G (Formal => Actual);
+--
+--      In the instance, the copy of P at (1) overrides Actual's P, since it
+--      is declared in the visible part of the instance. The copy of Q at (2)
+--      does not override anything. The copy of R at (3) overrides Actual's
+--      R, even though it is declared in the private part, because within
+--      the generic the explicit declaration of R overrides an implicit
+--      declaration.
+--
+--      Thus, for calls involving a parameter with tag T:
+--         - Calls to P will execute the body declared for T.
+--         - Calls to Q from within Instance will execute the body declared
+--           for T.
+--         - Calls to Q from outside Instance will execute the body declared
+--           for Actual.
+--         - Calls to R will execute the body declared for T.
+--
+--      Verify this behavior for both dispatching and nondispatching calls to
+--      Q and R. 
+--
+--
+-- CHANGE HISTORY:
+--      24 Feb 95   SAIC    Initial prerelease version.
+--
+--!
+
+package CC30002_0 is
+
+   type TC_Body_Kind is (Body_Of_Ancestor, Body_In_Instance,
+                         Body_Of_Actual,   Initial_Value);
+
+   type Camera is tagged record
+      -- ... Camera components.
+      TC_Focus_Called   : TC_Body_Kind := Initial_Value;
+      TC_Shutter_Called : TC_Body_Kind := Initial_Value;
+   end record;
+
+   procedure Focus (C: in out Camera);
+
+   -- ...Other operations.
+
+end CC30002_0;
+
+
+     --==================================================================--
+
+
+package body CC30002_0 is
+
+   procedure Focus (C: in out Camera) is
+   begin
+      -- Artificial for testing purposes.
+      C.TC_Focus_Called := Body_Of_Ancestor;
+   end Focus;
+
+end CC30002_0;
+
+
+     --==================================================================--
+
+
+with CC30002_0;
+use  CC30002_0;
+generic
+   type Camera_Type is new CC30002_0.Camera with private;
+package CC30002_1 is
+
+   type Speed_Camera is new Camera_Type with record
+      Diag_Code: Positive;
+      -- ...Other components.
+   end record;
+
+   -- Implicit procedure Focus (C: in out Speed_Camera) declared in generic.
+   procedure Self_Test_NonDisp (C: in out Speed_Camera);
+   procedure Self_Test_Disp    (C: in out Speed_Camera'Class);
+
+private
+
+   -- The following explicit declaration of Set_Shutter_Speed does NOT override
+   -- a corresponding implicit declaration in the generic. Therefore, its copy
+   -- does NOT override the implicit declaration (inherited from the actual)
+   -- in the instance.
+
+   procedure Set_Shutter_Speed (C: in out Speed_Camera);
+
+   -- The following explicit declaration of Focus DOES override a
+   -- corresponding implicit declaration (inherited from the parent) in the
+   -- generic. Therefore, its copy overrides the implicit declaration
+   -- (inherited from the actual) in the instance.
+
+   procedure Focus (C: in out Speed_Camera);  -- Overrides implicit Focus
+                                              -- in generic.
+end CC30002_1;
+
+
+     --==================================================================--
+
+
+package body CC30002_1 is
+
+   procedure Self_Test_NonDisp (C: in out Speed_Camera) is
+   begin
+      -- Nondispatching calls:
+      Focus (C);
+      Set_Shutter_Speed (C);
+   end Self_Test_NonDisp;
+
+   procedure Self_Test_Disp (C: in out Speed_Camera'Class) is
+   begin
+      -- Dispatching calls:
+      Focus (C);
+      Set_Shutter_Speed (C);
+   end Self_Test_Disp;
+
+   procedure Set_Shutter_Speed (C: in out Speed_Camera) is
+   begin
+      -- Artificial for testing purposes.
+      C.TC_Shutter_Called := Body_In_Instance;
+   end Set_Shutter_Speed;
+
+   procedure Focus (C: in out Speed_Camera) is
+   begin
+      -- Artificial for testing purposes.
+      C.TC_Focus_Called := Body_In_Instance;
+   end Focus;
+
+end CC30002_1;
+
+
+     --==================================================================--
+
+
+with CC30002_0;
+package CC30002_2 is
+
+   type Aperture_Camera is new CC30002_0.Camera with record
+      FStop: Natural;
+      -- ...Other components.
+   end record;
+
+   procedure Set_Shutter_Speed (C: in out Aperture_Camera);
+   procedure Focus (C: in out Aperture_Camera);
+
+end CC30002_2;
+
+
+     --==================================================================--
+
+
+package body CC30002_2 is
+
+   procedure Set_Shutter_Speed (C: in out Aperture_Camera) is
+      use CC30002_0;
+   begin
+      -- Artificial for testing purposes.
+      C.TC_Shutter_Called := Body_Of_Actual;
+   end Set_Shutter_Speed;
+
+   procedure Focus (C: in out Aperture_Camera) is
+      use CC30002_0;
+   begin
+      -- Artificial for testing purposes.
+      C.TC_Focus_Called := Body_Of_Actual;
+   end Focus;
+
+end CC30002_2;
+
+
+     --==================================================================--
+
+
+-- Instance declaration.
+
+with CC30002_1;
+with CC30002_2;
+package CC30002_3 is new CC30002_1 (Camera_Type => CC30002_2.Aperture_Camera);
+
+
+     --==================================================================--
+
+
+with CC30002_0;
+with CC30002_1;
+with CC30002_2;
+with CC30002_3; -- Instance.
+
+with Report;
+procedure CC30002 is
+
+   package Speed_Cameras renames CC30002_3;
+
+   use CC30002_0;
+
+   TC_Camera1: Speed_Cameras.Speed_Camera;
+   TC_Camera2: Speed_Cameras.Speed_Camera'Class := TC_Camera1;
+   TC_Camera3: Speed_Cameras.Speed_Camera;
+   TC_Camera4: Speed_Cameras.Speed_Camera;
+
+begin
+   Report.Test ("CC30002", "Check that an explicit declaration in the "      &
+                "private part of an instance does not override an implicit " &
+                "declaration in the instance, unless the corresponding "     &
+                "explicit declaration in the generic overrides a "           &
+                "corresponding implicit declaration in the generic. Check "  &
+                "for primitive subprograms of tagged types");
+
+--
+-- Check non-dispatching calls outside instance:
+--
+
+   -- Non-overriding primitive operation:
+
+   Speed_Cameras.Set_Shutter_Speed (TC_Camera1);
+   if TC_Camera1.TC_Shutter_Called /= Body_Of_Actual then
+      Report.Failed ("Wrong body executed: non-dispatching call to " &
+                     "Set_Shutter_Speed outside instance");
+   end if;
+
+
+   -- Overriding primitive operation:
+
+   Speed_Cameras.Focus (TC_Camera1);
+   if TC_Camera1.TC_Focus_Called /= Body_In_Instance then
+      Report.Failed ("Wrong body executed: non-dispatching call to " &
+                     "Focus outside instance");
+   end if;
+
+
+--
+-- Check dispatching calls outside instance:
+--
+
+   -- Non-overriding primitive operation:
+
+   Speed_Cameras.Set_Shutter_Speed (TC_Camera2);
+   if TC_Camera2.TC_Shutter_Called /= Body_Of_Actual then
+      Report.Failed ("Wrong body executed: dispatching call to " &
+                     "Set_Shutter_Speed outside instance");
+   end if;
+
+
+   -- Overriding primitive operation:
+
+   Speed_Cameras.Focus (TC_Camera2);
+   if TC_Camera2.TC_Focus_Called /= Body_In_Instance then
+      Report.Failed ("Wrong body executed: dispatching call to " &
+                     "Focus outside instance");
+   end if;
+
+
+
+--
+-- Check non-dispatching calls within instance:
+--
+
+   Speed_Cameras.Self_Test_NonDisp (TC_Camera3);
+
+   -- Non-overriding primitive operation:
+
+   if TC_Camera3.TC_Shutter_Called /= Body_In_Instance then
+      Report.Failed ("Wrong body executed: non-dispatching call to " &
+                     "Set_Shutter_Speed inside instance");
+   end if;
+
+   -- Overriding primitive operation:
+
+   if TC_Camera3.TC_Focus_Called /= Body_In_Instance then
+      Report.Failed ("Wrong body executed: non-dispatching call to " &
+                     "Focus inside instance");
+   end if;
+
+
+
+--
+-- Check dispatching calls within instance:
+--
+
+   Speed_Cameras.Self_Test_Disp (TC_Camera4);
+
+   -- Non-overriding primitive operation:
+
+   if TC_Camera4.TC_Shutter_Called /= Body_In_Instance then
+      Report.Failed ("Wrong body executed: dispatching call to " &
+                     "Set_Shutter_Speed inside instance");
+   end if;
+
+   -- Overriding primitive operation:
+
+   if TC_Camera4.TC_Focus_Called /= Body_In_Instance then
+      Report.Failed ("Wrong body executed: dispatching call to " &
+                     "Focus inside instance");
+   end if;
+
+   Report.Result;
+end CC30002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3004a.ada
new file mode 100644
index 000000000..5e65adf63
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3004a.ada
@@ -0,0 +1,87 @@
+-- CC3004A.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 ACTUAL PARAMETERS IN A NAMED GENERIC ACTUAL PARAMETER 
+-- ASSOCIATION MAY BE OUT OF ORDER, AND ARE ASSOCIATED WITH THE 
+-- CORRECT FORMALS.
+
+-- DAT 9/16/81 
+-- SPS 10/26/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3004A IS 
+BEGIN
+     TEST ("CC3004A", "ORDER OF NAMED GENERIC ACTUAL PARAMETERS");
+
+     DECLARE
+          GENERIC
+               A,B : INTEGER;
+               C : INTEGER;
+               D : INTEGER;
+          PACKAGE P1 IS END P1;
+
+          TYPE AI IS ACCESS INTEGER;
+
+          GENERIC
+               TYPE D IS ( <> );
+               VD : D;
+               TYPE AD IS ACCESS D;
+               VA : AD;
+          PACKAGE P2 IS END P2;
+
+          X : AI := NEW INTEGER '(IDENT_INT(23));
+          Y : AI := NEW INTEGER '(IDENT_INT(77));
+
+          PACKAGE BODY P1 IS
+          BEGIN
+               IF A /= IDENT_INT(4)  OR
+                  B /= IDENT_INT(12) OR
+                  C /= IDENT_INT(11) OR
+                  D /= IDENT_INT(-33)
+               THEN
+                    FAILED ("WRONG GENERIC PARAMETER ASSOCIATIONS");
+               END IF;
+          END P1;
+
+          PACKAGE BODY P2 IS
+          BEGIN
+               IF VA.ALL /= VD THEN 
+                    FAILED ("WRONG GENERIC PARM ASSOCIATIONS 2");
+               END IF;
+          END P2;
+
+          PACKAGE N1 IS NEW P1 (C => 11, A => 4, D => -33, B => 12);
+
+          PACKAGE N2 IS NEW P2 (VA => X, AD => AI, D => INTEGER, 
+                                VD => 23);
+
+          PACKAGE N3 IS NEW P2 (INTEGER, 77, VA => Y, AD => AI);
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC3004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3007a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3007a.ada
new file mode 100644
index 000000000..e9d6daa8d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3007a.ada
@@ -0,0 +1,118 @@
+-- CC3007A.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 NAMES IN A GENERIC DECLARATIONS ARE STATICALLY BOUND.
+
+-- DAT 9/18/81
+-- SPS 2/7/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3007A IS
+BEGIN
+     TEST ("CC3007A", "NAMES IN GENERICS ARE STATICALLY BOUND");
+
+     DECLARE
+          I : INTEGER := 1;
+          EX : EXCEPTION;
+          IA : INTEGER := I'SIZE;
+
+          FUNCTION F (X : INTEGER) RETURN INTEGER;
+
+          PACKAGE P IS
+               Q : INTEGER := 1;
+          END P;
+
+          GENERIC
+               J : IN OUT INTEGER;
+               WITH FUNCTION FP (X : INTEGER) RETURN INTEGER IS F;
+          PACKAGE GP IS
+               V1 : INTEGER := F(I);
+               V2 : INTEGER := FP(I);
+          END GP;
+
+          GENERIC
+               TYPE T IS RANGE <> ;
+               WITH FUNCTION F1 (X : INTEGER) RETURN INTEGER IS F;
+               INP : IN T := T (I'SIZE);
+          FUNCTION F1 (X : T) RETURN T;
+
+          FUNCTION F1 (X : T) RETURN T IS
+          BEGIN
+               IF INP /= T(IA) THEN
+                    FAILED ("INCORRECT GENERIC BINDING 2");
+               END IF;
+               I := I + 1;
+               RETURN 2 * T (F1 (F (INTEGER (X) + I + P.Q)));
+          END F1;
+
+          PACKAGE BODY GP IS
+               PACKAGE P IS
+                    Q : INTEGER := I + 1;
+               END P;
+               I : INTEGER := 1000;
+               FUNCTION F IS NEW F1 (INTEGER);
+               FUNCTION F2 IS NEW F1 (INTEGER);
+          BEGIN
+               P.Q := F2 (J + P.Q + V1 + 2 * V2);
+               J := P.Q;
+               RAISE EX;
+          END GP;
+
+          FUNCTION F (X : INTEGER) RETURN INTEGER IS
+          BEGIN
+               I := I + 2;
+               RETURN X + I;
+          END;
+     BEGIN
+          DECLARE
+               I : INTEGER := 1000;
+               EX : EXCEPTION;
+               FUNCTION F IS NEW F1 (INTEGER);
+               V : INTEGER := F (3);
+          BEGIN
+               BEGIN
+                    DECLARE
+                         PACKAGE P IS NEW GP (V);
+                    BEGIN
+                         FAILED ("EX NOT RAISED");
+                    END;
+               EXCEPTION
+                    WHEN EX =>
+                         FAILED ("WRONG EXCEPTION RAISED");
+                    WHEN OTHERS =>
+                         IF V /= 266 THEN
+                              FAILED ("WRONG BINDING IN GENERICS");
+                         END IF;
+                         RAISE;
+               END;
+
+          END;
+     EXCEPTION
+          WHEN EX => NULL;
+          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
+     END;
+
+     RESULT;
+END CC3007A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada
new file mode 100644
index 000000000..22bd4c0a3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada
@@ -0,0 +1,397 @@
+-- CC3007B.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 NAMES IN A GENERIC INSTANTIATION ARE STATICALLY
+--  IDENTIFIED (I.E., BOUND) AT THE TEXTUAL POINT OF THE INSTANTIA-
+--  TION, AND ARE BOUND BEFORE BEING "SUBSTITUTED" FOR THE COR-
+--  RESPONDING GENERIC FORMAL PARAMETERS IN THE SPECIFICATION AND
+--  BODY TEMPLATES.
+--
+--  SEE AI-00365/05-BI-WJ.
+
+-- HISTORY:
+--      EDWARD V. BERARD, 15 AUGUST 1990
+--      DAS   08 OCT 90   CHANGED INSTANTIATIONS TO USE VARIABLES
+--                        M1 AND M2 IN THE FIRST_BLOCK INSTANTIA-
+--                        TION AND TO ASSIGN THIRD_DATE AND
+--                        FOURTH_DATE VALUES BEFORE AND AFTER THE
+--                        SECOND_BLOCK INSTANTIATION.
+
+WITH REPORT;
+
+PROCEDURE CC3007B IS
+
+     INCREMENTED_VALUE : NATURAL := 0;
+
+     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                         SEP, OCT, NOV, DEC);
+     TYPE DAY_TYPE IS RANGE 1 .. 31;
+     TYPE YEAR_TYPE IS RANGE 1904 .. 2050;
+     TYPE DATE IS RECORD
+          MONTH : MONTH_TYPE;
+          DAY   : DAY_TYPE;
+          YEAR  : YEAR_TYPE;
+     END RECORD;
+
+     TYPE DATE_ACCESS IS ACCESS DATE;
+
+     TODAY           : DATE := (MONTH => AUG,
+                                DAY   => 8,
+                                YEAR  => 1990);
+
+     CHRISTMAS       : DATE := (MONTH => DEC,
+                                DAY   => 25,
+                                YEAR  => 1948);
+
+     WALL_DATE       : DATE := (MONTH => NOV,
+                                DAY   => 9,
+                                YEAR  => 1989);
+
+     BIRTH_DATE     : DATE := (MONTH => OCT,
+                               DAY   => 3,
+                               YEAR  => 1949);
+
+     FIRST_DUE_DATE : DATE := (MONTH => JAN,
+                               DAY   => 23,
+                               YEAR  => 1990);
+
+     LAST_DUE_DATE  : DATE := (MONTH => DEC,
+                               DAY   => 20,
+                               YEAR  => 1990);
+
+     THIS_MONTH    : MONTH_TYPE := AUG;
+
+     STORED_RECORD : DATE := TODAY;
+
+     STORED_INDEX  : MONTH_TYPE := AUG;
+
+     FIRST_DATE   : DATE_ACCESS := NEW DATE'(WALL_DATE);
+     SECOND_DATE  : DATE_ACCESS := FIRST_DATE;
+
+     THIRD_DATE     : DATE_ACCESS := NEW DATE'(BIRTH_DATE);
+     FOURTH_DATE  : DATE_ACCESS := NEW DATE'(CHRISTMAS);
+
+     TYPE DUE_DATES IS ARRAY (MONTH_TYPE RANGE JAN .. DEC) OF DATE;
+     REPORT_DATES : DUE_DATES := ((JAN, 23, 1990), (FEB, 23, 1990),
+                                  (MAR, 23, 1990), (APR, 23, 1990),
+                                  (MAY, 23, 1990), (JUN, 22, 1990),
+                                  (JUL, 23, 1990), (AUG, 23, 1990),
+                                  (SEP, 24, 1990), (OCT, 23, 1990),
+                                  (NOV, 23, 1990), (DEC, 20, 1990));
+
+     GENERIC
+
+          NATURALLY     : IN NATURAL;
+          FIRST_RECORD  : IN OUT DATE;
+          SECOND_RECORD : IN OUT DATE;
+          TYPE RECORD_POINTER IS ACCESS DATE;
+          POINTER : IN OUT RECORD_POINTER;
+          TYPE ARRAY_TYPE IS ARRAY (MONTH_TYPE) OF DATE;
+          THIS_ARRAY           : IN OUT ARRAY_TYPE;
+          FIRST_ARRAY_ELEMENT  : IN OUT DATE;
+          SECOND_ARRAY_ELEMENT : IN OUT DATE;
+          INDEX_ELEMENT        : IN OUT MONTH_TYPE;
+          POINTER_TEST         : IN OUT DATE;
+          ANOTHER_POINTER_TEST : IN OUT DATE;
+
+     PACKAGE TEST_ACTUAL_PARAMETERS IS
+
+          PROCEDURE EVALUATE_FUNCTION;
+          PROCEDURE CHECK_RECORDS;
+          PROCEDURE CHECK_ACCESS;
+          PROCEDURE CHECK_ARRAY;
+          PROCEDURE CHECK_ARRAY_ELEMENTS;
+          PROCEDURE CHECK_SCALAR;
+          PROCEDURE CHECK_POINTERS;
+
+     END TEST_ACTUAL_PARAMETERS;
+
+     PACKAGE BODY TEST_ACTUAL_PARAMETERS IS
+
+          PROCEDURE EVALUATE_FUNCTION IS
+          BEGIN  -- EVALUATE_FUNCTION
+
+               IF (INCREMENTED_VALUE = 0) OR 
+                  (NATURALLY /= INCREMENTED_VALUE) THEN
+                    REPORT.FAILED ("PROBLEMS EVALUATING FUNCTION " &
+                                   "PARAMETER.");
+               END IF;
+
+          END EVALUATE_FUNCTION;
+
+          PROCEDURE CHECK_RECORDS IS
+
+               STORE : DATE;
+
+          BEGIN  -- CHECK_RECORDS
+
+               IF STORED_RECORD /= FIRST_RECORD THEN
+                    REPORT.FAILED ("PROBLEM WITH RECORD TYPES");
+               ELSE
+                    STORED_RECORD := SECOND_RECORD;
+                    STORE := FIRST_RECORD;
+                    FIRST_RECORD := SECOND_RECORD;
+                    SECOND_RECORD := STORE;
+               END IF;
+
+          END CHECK_RECORDS;
+
+          PROCEDURE CHECK_ACCESS IS
+          BEGIN  -- CHECK_ACCESS
+
+               IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+               THEN
+                    IF POINTER.ALL /= DATE'(WALL_DATE) THEN
+                         REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " &
+                                        "- 1");
+                    ELSE
+                         POINTER.ALL := DATE'(BIRTH_DATE);
+                    END IF;
+               ELSE
+                    IF POINTER.ALL /= DATE'(BIRTH_DATE) THEN
+                         REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " &
+                                        "- 2");
+                    ELSE
+                         POINTER.ALL := DATE'(WALL_DATE);
+                    END IF;
+               END IF;
+
+          END CHECK_ACCESS;
+
+          PROCEDURE CHECK_ARRAY IS
+
+               STORE : DATE;
+
+          BEGIN  -- CHECK_ARRAY
+
+               IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+               THEN
+                    IF THIS_ARRAY (THIS_ARRAY'FIRST) /= FIRST_DUE_DATE
+                    THEN
+                         REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 1");
+                    ELSE
+                         THIS_ARRAY (THIS_ARRAY'FIRST) := LAST_DUE_DATE;
+                         THIS_ARRAY (THIS_ARRAY'LAST) := FIRST_DUE_DATE;
+                    END IF;
+               ELSE
+                    IF THIS_ARRAY (THIS_ARRAY'FIRST) /= LAST_DUE_DATE
+                    THEN
+                         REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 2");
+                    ELSE
+                         THIS_ARRAY (THIS_ARRAY'FIRST) :=
+                                                  FIRST_DUE_DATE;
+                         THIS_ARRAY (THIS_ARRAY'LAST)  := LAST_DUE_DATE;
+                    END IF;
+               END IF;
+
+          END CHECK_ARRAY;
+
+          PROCEDURE CHECK_ARRAY_ELEMENTS IS
+
+               STORE : DATE;
+
+          BEGIN  -- CHECK_ARRAY_ELEMENTS
+
+               IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+               THEN
+                    IF (FIRST_ARRAY_ELEMENT.MONTH /= MAY) OR
+                       (SECOND_ARRAY_ELEMENT.DAY /= 22) THEN
+                         REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
+                                        "- 1");
+                    ELSE
+                         STORE := FIRST_ARRAY_ELEMENT;
+                         FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
+                         SECOND_ARRAY_ELEMENT := STORE;
+                    END IF;
+               ELSE
+                    IF (FIRST_ARRAY_ELEMENT.MONTH /= JUN) OR
+                       (SECOND_ARRAY_ELEMENT.DAY /= 23) THEN
+                         REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " &
+                                        "- 2");
+                    ELSE
+                         STORE := FIRST_ARRAY_ELEMENT;
+                         FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT;
+                         SECOND_ARRAY_ELEMENT := STORE;
+                    END IF;
+               END IF;
+
+          END CHECK_ARRAY_ELEMENTS;
+
+          PROCEDURE CHECK_SCALAR IS
+          BEGIN  -- CHECK_SCALAR
+
+               IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+               THEN
+                    IF INDEX_ELEMENT /= STORED_INDEX THEN
+                         REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 1");
+                    ELSE
+                         INDEX_ELEMENT :=
+                                   MONTH_TYPE'SUCC(INDEX_ELEMENT);
+                         STORED_INDEX := INDEX_ELEMENT;
+                    END IF;
+               ELSE
+                    IF INDEX_ELEMENT /= STORED_INDEX THEN
+                         REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 2");
+                    ELSE
+                         INDEX_ELEMENT :=
+                              MONTH_TYPE'PRED (INDEX_ELEMENT);
+                         STORED_INDEX := INDEX_ELEMENT;
+                    END IF;
+               END IF;
+
+          END CHECK_SCALAR;
+
+          PROCEDURE CHECK_POINTERS IS
+
+               STORE : DATE;
+
+          BEGIN  -- CHECK_POINTERS
+
+               IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE
+               THEN
+                    IF (POINTER_TEST /= DATE'(OCT, 3, 1949)) OR
+                       (ANOTHER_POINTER_TEST /= DATE'(DEC, 25, 1948))
+                    THEN
+                         REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
+                                        "- 1");
+                    ELSE
+                         STORE := POINTER_TEST;
+                         POINTER_TEST := ANOTHER_POINTER_TEST;
+                         ANOTHER_POINTER_TEST := STORE;
+                    END IF;
+               ELSE
+                    IF (POINTER_TEST /= DATE'(DEC, 25, 1948)) OR
+                       (ANOTHER_POINTER_TEST /= DATE'(OCT, 3, 1949))
+                    THEN
+                         REPORT.FAILED ("PROBLEM WITH POINTER TEST " &
+                                        "- 2");
+                    ELSE
+                         STORE := POINTER_TEST;
+                         POINTER_TEST := ANOTHER_POINTER_TEST;
+                         ANOTHER_POINTER_TEST := STORE;
+                    END IF;
+               END IF;
+
+          END CHECK_POINTERS;
+
+     END TEST_ACTUAL_PARAMETERS;
+
+     FUNCTION INC RETURN NATURAL IS
+     BEGIN  -- INC
+          INCREMENTED_VALUE := NATURAL'SUCC (INCREMENTED_VALUE);
+          RETURN INCREMENTED_VALUE;
+     END INC;
+
+BEGIN  -- CC3007B
+
+     REPORT.TEST ("CC3007B", "CHECK THAT THE NAMES IN A GENERIC " &
+                  "INSTANTIATION ARE STAICALLY IDENTIFIED (I.E., " &
+                  "BOUND) AT THE TEXTUAL POINT OF THE INSTANTIATION" &
+                  ", AND ARE BOUND BEFORE BEING SUBSTITUTED FOR " &
+                  "THE CORRESPONDING GENERIC FORMAL PARAMETERS IN " &
+                  "THE SPECIFICATION AND BODY TEMPLATES.  " &
+                  "SEE AI-00365/05-BI-WJ.");
+
+     FIRST_BLOCK:
+
+     DECLARE
+
+          M1 : MONTH_TYPE := MAY;
+          M2 : MONTH_TYPE := JUN;
+
+          PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
+               NEW TEST_ACTUAL_PARAMETERS (
+                    NATURALLY              => INC,
+                    FIRST_RECORD           => TODAY,
+                    SECOND_RECORD          => CHRISTMAS,
+                    RECORD_POINTER         => DATE_ACCESS,
+                    POINTER                => SECOND_DATE,
+                    ARRAY_TYPE             => DUE_DATES,
+                    THIS_ARRAY             => REPORT_DATES,
+                    FIRST_ARRAY_ELEMENT    => REPORT_DATES (M1),
+                    SECOND_ARRAY_ELEMENT   => REPORT_DATES (M2),
+                    INDEX_ELEMENT          => THIS_MONTH,
+                    POINTER_TEST           => THIRD_DATE.ALL,
+                    ANOTHER_POINTER_TEST   => FOURTH_DATE.ALL);
+
+     BEGIN  -- FIRST_BLOCK
+
+          REPORT.COMMENT ("ENTERING FIRST BLOCK");
+          NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
+          M1 := SEP;
+          M2 := OCT;
+          -- NEW_TEST_ACTUAL_PARAMETERS SHOULD USE THE PREVIOUS
+          -- VALUES OF MAY AND JUN.
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS;
+
+     END FIRST_BLOCK;
+
+     SECOND_BLOCK:
+
+     DECLARE
+
+          SAVE_THIRD_DATE  : DATE_ACCESS := THIRD_DATE;
+          SAVE_FOURTH_DATE : DATE_ACCESS := FOURTH_DATE;
+
+          PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS
+               NEW TEST_ACTUAL_PARAMETERS (
+                    NATURALLY              => INC,
+                    FIRST_RECORD           => TODAY,
+                    SECOND_RECORD          => CHRISTMAS,
+                    RECORD_POINTER         => DATE_ACCESS,
+                    POINTER                => SECOND_DATE,
+                    ARRAY_TYPE             => DUE_DATES,
+                    THIS_ARRAY             => REPORT_DATES,
+                    FIRST_ARRAY_ELEMENT    => REPORT_DATES (MAY),
+                    SECOND_ARRAY_ELEMENT   => REPORT_DATES (JUN),
+                    INDEX_ELEMENT          => THIS_MONTH,
+                    POINTER_TEST           => THIRD_DATE.ALL,
+                    ANOTHER_POINTER_TEST   => FOURTH_DATE.ALL);
+
+     BEGIN  -- SECOND_BLOCK
+
+          REPORT.COMMENT ("ENTERING SECOND BLOCK");
+          NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS;
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS;
+
+          THIRD_DATE := NEW DATE'(JUL, 13, 1951);
+          FOURTH_DATE := NEW DATE'(JUL, 4, 1976);
+          NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS;
+          THIRD_DATE := SAVE_THIRD_DATE;
+          FOURTH_DATE := SAVE_FOURTH_DATE;
+
+     END SECOND_BLOCK;
+
+     REPORT.RESULT;
+
+END CC3007B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3011a.ada
new file mode 100644
index 000000000..8ecba226e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3011a.ada
@@ -0,0 +1,131 @@
+-- CC3011A.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 SUBPROGRAMS THAT WOULD HAVE THE SAME SPECIFICATION
+-- AFTER GENERIC INSTANTIATION MAY BE DECLARED IN THE SAME
+-- DECLARATIVE PART, AND THAT CALLS WITHIN THE INSTANTIATED UNIT ARE
+-- UNAMBIGUOUS.  CHECK THAT CALLS FROM OUTSIDE THE UNIT ARE UNAMBIGUOUS
+-- IF FORMAL PARAMETER NAMES ARE USED OR IF ONLY ONE OF THE EQUIVALENT
+-- PROGRAMS APPEARS IN THE VISIBLE PART OF THE PACKAGE.
+
+-- DAT 9/18/81
+-- SPS 10/19/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3011A IS
+BEGIN
+     TEST ("CC3011A", "CHECK SUBPROGRAMS IN GENERIC PACKAGES WITH SAME"
+          & " SPECIFICATION AFTER GENERIC PARAMETER SUBSTITUTION");
+
+     DECLARE
+          C : INTEGER := 0;
+
+          GENERIC
+               TYPE S IS ( <> );
+               TYPE T IS PRIVATE;
+               TYPE U IS RANGE <> ;
+               VT : T;
+          PACKAGE PKG IS
+               PROCEDURE P1 (X : S);
+          PRIVATE
+               PROCEDURE P1 (X : T);
+               VS : S := S'FIRST;
+               VU : U := U'FIRST;
+          END PKG;
+
+          GENERIC
+               TYPE S IS (<>);
+               TYPE T IS RANGE <>;
+          PACKAGE PP IS
+               PROCEDURE P1 (D: S);
+               PROCEDURE P1 (X: T);
+          END PP;
+
+          PACKAGE BODY PKG IS
+               PROCEDURE P1 (X : S) IS 
+               BEGIN
+                    C := C + 1;
+               END P1;
+               PROCEDURE P1 (X : T) IS
+               BEGIN
+                    C := C + 2;
+               END P1;
+               PROCEDURE P1 (X : U) IS
+               BEGIN
+                    C := C + 4;
+               END P1;
+          BEGIN
+               C := 0;
+               P1 (VS);
+               IF C /= IDENT_INT (1) THEN
+                    FAILED ("WRONG P1 CALLED -S");
+               END IF;
+               C := 0;
+               P1 (VT);
+               IF C /= IDENT_INT (2) THEN
+                    FAILED ("WRONG P1 CALLED -T");
+               END IF;
+               C := 0;
+               P1 (VU);
+               IF C /= IDENT_INT (4) THEN
+                    FAILED ("WRONG P1 CALLED -U");
+               END IF;
+               C := 0;
+          END PKG;
+
+          PACKAGE BODY PP IS
+               PROCEDURE P1 (D: S) IS
+               BEGIN
+                    C := C + 3;
+               END P1;
+               PROCEDURE P1 (X: T) IS
+               BEGIN
+                    C := C + 5;
+               END P1;
+          BEGIN
+               NULL;
+          END PP;
+
+          PACKAGE NP IS NEW PKG (INTEGER, INTEGER, INTEGER, 7);
+          PACKAGE NPP IS NEW PP (INTEGER, INTEGER);
+     BEGIN
+          NP.P1 (4);
+          IF C /= IDENT_INT (1) THEN
+               FAILED ("INCORRECT OVERLOADING ON FORMAL TYPES");
+          END IF;
+          C := 0;
+          NPP.P1 (D => 3);
+          IF C /= IDENT_INT (3) THEN
+               FAILED ("INCORRECT CALL TO P1 WITH D PARAMETER");
+          END IF;
+          C := 0;
+          NPP.P1 (X => 7);
+          IF C /= IDENT_INT (5) THEN
+               FAILED ("INCORRECT CALL TO P1 WITH X PARAMETER");
+          END IF;
+     END;
+
+     RESULT;
+END CC3011A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3011d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3011d.ada
new file mode 100644
index 000000000..26dfde26a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3011d.ada
@@ -0,0 +1,84 @@
+-- CC3011D.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 WHEN A GENERIC PACKAGE INSTANTIATION CONTAINS DECLARATIONS
+-- OF SUBPROGRAMS WITH THE SAME SPECIFICATIONS, THE CALLS TO THE
+-- SUBPROGRAMS ARE NOT AMBIGIOUS WITHIN THE GENERIC BODY.
+
+-- SPS 5/7/82
+-- SPS 2/7/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3011D IS
+BEGIN
+     TEST ("CC3011D", "SUBPROGRAMS WITH SAME SPECIFICATIONS NOT"
+          & " AMBIGIOUS WITHIN GENERIC BODY");
+
+     DECLARE
+          TYPE FLAG IS (PRT,PRS);
+          XX : FLAG;
+
+          GENERIC
+               TYPE S IS PRIVATE;
+               TYPE T IS PRIVATE;
+               V1 : S;
+               V2 : T;
+          PACKAGE P1 IS
+               PROCEDURE PR(X : S);
+               PROCEDURE PR(X : T);
+          END P1;
+
+          PACKAGE BODY P1 IS
+               PROCEDURE PR (X : S) IS
+               BEGIN
+                    XX := PRS;
+               END;
+
+               PROCEDURE PR (X : T ) IS
+               BEGIN
+                    XX := PRT;
+               END;
+
+          BEGIN
+               XX := PRT;
+               PR (V1);
+               IF XX /= PRS THEN
+                    FAILED ("WRONG BINDING FOR PR WITH TYPE S");
+               END IF;
+               XX := PRS;
+               PR (V2);
+               IF XX /= PRT THEN
+                    FAILED ("WRONG BINDING FOR PR WITH TYPE T");
+               END IF;
+          END P1;
+
+          PACKAGE PAK IS NEW P1 (INTEGER, INTEGER, 1, 2);
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC3011D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3012a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3012a.ada
new file mode 100644
index 000000000..da465017d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3012a.ada
@@ -0,0 +1,247 @@
+-- CC3012A.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 GENERIC INSTANCES MAY BE OVERLOADED.
+
+-- CHECK THAT THEY MAY OVERLOAD PREVIOUSLY DECLARED SUBPROGRAMS AND
+-- ENUMERATION LITERALS.
+
+-- DAT 9/16/81
+-- SPS 10/19/82
+-- SPS 2/8/83
+-- PWN 11/30/94 REMOVED PART OF TEST INVALID FOR ADA 9X.
+
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3012A IS
+BEGIN
+     TEST ("CC3012A", "CHECK THAT GENERIC INSTANCES MAY OVERLOAD " &
+                      "OTHER IDENTIFIERS");
+
+     DECLARE
+          GENERIC 
+               TYPE T IS ( <> );
+               V : IN T;
+          PROCEDURE GP (X : IN OUT T);
+
+          GENERIC 
+               TYPE T IS ( <> );
+          FUNCTION LESS (X, Y : T) RETURN BOOLEAN;
+
+          GENERIC
+               TYPE T IS ( <> );
+          FUNCTION PLUS (X, Y : T) RETURN T;
+
+          GENERIC
+               TYPE T IS PRIVATE;
+               Z : T;
+          FUNCTION F1  RETURN T;
+
+          TYPE DC IS NEW CHARACTER RANGE IDENT_CHAR ('A') .. 'Z';
+          TYPE DI IS NEW INTEGER;
+          TYPE ENUM IS (E1, E2, E3, E4);
+
+          VC : CHARACTER := 'A';
+          VI : INTEGER := 5;
+          VB : BOOLEAN := TRUE;
+          VE : ENUM := E2;
+
+          TYPE DENUM IS NEW ENUM RANGE E2 .. ENUM'LAST;
+
+          VDE : DENUM := E4;
+          VDC : DC := 'A';
+          VDI : DI := 7;
+
+          PROCEDURE GP (X : IN OUT T) IS
+          BEGIN
+               X := V;
+          END GP;
+
+          FUNCTION LESS (X, Y : T) RETURN BOOLEAN IS
+          BEGIN
+               RETURN FALSE;
+          END LESS;
+
+          FUNCTION PLUS (X, Y : T) RETURN T IS
+          BEGIN
+               RETURN T'FIRST;
+          END PLUS;
+
+          FUNCTION F1 RETURN T IS
+          BEGIN
+               RETURN Z;
+          END F1;
+
+          FUNCTION E5 RETURN INTEGER IS
+          BEGIN
+               RETURN 1;
+          END E5;
+
+          PACKAGE PKG IS
+          
+               PROCEDURE P IS NEW GP (CHARACTER, 'Q');
+               PROCEDURE P IS NEW GP (INTEGER, -14);
+               PROCEDURE P IS NEW GP (BOOLEAN, FALSE);
+               PROCEDURE P IS NEW GP (ENUM, E4);
+               PROCEDURE P IS NEW GP (DC, 'W');
+               PROCEDURE P IS NEW GP (DI, -33);
+               PROCEDURE P IS NEW GP (DENUM, E2);
+     
+               FUNCTION "<" IS NEW LESS (CHARACTER);
+               FUNCTION "<" IS NEW LESS (INTEGER);
+               FUNCTION "<" IS NEW LESS (BOOLEAN);
+               FUNCTION "<" IS NEW LESS (ENUM);
+               FUNCTION "<" IS NEW LESS (DC);
+               FUNCTION "<" IS NEW LESS (DI);
+               -- NOT FOR DENUM.
+     
+               FUNCTION "+" IS NEW PLUS (CHARACTER);
+               FUNCTION "+" IS NEW PLUS (INTEGER);
+               FUNCTION "+" IS NEW PLUS (BOOLEAN);
+               FUNCTION "+" IS NEW PLUS (ENUM);
+               FUNCTION "+" IS NEW PLUS (DC);
+               -- NOT FOR DI.
+               FUNCTION "+" IS NEW PLUS (DENUM);
+
+               FUNCTION E2 IS NEW F1 (BOOLEAN, FALSE);
+               FUNCTION E5 IS NEW F1 (DC, 'M');
+
+          END PKG;
+
+          PACKAGE BODY PKG IS
+          BEGIN
+               P (VC);
+               P (VI);
+               P (VB);
+               P (VE);
+               P (X => VDE);
+               P (X => VDC);
+               P (X => VDI);
+
+               IF VC /= 'Q' THEN
+                    FAILED ("OVERLOADED PROCEDURE - 1");
+               END IF;
+
+               IF VI /= -14 THEN
+                    FAILED ("OVERLOADED PROCEDURE - 2");
+               END IF;
+
+               IF VB /= FALSE THEN
+                    FAILED ("OVERLOADED PROCEDURE - 3");
+               END IF;
+
+               IF VE /= E4 THEN
+                    FAILED ("OVERLOADED PROCEDURE - 4");
+               END IF;
+
+               IF VDE /= E2 THEN
+                    FAILED ("OVERLOADED PROCEDURE - 5");
+               END IF;
+
+               IF VDC /= 'W' THEN
+                    FAILED ("OVERLOADED PROCEDURE - 6");
+               END IF;
+
+               IF VDI /= -33 THEN
+                    FAILED ("OVERLOADED PROCEDURE - 7");
+               END IF;
+
+               IF VC  < ASCII.DEL THEN
+                    FAILED ("OVERLOADED LESS THAN - 1");
+               END IF;
+
+               IF VI < 1E3 THEN
+                    FAILED ("OVERLOADED LESS THAN - 2");
+               END IF;
+
+               IF FALSE < TRUE THEN
+                    FAILED ("OVERLOADED LESS THAN - 3");
+               END IF;
+
+               IF E1 < VE THEN
+                    FAILED ("OVERLOADED LESS THAN - 4");
+               END IF;
+
+               IF VDC < 'Z' THEN
+                    FAILED ("OVERLOADED LESS THAN - 5");
+               END IF;
+
+               IF VDI < 0 THEN
+                    FAILED ("OVERLOADED LESS THAN - 6");
+               END IF;
+
+
+               IF -14 + 5 /= -9 THEN
+                    FAILED ("OVERLOADED PLUS - 2");
+               END IF;
+
+               IF VI + 5 /= INTEGER'FIRST THEN
+                    FAILED ("OVERLOADED PLUS - 3");
+               END IF;
+
+               IF VB + TRUE /= FALSE THEN
+                    FAILED ("OVERLOADED PLUS - 4");
+               END IF;
+
+               IF VE + E2 /= E1 THEN
+                    FAILED ("OVERLOADED PLUS - 5");
+               END IF;
+
+               IF DENUM'(E3) + E2 /= E2 THEN
+                    FAILED ("OVERLOADED PLUS - 6");
+               END IF;
+
+               IF  VDC + 'B' /= 'A' THEN
+                    FAILED ("OVERLOADED PLUS - 7");
+               END IF;
+
+               IF VDI + 14 /= -19 THEN       -- -33 + 14
+                    FAILED ("OVERLOADED PLUS - 8");
+               END IF;
+
+               VI := E5;
+               VDC := E5;
+               VE := E2;
+               VB := E2;
+               IF VI /= 1 OR
+                  VDC /= 'M' OR
+                  VE /= ENUM'VAL(IDENT_INT(1)) OR
+                  VB /= FALSE THEN
+                    FAILED ("OVERLOADING OF ENUMERATION LITERALS " &
+                            "AND PREDEFINED SUBPROGRAMS");
+               END IF;
+          END PKG;
+     BEGIN
+          DECLARE
+               USE PKG;
+          BEGIN
+               IF NOT (VI + 5 < 11) THEN
+               FAILED ("INCORRECT VISIBILITY OF GENERIC OVERLOADING");
+               END IF;
+          END;
+     END;
+
+     RESULT;
+END CC3012A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3015a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3015a.ada
new file mode 100644
index 000000000..ca3543c44
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3015a.ada
@@ -0,0 +1,104 @@
+-- CC3015A.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 WHEN A GENERIC PACKAGE INSTANTIATION IS ELABORATED, 
+-- STATEMENTS IN ITS PACKAGE BODY ARE EXECUTED AND EXPRESSIONS
+-- REQUIRING EVALUATION ARE EVALUATED (E.G., DEFAULTS FOR OBJECT
+-- DECLARATIONS ARE EVALUATED).
+
+-- RJW 6/11/86
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3015A IS
+     BOOL1, BOOL2 : BOOLEAN := FALSE;          
+          
+     TYPE ENUM IS (BEFORE, AFTER);
+
+     FUNCTION F (I : INTEGER) RETURN INTEGER IS
+     BEGIN
+          BOOL2 := TRUE;
+          RETURN I;
+     END;
+          
+     FUNCTION CHECK (E : ENUM) RETURN CHARACTER IS
+     BEGIN
+          IF E = BEFORE THEN
+               IF BOOL1 THEN
+                    FAILED ( "STATEMENT EXECUTED BEFORE " &
+                             "INSTANTIATION" );
+               END IF;
+               IF BOOL2 THEN
+                    FAILED ( "DEFAULT EXPRESSION EVALUATED " &
+                             "BEFORE INSTANTIATION" );
+               END IF;
+          ELSE
+               IF BOOL1 THEN
+                    NULL;
+               ELSE
+                    FAILED ( "STATEMENT NOT EXECUTED AT " &
+                             "INSTANTIATION" );
+               END IF;
+               IF BOOL2 THEN
+                    NULL;
+               ELSE
+                    FAILED ( "DEFAULT EXPRESSION NOT EVALUATED " &
+                             "AT INSTANTIATION" );
+               END IF;
+          END IF;
+          RETURN 'A';
+      END;
+
+     GENERIC 
+          TYPE INT IS RANGE <>;
+     PACKAGE PKG IS END PKG;
+
+     PACKAGE BODY PKG IS
+          I : INT := INT'VAL (F(0));
+     BEGIN
+          BOOL1 := TRUE;
+     END;
+                         
+BEGIN
+     TEST ("CC3015A", "CHECK THAT WHEN A GENERIC PACKAGE " & 
+                      "INSTANTIATION IS ELABORATED, STATEMENTS " & 
+                      "IN ITS PACKAGE BODY ARE EXECUTED AND " &
+                      "EXPRESSIONS REQUIRING EVALUATION ARE " &
+                      "EVALUATED (E.G., DEFAULTS FOR OBJECT " &
+                      "DECLARATIONS ARE EVALUATED)" );
+     
+
+     DECLARE
+          A : CHARACTER := CHECK (BEFORE);
+
+          PACKAGE NPKG IS NEW PKG (INTEGER);
+     
+          B : CHARACTER := CHECK (AFTER);
+
+     BEGIN
+          NULL;
+     END;          
+
+     RESULT;
+END CC3015A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016b.ada
new file mode 100644
index 000000000..2fbc09062
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016b.ada
@@ -0,0 +1,396 @@
+-- CC3016B.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 INSTANCE OF A GENERIC PACKAGE MUST DECLARE A
+--  PACKAGE. CHECK THAT THE DECLARATIVE ITEMS IN AN INSTANTIATION
+--  OF A GENERIC PACKAGE SPECIFICATION ARE ELABORATED IN THE ORDER
+--  DECLARED.    
+
+-- HISTORY:
+--         EDWARD V. BERARD, 8 AUGUST 1990
+
+WITH REPORT ;
+
+PROCEDURE CC3016B IS
+     
+    WHEN_ELABORATED : NATURAL := 0 ;
+    
+    TYPE REAL IS DIGITS 6 ;
+    REAL_VALUE : REAL := 3.14159 ;
+    
+    TRUE_VALUE : BOOLEAN := TRUE ;
+    
+    CHARACTER_VALUE : CHARACTER := 'Z' ;
+          
+    TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                        SEP, OCT, NOV, DEC) ;
+    TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+    TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+    TYPE DATE IS RECORD
+      MONTH : MONTH_TYPE ;
+      DAY   : DAY_TYPE ;
+      YEAR  : YEAR_TYPE ;
+    END RECORD ;
+          
+    TYPE DATE_ACCESS IS ACCESS DATE ;
+
+    THIS_MONTH   : MONTH_TYPE := AUG ;
+    THIS_YEAR     : YEAR_TYPE := 1990 ;
+
+    TODAY         : DATE := (MONTH => AUG,
+                               DAY   => 8,
+                              YEAR  => 1990) ;
+
+    FIRST_DATE   : DATE_ACCESS  := NEW DATE'(DAY   => 6,
+                                             MONTH => JUN,
+                                             YEAR  => 1967) ;
+    
+    TYPE DUE_DATES IS ARRAY (MONTH_TYPE RANGE JAN .. DEC) OF DATE ;
+    REPORT_DATES : DUE_DATES := ((JAN, 23, 1990), (FEB, 23, 1990),
+                                 (MAR, 23, 1990), (APR, 23, 1990),
+                                 (MAY, 23, 1990), (JUN, 22, 1990),
+                                 (JUL, 23, 1990), (AUG, 23, 1990),
+                                 (SEP, 24, 1990), (OCT, 23, 1990),
+                                 (NOV, 23, 1990), (DEC, 20, 1990)) ;
+                                 
+    TYPE LIST_INDEX IS RANGE 1 .. 16 ;
+    TYPE LIST IS ARRAY (LIST_INDEX) OF NATURAL ;
+    ORDER_LIST : LIST := (OTHERS => 0) ;
+
+    GENERIC
+    
+        TYPE RETURN_TYPE IS PRIVATE ;
+        RETURN_VALUE : IN OUT RETURN_TYPE ;
+        POSITION      : IN       NATURAL ;
+        OFFSET        : IN       NATURAL ;
+        WHEN_ELAB     : IN OUT NATURAL ;
+        TYPE INDEX IS RANGE <> ;
+        TYPE LIST IS ARRAY (INDEX) OF NATURAL ;
+        ORDER_LIST      : IN OUT LIST ;
+    
+    FUNCTION NAME (VALUE : IN NATURAL) RETURN RETURN_TYPE ;
+    
+    FUNCTION NAME (VALUE : IN NATURAL) RETURN RETURN_TYPE IS
+    
+    BEGIN -- NAME
+        
+        IF (VALUE = POSITION) THEN
+          WHEN_ELAB := NATURAL'SUCC (WHEN_ELAB) ;
+          ORDER_LIST (INDEX (POSITION)) := WHEN_ELAB ;
+          RETURN RETURN_VALUE ;
+        ELSIF (VALUE = (POSITION + OFFSET)) THEN
+          WHEN_ELAB := NATURAL'SUCC (WHEN_ELAB) ;
+          ORDER_LIST (INDEX (POSITION + OFFSET)) := WHEN_ELAB ;
+          RETURN RETURN_VALUE ;
+        END IF ;
+    
+    END NAME ;
+    
+    GENERIC
+    
+        TYPE FIRST_TYPE IS PRIVATE ;
+        WITH FUNCTION FIRST (POSITION : IN NATURAL) 
+                            RETURN FIRST_TYPE ;
+        FIRST_VALUE : IN NATURAL ;
+        TYPE SECOND_TYPE IS PRIVATE ;
+        WITH FUNCTION SECOND (POSITION : IN NATURAL) 
+                            RETURN SECOND_TYPE ;
+        SECOND_VALUE : IN NATURAL ;
+        TYPE THIRD_TYPE IS PRIVATE ;
+        WITH FUNCTION THIRD (POSITION : IN NATURAL) 
+                            RETURN THIRD_TYPE ;
+        THIRD_VALUE : IN NATURAL ;
+        TYPE FOURTH_TYPE IS PRIVATE ;
+        WITH FUNCTION FOURTH (POSITION : IN NATURAL) 
+                            RETURN FOURTH_TYPE ;
+        FOURTH_VALUE : IN NATURAL ;
+        TYPE FIFTH_TYPE IS PRIVATE ;
+        WITH FUNCTION FIFTH (POSITION : IN NATURAL) 
+                            RETURN FIFTH_TYPE ;
+        FIFTH_VALUE : IN NATURAL ;
+        TYPE SIXTH_TYPE IS PRIVATE ;
+        WITH FUNCTION SIXTH (POSITION : IN NATURAL) 
+                            RETURN SIXTH_TYPE ;
+        SIXTH_VALUE : IN NATURAL ;
+        TYPE SEVENTH_TYPE IS PRIVATE ;
+        WITH FUNCTION SEVENTH (POSITION : IN NATURAL) 
+                            RETURN SEVENTH_TYPE ;
+        SEVENTH_VALUE : IN NATURAL ;
+        TYPE EIGHTH_TYPE IS PRIVATE ;
+        WITH FUNCTION EIGHTH (POSITION : IN NATURAL) 
+                            RETURN EIGHTH_TYPE ;
+        EIGHTH_VALUE : IN NATURAL ;
+        TYPE NINTH_TYPE IS PRIVATE ;
+        WITH FUNCTION NINTH (POSITION : IN NATURAL) 
+                            RETURN NINTH_TYPE ;
+        NINTH_VALUE : IN NATURAL ;
+        TYPE TENTH_TYPE IS PRIVATE ;
+        WITH FUNCTION TENTH (POSITION : IN NATURAL) 
+                            RETURN TENTH_TYPE ;
+        TENTH_VALUE : IN NATURAL ;
+        TYPE ELEVENTH_TYPE IS PRIVATE ;
+        WITH FUNCTION ELEVENTH (POSITION : IN NATURAL) 
+                            RETURN ELEVENTH_TYPE ;
+        ELEVENTH_VALUE : IN NATURAL ;
+        TYPE TWELFTH_TYPE IS PRIVATE ;
+        WITH FUNCTION TWELFTH (POSITION : IN NATURAL) 
+                            RETURN TWELFTH_TYPE ;
+        TWELFTH_VALUE : IN NATURAL ;
+        TYPE THIRTEENTH_TYPE IS PRIVATE ;
+        WITH FUNCTION THIRTEENTH (POSITION : IN NATURAL) 
+                            RETURN THIRTEENTH_TYPE ;
+        THIRTEENTH_VALUE : IN NATURAL ;
+        TYPE FOURTEENTH_TYPE IS PRIVATE ;
+        WITH FUNCTION FOURTEENTH (POSITION : IN NATURAL) 
+                            RETURN FOURTEENTH_TYPE ;
+        FOURTEENTH_VALUE : IN NATURAL ;
+        TYPE FIFTEENTH_TYPE IS PRIVATE ;
+        WITH FUNCTION FIFTEENTH (POSITION : IN NATURAL) 
+                            RETURN FIFTEENTH_TYPE ;
+        FIFTEENTH_VALUE : IN NATURAL ;
+        TYPE SIXTEENTH_TYPE IS PRIVATE ;
+        WITH FUNCTION SIXTEENTH (POSITION : IN NATURAL) 
+                            RETURN SIXTEENTH_TYPE ;
+        SIXTEENTH_VALUE : IN NATURAL ;
+        
+    PACKAGE ORDER_PACKAGE IS
+    
+        A : FIRST_TYPE      := FIRST (FIRST_VALUE) ;
+        B : SECOND_TYPE     := SECOND (SECOND_VALUE) ;
+        C : THIRD_TYPE      := THIRD (THIRD_VALUE) ;
+        D : FOURTH_TYPE     := FOURTH (FOURTH_VALUE) ;
+        E : FIFTH_TYPE      := FIFTH (FIFTH_VALUE) ;
+        F : SIXTH_TYPE      := SIXTH (SIXTH_VALUE) ;
+        G : SEVENTH_TYPE    := SEVENTH (SEVENTH_VALUE) ;
+        H : EIGHTH_TYPE     := EIGHTH (EIGHTH_VALUE) ;
+        I : NINTH_TYPE      := NINTH (NINTH_VALUE) ;
+        J : TENTH_TYPE      := TENTH (TENTH_VALUE) ;
+        K : ELEVENTH_TYPE   := ELEVENTH (ELEVENTH_VALUE) ;
+        L : TWELFTH_TYPE    := TWELFTH (TWELFTH_VALUE) ;
+        M : THIRTEENTH_TYPE := THIRTEENTH (THIRTEENTH_VALUE) ;
+        N : FOURTEENTH_TYPE := FOURTEENTH (FOURTEENTH_VALUE) ;
+        O : FIFTEENTH_TYPE  := FIFTEENTH (FIFTEENTH_VALUE) ;
+        P : SIXTEENTH_TYPE  := SIXTEENTH (SIXTEENTH_VALUE) ;
+        
+    END ORDER_PACKAGE ;
+    
+
+    FUNCTION BOOL IS NEW NAME (RETURN_TYPE  => BOOLEAN,
+                               RETURN_VALUE => TRUE_VALUE,
+                               POSITION     => 1,
+                               OFFSET       => 8,
+                               WHEN_ELAB    => WHEN_ELABORATED,
+                               INDEX        => LIST_INDEX,
+                               LIST         => LIST,
+                               ORDER_LIST   => ORDER_LIST) ;
+                               
+    FUNCTION INT IS NEW NAME (RETURN_TYPE   => YEAR_TYPE,
+                              RETURN_VALUE  => THIS_YEAR,
+                              POSITION      => 2,
+                              OFFSET        => 8,
+                              WHEN_ELAB     => WHEN_ELABORATED,
+                              INDEX         => LIST_INDEX,
+                              LIST          => LIST,
+                              ORDER_LIST    => ORDER_LIST) ;
+                               
+    FUNCTION FLOAT IS NEW NAME (RETURN_TYPE  => REAL,
+                                RETURN_VALUE => REAL_VALUE,
+                                POSITION     => 3,
+                                OFFSET       => 8,
+                                WHEN_ELAB    => WHEN_ELABORATED,
+                                INDEX        => LIST_INDEX,
+                                LIST         => LIST,
+                                ORDER_LIST   => ORDER_LIST) ;
+                               
+    FUNCTION CHAR IS NEW NAME (RETURN_TYPE  => CHARACTER,
+                               RETURN_VALUE => CHARACTER_VALUE,
+                               POSITION     => 4,
+                               OFFSET       => 8,
+                               WHEN_ELAB    => WHEN_ELABORATED,
+                               INDEX        => LIST_INDEX,
+                               LIST         => LIST,
+                               ORDER_LIST   => ORDER_LIST) ;
+                               
+    FUNCTION ENUM IS NEW NAME (RETURN_TYPE  => MONTH_TYPE,
+                               RETURN_VALUE => THIS_MONTH,
+                               POSITION     => 5,
+                               OFFSET       => 8,
+                               WHEN_ELAB    => WHEN_ELABORATED,
+                               INDEX        => LIST_INDEX,
+                               LIST         => LIST,
+                               ORDER_LIST   => ORDER_LIST) ;
+                               
+    FUNCTION ARRY IS NEW NAME (RETURN_TYPE  => DUE_DATES,
+                               RETURN_VALUE => REPORT_DATES,
+                               POSITION     => 6,
+                               OFFSET       => 8,
+                               WHEN_ELAB    => WHEN_ELABORATED,
+                               INDEX        => LIST_INDEX,
+                               LIST         => LIST,
+                               ORDER_LIST   => ORDER_LIST) ;
+                               
+
+    FUNCTION RCRD IS NEW NAME (RETURN_TYPE  => DATE,
+                               RETURN_VALUE => TODAY,
+                               POSITION     => 7,
+                               OFFSET       => 8,
+                               WHEN_ELAB    => WHEN_ELABORATED,
+                               INDEX        => LIST_INDEX,
+                               LIST         => LIST,
+                               ORDER_LIST   => ORDER_LIST) ;
+                               
+
+    FUNCTION ACSS IS NEW NAME (RETURN_TYPE  => DATE_ACCESS,
+                               RETURN_VALUE => FIRST_DATE,
+                               POSITION     => 8,
+                               OFFSET       => 8,
+                               WHEN_ELAB    => WHEN_ELABORATED,
+                               INDEX        => LIST_INDEX,
+                               LIST         => LIST,
+                               ORDER_LIST   => ORDER_LIST) ;
+                               
+    PACKAGE ELABORATION_ORDER IS NEW ORDER_PACKAGE
+        (FIRST_TYPE            => BOOLEAN,
+         FIRST                 => BOOL,
+         FIRST_VALUE           => 1,
+         THIRD_TYPE            => REAL,
+         THIRD                 => FLOAT,
+         THIRD_VALUE           => 3,
+         SECOND_TYPE           => YEAR_TYPE,    -- ORDERING OF PARAMETERS
+         SECOND                => INT,          -- IS DELIBERATE. 
+         SECOND_VALUE          => 2,
+         FOURTH_TYPE           => CHARACTER,
+         FOURTH                => CHAR,
+         FOURTH_VALUE          => 4,
+         FIFTH_TYPE            => MONTH_TYPE,
+         FIFTH                 => ENUM,
+         FIFTH_VALUE           => 5,
+         SIXTH_TYPE            => DUE_DATES,
+         SIXTH                 => ARRY,
+         SIXTH_VALUE           => 6,
+         SEVENTH_TYPE          => DATE,
+         SEVENTH               => RCRD,
+         SEVENTH_VALUE         => 7,
+         EIGHTH_TYPE           => DATE_ACCESS,
+         EIGHTH                => ACSS,
+         EIGHTH_VALUE          => 8,
+         NINTH_TYPE            => BOOLEAN,
+         NINTH                 => BOOL,
+         NINTH_VALUE           => 9,
+         TENTH_TYPE            => YEAR_TYPE,
+         TENTH                 => INT,
+         TENTH_VALUE           => 10,
+         ELEVENTH_TYPE         => REAL,
+         ELEVENTH              => FLOAT,
+         ELEVENTH_VALUE        => 11,
+         TWELFTH_TYPE          => CHARACTER,
+         TWELFTH               => CHAR,
+         TWELFTH_VALUE         => 12,
+         THIRTEENTH_TYPE       => MONTH_TYPE,
+         THIRTEENTH            => ENUM,
+         THIRTEENTH_VALUE      => 13,
+         FOURTEENTH_TYPE       => DUE_DATES,
+         FOURTEENTH            => ARRY,
+         FOURTEENTH_VALUE      => 14,
+         FIFTEENTH_TYPE        => DATE,
+         FIFTEENTH             => RCRD,
+         FIFTEENTH_VALUE       => 15,
+         SIXTEENTH_TYPE        => DATE_ACCESS,
+         SIXTEENTH             => ACSS,
+         SIXTEENTH_VALUE       => 16) ;
+
+BEGIN
+     REPORT.TEST("CC3016B", "CHECK THAT AN INSTANCE OF A GENERIC " &
+                 "PACKAGE MUST DECLARE A PACKAGE. CHECK THAT THE " &
+                 "DECLARATIVE ITEMS IN AN INSTANTIATION OF A GENERIC " &
+                 "PACKAGE SPECIFICATION ARE ELABORATED IN THE ORDER " &
+                 "DECLARED.");
+
+     IF ORDER_LIST(1) /= REPORT.IDENT_INT(1) THEN
+          REPORT.FAILED("BOOLEAN 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(2) /= REPORT.IDENT_INT(2) THEN
+          REPORT.FAILED("INTEGER TYPE 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(3) /= REPORT.IDENT_INT(3) THEN
+          REPORT.FAILED("REAL 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(4) /= REPORT.IDENT_INT(4) THEN
+          REPORT.FAILED("CHARACTER 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(5) /= REPORT.IDENT_INT(5) THEN
+          REPORT.FAILED("ENUMERATION 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(6) /= REPORT.IDENT_INT(6) THEN
+          REPORT.FAILED("ARRAY 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(7) /= REPORT.IDENT_INT(7) THEN
+          REPORT.FAILED("RECORD 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(8) /= REPORT.IDENT_INT(8) THEN
+          REPORT.FAILED("ACCESS 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(9) /= REPORT.IDENT_INT(9) THEN
+          REPORT.FAILED("BOOLEAN 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(10) /= REPORT.IDENT_INT(10) THEN
+          REPORT.FAILED("INTEGER TYPE 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(11) /= REPORT.IDENT_INT(11) THEN
+          REPORT.FAILED("REAL 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(12) /= REPORT.IDENT_INT(12) THEN
+          REPORT.FAILED("CHARACTER 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(13) /= REPORT.IDENT_INT(13) THEN
+          REPORT.FAILED("ENUMERATION 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(14) /= REPORT.IDENT_INT(14) THEN
+          REPORT.FAILED("ARRAY 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(15) /= REPORT.IDENT_INT(15) THEN
+          REPORT.FAILED("RECORD 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF ORDER_LIST(16) /= REPORT.IDENT_INT(16) THEN
+          REPORT.FAILED("ACCESS 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     REPORT.RESULT ;
+     
+END CC3016B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016c.ada
new file mode 100644
index 000000000..637617027
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016c.ada
@@ -0,0 +1,192 @@
+-- CC3016C.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 INSTANCE OF A GENERIC PACKAGE MUST DECLARE A
+--  PACKAGE. CHECK THAT THE STATEMENTS IN AN INSTANTIATED GENERIC
+--  PACKAGE BODY ARE EXECUTED AFTER THE ELABORATION OF THE
+--  DECLARATIONS (IN SPEC AND IN BODY).
+
+-- HISTORY:
+--         EDWARD V. BERARD, 8 AUGUST 1990
+
+WITH REPORT;
+
+PROCEDURE  CC3016C  IS
+
+    GENERIC
+    
+        TYPE SOME_TYPE IS PRIVATE ;
+        FIRST_INITIAL_VALUE  : IN SOME_TYPE ;
+        SECOND_INITIAL_VALUE : IN SOME_TYPE ;
+        WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
+                               RESULT : OUT SOME_TYPE) ;
+        WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
+                                      RESULT : OUT SOME_TYPE) ;
+        WITH PROCEDURE THIRD_CHANGE (FIRST  : IN SOME_TYPE ;
+                                     RESULT : OUT SOME_TYPE) ;
+        FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
+        SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
+        THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
+        FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
+        FIFTH_EXPECTED_RESULT     : IN SOME_TYPE ;
+        SIXTH_EXPECTED_RESULT     : IN SOME_TYPE ;
+    
+    PACKAGE OUTER IS
+
+        VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
+        
+        FUNCTION INNER_VARIABLE RETURN SOME_TYPE ;
+
+        GENERIC
+        
+            INITIAL_VALUE : IN SOME_TYPE ;
+            WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
+                                   RESULT : OUT SOME_TYPE) ;
+            WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
+                                          RESULT : OUT SOME_TYPE) ;
+            FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
+            SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
+            THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
+            FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
+                    
+        PACKAGE INNER  IS
+            VARIABLE : SOME_TYPE := INITIAL_VALUE ;
+        END INNER ;
+        
+    END OUTER ;
+
+
+    PACKAGE BODY OUTER IS
+
+        ANOTHER_VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
+        
+        PACKAGE BODY  INNER  IS
+            ANOTHER_VARIABLE : SOME_TYPE := INITIAL_VALUE ;
+        BEGIN  -- INNER
+
+            CHANGE (FIRST  => VARIABLE,
+                    RESULT => VARIABLE) ;
+            CHANGE (FIRST  => ANOTHER_VARIABLE,
+                    RESULT => ANOTHER_VARIABLE) ;
+            OUTER.SECOND_CHANGE (FIRST  => OUTER.VARIABLE,
+                                 RESULT => OUTER.VARIABLE) ;
+            OUTER.CHANGE (FIRST  => OUTER.ANOTHER_VARIABLE,
+                          RESULT => OUTER.ANOTHER_VARIABLE) ;
+
+            IF (VARIABLE /= FIRST_EXPECTED_RESULT) OR
+               (ANOTHER_VARIABLE /= SECOND_EXPECTED_RESULT) OR
+               (OUTER.VARIABLE 
+                       /= THIRD_EXPECTED_RESULT) OR
+               (OUTER.ANOTHER_VARIABLE 
+                       /= FOURTH_EXPECTED_RESULT) THEN
+                    REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF INNER") ;
+            END IF;
+
+        END INNER ;
+
+        PACKAGE NEW_INNER IS NEW INNER 
+            (INITIAL_VALUE          => SECOND_INITIAL_VALUE,
+             CHANGE                 => CHANGE,
+             SECOND_CHANGE          => THIRD_CHANGE,
+             FIRST_EXPECTED_RESULT  => FIRST_EXPECTED_RESULT,
+             SECOND_EXPECTED_RESULT => SECOND_EXPECTED_RESULT,
+             THIRD_EXPECTED_RESULT  => THIRD_EXPECTED_RESULT,
+             FOURTH_EXPECTED_RESULT => FOURTH_EXPECTED_RESULT) ;
+             
+        FUNCTION INNER_VARIABLE RETURN SOME_TYPE IS
+        BEGIN
+            RETURN NEW_INNER.VARIABLE ;            
+        END INNER_VARIABLE ;
+
+    BEGIN  -- OUTER
+    
+        SECOND_CHANGE (FIRST  => VARIABLE,
+                       RESULT => VARIABLE) ;
+        SECOND_CHANGE (FIRST  => ANOTHER_VARIABLE,
+                       RESULT => ANOTHER_VARIABLE) ;
+                       
+        IF (VARIABLE /= FIFTH_EXPECTED_RESULT) OR
+           (ANOTHER_VARIABLE /= SIXTH_EXPECTED_RESULT) OR
+           (NEW_INNER.VARIABLE /= FIRST_EXPECTED_RESULT) THEN
+            REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF OUTER") ;
+        END IF;
+
+    END OUTER ;
+    
+    PROCEDURE DOUBLE (THIS_VALUE          : IN  INTEGER;
+                      GIVING_THIS_RESULT  : OUT INTEGER) IS
+    BEGIN -- DOUBLE
+        GIVING_THIS_RESULT := 2 * THIS_VALUE ;
+    END DOUBLE ;
+    
+    PROCEDURE ADD_20 (TO_THIS_VALUE      : IN  INTEGER;
+                      GIVING_THIS_RESULT : OUT INTEGER) IS
+    BEGIN -- ADD_20
+        GIVING_THIS_RESULT := TO_THIS_VALUE + 20 ;
+    END ADD_20 ;
+    
+    PROCEDURE TIMES_FIVE (THIS_VALUE          : IN  INTEGER;
+                          GIVING_THIS_RESULT  : OUT INTEGER) IS
+    BEGIN -- TIMES_FIVE
+        GIVING_THIS_RESULT := 5 * THIS_VALUE ;
+    END TIMES_FIVE ;    
+    
+BEGIN -- CC3016C
+
+    REPORT.TEST ("CC3016C" , "CHECK THAT AN INSTANCE OF A GENERIC PACKAGE " &
+                 "MUST DECLARE A PACKAGE. CHECK THAT THE STATEMENTS IN AN " &
+                 "INSTANTIATED GENERIC PACKAGE BODY ARE EXECUTED AFTER THE " &
+                 "ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).") ;
+                   
+    LOCAL_BLOCK:
+    
+    DECLARE
+    
+        PACKAGE NEW_OUTER IS NEW OUTER
+            (SOME_TYPE                 => INTEGER,
+            FIRST_INITIAL_VALUE        => 7,
+            SECOND_INITIAL_VALUE       => 11,
+            CHANGE                     => DOUBLE,
+            SECOND_CHANGE              => ADD_20,
+            THIRD_CHANGE               => TIMES_FIVE,
+            FIRST_EXPECTED_RESULT      => 22, 
+            SECOND_EXPECTED_RESULT     => 22,
+            THIRD_EXPECTED_RESULT      => 27,
+            FOURTH_EXPECTED_RESULT     => 14,
+            FIFTH_EXPECTED_RESULT      => 47,
+            SIXTH_EXPECTED_RESULT      => 34) ;
+
+    BEGIN  -- LOCAL_BLOCK    
+    
+        IF (NEW_OUTER.VARIABLE /= 47) OR
+           (NEW_OUTER.INNER_VARIABLE /= 22) THEN
+            REPORT.FAILED("ASSIGNED VALUES INCORRECT - " &
+                          "BODY OF MAIN PROGRAM") ;
+        END IF;
+        
+    END LOCAL_BLOCK ;
+
+    REPORT.RESULT;
+
+END CC3016C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016f.ada
new file mode 100644
index 000000000..9a1f099c1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016f.ada
@@ -0,0 +1,187 @@
+-- CC3016F.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.
+--*
+--     OFFICE, 3E 114, THE PENTAGON, WASHINGTON DC 20301-3081.
+
+-- OBJECTIVE:
+--   CHECK THAT AN INSTANTIATED PACKAGE HAS THE PROPERTIES REQUIRED
+--   OF A PACKAGE.
+
+--   CHECK THAT IF THE PARENT TYPE IN A DERIVED TYPE DEFINITION IS
+--   A GENERIC FORMAL TYPE, THE OPERATIONS DECLARED FOR THE DERIVED
+--   TYPE IN THE TEMPLATE ARE DETERMINED BY THE DECLARATION OF THE
+--   FORMAL TYPE.  THE OPERATIONS DECLARED FOR DERIVED TYPE IN THE
+--   INSTANCE ARE DETERMINED BY THE ACTUAL TYPE DENOTED BY THE FORMAL
+--   PARAMETER.  SEE AI-00398.
+
+-- HISTORY:
+--   DAS  8 OCT 90   INITIAL VERSION.
+--   JRL 02/19/93  ADDED USE CLAUSES FOR INSTANCES TO ENSURE DIRECT
+--                 OPERATOR VISIBILITY. CHANGED NT4'LAST TO P4.NT4'LAST
+--                 IN ASSIGNMENT STATEMENT FOR P4.X IN EXAMPLE_4.
+--                 CORRECTED ABE ERRORS IN EXAMPLE_2 AND EXAMPLE_3.
+--                 CHANGED R3."+" FROM MULTIPLICATION TO SUBTRACTION TO
+--                 AVOID CONSTRAINT_ERROR.
+
+WITH REPORT;
+
+PROCEDURE CC3016F IS
+BEGIN
+     REPORT.TEST ("CC3016F", "CHECK THAT IF THE PARENT TYPE IN A " &
+                             "DERIVED TYPE DEFINITION IS A GENERIC " &
+                             "FORMAL TYPE, THE OPERATIONS DECLARED " &
+                             "FOR THE DERIVED TYPE IN THE TEMPLATE " &
+                             "ARE DETERMINED BY THE DECLARATION OF " &
+                             "THE FORMAL TYPE, AND THAT THE " &
+                             "OPERATIONS DECLARED FOR THE DERIVED " &
+                             "TYPE IN THE INSTANCE ARE DETERMINED BY " &
+                             "THE ACTUAL TYPE DENOTED BY THE FORMAL " &
+                             "PARAMETER (AI-00398)");
+EXAMPLE_2:
+     DECLARE
+          GENERIC
+               TYPE PRIV IS PRIVATE;
+          PACKAGE GP2 IS
+               TYPE NT2 IS NEW PRIV;
+          END GP2;
+
+          PACKAGE R2 IS
+               TYPE T2 IS RANGE 1..10;
+               FUNCTION F RETURN T2;
+          END R2;
+
+          PACKAGE P2 IS NEW GP2 (PRIV => R2.T2);
+          USE P2;
+
+          XX1 : P2.NT2;
+          XX2 : P2.NT2;
+          XX3 : P2.NT2;
+
+          PACKAGE BODY R2 IS
+               FUNCTION F RETURN T2 IS
+               BEGIN
+                    RETURN T2'LAST;
+               END F;
+          END R2;
+     BEGIN
+          XX1 := 5;                   -- IMPLICIT CONVERSION FROM
+                                      -- UNIVERSAL INTEGER TO P2.NT2
+                                      -- IN P2.
+          XX2 := XX1 + XX1;           -- PREDEFINED "+" DECLARED FOR
+                                      -- P2.NT2.
+          XX3 := P2.F;                -- FUNCTION F DERIVED WITH THE
+                                      -- INSTANCE.
+
+     END EXAMPLE_2;
+
+EXAMPLE_3:
+     DECLARE
+          GENERIC
+               TYPE T3 IS RANGE <>;
+          PACKAGE GP3 IS
+               TYPE NT3 IS NEW T3;
+               X : NT3 := 5;
+               Y : NT3 := X + 3;      -- USES PREDEFINED "+" EVEN IN
+                                      -- INSTANCES
+          END GP3;
+
+          PACKAGE R3 IS
+               TYPE S IS RANGE 1..10;
+               FUNCTION "+" (LEFT : IN S; RIGHT : IN S) RETURN S;
+          END R3;
+
+          PACKAGE P3 IS NEW GP3 ( T3 => R3.S );
+          USE P3;
+
+          Z : P3.NT3;
+
+          PACKAGE BODY R3 IS
+               FUNCTION "+" (LEFT : IN S; RIGHT : IN S) RETURN S IS
+               BEGIN  -- IMPLEMENT AS SUBTRACTION, NOT ADDITION
+                    RETURN LEFT - RIGHT;
+               END "+";
+          END R3;
+     BEGIN
+          Z := P3.X + 3;     -- USES REDEFINED "+"
+
+          IF ( P3.Y /= P3.NT3'(8) ) THEN
+               REPORT.FAILED ("PREDEFINED ""+"" NOT USED TO COMPUTE " &
+                             "P3.Y");
+          END IF;
+
+          IF (Z /= P3.NT3'(2) ) THEN
+               REPORT.FAILED ("REDEFINED ""+"" NOT USED TO COMPUTE Z");
+          END IF;
+     END EXAMPLE_3;
+
+EXAMPLE_4:
+     DECLARE
+          GENERIC
+               TYPE T4 IS LIMITED PRIVATE;
+          PACKAGE GP4 IS
+               TYPE NT4 IS NEW T4;
+               X : NT4;
+          END GP4;
+
+          PACKAGE P4 IS NEW GP4 (BOOLEAN);
+          USE P4;
+
+     BEGIN
+          P4.X := P4.NT4'LAST;
+          IF ( P4.X  OR (NOT P4.X) ) THEN
+               REPORT.COMMENT ("P4.X CORRECTLY HAS A BOOLEAN TYPE");
+          END IF;
+     END EXAMPLE_4;
+
+EXAMPLE_5:
+     DECLARE
+          GENERIC
+               TYPE T5 (D : POSITIVE) IS PRIVATE;
+          PACKAGE GP5 IS
+               TYPE NT5 IS NEW T5;
+               X : NT5 (D => 5);
+               Y : POSITIVE := X.D;  -- REFERS TO DISCRIMINANT OF NT5
+          END GP5;
+
+          TYPE REC (A : POSITIVE) IS
+               RECORD
+                    D : POSITIVE := 7;
+               END RECORD;
+          PACKAGE P5 IS NEW GP5 (T5 => REC);
+               -- P5.Y INITIALIZED WITH VALUE USING COMPONENT SELECTION
+               -- OPERATION FOR THE DISCRIMINANT, I.E. FOR PARENT TYPE
+               -- T5 WHICH DENOTES REC.
+
+          W1 : POSITIVE := P5.X.D;     -- VALUE IS 7
+          W2 : POSITIVE := P5.X.A;     -- VALUE IS 5
+          W3 : POSITIVE := P5.Y;       -- VALUE IS 5;
+     BEGIN
+          IF ( ( W1 /= 7 ) OR ( W2 /= 5 ) OR  (W3 /= 5 ) ) THEN
+               REPORT.FAILED ("INCORRECT COMPONENT SELECTION");
+          END IF;
+     END EXAMPLE_5;
+
+     REPORT.RESULT;
+
+END CC3016F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016i.ada
new file mode 100644
index 000000000..933ec84b3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3016i.ada
@@ -0,0 +1,78 @@
+-- CC3016I.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 INSTANTIATED PACKAGE HAS THE PROPERTIES REQUIRED
+--   OF A PACKAGE.
+
+--   CHECK THAT IF THE DESIGNATED TYPE OF AN ACCESS TYPE IS A GENERIC
+--   FORMAL TYPE, OR IS A TYPE DERIVED DIRECTLY OR INDIRECTLY FROM A
+--   GENERIC FORMAL TYPE, THE OPERATIONS DECLARED FOR THE ACCESS TYPE
+--   IN THE TEMPLATE ARE DETERMINED BY THE DECLARATION OF THE FORMAL
+--   TYPE.  THE OPERATIONS DECLARED FOR ACCESS TYPE IN THE INSTANCE
+--   ARE DETERMINED BY THE ACTUAL TYPE DENOTED BY THE FORMAL PARAMETER.
+--   SEE AI-00398.
+
+-- HISTORY:
+--   DAS  8 OCT 90   INITIAL VERSION.
+
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3016I IS
+BEGIN
+     TEST("CC3016I", "CHECK THAT AN INSTANTIATED PACKAGE HAS THE " &
+          "PROPERTIES REQUIRED OF A PACKAGE.");
+
+EXAMPLE_5A:
+     DECLARE
+          GENERIC
+               TYPE T5A (D : POSITIVE) IS PRIVATE;
+          PACKAGE GP5A IS
+               TYPE NT5A IS NEW T5A;
+               X : NT5A (D => 5);
+               Y : POSITIVE := X.D;  -- REFERS TO DISCRIMINANT OF NT5A
+          END GP5A;
+
+          TYPE REC (A : POSITIVE) IS
+               RECORD
+                    D : POSITIVE := 7;
+               END RECORD;
+          PACKAGE P5A IS NEW GP5A (T5A => REC);
+               -- P5A.Y INITIALIZED WITH VALUE USING COMPONENT SELECTION
+               -- OPERATION FOR THE DISCRIMINANT, I.E. FOR PARENT TYPE
+               -- T5A WHICH DENOTES REC.
+
+          W1 : POSITIVE := P5A.X.D;    -- VALUE IS 7
+          W2 : POSITIVE := P5A.X.A;    -- VALUE IS 5
+          W3 : POSITIVE := P5A.Y;      -- VALUE IS 5;
+     BEGIN
+          IF ( ( W1 /= 7 ) OR ( W2 /= 5 ) OR  (W3 /= 5 ) ) THEN
+               FAILED ("INCORRECT COMPONENT SELECTION - ACCESS");
+          END IF;
+     END EXAMPLE_5A;
+
+     RESULT;
+ 
+END CC3016I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada
new file mode 100644
index 000000000..0f8fcfd6f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada
@@ -0,0 +1,470 @@
+-- CC3017B.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 INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
+-- PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
+-- DECLARE A FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT RAISED
+-- IF THE DEFAULT VALUE FOR A FORMAL PARAMETER DOES NOT SATISFY
+-- THE CONSTRAINTS OF THE SUBTYPE_INDICATION WHEN THE     
+-- DECLARATION IS ELABORATED, ONLY WHEN THE DEFAULT IS USED.   
+
+--   SUBTESTS ARE:
+--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
+--            INITIALIZED WITH A STATIC AGGREGATE.
+--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
+--            INITIALIZED WITH A STATIC VALUE.
+--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
+--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
+--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
+--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+--            WITH A STATIC AGGREGATE.
+--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
+--            INITIALIZED WITH A STATIC AGGREGATE.
+
+-- EDWARD V. BERARD, 7 AUGUST 1990
+
+WITH REPORT;
+
+PROCEDURE CC3017B IS
+
+BEGIN
+
+     REPORT.TEST ("CC3017B", "CHECK THAT AN INSTANCE OF A GENERIC " &
+                  "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
+                  "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
+                  "FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT " &
+                  "RAISED IF AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                  "CONSTRAINTS ON A FORMAL PARAMETER");
+
+     --------------------------------------------------
+
+     NONSTAT_ARRAY_PARMS:
+     
+     DECLARE
+     
+--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
+--            INITIALIZED WITH A STATIC AGGREGATE.
+
+          TYPE NUMBER IS RANGE 1 .. 100 ;
+          
+          GENERIC
+          
+            TYPE INTEGER_TYPE IS RANGE <> ;
+            LOWER : IN INTEGER_TYPE ;
+            UPPER : IN INTEGER_TYPE ;
+          
+          PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
+                        SECOND : IN INTEGER_TYPE) ;
+
+          PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
+                        SECOND : IN INTEGER_TYPE) IS
+                        
+               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE LOWER .. FIRST,
+                                 INTEGER_TYPE RANGE LOWER .. SECOND)
+                                         OF INTEGER_TYPE;
+
+               PROCEDURE PA1 (A : A1 := ((LOWER,UPPER),(UPPER,UPPER)))
+                    IS
+               BEGIN
+                    REPORT.FAILED ("BODY OF PA1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         REPORT.FAILED ("EXCEPTION RAISED IN PA1");
+               END PA1;
+
+          BEGIN  -- PA
+               PA1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PA1");
+          END PA;
+          
+          PROCEDURE NEW_PA IS NEW PA (INTEGER_TYPE => NUMBER,
+                                      LOWER        => 1,
+                                      UPPER        => 50) ;
+
+     BEGIN   -- NONSTAT_ARRAY_PARMS
+     
+          NEW_PA (FIRST  => NUMBER (25),
+                  SECOND => NUMBER (75));
+          
+     EXCEPTION
+          WHEN OTHERS =>
+               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PA");
+               
+     END NONSTAT_ARRAY_PARMS ;   
+     
+     --------------------------------------------------
+
+     SCALAR_NON_STATIC:
+     
+     DECLARE
+     
+--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
+--            INITIALIZED WITH A STATIC VALUE.
+
+          TYPE NUMBER IS RANGE 1 .. 100 ;
+          
+          GENERIC
+          
+            TYPE INTEGER_TYPE IS RANGE <> ;
+            STATIC_VALUE : IN INTEGER_TYPE ;
+          
+          PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
+                        UPPER  : IN INTEGER_TYPE) ;
+
+          PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
+                        UPPER  : IN INTEGER_TYPE) IS
+
+               SUBTYPE INT IS INTEGER_TYPE RANGE LOWER .. UPPER ;
+
+               PROCEDURE PB1 (I : INT := STATIC_VALUE) IS
+               BEGIN  -- PB1
+                    REPORT.FAILED ("BODY OF PB1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         REPORT.FAILED ("EXCEPTION RAISED IN PB1");
+               END PB1;
+
+          BEGIN  -- PB
+               PB1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PB1");
+          END PB;
+
+          PROCEDURE NEW_PB IS NEW PB (INTEGER_TYPE => NUMBER,
+                                      STATIC_VALUE => 20) ;
+
+     BEGIN   -- SCALAR_NON_STATIC
+          
+          NEW_PB (LOWER  => NUMBER (25),
+                  UPPER  => NUMBER (75));
+
+     EXCEPTION
+          WHEN OTHERS =>
+               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PB");
+     END SCALAR_NON_STATIC ; 
+
+     --------------------------------------------------
+
+     REC_NON_STAT_COMPS:
+     
+     DECLARE
+     
+--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
+--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
+
+          TYPE NUMBER IS RANGE 1 .. 100 ;
+          
+          GENERIC
+          
+            TYPE INTEGER_TYPE IS RANGE <> ;
+            F_STATIC_VALUE : IN INTEGER_TYPE ;
+            S_STATIC_VALUE : IN INTEGER_TYPE ;
+            T_STATIC_VALUE : IN INTEGER_TYPE ;
+            L_STATIC_VALUE : IN INTEGER_TYPE ;
+          
+          PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
+                        UPPER  : IN INTEGER_TYPE) ;
+
+          PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
+                        UPPER  : IN INTEGER_TYPE) IS
+                        
+               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
+                       RANGE LOWER .. UPPER ;
+               TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF 
+                     SUBINTEGER_TYPE ;
+               TYPE REC IS
+                    RECORD
+                         FIRST  : SUBINTEGER_TYPE ;
+                         SECOND : AR1 ;
+                    END RECORD;
+
+               PROCEDURE PC1 (R : REC := (F_STATIC_VALUE,
+                                         (S_STATIC_VALUE,
+                                          T_STATIC_VALUE,
+                                          L_STATIC_VALUE))) IS
+               BEGIN  -- PC1
+                    REPORT.FAILED ("BODY OF PC1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         REPORT.FAILED ("EXCEPTION RAISED IN PC1");
+               END PC1;
+
+          BEGIN  -- PC
+               PC1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PC1");
+          END PC;
+         
+          PROCEDURE NEW_PC IS NEW PC (INTEGER_TYPE => NUMBER,
+                                      F_STATIC_VALUE => 15,
+                                      S_STATIC_VALUE => 19,
+                                      T_STATIC_VALUE => 85,
+                                      L_STATIC_VALUE => 99) ;
+
+     BEGIN   -- REC_NON_STAT_COMPS
+          NEW_PC (LOWER => 20,
+                  UPPER => 80);
+     EXCEPTION
+          WHEN OTHERS =>
+               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PC");
+     END REC_NON_STAT_COMPS ;
+
+     --------------------------------------------------
+
+     FIRST_STATIC_ARRAY:
+
+     DECLARE
+     
+--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
+--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+--            WITH A STATIC AGGREGATE.
+
+          TYPE NUMBER IS RANGE 1 .. 100 ;
+          
+          GENERIC
+          
+            TYPE INTEGER_TYPE IS RANGE <> ;
+            F_STATIC_VALUE : IN INTEGER_TYPE ;
+            S_STATIC_VALUE : IN INTEGER_TYPE ;
+            T_STATIC_VALUE : IN INTEGER_TYPE ;
+            L_STATIC_VALUE : IN INTEGER_TYPE ;
+            A_STATIC_VALUE : IN INTEGER_TYPE ;
+            B_STATIC_VALUE : IN INTEGER_TYPE ;
+            C_STATIC_VALUE : IN INTEGER_TYPE ;
+            D_STATIC_VALUE : IN INTEGER_TYPE ;
+          
+          PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
+                         UPPER  : IN INTEGER_TYPE) ;
+
+          PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
+                         UPPER  : IN INTEGER_TYPE) IS
+                         
+               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
+                       RANGE LOWER .. UPPER ;
+
+               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
+                                       F_STATIC_VALUE .. S_STATIC_VALUE,
+                                 INTEGER_TYPE RANGE
+                                       T_STATIC_VALUE .. L_STATIC_VALUE)
+                       OF SUBINTEGER_TYPE ;
+
+               PROCEDURE P1D1 (A : A1 :=
+                           ((A_STATIC_VALUE, B_STATIC_VALUE),
+                           (C_STATIC_VALUE, D_STATIC_VALUE))) IS
+               BEGIN  -- P1D1
+                    REPORT.FAILED ("BODY OF P1D1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         REPORT.FAILED ("EXCEPTION RAISED IN P1D1");
+               END P1D1;
+
+          BEGIN  -- P1D
+               P1D1 ;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    REPORT.FAILED ("WRONG EXCEPTION RAISED - P1D1");
+          END P1D;
+          
+          PROCEDURE NEW_P1D IS NEW P1D (INTEGER_TYPE => NUMBER,
+                                        F_STATIC_VALUE => 21,
+                                        S_STATIC_VALUE => 37,
+                                        T_STATIC_VALUE => 67,
+                                        L_STATIC_VALUE => 79,
+                                        A_STATIC_VALUE => 11,
+                                        B_STATIC_VALUE => 88,
+                                        C_STATIC_VALUE => 87,
+                                        D_STATIC_VALUE => 13) ;
+
+     BEGIN  -- FIRST_STATIC_ARRAY
+          NEW_P1D (LOWER => 10,
+                     UPPER => 90);
+     EXCEPTION
+          WHEN OTHERS =>
+               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P1D");
+     END FIRST_STATIC_ARRAY ;
+
+     --------------------------------------------------
+
+     SECOND_STATIC_ARRAY:
+     
+     DECLARE
+     
+--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
+--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+--            WITH A STATIC AGGREGATE.
+
+          TYPE NUMBER IS RANGE 1 .. 100 ;
+          
+          GENERIC
+          
+            TYPE INTEGER_TYPE IS RANGE <> ;
+            F_STATIC_VALUE : IN INTEGER_TYPE ;
+            S_STATIC_VALUE : IN INTEGER_TYPE ;
+            T_STATIC_VALUE : IN INTEGER_TYPE ;
+            L_STATIC_VALUE : IN INTEGER_TYPE ;
+            A_STATIC_VALUE : IN INTEGER_TYPE ;
+            B_STATIC_VALUE : IN INTEGER_TYPE ;
+          
+          PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
+                         UPPER  : IN INTEGER_TYPE) ;
+
+          PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
+                         UPPER  : IN INTEGER_TYPE) IS
+                         
+               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
+                       RANGE LOWER .. UPPER ;
+
+               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
+                                       F_STATIC_VALUE .. S_STATIC_VALUE,
+                                 INTEGER_TYPE RANGE
+                                       T_STATIC_VALUE .. L_STATIC_VALUE)
+                       OF SUBINTEGER_TYPE ;
+
+               PROCEDURE P2D1 (A : A1 :=
+                                   (F_STATIC_VALUE .. S_STATIC_VALUE =>
+                                   (A_STATIC_VALUE, B_STATIC_VALUE))) IS
+               BEGIN  -- P2D1
+                    REPORT.FAILED ("BODY OF P2D1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         REPORT.FAILED ("EXCEPTION RAISED IN P2D1");
+               END P2D1;
+
+          BEGIN  -- P2D
+               P2D1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    REPORT.FAILED ("WRONG EXCEPTION RAISED - P2D1");
+          END P2D;
+          
+          PROCEDURE NEW_P2D IS NEW P2D (INTEGER_TYPE => NUMBER,
+                                        F_STATIC_VALUE => 21,
+                                        S_STATIC_VALUE => 37,
+                                        T_STATIC_VALUE => 67,
+                                        L_STATIC_VALUE => 79,
+                                        A_STATIC_VALUE => 7,
+                                        B_STATIC_VALUE => 93) ;
+
+     BEGIN  -- SECOND_STATIC_ARRAY
+          NEW_P2D (LOWER => 5,
+                   UPPER => 95);
+     EXCEPTION
+          WHEN OTHERS =>
+               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P2D");
+     END SECOND_STATIC_ARRAY ;
+
+     --------------------------------------------------
+
+     REC_NON_STATIC_CONS:
+     
+     DECLARE
+     
+--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
+--            INITIALIZED WITH A STATIC AGGREGATE.
+
+          TYPE NUMBER IS RANGE 1 .. 100 ;
+          
+          GENERIC
+          
+            TYPE INTEGER_TYPE IS RANGE <> ;
+            F_STATIC_VALUE : IN INTEGER_TYPE ;
+            S_STATIC_VALUE : IN INTEGER_TYPE ;
+            T_STATIC_VALUE : IN INTEGER_TYPE ;
+            L_STATIC_VALUE : IN INTEGER_TYPE ;
+            D_STATIC_VALUE : IN INTEGER_TYPE ;
+          
+          PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
+                        UPPER  : IN INTEGER_TYPE) ;
+
+          PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
+                        UPPER  : IN INTEGER_TYPE) IS
+                        
+               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
+                       RANGE LOWER .. UPPER ;
+               TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF 
+                     SUBINTEGER_TYPE ;
+                    
+               TYPE REC (DISCRIM : SUBINTEGER_TYPE) IS
+                    RECORD
+                         FIRST  : SUBINTEGER_TYPE ;
+                         SECOND : AR1 ;
+                    END RECORD ;
+
+               SUBTYPE REC4 IS REC (LOWER) ;
+
+               PROCEDURE PE1 (R : REC4 := (D_STATIC_VALUE,
+                                           F_STATIC_VALUE,
+                                          (S_STATIC_VALUE,
+                                           T_STATIC_VALUE,
+                                           L_STATIC_VALUE))) IS
+               BEGIN  -- PE1
+                    REPORT.FAILED ("BODY OF PE1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         REPORT.FAILED ("EXCEPTION RAISED IN PE1");
+               END PE1;
+
+          BEGIN  -- PE
+               PE1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PE1");
+          END PE;
+
+          PROCEDURE NEW_PE IS NEW PE (INTEGER_TYPE => NUMBER,
+                                      F_STATIC_VALUE => 37,
+                                      S_STATIC_VALUE => 21,
+                                      T_STATIC_VALUE => 67,
+                                      L_STATIC_VALUE => 79,
+                                      D_STATIC_VALUE => 44) ;
+
+     BEGIN  -- REC_NON_STATIC_CONS
+          NEW_PE  (LOWER => 2,
+                   UPPER => 99);
+     EXCEPTION
+          WHEN OTHERS =>
+               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PE");
+     END REC_NON_STATIC_CONS ;
+
+     --------------------------------------------------
+
+     REPORT.RESULT;
+
+END CC3017B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada
new file mode 100644
index 000000000..d4649716f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada
@@ -0,0 +1,336 @@
+-- CC3017C.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 INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
+--     PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
+--     DECLARE A FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS
+--     ARE COPIED.
+--
+--     SUBTESTS ARE:
+--         (A) SCALAR PARAMETERS TO PROCEDURES.
+--         (B) SCALAR PARAMETERS TO FUNCTIONS.
+--         (C) ACCESS PARAMETERS TO PROCEDURES.
+--         (D) ACCESS PARAMETERS TO FUNCTIONS.
+
+-- HISTORY:
+--     EDWARD V. BERARD, 7 AUGUST 1990
+--     CJJ 10/16/90  ADJUSTED LINES THAT WERE TOO LONG; REFORMATTED
+--                   HEADER TO CONFORM TO ACVC STANDARDS.
+--
+
+WITH REPORT;
+PROCEDURE CC3017C IS
+
+BEGIN
+     REPORT.TEST ("CC3017C", "CHECK THAT AN INSTANCE OF A GENERIC " &
+                  "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
+                  "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
+                  "FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS " &
+                  "ARE COPIED");
+
+     --------------------------------------------------
+
+     SCALAR_TO_PROCS:
+     
+     DECLARE
+
+--        (A) SCALAR PARAMETERS TO PROCEDURES.
+
+          TYPE NUMBER IS RANGE 0 .. 120 ;
+          VALUE : NUMBER ;
+          E     : EXCEPTION ;
+
+          GENERIC
+          
+            TYPE SCALAR_ITEM IS RANGE <> ;
+            
+          PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
+                       P_OUT     : OUT SCALAR_ITEM ;
+                       P_IN_OUT : IN OUT SCALAR_ITEM) ;
+                       
+          PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
+                       P_OUT     : OUT SCALAR_ITEM ;
+                       P_IN_OUT : IN OUT SCALAR_ITEM) IS
+
+               STORE  : SCALAR_ITEM ;
+
+          BEGIN  -- P
+
+               STORE := P_IN;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
+
+               P_OUT := 10;
+               IF (P_IN /= STORE) THEN
+                    REPORT.FAILED ("ASSIGNMENT TO SCALAR OUT " &
+                                   "PARAMETER CHANGES THE VALUE OF " &
+                                   "INPUT PARAMETER");
+                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
+               END IF;
+
+               P_IN_OUT := P_IN_OUT + 100;
+               IF (P_IN /= STORE) THEN
+                    REPORT.FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
+                                   "PARAMETER CHANGES THE VALUE OF " &
+                                   "INPUT PARAMETER");
+                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
+               END IF;
+
+               VALUE := VALUE + 1;
+               IF (P_IN /= STORE) THEN
+                    REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL " &
+                                   "PARAMETER CHANGES THE VALUE OF " &
+                                   "INPUT PARAMETER");
+               END IF;
+
+               RAISE E;  -- CHECK EXCEPTION HANDLING.
+          END P;
+          
+          PROCEDURE NEW_P IS NEW P (SCALAR_ITEM => NUMBER) ;
+
+     BEGIN  -- SCALAR_TO_PROCS
+          VALUE := 0;   -- INITIALIZE VALUE SO VARIOUS CASES CAN BE DETECTED.
+          
+          NEW_P (P_IN     => VALUE,
+                 P_OUT    => VALUE,
+                 P_IN_OUT => VALUE);
+          
+          REPORT.FAILED ("EXCEPTION NOT RAISED - SCALARS TO PROCEDURES");
+     EXCEPTION
+          WHEN E =>
+               IF (VALUE /= 1) THEN
+                    CASE VALUE IS
+                         WHEN 11  =>
+                              REPORT.FAILED ("OUT ACTUAL SCALAR " &
+                                             "PARAMETER CHANGED GLOBAL VALUE");
+                         WHEN 101 =>
+                              REPORT.FAILED ("IN OUT ACTUAL SCALAR " &
+                                             "PARAMETER CHANGED GLOBAL VALUE");
+                         WHEN 111 =>
+                              REPORT.FAILED ("OUT AND IN OUT ACTUAL " &
+                                             "SCALAR PARAMETERS CHANGED " &
+                                             "GLOBAL VALUE");
+                         WHEN OTHERS =>
+                              REPORT.FAILED ("UNDETERMINED CHANGE TO " &
+                                             "GLOBAL VALUE");
+                    END CASE;
+               END IF;
+          WHEN OTHERS =>
+              REPORT.FAILED ("WRONG EXCEPTION RAISED - SCALARS TO PROCEDURES");
+     END SCALAR_TO_PROCS ;
+
+     --------------------------------------------------
+
+     SCALAR_TO_FUNCS:
+     
+     DECLARE
+
+--        (B) SCALAR PARAMETERS TO FUNCTIONS.
+
+          TYPE NUMBER IS RANGE 0 .. 101 ;
+          FIRST  : NUMBER ;
+          SECOND : NUMBER ;
+
+          GENERIC
+          
+              TYPE ITEM IS RANGE <> ;
+            
+          FUNCTION F (F_IN : IN ITEM) RETURN ITEM ;
+          
+          FUNCTION F (F_IN : IN ITEM) RETURN ITEM IS
+
+               STORE  : ITEM := F_IN;
+
+          BEGIN  -- F
+
+               FIRST := FIRST + 1;
+               IF (F_IN /= STORE) THEN
+                    REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL FUNCTION " &
+                                   "PARAMETER CHANGES THE VALUE OF " &
+                                   "INPUT PARAMETER");
+               END IF;
+
+               RETURN (100);
+          END F;
+          
+          FUNCTION NEW_F IS NEW F (ITEM => NUMBER) ;
+
+     BEGIN  -- SCALAR_TO_FUNCS
+          FIRST  := 100 ;
+          SECOND := NEW_F (FIRST) ;
+     END SCALAR_TO_FUNCS ;
+
+     --------------------------------------------------
+
+     ACCESS_TO_PROCS:
+     
+     DECLARE
+
+--        (C) ACCESS PARAMETERS TO PROCEDURES.
+
+          TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                               SEP, OCT, NOV, DEC) ;
+          TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+          TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+          TYPE DATE IS RECORD
+              MONTH : MONTH_TYPE ;
+              DAY   : DAY_TYPE ;
+              YEAR  : YEAR_TYPE ;
+          END RECORD ;
+          
+          TYPE DATE_ACCESS IS ACCESS DATE ;
+          DATE_POINTER : DATE_ACCESS ;
+          
+          E    : EXCEPTION;
+          
+          GENERIC
+          
+            TYPE ITEM IS PRIVATE ;
+            TYPE ACCESS_ITEM IS ACCESS ITEM ;
+
+          PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;  
+                       P_OUT    : OUT    ACCESS_ITEM ;
+                       P_IN_OUT : IN OUT ACCESS_ITEM) ;
+
+          PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;  
+                       P_OUT    : OUT    ACCESS_ITEM ;
+                       P_IN_OUT : IN OUT ACCESS_ITEM) IS
+
+               STORE  : ACCESS_ITEM ;
+
+          BEGIN  -- P
+
+               STORE := P_IN ;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
+
+               DATE_POINTER := NEW DATE'(YEAR  => 1990,
+                                         DAY   => 7,
+                                         MONTH => AUG) ;
+               IF (P_IN /= STORE) THEN
+                    REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL " &
+                                   "PARAMETER CHANGES THE VALUE OF " &
+                                   "INPUT PARAMETER");
+                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
+               END IF;
+
+               P_OUT := NEW ITEM ;
+               IF (P_IN /= STORE) THEN
+                    REPORT.FAILED ("ASSIGNMENT TO ACCESS OUT " &
+                                   "PARAMETER CHANGES THE VALUE OF " &
+                                   "INPUT PARAMETER");
+                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
+               END IF;
+
+               P_IN_OUT :=  NEW ITEM ;
+               IF (P_IN /= STORE) THEN
+                    REPORT.FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
+                                   "PARAMETER CHANGES THE VALUE OF " &
+                                   "INPUT PARAMETER");
+               END IF;
+
+               RAISE E;  -- CHECK EXCEPTION HANDLING.
+          END P ;
+          
+          PROCEDURE NEW_P IS NEW P (ITEM         => DATE,
+                                    ACCESS_ITEM  => DATE_ACCESS) ;
+
+     BEGIN  -- ACCESS_TO_PROCS
+          DATE_POINTER := NEW DATE'(MONTH => DEC,
+                                    DAY   => 25,
+                                    YEAR  => 2000) ;
+                                    
+          NEW_P (P_IN       => DATE_POINTER,
+                   P_OUT    => DATE_POINTER,
+                   P_IN_OUT => DATE_POINTER) ;
+                 
+          REPORT.FAILED ("EXCEPTION NOT RAISED - ACCESS TO PROCEDURES");
+     EXCEPTION
+          WHEN E =>
+               IF (DATE_POINTER.ALL /= (AUG, 7, 1990)) THEN
+                    REPORT.FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
+                                   "PARAMETER VALUE CHANGED DESPITE " &
+                                   "RAISED EXCEPTION");
+               END IF;
+          WHEN OTHERS =>
+               REPORT.FAILED ("WRONG EXCEPTION RAISED - ACCESS TO PROCEDURES");
+     END ACCESS_TO_PROCS ;
+
+     --------------------------------------------------
+
+     ACCESS_TO_FUNCS:
+     
+     DECLARE
+     
+--        (D) ACCESS PARAMETERS TO FUNCTIONS.
+
+          TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                               SEP, OCT, NOV, DEC) ;
+          TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+          TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+          TYPE DATE IS RECORD
+            MONTH : MONTH_TYPE ;
+            DAY   : DAY_TYPE ;
+            YEAR  : YEAR_TYPE ;
+          END RECORD ;
+          
+          TYPE DATE_ACCESS IS ACCESS DATE ;
+          DATE_POINTER : DATE_ACCESS ;
+          NEXT_DATE    : DATE_ACCESS ;
+
+          GENERIC
+          
+            TYPE ITEM IS PRIVATE ;
+            TYPE ACCESS_ITEM IS ACCESS ITEM ;
+
+          FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM ;
+
+          FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM IS
+
+               STORE  : ACCESS_ITEM := F_IN ;
+
+          BEGIN  -- F
+
+               DATE_POINTER := NEW DATE'(YEAR  => 1990,
+                                            DAY   => 7,
+                                         MONTH => AUG) ;
+               IF (F_IN /= STORE) THEN
+                    REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL FUNCTION " &
+                                   "PARAMETER CHANGES THE VALUE OF " &
+                                   "INPUT PARAMETER");
+               END IF;
+
+               RETURN (NULL);
+          END F ;
+          
+          FUNCTION NEW_F IS NEW F (ITEM        => DATE,
+                                   ACCESS_ITEM => DATE_ACCESS) ;
+
+     BEGIN  -- ACCESS_TO_FUNCS
+          DATE_POINTER := NULL ;
+          NEXT_DATE    := NEW_F(F_IN => DATE_POINTER) ;
+     END ACCESS_TO_FUNCS ;
+
+     --------------------------------------------------
+
+     REPORT.RESULT;
+
+END CC3017C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019a.ada
new file mode 100644
index 000000000..3f5e84e60
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019a.ada
@@ -0,0 +1,173 @@
+-- CC3019A.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 INSTANTIATIONS OF NESTED GENERIC UNITS ARE PROCESSED
+-- CORRECTLY.
+
+-- JBG 11/6/85
+
+GENERIC
+     TYPE ELEMENT_TYPE IS PRIVATE;
+PACKAGE CC3019A_QUEUES IS
+
+     TYPE QUEUE_TYPE IS PRIVATE;
+
+     PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE;
+                    VALUE : ELEMENT_TYPE);
+
+     GENERIC
+          WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
+     PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE);
+
+PRIVATE
+
+     TYPE CONTENTS_TYPE IS ARRAY (1..3) OF ELEMENT_TYPE;
+     TYPE QUEUE_TYPE IS
+          RECORD
+               CONTENTS : CONTENTS_TYPE;
+               SIZE     : NATURAL := 0;
+          END RECORD;
+
+END CC3019A_QUEUES;
+
+PACKAGE BODY CC3019A_QUEUES IS
+
+     PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE;
+                    VALUE : ELEMENT_TYPE) IS
+     BEGIN
+          TO_Q.SIZE := TO_Q.SIZE + 1;
+          TO_Q.CONTENTS(TO_Q.SIZE) := VALUE;
+     END ADD;
+
+--   GENERIC
+--        WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
+     PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE) IS
+     BEGIN
+          FOR I IN TO_Q.CONTENTS'FIRST .. TO_Q.SIZE LOOP
+               APPLY (TO_Q.CONTENTS(I));
+          END LOOP;
+     END ITERATOR;
+
+END CC3019A_QUEUES;
+
+WITH REPORT; USE REPORT;
+WITH CC3019A_QUEUES;
+PROCEDURE CC3019A IS
+
+     SUBTYPE STR6 IS STRING (1..6);
+
+     TYPE STR6_ARR IS ARRAY (1..3) OF STR6;
+     STR6_VALS : STR6_ARR := ("111111", "222222",
+                               IDENT_STR("333333"));
+     CUR_STR_INDEX : NATURAL := 1;
+
+     TYPE INT_ARR IS ARRAY (1..3) OF INTEGER;
+     INT_VALS : INT_ARR := (-1, 3, IDENT_INT(3));
+     CUR_INT_INDEX : NATURAL := 1;
+
+-- THIS PROCEDURE IS CALLED ONCE FOR EACH ELEMENT OF THE QUEUE
+--
+     PROCEDURE CHECK_STR (VAL : STR6) IS
+     BEGIN
+          IF VAL /= STR6_VALS(CUR_STR_INDEX) THEN
+               FAILED ("STR6 ITERATOR FOR INDEX =" &
+                       INTEGER'IMAGE(CUR_STR_INDEX) & " WITH VALUE " &
+                       """" & VAL & """");
+          END IF;
+          CUR_STR_INDEX := CUR_STR_INDEX + 1;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("STR6 - CONSTRAINT_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("STR6 - UNEXPECTED EXCEPTION");
+     END CHECK_STR;
+
+     PROCEDURE CHECK_INT (VAL : INTEGER) IS
+     BEGIN
+          IF VAL /= INT_VALS(CUR_INT_INDEX) THEN
+               FAILED ("INTEGER ITERATOR FOR INDEX =" &
+                       INTEGER'IMAGE(CUR_INT_INDEX) & " WITH VALUE " &
+                       """" & INTEGER'IMAGE(VAL) & """");
+          END IF;
+          CUR_INT_INDEX := CUR_INT_INDEX + 1;
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("INTEGER - CONSTRAINT_ERROR RAISED");
+          WHEN OTHERS =>
+               FAILED ("INTEGER - UNEXPECTED EXCEPTION");
+     END CHECK_INT;
+
+     PACKAGE STR6_QUEUE IS NEW CC3019A_QUEUES (STR6);
+     USE STR6_QUEUE;
+
+     PACKAGE INT_QUEUE IS NEW CC3019A_QUEUES (INTEGER);
+     USE INT_QUEUE;
+
+BEGIN
+
+     TEST ("CC3019A", "CHECK NESTED GENERICS - ITERATORS");
+
+     DECLARE
+          Q1 : STR6_QUEUE.QUEUE_TYPE;
+
+          PROCEDURE CHK_STR IS NEW STR6_QUEUE.ITERATOR (CHECK_STR);
+
+     BEGIN
+
+          ADD (Q1, "111111");
+          ADD (Q1, "222222");
+          ADD (Q1, "333333");
+
+          CUR_STR_INDEX := 1;
+          CHK_STR (Q1);
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION - Q1");
+     END;
+
+-- REPEAT FOR INTEGERS
+
+     DECLARE
+          Q2 : INT_QUEUE.QUEUE_TYPE;
+
+          PROCEDURE CHK_INT IS NEW INT_QUEUE.ITERATOR (CHECK_INT);
+
+     BEGIN
+
+          ADD (Q2, -1);
+          ADD (Q2, 3);
+          ADD (Q2, 3);
+
+          CUR_INT_INDEX := 1;
+          CHK_INT (Q2);
+
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION - Q2");
+     END;
+
+     RESULT;
+
+END CC3019A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019b0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019b0.ada
new file mode 100644
index 000000000..b7a7a9d4e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019b0.ada
@@ -0,0 +1,191 @@
+-- CC3019B0.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 GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
+--  NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION.
+--
+-- HISTORY:
+--         EDWARD V. BERARD, 31 AUGUST 1990
+
+GENERIC
+     
+     TYPE ELEMENT IS LIMITED PRIVATE ;
+          
+     WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                            DESTINATION   : IN OUT ELEMENT) ;
+                                
+     WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
+                        RIGHT : IN ELEMENT) RETURN BOOLEAN ;
+                                       
+PACKAGE CC3019B0_LIST_CLASS IS
+     
+     TYPE LIST IS LIMITED PRIVATE ;
+          
+     OVERFLOW    : EXCEPTION ;
+     UNDERFLOW    : EXCEPTION ;
+          
+     PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
+                       TO_THIS_LIST        : IN OUT LIST) ;
+                       
+     PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
+                       FROM_THIS_LIST    : IN OUT LIST) ;
+                           
+     PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
+                       TO_THIS_LIST        : IN OUT LIST) ;
+                           
+     PROCEDURE CLEAR  (THIS_LIST           : IN OUT LIST) ;
+                               
+     GENERIC
+          
+          WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
+                                  CONTINUE        : OUT BOOLEAN) ;
+                                         
+     PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) ;
+                               
+     FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
+          RETURN NATURAL ;
+          
+     FUNCTION "=" (LEFT  : IN LIST ;
+                   RIGHT : IN LIST) RETURN BOOLEAN ;
+               
+PRIVATE
+     
+     TYPE LIST_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF ELEMENT ;
+          
+     TYPE LIST IS RECORD
+          LENGTH        : NATURAL := 0 ;
+          ACTUAL_LIST   : LIST_TABLE ;
+     END RECORD ;
+          
+END CC3019B0_LIST_CLASS ;
+     
+PACKAGE BODY CC3019B0_LIST_CLASS IS
+     
+     PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
+                       TO_THIS_LIST        : IN OUT LIST) IS
+                           
+     BEGIN  -- ADD
+          
+          IF TO_THIS_LIST.LENGTH >= 10 THEN
+               RAISE OVERFLOW ;
+          ELSE
+               TO_THIS_LIST.LENGTH := TO_THIS_LIST.LENGTH + 1 ;
+               ASSIGN (
+                    SOURCE      => THIS_ELEMENT,
+                    DESTINATION =>
+                        TO_THIS_LIST.ACTUAL_LIST (TO_THIS_LIST.LENGTH));
+          END IF ;
+          
+     END ADD ;
+                            
+     PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
+                       FROM_THIS_LIST    : IN OUT LIST) IS
+                               
+     BEGIN  -- DELETE
+          
+          IF FROM_THIS_LIST.LENGTH <= 0 THEN
+               RAISE UNDERFLOW ;
+          ELSE
+               ASSIGN (
+                    SOURCE      => 
+                      FROM_THIS_LIST.ACTUAL_LIST(FROM_THIS_LIST.LENGTH),
+                    DESTINATION => THIS_ELEMENT) ;
+               FROM_THIS_LIST.LENGTH := FROM_THIS_LIST.LENGTH - 1 ;
+          END IF ;
+          
+     END DELETE ;
+                            
+     PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
+                           TO_THIS_LIST        : IN OUT LIST) IS
+                               
+     BEGIN  -- COPY
+          
+          TO_THIS_LIST.LENGTH := THIS_LIST.LENGTH ;
+          FOR INDEX IN TO_THIS_LIST.ACTUAL_LIST'RANGE LOOP
+               ASSIGN (
+                    SOURCE      => THIS_LIST.ACTUAL_LIST (INDEX),
+                    DESTINATION => TO_THIS_LIST.ACTUAL_LIST (INDEX)) ;
+          END LOOP ;
+               
+     END COPY ;
+     
+     PROCEDURE CLEAR  (THIS_LIST          : IN OUT LIST) IS
+     
+     BEGIN  -- CLEAR
+     
+          THIS_LIST.LENGTH := 0 ;
+          
+     END CLEAR ;
+                               
+     PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) IS
+          
+          CONTINUE : BOOLEAN := TRUE ;
+          FINISHED : NATURAL := 0 ;
+               
+     BEGIN  -- ITERATE
+          
+          WHILE (CONTINUE = TRUE) AND (FINISHED < OVER_THIS_LIST.LENGTH)
+               LOOP
+                    FINISHED := FINISHED + 1 ;
+                    PROCESS (THIS_ELEMENT =>
+                                 OVER_THIS_LIST.ACTUAL_LIST (FINISHED),
+                              CONTINUE     => CONTINUE) ;
+               END LOOP ;
+                    
+     END ITERATE ;
+               
+     FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
+          RETURN NATURAL IS
+          
+     BEGIN  -- NUMBER_OF_ELEMENTS
+          
+          RETURN IN_THIS_LIST.LENGTH ;
+               
+     END NUMBER_OF_ELEMENTS ;
+          
+     FUNCTION "=" (LEFT  : IN LIST ;
+                   RIGHT : IN LIST) RETURN BOOLEAN IS
+                      
+          RESULT : BOOLEAN := TRUE ;
+          INDEX  : NATURAL := 0 ;
+          
+     BEGIN  -- "="
+     
+          IF LEFT.LENGTH /= RIGHT.LENGTH THEN
+               RESULT := FALSE ;
+          ELSE
+               WHILE (INDEX < LEFT.LENGTH) AND RESULT LOOP
+                    INDEX := INDEX + 1 ;
+                    IF LEFT.ACTUAL_LIST (INDEX) /=
+                       RIGHT.ACTUAL_LIST (INDEX) THEN
+                         RESULT := FALSE ;
+                    END IF ;
+               END LOOP ;
+          END IF ;
+          
+          RETURN RESULT ;
+          
+     END "=" ;
+               
+END CC3019B0_LIST_CLASS ;          
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019b1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019b1.ada
new file mode 100644
index 000000000..15dcb1370
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019b1.ada
@@ -0,0 +1,174 @@
+-- CC3019B1.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 GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
+--  NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION. IT IS USED
+--  BY THE MAIN PROCEDURE, I.E., CC3019B2M.ADA.
+--
+-- *** THIS FILE MUST BE COMPILED AFTER CC3019B0.ADA HAS BEEN
+-- *** COMPILED.
+--
+-- HISTORY:
+--         EDWARD V. BERARD, 31 AUGUST 1990
+
+WITH CC3019B0_LIST_CLASS ;
+
+GENERIC
+     
+     TYPE ELEMENT IS LIMITED PRIVATE ;
+          
+     WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                            DESTINATION   : IN OUT ELEMENT) ;
+                               
+     WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
+                        RIGHT : IN ELEMENT) RETURN BOOLEAN ;
+                                      
+PACKAGE CC3019B1_STACK_CLASS IS
+     
+     TYPE STACK IS LIMITED PRIVATE ;
+          
+     OVERFLOW    : EXCEPTION ;
+     UNDERFLOW   : EXCEPTION ;
+          
+     PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
+                     ON_TO_THIS_STACK    : IN OUT STACK) ;
+                        
+     PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
+                     OFF_THIS_STACK      : IN OUT STACK) ;
+                            
+     PROCEDURE COPY  (THIS_STACK       : IN OUT STACK ;
+                      TO_THIS_STACK    : IN OUT STACK) ;
+                         
+     PROCEDURE CLEAR (THIS_STACK       : IN OUT STACK) ;
+     
+     GENERIC
+          
+          WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
+                                  CONTINUE        : OUT BOOLEAN) ;
+                                        
+     PROCEDURE ITERATE (OVER_THIS_STACK    : IN STACK) ;
+                              
+     FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
+          RETURN NATURAL ;
+          
+     FUNCTION "=" (LEFT  : IN STACK ;
+                   RIGHT : IN STACK) RETURN BOOLEAN ;
+               
+PRIVATE
+
+     PACKAGE NEW_LIST_CLASS IS
+          NEW CC3019B0_LIST_CLASS (ELEMENT => ELEMENT,
+                                   ASSIGN  => ASSIGN,
+                                   "="     => "=") ;
+                                                      
+     TYPE STACK IS NEW NEW_LIST_CLASS.LIST ;
+          
+END CC3019B1_STACK_CLASS ;
+     
+PACKAGE BODY CC3019B1_STACK_CLASS IS
+     
+     PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
+                     ON_TO_THIS_STACK    : IN OUT STACK) IS
+                            
+     BEGIN  -- PUSH
+          
+          NEW_LIST_CLASS.ADD (
+               THIS_ELEMENT    => THIS_ELEMENT,
+               TO_THIS_LIST    =>
+                    NEW_LIST_CLASS.LIST (ON_TO_THIS_STACK)) ;
+                                    
+     EXCEPTION
+     
+          WHEN NEW_LIST_CLASS.OVERFLOW => RAISE OVERFLOW ;
+                                    
+     END PUSH ;
+                            
+     PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
+                     OFF_THIS_STACK      : IN OUT STACK) IS
+                            
+     BEGIN  -- POP
+          
+          NEW_LIST_CLASS.DELETE (
+               THIS_ELEMENT      => THIS_ELEMENT,
+               FROM_THIS_LIST    =>
+                         NEW_LIST_CLASS.LIST (OFF_THIS_STACK)) ;
+                                       
+     EXCEPTION
+     
+          WHEN NEW_LIST_CLASS.UNDERFLOW => RAISE UNDERFLOW ;
+                                    
+     END POP ;
+                            
+     PROCEDURE COPY  (THIS_STACK       : IN OUT STACK ;
+                      TO_THIS_STACK    : IN OUT STACK) IS
+                             
+     BEGIN  -- COPY
+          
+          NEW_LIST_CLASS.COPY (
+               THIS_LIST    => NEW_LIST_CLASS.LIST (THIS_STACK),
+               TO_THIS_LIST => NEW_LIST_CLASS.LIST (TO_THIS_STACK)) ;
+               
+     END COPY ;
+     
+     PROCEDURE CLEAR (THIS_STACK        : IN OUT STACK) IS
+     
+     BEGIN  -- CLEAR
+     
+          NEW_LIST_CLASS.CLEAR (NEW_LIST_CLASS.LIST (THIS_STACK)) ;
+          
+     END CLEAR ;
+     
+     PROCEDURE ITERATE (OVER_THIS_STACK    : IN STACK) IS
+     
+          PROCEDURE STACK_ITERATE IS NEW NEW_LIST_CLASS.ITERATE
+               (PROCESS => PROCESS) ;
+               
+     BEGIN  -- ITERATE
+     
+          STACK_ITERATE (NEW_LIST_CLASS.LIST (OVER_THIS_STACK)) ;
+          
+     END ITERATE ;
+
+     FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
+          RETURN NATURAL IS
+               
+     BEGIN  -- NUMBER_OF_ELEMENTS
+          
+          RETURN NEW_LIST_CLASS.NUMBER_OF_ELEMENTS
+               (IN_THIS_LIST => NEW_LIST_CLASS.LIST (ON_THIS_STACK)) ;
+                    
+     END NUMBER_OF_ELEMENTS ;
+          
+     FUNCTION "=" (LEFT  : IN STACK ;
+                   RIGHT : IN STACK) RETURN BOOLEAN IS
+     
+     BEGIN  -- "="
+     
+          RETURN NEW_LIST_CLASS."=" (
+               LEFT  => NEW_LIST_CLASS.LIST (LEFT),
+               RIGHT => NEW_LIST_CLASS.LIST (RIGHT)) ;
+                                       
+     END "=" ;
+               
+END CC3019B1_STACK_CLASS ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019b2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019b2.ada
new file mode 100644
index 000000000..52bf79ddc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019b2.ada
@@ -0,0 +1,300 @@
+-- CC3019B2M.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 INSTANTIATIONS OF UNITS WITHIN GENERIC UNITS, E.G.,
+--  TO SUPPORT ITERATORS. THIS TEST SPECIFICALLY CHECKS THAT A
+--  NESTING LEVEL OF 2 IS SUPPORTED FOR GENERICS.
+--
+--  *** THIS IS THE MAIN PROGRAM. IT MUST BE COMPILED AFTER THE
+--  *** SOURCE CODE IN FILES CC3019B0.ADA AND CC3019B1.ADA HAVE
+--  *** BEEN COMPILED.
+--
+-- HISTORY:
+--         EDWARD V. BERARD, 31 AUGUST 1990
+
+WITH REPORT ;
+WITH CC3019B1_STACK_CLASS ;
+
+PROCEDURE CC3019B2M IS
+
+     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                         SEP, OCT, NOV, DEC) ;
+     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+     TYPE DATE IS RECORD
+          MONTH : MONTH_TYPE ;
+          DAY   : DAY_TYPE ;
+          YEAR  : YEAR_TYPE ;
+     END RECORD ;
+     
+     STORE_DATE     : DATE ;
+
+     TODAY        : DATE := (MONTH => AUG,
+                             DAY   => 31,
+                             YEAR  => 1990) ;
+                                    
+     FIRST_DATE   : DATE := (MONTH => JUN,
+                             DAY   => 4,
+                             YEAR  => 1967) ;
+                                    
+     BIRTH_DATE   : DATE := (MONTH => OCT,
+                             DAY   => 3,
+                             YEAR  => 1949) ;
+                                    
+     WALL_DATE    : DATE := (MONTH => NOV,
+                             DAY   => 9,
+                             YEAR  => 1989) ;
+                                    
+     PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
+                       TO_THIS_DATE              : IN OUT DATE) ;
+                              
+     FUNCTION IS_EQUAL (LEFT  : IN DATE ;
+                        RIGHT : IN DATE) RETURN BOOLEAN ;
+
+     PACKAGE DATE_STACK IS
+          NEW CC3019B1_STACK_CLASS (ELEMENT => DATE,
+                                    ASSIGN  => ASSIGN,
+                                    "="     => IS_EQUAL) ;
+                                                   
+     FIRST_DATE_STACK    : DATE_STACK.STACK ;
+     SECOND_DATE_STACK   : DATE_STACK.STACK ;
+     THIRD_DATE_STACK    : DATE_STACK.STACK ;
+     
+     FUNCTION "=" (LEFT  : IN DATE_STACK.STACK ;
+                   RIGHT : IN DATE_STACK.STACK) RETURN BOOLEAN
+                   RENAMES DATE_STACK."=" ;
+                              
+     PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
+                       TO_THIS_DATE              : IN OUT DATE) IS
+                              
+     BEGIN -- ASSIGN
+          
+          TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ;
+                
+     END ASSIGN ;
+                                            
+     FUNCTION IS_EQUAL (LEFT  : IN DATE ;
+                        RIGHT : IN DATE) RETURN BOOLEAN IS
+                         
+     BEGIN -- IS_EQUAL
+     
+          RETURN (LEFT.MONTH = RIGHT.MONTH) AND
+                 (LEFT.DAY = RIGHT.DAY) AND
+                 (LEFT.YEAR = RIGHT.YEAR) ;
+          
+     END IS_EQUAL ;
+
+BEGIN  -- CC3019B2M
+
+     REPORT.TEST ("CC3019B2M",
+                  "CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC " &
+                  "UNITS, E.G., TO SUPPORT ITERATORS. THIS TEST " &
+                  "SPECIFICALLY CHECKS THAT A NESTING LEVEL OF " &
+                  "2 IS SUPPORTED FOR GENERICS.") ;
+                        
+     DATE_STACK.CLEAR (THIS_STACK => FIRST_DATE_STACK) ;
+     IF DATE_STACK.NUMBER_OF_ELEMENTS 
+        (ON_THIS_STACK => FIRST_DATE_STACK) /= 0 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ;
+     END IF ;
+     
+     DATE_STACK.PUSH (THIS_ELEMENT     => TODAY,
+                      ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
+     IF DATE_STACK.NUMBER_OF_ELEMENTS 
+        (ON_THIS_STACK => FIRST_DATE_STACK) /= 1 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ;
+     END IF ;
+     
+     DATE_STACK.PUSH (THIS_ELEMENT     => FIRST_DATE,
+                      ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
+     IF DATE_STACK.NUMBER_OF_ELEMENTS 
+        (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ;
+     END IF ;
+     
+     DATE_STACK.PUSH (THIS_ELEMENT     => BIRTH_DATE,
+                      ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
+     IF DATE_STACK.NUMBER_OF_ELEMENTS 
+        (ON_THIS_STACK => FIRST_DATE_STACK) /= 3 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ;
+     END IF ;
+     
+     DATE_STACK.POP (THIS_ELEMENT   => STORE_DATE,
+                           OFF_THIS_STACK => FIRST_DATE_STACK) ;
+     IF DATE_STACK.NUMBER_OF_ELEMENTS 
+        (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ;
+     END IF ;
+     
+     IF STORE_DATE /= BIRTH_DATE THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE REMOVED FROM STACK - 1") ;
+     END IF ;
+     
+     DATE_STACK.CLEAR (THIS_STACK => SECOND_DATE_STACK) ;
+     IF DATE_STACK.NUMBER_OF_ELEMENTS 
+        (ON_THIS_STACK => SECOND_DATE_STACK) /= 0 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ;
+     END IF ;
+          
+     DATE_STACK.COPY (THIS_STACK    => FIRST_DATE_STACK,
+                      TO_THIS_STACK => SECOND_DATE_STACK) ;
+                             
+     IF FIRST_DATE_STACK /= SECOND_DATE_STACK THEN
+          REPORT.FAILED (
+               "PROBLEMS WITH COPY OR TEST FOR EQUALITY") ;
+     END IF ;
+     
+     DATE_STACK.POP (THIS_ELEMENT   => STORE_DATE,
+                     OFF_THIS_STACK => SECOND_DATE_STACK) ;
+     DATE_STACK.PUSH (THIS_ELEMENT     => WALL_DATE,
+                      ON_TO_THIS_STACK => SECOND_DATE_STACK) ;
+     IF FIRST_DATE_STACK = SECOND_DATE_STACK THEN
+          REPORT.FAILED (
+               "PROBLEMS WITH POP OR TEST FOR EQUALITY") ;
+     END IF ;
+     
+     UNDERFLOW_EXCEPTION_TEST:
+     
+     BEGIN  -- UNDERFLOW_EXCEPTION_TEST
+     
+          DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ;
+          DATE_STACK.POP (THIS_ELEMENT      => STORE_DATE,
+                          OFF_THIS_STACK    => THIRD_DATE_STACK) ;
+          REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ;
+     
+     EXCEPTION
+     
+          WHEN DATE_STACK.UNDERFLOW => NULL ;  -- CORRECT EXCEPTION
+                                               -- RAISED
+          WHEN OTHERS =>
+               REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
+                              "UNDERFLOW EXCEPTION TEST") ;
+                                              
+     END UNDERFLOW_EXCEPTION_TEST ;
+     
+     OVERFLOW_EXCEPTION_TEST:
+     
+     BEGIN  -- OVERFLOW_EXCEPTION_TEST
+     
+          DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ;
+          FOR INDEX IN 1 .. 10 LOOP
+               DATE_STACK.PUSH ( THIS_ELEMENT     => TODAY,
+                                 ON_TO_THIS_STACK => THIRD_DATE_STACK) ;
+          END LOOP ;
+          
+          DATE_STACK.PUSH (THIS_ELEMENT     => TODAY,
+                           ON_TO_THIS_STACK => THIRD_DATE_STACK) ;
+          REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ;
+     
+     EXCEPTION
+     
+          WHEN DATE_STACK.OVERFLOW => NULL ;  -- CORRECT EXCEPTION
+                                              -- RAISED
+          WHEN OTHERS =>
+               REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
+                              "OVERFLOW EXCEPTION TEST") ;
+                                              
+     END OVERFLOW_EXCEPTION_TEST ;
+
+     LOCAL_BLOCK:
+     
+     DECLARE
+     
+          TYPE DATE_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF DATE ;
+     
+          FIRST_DATE_TABLE : DATE_TABLE ;
+     
+          TABLE_INDEX : POSITIVE := 1 ;
+     
+          PROCEDURE SHOW_DATES (THIS_DATE : IN  DATE ;
+                                CONTINUE  : OUT BOOLEAN) ;
+                                      
+          PROCEDURE STORE_DATES (THIS_DATE : IN DATE ;
+                                 CONTINUE  : OUT BOOLEAN) ;
+                                      
+          PROCEDURE SHOW_DATE_ITERATE IS NEW 
+               DATE_STACK.ITERATE (PROCESS => SHOW_DATES) ;
+                                
+          PROCEDURE STORE_DATE_ITERATE IS NEW 
+               DATE_STACK.ITERATE (PROCESS => STORE_DATES) ;
+                                
+          PROCEDURE SHOW_DATES (THIS_DATE : IN  DATE ;
+                                CONTINUE  : OUT BOOLEAN) IS
+          BEGIN  -- SHOW_DATES
+          
+                REPORT.COMMENT ("THE MONTH IS " &
+                           MONTH_TYPE'IMAGE (THIS_DATE.MONTH)) ;
+                REPORT.COMMENT ("THE DAY IS " &
+                           DAY_TYPE'IMAGE (THIS_DATE.DAY)) ;
+                REPORT.COMMENT ("THE YEAR IS " &
+                           YEAR_TYPE'IMAGE (THIS_DATE.YEAR)) ;
+                
+                CONTINUE := TRUE ;
+                           
+          END SHOW_DATES ;
+          
+          PROCEDURE STORE_DATES (THIS_DATE : IN  DATE ;
+                                       CONTINUE  : OUT BOOLEAN) IS
+          BEGIN  -- STORE_DATES
+          
+                FIRST_DATE_TABLE (TABLE_INDEX) := THIS_DATE ;
+                TABLE_INDEX := TABLE_INDEX + 1 ;
+                
+                CONTINUE := TRUE ;
+                
+          END STORE_DATES ;
+          
+     BEGIN  -- LOCAL_BLOCK
+     
+          REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ;
+          SHOW_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ;
+
+          REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ;
+          SHOW_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ;
+
+          STORE_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ;
+          IF (FIRST_DATE_TABLE (1) /= TODAY) OR
+               (FIRST_DATE_TABLE (2) /= FIRST_DATE) THEN
+                     REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ;
+          END IF ;
+          
+          TABLE_INDEX := 1 ;
+          STORE_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ;
+          IF (FIRST_DATE_TABLE (1) /= TODAY) OR
+               (FIRST_DATE_TABLE (2) /= WALL_DATE) THEN
+                     REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ;
+          END IF ;
+          
+     END LOCAL_BLOCK ;
+     
+     REPORT.RESULT ;
+     
+END CC3019B2M ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019c0.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019c0.ada
new file mode 100644
index 000000000..d34ff79f0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019c0.ada
@@ -0,0 +1,191 @@
+-- CC3019C0.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
+--   THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
+--   NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION.
+--
+-- HISTORY:
+--         EDWARD V. BERARD, 31 AUGUST 1990
+
+GENERIC
+
+     TYPE ELEMENT IS LIMITED PRIVATE ;
+
+     WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                            DESTINATION   : IN OUT ELEMENT) ;
+
+     WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
+                        RIGHT : IN ELEMENT) RETURN BOOLEAN ;
+
+PACKAGE CC3019C0_LIST_CLASS IS
+
+     TYPE LIST IS LIMITED PRIVATE ;
+
+     OVERFLOW    : EXCEPTION ;
+     UNDERFLOW   : EXCEPTION ;
+
+     PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
+                       TO_THIS_LIST        : IN OUT LIST) ;
+
+     PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
+                       FROM_THIS_LIST    : IN OUT LIST) ;
+
+     PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
+                       TO_THIS_LIST        : IN OUT LIST) ;
+
+     PROCEDURE CLEAR  (THIS_LIST           : IN OUT LIST) ;
+
+     GENERIC
+
+          WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
+                                  CONTINUE        : OUT BOOLEAN) ;
+
+     PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) ;
+
+     FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
+          RETURN NATURAL ;
+
+     FUNCTION "=" (LEFT  : IN LIST ;
+                   RIGHT : IN LIST) RETURN BOOLEAN ;
+
+PRIVATE
+
+     TYPE LIST_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF ELEMENT ;
+
+     TYPE LIST IS RECORD
+          LENGTH        : NATURAL := 0 ;
+          ACTUAL_LIST   : LIST_TABLE ;
+     END RECORD ;
+
+END CC3019C0_LIST_CLASS ;
+
+PACKAGE BODY CC3019C0_LIST_CLASS IS
+
+     PROCEDURE ADD    (THIS_ELEMENT        : IN OUT ELEMENT ;
+                       TO_THIS_LIST        : IN OUT LIST) IS
+
+     BEGIN  -- ADD
+
+          IF TO_THIS_LIST.LENGTH >= 10 THEN
+               RAISE OVERFLOW ;
+          ELSE
+               TO_THIS_LIST.LENGTH := TO_THIS_LIST.LENGTH + 1 ;
+               ASSIGN (
+                    SOURCE      => THIS_ELEMENT,
+                    DESTINATION =>
+                         TO_THIS_LIST.ACTUAL_LIST(TO_THIS_LIST.LENGTH));
+          END IF ;
+
+     END ADD ;
+
+     PROCEDURE DELETE (THIS_ELEMENT      : IN OUT ELEMENT ;
+                       FROM_THIS_LIST    : IN OUT LIST) IS
+
+     BEGIN  -- DELETE
+
+          IF FROM_THIS_LIST.LENGTH <= 0 THEN
+               RAISE UNDERFLOW ;
+          ELSE
+               ASSIGN (
+                    SOURCE      =>
+                      FROM_THIS_LIST.ACTUAL_LIST(FROM_THIS_LIST.LENGTH),
+                    DESTINATION => THIS_ELEMENT) ;
+               FROM_THIS_LIST.LENGTH := FROM_THIS_LIST.LENGTH - 1 ;
+          END IF ;
+
+     END DELETE ;
+
+     PROCEDURE COPY   (THIS_LIST           : IN OUT LIST ;
+                       TO_THIS_LIST        : IN OUT LIST) IS
+
+     BEGIN  -- COPY
+
+          TO_THIS_LIST.LENGTH := THIS_LIST.LENGTH ;
+          FOR INDEX IN TO_THIS_LIST.ACTUAL_LIST'RANGE LOOP
+               ASSIGN (SOURCE      => THIS_LIST.ACTUAL_LIST (INDEX),
+                       DESTINATION => TO_THIS_LIST.ACTUAL_LIST (INDEX));
+          END LOOP ;
+
+     END COPY ;
+
+     PROCEDURE CLEAR  (THIS_LIST         : IN OUT LIST) IS
+
+     BEGIN  -- CLEAR
+
+          THIS_LIST.LENGTH := 0 ;
+
+     END CLEAR ;
+
+     PROCEDURE ITERATE (OVER_THIS_LIST    : IN LIST) IS
+
+          CONTINUE : BOOLEAN := TRUE ;
+          FINISHED : NATURAL := 0 ;
+
+     BEGIN  -- ITERATE
+
+          WHILE (CONTINUE = TRUE) AND (FINISHED < OVER_THIS_LIST.LENGTH)
+               LOOP
+                    FINISHED := FINISHED + 1 ;
+                    PROCESS (THIS_ELEMENT =>
+                                OVER_THIS_LIST.ACTUAL_LIST (FINISHED),
+                             CONTINUE     => CONTINUE) ;
+               END LOOP ;
+
+     END ITERATE ;
+
+     FUNCTION NUMBER_OF_ELEMENTS (IN_THIS_LIST : IN LIST)
+          RETURN NATURAL IS
+
+     BEGIN  -- NUMBER_OF_ELEMENTS
+
+          RETURN IN_THIS_LIST.LENGTH ;
+
+     END NUMBER_OF_ELEMENTS ;
+
+     FUNCTION "=" (LEFT  : IN LIST ;
+                   RIGHT : IN LIST) RETURN BOOLEAN IS
+
+          RESULT : BOOLEAN := TRUE ;
+          INDEX  : NATURAL := 0 ;
+
+     BEGIN  -- "="
+
+          IF LEFT.LENGTH /= RIGHT.LENGTH THEN
+               RESULT := FALSE ;
+          ELSE
+               WHILE (INDEX < LEFT.LENGTH) AND RESULT LOOP
+                    INDEX := INDEX + 1 ;
+                    IF LEFT.ACTUAL_LIST (INDEX) /=
+                       RIGHT.ACTUAL_LIST (INDEX) THEN
+                        RESULT := FALSE ;
+                    END IF ;
+               END LOOP ;
+          END IF ;
+
+          RETURN RESULT ;
+
+     END "=" ;
+
+END CC3019C0_LIST_CLASS ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019c1.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019c1.ada
new file mode 100644
index 000000000..527c27f5a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019c1.ada
@@ -0,0 +1,331 @@
+-- CC3019C1.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 GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
+--  NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION. IT IS USED
+--  BY MAIN PROCEDURE CC3019C2M.ADA.
+--
+-- HISTORY:
+--         EDWARD V. BERARD, 31 AUGUST 1990
+
+WITH CC3019C0_LIST_CLASS ;
+
+GENERIC
+
+     TYPE ELEMENT IS LIMITED PRIVATE ;
+
+     WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                            DESTINATION   : IN OUT ELEMENT) ;
+
+     WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
+                        RIGHT : IN ELEMENT) RETURN BOOLEAN ;
+
+PACKAGE CC3019C1_NESTED_GENERICS IS
+
+     TYPE NESTED_GENERICS_TYPE IS LIMITED PRIVATE ;
+
+     PROCEDURE COPY (SOURCE        : IN OUT NESTED_GENERICS_TYPE ;
+                     DESTINATION   : IN OUT NESTED_GENERICS_TYPE) ;
+
+     PROCEDURE SET_ELEMENT
+                    (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
+                     TO_THIS_ELEMENT     : IN OUT ELEMENT) ;
+
+     PROCEDURE SET_NUMBER
+                    (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
+                     TO_THIS_NUMBER      : IN NATURAL) ;
+
+     FUNCTION "=" (LEFT  : IN NESTED_GENERICS_TYPE ;
+                   RIGHT : IN NESTED_GENERICS_TYPE) RETURN BOOLEAN ;
+
+     FUNCTION ELEMENT_OF (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
+          RETURN ELEMENT ;
+
+     FUNCTION NUMBER_OF  (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
+          RETURN NATURAL ;
+
+     GENERIC
+
+          TYPE ELEMENT IS LIMITED PRIVATE ;
+
+          WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                                 DESTINATION   : IN OUT ELEMENT) ;
+
+     PACKAGE GENERIC_TASK IS
+
+          TASK TYPE PROTECTED_AREA IS
+
+                    ENTRY STORE (ITEM    : IN OUT ELEMENT) ;
+                    ENTRY GET   (ITEM    : IN OUT ELEMENT) ;
+
+          END PROTECTED_AREA ;
+
+     END GENERIC_TASK ;
+
+     GENERIC
+
+          TYPE ELEMENT IS LIMITED PRIVATE ;
+
+          WITH PROCEDURE ASSIGN (SOURCE        : IN OUT ELEMENT ;
+                                 DESTINATION   : IN OUT ELEMENT) ;
+
+          WITH FUNCTION "=" (LEFT  : IN ELEMENT ;
+                             RIGHT : IN ELEMENT) RETURN BOOLEAN ;
+
+     PACKAGE STACK_CLASS IS
+
+          TYPE STACK IS LIMITED PRIVATE ;
+
+          OVERFLOW    : EXCEPTION ;
+          UNDERFLOW   : EXCEPTION ;
+
+          PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
+                          ON_TO_THIS_STACK    : IN OUT STACK) ;
+
+          PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
+                          OFF_THIS_STACK      : IN OUT STACK) ;
+
+          PROCEDURE COPY  (THIS_STACK        : IN OUT STACK ;
+                           TO_THIS_STACK    : IN OUT STACK) ;
+
+          PROCEDURE CLEAR (THIS_STACK        : IN OUT STACK) ;
+
+          GENERIC
+
+               WITH PROCEDURE PROCESS (THIS_ELEMENT    : IN  ELEMENT ;
+                                       CONTINUE        : OUT BOOLEAN) ;
+
+          PROCEDURE ITERATE (OVER_THIS_STACK    : IN STACK) ;
+
+          FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
+                    RETURN NATURAL ;
+
+          FUNCTION "=" (LEFT  : IN STACK ;
+                        RIGHT : IN STACK) RETURN BOOLEAN ;
+
+     PRIVATE
+
+          PACKAGE NEW_LIST_CLASS IS NEW
+               CC3019C0_LIST_CLASS (ELEMENT => ELEMENT,
+                                    ASSIGN  => ASSIGN,
+                                    "="     => "=") ;
+
+          TYPE STACK IS NEW NEW_LIST_CLASS.LIST ;
+
+     END STACK_CLASS ;
+
+PRIVATE
+
+     TYPE NESTED_GENERICS_TYPE IS RECORD
+          FIRST    : ELEMENT ;
+          SECOND   : NATURAL ;
+     END RECORD ;
+
+END CC3019C1_NESTED_GENERICS ;
+
+PACKAGE BODY CC3019C1_NESTED_GENERICS IS
+
+     PROCEDURE COPY (SOURCE        : IN OUT NESTED_GENERICS_TYPE ;
+                     DESTINATION   : IN OUT NESTED_GENERICS_TYPE) IS
+
+     BEGIN  -- COPY
+
+          ASSIGN (SOURCE        => SOURCE.FIRST,
+                  DESTINATION   => DESTINATION.FIRST) ;
+
+          DESTINATION.SECOND := SOURCE.SECOND ;
+
+     END COPY ;
+
+     PROCEDURE SET_ELEMENT
+          (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
+          TO_THIS_ELEMENT     : IN OUT ELEMENT) IS
+
+     BEGIN  -- SET_ELEMENT
+
+          ASSIGN (SOURCE        => TO_THIS_ELEMENT,
+                  DESTINATION   => FOR_THIS_NGT_OBJECT.FIRST) ;
+
+     END SET_ELEMENT ;
+
+     PROCEDURE SET_NUMBER
+          (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
+          TO_THIS_NUMBER      : IN NATURAL) IS
+
+     BEGIN  -- SET_NUMBER
+
+          FOR_THIS_NGT_OBJECT.SECOND := TO_THIS_NUMBER ;
+
+     END SET_NUMBER ;
+
+     FUNCTION "=" (LEFT  : IN NESTED_GENERICS_TYPE ;
+                   RIGHT : IN NESTED_GENERICS_TYPE) RETURN BOOLEAN IS
+
+     BEGIN  -- "="
+
+          IF (LEFT.FIRST = RIGHT.FIRST) AND
+             (LEFT.SECOND = RIGHT.SECOND) THEN
+                       RETURN TRUE ;
+          ELSE
+                    RETURN FALSE ;
+          END IF ;
+
+     END "=" ;
+
+     FUNCTION ELEMENT_OF (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
+          RETURN ELEMENT IS
+
+     BEGIN  -- ELEMENT_OF
+
+          RETURN THIS_NGT_OBJECT.FIRST ;
+
+     END ELEMENT_OF ;
+
+     FUNCTION NUMBER_OF (THIS_NGT_OBJECT    : IN NESTED_GENERICS_TYPE)
+          RETURN NATURAL IS
+
+     BEGIN  -- NUMBER_OF
+
+          RETURN THIS_NGT_OBJECT.SECOND ;
+
+     END NUMBER_OF ;
+
+     PACKAGE BODY GENERIC_TASK IS
+
+          TASK BODY PROTECTED_AREA IS
+
+               LOCAL_STORE : ELEMENT ;
+
+          BEGIN  -- PROTECTED_AREA
+
+               LOOP
+                    SELECT
+                         ACCEPT STORE (ITEM    : IN OUT ELEMENT) DO
+                              ASSIGN (SOURCE        => ITEM,
+                                      DESTINATION   => LOCAL_STORE) ;
+                         END STORE ;
+                    OR
+                         ACCEPT GET   (ITEM    : IN OUT ELEMENT) DO
+                              ASSIGN (SOURCE        => LOCAL_STORE,
+                                      DESTINATION   => ITEM) ;
+                         END GET ;
+                    OR
+                         TERMINATE ;
+                    END SELECT ;
+               END LOOP ;
+
+          END PROTECTED_AREA ;
+
+     END GENERIC_TASK ;
+
+     PACKAGE BODY STACK_CLASS IS
+
+          PROCEDURE PUSH (THIS_ELEMENT        : IN OUT ELEMENT ;
+                          ON_TO_THIS_STACK    : IN OUT STACK) IS
+
+          BEGIN  -- PUSH
+
+              NEW_LIST_CLASS.ADD (
+                    THIS_ELEMENT    => THIS_ELEMENT,
+                    TO_THIS_LIST    =>
+                         NEW_LIST_CLASS.LIST (ON_TO_THIS_STACK)) ;
+
+          EXCEPTION
+
+              WHEN NEW_LIST_CLASS.OVERFLOW => RAISE OVERFLOW ;
+
+          END PUSH ;
+
+          PROCEDURE POP  (THIS_ELEMENT        : IN OUT ELEMENT ;
+                          OFF_THIS_STACK      : IN OUT STACK) IS
+
+          BEGIN  -- POP
+
+               NEW_LIST_CLASS.DELETE (
+                    THIS_ELEMENT     => THIS_ELEMENT,
+                    FROM_THIS_LIST   =>
+                        NEW_LIST_CLASS.LIST (OFF_THIS_STACK)) ;
+
+          EXCEPTION
+
+                    WHEN NEW_LIST_CLASS.UNDERFLOW => RAISE UNDERFLOW ;
+
+          END POP ;
+
+          PROCEDURE COPY  (THIS_STACK       : IN OUT STACK ;
+                           TO_THIS_STACK    : IN OUT STACK) IS
+
+          BEGIN  -- COPY
+
+              NEW_LIST_CLASS.COPY (
+                    THIS_LIST    => NEW_LIST_CLASS.LIST (THIS_STACK),
+                    TO_THIS_LIST =>
+                         NEW_LIST_CLASS.LIST (TO_THIS_STACK)) ;
+
+          END COPY ;
+
+          PROCEDURE CLEAR (THIS_STACK        : IN OUT STACK) IS
+
+          BEGIN  -- CLEAR
+
+               NEW_LIST_CLASS.CLEAR (NEW_LIST_CLASS.LIST (THIS_STACK)) ;
+
+          END CLEAR ;
+
+          PROCEDURE ITERATE (OVER_THIS_STACK  : IN STACK) IS
+
+               PROCEDURE STACK_ITERATE IS NEW NEW_LIST_CLASS.ITERATE
+                                        (PROCESS => PROCESS) ;
+
+          BEGIN  -- ITERATE
+
+               STACK_ITERATE (NEW_LIST_CLASS.LIST (OVER_THIS_STACK)) ;
+
+          END ITERATE ;
+
+          FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK    : IN STACK)
+                    RETURN NATURAL IS
+
+          BEGIN  -- NUMBER_OF_ELEMENTS
+
+               RETURN NEW_LIST_CLASS.NUMBER_OF_ELEMENTS
+                    (IN_THIS_LIST =>
+                         NEW_LIST_CLASS.LIST (ON_THIS_STACK)) ;
+
+          END NUMBER_OF_ELEMENTS ;
+
+          FUNCTION "=" (LEFT  : IN STACK ;
+                        RIGHT : IN STACK) RETURN BOOLEAN IS
+
+          BEGIN  -- "="
+
+               RETURN NEW_LIST_CLASS."=" (
+                    LEFT  => NEW_LIST_CLASS.LIST (LEFT),
+                   RIGHT => NEW_LIST_CLASS.LIST (RIGHT)) ;
+
+          END "=" ;
+
+     END STACK_CLASS ;
+
+END CC3019C1_NESTED_GENERICS ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019c2.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019c2.ada
new file mode 100644
index 000000000..8fab9e623
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3019c2.ada
@@ -0,0 +1,457 @@
+-- CC3019C2M.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 INSTANTIATIONS OF UNITS WITHIN GENERIC UNITS, E.G.
+--   TO SUPPORT ITERATORS.
+
+--  THIS TEST SPECIFICALLY CHECKS THAT A
+--  NESTING LEVEL OF 3 IS SUPPORTED FOR GENERICS:
+--       INSTANTIATE CC3019C1_NESTED_GENERICS IN THE MAIN
+--       PROCEDURE, THE INSTANTIATION OF CC3019C0_LIST_CLASS
+--       IN GENERIC PACKAGE CC3019C1_NESTED_GENERICS, AND
+--       THE INSTANTIATION OF NEW_LIST_CLASS.ITERATE IN
+--       PROCEDURE ITERATE IN PACKAGE BODY STACK_CLASS.
+--
+--  *** THIS IS THE MAIN PROGRAM. IT MUST BE COMPILED AFTER THE
+--  *** SOURCE CODE IN FILES CC3019C0.ADA AND CC3019C1.ADA HAVE
+--  *** BEEN COMPILED.
+--
+-- HISTORY:
+--         EDWARD V. BERARD, 31 AUGUST 1990
+
+WITH REPORT ;
+WITH CC3019C1_NESTED_GENERICS ;
+
+PROCEDURE CC3019C2M IS
+
+     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                         SEP, OCT, NOV, DEC) ;
+     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+     TYPE DATE IS RECORD
+          MONTH : MONTH_TYPE ;
+          DAY   : DAY_TYPE ;
+          YEAR  : YEAR_TYPE ;
+     END RECORD ;
+
+     STORE_DATE   : DATE ;
+
+     TODAY        : DATE := (MONTH => AUG,
+                             DAY   => 31,
+                             YEAR  => 1990) ;
+
+     FIRST_DATE   : DATE := (MONTH => JUN,
+                             DAY   => 4,
+                             YEAR  => 1967) ;
+
+     BIRTH_DATE   : DATE := (MONTH => OCT,
+                             DAY   => 3,
+                             YEAR  => 1949) ;
+
+     WALL_DATE    : DATE := (MONTH => NOV,
+                             DAY   => 9,
+                             YEAR  => 1989) ;
+
+     TYPE SEX IS (MALE, FEMALE) ;
+
+     TYPE PERSON IS RECORD
+          BIRTH_DATE : DATE ;
+          GENDER     : SEX ;
+          NAME       : STRING (1 .. 10) ;
+     END RECORD ;
+
+     FIRST_PERSON  : PERSON ;
+     SECOND_PERSON : PERSON ;
+
+     MYSELF      : PERSON := (BIRTH_DATE => BIRTH_DATE,
+                              GENDER     => MALE,
+                              NAME        => "ED        ") ;
+
+     FRIEND      : PERSON := (BIRTH_DATE => DATE'(DEC, 27, 1949),
+                              GENDER     => MALE,
+                              NAME        => "DENNIS    ") ;
+
+     FATHER      : PERSON := (BIRTH_DATE => DATE'(JUL, 5, 1925),
+                              GENDER     => MALE,
+                              NAME        => "EDWARD    ") ;
+
+     DAUGHTER    : PERSON := (BIRTH_DATE => DATE'(DEC, 10, 1980),
+                              GENDER     => FEMALE,
+                              NAME       => "CHRISSY   ") ;
+
+     PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
+                       TO_THIS_DATE              : IN OUT DATE) ;
+
+     FUNCTION IS_EQUAL (LEFT  : IN DATE ;
+                        RIGHT : IN DATE) RETURN BOOLEAN ;
+
+     PROCEDURE ASSIGN (THE_VALUE_OF_THIS_PERSON  : IN OUT PERSON ;
+                       TO_THIS_PERSON            : IN OUT PERSON) ;
+
+     FUNCTION IS_EQUAL (LEFT  : IN PERSON ;
+                        RIGHT : IN PERSON) RETURN BOOLEAN ;
+
+--  INSTANTIATE OUTER GENERIC PACKAGE
+
+     PACKAGE NEW_NESTED_GENERICS IS NEW
+          CC3019C1_NESTED_GENERICS (ELEMENT => DATE,
+                                    ASSIGN  => ASSIGN,
+                                    "="     => IS_EQUAL) ;
+
+     FIRST_NNG  : NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ;
+     SECOND_NNG : NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ;
+
+     FUNCTION "=" (LEFT  : IN NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ;
+                   RIGHT : IN NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE)
+                   RETURN BOOLEAN RENAMES NEW_NESTED_GENERICS."=" ;
+
+--  INSTANTIATE NESTED TASK PACKAGE
+
+     PACKAGE NEW_GENERIC_TASK IS NEW
+          NEW_NESTED_GENERICS.GENERIC_TASK (ELEMENT => PERSON,
+                                            ASSIGN  => ASSIGN) ;
+
+     FIRST_GENERIC_TASK  : NEW_GENERIC_TASK.PROTECTED_AREA ;
+     SECOND_GENERIC_TASK : NEW_GENERIC_TASK.PROTECTED_AREA ;
+
+--  INSTANTIATE NESTED STACK PACKAGE
+
+     PACKAGE PERSON_STACK IS NEW
+          NEW_NESTED_GENERICS.STACK_CLASS (ELEMENT => PERSON,
+                                           ASSIGN  => ASSIGN,
+                                           "="     => IS_EQUAL) ;
+
+     FIRST_PERSON_STACK  : PERSON_STACK.STACK ;
+     SECOND_PERSON_STACK : PERSON_STACK.STACK ;
+     THIRD_PERSON_STACK  : PERSON_STACK.STACK ;
+
+     FUNCTION "=" (LEFT  : IN PERSON_STACK.STACK ;
+                   RIGHT : IN PERSON_STACK.STACK) RETURN BOOLEAN
+              RENAMES PERSON_STACK."=" ;
+
+     PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
+                       TO_THIS_DATE              : IN OUT DATE) IS
+
+     BEGIN -- ASSIGN
+
+          TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ;
+
+     END ASSIGN ;
+
+     FUNCTION IS_EQUAL (LEFT  : IN DATE ;
+                        RIGHT : IN DATE) RETURN BOOLEAN IS
+
+     BEGIN -- IS_EQUAL
+
+          IF (LEFT.MONTH = RIGHT.MONTH) AND (LEFT.DAY = RIGHT.DAY)
+             AND (LEFT.YEAR = RIGHT.YEAR) THEN
+               RETURN TRUE ;
+          ELSE
+               RETURN FALSE ;
+          END IF ;
+
+     END IS_EQUAL ;
+
+     PROCEDURE ASSIGN (THE_VALUE_OF_THIS_PERSON  : IN OUT PERSON ;
+                       TO_THIS_PERSON            : IN OUT PERSON) IS
+
+     BEGIN -- ASSIGN
+
+          TO_THIS_PERSON := THE_VALUE_OF_THIS_PERSON ;
+
+     END ASSIGN ;
+
+     FUNCTION IS_EQUAL (LEFT  : IN PERSON ;
+                        RIGHT : IN PERSON) RETURN BOOLEAN IS
+
+     BEGIN -- IS_EQUAL
+
+          IF (LEFT.BIRTH_DATE = RIGHT.BIRTH_DATE) AND
+             (LEFT.GENDER = RIGHT.GENDER) AND
+             (LEFT.NAME = RIGHT.NAME) THEN
+               RETURN TRUE ;
+          ELSE
+               RETURN FALSE ;
+          END IF ;
+
+     END IS_EQUAL ;
+
+BEGIN  -- CC3019C2M
+
+     REPORT.TEST ("CC3019C2M",
+                  "CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC " &
+                  "UNITS, E.G., TO SUPPORT ITERATORS. THIS TEST " &
+                  "SPECIFICALLY CHECKS THAT A NESTING LEVEL OF 3 " &
+                  "IS SUPPORTED FOR GENERICS.") ;
+
+-- CHECK THE OUTERMOST GENERIC (NEW_NESTED_GENERICS)
+
+     NEW_NESTED_GENERICS.SET_ELEMENT (
+          FOR_THIS_NGT_OBJECT => FIRST_NNG,
+          TO_THIS_ELEMENT     => TODAY) ;
+     NEW_NESTED_GENERICS.SET_NUMBER (
+          FOR_THIS_NGT_OBJECT => FIRST_NNG,
+          TO_THIS_NUMBER      => 1) ;
+
+     NEW_NESTED_GENERICS.SET_ELEMENT (
+          FOR_THIS_NGT_OBJECT => SECOND_NNG,
+          TO_THIS_ELEMENT     => FIRST_DATE) ;
+     NEW_NESTED_GENERICS.SET_NUMBER  (
+          FOR_THIS_NGT_OBJECT => SECOND_NNG,
+          TO_THIS_NUMBER      => 2) ;
+
+     IF FIRST_NNG = SECOND_NNG THEN
+          REPORT.FAILED ("PROBLEMS WITH TESTING EQUALITY FOR " &
+                         "OUTERMOST GENERIC") ;
+     END IF ;
+
+     IF (NEW_NESTED_GENERICS.ELEMENT_OF (THIS_NGT_OBJECT => FIRST_NNG)
+             /= TODAY) OR
+        (NEW_NESTED_GENERICS.ELEMENT_OF (
+                THIS_NGT_OBJECT => SECOND_NNG)
+             /= FIRST_DATE) THEN
+             REPORT.FAILED ("PROBLEMS WITH EXTRACTING ELEMENTS IN " &
+                            "OUTERMOST GENERIC") ;
+     END IF ;
+
+     IF (NEW_NESTED_GENERICS.NUMBER_OF (THIS_NGT_OBJECT => FIRST_NNG)
+             /= 1) OR
+        (NEW_NESTED_GENERICS.NUMBER_OF (THIS_NGT_OBJECT => SECOND_NNG)
+             /= 2) THEN
+             REPORT.FAILED ("PROBLEMS WITH EXTRACTING NUMBERS IN " &
+                             "OUTERMOST GENERIC") ;
+     END IF ;
+
+     NEW_NESTED_GENERICS.COPY (SOURCE        => FIRST_NNG,
+                               DESTINATION    => SECOND_NNG) ;
+
+     IF FIRST_NNG /= SECOND_NNG THEN
+          REPORT.FAILED ("PROBLEMS WITH COPYING OR TESTING EQUALITY " &
+                         "IN OUTERMOST GENERIC") ;
+     END IF ;
+
+-- CHECK THE FIRST NESTED GENERIC (GENERIC_TASK)
+
+     FIRST_GENERIC_TASK.STORE  (ITEM => MYSELF) ;
+     SECOND_GENERIC_TASK.STORE (ITEM => FRIEND) ;
+
+     FIRST_GENERIC_TASK.GET  (ITEM => FIRST_PERSON) ;
+     SECOND_GENERIC_TASK.GET (ITEM => SECOND_PERSON) ;
+
+     IF (FIRST_PERSON /= MYSELF) OR (SECOND_PERSON /= FRIEND) THEN
+          REPORT.FAILED ("PROBLEMS WITH NESTED TASK GENERIC") ;
+     END IF ;
+
+-- CHECK THE SECOND NESTED GENERIC (STACK_CLASS)
+
+     PERSON_STACK.CLEAR (THIS_STACK => FIRST_PERSON_STACK) ;
+     IF PERSON_STACK.NUMBER_OF_ELEMENTS
+        (ON_THIS_STACK => FIRST_PERSON_STACK) /= 0 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ;
+     END IF ;
+
+     PERSON_STACK.PUSH (THIS_ELEMENT     => MYSELF,
+                            ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
+     IF PERSON_STACK.NUMBER_OF_ELEMENTS
+        (ON_THIS_STACK => FIRST_PERSON_STACK) /= 1 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ;
+     END IF ;
+
+     PERSON_STACK.PUSH (THIS_ELEMENT     => FRIEND,
+                            ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
+     IF PERSON_STACK.NUMBER_OF_ELEMENTS
+        (ON_THIS_STACK => FIRST_PERSON_STACK) /= 2 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ;
+     END IF ;
+
+     PERSON_STACK.PUSH (THIS_ELEMENT     => FATHER,
+                            ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
+     IF PERSON_STACK.NUMBER_OF_ELEMENTS
+        (ON_THIS_STACK => FIRST_PERSON_STACK) /= 3 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ;
+     END IF ;
+
+     PERSON_STACK.POP (THIS_ELEMENT   => FIRST_PERSON,
+                           OFF_THIS_STACK => FIRST_PERSON_STACK) ;
+     IF PERSON_STACK.NUMBER_OF_ELEMENTS
+        (ON_THIS_STACK => FIRST_PERSON_STACK) /= 2 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ;
+     END IF ;
+
+     IF FIRST_PERSON /= FATHER THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE REMOVED FROM STACK - 1") ;
+     END IF ;
+
+     PERSON_STACK.CLEAR (THIS_STACK => SECOND_PERSON_STACK) ;
+     IF PERSON_STACK.NUMBER_OF_ELEMENTS
+        (ON_THIS_STACK => SECOND_PERSON_STACK) /= 0 THEN
+          REPORT.FAILED (
+               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ;
+     END IF ;
+
+     PERSON_STACK.COPY (THIS_STACK    => FIRST_PERSON_STACK,
+                            TO_THIS_STACK => SECOND_PERSON_STACK) ;
+
+     IF FIRST_PERSON_STACK /= SECOND_PERSON_STACK THEN
+          REPORT.FAILED (
+               "PROBLEMS WITH COPY OR TEST FOR EQUALITY (STACK)") ;
+     END IF ;
+
+     PERSON_STACK.POP (THIS_ELEMENT   => FIRST_PERSON,
+                       OFF_THIS_STACK => SECOND_PERSON_STACK) ;
+     PERSON_STACK.PUSH (THIS_ELEMENT     => DAUGHTER,
+                        ON_TO_THIS_STACK => SECOND_PERSON_STACK) ;
+     IF FIRST_PERSON_STACK = SECOND_PERSON_STACK THEN
+          REPORT.FAILED (
+               "PROBLEMS WITH POP OR TEST FOR EQUALITY (STACK)") ;
+     END IF ;
+
+     UNDERFLOW_EXCEPTION_TEST:
+
+     BEGIN  -- UNDERFLOW_EXCEPTION_TEST
+
+          PERSON_STACK.CLEAR (THIS_STACK => THIRD_PERSON_STACK) ;
+          PERSON_STACK.POP (THIS_ELEMENT    => FIRST_PERSON,
+                            OFF_THIS_STACK  => THIRD_PERSON_STACK) ;
+          REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ;
+
+     EXCEPTION
+
+          WHEN PERSON_STACK.UNDERFLOW => NULL ;  -- CORRECT EXCEPTION
+                                                 -- RAISED
+          WHEN OTHERS =>
+               REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
+                              "UNDERFLOW EXCEPTION TEST") ;
+
+     END UNDERFLOW_EXCEPTION_TEST ;
+
+     OVERFLOW_EXCEPTION_TEST:
+
+     BEGIN  -- OVERFLOW_EXCEPTION_TEST
+
+          PERSON_STACK.CLEAR (THIS_STACK => THIRD_PERSON_STACK) ;
+          FOR INDEX IN 1 .. 10 LOOP
+               PERSON_STACK.PUSH (
+                    THIS_ELEMENT     => MYSELF,
+                    ON_TO_THIS_STACK => THIRD_PERSON_STACK) ;
+          END LOOP ;
+
+          PERSON_STACK.PUSH (THIS_ELEMENT     => MYSELF,
+                             ON_TO_THIS_STACK => THIRD_PERSON_STACK) ;
+          REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ;
+
+     EXCEPTION
+
+          WHEN PERSON_STACK.OVERFLOW => NULL ;  -- CORRECT EXCEPTION
+                                                -- RAISED
+          WHEN OTHERS =>
+               REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
+                              "OVERFLOW EXCEPTION TEST") ;
+
+     END OVERFLOW_EXCEPTION_TEST ;
+
+     LOCAL_BLOCK:
+
+     DECLARE
+
+          TYPE PERSON_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF PERSON;
+
+          FIRST_PERSON_TABLE : PERSON_TABLE ;
+
+          TABLE_INDEX : POSITIVE := 1 ;
+
+          PROCEDURE GATHER_PEOPLE (THIS_PERSON : IN  PERSON ;
+                                   CONTINUE    : OUT BOOLEAN) ;
+
+          PROCEDURE SHOW_PEOPLE (THIS_PERSON  : IN  PERSON ;
+                                 CONTINUE     : OUT BOOLEAN) ;
+
+          PROCEDURE GATHER_PERSON_ITERATE IS NEW
+               PERSON_STACK.ITERATE (PROCESS => GATHER_PEOPLE) ;
+
+          PROCEDURE SHOW_PERSON_ITERATE IS NEW
+               PERSON_STACK.ITERATE (PROCESS => SHOW_PEOPLE) ;
+
+          PROCEDURE GATHER_PEOPLE (THIS_PERSON : IN  PERSON ;
+                                   CONTINUE    : OUT BOOLEAN) IS
+          BEGIN  -- GATHER_PEOPLE
+
+               FIRST_PERSON_TABLE (TABLE_INDEX) := THIS_PERSON ;
+               TABLE_INDEX := TABLE_INDEX + 1 ;
+
+               CONTINUE := TRUE ;
+
+          END GATHER_PEOPLE ;
+
+          PROCEDURE SHOW_PEOPLE (THIS_PERSON  : IN  PERSON ;
+                                 CONTINUE     : OUT BOOLEAN) IS
+
+          BEGIN  -- SHOW_PEOPLE
+
+               REPORT.COMMENT ("THE BIRTH MONTH IS " &
+                    MONTH_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.MONTH)) ;
+               REPORT.COMMENT ("THE BIRTH DAY IS " &
+                    DAY_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.DAY)) ;
+               REPORT.COMMENT ("THE BIRTH YEAR IS " &
+                    YEAR_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.YEAR)) ;
+               REPORT.COMMENT ("THE GENDER IS " &
+                    SEX'IMAGE (THIS_PERSON.GENDER)) ;
+               REPORT.COMMENT ("THE NAME IS " & THIS_PERSON.NAME) ;
+
+               CONTINUE := TRUE ;
+
+          END SHOW_PEOPLE ;
+
+     BEGIN  -- LOCAL_BLOCK
+
+          REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ;
+          SHOW_PERSON_ITERATE (OVER_THIS_STACK => FIRST_PERSON_STACK) ;
+
+          REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ;
+          SHOW_PERSON_ITERATE (OVER_THIS_STACK => SECOND_PERSON_STACK) ;
+
+          GATHER_PERSON_ITERATE (OVER_THIS_STACK => FIRST_PERSON_STACK);
+          IF (FIRST_PERSON_TABLE (1) /= MYSELF) OR
+             (FIRST_PERSON_TABLE (2) /= FRIEND) THEN
+               REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ;
+          END IF ;
+
+          TABLE_INDEX := 1 ;
+          GATHER_PERSON_ITERATE(OVER_THIS_STACK => SECOND_PERSON_STACK);
+          IF (FIRST_PERSON_TABLE (1) /= MYSELF) OR
+             (FIRST_PERSON_TABLE (2) /= DAUGHTER) THEN
+               REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ;
+          END IF ;
+
+     END LOCAL_BLOCK ;
+
+     REPORT.RESULT ;
+
+END CC3019C2M ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada
new file mode 100644
index 000000000..cd238c17a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada
@@ -0,0 +1,207 @@
+-- CC3106B.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 FORMAL PARAMETER DENOTES THE ACTUAL
+--     IN AN INSTANTIATION.
+
+-- HISTORY:
+--     LDC 06/20/88  CREATED ORIGINAL TEST
+--     EDWARD V. BERARD, 10 AUGUST 1990  ADDED CHECKS FOR MULTI-
+--                                       DIMENSIONAL ARRAYS
+
+WITH REPORT ;
+
+PROCEDURE CC3106B IS
+
+BEGIN  -- CC3106B
+
+    REPORT.TEST("CC3106B","CHECK THAT THE FORMAL PARAMETER DENOTES " &
+                "THE ACTUAL IN AN INSTANTIATION");
+
+    LOCAL_BLOCK:
+    
+    DECLARE
+    
+        SUBTYPE SM_INT IS INTEGER RANGE 0..15 ;
+        TYPE PCK_BOL IS ARRAY (5..18) OF BOOLEAN ;
+        PRAGMA PACK(PCK_BOL) ;
+          
+        SHORT_START : CONSTANT := -100 ;
+        SHORT_END   : CONSTANT := 100 ;
+        TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+    
+        SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
+    
+        TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                            SEP, OCT, NOV, DEC) ;
+                        
+        SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
+    
+        TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+        TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+        TYPE DATE IS RECORD
+            MONTH : MONTH_TYPE ;
+            DAY   : DAY_TYPE ;
+            YEAR  : YEAR_TYPE ;
+        END RECORD ;
+    
+        TODAY         : DATE := (MONTH => AUG,
+                                 DAY   => 8,
+                                 YEAR  => 1990) ;
+                            
+        FIRST_DATE    : DATE := (DAY   => 6,
+                                 MONTH => JUN,
+                                 YEAR  => 1967) ;
+                            
+        WALL_DATE     : DATE := (MONTH => NOV,
+                                 DAY   => 9,
+                                 YEAR  => 1989) ;
+                            
+        SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
+                            
+        TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
+                                         FIRST_HALF,
+                                         FIRST_FIVE) OF DATE ;
+                                     
+        TD_ARRAY : THREE_DIMENSIONAL := (THREE_DIMENSIONAL'RANGE =>
+                                        (THREE_DIMENSIONAL'RANGE (2) =>
+                                        (THREE_DIMENSIONAL'RANGE (3) =>
+                                          TODAY))) ;
+
+        TASK TYPE TSK IS
+            ENTRY ENT_1;
+            ENTRY ENT_2;
+            ENTRY ENT_3;
+        END TSK;
+
+        GENERIC
+          
+            TYPE GEN_TYPE IS (<>);
+            GEN_BOLARR         : IN OUT PCK_BOL;
+            GEN_TYP            : IN OUT GEN_TYPE;
+            GEN_TSK            : IN OUT TSK;
+            TEST_VALUE         : IN DATE ;
+            TEST_CUBE          : IN OUT THREE_DIMENSIONAL ;
+
+        PACKAGE P IS
+               PROCEDURE GEN_PROC1 ;
+               PROCEDURE GEN_PROC2 ;
+               PROCEDURE GEN_PROC3 ;
+               PROCEDURE ARRAY_TEST ;
+        END P;
+
+        ACT_BOLARR : PCK_BOL := (OTHERS => FALSE);
+        SI         : SM_INT := 0 ;
+        T          : TSK;
+
+        PACKAGE BODY P IS
+        
+            PROCEDURE GEN_PROC1 IS
+            BEGIN  -- GEN_PROC1
+                GEN_BOLARR(14) := REPORT.IDENT_BOOL(TRUE);
+                GEN_TYP := GEN_TYPE'VAL(4);
+                IF ACT_BOLARR(14) /= TRUE OR SI /= REPORT.IDENT_INT(4)
+                   THEN
+                    REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
+                                  "INSTANTIATED VALUES");
+                END IF;
+            END GEN_PROC1;
+
+            PROCEDURE GEN_PROC2 IS
+            BEGIN  -- GEN_PROC2
+                IF GEN_BOLARR(9) /= REPORT.IDENT_BOOL(TRUE) OR
+                      GEN_TYPE'POS(GEN_TYP) /= REPORT.IDENT_INT(2) THEN
+                    REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
+                                  "VALUES ASSIGNED IN THE MAIN " &
+                                  "PROCEDURE");
+                END IF;
+                GEN_BOLARR(18) := TRUE;
+                GEN_TYP := GEN_TYPE'VAL(9);
+            END GEN_PROC2;
+
+            PROCEDURE GEN_PROC3 IS
+            BEGIN  -- GEN_PROC3
+                GEN_TSK.ENT_2;
+            END GEN_PROC3 ;
+               
+            PROCEDURE ARRAY_TEST IS            
+            BEGIN  -- ARRAY_TEST
+               
+                TEST_CUBE (0, JUN, 'C') := TEST_VALUE ;
+                           
+                IF (TD_ARRAY (0, JUN, 'C')  /= TEST_VALUE) OR
+                      (TEST_CUBE (-5, MAR, 'A') /= WALL_DATE) THEN
+                    REPORT.FAILED ("MULTI-DIMENSIONAL ARRAY VALUES ARE " &
+                                   "DIFFERENT THAN THE VALUES ASSIGNED " &
+                                   "IN THE MAIN AND ARRAY_TEST PROCEDURES.") ;
+                END IF ;
+                
+            END ARRAY_TEST ;
+            
+        END P ;
+
+        TASK BODY TSK IS
+        BEGIN  -- TSK
+            ACCEPT ENT_1 DO
+                REPORT.COMMENT("TASK ENTRY 1 WAS CALLED");
+            END;
+            ACCEPT ENT_2 DO
+                REPORT.COMMENT("TASK ENTRY 2 WAS CALLED");
+            END;
+            ACCEPT ENT_3 DO
+                REPORT.COMMENT("TASK ENTRY 3 WAS CALLED");
+            END;
+        END TSK;
+
+        PACKAGE INSTA1 IS NEW P (GEN_TYPE       => SM_INT,
+                                 GEN_BOLARR     => ACT_BOLARR,
+                                 GEN_TYP        => SI,
+                                 GEN_TSK        => T,
+                                 TEST_VALUE     => FIRST_DATE,
+                                 TEST_CUBE      => TD_ARRAY) ;
+                             
+    BEGIN  -- LOCAL_BLOCK
+    
+        INSTA1.GEN_PROC1;
+        ACT_BOLARR(9) := TRUE;
+        SI := 2;
+        INSTA1.GEN_PROC2;
+        IF ACT_BOLARR(18) /= REPORT.IDENT_BOOL(TRUE) OR
+              SI /= REPORT.IDENT_INT(9) THEN
+            REPORT.FAILED("VALUES ARE DIFFERENT THAN VALUES " &
+                          "ASSIGNED IN THE GENERIC PROCEDURE");
+        END IF;
+
+        T.ENT_1;
+        INSTA1.GEN_PROC3;
+        T.ENT_3;
+          
+        TD_ARRAY (-5, MAR, 'A') := WALL_DATE ;
+        INSTA1.ARRAY_TEST ;
+
+     END LOCAL_BLOCK;
+
+     REPORT.RESULT;
+
+END CC3106B ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3120a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3120a.ada
new file mode 100644
index 000000000..dc709c322
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3120a.ada
@@ -0,0 +1,180 @@
+-- CC3120A.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 GENERIC IN PARAMETERS ARE ALWAYS COPIED, AND THAT
+-- GENERIC IN OUT PARAMETERS ARE ALWAYS RENAMED.
+
+-- DAT 8/10/81
+-- SPS 10/21/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3120A IS
+BEGIN
+     TEST ("CC3120A", "GENERIC IN PARMS ARE COPIED, GENERIC IN OUT"
+          & " PARMS ARE RENAMED");
+
+     DECLARE
+          S1, S2 : INTEGER;
+          A1, A2, A3 : STRING (1 .. IDENT_INT (3));
+
+          TYPE REC IS RECORD
+               C1, C2 : INTEGER := 1;
+          END RECORD;
+
+          R1, R2 : REC;
+
+          PACKAGE P IS
+               TYPE PRIV IS PRIVATE;
+               PROCEDURE SET_PRIV (P : IN OUT PRIV);
+          PRIVATE
+               TYPE PRIV IS NEW REC;
+          END P;
+          USE P;
+
+          P1, P2 : PRIV;
+          EX : EXCEPTION;
+
+          GENERIC
+               TYPE T IS PRIVATE;
+               P1 : IN OUT T;
+               P2 : IN T;
+          PROCEDURE GP;
+
+          B_ARR : ARRAY (1..10) OF BOOLEAN;
+
+          PACKAGE BODY P IS
+               PROCEDURE SET_PRIV (P : IN OUT PRIV) IS
+               BEGIN
+                    P.C1 := 3;
+               END SET_PRIV;
+          END P;
+
+          PROCEDURE GP IS
+          BEGIN
+               IF P1 = P2 THEN
+                    FAILED ("PARAMETER SCREW_UP SOMEWHERE");
+               END IF;
+               P1 := P2;
+               IF P1 /= P2 THEN
+                    FAILED ("ASSIGNMENT SCREW_UP SOMEWHERE");
+               END IF;
+               RAISE EX;
+               FAILED ("RAISE STATEMENT DOESN'T WORK");
+          END GP;
+     BEGIN
+          S1 := 4;
+          S2 := 5;
+          A1 := "XYZ";
+          A2 := "ABC";
+          A3 := "DEF";
+          R1.C1 := 4;
+          R2.C1 := 5;
+          B_ARR := (1|3|5|7|9 => TRUE, 2|4|6|8|10 => FALSE);
+          SET_PRIV (P2);
+
+          IF S1 = S2
+          OR A1 = A3
+          OR R1 = R2
+          OR P1 = P2 THEN
+               FAILED ("WRONG ASSIGNMENT");
+          END IF;
+          BEGIN
+               DECLARE
+                    PROCEDURE PR IS NEW GP (INTEGER, S1, S2);
+               BEGIN
+                    S2 := S1;
+                    PR;       -- OLD S2 ASSIGNED TO S1, SO S1 /= S2 NOW
+                    FAILED ("EX NOT RAISED 1");
+               EXCEPTION
+                    WHEN EX => NULL;
+               END;
+
+               DECLARE
+                    SUBTYPE STR_1_3 IS STRING (IDENT_INT (1)..3);
+                    PROCEDURE PR IS NEW GP (STR_1_3, A1, A3);
+               BEGIN
+                    A3 := A1;
+                    PR;
+                    FAILED ("EX NOT RAISED 2");
+               EXCEPTION
+                    WHEN EX => NULL;
+               END;
+
+               DECLARE
+                    PROCEDURE PR IS NEW GP (REC, R1, R2);
+               BEGIN
+                    R2 := R1;
+                    PR;
+                    FAILED ("EX NOT RAISED 3");
+               EXCEPTION
+                    WHEN EX => NULL;
+               END;
+
+               DECLARE
+                    PROCEDURE PR IS NEW GP (PRIV, P1, P2);
+               BEGIN
+                    P2 := P1;
+                    PR;
+                    FAILED ("EX NOT RAISED 4");
+               EXCEPTION
+                    WHEN EX => NULL;
+               END;
+               DECLARE
+                    PROCEDURE PR IS NEW GP (CHARACTER,
+                                            A3(IDENT_INT(2)),
+                                            A3(IDENT_INT(3)));
+               BEGIN
+                    A3(3) := A3(2);
+                    PR;
+                    FAILED ("EX NOT RAISED 5");
+               EXCEPTION
+                    WHEN EX => NULL;
+               END;
+
+               DECLARE
+                    PROCEDURE PR IS NEW GP (BOOLEAN,
+                                            B_ARR(IDENT_INT(2)),
+                                            B_ARR(IDENT_INT(3)));
+               BEGIN
+                    B_ARR(3) := B_ARR(2);
+                    PR;
+                    FAILED ("EX NOT RAISED 6");
+               EXCEPTION
+                    WHEN EX => NULL;
+               END;
+          END;
+
+          IF S1 = S2
+          OR A1 = A2
+          OR R1 = R2
+          OR P1 = P2
+          OR A3(2) = A3(3) 
+          OR B_ARR(2) = B_ARR(3) THEN
+               FAILED ("ASSIGNMENT FAILED 2");
+          END IF;
+     END;
+
+     RESULT;
+END CC3120A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3120b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3120b.ada
new file mode 100644
index 000000000..d25f4443f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3120b.ada
@@ -0,0 +1,146 @@
+-- CC3120B.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 TASKS ARE NOT COPIED AS GENERIC IN OUT PARMS.
+
+-- DAT 8/27/81
+-- SPS 4/6/82
+-- JBG 3/23/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3120B IS
+BEGIN
+     TEST ("CC3120B", "TASKS ARE NOT COPIED AS GENERIC PARAMETERS");
+
+     DECLARE
+          PACKAGE P IS
+               TYPE T IS LIMITED PRIVATE;
+               PROCEDURE UPDT (TPARM: IN T; I : IN OUT INTEGER);
+          PRIVATE
+               TASK TYPE T1 IS
+                    ENTRY GET (I : OUT INTEGER);
+                    ENTRY PUT (I : IN INTEGER);
+               END T1;
+               TYPE T IS RECORD
+                    C : T1;
+               END RECORD;
+          END P;
+          USE P;
+          TT : T;
+          GENERIC
+               TYPE T IS LIMITED PRIVATE;
+               T1 : IN OUT T;
+               WITH PROCEDURE UPDT (TPARM : IN T; I: IN OUT INTEGER)
+                    IS <> ;
+          PROCEDURE PR;
+
+          PROCEDURE PR IS
+               I : INTEGER;
+          BEGIN
+               I := 5;
+                                        -- PR.I
+                                        -- UPDT.I      UPDT.T1.I
+                                        --   5            4
+               UPDT (T1, I); 
+                                        --   4            5
+               IF I /= 4 THEN
+                    FAILED ("BAD VALUE 1");
+               END IF;
+               I := 6;
+                                        --   6            5
+               UPDT (T1, I);
+                                        --   5            6
+               IF I /= 5 THEN
+                    FAILED ("BAD VALUE 3");
+               END IF;
+               RAISE TASKING_ERROR;
+               FAILED ("INCORRECT RAISE STATEMENT");
+          END PR;
+
+          PACKAGE BODY P IS
+               PROCEDURE UPDT (TPARM : IN T; I : IN OUT INTEGER) IS
+                    V : INTEGER := I;
+                    -- UPDT.I => V
+                    -- T1.I => UPDT.I
+                    -- V => T1.I
+               BEGIN
+                    TPARM.C.GET (I);
+                    TPARM.C.PUT (V);
+               END UPDT;
+
+               TASK BODY T1 IS
+                    I : INTEGER;
+               BEGIN
+                    I := 1;
+                    LOOP
+                         SELECT
+                              ACCEPT GET (I : OUT INTEGER) DO
+                                   I := T1.I;
+                              END GET;
+                         OR
+                              ACCEPT PUT (I : IN INTEGER) DO
+                                   T1.I := I;
+                              END PUT;
+                         OR
+                              TERMINATE;
+                         END SELECT;
+                    END LOOP;
+               END T1;
+          END P;
+     BEGIN
+          DECLARE
+               X : INTEGER := 2;
+               PROCEDURE PPP IS NEW PR (T, TT);
+          BEGIN
+                                        -- X
+                                        -- UPDT.I      UPDT.T1.I
+                                        --   2            1
+               UPDT (TT, X);
+                                        --   1            2
+               X := X + 3;
+                                        --   4            2
+               UPDT (TT, X);
+                                        --   2            4
+               IF X /= 2 THEN 
+                    FAILED ("WRONG VALUE FOR X");
+               END IF;
+               BEGIN
+                    PPP;
+                    FAILED ("PPP NOT CALLED");
+               EXCEPTION
+                    WHEN TASKING_ERROR => NULL;
+               END;
+               X := 12;
+                                        --   12           6
+               UPDT (TT, X);
+                                        --   6            12
+               IF X /= 6 THEN
+                    FAILED ("WRONG FINAL VALUE IN TASK");
+               END IF;
+          END;
+     END;
+
+     RESULT;
+END CC3120B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3121a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3121a.ada
new file mode 100644
index 000000000..a0a8e4aaf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3121a.ada
@@ -0,0 +1,183 @@
+-- CC3121A.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 UNCONSTRAINED FORMAL GENERIC PARAMETER OF MODE "IN"
+-- HAVING AN ARRAY TYPE OR A TYPE WITH DISCRIMINANTS HAS THE CONSTRAINTS
+-- OF THE ACTUAL PARAMETER.
+
+-- TBN  9/29/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3121A IS
+
+     SUBTYPE INT IS INTEGER RANGE 1 .. 10;
+
+     TYPE ARRAY1 IS ARRAY (INT RANGE <>) OF INTEGER;
+
+     TYPE REC1 (D : INT) IS
+          RECORD
+               VAR1 : INTEGER := 1;
+          END RECORD;
+
+     TYPE REC2 (D : INT := 2) IS
+          RECORD
+               A : ARRAY1 (D .. IDENT_INT(4));
+               B : REC1 (D);
+               C : INTEGER := 1;
+          END RECORD;
+
+     TYPE ARRAY2 IS ARRAY (INT RANGE <>) OF REC2;
+
+BEGIN
+     TEST ("CC3121A", "CHECK THAT AN UNCONSTRAINED FORMAL GENERIC " &
+                      "PARAMETER OF MODE 'IN' HAVING AN ARRAY TYPE " &
+                      "OR A TYPE WITH DISCRIMINANTS HAS THE " &
+                      "CONSTRAINTS OF THE ACTUAL PARAMETER");
+
+     DECLARE
+          OBJ_ARA1 : ARRAY1 (IDENT_INT(2) .. 5);
+
+          GENERIC
+               VAR : ARRAY1;
+          PROCEDURE PROC;
+
+          PROCEDURE PROC IS
+          BEGIN
+               IF VAR'FIRST /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RESULTS FOR VAR'FIRST");
+               END IF;
+               IF VAR'LAST /= IDENT_INT(5) THEN
+                    FAILED ("INCORRECT RESULTS FOR VAR'LAST");
+               END IF;
+          END PROC;
+
+          PROCEDURE PROC1 IS NEW PROC (OBJ_ARA1);
+     BEGIN
+          PROC1;
+     END;
+
+     -------------------------------------------------------------------
+     DECLARE
+          OBJ_REC2 : REC2;
+
+          GENERIC
+               VAR : REC2;
+          FUNCTION FUNC RETURN INTEGER;
+
+          FUNCTION FUNC RETURN INTEGER IS
+          BEGIN
+               IF VAR.D /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR.D");
+               END IF;
+               IF VAR.A'FIRST /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR.A'FIRST");
+               END IF;
+               IF VAR.A'LAST /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR.A'LAST");
+               END IF;
+               IF VAR.B.D /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR.B.D");
+               END IF;
+               RETURN IDENT_INT(1);
+          END FUNC;
+
+          FUNCTION FUNC1 IS NEW FUNC (OBJ_REC2);
+
+     BEGIN
+          IF FUNC1 /= IDENT_INT(1) THEN
+               FAILED ("INCORRECT RESULTS FROM FUNC1 CALL");
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+     DECLARE
+          OBJ_ARA2 : ARRAY2 (IDENT_INT(6) .. 8);
+
+          GENERIC
+               VAR : ARRAY2;
+          PROCEDURE PROC;
+
+          PROCEDURE PROC IS
+          BEGIN
+               IF VAR'FIRST /= IDENT_INT(6) THEN
+                    FAILED ("INCORRECT RESULTS FOR VAR'FIRST");
+               END IF;
+               IF VAR'LAST /= IDENT_INT(8) THEN
+                    FAILED ("INCORRECT RESULTS FOR VAR'LAST");
+               END IF;
+               IF VAR(6).D /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR(6).D");
+               END IF;
+               IF VAR(6).A'FIRST /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR(6).A'FIRST");
+               END IF;
+               IF VAR(6).A'LAST /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR(6).A'LAST");
+               END IF;
+               IF VAR(6).B.D /= IDENT_INT(2) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR(6).B.D");
+               END IF;
+          END PROC;
+
+          PROCEDURE PROC2 IS NEW PROC (OBJ_ARA2);
+     BEGIN
+          PROC2;
+     END;
+
+     -------------------------------------------------------------------
+     DECLARE
+          OBJ_REC3 : REC2 (3);
+
+          GENERIC
+               VAR : REC2;
+          PACKAGE PAC IS
+               PAC_VAR : INTEGER := 1;
+          END PAC;
+
+          PACKAGE BODY PAC IS
+          BEGIN
+               IF VAR.D /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR.D");
+               END IF;
+               IF VAR.A'FIRST /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR.A'FIRST");
+               END IF;
+               IF VAR.A'LAST /= IDENT_INT(4) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR.A'LAST");
+               END IF;
+               IF VAR.B.D /= IDENT_INT(3) THEN
+                    FAILED ("INCORRECT RESULTS FROM VAR.B.D");
+               END IF;
+          END PAC;
+
+          PACKAGE PAC1 IS NEW PAC (OBJ_REC3);
+
+     BEGIN
+          NULL;
+     END;
+
+     -------------------------------------------------------------------
+
+     RESULT;
+END CC3121A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3123a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3123a.ada
new file mode 100644
index 000000000..917f5fd45
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3123a.ada
@@ -0,0 +1,198 @@
+-- CC3123A.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 FOR GENERIC IN PARAMETERS ARE ONLY
+-- EVALUATED IF THERE ARE NO ACTUAL PARAMETERS.
+
+-- TBN  12/01/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3123A IS
+
+BEGIN
+     TEST ("CC3123A", "CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN " &
+                      "PARAMETERS ARE ONLY EVALUATED IF THERE ARE " &
+                      "NO ACTUAL PARAMETERS");
+     DECLARE
+          TYPE ENUM IS (I, II, III);
+          OBJ_INT : INTEGER := 1;
+          OBJ_ENUM : ENUM := I;
+
+          GENERIC
+               GEN_INT : IN INTEGER := IDENT_INT(2);
+               GEN_BOOL : IN BOOLEAN := IDENT_BOOL(FALSE);
+               GEN_ENUM : IN ENUM := II;
+          PACKAGE P IS
+               PAC_INT : INTEGER := GEN_INT;
+               PAC_BOOL : BOOLEAN := GEN_BOOL;
+               PAC_ENUM : ENUM := GEN_ENUM;
+          END P;
+
+          PACKAGE P1 IS NEW P;
+          PACKAGE P2 IS
+               NEW P (IDENT_INT(OBJ_INT), GEN_ENUM => OBJ_ENUM);
+          PACKAGE P3 IS NEW P (GEN_BOOL => IDENT_BOOL(TRUE));
+     BEGIN
+          IF P1.PAC_INT /= 2 OR P1.PAC_BOOL OR P1.PAC_ENUM /= II THEN
+               FAILED ("DEFAULT VALUES WERE NOT EVALUATED");
+          END IF;
+          IF P2.PAC_INT /= 1 OR P2.PAC_BOOL OR P2.PAC_ENUM /= I THEN
+               FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &
+                       "- 1");
+          END IF;
+          IF P3.PAC_INT /= 2 OR NOT(P3.PAC_BOOL) OR
+               P3.PAC_ENUM /= II THEN
+               FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &
+                       "- 2");
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+     DECLARE
+          OBJ_INT1 : INTEGER := 3;
+
+          FUNCTION FUNC (X : INTEGER) RETURN INTEGER;
+
+          GENERIC
+               GEN_INT1 : IN INTEGER := FUNC (1);
+               GEN_INT2 : IN INTEGER := FUNC (GEN_INT1 + 1);
+          PROCEDURE PROC;
+
+          PROCEDURE PROC IS
+               PROC_INT1 : INTEGER := GEN_INT1;
+               PROC_INT2 : INTEGER := GEN_INT2;
+          BEGIN
+               IF PROC_INT1 /= 3 THEN
+                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
+                            "CORRECTLY - 3");
+               END IF;
+               IF PROC_INT2 /= 4 THEN
+                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
+                            "CORRECTLY - 4");
+               END IF;
+          END PROC;
+
+          FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
+          BEGIN
+               IF X /= IDENT_INT(4) THEN
+                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
+                            "CORRECTLY - 5");
+               END IF;
+               RETURN IDENT_INT(X);
+          END FUNC;
+
+          PROCEDURE NEW_PROC IS NEW PROC (GEN_INT1 => OBJ_INT1);
+
+     BEGIN
+          NEW_PROC;
+     END;
+
+     -------------------------------------------------------------------
+     DECLARE
+          TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;
+          TYPE REC IS
+               RECORD
+                    ANS : BOOLEAN;
+                    ARA : ARA_TYP;
+               END RECORD;
+          TYPE ARA_REC IS ARRAY (1 .. 5) OF REC;
+
+          FUNCTION F (X : INTEGER) RETURN INTEGER;
+
+          OBJ_REC : REC := (FALSE, (3, 4));
+          OBJ_ARA : ARA_REC := (1 .. 5 => (FALSE, (3, 4)));
+
+          GENERIC
+               GEN_OBJ1 : IN ARA_TYP := (F(1), 2);
+               GEN_OBJ2 : IN REC := (TRUE, GEN_OBJ1);
+               GEN_OBJ3 : IN ARA_REC := (1 .. F(5) => (TRUE, (1, 2)));
+          FUNCTION FUNC RETURN INTEGER;
+
+          FUNCTION FUNC RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT(1);
+          END FUNC;
+
+          FUNCTION F (X : INTEGER) RETURN INTEGER IS
+          BEGIN
+               FAILED ("DEFAULT VALUES WERE EVALUATED - 1");
+               RETURN IDENT_INT(X);
+          END F;
+
+          FUNCTION NEW_FUNC IS NEW FUNC ((3, 4), OBJ_REC, OBJ_ARA);
+
+     BEGIN
+          IF NOT EQUAL (NEW_FUNC, 1) THEN
+               FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 1");
+          END IF;
+     END;
+
+     -------------------------------------------------------------------
+     DECLARE
+          SUBTYPE INT IS INTEGER RANGE 1 .. 5;
+          TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;
+          TYPE COLOR IS (RED, WHITE);
+          TYPE CON_REC (D : INT) IS
+               RECORD
+                    A : COLOR;
+                    B : ARA_TYP;
+               END RECORD;
+          TYPE UNCON_OR_CON_REC (D : INT := 2) IS
+               RECORD
+                    A : COLOR;
+                    B : ARA_TYP;
+               END RECORD;
+          FUNCTION F (X : COLOR) RETURN COLOR;
+
+          OBJ_CON1 : CON_REC (1) := (1, WHITE, (3, 4));
+          OBJ_UNCON : UNCON_OR_CON_REC := (2, WHITE, (3, 4));
+          OBJ_CON2 : UNCON_OR_CON_REC (3) := (3, WHITE, (3, 4));
+
+          GENERIC
+               GEN_CON1 : IN CON_REC := (2, F(RED), (1, 2));
+               GEN_UNCON : IN UNCON_OR_CON_REC := (2, F(RED), (1, 2));
+               GEN_CON2 : IN UNCON_OR_CON_REC := GEN_UNCON;
+          FUNCTION FUNC RETURN INTEGER;
+
+          FUNCTION FUNC RETURN INTEGER IS
+          BEGIN
+               RETURN IDENT_INT(1);
+          END FUNC;
+
+          FUNCTION F (X : COLOR) RETURN COLOR IS
+          BEGIN
+               FAILED ("DEFAULT VALUES WERE EVALUATED - 2");
+               RETURN WHITE;
+          END F;
+
+          FUNCTION NEW_FUNC IS NEW FUNC (OBJ_CON1, OBJ_UNCON, OBJ_CON2);
+
+     BEGIN
+          IF NOT EQUAL (NEW_FUNC, 1) THEN
+               FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 2");
+          END IF;
+     END;
+
+     RESULT;
+END CC3123A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125a.ada
new file mode 100644
index 000000000..4adff6d2d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125a.ada
@@ -0,0 +1,111 @@
+-- CC3125A.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 IF THE INITIAL VALUE OF A 
+-- GENERIC IN PARAMETER DOES NOT SATISFY ITS SUBTYPE CONSTRAINT.
+
+-- THIS TEST CHECKS PARAMETERS OF A NON-GENERIC TYPE.
+
+-- DAT 8/10/81
+-- SPS 4/14/82
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3125A IS
+
+BEGIN
+     TEST ("CC3125A","GENERIC PARAMETER DEFAULTS OF " &
+                     "NON-GENERIC TYPE EVALUATED AND CHECKED WHEN " &
+                     "DECLARATION IS INSTANTIATED AND DEFAULT USED");
+
+     FOR I IN 1 .. 3 LOOP
+          COMMENT ("LOOP ITERATION");
+          BEGIN
+
+               DECLARE
+                    SUBTYPE T IS INTEGER RANGE 1 .. IDENT_INT(1);
+                    SUBTYPE I_1_2 IS INTEGER RANGE
+                         IDENT_INT (1) .. IDENT_INT (2);
+
+                    GENERIC
+                         P,Q : T := I_1_2'(I);
+                    PACKAGE PKG IS 
+                         R: T := P;
+                    END PKG;
+
+               BEGIN
+
+                    BEGIN
+                         DECLARE
+                              PACKAGE P1 IS NEW PKG;
+                         BEGIN
+                              IF I = IDENT_INT(1) THEN
+                                   IF P1.R /= IDENT_INT(1) 
+                                   THEN FAILED ("BAD INITIAL"&
+                                        " VALUE");
+                                   END IF;
+                              ELSIF I = 2 THEN
+                                   FAILED ("SUBTYPE NOT CHECKED AT " &
+                                           "INSTANTIATION");
+                              ELSE
+                                   FAILED ("DEFAULT NOT EVALUATED AT " &
+                                           "INSTANTIATION");
+                              END IF;
+                         EXCEPTION
+                              WHEN OTHERS => FAILED ("WRONG HANDLER");
+                         END;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              CASE I IS
+                                   WHEN 1 =>
+                                        FAILED ("INCORRECT EXCEPTION");
+                                   WHEN 2 =>
+                                        COMMENT ("CONSTRAINT CHECKED" &
+                                             " ON INSTANTIATION");
+                                   WHEN 3 =>
+                                        COMMENT ("DEFAULT EVALUATED " &
+                                             "ON INSTANTIATION");
+                              END CASE;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    CASE I IS
+                         WHEN 1 =>
+                              FAILED ("NO EXCEPTION SHOULD BE RAISED");
+                         WHEN 2 =>
+                              FAILED ("DEFAULT CHECKED AGAINST " &
+                                      "SUBTYPE AT DECLARATION");
+                         WHEN 3 =>
+                              FAILED ("DEFAULT EVALUATED AT " &
+                                      "DECLARATION");
+                    END CASE;
+          END;
+     END LOOP;
+
+     RESULT;
+END CC3125A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125b.ada
new file mode 100644
index 000000000..84d6d1198
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125b.ada
@@ -0,0 +1,148 @@
+-- CC3125B.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 A GENERIC IN PARAMETER
+-- HAVING AN ENUMERATION TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
+-- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
+
+-- TBN  12/15/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3125B IS
+
+     TYPE COLOR IS (GREEN, RED, WHITE, BLUE, ORANGE, PINK);
+     SUBTYPE FLAG IS COLOR RANGE RED .. BLUE;
+
+     FUNCTION IDENT_COL (X : COLOR) RETURN COLOR IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;
+          END IF;
+          RETURN GREEN;
+     END IDENT_COL;
+
+BEGIN
+     TEST ("CC3125B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
+                      "GENERIC IN PARAMETER HAVING AN ENUMERATION " &
+                      "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
+                      "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
+                      "FORMAL PARAMETER");
+     DECLARE
+          GENERIC
+               GEN_COL : IN FLAG;
+          PACKAGE P IS
+               PAC_COL : FLAG := GEN_COL;
+          END P;
+     BEGIN
+          BEGIN
+               DECLARE
+                    PACKAGE P1 IS NEW P(IDENT_COL(RED));
+               BEGIN
+                    IF P1.PAC_COL /= IDENT_COL(RED) THEN
+                         FAILED ("INCORRECT VALUE PASSED - 1");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE P2 IS NEW P(IDENT_COL(GREEN));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 2");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE P3 IS NEW P(IDENT_COL(PINK));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 3");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+          END;
+     END;
+     -------------------------------------------------------------------
+
+     DECLARE
+          GENERIC
+               TYPE GEN_TYP IS (<>);
+               GEN_COL : IN GEN_TYP;
+          PACKAGE Q IS
+               PAC_COL : GEN_TYP := GEN_COL;
+          END Q;
+     BEGIN
+          BEGIN
+               DECLARE
+                    PACKAGE Q1 IS NEW Q(FLAG, IDENT_COL(BLUE));
+               BEGIN
+                    IF Q1.PAC_COL /= IDENT_COL(BLUE) THEN
+                         FAILED ("INCORRECT VALUE PASSED - 4");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - 4");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE Q2 IS NEW Q(FLAG, IDENT_COL(GREEN));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 5");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE Q3 IS NEW Q(FLAG, IDENT_COL(PINK));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 6");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+          END;
+     END;
+
+     RESULT;
+END CC3125B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125c.ada
new file mode 100644
index 000000000..42904bdfb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125c.ada
@@ -0,0 +1,148 @@
+-- CC3125C.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 A GENERIC IN PARAMETER
+-- HAVING A FLOATING POINT TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
+-- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
+
+-- TBN  12/15/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3125C IS
+
+     TYPE FLT IS DIGITS 5 RANGE -10.0 .. 10.0;
+     SUBTYPE FLO IS FLT RANGE -5.0 .. 5.0;
+
+     FUNCTION IDENT_FLT (X : FLT) RETURN FLT IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;
+          END IF;
+          RETURN 0.0;
+     END IDENT_FLT;
+
+BEGIN
+     TEST ("CC3125C", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
+                      "GENERIC IN PARAMETER HAVING A FLOATING POINT " &
+                      "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
+                      "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
+                      "FORMAL PARAMETER");
+     DECLARE
+          GENERIC
+               GEN_FLO : IN FLO;
+          PACKAGE P IS
+               PAC_FLO : FLT := GEN_FLO;
+          END P;
+     BEGIN
+          BEGIN
+               DECLARE
+                    PACKAGE P1 IS NEW P(IDENT_FLT(-5.0));
+               BEGIN
+                    IF P1.PAC_FLO /= IDENT_FLT(-5.0) THEN
+                         FAILED ("INCORRECT VALUE PASSED - 1");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE P2 IS NEW P(IDENT_FLT(-5.1));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 2");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE P3 IS NEW P(IDENT_FLT(5.1));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 3");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+          END;
+     END;
+     -------------------------------------------------------------------
+
+     DECLARE
+          GENERIC
+               TYPE GEN_TYP IS DIGITS <>;
+               GEN_FLO : IN GEN_TYP;
+          PACKAGE Q IS
+               PAC_FLO : GEN_TYP := GEN_FLO;
+          END Q;
+     BEGIN
+          BEGIN
+               DECLARE
+                    PACKAGE Q1 IS NEW Q(FLO, IDENT_FLT(5.0));
+               BEGIN
+                    IF Q1.PAC_FLO /= IDENT_FLT(5.0) THEN
+                         FAILED ("INCORRECT VALUE PASSED - 4");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - 4");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE Q2 IS NEW Q(FLO, IDENT_FLT(-5.1));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 5");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE Q3 IS NEW Q(FLO, IDENT_FLT(5.1));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 6");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+          END;
+     END;
+
+     RESULT;
+END CC3125C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125d.ada
new file mode 100644
index 000000000..5977eb91a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3125d.ada
@@ -0,0 +1,148 @@
+-- CC3125D.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 A GENERIC IN PARAMETER
+-- HAVING A FIXED POINT TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
+-- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
+
+-- TBN  12/15/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3125D IS
+
+     TYPE FIXED IS DELTA 0.125 RANGE -10.0 .. 10.0;
+     SUBTYPE FIX IS FIXED RANGE -5.0 .. 5.0;
+
+     FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;
+          END IF;
+          RETURN 0.0;
+     END IDENT_FIX;
+
+BEGIN
+     TEST ("CC3125D", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
+                      "GENERIC IN PARAMETER HAVING A FIXED POINT " &
+                      "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
+                      "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
+                      "FORMAL PARAMETER");
+     DECLARE
+          GENERIC
+               GEN_FIX : IN FIX;
+          PACKAGE P IS
+               PAC_FIX : FIXED := GEN_FIX;
+          END P;
+     BEGIN
+          BEGIN
+               DECLARE
+                    PACKAGE P1 IS NEW P(IDENT_FIX(-5.0));
+               BEGIN
+                    IF P1.PAC_FIX /= IDENT_FIX(-5.0) THEN
+                         FAILED ("INCORRECT VALUE PASSED - 1");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE P2 IS NEW P(IDENT_FIX(-5.2));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 2");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE P3 IS NEW P(IDENT_FIX(5.2));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 3");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+          END;
+     END;
+     -------------------------------------------------------------------
+
+     DECLARE
+          GENERIC
+               TYPE GEN_TYP IS DELTA <>;
+               GEN_FIX : IN GEN_TYP;
+          PACKAGE Q IS
+               PAC_FIX : GEN_TYP := GEN_FIX;
+          END Q;
+     BEGIN
+          BEGIN
+               DECLARE
+                    PACKAGE Q1 IS NEW Q(FIX, IDENT_FIX(5.0));
+               BEGIN
+                    IF Q1.PAC_FIX /= IDENT_FIX(5.0) THEN
+                         FAILED ("INCORRECT VALUE PASSED - 4");
+                    END IF;
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - 4");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE Q2 IS NEW Q(FIX, IDENT_FIX(-5.2));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 5");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
+          END;
+
+          BEGIN
+               DECLARE
+                    PACKAGE Q3 IS NEW Q(FIX, IDENT_FIX(5.2));
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED - 6");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
+          END;
+     END;
+
+     RESULT;
+END CC3125D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3126a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3126a.ada
new file mode 100644
index 000000000..ba234648b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3126a.ada
@@ -0,0 +1,188 @@
+-- CC3126A.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 CONSTRAINT_ERROR IS RAISED IF AND ONLY IF THE ACTUAL
+--     PARAMETER DOES NOT HAVE THE SAME NUMBER OF COMPONENTS
+--     (PER DIMENSION) AS THE FORMAL PARAMETER. ALSO THAT FOR NULL
+--     ARRAYS NO ERROR IS RAISED.
+
+-- HISTORY:
+--     LB  12/02/86
+--     DWC 08/11/87  CHANGED HEADING FORMAT.
+--     RJW 10/26/89  INITIALIZED VARIABLE H.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  CC3126A  IS
+
+BEGIN
+     TEST ("CC3126A","GENERIC ACTUAL PARAMETER MUST HAVE THE SAME "&
+                     "NUMBER OF COMPONENTS (PER DIMENSION) AS THE "&
+                     "GENERIC FORMAL PARMETER");
+     BEGIN
+          DECLARE
+               TYPE ARRY1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+               SUBTYPE ARR IS ARRY1 (1 .. 10);
+
+               GENERIC
+                    GARR : IN ARR;
+               PACKAGE P IS
+                    NARR : ARR := GARR;
+               END P;
+
+          BEGIN
+               BEGIN
+                    DECLARE
+                         X : ARRY1 (2 .. 11) := (2 .. 11 => 0);
+                         PACKAGE Q IS NEW P(X);
+                    BEGIN
+                         Q.NARR(2) := 1;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED 1");
+               END;
+
+               BEGIN
+                    DECLARE
+                         S : ARRY1 (1 .. 11) := (1 .. 11 => 0);
+                         PACKAGE R IS NEW P(S);
+                    BEGIN
+                         FAILED ("EXCEPTION NOT RAISED 2");
+                         R.NARR(1) := IDENT_INT(R.NARR(1));
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED 2");
+               END;
+
+               BEGIN
+                    DECLARE
+                         G : ARRY1 (1 .. 9) := (1 .. 9 => 0);
+                         PACKAGE K IS NEW P(G);
+                    BEGIN
+                         FAILED ("EXCEPTION NOT RAISED 3");
+                         IF EQUAL(3,3) THEN
+                              K.NARR(1) := IDENT_INT(K.NARR(1));
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED 3");
+               END;
+
+               BEGIN
+                    DECLARE
+                         S : ARRY1 (1 .. 11) := (1 .. 11 => 0);
+                         PACKAGE F IS NEW P(S(2 .. 11));
+                    BEGIN
+                         F.NARR(2) := IDENT_INT(F.NARR(2));
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED 4");
+               END;
+          END;
+
+          DECLARE
+               SUBTYPE STR IS STRING(1 .. 20);
+
+               GENERIC
+                    GVAR : IN STR;
+               PACKAGE M IS
+                    NVAR : STR := GVAR;
+               END M;
+
+          BEGIN
+               BEGIN
+                    DECLARE
+                         L : STRING (2 .. 15);
+                         PACKAGE U IS NEW M(L);
+                    BEGIN
+                         FAILED ("EXCEPTION NOT RAISED 5");
+                         U.NVAR(2) := IDENT_CHAR(U.NVAR(2));
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED 5");
+               END;
+
+               BEGIN
+                    DECLARE
+                         H : STRING (1 .. 20) := (OTHERS => 'R');
+                         PACKAGE J IS NEW M(H);
+                    BEGIN
+                         IF EQUAL(3,3) THEN
+                              J.NVAR(2) := IDENT_CHAR(J.NVAR(2));
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED 6");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED STRINGS");
+          END;
+
+          DECLARE
+               TYPE NARRY IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+               SUBTYPE SNARRY IS NARRY (2 .. 0);
+
+               GENERIC
+                    RD : IN SNARRY;
+               PACKAGE JA IS
+                    CD : SNARRY := RD;
+               END JA;
+          BEGIN
+               BEGIN
+                    DECLARE
+                         AD : NARRY(1 .. 0);
+                         PACKAGE PA IS NEW JA(AD);
+                    BEGIN
+                         IF NOT EQUAL(0,PA.CD'LAST) THEN
+                              FAILED ("PARAMETER ATTRIBUTE INCORRECT");
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED 7");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED FOR ARRAYS "&
+                            "WITH NULL RANGES");
+          END;
+     END;
+
+     RESULT;
+
+END CC3126A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3127a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3127a.ada
new file mode 100644
index 000000000..9e1ccdb68
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3127a.ada
@@ -0,0 +1,143 @@
+-- CC3127A.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:
+--     FOR A CONSTRAINED IN FORMAL PARAMETER HAVING A RECORD OR PRIVATE
+--     TYPE WITH DISCRIMINANTS, CHECK THAT CONSTRAINT_ERROR IS RAISED
+--     IF AND ONLY IF CORRESPONDING DISCRIMINANTS OF THE ACTUAL AND
+--     FORMAL PARAMETER DO NOT HAVE THE SAME VALUES.
+
+-- HISTORY:
+--     LB   12/04/86  CREATED ORIGINAL TEST.
+--     VCL  08/19/87  CORRECTED THE FORMAT OF THIS HEADER.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE  CC3127A  IS
+
+     TYPE INT IS RANGE 1 .. 20;
+
+BEGIN
+     TEST ("CC3127A","CORRESPONDING DISCRIMINANTS OF THE GENERIC "&
+                     "ACTUAL PARAMETER AND THE GENERIC FORMAL "&
+                     "PARAMETER MUST HAVE THE SAME VALUES.");
+     BEGIN
+          DECLARE
+               TYPE REC (A : INT) IS
+                    RECORD
+                         RINT : POSITIVE := 2;
+                    END RECORD;
+               SUBTYPE CON_REC IS REC(4);
+
+               GENERIC
+                    GREC : IN CON_REC;
+               PACKAGE PA IS
+                    NREC : CON_REC := GREC;
+               END PA;
+          BEGIN
+               BEGIN
+                    DECLARE
+                         RVAR : REC(3);
+                         PACKAGE AB IS NEW PA(RVAR);
+                    BEGIN
+                         FAILED ("EXCEPTION NOT RAISED 1");
+                         AB.NREC.RINT := IDENT_INT(AB.NREC.RINT);
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED 1");
+               END;
+
+               BEGIN
+                    DECLARE
+                         SVAR : REC(4);
+                         PACKAGE CD IS NEW PA(SVAR);
+                    BEGIN
+                         IF EQUAL(3,3) THEN
+                              CD.NREC.RINT := IDENT_INT(CD.NREC.RINT);
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED 2");
+               END;
+          END;
+
+          DECLARE
+               PACKAGE EF IS
+                    TYPE PRI_REC (G : INT) IS PRIVATE;
+               PRIVATE
+                    TYPE PRI_REC (G : INT) IS
+                         RECORD
+                              PINT : POSITIVE := 2;
+                         END RECORD;
+               END EF;
+               SUBTYPE CPRI_REC IS EF.PRI_REC(4);
+
+               GENERIC
+                    GEN_REC : IN CPRI_REC;
+               PACKAGE GH IS
+                    NGEN_REC : CPRI_REC := GEN_REC;
+               END GH;
+
+          BEGIN
+               BEGIN
+                    DECLARE
+                         PVAR : EF.PRI_REC(4);
+                         PACKAGE LM IS NEW GH(PVAR);
+                    BEGIN
+                         IF EQUAL(3,3) THEN
+                              LM.NGEN_REC := LM.NGEN_REC;
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED 3");
+               END;
+
+               BEGIN
+                    DECLARE
+                         PTVAR : EF.PRI_REC(5);
+                         PACKAGE PAC IS NEW GH(PTVAR);
+                    BEGIN
+                         FAILED ("EXCEPTION NOT RAISED 4");
+                         IF EQUAL(3,5) THEN
+                            COMMENT ("DISCRIMINANT OF PAC.NGEN_REC IS "&
+                                       INT'IMAGE(PAC.NGEN_REC.G));
+                         END IF;
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED 4");
+               END;
+          END;
+     END;
+
+     RESULT;
+
+END CC3127A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3128a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3128a.ada
new file mode 100644
index 000000000..9afdd77d2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3128a.ada
@@ -0,0 +1,358 @@
+-- CC3128A.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, FOR A CONSTRAINED IN FORMAL PARAMETER HAVING AN ACCESS TYPE,
+--     CONSTRAINT_ERROR IS RAISED IF AND ONLY IF THE ACTUAL PARAMETER IS NOT
+--     NULL AND THE OBJECT DESIGNATED BY THE ACTUAL PARAMETER DOES NOT SATISFY
+--     THE FORMAL PARAMETER'S CONSTRAINTS.
+
+-- HISTORY:
+--     RJW 10/28/88  CREATED ORIGINAL TEST.
+--     JRL 02/28/96  Removed cases where the designated subtypes of the formal
+--                   and actual do not statically match. Corrected commentary.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3128A IS
+
+BEGIN
+     TEST ("CC3128A", "FOR A CONSTRAINED IN FORMAL PARAMETER HAVING " &
+                      "AN ACCESS TYPE, CONSTRAINT_ERROR IS RAISED " &
+                      "IF AND ONLY IF THE ACTUAL PARAMETER IS NOT " &
+                      "NULL AND THE OBJECT DESIGNATED BY THE ACTUAL " &
+                      "PARAMETER DOES NOT SATISFY FORMAL PARAMETER'S " &
+                      "CONSTRAINTS");
+
+     DECLARE
+          TYPE REC (D : INTEGER := 10) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE ACCREC IS ACCESS REC;
+
+          SUBTYPE LINK IS ACCREC (5);
+
+          GENERIC
+               LINK1 : LINK;
+          FUNCTION F (I : INTEGER) RETURN INTEGER;
+
+          FUNCTION F (I : INTEGER) RETURN INTEGER IS
+          BEGIN
+               IF I /= 5 THEN
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
+                            "TO CALL TO FUNCTION F - 1");
+               END IF;
+               IF NOT EQUAL (I, 5) AND THEN
+                  NOT EQUAL (LINK1.D, LINK1.D) THEN
+                    COMMENT ("DISREGARD");
+               END IF;
+               RETURN I + 1;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED WITHIN FUNCTION F - 1");
+               RETURN I + 1;
+          END F;
+
+          GENERIC
+               TYPE PRIV (D : INTEGER) IS PRIVATE;
+               PRIV1 : PRIV;
+          PACKAGE GEN IS
+               TYPE ACCPRIV IS ACCESS PRIV;
+               SUBTYPE LINK IS ACCPRIV (5);
+               GENERIC
+                    LINK1 : LINK;
+                    I : IN OUT INTEGER;
+               PACKAGE P IS END P;
+          END GEN;
+
+          PACKAGE BODY GEN IS
+               PACKAGE BODY P IS
+               BEGIN
+                    IF I /= 5 THEN
+                         FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
+                                 "TO PACKAGE BODY P - 1");
+                    END IF;
+                    IF NOT EQUAL (I, 5) AND THEN
+                       NOT EQUAL (LINK1.D, LINK1.D) THEN
+                         COMMENT ("DISREGARD");
+                    END IF;
+                    I := I + 1;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED WITHIN " &
+                                 "PACKAGE P - 1");
+                    I := I + 1;
+               END P;
+
+          BEGIN
+               BEGIN
+                    DECLARE
+                         AR10 : ACCPRIV;
+                         I : INTEGER := IDENT_INT (5);
+                         PACKAGE P1 IS NEW P (AR10, I);
+                    BEGIN
+                         IF I /= 6 THEN
+                              FAILED ("INCORRECT RESULT - " &
+                                      "PACKAGE P1");
+                         END IF;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("EXCEPTION RAISED TOO LATE - " &
+                                      "PACKAGE P1 - 1");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED AT INSTANTIATION " &
+                                 "OF PACKAGE P1 WITH NULL ACCESS " &
+                                 "VALUE");
+               END;
+
+               BEGIN
+                    DECLARE
+                         AR10 : ACCPRIV := NEW PRIV'(PRIV1);
+                         I : INTEGER := IDENT_INT (0);
+                         PACKAGE P1 IS NEW P (AR10, I);
+                    BEGIN
+                         FAILED ("NO EXCEPTION RAISED BY " &
+                                 "INSTANTIATION OF PACKAGE P1");
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("EXCEPTION RAISED TOO LATE - " &
+                                      "PACKAGE P1 - 2");
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED AT " &
+                                 "INSTANTIATION OF PACKAGE P1");
+               END;
+          END GEN;
+
+          PACKAGE NEWGEN IS NEW GEN (REC, (D => 10));
+
+     BEGIN
+          BEGIN
+               DECLARE
+                    I : INTEGER := IDENT_INT (5);
+                    AR10 : ACCREC;
+                    FUNCTION F1 IS NEW F (AR10);
+               BEGIN
+                    I := F1 (I);
+                    IF I /= 6 THEN
+                         FAILED ("INCORRECT RESULT RETURNED BY " &
+                                 "FUNCTION F1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED AT CALL TO " &
+                                 "FUNCTION F1 - 1");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED AT INSTANTIATION OF " &
+                            "FUNCTION F1 WITH NULL ACCESS VALUE");
+          END;
+
+          BEGIN
+               DECLARE
+                    I : INTEGER := IDENT_INT (0);
+                    AR10 : ACCREC := NEW REC'(D => 10);
+                    FUNCTION F1 IS NEW F (AR10);
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED BY INSTANTIATION " &
+                            "OF FUNCTION F1");
+                    I := F1 (I);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED AT CALL TO " &
+                                 "FUNCTION F1 - 2");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED AT " &
+                            "INSTANTIATION OF FUNCTION F1");
+          END;
+     END;
+
+     DECLARE
+          TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+
+          TYPE ACCARR IS ACCESS ARR;
+
+          SUBTYPE LINK IS ACCARR (1 .. 5);
+
+          GENERIC
+               LINK1 : LINK;
+          FUNCTION F (I : INTEGER) RETURN INTEGER;
+
+          FUNCTION F (I : INTEGER) RETURN INTEGER IS
+          BEGIN
+               IF I /= 5 THEN
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
+                            "TO CALL TO FUNCTION F - 2");
+               END IF;
+               IF NOT EQUAL (I, 5) AND THEN
+                  NOT EQUAL (LINK1(IDENT_INT (3)),LINK1(IDENT_INT (3)))
+                  THEN
+                    COMMENT ("DISREGARD");
+               END IF;
+               RETURN I + 1;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED WITHIN FUNCTION F - 2");
+               RETURN I + 1;
+          END F;
+
+          GENERIC
+               TYPE GENARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
+          PACKAGE GEN IS
+               TYPE ACCGENARR IS ACCESS GENARR;
+               SUBTYPE LINK IS ACCGENARR (1 .. 5);
+               GENERIC
+                    LINK1 : LINK;
+                    I : IN OUT INTEGER;
+               PACKAGE P IS END P;
+          END GEN;
+
+          PACKAGE BODY GEN IS
+               PACKAGE BODY P IS
+               BEGIN
+                    IF I /= 5 THEN
+                         FAILED ("CONSTRAINT_ERROR NOT RAISED PRIOR " &
+                                 "TO PACKAGE BODY P - 2");
+                    END IF;
+                    IF NOT EQUAL (I, 5) AND THEN
+                       NOT
+                       EQUAL(LINK1(IDENT_INT (3)),LINK1(IDENT_INT (3)))
+                       THEN
+                         COMMENT ("DISREGARD");
+                    END IF;
+                    I := I + 1;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED WITHIN " &
+                                 "PACKAGE P - 2");
+                    I := I + 1;
+               END P;
+
+          BEGIN
+               BEGIN
+                    DECLARE
+                         AR26 : ACCGENARR (2 .. 6);
+                         I : INTEGER := IDENT_INT (5);
+                         PACKAGE P2 IS NEW P (AR26, I);
+                    BEGIN
+                         IF I /= 6 THEN
+                              FAILED ("INCORRECT RESULT - " &
+                                      "PACKAGE P2");
+                         END IF;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("EXCEPTION RAISED TOO LATE - " &
+                                      "PACKAGE P2 - 1");
+                    END;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED AT INSTANTIATION " &
+                                 "OF PACKAGE P2 WITH NULL ACCESS " &
+                                 "VALUE");
+               END;
+
+               BEGIN
+                    DECLARE
+                         AR26 : ACCGENARR
+                                (IDENT_INT (2) .. IDENT_INT (6)) :=
+                                NEW GENARR'(1,2,3,4,5);
+                         I : INTEGER := IDENT_INT (0);
+                         PACKAGE P2 IS NEW P (AR26, I);
+                    BEGIN
+                         FAILED ("NO EXCEPTION RAISED BY " &
+                                 "INSTANTIATION OF PACKAGE P2");
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("EXCEPTION RAISED TOO LATE - " &
+                                      "PACKAGE P2 - 2");
+                    END;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED AT " &
+                                 "INSTANTIATION OF PACKAGE P2");
+               END;
+          END GEN;
+
+          PACKAGE NEWGEN IS NEW GEN (ARR);
+
+     BEGIN
+          BEGIN
+               DECLARE
+                    I : INTEGER := IDENT_INT (5);
+                    AR26 : ACCARR (IDENT_INT (2) .. IDENT_INT (6));
+                    FUNCTION F2 IS NEW F (AR26);
+               BEGIN
+                    I := F2 (I);
+                    IF I /= 6 THEN
+                         FAILED ("INCORRECT RESULT RETURNED BY " &
+                                 "FUNCTION F2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED AT CALL TO " &
+                                 "FUNCTION F2 - 1");
+               END;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED AT INSTANTIATION OF " &
+                            "FUNCTION F2 WITH NULL ACCESS VALUE");
+          END;
+
+          BEGIN
+               DECLARE
+                    I : INTEGER := IDENT_INT (0);
+                    AR26 : ACCARR (2 .. 6) := NEW ARR'(1,2,3,4,5);
+                    FUNCTION F2 IS NEW F (AR26);
+               BEGIN
+                    FAILED ("NO EXCEPTION RAISED BY INSTANTIATION " &
+                            "OF FUNCTION F2");
+                    I := F2 (I);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED AT CALL TO " &
+                                 "FUNCTION F2 - 2");
+               END;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED AT " &
+                            "INSTANTIATION OF FUNCTION F2");
+          END;
+     END;
+     RESULT;
+END CC3128A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3203a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3203a.ada
new file mode 100644
index 000000000..b0228ea92
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3203a.ada
@@ -0,0 +1,89 @@
+-- CC3203A.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 WHEN A GENERIC FORMAL LIMITED/NON LIMITED PRIVATE TYPE HAS
+-- DISCRIMINANTS, THE ACTUAL PARAMETER CAN HAVE DEFAULT DISCRIMINANT
+-- VALUES.
+
+-- SPS 7/9/82
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CC3203A IS
+BEGIN
+     TEST ("CC3203A", "CHECK DEFAULT VALUES FOR LIMITED/" &
+           "NON LIMITED GENERIC FORMAL PRIVATE TYPES");
+     DECLARE
+          SD : INTEGER := IDENT_INT(0);
+
+          FUNCTION INIT_RC (X: INTEGER) RETURN INTEGER;
+
+          TYPE REC (D : INTEGER := 3) IS
+               RECORD NULL; END RECORD;
+
+          TYPE RC(C : INTEGER := INIT_RC (1)) IS
+               RECORD NULL; END RECORD;
+
+          GENERIC
+               TYPE PV(X : INTEGER) IS PRIVATE;
+               TYPE LP(X : INTEGER) IS LIMITED PRIVATE;
+          PACKAGE PACK IS
+               SUBTYPE NPV IS PV;
+               SUBTYPE NLP IS LP;
+          END PACK;
+
+          FUNCTION INIT_RC (X: INTEGER) RETURN INTEGER IS
+               BEGIN
+                    SD := SD + X;
+                    RETURN SD;
+          END INIT_RC;
+
+          PACKAGE P1 IS NEW PACK (REC, RC);
+
+          PACKAGE P2 IS
+               P1VP : P1.NPV;
+               P1VL : P1.NLP;
+               P1VL2 : P1.NLP;
+          END P2;
+          USE P2;
+     BEGIN
+
+          IF P1VP.D /= IDENT_INT(3) THEN
+               FAILED ("DEFAULT DISCRIMINANT VALUE WRONG");
+          END IF;
+
+          IF P1VL.C /= 1 THEN
+               FAILED ("DID NOT EVALUATE DEFAULT DISCRIMINANT");
+          END IF;
+
+          IF P1VL2.C /= IDENT_INT(2) THEN
+               FAILED ("DID NOT EVALUATE DEFAULT DISCRIMINANT " &
+                       "WHEN NEEDED");
+          END IF;
+     END;
+
+     RESULT;
+
+END CC3203A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3207b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3207b.ada
new file mode 100644
index 000000000..8b6fa03ae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3207b.ada
@@ -0,0 +1,119 @@
+-- CC3207B.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 INSTANTIATION IS LEGAL IF A FORMAL
+--     PARAMETER HAVING A LIMITED PRIVATE TYPE WITHOUT
+--     A DISCRIMINANT IS USED TO DECLARE AN ACCESS
+--     TYPE IN A BLOCK THAT CONTAINS A SELECTIVE WAIT
+--     WITH A TERMINATE ALTERNATIVE, AND ACTUAL
+--     PARAMETER'S BASE IS A TASK TYPE OR TYPE WITH A
+--     SUBCOMPONENT OF A TASK TYPE.
+
+-- HISTORY:
+--     LDC  06/24/88  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CC3207B IS
+BEGIN
+     TEST("CC3207B","CHECK THAT INSTANTIATION IS LEGAL IF A "     &
+                    "FORMAL PARAMETER HAVING A LIMITED PRIVATE "  &
+                    "TYPE WITHOUT A DISCRIMINANT IS USED TO "     &
+                    "DECLARE AN ACCESS TYPE IN A BLOCK THAT "     &
+                    "CONTAINS A SELECTIVE WAIT WITH A TERMINATE " &
+                    "ALTERNATIVE, AND ACTUAL PARAMETER'S BASE "   &
+                    "A TASK TYPE OR TYPE WITH A SUBCOMPONENT OF " &
+                    "A TASK TYPE. ");
+
+     DECLARE
+          TASK TYPE TT IS
+               ENTRY E;
+          END TT;
+
+          TYPE TT_ARR IS ARRAY (1..2) OF TT;
+
+          TYPE TT_REC IS RECORD
+               COMP : TT_ARR;
+          END RECORD;
+
+          GENERIC
+               TYPE T IS LIMITED PRIVATE;
+          PACKAGE GEN IS
+               TASK TSK IS
+                    ENTRY ENT(A : OUT INTEGER);
+               END TSK;
+          END GEN;
+
+          INT : INTEGER;
+
+          TASK BODY TT IS
+          BEGIN
+               SELECT
+                    ACCEPT E;
+               OR
+                    TERMINATE;
+               END SELECT;
+          END TT;
+
+          PACKAGE BODY GEN IS
+               TASK BODY TSK IS
+               BEGIN
+                    DECLARE
+                         TYPE ACC_T IS ACCESS T;
+                         TA : ACC_T := NEW T;
+                    BEGIN
+                         SELECT
+                              ACCEPT ENT(A : OUT INTEGER) DO
+                                   A := IDENT_INT(7);
+                              END;
+                         OR
+                              TERMINATE;
+                         END SELECT;
+                    END;
+               END TSK;
+          END GEN;
+
+          PACKAGE GEN_TSK     IS NEW GEN(TT);
+          PACKAGE GEN_TSK_SUB IS NEW GEN(TT_REC);
+
+     BEGIN
+          GEN_TSK.TSK.ENT(INT);
+
+          IF INT /= IDENT_INT(7) THEN
+               FAILED("THE WRONG VALUE WAS RETURNED BY THE TASK");
+          END IF;
+
+          INT := 0;
+          GEN_TSK_SUB.TSK.ENT(INT);
+
+          IF INT /= IDENT_INT(7) THEN
+               FAILED("THE WRONG VALUE WAS RETURNED BY THE TASK, " &
+                      "WITH ACTUAL PARAMETER'S BASE IS A SUB" &
+                      "COMPONENT OF A TASK TYPE");
+          END IF;
+          RESULT;
+     END;
+END CC3207B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3220a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3220a.ada
new file mode 100644
index 000000000..d80ec17ea
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3220a.ada
@@ -0,0 +1,163 @@
+-- CC3220A.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 DISCRETE FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, AND
+-- OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING
+-- OPERATIONS OF THE ACTUAL TYPE.
+
+-- TBN  10/08/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3220A IS
+
+     GENERIC
+          TYPE T IS (<>);
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+BEGIN
+     TEST ("CC3220A", "CHECK THAT A DISCRETE FORMAL TYPE DENOTES ITS " &
+                      "ACTUAL PARAMETER, AND OPERATIONS OF THE " &
+                      "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                      "OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE
+          OBJ_INT : INTEGER := 1;
+
+          PACKAGE P1 IS NEW P (INTEGER);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1);
+          IF PAC_VAR /= OBJ_INT THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          OBJ_INT := PAC_VAR + OBJ_INT;
+          IF OBJ_INT <= PAC_VAR THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          PAC_VAR := PAC_VAR * OBJ_INT;
+          IF PAC_VAR NOT IN INTEGER THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF OBJ_INT NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          OBJ_NEWT := 1;
+          OBJ_NEWT := OBJ_NEWT + 1;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          IF NEW_T'SUCC(2) /= 3 THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+     END;
+
+     DECLARE
+          TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
+          OBJ_ENU : ENUM := RED;
+
+          PACKAGE P2 IS NEW P (ENUM);
+          USE P2;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(RED);
+          IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          IF PAC_VAR NOT IN ENUM THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          IF OBJ_ENU NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+          IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
+               FAILED ("INCORRECT RESULTS - 11");
+          END IF;
+          OBJ_ENU := SUB_T'SUCC(PAC_VAR);
+          IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
+               FAILED ("INCORRECT RESULTS - 12");
+          END IF;
+          OBJ_NEWT := BLUE;
+          OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 13");
+          END IF;
+          IF NEW_T'WIDTH /= 6 THEN
+               FAILED ("INCORRECT RESULTS - 14");
+          END IF;
+     END;
+
+     DECLARE
+          OBJ_CHR : CHARACTER := 'A';
+
+          PACKAGE P3 IS NEW P (CHARACTER);
+          USE P3;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+          ARA_NEWT : ARRAY (1 .. 5) OF NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'('A');
+          IF (PAC_VAR < OBJ_CHR) OR (PAC_VAR > OBJ_CHR) THEN
+               FAILED ("INCORRECT RESULTS - 15");
+          END IF;
+          IF PAC_VAR NOT IN CHARACTER THEN
+               FAILED ("INCORRECT RESULTS - 16");
+          END IF;
+          IF OBJ_CHR NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 17");
+          END IF;
+          IF CHARACTER'VAL(0) /= SUB_T'VAL(0) THEN
+               FAILED ("INCORRECT RESULTS - 18");
+          END IF;
+          OBJ_CHR := SUB_T'SUCC(PAC_VAR);
+          IF SUB_T'POS('A') /= 65 AND THEN OBJ_CHR /= 'A' THEN
+               FAILED ("INCORRECT RESULTS - 19");
+          END IF;
+          OBJ_NEWT := 'C';
+          OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 20");
+          END IF;
+          IF NEW_T'IMAGE('A') /= "'A'" THEN
+               FAILED ("INCORRECT RESULTS - 21");
+          END IF;
+          ARA_NEWT := "HELLO";
+          IF (NEW_T'('H') & NEW_T'('I')) /= "HI" THEN
+               FAILED ("INCORRECT RESULTS - 22");
+          END IF;
+     END;
+
+     RESULT;
+END CC3220A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3221a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3221a.ada
new file mode 100644
index 000000000..e7c7287da
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3221a.ada
@@ -0,0 +1,107 @@
+-- CC3221A.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 INTEGER FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, AND
+-- OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING
+-- OPERATIONS OF THE ACTUAL TYPE.
+
+-- TBN  10/09/86
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3221A IS
+
+     GENERIC
+          TYPE T IS RANGE <>;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+BEGIN
+     TEST ("CC3221A", "CHECK THAT AN INTEGER FORMAL TYPE DENOTES ITS " &
+                      "ACTUAL PARAMETER, AND OPERATIONS OF THE " &
+                      "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                      "OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE
+          TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
+
+          OBJ_INT : INTEGER := 1;
+          OBJ_FLO : FLOAT := 1.0;
+          OBJ_FIX : FIXED := 1.0;
+
+          PACKAGE P1 IS NEW P (INTEGER);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1);
+          IF PAC_VAR /= OBJ_INT THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          OBJ_INT := PAC_VAR + OBJ_INT;
+          IF OBJ_INT <= PAC_VAR THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          PAC_VAR := PAC_VAR * OBJ_INT;
+          IF PAC_VAR NOT IN INTEGER THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF OBJ_INT NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          PAC_VAR := 1;
+          OBJ_FIX := PAC_VAR * OBJ_FIX;
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          OBJ_INT := 1;
+          OBJ_FIX := OBJ_FIX / OBJ_INT;
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          OBJ_INT := OBJ_INT ** PAC_VAR;
+          IF OBJ_INT /= 1 THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          OBJ_FLO := OBJ_FLO ** PAC_VAR;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          OBJ_NEWT := 1;
+          OBJ_NEWT := OBJ_NEWT - 1;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+          IF NEW_T'SUCC(2) /= 3 THEN
+               FAILED ("INCORRECT RESULTS - 11");
+          END IF;
+     END;
+
+     RESULT;
+END CC3221A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3222a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3222a.ada
new file mode 100644
index 000000000..57cb19881
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3222a.ada
@@ -0,0 +1,116 @@
+-- CC3222A.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 FLOATING POINT FORMAL TYPE DENOTES ITS ACTUAL
+--     PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH
+--     CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
+
+-- HISTORY:
+--     TBN 10/09/86  CREATED ORIGINAL TEST.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3222A IS
+
+     TYPE FLOAT IS DIGITS 5 RANGE 0.0 .. 10.0;
+
+     GENERIC
+          TYPE T IS DIGITS <>;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+     FUNCTION IDENT_FLO (X : FLOAT) RETURN FLOAT IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;
+          ELSE
+               RETURN (0.0);
+          END IF;
+     END IDENT_FLO;
+
+BEGIN
+     TEST ("CC3222A", "CHECK THAT A FLOATING POINT FORMAL TYPE " &
+                      "DENOTES ITS ACTUAL PARAMETER, AND OPERATIONS " &
+                      "OF THE FORMAL TYPE ARE IDENTIFIED WITH " &
+                      "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE
+          OBJ_INT : INTEGER := 1;
+          OBJ_FLO : FLOAT := 1.0;
+
+          PACKAGE P1 IS NEW P (FLOAT);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1.0);
+          IF PAC_VAR /= OBJ_FLO THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          OBJ_FLO := IDENT_FLO (PAC_VAR) + IDENT_FLO (OBJ_FLO);
+          IF OBJ_FLO <= PAC_VAR THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          PAC_VAR := PAC_VAR * OBJ_FLO;
+          IF PAC_VAR NOT IN FLOAT THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF OBJ_FLO NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          PAC_VAR := 1.0;
+          OBJ_FLO := 1.0;
+          OBJ_FLO := PAC_VAR * OBJ_FLO;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          OBJ_FLO := 1.0;
+          OBJ_FLO := OBJ_FLO / OBJ_FLO;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          PAC_VAR := 1.0;
+          OBJ_FLO := PAC_VAR ** OBJ_INT;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          IF SUB_T'DIGITS /= 5 THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          OBJ_NEWT := 1.0;
+          OBJ_NEWT := OBJ_NEWT - 1.0;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          IF NEW_T'DIGITS /= 5 THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+     END;
+
+     RESULT;
+END CC3222A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3223a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3223a.ada
new file mode 100644
index 000000000..469a4963e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3223a.ada
@@ -0,0 +1,114 @@
+-- CC3223A.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 FORMAL TYPE DENOTES ITS ACTUAL
+--     PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED
+--     WITH CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
+
+-- HISTORY:
+--     TBN 10/09/86  CREATED ORIGINAL TEST.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3223A IS
+
+     TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
+
+     GENERIC
+          TYPE T IS DELTA <>;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+     FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;
+          ELSE
+               RETURN (0.0);
+          END IF;
+     END IDENT_FIX;
+
+BEGIN
+     TEST ("CC3223A", "CHECK THAT A FIXED POINT FORMAL TYPE DENOTES " &
+                      "ITS ACTUAL PARAMETER, AND OPERATIONS OF THE " &
+                      "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                      "OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE
+          OBJ_INT : INTEGER := 1;
+          OBJ_FIX : FIXED := 1.0;
+
+          PACKAGE P1 IS NEW P (FIXED);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1.0);
+          IF PAC_VAR /= OBJ_FIX THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX);
+          IF OBJ_FIX <= PAC_VAR THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          PAC_VAR := OBJ_INT * OBJ_FIX;
+          IF PAC_VAR NOT IN FIXED THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF OBJ_FIX NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          IF SUB_T'DELTA /= 0.125 THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          OBJ_NEWT := 1.0;
+          OBJ_NEWT := OBJ_NEWT - 1.0;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          IF NEW_T'DELTA /= 0.125 THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          OBJ_NEWT := NEW_T'SMALL + 1.0;
+          OBJ_FIX := 1.0;
+          OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX);
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          OBJ_FIX := 1.0;
+          OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX);
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          IF FIXED'SMALL /= NEW_T'SMALL THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+     END;
+
+     RESULT;
+END CC3223A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3224a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3224a.ada
new file mode 100644
index 000000000..5da67ea4c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3224a.ada
@@ -0,0 +1,313 @@
+-- CC3224A.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 FORMAL ARRAY TYPE DENOTES ITS ACTUAL
+--     PARAMETER, AND THAT OPERATIONS OF THE FORMAL TYPE ARE THOSE
+--     IDENTIFIED WITH THE CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
+
+-- HISTORY:
+--     DHH 09/19/88  CREATED ORIGINAL TEST.
+--     EDWARD V. BERARD, 14 AUGUST 1990  ADDED CHECKS FOR MULTI-
+--                                       DIMENSIONAL ARRAYS
+--     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.
+
+WITH REPORT ;
+
+PROCEDURE CC3224A IS
+
+    SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+    TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
+    TYPE B_ARR IS ARRAY(1 .. 3) OF BOOLEAN;
+
+    Q : ARR;
+    R : B_ARR;
+     
+    GENERIC
+        TYPE T IS ARRAY(INT) OF INTEGER;
+    PACKAGE P IS
+        SUBTYPE SUB_T IS T;
+        X : SUB_T := (1, 2, 3);
+    END P;
+
+    GENERIC
+        TYPE T IS ARRAY(INT) OF BOOLEAN;
+    PACKAGE BOOL IS
+        SUBTYPE SUB_T IS T;
+    END BOOL;
+     
+    SHORT_START : CONSTANT := -100 ;
+    SHORT_END   : CONSTANT := 100 ;
+    TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+    
+    SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
+    
+    TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+                        SEP, OCT, NOV, DEC) ;
+                        
+    SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
+    
+    TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+    TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+    TYPE DATE IS RECORD
+      MONTH : MONTH_TYPE ;
+      DAY   : DAY_TYPE ;
+      YEAR  : YEAR_TYPE ;
+    END RECORD ;
+    
+    TODAY         : DATE := (MONTH => AUG,
+                             DAY   => 8,
+                             YEAR  => 1990) ;
+                            
+    FIRST_DATE    : DATE := (DAY   => 6,
+                             MONTH => JUN,
+                             YEAR  => 1967) ;
+                            
+    WALL_DATE     : DATE := (MONTH => NOV,
+                             DAY   => 9,
+                             YEAR  => 1989) ;
+                            
+    SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
+                            
+    TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
+                                     FIRST_HALF,
+                                     FIRST_FIVE) OF DATE ;
+                                     
+    TD_ARRAY        : THREE_DIMENSIONAL ;
+    SECOND_TD_ARRAY : THREE_DIMENSIONAL ;
+                                     
+    GENERIC
+    
+        TYPE CUBE IS ARRAY (REALLY_SHORT,
+                            FIRST_HALF,
+                            FIRST_FIVE) OF DATE ;
+                            
+    PACKAGE TD_ARRAY_PACKAGE IS
+    
+        SUBTYPE SUB_CUBE IS CUBE ;
+        TEST_3D_ARRAY : SUB_CUBE := (THREE_DIMENSIONAL'RANGE =>
+                                    (THREE_DIMENSIONAL'RANGE (2) =>
+                                    (THREE_DIMENSIONAL'RANGE (3) =>
+                                     TODAY))) ;
+                                     
+    END TD_ARRAY_PACKAGE ;
+
+
+BEGIN  -- CC3224A
+
+    REPORT.TEST ("CC3224A", "CHECK THAT A FORMAL ARRAY TYPE DENOTES " &
+                 "ITS ACTUAL PARAMETER, AND THAT OPERATIONS OF " &
+                 "THE FORMAL TYPE ARE THOSE IDENTIFIED WITH THE " &
+                 "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");
+
+    ONE_DIMENSIONAL:
+     
+    DECLARE
+
+        PACKAGE P1 IS NEW P (ARR);
+
+        TYPE NEW_T IS NEW P1.SUB_T;
+        OBJ_NEWT : NEW_T;
+          
+    BEGIN  -- ONE_DIMENSIONAL
+     
+        IF NEW_T'FIRST /= ARR'FIRST THEN
+            REPORT.FAILED("'FIRST ATTRIBUTE REPORT.FAILED");
+        END IF;
+          
+        IF NEW_T'LAST /= ARR'LAST THEN
+            REPORT.FAILED("'LAST ATTRIBUTE REPORT.FAILED");
+        END IF;
+          
+        IF NEW_T'FIRST(1) /= ARR'FIRST(1) THEN
+            REPORT.FAILED("'FIRST(N) ATTRIBUTE REPORT.FAILED");
+        END IF;
+          
+        IF NOT (NEW_T'LAST(1) = ARR'LAST(1)) THEN
+            REPORT.FAILED("'LAST(N) ATTRIBUTE REPORT.FAILED");
+        END IF;
+          
+        IF 2 NOT IN NEW_T'RANGE THEN
+            REPORT.FAILED("'RANGE ATTRIBUTE REPORT.FAILED");
+        END IF;
+          
+        IF 3 NOT IN NEW_T'RANGE(1) THEN
+            REPORT.FAILED("'RANGE(N) ATTRIBUTE REPORT.FAILED");
+        END IF;
+          
+        IF NEW_T'LENGTH /= ARR'LENGTH THEN
+            REPORT.FAILED("'LENGTH ATTRIBUTE REPORT.FAILED");
+        END IF;
+          
+        IF NEW_T'LENGTH(1) /= ARR'LENGTH(1) THEN
+            REPORT.FAILED("'LENGTH(N) ATTRIBUTE REPORT.FAILED");
+         END IF;
+           
+        OBJ_NEWT := (1, 2, 3);
+        IF REPORT.IDENT_INT(3) /= OBJ_NEWT(3) THEN
+            REPORT.FAILED("ASSIGNMENT REPORT.FAILED");
+        END IF;
+
+        IF NEW_T'(1, 2, 3) NOT IN NEW_T THEN
+            REPORT.FAILED("QUALIFIED EXPRESSION REPORT.FAILED");
+        END IF;
+
+        Q := (1, 2, 3);
+        IF NEW_T(Q) /= OBJ_NEWT THEN
+            REPORT.FAILED("EXPLICIT CONVERSION REPORT.FAILED");
+        END IF;
+        
+        IF Q(1) /= OBJ_NEWT(1) THEN
+            REPORT.FAILED("INDEXING REPORT.FAILED");
+        END IF;
+        
+        IF (1, 2) /= OBJ_NEWT(1 .. 2) THEN
+            REPORT.FAILED("SLICE REPORT.FAILED");
+        END IF;
+        
+        IF (1, 2) & OBJ_NEWT(3) /= NEW_T(Q)THEN
+            REPORT.FAILED("CATENATION REPORT.FAILED");
+        END IF;
+        
+        IF NOT (P1.X IN ARR) THEN
+            REPORT.FAILED ("FORMAL DOES NOT DENOTE ACTUAL");
+        END IF;
+          
+    END ONE_DIMENSIONAL ;
+
+    BOOLEAN_ONE_DIMENSIONAL:
+     
+    DECLARE
+
+        PACKAGE B1 IS NEW BOOL (B_ARR);
+
+        TYPE NEW_T IS NEW B1.SUB_T;
+        OBJ_NEWT : NEW_T;
+          
+    BEGIN  -- BOOLEAN_ONE_DIMENSIONAL
+
+        OBJ_NEWT := (TRUE, TRUE, TRUE);
+        R := (TRUE, TRUE, TRUE);
+
+        IF (NEW_T'((TRUE, TRUE, TRUE)) XOR OBJ_NEWT) /=
+           NEW_T'((FALSE, FALSE, FALSE)) THEN
+            REPORT.FAILED("XOR REPORT.FAILED - BOOLEAN") ;
+        END IF;
+        
+        IF (NEW_T'((FALSE, FALSE, TRUE)) AND OBJ_NEWT) /=
+           NEW_T'((FALSE, FALSE, TRUE)) THEN
+            REPORT.FAILED("AND REPORT.FAILED - BOOLEAN") ;
+        END IF;
+        
+        IF (NEW_T'((FALSE, FALSE, FALSE)) OR OBJ_NEWT) /=
+           NEW_T'((TRUE, TRUE, TRUE)) THEN
+            REPORT.FAILED("OR REPORT.FAILED - BOOLEAN") ;
+        END IF ;
+          
+    END BOOLEAN_ONE_DIMENSIONAL ;
+     
+    THREE_DIMENSIONAL_TEST:
+     
+    DECLARE
+     
+         PACKAGE TD IS NEW TD_ARRAY_PACKAGE (CUBE => THREE_DIMENSIONAL) ;
+        
+        TYPE NEW_CUBE IS NEW TD.SUB_CUBE ;
+        NEW_CUBE_OBJECT : NEW_CUBE ;
+        
+    BEGIN  -- THREE_DIMENSIONAL_TEST
+    
+        IF (NEW_CUBE'FIRST /= THREE_DIMENSIONAL'FIRST) OR
+           (NEW_CUBE'FIRST (1) /= THREE_DIMENSIONAL'FIRST) OR
+           (NEW_CUBE'FIRST (2) /= THREE_DIMENSIONAL'FIRST (2)) OR
+           (NEW_CUBE'FIRST (3) /= THREE_DIMENSIONAL'FIRST (3)) THEN
+            REPORT.FAILED ("PROBLEMS WITH 'FIRST FOR MULTI-" &
+                           "DIMENSIONAL ARRAYS.") ;
+        END IF ;
+        
+        IF (NEW_CUBE'LAST /= THREE_DIMENSIONAL'LAST) OR
+           (NEW_CUBE'LAST (1) /= THREE_DIMENSIONAL'LAST) OR
+           (NEW_CUBE'LAST (2) /= THREE_DIMENSIONAL'LAST (2)) OR
+           (NEW_CUBE'LAST (3) /= THREE_DIMENSIONAL'LAST (3)) THEN
+            REPORT.FAILED ("PROBLEMS WITH 'LAST FOR MULTI-" &
+                           "DIMENSIONAL ARRAYS.") ;
+        END IF ;
+        
+        IF (-5 NOT IN NEW_CUBE'RANGE) OR
+           (-3 NOT IN NEW_CUBE'RANGE (1)) OR
+           (FEB NOT IN NEW_CUBE'RANGE (2)) OR
+           ('C' NOT IN NEW_CUBE'RANGE (3)) THEN
+            REPORT.FAILED ("PROBLEMS WITH 'RANGE FOR MULTI-" &
+                           "DIMENSIONAL ARRAYS.") ;
+        END IF ;
+        
+        IF (NEW_CUBE'LENGTH /= THREE_DIMENSIONAL'LENGTH) OR
+           (NEW_CUBE'LENGTH (1) /= THREE_DIMENSIONAL'LENGTH) OR
+           (NEW_CUBE'LENGTH (2) /= THREE_DIMENSIONAL'LENGTH (2)) OR
+           (NEW_CUBE'LENGTH (3) /= THREE_DIMENSIONAL'LENGTH (3)) THEN
+            REPORT.FAILED ("PROBLEMS WITH 'LENGTH FOR MULTI-" &
+                           "DIMENSIONAL ARRAYS.") ;
+        END IF ;
+        
+        NEW_CUBE_OBJECT := (NEW_CUBE'RANGE =>
+                           (NEW_CUBE'RANGE (2) =>
+                           (NEW_CUBE'RANGE (3) =>
+                            FIRST_DATE))) ;
+        IF FIRST_DATE /= NEW_CUBE_OBJECT (-3, MAR, 'D') THEN
+            REPORT.FAILED ("ASSIGNMENT FOR MULTI-DIMENSIONAL " &
+                           "ARRAYS FAILED.") ;
+        END IF ;
+        
+        IF NEW_CUBE'(NEW_CUBE'RANGE =>
+                    (NEW_CUBE'RANGE (2) =>
+                    (NEW_CUBE'RANGE (3) =>
+                     WALL_DATE))) NOT IN NEW_CUBE THEN
+            REPORT.FAILED ("QUALIFIED EXPRESSION FOR MULTI-" &
+                           "DIMENSIONAL ARRAYS FAILED.") ;
+        END IF ;
+        
+        SECOND_TD_ARRAY := (NEW_CUBE'RANGE =>
+                           (NEW_CUBE'RANGE (2) =>
+                           (NEW_CUBE'RANGE (3) =>
+                            FIRST_DATE))) ;
+        IF NEW_CUBE (SECOND_TD_ARRAY) /= NEW_CUBE_OBJECT THEN
+            REPORT.FAILED ("EXPLICIT CONVERSION FOR MULTI-" &
+                           "DIMENSIONAL ARRAYS FAILED.") ;
+        END IF ;
+        
+        IF SECOND_TD_ARRAY (-2, FEB, 'B')
+            /= NEW_CUBE_OBJECT (-2, FEB, 'B') THEN
+            REPORT.FAILED ("INDEXING FOR MULTI-" &
+                           "DIMENSIONAL ARRAYS FAILED.") ;
+        END IF ;
+        
+        IF NOT (TD.TEST_3D_ARRAY IN THREE_DIMENSIONAL) THEN
+            REPORT.FAILED ("FORMAL MULTI-DIMENSIONAL ARRAY " &
+                           "DOES NOT DENOTE ACTUAL.") ;
+        END IF ;
+        
+    END THREE_DIMENSIONAL_TEST ;
+    
+    REPORT.RESULT ;
+     
+END CC3224A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3225a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3225a.ada
new file mode 100644
index 000000000..478664f43
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3225a.ada
@@ -0,0 +1,183 @@
+-- CC3225A.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 FORMAL ACCESS TYPE DENOTES ITS ACTUAL
+--     PARAMETER, AND THAT OPERATIONS OF THE FORMAL TYPE ARE THOSE
+--     IDENTIFIED WITH THE CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
+
+-- HISTORY:
+--     DHH 10/21/88  CREATED ORIGINAL TEST.
+--     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3225A IS
+
+     GENERIC
+          TYPE NODE IS PRIVATE;
+          TYPE T IS ACCESS NODE;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : SUB_T;
+     END P;
+
+BEGIN
+     TEST ("CC3225A", "CHECK THAT A FORMAL ACCESS TYPE DENOTES ITS " &
+                      "ACTUAL PARAMETER, AND THAT OPERATIONS OF THE " &
+                      "FORMAL TYPE ARE THOSE IDENTIFIED WITH THE " &
+                      "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE
+          SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+          TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
+          TYPE ACC_ARR IS ACCESS ARR;
+
+          Q : ACC_ARR := NEW ARR;
+
+          PACKAGE P1 IS NEW P (ARR, ACC_ARR);
+          USE P1;
+
+     BEGIN
+          PAC_VAR := NEW ARR'(1, 2, 3);
+          IF PAC_VAR'FIRST /= Q'FIRST THEN
+               FAILED("'FIRST ATTRIBUTE FAILED");
+          END IF;
+          IF PAC_VAR'LAST /= Q'LAST THEN
+               FAILED("'LAST ATTRIBUTE FAILED");
+          END IF;
+          IF PAC_VAR'FIRST(1) /= Q'FIRST(1) THEN
+               FAILED("'FIRST(N) ATTRIBUTE FAILED");
+          END IF;
+          IF NOT (PAC_VAR'LAST(1) = Q'LAST(1)) THEN
+               FAILED("'LAST(N) ATTRIBUTE FAILED");
+          END IF;
+          IF 2 NOT IN PAC_VAR'RANGE THEN
+               FAILED("'RANGE ATTRIBUTE FAILED");
+          END IF;
+          IF 3 NOT IN PAC_VAR'RANGE(1) THEN
+               FAILED("'RANGE(N) ATTRIBUTE FAILED");
+          END IF;
+          IF PAC_VAR'LENGTH /= Q'LENGTH THEN
+               FAILED("'LENGTH ATTRIBUTE FAILED");
+          END IF;
+          IF PAC_VAR'LENGTH(1) /= Q'LENGTH(1) THEN
+               FAILED("'LENGTH(N) ATTRIBUTE FAILED");
+           END IF;
+
+          PAC_VAR.ALL := (1, 2, 3);
+          IF IDENT_INT(3) /= PAC_VAR(3) THEN
+               FAILED("ASSIGNMENT FAILED");
+          END IF;
+
+          IF SUB_T'(PAC_VAR) NOT IN SUB_T THEN
+               FAILED("QUALIFIED EXPRESSION FAILED");
+          END IF;
+
+          Q.ALL := PAC_VAR.ALL;
+          IF SUB_T(Q) = PAC_VAR THEN
+               FAILED("EXPLICIT CONVERSION FAILED");
+          END IF;
+          IF Q(1) /= PAC_VAR(1) THEN
+               FAILED("INDEXING FAILED");
+          END IF;
+          IF (1, 2) /= PAC_VAR(1 .. 2) THEN
+               FAILED("SLICE FAILED");
+          END IF;
+          IF (1, 2) & PAC_VAR(3) /= PAC_VAR.ALL THEN
+               FAILED("CATENATION FAILED");
+          END IF;
+     END;
+
+     DECLARE
+          TASK TYPE TSK IS
+               ENTRY ONE;
+          END TSK;
+
+          GENERIC
+               TYPE T IS ACCESS TSK;
+          PACKAGE P IS
+               SUBTYPE SUB_T IS T;
+               PAC_VAR : SUB_T;
+          END P;
+
+          TYPE ACC_TSK IS ACCESS TSK;
+
+          PACKAGE P1 IS NEW P(ACC_TSK);
+          USE P1;
+
+          GLOBAL : INTEGER := 5;
+
+          TASK BODY TSK IS
+          BEGIN
+               ACCEPT ONE DO
+                    GLOBAL := 1;
+               END ONE;
+          END;
+     BEGIN
+          PAC_VAR := NEW TSK;
+          PAC_VAR.ONE;
+          IF GLOBAL /= 1 THEN
+               FAILED("TASK ENTRY SELECTION FAILED");
+          END IF;
+     END;
+
+     DECLARE
+          TYPE REC IS
+               RECORD
+                    I : INTEGER;
+                    B : BOOLEAN;
+               END RECORD;
+
+          TYPE ACC_REC IS ACCESS REC;
+
+          PACKAGE P1 IS NEW P (REC, ACC_REC);
+          USE P1;
+
+     BEGIN
+          PAC_VAR := NEW REC'(4, (PAC_VAR IN ACC_REC));
+          IF PAC_VAR.I /= IDENT_INT(4) AND NOT PAC_VAR.B THEN
+               FAILED("RECORD COMPONENT SELECTION FAILED");
+          END IF;
+     END;
+
+     DECLARE
+          TYPE REC(B : BOOLEAN := FALSE) IS
+               RECORD
+                    NULL;
+               END RECORD;
+
+          TYPE ACC_REC IS ACCESS REC;
+
+          PACKAGE P1 IS NEW P (REC, ACC_REC);
+          USE P1;
+
+     BEGIN
+          PAC_VAR := NEW REC'(B => PAC_VAR IN ACC_REC);
+          IF NOT PAC_VAR.B THEN
+               FAILED("DISCRIMINANT SELECTION FAILED");
+          END IF;
+     END;
+
+     RESULT;
+END CC3225A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3230a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3230a.ada
new file mode 100644
index 000000000..7f40896a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3230a.ada
@@ -0,0 +1,133 @@
+-- CC3230A.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 PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+--      ACTUAL PARAMETER AN ENUMERATION TYPE, AND OPERATIONS OF THE
+--      FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE
+--      ACTUAL TYPE.
+
+-- HISTORY:
+--      TBN 09/14/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3230A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+     PACKAGE LP IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END LP;
+
+BEGIN
+     TEST ("CC3230A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                      "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
+                      "ENUMERATION TYPE, AND OPERATIONS OF THE " &
+                      "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                      "OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE
+          TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
+          OBJ_ENU : ENUM := RED;
+
+          PACKAGE P2 IS NEW P (ENUM);
+          USE P2;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(RED);
+          IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          IF PAC_VAR NOT IN ENUM THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          IF OBJ_ENU NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          OBJ_ENU := SUB_T'SUCC(PAC_VAR);
+          IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          OBJ_NEWT := BLUE;
+          OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          IF NEW_T'WIDTH /= 6 THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+     END;
+
+     DECLARE
+          TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
+          OBJ_ENU : ENUM := RED;
+
+          PACKAGE P2 IS NEW LP (ENUM);
+          USE P2;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(RED);
+          IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          IF PAC_VAR NOT IN ENUM THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          IF OBJ_ENU NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+          IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
+               FAILED ("INCORRECT RESULTS - 11");
+          END IF;
+          OBJ_ENU := SUB_T'SUCC(PAC_VAR);
+          IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
+               FAILED ("INCORRECT RESULTS - 12");
+          END IF;
+          OBJ_NEWT := BLUE;
+          OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 13");
+          END IF;
+          IF NEW_T'WIDTH /= 6 THEN
+               FAILED ("INCORRECT RESULTS - 14");
+          END IF;
+     END;
+
+     RESULT;
+END CC3230A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3231a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3231a.ada
new file mode 100644
index 000000000..a36bccfc8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3231a.ada
@@ -0,0 +1,177 @@
+-- CC3231A.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 PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+--      ACTUAL PARAMETER AN INTEGER TYPE, AND OPERATIONS OF THE FORMAL
+--      TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
+--      TYPE.
+
+-- HISTORY:
+--      TBN 09/14/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3231A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+     PACKAGE LP IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END LP;
+
+BEGIN
+     TEST ("CC3231A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                      "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
+                      "INTEGER TYPE, AND OPERATIONS OF THE " &
+                      "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                      "OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE  -- PRIVATE TYPE.
+          TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
+
+          OBJ_INT : INTEGER := 1;
+          OBJ_FLO : FLOAT := 1.0;
+          OBJ_FIX : FIXED := 1.0;
+
+          PACKAGE P1 IS NEW P (INTEGER);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1);
+          IF PAC_VAR /= OBJ_INT THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          OBJ_INT := PAC_VAR + OBJ_INT;
+          IF OBJ_INT <= PAC_VAR THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          PAC_VAR := PAC_VAR * OBJ_INT;
+          IF PAC_VAR NOT IN INTEGER THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF OBJ_INT NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          PAC_VAR := 1;
+          OBJ_FIX := PAC_VAR * OBJ_FIX;
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          OBJ_INT := 1;
+          OBJ_FIX := OBJ_FIX / OBJ_INT;
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          OBJ_INT := OBJ_INT ** PAC_VAR;
+          IF OBJ_INT /= 1 THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          OBJ_FLO := OBJ_FLO ** PAC_VAR;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          OBJ_NEWT := 1;
+          OBJ_NEWT := OBJ_NEWT - 1;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+          IF NEW_T'SUCC(2) /= 3 THEN
+               FAILED ("INCORRECT RESULTS - 11");
+          END IF;
+     END;
+
+     DECLARE  -- LIMITED PRIVATE TYPE.
+          TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
+
+          OBJ_INT : INTEGER := 1;
+          OBJ_FLO : FLOAT := 1.0;
+          OBJ_FIX : FIXED := 1.0;
+
+          PACKAGE P1 IS NEW LP (INTEGER);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1);
+          IF PAC_VAR /= OBJ_INT THEN
+               FAILED ("INCORRECT RESULTS - 12");
+          END IF;
+          OBJ_INT := PAC_VAR + OBJ_INT;
+          IF OBJ_INT <= PAC_VAR THEN
+               FAILED ("INCORRECT RESULTS - 13");
+          END IF;
+          PAC_VAR := PAC_VAR * OBJ_INT;
+          IF PAC_VAR NOT IN INTEGER THEN
+               FAILED ("INCORRECT RESULTS - 14");
+          END IF;
+          IF OBJ_INT NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 15");
+          END IF;
+          IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
+               FAILED ("INCORRECT RESULTS - 16");
+          END IF;
+          PAC_VAR := 1;
+          OBJ_FIX := PAC_VAR * OBJ_FIX;
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 17");
+          END IF;
+          OBJ_INT := 1;
+          OBJ_FIX := OBJ_FIX / OBJ_INT;
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 18");
+          END IF;
+          OBJ_INT := OBJ_INT ** PAC_VAR;
+          IF OBJ_INT /= 1 THEN
+               FAILED ("INCORRECT RESULTS - 19");
+          END IF;
+          OBJ_FLO := OBJ_FLO ** PAC_VAR;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 20");
+          END IF;
+          OBJ_NEWT := 1;
+          OBJ_NEWT := OBJ_NEWT - 1;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 21");
+          END IF;
+          IF NEW_T'SUCC(2) /= 3 THEN
+               FAILED ("INCORRECT RESULTS - 22");
+          END IF;
+     END;
+
+     RESULT;
+END CC3231A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3232a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3232a.ada
new file mode 100644
index 000000000..9b4b5445d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3232a.ada
@@ -0,0 +1,179 @@
+-- CC3232A.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 PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+--     ACTUAL PARAMETER A FLOATING POINT TYPE, AND OPERATIONS OF THE
+--     FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE
+--     ACTUAL TYPE.
+
+-- HISTORY:
+--     TBN 09/15/88  CREATED ORIGINAL TEST.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3232A IS
+
+     TYPE FLOAT IS DIGITS 5 RANGE 0.0 .. 10.0;
+
+     GENERIC
+          TYPE T IS PRIVATE;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+     PACKAGE LP IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END LP;
+
+     FUNCTION IDENT_FLO (X : FLOAT) RETURN FLOAT IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;
+          ELSE
+               RETURN (0.0);
+          END IF;
+     END IDENT_FLO;
+
+BEGIN
+     TEST ("CC3232A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                      "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER A " &
+                      "FLOATING POINT TYPE, AND OPERATIONS OF THE " &
+                      "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                      "OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE  -- PRIVATE TYPE.
+          OBJ_INT : INTEGER := 1;
+          OBJ_FLO : FLOAT := 1.0;
+
+          PACKAGE P1 IS NEW P (FLOAT);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1.0);
+          IF PAC_VAR /= OBJ_FLO THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          OBJ_FLO := IDENT_FLO (PAC_VAR) + IDENT_FLO (OBJ_FLO);
+          IF OBJ_FLO <= PAC_VAR THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          PAC_VAR := PAC_VAR * OBJ_FLO;
+          IF PAC_VAR NOT IN FLOAT THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF OBJ_FLO NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          PAC_VAR := 1.0;
+          OBJ_FLO := 1.0;
+          OBJ_FLO := PAC_VAR * OBJ_FLO;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          OBJ_FLO := 1.0;
+          OBJ_FLO := OBJ_FLO / OBJ_FLO;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          PAC_VAR := 1.0;
+          OBJ_FLO := PAC_VAR ** OBJ_INT;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          IF SUB_T'DIGITS /= 5 THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          OBJ_NEWT := 1.0;
+          OBJ_NEWT := OBJ_NEWT - 1.0;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          IF NEW_T'DIGITS /= 5 THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+     END;
+
+     DECLARE  -- LIMITED PRIVATE TYPE.
+          OBJ_INT : INTEGER := 1;
+          OBJ_FLO : FLOAT := 1.0;
+
+          PACKAGE P1 IS NEW LP (FLOAT);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1.0);
+          IF PAC_VAR /= OBJ_FLO THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          OBJ_FLO := IDENT_FLO (PAC_VAR) + IDENT_FLO (OBJ_FLO);
+          IF OBJ_FLO <= PAC_VAR THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          PAC_VAR := PAC_VAR * OBJ_FLO;
+          IF PAC_VAR NOT IN FLOAT THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF OBJ_FLO NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          PAC_VAR := 1.0;
+          OBJ_FLO := 1.0;
+          OBJ_FLO := PAC_VAR * OBJ_FLO;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          OBJ_FLO := 1.0;
+          OBJ_FLO := OBJ_FLO / OBJ_FLO;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          PAC_VAR := 1.0;
+          OBJ_FLO := PAC_VAR ** OBJ_INT;
+          IF OBJ_FLO /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          IF SUB_T'DIGITS /= 5 THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          OBJ_NEWT := 1.0;
+          OBJ_NEWT := OBJ_NEWT - 1.0;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          IF NEW_T'DIGITS /= 5 THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+     END;
+
+     RESULT;
+END CC3232A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3233a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3233a.ada
new file mode 100644
index 000000000..c344cfc97
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3233a.ada
@@ -0,0 +1,175 @@
+-- CC3233A.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 PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+--     ACTUAL PARAMETER, A FIXED POINT TYPE AND OPERATIONS OF THE FORMAL
+--     TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
+--     TYPE.
+
+-- HISTORY:
+--     TBN 09/15/88  CREATED ORIGINAL TEST.
+--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3233A IS
+
+     TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
+
+     GENERIC
+          TYPE T IS PRIVATE;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+     PACKAGE LP IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END LP;
+
+     FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN X;
+          ELSE
+               RETURN (0.0);
+          END IF;
+     END IDENT_FIX;
+
+BEGIN
+     TEST ("CC3233A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                      "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, A " &
+                      "FIXED POINT TYPE AND OPERATIONS OF THE FORMAL " &
+                      "TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                      "OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE  -- PRIVATE TYPE.
+          OBJ_INT : INTEGER := 1;
+          OBJ_FIX : FIXED := 1.0;
+
+          PACKAGE P1 IS NEW P (FIXED);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1.0);
+          IF PAC_VAR /= OBJ_FIX THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX);
+          IF OBJ_FIX <= PAC_VAR THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          PAC_VAR := OBJ_INT * OBJ_FIX;
+          IF PAC_VAR NOT IN FIXED THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF OBJ_FIX NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          IF SUB_T'DELTA /= 0.125 THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          OBJ_NEWT := 1.0;
+          OBJ_NEWT := OBJ_NEWT - 1.0;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          IF NEW_T'DELTA /= 0.125 THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          OBJ_NEWT := NEW_T'SMALL + 1.0;
+          OBJ_FIX := 1.0;
+          OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX);
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          OBJ_FIX := 1.0;
+          OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX);
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          IF FIXED'SMALL /= NEW_T'SMALL THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+     END;
+
+     DECLARE  -- LIMITED PRIVATE TYPE.
+          OBJ_INT : INTEGER := 1;
+          OBJ_FIX : FIXED := 1.0;
+
+          PACKAGE P1 IS NEW LP (FIXED);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1.0);
+          IF PAC_VAR /= OBJ_FIX THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX);
+          IF OBJ_FIX <= PAC_VAR THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          PAC_VAR := OBJ_INT * OBJ_FIX;
+          IF PAC_VAR NOT IN FIXED THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF OBJ_FIX NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          IF SUB_T'DELTA /= 0.125 THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          OBJ_NEWT := 1.0;
+          OBJ_NEWT := OBJ_NEWT - 1.0;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          IF NEW_T'DELTA /= 0.125 THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          OBJ_NEWT := NEW_T'SMALL + 1.0;
+          OBJ_FIX := 1.0;
+          OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX);
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          OBJ_FIX := 1.0;
+          OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX);
+          IF OBJ_FIX /= 1.0 THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          IF FIXED'SMALL /= NEW_T'SMALL THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+     END;
+
+     RESULT;
+END CC3233A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3234a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3234a.ada
new file mode 100644
index 000000000..487b26c89
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3234a.ada
@@ -0,0 +1,147 @@
+-- CC3234A.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 PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+--      ACTUAL PARAMETER AN ARRAY TYPE, AND OPERATIONS OF THE FORMAL
+--      TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
+--      TYPE.
+
+-- HISTORY:
+--      TBN 09/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3234A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+     PACKAGE LP IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END LP;
+
+BEGIN
+     TEST ("CC3234A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                      "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
+                      "ARRAY TYPE, AND OPERATIONS OF THE " &
+                      "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                      "OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE  -- PRIVATE TYPE.
+          TYPE ARRAY_TYPE IS ARRAY (1..10) OF INTEGER;
+
+          OBJ_ARR : ARRAY_TYPE := (OTHERS => 1);
+
+          PACKAGE P1 IS NEW P (ARRAY_TYPE);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
+          IF PAC_VAR /= OBJ_ARR THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          OBJ_ARR(1) := PAC_VAR(2) + OBJ_ARR(1);
+          IF OBJ_ARR(1) <= PAC_VAR(1) THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          PAC_VAR(1) := PAC_VAR(1) * OBJ_ARR(3);
+          IF PAC_VAR NOT IN ARRAY_TYPE THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF OBJ_ARR NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          IF ARRAY_TYPE'FIRST /= SUB_T'FIRST THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+          OBJ_ARR(1..5) := PAC_VAR(6..10);
+          IF OBJ_ARR(1..5) /= (1, 1, 1, 1, 1) THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          PAC_VAR := (1, 1, 1, 1, 1, 2, 2, 2, 2, 2);
+          OBJ_NEWT := (1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
+          OBJ_NEWT := NEW_T(PAC_VAR);
+          IF OBJ_NEWT(3..7) /= (1, 1, 1, 2, 2) THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+     END;
+
+     DECLARE  -- LIMITED PRIVATE TYPE.
+          TYPE ARRAY_TYPE IS ARRAY (1..10) OF INTEGER;
+
+          OBJ_ARR : ARRAY_TYPE := (OTHERS => 1);
+
+          PACKAGE P1 IS NEW LP (ARRAY_TYPE);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := SUB_T'(1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
+          IF PAC_VAR /= OBJ_ARR THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          OBJ_ARR(1) := PAC_VAR(2) + OBJ_ARR(1);
+          IF OBJ_ARR(1) <= PAC_VAR(1) THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+          PAC_VAR(1) := PAC_VAR(1) * OBJ_ARR(3);
+          IF PAC_VAR NOT IN ARRAY_TYPE THEN
+               FAILED ("INCORRECT RESULTS - 11");
+          END IF;
+          IF OBJ_ARR NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 12");
+          END IF;
+          IF ARRAY_TYPE'FIRST /= SUB_T'FIRST THEN
+               FAILED ("INCORRECT RESULTS - 13");
+          END IF;
+          OBJ_ARR(1..5) := PAC_VAR(6..10);
+          IF OBJ_ARR(1..5) /= (1, 1, 1, 1, 1) THEN
+               FAILED ("INCORRECT RESULTS - 14");
+          END IF;
+          PAC_VAR := (1, 1, 1, 1, 1, 2, 2, 2, 2, 2);
+          OBJ_NEWT := (1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
+          OBJ_NEWT := NEW_T(PAC_VAR);
+          IF OBJ_NEWT(3..7) /= (1, 1, 1, 2, 2) THEN
+               FAILED ("INCORRECT RESULTS - 15");
+          END IF;
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 16");
+          END IF;
+     END;
+
+     RESULT;
+END CC3234A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3235a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3235a.ada
new file mode 100644
index 000000000..f32c3e128
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3235a.ada
@@ -0,0 +1,129 @@
+-- CC3235A.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 PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS
+--      ACTUAL PARAMETER AN ACCESS TYPE, AND OPERATIONS OF THE FORMAL
+--      TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL
+--      TYPE.
+
+-- HISTORY:
+--      TBN 09/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3235A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+     PACKAGE LP IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END LP;
+
+BEGIN
+     TEST ("CC3235A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " &
+                      "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER AN " &
+                      "ACCESS TYPE, AND OPERATIONS OF THE " &
+                      "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
+                      "OPERATIONS OF THE ACTUAL TYPE");
+
+     DECLARE  -- PRIVATE TYPE.
+          TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
+
+          TYPE ACCESS_TYPE IS ACCESS ENUM;
+
+          OBJ_ACC : ACCESS_TYPE := NEW ENUM'(RED);
+
+          PACKAGE P1 IS NEW P (ACCESS_TYPE);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := NEW ENUM'(RED);
+          IF (PAC_VAR.ALL < OBJ_ACC.ALL) OR
+             (PAC_VAR.ALL > OBJ_ACC.ALL) THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          IF PAC_VAR NOT IN ACCESS_TYPE THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          IF OBJ_ACC NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          OBJ_ACC := NEW ENUM'(ENUM'SUCC(PAC_VAR.ALL));
+          IF OBJ_ACC.ALL /= YELLOW THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+          OBJ_NEWT := NEW ENUM'(BLUE);
+          OBJ_NEWT := NEW ENUM'(ENUM'PRED(OBJ_NEWT.ALL));
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 5");
+          END IF;
+     END;
+
+     DECLARE  -- LIMITED PRIVATE TYPE.
+          TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
+
+          TYPE ACCESS_TYPE IS ACCESS ENUM;
+
+          OBJ_ACC : ACCESS_TYPE := NEW ENUM'(RED);
+
+          PACKAGE P1 IS NEW LP (ACCESS_TYPE);
+          USE P1;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T;
+     BEGIN
+          PAC_VAR := NEW ENUM'(RED);
+          IF (PAC_VAR.ALL < OBJ_ACC.ALL) OR
+             (PAC_VAR.ALL > OBJ_ACC.ALL) THEN
+               FAILED ("INCORRECT RESULTS - 6");
+          END IF;
+          IF PAC_VAR NOT IN ACCESS_TYPE THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          IF OBJ_ACC NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          OBJ_ACC := NEW ENUM'(ENUM'SUCC(PAC_VAR.ALL));
+          IF OBJ_ACC.ALL /= YELLOW THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          OBJ_NEWT := NEW ENUM'(BLUE);
+          OBJ_NEWT := NEW ENUM'(ENUM'PRED(OBJ_NEWT.ALL));
+          IF OBJ_NEWT NOT IN NEW_T THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+     END;
+
+     RESULT;
+END CC3235A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3236a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3236a.ada
new file mode 100644
index 000000000..d02dec25e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3236a.ada
@@ -0,0 +1,117 @@
+-- CC3236A.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 FORMAL PRIVATE AND LIMITED PRIVATE TYPE DENOTES ITS
+--      ACTUAL PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE
+--      IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL TYPE
+--      WHEN THE ACTUAL PARAMETER IS A TYPE WITH DISCRIMINANTS.
+
+-- HISTORY:
+--      DHH 10/24/88 CREATED ORIGINAL TEST.
+--      PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3236A IS
+
+     GENERIC
+          TYPE T IS PRIVATE;
+     PACKAGE P IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END P;
+
+     GENERIC
+          TYPE T IS LIMITED PRIVATE;
+     PACKAGE LP IS
+          SUBTYPE SUB_T IS T;
+          PAC_VAR : T;
+     END LP;
+
+BEGIN
+     TEST ("CC3236A", "CHECK THAT A FORMAL PRIVATE OR LIMITED " &
+                      "PRIVATE TYPE DENOTES ITS ACTUAL PARAMETER AND " &
+                      "OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED " &
+                      "WITH CORRESPONDING OPERATIONS OF THE ACTUAL " &
+                      "TYPE, WHEN THE ACTUAL PARAMETER IS A TYPE " &
+                      "WITH DISCRIMINANTS");
+
+     DECLARE
+          TYPE REC(X : INTEGER := 5) IS
+               RECORD
+                    NULL;
+               END RECORD;
+          OBJ_REC : REC(4);
+
+          PACKAGE P2 IS NEW P (REC);
+          USE P2;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T(4);
+     BEGIN
+          PAC_VAR := SUB_T'((X => 4));
+          IF PAC_VAR /= OBJ_REC THEN
+               FAILED ("INCORRECT RESULTS - 1");
+          END IF;
+          IF PAC_VAR NOT IN REC THEN
+               FAILED ("INCORRECT RESULTS - 2");
+          END IF;
+          IF OBJ_REC NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 3");
+          END IF;
+          IF PAC_VAR.X /= OBJ_NEWT.X THEN
+               FAILED ("INCORRECT RESULTS - 4");
+          END IF;
+     END;
+
+     DECLARE
+          TYPE REC(X : INTEGER := 5) IS
+               RECORD
+                    NULL;
+               END RECORD;
+          OBJ_REC : REC(4);
+
+          PACKAGE P2 IS NEW LP (REC);
+          USE P2;
+
+          TYPE NEW_T IS NEW SUB_T;
+          OBJ_NEWT : NEW_T(4);
+     BEGIN
+          PAC_VAR := SUB_T'(X => 4);
+          IF PAC_VAR /= OBJ_REC THEN
+               FAILED ("INCORRECT RESULTS - 7");
+          END IF;
+          IF PAC_VAR NOT IN REC THEN
+               FAILED ("INCORRECT RESULTS - 8");
+          END IF;
+          IF OBJ_REC NOT IN SUB_T THEN
+               FAILED ("INCORRECT RESULTS - 9");
+          END IF;
+          IF PAC_VAR.X /= OBJ_NEWT.X THEN
+               FAILED ("INCORRECT RESULTS - 10");
+          END IF;
+     END;
+
+     RESULT;
+END CC3236A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3240a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3240a.ada
new file mode 100644
index 000000000..1983b9429
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3240a.ada
@@ -0,0 +1,122 @@
+-- CC3240A.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 FORMAL PRIVATE AND LIMITED PRIVATE TYPE DENOTES ITS
+--      ACTUAL PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE
+--      IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL TYPE
+--      WHEN THE FORMAL TYPE IS A TYPE WITH DISCRIMINANTS.
+
+-- HISTORY:
+--      RJW 10/13/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3240A IS
+
+BEGIN
+     TEST ("CC3240A", "CHECK THAT A FORMAL PRIVATE OR LIMITED " &
+                      "PRIVATE TYPE DENOTES ITS ACTUAL PARAMETER AND " &
+                      "OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED " &
+                      "WITH CORRESPONDING OPERATIONS OF THE ACTUAL " &
+                      "TYPE, WHEN THE FORMAL TYPE IS A TYPE " &
+                      "WITH DISCRIMINANTS");
+
+     DECLARE
+
+          GENERIC
+               TYPE T(A : INTEGER) IS PRIVATE;
+          PACKAGE P IS
+               SUBTYPE S IS T;
+               TX : T(5);
+          END P;
+
+          TYPE REC (L : INTEGER) IS
+               RECORD
+                    A : INTEGER;
+               END RECORD;
+
+          PACKAGE P1 IS NEW P (REC);
+          USE P1;
+
+     BEGIN
+          TX := (L => 5, A => 7);
+          IF NOT (TX IN REC) THEN
+               FAILED ("MEMBERSHIP TEST - PRIVATE");
+          END IF;
+
+          IF TX.A /= 7 OR TX.L /= 5 THEN
+               FAILED ("SELECTED COMPONENTS - PRIVATE");
+          END IF;
+
+          IF S(TX) /= REC(TX) THEN
+               FAILED ("EXPLICIT CONVERSION - PRIVATE");
+          END IF;
+
+          IF NOT TX'CONSTRAINED THEN
+               FAILED ("'CONSTRAINED - PRIVATE");
+          END IF;
+     END;
+
+     DECLARE
+          TYPE REC(L : INTEGER) IS
+               RECORD
+                    A : INTEGER;
+               END RECORD;
+
+          GENERIC
+               TYPE T(A : INTEGER) IS LIMITED PRIVATE;
+               TX : IN OUT T;
+          PACKAGE LP IS
+               SUBTYPE S IS T;
+          END LP;
+
+          R : REC (5) := (5, 7);
+
+          PACKAGE BODY LP IS
+          BEGIN
+               IF (TX IN S) /= (R IN REC) THEN
+                    FAILED ("MEMBERSHIP TEST - LIMITED PRIVATE");
+               END IF;
+
+               IF TX.A /= 5 THEN
+                    FAILED ("SELECTED COMPONENTS - LIMITED PRIVATE");
+               END IF;
+
+               IF (S(TX) IN S) /= (REC(R) IN REC) THEN
+                    FAILED ("EXPLICIT CONVERSION - LIMITED PRIVATE");
+               END IF;
+
+               IF NOT TX'CONSTRAINED THEN
+                    FAILED ("'CONSTRAINED - LIMITED PRIVATE");
+               END IF;
+          END LP;
+
+          PACKAGE P1 IS NEW LP (REC, R);
+          USE P1;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC3240A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305a.ada
new file mode 100644
index 000000000..66d0f38c4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305a.ada
@@ -0,0 +1,103 @@
+-- CC3305A.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 WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
+-- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
+
+-- CHECK WHEN THE SCALAR TYPE IS DEFINED BY (<>).
+
+-- SPS 7/15/82
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CC3305A IS
+BEGIN
+
+     TEST ("CC3305A", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
+           "TYPES OF THE FORM (<>)");
+
+     DECLARE
+          TYPE COLOR IS (RED, BLUE, YELLOW, ORANGE, GREEN, PURPLE);
+          SUBTYPE P_COLOR IS COLOR RANGE BLUE .. ORANGE;
+          SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+          SUBTYPE ATOC IS CHARACTER RANGE CHARACTER'VAL(1) .. 
+               CHARACTER'VAL(3);
+
+          GENERIC
+               TYPE GFT IS (<>);
+          PACKAGE PK IS END PK;
+
+          PACKAGE BODY PK IS
+          BEGIN
+               FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
+                    COMMENT ("START OF ITERATION");
+                    DECLARE
+                         VAR : GFT;
+                    BEGIN
+                         VAR := GFT'VAL (I);
+                         IF I = 0 OR I = 4 THEN
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              IF I /= 0 AND I /= 4 THEN
+                                   FAILED ("CONSTRAINT_ERROR RAISED " &
+                                      "INAPPROPRIATELY");
+                              END IF;
+                    END;
+               END LOOP;
+          END PK;
+
+     BEGIN
+          COMMENT ("INSTANTIATION WITH P_COLOR");
+          DECLARE
+               PACKAGE NPC IS NEW PK (P_COLOR);
+          BEGIN
+               NULL;
+          END;
+
+          COMMENT ("INSTANTIATION WITH INT");
+
+          DECLARE
+               PACKAGE NPI IS NEW PK (INT);
+          BEGIN
+               NULL;
+          END;
+
+          COMMENT ("INSTANTIATION WITH ATOC");
+
+          DECLARE
+               PACKAGE NPA IS NEW PK (ATOC);
+          BEGIN
+               NULL;
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
+     END;
+
+     RESULT;
+END CC3305A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305b.ada
new file mode 100644
index 000000000..7273c689e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305b.ada
@@ -0,0 +1,84 @@
+-- CC3305B.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 WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
+-- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
+
+-- CHECK WHEN THE SCALAR TYPE IS DEFINED BY RANGE <>.
+
+-- SPS 7/15/82
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CC3305B IS
+BEGIN
+
+     TEST ("CC3305B", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
+           "TYPES OF THE FORM RANGE <>");
+
+     DECLARE
+          SUBTYPE INT IS INTEGER RANGE 1 .. 3;
+
+          GENERIC
+               TYPE GFT IS RANGE <>;
+          PACKAGE PK IS END PK;
+
+          PACKAGE BODY PK IS
+          BEGIN
+               FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
+                    COMMENT ("START OF ITERATION");
+                    DECLARE
+                         VAR : GFT;
+                    BEGIN
+                         VAR := GFT(I);
+                         IF I = IDENT_INT(0) OR I = IDENT_INT(4) THEN
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              IF I /= IDENT_INT(0) AND
+                                 I /= IDENT_INT(4) THEN
+                                   FAILED ("CONSTRAINT_ERROR RAISED " &
+                                      "INAPPROPRIATELY");
+                              END IF;
+                    END;
+               END LOOP;
+          END PK;
+
+     BEGIN
+
+          DECLARE
+               PACKAGE NPI IS NEW PK (INT);
+          BEGIN
+               NULL;
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
+     END;
+
+     RESULT;
+END CC3305B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305c.ada
new file mode 100644
index 000000000..6cb53a87b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305c.ada
@@ -0,0 +1,84 @@
+-- CC3305C.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 WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
+-- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
+
+-- CHECK WHEN THE SCALAR TYPE IS DEFINED BY DIGITS <>.
+
+-- SPS 7/15/82
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CC3305C IS
+BEGIN
+
+     TEST ("CC3305C", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
+           "TYPES OF THE FORM DIGITS <>");
+
+     DECLARE
+          SUBTYPE FL IS FLOAT RANGE 1.0 .. 3.0;
+
+          GENERIC
+               TYPE GFT IS DIGITS <>;
+          PACKAGE PK IS END PK;
+
+          PACKAGE BODY PK IS
+          BEGIN
+               FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
+                    COMMENT ("START OF ITERATION");
+                    DECLARE
+                         VAR : GFT;
+                    BEGIN
+                         VAR := GFT (I);
+                         IF I = IDENT_INT(0) OR I = IDENT_INT(4) THEN
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              IF I /= IDENT_INT(0) AND 
+                                 I /= IDENT_INT(4) THEN
+                                   FAILED ("CONSTRAINT_ERROR RAISED " &
+                                      "INAPPROPRIATELY");
+                              END IF;
+                    END;
+               END LOOP;
+          END PK;
+
+     BEGIN
+
+          DECLARE
+               PACKAGE NP IS NEW PK (FL);
+          BEGIN
+               NULL;
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
+     END;
+
+     RESULT;
+END CC3305C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305d.ada
new file mode 100644
index 000000000..1faa64f62
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3305d.ada
@@ -0,0 +1,84 @@
+-- CC3305D.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 WHEN A GENERIC FORMAL TYPE IS A SCALAR TYPE, THE BOUNDS OF
+-- THE ACTUAL PARAMETER ARE USED WITHIN THE INSTANTIATED UNIT.
+
+-- CHECK WHEN THE SCALAR TYPE IS DEFINED BY DELTA <>.
+
+-- SPS 7/15/82
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CC3305D IS
+BEGIN
+
+     TEST ("CC3305D", "TEST THE BOUNDS OF GENERIC FORMAL SCALAR " &
+           "TYPES OF THE FORM DELTA <>");
+
+     DECLARE
+          TYPE FX IS DELTA 0.1 RANGE 1.0 .. 3.0;
+
+          GENERIC
+               TYPE GFT IS DELTA <>;
+          PACKAGE PK IS END PK;
+
+          PACKAGE BODY PK IS
+          BEGIN
+               FOR I IN IDENT_INT(0) .. IDENT_INT(4) LOOP
+                    COMMENT ("START OF ITERATION");
+                    DECLARE
+                         VAR : GFT;
+                    BEGIN
+                         VAR := GFT (I);
+                         IF I = IDENT_INT(0) OR I = IDENT_INT(4) THEN
+                              FAILED ("CONSTRAINT_ERROR NOT RAISED");
+                         END IF;
+                    EXCEPTION
+                         WHEN CONSTRAINT_ERROR =>
+                              IF I /= IDENT_INT(0) AND
+                                 I /= IDENT_INT(4) THEN
+                                   FAILED ("CONSTRAINT_ERROR RAISED " &
+                                      "INAPPROPRIATELY");
+                              END IF;
+                    END;
+               END LOOP;
+          END PK;
+
+     BEGIN
+
+          DECLARE
+               PACKAGE NP IS NEW PK (FX);
+          BEGIN
+               NULL;
+          END;
+
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               FAILED ("CONSTRAINT_ERROR RAISED ON INSTANTIATION");
+     END;
+
+     RESULT;
+END CC3305D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3601a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3601a.ada
new file mode 100644
index 000000000..198f47ecd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3601a.ada
@@ -0,0 +1,251 @@
+-- CC3601A.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 PREDEFINED OPERATORS MAY BE PASSED AS ACTUAL
+-- GENERIC SUBPROGRAM PARAMETERS (CHECKS FOR "=" AND "/=" ARE IN
+-- CC3601C).
+
+-- R.WILLIAMS 10/9/86
+-- JRL        11/15/95 Added unknown discriminant part to all formal
+--                     private types.
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3601A IS
+
+     GENERIC
+          TYPE T (<>) IS PRIVATE;
+          V, V1 : T;
+          KIND : STRING;
+          WITH FUNCTION F1 (X : IN T) RETURN T;
+     PACKAGE GP1 IS
+          R : BOOLEAN := F1 (V) = V1;
+     END GP1;
+
+     PACKAGE BODY GP1 IS
+     BEGIN
+          IF NOT (IDENT_BOOL(R)) THEN
+               FAILED ( "INCORRECT VALUE FOR UNARY OP - " & KIND);
+          END IF;
+     END GP1;
+
+     GENERIC
+          TYPE T (<>) IS PRIVATE;
+          V, V1, V2 : IN T;
+          KIND : STRING;
+          WITH FUNCTION F1 (P1 : IN T; P2 : IN T) RETURN T;
+     PACKAGE GP2 IS
+          R : BOOLEAN := V /= F1 (V1, V2);
+     END GP2;
+
+     PACKAGE BODY GP2 IS
+     BEGIN
+          IF IDENT_BOOL (R) THEN
+               FAILED ( "INCORRECT VALUE FOR BINARY OP - " & KIND);
+          END IF;
+     END GP2;
+
+     
+     GENERIC
+          TYPE T1 (<>) IS PRIVATE;
+          TYPE T2 (<>) IS PRIVATE;
+          V1 : T1;
+          V2 : T2;
+          KIND : STRING;
+          WITH FUNCTION F1 (X : IN T1) RETURN T2;
+     PACKAGE GP3 IS
+          R : BOOLEAN := F1 (V1) = V2;
+     END GP3;
+
+     PACKAGE BODY GP3 IS
+     BEGIN
+          IF NOT (IDENT_BOOL(R)) THEN
+               FAILED ( "INCORRECT VALUE FOR OP - " & KIND);
+          END IF;
+     END GP3;
+
+BEGIN
+     TEST ( "CC3601A", "CHECK THAT PREDEFINED OPERATORS MAY BE " &
+                       "PASSED AS ACTUAL GENERIC SUBPROGRAM " &
+                       "PARAMETERS" );
+
+
+     BEGIN -- CHECKS WITH RELATIONAL OPERATORS AND LOGICAL OPERATORS AS
+           -- ACTUAL PARAMETERS.
+
+          FOR I1 IN BOOLEAN LOOP
+
+               FOR I2 IN BOOLEAN LOOP
+                    COMMENT ( "B1 = " & BOOLEAN'IMAGE (I1) & " AND " &
+                              "B2 = " & BOOLEAN'IMAGE (I2) );
+                    DECLARE
+                         B1 : BOOLEAN := IDENT_BOOL (I1);
+                         B2 : BOOLEAN := IDENT_BOOL (I2);
+
+                         PACKAGE P1 IS 
+                              NEW GP1 (BOOLEAN, NOT B2, B2, 
+                                       """NOT"" - 1", "NOT");
+                         PACKAGE P2 IS 
+                              NEW GP2 (BOOLEAN, B1 OR B2, B1, B2, 
+                                       "OR", "OR");
+                         PACKAGE P3 IS  
+                              NEW GP2 (BOOLEAN, B1 AND B2, B2, B1, 
+                                       "AND", "AND");
+                         PACKAGE P4 IS 
+                              NEW GP2 (BOOLEAN, B1 /= B2, B1, B2, 
+                                       "XOR", "XOR");
+                         PACKAGE P5 IS  
+                              NEW GP2 (BOOLEAN, B1 < B2, B1, B2, 
+                                       "<", "<");
+                         PACKAGE P6 IS 
+                              NEW GP2 (BOOLEAN, B1 <= B2, B1, B2, 
+                                       "<=", "<=");
+                         PACKAGE P7 IS  
+                              NEW GP2 (BOOLEAN, B1 > B2, B1, B2, 
+                                       ">", ">");
+                         PACKAGE P8 IS  
+                              NEW GP2 (BOOLEAN, B1 >= B2, B1, B2, 
+                                       ">=", ">=");
+
+                         TYPE AB IS ARRAY (BOOLEAN RANGE <> ) 
+                              OF BOOLEAN;
+                         AB1 : AB (BOOLEAN) := (B1, B2);
+                         AB2 : AB (BOOLEAN) := (B2, B1);
+                         T : AB (B1 .. B2) := (B1 .. B2 => TRUE);
+                         F : AB (B1 .. B2) := (B1 .. B2 => FALSE);
+                         VB1 : AB (B1 .. B1) := (B1 => B2);
+                         VB2 : AB (B2 .. B2) := (B2 => B1);
+
+                         PACKAGE P9 IS 
+                              NEW GP1 (AB, AB1, NOT AB1, 
+                                       """NOT"" - 2", "NOT");
+                         PACKAGE P10 IS 
+                              NEW GP1 (AB, T, F, 
+                                       """NOT"" - 3", "NOT");
+                         PACKAGE P11 IS 
+                              NEW GP1 (AB, VB2, (B2 => NOT B1), 
+                                       """NOT"" - 4", "NOT");
+                         PACKAGE P12 IS 
+                              NEW GP2 (AB, AB1 AND AB2, AB1, AB2, 
+                                       "AND", "AND");
+                    BEGIN
+                         NULL;
+                    END;
+               END LOOP;
+          END LOOP;
+     END;
+
+     DECLARE -- CHECKS WITH ADDING AND MULTIPLYING OPERATORS, "**", 
+             -- AND "ABS".
+          
+          PACKAGE P1 IS NEW GP1 (INTEGER, -4, -4, """+"" - 1", "+");
+
+          PACKAGE P2 IS NEW GP1 (FLOAT, 4.0, 4.0, """+"" - 2", "+");
+
+          PACKAGE P3 IS NEW GP1 (DURATION, -4.0, -4.0, """+"" - 3",
+                                 "+");
+          PACKAGE P4 IS NEW GP1 (INTEGER, -4, 4, """-"" - 1", "-");
+
+          PACKAGE P5 IS NEW GP1 (FLOAT, 0.0, 0.0, """-"" - 2", "-");
+
+          PACKAGE P6 IS NEW GP1 (DURATION, 1.0, -1.0, """-"" - 3", 
+                                 "-");
+          PACKAGE P7 IS NEW GP2 (INTEGER, 6, 1, 5, """+"" - 1", "+");
+
+          PACKAGE P8 IS NEW GP2 (FLOAT, 6.0, 1.0, 5.0, """+"" - 2", 
+                                 "+");
+          PACKAGE P9 IS NEW GP2 (DURATION, 6.0, 1.0, 5.0, """+"" - 3",
+                                 "+");
+          PACKAGE P10 IS NEW GP2 (INTEGER, 1, 6, 5, """-"" - 1",
+                                  "-" );
+          PACKAGE P11 IS NEW GP2 (DURATION, 11.0, 6.0,-5.0, 
+                                  """-"" - 2", "-");
+          PACKAGE P12 IS NEW GP2 (FLOAT, 1.0, 6.0, 5.0, """-"" - 3",
+                                  "-");
+
+          SUBTYPE SUBINT IS INTEGER RANGE 0 .. 2;
+          TYPE STR IS ARRAY (SUBINT RANGE <>) OF CHARACTER;
+          VSTR : STR (0 .. 1) := "AB";
+
+          PACKAGE P13 IS NEW GP2 (STR, VSTR (0 .. 0) & 
+                                      VSTR (1 .. 1),
+                                      VSTR (0 .. 0),  
+                                      VSTR (1 .. 1), """&"" - 1", "&");
+
+          PACKAGE P14 IS NEW GP2 (STR, VSTR (1 .. 1) & 
+                                      VSTR (0 .. 0),
+                                      VSTR (1 .. 1),  
+                                      VSTR (0 .. 0), """&"" - 2", "&");
+                                        
+          PACKAGE P15 IS NEW GP2 (INTEGER, 0, -1, 0, """*"" - 1", "*");
+
+          PACKAGE P16 IS NEW GP2 (FLOAT, 6.0, 3.0, 2.0, """*"" - 2",
+                                  "*");
+          PACKAGE P17 IS NEW GP2 (INTEGER, 0, 0, 6, """/"" - 1", "/");
+
+          PACKAGE P18 IS NEW GP2 (FLOAT, 3.0, 6.0, 2.0, """/"" - 2",
+                                  "/");
+          PACKAGE P19 IS NEW GP2 (INTEGER, -1, -11, 5, "REM", "REM");
+
+          PACKAGE P20 IS NEW GP2 (INTEGER, 4, -11, 5, "MOD", "MOD");
+          
+          PACKAGE P21 IS NEW GP1 (INTEGER, 5, 5, """ABS"" - 1", "ABS");
+
+          PACKAGE P22 IS NEW GP1 (FLOAT, -5.0, 5.0, """ABS"" - 2", 
+                                  "ABS");
+
+          PACKAGE P23 IS NEW GP1 (DURATION, 0.0, 0.0, """ABS"" - 3", 
+                                  "ABS");
+
+          PACKAGE P24 IS NEW GP2 (INTEGER, 9, 3, 2, """**"" - 1", 
+                                  "**");
+
+          PACKAGE P25 IS NEW GP2 (INTEGER, 1, 5, 0, """**"" - 2",
+                                  "**");
+
+     BEGIN
+          NULL;
+     END;
+
+     DECLARE -- CHECKS WITH ATTRIBUTES.
+          
+          TYPE WEEKDAY IS (MON, TUES, WED, THUR, FRI);
+
+          PACKAGE P1 IS NEW GP1 (WEEKDAY, TUES, WED, "WEEKDAY'SUCC", 
+                                 WEEKDAY'SUCC);
+
+          PACKAGE P2 IS NEW GP1 (WEEKDAY, TUES, MON, "WEEKDAY'PRED", 
+                                 WEEKDAY'PRED);
+          
+          PACKAGE P3 IS NEW GP3 (WEEKDAY, STRING, THUR, "THUR", 
+                                 "WEEKDAY'IMAGE", WEEKDAY'IMAGE);
+
+          PACKAGE P4 IS NEW GP3 (STRING, WEEKDAY, "FRI", FRI, 
+                                 "WEEKDAY'VALUE", WEEKDAY'VALUE);
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC3601A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3601c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3601c.ada
new file mode 100644
index 000000000..a0119776d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3601c.ada
@@ -0,0 +1,149 @@
+-- CC3601C.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 "/=" MAY BE PASSED AS A GENERIC ACTUAL FUNCTION
+-- PARAMETER.
+
+-- DAT 10/6/81
+-- SPS 10/27/82
+-- JRK 2/9/83
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3601C IS
+BEGIN
+     TEST ("CC3601C", "/= AS GENERIC ACTUAL PARAMETER");
+
+     DECLARE
+          PACKAGE PK IS
+               TYPE LP IS LIMITED PRIVATE;
+               FUNCTION "=" (X, Y : LP) RETURN BOOLEAN;-- RETURNS FALSE.
+               TYPE INT IS NEW INTEGER;
+          PRIVATE
+               TASK TYPE LP;
+          END PK;
+          USE PK;
+
+          V1, V2 : LP;
+
+          TYPE REC IS RECORD
+               C : LP;
+          END RECORD;
+
+          R1, R2 : REC;
+
+          TYPE INT IS NEW INTEGER;
+
+          B1 : BOOLEAN := TRUE;
+          B2 : BOOLEAN := TRUE;
+          INTEGER_3 : INTEGER := 3;
+          INTEGER_4 : INTEGER := 4;
+          INT_3     : INT := 3;
+          INT_4     : INT := 4;
+          INT_5     : INT := 5;
+          PK_INT_M1 : PK.INT := -1;
+          PK_INT_M2 : PK.INT := -2;
+          PK_INT_1  : PK.INT := 1;
+          PK_INT_2  : PK.INT := 2;
+          PK_INT_3  : PK.INT := 3;
+
+          FUNCTION "=" (Q, R : LP) RETURN BOOLEAN;-- RETURNS TRUE.
+
+          GENERIC
+               TYPE T IS LIMITED PRIVATE;
+               V1, V2 : IN OUT T;
+               WITH FUNCTION NE (ZA : IN T; ZB : T) RETURN BOOLEAN;
+               VALUE : IN BOOLEAN; -- SHOULD BE VALUE OF NE(V1,V2).
+               STR : STRING;
+          PACKAGE GP IS END GP;
+
+          FUNCTION "=" (Q, R : IN REC) RETURN BOOLEAN;
+
+          FUNCTION NE (Q : INT; R : IN INT) RETURN BOOLEAN
+               RENAMES "/=";
+
+          FUNCTION NE (Q : PK.INT; R : IN PK.INT) RETURN BOOLEAN
+               RENAMES "/=";
+
+          PACKAGE BODY GP IS
+          BEGIN
+               IF IDENT_BOOL(VALUE) /= NE (V1, V2) THEN
+                    FAILED ("WRONG /= ACTUAL GENERIC PARAMETER "
+                    & STR);
+               END IF;
+          END GP;
+
+          FUNCTION "=" (Q, R : IN REC) RETURN BOOLEAN IS
+          BEGIN
+               RETURN FALSE;
+          END "=";
+
+          FUNCTION "=" (Q, R : LP) RETURN BOOLEAN IS
+          BEGIN
+               RETURN TRUE;
+          END "=";
+
+          PACKAGE BODY PK IS
+               FUNCTION "=" (X, Y : LP) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN R1 = R1;     -- FALSE.
+               END "=";
+               TASK BODY LP IS BEGIN NULL; END;
+          END PK;
+
+          PACKAGE P1 IS NEW GP (LP, V1, V2, "/=", FALSE, "1");
+
+          FUNCTION "NOT" (X : BOOLEAN) RETURN BOOLEAN IS
+          BEGIN RETURN X; END "NOT"; -- ENSURES USE OF PREDEFINED "NOT"
+
+          PACKAGE P2 IS NEW GP (LP,      V1, V2, "/=", FALSE, "2");
+          PACKAGE P3 IS NEW GP (LP, V1, V2, PK."/=", TRUE, "3");
+          PACKAGE P4 IS NEW GP (PK.LP, V1, V2, "/=", FALSE, "4");
+          PACKAGE P5 IS NEW GP (PK.LP, V1, V2, PK."/=", TRUE, "5");
+          PACKAGE P6 IS NEW GP (REC, R1, R2, "/=", TRUE, "6");
+          PACKAGE P7 IS NEW GP (INTEGER, INTEGER_3, INTEGER_4, "/=",
+                                TRUE, "7");
+          PACKAGE P8 IS NEW GP (BOOLEAN, B1, B2, "/=", FALSE,"8");
+          PACKAGE P9 IS NEW GP (INT, INT_3, INT_5, "/=", TRUE, "9");
+          PACKAGE P10 IS NEW GP (INT, INT_3, INT_3, "/=", FALSE, "10");
+          PACKAGE P11 IS NEW GP (INT, INT_3, INT_4, NE, TRUE, "11");
+          PACKAGE P12 IS NEW GP (INT, INT_3, INT_3, NE, FALSE, "12");
+          PACKAGE P13 IS NEW GP (PK.INT, PK_INT_3, PK_INT_3, NE,
+                                 FALSE, "13");
+          PACKAGE P14 IS NEW GP (PK.INT, PK_INT_M1, PK_INT_M2, NE, 
+                                 TRUE,  "14");
+          PACKAGE P15 IS NEW GP (PK.INT, PK_INT_1, PK_INT_1, "/=",
+                                 FALSE, "15");
+          PACKAGE P16 IS NEW GP (PK.INT, PK_INT_1, PK_INT_2, "/=",
+                                 TRUE,  "16");
+          PACKAGE P17 IS NEW GP (PK.INT, PK_INT_1, PK_INT_1, PK."/=",
+                                 FALSE, "17");
+          PACKAGE P18 IS NEW GP (PK.INT, PK_INT_1, PK_INT_2, PK."/=",
+                                 TRUE,  "18");
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC3601C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3602a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3602a.ada
new file mode 100644
index 000000000..005995e99
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3602a.ada
@@ -0,0 +1,146 @@
+-- CC3602A.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 ENTRIES MAY BE PASSED AS GENERIC SUBPROGRAM
+--     PARAMETERS.
+
+-- HISTORY:
+--     DAT 9/25/81     CREATED ORIGINAL TEST.
+--     LDC 10/6/88     REVISED; CHECKED THAT DEFAULT NAME CAN BE
+--                     IDENTIFIED WITH ENTRY.
+
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3602A IS
+     COUNTER : INTEGER := 0;
+BEGIN
+     TEST ("CC3602A", "ENTRIES AS GENERIC SUBPROGRAM PARAMETERS");
+
+     DECLARE
+          TASK TSK IS
+               ENTRY ENT;
+          END TSK;
+
+          GENERIC
+               WITH PROCEDURE P;
+          PROCEDURE GP;
+
+          GENERIC
+               WITH PROCEDURE P;
+          PACKAGE PK IS END PK;
+
+
+          PROCEDURE E1 RENAMES TSK.ENT;
+
+          GENERIC
+               WITH PROCEDURE P IS TSK.ENT;
+          PROCEDURE GP_DEF1;
+
+          GENERIC
+               WITH PROCEDURE P IS E1;
+          PROCEDURE GP_DEF2;
+
+          GENERIC
+               WITH PROCEDURE P IS TSK.ENT;
+          PACKAGE PK_DEF1 IS END PK_DEF1;
+
+          GENERIC
+               WITH PROCEDURE P IS E1;
+          PACKAGE PK_DEF2 IS END PK_DEF2;
+
+          PROCEDURE GP IS
+          BEGIN
+               P;
+          END GP;
+
+          PACKAGE BODY PK IS
+          BEGIN
+               P;
+          END PK;
+
+
+          PROCEDURE GP_DEF1 IS
+          BEGIN
+               P;
+          END GP_DEF1;
+
+          PROCEDURE GP_DEF2 IS
+          BEGIN
+               P;
+          END GP_DEF2;
+
+          PACKAGE BODY PK_DEF1 IS
+          BEGIN
+               P;
+          END PK_DEF1;
+
+          PACKAGE BODY PK_DEF2 IS
+          BEGIN
+               P;
+          END PK_DEF2;
+
+          TASK BODY TSK IS
+          BEGIN
+               LOOP
+                    SELECT
+                         ACCEPT ENT DO
+                              COUNTER := COUNTER + 1;
+                         END ENT;
+                    OR
+                         TERMINATE;
+                    END SELECT;
+               END LOOP;
+          END TSK;
+
+     BEGIN
+          DECLARE
+               PROCEDURE P1 IS NEW GP (TSK.ENT);
+               PROCEDURE E RENAMES TSK.ENT;
+               PROCEDURE P2 IS NEW GP (E);
+               PACKAGE PK1 IS NEW PK (TSK.ENT);
+               PACKAGE PK2 IS NEW PK (E);
+
+               PROCEDURE P3 IS NEW GP_DEF1;
+               PROCEDURE P4 IS NEW GP_DEF2;
+               PACKAGE PK3 IS NEW PK_DEF1;
+               PACKAGE PK4 IS NEW PK_DEF2;
+          BEGIN
+               P1;
+               P2;
+               TSK.ENT;
+               E;
+               P3;
+               P4;
+          END;
+          TSK.ENT;
+     END;
+
+     IF COUNTER /= 11 THEN
+          FAILED ("INCORRECT CALL OF ENTRY AS GENERIC PARAMETER");
+     END IF;
+
+     RESULT;
+END CC3602A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3603a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3603a.ada
new file mode 100644
index 000000000..45e65b25f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3603a.ada
@@ -0,0 +1,97 @@
+-- CC3603A.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 ENUMERATION LITERALS (BOTH IDENTIFIERS AND CHARACTER
+--     LITERALS) MAY BE PASSED AS ACTUALS CORRESPONDING TO GENERIC
+--     FORMAL SUBPROGRAMS.
+
+-- HISTORY:
+--     RJW 06/11/86  CREATED ORIGINAL TEST.
+--     VCL 08/18/87  CHANGED THE SECOND ACTUAL GENERIC PARAMETER IN THE
+--                   INSTANTIATION OF PROCEDURE NP3 TO
+--                   'IDENT_CHAR('X')'.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3603A IS
+
+BEGIN
+     TEST ("CC3603A", "CHECK THAT ENUMERATION LITERALS (BOTH " &
+                      "IDENTIFIERS AND CHARACTER LITERALS) MAY " &
+                      "BE PASSED AS ACTUALS CORRESPONDING TO " &
+                      "GENERIC FORMAL SUBPROGRAMS" );
+
+     DECLARE
+
+          TYPE ENUM1 IS ('A', 'B');
+          TYPE ENUM2 IS (C, D);
+
+          GENERIC
+               TYPE E IS (<>);
+               E1 : E;
+               WITH FUNCTION F RETURN E;
+          PROCEDURE P;
+
+          PROCEDURE P IS
+          BEGIN
+               IF F /= E1 THEN
+                    FAILED ( "WRONG VALUE FOR " & E'IMAGE (E1) &
+                             " AS ACTUAL PARAMETER" );
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED INSIDE OF P WITH " &
+                              E'IMAGE (E1) &
+                             " AS ACTUAL PARAMETER" );
+          END P;
+
+          PROCEDURE NP1 IS NEW P (ENUM1, 'A', 'A');
+          PROCEDURE NP2 IS NEW P (ENUM2, D, D);
+          PROCEDURE NP3 IS NEW P (CHARACTER, IDENT_CHAR('X'), 'X');
+     BEGIN
+          BEGIN
+               NP1;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED WHEN NP1 CALLED" );
+          END;
+
+          BEGIN
+               NP2;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED WHEN NP2 CALLED" );
+          END;
+
+          BEGIN
+               NP3;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ( "EXCEPTION RAISED WHEN NP3 CALLED" );
+          END;
+     END;
+     RESULT;
+
+END CC3603A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada
new file mode 100644
index 000000000..b9fb50b1b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada
@@ -0,0 +1,381 @@
+-- CC3605A.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 SOME DIFFERENCES BETWEEN THE FORMAL AND THE
+--     ACTUAL SUBPROGRAMS DO NOT INVALIDATE A MATCH.
+--          1)  CHECK DIFFERENT PARAMETER NAMES.
+--          2)  CHECK DIFFERENT PARAMETER CONSTRAINTS.
+--          3)  CHECK ONE PARAMETER CONSTRAINED AND THE OTHER
+--               UNCONSTRAINED (WITH ARRAY, RECORD, ACCESS, AND
+--               PRIVATE TYPES).
+--          4)  CHECK PRESENCE OR ABSENCE OF AN EXPLICIT "IN" MODE
+--               INDICATOR.
+--          5)  DIFFERENT TYPE MARKS USED TO SPECIFY THE TYPE OF
+--               PARAMETERS.
+
+-- HISTORY:
+--     LDC 10/04/88  CREATED ORIGINAL TEST.
+
+PACKAGE CC3605A_PACK IS
+
+     SUBTYPE INT IS INTEGER RANGE -100 .. 100;
+
+     TYPE PRI_TYPE (SIZE : INT) IS PRIVATE;
+
+     SUBTYPE PRI_CONST IS PRI_TYPE (2);
+
+PRIVATE
+
+     TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+
+     TYPE PRI_TYPE (SIZE : INT) IS
+          RECORD
+               SUB_A : ARR_TYPE (1 .. SIZE);
+          END RECORD;
+
+END CC3605A_PACK;
+
+
+WITH REPORT;
+USE  REPORT;
+WITH CC3605A_PACK;
+USE  CC3605A_PACK;
+
+PROCEDURE CC3605A IS
+
+     SUBTYPE ZERO_TO_TEN IS INTEGER
+          RANGE IDENT_INT (0) .. IDENT_INT (10);
+
+     SUBTYPE ONE_TO_FIVE IS INTEGER
+          RANGE IDENT_INT (1) .. IDENT_INT (5);
+
+     SUBPRG_ACT : BOOLEAN := FALSE;
+BEGIN
+     TEST
+          ("CC3605A", "CHECK THAT SOME DIFFERENCES BETWEEN THE " &
+                      "FORMAL AND THE ACTUAL PARAMETERS DO NOT " &
+                      "INVALIDATE A MATCH");
+
+----------------------------------------------------------------------
+-- DIFFERENT PARAMETER NAMES
+----------------------------------------------------------------------
+
+     DECLARE
+
+          PROCEDURE ACT_PROC (DIFF_NAME_PARM : ONE_TO_FIVE) IS
+          BEGIN
+               SUBPRG_ACT := TRUE;
+          END ACT_PROC;
+
+          GENERIC
+
+               WITH PROCEDURE PASSED_PROC (PARM : ONE_TO_FIVE);
+
+          PROCEDURE GEN_PROC;
+
+          PROCEDURE GEN_PROC IS
+          BEGIN
+               PASSED_PROC (ONE_TO_FIVE'FIRST);
+          END GEN_PROC;
+
+          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+     BEGIN
+          INST_PROC;
+          IF NOT SUBPRG_ACT THEN
+               FAILED
+                    ("DIFFERENT PARAMETER NAMES MADE MATCH INVALID");
+          END IF;
+     END;
+
+----------------------------------------------------------------------
+-- DIFFERENT PARAMETER CONSTRAINTS
+----------------------------------------------------------------------
+
+     DECLARE
+
+          PROCEDURE ACT_PROC (PARM : ONE_TO_FIVE) IS
+          BEGIN
+               SUBPRG_ACT := TRUE;
+          END ACT_PROC;
+
+          GENERIC
+
+               WITH PROCEDURE PASSED_PROC (PARM : ZERO_TO_TEN);
+
+          PROCEDURE GEN_PROC;
+
+          PROCEDURE GEN_PROC IS
+          BEGIN
+               PASSED_PROC (ONE_TO_FIVE'FIRST);
+          END GEN_PROC;
+
+          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+     BEGIN
+          SUBPRG_ACT := FALSE;
+          INST_PROC;
+          IF NOT SUBPRG_ACT THEN
+               FAILED
+                    ("DIFFERENT PARAMETER CONSTRAINTS MADE MATCH " &
+                     "INVALID");
+          END IF;
+     END;
+
+----------------------------------------------------------------------
+-- ONE PARAMETER CONSTRAINED (ARRAY)
+----------------------------------------------------------------------
+
+     DECLARE
+
+          TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+
+          SUBTYPE ARR_CONST IS ARR_TYPE (ONE_TO_FIVE'FIRST ..
+               ONE_TO_FIVE'LAST);
+
+          PASSED_PARM : ARR_CONST := (OTHERS => TRUE);
+
+          PROCEDURE ACT_PROC (PARM : ARR_CONST) IS
+          BEGIN
+               SUBPRG_ACT := TRUE;
+          END ACT_PROC;
+
+          GENERIC
+
+               WITH PROCEDURE PASSED_PROC (PARM : ARR_TYPE);
+
+          PROCEDURE GEN_PROC;
+
+          PROCEDURE GEN_PROC IS
+          BEGIN
+               PASSED_PROC (PASSED_PARM);
+          END GEN_PROC;
+
+          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+     BEGIN
+          SUBPRG_ACT := FALSE;
+          INST_PROC;
+          IF NOT SUBPRG_ACT THEN
+               FAILED
+                    ("ONE ARRAY PARAMETER CONSTRAINED MADE MATCH " &
+                     "INVALID");
+          END IF;
+     END;
+
+----------------------------------------------------------------------
+-- ONE PARAMETER CONSTRAINED (RECORDS)
+----------------------------------------------------------------------
+
+     DECLARE
+
+          TYPE REC_TYPE (BOL : BOOLEAN) IS
+               RECORD
+                    SUB_A : INTEGER;
+                    CASE BOL IS
+                         WHEN TRUE =>
+                              DSCR_A : INTEGER;
+
+                         WHEN FALSE =>
+                              DSCR_B : BOOLEAN;
+
+                    END CASE;
+               END RECORD;
+
+          SUBTYPE REC_CONST IS REC_TYPE (TRUE);
+
+          PASSED_PARM : REC_CONST := (TRUE, 1, 2);
+
+          PROCEDURE ACT_PROC (PARM : REC_CONST) IS
+          BEGIN
+               SUBPRG_ACT := TRUE;
+          END ACT_PROC;
+
+          GENERIC
+
+               WITH PROCEDURE PASSED_PROC (PARM : REC_TYPE);
+
+          PROCEDURE GEN_PROC;
+
+          PROCEDURE GEN_PROC IS
+          BEGIN
+               PASSED_PROC (PASSED_PARM);
+          END GEN_PROC;
+
+          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+     BEGIN
+          SUBPRG_ACT := FALSE;
+          INST_PROC;
+          IF NOT SUBPRG_ACT THEN
+               FAILED
+                    ("ONE RECORD PARAMETER CONSTRAINED MADE MATCH " &
+                     "INVALID");
+          END IF;
+     END;
+
+----------------------------------------------------------------------
+-- ONE PARAMETER CONSTRAINED (ACCESS)
+----------------------------------------------------------------------
+
+     DECLARE
+
+          TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
+
+          SUBTYPE ARR_CONST     IS ARR_TYPE (ONE_TO_FIVE'FIRST ..
+               ONE_TO_FIVE'LAST);
+
+          TYPE ARR_ACC_TYPE IS ACCESS ARR_TYPE;
+
+          SUBTYPE ARR_ACC_CONST IS ARR_ACC_TYPE (1 .. 3);
+
+          PASSED_PARM : ARR_ACC_TYPE := NULL;
+
+          PROCEDURE ACT_PROC (PARM : ARR_ACC_CONST) IS
+          BEGIN
+               SUBPRG_ACT := TRUE;
+          END ACT_PROC;
+
+          GENERIC
+
+               WITH PROCEDURE PASSED_PROC (PARM : ARR_ACC_TYPE);
+
+          PROCEDURE GEN_PROC;
+
+          PROCEDURE GEN_PROC IS
+          BEGIN
+               PASSED_PROC (PASSED_PARM);
+          END GEN_PROC;
+
+          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+     BEGIN
+          SUBPRG_ACT := FALSE;
+          INST_PROC;
+          IF NOT SUBPRG_ACT THEN
+               FAILED
+                    ("ONE ACCESS PARAMETER CONSTRAINED MADE MATCH " &
+                     "INVALID");
+          END IF;
+     END;
+
+----------------------------------------------------------------------
+-- ONE PARAMETER CONSTRAINED (PRIVATE)
+----------------------------------------------------------------------
+
+     DECLARE
+          PASSED_PARM : PRI_CONST;
+
+          PROCEDURE ACT_PROC (PARM : PRI_CONST) IS
+          BEGIN
+               SUBPRG_ACT := TRUE;
+          END ACT_PROC;
+
+          GENERIC
+
+               WITH PROCEDURE PASSED_PROC (PARM : PRI_TYPE);
+
+          PROCEDURE GEN_PROC;
+
+          PROCEDURE GEN_PROC IS
+          BEGIN
+               PASSED_PROC (PASSED_PARM);
+          END GEN_PROC;
+
+          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+     BEGIN
+          SUBPRG_ACT := FALSE;
+          INST_PROC;
+          IF NOT SUBPRG_ACT THEN
+               FAILED
+                    ("ONE PRIVATE PARAMETER CONSTRAINED MADE MATCH " &
+                     "INVALID");
+          END IF;
+     END;
+
+----------------------------------------------------------------------
+-- PRESENCE (OR ABSENCE) OF AN EXPLICIT "IN" MODE
+----------------------------------------------------------------------
+
+     DECLARE
+
+          PROCEDURE ACT_PROC (PARM : INTEGER) IS
+          BEGIN
+               SUBPRG_ACT := TRUE;
+          END ACT_PROC;
+
+          GENERIC
+
+               WITH PROCEDURE PASSED_PROC (PARM : IN INTEGER);
+
+          PROCEDURE GEN_PROC;
+
+          PROCEDURE GEN_PROC IS
+          BEGIN
+               PASSED_PROC (1);
+          END GEN_PROC;
+
+          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+     BEGIN
+          SUBPRG_ACT := FALSE;
+          INST_PROC;
+          IF NOT SUBPRG_ACT THEN
+               FAILED
+                     ("PRESENCE OF AN EXPLICIT 'IN' MODE MADE MATCH " &
+                     "INVALID");
+          END IF;
+     END;
+
+----------------------------------------------------------------------
+-- DIFFERENT TYPE MARKS
+----------------------------------------------------------------------
+
+     DECLARE
+
+          SUBTYPE MARK_1_TYPE IS INTEGER;
+
+          SUBTYPE MARK_2_TYPE IS INTEGER;
+
+          PROCEDURE ACT_PROC (PARM1 : IN MARK_1_TYPE) IS
+          BEGIN
+               SUBPRG_ACT := TRUE;
+          END ACT_PROC;
+
+          GENERIC
+
+               WITH PROCEDURE PASSED_PROC (PARM2 : MARK_2_TYPE);
+
+          PROCEDURE GEN_PROC;
+
+          PROCEDURE GEN_PROC IS
+          BEGIN
+               PASSED_PROC (1);
+          END GEN_PROC;
+
+          PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
+     BEGIN
+          SUBPRG_ACT := FALSE;
+          INST_PROC;
+          IF NOT SUBPRG_ACT THEN
+               FAILED ("DIFFERENT TYPE MARKS MADE MATCH INVALID");
+          END IF;
+     END;
+     RESULT;
+END CC3605A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3606a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3606a.ada
new file mode 100644
index 000000000..4d63b7143
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3606a.ada
@@ -0,0 +1,134 @@
+-- CC3606A.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 DEFAULT EXPRESSIONS OF A FORMAL SUBPROGRAM'S
+--     FORMAL PARAMETERS ARE USED WHEN THE FORMAL SUBPROGRAM IS
+--     CALLED IN THE INSTANTIATED UNIT (RATHER THAN ANY DEFAULT
+--     ASSOCIATED WITH ACTUAL SUBPROGRAM'S PARAMETERS).
+
+-- HISTORY:
+--     BCB 09/29/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3606A IS
+
+     X : BOOLEAN;
+     Y : BOOLEAN;
+
+     FUNCTION FUNC (A : INTEGER := 35) RETURN BOOLEAN IS
+     BEGIN
+          RETURN (A = 7);
+     END FUNC;
+
+     PROCEDURE PROC (B : INTEGER := 35) IS
+     BEGIN
+          IF B /= 7 THEN
+               FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
+                       "PROCEDURE NOT USED - 1");
+          END IF;
+     END PROC;
+
+     FUNCTION FUNC1 (C : INTEGER := 35) RETURN BOOLEAN IS
+     BEGIN
+          RETURN (C = 7);
+     END FUNC1;
+
+     PROCEDURE PROC3 (D : INTEGER := 35) IS
+     BEGIN
+          IF D /= 7 THEN
+               FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
+                       "PROCEDURE NOT USED - 2");
+          END IF;
+     END PROC3;
+
+     GENERIC
+          WITH FUNCTION FUNC (A : INTEGER := 7) RETURN BOOLEAN;
+     FUNCTION GENFUNC RETURN BOOLEAN;
+
+     FUNCTION GENFUNC RETURN BOOLEAN IS
+     BEGIN
+          IF NOT FUNC THEN
+               FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
+                       "FUNCTION NOT USED - 1");
+          END IF;
+          RETURN TRUE;
+     END GENFUNC;
+
+     GENERIC
+          WITH PROCEDURE PROC (B : INTEGER := 7);
+     PACKAGE PKG IS
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          PROC;
+     END PKG;
+
+     GENERIC
+          WITH FUNCTION FUNC1 (C : INTEGER := 7) RETURN BOOLEAN;
+     PROCEDURE PROC2;
+
+     PROCEDURE PROC2 IS
+     BEGIN
+          IF NOT FUNC1 THEN
+               FAILED ("DEFAULT EXPRESSION OF FORMAL PARAMETER " &
+                       "FUNCTION NOT USED - 2");
+          END IF;
+     END PROC2;
+
+     GENERIC
+          WITH PROCEDURE PROC3 (D : INTEGER := 7) IS <>;
+     FUNCTION GENFUNC1 RETURN BOOLEAN;
+
+     FUNCTION GENFUNC1 RETURN BOOLEAN IS
+     BEGIN
+          PROC3;
+          RETURN TRUE;
+     END GENFUNC1;
+
+     FUNCTION NEWFUNC IS NEW GENFUNC(FUNC);
+
+     PACKAGE PACK IS NEW PKG(PROC);
+
+     PROCEDURE PROC4 IS NEW PROC2(FUNC1);
+
+     FUNCTION NEWFUNC1 IS NEW GENFUNC1;
+
+BEGIN
+
+     TEST ("CC3606A", "CHECK THAT THE DEFAULT EXPRESSIONS OF A " &
+                      "FORMAL SUBPROGRAM'S FORMAL PARAMETERS ARE " &
+                      "USED WHEN THE FORMAL SUBPROGRAM IS CALLED IN " &
+                      "THE INSTANTIATED UNIT (RATHER THAN ANY " &
+                      "DEFAULT ASSOCIATED WITH ACTUAL SUBPROGRAM'S " &
+                      "PARAMETERS)");
+
+     X := NEWFUNC;
+     Y := NEWFUNC1;
+     PROC4;
+
+     RESULT;
+END CC3606A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3606b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3606b.ada
new file mode 100644
index 000000000..79dc8a7ba
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3606b.ada
@@ -0,0 +1,134 @@
+-- CC3606B.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 ANY CONSTRAINTS SPECIFIED FOR THE ACTUAL
+--     SUBPROGRAM'S PARAMETERS ARE USED IN PLACE OF THOSE
+--     ASSOCIATED WITH THE FORMAL SUBPROGRAM'S PARAMETERS
+--     (INCLUDING PARAMETERS SPECIFIED WITH A FORMAL GENERIC TYPE).
+
+-- HISTORY:
+--     LDC  06/30/88 CREATED ORIGINAL TEST.
+--     PWN  05/31/96 Corrected spelling problems.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC3606B IS
+
+     SUBTYPE ONE_TO_TEN IS
+          INTEGER RANGE IDENT_INT (1) .. IDENT_INT (10);
+     SUBTYPE ONE_TO_FIVE IS
+          INTEGER RANGE IDENT_INT (1) .. IDENT_INT (5);
+
+BEGIN
+     TEST ( "CC3606B", "CHECK THAT ANY CONSTRAINTS SPECIFIED FOR " &
+                       "THE ACTUAL SUBPROGRAM'S PARAMETERS ARE USED " &
+                       "IN PLACE OF THOSE ASSOCIATED WITH THE " &
+                       "FORMAL SUBPROGRAM'S PARAMETERS (INCLUDING " &
+                       "PARAMETERS SPECIFIED WITH A FORMAL GENERIC " &
+                       "TYPE)");
+     DECLARE
+          GENERIC
+               BRIAN : IN OUT INTEGER;
+               WITH PROCEDURE PASSED_PROC(LYNN :IN OUT ONE_TO_TEN);
+          PACKAGE GEN IS
+          END GEN;
+
+          DOUG : INTEGER := 10;
+
+          PACKAGE BODY GEN IS
+          BEGIN
+               PASSED_PROC(BRIAN);
+               FAILED("WRONG CONSTRAINTS FOR ACTUAL PARAMETER IN GEN");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("OTHER EXCEPTION WAS RAISED FOR ACTUAL " &
+                           "PARAMETER");
+          END GEN;
+
+          PROCEDURE PROC(JODIE : IN OUT ONE_TO_FIVE) IS
+               JOHN : ONE_TO_TEN;
+          BEGIN
+               JOHN := IDENT_INT(JODIE);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED("EXCEPTION RAISED INSIDE PROCEDURE");
+          END PROC;
+
+          PACKAGE GEN_PCK IS NEW GEN( DOUG, PROC);
+
+     BEGIN
+          NULL;
+     END;
+     DECLARE
+          TYPE ENUM IS (DAYTON, BEAVERCREEK, CENTERVILLE, ENGLEWOOD,
+                        FAIRBORN, HUBER_HEIGHTS, KETTERING, MIAMISBURG,
+                        OAKWOOD, RIVERSIDE, TROTWOOD, WEST_CARROLLTON,
+                        VANDALIA);
+          SUBTYPE SUB_ENUM IS ENUM RANGE  CENTERVILLE..FAIRBORN;
+
+          GENERIC
+               TYPE T_TYPE IS (<>);
+               BRIAN : T_TYPE;
+               WITH FUNCTION PASSED_FUNC(LYNN : T_TYPE)
+                    RETURN T_TYPE;
+
+          PACKAGE GEN_TWO IS
+          END GEN_TWO;
+
+          DOUG : ENUM := ENUM'FIRST;
+
+          PACKAGE BODY GEN_TWO IS
+
+          DAVE : T_TYPE;
+
+          BEGIN
+               DAVE := PASSED_FUNC(BRIAN);
+               FAILED("WRONG CONSTRAINTS FOR ACTUAL PARAMETER IN " &
+                      "GEN_TWO");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("OTHER EXCEPTION WAS " &
+                           "RAISED FOR ACTUAL " &
+                           "PARAMETER");
+          END GEN_TWO;
+
+          FUNCTION FUNC(JODIE : SUB_ENUM) RETURN SUB_ENUM IS
+          BEGIN
+               RETURN ENUM'VAL(IDENT_INT(ENUM'POS(JODIE)));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED("EXCEPTION RAISED INSIDE PROCEDURE");
+          END FUNC;
+
+          PACKAGE GEN_PCK_TWO IS NEW GEN_TWO( ENUM, DOUG, FUNC);
+
+     BEGIN
+          RESULT;
+     END;
+END CC3606B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3607b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3607b.ada
new file mode 100644
index 000000000..701c739cf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3607b.ada
@@ -0,0 +1,79 @@
+-- CC3607B.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 DEFAULT SUBPROGRAM IS SPECIFIED WITH A BOX, A
+--     SUBPROGRAM DIRECTLY VISIBLE AT THE POINT OF INSTANTIATION
+--     IS USED.
+
+-- HISTORY:
+--     LDC 08/23/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3607B IS
+
+BEGIN
+     TEST ("CC3607B", "CHECK THAT WHEN A DEFAULT SUBPROGRAM IS " &
+                      "SPECIFIED WITH A BOX, A SUBPROGRAM DIRECTLY " &
+                      "VISIBLE AT THE POINT OF INSTANTIATION IS USED");
+     DECLARE
+          PACKAGE PROC_PACK IS
+               PROCEDURE PROC;
+
+               GENERIC
+                    WITH PROCEDURE PROC IS <>;
+               PACKAGE GEN_PACK IS
+                    PROCEDURE DO_PROC;
+               END GEN_PACK;
+          END PROC_PACK;
+          USE PROC_PACK;
+
+          PACKAGE BODY PROC_PACK IS
+               PROCEDURE PROC IS
+               BEGIN
+                    FAILED("WRONG SUBPROGRAM WAS USED");
+               END PROC;
+
+               PACKAGE BODY GEN_PACK IS
+                    PROCEDURE DO_PROC IS
+                    BEGIN
+                         PROC;
+                    END DO_PROC;
+               END GEN_PACK;
+          END PROC_PACK;
+
+          PROCEDURE PROC IS
+          BEGIN
+               COMMENT ("SUBPROGRAM VISIBLE AT INSTANTIATION WAS " &
+                        "USED");
+          END PROC;
+
+          PACKAGE NEW_PACK IS NEW GEN_PACK;
+
+     BEGIN
+          NEW_PACK.DO_PROC;
+     END;
+
+     RESULT;
+END CC3607B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc40001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc40001.a
new file mode 100644
index 000000000..bf42470e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc40001.a
@@ -0,0 +1,403 @@
+-- CC40001.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 adjust is called on the value of a constant object created
+--      by the evaluation of a generic association for a formal object of
+--      mode in.
+--
+--      Check that those values are also subsequently finalized.
+--
+-- TEST DESCRIPTION:
+--      Create a backdrop of a controlled type sufficient to check that the
+--      correct operations get called at appropriate times.  Create a generic
+--      unit that takes a formal parameter of a formal type.  Create instances
+--      of this generic using various "levels" of the controlled type.  Check
+--      the same case for a generic child unit.
+--
+--      The cases tested are where the type of the formal object is:
+--        a visible classwide type  : CC40001_2
+--        a formal private type     : CC40001_3
+--        a formal tagged type      : CC40001_4
+--
+--      To more fully take advantage of the features of the language, and
+--      present a test which is "user oriented" this test utilizes multiple
+--      aspects of the language in combination.  Using Ada.Strings.Unbounded
+--      in combination with Ada.Finalization and Ada.Calendar to build layers
+--      of an object oriented system will likely be very common in actual
+--      practice.  A common paradigm in the language will also be the use of
+--      a parent package defining "basic" tagged types, and child packages
+--      will expand on those types via derivation.  The model used in this
+--      test is a simple type containing a character identity (used in the
+--      identity).  The next level of type add a timestamp.  Further levels
+--      might add location information, etc. however for the purposes of this
+--      test we stop at the second layer, as it is sufficient to test the
+--      stated objective.
+--
+--
+-- CHANGE HISTORY:
+--      06 FEB 96   SAIC   Initial version
+--      30 APR 96   SAIC   Added finalization checks for 2.1
+--      13 FEB 97   PWB.CTA  Moved global objects into bodies, after Initialize
+--                         body is elaborated; counted finalizations correctly.
+--!
+
+----------------------------------------------------------------- CC40001_0
+
+with Ada.Finalization;
+with Ada.Strings.Unbounded;
+package CC40001_0 is
+
+  type States is ( Erroneous, Defaulted, Initialized, Reset, Adjusted );
+
+  type Simple_Object(ID: Character) is
+    new Ada.Finalization.Controlled with
+      record
+        TC_Current_State : States := Defaulted;
+        Name : Ada.Strings.Unbounded.Unbounded_String;
+      end record;
+
+  procedure User_Operation( COB: in out Simple_Object; Name : String );
+  procedure Initialize( COB: in out Simple_Object );
+  procedure Adjust    ( COB: in out Simple_Object );
+  procedure Finalize  ( COB: in out Simple_Object );
+
+  Finalization_Count : Natural;
+
+end CC40001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with TCTouch;
+package body CC40001_0 is
+
+  procedure User_Operation( COB: in out Simple_Object; Name : String ) is
+  begin
+    COB.Name := Ada.Strings.Unbounded.To_Unbounded_String(Name);
+  end User_Operation;
+
+  procedure Initialize( COB: in out Simple_Object ) is
+  begin
+    COB.TC_Current_State := Initialized;
+  end Initialize;
+
+  procedure Adjust    ( COB: in out Simple_Object ) is
+  begin
+    COB.TC_Current_State := Adjusted;
+    TCTouch.Touch('A');  -------------------------------------------------- A
+    TCTouch.Touch(COB.ID); ------------------------------------------------ ID
+    -- note that the calls to touch will not be directly validated, it is
+    -- expected that some number > 0 of calls will be made to this procedure,
+    -- the subtests then clear (Flush) the Touch buffer and perform actions
+    -- where an incorrect implementation might call this procedure.  Such a
+    -- call will fail on the attempt to "Validate" the null string.
+  end Adjust;
+
+  procedure Finalize  ( COB: in out Simple_Object ) is
+  begin
+    COB.TC_Current_State := Erroneous;
+    Finalization_Count := Finalization_Count +1;
+  end Finalize;
+
+  TC_Global_Object : Simple_Object('G');
+
+end CC40001_0;
+
+----------------------------------------------------------------- CC40001_1
+
+with Ada.Calendar;
+package CC40001_0.CC40001_1 is
+
+  type Object_In_Time(ID: Character) is
+    new Simple_Object(ID) with
+      record
+        Birth : Ada.Calendar.Time;
+        Activity : Ada.Calendar.Time;
+      end record;
+
+  procedure User_Operation( COB: in out Object_In_Time;
+                           Name: String );
+
+  procedure Initialize( COB: in out Object_In_Time );
+  procedure Adjust    ( COB: in out Object_In_Time );
+  procedure Finalize  ( COB: in out Object_In_Time );
+
+end CC40001_0.CC40001_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with TCTouch;
+package body CC40001_0.CC40001_1 is
+
+  procedure Initialize( COB: in out Object_In_Time ) is
+  begin
+    COB.TC_Current_State := Initialized;
+    COB.Birth := Ada.Calendar.Clock;
+  end Initialize;
+
+  procedure Adjust    ( COB: in out Object_In_Time ) is
+  begin
+    COB.TC_Current_State := Adjusted;
+    TCTouch.Touch('a');    ------------------------------------------------ a
+    TCTouch.Touch(COB.ID); ------------------------------------------------ ID
+  end Adjust;
+
+  procedure Finalize  ( COB: in out Object_In_Time ) is
+  begin
+    COB.TC_Current_State := Erroneous;
+    Finalization_Count := Finalization_Count +1;
+  end Finalize;
+
+  procedure User_Operation( COB: in out Object_In_Time;
+                           Name: String ) is
+  begin
+    CC40001_0.User_Operation( Simple_Object(COB), Name );
+    COB.Activity := Ada.Calendar.Clock;
+    COB.TC_Current_State := Reset;
+  end User_Operation;
+
+  TC_Time_Object  : Object_In_Time('g');
+
+end CC40001_0.CC40001_1;
+
+----------------------------------------------------------------- CC40001_2
+
+generic
+  TC_Check_Object : in CC40001_0.Simple_Object'Class;
+package CC40001_0.CC40001_2 is
+  procedure TC_Verify_State;
+end CC40001_0.CC40001_2;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body CC40001_0.CC40001_2 is
+
+  procedure TC_Verify_State is
+  begin
+    if TC_Check_Object.TC_Current_State /= Adjusted then
+      Report.Failed( "CC40001_2 : Formal Object not adjusted" );
+    end if;
+  end TC_Verify_State;
+
+end CC40001_0.CC40001_2;
+
+----------------------------------------------------------------- CC40001_3
+
+generic
+  type Formal_Private(<>) is private;
+  TC_Check_Object : in Formal_Private;
+  with function Bad_Status( O: Formal_Private ) return Boolean;
+package CC40001_0.CC40001_3 is
+  procedure TC_Verify_State;
+end CC40001_0.CC40001_3;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body CC40001_0.CC40001_3 is
+
+  procedure TC_Verify_State is
+  begin
+    if Bad_Status( TC_Check_Object ) then
+      Report.Failed( "CC40001_3 : Formal Object not adjusted" );
+    end if;
+  end TC_Verify_State;
+
+end CC40001_0.CC40001_3;
+
+----------------------------------------------------------------- CC40001_4
+
+generic
+  type Formal_Tagged_Private(<>) is tagged private; 
+  TC_Check_Object : in Formal_Tagged_Private;
+  with function Bad_Status( O: Formal_Tagged_Private ) return Boolean;
+package CC40001_0.CC40001_4 is
+  procedure TC_Verify_State;
+end CC40001_0.CC40001_4;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body CC40001_0.CC40001_4 is
+
+  procedure TC_Verify_State is
+  begin
+    if Bad_Status( TC_Check_Object ) then
+      Report.Failed( "CC40001_4 : Formal Object not adjusted" );
+    end if;
+  end TC_Verify_State;
+
+end CC40001_0.CC40001_4;
+
+------------------------------------------------------------------- CC40001
+
+with Report;
+with TCTouch;
+with CC40001_0.CC40001_1;
+with CC40001_0.CC40001_2;
+with CC40001_0.CC40001_3;
+with CC40001_0.CC40001_4;
+procedure CC40001 is
+
+  function Not_Adjusted( CO : CC40001_0.Simple_Object )
+    return Boolean is
+     use type CC40001_0.States;
+  begin
+    return CO.TC_Current_State /= CC40001_0.Adjusted;
+  end Not_Adjusted;
+
+  function Not_Adjusted( CO : CC40001_0.CC40001_1.Object_In_Time )
+    return Boolean is
+     use type CC40001_0.States;
+  begin
+    return CO.TC_Current_State /= CC40001_0.Adjusted;
+  end Not_Adjusted;
+
+   -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Subtest 1
+
+  procedure Subtest_1 is
+    Object_0 : CC40001_0.Simple_Object('T');
+    Object_1 : CC40001_0.CC40001_1.Object_In_Time('t');
+
+    package Subtest_1_1 is
+      new CC40001_0.CC40001_2( Object_0 ); -- classwide generic formal object
+
+    package Subtest_1_2 is
+      new CC40001_0.CC40001_2( Object_1 ); -- classwide generic formal object
+  begin
+    TCTouch.Flush;  -- clear out all "A" and "T" entries, no further calls
+                    -- to Touch should occur before the call to Validate
+
+    -- set the objects TC_Current_State to "Reset"
+    CC40001_0.User_Operation( Object_0, "Subtest 1" );
+    CC40001_0.CC40001_1.User_Operation( Object_1, "Subtest 1" );
+
+    -- check that the objects TC_Current_State is "Adjusted"
+    Subtest_1_1.TC_Verify_State;
+    Subtest_1_2.TC_Verify_State;
+
+    TCTouch.Validate( "", "No actions should occur here, subtest 1" );
+
+  end Subtest_1;
+
+   -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Subtest 2
+
+  procedure Subtest_2 is
+    Object_0 : CC40001_0.Simple_Object('T');
+    Object_1 : CC40001_0.CC40001_1.Object_In_Time('t');
+
+    package Subtest_2_1 is -- generic formal object is discriminated private
+      new CC40001_0.CC40001_3( CC40001_0.Simple_Object,
+                               Object_0,
+                               Not_Adjusted );
+
+    package Subtest_2_2 is -- generic formal object is discriminated private
+      new CC40001_0.CC40001_3( CC40001_0.CC40001_1.Object_In_Time,
+                               Object_1,
+                               Not_Adjusted );
+
+  begin
+    TCTouch.Flush;  -- clear out all "A" and "T" entries
+
+    -- set the objects state to "Reset"
+    CC40001_0.User_Operation( Object_0, "Subtest 2" );
+    CC40001_0.CC40001_1.User_Operation( Object_1, "Subtest 2" );
+
+    Subtest_2_1.TC_Verify_State;
+    Subtest_2_2.TC_Verify_State;
+
+    TCTouch.Validate( "", "No actions should occur here, subtest 2" );
+
+  end Subtest_2;
+
+   -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- Subtest 3
+
+  procedure Subtest_3 is
+    Object_0 : CC40001_0.Simple_Object('T');
+    Object_1 : CC40001_0.CC40001_1.Object_In_Time('t');
+
+    package Subtest_3_1 is -- generic formal object is discriminated tagged
+      new CC40001_0.CC40001_4( CC40001_0.Simple_Object,
+                               Object_0,
+                               Not_Adjusted );
+
+    package Subtest_3_2 is -- generic formal object is discriminated tagged
+      new CC40001_0.CC40001_4( CC40001_0.CC40001_1.Object_In_Time,
+                               Object_1,
+                               Not_Adjusted );
+  begin
+    TCTouch.Flush;  -- clear out all "A" and "T" entries
+
+    -- set the objects state to "Reset"
+    CC40001_0.User_Operation( Object_0, "Subtest 3" );
+    CC40001_0.CC40001_1.User_Operation( Object_1, "Subtest 3" );
+
+    Subtest_3_1.TC_Verify_State;
+    Subtest_3_2.TC_Verify_State;
+
+    TCTouch.Validate( "", "No actions should occur here, subtest 3" );
+
+  end Subtest_3;
+
+begin  -- Main test procedure.
+
+  Report.Test ("CC40001", "Check that adjust and finalize are called on " &
+                          "the constant object created by the " &
+                          "evaluation of a generic association for a " &
+                          "formal object of mode in" );
+
+  -- check that the created constant objects are properly adjusted
+  -- and subsequently finalized
+
+  CC40001_0.Finalization_Count := 0;
+
+  Subtest_1;
+
+  if CC40001_0.Finalization_Count < 4 then
+    Report.Failed("Insufficient Finalizations for Subtest 1");
+  end if;
+
+  CC40001_0.Finalization_Count := 0;
+
+  Subtest_2;
+
+  if CC40001_0.Finalization_Count < 4 then
+    Report.Failed("Insufficient Finalizations for Subtest 2");
+  end if;
+
+  CC40001_0.Finalization_Count := 0;
+
+  Subtest_3;
+
+  if CC40001_0.Finalization_Count < 4 then
+    Report.Failed("Insufficient Finalizations for Subtest 3");
+  end if;
+
+  Report.Result;
+
+end CC40001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc50001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc50001.a
new file mode 100644
index 000000000..32a1afeb3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc50001.a
@@ -0,0 +1,257 @@
+-- CC50001.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, in an instance, each implicit declaration of a predefined
+--      operator of a formal tagged private type declares a view of the
+--      corresponding predefined operator of the actual type (even if the
+--      operator has been overridden for the actual type). Check that the
+--      body executed is determined by the type and tag of the operands.
+--
+-- TEST DESCRIPTION:
+--      The formal tagged private type has an unknown discriminant part, and
+--      is thus indefinite. This allows both definite and indefinite types
+--      to be passed as actuals. For tagged types, definite implies
+--      nondiscriminated, and indefinite implies discriminated (with known
+--      or unknown discriminants).
+--
+--      Only nonlimited tagged types are tested, since equality operators
+--      are not predefined for limited types. 
+--
+--      A tagged type is passed as an actual to a generic formal tagged
+--      private type. The tagged type overrides the predefined equality
+--      operator. A subprogram within the generic calls the equality operator
+--      of the formal type. In an instance, the equality operator denotes
+--      a view of the predefined operator of the actual type, but the
+--      call dispatches to the body of the overriding operator.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      21 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected expected result on
+--                          calls to "=" within the instance. Modified
+--                          commentary.
+--
+--!
+
+package CC50001_0 is
+
+   type Count_Type is tagged record                     -- Nondiscriminated
+      Count : Integer := 0;                             -- tagged type.
+   end record;
+
+   function "="(Left, Right : Count_Type)               -- User-defined
+     return Boolean;                                    -- equality operator.
+
+
+   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);
+
+   type Person_Type (Stat : Status;                     -- Discriminated
+                     NameLen, AddrLen : Str_Len) is     -- tagged 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;
+
+   function "="(Left, Right : Person_Type)              -- User-defined
+     return Boolean;                                    -- equality operator.
+
+
+   -- Testing entities: ------------------------------------------------
+
+   TC_Count_Item     : constant Count_Type  := (Count => 111);
+
+   TC_Person_Item    : constant Person_Type :=
+     (Faculty, 18, 17, "Eccles, John Scott", "Popham House, Lee", "0931");
+
+   ---------------------------------------------------------------------
+
+
+end CC50001_0;
+
+
+     --===================================================================--
+
+
+package body CC50001_0 is
+
+   function "="(Left, Right : Count_Type) return Boolean is
+   begin
+      return False;   -- Return FALSE even if Left = Right.
+   end "=";
+
+
+   function "="(Left, Right : Person_Type) return Boolean is
+   begin
+      return False;   -- Return FALSE even if Left = Right.
+   end "=";
+
+end CC50001_0;
+
+
+     --===================================================================--
+
+
+with CC50001_0;  -- Tagged (actual) type declarations.
+generic        -- Generic stack abstraction.
+
+   type Item (<>) is tagged private;            -- Formal tagged private type.
+
+package CC50001_1 is
+
+   -- Simulate a generic stack abstraction. In a real application, the
+   -- second operand of Push might be of type Stack, and type Stack
+   -- would have at least one component (pointing to the top stack item).
+
+   type Stack is private;
+
+   procedure Push (I : in Item; TC_Check : out Boolean);
+
+   -- ... Other stack operations.
+
+private
+
+   -- ... Stack and ancillary type declarations.
+
+   type Stack is record                       -- Artificial.
+      null;
+   end record;
+
+end CC50001_1;
+
+
+     --===================================================================--
+
+
+package body CC50001_1 is
+
+   -- For the sake of brevity, the implementation of Push is completely
+   -- artificial; the goal is to model a call of the equality operator within
+   -- the generic.
+   --
+   -- A real application might implement Push such that it does not add new
+   -- items to the stack if they are identical to the top item; in that
+   -- case, the equality operator would be called as part of an "if"
+   -- condition.
+
+   procedure Push (I : in Item; TC_Check : out Boolean) is
+   begin
+      TC_Check := not (I = I);              -- Call user-defined "="; should
+                                            -- return FALSE. Negation of
+                                            -- result makes TC_Check TRUE.
+   end Push;
+
+end CC50001_1;
+
+
+     --==================================================================--
+
+
+with CC50001_0;  -- Tagged (actual) type declarations.
+with CC50001_1;  -- Generic stack abstraction.
+
+use  CC50001_0;  -- Overloaded "=" directly visible.
+
+with Report;
+procedure CC50001 is
+
+   package Count_Stacks  is new CC50001_1 (CC50001_0.Count_Type);
+   package Person_Stacks is new CC50001_1 (CC50001_0.Person_Type);
+
+   User_Defined_Op_Called : Boolean;
+
+begin
+   Report.Test ("CC50001", "Check that, in an instance, each implicit "     &
+                "declaration of a primitive subprogram of a formal tagged " &
+                "private type declares a view of the corresponding "        &
+                "predefined operator of the actual type (even if the "      &
+                "operator has been overridden or hidden for the actual type)");
+
+--
+-- Test which "=" is called inside generic:
+--
+
+   User_Defined_Op_Called := False;
+
+   Count_Stacks.Push (CC50001_0.TC_Count_Item,
+                      User_Defined_Op_Called);
+
+
+   if not User_Defined_Op_Called then
+      Report.Failed ("User-defined ""="" not called inside generic for Count");
+   end if;
+
+
+   User_Defined_Op_Called := False;
+
+   Person_Stacks.Push (CC50001_0.TC_Person_Item,
+                       User_Defined_Op_Called);
+
+   if not User_Defined_Op_Called then
+      Report.Failed ("User-defined ""="" not called inside generic " &
+                     "for Person");
+   end if;
+
+
+--
+-- Test which "=" is called outside generic:
+--
+
+   User_Defined_Op_Called := False;
+
+   User_Defined_Op_Called :=
+     not (CC50001_0.TC_Count_Item = CC50001_0.TC_Count_Item);
+
+   if not User_Defined_Op_Called then
+      Report.Failed ("User-defined ""="" not called outside generic "&
+                     "for Count");
+   end if;
+
+
+   User_Defined_Op_Called := False;
+
+   User_Defined_Op_Called :=
+     not (CC50001_0.TC_Person_Item = CC50001_0.TC_Person_Item);
+
+   if not User_Defined_Op_Called then
+      Report.Failed ("User-defined ""="" not called outside generic "&
+                     "for Person");
+   end if;
+
+
+   Report.Result;
+end CC50001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc50a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc50a01.a
new file mode 100644
index 000000000..4d5dfdfd5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc50a01.a
@@ -0,0 +1,313 @@
+-- CC50A01.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 formal parameter of a library-level generic unit may be
+--      a formal tagged private type. Check that a nonlimited tagged type may
+--      be passed as an actual. Check that if the formal type is indefinite,
+--      both indefinite and definite types may be passed as actuals.
+--
+-- TEST DESCRIPTION:
+--      The generic package declares a formal tagged private type (this can
+--      be considered the parent "mixin" class). This type is extended in
+--      the generic to provide support for stacks of items of any nonlimited
+--      tagged type. Stacks are modeled as singly linked lists, with the list
+--      nodes being objects of the extended type.
+--
+--      A generic testing procedure pushes items onto a stack, and pops them
+--      back off, verifying the state of the stack at various points along the
+--      way. The push and pop routines exercise functionality important to
+--      tagged types, such as type conversion toward the root of the derivation
+--      class and extension aggregates.
+--
+--      The formal tagged private type has an unknown discriminant part, and
+--      is thus indefinite. This allows both definite and indefinite types
+--      to be passed as actuals. For tagged types, definite implies
+--      nondiscriminated, and indefinite implies discriminated (with known
+--      or unknown discriminants). 
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         FC50A00.A
+--      -> CC50A01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      21 Nov 95   SAIC    ACVC 2.0.1 fixes: Moved instantiations of
+--                          BC50A01_0 to library level.
+--      11 Aug 96   SAIC    ACVC 2.1: Updated prologue. Added pragma
+--                          Elaborate to context clauses for CC50A01_2 & _3.
+--
+--!
+
+with FC50A00;  -- Tagged (actual) type declarations.
+generic        -- Generic stack abstraction.
+
+   type Item (<>) is tagged private;            -- Formal tagged private type.
+   TC_Default_Value : Item;                     -- Needed in View_Top (see
+                                                -- below).
+package CC50A01_0 is
+
+   type Stack is private;
+
+-- Note that because the actual type corresponding to Item may be
+-- unconstrained, the functions of removing the top item from the stack and
+-- returning the value of the top item of the stack have been separated into
+-- Pop and View_Top, respectively. This is necessary because otherwise the
+-- returned value would have to be an out parameter of Pop, which would
+-- require the user (in the unconstrained case) to create an uninitialized
+-- unconstrained object to serve as the actual, which is illegal.
+
+   procedure Push     (I : in Item; S : in out Stack);
+   procedure Pop      (S : in out Stack);
+   function  View_Top (S : Stack) return Item;
+
+   function Size_Of (S : Stack) return Natural;
+
+private
+
+   type Stack_Item;
+   type Stack_Ptr is access Stack_Item;
+
+   type Stack_Item is new Item with record      -- Extends formal type.
+      Next : Stack_Ptr := null;
+   end record;
+
+   type Stack is record
+      Top  : Stack_Ptr := null;
+      Size : Natural   := 0;
+   end record;
+
+end CC50A01_0;
+
+
+     --==================================================================--
+
+
+package body CC50A01_0 is
+
+   -- Link NewItem in at the top of the stack (the extension aggregate within
+   -- the allocator initializes the inherited portion of NewItem to equal I,
+   -- and NewItem.Next to point to what S.Top points to).
+
+   procedure Push (I : in Item; S : in out Stack) is
+      NewItem : Stack_Ptr;
+   begin
+      NewItem := new Stack_Item'(I with S.Top);     -- Extension aggregate.
+      S.Top   := NewItem;
+      S.Size  := S.Size + 1;
+   end Push;
+
+
+   -- Remove item from top of stack. This procedure only updates the state of
+   -- the stack; it does not return the value of the popped item. Hence, in
+   -- order to accomplish a "true" pop, both View_Top and Pop must be called
+   -- consecutively.
+   --
+   -- If the stack is empty, the Pop is ignored (for simplicity; in a true
+   -- application this might be treated as an error condition).
+
+   procedure Pop (S : in out Stack) is
+   begin
+      if S.Top = null then                          -- Stack is empty.
+         null;
+         -- Raise exception.
+      else
+         S.Top  := S.Top.Next;
+         S.Size := S.Size - 1;
+         -- Deallocate discarded node.
+      end if;
+   end Pop;
+
+
+   -- Return the value of the top item on the stack. This procedure only
+   -- returns the value; it does not remove the top item from the stack.
+   -- Hence, in order to accomplish a "true" pop, both View_Top and Pop must
+   -- be called consecutively.
+   --
+   -- Since items on the stack are of a type (Stack_Item) derived from Item,
+   -- which is a (tagged) private type, type conversion toward the root is the
+   -- only way to get a value of type Item for return to the caller.
+   --
+   -- If the stack is empty, View_Top returns a pre-specified default value.
+   -- (In a true application, an exception might be raised instead).
+
+   function View_Top (S : Stack) return Item is
+   begin
+      if S.Top = null then                          -- Stack is empty.
+         return TC_Default_Value;                   -- Testing artifice.
+         -- Raise exception.
+      else
+         return Item(S.Top.all);                    -- Type conversion.
+      end if;
+   end View_Top;
+
+
+   function Size_Of (S : Stack) return Natural is
+   begin
+      return (S.Size);
+   end Size_Of;
+
+
+end CC50A01_0;
+
+
+     --==================================================================--
+
+
+-- The formal package Stacker below is needed to gain access to the
+-- appropriate version of the "generic" type Stack. It is provided with an
+-- explicit actual part in order to restrict the packages that can be passed
+-- as actuals to those which have been instantiated with the same actuals
+-- which this generic procedure has been instantiated with.
+
+with CC50A01_0;  -- Generic stack abstraction.
+generic
+   type Item_Type (<>) is tagged private;       -- Formal tagged private type.
+   Default : Item_Type;
+   with package Stacker is new CC50A01_0 (Item_Type, Default);
+procedure CC50A01_1 (S : in out Stacker.Stack; I : in Item_Type);
+
+
+     --==================================================================--
+
+--
+-- This generic procedure performs all of the testing of the
+-- stack abstraction.
+--
+
+with Report;
+procedure CC50A01_1 (S : in out Stacker.Stack; I : in Item_Type) is
+begin
+   Stacker.Push (I, S);                    -- Push onto empty stack.
+   Stacker.Push (I, S);                    -- Push onto nonempty stack.
+
+   if Stacker.Size_Of (S) /= 2 then
+      Report.Failed ("   Wrong stack size after 2 Pushes");
+   end if;
+
+   -- Calls to View_Top must initialize a declared object of type Item_Type
+   -- because the type may be unconstrained.
+
+   declare
+      Buffer1 : Item_Type := Stacker.View_Top (S);
+   begin
+      Stacker.Pop (S);                     -- Pop item off nonempty stack.
+      if Buffer1 /= I then
+         Report.Failed ("   Wrong stack item value after 1st Pop");
+      end if;
+   end;
+
+   declare
+      Buffer2 : Item_Type := Stacker.View_Top (S);
+   begin
+      Stacker.Pop (S);                     -- Pop last item off stack.
+      if Buffer2 /= I then
+         Report.Failed ("   Wrong stack item value after 2nd Pop");
+      end if;
+   end;
+
+   if Stacker.Size_Of (S) /= 0 then
+      Report.Failed ("   Wrong stack size after 2 Pops");
+   end if;
+
+   declare
+      Buffer3 : Item_Type := Stacker.View_Top (S);
+   begin
+      if Buffer3 /= Default then
+         Report.Failed ("   Wrong result after Pop of empty stack");
+      end if;
+      Stacker.Pop (S);                     -- Pop off empty stack.
+   end;
+
+end CC50A01_1;
+
+
+     --==================================================================--
+
+
+with FC50A00;
+
+with CC50A01_0;
+pragma Elaborate (CC50A01_0);
+
+package CC50A01_2 is new CC50A01_0 (FC50A00.Count_Type,
+                                    FC50A00.TC_Default_Count);
+
+
+     --==================================================================--
+
+
+with FC50A00;
+
+with CC50A01_0;
+pragma Elaborate (CC50A01_0);
+
+package CC50A01_3 is new CC50A01_0 (FC50A00.Person_Type,
+                                    FC50A00.TC_Default_Person);
+
+
+     --==================================================================--
+
+
+with FC50A00;   -- Tagged (actual) type declarations.
+with CC50A01_0; -- Generic stack abstraction.
+with CC50A01_1; -- Generic stack testing procedure.
+with CC50A01_2;
+with CC50A01_3;
+
+with Report;
+procedure CC50A01 is
+
+   package Count_Stacks  renames CC50A01_2;
+   package Person_Stacks renames CC50A01_3;
+
+
+   procedure TC_Count_Test is new CC50A01_1 (FC50A00.Count_Type,
+                                             FC50A00.TC_Default_Count,
+                                             Count_Stacks);
+   Count_Stack : Count_Stacks.Stack;
+
+ 
+   procedure TC_Person_Test is new CC50A01_1 (FC50A00.Person_Type,
+                                              FC50A00.TC_Default_Person,
+                                              Person_Stacks);
+   Person_Stack : Person_Stacks.Stack;
+
+begin
+   Report.Test ("CC50A01", "Check that a formal parameter of a " &
+                "library-level generic unit may be a formal tagged " &
+                "private type");
+
+   Report.Comment ("Testing definite tagged type..");
+   TC_Count_Test  (Count_Stack,  FC50A00.TC_Count_Item);
+
+   Report.Comment ("Testing indefinite tagged type..");
+   TC_Person_Test (Person_Stack, FC50A00.TC_Person_Item);
+
+   Report.Result;
+end CC50A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc50a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc50a02.a
new file mode 100644
index 000000000..6c2bf5fb0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc50a02.a
@@ -0,0 +1,227 @@
+-- CC50A02.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 nonlimited tagged type may be passed as an actual to a
+--      formal (non-tagged) private type. Check that if the formal type has
+--      an unknown discriminant part, a class-wide type may also be passed as
+--      an actual.
+--
+-- TEST DESCRIPTION:
+--      A generic package declares a formal private type and defines a
+--      stack abstraction. Stacks are modeled as singly linked lists of
+--      pointers to elements. Pointers are used because the elements may
+--      be unconstrained.
+--
+--      A generic testing procedure pushes an item onto a stack, then views
+--      the item on top of the stack.
+--
+--      The formal private type has an unknown discriminant part, and
+--      is thus indefinite. This allows both definite and indefinite types
+--      (including class-wide types) to be passed as actuals. For tagged types,
+--      definite implies nondiscriminated, and indefinite implies discriminated
+--      (with known/unknown discriminants). 
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FC50A00.A
+--      -> CC50A02.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Nov 95   SAIC    ACVC 2.0.1 fixes: Removed use of formal package
+--                          exception name in exception choice.
+--
+--!
+
+generic        -- Generic stack abstraction.
+   type Item (<>) is private;                   -- Formal private type.
+package CC50A02_0 is
+
+   type Stack is private;
+
+   procedure Push     (I : in Item; S : in out Stack);
+   function  View_Top (S : Stack) return Item;
+
+   -- ...Other stack operations...
+
+   Stack_Empty : exception;
+
+private
+
+   type Item_Ptr is access Item;
+
+   type Stack_Item;
+   type Stack_Ptr is access Stack_Item;
+
+   type Stack_Item is record
+      Item : Item_Ptr;
+      Next : Stack_Ptr;
+   end record;
+
+   type Stack is record
+      Top  : Stack_Ptr := null;
+      Size : Natural   := 0;
+   end record;
+
+end CC50A02_0;
+
+
+     --==================================================================--
+
+
+package body CC50A02_0 is
+
+   -- Link NewItem in at the top of the stack.
+
+   procedure Push (I : in Item; S : in out Stack) is
+      NewItem : Item_Ptr  := new Item'(I);
+      Element : Stack_Ptr := new Stack_Item'(Item => NewItem, Next => S.Top);
+   begin
+      S.Top   := Element;
+      S.Size  := S.Size + 1;
+   end Push;
+
+
+   -- Return (copy) of top item on stack. Do NOT remove from stack.
+
+   function View_Top (S : Stack) return Item is
+   begin
+      if S.Top = null then
+         raise Stack_Empty;
+      else
+         return S.Top.Item.all;
+      end if;
+   end View_Top;
+
+end CC50A02_0;
+
+
+     --==================================================================--
+
+
+-- The formal package Stacker below is needed to gain access to the
+-- appropriate version of the "generic" type Stack. It is provided with an
+-- explicit actual part in order to restrict the packages that can be passed
+-- as actuals to those which have been instantiated with the same actuals
+-- which this generic procedure has been instantiated with.
+
+with CC50A02_0;  -- Generic stack abstraction.
+generic
+   type Item_Type (<>) is private;       -- Formal private type.
+   with package Stacker is new CC50A02_0 (Item_Type);
+procedure CC50A02_1 (S : in out Stacker.Stack; I : in Item_Type);
+
+
+     --==================================================================--
+
+--
+-- This generic procedure performs all of the testing of the
+-- stack abstraction.
+--
+
+with Report;
+procedure CC50A02_1 (S : in out Stacker.Stack; I : in Item_Type) is
+begin
+   Stacker.Push (I, S);                    -- Push onto empty stack.
+
+   -- Calls to View_Top must initialize a declared object of type Item_Type
+   -- because the type may be unconstrained.
+
+   declare
+      Buffer : Item_Type := Stacker.View_Top (S);
+   begin
+      if Buffer /= I then
+         Report.Failed ("   Expected item not on stack");
+      end if;
+   exception
+      when Constraint_Error =>
+         Report.Failed ("   Unexpected error: Tags of pushed and popped " &
+                        "items don't match");
+   end;
+
+
+exception
+   when others =>
+      Report.Failed ("   Unexpected error: Item not pushed onto stack");
+end CC50A02_1;
+
+
+     --==================================================================--
+
+
+with FC50A00;   -- Tagged (actual) type declarations.
+with CC50A02_0; -- Generic stack abstraction.
+with CC50A02_1; -- Generic stack testing procedure.
+
+with Report;
+procedure CC50A02 is
+
+   --
+   -- Pass a nondiscriminated tagged actual:
+   --
+
+   package   Count_Stacks  is new CC50A02_0 (FC50A00.Count_Type);
+   procedure TC_Count_Test is new CC50A02_1 (FC50A00.Count_Type,
+                                             Count_Stacks);
+   Count_Stack : Count_Stacks.Stack;
+
+
+   --
+   -- Pass a discriminated tagged actual:
+   --
+ 
+   package   Person_Stacks  is new CC50A02_0 (FC50A00.Person_Type);
+   procedure TC_Person_Test is new CC50A02_1 (FC50A00.Person_Type,
+                                              Person_Stacks);
+   Person_Stack : Person_Stacks.Stack;
+
+
+   --
+   -- Pass a class-wide actual:
+   --
+ 
+   package   People_Stacks  is new CC50A02_0 (FC50A00.Person_Type'Class);
+   procedure TC_People_Test is new CC50A02_1 (FC50A00.Person_Type'Class,
+                                              People_Stacks);
+   People_Stack : People_Stacks.Stack;
+
+begin
+   Report.Test ("CC50A02", "Check that tagged actuals may be passed " &
+                "to a formal (nontagged) private type");
+
+   Report.Comment ("Testing definite tagged type..");
+   TC_Count_Test  (Count_Stack,  FC50A00.TC_Count_Item);
+
+   Report.Comment ("Testing indefinite tagged type..");
+   TC_Person_Test (Person_Stack, FC50A00.TC_Person_Item);
+
+   Report.Comment ("Testing class-wide type..");
+   TC_People_Test (People_Stack, FC50A00.TC_VIPerson_Item);
+
+   Report.Result;
+end CC50A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51001.a
new file mode 100644
index 000000000..6aa76a6f8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51001.a
@@ -0,0 +1,186 @@
+-- CC51001.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 formal parameter of a generic package may be a formal
+--      derived type. Check that the formal derived type may have an unknown
+--      discriminant part. Check that the ancestor type in a formal derived
+--      type definition may be a tagged type, and that the actual parameter
+--      may be a descendant of the ancestor type. Check that the formal derived
+--      type belongs to the derivation class rooted at the ancestor type;
+--      specifically, that components of the ancestor type may be referenced
+--      within the generic. Check that if a formal derived subtype is
+--      indefinite then the actual may be either definite or indefinite.
+--
+-- TEST DESCRIPTION:
+--      Define a class of tagged types with a definite root type. Extend the
+--      root type with a discriminated component. Since discriminants of
+--      tagged types may not have defaults, the type is indefinite.
+--
+--      Extend the extension with a second discriminated component, but with
+--      a new discriminant part. Declare a generic package with a formal
+--      derived type using the root type of the class as ancestor, and an
+--      unknown discriminant part. Declare an operation in the generic which
+--      accesses the common component of types in the class.
+--
+--      In the main program, instantiate the generic with each type in the
+--      class and verify that the operation correctly accesses the common
+--      component.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CC51001_0 is  -- Root type for message class.
+
+   subtype Msg_String is String (1 .. 20);
+
+   type Msg_Type is tagged record                          -- Root type of
+      Text : Msg_String := (others => ' ');                -- class (definite).
+   end record;
+
+end CC51001_0;
+
+
+-- No body for CC51001_0.
+
+
+     --==================================================================--
+
+
+with CC51001_0;       -- Root type for message class.
+package CC51001_1 is  -- Extensions to message class.
+
+   subtype Source_Length is Natural range 0 .. 10;
+
+   type From_Msg_Type (SLen : Source_Length) is            -- Direct derivative
+     new CC51001_0.Msg_Type with record                    -- of root type
+      From : String (1 .. SLen);                           -- (indefinite).
+   end record;
+
+   subtype Dest_Length is Natural range 0 .. 10;
+
+
+
+   type To_From_Msg_Type (DLen : Dest_Length) is           -- Indirect
+     new From_Msg_Type (SLen => 10) with record            -- derivative of
+      To : String (1 .. DLen);                             -- root type
+   end record;                                             -- (indefinite).
+
+end CC51001_1;
+
+
+-- No body for CC51001_1.
+
+
+     --==================================================================--
+
+
+with CC51001_0;       -- Root type for message class.
+generic               -- I/O operations for message class.
+   type Message_Type (<>) is new CC51001_0.Msg_Type with private;
+package CC51001_2 is
+
+   -- This subprogram contains an artificial result for testing purposes:
+   -- the function returns the text of the message to the caller as a string.
+
+   function Print_Message (M : in Message_Type) return String;
+
+   -- ... Other operations.
+
+end CC51001_2;
+
+
+     --==================================================================--
+
+
+package body CC51001_2 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 Print_Message (M : in Message_Type) return String is
+   begin
+      return M.Text;
+   end Print_Message;
+
+end CC51001_2;
+
+
+     --==================================================================--
+
+
+with CC51001_0;  -- Root type for message class.
+with CC51001_1;  -- Extensions to message class.
+with CC51001_2;  -- I/O operations for message class.
+
+with Report;
+procedure CC51001 is
+
+   -- Instantiate for various types in the class:
+
+   package Msgs   is new CC51001_2 (CC51001_0.Msg_Type);         -- Definite.
+   package FMsgs  is new CC51001_2 (CC51001_1.From_Msg_Type);    -- Indefinite.
+   package TFMsgs is new CC51001_2 (CC51001_1.To_From_Msg_Type); -- Indefinite.
+
+
+
+   Msg   : CC51001_0.Msg_Type         := (Text => "This is message #001");
+   FMsg  : CC51001_1.From_Msg_Type    := (Text => "This is message #002",
+                                          SLen => 2,
+                                          From => "Me");
+   TFMsg : CC51001_1.To_From_Msg_Type := (Text => "This is message #003",
+                                          From => "You       ",
+                                          DLen => 4,
+                                          To   => "Them");
+
+   Expected_Msg   : constant String := "This is message #001";
+   Expected_FMsg  : constant String := "This is message #002";
+   Expected_TFMsg : constant String := "This is message #003";
+
+begin
+   Report.Test ("CC51001", "Check that the formal derived type may have " &
+                "an unknown discriminant part. Check that the ancestor " &
+                "type in a formal derived type definition may be a " &
+                "tagged type, and that the actual parameter may be any " &
+                "definite or indefinite descendant of the ancestor type");
+
+   if (Msgs.Print_Message (Msg) /= Expected_Msg) then
+      Report.Failed ("Wrong result for definite root type");
+   end if;
+
+   if (FMsgs.Print_Message (FMsg) /= Expected_FMsg) then
+      Report.Failed ("Wrong result for direct indefinite derivative");
+   end if;
+
+   if (TFMsgs.Print_Message (TFMsg) /= Expected_TFMsg) then
+      Report.Failed ("Wrong result for Indirect indefinite derivative");
+   end if;
+
+   Report.Result;
+end CC51001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51002.a
new file mode 100644
index 000000000..1083d18a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51002.a
@@ -0,0 +1,198 @@
+-- CC51002.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, for formal derived tagged types, the formal parameter
+--      names and default expressions for a primitive subprogram in an
+--      instance are determined by the primitive subprogram of the ancestor
+--      type, but that the primitive subprogram body executed is that of the
+--      actual type.
+--
+-- TEST DESCRIPTION:
+--      Define a root tagged type in a library-level package and give it a
+--      primitive subprogram. Provide a default expression for a non-tagged
+--      parameter of the subprogram. Declare a library-level generic subprogram
+--      with a formal derived type using the root type as ancestor. Call
+--      the primitive subprogram of the root type using named association for
+--      the tagged parameter, and provide no actual for the defaulted
+--      parameter. Extend the root type in a second package and override the
+--      root type's subprogram with one which has different parameter names
+--      and no default expression for the non-tagged parameter. Instantiate
+--      the generic subprogram for each of the tagged types in the class and
+--      call the instances.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CC51002_0 is  -- Root message type and operations.
+
+   type Recipients is (None, Root, Sysop, Local, Remote);
+
+   type Msg_Type is tagged record                             -- Root type of
+      Text : String (1 .. 10);                                -- class.
+   end record;
+
+   function Send (Msg : in Msg_Type;                          -- Primitive
+                  To  : Recipients := Local) return Boolean;  -- subprogram.
+
+   -- ...Other message operations.
+
+end CC51002_0;
+
+
+     --==================================================================--
+
+
+package body CC51002_0 is
+
+   -- The implementation of Send is purely artificial; the validity of
+   -- its implementation in the context of the abstraction is irrelevant to
+   -- the feature being tested.
+
+   function Send (Msg : in Msg_Type;
+                  To  : Recipients := Local) return Boolean is
+   begin
+      return (Msg.Text = "Greetings!" and To = Local);
+   end Send;
+
+end CC51002_0;
+
+
+     --==================================================================--
+
+
+with CC51002_0;  -- Root message type and operations.
+generic          -- Message class function.
+   type Msg_Block is new CC51002_0.Msg_Type with private;
+function CC51002_1 (M : in Msg_Block) return Boolean;
+
+
+     --==================================================================--
+
+
+function CC51002_1 (M : in Msg_Block) return Boolean is
+   Okay : Boolean := False;
+begin
+
+   -- The call to Send below uses the ancestor type's parameter name, which
+   -- should be legal even if the actual subprogram called does not have a
+   -- parameter of that name. Furthermore, it uses the ancestor type's default
+   -- expression for the second parameter, which should be legal even if the
+   -- the actual subprogram called has no such default expression.
+
+   Okay := Send (Msg => M);
+   -- ...Other processing.
+   return Okay;
+
+end CC51002_1;
+
+
+     --==================================================================--
+
+
+with CC51002_0;       -- Root message type and operations.
+package CC51002_2 is  -- Extended message type and operations.
+
+   type Sender_Type is (Inside, Outside);
+
+   type Who_Msg_Type is new CC51002_0.Msg_Type with record   -- Derivative of
+      From : Sender_Type;                                    -- root type of
+   end record;                                               -- class.
+
+
+   -- Note: this overriding version of Send has different parameter names
+   -- from the root type's function. It also has no default expression.
+
+   function Send (M : Who_Msg_Type;                          -- Overrides
+                  R : CC51002_0.Recipients) return Boolean;  -- root type's
+                                                             -- operation.
+   -- ...Other extended message operations.
+
+end CC51002_2;
+
+
+     --==================================================================--
+
+
+package body CC51002_2 is
+
+   -- The implementation of Send is purely artificial; the validity of
+   -- its implementation in the context of the abstraction is irrelevant to
+   -- the feature being tested.
+
+   function Send (M : Who_Msg_Type; R : CC51002_0.Recipients) return Boolean is
+      use type CC51002_0.Recipients;
+   begin
+      return (M.Text = "Willkommen"     and
+              M.From = Outside          and
+              R      = CC51002_0.Local);
+   end Send;
+
+end CC51002_2;
+
+
+     --==================================================================--
+
+
+with CC51002_0;  -- Root message type and operations.
+with CC51002_1;  -- Message class function.
+with CC51002_2;  -- Extended message type and operations.
+
+with Report;
+procedure CC51002 is
+
+   function Send_Msg  is new CC51002_1 (CC51002_0.Msg_Type);
+   function Send_WMsg is new CC51002_1 (CC51002_2.Who_Msg_Type);
+
+   Mess  : CC51002_0.Msg_Type     := (Text => "Greetings!");
+   WMess : CC51002_2.Who_Msg_Type := (Text => "Willkommen",
+                                      From => CC51002_2.Outside);
+
+   TC_Okay_MStatus  : Boolean := False;
+   TC_Okay_WMStatus : Boolean := False;
+
+begin
+   Report.Test ("CC51002", "Check that, for formal derived tagged types, " &
+                "the formal parameter names and default expressions for "  &
+                "a primitive subprogram in an instance are determined by " &
+                "the primitive subprogram of the ancestor type, but that " &
+                "the primitive subprogram body executed is that of the"    &
+                "actual type");
+
+   TC_Okay_MStatus := Send_Msg (Mess);
+   if not TC_Okay_MStatus then
+      Report.Failed ("Wrong result from call to root type's operation");
+   end if;
+
+   TC_Okay_WMStatus := Send_WMsg (WMess);
+   if not TC_Okay_WMStatus then
+      Report.Failed ("Wrong result from call to derived type's operation");
+   end if;
+
+   Report.Result;
+end CC51002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51003.a
new file mode 100644
index 000000000..68ea32ebd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51003.a
@@ -0,0 +1,187 @@
+-- CC51003.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 the ancestor type of a formal derived type is a composite
+--      type that is not an array type, the formal type inherits components,
+--      including discriminants, from the ancestor type.
+--
+--      Check for the case where the ancestor type is a record type, and the
+--      formal derived type is declared in a generic subprogram.
+--
+-- TEST DESCRIPTION:
+--      Define a discriminated record type in a package. Declare a
+--      library-level generic subprogram with a formal derived type using the
+--      record type as ancestor. Give the generic subprogram an in out
+--      parameter of the formal derived type. Inside the generic, use the
+--      discriminant component and modify the remaining components of the
+--      record parameter. In the main program, declare record objects with two
+--      different discriminant values. Derive an indefinite type from the
+--      record type with a new discriminant part. Instantiate the generic
+--      subprogram for the root record subtype and the derived subtype. Call
+--      the root subtype instance with actual parameters having the two
+--      discriminant values. Also call the derived subtype instance with
+--      an appropriate actual.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      03 Jan 95   SAIC    Removed unknown discriminant part from formal
+--                          derived type.
+--      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Removed constrained subtype
+--                          instantiation and associated declarations.
+--                          Modified commentary.
+--
+--!
+
+
+-- Simulate a fragment of a matrix manipulation application.
+
+package CC51003_0 is  -- Matrix types.
+
+   type Matrix is array (Natural range <>, Natural range <>) of Integer;
+
+   type Square (Side : Natural) is record
+      Mat : Matrix (1 .. Side, 1 .. Side);
+   end record;
+
+   type Double_Square (Number : Natural) is record
+      Left  : Square (Number);
+      Right : Square (Number);
+   end record;
+
+end CC51003_0;
+
+
+-- No body for CC51003_0;
+
+
+     --==================================================================--
+
+
+with CC51003_0;  -- Matrix types.
+generic          -- Generic double-matrix "clear" operation.
+   type Dbl_Square is new CC51003_0.Double_Square;            -- Indefinite
+procedure CC51003_1 (Dbl : in out Dbl_Square);                -- formal.
+
+
+     --==================================================================--
+
+
+procedure CC51003_1 (Dbl : in out Dbl_Square) is
+begin
+   for I in 1 .. Dbl.Number loop     -- Discriminants inherited from ancestor
+      for J in 1 .. Dbl.Number loop  -- type (should work even for derived type
+                                     -- declaring new discriminant part).
+         Dbl.Left.Mat (I, J)  := 0;  -- Other components inherited from
+         Dbl.Right.Mat (I, J) := 0;  -- ancestor type.
+
+      end loop;
+   end loop;
+end CC51003_1;
+
+
+     --==================================================================--
+
+
+with CC51003_0;  -- Matrix types.
+with CC51003_1;  -- Generic double-matrix "clear" operation.
+
+with Report;
+procedure CC51003 is
+
+   use CC51003_0;  -- "/=" operator directly visible for Double_Square.
+
+   -- Matrices of root type:
+
+   Mat_2x2      : Square(Side => 2)           := (Side => 2,
+                                                  Mat  => ( (1, 2), (3, 4) ));
+   Dbl_Mat_2x2  : Double_Square(Number => 2)  := (2, Mat_2x2, Mat_2x2);
+
+
+   Zero_2x2     : constant Square(2)        := (2, Mat => ( (0, 0), (0, 0) ));
+   Expected_2x2 : constant Double_Square(2) := (Number => 2,
+                                                others => Zero_2x2);
+
+
+
+   Mat_3x3      : Square(Side => 3) := (Side => 3,
+                                        Mat  => (1      => (1, 4, 9),
+                                                 others => (1      => 5,
+                                                            others => 7)));
+   Dbl_Mat_3x3  : Double_Square(3)  := (Number => 3, others => Mat_3x3);
+
+
+   Zero_3x3     : constant Square(3) := (3, Mat => (others => (0,0,0)));
+   Expected_3x3 : constant Double_Square(Number => 3) :=
+                                        (3, Zero_3x3, Zero_3x3);
+
+
+   -- Derived type with new discriminant part (which constrains parent):
+
+   type New_Dbl_Sq (Num : Natural) is new Double_Square(Num);
+
+   New_Dbl_2x2      : New_Dbl_Sq (Num => 2) := (2, Mat_2x2, Mat_2x2);
+   Expected_New_2x2 : constant New_Dbl_Sq   := (Num => 2, others => Zero_2x2);
+
+
+
+   -- Instantiations:
+
+   procedure Clr_Dbl is new CC51003_1 (Double_Square);
+   procedure Clr_New_Dbl is new CC51003_1 (New_Dbl_Sq);
+
+
+begin
+   Report.Test ("CC51003", "Check that a formal derived record type " &
+                           "inherits components, including discriminants, " &
+                           "from its ancestor type");
+
+   -- Simulate use of matrix manipulation operations.
+
+   Clr_Dbl (Dbl_Mat_2x2);
+
+   if (Dbl_Mat_2x2 /= Expected_2x2) then
+      Report.Failed ("Wrong result for root type (2x2 matrix)");
+   end if;
+
+
+   Clr_Dbl (Dbl_Mat_3x3);
+
+   if (Dbl_Mat_3x3 /= Expected_3x3) then
+      Report.Failed ("Wrong result for root type (3x3 matrix)");
+   end if;
+
+
+   Clr_New_Dbl (New_Dbl_2x2);
+
+   if (New_Dbl_2x2 /= Expected_New_2x2) then
+      Report.Failed ("Wrong result for derived type (2x2 matrix)");
+   end if;
+
+
+   Report.Result;
+
+end CC51003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51004.a
new file mode 100644
index 000000000..09b1b57fa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51004.a
@@ -0,0 +1,181 @@
+-- CC51004.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 the ancestor type of a formal derived type is a composite
+--      type that is not an array type, the formal type inherits components,
+--      including discriminants, from the ancestor type.
+--
+--      Check for the case where the ancestor type is a tagged type, and the
+--      formal derived type is declared in a generic subprogram.
+--
+-- TEST DESCRIPTION:
+--      Define a discriminated tagged type in a package. Declare a
+--      library-level generic subprogram with a formal derived type using the
+--      tagged type as ancestor. Give the generic subprogram an in out
+--      parameter of the formal derived type. Inside the generic, use the
+--      discriminant component and modify the remaining components of the
+--      tagged parameter. In the main program, declare tagged record objects
+--      with two different discriminant values. Derive an indefinite type from
+--      the tagged type with a new discriminant part. Instantiate the
+--      generic subprogram for the root tagged subtype and the derived subtype.
+--      Call the root subtype instance with actual parameters having the two
+--      discriminant values. Also call the derived subtype instance with an
+--      appropriate actual.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      05 Jan 94   SAIC    Removed unknown discriminant part from formal
+--                          derived type. Moved declaration of type
+--                          New_Dbl_Sq from main subprogram to CC51004_0.
+--      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Removed constrained subtype
+--                          instantiation and associated declarations.
+--                          Modified commentary.
+--
+--!
+
+-- Simulate a fragment of a matrix manipulation application.
+
+package CC51004_0 is  -- Matrix types.
+
+   type Matrix is array (Natural range <>, Natural range <>) of Integer;
+
+   type Square (Side : Natural) is record
+      Mat : Matrix (1 .. Side, 1 .. Side);
+   end record;
+
+   type Sq_Type (Num1 : Natural) is tagged record
+      One : Square (Num1);
+   end record;
+
+   -- Extended type with new discriminant part (which constrains parent):
+
+   type New_Dbl_Sq (Num2 : Natural) is new Sq_Type(Num2) with record
+      Two : Square (Num2);
+   end record;
+
+end CC51004_0;
+
+
+-- No body for CC51004_0;
+
+
+     --==================================================================--
+
+
+with CC51004_0;  -- Matrix types.
+generic          -- Generic matrix "clear" operation.
+   type Squares is new CC51004_0.Sq_Type with private;       -- Indefinite
+procedure CC51004_1 (Sq : in out Squares);                   -- formal.
+
+
+     --==================================================================--
+
+
+procedure CC51004_1 (Sq : in out Squares) is
+begin
+   for I in 1 .. Sq.Num1 loop        -- Discriminants inherited from ancestor
+      for J in 1 .. Sq.Num1 loop     -- type (should work even for derived type
+                                     -- declaring new discriminant part).
+         Sq.One.Mat (I, J) := 0;     -- Other components inherited from
+                                     -- ancestor type.
+      end loop;
+   end loop;
+end CC51004_1;
+
+
+     --==================================================================--
+
+
+with CC51004_0;  -- Matrix types.
+with CC51004_1;  -- Generic double-matrix "clear" operation.
+
+with Report;
+procedure CC51004 is
+
+   use CC51004_0;  -- "/=" operator directly visible for Sq_Type.
+
+   -- Matrices of root type:
+
+   Mat_2x2      : Square(Side => 2)  := (Side => 2, Mat => ( (1, 2), (3, 4) ));
+   One_Mat_2x2  : Sq_Type(Num1 => 2) := (2, Mat_2x2);
+
+   Zero_2x2     : constant Square(2)  := (2, Mat => ( (0, 0), (0, 0) ));
+   Expected_2x2 : constant Sq_Type(2) := (Num1 => 2, One => Zero_2x2);
+
+
+   Mat_3x3      : Square(Side => 3) := (Side => 3,
+                                        Mat  => (1      => (5, 2, 7),
+                                                 others => (1      => 4,
+                                                            others => 9)));
+   One_Mat_3x3  : Sq_Type(3)        := (Num1 => 3, One => Mat_3x3);
+
+   Zero_3x3     : constant Square(3)        := (3, Mat => (others => (0,0,0)));
+   Expected_3x3 : constant Sq_Type(Num1 => 3) := (3, Zero_3x3);
+
+
+   New_Dbl_2x2      : New_Dbl_Sq(Num2 => 2) := (2, others => Mat_2x2);
+   Expected_New_2x2 : constant New_Dbl_Sq := (2, Zero_2x2, Mat_2x2);
+
+
+
+   -- Instantiations:
+
+   procedure Clr_Mat is new CC51004_1 (Sq_Type);
+   procedure Clr_New_Dbl is new CC51004_1 (New_Dbl_Sq);
+
+
+begin
+   Report.Test ("CC51004", "Check that a formal derived tagged type " &
+                           "inherits components, including discriminants, " &
+                           "from its ancestor type");
+
+   -- Simulate use of matrix manipulation operations.
+
+
+   Clr_Mat (One_Mat_2x2);
+
+   if (One_Mat_2x2 /= Expected_2x2) then
+      Report.Failed ("Wrong result root type (2x2 matrix)");
+   end if;
+
+
+   Clr_Mat (One_Mat_3x3);
+
+   if (One_Mat_3x3 /= Expected_3x3) then
+      Report.Failed ("Wrong result root type (3x3 matrix)");
+   end if;
+
+
+   Clr_New_Dbl (New_Dbl_2x2);
+
+   if (New_Dbl_2x2 /= Expected_New_2x2) then
+      Report.Failed ("Wrong result extended type (2x2 matrix)");
+   end if;
+
+
+   Report.Result;
+end CC51004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51006.a
new file mode 100644
index 000000000..b4dc4cdb4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51006.a
@@ -0,0 +1,224 @@
+-- CC51006.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, in an instance, each implicit declaration of a primitive
+--      subprogram of a formal (nontagged) derived type declares a view of
+--      the corresponding primitive subprogram of the ancestor type, even if
+--      the subprogram has been overridden for the actual type. Check that for
+--      a formal derived type with no discriminant part, if the ancestor
+--      subtype is an unconstrained scalar subtype then the actual may be
+--      either constrained or unconstrained.
+--
+-- TEST DESCRIPTION:
+--      The formal derived type has no discriminant part, but the ancestor
+--      subtype is unconstrained, making the formal type unconstrained. Since
+--      the ancestor subtype is a scalar subtype (not an access or composite
+--      subtype), the actual may be either constrained or unconstrained.
+--
+--      Declare a root type of a class as an unconstrained scalar (use floating
+--      point). Declare a primitive subprogram of the root type. Declare a
+--      generic package which has a formal derived type with the scalar root
+--      type as ancestor. Inside the generic, declare an operation which calls
+--      the ancestor type's primitive subprogram. Derive both constrained and
+--      unconstrained types from the root type and override the primitive
+--      subprogram for each. Declare a constrained subtype of the unconstrained
+--      derivative. Instantiate the generic package for the derived types and
+--      the subtype and call the "generic" operation for each one. Confirm that
+--      in all cases the root type's implementation of the primitive
+--      subprogram is called.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CC51006_0 is  -- Weight class.
+
+   type Weight_Type is digits 3;         -- Root type of class (unconstrained).
+
+   function Weight_To_String (Wt : Weight_Type) return String;
+
+   -- ... Other operations.
+
+end CC51006_0;
+
+
+     --==================================================================--
+
+
+package body CC51006_0 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 Weight_To_String (Wt : Weight_Type) return String is
+   begin
+      if Wt > 0.0 then         -- Always true for this test.
+         return ("Root type's implementation called");
+      else
+         return ("Unexpected result                ");
+      end if;
+   end Weight_To_String;
+
+end CC51006_0;
+
+
+     --==================================================================--
+
+
+with CC51006_0;  -- Weight class.
+generic          -- Generic weight operations. 
+   type Weight is new CC51006_0.Weight_Type;
+package CC51006_1 is
+
+   procedure Output_Weight (Wt : in Weight; TC_Return : out String);
+
+   -- ... Other operations.
+
+end CC51006_1;
+
+
+     --==================================================================--
+
+
+package body CC51006_1 is
+
+
+   -- The implementation of this procedure is purely artificial, and contains
+   -- an artificial parameter for testing purposes: the procedure returns the
+   -- weight string to the caller.
+
+   procedure Output_Weight (Wt : in Weight; TC_Return : out String) is
+   begin
+      TC_Return := Weight_To_String (Wt);   -- Should always call root type's
+   end Output_Weight;                       -- implementation.
+
+
+end CC51006_1;
+
+
+     --==================================================================--
+
+
+with CC51006_0;       -- Weight class.
+use  CC51006_0;
+package CC51006_2 is  -- Extensions to weight class.
+
+   type Grams is new Weight_Type;                         -- Unconstrained
+                                                          -- derivative.
+
+   function Weight_To_String (Wt : Grams) return String;  -- Overrides root
+                                                          -- type's operation.
+
+   subtype Milligrams is Grams                            -- Constrained
+     range 0.0 .. 0.999;                                  -- subtype (of der.).
+
+   type Pounds is new Weight_Type                         -- Constrained
+     range 0.0 .. 500.0;                                  -- derivative.
+
+   function Weight_To_String (Wt : Pounds) return String; -- Overrides root
+                                                          -- type's operation.
+
+end CC51006_2;
+
+
+     --==================================================================--
+
+
+package body CC51006_2 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 Weight_To_String (Wt : Grams) return String is
+   begin
+      return ("GRAMS: Should never be called    ");
+   end Weight_To_String;
+
+
+   function Weight_To_String (Wt : Pounds) return String is
+   begin
+      return ("POUNDS: Should never be called   ");
+   end Weight_To_String;
+
+end CC51006_2;
+
+
+     --==================================================================--
+
+
+with CC51006_1; -- Generic weight operations.
+with CC51006_2; -- Extensions to weight class.
+
+with Report;
+procedure CC51006 is
+
+   package Metric_Wts_G  is new CC51006_1 (CC51006_2.Grams);      -- Unconstr.
+   package Metric_Wts_MG is new CC51006_1 (CC51006_2.Milligrams); -- Constr.
+   package US_Wts        is new CC51006_1 (CC51006_2.Pounds);     -- Constr.
+
+   Gms : CC51006_2.Grams      := 113.451;
+   Mgm : CC51006_2.Milligrams := 0.549;
+   Lbs : CC51006_2.Pounds     := 24.52;
+
+
+   subtype TC_Buffers is String (1 .. 33);
+
+   TC_Expected : constant TC_Buffers := "Root type's implementation called";
+   TC_Buffer   :          TC_Buffers;
+
+begin
+   Report.Test ("CC51006", "Check that, in an instance, each implicit "  &
+                "declaration of a primitive subprogram of a formal "     &
+                "(nontagged) type declares a view of the corresponding " &
+                "primitive subprogram of the ancestor type");
+
+
+   Metric_Wts_G.Output_Weight (Gms, TC_Buffer);
+
+   if TC_Buffer /= TC_Expected then
+      Report.Failed ("Root operation not called for unconstrained derivative");
+   end if;
+
+
+   Metric_Wts_MG.Output_Weight (Mgm, TC_Buffer);
+
+   if TC_Buffer /= TC_Expected then
+      Report.Failed ("Root operation not called for constrained subtype");
+   end if;
+
+
+   US_Wts.Output_Weight (Lbs, TC_Buffer);
+
+   if TC_Buffer /= TC_Expected then
+      Report.Failed ("Root operation not called for constrained derivative");
+   end if;
+
+   Report.Result;
+end CC51006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51007.a
new file mode 100644
index 000000000..d8f78779d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51007.a
@@ -0,0 +1,305 @@
+-- CC51007.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 generic formal derived tagged type is a private extension.
+--      Specifically, check that, for a generic formal derived type whose
+--      ancestor type has abstract primitive subprograms, neither the formal
+--      derived type nor its descendants need be abstract. Check that objects
+--      and components of the formal derived type and its nonabstract
+--      descendants may be declared and allocated, as may nonabstract
+--      functions returning these types, and that aggregates of nonabstract
+--      descendants of the formal derived type are legal. Check that calls to
+--      the abstract primitive subprograms of the ancestor dispatch to the 
+--      bodies corresponding to the tag of the actual parameters.
+--
+-- TEST DESCRIPTION:
+--      Although the ancestor type is abstract and has abstract primitive
+--      subprograms, these subprograms, when inherited by a formal nonabstract
+--      derived type, are not abstract, since the formal derived type is a
+--      nonabstract private extension.  
+--
+--      Thus, derivatives of the formal derived type need not be abstract,
+--      and both the formal derived type and its derivatives are considered
+--      nonabstract types.
+--
+--      This test verifies that the restrictions placed on abstract types do
+--      not apply to the formal derived type or its derivatives. Specifically,
+--      objects of, components of, allocators of, and nonabstract functions
+--      returning the formal derived type or its derivatives are legal. In
+--      addition, the test verifies that a call within the instance to a
+--      primitive subprogram of the (abstract) ancestor type dispatches to
+--      the body corresponding to the tag of the actual parameter.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      23 Dec 94   SAIC    Deleted illegal extension aggregate.  Corrected
+--                          dispatching call. Editorial changes to commentary.
+--      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Moved instantiation of CC51007_3
+--                          to library level.
+--      11 Aug 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
+--                          clauses of CC51007_1 and CC51007_4.
+--
+--!
+
+package CC51007_0 is
+
+   Max_Length : constant := 10;
+   type Text is new String(1 .. Max_Length);
+
+   type Alert is abstract tagged record              -- Root type of class
+      Message : Text := (others => '*');             -- (abstract).
+   end record;
+
+   procedure Handle (A: in out Alert) is abstract;   -- Abstract dispatching
+                                                     -- operation.
+
+end CC51007_0;
+
+-- No body for CC51007_0;
+
+
+     --===================================================================--
+
+
+with CC51007_0;
+
+with Ada.Calendar;
+pragma Elaborate (Ada.Calendar);
+
+package CC51007_1 is
+
+   type Low_Alert is new CC51007_0.Alert with record
+      Time_Of_Arrival : Ada.Calendar.Time := Ada.Calendar.Time_Of (1901, 8, 1);
+   end record;
+
+   procedure Handle (A: in out Low_Alert);           -- Overrides parent's
+                                                     -- implementation.
+   Low : Low_Alert;
+
+end CC51007_1;
+
+
+     --===================================================================--
+
+
+package body CC51007_1 is
+
+   procedure Handle (A: in out Low_Alert) is         -- Artificial for
+   begin                                             -- testing.
+      A.Time_Of_Arrival := Ada.Calendar.Time_Of (1984, 1, 1);
+      A.Message := "Low Alert!";
+   end Handle;
+
+end CC51007_1;
+
+
+     --===================================================================--
+
+
+with CC51007_1;
+package CC51007_2 is
+
+   type Person is (OOD, CO, CinC);
+
+   type Medium_Alert is new CC51007_1.Low_Alert with record
+      Action_Officer : Person := OOD;
+   end record;
+
+   procedure Handle (A: in out Medium_Alert);        -- Overrides parent's
+                                                     -- implementation.
+   Med : Medium_Alert;
+
+end CC51007_2;
+
+
+     --===================================================================--
+
+
+with Ada.Calendar;
+package body CC51007_2 is
+
+   procedure Handle (A: in out Medium_Alert) is      -- Artificial for
+   begin                                             -- testing.
+      A.Action_Officer := CO;
+      A.Time_Of_Arrival := Ada.Calendar.Time_Of (2001, 1, 1);
+      A.Message := "Med Alert!";
+   end Handle;
+
+end CC51007_2;
+
+
+     --===================================================================--
+
+
+with CC51007_0;
+generic
+   type Alert_Type is new CC51007_0.Alert with private;
+   Initial_State : in Alert_Type;
+package CC51007_3 is
+
+   function Clear_Message (A: Alert_Type)                -- Function returning
+     return Alert_Type;                                  -- formal type.
+
+
+   Max_Note : Natural := 10;
+   type Note is new String (1 .. Max_Note);
+
+   type Extended_Alert is new Alert_Type with record
+      Addendum : Note := (others => '*');
+   end record;
+
+   -- In instance, inherits version of Handle from
+   -- actual corresponding to formal type.
+
+   function Annotate_Alert (A: in Alert_Type'Class)      -- Function returning
+     return Extended_Alert;                              -- derived type.
+
+
+   Init_Ext_Alert : constant Extended_Alert     :=       -- Object declaration.
+     (Initial_State with Addendum => "----------");      -- Aggregate.
+
+
+   type Alert_Type_Ptr is access constant Alert_Type;
+   type Ext_Alert_Ptr  is access          Extended_Alert;
+
+   Init_Alert_Ptr     : Alert_Type_Ptr := 
+     new Alert_Type'(Initial_State);                        -- Allocator.
+
+   Init_Ext_Alert_Ptr : Ext_Alert_Ptr  :=
+     new Extended_Alert'(Init_Ext_Alert);                -- Allocator.
+
+
+   type Alert_Pair is record
+      A  : Alert_Type;                                   -- Component.
+      EA : Extended_Alert;                               -- Component.
+   end record;
+
+end CC51007_3;
+
+
+     --===================================================================--
+
+
+package body CC51007_3 is
+
+   function Clear_Message (A: Alert_Type) return Alert_Type is
+      Temp : Alert_Type := A;                       -- Object declaration.
+   begin
+      Temp.Message := (others => '-');
+      return Temp;
+   end Clear_Message;
+
+   function Annotate_Alert (A: in Alert_Type'Class) return Extended_Alert is
+      Temp : Alert_Type'Class := A;
+   begin
+      Handle (Temp);                                -- Dispatching call to
+                                                    -- operation of ancestor.
+      return (Alert_Type(Temp) with Addendum => "No comment");
+   end Annotate_Alert;
+
+end CC51007_3;
+
+
+     --===================================================================--
+
+
+with CC51007_1;
+
+with CC51007_3;
+pragma Elaborate (CC51007_3);
+
+package CC51007_4 is new CC51007_3 (CC51007_1.Low_Alert, CC51007_1.Low);
+
+
+     --===================================================================--
+
+
+with CC51007_1;
+with CC51007_2;
+with CC51007_3;
+with CC51007_4;
+
+with Ada.Calendar;
+with Report;
+procedure CC51007 is
+
+   package Alert_Support renames CC51007_4;
+
+   Ext : Alert_Support.Extended_Alert;
+
+   TC_Result       : Alert_Support.Extended_Alert;
+
+   TC_Low_Expected : constant Alert_Support.Extended_Alert :=
+                       (Time_Of_Arrival => Ada.Calendar.Time_Of (1984, 1, 1),
+                        Message         => "Low Alert!",
+                        Addendum        => "No comment");
+
+   TC_Med_Expected : constant Alert_Support.Extended_Alert :=
+                       (Time_Of_Arrival => Ada.Calendar.Time_Of (2001, 1, 1),
+                        Message         => "Med Alert!",
+                        Addendum        => "No comment");
+
+   TC_Ext_Expected : constant Alert_Support.Extended_Alert := TC_Low_Expected;
+
+
+   use type Alert_Support.Extended_Alert;
+
+begin
+   Report.Test ("CC51007", "Check that, for a generic formal derived type "  &
+                "whose ancestor type has abstract primitive subprograms, "   &
+                "neither the formal derived type nor its descendants need "  &
+                "be abstract, and that objects of, components of, "          &
+                "allocators of, aggregates of, and nonabstract functions "   &
+                "returning these types are legal. Check that calls to the "  &
+                "abstract primitive subprograms of the ancestor dispatch "   &
+                "to the bodies corresponding to the tag of the actual "      &
+                "parameters");
+
+
+   TC_Result := Alert_Support.Annotate_Alert (CC51007_1.Low);  -- Dispatching
+                                                               -- call.
+   if TC_Result /= TC_Low_Expected then
+      Report.Failed ("Wrong results from dispatching call (Low_Alert)");
+   end if;
+
+
+   TC_Result := Alert_Support.Annotate_Alert (CC51007_2.Med);  -- Dispatching
+                                                               -- call.
+   if TC_Result /= TC_Med_Expected then
+      Report.Failed ("Wrong results from dispatching call (Medium_Alert)");
+   end if;
+
+
+   TC_Result := Alert_Support.Annotate_Alert (Ext);   -- Results in dispatching
+                                                      -- call.
+   if TC_Result /= TC_Ext_Expected then
+      Report.Failed ("Wrong results from dispatching call (Extended_Alert)");
+   end if;
+
+
+   Report.Result;
+end CC51007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51008.a
new file mode 100644
index 000000000..b95ae6cf0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51008.a
@@ -0,0 +1,124 @@
+-- CC51008.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 ACAA 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 operations are inherited for a formal derived type whose
+--    ancestor is also a formal type as described in the corrigendum.
+--    (Defect Report 8652/0038, as reflected in Technical Corrigendum 1,
+--    RM95 12.5.1(21/1)).
+--
+-- CHANGE HISTORY:
+--    29 Jan 2001   PHL   Initial version.
+--    30 Apr 2002   RLB   Readied for release.
+--
+--!
+package CC51008_0 is
+
+    type R0 is
+	record
+	    C : Float;
+	end record;
+
+    procedure S (X : R0);
+
+end CC51008_0;
+
+with Report;
+use Report;
+package body CC51008_0 is
+    procedure S (X : R0) is
+    begin
+	Comment ("CC51008_0.S called");
+    end S;
+end CC51008_0;
+
+with CC51008_0;
+generic
+    type F1 is new CC51008_0.R0;
+    type F2 is new F1;
+package CC51008_1 is
+    procedure G (O1 : F1; O2 : F2);
+end CC51008_1;
+
+package body CC51008_1 is
+    procedure G (O1 : F1; O2 : F2) is
+    begin
+	S (O1);
+	S (O2);
+    end G;
+end CC51008_1;
+
+with CC51008_0;
+package CC51008_2 is
+    type R2 is new CC51008_0.R0;
+    procedure S (X : out R2);
+end CC51008_2;
+
+with Report;
+use Report;
+package body CC51008_2 is
+    procedure S (X : out R2) is
+    begin
+	Failed ("CC51008_2.S called");
+    end S;
+end CC51008_2;
+
+with CC51008_2;
+package CC51008_3 is
+    type R3 is new CC51008_2.R2;
+    procedure S (X : R3);
+end CC51008_3;
+
+with Report;
+use Report;
+package body CC51008_3 is
+    procedure S (X : R3) is
+    begin
+	Failed ("CC51008_3.S called");
+    end S;
+end CC51008_3;
+
+with CC51008_1;
+with CC51008_2;
+with CC51008_3;
+with Report;
+use Report;
+procedure CC51008 is
+
+    package Inst is new CC51008_1 (CC51008_2.R2,
+				   CC51008_3.R3);
+
+    X2 : constant CC51008_2.R2 := (C => 2.0);
+    X3 : constant CC51008_3.R3 := (C => 3.0);
+
+begin
+    Test ("CC51008",
+	  "Check that operations are inherited for a formal derived " &
+	     "type whose ancestor is also a formal type as described in " &
+	     "RM95 12.5.1(21/1)");
+    Inst.G (X2, X3);
+    Result;
+end CC51008;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51a01.a
new file mode 100644
index 000000000..60c32be47
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51a01.a
@@ -0,0 +1,193 @@
+-- CC51A01.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, in an instance, each implicit declaration of a user-defined
+--      subprogram of a formal derived record type declares a view of the
+--      corresponding primitive subprogram of the ancestor, even if the
+--      primitive subprogram has been overridden for the actual type.
+--
+-- TEST DESCRIPTION:
+--      Declare a "fraction" type abstraction in a package (foundation code).
+--      Declare a "fraction" I/O routine in a generic package with a formal
+--      derived type whose ancestor type is the fraction type declared in
+--      the first package. Within the I/O routine, call other operations of
+--      ancestor type. Derive from the root fraction type in another package
+--      and override one of the operations called in the generic I/O routine.
+--      Derive from the derivative of the root fraction type. Instantiate
+--      the generic package for each of the three types and call the I/O
+--      routine.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FC51A00.A
+--         CC51A01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FC51A00;         -- Fraction type abstraction.
+generic               -- Fraction I/O support.
+   type Fraction is new FC51A00.Fraction_Type;     -- Formal derived type of a
+package CC51A01_0 is                               -- (private) record type.
+
+   -- Simulate writing a fraction to standard output. In a real application,
+   -- this subprogram might be a procedure which uses Text_IO routines. For
+   -- the purposes of the test, the "output" is returned to the caller as a
+   -- string.
+   function Put (Item : in Fraction) return String;
+
+   -- ... Other I/O operations for fractions.
+
+end CC51A01_0;
+
+
+     --==================================================================--
+
+
+package body CC51A01_0 is
+
+   function Put (Item : in Fraction) return String is
+      Num : constant String :=              -- Fraction's primitive subprograms
+        Integer'Image (Numerator (Item));   -- are inherited from its parent
+      Den : constant String :=              -- (FC51A00.Fraction_Type) and NOT
+        Integer'Image (Denominator (Item)); -- from the actual type.
+   begin
+      return (Num & '/' & Den);
+   end Put;
+
+end CC51A01_0;
+
+
+     --==================================================================--
+
+
+with FC51A00;         -- Fraction type abstraction.
+package CC51A01_1 is
+
+   -- Derive directly from the root type of the class and override one of the
+   -- primitive subprograms.
+
+   type Pos_Fraction is new FC51A00.Fraction_Type;     -- Derived directly from
+                                                       -- root type of class.
+   -- Inherits "/" from root type.
+   -- Inherits "-" from root type.
+   -- Inherits Numerator from root type.
+   -- Inherits Denominator from root type.
+
+   -- Return absolute value of numerator as integer.
+   function Numerator (Frac : Pos_Fraction)            -- Overrides parent's
+     return Integer;                                   -- operation.
+
+end CC51A01_1;
+
+
+     --==================================================================--
+
+
+package body CC51A01_1 is
+
+   -- This body should never be called.
+   --
+   -- The test sends the function Numerator a fraction with a negative
+   -- numerator, and expects this negative numerator to be returned. This
+   -- version of the function returns the absolute value of the numerator.
+   -- Thus, a call to this version is detectable by examining the sign
+   -- of the return value.
+
+   function Numerator (Frac : Pos_Fraction) return Integer is
+      Converted_Frac : FC51A00.Fraction_Type := FC51A00.Fraction_Type (Frac);
+      Orig_Numerator : Integer := FC51A00.Numerator (Converted_Frac);
+   begin
+      return abs (Orig_Numerator);
+   end Numerator;
+
+end CC51A01_1;
+
+
+     --==================================================================--
+
+
+with FC51A00;     -- Fraction type abstraction.
+with CC51A01_0;   -- Fraction I/O support.
+with CC51A01_1;   -- Positive fraction type abstraction.
+
+with Report;
+procedure CC51A01 is
+
+   type Distance is new CC51A01_1.Pos_Fraction;    -- Derived indirectly from
+                                                   -- root type of class.
+   -- Inherits "/" indirectly from root type.
+   -- Inherits "-" indirectly from root type.
+   -- Inherits Numerator directly from parent type.
+   -- Inherits Denominator indirectly from root type.
+
+   use FC51A00, CC51A01_1;                         -- All primitive subprograms
+                                                   -- directly visible.
+
+   package Fraction_IO     is new CC51A01_0 (Fraction_Type);
+   package Pos_Fraction_IO is new CC51A01_0 (Pos_Fraction);
+   package Distance_IO     is new CC51A01_0 (Distance);
+
+   -- For each of the instances above, the subprogram "Put" should produce
+   -- the same result. That is, the primitive subprograms called by Put
+   -- should in all cases be those of the type Fraction_Type, which is the
+   -- ancestor type for the formal derived type in the generic unit. In
+   -- particular, for Pos_Fraction_IO and Distance_IO, the versions of
+   -- Numerator called should NOT be those of the actual types, which override
+   -- Fraction_Type's version.
+
+   TC_Expected_Result : constant String := "-3/ 16";
+
+   TC_Root_Type_Of_Class  : Fraction_Type := -3/16;
+   TC_Direct_Derivative   : Pos_Fraction  := -3/16;
+   TC_Indirect_Derivative : Distance      := -3/16;
+
+begin
+   Report.Test ("CC51A01", "Check that, in an instance, each implicit "     &
+                "declaration of a user-defined subprogram of a formal "     &
+                "derived record type declares a view of the corresponding " &
+                "primitive subprogram of the ancestor, even if the "        &
+                "primitive subprogram has been overridden for the actual "  &
+                "type");
+
+   if (Fraction_IO.Put (TC_Root_Type_Of_Class) /= TC_Expected_Result) then
+      Report.Failed ("Wrong result for root type");
+   end if;
+
+   if (Pos_Fraction_IO.Put (TC_Direct_Derivative) /= TC_Expected_Result) then
+      Report.Failed ("Wrong result for direct derivative");
+   end if;
+
+   if (Distance_IO.Put (TC_Indirect_Derivative) /= TC_Expected_Result) then
+      Report.Failed ("Wrong result for INdirect derivative");
+   end if;
+
+   Report.Result;
+end CC51A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51b03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51b03.a
new file mode 100644
index 000000000..0cbeeb46f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51b03.a
@@ -0,0 +1,258 @@
+-- CC51B03.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 attribute S'Definite, where S is an indefinite formal
+--      private or derived type, returns true if the actual corresponding to
+--      S is definite, and returns false otherwise.
+--
+-- TEST DESCRIPTION:
+--      A definite subtype is any subtype which is not indefinite. 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.
+--
+--      The possible forms of indefinite formal subtype are as follows:
+--
+--         Formal derived types:
+--          X - Ancestor is an unconstrained array type
+--          * - Ancestor is a discriminated record type without defaults
+--          X - Ancestor is a discriminated tagged type
+--          * - Ancestor type has unknown discriminants
+--            - Formal type has an unknown discriminant part
+--          * - Formal type has a known discriminant part
+--
+--         Formal private types:
+--            - Formal type has an unknown discriminant part
+--          * - Formal type has a known discriminant part
+--
+--      The formal subtypes preceded by an 'X' above are not covered, because
+--      other rules prevent a definite subtype from being passed as an actual.
+--      The formal subtypes preceded by an '*' above are not covered, because
+--      'Definite is less likely to be used for these formals.
+--
+--      The following kinds of actuals are passed to various of the formal
+--      types listed above:
+--
+--            - Undiscriminated type
+--            - Type with defaulted discriminants
+--            - Type with undefaulted discriminants
+--            - Class-wide type
+--
+--      A typical usage of S'Definite might be algorithm selection in a
+--      generic I/O package, e.g., the use of fixed-length or variable-length
+--      records depending on whether the actual is definite or indefinite.
+--      In such situations, S'Definite would appear in if conditions or other
+--      contexts requiring a boolean expression. This test checks S'Definite
+--      in such usage contexts but, for brevity, omits any surrounding
+--      usage code.
+--      
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FC51B00.A
+--      -> CC51B03.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FC51B00;  -- Indefinite subtype declarations.
+package CC51B03_0 is
+
+   --
+   -- Formal private type cases:
+   --
+
+   generic
+      type Formal (<>) is private;              -- Formal has unknown
+   package PrivateFormalUnknownDiscriminants is -- discriminant part.
+      function Is_Definite return Boolean;
+   end PrivateFormalUnknownDiscriminants;
+
+
+   --
+   -- Formal derived type cases:
+   --
+
+   generic
+      type Formal (<>) is new FC51B00.Vector    -- Formal has an unknown disc.
+        with private;                           -- part; ancestor is tagged.
+   package TaggedAncestorUnknownDiscriminants is
+      function Is_Definite return Boolean;
+   end TaggedAncestorUnknownDiscriminants;
+
+
+end CC51B03_0;
+
+
+     --==================================================================--
+
+
+package body CC51B03_0 is
+
+   package body PrivateFormalUnknownDiscriminants is
+      function Is_Definite return Boolean is
+      begin
+         if Formal'Definite then                -- Attribute used in "if"
+            -- ...Execute algorithm #1...       -- condition inside subprogram.
+            return True;
+         else
+            -- ...Execute algorithm #2...
+            return False;
+         end if;
+      end Is_Definite;
+   end PrivateFormalUnknownDiscriminants;
+
+
+   package body TaggedAncestorUnknownDiscriminants is
+      function Is_Definite return Boolean is
+      begin
+         return Formal'Definite;                -- Attribute used in return
+      end Is_Definite;                          -- statement inside subprogram.
+   end TaggedAncestorUnknownDiscriminants;
+
+
+end CC51B03_0;
+
+
+     --==================================================================--
+
+
+with FC51B00;
+package CC51B03_1 is
+
+   subtype Spin_Type is Natural range 0 .. 3;
+
+   type Extended_Vector (Spin : Spin_Type) is   -- Tagged type with
+     new FC51B00.Vector with null record;       -- discriminant (indefinite).
+      
+
+end CC51B03_1;
+
+
+     --==================================================================--
+
+
+with FC51B00;   -- Indefinite subtype declarations.
+with CC51B03_0; -- Generic package declarations.
+with CC51B03_1;
+
+with Report;
+procedure CC51B03 is
+
+   --
+   -- Instances for formal private type with unknown discriminants:
+   --
+
+   package PrivateFormal_UndiscriminatedTaggedActual is new
+     CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Vector);
+
+   package PrivateFormal_ClassWideActual is new
+     CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Vector'Class);
+
+   package PrivateFormal_DiscriminatedTaggedActual is new
+     CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Square_Pair);
+
+   package PrivateFormal_DiscriminatedUndefaultedRecordActual is new
+     CC51B03_0.PrivateFormalUnknownDiscriminants (FC51B00.Square);
+
+
+   subtype Length is Natural range 0 .. 20;
+   type Message (Len : Length := 0) is record   -- Record type with defaulted
+      Text : String (1 .. Len);                 -- discriminant (definite).
+   end record;
+      
+   package PrivateFormal_DiscriminatedDefaultedRecordActual is new
+     CC51B03_0.PrivateFormalUnknownDiscriminants (Message);
+
+
+   --
+   -- Instances for formal derived tagged type with unknown discriminants:
+   --
+
+   package DerivedFormal_UndiscriminatedTaggedActual is new
+     CC51B03_0.TaggedAncestorUnknownDiscriminants (FC51B00.Vector);
+
+   package DerivedFormal_ClassWideActual is new
+     CC51B03_0.TaggedAncestorUnknownDiscriminants (FC51B00.Vector'Class);
+
+   package DerivedFormal_DiscriminatedTaggedActual is new
+     CC51B03_0.TaggedAncestorUnknownDiscriminants (CC51B03_1.Extended_Vector);
+
+
+begin
+   Report.Test ("CC51B03", "Check that S'Definite returns true if the " &
+                "actual corresponding to S is definite, and false otherwise");
+
+
+   if not PrivateFormal_UndiscriminatedTaggedActual.Is_Definite then
+      Report.Failed ("Formal private/unknown discriminants: wrong " &
+                     "result for undiscriminated tagged actual");
+   end if;  
+
+   if PrivateFormal_ClassWideActual.Is_Definite then
+      Report.Failed ("Formal private/unknown discriminants: wrong " &
+                     "result for class-wide actual");
+   end if;  
+
+   if PrivateFormal_DiscriminatedTaggedActual.Is_Definite then
+      Report.Failed ("Formal private/unknown discriminants: wrong " &
+                     "result for discriminated tagged actual");
+   end if;  
+
+   if PrivateFormal_DiscriminatedUndefaultedRecordActual.Is_Definite then
+      Report.Failed ("Formal private/unknown discriminants: wrong result " &
+                     "for record actual with undefaulted discriminants");
+   end if;  
+
+   if not PrivateFormal_DiscriminatedDefaultedRecordActual.Is_Definite then
+      Report.Failed ("Formal private/unknown discriminants: wrong result " &
+                     "for record actual with defaulted discriminants");
+   end if;  
+
+
+   if not DerivedFormal_UndiscriminatedTaggedActual.Is_Definite then
+      Report.Failed ("Formal derived/unknown discriminants: wrong result " &
+                     "for undiscriminated tagged actual");
+   end if;  
+
+   if DerivedFormal_ClassWideActual.Is_Definite then
+      Report.Failed ("Formal derived/unknown discriminants: wrong result " &
+                     "for class-wide actual");
+   end if;  
+
+   if DerivedFormal_DiscriminatedTaggedActual.Is_Definite then
+      Report.Failed ("Formal derived/unknown discriminants: wrong result " &
+                     "for discriminated tagged actual");
+   end if;  
+
+
+   Report.Result;
+end CC51B03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51d01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51d01.a
new file mode 100644
index 000000000..63c68c0d4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51d01.a
@@ -0,0 +1,262 @@
+-- CC51D01.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, in an instance, each implicit declaration of a user-defined
+--      subprogram of a formal private extension declares a view of the
+--      corresponding primitive subprogram of the ancestor, and that if the
+--      tag in a call is statically determined to be that of the formal type,
+--      the body executed will be that corresponding to the actual type.
+--
+--      Check subprograms declared within a generic formal package. Check for
+--      the case where the actual type passed to the formal private extension
+--      is a specific tagged type. Check for several types in the same class.
+--
+--
+-- TEST DESCRIPTION:
+--      Declare a list abstraction in a generic package which manages lists of
+--      elements of any nonlimited type (foundation code). Declare a package
+--      which declares a tagged type and a type derived from it. Declare an
+--      operation for the root tagged type and override it for the derived
+--      type. Derive a type from this derived type, but do not override the
+--      operation. Declare a generic subprogram which operates on lists of
+--      elements of tagged types. Provide the generic subprogram with two
+--      formal parameters: (1) a formal derived tagged type which represents a
+--      list element type, and (2) a generic formal package with the list
+--      abstraction package as template. Use the formal derived type as the
+--      generic formal actual part for the formal package. Within the generic
+--      subprogram, call the operation of the root tagged type. In the main
+--      program, instantiate the generic list package and the generic
+--      subprogram with the root tagged type and each derivative, then call
+--      each instance with an object of the appropriate type.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FC51D00.A
+--      -> CC51D01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      04 Jan 95   SAIC    Moved declaration of type Ranked_ID_Type from
+--                          main subprogram to package CC51D01_0. Removed
+--                          case passing class-wide actual to instance.
+--                          Updated test description and modified comments.
+--
+--!
+
+package CC51D01_0 is -- This package simulates support for a personnel
+                     -- database.
+
+   type SSN_Type is new String (1 .. 9);
+
+   type Blind_ID_Type is tagged record                   -- Root type of
+      SSN : SSN_Type;                                    -- class.
+      -- ... Other components.
+   end record;
+
+   procedure Update_ID (Item : in out Blind_ID_Type);    -- Parent operation.
+
+   -- ... Other operations.
+
+
+   type Name_Type is new String (1 .. 9);
+
+   type Named_ID_Type is new Blind_ID_Type with record   -- Direct derivative
+      Name : Name_Type := "Doe      ";                   -- of root type.
+      -- ... Other components.
+   end record;
+
+   -- Inherits Update_ID from parent.
+
+   procedure Update_ID (Item : in out Named_ID_Type);    -- Overrides parent's
+                                                         -- implementation.
+
+
+   type Ranked_ID_Type is new Named_ID_Type with record
+      Level : Integer := 0;                              -- Indirect derivative
+      -- ... Other components.                           -- of root type.
+   end record;
+
+   -- Inherits Update_ID from parent.
+
+end CC51D01_0;
+
+
+     --==================================================================--
+
+
+package body CC51D01_0 is
+
+   -- The implementations of Update_ID are purely artificial; the validity of
+   -- their implementations in the context of the abstraction is irrelevant to
+   -- the feature being tested.
+
+   procedure Update_ID (Item : in out Blind_ID_Type) is
+   begin
+      Item.SSN := "111223333";
+   end Update_ID;
+
+
+   procedure Update_ID (Item : in out Named_ID_Type) is
+   begin
+      Item.SSN := "444556666";
+      -- ... Other stuff.
+   end Update_ID;
+
+end CC51D01_0;
+
+
+     --==================================================================--
+
+
+--                           --
+-- Formal package used here. --
+--                           --
+
+with FC51D00;    -- Generic list abstraction.
+with CC51D01_0;  -- Tagged type declarations.
+generic          -- This procedure simulates a generic operation for types
+                 -- in the class rooted at Blind_ID_Type.
+   type Elem_Type is new CC51D01_0.Blind_ID_Type with private;
+   with package List_Mgr is new FC51D00 (Elem_Type);
+procedure CC51D01_1 (L : in out List_Mgr.List_Type; E : in Elem_Type);
+
+
+     --==================================================================--
+
+
+-- The implementation of CC51D01_1 is purely artificial; the validity
+-- of its implementation in the context of the abstraction is irrelevant
+-- to the feature being tested.
+--
+-- The expected behavior here is as follows: for each actual type corresponding
+-- to Elem_Type, the call to Update_ID should invoke the actual type's
+-- implementation, which updates the object's SSN field. Write_Element then
+-- adds the object to the list.
+
+procedure CC51D01_1 (L : in out List_Mgr.List_Type; E : in Elem_Type) is
+   Element : Elem_Type := E;   -- Can't update IN parameter.
+begin
+   Update_ID (Element);                    -- Executes actual type's version.
+   List_Mgr.Write_Element (1, L, Element); -- Executes actual type's version.
+end CC51D01_1;
+
+
+     --==================================================================--
+
+
+with FC51D00;    -- Generic list abstraction.
+with CC51D01_0;  -- Tagged type declarations.
+with CC51D01_1;  -- Generic operation.
+
+with Report;
+procedure CC51D01 is
+
+   use CC51D01_0;                                        -- All types & ops
+                                                         -- directly visible.
+
+   -- Begin test code declarations: -----------------------
+
+   TC_Expected_1 : Blind_ID_Type       := (SSN => "111223333");
+   TC_Expected_2 : Named_ID_Type       := ("444556666", "Doe      ");
+   TC_Expected_3 : Ranked_ID_Type      := ("444556666", "Doe      ", 0);
+
+   TC_Initial_1  : Blind_ID_Type       := (SSN => "777889999");
+   TC_Initial_2  : Named_ID_Type       := ("777889999", "Doe      ");
+   TC_Initial_3  : Ranked_ID_Type      := ("777889999", "Doe      ", 0);
+
+   -- End test code declarations. -------------------------
+
+
+   -- Begin instantiations and list declarations: ---------
+
+   -- At this point in an application, the generic list package would be
+   -- instantiated for one of the visible tagged types. Next, the generic
+   -- subprogram would be instantiated for the same tagged type and the
+   -- preceding list package instance.
+   --
+   -- In order to cover all the important cases, this test instantiates several
+   -- packages and subprograms (probably more than would typically appear
+   -- in user code).
+
+   -- Support for lists of blind IDs:
+
+   package Blind_Lists is new FC51D00 (Blind_ID_Type);
+   procedure Update_and_Write is new CC51D01_1 (Blind_ID_Type, Blind_Lists);
+   Blind_List : Blind_Lists.List_Type;
+
+
+   -- Support for lists of named IDs:
+
+   package Named_Lists is new FC51D00 (Named_ID_Type);
+   procedure Update_and_Write is new                     -- Overloads subprog
+     CC51D01_1 (Elem_Type => Named_ID_Type,              -- for Blind_ID_Type.
+                List_Mgr  => Named_Lists);
+   Named_List : Named_Lists.List_Type;
+
+
+   -- Support for lists of ranked IDs:
+
+   package Ranked_Lists is new FC51D00 (Ranked_ID_Type);
+   procedure Update_and_Write is new                     -- Overloads.
+     CC51D01_1 (Elem_Type => Ranked_ID_Type,
+                List_Mgr  => Ranked_Lists);
+   Ranked_List : Ranked_Lists.List_Type;
+
+   -- End instantiations and list declarations. -----------
+
+
+begin
+   Report.Test ("CC51D01", "Formal private extension, specific tagged "   &
+                "type actual: body of primitive subprogram executed is "  &
+                "that of actual type. Check for subprograms declared in " &
+                "a formal package");
+
+
+   Update_and_Write (Blind_List, TC_Initial_1);
+
+   if (Blind_Lists.View_Element (1, Blind_List) /= TC_Expected_1) then
+      Report.Failed ("Wrong result for root tagged type");
+   end if;
+
+
+   Update_and_Write (Named_List, TC_Initial_2);
+
+   if (Named_Lists.View_Element (1, Named_List) /= TC_Expected_2) then
+      Report.Failed ("Wrong result for type derived directly from root");
+   end if;
+
+
+   Update_and_Write (Ranked_List, TC_Initial_3);
+
+   if (Ranked_Lists.View_Element (1, Ranked_List) /= TC_Expected_3) then
+      Report.Failed ("Wrong result for type derived indirectly from root");
+   end if;
+
+
+   Report.Result;
+end CC51D01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51d02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51d02.a
new file mode 100644
index 000000000..520556391
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc51d02.a
@@ -0,0 +1,244 @@
+-- CC51D02.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, in an instance, each implicit declaration of a user-defined
+--      subprogram of a formal private extension declares a view of the
+--      corresponding primitive subprogram of the ancestor, and that if the
+--      tag in a call is statically determined to be that of the formal type,
+--      the body executed will be that corresponding to the actual type.
+--
+--      Check subprograms declared within a generic formal package. Check for
+--      the case where the actual type passed to the formal private extension
+--      is a class-wide type. Check for several types in the same class.
+--
+--
+-- TEST DESCRIPTION:
+--      Declare a list abstraction in a generic package which manages lists of
+--      elements of any nonlimited type (foundation code). Declare a package
+--      which declares a tagged type and a derivative. Declare an operation
+--      for the root tagged type and override it for the derivative. Declare
+--      a generic subprogram which operates on lists of elements of tagged
+--      types. Provide the generic subprogram with two formal parameters: (1)
+--      a formal derived tagged type which represents a list element type, and
+--      (2) a generic formal package with the list abstraction package as
+--      template. Use the formal derived type as the generic formal actual
+--      part for the formal package. Within the generic subprogram, call the
+--      operation of the root tagged type. In the main program, instantiate
+--      the generic list package and the generic subprogram with the class-wide
+--      type for the root tagged type.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FC51D00.A
+--      -> CC51D02.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      05 Jan 95   SAIC    Changed types of TC_Expected_1 and TC_Expected_2
+--                          from specific to class-wide. Eliminated (illegal)
+--                          assignment step prior to comparison of
+--                          TC_Expected_X with item on stack.
+--
+--!
+
+package CC51D02_0 is -- This package simulates support for a personnel
+                     -- database.
+
+   type SSN_Type is new String (1 .. 9);
+
+   type Blind_ID_Type is tagged record                   -- Root type of
+      SSN : SSN_Type;                                    -- class.
+      -- ... Other components.
+   end record;
+
+   procedure Update_ID (Item : in out Blind_ID_Type);    -- Parent operation.
+
+   -- ... Other operations.
+
+
+   type Name_Type is new String (1 .. 9);
+
+   type Named_ID_Type is new Blind_ID_Type with record   -- Direct derivative
+      Name : Name_Type := "Doe      ";                   -- of root type.
+      -- ... Other components.
+   end record;
+
+   -- Inherits Update_ID from parent.
+
+   procedure Update_ID (Item : in out Named_ID_Type);    -- Overrides parent's
+                                                         -- implementation.
+
+end CC51D02_0;
+
+
+     --==================================================================--
+
+
+package body CC51D02_0 is
+
+   -- The implementations of Update_ID are purely artificial; the validity of
+   -- their implementations in the context of the abstraction is irrelevant to
+   -- the feature being tested.
+
+   procedure Update_ID (Item : in out Blind_ID_Type) is
+   begin
+      Item.SSN := "111223333";
+   end Update_ID;
+
+
+   procedure Update_ID (Item : in out Named_ID_Type) is
+   begin
+      Item.SSN := "444556666";
+      -- ... Other stuff.
+   end Update_ID;
+
+end CC51D02_0;
+
+
+     --==================================================================--
+
+
+--                           --
+-- Formal package used here. --
+--                           --
+
+with FC51D00;    -- Generic list abstraction.
+with CC51D02_0;  -- Tagged type declarations.
+generic          -- This procedure simulates a generic operation for types
+                 -- in the class rooted at Blind_ID_Type.
+   type Elem_Type (<>) is new CC51D02_0.Blind_ID_Type with private;
+   with package List_Mgr is new FC51D00 (Elem_Type);
+procedure CC51D02_1 (L : in out List_Mgr.List_Type; E : in Elem_Type);
+
+
+     --==================================================================--
+
+
+-- The implementation of CC51D02_1 is purely artificial; the validity
+-- of its implementation in the context of the abstraction is irrelevant
+-- to the feature being tested.
+--
+-- The expected behavior here is as follows: for each actual type corresponding
+-- to Elem_Type, the call to Update_ID should invoke the actual type's
+-- implementation (based on the tag of the actual), which updates the object's
+-- SSN field. Write_Element then adds the object to the list.
+
+procedure CC51D02_1 (L : in out List_Mgr.List_Type; E : in Elem_Type) is
+   Element : Elem_Type := E;   -- Can't update IN parameter.
+                               -- Initialization of unconstrained variable.
+begin
+   Update_ID (Element);                    -- Executes actual type's version
+                                           -- (for this test, this will be a
+                                           -- dispatching call).
+   List_Mgr.Write_Element (1, L, Element); -- Executes actual type's version
+                                           -- (for this test, this will be a
+                                           -- class-wide operation).
+end CC51D02_1;
+
+
+     --==================================================================--
+
+
+with FC51D00;    -- Generic list abstraction.
+with CC51D02_0;  -- Tagged type declarations.
+with CC51D02_1;  -- Generic operation.
+
+with Report;
+procedure CC51D02 is
+
+   use CC51D02_0;                                        -- All types & ops
+                                                         -- directly visible.
+
+   -- Begin test code declarations: -----------------------
+
+   TC_Expected_1 : Blind_ID_Type'Class :=
+                   Blind_ID_Type'(SSN => "111223333");
+   TC_Expected_2 : Blind_ID_Type'Class :=
+                   Named_ID_Type'("444556666", "Doe      ");
+
+
+   TC_Initial_1  : Blind_ID_Type       := (SSN => "777889999");
+   TC_Initial_2  : Named_ID_Type       := ("777889999", "Doe      ");
+   TC_Initial_3  : Blind_ID_Type'Class := TC_Initial_2;
+
+   -- End test code declarations. -------------------------
+
+
+   package ID_Class_Lists is new FC51D00 (Blind_ID_Type'Class);
+
+   procedure Update_and_Write is new CC51D02_1 (Blind_ID_Type'Class,
+                                                ID_Class_Lists);
+
+   Blind_List  : ID_Class_Lists.List_Type;
+   Named_List  : ID_Class_Lists.List_Type;
+   Maimed_List : ID_Class_Lists.List_Type;
+
+
+begin
+   Report.Test ("CC51D02", "Formal private extension, class-wide actual: " &
+                "body of primitive subprogram executed is that of actual " &
+                "type. Check for subprograms declared in formal package");
+
+
+   Update_and_Write (Blind_List, TC_Initial_1);    -- Test root type actual.
+
+   if (ID_Class_Lists.View_Element (1, Blind_List) not in Blind_ID_Type) then
+      Report.Failed ("Result for root type actual is not in proper class");
+   elsif (ID_Class_Lists.View_Element (1, Blind_List) /= TC_Expected_1) then
+      Report.Failed ("Wrong result for root type actual");
+   end if;
+
+
+   Update_and_Write (Named_List, TC_Initial_2);    -- Test derived type actual.
+
+   if (ID_Class_Lists.View_Element (1, Named_List) not in Named_ID_Type) then
+      Report.Failed ("Result for derived type actual is not in proper class");
+   elsif (ID_Class_Lists.View_Element (1, Named_List)/= TC_Expected_2) then
+      Report.Failed ("Wrong result for derived type actual");
+   end if;
+
+
+   -- In the subtest below, an object of a class-wide type (TC_Initial_3) is
+   -- passed to Update_and_Write. It has been initialized with an object of
+   -- type Named_ID_Type, so the result should be identical to
+   -- that of the Named_ID_Type subtest (namely TC_Expected_2). Note that
+   -- a new list of Named IDs is used (Maimed_List). This is to assure test
+   -- validity, since Named_List has already been updated by a previous
+   -- subtest.
+
+   Update_and_Write (Maimed_List, TC_Initial_3);   -- Test class-wide actual.
+
+   if (ID_Class_Lists.View_Element (1, Maimed_List) not in Named_ID_Type) then
+      Report.Failed ("Result for class-wide actual is not in proper class");
+   elsif (ID_Class_Lists.View_Element (1, Maimed_List) /= TC_Expected_2) then
+      Report.Failed ("Wrong result for class-wide actual");
+   end if;
+
+
+   Report.Result;
+end CC51D02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54001.a
new file mode 100644
index 000000000..eb297d0ec
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54001.a
@@ -0,0 +1,184 @@
+-- CC54001.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 general access-to-constant type may be passed as an
+--      actual to a generic formal access-to-constant type.
+--
+-- TEST DESCRIPTION:
+--      The generic implements a stack of access objects as an array. The
+--      designated type of the formal access type is itself a formal private
+--      type declared in the same generic formal part.
+--      
+--      The generic is instantiated with an unconstrained subtype of String,
+--      which results in a stack which can accommodate strings of varying
+--      lengths (ragged array). Furthermore, the access objects to be pushed
+--      onto the stack are created both statically and dynamically, utilizing
+--      allocators and the 'Access attribute.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate to context clause
+--                          preceding CC54001_1.
+--
+--!
+
+generic
+   Size : in Positive;
+   type Element_Type (<>) is private;
+   type Element_Ptr       is access constant Element_Type;
+package CC54001_0 is -- Generic stack of pointers.
+
+   type Stack_Type is private;
+
+   procedure Push (Stack    : in out Stack_Type;
+                   Elem_Ptr : in     Element_Ptr);
+
+   procedure Pop  (Stack    : in out Stack_Type;
+                   Elem_Ptr :    out Element_Ptr);
+
+   -- ... Other operations.
+
+private
+
+   subtype Index is Positive range 1 .. (Size + 1);
+   type Stack_Type is array (Index) of Element_Ptr;  -- Last element unused.
+
+   Top : Index := 1;
+
+end CC54001_0;
+
+
+     --===================================================================--
+
+
+package body CC54001_0 is
+
+   procedure Push (Stack    : in out Stack_Type;
+                   Elem_Ptr : in     Element_Ptr) is
+   begin
+      Stack(Top) := Elem_Ptr;
+      Top := Top + 1;  -- Artificial: no Constraint_Error protection.
+   end Push;
+
+
+   procedure Pop (Stack    : in out Stack_Type;
+                  Elem_Ptr :    out Element_Ptr) is
+   begin
+      Top := Top - 1;  -- Artificial: no Constraint_Error protection.
+      Elem_Ptr := Stack(Top);
+   end Pop;
+
+end CC54001_0;
+
+
+     --===================================================================--
+
+
+with CC54001_0;      -- Generic stack of pointers.
+pragma Elaborate (CC54001_0);
+
+package CC54001_1 is
+
+   subtype Message     is String;
+   type    Message_Ptr is access constant Message;
+
+   Message_Count : constant := 4;
+
+   Message_0 : aliased constant Message := "Hello";
+   Message_1 : aliased constant Message := "Doctor";
+   Message_2 : aliased constant Message := "Name";
+   Message_3 : aliased constant Message := "Continue";
+
+
+   package Stack_of_Messages is new CC54001_0
+     (Element_Type => Message,
+      Element_Ptr  => Message_Ptr,
+      Size         => Message_Count);
+
+   Message_Stack : Stack_Of_Messages.Stack_Type;
+
+
+   procedure Create_Message_Stack;
+
+end CC54001_1;
+
+
+     --===================================================================--
+
+
+package body CC54001_1 is
+
+   procedure Create_Message_Stack is
+      -- Push access objects onto stack. Note that some are statically
+      -- allocated, and some are dynamically allocated (using an aliased
+      -- object to initialize).
+   begin
+      Stack_Of_Messages.Push (Message_Stack, Message_0'Access); -- Static.
+      Stack_Of_Messages.Push (Message_Stack,
+                              new Message'(Message_1));         -- Dynamic.
+      Stack_Of_Messages.Push (Message_Stack, Message_2'Access); -- Static.
+      Stack_Of_Messages.Push (Message_Stack,                    -- Dynamic.
+                              new Message'(Message_3));
+   end Create_Message_Stack;
+
+end CC54001_1;
+
+
+     --===================================================================--
+
+
+with CC54001_1;
+
+with Report;
+procedure CC54001 is
+
+   package Messages renames CC54001_1.Stack_Of_Messages;
+
+   Msg0, Msg1, Msg2, Msg3 : CC54001_1.Message_Ptr;
+
+begin
+   Report.Test ("CC54001", "Check that a general access-to-constant type "   &
+                           "may be passed as an actual to a generic formal " &
+                           "access-to-constant type");
+
+   CC54001_1.Create_Message_Stack;
+
+   Messages.Pop (CC54001_1.Message_Stack, Msg3);  -- Pop items off stack in the
+   Messages.Pop (CC54001_1.Message_Stack, Msg2);  -- reverse order that they
+   Messages.Pop (CC54001_1.Message_Stack, Msg1);  -- were pushed.
+   Messages.Pop (CC54001_1.Message_Stack, Msg0);
+
+   if Msg0.all /= CC54001_1.Message_0 or else
+      Msg1.all /= CC54001_1.Message_1 or else
+      Msg2.all /= CC54001_1.Message_2 or else
+      Msg3.all /= CC54001_1.Message_3
+   then
+      Report.Failed ("Items popped off of stack do not match those pushed");
+   end if;
+
+   Report.Result;
+end CC54001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54002.a
new file mode 100644
index 000000000..623f25d6c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54002.a
@@ -0,0 +1,223 @@
+-- CC54002.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 general access-to-variable type may be passed as an
+--      actual to a generic formal general access-to-variable type. Check that
+--      designated objects may be read and updated through the access value.
+--
+-- TEST DESCRIPTION:
+--      The generic implements a List of access objects as an array, which
+--      is itself a component of a record. The designated type of the formal
+--      access type is a formal private type declared in the same generic
+--      formal part.
+--
+--      The access objects to be placed in the List are created both
+--      statically and dynamically, utilizing allocators and the 'Access
+--      attribute.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate to context clause
+--                          preceding CC54002_1.
+--
+--!
+
+generic
+   Size : in Positive;
+   type Element_Type (<>) is private;
+   type Element_Ptr       is access all Element_Type;
+package CC54002_0 is -- Generic list of pointers.
+
+   subtype Index is Positive range 1 .. (Size + 1);
+
+   type List_Array is array (Index) of Element_Ptr;
+
+   type List_Type is record
+      Elements : List_Array;
+      Next     : Index := 1;    -- Next available "slot" in list.
+   end record;
+
+
+   procedure Put (List     : in out List_Type;
+                  Elem_Ptr : in     Element_Ptr;
+                  Location : in     Index);
+
+   procedure Get (List     : in out List_Type;
+                  Elem_Ptr :    out Element_Ptr;
+                  Location : in     Index);
+
+   -- ... Other operations.
+
+end CC54002_0;
+
+
+     --===================================================================--
+
+
+package body CC54002_0 is
+
+   procedure Put (List     : in out List_Type;
+                  Elem_Ptr : in     Element_Ptr;
+                  Location : in     Index) is
+   begin
+      List.Elements(Location) := Elem_Ptr;
+   end Put;
+
+
+   procedure Get (List     : in out List_Type;
+                  Elem_Ptr :    out Element_Ptr;
+                  Location : in     Index) is
+   begin  -- Artificial: no provision for getting "empty" element.
+      Elem_Ptr := List.Elements(Location);
+   end Get;
+
+end CC54002_0;
+
+
+     --===================================================================--
+
+
+with CC54002_0;      -- Generic List of pointers.
+pragma Elaborate (CC54002_0);
+
+package CC54002_1 is
+
+   subtype Lengths is Natural range 0 .. 50;
+
+   type Subscriber (NLen, ALen: Lengths := 50) is record
+      Name    : String(1 .. NLen);
+      Address : String(1 .. ALen);
+      -- ... Other components.
+   end record;
+
+   type Subscriber_Ptr is access all Subscriber;         -- General access-to-
+                                                         -- variable type.
+
+   package District_Subscription_Lists is new CC54002_0
+     (Element_Type => Subscriber,
+      Element_Ptr  => Subscriber_Ptr,
+      Size         => 100);
+
+   District_01_Subscribers : District_Subscription_Lists.List_Type;
+
+
+   New_Subscriber_01 : aliased CC54002_1.Subscriber :=
+     (12, 23, "Brown, Silas", "King's Pyland, Dartmoor");
+
+   New_Subscriber_02 : aliased CC54002_1.Subscriber :=
+     (16, 23, "Hatherly, Victor", "16A Victoria St. London");
+
+end CC54002_1;
+
+-- No body for CC54002_1.
+
+
+     --===================================================================--
+
+
+with CC54002_1;
+
+with Report;
+procedure CC54002 is
+
+   Mod_Subscriber_01 : constant CC54002_1.Subscriber :=
+     (12, 23, "Brown, Silas", "Mapleton, Dartmoor     ");
+
+   TC_Actual_01, TC_Actual_02 : CC54002_1.Subscriber_Ptr;
+
+
+   use type CC54002_1.Subscriber;  -- "/=" directly visible.
+
+begin
+   Report.Test ("CC54002", "Check that a general access-to-variable type "   &
+                           "may be passed as an actual to a generic formal " &
+                           "access-to-variable type");
+
+
+   -- Add elements to the list:
+
+   CC54002_1.District_Subscription_Lists.Put    -- Element created statically.
+     (List     => CC54002_1.District_01_Subscribers,
+      Elem_Ptr => CC54002_1.New_Subscriber_01'Access,
+      Location => 1);
+
+   CC54002_1.District_Subscription_Lists.Put    -- Element created dynamically.
+     (List     => CC54002_1.District_01_Subscribers,
+      Elem_Ptr => new CC54002_1.Subscriber'(CC54002_1.New_Subscriber_02),
+      Location => 2);
+
+
+   -- Manipulation of the objects on the list is performed below directly
+   -- through the access objects. Although such manipulation is artificial
+   -- from the perspective of this usage model, it is not artificial in
+   -- general and is necessary in order to test the objective.
+
+
+   -- Modify the first list element through the access object:
+
+   CC54002_1.District_01_Subscribers.Elements(1).Address :=      -- Update
+      "Mapleton, Dartmoor     ";      -- Implicit dereference.   -- through the
+                                                                 -- access
+                                                                 -- object.
+   -- Retrieve elements of the list:
+
+   CC54002_1.District_Subscription_Lists.Get
+     (CC54002_1.District_01_Subscribers,
+      TC_Actual_01,
+      1);
+
+   CC54002_1.District_Subscription_Lists.Get
+     (CC54002_1.District_01_Subscribers,
+      TC_Actual_02,
+      2);
+
+   -- Verify list contents in two ways: 1st verify the directly-dereferenced
+   -- access objects against the dereferenced access objects returned by Get;
+   -- 2nd verify them against objects the expected values:
+
+                                                                 -- Read
+                                                                 -- through the
+                                                                 -- access
+                                                                 -- objects.
+
+   if CC54002_1.District_01_Subscribers.Elements(1).all /= TC_Actual_01.all
+      or else
+      CC54002_1.District_01_Subscribers.Elements(2).all /= TC_Actual_02.all
+   then
+      Report.Failed ("Wrong results returned by Get");
+   
+   elsif CC54002_1.District_01_Subscribers.Elements(1).all /=
+           Mod_Subscriber_01
+         or
+         CC54002_1.District_01_Subscribers.Elements(2).all /=
+           CC54002_1.New_Subscriber_02
+   then
+      Report.Failed ("List elements do not have expected values");
+   end if;
+
+   Report.Result;
+end CC54002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54003.a
new file mode 100644
index 000000000..d8aaeaf9c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54003.a
@@ -0,0 +1,234 @@
+-- CC54003.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 general access-to-subprogram type may be passed as an
+--      actual to a generic formal access-to-subprogram type. Check that
+--      designated subprograms may be called by dereferencing the access
+--      values.
+--
+-- TEST DESCRIPTION:
+--      The generic implements a stack of access-to-subprogram objects as an
+--      array. The profile of the access-to-subprogram formal corresponds to
+--      a function which accepts a parameter of some type and returns an
+--      object of the same type.
+--      
+--      For this test, the functions for which access values will be pushed
+--      onto the stack accept a parameter of type access-to-string, lengthen
+--      the pointed-to string, then return an access object pointing to this
+--      lengthened string.
+--      
+--      The instance declares a function Execute_Stack which executes each
+--      subprogram on the stack in sequence. This function accepts some initial
+--      access-to-string, then returns an access object pointing to the
+--      lengthened string resulting from the execution of the stacked
+--      subprograms. Access-to-string objects are used rather than strings
+--      themselves because the initial string "grows" during each iteration.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate to context clause
+--                          preceding CC54003_2.
+--
+--!
+
+generic
+
+   Size : in Positive;
+
+   type Item_Type (<>) is private;
+   type Item_Ptr is access Item_Type;
+
+   type Function_Ptr is access function (Item : Item_Ptr) 
+     return Item_Ptr;
+
+package CC54003_0 is -- Generic stack of pointers.
+
+   type Stack_Type is private;
+
+   procedure Push (Stack    : in out Stack_Type;
+                   Func_Ptr : in     Function_Ptr);
+
+   function Execute_Stack (Stack         : Stack_Type;
+                           Initial_Input : Item_Ptr) return Item_Ptr;
+
+   -- ... Other operations.
+
+private
+
+   subtype Index is Positive range 1 .. (Size + 1);
+   type Stack_Type is array (Index) of Function_Ptr;       -- Last slot unused.
+
+   Top : Index := 1;                  -- Top refers to the next available slot.
+
+end CC54003_0;
+
+
+     --===================================================================--
+
+
+package body CC54003_0 is
+
+   procedure Push (Stack    : in out Stack_Type;
+                   Func_Ptr : in     Function_Ptr) is
+   begin
+      Stack(Top) := Func_Ptr;
+      Top := Top + 1;     -- Artificial: no Constraint_Error protection.
+   end Push;
+
+
+   -- Call each subprogram on the stack in sequence. For the first call, pass
+   -- Initial_Input. For succeeding calls, pass the result of the previous
+   -- call.
+
+   function Execute_Stack (Stack         : Stack_Type;
+                           Initial_Input : Item_Ptr) return Item_Ptr is
+      Result : Item_Ptr := Initial_Input;
+   begin
+      for I in reverse Index'First .. (Top - 1) loop    -- Artificial: no C_E
+         Result := Stack(I)(Result);                    -- protection.
+      end loop;
+      return Result;
+   end Execute_Stack;
+
+end CC54003_0;
+
+
+     --===================================================================--
+
+
+package CC54003_1 is
+
+   subtype Message     is String;
+   type    Message_Ptr is access Message;
+
+   function Add_Prefix (Msg_Ptr : Message_Ptr) return Message_Ptr;
+   function Add_Suffix (Msg_Ptr : Message_Ptr) return Message_Ptr;
+
+   -- ...Other operations.
+
+end CC54003_1;
+
+
+     --===================================================================--
+
+
+package body CC54003_1 is
+
+   function Add_Prefix (Msg_Ptr : Message_Ptr) return Message_Ptr is
+      Sender  : constant String := "Dummy: ";    -- Artificial; in a real
+                                                 -- application Sender might
+      New_Msg : Message := Sender & Msg_Ptr.all; -- be a call to a function.
+   begin
+      return new Message'(New_Msg);
+   end Add_Prefix;
+
+
+   function Add_Suffix (Msg_Ptr : Message_Ptr) return Message_Ptr is
+      Time : constant String := " (12:03pm)";    -- Artificial; in a real
+                                                 -- application Time might be a
+      New_Msg : Message := Msg_Ptr.all & Time;   -- be a call to a function.
+   begin
+      return new Message'(New_Msg);
+   end Add_Suffix;
+
+end CC54003_1;
+
+
+     --===================================================================--
+
+
+with CC54003_0;      -- Generic stack of pointers.
+pragma Elaborate (CC54003_0);
+
+with CC54003_1;      -- Message abstraction.
+
+package CC54003_2 is
+
+   type Operation_Ptr is access function (Msg_Ptr : CC54003_1.Message_Ptr)
+     return CC54003_1.Message_Ptr;
+
+   Maximum_Ops : constant := 4;         -- Arbitrary.
+
+   package Stack_of_Ops is new CC54003_0
+     (Item_Type    => CC54003_1.Message,
+      Item_Ptr     => CC54003_1.Message_Ptr,
+      Function_Ptr => Operation_Ptr,
+      Size         => Maximum_Ops);
+
+   Operation_Stack : Stack_Of_Ops.Stack_Type;
+
+
+   procedure Create_Operation_Stack;
+
+end CC54003_2;
+
+     --===================================================================--
+
+
+package body CC54003_2 is
+
+   procedure Create_Operation_Stack is
+   begin
+      Stack_Of_Ops.Push (Operation_Stack, CC54003_1.Add_Prefix'Access);
+      Stack_Of_Ops.Push (Operation_Stack, CC54003_1.Add_Suffix'Access);
+   end Create_Operation_Stack;
+
+end CC54003_2;
+
+
+     --===================================================================--
+
+
+with CC54003_1;  -- Message abstraction.
+with CC54003_2;  -- Message-operation stack.
+
+with Report;
+procedure CC54003 is
+
+   package Msg_Ops renames CC54003_2.Stack_Of_Ops;
+
+   Msg      : CC54003_1.Message_Ptr := new CC54003_1.Message'("Hello there");
+   Expected : CC54003_1.Message     := "Dummy: Hello there (12:03pm)";
+
+begin
+   Report.Test ("CC54003", "Check that a general access-to-subprogram type " &
+                           "may be passed as an actual to a generic formal " &
+                           "access-to-subprogram type");
+
+   CC54003_2.Create_Operation_Stack;
+
+   declare
+      Actual : CC54003_1.Message_Ptr := 
+        Msg_Ops.Execute_Stack (CC54003_2.Operation_Stack, Msg);
+   begin
+      if Actual.all /= Expected then
+         Report.Failed ("Wrong result from dereferenced subprogram execution");
+      end if;
+   end;
+
+   Report.Result;
+end CC54003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54004.a
new file mode 100644
index 000000000..0023b3a74
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54004.a
@@ -0,0 +1,295 @@
+-- CC54004.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 designated type of a generic formal pool-specific
+--      access type may be class-wide. Check that calls to primitive
+--      subprograms in the instance dispatch to the appropriate bodies when
+--      the controlling operand is a dereference of an object of the access-
+--      to-class-wide type.
+--
+-- TEST DESCRIPTION:
+--      A hierarchy of types is declared in two packages. The root type of
+--      the class is declared as abstract in a separate package. It possesses
+--      an abstract primitive subprogram Handle. A concrete type extends the
+--      root type in a second package with a component of an enumeration type.
+--      A second type extends this extension in the same package. Both
+--      derivatives override the root type's primitive subprogram with a
+--      non-abstract subprogram.
+--
+--      The generic implements a heterogeneous stack of access-to-class-wide
+--      objects in the root type's class. A subprogram declared in the
+--      generic calls Handle using dereferences of each of the class-wide
+--      objects on the stack as operand. Each call to Handle should dispatch
+--      to the appropriate body based on the tag of the operand. The
+--      overriding versions of Handle each set the component of the type to
+--      a different value. The value of the component is checked to verify
+--      that the calls dispatched correctly.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Apr 96   SAIC    ACVC 2.1: Added pragma Elaborate to context clause
+--                          preceding CC54004_3.
+--
+--!
+
+package CC54004_0 is
+
+   -- The types and operations defined here are artificial. The component
+   -- TC_Code is the only component required for testing purposes.
+
+   type TC_Code_Type is (None, Low, Medium);
+
+   type Alert is abstract tagged record              -- Abstract type.
+      TC_Code : TC_Code_Type;    -- Testing flag.
+   end record;
+
+   procedure Handle (A : in out Alert);              -- Non-abstract primitive
+                                                     -- subprogram.
+   -- ...Other operations.
+
+   type Alert_Ptr is access Alert'Class;             -- Access-to-class-wide
+                                                     -- type.
+end CC54004_0;
+
+
+     --===================================================================--
+
+
+package body CC54004_0 is
+
+   procedure Handle (A : in out Alert) is
+   begin
+      A.TC_Code := None;
+   end Handle;
+
+end CC54004_0;
+
+
+     --===================================================================--
+
+
+with CC54004_0;
+use  CC54004_0;
+package CC54004_1 is
+
+   type Low_Alert is new CC54004_0.Alert with record
+      C1 : String (1 .. 5) := "Dummy";
+      -- ...Other components.
+   end record;
+
+   procedure Handle (A : in out Low_Alert);          -- Overrides parent's
+                                                     -- operations.
+   --...Other operations.
+
+
+   type Medium_Alert is new Low_Alert with record
+      C : Integer := 6;
+      -- ...Other components.
+   end record;
+
+   procedure Handle (A : in out Medium_Alert);       -- Overrides parent's
+                                                     -- operations.
+   --...Other operations.
+
+end CC54004_1;
+
+
+     --===================================================================--
+
+package body CC54004_1 is
+
+   procedure Handle (A : in out Low_Alert) is
+   begin
+      A.TC_Code := Low;
+   end Handle;
+
+   procedure Handle (A : in out Medium_Alert) is
+   begin
+      A.TC_Code := Medium;
+   end Handle;
+
+end CC54004_1;
+
+
+     --===================================================================--
+
+
+with CC54004_0;
+generic
+   type Element_Type is abstract new CC54004_0.Alert with private;
+   type Element_Ptr  is access Element_Type'Class;
+package CC54004_2 is
+
+   type Stack_Type is private;
+
+   procedure Push (Stack     : in out Stack_Type;
+                   Elem_Ptr  : in     Element_Ptr);
+
+   procedure Pop  (Stack     : in out Stack_Type;
+                   Elem_Ptr  :    out Element_Ptr);
+
+   procedure Process_Stack (Stack : in out Stack_Type);
+
+   -- ... Other operations.
+
+private
+
+   subtype Index is Positive range 1 .. 5;
+   type Stack_Type is array (Index) of Element_Ptr;
+
+   Top : Index := 1;
+
+end CC54004_2;
+
+
+     --===================================================================--
+
+
+package body CC54004_2 is
+
+   procedure Push (Stack    : in out Stack_Type;
+                   Elem_Ptr : in     Element_Ptr) is
+   begin
+      Stack(Top) := Elem_Ptr;
+      Top := Top + 1;     -- Artificial: no Constraint_Error protection.
+   end Push;
+
+
+   procedure Pop  (Stack     : in out Stack_Type;
+                   Elem_Ptr  :    out Element_Ptr)is
+   begin
+      Top := Top - 1;     -- Artificial: no Constraint_Error protection.
+      Elem_Ptr := Stack(Top);
+   end Pop;
+
+
+   -- Call Handle for each element on the stack. Since the dereferenced access
+   -- object is of a class-wide type, all calls to Handle are dispatching. The
+   -- version of Handle called will be that declared for the type
+   -- corresponding to the tag of the operand.
+
+   procedure Process_Stack (Stack  : in out Stack_Type) is
+   begin -- Artificial: no Constraint_Error protection.
+      for I in reverse Index'First .. (Top - 1) loop
+         Handle (Stack(I).all);            -- Call dispatches based on
+      end loop;                            -- tag of operand.
+   end Process_Stack;
+
+end CC54004_2;
+
+
+     --===================================================================--
+
+
+with CC54004_0;
+with CC54004_1;
+with CC54004_2;
+pragma Elaborate (CC54004_2);
+
+package CC54004_3 is
+
+   package Alert_Stacks is new CC54004_2 (Element_Type => CC54004_0.Alert,
+                                          Element_Ptr  => CC54004_0.Alert_Ptr);
+
+   -- All overriding versions of Handle visible at the point of instantiation.
+
+   Alert_List  : Alert_Stacks.Stack_Type;
+
+   procedure TC_Create_Alert_Stack;
+
+end CC54004_3;
+
+
+     --===================================================================--
+
+
+package body CC54004_3 is
+
+   procedure TC_Create_Alert_Stack is
+   begin
+      Alert_Stacks.Push (Alert_List, new CC54004_1.Low_Alert);
+      Alert_Stacks.Push (Alert_List, new CC54004_1.Medium_Alert);
+   end TC_Create_Alert_Stack;
+
+end CC54004_3;
+
+
+     --===================================================================--
+
+
+with CC54004_0;
+with CC54004_1;
+with CC54004_3;
+
+with Report;
+procedure CC54004 is
+   TC_Low_Ptr, TC_Med_Ptr : CC54004_0.Alert_Ptr;
+   TC_Low_Actual          : CC54004_1.Low_Alert;
+   TC_Med_Actual          : CC54004_1.Medium_Alert;
+
+   use type CC54004_0.TC_Code_Type;
+begin
+   Report.Test ("CC54004", "Check that the designated type of a generic " &
+                "formal pool-specific access type may be class-wide");
+
+
+   -- Create stack of elements:
+
+   CC54004_3.TC_Create_Alert_Stack;
+
+
+   -- Commence dispatching operations on stack elements:
+
+   CC54004_3.Alert_Stacks.Process_Stack (CC54004_3.Alert_List);
+
+
+   -- Pop "handled" alerts off stack:
+
+   CC54004_3.Alert_Stacks.Pop (CC54004_3.Alert_List, TC_Med_Ptr);
+   CC54004_3.Alert_Stacks.Pop (CC54004_3.Alert_List, TC_Low_Ptr);
+
+
+   -- Verify results:
+
+   if TC_Low_Ptr.all not in CC54004_1.Low_Alert    or else
+      TC_Med_Ptr.all not in CC54004_1.Medium_Alert
+   then
+      Report.Failed ("Class-wide objects do not have expected tags");
+
+   -- The explicit dereference of the "Pop"ed pointers results in views of
+   -- the designated objects, the nominal subtypes of which are class-wide.
+   -- In order to be able to reference the component TC_Code, these views
+   -- must be converted to a specific type possessing that component.
+
+   elsif CC54004_1.Low_Alert(TC_Low_Ptr.all).TC_Code    /= CC54004_0.Low    or
+         CC54004_1.Medium_Alert(TC_Med_Ptr.all).TC_Code /= CC54004_0.Medium
+   then
+      Report.Failed ("Calls did not dispatch to expected operations");
+   end if;
+
+   Report.Result;
+end CC54004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70001.a
new file mode 100644
index 000000000..65681b072
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70001.a
@@ -0,0 +1,309 @@
+-- CC70001.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 template for a generic formal package may be a child
+--      package, and that a child instance which is an instance of the
+--      template may be passed as an actual to the formal package. Check that
+--      the visible part of the generic formal package includes the first list
+--      of basic declarative items of the package specification.
+--
+-- TEST DESCRIPTION:
+--      Declare a list abstraction in a generic package which manages lists of
+--      elements of any nonlimited type. Declare a generic child package of
+--      this package which defines additional list operations. Declare a
+--      generic subprogram which operates on lists of elements of discrete
+--      types. Provide the generic subprogram with three formal parameters:
+--      (1) a formal discrete type which represents a list element type, (2)
+--      a generic formal package with the parent list generic as template, and
+--      (3) a generic formal package with the child list generic as template.
+--      Use the formal discrete type as the generic formal actual part for the
+--      parent formal package. In the main program, declare an instance of
+--      parent, then declare an instance of the child which is itself a child
+--      the parent's instance. Pass these instances as actuals to the generic
+--      subprogram instance.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      05 Nov 95   SAIC    ACVC 2.0.1 fixes: Corrected syntax of formal
+--                          package declaration.
+--      27 Feb 97   PWB.CTA Added an elaboration pragma.
+--!
+
+generic             
+   type Element_Type is private;  -- List elems may be of any nonlimited type.
+package CC70001_0 is              -- List abstraction.
+
+   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;
+
+   -- 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 CC70001_0;
+
+
+     --==================================================================--
+
+
+package body CC70001_0 is
+
+   function End_Of_List (L : List_Type) return Boolean is
+   begin
+      return (L.Current = null);
+   end End_Of_List;
+
+
+   procedure Reset (L : in out List_Type) is
+   begin
+      L.Current := L.First;                 -- Set "current" pointer to first
+   end Reset;                               -- list element.
+
+end CC70001_0;
+
+
+     --==================================================================--
+
+
+-- Child must be generic since parent is generic. A formal parameter for
+-- "element type" can not be provided here, because then the type of list
+-- element assumed by these new operations would be different from that
+-- defined by the list type declared in the parent.
+
+generic             
+package CC70001_0.CC70001_1 is    -- Additional list operations.
+
+   -- 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);
+
+end CC70001_0.CC70001_1;
+
+
+     --==================================================================--
+
+
+package body CC70001_0.CC70001_1 is
+
+   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;
+
+end CC70001_0.CC70001_1;
+
+
+     --==================================================================--
+
+
+with CC70001_0.CC70001_1;  -- Generic list abstraction + additional operations.
+generic
+
+   -- Import the list abstraction defined in CC70001_0, as well as the
+   -- additional operations defined in CC70001_0.CC70001_1. Declare a formal
+   -- discrete type. Restrict this generic procedure to operate only on lists
+   -- of discrete elements by passing the formal discrete type as an actual
+   -- parameter to the formal (parent) package.
+
+   type Elem_Type is (<>);                  -- Discrete types only.
+   with package List_Mgr is new CC70001_0 (Elem_Type);
+   with package List_Ops is new List_Mgr.CC70001_1 (<>);
+
+procedure CC70001_2 (L : in out List_Mgr.List_Type);
+
+
+     --==================================================================--
+
+
+procedure CC70001_2 (L : in out List_Mgr.List_Type) is
+begin
+   List_Mgr.Reset (L);
+   while not List_Mgr.End_Of_List (L) loop
+      List_Ops.Write_Element (L, Elem_Type'First);
+   end loop;
+end CC70001_2;
+
+
+     --==================================================================--
+
+
+package CC70001_3 is
+
+   type Points is range 0 .. 10;
+
+   -- ... Various other types used by the application.
+
+end CC70001_3;
+
+
+-- No body for CC70001_3;
+
+
+     --==================================================================--
+
+
+-- Declare instances of the generic list packages for the discrete type.
+-- In order to establish that the type passed as an actual to the parent
+-- generic (CC70001_0) is the one utilized by the child generic (CC70001_1),
+-- the instance of the child must itself be declared as a child of the
+-- instance of the parent. Since only library units may have or be children,
+-- both instances must be library units.
+
+with CC70001_0;            -- Generic list abstraction.
+with CC70001_3;            -- Package containing discrete type declaration.
+pragma Elaborate (CC70001_0);
+package CC70001_4 is new CC70001_0 (CC70001_3.Points);
+
+with CC70001_0.CC70001_1;  -- Generic extension to list abstraction.
+with CC70001_4;
+package CC70001_4.CC70001_5 is new CC70001_4.CC70001_1;
+
+
+     --==================================================================--
+
+
+with CC70001_2;            -- Generic "zeroing" op for lists of discrete types.
+with CC70001_3;            -- Types for application.
+with CC70001_4.CC70001_5;  -- Discrete list abstraction + additional ops.
+
+with Report;
+procedure CC70001 is
+
+   package Lists_Of_Scores renames CC70001_4;
+   package Score_Ops       renames CC70001_4.CC70001_5;
+
+   Scores : Lists_Of_Scores.List_Type;                -- List of points.
+
+   procedure Reset_All_Scores is new CC70001_2        -- Operation on lists of
+     (Elem_Type => CC70001_3.Points,                  -- points.
+      List_Mgr  => Lists_Of_Scores,
+      List_Ops  => Score_Ops);
+
+
+   -- Begin test code declarations: -----------------------
+
+   type TC_Score_Array is array (1 .. 3) of CC70001_3.Points;
+
+   TC_Initial_Values : constant TC_Score_Array := (2, 4, 6);
+   TC_Final_Values   : constant TC_Score_Array := (0, 0, 0);
+
+   TC_Correct_Initial_Values : Boolean := False;
+   TC_Correct_Final_Values   : Boolean := False;
+
+
+   procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is
+   begin                                  -- Initial list contains 3 scores
+      for I in TC_Score_Array'Range loop  -- with the values 2, 4, and 6.
+         Score_Ops.Add_Element (L, TC_Initial_Values(I));
+      end loop;
+   end TC_Initialize_List;
+
+
+   procedure TC_Verify_List (L        : in out Lists_of_Scores.List_Type;
+                             Expected : in     TC_Score_Array;
+                             OK       :    out Boolean) is
+      Actual : TC_Score_Array;
+   begin                                  -- Verify that all scores have been
+      Lists_of_Scores.Reset (L);          -- set to zero.
+      for I in TC_Score_Array'Range loop
+         Score_Ops.Read_Element (L, Actual(I));
+      end loop;
+      OK := (Actual = Expected);
+   end TC_Verify_List;
+
+   -- End test code declarations. -------------------------
+
+
+begin
+   Report.Test ("CC70001", "Check that the template for a generic formal "   &
+                "package may be a child package, and that a child instance " &
+                "which is an instance of the template may be passed as an "  &
+                "actual to the formal package. Check that the visible part " &
+                "of the generic formal package includes the first list of "  &
+                "basic declarative items of the package specification");
+
+   TC_Initialize_List (Scores);
+   TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
+
+   if not TC_Correct_Initial_Values then
+      Report.Failed ("List contains incorrect initial values");
+   end if;
+
+   Reset_All_Scores (Scores);
+   TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
+
+   if not TC_Correct_Final_Values then
+      Report.Failed ("List contains incorrect final values");
+   end if;
+
+   Report.Result;
+end CC70001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70002.a
new file mode 100644
index 000000000..3e4d9c40b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70002.a
@@ -0,0 +1,241 @@
+-- CC70002.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 formal package actual part may specify actual parameters
+--      for a generic formal package. Check that these actual parameters may
+--      be formal types, formal objects, and formal subprograms. Check that
+--      the visible part of the generic formal package includes the first list
+--      of basic declarative items of the package specification, and that if
+--      the formal package actual part is (<>), it also includes the generic
+--      formal part of the template for the formal package.
+--
+-- TEST DESCRIPTION:
+--      Declare a generic package which defines a "signature" for mathematical
+--      groups. Declare a second generic package which defines a
+--      two-dimensional matrix abstraction. Declare a third generic package
+--      which provides mathematical group operations for two-dimensional
+--      matrices. Provide this third generic with two formal parameters: (1)
+--      a generic formal package with the second generic as template and a
+--      (<>) actual part, and (2) a generic formal package with the first
+--      generic as template and an actual part that takes a formal type,
+--      object, and subprogram from the first formal package as actuals.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+generic              -- Mathematical group signature.
+
+   type Group_Type is private;
+
+   Identity : in Group_Type;
+
+   with function Operation (Left, Right : Group_Type) return Group_Type;
+-- with function Inverse... (omitted for brevity).
+
+package CC70002_0 is
+
+   function Power (Left : Group_Type; Right : Integer) return Group_Type;
+
+   -- ... Other group operations.
+
+end CC70002_0;
+
+
+     --==================================================================--
+
+
+package body CC70002_0 is
+
+   -- The implementation of Power is purely artificial; the validity of its
+   -- implementation in the context of the abstraction is irrelevant to the
+   -- feature being tested.
+
+   function Power (Left : Group_Type; Right : Integer) return Group_Type is
+      Result : Group_Type := Identity;
+   begin
+      Result := Operation (Result, Left);  -- All this really does is add
+      return Result;                       -- one to each matrix element.
+   end Power;
+
+end CC70002_0;
+
+
+     --==================================================================--
+
+
+generic          -- 2D matrix abstraction.
+   type Element_Type is range <>;
+
+   type Abscissa is range <>;
+   type Ordinate is range <>;
+
+   type Matrix_2D is array (Abscissa, Ordinate) of Element_Type;
+package CC70002_1 is
+
+   Add_Ident : constant Matrix_2D := (Abscissa => (others => 1));
+                                                          -- Artificial for
+                                                          -- testing purposes.
+   -- ... Other identity matrices.
+
+
+   function "+" (A, B : Matrix_2D) return Matrix_2D;
+
+   -- ... Other operations.
+
+end CC70002_1;
+
+
+     --==================================================================--
+
+
+package body CC70002_1 is
+
+   function "+" (A, B : Matrix_2D) return Matrix_2D is
+      C : Matrix_2D;
+   begin
+      for I in Abscissa loop
+         for J in Ordinate loop
+            C(I,J) := A(I,J) + B(I,J);
+         end loop;
+      end loop;
+      return C;
+   end "+";
+
+end CC70002_1;
+
+
+     --==================================================================--
+
+
+with CC70002_0;  -- Mathematical group signature.
+with CC70002_1;  -- 2D matrix abstraction.
+
+generic          -- Mathematical 2D matrix addition group.
+
+   with package Matrix_Ops is new CC70002_1 (<>);
+
+   -- Although the restriction of the formal package below to signatures
+   -- describing addition groups, and then only for 2D matrices, is rather
+   -- artificial in the context of this "application," the passing of types,
+   -- objects, and subprograms as actuals to a formal package is not.
+
+   with package Math_Sig is new CC70002_0
+     (Group_Type => Matrix_Ops.Matrix_2D,
+      Identity   => Matrix_Ops.Add_Ident,
+      Operation  => Matrix_Ops."+");
+
+package CC70002_2 is
+
+   -- Add two matrices that are to be multiplied by coefficients:
+   -- [ ] = CA*[ ] + CB*[ ].
+
+   function Add_Matrices_With_Coefficients (A  : Matrix_Ops.Matrix_2D;
+                                            CA : Integer;
+                                            B  : Matrix_Ops.Matrix_2D;
+                                            CB : Integer)
+     return Matrix_Ops.Matrix_2D;
+
+   -- ...Other operations.
+
+end CC70002_2;
+
+
+     --==================================================================--
+
+
+package body CC70002_2 is
+
+   function Add_Matrices_With_Coefficients (A  : Matrix_Ops.Matrix_2D;
+                                            CA : Integer;
+                                            B  : Matrix_Ops.Matrix_2D;
+                                            CB : Integer)
+     return Matrix_Ops.Matrix_2D is
+      Left, Right : Matrix_Ops.Matrix_2D;
+   begin
+      Left  := Math_Sig.Power (A, CA);      -- Multiply 1st array by its coeff.
+      Right := Math_Sig.Power (B, CB);      -- Multiply 2nd array by its coeff.
+      return (Matrix_Ops."+" (Left, Right));-- Add these two arrays.
+   end Add_Matrices_With_Coefficients;
+
+end CC70002_2;
+
+
+     --==================================================================--
+
+
+with CC70002_0;  -- Mathematical group signature.
+with CC70002_1;  -- 2D matrix abstraction.
+with CC70002_2;  -- Mathematical 2D matrix addition group.
+
+with Report;
+procedure CC70002 is
+
+   subtype Cell_Type     is Positive range 1 .. 3;
+   subtype Category_Type is Positive range 1 .. 2;
+
+   type Data_Points is new Natural range 0 .. 100;
+
+   type Table_Type is array (Cell_Type, Category_Type) of Data_Points;
+
+   package Data_Table_Support is new CC70002_1 (Data_Points,
+                                                Cell_Type,
+                                                Category_Type,
+                                                Table_Type);
+
+   package Data_Table_Addition_Group is new CC70002_0
+     (Group_Type => Table_Type,
+      Identity   => Data_Table_Support.Add_Ident,
+      Operation  => Data_Table_Support."+");
+
+   package Table_Add_Ops is new CC70002_2
+     (Data_Table_Support, Data_Table_Addition_Group);
+
+
+   Scores_Table : Table_Type := ( (  12,   0),
+                                  (  21,  33),
+                                  (  49,   9) );
+   Expected     : Table_Type := ( (  26,   2),
+                                  (  44,  68),
+                                  ( 100,  20) );
+
+begin
+   Report.Test ("CC70002", "Check that a generic formal package actual " &
+                "part may specify formal objects, formal subprograms, " &
+                "and formal types");
+
+   Scores_Table := Table_Add_Ops.Add_Matrices_With_Coefficients
+                     (Scores_Table, 2,
+                      Scores_Table, 1);
+
+   if (Scores_Table /= Expected) then
+      Report.Failed ("Incorrect result for multi-dimensional array");
+   end if;
+
+   Report.Result;
+end CC70002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70003.a
new file mode 100644
index 000000000..d2309fc36
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70003.a
@@ -0,0 +1,212 @@
+-- CC70003.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 actual passed to a formal package may be a formal
+--      access-to-subprogram type. Check that the visible part of the generic
+--      formal package includes the first list of basic declarative items of
+--      the package specification.
+--
+-- TEST DESCRIPTION:
+--      Declare a list abstraction in a generic package which manages lists of
+--      elements of any nonlimited type (foundation code). Declare a generic
+--      package which supports the execution of lists of operations. Provide
+--      the generic package with two formal parameters: (1) a formal access-
+--      to-function type, and (2) a generic formal package with the list
+--      abstraction package as template. Within a procedure declared in the
+--      list-execution package, utilize information about the profile of
+--      the functions in the list. Declare a package which declares functions
+--      matching the profile of the formal access-to-subprogram type. In the
+--      main program, create a list of pointers to the functions declared in
+--      the package, instantiate the list abstraction and list-execution
+--      packages, and use the list-execution procedure to call each of the
+--      functions in the list in sequence.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+generic
+   type Element_Type is private;
+package CC70003_0 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 CC70003_0;
+
+
+     --==================================================================--
+
+
+package body CC70003_0 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 CC70003_0;
+
+
+     --==================================================================--
+
+
+with CC70003_0;    -- Generic list abstraction.
+generic
+   type Elem_Type is access function (F : Float) return Float;
+   with package List_Mgr is new CC70003_0 (Elem_Type);
+package CC70003_1 is  -- This package simulates support for executing lists
+                      -- of operations.
+
+   procedure Execute_List (L : List_Mgr.List_Type; F : in out Float);
+
+   -- ... Other operations.
+
+end CC70003_1;
+
+
+     --==================================================================--
+
+
+package body CC70003_1 is
+
+   procedure Execute_List (L : List_Mgr.List_Type; F : in out Float) is
+   begin
+      for I in L'Range loop
+         F := List_Mgr.View_Element(I, L)(F);   -- Execute next operation in
+      end loop;                                 -- list with current value of
+   end Execute_List;                            -- F as operand.
+
+
+end CC70003_1;
+
+
+     --==================================================================--
+
+
+package CC70003_2 is
+
+   function Sine (F : Float) return Float;
+   function Exp  (F : Float) return Float;
+
+   -- ... Other math functions.
+
+end CC70003_2;
+
+
+     --==================================================================--
+
+
+package body CC70003_2 is
+
+   -- The implementations of the functions below are purely artificial; the
+   -- validity of their implementations in the context of the abstraction is
+   -- irrelevant to the feature being tested.
+
+   function Sine (F : Float) return Float is
+   begin
+      return (-0.15);
+   end Sine;
+
+   function Exp (F : Float) return Float is
+   begin
+      if (F = 0.0) then
+         return (-0.69);
+      else
+         return (2.0);  -- This branch should be taken.
+      end if;
+   end Exp;
+
+end CC70003_2;
+
+
+     --==================================================================--
+
+
+with CC70003_0;    -- Generic list abstraction.
+with CC70003_1;  -- Generic operation-list abstraction.
+with CC70003_2;  -- Math library.
+
+with Report;
+procedure CC70003 is
+
+   type Math_Op is access function (F : Float) return Float;
+
+   package Math_Op_Lists        is new CC70003_0 (Math_Op);
+   package Math_Op_List_Support is new CC70003_1 (Math_Op, Math_Op_Lists);
+
+   Sin_Ptr : Math_Op := CC70003_2.Sine'Access;
+   Exp_Ptr : Math_Op := CC70003_2.Exp'Access;
+
+   Op_List : Math_Op_Lists.List_Type;
+
+   Operand  : Float := 0.0;
+   Expected : Float := 2.0;
+
+
+begin
+   Report.Test ("CC70003", "Check that the actual passed to a formal " &
+                "package may be a formal access-to-subprogram type");
+
+   Math_Op_Lists.Write_Element (1, Op_List, Sin_Ptr);
+   Math_Op_Lists.Write_Element (2, Op_List, Exp_Ptr);
+
+   Math_Op_List_Support.Execute_List (Op_List, Operand);
+
+   if (Operand /= Expected) then
+      Report.Failed ("Incorrect results from indirect function calls");
+   end if;
+
+   Report.Result;
+end CC70003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70a01.a
new file mode 100644
index 000000000..ac92f437a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70a01.a
@@ -0,0 +1,208 @@
+-- CC70A01.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 visible part of a generic formal package includes the
+--      first list of basic declarative items of the package specification.
+--      Check for a generic package which declares a formal package with (<>)
+--      as its actual part.
+--
+-- TEST DESCRIPTION:
+--      The "first list of basic declarative items" of a package specification
+--      is the visible part of the package. Thus, the declarations in the
+--      visible part of the actual instance corresponding to a formal
+--      package are available in the generic which declares the formal package.
+--       
+--      Declare a generic package which simulates a complex integer abstraction
+--      (foundation code).
+--
+--      Declare a second, library-level generic package which utilizes the
+--      first generic package as a generic formal package (with a (<>)
+--      actual_part). In the second generic package, declare objects, types,
+--      and operations in terms of the objects, types, and operations declared
+--      in the first generic package.
+--
+--      In the main program, instantiate the first generic package, then
+--      instantiate the second generic package and pass the first instance
+--      to it as a generic actual parameter. Check that the operations in
+--      the second instance perform as expected.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FC70A00;         -- Generic complex integer operations.
+
+generic               -- Generic complex matrix operations.
+   with package Complex_Package is new FC70A00 (<>);
+package CC70A01_0 is
+
+   type Complex_Matrix_Type is                        -- 1st index is matrix
+      array (Positive range <>, Positive range <>)    -- row, 2nd is column.
+        of Complex_Package.Complex_Type;              
+   Dimension_Mismatch : exception;
+
+
+   function Identity_Matrix (Size : Positive)         -- Create identity matrix
+     return Complex_Matrix_Type;                      -- of specified size.
+
+   function "*" (Left  : Complex_Matrix_Type;         -- Multiply two complex
+                 Right : Complex_Matrix_Type)         -- matrices.
+     return Complex_Matrix_Type;
+
+end CC70A01_0;
+
+
+     --==================================================================--
+
+
+package body CC70A01_0 is  -- Generic complex matrix operations.
+
+   use Complex_Package;
+
+               --==============================================--
+
+   function Inner_Product (Left, Right : Complex_Matrix_Type;
+                           Row, Column : Positive)    -- Compute inner product
+     return Complex_Package.Complex_Type is           -- for matrix-multiply.
+
+      Result : Complex_Type := Zero;                  
+      subtype Vector_Size is Positive range Left'Range(2);
+
+   begin  -- Inner_Product.
+      for I in Vector_Size loop
+         Result := Result +                           -- Complex_Package."+".
+                   (Left(Row, I) * Right(I, Column)); -- Complex_Package."*".
+      end loop;
+      return (Result);
+   end Inner_Product;
+
+               --==============================================--
+
+   function Identity_Matrix (Size : Positive) return Complex_Matrix_Type is
+      Result : Complex_Matrix_Type (1 .. Size, 1 .. Size) :=
+               (others => (others => Zero));          -- Zeroes everywhere...
+   begin
+      for I in 1 .. Size loop
+         Result (I, I) := One;                        -- Ones on the diagonal.
+      end loop;
+      return (Result);
+   end Identity_Matrix;
+
+               --==============================================--
+
+   function "*" (Left  : Complex_Matrix_Type; Right : Complex_Matrix_Type)
+     return Complex_Matrix_Type is
+
+      subtype Rows    is Positive range Left'Range(1);
+      subtype Columns is Positive range Right'Range(2);
+
+      Result : Complex_Matrix_Type(Rows, Columns);
+   begin
+      if Left'Length(2) /= Right'Length(1) then       -- # columns of Left must
+                                                      -- match # rows of Right.
+         raise Dimension_Mismatch;                    
+      else
+         for I in Rows loop
+            for J in Columns loop
+                Result(I, J) := Inner_Product (Left, Right, I, J);
+            end loop;
+         end loop;
+         return (Result);
+      end if;
+   end "*";
+
+end CC70A01_0;
+
+
+     --==================================================================--
+
+
+with Report;
+
+with FC70A00;    -- Generic complex integer operations.
+with CC70A01_0;  -- Generic complex matrix operations.
+
+procedure CC70A01 is
+
+   type My_Integer is range -100 .. 100;
+
+   package My_Complex_Package is new FC70A00   (My_Integer);
+   package My_Matrix_Package  is new CC70A01_0 (My_Complex_Package);
+
+   use My_Complex_Package,                                -- All user-defined
+       My_Matrix_Package;                                 -- operators directly
+                                                          -- visible.
+
+   subtype Matrix_2x2 is Complex_Matrix_Type (1 .. 2, 1 .. 2);
+   subtype Matrix_2x3 is Complex_Matrix_Type (1 .. 2, 1 .. 3);
+
+   function C (Real, Imag : My_Integer) return Complex_Type renames Complex;
+
+begin  -- Main program.
+
+   Report.Test ("CC70A01", "Check that the visible part of a generic " &
+                "formal package includes the first list of basic " &
+                "declarative items of the package specification. Check " &
+                "for a generic package where formal package has (<>) " &
+                "actual part");
+
+   declare
+      Identity_2x2 : Matrix_2x2 := Identity_Matrix (Size => 2);
+      Operand_2x3  : Matrix_2x3 := ( ( C(1, 2), C(3, 6), C(5, 1) ),
+                                     ( C(0, 3), C(7, 9), C(3, 4) ) );
+      Result_2x3   : Matrix_2x3 := ( others => ( others => Zero ) );
+   begin
+
+      begin -- Block #1.
+         Result_2x3 := Identity_2x2 * Operand_2x3; -- Should return
+                                                   -- Operand_2x3.
+         if (Result_2x3 /= Operand_2x3) then
+            Report.Failed ("Incorrect results from matrix multiplication");
+         end if;
+      exception
+         when others =>
+            Report.Failed ("Unexpected exception raised - Block #1");
+      end;  -- Block #1.
+
+
+      begin -- Block #2.
+         Result_2x3 := Operand_2x3 * Identity_2x2;  -- Can't multiply 2x3
+                                                    -- by 2x2.
+         Report.Failed ("Exception Dimension_Mismatch not raised");
+      exception
+         when Dimension_Mismatch =>
+            null;
+         when others             =>
+            Report.Failed ("Unexpected exception raised - Block #2");
+      end;  -- Block #2.
+
+   end;
+
+   Report.Result;
+
+end CC70A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70a02.a
new file mode 100644
index 000000000..3601ce443
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70a02.a
@@ -0,0 +1,193 @@
+-- CC70A02.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 visible part of a generic formal package includes the
+--      first list of basic declarative items of the package specification.
+--      Check for a generic subprogram which declares a formal package with
+--      (<>) as its actual part.
+--
+-- TEST DESCRIPTION:
+--      The "first list of basic declarative items" of a package specification
+--      is the visible part of the package. Thus, the declarations in the
+--      visible part of the actual instance corresponding to a formal
+--      package are available in the generic which declares the formal package.
+--       
+--      Declare a generic package which simulates a complex integer abstraction
+--      (foundation code).
+--
+--      Declare a second generic package which defines a "signature" for
+--      mathematical groups. Declare a generic function within a package
+--      which utilizes the second generic package as a generic formal package
+--      (with a (<>) actual_part).
+--
+--      In the main program, instantiate the first generic package, then
+--      instantiate the second generic package with objects, types, and
+--      operations declared in the first instance.
+--
+--      Instantiate the generic function and pass the second instance
+--      to it as a generic actual parameter. Check that the instance of the
+--      generic function performs as expected.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+generic               -- Mathematical group signature.
+
+   type Group_Type is private;
+
+   Identity : in Group_Type;
+
+   with function Operation (Left, Right : Group_Type) return Group_Type;
+   with function Inverse   (Right : Group_Type)       return Group_Type;
+
+package CC70A02_0 is end;
+
+-- No body for CC70A02_0.
+
+
+     --==================================================================--
+
+
+with CC70A02_0;       -- Mathematical group signature.
+
+package CC70A02_1 is  -- Mathematical group operations.
+
+   --                                  --
+   -- Generic formal package used here --
+   --                                  --
+
+   generic            -- Powers for mathematical groups.
+      with package Group is new CC70A02_0 (<>);
+   function Power (Left : Group.Group_Type; Right : Integer)
+     return Group.Group_Type;
+
+
+end CC70A02_1;
+
+
+     --==================================================================--
+
+
+package body CC70A02_1 is  -- Mathematical group operations.
+
+
+
+   function Power (Left : Group.Group_Type; Right : Integer)
+     return Group.Group_Type is
+      Result : Group.Group_Type := Group.Identity;
+   begin
+      for I in 1 .. abs(Right) loop                 -- Repeat group operations
+         Result := Group.Operation (Result, Left);  -- the specified number of
+      end loop;                                     -- times.
+
+      if Right < 0 then                             -- If specified power is
+         return Group.Inverse (Result);             -- negative, return the
+      else                                          -- inverse of the result.
+         return Result;                             -- If it is zero, return
+      end if;                                       -- the identity.
+   end Power;
+
+
+end CC70A02_1;
+
+
+     --==================================================================--
+
+
+with Report;
+
+with FC70A00;    -- Complex integer abstraction.
+with CC70A02_0;  -- Mathematical group signature.
+with CC70A02_1;  -- Mathematical group operations.
+
+procedure CC70A02 is
+
+   -- Declare an instance of complex integers:
+
+   type My_Integer is range -100 .. 100;
+   package Complex_Integers is new FC70A00 (My_Integer);
+
+
+   -- Define an addition group for complex integers:
+
+   package Complex_Addition_Group is new CC70A02_0
+     (Group_Type => Complex_Integers.Complex_Type,  -- For complex integers...
+      Identity   => Complex_Integers.Zero,          -- Additive identity.
+      Operation  => Complex_Integers."+",           -- Additive operation.
+      Inverse    => Complex_Integers."-");          -- Additive inverse.
+
+   function Complex_Multiplication is new           -- Multiplication of a
+     CC70A02_1.Power(Complex_Addition_Group);       -- complex integer by a
+                                                    -- constant.
+
+
+   -- Define a multiplication group for complex integers:
+
+   package Complex_Multiplication_Group is new CC70A02_0
+     (Group_Type => Complex_Integers.Complex_Type,  -- For complex integers...
+      Identity   => Complex_Integers.One,           -- Multiplicative identity.
+      Operation  => Complex_Integers."*",           -- Multiplicative oper.
+      Inverse    => Complex_Integers.Reciprocal);   -- Multiplicative inverse.
+
+   function Complex_Exponentiation is new           -- Exponentiation of a
+     CC70A02_1.Power(Complex_Multiplication_Group); -- complex integer by a
+                                                    -- constant.
+
+   use Complex_Integers;
+
+
+begin  -- Main program.
+
+   Report.Test ("CC70A02", "Check that the visible part of a generic " &
+                "formal package includes the first list of basic " &
+                "declarative items of the package specification. Check " &
+                "for a generic subprogram where formal package has (<>) " &
+                "actual part");
+
+   declare
+      Mult_Operand         : constant Complex_Type := Complex ( -4,  9);
+      Exp_Operand          : constant Complex_Type := Complex (  0, -7);
+
+      Expected_Mult_Result : constant Complex_Type := Complex ( 28, -63);
+      Expected_Exp_Result  : constant Complex_Type := Complex (-49,   0);
+   begin
+
+      if Complex_Multiplication (Mult_Operand, -7) /= Expected_Mult_Result then
+         Report.Failed ("Incorrect results from complex multiplication");
+      end if;
+
+      if Complex_Exponentiation (Exp_Operand, 2) /= Expected_Exp_Result then
+         Report.Failed ("Incorrect results from complex exponentiation");
+      end if;
+
+   end;
+
+   Report.Result;
+
+end CC70A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70b01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70b01.a
new file mode 100644
index 000000000..6c514e17b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70b01.a
@@ -0,0 +1,170 @@
+-- CC70B01.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 formal package actual part may specify actual parameters
+--      for a generic formal package. Check that a use clause in the generic
+--      formal part provides direct visibility of declarations within the
+--      generic formal package. Check that the scope of such a use clause
+--      extends to the generic subprogram body. Check that the visible part of
+--      the generic formal package includes the first list of basic
+--      declarative items of the package specification.
+--
+--      Check the case where the formal package is declared in a generic
+--      subprogram.
+--
+-- TEST DESCRIPTION:
+--      Declare a list abstraction in a generic package which manages lists of
+--      elements of any nonlimited type (foundation code). Declare a generic
+--      subprogram which operates on lists of elements of discrete types.
+--      Provide the generic subprogram with two formal parameters: (1) a
+--      formal discrete type which represents a list element type, and (2) a
+--      generic formal package with the list abstraction package as template.
+--      Use the formal discrete type as the generic formal actual part for the
+--      formal package. Include a use clause for the formal package in the
+--      generic subprogram formal part.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FC70B00.A
+--         CC70B01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+-- Declare a generic subprogram which performs an operation on lists of
+-- discrete objects.
+
+with FC70B00;  -- Generic list abstraction.
+generic
+
+   -- Import the list abstraction defined in FC70B00. To ensure that only
+   -- list abstraction instances defining lists of *discrete* elements will be
+   -- accepted as actuals to this generic, declare a formal discrete type and
+   -- pass it as an actual parameter to the formal package.
+   --
+   -- Only instances declared for the same discrete type as that used to
+   -- instantiate this generic subprogram will be accepted.
+
+   type Elem_Type is (<>);                  -- Discrete types only.
+   with package List_Mgr is new FC70B00 (Elem_Type);
+
+   use List_Mgr;                            -- Use clause for formal package.
+
+procedure CC70B01_0 (L : in out List_Type); -- List_Mgr.List_Type directly
+                                            -- visible.
+
+
+     --==================================================================--
+
+
+procedure CC70B01_0 (L : in out List_Type) is  -- Declarations in List_Mgr
+begin                                          -- still directly visible.
+   Reset (L);
+   while not End_Of_List (L) loop
+      Write_Element (L, Elem_Type'First);      -- This statement assumes
+   end loop;                                   -- Elem_Type is discrete.
+end CC70B01_0;
+
+
+     --==================================================================--
+
+
+with FC70B00;    -- Generic list abstraction.
+with CC70B01_0;  -- Generic "zeroing" operation for lists of discrete types.
+
+with Report;
+procedure CC70B01 is
+
+   type Points is range 0 .. 10;                    -- Discrete type.
+   package Lists_of_Scores is new FC70B00 (Points); -- List-of-points
+                                                    -- abstraction.
+   Scores : Lists_of_Scores.List_Type;              -- List of points.
+
+   procedure Reset_All_Scores is new                -- Operation on lists of
+     CC70B01_0 (Points, Lists_of_Scores);           -- points.
+
+
+   -- Begin test code declarations: -----------------------
+
+   type TC_Score_Array is array (1 .. 3) of Points;
+
+   TC_Initial_Values : constant TC_Score_Array := (2, 4, 6);
+   TC_Final_Values   : constant TC_Score_Array := (0, 0, 0);
+
+   TC_Correct_Initial_Values : Boolean := False;
+   TC_Correct_Final_Values   : Boolean := False;
+
+
+   procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is
+   begin                                  -- Initial list contains 3 scores
+      for I in TC_Score_Array'Range loop  -- with the values 2, 4, and 6.
+         Lists_of_Scores.Add_Element (L, TC_Initial_Values(I));
+      end loop;
+   end TC_Initialize_List;
+
+
+   procedure TC_Verify_List (L        : in out Lists_of_Scores.List_Type;
+                             Expected : in     TC_Score_Array;
+                             OK       :    out Boolean) is
+      Actual : TC_Score_Array;
+   begin                                  -- Verify that all scores have been
+      Lists_of_Scores.Reset (L);          -- set to zero.
+      for I in TC_Score_Array'Range loop
+         Lists_of_Scores.Read_Element (L, Actual(I));
+      end loop;
+      OK := (Actual = Expected);
+   end TC_Verify_List;
+
+   -- End test code declarations. -------------------------
+
+
+begin
+   Report.Test ("CC70B01", "Check that a library-level generic subprogram "   &
+                "may have a formal package as a formal parameter, and that "  &
+                "the generic formal actual part may specify explicit actual " &
+                "parameters. Check that a use clause is legal in the "        &
+                "generic formal part");
+
+   TC_Initialize_List (Scores);
+   TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
+
+   if not TC_Correct_Initial_Values then
+      Report.Failed ("List contains incorrect initial values");
+   end if;
+
+   Reset_All_Scores (Scores);
+   TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
+
+   if not TC_Correct_Final_Values then
+      Report.Failed ("List contains incorrect final values");
+   end if;
+
+   Report.Result;
+end CC70B01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70b02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70b02.a
new file mode 100644
index 000000000..d27eea843
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70b02.a
@@ -0,0 +1,222 @@
+-- CC70B02.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 formal package actual part may specify actual parameters
+--      for a generic formal package. Check that such an actual parameter may
+--      be a formal parameter of a previously declared formal package
+--      (with a (<>) actual part). Check that a use clause in the generic
+--      formal part provides direct visibility of declarations within the
+--      generic formal package, including formal parameters (if the formal
+--      package has a (<>) actual part). Check that the scope of such a use
+--      clause extends to the generic subprogram body. Check that the visible
+--      part of the generic formal package includes the first list of basic
+--      declarative items of the package specification.
+--
+--      Check the case where the formal package is declared in a generic
+--      package.
+--
+-- TEST DESCRIPTION:
+--      Declare a list abstraction in a generic package which manages lists of
+--      elements of any nonlimited type (foundation code). Declare a second
+--      generic package which declares operations on discrete types. Declare
+--      a third generic package which combines the abstractions of the first
+--      two generics and declares operations on lists of elements of discrete
+--      types. Provide the third generic package with two formal parameters:
+--      (1) a generic formal package with the discrete operation package as
+--      template, and (2) a generic formal package with the list abstraction
+--      package as template. Use the formal discrete type of the discrete
+--      operations generic as the generic formal actual part for the second
+--      formal package. Include a use clause for the first formal package in
+--      the third generic package formal part.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FC70B00.A
+--         CC70B02.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+generic
+   type Discrete_Type is (<>);  -- Discrete types only.
+package CC70B02_0 is            -- Discrete type operations.
+
+   procedure Double (Object : in out Discrete_Type);
+
+   -- ... Other operations on discrete objects.
+
+end CC70B02_0;
+
+
+     --==================================================================--
+
+
+package body CC70B02_0 is
+
+   procedure Double (Object : in out Discrete_Type) is
+      Doubled_Position : Integer := Discrete_Type'Pos (Object) * 2;
+   begin
+      -- ... Error-checking code omitted for brevity.
+      Object := Discrete_Type'Val (Doubled_Position);
+   end Double;
+
+end CC70B02_0;
+
+
+     --==================================================================--
+
+
+with CC70B02_0;                  -- Discrete type operations.
+with FC70B00;                    -- List abstraction.
+generic
+
+   -- Import both the discrete-operation and list abstractions. To ensure that
+   -- only list abstraction instances defining lists of *discrete* elements
+   -- will be accepted as actuals to this generic, pass the formal discrete
+   -- type from the discrete-operation abstraction as an actual parameter to
+   -- the list-abstraction formal package.
+   --
+   -- Only list instances declared for the same discrete type as that used
+   -- to instantiate the discrete-operation package will be accepted.
+
+   with package Discrete_Ops is new CC70B02_0 (<>);
+
+   use Discrete_Ops;             -- Discrete_Ops directly visible.
+
+   with package List_Mgr is new FC70B00 (Discrete_Type);  -- Discrete_Type is
+                                                          -- formal parameter
+                                                          -- of template for
+                                                          -- Discrete_Ops.
+package CC70B02_1 is             -- Discrete list operations.
+
+   procedure Double_List (L : in out List_Mgr.List_Type);
+
+   -- ... Other operations on lists of discrete objects.
+
+end CC70B02_1;
+
+
+     --==================================================================--
+
+
+package body CC70B02_1 is
+
+   procedure Double_List (L : in out List_Mgr.List_Type) is
+      Element : Discrete_Type;  -- Formal part of Discrete_Ops template
+   begin                        -- is directly visible here.
+      List_Mgr.Reset (L);
+      while not List_Mgr.End_Of_List (L) loop
+         List_Mgr.View_Element (L, Element);
+         Double (Element);
+         List_Mgr.Write_Element (L, Element);
+      end loop;
+   end Double_List;
+
+end CC70B02_1;
+
+
+     --==================================================================--
+
+
+with FC70B00;    -- Generic list abstraction.
+with CC70B02_0;  -- Generic discrete type operations.
+with CC70B02_1;  -- Generic discrete list operations.
+
+with Report;
+procedure CC70B02 is
+
+   type Points is range 0 .. 100;                   -- Discrete type.
+
+   package Points_Ops is new CC70B02_0 (Points);    -- Points-type operations.
+   package Lists_of_Points is new FC70B00 (Points); -- Points lists.
+   package Points_List_Ops is new                   -- Points-list operations.
+     CC70B02_1 (Points_Ops, Lists_Of_Points);
+      
+   Scores : Lists_of_Points.List_Type;              -- List of points.
+
+
+   -- Begin test code declarations: -----------------------
+
+   type TC_Score_Array is array (1 .. 3) of Points;
+
+   TC_Initial_Values : constant TC_Score_Array := (23, 15,  0);
+   TC_Final_Values   : constant TC_Score_Array := (46, 30,  0);
+
+   TC_Correct_Initial_Values : Boolean := False;
+   TC_Correct_Final_Values   : Boolean := False;
+
+
+   procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is
+   begin                                  -- Initial list contains 3 scores
+      for I in TC_Score_Array'Range loop  -- with the values 23, 15, and 0.
+         Lists_Of_Points.Add_Element (L, TC_Initial_Values(I));
+      end loop;
+   end TC_Initialize_List;
+
+
+   procedure TC_Verify_List (L        : in out Lists_Of_Points.List_Type;
+                             Expected : in     TC_Score_Array;
+                             OK       :    out Boolean) is
+      Actual : TC_Score_Array;
+   begin                                  -- Verify that all scores have been
+      Lists_Of_Points.Reset (L);          -- set to zero.
+      for I in TC_Score_Array'Range loop
+         Lists_Of_Points.Read_Element (L, Actual(I));
+      end loop;
+      OK := (Actual = Expected);
+   end TC_Verify_List;
+
+   -- End test code declarations. -------------------------
+
+
+begin
+   Report.Test ("CC70B02", "Check that a library-level generic package "      &
+                "may have a formal package as a formal parameter, and that "  &
+                "the generic formal actual part may specify explicit actual " &
+                "parameters (including a formal parameter of a previously "   &
+                "declared formal package). Check that a use clause is legal " &
+                "in the generic formal part");
+
+   TC_Initialize_List (Scores);
+   TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
+
+   if not TC_Correct_Initial_Values then
+      Report.Failed ("List contains incorrect initial values");
+   end if;
+
+   Points_List_Ops.Double_List (Scores);
+   TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
+
+   if not TC_Correct_Final_Values then
+      Report.Failed ("List contains incorrect final values");
+   end if;
+
+   Report.Result;
+end CC70B02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70c01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70c01.a
new file mode 100644
index 000000000..f22ad01e7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70c01.a
@@ -0,0 +1,187 @@
+-- CC70C01.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 generic formal package is an instance. Specifically,
+--      check that a generic formal package may be passed as an actual
+--      parameter in an instantiation of a generic package. Check that the
+--      visible part of the generic formal package includes the first list of
+--      basic declarative items of the package specification.
+--
+-- TEST DESCRIPTION:
+--      A generic formal package is a package, and is an instance.
+--
+--      Declare a list type in a generic package for lists of elements of any
+--      nonlimited type (foundation code). Declare a second generic package
+--      which declares operations for the list type, and parameterize it with
+--      a generic formal package with the list-type package as template
+--      (foundation code). Declare a third generic package which declares
+--      additional operations for the list type, and parameterize it just like
+--      the second generic package. Declare an instance of the second generic
+--      in the spec of the third generic, passing the formal package as the
+--      actual.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FC70C00.A
+--         CC70C01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FC70C00_0;                -- List abstraction.
+with FC70C00_1;                -- Basic list operations.
+generic
+   with package Lists is new FC70C00_0 (<>);
+package CC70C01_0 is           -- Additional list operations.
+
+   -- Instantiate a generic package (FC70C00_1) with a generic formal package
+   -- (Lists). This ensures that the package passed as an actual corresponding
+   -- to Lists is the same one passed as an actual to FC70C00_1. Thus, all list
+   -- operations from both FC70C00_1 and this package operate on lists of the
+   -- same element type.
+
+   package Basic_List_Ops is new FC70C00_1 (Lists);
+
+
+   End_of_List_Reached : exception;
+
+
+   -- Read from current element and advance "current" pointer.
+   procedure Read_Element (L : in out Lists.List_Type;
+                           E :    out Lists.Element_Type);
+
+   -- Add element to end of list.
+   procedure Add_Element (L : in out Lists.List_Type;
+                          E : in     Lists.Element_Type);
+
+end CC70C01_0;
+
+
+     --==================================================================--
+
+
+package body CC70C01_0 is
+
+   procedure Read_Element (L : in out Lists.List_Type;
+                           E :    out Lists.Element_Type) is
+   begin
+      if Basic_List_Ops.End_Of_List (L) then  -- Use of op from the previous
+         raise End_Of_List_Reached;           -- generic package.
+      else
+         E         := L.Current.Item;         -- Retrieve current element.
+         L.Current := L.Current.Next;         -- Advance "current" pointer.
+      end if;
+   end Read_Element;
+
+
+   procedure Add_Element (L : in out Lists.List_Type;
+                          E : in     Lists.Element_Type) is
+      New_Node : Lists.Node_Pointer := new Lists.Node_Type'(E, null); 
+      use type Lists.Node_Pointer;
+   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;
+
+
+end CC70C01_0;
+
+
+     --==================================================================--
+
+
+with FC70C00_0;  -- Generic list abstraction.
+with CC70C01_0;  -- Additional generic list operations.
+
+with Report;
+procedure CC70C01 is
+
+   type Points is range 0 .. 100;                     -- Discrete type.
+
+   package Lists_of_Points is new FC70C00_0 (Points); -- Points lists.
+
+   package Points_List_Ops is new                     -- Points-list ops.
+     CC70C01_0 (Lists_Of_Points);
+      
+   Scores : Lists_of_Points.List_Type;                -- List of points.
+
+
+   -- Begin test code declarations: -----------------------
+
+   type TC_Score_Array is array (1 .. 3) of Points;
+
+   TC_List_Values : constant TC_Score_Array := (23, 15,  0);
+
+   TC_Correct_List_Values : Boolean := False;
+
+
+   procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is
+   begin                                  -- Initial list contains 3 scores
+      for I in TC_Score_Array'Range loop  -- with the values 23, 15, and 0.
+         Points_List_Ops.Add_Element (L, TC_List_Values(I));
+      end loop;
+   end TC_Initialize_List;
+
+
+   procedure TC_Verify_List (L        : in out Lists_Of_Points.List_Type;
+                             Expected : in     TC_Score_Array;
+                             OK       :    out Boolean) is
+      Actual : TC_Score_Array;
+   begin
+      Points_List_Ops.Basic_List_Ops.Reset (L);
+      for I in TC_Score_Array'Range loop
+         Points_List_Ops.Read_Element (L, Actual(I));
+      end loop;
+      OK := (Actual = Expected);
+   end TC_Verify_List;
+
+   -- End test code declarations. -------------------------
+
+
+begin
+
+   Report.Test ("CC70C01", "Check that a generic formal package may be " &
+                "passed as an actual in an instantiation of a generic " &
+                "package");
+
+   TC_Initialize_List (Scores);
+   TC_Verify_List (Scores, TC_List_Values, TC_Correct_List_Values);
+
+   if not TC_Correct_List_Values then
+      Report.Failed ("List contains incorrect values");
+   end if;
+
+   Report.Result;
+
+end CC70C01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70c02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70c02.a
new file mode 100644
index 000000000..f479193b5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70c02.a
@@ -0,0 +1,192 @@
+-- CC70C02.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 generic formal package is an instance. Specifically,
+--      check that a generic formal package may be passed as an actual
+--      parameter to another generic formal package. Check that the
+--      visible part of the generic formal package includes the first list of
+--      basic declarative items of the package specification.
+--
+-- TEST DESCRIPTION:
+--      A generic formal package is a package, and is an instance.
+--
+--      Declare a list type in a generic package for lists of elements of any
+--      nonlimited type (foundation code). Declare a second generic package
+--      which declares operations for the list type, and parameterize it with
+--      a generic formal package with the list-type package as template
+--      (foundation code). Declare a third generic package which declares
+--      additional operations for the list type, and parameterize it with two
+--      generic formal packages, one with the list-type package as template,
+--      the other with the second generic package as template. Use the first
+--      formal package as the generic formal actual part for the second formal
+--      package.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FC70C00.A
+--         CC70C02.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FC70C00_0;                -- List abstraction.
+with FC70C00_1;                -- Basic list operations.
+generic
+
+   -- Import both the list-type abstraction defined in FC70C00_0 and the basic
+   -- list operations defined in FC70C00_1. To ensure that only basic operation
+   -- instances for lists of the same element type as that used to instantiate
+   -- the list type are accepted as actuals to this generic, pass the list-type
+   -- formal package as an actual parameter to the list-operation formal
+   -- package.
+
+   with package Lists          is new FC70C00_0 (<>);
+   with package Basic_List_Ops is new FC70C00_1 (Lists);
+package CC70C02_0 is           -- Additional list operations.
+
+   End_of_List_Reached : exception;
+
+
+   -- Read from current element and advance "current" pointer.
+   procedure Read_Element (L : in out Lists.List_Type;
+                           E :    out Lists.Element_Type);
+
+   -- Add element to end of list.
+   procedure Add_Element (L : in out Lists.List_Type;
+                          E : in     Lists.Element_Type);
+
+end CC70C02_0;
+
+
+     --==================================================================--
+
+
+package body CC70C02_0 is
+
+   procedure Read_Element (L : in out Lists.List_Type;
+                           E :    out Lists.Element_Type) is
+   begin
+      if Basic_List_Ops.End_Of_List (L) then  -- Use of op from the previous
+         raise End_Of_List_Reached;           -- generic package.
+      else
+         E         := L.Current.Item;         -- Retrieve current element.
+         L.Current := L.Current.Next;         -- Advance "current" pointer.
+      end if;
+   end Read_Element;
+
+
+   procedure Add_Element (L : in out Lists.List_Type;
+                          E : in     Lists.Element_Type) is
+      New_Node : Lists.Node_Pointer := new Lists.Node_Type'(E, null); 
+      use type Lists.Node_Pointer;
+   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;
+
+
+end CC70C02_0;
+
+
+     --==================================================================--
+
+
+with FC70C00_0;  -- Generic list type abstraction.
+with FC70C00_1;  -- Generic list operations.
+with CC70C02_0;  -- Additional generic list operations.
+
+with Report;
+procedure CC70C02 is
+
+   type Points is range 0 .. 100;                     -- Discrete type.
+
+   package Lists_of_Points is new FC70C00_0 (Points); -- Points lists.
+
+   package Basic_Point_Ops is new                     -- Basic points-list ops.
+     FC70C00_1 (Lists_Of_Points);
+
+   package Points_List_Ops is new                     -- More points-list ops.
+     CC70C02_0 (Lists          => Lists_Of_Points,
+                Basic_List_Ops => Basic_Point_Ops);
+
+   Scores : Lists_of_Points.List_Type;                -- List of points.
+
+
+   -- Begin test code declarations: -----------------------
+
+   type TC_Score_Array is array (1 .. 3) of Points;
+
+   TC_List_Values : constant TC_Score_Array := (23, 15,  0);
+
+   TC_Correct_List_Values : Boolean := False;
+
+
+   procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is
+   begin                                  -- Initial list contains 3 scores
+      for I in TC_Score_Array'Range loop  -- with the values 23, 15, and 0.
+         Points_List_Ops.Add_Element (L, TC_List_Values(I));
+      end loop;
+   end TC_Initialize_List;
+
+
+   procedure TC_Verify_List (L        : in out Lists_Of_Points.List_Type;
+                             Expected : in     TC_Score_Array;
+                             OK       :    out Boolean) is
+      Actual : TC_Score_Array;
+   begin
+      Basic_Point_Ops.Reset (L);
+      for I in TC_Score_Array'Range loop
+         Points_List_Ops.Read_Element (L, Actual(I));
+      end loop;
+      OK := (Actual = Expected);
+   end TC_Verify_List;
+
+   -- End test code declarations. -------------------------
+
+
+begin
+
+   Report.Test ("CC70C02", "Check that a generic formal package may be " &
+                "passed as an actual to another formal package");
+
+   TC_Initialize_List (Scores);
+   TC_Verify_List (Scores, TC_List_Values, TC_Correct_List_Values);
+
+   if not TC_Correct_List_Values then
+      Report.Failed ("List contains incorrect values");
+   end if;
+
+   Report.Result;
+
+end CC70C02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd10001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd10001.a
new file mode 100644
index 000000000..6b44067c9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd10001.a
@@ -0,0 +1,300 @@
+-- CD10001.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 representation items may contain nonstatic expressions
+--      in the case that each expression in  the representation item is a
+--      name that statically denotes a constant declared before the entity.
+--
+--
+-- TEST DESCRIPTION:
+--      For each of the specific items in the objective, this test checks
+--      an example of each of the categories of representation specification
+--      that are applicable to that objective, to wit:
+--        address clause ....................... Expressions need not be static
+--        alignment clause ..................... Expressions must be static
+--        bit order clause ..................... Not tested
+--        component size clause ................ Expressions must be static
+--        enumeration representation clause .... Expressions must be static
+--        external tag clause .................. Expressions must be static
+--        Import, Export and Convention pragmas  Not tested
+--        input clause ......................... Not tested
+--        output clause ........................ Not tested
+--        Pack pragma .......................... Not tested
+--        read clause .......................... Not tested
+--        record representation clause ......... Expressions must be static
+--        size clause .......................... Expressions must be static
+--        small clause ......................... Expressions must be static
+--        storage pool clause .................. Not tested
+--        storage size clause .................. Expressions must be static
+--        write clause ......................... Not tested
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute.
+--
+--      For implementations not validating against Annex C:
+--        if this test compiles without error messages at compilation,
+--        it must bind and execute.
+--
+-- PASS/FAIL CRITERIA:
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute, report PASSED, and complete normally,
+--        otherwise the test FAILS
+--
+--      For implementations not validating against Annex C:
+--        PASSING behavior is:
+--          this test executes, reports PASSED, and completes normally
+--        or
+--          this test executes and reports NOT_APPLICABLE
+--        or
+--          this test produces at least one error message at compilation, and
+--          the error message is associated with one of the items marked:
+--             -- N/A => ERROR.
+--
+--      All other behaviors are FAILING.
+--
+
+-- CHANGE HISTORY:
+--      11 JUL 95   SAIC  Initial version
+--      10 MAR 97   PWB.CTA Made Nonstatic_Entity nonstatic; changed
+--                        Tenths'Small from 1.0/32.0 to 1.0/10.0,
+--                        as expected by the later check; improved
+--                        internal documentation.
+--      16 FEB 98   EDS   Modified test documentation.
+--      24 NOV 98   RLB   Changed Tenths'Small to 1.0/32.0, as this is
+--                        necessary so that all implementations can
+--                        process this test. (3.5.9(21) means non-binary
+--                        smalls are optional.)
+--      11 MAR 99   RLB   Merged versions. Most EDS changes removed (as
+--                        they made the test less applicable than the ACAA
+--                        version).
+--!
+
+----------------------------------------------------------------- CD10001_0
+
+with System;
+with System.Storage_Elements;
+with Impdef;
+with SPPRT13;
+package CD10001_0 is
+
+  -- a few types and objects to work with.
+
+  type Int is range -2048 .. 2047;
+  My_Int : Int := 1024;
+
+  type Enumeration is (First, Second, Third, Fourth, Fifth);
+
+  -- a few names that statically denote constants:
+
+  Nonstatic_Entity : constant System.Address :=                  -- Non-static
+     System.Storage_Elements."+" 
+       ( SPPRT13.Variable_Address, 
+         System.Storage_Elements.Storage_Offset'(0) );
+
+  Tag_String : constant String := Impdef.External_Tag_Value;     -- Static
+  -- Check to ensure that Tag_String is static
+  Tag_String_Length : constant := Tag_String'Length;
+
+  A_Reasonable_Size_Value : constant := System.Storage_Unit;     -- Static
+ 
+  Zero  : constant := 0;                                         -- Static
+  One   : constant := 1;                                         -- Static
+  Two   : constant := 2;                                         -- Static
+  Three : constant := 3;                                         -- Static
+  Four  : constant := 4;                                         -- Static
+  Five  : constant := 5;                                         -- Static
+
+  K : constant Int := My_Int;                                    -- Non-Static
+
+--      Check that representation items containing nonstatic expressions are
+--      supported in the case that the representation item is a name that
+--      statically denotes a constant declared before the entity.
+--
+--        address clause
+--        Expression must be static - RM 13.3(12)
+
+  Object_Address : Enumeration;
+    for Object_Address'Address use Nonstatic_Entity;          -- N/A => ERROR.
+
+--        alignment clause
+--        Expression must be static - RM 13.3(25)
+
+  Object_Alignment : Enumeration;
+    for Object_Alignment'Alignment use One;                   -- N/A => ERROR.
+  
+--        bit order clause
+-- no interesting test can be specified
+
+--        component size clause
+--        Expression must be static - RM 13.3(69)
+
+  type Array_With_Components is array(1..10) of Enumeration;
+    for Array_With_Components'Component_Size
+      use A_Reasonable_Size_Value;                            -- N/A => ERROR.
+
+--        enumeration representation clause
+--        Expressions must be static - RM 13.4(6)
+
+  type Enumeration_1 is (First, Second, Third);
+  for Enumeration_1 use (First => One, Second => Two, Third => Three);
+
+--        external tag clause
+--        Expression must be static - RM 13.3(75)
+
+  type Some_Tagged_Type is tagged null record;
+    for Some_Tagged_Type'External_Tag use Tag_String;         -- N/A => ERROR.
+
+--        Import, Export and Convention pragmas
+-- no interesting test can be specified
+
+--        input clause
+-- no interesting test can be specified
+
+--        output clause
+-- no interesting test can be specified
+
+--        Pack pragma
+-- no interesting test can be specified
+
+--        read clause
+-- no interesting test can be specified
+
+--        record representation clause
+--        Expressions must be static - RM 13.3(10)
+
+  type Record_To_Layout is record
+    Bit_0 : Boolean;
+    Bit_1 : Boolean;
+  end record;
+    for Record_To_Layout use record                           -- N/A => ERROR.
+      Bit_0 at Zero range Zero..Zero;                         -- N/A => ERROR.
+      Bit_1 at Zero range Four..Four;                         -- N/A => ERROR.
+    end record;                                               -- N/A => ERROR.
+
+--        size clause
+--        Expression must be static - RM 13.3(41)
+
+  Object_Size : Enumeration;
+    for Object_Size'Size use A_Reasonable_Size_Value;         -- N/A => ERROR.
+
+--        small clause
+--        Expression must be static - RM 3.5.10(2)
+
+  type Tenths is delta 0.1 range 0.0..10.0;
+    for Tenths'Small use 1.0 / (Two ** Five);                 -- N/A => ERROR.
+
+--        storage pool clause
+--        Not tested
+
+--        storage size clause
+--        Expression may be non-static - RM 13.11(15)
+  type Reference is access Record_To_Layout;
+    for Reference'Storage_Size use Four * K;                  -- N/A => ERROR.
+
+
+--        write clause
+-- no interesting test can be specified
+
+  procedure TC_Check_Values;
+
+end CD10001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+package body CD10001_0 is
+
+  use type System.Address;
+
+  procedure Assert( Truth : Boolean; Message: String ) is
+  begin
+    if not Truth then
+      TCTouch.Implementation_Check( Message );
+    end if;
+  end Assert;
+
+  procedure TC_Check_Values is
+    Record_Object : Record_To_Layout;
+  begin
+
+    Assert(Object_Address'Address = Nonstatic_Entity,
+           "Object not at specified address");
+
+    Assert(Object_Alignment'Alignment >= One,
+           "Object not at specified alignment");
+
+    Assert(Array_With_Components'Component_Size = A_Reasonable_Size_Value,
+           "Array Components not specified size");
+
+-- I don't see how to reliably check this one:
+--
+--  type Enumeration_1 is (First, Second, Third);
+--  for Enumeration_1 use (First => One, Second => Two, Third => Three);
+
+    Assert(Some_Tagged_Type'External_Tag = Tag_String,
+           "External_Tag not specified value");
+    Assert(Record_Object.Bit_0'First_Bit = Zero,
+          "Record object First_Bit not zero");
+
+    Assert(Record_Object.Bit_1'Last_Bit = Four,
+          "Record object Last_Bit not four");
+
+    Assert(Object_Size'Size = A_Reasonable_Size_Value,
+           "Object size not specified value");
+
+    Assert(Tenths'Small = 1.0 / Two ** Five,
+           "Tenths small not specified value");
+
+    Assert(Reference'Storage_Size = 4096, -- Four * K,
+           "Reference storage size not specified value");
+
+  end TC_Check_Values;
+
+end CD10001_0;
+
+------------------------------------------------------------------- CD10001
+
+with Report;
+with CD10001_0;
+
+procedure CD10001 is
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD10001", "Check that representation items containing " &
+                          "nonstatic expressions are supported in the " &
+                          "case that the representation item is a name " &
+                          "that statically denotes a constant declared " &
+                          "before the entity" );
+
+  CD10001_0.TC_Check_Values;
+
+  Report.Result;
+
+end CD10001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd10002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd10002.a
new file mode 100644
index 000000000..fc56d4299
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd10002.a
@@ -0,0 +1,1198 @@
+-- CD10002.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that operational items are allowed in some contexts where
+--    representation items are not:
+--
+--       1 - Check that the name of an incompletely defined type can be used
+--           when specifying an operational item. (RM95/TC1 7.3(5)).
+--
+--       2 - Check that operational items can be specified for a descendant of
+--           a generic formal untagged type. (RM95/TC1 13.1(10)).
+--
+--       3 - Check that operational items can be specified for a derived
+--           untagged type even if the parent type is a by-reference type or
+--           has user-defined primitive subprograms. (RM95/TC1 13.1(11/1)).
+--
+--    (Defect Report 8652/0009, as reflected in Technical Corrigendum 1).
+--
+-- CHANGE HISTORY:
+--    19 JAN 2001   PHL   Initial version.
+--     3 DEC 2001   RLB   Reformatted for ACATS.
+--     3 OCT 2002   RLB   Corrected incorrect type derivations.
+--
+--!
+with Ada.Streams;
+use Ada.Streams;
+package CD10002_0 is
+
+    type Kinds is (Read, Write, Input, Output);
+    type Counts is array (Kinds) of Natural;
+
+    generic
+        type T is private;
+    package Nonlimited_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 Nonlimited_Stream_Ops;
+
+    generic
+        type T (<>) is limited private; -- Should be self-initializing.
+        C : in out T;
+    package Limited_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 Limited_Stream_Ops;
+
+end CD10002_0;
+
+
+package body CD10002_0 is
+
+    package body Nonlimited_Stream_Ops is
+        Cnts : Counts := (others => 0);
+        X : T; -- Initialized by Write/Output.
+
+        procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is
+        begin
+            X := Item;
+            Cnts (Write) := Cnts (Write) + 1;
+        end Write;
+
+        function Input (Stream : access Root_Stream_Type'Class) return T is
+        begin
+            Cnts (Input) := Cnts (Input) + 1;
+            return X;
+        end Input;
+
+        procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is
+        begin
+            Cnts (Read) := Cnts (Read) + 1;
+            Item := X;
+        end Read;
+
+        procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is
+        begin
+            X := Item;
+            Cnts (Output) := Cnts (Output) + 1;
+        end Output;
+
+        function Get_Counts return Counts is
+        begin
+            return Cnts;
+        end Get_Counts;
+
+    end Nonlimited_Stream_Ops;
+
+    package body Limited_Stream_Ops is
+        Cnts : Counts := (others => 0);
+
+        procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is
+        begin
+            Cnts (Write) := Cnts (Write) + 1;
+        end Write;
+
+        function Input (Stream : access Root_Stream_Type'Class) return T is
+        begin
+            Cnts (Input) := Cnts (Input) + 1;
+            return C;
+        end Input;
+
+        procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is
+        begin
+            Cnts (Read) := Cnts (Read) + 1;
+        end Read;
+
+        procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is
+        begin
+            Cnts (Output) := Cnts (Output) + 1;
+        end Output;
+
+        function Get_Counts return Counts is
+        begin
+            return Cnts;
+        end Get_Counts;
+
+    end Limited_Stream_Ops;
+
+end CD10002_0;
+
+
+with Ada.Streams;
+use Ada.Streams;
+package CD10002_1 is
+
+    type Dummy_Stream is new Root_Stream_Type with null record;
+    procedure Read (Stream : in out Dummy_Stream;
+                    Item : out Stream_Element_Array;
+                    Last : out Stream_Element_Offset);
+    procedure Write (Stream : in out Dummy_Stream;
+                     Item : Stream_Element_Array);
+
+end CD10002_1;
+
+
+with Report;
+use Report;
+package body CD10002_1 is
+
+    procedure Read (Stream : in out Dummy_Stream;
+                    Item : out Stream_Element_Array;
+                    Last : out Stream_Element_Offset) is
+    begin
+        Failed ("Unexpected call to the Read operation of Dummy_Stream");
+    end Read;
+
+    procedure Write (Stream : in out Dummy_Stream;
+                     Item : Stream_Element_Array) is
+    begin
+        Failed ("Unexpected call to the Write operation of Dummy_Stream");
+    end Write;
+
+end CD10002_1;
+
+
+with Ada.Streams;
+use Ada.Streams;
+with CD10002_0;
+package CD10002_Deriv is
+
+    -- Parent has user-defined subprograms.
+
+    type T1 is new Boolean;
+    function Is_Odd (X : Integer) return T1;
+
+    type T2 is
+        record
+            F : Float;
+        end record;
+    procedure Print (X : T2);
+
+    type T3 is array (Boolean) of Duration;
+    function "+" (L, R : T3) return T3;
+
+    -- Parent is by-reference.  No need to check the case where the parent
+    -- is tagged, because the defect report only deals with untagged types.
+
+    task type T4 is
+    end T4;
+
+    protected type T5 is
+    end T5;
+
+    type T6 (D : access Integer := new Integer'(2)) is limited null record;
+
+    type T7 is array (Character) of T6;
+
+    package P is
+        type T8 is limited private;
+    private
+        type T8 is new T5;
+    end P;
+
+    type Nt1 is new T1;
+    type Nt2 is new T2;
+    type Nt3 is new T3;
+    type Nt4 is new T4;
+    type Nt5 is new T5;
+    type Nt6 is new T6;
+    type Nt7 is new T7;
+    type Nt8 is new P.T8;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base;
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Nt1'Base);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt2;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt3;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt4;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt5;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt6;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt7;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt8;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8);
+
+    for Nt1'Write use Write;
+    for Nt1'Read use Read;
+    for Nt1'Output use Output;
+    for Nt1'Input use Input;
+
+    for Nt2'Write use Write;
+    for Nt2'Read use Read;
+    for Nt2'Output use Output;
+    for Nt2'Input use Input;
+
+    for Nt3'Write use Write;
+    for Nt3'Read use Read;
+    for Nt3'Output use Output;
+    for Nt3'Input use Input;
+
+    for Nt4'Write use Write;
+    for Nt4'Read use Read;
+    for Nt4'Output use Output;
+    for Nt4'Input use Input;
+
+    for Nt5'Write use Write;
+    for Nt5'Read use Read;
+    for Nt5'Output use Output;
+    for Nt5'Input use Input;
+
+    for Nt6'Write use Write;
+    for Nt6'Read use Read;
+    for Nt6'Output use Output;
+    for Nt6'Input use Input;
+
+    for Nt7'Write use Write;
+    for Nt7'Read use Read;
+    for Nt7'Output use Output;
+    for Nt7'Input use Input;
+
+    for Nt8'Write use Write;
+    for Nt8'Read use Read;
+    for Nt8'Output use Output;
+    for Nt8'Input use Input;
+
+    -- All these variables are self-initializing.
+    C4 : Nt4;
+    C5 : Nt5;
+    C6 : Nt6;
+    C7 : Nt7;
+    C8 : Nt8;
+
+    package Nt1_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt1'Base);
+    package Nt2_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt2);
+    package Nt3_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt3);
+    package Nt4_Ops is new CD10002_0.Limited_Stream_Ops (Nt4, C4);
+    package Nt5_Ops is new CD10002_0.Limited_Stream_Ops (Nt5, C5);
+    package Nt6_Ops is new CD10002_0.Limited_Stream_Ops (Nt6, C6);
+    package Nt7_Ops is new CD10002_0.Limited_Stream_Ops (Nt7, C7);
+    package Nt8_Ops is new CD10002_0.Limited_Stream_Ops (Nt8, C8);
+
+end CD10002_Deriv;
+
+
+package body CD10002_Deriv is
+
+    function Is_Odd (X : Integer) return T1 is
+    begin
+        return True;
+    end Is_Odd;
+    procedure Print (X : T2) is
+    begin
+        null;
+    end Print;
+    function "+" (L, R : T3) return T3 is
+    begin
+        return (False => L (False) + R (True), True => L (True) + R (False));
+    end "+";
+    task body T4 is
+    begin
+        null;
+    end T4;
+    protected body T5 is
+    end T5;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base)
+       renames Nt1_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base
+       renames Nt1_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt1'Base)
+       renames Nt1_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base)
+       renames Nt1_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2)
+       renames Nt2_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt2
+       renames Nt2_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2)
+       renames Nt2_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2)
+       renames Nt2_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3)
+       renames Nt3_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt3
+       renames Nt3_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3)
+       renames Nt3_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3)
+       renames Nt3_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4)
+       renames Nt4_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt4
+       renames Nt4_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4)
+       renames Nt4_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4)
+       renames Nt4_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5)
+       renames Nt5_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt5
+       renames Nt5_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5)
+       renames Nt5_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5)
+       renames Nt5_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6)
+       renames Nt6_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt6
+       renames Nt6_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6)
+       renames Nt6_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6)
+       renames Nt6_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7)
+       renames Nt7_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt7
+       renames Nt7_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7)
+       renames Nt7_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7)
+       renames Nt7_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8)
+       renames Nt8_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt8
+       renames Nt8_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8)
+       renames Nt8_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8)
+       renames Nt8_Ops.Output;
+
+end CD10002_Deriv;
+
+
+with Ada.Streams;
+use Ada.Streams;
+with CD10002_0;
+generic
+    type T1 is (<>);
+    type T2 is range <>;
+    type T3 is mod <>;
+    type T4 is digits <>;
+    type T5 is delta <>;
+    type T6 is delta <> digits <>;
+    type T7 is access T3;
+    type T8 is new Boolean;
+    type T9 is private;
+    type T10 (<>) is limited private; -- Should be self-initializing.
+    C10 : in out T10;
+    type T11 is array (T1) of T2;
+package CD10002_Gen is
+
+    -- Direct descendants.
+    type Nt1 is new T1;
+    type Nt2 is new T2;
+    type Nt3 is new T3;
+    type Nt4 is new T4;
+    type Nt5 is new T5;
+    type Nt6 is new T6;
+    type Nt7 is new T7;
+    type Nt8 is new T8;
+    type Nt9 is new T9;
+    type Nt10 is new T10;
+    type Nt11 is new T11;
+
+    -- Indirect descendants (only pick two, a limited one and a non-limited
+    -- one).
+    type Nt12 is new Nt10;
+    type Nt13 is new Nt11;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base;
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Nt1'Base);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt2'Base;
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Nt2'Base);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2'Base);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt3'Base;
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Nt3'Base);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3'Base);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt4'Base;
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Nt4'Base);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4'Base);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt5'Base;
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Nt5'Base);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5'Base);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt6'Base;
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Nt6'Base);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6'Base);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt7;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt8'Base;
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Nt8'Base);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8'Base);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt9);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt9;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt9);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt9);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt10);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt10;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt10);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt10);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt11);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt11;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt11);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt11);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt12);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt12;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt12);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt12);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt13);
+    function Input (Stream : access Root_Stream_Type'Class) return Nt13;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt13);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt13);
+
+    for Nt1'Write use Write;
+    for Nt1'Read use Read;
+    for Nt1'Output use Output;
+    for Nt1'Input use Input;
+
+    for Nt2'Write use Write;
+    for Nt2'Read use Read;
+    for Nt2'Output use Output;
+    for Nt2'Input use Input;
+
+    for Nt3'Write use Write;
+    for Nt3'Read use Read;
+    for Nt3'Output use Output;
+    for Nt3'Input use Input;
+
+    for Nt4'Write use Write;
+    for Nt4'Read use Read;
+    for Nt4'Output use Output;
+    for Nt4'Input use Input;
+
+    for Nt5'Write use Write;
+    for Nt5'Read use Read;
+    for Nt5'Output use Output;
+    for Nt5'Input use Input;
+
+    for Nt6'Write use Write;
+    for Nt6'Read use Read;
+    for Nt6'Output use Output;
+    for Nt6'Input use Input;
+
+    for Nt7'Write use Write;
+    for Nt7'Read use Read;
+    for Nt7'Output use Output;
+    for Nt7'Input use Input;
+
+    for Nt8'Write use Write;
+    for Nt8'Read use Read;
+    for Nt8'Output use Output;
+    for Nt8'Input use Input;
+
+    for Nt9'Write use Write;
+    for Nt9'Read use Read;
+    for Nt9'Output use Output;
+    for Nt9'Input use Input;
+
+    for Nt10'Write use Write;
+    for Nt10'Read use Read;
+    for Nt10'Output use Output;
+    for Nt10'Input use Input;
+
+    for Nt11'Write use Write;
+    for Nt11'Read use Read;
+    for Nt11'Output use Output;
+    for Nt11'Input use Input;
+
+    for Nt12'Write use Write;
+    for Nt12'Read use Read;
+    for Nt12'Output use Output;
+    for Nt12'Input use Input;
+
+    for Nt13'Write use Write;
+    for Nt13'Read use Read;
+    for Nt13'Output use Output;
+    for Nt13'Input use Input;
+
+    type Null_Record is null record;
+
+    package Nt1_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt1'Base);
+    package Nt2_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt2'Base);
+    package Nt3_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt3'Base);
+    package Nt4_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt4'Base);
+    package Nt5_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt5'Base);
+    package Nt6_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt6'Base);
+    package Nt7_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt7);
+    package Nt8_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt8'Base);
+    package Nt9_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt9);
+    package Nt11_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt11);
+    package Nt13_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt13);
+
+    function Get_Nt10_Counts return CD10002_0.Counts;
+    function Get_Nt12_Counts return CD10002_0.Counts;
+
+end CD10002_Gen;
+
+
+package body CD10002_Gen is
+
+    use CD10002_0;
+
+    Nt10_Cnts : Counts := (others => 0);
+    Nt12_Cnts : Counts := (others => 0);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base)
+       renames Nt1_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base
+       renames Nt1_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt1'Base)
+       renames Nt1_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base)
+       renames Nt1_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2'Base)
+       renames Nt2_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt2'Base
+       renames Nt2_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2'Base)
+       renames Nt2_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2'Base)
+       renames Nt2_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3'Base)
+       renames Nt3_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt3'Base
+       renames Nt3_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3'Base)
+       renames Nt3_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3'Base)
+       renames Nt3_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4'Base)
+       renames Nt4_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt4'Base
+       renames Nt4_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4'Base)
+       renames Nt4_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4'Base)
+       renames Nt4_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5'Base)
+       renames Nt5_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt5'Base
+       renames Nt5_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5'Base)
+       renames Nt5_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5'Base)
+       renames Nt5_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6'Base)
+       renames Nt6_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt6'Base
+       renames Nt6_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6'Base)
+       renames Nt6_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6'Base)
+       renames Nt6_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7)
+       renames Nt7_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt7
+       renames Nt7_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7)
+       renames Nt7_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7)
+       renames Nt7_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8'Base)
+       renames Nt8_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt8'Base
+       renames Nt8_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8'Base)
+       renames Nt8_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8'Base)
+       renames Nt8_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt9)
+       renames Nt9_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt9
+       renames Nt9_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt9)
+       renames Nt9_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt9)
+       renames Nt9_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt10) is
+    begin
+        Nt10_Cnts (Write) := Nt10_Cnts (Write) + 1;
+    end Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt10 is
+    begin
+        Nt10_Cnts (Input) := Nt10_Cnts (Input) + 1;
+        return Nt10 (C10);
+    end Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt10) is
+    begin
+        Nt10_Cnts (Read) := Nt10_Cnts (Read) + 1;
+    end Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt10) is
+    begin
+        Nt10_Cnts (Output) := Nt10_Cnts (Output) + 1;
+    end Output;
+    function Get_Nt10_Counts return CD10002_0.Counts is
+    begin
+        return Nt10_Cnts;
+    end Get_Nt10_Counts;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt11)
+       renames Nt11_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt11
+       renames Nt11_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt11)
+       renames Nt11_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt11)
+       renames Nt11_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt12) is
+    begin
+        Nt12_Cnts (Write) := Nt12_Cnts (Write) + 1;
+    end Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt12 is
+    begin
+        Nt12_Cnts (Input) := Nt12_Cnts (Input) + 1;
+        return Nt12 (C10);
+    end Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt12) is
+    begin
+        Nt12_Cnts (Read) := Nt12_Cnts (Read) + 1;
+    end Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt12) is
+    begin
+        Nt12_Cnts (Output) := Nt12_Cnts (Output) + 1;
+    end Output;
+    function Get_Nt12_Counts return CD10002_0.Counts is
+    begin
+        return Nt12_Cnts;
+    end Get_Nt12_Counts;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt13)
+       renames Nt13_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Nt13
+       renames Nt13_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt13)
+       renames Nt13_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt13)
+       renames Nt13_Ops.Output;
+
+end CD10002_Gen;
+
+
+with Ada.Streams;
+use Ada.Streams;
+with CD10002_0;
+package CD10002_Priv is
+
+    External_Tag_1 : constant String := "Isaac Newton";
+    External_Tag_2 : constant String := "Albert Einstein";
+
+    type T1 is tagged private;
+    type T2 is tagged
+        record
+            C : T1;
+        end record;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : T1);
+    function Input (Stream : access Root_Stream_Type'Class) return T1;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out T1);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : T1);
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : T2);
+    function Input (Stream : access Root_Stream_Type'Class) return T2;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out T2);
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : T2);
+
+    for T1'Write use Write;
+    for T1'Input use Input;
+
+    for T2'Read use Read;
+    for T2'Output use Output;
+    for T2'External_Tag use External_Tag_2;
+
+    function Get_T1_Counts return CD10002_0.Counts;
+    function Get_T2_Counts return CD10002_0.Counts;
+
+private
+
+    for T1'Read use Read;
+    for T1'Output use Output;
+    for T1'External_Tag use External_Tag_1;
+
+    for T2'Write use Write;
+    for T2'Input use Input;
+
+    type T1 is tagged null record;
+
+    package T1_Ops is new CD10002_0.Nonlimited_Stream_Ops (T1);
+    package T2_Ops is new CD10002_0.Nonlimited_Stream_Ops (T2);
+
+end CD10002_Priv;
+
+
+package body CD10002_Priv is
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : T1)
+       renames T1_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return T1
+       renames T1_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out T1)
+       renames T1_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : T1)
+       renames T1_Ops.Output;
+
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : T2)
+       renames T2_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return T2
+       renames T2_Ops.Input;
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out T2)
+       renames T2_Ops.Read;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : T2)
+       renames T2_Ops.Output;
+
+    function Get_T1_Counts return CD10002_0.Counts renames T1_Ops.Get_Counts;
+    function Get_T2_Counts return CD10002_0.Counts renames T2_Ops.Get_Counts;
+end CD10002_Priv;
+
+
+with Ada.Streams;
+use Ada.Streams;
+with Report;
+use Report;
+with System;
+with CD10002_0;
+with CD10002_1;
+with CD10002_Deriv;
+with CD10002_Gen;
+with CD10002_Priv;
+procedure CD10002 is
+
+    package Deriv renames CD10002_Deriv;
+    generic package Gen renames CD10002_Gen;
+    package Priv renames CD10002_Priv;
+
+    type Stream_Ops is (Read, Write, Input, Output);
+    type Counts is array (Stream_Ops) of Natural;
+
+    S : aliased CD10002_1.Dummy_Stream;
+
+begin
+    Test ("CD10002",
+          "Check that operational items are allowed in some contexts " &
+             "where representation items are not");
+
+    Test_Priv:
+        declare
+            X1 : Priv.T1;
+            X2 : Priv.T2;
+            use CD10002_0;
+        begin
+            Comment
+               ("Check that the name of an incompletely defined type can be " &
+                "used when specifying an operational item");
+
+            -- Partial view of a private type.
+            Priv.T1'Write (S'Access, X1);
+            Priv.T1'Read (S'Access, X1);
+            Priv.T1'Output (S'Access, X1);
+            X1 := Priv.T1'Input (S'Access);
+
+            if Priv.Get_T1_Counts /= (1, 1, 1, 1) then
+                Failed ("Incorrect calls to the stream attributes for Priv.T1");
+            elsif Priv.T1'External_Tag /= Priv.External_Tag_1 then
+                Failed ("Incorrect external tag for Priv.T1");
+            end if;
+
+            -- Incompletely defined but not private.
+            Priv.T2'Write (S'Access, X2);
+            Priv.T2'Read (S'Access, X2);
+            Priv.T2'Output (S'Access, X2);
+            X2 := Priv.T2'Input (S'Access);
+
+            if Priv.Get_T2_Counts /= (1, 1, 1, 1) then
+                Failed ("Incorrect calls to the stream attributes for Priv.T2");
+            elsif Priv.T2'External_Tag /= Priv.External_Tag_2 then
+                Failed ("Incorrect external tag for Priv.T2");
+            end if;
+
+        end Test_Priv;
+
+    Test_Gen:
+        declare
+
+            type Modular is mod System.Max_Binary_Modulus;
+            type Decimal is delta 1.0 digits 1;
+            type Access_Modular is access Modular;
+            type R9 is null record;
+            type R10 (D : access Integer) is limited null record;
+            type Arr is array (Character) of Integer;
+
+            C10 : R10 (new Integer'(19));
+
+            package Inst is new Gen (T1 => Character,
+                                     T2 => Integer,
+                                     T3 => Modular,
+                                     T4 => Float,
+                                     T5 => Duration,
+                                     T6 => Decimal,
+                                     T7 => Access_Modular,
+                                     T8 => Boolean,
+                                     T9 => R9,
+                                     T10 => R10,
+                                     C10 => C10,
+                                     T11 => Arr);
+
+            X1 : Inst.Nt1 := 'a';
+            X2 : Inst.Nt2 := 0;
+            X3 : Inst.Nt3 := 0;
+            X4 : Inst.Nt4 := 0.0;
+            X5 : Inst.Nt5 := 0.0;
+            X6 : Inst.Nt6 := 0.0;
+            X7 : Inst.Nt7 := null;
+            X8 : Inst.Nt8 := Inst.False;
+            X9 : Inst.Nt9 := (null record);
+            X10 : Inst.Nt10 (D => new Integer'(5));
+            Y10 : Integer;
+            X11 : Inst.Nt11 := (others => 0);
+            X12 : Inst.Nt12 (D => new Integer'(7));
+            Y12 : Integer;
+            X13 : Inst.Nt13 := (others => 0);
+            use CD10002_0;
+        begin
+            Comment ("Check that operational items can be specified for a " &
+                     "descendant of a generic formal untagged type");
+
+            Inst.Nt1'Write (S'Access, X1);
+            Inst.Nt1'Read (S'Access, X1);
+            Inst.Nt1'Output (S'Access, X1);
+            X1 := Inst.Nt1'Input (S'Access);
+
+            if Inst.Nt1_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt1");
+            end if;
+
+            Inst.Nt2'Write (S'Access, X2);
+            Inst.Nt2'Read (S'Access, X2);
+            Inst.Nt2'Output (S'Access, X2);
+            X2 := Inst.Nt2'Input (S'Access);
+
+            if Inst.Nt2_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt2");
+            end if;
+
+            Inst.Nt3'Write (S'Access, X3);
+            Inst.Nt3'Read (S'Access, X3);
+            Inst.Nt3'Output (S'Access, X3);
+            X3 := Inst.Nt3'Input (S'Access);
+
+            if Inst.Nt3_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt3");
+            end if;
+
+            Inst.Nt4'Write (S'Access, X4);
+            Inst.Nt4'Read (S'Access, X4);
+            Inst.Nt4'Output (S'Access, X4);
+            X4 := Inst.Nt4'Input (S'Access);
+
+            if Inst.Nt4_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt4");
+            end if;
+
+            Inst.Nt5'Write (S'Access, X5);
+            Inst.Nt5'Read (S'Access, X5);
+            Inst.Nt5'Output (S'Access, X5);
+            X5 := Inst.Nt5'Input (S'Access);
+
+            if Inst.Nt5_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt5");
+            end if;
+
+            Inst.Nt6'Write (S'Access, X6);
+            Inst.Nt6'Read (S'Access, X6);
+            Inst.Nt6'Output (S'Access, X6);
+            X6 := Inst.Nt6'Input (S'Access);
+
+            if Inst.Nt6_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt6");
+            end if;
+
+            Inst.Nt7'Write (S'Access, X7);
+            Inst.Nt7'Read (S'Access, X7);
+            Inst.Nt7'Output (S'Access, X7);
+            X7 := Inst.Nt7'Input (S'Access);
+
+            if Inst.Nt7_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt7");
+            end if;
+
+            Inst.Nt8'Write (S'Access, X8);
+            Inst.Nt8'Read (S'Access, X8);
+            Inst.Nt8'Output (S'Access, X8);
+            X8 := Inst.Nt8'Input (S'Access);
+
+            if Inst.Nt8_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt8");
+            end if;
+
+            Inst.Nt9'Write (S'Access, X9);
+            Inst.Nt9'Read (S'Access, X9);
+            Inst.Nt9'Output (S'Access, X9);
+            X9 := Inst.Nt9'Input (S'Access);
+
+            if Inst.Nt9_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt9");
+            end if;
+
+            Inst.Nt10'Write (S'Access, X10);
+            Inst.Nt10'Read (S'Access, X10);
+            Inst.Nt10'Output (S'Access, X10);
+            Y10 := Inst.Nt10'Input (S'Access).D.all;
+
+            if Inst.Get_Nt10_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt10");
+            end if;
+
+            Inst.Nt11'Write (S'Access, X11);
+            Inst.Nt11'Read (S'Access, X11);
+            Inst.Nt11'Output (S'Access, X11);
+            X11 := Inst.Nt11'Input (S'Access);
+
+            if Inst.Nt11_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt11");
+            end if;
+
+            Inst.Nt12'Write (S'Access, X12);
+            Inst.Nt12'Read (S'Access, X12);
+            Inst.Nt12'Output (S'Access, X12);
+            Y12 := Inst.Nt12'Input (S'Access).D.all;
+
+            if Inst.Get_Nt12_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt12");
+            end if;
+
+            Inst.Nt13'Write (S'Access, X13);
+            Inst.Nt13'Read (S'Access, X13);
+            Inst.Nt13'Output (S'Access, X13);
+            X13 := Inst.Nt13'Input (S'Access);
+
+            if Inst.Nt13_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Inst.Nt13");
+            end if;
+        end Test_Gen;
+
+    Test_Deriv:
+        declare
+            X1 : Deriv.Nt1 := Deriv.False;
+            X2 : Deriv.Nt2 := (others => 0.0);
+            X3 : Deriv.Nt3 := (others => 0.0);
+            X4 : Deriv.Nt4;
+            Y4 : Boolean;
+            X5 : Deriv.Nt5;
+            Y5 : System.Address;
+            X6 : Deriv.Nt6;
+            Y6 : Integer;
+            X7 : Deriv.Nt7;
+            Y7 : Integer;
+            X8 : Deriv.Nt8;
+            Y8 : Integer;
+            use CD10002_0;
+        begin
+            Comment ("Check that operational items can be specified for a " &
+                     "derived untagged type even if the parent type is a " &
+                     "by-reference type, or has user-defined primitive " &
+                     "subprograms");
+
+            Deriv.Nt1'Write (S'Access, X1);
+            Deriv.Nt1'Read (S'Access, X1);
+            Deriv.Nt1'Output (S'Access, X1);
+            X1 := Deriv.Nt1'Input (S'Access);
+
+            if Deriv.Nt1_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Deriv.Nt1");
+            end if;
+
+            Deriv.Nt2'Write (S'Access, X2);
+            Deriv.Nt2'Read (S'Access, X2);
+            Deriv.Nt2'Output (S'Access, X2);
+            X2 := Deriv.Nt2'Input (S'Access);
+
+            if Deriv.Nt2_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Deriv.Nt2");
+            end if;
+
+            Deriv.Nt3'Write (S'Access, X3);
+            Deriv.Nt3'Read (S'Access, X3);
+            Deriv.Nt3'Output (S'Access, X3);
+            X3 := Deriv.Nt3'Input (S'Access);
+
+            if Deriv.Nt3_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Deriv.Nt3");
+            end if;
+
+            Deriv.Nt4'Write (S'Access, X4);
+            Deriv.Nt4'Read (S'Access, X4);
+            Deriv.Nt4'Output (S'Access, X4);
+            Y4 := Deriv.Nt4'Input (S'Access)'Terminated;
+
+            if Deriv.Nt4_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Deriv.Nt4");
+            end if;
+
+            Deriv.Nt5'Write (S'Access, X5);
+            Deriv.Nt5'Read (S'Access, X5);
+            Deriv.Nt5'Output (S'Access, X5);
+            Y5 := Deriv.Nt5'Input (S'Access)'Address;
+
+            if Deriv.Nt5_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Deriv.Nt5");
+            end if;
+
+            Deriv.Nt6'Write (S'Access, X6);
+            Deriv.Nt6'Read (S'Access, X6);
+            Deriv.Nt6'Output (S'Access, X6);
+            Y6 := Deriv.Nt6'Input (S'Access).D.all;
+
+            if Deriv.Nt6_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Deriv.Nt6");
+            end if;
+
+            Deriv.Nt7'Write (S'Access, X7);
+            Deriv.Nt7'Read (S'Access, X7);
+            Deriv.Nt7'Output (S'Access, X7);
+            Y7 := Deriv.Nt7'Input (S'Access) ('a').D.all;
+
+            if Deriv.Nt7_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Deriv.Nt7");
+            end if;
+
+            Deriv.Nt8'Write (S'Access, X8);
+            Deriv.Nt8'Read (S'Access, X8);
+            Deriv.Nt8'Output (S'Access, X8);
+            Y8 := Deriv.Nt8'Input (S'Access)'Size;
+
+            if Deriv.Nt8_Ops.Get_Counts /= (1, 1, 1, 1) then
+                Failed
+                   ("Incorrect calls to the stream attributes for Deriv.Nt8");
+            end if;
+        end Test_Deriv;
+
+    Result;
+end CD10002;
+
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009a.ada
new file mode 100644
index 000000000..905675a7f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009a.ada
@@ -0,0 +1,80 @@
+-- CD1009A.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 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE
+--     OR PRIVATE PART OF A PACKAGE FOR AN INTEGER TYPE DECLARED IN
+--     THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     VCL  09/18/87 CREATED ORIGINAL TEST.
+--     DHH  03/31/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND ADDED
+--                   CHECK FOR REPRESENTATION CLAUSES, AND CHANGED
+--                   SPECIFIED_SIZE TO 5.
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD1009A IS
+BEGIN
+     TEST ("CD1009A", "A 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE " &
+                      "OR PRIVATE PART OF A PACKAGE FOR AN INTEGER " &
+                      "TYPE DECLARED IN THE VISIBLE PART OF THE " &
+                      "SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := 5;
+
+               TYPE CHECK_TYPE_1 IS RANGE -8 .. 7;
+               FOR CHECK_TYPE_1'SIZE USE SPECIFIED_SIZE;
+               TYPE PACK_ARY IS ARRAY(1 .. 6) OF CHECK_TYPE_1;
+               PRAGMA PACK (PACK_ARY);
+               OBJ1 : PACK_ARY := (OTHERS => -7);
+
+               TYPE CHECK_TYPE_2 IS RANGE -8 .. 7;
+          PRIVATE
+               FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
+               OBJ2 : CHECK_TYPE_2 := -7;
+               PROCEDURE CHECK1 IS NEW LENGTH_CHECK (CHECK_TYPE_1);
+               PROCEDURE CHECK2 IS NEW LENGTH_CHECK (CHECK_TYPE_2);
+          END PACK;
+
+          PACKAGE BODY PACK IS
+          BEGIN
+               CHECK1 (OBJ1(IDENT_INT(1)), 5, "CHECK_TYPE_1");
+               CHECK2 (OBJ2, 5, "CHECK_TYPE_2");
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE");
+          END IF;
+
+          IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE");
+          END IF;
+     END;
+
+     RESULT;
+END CD1009A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009b.ada
new file mode 100644
index 000000000..2cbc9e77f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009b.ada
@@ -0,0 +1,80 @@
+-- CD1009B.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 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE
+--     OR PRIVATE PART OF A PACKAGE FOR AN ENUMERATION TYPE DECLARED
+--     IN THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
+--                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL 10/07/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009B IS
+BEGIN
+     TEST ("CD1009B", "A 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE " &
+                      "OR PRIVATE PART OF A PACKAGE FOR AN " &
+                      "ENUMERATION TYPE DECLARED IN THE VISIBLE " &
+                      "PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE / 2;
+
+               TYPE CHECK_TYPE_1 IS (A0, A1, A2, A3);
+               FOR CHECK_TYPE_1'SIZE
+                              USE SPECIFIED_SIZE;
+
+               TYPE CHECK_TYPE_2 IS (A0, A1, A2, A3);
+          PRIVATE
+               FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
+          END PACK;
+
+          USE PACK;
+          X : CHECK_TYPE_1 := A0;
+          Y : CHECK_TYPE_2 := A2;
+     BEGIN
+          IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
+          END IF;
+
+          IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_2'SIZE IS INCORRECT");
+          END IF;
+
+          IF X'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT'SIZE IS TOO SMALL --" &
+                       CHECK_TYPE_1'IMAGE(X));
+          END IF;
+
+          IF Y'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT'SIZE IS TOO SMALL --" &
+                       CHECK_TYPE_2'IMAGE(Y));
+          END IF;
+
+     END;
+
+     RESULT;
+END CD1009B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009d.ada
new file mode 100644
index 000000000..738235f65
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009d.ada
@@ -0,0 +1,84 @@
+-- CD1009D.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 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE
+--     OR PRIVATE PART OF A PACKAGE FOR A FIXED POINT TYPE DECLARED IN
+--     THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
+--                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL 10/07/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009D IS
+BEGIN
+     TEST ("CD1009D", "A 'SIZE CLAUSE MAY BE GIVEN IN THE VISIBLE " &
+                      "OR PRIVATE PART OF A PACKAGE FOR A " &
+                      "FIXED POINT TYPE DECLARED IN THE VISIBLE " &
+                      "PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               TYPE SPECIFIED IS DELTA 2.0 ** (-4) RANGE 0.0 .. 10.0;
+
+               SPECIFIED_SIZE : CONSTANT := SPECIFIED'SIZE;
+
+               TYPE CHECK_TYPE_1 IS DELTA 2.0 ** (-1) RANGE 0.0 .. 1.0;
+               FOR CHECK_TYPE_1'SIZE
+                              USE SPECIFIED_SIZE;
+
+               TYPE CHECK_TYPE_2 IS DELTA 2.0 ** (-1) RANGE 0.0 .. 1.0;
+          PRIVATE
+               FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
+          END PACK;
+
+          USE PACK;
+
+          X: CHECK_TYPE_1 := 0.5;
+          Y: CHECK_TYPE_2 := 0.5;
+
+     BEGIN
+          IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
+          END IF;
+
+          IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_2'SIZE IS INCORRECT");
+          END IF;
+
+          IF X'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE IS TOO SMALL -- " &
+                       "VALUE IS" & INTEGER'IMAGE ( INTEGER(X) ) );
+          END IF;
+
+          IF Y'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE IS TOO SMALL -- " &
+                       "VALUE IS" & INTEGER'IMAGE ( INTEGER(Y) ) );
+          END IF;
+
+     END;
+
+     RESULT;
+END CD1009D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009e.ada
new file mode 100644
index 000000000..4524358fa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009e.ada
@@ -0,0 +1,82 @@
+-- CD1009E.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 'SIZE' SPECIFICATION MAY BE GIVEN IN THE VISIBLE
+--     OR PRIVATE PART OF A PACKAGE FOR A ONE-DIMENSIONAL ARRAY TYPE
+--     DECLARED IN THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
+--                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL  10/07/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009E IS
+BEGIN
+     TEST ("CD1009E", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE VISIBLE " &
+                      "OR PRIVATE PART OF A PACKAGE FOR A " &
+                      "ONE-DIMENSIONAL ARRAY TYPE DECLARED IN THE " &
+                      "VISIBLE PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE * 5;
+
+               TYPE CHECK_TYPE_1 IS ARRAY (1 ..5) OF INTEGER;
+               FOR CHECK_TYPE_1'SIZE
+                              USE SPECIFIED_SIZE;
+               X : CHECK_TYPE_1 := (OTHERS => IDENT_INT(1));
+
+               TYPE CHECK_TYPE_2 IS ARRAY (1 ..5) OF INTEGER;
+          PRIVATE
+               FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
+          END PACK;
+
+          USE PACK;
+
+               Y : CHECK_TYPE_2 := (OTHERS => IDENT_INT(5));
+     BEGIN
+          IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
+          END IF;
+
+          IF X'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
+                       "FIRST VALUE IS"  &
+                       INTEGER'IMAGE( X( IDENT_INT(1) ) ) );
+          END IF;
+
+          IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_2'SIZE IS INCORRECT");
+          END IF;
+
+          IF Y'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_2.  " &
+                       "FIRST VALUE IS"  &
+                       INTEGER'IMAGE( Y( IDENT_INT(1) ) ) );
+          END IF;
+     END;
+
+     RESULT;
+END CD1009E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009f.ada
new file mode 100644
index 000000000..8bcde28c5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009f.ada
@@ -0,0 +1,83 @@
+-- CD1009F.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 'SIZE' SPECIFICATION MAY BE GIVEN IN THE VISIBLE
+--     OR PRIVATE PART OF A PACKAGE FOR A TWO-DIMENSIONAL ARRAY TYPE
+--     DECLARED IN THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
+--                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL  10/07/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009F IS
+BEGIN
+     TEST ("CD1009F", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE VISIBLE " &
+                      "OR PRIVATE PART OF A PACKAGE FOR A " &
+                      "TWO-DIMENSIONAL ARRAY TYPE DECLARED IN THE " &
+                      "VISIBLE PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE * 25;
+
+               TYPE CHECK_TYPE_1 IS ARRAY (1 .. 5, 1 .. 5) OF INTEGER;
+               FOR CHECK_TYPE_1'SIZE
+                              USE SPECIFIED_SIZE;
+               X : CHECK_TYPE_1 := ( OTHERS =>
+                                     ( OTHERS => IDENT_INT(1) ) );
+
+               TYPE CHECK_TYPE_2 IS ARRAY (1 .. 5, 1 .. 5) OF INTEGER;
+          PRIVATE
+               FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
+          END PACK;
+
+          USE PACK;
+
+               Y : CHECK_TYPE_2 := ( OTHERS =>
+                                     ( OTHERS => IDENT_INT(5) ) );
+     BEGIN
+          IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
+          END IF;
+
+          IF X'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
+                       "REPRESENTATIVE VALUE IS"  &
+                       INTEGER'IMAGE( X( IDENT_INT(1), IDENT_INT(2) ) ) );
+          END IF;
+
+          IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_2'SIZE IS INCORRECT");
+          END IF;
+
+          IF Y'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_2.  " &
+                       INTEGER'IMAGE( Y( IDENT_INT(1), IDENT_INT(2) ) ) );
+          END IF;
+     END;
+
+     RESULT;
+END CD1009F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009g.ada
new file mode 100644
index 000000000..1a1426b5c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009g.ada
@@ -0,0 +1,86 @@
+-- CD1009G.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 'SIZE' SPECIFICATION MAY BE GIVEN IN THE VISIBLE
+--     OR PRIVATE PART OF A PACKAGE FOR A RECORD TYPE DECLARED IN
+--     THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
+--                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL  10/07/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009G IS
+BEGIN
+     TEST ("CD1009G", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE VISIBLE " &
+                      "OR PRIVATE PART OF A PACKAGE FOR A " &
+                      "RECORD TYPE DECLARED IN THE " &
+                      "VISIBLE PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE;
+
+               TYPE CHECK_TYPE_1 IS
+                    RECORD
+                         I : INTEGER;
+                    END RECORD;
+               FOR CHECK_TYPE_1'SIZE
+                              USE SPECIFIED_SIZE;
+               X : CHECK_TYPE_1 := ( I => IDENT_INT (1) );
+
+               TYPE CHECK_TYPE_2 IS
+                    RECORD
+                         I : INTEGER;
+                    END RECORD;
+          PRIVATE
+               FOR CHECK_TYPE_2'SIZE USE SPECIFIED_SIZE;
+          END PACK;
+
+          USE PACK;
+
+               Y : CHECK_TYPE_2 := ( I => IDENT_INT (5) );
+     BEGIN
+          IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
+          END IF;
+
+          IF X'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
+                       "VALUE IS"  & INTEGER'IMAGE( IDENT_INT( X.I) ) );
+          END IF;
+
+          IF CHECK_TYPE_2'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_2'SIZE IS INCORRECT");
+          END IF;
+
+          IF Y'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_2.  " &
+                       "VALUE IS"  & INTEGER'IMAGE( IDENT_INT(Y.I) ) );
+          END IF;
+     END;
+
+     RESULT;
+END CD1009G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009h.ada
new file mode 100644
index 000000000..35cccb522
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009h.ada
@@ -0,0 +1,79 @@
+-- CD1009H.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 'SIZE' SPECIFICATION MAY BE GIVEN IN THE PRIVATE
+--     PART OF A PACKAGE FOR A PRIVATE TYPE DECLARED IN THE VISIBLE
+--     PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
+--                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL  09/18/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009H IS
+BEGIN
+     TEST ("CD1009H", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE " &
+                      "PRIVATE PART OF A PACKAGE FOR A PRIVATE " &
+                      "TYPE DECLARED IN THE VISIBLE PART OF THE " &
+                      "SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE / 2;
+
+               TYPE CHECK_TYPE_1 IS PRIVATE;
+               C1 : CONSTANT CHECK_TYPE_1;
+               FUNCTION IMAGE ( A : CHECK_TYPE_1 ) RETURN STRING;
+          PRIVATE
+               TYPE CHECK_TYPE_1 IS RANGE 0 .. 7;
+               FOR CHECK_TYPE_1'SIZE
+                              USE SPECIFIED_SIZE;
+               C1 : CONSTANT CHECK_TYPE_1 := CHECK_TYPE_1(IDENT_INT(1));
+          END PACK;
+
+          USE PACK;
+          X : CHECK_TYPE_1 := C1;
+
+          PACKAGE BODY PACK IS
+               FUNCTION IMAGE ( A : CHECK_TYPE_1 ) RETURN STRING IS
+               BEGIN
+                    RETURN INTEGER'IMAGE ( INTEGER (A) );
+               END IMAGE;
+         END PACK;
+
+     BEGIN
+          IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
+          END IF;
+
+          IF X'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
+                       "VALUE IS"  & IMAGE(X));
+          END IF;
+
+     END;
+
+     RESULT;
+END CD1009H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009i.ada
new file mode 100644
index 000000000..ba35fed3a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009i.ada
@@ -0,0 +1,69 @@
+-- CD1009I.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 'SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE
+--     PART OF A PACKAGE FOR A LIMITED-PRIVATE TYPE DECLARED IN THE
+--     VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     VCL  09/18/87 CREATED ORIGINAL TEST.
+--     DHH  03/30/89 CHANGED SPECIFIED_SIZE TO 5, ADDED CHECK FOR
+--                   REPRESENTATION CLAUSES AND CHANGED THE TEST
+--                   EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD1009I IS
+BEGIN
+     TEST ("CD1009I", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE " &
+                      "PRIVATE PART OF A PACKAGE FOR A LIMITED-" &
+                      "PRIVATE TYPE DECLARED IN THE VISIBLE PART " &
+                      "OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := 5;
+
+               TYPE CHECK_TYPE_1 IS LIMITED PRIVATE;
+          PRIVATE
+               TYPE CHECK_TYPE_1 IS RANGE -8 .. 7;
+               FOR CHECK_TYPE_1'SIZE USE SPECIFIED_SIZE;
+               OBJ_CHECK : CHECK_TYPE_1 := -7;
+               PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE_1);
+          END PACK;
+
+          PACKAGE BODY PACK IS
+          BEGIN
+               CHECK_1 (OBJ_CHECK, 5, "CHECK_TYPE_1");
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE");
+          END IF;
+     END;
+
+     RESULT;
+END CD1009I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009j.ada
new file mode 100644
index 000000000..dcae459af
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009j.ada
@@ -0,0 +1,66 @@
+-- CD1009J.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 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE
+--     VISIBLE OR PRIVATE PART OF A PACKAGE FOR AN ACCESS TYPE
+--     DECLARED IN THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL 10/07/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009J IS
+BEGIN
+     TEST ("CD1009J", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
+                      "VISIBLE OR PRIVATE PART OF A PACKAGE FOR AN " &
+                      "ACCESS TYPE DECLARED IN THE VISIBLE PART OF " &
+                      "THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE * 10;
+
+               TYPE CHECK_TYPE_1 IS ACCESS INTEGER;
+               FOR CHECK_TYPE_1'STORAGE_SIZE
+                              USE SPECIFIED_SIZE;
+
+               TYPE CHECK_TYPE_2 IS ACCESS INTEGER;
+          PRIVATE
+               FOR CHECK_TYPE_2'STORAGE_SIZE USE SPECIFIED_SIZE;
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          IF CHECK_TYPE_1'STORAGE_SIZE < SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO SMALL");
+          END IF;
+
+          IF CHECK_TYPE_2'STORAGE_SIZE < SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_2'STORAGE_SIZE IS TOO SMALL");
+          END IF;
+     END;
+
+     RESULT;
+END CD1009J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009k.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009k.tst
new file mode 100644
index 000000000..02a824abf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009k.tst
@@ -0,0 +1,94 @@
+-- CD1009K.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 A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE
+--     VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TASK TYPE DECLARED IN
+--     THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- MACRO SUBSTITUTION:
+--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+--     THE ACTIVATION OF A TASK.
+
+-- HISTORY:
+--     VCL  10/08/87 CREATED ORIGINAL TEST.
+--     DHH  03/30/89 CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
+--                   EXTENSION FROM '.DEP' TO '.TST'.
+--     TMB  02/29/96 EFFECT OF SETTING 'STORAGE_SIZE IS IMPLEMENTATION 
+--                   DEPENDENT.
+--                   ONLY GUARANTEE WHEN EXAMINING 'STORAGE_SIZE IS THAT
+--                   IT IS NOT NEGATIVE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009K IS
+BEGIN
+     TEST ("CD1009K", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
+                      "VISIBLE OR PRIVATE PART OF A PACKAGE FOR A " &
+                      "TASK TYPE DECLARED IN THE VISIBLE PART OF " &
+                      "THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+
+               TASK TYPE CHECK_TYPE_1 IS
+               END CHECK_TYPE_1;
+
+               FOR CHECK_TYPE_1'STORAGE_SIZE
+                              USE SPECIFIED_SIZE;
+
+               TASK TYPE CHECK_TYPE_2 IS
+               END CHECK_TYPE_2;
+
+          PRIVATE
+               FOR CHECK_TYPE_2'STORAGE_SIZE USE SPECIFIED_SIZE;
+          END PACK;
+
+          PACKAGE BODY PACK IS
+               TASK BODY CHECK_TYPE_1 IS
+                    I : INTEGER;
+               BEGIN
+                    NULL;
+               END CHECK_TYPE_1;
+
+               TASK BODY CHECK_TYPE_2 IS
+                    I : INTEGER;
+               BEGIN
+                    NULL;
+               END CHECK_TYPE_2;
+
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          IF CHECK_TYPE_1'STORAGE_SIZE < 0 THEN
+               FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO SMALL");
+          END IF;
+
+          IF CHECK_TYPE_2'STORAGE_SIZE < 0 THEN
+               FAILED ("CHECK_TYPE_2'STORAGE_SIZE IS TOO SMALL");
+          END IF;
+     END;
+
+     RESULT;
+END CD1009K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009l.ada
new file mode 100644
index 000000000..61bca0d49
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009l.ada
@@ -0,0 +1,69 @@
+-- CD1009L.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 'SMALL' CLAUSE MAY BE GIVEN IN THE VISIBLE OR
+--     PRIVATE PART OF A PACKAGE FOR A FIXED POINT TYPE DECLARED
+--     IN THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     VCL 10/08/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CHANGED
+--                    COMMENT FROM FLOATING POINT TO FIXED POINT.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009L IS
+BEGIN
+     TEST ("CD1009L", "A 'SMALL' CLAUSE MAY BE GIVEN IN THE VISIBLE " &
+                      "OR PRIVATE PART OF A PACKAGE FOR A " &
+                      "FIXED POINT TYPE DECLARED IN THE VISIBLE " &
+                      "PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               TYPE SPECIFIED IS DELTA 2.0 ** (-2) RANGE 0.0 .. 1.0;
+
+               SPECIFIED_SMALL : CONSTANT := SPECIFIED'SMALL;
+
+               TYPE CHECK_TYPE_1 IS DELTA 2.0 ** (-1) RANGE 0.0 .. 1.0;
+               FOR CHECK_TYPE_1'SMALL
+                              USE SPECIFIED_SMALL;
+
+               TYPE CHECK_TYPE_2 IS DELTA 2.0 ** (-1) RANGE 0.0 .. 1.0;
+          PRIVATE
+               FOR CHECK_TYPE_2'SMALL USE SPECIFIED_SMALL;
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          IF CHECK_TYPE_1'SMALL /= SPECIFIED_SMALL THEN
+               FAILED ("INCORRECT RESULTS FOR CHECK_TYPE_1'SMALL");
+          END IF;
+
+          IF CHECK_TYPE_2'SMALL /= SPECIFIED_SMALL THEN
+               FAILED ("INCORRECT RESULTS FOR CHECK_TYPE_2'SMALL");
+          END IF;
+     END;
+
+     RESULT;
+END CD1009L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009m.ada
new file mode 100644
index 000000000..7e1932a43
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009m.ada
@@ -0,0 +1,81 @@
+-- CD1009M.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 ENUMERATION REPRESENTATION CLAUSE MAY BE GIVEN IN
+--     THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR AN ENUMERATION
+--     TYPE DECLARED IN THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     VCL  10/08/87  CREATED ORIGINAL TEST.
+--     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
+--                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;                       -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD1009M IS
+BEGIN
+     TEST ("CD1009M", "AN ENUMERATION REPRESENTATION CLAUSE MAY BE " &
+                      "GIVEN IN THE VISIBLE OR PRIVATE PART OF A " &
+                      "PACKAGE FOR AN ENUMERATION TYPE DECLARED IN " &
+                      "THE VISIBLE PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               TYPE CHECK_TYPE_1 IS (A0, A2, A4, A8);
+               FOR CHECK_TYPE_1 USE (A0 => 0,
+                                     A2 => 1,
+                                     A4 => 2,
+                                     A8 => 3);
+
+               TYPE CHECK_TYPE_2 IS (A0, A2, A4, A8);
+               TYPE INT1 IS RANGE 0 .. 3;
+               FOR INT1'SIZE USE CHECK_TYPE_1'SIZE;
+
+               TYPE INT2 IS RANGE 2 .. 8;
+
+          PRIVATE
+               FOR CHECK_TYPE_2 USE (A0 => 2,
+                                     A2 => 4,
+                                     A4 => 6,
+                                     A8 => 8);
+               FOR INT2'SIZE USE CHECK_TYPE_2'SIZE;
+
+               PROCEDURE CHECK_1 IS NEW ENUM_CHECK(CHECK_TYPE_1, INT1);
+               PROCEDURE CHECK_2 IS NEW ENUM_CHECK(CHECK_TYPE_2, INT2);
+
+          END PACK;
+
+          PACKAGE BODY PACK IS
+          BEGIN
+               CHECK_1 (A4, 2, "CHECK_TYPE_1");
+               CHECK_2 (A8, 8, "CHECK_TYPE_2");
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD1009M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009n.ada
new file mode 100644
index 000000000..9ebcaa106
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009n.ada
@@ -0,0 +1,147 @@
+-- CD1009N.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 RECORD REPRESENTATION CLAUSE MAY BE GIVEN
+--     IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A RECORD TYPE
+--     DECLARED IN THE VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     VCL 10/08/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CORRECTED
+--                    CHECKS FOR FAILURE.
+
+WITH SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009N IS
+BEGIN
+     TEST ("CD1009N", "A RECORD REPRESENTATION CLAUSE MAY BE GIVEN " &
+                      "IN THE VISIBLE OR PRIVATE PART OF A PACKAGE " &
+                      "FOR A RECORD TYPE DECLARED IN THE " &
+                      "VISIBLE PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               UNITS_PER_INTEGER : CONSTANT :=
+                    (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
+                    SYSTEM.STORAGE_UNIT;
+
+               TYPE CHECK_TYPE_1 IS
+                    RECORD
+                         I1 : INTEGER RANGE 0 .. 255;
+                         B1 : BOOLEAN;
+                         B2 : BOOLEAN;
+                         I2 : INTEGER RANGE 0 .. 15;
+                    END RECORD;
+               FOR CHECK_TYPE_1 USE
+                    RECORD
+                         I1 AT 0 * UNITS_PER_INTEGER
+                              RANGE 0 .. INTEGER'SIZE - 1;
+                         B1 AT 1 * UNITS_PER_INTEGER
+                              RANGE 0 .. BOOLEAN'SIZE - 1;
+                         B2 AT 2 * UNITS_PER_INTEGER
+                              RANGE 0 .. BOOLEAN'SIZE - 1;
+                         I2 AT 3 * UNITS_PER_INTEGER
+                              RANGE 0 .. INTEGER'SIZE - 1;
+                    END RECORD;
+
+               TYPE CHECK_TYPE_2 IS
+                    RECORD
+                         I1 : INTEGER RANGE 0 .. 255;
+                         B1 : BOOLEAN;
+                         B2 : BOOLEAN;
+                         I2 : INTEGER RANGE 0 .. 15;
+                    END RECORD;
+
+          PRIVATE
+               FOR CHECK_TYPE_2 USE
+                         RECORD
+                         I1 AT 0 * UNITS_PER_INTEGER
+                              RANGE 0 .. INTEGER'SIZE - 1;
+                         B1 AT 1 * UNITS_PER_INTEGER
+                              RANGE 0 .. BOOLEAN'SIZE - 1;
+                         B2 AT 2 * UNITS_PER_INTEGER
+                              RANGE 0 .. BOOLEAN'SIZE - 1;
+                         I2 AT 3 * UNITS_PER_INTEGER
+                              RANGE 0 .. INTEGER'SIZE - 1;
+                         END RECORD;
+          END PACK;
+
+          USE PACK;
+
+          R1 : CHECK_TYPE_1;
+
+          R2 : CHECK_TYPE_2;
+     BEGIN
+          IF R1.I1'FIRST_BIT /= 0 OR
+                    R1.I1'LAST_BIT /= INTEGER'SIZE - 1 OR
+                    R1.I1'POSITION /= 0 THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R1.I1");
+          END IF;
+
+          IF R1.B1'FIRST_BIT /= 0 OR
+                    R1.B1'LAST_BIT /= BOOLEAN'SIZE - 1 OR
+                    R1.B1'POSITION /= 1 * UNITS_PER_INTEGER THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R1.B1");
+          END IF;
+
+          IF R1.B2'FIRST_BIT /= 0 OR
+                    R1.B2'LAST_BIT /= BOOLEAN'SIZE - 1 OR
+                    R1.B2'POSITION /= 2 * UNITS_PER_INTEGER THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R1.B2");
+          END IF;
+
+          IF R1.I2'FIRST_BIT /= 0 OR
+                    R1.I2'LAST_BIT /= INTEGER'SIZE - 1 OR
+                    R1.I2'POSITION /= 3 * UNITS_PER_INTEGER THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R1.I2");
+          END IF;
+
+
+          IF R2.I1'FIRST_BIT /= 0 OR
+                    R2.I1'LAST_BIT /= INTEGER'SIZE - 1 OR
+                    R2.I1'POSITION /= 0 THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R2.I1");
+          END IF;
+
+          IF R2.B1'FIRST_BIT /= 0 OR
+                    R2.B1'LAST_BIT /= BOOLEAN'SIZE - 1 OR
+                    R2.B1'POSITION /= 1 * UNITS_PER_INTEGER THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R2.B1");
+          END IF;
+
+          IF R2.B2'FIRST_BIT /= 0 OR
+                    R2.B2'LAST_BIT /= BOOLEAN'SIZE - 1 OR
+                    R2.B2'POSITION /= 2 * UNITS_PER_INTEGER THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R2.B2");
+          END IF;
+
+          IF R2.I2'FIRST_BIT /= 0 OR
+                    R2.I2'LAST_BIT /= INTEGER'SIZE - 1 OR
+                    R2.I2'POSITION /= 3 * UNITS_PER_INTEGER THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R2.I2");
+          END IF;
+     END;
+
+     RESULT;
+END CD1009N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009o.ada
new file mode 100644
index 000000000..4317a0d05
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009o.ada
@@ -0,0 +1,75 @@
+-- CD1009O.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 'SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE PART
+--     OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL DECLARATION
+--     IS AN INTEGER TYPE, DECLARED IN THE VISIBLE PART OF THE SAME
+--     PACKAGE.
+
+-- HISTORY:
+--     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
+--                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL  10/08/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009O IS
+BEGIN
+     TEST ("CD1009O", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE " &
+                      "PART OF A PACKAGE FOR AN INCOMPLETE TYPE, " &
+                      "WHOSE FULL DECLARATION IS AN INTEGER " &
+                      "TYPE, DECLARED IN THE VISIBLE PART OF THE " &
+                      "SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE / 2;
+
+               TYPE CHECK_TYPE_1;
+               TYPE ACC IS ACCESS CHECK_TYPE_1;
+
+               TYPE CHECK_TYPE_1 IS RANGE 0 .. 7;
+
+          PRIVATE
+               FOR CHECK_TYPE_1'SIZE
+                              USE SPECIFIED_SIZE;
+          END PACK;
+
+          USE PACK;
+
+          X : CHECK_TYPE_1 := CHECK_TYPE_1 (IDENT_INT(1));
+
+     BEGIN
+          IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
+          END IF;
+
+          IF X'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
+                       "VALUE IS"  & CHECK_TYPE_1'IMAGE(X));
+          END IF;
+
+     END;
+
+     RESULT;
+END CD1009O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009p.ada
new file mode 100644
index 000000000..3dcc29a6e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009p.ada
@@ -0,0 +1,66 @@
+-- CD1009P.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 'SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE PART
+--     OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL DECLARATION
+--     IS AN ENUMERATION TYPE, DECLARED IN THE VISIBLE PART OF THE SAME
+--     PACKAGE.
+
+-- HISTORY:
+--     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
+--                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL  10/09/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009P IS
+BEGIN
+     TEST ("CD1009P", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE VISIBLE " &
+                      "PART OF A PACKAGE FOR AN INCOMPLETE TYPE, " &
+                      "WHOSE FULL DECLARATION IS AN ENUMERATION " &
+                      "TYPE, DECLARED IN THE VISIBLE PART OF THE " &
+                      "SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE;
+
+               TYPE CHECK_TYPE_1;
+               TYPE ACC IS ACCESS CHECK_TYPE_1;
+
+               TYPE CHECK_TYPE_1 IS (A0, A1, A2, A3);
+
+          PRIVATE
+               FOR CHECK_TYPE_1'SIZE
+                              USE SPECIFIED_SIZE;
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          IF CHECK_TYPE_1'SIZE > SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE IS TOO LARGE");
+          END IF;
+     END;
+
+     RESULT;
+END CD1009P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009q.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009q.ada
new file mode 100644
index 000000000..e6c88d837
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009q.ada
@@ -0,0 +1,75 @@
+-- CD1009Q.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 'SIZE' SPECIFICATION MAY BE GIVEN IN THE PRIVATE
+--     PART OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL DECLARATION
+--     IS A FIXED POINT TYPE, DECLARED IN THE VISIBLE PART OF THE SAME
+--     PACKAGE.
+
+-- HISTORY:
+--     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
+--                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL  10/21/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009Q IS
+BEGIN
+     TEST ("CD1009Q", "A 'SIZE' CLAUSE MAY BE GIVEN IN THE " &
+                      "PRIVATE PART OF A PACKAGE FOR A AN " &
+                      "INCOMPLETE TYPE, WHOSE FULL DECLARATION IS A " &
+                      "FIXED POINT TYPE, DECLARED IN THE VISIBLE " &
+                      "PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               TYPE SPECIFIED IS DELTA 2.0 ** (-4) RANGE 0.0 .. 10.0;
+
+               SPECIFIED_SIZE : CONSTANT := SPECIFIED'SIZE;
+
+               TYPE CHECK_TYPE_1;
+               TYPE ACC IS ACCESS CHECK_TYPE_1;
+
+               TYPE CHECK_TYPE_1 IS DELTA 2.0 ** (-1) RANGE 0.0 .. 2.0;
+          PRIVATE
+               FOR CHECK_TYPE_1'SIZE
+                              USE SPECIFIED_SIZE;
+          END PACK;
+
+          USE PACK;
+
+          X : CHECK_TYPE_1 := CHECK_TYPE_1 ( IDENT_INT (1) );
+     BEGIN
+          IF CHECK_TYPE_1'SIZE /= SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'SIZE IS INCORRECT");
+          END IF;
+
+          IF X'SIZE < SPECIFIED_SIZE THEN
+               FAILED ("OBJECT SIZE TOO SMALL -- CHECK_TYPE_1.  " &
+                       "VALUE IS"  & INTEGER'IMAGE ( INTEGER(X) ) );
+          END IF;
+
+     END;
+
+     RESULT;
+END CD1009Q;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009r.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009r.ada
new file mode 100644
index 000000000..fe2bd21f7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009r.ada
@@ -0,0 +1,64 @@
+-- CD1009R.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 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE
+--     PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL
+--     DECLARATION IS AN ACCESS TYPE, DECLARED IN THE VISIBLE PART OF
+--     THE SAME PACKAGE.
+
+-- HISTORY:
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL 10/21/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009R IS
+BEGIN
+     TEST ("CD1009R", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
+                      "PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE " &
+                      "TYPE, WHOSE FULL TYPE DECLARATION IS AN " &
+                      "ACCESS TYPE, DECLARED IN THE VISIBLE PART OF " &
+                      "THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE * 10;
+
+               TYPE CHECK_TYPE_1;
+               TYPE ACC IS ACCESS CHECK_TYPE_1;
+
+               TYPE CHECK_TYPE_1 IS ACCESS INTEGER;
+          PRIVATE
+               FOR CHECK_TYPE_1'STORAGE_SIZE
+                              USE SPECIFIED_SIZE;
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          IF CHECK_TYPE_1'STORAGE_SIZE < SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO SMALL");
+          END IF;
+     END;
+
+     RESULT;
+END CD1009R;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009s.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009s.ada
new file mode 100644
index 000000000..ef67765a6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009s.ada
@@ -0,0 +1,72 @@
+-- CD1009S.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 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE
+--     PART OF A PACKAGE FOR A PRIVATE TYPE, WHOSE FULL TYPE
+--     DECLARATION IS AN ACCESS TYPE, DECLARED IN THE VISIBLE PART
+--     OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     VCL 10/09/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009S IS
+BEGIN
+     TEST ("CD1009S", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
+                      "PRIVATE PART OF A PACKAGE FOR A PRIVATE TYPE, " &
+                      "WHOSE FULL TYPE DECLARATION IS AN ACCESS " &
+                      "TYPE, DECLARED IN THE VISIBLE PART OF THE " &
+                      "SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE * 10;
+
+               TYPE CHECK_TYPE_1 IS PRIVATE;
+
+               PROCEDURE P;
+          PRIVATE
+               TYPE CHECK_TYPE_1 IS ACCESS INTEGER;
+               FOR CHECK_TYPE_1'STORAGE_SIZE
+                              USE SPECIFIED_SIZE;
+          END PACK;
+
+          PACKAGE BODY PACK IS
+               PROCEDURE P IS
+               BEGIN
+                    IF CHECK_TYPE_1'STORAGE_SIZE < SPECIFIED_SIZE THEN
+                         FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO " &
+                                 "SMALL");
+                    END IF;
+               END P;
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          P;
+     END;
+
+     RESULT;
+END CD1009S;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009t.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009t.tst
new file mode 100644
index 000000000..1ed4b53e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009t.tst
@@ -0,0 +1,77 @@
+-- CD1009T.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 A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE
+--     PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL
+--     TYPE DECLARATION IS A TASK TYPE, DECLARED IN THE VISIBLE
+--     PART OF THE SAME PACKAGE.
+
+-- MACRO SUBSTITUTION:
+--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+--     THE ACTIVATION OF A TASK.
+
+-- HISTORY:
+--     VCL  10/21/87  CREATED ORIGINAL TEST.
+--     DHH  03/30/89  CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
+--                    EXTENSION FROM '.DEP' TO '.TST'.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009T IS
+BEGIN
+     TEST ("CD1009T", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
+                      "PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE  " &
+                      "TYPE, WHOSE FULL TYPE DECLARATION IS A " &
+                      "TASK TYPE, DECLARED IN THE VISIBLE PART OF " &
+                      "THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+
+               TYPE CHECK_TYPE_1;
+               TYPE ACC IS ACCESS CHECK_TYPE_1;
+
+               TASK TYPE CHECK_TYPE_1 IS END CHECK_TYPE_1;
+          PRIVATE
+               FOR CHECK_TYPE_1'STORAGE_SIZE
+                              USE SPECIFIED_SIZE;
+          END PACK;
+
+          PACKAGE BODY PACK IS
+               TASK BODY CHECK_TYPE_1 IS
+                    I : INTEGER;
+               BEGIN
+                    NULL;
+               END CHECK_TYPE_1;
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          IF CHECK_TYPE_1'STORAGE_SIZE < SPECIFIED_SIZE THEN
+               FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO SMALL");
+          END IF;
+     END;
+
+     RESULT;
+END CD1009T;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009u.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009u.tst
new file mode 100644
index 000000000..de803d480
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009u.tst
@@ -0,0 +1,84 @@
+-- CD1009U.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 A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE PRIVATE
+--     PART OF A PACKAGE FOR A LIMITED PRIVATE TYPE, WHOSE FULL TYPE
+--     DECLARATION IS A TASK TYPE, DECLARED IN THE VISIBLE PART OF THE
+--     SAME PACKAGE.
+
+-- MACRO SUBSTITUTION:
+--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+--     THE ACTIVATION OF A TASK.
+
+-- HISTORY:
+--     VCL  10/09/87  CREATED ORIGINAL TEST.
+--     DHH  03/30/89  CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
+--                    EXTENSION FROM '.DEP' TO '.TST'.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009U IS
+BEGIN
+     TEST ("CD1009U", "A 'STORAGE_SIZE' CLAUSE MAY BE GIVEN IN THE " &
+                      "PRIVATE PART OF A PACKAGE FOR A LIMITED " &
+                      "PRIVATE TYPE, WHOSE FULL TYPE DECLARATION IS " &
+                      "A TASK TYPE, DECLARED IN THE VISIBLE PART OF " &
+                      "THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+
+               TYPE CHECK_TYPE_1 IS LIMITED PRIVATE;
+
+               PROCEDURE P;
+          PRIVATE
+               TASK TYPE CHECK_TYPE_1 IS
+               END CHECK_TYPE_1;
+
+               FOR CHECK_TYPE_1'STORAGE_SIZE USE SPECIFIED_SIZE;
+          END PACK;
+
+          PACKAGE BODY PACK IS
+               PROCEDURE P IS
+               BEGIN
+                    IF CHECK_TYPE_1'STORAGE_SIZE < SPECIFIED_SIZE THEN
+                         FAILED ("CHECK_TYPE_1'STORAGE_SIZE IS TOO " &
+                                 "SMALL");
+                    END IF;
+               END P;
+
+               TASK BODY CHECK_TYPE_1 IS
+                    I : INTEGER;
+               BEGIN
+                    NULL;
+               END CHECK_TYPE_1;
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          P;
+     END;
+
+     RESULT;
+END CD1009U;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009v.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009v.ada
new file mode 100644
index 000000000..945e236c2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009v.ada
@@ -0,0 +1,76 @@
+-- CD1009V.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 ENUMERATION REPRESENTATION CLAUSE MAY BE GIVEN IN
+--     THE PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE
+--     FULL TYPE DECLARATION IS AN ENUMERATION TYPE DECLARED IN THE
+--     VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     VCL  10/21/87  CREATED ORIGINAL TEST.
+--     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
+--                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;                        -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD1009V IS
+BEGIN
+     TEST ("CD1009V", "AN ENUMERATION REPRESENTATION CLAUSE MAY BE " &
+                      "GIVEN IN THE PRIVATE PART OF A " &
+                      "PACKAGE FOR AN INCOMPLETE TYPE, WHOSE FULL " &
+                      "TYPE DECLARATION IS AN ENUMERATION TYPE, " &
+                      "DECLARED IN THE VISIBLE PART OF THE SAME " &
+                      "PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               TYPE CHECK_TYPE_1;
+               TYPE ACC IS ACCESS CHECK_TYPE_1;
+
+               TYPE CHECK_TYPE_1 IS (A0, A2, A4, A8);
+          PRIVATE
+
+               FOR CHECK_TYPE_1 USE (A0 => 9,
+                                     A2 => 13,
+                                     A4 => 15,
+                                     A8 => 18);
+               TYPE INT1 IS RANGE 9 .. 18;
+               FOR INT1'SIZE USE CHECK_TYPE_1'SIZE;
+
+               PROCEDURE CHECK_1 IS NEW ENUM_CHECK(CHECK_TYPE_1, INT1);
+
+          END PACK;
+
+          PACKAGE BODY PACK IS
+          BEGIN
+               CHECK_1 (A2, 13, "CHECK_TYPE_1");
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD1009V;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009w.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009w.ada
new file mode 100644
index 000000000..ef06e43f0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009w.ada
@@ -0,0 +1,71 @@
+-- CD1009W.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 ENUMERATION REPRESENTATION CLAUSE MAY BE GIVEN IN
+--     THE PRIVATE PART OF A PACKAGE FOR A PRIVATE TYPE, WHOSE FULL
+--     TYPE DECLARATION IS AN ENUMERATION TYPE, DECLARED IN THE
+--     VISIBLE PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     VCL  10/09/87  CREATED ORIGINAL TEST.
+--     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
+--                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSE.
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD1009W IS
+BEGIN
+     TEST ("CD1009W", "AN ENUMERATION REPRESENTATION CLAUSE MAY BE " &
+                      "GIVEN IN THE PRIVATE PART OF A PACKAGE FOR " &
+                      "A PRIVATE TYPE, WHOSE FULL TYPE DECLARATION " &
+                      "IS AN ENUMERATION TYPE, DECLARED IN " &
+                      "THE VISIBLE PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               TYPE CHECK_TYPE_1 IS PRIVATE;
+          PRIVATE
+               TYPE CHECK_TYPE_1 IS (A0, A2, A4, A8);
+               FOR CHECK_TYPE_1 USE (A0 => 0,
+                                     A2 => 2,
+                                     A4 => 4,
+                                     A8 => 16);
+               TYPE INT1 IS RANGE 0 .. 16;
+               FOR INT1'SIZE USE CHECK_TYPE_1'SIZE;
+
+               PROCEDURE CHECK_1 IS NEW ENUM_CHECK(CHECK_TYPE_1, INT1);
+          END PACK;
+
+          PACKAGE BODY PACK IS
+          BEGIN
+               CHECK_1 (A8, 16, "CHECK_TYPE_1");
+          END PACK;
+
+          USE PACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD1009W;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009x.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009x.ada
new file mode 100644
index 000000000..045be9455
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009x.ada
@@ -0,0 +1,105 @@
+-- CD1009X.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 RECORD REPRESENTATION CLAUSE MAY BE GIVEN
+--     IN THE PRIVATE PART OF A PACKAGE FOR AN INCOMPLETE TYPE, WHOSE
+--     FULL TYPE DECLARATION IS A RECORD TYPE DECLARED IN THE VISIBLE
+--     PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     VCL 10/21/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CORRECTED
+--                    CHECKS FOR FAILURE.
+
+WITH SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009X IS
+BEGIN
+     TEST ("CD1009X", "A RECORD REPRESENTATION CLAUSE MAY BE GIVEN " &
+                      "IN THE PRIVATE PART OF A PACKAGE FOR AN " &
+                      "INCOMPLETE TYPE, WHOSE FULL TYPE DECLARATION " &
+                      "IS A RECORD TYPE DECLARED IN THE " &
+                      "VISIBLE PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               UNITS_PER_INTEGER : CONSTANT :=
+                    (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
+                    SYSTEM.STORAGE_UNIT;
+
+               TYPE CHECK_TYPE_1;
+               TYPE ACC IS ACCESS CHECK_TYPE_1;
+
+               TYPE CHECK_TYPE_1 IS
+                    RECORD
+                         I1 : INTEGER RANGE 0 .. 255;
+                         B1 : BOOLEAN;
+                         B2 : BOOLEAN;
+                         I2 : INTEGER RANGE 0 .. 15;
+                    END RECORD;
+          PRIVATE
+               FOR CHECK_TYPE_1 USE
+                    RECORD
+                         I1 AT 0 * UNITS_PER_INTEGER
+                              RANGE 0 .. INTEGER'SIZE - 1;
+                         B1 AT 1 * UNITS_PER_INTEGER
+                              RANGE 0 .. BOOLEAN'SIZE - 1;
+                         B2 AT 2 * UNITS_PER_INTEGER
+                              RANGE 0 .. BOOLEAN'SIZE - 1;
+                         I2 AT 3 * UNITS_PER_INTEGER
+                              RANGE 0 .. INTEGER'SIZE - 1;
+                    END RECORD;
+          END PACK;
+
+          USE PACK;
+
+          R1 : CHECK_TYPE_1;
+     BEGIN
+          IF R1.I1'FIRST_BIT /= 0 OR
+                    R1.I1'LAST_BIT /= INTEGER'SIZE - 1 OR
+                    R1.I1'POSITION /= 0 THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R1.I1");
+          END IF;
+
+          IF R1.B1'FIRST_BIT /= 0 OR
+                    R1.B1'LAST_BIT /= BOOLEAN'SIZE - 1 OR
+                    R1.B1'POSITION /= 1 * UNITS_PER_INTEGER THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R1.B1");
+          END IF;
+
+          IF R1.B2'FIRST_BIT /= 0 OR
+                    R1.B2'LAST_BIT /= BOOLEAN'SIZE - 1 OR
+                    R1.B2'POSITION /= 2 * UNITS_PER_INTEGER THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R1.B2");
+          END IF;
+
+          IF R1.I2'FIRST_BIT /= 0 OR
+                    R1.I2'LAST_BIT /= INTEGER'SIZE - 1 OR
+                    R1.I2'POSITION /= 3 * UNITS_PER_INTEGER THEN
+               FAILED ("INCORRECT REPRESENTATION FOR R1.I2");
+          END IF;
+     END;
+
+     RESULT;
+END CD1009X;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009y.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009y.ada
new file mode 100644
index 000000000..1300c17f8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009y.ada
@@ -0,0 +1,115 @@
+-- CD1009Y.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 RECORD REPRESENTATION CLAUSE MAY BE GIVEN IN THE
+--     PRIVATE PART OF A PACKAGE FOR A PRIVATE TYPE, WHOSE FULL TYPE
+--     DECLARATION IS A RECORD TYPE, DECLARED IN THE VISIBLE PART
+--     OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     VCL 10/09/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CORRECTED
+--                    CHECKS FOR FAILURE.
+
+WITH SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009Y IS
+BEGIN
+     TEST ("CD1009Y", "A RECORD REPRESENTATION CLAUSE MAY BE GIVEN " &
+                      "IN THE PRIVATE PART OF A PACKAGE FOR A " &
+                      "PRIVATE TYPE, WHOSE FULL TYPE DECLARATION IS " &
+                      "A RECORD TYPE DECLARED IN THE " &
+                      "VISIBLE PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               UNITS_PER_INTEGER : CONSTANT :=
+                    (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
+                    SYSTEM.STORAGE_UNIT;
+
+               TYPE CHECK_TYPE_1 IS PRIVATE;
+
+               PROCEDURE P;
+          PRIVATE
+               TYPE CHECK_TYPE_1 IS
+                    RECORD
+                         I1 : INTEGER RANGE 0 .. 255;
+                         B1 : BOOLEAN;
+                         B2 : BOOLEAN;
+                         I2 : INTEGER RANGE 0 .. 15;
+                    END RECORD;
+               FOR CHECK_TYPE_1 USE
+                    RECORD
+                         I1 AT 0 * UNITS_PER_INTEGER
+                              RANGE 0 .. INTEGER'SIZE - 1;
+                         B1 AT 1 * UNITS_PER_INTEGER
+                              RANGE 0 .. BOOLEAN'SIZE - 1;
+                         B2 AT 2 * UNITS_PER_INTEGER
+                              RANGE 0 .. BOOLEAN'SIZE - 1;
+                         I2 AT 3 * UNITS_PER_INTEGER
+                              RANGE 0 .. INTEGER'SIZE - 1;
+                    END RECORD;
+          END PACK;
+
+          PACKAGE BODY PACK IS
+               PROCEDURE P IS
+                    R1 : CHECK_TYPE_1;
+               BEGIN
+                    IF R1.I1'FIRST_BIT /= 0 OR
+                              R1.I1'LAST_BIT /= INTEGER'SIZE - 1 OR
+                              R1.I1'POSITION /= 0 THEN
+                         FAILED ("INCORRECT REPRESENTATION FOR R1.I1");
+                    END IF;
+
+                    IF R1.B1'FIRST_BIT /= 0 OR
+                              R1.B1'LAST_BIT /= BOOLEAN'SIZE - 1 OR
+                              R1.B1'POSITION /= 1 * UNITS_PER_INTEGER
+                                   THEN
+                         FAILED ("INCORRECT REPRESENTATION FOR R1.B1");
+                    END IF;
+
+                    IF R1.B2'FIRST_BIT /= 0 OR
+                              R1.B2'LAST_BIT /= BOOLEAN'SIZE - 1 OR
+                              R1.B2'POSITION /= 2 * UNITS_PER_INTEGER
+                                   THEN
+                         FAILED ("INCORRECT REPRESENTATION FOR R1.B2");
+                    END IF;
+
+                    IF R1.I2'FIRST_BIT /= 0 OR
+                              R1.I2'LAST_BIT /= INTEGER'SIZE - 1 OR
+                              R1.I2'POSITION /= 3 * UNITS_PER_INTEGER
+                                   THEN
+                         FAILED ("INCORRECT REPRESENTATION FOR R1.I2");
+                    END IF;
+               END P;
+          END PACK;
+
+          USE PACK;
+
+     BEGIN
+          P;
+     END;
+
+     RESULT;
+END CD1009Y;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009z.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009z.ada
new file mode 100644
index 000000000..61e6b1314
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1009z.ada
@@ -0,0 +1,115 @@
+-- CD1009Z.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 RECORD REPRESENTATION CLAUSE MAY BE GIVEN IN THE
+--     PRIVATE PART OF A PACKAGE FOR A LIMITED-PRIVATE TYPE, WHOSE
+--     FULL TYPE DECLARATION IS A RECORD TYPE, DECLARED IN THE VISIBLE
+--     PART OF THE SAME PACKAGE.
+
+-- HISTORY:
+--     VCL 10/09/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CORRECTED
+--                    CHECKS FOR FAILURE.
+
+WITH SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CD1009Z IS
+BEGIN
+     TEST ("CD1009Z", "A RECORD REPRESENTATION CLAUSE MAY BE GIVEN " &
+                      "IN THE PRIVATE PART OF A PACKAGE FOR A " &
+                      "LIMITED PRIVATE TYPE, WHOSE FULL TYPE " &
+                      "DECLARATION IS A RECORD TYPE DECLARED IN THE " &
+                      "VISIBLE PART OF THE SAME PACKAGE");
+     DECLARE
+          PACKAGE PACK IS
+               UNITS_PER_INTEGER : CONSTANT :=
+                    (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
+                    SYSTEM.STORAGE_UNIT;
+
+               TYPE CHECK_TYPE_1 IS LIMITED PRIVATE;
+
+               PROCEDURE P;
+          PRIVATE
+               TYPE CHECK_TYPE_1 IS
+                    RECORD
+                         I1 : INTEGER RANGE 0 .. 255;
+                         B1 : BOOLEAN;
+                         B2 : BOOLEAN;
+                         I2 : INTEGER RANGE 0 .. 15;
+                    END RECORD;
+               FOR CHECK_TYPE_1 USE
+                    RECORD
+                         I1 AT 0 * UNITS_PER_INTEGER
+                              RANGE 0 .. INTEGER'SIZE - 1;
+                         B1 AT 1 * UNITS_PER_INTEGER
+                              RANGE 0 .. BOOLEAN'SIZE - 1;
+                         B2 AT 2 * UNITS_PER_INTEGER
+                              RANGE 0 .. BOOLEAN'SIZE - 1;
+                         I2 AT 3 * UNITS_PER_INTEGER
+                              RANGE 0 .. INTEGER'SIZE - 1;
+                    END RECORD;
+          END PACK;
+
+          PACKAGE BODY PACK IS
+               PROCEDURE P IS
+                    R1 : CHECK_TYPE_1;
+               BEGIN
+                    IF R1.I1'FIRST_BIT /= 0 OR
+                              R1.I1'LAST_BIT /= INTEGER'SIZE - 1 OR
+                              R1.I1'POSITION /= 0 THEN
+                         FAILED ("INCORRECT REPRESENTATION FOR R1.I1");
+                    END IF;
+
+                    IF R1.B1'FIRST_BIT /= 0 OR
+                              R1.B1'LAST_BIT /= BOOLEAN'SIZE - 1 OR
+                              R1.B1'POSITION /= 1 * UNITS_PER_INTEGER
+                                   THEN
+                         FAILED ("INCORRECT REPRESENTATION FOR R1.B1");
+                    END IF;
+
+                    IF R1.B2'FIRST_BIT /= 0 OR
+                              R1.B2'LAST_BIT /= BOOLEAN'SIZE - 1 OR
+                              R1.B2'POSITION /= 2 * UNITS_PER_INTEGER
+                                   THEN
+                         FAILED ("INCORRECT REPRESENTATION FOR R1.B2");
+                    END IF;
+
+                    IF R1.I2'FIRST_BIT /= 0 OR
+                              R1.I2'LAST_BIT /= INTEGER'SIZE - 1 OR
+                              R1.I2'POSITION /= 3 * UNITS_PER_INTEGER
+                                   THEN
+                         FAILED ("INCORRECT REPRESENTATION FOR R1.I2");
+                    END IF;
+               END P;
+          END PACK;
+
+          USE PACK;
+
+     BEGIN
+          P;
+     END;
+
+     RESULT;
+END CD1009Z;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03a.ada
new file mode 100644
index 000000000..1b4bf239c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03a.ada
@@ -0,0 +1,84 @@
+-- CD1C03A.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 SIZE OF A DERIVED TYPE IS INHERITED FROM THE
+--     PARENT IF THE SIZE OF THE PARENT WAS DETERMINED BY A SIZE
+--     CLAUSE.
+
+-- HISTORY:
+--     JET  09/16/87 CREATED ORIGINAL TEST.
+--     DHH  03/30/89 CHANGED SPECIFIED_SIZE TO 5, ADDED CHECK ON
+--                   REPRESENTATION CLAUSES, AND CHANGED THE TEST
+--                   EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                     -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD1C03A IS
+
+     SPECIFIED_SIZE : CONSTANT := 5;
+
+     TYPE PARENT_TYPE IS RANGE -8 .. 7;
+
+     FOR PARENT_TYPE'SIZE USE SPECIFIED_SIZE;
+     PT : PARENT_TYPE := -7;
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+
+     DT : DERIVED_TYPE := -7;
+     PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (DERIVED_TYPE);
+     PROCEDURE CHECK_2 IS NEW LENGTH_CHECK (PARENT_TYPE);
+
+BEGIN
+
+     TEST("CD1C03A", "CHECK THAT THE SIZE OF A DERIVED TYPE IS " &
+                     "INHERITED FROM THE PARENT IF THE SIZE OF " &
+                     "THE PARENT WAS DETERMINED BY A SIZE CLAUSE");
+
+     IF PARENT_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("PARENT_TYPE'SIZE /= " &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(PARENT_TYPE'SIZE));
+     END IF;
+
+     IF DERIVED_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("DERIVED_TYPE'SIZE /= " &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_TYPE'SIZE));
+     END IF;
+
+     IF DT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("DT'SIZE SHOULD NOT BE LESS THAN" &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DT'SIZE));
+     END IF;
+
+     CHECK_1 (DT, 5, "DERIVED_TYPE");
+     CHECK_2 (PT, 5, "PARENT_TYPE");
+     RESULT;
+
+END CD1C03A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03b.ada
new file mode 100644
index 000000000..5536ead82
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03b.ada
@@ -0,0 +1,78 @@
+-- CD1C03B.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 SIZE OF A DERIVED TYPE IS INHERITED FROM THE
+--     PARENT IF THE SIZE OF THE PARENT WAS DETERMINED BY A PRAGMA
+--     PACK.
+
+-- HISTORY:
+--     JET 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 03/27/89  MODIFIED COMPARISON OF OBJECT SIZE TO PARENT SIZE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1C03B IS
+
+     TYPE ENUM IS (E1, E2, E3);
+
+     TYPE NORMAL_TYPE IS ARRAY (1 .. 100) OF ENUM;
+
+     TYPE PARENT_TYPE IS ARRAY (1 .. 100) OF ENUM;
+     PRAGMA PACK (PARENT_TYPE);
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+     X : DERIVED_TYPE := (OTHERS => ENUM'FIRST);
+
+BEGIN
+
+     TEST("CD1C03B", "CHECK THAT THE SIZE OF A DERIVED TYPE IS " &
+                     "INHERITED FROM THE PARENT IF THE SIZE OF " &
+                     "THE PARENT WAS DETERMINED BY A PRAGMA PACK");
+
+     IF PARENT_TYPE'SIZE = IDENT_INT (NORMAL_TYPE'SIZE) THEN
+          COMMENT ("PRAGMA PACK HAD NO EFFECT ON THE SIZE OF " &
+                   "PARENT_TYPE, WHICH IS" &
+                   INTEGER'IMAGE(PARENT_TYPE'SIZE));
+     ELSIF PARENT_TYPE'SIZE > IDENT_INT (NORMAL_TYPE'SIZE) THEN
+          FAILED ("PARENT_TYPE'SIZE SHOULD NOT BE GREATER THAN" &
+                  INTEGER'IMAGE(NORMAL_TYPE'SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(PARENT_TYPE'SIZE));
+     END IF;
+
+     IF DERIVED_TYPE'SIZE > IDENT_INT (PARENT_TYPE'SIZE) THEN
+          FAILED ("DERIVED_TYPE'SIZE SHOULD NOT BE GREATER THAN" &
+                  INTEGER'IMAGE(PARENT_TYPE'SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_TYPE'SIZE));
+     END IF;
+
+     IF X'SIZE < DERIVED_TYPE'SIZE THEN
+          FAILED ("OBJECT SIZE TOO LARGE.  FIRST VALUE IS " &
+                  ENUM'IMAGE ( X(1) ) );
+     END IF;
+
+     RESULT;
+
+END CD1C03B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03c.ada
new file mode 100644
index 000000000..9e37bb4b0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03c.ada
@@ -0,0 +1,71 @@
+-- CD1C03C.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 COLLECTION SIZE OF A DERIVED TYPE IS
+--     INHERITED FROM THE PARENT IF THE COLLECTION SIZE OF
+--     THE PARENT WAS DETERMINED BY A COLLECTION SIZE CLAUSE.
+
+-- HISTORY:
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     JET 09/16/87  CREATED ORIGINAL TEST.
+--     RJW 02/10/88  RENAMED FROM CD1C03C.TST.  REMOVED MACRO -
+--                   ACC_SIZE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1C03C IS
+
+     SPECIFIED_SIZE : CONSTANT := 512;
+
+     TYPE PARENT_TYPE IS ACCESS STRING;
+
+     FOR PARENT_TYPE'STORAGE_SIZE USE SPECIFIED_SIZE;
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+
+BEGIN
+
+     TEST("CD1C03C", "CHECK THAT THE COLLECTION  SIZE OF A " &
+                     "DERIVED TYPE IS INHERITED FROM THE PARENT " &
+                     "IF THE COLLECTION SIZE OF THE PARENT WAS " &
+                     "DETERMINED BY A COLLECTION SIZE CLAUSE");
+
+     IF PARENT_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("PARENT_TYPE'STORAGE_SIZE SHOULD NOT BE " &
+                  "LESS THAN SPECIFIED_SIZE.  " &
+                  "ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(PARENT_TYPE'SIZE));
+     END IF;
+
+     IF DERIVED_TYPE'STORAGE_SIZE /=
+                         IDENT_INT (PARENT_TYPE'STORAGE_SIZE) THEN
+          FAILED ("DERIVED_TYPE'STORAGE_SIZE SHOULD BE " &
+                  "EQUAL TO PARENT_TYPE'STORAGE_SIZE.  " &
+                  "ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_TYPE'STORAGE_SIZE));
+     END IF;
+
+     RESULT;
+
+END CD1C03C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03e.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03e.tst
new file mode 100644
index 000000000..8b706c553
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03e.tst
@@ -0,0 +1,82 @@
+-- CD1C03E.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 THE STORAGE SIZE OF A DERIVED TASK TYPE IS
+--     INHERITED FROM THE PARENT IF THE STORAGE SIZE OF THE
+--     PARENT WAS DETERMINED BY A TASK STORAGE SIZE CLAUSE.
+
+-- MACRO SUBSTITUTION:
+--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+--     THE ACTIVATION OF A TASK.
+
+-- HISTORY:
+--     JET 09/16/87  CREATED ORIGINAL TEST.
+--     DHH 03/30/89  CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
+--                   EXTENSION FROM '.DEP' TO '.TST'.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1C03E IS
+
+     SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+
+     TASK TYPE PARENT_TYPE IS
+          ENTRY E;
+     END PARENT_TYPE;
+
+     FOR PARENT_TYPE'STORAGE_SIZE USE SPECIFIED_SIZE;
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+
+     TASK BODY PARENT_TYPE IS
+     BEGIN
+          ACCEPT E DO
+               COMMENT ("ENTRY E ACCEPTED");
+          END E;
+     END PARENT_TYPE;
+
+BEGIN
+
+     TEST("CD1C03E", "CHECK THAT THE STORAGE SIZE OF A DERIVED " &
+                     "TASK TYPE IS INHERITED FROM THE PARENT IF " &
+                     "THE STORAGE SIZE OF THE PARENT WAS " &
+                     "DETERMINED BY A TASK STORAGE SIZE CLAUSE");
+
+     IF PARENT_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("PARENT_TYPE'STORAGE_SIZE SHOULD NOT BE LESS THAN" &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(PARENT_TYPE'STORAGE_SIZE));
+     END IF;
+
+     IF DERIVED_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("DERIVED_TYPE'STORAGE_SIZE SHOULD NOT BE LESS THAN " &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_TYPE'STORAGE_SIZE));
+     END IF;
+
+     RESULT;
+
+END CD1C03E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03f.ada
new file mode 100644
index 000000000..3686710c6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03f.ada
@@ -0,0 +1,76 @@
+-- CD1C03F.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 VALUE OF 'SMALL FOR A DERIVED FIXED POINT TYPE
+--     IS INHERITED FROM THE PARENT IF THE VALUE OF 'SMALL FOR THE
+--     PARENT WAS DETERMINED BY A 'SMALL SPECIFICATION CLAUSE.
+
+-- HISTORY:
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     JET 09/17/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1C03F IS
+
+     SPECIFIED_SMALL : CONSTANT := 0.25;
+
+     TYPE FLT IS NEW FLOAT;
+
+     TYPE PARENT_TYPE IS DELTA 1.0 RANGE 0.0 .. 100.0;
+
+     FOR PARENT_TYPE'SMALL USE SPECIFIED_SMALL;
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+
+     FUNCTION IDENT_FLT (F : FLT) RETURN FLT IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN F;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END;
+
+BEGIN
+
+     TEST("CD1C03F", "CHECK THAT THE VALUE OF 'SMALL FOR A " &
+                     "DERIVED FIXED POINT TYPE IS INHERITED " &
+                     "FROM THE PARENT IF THE VALUE OF 'SMALL " &
+                     "FOR THE PARENT WAS DETERMINED BY A 'SMALL " &
+                     "SPECIFICATION CLAUSE");
+
+     IF PARENT_TYPE'SMALL /= IDENT_FLT (SPECIFIED_SMALL) THEN
+          FAILED ("PARENT_TYPE'SMALL SHOULD BE EQUAL TO " &
+                  "THE SPECIFIED VALUE");
+     END IF;
+
+     IF DERIVED_TYPE'SMALL /= IDENT_FLT (SPECIFIED_SMALL) THEN
+          FAILED ("DERIVED_TYPE'SMALL SHOULD BE EQUAL TO " &
+                  "THE SPECIFIED VALUE");
+     END IF;
+
+     RESULT;
+
+END CD1C03F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03g.ada
new file mode 100644
index 000000000..898b68a1b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03g.ada
@@ -0,0 +1,65 @@
+-- CD1C03G.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 SIZE OF A DERIVED ENUMERATION TYPE IS
+--     INHERITED FROM THE PARENT IF THE SIZE OF THE PARENT WAS
+--     DETERMINED BY AN ENUMERATION REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     JET 09/17/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1C03G IS
+
+     TYPE NORMAL_TYPE IS (RED, BLUE, GREEN, YELLOW);
+
+     TYPE PARENT_TYPE IS (RED, BLUE, GREEN, YELLOW);
+
+     FOR PARENT_TYPE USE
+          (RED => 256, BLUE => 257, GREEN => 258, YELLOW => 259);
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+
+BEGIN
+
+     TEST("CD1C03G", "CHECK THAT THE SIZE OF A DERIVED ENUMERATION " &
+                     "TYPE IS INHERITED FROM THE PARENT IF THE " &
+                     "SIZE OF THE PARENT WAS DETERMINED BY AN " &
+                     "ENUMERATION REPRESENTATION CLAUSE");
+
+     IF PARENT_TYPE'SIZE = IDENT_INT (NORMAL_TYPE'SIZE) THEN
+          COMMENT ("PARENT_TYPE'SIZE WAS NOT AFFECTED BY THE " &
+                   "REPRESENTATION CLAUSE");
+     END IF;
+
+     IF DERIVED_TYPE'SIZE /= IDENT_INT (PARENT_TYPE'SIZE) THEN
+          FAILED ("DERIVED_TYPE'SIZE WAS NOT INHERITED FROM " &
+                  "PARENT_TYPE");
+     END IF;
+
+     RESULT;
+
+END CD1C03G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03h.ada
new file mode 100644
index 000000000..ad84e9196
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03h.ada
@@ -0,0 +1,122 @@
+-- CD1C03H.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 RECORD SIZE AND THE COMPONENT POSITIONS AND
+--     SIZES OF A DERIVED RECORD TYPE ARE INHERITED FROM THE
+--     PARENT IF THOSE ASPECTS OF THE PARENT WERE DETERMINED BY A
+--     RECORD REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     JET 09/17/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+
+PROCEDURE CD1C03H IS
+
+     UNITS_PER_INTEGER : CONSTANT :=
+          (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
+          SYSTEM.STORAGE_UNIT;
+
+     TYPE E_TYPE IS (RED, BLUE, GREEN);
+
+     TYPE PARENT_TYPE IS
+          RECORD
+               I : INTEGER RANGE 0 .. 127 := 127;
+               C : CHARACTER := 'S';
+               B : BOOLEAN := FALSE;
+               E : E_TYPE := BLUE;
+          END RECORD;
+
+     FOR PARENT_TYPE USE
+          RECORD
+               C AT 0 * UNITS_PER_INTEGER RANGE 0 .. CHARACTER'SIZE - 1;
+               B AT 1 * UNITS_PER_INTEGER RANGE 0 .. BOOLEAN'SIZE - 1;
+               I AT 2 * UNITS_PER_INTEGER RANGE 0 .. INTEGER'SIZE/2 - 1;
+               E AT 3 * UNITS_PER_INTEGER RANGE 0 .. CHARACTER'SIZE - 1;
+          END RECORD;
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+
+     P_REC : PARENT_TYPE;
+     REC   : DERIVED_TYPE;
+
+BEGIN
+
+     TEST("CD1C03H", "CHECK THAT THE RECORD SIZE AND THE COMPONENT " &
+                     "POSITIONS AND SIZES OF A DERIVED RECORD " &
+                     "TYPE ARE INHERITED FROM THE PARENT IF THOSE " &
+                     "ASPECTS OF THE PARENT WERE DETERMINED BY " &
+                     "A RECORD REPRESENTATION CLAUSE");
+
+     IF DERIVED_TYPE'SIZE /= IDENT_INT (PARENT_TYPE'SIZE) THEN
+          FAILED ("DERIVED_TYPE'SIZE WAS NOT INHERITED FROM " &
+                  "PARENT_TYPE");
+     END IF;
+
+     IF REC.I'SIZE /= P_REC.I'SIZE OR
+        REC.C'SIZE /= P_REC.C'SIZE OR
+        REC.B'SIZE /= P_REC.B'SIZE OR
+        REC.E'SIZE /= P_REC.E'SIZE THEN
+          FAILED ("THE SIZES OF DERIVED_TYPE ELEMENTS WERE NOT " &
+                  "INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     REC := (12, 'T', TRUE, RED);
+
+     IF (REC.I /= 12) OR (REC.C /= 'T') OR
+        (NOT REC.B) OR (REC.E /= RED) THEN
+          FAILED ("THE VALUES OF DERIVED_TYPE COMPONENTS WERE " &
+                  "INCORRECT");
+     END IF;
+
+     IF REC.I'POSITION /= P_REC.I'POSITION OR
+        REC.C'POSITION /= P_REC.C'POSITION OR
+        REC.B'POSITION /= P_REC.B'POSITION OR
+        REC.E'POSITION /= P_REC.E'POSITION THEN
+          FAILED ("THE POSITIONS OF DERIVED_TYPE COMPONENTS WERE " &
+                  "NOT INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     IF REC.I'FIRST_BIT /= P_REC.I'FIRST_BIT OR
+        REC.C'FIRST_BIT /= P_REC.C'FIRST_BIT OR
+        REC.B'FIRST_BIT /= P_REC.B'FIRST_BIT OR
+        REC.E'FIRST_BIT /= P_REC.E'FIRST_BIT THEN
+          FAILED ("THE FIRST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
+                  "NOT INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     IF REC.I'LAST_BIT /= P_REC.I'LAST_BIT OR
+        REC.C'LAST_BIT /= P_REC.C'LAST_BIT OR
+        REC.B'LAST_BIT /= P_REC.B'LAST_BIT OR
+        REC.E'LAST_BIT /= P_REC.E'LAST_BIT THEN
+          FAILED ("THE LAST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
+                  "NOT INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     RESULT;
+
+END CD1C03H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03i.ada
new file mode 100644
index 000000000..25ad2e082
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c03i.ada
@@ -0,0 +1,115 @@
+-- CD1C03I.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 RECORD SIZE AND THE COMPONENT POSITIONS AND
+--     SIZES OF A DERIVED RECORD TYPE ARE INHERITED FROM THE
+--     PARENT IF THOSE ASPECTS OF THE PARENT WERE DETERMINED BY THE
+--     PRAGMA PACK.
+
+-- HISTORY:
+--     JET 09/17/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD1C03I IS
+
+     TYPE E_TYPE IS (RED, BLUE, GREEN);
+
+     TYPE PARENT_TYPE IS
+          RECORD
+               B1: BOOLEAN := TRUE;
+               I : INTEGER RANGE 0 .. 127 := 127;
+               C : CHARACTER := 'S';
+               B2: BOOLEAN := FALSE;
+               E : E_TYPE := BLUE;
+          END RECORD;
+
+     PRAGMA PACK (PARENT_TYPE);
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+
+     P_REC : PARENT_TYPE;
+     REC   : DERIVED_TYPE;
+
+BEGIN
+
+     TEST("CD1C03I", "CHECK THAT THE RECORD SIZE AND THE COMPONENT " &
+                     "POSITIONS AND SIZES OF A DERIVED RECORD " &
+                     "TYPE ARE INHERITED FROM THE PARENT IF THOSE " &
+                     "ASPECTS OF THE PARENT WERE DETERMINED BY " &
+                     "THE PRAGMA PACK");
+
+     IF DERIVED_TYPE'SIZE /= PARENT_TYPE'SIZE THEN
+          FAILED ("DERIVED_TYPE'SIZE WAS NOT INHERITED FROM " &
+                  "PARENT_TYPE");
+     END IF;
+
+     IF REC.I'SIZE /= P_REC.I'SIZE OR
+        REC.C'SIZE /= P_REC.C'SIZE OR
+        REC.B1'SIZE /= P_REC.B1'SIZE OR
+        REC.B2'SIZE /= P_REC.B2'SIZE OR
+        REC.E'SIZE /= P_REC.E'SIZE THEN
+          FAILED ("THE SIZES OF DERIVED_TYPE ELEMENTS WERE NOT " &
+                  "INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     REC := (FALSE, 12, 'T', TRUE, RED);
+
+     IF (REC.I /= 12) OR (REC.C /= 'T') OR
+         REC.B1 OR (NOT REC.B2) OR (REC.E /= RED) THEN
+          FAILED ("THE VALUES OF DERIVED_TYPE COMPONENTS WERE " &
+                  "INCORRECT");
+     END IF;
+
+     IF REC.I'POSITION /= P_REC.I'POSITION OR
+        REC.C'POSITION /= P_REC.C'POSITION OR
+        REC.B1'POSITION /= P_REC.B1'POSITION OR
+        REC.B2'POSITION /= P_REC.B2'POSITION OR
+        REC.E'POSITION /= P_REC.E'POSITION THEN
+          FAILED ("THE POSITIONS OF DERIVED_TYPE COMPONENTS WERE " &
+                  "NOT INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     IF REC.I'FIRST_BIT /= P_REC.I'FIRST_BIT OR
+        REC.C'FIRST_BIT /= P_REC.C'FIRST_BIT OR
+        REC.B1'FIRST_BIT /= P_REC.B1'FIRST_BIT OR
+        REC.B2'FIRST_BIT /= P_REC.B2'FIRST_BIT OR
+        REC.E'FIRST_BIT /= P_REC.E'FIRST_BIT THEN
+          FAILED ("THE FIRST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
+                  "NOT INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     IF REC.I'LAST_BIT /= P_REC.I'LAST_BIT OR
+        REC.C'LAST_BIT /= P_REC.C'LAST_BIT OR
+        REC.B1'LAST_BIT /= P_REC.B1'LAST_BIT OR
+        REC.B2'LAST_BIT /= P_REC.B2'LAST_BIT OR
+        REC.E'LAST_BIT /= P_REC.E'LAST_BIT THEN
+          FAILED ("THE LAST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
+                  "NOT INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     RESULT;
+
+END CD1C03I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c04a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c04a.ada
new file mode 100644
index 000000000..2c04b1e7b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c04a.ada
@@ -0,0 +1,147 @@
+-- CD1C04A.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 SIZE CLAUSE CAN BE GIVEN FOR A DERIVED TYPE, A
+--     DERIVED PRIVATE TYPE, AND A DERIVED LIMITED PRIVATE TYPE EVEN
+--     IF THE SIZE IS INHERITED FROM THE PARENT, AND THAT THE SIZE
+--     CLAUSES FOR THE DERIVED TYPES OVERRIDE THE PARENTS'.
+
+-- HISTORY:
+--     PWB 03/25/89  MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST
+--                   TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     JET 09/16/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1C04A IS
+
+     SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE / 2;
+
+     TYPE PARENT_TYPE IS RANGE 0 .. 100;
+
+     FOR PARENT_TYPE'SIZE USE INTEGER'SIZE;
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+
+     FOR DERIVED_TYPE'SIZE USE SPECIFIED_SIZE;
+
+     PACKAGE P IS
+          TYPE PRIVATE_PARENT IS PRIVATE;
+          TYPE LIM_PRIV_PARENT IS LIMITED PRIVATE;
+     PRIVATE
+          TYPE PRIVATE_PARENT IS RANGE 0 .. 100;
+          FOR PRIVATE_PARENT'SIZE USE INTEGER'SIZE;
+          TYPE LIM_PRIV_PARENT IS RANGE 0 .. 100;
+          FOR LIM_PRIV_PARENT'SIZE USE INTEGER'SIZE;
+     END P;
+
+     USE P;
+
+     TYPE DERIVED_PRIVATE_TYPE IS NEW PRIVATE_PARENT;
+
+     FOR DERIVED_PRIVATE_TYPE'SIZE USE SPECIFIED_SIZE;
+
+     TYPE DERIVED_LIM_PRIV_TYPE IS NEW LIM_PRIV_PARENT;
+
+     FOR DERIVED_LIM_PRIV_TYPE'SIZE USE SPECIFIED_SIZE;
+
+     DT : DERIVED_TYPE := 100;
+     DPT : DERIVED_PRIVATE_TYPE;
+     DLPT : DERIVED_LIM_PRIV_TYPE;
+
+BEGIN
+
+     TEST("CD1C04A", "CHECK THAT A SIZE CLAUSE CAN BE GIVEN FOR " &
+                     "A DERIVED TYPE, A DERIVED PRIVATE TYPE, AND " &
+                     "A DERIVED LIMITED PRIVATE TYPE EVEN IF THE " &
+                     "SIZE IS INHERITED FROM THE PARENT, AND THAT " &
+                     "THE SIZE CLAUSES FOR THE DERIVED TYPES " &
+                     "OVERRIDE THE PARENTS'");
+
+     IF PARENT_TYPE'SIZE /= IDENT_INT (INTEGER'SIZE) THEN
+          FAILED ("PARENT_TYPE'SIZE SHOULD BE " &
+                  INTEGER'IMAGE(INTEGER'SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(PARENT_TYPE'SIZE));
+     END IF;
+
+     IF DERIVED_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("DERIVED_TYPE'SIZE SHOULD BE " &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_TYPE'SIZE));
+     END IF;
+
+     IF DT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("DT'SIZE SHOULD NOT BE LESS THAN" &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DT'SIZE));
+     END IF;
+
+     IF PRIVATE_PARENT'SIZE < IDENT_INT (INTEGER'SIZE) THEN
+          FAILED ("PRIVATE_PARENT'SIZE SHOULD NOT BE LESS THAN" &
+                  INTEGER'IMAGE(INTEGER'SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(PRIVATE_PARENT'SIZE));
+     END IF;
+
+     IF DERIVED_PRIVATE_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("DERIVED_PRIVATE_TYPE'SIZE SHOULD BE " &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_PRIVATE_TYPE'SIZE));
+     END IF;
+
+     IF DPT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("DPT'SIZE SHOULD NOT BE LESS THAN" &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DPT'SIZE));
+     END IF;
+
+     IF LIM_PRIV_PARENT'SIZE /= IDENT_INT (INTEGER'SIZE) THEN
+          FAILED ("LIM_PRIV_PARENT'SIZE SHOULD BE" &
+                  INTEGER'IMAGE(INTEGER'SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(LIM_PRIV_PARENT'SIZE));
+     END IF;
+
+     IF DERIVED_LIM_PRIV_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("DERIVED_LIM_PRIV_TYPE'SIZE SHOULD BE " &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_LIM_PRIV_TYPE'SIZE));
+     END IF;
+
+     IF DLPT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("DLPT'SIZE SHOULD NOT BE LESS THAN" &
+                  INTEGER'IMAGE(SPECIFIED_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DLPT'SIZE));
+     END IF;
+
+     RESULT;
+
+END CD1C04A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c04d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c04d.ada
new file mode 100644
index 000000000..9e95b546d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c04d.ada
@@ -0,0 +1,80 @@
+-- CD1C04D.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 ENUMERATION REPRESENTATION CLAUSE CAN BE GIVEN
+--     FOR A DERIVED ENUMERATION TYPE EVEN IF THE REPRESENTATION IS
+--     INHERITED FROM THE PARENT, AND THAT THE CLAUSE FOR THE DERIVED
+--     TYPE OVERRIDES THAT OF THE PARENT.
+
+-- HISTORY:
+--     JET 09/21/87  CREATED ORIGINAL TEST.
+--     DHH 03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
+--                   '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSE.
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD1C04D IS
+
+     TYPE NORMAL_TYPE IS (RED, BLUE, GREEN, YELLOW);
+
+     TYPE PARENT_TYPE IS (RED, BLUE, GREEN, YELLOW);
+
+     FOR PARENT_TYPE USE
+          (RED => 256, BLUE => 257, GREEN => 258, YELLOW => 259);
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+
+     FOR DERIVED_TYPE USE
+          (RED => 16, BLUE => 17, GREEN => 18, YELLOW => 19);
+
+     TYPE INT1 IS RANGE 16 .. 19;
+     FOR INT1'SIZE USE DERIVED_TYPE'SIZE;
+
+     PROCEDURE CHECK_1 IS NEW ENUM_CHECK(DERIVED_TYPE, INT1);
+
+BEGIN
+
+     TEST("CD1C04D", "CHECK THAT AN ENUMERATION REPRESENTATION " &
+                     "CLAUSE CAN BE GIVEN FOR A DERIVED ENUMERATION " &
+                     "TYPE EVEN IF THE REPRESENTATION IS INHERITED " &
+                     "FROM THE PARENT, AND THAT THE CLAUSE FOR THE " &
+                     "DERIVED TYPE OVERRIDES THAT OF THE PARENT");
+
+     IF PARENT_TYPE'SIZE = IDENT_INT (NORMAL_TYPE'SIZE) THEN
+          COMMENT ("PARENT_TYPE'SIZE WAS NOT AFFECTED BY THE " &
+                   "REPRESENTATION CLAUSE");
+     END IF;
+
+     IF DERIVED_TYPE'SIZE >= IDENT_INT (PARENT_TYPE'SIZE) THEN
+          COMMENT ("THE SPECIFICATION OF SMALLER VALUES FOR THE " &
+                   "REPRESENTATION OF DERIVED_TYPE DID NOT " &
+                   "REDUCE THE SIZE OF DERIVED_TYPE");
+     END IF;
+
+     CHECK_1 (DERIVED_TYPE'(GREEN), 18, "DERIVED_TYPE");
+
+     RESULT;
+
+END CD1C04D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c04e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c04e.ada
new file mode 100644
index 000000000..21c7a7eef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c04e.ada
@@ -0,0 +1,124 @@
+-- CD1C04E.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 RECORD REPRESENTATION CLAUSE CAN BE GIVEN FOR
+--     A DERIVED RECORD TYPE EVEN IF THE REPRESENTATION IS INHERITED
+--     FROM THE PARENT, AND THAT THE REPRESENTATION CLAUSE FOR THE
+--     DERIVED TYPE OVERRIDES THAT OF THE PARENT TYPE.
+
+-- HISTORY:
+--     PWB 03/25/89  DELETED CHECKS OF COMPONENT'SIZE; CHANGED
+--         EXTENSION FROM '.ADA' TO '.DEP'.
+--     JET 09/21/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM; USE SYSTEM;
+
+PROCEDURE CD1C04E IS
+
+     UNITS_PER_INTEGER : CONSTANT :=
+          (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
+          SYSTEM.STORAGE_UNIT;
+
+     TYPE E_TYPE IS (RED, BLUE, GREEN);
+
+     TYPE PARENT_TYPE IS
+          RECORD
+               I : INTEGER RANGE 0 .. 127 := 127;
+               C : CHARACTER := 'S';
+               B : BOOLEAN := FALSE;
+               E : E_TYPE := BLUE;
+          END RECORD;
+
+     FOR PARENT_TYPE USE
+          RECORD
+               C AT 0 * UNITS_PER_INTEGER RANGE 0 .. CHARACTER'SIZE - 1;
+               B AT 1 * UNITS_PER_INTEGER RANGE 0 .. BOOLEAN'SIZE - 1;
+               I AT 2 * UNITS_PER_INTEGER RANGE 0 .. INTEGER'SIZE/2 - 1;
+               E AT 3 * UNITS_PER_INTEGER RANGE 0 .. CHARACTER'SIZE - 1;
+          END RECORD;
+
+     TYPE DERIVED_TYPE IS NEW PARENT_TYPE;
+
+     FOR DERIVED_TYPE USE
+          RECORD
+               C AT 1 * UNITS_PER_INTEGER RANGE 1 .. CHARACTER'SIZE + 1;
+               B AT 3 * UNITS_PER_INTEGER RANGE 1 .. BOOLEAN'SIZE + 1;
+               I AT 5 * UNITS_PER_INTEGER RANGE 1 .. INTEGER'SIZE/2 + 1;
+               E AT 7 * UNITS_PER_INTEGER RANGE 1 .. CHARACTER'SIZE + 1;
+          END RECORD;
+
+     P_REC : PARENT_TYPE;
+     REC   : DERIVED_TYPE;
+
+BEGIN
+
+     TEST("CD1C04E", "CHECK THAT A RECORD REPRESENTATION CLAUSE " &
+                     "CAN BE GIVEN FOR A DERIVED RECORD TYPE EVEN " &
+                     "IF THE REPRESENTATION IS INHERITED FROM " &
+                     "THE PARENT, AND THAT THE REPRESENTATION " &
+                     "CLAUSE FOR THE DERIVED TYPE OVERRIDES THAT " &
+                     "OF THE PARENT TYPE");
+
+     IF DERIVED_TYPE'SIZE = IDENT_INT (PARENT_TYPE'SIZE) THEN
+          FAILED ("DERIVED_TYPE'SIZE WAS INHERITED FROM " &
+                  "PARENT_TYPE");
+     END IF;
+
+     REC := (12, 'T', TRUE, RED);
+
+     IF (REC.I /= 12) OR (REC.C /= 'T') OR
+        (NOT REC.B) OR (REC.E /= RED) THEN
+          FAILED ("THE VALUES OF DERIVED_TYPE COMPONENTS WERE " &
+                  "INCORRECT");
+     END IF;
+
+     IF REC.I'POSITION = P_REC.I'POSITION OR
+        REC.C'POSITION = P_REC.C'POSITION OR
+        REC.B'POSITION = P_REC.B'POSITION OR
+        REC.E'POSITION = P_REC.E'POSITION THEN
+          FAILED ("THE POSITIONS OF DERIVED_TYPE COMPONENTS WERE " &
+                  "INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     IF REC.I'FIRST_BIT = P_REC.I'FIRST_BIT OR
+        REC.C'FIRST_BIT = P_REC.C'FIRST_BIT OR
+        REC.B'FIRST_BIT = P_REC.B'FIRST_BIT OR
+        REC.E'FIRST_BIT = P_REC.E'FIRST_BIT THEN
+          FAILED ("THE FIRST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
+                  "INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     IF REC.I'LAST_BIT = P_REC.I'LAST_BIT OR
+        REC.C'LAST_BIT = P_REC.C'LAST_BIT OR
+        REC.B'LAST_BIT = P_REC.B'LAST_BIT OR
+        REC.E'LAST_BIT = P_REC.E'LAST_BIT THEN
+          FAILED ("THE LAST_BITS OF DERIVED_TYPE COMPONENTS WERE " &
+                  "INHERITED FROM PARENT_TYPE");
+     END IF;
+
+     RESULT;
+
+END CD1C04E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c06a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c06a.tst
new file mode 100644
index 000000000..fff91a357
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd1c06a.tst
@@ -0,0 +1,100 @@
+-- CD1C06A.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 THE EXPRESSION IN A TASK STORAGE SIZE CLAUSE
+--     IS NOT EVALUATED AGAIN WHEN A DERIVED TYPE INHERITS THE
+--     STORAGE SIZE OF THE PARENT.
+
+-- MACRO SUBSTITUTION:
+--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+--     THE ACTIVATION OF A TASK.
+
+-- HISTORY:
+--     JET 09/21/87  CREATED ORIGINAL TEST.
+--     DHH 03/30/89  CHANGED SPECIFIED_SIZE TO A MACRO VALUE AND CHANGED
+--                   EXTENSION FROM '.DEP' TO '.TST'.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD1C06A IS
+
+     I : INTEGER := 0;
+
+     SPECIFIED_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+
+     FUNCTION COUNT_SIZE RETURN INTEGER IS
+     BEGIN
+          I := I + 1;
+          RETURN SPECIFIED_SIZE * I;
+     END;
+
+BEGIN
+
+     TEST("CD1C06A", "CHECK THAT THE EXPRESSION IN A TASK STORAGE " &
+                     "SIZE CLAUSE IS NOT EVALUATED AGAIN WHEN A " &
+                     "DERIVED TYPE INHERITS THE STORAGE SIZE OF " &
+                     "THE PARENT");
+
+     DECLARE
+
+          TASK TYPE PARENT IS
+               ENTRY E;
+          END PARENT;
+
+          FOR PARENT'STORAGE_SIZE USE COUNT_SIZE;
+
+          TYPE DERIVED_TYPE IS NEW PARENT;
+
+          TASK BODY PARENT IS
+          BEGIN
+               ACCEPT E DO
+                    COMMENT ("ENTRY E ACCEPTED");
+               END E;
+          END PARENT;
+
+     BEGIN
+          IF PARENT'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
+               FAILED ("PARENT'STORAGE_SIZE SHOULD NOT BE " &
+                       "LESS THAN" & INTEGER'IMAGE (SPECIFIED_SIZE) &
+                       ".  ACTUAL SIZE IS" &
+                       INTEGER'IMAGE(PARENT'STORAGE_SIZE));
+          END IF;
+
+          IF DERIVED_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
+               FAILED ("DERIVED_TYPE'STORAGE_SIZE SHOULD NOT BE " &
+                       "LESS THAN" & INTEGER'IMAGE(SPECIFIED_SIZE) &
+                       ".  ACTUAL SIZE IS" &
+                       INTEGER'IMAGE(DERIVED_TYPE'STORAGE_SIZE));
+          END IF;
+
+          IF I > IDENT_INT (1) THEN
+               FAILED ("THE EXPRESSION FOR THE STORAGE SIZE " &
+                       "SPECIFICATION WAS EVALUATED MORE THAN ONCE");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END CD1C06A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd20001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd20001.a
new file mode 100644
index 000000000..21f973873
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd20001.a
@@ -0,0 +1,275 @@
+-- CD20001.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 for packed records the components are packed as tightly
+--      as possible subject to the Size of the component subtypes.
+--      Specifically check that Boolean objects are packed one to a bit.
+--
+--      Check that the Component_Size for a packed array type is less than
+--      or equal to the smallest of those factors of the word size that are
+--      greater than or equal to the Size of the component subtype.
+--      
+-- TEST DESCRIPTION:
+--      This test defines and packs several types, and checks that the sizes
+--      of the resulting objects is as expected.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as
+--        inapplicable.  Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      22 JUL 95   SAIC   Initial version
+--      08 MAY 96   SAIC   Strengthened for 2.1
+--      29 JAN 98   EDS    Deleted check that Component_Size is really a
+--                         factor of Word_Size.
+--!
+
+----------------------------------------------------------------- CD20001_0
+
+with System;
+package CD20001_0 is
+
+  type Wordlong_Bool_Array is array(1..System.Word_Size) of Boolean;
+    pragma Pack(Wordlong_Bool_Array);                         -- ANX-C RQMT
+
+  type Def_Rep_Components is range 0..2**(System.Storage_Unit-2);
+
+  type Spec_Rep_Components is range 0..2**(System.Storage_Unit-2);
+    for Spec_Rep_Components'Size use System.Storage_Unit;     -- ANX-C RQMT
+
+  type Packed_Array_Def_Components is array(1..32) of Def_Rep_Components;
+    pragma Pack(Packed_Array_Def_Components);                 -- ANX-C RQMT
+
+  type Packed_Array_Spec_Components is array(1..32) of Spec_Rep_Components;
+    pragma Pack(Packed_Array_Spec_Components);                -- ANX-C RQMT
+
+  procedure TC_Check_Values;
+
+end CD20001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with TCTouch;
+package body CD20001_0 is
+
+  procedure TC_Check_Values is
+    My_Word      : Wordlong_Bool_Array := (others => False);
+
+    Cited_Unit   : Spec_Rep_Components := 0;
+
+    Packed_Array : Packed_Array_Def_Components := (others => 0);
+
+    Cited_Packed : Packed_Array_Spec_Components := (others => 0);
+
+  begin
+    TCTouch.Assert( My_Word'Size = System.Word_Size,
+       "pragma Pack on array of Booleans does not pack one Boolean per bit" );
+
+    TCTouch.Assert( My_Word'Component_Size = 1,
+                    "size of Boolean array component not 1 bit");
+
+    TCTouch.Assert( Cited_Unit'Size = System.Storage_Unit,
+                    "Object specified to be Storage_Unit bits not " &
+                    "Storage_Unit bits in size");
+
+    TCTouch.Assert( Packed_Array'Component_Size <= System.Storage_Unit,
+                    "Packed array component expected to be less than or " &
+                    "equal to Storage_Unit bits in size is greater than " &
+                    "Storage_Unit bits in size");
+
+    TCTouch.Assert( Cited_Packed'Component_Size = System.Storage_Unit,
+                    "Array component specified to be Storage_Unit " &
+                    "bits not Storage_Unit bits in size");
+
+  end TC_Check_Values;
+
+end CD20001_0;
+
+----------------------------------------------------------------- CD20001_1
+
+with System;
+package CD20001_1 is
+
+  type Bits_2  is range 0..2**2-1;
+    for Bits_2'Size use 2;                                    -- ANX-C RQMT
+
+  type Bits_3  is range 0..2**3-1;
+    for Bits_3'Size use 3;                                    -- ANX-C RQMT
+
+  type Bits_7  is range 0..2**7-1;
+    for Bits_7'Size use 7;                                    -- ANX-C RQMT
+
+  type Bits_8  is range 0..2**8-1;
+    for Bits_8'Size use 8;                                    -- ANX-C RQMT
+
+  type Bits_9  is range 0..2**9-1;
+    for Bits_9'Size use 9;                                    -- ANX-C RQMT
+
+  type Bits_15 is range 0..2**15-1;
+    for Bits_15'Size use 15;                                  -- ANX-C RQMT
+
+  type Pact_Aray_2  is array(0..31) of Bits_2;
+    pragma Pack( Pact_Aray_2 );                               -- ANX-C RQMT
+
+  type Pact_Aray_3  is array(0..31) of Bits_3;
+    pragma Pack( Pact_Aray_3 );                               -- ANX-C RQMT
+
+  type Pact_Aray_7  is array(0..31) of Bits_7;
+    pragma Pack( Pact_Aray_7 );                               -- ANX-C RQMT
+
+  type Pact_Aray_8  is array(0..31) of Bits_8;
+    pragma Pack( Pact_Aray_8 );                               -- ANX-C RQMT
+
+  type Pact_Aray_9  is array(0..31) of Bits_9;
+    pragma Pack( Pact_Aray_9 );                               -- ANX-C RQMT
+
+  type Pact_Aray_15 is array(0..31) of Bits_15;
+    pragma Pack( Pact_Aray_15 );                              -- ANX-C RQMT
+
+
+  procedure TC_Check_Values;
+
+end CD20001_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with TCTouch;
+package body CD20001_1 is
+
+   function Next_Factor ( Value : Positive ) return Integer is
+   -- Returns the factor of Word_Size that is next larger than Value.
+   -- If Value is greater than Word_Size, then returns Word_Size.
+     Test   : Integer := Value;
+     Found  : Boolean := False;
+  begin  -- Next_Factor
+     while not Found and Test <= System.Word_Size loop
+       if System.Word_Size mod Test = 0 then
+          Found := True;
+       else
+          Test := Test + 1;
+       end if;
+     end loop;
+     if Found then
+        return Test;
+     else
+        return System.Word_Size;
+     end if;
+  end Next_Factor;
+
+  procedure TC_Check_Values is
+  begin
+  
+    if Pact_Aray_2'Component_Size > Next_Factor ( Bits_2'Size ) then
+       Report.Failed
+          ( "2 bit element Packed Array'Component_Size too big" );
+    end if;
+
+    TCTouch.Assert( Pact_Aray_2'Component_Size <= Pact_Aray_2'Size,
+                    "2 bit Component_Size greater than array size" );
+
+    if Pact_Aray_3'Component_Size > Next_Factor ( Bits_3'Size ) then
+       Report.Failed
+          ( "3 bit element Packed Array'Component_Size too big" );
+    end if;
+
+    TCTouch.Assert( Pact_Aray_3'Component_Size <= Pact_Aray_3'Size,
+                    "3 bit Component_Size greater than array size" );
+
+    if Pact_Aray_7'Component_Size > Next_Factor ( Bits_7'Size ) then
+       Report.Failed
+          ( "7 bit element Packed Array'Component_Size too big" );
+    end if;
+
+    TCTouch.Assert( Pact_Aray_7'Component_Size <= Pact_Aray_7'Size,
+                    "7 bit Component_Size greater than array size" );
+
+    if Pact_Aray_8'Component_Size > Next_Factor ( Bits_8'Size ) then
+       Report.Failed
+          ( "8 bit element Packed Array'Component_Size too big" );
+    end if;
+
+    TCTouch.Assert( Pact_Aray_8'Component_Size <= Pact_Aray_8'Size,
+                    "8 bit Component_Size greater than array size" );
+
+    if System.Word_Size > 8 then
+
+      if Pact_Aray_9'Component_Size > Next_Factor ( Bits_9'Size ) then
+         Report.Failed
+            ( "9 bit element Packed Array'Component_Size too big" );
+      end if;
+
+      TCTouch.Assert( Pact_Aray_9'Component_Size <= Pact_Aray_9'Size,
+                    "9 bit Component_Size greater than array size" );
+
+      if Pact_Aray_15'Component_Size > Next_Factor ( Bits_15'Size ) then
+         Report.Failed
+            ( "15 bit element Packed Array'Component_Size too big" );
+      end if;
+
+      TCTouch.Assert( Pact_Aray_15'Component_Size <= Pact_Aray_15'Size,
+                    "15 bit Component_Size greater than array size" );
+
+    end if;
+
+  end TC_Check_Values;
+
+end CD20001_1;
+
+------------------------------------------------------------------- CD20001
+
+with Report;
+with CD20001_0;
+with CD20001_1;
+
+procedure CD20001 is
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD20001", "Check that packed records are packed as tightly " &
+                          "as possible.  Check that Boolean objects are " &
+                          "packed one to a bit. " &
+                          "Check that the Component_Size for a packed " &
+                          "array type is the value which is less than or " &
+                          "equal to the Size of the component type, " &
+                          "rounded up to the nearest factor of word_size" );
+   
+  CD20001_0.TC_Check_Values;
+
+  CD20001_1.TC_Check_Values;
+
+  Report.Result;
+
+end CD20001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a21a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a21a.ada
new file mode 100644
index 000000000..6f42d393c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a21a.ada
@@ -0,0 +1,215 @@
+-- CD2A21A.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 SIZE SPECIFICATION IS GIVEN FOR AN
+--     ENUMERATION TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
+--     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 07/28/87 CREATED ORIGINAL TEST.
+--     DHH 04/17/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
+--                  REPRESENTATION CLAUSE.
+--     JRL 03/26/92 ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                    -- CONTAINS A CALLED TO 'FAILED'.
+PROCEDURE CD2A21A IS
+
+     BASIC_SIZE : CONSTANT := INTEGER'SIZE/2;
+
+     TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
+
+     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
+
+     C0 : CHECK_TYPE := ZERO;
+     C1 : CHECK_TYPE := ONE;
+     C2 : CHECK_TYPE := TWO;
+
+     TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
+     CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
+
+     TYPE REC_TYPE IS RECORD
+          COMP0 : CHECK_TYPE := ZERO;
+          COMP1 : CHECK_TYPE := ONE;
+          COMP2 : CHECK_TYPE := TWO;
+     END RECORD;
+
+     CHREC : REC_TYPE;
+
+     PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
+
+     FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN CH;
+          ELSE
+               RETURN ONE;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
+                     CIO1, CIO2 : IN OUT CHECK_TYPE;
+                     CO2        :    OUT CHECK_TYPE) IS
+     BEGIN
+          IF NOT ((CI0 <  IDENT (ONE))                          AND
+                  (IDENT (CI2)  > IDENT (CIO1))                 AND
+                  (CIO1 <= IDENT (ONE)) AND(IDENT (TWO) = CI2)) THEN
+               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
+                       "- 1");
+          END IF;
+
+          IF CHECK_TYPE'POS (CI0)  /= IDENT_INT (0) OR
+             CHECK_TYPE'POS (CIO1) /= IDENT_INT (1) OR
+             CHECK_TYPE'POS (CI2)  /= IDENT_INT (2) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 1");
+          END IF;
+
+          IF CHECK_TYPE'SUCC (CI0)  /=  IDENT (CIO1) OR
+             CHECK_TYPE'SUCC (CIO1) /= IDENT (CI2)   THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 1");
+          END IF;
+
+          IF CHECK_TYPE'IMAGE (CI0)  /= IDENT_STR ("ZERO") OR
+             CHECK_TYPE'IMAGE (CIO1) /= IDENT_STR ("ONE")  OR
+             CHECK_TYPE'IMAGE (CI2)  /= IDENT_STR ("TWO")  THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 1");
+          END IF;
+
+          CO2 := TWO;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A21A", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
+                      "GIVEN FOR AN ENUMERATION TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
+                      "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
+
+     PROC (ZERO, TWO, C1, C2, C2);
+     CHECK_1 (TWO, INTEGER'SIZE/2, "CHECK_TYPE");
+
+     IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+     END IF;
+
+     IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR C0'SIZE");
+     END IF;
+
+     IF NOT ((IDENT (C1) IN C1 .. C2)       AND
+             (C0 NOT IN IDENT (ONE) .. C2)) THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
+     END IF;
+
+     IF CHECK_TYPE'FIRST /= IDENT (ZERO) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST - 2");
+     END IF;
+
+     IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
+        CHECK_TYPE'VAL (1) /= IDENT (C1) OR
+        CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 2");
+     END IF;
+
+     IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
+        CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 2");
+     END IF;
+
+     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
+        CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
+        CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 2");
+     END IF;
+
+     IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
+     END IF;
+
+     IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
+             (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
+             (CHARRAY (1) <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHARRAY (2)))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
+     END IF;
+
+     IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
+             (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
+     END IF;
+
+     IF CHECK_TYPE'POS (CHARRAY (0)) /= IDENT_INT (0) OR
+        CHECK_TYPE'POS (CHARRAY (1)) /= IDENT_INT (1) OR
+        CHECK_TYPE'POS (CHARRAY (2)) /= IDENT_INT (2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 3");
+     END IF;
+
+     IF CHECK_TYPE'SUCC (CHARRAY (0)) /= IDENT (CHARRAY (1)) OR
+        CHECK_TYPE'SUCC (CHARRAY (1)) /= IDENT (CHARRAY (2)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 3");
+     END IF;
+
+     IF CHECK_TYPE'IMAGE (CHARRAY (0)) /= IDENT_STR ("ZERO") OR
+        CHECK_TYPE'IMAGE (CHARRAY (1)) /= IDENT_STR ("ONE")  OR
+        CHECK_TYPE'IMAGE (CHARRAY (2)) /= IDENT_STR ("TWO")  THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 3");
+     END IF;
+
+     IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
+     END IF;
+
+     IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
+             (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
+             (CHREC.COMP1 <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHREC.COMP2))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
+     END IF;
+
+     IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
+             (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
+     END IF;
+
+     IF CHECK_TYPE'VAL (0) /= IDENT (CHREC.COMP0) OR
+        CHECK_TYPE'VAL (1) /= IDENT (CHREC.COMP1) OR
+        CHECK_TYPE'VAL (2) /= IDENT (CHREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 4");
+     END IF;
+
+     IF CHECK_TYPE'PRED (CHREC.COMP1) /= IDENT (CHREC.COMP0) OR
+        CHECK_TYPE'PRED (CHREC.COMP2) /= IDENT (CHREC.COMP1) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 4");
+     END IF;
+
+     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHREC.COMP0) OR
+        CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHREC.COMP1) OR
+        CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 4");
+     END IF;
+
+     RESULT;
+END CD2A21A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a21c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a21c.ada
new file mode 100644
index 000000000..0fc6fb127
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a21c.ada
@@ -0,0 +1,116 @@
+-- CD2A21C.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 SIZE SPECIFICATION CAN BE GIVEN FOR AN ENUMERATION
+--     TYPE:
+--          IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
+--            DECLARED IN THE VISIBLE PART;
+--          FOR A DERIVED ENUMERATION TYPE;
+--          FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
+--            AN ENUMERATION TYPE.
+
+-- HISTORY:
+--     PWB 06/17/87  CREATED ORIGINAL TEST.
+--     DHH 04/17/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
+--                   REPRESENTATION CLAUSE.
+--     JRL 03/26/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD2A21C IS
+
+     TYPE BASIC_ENUM IS (A, B, C, D, E);
+     SPECIFIED_SIZE : CONSTANT := BASIC_ENUM'SIZE;
+
+     MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
+
+     TYPE DERIVED_ENUM IS NEW BASIC_ENUM;
+     FOR DERIVED_ENUM'SIZE USE SPECIFIED_SIZE;
+
+     PACKAGE P IS
+          TYPE ENUM_IN_P IS (A1, B1, C1, D1, E1, F1, G1);
+          FOR ENUM_IN_P'SIZE USE SPECIFIED_SIZE;
+          TYPE PRIVATE_ENUM IS PRIVATE;
+          TYPE ALT_ENUM_IN_P IS (A2, B2, C2, D2, E2, F2, G2);
+     PRIVATE
+          TYPE PRIVATE_ENUM IS (A3, B3, C3, D3, E3, F3, G3);
+          FOR ALT_ENUM_IN_P'SIZE USE SPECIFIED_SIZE;
+     END P;
+
+     TYPE DERIVED_PRIVATE_ENUM IS NEW P.PRIVATE_ENUM;
+     FOR DERIVED_PRIVATE_ENUM'SIZE USE SPECIFIED_SIZE;
+
+     USE P;
+
+     PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (DERIVED_ENUM);
+     PROCEDURE CHECK_2 IS NEW LENGTH_CHECK (ENUM_IN_P);
+     PROCEDURE CHECK_3 IS NEW LENGTH_CHECK (ALT_ENUM_IN_P);
+
+BEGIN
+
+     TEST("CD2A21C", "CHECK THAT 'SIZE SPECIFICATIONS CAN BE GIVEN " &
+                     "IN THE VISIBLE OR PRIVATE PART OF A PACKAGE " &
+                     "FOR ENUMERATION TYPES DECLARED IN THE VISIBLE " &
+                     "PART, AND FOR DERIVED ENUMERATION " &
+                     "TYPES AND DERIVED PRIVATE TYPES WHOSE FULL " &
+                     "DECLARATIONS ARE AS ENUMERATION TYPES");
+
+     CHECK_1 (C,  SPECIFIED_SIZE, "DERIVED_ENUM");
+     CHECK_2 (C1, SPECIFIED_SIZE, "ENUM_IN_P");
+     CHECK_3 (C2, SPECIFIED_SIZE, "ALT_ENUM_IN_P");
+
+     IF DERIVED_ENUM'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("DERIVED_ENUM'SIZE SHOULD NOT BE GREATER THAN" &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_ENUM'SIZE));
+     END IF;
+
+     IF ENUM_IN_P'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("ENUM_IN_P'SIZE SHOULD NOT BE GREATER THAN" &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(ENUM_IN_P'SIZE));
+     END IF;
+
+     IF ALT_ENUM_IN_P'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("ALT_ENUM_IN_P'SIZE SHOULD NOT BE GREATER THAN" &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(ALT_ENUM_IN_P'SIZE));
+     END IF;
+
+     IF DERIVED_PRIVATE_ENUM'SIZE /= MINIMUM_SIZE THEN
+
+          FAILED ("DERIVED_PRIVATE_ENUM'SIZE SHOULD NOT BE GREATER " &
+                  "THAN " & INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_PRIVATE_ENUM'SIZE));
+     END IF;
+
+     RESULT;
+
+END CD2A21C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a21e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a21e.ada
new file mode 100644
index 000000000..c241ea39d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a21e.ada
@@ -0,0 +1,153 @@
+-- CD2A21E.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 SIZE SPECIFICATION IS GIVEN FOR AN
+--     ENUMERATION TYPE, THEN SUCH A TYPE CAN
+--     BE PASSED AS AN ACTUAL PARAMETER TO A GENERIC PROCEDURE.
+
+-- HISTORY:
+--     JET 08/18/87 CREATED ORIGINAL TEST.
+--     DHH 04/17/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
+--                  REPRESENTATION CLAUSE.
+--     BCB 03/05/90 ADDED CALL TO LENGTH_CHECK TO VERIFY THAT THE SIZE
+--                  SPECIFICATION IS OBEYED.
+--     LDC 10/03/90 ADDED CASES FOR >=, /=, ASSIGNMENT, QUALIFICATION, 
+--                  AND EXPLICIT CONVERSION.
+--     JRL 03/26/92 ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD2A21E IS
+
+     TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
+     BASIC_SIZE : CONSTANT := INTEGER'SIZE / 2;
+
+     FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
+
+BEGIN
+     TEST ("CD2A21E", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
+                      "GIVEN FOR AN ENUMERATION TYPE, " &
+                      "THEN SUCH A TYPE CAN BE " &
+                      "PASSED AS AN ACTUAL PARAMETER TO A GENERIC " &
+                      "PROCEDURE");
+
+     DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
+
+          GENERIC
+               TYPE GPARM IS (<>);
+          PROCEDURE GENPROC (C0, C1, C2: GPARM);
+
+          PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
+
+               SUBTYPE CHECK_TYPE IS GPARM;
+
+               C3 : GPARM;
+
+               CHECKVAR : CHECK_TYPE;
+
+               PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
+
+               FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN CH;
+                    ELSE
+                         RETURN C1;
+                    END IF;
+               END IDENT;
+
+          BEGIN -- GENPROC.
+
+               CHECKVAR := IDENT (C0);
+
+               CHECK_1 (CHECKVAR, CHECK_TYPE'SIZE, "CHECK_TYPE");
+
+               IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+               END IF;
+
+               IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR C0'SIZE");
+               END IF;
+
+               IF NOT ((IDENT (C1) IN C1 .. C2)       AND
+                       (IDENT(C0) NOT IN IDENT (C1) .. C2)) THEN
+                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                            "OPERATORS");
+               END IF;
+
+               IF CHECK_TYPE'LAST /= IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
+               END IF;
+
+               IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
+                  CHECK_TYPE'VAL (1) /= IDENT (C1) OR
+                  CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL");
+               END IF;
+
+               IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
+                  CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED");
+               END IF;
+
+               IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
+                  CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
+                  CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE");
+               END IF;
+
+               CHECKVAR := CHECK_TYPE'VALUE ("ONE");
+               C3 := GPARM(CHECKVAR);
+               IF C3 /= IDENT(C1) THEN 
+                    FAILED ("INCORRECT VALUE FOR CONVERSION");
+               END IF;
+
+               CHECK_1 (IDENT(C0), BASIC_SIZE, "CHECK_ENUM");
+
+
+               IF CHECK_TYPE'(C2) /= IDENT(C2) THEN 
+                    FAILED ("INCORRECT VALUE FOR QUALIFICATION");
+               END IF;
+
+               C3 := CHECK_TYPE'VALUE ("TWO");
+               IF C3 /= IDENT(C2) THEN 
+                    FAILED ("INCORRECT VALUE FOR ASSIGNMENT");
+               END IF;
+
+          END GENPROC;
+
+          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
+
+     BEGIN
+
+          NEWPROC (ZERO, ONE, TWO);
+
+     END;
+
+     RESULT;
+
+END CD2A21E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22a.ada
new file mode 100644
index 000000000..37564d807
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22a.ada
@@ -0,0 +1,213 @@
+-- CD2A22A.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 SIZE SPECIFICATION INDICATING THE SMALLEST SIZE
+--     APPROPRIATE FOR A SIGNED REPRESENTATION IS GIVEN FOR AN
+--     ENUMERATION TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
+--     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 07/28/87 CREATED ORIGINAL TEST.
+--     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     JRL 03/27/92 ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A22A IS
+
+     BASIC_SIZE : CONSTANT := 3;
+
+     TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
+
+     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
+
+     C0 : CHECK_TYPE := ZERO;
+     C1 : CHECK_TYPE := ONE;
+     C2 : CHECK_TYPE := TWO;
+
+     TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
+     CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
+
+     TYPE REC_TYPE IS RECORD
+          COMP0 : CHECK_TYPE := ZERO;
+          COMP1 : CHECK_TYPE := ONE;
+          COMP2 : CHECK_TYPE := TWO;
+     END RECORD;
+
+     CHREC : REC_TYPE;
+
+     FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN CH;
+          ELSE
+               RETURN ONE;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
+                     CIO1, CIO2 : IN OUT CHECK_TYPE;
+                     CO2        :    OUT CHECK_TYPE) IS
+     BEGIN
+          IF NOT ((CI0 <  IDENT (ONE))                          AND
+                  (IDENT (CI2)  > IDENT (CIO1))                 AND
+                  (CIO1 <= IDENT (ONE)) AND(IDENT (TWO) = CI2)) THEN
+               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
+                       "- 1");
+          END IF;
+
+          IF CHECK_TYPE'POS (CI0)  /= IDENT_INT (0) OR
+             CHECK_TYPE'POS (CIO1) /= IDENT_INT (1) OR
+             CHECK_TYPE'POS (CI2)  /= IDENT_INT (2) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 1");
+          END IF;
+
+          IF CHECK_TYPE'SUCC (CI0)  /=  IDENT (CIO1) OR
+             CHECK_TYPE'SUCC (CIO1) /= IDENT (CI2)   THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 1");
+          END IF;
+
+          IF CHECK_TYPE'IMAGE (CI0)  /= IDENT_STR ("ZERO") OR
+             CHECK_TYPE'IMAGE (CIO1) /= IDENT_STR ("ONE")  OR
+             CHECK_TYPE'IMAGE (CI2)  /= IDENT_STR ("TWO")  THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 1");
+          END IF;
+
+          CO2 := TWO;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A22A", "CHECK THAT IF A SIZE SPECIFICATION " &
+                      "INDICATING THE SMALLEST SIZE APPROPRIATE " &
+                      "FOR A SIGNED REPRESENTATION IS GIVEN " &
+                      "FOR AN ENUMERATION TYPE, THEN OPERATIONS " &
+                      "ON VALUES OF SUCH A TYPE ARE NOT AFFECTED " &
+                      "BY THE REPRESENTATION CLAUSE");
+
+     PROC (ZERO, TWO, C1, C2, C2);
+
+     IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+     END IF;
+
+     IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR C0'SIZE");
+     END IF;
+
+     IF NOT ((IDENT (C1) IN C1 .. C2)       AND
+             (C0 NOT IN IDENT (ONE) .. C2)) THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
+     END IF;
+
+     IF CHECK_TYPE'FIRST /= IDENT (ZERO) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST - 2");
+     END IF;
+
+     IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
+        CHECK_TYPE'VAL (1) /= IDENT (C1) OR
+        CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 2");
+     END IF;
+
+     IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
+        CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 2");
+     END IF;
+
+     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
+        CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
+        CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 2");
+     END IF;
+
+     IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
+     END IF;
+
+     IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
+             (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
+             (CHARRAY (1) <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHARRAY (2)))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
+     END IF;
+
+     IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
+             (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
+     END IF;
+
+     IF CHECK_TYPE'POS (CHARRAY (0)) /= IDENT_INT (0) OR
+        CHECK_TYPE'POS (CHARRAY (1)) /= IDENT_INT (1) OR
+        CHECK_TYPE'POS (CHARRAY (2)) /= IDENT_INT (2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 3");
+     END IF;
+
+     IF CHECK_TYPE'SUCC (CHARRAY (0)) /= IDENT (CHARRAY (1)) OR
+        CHECK_TYPE'SUCC (CHARRAY (1)) /= IDENT (CHARRAY (2)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 3");
+     END IF;
+
+     IF CHECK_TYPE'IMAGE (CHARRAY (0)) /= IDENT_STR ("ZERO") OR
+        CHECK_TYPE'IMAGE (CHARRAY (1)) /= IDENT_STR ("ONE")  OR
+        CHECK_TYPE'IMAGE (CHARRAY (2)) /= IDENT_STR ("TWO")  THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 3");
+     END IF;
+
+     IF CHREC.COMP1'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHREC.COMP1'SIZE");
+     END IF;
+
+     IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
+             (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
+             (CHREC.COMP1 <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHREC.COMP2))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
+     END IF;
+
+     IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
+             (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
+     END IF;
+
+     IF CHECK_TYPE'VAL (0) /= IDENT (CHREC.COMP0) OR
+        CHECK_TYPE'VAL (1) /= IDENT (CHREC.COMP1) OR
+        CHECK_TYPE'VAL (2) /= IDENT (CHREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 4");
+     END IF;
+
+     IF CHECK_TYPE'PRED (CHREC.COMP1) /= IDENT (CHREC.COMP0) OR
+        CHECK_TYPE'PRED (CHREC.COMP2) /= IDENT (CHREC.COMP1) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 4");
+     END IF;
+
+     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHREC.COMP0) OR
+        CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHREC.COMP1) OR
+        CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 4");
+     END IF;
+
+     RESULT;
+END CD2A22A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22e.ada
new file mode 100644
index 000000000..2ed878c5b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22e.ada
@@ -0,0 +1,216 @@
+-- CD2A22E.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 SIZE CLAUSE SPECIFYING THE SMALLEST SIZE
+--     APPROPRIATE FOR AN UNSIGNED REPRESENTATION IS GIVEN FOR AN
+--     ENUMERATION TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
+--     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     JET 08/12/87 CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     JRL 03/27/92 ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A22E IS
+
+     BASIC_SIZE : CONSTANT := 2;
+
+     TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
+
+     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
+
+     C0 : CHECK_TYPE := ZERO;
+     C1 : CHECK_TYPE := ONE;
+     C2 : CHECK_TYPE := TWO;
+
+     TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
+     CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
+
+     TYPE REC_TYPE IS RECORD
+          COMP0 : CHECK_TYPE := ZERO;
+          COMP1 : CHECK_TYPE := ONE;
+          COMP2 : CHECK_TYPE := TWO;
+     END RECORD;
+
+     CHREC : REC_TYPE;
+
+     FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN CH;
+          ELSE
+               RETURN ONE;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
+                     CIO1, CIO2 : IN OUT CHECK_TYPE;
+                     CO2        :    OUT CHECK_TYPE) IS
+     BEGIN
+          IF CIO1'SIZE < IDENT_INT (BASIC_SIZE) THEN
+               FAILED ("INCORRECT VALUE FOR CIO1'SIZE");
+          END IF;
+
+          IF NOT ((IDENT (CIO1) IN CIO1 .. CIO2)    AND
+                  (CI0 NOT IN IDENT (ONE) .. CIO2)) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS " &
+                       "- 1");
+          END IF;
+
+          IF CHECK_TYPE'VAL (0) /= IDENT (CI0)  OR
+             CHECK_TYPE'VAL (1) /= IDENT (CIO1) OR
+             CHECK_TYPE'VAL (2) /= IDENT (CIO2) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 1");
+          END IF;
+
+          IF CHECK_TYPE'PRED (CIO1) /= IDENT (CI0)  OR
+             CHECK_TYPE'PRED (CIO2) /= IDENT (CIO1) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 1");
+          END IF;
+
+          IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CI0)   OR
+             CHECK_TYPE'VALUE ("ONE")  /=  IDENT (CIO1) OR
+             CHECK_TYPE'VALUE ("TWO")  /=  IDENT (CIO2) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 1");
+          END IF;
+
+          CO2 := TWO;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A22E", "CHECK THAT IF A SIZE CLAUSE " &
+                      "SPECIFYING THE SMALLEST SIZE APPROPRIATE " &
+                      "FOR AN UNSIGNED REPRESENTATION IS GIVEN " &
+                      "FOR AN ENUMERATION TYPE, THEN OPERATIONS " &
+                      "ON VALUES OF SUCH A TYPE ARE NOT AFFECTED " &
+                      "BY THE REPRESENTATION CLAUSE");
+
+     PROC (ZERO, TWO, C1, C2, C2);
+
+     IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+     END IF;
+
+     IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR C0'SIZE");
+     END IF;
+
+     IF NOT ((C0 <  IDENT (ONE)) AND(IDENT (C2)  > IDENT (C1)) AND
+             (C1 <= IDENT (ONE)) AND(IDENT (TWO) = C2))        THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
+     END IF;
+
+     IF CHECK_TYPE'LAST /= IDENT (TWO) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST - 2");
+     END IF;
+
+     IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
+        CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
+        CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 2");
+     END IF;
+
+     IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
+        CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 2");
+     END IF;
+
+     IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
+        CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
+        CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 2");
+     END IF;
+
+     IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
+     END IF;
+
+     IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
+             (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
+             (CHARRAY (1) <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHARRAY (2)))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
+     END IF;
+
+     IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
+             (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
+     END IF;
+
+     IF CHECK_TYPE'VAL (0) /= IDENT (CHARRAY (0)) OR
+        CHECK_TYPE'VAL (1) /= IDENT (CHARRAY (1)) OR
+        CHECK_TYPE'VAL (2) /= IDENT (CHARRAY (2)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 3");
+     END IF;
+
+     IF CHECK_TYPE'PRED (CHARRAY (1)) /= IDENT (CHARRAY (0)) OR
+        CHECK_TYPE'PRED (CHARRAY (2)) /= IDENT (CHARRAY (1)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 3");
+     END IF;
+
+     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHARRAY (0)) OR
+        CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHARRAY (1)) OR
+        CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHARRAY (2)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 3");
+     END IF;
+
+     IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
+     END IF;
+
+     IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
+             (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
+             (CHREC.COMP1 <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHREC.COMP2))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
+     END IF;
+
+     IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
+             (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
+     END IF;
+
+     IF CHECK_TYPE'POS (CHREC.COMP0) /= IDENT_INT (0) OR
+        CHECK_TYPE'POS (CHREC.COMP1) /= IDENT_INT (1) OR
+        CHECK_TYPE'POS (CHREC.COMP2) /= IDENT_INT (2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 4");
+     END IF;
+
+     IF CHECK_TYPE'SUCC (CHREC.COMP0) /= IDENT (CHREC.COMP1) OR
+        CHECK_TYPE'SUCC (CHREC.COMP1) /= IDENT (CHREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 4");
+     END IF;
+
+     IF CHECK_TYPE'IMAGE (CHREC.COMP0) /= IDENT_STR ("ZERO") OR
+        CHECK_TYPE'IMAGE (CHREC.COMP1) /= IDENT_STR ("ONE")  OR
+        CHECK_TYPE'IMAGE (CHREC.COMP2) /= IDENT_STR ("TWO")  THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 4");
+     END IF;
+
+     RESULT;
+END CD2A22E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22i.ada
new file mode 100644
index 000000000..2dbe50341
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22i.ada
@@ -0,0 +1,120 @@
+-- CD2A22I.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 SIZE CLAUSE SPECIFIES THE SMALLEST APPROPRIATE
+--     SIZE FOR A SIGNED REPRESENTATION FOR AN ENUMERATION TYPE,
+--     THEN THE TYPE CAN BE USED AS AN ACTUAL PARAMETER IN AN
+--     INSTANTIATION.
+
+-- HISTORY:
+--     JET 08/13/87 CREATED ORIGINAL TEST.
+--     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     JRL 03/27/92 ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A22I IS
+
+     TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
+     BASIC_SIZE : CONSTANT := 3;
+
+     FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
+
+BEGIN
+     TEST ("CD2A22I", "CHECK THAT IF A SIZE CLAUSE SPECIFIES THE " &
+                      "SMALLEST APPROPRIATE SIZE FOR A SIGNED " &
+                      "REPRESENTATION FOR AN ENUMERATION TYPE, THEN " &
+                      "THE TYPE CAN BE USED AS AN ACTUAL PARAMETER IN " &
+                      "AN INSTANTIATION");
+
+
+     DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
+
+          GENERIC
+               TYPE GPARM IS (<>);
+          PROCEDURE GENPROC (C0, C1, C2: GPARM);
+
+          PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
+
+               SUBTYPE CHECK_TYPE IS GPARM;
+
+               FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN CH;
+                    ELSE
+                         RETURN C1;
+                    END IF;
+               END IDENT;
+
+          BEGIN -- GENPROC.
+
+               IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+               END IF;
+
+               IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR C0'SIZE");
+               END IF;
+
+               IF NOT ((IDENT (C1) IN C1 .. C2)       AND
+                       (C0 NOT IN IDENT (C1) .. C2)) THEN
+                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                            "OPERATORS");
+               END IF;
+
+               IF CHECK_TYPE'LAST /= IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
+               END IF;
+
+               IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
+                  CHECK_TYPE'VAL (1) /= IDENT (C1) OR
+                  CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL");
+               END IF;
+
+               IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
+                  CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED");
+               END IF;
+
+               IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
+                  CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
+                  CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE");
+               END IF;
+
+          END GENPROC;
+
+          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
+
+     BEGIN
+
+          NEWPROC (ZERO, ONE, TWO);
+
+     END;
+
+     RESULT;
+
+END CD2A22I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22j.ada
new file mode 100644
index 000000000..89737c746
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a22j.ada
@@ -0,0 +1,125 @@
+-- CD2A22J.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 SIZE SPECIFICATION IS GIVEN FOR AN
+--     ENUMERATION TYPE, THEN SUCH A TYPE OF THE SMALLEST APPROPRIATE
+--     UNSIGNED SIZE CAN BE PASSED AS AN ACTUAL PARAMETER TO A GENERIC
+--     PROCEDURE.
+
+-- HISTORY:
+--     JET 08/13/87 CREATED ORIGINAL TEST.
+--     DHH 04/17/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
+--                  REPRESENTATION CLAUSE.
+--     JRL 03/27/92 ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD2A22J IS
+
+     TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
+     BASIC_SIZE : CONSTANT := 2;
+
+     FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
+
+BEGIN
+     TEST ("CD2A22J", "CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN " &
+                      "FOR AN ENUMERATION TYPE, THEN SUCH A TYPE OF " &
+                      "THE SMALLEST APPROPRIATE UNSIGNED SIZE CAN BE " &
+                      "PASSED AS AN ACTUAL PARAMETER TO A GENERIC " &
+                      "PROCEDURE");
+
+     DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
+
+          GENERIC
+               TYPE GPARM IS (<>);
+          PROCEDURE GENPROC (C0, C1, C2: GPARM);
+
+          PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
+
+               SUBTYPE CHECK_TYPE IS GPARM;
+
+               FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN CH;
+                    ELSE
+                         RETURN C1;
+                    END IF;
+               END IDENT;
+
+               PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
+
+          BEGIN -- GENPROC.
+               CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
+
+               IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+               END IF;
+
+               IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR C0'SIZE");
+               END IF;
+
+               IF NOT ((C0 <  IDENT (C1)) AND
+                       (IDENT (C2)  > IDENT (C1)) AND
+                       (C1 <= IDENT (C1)) AND (IDENT (C2) = C2)) THEN
+                    FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
+                            "OPERATORS");
+               END IF;
+
+               IF CHECK_TYPE'FIRST /= IDENT (C0) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST");
+               END IF;
+
+               IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
+                  CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
+                  CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS");
+               END IF;
+
+               IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
+                  CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC");
+               END IF;
+
+               IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
+                  CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
+                  CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE");
+               END IF;
+
+          END GENPROC;
+
+          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
+
+     BEGIN
+
+          NEWPROC (ZERO, ONE, TWO);
+
+     END;
+
+     RESULT;
+END CD2A22J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a23a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a23a.ada
new file mode 100644
index 000000000..2526f7106
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a23a.ada
@@ -0,0 +1,221 @@
+-- CD2A23A.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 SIZE SPECIFICATION AND AN ENUMERATION
+--     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
+--     THEN OPERATIONS ON VALUES OF SUCH A TYPE ARE NOT AFFECTED
+--     BY THE REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 07/28/87 CREATED ORIGINAL TEST.
+--     DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
+--                  REPRESENTATION CLAUSE.
+--     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
+
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD2A23A IS
+
+     BASIC_SIZE : CONSTANT := INTEGER'SIZE/2;
+
+     TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
+
+     FOR CHECK_TYPE USE (ZERO => 3, ONE => 4, TWO => 5);
+
+     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
+
+     C0 : CHECK_TYPE := ZERO;
+     C1 : CHECK_TYPE := ONE;
+     C2 : CHECK_TYPE := TWO;
+
+     TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
+     CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
+
+     TYPE REC_TYPE IS RECORD
+          COMP0 : CHECK_TYPE := ZERO;
+          COMP1 : CHECK_TYPE := ONE;
+          COMP2 : CHECK_TYPE := TWO;
+     END RECORD;
+
+     CHREC : REC_TYPE;
+
+     FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN CH;
+          ELSE
+               RETURN ONE;
+          END IF;
+     END IDENT;
+
+     PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
+
+     PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
+                     CIO1, CIO2 : IN OUT CHECK_TYPE;
+                     CO2        :    OUT CHECK_TYPE) IS
+     BEGIN
+          IF NOT ((IDENT (CIO1) IN CIO1 .. CIO2)    AND
+                  (CI0 NOT IN IDENT (ONE) .. CIO2)) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS " &
+                       "- 1");
+          END IF;
+
+          IF CHECK_TYPE'VAL (0) /= IDENT (CI0)  OR
+             CHECK_TYPE'VAL (1) /= IDENT (CIO1) OR
+             CHECK_TYPE'VAL (2) /= IDENT (CIO2) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 1");
+          END IF;
+
+          IF CHECK_TYPE'PRED (CIO1) /= IDENT (CI0)  OR
+             CHECK_TYPE'PRED (CIO2) /= IDENT (CIO1) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 1");
+          END IF;
+
+          IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CI0)   OR
+             CHECK_TYPE'VALUE ("ONE")  /=  IDENT (CIO1) OR
+             CHECK_TYPE'VALUE ("TWO")  /=  IDENT (CIO2) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 1");
+          END IF;
+
+          CO2 := TWO;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A23A", "CHECK THAT WHEN A SIZE SPECIFICATION AND " &
+                      "AN ENUMERATION REPRESENTATION CLAUSE ARE " &
+                      "GIVEN FOR AN ENUMERATION TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
+                      "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
+
+     CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
+     PROC (ZERO, TWO, C1, C2, C2);
+
+     IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+     END IF;
+
+     IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR C0'SIZE");
+     END IF;
+
+     IF NOT ((C0 <  IDENT (ONE)) AND(IDENT (C2)  > IDENT (C1)) AND
+             (C1 <= IDENT (ONE)) AND(IDENT (TWO) = C2))        THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
+     END IF;
+
+     IF CHECK_TYPE'LAST /= IDENT (TWO) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST - 2");
+     END IF;
+
+     IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
+        CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
+        CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 2");
+     END IF;
+
+     IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
+        CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 2");
+     END IF;
+
+     IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
+        CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
+        CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 2");
+     END IF;
+
+     IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
+     END IF;
+
+     IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
+             (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
+             (CHARRAY (1) <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHARRAY (2)))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
+     END IF;
+
+     IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
+             (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
+     END IF;
+
+     IF CHECK_TYPE'VAL (0) /= IDENT (CHARRAY (0)) OR
+        CHECK_TYPE'VAL (1) /= IDENT (CHARRAY (1)) OR
+        CHECK_TYPE'VAL (2) /= IDENT (CHARRAY (2)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 3");
+     END IF;
+
+     IF CHECK_TYPE'PRED (CHARRAY (1)) /= IDENT (CHARRAY (0)) OR
+        CHECK_TYPE'PRED (CHARRAY (2)) /= IDENT (CHARRAY (1)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 3");
+     END IF;
+
+     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHARRAY (0)) OR
+        CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHARRAY (1)) OR
+        CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHARRAY (2)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 3");
+     END IF;
+
+     IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
+     END IF;
+
+     IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
+             (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
+             (CHREC.COMP1 <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHREC.COMP2))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
+     END IF;
+
+     IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
+             (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
+     END IF;
+
+     IF CHECK_TYPE'POS (CHREC.COMP0) /= IDENT_INT (0) OR
+        CHECK_TYPE'POS (CHREC.COMP1) /= IDENT_INT (1) OR
+        CHECK_TYPE'POS (CHREC.COMP2) /= IDENT_INT (2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 4");
+     END IF;
+
+     IF CHECK_TYPE'SUCC (CHREC.COMP0) /= IDENT (CHREC.COMP1) OR
+        CHECK_TYPE'SUCC (CHREC.COMP1) /= IDENT (CHREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 4");
+     END IF;
+
+     IF CHECK_TYPE'IMAGE (CHREC.COMP0) /= IDENT_STR ("ZERO") OR
+        CHECK_TYPE'IMAGE (CHREC.COMP1) /= IDENT_STR ("ONE")  OR
+        CHECK_TYPE'IMAGE (CHREC.COMP2) /= IDENT_STR ("TWO")  THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 4");
+     END IF;
+
+
+     RESULT;
+
+END CD2A23A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a23e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a23e.ada
new file mode 100644
index 000000000..234c7119a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a23e.ada
@@ -0,0 +1,198 @@
+-- CD2A23E.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 SIZE SPECIFICATION AND AN ENUMERATION
+--     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
+--     THEN SUCH A TYPE CAN BE PASSED AS AN ACTUAL PARAMETER TO A
+--     GENERIC PROCEDURE.
+
+-- HISTORY:
+--     JET 08/18/87 CREATED ORIGINAL TEST.
+--     DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
+--                  REPRESENTATION CLAUSE.
+--     BCB 03/05/90 ADDED CALL TO LENGTH_CHECK TO VERIFY THAT THE SIZE
+--                  SPECIFICATION IS OBEYED.
+--     LDC 10/03/90 ADDED EXCEPTION HANDER FOR CHECK OF 'SUCC, 'PRED,
+--                  ADDED CASES FOR >=, /=, ASSIGNMENT, QUALIFICATION, 
+--                  AND EXPLICIT CONVERSION.
+--     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
+
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD2A23E IS
+
+     TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
+     BASIC_SIZE : CONSTANT := 8;
+
+     FOR BASIC_ENUM USE (ZERO => 3, ONE => 4, TWO => 5);
+     FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
+
+BEGIN
+     TEST ("CD2A23E", "CHECK THAT WHEN A SIZE SPECIFICATION AND AN " &
+                      "ENUMERATION REPRESENTATION CLAUSE ARE " &
+                      "GIVEN FOR AN ENUMERATION TYPE, " &
+                      "THEN SUCH A TYPE CAN BE " &
+                      "PASSED AS AN ACTUAL PARAMETER TO A GENERIC " &
+                      "PROCEDURE");
+
+     DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
+
+          GENERIC
+               TYPE GPARM IS (<>);
+          PROCEDURE GENPROC (C0, C1, C2: GPARM);
+
+          PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
+
+               SUBTYPE CHECK_TYPE IS GPARM;
+
+               C3 : GPARM;
+
+               CHECKVAR : CHECK_TYPE;
+
+               FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN CH;
+                    ELSE
+                         RETURN C1;
+                    END IF;
+               END IDENT;
+
+               PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
+
+
+          BEGIN -- GENPROC.
+
+               CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
+
+               CHECKVAR := IDENT (C0);
+
+               CHECK_1 (CHECKVAR, CHECK_TYPE'SIZE, "CHECK_TYPE");
+
+               IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+               END IF;
+
+               IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR C0'SIZE");
+               END IF;
+
+               IF NOT ((IDENT(C0) <  IDENT (C1)) AND
+                       (IDENT(C2) >  IDENT (C1)) AND
+                       (IDENT(C1) <= IDENT (C1)) AND 
+                       (IDENT(C2) =  IDENT (C2))) THEN
+                    FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
+                            "OPERATORS");
+               END IF;
+
+               IF CHECK_TYPE'FIRST /= IDENT (C0) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST");
+               END IF;
+
+               IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
+                  CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
+                  CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS");
+               END IF;
+
+               IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
+                  CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC");
+               END IF;
+
+               BEGIN
+                    IF CHECK_TYPE'SUCC (IDENT(C2)) /= IDENT (C1) THEN
+                         FAILED ("CONSTRAINT ERROR NOT RAISED FOR " &
+                                 "CHECK_TYPE'SUCC");
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         IF 3 /= IDENT_INT(3) THEN
+                              COMMENT ("DON'T OPTIMIZE EXCEPTION -1");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED FOR " &
+                                 "CHECK_TYPE'SUCC");
+               END;
+
+               BEGIN
+                    IF CHECK_TYPE'PRED(IDENT(C0)) /= IDENT (C1) THEN
+                        FAILED ("CONSTRAINT ERROR NOT RAISED FOR " &
+                                 "CHECK_TYPE'PRED");
+                    END IF;
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         IF 3 /= IDENT_INT(3) THEN
+                              COMMENT ("DON'T OPTIMIZE EXCEPTION -2");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED FOR " &
+                                 "CHECK_TYPE'PRED");
+               END;
+
+               IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
+                  CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED");
+               END IF;
+
+               IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
+                  CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
+                  CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE");
+               END IF;
+
+               CHECKVAR := CHECK_TYPE'VALUE ("ONE");
+               C3 := GPARM(CHECKVAR);
+               IF C3 /= IDENT(C1) THEN 
+                    FAILED ("INCORRECT VALUE FOR CONVERSION");
+               END IF;
+
+               CHECK_1 (IDENT(C0), BASIC_SIZE, "CHECK_ENUM");
+
+
+               IF CHECK_TYPE'(C2) /= IDENT(C2) THEN 
+                    FAILED ("INCORRECT VALUE FOR QUALIFICATION");
+               END IF;
+
+               C3 := CHECK_TYPE'VALUE ("TWO");
+               IF C3 /= IDENT(C2) THEN 
+                    FAILED ("INCORRECT VALUE FOR ASSIGNMENT");
+               END IF;
+
+          END GENPROC;
+
+          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
+
+     BEGIN
+
+          NEWPROC (ZERO, ONE, TWO);
+
+     END;
+
+     RESULT;
+
+END CD2A23E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24a.ada
new file mode 100644
index 000000000..2ec575715
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24a.ada
@@ -0,0 +1,226 @@
+-- CD2A24A.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 SIZE SPECIFICATION AND AN ENUMERATION
+--     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
+--     THEN OPERATIONS ON VALUES OF SUCH A TYPE WITH THE SMALLEST
+--     APPROPRIATE SIGNED SIZE ARE NOT AFFECTED BY THE
+--     REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     JET 08/19/87 CREATED ORIGINAL TEST.
+--     DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
+--                  REPRESENTATION CLAUSE.
+--     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD2A24A IS
+
+     BASIC_SIZE : CONSTANT := 4;
+
+     TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
+
+     FOR CHECK_TYPE USE (ZERO => 3, ONE => 4, TWO => 5);
+
+     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
+
+     C0 : CHECK_TYPE := ZERO;
+     C1 : CHECK_TYPE := ONE;
+     C2 : CHECK_TYPE := TWO;
+
+     TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
+     CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
+
+     TYPE REC_TYPE IS RECORD
+          COMP0 : CHECK_TYPE := ZERO;
+          COMP1 : CHECK_TYPE := ONE;
+          COMP2 : CHECK_TYPE := TWO;
+     END RECORD;
+
+     CHREC : REC_TYPE;
+
+     FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN CH;
+          ELSE
+               RETURN ONE;
+          END IF;
+     END IDENT;
+
+     PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
+
+     PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
+                     CIO1, CIO2 : IN OUT CHECK_TYPE;
+                     CO2        :    OUT CHECK_TYPE) IS
+     BEGIN
+          IF NOT ((IDENT (CIO1) IN CIO1 .. CIO2)    AND
+                  (CI0 NOT IN IDENT (ONE) .. CIO2)) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS " &
+                       "- 1");
+          END IF;
+
+          IF CHECK_TYPE'VAL (0) /= IDENT (CI0)  OR
+             CHECK_TYPE'VAL (1) /= IDENT (CIO1) OR
+             CHECK_TYPE'VAL (2) /= IDENT (CIO2) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 1");
+          END IF;
+
+          IF CHECK_TYPE'PRED (CIO1) /= IDENT (CI0)  OR
+             CHECK_TYPE'PRED (CIO2) /= IDENT (CIO1) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 1");
+          END IF;
+
+          IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CI0)   OR
+             CHECK_TYPE'VALUE ("ONE")  /=  IDENT (CIO1) OR
+             CHECK_TYPE'VALUE ("TWO")  /=  IDENT (CIO2) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 1");
+          END IF;
+
+          CO2 := TWO;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A24A", "CHECK THAT WHEN A SIZE SPECIFICATION AND " &
+                      "AN ENUMERATION REPRESENTATION CLAUSE ARE " &
+                      "GIVEN FOR AN ENUMERATION TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF SUCH A TYPE WITH " &
+                      "THE SMALLEST APPROPRIATE SIGNED SIZE ARE " &
+                      "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
+
+     CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
+     PROC (ZERO, TWO, C1, C2, C2);
+
+     IF C1 /= ONE OR C2 /= TWO THEN
+          FAILED ("INCORRECT VALUE RETURNED BY PROCEDURE");
+     END IF;
+
+     IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+     END IF;
+
+     IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR C0'SIZE");
+     END IF;
+
+     IF NOT ((C0 <  IDENT (ONE)) AND(IDENT (C2)  > IDENT (C1)) AND
+             (C1 <= IDENT (ONE)) AND(IDENT (TWO) = C2))        THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
+     END IF;
+
+     IF CHECK_TYPE'LAST /= IDENT (TWO) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST - 2");
+     END IF;
+
+     IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
+        CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
+        CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 2");
+     END IF;
+
+     IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
+        CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 2");
+     END IF;
+
+     IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
+        CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
+        CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 2");
+     END IF;
+
+     IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
+     END IF;
+
+     IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
+             (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
+             (CHARRAY (1) <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHARRAY (2)))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
+     END IF;
+
+     IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
+             (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
+     END IF;
+
+     IF CHECK_TYPE'VAL (0) /= IDENT (CHARRAY (0)) OR
+        CHECK_TYPE'VAL (1) /= IDENT (CHARRAY (1)) OR
+        CHECK_TYPE'VAL (2) /= IDENT (CHARRAY (2)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 3");
+     END IF;
+
+     IF CHECK_TYPE'PRED (CHARRAY (1)) /= IDENT (CHARRAY (0)) OR
+        CHECK_TYPE'PRED (CHARRAY (2)) /= IDENT (CHARRAY (1)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 3");
+     END IF;
+
+     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHARRAY (0)) OR
+        CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHARRAY (1)) OR
+        CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHARRAY (2)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 3");
+     END IF;
+
+     IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
+     END IF;
+
+     IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
+             (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
+             (CHREC.COMP1 <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHREC.COMP2))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
+     END IF;
+
+     IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
+             (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
+     END IF;
+
+     IF CHECK_TYPE'POS (CHREC.COMP0) /= IDENT_INT (0) OR
+        CHECK_TYPE'POS (CHREC.COMP1) /= IDENT_INT (1) OR
+        CHECK_TYPE'POS (CHREC.COMP2) /= IDENT_INT (2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 4");
+     END IF;
+
+     IF CHECK_TYPE'SUCC (CHREC.COMP0) /= IDENT (CHREC.COMP1) OR
+        CHECK_TYPE'SUCC (CHREC.COMP1) /= IDENT (CHREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 4");
+     END IF;
+
+     IF CHECK_TYPE'IMAGE (CHREC.COMP0) /= IDENT_STR ("ZERO") OR
+        CHECK_TYPE'IMAGE (CHREC.COMP1) /= IDENT_STR ("ONE")  OR
+        CHECK_TYPE'IMAGE (CHREC.COMP2) /= IDENT_STR ("TWO")  THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 4");
+     END IF;
+
+
+     RESULT;
+
+END CD2A24A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24e.ada
new file mode 100644
index 000000000..fcb0087b0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24e.ada
@@ -0,0 +1,220 @@
+-- CD2A24E.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 SIZE CLAUSE AND AN ENUMERATION
+--     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
+--     AND THE SMALLEST SIZE APPROPRIATE FOR AN UNSIGNED REPRESENTATION
+--     IS SPECIFIED, THEN OPERATIONS ON THE TYPE ARE NOT AFFECTED.
+
+-- HISTORY:
+--     JET 08/19/87 CREATED ORIGINAL TEST.
+--     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A24E IS
+
+     BASIC_SIZE : CONSTANT := 3;
+
+     TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
+
+     FOR CHECK_TYPE USE (ZERO => 3, ONE => 4,
+                         TWO => 5);
+
+     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
+
+     C0 : CHECK_TYPE := ZERO;
+     C1 : CHECK_TYPE := ONE;
+     C2 : CHECK_TYPE := TWO;
+
+     TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
+     CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
+
+     TYPE REC_TYPE IS RECORD
+          COMP0 : CHECK_TYPE := ZERO;
+          COMP1 : CHECK_TYPE := ONE;
+          COMP2 : CHECK_TYPE := TWO;
+     END RECORD;
+
+     CHREC : REC_TYPE;
+
+     FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN CH;
+          ELSE
+               RETURN ONE;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
+                     CIO1, CIO2 : IN OUT CHECK_TYPE;
+                     CO2        :    OUT CHECK_TYPE) IS
+     BEGIN
+          IF NOT ((CI0 <  IDENT (ONE))                          AND
+                  (IDENT (CI2)  > IDENT (CIO1))                 AND
+                  (CIO1 <= IDENT (ONE)) AND(IDENT (TWO) = CI2)) THEN
+               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
+                       "- 1");
+          END IF;
+
+          IF CHECK_TYPE'POS (CI0)  /= IDENT_INT (0) OR
+             CHECK_TYPE'POS (CIO1) /= IDENT_INT (1) OR
+             CHECK_TYPE'POS (CI2)  /= IDENT_INT (2) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 1");
+          END IF;
+
+          IF CHECK_TYPE'SUCC (CI0)  /=  IDENT (CIO1) OR
+             CHECK_TYPE'SUCC (CIO1) /= IDENT (CI2)   THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 1");
+          END IF;
+
+          IF CHECK_TYPE'IMAGE (CI0)  /= IDENT_STR ("ZERO") OR
+             CHECK_TYPE'IMAGE (CIO1) /= IDENT_STR ("ONE")  OR
+             CHECK_TYPE'IMAGE (CI2)  /= IDENT_STR ("TWO")  THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 1");
+          END IF;
+
+
+          CO2 := TWO;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A24E", "CHECK THAT IF A SIZE CLAUSE AND AN ENUMERATION " &
+                      "REPRESENTATION CLAUSE ARE GIVEN FOR AN " &
+                      "ENUMERATION TYPE, AND THE SMALLEST SIZE " &
+                      "APPROPRIATE FOR AN UNSIGNED REPRESENTATION " &
+                      "IS SPECIFIED, THEN OPERATIONS ON THE TYPE " &
+                      "ARE NOT AFFECTED");
+
+     PROC (ZERO, TWO, C1, C2, C2);
+
+     IF C1 /= ONE OR C2 /= TWO THEN
+          FAILED ("INCORRECT VALUE RETURNED BY PROCEDURE");
+     END IF;
+
+     IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+     END IF;
+
+     IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR C0'SIZE");
+     END IF;
+
+     IF NOT ((IDENT (C1) IN C1 .. C2)       AND
+             (C0 NOT IN IDENT (ONE) .. C2)) THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
+     END IF;
+
+     IF CHECK_TYPE'FIRST /= IDENT (ZERO) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST - 2");
+     END IF;
+
+     IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
+        CHECK_TYPE'VAL (1) /= IDENT (C1) OR
+        CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 2");
+     END IF;
+
+     IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
+        CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 2");
+     END IF;
+
+     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
+        CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
+        CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 2");
+     END IF;
+
+     IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
+     END IF;
+
+     IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
+             (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
+             (CHARRAY (1) <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHARRAY (2)))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
+     END IF;
+
+     IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
+             (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
+     END IF;
+
+     IF CHECK_TYPE'POS (CHARRAY (0)) /= IDENT_INT (0) OR
+        CHECK_TYPE'POS (CHARRAY (1)) /= IDENT_INT (1) OR
+        CHECK_TYPE'POS (CHARRAY (2)) /= IDENT_INT (2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 3");
+     END IF;
+
+     IF CHECK_TYPE'SUCC (CHARRAY (0)) /= IDENT (CHARRAY (1)) OR
+        CHECK_TYPE'SUCC (CHARRAY (1)) /= IDENT (CHARRAY (2)) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 3");
+     END IF;
+
+     IF CHECK_TYPE'IMAGE (CHARRAY (0)) /= IDENT_STR ("ZERO") OR
+        CHECK_TYPE'IMAGE (CHARRAY (1)) /= IDENT_STR ("ONE")  OR
+        CHECK_TYPE'IMAGE (CHARRAY (2)) /= IDENT_STR ("TWO")  THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 3");
+     END IF;
+
+     IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
+     END IF;
+
+     IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
+             (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
+             (CHREC.COMP1 <= IDENT (ONE))                 AND
+             (IDENT (TWO) = CHREC.COMP2))                 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
+     END IF;
+
+     IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
+             (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
+     END IF;
+
+     IF CHECK_TYPE'VAL (0) /= IDENT (CHREC.COMP0) OR
+        CHECK_TYPE'VAL (1) /= IDENT (CHREC.COMP1) OR
+        CHECK_TYPE'VAL (2) /= IDENT (CHREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 4");
+     END IF;
+
+     IF CHECK_TYPE'PRED (CHREC.COMP1) /= IDENT (CHREC.COMP0) OR
+        CHECK_TYPE'PRED (CHREC.COMP2) /= IDENT (CHREC.COMP1) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 4");
+     END IF;
+
+     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHREC.COMP0) OR
+        CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHREC.COMP1) OR
+        CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 4");
+     END IF;
+
+     RESULT;
+END CD2A24E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24i.ada
new file mode 100644
index 000000000..494516bf0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24i.ada
@@ -0,0 +1,126 @@
+-- CD2A24I.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 SIZE CLAUSE (SPECIFYING THE SMALLEST APPROPRIATE
+--     SIZE FOR A SIGNED REPRESENTATION) AND AN ENUMERATION
+--     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
+--     THEN THE TYPE CAN BE USED AS AN ACTUAL PARAMETER IN AN
+--     INSTANTIATION.
+
+-- HISTORY:
+--     JET 08/19/87 CREATED ORIGINAL TEST.
+--     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES. 
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A24I IS
+
+     TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
+     BASIC_SIZE : CONSTANT := 4;
+
+     FOR BASIC_ENUM USE (ZERO => 3, ONE => 4,
+                         TWO => 5);
+
+     FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
+
+BEGIN
+     TEST ("CD2A24I", "CHECK THAT IF A SIZE CLAUSE (SPECIFYING THE " &
+                      "SMALLEST APPROPRIATE SIZE FOR A SIGNED " &
+                      "REPRESENTATION) AND AN ENUMERATION " &
+                      "REPRESENTATION CLAUSE ARE GIVEN FOR AN " &
+                      "ENUMERATION TYPE, THEN THE TYPE CAN BE USED " &
+                      "AS AN ACTUAL PARAMETER IN AN INSTANTIATION");
+
+
+     DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
+
+          GENERIC
+               TYPE GPARM IS (<>);
+          PROCEDURE GENPROC (C0, C1, C2: GPARM);
+
+          PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
+
+               SUBTYPE CHECK_TYPE IS GPARM;
+
+               FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN CH;
+                    ELSE
+                         RETURN C1;
+                    END IF;
+               END IDENT;
+
+          BEGIN -- GENPROC.
+
+               IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+               END IF;
+
+               IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR C0'SIZE");
+               END IF;
+
+               IF NOT ((C0 <  IDENT (C1)) AND
+                       (IDENT (C2)  > IDENT (C1)) AND
+                       (C1 <= IDENT (C1)) AND (IDENT (C2) = C2)) THEN
+                    FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
+                            "OPERATORS");
+               END IF;
+
+               IF CHECK_TYPE'FIRST /= IDENT (C0) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST");
+               END IF;
+
+               IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
+                  CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
+                  CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS");
+               END IF;
+
+               IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
+                  CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC");
+               END IF;
+
+               IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
+                  CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
+                  CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE");
+               END IF;
+
+          END GENPROC;
+
+          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
+
+     BEGIN
+
+          NEWPROC (ZERO, ONE, TWO);
+
+     END;
+
+     RESULT;
+
+END CD2A24I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24j.ada
new file mode 100644
index 000000000..2a9fd8175
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a24j.ada
@@ -0,0 +1,124 @@
+-- CD2A24J.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 SIZE CLAUSE (SPECIFYING THE SMALLEST APPROPRIATE
+--     SIZE FOR AN UNSIGNED REPRESENTATION) AND AN ENUMERATION
+--     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
+--     THEN THE TYPE CAN BE USED AS AN ACTUAL PARAMETER IN AN
+--     INSTANTIATION.
+
+-- HISTORY:
+--     JET 08/19/87 CREATED ORIGINAL TEST.
+--     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A24J IS
+
+     TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
+     BASIC_SIZE : CONSTANT := 3;
+
+     FOR BASIC_ENUM USE (ZERO => 3, ONE => 4,
+                         TWO => 5);
+     FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
+
+BEGIN
+     TEST ("CD2A24J", "CHECK THAT IF A SIZE CLAUSE (SPECIFYING THE " &
+                      "SMALLEST APPROPRIATE SIZE FOR AN UNSIGNED " &
+                      "REPRESENTATION) AND AN ENUMERATION " &
+                      "REPRESENTATION CLAUSE ARE GIVEN FOR AN " &
+                      "ENUMERATION TYPE, THEN THE TYPE CAN BE USED " &
+                      "AS AN ACTUAL PARAMETER IN AN INSTANTIATION");
+
+
+     DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
+
+          GENERIC
+               TYPE GPARM IS (<>);
+          PROCEDURE GENPROC (C0, C1, C2: GPARM);
+
+          PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
+
+               SUBTYPE CHECK_TYPE IS GPARM;
+
+               FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN CH;
+                    ELSE
+                         RETURN C1;
+                    END IF;
+               END IDENT;
+
+          BEGIN -- GENPROC.
+
+               IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+               END IF;
+
+               IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR C0'SIZE");
+               END IF;
+
+               IF NOT ((IDENT (C1) IN C1 .. C2)       AND
+                       (C0 NOT IN IDENT (C1) .. C2)) THEN
+                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                            "OPERATORS");
+               END IF;
+
+               IF CHECK_TYPE'LAST /= IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
+               END IF;
+
+               IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
+                  CHECK_TYPE'VAL (1) /= IDENT (C1) OR
+                  CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL");
+               END IF;
+
+               IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
+                  CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED");
+               END IF;
+
+               IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
+                  CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
+                  CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
+                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE");
+               END IF;
+
+          END GENPROC;
+
+          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
+
+     BEGIN
+
+          NEWPROC (ZERO, ONE, TWO);
+
+     END;
+
+     RESULT;
+
+END CD2A24J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a31a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a31a.ada
new file mode 100644
index 000000000..be8efa615
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a31a.ada
@@ -0,0 +1,266 @@
+-- CD2A31A.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 SIZE SPECIFICATION IS GIVEN FOR AN
+--     INTEGER TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
+--     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     JET 08/06/87  CREATED ORIGINAL TEST.
+--     DHH 04/06/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   SIZE CLAUSE VALUE TO 9, AND ADDED REPRESENTAION
+--                   CLAUSE CHECK.
+--     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT;  USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD2A31A IS
+
+     BASIC_SIZE : CONSTANT := 9;
+
+     TYPE INT IS RANGE -100 .. 100;
+
+     FOR INT'SIZE USE BASIC_SIZE;
+
+     I1 : INT := -100;
+     I2 : INT :=    0;
+     I3 : INT :=  100;
+
+     TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE -1 .. 1) OF INT;
+     INTARRAY : ARRAY_TYPE := (-100, 0, 100);
+
+     TYPE REC_TYPE IS RECORD
+          COMPN : INT := -100;
+          COMPZ : INT :=    0;
+          COMPP : INT :=  100;
+     END RECORD;
+
+     IREC : REC_TYPE;
+
+     PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (INT);
+
+     FUNCTION IDENT (I : INT) RETURN INT IS
+     BEGIN
+          IF EQUAL (0,0) THEN
+               RETURN I;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC (PIN,  PIP  :        INT;
+                     PIOZ, PIOP : IN OUT INT;
+                     POP        :    OUT INT) IS
+
+     BEGIN
+          IF PIN'SIZE < IDENT_INT (BASIC_SIZE) THEN
+               FAILED ("INCORRECT VALUE FOR PIN'SIZE");
+          END IF;
+
+          IF NOT ((PIN < IDENT (0))             AND
+                  (IDENT (PIP) > IDENT (PIOZ))  AND
+                  (PIOZ <= IDENT (1))           AND
+                  (IDENT (100) = PIP))          THEN
+               FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
+                       "OPERATORS - 1");
+          END IF;
+
+          IF NOT (((PIN + PIP)   = PIOZ)       AND
+                  ((PIP - PIOZ)  = PIOP)       AND
+                  ((PIOP * PIOZ) = PIOZ)       AND
+                  ((PIOZ / PIN)  = PIOZ)       AND
+                  ((PIN ** 1)    = PIN)        AND
+                  ((PIN REM 9)   = IDENT (-1)) AND
+                  ((PIP MOD 9)   = IDENT (1))) THEN
+               FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
+                       "OPERATORS - 1");
+          END IF;
+
+          IF INT'VAL (-100) /= IDENT (PIN)  OR
+             INT'VAL (0)    /= IDENT (PIOZ) OR
+             INT'VAL (100)  /= IDENT (PIOP) THEN
+               FAILED ("INCORRECT VALUE FOR INT'VAL - 1");
+          END IF;
+
+          IF INT'PRED (PIOZ) /= IDENT (-1) OR
+             INT'PRED (PIP)  /= IDENT (99) THEN
+               FAILED ("INCORRECT VALUE FOR INT'PRED - 1");
+          END IF;
+
+          IF INT'VALUE ("-100") /= IDENT (PIN)  OR
+             INT'VALUE ("0")    /= IDENT (PIOZ) OR
+             INT'VALUE ("100")  /= IDENT (PIOP) THEN
+               FAILED ("INCORRECT VALUE FOR INT'VALUE - 1");
+          END IF;
+
+          POP := 100;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A31A", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
+                      "GIVEN FOR AN INTEGER TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
+                      "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
+
+     CHECK_1 (I1, 9, "INT");
+     PROC (-100, 100, I2, I3, I3);
+
+     IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR INT'SIZE");
+     END IF;
+
+     IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR I1'SIZE");
+     END IF;
+
+     FOR I IN IDENT (I1) .. IDENT (I3) LOOP
+          IF NOT (I IN I1 .. I3) OR
+             (I NOT IN IDENT(-100) .. IDENT(100)) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                       "OPERATORS - 2");
+          END IF;
+     END LOOP;
+
+     IF NOT ((+I1 = I1)     AND
+             (-I3 = I1)      AND
+             (ABS I1 = I3)) THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
+                  "OPERATORS - 2");
+     END IF;
+
+     IF INT'FIRST /= IDENT (-100) THEN
+          FAILED ("INCORRECT VALUE FOR INT'FIRST - 2");
+     END IF;
+
+     IF INT'POS (I1) /= IDENT_INT (-100) OR
+        INT'POS (I2) /= IDENT_INT (   0) OR
+        INT'POS (I3) /= IDENT_INT ( 100) THEN
+          FAILED ("INCORRECT VALUE FOR INT'POS - 2");
+     END IF;
+
+     IF INT'SUCC (I1) /= IDENT (-99) OR
+        INT'SUCC (I2) /= IDENT (1)   THEN
+          FAILED ("INCORRECT VALUE FOR INT'SUCC - 2");
+     END IF;
+
+     IF INT'IMAGE (I1) /= IDENT_STR ("-100") OR
+        INT'IMAGE (I2) /= IDENT_STR (" 0")    OR
+        INT'IMAGE (I3) /= IDENT_STR (" 100")  THEN
+          FAILED ("INCORRECT VALUE FOR INT'IMAGE - 2");
+     END IF;
+
+     IF INTARRAY(0)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR INTARRAY(0)'SIZE");
+     END IF;
+
+     IF NOT ((INTARRAY(-1) < IDENT (0))                       AND
+             (IDENT (INTARRAY (1)) > IDENT (INTARRAY(0)))     AND
+             (INTARRAY(0) <= IDENT (0))                       AND
+             (IDENT (100) = INTARRAY (1)))                    THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
+     END IF;
+
+     FOR I IN IDENT (INTARRAY(-1)) .. IDENT (INTARRAY(1)) LOOP
+          IF NOT (I IN INTARRAY(-1) .. INTARRAY(1)) OR
+             (I NOT IN IDENT(-100) .. IDENT(100)) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                       "OPERATORS - 3");
+          END IF;
+     END LOOP;
+
+     IF NOT (((INTARRAY(-1) + INTARRAY( 1)) = INTARRAY( 0)) AND
+             ((INTARRAY( 0) - INTARRAY( 1)) = INTARRAY(-1)) AND
+             ((INTARRAY( 1) * INTARRAY( 0)) = INTARRAY( 0)) AND
+             ((INTARRAY( 0) / INTARRAY(-1)) = INTARRAY( 0)) AND
+             ((INTARRAY(-1) ** 1)           = INTARRAY(-1)) AND
+             ((INTARRAY(-1) REM 9)          = IDENT (-1))   AND
+             ((INTARRAY( 1) MOD 9)          = IDENT ( 1)))  THEN
+          FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
+                  "OPERATORS - 3");
+     END IF;
+
+     IF INT'POS (INTARRAY (-1)) /= IDENT_INT (-100) OR
+        INT'POS (INTARRAY ( 0)) /= IDENT_INT (   0) OR
+        INT'POS (INTARRAY ( 1)) /= IDENT_INT ( 100) THEN
+          FAILED ("INCORRECT VALUE FOR INT'POS - 3");
+     END IF;
+
+     IF INT'SUCC (INTARRAY (-1)) /= IDENT (-99) OR
+        INT'SUCC (INTARRAY ( 0)) /= IDENT (1)   THEN
+          FAILED ("INCORRECT VALUE FOR INT'SUCC - 3");
+     END IF;
+
+     IF INT'IMAGE (INTARRAY (-1)) /= IDENT_STR ("-100") OR
+        INT'IMAGE (INTARRAY ( 0)) /= IDENT_STR (" 0")    OR
+        INT'IMAGE (INTARRAY ( 1)) /= IDENT_STR (" 100")  THEN
+          FAILED ("INCORRECT VALUE FOR INT'IMAGE - 3");
+     END IF;
+
+     IF IREC.COMPP'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR IREC.COMPP'SIZE");
+     END IF;
+
+     IF NOT ((IREC.COMPN < IDENT (0))                      AND
+             (IDENT (IREC.COMPP) > IDENT (IREC.COMPZ))     AND
+             (IREC.COMPZ <= IDENT (0))                     AND
+             (IDENT (100) = IREC.COMPP))                   THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
+     END IF;
+
+     FOR I IN IDENT (IREC.COMPN) .. IDENT (IREC.COMPP) LOOP
+          IF NOT (I IN IREC.COMPN .. IREC.COMPP) OR
+             (I NOT IN IDENT(-100) .. IDENT(100)) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                       "OPERATORS - 4");
+          END IF;
+     END LOOP;
+
+     IF NOT ((+IREC.COMPN = IREC.COMPN)     AND
+             (-IREC.COMPP = IREC.COMPN)     AND
+             (ABS IREC.COMPN = IREC.COMPP)) THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
+                  "OPERATORS - 4");
+     END IF;
+
+     IF INT'VAL (-100) /= IDENT (IREC.COMPN) OR
+        INT'VAL (   0) /= IDENT (IREC.COMPZ) OR
+        INT'VAL ( 100) /= IDENT (IREC.COMPP) THEN
+          FAILED ("INCORRECT VALUE FOR INT'VAL - 4");
+     END IF;
+
+     IF INT'PRED (IREC.COMPZ) /= IDENT (-1) OR
+        INT'PRED (IREC.COMPP) /= IDENT (99) THEN
+          FAILED ("INCORRECT VALUE FOR INT'PRED - 4");
+     END IF;
+
+     IF INT'VALUE ("-100") /= IDENT (IREC.COMPN) OR
+        INT'VALUE (   "0") /= IDENT (IREC.COMPZ) OR
+        INT'VALUE ( "100") /= IDENT (IREC.COMPP) THEN
+          FAILED ("INCORRECT VALUE FOR INT'VALUE - 4");
+     END IF;
+
+     RESULT;
+END CD2A31A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a31c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a31c.ada
new file mode 100644
index 000000000..2b01ed6e2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a31c.ada
@@ -0,0 +1,127 @@
+-- CD2A31C.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 INTEGER 'SIZE SPECIFICATIONS CAN BE GIVEN:
+--        IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
+--          DECLARED IN THE VISIBLE PART;
+--        FOR A DERIVED INTEGER TYPE;
+--        FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
+--          AN INTEGER TYPE;
+--        FOR AN INTEGER TYPE IN A GENERIC UNIT.
+
+-- HISTORY:
+--     PWB 06/17/87  CREATED ORIGINAL TEST.
+--     DHH 04/06/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   SIZE CLAUSE VALUE TO 9, AND ADDED REPRESENTAION
+--                   CLAUSE CHECK AND INCLUDED TEST FOR INTEGER IN A
+--                   GENERIC UNIT.
+--     JRL 03/27/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
+--     DTN 06/17/92  REMOVED THE LENGTH CLAUSE FOR TYPE PRIVATE_INT.
+
+WITH REPORT; USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD2A31C IS
+
+     TYPE BASIC_INT IS RANGE -60 .. 80;
+     SPECIFIED_SIZE : CONSTANT := 9;
+
+     TYPE DERIVED_INT IS NEW BASIC_INT;
+     FOR DERIVED_INT'SIZE USE SPECIFIED_SIZE;
+
+     PACKAGE P IS
+          TYPE INT_IN_P IS RANGE -125 .. 125;
+          FOR INT_IN_P'SIZE USE SPECIFIED_SIZE;
+          TYPE PRIVATE_INT IS PRIVATE;
+          TYPE ALT_INT_IN_P IS RANGE -125 .. 125;
+     PRIVATE
+          TYPE PRIVATE_INT IS RANGE -125 .. 125;
+          FOR ALT_INT_IN_P'SIZE USE SPECIFIED_SIZE;
+     END P;
+
+     USE P;
+     TYPE DERIVED_PRIVATE_INT IS NEW PRIVATE_INT;
+     FOR DERIVED_PRIVATE_INT'SIZE USE SPECIFIED_SIZE;
+     MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
+
+-- SIZE SPECIFICATION GIVEN IN A GENERIC PROCEDURE.
+
+     GENERIC
+     PROCEDURE GENPROC;
+
+     PROCEDURE GENPROC IS
+          TYPE CHECK_INT IS RANGE -125 .. 125;
+          FOR CHECK_INT'SIZE USE SPECIFIED_SIZE;
+
+          PROCEDURE CHECK_4 IS NEW LENGTH_CHECK (CHECK_INT);
+
+     BEGIN
+
+          IF CHECK_INT'SIZE /= MINIMUM_SIZE THEN
+               FAILED ("GENERIC CHECK_INT'SIZE IS INCORRECT");
+          END IF;
+          CHECK_4 (-60, 9, "GENERIC CHECK_INT");
+
+     END GENPROC;
+
+     PROCEDURE NEWPROC IS NEW GENPROC;
+
+     PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (DERIVED_INT);
+     PROCEDURE CHECK_2 IS NEW LENGTH_CHECK (INT_IN_P);
+     PROCEDURE CHECK_3 IS NEW LENGTH_CHECK (ALT_INT_IN_P);
+
+BEGIN
+
+     TEST("CD2A31C", "CHECK THAT 'SIZE SPECIFICATIONS CAN BE GIVEN IN " &
+                     "VISIBLE OR PRIVATE PART OF PACKAGE FOR INTEGER " &
+                     "TYPE DECLARED IN VISIBLE PART, AND FOR " &
+                     "DERIVED INTEGER TYPES " &
+                     "AND DERIVED PRIVATE TYPES WHOSE FULL DECLARATIONS " &
+                     "ARE AS INTEGER TYPES");
+
+     CHECK_1 (-60, 9, "DERIVED_INT");
+     CHECK_2 (-60, 9, "INT_IN_P");
+     CHECK_3 (-60, 9, "ALT_INT_IN_P");
+
+     NEWPROC;
+
+     IF DERIVED_INT'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("DERIVED_INT'SIZE INCORRECT");
+     END IF;
+
+     IF INT_IN_P'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("INT_IN_P'SIZE INCORRECT");
+     END IF;
+
+     IF ALT_INT_IN_P'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("ALT_INT_IN_P'SIZE INCORRECT");
+     END IF;
+
+     IF DERIVED_PRIVATE_INT'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("DERIVED_PRIVATE_INT'SIZE INCORRECT");
+     END IF;
+
+     RESULT;
+
+END CD2A31C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a31e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a31e.ada
new file mode 100644
index 000000000..b4ed17caa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a31e.ada
@@ -0,0 +1,139 @@
+-- CD2A31E.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 SIZE SPECIFICATION IS GIVEN FOR AN
+--     INTEGER TYPE, THEN SUCH A TYPE CAN BE PASSED AS AN ACTUAL
+--     PARAMETER TO GENERIC PROCEDURES.
+
+-- HISTORY:
+--     JET 08/12/87  CREATED ORIGINAL TEST.
+--     BCB 10/18/88  MODIFIED HEADER AND ENTERED IN ACVC.
+--     DHH 04/06/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   SIZE CLAUSE VALUE TO 9, AND CHANGED 'SIZE CLAUSE
+--                   CHECKS.
+--     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD2A31E IS
+
+     TYPE BASIC_INT IS RANGE -100 .. 100;
+     BASIC_SIZE : CONSTANT := 9;
+
+     FOR BASIC_INT'SIZE USE BASIC_SIZE;
+
+BEGIN
+
+     TEST ("CD2A31E", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
+                      "GIVEN FOR AN INTEGER TYPE, THEN SUCH A TYPE " &
+                      "CAN BE PASSED AS AN ACTUAL PARAMETER TO " &
+                      "GENERIC PACKAGES AND PROCEDURES");
+
+     DECLARE -- TYPE DECLARATION WITHIN GENERIC PROCEDURE.
+
+          GENERIC
+               TYPE GPARM IS RANGE <>;
+          PROCEDURE GENPROC;
+
+          PROCEDURE GENPROC IS
+
+          SUBTYPE INT IS GPARM;
+
+          I1 : INT := -100;
+          I2 : INT :=    0;
+          I3 : INT :=  100;
+
+          FUNCTION IDENT (I : INT) RETURN INT IS
+          BEGIN
+               IF EQUAL (0,0) THEN
+                    RETURN I;
+               ELSE
+                    RETURN 0;
+               END IF;
+          END IDENT;
+
+          BEGIN -- GENPROC.
+
+               IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR INT'SIZE");
+               END IF;
+
+               IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR I1'SIZE");
+               END IF;
+
+               IF NOT ((I1 < IDENT (0))           AND
+                       (IDENT (I3) > IDENT (I2))  AND
+                       (I2 <= IDENT (0))          AND
+                       (IDENT (100) = I3))        THEN
+                    FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
+                            "OPERATORS");
+               END IF;
+
+               IF NOT (((I1 + I3)  = I2)         AND
+                       ((I2 - I3)  = I1)         AND
+                       ((I3 * I2)  = I2)         AND
+                       ((I2 / I1)  = I2)         AND
+                       ((I1 ** 1)  = I1)         AND
+                       ((I1 REM 9) = IDENT (-1)) AND
+                       ((I3 MOD 9) = IDENT (1))) THEN
+                    FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
+                            "OPERATORS");
+               END IF;
+
+               IF INT'LAST /= IDENT (100) THEN
+                    FAILED ("INCORRECT VALUE FOR INT'LAST");
+               END IF;
+
+               IF INT'VAL (-100) /= IDENT (I1) OR
+                  INT'VAL (0)    /= IDENT (I2) OR
+                  INT'VAL (100)  /= IDENT (I3) THEN
+                    FAILED ("INCORRECT VALUE FOR INT'VAL");
+               END IF;
+
+               IF INT'PRED (I2) /= IDENT (-1) OR
+                  INT'PRED (I3) /= IDENT (99) THEN
+                    FAILED ("INCORRECT VALUE FOR INT'PRED");
+               END IF;
+
+               IF INT'VALUE ("-100") /= IDENT (I1) OR
+                  INT'VALUE (" 0")   /= IDENT (I2) OR
+                  INT'VALUE (" 100") /= IDENT (I3) THEN
+                         FAILED ("INCORRECT VALUE FOR INT'VALUE");
+               END IF;
+
+          END GENPROC;
+
+          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_INT);
+
+     BEGIN
+
+          NEWPROC;
+
+     END;
+
+     RESULT;
+
+END CD2A31E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32a.ada
new file mode 100644
index 000000000..228b445d6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32a.ada
@@ -0,0 +1,272 @@
+-- CD2A32A.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 SIZE SPECIFICATION IS GIVEN FOR AN
+--     INTEGER TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
+--     WITH THE SMALLEST APPROPRIATE SIGNED SIZE ARE NOT
+--     AFFECTED BY THE REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     JET 08/12/87  CREATED ORIGINAL TEST.
+--     DHH 04/10/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   SIZE CLAUSE VALUE TO 7, CHANGED OPERATOR ON 'SIZE
+--                   CHECKS AND ADDED REPRESENTAION CLAUSE CHECK.
+--     RJW 03/28/90  REMOVED ERRONEOUS REFERENCES TO LENGTH_CHECK.
+--     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT;  USE REPORT;
+WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD2A32A IS
+
+     BASIC_SIZE : CONSTANT := 7;
+
+     TYPE INT IS RANGE -63 .. 63;
+
+     FOR INT'SIZE USE BASIC_SIZE;
+
+     I1 : INT := -63;
+     I2 : INT :=    0;
+     I3 : INT :=  63;
+
+     TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE -1 .. 1) OF INT;
+     PRAGMA PACK (ARRAY_TYPE);
+     INTARRAY : ARRAY_TYPE := (-63, 0, 63);
+
+     TYPE REC_TYPE IS RECORD
+          COMPN : INT := -63;
+          COMPZ : INT :=    0;
+          COMPP : INT :=  63;
+     END RECORD;
+     PRAGMA PACK (REC_TYPE);
+
+     IREC : REC_TYPE;
+
+     FUNCTION IDENT (I : INT) RETURN INT IS
+     BEGIN
+          IF EQUAL (0,0) THEN
+               RETURN I;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT;
+
+     PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (INT);
+
+
+     PROCEDURE PROC (PIN,  PIP  :        INT;
+                     PIOZ, PIOP : IN OUT INT;
+                     POP        :    OUT INT) IS
+
+     BEGIN
+          IF PIN'SIZE < IDENT_INT (BASIC_SIZE) THEN
+               FAILED ("INCORRECT VALUE FOR PIN'SIZE");
+          END IF;
+
+          FOR P1 IN IDENT (PIN) .. IDENT (PIOP) LOOP
+               IF NOT (P1 IN PIN .. PIP) OR
+                  (P1 NOT IN IDENT(-63) .. IDENT(63)) THEN
+                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                       "OPERATORS - 1");
+               END IF;
+          END LOOP;
+
+          IF NOT ((+PIP = PIOP)     AND
+                  (-PIN = PIP)      AND
+                  (ABS PIN = PIOP)) THEN
+               FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
+                       "OPERATORS - 1");
+          END IF;
+
+          IF INT'VAL (-63) /= IDENT (PIN)  OR
+             INT'VAL (0)    /= IDENT (PIOZ) OR
+             INT'VAL (63)  /= IDENT (PIOP) THEN
+               FAILED ("INCORRECT VALUE FOR INT'VAL - 1");
+          END IF;
+
+          IF INT'PRED (PIOZ) /= IDENT (-1) OR
+             INT'PRED (PIP)  /= IDENT (62) THEN
+               FAILED ("INCORRECT VALUE FOR INT'PRED - 1");
+          END IF;
+
+          IF INT'VALUE ("-63") /= IDENT (PIN)  OR
+             INT'VALUE ("0")    /= IDENT (PIOZ) OR
+             INT'VALUE ("63")  /= IDENT (PIOP) THEN
+               FAILED ("INCORRECT VALUE FOR INT'VALUE - 1");
+          END IF;
+
+          POP := 63;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A32A", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
+                      "GIVEN FOR AN INTEGER TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF SUCH A TYPE WITH " &
+                      "THE SMALLEST APPROPRIATE SIGNED SIZE ARE " &
+                      "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
+
+     CHECK_1 (I1, 7, "INT");
+
+     PROC (-63, 63, I2, I3, I3);
+
+     IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR INT'SIZE");
+     END IF;
+
+     IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR I1'SIZE");
+     END IF;
+
+     IF NOT ((I1 < IDENT (0))              AND
+             (IDENT (I3) > IDENT (I2))     AND
+             (I2 <= IDENT (0))             AND
+             (IDENT (63) = I3))           THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
+     END IF;
+
+     IF NOT (((I1 + I3)   = I2)         AND
+             ((I2 - I3)   = I1)         AND
+             ((I3 * I2)   = I2)         AND
+             ((I2 / I1)   = I2)         AND
+             ((I1 ** 1)   = I1)         AND
+             ((I1 REM 10) = IDENT (-3)) AND
+             ((I3 MOD 10) = IDENT (3))) THEN
+          FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
+                  "OPERATORS - 2");
+     END IF;
+
+     IF INT'FIRST /= IDENT (-63) THEN
+          FAILED ("INCORRECT VALUE FOR INT'FIRST - 2");
+     END IF;
+
+     IF INT'POS (I1) /= IDENT_INT (-63) OR
+        INT'POS (I2) /= IDENT_INT (   0) OR
+        INT'POS (I3) /= IDENT_INT ( 63) THEN
+          FAILED ("INCORRECT VALUE FOR INT'POS - 2");
+     END IF;
+
+     IF INT'SUCC (I1) /= IDENT (-62) OR
+        INT'SUCC (I2) /= IDENT (1)   THEN
+          FAILED ("INCORRECT VALUE FOR INT'SUCC - 2");
+     END IF;
+
+     IF INT'IMAGE (I1) /= IDENT_STR ("-63") OR
+        INT'IMAGE (I2) /= IDENT_STR (" 0")    OR
+        INT'IMAGE (I3) /= IDENT_STR (" 63")  THEN
+          FAILED ("INCORRECT VALUE FOR INT'IMAGE - 2");
+     END IF;
+
+     IF INTARRAY(0)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR INTARRAY(0)'SIZE");
+     END IF;
+
+     IF NOT ((INTARRAY(-1) < IDENT (0))                       AND
+             (IDENT (INTARRAY (1)) > IDENT (INTARRAY(0)))     AND
+             (INTARRAY(0) <= IDENT (0))                       AND
+             (IDENT (63) = INTARRAY (1)))                    THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
+     END IF;
+
+     FOR I IN IDENT (INTARRAY(-1)) .. IDENT (INTARRAY(1)) LOOP
+          IF NOT (I IN INTARRAY(-1) .. INTARRAY(1)) OR
+             (I NOT IN IDENT(-63) .. IDENT(63)) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                       "OPERATORS - 3");
+          END IF;
+     END LOOP;
+
+     IF NOT ((+INTARRAY(-1) = INTARRAY(-1))     AND
+             (-INTARRAY( 1) = INTARRAY(-1))     AND
+             (ABS INTARRAY(-1) = INTARRAY(1)))  THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
+                  "OPERATORS - 3");
+     END IF;
+
+     IF INT'VAL (-63) /= IDENT (INTARRAY (-1)) OR
+        INT'VAL (   0) /= IDENT (INTARRAY ( 0)) OR
+        INT'VAL ( 63) /= IDENT (INTARRAY ( 1)) THEN
+          FAILED ("INCORRECT VALUE FOR INT'VAL - 3");
+     END IF;
+
+     IF INT'PRED (INTARRAY (0)) /= IDENT (-1) OR
+        INT'PRED (INTARRAY (1)) /= IDENT (62) THEN
+          FAILED ("INCORRECT VALUE FOR INT'PRED - 3");
+     END IF;
+
+     IF INT'VALUE ("-63") /= IDENT (INTARRAY (-1)) OR
+        INT'VALUE ("0")    /= IDENT (INTARRAY ( 0)) OR
+        INT'VALUE ("63")  /= IDENT (INTARRAY ( 1)) THEN
+          FAILED ("INCORRECT VALUE FOR INT'VALUE - 3");
+     END IF;
+
+     IF IREC.COMPP'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR IREC.COMPP'SIZE");
+     END IF;
+
+     IF NOT ((IREC.COMPN < IDENT (0))                      AND
+             (IDENT (IREC.COMPP) > IDENT (IREC.COMPZ))     AND
+             (IREC.COMPZ <= IDENT (0))                     AND
+             (IDENT (63) = IREC.COMPP))                   THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
+     END IF;
+
+     FOR I IN IDENT (IREC.COMPN) .. IDENT (IREC.COMPP) LOOP
+          IF NOT (I IN IREC.COMPN .. IREC.COMPP) OR
+             (I NOT IN IDENT(-63) .. IDENT(63)) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                       "OPERATORS - 4");
+          END IF;
+     END LOOP;
+
+     IF NOT (((IREC.COMPN + IREC.COMPP) = IREC.COMPZ)  AND
+             ((IREC.COMPZ - IREC.COMPP) = IREC.COMPN)  AND
+             ((IREC.COMPP * IREC.COMPZ) = IREC.COMPZ)  AND
+             ((IREC.COMPZ / IREC.COMPN) = IREC.COMPZ)  AND
+             ((IREC.COMPN ** 1)         = IREC.COMPN)  AND
+             ((IREC.COMPN REM 10)       = IDENT (-3))  AND
+             ((IREC.COMPP MOD 10)       = IDENT ( 3))) THEN
+          FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
+                  "OPERATORS - 4");
+     END IF;
+
+     IF INT'POS (IREC.COMPN) /= IDENT_INT (-63) OR
+        INT'POS (IREC.COMPZ) /= IDENT_INT (   0) OR
+        INT'POS (IREC.COMPP) /= IDENT_INT ( 63) THEN
+          FAILED ("INCORRECT VALUE FOR INT'POS - 4");
+     END IF;
+
+     IF INT'SUCC (IREC.COMPN) /= IDENT (-62) OR
+        INT'SUCC (IREC.COMPZ) /= IDENT (  1) THEN
+          FAILED ("INCORRECT VALUE FOR INT'SUCC - 4");
+     END IF;
+
+     IF INT'IMAGE (IREC.COMPN) /= IDENT_STR ("-63") OR
+        INT'IMAGE (IREC.COMPZ) /= IDENT_STR (" 0")    OR
+        INT'IMAGE (IREC.COMPP) /= IDENT_STR (" 63")  THEN
+          FAILED ("INCORRECT VALUE FOR INT'IMAGE - 4");
+     END IF;
+
+     RESULT;
+END CD2A32A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32c.ada
new file mode 100644
index 000000000..a8edaa6ea
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32c.ada
@@ -0,0 +1,128 @@
+-- CD2A32C.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 SIZE SPECIFICATION FOR AN INTEGER TYPE OF THE
+--     SMALLEST APPROPRIATE SIGNED SIZE CAN BE GIVEN:
+--        IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
+--          DECLARED IN THE VISIBLE PART;
+--        FOR A DERIVED INTEGER TYPE;
+--        FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
+--          AN INTEGER TYPE;
+--        FOR AN INTEGER TYPE IN A GENERIC UNIT.
+
+-- HISTORY:
+--     JET 08/12/87  CREATED ORIGINAL TEST.
+--     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   SIZE CLAUSE VALUE TO 7, CHANGED OPERATOR ON 'SIZE
+--                   CHECKS, ADDED REPRESENTAION CLAUSE CHECK, AND
+--                   ADDED CHECK ON INTEGER IN A GENERIC UNIT.
+--     BCB 10/03/90  CHANGED FAILED MESSAGES FROM "SHOULD NOT BE GREATER
+--                   THAN" TO "MUST BE EQUAL TO".
+--     JRL 03/27/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A32C IS
+
+     TYPE BASIC_INT IS RANGE -63 .. 63;
+     SPECIFIED_SIZE : CONSTANT := 7;
+
+     TYPE DERIVED_INT IS NEW BASIC_INT;
+     FOR DERIVED_INT'SIZE USE SPECIFIED_SIZE;
+
+     PACKAGE P IS
+          TYPE INT_IN_P IS RANGE -63 .. 63;
+          FOR INT_IN_P'SIZE USE SPECIFIED_SIZE;
+          TYPE PRIVATE_INT IS PRIVATE;
+          TYPE ALT_INT_IN_P IS RANGE -63 .. 63;
+     PRIVATE
+          TYPE PRIVATE_INT IS RANGE -63 .. 63;
+          FOR ALT_INT_IN_P'SIZE USE SPECIFIED_SIZE;
+     END P;
+
+     USE P;
+
+     GENERIC
+     PACKAGE GENPACK IS
+          TYPE GEN_CHECK_INT IS RANGE -63 .. 63;
+          FOR GEN_CHECK_INT'SIZE USE SPECIFIED_SIZE;
+     END GENPACK;
+
+     PACKAGE NEWPACK IS NEW GENPACK;
+
+     USE NEWPACK;
+     TYPE DERIVED_PRIVATE_INT IS NEW PRIVATE_INT;
+     FOR DERIVED_PRIVATE_INT'SIZE USE SPECIFIED_SIZE;
+
+     MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
+
+BEGIN
+
+     TEST("CD2A32C", "CHECK THAT A SIZE SPECIFICATION " &
+                     "FOR AN INTEGER TYPE OF THE SMALLEST " &
+                     "APPROPRIATE SIGNED SIZE CAN BE GIVEN: IN THE " &
+                     "VISIBLE OR PRIVATE PART OF A PACKAGE FOR A " &
+                     "TYPE DECLARED IN THE VISIBLE PART; FOR A " &
+                     "DERIVED INTEGER TYPE; FOR A DERIVED PRIVATE " &
+                     "TYPE WHOSE FULL DECLARATION IS AS AN INTEGER " &
+                     "TYPE; FOR AN INTEGER TYPE IN A GENERIC UNIT");
+
+     IF DERIVED_INT'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("DERIVED_INT'SIZE MUST BE EQUAL TO" &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_INT'SIZE));
+     END IF;
+
+     IF INT_IN_P'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("INT_IN_P'SIZE MUST BE EQUAL TO" &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(INT_IN_P'SIZE));
+     END IF;
+
+     IF ALT_INT_IN_P'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("ALT_INT_IN_P'SIZE MUST BE EQUAL TO" &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(ALT_INT_IN_P'SIZE));
+     END IF;
+
+     IF DERIVED_PRIVATE_INT'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("DERIVED_PRIVATE_INT'SIZE MUST BE EQUAL TO " &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_PRIVATE_INT'SIZE));
+     END IF;
+
+     IF GEN_CHECK_INT'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("GEN_CHECK_INT'SIZE MUST BE EQUAL TO" &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(GEN_CHECK_INT'SIZE));
+     END IF;
+
+     RESULT;
+
+END CD2A32C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32e.ada
new file mode 100644
index 000000000..621ea6749
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32e.ada
@@ -0,0 +1,263 @@
+-- CD2A32E.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 SIZE SPECIFICATION IS GIVEN FOR AN
+--     INTEGER TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
+--     WITH THE SMALLEST APPROPRIATE UNSIGNED SIZE ARE NOT
+--     AFFECTED BY THE REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     JET 08/12/87  CREATED ORIGINAL TEST.
+--     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   SIZE CLAUSE VALUE TO 7, AND CHANGED OPERATOR ON
+--                   'SIZE CHECKS.
+--     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE CD2A32E IS
+
+     BASIC_SIZE : CONSTANT := 7;
+
+     TYPE INT IS RANGE 0 .. 126;
+
+     FOR INT'SIZE USE BASIC_SIZE;
+
+     I0 : INT :=   0;
+     I1 : INT :=  63;
+     I2 : INT := 126;
+
+     TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE 0 .. 2) OF INT;
+     INTARRAY : ARRAY_TYPE := (0, 63, 126);
+
+     TYPE REC_TYPE IS RECORD
+          COMP0 : INT :=   0;
+          COMP1 : INT := 63;
+          COMP2 : INT := 126;
+     END RECORD;
+
+     IREC : REC_TYPE;
+
+     FUNCTION IDENT (I : INT) RETURN INT IS
+     BEGIN
+          IF EQUAL (0,0) THEN
+               RETURN I;
+          ELSE
+               RETURN 0;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC (PI0,  PI2  :        INT;
+                     PIO1, PIO2 : IN OUT INT;
+                     PO2        :    OUT INT) IS
+
+     BEGIN
+          IF PI0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+               FAILED ("INCORRECT VALUE FOR PI0'SIZE");
+          END IF;
+
+          IF NOT ((PI0 < IDENT (1))             AND
+                  (IDENT (PI2) > IDENT (PIO1))  AND
+                  (PIO1 <= IDENT (63))         AND
+                  (IDENT (126) = PI2))          THEN
+               FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
+                       "OPERATORS - 1");
+          END IF;
+
+          IF NOT (((PI0 + PI2)   = PIO2)        AND
+                  ((PI2 - PIO1)  = PIO1)        AND
+                  ((PIO1 * IDENT (2)) = PI2)    AND
+                  ((PIO2 / PIO1) = IDENT (2))   AND
+                  ((PIO1 ** 1)   = IDENT (63))  AND
+                  ((PIO2 REM 10)  = IDENT (6))  AND
+                  ((PIO1 MOD 10)  = IDENT (3))) THEN
+               FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
+                       "OPERATORS - 1");
+          END IF;
+
+          IF INT'POS (PI0)  /= IDENT_INT (0)   OR
+             INT'POS (PIO1) /= IDENT_INT (63) OR
+             INT'POS (PI2)  /= IDENT_INT (126) THEN
+               FAILED ("INCORRECT VALUE FOR INT'POS - 1");
+          END IF;
+
+          IF INT'SUCC (PI0)  /= IDENT (1)   OR
+             INT'SUCC (PIO1) /= IDENT (64) THEN
+               FAILED ("INCORRECT VALUE FOR INT'SUCC - 1");
+          END IF;
+
+          IF INT'IMAGE (PI0)  /= IDENT_STR (" 0")   OR
+             INT'IMAGE (PIO1) /= IDENT_STR (" 63") OR
+             INT'IMAGE (PI2)  /= IDENT_STR (" 126") THEN
+               FAILED ("INCORRECT VALUE FOR INT'IMAGE - 1");
+          END IF;
+
+          PO2 := 126;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A32E", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
+                      "GIVEN FOR AN INTEGER TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF SUCH A TYPE WITH " &
+                      "THE SMALLEST APPROPRIATE UNSIGNED SIZE ARE " &
+                      "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
+
+     PROC (0, 126, I1, I2, I2);
+
+     IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR INT'SIZE");
+     END IF;
+
+     IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR I1'SIZE");
+     END IF;
+
+     FOR I IN IDENT (I0) .. IDENT (I2) LOOP
+          IF NOT (I IN I0 .. I2) OR
+             (I NOT IN IDENT(0) .. IDENT(126)) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                       "OPERATORS - 2");
+          END IF;
+     END LOOP;
+
+     IF NOT ((+I2 = I2)     AND
+             (-I1 = -63)   AND
+             (ABS I2 = I2)) THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
+                  "OPERATORS - 2");
+     END IF;
+
+     IF INT'VAL (0)   /= IDENT (I0) OR
+        INT'VAL (63) /= IDENT (I1) OR
+        INT'VAL (126) /= IDENT (I2) THEN
+          FAILED ("INCORRECT VALUE FOR INT'VAL - 2");
+     END IF;
+
+     IF INT'PRED (I1) /= IDENT (62)  OR
+        INT'PRED (I2) /= IDENT (125) THEN
+          FAILED ("INCORRECT VALUE FOR INT'PRED - 2");
+     END IF;
+
+     IF INT'VALUE ("0")   /= IDENT (I0) OR
+        INT'VALUE ("63") /= IDENT (I1) OR
+        INT'VALUE ("126") /= IDENT (I2) THEN
+          FAILED ("INCORRECT VALUE FOR INT'VALUE - 2");
+     END IF;
+
+     IF INTARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR INTARRAY(1)'SIZE");
+     END IF;
+
+     IF NOT ((INTARRAY(0) < IDENT (1))                   AND
+             (IDENT (INTARRAY(2)) > IDENT (INTARRAY(1))) AND
+             (INTARRAY(1) <= IDENT (63))                AND
+             (IDENT (126) = INTARRAY(2)))                THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
+                  "OPERATORS - 3");
+     END IF;
+
+     FOR I IN IDENT (INTARRAY(0)) .. IDENT (INTARRAY(2)) LOOP
+          IF NOT (I IN INTARRAY(0) .. INTARRAY(2)) OR
+             (I NOT IN IDENT(0) .. IDENT(126))     THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                       "OPERATORS - 3");
+          END IF;
+     END LOOP;
+
+     IF NOT (((INTARRAY(0) + INTARRAY(2))  = INTARRAY(2)) AND
+             ((INTARRAY(2) - INTARRAY(1))  = INTARRAY(1)) AND
+             ((INTARRAY(1) * IDENT (2))    = INTARRAY(2)) AND
+             ((INTARRAY(2) / INTARRAY(1))  = IDENT (2))   AND
+             ((INTARRAY(1) ** 1)           = IDENT (63))  AND
+             ((INTARRAY(2) REM 10)         = IDENT (6))   AND
+             ((INTARRAY(1) MOD 10)         = IDENT (3)))  THEN
+          FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
+                  "OPERATORS - 3");
+     END IF;
+
+     IF INT'POS (INTARRAY(0)) /= IDENT_INT (0)   OR
+        INT'POS (INTARRAY(1)) /= IDENT_INT (63) OR
+        INT'POS (INTARRAY(2)) /= IDENT_INT (126) THEN
+          FAILED ("INCORRECT VALUE FOR INT'POS - 3");
+     END IF;
+
+     IF INT'SUCC (INTARRAY(0)) /= IDENT (1)   OR
+        INT'SUCC (INTARRAY(1)) /= IDENT (64) THEN
+          FAILED ("INCORRECT VALUE FOR INT'SUCC - 3");
+     END IF;
+
+     IF INT'IMAGE (INTARRAY(0)) /= IDENT_STR (" 0")   OR
+        INT'IMAGE (INTARRAY(1)) /= IDENT_STR (" 63") OR
+        INT'IMAGE (INTARRAY(2)) /= IDENT_STR (" 126") THEN
+          FAILED ("INCORRECT VALUE FOR INT'IMAGE - 3");
+     END IF;
+
+     IF IREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR IREC.COMP2'SIZE");
+     END IF;
+
+     IF NOT ((IREC.COMP0 < IDENT (1))                  AND
+             (IDENT (IREC.COMP2) > IDENT (IREC.COMP1)) AND
+             (IREC.COMP1 <= IDENT (63))               AND
+             (IDENT (126) = IREC.COMP2))               THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
+                  "OPERATORS - 4");
+     END IF;
+
+     FOR I IN IDENT (IREC.COMP0) .. IDENT (IREC.COMP2) LOOP
+          IF NOT (I IN IREC.COMP0 .. IREC.COMP2) OR
+             (I NOT IN IDENT(0) .. IDENT(126))   THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                       "OPERATORS - 4");
+          END IF;
+     END LOOP;
+
+     IF NOT ((+IREC.COMP2 = IREC.COMP2)     AND
+             (-IREC.COMP1 = -63)           AND
+             (ABS IREC.COMP2 = IREC.COMP2)) THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
+                  "OPERATORS - 4");
+     END IF;
+
+     IF INT'VAL (0)   /= IDENT (IREC.COMP0) OR
+        INT'VAL (63) /= IDENT (IREC.COMP1) OR
+        INT'VAL (126) /= IDENT (IREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR INT'VAL - 4");
+     END IF;
+
+     IF INT'PRED (IREC.COMP1) /= IDENT (62)  OR
+        INT'PRED (IREC.COMP2) /= IDENT (125) THEN
+          FAILED ("INCORRECT VALUE FOR INT'PRED - 4");
+     END IF;
+
+     IF INT'VALUE ("0")   /= IDENT (IREC.COMP0) OR
+        INT'VALUE ("63") /= IDENT (IREC.COMP1) OR
+        INT'VALUE ("126") /= IDENT (IREC.COMP2) THEN
+          FAILED ("INCORRECT VALUE FOR INT'VALUE - 4");
+     END IF;
+
+     RESULT;
+
+END CD2A32E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32g.ada
new file mode 100644
index 000000000..c9d84665c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32g.ada
@@ -0,0 +1,131 @@
+-- CD2A32G.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 SIZE SPECIFICATION FOR AN INTEGER
+--     TYPE OF THE SMALLEST APPROPRIATE UNSIGNED SIZE CAN BE GIVEN:
+--        IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
+--          DECLARED IN THE VISIBLE PART;
+--        FOR A DERIVED INTEGER TYPE;
+--        FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
+--          AN INTEGER TYPE;
+--        FOR AN INTEGER TYPE GIVEN IN A GENERIC UNIT.
+
+-- HISTORY:
+--     JET 08/12/87  CREATED ORIGINAL TEST.
+--     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   SIZE CLAUSE VALUE TO 7, CHANGED OPERATOR ON 'SIZE
+--                   CHECKS, AND ADDED CHECK FOR 'SIZE IN A GENERIC
+--                   UNIT.
+--     JRL 03/27/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A32G IS
+
+     TYPE BASIC_INT IS RANGE 0 .. 126;
+     SPECIFIED_SIZE : CONSTANT := 7;
+
+     TYPE DERIVED_INT IS NEW BASIC_INT;
+     FOR DERIVED_INT'SIZE USE SPECIFIED_SIZE;
+
+     PACKAGE P IS
+          TYPE INT_IN_P IS RANGE 0 .. 126;
+          FOR INT_IN_P'SIZE USE SPECIFIED_SIZE;
+          TYPE PRIVATE_INT IS PRIVATE;
+          TYPE ALT_INT_IN_P IS RANGE 0 .. 126;
+     PRIVATE
+          TYPE PRIVATE_INT IS RANGE 0 .. 126;
+          FOR ALT_INT_IN_P'SIZE USE SPECIFIED_SIZE;
+     END P;
+
+     USE P;
+
+     TYPE DERIVED_PRIVATE_INT IS NEW PRIVATE_INT;
+     FOR DERIVED_PRIVATE_INT'SIZE USE SPECIFIED_SIZE;
+
+     MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
+
+     GENERIC
+     PROCEDURE GENPROC;
+
+     PROCEDURE GENPROC IS
+          TYPE GEN_CHECK_INT IS RANGE 0 .. 126;
+          FOR GEN_CHECK_INT'SIZE USE SPECIFIED_SIZE;
+
+     BEGIN
+
+          IF GEN_CHECK_INT'SIZE /= MINIMUM_SIZE THEN
+               FAILED ("GEN_CHECK_INT'SIZE SHOULD NOT BE GREATER " &
+                       "THAN" & INTEGER'IMAGE(MINIMUM_SIZE) &
+                       ".  ACTUAL SIZE IS" &
+                       INTEGER'IMAGE(GEN_CHECK_INT'SIZE));
+          END IF;
+     END GENPROC;
+
+     PROCEDURE NEWPROC IS NEW GENPROC;
+
+BEGIN
+
+     TEST("CD2A32G", "CHECK THAT SIZE SPECIFICATIONS OF THE SMALLEST " &
+                     "APPROPRIATE UNSIGNED SIZE CAN BE GIVEN " &
+                     "IN THE VISIBLE OR PRIVATE PART OF PACKAGE FOR " &
+                     "AN INTEGER TYPE DECLARED IN VISIBLE PART, " &
+                     "FOR DERIVED INTEGER " &
+                     "TYPES AND DERIVED PRIVATE TYPES WHOSE FULL " &
+                     "DECLARATION IS AS AN INTEGER TYPE AND FOR AN " &
+                     "INTEGER TYPE GIVEN IN A GENERIC UNIT");
+
+     IF DERIVED_INT'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("DERIVED_INT'SIZE SHOULD NOT BE GREATER THAN" &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_INT'SIZE));
+     END IF;
+
+     IF INT_IN_P'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("INT_IN_P'SIZE SHOULD NOT BE GREATER THAN" &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(INT_IN_P'SIZE));
+     END IF;
+
+     IF ALT_INT_IN_P'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("ALT_INT_IN_P'SIZE SHOULD NOT BE GREATER THAN" &
+                  INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(ALT_INT_IN_P'SIZE));
+     END IF;
+
+     IF DERIVED_PRIVATE_INT'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("DERIVED_PRIVATE_INT'SIZE SHOULD NOT BE GREATER " &
+                  "THAN" & INTEGER'IMAGE(MINIMUM_SIZE) &
+                  ".  ACTUAL SIZE IS" &
+                  INTEGER'IMAGE(DERIVED_PRIVATE_INT'SIZE));
+     END IF;
+
+     NEWPROC;
+
+     RESULT;
+
+END CD2A32G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32i.ada
new file mode 100644
index 000000000..d3439a71e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32i.ada
@@ -0,0 +1,135 @@
+-- CD2A32I.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 SIZE SPECIFICATION OF THE SMALLEST APPROPRIATE
+--     SIGNED SIZE IS GIVEN FOR AN INTEGER TYPE, THE TYPE CAN
+--     BE PASSED AS AN ACTUAL PARAMETER TO GENERIC PROCEDURES.
+
+-- HISTORY:
+--     JET 08/12/87  CREATED ORIGINAL TEST.
+--     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   SIZE CLAUSE VALUE TO 7, AND CHANGED OPERATOR ON
+--                   'SIZE CHECKS.
+--     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT;  USE REPORT;
+PROCEDURE CD2A32I IS
+
+     TYPE BASIC_INT IS RANGE -63 .. 63;
+     BASIC_SIZE : CONSTANT := 7;
+
+     FOR BASIC_INT'SIZE USE BASIC_SIZE;
+
+BEGIN
+
+     TEST ("CD2A32I", "CHECK THAT WHEN A SIZE SPECIFICATION " &
+                      "OF THE SMALLEST APPROPRIATE SIGNED SIZE " &
+                      "IS GIVEN FOR AN INTEGER TYPE, " &
+                      "THE TYPE " &
+                      "CAN BE PASSED AS AN ACTUAL PARAMETER TO " &
+                      "GENERIC PROCEDURES");
+
+     DECLARE -- TYPE DECLARATION WITHIN GENERIC PROCEDURE.
+
+          GENERIC
+               TYPE GPARM IS RANGE <>;
+          PROCEDURE GENPROC;
+
+          PROCEDURE GENPROC IS
+
+          SUBTYPE INT IS GPARM;
+
+          I1 : INT := -63;
+          I2 : INT :=    0;
+          I3 : INT :=  63;
+
+          FUNCTION IDENT (I : INT) RETURN INT IS
+          BEGIN
+               IF EQUAL (0,0) THEN
+                    RETURN I;
+               ELSE
+                    RETURN 0;
+               END IF;
+          END IDENT;
+
+          BEGIN -- GENPROC.
+
+               IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR INT'SIZE");
+               END IF;
+
+               IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR I1'SIZE");
+               END IF;
+
+               FOR I IN IDENT (I1) .. IDENT (I3) LOOP
+                    IF NOT (I IN I1 .. I3) OR
+                       (I NOT IN IDENT(-63) .. IDENT(63)) THEN
+                         FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                                 "OPERATORS");
+                    END IF;
+               END LOOP;
+
+               IF NOT ((+I1 = I1)     AND
+                       (-I3 = I1)     AND
+                       (ABS I1 = I3)) THEN
+                    FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
+                            "OPERATORS");
+               END IF;
+
+               IF INT'LAST /= IDENT (63) THEN
+                    FAILED ("INCORRECT VALUE FOR INT'LAST");
+               END IF;
+
+               IF INT'VAL (-63) /= IDENT (I1) OR
+                  INT'VAL (0)    /= IDENT (I2) OR
+                  INT'VAL (63)  /= IDENT (I3) THEN
+                    FAILED ("INCORRECT VALUE FOR INT'VAL");
+               END IF;
+
+               IF INT'PRED (I2) /= IDENT (-1) OR
+                  INT'PRED (I3) /= IDENT (62) THEN
+                    FAILED ("INCORRECT VALUE FOR INT'PRED");
+               END IF;
+
+               IF INT'VALUE ("-63") /= IDENT (I1) OR
+                  INT'VALUE (" 0")   /= IDENT (I2) OR
+                  INT'VALUE (" 63") /= IDENT (I3) THEN
+                         FAILED ("INCORRECT VALUE FOR INT'VALUE");
+               END IF;
+
+          END GENPROC;
+
+          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_INT);
+
+     BEGIN
+
+          NEWPROC;
+
+     END;
+
+     RESULT;
+
+END CD2A32I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32j.ada
new file mode 100644
index 000000000..e8969b3cb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a32j.ada
@@ -0,0 +1,135 @@
+-- CD2A32J.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 SIZE SPECIFICATION OF THE SMALLEST APPROPRIATE
+--     UNSIGNED SIZE IS GIVEN FOR AN INTEGER TYPE, THE TYPE CAN BE
+--     PASSED AS AN ACTUAL PARAMETER TO GENERIC PROCEDURES.
+
+-- HISTORY:
+--     JET 08/12/87  CREATED ORIGINAL TEST.
+--     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   SIZE CLAUSE VALUE TO 7, AND CHANGED OPERATOR ON
+--                   'SIZE CHECKS.
+--     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
+
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD2A32J IS
+
+     TYPE BASIC_INT IS RANGE 0 .. 126;
+     BASIC_SIZE : CONSTANT := 7;
+
+     FOR BASIC_INT'SIZE USE BASIC_SIZE;
+
+BEGIN
+
+     TEST ("CD2A32J", "CHECK THAT WHEN A SIZE SPECIFICATION " &
+                      "OF THE SMALLEST APPROPRIATE UNSIGNED SIZE " &
+                      "IS GIVEN FOR AN INTEGER TYPE, THE TYPE " &
+                      "CAN BE PASSED AS AN ACTUAL PARAMETER TO " &
+                      "GENERIC PROCEDURES");
+
+     DECLARE -- TYPE DECLARATION WITHIN GENERIC PROCEDURE.
+
+          GENERIC
+               TYPE GPARM IS RANGE <>;
+          PROCEDURE GENPROC;
+
+          PROCEDURE GENPROC IS
+
+          SUBTYPE INT IS GPARM;
+
+          I0 : INT :=   0;
+          I1 : INT :=  63;
+          I2 : INT := 126;
+
+          FUNCTION IDENT (I : INT) RETURN INT IS
+          BEGIN
+               IF EQUAL (0,0) THEN
+                    RETURN I;
+               ELSE
+                    RETURN 0;
+               END IF;
+          END IDENT;
+
+          BEGIN -- GENPROC.
+
+               IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR INT'SIZE");
+               END IF;
+
+               IF I0'SIZE < IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR I0'SIZE");
+               END IF;
+
+               IF NOT ((I0 < IDENT (1))          AND
+                       (IDENT (I2) > IDENT (I1)) AND
+                       (I1 <= IDENT (63))       AND
+                       (IDENT (126) = I2))       THEN
+                    FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
+                            "OPERATORS");
+               END IF;
+
+               IF NOT (((I0 + I2)  = I2)          AND
+                       ((I2 - I1)  = I1)          AND
+                       ((I1 * IDENT (2)) = I2)    AND
+                       ((I2 / I1)  = IDENT (2))   AND
+                       ((I1 ** 1)  = IDENT (63)) AND
+                       ((I2 REM 10) = IDENT (6))   AND
+                       ((I1 MOD 10) = IDENT (3)))  THEN
+                    FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
+                            "OPERATORS");
+               END IF;
+
+               IF INT'POS (I0) /= IDENT_INT (0)   OR
+                  INT'POS (I1) /= IDENT_INT (63) OR
+                  INT'POS (I2) /= IDENT_INT (126) THEN
+                    FAILED ("INCORRECT VALUE FOR INT'POS");
+               END IF;
+
+               IF INT'SUCC (I0) /= IDENT (1)   OR
+                  INT'SUCC (I1) /= IDENT (64)  THEN
+                    FAILED ("INCORRECT VALUE FOR INT'SUCC");
+               END IF;
+
+               IF INT'IMAGE (I0) /= IDENT_STR (" 0")   OR
+                  INT'IMAGE (I1) /= IDENT_STR (" 63") OR
+                  INT'IMAGE (I2) /= IDENT_STR (" 126") THEN
+                    FAILED ("INCORRECT VALUE FOR INT'IMAGE");
+               END IF;
+
+          END GENPROC;
+
+          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_INT);
+
+     BEGIN
+
+          NEWPROC;
+
+     END;
+
+     RESULT;
+
+END CD2A32J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a51a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a51a.ada
new file mode 100644
index 000000000..f1ce2886b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a51a.ada
@@ -0,0 +1,193 @@
+-- CD2A51A.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 SIZE SPECIFICATION IS GIVEN FOR A
+--     FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
+--     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 08/12/87  CREATED ORIGINAL TEST.
+--     DHH 04/12/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   OPERATORS ON 'SIZE TESTS, AND CHANGED 'SIZE CLAUSE
+--                   SO THAT IT IS NOT A POWER OF TWO.
+--     WMC 03/31/92  ELIMINATED TEST REDUNDANCIES.
+--     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A51A IS
+
+     BASIC_SIZE : CONSTANT := 9;
+
+     TYPE BASIC_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
+
+     TYPE CHECK_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
+
+     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
+
+     CNEG1 : CHECK_TYPE := -3.5;
+     CNEG2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
+     CPOS1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
+     CPOS2 : CHECK_TYPE :=  3.5;
+     CZERO : CHECK_TYPE;
+
+     TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF CHECK_TYPE;
+     CHARRAY : ARRAY_TYPE :=
+          (-3.5, CHECK_TYPE (-1.0/3.0), CHECK_TYPE (4.0/6.0), 3.5);
+
+     TYPE REC_TYPE IS RECORD
+          COMPN1 : CHECK_TYPE := -3.5;
+          COMPN2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
+          COMPP1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
+          COMPP2 : CHECK_TYPE :=  3.5;
+     END RECORD;
+
+     CHREC : REC_TYPE;
+
+     FUNCTION IDENT (FX : CHECK_TYPE) RETURN CHECK_TYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN FX;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC (N1_IN, P1_IN      :        CHECK_TYPE;
+                     N2_INOUT,P2_INOUT : IN OUT CHECK_TYPE;
+                     CZOUT             :    OUT CHECK_TYPE) IS
+     BEGIN
+
+          IF +IDENT (N2_INOUT) NOT IN -0.375 .. -0.3125 OR
+             IDENT (-P1_IN) NOT IN -0.6875 .. -0.625 THEN
+               FAILED ("INCORRECT RESULTS FOR " &
+                       "UNARY ADDING OPERATORS - 1");
+          END IF;
+
+          IF ABS IDENT (N2_INOUT) NOT IN 0.3125 .. 0.375 OR
+             IDENT (ABS P1_IN) NOT IN 0.625 .. 0.6875 THEN
+               FAILED ("INCORRECT RESULTS FOR " &
+                       "ABSOLUTE VALUE OPERATORS - 1");
+          END IF;
+
+          CZOUT := 0.0;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A51A", "CHECK THAT WHEN A SIZE SPECICFICATION IS " &
+                      "GIVEN FOR A FIXED POINT TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
+                      "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
+
+     PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
+
+     IF IDENT (CZERO) /= 0.0 THEN
+          FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
+     END IF;
+
+     IF CHECK_TYPE'LAST < IDENT (3.9375) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
+     END IF;
+
+     IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+     END IF;
+
+     IF CHECK_TYPE'AFT /= BASIC_TYPE'AFT THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'AFT");
+     END IF;
+
+     IF CNEG1'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CNEG1'SIZE");
+     END IF;
+
+     IF IDENT (CNEG1) + CPOS1 NOT IN -2.875 .. -2.8125 OR
+        CPOS2  - IDENT (CPOS1) NOT IN 2.8125 .. 2.875 THEN
+          FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 2");
+     END IF;
+
+     IF CHECK_TYPE (CNEG1 * IDENT (CPOS1)) NOT IN -2.4375 .. -2.1875 OR
+        CHECK_TYPE (IDENT (CNEG2) / CPOS2) NOT IN
+               -0.125 .. -0.0625 THEN
+          FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 2");
+     END IF;
+
+     IF IDENT (CPOS1) NOT IN 0.625 .. 0.6875 OR
+            CNEG2 IN -0.25 .. 0.0 OR
+            IDENT (CNEG2) IN -1.0 .. -0.4375 THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                  "OPERATORS - 2");
+     END IF;
+
+     IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
+     END IF;
+
+     IF +IDENT (CHARRAY (1)) NOT IN -0.375 .. -0.3125 OR
+        IDENT (-CHARRAY (2)) NOT IN -0.6875 .. -0.625 THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 3");
+     END IF;
+
+     IF ABS IDENT (CHARRAY (1)) NOT IN 0.3125 .. 0.375 OR
+        IDENT (ABS CHARRAY (2)) NOT IN 0.625 .. 0.6875 THEN
+          FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
+                  "OPERATORS - 3");
+     END IF;
+
+     IF IDENT (CHARRAY (2)) NOT IN 0.625 .. 0.6875 OR
+            CHARRAY (1) IN -0.25 .. 0.0 OR
+            IDENT (CHARRAY (1)) IN -1.0 .. -0.4375 THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                  "OPERATORS - 3");
+     END IF;
+
+     IF CHREC.COMPP1'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHREC.COMPP1'SIZE");
+     END IF;
+
+     IF IDENT (CHREC.COMPN1) + CHREC.COMPP1 NOT IN
+             -2.875 .. -2.8125 OR
+        CHREC.COMPP2  - IDENT (CHREC.COMPP1) NOT IN
+             2.8125 .. 2.875 THEN
+          FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 4");
+     END IF;
+
+     IF CHECK_TYPE (CHREC.COMPN1 * IDENT (CHREC.COMPP1)) NOT IN
+          -2.4375 .. -2.1875 OR
+        CHECK_TYPE (IDENT (CHREC.COMPN2) / CHREC.COMPP2) NOT IN
+          -0.125 .. -0.0625 THEN
+          FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 4");
+     END IF;
+
+     IF IDENT (CHREC.COMPP1) NOT IN 0.625 .. 0.6875 OR
+            CHREC.COMPN2 IN -0.25 .. 0.0 OR
+            IDENT (CHREC.COMPN2) IN -1.0 .. -0.4375 THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                  "OPERATORS - 4");
+     END IF;
+
+     RESULT;
+
+END CD2A51A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a53a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a53a.ada
new file mode 100644
index 000000000..15613b5d7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a53a.ada
@@ -0,0 +1,217 @@
+-- CD2A53A.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 SIZE AND SMALL SPECIFICATIONS ARE GIVEN FOR A
+--     FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE ARE
+--     NOT AFFECTED BY THE REPRESENTATION CLAUSE.
+
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C)
+--          and which support decimal small values:
+--          The test must compile, bind, execute, report PASSED, and
+--          complete normally.
+--
+--      For other implementations:
+--          This test may produce at least one error message at compilation,
+--          and the error message is associated with one of the items marked:
+--             -- N/A => ERROR.
+--          The test will be recorded as Not_Applicable.
+--          Otherwise, the test must execute and report PASSED.
+--
+--      All other behaviors are FAILING.
+--
+-- HISTORY:
+--     BCB 08/24/87  CREATED ORIGINAL TEST.
+--     DHH 04/12/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
+--                   OPERATORS ON 'SIZE TESTS, AND CHANGED 'SIZE CLAUSE
+--                   SO THAT IT IS NOT A POWER OF TWO.
+--     WMC 04/01/92  ELIMINATED TEST REDUNDANCIES.
+--     RLB 11/24/98  Added Ada 95 applicability criteria.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A53A IS
+     BASIC_SIZE : CONSTANT := 15;
+     BASIC_SMALL : CONSTANT := 0.01;
+
+     ZERO  : CONSTANT :=  0.0;
+
+     TYPE CHECK_TYPE IS DELTA 1.0 RANGE -4.0 .. 4.0;
+
+     FOR CHECK_TYPE'SMALL USE BASIC_SMALL;   -- N/A => ERROR.
+     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;     -- N/A => ERROR.
+
+     CNEG1 : CHECK_TYPE := -2.7;
+     CNEG2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
+     CPOS1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
+     CPOS2 : CHECK_TYPE :=  2.7;
+     CZERO : CHECK_TYPE;
+
+     TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF CHECK_TYPE;
+     CHARRAY : ARRAY_TYPE :=
+          (-2.7, CHECK_TYPE (-1.0/3.0), CHECK_TYPE (4.0/6.0), 2.7);
+
+     TYPE REC_TYPE IS RECORD
+          COMPF : CHECK_TYPE := -2.7;
+          COMPN : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
+          COMPP : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
+          COMPL : CHECK_TYPE :=  2.7;
+     END RECORD;
+
+     CHREC : REC_TYPE;
+
+     FUNCTION IDENT (FX : CHECK_TYPE) RETURN CHECK_TYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN FX;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC (CN1IN, CP1IN      :        CHECK_TYPE;
+                     CN2INOUT,CP2INOUT : IN OUT CHECK_TYPE;
+                     CZOUT             :    OUT CHECK_TYPE) IS
+     BEGIN
+
+          IF IDENT (CN1IN) + CP1IN NOT IN -2.04 .. -2.03 OR
+             CP2INOUT  - IDENT (CP1IN) NOT IN 2.03 .. 2.04 THEN
+               FAILED ("INCORRECT RESULTS FOR " &
+                       "BINARY ADDING OPERATORS - 1");
+          END IF;
+
+          IF CHECK_TYPE (CN1IN * IDENT (CP1IN)) NOT IN
+             -1.81 .. -1.78 OR
+             CHECK_TYPE (IDENT (CN2INOUT) / CP2INOUT) NOT IN
+             -0.13 .. -0.12 THEN
+               FAILED ("INCORRECT RESULTS FOR " &
+                       "MULTIPLYING OPERATORS - 1");
+          END IF;
+
+          IF IDENT (CP1IN) NOT IN 0.66 .. 0.670 OR
+                 CN2INOUT IN -0.32 .. 0.0 OR
+                 IDENT (CN2INOUT) IN -1.0 .. -0.35 THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                       "OPERATORS - 1");
+          END IF;
+
+          CZOUT := 0.0;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2A53A", "CHECK THAT WHEN SIZE AND SMALL SPECIFICATIONS " &
+                      "ARE GIVEN FOR A FIXED POINT TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF SUCH A TYPE ARE NOT " &
+                      "AFFECTED BY THE REPRESENTATION CLAUSE");
+
+     PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
+
+     IF CNEG1'SIZE < IDENT_INT(BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CNEG1'SIZE");
+     END IF;
+
+     IF IDENT (CZERO) /= ZERO THEN
+          FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
+     END IF;
+
+     IF CHECK_TYPE'FIRST > IDENT (-3.99) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST");
+     END IF;
+
+     IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
+     END IF;
+
+     IF CHECK_TYPE'SMALL /= BASIC_SMALL THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SMALL");
+     END IF;
+
+     IF CHECK_TYPE'FORE /= 2 THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FORE");
+     END IF;
+
+     IF +IDENT (CNEG2) NOT IN -0.34 .. -0.33 OR
+        IDENT (-CPOS1) NOT IN -0.67 .. -0.66 THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 2");
+     END IF;
+
+     IF ABS IDENT (CNEG2) NOT IN 0.33 .. 0.34 OR
+        IDENT (ABS CPOS1) NOT IN 0.66 .. 0.670 THEN
+          FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
+                  "OPERATORS - 2");
+     END IF;
+
+     IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
+     END IF;
+
+     IF IDENT (CHARRAY (0)) + CHARRAY (2) NOT IN
+             -2.04 .. -2.03 OR
+        CHARRAY (3)  - IDENT (CHARRAY (2)) NOT IN
+             2.03 .. 2.04 THEN
+          FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 3");
+     END IF;
+
+     IF CHECK_TYPE (CHARRAY (0) * IDENT (CHARRAY (2))) NOT IN
+          -1.81 .. -1.78 OR
+        CHECK_TYPE (IDENT (CHARRAY (1)) / CHARRAY (3)) NOT IN
+          -0.13 .. -0.12 THEN
+          FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 3");
+     END IF;
+
+     IF IDENT (CHARRAY (2)) NOT IN 0.66 .. 0.670 OR
+            CHARRAY (1) IN -0.32 .. 0.0 OR
+            IDENT (CHARRAY (1)) IN -1.0 .. -0.35 THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                  "OPERATORS - 3");
+     END IF;
+
+     IF CHREC.COMPP'SIZE < IDENT_INT (BASIC_SIZE) THEN
+          FAILED ("INCORRECT VALUE FOR CHREC.COMPP'SIZE");
+     END IF;
+
+     IF +IDENT (CHREC.COMPN) NOT IN -0.34 .. -0.33 OR
+        IDENT (-CHREC.COMPP) NOT IN -0.67 .. -0.66 THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 4");
+     END IF;
+
+     IF ABS IDENT (CHREC.COMPN) NOT IN 0.33 .. 0.34 OR
+        IDENT (ABS CHREC.COMPP) NOT IN 0.66 .. 0.670 THEN
+          FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
+                  "OPERATORS - 4");
+     END IF;
+
+     IF IDENT (CHREC.COMPP) NOT IN 0.66 .. 0.670 OR
+            CHREC.COMPN IN -0.32 .. 0.0 OR
+            IDENT (CHREC.COMPN) IN -1.0 .. -0.35 THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                  "OPERATORS - 4");
+     END IF;
+
+     RESULT;
+
+END CD2A53A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a53e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a53e.ada
new file mode 100644
index 000000000..a023967de
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a53e.ada
@@ -0,0 +1,235 @@
+-- CD2A53E.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 SIZE AND SMALL SPECIFICATIONS ARE GIVEN FOR A
+--     FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
+--     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE WHEN THE TYPE
+--     IS PASSED AS A GENERIC ACTUAL PARAMETER.
+
+-- HISTORY:
+--     BCB 08/24/87  CREATED ORIGINAL TEST.
+--     DHH 04/12/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND CHANGED
+--                   OPERATORS ON 'SIZE TESTS.
+--     WMC 04/01/92  ELIMINATED TEST REDUNDANCIES.
+--     MRM 07/16/92  FIX ALIGNMENT OF BLOCK BODY
+--     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A53E IS
+
+     BASIC_SIZE : CONSTANT := INTEGER'SIZE/2;
+     BASIC_SMALL : CONSTANT := 2.0 ** (-4);
+     B : BOOLEAN;
+
+     TYPE CHECK_TYPE IS DELTA 1.0 RANGE -4.0 .. 4.0;
+     FOR CHECK_TYPE'SMALL USE BASIC_SMALL;
+     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
+
+BEGIN
+
+     TEST ("CD2A53E", "CHECK THAT WHEN SIZE AND SMALL SPECIFICATIONS " &
+                      "ARE GIVEN FOR A FIXED POINT TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF SUCH A TYPE ARE NOT " &
+                      "AFFECTED BY THE REPRESENTATION CLAUSE WHEN " &
+                      "THE TYPE IS PASSED AS A GENERIC ACTUAL " &
+                      "PARAMETER");
+
+     DECLARE
+
+          GENERIC
+
+               TYPE FIXED_ELEMENT IS DELTA <>;
+
+          FUNCTION FUNC RETURN BOOLEAN;
+
+          FUNCTION FUNC RETURN BOOLEAN IS
+
+               ZERO  : CONSTANT :=  0.0;
+
+               TYPE BASIC_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
+
+               CNEG1 : FIXED_ELEMENT := -3.5;
+               CNEG2 : FIXED_ELEMENT := FIXED_ELEMENT (-1.0/3.0);
+               CPOS1 : FIXED_ELEMENT := FIXED_ELEMENT (4.0/6.0);
+               CPOS2 : FIXED_ELEMENT :=  3.5;
+               CZERO : FIXED_ELEMENT;
+
+               TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF FIXED_ELEMENT;
+               CHARRAY : ARRAY_TYPE :=
+                   (-3.5, FIXED_ELEMENT (-1.0/3.0), FIXED_ELEMENT
+                    (4.0/6.0), 3.5);
+
+               TYPE REC_TYPE IS RECORD
+                    COMPF : FIXED_ELEMENT := -3.5;
+                    COMPN : FIXED_ELEMENT := FIXED_ELEMENT (-1.0/3.0);
+                    COMPP : FIXED_ELEMENT := FIXED_ELEMENT (4.0/6.0);
+                    COMPL : FIXED_ELEMENT :=  3.5;
+               END RECORD;
+
+               CHREC : REC_TYPE;
+
+               FUNCTION IDENT (FX : FIXED_ELEMENT) RETURN
+                    FIXED_ELEMENT IS
+               BEGIN
+                    IF EQUAL (3, 3) THEN
+                         RETURN FX;
+                    ELSE
+                         RETURN 0.0;
+                    END IF;
+               END IDENT;
+
+               PROCEDURE PROC (CN1IN, CP1IN      :        FIXED_ELEMENT;
+                               CN2INOUT,CP2INOUT : IN OUT FIXED_ELEMENT;
+                               CZOUT             :    OUT FIXED_ELEMENT)
+                               IS
+               BEGIN
+
+                    IF +IDENT (CN2INOUT) NOT IN -0.375 .. -0.3125 OR
+                        IDENT (-CP1IN) NOT IN -0.6875 .. -0.625 THEN
+                        FAILED ("INCORRECT RESULTS FOR " &
+                                "UNARY ADDING OPERATORS - 1");
+                    END IF;
+
+                    IF ABS IDENT (CN2INOUT) NOT IN 0.3125 .. 0.375 OR
+                         IDENT (ABS CP1IN) NOT IN 0.625 .. 0.6875 THEN
+                         FAILED ("INCORRECT RESULTS FOR " &
+                                 "ABSOLUTE VALUE OPERATORS - 1");
+                    END IF;
+
+                    CZOUT := 0.0;
+
+               END PROC;
+
+          BEGIN -- FUNC
+
+               PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
+
+               IF IDENT (CZERO) /= ZERO THEN
+                    FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
+               END IF;
+
+               IF FIXED_ELEMENT'LAST < IDENT (3.9375) THEN
+                    FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'LAST");
+               END IF;
+
+               IF FIXED_ELEMENT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'SIZE");
+               END IF;
+
+               IF FIXED_ELEMENT'SMALL /= BASIC_SMALL THEN
+                    FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'SMALL");
+               END IF;
+
+               IF FIXED_ELEMENT'AFT /= 1 THEN
+                    FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'AFT");
+               END IF;
+
+               IF CNEG1'SIZE < IDENT_INT(BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR CNEG1'SIZE");
+               END IF;
+
+               IF IDENT (CNEG1) + CPOS1 NOT IN -2.875 .. -2.8125 OR
+                   CPOS2  - IDENT (CPOS1) NOT IN 2.8125 .. 2.875 THEN
+                    FAILED ("INCORRECT RESULTS FOR BINARY ADDING " &
+                            "OPERATORS - 2");
+               END IF;
+
+               IF FIXED_ELEMENT (CNEG1 * IDENT (CPOS1)) NOT IN
+                    -2.4375 .. -2.1875 OR
+                  FIXED_ELEMENT (IDENT (CNEG2) / CPOS2) NOT IN
+                    -0.125 .. -0.0625 THEN
+                    FAILED ("INCORRECT RESULTS FOR MULTIPLYING " &
+                            "OPERATORS - 2");
+               END IF;
+
+               IF IDENT (CPOS1) NOT IN 0.625 .. 0.6875 OR
+                      CNEG2 IN -0.25 .. 0.0 OR
+                      IDENT (CNEG2) IN -1.0 .. -0.4375 THEN
+                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                            "OPERATORS - 2");
+               END IF;
+
+               IF CHARRAY(1)'SIZE < IDENT_INT(BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
+               END IF;
+
+               IF +IDENT (CHARRAY (1)) NOT IN -0.375 .. -0.3125 OR
+                    IDENT (-CHARRAY (2)) NOT IN -0.6875 .. -0.625 THEN
+                    FAILED ("INCORRECT RESULTS FOR UNARY ADDING " &
+                            "OPERATORS - 3");
+               END IF;
+
+               IF ABS IDENT (CHARRAY (1)) NOT IN 0.3125 .. 0.375 OR
+                  IDENT (ABS CHARRAY (2)) NOT IN 0.625 .. 0.6875 THEN
+                    FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
+                            "OPERATORS - 3");
+               END IF;
+
+               IF IDENT (CHARRAY (2)) NOT IN 0.625 .. 0.6875 OR
+                      CHARRAY (1) IN -0.25 .. 0.0 OR
+                      IDENT (CHARRAY (1)) IN -1.0 .. -0.4375 THEN
+                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                            "OPERATORS - 3");
+               END IF;
+
+               IF CHREC.COMPP'SIZE < IDENT_INT(BASIC_SIZE) THEN
+                    FAILED ("INCORRECT VALUE FOR CHREC.COMPP'SIZE");
+               END IF;
+
+               IF IDENT (CHREC.COMPF) + CHREC.COMPP NOT IN
+                     -2.875 .. -2.8125 OR
+                    CHREC.COMPL  - IDENT (CHREC.COMPP) NOT IN
+                     2.8125 .. 2.875 THEN
+                    FAILED ("INCORRECT RESULTS FOR BINARY ADDING " &
+                               "OPERATORS - 4");
+               END IF;
+
+               IF FIXED_ELEMENT (CHREC.COMPF * IDENT (CHREC.COMPP))
+                    NOT IN -2.4375 .. -2.1875 OR
+                  FIXED_ELEMENT (IDENT (CHREC.COMPN) / CHREC.COMPL)
+                    NOT IN -0.125 .. -0.0625 THEN
+                    FAILED ("INCORRECT RESULTS FOR MULTIPLYING " &
+                            "OPERATORS - 4");
+               END IF;
+
+               IF IDENT (CHREC.COMPP) NOT IN 0.625 .. 0.6875 OR
+                      CHREC.COMPN IN -0.25 .. 0.0 OR
+                      IDENT (CHREC.COMPN) IN -1.0 .. -0.4375 THEN
+                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
+                            "OPERATORS - 4");
+               END IF;
+
+               RETURN TRUE;
+
+          END FUNC;
+
+          FUNCTION NEWFUNC IS NEW FUNC(CHECK_TYPE);
+     BEGIN
+          B := NEWFUNC;
+     END;
+
+     RESULT;
+
+END CD2A53E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a83c.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a83c.tst
new file mode 100644
index 000000000..26413daac
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a83c.tst
@@ -0,0 +1,101 @@
+-- CD2A83C.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 SIZE AND COLLECTION SIZE SPECIFICATIONS
+--     FOR AN ACCESS TYPE CAN BE GIVEN IN THE VISIBLE OR
+--     PRIVATE PART OF A PACKAGE FOR A TYPE DECLARED IN
+--     THE VISIBLE PART.
+
+-- HISTORY:
+--     JET 09/01/87  CREATED ORIGINAL TEST.
+--     DHH 04/11/89  CHANGED OPERATOR ON 'SIZE CHECKS AND REMOVED
+--                   APPLICABILITY CRITERIA.
+
+--     $ACC_SIZE IS THE SIZE IN BITS FOR AN ACCESS VARIABLE WHOSE
+--     DESIGNATED TYPE IS A STRING TYPE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A83C IS
+
+     SPECIFIED_SIZE : CONSTANT := $ACC_SIZE;
+     COLL_SIZE : CONSTANT := 256;
+
+     TYPE CHECK_ACC IS ACCESS STRING;
+
+     FOR CHECK_ACC'STORAGE_SIZE USE COLL_SIZE;
+
+     FOR CHECK_ACC'SIZE USE SPECIFIED_SIZE;
+
+     PACKAGE P IS
+          TYPE ACC_IN_P IS ACCESS STRING;
+          FOR ACC_IN_P'STORAGE_SIZE USE COLL_SIZE;
+          FOR ACC_IN_P'SIZE USE SPECIFIED_SIZE;
+          TYPE PRIVATE_ACC IS PRIVATE;
+          TYPE ALT_ACC_IN_P IS ACCESS STRING;
+     PRIVATE
+          TYPE PRIVATE_ACC IS ACCESS STRING;
+          FOR ALT_ACC_IN_P'STORAGE_SIZE USE COLL_SIZE;
+          FOR ALT_ACC_IN_P'SIZE USE SPECIFIED_SIZE;
+     END P;
+
+     USE P;
+
+     MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
+
+BEGIN
+
+     TEST("CD2A83C", "CHECK THAT WHEN SIZE AND COLLECTION SIZE " &
+                     "SPECIFICATIONS FOR AN ACCESS TYPE, " &
+                     "CAN BE GIVEN IN " &
+                     "THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR " &
+                     "A TYPE DECLARED IN THE VISIBLE PART");
+
+     IF CHECK_ACC'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("CHECK_ACC'SIZE /= SPECIFIED_SIZE");
+     END IF;
+
+     IF CHECK_ACC'STORAGE_SIZE < COLL_SIZE THEN
+          FAILED ("CHECK_ACC'STORAGE_SIZE TOO SMALL");
+     END IF;
+
+     IF ACC_IN_P'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("ACC_IN_P'SIZE /= SPECIFIED_SIZE");
+     END IF;
+
+     IF ACC_IN_P'STORAGE_SIZE < COLL_SIZE THEN
+          FAILED ("ACC_IN_P'STORAGE_SIZE TOO SMALL");
+     END IF;
+
+     IF ALT_ACC_IN_P'SIZE /= MINIMUM_SIZE THEN
+          FAILED ("ALT_ACC_IN_P'SIZE /= SPECIFIED_SIZE");
+     END IF;
+
+     IF ALT_ACC_IN_P'STORAGE_SIZE < COLL_SIZE THEN
+          FAILED ("ALT_ACC_IN_P'STORAGE_SIZE TOO SMALL");
+     END IF;
+
+     RESULT;
+
+END CD2A83C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a91c.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a91c.tst
new file mode 100644
index 000000000..09acce9f4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2a91c.tst
@@ -0,0 +1,134 @@
+-- CD2A91C.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 A SIZE SPECIFICATION FOR A TASK TYPE CAN BE GIVEN IN
+--     THE VISIBLE OR PRIVATE PART OF A PACKAGE.
+
+-- MACRO SUBSTITUTION:
+--     $TASK_SIZE IS THE NUMBER OF BITS NEEDED BY THE IMPLEMENTATION TO
+--     HOLD ANY POSSIBLE OBJECT OF THE TASK TYPE "BASIC_TYPE".
+
+-- HISTORY:
+--     BCB 09/08/87  CREATED ORIGINAL TEST.
+--     RJW 05/12/89  MODIFIED CHECKS INVOLVING 'SIZE ATTRIBUTE.
+--                   REMOVED APPLICABILTY CRITERIA.
+--     DTN 11/20/91  DELETED SUBPARTS (B and C).
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2A91C IS
+
+     BASIC_SIZE : CONSTANT := $TASK_SIZE;
+
+     VAL : INTEGER := 1;
+
+     TASK TYPE BASIC_TYPE IS
+          ENTRY HERE(NUM : IN OUT INTEGER);
+     END BASIC_TYPE;
+
+     FOR BASIC_TYPE'SIZE USE BASIC_SIZE;
+
+     BASIC_TASK : BASIC_TYPE;
+
+     PACKAGE P IS
+          TASK TYPE TASK_IN_P IS
+               ENTRY HERE(NUM : IN OUT INTEGER);
+          END TASK_IN_P;
+          FOR TASK_IN_P'SIZE USE BASIC_SIZE;
+          TASK TYPE ALT_TASK_IN_P IS
+               ENTRY HERE(NUM : IN OUT INTEGER);
+          END ALT_TASK_IN_P;
+     PRIVATE
+          FOR ALT_TASK_IN_P'SIZE USE BASIC_SIZE;
+     END P;
+
+     USE P;
+
+     ALT_TASK : ALT_TASK_IN_P;
+     IN_TASK : TASK_IN_P;
+
+     TASK BODY BASIC_TYPE IS
+     BEGIN
+          SELECT
+               ACCEPT HERE(NUM : IN OUT INTEGER) DO
+                     NUM := 0;
+               END HERE;
+          OR
+               TERMINATE;
+          END SELECT;
+     END BASIC_TYPE;
+
+     PACKAGE BODY P IS
+          TASK BODY TASK_IN_P IS
+          BEGIN
+               SELECT
+                    ACCEPT HERE(NUM : IN OUT INTEGER) DO
+                          NUM := 0;
+                    END HERE;
+               OR
+                    TERMINATE;
+               END SELECT;
+          END TASK_IN_P;
+          TASK BODY ALT_TASK_IN_P IS
+          BEGIN
+               SELECT
+                    ACCEPT HERE(NUM : IN OUT INTEGER) DO
+                          NUM := 0;
+                    END HERE;
+               OR
+                    TERMINATE;
+               END SELECT;
+          END ALT_TASK_IN_P;
+     END P;
+
+BEGIN
+     TEST ("CD2A91C", "CHECK THAT A SIZE SPECIFICATION FOR A TASK " &
+                      "TYPE CAN BE GIVEN IN THE VISIBLE OR PRIVATE " &
+                      "PART OF A PACKAGE");
+
+     BASIC_TASK.HERE(VAL);
+
+     IF VAL /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT RESULTS FROM ENTRY CALL - 1");
+     END IF;
+
+     VAL := 1;
+
+     ALT_TASK.HERE(VAL);
+ 
+     IF VAL /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT RESULTS FROM ENTRY CALL - 2");
+     END IF;
+ 
+     VAL := 1;
+
+     IN_TASK.HERE(VAL);
+
+     IF VAL /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT RESULTS FROM ENTRY CALL - 3");
+     END IF;
+
+
+     RESULT;
+END CD2A91C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11a.ada
new file mode 100644
index 000000000..580bb8d11
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11a.ada
@@ -0,0 +1,214 @@
+-- CD2B11A.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 COLLECTION SIZE SPECIFICATION CAN BE GIVEN FOR AN
+--     ACCESS TYPE, THEN OPERATIONS ON VALUES OF THE ACCESS TYPE ARE NOT
+--     AFFECTED.
+
+-- HISTORY:
+--     BCB 11/01/88  CREATED ORIGINAL TEST.
+--     RJW 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
+--                   ADDED CHECK FOR UNCHECKED_DEALLOCATION.
+
+WITH REPORT;  USE REPORT;
+WITH SYSTEM;
+WITH UNCHECKED_DEALLOCATION;
+PROCEDURE CD2B11A IS
+
+     BASIC_SIZE : CONSTANT := 1024;
+
+     TYPE MAINTYPE IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+     TYPE ACC_TYPE IS ACCESS MAINTYPE;
+     SUBTYPE ACC_RANGE IS ACC_TYPE (1 .. 3);
+
+     FOR ACC_TYPE'STORAGE_SIZE USE BASIC_SIZE;
+
+     TYPE RECORD_TYPE IS RECORD
+          COMP : ACC_TYPE;
+     END RECORD;
+
+     CHECK_TYPE1 : ACC_TYPE;
+     CHECK_TYPE2 : ACC_TYPE;
+     CHECK_TYPE3 : ACC_TYPE(1..3);
+
+     CHECK_ARRAY : ARRAY (1..2) OF ACC_TYPE;
+
+     CHECK_RECORD1 : RECORD_TYPE;
+     CHECK_RECORD2 : RECORD_TYPE;
+
+     CHECK_PARAM1 : ACC_TYPE;
+     CHECK_PARAM2 : ACC_TYPE;
+
+     CHECK_NULL : ACC_TYPE := NULL;
+
+     PROCEDURE PROC (ACC1,ACC2 : IN OUT ACC_TYPE) IS
+
+     BEGIN
+
+          IF (ACC1.ALL /= ACC2.ALL) THEN
+               FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS " &
+                       "- 1");
+          END IF;
+
+          IF EQUAL (3,3) THEN
+               ACC2 := ACC1;
+          END IF;
+
+          IF ACC2 /= ACC1 THEN
+               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
+                       "-1");
+          END IF;
+
+          IF (ACC1 IN ACC_RANGE) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 1");
+          END IF;
+
+     END PROC;
+
+BEGIN
+
+     TEST ("CD2B11A", "CHECK THAT IF A COLLECTION SIZE SPECIFICATION " &
+                      "CAN BE GIVEN FOR AN ACCESS TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF THE ACCESS TYPE ARE " &
+                      "NOT AFFECTED");
+
+     CHECK_PARAM1 := NEW MAINTYPE'(25,35,45);
+     CHECK_PARAM2 := NEW MAINTYPE'(25,35,45);
+
+     PROC (CHECK_PARAM1,CHECK_PARAM2);
+
+     IF ACC_TYPE'STORAGE_SIZE < BASIC_SIZE THEN
+          FAILED ("INCORRECT VALUE FOR ACCESS TYPE STORAGE_SIZE");
+     END IF;
+
+     CHECK_TYPE1 := NEW MAINTYPE'(25,35,45);
+     CHECK_TYPE2 := NEW MAINTYPE'(25,35,45);
+     CHECK_TYPE3 := NEW MAINTYPE'(1 => 1,2 => 2,3 => 3);
+
+     CHECK_ARRAY (1) := NEW MAINTYPE'(25,35,45);
+     CHECK_ARRAY (2) := NEW MAINTYPE'(25,35,45);
+
+     CHECK_RECORD1.COMP := NEW MAINTYPE'(25,35,45);
+     CHECK_RECORD2.COMP := NEW MAINTYPE'(25,35,45);
+
+     IF (CHECK_TYPE1.ALL /= CHECK_TYPE2.ALL) THEN
+          FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 2");
+     END IF;
+
+     IF EQUAL (3,3) THEN
+          CHECK_TYPE2 := CHECK_TYPE1;
+     END IF;
+
+     IF CHECK_TYPE2 /= CHECK_TYPE1 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
+     END IF;
+
+     IF (CHECK_TYPE1 IN ACC_RANGE) THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 2");
+     END IF;
+
+     IF (CHECK_ARRAY (1).ALL /= CHECK_ARRAY (2).ALL) THEN
+          FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 3");
+     END IF;
+
+     IF EQUAL (3,3) THEN
+          CHECK_ARRAY (2) := CHECK_ARRAY (1);
+     END IF;
+
+     IF CHECK_ARRAY (2) /= CHECK_ARRAY (1) THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
+     END IF;
+
+     IF (CHECK_ARRAY (1) IN ACC_RANGE) THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 3");
+     END IF;
+
+     IF (CHECK_RECORD1.COMP.ALL /= CHECK_RECORD2.COMP.ALL) THEN
+          FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 4");
+     END IF;
+
+     IF EQUAL (3,3) THEN
+          CHECK_RECORD2 := CHECK_RECORD1;
+     END IF;
+
+     IF CHECK_RECORD2 /= CHECK_RECORD1 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
+     END IF;
+
+     IF (CHECK_RECORD1.COMP IN ACC_RANGE) THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 4");
+     END IF;
+
+     IF CHECK_TYPE3'FIRST /= IDENT_INT (1) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'FIRST");
+     END IF;
+
+     IF CHECK_TYPE3'LAST /= IDENT_INT (3) THEN
+          FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'LAST");
+     END IF;
+
+     DECLARE
+          TYPE ACC_CHAR IS ACCESS CHARACTER;
+          FOR ACC_CHAR'STORAGE_SIZE USE 128;
+
+          LIMIT : INTEGER :=
+           (ACC_CHAR'STORAGE_SIZE * SYSTEM.STORAGE_UNIT)/CHARACTER'SIZE;
+
+          ACC_ARRAY : ARRAY (1 .. LIMIT + 1) OF ACC_CHAR;
+          PLACE : INTEGER;
+
+          PROCEDURE FREE IS
+               NEW UNCHECKED_DEALLOCATION (CHARACTER, ACC_CHAR);
+     BEGIN
+          FOR I IN ACC_ARRAY'RANGE LOOP
+               ACC_ARRAY (IDENT_INT (I)) :=
+                    NEW CHARACTER'
+                         (IDENT_CHAR ((CHARACTER'VAL (I MOD 128))));
+               PLACE := I;
+          END LOOP;
+          FAILED ("NO EXCEPTION RAISED WHEN COLLECTION SIZE EXCEEDED");
+     EXCEPTION
+          WHEN STORAGE_ERROR =>
+               BEGIN
+                    FOR I IN 1 .. PLACE LOOP
+                         IF I MOD 2 = 0 THEN
+                              FREE (ACC_ARRAY (IDENT_INT (I)));
+                         END IF;
+                    END LOOP;
+
+                    FOR I IN 1 .. PLACE LOOP
+                         IF I MOD 2 = 1 AND THEN
+                            IDENT_CHAR (ACC_ARRAY (I).ALL) /=
+                            CHARACTER'VAL (I MOD IDENT_INT (128)) THEN
+                              FAILED ("INCORRECT VALUE IN ARRAY");
+                         END IF;
+                    END LOOP;
+               END;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED");
+     END;
+
+     RESULT;
+END CD2B11A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11b.ada
new file mode 100644
index 000000000..770d8d83f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11b.ada
@@ -0,0 +1,196 @@
+-- CD2B11B.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 COLLECTION SIZE IS SPECIFIED FOR AN
+--     ACCESS TYPE IN A GENERIC UNIT, THEN OPERATIONS ON VALUES OF THE
+--     ACCESS TYPE ARE NOT AFFECTED.
+
+-- HISTORY:
+--     BCB 09/23/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD2B11B IS
+
+     BASIC_SIZE : CONSTANT := 1024;
+     B : BOOLEAN;
+
+BEGIN
+
+     TEST ("CD2B11B", "CHECK THAT IF A COLLECTION SIZE IS SPECIFIED " &
+                      "FOR AN ACCESS TYPE, THEN " &
+                      "OPERATIONS ON VALUES OF THE ACCESS TYPE ARE " &
+                      "NOT AFFECTED");
+
+     DECLARE
+
+          GENERIC
+          FUNCTION FUNC RETURN BOOLEAN;
+
+          FUNCTION FUNC RETURN BOOLEAN IS
+
+               TYPE MAINTYPE IS ARRAY (INTEGER RANGE <>) OF INTEGER;
+               TYPE ACC_TYPE IS ACCESS MAINTYPE;
+               SUBTYPE ACC_RANGE IS ACC_TYPE (1 .. 3);
+
+               FOR ACC_TYPE'STORAGE_SIZE
+                    USE BASIC_SIZE;
+
+               TYPE RECORD_TYPE IS RECORD
+                    COMP : ACC_TYPE;
+               END RECORD;
+
+               CHECK_TYPE1 : ACC_TYPE;
+               CHECK_TYPE2 : ACC_TYPE;
+               CHECK_TYPE3 : ACC_TYPE(1..3);
+
+               CHECK_ARRAY : ARRAY (1..3) OF ACC_TYPE;
+
+               CHECK_RECORD1 : RECORD_TYPE;
+               CHECK_RECORD2 : RECORD_TYPE;
+
+               CHECK_PARAM1 : ACC_TYPE;
+               CHECK_PARAM2 : ACC_TYPE;
+
+               CHECK_NULL : ACC_TYPE := NULL;
+
+               PROCEDURE PROC (ACC1,ACC2 : IN OUT ACC_TYPE) IS
+
+               BEGIN
+
+                    IF (ACC1.ALL /= ACC2.ALL) THEN
+                         FAILED ("INCORRECT VALUES FOR DESIGNATED " &
+                                 "OBJECTS - 1");
+                    END IF;
+
+                    IF EQUAL (3,3) THEN
+                         ACC2 := ACC1;
+                    END IF;
+
+                    IF ACC2 /= ACC1 THEN
+                         FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
+                                 "OPERATORS - 1");
+                    END IF;
+
+                    IF (ACC1 IN ACC_RANGE) THEN
+                         FAILED ("INCORRECT RESULTS FOR " &
+                                 "MEMBERSHIP TEST - 1");
+                    END IF;
+
+               END PROC;
+
+     BEGIN -- FUNC.
+
+          CHECK_PARAM1 := NEW MAINTYPE'(25,35,45);
+          CHECK_PARAM2 := NEW MAINTYPE'(25,35,45);
+
+          PROC (CHECK_PARAM1,CHECK_PARAM2);
+
+          IF ACC_TYPE'STORAGE_SIZE < BASIC_SIZE THEN
+               FAILED ("INCORRECT VALUE FOR ACCESS TYPE STORAGE_SIZE");
+          END IF;
+
+          CHECK_TYPE1 := NEW MAINTYPE'(25,35,45);
+          CHECK_TYPE2 := NEW MAINTYPE'(25,35,45);
+          CHECK_TYPE3 := NEW MAINTYPE'(1 => 1,2 => 2,3 => 3);
+
+          CHECK_ARRAY (1) := NEW MAINTYPE'(25,35,45);
+          CHECK_ARRAY (2) := NEW MAINTYPE'(25,35,45);
+
+          CHECK_RECORD1.COMP := NEW MAINTYPE'(25,35,45);
+          CHECK_RECORD2.COMP := NEW MAINTYPE'(25,35,45);
+
+          IF (CHECK_TYPE1.ALL /= CHECK_TYPE2.ALL) THEN
+               FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 2");
+          END IF;
+
+          IF EQUAL (3,3) THEN
+               CHECK_TYPE2 := CHECK_TYPE1;
+          END IF;
+
+          IF CHECK_TYPE2 /= CHECK_TYPE1 THEN
+               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
+                       "- 2");
+          END IF;
+
+          IF (CHECK_TYPE1 IN ACC_RANGE) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 2");
+          END IF;
+
+          IF (CHECK_ARRAY (1).ALL /= CHECK_ARRAY (2).ALL) THEN
+               FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 3");
+          END IF;
+
+          IF EQUAL (3,3) THEN
+               CHECK_ARRAY (2) := CHECK_ARRAY (1);
+          END IF;
+
+          IF CHECK_ARRAY (2) /= CHECK_ARRAY (1) THEN
+               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
+                       "- 3");
+          END IF;
+
+          IF (CHECK_ARRAY (1) IN ACC_RANGE) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 3");
+          END IF;
+
+          IF (CHECK_RECORD1.COMP.ALL /= CHECK_RECORD2.COMP.ALL) THEN
+               FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 4");
+          END IF;
+
+          IF EQUAL (3,3) THEN
+               CHECK_RECORD2 := CHECK_RECORD1;
+          END IF;
+
+          IF CHECK_RECORD2 /= CHECK_RECORD1 THEN
+               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
+                       "- 4");
+          END IF;
+
+          IF (CHECK_RECORD1.COMP IN ACC_RANGE) THEN
+               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 4");
+          END IF;
+
+          IF CHECK_TYPE3'FIRST /= IDENT_INT (1) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'FIRST");
+          END IF;
+
+          IF CHECK_TYPE3'LAST /= IDENT_INT (3) THEN
+               FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'LAST");
+          END IF;
+
+          RETURN TRUE;
+
+     END FUNC;
+
+     FUNCTION NEWFUNC IS NEW FUNC;
+
+     BEGIN
+          B := NEWFUNC;
+     END;
+
+     RESULT;
+END CD2B11B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11d.ada
new file mode 100644
index 000000000..e620bad74
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11d.ada
@@ -0,0 +1,54 @@
+-- CD2B11D.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 EXPRESSION IN A COLLECTION SIZE CLAUSE
+--     FOR AN ACCESS TYPE NEED NOT BE STATIC.
+
+-- HISTORY:
+--     BCB 09/23/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD2B11D IS
+
+     TYPE CHECK_TYPE IS ACCESS INTEGER;
+     FOR CHECK_TYPE'STORAGE_SIZE USE 256;
+
+     TYPE ACC_TYPE IS ACCESS INTEGER;
+     FOR ACC_TYPE'STORAGE_SIZE USE IDENT_INT (256);
+
+BEGIN
+
+     TEST ("CD2B11D", "CHECK THAT THE EXPRESSION IN A COLLECTION " &
+                      "SIZE SPECIFICATION FOR AN ACCESS TYPE "&
+                      "NEED NOT BE STATIC");
+
+     IF ACC_TYPE'STORAGE_SIZE < IDENT_INT (256) THEN
+          FAILED ("INCORRECT VALUE FOR STORAGE_SIZE");
+     END IF;
+
+     RESULT;
+END CD2B11D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11e.ada
new file mode 100644
index 000000000..b71f03261
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11e.ada
@@ -0,0 +1,76 @@
+-- CD2B11E.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 EXPRESSION IN A COLLECTION SIZE CLAUSE
+--     FOR AN ACCESS TYPE IN A GENERIC UNIT NEED NOT BE STATIC.
+
+-- HISTORY:
+--     BCB 09/23/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD2B11E IS
+
+     B : BOOLEAN;
+
+BEGIN
+
+     TEST ("CD2B11E", "CHECK THAT THE EXPRESSION IN A COLLECTION " &
+                      "SIZE CLAUSE FOR AN ACCESS TYPE IN A " &
+                      "GENERIC UNIT NEED NOT BE STATIC");
+
+     DECLARE
+
+          GENERIC
+          FUNCTION FUNC RETURN BOOLEAN;
+
+          FUNCTION FUNC RETURN BOOLEAN IS
+
+               TYPE TEST_TYPE IS ACCESS INTEGER;
+               FOR TEST_TYPE'STORAGE_SIZE USE 256;
+
+               TYPE ACC_TYPE IS ACCESS INTEGER;
+               FOR ACC_TYPE'STORAGE_SIZE
+                                USE IDENT_INT (256);
+
+          BEGIN -- FUNC.
+
+               IF ACC_TYPE'STORAGE_SIZE < IDENT_INT (256) THEN
+                    FAILED ("INCORRECT VALUE FOR STORAGE_SIZE");
+               END IF;
+
+               RETURN TRUE;
+
+          END FUNC;
+
+     FUNCTION NEWFUNC IS NEW FUNC;
+
+     BEGIN
+          B := NEWFUNC;
+     END;
+
+     RESULT;
+END CD2B11E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11f.ada
new file mode 100644
index 000000000..ad1564502
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b11f.ada
@@ -0,0 +1,88 @@
+-- CD2B11F.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 COLLECTION SIZE SPECIFICATION IS GIVEN FOR AN
+--     ACCESS TYPE WHOSE DESIGNATED TYPE IS A DISCRIMINATED RECORD, THEN
+--     OPERATIONS ON VALUES OF THE ACCESS TYPE ARE NOT AFFECTED.
+
+-- HISTORY:
+--     BCB 09/29/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD2B11F IS
+
+     BASIC_SIZE : CONSTANT := 1024;
+
+     TYPE RECORD_TYPE(DISC : INTEGER := 100) IS RECORD
+          COMP1 : INTEGER;
+          COMP2 : INTEGER;
+          COMP3 : INTEGER;
+     END RECORD;
+
+     TYPE ACC_RECORD IS ACCESS RECORD_TYPE;
+     FOR ACC_RECORD'STORAGE_SIZE USE BASIC_SIZE;
+
+     CHECK_RECORD1 : ACC_RECORD;
+     CHECK_RECORD2 : ACC_RECORD;
+
+BEGIN
+
+     TEST ("CD2B11F", "CHECK THAT IF A COLLECTION SIZE SPECIFICATION " &
+                      "IS GIVEN FOR AN ACCESS TYPE WHOSE " &
+                      "DESIGNATED TYPE IS A DISCRIMINATED RECORD, " &
+                      "THEN OPERATIONS ON VALUES OF THE ACCESS TYPE " &
+                      "ARE NOT AFFECTED");
+
+     CHECK_RECORD1 := NEW RECORD_TYPE;
+     CHECK_RECORD1.COMP1 := 25;
+     CHECK_RECORD1.COMP2 := 25;
+     CHECK_RECORD1.COMP3 := 150;
+
+     IF ACC_RECORD'STORAGE_SIZE < BASIC_SIZE THEN
+          FAILED ("INCORRECT VALUE FOR RECORD TYPE ACCESS " &
+                  "STORAGE_SIZE");
+     END IF;
+
+     IF CHECK_RECORD1.DISC /= IDENT_INT (100) THEN
+          FAILED ("INCORRECT VALUE FOR RECORD DISCRIMINANT");
+     END IF;
+
+     IF ((CHECK_RECORD1.COMP1 /= CHECK_RECORD1.COMP2) OR
+             (CHECK_RECORD1.COMP1 = CHECK_RECORD1.COMP3)) THEN
+          FAILED ("INCORRECT VALUE FOR RECORD COMPONENT");
+     END IF;
+
+     IF EQUAL (3,3) THEN
+          CHECK_RECORD2 := CHECK_RECORD1;
+     END IF;
+
+     IF CHECK_RECORD2 /= CHECK_RECORD1 THEN
+          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATOR");
+     END IF;
+
+     RESULT;
+END CD2B11F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b15c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b15c.ada
new file mode 100644
index 000000000..8e58d81a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b15c.ada
@@ -0,0 +1,103 @@
+-- CD2B15C.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:
+--     IF THE COLLECTION SIZE IS LARGE ENOUGH TO HOLD SOME
+--     VALUES OF THE DESIGNATED TYPE, CHECK THAT "STORAGE_ERROR"
+--     IS RAISED BY AN ALLOCATOR WHEN INSUFFICIENT STORAGE IS
+--     AVAILABLE.
+
+-- HISTORY:
+--     DHH 09/23/87 CREATED ORIGINAL TEST.
+--     PMW 09/19/88 MODIFIED WITHDRAWN TEST.
+--     THS 03/21/90 CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND
+--                  COMPLETELY REVISED THE TEST TO PREVENT OPTIMIZATION.
+--     LDC 09/20/90 REMOVED UNUSED VARIABLE, CHANGED FAIL CALLS TO 
+--                  COMMENT FOR 'STORAGE_SIZE /= TO SPECIFIED SIZE,
+--                  MOVED LOOP FOR CHECK VALUES TO EXCEPTION HANDLER.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM;
+PROCEDURE CD2B15C IS
+
+     SPECIFIED_SIZE : CONSTANT := 1000;
+
+     TYPE CHECK_TYPE IS ACCESS INTEGER;
+     FOR CHECK_TYPE'STORAGE_SIZE USE SPECIFIED_SIZE;
+
+     UNITS_PER_INTEGER : CONSTANT :=
+         (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) / SYSTEM.STORAGE_UNIT;
+
+     TYPE ACC_ARRAY_TYPE IS ARRAY
+         (INTEGER RANGE 1 .. (CHECK_TYPE'STORAGE_SIZE /
+          UNITS_PER_INTEGER) + 1) OF CHECK_TYPE;
+     ACC_ARRAY : ACC_ARRAY_TYPE;
+
+     PLACE_I_STOPPED : INTEGER := 0;
+
+BEGIN
+
+     TEST ("CD2B15C", "IF THE COLLECTION SIZE IS LARGE " &
+                      "ENOUGH TO HOLD SOME VALUES OF " &
+                      "THE DESIGNATED TYPE, CHECK THAT " &
+                      "STORAGE_ERROR IS RAISED BY AN " &
+                      "ALLOCATOR WHEN INSUFFICIENT STORAGE " &
+                      "IS AVAILABLE");
+
+     IF CHECK_TYPE'STORAGE_SIZE < IDENT_INT (SPECIFIED_SIZE) THEN
+          FAILED ("CHECK_TYPE'STORAGE_SIZE IS LESS THEN THE VALUE " &
+                  "SPECIFIED IN THE REPRESENTATION CLAUSE");
+
+     ELSIF CHECK_TYPE'STORAGE_SIZE > 2 * IDENT_INT (SPECIFIED_SIZE) THEN
+          COMMENT ("VALUE FOR CHECK_TYPE'STORAGE_SIZE IS MORE THEN " &
+                   "TWICE THE SPECIFIED VALUE IN THE REPRESENTATION " &
+                   "CLAUSE");
+     END IF;
+
+     BEGIN
+
+          FOR I IN ACC_ARRAY'RANGE LOOP
+               ACC_ARRAY (I) := NEW INTEGER'(IDENT_INT (I));
+               PLACE_I_STOPPED := I;
+          END LOOP;
+
+          FAILED ("NO EXCEPTION RAISED WHEN RESERVED SPACE " &
+                  "EXCEEDED");
+
+     EXCEPTION
+          WHEN STORAGE_ERROR =>
+               FOR I IN 1 .. PLACE_I_STOPPED LOOP
+                    IF ACC_ARRAY (I).ALL /= IDENT_INT (I) THEN
+                        FAILED ("INCORRECT VALUE FOR ACC_ARRAY (" &
+                                INTEGER'IMAGE (I) & ")");
+                    END IF;
+               END LOOP;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED WHEN RESERVED SPACE " &
+                       "EXCEEDED");
+     END;
+
+     RESULT;
+
+END CD2B15C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b16a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b16a.ada
new file mode 100644
index 000000000..6dc514186
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2b16a.ada
@@ -0,0 +1,85 @@
+-- CD2B16A.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:
+--     IF A COLLECTION SIZE CLAUSE IS GIVEN FOR A PARENT ACCESS TYPE,
+--     THEN THE DERIVED TYPE HAS THE SAME COLLECTION SIZE, WHETHER THE
+--     DERIVED TYPE IS DECLARED BEFORE OR AFTER THE PARENT COLLECTION
+--     SIZE SPECIFICATION.
+
+-- HISTORY:
+--     DHH 09/29/87 CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CD2B16A IS
+BEGIN
+     TEST ("CD2B16A", "IF A COLLECTION SIZE IS GIVEN FOR A " &
+                      "PARENT ACCESS TYPE, THEN THE DERIVED TYPE HAS " &
+                      "THE SAME COLLECTION SIZE, WHETHER THE " &
+                      "DERIVED TYPE IS DECLARED BEFORE OR AFTER " &
+                      "THE PARENT COLLECTION SIZE SPECIFICATION");
+
+          DECLARE
+
+               COLLECTION_SIZE : CONSTANT :=128;
+               TYPE V IS ARRAY(1..4) OF INTEGER;
+
+               TYPE CELL IS
+                    RECORD
+                         VALUE : V;
+                    END RECORD;
+
+               TYPE LINK IS ACCESS CELL;
+               TYPE NEWLINK1 IS NEW LINK;
+
+               FOR LINK'STORAGE_SIZE USE
+                                     COLLECTION_SIZE;
+
+               TYPE NEWLINK2 IS NEW LINK;
+
+          BEGIN    -- ACTIVE DECLARE
+
+               IF LINK'STORAGE_SIZE < COLLECTION_SIZE THEN
+                    FAILED("STORAGE_SIZE SMALLER THAN STORAGE_SIZE " &
+                           "SPECIFIED WAS ALLOCATED");
+               END IF;
+
+               IF LINK'STORAGE_SIZE /= NEWLINK1'STORAGE_SIZE THEN
+                    FAILED("STORAGE_SIZE OF THE FIRST DERIVED TYPE" &
+                           "IS NOT THE SAME SIZE AS THAT OF THE " &
+                           "PARENT");
+               END IF;
+
+               IF LINK'STORAGE_SIZE /= NEWLINK2'STORAGE_SIZE THEN
+                    FAILED("STORAGE_SIZE OF THE SECOND DERIVED TYPE" &
+                           "IS NOT THE SAME SIZE AS THAT OF THE " &
+                           "PARENT");
+               END IF;
+
+          END;    --ACTIVE DECLARE
+
+     RESULT;
+END CD2B16A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2c11a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2c11a.tst
new file mode 100644
index 000000000..d4f326b99
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2c11a.tst
@@ -0,0 +1,140 @@
+--CD2C11A.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:
+--     IF A TASK STORAGE SIZE SPECIFICATION IS GIVEN FOR A TASK
+--     TYPE, THEN OPERATIONS ON VALUES OF THE TASK TYPE ARE NOT
+--     AFFECTED.
+
+-- MACRO SUBSTITUTION:
+--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+--     THE ACTIVATION OF A TASK.
+
+-- HISTORY
+--     DHH 09/24/87  CREATED ORIGINAL TEST.
+--     RJW 07/06/88  REVISED THE TEST TO REMOVE UNINITIALIZED 'IN OUT'
+--                   PARAMETER.  CHANGED EXTENSION TO 'TST'.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2C11A IS
+
+    TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+
+BEGIN
+
+     TEST ("CD2C11A", "IF A TASK STORAGE SIZE SPECIFICATION IS " &
+                      "GIVEN FOR A TASK TYPE, THEN OPERATIONS " &
+                      "ON VALUES OF THE TASK TYPE ARE NOT AFFECTED");
+
+     DECLARE
+          PACKAGE PACK IS
+
+               TYPE FLT IS DIGITS 1;
+
+               TASK TYPE TTYPE IS
+                    ENTRY ADD(J :IN INTEGER; K : IN OUT INTEGER);
+                    ENTRY MULT(Y : IN FLT; Z : IN OUT FLT);
+               END TTYPE;
+
+
+               M : INTEGER := 81;
+               N : INTEGER := 0;
+               V,W : FLT RANGE 1.0..512.0 := 2.0;
+
+               FOR TTYPE'STORAGE_SIZE USE TASK_STORAGE_SIZE;
+
+               T : TTYPE;
+
+          END PACK;
+
+          PACKAGE BODY PACK IS
+               FUNCTION IDENT_FLT(FT : FLT) RETURN FLT IS
+               BEGIN
+                    IF EQUAL(5,5) THEN
+                         RETURN FT;
+                    ELSE
+                         RETURN 0.0;
+                    END IF;
+               END IDENT_FLT;
+
+               TASK BODY TTYPE IS
+                    ITEMP : INTEGER := 0;
+                    FTEMP : FLT := 0.0;
+               BEGIN
+                    ACCEPT ADD(J :IN INTEGER; K : IN OUT INTEGER) DO
+                         ITEMP := J;
+                         IF EQUAL(3,3) THEN
+                              K := ITEMP;
+                         ELSE
+                              K := 0;
+                         END IF;
+                    END ADD;
+                    ACCEPT MULT(Y : IN FLT; Z : IN OUT FLT) DO
+                         FTEMP := Y;
+                         IF EQUAL(3,3) THEN
+                              Z := FTEMP;
+                         ELSE
+                              Z := 0.0;
+                         END IF;
+                    END MULT;
+               END TTYPE;
+
+               PROCEDURE TEST_TASK(G : IN TTYPE;
+                                 S : IN  FLT; T : IN OUT FLT) IS
+                    R : FLT := 4.0;
+               BEGIN
+                    IF NOT (G'CALLABLE) OR G'TERMINATED THEN
+                         FAILED("TASK INSIDE PROCEDURE IS SHOWING " &
+                                "WRONG VALUE FOR 'CALLABLE OR " &
+                                "'TERMINATED");
+                    END IF;
+                    G.MULT(S,T);
+               END TEST_TASK;
+
+          BEGIN
+
+               IF TTYPE'STORAGE_SIZE < IDENT_INT(TASK_STORAGE_SIZE) THEN
+                    FAILED("ACTUAL 'STORAGE_SIZE USED IS SMALLER " &
+                           "THAN SIZE REQUESTED");
+               END IF;
+
+               T.ADD(M,N);
+
+               IF M /= IDENT_INT(N) THEN
+                    FAILED("TASK CALL PARAMETERS NOT EQUAL");
+               END IF;
+
+               V := IDENT_FLT(13.0);
+               TEST_TASK(T,V,W);
+               IF V /= IDENT_FLT(W)  THEN
+                    FAILED("TASK AS PARAMETER FAILED");
+               END IF;
+
+          END PACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD2C11A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2c11d.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2c11d.tst
new file mode 100644
index 000000000..2e5a5fe9e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2c11d.tst
@@ -0,0 +1,87 @@
+--CD2C11D.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 THE EXPRESSION IN A TASK STORAGE SIZE CLAUSE NEED
+--     NOT BE STATIC.
+
+-- MACRO SUBSTITUTION:
+--     $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR
+--     THE ACTIVATION OF A TASK.
+
+-- HISTORY
+--     DHH 09/29/87 CREATED ORIGINAL TEST
+--     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.TST'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CD2C11D IS
+
+BEGIN
+
+     TEST ("CD2C11D","THE EXPRESSION IN A TASK STORAGE SIZE CLAUSE " &
+                     "NEED NOT BE STATIC");
+
+     DECLARE
+
+          STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE;
+          PACKAGE PACK IS
+               TASK TYPE CHECK_TYPE;
+
+               FOR CHECK_TYPE'STORAGE_SIZE USE
+                                      STORAGE_SIZE;
+               TASK TYPE TTYPE IS
+                    ENTRY ADD(J :IN INTEGER; K : IN OUT INTEGER);
+               END TTYPE;
+
+               FOR TTYPE'STORAGE_SIZE USE IDENT_INT(STORAGE_SIZE);
+
+          END PACK;
+
+          PACKAGE BODY PACK IS
+
+               TASK BODY TTYPE IS
+               BEGIN
+                    ACCEPT ADD(J :IN INTEGER; K : IN OUT INTEGER);
+               END TTYPE;
+
+               TASK BODY CHECK_TYPE IS
+               BEGIN
+                    NULL;
+               END CHECK_TYPE;
+
+          BEGIN
+
+               IF TTYPE'STORAGE_SIZE < IDENT_INT(STORAGE_SIZE) THEN
+                    FAILED("STORAGE_SIZE SPECIFIED IS " &
+                           "GREATER THAN MEMORY ALLOCATED");
+               END IF;
+
+          END PACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD2C11D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2d11a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2d11a.ada
new file mode 100644
index 000000000..f44e8ef7d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2d11a.ada
@@ -0,0 +1,214 @@
+-- CD2D11A.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 SMALL SPECIFICATION IS GIVEN FOR A
+--     FIXED POINT TYPE, THEN ARITHMETIC OPERATIONS ON VALUES OF THE
+--     TYPE ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     BCB 09/01/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD2D11A IS
+
+     BASIC_SMALL : CONSTANT := 2.0 ** (-4);
+
+     TYPE BASIC_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
+
+     TYPE CHECK_TYPE IS DELTA 1.0 RANGE -4.0 .. 4.0;
+
+     FOR CHECK_TYPE'SMALL USE BASIC_SMALL;
+
+     CNEG1 : CHECK_TYPE := -3.5;
+     CNEG2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
+     CPOS1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
+     CPOS2 : CHECK_TYPE :=  3.5;
+     CZERO : CHECK_TYPE;
+
+     TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF CHECK_TYPE;
+     CHARRAY : ARRAY_TYPE :=
+          (-3.5, CHECK_TYPE (-1.0/3.0), CHECK_TYPE (4.0/6.0), 3.5);
+
+     TYPE REC_TYPE IS RECORD
+          COMPN1 : CHECK_TYPE := -3.5;
+          COMPN2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
+          COMPP1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
+          COMPP2 : CHECK_TYPE :=  3.5;
+     END RECORD;
+
+     CHREC : REC_TYPE;
+
+     FUNCTION IDENT (FX : CHECK_TYPE) RETURN CHECK_TYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN FX;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT;
+
+     PROCEDURE PROC (N1_IN, P1_IN      :        CHECK_TYPE;
+                     N2_INOUT,P2_INOUT : IN OUT CHECK_TYPE;
+                     CZOUT             :    OUT CHECK_TYPE) IS
+     BEGIN
+
+          IF IDENT (N1_IN) + P1_IN NOT IN
+                  -2.875 .. -2.8125 OR
+             P2_INOUT  - IDENT (P1_IN) NOT IN
+                  2.8125 .. 2.875 THEN
+               FAILED ("INCORRECT RESULTS FOR " &
+                       "BINARY ADDING OPERATORS - 1");
+          END IF;
+
+          IF +IDENT (N2_INOUT) NOT IN -0.375 .. -0.3125 OR
+             IDENT (-P1_IN) NOT IN -0.6875 .. -0.625 THEN
+               FAILED ("INCORRECT RESULTS FOR " &
+                       "UNARY ADDING OPERATORS - 1");
+          END IF;
+
+          IF CHECK_TYPE (N1_IN * IDENT (P1_IN)) NOT IN
+               -2.4375 .. -2.1875 OR
+             CHECK_TYPE (IDENT (N2_INOUT) / P2_INOUT) NOT IN
+               -0.125 .. -0.0625 THEN
+               FAILED ("INCORRECT RESULTS FOR " &
+                       "MULTIPLYING OPERATORS - 1");
+          END IF;
+
+          IF ABS IDENT (N2_INOUT) NOT IN 0.3125 .. 0.375 OR
+             IDENT (ABS P1_IN) NOT IN 0.625 .. 0.6875 THEN
+               FAILED ("INCORRECT RESULTS FOR " &
+                       "ABSOLUTE VALUE OPERATORS - 1");
+          END IF;
+
+          CZOUT := 0.0;
+
+     END PROC;
+
+BEGIN
+     TEST ("CD2D11A", "CHECK THAT IF A SMALL SPECIFICATION IS " &
+                      "GIVEN FOR AN FIXED POINT TYPE, THEN " &
+                      "ARITHMETIC OPERATIONS ON VALUES OF THE " &
+                      "TYPE ARE NOT AFFECTED BY THE REPRESENTATION " &
+                      "CLAUSE");
+
+     PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
+
+     IF IDENT (CZERO) /= 0.0 THEN
+          FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
+     END IF;
+
+     IF IDENT (CNEG1) + CPOS1 NOT IN -2.875 .. -2.8125 OR
+        CPOS2  - IDENT (CPOS1) NOT IN 2.8125 .. 2.875 THEN
+          FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 2");
+     END IF;
+
+     IF +IDENT (CNEG2) NOT IN -0.375 .. -0.3125 OR
+        IDENT (-CPOS1) NOT IN -0.6875 .. -0.625 THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 2");
+     END IF;
+
+     IF CHECK_TYPE (CNEG1 * IDENT (CPOS1)) NOT IN -2.4375 .. -2.1875 OR
+        CHECK_TYPE (IDENT (CNEG2) / CPOS2) NOT IN
+               -0.125 .. -0.0625 THEN
+          FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 2");
+     END IF;
+
+     IF ABS IDENT (CNEG2) NOT IN 0.3125 .. 0.375 OR
+        IDENT (ABS CPOS1) NOT IN 0.625 .. 0.6875 THEN
+          FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
+                  "OPERATORS - 2");
+     END IF;
+
+     IF IDENT (CPOS1) NOT IN 0.625 .. 0.6875 OR
+            CNEG2 IN -0.25 .. 0.0 OR
+            IDENT (CNEG2) IN -1.0 .. -0.4375 THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
+     END IF;
+
+     IF IDENT (CHARRAY (0)) + CHARRAY (2) NOT IN
+             -2.875 .. -2.8125 OR
+        CHARRAY (3)  - IDENT (CHARRAY (2)) NOT IN
+             2.8125 .. 2.875 THEN
+          FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 3");
+     END IF;
+
+     IF +IDENT (CHARRAY (1)) NOT IN -0.375 .. -0.3125 OR
+        IDENT (-CHARRAY (2)) NOT IN -0.6875 .. -0.625 THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 3");
+     END IF;
+
+     IF CHECK_TYPE (CHARRAY (0) * IDENT (CHARRAY (2))) NOT IN
+          -2.4375 .. -2.1875 OR
+        CHECK_TYPE (IDENT (CHARRAY (1)) / CHARRAY (3)) NOT IN
+          -0.125 .. -0.0625 THEN
+          FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 3");
+     END IF;
+
+     IF ABS IDENT (CHARRAY (1)) NOT IN 0.3125 .. 0.375 OR
+        IDENT (ABS CHARRAY (2)) NOT IN 0.625 .. 0.6875 THEN
+          FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
+                  "OPERATORS - 3");
+     END IF;
+
+     IF IDENT (CHARRAY (2)) NOT IN 0.625 .. 0.6875 OR
+            CHARRAY (1) IN -0.25 .. 0.0 OR
+            IDENT (CHARRAY (1)) IN -1.0 .. -0.4375 THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
+     END IF;
+
+     IF IDENT (CHREC.COMPN1) + CHREC.COMPP1 NOT IN
+             -2.875 .. -2.8125 OR
+        CHREC.COMPP2  - IDENT (CHREC.COMPP1) NOT IN
+             2.8125 .. 2.875 THEN
+          FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 4");
+     END IF;
+
+     IF +IDENT (CHREC.COMPN2) NOT IN -0.375 .. -0.3125 OR
+        IDENT (-CHREC.COMPP1) NOT IN -0.6875 .. -0.625 THEN
+          FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 4");
+     END IF;
+
+     IF CHECK_TYPE (CHREC.COMPN1 * IDENT (CHREC.COMPP1)) NOT IN
+          -2.4375 .. -2.1875 OR
+        CHECK_TYPE (IDENT (CHREC.COMPN2) / CHREC.COMPP2) NOT IN
+          -0.125 .. -0.0625 THEN
+          FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 4");
+     END IF;
+
+     IF ABS IDENT (CHREC.COMPN2) NOT IN 0.3125 .. 0.375 OR
+        IDENT (ABS CHREC.COMPP1) NOT IN 0.625 .. 0.6875 THEN
+          FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
+                  "OPERATORS - 4");
+     END IF;
+
+     IF IDENT (CHREC.COMPP1) NOT IN 0.625 .. 0.6875 OR
+           CHREC.COMPN2 IN -0.25 .. 0.0 OR
+           IDENT (CHREC.COMPN2) IN -1.0 .. -0.4375 THEN
+          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
+     END IF;
+
+     RESULT;
+END CD2D11A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2d13a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2d13a.ada
new file mode 100644
index 000000000..abb3f6bcd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd2d13a.ada
@@ -0,0 +1,66 @@
+-- CD2D13A.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 SMALL CLAUSE CAN BE GIVEN IN THE VISIBLE
+--     OR PRIVATE PART OF A PACKAGE FOR A FIXED POINT TYPE DECLARED
+--     IN THE VISIBLE PART.
+
+-- HISTORY:
+--     BCB 09/01/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; WITH TEXT_IO;
+WITH REPORT; USE REPORT;
+PROCEDURE CD2D13A IS
+
+     SPECIFIED_SMALL : CONSTANT := 2.0 ** (-4);
+
+     PACKAGE P IS
+          TYPE FIXED_IN_P IS DELTA 1.0 RANGE -4.0 .. 4.0;
+          FOR FIXED_IN_P'SMALL USE SPECIFIED_SMALL;
+          TYPE ALT_FIXED_IN_P IS DELTA 1.0 RANGE -4.0 .. 4.0;
+     PRIVATE
+          FOR ALT_FIXED_IN_P'SMALL USE SPECIFIED_SMALL;
+     END P;
+
+     USE P;
+
+BEGIN
+
+     TEST("CD2D13A", "A SMALL CLAUSE CAN BE GIVEN IN THE VISIBLE " &
+                     "OR PRIVATE PART OF A PACKAGE FOR A FIXED " &
+                     "POINT TYPE DECLARED IN THE VISIBLE PART");
+
+     IF FIXED_IN_P'SMALL /= SPECIFIED_SMALL THEN
+          FAILED ("INCORRECT VALUE FOR FIXED_IN_P'SMALL");
+     END IF;
+
+     IF ALT_FIXED_IN_P'SMALL /= SPECIFIED_SMALL THEN
+          FAILED ("INCORRECT VALUE FOR ALT_FIXED_IN_P'SMALL");
+     END IF;
+
+     RESULT;
+
+END CD2D13A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30001.a
new file mode 100644
index 000000000..d65e14508
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30001.a
@@ -0,0 +1,284 @@
+-- CD30001.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 X'Address produces a useful result when X is an aliased
+--      object.
+--      Check that X'Address produces a useful result when X is an object of
+--      a by-reference type.
+--      Check that X'Address produces a useful result when X is an entity
+--      whose Address has been specified.
+--
+--      Check that aliased objects and subcomponents are allocated on storage
+--      element boundaries.  Check that objects and subcomponents of by
+--      reference types are allocated on storage element boundaries.
+--
+--      Check that for an array X, X'Address points at the first component
+--      of the array, and not at the array bounds.
+--   
+-- TEST DESCRIPTION:
+--      This test defines a data structure (an array of records) where each
+--      aspect of the data structure is aliased.  The test checks 'Address
+--      for each "layer" of aliased objects.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      22 JUL 95   SAIC   Initial version
+--      08 MAY 96   SAIC   Reinforced for 2.1
+--      16 FEB 98   EDS    Modified documentation
+--!
+
+----------------------------------------------------------------- CD30001_0
+
+with SPPRT13;
+package CD30001_0 is
+
+  --    Check that X'Address produces a useful result when X is an aliased
+  --    object.
+  --    Check that X'Address produces a useful result when X is an object of
+  --    a by-reference type.
+  --    Check that X'Address produces a useful result when X is an entity
+  --    whose Address has been specified.
+  --    (using the new form of "for X'Address use ...")
+  --
+  --    Check that aliased objects and subcomponents are allocated on storage
+  --    element boundaries.  Check that objects and subcomponents of by
+  --    reference types are allocated on storage element boundaries.
+
+  type Simple_Enum_Type is (Just, A, Little, Bit);
+
+  type Data is record
+    Aliased_Comp_1 : aliased Simple_Enum_Type;
+    Aliased_Comp_2 : aliased Simple_Enum_Type;
+  end record;
+
+  type Array_W_Aliased_Comps is array(1..2) of aliased Data;
+
+  Aliased_Object  : aliased Array_W_Aliased_Comps;
+
+  Specific_Object : aliased Array_W_Aliased_Comps;
+  for Specific_Object'Address use SPPRT13.Variable_Address2;  -- ANX-C RQMT.
+
+  procedure TC_Check_Aliased_Addresses;
+
+  procedure TC_Check_Specific_Addresses;
+
+  procedure TC_Check_By_Reference_Types;
+
+end CD30001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with System.Storage_Elements;
+with System.Address_To_Access_Conversions;
+package body CD30001_0 is
+
+  package Simple_Enum_Type_Ref_Conv is
+    new System.Address_To_Access_Conversions(Simple_Enum_Type);
+
+  package Data_Ref_Conv is new System.Address_To_Access_Conversions(Data);
+
+  package Array_W_Aliased_Comps_Ref_Conv is
+    new System.Address_To_Access_Conversions(Array_W_Aliased_Comps);
+
+  use type System.Address;
+  use type System.Storage_Elements.Integer_Address;
+  use type System.Storage_Elements.Storage_Offset;
+
+  procedure TC_Check_Aliased_Addresses is
+    use type Simple_Enum_Type_Ref_Conv.Object_Pointer;
+    use type Data_Ref_Conv.Object_Pointer;
+    use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer;
+
+  begin
+
+    -- Check the object Aliased_Object
+
+    if Aliased_Object'Address not in System.Address then
+      Report.Failed("Aliased_Object'Address not an address");
+    end if;
+
+    if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(Aliased_Object'Address)
+       /= Aliased_Object'Unchecked_Access then                   
+      Report.Failed
+                  ("'Unchecked_Access does not match expected address value");
+    end if;
+
+    -- Check the element Aliased_Object(1)
+
+    if Data_Ref_Conv.To_Address( Aliased_Object(1)'Access )
+       /= Aliased_Object(1)'Address then
+      Report.Failed
+             ("Array element 'Access does not match expected address value");
+    end if;
+
+    -- Check that Array'Address points at the first component...   
+
+    if Array_W_Aliased_Comps_Ref_Conv.To_Address( Aliased_Object'Access )
+       /= Aliased_Object(1)'Address then
+      Report.Failed
+        ("Address of array object does not equal address of first component");
+    end if;
+
+    -- Check the components of Aliased_Object(2)
+
+    if Simple_Enum_Type_Ref_Conv.To_Address(
+                          Aliased_Object(2).Aliased_Comp_1'Unchecked_Access)
+       not in System.Address then
+      Report.Failed("Component 2 'Unchecked_Access not a valid address");
+    end if;
+
+    if Aliased_Object(2).Aliased_Comp_2'Address not in System.Address then
+      Report.Failed("Component 2 not located at a valid address ");
+    end if;
+
+  end TC_Check_Aliased_Addresses;
+
+  procedure TC_Check_Specific_Addresses is
+    use type System.Address;
+    use type System.Storage_Elements.Integer_Address;
+    use type Simple_Enum_Type_Ref_Conv.Object_Pointer;
+    use type Data_Ref_Conv.Object_Pointer;
+    use type Array_W_Aliased_Comps_Ref_Conv.Object_Pointer;
+  begin
+
+    -- Check the object Specific_Object
+
+    if System.Storage_Elements.To_Integer(Specific_Object'Address)
+       /= System.Storage_Elements.To_Integer(SPPRT13.Variable_Address2) then
+      Report.Failed
+        ("Specific_Object not at address specified in representation clause");
+    end if;
+
+    if Array_W_Aliased_Comps_Ref_Conv.To_Pointer(SPPRT13.Variable_Address2)
+       /= Specific_Object'Unchecked_Access then
+      Report.Failed("Specific_Object'Unchecked_Access not expected value");
+    end if;
+
+    -- Check the element Specific_Object(1)
+
+    if Data_Ref_Conv.To_Address( Specific_Object(1)'Access )
+       /= Specific_Object(1)'Address then
+      Report.Failed
+        ("Specific Array element 'Access does not correspond to the "
+         & "elements 'Address");
+    end if;
+
+    -- Check that Array'Address points at the first component...
+
+    if Array_W_Aliased_Comps_Ref_Conv.To_Address( Specific_Object'Access )
+       /= Specific_Object(1)'Address then
+      Report.Failed
+        ("Address of array object does not equal address of first component");
+    end if;
+
+    -- Check the components of Specific_Object(2)
+
+    if Simple_Enum_Type_Ref_Conv.To_Address(
+                                    Specific_Object(1).Aliased_Comp_1'Access)
+                                                    not in System.Address then
+      Report.Failed("Access value of first record component for object at " &
+                    "specific address not a valid address");
+    end if;
+
+    if Specific_Object(2).Aliased_Comp_2'Address not in System.Address then
+      Report.Failed("Second record component for object at specific " &
+                    "address not located at a valid address");
+    end if;
+
+  end TC_Check_Specific_Addresses;
+
+--      Check that X'Address produces a useful result when X is an object of
+--      a by-reference type.
+
+    type Tagged_But_Not_Exciting is tagged record
+      A_Bit_Of_Data : Boolean;
+    end record;
+
+    Tagged_Object : Tagged_But_Not_Exciting;
+
+  procedure Muck_With_Addresses( It : in out Tagged_But_Not_Exciting;
+                                 Its_Address : in System.Address ) is
+  begin
+    if It'Address /= Its_Address then
+      Report.Failed("Address of object passed by reference does not " &
+                    "match address of object passed" );
+    end if;
+  end Muck_With_Addresses;
+
+  procedure TC_Check_By_Reference_Types is 
+  begin
+    Muck_With_Addresses( Tagged_Object, Tagged_Object'Address );
+  end TC_Check_By_Reference_Types;
+
+end CD30001_0;
+
+------------------------------------------------------------------- CD30001
+
+with Report;
+with CD30001_0;
+procedure CD30001 is
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD30001",
+               "Check that X'Address produces a useful result when X is " &
+               "an aliased object, or an entity whose Address has been " &
+               "specified" );
+   
+--      Check that X'Address produces a useful result when X is an aliased
+--      object.
+--
+--      Check that aliased objects and subcomponents are allocated on storage
+--      element boundaries.  Check that objects and subcomponents of by
+--      reference types are allocated on storage element boundaries.
+
+  CD30001_0.TC_Check_Aliased_Addresses;
+
+--      Check that X'Address produces a useful result when X is an entity
+--      whose Address has been specified.
+
+  CD30001_0.TC_Check_Specific_Addresses;
+
+--      Check that X'Address produces a useful result when X is an object of
+--      a by-reference type.
+
+  CD30001_0.TC_Check_By_Reference_Types;
+
+  Report.Result;
+
+end CD30001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30002.a
new file mode 100644
index 000000000..7b6fff713
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30002.a
@@ -0,0 +1,207 @@
+-- CD30002.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 implementation supports Alignments for subtypes and
+--      objects specified as factors and multiples of the number of storage
+--      elements per word, unless those values cannot be loaded and stored.
+--      Check that the largest alignment returned by default is supported.
+--
+--      Check that the implementation supports Alignments supported by the
+--      target linker for stand-alone library-level objects of statically
+--      constrained subtypes.
+--
+-- TEST DESCRIPTION:
+--      This test defines several types and objects, specifying various
+--      alignments for them (as factors and multiples of the number of
+--      storage elements per word).  It then checks the alignments by
+--      declaring some objects, and checking that the integer values of
+--      their addresses is mod the specified alignment.  This will not
+--      prevent false passes where the lucky compiler gets it right by
+--      chance, but will catch compilers that specifically do not obey
+--      the alignment clauses.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      22 JUL 95   SAIC   Initial version
+--      09 MAY 96   SAIC   Strengthened for 2.1
+--      26 FEB 97   PWB.CTA Allowed for unexpected word sizes
+--      16 FEB 98   EDS    Modified documentation.
+--      26 SEP 98   RLB    Fixed value on line 130 so check and dec. match.
+--      30 OCT 98   RLB    Split Multiple_Alignment and revised the
+--                         calculation to work on all targets.
+--      18 JAN 99   RLB    Repaired again to work on targets where word size
+--                         equals storage unit.
+--!
+
+----------------------------------------------------------------- CD30002_0
+
+with Impdef;
+with System.Storage_Elements;
+package CD30002_0 is
+
+  S_Units_per_Word : constant := System.Word_Size/System.Storage_Unit;
+	-- Must be 1 or greater.
+
+  Multiple_Type_Alignment : constant :=
+      Integer'Min ( Impdef.Max_Default_Alignment,
+                    2 * S_Units_per_Word );
+      -- Calculate a reasonable alignment, but not larger than the
+      -- implementation is required to support.
+
+  Multiple_Object_Alignment : constant :=
+      Integer'Min ( Impdef.Max_Linker_Alignment,
+                    2 * S_Units_per_Word );
+      -- Calculate a reasonable object alignment, but not larger than
+      -- the implementation is required to support.
+
+  Small_Alignment : constant :=
+      Integer'Max ( S_Units_per_Word / 2, 1);
+      -- Calculate a reasonable small alignment, but not less than 1.
+      -- (If S_Units_per_Word = 1, 1/2 => 0 which causes problems
+      -- verifying alignment.)
+
+  subtype Storage_Element is System.Storage_Elements.Storage_Element;
+
+  type Some_Stuff is array(1..S_Units_Per_Word) of Storage_Element;
+    for Some_Stuff'Alignment
+      use Impdef.Max_Default_Alignment;                       -- ANX-C RQMT.
+
+  Library_Level_Object : Some_Stuff;
+    for Library_Level_Object'Alignment
+      use Impdef.Max_Linker_Alignment;                        -- ANX-C RQMT.
+
+  type Quarter is mod 4; -- two bits
+    for Quarter'Alignment use Small_Alignment;                -- ANX-C RQMT.
+
+  type Half is mod 16; -- nibble
+    for Half'Alignment use Multiple_Type_Alignment;                -- ANX-C RQMT.
+  
+  type O_Some_Stuff is array(1..S_Units_Per_Word) of Storage_Element;
+  
+  type O_Quarter is mod 4; -- two bits
+
+  type O_Half is mod 16; -- nibble
+
+end CD30002_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+-- there is no package body CD30002_0
+
+------------------------------------------------------------------- CD30002
+
+with Report;
+with Impdef;
+with CD30002_0;
+with System.Storage_Elements;
+procedure CD30002 is
+
+  My_Stuff   : CD30002_0.Some_Stuff;
+    -- Impdef.Max_Default_Alignment
+
+  My_Quarter : CD30002_0.Quarter;
+    -- CD30002_0.S_Units_per_Word / 2
+
+  My_Half    : CD30002_0.Half;
+    -- CD30002_0.S_Units_per_Word * 2
+
+  Stuff_Object   : CD30002_0.O_Some_Stuff;
+    for Stuff_Object'Alignment
+      use Impdef.Max_Default_Alignment;                       -- ANX-C RQMT.
+
+  Quarter_Object : CD30002_0.O_Quarter;
+    for Quarter_Object'Alignment
+        use CD30002_0.Small_Alignment;                        -- ANX-C RQMT.
+
+  Half_Object    : CD30002_0.O_Half;
+    for Half_Object'Alignment
+        use CD30002_0.Multiple_Object_Alignment;              -- ANX-C RQMT.
+
+  subtype IntAdd is System.Storage_Elements.Integer_Address;
+    use type System.Storage_Elements.Integer_Address;
+
+  function A2I(Value: System.Address) return IntAdd renames
+    System.Storage_Elements.To_Integer;
+
+  NAC : constant String := " not aligned correctly";
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD30002", "Check that the implementation supports " &
+                          "Alignments for subtypes and objects specified " &
+                          "as factors and multiples of the number of " &
+                          "storage elements per word, unless those values " &
+                          "cannot be loaded and stored. Check that the " &
+                          "largest alignment returned by default is " &
+                          "supported. Check that the implementation " &
+                          "supports Alignments supported by the target " &
+                          "linker for stand-alone library-level objects " &
+                          "of statically constrained subtypes" );
+
+  if A2I(CD30002_0.Library_Level_Object'Address)
+     mod Impdef.Max_Linker_Alignment /= 0 then
+    Report.Failed("Library_Level_Object" & NAC);
+  end if;
+
+  if A2I(My_Stuff'Address) mod Impdef.Max_Default_Alignment /= 0 then
+    Report.Failed("Max alignment subtype" & NAC);
+  end if;
+
+  if A2I(My_Quarter'Address) mod (CD30002_0.Small_Alignment) /= 0 then
+    Report.Failed("Factor of words subtype" & NAC);
+  end if;
+
+  if A2I(My_Half'Address) mod (CD30002_0.Multiple_Type_Alignment) /= 0 then
+    Report.Failed("Multiple of words subtype" & NAC);
+  end if;
+
+  if A2I(Stuff_Object'Address) mod Impdef.Max_Default_Alignment /= 0 then
+    Report.Failed("Stuff alignment object" & NAC);
+  end if;
+
+  if A2I(Quarter_Object'Address) 
+       mod (CD30002_0.Small_Alignment) /= 0 then
+    Report.Failed("Factor of words object" & NAC);
+  end if;
+
+  if A2I(Half_Object'Address) mod (CD30002_0.Multiple_Object_Alignment) /= 0 then
+    Report.Failed("Multiple of words object" & NAC);
+  end if;
+
+  Report.Result;
+
+end CD30002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30003.a
new file mode 100644
index 000000000..af414490f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30003.a
@@ -0,0 +1,227 @@
+-- CD30003.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 Size clause for an object is supported if the specified
+--      size is at least as large as the subtype's size, and correspond to a
+--      size in storage elements that is a multiple of the object's (non-zero)
+--      Alignment. RM 13.3(43)
+--
+-- TEST DESCRIPTION:
+--      This test defines several types and then asserts specific sizes for
+--      the, it then checks that the size set is reported back.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      22 JUL 95   SAIC   Initial version
+--      08 MAY 96   SAIC   Corrected and strengthened for 2.1
+--      14 FEB 97   PWB.CTA Changed 'Size specifications to multiples
+--                         of System.Storage_Unit; restricted 'Size spec
+--                         for enumeration object to max integer size.
+--      16 FEB 98   EDS    Modify Documentation.
+--      25 JAN 99   RLB    Repaired to properly set and check sizes.
+--      29 JAN 99   RLB    Added Pack pragma needed for some implementations.
+--                         Corrected to support a Storage_Unit size < 8.
+--!
+
+------------------------------------------------------------------- CD30003
+
+with Report;
+with System;
+procedure CD30003 is
+
+  ---------------------------------------------------------------------------
+  -- types and subtypes
+  ---------------------------------------------------------------------------
+
+  type Bit is mod 2**1;
+  for Bit'Size use 1;                                         -- ANX-C RQMT.
+
+  type Byte is mod 2**8;
+  for Byte'Size use 8;                                        -- ANX-C RQMT.
+
+  type Smallword is mod 2**8;
+  for Smallword'size use 16;                                  -- ANX-C RQMT.
+
+  type Byte_Array is array(1..4) of Byte;
+  pragma Pack(Byte_Array);                                    -- ANX-C RQMT.
+  -- size should be 32
+
+  type Smallword_Array is array(1..4) of Smallword;
+  pragma Pack(Smallword_Array); -- Required if Storage_Unit > 16. -- ANX-C RQMT.
+
+  -- Use to calulate maximum required size:
+  type Max_Modular is mod System.Max_Binary_Modulus;
+  type Max_Integer is range System.Min_Int .. System.Max_Int;
+  Enum_Size : constant := Integer'Min (32,
+      Integer'Min (Max_Modular'Size, Max_Integer'Size));
+  type Transmission_Data is ( Empty, Input, Output, IO, Control );
+  for Transmission_Data'Size use Enum_Size;                   -- ANX-C RQMT.
+
+  -- Sizes to try:
+
+  -- The basic sizes are based on a "normal" Storage_Unit = 8 implementation.
+  -- We then use formulas to insure that the specified sizes meet the
+  -- the minimum level of support and AI-0051.
+
+  Modular_Single_Size : constant := Integer'Min (((8 + (System.Storage_Unit-1))
+     /System.Storage_Unit)*System.Storage_Unit, Max_Modular'Size);
+     -- Calulate an appropriate, legal, and required to be supported size to
+     -- try, which is the size of Byte. Note that object sizes must be
+     -- a multiple of the storage unit for the compiler.
+
+  Modular_Double_Size : constant := Integer'Min (((16 + (System.Storage_Unit-1))
+     /System.Storage_Unit)*System.Storage_Unit, Max_Modular'Size);
+
+  Modular_Quad_Size : constant := Integer'Min (((32 + (System.Storage_Unit-1))
+     /System.Storage_Unit)*System.Storage_Unit, Max_Modular'Size);
+
+  Array_Quad_Size : constant := ((4 * 8 + (System.Storage_Unit-1))
+     /System.Storage_Unit)*System.Storage_Unit;
+
+  Array_Octo_Size : constant := ((4 * 16 + (System.Storage_Unit-1))
+     /System.Storage_Unit)*System.Storage_Unit;
+
+  Rounded_Enum_Size : constant := ((Enum_Size + (System.Storage_Unit-1))
+     /System.Storage_Unit)*System.Storage_Unit;
+
+  Enum_Quad_Size : constant := Integer'Min (((32 + (System.Storage_Unit-1))
+     /System.Storage_Unit)*System.Storage_Unit,
+     Integer'Min (Max_Modular'Size, Max_Integer'Size));
+
+
+  ---------------------------------------------------------------------------
+  -- objects
+  ---------------------------------------------------------------------------
+
+  Bit_8 : Bit :=0;
+  for Bit_8'Size use System.Storage_Unit;                     -- ANX-C RQMT.
+
+  Bit_G : Bit :=0;
+  for Bit_G'Size use Modular_Double_Size;                     -- ANX-C RQMT.
+
+  Byte_8 : Byte :=0;
+  for Byte_8'Size use Modular_Single_Size;                    -- ANX-C RQMT.
+
+  Byte_G : Byte :=0;
+  for Byte_G'Size use Modular_Double_Size;                    -- ANX-C RQMT.
+
+  Smallword_1 : Smallword :=0;
+  for Smallword_1'Size use Modular_Double_Size;               -- ANX-C RQMT.
+
+  Smallword_2 : Smallword :=0;
+  for Smallword_2'Size use Modular_Quad_Size;                 -- ANX-C RQMT.
+
+  Byte_Array_1 : Byte_Array := (others=>0);
+  for Byte_Array_1'Size use Array_Quad_Size;                  -- ANX-C RQMT.
+
+  Smallword_Array_1 : Smallword_Array := (others=>0);
+  for Smallword_Array_1'Size use Array_Octo_Size;             -- ANX-C RQMT.
+
+  Transmission_Data_1 : aliased Transmission_Data := Empty;
+
+  Transmission_Data_2 : Transmission_Data := Control;
+  for Transmission_Data_2'Size use Enum_Quad_Size;            -- ANX-C RQMT.
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD30003", "Check that Size clauses are supported for " &
+                          "values at least as large as the subtypes " &
+                          "size, and correspond to a size in storage " &
+                          "elements that is a multiple of the objects " &
+                          "(non-zero) Alignment" );
+   
+  if Bit_8'Size /= System.Storage_Unit then
+    Report.Failed("Expected Bit_8'Size =" & Integer'Image(System.Storage_Unit)
+                      & " , actually =" & Integer'Image(Bit_8'Size));
+  end if;
+
+  if Bit_G'Size /= Modular_Double_Size then
+    Report.Failed("Expected Bit_G'Size =" & Integer'Image(Modular_Double_Size)
+                      & " , actually =" & Integer'Image(Bit_G'Size));
+  end if;
+
+  if Byte_8'Size /= Modular_Single_Size then
+    Report.Failed("Expected Byte_8'Size =" & Integer'Image(Modular_Single_Size)
+                      & " , actually =" & Integer'Image(Byte_8'Size));
+  end if;
+
+  if Byte_G'Size /= Modular_Double_Size then
+    Report.Failed("Expected Bit_G'Size =" & Integer'Image(Modular_Double_Size)
+                      & " , actually =" & Integer'Image(Byte_G'Size));
+  end if;
+
+  if Smallword_1'Size /= Modular_Double_Size then
+    Report.Failed("Expected Smallword_1'Size =" &
+                      Integer'Image(Modular_Double_Size) &
+                      ", actually =" & Integer'Image(Smallword_1'Size));
+  end if;
+
+  if Smallword_2'Size /= Modular_Quad_Size then
+    Report.Failed("Expected Smallword_2'Size =" &
+                      Integer'Image(Modular_Quad_Size) &
+                      ", actually =" & Integer'Image(Smallword_2'Size));
+  end if;
+
+  if Byte_Array_1'Size /= Array_Quad_Size then
+    Report.Failed("Expected Byte_Array_1'Size =" &
+                      Integer'Image(Array_Quad_Size) &
+                      ", actually =" & Integer'Image(Byte_Array_1'Size));
+  end if;
+
+  if Smallword_Array_1'Size /= Array_Octo_Size then
+    Report.Failed(
+      "Expected Smallword_Array_1'Size =" &
+                      Integer'Image(Array_Octo_Size) &
+                      ", actually =" & Integer'Image(Smallword_Array_1'Size));
+  end if;
+
+  if Transmission_Data_1'Size /= Enum_Size and then
+     Transmission_Data_1'Size /= Rounded_Enum_Size then
+    Report.Failed(
+      "Expected Transmission_Data_1'Size =" & Integer'Image(Rounded_Enum_Size) &
+                      ", actually =" & Integer'Image(Transmission_Data_1'Size));
+  end if;
+
+  if Transmission_Data_2'Size /= Enum_Quad_Size then
+    Report.Failed(
+      "Expected Transmission_Data_2'Size =" & Integer'Image(Enum_Quad_Size) &
+                      ", actually =" & Integer'Image(Transmission_Data_2'Size));
+  end if;
+
+  Report.Result;
+
+end CD30003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30004.a
new file mode 100644
index 000000000..1a1bcff1f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd30004.a
@@ -0,0 +1,215 @@
+-- CD30004.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 unspecified Size of static discrete
+--      subtypes is the number of bits needed to represent each value
+--      belonging to the subtype using an unbiased representation, where
+--      space for a sign bit is provided only in the event the subtype
+--      contains negative values.  Check that for first subtypes specified
+--      Sizes are supported reflecting this representation. [ARM 95 13.3(55)].
+--
+-- TEST DESCRIPTION:
+--      This test defines a few types that should have distinctly recognizable
+--      sizes.  A packed record which should result in very specific bits
+--      sizes for it's components is used to check the first part of the
+--      objective. The second part of the objective is checked by giving
+--	sizes for a similar set of types.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+-- CHANGE HISTORY:
+--      22 JUL 95   SAIC   Initial version
+--      06 MAY 96   SAIC   Revised for 2.1
+--      26 FEB 97   PWB.CTA Added pragma Pack for type Check_Record
+--      16 FEB 98   EDS    Modified Documentation.
+--      06 JUL 99   RLB    Repaired comments, removed junk test cases.
+--                         Added test cases to test that appropriate Size
+--                         clauses are allowed.
+
+--!
+----------------------------------------------------------------- CD30004_0
+
+package CD30004_0 is
+
+--      Check that the unspecified Size of static discrete and fixed point
+--      subtypes are the number of bits needed to represent each value
+--      belonging to the subtype using an unbiased representation, where
+--      space for a sign bit is provided only in the event the subtype
+--      contains negative values.  Check that for first subtypes specified
+--      Sizes are supported reflecting this representation.
+
+  type Bits_2 is ( Zeroth_Bit, Fiercest_Bit, Secants_Bit, Threadless_Bit );
+
+  type Bits_3 is range 0..2**3-1;
+
+  type Bits_5 is range -2**4+1..2**4-1;  -- allow for 1's comp
+
+  type Bits_14 is mod 2**14;
+
+  type Check_Record is
+  record
+    B14 : Bits_14;
+    B2  : Bits_2;
+    B3  : Bits_3;
+    B5  : Bits_5;
+    C   : Character;
+  end record;
+  pragma Pack ( Check_Record );
+
+  procedure TC_Check_Values;
+  procedure TC_Check_Specified_Sizes;
+
+end CD30004_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+with Report;
+with Impdef;
+package body CD30004_0 is
+
+  procedure TC_Check_Values is
+  begin
+
+    if Bits_2'Size /= 2 then
+      if Impdef.Validating_Annex_C then
+         Report.Failed("Bits_2'Size not 2 bits");
+      else -- Recommended levels of support are not binding.
+         Report.Comment("Bits_2'Size not 2 bits");
+      end if;
+    end if;
+
+    if Bits_14'Size /= 14 then
+      if Impdef.Validating_Annex_C then
+         Report.Failed("Bits_14'Size not 14 bits");
+      else
+         Report.Comment("Bits_14'Size not 14 bits");
+      end if;
+    end if;
+
+    if Bits_3'Size /= 3 then
+      if Impdef.Validating_Annex_C then
+         Report.Failed("Bits_3'Size not 3 bits");
+      else
+         Report.Comment("Bits_3'Size not 3 bits");
+      end if;
+    end if;
+
+    if Bits_5'Size /= 5 then
+      if Impdef.Validating_Annex_C then
+         Report.Failed("Bits_5'Size not 5 bits");
+      else
+         Report.Comment("Bits_5'Size not 5 bits");
+      end if;
+    end if;
+
+    if Character'Size /= 8 then
+      Report.Failed("Character'Size not 8 bits");
+    end if;
+
+    if Wide_Character'Size /= 16 then
+      Report.Failed("Wide_Character'Size not 16 bits");
+    end if;
+
+  end TC_Check_Values;
+
+  type Spec_Bits_2 is ( Zeroth_Bit, Fiercest_Bit, Secants_Bit, Threadless_Bit );
+  for Spec_Bits_2'Size use 2;                            -- ANX-C RQMT.
+
+  type Spec_Bits_3 is range 0..2**3-1;
+  for Spec_Bits_3'Size use 3;                            -- ANX-C RQMT.
+
+  type Spec_Bits_5 is range -2**4+1..2**4-1;  -- allow for 1's comp
+  for Spec_Bits_5'Size use 5;                            -- ANX-C RQMT.
+
+  type Spec_Bits_14 is mod 2**14;
+  for Spec_Bits_14'Size use 14;                          -- ANX-C RQMT.
+
+  type Spec_Record is new Check_Record;
+  for Spec_Record'Size use 64;                           -- ANX-C RQMT.
+
+  procedure TC_Check_Specified_Sizes is
+
+  begin
+
+    if Spec_Record'Size /= 64 then
+      Report.Failed("Spec_Record'Size not 64 bits");
+    end if;
+
+    if Spec_Bits_2'Size /= 2 then
+      Report.Failed("Spec_Bits_2'Size not 2 bits");
+    end if;
+
+    if Spec_Bits_14'Size /= 14 then
+      Report.Failed("Spec_Bits_14'Size not 14 bits");
+    end if;
+
+    if Spec_Bits_3'Size /= 3 then
+      Report.Failed("Spec_Bits_3'Size not 3 bits");
+    end if;
+
+    if Spec_Bits_5'Size /= 5 then
+      Report.Failed("Spec_Bits_5'Size not 5 bits");
+    end if;
+
+  end TC_Check_Specified_Sizes;
+
+end CD30004_0;
+
+------------------------------------------------------------------- CD30004
+
+with Report;
+with CD30004_0;
+
+procedure CD30004 is
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD30004", "Check that the unspecified Size of static " &
+               "discrete and fixed point subtypes is the number of bits " &
+               "needed to represent each value belonging to the subtype " &
+               "using an unbiased representation, where space for a sign " &
+               "bit is provided only in the event the subtype contains " &
+               "negative values.  Check that for first subtypes " &
+               "specified Sizes are supported reflecting this " &
+               "representation.");
+
+  CD30004_0.TC_Check_Values;
+
+  CD30004_0.TC_Check_Specified_Sizes;
+
+  Report.Result;
+
+end CD30004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd300050.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd300050.am
new file mode 100644
index 000000000..81b6e3354
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd300050.am
@@ -0,0 +1,154 @@
+-- CD30005.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 Address clauses are supported for imported subprograms.
+--
+-- TEST DESCRIPTION:
+--      This test imports a simple C function and specifies it's location.
+--
+--      The implementation may choose to implement
+--      Impdef.CD30005_1_Foreign_Address so as to dynamically call a C
+--      function that returns the appropriate address for the external
+--      function identified by Impdef.CD30005_1_External_Name.
+--
+-- TEST FILES:
+--         CD300050.AM
+--         CD300051.C  -- the C function:  (included below for reference)
+--
+-- SPECIAL REQUIREMENTS:
+--      The file CD300051.C must be compiled with a C compiler.
+--      Implementation dialects of C may require alteration of the C program
+--      syntax.  The program is included here for reference:
+--
+--            int _cd30005_1( Value )
+--            {
+--               /* int Value */
+--
+--               return Value + 1;
+--            }
+--
+--      Implementations may require special linkage commands to include the
+--      C code.
+--
+-- APPLICABILITY CRITERIA:
+--    This test is not applicable to implementations not providing an interface
+--    to C language units.  OTHERWISE:
+--
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      22 JUL 95   SAIC   Initial version
+--      30 APR 96   SAIC   Added commentary for 2.1
+--      09 MAY 96   SAIC   Changed reporting for 2.1
+--      04 NOV 96   SAIC   Added use type System.Address
+--      16 FEB 98   EDS    Modified documentation.
+--      29 JUN 98   EDS    Modified main program name.
+--!
+
+----------------------------------------------------------------- CD30005_0
+
+with Impdef;
+package CD30005_0 is
+
+--      Check that Address clauses are supported for imported subprograms.
+
+  type External_Func_Ref is access function(N:Integer) return Integer;
+    pragma Convention( C, External_Func_Ref );
+
+
+  function CD30005_1( I: Integer ) return Integer;
+
+    pragma Import( C, CD30005_1,
+                   Impdef.CD30005_1_External_Name );          -- N/A => ERROR.
+
+      for CD30005_1'Address use
+        Impdef.CD30005_1_Foreign_Address;                     -- ANX-C RQMT.
+
+  procedure TC_Check_Imports;
+
+end CD30005_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+with System.Storage_Elements;
+with System.Address_To_Access_Conversions;
+package body CD30005_0 is
+
+  use type System.Address;
+
+  procedure TC_Check_Imports is
+    S   : External_Func_Ref := CD30005_1'Access;
+    I,K : Integer := 99;
+  begin
+
+    K := S.all(I);
+    if K /= 100 then
+      Report.Failed("C program returned" & Integer'Image(K));
+    end if;
+
+    I := CD30005_1( I );
+    if I /= 100 then
+      Report.Failed("C program returned" & Integer'Image(I));
+    end if;
+
+    if CD30005_1'Address /= Impdef.CD30005_1_Foreign_Address then
+      Report.Failed("Address not that specified");
+    end if;
+
+  end TC_Check_Imports;
+
+end CD30005_0;
+
+------------------------------------------------------------------- CD300050
+
+with Report;
+with CD30005_0;
+
+procedure CD300050 is
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD30005",
+               "Check that Address clauses are supported for imported " &
+               "subprograms" );
+   
+--      Check that Address clauses are supported for imported subprograms.
+
+  CD30005_0.TC_Check_Imports;
+
+  Report.Result;
+
+end CD300050;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd300051.c b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd300051.c
new file mode 100644
index 000000000..5771fc81b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd300051.c
@@ -0,0 +1,57 @@
+/*
+-- CD30051.C                                                            
+--                                                                       
+--                             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.
+--*
+--                                                                       
+-- FUNCTION NAME: _cd3005_1
+--                                                                       
+-- FUNCTION DESCRIPTION:                                                 
+--      This C function returns the sum of its parameter and 1 through
+--      the function name.  The parameter is unchanged.
+--
+-- INPUTS:
+--      This function requires that one parameter, of type int, be passed 
+--      to it.
+--
+-- PROCESSING:
+--      The function will calculate the sum of its parameter and 1
+--      and return this value as the function result through the function
+--      name.
+--
+-- OUTPUTS:                        
+--      The sum of the parameter and 1 is returned through function name. 
+--                                                                       
+-- CHANGE HISTORY:                                                       
+--      12 Oct 95   SAIC    Initial prerelease version.                  
+--      14 Feb 97   PWB.CTA Created this file from code appearing in
+--                          CD30005.A (as comments).
+--!
+*/
+            int _cd30005_1( Value )
+            {
+                /* int Value */
+
+               return Value + 1;
+            }
+                                                                         
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014a.ada
new file mode 100644
index 000000000..ee37df82a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014a.ada
@@ -0,0 +1,132 @@
+-- CD3014A.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 ENUMERATION TYPE WITH A REPRESENTATION CLAUSE CAN
+--     BE USED CORRECTLY IN ORDERING RELATIONS, INDEXING ARRAYS, AND IN
+--     GENERIC INSTANTIATIONS.
+
+-- HISTORY
+--     DHH 09/30/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     BCB 03/07/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
+--                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
+--                   REVISED CHECK FOR ARRAY INDEXING.
+--     THS 09/18/90  REVISED WORDING IN HEADER AND MODIFIED FAILED ERROR
+--                   MESSAGE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD3014A IS
+
+BEGIN
+
+     TEST ("CD3014A", "CHECK THAT AN ENUMERATION TYPE WITH A " &
+                      "REPRESENTATION CLAUSE CAN BE USED CORRECTLY " &
+                      "IN ORDERING RELATIONS, INDEXING ARRAYS, AND " &
+                      "IN GENERIC INSTANTIATIONS");
+
+     DECLARE
+          PACKAGE PACK IS
+
+               TYPE HUE IS (RED,BLUE,YELLOW,'R','B','Y');
+
+               FOR HUE USE (RED => 8, BLUE => 9,
+                            YELLOW => 10, 'R' => 11,
+                            'B' => 12, 'Y' => 13);
+
+               TYPE BASE IS ARRAY(HUE) OF INTEGER;
+               COLOR,BASIC : HUE;
+               BARRAY : BASE;
+
+               TYPE HUE1 IS ('Y','B','R',YELLOW,BLUE,RED);
+
+               FOR HUE1 USE ('Y' => 10, 'B' => 14, 'R' => 16,
+                             YELLOW => 19, BLUE => 41, RED => 46);
+
+               TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
+               COLOR1,BASIC1 : HUE1;
+               BARRAY1 : BASE1;
+
+               GENERIC
+                    TYPE ENUM IS (<>);
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM);
+
+          END PACK;
+
+          PACKAGE BODY PACK IS
+
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
+                    T : ENUM;
+               BEGIN
+                    T := X;
+                    X := Y;
+                    Y := T;
+               END CHANGE;
+
+               PROCEDURE PROC IS NEW CHANGE(HUE);
+               PROCEDURE PROC1 IS NEW CHANGE(HUE1);
+
+          BEGIN
+               BASIC := RED;
+               COLOR := HUE'SUCC(BASIC);
+               BASIC1 := RED;
+               COLOR1 := HUE1'PRED(BASIC1);
+               IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
+                  COLOR > 'B') OR
+                  NOT (COLOR1 < BASIC1 AND BASIC1 >= 'R' AND
+                  'Y' <= COLOR1 AND COLOR1 > 'B') THEN
+                    FAILED("ORDERING RELATIONS ARE INCORRECT");
+               END IF;
+
+               PROC(BASIC,COLOR);
+               PROC1(BASIC1,COLOR1);
+
+               IF COLOR /= RED OR COLOR1 /= RED THEN
+                    FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
+                           "GENERIC UNIT NOT CORRECT AFTER CALL");
+               END IF;
+
+               BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
+                         IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
+
+               BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
+                         IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
+
+               IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
+                   BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
+                   BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
+                  NOT (BARRAY1 (RED) = 6 AND BARRAY1 (BLUE) = 5 AND
+                   BARRAY1 (YELLOW) = 4 AND BARRAY1 ('R') = 3 AND
+                   BARRAY1 ('B') = 2 AND BARRAY1 ('Y') = 1)
+                  THEN
+                    FAILED("INDEXING ARRAY FAILURE");
+               END IF;
+
+          END PACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3014A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014c.ada
new file mode 100644
index 000000000..9e8af8980
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014c.ada
@@ -0,0 +1,85 @@
+-- CD3014C.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 ENUMERATION REPRESENTATION CLAUSE CAN BE GIVEN IN
+--     THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE DECLARED IN
+--     THE VISIBLE PART.
+
+-- HISTORY
+--     DHH 09/30/87 CREATED ORIGINAL TEST
+--     DHH 03/27/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA',CHANGED
+--                   FROM 'A' TEST TO 'C' TEST AND ADDED CHECK FOR
+--                   REPRESENTATION CLAUSE.
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;        -- CONTAINS CALL TO 'FAILED'
+PROCEDURE CD3014C IS
+
+BEGIN
+
+     TEST ("CD3014C", "CHECK THAT AN ENUMERATION " &
+                      "REPRESENTATION CLAUSE CAN BE GIVEN IN THE " &
+                      "VISIBLE OR PRIVATE PART OF A PACKAGE FOR " &
+                      "A TYPE DECLARED IN THE VISIBLE PART");
+
+     DECLARE
+          PACKAGE PACK IS
+
+               TYPE HUE IS (RED,BLUE,YELLOW);
+               TYPE NEWHUE IS (RED,BLUE,YELLOW);
+
+               FOR HUE USE
+                         (RED => 8, BLUE => 16,
+                                      YELLOW => 32);
+               A : HUE := BLUE;
+          PRIVATE
+
+               FOR NEWHUE USE (RED => 8, BLUE => 16, YELLOW => 32);
+
+               B : NEWHUE := RED;
+
+               TYPE INT_HUE IS RANGE 8 .. 32;
+               FOR INT_HUE'SIZE USE HUE'SIZE;
+
+               TYPE INT_NEW IS RANGE 8 .. 32;
+               FOR INT_NEW'SIZE USE NEWHUE'SIZE;
+
+               PROCEDURE CHECK_HUE IS NEW ENUM_CHECK(HUE, INT_HUE);
+               PROCEDURE CHECK_NEW IS NEW ENUM_CHECK(NEWHUE, INT_NEW);
+
+          END PACK;
+
+          PACKAGE BODY PACK IS
+          BEGIN
+               CHECK_HUE (RED, 8, "HUE");
+               CHECK_NEW (YELLOW, 32, "NEWHUE");
+          END PACK;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3014C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014d.ada
new file mode 100644
index 000000000..6ce3f4ce8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014d.ada
@@ -0,0 +1,135 @@
+-- CD3014D.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 ENUMERATION TYPE WITH A REPRESENTATION CLAUSE IN A
+--     GENERIC UNIT CAN BE USED CORRECTLY IN ORDERING RELATIONS,
+--     INDEXING ARRAYS, AND IN GENERIC INSTANTIATIONS.
+
+-- HISTORY
+--     DHH 09/30/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     BCB 03/07/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
+--                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
+--                   REVISED CHECK FOR ARRAY INDEXING.
+--     THS 09/18/90  REVISED WORDING IN HEADER AND MODIFIED FAILED ERROR
+--                   MESSAGE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD3014D IS
+
+BEGIN
+
+     TEST ("CD3014D", "CHECK THAT AN ENUMERATION TYPE WITH A " &
+                      "REPRESENTATION CLAUSE IN A GENERIC UNIT CAN " &
+                      "BE USED CORRECTLY IN ORDERING RELATIONS, " &
+                      "INDEXING ARRAYS, AND IN GENERIC INSTANTIATIONS");
+
+     DECLARE
+
+          GENERIC
+          PACKAGE GENPACK IS
+
+               TYPE HUE IS (RED,BLUE,YELLOW,'R','B','Y');
+
+               FOR HUE USE (RED => 8, BLUE => 9, YELLOW => 10,
+                            'R' => 11, 'B' => 12, 'Y' => 13);
+
+               TYPE HUE1 IS ('Y','B','R',YELLOW,BLUE,RED);
+
+               FOR HUE1 USE ('Y' => 10, 'B' => 14, 'R' => 16,
+                             YELLOW => 19, BLUE => 41, RED => 46);
+
+               TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
+               COLOR1,BASIC1 : HUE1;
+               BARRAY1 : BASE1;
+
+               TYPE BASE IS ARRAY(HUE) OF INTEGER;
+               COLOR,BASIC : HUE;
+               BARRAY : BASE;
+
+               GENERIC
+                    TYPE ENUM IS (<>);
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM);
+
+          END GENPACK;
+
+          PACKAGE BODY GENPACK IS
+
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
+                    T : ENUM;
+               BEGIN
+                    T := X;
+                    X := Y;
+                    Y := T;
+               END CHANGE;
+
+               PROCEDURE PROC IS NEW CHANGE(HUE);
+               PROCEDURE PROC1 IS NEW CHANGE(HUE1);
+
+          BEGIN
+               BASIC := RED;
+               COLOR := HUE'SUCC(BASIC);
+               BASIC1 := RED;
+               COLOR1 := HUE1'PRED(BASIC1);
+               IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
+                  COLOR > 'B') OR
+                  NOT (COLOR1 < BASIC1 AND BASIC1 >= 'R' AND
+                  'Y' <= COLOR1 AND COLOR1 > 'B') THEN
+                    FAILED("ORDERING RELATIONS ARE INCORRECT");
+               END IF;
+
+               PROC(BASIC,COLOR);
+               PROC1(BASIC1,COLOR1);
+
+               IF COLOR /= RED OR COLOR1 /= RED THEN
+                    FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
+                           "GENERIC UNIT NOT CORRECT AFTER CALL");
+               END IF;
+
+               BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
+                         IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
+
+               BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
+                         IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
+
+               IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
+                   BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
+                   BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
+                  NOT (BARRAY1 (RED) = 6 AND BARRAY1 (BLUE) = 5 AND
+                   BARRAY1 (YELLOW) = 4 AND BARRAY1 ('R') = 3 AND
+                   BARRAY1 ('B') = 2 AND BARRAY1 ('Y') = 1)
+                  THEN
+                    FAILED("INDEXING ARRAY FAILURE");
+               END IF;
+
+          END GENPACK;
+
+          PACKAGE P IS NEW GENPACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3014D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014f.ada
new file mode 100644
index 000000000..430cc4b2d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3014f.ada
@@ -0,0 +1,88 @@
+-- CD3014F.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 ENUMERATION REPRESENTATION CLAUSE CAN BE GIVEN
+--     IN THE VISIBLE OR PRIVATE PART OF A GENERIC PACKAGE FOR A
+--     TYPE DECLARED IN THE VISIBLE PART.
+
+-- HISTORY
+--     DHH 09/30/87  CREATED ORIGINAL TEST
+--     DHH 03/29/89  CHANGED FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
+--                   '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
+--     RJW 09/18/89  REMOVED THE COMMENT "-- N/A => ERROR.".
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD3014F IS
+
+BEGIN
+
+     TEST ("CD3014F", "CHECK THAT AN ENUMERATION REPRESENTATION " &
+                      "CLAUSE CAN BE GIVEN IN THE VISIBLE " &
+                      "OR PRIVATE PART OF A GENERIC PACKAGE FOR " &
+                      "A TYPE DECLARED IN THE VISIBLE PART");
+
+     DECLARE
+
+          GENERIC
+          PACKAGE GENPACK IS
+
+               TYPE HUE IS (RED,BLUE,YELLOW,'R','B','Y');
+               TYPE NEWHUE IS (RED,BLUE,YELLOW,'R','B','Y');
+
+               FOR HUE USE (RED => 8, BLUE => 9, YELLOW => 10,
+                   'R' => 11, 'B' => 12, 'Y' => 13);
+               A : HUE := BLUE;
+
+               TYPE INT1 IS RANGE 8 .. 13;
+               FOR INT1'SIZE USE HUE'SIZE;
+
+          PRIVATE
+
+               FOR NEWHUE USE (RED => 2, BLUE => 4, YELLOW => 6,
+                   'R' => 8, 'B' => 10, 'Y' => 12);
+
+               B : NEWHUE := RED;
+               TYPE INT2 IS RANGE 2 .. 12;
+               FOR INT2'SIZE USE NEWHUE'SIZE;
+
+               PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
+               PROCEDURE CHECK_2 IS NEW ENUM_CHECK(NEWHUE, INT2);
+          END GENPACK;
+
+          PACKAGE BODY GENPACK IS
+          BEGIN
+               CHECK_1 ('B', 12, "HUE");
+               CHECK_2 ('B', 10, "NEWHUE");
+          END GENPACK;
+
+          PACKAGE P IS NEW GENPACK;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3014F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015a.ada
new file mode 100644
index 000000000..34b930db0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015a.ada
@@ -0,0 +1,133 @@
+-- CD3015A.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 ENUMERATION TYPE CAN BE USED CORRECTLY IN
+--     ORDERING RELATIONS, INDEXING ARRAYS, AND IN GENERIC
+--     INSTANTIATIONS, WHEN THERE IS NO ENUMERATION CLAUSE FOR THE
+--     PARENT.
+
+-- HISTORY
+--     DHH 09/30/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     BCB 03/08/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
+--                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
+--                   REVISED CHECK FOR ARRAY INDEXING.
+--     THS 09/18/90  REVISED WORDING IN HEADER COMMENT AND FIXED FAILURE
+--                   ERROR MESSAGE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD3015A IS
+
+BEGIN
+
+     TEST ("CD3015A", "CHECK THAT A DERIVED ENUMERATION TYPE CAN BE " &
+                      "USED CORRECTLY IN ORDERING RELATIONS, " &
+                      "INDEXING ARRAYS, AND IN GENERIC " &
+                      "INSTANTIATIONS, WHEN THERE IS NO ENUMERATION " &
+                      "CLAUSE FOR THE PARENT");
+
+     DECLARE
+          PACKAGE PACK IS
+
+               TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
+
+               TYPE HUE IS NEW MAIN;
+               FOR HUE USE (RED => 8, BLUE => 9, YELLOW => 10,
+                            'R' => 11, 'B' => 12, 'Y' => 13);
+
+               TYPE BASE IS ARRAY(HUE) OF INTEGER;
+               COLOR,BASIC : HUE;
+               BARRAY : BASE;
+
+               TYPE HUE1 IS NEW MAIN;
+               FOR HUE1 USE (RED => 10, BLUE => 14, YELLOW => 16,
+                            'R' => 19, 'B' => 41, 'Y' => 46);
+
+               TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
+               COLOR1,BASIC1 : HUE1;
+               BARRAY1 : BASE1;
+
+               GENERIC
+                    TYPE ENUM IS (<>);
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM);
+
+          END PACK;
+
+          PACKAGE BODY PACK IS
+
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
+                    T : ENUM;
+               BEGIN
+                    T := X;
+                    X := Y;
+                    Y := T;
+               END CHANGE;
+
+               PROCEDURE PROC IS NEW CHANGE(HUE);
+               PROCEDURE PROC1 IS NEW CHANGE(HUE1);
+
+          BEGIN
+               BASIC := RED;
+               COLOR := HUE'SUCC(BASIC);
+               BASIC1 := RED;
+               COLOR1 := HUE1'SUCC(BASIC1);
+               IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
+                  COLOR > 'B') OR
+                  NOT (COLOR1 >= BASIC1 AND BASIC1 < 'R' AND
+                  'Y' > COLOR1 AND COLOR1 <= 'B') THEN
+                    FAILED("ORDERING RELATIONS ARE INCORRECT");
+               END IF;
+
+               PROC(BASIC,COLOR);
+               PROC1(BASIC1,COLOR1);
+
+               IF COLOR /= RED OR COLOR1 /= RED THEN
+                    FAILED("VALUES IN PARAMETERS TO INSTANCE OF " &
+                           "GENERIC UNIT NOT CORRECT AFTER CALL");
+               END IF;
+
+               BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
+                         IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
+
+               BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
+                         IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
+
+               IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
+                   BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
+                   BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
+                  NOT (BARRAY1 (RED) = 1 AND BARRAY1 (BLUE) = 2 AND
+                   BARRAY1 (YELLOW) = 3 AND BARRAY1 ('R') = 4 AND
+                   BARRAY1 ('B') = 5 AND BARRAY1 ('Y') = 6)
+                  THEN
+                    FAILED("INDEXING ARRAY FAILURE");
+               END IF;
+
+          END PACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3015A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015c.ada
new file mode 100644
index 000000000..c4ed23801
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015c.ada
@@ -0,0 +1,82 @@
+-- CD3015C.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 ENUMERATION REPRESENTATION CLAUSE FOR A DERIVED
+--     TYPE CAN BE GIVEN IN THE VISIBLE OR PRIVATE PART OF A PACKAGE
+--     FOR A DERIVED TYPE DECLARED IN THE VISIBLE PART, WHERE NO
+--     ENUMERATION CLAUSE HAS BEEN GIVEN FOR THE PARENT.
+
+-- HISTORY
+--     DHH  10/01/87  CREATED ORIGINAL TEST
+--     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
+--                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD3015C IS
+
+BEGIN
+
+     TEST ("CD3015C", "CHECK THAT AN ENUMERATION " &
+                      "REPRESENTATION CLAUSE FOR A DERIVED TYPE CAN " &
+                      "BE GIVEN IN THE VISIBLE OR PRIVATE PART OF A " &
+                      "PACKAGE FOR A DERIVED TYPE DECLARED IN THE " &
+                      "VISIBLE PART, WHERE NO ENUMERATION CLAUSE HAS " &
+                      "BEEN GIVEN FOR THE PARENT");
+
+     DECLARE
+          PACKAGE PACK IS
+
+               TYPE MAIN IS (RED,BLUE,YELLOW);
+
+               TYPE HUE IS NEW MAIN;
+               TYPE NEWHUE IS NEW MAIN;
+
+               FOR HUE USE (RED => 1, BLUE => 16, YELLOW => 32);
+          PRIVATE
+               FOR NEWHUE USE (RED => 16, BLUE => 17, YELLOW => 18);
+
+               TYPE INT1 IS RANGE 1 .. 32;
+               FOR INT1'SIZE USE HUE'SIZE;
+
+               TYPE INT2 IS RANGE 16 .. 18;
+               FOR INT2'SIZE USE NEWHUE'SIZE;
+
+               PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
+               PROCEDURE CHECK_2 IS NEW ENUM_CHECK(NEWHUE, INT2);
+          END PACK;
+
+          PACKAGE BODY PACK IS
+
+          BEGIN
+               CHECK_1 (RED, 1, "HUE");
+               CHECK_2 (YELLOW, 18, "NEWHUE");
+          END PACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3015C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015e.ada
new file mode 100644
index 000000000..f0de7be60
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015e.ada
@@ -0,0 +1,130 @@
+-- CD3015E.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 THERE IS NO ENUMERATION CLAUSE FOR THE PARENT
+--     TYPE IN A GENERIC UNIT, THE DERIVED TYPE CAN BE USED CORRECTLY
+--     IN ORDERING RELATIONS, INDEXING ARRAYS, AND IN GENERIC
+--     INSTANTIATIONS.
+
+-- HISTORY
+--     DHH 10/05/87 CREATED ORIGINAL TEST
+--     DHH 03/30/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND ADDED
+--                  CHECK FOR REPRESENTATION CLAUSE.
+--     RJW 03/20/90 MODIFIED CHECK FOR ARRAY INDEXING.
+--     THS 09/18/90 REVISED WORDING ON FAILURE ERROR MESSAGE.
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;                        -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD3015E IS
+
+BEGIN
+
+     TEST ("CD3015E", "CHECK THAT WHEN THERE " &
+                      "IS NO ENUMERATION CLAUSE FOR THE PARENT " &
+                      "TYPE IN A GENERIC UNIT, THE " &
+                      "DERIVED TYPE CAN BE USED CORRECTLY IN " &
+                      "ORDERING RELATIONS, INDEXING ARRAYS, AND IN " &
+                      "GENERIC INSTANTIATIONS");
+
+     DECLARE
+
+          GENERIC
+          PACKAGE GENPACK IS
+
+               TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
+
+               TYPE HUE IS NEW MAIN;
+               FOR HUE USE
+                         (RED => 1, BLUE => 6,
+                               YELLOW => 11, 'R' => 16,
+                               'B' => 22, 'Y' => 30);
+
+               TYPE BASE IS ARRAY(HUE) OF INTEGER;
+               COLOR,BASIC : HUE;
+               BARRAY : BASE;
+               T : INTEGER := 1;
+
+               TYPE INT1 IS RANGE 1 .. 30;
+               FOR INT1'SIZE USE HUE'SIZE;
+
+               PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
+
+               GENERIC
+                    TYPE ENUM IS (<>);
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM);
+
+          END GENPACK;
+
+          PACKAGE BODY GENPACK IS
+
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
+                    T : ENUM;
+               BEGIN
+                    T := X;
+                    X := Y;
+                    Y := T;
+               END CHANGE;
+
+               PROCEDURE PROC IS NEW CHANGE(HUE);
+
+          BEGIN
+               BASIC := RED;
+               COLOR := HUE'SUCC(BASIC);
+               IF (COLOR < BASIC OR
+                        BASIC >= 'R' OR
+                        'Y' <= COLOR OR
+                        COLOR > 'B') THEN
+                    FAILED("ORDERING RELATIONS ARE INCORRECT");
+               END IF;
+
+               PROC(BASIC,COLOR);
+
+               IF COLOR /= RED THEN
+                    FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
+                           "GENERIC UNIT NOT CORRECT AFTER CALL");
+               END IF;
+
+               FOR I IN HUE LOOP
+                    BARRAY(I) := IDENT_INT(T);
+                    T := T + 1;
+               END LOOP;
+
+               IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
+                   BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
+                   BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) THEN
+                    FAILED("INDEXING ARRAY FAILURE");
+               END IF;
+
+               CHECK_1 (YELLOW, 11, "HUE");
+
+          END GENPACK;
+
+          PACKAGE P IS NEW GENPACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3015E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015f.ada
new file mode 100644
index 000000000..61e93ec49
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015f.ada
@@ -0,0 +1,93 @@
+-- CD3015F.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 ENUMERATION REPRESENTATION CLAUSE FOR A DERIVED
+--     TYPE CAN BE GIVEN IN THE VISIBLE OR PRIVATE PART OF A GENERIC
+--     PACKAGE FOR A DERIVED TYPE DECLARED IN THE VISIBLE PART, WHERE
+--     NO ENUMERATION CLAUSE HAS BEEN GIVEN FOR THE PARENT.
+
+-- HISTORY
+--     DHH 10/01/87 CREATED ORIGINAL TEST
+--     DHH 03/27/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA',CHANGED
+--                   FROM 'A' TEST TO 'C' TEST AND ADDED CHECK FOR
+--                   REPRESENTATION CLAUSE.
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;            -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD3015F IS
+
+BEGIN
+
+     TEST ("CD3015F", "CHECK THAT AN " &
+                      "ENUMERATION REPRESENTATION CLAUSE FOR A " &
+                      "DERIVED TYPE CAN BE GIVEN IN THE VISIBLE OR " &
+                      "PRIVATE PART OF A GENERIC PACKAGE FOR A " &
+                      "DERIVED TYPE DECLARED IN THE VISIBLE PART, " &
+                      "WHERE NO ENUMERATION CLAUSE HAS BEEN GIVEN " &
+                      "FOR THE PARENT");
+
+     DECLARE
+
+          GENERIC
+          PACKAGE GENPACK IS
+
+               TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
+
+               TYPE HUE IS NEW MAIN;
+               TYPE NEWHUE IS NEW MAIN;
+
+               FOR HUE USE (RED => 8, BLUE => 9, YELLOW => 10,
+                     'R' => 11, 'B' => 12, 'Y' => 13);
+
+          PRIVATE
+               FOR NEWHUE USE (RED => 8, BLUE => 9, YELLOW => 10,
+                     'R' => 11, 'B' => 12, 'Y' => 13);
+
+               TYPE INT_HUE IS RANGE 8 .. 13;
+               FOR INT_HUE'SIZE USE HUE'SIZE;
+
+               TYPE INT_NEW IS RANGE 8 .. 13;
+               FOR INT_NEW'SIZE USE NEWHUE'SIZE;
+
+               PROCEDURE CHECK_HUE IS NEW ENUM_CHECK(HUE, INT_HUE);
+               PROCEDURE CHECK_NEW IS NEW ENUM_CHECK(NEWHUE, INT_NEW);
+
+          END GENPACK;
+
+          PACKAGE BODY GENPACK IS
+
+          BEGIN
+               CHECK_HUE (RED, 8, "HUE");
+               CHECK_HUE ('R', 11, "NEWHUE");
+          END GENPACK;
+
+          PACKAGE P IS NEW GENPACK;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3015F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015g.ada
new file mode 100644
index 000000000..9158dc64b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015g.ada
@@ -0,0 +1,136 @@
+-- CD3015G.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 ENUMERATION TYPE WITH A REPRESENTATION
+--     CLAUSE CAN BE USED CORRECTLY IN ORDERING RELATIONS, INDEXING
+--     ARRAYS, AND IN GENERIC INSTANTIATIONS WHEN THERE IS AN
+--     ENUMERATION CLAUSE FOR THE PARENT.
+
+-- HISTORY
+--     DHH 09/30/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     BCB 03/08/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
+--                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
+--                   REVISED CHECK FOR ARRAY INDEXING.
+--     THS 09/18/90  REVISED WORDING IN HEADER COMMENT AND FIXED FAILURE
+--                   ERROR MESSAGE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD3015G IS
+
+BEGIN
+
+     TEST ("CD3015G", "CHECK THAT A DERIVED ENUMERATION TYPE WITH A " &
+                      "REPRESENTATION CLAUSE CAN BE USED CORRECTLY " &
+                      "IN ORDERING RELATIONS, INDEXING ARRAYS, AND " &
+                      "IN GENERIC INSTANTIATIONS WHEN THERE IS AN " &
+                      "ENUMERATION CLAUSE FOR THE PARENT");
+
+     DECLARE
+          PACKAGE PACK IS
+
+               TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
+
+               FOR MAIN USE (RED => 1, BLUE => 2, YELLOW => 3, 'R' => 4,
+                             'B' => 5, 'Y' => 6);
+
+               TYPE HUE IS NEW MAIN;
+               FOR HUE USE (RED => 8, BLUE => 9, YELLOW => 10,
+                            'R' => 11, 'B' => 12, 'Y' => 13);
+
+               TYPE HUE1 IS NEW MAIN;
+               FOR HUE1 USE (RED => 10, BLUE => 14, YELLOW => 16,
+                            'R' => 19, 'B' => 41, 'Y' => 46);
+
+               TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
+               COLOR1,BASIC1 : HUE1;
+               BARRAY1 : BASE1;
+
+               TYPE BASE IS ARRAY(HUE) OF INTEGER;
+               COLOR,BASIC : HUE;
+               BARRAY : BASE;
+
+               GENERIC
+                    TYPE ENUM IS (<>);
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM);
+
+          END PACK;
+
+          PACKAGE BODY PACK IS
+
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
+                    T : ENUM;
+               BEGIN
+                    T := X;
+                    X := Y;
+                    Y := T;
+               END CHANGE;
+
+               PROCEDURE PROC IS NEW CHANGE(HUE);
+               PROCEDURE PROC1 IS NEW CHANGE(HUE1);
+
+          BEGIN
+               BASIC := RED;
+               COLOR := HUE'SUCC(BASIC);
+               BASIC1 := RED;
+               COLOR1 := HUE1'SUCC(BASIC1);
+               IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
+                  COLOR > 'B') OR
+                  NOT (COLOR1 >= BASIC1 AND BASIC1 < 'R' AND
+                  'Y' > COLOR1 AND COLOR1 <= 'B') THEN
+                    FAILED("ORDERING RELATIONS ARE INCORRECT");
+               END IF;
+
+               PROC(BASIC,COLOR);
+               PROC1(BASIC1,COLOR1);
+
+               IF COLOR /= RED OR COLOR1 /= RED THEN
+                    FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
+                           "GENERIC UNIT NOT CORRECT AFTER CALL");
+               END IF;
+
+               BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
+                         IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
+
+               BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
+                         IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
+
+               IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
+                   BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
+                   BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
+                  NOT (BARRAY1 (RED) = 1 AND BARRAY1 (BLUE) = 2 AND
+                   BARRAY1 (YELLOW) = 3 AND BARRAY1 ('R') = 4 AND
+                   BARRAY1 ('B') = 5 AND BARRAY1 ('Y') = 6)
+                  THEN
+                    FAILED("INDEXING ARRAY FAILURE");
+               END IF;
+
+          END PACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3015G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015h.ada
new file mode 100644
index 000000000..ad557091d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015h.ada
@@ -0,0 +1,86 @@
+-- CD3015H.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 ENUMERATION REPRESENTATION CLAUSE FOR A DERIVED
+--     TYPE CAN BE GIVEN IN THE VISIBLE OR PRIVATE PART OF A PACKAGE
+--     FOR A DERIVED TYPE DECLARED IN THE VISIBLE PART, WHERE AN
+--     ENUMERATION CLAUSE HAS BEEN GIVEN FOR THE PARENT.
+
+-- HISTORY
+--     DHH  10/01/87  CREATED ORIGINAL TEST
+--     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
+--                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD3015H IS
+
+BEGIN
+
+     TEST ("CD3015H", "CHECK THAT AN ENUMERATION " &
+                      "REPRESENTATION CLAUSE FOR A DERIVED TYPE CAN " &
+                      "BE GIVEN IN THE VISIBLE OR PRIVATE PART OF A " &
+                      "PACKAGE FOR A DERIVED TYPE DECLARED IN THE " &
+                      "VISIBLE PART, WHERE AN ENUMERATION CLAUSE HAS " &
+                      "BEEN GIVEN FOR THE PARENT");
+
+     DECLARE
+          PACKAGE PACK IS
+
+               TYPE MAIN IS (RED,BLUE,YELLOW);
+               FOR MAIN USE (RED => 1, BLUE => 2, YELLOW => 3);
+
+               TYPE HUE IS NEW MAIN;
+               TYPE NEWHUE IS NEW MAIN;
+
+               FOR HUE USE
+                         (RED => 8, BLUE => 9, YELLOW => 10);
+
+          PRIVATE
+
+               FOR NEWHUE USE (RED => 6, BLUE => 11, YELLOW => 18);
+
+               TYPE INT1 IS RANGE 8 .. 10;
+               FOR INT1'SIZE USE HUE'SIZE;
+
+               TYPE INT2 IS RANGE 6 .. 18;
+               FOR INT2'SIZE USE NEWHUE'SIZE;
+
+               PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
+               PROCEDURE CHECK_2 IS NEW ENUM_CHECK(NEWHUE, INT2);
+
+          END PACK;
+
+          PACKAGE BODY PACK IS
+          BEGIN
+               CHECK_1 (RED, 8, "HUE");
+               CHECK_2 (YELLOW, 18, "NEWHUE");
+          END PACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3015H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015i.ada
new file mode 100644
index 000000000..c1cf45b0b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015i.ada
@@ -0,0 +1,144 @@
+-- CD3015I.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 ENUMERATION TYPE WITH A REPRESENTATION
+--     CLAUSE IN A GENERIC UNIT CAN BE USED CORRECTLY IN ORDERING
+--     RELATIONS, INDEXING ARRAYS, AND IN GENERIC INSTANTIATIONS WHEN
+--     THERE IS AN ENUMERATION CLAUSE FOR THE PARENT.
+
+-- HISTORY
+--     DHH 09/30/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     BCB 03/08/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
+--                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
+--                   REVISED CHECK FOR ARRAY INDEXING.
+--     THS 09/18/90  REVISED WORDING IN HEADER COMMENT AND FIXED FAILURE
+--                   ERROR MESSAGE.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD3015I IS
+
+BEGIN
+
+     TEST ("CD3015I", "CHECK THAT A DERIVED ENUMERATION TYPE WITH A " &
+                      "REPRESENTATION CLAUSE IN A GENERIC UNIT CAN " &
+                      "BE USED CORRECTLY IN ORDERING RELATIONS, " &
+                      "INDEXING ARRAYS, AND IN GENERIC " &
+                      "INSTANTIATIONS WHEN THERE IS AN ENUMERATION " &
+                      "CLAUSE FOR THE PARENT");
+
+     DECLARE
+
+          GENERIC
+          PACKAGE GENPACK IS
+
+               TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
+               FOR MAIN USE
+                         (RED => 1, BLUE => 2,
+                               YELLOW => 3, 'R' => 4,
+                               'B' => 5, 'Y' => 6);
+
+               TYPE HUE IS NEW MAIN;
+               FOR HUE USE
+                         (RED => 8, BLUE => 9,
+                               YELLOW => 10, 'R' => 11,
+                               'B' => 12, 'Y' => 13);
+
+               TYPE BASE IS ARRAY(HUE) OF INTEGER;
+               COLOR,BASIC : HUE;
+               BARRAY : BASE;
+
+               TYPE HUE1 IS NEW MAIN;
+               FOR HUE1 USE (RED => 10, BLUE => 14, YELLOW => 16,
+                            'R' => 19, 'B' => 41, 'Y' => 46);
+
+               TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
+               COLOR1,BASIC1 : HUE1;
+               BARRAY1 : BASE1;
+
+               GENERIC
+                    TYPE ENUM IS (<>);
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM);
+
+          END GENPACK;
+
+          PACKAGE BODY GENPACK IS
+
+               PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
+                    T : ENUM;
+               BEGIN
+                    T := X;
+                    X := Y;
+                    Y := T;
+               END CHANGE;
+
+               PROCEDURE PROC IS NEW CHANGE(HUE);
+               PROCEDURE PROC1 IS NEW CHANGE(HUE1);
+
+          BEGIN
+               BASIC := RED;
+               COLOR := HUE'SUCC(BASIC);
+               BASIC1 := RED;
+               COLOR1 := HUE1'SUCC(BASIC1);
+               IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
+                  COLOR > 'B') OR
+                  NOT (COLOR1 >= BASIC1 AND BASIC1 < 'R' AND
+                  'Y' > COLOR1 AND COLOR1 <= 'B') THEN
+                    FAILED("ORDERING RELATIONS ARE INCORRECT");
+               END IF;
+
+               PROC(BASIC,COLOR);
+               PROC1(BASIC1,COLOR1);
+
+               IF COLOR /= RED OR COLOR1 /= RED THEN
+                    FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
+                           "GENERIC UNIT NOT CORRECT AFTER CALL");
+               END IF;
+
+               BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
+                         IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
+
+               BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
+                         IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
+
+               IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
+                   BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
+                   BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
+                  NOT (BARRAY1 (RED) = 1 AND BARRAY1 (BLUE) = 2 AND
+                   BARRAY1 (YELLOW) = 3 AND BARRAY1 ('R') = 4 AND
+                   BARRAY1 ('B') = 5 AND BARRAY1 ('Y') = 6)
+                  THEN
+                    FAILED("INDEXING ARRAY FAILURE");
+               END IF;
+
+          END GENPACK;
+
+          PACKAGE P IS NEW GENPACK;
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3015I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015k.ada
new file mode 100644
index 000000000..a075f887c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3015k.ada
@@ -0,0 +1,92 @@
+-- CD3015K.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 ENUMERATION
+--     REPRESENTATION CLAUSE FOR A DERIVED TYPE CAN BE GIVEN IN THE
+--     VISIBLE OR PRIVATE PART OF A GENERIC PACKAGE FOR A DERIVED TYPE
+--     DECLARED IN THE VISIBLE PART, WHERE AN ENUMERATION CLAUSE
+--     HAS BEEN GIVEN FOR THE PARENT.
+
+-- HISTORY
+--     DHH  10/01/87  CREATED ORIGINAL TEST
+--     DHH  03/29/89  CHANGE FROM 'A' TEST TO 'C' TEST AND FROM '.DEP'
+--                    '.ADA'.  ADDED CHECK ON REPRESENTATION CLAUSES.
+
+WITH REPORT; USE REPORT;
+WITH ENUM_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
+PROCEDURE CD3015K IS
+
+BEGIN
+
+     TEST ("CD3015K", "CHECK THAT AN ENUMERATION REPRESENTATION " &
+                      "CLAUSE FOR A DERIVED TYPE CAN BE GIVEN IN " &
+                      "THE VISIBLE OR PRIVATE PART OF A GENERIC " &
+                      "PACKAGE FOR A DERIVED TYPE DECLARED IN " &
+                      "THE VISIBLE PART, WHERE AN ENUMERATION " &
+                      "CLAUSE HAS BEEN GIVEN FOR THE PARENT");
+
+     DECLARE
+
+          GENERIC
+          PACKAGE GENPACK IS
+
+               TYPE MAIN IS (RED,BLUE,YELLOW);
+               FOR MAIN USE (RED => 1, BLUE => 2, YELLOW => 3);
+
+               TYPE HUE IS NEW MAIN;
+               TYPE NEWHUE IS NEW MAIN;
+
+               FOR HUE USE (RED => 8, BLUE => 11, YELLOW => 12);
+
+          PRIVATE
+
+               FOR NEWHUE USE (RED => 6, BLUE => 12, YELLOW => 18);
+
+               TYPE INT1 IS RANGE 8 .. 12;
+               FOR INT1'SIZE USE HUE'SIZE;
+
+               TYPE INT2 IS RANGE 6 .. 18;
+               FOR INT2'SIZE USE NEWHUE'SIZE;
+
+               PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
+               PROCEDURE CHECK_2 IS NEW ENUM_CHECK(NEWHUE, INT2);
+
+          END GENPACK;
+
+          PACKAGE BODY GENPACK IS
+
+          BEGIN
+               CHECK_1 (RED, 8, "HUE");
+               CHECK_2 (YELLOW, 18, "NEWHUE");
+          END GENPACK;
+
+          PACKAGE P IS NEW GENPACK;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD3015K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3021a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3021a.ada
new file mode 100644
index 000000000..4bad83b61
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd3021a.ada
@@ -0,0 +1,66 @@
+-- CD3021A.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 AGGREGATE IN AN ENUMERATION REPRESENTATION CLAUSE
+--     IS NOT AMBIGUOUS EVEN IF THERE ARE SEVERAL ONE-DIMENSIONAL ARRAY
+--     TYPES WITH THE ENUMERATION TYPE AS THE INDEX SUBTYPE.
+
+-- HISTORY:
+--     BCB 09/30/87  CREATED ORIGINAL TEST.
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP', CORRECTED
+--                    CHECKS FOR FAILURE.
+
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD3021A IS
+
+     TYPE ENUM IS (A,B,C);
+
+     TYPE ARR1 IS ARRAY(ENUM) OF INTEGER;
+     TYPE ARR2 IS ARRAY(ENUM) OF INTEGER;
+     TYPE ARR3 IS ARRAY(ENUM) OF INTEGER;
+
+     FOR ENUM USE (A => 1,B => 2,C => 3);
+
+     A1 : ARR1 := (A => 5,B => 6,C => 13);
+     A2 : ARR2 := (A => 1,B => 2,C => 3);
+     A3 : ARR3 := (A => 0,B => 1,C => 2);
+
+BEGIN
+
+     TEST ("CD3021A", "CHECK THAT THE AGGREGATE IN AN ENUMERATION " &
+                      "REPRESENTATION CLAUSE IS NOT AMBIGUOUS EVEN " &
+                      "IF THERE ARE SEVERAL ONE-DIMENSIONAL ARRAY " &
+                      "TYPES WITH THE ENUMERATION TYPE AS THE INDEX " &
+                      "SUBTYPE");
+
+     IF (A1 /= (IDENT_INT (5), IDENT_INT (6), IDENT_INT (13))) OR
+          (A2 /= (IDENT_INT (1), IDENT_INT (2), IDENT_INT (3))) OR
+          (A3 /= (IDENT_INT (0), IDENT_INT (1), IDENT_INT (2))) THEN
+          FAILED ("INCORRECT VALUES FOR ARRAYS");
+     END IF;
+
+     RESULT;
+END CD3021A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd33001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd33001.a
new file mode 100644
index 000000000..82555054a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd33001.a
@@ -0,0 +1,139 @@
+-- CD33001.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 Component_Sizes that are a factor of the word
+--      size are supported.
+--
+--      Check that for such Component_Sizes arrays contain no gaps between
+--      components.
+--
+-- TEST DESCRIPTION:
+--      This test defines three array types and specifies their layouts
+--      using representation specifications for the 'Component_Size and
+--      pragma Packs for each.  It then checks that the implied assumptions
+--      about the resulting layout actually can be made.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      22 JUL 95   SAIC   Initial version
+--      07 MAY 96   SAIC   Revised for 2.1
+--      24 AUG 96   SAIC   Additional 2.1 revisions
+--      17 FEB 97   PWB.CTA  Corrected prefix of 'Component_Size to name
+--                           array object instead of array subtype
+--      16 FEB 98   EDS    Modified documentation.
+--!
+
+----------------------------------------------------------------- CD33001_0
+
+with System;
+package CD33001_0 is
+
+  S_Units_per_Word : constant := System.Word_Size/System.Storage_Unit;
+
+  type Nibble is mod 2**4;
+
+  type Byte is mod 2**8;
+
+  type Half_Stuff is array(Natural range <>) of Nibble;
+    for Half_Stuff'Component_Size
+      use System.Word_Size / 2;   -- factor                   -- ANX-C RQMT.
+  pragma Pack(Half_Stuff);                                    -- ANX-C RQMT.
+
+  type Word_Stuff is array(Natural range <>) of Byte;
+    for Word_Stuff'Component_Size
+      use System.Word_Size;                                   -- ANX-C RQMT.
+
+  type Address_Calculator is record
+    Item_1 : Nibble;
+    Item_2 : Nibble;
+  end record;
+
+  for Address_Calculator use record
+    Item_1 at 0 range 0..3;
+    Item_2 at 1 range 0..3;
+  end record;
+
+  -- given that Item_1 is specified to be at 'Position = 0 and
+  --            Item_2 is specified to be at 'Position = 1
+  -- by definition (13.5.2(2)) abs(Item_2'Address - Item_1'Address) = 1
+
+end CD33001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+-- there is no package body CD33001_0
+
+------------------------------------------------------------------- CD33001
+
+with Report;
+with System.Storage_Elements;
+with CD33001_0;
+procedure CD33001 is
+
+  use type System.Storage_Elements.Storage_Offset;
+
+  A_Half   : CD33001_0.Half_Stuff(0..15);
+
+  A_Word   : CD33001_0.Word_Stuff(0..15);
+ 
+  procedure Unexpected( Message : String; Wanted, Got: Integer ) is
+  begin
+    Report.Failed( Message & " Wanted:"
+                   & Integer'Image(Wanted) & " Got:" & Integer'Image(Got) );
+  end Unexpected;
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD33001", "Check that Component_Sizes that are factor of " &
+                          "the word size are supported.  Check that for " &
+                          "such Component_Sizes arrays contain no gaps " &
+                          "between components" );
+
+  if A_Half'Size /= A_Half'Component_Size * 16 then
+    Unexpected("Half word Size",
+               CD33001_0.Half_Stuff'Component_Size * 16,
+               A_Half'Size );
+  end if;
+
+  if A_Word(1)'Size /= System.Word_Size then
+    Unexpected("Word Size", System.Word_Size, A_Word(1)'Size );
+  end if;
+
+
+  Report.Result;
+
+end CD33001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd33002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd33002.a
new file mode 100644
index 000000000..5b3cdbd5f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd33002.a
@@ -0,0 +1,140 @@
+-- CD33002.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 Component_Sizes that are multiples of the word
+--      size are supported.
+--
+--      Check that for such Component_Sizes arrays contain no gaps between
+--      components.
+--
+-- TEST DESCRIPTION:
+--      This test defines three array types and specifies their layouts
+--      using representation specifications for the 'Component_Size and
+--      pragma Packs for each.  It then checks that the implied assumptions
+--      about the resulting layout actually can be made.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      22 JUL 95   SAIC   Initial version
+--      07 MAY 96   SAIC   Revised for 2.1
+--      24 AUG 96   SAIC   Additional 2.1 revisions
+--      16 FEB 98   EDS    Modify documentation.
+--!
+
+----------------------------------------------------------------- CD33002_0
+
+with System;
+package CD33002_0 is
+
+  S_Units_per_Word : constant := System.Word_Size/System.Storage_Unit;
+
+  type Nibble is mod 2**4;
+
+  type Byte is mod 2**8;
+
+  type Word_Stuff is array(Natural range <>) of Byte;
+    for Word_Stuff'Component_Size
+      use System.Word_Size;                                   -- ANX-C RQMT.
+      pragma Pack(Word_Stuff);                                -- ANX-C RQMT.
+
+  type Double_Stuff is array(Natural range <>) of Byte;
+    for Double_Stuff'Component_Size
+      use System.Word_Size * 2;     -- multiple               -- ANX-C RQMT.
+
+  type Address_Calculator is record
+    Item_1 : Nibble;
+    Item_2 : Nibble;
+  end record;
+
+  for Address_Calculator use record
+    Item_1 at 0 range 0..3;
+    Item_2 at 1 range 0..3;
+  end record;
+
+  -- by definition (13.5.2(2)) abs(Item_2'Address - Item_1'Address) = 1
+  -- it therefore follows that:
+  --     Address_Calculator'Size = 2 * Addressable_Unit'Size
+
+end CD33002_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+-- there is no package body CD33002_0
+
+------------------------------------------------------------------- CD33002
+
+with Report;
+with TCTouch;
+with System.Storage_Elements;
+with CD33002_0;
+procedure CD33002 is
+
+  use type System.Storage_Elements.Storage_Offset;
+
+  A_Word   : CD33002_0.Word_Stuff(0..15);
+ 
+  A_Double : CD33002_0.Double_Stuff(0..15);
+
+  procedure Unexpected( Message : String; Wanted, Got: Integer ) is
+  begin
+    Report.Failed ( Message & " Wanted:"
+                    & Integer'Image(Wanted) & " Got:" & Integer'Image(Got) );
+  end Unexpected;
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD33002", "Check that Component_Sizes that are multiples "
+                        & "of the word size are supported. Check that for "
+                        & "such Component_Sizes arrays contain no gaps "
+                        & "between components" );
+
+  if A_Word'Size /= CD33002_0.Word_Stuff'Component_Size * 16 then
+    Unexpected("Word Size",
+                CD33002_0.Word_Stuff'Component_Size * 16,
+                A_Word'Size );
+  end if;
+
+  if A_Double'Size /= CD33002_0.Double_Stuff'Component_Size * 16 then
+    Unexpected("Double word Size",
+                CD33002_0.Double_Stuff'Component_Size * 16,
+                A_Double'Size );
+  end if;
+
+
+  Report.Result;
+
+end CD33002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd40001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd40001.a
new file mode 100644
index 000000000..273271fdb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd40001.a
@@ -0,0 +1,181 @@
+-- CD40001.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 Enumeration_Representation_Clauses are supported for
+--      codes in the range System.Min_Int..System.Max_Int.
+--
+-- TEST DESCRIPTION:
+--      This test defines several types, and checks that the range of the 
+--      enumeration clause is as expected.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      22 JUL 95   SAIC   Initial version
+--      07 MAY 96   SAIC   Revised for 2.1
+--      16 FEB 98   EDS    Modified Documentation.
+--!
+
+with System;
+with Ada.Unchecked_Conversion;
+package CD40001_0 is
+
+  type Press_The_Bounds is ( Negative_Large, Positive_Large );
+
+  for Press_The_Bounds use
+      ( Negative_Large => System.Min_Int,                     -- ANX-C RQMT.
+        Positive_Large => System.Max_Int );                   -- ANX-C RQMT.
+
+  type Add_The_Bounds is 
+    ( Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
+
+  for Add_The_Bounds use
+      ( Monday    => System.Min_Int,                          -- ANX-C RQMT.
+        Tuesday   => System.Min_Int + 1,                      -- ANX-C RQMT.
+        Wednesday => System.Min_Int + 2,                      -- ANX-C RQMT.
+        Thursday  => System.Min_Int + 3,                      -- ANX-C RQMT.
+        Friday    => System.Min_Int + 4,                      -- ANX-C RQMT.
+        Saturday  => System.Min_Int + 5 );                    -- ANX-C RQMT.
+
+  type Minus_The_Bounds is ( Jan, Feb, Mar, Apr);
+
+  for Minus_The_Bounds use
+      ( Apr => System.Max_Int,                                -- ANX-C RQMT.
+        Mar => System.Max_Int - 1,                            -- ANX-C RQMT.
+        Feb => System.Max_Int - 2,                            -- ANX-C RQMT.
+        Jan => System.Max_Int - 3 );                          -- ANX-C RQMT.
+
+  type TC_Integer is range System.Min_Int..System.Max_Int;
+
+  procedure TC_Check_Press; 
+
+  procedure TC_Check_Add; 
+
+  procedure TC_Check_Minus; 
+
+  function TC_Compare_Press is new Ada.Unchecked_Conversion 
+    (Press_The_Bounds, TC_Integer);
+
+  function TC_Compare_Add is new Ada.Unchecked_Conversion 
+    (Add_The_Bounds, TC_Integer);
+
+  function TC_Compare_Minus is new Ada.Unchecked_Conversion 
+    (Minus_The_Bounds, TC_Integer);
+
+end CD40001_0;
+
+     --==================================================================--
+
+with Report;
+package body CD40001_0 is
+
+  procedure TC_Check_Press is
+    My_Press_First : Press_The_Bounds := Negative_Large;
+    My_Press_Last  : Press_The_Bounds := Positive_Large;
+  begin
+    if TC_Compare_Press (My_Press_First) /= System.Min_Int or
+       TC_Compare_Press (My_Press_Last)  /= System.Max_Int 
+    then
+      Report.Failed 
+        ("Expected enumeration size of System.Min_Int and System.Max_Int " &
+         "not available for this implementation");
+    end if;
+  end TC_Check_Press;
+
+  ---------------------------------------------------------------------------
+  procedure TC_Check_Add is
+    My_Monday    : Add_The_Bounds := Monday;
+    My_Tuesday   : Add_The_Bounds := Tuesday; 
+    My_Wednesday : Add_The_Bounds := Wednesday; 
+    My_Thursday  : Add_The_Bounds := Thursday;
+    My_Friday    : Add_The_Bounds := Friday;
+    My_Saturday  : Add_The_Bounds := Saturday; 
+  begin
+    if TC_Compare_Add (My_Monday)    /= (System.Min_Int)     or
+       TC_Compare_Add (My_Thursday)  /= (System.Min_Int + 3) or
+       TC_Compare_Add (My_Wednesday) /= (System.Min_Int + 2) or
+       TC_Compare_Add (My_Tuesday)   /= (System.Min_Int + 1) or
+       TC_Compare_Add (My_Saturday)  /= (System.Min_Int + 5) or
+       TC_Compare_Add (My_Friday)    /= (System.Min_Int + 4)   
+    then
+      Report.Failed
+        ("Expected enumeration size of System.Min_Int, System.Min_Int + 1 " &
+         "through System.Min_Int + 5 not available for this implementation");
+    end if;
+  end TC_Check_Add;
+
+  ---------------------------------------------------------------------------
+  procedure TC_Check_Minus is
+    My_Jan : Minus_The_Bounds := Jan;
+    My_Feb : Minus_The_Bounds := Feb; 
+    My_Mar : Minus_The_Bounds := Mar; 
+    My_Apr : Minus_The_Bounds := Apr;
+  begin
+    if TC_Compare_Minus (My_Jan) /= (System.Max_Int - 3) or
+       TC_Compare_Minus (My_Feb) /= (System.Max_Int - 2) or
+       TC_Compare_Minus (My_Mar) /= (System.Max_Int - 1) or
+       TC_Compare_Minus (My_Apr) /= (System.Max_Int)
+    then
+      Report.Failed
+        ("Expected enumeration size of System.Max_Int, System.Max_Int - 1 " &
+         "through System.Max_Int - 3 not available for this implementation");
+    end if;
+  end TC_Check_Minus;
+
+end CD40001_0;
+
+     --==================================================================--
+
+with Report;
+with CD40001_0;
+
+procedure CD40001 is
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD40001", "Check that Enumeration_Representation_Clauses " &
+                          "are supported for codes in the range " &
+                          "System.Min_Int..System.Max_Int" );
+   
+  CD40001_0.TC_Check_Press;
+
+  CD40001_0.TC_Check_Add;
+
+  CD40001_0.TC_Check_Minus;
+
+  Report.Result;
+
+end CD40001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4031a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4031a.ada
new file mode 100644
index 000000000..936088d65
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4031a.ada
@@ -0,0 +1,95 @@
+-- CD4031A.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 RECORD REPRESENTATION CLAUSE IS GIVEN FOR A
+--     VARIANT RECORD TYPE, THEN COMPONENTS BELONGING TO DIFFERENT
+--     VARIANTS CAN BE GIVEN OVERLAPPING STORAGE.
+
+-- HISTORY:
+--     PWB 07/22/87  CREATED ORIGINAL TEST.
+--     DHH 03/27/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND
+--                   ADDED CHECK FOR REPRESENTATION CLAUSE.
+--     RJW 06/12/90  REMOVED REFERENCES TO LENGTH_CHECK.  REVISED
+--                   COMMENTS.
+--     JRL 10/13/96  Adjusted ranges in type definitions to allow 1's
+--                   complement machines to represent all values in
+--                   the specified number of bits.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD4031A IS
+
+     TYPE DISCRIMINAN IS RANGE -1 .. 1;
+     TYPE INT IS RANGE -3 .. 3;
+     TYPE LARGE_INT IS RANGE -7 .. 7;
+
+     TYPE TEST_CLAUSE (DISC : DISCRIMINAN := 0) IS
+          RECORD
+               CASE DISC IS
+                    WHEN 0 =>
+                         INTEGER_COMP : LARGE_INT;
+                    WHEN OTHERS  =>
+                         CH_COMP_1 : INT;
+                         CH_COMP_2 : INT;
+               END CASE;
+          END RECORD;
+
+     FOR TEST_CLAUSE USE
+          RECORD
+               DISC AT 0
+                           RANGE 0 .. 1;
+               INTEGER_COMP AT 0
+                           RANGE 2 .. 5;
+               CH_COMP_1 AT 0
+                           RANGE 2 .. 4;
+               CH_COMP_2 AT 0
+                           RANGE 5 .. 7;
+          END RECORD;
+
+     TYPE TEST_CL1 IS NEW TEST_CLAUSE(DISC => 0);
+     TYPE TEST_CL2 IS NEW TEST_CLAUSE(DISC => 1);
+     TEST_RECORD : TEST_CL1;
+     TEST_RECORD1 : TEST_CL2;
+
+     INTEGER_COMP_FIRST,
+     CH_COMP_1_FIRST : INTEGER;
+
+BEGIN
+     TEST ("CD4031A", "IN RECORD REPRESENTATION CLAUSES " &
+                      "FOR VARIANT RECORD TYPES, " &
+                      "COMPONENTS OF DIFFERENT VARIANTS " &
+                      "CAN BE GIVEN OVERLAPPING STORAGE");
+
+     TEST_RECORD := (0, -7);
+     INTEGER_COMP_FIRST := TEST_RECORD.INTEGER_COMP'FIRST_BIT;
+
+     TEST_RECORD1 := (1, -3, -3);
+     CH_COMP_1_FIRST := TEST_RECORD1.CH_COMP_1'FIRST_BIT;
+
+     IF INTEGER_COMP_FIRST /= CH_COMP_1_FIRST THEN
+          FAILED ("COMPONENTS DO NOT BEGIN AT SAME POINT");
+     END IF;
+
+     RESULT;
+END CD4031A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4041a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4041a.tst
new file mode 100644
index 000000000..d0e2fd65d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4041a.tst
@@ -0,0 +1,92 @@
+-- CD4041A.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 AN ALIGNMENT CLAUSE CAN BE GIVEN FOR A RECORD
+--     REPRESENTATION CLAUSE.
+
+-- HISTORY:
+--     RJW 08/25/87  CREATED ORIGINAL TEST.
+--     DHH 03/30/89  CHANGED MOD 4 TO A MACRO VALUE AND CHANGED
+--                   EXTENSION FROM '.DEP' TO '.TST'.
+
+-- MACRO SUBSTITUTION:
+--     $ALIGNMENT IS THE VALUE USED TO ALIGN A RECORD ON A BOUNDARY
+--     DEFINED BY THE IMPLEMENTATION.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM;
+PROCEDURE CD4041A IS
+
+     UNITS_PER_INTEGER : CONSTANT :=
+                      (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
+                      SYSTEM.STORAGE_UNIT;
+
+     TYPE CHECK_CLAUSE IS RECORD
+          INT_COMP    : INTEGER;
+          CHAR_COMP   : CHARACTER;
+     END RECORD;
+
+     FOR CHECK_CLAUSE USE
+          RECORD AT MOD $ALIGNMENT;
+               INT_COMP AT 0
+                           RANGE 0..INTEGER'SIZE - 1;
+               CHAR_COMP AT 1*UNITS_PER_INTEGER
+                           RANGE 0..CHARACTER'SIZE - 1;
+          END RECORD;
+
+     CHECK_RECORD : CHECK_CLAUSE := (1, 'A');
+
+BEGIN
+     TEST ("CD4041A", "CHECK THAT AN ALIGNMENT CLAUSE CAN BE " &
+                      "GIVEN FOR A RECORD REPRESENTATION CLAUSE");
+
+     IF CHECK_RECORD.INT_COMP'FIRST_BIT /= 0 THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.INT_COMP'LAST_BIT /= INTEGER'SIZE - 1 THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.INT_COMP'POSITION /= 0 THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'FIRST_BIT /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHAR_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'LAST_BIT /=
+               IDENT_INT (CHARACTER'SIZE - 1) THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHAR_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'POSITION /=
+               IDENT_INT (UNITS_PER_INTEGER) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF CHAR_COMP");
+     END IF;
+
+     RESULT;
+END CD4041A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051a.ada
new file mode 100644
index 000000000..746f82bcd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051a.ada
@@ -0,0 +1,92 @@
+-- CD4051A.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 RECORD REPRESENTATION CLAUSE CAN BE GIVEN FOR
+--     DERIVED TYPES WHOSE PARENT TYPES ARE RECORD TYPES WITHOUT
+--     DISCRIMINANTS.
+
+-- HISTORY:
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     RJW 08/25/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM;
+PROCEDURE CD4051A IS
+
+     UNITS_PER_INTEGER : CONSTANT :=
+                      (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
+                      SYSTEM.STORAGE_UNIT;
+
+     TYPE BASIC_CLAUSE IS RECORD
+          INT_COMP    : INTEGER;
+          CHAR_COMP   : CHARACTER;
+     END RECORD;
+
+     TYPE CHECK_CLAUSE IS NEW BASIC_CLAUSE;
+
+     FOR CHECK_CLAUSE USE
+          RECORD
+               INT_COMP AT 0
+                           RANGE 0..INTEGER'SIZE - 1;
+               CHAR_COMP AT 1*UNITS_PER_INTEGER
+                           RANGE 0..CHARACTER'SIZE - 1;
+          END RECORD;
+
+     CHECK_RECORD : CHECK_CLAUSE := (1, 'A');
+
+BEGIN
+     TEST ("CD4051A", "CHECK THAT A RECORD REPRESENTATION " &
+                      "CLAUSE CAN BE GIVEN FOR A DERIVED TYPE " &
+                      "WHOSE PARENT TYPE IS IS A RECORD TYPE " &
+                      "WITHOUT DISCRIMINANTS");
+
+     IF CHECK_RECORD.INT_COMP'FIRST_BIT /= 0 THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.INT_COMP'LAST_BIT /= INTEGER'SIZE - 1 THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.INT_COMP'POSITION /= 0 THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'FIRST_BIT /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHAR_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'LAST_BIT /=
+               IDENT_INT (CHARACTER'SIZE - 1) THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHAR_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'POSITION /=
+               IDENT_INT (UNITS_PER_INTEGER) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF CHAR_COMP");
+     END IF;
+
+     RESULT;
+END CD4051A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051b.ada
new file mode 100644
index 000000000..1cd440f44
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051b.ada
@@ -0,0 +1,94 @@
+-- CD4051B.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 RECORD REPRESENTATION CLAUSE WHICH CHANGES THE
+--     ORDER OF THE COMPONENT STORAGE CAN BE GIVEN FOR A DERIVED TYPE
+--     WHOSE PARENT TYPE IS A RECORD WITHOUT A DISCRIMINANT.
+
+-- HISTORY:
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     RJW 08/25/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM;
+PROCEDURE CD4051B IS
+
+     UNITS_PER_INTEGER : CONSTANT :=
+                      (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
+                      SYSTEM.STORAGE_UNIT;
+
+     TYPE BASIC_CLAUSE IS RECORD
+          INT_COMP    : INTEGER;
+          CHAR_COMP   : CHARACTER;
+     END RECORD;
+
+     TYPE CHECK_CLAUSE IS NEW BASIC_CLAUSE;
+
+     FOR CHECK_CLAUSE USE
+          RECORD
+               INT_COMP AT 1*UNITS_PER_INTEGER
+                           RANGE 0..INTEGER'SIZE - 1;
+               CHAR_COMP AT 0
+                           RANGE 0..CHARACTER'SIZE - 1;
+          END RECORD;
+
+     CHECK_RECORD : CHECK_CLAUSE := (1, 'A');
+
+BEGIN
+     TEST ("CD4051B", "CHECK THAT A RECORD REPRESENTATION " &
+                      "CLAUSE WHICH CHANGES THE ORDER OF COMPONENT " &
+                      "STORAGE CAN BE GIVEN FOR A DERIVED TYPE " &
+                      "WHOSE PARENT TYPE IS IS A RECORD TYPE " &
+                      "WITHOUT DISCRIMINANTS");
+
+     IF CHECK_RECORD.INT_COMP'FIRST_BIT /= 0 THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.INT_COMP'LAST_BIT /= INTEGER'SIZE - 1 THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.INT_COMP'POSITION /=
+               IDENT_INT (UNITS_PER_INTEGER) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'FIRST_BIT /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHAR_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'LAST_BIT /=
+               IDENT_INT (CHARACTER'SIZE - 1) THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHAR_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'POSITION /=
+               IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF CHAR_COMP");
+     END IF;
+
+     RESULT;
+END CD4051B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051c.ada
new file mode 100644
index 000000000..ea97f1caf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051c.ada
@@ -0,0 +1,108 @@
+-- CD4051C.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 RECORD REPRESENTATION CLAUSE CAN BE GIVEN FOR
+--     A DERIVED TYPE WHOSE PARENT TYPE IS A RECORD WITH A
+--     DISCRIMINANT.
+
+-- HISTORY:
+--     BCB 03/20/89  CHANGED EXTENSION FROM '.ADA' TO '.DEP'.
+--     RJW 08/25/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM;
+PROCEDURE CD4051C IS
+
+     UNITS_PER_INTEGER : CONSTANT :=
+                      (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1) /
+                      SYSTEM.STORAGE_UNIT;
+
+     TYPE BASIC_CLAUSE (DISC : BOOLEAN) IS RECORD
+          INT_COMP    : INTEGER;
+          CHAR_COMP   : CHARACTER;
+     END RECORD;
+
+     TYPE CHECK_CLAUSE IS NEW BASIC_CLAUSE;
+
+     FOR CHECK_CLAUSE USE
+          RECORD
+               DISC AT 0
+                           RANGE 0..BOOLEAN'SIZE - 1;
+               INT_COMP AT 1*UNITS_PER_INTEGER
+                           RANGE 0..INTEGER'SIZE - 1;
+               CHAR_COMP AT 2*UNITS_PER_INTEGER
+                           RANGE 0..CHARACTER'SIZE - 1;
+          END RECORD;
+
+     CHECK_RECORD : CHECK_CLAUSE (TRUE) := (TRUE, 1, 'A');
+
+BEGIN
+     TEST ("CD4051C", "CHECK THAT A RECORD REPRESENTATION " &
+                      "CLAUSE CAN BE GIVEN FOR A DERIVED TYPE " &
+                      "WHOSE PARENT TYPE IS IS A RECORD TYPE " &
+                      "WITH DISCRIMINANTS");
+
+     IF CHECK_RECORD.DISC'FIRST_BIT /= 0 THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF DISC");
+     END IF;
+
+     IF CHECK_RECORD.DISC'LAST_BIT /= BOOLEAN'SIZE - 1 THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF DISC");
+     END IF;
+
+     IF CHECK_RECORD.DISC'POSITION /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF DISC");
+     END IF;
+
+     IF CHECK_RECORD.INT_COMP'FIRST_BIT /= 0 THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.INT_COMP'LAST_BIT /=
+               IDENT_INT (INTEGER'SIZE - 1) THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.INT_COMP'POSITION /=
+               IDENT_INT (UNITS_PER_INTEGER) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF INT_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'FIRST_BIT /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHAR_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'LAST_BIT /=
+               IDENT_INT (CHARACTER'SIZE - 1) THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHAR_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CHAR_COMP'POSITION /=
+               IDENT_INT (2 * UNITS_PER_INTEGER) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF CHAR_COMP");
+     END IF;
+
+     RESULT;
+END CD4051C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051d.ada
new file mode 100644
index 000000000..5b83c336c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd4051d.ada
@@ -0,0 +1,134 @@
+-- CD4051D.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 RECORD REPRESENTATION CLAUSE CAN BE GIVEN FOR
+--     A DERIVED SUBTYPE WHOSE PARENT TYPE IS A RECORD TYPE WITH
+--     VARIANTS AND THE REPRESENTATION CLAUSE MENTIONS COMPONENTS THAT
+--     DO NOT EXIST IN THE DERIVED SUBTYPE.
+
+-- HISTORY:
+--     RJW 08/25/87  CREATED ORIGINAL TEST.
+--     DHH 03/27/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND
+--                   ADDED CHECK FOR REPRESENTATION CLAUSE.
+--     RJW 10/26/89  REMOVED REFERENCES TO LENGTH_CHECK.
+--     THS 09/18/90  MADE CALLS TO IDENT_INT TO DEFEAT OPTIMIZATION.
+--     JRL 10/13/96  Adjusted ranges in type definitions to allow 1's
+--                   complement machines to represent all values in
+--                   the specified number of bits.
+
+WITH REPORT; USE REPORT;
+WITH SYSTEM;
+PROCEDURE CD4051D IS
+
+     TYPE INT IS RANGE -3 .. 3;
+     TYPE LARGE_INT IS RANGE -7 .. 7;
+
+     TYPE BASIC_CLAUSE (DISC : BOOLEAN) IS RECORD
+          BOOL_COMP   : BOOLEAN;
+          CASE DISC IS
+               WHEN FALSE =>
+                    INT_COMP  : LARGE_INT;
+               WHEN TRUE  =>
+                    CH_COMP_1 : INT;
+                    CH_COMP_2 : INT;
+          END CASE;
+     END RECORD;
+
+     TYPE CHECK_CLAUSE IS NEW BASIC_CLAUSE (TRUE);
+
+     FOR CHECK_CLAUSE USE
+          RECORD
+               DISC AT 0
+                           RANGE 0 .. 0;
+               BOOL_COMP AT 0
+                           RANGE 1 .. 1;
+               INT_COMP AT 0
+                           RANGE 2 .. 5;
+               CH_COMP_1 AT 0
+                           RANGE 2 .. 4;
+               CH_COMP_2 AT 0
+                           RANGE 5 .. 7;
+          END RECORD;
+
+     CHECK_RECORD : CHECK_CLAUSE := (TRUE, TRUE, -2, -2);
+
+BEGIN
+     TEST ("CD4051D", "CHECK THAT A RECORD REPRESENTATION " &
+                      "CLAUSE CAN BE GIVEN FOR A DERIVED TYPE " &
+                      "WHOSE PARENT TYPE IS A RECORD TYPE " &
+                      "WITH VARIANTS AND WHERE THE RECORD " &
+                      "REPRESENTATION CLAUSE MENTIONS COMPONENTS " &
+                      "THAT DO NOT EXIST IN THE DERIVED SUBTYPE");
+
+     IF CHECK_RECORD.DISC'FIRST_BIT /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF DISC");
+     END IF;
+
+     IF CHECK_RECORD.DISC'LAST_BIT /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF DISC");
+     END IF;
+
+     IF CHECK_RECORD.DISC'POSITION /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF DISC");
+     END IF;
+
+     IF CHECK_RECORD.BOOL_COMP'FIRST_BIT /= IDENT_INT (1) THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF BOOL_COMP");
+     END IF;
+
+     IF CHECK_RECORD.BOOL_COMP'LAST_BIT /= IDENT_INT (1) THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF BOOL_COMP");
+     END IF;
+
+     IF CHECK_RECORD.BOOL_COMP'POSITION /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF BOOL_COMP");
+     END IF;
+
+     IF CHECK_RECORD.CH_COMP_1'FIRST_BIT /= IDENT_INT (2) THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CH_COMP_1");
+     END IF;
+
+     IF CHECK_RECORD.CH_COMP_1'LAST_BIT /= IDENT_INT (4) THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF CH_COMP_1");
+     END IF;
+
+     IF CHECK_RECORD.CH_COMP_1'POSITION /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF CH_COMP_1");
+     END IF;
+
+     IF CHECK_RECORD.CH_COMP_2'FIRST_BIT /= IDENT_INT (5) THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CH_COMP_2");
+     END IF;
+
+     IF CHECK_RECORD.CH_COMP_2'LAST_BIT /= IDENT_INT (7) THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF CH_COMP_2");
+     END IF;
+
+     IF CHECK_RECORD.CH_COMP_2'POSITION /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF CH_COMP_2");
+     END IF;
+
+     RESULT;
+END CD4051D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003a.ada
new file mode 100644
index 000000000..04a7c1a3e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003a.ada
@@ -0,0 +1,79 @@
+-- CD5003A.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 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN FOR
+--     A PACKAGE BODY CONTAINING AN ADDRESS CLAUSE AS LONG AS A 'WITH'
+--     CLAUSE IS GIVEN FOR THE SPECIFICATION.
+
+-- HISTORY:
+--     RJW 10/13/88  CREATED ORIGINAL TEST.
+--     BCB 04/18/89  CHANGED EXTENSION TO '.ADA'.  REMOVED APPLICABILITY
+--                   CRITERIA AND N/A ERROR MESSAGES.
+-- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+WITH SYSTEM;
+PACKAGE CD5003A_PKG2 IS 
+     PROCEDURE REQUIRE_BODY;
+END CD5003A_PKG2;
+
+WITH SPPRT13;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (SPPRT13);
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY CD5003A_PKG2 IS
+     TEST_VAR : INTEGER;
+     FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
+     USE SYSTEM;
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+       NULL;
+     END;
+BEGIN
+     TEST ("CD5003A", "CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' " &
+                      "NEED NOT BE GIVEN FOR A PACKAGE BODY " &
+                      "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
+                      "'WITH' CLAUSE IS GIVEN FOR THE SPECIFICATION");
+
+     TEST_VAR := IDENT_INT (3);
+
+     IF TEST_VAR /= 3 THEN
+          FAILED ("INCORRECT VALUE FOR TEST_VAR");
+     END IF;
+
+     IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
+     END IF;
+
+END CD5003A_PKG2;
+
+WITH REPORT; USE REPORT;
+WITH CD5003A_PKG2; USE CD5003A_PKG2;
+WITH SPPRT13;
+PROCEDURE CD5003A IS
+BEGIN
+
+    RESULT;
+END CD5003A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003b.ada
new file mode 100644
index 000000000..789edd570
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003b.ada
@@ -0,0 +1,77 @@
+-- CD5003B.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 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN FOR
+--     A PROCEDURE BODY CONTAINING AN ADDRESS CLAUSE AS LONG AS A 'WITH'
+--     CLAUSE IS GIVEN FOR THE PROCEDURE SPECIFICATION.
+
+-- HISTORY:
+--     VCL 09/04/87  CREATED ORIGINAL TEST.
+--     RJW 10/13/88  INITIALIZED THE VARIABLE "CHECK_VAR".
+--     BCB 04/18/89  CHANGED EXTENSION TO '.ADA'.  REMOVED APPLICABILITY
+--                   CRITERIA AND N/A ERROR MESSAGES.
+
+WITH SYSTEM;
+PROCEDURE CD5003B;
+
+WITH SPPRT13;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (SPPRT13);
+PRAGMA ELABORATE (REPORT);
+PROCEDURE CD5003B IS
+     TYPE ENUM IS (A0, A1, A2, A3, A4, A5);
+
+     TEST_VAR : ENUM := A0;
+     FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
+     USE SYSTEM;
+
+     FUNCTION IDENT_ENUM (P : ENUM) RETURN ENUM IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN P;
+          ELSE
+               RETURN A0;
+          END IF;
+     END IDENT_ENUM;
+
+BEGIN
+     TEST ("CD5003B", "CHECK THAT A 'WITH' CLAUSE NAMING 'SYSTEM' " &
+                      "NEED NOT BE GIVEN FOR A PROCEDURE BODY " &
+                      "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
+                      "'WITH' CLAUSE IS GIVEN FOR THE PROCEDURE " &
+                      "SPECIFICATION");
+
+     TEST_VAR := IDENT_ENUM (A3);
+
+     IF TEST_VAR /= A3 THEN
+          FAILED ("INCORRECT VALUE FOR TEST_VAR");
+     END IF;
+
+     IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
+     END IF;
+
+    RESULT;
+END CD5003B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003c.ada
new file mode 100644
index 000000000..9ea5ae59d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003c.ada
@@ -0,0 +1,86 @@
+-- CD5003C.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 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
+--     FOR A PACKAGE BODY SUBUNIT CONTAINING AN ADDRESS CLAUSE AS
+--     LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT CONTAINING THE
+--     PACKAGE SPECIFICATION.
+
+-- HISTORY:
+--     VCL  09/04/87  CREATED ORIGINAL TEST.
+--     PWB  05/12/89  CHANGED TO ".ADA" TEST.
+
+
+WITH SYSTEM;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PROCEDURE CD5003C IS
+     PACKAGE CD5003C_PACK2 IS END CD5003C_PACK2;
+
+     PACKAGE BODY CD5003C_PACK2 IS SEPARATE;
+
+     USE CD5003C_PACK2;
+BEGIN
+    RESULT;
+END CD5003C;
+
+WITH SPPRT13;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (SPPRT13);
+PRAGMA ELABORATE (REPORT);
+SEPARATE (CD5003C)
+PACKAGE BODY CD5003C_PACK2 IS
+     TYPE ATYPE IS ARRAY (1 .. 10) OF INTEGER;
+
+     TEST_VAR : ATYPE := (OTHERS => 0);
+     FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
+     USE SYSTEM;
+
+     FUNCTION IDENT (P : ATYPE) RETURN ATYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN P;
+          ELSE
+               RETURN (OTHERS => 0);
+          END IF;
+     END IDENT;
+BEGIN
+     TEST ("CD5003C", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT " &
+                      "BE GIVEN FOR A PACKAGE BODY SUBUNIT " &
+                      "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
+                      "'WITH' CLAUSE IS GIVEN FOR THE UNIT " &
+                      "CONTAINING THE PACKAGE SPECIFICATION");
+
+
+     TEST_VAR := IDENT (ATYPE'(OTHERS => 3));
+
+     IF TEST_VAR /= ATYPE'(OTHERS => 3) THEN
+          FAILED ("INCORRECT VALUE FOR TEST_VAR");
+     END IF;
+
+     IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
+     END IF;
+END CD5003C_PACK2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003d.ada
new file mode 100644
index 000000000..a5a83785c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003d.ada
@@ -0,0 +1,88 @@
+-- CD5003D.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 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
+--     FOR A PROCEDURE BODY SUBUNIT CONTAINING AN ADDRESS CLAUSE AS
+--     LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT CONTAINING
+--     THE PROCEDURE SPECIFICATION.
+
+-- HISTORY:
+--     VCL  09/08/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+PACKAGE CD5003D_PACK2 IS
+     PROCEDURE CD5003D_PROC2;
+END CD5003D_PACK2;
+
+WITH SYSTEM;
+PACKAGE BODY CD5003D_PACK2 IS
+     PROCEDURE CD5003D_PROC2 IS SEPARATE;
+END CD5003D_PACK2;
+
+WITH SPPRT13;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (SPPRT13);
+PRAGMA ELABORATE (REPORT);
+SEPARATE (CD5003D_PACK2)
+PROCEDURE CD5003D_PROC2 IS
+     TYPE FIXD IS DELTA 0.1 RANGE -10.0 .. 10.0;
+
+     TEST_VAR : FIXD := 0.0;
+     FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
+     USE SYSTEM;
+
+     FUNCTION IDENT_FIXD (P : FIXD) RETURN FIXD IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN P;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT_FIXD;
+BEGIN
+     TEST ("CD5003D", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE " &
+                      "GIVEN FOR A PROCEDURE BODY SUBUNIT " &
+                      "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
+                      "'WITH' CLAUSE IS GIVEN FOR THE UNIT " &
+                      "CONTAINING THE PROCEDURE SPECIFICATION");
+
+     TEST_VAR := IDENT_FIXD (3.3);
+
+     IF TEST_VAR /= 3.3 THEN
+          FAILED ("INCORRECT VALUE FOR TEST_VAR");
+     END IF;
+
+     IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
+     END IF;
+
+    RESULT;
+END CD5003D_PROC2;
+
+WITH CD5003D_PACK2; USE CD5003D_PACK2;
+PROCEDURE CD5003D IS
+BEGIN
+     CD5003D_PROC2;
+END CD5003D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003e.ada
new file mode 100644
index 000000000..8c157f832
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003e.ada
@@ -0,0 +1,76 @@
+-- CD5003E.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 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
+--     FOR A TASK BODY SUBUNIT CONTAINING AN ADDRESS CLAUSE AS LONG
+--     AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT CONTAINING THE TASK
+--     SPECIFICATION.
+
+-- HISTORY:
+--     VCL  09/08/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+
+WITH SYSTEM;
+PROCEDURE CD5003E IS
+     TASK TASK2 IS
+          ENTRY TST;
+     END TASK2;
+     TASK BODY TASK2 IS SEPARATE;
+BEGIN
+     TASK2.TST;
+END CD5003E;
+
+WITH SPPRT13;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (SPPRT13);
+PRAGMA ELABORATE (REPORT);
+SEPARATE (CD5003E)
+TASK BODY TASK2 IS
+     TEST_VAR : INTEGER := 0;
+     FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
+     USE SYSTEM;
+
+BEGIN
+     ACCEPT TST DO
+          TEST ("CD5003E", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT " &
+                           "BE GIVEN FOR A TASK BODY SUBUNIT " &
+                           "CONTAINING AN ADDRESS CLAUSE AS LONG " &
+                           "AS A 'WITH' CLAUSE IS GIVEN FOR THE " &
+                           "UNIT CONTAINING THE TASK SPECIFICATION");
+
+          TEST_VAR := IDENT_INT (3);
+
+          IF TEST_VAR /= 3 THEN
+               FAILED ("INCORRECT VALUE FOR TEST_VAR");
+          END IF;
+
+          IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
+          END IF;
+
+         RESULT;
+     END TST;
+END TASK2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003f.ada
new file mode 100644
index 000000000..1e54c6d24
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003f.ada
@@ -0,0 +1,91 @@
+-- CD5003F.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 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
+--     FOR A GENERIC PACKAGE BODY CONTAINING AN ADDRESS CLAUSE
+--     AS LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE GENERIC PACKAGE
+--     SPECIFICATION.
+
+-- HISTORY:
+--     VCL  09/09/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+-- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+WITH SYSTEM;
+GENERIC
+PACKAGE CD5003F_PACK2 IS 
+     PROCEDURE REQUIRE_BODY;
+END CD5003F_PACK2;
+
+WITH SPPRT13;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (SPPRT13);
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY CD5003F_PACK2 IS
+     TYPE ATYPE IS ARRAY (1 .. 10) OF INTEGER;
+
+     TEST_VAR : ATYPE := (OTHERS => 0);
+     FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
+     USE SYSTEM;
+
+     FUNCTION IDENT (P : ATYPE) RETURN ATYPE IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN P;
+          ELSE
+               RETURN (OTHERS => 0);
+          END IF;
+     END IDENT;
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+       NULL;
+     END;
+BEGIN
+     TEST ("CD5003F", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT " &
+                      "BE GIVEN FOR A GENERIC PACKAGE BODY " &
+                      "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
+                      "'WITH' CLAUSE IS GIVEN FOR THE GENERIC " &
+                      "PACKAGE SPECIFICATION");
+
+     TEST_VAR := IDENT (ATYPE'(OTHERS => 3));
+
+     IF TEST_VAR /= ATYPE'(OTHERS => 3) THEN
+          FAILED ("INCORRECT VALUE FOR TEST_VAR");
+     END IF;
+
+     IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
+     END IF;
+END CD5003F_PACK2;
+
+WITH CD5003F_PACK2;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PROCEDURE CD5003F IS
+     PACKAGE CD5003F_PACK3 IS NEW CD5003F_PACK2;
+BEGIN
+    RESULT;
+END CD5003F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003g.ada
new file mode 100644
index 000000000..5789fec5e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003g.ada
@@ -0,0 +1,89 @@
+-- CD5003G.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 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
+--     FOR A GENERIC PROCEDURE BODY CONTAINING AN ADDRESS CLAUSE
+--     AS LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT CONTAINING
+--     THE GENERIC PROCEDURE SPECIFICATION.
+
+-- HISTORY:
+--     VCL  09/09/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM;
+PACKAGE CD5003G_PACK2 IS
+     GENERIC
+     PROCEDURE CD5003G_PROC2;
+END CD5003G_PACK2;
+
+WITH SPPRT13;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (SPPRT13);
+PRAGMA ELABORATE (REPORT);
+PACKAGE BODY CD5003G_PACK2 IS
+     PROCEDURE CD5003G_PROC2 IS
+          TYPE FIXD IS DELTA 0.1 RANGE -10.0 .. 10.0;
+
+          TEST_VAR : FIXD := 0.0;
+          FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
+          USE SYSTEM;
+
+          FUNCTION IDENT_FIXD (P : FIXD) RETURN FIXD IS
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    RETURN P;
+               ELSE
+                    RETURN 0.0;
+               END IF;
+          END IDENT_FIXD;
+     BEGIN
+          TEST ("CD5003G", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT " &
+                           "BE GIVEN FOR A GENERIC PROCEDURE BODY " &
+                           "CONTAINING AN ADDRESS CLAUSE AS LONG AS " &
+                           "A 'WITH' CLAUSE IS GIVEN FOR THE UNIT " &
+                           "CONTAINING THE GENERIC PROCEDURE " &
+                           "SPECIFICATION");
+
+          TEST_VAR := IDENT_FIXD (3.3);
+
+          IF TEST_VAR /= 3.3 THEN
+               FAILED ("INCORRECT VALUE FOR TEST_VAR");
+          END IF;
+
+          IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
+          END IF;
+
+         RESULT;
+     END CD5003G_PROC2;
+END CD5003G_PACK2;
+
+
+WITH CD5003G_PACK2; USE CD5003G_PACK2;
+PROCEDURE CD5003G IS
+     PROCEDURE PROC3 IS NEW CD5003G_PROC2;
+BEGIN
+     PROC3;
+END CD5003G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003h.ada
new file mode 100644
index 000000000..c0418568d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003h.ada
@@ -0,0 +1,89 @@
+-- CD5003H.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 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
+--     FOR A GENERIC PACKAGE BODY SUBUNIT CONTAINING AN ADDRESS
+--     CLAUSE AS LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT
+--     CONTAINING THE GENERIC PACKAGE SPECIFICATION.
+
+-- HISTORY:
+--     VCL  09/09/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+-- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+WITH SYSTEM;
+PACKAGE CD5003H_PACK3 IS
+
+     PROCEDURE REQUIRE_BODY;
+
+     GENERIC
+     PACKAGE PACK4 IS END PACK4;
+END CD5003H_PACK3;
+
+PACKAGE BODY CD5003H_PACK3 IS
+
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+       NULL;
+     END;
+
+     PACKAGE BODY PACK4 IS SEPARATE;
+END CD5003H_PACK3;
+
+WITH SPPRT13;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (SPPRT13);
+PRAGMA ELABORATE (REPORT);
+SEPARATE (CD5003H_PACK3)
+PACKAGE BODY PACK4 IS
+     TEST_VAR : INTEGER := 0;
+     FOR TEST_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
+     USE SYSTEM;
+BEGIN
+     TEST ("CD5003H", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE " &
+                      "GIVEN FOR A GENERIC PACKAGE BODY SUBUNIT " &
+                      "CONTAINING AN ADDRESS CLAUSE AS LONG AS " &
+                      "A 'WITH' CLAUSE IS GIVEN FOR THE UNIT " &
+                      "CONTAINING THE GENERIC PACKAGE SPECIFICATION.");
+
+     TEST_VAR := IDENT_INT (3);
+
+     IF TEST_VAR /= 3 THEN
+          FAILED ("INCORRECT VALUE FOR TEST_VAR");
+     END IF;
+
+     IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
+     END IF;
+END PACK4;
+
+WITH CD5003H_PACK3; USE CD5003H_PACK3;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PROCEDURE CD5003H IS
+     PACKAGE PACK5 IS NEW PACK4;
+BEGIN
+    RESULT;
+END CD5003H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003i.ada
new file mode 100644
index 000000000..7ea6dc715
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5003i.ada
@@ -0,0 +1,94 @@
+-- CD5003I.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 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE GIVEN
+--     FOR A GENERIC PROCEDURE BODY SUBUNIT CONTAINING AN ADDRESS
+--     CLAUSE AS LONG AS A 'WITH' CLAUSE IS GIVEN FOR THE UNIT
+--     CONTAINING THE GENERIC PROCEDURE SPECIFICATION.
+
+-- HISTORY:
+--     VCL  09/09/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+PACKAGE CD5003I_PACK3 IS
+     GENERIC
+     PROCEDURE PROC2;
+END CD5003I_PACK3;
+
+WITH SYSTEM;
+PACKAGE BODY CD5003I_PACK3 IS
+     PROCEDURE PROC2 IS SEPARATE;
+END CD5003I_PACK3;
+
+WITH SPPRT13;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (SPPRT13);
+PRAGMA ELABORATE (REPORT);
+SEPARATE (CD5003I_PACK3)
+PROCEDURE PROC2 IS
+     TYPE FIXD IS DELTA 0.1 RANGE -10.0 .. 10.0;
+
+     TEST_VAR : FIXD;
+     FOR TEST_VAR
+               USE AT SPPRT13.VARIABLE_ADDRESS;
+
+     USE SYSTEM;
+
+     FUNCTION IDENT (P : FIXD) RETURN FIXD IS
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               RETURN P;
+          ELSE
+               RETURN 0.0;
+          END IF;
+     END IDENT;
+BEGIN
+     TEST ("CD5003I", "A 'WITH' CLAUSE NAMING 'SYSTEM' NEED NOT BE " &
+                      "GIVEN FOR A GENERIC PROCEDURE BODY SUBUNIT " &
+                      "CONTAINING AN ADDRESS CLAUSE AS LONG AS A " &
+                      "'WITH' CLAUSE IS GIVEN FOR THE UNIT " &
+                      "CONTAINING THE GENERIC PROCEDURE SPECIFICATION");
+
+     TEST_VAR := IDENT (3.3);
+
+     IF TEST_VAR /= 3.3 THEN
+          FAILED ("INCORRECT VALUE FOR TEST_VAR");
+     END IF;
+
+     IF TEST_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR TEST_VAR");
+     END IF;
+
+     RESULT;
+END PROC2;
+
+WITH CD5003I_PACK3; USE CD5003I_PACK3;
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PROCEDURE CD5003I IS
+     PROCEDURE PROC3 IS NEW PROC2;
+BEGIN
+     PROC3;
+END CD5003I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011a.ada
new file mode 100644
index 000000000..b586f0d9c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011a.ada
@@ -0,0 +1,87 @@
+-- CD5011A.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF AN
+--     ENUMERATION TYPE IN THE DECLARATIVE PART OF A SUBPROGRAM.
+
+-- HISTORY:
+--     PWB 08/06/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+PROCEDURE CD5011A IS
+
+     TYPE ENUM IS (RED, BLUE, 'R', 'B');
+
+     PROCEDURE MIX IS
+          HUE : ENUM := RED;
+          FOR HUE USE
+               AT SPPRT13.VARIABLE_ADDRESS;
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               HUE := BLUE;
+          END IF;
+          IF HUE /= BLUE THEN
+               FAILED ("WRONG VALUE FOR VARIABLE IN PROCEDURE");
+          END IF;
+          IF HUE'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("WRONG ADDRESS FOR VARIABLE IN PROCEDURE");
+          END IF;
+     END MIX;
+
+     FUNCTION FIX RETURN BOOLEAN IS
+          LETTER : ENUM := 'R';
+          FOR LETTER USE AT
+                    SPPRT13.VARIABLE_ADDRESS;
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               LETTER := 'B';
+          END IF;
+          IF LETTER /= ENUM'LAST THEN
+               FAILED ("WRONG VALUE FOR VARIABLE IN FUNCTION");
+          END IF;
+          IF LETTER'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("WRONG ADDRESS FOR VARIABLE IN FUNCTION");
+          END IF;
+          RETURN EQUAL(3,3);
+     END FIX;
+
+BEGIN
+
+     TEST ("CD5011A", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF AN ENUMERATION " &
+                      "TYPE IN THE DECLARATIVE PART OF A " &
+                      "SUBPROGRAM.");
+
+     IF NOT FIX THEN
+          FAILED ("FUNCTION FIX YIELDS WRONG VALUE");
+     END IF;
+
+     MIX;
+     RESULT;
+
+END CD5011A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011c.ada
new file mode 100644
index 000000000..45b2490c8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011c.ada
@@ -0,0 +1,69 @@
+-- CD5011C.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF
+--     AN INTEGER TYPE IN THE DECLARATIVE PART OF A PACKAGE BODY.
+
+-- HISTORY:
+--     JET 09/11/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+
+PROCEDURE CD5011C IS
+
+     PACKAGE CD5011C_PACKAGE IS
+     END CD5011C_PACKAGE;
+
+     PACKAGE BODY CD5011C_PACKAGE IS
+
+          INT : INTEGER := 0;
+          FOR INT USE
+               AT SPPRT13.VARIABLE_ADDRESS;
+
+     BEGIN
+          TEST ("CD5011C", "AN ADDRESS CLAUSE CAN BE " &
+                           "GIVEN FOR A VARIABLE OF AN INTEGER " &
+                           "TYPE IN THE DECLARATIVE PART OF A " &
+                           "PACKAGE BODY");
+
+          IF EQUAL (3, 3) THEN
+               INT := 5;
+          END IF;
+          IF INT /= IDENT_INT (5) THEN
+               FAILED ("WRONG VALUE FOR VARIABLE IN PACKAGE");
+          END IF;
+          IF INT'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("WRONG ADDRESS FOR VARIABLE IN PACKAGE");
+          END IF;
+     END;
+
+BEGIN
+
+     RESULT;
+
+END CD5011C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011e.ada
new file mode 100644
index 000000000..2806fb229
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011e.ada
@@ -0,0 +1,70 @@
+-- CD5011E.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
+--     FLOATING POINT TYPE IN THE DECLARATIVE PART OF A BLOCK
+--     STATEMENT.
+
+-- HISTORY:
+--     JET 09/11/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+
+PROCEDURE CD5011E IS
+
+BEGIN
+
+     TEST ("CD5011E", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF A FLOATING POINT " &
+                      "TYPE IN THE DECLARATIVE PART OF A " &
+                      "BLOCK STATEMENT");
+
+     DECLARE
+
+          FP : FLOAT := 3.0;
+          FOR FP USE
+               AT SPPRT13.VARIABLE_ADDRESS;
+
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               FP := 2.0;
+          END IF;
+
+          IF FP /= 2.0 THEN
+               FAILED ("WRONG VALUE FOR VARIABLE IN BLOCK");
+          END IF;
+
+          IF FP'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("WRONG ADDRESS FOR VARIABLE IN BLOCK");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END CD5011E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011g.ada
new file mode 100644
index 000000000..1b63ba50c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011g.ada
@@ -0,0 +1,72 @@
+-- CD5011G.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
+--     FIXED POINT TYPE IN THE DECLARATIVE PART OF A SUBPROGRAM.
+
+-- HISTORY:
+--     JET 09/11/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+
+PROCEDURE CD5011G IS
+
+     TYPE FIX_TYPE IS DELTA 0.125 RANGE 0.0 .. 10.0;
+
+     PROCEDURE CD5011G_PROC IS
+
+          FP : FIX_TYPE := 2.0;
+          FOR FP USE
+               AT SPPRT13.VARIABLE_ADDRESS;
+
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               FP := 3.0;
+          END IF;
+
+          IF FP /= 3.0 THEN
+               FAILED ("INCORRECT VALUE FOR VARIABLE IN PROCEDURE");
+          END IF;
+
+          IF FP'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR VARIABLE IN PROCEDURE");
+          END IF;
+
+     END CD5011G_PROC;
+
+BEGIN
+     TEST ("CD5011G", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF A FIXED POINT " &
+                      "TYPE IN THE DECLARATIVE PART OF A " &
+                      "SUBPROGRAM");
+
+     CD5011G_PROC;
+
+     RESULT;
+
+END CD5011G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011i.ada
new file mode 100644
index 000000000..a0a841879
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011i.ada
@@ -0,0 +1,74 @@
+-- CD5011I.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF
+--     AN ARRAY TYPE IN THE DECLARATIVE PART OF A PACKAGE BODY.
+
+-- HISTORY:
+--     JET 09/11/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+
+PROCEDURE CD5011I IS
+
+     PACKAGE CD5011I_PACKAGE IS
+     END CD5011I_PACKAGE;
+
+     PACKAGE BODY CD5011I_PACKAGE IS
+
+          INT : ARRAY (1 .. 10) OF INTEGER;
+          FOR INT USE
+               AT SPPRT13.VARIABLE_ADDRESS;
+
+     BEGIN
+          TEST ("CD5011I", "AN ADDRESS CLAUSE CAN BE " &
+                           "GIVEN FOR A VARIABLE OF AN ARRAY " &
+                           "TYPE IN THE DECLARATIVE PART OF A " &
+                           "PACKAGE BODY");
+
+          FOR I IN INT'RANGE LOOP
+               INT (I) := IDENT_INT (I);
+          END LOOP;
+
+          FOR I IN INT'RANGE LOOP
+               IF INT (I) /= I THEN
+                    FAILED ("WRONG VALUE FOR ELEMENT" &
+                            INTEGER'IMAGE (I));
+               END IF;
+          END LOOP;
+
+          IF INT'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("WRONG ADDRESS FOR VARIABLE IN PACKAGE");
+          END IF;
+     END;
+
+BEGIN
+
+     RESULT;
+
+END CD5011I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011k.ada
new file mode 100644
index 000000000..6c4a16a3e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011k.ada
@@ -0,0 +1,75 @@
+-- CD5011K.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
+--     RECORD TYPE IN THE DECLARATIVE PART OF A BLOCK STATEMENT.
+
+-- HISTORY:
+--     JET 09/15/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+
+PROCEDURE CD5011K IS
+
+BEGIN
+
+     TEST ("CD5011K", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF A RECORD " &
+                      "TYPE IN THE DECLARATIVE PART OF A " &
+                      "BLOCK STATEMENT");
+
+     DECLARE
+
+          TYPE REC_TYPE IS RECORD
+               I : INTEGER := 12;
+               B : BOOLEAN := TRUE;
+          END RECORD;
+
+          REC : REC_TYPE;
+          FOR REC USE
+               AT SPPRT13.VARIABLE_ADDRESS;
+
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               REC.I := 17;
+               REC.B := FALSE;
+          END IF;
+
+          IF REC.I /= 17 OR REC.B THEN
+               FAILED ("WRONG VALUE FOR VARIABLE IN BLOCK");
+          END IF;
+
+          IF REC'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("WRONG ADDRESS FOR VARIABLE IN BLOCK");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END CD5011K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011m.ada
new file mode 100644
index 000000000..25d6f856e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011m.ada
@@ -0,0 +1,72 @@
+-- CD5011M.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF
+--     AN ACCESS TYPE IN THE DECLARATIVE PART OF A SUBPROGRAM.
+
+-- HISTORY:
+--     JET 09/15/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+
+PROCEDURE CD5011M IS
+
+     TYPE ACC_TYPE IS ACCESS STRING;
+
+     PROCEDURE CD5011M_PROC IS
+
+          ACC : ACC_TYPE := NEW STRING'("THE QUICK BROWN FOX");
+          FOR ACC USE
+               AT SPPRT13.VARIABLE_ADDRESS;
+
+     BEGIN
+          IF EQUAL (3, 3) THEN
+               ACC := NEW STRING'("THE LAZY DOG");
+          END IF;
+
+          IF ACC.ALL /= IDENT_STR ("THE LAZY DOG") THEN
+               FAILED ("INCORRECT VALUE FOR VARIABLE IN PROCEDURE");
+          END IF;
+
+          IF ACC'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR VARIABLE IN PROCEDURE");
+          END IF;
+
+     END CD5011M_PROC;
+
+BEGIN
+     TEST ("CD5011M", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF AN ACCESS " &
+                      "TYPE IN THE DECLARATIVE PART OF A " &
+                      "SUBPROGRAM");
+
+     CD5011M_PROC;
+
+     RESULT;
+
+END CD5011M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011q.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011q.ada
new file mode 100644
index 000000000..4b9bf5c36
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011q.ada
@@ -0,0 +1,91 @@
+-- CD5011Q.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
+--     PRIVATE TYPE IN THE DECLARATIVE PART OF A BLOCK STATEMENT.
+
+-- HISTORY:
+--     JET 09/15/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+
+PROCEDURE CD5011Q IS
+
+     PACKAGE P IS
+          TYPE PRIV_TYPE IS PRIVATE;
+          FUNCTION INT_TO_PRIV (I : INTEGER) RETURN PRIV_TYPE;
+          FUNCTION EQUAL (P : PRIV_TYPE; I : INTEGER) RETURN BOOLEAN;
+     PRIVATE
+          TYPE PRIV_TYPE IS NEW INTEGER;
+     END P;
+
+     PACKAGE BODY P IS
+
+          FUNCTION INT_TO_PRIV (I : INTEGER) RETURN PRIV_TYPE IS
+               BEGIN
+                    RETURN PRIV_TYPE(I);
+               END;
+
+          FUNCTION EQUAL (P : PRIV_TYPE; I : INTEGER) RETURN BOOLEAN IS
+               BEGIN
+                    RETURN (P = PRIV_TYPE(I));
+               END;
+
+     END P;
+
+     USE P;
+
+BEGIN
+
+     TEST ("CD5011Q", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF A PRIVATE " &
+                      "TYPE IN THE DECLARATIVE PART OF A " &
+                      "BLOCK STATEMENT");
+
+     DECLARE
+
+          PRIV : PRIV_TYPE := INT_TO_PRIV (12);
+          FOR PRIV USE
+               AT SPPRT13.VARIABLE_ADDRESS;
+
+     BEGIN
+          PRIV := INT_TO_PRIV (17);
+
+          IF NOT EQUAL (PRIV, IDENT_INT (17)) THEN
+               FAILED ("INCORRECT VALUE FOR VARIABLE OF PRIVATE TYPE");
+          END IF;
+
+          IF PRIV'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR VARIABLE OF " &
+                       "PRIVATE TYPE");
+          END IF;
+     END;
+
+     RESULT;
+
+END CD5011Q;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011s.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011s.ada
new file mode 100644
index 000000000..2943892da
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5011s.ada
@@ -0,0 +1,89 @@
+-- CD5011S.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
+--     LIMITED PRIVATE TYPE IN THE DECLARATIVE PART OF A SUBPROGRAM.
+
+-- HISTORY:
+--     JET 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+
+PROCEDURE CD5011S IS
+
+     PACKAGE P IS
+          TYPE LIMP_TYPE IS LIMITED PRIVATE;
+          PROCEDURE TEST_LIMP (LIMP : IN OUT LIMP_TYPE);
+     PRIVATE
+          TYPE LIMP_TYPE IS ARRAY (1 .. 10) OF INTEGER;
+     END P;
+
+     PACKAGE BODY P IS
+          PROCEDURE TEST_LIMP (LIMP : IN OUT LIMP_TYPE) IS
+          BEGIN
+               FOR I IN LIMP'RANGE LOOP
+                    LIMP (I) := IDENT_INT (I);
+               END LOOP;
+
+               FOR I IN LIMP'RANGE LOOP
+                    IF LIMP (I) /= I THEN
+                         FAILED ("INCORRECT VALUE FOR ELEMENT" &
+                                 INTEGER'IMAGE (I));
+                    END IF;
+               END LOOP;
+          END TEST_LIMP;
+     END P;
+
+     USE P;
+
+     PROCEDURE CD5011S_PROC IS
+
+          LIMP : LIMP_TYPE;
+          FOR LIMP USE
+               AT SPPRT13.VARIABLE_ADDRESS;
+
+     BEGIN
+          TEST_LIMP (LIMP);
+
+          IF LIMP'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+               FAILED ("WRONG ADDRESS FOR VARIABLE OF A LIMITED " &
+                       "PRIVATE TYPE");
+          END IF;
+     END;
+
+BEGIN
+     TEST ("CD5011S", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF A LIMITED " &
+                      "PRIVATE TYPE IN THE DECLARATIVE PART " &
+                      "OF A SUBPROGRAM");
+
+     CD5011S_PROC;
+
+     RESULT;
+
+END CD5011S;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012a.ada
new file mode 100644
index 000000000..05cb7babd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012a.ada
@@ -0,0 +1,78 @@
+-- CD5012A.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF AN
+--     ENUMERATION TYPE IN THE DECLARATIVE PART OF A GENERIC SUBPROGRAM.
+
+-- HISTORY:
+--     DHH 09/15/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+PROCEDURE CD5012A IS
+
+BEGIN
+
+     TEST ("CD5012A", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF AN ENUMERATION " &
+                      "TYPE IN THE DECLARATIVE PART OF A " &
+                      "GENERIC SUBPROGRAM");
+
+     DECLARE
+          TYPE NON_CHAR IS (RED, BLUE, GREEN);
+
+          COLOR : NON_CHAR;
+          TEST_VAR : ADDRESS := COLOR'ADDRESS;
+
+          GENERIC
+          PROCEDURE GENPROC;
+
+          PROCEDURE GENPROC IS
+
+               HUE : NON_CHAR := GREEN;
+               FOR HUE USE AT
+                        SPPRT13.VARIABLE_ADDRESS;
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    HUE := RED;
+               END IF;
+               IF HUE /= RED THEN
+                    FAILED ("WRONG VALUE FOR VARIABLE IN " &
+                            "GENERIC PROCEDURE");
+               END IF;
+               IF HUE'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+                    FAILED ("WRONG ADDRESS FOR VARIABLE " &
+                            "IN GENERIC PROCEDURE");
+               END IF;
+          END GENPROC;
+
+          PROCEDURE PROC IS NEW GENPROC;
+     BEGIN
+          PROC;
+     END;
+     RESULT;
+END CD5012A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012b.ada
new file mode 100644
index 000000000..455fe8564
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012b.ada
@@ -0,0 +1,77 @@
+-- CD5012B.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF AN
+--     INTEGER TYPE IN THE DECLARATIVE PART OF A GENERIC PACKAGE BODY.
+
+-- HISTORY:
+--     DHH 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+PROCEDURE CD5012B IS
+
+BEGIN
+
+     TEST ("CD5012B", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF AN INTEGER " &
+                      "TYPE IN THE DECLARATIVE PART OF A " &
+                      "GENERIC PACKAGE BODY");
+
+     DECLARE
+
+          GENERIC
+          PACKAGE GENPACK IS
+          END GENPACK;
+
+          PACKAGE BODY GENPACK IS
+
+               INT2 : INTEGER :=2;
+
+               FOR INT2 USE AT
+                      SPPRT13.VARIABLE_ADDRESS;
+
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    INT2 := 1;
+               END IF;
+               IF INT2 /= 1 THEN
+                    FAILED ("WRONG VALUE FOR VARIABLE IN " &
+                            "A GENERIC PACKAGE BODY");
+               END IF;
+               IF INT2'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+                    FAILED ("WRONG ADDRESS FOR VARIABLE " &
+                            "IN A GENERIC PACKAGE BODY");
+               END IF;
+          END GENPACK;
+
+          PACKAGE PACK IS NEW GENPACK;
+     BEGIN
+          NULL;
+     END;
+     RESULT;
+END CD5012B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012e.ada
new file mode 100644
index 000000000..bfcd2f545
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012e.ada
@@ -0,0 +1,76 @@
+-- CD5012E.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
+--     FIXED POINT TYPE IN THE DECLARATIVE PART OF A GENERIC SUBPROGRAM.
+
+-- HISTORY:
+--     DHH 09/15/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+PROCEDURE CD5012E IS
+
+BEGIN
+
+     TEST ("CD5012E", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF A FIXED POINT " &
+                      "TYPE IN THE DECLARATIVE PART OF A " &
+                      "GENERIC SUBPROGRAM");
+
+     DECLARE
+
+          GENERIC
+          PROCEDURE GENPROC;
+
+          PROCEDURE GENPROC IS
+
+               TYPE FIXED IS DELTA 2.0**(-4) RANGE -10.0..10.0;
+
+               TESTFIX : FIXED := 0.0;
+               FOR TESTFIX USE AT SPPRT13.VARIABLE_ADDRESS;
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    TESTFIX := 1.0;
+               END IF;
+               IF TESTFIX /= 1.0 THEN
+                    FAILED ("WRONG VALUE FOR VARIABLE IN " &
+                                 "A GENERIC PROCEDURE");
+               END IF;
+               IF TESTFIX'ADDRESS /=
+                        SPPRT13.VARIABLE_ADDRESS THEN
+                    FAILED ("WRONG ADDRESS FOR VARIABLE " &
+                                   "IN A GENERIC PROCEDURE");
+               END IF;
+          END GENPROC;
+
+          PROCEDURE PROC IS NEW GENPROC;
+     BEGIN
+          PROC;
+     END;
+     RESULT;
+END CD5012E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012f.ada
new file mode 100644
index 000000000..69fb2e80b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012f.ada
@@ -0,0 +1,78 @@
+-- CD5012F.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF AN
+--     ARRAY TYPE IN THE DECLARATIVE PART OF A GENERIC
+--     PACKAGE BODY.
+
+-- HISTORY:
+--     DHH 09/17/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+PROCEDURE CD5012F IS
+
+BEGIN
+
+     TEST ("CD5012F", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF AN ARRAY " &
+                      "TYPE IN THE DECLARATIVE " &
+                      "PART OF A GENERIC PACKAGE BODY");
+
+     DECLARE
+
+          GENERIC
+          PACKAGE GENPACK IS
+
+          END GENPACK;
+
+          PACKAGE BODY GENPACK IS
+               ARRAY_VAR : ARRAY (0..4) OF INTEGER := (0,1,2,3,4);
+
+               FOR ARRAY_VAR USE AT SPPRT13.VARIABLE_ADDRESS;
+
+
+          BEGIN
+               IF EQUAL (3, 3) THEN
+                    ARRAY_VAR := (4,3,2,1,0);
+               END IF;
+               IF ARRAY_VAR /= (4,3,2,1,0) THEN
+                    FAILED ("WRONG VALUE FOR VARIABLE IN " &
+                            "A GENERIC PACKAGE BODY");
+               END IF;
+               IF ARRAY_VAR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+                    FAILED ("WRONG ADDRESS FOR VARIABLE " &
+                            "IN A GENERIC PACKAGE BODY");
+               END IF;
+          END GENPACK;
+
+          PACKAGE PACK IS NEW GENPACK;
+     BEGIN
+          NULL;
+     END;
+     RESULT;
+END CD5012F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012i.ada
new file mode 100644
index 000000000..1be46d425
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012i.ada
@@ -0,0 +1,87 @@
+-- CD5012I.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF AN
+--     ACCESS TYPE IN THE DECLARATIVE PART OF A GENERIC SUBPROGRAM.
+
+-- HISTORY:
+--     DHH 09/17/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+PROCEDURE CD5012I IS
+
+BEGIN
+
+     TEST ("CD5012I", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF AN ACCESS " &
+                      "TYPE IN THE DECLARATIVE PART OF A " &
+                      "GENERIC SUBPROGRAM");
+
+     DECLARE
+
+          GENERIC
+          PROCEDURE GENPROC;
+
+          PROCEDURE GENPROC IS
+
+               TYPE CELL;
+               TYPE POINTER IS ACCESS CELL;
+               TYPE CELL IS
+                    RECORD
+                         VALUE : INTEGER;
+                         NEXT : POINTER;
+                    END RECORD;
+
+               C,PTR : POINTER := NULL;
+
+               FOR PTR USE AT
+                      SPPRT13.VARIABLE_ADDRESS;
+          BEGIN
+               PTR := NEW CELL'(0,NULL);
+               C := PTR;
+
+               IF EQUAL (3, 3) THEN
+                    PTR.VALUE := 1;
+                    PTR.NEXT := C;
+               END IF;
+               IF PTR.ALL /= (1,C) THEN
+                    FAILED ("WRONG VALUE FOR VARIABLE IN " &
+                            "A GENERIC PROCEDURE");
+               END IF;
+               IF PTR'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+                    FAILED ("WRONG ADDRESS FOR VARIABLE " &
+                            "IN A GENERIC PROCEDURE");
+               END IF;
+          END GENPROC;
+
+          PROCEDURE PROC IS NEW GENPROC;
+     BEGIN
+          PROC;
+     END;
+     RESULT;
+END CD5012I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012m.ada
new file mode 100644
index 000000000..1cd3c218e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5012m.ada
@@ -0,0 +1,78 @@
+-- CD5012M.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 ADDRESS CLAUSE CAN BE GIVEN FOR A VARIABLE OF A
+--     LIMITED PRIVATE TYPE IN THE DECLARATIVE PART OF A GENERIC
+--     SUBPROGRAM.
+
+-- HISTORY:
+--     DHH 09/15/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH REPORT; USE REPORT;
+WITH SPPRT13;
+PROCEDURE CD5012M IS
+
+BEGIN
+
+     TEST ("CD5012M", "AN ADDRESS CLAUSE CAN BE " &
+                      "GIVEN FOR A VARIABLE OF A LIMITED " &
+                      "PRIVATE TYPE IN THE DECLARATIVE " &
+                      "PART OF A GENERIC SUBPROGRAM");
+
+     DECLARE
+
+          PACKAGE P IS
+               TYPE FIXED IS LIMITED PRIVATE;
+
+          PRIVATE
+               TYPE FIXED IS DELTA 2.0**(-4) RANGE -10.0..10.0;
+          END P;
+
+          USE P;
+
+          GENERIC
+          PROCEDURE GENPROC;
+
+          PROCEDURE GENPROC IS
+
+               TESTFIX : FIXED;
+
+               FOR TESTFIX USE AT
+                 SPPRT13.VARIABLE_ADDRESS;
+          BEGIN
+               IF TESTFIX'ADDRESS /= SPPRT13.VARIABLE_ADDRESS THEN
+                    FAILED ("WRONG ADDRESS FOR LIMITED PRIVATE " &
+                            "TYPE VARIABLE IN GENERIC PROCEDURE");
+               END IF;
+          END GENPROC;
+
+     PROCEDURE PROC IS NEW GENPROC;
+     BEGIN
+          PROC;
+     END;
+     RESULT;
+END CD5012M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013a.ada
new file mode 100644
index 000000000..ad7650e45
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013a.ada
@@ -0,0 +1,72 @@
+-- CD5013A.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 ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART OF
+--     A PACKAGE SPECIFICATION FOR A VARIABLE OF AN ENUMERATION TYPE,
+--     WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+-- HISTORY:
+--     BCB 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+WITH SPPRT13; USE SPPRT13;
+WITH SYSTEM;  USE SYSTEM;
+
+PROCEDURE CD5013A IS
+
+     TYPE ENUM_TYPE IS (ONE,TWO,THREE,FOUR,FIVE,SIX);
+
+     PACKAGE PACK IS
+          CHECK_TYPE : ENUM_TYPE;
+          FOR CHECK_TYPE USE AT VARIABLE_ADDRESS;
+     END PACK;
+
+     USE PACK;
+
+BEGIN
+
+     TEST ("CD5013A", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
+                      "THE VISIBLE PART OF A PACKAGE SPECIFICATION " &
+                      "FOR A VARIABLE OF AN ENUMERATION TYPE, WHERE " &
+                      "THE VARIABLE IS DECLARED IN THE VISIBLE PART " &
+                      "OF THE SPECIFICATION");
+
+     CHECK_TYPE := ONE;
+     IF EQUAL(3,3) THEN
+          CHECK_TYPE := THREE;
+     END IF;
+
+     IF CHECK_TYPE /= THREE THEN
+          FAILED ("INCORRECT VALUE FOR ENUMERATION VARIABLE");
+     END IF;
+
+     IF CHECK_TYPE'ADDRESS /= VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR ENUMERATION VARIABLE");
+     END IF;
+
+     RESULT;
+END CD5013A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013c.ada
new file mode 100644
index 000000000..f00dfecb6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013c.ada
@@ -0,0 +1,73 @@
+-- CD5013C.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART OF
+--     A PACKAGE SPECIFICATION FOR A VARIABLE OF AN INTEGER TYPE, WHERE
+--     THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+-- HISTORY:
+--     BCB 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+WITH SPPRT13; USE SPPRT13;
+WITH SYSTEM;  USE SYSTEM;
+
+PROCEDURE CD5013C IS
+
+     TYPE INT_TYPE IS RANGE INTEGER'FIRST .. INTEGER'LAST;
+
+     PACKAGE PACK IS
+          CHECK_VAR : INT_TYPE;
+     PRIVATE
+          FOR CHECK_VAR USE AT VARIABLE_ADDRESS;
+     END PACK;
+
+     USE PACK;
+
+BEGIN
+
+     TEST ("CD5013C", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
+                      "THE PRIVATE PART OF A PACKAGE SPECIFICATION " &
+                      "FOR A VARIABLE OF AN INTEGER TYPE, WHERE THE " &
+                      "VARIABLE IS DECLARED IN THE VISIBLE PART OF " &
+                      "THE SPECIFICATION");
+
+     CHECK_VAR := 100;
+     IF EQUAL(3,3) THEN
+          CHECK_VAR := 10;
+     END IF;
+
+     IF CHECK_VAR /= 10 THEN
+          FAILED ("INCORRECT VALUE FOR INTEGER VARIABLE");
+     END IF;
+
+     IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR INTEGER VARIABLE");
+     END IF;
+
+     RESULT;
+END CD5013C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013e.ada
new file mode 100644
index 000000000..cb04cfd62
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013e.ada
@@ -0,0 +1,72 @@
+-- CD5013E.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 ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART OF
+--     A PACKAGE SPECIFICATION FOR A VARIABLE OF A FLOATING POINT TYPE,
+--     WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+-- HISTORY:
+--     BCB 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+WITH SPPRT13; USE SPPRT13;
+WITH SYSTEM;  USE SYSTEM;
+
+PROCEDURE CD5013E IS
+
+     TYPE FLT_TYPE IS DIGITS 5 RANGE -1.0 .. 1.0;
+
+     PACKAGE PACK IS
+          CHECK_VAR : FLT_TYPE;
+          FOR CHECK_VAR USE AT VARIABLE_ADDRESS;
+     END PACK;
+
+     USE PACK;
+
+BEGIN
+
+     TEST ("CD5013E", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
+                      "THE VISIBLE PART OF A PACKAGE SPECIFICATION " &
+                      "FOR A VARIABLE OF A FLOATING POINT TYPE, " &
+                      "WHERE THE VARIABLE IS DECLARED IN THE VISIBLE " &
+                      "PART OF THE SPECIFICATION");
+
+     CHECK_VAR := 0.5;
+     IF EQUAL(3,3) THEN
+          CHECK_VAR := 0.0;
+     END IF;
+
+     IF CHECK_VAR /= 0.0 THEN
+          FAILED ("INCORRECT VALUE FOR FLOATING POINT VARIABLE");
+     END IF;
+
+     IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR FLOATING POINT VARIABLE");
+     END IF;
+
+     RESULT;
+END CD5013E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013g.ada
new file mode 100644
index 000000000..355c682c3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013g.ada
@@ -0,0 +1,74 @@
+-- CD5013G.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART OF
+--     A PACKAGE SPECIFICATION FOR A VARIABLE OF A FIXED POINT TYPE,
+--     WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+-- HISTORY:
+--     BCB 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+WITH SPPRT13; USE SPPRT13;
+WITH SYSTEM;  USE SYSTEM;
+
+PROCEDURE CD5013G IS
+
+     TYPE FIX_TYPE IS DELTA 0.5 RANGE -7.5 .. 7.5;
+
+     PACKAGE PACK IS
+          CHECK_VAR : FIX_TYPE;
+     PRIVATE
+          FOR CHECK_VAR USE
+               AT VARIABLE_ADDRESS;
+     END PACK;
+
+     USE PACK;
+
+BEGIN
+
+     TEST ("CD5013G", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
+                      "THE PRIVATE PART OF A PACKAGE SPECIFICATION " &
+                      "FOR A VARIABLE OF A FIXED POINT TYPE, " &
+                      "WHERE THE VARIABLE IS DECLARED IN THE VISIBLE " &
+                      "PART OF THE SPECIFICATION");
+
+     CHECK_VAR := 1.5;
+     IF EQUAL(3,3) THEN
+          CHECK_VAR := 5.0;
+     END IF;
+
+     IF CHECK_VAR /= 5.0 THEN
+          FAILED ("INCORRECT VALUE FOR FIXED POINT VARIABLE");
+     END IF;
+
+     IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR FIXED POINT VARIABLE");
+     END IF;
+
+     RESULT;
+END CD5013G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013i.ada
new file mode 100644
index 000000000..7a405b28a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013i.ada
@@ -0,0 +1,73 @@
+-- CD5013I.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 ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART OF
+--     A PACKAGE SPECIFICATION FOR A VARIABLE OF AN ARRAY TYPE, WHERE
+--     THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+-- HISTORY:
+--     BCB 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+WITH SPPRT13; USE SPPRT13;
+WITH SYSTEM;  USE SYSTEM;
+
+PROCEDURE CD5013I IS
+
+     TYPE ARR_TYPE IS ARRAY(1..5) OF INTEGER;
+
+     PACKAGE PACK IS
+          CHECK_VAR : ARR_TYPE;
+          FOR CHECK_VAR USE
+               AT VARIABLE_ADDRESS;
+     END PACK;
+
+     USE PACK;
+
+BEGIN
+
+     TEST ("CD5013I", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
+                      "THE VISIBLE PART OF A PACKAGE SPECIFICATION " &
+                      "FOR A VARIABLE OF AN ARRAY TYPE, WHERE THE " &
+                      "VARIABLE IS DECLARED IN THE VISIBLE PART OF " &
+                      "THE SPECIFICATION");
+
+     CHECK_VAR := (1,2,3,4,5);
+     IF EQUAL(3,3) THEN
+          CHECK_VAR := (5,4,3,2,1);
+     END IF;
+
+     IF CHECK_VAR /= (5,4,3,2,1) THEN
+          FAILED ("INCORRECT VALUE FOR ARRAY VARIABLE");
+     END IF;
+
+     IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR ARRAY VARIABLE");
+     END IF;
+
+     RESULT;
+END CD5013I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013k.ada
new file mode 100644
index 000000000..469abf4a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013k.ada
@@ -0,0 +1,78 @@
+-- CD5013K.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART OF
+--     A PACKAGE SPECIFICATION FOR A VARIABLE OF A RECORD TYPE, WHERE
+--     THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+-- HISTORY:
+--     BCB 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+WITH SPPRT13; USE SPPRT13;
+WITH SYSTEM;  USE SYSTEM;
+
+PROCEDURE CD5013K IS
+
+     TYPE REC_TYPE IS RECORD
+          BOOL : BOOLEAN;
+          INT  : INTEGER;
+     END RECORD;
+
+     PACKAGE PACK IS
+          CHECK_VAR : REC_TYPE;
+     PRIVATE
+          FOR CHECK_VAR USE
+               AT VARIABLE_ADDRESS;
+     END PACK;
+
+     PACKAGE BODY PACK IS
+     BEGIN
+          TEST ("CD5013K", "AN ADDRESS CLAUSE CAN BE GIVEN " &
+                           "IN THE PRIVATE PART OF A PACKAGE " &
+                           "SPECIFICATION FOR A VARIABLE OF A RECORD " &
+                           "TYPE, WHERE THE VARIABLE IS DECLARED IN " &
+                           "THE VISIBLE PART OF THE SPECIFICATION");
+
+          CHECK_VAR := (TRUE, IDENT_INT(5));
+          IF EQUAL(3,3) THEN
+               CHECK_VAR := (FALSE, IDENT_INT(10));
+          END IF;
+
+          IF CHECK_VAR /= (FALSE, IDENT_INT (10)) THEN
+               FAILED ("INCORRECT VALUE FOR RECORD VARIABLE");
+          END IF;
+
+          IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR RECORD VARIABLE");
+          END IF;
+     END PACK;
+
+BEGIN
+
+     RESULT;
+END CD5013K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013m.ada
new file mode 100644
index 000000000..2e4838606
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013m.ada
@@ -0,0 +1,73 @@
+-- CD5013M.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 ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART OF
+--     A PACKAGE SPECIFICATION FOR A VARIABLE OF AN ACCESS TYPE, WHERE
+--     THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+-- HISTORY:
+--     BCB 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+WITH SPPRT13; USE SPPRT13;
+WITH SYSTEM;  USE SYSTEM;
+
+PROCEDURE CD5013M IS
+
+     TYPE ACC_TYPE IS ACCESS INTEGER;
+
+     PACKAGE PACK IS
+          CHECK_VAR : ACC_TYPE;
+          FOR CHECK_VAR USE
+               AT VARIABLE_ADDRESS;
+     END PACK;
+
+     USE PACK;
+
+BEGIN
+
+     TEST ("CD5013M", "AN ADDRESS CLAUSE CAN BE GIVEN IN " &
+                      "THE VISIBLE PART OF A PACKAGE SPECIFICATION " &
+                      "FOR A VARIABLE OF AN ACCESS TYPE, WHERE THE " &
+                      "VARIABLE IS DECLARED IN THE VISIBLE PART OF " &
+                      "THE SPECIFICATION");
+
+     CHECK_VAR := NEW INTEGER'(100);
+     IF EQUAL(3,3) THEN
+          CHECK_VAR := NEW INTEGER'(25);
+     END IF;
+
+     IF CHECK_VAR.ALL /= 25 THEN
+          FAILED ("INCORRECT VALUE FOR ACCESS VARIABLE");
+     END IF;
+
+     IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
+          FAILED ("INCORRECT ADDRESS FOR ACCESS VARIABLE");
+     END IF;
+
+     RESULT;
+END CD5013M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013o.ada
new file mode 100644
index 000000000..c063fcef3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5013o.ada
@@ -0,0 +1,83 @@
+-- CD5013O.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART OF
+--     A PACKAGE SPECIFICATION FOR A VARIABLE OF A PRIVATE TYPE, WHERE
+--     THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+-- HISTORY:
+--     BCB 09/16/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH REPORT;  USE REPORT;
+WITH SPPRT13; USE SPPRT13;
+WITH SYSTEM;  USE SYSTEM;
+
+PROCEDURE CD5013O IS
+
+     PACKAGE P1 IS
+     END P1;
+
+     PACKAGE PACK IS
+          TYPE F IS PRIVATE;
+     PRIVATE
+          TYPE F IS NEW INTEGER;
+          CHECK_VAR : F;
+          FOR CHECK_VAR USE AT VARIABLE_ADDRESS;
+     END PACK;
+
+     USE PACK;
+
+     PACKAGE BODY P1 IS
+     BEGIN
+          TEST ("CD5013O", "AN ADDRESS CLAUSE CAN BE GIVEN" &
+                           " IN THE PRIVATE PART OF A PACKAGE " &
+                           "SPECIFICATION FOR A VARIABLE OF A " &
+                           "PRIVATE TYPE, WHERE THE VARIABLE IS " &
+                           "DECLARED IN THE VISIBLE PART OF THE " &
+                           "SPECIFICATION");
+     END P1;
+
+     PACKAGE BODY PACK IS
+     BEGIN
+          CHECK_VAR := 100;
+          IF EQUAL(3,3) THEN
+               CHECK_VAR := 25;
+          END IF;
+
+          IF CHECK_VAR /= 25 THEN
+               FAILED ("INCORRECT VALUE FOR PRIVATE VARIABLE");
+          END IF;
+
+          IF CHECK_VAR'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR PRIVATE VARIABLE");
+          END IF;
+     END PACK;
+
+BEGIN
+
+     RESULT;
+END CD5013O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014a.ada
new file mode 100644
index 000000000..094017798
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014a.ada
@@ -0,0 +1,84 @@
+-- CD5014A.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 ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF AN
+--     ENUMERATION TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE
+--     PART OF THE SPECIFICATION.
+
+
+-- HISTORY:
+--     CDJ 07/24/87  CREATED ORIGINAL TEST.
+--     BCB 09/30/87  CHANGED TEST TO STANDARD FORMAT.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     MCH 04/03/90  ADDED INSTANTIATION.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014A IS
+
+BEGIN
+
+     TEST ("CD5014A", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF AN " &
+                      "ENUMERATION TYPE, WHERE THE VARIABLE IS " &
+                      "DECLARED IN THE VISIBLE PART OF THE " &
+                      "SPECIFICATION");
+
+     DECLARE
+
+     GENERIC
+     PACKAGE PKG IS
+          TYPE ENUM_TYPE IS (RED,BLUE,GREEN);
+          ENUM_OBJ1 : ENUM_TYPE := RED;
+          FOR ENUM_OBJ1 USE AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               ENUM_OBJ1 := BLUE;
+          END IF;
+
+          IF ENUM_OBJ1 /= BLUE THEN
+               FAILED ("INCORRECT VALUE FOR ENUMERATION VARIABLE");
+          END IF;
+
+          IF ENUM_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR ENUMERATION VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE INSTANTIATE IS NEW PKG;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014c.ada
new file mode 100644
index 000000000..d09969f05
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014c.ada
@@ -0,0 +1,84 @@
+-- CD5014C.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF AN INTEGER
+--     TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+
+-- HISTORY:
+--     CDJ 07/24/87  CREATED ORIGINAL TEST.
+--     BCB 09/30/87  CHANGED TEST TO STANDARD FORMAT.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     MCH 04/03/90  ADDED INSTANTIATION.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014C IS
+
+BEGIN
+
+     TEST ("CD5014C", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF AN INTEGER " &
+                      "TYPE, WHERE THE VARIABLE IS DECLARED IN THE " &
+                      "VISIBLE PART OF THE SPECIFICATION");
+
+     DECLARE
+
+     GENERIC
+     PACKAGE PKG IS
+          TYPE INTEGER_TYPE IS RANGE 0 .. 100;
+          INTEGER_OBJ1 : INTEGER_TYPE := 50;
+     PRIVATE
+          FOR INTEGER_OBJ1 USE AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               INTEGER_OBJ1 := 7;
+          END IF;
+
+          IF INTEGER_OBJ1 /= 7 THEN
+               FAILED ("INCORRECT VALUE FOR INTEGER VARIABLE");
+          END IF;
+
+          IF INTEGER_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR INTEGER VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE INSTANTIATE IS NEW PKG;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014e.ada
new file mode 100644
index 000000000..145e3aaf1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014e.ada
@@ -0,0 +1,84 @@
+-- CD5014E.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 ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FLOATING
+--     POINT TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART
+--     OF THE SPECIFICATION.
+
+
+-- HISTORY:
+--     CDJ 08/19/87  CREATED ORIGINAL TEST.
+--     BCB 09/30/87  CHANGED TEST TO STANDARD FORMAT.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     MCH 04/03/90  ADDED INSTANTIATION.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014E IS
+
+BEGIN
+
+     TEST ("CD5014E", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF A FLOATING " &
+                      "POINT TYPE, WHERE THE VARIABLE IS DECLARED " &
+                      "IN THE VISIBLE PART OF THE SPECIFICATION");
+
+     DECLARE
+
+     GENERIC
+     PACKAGE PKG IS
+          TYPE FLOAT_TYPE IS DIGITS SYSTEM.MAX_DIGITS
+               RANGE 0.0 .. 100.0;
+          FLOAT_OBJ1 : FLOAT_TYPE := 50.0;
+          FOR FLOAT_OBJ1 USE AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               FLOAT_OBJ1 := 5.0;
+          END IF;
+
+          IF FLOAT_OBJ1 /= 5.0 THEN
+               FAILED ("INCORRECT VALUE FOR FLOATING POINT VARIABLE");
+          END IF;
+
+          IF FLOAT_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR FLOATING POINT VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE INSTANTIATE IS NEW PKG;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014g.ada
new file mode 100644
index 000000000..28ab3997d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014g.ada
@@ -0,0 +1,84 @@
+-- CD5014G.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FIXED
+--     POINT TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF
+--     THE SPECIFICATION.
+
+
+-- HISTORY:
+--     CDJ 07/24/87  CREATED ORIGINAL TEST.
+--     BCB 10/01/87  CHANGED TEST TO STANDARD FORMAT.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     MCH 04/03/90  ADDED INSTANTIATION.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014G IS
+
+BEGIN
+
+     TEST ("CD5014G", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF A FIXED " &
+                      "POINT TYPE, WHERE THE VARIABLE IS DECLARED " &
+                      "IN THE VISIBLE PART OF THE SPECIFICATION");
+
+     DECLARE
+
+     GENERIC
+     PACKAGE PKG IS
+          TYPE FIXED_TYPE IS DELTA 0.5 RANGE 0.0 .. 100.0;
+          FIXED_OBJ1 : FIXED_TYPE := 50.0;
+     PRIVATE
+          FOR FIXED_OBJ1 USE AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               FIXED_OBJ1 := 5.0;
+          END IF;
+
+          IF FIXED_OBJ1 /= 5.0 THEN
+               FAILED ("INCORRECT VALUE FOR FIXED POINT VARIABLE");
+          END IF;
+
+          IF FIXED_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR FIXED POINT VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE INSTANTIATE IS NEW PKG;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014i.ada
new file mode 100644
index 000000000..23c235783
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014i.ada
@@ -0,0 +1,83 @@
+-- CD5014I.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 ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF AN ARRAY
+--     TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+
+-- HISTORY:
+--     CDJ 07/24/87  CREATED ORIGINAL TEST.
+--     BCB 10/01/87  CHANGED TEST TO STANDARD FORMAT.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     MCH 04/03/90  ADDED INSTANTIATION.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014I IS
+
+BEGIN
+
+     TEST ("CD5014I", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF AN ARRAY " &
+                      "TYPE, WHERE THE VARIABLE IS DECLARED IN THE " &
+                      "VISIBLE PART OF THE SPECIFICATION");
+
+     DECLARE
+
+     GENERIC
+     PACKAGE PKG IS
+          TYPE ARR_TYPE IS ARRAY (1..2) OF INTEGER;
+          ARR_OBJ1 : ARR_TYPE := (5,10);
+          FOR ARR_OBJ1 USE AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               ARR_OBJ1 := (13,21);
+          END IF;
+
+          IF ARR_OBJ1 /= (13,21) THEN
+               FAILED ("INCORRECT VALUE FOR ARRAY VARIABLE");
+          END IF;
+
+          IF ARR_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR ARRAY VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE INSTANTIATE IS NEW PKG;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014k.ada
new file mode 100644
index 000000000..1cee824e9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014k.ada
@@ -0,0 +1,87 @@
+-- CD5014K.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A RECORD
+--     TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+
+-- HISTORY:
+--     CDJ 07/24/87  CREATED ORIGINAL TEST.
+--     BCB 10/01/87  CHANGED TEST TO STANDARD FORMAT.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     MCH 04/03/90  ADDED INSTANTIATION.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014K IS
+
+BEGIN
+
+     TEST ("CD5014K", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF A RECORD " &
+                      "TYPE, WHERE THE VARIABLE IS DECLARED IN THE " &
+                      "VISIBLE PART OF THE SPECIFICATION");
+
+
+     DECLARE
+
+     GENERIC
+     PACKAGE PKG IS
+          TYPE REC_TYPE IS RECORD
+               VAL : INTEGER;
+          END RECORD;
+          REC_OBJ1 : REC_TYPE := (VAL => 10);
+     PRIVATE
+          FOR REC_OBJ1 USE AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               REC_OBJ1.VAL := 100;
+          END IF;
+
+          IF REC_OBJ1.VAL /= 100 THEN
+               FAILED ("INCORRECT VALUE FOR RECORD VARIABLE COMPONENT");
+          END IF;
+
+          IF REC_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR RECORD VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE INSTANTIATE IS NEW PKG;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014m.ada
new file mode 100644
index 000000000..8b0ec5743
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014m.ada
@@ -0,0 +1,88 @@
+-- CD5014M.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 ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF AN ACCESS
+--     TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF
+--     THE SPECIFICATION.
+
+
+-- HISTORY:
+--     CDJ 07/24/87  CREATED ORIGINAL TEST.
+--     BCB 10/01/87  CHANGED TEST TO STANDARD FORMAT.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     MCH 04/03/90  ADDED INSTANTIATION.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014M IS
+
+BEGIN
+
+     TEST ("CD5014M", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF AN ACCESS " &
+                      "TYPE, WHERE THE VARIABLE IS DECLARED IN THE " &
+                      "VISIBLE PART OF THE SPECIFICATION");
+
+     DECLARE
+
+     GENERIC
+     PACKAGE PKG IS
+          TYPE ACCESS_TYPE;
+          TYPE POINTER_TYPE IS ACCESS ACCESS_TYPE;
+          TYPE ACCESS_TYPE IS RECORD
+               VAL1 : INTEGER;
+               NEXT : POINTER_TYPE;
+          END RECORD;
+          POINTER_OBJ1 : POINTER_TYPE := NEW ACCESS_TYPE'(0,NULL);
+          FOR POINTER_OBJ1 USE AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               POINTER_OBJ1 := NEW ACCESS_TYPE'(10,NULL);
+          END IF;
+
+          IF POINTER_OBJ1.ALL /= (10,NULL) THEN
+               FAILED ("INCORRECT VALUE FOR ACCESS VARIABLE");
+          END IF;
+
+          IF POINTER_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR ACCESS VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE INSTANTIATE IS NEW PKG;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014o.ada
new file mode 100644
index 000000000..e8018ca98
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014o.ada
@@ -0,0 +1,85 @@
+-- CD5014O.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A PRIVATE
+--     TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART OF THE
+--     SPECIFICATION.
+
+
+-- HISTORY:
+--     CDJ 07/24/87  CREATED ORIGINAL TEST.
+--     BCB 10/01/87  CHANGED TEST TO STANDARD FORMAT.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+--     MCH 04/03/90  ADDED INSTANTIATION.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014O IS
+
+BEGIN
+
+     TEST ("CD5014O", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF A PRIVATE " &
+                      "TYPE, WHERE THE VARIABLE IS DECLARED IN THE " &
+                      "VISIBLE PART OF THE SPECIFICATION");
+
+     DECLARE
+
+     GENERIC
+     PACKAGE PKG IS
+          TYPE PRIVATE_TYPE IS PRIVATE;
+     PRIVATE
+          TYPE PRIVATE_TYPE IS RANGE 1 .. 20;
+          PRIVATE_OBJ1 : PRIVATE_TYPE := 5;
+          FOR PRIVATE_OBJ1 USE AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               PRIVATE_OBJ1 := 9;
+          END IF;
+
+          IF PRIVATE_OBJ1 /= 9 THEN
+               FAILED ("INCORRECT VALUE FOR PRIVATE VARIABLE");
+          END IF;
+
+          IF PRIVATE_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR PRIVATE VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE INSTANTIATE IS NEW PKG;
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014t.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014t.ada
new file mode 100644
index 000000000..9eee00c71
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014t.ada
@@ -0,0 +1,86 @@
+-- CD5014T.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FORMAL
+--     DISCRETE TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART
+--     OF THE SPECIFICATION.
+
+
+-- HISTORY:
+--     BCB 10/08/87  CREATED ORIGINAL TEST.
+
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014T IS
+
+BEGIN
+
+     TEST ("CD5014T", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF A FORMAL " &
+                      "DISCRETE TYPE, WHERE THE VARIABLE IS DECLARED " &
+                      "IN THE VISIBLE PART OF THE SPECIFICATION");
+
+     DECLARE
+
+     GENERIC
+          TYPE FORM_DISCRETE_TYPE IS (<>);
+     PACKAGE PKG IS
+          FORM_DISCRETE_OBJ1 : FORM_DISCRETE_TYPE :=
+               FORM_DISCRETE_TYPE'FIRST;
+     PRIVATE
+          FOR FORM_DISCRETE_OBJ1 USE
+               AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+
+          IF EQUAL(3,3) THEN
+               FORM_DISCRETE_OBJ1 := FORM_DISCRETE_TYPE'LAST;
+          END IF;
+
+          IF FORM_DISCRETE_OBJ1 /= FORM_DISCRETE_TYPE'LAST THEN
+               FAILED ("INCORRECT VALUE FOR FORMAL DISCRETE VARIABLE");
+          END IF;
+
+          IF FORM_DISCRETE_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR FORMAL DISCRETE " &
+                       "VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE PACK IS NEW PKG(FORM_DISCRETE_TYPE => INTEGER);
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014T;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014v.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014v.ada
new file mode 100644
index 000000000..237a37a88
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014v.ada
@@ -0,0 +1,83 @@
+-- CD5014V.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 ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FORMAL
+--     FIXED TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART
+--     OF THE SPECIFICATION.
+
+
+-- HISTORY:
+--     BCB 10/08/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014V IS
+
+BEGIN
+
+     TEST ("CD5014V", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF A FORMAL " &
+                      "FIXED TYPE, WHERE THE VARIABLE IS DECLARED " &
+                      "IN THE VISIBLE PART OF THE SPECIFICATION");
+
+     DECLARE
+          TYPE FIX IS DELTA 0.5 RANGE -30.00 .. 30.00;
+
+     GENERIC
+          TYPE FORM_FIXED_TYPE IS DELTA <>;
+     PACKAGE PKG IS
+          FORM_FIXED_OBJ1 : FORM_FIXED_TYPE := 5.0;
+          FOR FORM_FIXED_OBJ1 USE AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF EQUAL(3,3) THEN
+               FORM_FIXED_OBJ1 := 20.0;
+          END IF;
+
+          IF FORM_FIXED_OBJ1 /= 20.0 THEN
+               FAILED ("INCORRECT VALUE FOR FORMAL FIXED VARIABLE");
+          END IF;
+
+          IF FORM_FIXED_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR FORMAL FIXED " &
+                       "VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE PACK IS NEW PKG(FORM_FIXED_TYPE => FIX);
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014V;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014x.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014x.ada
new file mode 100644
index 000000000..fe6e2cb3b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014x.ada
@@ -0,0 +1,89 @@
+-- CD5014X.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FORMAL
+--     ARRAY TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART
+--     OF THE SPECIFICATION.
+
+-- HISTORY:
+--     BCB 10/08/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CD5014X IS
+
+BEGIN
+
+     TEST ("CD5014X", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF A FORMAL " &
+                      "ARRAY TYPE, WHERE THE VARIABLE IS DECLARED " &
+                      "IN THE VISIBLE PART OF THE SPECIFICATION");
+
+     DECLARE
+
+          TYPE COLOR IS (RED,BLUE,GREEN);
+          TYPE COLOR_TABLE IS ARRAY (COLOR) OF INTEGER;
+
+     GENERIC
+          TYPE INDEX IS (<>);
+          TYPE FORM_ARRAY_TYPE IS ARRAY (INDEX) OF INTEGER;
+     PACKAGE PKG IS
+          FORM_ARRAY_OBJ1 : FORM_ARRAY_TYPE := (1,2,3);
+     PRIVATE
+          FOR FORM_ARRAY_OBJ1 USE AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+
+          IF EQUAL(3,3) THEN
+               FORM_ARRAY_OBJ1 := (10,20,30);
+          END IF;
+
+          IF FORM_ARRAY_OBJ1 /= (10,20,30) THEN
+               FAILED ("INCORRECT VALUE FOR FORMAL ARRAY VARIABLE");
+          END IF;
+
+          IF FORM_ARRAY_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR FORMAL ARRAY " &
+                       "VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE PACK IS NEW PKG(INDEX => COLOR,
+                             FORM_ARRAY_TYPE => COLOR_TABLE);
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014X;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014y.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014y.ada
new file mode 100644
index 000000000..75c8ba64a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014y.ada
@@ -0,0 +1,74 @@
+-- CD5014Y.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 ADDRESS CLAUSE CAN BE GIVEN IN THE VISIBLE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FORMAL
+--     PRIVATE TYPE, WHERE THE VARIABLE IS DECLARED IN THE VISIBLE PART
+--     OF THE SPECIFICATION.
+
+-- HISTORY:
+--     BCB 10/08/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014Y IS
+
+BEGIN
+
+     TEST ("CD5014Y", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE VISIBLE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF A FORMAL " &
+                      "PRIVATE TYPE, WHERE THE VARIABLE IS DECLARED " &
+                      "IN THE VISIBLE PART OF THE SPECIFICATION");
+
+     DECLARE
+
+     GENERIC
+          TYPE FORM_PRIVATE_TYPE IS PRIVATE;
+     PACKAGE PKG IS
+          FORM_PRIVATE_OBJ1 : FORM_PRIVATE_TYPE;
+          FOR FORM_PRIVATE_OBJ1 USE
+               AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF FORM_PRIVATE_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR FORMAL PRIVATE " &
+                       "VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE PACK IS NEW PKG(FORM_PRIVATE_TYPE => INTEGER);
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014Y;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014z.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014z.ada
new file mode 100644
index 000000000..dee329120
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd5014z.ada
@@ -0,0 +1,76 @@
+-- CD5014Z.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 ADDRESS CLAUSE CAN BE GIVEN IN THE PRIVATE PART
+--     OF A GENERIC PACKAGE SPECIFICATION FOR A VARIABLE OF A FORMAL
+--     LIMITED PRIVATE TYPE, WHERE THE VARIABLE IS DECLARED IN THE
+--     VISIBLE PART OF THE SPECIFICATION.
+
+-- HISTORY:
+--     BCB 10/08/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM; USE SYSTEM;
+WITH SPPRT13; USE SPPRT13;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CD5014Z IS
+
+BEGIN
+
+     TEST ("CD5014Z", " AN ADDRESS CLAUSE CAN BE GIVEN " &
+                      "IN THE PRIVATE PART OF A GENERIC PACKAGE " &
+                      "SPECIFICATION FOR A VARIABLE OF A FORMAL " &
+                      "LIMITED PRIVATE TYPE, WHERE THE VARIABLE IS " &
+                      "DECLARED IN THE VISIBLE PART OF THE " &
+                      "SPECIFICATION");
+
+     DECLARE
+
+     GENERIC
+          TYPE FORM_LIM_PRIVATE_TYPE IS LIMITED PRIVATE;
+     PACKAGE PKG IS
+          FORM_LIM_PRIVATE_OBJ1 : FORM_LIM_PRIVATE_TYPE;
+     PRIVATE
+          FOR FORM_LIM_PRIVATE_OBJ1 USE
+               AT VARIABLE_ADDRESS;
+     END PKG;
+
+     PACKAGE BODY PKG IS
+     BEGIN
+          IF FORM_LIM_PRIVATE_OBJ1'ADDRESS /= VARIABLE_ADDRESS THEN
+               FAILED ("INCORRECT ADDRESS FOR FORMAL LIMITED PRIVATE " &
+                       "VARIABLE");
+          END IF;
+     END PKG;
+
+     PACKAGE PACK IS NEW PKG(FORM_LIM_PRIVATE_TYPE => INTEGER);
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CD5014Z;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd70001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd70001.a
new file mode 100644
index 000000000..484009588
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd70001.a
@@ -0,0 +1,201 @@
+--
+-- CD70001.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 package System includes Max_Base_Digits, Address,
+--      Null_Address, Word_Size, functions "<", "<=", ">", ">=", "="
+--      (with Address parameters and Boolean results), Bit_Order,
+--      Default_Bit_Order, Any_Priority, Interrupt_Priority,
+--      and Default_Priority.
+--
+--      Check that package System.Storage_Elements includes all required
+--      types and operations.
+--
+-- TEST DESCRIPTION:
+--      The test checks for the existence of the names additional
+--      to package system above those names tested for in 9Xbasic.
+--
+--      This test checks that the semantics provided in Storage_Elements
+--      are present and operate marginally within expectations (to the best
+--      extent possible in a portable implementation independent fashion).
+--
+--
+-- CHANGE HISTORY:
+--      09 MAY 95   SAIC   Initial version
+--      27 JAN 96   SAIC   Revised for 2.1; Allow negative address delta
+--
+--!
+
+with Report;
+with Ada.Text_IO;
+with System.Storage_Elements;
+with System.Address_To_Access_Conversions;
+procedure CD70001 is
+  use System;
+
+  procedure CD70 is
+
+    type Int_Max is range Min_Int .. Max_Int;
+
+    My_Int : Int_Max := System.Max_Base_Digits + System.Word_Size;
+
+    An_Address : Address;
+    An_Other_Address : Address := An_Address'Address;
+
+  begin  -- 7.0
+
+
+      if Default_Bit_Order not in High_Order_First..Low_Order_First then
+         Report.Failed ("Default_Bit_Order invalid");
+      end if;
+
+      if Bit_Order'Pos(High_Order_First) /= 0 then
+         Report.Failed ("Bit_Order'Pos(High_Order_First) /= 0");
+      end if;
+
+      if Bit_Order'Pos(Low_Order_First) /= 1 then
+         Report.Failed ("Bit_Order'Pos(Low_Order_First) /= 1");
+      end if;
+
+      An_Address := My_Int'Address;
+
+      if An_Address = Null_Address then
+        Report.Failed ("Null_Address matched a real address");
+      end if;
+
+
+      if An_Address'Address /= An_Other_Address then
+        Report.Failed("Value set at elaboration not equal to itself");
+      end if;
+
+      if An_Address'Address > An_Other_Address 
+         and An_Address'Address < An_Other_Address then
+        Report.Failed("Address is both greater and less!");
+      end if;
+
+      if not (An_Address'Address >= An_Other_Address 
+         and An_Address'Address <= An_Other_Address) then
+        Report.Failed("Address comparisons wrong");
+      end if;
+
+
+      if Priority'First /= Any_Priority'First then
+        Report.Failed ("Priority'First /= Any_Priority'First");
+      end if;
+
+      if Interrupt_Priority'First /= Priority'Last+1 then
+        Report.Failed ("Interrupt_Priority'First /= Priority'Last+1");
+      end if;
+
+      if Interrupt_Priority'Last /= Any_Priority'Last then
+        Report.Failed ("Interrupt_Priority'Last /= Any_Priority'Last");
+      end if;
+
+      if Default_Priority /= ((Priority'First + Priority'Last)/2) then
+        Report.Failed ("Default_Priority wrong value");
+      end if;
+
+  end CD70;
+
+  procedure CD71 is
+    use System.Storage_Elements;
+
+    Storehouse_1 : Storage_Array(0..127);
+    Storehouse_2 : Storage_Array(0..127);
+
+    House_Offset : Storage_Offset;
+
+  begin  -- 7.1
+
+
+      if Storage_Count'First /= 0 then
+        Report.Failed ("Storage_Count'First /= 0");
+      end if;
+
+      if Storage_Count'Last /= Storage_Offset'Last then
+        Report.Failed ("Storage_Count'Last /= Storage_Offset'Last");
+      end if;
+
+
+      if Storage_Element'Size /= Storage_Unit then
+        Report.Failed ("Storage_Element'Size /= Storage_Unit");
+      end if;
+
+      if Storage_Array'Component_Size /= Storage_Unit then
+        Report.Failed ("Storage_Array'Element_Size /= Storage_Unit");
+      end if;
+
+      if Storage_Element'Last+1 /= 0 then
+        Report.Failed ("Storage_Element not modular");
+      end if;
+
+
+      -- "+", "-"( Address, Storage_Offset) and inverse
+
+      House_Offset := Storehouse_2'Address - Storehouse_1'Address;
+      -- Address - Address = Offset
+      -- Note that House_Offset may be a negative value
+
+      if House_Offset + Storehouse_1'Address /= Storehouse_2'Address then
+      -- Offset + Address = Address
+        Report.Failed ("Storage arithmetic non-linear O+A");
+      end if;
+
+      if Storehouse_1'Address + House_Offset /= Storehouse_2'Address then
+      -- Address + Offset = Address
+        Report.Failed ("Storage arithmetic non-linear A+O");
+      end if;
+
+      if Storehouse_2'Address - House_Offset /= Storehouse_1'Address then
+      -- Address - Offset = Address
+        Report.Failed ("Storage arithmetic non-linear A-O");
+      end if;
+
+      if (Storehouse_2'Address mod abs(House_Offset) > abs(House_Offset)) then
+      -- "mod"( Address, Storage_Offset)
+        Report.Failed("Mod arithmetic");
+      end if;
+
+
+      if Storehouse_1'Address
+         /= To_Address(To_Integer(Storehouse_1'Address)) then
+        Report.Failed("To_Address, To_Integer not symmetric");
+      end if;
+
+  end CD71;
+
+
+begin  -- Main test procedure.
+
+   Report.Test ("CD70001", "Check package System" );
+
+   CD70;
+
+   CD71;
+
+  Report.Result;
+
+end CD70001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7002a.ada
new file mode 100644
index 000000000..f278c0bdd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7002a.ada
@@ -0,0 +1,52 @@
+-- CD7002A.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 VARIABLE OF TYPE ADDRESS CAN BE DECLARED IN A UNIT
+--     WHICH HAS A WITH CLAUSE NAMING SYSTEM.
+
+-- HISTORY:
+--     DHH 08/31/88  CREATED ORIGINAL TEST.
+
+WITH SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CD7002A IS
+
+     I : INTEGER;
+
+     OBJECT : SYSTEM.ADDRESS := I'ADDRESS;
+
+     SUBTYPE MY_ADDRESS IS SYSTEM.ADDRESS;
+
+BEGIN
+     TEST ("CD7002A", "CHECK THAT A VARIABLE OF TYPE ADDRESS CAN BE " &
+                      "DECLARED IN A UNIT WHICH HAS A WITH CLAUSE " &
+                      "NAMING SYSTEM");
+
+     IF NOT IDENT_BOOL(OBJECT IN MY_ADDRESS) THEN
+          FAILED("INCORRECT RESULT");
+     END IF;
+
+     RESULT;
+END CD7002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7007b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7007b.ada
new file mode 100644
index 000000000..c5edf4b22
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7007b.ada
@@ -0,0 +1,52 @@
+-- CD7007B.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 SUBTYPE 'PRIORITY' IS DECLARED WITHIN THE PACKAGE
+--     SYSTEM AND IT IS A SUBTYPE OF 'INTEGER'.
+
+-- HISTORY:
+--     VCL  09/16/87  CREATED ORIGINAL TEST.
+
+WITH SYSTEM;
+WITH REPORT; USE REPORT;
+PROCEDURE CD7007B IS
+BEGIN
+     TEST ("CD7007B", "THE SUBTYPE 'PRIORITY' IS DECLARED WITHIN " &
+                      "THE PACKAGE SYSTEM AND IT IS A SUBTYPE OF " &
+                      "'INTEGER'");
+
+     DECLARE
+          CHECK_VAR : SYSTEM.PRIORITY;
+     BEGIN
+          IF SYSTEM.PRIORITY'FIRST NOT IN
+                              INTEGER'FIRST .. INTEGER'LAST AND
+                    SYSTEM.PRIORITY'LAST NOT IN
+                              INTEGER'FIRST .. INTEGER'LAST THEN
+               FAILED ("'SYSTEM.PRIORITY' IS NOT AN INTEGER SUBTYPE");
+          END IF;
+     END;
+
+     RESULT;
+END CD7007B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101d.ada
new file mode 100644
index 000000000..9b56f2c3d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101d.ada
@@ -0,0 +1,53 @@
+-- CD7101D.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 FOR MIN_INT AND MAX_INT IN PACKAGE SYSTEM,
+--     INTEGER'FIRST >= MIN_INT AND INTEGER'LAST <= MAX_INT.
+
+-- HISTORY:
+--     JET 09/10/87  CREATED ORIGINAL TEST.
+
+WITH SYSTEM;
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD7101D IS
+
+BEGIN
+
+     TEST ("CD7101D", "CHECK THAT FOR MIN_INT AND MAX_INT IN PACKAGE " &
+                      "SYSTEM, INTEGER'FIRST >= MIN_INT AND INTEGER'" &
+                      "LAST <= MAX_INT");
+
+     IF INTEGER'POS (INTEGER'FIRST) < SYSTEM.MIN_INT THEN
+          FAILED ("INCORRECT VALUE FOR SYSTEM.MIN_INT");
+     END IF;
+
+     IF INTEGER'POS (INTEGER'LAST) > SYSTEM.MAX_INT THEN
+          FAILED ("INCORRECT VALUE FOR SYSTEM.MAX_INT");
+     END IF;
+
+     RESULT;
+
+END CD7101D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101e.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101e.dep
new file mode 100644
index 000000000..d2d430a07
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101e.dep
@@ -0,0 +1,62 @@
+-- CD7101E.DEP
+
+--                             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 FOR MIN_INT AND MAX_INT IN PACKAGE SYSTEM,
+--     SHORT_INTEGER'FIRST >= MIN_INT AND SHORT_INTEGER'LAST <= MAX_INT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO THOSE IMPLEMENTATIONS THAT
+--     SUPPORT THE SHORT_INTEGER DATA TYPE.
+
+--     IF THE SHORT_INTEGER TYPE IS NOT SUPPORTED THEN THE
+--     DECLARATION OF "TEST_VAR" MUST BE REJECTED.
+
+-- HISTORY:
+--     JET 09/10/87  CREATED ORIGINAL TEST.
+
+WITH SYSTEM;
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD7101E IS
+
+     TEST_VAR : SHORT_INTEGER := 0;          -- N/A => ERROR.
+
+BEGIN
+
+     TEST ("CD7101E", "CHECK THAT FOR MIN_INT AND MAX_INT IN PACKAGE " &
+                      "SYSTEM, SHORT_INTEGER'FIRST >= MIN_INT AND " &
+                      "SHORT_INTEGER'LAST <= MAX_INT");
+
+     IF SHORT_INTEGER'POS (SHORT_INTEGER'FIRST) < SYSTEM.MIN_INT THEN
+          FAILED ("INCORRECT VALUE FOR SYSTEM.MIN_INT");
+     END IF;
+
+     IF SHORT_INTEGER'POS (SHORT_INTEGER'LAST) > SYSTEM.MAX_INT THEN
+          FAILED ("INCORRECT VALUE FOR SYSTEM.MAX_INT");
+     END IF;
+
+     RESULT;
+
+END CD7101E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101f.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101f.dep
new file mode 100644
index 000000000..4f1169eac
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101f.dep
@@ -0,0 +1,62 @@
+-- CD7101F.DEP
+
+--                             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 FOR MIN_INT AND MAX_INT IN PACKAGE SYSTEM,
+--     LONG_INTEGER'FIRST >= MIN_INT AND LONG_INTEGER'LAST <= MAX_INT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT
+--     THE LONG_INTEGER DATA TYPE.
+
+--     IF THE LONG_INTEGER TYPE IS NOT SUPPORTED, THEN THE
+--     DECLARATION OF "TEST_VAR" MUST BE REJECTED.
+
+-- HISTORY:
+--     JET 09/10/87  CREATED ORIGINAL TEST.
+
+WITH SYSTEM;
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD7101F IS
+
+     TEST_VAR : LONG_INTEGER := 0;          -- N/A => ERROR.
+
+BEGIN
+
+     TEST ("CD7101F", "CHECK THAT FOR MIN_INT AND MAX_INT IN PACKAGE " &
+                      "SYSTEM, LONG_INTEGER'FIRST >= MIN_INT AND " &
+                      "LONG_INTEGER'LAST <= MAX_INT");
+
+     IF LONG_INTEGER'POS (LONG_INTEGER'FIRST) < SYSTEM.MIN_INT THEN
+          FAILED ("INCORRECT VALUE FOR SYSTEM.MIN_INT");
+          END IF;
+
+     IF LONG_INTEGER'POS (LONG_INTEGER'LAST) > SYSTEM.MAX_INT THEN
+          FAILED ("INCORRECT VALUE FOR SYSTEM.MAX_INT");
+     END IF;
+
+     RESULT;
+
+END CD7101F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101g.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101g.tst
new file mode 100644
index 000000000..b91a34d48
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7101g.tst
@@ -0,0 +1,70 @@
+-- CD7101G.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 FOR MIN_INT AND MAX_INT IN PACKAGE SYSTEM AND
+--     A PREDEFINED INTEGER TYPE I OTHER THAN INTEGER, SHORT_INTEGER,
+--     AND LONG_INTEGER, I'FIRST >= MIN_INT AND I'LAST <= MAX_INT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT HAVE
+--     A PREDEFINED INTEGER TYPE OTHER THAN INTEGER, SHORT_INTEGER,
+--     AND LONG_INTEGER.
+
+--     IF NO SUCH TYPE EXISTS, THEN THE DECLARATION OF TEST_VAR
+--     MUST BE REJECTED.
+
+-- HISTORY:
+--     JET 09/10/87  CREATED ORIGINAL TEST.
+
+--     $NAME IS THE NAME OF A PREDEFINED INTEGER TYPE OTHER THAN
+--     INTEGER, SHORT_INTEGER, AND LONG_INTEGER, IF ANY SUCH TYPE
+--     EXISTS.
+
+WITH SYSTEM;
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD7101G IS
+
+     TEST_VAR : $NAME := 0;                    -- N/A => ERROR.
+
+BEGIN
+
+     TEST ("CD7101G", "CHECK THAT FOR MIN_INT AND MAX_INT IN " &
+                      "PACKAGE SYSTEM AND A PREDEFINED INTEGER " &
+                      "TYPE I OTHER THAN INTEGER, SHORT_INTEGER, " &
+                      "AND LONG_INTEGER, I'FIRST >= MIN_INT AND " &
+                      "I'LAST <= MAX_INT");
+
+     IF $NAME'POS ($NAME'FIRST) < SYSTEM.MIN_INT THEN
+          FAILED ("INCORRECT VALUE FOR SYSTEM.MIN_INT");
+     END IF;
+
+     IF $NAME'POS ($NAME'LAST) > SYSTEM.MAX_INT THEN
+          FAILED ("INCORRECT VALUE FOR SYSTEM.MAX_INT");
+     END IF;
+
+     RESULT;
+
+END CD7101G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7103d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7103d.ada
new file mode 100644
index 000000000..f6da8a0bb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7103d.ada
@@ -0,0 +1,52 @@
+-- CD7103D.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 = 2.0 ** (- MAX_MANTISSA).
+
+-- HISTORY:
+--     BCB 09/10/87  CREATED ORIGINAL TEST.
+
+--     DTN 11/21/91  DELETED SUBPART (A).  CHANGED EXTENSION FROM '.TST' TO 
+--                   '.ADA'.
+
+WITH SYSTEM;
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD7103D IS
+
+     MANTISSA_VAL : CONSTANT := 2.0 ** (-SYSTEM.MAX_MANTISSA);
+
+BEGIN
+
+     TEST ("CD7103D", "CHECK THAT THE CONSTANT FINE_DELTA " &
+                      "= 2.0 ** (- MAX_MANTISSA)");
+
+     IF SYSTEM.FINE_DELTA /= MANTISSA_VAL THEN
+          FAILED ("INCORRECT VALUE FOR SYSTEM.FINE_DELTA");
+     END IF;
+
+     RESULT;
+
+END CD7103D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7202a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7202a.ada
new file mode 100644
index 000000000..8e4f89aef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7202a.ada
@@ -0,0 +1,55 @@
+-- CD7202A.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:
+--     THE 'ADDRESS ATTRIBUTE CAN BE USED IN A COMPILATION UNIT EVEN IF
+--     A WITH CLAUSE FOR PACKAGE SYSTEM DOES NOT APPLY TO THE UNIT.
+
+-- HISTORY:
+--     DHH 08/31/88  CREATED ORIGINAL TEST.
+
+WITH SYSTEM;
+PACKAGE CD7202A_SYS IS
+     SUBTYPE MY_ADDRESS IS SYSTEM.ADDRESS;
+END CD7202A_SYS;
+
+WITH CD7202A_SYS;
+WITH REPORT; USE REPORT;
+PROCEDURE CD7202A IS
+
+     INT : INTEGER := 2;
+
+     BOOL : BOOLEAN := (INT'ADDRESS IN CD7202A_SYS.MY_ADDRESS);
+
+BEGIN
+     TEST ("CD7202A", "THE 'ADDRESS ATTRIBUTE CAN BE USED IN A" &
+                      " COMPILATION UNIT EVEN IF A WITH CLAUSE FOR " &
+                      "PACKAGE SYSTEM DOES NOT APPLY TO THE UNIT");
+
+     IF NOT IDENT_BOOL(BOOL) THEN
+          FAILED("ADDRESS ATTRIBUTE INCORRECT");
+     END IF;
+
+     RESULT;
+END CD7202A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7204b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7204b.ada
new file mode 100644
index 000000000..64114ad22
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7204b.ada
@@ -0,0 +1,88 @@
+-- CD7204B.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 'POSITION, 'LAST_BIT, AND 'FIRST_BIT
+--     ATTRIBUTES CAN DENOTE A RECORD COMPONENT, AND THE ATTRIBUTES
+--     RETURN APPROPRIATE VALUES WHEN A RECORD REPRESENTATION CLAUSE IS
+--     NOT PRESENT.
+
+-- HISTORY:
+--     BCB 09/14/87  CREATED ORIGINAL TEST.
+--     RJW 02/08/88  REVISED SO THAT TEST PASSES IF BOOLEAN'SIZE = 1.
+--     RJW 05/31/90  CORRECTED COMPARISONS INVOLVING SIZES.
+--     LDC 10/04/90  ADDED CHECK FOR 'POSITION.
+
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD7204B IS
+
+     TYPE BASIC_REC IS RECORD
+          CHECK_INT : INTEGER := 5;
+          CHECK_BOOL : BOOLEAN := TRUE;
+     END RECORD;
+
+     CHECK_REC : BASIC_REC;
+
+BEGIN
+
+     TEST ("CD7204B", "CHECK THAT THE PREFIX OF THE 'POSITION, " &
+                      "'LAST_BIT, AND 'FIRST_BIT ATTRIBUTES CAN " &
+                      "DENOTE A RECORD COMPONENT, AND THE ATTRIBUTES " &
+                      "RETURN APPROPRIATE VALUES WHEN A RECORD " &
+                      "REPRESENTATION CLAUSE IS NOT PRESENT");
+
+     IF CHECK_REC.CHECK_INT'FIRST_BIT >= CHECK_REC.CHECK_INT'LAST_BIT
+          THEN FAILED ("INCORRECT VALUES FOR FIRST_BIT OR LAST_BIT " &
+                       "OF CHECK_INT");
+     END IF;
+
+     IF (CHECK_REC.CHECK_INT'LAST_BIT - CHECK_REC.CHECK_INT'FIRST_BIT
+          + 1) < INTEGER'SIZE THEN
+          FAILED ("INCORRECT SIZE FOR CHECK_INT");
+     END IF;
+
+     IF CHECK_REC.CHECK_BOOL'POSITION <= CHECK_REC.CHECK_INT'POSITION
+          THEN FAILED ("INCORRECT VALUE FOR 'POSITION OF CHECK_INT " &
+                       "OR CHECK_BOOL");
+     END IF;
+
+     IF CHECK_REC.CHECK_INT'POSITION >= CHECK_REC.CHECK_BOOL'POSITION
+          THEN FAILED ("INCORRECT VALUE FOR 'POSITION OF CHECK_INT " &
+                       "OR CHECK_BOOL - 2");
+     END IF;
+
+     IF CHECK_REC.CHECK_BOOL'FIRST_BIT > CHECK_REC.CHECK_BOOL'LAST_BIT
+          THEN FAILED ("INCORRECT VALUE FOR FIRST_BIT OR LAST_BIT " &
+                       "OF CHECK_BOOL");
+     END IF;
+
+     IF (CHECK_REC.CHECK_BOOL'LAST_BIT - CHECK_REC.CHECK_BOOL'FIRST_BIT
+          + 1) < BOOLEAN'SIZE THEN
+          FAILED ("INCORRECT SIZE FOR CHECK_BOOL");
+     END IF;
+
+     RESULT;
+
+END CD7204B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7204c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7204c.ada
new file mode 100644
index 000000000..77ca9bdb2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7204c.ada
@@ -0,0 +1,91 @@
+-- CD7204C.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 'POSITION, 'LAST_BIT, AND 'FIRST_BIT
+--     ATTRIBUTES CAN DENOTE A RECORD COMPONENT, AND THE ATTRIBUTES
+--     RETURN APPROPRIATE VALUES WHEN A RECORD REPRESENTATION CLAUSE
+--     IS GIVEN.
+
+-- HISTORY:
+--     BCB 09/14/87  CREATED ORIGINAL TEST.
+--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
+
+WITH SYSTEM;
+WITH REPORT;  USE REPORT;
+
+PROCEDURE CD7204C IS
+
+     UNITS_PER_INTEGER : CONSTANT :=
+          (INTEGER'SIZE + SYSTEM.STORAGE_UNIT - 1)/SYSTEM.STORAGE_UNIT;
+
+     TYPE BASIC_REC IS RECORD
+          CHECK_INT : INTEGER;
+          CHECK_CHAR : CHARACTER;
+     END RECORD;
+
+     FOR BASIC_REC USE
+          RECORD
+               CHECK_INT AT 0 RANGE 0..INTEGER'SIZE - 1;
+               CHECK_CHAR AT 1*UNITS_PER_INTEGER
+                          RANGE 0..CHARACTER'SIZE - 1;
+          END RECORD;
+
+     CHECK_REC : BASIC_REC;
+
+BEGIN
+
+     TEST ("CD7204C", "THE PREFIX OF THE 'POSITION, " &
+                      "'LAST_BIT, AND 'FIRST_BIT ATTRIBUTES CAN " &
+                      "DENOTE A RECORD COMPONENT, AND THE ATTRIBUTES " &
+                      "RETURN APPROPRIATE VALUES WHEN A RECORD " &
+                      "REPRESENTATION CLAUSE IS GIVEN");
+
+     IF CHECK_REC.CHECK_INT'POSITION /= 0 THEN
+          FAILED ("INCORRECT VALUE FOR POSITION OF CHECK_INT");
+     END IF;
+
+     IF CHECK_REC.CHECK_INT'FIRST_BIT /= IDENT_INT (0) THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHECK_INT");
+     END IF;
+
+     IF CHECK_REC.CHECK_INT'LAST_BIT /= INTEGER'SIZE - 1 THEN
+          FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHECK_INT");
+     END IF;
+
+     IF CHECK_REC.CHECK_CHAR'POSITION /= IDENT_INT (UNITS_PER_INTEGER)
+          THEN FAILED ("INCORRECT VALUE FOR POSITION OF CHECK_CHAR");
+     END IF;
+
+     IF CHECK_REC.CHECK_CHAR'FIRST_BIT /= 0 THEN
+          FAILED ("INCORRECT VALUE FOR FIRST_BIT OF CHECK_CHAR");
+     END IF;
+
+     IF CHECK_REC.CHECK_CHAR'LAST_BIT /= IDENT_INT (CHARACTER'SIZE - 1)
+          THEN FAILED ("INCORRECT VALUE FOR LAST_BIT OF CHECK_CHAR");
+     END IF;
+
+     RESULT;
+
+END CD7204C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd72a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd72a01.a
new file mode 100644
index 000000000..9c98cb0c6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd72a01.a
@@ -0,0 +1,165 @@
+--
+-- CD72A01.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 package System.Address_To_Access_Conversions may be
+--      instantiated for various simple types.
+--
+--      Check that To_Pointer and To_Address are inverse operations.
+--
+--      Check that To_Pointer(X'Address) equals X'Unchecked_Access for an
+--      X that allows Unchecked_Access.
+--
+--      Check that To_Pointer(Null_Address) returns null.
+--
+-- TEST DESCRIPTION:
+--      This test checks that the semantics provided in
+--      Address_To_Access_Conversions are present and operate
+--      within expectations (to the best extent possible in a portable
+--      implementation independent fashion).
+--
+--      The functions Address_To_Hex and Hex_To_Address test the invertability
+--      of the To_Integer and To_Address functions, along with a great deal
+--      of optimizer chaff and protection from the fact that type
+--      Storage_Elements.Integer_Address may be either a modular or a signed
+--      integer type.
+--
+--      This test has some interesting usage paradigms in that users
+--      occasionally want to store address information in a transportable
+--      fashion, and often resort to some textual representation of values.  
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+-- CHANGE HISTORY:
+--      13 JUL 95   SAIC   Initial version (CD72001)
+--      08 FEB 96   SAIC   Revised (split) version for 2.1
+--      07 MAY 96   SAIC   Additional subtest added for 2.1
+--      16 FEB 98   EDS    Modified documentation.
+--!
+
+with Report;
+with Impdef;
+with FD72A00;
+with System.Storage_Elements;
+with System.Address_To_Access_Conversions;
+procedure CD72A01 is
+  use System;
+  use FD72A00;
+
+  package Number_ATAC is
+      new System.Address_To_Access_Conversions(Number); -- ANX-C RQMT
+
+  use type Number_ATAC.Object_Pointer;
+
+  type Data is record
+    One, Two: aliased Number;
+  end record;
+
+  package Data_ATAC is
+      new System.Address_To_Access_Conversions(Data);   -- ANX-C RQMT
+
+  use type Data_ATAC.Object_Pointer;
+
+  type Test_Cases is ( Addr_Type, Record_Type );
+
+  type Naive_Dynamic_String is access String;
+
+  type String_Store is array(Test_Cases) of Naive_Dynamic_String;
+
+  The_Strings : String_Store;
+
+  -- create several aliased objects with distinct values
+
+  My_Number : aliased Number := Number'First;
+  My_Data   : aliased Data   := (Number'First,Number'Last);
+
+   use type System.Storage_Elements.Integer_Address;
+
+begin  -- Main test procedure.
+
+   Report.Test ("CD72A01", "Check package " &
+                            "System.Address_To_Access_Conversions " &
+                            "for simple types" );
+  
+    -- take several pointer objects, convert them to addresses, and store
+    -- the address as a hexadecimal representation for later reconversion
+
+    The_Strings(Addr_Type) := new String'(
+      Address_To_Hex(Number_ATAC.To_Address(My_Number'Access)) );
+
+    The_Strings(Record_Type) := new String'(
+      Address_To_Hex(Data_ATAC.To_Address(My_Data'Access)) );
+
+    -- now, reconvert the hexadecimal address values back to pointers,
+    -- and check that the dereferenced pointer still designates the
+    -- value placed at that location.  The use of the intermediate
+    -- string representation should foil even the cleverest of optimizers
+
+    if Number_ATAC.To_Pointer(
+                             Hex_To_Address(The_Strings(Addr_Type))).all
+       /= Number'First then
+      Report.Failed("Number reconversion");
+    end if;
+
+    if Data_ATAC.To_Pointer(Hex_To_Address(The_Strings(Record_Type))).all
+       /= (Number'First,Number'Last) then
+      Report.Failed("Data reconversion");
+    end if;
+
+    -- check that the resulting values are equal to the 'Unchecked_Access
+    -- of the value
+
+    if Number_ATAC.To_Pointer(
+                             Hex_To_Address(The_Strings(Addr_Type)))
+       /= My_Number'Unchecked_Access then
+      Report.Failed("Number Unchecked_Access");
+    end if;
+
+    if Data_ATAC.To_Pointer(Hex_To_Address(The_Strings(Record_Type)))
+       /= My_Data'Unchecked_Access then
+      Report.Failed("Data Unchecked_Access");
+    end if;
+
+   if Number_ATAC.To_Pointer(System.Null_Address) /= null then
+     Report.Failed("To_Pointer(Null_Address) /= null");
+   end if;
+
+   if Number_ATAC.To_Address(null) /= System.Null_Address then
+     Report.Failed("To_Address(null) /= Null_Address");
+   end if;
+
+   Report.Result;
+
+end CD72A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd72a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd72a02.a
new file mode 100644
index 000000000..f396edc19
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd72a02.a
@@ -0,0 +1,225 @@
+-- CD72A02.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 package System.Address_To_Access_Conversions may be
+--      instantiated for various composite types.
+--
+--      Check that To_Pointer and To_Address are inverse operations.
+--
+--      Check that To_Pointer(X'Address) equals X'Unchecked_Access for an
+--      X that allows Unchecked_Access.
+--
+--      Check that To_Pointer(Null_Address) returns null.
+--
+-- TEST DESCRIPTION:
+--      This test is identical to CD72A01 with the exception that it tests
+--      the composite types where CD72A01 tests "simple" types.
+--
+--      This test checks that the semantics provided in
+--      Address_To_Access_Conversions are present and operate
+--      within expectations (to the best extent possible in a portable
+--      implementation independent fashion).
+--
+--      The functions Address_To_Hex and Hex_To_Address test the invertability
+--      of the To_Integer and To_Address functions, along with a great deal
+--      of optimizer chaff and protection from the fact that type
+--      Storage_Elements.Integer_Address may be either a modular or a signed
+--      integer type.
+--
+--      This test has some interesting usage paradigms in that users
+--      occasionally want to store address information in a transportable
+--      fashion, and often resort to some textual representation of values.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      13 JUL 95   SAIC   Initial version (CD72001)
+--      08 FEB 96   SAIC   Split from CD72001 by reviewer request for 2.1
+--      12 NOV 96   SAIC   Corrected typo in RM ref
+--      16 FEB 98   EDS    Modified documentation.
+--      22 JAN 02   RLB    Corrected test description.
+--!
+
+with Report;
+with Impdef;
+with FD72A00;
+with System.Storage_Elements;
+with System.Address_To_Access_Conversions;
+procedure CD72A02 is
+  use System;
+  use FD72A00;
+
+   type Tagged_Record is tagged record
+      Value : Natural;
+    end record;
+
+    package Class_ATAC is
+      new System.Address_To_Access_Conversions(Tagged_Record'Class);
+                                                        -- ANX-C RQMT
+
+  use type Class_ATAC.Object_Pointer;
+
+    task type TC_Task_Type is
+      entry E;
+      entry F;
+    end TC_Task_Type;
+
+    package Task_ATAC is
+            new System.Address_To_Access_Conversions(TC_Task_Type);
+                                                        -- ANX-C RQMT
+
+  use type Task_ATAC.Object_Pointer;
+
+    task body TC_Task_Type is
+    begin
+      select
+        accept E;
+      or
+        accept F;
+          Report.Failed("Task rendezvoused on wrong path");
+      end select;
+    end TC_Task_Type;
+
+    protected type TC_Protec is
+      procedure E;
+      procedure F;
+    private
+      Visited : Boolean := False;
+    end TC_Protec;
+
+    package Protected_ATAC is
+            new System.Address_To_Access_Conversions(TC_Protec);
+                                                        -- ANX-C RQMT
+
+  use type Protected_ATAC.Object_Pointer;
+
+    protected body TC_Protec is
+      procedure E is
+      begin
+        Visited := True;
+      end E;
+      procedure F is
+      begin
+        if not Visited then
+          Report.Failed("Protected Object took wrong path");
+        end if;
+      end F;
+    end TC_Protec;
+
+    type Test_Cases is ( Tagged_Type, Task_Type,  Protected_Type );
+
+    type Naive_Dynamic_String is access String;
+
+    type String_Store is array(Test_Cases) of Naive_Dynamic_String;
+
+    The_Strings : String_Store;
+
+    -- create several aliased objects with distinct values
+
+    My_Rec  : aliased Tagged_Record := (Value => Natural'Last);
+    My_Task : aliased TC_Task_Type;
+    My_Prot : aliased TC_Protec;
+
+    use type System.Storage_Elements.Integer_Address;
+
+begin  -- Main test procedure.
+
+   Report.Test ("CD72A02", "Check package " &
+                            "System.Address_To_Access_Conversions " &
+                            "for composite types" );
+
+    -- take several pointer objects, convert them to addresses, and store
+    -- the address as a hexadecimal representation for later reconversion
+
+    The_Strings(Tagged_Type) := new String'(
+      Address_To_Hex(Class_ATAC.To_Address(My_Rec'Access)) );
+
+    The_Strings(Task_Type) := new String'(
+      Address_To_Hex(Task_ATAC.To_Address(My_Task'Access)) );
+
+    The_Strings(Protected_Type) := new String'(
+      Address_To_Hex(Protected_ATAC.To_Address(My_Prot'Access)) );
+
+    -- now, reconvert the hexadecimal address values back to pointers,
+    -- and check that the dereferenced pointer still designates the
+    -- value placed at that location.  The use of the intermediate
+    -- string representation should foil even the cleverest of optimizers
+
+    if Tagged_Record(Class_ATAC.To_Pointer(
+                              Hex_To_Address(The_Strings(Tagged_Type))).all)
+       /= Tagged_Record'(Value => Natural'Last) then
+      Report.Failed("Tagged_Record reconversion");
+    end if;
+
+    Task_ATAC.To_Pointer(Hex_To_Address(The_Strings(Task_Type))).E;
+
+    begin
+      select        -- allow for task to have completed.
+        My_Task.F;  -- should not happen, will call Report.Fail in task
+      else
+        null;       -- expected case, "Report.Pass;"
+      end select;
+    exception
+      when Tasking_Error => null;  -- task terminated, which is OK
+    end;
+
+    Protected_ATAC.To_Pointer(
+                           Hex_To_Address(The_Strings(Protected_Type))).E;
+    My_Prot.F;    -- checks that call to E occurred
+
+
+    -- check that the resulting values are equal to the 'Unchecked_Access
+    -- of the value
+
+    if Class_ATAC.To_Pointer(Hex_To_Address(The_Strings(Tagged_Type)))
+       /= My_Rec'Unchecked_Access then
+      Report.Failed("Tagged_Record Unchecked_Access");
+    end if;
+
+    if Task_ATAC.To_Pointer(Hex_To_Address(The_Strings(Task_Type)))
+       /= My_Task'Unchecked_Access then
+      Report.Failed("Task Unchecked_Access");
+    end if;
+
+    if Protected_ATAC.To_Pointer(
+                           Hex_To_Address(The_Strings(Protected_Type)))
+       /= My_Prot'Unchecked_Access then
+      Report.Failed("Protected Unchecked_Access");
+    end if;
+
+  Report.Result;
+
+end CD72A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7305a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7305a.ada
new file mode 100644
index 000000000..3241fca8f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd7305a.ada
@@ -0,0 +1,52 @@
+-- CD7305A.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, FOR DIGITS 5, THAT MACHINE_RADIX, MACHINE_MANTISSA,
+--     MACHINE_EMAX, AND MACHINE_EMIN HAVE THE CORRECT VALUES.
+
+-- HISTORY:
+--     DHH 09/15/88  CREATED ORIGINAL TEST.
+--     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
+
+WITH REPORT; USE REPORT;
+PROCEDURE CD7305A IS
+
+     TYPE T IS DIGITS 5;
+
+     B : BOOLEAN := FALSE;
+
+BEGIN
+     TEST ("CD7305A", "CHECK, FOR DIGITS 5, THAT MACHINE_RADIX, " &
+                      "MACHINE_MANTISSA, MACHINE_EMAX, AND " &
+                      "MACHINE_EMIN HAVE THE CORRECT VALUES");
+
+
+     IF T'MACHINE_RADIX < 2 OR
+        T'BASE'MACHINE_RADIX /= T'MACHINE_RADIX THEN
+          FAILED ("INCORRECT 'MACHINE_RADIX");
+     END IF;
+
+     RESULT;
+END CD7305A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd90001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd90001.a
new file mode 100644
index 000000000..bd5c070a6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd90001.a
@@ -0,0 +1,233 @@
+-- CD90001.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 Unchecked_Conversion is supported and is reversible in
+--      the cases where:
+--        Source'Size = Target'Size                            
+--        Source'Alignment = Target'Alignment                  
+--        Source and Target are both represented contiguously  
+--        Bit pattern in Source is a meaningful value of Target type
+--                                                             
+-- TEST DESCRIPTION:
+--      This test declares an enumeration type with a representation
+--      specification that should fit neatly into an 8 bit object; and a
+--      modular type that should also be able to fit easily into 8 bits;
+--      uses size representation clauses on both of them for 8 bit
+--      representations.  It then defines two instances of
+--      Unchecked_Conversion; to convert both ways between the types.
+--      Using several distinctive values, it checks that the conversions
+--      are performed, and reversible.
+--      As a second case, the above is performed with an integer type and
+--      a packed array of booleans.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      22 JUL 95   SAIC   Initial version
+--      07 MAY 96   SAIC   Changed Boolean to Character for 2.1
+--      27 JUL 96   SAIC   Allowed for partial N/A to be PASS
+--      14 FEB 97   PWB.CTA  Corrected "=" to "/=" in alignment check.
+--      16 FEB 98   EDS    Modified documentation.
+--!
+
+----------------------------------------------------------------- CD90001_0
+
+with Report;
+with Unchecked_Conversion;
+package CD90001_0 is
+
+  -- Case 1 : Modular <=> Enumeration
+
+  type Eight_Bits is mod 2**8;
+    for Eight_Bits'Size use 8;
+
+  type User_Enums is ( One, Two, Four, Eight,
+                       Sixteen, Thirty_Two, Sixty_Four, One_Twenty_Eight );
+    for User_Enums'Size use 8;
+
+    for User_Enums use
+                    ( One              =>   1,                -- ANX-C RQMT.
+                      Two              =>   2,                -- ANX-C RQMT.
+                      Four             =>   4,                -- ANX-C RQMT.
+                      Eight            =>   8,                -- ANX-C RQMT.
+                      Sixteen          =>  16,                -- ANX-C RQMT.
+                      Thirty_Two       =>  32,                -- ANX-C RQMT.
+                      Sixty_Four       =>  64,                -- ANX-C RQMT.
+                      One_Twenty_Eight => 128 );              -- ANX-C RQMT.
+
+  function EB_2_UE is new Unchecked_Conversion( Eight_Bits, User_Enums );
+
+  function UE_2_EB is new Unchecked_Conversion( User_Enums, Eight_Bits );
+
+  procedure TC_Check_Case_1;
+
+  -- Case 2 : Integer <=> Packed Character array
+
+  type Signed_16 is range -2**15+1 .. 2**15-1;
+  -- +1, -1 allows for both 1's and 2's comp
+
+  type Bits_16 is array(0..1) of Character;
+  pragma Pack(Bits_16);                                       -- ANX-C RQMT.
+
+  function S16_2_B16 is new Unchecked_Conversion( Signed_16, Bits_16 );
+
+  function B16_2_S16 is new Unchecked_Conversion( Bits_16, Signed_16 );
+
+  procedure TC_Check_Case_2;
+
+end CD90001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body CD90001_0 is
+
+  Check_List : constant array(1..8) of Eight_Bits
+             := ( 1, 2, 4, 8, 16, 32, 64, 128 );
+
+  Check_Enum : constant array(1..8) of User_Enums
+             := ( One, Two, Four, Eight,
+                  Sixteen, Thirty_Two, Sixty_Four, One_Twenty_Eight );
+
+  procedure TC_Check_Case_1 is
+    Mod_Value : Eight_Bits;
+    Enum_Val  : User_Enums;
+  begin
+    for I in Check_List'Range loop
+
+      if EB_2_UE(Check_List(I)) /= Check_Enum(I) then
+        Report.Failed("EB => UE conversion failed");
+      end if;
+
+      if Check_List(I)          /= UE_2_EB(Check_Enum(I)) then
+        Report.Failed ("EU => EB conversion failed");
+      end if;
+
+    end loop; 
+  end TC_Check_Case_1;
+
+  procedure TC_Check_Case_2 is
+    S: Signed_16;
+    T,U: Signed_16;
+    B: Bits_16;
+    C,D: Bits_16;  -- allow for byte swapping
+  begin
+         --FDEC_BA98_7654_3210
+    S := 2#0011_0000_0111_0111#;
+    B := S16_2_B16( S );
+    C := ( Character'Val(2#0011_0000#), Character'Val(2#0111_0111#) );
+    D := ( Character'Val(2#0111_0111#), Character'Val(2#0011_0000#) );
+
+    if (B /= C) and (B /= D) then
+      Report.Failed("Int => Chararray conversion failed");
+    end if;
+
+    B := ( Character'Val(2#0011_1100#), Character'Val(2#0101_0101#) );
+    S := B16_2_S16( B );
+    T := 2#0011_1100_0101_0101#;
+    U := 2#0101_0101_0011_1100#;
+
+    if (S /= T) and (S /= U) then
+      Report.Failed("Chararray => Int conversion failed");
+    end if;
+
+  end TC_Check_Case_2;
+
+end CD90001_0;
+
+------------------------------------------------------------------- CD90001
+
+with Report;
+with CD90001_0;
+
+procedure CD90001 is
+
+  Eight_NA   : Boolean := False;
+  Sixteen_NA : Boolean := False;
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD90001", "Check that Unchecked_Conversion is supported " &
+                          "and is reversible in appropriate cases" );
+  Eight_Bit_Case:
+  begin
+    if CD90001_0.User_Enums'Size /= CD90001_0.Eight_Bits'Size then
+      Report.Comment("The sizes of the 8 bit types used in this test "
+                            & "do not match" );
+      Eight_NA := True;
+    elsif CD90001_0.User_Enums'Alignment /= CD90001_0.Eight_Bits'Alignment then
+      Report.Comment("The alignments of the 8 bit types used in this "
+                            & "test do not match" );
+      Eight_NA := True;
+    else
+      CD90001_0.TC_Check_Case_1;
+    end if;
+
+  exception
+    when Constraint_Error =>
+           Report.Failed("Constraint_Error raised in 8 bit case");
+    when others           =>
+           Report.Failed("Unexpected exception raised in 8 bit case");
+  end Eight_Bit_Case;
+
+  Sixteen_Bit_Case:
+  begin
+    if CD90001_0.Signed_16'Size /= CD90001_0.Bits_16'Size then
+      Report.Comment("The sizes of the 16 bit types used in this test "
+                            & "do not match" );
+      Sixteen_NA := True;
+    elsif CD90001_0.Signed_16'Alignment = CD90001_0.Bits_16'Alignment then
+      Report.Comment("The alignments of the 16 bit types used in this "
+                            & "test do not match" );
+      Sixteen_NA := True;
+    else
+      CD90001_0.TC_Check_Case_2;
+    end if;
+
+  exception
+    when Constraint_Error =>
+           Report.Failed("Constraint_Error raised in 16 bit case");
+    when others           =>
+           Report.Failed("Unexpected exception raised in 16 bit case");
+  end Sixteen_Bit_Case;
+
+  if Eight_NA and Sixteen_NA then
+    Report.Not_Applicable("No cases in this test apply");
+  end if;
+
+  Report.Result;
+
+end CD90001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd92001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd92001.a
new file mode 100644
index 000000000..d07ff4881
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cd92001.a
@@ -0,0 +1,229 @@
+-- CD92001.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 X denotes a scalar object, X'Valid
+--      yields true if an only if the object denoted by X is normal and
+--      has a valid representation.
+--
+-- TEST DESCRIPTION:
+--      Using Unchecked_Conversion, Image and Value attributes, combined
+--      with string manipulation, cause valid and invalid values to be
+--      stored in various objects.  Check their validity with the
+--      attribute 'Valid.  Invalid objects are created in a loop which
+--      performs a simplistic check to ensure that the values being used
+--      are indeed not valid, then assigns the value using an instance of
+--      Unchecked_Conversion.  The creation of the tables of valid values
+--      is trivial.
+--
+-- APPLICABILITY CRITERIA:
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Systems Programming Annex (C):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex C:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- N/A => ERROR", in which case it may be graded as
+--        inapplicable. Otherwise, the test must execute and report PASSED.
+--
+--
+-- CHANGE HISTORY:
+--      10 MAY 95   SAIC    Initial version
+--      07 MAY 96   SAIC    Changed U_C to Ada.U_C for 2.1
+--      05 JAN 99   RLB     Added Component_Size clauses to compensate
+--                          for the fact that there is no required size
+--                          for either the enumeration or modular components.
+--!
+
+with Report;
+with Ada.Unchecked_Conversion;
+with System;
+procedure CD92001 is
+
+  type Sparse_Enumerated is
+       ( Help, Home, Page_Up, Del, EndK,
+         Page_Down, Up, Left, Down, Right );
+
+  for Sparse_Enumerated use ( Help      =>    2,
+                              Home      =>    4,
+                              Page_Up   =>    8,
+                              Del       =>   16,
+                              EndK      =>   32,
+                              Page_Down =>   64,
+                              Up        =>  128,
+                              Left      =>  256,
+                              Down      =>  512,
+                              Right     => 1024 );
+
+  type Mod_10 is mod 10;
+
+  type Default_Enumerated is ( Zero,  One, Two,   Three, Four,
+                               Five,  Six, Seven, Eight, Nine,
+                               Clear, '=', '/',   '*',   '-',
+                               '+',   Enter );
+    for Default_Enumerated'Size use 8;
+
+  Default_Enumerated_Count : constant := 17;
+
+  type Mod_By_Enum_Items is mod Default_Enumerated_Count;
+
+  type Mod_Same_Size_As_Sparse_Enum is mod 2**12;
+                                        -- Sparse_Enumerated 'Size;
+
+  type Mod_Same_Size_As_Def_Enum is mod 2**8;
+                                     -- Default_Enumerated'Size;
+
+  subtype Test_Width is Positive range 1..100;
+
+  -- Note: There is no required relationship between 'Size and 'Component_Size,
+  -- so we must use component_size clauses here.
+  -- We use the following expressions to insure that the component size is a
+  -- multiple of the Storage_Unit.
+  Sparse_Component_Size : constant := ((Sparse_Enumerated'Size / System.Storage_Unit) +
+        Boolean'Pos((Sparse_Enumerated'Size mod System.Storage_Unit) /= 0)) *
+        System.Storage_Unit;
+  Default_Component_Size : constant := ((Default_Enumerated'Size / System.Storage_Unit) +
+        Boolean'Pos((Sparse_Enumerated'Size mod System.Storage_Unit) /= 0)) *
+        System.Storage_Unit;
+
+  type Sparse_Enum_Table is array(Test_Width) of Sparse_Enumerated;
+  for Sparse_Enum_Table'Component_Size use Sparse_Component_Size;  -- N/A => ERROR.
+  type Def_Enum_Table is array(Test_Width) of Default_Enumerated;
+  for Def_Enum_Table'Component_Size use Default_Component_Size;  -- N/A => ERROR.
+
+  type Sparse_Mod_Table  is
+       array(Test_Width) of Mod_Same_Size_As_Sparse_Enum;
+  for Sparse_Mod_Table'Component_Size use Sparse_Component_Size;  -- N/A => ERROR.
+
+  type Default_Mod_Table is
+       array(Test_Width) of Mod_Same_Size_As_Def_Enum;
+  for Default_Mod_Table'Component_Size use Default_Component_Size;  -- N/A => ERROR.
+
+  function UC_Sparse_Mod_Enum is
+    new Ada.Unchecked_Conversion( Sparse_Mod_Table, Sparse_Enum_Table );
+
+  function UC_Def_Mod_Enum is
+    new Ada.Unchecked_Conversion( Default_Mod_Table, Def_Enum_Table );
+
+  Valid_Sparse_Values : Sparse_Enum_Table;
+  Valid_Def_Values    : Def_Enum_Table;
+
+  Sample_Enum_Value_Table : Sparse_Mod_Table;
+  Sample_Def_Value_Table  : Default_Mod_Table;
+
+
+  -- fill the Valid tables with valid values for conversion
+  procedure Fill_Valid is
+    K : Mod_10 := 0;
+    P : Mod_By_Enum_Items := 0;
+  begin
+    for I in Test_Width loop
+      Valid_Sparse_Values(I) := Sparse_Enumerated'Val( K );
+      Valid_Def_Values(I)    := Default_Enumerated'Val( Integer(P) );
+      K := K +1;
+      P := P +1;
+    end loop;
+  end Fill_Valid;
+
+  -- fill the Sample tables with invalid values for conversion
+  procedure Fill_Invalid is
+    K : Mod_Same_Size_As_Sparse_Enum := 1;
+    P : Mod_Same_Size_As_Def_Enum    := 1;
+  begin
+    for I in Test_Width loop
+      K := K +13;
+      if K mod 2 = 0 then  -- oops, that would be a valid value
+        K := K +1;
+      end if;
+      if P = Mod_Same_Size_As_Def_Enum'Last
+         or P < Default_Enumerated_Count then -- that would be valid
+        P := Default_Enumerated_Count + 1;
+      else
+        P := P +1;
+      end if;
+      Sample_Enum_Value_Table(I) := K;
+      Sample_Def_Value_Table(I)  := P;
+    end loop;
+
+    Valid_Sparse_Values := UC_Sparse_Mod_Enum(Sample_Enum_Value_Table);
+    Valid_Def_Values    := UC_Def_Mod_Enum(Sample_Def_Value_Table);
+
+  end Fill_Invalid;
+
+  -- fill the tables with second set of valid values for conversion
+  procedure Refill_Valid is
+    K : Mod_10 := 0;
+    P : Mod_By_Enum_Items := 0;
+
+    Table : Array(Mod_10) of Mod_Same_Size_As_Sparse_Enum
+          := ( 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024 );
+
+  begin
+    for I in Test_Width loop
+      Sample_Enum_Value_Table(I) := Table(K);
+      Sample_Def_Value_Table(I)  := Mod_Same_Size_As_Def_Enum(P);
+      K := K +1;
+      P := P +1;
+    end loop;
+    Valid_Sparse_Values := UC_Sparse_Mod_Enum(Sample_Enum_Value_Table);
+    Valid_Def_Values    := UC_Def_Mod_Enum(Sample_Def_Value_Table);
+  end Refill_Valid;
+
+  procedure Validate(Expect_Valid: Boolean) is
+  begin  -- here's where we actually use the tested attribute
+
+    for K in Test_Width loop
+      if Valid_Sparse_Values(K)'Valid /= Expect_Valid then
+        Report.Failed("Expected 'Valid =" & Boolean'Image(Expect_Valid)
+                    & " for Sparse item " & Integer'Image(K) );
+      end if;
+    end loop;
+
+    for P in Test_Width loop
+      if Valid_Def_Values(P)'Valid /= Expect_Valid then
+        Report.Failed("Expected 'Valid =" & Boolean'Image(Expect_Valid)
+                    & " for Default item " & Integer'Image(P) );
+      end if;
+    end loop;
+
+  end Validate;
+
+begin  -- Main test procedure.
+
+  Report.Test ("CD92001", "Check object attribute: X'Valid" );
+   
+  Fill_Valid;
+  Validate(True);
+
+  Fill_Invalid;
+  Validate(False);
+
+  Refill_Valid;
+  Validate(True);
+
+  Report.Result;
+
+end CD92001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201a.ada
new file mode 100644
index 000000000..b433f0cac
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201a.ada
@@ -0,0 +1,70 @@
+-- CDA201A.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_CONVERSION CAN BE INSTANTIATED FOR
+--     CONVERSION BETWEEN INTEGER AND BOOLEAN ARRAY TYPES.
+
+-- HISTORY:
+--     JET 09/12/88  CREATED ORIGINAL TEST.
+--     DHH 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
+
+WITH REPORT; USE REPORT;
+WITH UNCHECKED_CONVERSION;
+PROCEDURE CDA201A IS
+
+     TYPE BOOL_ARR IS ARRAY (1..INTEGER'SIZE) OF BOOLEAN;
+     PRAGMA PACK (BOOL_ARR);
+
+     I : INTEGER;
+     B : BOOL_ARR;
+
+     FUNCTION INT_TO_BOOL IS NEW
+                               UNCHECKED_CONVERSION (INTEGER, BOOL_ARR);
+
+     FUNCTION BOOL_TO_INT IS NEW UNCHECKED_CONVERSION(BOOL_ARR,INTEGER);
+
+BEGIN
+     TEST ("CDA201A", "CHECK THAT UNCHECKED_CONVERSION CAN BE " &
+                      "INSTANTIATED FOR CONVERSION BETWEEN " &
+                      "INTEGER AND BOOLEAN ARRAY TYPES");
+
+     I := BOOL_TO_INT((1..INTEGER'SIZE => IDENT_BOOL(TRUE)));
+
+     IF INT_TO_BOOL(IDENT_INT(I)) /= (1..INTEGER'SIZE => TRUE) THEN
+          FAILED("INCORRECT RESULT FROM ARRAY-INTEGER-ARRAY");
+     END IF;
+
+     B := INT_TO_BOOL(IDENT_INT(-1));
+
+     FOR J IN B'RANGE LOOP
+          B(J) := IDENT_BOOL(B(J));
+     END LOOP;
+
+     IF BOOL_TO_INT(B) /= -1 THEN
+          FAILED("INCORRECT RESULT FROM INTEGER-ARRAY-INTEGER");
+     END IF;
+
+     RESULT;
+END CDA201A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201b.ada
new file mode 100644
index 000000000..742cd92c3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201b.ada
@@ -0,0 +1,63 @@
+-- CDA201B.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_CONVERSION CAN BE INSTANTIATED FOR
+--     CONVERSION BETWEEN FLOAT AND BOOLEAN ARRAY TYPES.
+
+-- HISTORY:
+--     JET 09/12/88  CREATED ORIGINAL TEST.
+--     DHH 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
+--     GJD 11/15/95  REMOVED USE OF OBSOLETE ADA 83 ATTRIBUTE (LARGE).
+
+WITH REPORT; USE REPORT;
+WITH UNCHECKED_CONVERSION;
+PROCEDURE CDA201B IS
+
+     TYPE BOOL_ARR IS ARRAY (1..FLOAT'SIZE) OF BOOLEAN;
+     PRAGMA PACK (BOOL_ARR);
+
+     B : BOOL_ARR;
+
+     FUNCTION FLT_TO_BOOL IS NEW UNCHECKED_CONVERSION(FLOAT, BOOL_ARR);
+
+     FUNCTION BOOL_TO_FLT IS NEW UNCHECKED_CONVERSION(BOOL_ARR, FLOAT);
+
+BEGIN
+     TEST ("CDA201B", "CHECK THAT UNCHECKED_CONVERSION CAN BE " &
+                      "INSTANTIATED FOR CONVERSION BETWEEN " &
+                      "FLOAT AND BOOLEAN ARRAY TYPES");
+
+     B := FLT_TO_BOOL(FLOAT'LAST + FLOAT(IDENT_INT(0)));
+
+     FOR J IN B'RANGE LOOP
+          B(J) := B(J+IDENT_INT(0));
+     END LOOP;
+
+     IF BOOL_TO_FLT(B) /= FLOAT'LAST THEN
+          FAILED("INCORRECT RESULT FROM FLOAT-ARRAY-FLOAT");
+     END IF;
+
+     RESULT;
+END CDA201B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201c.ada
new file mode 100644
index 000000000..db742ace7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201c.ada
@@ -0,0 +1,76 @@
+-- CDA201C.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_CONVERSION CAN BE INSTANTIATED FOR
+--     CONVERSION BETWEEN CONSTRAINED ARRAY AND RECORD TYPES.
+
+-- HISTORY:
+--     JET 09/12/88  CREATED ORIGINAL TEST.
+--     DHH 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
+
+WITH REPORT; USE REPORT;
+WITH UNCHECKED_CONVERSION;
+PROCEDURE CDA201C IS
+
+     TYPE INT IS NEW INTEGER;
+
+     TYPE ARR IS ARRAY (1..2) OF INTEGER;
+     TYPE ARR2 IS ARRAY (ARR'RANGE) OF INT;
+
+     TYPE REC IS RECORD
+          D : INTEGER;
+          I : INTEGER;
+     END RECORD;
+
+     TYPE REC2 IS RECORD
+          D : INT;
+          I : INT;
+     END RECORD;
+
+     A : ARR2;
+     R : REC2;
+
+     FUNCTION ARR_CONV IS NEW UNCHECKED_CONVERSION(ARR, ARR2);
+     FUNCTION REC_CONV IS NEW UNCHECKED_CONVERSION(REC, REC2);
+
+BEGIN
+     TEST ("CDA201C", "CHECK THAT UNCHECKED_CONVERSION CAN BE " &
+                      "INSTANTIATED FOR CONVERSION BETWEEN " &
+                      "CONSTRAINED ARRAY AND RECORD TYPES");
+
+     A := ARR_CONV(ARR'(ARR'RANGE => IDENT_INT(-1)));
+
+     IF A /= ARR2'(ARR'RANGE => -1) THEN
+          FAILED("INCORRECT RESULT FROM ARRAY CONVERSION");
+     END IF;
+
+     R := REC_CONV(REC'(D | I => IDENT_INT(1)));
+
+     IF R /= REC2'(D => 1, I => 1) THEN
+          FAILED("INCORRECT RESULT FROM RECORD CONVERSION");
+     END IF;
+
+     RESULT;
+END CDA201C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201e.ada
new file mode 100644
index 000000000..c82e48c53
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cda201e.ada
@@ -0,0 +1,120 @@
+-- CDA201E.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_CONVERSION CAN BE INSTANTIATED FOR THE
+--     CONVERSION OF AN ENUMERATION TYPE WITH A REPRESENTATION CLAUSE TO
+--     INTEGER.
+
+-- HISTORY:
+--     JET 09/23/88  CREATED ORIGINAL TEST.
+--     DHH 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
+--     RJW 02/28/90  ADDED SIZE CLAUSE FOR TYPE STOOGE.
+--     LDC 09/20/90  ADDED CHECK FOR CONVERSION FROM INT TO STOOGE,
+--                   ADDED COMMENT WHEN SIZES AREN'T EQUAL.
+
+WITH REPORT; USE REPORT;
+WITH UNCHECKED_CONVERSION;
+PROCEDURE CDA201E IS
+
+     TYPE STOOGE IS (CURLY, MOE, LARRY);
+     FOR STOOGE USE (CURLY => -5, MOE => 13, LARRY => 127);
+     FOR STOOGE'SIZE USE 8;
+
+     TYPE INT IS RANGE -128 .. 127;
+     FOR INT'SIZE USE 8;
+
+     I    : INT := 0;
+     NAME : STOOGE := CURLY;
+
+     FUNCTION E_TO_I IS NEW UNCHECKED_CONVERSION(STOOGE, INT);
+     FUNCTION I_TO_E IS NEW UNCHECKED_CONVERSION(INT, STOOGE);
+
+     FUNCTION ID(E : STOOGE) RETURN STOOGE IS
+     BEGIN
+          RETURN STOOGE'VAL(STOOGE'POS(E) + IDENT_INT(0));
+     END ID;
+
+     FUNCTION ID_INT (X : INT) RETURN INT IS
+          A : INTEGER := IDENT_INT(3);
+     BEGIN
+          IF EQUAL (A, IDENT_INT(3)) THEN    -- ALWAYS EQUAL.
+               RETURN X;                     -- ALWAYS EXECUTED.
+          END IF;
+          RETURN 0;                          -- NEVER EXECUTED.
+     END ID_INT;
+
+BEGIN
+     TEST ("CDA201E", "CHECK THAT UNCHECKED_CONVERSION CAN BE " &
+                      "INSTANTIATED FOR THE CONVERSION OF AN " &
+                      "ENUMERATION TYPE WITH A REPRESENTATION " &
+                      "CLAUSE TO INTEGER");
+
+     IF I'SIZE /= NAME'SIZE THEN
+          COMMENT( "UNCHECKED_CONVERSION MIGHT BE INSTANTIATED WITH " &
+                   "DIFFERNT SIZES");
+     END IF;
+
+     BEGIN
+          I := E_TO_I(ID(CURLY));
+          IF I /= -5 THEN
+               FAILED ("INCORRECT VALUE OF CURLY: " & INT'IMAGE(I));
+          END IF;
+
+          I := E_TO_I(ID(MOE));
+          IF I /= 13 THEN
+               FAILED ("INCORRECT VALUE OF MOE: " & INT'IMAGE(I));
+          END IF;
+
+          I := E_TO_I(ID(LARRY));
+          IF I /= 127 THEN
+               FAILED ("INCORRECT VALUE OF LARRY: " & INT'IMAGE(I));
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED BY CONVERSION");
+     END;
+
+     BEGIN     -- 2
+          NAME := I_TO_E(ID_INT(-5));
+          IF NAME /= CURLY THEN
+               FAILED ("INCORRECT VALUE OF -5 : " & STOOGE'IMAGE(NAME));
+          END IF;
+
+          NAME := I_TO_E(ID_INT(13));
+          IF NAME /= MOE THEN
+               FAILED ("INCORRECT VALUE OF 13: " & STOOGE'IMAGE(NAME));
+          END IF;
+
+          NAME := I_TO_E(ID_INT(127));
+          IF NAME /= LARRY THEN
+               FAILED ("INCORRECT VALUE OF 127: " & STOOGE'IMAGE(NAME));
+          END IF;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED BY CONVERSION - 2");
+     END;
+
+     RESULT;
+END CDA201E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdb0a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdb0a01.a
new file mode 100644
index 000000000..566fad138
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdb0a01.a
@@ -0,0 +1,305 @@
+-- CDB0A01.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 storage pool may be user_determined, and that storage
+--      is allocated by calling Allocate.
+--
+--      Check that a storage.pool may be specified using 'Storage_Pool
+--      and that S'Storage_Pool denotes the storage pool of the type S.
+--
+-- TEST DESCRIPTION:
+--      The package System.Storage_Pools is exercised by two very similar
+--      packages which define a tree type and exercise it in a simple manner.
+--      One package uses a user defined pool.  The other package uses a
+--      storage pool assigned by the implementation; Storage_Size is
+--      specified for this pool.
+--      The dispatching procedures Allocate and Deallocate are tested as an
+--      intentional side effect of the tree packages.
+--
+--      For completeness, the actions of the tree packages are checked for
+--      correct operation.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FDB0A00.A   (foundation code)
+--         CDB0A01.A
+--
+--
+-- CHANGE HISTORY:
+--      02 JUN 95   SAIC   Initial version
+--      07 MAY 96   SAIC   Removed ambiguity with CDB0A02
+--      13 FEB 97   PWB.CTA Corrected lexically ordered string literal
+--!
+
+---------------------------------------------------------------- CDB0A01_1
+
+---------------------------------------------------------- FDB0A00.Pool1
+
+package FDB0A00.Pool1 is
+  User_Pool : Stack_Heap( 5_000 );
+end FDB0A00.Pool1;
+
+---------------------------------------------------------- FDB0A00.Comparator
+
+with System.Storage_Pools;
+package FDB0A00.Comparator is
+
+  function "="( A,B : System.Storage_Pools.Root_Storage_Pool'Class )
+           return Boolean;
+
+end FDB0A00.Comparator;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+package body FDB0A00.Comparator is
+
+  function "="( A,B : System.Storage_Pools.Root_Storage_Pool'Class )
+           return Boolean is
+    use type System.Address;
+  begin
+    return A'Address = B'Address;
+  end "=";
+
+end FDB0A00.Comparator;
+
+---------------------------------------------------------------- CDB0A01_2
+
+with FDB0A00.Pool1;
+package CDB0A01_2 is
+
+  type Cell;
+  type User_Pool_Tree is access Cell;
+
+  for User_Pool_Tree'Storage_Pool use FDB0A00.Pool1.User_Pool;
+
+  type Cell is record
+    Data : Character;
+    Left,Right : User_Pool_Tree;
+  end record;
+
+  procedure Insert( Item: Character; On_Tree : in out User_Pool_Tree );
+
+  procedure Traverse( The_Tree : User_Pool_Tree );
+
+  procedure Defoliate( The_Tree : in out User_Pool_Tree );
+
+end CDB0A01_2;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+with Unchecked_Deallocation;
+package body CDB0A01_2 is
+  procedure Deallocate is new Unchecked_Deallocation(Cell,User_Pool_Tree);
+
+  -- Sort: zeros on the left, ones on the right...
+  procedure Insert( Item: Character; On_Tree : in out User_Pool_Tree ) is
+  begin
+    if On_Tree = null then
+      On_Tree := new Cell'(Item,null,null); 
+    elsif Item > On_Tree.Data then
+      Insert(Item,On_Tree.Right);
+    else
+      Insert(Item,On_Tree.Left);  
+    end if;
+  end Insert;
+
+  procedure Traverse( The_Tree : User_Pool_Tree ) is
+  begin
+    if The_Tree = null then
+      null;  -- how very symmetrical
+    else
+      Traverse(The_Tree.Left);
+      TCTouch.Touch(The_Tree.Data);
+      Traverse(The_Tree.Right);
+    end if;
+  end Traverse;
+
+  procedure Defoliate( The_Tree : in out User_Pool_Tree ) is
+  begin
+
+    if The_Tree.Left /= null then
+      Defoliate(The_Tree.Left);
+    end if;
+
+    if The_Tree.Right /= null then
+      Defoliate(The_Tree.Right);
+    end if;
+
+    Deallocate(The_Tree);
+
+  end Defoliate;
+
+end CDB0A01_2;
+
+---------------------------------------------------------------- CDB0A01_3
+
+with FDB0A00.Pool1;
+package CDB0A01_3 is
+
+  type Cell;
+  type System_Pool_Tree is access Cell;
+
+  for System_Pool_Tree'Storage_Size use 2000;
+
+  -- assumptions: Cell is <= 20 storage_units
+  --              Tree building exercise requires O(15) cells
+  --              2000 > 20 * 15 by a generous margin
+
+  type Cell is record
+    Data: Character;
+    Left,Right : System_Pool_Tree;
+  end record;
+
+  procedure Insert( Item: Character; On_Tree : in out System_Pool_Tree );
+
+  procedure Traverse( The_Tree : System_Pool_Tree );
+
+  procedure Defoliate( The_Tree : in out System_Pool_Tree );
+
+end CDB0A01_3;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+with Unchecked_Deallocation;
+package body CDB0A01_3 is
+  procedure Deallocate is new Unchecked_Deallocation(Cell,System_Pool_Tree);
+
+  -- Sort: zeros on the left, ones on the right...
+  procedure Insert( Item: Character; On_Tree : in out System_Pool_Tree ) is
+  begin
+    if On_Tree = null then
+      On_Tree := new Cell'(Item,null,null);
+    elsif Item > On_Tree.Data then
+      Insert(Item,On_Tree.Right);
+    else
+      Insert(Item,On_Tree.Left);  
+    end if;
+  end Insert;
+
+  procedure Traverse( The_Tree : System_Pool_Tree ) is
+  begin
+    if The_Tree = null then
+      null;  -- how very symmetrical
+    else
+      Traverse(The_Tree.Left);
+      TCTouch.Touch(The_Tree.Data);
+      Traverse(The_Tree.Right);
+    end if;
+  end Traverse;
+
+  procedure Defoliate( The_Tree : in out System_Pool_Tree ) is
+  begin
+
+    if The_Tree.Left /= null then
+      Defoliate(The_Tree.Left);
+    end if;
+
+    if The_Tree.Right /= null then
+      Defoliate(The_Tree.Right);
+    end if;
+
+    Deallocate(The_Tree);
+
+  end Defoliate;
+
+end CDB0A01_3;
+
+------------------------------------------------------------------ CDB0A01
+
+with Report;
+with TCTouch;
+with FDB0A00.Comparator;
+with FDB0A00.Pool1;
+with CDB0A01_2;
+with CDB0A01_3;
+
+procedure CDB0A01 is
+
+  Banyan : CDB0A01_2.User_Pool_Tree;
+  Torrey : CDB0A01_3.System_Pool_Tree;
+
+  use type CDB0A01_2.User_Pool_Tree;
+  use type CDB0A01_3.System_Pool_Tree;
+
+  Countess     : constant String := "Ada Augusta Lovelace";
+  Cenosstu     : constant String := "  AALaaacdeeglostuuv";
+  Insertion    : constant String := "AAAAAAAAAAAAAAAAAAAA";
+  Deallocation : constant String := "DDDDDDDDDDDDDDDDDDDD";
+
+begin  -- Main test procedure.
+
+   Report.Test ("CDB0A01", "Check that a storage pool may be " &
+                           "user_determined, and that storage is " &
+                           "allocated by calling Allocate.  Check that " &
+                           "a storage.pool may be specified using " &
+                           "'Storage_Pool and that S'Storage_Pool denotes " &
+                           "the storage pool of the type S" );
+
+--      Check that S'Storage_Pool denotes the storage pool for the type S.
+
+  TCTouch.Assert(
+     FDB0A00.Comparator."="(FDB0A00.Pool1.User_Pool,
+                            CDB0A01_2.User_Pool_Tree'Storage_Pool ),
+     "'Storage_Pool not correct for CDB0A01_2.User_Pool_Tree");
+
+  TCTouch.Assert_Not(
+     FDB0A00.Comparator."="(FDB0A00.Pool1.User_Pool,
+                            CDB0A01_3.System_Pool_Tree'Storage_Pool ),
+     "'Storage_Pool not correct for CDB0A01_3.System_Pool_Tree");
+
+--      Check that storage is allocated by calling Allocate.
+
+  for Count in Countess'Range loop
+    CDB0A01_2.Insert( Countess(Count), Banyan );
+  end loop;
+  TCTouch.Validate(Insertion, "Allocate calls via CDB0A01_2" ); 
+
+  for Count in Countess'Range loop
+    CDB0A01_3.Insert( Countess(Count), Torrey );
+  end loop;
+  TCTouch.Validate("", "Allocate calls via CDB0A01_3" ); 
+
+  CDB0A01_2.Traverse(Banyan);
+  TCTouch.Validate(Cenosstu, "Traversal of Banyan" );
+
+  CDB0A01_3.Traverse(Torrey);
+  TCTouch.Validate(Cenosstu, "Traversal of Torrey" );
+
+  CDB0A01_2.Defoliate(Banyan);
+  TCTouch.Validate(Deallocation, "Deforestation of Banyan" );
+  TCTouch.Assert(Banyan = null, "Banyan Deallocation result not null");
+
+  CDB0A01_3.Defoliate(Torrey);
+  TCTouch.Validate("", "Deforestation of Torrey" );
+  TCTouch.Assert(Torrey = null, "Torrey Deallocation result not null");
+
+  Report.Result;
+
+end CDB0A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdb0a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdb0a02.a
new file mode 100644
index 000000000..6a7fca54a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdb0a02.a
@@ -0,0 +1,329 @@
+-- CDB0A02.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 several access types can share the same pool.
+--
+--      Check that any exception propagated by Allocate is
+--      propagated by the allocator.
+--
+--      Check that for an access type S, S'Max_Size_In_Storage_Elements
+--      denotes the maximum values for Size_In_Storage_Elements that will
+--      be requested via Allocate.
+--
+-- TEST DESCRIPTION:
+--      After checking correct operation of the tree packages, the limits of
+--      the storage pools (first the shared user defined storage pool, then
+--      the system storage pool) are intentionally exceeded.  The test checks
+--      that the correct exception is raised.
+--
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FDB0A00.A   (foundation code)
+--         CDB0A02.A
+--
+--
+-- CHANGE HISTORY:
+--      10 AUG 95   SAIC   Initial version
+--      07 MAY 96   SAIC   Disambiguated for 2.1
+--      13 FEB 97   PWB.CTA  Reduced minimum allowable
+--                           Max_Size_In_Storage_Units, for implementations
+--                           with larger storage units
+--      25 JAN 01   RLB    Removed dubious checks on Max_Size_In_Storage_Units;
+--                         tightened important one.
+
+--!
+
+---------------------------------------------------------- FDB0A00.Pool2
+
+package FDB0A00.Pool2 is
+  Pond : Stack_Heap( 5_000 );
+end FDB0A00.Pool2;
+
+---------------------------------------------------------------- CDB0A02_2
+
+with FDB0A00.Pool2;
+package CDB0A02_2 is
+
+  type Small_Cell;
+  type Small_Tree is access Small_Cell;
+
+  for Small_Tree'Storage_Pool use FDB0A00.Pool2.Pond;  -- first usage
+
+  type Small_Cell is record
+    Data: Character;
+    Left,Right : Small_Tree;
+  end record;
+
+  procedure Insert( Item: Character; On_Tree : in out Small_Tree );
+
+  procedure Traverse( The_Tree : Small_Tree );
+
+  procedure Defoliate( The_Tree : in out Small_Tree );
+
+  procedure TC_Exceed_Pool;
+
+  Pool_Max_Elements : constant := 6000;
+                      -- to guarantee overflow in TC_Exceed_Pool
+
+end CDB0A02_2;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+with Report;
+with Unchecked_Deallocation;
+package body CDB0A02_2 is
+  procedure Deallocate is new Unchecked_Deallocation(Small_Cell,Small_Tree);
+
+  -- Sort: zeros on the left, ones on the right...
+  procedure Insert( Item: Character; On_Tree : in out Small_Tree ) is
+  begin
+    if On_Tree = null then
+      On_Tree := new Small_Cell'(Item,null,null);
+    elsif Item > On_Tree.Data then
+      Insert(Item,On_Tree.Right);
+    else
+      Insert(Item,On_Tree.Left);
+    end if;
+  end Insert;
+
+  procedure Traverse( The_Tree : Small_Tree ) is
+  begin
+    if The_Tree = null then
+      null;  -- how very symmetrical
+    else
+      Traverse(The_Tree.Left);
+      TCTouch.Touch(The_Tree.Data);
+      Traverse(The_Tree.Right);
+    end if;
+  end Traverse;
+
+  procedure Defoliate( The_Tree : in out Small_Tree ) is
+  begin
+
+    if The_Tree.Left /= null then
+      Defoliate(The_Tree.Left);
+    end if;
+
+    if The_Tree.Right /= null then
+      Defoliate(The_Tree.Right);
+    end if;
+
+    Deallocate(The_Tree);
+
+  end Defoliate;
+
+  procedure TC_Exceed_Pool is
+    Wild_Branch : Small_Tree;
+  begin
+    for Ever in 1..Pool_Max_Elements loop
+       Wild_Branch := new Small_Cell'('a', Wild_Branch, Wild_Branch);
+       TCTouch.Validate("A","Allocating element for overflow");
+    end loop;
+    Report.Failed(" Pool_Overflow not raised on exceeding user pool size");
+  exception
+    when FDB0A00.Pool_Overflow => null; -- anticipated case
+    when others =>
+      Report.Failed("wrong exception raised in user Exceed_Pool");
+  end TC_Exceed_Pool;
+
+end CDB0A02_2;
+
+---------------------------------------------------------------- CDB0A02_3
+
+-- This package is essentially identical to CDB0A02_2, except that the size
+-- of a cell is significantly larger.  This is used to check that different
+-- access types may share a single pool
+
+with FDB0A00.Pool2;
+package CDB0A02_3 is
+
+  type Large_Cell;
+  type Large_Tree is access Large_Cell;
+
+  for Large_Tree'Storage_Pool use FDB0A00.Pool2.Pond;  -- second usage
+
+  type Large_Cell is record
+    Data: Character;
+    Extra_Data : String(1..2);
+    Left,Right : Large_Tree;
+  end record;
+
+  procedure Insert( Item: Character; On_Tree : in out Large_Tree );
+
+  procedure Traverse( The_Tree : Large_Tree );
+
+  procedure Defoliate( The_Tree : in out Large_Tree );
+
+end CDB0A02_3;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with TCTouch;
+with Unchecked_Deallocation;
+package body CDB0A02_3 is
+  procedure Deallocate is new Unchecked_Deallocation(Large_Cell,Large_Tree);
+
+  -- Sort: zeros on the left, ones on the right...
+  procedure Insert( Item: Character; On_Tree : in out Large_Tree ) is
+  begin
+    if On_Tree = null then
+      On_Tree := new Large_Cell'(Item,(Item,Item),null,null);
+    elsif Item > On_Tree.Data then
+      Insert(Item,On_Tree.Right);
+    else
+      Insert(Item,On_Tree.Left);
+    end if;
+  end Insert;
+
+  procedure Traverse( The_Tree : Large_Tree ) is
+  begin
+    if The_Tree = null then
+      null;  -- how very symmetrical
+    else
+      Traverse(The_Tree.Left);
+      TCTouch.Touch(The_Tree.Data);
+      Traverse(The_Tree.Right);
+    end if;
+  end Traverse;
+
+  procedure Defoliate( The_Tree : in out Large_Tree ) is
+  begin
+
+    if The_Tree.Left /= null then
+      Defoliate(The_Tree.Left);
+    end if;
+
+    if The_Tree.Right /= null then
+      Defoliate(The_Tree.Right);
+    end if;
+
+    Deallocate(The_Tree);
+
+ end Defoliate;
+
+end CDB0A02_3;
+
+------------------------------------------------------------------ CDB0A02
+
+with Report;
+with TCTouch;
+with System.Storage_Elements;
+with CDB0A02_2;
+with CDB0A02_3;
+with FDB0A00;
+
+procedure CDB0A02 is
+
+  Banyan : CDB0A02_2.Small_Tree;
+  Torrey : CDB0A02_3.Large_Tree;
+
+  use type CDB0A02_2.Small_Tree;
+  use type CDB0A02_3.Large_Tree;
+
+  Countess1    : constant String := "Ada ";
+  Countess2    : constant String := "Augusta ";
+  Countess3    : constant String := "Lovelace";
+  Cenosstu     : constant String := "  AALaaacdeeglostuuv";
+  Insertion    : constant String := "AAAAAAAAAAAAAAAAAAAA"
+                                  & "AAAAAAAAAAAAAAAAAAAA";
+  Deallocation : constant String := "DDDDDDDDDDDDDDDDDDDD";
+
+begin  -- Main test procedure.
+
+   Report.Test ("CDB0A02", "Check that several access types can share " &
+                           "the same pool.  Check that any exception " &
+                           "propagated by Allocate is propagated by the " &
+                           "allocator.  Check that for an access type S, " &
+                           "S'Max_Size_In_Storage_Elements denotes the " &
+                           "maximum values for Size_In_Storage_Elements " &
+                           "that will be requested via Allocate" );
+
+  -- Check that access types can share the same pool.
+
+  for Count in Countess1'Range loop
+    CDB0A02_2.Insert( Countess1(Count), Banyan );
+  end loop;
+
+  for Count in Countess1'Range loop
+    CDB0A02_3.Insert( Countess1(Count), Torrey );
+  end loop;
+
+  for Count in Countess2'Range loop
+    CDB0A02_2.Insert( Countess2(Count), Banyan );
+  end loop;
+
+  for Count in Countess2'Range loop
+    CDB0A02_3.Insert( Countess2(Count), Torrey );
+  end loop;
+
+  for Count in Countess3'Range loop
+    CDB0A02_2.Insert( Countess3(Count), Banyan );
+  end loop;
+
+  for Count in Countess3'Range loop
+    CDB0A02_3.Insert( Countess3(Count), Torrey );
+  end loop;
+
+  TCTouch.Validate(Insertion, "Allocate calls via CDB0A02_2" );
+
+
+  CDB0A02_2.Traverse(Banyan);
+  TCTouch.Validate(Cenosstu, "Traversal of Banyan" );
+
+  CDB0A02_3.Traverse(Torrey);
+  TCTouch.Validate(Cenosstu, "Traversal of Torrey" );
+
+  CDB0A02_2.Defoliate(Banyan);
+  TCTouch.Validate(Deallocation, "Deforestation of Banyan" );
+  TCTouch.Assert(Banyan = null, "Banyan Deallocation result not null");
+
+  CDB0A02_3.Defoliate(Torrey);
+  TCTouch.Validate(Deallocation, "Deforestation of Torrey" );
+  TCTouch.Assert(Torrey = null, "Torrey Deallocation result not null");
+
+  -- Check that for an access type S, S'Max_Size_In_Storage_Elements
+  -- denotes the maximum values for Size_In_Storage_Elements that will
+  -- be requested via Allocate. (Of course, all we can do is check that
+  -- whatever was requested of Allocate did not exceed the values of the
+  -- attributes.)
+
+  TCTouch.Assert( FDB0A00.TC_Largest_Request in 1 ..
+                  System.Storage_Elements.Storage_Count'Max (
+                    CDB0A02_2.Small_Cell'Max_Size_In_Storage_Elements,
+                    CDB0A02_3.Large_Cell'Max_Size_In_Storage_Elements),
+                  "An object of excessive size was allocated.  Size: "
+   & System.Storage_Elements.Storage_Count'Image(FDB0A00.TC_Largest_Request));
+
+  -- Check that an exception raised in Allocate is propagated by the allocator.
+
+  CDB0A02_2.TC_Exceed_Pool;
+
+  Report.Result;
+
+end CDB0A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd1001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd1001.a
new file mode 100644
index 000000000..0641798b1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd1001.a
@@ -0,0 +1,94 @@
+-- CDD1001.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that components of Stream_Element_Array are aliased.  (Defect
+--    Report 8652/0044).
+--
+-- APPLICABILITY CRITERIA:
+--    All implementations must attempt to compile this test.
+--
+--    For implementations for which Stream_Element'Size is a multiple of
+--    System.Storage_Unit, this test must execute.
+--
+--    For other implementations, if this test compiles without error messages
+--    at compilation, it must bind and execute.
+--
+-- PASS/FAIL CRITERIA:
+--    For implementations for which Stream_Element'Size is a multiple of
+--      System.Storage_Unit, this test must execute, report PASSED, and
+--      complete normally, otherwise the test FAILS.
+--
+--    For other implementations:
+--      PASSING behavior is:
+--        this test executes, reports PASSED, and completes normally
+--      or
+--        this test produces at least one error message at compilation, and
+--        the error message is associated with one of the items marked:
+--           -- N/A => ERROR.
+--
+--      All other behaviors are FAILING.
+--
+--
+-- CHANGE HISTORY:
+--    12 FEB 2001   PHL   Initial version
+--    15 MAR 2001   RLB   Readied for release.
+
+--!
+with Ada.Streams;
+use Ada.Streams;
+with Report;
+use Report;
+procedure CDD1001 is
+
+    type Acc is access all Stream_Element;
+
+    A : Stream_Element_Array
+	   (Stream_Element_Offset (Ident_Int (1)) ..
+	       Stream_Element_Offset (Ident_Int (10)));
+    B : array (A'Range) of Acc;
+begin
+    Test ("CDD1001",
+	  "Check that components of Stream_Element_Array are aliased");
+
+    for I in A'Range loop
+	A (I) := Stream_Element (Ident_Int (Integer (I)) * Ident_Int (3));
+    end loop;
+
+    for I in B'Range loop
+	B (I) := A (I)'Access;                                -- N/A => ERROR.
+    end loop;
+
+    for I in B'Range loop
+	if B (I).all /= Stream_Element
+			   (Ident_Int (Integer (I)) * Ident_Int (3)) then
+	    Failed ("Unable to build access values designating elements " &
+		    "of a Stream_Element_Array");
+	end if;
+    end loop;
+
+    Result;
+end CDD1001;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2001.a
new file mode 100644
index 000000000..3184dded8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2001.a
@@ -0,0 +1,203 @@
+-- CDD2001.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that the default implementation of Read and Input raise End_Error
+--    if the end of stream is reached before the reading of a value is
+--    completed.  (Defect Report 8652/0045,
+--    Technical Corrigendum 13.13.2(35.1/1)).
+--
+-- CHANGE HISTORY:
+--    12 FEB 2001   PHL   Initial version.
+--    29 JUN 2001   RLB   Reformatted for ACATS.
+--
+--!
+
+with Ada.Streams;
+use Ada.Streams;
+package CDD2001_0 is
+
+    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);
+
+end CDD2001_0;
+
+package body CDD2001_0 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;
+
+end CDD2001_0;
+
+with Ada.Exceptions;
+use Ada.Exceptions;
+with CDD2001_0;
+use CDD2001_0;
+with Io_Exceptions;
+use Io_Exceptions;
+with Report;
+use Report;
+procedure CDD2001 is
+
+    subtype Int is Integer range -20 .. 20;
+
+    type R (D : Int) is
+	record
+	    C1 : Character := Ident_Char ('a');
+	    case D is
+		when 0 .. 20 =>
+		    C2 : String (1 .. D) := (others => Ident_Char ('b'));
+		when others =>
+		    C3, C4 : Float := Float (-D);
+	    end case;
+	end record;
+
+    S : aliased My_Stream (200);
+
+begin
+    Test
+       ("CDD2001",
+	   "Check that the default implementation of Read and Input " &
+	   "raise End_Error if the end of stream is reached before the " &
+           "reading of a value is completed");
+
+    Read:
+	declare
+	    X : R (Ident_Int (13));
+	begin
+	    Clear (S);
+
+	    -- A complete object.
+	    R'Write (S'Access, X);
+	    X.C1 := Ident_Char ('A');
+	    X.C2 := (others => Ident_Char ('B'));
+	    R'Read (S'Access, X);
+	    if X.C1 /= Ident_Char ('a') or X.C2 /=
+					      (1 .. 13 => Ident_Char ('b')) then
+		Failed ("Read did not produce the expected result");
+	    end if;
+
+	    Clear (S);
+
+	    -- Not enough data.
+	    Character'Write (S'Access, 'a');
+	    String'Write (S'Access, "bbb");
+
+	    begin
+		R'Read (S'Access, X);
+		Failed
+		   ("No exception raised when the end of stream is reached " &
+		    "before the reading of a value is completed - 1");
+	    exception
+		when End_Error =>
+		    null;
+		when E: others =>
+		    Failed ("Wrong Exception " & Exception_Name (E) &
+			    " - " & Exception_Information (E) &
+			    " - " & Exception_Message (E) & " - 1");
+	    end;
+
+	end Read;
+
+    Input:
+	declare
+	    X : R (Ident_Int (-11));
+	begin
+	    Clear (S);
+
+	    -- A complete object.
+	    R'Output (S'Access, X);
+	    X.C1 := Ident_Char ('A');
+	    X.C3 := 4.0;
+	    X.C4 := 5.0;
+	    X := R'Input (S'Access);
+	    if X.C1 /= Ident_Char ('a') or X.C3 /= 11.0 or X.C4 /= 11.0 then
+		Failed ("Input did not produce the expected result");
+	    end if;
+
+	    Clear (S);
+
+	    -- Not enough data.
+	    Integer'Output (S'Access, Ident_Int (-11)); -- The discriminant
+	    Character'Output (S'Access, 'a');
+	    Float'Output (S'Access, 11.0);
+
+	    begin
+		X := R'Input (S'Access);
+		Failed
+		   ("No exception raised when the end of stream is reached " &
+		    "before the reading of a value is completed - 2");
+	    exception
+		when End_Error =>
+		    null;
+		when E: others =>
+		    Failed ("Wrong exception " & Exception_Name (E) &
+			    " - " & Exception_Message (E) & " - 2");
+	    end;
+
+	end Input;
+
+    Result;
+end CDD2001;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2a01.a
new file mode 100644
index 000000000..7c8000ce0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2a01.a
@@ -0,0 +1,379 @@
+-- CDD2A01.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that the Read and Write attributes for a type extension are created
+--    from the parent type's attribute (which may be user-defined) and those
+--    for the extension components.  Also check that the default Input and
+--    Output attributes are used for a type extension, even if the parent
+--    type's attribute is user-defined.  (Defect Report 8652/0040,
+--     as reflected in Technical Corrigendum 1, penultimate sentence of
+--     13.13.2(9/1) and 13.13.2(25/1)).
+--
+-- CHANGE HISTORY:
+--    30 JUL 2001   PHL   Initial version.
+--     5 DEC 2001   RLB   Reformatted for ACATS.
+--
+--!
+with Ada.Streams;
+use Ada.Streams;
+with FDD2A00;
+use FDD2A00;
+with Report;
+use Report;
+procedure CDD2A01 is
+
+    Input_Output_Error : exception;
+
+    type Int is range 1 .. 1000;
+    type Str is array (Int range <>) of Character;
+
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Int'Base);
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Int'Base;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base);
+
+    for Int'Read use Read;
+    for Int'Write use Write;
+    for Int'Input use Input;
+    for Int'Output use Output;
+
+
+    type Parent (D1, D2 : Int; B : Boolean) is tagged
+        record
+            S : Str (D1 .. D2);
+            case B is
+                when False =>
+                    C1 : Integer;
+                when True =>
+                    C2 : Float;
+            end case;
+        end record;
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent);
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent);
+    function Input (Stream : access Root_Stream_Type'Class) return Parent;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent);
+
+    for Parent'Read use Read;
+    for Parent'Write use Write;
+    for Parent'Input use Input;
+    for Parent'Output use Output;
+
+
+    procedure Actual_Read
+                 (Stream : access Root_Stream_Type'Class; Item : out Int) is
+    begin
+        Integer'Read (Stream, Integer (Item));
+    end Actual_Read;
+
+    procedure Actual_Write
+                 (Stream : access Root_Stream_Type'Class; Item : Int) is
+    begin
+        Integer'Write (Stream, Integer (Item));
+    end Actual_Write;
+
+    function Actual_Input (Stream : access Root_Stream_Type'Class) return Int is
+    begin
+        return Int (Integer'Input (Stream));
+    end Actual_Input;
+
+    procedure Actual_Output
+                 (Stream : access Root_Stream_Type'Class; Item : Int) is
+    begin
+        Integer'Output (Stream, Integer (Item));
+    end Actual_Output;
+
+
+    procedure Actual_Read
+                 (Stream : access Root_Stream_Type'Class; Item : out Parent) is
+    begin
+        case Item.B is
+            when False =>
+                Item.C1 := 7;
+            when True =>
+                Float'Read (Stream, Item.C2);
+        end case;
+        Str'Read (Stream, Item.S);
+    end Actual_Read;
+
+    procedure Actual_Write
+                 (Stream : access Root_Stream_Type'Class; Item : Parent) is
+    begin
+        case Item.B is
+            when False =>
+                null; -- Don't write C1
+            when True =>
+                Float'Write (Stream, Item.C2);
+        end case;
+        Str'Write (Stream, Item.S);
+    end Actual_Write;
+
+    function Actual_Input
+                (Stream : access Root_Stream_Type'Class) return Parent is
+        X : Parent (1, 1, True);
+    begin
+        raise Input_Output_Error;
+        return X;
+    end Actual_Input;
+
+    procedure Actual_Output
+                 (Stream : access Root_Stream_Type'Class; Item : Parent) is
+    begin
+        raise Input_Output_Error;
+    end Actual_Output;
+
+    package Int_Ops is new Counting_Stream_Ops (T => Int'Base,
+                                                Actual_Write => Actual_Write,
+                                                Actual_Input => Actual_Input,
+                                                Actual_Read => Actual_Read,
+                                                Actual_Output => Actual_Output);
+
+    package Parent_Ops is
+       new Counting_Stream_Ops (T => Parent,
+                                Actual_Write => Actual_Write,
+                                Actual_Input => Actual_Input,
+                                Actual_Read => Actual_Read,
+                                Actual_Output => Actual_Output);
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Int'Base)
+       renames Int_Ops.Read;
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base)
+       renames Int_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Int'Base
+       renames Int_Ops.Input;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base)
+       renames Int_Ops.Output;
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent)
+       renames Parent_Ops.Read;
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent)
+       renames Parent_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Parent
+       renames Parent_Ops.Input;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent)
+       renames Parent_Ops.Output;
+
+    type Derived1 is new Parent with
+        record
+            C3 : Int;
+        end record;
+
+    type Derived2 (D : Int) is new Parent (D1 => D,
+                                           D2 => D,
+                                           B => False) with
+        record
+            C3 : Int;
+        end record;
+
+begin
+    Test ("CDD2A01",
+          "Check that the Read and Write attributes for a type " &
+             "extension are created from the parent type's " &
+             "attribute (which may be user-defined) and those for the " &
+             "extension components; also check that the default input " &
+             "and output attributes are used for a type extension, even " &
+             "if the parent type's attribute is user-defined");
+
+    Test1:
+        declare
+            S : aliased My_Stream (1000);
+            X1 : Derived1 (D1 => Int (Ident_Int (2)),
+                           D2 => Int (Ident_Int (5)),
+                           B => Ident_Bool (True));
+            Y1 : Derived1 := (D1 => 3,
+                              D2 => 6,
+                              B => False,
+                              S => Str (Ident_Str ("3456")),
+                              C1 => Ident_Int (100),
+                              C3 => Int (Ident_Int (88)));
+            X2 : Derived1 (D1 => Int (Ident_Int (2)),
+                           D2 => Int (Ident_Int (5)),
+                           B => Ident_Bool (True));
+        begin
+            X1.S := Str (Ident_Str ("bcde"));
+            X1.C2 := Float (Ident_Int (4));
+            X1.C3 := Int (Ident_Int (99));
+
+            Derived1'Write (S'Access, X1);
+            if Int_Ops.Get_Counts /=
+               (Read => 0, Write => 1, Input => 0, Output => 0) then
+                Failed ("Error writing extension components - 1");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 0, Write => 1, Input => 0, Output => 0) then
+                Failed ("Didn't call parent type's Write - 1");
+            end if;
+
+            Derived1'Read (S'Access, X2);
+            if Int_Ops.Get_Counts /=
+               (Read => 1, Write => 1, Input => 0, Output => 0) then
+                Failed ("Error reading extension components - 1");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 1, Write => 1, Input => 0, Output => 0) then
+                Failed ("Didn't call inherited Read - 1");
+            end if;
+
+            if X2 /= (D1 => 2,
+                      D2 => 5,
+                      B => True,
+                      S => Str (Ident_Str ("bcde")),
+                      C2 => Float (Ident_Int (4)),
+                      C3 => Int (Ident_Int (99))) then
+                Failed
+                   ("Inherited Read and Write are not inverses of each other - 1");
+            end if;
+
+            begin
+                Derived1'Output (S'Access, Y1);
+                if Int_Ops.Get_Counts /=
+                   (Read => 1, Write => 4, Input => 0, Output => 0) then
+                    Failed ("Error writing extension components - 2");
+                end if;
+                if Parent_Ops.Get_Counts /=
+                   (Read => 1, Write => 2, Input => 0, Output => 0) then
+                    Failed ("Didn't call inherited Write - 2");
+                end if;
+            exception
+                when Input_Output_Error =>
+                    Failed ("Did call inherited Output - 2");
+            end;
+
+            begin
+                declare
+                    Y2 : Derived1 := Derived1'Input (S'Access);
+                begin
+                    if Int_Ops.Get_Counts /=
+                       (Read => 4, Write => 4, Input => 0, Output => 0) then
+                        Failed ("Error reading extension components - 2");
+                    end if;
+                    if Parent_Ops.Get_Counts /=
+                       (Read => 2, Write => 2, Input => 0, Output => 0) then
+                        Failed ("Didn't call inherited Read - 2");
+                    end if;
+                    if Y2 /= (D1 => 3,
+                              D2 => 6,
+                              B => False,
+                              S => Str (Ident_Str ("3456")),
+                              C1 => Ident_Int (7),
+                              C3 => Int (Ident_Int (88))) then
+                        Failed
+                           ("Input and Output are not inverses of each other - 2");
+                    end if;
+                end;
+            exception
+                when Input_Output_Error =>
+                    Failed ("Did call inherited Input - 2");
+            end;
+
+        end Test1;
+
+    Test2:
+        declare
+            S : aliased My_Stream (1000);
+            X1 : Derived2 (D => Int (Ident_Int (7)));
+            Y1 : Derived2 := (D => 8,
+                              S => Str (Ident_Str ("8")),
+                              C1 => Ident_Int (200),
+                              C3 => Int (Ident_Int (77)));
+            X2 : Derived2 (D => Int (Ident_Int (7)));
+        begin
+            X1.S := Str (Ident_Str ("g"));
+            X1.C1 := Ident_Int (4);
+            X1.C3 := Int (Ident_Int (666));
+
+            Derived2'Write (S'Access, X1);
+            if Int_Ops.Get_Counts /=
+               (Read => 4, Write => 5, Input => 0, Output => 0) then
+                Failed ("Error writing extension components - 3");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 2, Write => 3, Input => 0, Output => 0) then
+                Failed ("Didn't call inherited Write - 3");
+            end if;
+
+            Derived2'Read (S'Access, X2);
+            if Int_Ops.Get_Counts /=
+               (Read => 5, Write => 5, Input => 0, Output => 0) then
+                Failed ("Error reading extension components - 3");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 3, Write => 3, Input => 0, Output => 0) then
+                Failed ("Didn't call inherited Read - 3");
+            end if;
+
+            if X2 /= (D => 7,
+                      S => Str (Ident_Str ("g")),
+                      C1 => Ident_Int (7),
+                      C3 => Int (Ident_Int (666))) then
+                Failed ("Read and Write are not inverses of each other - 3");
+            end if;
+
+            begin
+                Derived2'Output (S'Access, Y1);
+                if Int_Ops.Get_Counts /=
+                   (Read => 5, Write => 7, Input => 0, Output => 0) then
+                    Failed ("Error writing extension components - 4");
+                end if;
+                if Parent_Ops.Get_Counts /=
+                   (Read => 3, Write => 4, Input => 0, Output => 0) then
+                    Failed ("Didn't call inherited Write - 4");
+                end if;
+            exception
+                when Input_Output_Error =>
+                    Failed ("Did call inherited Output - 4");
+            end;
+
+            begin
+                declare
+                    Y2 : Derived2 := Derived2'Input (S'Access);
+                begin
+                    if Int_Ops.Get_Counts /=
+                       (Read => 7, Write => 7, Input => 0, Output => 0) then
+                        Failed ("Error reading extension components - 4");
+                    end if;
+                    if Parent_Ops.Get_Counts /=
+                       (Read => 4, Write => 4, Input => 0, Output => 0) then
+                        Failed ("Didn't call inherited Read - 4");
+                    end if;
+                    if Y2 /= (D => 8,
+                              S => Str (Ident_Str ("8")),
+                              C1 => Ident_Int (7),
+                              C3 => Int (Ident_Int (77))) then
+                        Failed
+                           ("Input and Output are not inverses of each other - 4");
+                    end if;
+                end;
+            exception
+                when Input_Output_Error =>
+                    Failed ("Did call inherited Input - 4");
+            end;
+
+        end Test2;
+
+    Result;
+end CDD2A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2a02.a
new file mode 100644
index 000000000..854431c34
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2a02.a
@@ -0,0 +1,345 @@
+-- CDD2A02.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that the Read, Write, Input, and Output attributes are inherited
+--    for untagged derived types.  (Defect Report 8652/0040,
+--     as reflected in Technical Corrigendum 1, 13.13.2(8.1/1) and
+--     13.13.2(25/1)).
+--
+-- CHANGE HISTORY:
+--    30 JUL 2001   PHL   Initial version.
+--     5 DEC 2001   RLB   Reformatted for ACATS.
+--
+--!
+with Ada.Streams;
+use Ada.Streams;
+with FDD2A00;
+use FDD2A00;
+with Report;
+use Report;
+procedure CDD2A02 is
+
+    type Int is range 1 .. 10;
+    type Str is array (Int range <>) of Character;
+
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Int'Base);
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Int'Base;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base);
+
+    for Int'Read use Read;
+    for Int'Write use Write;
+    for Int'Input use Input;
+    for Int'Output use Output;
+
+
+    type Parent (D1, D2 : Int; B : Boolean) is
+        record
+            S : Str (D1 .. D2);
+            case B is
+                when False =>
+                    C1 : Integer;
+                when True =>
+                    C2 : Float;
+            end case;
+        end record;
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent);
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent);
+    function Input (Stream : access Root_Stream_Type'Class) return Parent;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent);
+
+    for Parent'Read use Read;
+    for Parent'Write use Write;
+    for Parent'Input use Input;
+    for Parent'Output use Output;
+
+
+    procedure Actual_Read
+                 (Stream : access Root_Stream_Type'Class; Item : out Int) is
+    begin
+        Integer'Read (Stream, Integer (Item));
+    end Actual_Read;
+
+    procedure Actual_Write
+                 (Stream : access Root_Stream_Type'Class; Item : Int) is
+    begin
+        Integer'Write (Stream, Integer (Item));
+    end Actual_Write;
+
+    function Actual_Input (Stream : access Root_Stream_Type'Class) return Int is
+    begin
+        return Int (Integer'Input (Stream));
+    end Actual_Input;
+
+    procedure Actual_Output
+                 (Stream : access Root_Stream_Type'Class; Item : Int) is
+    begin
+        Integer'Output (Stream, Integer (Item));
+    end Actual_Output;
+
+
+    procedure Actual_Read
+                 (Stream : access Root_Stream_Type'Class; Item : out Parent) is
+    begin
+        case Item.B is
+            when False =>
+                Item.C1 := 7;
+            when True =>
+                Float'Read (Stream, Item.C2);
+        end case;
+        Str'Read (Stream, Item.S);
+    end Actual_Read;
+
+    procedure Actual_Write
+                 (Stream : access Root_Stream_Type'Class; Item : Parent) is
+    begin
+        case Item.B is
+            when False =>
+                null; -- Don't write C1
+            when True =>
+                Float'Write (Stream, Item.C2);
+        end case;
+        Str'Write (Stream, Item.S);
+    end Actual_Write;
+
+    function Actual_Input
+                (Stream : access Root_Stream_Type'Class) return Parent is
+        D1, D2 : Int;
+        B : Boolean;
+    begin
+        Int'Read (Stream, D2);
+        Boolean'Read (Stream, B);
+        Int'Read (Stream, D1);
+
+        declare
+            Item : Parent (D1 => D1, D2 => D2, B => B);
+        begin
+            Parent'Read (Stream, Item);
+            return Item;
+        end;
+
+    end Actual_Input;
+
+    procedure Actual_Output
+                 (Stream : access Root_Stream_Type'Class; Item : Parent) is
+    begin
+        Int'Write (Stream, Item.D2);
+        Boolean'Write (Stream, Item.B);
+        Int'Write (Stream, Item.D1);
+        Parent'Write (Stream, Item);
+    end Actual_Output;
+
+    package Int_Ops is new Counting_Stream_Ops (T => Int'Base,
+                                                Actual_Write => Actual_Write,
+                                                Actual_Input => Actual_Input,
+                                                Actual_Read => Actual_Read,
+                                                Actual_Output => Actual_Output);
+
+    package Parent_Ops is
+       new Counting_Stream_Ops (T => Parent,
+                                Actual_Write => Actual_Write,
+                                Actual_Input => Actual_Input,
+                                Actual_Read => Actual_Read,
+                                Actual_Output => Actual_Output);
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Int'Base)
+       renames Int_Ops.Read;
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base)
+       renames Int_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Int'Base
+       renames Int_Ops.Input;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base)
+       renames Int_Ops.Output;
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent)
+       renames Parent_Ops.Read;
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent)
+       renames Parent_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Parent
+       renames Parent_Ops.Input;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent)
+       renames Parent_Ops.Output;
+
+begin
+    Test ("CDD2A02", "Check that the Read, Write, Input, and Output " &
+                     "attributes are inherited for untagged derived types");
+
+    Test1:
+        declare
+            type Derived1 is new Parent;
+            S : aliased My_Stream (1000);
+            X1 : Derived1 (D1 => Int (Ident_Int (2)),
+                           D2 => Int (Ident_Int (5)), B => Ident_Bool (True));
+            Y1 : Derived1 := (D1 => 3,
+                              D2 => 6,
+                              B => False,
+                              S => Str (Ident_Str ("3456")),
+                              C1 => Ident_Int (100));
+            X2 : Derived1 (D1 => Int (Ident_Int (2)),
+                           D2 => Int (Ident_Int (5)), B => Ident_Bool (True));
+        begin
+            X1.S := Str (Ident_Str ("bcde"));
+            X1.C2 := Float (Ident_Int (4));
+
+            Derived1'Write (S'Access, X1);
+            if Int_Ops.Get_Counts /=
+               (Read => 0, Write => 0, Input => 0, Output => 0) then
+                Failed ("Error writing discriminants - 1");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 0, Write => 1, Input => 0, Output => 0) then
+                Failed ("Didn't call inherited Write - 1");
+            end if;
+
+            Derived1'Read (S'Access, X2);
+            if Int_Ops.Get_Counts /=
+               (Read => 0, Write => 0, Input => 0, Output => 0) then
+                Failed ("Error reading discriminants - 1");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 1, Write => 1, Input => 0, Output => 0) then
+                Failed ("Didn't call inherited Read - 1");
+            end if;
+
+            if X2 /= (D1 => 2,
+                      D2 => 5,
+                      B => True,
+                      S => Str (Ident_Str ("bcde")),
+                      C2 => Float (Ident_Int (4))) then
+                Failed
+                   ("Inherited Read and Write are not inverses of each other - 1");
+            end if;
+
+            Derived1'Output (S'Access, Y1);
+            if Int_Ops.Get_Counts /=
+               (Read => 0, Write => 2, Input => 0, Output => 0) then
+                Failed ("Error writing discriminants - 2");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 1, Write => 2, Input => 0, Output => 1) then
+                Failed ("Didn't call inherited Output - 2");
+            end if;
+
+            declare
+                Y2 : Derived1 := Derived1'Input (S'Access);
+            begin
+                if Int_Ops.Get_Counts /=
+                   (Read => 2, Write => 2, Input => 0, Output => 0) then
+                    Failed ("Error reading discriminants - 2");
+                end if;
+                if Parent_Ops.Get_Counts /=
+                   (Read => 2, Write => 2, Input => 1, Output => 1) then
+                    Failed ("Didn't call inherited Input - 2");
+                end if;
+
+                if Y2 /= (D1 => 3,
+                          D2 => 6,
+                          B => False,
+                          S => Str (Ident_Str ("3456")),
+                          C1 => Ident_Int (7)) then
+                    Failed
+                       ("Inherited Input and Output are not inverses of each other - 2");
+                end if;
+            end;
+        end Test1;
+
+    Test2:
+        declare
+            type Derived2 (D : Int) is new Parent (D1 => D,
+                                                   D2 => D,
+                                                   B => False);
+            S : aliased My_Stream (1000);
+            X1 : Derived2 (D => Int (Ident_Int (7)));
+            Y1 : Derived2 := (D => 8,
+                              S => Str (Ident_Str ("8")),
+                              C1 => Ident_Int (200));
+            X2 : Derived2 (D => Int (Ident_Int (7)));
+        begin
+            X1.S := Str (Ident_Str ("g"));
+            X1.C1 := Ident_Int (4);
+
+            Derived2'Write (S'Access, X1);
+            if Int_Ops.Get_Counts /=
+               (Read => 2, Write => 2, Input => 0, Output => 0) then
+                Failed ("Error writing discriminants - 3");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 2, Write => 3, Input => 1, Output => 1) then
+                Failed ("Didn't call inherited Write - 3");
+            end if;
+
+            Derived2'Read (S'Access, X2);
+            if Int_Ops.Get_Counts /=
+               (Read => 2, Write => 2, Input => 0, Output => 0) then
+                Failed ("Error reading discriminants - 3");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 3, Write => 3, Input => 1, Output => 1) then
+                Failed ("Didn't call inherited Read - 3");
+            end if;
+
+            if X2 /= (D => 7,
+                      S => Str (Ident_Str ("g")),
+                      C1 => Ident_Int (7)) then
+                Failed
+                   ("Inherited Read and Write are not inverses of each other - 3");
+            end if;
+
+            Derived2'Output (S'Access, Y1);
+            if Int_Ops.Get_Counts /=
+               (Read => 2, Write => 4, Input => 0, Output => 0) then
+                Failed ("Error writing discriminants - 4");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 3, Write => 4, Input => 1, Output => 2) then
+                Failed ("Didn't call inherited Output - 4");
+            end if;
+
+            declare
+                Y2 : Derived2 := Derived2'Input (S'Access);
+            begin
+                if Int_Ops.Get_Counts /=
+                   (Read => 4, Write => 4, Input => 0, Output => 0) then
+                    Failed ("Error reading discriminants - 4");
+                end if;
+                if Parent_Ops.Get_Counts /=
+                   (Read => 4, Write => 4, Input => 2, Output => 2) then
+                    Failed ("Didn't call inherited Input - 4");
+                end if;
+
+                if Y2 /= (D => 8,
+                          S => Str (Ident_Str ("8")),
+                          C1 => Ident_Int (7)) then
+                    Failed
+                       ("Inherited Input and Output are not inverses of each other - 4");
+                end if;
+            end;
+        end Test2;
+
+    Result;
+end CDD2A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2a03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2a03.a
new file mode 100644
index 000000000..b4c291772
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cdd2a03.a
@@ -0,0 +1,325 @@
+-- CDD2A03.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that the default Read and Write attributes for a limited type
+--    extension are created from the parent type's attribute (which may be
+--    user-defined) and those for the extension components, if the extension
+--    components are non-limited or have user-defined attributes.  Check that
+--    such limited type extension attributes are callable (Defect Report
+--    8652/0040, as reflected in Technical Corrigendum 1, penultimate sentence
+--     of 13.13.2(9/1) and 13.13.2(36/1)).
+--
+-- CHANGE HISTORY:
+--     1 AUG 2001   PHL   Initial version.
+--     3 DEC 2001   RLB   Reformatted for ACATS.
+--
+--!
+with Ada.Streams;
+use Ada.Streams;
+with FDD2A00;
+use FDD2A00;
+with Report;
+use Report;
+procedure CDD2A03 is
+
+    Input_Output_Error : exception;
+
+    type Int is range 1 .. 1000;
+    type Str is array (Int range <>) of Character;
+
+    procedure Read (Stream : access Root_Stream_Type'Class;
+                    Item : out Int'Base);
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base);
+    function Input (Stream : access Root_Stream_Type'Class) return Int'Base;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base);
+
+    for Int'Read use Read;
+    for Int'Write use Write;
+    for Int'Input use Input;
+    for Int'Output use Output;
+
+
+    type Lim is limited
+        record
+            C : Int;
+        end record;
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Lim);
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Lim);
+    function Input (Stream : access Root_Stream_Type'Class) return Lim;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Lim);
+
+    for Lim'Read use Read;
+    for Lim'Write use Write;
+    for Lim'Input use Input;
+    for Lim'Output use Output;
+
+
+    type Parent (D1, D2 : Int; B : Boolean) is tagged limited
+        record
+            S : Str (D1 .. D2);
+            case B is
+                when False =>
+                    C1 : Integer;
+                when True =>
+                    C2 : Float;
+            end case;
+        end record;
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent);
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent);
+    function Input (Stream : access Root_Stream_Type'Class) return Parent;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent);
+
+    for Parent'Read use Read;
+    for Parent'Write use Write;
+    for Parent'Input use Input;
+    for Parent'Output use Output;
+
+
+    procedure Actual_Read
+                 (Stream : access Root_Stream_Type'Class; Item : out Int) is
+    begin
+        Integer'Read (Stream, Integer (Item));
+    end Actual_Read;
+
+    procedure Actual_Write
+                 (Stream : access Root_Stream_Type'Class; Item : Int) is
+    begin
+        Integer'Write (Stream, Integer (Item));
+    end Actual_Write;
+
+    function Actual_Input (Stream : access Root_Stream_Type'Class) return Int is
+    begin
+        return Int (Integer'Input (Stream));
+    end Actual_Input;
+
+    procedure Actual_Output
+                 (Stream : access Root_Stream_Type'Class; Item : Int) is
+    begin
+        Integer'Output (Stream, Integer (Item));
+    end Actual_Output;
+
+
+    procedure Actual_Read
+                 (Stream : access Root_Stream_Type'Class; Item : out Lim) is
+    begin
+        Integer'Read (Stream, Integer (Item.C));
+    end Actual_Read;
+
+    procedure Actual_Write
+                 (Stream : access Root_Stream_Type'Class; Item : Lim) is
+    begin
+        Integer'Write (Stream, Integer (Item.C));
+    end Actual_Write;
+
+    function Actual_Input (Stream : access Root_Stream_Type'Class) return Lim is
+        Result : Lim;
+    begin
+        Result.C := Int (Integer'Input (Stream));
+        return Result;
+    end Actual_Input;
+
+    procedure Actual_Output
+                 (Stream : access Root_Stream_Type'Class; Item : Lim) is
+    begin
+        Integer'Output (Stream, Integer (Item.C));
+    end Actual_Output;
+
+
+    procedure Actual_Read
+                 (Stream : access Root_Stream_Type'Class; Item : out Parent) is
+    begin
+        case Item.B is
+            when False =>
+                Item.C1 := 7;
+            when True =>
+                Float'Read (Stream, Item.C2);
+        end case;
+        Str'Read (Stream, Item.S);
+    end Actual_Read;
+
+    procedure Actual_Write
+                 (Stream : access Root_Stream_Type'Class; Item : Parent) is
+    begin
+        case Item.B is
+            when False =>
+                null; -- Don't write C1
+            when True =>
+                Float'Write (Stream, Item.C2);
+        end case;
+        Str'Write (Stream, Item.S);
+    end Actual_Write;
+
+    function Actual_Input
+                (Stream : access Root_Stream_Type'Class) return Parent is
+        X : Parent (1, 1, True);
+    begin
+        raise Input_Output_Error;
+        return X;
+    end Actual_Input;
+
+    procedure Actual_Output
+                 (Stream : access Root_Stream_Type'Class; Item : Parent) is
+    begin
+        raise Input_Output_Error;
+    end Actual_Output;
+
+    package Int_Ops is new Counting_Stream_Ops (T => Int'Base,
+                                                Actual_Write => Actual_Write,
+                                                Actual_Input => Actual_Input,
+                                                Actual_Read => Actual_Read,
+                                                Actual_Output => Actual_Output);
+
+    package Lim_Ops is new Counting_Stream_Ops (T => Lim,
+                                                Actual_Write => Actual_Write,
+                                                Actual_Input => Actual_Input,
+                                                Actual_Read => Actual_Read,
+                                                Actual_Output => Actual_Output);
+
+    package Parent_Ops is
+       new Counting_Stream_Ops (T => Parent,
+                                Actual_Write => Actual_Write,
+                                Actual_Input => Actual_Input,
+                                Actual_Read => Actual_Read,
+                                Actual_Output => Actual_Output);
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Int'Base)
+       renames Int_Ops.Read;
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base)
+       renames Int_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Int'Base
+       renames Int_Ops.Input;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base)
+       renames Int_Ops.Output;
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Lim)
+       renames Lim_Ops.Read;
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Lim)
+       renames Lim_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Lim
+       renames Lim_Ops.Input;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Lim)
+       renames Lim_Ops.Output;
+
+    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent)
+       renames Parent_Ops.Read;
+    procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent)
+       renames Parent_Ops.Write;
+    function Input (Stream : access Root_Stream_Type'Class) return Parent
+       renames Parent_Ops.Input;
+    procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent)
+       renames Parent_Ops.Output;
+
+    type Derived1 is new Parent with
+        record
+            C3 : Int;
+        end record;
+
+    type Derived2 (D : Int) is new Parent (D1 => D,
+                                           D2 => D,
+                                           B => False) with
+        record
+            C3 : Lim;
+        end record;
+
+begin
+    Test ("CDD2A03",
+          "Check that the default Read and Write attributes for a limited " &
+             "type extension are created from the parent type's " &
+             "attribute (which may be user-defined) and those for the " &
+             "extension components, if the extension components are " &
+             "non-limited or have user-defined attributes; check that such " &
+             "limited type extension attributes are callable");
+
+    Test1:
+        declare
+            S : aliased My_Stream (1000);
+            X1 : Derived1 (D1 => Int (Ident_Int (2)),
+                           D2 => Int (Ident_Int (5)),
+                           B => Ident_Bool (True));
+            X2 : Derived1 (D1 => Int (Ident_Int (2)),
+                           D2 => Int (Ident_Int (5)),
+                           B => Ident_Bool (True));
+        begin
+            X1.S := Str (Ident_Str ("bcde"));
+            X1.C2 := Float (Ident_Int (4));
+            X1.C3 := Int (Ident_Int (99));
+
+            Derived1'Write (S'Access, X1);
+            if Int_Ops.Get_Counts /=
+               (Read => 0, Write => 1, Input => 0, Output => 0) then
+                Failed ("Error writing extension components - 1");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 0, Write => 1, Input => 0, Output => 0) then
+                Failed ("Didn't call parent type's Write - 1");
+            end if;
+
+            Derived1'Read (S'Access, X2);
+            if Int_Ops.Get_Counts /=
+               (Read => 1, Write => 1, Input => 0, Output => 0) then
+                Failed ("Error reading extension components - 1");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 1, Write => 1, Input => 0, Output => 0) then
+                Failed ("Didn't call inherited Read - 1");
+            end if;
+        end Test1;
+
+    Test2:
+        declare
+            S : aliased My_Stream (1000);
+            X1 : Derived2 (D => Int (Ident_Int (7)));
+            X2 : Derived2 (D => Int (Ident_Int (7)));
+        begin
+            X1.S := Str (Ident_Str ("g"));
+            X1.C1 := Ident_Int (4);
+            X1.C3.C := Int (Ident_Int (666));
+
+            Derived2'Write (S'Access, X1);
+            if Lim_Ops.Get_Counts /=
+               (Read => 0, Write => 1, Input => 0, Output => 0) then
+                Failed ("Error writing extension components - 2");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 1, Write => 2, Input => 0, Output => 0) then
+                Failed ("Didn't call inherited Write - 2");
+            end if;
+
+            Derived2'Read (S'Access, X2);
+            if Lim_Ops.Get_Counts /=
+               (Read => 1, Write => 1, Input => 0, Output => 0) then
+                Failed ("Error reading extension components - 2");
+            end if;
+            if Parent_Ops.Get_Counts /=
+               (Read => 2, Write => 2, Input => 0, Output => 0) then
+                Failed ("Didn't call inherited Read - 2");
+            end if;
+        end Test2;
+
+    Result;
+end CDD2A03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cde0001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cde0001.a
new file mode 100644
index 000000000..59db2256f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cd/cde0001.a
@@ -0,0 +1,324 @@
+-- CDE0001.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 following names can be used in the declaration of a
+--      generic formal parameter (object, array type, or access type) without 
+--      causing freezing of the named type:
+--        (1) The name of a private type,
+--        (2) A name that denotes a subtype of a private type, and
+--        (3) A name that denotes a composite type with a subcomponent of a
+--           private type (or subtype).
+--      Check for untagged and tagged types.
+--
+-- TEST DESCRIPTION:
+--      This transition test defines private and limited private types,
+--      subtypes of these private types, records and arrays of both types and
+--      subtypes, a tagged type and a private extension.
+--      This test creates examples where the above types are used in the 
+--      definition of several generic formal type parameters (object, array 
+--      type, or access type) in both visible and private parts.  These 
+--      visible and private generic packages are instantiated in the body of 
+--      the public child and the private child, respectively.  
+--      The main program utilizes the functions declared in the public child
+--      to verify results of the instantiations.
+--
+--      Inspired by B74103F.ADA.
+--
+--
+-- CHANGE HISTORY:
+--      12 Mar 96   SAIC    Initial version for ACVC 2.1.
+--      05 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate for CDE0001.
+--      21 Nov 98   RLB     Added pragma Elaborate for CDE0001 to CDE0001_3.
+--!
+
+package CDE0001_0 is
+
+   subtype Small_Int is Integer range 1 .. 2;
+
+   type Private_Type    is private;
+   type Limited_Private is limited private;
+
+   subtype Private_Subtype         is Private_Type;
+   subtype Limited_Private_Subtype is Limited_Private;
+
+   type Array_Of_LP_Subtype is array (1..2) of Limited_Private_Subtype;
+
+   type Rec_Of_Limited_Private is
+     record
+        C1 : Limited_Private;
+     end record;
+
+   type Rec_Of_Private_SubType is 
+     record
+        C1 : Private_SubType;
+     end record;
+
+   type Tag_Type is tagged
+     record
+        C1 : Small_Int;
+     end record;
+
+   type New_TagType is new Tag_Type with private;
+
+   generic               
+
+      Formal_Obj01 : in out Private_Type;              -- Formal objects defined
+      Formal_Obj02 : in out Limited_Private;           -- by names of private 
+      Formal_Obj03 : in out Private_Subtype;           -- types, names that
+      Formal_Obj04 : in out Limited_Private_Subtype;   -- denotes subtypes of 
+      Formal_Obj05 : in out New_TagType;               -- the private types.
+
+   package CDE0001_1 is
+      procedure Assign_Objects;
+
+   end CDE0001_1;
+   
+private
+
+   generic               
+      -- Formal array types of a private type, a composite type with a 
+      -- subcomponent of a private type.
+
+      type Formal_Arr01 is array (Small_Int) of Private_Type;
+      type Formal_Arr02 is array (Small_Int) of Rec_Of_Limited_Private;
+
+      -- Formal access types of composite types with a subcomponent of 
+      -- a private subtype.
+
+      type Formal_Acc01 is access Rec_Of_Private_Subtype;
+      type Formal_Acc02 is access Array_Of_LP_Subtype;
+
+   package CDE0001_2 is
+
+      procedure Assign_Arrays (P1 : out Formal_Arr01;
+                               P2 : out Formal_Arr02);
+
+      procedure Assign_Access (P1 : out Formal_Acc01;
+                               P2 : out Formal_Acc02);
+
+   end CDE0001_2;
+
+   ----------------------------------------------------------
+   type Private_Type    is range 1 .. 10;
+   type Limited_Private is (Eh, Bee, Sea, Dee);
+   type New_TagType     is new Tag_Type with 
+     record
+        C2 : Private_Type;
+     end record;
+
+end CDE0001_0;
+
+     --==================================================================--
+
+package body CDE0001_0 is
+
+   package body CDE0001_1 is
+
+      procedure Assign_Objects is
+      begin
+         Formal_Obj01 := Private_Type'First;
+         Formal_Obj02 := Limited_Private'Last;
+         Formal_Obj03 := Private_Subtype'Last;
+         Formal_Obj04 := Limited_Private_Subtype'First;
+         Formal_Obj05 := New_TagType'(C1 => 2, C2 => Private_Type'Last);
+
+      end Assign_Objects;
+
+   end CDE0001_1;
+
+   --===========================================================--
+
+   package body CDE0001_2 is
+
+      procedure Assign_Arrays (P1 : out Formal_Arr01;
+                               P2 : out Formal_Arr02) is
+      begin
+         P1(1)    := Private_Type'Pred(Private_Type'Last);
+         P1(2)    := Private_Type'Succ(Private_Type'First);
+         P2(1).C1 := Limited_Private'Succ(Limited_Private'First);
+         P2(2).C1 := Limited_Private'Pred(Limited_Private'Last);
+
+      end Assign_Arrays;
+
+      -----------------------------------------------------------------
+      procedure Assign_Access (P1 : out Formal_Acc01;
+                               P2 : out Formal_Acc02) is
+      begin
+         P1 := new Rec_Of_Private_Subtype'(C1 => Private_Subtype'Last);
+         P2 := new Array_Of_LP_Subtype'(Eh, Dee);
+
+      end Assign_Access;
+
+   end CDE0001_2;
+
+end CDE0001_0;
+
+     --==================================================================--
+
+-- The following private child package instantiates its parent private generic
+-- package. 
+
+with CDE0001_0;
+pragma Elaborate (CDE0001_0); -- So generic unit can be instantiated.
+private 
+package CDE0001_0.CDE0001_3 is
+
+   type Arr01 is array (Small_Int) of Private_Type;
+   type Arr02 is array (Small_Int) of Rec_Of_Limited_Private;
+   type Acc01 is access Rec_Of_Private_Subtype;
+   type Acc02 is access Array_Of_LP_Subtype;
+
+   package Formal_Types_Pck is new CDE0001_2 (Arr01, Arr02, Acc01, Acc02);
+   
+   Arr01_Obj : Arr01;
+   Arr02_Obj : Arr02;
+   Acc01_Obj : Acc01;
+   Acc02_Obj : Acc02;
+
+end CDE0001_0.CDE0001_3;
+
+     --==================================================================--
+
+package CDE0001_0.CDE0001_4 is
+
+   -- The following functions check the private types defined in the parent
+   -- and the private child package from within the client program.
+
+   function Verify_Objects return Boolean;
+
+   function Verify_Arrays return Boolean;
+
+   function Verify_Access return Boolean;
+
+end CDE0001_0.CDE0001_4;
+
+     --==================================================================--
+
+with CDE0001_0.CDE0001_3;            -- private sibling.
+
+pragma Elaborate (CDE0001_0.CDE0001_3);
+
+package body CDE0001_0.CDE0001_4 is
+
+   Obj1 : Private_Type            := 2;   
+   Obj2 : Limited_Private         := Bee;
+   Obj3 : Private_Subtype         := 3;    
+   Obj4 : Limited_Private_Subtype := Sea;
+   Obj5 : New_TagType             := (1, 5);
+
+   -- Instantiate the generic package declared in the visible part of
+   -- the parent.
+ 
+   package Formal_Obj_Pck is new CDE0001_1 (Obj1, Obj2, Obj3, Obj4, Obj5);
+
+   ---------------------------------------------------
+   function Verify_Objects return Boolean is
+      Result : Boolean := False;
+   begin
+      if Obj1    = 1    and 
+         Obj2    = Dee  and 
+         Obj3    = 10   and 
+         Obj4    = Eh   and 
+         Obj5.C1 = 2    and
+         Obj5.C2 = 10   then
+           Result := True;
+      end if;
+
+      return Result;
+
+   end Verify_Objects;
+
+   ---------------------------------------------------
+   function Verify_Arrays return Boolean is
+      Result : Boolean := False;
+   begin
+      if CDE0001_0.CDE0001_3.Arr01_Obj(1)    = 9     and 
+         CDE0001_0.CDE0001_3.Arr01_Obj(2)    = 2     and 
+         CDE0001_0.CDE0001_3.Arr02_Obj(1).C1 = Bee   and 
+         CDE0001_0.CDE0001_3.Arr02_Obj(2).C1 = Sea   then
+           Result := True;
+      end if;
+
+      return Result;
+
+   end Verify_Arrays;
+
+   ---------------------------------------------------
+   function Verify_Access return Boolean is
+      Result : Boolean := False;
+   begin
+      if CDE0001_0.CDE0001_3.Acc01_Obj.C1  = 10   and 
+         CDE0001_0.CDE0001_3.Acc02_Obj(1)  = Eh   and
+         CDE0001_0.CDE0001_3.Acc02_Obj(2)  = Dee  then
+            Result := True;
+      end if;
+
+      return Result;
+
+   end Verify_Access;
+
+begin
+
+   Formal_Obj_Pck.Assign_Objects;
+
+   CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Arrays 
+     (CDE0001_0.CDE0001_3.Arr01_Obj, CDE0001_0.CDE0001_3.Arr02_Obj);
+   CDE0001_0.CDE0001_3.Formal_Types_Pck.Assign_Access 
+     (CDE0001_0.CDE0001_3.Acc01_Obj, CDE0001_0.CDE0001_3.Acc02_Obj);
+
+end CDE0001_0.CDE0001_4;
+
+     --==================================================================--
+
+with Report;
+with CDE0001_0.CDE0001_4;
+
+procedure CDE0001 is
+
+begin
+
+   Report.Test ("CDE0001", "Check that the name of the private type, a "  &
+                "name that denotes a subtype of the private type, or a "  &
+                "name that denotes a composite type with a subcomponent " &
+                "of a private type can be used in the declaration of a "  &
+                "generic formal type parameter without causing freezing " &
+                "of the named type");
+
+   if not CDE0001_0.CDE0001_4.Verify_Objects then
+      Report.Failed ("Wrong values for formal objects");
+   end if;
+
+   if not CDE0001_0.CDE0001_4.Verify_Arrays then
+      Report.Failed ("Wrong values for formal array types");
+   end if;
+
+   if not CDE0001_0.CDE0001_4.Verify_Access then
+      Report.Failed ("Wrong values for formal access types");
+   end if;
+
+   Report.Result;
+
+end CDE0001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102a.ada
new file mode 100644
index 000000000..b784b87de
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102a.ada
@@ -0,0 +1,133 @@
+-- CE2102A.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 TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL
+--     OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE SEQUENTIAL_IO.
+
+--          A) OPENED FILES
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH OUT_FILE MODE FOR SEQUENTIAL FILES.
+
+-- HISTORY:
+--     DLD 08/10/82
+--     JBG 02/22/84
+--     SPW 07/29/87  SPLIT CASE FOR UNOPENED FILES INTO CE2102L.ADA.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2102A IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER);
+     USE SEQ_IO;
+     TEST_FILE_ONE : SEQ_IO.FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE2102A", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
+                      "PERFORMING ILLEGAL OPERATIONS ON OPENED FILES " &
+                      "OF TYPE SEQUENTIAL_IO");
+
+     BEGIN
+          CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+
+-- CHECK THAT OPEN STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY OPEN
+
+          BEGIN
+               OPEN (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
+                       "ALREADY OPEN - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON OPEN - 1");
+          END;
+
+          BEGIN
+               OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
+                       "ALREADY OPEN - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON OPEN - 2");
+          END;
+
+-- CHECK THAT CREATE STATEMENT RAISES EXCEPTION WHEN FILE
+-- IS ALREADY OPEN
+
+          BEGIN
+               CREATE (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
+                       "FILE IS USED IN A CREATE - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON CREATE - 1");
+          END;
+
+          BEGIN
+               CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
+                       "FILE IS USED IN A CREATE - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
+          END;
+
+--DELETE TEST FILE
+
+          BEGIN
+               DELETE (TEST_FILE_ONE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("DELETION OF EXTERNAL FILE APPEARS NOT " &
+                             "TO BE SUPPORTED");
+
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                            "FOR DELETE");
+          END;
+
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED FOR CREATE " &
+                               "WITH OUT_FILE MODE");
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED FOR CREATE " &
+                               "WITH OUT_FILE MODE");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR CREATE");
+     END;
+
+     RESULT;
+END CE2102A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102b.ada
new file mode 100644
index 000000000..98494c6cb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102b.ada
@@ -0,0 +1,155 @@
+-- CE2102B.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 TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL
+--     OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE DIRECT_IO.
+
+--          A) OPENED FILES
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO THOSE  IMPLEMENTATIONS WHICH
+--     SUPPORT CREATE WITH OUT_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     DLD 08/10/82
+--     SPS 11/03/82
+--     JBG 02/22/84
+--     SPW 08/13/87  SPLIT CASE FOR UNOPENED FILES INTO CE2102M.ADA.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102B IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
+     USE DIR_IO;
+     TEST_FILE_ONE : DIR_IO.FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE2102B", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
+                      "PERFORMING ILLEGAL OPERATIONS ON FILES " &
+                      "OF TYPE DIRECT_IO");
+
+     BEGIN
+          CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+
+-- CHECK THAT OPEN STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY OPEN
+
+          BEGIN
+               OPEN (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
+                       "ALREADY OPEN - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON OPEN - 1");
+          END;
+
+          BEGIN
+               OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
+                       "ALREADY OPEN - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON OPEN - 2");
+          END;
+
+          BEGIN
+               OPEN (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
+                       "ALREADY OPEN - 3");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON OPEN - 3");
+          END;
+
+-- CHECK THAT CREATE STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY
+-- OPEN
+
+          BEGIN
+               CREATE (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
+                       "FILE IS USED IN A CREATE - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON CREATE - 1");
+          END;
+
+          BEGIN
+               CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
+                       "FILE IS USED IN A CREATE - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
+          END;
+
+          BEGIN
+               CREATE (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
+                       "FILE IS USED IN A CREATE - 3");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON CREATE - 3");
+          END;
+
+--DELETE TEST FILE
+
+          BEGIN
+               DELETE (TEST_FILE_ONE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("DELETION OF EXTERNAL FILE APPEARS NOT " &
+                             "TO BE SUPPORTED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED FOR DELETE");
+          END;
+
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED FOR CREATE " &
+                               "WITH OUT_FILE MODE");
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED FOR CREATE " &
+                               "WITH OUT_FILE MODE");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR CREATE");
+     END;
+
+     RESULT;
+
+END CE2102B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102c.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102c.tst
new file mode 100644
index 000000000..11868bcca
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102c.tst
@@ -0,0 +1,140 @@
+-- CE2102C.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 NAME_ERROR IS RAISED WHEN THE NAME STRING DOES NOT
+--     IDENTIFY AN EXTERNAL FILE FOR AN OPEN OR CREATE OPERATION FOR
+--     SEQUENTIAL_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH OUT_FILE MODE FOR SEQUENTIAL TEMPORARY FILES.
+
+-- HISTORY:
+--     SPS  08/26/82
+--     JBG  02/22/84  CHANGED TO .ADA TEST.
+--     JRK  11/30/84  CHANGED TO .TST TEST.
+--     TBN  02/12/86  SPLIT TEST.  PUT DIRECT_IO INTO CE2102H-B.TST.
+--     SPW  08/25/87  CORRECTED EXCEPTION HANDLING.
+--     BCB  09/28/88  ADDED EXCEPTION HANDLERS FOR DELETE STATEMENTS.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2102C IS
+
+     NAME1 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME1";
+               -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY)
+               -- CONTAINS INVALID CHARACTERS OR IS TOO LONG.
+
+     NAME2 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME2";
+               -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY)
+               -- CONTAINS A WILD CARD CHARACTER OR IS TOO LONG.
+
+BEGIN
+
+     TEST ("CE2102C", "CHECK THAT NAME_ERROR IS RAISED BY OPEN AND " &
+                      "CREATE WHEN NAME DOES NOT IDENTIFY AN " &
+                      "EXTERNAL FILE FOR SEQUENTIAL_IO");
+
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+
+-- CHECK WHETHER CREATE RAISES USE_ERROR
+
+          BEGIN
+               CREATE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("TEMPORARY SEQUENTIAL FILES WITH " &
+                                    "OUT_FILE MODE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE");
+                    RAISE INCOMPLETE;
+          END;
+          CLOSE (FILE1);
+
+          BEGIN
+               CREATE(FILE1, OUT_FILE, NAME1);
+               FAILED ("NAME_ERROR NOT RAISED - CREATE SEQ 1");
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NULL;
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED - CREATE SEQ 1");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CREATE SEQ 1");
+          END;
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, NAME2);
+               FAILED("NAME_ERROR NOT RAISED - CREATE SEQ 2");
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NULL;
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED - CREATE SEQ 2");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CREATE SEQ 2");
+          END;
+
+-- CHECK WHETHER OPEN RAISES NAME_ERROR IN THE CASE OF A LEGAL FILE
+-- NAME BUT A NON-EXISTENT FILE.
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               FAILED("NAME_ERROR NOT RAISED - OPEN SEQ");
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NULL;
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED - OPEN SEQ");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - OPEN SEQ");
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+END CE2102C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102d.ada
new file mode 100644
index 000000000..728eed108
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102d.ada
@@ -0,0 +1,63 @@
+-- CE2102D.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
+--     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE
+--     IMPLEMENTATION FOR SEQUENTIAL_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT IN_FILE FOR CREATE FOR SEQUENTIAL_IO.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2102D IS
+BEGIN
+
+     TEST ("CE2102D", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF CREATE FOR SEQUENTIAL_IO");
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
+          USE SEQ;
+          FILE1 : FILE_TYPE;
+     BEGIN
+          CREATE (FILE1, IN_FILE);
+          CLOSE (FILE1);
+          NOT_APPLICABLE ("CREATE WITH MODE IN_FILE ALLOWED");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+     END;
+
+     RESULT;
+
+END CE2102D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102e.ada
new file mode 100644
index 000000000..caaf3fd61
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102e.ada
@@ -0,0 +1,66 @@
+-- CE2102E.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
+--     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE
+--     IMPLEMENTATION FOR SEQUENTIAL_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT OUT_FILE FOR CREATE FOR SEQUENTIAL_IO.
+
+-- HISTORY:
+--     SPS 08/26/82
+--     JBG 06/04/84
+--     EG  05/08/85
+--     TBN 07/23/87  COMPLETELY REVISED TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2102E IS
+BEGIN
+
+     TEST ("CE2102E", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF CREATE FOR SEQUENTIAL_IO");
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
+          USE SEQ;
+          FILE1 : FILE_TYPE;
+     BEGIN
+          CREATE (FILE1, OUT_FILE);
+          CLOSE (FILE1);
+          NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE ALLOWED");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+     END;
+
+     RESULT;
+
+END CE2102E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102f.ada
new file mode 100644
index 000000000..8d8328d42
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102f.ada
@@ -0,0 +1,65 @@
+-- CE2102F.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
+--     INOUT_FILE, WHEN INOUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY
+--     THE IMPLEMENTATION FOR DIRECT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT INOUT_FILE FOR CREATE FOR DIRECT FILES.
+
+-- HISTORY:
+--     SPS 08/26/82
+--     JBG 06/04/84
+--     TBN 07/23/87  COMPLETELY REVISED TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102F IS
+BEGIN
+
+     TEST ("CE2102F", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "INOUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF CREATE FOR DIRECT_IO");
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+     BEGIN
+          CREATE (FILE1, INOUT_FILE);
+          CLOSE (FILE1);
+          NOT_APPLICABLE ("CREATE WITH MODE INOUT_FILE ALLOWED");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+     END;
+
+     RESULT;
+
+END CE2102F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102g.ada
new file mode 100644
index 000000000..b5de4e617
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102g.ada
@@ -0,0 +1,130 @@
+-- CE2102G.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 USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT
+--     SUPPORT RESET FOR SEQUENTIAL_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     SPS 08/27/82
+--     JBG 06/04/84
+--     TBN 02/12/86  SPLIT TEST.  PUT DIRECT_IO INTO CE2102K.ADA.
+--     TBN 09/15/87  COMPLETELY REVISED TEST.
+
+WITH SEQUENTIAL_IO;
+WITH REPORT; USE REPORT;
+PROCEDURE CE2102G IS
+     INCOMPLETE : EXCEPTION;
+BEGIN
+     TEST ("CE2102G", "CHECK THAT USE_ERROR IS RAISED IF AN " &
+                      "IMPLEMENTATION DOES NOT SUPPORT RESET FOR " &
+                      "SEQUENTIAL_IO");
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ;
+          FILE1 : FILE_TYPE;
+          INT1 : INTEGER := IDENT_INT(1);
+          INT2 : INTEGER := 2;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " &
+                                    "SEQUENTIAL FILE WITH OUT_FILE " &
+                                    "MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " &
+                                    "SEQUENTIAL FILE WITH OUT_FILE " &
+                                    "MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, INT2);
+          BEGIN
+               RESET (FILE1, IN_FILE);
+               COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS ALLOWED");
+               BEGIN
+                    READ (FILE1, INT1);
+                    IF INT1 /= IDENT_INT(2) THEN
+                         FAILED ("RESETTING FROM OUT_FILE TO IN_FILE " &
+                                 "AFFECTED DATA");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
+                                 "READING FROM FILE");
+               END;
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS NOT " &
+                             "ALLOWED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
+                            "RESETTING FROM OUT_FILE TO IN_FILE");
+          END;
+
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " &
+                                    "SEQUENTIAL FILE WITH IN_FILE " &
+                                    "MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               RESET (FILE1, OUT_FILE);
+               COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS NOT " &
+                             "ALLOWED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
+                            "RESETTING FROM IN_FILE TO OUT_FILE");
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+END CE2102G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102h.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102h.tst
new file mode 100644
index 000000000..ea265c034
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102h.tst
@@ -0,0 +1,136 @@
+-- CE2102H.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 NAME_ERROR IS RAISED WHEN THE NAME STRING DOES NOT
+--     IDENTIFY AN EXTERNAL FILE FOR AN OPEN OR CREATE OPERATION FOR
+--     DIRECT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH INOUT_FILE MODE FOR TEMPORARY DIRECT FILES.
+
+-- HISTORY:
+--     TBN 02/12/86
+--     SPW 08/26/87  CORRECTED EXCEPTION HANDLING.
+--     BCB 09/28/88  ADDED EXCEPTION HANDLERS FOR DELETE STATEMENTS.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102H IS
+
+     NAME1 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME1";
+               -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY)
+               -- CONTAINS INVALID CHARACTERS OR IS TOO LONG.
+
+     NAME2 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME2";
+               -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY)
+               -- CONTAINS A WILD CARD CHARACTER OR IS TOO LONG.
+
+BEGIN
+
+     TEST ("CE2102H", "CHECK THAT NAME_ERROR IS RAISED BY OPEN AND " &
+                      "CREATE WHEN NAME DOES NOT IDENTIFY AN " &
+                      "EXTERNAL FILE FOR DIRECT_IO");
+
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+
+-- CHECK WHETHER CREATE RAISES USE_ERROR
+
+          BEGIN
+               CREATE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("TEMPORARY DIRECT FILES WITH " &
+                                    "INOUT_FILE MODE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE");
+                    RAISE INCOMPLETE;
+          END;
+          CLOSE (FILE1);
+
+          BEGIN
+               CREATE(FILE1, OUT_FILE, NAME1);
+               FAILED ("NAME_ERROR NOT RAISED - CREATE DIR 1");
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NULL;
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED - CREATE DIR 1");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CREATE DIR 1");
+          END;
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, NAME2);
+               FAILED("NAME_ERROR NOT RAISED - CREATE DIR 2");
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NULL;
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED - CREATE DIR 2");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CREATE DIR 2");
+          END;
+
+-- CHECK WHETHER OPEN RAISES NAME_ERROR IN THE CASE OF A LEGAL FILE NAME
+-- BUT A NON-EXISTENT FILE.
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               FAILED("NAME_ERROR NOT RAISED - OPEN DIR");
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NULL;
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED - OPEN DIR");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - OPEN DIR");
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+END CE2102H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102i.ada
new file mode 100644
index 000000000..43616c217
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102i.ada
@@ -0,0 +1,63 @@
+-- CE2102I.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
+--     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR CREATE BY
+--     THE IMPLEMENTATION FOR DIRECT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT IN_FILE FOR CREATE FOR DIRECT FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102I IS
+BEGIN
+
+     TEST ("CE2102I", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF CREATE FOR DIRECT_IO");
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+     BEGIN
+          CREATE (FILE1, IN_FILE);
+          CLOSE (FILE1);
+          NOT_APPLICABLE ("CREATE WITH MODE IN_FILE ALLOWED");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+     END;
+
+     RESULT;
+
+END CE2102I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102j.ada
new file mode 100644
index 000000000..efe08a689
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102j.ada
@@ -0,0 +1,66 @@
+-- CE2102J.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
+--     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY
+--     THE IMPLEMENTATION FOR DIRECT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT OUT_FILE FOR CREATE FOR DIRECT FILES.
+
+-- HISTORY:
+--     SPS 08/26/82
+--     JBG 06/04/84
+--     EG  05/08/85
+--     TBN 07/23/87  COMPLETELY REVISED TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102J IS
+BEGIN
+
+     TEST ("CE2102J", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF CREATE FOR DIRECT_IO");
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+     BEGIN
+          CREATE (FILE1, OUT_FILE);
+          CLOSE (FILE1);
+          NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE ALLOWED");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+     END;
+
+     RESULT;
+
+END CE2102J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102k.ada
new file mode 100644
index 000000000..fed673f27
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102k.ada
@@ -0,0 +1,248 @@
+-- CE2102K.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 USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT
+--     SUPPORT RESET FOR DIRECT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     DIRECT FILES.
+
+-- HISTORY:
+--     TBN 02/12/86  CREATED ORIGINAL TEST.
+--     TBN 09/15/87  COMPLETELY REVISED TEST.
+
+WITH DIRECT_IO;
+WITH REPORT; USE REPORT;
+PROCEDURE CE2102K IS
+     INCOMPLETE : EXCEPTION;
+BEGIN
+     TEST ("CE2102K", "CHECK THAT USE_ERROR IS RAISED IF AN " &
+                      "IMPLEMENTATION DOES NOT SUPPORT RESET FOR " &
+                      "DIRECT_IO");
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+          INT1 : INTEGER := IDENT_INT(1);
+          INT2 : INTEGER := 2;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " &
+                                    "DIRECT FILE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " &
+                                    "DIRECT FILE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, INT2);
+
+     -- RESETTING FROM OUT_FILE TO IN_FILE.
+
+          BEGIN
+               RESET (FILE1, IN_FILE);
+               COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS ALLOWED");
+               BEGIN
+                    READ (FILE1, INT1);
+                    IF INT1 /= IDENT_INT(2) THEN
+                         FAILED ("RESETTING FROM OUT_FILE TO IN_FILE " &
+                                 "AFFECTED DATA");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
+                                 "READING FROM FILE - 1");
+               END;
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS NOT " &
+                             "ALLOWED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
+                            "RESETTING FROM OUT_FILE TO IN_FILE");
+          END;
+
+          CLOSE (FILE1);
+
+     -- RESETTING FROM OUT_FILE TO INOUT_FILE.
+
+          CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME(2));
+
+          WRITE (FILE1, INT2);
+          BEGIN
+               RESET (FILE1, INOUT_FILE);
+               COMMENT ("RESET FROM OUT_FILE TO INOUT_FILE IS ALLOWED");
+               BEGIN
+                    READ (FILE1, INT1);
+                    IF INT1 /= IDENT_INT(2) THEN
+                         FAILED ("RESETTING FROM OUT_FILE TO " &
+                                 "INOUT_FILE AFFECTED DATA");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
+                                 "READING FROM FILE - 2");
+               END;
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("RESET FROM OUT_FILE TO INOUT_FILE IS " &
+                             "NOT ALLOWED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
+                            "RESETTING FROM OUT_FILE TO INOUT_FILE");
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     -- RESETTING FROM IN_FILE TO OUT_FILE.
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " &
+                                    "DIRECT FILE WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               RESET (FILE1, OUT_FILE);
+               COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS NOT " &
+                             "ALLOWED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
+                            "RESETTING FROM IN_FILE TO OUT_FILE");
+          END;
+
+          CLOSE (FILE1);
+
+     -- RESETTING FROM IN_FILE TO INOUT_FILE.
+
+          OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+
+          BEGIN
+               RESET (FILE1, INOUT_FILE);
+               COMMENT ("RESET FROM IN_FILE TO INOUT_FILE IS ALLOWED");
+               BEGIN
+                    READ (FILE1, INT1);
+                    IF INT1 /= IDENT_INT(2) THEN
+                         FAILED ("RESETTING FROM IN_FILE TO " &
+                                 "INOUT_FILE AFFECTED DATA");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
+                                 "READING FROM FILE - 3");
+               END;
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("RESET FROM IN_FILE TO INOUT_FILE IS " &
+                             "NOT ALLOWED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
+                            "RESETTING FROM IN_FILE TO INOUT_FILE");
+          END;
+
+          CLOSE (FILE1);
+
+     -- RESETTING FROM INOUT_FILE TO IN_FILE.
+
+          BEGIN
+               OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " &
+                                    "DIRECT FILE WITH INOUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               RESET (FILE1, IN_FILE);
+               COMMENT ("RESET FROM INOUT_FILE TO IN_FILE IS ALLOWED");
+               BEGIN
+                    READ (FILE1, INT1);
+                    IF INT1 /= IDENT_INT(2) THEN
+                         FAILED ("RESETTING FROM INOUT_FILE TO " &
+                                 "IN_FILE AFFECTED DATA");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
+                                 "READING FROM FILE - 2");
+               END;
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("RESET FROM INOUT_FILE TO IN_FILE IS " &
+                             "NOT ALLOWED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
+                            "RESETTING FROM INOUT_FILE TO IN_FILE");
+          END;
+
+          CLOSE (FILE1);
+
+     -- RESETTING FROM INOUT_FILE TO OUT_FILE.
+
+          OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+
+          BEGIN
+               RESET (FILE1, OUT_FILE);
+               COMMENT ("RESET FROM INOUT_FILE TO OUT_FILE IS ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("RESET FROM INOUT_FILE TO OUT_FILE IS " &
+                             "NOT ALLOWED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
+                            "RESETTING FROM INOUT_FILE TO OUT_FILE");
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+END CE2102K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102l.ada
new file mode 100644
index 000000000..81d86633d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102l.ada
@@ -0,0 +1,147 @@
+-- CE2102L.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 TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL
+--     OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE SEQUENTIAL_IO.
+
+--          B) UNOPENED FILES
+
+-- HISTORY:
+--     SPW 07/29/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2102L IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER);
+     USE SEQ_IO;
+
+     TEST_FILE_ONE : SEQ_IO.FILE_TYPE;
+     STR : STRING (1 .. 10);
+     FL_MODE : SEQ_IO.FILE_MODE ;
+
+BEGIN
+
+     TEST ("CE2102L", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
+                      "PERFORMING ILLEGAL OPERATIONS ON UNOPENED " &
+                      "FILES OF TYPE SEQUENTIAL_IO");
+
+-- CHECK TO SEE THAT PROPER EXCEPTIONS ARE RAISED WHEN
+-- PERFORMING OPERATIONS ON AN UNOPENED FILE
+
+-- CLOSE AN UNOPENED FILE
+
+     BEGIN
+          CLOSE (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " &
+                  "FILE IS USED IN A CLOSE");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON CLOSE");
+     END;
+
+-- DELETE AN UNOPENED FILE
+
+     BEGIN
+          DELETE (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " &
+                  "FILE IS USED IN A DELETE");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON DELETE");
+     END;
+
+-- RESET UNOPENED FILE
+
+     BEGIN
+          RESET (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " &
+                  "FILE IS USED IN A RESET");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON RESET");
+     END;
+
+     BEGIN
+          RESET (TEST_FILE_ONE, IN_FILE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN A UNOPENED FILE " &
+                  "IS USED IN A RESET WITH MODE PARAMETER");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON RESET " &
+                       "WITH MODE");
+     END;
+
+-- ATTEMPT TO DETERMINE MODE OF UNOPENED FILE
+
+     BEGIN
+          FL_MODE := MODE (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN A UNOPENED " &
+                  "FILE IS USED IN A MODE OPERATION");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON MODE");
+     END;
+
+-- ATTEMPT TO DETERMINE NAME OF UNOPENED FILE
+
+     BEGIN
+          STR := NAME (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN A UNOPENED " &
+                  "FILE IS USED IN A NAME OPERATION");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON NAME");
+     END;
+
+--ATTEMPT TO DETERMINE FORM OF UNOPENED FILE
+
+     BEGIN
+          STR := FORM (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED " &
+                  "FILE IS USED IN A FORM OPERATION");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON FORM");
+     END;
+
+     RESULT;
+
+END CE2102L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102m.ada
new file mode 100644
index 000000000..8ea79cf9b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102m.ada
@@ -0,0 +1,146 @@
+-- CE2102M.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 TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL
+--     OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE DIRECT_IO.
+
+--          B) UNOPENED FILES
+
+-- HISTORY:
+--     SPW 02/24/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102M IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
+     USE DIR_IO;
+
+     TEST_FILE_ONE : DIR_IO.FILE_TYPE;
+     STR : STRING (1 .. 10);
+     FL_MODE : DIR_IO.FILE_MODE ;
+
+BEGIN
+
+     TEST ("CE2102M", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
+                      "PERFORMING ILLEGAL OPERATIONS ON UNOPENED " &
+                      "FILES OF TYPE DIRECT_IO");
+
+-- CHECK TO SEE THAT PROPER EXCEPTIONS ARE RAISED WHEN
+-- PERFORMING OPERATIONS ON AN UNOPENED FILE
+
+-- CLOSE AN UNOPENED FILE
+
+     BEGIN
+          CLOSE (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
+                  "IS USED IN A CLOSE OPERATION");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON CLOSE");
+     END;
+
+-- DELETE AN UNOPENED FILE
+
+     BEGIN
+          DELETE (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
+                  "IS USED IN A DELETE OPERATION");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON DELETE");
+     END;
+
+-- RESET UNOPENED FILE
+
+     BEGIN
+          RESET (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
+                  "IS USED IN A RESET");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON RESET");
+     END;
+
+     BEGIN
+          RESET (TEST_FILE_ONE, IN_FILE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
+                  "IS USED IN A RESET WITH MODE PARAMETER");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON RESET WITH " &
+                       "MODE PARAMETER");
+     END;
+
+-- ATTEMPT TO DETERMINE MODE OF UNOPENED FILE
+
+     BEGIN
+          FL_MODE := MODE (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
+                  "IS USED IN A MODE OPERATION");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON MODE");
+     END;
+
+-- ATTEMPT TO DETERMINE NAME OF UNOPENED FILE
+
+     BEGIN
+          STR := NAME (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
+                  "IS USED IN A NAME OPERATION");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON NAME");
+     END;
+
+--ATTEMPT TO DETERMINE FORM OF UNOPENED FILE
+
+     BEGIN
+          STR := FORM (TEST_FILE_ONE);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN AN UNOPENED FILE " &
+                  "IS USED IN A FORM OPERATION");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON FORM");
+     END;
+
+     RESULT;
+END CE2102M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102n.ada
new file mode 100644
index 000000000..c7b6414c7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102n.ada
@@ -0,0 +1,98 @@
+-- CE2102N.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
+--     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
+--     IMPLEMENTATION FOR SEQUENTIAL_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT OPEN WITH IN_FILE MODE FOR SEQUENTIAL FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2102N IS
+BEGIN
+
+     TEST ("CE2102N", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF OPEN FOR SEQUENTIAL FILES");
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
+          USE SEQ;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          VAR1 : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, VAR1);
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               NOT_APPLICABLE ("OPEN FOR IN_FILE MODE ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+          END;
+
+          IF IS_OPEN (FILE1) THEN
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END IF;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2102N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102o.ada
new file mode 100644
index 000000000..699ffa73c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102o.ada
@@ -0,0 +1,117 @@
+-- CE2102O.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 USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE
+--     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR RESET BY THE
+--     IMPLEMENTATION FOR SEQUENTIAL FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT RESET WITH IN_FILE MODE FOR SEQUENTIAL FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2102O IS
+BEGIN
+
+     TEST ("CE2102O", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " &
+                      "A FILE OF MODE IN_FILE, WHEN IN_FILE MODE IS " &
+                      "NOT SUPPORTED FOR RESET BY THE IMPLEMENTATION " &
+                      "FOR SEQUENTIAL FILES");
+
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
+          USE SEQ;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          VAR1 : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, VAR1);
+          CLOSE (FILE1);
+
+          BEGIN
+               BEGIN
+                    OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT " &
+                                         "SUPPORTED");
+                         RAISE INCOMPLETE;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+                         RAISE INCOMPLETE;
+               END;
+
+               BEGIN
+                    RESET (FILE1);
+                    NOT_APPLICABLE ("RESET FOR IN_FILE MODE IS " &
+                                    "SUPPORTED");
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                                 "RESET");
+               END;
+          EXCEPTION
+               WHEN INCOMPLETE =>
+                    NULL;
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2102O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102p.ada
new file mode 100644
index 000000000..f5db1c99a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102p.ada
@@ -0,0 +1,98 @@
+-- CE2102P.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
+--     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
+--     IMPLEMENTATION FOR SEQUENTIAL_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT OPEN WITH OUT_FILE MODE FOR SEQUENTIAL FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2102P IS
+BEGIN
+
+     TEST ("CE2102P", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF OPEN FOR SEQUENTIAL FILES");
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
+          USE SEQ;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          VAR1 : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, VAR1);
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+               NOT_APPLICABLE ("OPEN FOR OUT_FILE MODE ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+          END;
+
+          IF IS_OPEN (FILE1) THEN
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END IF;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2102P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102q.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102q.ada
new file mode 100644
index 000000000..af7fbe564
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102q.ada
@@ -0,0 +1,97 @@
+-- CE2102Q.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 USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE
+--     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR RESET BY THE
+--     IMPLEMENTATION FOR SEQUENTIAL FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT RESET WITH OUT_FILE MODE FOR SEQUENTIAL FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2102Q IS
+BEGIN
+
+     TEST ("CE2102Q", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " &
+                      "A FILE OF MODE OUT_FILE, WHEN OUT_FILE MODE " &
+                      "IS NOT SUPPORTED FOR RESET BY THE " &
+                      "IMPLEMENTATION FOR SEQUENTIAL FILES");
+
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (BOOLEAN);
+          USE SEQ;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          VAR1 : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, VAR1);
+
+          BEGIN
+               RESET (FILE1);
+               NOT_APPLICABLE ("RESET FOR OUT_FILE MODE IS SUPPORTED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON RESET");
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2102Q;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102r.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102r.ada
new file mode 100644
index 000000000..8ec6c9ec2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102r.ada
@@ -0,0 +1,98 @@
+-- CE2102R.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
+--     INOUT_FILE, WHEN INOUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
+--     IMPLEMENTATION FOR DIRECT FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT OPEN WITH INOUT_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102R IS
+BEGIN
+
+     TEST ("CE2102R", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "INOUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF OPEN FOR DIRECT FILES");
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          VAR1 : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, VAR1);
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+               NOT_APPLICABLE ("OPEN FOR INOUT_FILE MODE ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+          END;
+
+          IF IS_OPEN (FILE1) THEN
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END IF;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2102R;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102s.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102s.ada
new file mode 100644
index 000000000..030ce4925
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102s.ada
@@ -0,0 +1,98 @@
+-- CE2102S.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 USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE
+--     INOUT_FILE, WHEN INOUT_FILE MODE IS NOT SUPPORTED FOR RESET BY
+--     THE IMPLEMENTATION FOR DIRECT FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT RESET WITH INOUT_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102S IS
+BEGIN
+
+     TEST ("CE2102S", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " &
+                      "A FILE OF MODE INOUT_FILE, WHEN INOUT_FILE " &
+                      "MODE IS NOT SUPPORTED FOR RESET BY THE " &
+                      "IMPLEMENTATION FOR DIRECT FILES");
+
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          VAR1 : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "INOUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "INOUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, VAR1);
+
+          BEGIN
+               RESET (FILE1);
+               NOT_APPLICABLE ("RESET FOR INOUT_FILE MODE IS " &
+                               "SUPPORTED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON RESET");
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2102S;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102t.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102t.ada
new file mode 100644
index 000000000..b97ad627a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102t.ada
@@ -0,0 +1,98 @@
+-- CE2102T.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
+--     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
+--     IMPLEMENTATION FOR DIRECT FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT OPEN WITH IN_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102T IS
+BEGIN
+
+     TEST ("CE2102T", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF OPEN FOR DIRECT FILES");
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          VAR1 : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "INOUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "INOUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, VAR1);
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               NOT_APPLICABLE ("OPEN FOR IN_FILE MODE ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+          END;
+
+          IF IS_OPEN (FILE1) THEN
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END IF;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2102T;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102u.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102u.ada
new file mode 100644
index 000000000..0a9d946f2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102u.ada
@@ -0,0 +1,117 @@
+-- CE2102U.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 USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE
+--     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR RESET BY
+--     THE IMPLEMENTATION FOR DIRECT FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT RESET WITH IN_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102U IS
+BEGIN
+
+     TEST ("CE2102U", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " &
+                      "A FILE OF MODE IN_FILE, WHEN IN_FILE " &
+                      "MODE IS NOT SUPPORTED FOR RESET BY THE " &
+                      "IMPLEMENTATION FOR DIRECT FILES");
+
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          VAR1 : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "INOUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "INOUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, VAR1);
+          CLOSE (FILE1);
+
+          BEGIN
+               BEGIN
+                    OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN WITH IN_FILE MODE " &
+                                         "NOT SUPPORTED");
+                         RAISE INCOMPLETE;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+                         RAISE INCOMPLETE;
+               END;
+
+               BEGIN
+                    RESET (FILE1);
+                    NOT_APPLICABLE ("RESET FOR IN_FILE MODE IS " &
+                                    "SUPPORTED");
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                                 "RESET");
+               END;
+          EXCEPTION
+               WHEN INCOMPLETE =>
+                    NULL;
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2102U;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102v.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102v.ada
new file mode 100644
index 000000000..423200263
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102v.ada
@@ -0,0 +1,98 @@
+-- CE2102V.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
+--     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
+--     IMPLEMENTATION FOR DIRECT FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT OPEN WITH OUT_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102V IS
+BEGIN
+
+     TEST ("CE2102V", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF OPEN FOR DIRECT FILES");
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          VAR1 : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "INOUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "INOUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, VAR1);
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+               NOT_APPLICABLE ("OPEN FOR OUT_FILE MODE ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+          END;
+
+          IF IS_OPEN (FILE1) THEN
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END IF;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2102V;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102w.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102w.ada
new file mode 100644
index 000000000..5239f0bc7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102w.ada
@@ -0,0 +1,98 @@
+-- CE2102W.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 USE_ERROR IS RAISED WHEN RESETTING A FILE OF MODE
+--     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR RESET BY
+--     THE IMPLEMENTATION FOR DIRECT FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT RESET WITH OUT_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     TBN 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2102W IS
+BEGIN
+
+     TEST ("CE2102W", "CHECK THAT USE_ERROR IS RAISED WHEN RESETTING " &
+                      "A FILE OF MODE OUT_FILE, WHEN OUT_FILE " &
+                      "MODE IS NOT SUPPORTED FOR RESET BY THE " &
+                      "IMPLEMENTATION FOR DIRECT FILES");
+
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (BOOLEAN);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          VAR1 : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, VAR1);
+
+          BEGIN
+               RESET (FILE1);
+               NOT_APPLICABLE ("RESET FOR OUT_FILE MODE IS " &
+                               "SUPPORTED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON RESET");
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2102W;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102x.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102x.ada
new file mode 100644
index 000000000..8f56ac55a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102x.ada
@@ -0,0 +1,85 @@
+-- CE2102X.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 USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT
+--     SUPPORT DELETION OF AN EXTERNAL SEQUENTIAL FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF A SEQUENTIAL FILE WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     TBN 09/15/87  CREATED ORIGINAL TEST.
+
+WITH SEQUENTIAL_IO;
+WITH REPORT; USE REPORT;
+PROCEDURE CE2102X IS
+     INCOMPLETE : EXCEPTION;
+BEGIN
+     TEST ("CE2102X", "CHECK THAT USE_ERROR IS RAISED IF AN " &
+                      "IMPLEMENTATION DOES NOT SUPPORT DELETION " &
+                      "OF AN EXTERNAL SEQUENTIAL FILE");
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ;
+          FILE1 : FILE_TYPE;
+          INT1 : INTEGER := IDENT_INT(1);
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " &
+                                    "SEQUENTIAL FILE WITH OUT_FILE " &
+                                    "MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " &
+                                    "SEQUENTIAL FILE WITH OUT_FILE " &
+                                    "MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, INT1);
+          BEGIN
+               DELETE (FILE1);
+               COMMENT ("DELETION OF AN EXTERNAL SEQUENTIAL FILE IS " &
+                        "ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("DELETION OF AN EXTERNAL SEQUENTIAL " &
+                             "FILE IS NOT ALLOWED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
+                            "DELETING AN EXTERNAL FILE");
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+END CE2102X;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102y.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102y.ada
new file mode 100644
index 000000000..e6ae6d3d1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2102y.ada
@@ -0,0 +1,83 @@
+-- CE2102Y.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 USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT
+--     SUPPORT DELETION OF AN EXTERNAL DIRECT FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF A DIRECT FILE WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     TBN 09/15/87  CREATED ORIGINAL TEST.
+
+WITH DIRECT_IO;
+WITH REPORT; USE REPORT;
+PROCEDURE CE2102Y IS
+     INCOMPLETE : EXCEPTION;
+BEGIN
+     TEST ("CE2102Y", "CHECK THAT USE_ERROR IS RAISED IF AN " &
+                      "IMPLEMENTATION DOES NOT SUPPORT DELETION " &
+                      "OF AN EXTERNAL DIRECT FILE");
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+          USE DIR;
+          FILE1 : FILE_TYPE;
+          INT1 : INTEGER := IDENT_INT(1);
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " &
+                                    "DIRECT FILE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " &
+                                    "DIRECT FILE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE1, INT1);
+          BEGIN
+               DELETE (FILE1);
+               COMMENT ("DELETION OF AN EXTERNAL DIRECT FILE IS " &
+                        "ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT ("DELETION OF AN EXTERNAL DIRECT " &
+                             "FILE IS NOT ALLOWED");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
+                            "DELETING AN EXTERNAL FILE");
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+END CE2102Y;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103a.tst
new file mode 100644
index 000000000..6a6d21a59
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103a.tst
@@ -0,0 +1,142 @@
+-- CE2103A.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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
+--     TYPE SEQUENTIAL_IO.
+
+--          A) UNOPENED FILES
+
+-- HISTORY:
+--     DLD 08/10/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  06/03/85
+--     SPW 08/10/87  SPLIT CASE FOR OPENED FILES INTO CE2103C.ADA.
+--     PWB 03/07/97  ADDED CHECK FOR FILE SUPPORT.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2103A IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(CHARACTER);
+          USE SEQ_IO;
+
+     TEST_FILE_ZERO : SEQ_IO.FILE_TYPE;
+     TEST_FILE_ONE : SEQ_IO.FILE_TYPE;
+     TEST_FILE_TWO : SEQ_IO.FILE_TYPE;
+     TEST_FILE_THREE : SEQ_IO.FILE_TYPE;
+     TEST_FILE_FOUR : SEQ_IO.FILE_TYPE;
+     VAL : BOOLEAN;
+
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2103A", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
+                      "VALUES FOR UNOPENED FILES OF TYPE " &
+                      "SEQUENTIAL_IO");
+
+-- FIRST TEST WHETHER IMPLEMENTATION SUPPORTS SEQUENTIAL FILES AT ALL
+
+     BEGIN
+          SEQ_IO.CREATE ( TEST_FILE_ZERO,
+                          SEQ_IO.OUT_FILE,
+                          REPORT.LEGAL_FILE_NAME );
+     EXCEPTION
+          WHEN SEQ_IO.USE_ERROR | SEQ_IO.NAME_ERROR =>
+               REPORT.NOT_APPLICABLE
+                    ( "SEQUENTIAL FILES NOT SUPPORTED -- CREATE OUT-FILE" );
+               RAISE INCOMPLETE;
+     END;
+     SEQ_IO.DELETE ( TEST_FILE_ZERO );
+
+-- WHEN FILE IS DECLARED BUT NOT OPEN
+
+     BEGIN
+          VAL := TRUE;
+          VAL := IS_OPEN (TEST_FILE_ONE);
+          IF VAL = TRUE THEN
+               FAILED ("FILE NOT OPEN BUT IS_OPEN RETURNS TRUE");
+          END IF;
+     END;
+
+-- FOLLOWING UNSUCCESSFUL CREATE
+
+     BEGIN
+          VAL := TRUE;
+          CREATE (TEST_FILE_TWO, OUT_FILE,
+                  "$ILLEGAL_EXTERNAL_FILE_NAME1");
+          FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL CREATE");
+     EXCEPTION
+          WHEN NAME_ERROR =>
+               VAL := IS_OPEN (TEST_FILE_TWO);
+               IF VAL = TRUE THEN
+                    FAILED ("IS_OPEN GIVES TRUE AFTER AN " &
+                            "UNSUCCESSFUL CREATE");
+               END IF;
+     END;
+
+-- FOLLOWING UNSUCCESSFUL OPEN
+
+     BEGIN
+          VAL := TRUE;
+          OPEN (TEST_FILE_THREE, IN_FILE,
+                "$ILLEGAL_EXTERNAL_FILE_NAME1");
+          FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL OPEN");
+     EXCEPTION
+          WHEN NAME_ERROR =>
+               VAL := IS_OPEN (TEST_FILE_THREE);
+               IF VAL = TRUE THEN
+                    FAILED ("IS_OPEN GIVES TRUE - UNSUCCESSFUL OPEN");
+               END IF;
+     END;
+
+-- FOLLOWING CLOSING FILE THAT IS NOT OPEN
+
+     BEGIN
+          VAL := TRUE;
+          CLOSE (TEST_FILE_FOUR);
+          FAILED ("STATUS ERROR NOT RAISED WHEN " &
+                  "ATTEMPTING TO CLOSE AN UNOPENED FILE");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               VAL := IS_OPEN (TEST_FILE_FOUR);
+               IF VAL = TRUE THEN
+                    FAILED ("IS_OPEN GIVES TRUE AFTER ATTEMPTING " &
+                            "TO CLOSE AN UNOPENED FILE");
+               END IF;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          NULL;
+          REPORT.RESULT;
+     WHEN OTHERS =>
+          REPORT.FAILED ( "UNEXPECTED EXCEPTION" );
+          REPORT.RESULT;
+END CE2103A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103b.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103b.tst
new file mode 100644
index 000000000..2bcd7ad0b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103b.tst
@@ -0,0 +1,141 @@
+-- CE2103B.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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
+--     TYPE DIRECT_IO.
+
+--          A) UNOPENED FILES
+
+-- HISTORY:
+--     DLD 08/10/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  06/03/85
+--     SPW 08/13/87  SPLIT CASE FOR OPEN FILES INTO CE2103D.ADA.
+--     PWB 03/07/97  ADDED CHECK FOR FILE SUPPORT.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2103B IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO(CHARACTER);
+          USE DIR_IO;
+
+     TEST_FILE_ZERO : DIR_IO.FILE_TYPE;
+     TEST_FILE_ONE : DIR_IO.FILE_TYPE;
+     TEST_FILE_TWO : DIR_IO.FILE_TYPE;
+     TEST_FILE_THREE : DIR_IO.FILE_TYPE;
+     TEST_FILE_FOUR : DIR_IO.FILE_TYPE;
+     VAL : BOOLEAN;
+
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2103B", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
+                      "VALUES FOR UNOPENED FILES OF TYPE DIRECT_IO");
+
+-- FIRST TEST WHETHER IMPLEMENTATION SUPPORTS DIRECT FILES AT ALL
+
+     BEGIN
+          DIR_IO.CREATE ( TEST_FILE_ZERO,
+                          DIR_IO.OUT_FILE,
+                          REPORT.LEGAL_FILE_NAME );
+     EXCEPTION
+          WHEN DIR_IO.USE_ERROR | DIR_IO.NAME_ERROR =>
+               REPORT.NOT_APPLICABLE
+                    ( "DIRECT FILES NOT SUPPORTED -- CREATE OUT-FILE" );
+               RAISE INCOMPLETE;
+     END;
+     DIR_IO.DELETE ( TEST_FILE_ZERO );
+
+-- WHEN FILE IS DECLARED BUT NOT OPEN
+
+     BEGIN
+          VAL := TRUE;
+          VAL := IS_OPEN (TEST_FILE_ONE);
+          IF VAL = TRUE THEN
+               FAILED ("FILE NOT OPEN BUT IS_OPEN RETURNS TRUE");
+          END IF;
+     END;
+
+-- FOLLOWING UNSUCCESSFUL CREATE
+
+     BEGIN
+          VAL := TRUE;
+          CREATE (TEST_FILE_TWO, OUT_FILE,
+                  "$ILLEGAL_EXTERNAL_FILE_NAME1");
+          FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL CREATE");
+     EXCEPTION
+          WHEN NAME_ERROR =>
+               VAL := IS_OPEN (TEST_FILE_TWO);
+               IF VAL = TRUE THEN
+                    FAILED ("IS_OPEN GIVES TRUE AFTER AN " &
+                            "UNSUCCESSFUL CREATE");
+               END IF;
+     END;
+
+-- FOLLOWING UNSUCCESSFUL OPEN
+
+     BEGIN
+          VAL := TRUE;
+          OPEN (TEST_FILE_THREE, IN_FILE,
+                "$ILLEGAL_EXTERNAL_FILE_NAME2");
+          FAILED ("NAME_ERROR NOT RAISED - UNSUCCESSFUL OPEN");
+     EXCEPTION
+          WHEN NAME_ERROR =>
+               VAL := IS_OPEN (TEST_FILE_THREE);
+               IF VAL = TRUE THEN
+                    FAILED ("IS_OPEN GIVES TRUE - UNSUCCESSFUL OPEN");
+               END IF;
+     END;
+
+-- FOLLOWING CLOSING FILE THAT IS NOT OPEN
+
+     BEGIN
+          VAL := TRUE;
+          CLOSE (TEST_FILE_FOUR);
+          FAILED ("STATUS ERROR NOT RAISED WHEN ATTEMPTING " &
+                  "CLOSE AN UNOPENED FILE");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               VAL := IS_OPEN (TEST_FILE_FOUR);
+               IF VAL = TRUE THEN
+                    FAILED ("IS_OPEN GIVES TRUE AFTER ATTEMPTING " &
+                            "TO CLOSE AN UNOPENED FILE");
+               END IF;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          NULL;
+          REPORT.RESULT;
+     WHEN OTHERS =>
+          REPORT.FAILED ( "UNEXPECTED EXCEPTION" );
+          REPORT.RESULT;
+END CE2103B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103c.ada
new file mode 100644
index 000000000..2f70f3cb9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103c.ada
@@ -0,0 +1,149 @@
+-- CE2103C.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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
+--     TYPE SEQUENTIAL_IO.
+
+--          B) OPENED FILES
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     SPW 08/10/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2103C IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(CHARACTER);
+     USE SEQ_IO;
+     INCOMPLETE : EXCEPTION;
+     TEST_FILE_ONE : SEQ_IO.FILE_TYPE;
+     VAL : BOOLEAN;
+
+BEGIN
+
+     TEST ("CE2103C", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
+                      "VALUES FOR FILES OF TYPE SEQUENTIAL_IO");
+
+-- FOLLOWING A CREATE
+
+     VAL := FALSE;
+
+     BEGIN
+          CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     VAL := IS_OPEN (TEST_FILE_ONE);
+
+     IF VAL = FALSE THEN
+          FAILED ("IS_OPEN RETURNS FALSE AFTER CREATE");
+     END IF;
+
+-- FOLLOWING CLOSE
+
+     VAL := TRUE;
+     CLOSE (TEST_FILE_ONE);
+     VAL := IS_OPEN (TEST_FILE_ONE);
+     IF VAL = TRUE THEN
+          FAILED ("IS_OPEN RETURNS TRUE AFTER CLOSE");
+     END IF;
+
+-- FOLLOWING OPEN
+
+     VAL := FALSE;
+
+     BEGIN
+          OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN
+                    FAILED ("IS_OPEN GIVES TRUE ON " &
+                            "UNSUCESSFUL OPEN");
+               END IF;
+               RAISE INCOMPLETE;
+     END;
+
+     VAL := IS_OPEN (TEST_FILE_ONE);
+     IF VAL = FALSE THEN
+          FAILED ("IS_OPEN RETURNS FALSE AFTER OPEN");
+     END IF;
+
+-- AFTER RESET
+
+     VAL := FALSE;
+
+     BEGIN
+          RESET (TEST_FILE_ONE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     VAL := IS_OPEN (TEST_FILE_ONE);
+     IF VAL = FALSE THEN
+          FAILED ("IS_OPEN RETURNS FALSE AFTER RESET");
+     END IF;
+
+-- AFTER DELETE
+
+     VAL := TRUE;
+
+     BEGIN
+          DELETE (TEST_FILE_ONE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN
+                    FAILED ("IS_OPEN GIVES TRUE ON UNSUCCESSFUL " &
+                            "DELETE");
+               END IF;
+               RAISE INCOMPLETE;
+     END;
+
+     VAL := IS_OPEN (TEST_FILE_ONE);
+     IF VAL = TRUE THEN
+          FAILED ("IS_OPEN RETURNS TRUE AFTER DELETE");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2103C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103d.ada
new file mode 100644
index 000000000..691650ba3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2103d.ada
@@ -0,0 +1,148 @@
+-- CE2103D.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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
+--     TYPE DIRECT_IO.
+
+--          B) OPENED FILES
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTAIONS WHICH SUPPORT
+--     CREATION OF EXTERNAL FILES FOR DIRECT FILES.
+
+-- HISTORY:
+--     SPW 08/13/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2103D IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO(CHARACTER);
+     USE DIR_IO;
+     INCOMPLETE : EXCEPTION;
+     TEST_FILE_ONE : DIR_IO.FILE_TYPE;
+     VAL : BOOLEAN;
+
+BEGIN
+
+     TEST ("CE2103D", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
+                      "VALUES FOR FILES OF TYPE DIRECT_IO");
+
+-- FOLLOWING A CREATE
+
+     VAL := FALSE;
+
+     BEGIN
+          CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     VAL := IS_OPEN (TEST_FILE_ONE);
+     IF VAL = FALSE THEN
+          FAILED ("IS_OPEN RETURNS FALSE AFTER CREATE");
+     END IF;
+
+-- FOLLOWING CLOSE
+
+     VAL := TRUE;
+     CLOSE (TEST_FILE_ONE);
+     VAL := IS_OPEN (TEST_FILE_ONE);
+     IF VAL = TRUE THEN
+          FAILED ("IS_OPEN RETURNS TRUE AFTER CLOSE");
+     END IF;
+
+-- FOLLOWING OPEN
+
+     VAL := FALSE;
+
+     BEGIN
+          OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN
+                    FAILED ("IS_OPEN GIVES TRUE ON " &
+                            "UNSUCCESSFUL OPEN");
+               END IF;
+               RAISE INCOMPLETE;
+     END;
+
+     VAL := IS_OPEN (TEST_FILE_ONE);
+     IF VAL = FALSE THEN
+          FAILED ("IS_OPEN RETURNS FALSE AFTER OPEN");
+     END IF;
+
+-- AFTER RESET
+
+     VAL := FALSE;
+
+     BEGIN
+          RESET (TEST_FILE_ONE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     VAL := IS_OPEN (TEST_FILE_ONE);
+     IF VAL = FALSE THEN
+          FAILED ("IS_OPEN RETURNS FALSE AFTER RESET");
+     END IF;
+
+-- AFTER DELETE
+
+     VAL := TRUE;
+
+     BEGIN
+          DELETE (TEST_FILE_ONE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN
+                    FAILED ("IS_OPEN GIVES TRUE ON UNSUCCESSFUL " &
+                            "DELETE");
+               END IF;
+               RAISE INCOMPLETE;
+     END;
+
+     VAL := IS_OPEN (TEST_FILE_ONE);
+     IF VAL = TRUE THEN
+          FAILED ("IS_OPEN RETURNS TRUE AFTER DELETE");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2103D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104a.ada
new file mode 100644
index 000000000..55e3fc3fd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104a.ada
@@ -0,0 +1,118 @@
+-- CE2104A.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 FILE CAN BE CLOSED AND THEN RE-OPENED.
+
+--          A) SEQUENTIAL FILES
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE
+--     ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE.
+
+-- HISTORY:
+--     DLD 08/11/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  06/03/85
+--     SPW 08/07/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
+--                   HANDLING.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2104A IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER);
+     USE SEQ_IO;
+
+     SEQ_FILE : SEQ_IO.FILE_TYPE;
+     VAR : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2104A", "CHECK THAT A FILE CAN BE CLOSED " &
+                      "AND THEN RE-OPENED");
+
+-- INITIALIZE TEST FILE
+
+     BEGIN
+          CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+               RAISE INCOMPLETE;
+
+     END;
+
+     WRITE (SEQ_FILE, 17);
+     CLOSE (SEQ_FILE);
+
+-- RE-OPEN SEQUENTIAL TEST FILE
+
+     BEGIN
+          OPEN (SEQ_FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     READ (SEQ_FILE, VAR);
+     IF VAR /= 17 THEN
+          FAILED ("WRONG DATA RETURNED FROM READ - " &
+                  "SEQUENTIAL");
+     END IF;
+
+-- DELETE TEST FILE
+
+     BEGIN
+
+          DELETE (SEQ_FILE);
+
+     EXCEPTION
+
+          WHEN USE_ERROR =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+EXCEPTION
+
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2104A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104b.ada
new file mode 100644
index 000000000..000d00bc8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104b.ada
@@ -0,0 +1,125 @@
+-- CE2104B.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 NAME RETURNED BY NAME CAN BE USED IN A
+--     SUBSEQUENT OPEN.
+
+--          A) SEQUENTIAL FILES
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE
+--     ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE.
+
+-- HISTORY:
+--     DLD 08/11/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  05/31/85
+--     TBN 11/04/86  ADDED A RAISE INCOMPLETE STATEMENT WHEN FAILED IS
+--                   CALLED FOR OPEN OR CREATE.
+--     SPW 08/07/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
+--                   HANDLING.
+
+WITH SEQUENTIAL_IO;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CE2104B IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER);
+     USE SEQ_IO;
+     TYPE ACC_STR IS ACCESS STRING;
+
+     SEQ_FILE_ONE : SEQ_IO.FILE_TYPE;
+     SEQ_FILE_TWO : SEQ_IO.FILE_TYPE;
+     SEQ_FILE_NAME : ACC_STR;
+     VAR : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2104B", "CHECK THAT THE NAME RETURNED BY NAME " &
+                      "CAN BE USED IN A SUBSEQUENT OPEN");
+
+-- CREATE TEST FILE
+
+     BEGIN
+          CREATE(SEQ_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     WRITE (SEQ_FILE_ONE, 14);
+     SEQ_FILE_NAME := NEW STRING'(NAME(SEQ_FILE_ONE));
+     CLOSE (SEQ_FILE_ONE);
+
+-- ATTEMPT TO RE-OPEN SEQUENTIAL TEST FILE USING RETURNED NAME VALUE
+
+     BEGIN
+          OPEN (SEQ_FILE_TWO, IN_FILE, SEQ_FILE_NAME.ALL);
+     EXCEPTION
+          WHEN SEQ_IO.USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN SEQ_IO.NAME_ERROR =>
+               FAILED ("STRING NOT ACCEPTED AS NAME FOR FILE - SEQ");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("FILE NOT RE-OPENED - SEQ");
+               RAISE INCOMPLETE;
+     END;
+
+     READ (SEQ_FILE_TWO, VAR);
+     IF VAR /= 14 THEN
+          FAILED ("WRONG DATA RETURNED FROM READ -SEQ");
+     END IF;
+
+-- DELETE TEST FILE
+
+     BEGIN
+          DELETE (SEQ_FILE_TWO);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               COMMENT ("DELETION OF EXTERNAL FILE IS NOT SUPPORTED");
+     END;
+
+     RESULT;
+
+EXCEPTION
+
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2104B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada
new file mode 100644
index 000000000..840eb575f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada
@@ -0,0 +1,115 @@
+-- CE2104C.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 FILE CAN BE CLOSED AND THEN RE-OPENED.
+
+--          B) DIRECT FILES
+
+-- APPLICABLILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE
+--     ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE.
+
+-- HISTORY:
+--     DLD 08/11/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  06/03/85
+--     PWB 02/10/86  CORRECTED REPORTED TEST NAME; CHANGED DATA FILE
+--                   NAME TO "Y2104C" TO MATCH TEST NAME.
+--     SPW 08/07/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
+--                   HANDLING.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2104C IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
+     USE DIR_IO;
+
+     DIR_FILE : DIR_IO.FILE_TYPE;
+     VAR : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2104C", "CHECK THAT A FILE CAN BE CLOSED " &
+                      "AND THEN RE-OPENED");
+
+-- INITIALIZE TEST FILE
+
+     BEGIN
+          CREATE (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+               RAISE INCOMPLETE;
+
+     END;
+
+     WRITE (DIR_FILE, 28);
+     CLOSE (DIR_FILE);
+
+-- RE-OPEN DIRECT TEST FILE
+
+     BEGIN
+          OPEN (DIR_FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     READ (DIR_FILE, VAR);
+     IF VAR /= 28 THEN
+          FAILED ("WRONG DATA RETURNED FROM READ - DIRECT");
+     END IF;
+
+-- DELETE TEST FILE
+
+     BEGIN
+          DELETE (DIR_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2104C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104d.ada
new file mode 100644
index 000000000..068826da1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2104d.ada
@@ -0,0 +1,126 @@
+-- CE2104D.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 NAME RETURNED BY NAME CAN BE USED IN A
+--     SUBSEQUENT OPEN.
+
+--          B) DIRECT FILES
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE
+--     ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE.
+
+-- HISTORY:
+--     DLD 08/11/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  05/31/85
+--     TBN 11/04/86  ADDED A RAISE INCOMPLETE STATEMENT WHEN FAILED IS
+--                   CALLED FOR OPEN OR CREATE.
+--     SPW 08/07/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
+--                   HANDLING.
+
+WITH DIRECT_IO;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CE2104D IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
+     USE DIR_IO;
+     TYPE ACC_STR IS ACCESS STRING;
+
+     DIR_FILE_ONE : DIR_IO.FILE_TYPE;
+     DIR_FILE_TWO : DIR_IO.FILE_TYPE;
+     DIR_FILE_NAME : ACC_STR;
+     VAR : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2104D", "CHECK THAT THE NAME RETURNED BY NAME " &
+                      "CAN BE USED IN A SUBSEQUENT OPEN");
+
+-- CREATE TEST FILE
+
+     BEGIN
+          CREATE (DIR_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     WRITE (DIR_FILE_ONE, 3);
+     DIR_FILE_NAME := NEW STRING'(NAME(DIR_FILE_ONE));
+     CLOSE (DIR_FILE_ONE);
+
+-- ATTEMPT TO RE-OPEN DIRECT TEST FILE USING RETURNED NAME VALUE
+
+     BEGIN
+          OPEN (DIR_FILE_TWO, IN_FILE, DIR_FILE_NAME.ALL);
+     EXCEPTION
+          WHEN DIR_IO.USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN DIR_IO.NAME_ERROR =>
+               FAILED ("STRING NOT ACCEPTED AS NAME FOR FILE - DIR");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("FILE NOT RE-OPENED - DIR");
+               RAISE INCOMPLETE;
+
+     END;
+
+     READ (DIR_FILE_TWO, VAR);
+     IF VAR /= 3 THEN
+          FAILED ("WRONG DATA RETURNED FROM READ - DIR");
+     END IF;
+
+-- DELETE TEST FILE
+
+     BEGIN
+          DELETE (DIR_FILE_TWO);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               COMMENT ("DELETION OF EXTERNAL FILE IS NOT SUPPORTED");
+     END;
+
+     RESULT;
+
+EXCEPTION
+
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2104D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2106a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2106a.ada
new file mode 100644
index 000000000..0facea571
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2106a.ada
@@ -0,0 +1,122 @@
+-- CE2106A.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 AFTER A SUCCESSFUL DELETE OF AN EXTERNAL FILE, THE
+--     NAME OF THE FILE CAN BE USED IN A CREATE OPERATION.
+
+--          A) SEQUENTIAL FILES
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION WITH OUT_FILE MODE FOR SEQUENTIAL FILES AND
+--     DELETION OF EXTERNAL FILES.
+
+-- HISTORY:
+--     SPS 08/25/82
+--     SPS 11/09/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST.
+--     TBN 02/12/86  SPLIT TEST.  PUT DIRECT_IO INTO CE2106B.ADA.
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     SPW 08/07/87  INSERTED ALLOWABLE EXCEPTION USE_ERROR ON
+--                   DELETE.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2106A IS
+
+BEGIN
+
+     TEST ("CE2106A", "CHECK THAT AN EXTERNAL FILE CAN BE CREATED " &
+                      "AFTER AN EXTERNAL FILE WITH SAME NAME HAS " &
+                      "BEEN DELETED FOR SEQUENTIAL_IO");
+
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ;
+          FL1 : FILE_TYPE;
+          FL2 : FILE_TYPE;
+          T_FAILED : BOOLEAN := FALSE;
+          D_FILE : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; SEQUENTIAL " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    T_FAILED := TRUE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; SEQUENTIAL " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    T_FAILED := TRUE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " &
+                            "CREATE");
+                    T_FAILED := TRUE;
+          END;
+
+          IF NOT T_FAILED THEN
+               BEGIN
+                    DELETE (FL1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("DELETION OF EXTERNAL FILE " &
+                                         "IS NOT SUPPORTED");
+                         T_FAILED := TRUE;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                                 "DELETE");
+                         T_FAILED := TRUE;
+               END;
+          END IF;
+
+          IF NOT T_FAILED THEN
+               BEGIN
+                    CREATE (FL2, OUT_FILE, LEGAL_FILE_NAME);
+                    D_FILE := TRUE;
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         FAILED ("USE_ERROR FOR RECREATE - SEQ");
+                    WHEN OTHERS =>
+                         FAILED ("UNABLE TO RECREATE FILE AFTER " &
+                                 "DELETION - SEQ");
+               END;
+
+               IF D_FILE THEN
+                    BEGIN
+                         DELETE (FL2);
+                    EXCEPTION
+                         WHEN USE_ERROR =>
+                              FAILED ("USE_ERROR FOR DELETE - SEQ");
+                    END;
+               END IF;
+          END IF;
+     END;
+
+     RESULT;
+
+END CE2106A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2106b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2106b.ada
new file mode 100644
index 000000000..da6bc8cfe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2106b.ada
@@ -0,0 +1,119 @@
+-- CE2106B.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 AFTER A SUCCESSFUL DELETE OF AN EXTERNAL FILE, THE
+--     NAME OF THE FILE CAN BE USED IN A CREATE OPERATION.
+
+--          B) DIRECT FILES
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION WITH OUT_FILE MODE FOR DIRECT FILES AND
+--     DELETION OF EXTERNAL FILES.
+
+-- HISTORY:
+--     TBN 02/12/86
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     SPW 08/07/87  INSERTED ALLOWABLE EXCEPTION USE_ERROR ON
+--                   DELETE.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2106B IS
+BEGIN
+
+     TEST ("CE2106B", "CHECK THAT AN EXTERNAL FILE CAN BE CREATED " &
+                      "AFTER AN EXTERNAL FILE WITH SAME NAME HAS " &
+                      "BEEN DELETED FOR DIRECT_IO");
+
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+          USE DIR;
+          FL1 : FILE_TYPE;
+          FL2 : FILE_TYPE;
+          T_FAILED : BOOLEAN := FALSE;
+          D_FILE : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; DIRECT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    T_FAILED := TRUE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; DIRECT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    T_FAILED := TRUE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED; DIRECT " &
+                            "CREATE");
+                    T_FAILED := TRUE;
+          END;
+
+          IF NOT T_FAILED THEN
+               BEGIN
+                    DELETE (FL1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("DELETION OF EXTERNAL FILE " &
+                                         "IS NOT SUPPORTED");
+                         T_FAILED := TRUE;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                                 "DELETE");
+                         T_FAILED := TRUE;
+               END;
+          END IF;
+
+          IF NOT T_FAILED THEN
+               BEGIN
+                    CREATE (FL2, OUT_FILE, LEGAL_FILE_NAME);
+                    D_FILE := TRUE;
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         FAILED ("USE_ERROR FOR RECREATE - DIR");
+                    WHEN OTHERS =>
+                         FAILED ("UNABLE TO RECREATE FILE AFTER " &
+                                 "DELETION - DIR");
+               END;
+
+               IF D_FILE THEN
+                    BEGIN
+                         DELETE (FL2);
+                    EXCEPTION
+                         WHEN USE_ERROR =>
+                              FAILED ("USE_ERROR WHILE DELETING DIR " &
+                                      "FILE");
+                    END;
+               END IF;
+          END IF;
+     END;
+
+     RESULT;
+
+END CE2106B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108e.ada
new file mode 100644
index 000000000..d03dd2d3f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108e.ada
@@ -0,0 +1,83 @@
+-- CE2108E.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 EXTERNAL SEQUENTIAL FILE SPECIFIED BY A NON-NULL
+--     STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN
+--     PROGRAM.
+
+--     THIS TEST CREATES A SEQUENTIAL FILE;  CE2108F.ADA READS IT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF AN EXTERNAL SEQUENTIAL FILE WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     TBN 07/16/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2108E IS
+
+     PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
+     INCOMPLETE : EXCEPTION;
+     FILE_NAME : SEQ.FILE_TYPE;
+     PREVENT_EMPTY_FILE : NATURAL := 5;
+
+BEGIN
+
+     TEST ("CE2108E" , "CHECK THAT AN EXTERNAL SEQUENTIAL FILE " &
+                       "SPECIFIED BY A NON-NULL STRING NAME IS " &
+                       "ACCESSIBLE AFTER THE COMPLETION OF THE MAIN " &
+                       "PROGRAM");
+     BEGIN
+          BEGIN
+               SEQ.CREATE (FILE_NAME, SEQ.OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN SEQ.USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON SEQUENTIAL " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN SEQ.NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON SEQUENTIAL " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "SEQUENTIAL CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SEQ.WRITE (FILE_NAME, PREVENT_EMPTY_FILE);
+          SEQ.CLOSE (FILE_NAME);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2108E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108f.ada
new file mode 100644
index 000000000..7f88abd01
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108f.ada
@@ -0,0 +1,112 @@
+-- CE2108F.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 EXTERNAL SEQUENTIAL FILE SPECIFIED BY A NON-NULL
+--     STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN
+--     PROGRAM.
+
+--     THIS TEST CHECKS THE CREATION OF A SEQUENTIAL FILE WHICH WAS
+--     CREATED BY CE2108E.ADA.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     TBN 07/16/87  CREATED ORIGINAL TESTED.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2108F IS
+
+     PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
+     USE SEQ;
+     INCOMPLETE : EXCEPTION;
+     CHECK_SUPPORT, FILE_NAME : FILE_TYPE;
+     PREVENT_EMPTY_FILE : NATURAL := 0;
+
+BEGIN
+     TEST ("CE2108F", "CHECK THAT AN EXTERNAL SEQUENTIAL FILE " &
+                      "SPECIFIED BY A NON-NULL STRING NAME IS " &
+                      "ACCESSIBLE AFTER THE COMPLETION OF THE MAIN " &
+                      "PROGRAM");
+
+     -- TEST FOR SEQUENTIAL FILE SUPPORT.
+
+     BEGIN
+          CREATE (CHECK_SUPPORT, OUT_FILE, LEGAL_FILE_NAME);
+          BEGIN
+               DELETE (CHECK_SUPPORT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON DELETE");
+          END;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON SEQUENTIAL " &
+                               "CREATE WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON SEQUENTIAL " &
+                               "CREATE WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                       "SEQUENTIAL CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     -- BEGIN TEST OBJECTIVE.
+
+     BEGIN
+          OPEN (FILE_NAME, IN_FILE, LEGAL_FILE_NAME(1, "CE2108E"));
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN FOR " &
+                               "SEQUENTIAL FILE WITH IN_FILE " &
+                               "MODE");
+               RAISE INCOMPLETE;
+     END;
+     READ (FILE_NAME, PREVENT_EMPTY_FILE);
+     IF PREVENT_EMPTY_FILE /= 5 THEN
+          FAILED ("OPENED WRONG FILE OR DATA ERROR");
+     END IF;
+     BEGIN
+          DELETE (FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               COMMENT ("IMPLEMENTATION WOULD NOT ALLOW DELETION OF " &
+                        "EXTERNAL FILE");
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+END CE2108F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108g.ada
new file mode 100644
index 000000000..81166569d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108g.ada
@@ -0,0 +1,82 @@
+-- CE2108G.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 EXTERNAL DIRECT FILE SPECIFIED BY A NON-NULL
+--     STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN
+--     PROGRAM.
+
+--     THIS TEST CREATES A DIRECT FILE;  CE2108H.ADA READS IT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF AN EXTERNAL DIRECT FILE.
+
+-- HISTORY:
+--     TBN 07/16/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2108G IS
+
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     INCOMPLETE : EXCEPTION;
+     FILE_NAME : DIR.FILE_TYPE;
+     PREVENT_EMPTY_FILE : NATURAL := 5;
+
+BEGIN
+
+     TEST ("CE2108G", "CHECK THAT AN EXTERNAL DIRECT FILE SPECIFIED " &
+                      "BY A NON-NULL STRING NAME IS ACCESSIBLE AFTER " &
+                      "THE COMPLETION OF THE MAIN PROGRAM");
+     BEGIN
+          BEGIN
+               DIR.CREATE (FILE_NAME, DIR.OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN DIR.USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON DIRECT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN DIR.NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON DIRECT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "DIRECT CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          DIR.WRITE (FILE_NAME, PREVENT_EMPTY_FILE);
+          DIR.CLOSE (FILE_NAME);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2108G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108h.ada
new file mode 100644
index 000000000..483f23e0b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2108h.ada
@@ -0,0 +1,108 @@
+-- CE2108H.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 EXTERNAL DIRECT FILE SPECIFIED BY A NON-NULL
+--     STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN
+--     PROGRAM.
+
+--     THIS TEST CHECKS THE CREATION OF A DIRECT FILE WHICH WAS
+--     CREATED BY CE2108G.ADA.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     DIRECT FILES.
+
+-- HISTORY:
+--     TBN 07/16/87  CREATED ORIGINAL TESTED.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2108H IS
+
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     USE DIR;
+     INCOMPLETE : EXCEPTION;
+     CHECK_SUPPORT, FILE_NAME : FILE_TYPE;
+     PREVENT_EMPTY_FILE : NATURAL := 0;
+
+BEGIN
+     TEST ("CE2108H", "CHECK THAT AN EXTERNAL DIRECT FILE SPECIFIED " &
+                      "BY A NON-NULL STRING NAME IS ACCESSIBLE AFTER " &
+                      "THE COMPLETION OF THE MAIN PROGRAM");
+
+     -- TEST FOR DIRECT FILE SUPPORT.
+
+     BEGIN
+          CREATE (CHECK_SUPPORT, OUT_FILE, LEGAL_FILE_NAME);
+          BEGIN
+               DELETE (CHECK_SUPPORT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON DIRECT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON DIRECT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON DIRECT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     -- BEGIN TEST OBJECTIVE.
+
+     BEGIN
+          OPEN (FILE_NAME, IN_FILE, LEGAL_FILE_NAME(1, "CE2108G"));
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     READ (FILE_NAME, PREVENT_EMPTY_FILE);
+     IF PREVENT_EMPTY_FILE /= 5 THEN
+          FAILED ("OPENED WRONG FILE OR DATA ERROR");
+     END IF;
+     BEGIN
+          DELETE (FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               COMMENT ("IMPLEMENTATION WOULD NOT ALLOW DELETION OF " &
+                        "EXTERNAL FILE");
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+END CE2108H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2109a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2109a.ada
new file mode 100644
index 000000000..5d25a59d7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2109a.ada
@@ -0,0 +1,83 @@
+-- CE2109A.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 DEFAULT MODES IN CREATE ARE SET CORRECTLY FOR
+--     SEQUENTIAL_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH OUT_FILE MODE FOR SEQUENTIAL FILES.
+
+-- HISTORY:
+--     ABW 08/13/82
+--     SPS 11/09/82
+--     JBG 11/11/83
+--     TBN 02/13/86  SPLIT TEST.  PUT DIRECT_IO INTO CE2109B.ADA AND
+--                   TEXT_IO INTO CE2109C.ADA.
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/12/87  CHANGED NOT_APPLICABLE MESSAGE, REMOVED
+--                   NAME_ERROR, AND CLOSED THE FILE.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2109A IS
+
+     INCOMPLETE : EXCEPTION;
+     PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
+     USE SEQ;
+     FILE2 : SEQ.FILE_TYPE;
+
+BEGIN
+
+     TEST( "CE2109A", "CHECK DEFAULT MODE IN CREATE FOR SEQ_IO");
+
+     BEGIN
+          CREATE (FILE2);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                               "OUT_FILE MODE NOT SUPPORTED");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " &
+                       "CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     IF MODE (FILE2) /= OUT_FILE THEN
+          FAILED( "MODE INCORRECTLY SET FOR SEQUENTIAL_IO" );
+     END IF;
+
+     CLOSE (FILE2);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2109A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2109b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2109b.ada
new file mode 100644
index 000000000..5d17489f5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2109b.ada
@@ -0,0 +1,80 @@
+-- CE2109B.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 DEFAULT MODES IN CREATE ARE SET CORRECTLY FOR
+--     DIRECT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH INOUT_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     TBN 02/13/86
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/12/87  CHANGED NOT_APPLICABLE MESSAGE, REMOVED
+--                   NAME_ERROR, AND CLOSED THE FILE.
+--     LDC 05/26/88  CHANGED APPLICABILITY COMMENT FROM OUT_FILE TO
+--                   INOUT_FILE.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2109B IS
+
+     INCOMPLETE : EXCEPTION;
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     USE DIR;
+     FILE3 : DIR.FILE_TYPE;
+
+BEGIN
+
+     TEST( "CE2109B", "CHECK DEFAULT MODE IN CREATE FOR DIRECT_IO");
+
+     BEGIN
+          CREATE (FILE3);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("CREATE OF DIRECT FILE WITH " &
+                               "INOUT_FILE MODE NOT SUPPORTED");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; DIRECT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     IF MODE (FILE3) /= INOUT_FILE THEN
+          FAILED( "MODE INCORRECTLY SET FOR DIRECT_IO" );
+     END IF;
+
+     CLOSE (FILE3);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2109B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2109c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2109c.ada
new file mode 100644
index 000000000..9d4f3bb0a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2109c.ada
@@ -0,0 +1,76 @@
+-- CE2109C.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 DEFAULT MODES IN CREATE ARE SET CORRECTLY FOR
+--     TEXT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH OUT_FILE MODE FOR TEXT FILES.
+
+-- HISTORY:
+--     TBN 02/13/86
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/12/87  CHANGED NOT_APPLICABLE MESSAGE, REMOVED
+--                   NAME_ERROR, AND CLOSED THE FILE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE2109C IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE1 : TEXT_IO.FILE_TYPE;
+
+BEGIN
+
+     TEST( "CE2109C", "CHECK DEFAULT MODE IN CREATE FOR TEXT_IO");
+
+     BEGIN
+          CREATE (FILE1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("CREATE OF TEXT FILE WITH OUT_FILE" &
+                               "MODE NOT SUPPORTED");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     IF MODE (FILE1) /= OUT_FILE THEN
+          FAILED( "MODE INCORRECTLY SET FOR TEXT_IO" );
+     END IF;
+
+     CLOSE (FILE1);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2109C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2110a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2110a.ada
new file mode 100644
index 000000000..f71bbfe07
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2110a.ada
@@ -0,0 +1,104 @@
+-- CE2110A.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 EXTERNAL FILE CEASES TO EXIST AFTER A SUCCESSFUL
+--     DELETE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION AND DELETION OF SEQUENTIAL FILES.
+
+-- HISTORY:
+--     SPS 08/25/82
+--     SPS 11/09/82
+--     JBG 04/01/83
+--     EG  05/31/85
+--     JLH 07/21/87  ADDED A CALL TO NOT_APPLICABLE, IF EXCEPTION
+--                   USE_ERROR IS RAISED BY DELETE.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2110A IS
+BEGIN
+
+     TEST ("CE2110A", "CHECK THAT THE EXTERNAL FILE CEASES TO EXIST " &
+                      "AFTER A SUCCESSFUL DELETE");
+
+     DECLARE
+          PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ;
+          FL1, FL2 : FILE_TYPE;
+          VAR1 : INTEGER := 5;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+          BEGIN
+               CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               WRITE (FL1, VAR1);     -- THIS WRITES TO THE FILE IF IT
+          EXCEPTION                   -- CAN, NOT NECESSARY FOR THE
+               WHEN OTHERS =>         -- OBJECTIVE.
+                    NULL;
+          END;
+
+          BEGIN
+               DELETE (FL1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("DELETION OF EXTERNAL FILES NOT " &
+                                    "SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               OPEN (FL2, IN_FILE, LEGAL_FILE_NAME);
+               FAILED ("EXTERNAL FILE STILL EXISTS AFTER " &
+                       "A SUCCESSFUL DELETION - SEQ");
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NULL;
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2110A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2110c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2110c.ada
new file mode 100644
index 000000000..983657ad5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2110c.ada
@@ -0,0 +1,104 @@
+-- CE2110C.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 EXTERNAL FILE CEASES TO EXIST AFTER A SUCCESSFUL
+--     DELETE.
+
+-- APPLICABILITY CRITERIA:
+--    THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--    CREATION AND DELETION OF DIRECT FILES.
+
+-- HISTORY:
+--     SPS 08/25/82
+--     SPS 11/09/82
+--     JBG 04/01/83
+--     EG  05/31/85
+--     JLH 07/21/87  ADDED A CALL TO NOT_APPLICABLE IF EXCEPTION
+--                   USE_ERROR IS RAISED ON DELETE.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2110C IS
+BEGIN
+
+     TEST ("CE2110C", "CHECK THAT THE EXTERNAL FILE CEASES TO EXIST " &
+                      "AFTER A SUCCESSFUL DELETE");
+
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+          USE DIR;
+          FL1, FL2 : FILE_TYPE;
+          VAR1 : INTEGER := 5;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+          BEGIN
+               CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXCEPTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               WRITE (FL1, VAR1);     -- THIS WRITES TO THE FILE IF IT
+          EXCEPTION                   -- CAN, NOT NECESSARY FOR THE
+               WHEN OTHERS =>         -- OBJECTIVE.
+                    NULL;
+          END;
+
+          BEGIN
+               DELETE (FL1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("DELETION OF EXTERNAL FILE NOT " &
+                                    "SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               OPEN (FL2, IN_FILE, LEGAL_FILE_NAME);
+               FAILED ("EXTERNAL FILE STILL EXISTS AFTER " &
+                       "A SUCCESSFUL DELETION - DIR");
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NULL;
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2110C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111a.ada
new file mode 100644
index 000000000..c71591a89
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111a.ada
@@ -0,0 +1,131 @@
+-- CE2111A.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 FILE REMAINS OPEN AFTER A RESET.
+
+--     THIS OBJECTIVE IS BEING INTERPRETED AS : CHECK THAT A FILE
+--     REMAINS OPEN AFTER AN ATTEMPT TO RESET.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     DLD 08/13/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  05/28/85
+--     JLH 07/22/87  REWROTE TEST ALGORITHM.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2111A IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO(INTEGER);
+          USE SEQ_IO;
+
+     SEQ_FILE : SEQ_IO.FILE_TYPE;
+     VAR1 : INTEGER := 5;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2111A", "CHECK THAT THE FILE REMAINS OPEN AFTER A RESET");
+
+-- CREATE SEQUENTIAL TEST FILE
+
+     BEGIN
+          CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
+          WRITE (SEQ_FILE, VAR1);
+          CLOSE (SEQ_FILE);
+     EXCEPTION
+          WHEN USE_ERROR | NAME_ERROR =>
+               NOT_APPLICABLE ("SEQUENTIAL FILES NOT SUPPORTED");
+               RAISE INCOMPLETE;
+     END;
+
+-- OPEN FILE
+
+     BEGIN
+          OPEN (SEQ_FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT SUPPORTED " &
+                               "FOR SEQ_IO");
+               RAISE INCOMPLETE;
+     END;
+
+-- RESET FILE
+
+     BEGIN
+          RESET(SEQ_FILE);
+     EXCEPTION
+          WHEN USE_ERROR  =>
+               NULL;
+     END;
+
+     IF IS_OPEN (SEQ_FILE) THEN
+          CLOSE (SEQ_FILE);
+     ELSE
+          FAILED ("RESET FOR IN_FILE, CLOSED FILE");
+     END IF;
+
+-- RE-OPEN AS OUT_FILE AND REPEAT TEST
+
+     BEGIN
+          OPEN (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("OPEN WITH OUT_FILE MODE NOT " &
+                               "SUPPORTED FOR SEQ_IO");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (SEQ_FILE);
+     EXCEPTION
+          WHEN USE_ERROR  =>
+               NULL;
+     END;
+
+     IF IS_OPEN (SEQ_FILE) THEN
+          BEGIN
+               DELETE (SEQ_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+     ELSE
+          FAILED ("RESET FOR OUT_FILE, CLOSED FILE");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2111A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111b.ada
new file mode 100644
index 000000000..58ceb832c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111b.ada
@@ -0,0 +1,183 @@
+-- CE2111B.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 SUCCESSFUL RESET POSITIONS THE INDEX CORRECTLY
+--     TO THE START OF THE FILE FOR DIRECT IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     RESET FOR DIRECT FILES.
+
+-- HISTORY:
+--     DLD 08/13/82
+--     JBG 03/24/83
+--     EG  05/29/85
+--     JLH 07/23/87  ADDED CHECKS FOR USE_ERROR WHEN FILE IS RESET.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2111B IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+          USE DIR_IO;
+     TEST_FILE_ONE : DIR_IO.FILE_TYPE;
+     DATUM : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2111B", "CHECK THAT SUCCESSFUL RESETS POSITION THE " &
+                      "INDEX CORRECTLY");
+
+-- CREATE AND INITIALIZE TEST FILE
+
+     BEGIN
+          CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     WRITE (TEST_FILE_ONE, 5);
+     WRITE (TEST_FILE_ONE, 6);
+     WRITE (TEST_FILE_ONE, 7);
+     WRITE (TEST_FILE_ONE, 8);
+
+-- CHECK THAT RESET POSITIONS INDEX CORRECTLY FOR OUT_FILE
+
+     BEGIN
+          RESET (TEST_FILE_ONE);
+          IF INDEX (TEST_FILE_ONE) /= 1 THEN
+               FAILED ("RESET INCORRECTLY POSITIONED FILE FOR " &
+                       "OUT_FILE");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET NOT SUPPORTED FOR OUT_FILE");
+               RAISE INCOMPLETE;
+     END;
+
+-- WRITE MORE DATA
+
+     WRITE (TEST_FILE_ONE, 2);
+     CLOSE (TEST_FILE_ONE);
+
+-- NOW CHECK TO SEE THAT RESET WORKED FOR OUT_FILE
+
+     BEGIN
+          OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("DIR_IO NOT SUPPORTED FOR IN_FILE OPEN");
+               RAISE INCOMPLETE;
+     END;
+     READ (TEST_FILE_ONE, DATUM);
+     IF DATUM /= 2 THEN
+          FAILED ("RESET FAILED FOR OUT_FILE");
+     END IF;
+
+-- POSITION POINTER APPROPRIATELY FOR IN_FILE RESET
+
+     READ (TEST_FILE_ONE, DATUM);
+
+-- RESET IN_FILE
+
+     BEGIN
+          RESET (TEST_FILE_ONE);
+          IF INDEX (TEST_FILE_ONE) /= 1 THEN
+               FAILED ("RESET INCORRECTLY POSITIONED FILE " &
+                       "FOR IN_FILE");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET NOT SUPPORTED FOR IN_FILE");
+               RAISE INCOMPLETE;
+     END;
+
+-- VALIDATE IN_FILE RESET
+
+     READ (TEST_FILE_ONE, DATUM);
+     IF DATUM /= 2 THEN
+          FAILED ("RESET FAILED FOR IN_FILE");
+     END IF;
+
+-- VALIDATE RESET FOR IN_OUT FILE
+
+     CLOSE (TEST_FILE_ONE);
+     BEGIN
+          OPEN (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("DIR_IO NOT SUPPORTED FOR INOUT_FILE " &
+                               "OPEN");
+               RAISE INCOMPLETE;
+     END;
+
+-- WRITE NEW DATA
+
+     WRITE (TEST_FILE_ONE, 3);
+
+-- RESET INOUT_FILE
+
+     BEGIN
+          RESET (TEST_FILE_ONE);
+          IF INDEX (TEST_FILE_ONE) /= 1 THEN
+               FAILED ("RESET INCORRECTLY POSITIONED FILE " &
+                       "FOR INOUT_FILE");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET NOT SUPPORTED FOR INOUT_FILE");
+               RAISE INCOMPLETE;
+     END;
+
+-- VALIDATE RESET
+
+     READ (TEST_FILE_ONE, DATUM);
+     IF DATUM /= 3 THEN
+          FAILED ("RESET FAILED FOR INOUT_FILE");
+     END IF;
+
+-- DELETE TEST FILE
+
+     BEGIN
+          DELETE (TEST_FILE_ONE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2111B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111c.ada
new file mode 100644
index 000000000..09aff6657
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111c.ada
@@ -0,0 +1,127 @@
+-- CE2111C.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 SUPPLIED MODE PARAMETER IN A RESET CHANGES
+--     THE MODE OF A GIVEN FILE.  IF NO PARAMETER IS SUPPLIED
+--     THE MODE REMAINS THE SAME.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     RESET FOR SEQUENTIAL FILES.
+
+-- HISTORY:
+--     DLD 08/16/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  05/29/85
+--     JLH 07/23/87  ADDED CHECKS FOR USE_ERROR WHEN FILE IS RESET.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2111C IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ_IO;
+     SEQ_FILE : SEQ_IO.FILE_TYPE;
+     SEQ_MODE : SEQ_IO.FILE_MODE;
+     INCOMPLETE : EXCEPTION;
+     VAR1 : INTEGER := 5;
+
+BEGIN
+
+     TEST ("CE2111C", "CHECK THAT A SUPPLIED MODE PARAMETER SETS " &
+                      "THE MODE OF THE GIVEN FILE APPROPRIATELY");
+
+-- CREATE SEQUENTIAL TEST FILE
+
+     BEGIN
+          CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
+          WRITE (SEQ_FILE, VAR1);
+          CLOSE (SEQ_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          OPEN (SEQ_FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("SEQUENTIAL FILES WITH IN_FILE MODE " &
+                               "NOT SUPPORTED");
+               RAISE INCOMPLETE;
+     END;
+
+-- RESET TO DEFAULT
+
+     BEGIN
+          SEQ_MODE := OUT_FILE;
+          RESET (SEQ_FILE);
+          SEQ_MODE := MODE (SEQ_FILE);
+          IF SEQ_MODE /= IN_FILE THEN
+               FAILED ("DEFAULT RESET CHANGED MODE - SEQ");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET NOT SUPPORTED FOR SEQ IN_FILE " &
+                               "MODE");
+               RAISE INCOMPLETE;
+     END;
+
+-- RESET TO OUT_FILE
+
+     BEGIN
+          SEQ_MODE := IN_FILE;
+          RESET (SEQ_FILE, OUT_FILE);
+          SEQ_MODE := MODE (SEQ_FILE);
+          IF SEQ_MODE /= OUT_FILE THEN
+               FAILED ("RESET TO OUT_FILE FAILED - SEQ");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET FROM IN_FILE TO OUT_FILE MODE " &
+                               "NOT SUPPORTED FOR SEQ FILES");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          DELETE (SEQ_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2111C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111e.ada
new file mode 100644
index 000000000..57e4cb89f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111e.ada
@@ -0,0 +1,156 @@
+-- CE2111E.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 FILE REMAINS OPEN AFTER A RESET.
+
+--     THIS OBJECTIVE IS BEING INTERPRETED AS : CHECK THAT A FILE
+--     REMAINS OPEN AFTER AN ATTEMPT TO RESET.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     DIRECT FILES.
+
+-- HISTORY:
+--     DLD 08/13/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  05/28/85
+--     JLH 07/23/87  REWROTE TEST ALGORITHM.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2111E IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+          USE DIR_IO;
+
+     DIR_FILE : DIR_IO.FILE_TYPE;
+     VAR1 : INTEGER := 5;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2111E", "CHECK THAT THE FILE REMAINS OPEN AFTER A RESET");
+
+-- CREATE DIRECT TEST FILE
+
+     BEGIN
+          CREATE (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME);
+          WRITE (DIR_FILE, VAR1);
+          CLOSE (DIR_FILE);
+     EXCEPTION
+          WHEN USE_ERROR | NAME_ERROR =>
+               NOT_APPLICABLE ("DIRECT FILES NOT SUPPORTED");
+               RAISE INCOMPLETE;
+     END;
+
+-- OPEN FILE
+
+     BEGIN
+          OPEN (DIR_FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT SUPPORTED " &
+                               "FOR DIR_IO");
+               RAISE INCOMPLETE;
+     END;
+
+-- RESET FILE
+
+     BEGIN
+          RESET (DIR_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     IF IS_OPEN (DIR_FILE) THEN
+          CLOSE (DIR_FILE);
+     ELSE
+          FAILED ("RESET FOR IN_FILE, CLOSED FILE");
+     END IF;
+
+
+-- RE-OPEN AS OUT_FILE AND REPEAT TEST
+
+     BEGIN
+          OPEN (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("OPEN WITH OUT_FILE MODE NOT " &
+                               "SUPPORTED FOR DIR_IO");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (DIR_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     IF IS_OPEN (DIR_FILE) THEN
+          CLOSE (DIR_FILE);
+     ELSE
+          FAILED ("RESET FOR OUT_FILE, CLOSED FILE");
+     END IF;
+
+-- RE-OPEN AS IN_OUT FILE AND REPEAT TEST
+
+     BEGIN
+          OPEN (DIR_FILE, INOUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("OPEN WITH IN_OUT FILE MODE NOT " &
+                               "SUPPORTED FOR DIR_IO");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (DIR_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     IF IS_OPEN (DIR_FILE) THEN
+          BEGIN
+               DELETE (DIR_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+     ELSE
+          FAILED ("RESET FOR INOUT_FILE, CLOSED FILE");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2111E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111f.ada
new file mode 100644
index 000000000..1259cb894
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111f.ada
@@ -0,0 +1,132 @@
+-- CE2111F.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 SUCCESSFUL RESET POSITIONS THE FILE CORRECTLY
+--     TO THE START OF THE FILE FOR SEQUENTIAL IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     RESET FOR SEQUENTIAL FILES.
+
+-- HISTORY:
+--     JLH 08/03/87 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2111F IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ_IO;
+     TEST_FILE_ONE : SEQ_IO.FILE_TYPE;
+     DATUM : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE2111F", "CHECK THAT SUCCESSFUL RESET POSITIONS THE " &
+                      "FILE CORRECTLY");
+
+-- CREATE AND INITIALIZE TEST FILE
+
+     BEGIN
+          CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     WRITE (TEST_FILE_ONE, 5);
+     WRITE (TEST_FILE_ONE, 6);
+
+-- CHECK THAT RESET POSITIONS INDEX CORRECTLY FOR OUT_FILE
+
+     BEGIN
+          RESET (TEST_FILE_ONE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET NOT SUPPORTED FOR OUT_FILE");
+               RAISE INCOMPLETE;
+     END;
+
+-- WRITE MORE DATA
+
+     WRITE (TEST_FILE_ONE, 2);
+     CLOSE (TEST_FILE_ONE);
+
+-- NOW CHECK TO SEE THAT RESET WORKED FOR OUT_FILE
+
+     BEGIN
+          OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("SEQ_IO NOT SUPPORTED FOR IN_FILE OPEN");
+               RAISE INCOMPLETE;
+     END;
+
+     READ (TEST_FILE_ONE, DATUM);
+
+     IF DATUM /= 2 THEN
+          FAILED ("RESET INCORRECTLY POSITIONED FILE FOR OUT_FILE");
+     END IF;
+
+
+-- RESET IN_FILE
+
+     BEGIN
+          RESET (TEST_FILE_ONE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET NOT SUPPORTED FOR IN_FILE");
+               RAISE INCOMPLETE;
+     END;
+
+-- VALIDATE IN_FILE RESET
+
+     READ (TEST_FILE_ONE, DATUM);
+
+     IF DATUM /= 2 THEN
+          FAILED ("RESET INCORRECTLY POSITIONED FILE FOR IN_FILE");
+     END IF;
+
+-- DELETE TEST FILE
+
+     BEGIN
+          DELETE (TEST_FILE_ONE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2111F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111g.ada
new file mode 100644
index 000000000..c3375482f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111g.ada
@@ -0,0 +1,147 @@
+-- CE2111G.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 SUPPLIED MODE PARAMETER IN A RESET CHANGES
+--     THE MODE OF A GIVEN FILE.  IF NO PARAMETER IS SUPPLIED
+--     THE MODE REMAINS THE SAME.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     RESET FOR DIRECT FILES.
+
+-- HISTORY:
+--     DLD 08/16/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  05/29/85
+--     TBN 11/04/86  ADDED A RAISE INCOMPLETE STATEMENT WHEN FAILED
+--                   IS CALLED FOR OPEN OR CREATE.
+--     JLH 07/24/87  ADDED CHECKS FOR USE_ERR0R WHEN FILE IS RESET.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2111G IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+          USE DIR_IO;
+     DIR_FILE : DIR_IO.FILE_TYPE;
+     DIR_MODE : DIR_IO.FILE_MODE;
+     INCOMPLETE : EXCEPTION;
+     VAR1 : INTEGER := 5;
+
+BEGIN
+
+     TEST ("CE2111G", "CHECK THAT A SUPPLIED MODE PARAMETER SETS " &
+                      "THE MODE OF THE GIVEN FILE APPROPRIATELY");
+
+-- CREATE DIRECT TEST FILE
+
+     BEGIN
+          CREATE (DIR_FILE, INOUT_FILE, LEGAL_FILE_NAME);
+          WRITE (DIR_FILE, VAR1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+-- RESET TO DEFAULT
+
+     BEGIN
+          DIR_MODE := OUT_FILE;
+          RESET (DIR_FILE);
+          DIR_MODE := MODE (DIR_FILE);
+          IF DIR_MODE /= INOUT_FILE THEN
+               FAILED ("DEFAULT RESET CHANGED MODE - DIR");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET NOT SUPPORTED FOR DIR " &
+                               "INOUT_FILES");
+     END;
+
+-- RESET TO OUT_FILE
+
+     BEGIN
+          DIR_MODE := IN_FILE;
+          RESET (DIR_FILE, OUT_FILE);
+          DIR_MODE := MODE (DIR_FILE);
+          IF DIR_MODE /= OUT_FILE THEN
+               FAILED ("RESET TO OUT_FILE FAILED - DIR");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET FROM INOUT_FILE TO OUT_FILE " &
+                               "NOT SUPPORTED FOR DIR FILES");
+     END;
+
+-- RESET TO IN_FILE
+
+     BEGIN
+          DIR_MODE := OUT_FILE;
+          RESET (DIR_FILE, IN_FILE);
+          DIR_MODE := MODE (DIR_FILE);
+          IF DIR_MODE /= IN_FILE THEN
+               FAILED ("RESET TO IN_FILE FAILED - DIR");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE NOT " &
+                               "SUPPORTED FOR DIR IN_FILE");
+     END;
+
+-- RESET TO INOUT_FILE
+
+     BEGIN
+          DIR_MODE := OUT_FILE;
+          RESET (DIR_FILE, INOUT_FILE);
+          DIR_MODE := MODE (DIR_FILE);
+          IF DIR_MODE /= INOUT_FILE THEN
+               FAILED ("RESET TO INOUT_FILE FAILED - DIR");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET FROM IN_FILE TO INOUT_FILE NOT " &
+                               "SUPPORTED FOR DIR INOUT_FILES");
+     END;
+
+     BEGIN
+          DELETE (DIR_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2111G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111i.ada
new file mode 100644
index 000000000..d9367f5ad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2111i.ada
@@ -0,0 +1,113 @@
+-- CE2111I.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 SUPPLIED MODE PARAMETER IN A RESET CHANGES
+--     THE MODE OF A GIVEN FILE.  IF NO PARAMETER IS SUPPLIED
+--     THE MODE REMAINS THE SAME.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     RESET FOR SEQUENTIAL FILES.
+
+-- HISTORY:
+--     JLH 07/23/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2111I IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ_IO;
+     SEQ_FILE : SEQ_IO.FILE_TYPE;
+     SEQ_MODE : SEQ_IO.FILE_MODE;
+     INCOMPLETE : EXCEPTION;
+     VAR1 : INTEGER := 5;
+
+BEGIN
+
+     TEST("CE2111I", "CHECK THAT A SUPPLIED MODE PARAMETER SETS " &
+                     "THE MODE OF THE GIVEN FILE APPROPRIATELY");
+
+-- CREATE SEQUENTIAL TEST FILE
+
+     BEGIN
+          CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
+          WRITE (SEQ_FILE, VAR1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+-- RESET TO DEFAULT
+
+     BEGIN
+          SEQ_MODE := IN_FILE;
+          RESET (SEQ_FILE);
+          SEQ_MODE := MODE (SEQ_FILE);
+          IF SEQ_MODE /= OUT_FILE THEN
+               FAILED ("DEFAULT RESET CHANGED MODE - SEQ");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET NOT SUPPORTED FOR SEQ OUT_FILE " &
+                               "MODE");
+               RAISE INCOMPLETE;
+     END;
+
+-- RESET TO IN_FILE
+
+     BEGIN
+          SEQ_MODE := OUT_FILE;
+          RESET (SEQ_FILE, IN_FILE);
+          SEQ_MODE := MODE (SEQ_FILE);
+          IF SEQ_MODE /= IN_FILE THEN
+               FAILED ("RESET TO IN_FILE FAILED - SEQ");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE MODE " &
+                               "NOT SUPPORTED FOR SEQ FILES");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          DELETE (SEQ_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2111I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201a.ada
new file mode 100644
index 000000000..85c188fac
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201a.ada
@@ -0,0 +1,112 @@
+-- CE2201A.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH ELEMENT_TYPE STRING.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     ABW 08/16/82
+--     SPS 11/09/82
+--     JBG 01/05/83
+--     JBG 02/22/84  CHANGED TO .ADA TEST.
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 07/28/87  REMOVED DEPENDENCE ON SUPPORT OF RESET.
+
+WITH REPORT;
+USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201A IS
+
+BEGIN
+
+     TEST ("CE2201A", "CHECK THAT READ, WRITE, AND " &
+                      "END_OF_FILE ARE SUPPORTED FOR " &
+                      "SEQUENTIAL FILES - STRING TYPE");
+
+     DECLARE
+          SUBTYPE STRNG IS STRING (1..12);
+          PACKAGE SEQ_STR IS NEW SEQUENTIAL_IO (STRNG);
+          USE SEQ_STR;
+          FILE_STR : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          STR : STRNG := "TEXT OF FILE";
+          ITEM_STR : STRNG;
+     BEGIN
+          BEGIN
+               CREATE (FILE_STR, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_STR, STR);
+          CLOSE (FILE_STR);
+
+          BEGIN
+               OPEN (FILE_STR, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_STR) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR TYPE STRING");
+          END IF;
+
+          READ (FILE => FILE_STR, ITEM => ITEM_STR);
+
+          IF ITEM_STR /= STRNG (IDENT_STR("TEXT OF FILE")) THEN
+               FAILED ("READ WRONG VALUE - STRING");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE_STR) THEN
+               FAILED ("END OF FILE NOT TRUE - STRING");
+          END IF;
+
+          BEGIN
+               DELETE (FILE_STR);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2201A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201b.ada
new file mode 100644
index 000000000..151f88663
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201b.ada
@@ -0,0 +1,116 @@
+-- CE2201B.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED ARRAY.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED ARRAY.
+
+-- HISTORY:
+--     ABW 08/17/82
+--     SPS 09/15/82
+--     SPS 11/09/82
+--     JBG 05/02/83
+--     EG  05/08/85
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 07/28/87  REMOVED THE DEPENDENCE OF RESET BEING SUPPORTED
+--                   AND CREATED EXTERNAL FILES RATHER THAN TEMPORARY
+--                   FILES.
+
+WITH REPORT;
+USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201B IS
+
+BEGIN
+
+     TEST ("CE2201B", "CHECK THAT READ, WRITE, AND " &
+                      "END_OF_FILE ARE SUPPORTED FOR " &
+                      "SEQUENTIAL FILES - CONSTRAINED ARRAY");
+
+     DECLARE
+          TYPE ARR_CN IS ARRAY (1..5) OF BOOLEAN;
+          PACKAGE SEQ_ARR_CN IS NEW SEQUENTIAL_IO (ARR_CN);
+          USE SEQ_ARR_CN;
+          FILE_ARR_CN : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          ARR1 : ARR_CN := (TRUE,TRUE,FALSE,TRUE,TRUE);
+          ITEM_ARR1 : ARR_CN;
+     BEGIN
+          BEGIN
+               CREATE (FILE_ARR_CN, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_ARR_CN, ARR1);
+          CLOSE (FILE_ARR_CN);
+
+          BEGIN
+               OPEN (FILE_ARR_CN, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_ARR_CN) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR " &
+                       "CONSTRAINED ARRAY");
+          END IF;
+
+          READ (FILE_ARR_CN, ITEM_ARR1);
+
+          IF ITEM_ARR1 /= ARR1 THEN
+               FAILED ("READ WRONG VALUE - CONSTRAINED ARRAY");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE_ARR_CN) THEN
+               FAILED ("END OF FILE NOT TRUE - CONSTRAINED ARRAY");
+          END IF;
+
+          BEGIN
+               DELETE  (FILE_ARR_CN);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2201B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201c.ada
new file mode 100644
index 000000000..44516b172
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201c.ada
@@ -0,0 +1,111 @@
+-- CE2201C.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH ELEMENT_TYPE FLOAT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     ABW 08/17/82
+--     SPS 11/10/82
+--     JBG 20/22/84  CHANGED TO .ADA TEST.
+--     EG  05/16/85
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/03/87  REMOVED DEPENDENCE OF RESET AND CREATED AN EXTERNAL
+--                   FILE RATHER THAN A TEMPORARY FILE.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201C IS
+BEGIN
+
+     TEST ("CE2201C", "CHECK THAT READ, WRITE, AND " &
+                      "END_OF_FILE ARE SUPPORTED FOR " &
+                      "SEQUENTIAL FILES - FLOAT");
+
+     DECLARE
+          PACKAGE SEQ_FLT IS NEW SEQUENTIAL_IO (FLOAT);
+          USE SEQ_FLT;
+          FILE_FLT : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          FLT : FLOAT := 65.0;
+          ITEM_FLT : FLOAT;
+     BEGIN
+          BEGIN
+               CREATE (FILE_FLT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_FLT, FLT);
+          CLOSE (FILE_FLT);
+
+          BEGIN
+               OPEN (FILE_FLT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_FLT) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR FLOATING POINT");
+          END IF;
+
+          READ (FILE_FLT, ITEM_FLT);
+
+          IF ITEM_FLT /= 65.0 THEN
+               FAILED ("READ WRONG VALUE - FLOAT");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE_FLT) THEN
+               FAILED ("END OF FILE NOT TRUE - FLOAT");
+          END IF;
+
+          BEGIN
+               DELETE (FILE_FLT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE2201C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201d.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201d.dep
new file mode 100644
index 000000000..fdbe40e59
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201d.dep
@@ -0,0 +1,145 @@
+-- CE2201D.DEP
+
+--                             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 WHETHER READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH ELEMENT_TYPE UNCONSTRAINED ARRAY.
+
+--     IF I/O IS NOT SUPPORTED, THEN CREATE AND OPEN CAN RAISE USE_ERROR
+--     OR NAME_ERROR. SEE (AI-00332).
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS NON-APPLICABLE IF THE INSTANTIATION OF SEQUENTIAL_IO
+--     WITH UNCONSTRAINED ARRAY TYPE, ARR_UNCN, IS NOT SUPPORTED.
+
+--     IF THE INSTANTIATION OF SEQUENTIAL_IO IS NOT SUPPORTED THEN
+--     THE INSTANTIATION MUST BE REJECTED.
+
+-- HISTORY:
+--     ABW  8/17/82
+--     SPS 9/15/82
+--     SPS 11/9/82
+--     JBG 1/6/83
+--     JBG 6/4/84
+--     TBN 11/01/85     RENAMED FROM CE2201D.DEP AND MODIFIED COMMENTS.
+--     TBN 11/04/86     REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                      RESULT WHEN FILES ARE NOT SUPPORTED.
+--     THS 03/30/90     RENAMED FROM EE2201D.ADA.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201D IS
+     INCOMPLETE : EXCEPTION;
+BEGIN
+
+     TEST ("CE2201D" , "CHECK WHETHER READ, WRITE, AND END_OF_FILE " &
+                       "ARE SUPPORTED FOR SEQUENTIAL FILES WITH " &
+                       "UNCONSTRAINED ARRAY TYPES");
+
+     DECLARE
+          SUBTYPE ONE_TEN IS INTEGER RANGE 1..10;
+          TYPE ARR_UNCN IS ARRAY (ONE_TEN RANGE <>) OF INTEGER;
+          PACKAGE SEQ_ARR_UNCN
+               IS NEW SEQUENTIAL_IO (ARR_UNCN); -- N/A => ERROR.
+          USE SEQ_ARR_UNCN;
+          FILE_ARR_UNCN : FILE_TYPE;
+          ARR2 : ARR_UNCN (1..6) := (1,3,5,7,9,0);
+          ITEM_ARR2 : ARR_UNCN (1..6);
+     BEGIN
+          BEGIN
+               CREATE (FILE_ARR_UNCN);
+
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; SEQUENTIAL " &
+                                    "CREATE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; SEQUENTIAL " &
+                                    "CREATE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               WRITE (FILE_ARR_UNCN,ARR2);
+               WRITE (FILE_ARR_UNCN, (0, -2));
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRITE FOR UNCONSTRAINED ARRAY");
+          END;
+
+          RESET (FILE_ARR_UNCN,IN_FILE);
+
+          IF END_OF_FILE (FILE_ARR_UNCN) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR " &
+                       "UNCONSTRAINED ARRAY");
+          END IF;
+
+          BEGIN
+               READ (FILE_ARR_UNCN,ITEM_ARR2);
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("READ FOR UNCONSTRAINED ARRAY");
+          END;
+
+          IF ITEM_ARR2 /= (1,3,5,7,9,0) THEN
+               FAILED ("READ WRONG VALUE - 1");
+          END IF;
+
+          BEGIN
+               READ (FILE_ARR_UNCN, ITEM_ARR2(3..4));
+
+               IF ITEM_ARR2 /= (1,3,0,-2,9,0) THEN
+                    FAILED ("READ WRONG VALUE - 2");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION FOR SECOND ARRAY READ");
+          END;
+
+          IF NOT END_OF_FILE(FILE_ARR_UNCN) THEN
+               FAILED ("NOT AT END OF FILE");
+          END IF;
+
+          CLOSE (FILE_ARR_UNCN);
+
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED BY RESET");
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2201D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201e.dep b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201e.dep
new file mode 100644
index 000000000..2ee9578dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201e.dep
@@ -0,0 +1,155 @@
+-- CE2201E.DEP
+
+--                             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 WHETHER READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH VARIANT RECORDS WITH NON-DEFAULT
+--     DISCRIMINANTS.
+
+--     IF I/O IS NOT SUPPORTED, THEN CREATE AND OPEN CAN RAISE USE_ERROR
+--     OR NAME_ERROR. SEE (AI-00332).
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS NON-APPLICABLE IF THE INSTANTIATION OF
+--     SEQUENTIAL_IO WITH VARIANT RECORDS HAVING NO DEFAULT
+--     DISCRIMINANT VALUES IS REJECTED.
+
+-- HISTORY:
+--     JBG 1/6/83
+--     JBG 5/2/83
+--     TBN 11/18/85     RENAMED FROM CE2201E.DEP AND MODIFIED COMMENTS.
+--                      SPLIT DEFAULT DISCRIMINANT CASE INTO
+--                      CE2201G.ADA.
+--     TBN 11/04/86     REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                      RESULT WHEN FILES ARE NOT SUPPORTED.
+--     THS 03/30/90     RENAMED FROM EE2201E.ADA.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201E IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2201E", "CHECK WHETHER READ, WRITE, AND END_OF_FILE " &
+                      "ARE SUPPORTED FOR SEQUENTIAL FILES WITH " &
+                      "UNCONSTRAINED VARIANT RECORD TYPES WITH " &
+                      "NON-DEFAULT DISCRIMINANTS.");
+
+     DECLARE
+          TYPE VAR_REC (DISCR : BOOLEAN) IS
+               RECORD
+                    CASE DISCR IS
+                         WHEN TRUE =>
+                              A : INTEGER;
+                         WHEN FALSE =>
+                              B : STRING (1..20);
+                    END CASE;
+               END RECORD;
+
+          PACKAGE SEQ_VAR_REC
+               IS NEW SEQUENTIAL_IO (VAR_REC);  -- N/A => ERROR.
+          USE SEQ_VAR_REC;
+
+          FILE_VAR_REC : FILE_TYPE;
+          ITEM_TRUE  : VAR_REC(TRUE);
+          ITEM_FALSE : VAR_REC(FALSE);
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE_VAR_REC);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; SEQUENTIAL " &
+                                    "CREATE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; SEQUENTIAL " &
+                                    "CREATE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED; SEQUENTIAL " &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               WRITE (FILE_VAR_REC, (TRUE, -6));
+               WRITE (FILE_VAR_REC, (FALSE, (1..20 => 'C')));
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("WRITE FOR RECORD WITH DISCRIMINANT");
+          END;
+
+          BEGIN
+               RESET (FILE_VAR_REC,IN_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR FOR RESET");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_VAR_REC) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR RECORD" &
+                       "WITH DISCRIMINANT");
+          END IF;
+
+          BEGIN
+               READ (FILE_VAR_REC,ITEM_TRUE);
+
+               IF ITEM_TRUE /= (TRUE, IDENT_INT(-6)) THEN
+                    FAILED ("READ WRONG VALUE - 1");
+               END IF;
+
+               IF END_OF_FILE (FILE_VAR_REC) THEN
+                    FAILED ("PREMATURE END OF FILE");
+               END IF;
+
+               READ (FILE_VAR_REC, ITEM_FALSE);
+
+               IF ITEM_FALSE /= (FALSE, (1..IDENT_INT(20) => 'C')) THEN
+                    FAILED ("READ WRONG VALUE - 2");
+               END IF;
+
+               IF NOT END_OF_FILE(FILE_VAR_REC) THEN
+                    FAILED ("NOT AT END OF FILE");
+               END IF;
+
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("READ FOR VARIANT RECORD");
+          END;
+
+          CLOSE (FILE_VAR_REC);
+
+     END;
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2201E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201f.ada
new file mode 100644
index 000000000..7baa401e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201f.ada
@@ -0,0 +1,129 @@
+-- CE2201F.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--      SEQUENTIAL FILES WITH PRIVATE ELEMENT_TYPES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES WITH PRIVATE ELEMENT_TYPES.
+
+-- HISTORY:
+--     ABW 08/17/82
+--     SPS 09/15/82
+--     SPS 11/09/82
+--     JBG 01/06/83
+--     JBG 02/22/84  CHANGED TO .ADA TEST.
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/03/87  REMOVED DEPENDENCE OF RESET AND CREATED EXTERNAL
+--                   FILES RATHER THAN TEMPORARY FILES.
+
+WITH REPORT;
+USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201F IS
+
+     PACKAGE PKG IS
+          TYPE PRIV IS PRIVATE;
+          FUNCTION MAKE_PRIV (X : INTEGER) RETURN PRIV;
+     PRIVATE
+          TYPE PRIV IS NEW INTEGER;
+     END PKG;
+     USE PKG;
+
+     PACKAGE BODY PKG IS
+          FUNCTION MAKE_PRIV (X : INTEGER) RETURN PRIV IS
+          BEGIN
+               RETURN PRIV(X);
+          END;
+     END PKG;
+
+BEGIN
+
+     TEST ("CE2201F", "CHECK THAT READ, WRITE, AND " &
+                      "END_OF_FILE ARE SUPPORTED FOR " &
+                      "SEQUENTIAL FILES FOR PRIVATE TYPES");
+
+     DECLARE
+          PACKAGE SEQ_PRV IS NEW SEQUENTIAL_IO (PRIV);
+          USE SEQ_PRV;
+          PRV, ITEM_PRV : PRIV;
+          FILE_PRV : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+          BEGIN
+               CREATE (FILE_PRV, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          PRV := MAKE_PRIV(IDENT_INT(26));
+
+          WRITE (FILE_PRV, PRV);
+          CLOSE (FILE_PRV);
+
+          BEGIN
+               OPEN (FILE_PRV, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_PRV) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR PRIVATE TYPE");
+          END IF;
+
+          READ (FILE_PRV, ITEM_PRV);
+
+          IF ITEM_PRV /= MAKE_PRIV (26) THEN
+               FAILED ("READ WRONG VALUE");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE_PRV) THEN
+               FAILED ("NOT AT END OF FILE");
+          END IF;
+
+          BEGIN
+               DELETE (FILE_PRV);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2201F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201g.ada
new file mode 100644
index 000000000..cb8a528d7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201g.ada
@@ -0,0 +1,138 @@
+-- CE2201G.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED
+--      FOR SEQUENTIAL FILES WITH VARIANT RECORDS WITH DEFAULT
+--      DISCRIMINANTS.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     TBN 05/15/86
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/03/87  REMOVED DEPENDENCE OF RESET AND CREATED EXTERNAL
+--                   FILES RATHER THAN TEMPORARY FILES.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201G IS
+
+BEGIN
+
+     TEST ("CE2201G", "CHECK THAT READ, WRITE, AND END_OF_FILE " &
+                      "ARE SUPPORTED FOR SEQUENTIAL FILES WITH " &
+                      "UNCONSTRAINED VARIANT RECORD TYPES WITH " &
+                      "DEFAULT DISCRIMINANTS.");
+
+     DECLARE
+          TYPE VAR_REC (DISCR : BOOLEAN := TRUE) IS
+               RECORD
+                    CASE DISCR IS
+                         WHEN TRUE =>
+                              A : INTEGER;
+                         WHEN FALSE =>
+                              B : STRING (1..20);
+                    END CASE;
+               END RECORD;
+
+          PACKAGE SEQ_VAR_REC IS NEW SEQUENTIAL_IO (VAR_REC);
+          USE SEQ_VAR_REC;
+
+          FILE_VAR_REC : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          ITEM_TRUE : VAR_REC(TRUE);     -- CONSTRAINED
+          ITEM      : VAR_REC;           -- UNCONSTRAINED
+
+     BEGIN
+          BEGIN
+               CREATE (FILE_VAR_REC, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_VAR_REC, (TRUE, -5));
+          WRITE (FILE_VAR_REC, (FALSE, (1..20 => 'B')));
+          CLOSE (FILE_VAR_REC);
+
+          BEGIN
+               OPEN (FILE_VAR_REC, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_VAR_REC) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR RECORD" &
+                       "WITH DISCRIMINANT");
+          END IF;
+
+          BEGIN
+               READ (FILE_VAR_REC, ITEM_TRUE);
+
+               IF ITEM_TRUE /= (TRUE, IDENT_INT(-5)) THEN
+                    FAILED ("READ WRONG VALUE - 1");
+               END IF;
+
+               IF END_OF_FILE (FILE_VAR_REC) THEN
+                    FAILED ("PREMATURE END OF FILE");
+               END IF;
+
+               READ (FILE_VAR_REC, ITEM);
+
+               IF ITEM /= (FALSE, (1..IDENT_INT(20) => 'B')) THEN
+                    FAILED ("READ WRONG VALUE - 2");
+               END IF;
+
+               IF NOT END_OF_FILE(FILE_VAR_REC) THEN
+                    FAILED ("NOT AT END OF FILE");
+               END IF;
+
+          END;
+
+          BEGIN
+               DELETE (FILE_VAR_REC);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE2201G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201h.ada
new file mode 100644
index 000000000..03705c8d6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201h.ada
@@ -0,0 +1,105 @@
+-- CE2201H.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH ELEMENT TYPE INTEGER.
+
+-- APPLICABILITY:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES WITH ELEMENT TYPE INTEGER.
+
+-- HISTORY:
+--     JLH 07/28/87 CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201H IS
+
+BEGIN
+
+     TEST ("CE2201H" , "CHECK THAT READ, WRITE, AND " &
+                       "END_OF_FILE ARE SUPPORTED FOR " &
+                       "SEQUENTIAL FILES - INTEGER TYPE");
+
+     DECLARE
+          PACKAGE SEQ_INT IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ_INT;
+          FILE_INT : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          INT : INTEGER := IDENT_INT (33);
+          ITEM_INT : INTEGER;
+     BEGIN
+          BEGIN
+               CREATE (FILE_INT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_INT, INT);
+          CLOSE (FILE_INT);
+
+          BEGIN
+               OPEN (FILE_INT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_INT) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR TYPE INTEGER");
+          END IF;
+
+          READ (FILE_INT, ITEM_INT);
+
+          IF ITEM_INT /= IDENT_INT(33) THEN
+               FAILED ("READ WRONG VALUE - INTEGER");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE_INT) THEN
+               FAILED ("END OF FILE NOT TRUE - INTEGER");
+          END IF;
+
+          BEGIN
+               DELETE (FILE_INT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2201H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201i.ada
new file mode 100644
index 000000000..e3e6e6037
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201i.ada
@@ -0,0 +1,105 @@
+-- CE2201I.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH ELEMENT TYPE BOOLEAN.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     JLH 07/28/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201I IS
+
+BEGIN
+
+     TEST ("CE2201I", "CHECK THAT READ, WRITE, AND " &
+                      "END_OF_FILE ARE SUPPORTED FOR " &
+                      "SEQUENTIAL FILES - BOOLEAN TYPE");
+
+     DECLARE
+          PACKAGE SEQ_BOOL IS NEW SEQUENTIAL_IO (BOOLEAN);
+          USE SEQ_BOOL;
+          FILE_BOOL : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          BOOL : BOOLEAN := IDENT_BOOL (TRUE);
+          ITEM_BOOL : BOOLEAN;
+     BEGIN
+          BEGIN
+               CREATE (FILE_BOOL, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_BOOL, BOOL);
+          CLOSE (FILE_BOOL);
+
+          BEGIN
+               OPEN (FILE_BOOL, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_BOOL) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR TYPE BOOLEAN");
+          END IF;
+
+          READ (FILE_BOOL, BOOL);
+
+          IF BOOL /= IDENT_BOOL (TRUE) THEN
+               FAILED ("READ WRONG VALUE - BOOLEAN");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE_BOOL) THEN
+               FAILED ("END OF FILE NOT TRUE - BOOLEAN");
+          END IF;
+
+          BEGIN
+               DELETE (FILE_BOOL);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2201I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201j.ada
new file mode 100644
index 000000000..060909c4a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201j.ada
@@ -0,0 +1,106 @@
+-- CE2201J.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH ELEMENT TYPE ENUMERATION.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     JLH 07/28/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201J IS
+
+BEGIN
+
+     TEST ("CE2201J", "CHECK THAT READ, WRITE, AND " &
+                      "END_OF_FILE ARE SUPPORTED FOR " &
+                      "SEQUENTIAL FILES - ENUMERATION TYPE");
+
+     DECLARE
+          TYPE ENUMERATION IS (ONE, TWO, '4');
+          PACKAGE SEQ_ENUM IS NEW SEQUENTIAL_IO (ENUMERATION);
+          USE SEQ_ENUM;
+          FILE_ENUM : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          ENUM : ENUMERATION := ('4');
+          ITEM_ENUM : ENUMERATION;
+     BEGIN
+          BEGIN
+               CREATE (FILE_ENUM, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_ENUM, ENUM);
+          CLOSE (FILE_ENUM);
+
+          BEGIN
+               OPEN (FILE_ENUM, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_ENUM) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR TYPE ENUMERATION");
+          END IF;
+
+          READ (FILE_ENUM, ITEM_ENUM);
+
+          IF ITEM_ENUM /= '4' THEN
+               FAILED ("READ WRONG VALUE - ENUMERATION");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE_ENUM) THEN
+               FAILED ("END OF FILE NOT TRUE - ENUMERATION");
+          END IF;
+
+          BEGIN
+               DELETE (FILE_ENUM);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2201J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201k.ada
new file mode 100644
index 000000000..a372ad602
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201k.ada
@@ -0,0 +1,102 @@
+-- CE2201K.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH ELEMENT TYPE ACCESS.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     JLH 07/28/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201K IS
+
+BEGIN
+
+     TEST ("CE2201K", "CHECK THAT READ, WRITE, AND " &
+                      "END_OF_FILE ARE SUPPORTED FOR " &
+                      "SEQUENTIAL FILES - ACCESS TYPE");
+
+     DECLARE
+          TYPE ACC_INT IS ACCESS INTEGER;
+          PACKAGE SEQ_ACC IS NEW SEQUENTIAL_IO (ACC_INT);
+          USE SEQ_ACC;
+          FILE_ACC : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          ACC : ACC_INT := NEW INTEGER'(33);
+          ITEM_ACC : ACC_INT;
+     BEGIN
+          BEGIN
+               CREATE (FILE_ACC, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_ACC, ACC);
+          CLOSE (FILE_ACC);
+
+          BEGIN
+               OPEN (FILE_ACC, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_ACC) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR TYPE ACCESS");
+          END IF;
+
+          READ (FILE_ACC, ITEM_ACC);
+
+          IF NOT END_OF_FILE (FILE_ACC) THEN
+               FAILED ("END OF FILE NOT TRUE - ACCESS");
+          END IF;
+
+          BEGIN
+               DELETE (FILE_ACC);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2201K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201l.ada
new file mode 100644
index 000000000..15af84035
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201l.ada
@@ -0,0 +1,103 @@
+-- CE2201L.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH ELEMENT TYPE FIXED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     JLH 08/03/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201L IS
+BEGIN
+
+     TEST ("CE2201L", "CHECK THAT READ, WRITE, AND END_OF_FILE " &
+                      "ARE SUPPORTED FOR SEQUENTIAL FILES - FIXED");
+
+     DECLARE
+          TYPE FIX IS DELTA 0.5 RANGE -10.0 .. 255.0;
+          PACKAGE SEQ_FIX IS NEW SEQUENTIAL_IO (FIX);
+          USE SEQ_FIX;
+          FILE_FIX : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          FX : FIX := -8.5;
+          ITEM_FIX : FIX;
+     BEGIN
+          BEGIN
+               CREATE (FILE_FIX, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_FIX, FX);
+          CLOSE (FILE_FIX);
+
+          BEGIN
+               OPEN (FILE_FIX, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_FIX) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR FIXED POINT");
+          END IF;
+
+          READ (FILE_FIX, ITEM_FIX);
+
+          IF NOT END_OF_FILE (FILE_FIX) THEN
+               FAILED ("END OF FILE NOT TRUE - FIXED");
+          END IF;
+
+          IF ITEM_FIX /= -8.5 THEN
+               FAILED ("READ WRONG VALUE - STRING");
+          END IF;
+
+          BEGIN
+               DELETE (FILE_FIX);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2201L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201m.ada
new file mode 100644
index 000000000..cf32381bf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201m.ada
@@ -0,0 +1,123 @@
+-- CE2201M.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED
+--     FOR SEQUENTIAL FILES WITH ELEMENT_TYPE RECORD WITHOUT
+--     DISCRIMINANTS.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT SEQUENTIAL FILES WITH ELEMENT_TYPE RECORD WITHOUT
+--     DISCRIMINANTS.
+
+-- HISTORY:
+--     ABW 08/17/82
+--     SPS 09/15/82
+--     SPS 11/09/82
+--     JBG 05/02/83
+--     EG  05/08/85
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 07/28/87  REMOVED THE DEPENDENCE OF RESET BEING SUPPORTED
+--                   AND CREATED EXTERNAL FILES RATHER THAN TEMPORARY
+--                   FILES.
+
+WITH REPORT;
+USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201M IS
+
+BEGIN
+
+     TEST ("CE2201M", "CHECK THAT READ, WRITE, AND " &
+                      "END_OF_FILE ARE SUPPORTED FOR " &
+                      "SEQUENTIAL FILES - RECORD WITHOUT " &
+                      "DISCRIMINANTS");
+
+     DECLARE
+          TYPE REC IS
+               RECORD
+                    ONE : INTEGER;
+                    TWO : INTEGER;
+               END RECORD;
+          PACKAGE SEQ_REC IS NEW SEQUENTIAL_IO (REC);
+          USE SEQ_REC;
+          FILE_REC : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          REC1 : REC := (ONE=>18, TWO=>36);
+          ITEM_REC1 : REC;
+     BEGIN
+
+          BEGIN
+               CREATE (FILE_REC, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_REC, REC1);
+          CLOSE (FILE_REC);
+
+          BEGIN
+               OPEN (FILE_REC, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_REC) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR TYPE RECORD");
+          END IF;
+
+          READ (FILE_REC, ITEM_REC1);
+
+          IF ITEM_REC1 /= (18, IDENT_INT(36)) THEN
+               FAILED ("READ WRONG VALUE - RECORD");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE_REC) THEN
+               FAILED ("END OF FILE NOT TRUE - RECORD");
+          END IF;
+
+          BEGIN
+               DELETE (FILE_REC);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2201M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201n.ada
new file mode 100644
index 000000000..2eaa296e2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2201n.ada
@@ -0,0 +1,123 @@
+-- CE2201N.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 READ, WRITE, AND END_OF_FILE ARE SUPPORTED FOR
+--     SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED RECORD TYPES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES WITH ELEMENT_TYPE CONSTRAINED RECORD TYPES.
+
+-- HISTORY:
+--     ABW 08/17/82
+--     SPS 09/15/82
+--     SPS 11/09/82
+--     JBG 05/02/83
+--     EG  05/08/85
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 07/28/87  REMOVED THE DEPENDENCE OF RESET BEING SUPPORTED
+--                   AND CREATED EXTERNAL FILES RATHER THAN TEMPORARY
+--                   FILES.
+
+WITH REPORT;
+USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2201N IS
+
+BEGIN
+
+     TEST ("CE2201N", "CHECK THAT READ, WRITE, AND " &
+                      "END_OF_FILE ARE SUPPORTED FOR " &
+                      "SEQUENTIAL FILES - CONSTRAINED RECORDS");
+
+     DECLARE
+          TYPE REC_DEF (DISCR : INTEGER := 18) IS
+               RECORD
+                    ONE : INTEGER := 1;
+                    TWO : INTEGER := 2;
+                    THREE : INTEGER := 17;
+                    FOUR : INTEGER := 2;
+               END RECORD;
+          SUBTYPE REC_DEF_2 IS REC_DEF(2);
+          PACKAGE SEQ_REC_DEF IS NEW SEQUENTIAL_IO (REC_DEF_2);
+          USE SEQ_REC_DEF;
+          FILE_REC_DEF : FILE_TYPE;
+          INCOMPLETE : EXCEPTION;
+          REC3 : REC_DEF(2);
+          ITEM_REC3 : REC_DEF(2);
+     BEGIN
+          BEGIN
+               CREATE (FILE_REC_DEF, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE OF SEQUENTIAL FILE WITH " &
+                                    "MODE OUT_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE_REC_DEF, REC3);
+          CLOSE (FILE_REC_DEF);
+
+          BEGIN
+               OPEN (FILE_REC_DEF, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN OF SEQUENTIAL FILE WITH " &
+                                    "MODE IN_FILE NOT SUPPORTED");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF END_OF_FILE (FILE_REC_DEF) THEN
+               FAILED ("WRONG END_OF_FILE VALUE FOR RECORD" &
+                       "WITH DEFAULT");
+          END IF;
+
+          READ (FILE_REC_DEF, ITEM_REC3);
+
+          IF ITEM_REC3 /= (2, IDENT_INT(1),2,17,2) THEN
+               FAILED ("READ WRONG VALUE - RECORD WITH DEFAULT");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE_REC_DEF) THEN
+               FAILED ("END OF FILE NOT TRUE - RECORD WITH DEFAULT");
+          END IF;
+
+          BEGIN
+               DELETE (FILE_REC_DEF);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2201N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2202a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2202a.ada
new file mode 100644
index 000000000..a4073579b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2202a.ada
@@ -0,0 +1,143 @@
+-- CE2202A.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 READ, WRITE, AND END_OF_FILE RAISE STATUS_ERROR
+--     WHEN APPLIED TO A NON-OPEN SEQUENTIAL FILE.  USE_ERROR IS
+--     NOT PERMITTED.
+
+-- HISTORY:
+--     ABW 08/17/82
+--     SPS 09/13/82
+--     SPS 11/09/82
+--     EG  11/26/84
+--     EG  05/16/85
+--     GMT 07/24/87  REPLACED CALL TO REPORT.COMMENT WITH "NULL;".
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2202A IS
+
+     PACKAGE SEQ IS NEW SEQUENTIAL_IO (INTEGER);
+     USE SEQ;
+     FILE1, FILE2 : FILE_TYPE;
+     CNST : CONSTANT INTEGER := 101;
+     IVAL : INTEGER;
+     BOOL : BOOLEAN;
+
+BEGIN
+     TEST ("CE2202A","CHECK THAT READ, WRITE, AND "    &
+                     "END_OF_FILE RAISE STATUS_ERROR " &
+                     "WHEN APPLIED TO A NON-OPEN "     &
+                     "SEQUENTIAL FILE");
+     BEGIN
+          BEGIN
+               WRITE (FILE1,CNST);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN WRITE APPLIED " &
+                       "TO NON-EXISTENT FILE");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED WHEN WRITE " &
+                            "APPLIED TO NON-EXISTENT FILE");
+          END;
+
+          BEGIN
+               READ (FILE1,IVAL);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN READ APPLIED " &
+                       "TO NON-EXISTENT FILE");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED WHEN READ " &
+                            "APPLIED TO NON-EXISTENT FILE");
+          END;
+
+          BEGIN
+               BOOL := END_OF_FILE (FILE1);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN END_OF_FILE " &
+                       "APPLIED TO NON-EXISTENT FILE");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED WHEN END_OF_FILE " &
+                            "APPLIED TO NON-EXISTENT FILE");
+          END;
+     END;
+
+     BEGIN
+          BEGIN
+               CREATE (FILE2);
+               CLOSE (FILE2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL; -- IF FILE2 CANNOT BE CREATED THEN WE WILL
+                          -- BE REPEATING EARLIER TESTS, BUT THAT'S OK.
+          END;
+
+          BEGIN
+               WRITE (FILE2,CNST);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN WRITE APPLIED " &
+                       "TO FILE2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED WHEN WRITE " &
+                            "APPLIED TO FILE2");
+          END;
+
+          BEGIN
+               READ (FILE2,IVAL);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN READ APPLIED " &
+                       "TO FILE2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED WHEN READ " &
+                            "APPLIED TO FILE2");
+          END;
+
+          BEGIN
+               BOOL := END_OF_FILE (FILE2);
+               FAILED ("STATUS_ERROR NOT RAISED WHEN END_OF_FILE " &
+                       "APPLIED TO FILE2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED WHEN END_OF_FILE " &
+                            "APPLIED TO FILE2");
+          END;
+
+     END;
+
+     RESULT;
+
+END CE2202A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2203a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2203a.tst
new file mode 100644
index 000000000..f9a3f658d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2203a.tst
@@ -0,0 +1,121 @@
+-- CE2203A.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, FOR SEQUENTIAL_IO, WRITE RAISES THE EXCEPTION
+--     USE_ERROR IF THE CAPACITY OF THE EXTERNAL FILE IS EXCEEDED.
+--     THIS TEST ONLY CHECKS THAT THE IMPLEMENTATION SUPPORTS AN
+--     EXTERNAL FILE CAPACITY OF 4096 CHARACTERS OR LESS.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.  ALSO, THE IMPLEMENTATION MUST BE ABLE TO
+--     RESTRICT THE CAPACITY OF AN EXTERNAL FILE.
+
+--     $FORM_STRING2 IS DEFINED SUCH 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".
+
+-- HISTORY:
+--     JLH 07/12/88  CREATED ORIGINAL TEST.
+-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2203A IS
+
+     SUBTYPE STR512 IS STRING (1 .. 512);
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (STR512);
+          USE SEQ_IO;
+
+     FILE : FILE_TYPE;
+     ITEM : STR512 := (1 .. 512 => 'A');
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2203A", "CHECK FOR SEQUENTIAL_IO THAT WRITE RAISES " &
+                      "USE_ERROR IF THE CAPACITY OF THE EXTERNAL " &
+                      "FILE IS EXCEEDED");
+
+     BEGIN
+
+          IF
+$FORM_STRING2
+               = STRING'("CANNOT_RESTRICT_FILE_CAPACITY") THEN
+               NOT_APPLICABLE ("IMPLEMENTATION CANNOT RESTRICT FILE " &
+                               "CAPACITY");
+               RAISE INCOMPLETE;
+          ELSE
+               BEGIN
+                    CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME,
+
+$FORM_STRING2
+);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                         "WITH MODE OUT_FILE");
+                         RAISE INCOMPLETE;
+                    WHEN NAME_ERROR =>
+                         NOT_APPLICABLE ("NAME_ERROR RAISED ON " &
+                                         "CREATE WITH MODE OUT_FILE");
+                         RAISE INCOMPLETE;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                                 "CREATE");
+                         RAISE INCOMPLETE;
+               END;
+          END IF;
+
+          BEGIN
+               FOR I IN 1 .. 9 LOOP
+                    WRITE (FILE, ITEM);
+               END LOOP;
+               FAILED ("USE_ERROR NOT RAISED WHEN THE CAPACITY " &
+                       "OF THE EXTERNAL FILE IS EXCEEDED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE2203A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204a.ada
new file mode 100644
index 000000000..ee6089878
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204a.ada
@@ -0,0 +1,117 @@
+-- CE2204A.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 WRITE IS FORBIDDEN FOR SEQUENTIAL FILES OF
+--     MODE IN_FILE.
+
+--          A)  CHECK NON-TEMPORARY FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     DLD 08/17/82
+--     SPS 08/24/82
+--     SPS 11/09/82
+--     JBG 02/22/84  CHANGE TO .ADA TEST.
+--     JBG 03/30/84
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     GMT 07/27/87  SPLIT THIS TEST BY MOVING THE CODE FOR CHECKING
+--                   TEMPORARY FILES INTO CE2204C.ADA.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2204A IS
+     INCOMPLETE : EXCEPTION;
+BEGIN
+     TEST ("CE2204A", "CHECK THAT MODE_ERROR IS RAISED BY WRITE " &
+                      "WHEN THE MODE IS IN_FILE AND THE FILE " &
+                      "IS A NON-TEMPORARY FILE");
+     DECLARE
+          PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ_IO;
+          SEQ_FILE : FILE_TYPE;
+          VAR1     : INTEGER := 5;
+     BEGIN
+          BEGIN
+               CREATE (SEQ_FILE, OUT_FILE,
+                       LEGAL_FILE_NAME (1, "CE2204A"));
+               WRITE (SEQ_FILE, VAR1);
+               CLOSE (SEQ_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; " &
+                                    "SEQUENTIAL CREATE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; " &
+                                    "SEQUENTIAL CREATE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED; " &
+                            "SEQUENTIAL CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               OPEN (SEQ_FILE, IN_FILE,
+                     LEGAL_FILE_NAME (1, "CE2204A"));
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR  RAISED ON THE " &
+                                    "OPENING OF A SEQUENTIAL " &
+                                    "NON-TEMPORARY FILE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               WRITE (SEQ_FILE, 3);
+               FAILED ("MODE_ERROR NOT RAISED - NAMED FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - NAMED FILE");
+          END;
+
+          BEGIN
+               DELETE (SEQ_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2204A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204b.ada
new file mode 100644
index 000000000..61ef0abe6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204b.ada
@@ -0,0 +1,118 @@
+-- CE2204B.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 READ AND END_OF_FILE ARE FORBIDDEN FOR SEQUENTIAL
+--     FILES OF MODE OUT_FILE.
+
+--          A) CHECK NON-TEMPORARY FILES.
+
+-- APPLICABILITY CRITERIA:
+--      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--      THE CREATION OF SEQUENTIAL FILES.
+
+-- HISTORY:
+--     DLD 08/17/82
+--     SPS 08/24/82
+--     SPS 110/9/82
+--     JBG 02/22/84  CHANGE TO .ADA TEST.
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     GMT 07/24/87  SPLIT THIS TEST BY MOVING THE CODE FOR CHECKING
+--                   TEMPORARY FILES INTO CE2204D.ADA.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2204B IS
+BEGIN
+     TEST ("CE2204B", "FOR A NON-TEMPORARY SEQUENTIAL FILE, CHECK " &
+                      "THAT MODE_ERROR IS RAISED BY READ AND " &
+                      "END_OF_FILE WHEN THE MODE IS OUT_FILE");
+     DECLARE
+          PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ_IO;
+          SEQ_FILE   : FILE_TYPE;
+          X          : INTEGER;
+          B          : BOOLEAN;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+          BEGIN
+               CREATE (SEQ_FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 2");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON CREATE - 3");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (SEQ_FILE, 5);
+
+          BEGIN                    -- THIS IS ONLY
+               RESET (SEQ_FILE);   -- AN ATTEMPT
+          EXCEPTION                -- TO RESET,
+               WHEN USE_ERROR =>   -- IF RESET
+                    NULL;          -- N/A THEN
+          END;                     -- TEST IS
+                                   -- NOT AFFECTED.
+          BEGIN
+               READ (SEQ_FILE, X);
+               FAILED ("MODE_ERROR NOT RAISED ON READ - 4");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON READ - 5");
+          END;
+
+          BEGIN
+               B := END_OF_FILE (SEQ_FILE);
+               FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 6");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - END_OF_FILE - 7");
+          END;
+
+          BEGIN
+               DELETE (SEQ_FILE);
+          EXCEPTION
+               WHEN  USE_ERROR =>
+                     NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2204B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204c.ada
new file mode 100644
index 000000000..5981d38df
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204c.ada
@@ -0,0 +1,91 @@
+-- CE2204C.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 WRITE IS FORBIDDEN FOR SEQUENTIAL FILES OF
+--     MODE IN_FILE.
+
+--          B)  CHECK TEMPORARY FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEMPORARY SEQUENTIAL FILES AND THE RESETTING FROM OUT_FILE
+--     TO IN_FILE.
+
+-- HISTORY:
+--     GMT 07/27/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2204C IS
+     INCOMPLETE : EXCEPTION;
+BEGIN
+     TEST ("CE2204C", "CHECK THAT MODE_ERROR IS RAISED BY WRITE " &
+                      "WHEN THE MODE IS INFILE AND THE FILE IS " &
+                      "A TEMPORARY FILE");
+     DECLARE
+          PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ_IO;
+          FT   : FILE_TYPE;
+          VAR1 : INTEGER  := 5;
+     BEGIN
+          BEGIN
+               CREATE (FT, OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FT, VAR1);
+
+          BEGIN
+               RESET (FT, IN_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON RESET - 2");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               WRITE(FT, 3);
+               FAILED ("MODE_ERROR NOT RAISED ON WRITE - 3");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON WRITE - 4");
+          END;
+
+          CLOSE (FT);
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2204C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204d.ada
new file mode 100644
index 000000000..38427f5bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2204d.ada
@@ -0,0 +1,104 @@
+-- CE2204D.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 READ AND END_OF_FILE ARE FORBIDDEN FOR SEQUENTIAL
+--     FILES OF MODE OUT_FILE.
+
+--          B) CHECK TEMPORARY FILES.
+
+-- APPLICABILITY CRITERIA:
+--      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--      THE CREATION OF TEMPORARY SEQUENTIAL FILES.
+
+-- HISTORY:
+--     GMT 07/24/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2204D  IS
+BEGIN
+     TEST ("CE2204D", "FOR A TEMPORARY SEQUENTIAL FILE, CHECK THAT " &
+                      "MODE_ERROR IS RAISED BY READ AND END_OF_FILE " &
+                      "WHEN THE MODE IS OUT_FILE");
+     DECLARE
+          PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
+          USE SEQ_IO;
+          FT         : FILE_TYPE;
+          X          : INTEGER;
+          B          : BOOLEAN;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+          BEGIN
+               CREATE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FT, 5);
+
+          BEGIN                    -- THIS IS ONLY
+               RESET (FT);         -- AN ATTEMPT
+          EXCEPTION                -- TO RESET,
+               WHEN USE_ERROR =>   -- IF RESET
+                    NULL;          -- N/A THEN
+          END;                     -- TEST IS
+                                   -- NOT AFFECTED.
+
+          BEGIN
+               READ (FT, X);
+               FAILED ("MODE_ERROR NOT RAISED ON READ - 3");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON READ - 4");
+          END;
+
+          BEGIN
+               B := END_OF_FILE (FT);
+               FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 5");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - END_OF_FILE - 6");
+          END;
+
+          CLOSE (FT);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2204D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada
new file mode 100644
index 000000000..33edc2d68
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada
@@ -0,0 +1,151 @@
+-- CE2205A.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 WHETHER  READ  FOR A SEQUENTIAL FILE RAISES  DATA_ERROR OR
+--     CONSTRAINT_ERROR WHEN AN ELEMENT IS READ THAT IS OUTSIDE THE
+--     RANGE OF THE ITEM TYPE BUT WITHIN THE RANGE OF THE INSTANTIATED
+--     TYPE, AND CHECK THAT READING CAN CONTINUE AFTER THE EXCEPTION
+--     HAS BEEN HANDLED.
+
+--          A) CHECK ENUMERATION TYPE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT SEQUENTIAL FILES.
+
+-- HISTORY:
+--     SPS 09/28/82
+--     JBG 06/04/84
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     GMT 07/24/87  RENAMED FROM CE2210A.ADA AND REMOVED THE USE OF
+--                   RESET.
+--     PWB 05/18/89  DELETED CALL TO FAILED WHEN NO EXCEPTION RAISED.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2205A IS
+BEGIN
+
+     TEST ("CE2205A", "CHECK WHETHER READ FOR A SEQUENTIAL FILE " &
+                      "RAISES  DATA_ERROR OR CONSTRAINT_ERROR WHEN " &
+                      "AN ELEMENT IS READ THAT IS OUTSIDE THE RANGE " &
+                      "OF THE ITEM TYPE BUT WITHIN THE RANGE OF THE " &
+                      "INSTANTIATED TYPE, AND CHECK THAT READING CAN " &
+                      "CONTINUE AFTER THE EXCEPTION HAS BEEN HANDLED");
+     DECLARE
+          PACKAGE  SEQ  IS NEW  SEQUENTIAL_IO (CHARACTER);
+          USE SEQ;
+          FT : FILE_TYPE;
+          SUBTYPE CH IS CHARACTER  RANGE 'A' .. 'D';
+          X : CH;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON SEQUENTIAL " &
+                                    "CREATE WITH OUT_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON SEQUENTIAL " &
+                                    "CREATE WITH OUT_FILE MODE - 2");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "SEQUENTIAL CREATE - 3");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FT, 'A');
+          WRITE (FT, 'M');
+          WRITE (FT, 'B');
+          WRITE (FT, 'C');
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN  (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN WITH IN_FILE MODE IS NOT " &
+                                    "SUPPORTED - 4");
+               RAISE INCOMPLETE;
+          END;
+
+          -- BEGIN TEST
+
+          READ (FT, X);
+          IF X /= 'A' THEN
+               FAILED ("INCORRECT VALUE FOR READ - 5");
+          END IF;
+
+          BEGIN
+               READ (FT, X);
+               COMMENT ("NO EXCEPTION RAISED FOR READ WITH ELEMENT " &
+                       "OUT OF RANGE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR RAISED FOR SCALAR "  &
+                             "TYPES - 7");
+               WHEN DATA_ERROR =>
+                    COMMENT ("DATA_ERROR RAISED FOR SCALAR TYPES - 8");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 9");
+          END;
+
+          BEGIN
+               READ (FT, X);
+               IF X /= 'B' THEN
+                    FAILED ("INCORRECT VALUE FOR READ - 10");
+               END IF;
+
+               READ (FT, X);
+               IF X /= 'C' THEN
+                    FAILED ("INCORRECT VALUE FOR READ - 11");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNABLE TO CONTINUE READING - 12");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2205A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2206a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2206a.ada
new file mode 100644
index 000000000..841b680dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2206a.ada
@@ -0,0 +1,133 @@
+-- CE2206A.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 READ FOR A SEQUENTIAL FILE RAISES END_ERROR WHEN
+--     THERE ARE NO MORE ELEMENTS THAT CAN BE READ FROM THE GIVEN
+--     FILE.  ALSO CHECK THAT END_OF_FILE CORRECTLY DETECTS THE END
+--     OF A SEQUENTIAL FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     SEQUENTIAL FILES.
+
+-- HISTORY:
+--     JLH 08/22/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH SEQUENTIAL_IO;
+
+PROCEDURE CE2206A IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (CHARACTER);
+     USE SEQ_IO;
+
+     FILE : FILE_TYPE;
+     ITEM : CHARACTER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2206A", "CHECK THAT READ FOR A SEQUENTIAL FILE RAISES " &
+                      "END_ERROR WHEN THERE ARE NO MORE ELEMENTS " &
+                      "THAT CAN BE READ FROM THE GIVEN FILE.  ALSO " &
+                      "CHECK THAT END_OF_FILE CORRECTLY DETECTS THE " &
+                      "END OF A SEQUENTIAL FILE");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          WRITE (FILE, 'A');
+          WRITE (FILE, 'B');
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                                    "MODE IN_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+                    RAISE INCOMPLETE;
+          END;
+
+          READ (FILE, ITEM);
+          IF ITEM /= 'A' THEN
+               FAILED ("INCORRECT VALUE READ");
+          END IF;
+
+          IF END_OF_FILE (FILE) THEN
+               FAILED ("END_OF_FILE NOT DETECTED CORRECTLY - 1");
+          END IF;
+
+          READ (FILE, ITEM);
+
+          IF NOT END_OF_FILE (FILE) THEN
+               FAILED ("END_OF_FILE NOT DETECTED CORRECTLY - 2");
+          END IF;
+
+          BEGIN
+               READ (FILE, ITEM);
+               FAILED ("END_ERROR NOT RAISED FOR READ");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON READ");
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE2206A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2208b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2208b.ada
new file mode 100644
index 000000000..418199a86
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2208b.ada
@@ -0,0 +1,185 @@
+-- CE2208B.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 DATA CAN BE OVERWRITTEN IN THE SEQUENTIAL FILE AND THE
+--     CORRECT VALUES CAN LATER BE READ.  ALSO CHECK THAT OVERWRITING
+--     TRUNCATES THE FILE TO THE LAST ELEMENT WRITTEN.
+
+-- APPLICABILITY CRITERIA:
+--      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--      THE CREATING AND OPENING OF SEQUENTIAL FILES.
+
+-- HISTORY:
+--     TBN  09/30/86  CREATED ORIGINAL TEST.
+--     GMT  07/24/87  ADDED CHECKS FOR USE_ERROR AND REMOVED SOME CODE.
+--     BCB  10/03/90  CHANGED CODE TO CHECK THAT OVERWRITING TRUNCATES
+--                    INSTEAD OF WHETHER IT TRUNCATES.
+
+WITH SEQUENTIAL_IO;
+WITH REPORT; USE REPORT;
+PROCEDURE CE2208B IS
+
+     PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
+     USE SEQ_IO;
+
+     FILE1      : FILE_TYPE;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE2208B",
+           "CHECK THAT DATA CAN BE OVERWRITTEN IN THE SEQUENTIAL " &
+           "FILE AND THE CORRECT VALUES CAN LATER BE READ.  ALSO " &
+           "CHECK THAT OVERWRITING TRUNCATES THE FILE." );
+
+     -- INITIALIZE TEST FILE
+
+     BEGIN
+          CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED DURING CREATE");
+               RAISE INCOMPLETE;
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED DURING CREATE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNKNOWN EXCEPTION RAISED DURING CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          FOR I IN 1 .. 25 LOOP
+               WRITE (FILE1, I);
+          END LOOP;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED DURING WRITE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          CLOSE (FILE1);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED DURING CLOSE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ( "OPEN WITH  OUT_FILE  MODE NOT "  &
+                                "SUPPORTED FOR SEQUENTIAL FILES" );
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED DURING OPEN");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          FOR I IN 26 .. 36 LOOP
+               WRITE (FILE1, I);
+          END LOOP;
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED DURING OVERWRITE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          CLOSE (FILE1);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED DURING 2ND CLOSE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ( "OPEN WITH  IN_FILE  MODE NOT "   &
+                                "SUPPORTED FOR SEQUENTIAL FILES" );
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED DURING SECOND OPEN");
+               RAISE INCOMPLETE;
+     END;
+
+     DECLARE
+          END_REACHED : BOOLEAN := FALSE;
+          COUNT : INTEGER := 26;
+          NUM : INTEGER;
+     BEGIN
+          WHILE COUNT <= 36 AND NOT END_REACHED LOOP
+               BEGIN
+                    READ (FILE1, NUM);
+                    IF NUM /= COUNT THEN
+                         FAILED ("INCORRECT RESULTS READ FROM FILE " &
+                                 INTEGER'IMAGE (NUM));
+                    END IF;
+                    COUNT := COUNT + 1;
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         END_REACHED := TRUE;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
+                                 "READING - 1");
+                         RAISE INCOMPLETE;
+               END;
+          END LOOP;
+          IF COUNT <= 36 THEN
+               FAILED ("FILE WAS INCOMPLETE");
+               RAISE INCOMPLETE;
+          ELSE
+               BEGIN
+                    READ (FILE1, NUM);
+                    FAILED ("END_ERROR NOT RAISED BY ATTEMPT TO READ");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                                 "DURING READING - 2");
+                         RAISE INCOMPLETE;
+               END;
+          END IF;
+     END;
+
+     BEGIN
+          DELETE (FILE1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2208B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401a.ada
new file mode 100644
index 000000000..4ec422769
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401a.ada
@@ -0,0 +1,357 @@
+-- CE2401A.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
+--     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE AND
+--     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPES
+--     STRING, CHARACTER, AND INTEGER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
+--     SUPPORT DIRECT FILES.
+
+-- HISTORY:
+--     ABW 08/16/82
+--     SPS 09/15/82
+--     SPS 11/09/82
+--     JBG 02/22/84  CHANGE TO .ADA TEST.
+--     EG  05/16/85
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 07/31/87  ISOLATED EXCEPTIONS.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2401A IS
+     END_SUBTEST : EXCEPTION;
+BEGIN
+
+     TEST ("CE2401A" , "CHECK THAT READ, WRITE, SET_INDEX " &
+                       "INDEX, SIZE AND END_OF_FILE ARE " &
+                       "SUPPORTED FOR DIRECT FILES");
+
+     DECLARE
+          SUBTYPE STR_TYPE IS STRING (1..12);
+          PACKAGE DIR_STR IS NEW DIRECT_IO (STR_TYPE);
+          USE DIR_STR;
+          FILE_STR : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE_STR, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - STRING");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE - STRING");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               STR : STR_TYPE := "TEXT OF FILE";
+               ITEM_STR : STR_TYPE;
+               ONE_STR : POSITIVE_COUNT := 1;
+               TWO_STR : POSITIVE_COUNT := 2;
+          BEGIN
+               BEGIN
+                    WRITE (FILE_STR,STR);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "STRING - 1");
+               END;
+
+               BEGIN
+                    WRITE (FILE_STR,STR,TWO_STR);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "STRING - 2");
+               END;
+
+               BEGIN
+                    IF SIZE (FILE_STR) /= TWO_STR THEN
+                         FAILED ("SIZE FOR TYPE STRING");
+                    END IF;
+                    IF NOT END_OF_FILE (FILE_STR) THEN
+                         FAILED ("WRONG END_OF_FILE VALUE FOR STRING");
+                    END IF;
+                    SET_INDEX (FILE_STR,ONE_STR);
+                    IF INDEX (FILE_STR) /= ONE_STR THEN
+                         FAILED ("WRONG INDEX VALUE FOR STRING");
+                    END IF;
+               END;
+
+               CLOSE (FILE_STR);
+
+               BEGIN
+                    OPEN (FILE_STR, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
+                                         "NOT SUPPORTED - 1");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE_STR,ITEM_STR);
+                    IF ITEM_STR /= STR THEN
+                         FAILED ("INCORRECT STRING VALUE READ - 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITHOUT FROM FOR STRING");
+               END;
+
+               BEGIN
+                    READ (FILE_STR,ITEM_STR,ONE_STR);
+                    IF ITEM_STR /= STR THEN
+                         FAILED ("INCORRECT STRING VALUE READ - 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITH FROM FOR STRING");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE_STR);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     DECLARE
+          PACKAGE DIR_CHR IS NEW DIRECT_IO (CHARACTER);
+          USE DIR_CHR;
+          FILE_CHR : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE_CHR, INOUT_FILE, LEGAL_FILE_NAME(2));
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - CHARACTER");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE - CHARACTER");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               CHR : CHARACTER := 'C';
+               ITEM_CHR : CHARACTER;
+               ONE_CHR : POSITIVE_COUNT := 1;
+               TWO_CHR : POSITIVE_COUNT := 2;
+          BEGIN
+               BEGIN
+                    WRITE (FILE_CHR,CHR);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "CHARACTER - 1");
+               END;
+
+               BEGIN
+                    WRITE (FILE_CHR,CHR,TWO_CHR);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "CHARACTER - 2");
+               END;
+
+               BEGIN
+                    IF SIZE (FILE_CHR) /= TWO_CHR THEN
+                         FAILED ("SIZE FOR TYPE CHARACTER");
+                    END IF;
+                    IF NOT END_OF_FILE (FILE_CHR) THEN
+                         FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
+                                 "CHARACTER");
+                    END IF;
+                    SET_INDEX (FILE_CHR,ONE_CHR);
+                    IF INDEX (FILE_CHR) /= ONE_CHR THEN
+                         FAILED ("WRONG INDEX VALUE FOR TYPE " &
+                                 "CHARACTER");
+                    END IF;
+               END;
+
+               CLOSE (FILE_CHR);
+
+               BEGIN
+                    OPEN (FILE_CHR, IN_FILE, LEGAL_FILE_NAME(2));
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
+                                         "NOT SUPPORTED - 2");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE_CHR,ITEM_CHR);
+                    IF ITEM_CHR /= CHR THEN
+                         FAILED ("INCORRECT CHR VALUE READ - 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITHOUT FROM FOR " &
+                                 "TYPE CHARACTER");
+               END;
+
+               BEGIN
+                    READ (FILE_CHR,ITEM_CHR,ONE_CHR);
+                    IF ITEM_CHR /= CHR THEN
+                         FAILED ("INCORRECT CHR VALUE READ - 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITH FROM FOR " &
+                                 "TYPE CHARACTER");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE_CHR);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     DECLARE
+          PACKAGE DIR_INT IS NEW DIRECT_IO (INTEGER);
+          USE DIR_INT;
+          FILE_INT : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE_INT, INOUT_FILE, LEGAL_FILE_NAME(3));
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - INTEGER");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE - INTEGER");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               INT : INTEGER := IDENT_INT (33);
+               ITEM_INT : INTEGER;
+               ONE_INT : POSITIVE_COUNT := 1;
+               TWO_INT : POSITIVE_COUNT := 2;
+          BEGIN
+               BEGIN
+                    WRITE (FILE_INT,INT);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "INTEGER - 1");
+               END;
+
+               BEGIN
+                    WRITE (FILE_INT,INT,TWO_INT);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "INTEGER - 2");
+               END;
+
+               BEGIN
+                    IF SIZE (FILE_INT) /= TWO_INT THEN
+                         FAILED ("SIZE FOR TYPE INTEGER");
+                    END IF;
+                    IF NOT END_OF_FILE (FILE_INT) THEN
+                         FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
+                                 "INTEGER");
+                    END IF;
+                    SET_INDEX (FILE_INT, ONE_INT);
+                    IF INDEX (FILE_INT) /= ONE_INT THEN
+                         FAILED ("WRONG INDEX VALUE FOR TYPE INTEGER");
+                    END IF;
+               END;
+
+               CLOSE (FILE_INT);
+
+               BEGIN
+                    OPEN (FILE_INT, IN_FILE, LEGAL_FILE_NAME(3));
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
+                                         "NOT SUPPORTED - 3");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE_INT,ITEM_INT);
+                    IF ITEM_INT /= INT THEN
+                         FAILED ("INCORRECT INT VALUE READ - 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITHOUT FROM FOR " &
+                                 "TYPE INTEGER");
+               END;
+
+               BEGIN
+                    READ (FILE_INT,ITEM_INT,ONE_INT);
+                    IF ITEM_INT /= INT THEN
+                         FAILED ("INCORRECT INT VALUE READ - 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITH FROM FOR " &
+                                 "TYPE INTEGER");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE_INT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2401A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401b.ada
new file mode 100644
index 000000000..e527fbb56
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401b.ada
@@ -0,0 +1,347 @@
+-- CE2401B.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
+--     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
+--     END_OF_FILE FOR DIRECT FILES WITH ELEMENT_TYPES BOOLEAN,
+--     ACCESS, AND ENUMERATED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     DIRECT FILES.
+
+-- HISTORY:
+--     ABW 08/18/82
+--     SPS 09/15/82
+--     SPS 11/09/82
+--     JBG 02/22/84  CHANGE TO .ADA TEST.
+--     EG  05/16/85
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/07/87  ISOLATED EXCEPTIONS.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2401B IS
+     END_SUBTEST : EXCEPTION;
+BEGIN
+
+     TEST ("CE2401B", "CHECK READ, WRITE, SET_INDEX " &
+                      "INDEX, SIZE, AND END_OF_FILE FOR " &
+                      "DIRECT FILES FOR BOOLEAN, ACCESS " &
+                      "AND ENUMERATION TYPES");
+     DECLARE
+          PACKAGE DIR_BOOL IS NEW DIRECT_IO (BOOLEAN);
+          USE DIR_BOOL;
+          FILE_BOOL : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE_BOOL, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - BOOLEAN");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE - BOOLEAN");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               BOOL : BOOLEAN := IDENT_BOOL (TRUE);
+               ITEM_BOOL : BOOLEAN;
+               ONE_BOOL : POSITIVE_COUNT := 1;
+               TWO_BOOL : POSITIVE_COUNT := 2;
+          BEGIN
+               BEGIN
+                    WRITE (FILE_BOOL,BOOL);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "BOOLEAN - 1");
+               END;
+
+               BEGIN
+                    WRITE (FILE_BOOL,BOOL,TWO_BOOL);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "BOOLEAN - 2");
+               END;
+
+               BEGIN
+                    IF SIZE (FILE_BOOL) /= TWO_BOOL THEN
+                         FAILED ("SIZE FOR TYPE BOOLEAN");
+                    END IF;
+                    IF NOT END_OF_FILE (FILE_BOOL) THEN
+                         FAILED ("WRONG END_OF_FILE VALUE FOR " &
+                                 "BOOLEAN");
+                    END IF;
+                    SET_INDEX (FILE_BOOL,ONE_BOOL);
+                    IF INDEX (FILE_BOOL) /= ONE_BOOL THEN
+                         FAILED ("WRONG INDEX VALUE FOR TYPE BOOLEAN");
+                    END IF;
+               END;
+
+               CLOSE (FILE_BOOL);
+
+               BEGIN
+                    OPEN (FILE_BOOL, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
+                                         "NOT SUPPORTED - 1");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE_BOOL,ITEM_BOOL);
+                    IF ITEM_BOOL /= BOOL THEN
+                         FAILED ("INCORRECT BOOLEAN VALUE READ - 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITHOUT FROM FOR " &
+                                 "TYPE BOOLEAN");
+               END;
+
+               BEGIN
+                    READ (FILE_BOOL,ITEM_BOOL,ONE_BOOL);
+                    IF ITEM_BOOL /= BOOL THEN
+                         FAILED ("INCORRECT BOOLEAN VALUE READ - 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITH FROM FOR BOOLEAN");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE_BOOL);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     DECLARE
+          TYPE ENUMERATED IS (ONE,TWO,THREE);
+          PACKAGE DIR_ENUM IS NEW DIRECT_IO (ENUMERATED);
+          USE DIR_ENUM;
+          FILE_ENUM : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE_ENUM, INOUT_FILE, LEGAL_FILE_NAME(2));
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - ENUMERATED");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE - ENUMERATED");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               ENUM : ENUMERATED := (THREE);
+               ITEM_ENUM : ENUMERATED;
+               ONE_ENUM : POSITIVE_COUNT := 1;
+               TWO_ENUM : POSITIVE_COUNT := 2;
+          BEGIN
+               BEGIN
+                    WRITE (FILE_ENUM,ENUM);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "ENUMERATED - 1");
+               END;
+
+               BEGIN
+                    WRITE (FILE_ENUM,ENUM,TWO_ENUM);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "ENUMERATED - 2");
+               END;
+
+               BEGIN
+                    IF SIZE (FILE_ENUM) /= TWO_ENUM THEN
+                         FAILED ("SIZE FOR TYPE ENUMERATED");
+                    END IF;
+                    IF NOT END_OF_FILE (FILE_ENUM) THEN
+                         FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
+                                 "ENUMERATED");
+                    END IF;
+                    SET_INDEX (FILE_ENUM,ONE_ENUM);
+                    IF INDEX (FILE_ENUM) /= ONE_ENUM THEN
+                         FAILED ("WRONG INDEX VALUE FOR TYPE " &
+                                 "ENUMERATED");
+                    END IF;
+               END;
+
+               CLOSE (FILE_ENUM);
+
+               BEGIN
+                    OPEN (FILE_ENUM, IN_FILE, LEGAL_FILE_NAME(2));
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
+                                         "NOT SUPPORTED - 2");
+                    RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE_ENUM,ITEM_ENUM);
+                    IF ITEM_ENUM /= ENUM THEN
+                         FAILED ("INCORRECT ENUM VALUE READ - 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITHOUT FROM FOR ENUMERATED");
+               END;
+
+               BEGIN
+                    READ (FILE_ENUM,ITEM_ENUM,ONE_ENUM);
+                    IF ITEM_ENUM /= ENUM THEN
+                         FAILED ("INCORRECT ENUM VALUE READ - 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITH FROM FOR " &
+                                 "TYPE ENUMERATED");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE_ENUM);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     DECLARE
+          TYPE ACC_INT IS ACCESS INTEGER;
+          PACKAGE DIR_ACC IS NEW DIRECT_IO (ACC_INT);
+          USE DIR_ACC;
+          FILE_ACC : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE_ACC, INOUT_FILE, LEGAL_FILE_NAME(3));
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - ACCESS");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               ACC : ACC_INT := NEW INTEGER'(33);
+               ITEM_ACC : ACC_INT;
+               ONE_ACC : POSITIVE_COUNT := 1;
+               TWO_ACC : POSITIVE_COUNT := 2;
+          BEGIN
+               BEGIN
+                    WRITE (FILE_ACC,ACC);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "ACCESS - 1");
+               END;
+
+               BEGIN
+                    WRITE (FILE_ACC,ACC,TWO_ACC);
+
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "ACCESS - 2");
+               END;
+
+               BEGIN
+                    IF SIZE (FILE_ACC) /= TWO_ACC THEN
+                         FAILED ("SIZE FOR TYPE ACCESS");
+                    END IF;
+                    IF NOT END_OF_FILE (FILE_ACC) THEN
+                         FAILED ("WRONG END_OF_FILE VALUE FOR ACCESS");
+                    END IF;
+                    SET_INDEX (FILE_ACC,ONE_ACC);
+                    IF INDEX (FILE_ACC) /= ONE_ACC THEN
+                         FAILED ("WRONG INDEX VALUE FOR TYPE ACCESS");
+                    END IF;
+               END;
+
+               CLOSE (FILE_ACC);
+
+               BEGIN
+                    OPEN (FILE_ACC, IN_FILE, LEGAL_FILE_NAME(3));
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN FOR IN_FILE NOT " &
+                                         "SUPPORTED - 3");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE_ACC,ITEM_ACC);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITHOUT FROM FOR ACCESS");
+               END;
+
+               BEGIN
+                    READ (FILE_ACC,ITEM_ACC,ONE_ACC);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITH FROM FOR ACCESS");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE_ACC);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2401B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401c.ada
new file mode 100644
index 000000000..d793104a7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401c.ada
@@ -0,0 +1,268 @@
+-- CE2401C.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
+--     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
+--     END_OF_FILE ARE IMPLEMENTED FOR DIRECT FILES WITH
+--     ELEMENT_TYPE CONSTRAINED ARRAY, AND RECORD WITHOUT DISCRIMINANTS.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     DIRECT FILES.
+
+-- HISTORY:
+--     ABW 08/18/82
+--     SPS 09/20/82
+--     SPS 11/09/82
+--     JBG 05/02/83
+--     JRK 03/26/84
+--     EG  05/16/85
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/10/87  ISOLATED EXCEPTIONS.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2401C IS
+     END_SUBTEST: EXCEPTION;
+BEGIN
+
+     TEST ("CE2401C" , "CHECK READ, WRITE, SET_INDEX " &
+                       "INDEX, SIZE, AND END_OF_FILE FOR " &
+                       "DIRECT FILES FOR CONSTRAINED ARRAY TYPES, " &
+                       "AND RECORD TYPES WITHOUT DISCRIMINANTS");
+
+     DECLARE
+          TYPE ARR_CN IS ARRAY (1..5) OF BOOLEAN;
+          PACKAGE DIR_ARR_CN IS NEW DIRECT_IO (ARR_CN);
+          USE DIR_ARR_CN;
+          FILE : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - CONSTRAINED ARRAY");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE - CONSTRAINED ARRAY");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               ARR : ARR_CN := (TRUE,TRUE,FALSE,TRUE,TRUE);
+               ITEM : ARR_CN;
+               ONE : POSITIVE_COUNT := 1;
+               TWO : POSITIVE_COUNT := 2;
+          BEGIN
+               BEGIN
+                    WRITE (FILE,ARR);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "CONTRAINED ARRAY - 1");
+               END;
+
+               BEGIN
+                    WRITE (FILE,ARR,TWO);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "CONSTRAINED ARRAY - 2");
+               END;
+
+               BEGIN
+                    IF SIZE (FILE) /= TWO THEN
+                         FAILED ("SIZE FOR TYPE CONSTRAINED ARRAY");
+                    END IF;
+                    IF NOT END_OF_FILE (FILE) THEN
+                         FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
+                                 "CONSTRAINED ARRAY");
+                    END IF;
+                    SET_INDEX (FILE,ONE);
+                    IF INDEX (FILE) /= ONE THEN
+                         FAILED ("WRONG INDEX VALUE FOR TYPE " &
+                                 "CONSTRAINED ARRAY");
+                    END IF;
+               END;
+
+               CLOSE (FILE);
+
+               BEGIN
+                    OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
+                                         "NOT SUPPORTED - 1");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE,ITEM);
+                    IF ITEM /= ARR THEN
+                         FAILED ("INCORRECT ARRAY VALUES READ " &
+                                 "- 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITHOUT FROM FOR " &
+                                 "TYPE CONSTRAINED ARRAY");
+               END;
+
+               BEGIN
+                    READ (FILE,ITEM,ONE);
+                    IF ITEM /= ARR THEN
+                         FAILED ("INCORRECT ARRAY VALUES READ " &
+                                 "- 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITH FROM FOR " &
+                                 "TYPE CONSTRAINED ARRAY");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     DECLARE
+          TYPE REC IS
+               RECORD
+                    ONE : INTEGER;
+                    TWO : INTEGER;
+          END RECORD;
+          PACKAGE DIR_REC IS NEW DIRECT_IO (REC);
+          USE DIR_REC;
+          FILE : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME(2));
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - RECORD");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON CREATE - " &
+                            "RECORD");
+          END;
+
+          DECLARE
+               REC1 : REC := REC'(ONE=>18,TWO=>36);
+               ITEM : REC;
+               ONE : POSITIVE_COUNT := 1;
+               TWO : POSITIVE_COUNT := 2;
+          BEGIN
+               BEGIN
+                    WRITE (FILE,REC1);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR - " &
+                                 "RECORD - 1");
+               END;
+
+               BEGIN
+                    WRITE (FILE,REC1,TWO);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR - " &
+                                 "RECORD - 2");
+               END;
+
+               BEGIN
+                    IF SIZE (FILE) /= TWO THEN
+                         FAILED ("SIZE FOR TYPE RECORD");
+                    END IF;
+                    IF NOT END_OF_FILE (FILE) THEN
+                         FAILED ("WRONG END_OF_FILE VALUE FOR RECORD");
+                    END IF;
+                    SET_INDEX (FILE,ONE);
+                    IF INDEX (FILE) /= ONE THEN
+                         FAILED ("WRONG INDEX VALUE FOR TYPE RECORD");
+                    END IF;
+               END;
+
+               CLOSE (FILE);
+
+               BEGIN
+                    OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2));
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
+                                         "NOT SUPPORTED - 2");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE,ITEM);
+                    IF ITEM /= REC1 THEN
+                         FAILED ("INCORRECT RECORD VALUES READ " &
+                                 "- 1");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITHOUT FROM FOR RECORD");
+               END;
+
+               BEGIN
+                    READ (FILE,ITEM,ONE);
+                    IF ITEM /= REC1 THEN
+                         FAILED ("INCORRECT RECORD VALUES READ " &
+                                 "- 2");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITH FROM FOR " &
+                                 "TYPE RECORD");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2401C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401e.ada
new file mode 100644
index 000000000..a9b050d7c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401e.ada
@@ -0,0 +1,172 @@
+-- CE2401E.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
+--     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
+--     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPE
+--     FLOATING POINT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY FOR IMPLEMENTATIONS WHICH SUPPORT CREATION OF
+--     DIRECT FILES WITH INOUT_FILE MODE AND OPENING OF DIRECT FILES
+--     WITH IN_FILE MODE.
+
+-- HISTORY:
+--     ABW 08/18/82
+--     SPS 09/15/82
+--     SPS 11/11/82
+--     JBG 05/02/83
+--     EG  11/19/85  HANDLE IMPLEMENTATIONS WITH
+--                   POSITIVE_COUNT'LAST=1.
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/10/87  ISOLATED EXCEPTIONS. SPLIT FIXED POINT TESTS
+--                   INTO CE2401I.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2401E IS
+
+     END_SUBTEST : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2401E", "CHECK THAT READ, WRITE, SET_INDEX, " &
+                       "INDEX, SIZE, AND END_OF_FILE ARE " &
+                       "SUPPORTED FOR DIRECT FILES WITH " &
+                       "ELEMENT_TYPE FLOAT");
+
+     DECLARE
+
+          PACKAGE DIR_FLT IS NEW DIRECT_IO (FLOAT);
+          USE DIR_FLT;
+          FILE_FLT : FILE_TYPE;
+
+     BEGIN
+          BEGIN
+               CREATE (FILE_FLT, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - FLOAT");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE - FLOAT");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               FLT : FLOAT := 65.0;
+               ITEM_FLT : FLOAT;
+               ONE_FLT : POSITIVE_COUNT := 1;
+               TWO_FLT : POSITIVE_COUNT := 2;
+          BEGIN
+               BEGIN
+                    WRITE (FILE_FLT, FLT);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "FLOATING POINT - 1");
+               END;
+
+               BEGIN
+                    WRITE (FILE_FLT, FLT, TWO_FLT);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "FLOATING POINT - 2");
+               END;
+
+               BEGIN
+                    IF SIZE (FILE_FLT) /= TWO_FLT THEN
+                         FAILED ("SIZE FOR FLOATING POINT");
+                    END IF;
+
+                    IF NOT END_OF_FILE (FILE_FLT) THEN
+                         FAILED ("WRONG END_OF_FILE VALUE FOR " &
+                                 "FLOATING POINT");
+                    END IF;
+
+                    SET_INDEX (FILE_FLT, ONE_FLT);
+                    IF INDEX (FILE_FLT) /= ONE_FLT THEN
+                         FAILED ("WRONG INDEX VALUE FOR " &
+                                 "FLOATING POINT");
+                    END IF;
+               END;
+
+               CLOSE (FILE_FLT);
+
+               BEGIN
+                    OPEN (FILE_FLT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN FOR IN_FILE " &
+                                         "MODE NOT SUPPORTED");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE_FLT, ITEM_FLT);
+                    IF ITEM_FLT /= FLT THEN
+                         FAILED ("WRONG VALUE READ FOR " &
+                                 "FLOATING POINT");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITHOUT FROM FOR " &
+                                 "TYPE FLOATING POINT");
+               END;
+
+               BEGIN
+                    READ (FILE_FLT, ITEM_FLT, ONE_FLT);
+                    IF ITEM_FLT /= FLT THEN
+                         FAILED ("WRONG VALUE READ WITH INDEX FOR " &
+                                 "FLOATING POINT");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITH FROM FOR " &
+                                 "TYPE FLOATING POINT");
+               END;
+
+               BEGIN
+                    DELETE (FILE_FLT);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+
+     RESULT;
+
+END CE2401E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401f.ada
new file mode 100644
index 000000000..30b69c991
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401f.ada
@@ -0,0 +1,200 @@
+-- CE2401F.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
+--     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
+--     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPE
+--     PRIVATE.
+
+-- APPLICABILITY CRITERIA:
+--
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION WITH INOUT_FILE MODE AND OPENING WITH IN_FILE MODE FOR
+--     DIRECT FILES.
+
+-- HISTORY:
+--     ABW 08/18/82
+--     SPS 09/15/82
+--     SPS 11/09/82
+--     JBG 02/22/84  CHANGE TO .ADA TEST
+--     EG  11/19/85  CORRECT SO TEST CAN HANDLE IMPLEMENTATION WITH
+--                   POSITIVE_COUNT'LAST=1; COVER POSSIBILITY OF CREATE
+--                   RAISING USE_ERROR; ENSURE RESET DOESN'T RAISE
+--                   EXCEPTION IF CREATE FAILS; CHECK THAT WE CAN READ
+--                   DATA THAT HAS BEEN WRITTEN.
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/11/87  ISOLATED EXCEPTIONS.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2401F IS
+
+     END_SUBTEST : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2401F", "CHECK THAT READ, WRITE, SET_INDEX, " &
+                       "INDEX, SIZE, AND END_OF_FILE ARE " &
+                       "SUPPORTED FOR DIRECT FILES WITH " &
+                       "ELEMENT_TYPE PRIVATE");
+
+     DECLARE
+
+          PACKAGE PKG IS
+               TYPE PRIV IS PRIVATE;
+               FUNCTION ASSIGN RETURN PRIV;
+          PRIVATE
+               TYPE PRIV IS NEW INTEGER;
+          END PKG;
+
+          USE PKG;
+
+          PACKAGE DIR_PRV IS NEW DIRECT_IO (PRIV);
+          USE DIR_PRV;
+          FILE_PRV : FILE_TYPE;
+
+          PACKAGE BODY PKG IS
+               FUNCTION ASSIGN RETURN PRIV IS
+               BEGIN
+                    RETURN (16);
+               END;
+          BEGIN
+               NULL;
+          END PKG;
+
+     BEGIN
+          BEGIN
+               CREATE (FILE_PRV, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - PRIVATE");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE - PRIVATE");
+                    RAISE END_SUBTEST;
+          END;
+
+          BEGIN
+
+               DECLARE
+
+                    PRV, ITEM_PRV : PRIV;
+                    ONE_PRV : POSITIVE_COUNT := 1;
+                    TWO_PRV : POSITIVE_COUNT := 2;
+
+               BEGIN
+
+                    PRV := ASSIGN;
+
+                    BEGIN
+                         WRITE (FILE_PRV, PRV);
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                      "PRIVATE - 1");
+                    END;
+
+                    BEGIN
+                         WRITE (FILE_PRV, PRV, TWO_PRV);
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                      "PRIVATE - 2");
+                    END;
+
+                    BEGIN
+                         IF SIZE (FILE_PRV) /= TWO_PRV THEN
+                              FAILED ("SIZE FOR TYPE PRIVATE");
+                         END IF;
+                         IF NOT END_OF_FILE (FILE_PRV) THEN
+                              FAILED ("WRONG END_OF_FILE VALUE FOR " &
+                                      "PRIVATE TYPE");
+                         END IF;
+
+                         SET_INDEX (FILE_PRV, ONE_PRV);
+
+                         IF INDEX (FILE_PRV) /= ONE_PRV THEN
+                              FAILED ("WRONG INDEX VALUE FOR PRIVATE " &
+                                      "TYPE");
+                         END IF;
+                    END;
+
+                    CLOSE (FILE_PRV);
+
+                    BEGIN
+                         OPEN (FILE_PRV, IN_FILE, LEGAL_FILE_NAME);
+                    EXCEPTION
+                         WHEN USE_ERROR =>
+                              NOT_APPLICABLE ("OPEN FOR IN_FILE NOT " &
+                                       "SUPPORTED");
+                              RAISE END_SUBTEST;
+                    END;
+
+                    BEGIN
+                         READ (FILE_PRV, ITEM_PRV);
+                         IF ITEM_PRV /= PRV THEN
+                              FAILED ("INCORRECT PRIVATE TYPE VALUE " &
+                                      "READ - 1");
+                         END IF;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("READ WITHOUT FROM FOR " &
+                                      "PRIVATE TYPE");
+                    END;
+
+                    BEGIN
+                         READ (FILE_PRV, ITEM_PRV, ONE_PRV);
+                         IF ITEM_PRV /= PRV THEN
+                              FAILED ("INCORRECT PRIVATE TYPE VALUE " &
+                                      "READ - 2");
+                         END IF;
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("READ WITH FROM FOR " &
+                                      "PRIVATE TYPE");
+                    END;
+               END;
+
+               BEGIN
+                    DELETE (FILE_PRV);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2401F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401h.ada
new file mode 100644
index 000000000..70ce088d5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401h.ada
@@ -0,0 +1,168 @@
+-- CE2401H.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 READ, WRITE, SET_INDEX, INDEX, SIZE, AND
+--     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH
+--     ELEMENT_TYPE UNCONSTRAINED RECORDS WITH DEFAULT DISCRIMINANTS.
+
+--     THIS INSTANTIATION IS ALWAYS LEGAL BY AI-00037.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH INOUT_FILE MODE AND OPENING WITH IN_FILE MODE FOR
+--     DIRECT FILES.
+
+-- HISTORY:
+--     TBN 05/15/86
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/10/87  ISOLATED EXCEPTIONS.
+
+WITH REPORT;
+USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2401H IS
+
+     END_SUBTEST : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2401H", "CHECK THAT READ, WRITE, SET_INDEX, INDEX, " &
+                       "SIZE, AND END_OF_FILE ARE SUPPORTED FOR " &
+                       "DIRECT FILES WITH ELEMENT_TYPE UNCONSTRAINED " &
+                       "RECORDS WITH DEFAULT DISCRIMINANTS");
+
+     DECLARE
+          TYPE REC_DEF (DISCR : INTEGER := 1) IS
+               RECORD
+                    ONE : INTEGER := DISCR;
+                    TWO : INTEGER := 3;
+                    THREE : INTEGER := 5;
+                    FOUR : INTEGER := 7;
+               END RECORD;
+          PACKAGE DIR_REC_DEF IS NEW DIRECT_IO (REC_DEF);
+          USE DIR_REC_DEF;
+          FILE1 : FILE_TYPE;
+          REC : REC_DEF;
+          ITEM : REC_DEF;
+          ONE : POSITIVE_COUNT := 1;
+          TWO : POSITIVE_COUNT := 2;
+
+     BEGIN
+          BEGIN
+               CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR  =>
+                    NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE " &
+                                    "NOT SUPPORTED FOR " &
+                                    "UNCONSTRAINED RECORDS WITH " &
+                                    "DEFAULT DISCRIMINATES");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON DIRECT " &
+                            "CREATE");
+                    RAISE END_SUBTEST;
+          END;
+
+          BEGIN
+               WRITE (FILE1, REC);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                            "RECORD WITH DEFAULT - 1");
+          END;
+
+          BEGIN
+               WRITE (FILE1, REC, TWO);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                            "RECORD WITH DEFAULT - 2");
+          END;
+
+          BEGIN
+               IF SIZE (FILE1) /= TWO THEN
+                    FAILED ("SIZE FOR RECORD WITH DEFAULT");
+               END IF;
+               IF NOT END_OF_FILE (FILE1) THEN
+                    FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
+                            "RECORD WITH DEFAULT");
+               END IF;
+               SET_INDEX (FILE1, ONE);
+               IF INDEX (FILE1) /= ONE THEN
+                    FAILED ("WRONG INDEX VALUE FOR RECORD" &
+                            "WITH DEFAULT");
+               END IF;
+          END;
+
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("OPEN FOR IN_FILE NOT SUPPORTED");
+                    RAISE END_SUBTEST;
+          END;
+
+          BEGIN
+               READ (FILE1, ITEM);
+               IF ITEM /= (1,1,3,5,7) THEN
+                    FAILED ("WRONG VALUE READ");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("READ WITHOUT FROM FOR " &
+                            "TYPE RECORD WITH DEFAULT");
+          END;
+
+          BEGIN
+               ITEM := (OTHERS => 0);
+               READ (FILE1, ITEM, ONE);
+               IF ITEM /= (1,1,3,5,7) THEN
+                    FAILED ("WRONG VALUE READ");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("READ WITH FROM FOR " &
+                            "TYPE RECORD WITH DEFAULT");
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2401H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401i.ada
new file mode 100644
index 000000000..68f2ba439
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401i.ada
@@ -0,0 +1,163 @@
+-- CE2401I.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
+--     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE, AND
+--     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPE
+--     FIXED POINT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY FOR IMPLEMENTATIONS WHICH SUPPORT CREATION OF
+--     DIRECT FILES WITH INOUT_FILE MODE AND OPENING OF DIRECT FILES
+--     WITH IN_FILE MODE.
+
+-- HISTORY:
+--     DWC 08/10/87  CREATED ORIGINAL VERSION.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2401I IS
+
+     END_SUBTEST : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2401I", "CHECK THAT READ, WRITE, SET_INDEX, " &
+                       "INDEX, SIZE, AND END_OF_FILE ARE " &
+                       "SUPPORTED FOR DIRECT FILES WITH " &
+                       "ELEMENT_TYPE FIXED");
+
+     DECLARE
+
+          TYPE FIX_TYPE IS DELTA 0.5 RANGE 0.0 .. 255.0;
+          PACKAGE DIR_FIX IS NEW DIRECT_IO (FIX_TYPE);
+          USE DIR_FIX;
+          FILE_FIX : FILE_TYPE;
+
+     BEGIN
+          BEGIN
+               CREATE (FILE_FIX, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
+                                    "ON CREATE - FIXED POINT");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE - FIXED POINT");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               FIX : FIX_TYPE := 16.0;
+               ITEM_FIX : FIX_TYPE;
+               ONE_FIX : POSITIVE_COUNT := 1;
+               TWO_FIX : POSITIVE_COUNT := 2;
+
+          BEGIN
+               BEGIN
+                    WRITE (FILE_FIX, FIX);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "FIXED POINT - 1");
+               END;
+
+               BEGIN
+                    WRITE (FILE_FIX, FIX, TWO_FIX);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE FOR " &
+                                 "FIXED POINT - 2");
+               END;
+
+               BEGIN
+                    IF SIZE (FILE_FIX) /= TWO_FIX THEN
+                         FAILED ("SIZE FOR TYPE FIXED POINT");
+                    END IF;
+
+                    IF NOT END_OF_FILE (FILE_FIX) THEN
+                         FAILED ("WRONG END_OF_FILE VALUE FOR " &
+                                 "FIXED POINT");
+                    END IF;
+
+                    SET_INDEX (FILE_FIX, ONE_FIX);
+
+                    IF INDEX (FILE_FIX) /= ONE_FIX THEN
+                         FAILED ("WRONG INDEX VALUE FOR FIXED " &
+                                 "POINT");
+                    END IF;
+               END;
+
+               CLOSE (FILE_FIX);
+
+               BEGIN
+                    OPEN (FILE_FIX, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
+                                         "NOT SUPPORTED");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE_FIX, ITEM_FIX);
+                    IF ITEM_FIX /= FIX THEN
+                        FAILED ("WRONG VALUE READ FOR FIXED POINT");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITHOUT FROM FOR FIXED " &
+                                 "POINT");
+               END;
+
+               BEGIN
+                    READ (FILE_FIX, ITEM_FIX, ONE_FIX);
+                    IF ITEM_FIX /= FIX THEN
+                        FAILED ("WRONG VALUE READ WITH INDEX " &
+                                "FOR FIXED POINT");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ WITH FROM FOR FIXED POINT");
+               END;
+
+               BEGIN
+                    DELETE (FILE_FIX);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2401I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401j.ada
new file mode 100644
index 000000000..85e43cc66
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401j.ada
@@ -0,0 +1,176 @@
+-- CE2401J.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 DATA WRITTEN INTO A DIRECT FILE CAN BE READ
+--     CORRECTLY.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION WITH INOUT_FILE MODE AND OPENING WITH IN_FILE MODE FOR
+--     DIRECT FILES.
+
+-- HISTORY:
+--     DWC 08/12/87  CREATE ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2401J IS
+     END_SUBTEST: EXCEPTION;
+BEGIN
+
+     TEST ("CE2401J" , "CHECK THAT DATA WRITTEN INTO A DIRECT FILE " &
+                       "CAN BE READ CORRECTLY");
+
+     DECLARE
+          PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+          USE DIR_IO;
+          FILE : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE WITH INOUT FILE NOT " &
+                                    "SUPPORTED");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               OUT_ITEM1 : INTEGER := 10;
+               OUT_ITEM2 : INTEGER := 21;
+               OUT_ITEM3 : INTEGER := 32;
+               IN_ITEM   : INTEGER;
+               ONE   : POSITIVE_COUNT := 1;
+               THREE : POSITIVE_COUNT := 3;
+               FIVE  : POSITIVE_COUNT := 5;
+          BEGIN
+               BEGIN
+                    WRITE (FILE, OUT_ITEM1, ONE);
+                    WRITE (FILE, OUT_ITEM2, THREE);
+                    BEGIN
+                         READ (FILE, IN_ITEM, ONE);
+                         IF OUT_ITEM1 /= IN_ITEM THEN
+                              FAILED ("INCORRECT INTEGER VALUE " &
+                                      "READ - 1");
+                         END IF;
+                    END;
+                    WRITE (FILE, OUT_ITEM3, FIVE);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE, IN_ITEM, THREE);
+                    IF OUT_ITEM2 /= IN_ITEM THEN
+                         FAILED ("INCORRECT INTEGER VALUE READ - 2");
+                    END IF;
+               END;
+
+               BEGIN
+                    RESET (FILE);
+                    READ (FILE, IN_ITEM);
+                    IF OUT_ITEM1 /= IN_ITEM THEN
+                         FAILED ("INCORRECT INTEGER VALUE READ - 3");
+                    END IF;
+               EXCEPTION
+                    WHEN USE_ERROR => NULL;
+               END;
+
+               CLOSE (FILE);
+
+               BEGIN
+                    OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE, IN_ITEM);
+                    IF OUT_ITEM1 /= IN_ITEM THEN
+                         FAILED ("INCORRECT INTEGER VALUE READ - 4");
+                         RAISE END_SUBTEST;
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ IN IN_FILE MODE - 1");
+               END;
+
+               BEGIN
+                    READ (FILE, IN_ITEM, ONE);
+                    IF OUT_ITEM1 /= IN_ITEM THEN
+                         FAILED ("INCORRECT INTEGER VALUE READ - 5");
+                         RAISE END_SUBTEST;
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ IN IN_FILE MODE - 2");
+               END;
+
+               BEGIN
+                    READ (FILE, IN_ITEM, FIVE);
+                    IF OUT_ITEM3 /= IN_ITEM THEN
+                         FAILED ("INCORRECT INTEGER VALUE READ - 6");
+                         RAISE END_SUBTEST;
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ IN IN_FILE MODE - 3");
+               END;
+
+               BEGIN
+                    READ (FILE, IN_ITEM, THREE);
+                    IF OUT_ITEM2 /= IN_ITEM THEN
+                         FAILED ("INCORRECT INTEGER VALUE READ - 7");
+                         RAISE END_SUBTEST;
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("READ IN IN_FILE MODE - 4");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2401J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401k.ada
new file mode 100644
index 000000000..2e00f66ef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401k.ada
@@ -0,0 +1,164 @@
+-- CE2401K.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 DATA CAN BE OVERWRITTEN IN THE DIRECT FILE AND
+--     THE CORRECT VALUES CAN LATER BE READ.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF INOUT_FILE MODE AND OPENING OF OUT_FILE MODE FOR
+--     DIRECT FILES.
+
+-- HISTORY:
+--     DWC 08/12/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2401K IS
+     END_SUBTEST: EXCEPTION;
+BEGIN
+
+     TEST ("CE2401K" , "CHECK THAT DATA CAN BE OVERWRITTEN IN " &
+                       "THE DIRECT FILE AND THE CORRECT VALUES " &
+                       "CAN LATER BE READ.");
+
+     DECLARE
+          PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+          USE DIR_IO;
+          FILE : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE " &
+                                    "NOT SUPPORTED");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               OUT_ITEM1 : INTEGER := 10;
+               OUT_ITEM2 : INTEGER := 21;
+               IN_ITEM   : INTEGER;
+               ONE : POSITIVE_COUNT := 1;
+               TWO : POSITIVE_COUNT := 2;
+          BEGIN
+               BEGIN
+                    WRITE (FILE, OUT_ITEM1, ONE);
+                    WRITE (FILE, OUT_ITEM2, TWO);
+                    WRITE (FILE, OUT_ITEM2, ONE);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE " &
+                                 "IN INOUT_FILE MODE");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE, IN_ITEM, ONE);
+                    IF OUT_ITEM2 /= IN_ITEM THEN
+                         FAILED ("INCORRECT INTEGER VALUE READ - 1");
+                         RAISE END_SUBTEST;
+                    END IF;
+               END;
+
+               BEGIN
+                    READ (FILE, IN_ITEM, TWO);
+                    IF OUT_ITEM2 /= IN_ITEM THEN
+                         FAILED ("INCORRECT INTEGER VALUE READ - 2");
+                         RAISE END_SUBTEST;
+                    END IF;
+               END;
+
+               CLOSE (FILE);
+
+               BEGIN
+                    OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    WRITE (FILE, OUT_ITEM1, ONE);
+                    WRITE (FILE, OUT_ITEM2, TWO);
+                    WRITE (FILE, OUT_ITEM1, TWO);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE " &
+                                 "IN OUT_FILE MODE");
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    RESET (FILE, IN_FILE);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         RAISE END_SUBTEST;
+               END;
+
+               BEGIN
+                    READ (FILE, IN_ITEM, ONE);
+                    IF OUT_ITEM1 /= IN_ITEM THEN
+                         FAILED ("INCORRECT INTEGER VALUE READ - 3");
+                         RAISE END_SUBTEST;
+                    END IF;
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         FAILED ("READ IN IN_FILE MODE - 1");
+               END;
+
+               BEGIN
+                    READ (FILE, IN_ITEM, TWO);
+                    IF OUT_ITEM1 /= IN_ITEM THEN
+                         FAILED ("INCORRECT INTEGER VALUE READ - 4");
+                         RAISE END_SUBTEST;
+                    END IF;
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         FAILED ("READ IN IN_FILE MODE - 2");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2401K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401l.ada
new file mode 100644
index 000000000..3ecba26fc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2401l.ada
@@ -0,0 +1,125 @@
+-- CE2401L.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 REWRITING AN ELEMENT DOES NOT CHANGE THE SIZE OF
+--     THE FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH INOUT_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     DWC 08/12/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2401L IS
+     END_SUBTEST: EXCEPTION;
+BEGIN
+
+     TEST ("CE2401L" , "CHECK THAT REWRITING AN ELEMENT DOES NOT " &
+                       "CHANGE THE SIZE OF THE FILE");
+
+     DECLARE
+          PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+          USE DIR_IO;
+          FILE : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FILE, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE " &
+                                    "NOT SUPPORTED");
+                    RAISE END_SUBTEST;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED ON " &
+                            "CREATE");
+                    RAISE END_SUBTEST;
+          END;
+
+          DECLARE
+               OUT_ITEM1 : INTEGER := 10;
+               OUT_ITEM2 : INTEGER := 21;
+               OUT_ITEM4 : INTEGER := 43;
+               IN_ITEM   : INTEGER;
+               ONE  : POSITIVE_COUNT := 1;
+               TWO  : POSITIVE_COUNT := 2;
+               FOUR : POSITIVE_COUNT := 4;
+               OLD_FILE_SIZE : POSITIVE_COUNT;
+          BEGIN
+               BEGIN
+                    WRITE (FILE, OUT_ITEM1, ONE);
+                    WRITE (FILE, OUT_ITEM4, FOUR);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED ON WRITE " &
+                                 "IN INOUT_FILE MODE");
+                         RAISE END_SUBTEST;
+               END;
+
+               OLD_FILE_SIZE := SIZE (FILE);
+
+               WRITE (FILE, OUT_ITEM1, ONE);
+               WRITE (FILE, OUT_ITEM4, FOUR);
+
+               IF OLD_FILE_SIZE /= SIZE (FILE) THEN
+                    FAILED ("FILE SIZE CHANGED DURING REWRITE - 1");
+                    RAISE END_SUBTEST;
+               END IF;
+
+               WRITE (FILE, OUT_ITEM1, ONE);
+               WRITE (FILE, OUT_ITEM2, TWO);
+               WRITE (FILE, OUT_ITEM4, FOUR);
+
+               OLD_FILE_SIZE := SIZE (FILE);
+
+               WRITE (FILE, OUT_ITEM1, FOUR);
+
+               IF OLD_FILE_SIZE /= SIZE (FILE) THEN
+                    FAILED ("FILE SIZE CHANGED DURING REWRITE - 2");
+                    RAISE END_SUBTEST;
+               END IF;
+          EXCEPTION
+               WHEN END_SUBTEST =>
+                    NULL;
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN END_SUBTEST =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2401L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada
new file mode 100644
index 000000000..f05330a34
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada
@@ -0,0 +1,161 @@
+-- CE2402A.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 READ, WRITE, INDEX, SET_INDEX, SIZE, AND
+--     END_OF_FILE RAISE STATUS_ERROR WHEN APPLIED TO A NON-OPEN
+--     DIRECT FILE.  USE_ERROR IS NOT PERMITTED.
+
+-- HISTORY:
+--     ABW 08/17/82
+--     SPS 09/16/82
+--     SPS 11/09/82
+--     JBG 08/30/83
+--     EG  11/26/84
+--     EG  06/04/85
+--     GMT 08/03/87  CLARIFIED SOME OF THE FAILED MESSAGES, AND
+--                   REMOVED THE EXCEPTION FOR CONSTRAINT_ERROR.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2402A IS
+
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     USE DIR;
+     FILE1   : FILE_TYPE;
+     CNST    : CONSTANT INTEGER := 101;
+     IVAL    : INTEGER;
+     BOOL    : BOOLEAN;
+     X_COUNT : COUNT;
+     P_COUNT : POSITIVE_COUNT;
+
+BEGIN
+     TEST ("CE2402A","CHECK THAT READ, WRITE, INDEX, "   &
+                     "SET_INDEX, SIZE, AND END_OF_FILE " &
+                     "RAISE STATUS_ERROR WHEN APPLIED "  &
+                     "A NON-OPEN DIRECT FILE");
+     BEGIN
+          WRITE (FILE1, CNST);
+          FAILED ("STATUS_ERROR WAS NOT RAISED ON WRITE - 1");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED ON WRITE - 2");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON WRITE - 3");
+     END;
+
+     BEGIN
+          X_COUNT := SIZE (FILE1);
+          FAILED ("STATUS_ERROR NOT RAISED ON SIZE - 4");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED ON SIZE - 5");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON SIZE - 6");
+     END;
+
+     BEGIN
+          BOOL := END_OF_FILE (FILE1);
+          FAILED ("STATUS_ERROR WAS NOT RAISED ON END_OF_FILE - 7");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED ON END_OF_FILE - 8");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON END_OF_FILE - 9");
+     END;
+
+     BEGIN
+          P_COUNT := INDEX (FILE1);
+          FAILED ("STATUS_ERROR WAS NOT RAISED ON INDEX - 10");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED ON INDEX - 11");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON INDEX - 12");
+     END;
+
+     BEGIN
+          READ (FILE1, IVAL);
+          FAILED ("STATUS_ERROR WAS NOT RAISED ON READ - 13");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED ON READ - 14");
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON READ - 15");
+     END;
+
+     DECLARE
+          ONE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
+     BEGIN
+          BEGIN
+               WRITE (FILE1, CNST, ONE);
+               FAILED ("STATUS_ERROR NOT RAISED ON WRITE - 16");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED ON WRITE - 17");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON WRITE - 18");
+          END;
+
+          BEGIN
+               SET_INDEX (FILE1,ONE);
+               FAILED ("STATUS_ERROR NOT RAISED ON SET_INDEX - 19");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED ON SET_INDEX - 20");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON SET_INDEX - 21");
+          END;
+
+          BEGIN
+               READ (FILE1, IVAL, ONE);
+               FAILED ("STATUS_ERROR WAS NOT RAISED ON READ - 22");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED ON READ - 23");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON READ - 24");
+          END;
+     END;
+
+     RESULT;
+
+END CE2402A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2403a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2403a.tst
new file mode 100644
index 000000000..0988eb256
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2403a.tst
@@ -0,0 +1,121 @@
+-- CE2403A.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, FOR DIRECT_IO, WRITE RAISES THE EXCEPTION
+--     USE_ERROR IF THE CAPACITY OF THE EXTERNAL FILE IS EXCEEDED.
+--     THIS TEST ONLY CHECKS THAT THE IMPLEMENTATION SUPPORTS AN
+--     EXTERNAL FILE CAPACITY OF 4096 CHARACTERS OR LESS.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     DIRECT FILES.  ALSO, THE IMPLEMENTATION MUST BE ABLE TO
+--     RESTRICT THE CAPACITY OF AN EXTERNAL FILE.
+
+--     $FORM_STRING2 IS DEFINED SUCH 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".
+
+-- HISTORY:
+--     JLH 07/12/88  CREATED ORIGINAL TEST.
+-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2403A IS
+
+     SUBTYPE STR512 IS STRING (1 .. 512);
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO (STR512);
+          USE DIR_IO;
+
+     FILE : FILE_TYPE;
+     ITEM : STR512 := (1 .. 512 => 'A');
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2403A", "CHECK FOR DIRECT_IO THAT WRITE RAISES " &
+                      "USE_ERROR IF THE CAPACITY OF THE EXTERNAL " &
+                      "FILE IS EXCEEDED");
+
+     BEGIN
+
+          IF
+$FORM_STRING2
+               = STRING'("CANNOT_RESTRICT_FILE_CAPACITY") THEN
+               NOT_APPLICABLE ("IMPLEMENTATION CANNOT RESTRICT FILE " &
+                               "CAPACITY");
+               RAISE INCOMPLETE;
+          ELSE
+               BEGIN
+                    CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME,
+
+$FORM_STRING2
+);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                         "WITH MODE OUT_FILE");
+                         RAISE INCOMPLETE;
+                    WHEN NAME_ERROR =>
+                         NOT_APPLICABLE ("NAME_ERROR RAISED ON " &
+                                         "CREATE WITH MODE OUT_FILE");
+                         RAISE INCOMPLETE;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                                 "CREATE");
+                         RAISE INCOMPLETE;
+               END;
+          END IF;
+
+          BEGIN
+               FOR I IN 1 .. 9 LOOP
+                    WRITE (FILE, ITEM);
+               END LOOP;
+               FAILED ("USE_ERROR NOT RAISED WHEN THE CAPACITY " &
+                       "OF THE EXTERNAL FILE IS EXCEEDED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE2403A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2404a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2404a.ada
new file mode 100644
index 000000000..11bec0f33
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2404a.ada
@@ -0,0 +1,99 @@
+-- CE2404A.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 READ RAISES MODE_ERROR WHEN THE CURRENT MODE IS
+--     OUT_FILE.
+
+--          A)  CHECK NON-TEMPORARY FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF DIRECT FILES WITH MODE OUT_FILE.
+
+-- HISTORY:
+--     DLD 08/17/82
+--     SPS 11/09/82
+--     SPS 11/22/82
+--     JBG 02/22/84  CHANGE TO .ADA TEST.
+--     EG  05/16/85
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     GMT 08/03/87  MOVED THE TEMP-FILE CASE TO CE2404B.ADA.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2404A IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+     USE DIR_IO;
+     DIR_FILE_1 : FILE_TYPE;
+     I          : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE2404A", "CHECK THAT READ RAISES MODE_ERROR WHEN THE " &
+                      "CURRENT MODE IS OUT_FILE AND THE FILE IS " &
+                      "A NON-TEMPORARY FILE");
+     BEGIN
+
+          CREATE (DIR_FILE_1, OUT_FILE, LEGAL_FILE_NAME);
+
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 2");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 3");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          READ (DIR_FILE_1, I);
+          FAILED ("MODE_ERROR NOT RAISED ON READ - 4");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON READ - 5");
+     END;
+
+     BEGIN
+          DELETE (DIR_FILE_1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2404A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2404b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2404b.ada
new file mode 100644
index 000000000..8e3d56077
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2404b.ada
@@ -0,0 +1,82 @@
+-- CE2404B.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 READ RAISES MODE_ERROR WHEN THE CURRENT MODE IS
+--     OUT_FILE.
+
+--          B)  CHECK TEMPORARY FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF DIRECT FILES WITH MODE OUT_FILE.
+
+-- HISTORY:
+--     GMT 08/03/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2404B IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
+     USE DIR_IO;
+     DIR_FILE_2 : FILE_TYPE;
+     I          : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE2404B", "CHECK THAT READ RAISES MODE_ERROR WHEN THE " &
+                      "CURRENT MODE IS OUT_FILE AND THE FILE IS " &
+                      "A TEMPORARY FILE");
+     BEGIN
+          CREATE (DIR_FILE_2, OUT_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 2");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          READ(DIR_FILE_2, I);
+          FAILED("MODE_ERROR NOT RAISED ON READ - 3");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED("WRONG EXCEPTION RAISED ON READ - 4");
+     END;
+
+     CLOSE (DIR_FILE_2);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2404B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2405b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2405b.ada
new file mode 100644
index 000000000..fb8224282
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2405b.ada
@@ -0,0 +1,157 @@
+-- CE2405B.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 READ RAISES END_ERROR WHEN THE CURRENT READ POSITION
+--     IS GREATER THAN THE END POSITION.  ALSO CHECK THAT END_OF_FILE
+--     CORRECTLY DETECTS THE END OF A DIRECT FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION WITH INOUT_FILE MODE AND OPENING OF IN_FILE MODE.
+
+-- HISTORY:
+--     SPS 09/28/82
+--     JBG 02/22/84  CHANGE TO .ADA TEST
+--     EG  05/16/85
+--     GMT 08/03/87  ADDED CODE TO CHECK THAT END_OF_FILE WORKS, AND
+--                   ADDED CODE TO PREVENT SOME EXCEPTION PROPAGATION.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2405B IS
+BEGIN
+     TEST ("CE2405B", "CHECK THAT END_ERROR IS RAISED BY READ AT THE " &
+                      "END OF A FILE AND THAT END_OF_FILE CORRECTLY " &
+                      "DETECTS THE END OF A DIRECT_IO FILE");
+     DECLARE
+          PACKAGE DIR IS NEW DIRECT_IO (CHARACTER);
+          USE DIR;
+          FT         : FILE_TYPE;
+          CH         : CHARACTER;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+
+          -- CREATE AND INITIALIZE FILE
+
+          BEGIN
+               CREATE (FT, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR | NAME_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR | NAME_ERROR WAS " &
+                                    "RAISED ON CREATE - 1");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+
+               WRITE (FT, 'C');
+               WRITE (FT, 'X');
+
+               -- BEGIN TEST
+
+               IF NOT END_OF_FILE (FT) THEN
+                    FAILED ("END_OF_FILE RETURNED INCORRECT " &
+                            "BOOLEAN VALUE - 3");
+               END IF;
+
+               BEGIN
+                    READ (FT, CH);
+                    FAILED ("END_ERROR NOT RAISED ON READ - 4");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED ON READ - 5");
+               END;
+
+               WRITE (FT,'E');
+
+               BEGIN
+                    READ (FT, CH);
+                    FAILED ("END_ERROR NOT RAISED ON READ - 6");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED ON READ - 7");
+               END;
+
+          END;
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN - 8");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON OPEN - 9");
+                    RAISE INCOMPLETE;
+          END;
+
+          DECLARE
+               COUNT_NBR_OF_READS : NATURAL := 0;
+               EXPECTED_COUNT     : CONSTANT := 3;
+          BEGIN
+               LOOP
+                    IF END_OF_FILE (FT) THEN
+                         EXIT;
+                    ELSE
+                         READ (FT, CH);
+                         COUNT_NBR_OF_READS := COUNT_NBR_OF_READS + 1;
+                    END IF;
+               END LOOP;
+
+               IF COUNT_NBR_OF_READS /= EXPECTED_COUNT THEN
+                      FAILED ("THE BAD VALUE FOR COUNT_NBR_OF_READS " &
+                              "IS " &
+                               NATURAL'IMAGE (COUNT_NBR_OF_READS) );
+               END IF;
+
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE2405B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2406a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2406a.ada
new file mode 100644
index 000000000..3fbf03781
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2406a.ada
@@ -0,0 +1,199 @@
+-- CE2406A.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:
+--     FOR A DIRECT ACCESS FILE, CHECK THAT AFTER A READ, THE CURRENT
+--     READ POSITION IS INCREMENTED BY ONE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     DIRECT_IO FILES.
+
+-- HISTORY:
+--     ABW 08/20/82
+--     SPS 09/16/82
+--     SPS 11/09/82
+--     JBG 02/22/84  CHANGE TO .ADA TEST.
+--     EG  05/16/85
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     GMT 08/05/87  REMOVED DEPENDENCE ON RESET AND ADDED CHECK FOR
+--                   USE_ERROR ON DELETE.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2406A IS
+
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     USE DIR;
+     FILE1                : FILE_TYPE;
+     INT                  : INTEGER := IDENT_INT (18);
+     BOOL                 : BOOLEAN := IDENT_BOOL (TRUE);
+     INT_ITEM1, INT_ITEM2 : INTEGER;
+     INCOMPLETE           : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2406A", "CHECK THAT READ POSITION IS INCREMENTED " &
+                      "BY ONE AFTER A READ");
+
+     -- CREATE AND INITIALIZE FILE1
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN NAME_ERROR | USE_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR | USE_ERROR RAISED " &
+                                    "ON CREATE - 1");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               WRITE (FILE1, INT);
+               WRITE (FILE1, 26);
+               WRITE (FILE1, 12);
+               WRITE (FILE1, 19);
+               WRITE (FILE1, INT);
+               WRITE (FILE1, 3);
+
+               -- BEGIN TEST
+
+               CLOSE (FILE1);
+               BEGIN
+                    OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED ON" &
+                                         "OPEN - 3");
+                         RAISE INCOMPLETE;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED ON " &
+                                         "OPEN - 4");
+                         RAISE INCOMPLETE;
+               END;
+
+
+               IF INDEX(FILE1) /= POSITIVE_COUNT (IDENT_INT(1)) THEN
+                    FAILED ("INITIAL INDEX VALUE INCORRECT - 5");
+               ELSE
+                    READ (FILE1, INT_ITEM1);
+                    IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN
+                         FAILED ("INDEX VALUE NOT INCREMENTED - 6");
+                    ELSE
+                         IF INT_ITEM1 /= IDENT_INT(18) THEN
+                              FAILED ("READ INCORRECT VALUE - 7");
+                         END IF;
+                         READ (FILE1, INT_ITEM1, 4);
+                         IF INDEX(FILE1) /=
+                            POSITIVE_COUNT (IDENT_INT(5)) THEN
+                             FAILED ("INDEX VALUE NOT INCREMENTED " &
+                                     "WHEN TO IS SPECIFIED - 8");
+                         ELSE
+                              IF INT_ITEM1 /= IDENT_INT(19) THEN
+                                   FAILED ("READ INCORRECT VALUE - 9");
+                              END IF;
+                              READ (FILE1, INT_ITEM1);
+                              IF INDEX(FILE1) /=
+                                 POSITIVE_COUNT(IDENT_INT(6)) THEN
+                                   FAILED ("INDEX VALUE NOT " &
+                                           "INCREMENTED WHEN " &
+                                           "LAST - 10");
+                              ELSIF INT_ITEM1 /= IDENT_INT(18) THEN
+                                   FAILED ("READ INCORRECT " &
+                                           "IN_FILE VALUE - 11");
+                              END IF;
+                         END IF;
+                    END IF;
+               END IF;
+
+               CLOSE (FILE1);
+               BEGIN
+                    OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED ON " &
+                                         "OPEN - 12");
+                         RAISE INCOMPLETE;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED ON " &
+                                         "OPEN - 13");
+                         RAISE INCOMPLETE;
+               END;
+
+               IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(1)) THEN
+                    FAILED ("INITIAL INDEX VALUE INCORRECT - 14");
+               ELSE
+                    READ (FILE1, INT_ITEM2);
+                    IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN
+                         FAILED ("INDEX VALUE NOT INCREMENTED - 15");
+                    ELSE
+                         IF INT_ITEM2 /= IDENT_INT(18) THEN
+                              FAILED ("READ INCORRECT VALUE - 16");
+                         END IF;
+                         READ (FILE1, INT_ITEM2, 4);
+                         IF INDEX (FILE1) /=
+                            POSITIVE_COUNT(IDENT_INT(5)) THEN
+                             FAILED ("INDEX VALUE NOT INCREMENTED " &
+                                     "WHEN TO IS SPECIFIED - 17");
+                         ELSE
+                              IF INT_ITEM2 /= IDENT_INT(19) THEN
+                                   FAILED ("INCORRECT VALUE - 18");
+                              END IF;
+                              READ (FILE1, INT_ITEM2);
+                              IF INDEX(FILE1) /=
+                                 POSITIVE_COUNT(IDENT_INT(6)) THEN
+                                   FAILED ("INDEX VALUE NOT " &
+                                           "INCREMENTED WHEN " &
+                                           "LAST - INOUT_FILE - 19");
+                              ELSIF INT_ITEM2 /= IDENT_INT(18) THEN
+                                   FAILED ("READ INCORRECT " &
+                                           "INOUT_FILE VALUE - 20");
+                              END IF;
+                         END IF;
+                    END IF;
+               END IF;
+
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE2406A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2407a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2407a.ada
new file mode 100644
index 000000000..ce55310db
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2407a.ada
@@ -0,0 +1,110 @@
+-- CE2407A.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 WRITE RAISES MODE_ERROR WHEN THE CURRENT MODE
+--     IS IN_FILE.
+
+--          1) CHECK NON-TEMPORARY FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH OUT_FILE MODE AND OPEN WITH IN_FILE MODE FOR DIRECT
+--     FILES.
+
+-- HISTORY:
+--     ABW 08/20/82
+--     SPS 09/16/82
+--     SPS 11/09/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     GMT 08/06/86  REMOVED THE DEPENDENCE ON RESET AND MOVED THE CHECK
+--                   FOR TEMPORARY FILES INTO CE2407B.ADA.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2407A IS
+
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     USE DIR;
+     INCOMPLETE : EXCEPTION;
+     FILE1      : FILE_TYPE;
+     INT        : INTEGER := IDENT_INT (18);
+
+BEGIN
+     TEST ("CE2407A", "CHECK THAT WRITE RAISES MODE_ERROR WHEN THE " &
+                      "CURRENT MODE IS IN_FILE AND THE FILE IS " &
+                      "A NON-TEMPORARY FILE");
+     BEGIN
+          CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 2");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 3");
+               RAISE INCOMPLETE;
+     END;
+
+     WRITE (FILE1, INT);
+     CLOSE (FILE1);
+
+     BEGIN
+          OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE("USE_ERROR RAISED ON OPEN - 4");
+               RAISE INCOMPLETE;
+     END;
+
+
+
+     BEGIN
+          WRITE (FILE1,INT);
+          FAILED ("MODE_ERROR NOT RAISED ON WRITE - 5");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED ON WRITE - 6");
+     END;
+
+     BEGIN
+          DELETE (FILE1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2407A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2407b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2407b.ada
new file mode 100644
index 000000000..b97b76160
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2407b.ada
@@ -0,0 +1,93 @@
+-- CE2407B.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 WRITE RAISES MODE_ERROR WHEN THE CURRENT MODE
+--     IS IN_FILE.
+
+--          2) CHECK TEMPORARY FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH OUT_FILE MODE AND RESET FROM OUT_FILE MODE TO
+--     IN_FILE MODE.
+
+-- HISTORY:
+--     GMT 08/06/86  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2407B IS
+
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     USE DIR;
+     INCOMPLETE : EXCEPTION;
+     FILE2      : FILE_TYPE;
+     INT        : INTEGER := IDENT_INT (18);
+
+BEGIN
+     TEST ("CE2407B", "CHECK THAT WRITE RAISES MODE_ERROR WHEN THE " &
+                      "CURRENT MODE IS IN_FILE AND THE FILE IS " &
+                      "A TEMPORARY FILE");
+     BEGIN
+          CREATE (FILE2, OUT_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 1");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE - 2");
+               RAISE INCOMPLETE;
+     END;
+
+     WRITE (FILE2, INT);
+
+     BEGIN
+          RESET (FILE2, IN_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE("USE_ERROR RAISED ON RESET - 3");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          WRITE (FILE2, INT);
+          FAILED ("MODE_ERROR NOT RAISED ON WRITE - 4");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED ON WRITE - 5");
+     END;
+
+     CLOSE (FILE2);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2407B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2408a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2408a.ada
new file mode 100644
index 000000000..a6cf7d3b4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2408a.ada
@@ -0,0 +1,120 @@
+-- CE2408A.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 WRITE DOES NOT CAUSE AN EXCEPTION WHEN THE TO
+--     PARAMETER IS GREATER THAN THE END POSITION.
+
+--          1) FILE MODE IS OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF DIRECT FILES WITH MODE OUT_FILE.
+
+-- HISTORY:
+--     DLD 08/19/82
+--     SPS 11/09/82
+--     EG  05/16/85
+--     GMT 08/05/87  ADDED A CHECK FOR USE_ERROR ON DELETE AND REMOVED
+--                   THE OTHERS EXCEPTION AT THE BOTTOM OF THE FILE.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2408A IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+     USE DIR_IO;
+
+     DIR_FILE   : FILE_TYPE;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2408A", "FOR FILES OF MODE OUT_FILE, CHECK THAT " &
+                      "WRITE DOES NOT CAUSE AN EXCEPTION  WHEN THE " &
+                      """TO"" PARAMETER IS GREATER THAN THE END " &
+                      "POSITION");
+
+     -- CREATE TEST FILE
+
+     BEGIN
+          CREATE (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH MODE " &
+                               "OUT_FILE FOR DIR_IO - 1");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
+                               "MODE OUT_FILE FOR DIR_IO - 2");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE WITH " &
+                       "MODE OUT_FILE FOR DIR_IO - 3");
+               RAISE INCOMPLETE;
+     END;
+
+     -- FILL UP FILE
+
+     WRITE (DIR_FILE, 3);
+     WRITE (DIR_FILE, 4);
+     WRITE (DIR_FILE, 5);
+     WRITE (DIR_FILE, 6);
+
+     -- WRITE WHERE TO IS LARGER THAN END OF FILE
+
+     BEGIN
+          WRITE (DIR_FILE, 9, 7);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("WRITE RAISED EXCEPTION WHEN TO " &
+                       "PARAMETER WAS BEYOND END - 4");
+     END;
+
+     BEGIN
+          SET_INDEX (DIR_FILE, 11);
+          WRITE (DIR_FILE, 10);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("SET_INDEX/WRITE RAISED EXCEPTION WHEN TO " &
+                       "PARAMETER EXCEEDS THE END POSITION - 5");
+     END;
+
+     -- DELETE TEST FILE
+
+     BEGIN
+          DELETE (DIR_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2408A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2408b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2408b.ada
new file mode 100644
index 000000000..7c2da6bb8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2408b.ada
@@ -0,0 +1,112 @@
+-- CE2408B.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 WRITE DOES NOT CAUSE AN EXCEPTION WHEN THE TO
+--     PARAMETER IS GREATER THAN THE END POSITION.
+
+--          2) FILE MODE IS INOUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF DIRECT FILES WITH MODE INOUT_FILE.
+
+-- HISTORY:
+--     GMT 08/05/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2408B IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+     USE DIR_IO;
+
+     DIR_FILE   : FILE_TYPE;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE2408B", "FOR FILES OF MODE INOUT_FILE, CHECK THAT " &
+                      "WRITE DOES NOT CAUSE AN EXCEPTION WHEN THE " &
+                      """TO"" PARAMETER IS GREATER THAN THE END " &
+                      "POSITION");
+     BEGIN
+          CREATE (DIR_FILE, INOUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
+                               "MODE INOUT_FILE FOR DIR_IO - 1");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
+                               "MODE INOUT_FILE FOR DIR_IO - 2");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE WITH " &
+                       "MODE INOUT_FILE FOR DIR_IO - 3");
+               RAISE INCOMPLETE;
+     END;
+
+     -- FILL UP FILE
+
+     WRITE (DIR_FILE, 3);
+     WRITE (DIR_FILE, 4);
+     WRITE (DIR_FILE, 5);
+     WRITE (DIR_FILE, 6);
+
+     -- WRITE WHERE TO IS LARGER THAN END OF FILE
+
+     BEGIN
+          WRITE (DIR_FILE, 9, 7);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("WRITE RAISED EXCEPTION WHEN TO " &
+                       "PARAMETER WAS BEYOND END - 4");
+     END;
+
+     BEGIN
+          SET_INDEX (DIR_FILE, 11);
+          WRITE (DIR_FILE, 10);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("SET_INDEX/WRITE RAISED EXCEPTION WHEN TO " &
+                       "PARAMETER EXCEEDS THE END POSITION - 5");
+     END;
+
+     -- DELETE TEST FILE
+
+     BEGIN
+          DELETE (DIR_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2408B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2409a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2409a.ada
new file mode 100644
index 000000000..e6e591f0e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2409a.ada
@@ -0,0 +1,113 @@
+-- CE2409A.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:
+--     FOR DIRECT ACCESS FILES, CHECK THAT A WRITE TO A POSITION
+--     GREATER THAN THE CURRENT END POSITION CAUSES THE WRITE
+--     POSITION AND THE FILE SIZE TO BE INCREMENTED.
+
+--          1) CHECK FILES OF MODE INOUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH INOUT_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     ABW 08/27/82
+--     SPS 11/09/82
+--     SPS 03/18/83
+--     EG  05/16/85
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     GMT 08/05/87  REVISED EXCEPTION HANDLING, ADDED CHECK FOR WRITE
+--                   USING TO, AND MOVED OUT_FILE CASE TO CE2409B.ADA.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2409A IS
+
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     USE DIR;
+     FILE1      : FILE_TYPE;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2409A", "CHECK THAT WRITE POSITION AND " &
+                      "SIZE ARE INCREMENTED CORRECTLY FOR " &
+                      "DIR FILES OF MODE INOUT_FILE");
+
+     BEGIN
+          CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR | NAME_ERROR =>
+               NOT_APPLICABLE ("CREATE WITH INOUT_FILE MODE NOT " &
+                               "SUPPORTED FOR DIR FILES - 1");
+               RAISE INCOMPLETE;
+     END;
+
+     DECLARE
+          INT      : INTEGER := IDENT_INT (18);
+          TWO_C    : COUNT := COUNT (IDENT_INT(2));
+          THREE_PC : POSITIVE_COUNT
+                           := POSITIVE_COUNT (IDENT_INT(3));
+          FIVE_C   : COUNT := COUNT (IDENT_INT(5));
+          FIVE_PC  : POSITIVE_COUNT
+                           := POSITIVE_COUNT (IDENT_INT(5));
+          SIX_PC  : POSITIVE_COUNT
+                           := POSITIVE_COUNT (IDENT_INT(6));
+     BEGIN
+          WRITE (FILE1, INT);
+          WRITE (FILE1, INT);
+          IF INDEX (FILE1) /= THREE_PC THEN
+               FAILED ("INCORRECT INDEX VALUE - 1");
+          END IF;
+          IF SIZE (FILE1) /= TWO_C THEN
+               FAILED ("INCORRECT SIZE VALUE - 2");
+          END IF;
+
+          WRITE (FILE1, INT, FIVE_PC);
+          IF INDEX (FILE1) /= SIX_PC THEN
+               FAILED ("INCORRECT INDEX VALUE - 3");
+          END IF;
+          IF SIZE (FILE1) /= FIVE_C THEN
+               FAILED ("INCORRECT SIZE VALUE - 4");
+          END IF;
+     END;
+
+     BEGIN
+          DELETE (FILE1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT ;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2409A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2409b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2409b.ada
new file mode 100644
index 000000000..544819864
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2409b.ada
@@ -0,0 +1,98 @@
+-- CE2409B.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:
+--     FOR DIRECT ACCESS FILES, CHECK THAT A WRITE TO A POSITION
+--     GREATER THAN THE CURRENT END POSITION CAUSES THE WRITE
+--     POSITION AND THE FILE SIZE TO BE INCREMENTED.
+
+--          2) CHECK FILES OF MODE OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH MODE OUT_FILE FOR DIRECT FILES.
+
+-- HISTORY:
+--     GMT 08/05/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2409B IS
+
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     USE DIR;
+     FILE1      : FILE_TYPE;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2409B", "CHECK THAT WRITE POSITION AND " &
+                      "SIZE ARE INCREMENTED APPROPRIATELY");
+     BEGIN
+          CREATE (FILE1, OUT_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE NOT " &
+                               "SUPPORTED FOR DIR FILES - 1");
+               RAISE INCOMPLETE;
+     END;
+
+     DECLARE
+          INT      : INTEGER := IDENT_INT (18);
+          TWO_C    : COUNT := COUNT (IDENT_INT(2));
+          THREE_C  : COUNT := COUNT (IDENT_INT(3));
+          THREE_PC : POSITIVE_COUNT
+                           := POSITIVE_COUNT (IDENT_INT(3));
+          FOUR_PC  : POSITIVE_COUNT
+                           := POSITIVE_COUNT (IDENT_INT(4));
+     BEGIN
+          WRITE (FILE1, INT);
+          WRITE (FILE1, INT);
+          IF INDEX (FILE1) /= THREE_PC THEN
+               FAILED ("INCORRECT VALUE FOR INDEX - 2");
+          END IF;
+          IF SIZE (FILE1) /= TWO_C THEN
+               FAILED ("INCORRECT VALUE FOR SIZE - 3");
+          END IF;
+
+          WRITE (FILE1, INT);
+          IF INDEX (FILE1) /= FOUR_PC THEN
+               FAILED ("INCORRECT VALUE FOR INDEX - 4");
+          END IF;
+          IF SIZE (FILE1) /= THREE_C THEN
+               FAILED ("INCORRECT VALUE FOR SIZE - 5");
+          END IF;
+
+     END;
+
+     CLOSE (FILE1);
+
+     RESULT ;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2409B ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2410a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2410a.ada
new file mode 100644
index 000000000..5029d1ec6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2410a.ada
@@ -0,0 +1,96 @@
+-- CE2410A.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 END_OF_FILE RAISES MODE_ERROR WHEN THE CURRENT
+--     MODE IS OUT_FILE.
+
+--          1) CHECK NON-TEMPORARY FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH OUT_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     ABW 08/20/82
+--     SPS 09/16/82
+--     SPS 11/09/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     EG  11/02/84
+--     EG  05/16/85
+--     GMT 08/05/87  REVISED EXCEPTION HANDLING AND MOVED THE CASE FOR
+--                   TEMPORARY FILES INTO CE2410B.ADA.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2410A IS
+
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     USE DIR;
+     FILE1       : FILE_TYPE;
+     INT         : INTEGER := IDENT_INT (18);
+     BOOL        : BOOLEAN;
+     INCOMPLETE  : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2410A", "CHECK THAT END_OF_FILE RAISES MODE_ERROR WHEN " &
+                      "THE CURRENT MODE IS OUT_FILE AND THE FILE IS " &
+                      "A NON-TEMPORARY FILE.");
+
+     BEGIN
+          CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR | NAME_ERROR =>
+               NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE NOT " &
+                               "SUPPORTED FOR DIRECT FILES - 1");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          BOOL := END_OF_FILE (FILE1);
+          FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 2");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON " &
+                       "END_OF_FILE - 3");
+     END;
+
+     BEGIN
+          DELETE (FILE1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT ;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2410A ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2410b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2410b.ada
new file mode 100644
index 000000000..665bc8efc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2410b.ada
@@ -0,0 +1,84 @@
+-- CE2410B.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 END_OF_FILE RAISES MODE_ERROR WHEN THE CURRENT
+--     MODE IS OUT_FILE.
+
+--          2) CHECK TEMPORARY FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH OUT_FILE MODE FOR DIRECT FILES.
+
+-- HISTORY:
+--     GMT 08/05/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH DIRECT_IO;
+
+PROCEDURE CE2410B IS
+
+     PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
+     USE DIR;
+     FILE1       : FILE_TYPE;
+     INT         : INTEGER := IDENT_INT (18);
+     BOOL        : BOOLEAN;
+     INCOMPLETE  : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE2410B", "CHECK THAT END_OF_FILE RAISES MODE_ERROR WHEN " &
+                      "THE CURRENT MODE IS OUT_FILE AND THE FILE IS " &
+                      "A TEMPORARY FILE.");
+
+     BEGIN
+          CREATE (FILE1, OUT_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("CREATE WITH OUT_FILE MODE NOT " &
+                               "SUPPORTED FOR DIRECT FILES - 1");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          BOOL := END_OF_FILE (FILE1);
+          FAILED ("MODE_ERROR NOT RAISED ON END_OF_FILE - 2");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED ON " &
+                       "END_OF_FILE - 3");
+     END;
+
+     CLOSE (FILE1);
+
+     RESULT ;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE2410B ;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2411a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2411a.ada
new file mode 100644
index 000000000..9f735df68
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce2411a.ada
@@ -0,0 +1,207 @@
+-- CE2411A.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 INDEX RETURNS THE CORRECT INDEX POSITION AND THAT
+--     SET_INDEX CORRECTLY SETS THE INDEX POSITION IN A DIRECT FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     DIRECT FILES.
+
+-- HISTORY:
+--     TBN 10/01/86
+--     JLH 08/07/87  REVISED EXTERNAL FILE NAME, REMOVED CHECK FOR
+--                   NAME_ERROR ON OPEN CALLS, AND REMOVED
+--                   UNNECESSARY CODE.
+
+WITH DIRECT_IO;
+WITH REPORT; USE REPORT;
+PROCEDURE CE2411A IS
+
+     PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER);
+     USE DIR_IO;
+
+     FILE1 : FILE_TYPE;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE2411A", "CHECK THAT INDEX RETURNS THE CORRECT INDEX " &
+                      "POSITION AND THAT SET_INDEX CORRECTLY SETS " &
+                      "THE INDEX POSITION IN A DIRECT FILE");
+
+
+     -- INITIALIZE TEST FILE
+
+     BEGIN
+          CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED DURING CREATE " &
+                               "WITH OUT_FILE MODE FOR DIR_IO");
+               RAISE INCOMPLETE;
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED DURING CREATE " &
+                               "WITH OUT_FILE MODE FOR DIR_IO");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNKNOWN EXCEPTION RAISED DURING CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          IF INDEX (FILE1) /= 1 THEN
+               FAILED ("STARTING INDEX POSITION IS INCORRECT - 1");
+               RAISE INCOMPLETE;
+          END IF;
+          FOR I IN 1 .. 10 LOOP
+               WRITE (FILE1, I);
+          END LOOP;
+          IF INDEX (FILE1) /= 11 THEN
+               FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 2");
+          END IF;
+          WRITE (FILE1, 20, 20);
+          IF INDEX (FILE1) /= 21 THEN
+               FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 3");
+          END IF;
+          SET_INDEX (FILE1, 11);
+          IF INDEX (FILE1) /= 11 THEN
+               FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - 4");
+          END IF;
+          WRITE (FILE1, 11);
+          IF INDEX (FILE1) /= 12 THEN
+               FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 5");
+          END IF;
+     END;
+
+     CLOSE (FILE1);
+
+     BEGIN
+          OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED DURING OPEN INFILE " &
+                               "FOR DIR_IO");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNKNOWN EXCEPTION RAISED DURING OPEN INFILE");
+               RAISE INCOMPLETE;
+     END;
+
+     DECLARE
+          NUM : INTEGER;
+     BEGIN
+          IF INDEX (FILE1) /= 1 THEN
+               FAILED ("STARTING INDEX POSITION IS INCORRECT - 7");
+               RAISE INCOMPLETE;
+          END IF;
+          FOR I IN 1 .. 10 LOOP
+               READ (FILE1, NUM);
+               IF NUM /= I THEN
+                    FAILED ("FILE CONTAINS INCORRECT DATA - 8");
+               END IF;
+               IF INDEX (FILE1) /= POSITIVE_COUNT(I + 1) THEN
+                    FAILED ("INDEX DOES NOT RETURN THE CORRECT " &
+                            "POSITION - 9");
+               END IF;
+          END LOOP;
+          SET_INDEX (FILE1, 20);
+          IF INDEX (FILE1) /= 20 THEN
+               FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " &
+                       "10");
+          END IF;
+          READ (FILE1, NUM, 20);
+          IF NUM /= 20 THEN
+               FAILED ("FILE CONTAINS INCORRECT DATA - 11");
+          END IF;
+          IF INDEX (FILE1) /= 21 THEN
+               FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 12");
+          END IF;
+          SET_INDEX (FILE1, 1);
+          IF INDEX (FILE1) /= 1 THEN
+               FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " &
+                       "13");
+          END IF;
+     END;
+
+     CLOSE (FILE1);
+
+     BEGIN
+          OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED DURING OPEN " &
+                               "INOUT_FILE FOR DIR_IO");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNKNOWN EXCEPTION RAISED DURING OPEN INOUT");
+               RAISE INCOMPLETE;
+     END;
+
+     DECLARE
+          NUM : INTEGER;
+     BEGIN
+          IF INDEX (FILE1) /= 1 THEN
+               FAILED ("STARTING INDEX POSITION IS INCORRECT - 15");
+               RAISE INCOMPLETE;
+          END IF;
+          FOR I IN 1 .. 10 LOOP
+               READ (FILE1, NUM);
+               IF NUM /= I THEN
+                    FAILED ("FILE CONTAINS INCORRECT DATA - 16");
+               END IF;
+               IF INDEX (FILE1) /= POSITIVE_COUNT(I + 1) THEN
+                    FAILED ("INDEX DOES NOT RETURN THE CORRECT " &
+                            "POSITION - 17");
+               END IF;
+          END LOOP;
+          SET_INDEX (FILE1, 20);
+          IF INDEX (FILE1) /= 20 THEN
+               FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " &
+                       "18");
+          END IF;
+          WRITE (FILE1, 12, 12);
+          IF INDEX (FILE1) /= 13 THEN
+               FAILED ("INDEX DOES NOT RETURN CORRECT POSITION - 19");
+          END IF;
+          SET_INDEX (FILE1, 1);
+          IF INDEX (FILE1) /= 1 THEN
+               FAILED ("SET_INDEX DOES NOT CORRECTLY SET POSITION - " &
+                       "20");
+          END IF;
+     END;
+
+     BEGIN
+          DELETE (FILE1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+END CE2411A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002b.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002b.tst
new file mode 100644
index 000000000..7dcc28fe0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002b.tst
@@ -0,0 +1,84 @@
+-- CE3002B.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 COUNT IS A VISIBLE TYPE, THAT COUNT'FIRST IS 0,
+--     THAT POSITIVE_COUNT IS A SUBTYPE OF COUNT, THAT
+--     POSITIVE_COUNT'FIRST IS 1, THAT POSITIVE_COUNT'LAST
+--     EQUALS COUNT'LAST, AND COUNT'LAST HAS A SPECIFIED
+--     IMPLEMENTATION-DEPENDENT VALUE.
+
+-- HISTORY:
+--     SPS 09/30/82
+--     SPS 11/09/82
+--     JBG 03/16/83
+--     JLH 08/07/87  REVISED VALUES USED IN COUNT AND POSITIVE_COUNT
+--                   TO THE INTEGER VALUE 1.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3002B IS
+BEGIN
+
+     TEST ("CE3002B", "CHECK THAT COUNT IS VISIBLE, COUNT'FIRST IS " &
+                      "0, POSITIVE_COUNT IS A SUBTYPE OF COUNT, " &
+                      "POSITIVE_COUNT'FIRST IS 1, POSITIVE_COUNT'" &
+                      "LAST EQUALS COUNT'LAST, AND COUNT'LAST " &
+                      "HAS A SPECIFIED VALUE");
+
+     DECLARE
+          X : COUNT;
+          A : POSITIVE_COUNT;
+     BEGIN
+          IF COUNT'FIRST /= COUNT(IDENT_INT (0)) THEN
+               FAILED ("COUNT'FIRST NOT 0; IS" &
+                       COUNT'IMAGE(COUNT'FIRST));
+          END IF;
+
+          IF POSITIVE_COUNT'FIRST /= POSITIVE_COUNT (IDENT_INT (1)) THEN
+               FAILED ("POSITIVE_COUNT'FIRST NOT 1; IS" &
+                       COUNT'IMAGE(POSITIVE_COUNT'FIRST));
+          END IF;
+
+          IF POSITIVE_COUNT'LAST /= COUNT'LAST THEN
+               FAILED ("POSITIVE_COUNT'LAST NOT EQUAL COUNT'LAST");
+          END IF;
+
+          IF COUNT'LAST /= $COUNT_LAST THEN
+               FAILED ("COUNT'LAST NOT $COUNT_LAST; IS" &
+                       COUNT'IMAGE(COUNT'LAST));
+          END IF;
+
+          X := POSITIVE_COUNT (IDENT_INT (1));
+          A := X;
+          A := COUNT (IDENT_INT (1));
+          X := A;
+     END;
+
+     RESULT;
+
+END CE3002B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002c.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002c.tst
new file mode 100644
index 000000000..c240907f8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002c.tst
@@ -0,0 +1,69 @@
+-- CE3002C.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 FIELD IS A SUBTYPE OF INTEGER, FIELD'FIRST = 0, AND
+--     FIELD'LAST HAS A SPECIFIED IMPLEMENTATION-DEPENDENT VALUE.
+
+-- HISTORY:
+--     SPS 09/30/82
+--     SPS 11/09/82
+--     JBG 03/16/83
+--     JLH 08/07/87  REVISED VALUES USED IN INTEGER AND FIELD TO THE
+--                   INTEGER VALUE 1.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3002C IS
+BEGIN
+
+     TEST ("CE3002C", "CHECK THAT FIELD IS A SUBTYPE OF INTEGER AND " &
+                      "FIELD'FIRST = 0");
+
+     DECLARE
+          A : INTEGER;
+          B : FIELD;
+     BEGIN
+          IF FIELD'FIRST /= IDENT_INT (0) THEN
+               FAILED ("FIELD'FIRST NOT 0; IS" &
+                       FIELD'IMAGE(FIELD'FIRST));
+          END IF;
+
+          IF FIELD'LAST /= $FIELD_LAST THEN
+               FAILED ("FIELD'LAST NOT $FIELD_LAST; IS" &
+                       FIELD'IMAGE(FIELD'LAST));
+          END IF;
+
+          A := IDENT_INT (1);
+          B := A;
+          B := IDENT_INT (1);
+          A := B;
+     END;
+
+     RESULT;
+
+END CE3002C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002d.ada
new file mode 100644
index 000000000..3d1976014
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002d.ada
@@ -0,0 +1,61 @@
+-- CE3002D.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 NUMBER_BASE IS A SUBTYPE OF INTEGER, WITH
+-- NUMBER_BASE'FIRST EQUAL 2 AND NUMBER_BASE'LAST EQUAL 16.
+
+-- SPS 10/1/82
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3002D IS
+BEGIN
+
+     TEST ("CE3002D", "CHECK THAT NUMBER_BASE IS A SUBTYPE " &
+                      "OF INTEGER WITH NUMBER_BASE'FIRST = 2 " &
+                      "AND NUMBER_BASE'LAST = 16");
+
+     DECLARE
+          X : INTEGER;
+          Y : NUMBER_BASE;
+     BEGIN
+          IF NUMBER_BASE'FIRST /= IDENT_INT (2) THEN
+               FAILED ("NUMBER_BASE'FIRST NOT 2");
+          END IF;
+
+          IF NUMBER_BASE'LAST /= IDENT_INT (16) THEN
+               FAILED ("NUMBER_BASE'LAST NOT 16");
+          END IF;
+
+          X := IDENT_INT (3);
+          Y := X;
+          Y := IDENT_INT (8);
+          X := Y;
+     END;
+
+RESULT;
+END CE3002D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002f.ada
new file mode 100644
index 000000000..ad15ecdee
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3002f.ada
@@ -0,0 +1,55 @@
+-- CE3002F.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 UNBOUNDED HAS TYPE COUNT AND VALUE ZERO.
+
+-- SPS 10/1/82
+-- SPS 11/9/82
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3002F IS
+BEGIN
+
+     TEST ("CE3002F", "CHECK THAT UNBOUNDED HAS TYPE COUNT AND " &
+                      "VALUE ZERO");
+
+     DECLARE
+          Z : COUNT := 0;
+     BEGIN
+          IF UNBOUNDED /= COUNT(IDENT_INT(0)) THEN
+               FAILED ("UNBOUNDED NOT 0");
+          END IF;
+
+          IF UNBOUNDED /= Z THEN
+               FAILED ("UNBOUNDED NOT COUNT");
+          END IF;
+     END;
+
+     RESULT;
+
+END CE3002F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102a.ada
new file mode 100644
index 000000000..ec5c5001d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102a.ada
@@ -0,0 +1,151 @@
+-- CE3102A.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 STATUS_ERROR IS RAISED BY CREATE AND OPEN
+--     IF THE GIVEN TEXT FILES ARE ALREADY OPEN.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH MODE OUT_FILE FOR TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/24/82
+--     SPS 09/16/82
+--     SPS 11/09/82
+--     JBG 07/25/83
+--     JLH 08/07/87  COMPLETE REVISION OF TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3102A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3102A" , "CHECK THAT STATUS_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR TEXT FILES");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          CREATE (FILE, OUT_FILE);
+          FAILED ("STATUS_ERROR NOT RAISED FOR CREATE - 1");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE - 1");
+     END;
+
+     BEGIN
+          CREATE (FILE, IN_FILE);
+          FAILED ("STATUS_ERROR NOT RAISED FOR CREATE - 2");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE - 2");
+     END;
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          FAILED ("STATUS_ERROR NOT RAISED FOR CREATE - 3");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE - 3");
+     END;
+
+     BEGIN
+          OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 1");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 1");
+     END;
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 2");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 2");
+     END;
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME (2, "CE3102A"));
+          FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 3");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 3");
+     END;
+
+     BEGIN
+          CREATE (FILE, IN_FILE, LEGAL_FILE_NAME (2, "CE3102A"));
+          FAILED ("STATUS_ERROR NOT RAISED FOR OPEN - 4");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR OPEN - 4");
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3102A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102b.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102b.tst
new file mode 100644
index 000000000..2383d45d8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102b.tst
@@ -0,0 +1,184 @@
+-- CE3102B.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 FOR TEXT FILES NAME_ERROR IS RAISED BY CREATE AND
+--     OPEN IF THE GIVEN NAME STRING DOES NOT ALLOW THE IDENTIFICATION
+--     OF AN EXTERNAL FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE FOR TEXT_IO.
+
+-- HISTORY:
+--     ABW 08/24/82
+--     JBG 03/16/83
+--     EG  05/30/85
+--     JLH 08/12/87  REMOVED UNNECESSARY CODE, ADDED NEW CASES FOR OPEN,
+--                   AND REMOVED DEPENDENCE ON DELETE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3102B IS
+
+     FILE1, FILE2 : FILE_TYPE;
+     FILE_NAME_OK : BOOLEAN := FALSE;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3102B", "CHECK THAT NAME_ERROR IS RAISED " &
+                      "APPROPRIATELY");
+
+     -- CHECK THAT A LEGAL FILE NAME IS OK SO TEST IS VALID
+
+     BEGIN
+          CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                               "OF ASSUMED VALID FILE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                               "OF ASSUMED VALID FILE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          DELETE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               FAILED ("FILE STILL EXISTS AFTER DELETE");
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NULL;
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                            "IN_FILE MODE");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT OPEN");
+          END;
+
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     -- PERFORM VARIOUS CHECKS
+
+     BEGIN
+          OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME(2));
+          FAILED ("NO EXCEPTION FOR NON-EXISTENT FILE - IN_FILE");
+     EXCEPTION
+          WHEN NAME_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR OPEN OF " &
+                       "NON-EXISTENT FILE - IN_FILE");
+     END;
+
+     BEGIN
+          OPEN (FILE2, OUT_FILE, LEGAL_FILE_NAME(3));
+          FAILED ("NO EXCEPTION FOR NON-EXISTENT FILE - OUT_FILE");
+     EXCEPTION
+          WHEN NAME_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR OPEN FOR " &
+                       "NON-EXISTENT FILE - OUT_FILE");
+     END;
+
+     BEGIN
+          CREATE (FILE1, NAME => "$ILLEGAL_EXTERNAL_FILE_NAME1");
+          FAILED ("NO EXCEPTION RAISED FOR " &
+                  "$ILLEGAL_EXTERNAL_FILE_NAME1 - CREATE");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED FOR " &
+                       "$ILLEGAL_EXTERNAL_FILE_NAME1 - CREATE");
+          WHEN NAME_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR " &
+                       "$ILLEGAL_EXTERNAL_FILE_NAME1 - CREATE");
+     END;
+
+     BEGIN
+          CREATE (FILE2, NAME => "$ILLEGAL_EXTERNAL_FILE_NAME2");
+          FAILED ("NO EXCEPTION RAISED FOR " &
+                  "$ILLEGAL_EXTERNAL_FILE_NAME2 - CREATE");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED FOR " &
+                       "$ILLEGAL_EXTERNAL_FILE_NAME2 - CREATE");
+          WHEN NAME_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR " &
+                       "$ILLEGAL_EXTERNAL_FILE_NAME2 - CREATE");
+     END;
+
+     BEGIN
+          OPEN (FILE2, IN_FILE,
+                NAME => "$ILLEGAL_EXTERNAL_FILE_NAME1");
+          FAILED ("NO EXCEPTION RAISED FOR " &
+                  "$ILLEGAL_EXTERNAL_FILE_NAME1 - OPEN");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               FAILED ("USE ERROR RAISED FOR " &
+                       "$ILLEGAL_EXTERNAL_FILE_NAME1 - OPEN");
+          WHEN NAME_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR " &
+                       "$ILLEGAL_EXTERNAL_FILE_NAME1 - OPEN");
+     END;
+
+     BEGIN
+          OPEN (FILE1, IN_FILE,
+                NAME => "$ILLEGAL_EXTERNAL_FILE_NAME2");
+          FAILED ("NO EXCEPTION RAISED FOR " &
+                  "$ILLEGAL_EXTERNAL_FILE_NAME2 - OPEN");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED FOR " &
+                       "$ILLEGAL_EXTERNAL_FILE_NAME2 - OPEN");
+          WHEN NAME_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR " &
+                       "$ILLEGAL_EXTERNAL_FILE_NAME2 - OPEN");
+     END;
+
+     RESULT;
+
+EXCEPTION
+
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3102B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102d.ada
new file mode 100644
index 000000000..0f58c1976
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102d.ada
@@ -0,0 +1,145 @@
+-- CE3102D.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 STATUS_ERROR IS RAISED BY CLOSE, DELETE, RESET, MODE,
+--     NAME, AND FORM IF THE GIVEN TEXT FILES ARE NOT OPEN.
+
+-- HISTORY:
+--     JLH 08/10/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3102D IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     FT : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3102D" , "CHECK THAT STATUS_ERROR IS RAISED " &
+                       "APPROPRIATELY FOR TEXT FILES");
+
+     BEGIN
+          CREATE (FT);
+          CLOSE (FT);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR CREATE");
+     END;
+
+     BEGIN
+          RESET (FT);
+          FAILED ("STATUS_ERROR NOT RAISED FOR RESET");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED FOR RESET OF CLOSED FILE");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR RESET");
+     END;
+
+     BEGIN
+          DECLARE
+               MD : FILE_MODE := MODE (FT);
+          BEGIN
+               FAILED ("STATUS_ERROR NOT RAISED FOR MODE");
+          END;
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED FOR MODE OF CLOSED FILE");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR MODE");
+     END;
+
+     BEGIN
+          DECLARE
+               NM : CONSTANT STRING := NAME (FT);
+          BEGIN
+               FAILED ("STATUS_ERROR NOT RAISED FOR NAME");
+          END;
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED FOR NAME OF CLOSED FILE");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR NAME");
+     END;
+
+     BEGIN
+          DECLARE
+               FM : CONSTANT STRING := FORM (FT);
+          BEGIN
+               FAILED ("STATUS_ERROR NOT RAISED FOR FORM");
+          END;
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED FOR FORM OF CLOSED FILE");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR FORM");
+     END;
+
+     BEGIN
+          CLOSE (FT);
+          FAILED ("STATUS_ERROR NOT RAISED FOR CLOSE");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED WHEN CLOSING CLOSED FILE");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR CLOSE");
+     END;
+
+     BEGIN
+          DELETE (FT);
+          FAILED ("STATUS_ERROR NOT RAISED FOR DELETE");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN USE_ERROR =>
+               FAILED ("USE_ERROR RAISED FOR DELETE OF CLOSED FILE");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR DELETE");
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3102D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102e.ada
new file mode 100644
index 000000000..c971abd48
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102e.ada
@@ -0,0 +1,63 @@
+-- CE3102E.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
+--     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE
+--     IMPLEMENTATION FOR TEXT FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT IN_FILE MODE WITH CREATE FOR TEXT FILES.
+
+-- HISTORY:
+--     JLH 08/12/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3102E IS
+
+     FILE1 : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3102E", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF CREATE FOR TEXT FILES");
+
+     BEGIN
+          CREATE (FILE1, IN_FILE);
+          CLOSE (FILE1);
+          NOT_APPLICABLE ("CREATE WITH MODE IN_FILE ALLOWED");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+     END;
+
+     RESULT;
+
+END CE3102E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102f.ada
new file mode 100644
index 000000000..d87b80ae4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102f.ada
@@ -0,0 +1,130 @@
+-- CE3102F.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 USE_ERROR IS RAISED WHEN AN EXTERNAL FILE
+--     CANNOT BE RESET.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES, BUT DO NOT SUPPORT RESET OF EXTERNAL FILES.
+
+-- HISTORY:
+--     JLH 08/12/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3102F IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3102F", "CHECK THAT USE_ERROR IS RAISED WHEN AN " &
+                      "EXTERNAL FILE CANNOT BE RESET");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (FILE);
+          NOT_APPLICABLE ("RESET FOR OUT_FILE MODE ALLOWED - 1");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET - 1");
+     END;
+
+     PUT (FILE, "HELLO");
+
+     BEGIN
+          RESET (FILE, IN_FILE);
+          NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE MODE " &
+                          "ALLOWED - 1");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RASIED FOR RESET - 2");
+     END;
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("TEXT_IO NOT SUPPORTED FOR IN_FILE " &
+                               "OPEN");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (FILE);
+          NOT_APPLICABLE ("RESET FOR IN_FILE MODE ALLOWED - 2");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET - 3");
+     END;
+
+     BEGIN
+          RESET (FILE, OUT_FILE);
+          NOT_APPLICABLE ("RESET FROM IN_FILE TO OUT_FILE MODE " &
+                          "ALLOWED - 2");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET - 4");
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3102F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102g.ada
new file mode 100644
index 000000000..a60f50f22
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102g.ada
@@ -0,0 +1,84 @@
+-- CE3102G.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 USE_ERROR IS RAISED WHEN AN EXTERNAL FILE
+--     CANNOT BE DELETED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES, BUT DO NOT SUPPORT DELETION OF EXTERNAL FILES.
+
+-- HISTORY:
+--     JLH 08/12/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3102G IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     VAR1 : CHARACTER := 'A';
+
+BEGIN
+
+     TEST ("CE3102G" , "CHECK THAT USE_ERROR IS RAISED WHEN AN " &
+                       "EXTERNAL FILE CANNOT BE DELETED");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               NOT_APPLICABLE ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     PUT (FILE, VAR1);
+
+     BEGIN
+          DELETE (FILE);
+          NOT_APPLICABLE ("DELETION OF EXTERNAL FILES ALLOWED");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR DELETE");
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3102G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102h.ada
new file mode 100644
index 000000000..152b6eabc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102h.ada
@@ -0,0 +1,116 @@
+-- CE3102H.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 MODE_ERROR IS RAISED WHEN ATTEMPTING TO CHANGE
+--     THE MODE OF A FILE SERVING AS THE CURRENT DEFAULT INPUT
+--     OR DEFAULT OUTPUT FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 08/12/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3102H IS
+
+     FILE1 : FILE_TYPE;
+     INCOMPLETE : EXCEPTION;
+     ITEM : CHARACTER := 'A';
+
+BEGIN
+
+     TEST ("CE3102H", "CHECK THAT MODE_ERROR IS RAISED WHEN " &
+                      "ATTEMPTING TO CHANGE THE MODE OF A FILE " &
+                      "SERVING AS THE CURRENT DEFAULT INPUT OR " &
+                      "DEFAULT OUTPUT FILE");
+
+     BEGIN
+          CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_OUTPUT (FILE1);
+
+     BEGIN
+          RESET (FILE1, IN_FILE);
+          FAILED ("MODE_ERROR NOT RAISED FOR RESET");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET");
+     END;
+
+     SET_OUTPUT (STANDARD_OUTPUT);
+
+     PUT (FILE1, ITEM);
+     CLOSE (FILE1);
+
+     BEGIN
+          OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_INPUT (FILE1);
+
+     BEGIN
+          RESET (FILE1, OUT_FILE);
+          FAILED ("MODE_ERROR NOT RAISED FOR RESET");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR RESET");
+     END;
+
+     SET_INPUT (STANDARD_INPUT);
+
+     BEGIN
+          DELETE (FILE1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3102H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102i.ada
new file mode 100644
index 000000000..cc126bc7e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102i.ada
@@ -0,0 +1,63 @@
+-- CE3102I.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 USE_ERROR IS RAISED WHEN CREATING A FILE OF MODE
+--     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR CREATE BY THE
+--     IMPLEMENTATION FOR TEXT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT OUT_FILE FOR CREATE FOR TEXT_IO.
+
+-- HISTORY:
+--     JLH 08/12/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3102I IS
+
+     FILE1 : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3102I", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF CREATE FOR TEXT_IO");
+
+     BEGIN
+          CREATE (FILE1, OUT_FILE);
+          CLOSE (FILE1);
+          NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE ALLOWED");
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+     END;
+
+     RESULT;
+
+END CE3102I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102j.ada
new file mode 100644
index 000000000..ce1b5f689
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102j.ada
@@ -0,0 +1,98 @@
+-- CE3102J.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
+--     IN_FILE, WHEN IN_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
+--     IMPLEMENTATION FOR TEXT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT IN_FILE MODE FOR OPEN FOR TEXT_IO.
+
+-- HISTORY:
+--     JLH 08/12/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3102J IS
+
+     FILE1 : FILE_TYPE;
+     INCOMPLETE : EXCEPTION;
+     RAISED_USE_ERROR : BOOLEAN := FALSE;
+     VAR1 : CHARACTER := 'A';
+
+BEGIN
+
+     TEST ("CE3102J", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "IN_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF OPEN FOR TEXT_IO");
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE1, VAR1);
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               NOT_APPLICABLE ("OPEN FOR IN_FILE MODE ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+          END;
+
+          IF IS_OPEN (FILE1) THEN
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END IF;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3102J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102k.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102k.ada
new file mode 100644
index 000000000..151a4d687
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3102k.ada
@@ -0,0 +1,98 @@
+-- CE3102K.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 USE_ERROR IS RAISED WHEN OPENING A FILE OF MODE
+--     OUT_FILE, WHEN OUT_FILE MODE IS NOT SUPPORTED FOR OPEN BY THE
+--     IMPLEMENTATION FOR TEXT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH DO NOT
+--     SUPPORT OUT_FILE MODE FOR OPEN FOR TEXT_IO.
+
+-- HISTORY:
+--     JLH 08/12/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3102K IS
+
+     FILE1 : FILE_TYPE;
+     INCOMPLETE : EXCEPTION;
+     RAISED_USE_ERROR : BOOLEAN := FALSE;
+     VAR1 : CHARACTER := 'A';
+
+BEGIN
+
+     TEST ("CE3102K", "CHECK THAT USE_ERROR IS RAISED WHEN MODE " &
+                      "OUT_FILE IS NOT SUPPORTED FOR THE OPERATION " &
+                      "OF OPEN FOR TEXT_IO");
+     BEGIN
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE FOR " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE1, VAR1);
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+               NOT_APPLICABLE ("OPEN FOR OUT_FILE MODE ALLOWED");
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+          END;
+
+          IF IS_OPEN (FILE1) THEN
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END IF;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3102K;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3103a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3103a.ada
new file mode 100644
index 000000000..7b09a7727
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3103a.ada
@@ -0,0 +1,216 @@
+-- CE3103A.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 PAGE AND LINE LENGTH OF TEXT FILES ARE ZERO
+--     AFTER A CREATE, OPEN, OR RESET TO OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILE.
+
+-- HISTORY:
+--     ABW 08/24/82
+--     SPS 09/16/82
+--     SPS 11/09/82
+--     SPS 01/18/83
+--     EG  11/02/84
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/13/87  REVISED TEST TO INCLUDE CASES TO RESET THE FILE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3103A IS
+
+     SUBTEST : EXCEPTION;
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     ZERO : CONSTANT COUNT := COUNT(IDENT_INT(0));
+     TWO  : CONSTANT COUNT := COUNT (IDENT_INT(2));
+     FIVE : CONSTANT COUNT := COUNT (IDENT_INT(5));
+
+BEGIN
+
+     TEST ("CE3103A" , "CHECK THAT PAGE AND LINE LENGTH " &
+                       "ARE SET TO ZERO AFTER CREATE, " &
+                       "OPEN, OR RESET");
+
+BEGIN
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     IF LINE_LENGTH (FILE) /= ZERO THEN
+          FAILED ("LINE_LENGTH FOR CREATE IS NOT ZERO");
+     END IF;
+     IF PAGE_LENGTH (FILE) /= ZERO THEN
+          FAILED ("PAGE_LENGTH FOR CREATE IS NOT ZERO");
+     END IF;
+
+     SET_LINE_LENGTH (FILE, TWO);
+     SET_PAGE_LENGTH (FILE, FIVE);
+
+     PUT_LINE (FILE, "HI");
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN");
+               RAISE INCOMPLETE;
+     END;
+
+     IF LINE_LENGTH (FILE) /= ZERO THEN
+          FAILED ("LINE_LENGTH FOR OPEN IS NOT ZERO");
+     END IF;
+     IF PAGE_LENGTH (FILE) /= ZERO THEN
+          FAILED ("PAGE_LENGTH FOR OPEN IS NOT ZERO");
+     END IF;
+
+     SET_LINE_LENGTH (FILE, TWO);
+     SET_PAGE_LENGTH (FILE, TWO);
+
+     PUT_LINE (FILE, "HI");
+
+     BEGIN
+          BEGIN
+               RESET (FILE, OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    RAISE SUBTEST;
+          END;
+
+          IF LINE_LENGTH (FILE) /= ZERO THEN
+               FAILED ("LINE_LENGTH FOR RESET TO OUT_FILE IS NOT " &
+                       "ZERO - 1");
+          END IF;
+          IF PAGE_LENGTH (FILE) /= ZERO THEN
+               FAILED ("PAGE_LENGTH FOR RESET TO OUT_FILE IS NOT " &
+                       "ZERO - 1");
+          END IF;
+     EXCEPTION
+          WHEN SUBTEST =>
+               NULL;
+     END;
+
+     SET_LINE_LENGTH (FILE, FIVE);
+     SET_PAGE_LENGTH (FILE, FIVE);
+
+     PUT_LINE (FILE, "HELLO");
+
+     IF LINE_LENGTH (FILE) /= 5 THEN
+          FAILED ("LINE_LENGTH FOR RESET IN OUT_FILE, PLUS HELLO " &
+                  "IS NOT FIVE");
+     END IF;
+     IF PAGE_LENGTH (FILE) /= 5 THEN
+          FAILED ("PAGE_LENGTH FOR RESET IN OUT_FILE, PLUS HELLO " &
+                  "IS NOT FIVE");
+     END IF;
+
+     BEGIN
+          BEGIN
+               RESET (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    RAISE SUBTEST;
+          END;
+
+          IF LINE_LENGTH (FILE) /= ZERO THEN
+               FAILED ("LINE_LENGTH FOR RESET IS NOT ZERO");
+          END IF;
+          IF PAGE_LENGTH (FILE) /= ZERO THEN
+               FAILED ("PAGE_LENGTH FOR RESET IS NOT ZERO");
+          END IF;
+     EXCEPTION
+          WHEN SUBTEST =>
+               NULL;
+     END;
+
+     SET_LINE_LENGTH (FILE, FIVE);
+     SET_PAGE_LENGTH (FILE, FIVE);
+
+     PUT_LINE (FILE, "HELLO");
+
+     IF LINE_LENGTH (FILE) /= 5 THEN
+          FAILED ("LINE_LENGTH FOR RESET PLUS HELLO");
+     END IF;
+     IF PAGE_LENGTH (FILE) /= 5 THEN
+          FAILED ("PAGE_LENGTH FOR RESET PLUS HELLO");
+     END IF;
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (FILE, OUT_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               RAISE INCOMPLETE;
+     END;
+
+     IF LINE_LENGTH (FILE) /= ZERO THEN
+          FAILED ("LINE_LENGTH FOR RESET TO OUT_FILE IS NOT ZERO - 2");
+     END IF;
+     IF PAGE_LENGTH (FILE) /= ZERO THEN
+          FAILED ("PAGE_LENGTH FOR RESET TO OUT_FILE IS NOT ZERO - 2");
+     END IF;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          NULL;
+END;
+
+RESULT;
+
+END CE3103A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3104a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3104a.ada
new file mode 100644
index 000000000..4725f2473
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3104a.ada
@@ -0,0 +1,231 @@
+-- CE3104A.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 CURRENT COLUMN, LINE, AND PAGE NUMBERS OF
+--     TEXT FILES ARE SET TO ONE AFTER A CREATE, OPEN, OR RESET.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/24/82
+--     SPS 09/16/82
+--     SPS 11/09/82
+--     JBG 03/16/83
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/13/87  CHANGED FAILED MESSAGES AND ADDED SUBTEST
+--                   EXCEPTION.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3104A IS
+
+     INCOMPLETE, SUBTEST : EXCEPTION;
+     FILE, FT : FILE_TYPE;
+     ONE      : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
+     CHAR     : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3104A" , "CHECK THAT COLUMN, LINE, AND " &
+                       "PAGE NUMBERS ARE ONE AFTER A " &
+                       "CREATE, OPEN, OR RESET");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE " &
+                       "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     IF COL (FILE) /= ONE THEN
+          FAILED ("INCORRECT RESULTS FROM COLUMN AFTER CREATE");
+     END IF;
+     IF LINE (FILE) /= ONE THEN
+          FAILED ("INCORRECT RESULTS FROM LINE AFTER CREATE");
+     END IF;
+     IF PAGE (FILE) /= ONE THEN
+          FAILED ("INCORRECT RESULTS FROM PAGE AFTER CREATE");
+     END IF;
+
+     NEW_PAGE (FILE);
+     NEW_LINE (FILE);
+     PUT (FILE, "STRING");
+
+     CLOSE (FILE);
+
+     BEGIN
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    RAISE SUBTEST;
+          END;
+
+          IF COL (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM COLUMN AFTER " &
+                       "OPEN - IN_FILE");
+          END IF;
+          IF LINE (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM LINE AFTER " &
+                       "OPEN - IN_FILE");
+          END IF;
+          IF PAGE (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM PAGE AFTER " &
+                       "OPEN - IN_FILE");
+          END IF;
+
+          GET (FILE, CHAR);   -- SETS PAGE, LINE, AND COL /= 1
+
+          BEGIN
+               RESET (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    CLOSE (FILE);
+                    RAISE SUBTEST;
+          END;
+
+          IF COL (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM COLUMN AFTER RESET");
+          END IF;
+          IF LINE (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM LINE AFTER RESET");
+          END IF;
+          IF PAGE (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM PAGE AFTER RESET");
+          END IF;
+
+          GET (FILE, CHAR);   -- CHANGES LINE, PAGE, COL; STILL IN_FILE
+
+          BEGIN
+               RESET (FILE,OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    CLOSE (FILE);
+                    RAISE SUBTEST;
+          END;
+
+          IF COL (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM COLUMN AFTER RESET " &
+                       "TO OUT_FILE");
+          END IF;
+          IF LINE (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM LINE AFTER RESET " &
+                       "TO OUT_FILE");
+          END IF;
+          IF PAGE (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM PAGE AFTER RESET " &
+                       "TO OUT_FILE");
+          END IF;
+
+          CLOSE (FILE);
+
+     EXCEPTION
+          WHEN SUBTEST =>
+               NULL;
+     END;
+
+     BEGIN
+          BEGIN
+               OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    RAISE SUBTEST;
+          END;
+
+          IF COL (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM COLUMN AFTER OPEN " &
+                       "TO OUT_FILE");
+          END IF;
+          IF LINE (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM LINE AFTER OPEN " &
+                       "TO OUT_FILE");
+          END IF;
+          IF PAGE (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM PAGE AFTER OPEN " &
+                       "TO OUT_FILE");
+          END IF;
+
+     EXCEPTION
+          WHEN SUBTEST =>
+               NULL;
+     END;
+
+     BEGIN
+          BEGIN
+               CREATE (FT, IN_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    RAISE SUBTEST;
+          END;
+
+          IF COL (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM COLUMN AFTER CREATE " &
+                       "IN IN_FILE");
+          END IF;
+          IF LINE (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM LINE AFTER CREATE " &
+                       "IN IN_FILE");
+          END IF;
+          IF PAGE (FILE) /= ONE THEN
+               FAILED ("INCORRECT RESULTS FROM PAGE AFTER CREATE " &
+                       "IN IN_FILE");
+          END IF;
+
+          CLOSE (FT);
+
+     EXCEPTION
+          WHEN SUBTEST =>
+               NULL;
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+END CE3104A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3104b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3104b.ada
new file mode 100644
index 000000000..34af98936
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3104b.ada
@@ -0,0 +1,120 @@
+-- CE3104B.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 FILE REMAINS OPEN AFTER A RESET.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     DWC 08/13/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3104B IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE   : FILE_TYPE;
+     ITEM1  : STRING (1..5) := "STUFF";
+
+BEGIN
+
+     TEST ("CE3104B", "CHECK THAT THE FILE REMAINS OPEN AFTER " &
+                      "A RESET");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          PUT_LINE (FILE, ITEM1);
+          CLOSE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR | NAME_ERROR =>
+               NOT_APPLICABLE ("CREATE WITH OUT_FILE MODE " &
+                               "NOT SUPPORTED");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
+                       "FILE I/O");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("OPEN WITH IN_FILE MODE NOT " &
+                               "SUPPORTED");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     IF IS_OPEN (FILE) THEN
+          CLOSE (FILE);
+     ELSE
+          FAILED ("RESET FOR IN_FILE, CLOSED FILE");
+     END IF;
+
+     BEGIN
+          OPEN (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("OPEN WITH OUT_FILE MODE NOT " &
+                               "SUPPORTED");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     IF IS_OPEN (FILE) THEN
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+     ELSE
+          FAILED ("RESET FOR OUT_FILE CLOSED FILE");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+END CE3104B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3104c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3104c.ada
new file mode 100644
index 000000000..a9379ef42
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3104c.ada
@@ -0,0 +1,117 @@
+-- CE3104C.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 MODE PARAMETER IN RESET CHANGES THE MODE OF A
+--     GIVEN FILE, AND IF NO MODE IS SUPPLIED, THE MODE IS LEFT AS IT
+--     WAS BEFORE THE RESET.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     RESET FOR TEXT FILES.
+
+-- HISTORY:
+--     DWC 08/17/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3104C IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE   : FILE_TYPE;
+     ITEM1  : STRING (1..5) := "STUFF";
+     ITEM2  : STRING (1..5);
+     LENGTH : NATURAL;
+
+BEGIN
+
+     TEST ("CE3104C", "CHECK THAT THE FILE REMAINS OPEN AFTER " &
+                      "A RESET");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          PUT_LINE (FILE, ITEM1);
+     EXCEPTION
+          WHEN USE_ERROR | NAME_ERROR =>
+               NOT_APPLICABLE ("CREATE WITH OUT_FILE MODE NOT " &
+                               "SUPPORTED");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
+                       "FILE I/O");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (FILE);
+          IF MODE (FILE) /= OUT_FILE THEN
+               FAILED ("RESET CHANGED MODE OF OUT_FILE");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET FOR OUT_FILE MODE NOT " &
+                               "SUPPORTED FOR TEXT FILES");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (FILE, IN_FILE);
+          IF MODE (FILE) /= IN_FILE THEN
+               FAILED ("RESET MODE TO IN_FILE");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET FROM OUT_FILE TO IN_FILE " &
+                               "NOT SUPPORTED FOR TEXT FILES");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          RESET (FILE);
+          IF MODE (FILE) /= IN_FILE THEN
+               FAILED ("RESET CHANGED MODE OF IN_FILE");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("RESET OF IN_FILE MODE NOT SUPPORTED " &
+                               "FOR TEXT FILES");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+END CE3104C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3106a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3106a.ada
new file mode 100644
index 000000000..474a66ade
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3106a.ada
@@ -0,0 +1,226 @@
+-- CE3106A.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 CLOSING A FILE HAS THE FOLLOWING EFFECT:
+--          1) IF THERE IS NO LINE TERMINATOR, A LINE TERMINATOR, PAGE
+--             TERMINATOR, AND FILE TERMINATOR ARE WRITTEN AT THE END
+--             OF THE FILE.
+--          2) IF THERE IS A LINE TERMINATOR BUT NO PAGE TERMINATOR, A
+--             PAGE TERMINATOR AND A FILE TERMINATOR ARE WRITTEN.
+--          3) IF THERE IS A PAGE TERMINATOR, A FILE TERMINATOR IS
+--             WRITTEN.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 07/08/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3106A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE1, FILE2, FILE3 : FILE_TYPE;
+     ITEM : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3106A", "CHECK THAT CLOSING A FILE HAS THE CORRECT " &
+                      "EFFECT ON THE FILE CONCERNING LINE, PAGE, " &
+                      "AND FILE TERMINATORS");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE" &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE1, 'A');
+          NEW_LINE (FILE1);
+          PUT (FILE1, 'B');
+
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH MODE IN_FILE");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FILE1, ITEM);
+
+          IF LINE (FILE1) /= 1 THEN
+               FAILED ("INCORRECT LINE NUMBER - 1");
+          END IF;
+
+          GET (FILE1, ITEM);
+          IF ITEM /= 'B' THEN
+               FAILED ("INCORRECT VALUE READ - 1");
+          END IF;
+
+          IF LINE (FILE1) /= 2 THEN
+               FAILED ("INCORRECT LINE NUMBER - 2");
+          END IF;
+
+          IF NOT END_OF_LINE (FILE1) THEN
+               FAILED ("LINE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS CLOSED");
+          END IF;
+
+          IF NOT END_OF_PAGE (FILE1) THEN
+               FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS CLOSED");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE1) THEN
+               FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS CLOSED");
+          END IF;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME(2));
+          PUT (FILE2, 'A');
+          NEW_LINE (FILE2);
+          PUT (FILE2, 'B');
+          NEW_PAGE (FILE2);
+          PUT (FILE2, 'C');
+          NEW_LINE (FILE2);
+
+          CLOSE (FILE2);
+
+          OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME(2));
+
+          GET (FILE2, ITEM);
+
+          GET (FILE2, ITEM);
+          IF ITEM /= 'B' THEN
+               FAILED ("INCORRECT VALUE READ - 2");
+          END IF;
+
+          IF LINE (FILE2) /= 2 THEN
+               FAILED ("INCORRECT LINE NUMBER - 3");
+          END IF;
+
+          GET (FILE2, ITEM);
+
+          IF LINE (FILE2) /= 1 THEN
+               FAILED ("INCORRECT LINE NUMBER - 4");
+          END IF;
+
+          IF PAGE (FILE2) /= 2 THEN
+               FAILED ("INCORRECT PAGE NUMBER - 1");
+          END IF;
+
+          IF NOT END_OF_PAGE (FILE2) THEN
+               FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS CLOSED - 2");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE2) THEN
+               FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS CLOSED - 2");
+          END IF;
+
+          BEGIN
+               DELETE (FILE2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          CREATE (FILE3, OUT_FILE, LEGAL_FILE_NAME(3));
+          PUT (FILE3, 'A');
+          NEW_PAGE (FILE3);
+          PUT (FILE3, 'B');
+          NEW_PAGE (FILE3);
+          NEW_LINE (FILE3);
+          PUT (FILE3, 'C');
+          NEW_PAGE (FILE3);
+
+          CLOSE (FILE3);
+
+          OPEN (FILE3, IN_FILE, LEGAL_FILE_NAME(3));
+
+          GET (FILE3, ITEM);
+
+          GET (FILE3, ITEM);
+          IF ITEM /= 'B' THEN
+               FAILED ("INCORRECT VALUE READ - 3");
+          END IF;
+
+          GET (FILE3, ITEM);
+
+          IF LINE (FILE3) /= 2 THEN
+               FAILED ("INCORRECT LINE NUMBER - 5");
+          END IF;
+
+          IF PAGE (FILE3) /= 3 THEN
+               FAILED ("INCORRECT PAGE NUMBER - 2");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE3) THEN
+               FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS CLOSED - 3");
+          END IF;
+
+          BEGIN
+               DELETE (FILE3);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3106A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3106b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3106b.ada
new file mode 100644
index 000000000..9d507a97c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3106b.ada
@@ -0,0 +1,220 @@
+-- CE3106B.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 RESETTING AN OUT_FILE TO AN IN_FILE HAS THE FOLLOWING
+--     EFFECT:
+--          1) IF THERE IS NO LINE TERMINATOR, A LINE TERMINATOR, PAGE
+--             TERMINATOR, AND FILE TERMINATOR ARE WRITTEN AT THE END
+--             OF THE FILE.
+--          2) IF THERE IS A LINE TERMINATOR BUT NO PAGE TERMINATOR, A
+--             PAGE TERMINATOR AND A FILE TERMINATOR ARE WRITTEN.
+--          3) IF THERE IS A PAGE TERMINATOR, A FILE TERMINATOR IS
+--             WRITTEN.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 07/08/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3106B IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE1, FILE2, FILE3 : FILE_TYPE;
+     ITEM : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3106B", "CHECK THAT RESETTING AN OUT_FILE TO AN " &
+                      "IN_FILE HAS THE CORRECT EFFECT ON THE " &
+                      "FILE CONCERNING LINE, PAGE, AND FILE " &
+                      "TERMINATORS");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE" &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE1, 'A');
+          NEW_LINE (FILE1);
+          PUT (FILE1, 'B');
+
+          BEGIN
+               RESET (FILE1, IN_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON FILE RESET " &
+                                    "FROM OUT_FILE TO IN_FILE");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FILE1, ITEM);
+
+          IF LINE (FILE1) /= 1 THEN
+               FAILED ("INCORRECT LINE NUMBER - 1");
+          END IF;
+
+          GET (FILE1, ITEM);
+          IF ITEM /= 'B' THEN
+               FAILED ("INCORRECT VALUE READ - 1");
+          END IF;
+
+          IF LINE (FILE1) /= 2 THEN
+               FAILED ("INCORRECT LINE NUMBER - 2");
+          END IF;
+
+          IF NOT END_OF_LINE (FILE1) THEN
+               FAILED ("LINE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS RESET");
+          END IF;
+
+          IF NOT END_OF_PAGE (FILE1) THEN
+               FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS RESET");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE1) THEN
+               FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS RESET");
+          END IF;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME(2));
+          PUT (FILE2, 'A');
+          NEW_LINE (FILE2);
+          PUT (FILE2, 'B');
+          NEW_PAGE (FILE2);
+          PUT (FILE2, 'C');
+          NEW_LINE (FILE2);
+
+          RESET (FILE2, IN_FILE);
+
+          GET (FILE2, ITEM);
+          GET (FILE2, ITEM);
+
+          IF LINE (FILE2) /= 2 THEN
+               FAILED ("INCORRECT LINE NUMBER - 3");
+          END IF;
+
+          GET (FILE2, ITEM);
+          IF ITEM /= 'C' THEN
+               FAILED ("INCORRECT VALUE READ - 2");
+          END IF;
+
+          IF LINE(FILE2) /= 1 THEN
+               FAILED ("INCORRECT LINE NUMBER - 4");
+          END IF;
+
+          IF PAGE(FILE2) /= 2 THEN
+               FAILED ("INCORRECT PAGE NUMBER - 1");
+          END IF;
+
+          IF NOT END_OF_PAGE (FILE2) THEN
+               FAILED ("PAGE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS RESET - 2");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE2) THEN
+               FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS RESET - 2");
+          END IF;
+
+          BEGIN
+               DELETE (FILE2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          CREATE (FILE3, OUT_FILE, LEGAL_FILE_NAME(3));
+          PUT (FILE3, 'A');
+          NEW_PAGE (FILE3);
+          PUT (FILE3, 'B');
+          NEW_PAGE (FILE3);
+          NEW_LINE (FILE3);
+          PUT (FILE3, 'C');
+          NEW_PAGE (FILE3);
+
+          RESET (FILE3, IN_FILE);
+
+          GET (FILE3, ITEM);
+          IF ITEM /= 'A' THEN
+               FAILED ("INCORRECT VALUE READ - 3");
+          END IF;
+
+          GET (FILE3, ITEM);
+          GET (FILE3, ITEM);
+
+          IF LINE(FILE3) /= 2 THEN
+               FAILED ("INCORRECT LINE NUMBER - 5");
+          END IF;
+
+          IF PAGE(FILE3) /= 3 THEN
+               FAILED ("INCORRECT PAGE NUMBER - 2");
+          END IF;
+
+          IF NOT END_OF_FILE (FILE3) THEN
+               FAILED ("FILE TERMINATOR NOT WRITTEN WHEN FILE " &
+                       "IS RESET - 3");
+          END IF;
+
+          BEGIN
+               DELETE (FILE3);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3106B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3107a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3107a.tst
new file mode 100644
index 000000000..96646fb71
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3107a.tst
@@ -0,0 +1,135 @@
+-- CE3107A.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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
+--     TYPE TEXT_IO.
+
+-- HISTORY:
+--     DLD 08/10/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  05/29/85
+--     DWC 08/17/87  SPLIT OUT CASES WHICH DEPEND ON A TEXT FILE
+--                   BEING CREATED OR SUCCESSFULLY OPENED.  PLACED
+--                   CASES INTO CE3107B.ADA.
+--     PWB 03/07/97  ADDED CHECK FOR FILE SUPPORT.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3107A IS
+
+     TEST_FILE_ZERO : FILE_TYPE;
+     TEST_FILE_ONE : FILE_TYPE;
+     TEST_FILE_TWO : FILE_TYPE;
+     TEST_FILE_THREE : FILE_TYPE;
+     VAL : BOOLEAN;
+
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST("CE3107A", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
+                     "VALUES FOR UNOPENED FILES OF TYPE TEXT_IO");
+
+-- FIRST TEST WHETHER IMPLEMENTATION SUPPORTS TEXT FILES AT ALL
+
+     BEGIN
+          TEXT_IO.CREATE ( TEST_FILE_ZERO,
+                          TEXT_IO.OUT_FILE,
+                          REPORT.LEGAL_FILE_NAME );
+     EXCEPTION
+          WHEN TEXT_IO.USE_ERROR | TEXT_IO.NAME_ERROR =>
+               REPORT.NOT_APPLICABLE
+                    ( "TEXT FILES NOT SUPPORTED -- CREATE OUT-FILE" );
+               RAISE INCOMPLETE;
+     END;
+     TEXT_IO.DELETE ( TEST_FILE_ZERO );
+
+-- WHEN FILE IS DECLARED BUT NOT OPEN
+
+     VAL := TRUE;
+     VAL := IS_OPEN(TEST_FILE_ONE);
+     IF VAL = TRUE THEN
+          FAILED("FILE NOT OPEN BUT IS_OPEN RETURNS TRUE");
+     END IF;
+
+-- FOLLOWING UNSUCCESSFUL CREATE
+
+     BEGIN
+          VAL := TRUE;
+          CREATE(TEST_FILE_TWO, OUT_FILE,
+                 "$ILLEGAL_EXTERNAL_FILE_NAME1");
+          FAILED("NAME_ERROR NOT RAISED - UNSUCCESSFUL CREATE");
+     EXCEPTION
+          WHEN NAME_ERROR =>
+               VAL := IS_OPEN(TEST_FILE_TWO);
+               IF VAL = TRUE THEN
+                    FAILED("IS_OPEN GIVES TRUE AFTER AN " &
+                           "UNSUCCESSFUL CREATE");
+               END IF;
+     END;
+
+-- FOLLOWING UNSUCCESSFUL OPEN
+
+     BEGIN
+          VAL := FALSE;
+          OPEN(TEST_FILE_TWO, IN_FILE, LEGAL_FILE_NAME);
+          FAILED("NAME_ERROR NOT RAISED - " &
+                 "UNSUCCESSFUL OPEN");
+     EXCEPTION
+          WHEN NAME_ERROR =>
+               VAL := IS_OPEN(TEST_FILE_TWO);
+               IF VAL = TRUE THEN
+                    FAILED("IS_OPEN GIVES TRUE - " &
+                           "UNSUCCESSFUL OPEN");
+               END IF;
+     END;
+
+-- CLOSE FILE WHILE NOT OPEN
+
+     BEGIN
+          VAL := TRUE;
+          CLOSE(TEST_FILE_THREE);  -- STATUS ERROR
+          FAILED("STATUS_ERROR NOT RAISED - UNSUCCESSFUL CLOSE");
+     EXCEPTION
+          WHEN OTHERS =>
+               VAL := IS_OPEN(TEST_FILE_THREE);
+               IF VAL = TRUE THEN
+                    FAILED("IS_OPEN GIVES TRUE - UNSUCCESSFUL  " &
+                           "CLOSE");
+               END IF;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          NULL;
+          REPORT.RESULT;
+     WHEN OTHERS =>
+          REPORT.FAILED ( "UNEXPECTED EXCEPTION" );
+          REPORT.RESULT;
+END CE3107A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3107b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3107b.ada
new file mode 100644
index 000000000..6c40c5d60
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3107b.ada
@@ -0,0 +1,141 @@
+-- CE3107B.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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
+--     TYPE TEXT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION WITH OUT_FILE MODE FOR TEXT FILES.
+
+-- HISTORY:
+--     DWC 08/17/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3107B IS
+
+     TEST_FILE_ONE : FILE_TYPE;
+     TEST_FILE_TWO : FILE_TYPE;
+     VAL : BOOLEAN;
+
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST("CE3107B", "CHECK THAT IS_OPEN RETURNS THE " &
+                     "PROPER VALUES FOR FILES OF TYPE TEXT_IO");
+
+-- FOLLOWING A CREATE
+
+     BEGIN
+          VAL := FALSE;
+          CREATE(TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+          VAL := IS_OPEN(TEST_FILE_ONE);
+          IF VAL = FALSE THEN
+               FAILED("IS_OPEN RETURNS FALSE AFTER CREATE");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+-- FOLLOWING CLOSE
+
+     VAL := TRUE;
+     IF IS_OPEN(TEST_FILE_ONE) = TRUE THEN
+          CLOSE(TEST_FILE_ONE);
+     END IF;
+     VAL := IS_OPEN(TEST_FILE_ONE);
+     IF VAL = TRUE THEN
+          FAILED("IS_OPEN RETURNS TRUE AFTER CLOSE");
+     END IF;
+
+-- FOLLOWING OPEN
+
+     BEGIN
+          VAL := FALSE;
+          BEGIN
+               OPEN (TEST_FILE_TWO, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    IF IS_OPEN (TEST_FILE_TWO) /= FALSE THEN
+                         FAILED ("FILE OPEN AFTER USE_ERROR " &
+                                 "DURING OPEN");
+                    END IF;
+                    RAISE INCOMPLETE;
+          END;
+          VAL := IS_OPEN(TEST_FILE_TWO);
+          IF VAL = FALSE THEN
+               FAILED("IS_OPEN RETURNS FALSE AFTER OPEN");
+          END IF;
+
+-- AFTER RESET
+
+          BEGIN
+               VAL := FALSE;
+               RESET(TEST_FILE_TWO);
+               VAL := IS_OPEN(TEST_FILE_TWO);
+               IF VAL = FALSE THEN
+                    FAILED("IS_OPEN RETURNS FALSE AFTER RESET");
+               END IF;
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT("IMPLEMENTATION DOES NOT SUPPORT RESET");
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+-- AFTER DELETE
+
+     BEGIN
+          VAL := TRUE;
+          DELETE(TEST_FILE_TWO);
+          VAL := IS_OPEN(TEST_FILE_TWO);
+          IF VAL = TRUE THEN
+               FAILED("IS_OPEN RETURNS TRUE AFTER DELETE");
+          END IF;
+     EXCEPTION
+          WHEN USE_ERROR =>
+               IF IS_OPEN (TEST_FILE_TWO) /= FALSE THEN
+                    FAILED ("FILE OPEN AFTER USE_ERROR " &
+                            "DURING DELETE");
+               END IF;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3107B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3108a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3108a.ada
new file mode 100644
index 000000000..f5297a60a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3108a.ada
@@ -0,0 +1,106 @@
+-- CE3108A.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 FILE CAN BE CLOSED AND THEN RE-OPENED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     DLD 08/11/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  05/16/85
+--     GMT 08/17/87  REMOVED UNNECESSARY CODE AND ADDED A CHECK FOR
+--                   USE_ERROR ON DELETE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3108A IS
+
+     TXT_FILE   : FILE_TYPE;
+     VAR        : STRING (1..2);
+     LAST       : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3108A", "CHECK THAT A FILE CAN BE CLOSED " &
+                      "AND THEN RE-OPENED");
+
+     -- INITIALIZE TEST FILES
+
+     BEGIN
+
+          BEGIN
+               CREATE (TXT_FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               PUT (TXT_FILE, "17");
+               CLOSE (TXT_FILE);
+
+               -- RE-OPEN TEXT TEST FILE
+
+               BEGIN
+                    OPEN (TXT_FILE, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN");
+                         RAISE INCOMPLETE;
+               END;
+
+               GET (TXT_FILE, VAR);
+               IF VAR /= "17" THEN
+                    FAILED ("WRONG DATA RETURNED FROM READ -TEXT");
+               END IF;
+
+               -- DELETE TEST FILES
+
+               BEGIN
+                    DELETE (TXT_FILE);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3108A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3108b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3108b.ada
new file mode 100644
index 000000000..0c366f6ab
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3108b.ada
@@ -0,0 +1,111 @@
+-- CE3108B.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 NAME RETURNED BY THE NAME FUNCTION CAN BE USED
+--     IN A SUBSEQUENT OPEN.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     DLD 08/11/82
+--     SPS 11/09/82
+--     JBG 03/24/83
+--     EG  05/16/85
+--     GMT 08/17/87  REMOVED UNNECESSARY CODE AND ADDED A CHECK FOR
+--                   USE_ERROR ON DELETE.
+
+WITH TEXT_IO; USE TEXT_IO;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CE3108B IS
+
+     TYPE ACC_STR IS ACCESS STRING;
+
+     TXT_FILE      : FILE_TYPE;
+     TXT_FILE_NAME : ACC_STR;
+     DIR_FILE_NAME : ACC_STR;
+     VAR           : STRING(1..2);
+     LAST          : INTEGER;
+     INCOMPLETE    : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3108B", "CHECK THAT THE NAME RETURNED BY THE NAME-" &
+                      "FUNCTION CAN BE USED IN A SUBSEQUENT OPEN");
+
+     -- CREATE TEST FILES
+
+     BEGIN
+          BEGIN
+               CREATE (TXT_FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE - 1");
+                    RAISE INCOMPLETE;
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE - 2");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               PUT (TXT_FILE, "14");
+               TXT_FILE_NAME := NEW STRING'(NAME (TXT_FILE));
+               CLOSE (TXT_FILE);
+
+               -- ATTEMPT TO RE-OPEN TEXT TEST FILE USING RETURNED NAME
+               -- VALUE
+
+               BEGIN
+                    OPEN (TXT_FILE, IN_FILE, TXT_FILE_NAME.ALL);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR ON RE-OPEN - 3");
+                         RAISE INCOMPLETE;
+               END;
+
+               GET (TXT_FILE, VAR);
+               IF VAR /= "14" THEN
+                    FAILED ("WRONG DATA RETURNED FROM READ - 4");
+               END IF;
+
+               -- CLOSE AND DELETE TEST FILES
+
+               BEGIN
+                    DELETE (TXT_FILE);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3108B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3110a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3110a.ada
new file mode 100644
index 000000000..f6d756a75
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3110a.ada
@@ -0,0 +1,107 @@
+-- CE3110A.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 AFTER A SUCCESSFUL DELETE OF AN EXTERNAL FILE, THE
+--     NAME OF THE FILE CAN BE USED IN A CREATE OPERATION.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION AND DELETION OF TEXT FILES.
+
+-- HISTORY:
+--     SPS 08/25/82
+--     SPS 11/09/82
+--     JBG 06/04/84
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/18/87  CORRECTED EXCEPTION FORMAT.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3110A IS
+BEGIN
+
+     TEST ("CE3110A", "CHECK THAT AN EXTERNAL FILE CAN BE CREATED " &
+                      "AFTER AN EXTERNAL FILE WITH SAME NAME HAS BEEN" &
+                      " DELETED");
+     DECLARE
+          FL1 : FILE_TYPE;
+          FL2 : FILE_TYPE;
+          T_FAILED : BOOLEAN := FALSE;
+          D_FILE : BOOLEAN := FALSE;
+     BEGIN
+          BEGIN
+               CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    T_FAILED := TRUE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    T_FAILED := TRUE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT " &
+                            "CREATE WITH OUT_FILE MODE");
+                    T_FAILED := TRUE;
+          END;
+
+          IF NOT T_FAILED THEN
+               BEGIN
+                    DELETE (FL1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("DELETION OF EXTERNAL " &
+                                         "FILES NOT SUPPORTED");
+                         T_FAILED := TRUE;
+               END;
+          END IF;
+
+          IF NOT T_FAILED THEN
+               BEGIN
+                    CREATE (FL2, OUT_FILE, LEGAL_FILE_NAME);
+                    D_FILE := TRUE;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("UNABLE TO RECREATE FILE AFTER " &
+                                 "DELETION - TEXT");
+               END;
+               IF D_FILE THEN
+                    BEGIN
+                         DELETE (FL2);
+                    EXCEPTION
+                         WHEN OTHERS =>
+                              FAILED ("DELETE SHOULD STILL BE " &
+                                      "SUPPORTED");
+                    END;
+               END IF;
+          END IF;
+     END;
+
+     RESULT;
+
+END CE3110A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3112c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3112c.ada
new file mode 100644
index 000000000..3ee20cf1b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3112c.ada
@@ -0,0 +1,81 @@
+-- CE3112C.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 EXTERNAL TEXT FILE SPECIFIED BY A NON-NULL
+--     STRING NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN
+--     PROGRAM.
+
+--     THIS TEST CREATES A TEXT FILE WHICH CE3112D.ADA WILL READ.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF AN EXTERNAL TEXT FILE WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     GMT 08/13/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO;
+
+PROCEDURE CE3112C IS
+
+     INCOMPLETE         : EXCEPTION;
+     FILE_NAME          : TEXT_IO.FILE_TYPE;
+     PREVENT_EMPTY_FILE : STRING (1..5) := "HELLO";
+
+BEGIN
+     TEST ("CE3112C" , "CHECK THAT AN EXTERNAL TEXT FILE SPECIFIED " &
+                       "BY A NON-NULL STRING NAME IS ACCESSIBLE " &
+                       "AFTER THE COMPLETION OF THE MAIN PROGRAM");
+     BEGIN
+          BEGIN
+               TEXT_IO.CREATE (FILE_NAME, TEXT_IO.OUT_FILE,
+                               LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN TEXT_IO.USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+               WHEN TEXT_IO.NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE - 2");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "TEXT CREATE - 3");
+                    RAISE INCOMPLETE;
+          END;
+
+          TEXT_IO.PUT (FILE_NAME, PREVENT_EMPTY_FILE);
+          TEXT_IO.CLOSE (FILE_NAME);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3112C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3112d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3112d.ada
new file mode 100644
index 000000000..3328c8161
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3112d.ada
@@ -0,0 +1,112 @@
+-- CE3112D.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 EXTERNAL TEXT FILE SPECIFIED BY A NON-NULL STRING
+--     NAME IS ACCESSIBLE AFTER THE COMPLETION OF THE MAIN PROGRAM.
+
+--     THIS TEST CHECKS THE CREATION OF A TEXT FILE X3112C, WHICH WAS
+--     CREATED BY CE3112C.ADA.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     GMT 08/13/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO;
+
+PROCEDURE CE3112D IS
+
+     INCOMPLETE               : EXCEPTION;
+     CHECK_SUPPORT, FILE_NAME : TEXT_IO.FILE_TYPE;
+     PREVENT_EMPTY_FILE       : STRING (1..5);
+
+BEGIN
+     TEST ("CE3112D", "CHECK THAT AN EXTERNAL TEXT FILE SPECIFIED BY " &
+                      "A NON-NULL STRING NAME IS ACCESSIBLE AFTER " &
+                      "THE COMPLETION OF THE MAIN PROGRAM");
+
+     -- TEST FOR TEXT FILE SUPPORT.
+
+     BEGIN
+          TEXT_IO.CREATE (CHECK_SUPPORT, TEXT_IO.OUT_FILE,
+                          LEGAL_FILE_NAME);
+          BEGIN
+               TEXT_IO.DELETE (CHECK_SUPPORT);
+          EXCEPTION
+               WHEN TEXT_IO.USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "DELETE - 1");
+          END;
+     EXCEPTION
+          WHEN TEXT_IO.USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "OUT_FILE MODE - 2");
+               RAISE INCOMPLETE;
+          WHEN TEXT_IO.NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE  - 3");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
+                       "CREATE - 4");
+               RAISE INCOMPLETE;
+     END;
+
+     -- BEGIN TEST OBJECTIVE.
+
+     BEGIN
+          TEXT_IO.OPEN (FILE_NAME, TEXT_IO.IN_FILE,
+                        LEGAL_FILE_NAME (1, "CE3112C"));
+     EXCEPTION
+          WHEN TEXT_IO.USE_ERROR =>
+               NOT_APPLICABLE("USE_ERROR RAISED ON OPEN FOR TEXT " &
+                              "FILE WITH IN_FILE MODE - 5");
+               RAISE INCOMPLETE;
+     END;
+
+     TEXT_IO.GET (FILE_NAME, PREVENT_EMPTY_FILE);
+
+     IF PREVENT_EMPTY_FILE /= "HELLO" THEN
+          FAILED ("OPENED WRONG FILE OR DATA ERROR - 6");
+     END IF;
+     BEGIN
+          TEXT_IO.DELETE (FILE_NAME);
+     EXCEPTION
+          WHEN TEXT_IO.USE_ERROR =>
+               COMMENT ("IMPLEMENTATION WOULD NOT ALLOW DELETION OF " &
+                        "EXTERNAL FILE - 7");
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+END CE3112D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3114a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3114a.ada
new file mode 100644
index 000000000..f217cde6a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3114a.ada
@@ -0,0 +1,102 @@
+-- CE3114A.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 EXTERNAL TEXT FILE CEASES TO EXIST AFTER
+--     A SUCCESSFUL DELETE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION AND DELETION OF TEXT FILES.
+
+-- HISTORY:
+--     SPS 08/25/82
+--     SPS 11/09/82
+--     JBG 04/01/83
+--     EG  05/16/85
+--     GMT 08/25/87  COMPLETELY REVISED.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3114A IS
+BEGIN
+
+     TEST ("CE3114A", "CHECK THAT AN EXTERNAL TEXT FILE CEASES TO " &
+                      "EXIST AFTER A SUCCESSFUL DELETE");
+
+     DECLARE
+          FL1, FL2   : FILE_TYPE;
+          VAR1       : CHARACTER := 'A';
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+          BEGIN
+               CREATE (FL1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE - 2");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "CREATE - 3");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               PUT (FL1, VAR1);   -- THIS PUTS TO THE FILE IF
+          EXCEPTION               -- IT CAN, NOT NECESSARY FOR
+               WHEN OTHERS =>     -- THE OBJECTIVE.
+                    NULL;
+          END;
+
+          BEGIN
+               DELETE (FL1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("DELETION OF EXTERNAL TEXT FILES " &
+                                    "IS NOT SUPPORTED - 4");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               OPEN (FL2, IN_FILE, LEGAL_FILE_NAME);
+               FAILED ("EXTERNAL TEXT FILE STILL EXISTS AFTER " &
+                       "A SUCCESSFUL DELETION - 5");
+          EXCEPTION
+               WHEN NAME_ERROR =>
+                    NULL;
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3114A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3115a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3115a.ada
new file mode 100644
index 000000000..66d951e53
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3115a.ada
@@ -0,0 +1,232 @@
+-- CE3115A.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 RESETTING ONE OF A MULTIPLE OF INTERNAL FILES
+--     ASSOCIATED WITH THE SAME EXTERNAL FILE HAS NO EFFECT ON ANY
+--     OF THE OTHER INTERNAL FILES.
+
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST APPLIES ONLY TO IMPLEMENTATIONS WHICH SUPPORT MULTIPLE
+--     INTERNAL FILES ASSOCIATED WITH THE SAME EXTERNAL FILE AND
+--     RESETTING OF THESE MULTIPLE INTERNAL FILES FOR TEXT FILES.
+
+-- HISTORY:
+--     DLD 08/16/82
+--     SPS 11/09/82
+--     JBG 06/04/84
+--     EG  11/19/85  MADE TEST INAPPLICABLE IF CREATE USE_ERROR.
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE RESULT WHEN
+--                   FILES NOT SUPPORTED.
+--     GMT 08/25/87  COMPLETELY REVISED.
+--     EDS 12/01/97  ADD NAME_ERROR HANDLER TO OUTPUT NOT_APPLICABLE RESULT.
+--     RLB 09/29/98  MADE MODIFICATION TO AVOID BUFFERING PROBLEMS.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3115A IS
+
+BEGIN
+
+     TEST ("CE3115A", "CHECK THAT RESETTING ONE OF A MULTIPLE OF " &
+                      "INTERNAL FILES ASSOCIATED WITH THE SAME " &
+                      "EXTERNAL FILE HAS NO EFFECT ON ANY OF THE " &
+                      "OTHER INTERNAL FILES");
+
+     DECLARE
+          TXT_FILE_ONE : TEXT_IO.FILE_TYPE;
+          TXT_FILE_TWO : TEXT_IO.FILE_TYPE;
+
+          CH           : CHARACTER := 'A';
+
+          INCOMPLETE   : EXCEPTION;
+
+          PROCEDURE TXT_CLEANUP IS
+               FILE1_OPEN : BOOLEAN := IS_OPEN (TXT_FILE_ONE);
+               FILE2_OPEN : BOOLEAN := IS_OPEN (TXT_FILE_TWO);
+          BEGIN
+               IF FILE1_OPEN AND FILE2_OPEN THEN
+                    CLOSE (TXT_FILE_TWO);
+                    DELETE (TXT_FILE_ONE);
+               ELSIF FILE1_OPEN THEN
+                    DELETE (TXT_FILE_ONE);
+               ELSIF FILE2_OPEN THEN
+                    DELETE (TXT_FILE_TWO);
+               END IF;
+          EXCEPTION
+               WHEN TEXT_IO.USE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED " &
+                            "IN CLEANUP - 1");
+          END TXT_CLEANUP;
+
+     BEGIN
+
+          BEGIN -- CREATE FIRST FILE
+
+               CREATE (TXT_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
+               PUT (TXT_FILE_ONE, CH);
+
+          EXCEPTION
+               WHEN TEXT_IO.USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; CREATE OF " &
+                                    "EXTERNAL FILENAME IS NOT " &
+                                    "SUPPORTED - 2");
+                    RAISE INCOMPLETE;
+               WHEN TEXT_IO.NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; CREATE OF " &
+                                    "EXTERNAL FILENAME IS NOT " &
+                                    "SUPPORTED - 3");
+                    RAISE INCOMPLETE;
+
+          END; -- CREATE FIRST FILE
+
+          BEGIN -- OPEN SECOND FILE
+
+               OPEN (TXT_FILE_TWO, IN_FILE, LEGAL_FILE_NAME);
+
+          EXCEPTION
+
+               WHEN TEXT_IO.USE_ERROR =>
+                    NOT_APPLICABLE ("MULTIPLE INTERNAL FILES ARE NOT " &
+                                    "SUPPORTED WHEN ONE IS MODE " &
+                                    "OUT_FILE AND THE OTHER IS MODE " &
+                                    "IN_FILE - 4" &
+                                    " - USE_ERROR RAISED ");
+                    TXT_CLEANUP;
+                    RAISE INCOMPLETE;
+
+               WHEN TEXT_IO.NAME_ERROR =>
+                    NOT_APPLICABLE ("MULTIPLE INTERNAL FILES ARE NOT " &
+                                    "SUPPORTED WHEN ONE IS MODE " &
+                                    "OUT_FILE AND THE OTHER IS MODE " &
+                                    "IN_FILE - 4" &
+                                    " - NAME_ERROR RAISED ");
+                    TXT_CLEANUP;
+                    RAISE INCOMPLETE;
+
+          END; -- OPEN SECOND FILE
+          FLUSH (TXT_FILE_ONE); -- AVOID BUFFERING PROBLEMS.
+
+          CH := 'B';
+          GET (TXT_FILE_TWO, CH);
+          IF CH /= 'A' THEN
+               FAILED ("INCORRECT VALUE FOR GET - 5");
+          END IF;
+
+          BEGIN -- INITIALIZE FIRST FILE TO CHECK POINTER RESETTING
+
+               RESET (TXT_FILE_ONE);
+               IF MODE (TXT_FILE_ONE) /= OUT_FILE THEN
+                    FAILED ("FILE WAS NOT RESET - 6");
+               END IF;
+               IF MODE (TXT_FILE_TWO) /= IN_FILE THEN
+                    FAILED ("RESETTING OF ONE INTERNAL FILE " &
+                            "AFFECTED THE OTHER INTERNAL FILE - 7");
+               END IF;
+
+          EXCEPTION
+
+               WHEN TEXT_IO.USE_ERROR =>
+                    NOT_APPLICABLE ("RESETTING OF EXTERNAL FILE FOR " &
+                                    "OUT_FILE MODE IS " &
+                                    " NOT SUPPORTED - 8");
+                    TXT_CLEANUP;
+                    RAISE INCOMPLETE;
+
+          END; -- INITIALIZE FIRST FILE TO CHECK POINTER RESETTING
+
+          -- PERFORM SOME I/O ON THE FIRST FILE
+
+          PUT (TXT_FILE_ONE, 'C');
+          PUT (TXT_FILE_ONE, 'D');
+          PUT (TXT_FILE_ONE, 'E');
+          CLOSE (TXT_FILE_ONE);
+
+          BEGIN
+               OPEN (TXT_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("MULTIPLE INTERNAL FILES NOT " &
+                                    "SUPPORTED WHEN BOTH FILES HAVE " &
+                                    "IN_FILE MODE - 9");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (TXT_FILE_ONE, CH);
+          GET (TXT_FILE_ONE, CH);
+
+          BEGIN -- INITIALIZE SECOND FILE AND PERFORM SOME I/O
+
+               CLOSE (TXT_FILE_TWO);
+               OPEN (TXT_FILE_TWO, IN_FILE, LEGAL_FILE_NAME);
+
+          EXCEPTION
+
+               WHEN TEXT_IO.USE_ERROR =>
+                    FAILED ("MULTIPLE INTERNAL FILES SHOULD STILL " &
+                            "BE ALLOWED - 10");
+                    TXT_CLEANUP;
+                    RAISE INCOMPLETE;
+
+          END; -- INITIALIZE SECOND FILE AND PERFORM SOME I/O
+
+          BEGIN -- RESET FIRST FILE AND CHECK EFFECTS ON SECOND FILE
+
+               GET (TXT_FILE_TWO, CH);
+               IF CH /= 'C' THEN
+                    FAILED ("INCORRECT VALUE FOR GET OPERATION - 11");
+               END IF;
+
+               RESET (TXT_FILE_ONE);
+               GET (TXT_FILE_TWO, CH);
+               IF CH /= 'D' THEN
+                    FAILED ("RESETTING INDEX OF ONE TEXT FILE " &
+                            "RESETS THE OTHER ASSOCIATED FILE - 12");
+               END IF;
+
+          EXCEPTION
+
+               WHEN TEXT_IO.USE_ERROR =>
+                    FAILED ("RESETTING SHOULD STILL BE SUPPORTED - 13");
+                    TXT_CLEANUP;
+                    RAISE INCOMPLETE;
+
+          END; -- RESET FIRST FILE AND CHECK EFFECTS ON SECOND FILE
+
+          TXT_CLEANUP;
+
+     EXCEPTION
+
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3115A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3201a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3201a.ada
new file mode 100644
index 000000000..eb7b6ead4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3201a.ada
@@ -0,0 +1,71 @@
+-- CE3201A.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 STANDARD INPUT AND OUTPUT FILES EXIST
+-- AND ARE OPEN.
+
+-- ABW  8/25/82
+-- SPS 9/16/82
+-- SPS 12/14/82
+-- JBG 3/17/83
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3201A IS
+     CH : CHARACTER;
+BEGIN
+
+     TEST ("CE3201A", "CHECK THAT STANDARD INPUT AND " &
+                      "OUTPUT EXIST AND ARE OPEN");
+
+     IF NOT IS_OPEN (STANDARD_INPUT) THEN
+          FAILED ("STANDARD_INPUT NOT OPEN - IS_OPEN");
+     END IF;
+
+     IF NOT IS_OPEN (STANDARD_OUTPUT) THEN
+          FAILED ("STANDARD_OUTPUT NOT OPEN - IS_OPEN");
+     END IF;
+
+     BEGIN
+          PUT ('X');
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("STANDARD_OUTPUT NOT AVAILABLE - " &
+                       "PUT DEFAULT");
+     END;
+
+     BEGIN
+          PUT (STANDARD_OUTPUT, 'D');
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("STANDARD_OUTPUT NOT AVAILABLE - " &
+                       "PUT");
+     END;
+
+     RESULT;
+
+END CE3201A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3202a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3202a.ada
new file mode 100644
index 000000000..755d48850
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3202a.ada
@@ -0,0 +1,57 @@
+-- CE3202A.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 CURRENT_INPUT AND CURRENT_OUTPUT INITIALLY
+-- CORRESPOND TO STANDARD FILES.
+
+-- ABW  8/25/82
+-- SPS  11/9/82
+-- JBG  3/17/83
+-- JBG 5/8/84
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3202A IS
+
+
+BEGIN
+
+     TEST ("CE3202A", "CHECK THAT CURRENT_INPUT AND " &
+                      "CURRENT_OUTPUT INITIALLY " &
+                      "CORRESPOND TO STANDARD FILES");
+
+     IF NAME (CURRENT_INPUT) /= NAME (STANDARD_INPUT) THEN
+          FAILED ("CURRENT_INPUT INCORRECT - NAME");
+     END IF;
+
+     IF NAME (CURRENT_OUTPUT) /= NAME (STANDARD_OUTPUT) THEN
+          FAILED ("CURRENT_OUTPUT INCORRECT - NAME");
+     END IF;
+
+     RESULT;
+
+END CE3202A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3206a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3206a.ada
new file mode 100644
index 000000000..a865b6091
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3206a.ada
@@ -0,0 +1,103 @@
+-- CE3206A.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 SET_INPUT AND SET_OUTPUT RAISE STATUS_ERROR WHEN
+--     CALLED WITH A FILE PARAMETER DENOTING A CLOSED FILE.
+
+-- HISTORY:
+--     ABW 08/31/82
+--     SPS 10/01/82
+--     SPS 11/09/82
+--     JLH 08/18/87  ADDED NEW CASES FOR SET_INPUT AND SET_OUTPUT.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3206A IS
+
+     FILE_IN, FILE1 : FILE_TYPE;
+     ITEM : CHARACTER := 'A';
+
+BEGIN
+
+     TEST ("CE3206A", "CHECK THAT SET_INPUT AND SET_OUTPUT " &
+                      "RAISE STATUS_ERROR WHEN CALLED WITH A " &
+                      "FILE PARAMETER DENOTING A CLOSED FILE");
+
+     BEGIN
+          SET_INPUT (FILE_IN);
+          FAILED ("STATUS_ERROR NOT RAISED FOR SET_INPUT - 1");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR SET_INPUT - 1");
+     END;
+
+     BEGIN
+          SET_OUTPUT (FILE_IN);
+          FAILED ("STATUS_ERROR NOT RAISED FOR SET_OUTPUT - 1");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR SET_OUTPUT - 1");
+     END;
+
+     BEGIN
+          CREATE (FILE1, OUT_FILE);
+          PUT (FILE1, ITEM);
+          CLOSE (FILE1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     BEGIN
+          SET_INPUT (FILE1);
+          FAILED ("STATUS_ERROR NOT RAISED FOR SET_INPUT - 2");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR SET_INPUT - 2");
+     END;
+
+     BEGIN
+          SET_OUTPUT (FILE1);
+          FAILED ("STATUS_ERROR NOT RAISED FOR SET_OUTPUT - 2");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR SET_OUTPUT - 2");
+     END;
+
+
+     RESULT;
+
+END CE3206A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3207a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3207a.ada
new file mode 100644
index 000000000..6b234cef0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3207a.ada
@@ -0,0 +1,107 @@
+-- CE3207A.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 MODE_ERROR IS RAISED IF THE PARAMETER TO SET_INPUT HAS
+--     MODE OUT_FILE OR THE PARAMETER TO SET_OUTPUT HAS MODE IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 07/07/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3207A IS
+
+     FILE1, FILE2 : FILE_TYPE;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3207A", "CHECK THAT MODE_ERROR IS RAISED IF THE " &
+                      "PARAMETER TO SET_INPUT HAS MODE OUT_FILE " &
+                      "OR THE PARAMETER TO SET_OUTPUT HAS MODE " &
+                      "IN_FILE");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               SET_INPUT (FILE1);
+               FAILED ("MODE_ERROR NOT RAISED FOR SET_INPUT WITH " &
+                       "MODE OUT_FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR SET_INPUT");
+          END;
+
+          CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME);
+
+          PUT (FILE2, "OUTPUT STRING");
+          CLOSE (FILE2);
+          OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME);
+
+          BEGIN
+               SET_OUTPUT (FILE2);
+               FAILED ("MODE_ERROR NOT RAISED FOR SET_OUTPUT WITH " &
+                       "MODE IN_FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR SET_OUTPUT");
+          END;
+
+          BEGIN
+               DELETE (FILE2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3207A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3301a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3301a.ada
new file mode 100644
index 000000000..4766cb9c0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3301a.ada
@@ -0,0 +1,176 @@
+-- CE3301A.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 THE LINE AND PAGE LENGTH ARE NONZERO, LINE AND
+--     PAGE TERMINATORS ARE OUTPUT AT THE APPROPRIATE POINTS.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/22/82
+--     SPS 11/15/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/27/87  COMPLETELY REVISED TEST.
+--     LDC 05/26/88  ADDED "FILE" PARAMETERS.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3301A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     TWO : CONSTANT COUNT := COUNT(IDENT_INT(2));
+     TEN : CONSTANT COUNT := COUNT(IDENT_INT(10));
+     THREE : CONSTANT COUNT := COUNT(IDENT_INT(3));
+     ITEM1 : STRING (1..10);
+     ITEM2 : STRING (1..2);
+
+BEGIN
+
+     TEST ("CE3301A", "CHECK THAT WHEN THE LINE AND PAGE LENGTH ARE " &
+                      "NONZERO, LINE AND PAGE TERMINATORS ARE " &
+                      "OUTPUT AT THE APPROPRIATE POINTS");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     IF LINE_LENGTH (FILE) /= UNBOUNDED THEN
+          FAILED ("LINE LENGTH NOT INITIALLY UNBOUNDED");
+     END IF;
+
+     IF PAGE_LENGTH (FILE) /= UNBOUNDED THEN
+          FAILED ("PAGE LENGTH NOT INITIALLY UNBOUNDED");
+     END IF;
+
+     SET_LINE_LENGTH (FILE,TEN);
+     SET_PAGE_LENGTH (FILE,TWO);
+
+     FOR I IN 1 .. 30 LOOP
+          PUT (FILE,'C');
+     END LOOP;
+
+     IF PAGE (FILE) /= 2 AND LINE (FILE) /= 1 THEN
+          FAILED ("LINE AND PAGE LENGTHS WERE NOT BOUND " &
+                  "CORRECTLY");
+     END IF;
+
+     SET_LINE_LENGTH (FILE, TWO);
+     SET_PAGE_LENGTH (FILE, THREE);
+     PUT (FILE, "DDDDDDD");
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     GET (FILE, ITEM1);
+
+     IF NOT (END_OF_LINE (FILE)) THEN
+          FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR");
+     END IF;
+
+     IF END_OF_PAGE (FILE) THEN
+          FAILED ("PAGE TERMINATOR OUTPUT AT INAPPROPRIATE POINT");
+     END IF;
+
+     GET (FILE, ITEM1);
+
+     IF ITEM1 /= "CCCCCCCCCC" THEN
+          FAILED ("INCORRECT VALUE READ");
+     END IF;
+
+     IF NOT (END_OF_LINE(FILE)) THEN
+          FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR");
+     END IF;
+
+     IF NOT (END_OF_PAGE(FILE)) THEN
+          FAILED ("INCORRECT VALUE BEFORE PAGE TERMINATOR");
+     END IF;
+
+     GET (FILE, ITEM1);
+     GET (FILE, ITEM2);
+
+     IF ITEM2 /= "DD" THEN
+          FAILED ("INCORRECT VALUE READ");
+     END IF;
+
+     IF NOT (END_OF_LINE(FILE)) THEN
+          FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR");
+     END IF;
+
+     IF END_OF_PAGE (FILE) THEN
+          FAILED ("PAGE TERMINATOR OUTPUT AT INAPPROPRIATE POINT");
+     END IF;
+
+     GET (FILE, ITEM2);
+
+     IF ITEM2 /= "DD" THEN
+          FAILED ("INCORRECT VALUE READ");
+     END IF;
+
+     IF NOT (END_OF_LINE(FILE)) THEN
+          FAILED ("INCORRECT VALUE BEFORE LINE TERMINATOR");
+     END IF;
+
+     IF NOT (END_OF_PAGE(FILE)) THEN
+          FAILED ("INCORRECT VALUE BEFORE PAGE TERMINATOR");
+     END IF;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3301A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3302a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3302a.ada
new file mode 100644
index 000000000..905da7abe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3302a.ada
@@ -0,0 +1,138 @@
+-- CE3302A.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 SET_LINE_LENGTH, SET_PAGE_LENGTH, LINE_LENGTH, AND
+--     PAGE_LENGTH RAISE MODE_ERROR WHEN APPLIED TO A FILE OF MODE
+--     IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/16/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/19/87  CREATED AN EXTERNAL FILE WITH A NAME, REMOVED
+--                   DEPENDENCE ON RESET, AND ADDED CODE TO DELETE
+--                   EXTERNAL FILE.
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3302A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     FIVE : COUNT := COUNT(IDENT_INT(5));
+     VAR1 : COUNT;
+     ITEM : CHARACTER := 'A';
+
+BEGIN
+     TEST ("CE3302A", "CHECK THAT SET_LINE_LENGTH, SET_PAGE_LENGTH, " &
+                      "LINE_LENGTH, AND PAGE_LENGTH RAISE MODE_ERROR " &
+                      "WHEN APPLIED TO A FILE OF MODE IN_FILE");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT FILE CREATE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT FILE CREATE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     PUT (FILE, ITEM);
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT FILE OPEN");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          SET_LINE_LENGTH (FILE, FIVE);
+          FAILED ("MODE_ERROR NOT RAISED - SET_LINE_LENGTH");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - SET_LINE_LENGTH");
+     END;
+
+     BEGIN
+          SET_PAGE_LENGTH (FILE, FIVE);
+          FAILED ("MODE_ERROR NOT RAISED - SET_PAGE_LENGTH");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - SET_PAGE_LENGTH");
+     END;
+
+     BEGIN
+          VAR1 := LINE_LENGTH (FILE);
+          FAILED ("MODE_ERROR NOT RAISED - LINE_LENGTH");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - LINE_LENGTH");
+     END;
+
+     BEGIN
+          VAR1 := PAGE_LENGTH (FILE);
+          FAILED ("MODE_ERROR NOT RAISED - PAGE_LENGTH");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - PAGE_LENGTH");
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3302A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3303a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3303a.ada
new file mode 100644
index 000000000..50facadb9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3303a.ada
@@ -0,0 +1,152 @@
+-- CE3303A.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 SET_LINE_LENGTH, SET_PAGE_LENGTH, LINE_LENGTH, AND
+--     PAGE_LENGTH RAISE STATUS_ERROR WHEN APPLIED TO A CLOSED FILE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/16/82
+--     JLH 08/19/87  ADDED AN ATTEMPT TO CREATE AN EXTERNAL FILE;
+--                   ADDED CHECKS TO THE SAME FOUR CASES WHICH EXIST
+--                   IN TEST AGAINST ATTEMPTED CREATE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3303A IS
+
+     FILE : FILE_TYPE;
+     FIVE : COUNT := COUNT(IDENT_INT(5));
+     C : COUNT;
+     ITEM : CHARACTER := 'A';
+
+BEGIN
+
+     TEST ("CE3303A" , "CHECK THAT SET_LINE_LENGTH, " &
+                       "SET_PAGE_LENGTH, LINE_LENGTH, AND " &
+                       "PAGE_LENGTH RAISE STATUS_ERROR " &
+                       "WHEN APPLIED TO A CLOSED FILE");
+
+-- FILE NONEXISTANT
+
+     BEGIN
+          SET_LINE_LENGTH (FILE, FIVE);
+          FAILED ("STATUS_ERROR NOT RAISED FOR SET_LINE_LENGTH - 1");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR SET_LINE_LENGTH " &
+                       "- 1");
+     END;
+
+     BEGIN
+          SET_PAGE_LENGTH (FILE, FIVE);
+          FAILED ("STATUS_ERROR NOT RAISED FOR SET_PAGE_LENGTH - 1");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR SET_PAGE_LENGTH " &
+                       "- 1");
+     END;
+
+     BEGIN
+          C := LINE_LENGTH (FILE);
+          FAILED ("STATUS_ERROR NOT RAISED FOR LINE_LENGTH - 1");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR LINE_LENGTH - 1");
+     END;
+
+     BEGIN
+          C := PAGE_LENGTH (FILE);
+          FAILED ("STATUS_ERROR NOT RAISED FOR PAGE_LENGTH - 1");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR PAGE_LENGTH - 1");
+     END;
+
+     BEGIN
+          CREATE (FILE, OUT_FILE);
+          PUT (FILE, ITEM);
+          CLOSE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     BEGIN
+          SET_LINE_LENGTH (FILE, FIVE);
+          FAILED ("STATUS_ERROR NOT RAISED FOR SET_LINE_LENGTH - 2");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR SET_LINE_LENGTH " &
+                       "- 2");
+     END;
+
+     BEGIN
+          SET_PAGE_LENGTH (FILE, FIVE);
+          FAILED ("STATUS_ERROR NOT RAISED FOR SET_PAGE_LENGTH - 2");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR SET_PAGE_LENGTH " &
+                       "- 2");
+     END;
+
+     BEGIN
+          C := LINE_LENGTH (FILE);
+          FAILED ("STATUS_ERROR NOT RAISED FOR LINE_LENGTH - 2");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR LINE_LENGTH - 2");
+     END;
+
+     BEGIN
+          C := PAGE_LENGTH (FILE);
+          FAILED ("STATUS_ERROR NOT RAISED FOR PAGE_LENGTH - 2");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR PAGE_LENGTH - 2");
+     END;
+
+     RESULT;
+
+END CE3303A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3304a.tst b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3304a.tst
new file mode 100644
index 000000000..e1ee3f859
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3304a.tst
@@ -0,0 +1,204 @@
+-- CE3304A.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 USE_ERROR IS RAISED BY A CALL TO SET_LINE_LENGTH
+--     OR TO SET_PAGE_LENGTH WHEN THE SPECIFIED VALUE IS INAPPROPRIATE
+--     FOR THE EXTERNAL FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS THAT SATISFY THE
+--     FOLLOWING CONDITIONS:
+--       1) TEXT FILES ARE SUPPORTED
+--       2) EITHER BY DEFAULT OR BY USE OF THE "FORM" PARAMETER TO
+--          THE CREATE PROCEDURE, A TEXT FILE CAN BE CREATED FOR
+--          WHICH AT LEAST ONE OF THE FOLLOWING CONDITIONS HOLDS:
+--           A)  THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT
+--               AN APPROPRIATE LINE-LENGTH FOR THE FILE,
+--             OR
+--           B)  THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT
+--               AN APPROPRIATE PAGE-LENGTH FOR THE FILE.
+
+-- MACRO SUBSTITUTIONS:
+--     FOR THE MACRO SYMBOL "$FORM_STRING," SUBSTITUTE A STRING LITERAL
+--     SPECIFIYING THAT THE EXTERNAL FILE MEETS BOTH OF THE CONDITIONS
+--     (A) AND (B) ABOVE.  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 SUBSTITUE THE NULL
+--     STRING ("").
+--     FOR THE MACRO SYMBOL "$INAPPROPRIATE_LINE_LENGTH," SUBSTITUTE
+--     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.
+--     FOR THE MACRO SYMBOL "$INAPPROPRIATE_PAGE_LENGTH," SUBSTITUTE
+--     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.
+
+-- HISTORY:
+--     PWB 07/07/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3304A IS
+
+     FILE1,
+     FILE2,
+     FILE3 : FILE_TYPE;
+
+     LINE_LENGTH_SHOULD_WORK,
+     PAGE_LENGTH_SHOULD_WORK : BOOLEAN;
+
+     INCOMPLETE : EXCEPTION;
+
+     TEST_VALUE : COUNT;
+
+BEGIN
+
+     TEST ("CE3304A", "CHECK THAT USE_ERROR IS RAISED IF A CALL TO " &
+                      "SET_LINE_LENGTH OR SET_PAGE_LENGTH SPECIFIES " &
+                      "A VALUE THAT IS INAPPROPRIATE FOR THE " &
+                      "EXTERNAL FILE");
+
+     BEGIN     -- CHECK WHETHER TEXT FILES ARE SUPPORTED.
+
+          CREATE(FILE1, OUT_FILE, LEGAL_FILE_NAME(1),
+                 FORM => $FORM_STRING);
+          PUT_LINE(FILE1, "AAA");
+          CLOSE(FILE1);
+
+     EXCEPTION
+
+          WHEN USE_ERROR | NAME_ERROR =>
+               NOT_APPLICABLE ("CREATION OF TEXT FILES NOT SUPPORTED");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED AT INITIAL CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN  -- CHECK INAPPROPRIATE LINE LENGTH.
+
+          BEGIN   -- IS THERE AN INAPPROPRIATE VALUE?
+               TEST_VALUE :=
+                         COUNT(IDENT_INT($INAPPROPRIATE_LINE_LENGTH));
+               IF NOT EQUAL (INTEGER(TEST_VALUE),
+                             INTEGER(TEST_VALUE)) THEN
+                    COMMENT ("OPTIMIZATION DEFEATED" &
+                              COUNT'IMAGE(TEST_VALUE));
+               END IF;
+               LINE_LENGTH_SHOULD_WORK := TRUE;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    LINE_LENGTH_SHOULD_WORK := FALSE;
+                    COMMENT("THERE IS NO INAPPROPRIATE LINE LENGTH");
+          END;
+
+          IF LINE_LENGTH_SHOULD_WORK THEN
+               BEGIN
+                    CREATE(FILE2, OUT_FILE, LEGAL_FILE_NAME(2),
+                           FORM => $FORM_STRING);
+                    SET_LINE_LENGTH(FILE2, $INAPPROPRIATE_LINE_LENGTH);
+                    FAILED("NO EXCEPTION FOR INAPPROPRIATE LINE " &
+                           "LENGTH");
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         IF NOT IS_OPEN(FILE2) THEN
+                              FAILED ("FILE NOT OPENED -- LINE LENGTH");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED FOR " &
+                                 "INAPPROPRIATE LINE LENGTH");
+               END;
+          END IF;
+     END;
+
+-----------------------------------------------------------------------
+
+     BEGIN  -- CHECK INAPPROPRIATE PAGE LENGTH.
+
+          BEGIN   -- IS THERE AN INAPPROPRIATE VALUE?
+               TEST_VALUE :=
+                         COUNT(IDENT_INT($INAPPROPRIATE_PAGE_LENGTH));
+               IF NOT EQUAL (INTEGER(TEST_VALUE),
+                             INTEGER(TEST_VALUE)) THEN
+                    COMMENT ("OPTIMIZATION DEFEATED" &
+                             COUNT'IMAGE(TEST_VALUE));
+               END IF;
+               PAGE_LENGTH_SHOULD_WORK := TRUE;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    PAGE_LENGTH_SHOULD_WORK := FALSE;
+                    COMMENT("THERE IS NO INAPPROPRIATE PAGE LENGTH");
+          END;
+
+          IF PAGE_LENGTH_SHOULD_WORK THEN
+               BEGIN
+                    CREATE(FILE3, OUT_FILE, LEGAL_FILE_NAME(3),
+                           FORM => $FORM_STRING);
+                    SET_PAGE_LENGTH(FILE3, $INAPPROPRIATE_PAGE_LENGTH);
+                    FAILED("NO EXCEPTION FOR INAPPROPRIATE PAGE " &
+                           "LENGTH");
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         IF NOT IS_OPEN(FILE3) THEN
+                              FAILED ("FILE NOT OPENED -- PAGE LENGTH");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED FOR " &
+                                 "INAPPROPRIATE PAGE LENGTH");
+               END;
+          END IF;
+     END;
+
+     IF NOT (PAGE_LENGTH_SHOULD_WORK OR LINE_LENGTH_SHOULD_WORK) THEN
+          NOT_APPLICABLE("NO INAPPROPRIATE VALUES FOR EITHER LINE " &
+                         "LENGTH OR PAGE LENGTH");
+     END IF;
+
+     BEGIN     -- CLEAN UP FILES.
+
+          IF IS_OPEN(FILE1) THEN
+               CLOSE(FILE1);
+          END IF;
+
+          IF IS_OPEN(FILE2) THEN
+               CLOSE(FILE2);
+          END IF;
+
+          IF IS_OPEN(FILE3) THEN
+               CLOSE(FILE3);
+          END IF;
+
+     EXCEPTION
+          WHEN USE_ERROR =>
+               COMMENT("FILES NOT DELETED");
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+END CE3304A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3305a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3305a.ada
new file mode 100644
index 000000000..1807d9128
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3305a.ada
@@ -0,0 +1,182 @@
+-- CE3305A.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 LINE AND PAGE LENGTHS MAY BE ALTERED DYNAMICALLY
+--     SEVERAL TIMES.  CHECK THAT WHEN RESET TO ZERO, THE LENGTHS ARE
+--     UNBOUNDED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES WITH UNBOUNDED LINE LENGTH.
+
+-- HISTORY:
+--     SPS 09/28/82
+--     EG  05/22/85
+--     DWC 08/18/87  ADDED CHECK_FILE WITHOUT A'S.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3305A IS
+
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3305A", "CHECK THAT LINE AND PAGE LENGTHS MAY BE " &
+                      "ALTERED DYNAMICALLY");
+
+     DECLARE
+          FT : FILE_TYPE;
+
+          PROCEDURE PUT_CHARS (CNT: INTEGER; CH: CHARACTER) IS
+          BEGIN
+               FOR I IN 1 .. CNT LOOP
+                    PUT (FT, CH);
+               END LOOP;
+          END PUT_CHARS;
+
+     BEGIN
+
+          BEGIN
+               CREATE(FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_LINE_LENGTH (FT, 10);
+          SET_PAGE_LENGTH (FT, 5);
+
+          PUT_CHARS (150, 'X');         -- 15 LINES
+
+          BEGIN
+               SET_LINE_LENGTH (FT, 5);
+               SET_PAGE_LENGTH (FT, 10);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNABLE TO CHANGE LINE OR PAGE LENGTH");
+          END;
+
+          PUT_CHARS (50, 'B');               -- 10 LINES
+
+          BEGIN
+               SET_LINE_LENGTH (FT, 25);
+               SET_PAGE_LENGTH (FT,4);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("UNABLE TO CHANGE LINE OR PAGE LENGTH - 2");
+          END;
+
+          PUT_CHARS (310, 'K');              -- 12 LINES, 10 CHARACTERS
+
+--  THIS CAN RAISE USE_ERROR IF AN IMPLEMENTATION REQUIRES A BOUNDED
+--  LINE LENGTH FOR AN EXTERNAL FILE.
+
+          BEGIN
+               BEGIN
+                    SET_LINE_LENGTH (FT, UNBOUNDED);
+                    SET_PAGE_LENGTH (FT, UNBOUNDED);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("BOUNDED LINE LENGTH " &
+                                         "REQUIRED");
+                         RAISE INCOMPLETE;
+               END;
+
+               PUT_CHARS (100, 'A');              -- ONE LINE
+
+               CHECK_FILE (FT,"XXXXXXXXXX#" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#@" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#@" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#" &
+                              "XXXXXXXXXX#" &
+                              "BBBBB#" &
+                              "BBBBB#" &
+                              "BBBBB#" &
+                              "BBBBB#" &
+                              "BBBBB#@" &
+                              "BBBBB#" &
+                              "BBBBB#" &
+                              "BBBBB#" &
+                              "BBBBB#" &
+                              "BBBBBKKKKKKKKKKKKKKKKKKKK#@" &
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#@" &
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#@" &
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#"&
+                              "KKKKKKKKKKKKKKKKKKKKKKKKK#"&
+                              "KKKKKKKKKKKKKKKAAAAAAAAAAA" &
+                              "AAAAAAAAAAAAAAAAAAAAAAAAAA" &
+                              "AAAAAAAAAAAAAAAAAAAAAAAAAA" &
+                              "AAAAAAAAAAAAAAAAAAAAAAAAAA" &
+                              "AAAAAAAAAAA#@%");
+
+          EXCEPTION
+               WHEN INCOMPLETE =>
+                    NULL;
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3305A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3306a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3306a.ada
new file mode 100644
index 000000000..c021f3147
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3306a.ada
@@ -0,0 +1,82 @@
+-- CE3306A.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 CONSTRAINT_ERROR IS RAISED IF THE VALUE OF 'TO' IS
+--     NEGATIVE OR GREATER THAN COUNT'LAST WHEN COUNT'LAST IS LESS THAN
+--     COUNT'BASE'LAST.
+
+-- HISTORY:
+--     JET 08/17/88  CREATED ORIGINAL TEST.
+--     PWN 10/27/95  REMOVED CONSTRAINT CHECK THAT NOW HAPPENS AT
+--                   COMPILE TIME.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+PROCEDURE CE3306A IS
+
+BEGIN
+     TEST ("CE3306A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF THE " &
+                      "VALUE OF 'TO' IS NEGATIVE OR GREATER THAN " &
+                      "COUNT'LAST WHEN COUNT'LAST IS LESS THAN " &
+                      "COUNT'BASE'LAST");
+
+     BEGIN
+          SET_LINE_LENGTH(-1);
+          FAILED("NO EXCEPTION FOR SET_LINE_LENGTH(-1)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION FOR SET_LINE_LENGTH(-1)");
+     END;
+
+     BEGIN
+          SET_PAGE_LENGTH(COUNT(IDENT_INT(-1)));
+          FAILED("NO EXCEPTION FOR SET_PAGE_LENGTH(-1)");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED("UNEXPECTED EXCEPTION FOR SET_PAGE_LENGTH(-1)");
+     END;
+
+     IF COUNT'LAST < COUNT'BASE'LAST THEN
+          BEGIN
+               SET_LINE_LENGTH(COUNT'LAST + COUNT(IDENT_INT(1)));
+               FAILED("NO EXCEPTION FOR SET_LINE_LENGTH(COUNT'LAST+1)");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION FOR SET_LINE_LENGTH" &
+                           "(COUNT'LAST+1)");
+          END;
+
+     ELSE
+          COMMENT("COUNT'LAST IS EQUAL TO COUNT'BASE'LAST");
+     END IF;
+
+     RESULT;
+END CE3306A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3401a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3401a.ada
new file mode 100644
index 000000000..714e16c03
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3401a.ada
@@ -0,0 +1,105 @@
+-- CE3401A.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 FORMAL PARAMETERS OF EACH COLUMN, LINE, AND
+--     PAGE OPERATION ARE NAMED CORRECTLY.
+
+-- HISTORY:
+--     JET 08/17/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+PROCEDURE CE3401A IS
+
+     FIN, FOUT : FILE_TYPE;
+     B : BOOLEAN;
+     C : COUNT;
+     FILE_OK : BOOLEAN := FALSE;
+
+BEGIN
+     TEST ("CE3401A", "CHECK THAT THE FORMAL PARAMETERS OF EACH " &
+                      "COLUMN, LINE, AND PAGE OPERATION ARE NAMED " &
+                      "CORRECTLY");
+
+     BEGIN
+          CREATE(FOUT, OUT_FILE, LEGAL_FILE_NAME);
+          FILE_OK := TRUE;
+     EXCEPTION
+          WHEN OTHERS =>
+               NOT_APPLICABLE("OUTPUT FILE COULD NOT BE CREATED");
+     END;
+
+     IF FILE_OK THEN
+          NEW_LINE(FILE => FOUT, SPACING => 1);
+          NEW_PAGE(FILE => FOUT);
+          SET_COL(FILE => FOUT, TO => 1);
+          SET_LINE(FILE => FOUT, TO => 1);
+          C := COL(FILE => FOUT);
+          C := LINE(FILE => FOUT);
+          C := PAGE(FILE => FOUT);
+
+          NEW_PAGE(FOUT);
+
+          BEGIN
+               CLOSE(FOUT);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED("OUTPUT FILE COULD NOT BE CLOSED");
+                    FILE_OK := FALSE;
+          END;
+     END IF;
+
+     IF FILE_OK THEN
+          BEGIN
+               OPEN(FIN, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED("INPUT FILE COULD NOT BE OPENED");
+                    FILE_OK := FALSE;
+          END;
+     END IF;
+
+     IF FILE_OK THEN
+          SKIP_LINE(FILE => FIN, SPACING => 1);
+          SKIP_PAGE(FILE => FIN);
+          B := END_OF_LINE(FILE => FIN);
+          B := END_OF_PAGE(FILE => FIN);
+          B := END_OF_FILE(FILE => FIN);
+
+          BEGIN
+               DELETE(FIN);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT("FILE COULD NOT BE DELETED");
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED ERROR AT DELETION");
+          END;
+     END IF;
+
+     RESULT;
+EXCEPTION
+     WHEN OTHERS =>
+          FAILED("UNEXPECTED EXCEPTION RAISED");
+END CE3401A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402a.ada
new file mode 100644
index 000000000..18773f848
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402a.ada
@@ -0,0 +1,117 @@
+-- CE3402A.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 NEW_LINE RAISES MODE_ERROR WHEN THE FILE MODE
+--     IS IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/16/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/19/87  ADDED ATTEMPT TO DELETE THE FILE AND REPLACED
+--                   RESET WITH CLOSE AND OPEN.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3402A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE1 : FILE_TYPE;
+     SPAC : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
+
+BEGIN
+
+     TEST ("CE3402A" , "CHECK THAT NEW_LINE RAISES MODE_ERROR " &
+                       "WHEN THE FILE MODE IS IN_FILE");
+
+     BEGIN
+          CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          PUT_LINE (FILE1, "STUFF");
+          CLOSE (FILE1);
+          OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED FOR OPEN " &
+                               "WITH IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          NEW_LINE (FILE1,SPAC);
+          FAILED ("MODE_ERROR NOT RAISED FOR IN_FILE");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR IN_FILE");
+     END;
+
+     BEGIN
+          NEW_LINE (STANDARD_INPUT,SPAC);
+          FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_INPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED FOR STANDARD_INPUT");
+     END;
+
+     BEGIN
+          DELETE (FILE1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3402A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402c.ada
new file mode 100644
index 000000000..ed5d27b1b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402c.ada
@@ -0,0 +1,112 @@
+-- CE3402C.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 NEW_LINE INCREMENTS THE CURRENT PAGE BY ONE AND
+--     SETS THE CURRENT LINE NUMBER TO ONE WHEN THE PAGE LENGTH IS
+--     BOUNDED AND THE LINE NUMBER WOULD HAVE EXCEEDED THE
+--     MAXIMUM PAGE LENGTH.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 09/01/82
+--     SPS 11/30/82
+--     SPS 01/24/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/19/87  ADDED ORIGINAL_LINE_LENGTH AND
+--                   ORIGINAL_PAGE_LENGTH VARIABLES AND CLOSED FILE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3402C IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
+     TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
+     THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
+     CHAR : CHARACTER := ('C');
+     ITEM_CHAR : CHARACTER;
+     ORIGINAL_LINE_LENGTH : COUNT := LINE_LENGTH;
+     ORIGINAL_PAGE_LENGTH : COUNT := PAGE_LENGTH;
+
+BEGIN
+
+     TEST ("CE3402C" , "CHECK END_OF_PAGE BEHAVIOR OF NEW_LINE");
+
+     BEGIN
+          CREATE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_LINE_LENGTH (FILE,THREE);
+     SET_PAGE_LENGTH (FILE,TWO);
+
+     FOR I IN 1..6
+     LOOP
+          PUT (FILE,CHAR);
+     END LOOP;
+
+     NEW_LINE (FILE);
+
+     IF PAGE (FILE) /= TWO THEN
+          FAILED ("PAGE NOT INCREMENTED BY ONE");
+     END IF;
+
+     IF LINE (FILE) /= ONE THEN
+          FAILED ("LINE NOT SET TO ONE");
+     END IF;
+
+     NEW_LINE (FILE, 7);
+     IF PAGE (FILE) /= POSITIVE_COUNT(IDENT_INT (5)) THEN
+          FAILED ("MULTIPLE PAGES NOT CREATED BY NEW_LINE");
+     END IF;
+
+     SET_LINE_LENGTH (FILE, ORIGINAL_LINE_LENGTH);
+     SET_PAGE_LENGTH (FILE, ORIGINAL_PAGE_LENGTH);
+     CHECK_FILE (FILE, "CCC#CCC#@##@##@##@#@%");
+
+     CLOSE (FILE);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3402C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402d.ada
new file mode 100644
index 000000000..a52c7dea6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402d.ada
@@ -0,0 +1,92 @@
+-- CE3402D.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 NEW_LINE SETS THE CURRENT COLUMN NUMBER TO ONE,
+--     AND NEW_LINE OUTPUTS LINE TERMINATORS WHEN THE SPACING IS
+--     GREATER THAN ONE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATE WITH OUT_FILE MODE FOR TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/19/87  CHANGED FAILED MESSAGE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3402D IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
+     SPAC3 : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
+     FOUR : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(4));
+
+BEGIN
+
+     TEST ("CE3402D",  "CHECK THAT NEW_LINE SETS THE CURRENT " &
+                       "COLUMN NUMBER TO ONE, AND NEW_LINE OUTPUTS " &
+                       "TERMINATORS WHEN THE SPACING IS " &
+                       "GREATER THAN ONE");
+
+     BEGIN
+          CREATE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN 1..5 LOOP
+          PUT (FILE, 'X');
+     END LOOP;
+
+     NEW_LINE (FILE, SPAC3);
+     IF LINE (FILE) /= FOUR THEN
+          FAILED ("NEW_LINE DID NOT OUTPUT LINE TERMINATORS");
+     END IF;
+
+     IF COL (FILE) /= ONE THEN
+          FAILED ("COLUMN NOT SET TO ONE");
+     END IF;
+     CLOSE (FILE);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3402D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402e.ada
new file mode 100644
index 000000000..7b498795a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3402e.ada
@@ -0,0 +1,106 @@
+-- CE3402E.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 NEW_LINE RAISES CONSTRAINT_ERROR IF SPACING IS
+--     ZERO, OR NEGATIVE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/16/82
+--     JBG 08/30/83
+--     DWC 08/19/87  ADDED COUNT'LAST CASE.
+--     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3402E IS
+
+     FILE : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3402E" , "CHECK THAT NEW_LINE RAISES CONSTRAINT_ERROR " &
+                       "IF SPACING IS ZERO, OR NEGATIVE");
+
+     BEGIN
+          NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(0)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR ZERO");
+     END;
+
+     BEGIN
+          NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(-2)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR NEGATIVE NUMBER");
+     END;
+
+     BEGIN
+          CREATE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     BEGIN
+          NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(0)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR ZERO");
+     END;
+
+     BEGIN
+          NEW_LINE (FILE,POSITIVE_COUNT(IDENT_INT(-2)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR NEGATIVE NUMBER");
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN OTHERS =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3402E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403a.ada
new file mode 100644
index 000000000..67ed44c7d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403a.ada
@@ -0,0 +1,109 @@
+-- CE3403A.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 SKIP_LINE CAN ONLY BE APPLIED TO FILES OF MODE
+--     IN_FILE, MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT CREATION OF TEMPORARY FILES WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/16/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/04/87  REVISED EXCEPTION HANDLERS AND ADDED A CASE
+--                   FOR STANDARD_OUTPUT.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3403A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     SPAC : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
+
+BEGIN
+
+     TEST ("CE3403A" , "CHECK THAT SKIP_LINE CAN ONLY BE " &
+                       "APPLIED TO FILES OF MODE IN_FILE");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE OF " &
+                               "TEMPORARY FILE WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          SKIP_LINE (FILE,SPAC);
+          FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR OUT_FILE");
+     END;
+
+     BEGIN
+          SKIP_LINE (CURRENT_OUTPUT,SPAC);
+          FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
+                       "CURRENT_OUTPUT");
+     END;
+
+     BEGIN
+          SKIP_LINE (STANDARD_OUTPUT,SPAC);
+          FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
+                       "STANDARD_OUTPUT");
+     END;
+
+     CLOSE (FILE);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3403A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403b.ada
new file mode 100644
index 000000000..5cae13d47
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403b.ada
@@ -0,0 +1,152 @@
+-- CE3403B.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 SPACING PARAMETER OF SKIP_LINE IS OPTIONAL,
+--     AND THAT THE DEFAULT VALUE IS ONE.
+--     CHECK THAT THE FILE PARAMETER IS ALSO OPTIONAL, AND THAT THE
+--     FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 12/14/82
+--     JBG 1/17/83
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/04/87  REVISED EXCEPTION HANDLERS, REMOVED
+--                   DEPENDENCIES ON RESET, AND ADDED AN ATTEMPT
+--                   TO DELETE FILE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3403B IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     SPAC, TWO : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
+     A    : INTEGER := CHARACTER'POS('A');
+     CH   : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3403B" , "CHECK DEFAULT SPACING AND FILE " &
+                       "OF SKIP_LINE");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN 1 .. 3 LOOP          -- CREATES "BBB#CC#D##F#@%"
+          FOR J IN 1 .. 4-I LOOP
+               PUT (FILE, CHARACTER'VAL(A + I));
+          END LOOP;
+          NEW_LINE (FILE);
+     END LOOP;
+     NEW_LINE (FILE);
+     PUT (FILE, 'F');
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                               "FOR IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     GET (FILE, CH);
+     IF CH /= CHARACTER'VAL (A + 1) THEN
+          FAILED ("LINE CONTENT WRONG - 1");
+     END IF;
+
+     SKIP_LINE (FILE);
+
+     IF LINE (FILE) /= TWO THEN
+          FAILED ("SPACING DEFAULT NOT ONE");
+     END IF;
+
+     GET (FILE, CH);
+     IF CH /= CHARACTER'VAL (A + 2) THEN
+          FAILED ("LINE CONTENT WRONG - 2");
+     END IF;
+
+     SET_INPUT (FILE);
+     SKIP_LINE (FILE);
+
+     IF LINE (FILE) /= 3 THEN
+          FAILED ("SKIP_LINE DOES NOT OPERATE CORRECTLY ON " &
+                  "DEFAULT FILE");
+     END IF;
+
+     GET (FILE, CH);
+     IF CH /= CHARACTER'VAL (A + 3) THEN
+          FAILED ("LINE CONTENT WRONG - 3");
+     END IF;
+
+     SKIP_LINE;
+
+     IF LINE (FILE) /= 4 THEN
+          FAILED ("LINE COUNT NOT 4; WAS " & COUNT'IMAGE(LINE(FILE)));
+     END IF;
+
+     GET (FILE, CH);
+     IF CH /= 'F' THEN
+          FAILED ("NOT RIGHT LINE");
+     END IF;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3403B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403c.ada
new file mode 100644
index 000000000..d6dd6586a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403c.ada
@@ -0,0 +1,122 @@
+-- CE3403C.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 SKIP_LINE SETS THE CURRENT COLUMN NUMBER TO ONE,
+--     AND THAT IT IS PERFORMED SPACING TIMES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/08/87  REVISED EXCEPTION HANDLING, REMOVED
+--                   DEPENDENCE ON RESET, AND ADDED NEW CASES.
+--     GJD 11/15/95  FIXED ADA 95 INCOMPATIBLE USE OF CHARACTER LITERALS.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3403C IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
+     SPAC3 : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
+     FOUR : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(4));
+     CH: CHARACTER;
+
+BEGIN
+
+     TEST ("CE3403C" , "CHECK THAT SKIP_LINE SETS THE CURRENT " &
+                       "COLUMN NUMBER TO ONE, AND THAT IT IS " &
+                       "PERFORMED SPACING TIMES");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN CHARACTER RANGE 'A' .. 'E' LOOP
+          FOR J IN 1 .. 3 LOOP
+               PUT (FILE, I);
+          END LOOP;
+          NEW_LINE (FILE);
+     END LOOP;
+
+     CLOSE (FILE);
+
+     BEGIN
+           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                               "FOR IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     IF COL (FILE) /= ONE THEN
+          FAILED ("COLUMN NOT SET TO ONE");
+     END IF;
+
+     GET (FILE, CH);
+
+     IF CH /= 'A' THEN
+          FAILED ("INCORRECT VALUE READ - 1");
+     END IF;
+
+     SKIP_LINE (FILE,SPAC3);
+     GET (FILE, CH);
+
+     IF CH /= 'D' THEN
+          FAILED ("INCORRECT VALUE READ - 2");
+     END IF;
+
+     IF LINE (FILE) /= FOUR THEN
+          FAILED ("NOT PERFORMED SPACING TIMES");
+     END IF;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3403C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403d.ada
new file mode 100644
index 000000000..6fc1a2532
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403d.ada
@@ -0,0 +1,99 @@
+-- CE3403D.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 SKIP_LINE RAISES CONSTRAINT_ERROR IF SPACING IS
+--     ZERO OR NEGATIVE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/16/82
+--     SPS 11/11/82
+--     DWC 09/09/87  ADDED CASE FOR COUNT'LAST.
+--     KAS 11/27/95  REMOVED CASES FOR COUNT'LAST
+--     TMB 11/19/96  FIXED OBJECTIVE
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3403D IS
+
+     FILE : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3403D" , "CHECK THAT SKIP_LINE RAISES " &
+                       "CONSTRAINT_ERROR IF SPACING IS ZERO, " &
+                       "OR NEGATIVE" );
+     BEGIN
+          SKIP_LINE (FILE, POSITIVE_COUNT(IDENT_INT(0)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO");
+     END;
+
+     BEGIN
+          SKIP_LINE (FILE, POSITIVE_COUNT(IDENT_INT(-2)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
+                       "NEGATIVE NUMBER");
+     END;
+
+
+     BEGIN
+          SKIP_LINE (POSITIVE_COUNT(IDENT_INT(0)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO - DEFAULT");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO " &
+                       "- DEFAULT");
+     END;
+
+     BEGIN
+          SKIP_LINE (POSITIVE_COUNT(IDENT_INT(-6)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUM " &
+                  "- DEFAULT");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED NEGATIVE NUM " &
+                       "- DEFAULT");
+     END;
+
+
+     RESULT;
+
+END CE3403D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403e.ada
new file mode 100644
index 000000000..3d324a72c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403e.ada
@@ -0,0 +1,150 @@
+-- CE3403E.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 SKIP_LINE INCREMENTS THE CURRENT LINE NUMBER BY ONE
+--     AND SETS THE CURRENT COLUMN NUMBER TO ONE IF THE LINE TERMINATOR
+--     IS NOT FOLLOWED BY A PAGE TERMINATOR, AND THAT IT SETS BOTH THE
+--     LINE AND COLUMN NUMBERS TO ONE AND INCREMENTS THE CURRENT PAGE
+--     NUMBER BY ONE IF THE LINE TERMINATOR IS FOLLOWED BY A PAGE
+--     TERMINATOR.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/20/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/09/87  REVISED TEST TO USE A FILE NAME, REMOVED
+--                   DEPENDENCE ON RESET, AND ATTEMPTED TO
+--                   DELETE THE FILE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3403E IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     ONE  : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
+     TWO  : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
+     CHAR : CHARACTER := ('C');
+
+BEGIN
+
+     TEST ("CE3403E" , "CHECK THAT SKIP_LINE SETS COLUMN, " &
+                       "LINE, AND PAGE NUMBERS CORRECTLY");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     PUT (FILE, CHAR);
+     NEW_LINE (FILE);
+     PUT (FILE, CHAR);
+     NEW_PAGE (FILE);
+     PUT (FILE, CHAR);
+
+      CLOSE (FILE);
+
+     BEGIN
+           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                               "WITH IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     IF (LINE (FILE) /= ONE) OR (PAGE (FILE) /= ONE) THEN
+          FAILED ("INCORRECT LINE AND PAGE NUMBERS");
+     ELSE
+
+-- LINE TERMINATOR NOT FOLLOWED BY PAGE TERMINATOR
+
+          GET (FILE, CHAR);
+
+          IF CHAR /= 'C' THEN
+               FAILED ("INCORRECT VALUE READ - 1");
+          END IF;
+
+          SKIP_LINE (FILE);
+          IF LINE (FILE) /= TWO THEN
+               FAILED ("FIRST SUBTEST - LINE NOT INCREMENTED");
+          END IF;
+          IF COL (FILE) /= ONE THEN
+               FAILED ("FIRST SUBTEST - COLUMN NOT SET TO ONE");
+          END IF;
+
+-- LINE TERMINATOR FOLLOWED BY PAGE TERMINATOR
+
+          GET (FILE, CHAR);
+
+          IF CHAR /= 'C' THEN
+               FAILED ("INCORRECT VALUE READ - 2");
+          END IF;
+
+          SKIP_LINE (FILE);
+          IF LINE (FILE) /= ONE THEN
+               FAILED ("SECOND SUBTEST - LINE NOT SET TO ONE");
+          END IF;
+          IF COL (FILE) /= ONE THEN
+               FAILED ("SECOND SUBTEST - COLUMN NOT SET TO ONE");
+          END IF;
+          IF PAGE (FILE) /= TWO THEN
+               FAILED ("SECOND SUBTEST - PAGE NOT INCREMENTED");
+          END IF;
+     END IF;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3403E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403f.ada
new file mode 100644
index 000000000..ebd6420f5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3403f.ada
@@ -0,0 +1,156 @@
+-- CE3403F.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 SKIP_LINE RAISES END_ERROR IF AN ATTEMPT IS
+--     MADE TO SKIP A FILE TERMINATOR.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 11/11/82
+--     SPS 12/14/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/09/87  REVISED TEST TO USE A FILE NAME, REMOVED
+--                   DEPENDENCE ON RESET, AND ADDED ATTEMPT TO
+--                   DELETE THE FILE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3403F IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     CHAR : CHARACTER := ('C');
+     ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT (1));
+     TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT (2));
+
+BEGIN
+     TEST ("CE3403F" , "CHECK THAT SKIP_LINE RAISES END_ERROR " &
+                       "IF AN ATTEMPT IS MADE TO SKIP A FILE " &
+                       "TERMINATOR");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN 1..3
+     LOOP
+          PUT (FILE,CHAR);
+     END LOOP;
+
+      CLOSE (FILE);
+
+     BEGIN
+           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                               "FOR IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          GET (FILE, CHAR);
+          IF CHAR /= 'C' THEN
+               FAILED ("INCORRECT VALUE READ");
+          END IF;
+
+          SKIP_LINE (FILE);
+          SKIP_LINE (FILE);
+          FAILED ("END_ERROR NOT RAISED - 1");
+     EXCEPTION
+          WHEN END_ERROR =>
+
+               IF COL (FILE) /= ONE THEN
+                    FAILED ("COL NOT RESET CORRECTLY");
+               END IF;
+
+               IF NOT END_OF_FILE (FILE) THEN
+                    FAILED ("NOT POSITIONED AT END OF FILE");
+               END IF;
+
+               IF PAGE (FILE) /= TWO THEN
+                    FAILED ("PAGE NOT INCREMENTED");
+               END IF;
+
+               IF LINE (FILE) /= ONE THEN
+                    FAILED ("LINE NOT RESET CORRECTLY");
+               END IF;
+
+               IF NOT END_OF_LINE (FILE) THEN
+                    FAILED ("EOL FALSE AT FILE TERMINATOR");
+               END IF;
+
+               IF NOT END_OF_PAGE (FILE) THEN
+                    FAILED ("EOP FALSE AT FILE TERMINATOR");
+               END IF;
+
+               BEGIN
+                    SKIP_LINE (FILE);
+                    FAILED ("END_ERROR NOT RAISED - 2");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+               END;
+
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3403F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404a.ada
new file mode 100644
index 000000000..a944138ec
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404a.ada
@@ -0,0 +1,94 @@
+-- CE3404A.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 END_OF_LINE RAISES MODE_ERROR WHEN APPLIED TO
+--     AN OUT_FILE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/17/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     GMT 29/28/87  COMPLETELY REVISED.
+
+WITH REPORT;  USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3404A IS
+
+     MY_FILE : FILE_TYPE;
+     BOOL    : BOOLEAN;
+
+BEGIN
+
+     TEST ("CE3404A", "CHECK THAT END_OF_LINE RAISES MODE_ERROR " &
+                      "WHEN APPLIED TO AN OUT_FILE");
+
+     BEGIN
+          BOOL := END_OF_FILE (CURRENT_OUTPUT);
+          FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT - 1");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
+                       "CURRENT_OUTPUT - 2");
+     END;
+
+     BEGIN
+          BOOL := END_OF_FILE (STANDARD_OUTPUT);
+          FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT - 3");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
+                       "STANDARD_OUTPUT - 4");
+     END;
+
+     BEGIN
+          CREATE (MY_FILE);
+          BEGIN
+               BOOL := END_OF_FILE (MY_FILE);
+               FAILED ("MODE_ERROR NOT RAISED FOR MY_FILE - 5");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
+                            "MY_FILE - 6");
+
+          END;
+
+          CLOSE (MY_FILE);
+
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3404A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404b.ada
new file mode 100644
index 000000000..87ae4b166
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404b.ada
@@ -0,0 +1,130 @@
+-- CE3404B.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 END_OF_LINE OPERATES ON THE CURRENT DEFAULT INPUT FILE
+--     IF NO FILE IS SPECIFIED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW  08/26/82
+--     SPS  09/17/82
+--     SPS  11/11/82
+--     TBN  11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                    RESULT WHEN FILES ARE NOT SUPPORTED.
+--     GMT  09/22/87  CREATED A NON-TEMP FILE, REMOVED DEPENDENCE ON
+--                    RESET, AND CHECKED THE VALUE OF THE CHAR READ.
+
+WITH REPORT;  USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3404B IS
+
+     INCOMPLETE : EXCEPTION;
+     MY_FILE    : FILE_TYPE;
+     LOOP_COUNT : INTEGER := 0;
+     BOOL       : BOOLEAN;
+     CHAR       : CHARACTER := ('C');
+
+BEGIN
+
+     TEST ("CE3404B", "CHECK THAT END_OF_LINE OPERATES ON THE " &
+                      "CURRENT DEFAULT INPUT FILE IF NO FILE " &
+                      "IS SPECIFIED");
+
+--   CREATE AND INITIALIZE THE FILE
+
+     BEGIN
+          CREATE (MY_FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE - 1");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE - 2");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE - 3");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN 1..3 LOOP
+          PUT (MY_FILE,CHAR);
+     END LOOP;
+     NEW_LINE (MY_FILE);
+     PUT (MY_FILE,CHAR);
+
+     CLOSE (MY_FILE);
+
+     BEGIN
+          OPEN (MY_FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE ERROR RAISED ON ATTEMPT TO " &
+                               "RE-OPEN WITH MODE OF IN_FILE - 4");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_INPUT (MY_FILE);
+
+--   START THE TEST
+
+     LOOP
+          GET (CHAR);
+          IF CHAR /= 'C' THEN
+               FAILED ("CHAR READ FROM FILE HAS WRONG VALUE - 5");
+               RAISE INCOMPLETE;
+          END IF;
+     EXIT WHEN END_OF_LINE;
+          LOOP_COUNT := LOOP_COUNT + 1;
+          IF LOOP_COUNT > IDENT_INT (3) THEN
+               FAILED ("END_OF_LINE ON DEFAULT INCORRECT - 6");
+               EXIT;
+          END IF;
+     END LOOP;
+
+     GET (CHAR);
+     IF CHAR /= 'C' THEN
+          FAILED ("FINAL CHAR READ FROM FILE HAS WRONG VALUE - 7");
+     END IF;
+
+     BEGIN
+          DELETE (MY_FILE);
+     EXCEPTION
+          WHEN OTHERS =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3404B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404c.ada
new file mode 100644
index 000000000..c03cf557a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404c.ada
@@ -0,0 +1,165 @@
+-- CE3404C.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 END_OF_LINE RETURNS THE CORRECT VALUE WHEN POSITIONED
+--     AT THE BEGINNING AND THE END OF A LINE, AND WHEN POSITIONED JUST
+--     BEFORE THE FILE TERMINATOR.
+
+--          CASE 1)  BOUNDED LINE LENGTH
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/17/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     GMT 09/22/87  REMOVED DEPENDENCE ON RESET AND MOVED THE CHECK
+--                   FOR UNBOUNDED LINE_LENGTH TO CE3404D.ADA.
+
+WITH REPORT;  USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3404C IS
+     INCOMPLETE     : EXCEPTION;
+     MY_FILE        : FILE_TYPE;
+     ITEM_CHAR      : CHARACTER;
+     CHAR           : CHARACTER := ('C');
+     TEN            : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(10));
+     BLANK_COUNTER  : NATURAL := 0;
+
+BEGIN
+
+     TEST ("CE3404C", "CHECK THAT END_OF_LINE RETURNS THE CORRECT " &
+                      "VALUE WHEN POSITIONED AT THE BEGINNING " &
+                      "AND THE END OF A LINE, AND WHEN POSITIONED " &
+                      "JUST BEFORE THE FILE TERMINATOR");
+
+--   CREATE AND INITIALIZE TEST FILE WITH BOUNDED LINE LENGTH
+
+     BEGIN
+          CREATE (MY_FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_LINE_LENGTH (MY_FILE,TEN);
+
+     FOR I IN 1..5 LOOP
+          PUT (MY_FILE, CHAR);
+     END LOOP;
+     NEW_LINE (MY_FILE);
+     PUT (MY_FILE, 'B');
+
+     CLOSE (MY_FILE);
+
+     BEGIN
+          OPEN (MY_FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+--   BEGIN THE TEST
+
+     IF END_OF_LINE (MY_FILE) THEN
+          FAILED ("END_OF_LINE: INCORRECT VALUE AT FIRST POSITION - 5");
+     END IF;
+
+     IF COL (MY_FILE) /= 1 THEN
+          FAILED ("EOL MODIFIED COL NUMBER - 6");
+     END IF;
+
+     FOR I IN 1..4 LOOP
+          GET (MY_FILE,ITEM_CHAR);
+     END LOOP;
+
+     IF END_OF_LINE (MY_FILE) THEN
+          FAILED ("END_OF_LINE: INCORRECT VALUE AT FIFTH POSITION - 7");
+     END IF;
+
+     GET (MY_FILE,ITEM_CHAR);
+
+     WHILE NOT END_OF_LINE (MY_FILE) LOOP
+          GET (MY_FILE, ITEM_CHAR);
+          IF ITEM_CHAR = ' ' THEN
+               BLANK_COUNTER := BLANK_COUNTER + 1;
+          ELSE
+               FAILED ("STRING WAS PADDED WITH SOMETHING OTHER THAN " &
+                       "BLANKS - 8");
+          END IF;
+     END LOOP;
+
+     IF BLANK_COUNTER > 5 THEN
+          FAILED ("TOO MANY BLANKS WERE USED FOR PADDING - 9");
+     END IF;
+
+     IF LINE (MY_FILE) /= 1 THEN
+          FAILED ("EOL SKIPPED LINE TERMINATOR - 10");
+     END IF;
+
+     IF NOT END_OF_LINE (MY_FILE) THEN
+          FAILED ("EOL SKIPPED LINE TERMINATOR - 11");
+     END IF;
+
+     SKIP_PAGE (MY_FILE);
+
+     IF PAGE (MY_FILE) /= 2 THEN
+          FAILED ("INCORRECT PAGE NUMBER");
+     END IF;
+
+     IF NOT END_OF_LINE (MY_FILE) THEN
+          FAILED ("INCORRECT VALUE WHEN POSITIONED JUST BEFORE FILE " &
+                  "TERMINATOR");
+     END IF;
+
+     BEGIN
+          DELETE (MY_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3404C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404d.ada
new file mode 100644
index 000000000..33e1f725b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3404d.ada
@@ -0,0 +1,152 @@
+-- CE3404D.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 END_OF_LINE RETURNS THE CORRECT VALUE WHEN POSITIONED
+--     AT THE BEGINNING AND THE END OF A LINE, AND WHEN POSITIONED JUST
+--     BEFORE THE FILE TERMINATOR.
+
+--          CASE 2)  UNBOUNDED LINE LENGTH
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     GMT  09/22/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;  USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3404D IS
+     INCOMPLETE     : EXCEPTION;
+     MY_FILE        : FILE_TYPE;
+     ITEM_CHAR      : CHARACTER;
+     CHAR           : CHARACTER := ('C');
+     TEN            : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(10));
+     BLANK_COUNTER  : NATURAL := 0;
+
+BEGIN
+
+     TEST ("CE3404D", "CHECK THAT END_OF_LINE RETURNS THE CORRECT " &
+                      "VALUE WHEN POSITIONED AT THE BEGINNING AND " &
+                      "THE END OF A LINE, AND WHEN POSITIONED JUST " &
+                      "BEFORE THE FILE TERMINATOR");
+
+--   CREATE AND INITIALIZE TEST FILE WITH BOUNDED LINE LENGTH
+
+     BEGIN
+          CREATE (MY_FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN 1..5 LOOP
+          PUT (MY_FILE, CHAR);
+     END LOOP;
+     NEW_LINE (MY_FILE);
+     PUT (MY_FILE, 'B');
+
+     CLOSE (MY_FILE);
+
+     BEGIN
+          OPEN (MY_FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+--   BEGIN THE TEST
+
+     IF END_OF_LINE (MY_FILE) THEN
+          FAILED ("END_OF_LINE: INCORRECT VALUE AT FIRST POSITION - 5");
+     END IF;
+
+     IF COL (MY_FILE) /= 1 THEN
+          FAILED ("EOL MODIFIED COL NUMBER - 6");
+     END IF;
+
+     FOR I IN 1..4 LOOP
+          GET (MY_FILE,ITEM_CHAR);
+     END LOOP;
+
+     IF END_OF_LINE (MY_FILE) THEN
+          FAILED ("END_OF_LINE: INCORRECT VALUE AT FIFTH POSITION - 7");
+     END IF;
+
+     GET (MY_FILE,ITEM_CHAR);
+
+     WHILE NOT END_OF_LINE (MY_FILE) LOOP
+          GET (MY_FILE, ITEM_CHAR);
+          IF ITEM_CHAR = ' ' THEN
+               FAILED ("STRING WAS PADDED WITH SOMETHING OTHER THAN " &
+                       "BLANKS - 8");
+          END IF;
+     END LOOP;
+
+     IF LINE (MY_FILE) /= 1 THEN
+          FAILED ("EOL SKIPPED LINE TERMINATOR - 10");
+     END IF;
+
+     IF NOT END_OF_LINE (MY_FILE) THEN
+          FAILED ("EOL SKIPPED LINE TERMINATOR - 11");
+     END IF;
+
+     SKIP_PAGE (MY_FILE);
+
+     IF PAGE (MY_FILE) /= 2 THEN
+          FAILED ("INCORRECT PAGE NUMBER");
+     END IF;
+
+     IF NOT END_OF_LINE (MY_FILE) THEN
+          FAILED ("INCORRECT VALUE WHEN POSITIONED JUST BEFORE " &
+                  "TERMINATOR");
+     END IF;
+
+     BEGIN
+          DELETE (MY_FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3404D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3405a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3405a.ada
new file mode 100644
index 000000000..d035af7ce
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3405a.ada
@@ -0,0 +1,127 @@
+-- CE3405A.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 NEW_PAGE OUTPUTS A LINE TERMINATOR FOLLOWED BY A PAGE
+--     TERMINATOR IF THE CURRENT LINE IS NOT AT COLUMN 1 OR IF THE
+--     CURRENT PAGE IS AT LINE 1;  IF THE CURRENT LINE IS AT COLUMN 1,
+--     OUTPUTS A PAGE TERMINATOR ONLY.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     ABW 09/02/82
+--     JBG 01/18/83
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/23/87  ADDED A CASE WHICH CALLS NEW_LINE AND NEW_PAGE
+--                   CONSECUTIVELY AND SEPARATED CASES INTO DIFFERENT
+--                   IF STATEMENTS.  ADDED CHECK FOR USE_ERROR ON
+--                   DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3405A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE  : FILE_TYPE;
+     ONE   : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
+     TWO   : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
+     THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
+     FOUR  : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(4));
+     CHAR  : CHARACTER := ('C');
+
+BEGIN
+
+     TEST ("CE3405A", "CHECK THAT NEW_PAGE OUTPUTS A LINE TERMINATOR " &
+                      "FOLLOWED BY A PAGE TERMINATOR IF THE CURRENT " &
+                      "LINE IS NOT AT COLUMN 1 OR IF THE CURRENT " &
+                      "PAGE IS AT LINE 1;  IF THE CURRENT LINE IS AT " &
+                      "COLUMN 1, OUTPUTS A PAGE TERMINATOR ONLY");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     NEW_PAGE (FILE);
+     NEW_PAGE (FILE);                   -- CURRENT PAGE TERMINATED
+     IF PAGE (FILE) /= THREE THEN
+          FAILED ("INITIAL PAGE COUNT INCORRECT");
+     END IF;
+
+     SET_LINE_LENGTH (FILE,THREE);
+     PUT (FILE,CHAR);
+     NEW_LINE (FILE);
+
+     IF LINE (FILE) /= TWO THEN
+          FAILED ("INCORRECT LINE NUMBER - 1");
+     END IF;
+
+     IF PAGE (FILE) /= THREE THEN
+          FAILED ("INCORRECT PAGE NUMBER - 2");
+     END IF;
+
+     NEW_PAGE (FILE);             -- CURRENT LINE TERMINATED (B)
+     IF LINE (FILE) /= ONE THEN
+          FAILED ("LINE NUMBER NOT INCREMENTED");
+     END IF;
+     IF PAGE (FILE) /= FOUR THEN
+          FAILED ("PAGE NUMBER NOT INCREMENTED");
+     END IF;
+     PUT (FILE, IDENT_CHAR('E'));  -- CURRENT LINE NOT TERM (C)
+     NEW_PAGE (FILE);
+     NEW_LINE (FILE);
+     NEW_PAGE (FILE);
+
+     CHECK_FILE (FILE, "#@#@C#@E#@#@%");
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3405A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3405c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3405c.ada
new file mode 100644
index 000000000..27f157440
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3405c.ada
@@ -0,0 +1,126 @@
+-- CE3405C.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 NEW_PAGE RAISES MODE_ERROR IF THE FILE SPECIFIED
+--     HAS MODE IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/23/87  CREATED AN EXTERNAL FILE, REMOVED DEPENDENCE ON
+--                   RESET, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3405C IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3405C", "CHECK THAT NEW_PAGE RAISES MODE_ERROR IF THE " &
+                      "FILE SPECIFIED HAS MODE IN_FILE");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     PUT (FILE, "STUFF");
+
+     CLOSE (FILE);
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                               "WITH IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          NEW_PAGE (FILE);
+          FAILED ("MODE_ERROR NOT RAISED FOR IN_FILE");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR IN_FILE");
+     END;
+
+     BEGIN
+          NEW_PAGE (STANDARD_INPUT);
+          FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_INPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR STANDARD_INPUT");
+     END;
+
+     BEGIN
+          NEW_PAGE (CURRENT_INPUT);
+          FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_INPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR CURRENT_INPUT");
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3405C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3405d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3405d.ada
new file mode 100644
index 000000000..b21fb1df6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3405d.ada
@@ -0,0 +1,114 @@
+-- CE3405D.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 NEW_PAGE INCREMENTS THE CURRENT PAGE NUMBER AND
+--     SETS THE CURRENT COLUMN AND LINE NUMBERS TO ONE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 08/28/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/23/87  CORRECTED EXCEPTION HANDLING AND ADDED CASES FOR
+--                   CONSECUTIVE NEW_LINE AND NEW_PAGE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3405D IS
+     INCOMPLETE : EXCEPTION;
+BEGIN
+
+     TEST ("CE3405D", "CHECK THAT NEW_PAGE INCREMENTS PAGE COUNT " &
+                      "AND SETS COLUMN AND LINE TO ONE");
+
+     DECLARE
+          FT : FILE_TYPE;
+          CH : CHARACTER;
+          PG_NUM : POSITIVE_COUNT;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "FOR TEMP FILE WITH OUT_FILE " &
+                                    "MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "STRING");
+          NEW_LINE (FT);
+          PUT (FT, 'X');
+          PG_NUM := PAGE (FT);
+
+          NEW_PAGE (FT);
+
+          IF COL(FT) /= 1 THEN
+               FAILED ("COLUMN NUMBER NOT RESET - OUTPUT - 1");
+          END IF;
+          IF LINE (FT) /= 1 THEN
+               FAILED ("LINE NUMBER NOT RESET - OUTPUT - 1");
+          END IF;
+          IF PAGE (FT) /= PG_NUM + 1 THEN
+               FAILED ("PAGE NUMBER NOT INCREMENTED - OUTPUT - 1");
+          END IF;
+
+          PUT (FT, "MORE STUFF");
+          NEW_LINE (FT);
+          NEW_PAGE (FT);
+
+          IF COL(FT) /= 1 THEN
+               FAILED ("COLUMN NUMBER NOT RESET - OUTPUT - 2");
+          END IF;
+          IF LINE (FT) /= 1 THEN
+               FAILED ("LINE NUMBER NOT RESET - OUTPUT - 2");
+          END IF;
+          IF PAGE (FT) /= PG_NUM + 2 THEN
+               FAILED ("PAGE NUMBER NOT INCREMENTED - OUTPUT - 2");
+          END IF;
+
+          CHECK_FILE (FT, "STRING#X#@MORE STUFF#@%");
+
+          CLOSE (FT);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3405D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406a.ada
new file mode 100644
index 000000000..14765189f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406a.ada
@@ -0,0 +1,159 @@
+-- CE3406A.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 SKIP_PAGE READS AND DISCARDS CHARACTERS AND LINE
+--     TERMINATORS UNTIL A PAGE TERMINATOR IS READ, ADDS ONE TO THE
+--     CURRENT PAGE NUMBER, AND SETS THE CURRENT COLUMN NUMBER AND LINE
+--     NUMBER TO ONE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/17/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/24/87  CREATED NON-TEMPORARY FILE, REMOVED DEPENDENCE
+--                   ON RESET, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3406A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     CHAR_X : CHARACTER := ('X');
+     ITEM_CHAR : CHARACTER;
+     ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
+     TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
+     THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
+
+BEGIN
+
+     TEST ("CE3406A", "CHECK THAT SKIP_LINE READS AND " &
+                      "SETS PAGE AND COLUMN CORRECTLY");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     PUT (FILE, "CDE");
+     NEW_LINE (FILE);
+     PUT (FILE, "FGHI");
+     NEW_LINE (FILE);
+     PUT (FILE, "JK");
+     NEW_PAGE (FILE);
+     NEW_PAGE (FILE);
+     PUT (FILE,CHAR_X);
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     IF (LINE (FILE) /= ONE) THEN
+          FAILED ("LINE NUMBER NOT EQUAL TO ONE");
+     END IF;
+
+     IF (PAGE (FILE) /= ONE) THEN
+          FAILED ("PAGE NUMBER NOT EQUAL TO ONE");
+     END IF;
+
+     GET (FILE, ITEM_CHAR);
+
+     IF ITEM_CHAR /= 'C' THEN
+          FAILED ("INCORRECT VALUE READ FROM FILE - 1");
+     END IF;
+
+     SKIP_PAGE (FILE);
+
+     IF COL (FILE) /= ONE THEN
+          FAILED ("COLUMN NOT SET TO ONE - 1");
+     END IF;
+
+     IF LINE (FILE) /= ONE THEN
+          FAILED ("LINE NOT SET TO ONE - 1");
+     END IF;
+
+     IF PAGE (FILE) /= TWO THEN
+          FAILED ("PAGE NOT SET TO TWO");
+     END IF;
+
+     SKIP_PAGE (FILE);
+
+     IF COL (FILE) /= ONE THEN
+          FAILED ("COLUMN NOT SET TO ONE - 2");
+     END IF;
+
+     IF LINE (FILE) /= ONE THEN
+          FAILED ("LINE NOT SET TO ONE - 2");
+     END IF;
+
+     IF PAGE (FILE) /= THREE THEN
+          FAILED ("PAGE NOT SET TO THREE");
+     END IF;
+
+     GET (FILE, ITEM_CHAR);
+     IF ITEM_CHAR /= 'X' THEN
+          FAILED ("INCORRECT VALUE READ FROM FILE - 2");
+     END IF;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3406A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406b.ada
new file mode 100644
index 000000000..95e7c7adb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406b.ada
@@ -0,0 +1,104 @@
+-- CE3406B.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 SKIP_PAGE CAN ONLY BE APPLIED TO FILES OF MODE
+--     IN_FILE, MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILE CREATE WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/24/87  CORRECTED EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3406B IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3406B", "CHECK THAT SKIP_PAGE CAN ONLY BE " &
+                      "APPLIED TO FILES OF MODE IN_FILE");
+
+     BEGIN
+          CREATE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                               "FOR TEMPORARY FILE WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          SKIP_PAGE (FILE);
+          FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR OUT_FILE");
+     END;
+
+     BEGIN
+          SKIP_PAGE (STANDARD_OUTPUT);
+          FAILED ("MODE_ERROR RAISED FOR STANDARD_OUTPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR STANDARD_OUTPUT");
+     END;
+
+     BEGIN
+          SKIP_PAGE (CURRENT_OUTPUT);
+          FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR CURRENT_OUTPUT");
+     END;
+
+     CLOSE (FILE);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3406B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406c.ada
new file mode 100644
index 000000000..bc3027429
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406c.ada
@@ -0,0 +1,148 @@
+-- CE3406C.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 SKIP_PAGE RAISES END_ERROR WHEN THE FILE IS POSITIONED
+--     BEFORE THE FILE TERMINATOR BUT NOT WHEN THE FILE IS POSITIONED
+--     BEFORE THE FINAL PAGE TERMINATOR.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/17/82
+--     JBG 01/24/83
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/24/87  CREATED NON-TEMPORARY FILE, REMOVED DEPENDENCE
+--                   ON RESET, AND CHECKED CHARACTER READ IN.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3406C IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     CHAR : CHARACTER := ('C');
+     ITEM_CHAR : CHARACTER;
+     TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
+
+BEGIN
+
+     TEST ("CE3406C", "CHECK THAT SKIP_PAGE RAISES END_ERROR WHEN " &
+                      "THE FILE IS POSITIONED BEFORE THE FILE " &
+                      "TERMINATOR BUT NOT WHEN THE FILE IS " &
+                      "POSITIONED BEFORE THE FINAL PAGE TERMINATOR");
+
+-- CREATE AND INITIALIZE FILE
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN 1..2 LOOP
+          FOR I IN 1..3 LOOP
+               PUT (FILE,CHAR);
+          END LOOP;
+          NEW_LINE (FILE);
+     END LOOP;
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+-- START TEST
+
+-- TEST SKIP_PAGE BEFORE FINAL PAGE TERMINATOR
+
+     WHILE NOT END_OF_PAGE (FILE) LOOP
+          GET (FILE, ITEM_CHAR);
+          IF ITEM_CHAR /= 'C' THEN
+               FAILED ("INCORRECT VALUE READ FROM FILE");
+          END IF;
+     END LOOP;
+
+     BEGIN
+          SKIP_PAGE (FILE);
+     EXCEPTION
+          WHEN END_ERROR =>
+               FAILED ("RAISED END_ERROR BEFORE FINAL PAGE " &
+                       "TERMINATOR - 1");
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED - 1");
+     END;
+
+     IF PAGE (FILE) /= TWO THEN
+          FAILED ("PAGE NOT SET TO TWO");
+     END IF;
+
+-- TEST SKIP_PAGE BEFORE FILE TERMINATOR
+     BEGIN
+          SKIP_PAGE (FILE);
+          FAILED ("END_ERROR NOT RAISED");
+     EXCEPTION
+          WHEN END_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED - 2");
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3406C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406d.ada
new file mode 100644
index 000000000..fa1ba25f0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3406d.ada
@@ -0,0 +1,122 @@
+-- CE3406D.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 SKIP_PAGE OPERATES ON THE CURRENT DEFAULT INPUT
+--     FILE WHEN NO FILE IS SPECIFIED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     JBG 01/26/83
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/24/87  CREATED NON-TEMPORARY FILE, REMOVED DEPENDENCE
+--                   ON RESET, AND CHECKED CHARACTER READ IN.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3406D IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     ITEM_CHAR : CHARACTER;
+     TWO : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
+     THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
+
+BEGIN
+
+     TEST ("CE3406D", "CHECK THAT SKIP_PAGE OPERATES ON THE CURRENT " &
+                      "DEFAULT INPUT FILE WHEN NO FILE IS SPECIFIED");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     PUT (FILE, "ABC");
+     NEW_PAGE (FILE);
+     PUT (FILE, "DEF");
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_INPUT (FILE);
+
+     SKIP_PAGE;
+
+     GET (FILE, ITEM_CHAR);
+     IF ITEM_CHAR /= 'D' THEN
+          FAILED ("INCORRECT VALUE READ FROM FILE");
+     END IF;
+
+     IF PAGE (CURRENT_INPUT) /= TWO THEN
+          FAILED ("SKIP_PAGE NOT APPLIED TO CURRENT_INPUT");
+     END IF;
+
+     SKIP_PAGE (FILE);
+
+     IF PAGE (CURRENT_INPUT) /= THREE THEN
+          FAILED ("SKIP_PAGE NOT APPLIED TO CURRENT_INPUT");
+     END IF;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3406D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3407a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3407a.ada
new file mode 100644
index 000000000..d3a0052f2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3407a.ada
@@ -0,0 +1,141 @@
+-- CE3407A.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 END_OF_PAGE RETURNS THE CORRECT VALUE WHEN POSITIONED
+--     AT THE BEGINNING AND AT THE END OF THE PAGE, AND BEFORE A FILE
+--     TERMINATOR.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/22/82
+--     JBG 01/26/83
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/28/87  REMOVED UNNECESSARY CODE, REMOVED DEPENDENCE
+--                   ON RESET AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3407A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE1 : FILE_TYPE;
+     CHAR  : CHARACTER := ('C');
+     ITEM_CHAR : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3407A", "CHECK THAT END_OF_PAGE RETURNS " &
+                      "THE CORRECT VALUE");
+
+-- CREATE & INITIALIZE OUTPUT FILE
+
+     BEGIN
+          CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN 1..6 LOOP
+          PUT (FILE1, CHAR);
+     END LOOP;
+
+     CLOSE (FILE1);
+
+     BEGIN
+          OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     IF END_OF_PAGE (FILE1) THEN
+          FAILED ("INCORRECT VALUE AT FIRST POSITION - 1");
+     END IF;
+
+     IF END_OF_PAGE (FILE1) THEN
+          FAILED ("INCORRECT VALUE AT FIRST POSITION - 2");
+     END IF;
+
+-- TEST WHEN POSITIONED BEFORE LAST CHARACTER IN FILE
+
+     FOR I IN 1..5 LOOP
+          GET (FILE1, ITEM_CHAR);
+     END LOOP;
+
+     IF END_OF_PAGE (FILE1) THEN
+          FAILED ("INCORRECT VALUE BEFORE LAST CHARACTER");
+     END IF;
+
+-- TEST WHEN AT END OF FILE
+
+     GET (FILE1, ITEM_CHAR);
+     IF NOT END_OF_PAGE (FILE1) THEN
+          FAILED ("INCORRECT VALUE AT LAST POSITION");
+     END IF;
+
+     SKIP_PAGE (FILE1);
+
+     IF NOT END_OF_PAGE (FILE1) THEN
+          FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 1");
+     END IF;
+
+     IF NOT END_OF_PAGE (FILE1) THEN
+          FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 2");
+     END IF;
+
+     BEGIN
+          DELETE (FILE1);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3407A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3407b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3407b.ada
new file mode 100644
index 000000000..c4a509c3d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3407b.ada
@@ -0,0 +1,107 @@
+-- CE3407B.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 END_OF_PAGE CAN ONLY BE APPLIED TO FILES OF MODE
+--     IN_FILE, THAT MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/22/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/28/87  CORRECTED EXCEPTION HANDLING AND ADDED CASE
+--                   FOR CURRENT_OUTPUT.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3407B IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     BOOL : BOOLEAN;
+
+BEGIN
+
+     TEST ("CE3407B", "CHECK THAT END_OF_PAGE RAISES MODE_ERROR " &
+                      "FOR FILES OF MODE OUT_FILE");
+
+     BEGIN
+          CREATE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " &
+                               "TEMPORARY FILE WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          BOOL := END_OF_PAGE (FILE);
+          FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR OUT_FILE");
+     END;
+
+     BEGIN
+          BOOL := END_OF_PAGE (STANDARD_OUTPUT);
+          FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR STANDARD_OUTPUT");
+     END;
+
+     BEGIN
+          BOOL := END_OF_PAGE (CURRENT_OUTPUT);
+          FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("OTHER EXCEPTION RAISED FOR CURRENT_OUTPUT");
+     END;
+
+     CLOSE (FILE);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3407B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3407c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3407c.ada
new file mode 100644
index 000000000..7be1f47c4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3407c.ada
@@ -0,0 +1,134 @@
+-- CE3407C.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 FILE PARAMETER OF END_OF_PAGE IS OPTIONAL, AND
+--     THAT THE FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT
+--     FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/28/87  REMOVED DEPENDENCE ON RESET, ADDED MORE CASES FOR
+--                   END_OF_PAGE, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3407C IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE_IN : FILE_TYPE;
+     CHAR : CHARACTER := 'C';
+     ITEM_CHAR : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3407C", "CHECK THAT THE FILE PARAMETER OF END_OF_PAGE " &
+                      "IS OPTIONAL, AND THAT THE FUNCTION IS THEN " &
+                      "APPLIED TO THE CURRENT DEFAULT INPUT FILE");
+
+     BEGIN
+          CREATE (FILE_IN, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "MODE OUT_FILE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH MODE OUT_FILE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN 1..3 LOOP
+          PUT (FILE_IN, CHAR);
+     END LOOP;
+     NEW_PAGE (FILE_IN);
+     PUT (FILE_IN, 'D');
+
+     CLOSE (FILE_IN);
+
+     BEGIN
+          OPEN (FILE_IN, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_INPUT (FILE_IN);
+
+     IF END_OF_PAGE THEN
+          FAILED ("INCORRECT VALUE AT FIRST POSITION");
+     END IF;
+
+     IF END_OF_PAGE /= END_OF_PAGE (FILE_IN) THEN
+          FAILED ("END OF PAGE DOES NOT OPERATE WITH DEFAULT FILE");
+     END IF;
+
+     GET (ITEM_CHAR);
+     GET (ITEM_CHAR);
+     GET (ITEM_CHAR);
+
+     IF END_OF_PAGE /= TRUE THEN
+          FAILED ("INCORRECT VALUE BEFORE PAGE TERMINATOR");
+     END IF;
+
+     IF END_OF_PAGE /= END_OF_PAGE (FILE_IN) THEN
+          FAILED ("END_OF_PAGE WITHOUT PARAMETER DOES " &
+                  "NOT OPERATE ON THE DEFAULT INPUT FILE");
+     END IF;
+
+     GET (ITEM_CHAR);
+
+     IF NOT (END_OF_PAGE) THEN
+          FAILED ("INCORRECT VALUE AT LAST POSITION");
+     END IF;
+
+     BEGIN
+          DELETE (FILE_IN);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3407C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3408a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3408a.ada
new file mode 100644
index 000000000..2b0107e5a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3408a.ada
@@ -0,0 +1,142 @@
+-- CE3408A.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 END_OF_FILE RETURNS TRUE ONLY IF POSITIONED BEFORE THE
+--     FINAL PAGE TERMINATOR OR BEFORE THE FILE TERMINATOR.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     JBG 01/26/83
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/31/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
+--                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3408A IS
+
+     INCOMPLETE : EXCEPTION;
+     COUNT      : INTEGER := 0;
+     FILE       : FILE_TYPE;
+     CHAR       : CHARACTER := ('C');
+     ITEM_CHAR  : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3408A", "CHECK THAT END_OF_FILE RETURNS " &
+                      "THE CORRECT VALUE");
+
+-- CREATE & INITIALIZE OUTPUT FILE.
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN 1..6 LOOP
+          PUT (FILE, CHAR);
+     END LOOP;
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+-- TEST WHEN POSITIONED TO BEGINNING OF FILE.
+
+     IF END_OF_FILE (FILE) THEN
+          FAILED ("INCORRECT VALUE AT FIRST POSITION - 1");
+     END IF;
+
+     IF END_OF_FILE (FILE) THEN
+          FAILED ("INCORRECT VALUE AT FIRST POSITION - 2");
+     END IF;
+
+-- TEST WHEN POSITIONED BEFORE LAST CHARACTER IN FILE.
+
+     FOR I IN 1..5 LOOP
+          GET (FILE, ITEM_CHAR);
+     END LOOP;
+
+     IF END_OF_FILE (FILE) THEN
+          FAILED ("INCORRECT VALUE BEFORE LAST CHARACTER");
+     END IF;
+
+-- TEST WHEN AT END OF FILE.
+
+     GET (FILE, ITEM_CHAR);
+     IF NOT END_OF_FILE (FILE) THEN
+          FAILED ("INCORRECT VALUE AT LAST POSITION");
+     END IF;
+
+     SKIP_PAGE (FILE);
+
+     IF NOT END_OF_FILE (FILE) THEN
+          FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 1");
+     END IF;
+
+     IF NOT END_OF_FILE (FILE) THEN
+          FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 2");
+     END IF;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3408A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3408b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3408b.ada
new file mode 100644
index 000000000..a8269f7ab
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3408b.ada
@@ -0,0 +1,109 @@
+-- CE3408B.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 END_OF_FILE CAN ONLY BE APPLIED TO FILES OF MODE
+--     IN_FILE, MODE_ERROR IS RAISED FOR FILES OF MODE OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/20/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/31/87  CORRECTED EXCEPTION HANDLING, REMOVED UNNECESSARY
+--                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3408B IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     BOOL : BOOLEAN;
+
+BEGIN
+
+     TEST ("CE3408B", "CHECK THAT END_OF_FILE CAN ONLY BE " &
+                      "APPLIED TO FILES OF MODE IN_FILE");
+
+     BEGIN
+          CREATE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " &
+                               "TEMPORARY FILE WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          BOOL := END_OF_FILE (FILE);
+          FAILED ("MODE_ERROR NOT RAISED FOR OUT_FILE");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR OUT_FILE");
+     END;
+
+     BEGIN
+          BOOL := END_OF_FILE (STANDARD_OUTPUT);
+          FAILED ("MODE_ERROR NOT RAISED FOR STANDARD_OUTPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
+                       "STANDARD_OUTPUT");
+     END;
+
+     BEGIN
+          BOOL := END_OF_FILE (CURRENT_OUTPUT);
+          FAILED ("MODE_ERROR NOT RAISED FOR CURRENT_OUTPUT");
+     EXCEPTION
+          WHEN MODE_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR " &
+                       "CURRENT_OUTPUT");
+     END;
+
+     CLOSE (FILE);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3408B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3408c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3408c.ada
new file mode 100644
index 000000000..db74ac5bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3408c.ada
@@ -0,0 +1,138 @@
+-- CE3408C.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 FILE PARAMETER OF END_OF_FILE IS OPTIONAL, AND
+--     THAT THE FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT
+--     FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/31/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
+--                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3408C IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE_IN : FILE_TYPE;
+     CHAR : CHARACTER := 'A';
+     ITEM_CHAR : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3408C", "CHECK THAT THE FILE PARAMETER OF END_OF_FILE " &
+                      "IS OPTIONAL, AND THAT THE FUNCTION IS THEN " &
+                      "APPLIED TO THE CURRENT DEFAULT INPUT FILE");
+
+
+-- CREATE TEST FILE
+
+     BEGIN
+          CREATE (FILE_IN, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN 1..3 LOOP
+          PUT (FILE_IN, CHAR);
+     END LOOP;
+     NEW_PAGE (FILE_IN);
+
+     PUT (FILE_IN, CHAR);
+
+     CLOSE (FILE_IN);
+
+     BEGIN
+          OPEN (FILE_IN, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "MODE IN_FILE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_INPUT (FILE_IN);
+     IF END_OF_FILE THEN
+          FAILED ("INCORRECT VALUE AT FIRST POSITION");
+     END IF;
+
+     IF END_OF_FILE /= END_OF_FILE (FILE_IN) THEN
+          FAILED ("END OF FILE DOES NOT OPERATE WITH DEFAULT FILE");
+     END IF;
+
+     WHILE NOT END_OF_PAGE (FILE_IN)
+     LOOP
+          GET (ITEM_CHAR);
+     END LOOP;
+
+     IF END_OF_FILE THEN
+          FAILED ("INCORRECT VALUE BEFORE LAST CHARACTER");
+     END IF;
+
+     IF END_OF_FILE /= END_OF_FILE (FILE_IN) THEN
+          FAILED ("END_OF_FILE WITHOUT PARAMETER DOES " &
+                  "NOT OPERATE ON THE DEFAULT INPUT FILE");
+     END IF;
+
+     GET (ITEM_CHAR);
+
+     IF NOT (END_OF_FILE) THEN
+          FAILED ("INCORRECT VALUE AT LAST POSITION");
+     END IF;
+
+     BEGIN
+          DELETE (FILE_IN);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3408C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409a.ada
new file mode 100644
index 000000000..6dd5d1cc9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409a.ada
@@ -0,0 +1,111 @@
+-- CE3409A.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 SET_COL RAISES LAYOUT_ERROR IF THE LINE LENGTH IS
+--     BOUNDED AND THE GIVEN COLUMN POSITION EXCEEDS THE LINE LENGTH
+--     FOR FILES OF MODE OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/31/87  CORRECTD EXCEPTION HANDLING AND ADDED NEW CASES
+--                   FOR OBJECTIVE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3409A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE  : FILE_TYPE;
+     THREE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(3));
+     FOUR  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
+     FIVE  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(5));
+
+BEGIN
+
+     TEST ("CE3409A", "CHECK THAT SET_COL RAISES " &
+                      "LAYOUT_ERROR APPROPRIATELY");
+
+     BEGIN
+          CREATE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " &
+                               "TEMPORARY FILE WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_LINE_LENGTH (FILE, THREE);
+
+     BEGIN
+          SET_COL (FILE, FOUR);
+          FAILED ("LAYOUT_ERROR NOT RAISED ON SET_COL - 1");
+     EXCEPTION
+          WHEN LAYOUT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_COL - 1");
+     END;
+
+     IF COL (FILE) /= 1 THEN
+          FAILED ("COLUMN LENGTH NOT INITIALLY ONE");
+     END IF;
+
+     PUT (FILE, 'A');
+     PUT (FILE, 'B');
+     PUT (FILE, 'C');
+
+     SET_LINE_LENGTH (FILE, FOUR);
+
+     BEGIN
+          SET_COL (FILE, FIVE);
+          FAILED ("LAYOUT_ERROR NOT RAISED ON SET_COL - 2");
+     EXCEPTION
+          WHEN LAYOUT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_COL - 2");
+     END;
+
+     CLOSE (FILE);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3409A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409b.ada
new file mode 100644
index 000000000..1af3f07f5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409b.ada
@@ -0,0 +1,76 @@
+-- CE3409B.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 SET_COL RAISES CONSTRAINT_ERROR IF THE GIVEN
+--     COLUMN NUMBER IS ZERO, OR NEGATIVE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/22/82
+--     JBG 01/27/83
+--     JLH 08/31/87  CORRECTED EXCEPTION HANDLING, REMOVED UNNECESSARY
+--                   CODE, AND ADDED CASE FOR COUNT'LAST.
+--     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS.
+
+WITH REPORT ;
+USE REPORT ;
+WITH TEXT_IO ;
+USE TEXT_IO ;
+
+PROCEDURE CE3409B IS
+     FILE : FILE_TYPE;
+BEGIN
+
+     TEST ("CE3409B", "CHECK THAT SET_COL RAISES CONSTRAINT_ERROR " &
+                      "IF THE GIVEN COLUMN NUMBER IS ZERO, OR NEGATIVE.");
+
+     BEGIN
+          SET_COL (FILE, POSITIVE_COUNT(IDENT_INT(0)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN STATUS_ERROR =>
+               FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 1");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO");
+     END;
+
+     BEGIN
+          SET_COL (FILE, POSITIVE_COUNT(IDENT_INT(-2)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN STATUS_ERROR =>
+               FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 2");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR NEGATIVE " &
+                       "NUMBER");
+     END;
+
+     RESULT;
+
+END CE3409B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409c.ada
new file mode 100644
index 000000000..7085884a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409c.ada
@@ -0,0 +1,188 @@
+-- CE3409C.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 SET_COL SETS THE CURRENT COLUMN NUMBER TO THE VALUE
+--     SPECIFIED BY TO FOR FILES OF MODES IN_FILE AND OUT_FILE.
+--     CHECK THAT IT HAS NO EFFECT IF THE VALUE SPECIFIED BY TO IS
+--     EQUAL TO THE CURRENT COLUMN NUMBER FOR BOTH IN_FILE AND OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/20/82
+--     JBG 01/27/83
+--     SPS 02/18/83
+--     EG  05/22/85
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/31/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
+--                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3409C IS
+
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE3409C", "CHECK THAT SET_COL SETS THE CURRENT COLUMN " &
+                      "NUMBER TO THE VALUE SPECIFIED BY TO FOR FILES " &
+                      "OF MODES IN_FILE AND OUT_FILE.  CHECK THAT IT " &
+                      "HAS NO EFFECT IF THE VALUE SPECIFIED BY TO IS " &
+                      "EQUAL TO THE CURRENT COLUMN NUMBER FOR BOTH " &
+                      "IN_FILE AND OUT_FILE");
+
+     DECLARE
+          FILE : FILE_TYPE;
+          CHAR : CHARACTER := ('C');
+          ITEM_CHAR : CHARACTER;
+          ONE  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
+          TWO  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
+          FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
+     BEGIN
+
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_PAGE_LENGTH (FILE, TWO);
+          SET_COL (FILE, FOUR);
+          IF COL (FILE) /= FOUR THEN
+               FAILED ("FOR OUT_FILE COLUMN NOT FOUR");
+          ELSE
+               PUT (FILE, 'C');
+               SET_COL (FILE, 5);
+               IF COL (FILE) /= FOUR+1 OR LINE (FILE) /= ONE THEN
+                    FAILED ("FOR OUT_FILE COLUMN UNNECESSARILY " &
+                            "CHANGED FROM FOUR");
+               ELSE
+                    SET_COL (FILE, 8);
+                    PUT (FILE, "DE");
+                    SET_COL (FILE, TWO+1);
+                    IF COL (FILE) /= TWO+ONE OR LINE (FILE) /= TWO THEN
+                         FAILED ("FOR OUT_FILE COLUMN NOT TWO");
+                    END IF;
+                    PUT (FILE, 'B');
+                    SET_COL (FILE, TWO);
+
+                    IF PAGE (FILE) /= TWO THEN
+                         FAILED ("PAGE TERMINATOR NOT OUTPUT");
+                    END IF;
+
+                    IF LINE (FILE) /= ONE THEN
+                         FAILED ("LINE TERMINATOR NOT OUTPUT");
+                    END IF;
+
+                    IF COL (FILE) /= TWO THEN
+                         FAILED ("COL NOT TWO; IS" &
+                                 COUNT'IMAGE(COL(FILE)));
+                    END IF;
+
+                    PUT (FILE, 'X');
+               END IF;
+          END IF;
+
+          CHECK_FILE (FILE, "   C   DE#  B#@ X#@%");
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH MODE IN_FILE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_COL (FILE, FOUR);
+          IF COL (FILE) /= FOUR THEN
+               FAILED ("FOR IN_FILE COLUMN NOT FOUR");
+          ELSE
+               GET (FILE, ITEM_CHAR);
+               IF ITEM_CHAR /= 'C' THEN
+                    FAILED ("SET_COL FOR READ; ACTUALLY READ '" &
+                            ITEM_CHAR & "'");
+               END IF;
+
+               SET_COL (FILE, 5);
+               IF COL (FILE) /= FOUR+1 OR LINE (FILE) /= ONE THEN
+                    FAILED ("FOR IN_FILE COLUMN UNNECESSARILY " &
+                            "CHANGED FROM FOUR");
+               ELSE
+                    SET_COL (FILE, 9);
+                    GET (FILE, ITEM_CHAR);
+                    IF ITEM_CHAR /= 'E' THEN
+                         FAILED ("SET_COL FOR READ 2; ACTUALLY READ '" &
+                                 ITEM_CHAR & "'");
+                    END IF;
+
+                    SET_COL (FILE, 3);
+                    GET (FILE, ITEM_CHAR);
+                    IF ITEM_CHAR /= 'B' THEN
+                         FAILED ("SET_COL FOR READ 3; ACTUALLY READ '" &
+                                 ITEM_CHAR & "'");
+                    END IF;
+
+                    IF COL (FILE) /= 4 OR LINE (FILE) /= TWO THEN
+                         FAILED ("FOR IN_FILE COLUMN NOT TWO");
+                    END IF;
+               END IF;
+          END IF;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3409C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409d.ada
new file mode 100644
index 000000000..97ecd9b03
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409d.ada
@@ -0,0 +1,140 @@
+-- CE3409D.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, FOR FILES OF MODE IN_FILE, SET_COL READS UNTIL A
+--     LINE FOUND HAVING A CHARACTER AT THE SPECIFIED COLUMN, SKIPPING
+--     LINE AND PAGE TERMINATORS AS NECESSARY.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JBG 01/27/83
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/31/87  REMOVED DEPENDENCE ON REST, REMOVED UNNECESSARY
+--                   CODE, CHECKED FOR USE_ERROR ON DELETE, AND ADDED
+--                   NEW CASES FOR SET_COL.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3409D IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
+     ITEM_CHAR : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3409D", "CHECK THAT SET_COL SKIPS LINE AND PAGE " &
+                      "TERMINATORS WHEN NECESSARY");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "MODE OUT_FILE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH MODE OUT_FILE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     PUT (FILE, "ABC");
+     NEW_LINE (FILE);
+     PUT (FILE, "DEFGHI");
+     NEW_PAGE (FILE);
+     PUT (FILE, "XYZ");
+     NEW_PAGE (FILE);
+     PUT (FILE, "IJKL");
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "MODE IN_FILE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_COL (FILE, FOUR);
+     GET (FILE, ITEM_CHAR);
+
+     IF ITEM_CHAR = ' ' THEN
+          BEGIN
+               COMMENT ("FILE PADS LINES WITH SPACES");
+
+               SET_COL (FILE, FOUR);
+               GET (FILE, ITEM_CHAR);
+               IF ITEM_CHAR /= 'G' THEN
+                    FAILED ("INCORRECT VALUE FROM SET_COL - 1");
+               END IF;
+
+               SET_COL (FILE, FOUR);
+               GET (FILE, ITEM_CHAR);
+               IF ITEM_CHAR /= ' ' THEN
+                    FAILED ("LINES SHOULD STILL BE PADDED WITH BLANKS");
+               END IF;
+          END;
+
+     ELSIF ITEM_CHAR /= 'G' THEN
+          FAILED ("SET_COL DOESN'T SKIP LINE MARKS; " &
+                  "ACTUALLY READ '" & ITEM_CHAR & "'");
+     ELSE
+          BEGIN
+               SET_COL (FILE, FOUR);
+               GET (FILE, ITEM_CHAR);
+
+               IF ITEM_CHAR /= 'L' THEN
+                    FAILED ("SET_COL DOESN'T SKIP PAGE MARKS; " &
+                            "ACTUALLY READ '" & ITEM_CHAR & "'");
+               END IF;
+          END;
+     END IF;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3409D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409e.ada
new file mode 100644
index 000000000..28d072d7a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3409e.ada
@@ -0,0 +1,115 @@
+-- CE3409E.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 SET_COL RAISES END_ERROR IF NO LINE BEFORE THE END OF
+--     THE FILE IS LONG ENOUGH.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/20/82
+--     JBG 01/27/83
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/31/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
+--                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3409E IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     CHAR : CHARACTER := ('C');
+     ITEM_CHAR : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3409E", "CHECK THAT SET_COL RAISES END_ERROR " &
+                      "WHEN IT ATTEMPTS TO READ THE FILE TERMINATOR");
+
+-- CREATE & INITIALIZE FILE
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     PUT (FILE, "ABCD");
+     NEW_LINE (FILE);
+     PUT (FILE, "DEF");
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          SET_COL (FILE, 513);
+          FAILED ("END ERROR NOT RAISED ON SET_COL");
+     EXCEPTION
+          WHEN END_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_COL");
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3409E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410a.ada
new file mode 100644
index 000000000..a4e3870af
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410a.ada
@@ -0,0 +1,89 @@
+-- CE3410A.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 SET_LINE RAISES LAYOUT_ERROR IF THE PAGE LENGTH IS
+--     BOUNDED AND THE GIVEN LINE POSITION EXCEEDS THE PAGE LENGTH
+--     FOR FILES OF MODE OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/31/87  CORRECTED EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3410A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE  : FILE_TYPE;
+     THREE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(3));
+     FOUR  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
+
+BEGIN
+
+     TEST ("CE3410A", "CHECK THAT SET_LINE RAISES " &
+                      "LAYOUT_ERROR APPROPRIATELY");
+
+     BEGIN
+          CREATE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE FOR " &
+                               "TEMPORARY FILE WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_PAGE_LENGTH (FILE, THREE);
+
+     BEGIN
+          SET_LINE (FILE, FOUR);
+          FAILED ("LAYOUT ERROR NOT RAISED FOR SET_LINE");
+     EXCEPTION
+          WHEN LAYOUT_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR SET_LINE");
+     END;
+
+     CLOSE (FILE);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3410A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410b.ada
new file mode 100644
index 000000000..08f185fc8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410b.ada
@@ -0,0 +1,77 @@
+-- CE3410B.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 SET_LINE RAISES CONSTRAINT_ERROR IF THE GIVEN
+--     LINE NUMBER IS ZERO, OR NEGATIVE.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/22/82
+--     JBG 01/27/83
+--     JLH 08/31/87  ADDED CASE FOR COUNT'LAST.
+--     PWN 10/27/95  REMOVED OUT OF RANGE STATIC VALUE CHECKS
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3410B IS
+
+     FILE : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3410B", "CHECK THAT SET_LINE RAISES CONSTRAINT_ERROR " &
+                      "IF THE GIVEN LINE NUMBER IS ZERO, OR NEGATIVE");
+
+     BEGIN
+          SET_LINE (FILE, POSITIVE_COUNT(IDENT_INT(0)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ZERO");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN STATUS_ERROR =>
+               FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 1");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR ZERO");
+     END;
+
+     BEGIN
+          SET_LINE (FILE, POSITIVE_COUNT(IDENT_INT(-2)));
+          FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE NUMBER");
+     EXCEPTION
+          WHEN CONSTRAINT_ERROR =>
+               NULL;
+          WHEN STATUS_ERROR =>
+               FAILED ("STATUS_ERROR INSTEAD OF CONSTRAINT_ERROR - 2");
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED FOR NEGATIVE " &
+                       "NUMBER");
+     END;
+
+     RESULT;
+
+END CE3410B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada
new file mode 100644
index 000000000..dc004895d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada
@@ -0,0 +1,205 @@
+-- CE3410C.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 SET_LINE SETS THE CURRENT LINE NUMBER TO THE VALUE
+--     SPECIFIED BY TO FOR FILES OF MODES IN_FILE AND OUT_FILE.
+--     CHECK THAT IT HAS NO EFFECT IF THE VALUE SPECIFIED BY TO IS
+--     EQUAL TO THE CURRENT LINE NUMBER FOR BOTH IN_FILE AND OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/20/82
+--     JBG 01/27/83
+--     EG  05/22/85
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/01/87  REMOVED DEPENDENCE ON RESET, ADDED MORE TEST
+--                   CASES, AND CHECKED FOR USE_ERROR ON DELETE.
+--     JRL 02/29/96  Added File parameter to call to Set_Page_Length.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3410C IS
+
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE3410C", "CHECK THAT SET_LINE SETS LINE " &
+                      "NUMBER CORRECTLY");
+
+     DECLARE
+          FILE : FILE_TYPE;
+          CHAR : CHARACTER := ('C');
+          ITEM_CHAR : CHARACTER;
+          ONE   : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
+          TWO   : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
+          THREE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(3));
+          FOUR  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
+     BEGIN
+
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_LINE (FILE, FOUR);
+          IF LINE (FILE) /= FOUR THEN
+               FAILED ("FOR OUT_FILE LINE NOT FOUR");
+          ELSE
+               PUT (FILE, 'C');
+               NEW_LINE (FILE);
+               SET_LINE (FILE, 5);
+               IF LINE (FILE) /= FOUR+1 THEN
+                    FAILED ("FOR OUT_FILE LINE UNNECESSARILY " &
+                            "CHANGED FROM FOUR");
+               ELSE
+                    SET_LINE (FILE, 8);
+                    PUT (FILE, "DE");
+                    SET_LINE (FILE, TWO+1);
+                    IF LINE (FILE) /= TWO+ONE THEN
+                         FAILED ("FOR OUT_FILE LINE NOT THREE");
+                    END IF;
+
+                    SET_LINE (FILE, TWO);
+
+                    IF PAGE (FILE) /= ONE+TWO THEN
+                         FAILED ("PAGE TERMINATOR NOT OUTPUT - 2");
+                    END IF;
+
+                    IF LINE (FILE) /= TWO THEN
+                         FAILED ("LINE NOT TWO; IS" &
+                                 COUNT'IMAGE(LINE(FILE)));
+                    END IF;
+
+                    SET_PAGE_LENGTH (FILE, TWO);
+                    PUT (FILE, 'X');
+                    SET_LINE (FILE, TWO);
+                    PUT (FILE, 'Y');
+
+                    IF LINE (FILE) /= TWO THEN
+                         FAILED ("LINE NOT TWO; IS " &
+                                 COUNT'IMAGE(LINE(FILE)));
+                    END IF;
+
+                    IF PAGE (FILE) /= THREE THEN
+                         FAILED ("PAGE NOT THREE; IS " &
+                                 COUNT'IMAGE(PAGE(FILE)));
+                    END IF;
+
+               END IF;
+          END IF;
+
+          CHECK_FILE (FILE, "###C####DE#@##@#XY#@%");
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED FOR TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_LINE (FILE, FOUR);
+          IF LINE (FILE) /= FOUR THEN
+               FAILED ("FOR IN_FILE LINE NOT FOUR");
+          ELSE
+               GET (FILE, ITEM_CHAR);
+               IF ITEM_CHAR /= 'C' THEN
+                    FAILED ("SET_LINE FOR READ; ACTUALLY READ '" &
+                            ITEM_CHAR & "'");
+               END IF;
+
+               SKIP_LINE (FILE);
+               SET_LINE (FILE, 5);
+               IF LINE (FILE) /= FOUR+1 OR PAGE (FILE) /= ONE THEN
+                    FAILED ("INCORRECT LINE OR PAGE");
+               ELSE
+                    SET_LINE (FILE, 8);
+                    GET (FILE, ITEM_CHAR);
+                    IF ITEM_CHAR /= 'D' THEN
+                         FAILED ("SET_LINE FOR READ 2; ACTUALLY READ '"&
+                                 ITEM_CHAR & "'");
+                    END IF;
+
+                    SET_LINE (FILE, TWO);
+                    IF PAGE (FILE) /= TWO THEN
+                         FAILED ("FOR IN_FILE PAGE NOT TWO");
+                    END IF;
+
+                    SET_LINE (FILE, TWO);
+                    IF PAGE (FILE) /= TWO OR LINE (FILE) /= TWO THEN
+                         FAILED ("FOR IN_FILE PAGE NOT 2");
+                    END IF;
+
+                    SKIP_LINE (FILE);
+                    SET_LINE (FILE, TWO);
+
+                    GET (FILE, ITEM_CHAR);
+
+                    IF ITEM_CHAR /= 'X' THEN
+                         FAILED ("SET_LINE FOR READ 3; ACTUALLY READ '"&
+                                 ITEM_CHAR & "'");
+                    END IF;
+
+               END IF;
+          END IF;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3410C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410d.ada
new file mode 100644
index 000000000..09fa09ebc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410d.ada
@@ -0,0 +1,118 @@
+-- CE3410D.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, FOR FILES OF MODE IN_FILE, SET_LINE READS UNTIL A
+--     PAGE IS FOUND HAVING A LINE AT THE SPECIFIED POSITION, SKIPPING
+--     LINE AND PAGE TERMINATORS AS NECESSARY.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JBG 01/27/83
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/01/87  REMOVED DEPENDENCE ON RESET AND CHECKED FOR
+--                   USE_ERROR ON DELETE.
+--     GJD 11/15/95  FIXED ADA 95 INCOMPATIBLE USE OF CHARACTER LITERALS.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3410D IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     FOUR : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
+     ITEM_CHAR : CHARACTER;
+
+BEGIN
+
+     TEST ("CE3410D", "CHECK THAT SET_LINE SKIPS PAGE " &
+                      "TERMINATORS WHEN NECESSARY");
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "MODE OUT_FILE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH MODE OUT_FILE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     FOR I IN CHARACTER RANGE 'A'..'C' LOOP
+          PUT (FILE, I);
+          NEW_LINE (FILE);
+     END LOOP;
+
+     NEW_PAGE (FILE);
+
+     FOR I IN CHARACTER RANGE 'D'..'H'   -- 5 LINES
+     LOOP
+          PUT (FILE, I);
+          NEW_LINE (FILE);
+     END LOOP;
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_LINE (FILE, FOUR);
+     GET (FILE, ITEM_CHAR);
+
+     IF ITEM_CHAR /= 'G' THEN
+          FAILED ("SET_LINE DOESN'T SKIP PAGE MARKS; " &
+                  "ACTUALLY READ '" & ITEM_CHAR & "'");
+     END IF;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+                    NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3410D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410e.ada
new file mode 100644
index 000000000..f86608bf5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3410e.ada
@@ -0,0 +1,125 @@
+-- CE3410E.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 SET_LINE RAISES END_ERROR IF NO PAGE BEFORE THE END
+--     OF THE FILE IS LONG ENOUGH.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/20/82
+--     JBG 01/27/83
+--     JBG 08/30/83
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/02/87  REMOVED DEPENDENCE ON RESET, ADDED NEW CASES FOR
+--                   OBJECTIVE, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3410E IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE : FILE_TYPE;
+     CHAR : CHARACTER := ('C');
+     ITEM_CHAR : CHARACTER;
+     FIVE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(5));
+
+BEGIN
+
+     TEST ("CE3410E", "CHECK THAT SET_LINE RAISES END_ERROR " &
+                      "WHEN IT ATTEMPTS TO READ THE FILE TERMINATOR");
+
+-- CREATE & INITIALIZE FILE
+
+     BEGIN
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "MODE OUT_FILE");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH MODE OUT_FILE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     PUT (FILE, "ABCD");
+     NEW_LINE (FILE);
+     PUT (FILE, "DEF");
+     NEW_LINE (FILE, 3);
+     NEW_PAGE (FILE);
+     PUT_LINE (FILE, "HELLO");
+     NEW_PAGE (FILE);
+     PUT_LINE (FILE, "GH");
+     PUT_LINE (FILE, "IJK");
+     PUT_LINE (FILE, "HI");
+     PUT_LINE (FILE, "TESTING");
+
+     CLOSE (FILE);
+
+     BEGIN
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "MODE IN_FILE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          SET_LINE (FILE,FIVE);
+          FAILED ("END ERROR NOT RAISED ON SET_LINE");
+     EXCEPTION
+          WHEN END_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON SET_LINE");
+     END;
+
+     BEGIN
+          DELETE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3410E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3411a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3411a.ada
new file mode 100644
index 000000000..1b81316d1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3411a.ada
@@ -0,0 +1,164 @@
+-- CE3411A.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 COL RETURNS THE VALUE OF THE CURRENT COLUMN NUMBER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/29/82
+--     JBG 08/30/83
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/02/87  REMOVED DEPENDENCE ON RESET AND CHECKED FOR
+--                   USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3411A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3411A", "CHECK THAT COL RETURNS THE VALUE OF THE " &
+                      "CURRENT COLUMN NUMBER");
+
+     DECLARE
+          FT        : FILE_TYPE;
+          X         : CHARACTER;
+          NUM_CHARS : POSITIVE_COUNT;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "OUTPUT STRING");
+          IF COL (FT) /= 14 THEN
+               FAILED ("COL INCORRECT AFTER PUT; IS" &
+                       COUNT'IMAGE(COL(FT)));
+          END IF;
+
+          NEW_LINE (FT);
+          IF COL (FT) /= 1 THEN
+               FAILED ("COL INCORRECT AFTER NEW_LINE; IS" &
+                       COUNT'IMAGE(COL(FT)));
+          END IF;
+
+          PUT (FT, "MORE OUTPUT");
+          NEW_PAGE (FT);
+          IF COL (FT) /= 1 THEN
+               FAILED ("COL INCORRECT AFTER NEW_PAGE; IS" &
+                       COUNT'IMAGE(COL(FT)));
+          END IF;
+
+          PUT (FT, "FINAL");
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF COL (FT) /= 1 THEN
+               FAILED ("COL INCORRECT AFTER REOPEN; IS" &
+                       COUNT'IMAGE(COL(FT)));
+          END IF;
+
+          FOR I IN 1 .. 4 LOOP
+               GET (FT, X);
+          END LOOP;
+          IF COL (FT) /= 5 THEN
+               FAILED ("COL INCORRECT AFTER GET; IS" &
+                       COUNT'IMAGE(COL(FT)));
+          END IF;
+
+          NUM_CHARS := COL(FT);
+          WHILE NOT END_OF_LINE(FT) LOOP
+               GET (FT, X);
+               NUM_CHARS := NUM_CHARS + 1;
+          END LOOP;
+
+          IF COL(FT) /= NUM_CHARS THEN
+               FAILED ("COL INCORRECT BEFORE END OF LINE; IS" &
+                       COUNT'IMAGE(COL(FT)));
+          END IF;
+
+          SKIP_LINE (FT);
+          IF COL(FT) /= 1 THEN
+               FAILED ("COL INCORRECT AFTER SKIP_LINE; IS" &
+                       COUNT'IMAGE(COL(FT)));
+          END IF;
+
+          SET_COL (FT, 2);
+          IF COL (FT) /= 2 THEN
+               FAILED ("COL INCORRECT AFTER SET_COL; IS" &
+                       COUNT'IMAGE(COL(FT)));
+          END IF;
+
+          SKIP_PAGE (FT);
+          IF COL(FT) /= 1 THEN
+               FAILED ("COL INCORRECT AFTER SKIP_PAGE; IS" &
+                       COUNT'IMAGE(COL(FT)));
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+END CE3411A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3411c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3411c.ada
new file mode 100644
index 000000000..fd95831c6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3411c.ada
@@ -0,0 +1,146 @@
+-- CE3411C.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 COL OPERATES ON THE CURRENT DEFAULT OUTPUT FILE WHEN
+--     NO FILE IS SPECIFIED.  CHECK THAT COL CAN OPERATE ON FILES OF
+--     MODES IN_FILE AND OUT_FILE, INCLUDING THE CURRENT DEFAULT
+--     INPUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/29/82
+--     JBG 01/31/83
+--     JBG 08/30/83
+--     JLH 09/02/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
+--                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3411C IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3411C", "CHECK THAT COL OPERATES ON DEFAULT IN_FILE AND "&
+                      "OUT_FILE FILES");
+
+     DECLARE
+          F1, F2 : FILE_TYPE;
+          C : POSITIVE_COUNT;
+          X : CHARACTER;
+     BEGIN
+          IF COL /= COL (STANDARD_OUTPUT) THEN
+               FAILED ("COL DEFAULT NOT STANDARD_OUTPUT");
+          END IF;
+
+          IF COL /= COL (STANDARD_INPUT) THEN
+               FAILED ("COL DEFAULT NOT STANDARD_INPUT");
+          END IF;
+
+          IF COL /= COL (CURRENT_INPUT) THEN
+               FAILED ("COL DEFAULT NOT CURRENT_INPUT");
+          END IF;
+
+          IF COL /= COL (CURRENT_OUTPUT) THEN
+               FAILED ("COL DEFAULT NOT CURRENT_OUTPUT");
+          END IF;
+
+          BEGIN
+               CREATE (F1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (F2, OUT_FILE);
+
+          SET_OUTPUT (F2);
+
+          PUT (F1, "STRING");
+          IF COL (F1) /= 7 THEN
+               FAILED ("COL INCORRECT SUBTEST 1");
+          END IF;
+
+          PUT (F2, "OUTPUT STRING");
+          IF COL /= COL(F2) AND COL(F2) /= 14 THEN
+               FAILED ("COL INCORRECT SUBTEST 2; WAS " &
+                       COUNT'IMAGE(COL) & " VS. " &
+                       COUNT'IMAGE(COL(F2)));
+          END IF;
+
+          CLOSE (F1);
+
+          BEGIN
+               OPEN (F1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_INPUT (F1);
+
+          GET (F1, X);
+          GET (F1, X);
+          GET (F1, X);
+
+          IF X /= 'R' THEN
+               FAILED ("INCORRECT VALUE READ");
+          END IF;
+
+          IF COL (CURRENT_INPUT) /= 4 AND COL /= 4 THEN
+               FAILED ("COL INCORRECT SUBTEST 3");
+          END IF;
+
+          BEGIN
+               DELETE (F1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          CLOSE (F2);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3411C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3412a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3412a.ada
new file mode 100644
index 000000000..56b6744a4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3412a.ada
@@ -0,0 +1,149 @@
+-- CE3412A.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 LINE RETURNS THE VALUE OF THE CURRENT LINE NUMBER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/29/82
+--     JBG 08/30/83
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/02/87  REMOVED DEPENDENCE ON RESET AND CHECKED FOR
+--                   USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3412A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3412A", "CHECK LINE RETURNS LINE NUMBER");
+
+     DECLARE
+          FT : FILE_TYPE;
+          X : CHARACTER;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF LINE (FT) /= 1 THEN
+               FAILED ("CURRENT LINE NUMBER NOT INITIALLY ONE");
+          END IF;
+
+          FOR I IN 1 .. 3 LOOP
+               PUT (FT, "OUTPUT STRING");
+               NEW_LINE (FT);
+          END LOOP;
+          IF LINE (FT) /= 4 THEN
+               FAILED ("LINE INCORRECT AFTER PUT; IS" &
+                       COUNT'IMAGE(LINE(FT)));
+          END IF;
+
+          NEW_PAGE (FT);
+          IF LINE (FT) /= 1 THEN
+               FAILED ("LINE INCORRECT AFTER NEW_PAGE; IS" &
+                       COUNT'IMAGE(LINE(FT)));
+          END IF;
+
+          FOR I IN 1 .. 5 LOOP
+               PUT (FT, "MORE OUTPUT");
+               NEW_LINE(FT);
+          END LOOP;
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF LINE (FT) /= 1 THEN
+               FAILED ("LINE INCORRECT AFTER RESET; IS" &
+                       COUNT'IMAGE(LINE(FT)));
+          END IF;
+
+          FOR I IN 1 .. 2 LOOP
+               SKIP_LINE (FT);
+          END LOOP;
+          IF LINE (FT) /= 3 THEN
+               FAILED ("LINE INCORRECT AFTER SKIP_LINE; IS" &
+                       COUNT'IMAGE(LINE(FT)));
+          END IF;
+
+          SET_LINE (FT, 2);
+          IF LINE (FT) /= 2 THEN
+               FAILED ("LINE INCORRECT AFTER SET_LINE; IS" &
+                       COUNT'IMAGE(LINE(FT)));
+          END IF;
+
+          SKIP_PAGE (FT);
+          IF LINE (FT) /= 1 THEN
+               FAILED ("LINE INCORRECT AFTER SKIP_PAGE; IS" &
+                       COUNT'IMAGE(LINE(FT)));
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3412A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3413a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3413a.ada
new file mode 100644
index 000000000..079da5edd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3413a.ada
@@ -0,0 +1,128 @@
+-- CE3413A.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 PAGE RETURNS THE VALUE OF THE CURRENT PAGE NUMBER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/29/82
+--     JBG 08/30/83
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/04/87  REMOVED DEPENDENCE ON RESET AND CHECKED FOR
+--                   USE_ERROR ON DELETE.
+
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3413A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3413A", "CHECK THAT PAGE RETURNS THE CORRECT PAGE " &
+                      "NUMBER");
+
+     DECLARE
+          FT : FILE_TYPE;
+          X : CHARACTER;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "TEXT CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF PAGE (FT) /= 1 THEN
+               FAILED ("CURRENT PAGE NOT INITIALLY ONE");
+          END IF;
+
+          FOR I IN 1 .. 6 LOOP
+               PUT (FT, "OUTPUT STRING");
+               NEW_PAGE (FT);
+          END LOOP;
+          IF PAGE (FT) /= 7 THEN
+               FAILED ("PAGE INCORRECT AFTER PUT; IS" &
+                       COUNT'IMAGE(PAGE(FT)));
+          END IF;
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF PAGE (FT) /= 1 THEN
+               FAILED ("PAGE INCORRECT AFTER OPEN IS" &
+                       COUNT'IMAGE(PAGE(FT)));
+          END IF;
+
+          FOR I IN 1 .. 4 LOOP
+               SKIP_PAGE (FT);
+          END LOOP;
+          IF PAGE (FT) /= 5 THEN
+               FAILED ("PAGE INCORRECT AFTER SKIP_PAGE; IS" &
+                       COUNT'IMAGE(PAGE(FT)));
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3413A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3413b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3413b.ada
new file mode 100644
index 000000000..cb273caa3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3413b.ada
@@ -0,0 +1,163 @@
+-- CE3413B.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 PAGE RAISES LAYOUT_ERROR WHEN THE VALUE OF THE
+--     PAGE NUMBER EXCEEDS COUNT'LAST.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- HISTORY:
+--     JLH 07/27/88  CREATED ORIGINAL TEST.
+--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+
+PROCEDURE CE3413B IS
+
+     FILE : FILE_TYPE;
+     INCOMPLETE, INAPPLICABLE : EXCEPTION;
+     ITEM : STRING(1..3) := "ABC";
+     LST : NATURAL;
+
+BEGIN
+
+     TEST ("CE3413B", "CHECK THAT PAGE RAISES LAYOUT_ERROR WHEN THE " &
+                      "VALUE OF THE PAGE NUMBER EXCEEDS COUNT'LAST");
+
+     BEGIN
+
+          IF COUNT'LAST > 150000 THEN
+               RAISE INAPPLICABLE;
+          END IF;
+
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          FOR I IN 1 .. COUNT'LAST-1 LOOP
+               NEW_PAGE (FILE);
+          END LOOP;
+
+          PUT (FILE, ITEM);
+
+          NEW_PAGE (FILE);
+          PUT (FILE, "DEF");
+
+          BEGIN
+               IF PAGE(FILE) <= POSITIVE_COUNT(COUNT'LAST) THEN
+                    FAILED ("PAGE NUMBER INCORRECT AFTER PAGE SET - 1");
+               END IF;
+               FAILED ("LAYOUT_ERROR NOT RAISED FOR PAGE - 1");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT_ERROR RAISED FOR PAGE - 1");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED FOR PAGE - 1");
+          END;
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          FOR I IN 1 .. COUNT'LAST-1 LOOP
+               SKIP_PAGE (FILE);
+          END LOOP;
+
+          IF PAGE(FILE) /= COUNT'LAST THEN
+               FAILED ("INCORRECT PAGE NUMBER");
+          END IF;
+
+          GET_LINE (FILE, ITEM, LST);
+          IF ITEM /= "ABC" THEN
+               FAILED ("INCORRECT VALUE READ");
+          END IF;
+
+          SKIP_PAGE (FILE);
+
+          BEGIN
+               IF PAGE(FILE) <= POSITIVE_COUNT(COUNT'LAST) THEN
+                    FAILED ("PAGE NUMBER INCORRECT AFTER PAGE SET - 2");
+               END IF;
+               FAILED ("LAYOUT_ERROR NOT RAISED FOR PAGE - 2");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT_ERROR RAISED FOR PAGE - 2");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED FOR PAGE - 2");
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+          WHEN INAPPLICABLE =>
+               NOT_APPLICABLE ("THE VALUE OF COUNT'LAST IS GREATER " &
+                               "THAN 150000.  THE CHECKING OF THIS " &
+                               "OBJECTIVE IS IMPRACTICAL");
+
+     END;
+
+     RESULT;
+
+END CE3413B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3413c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3413c.ada
new file mode 100644
index 000000000..dca4c2ba6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3413c.ada
@@ -0,0 +1,152 @@
+-- CE3413C.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 PAGE OPERATES ON THE CURRENT DEFAULT OUTPUT FILE WHEN
+--     NO FILE IS SPECIFIED.  CHECK THAT PAGE CAN OPERATE ON FILES OF
+--     MODES IN_FILE AND OUT_FILE, INCLUDING THE CURRENT DEFAULT
+--     INPUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/29/82
+--     JBG 08/30/83
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/04/87  REMOVED DEPENDENCE ON RESET, CORRECTED EXCEPTION
+--                   HANDLING, AND CHECKED FOR USE_ERROR ON DELETE.
+
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3413C IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3413C", "CHECK THAT PAGE OPERATES ON DEFAULT IN_FILE " &
+                      "AND OUT_FILE FILES");
+
+     DECLARE
+          F1, F2 : FILE_TYPE;
+          C : POSITIVE_COUNT;
+          X : CHARACTER;
+     BEGIN
+
+          BEGIN
+               CREATE (F1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "TEXT CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               CREATE (F2, OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "FOR TEMPORARY FILES WITH " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_OUTPUT (F2);
+
+          IF PAGE (F2) /= 1 AND PAGE (STANDARD_OUTPUT) /= 1 THEN
+               FAILED ("PAGE INCORRECT SUBTEST - 1");
+          END IF;
+
+          FOR I IN 1 .. 3 LOOP
+               PUT (F1, "STRING");
+               NEW_PAGE (F1);
+          END LOOP;
+
+          IF PAGE (F1) /= 4 THEN
+               FAILED ("PAGE INCORRECT SUBTEST - 2");
+          END IF;
+
+          SET_LINE_LENGTH (F2, 3);
+          SET_PAGE_LENGTH (F2, 1);
+          PUT ("OUTPUT STRING");
+          IF PAGE /= PAGE(F2) THEN
+               FAILED ("PAGE INCORRECT SUBTEST - 3");
+          END IF;
+
+          CLOSE (F1);
+
+          BEGIN
+               OPEN (F1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_INPUT (F1);
+
+          IF PAGE (F1) /= 1 THEN
+               FAILED ("PAGE INCORRECT SUBTEST - 4");
+          END IF;
+
+          SKIP_PAGE(F1);
+          SKIP_PAGE(F1);
+          IF PAGE (F1) /= PAGE (CURRENT_INPUT) THEN
+               FAILED ("PAGE INCORRECT SUBTEST - 5");
+          END IF;
+
+          BEGIN
+               DELETE (F1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          CLOSE (F2);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3413C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3414a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3414a.ada
new file mode 100644
index 000000000..8f236ca2f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3414a.ada
@@ -0,0 +1,204 @@
+-- CE3414A.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 STATUS_ERROR IS RAISED WHEN NEW_LINE, SKIP_LINE,
+--     END_OF_LINE, NEW_PAGE, SKIP_PAGE, END_OF_PAGE, END_OF_FILE,
+--     SET_COL, SET_LINE, COL, LINE, AND PAGE ARE CALLED AND THE FILE
+--     IS NOT OPEN.
+
+-- HISTORY:
+--     BCB 10/27/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3414A IS
+
+     FILE : FILE_TYPE;
+
+     INCOMPLETE : EXCEPTION;
+
+     X : POSITIVE_COUNT;
+
+BEGIN
+     TEST ("CE3414A", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
+                      "NEW_LINE, SKIP_LINE, END_OF_LINE, NEW_PAGE, " &
+                      "SKIP_PAGE, END_OF_PAGE, END_OF_FILE, SET_COL, " &
+                      "SET_LINE, COL, LINE, AND PAGE ARE CALLED AND " &
+                      "THE FILE IS NOT OPEN");
+
+     BEGIN
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE, 'A');
+
+          CLOSE (FILE);
+
+          BEGIN
+               NEW_LINE (FILE);
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               SKIP_LINE (FILE);
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               IF NOT END_OF_LINE (FILE) THEN
+                    NULL;
+               END IF;
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 3");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 3");
+          END;
+
+          BEGIN
+               NEW_PAGE (FILE);
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 4");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 4");
+          END;
+
+          BEGIN
+               SKIP_PAGE (FILE);
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 5");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 5");
+          END;
+
+          BEGIN
+               IF NOT END_OF_PAGE (FILE) THEN
+                    NULL;
+               END IF;
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 6");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 6");
+          END;
+
+          BEGIN
+               IF NOT END_OF_FILE (FILE) THEN
+                    NULL;
+               END IF;
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 7");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 7");
+          END;
+
+          BEGIN
+               SET_COL (FILE, 2);
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 8");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 8");
+          END;
+
+          BEGIN
+               SET_LINE (FILE, 2);
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 9");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 9");
+          END;
+
+          BEGIN
+               X := COL (FILE);
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 10");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 10");
+          END;
+
+          BEGIN
+               X := LINE (FILE);
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 11");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 11");
+          END;
+
+          BEGIN
+               X := PAGE (FILE);
+               FAILED ("STATUS_ERROR WAS NOT RAISED - 12");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 12");
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+END CE3414A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3601a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3601a.ada
new file mode 100644
index 000000000..c5b63fd61
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3601a.ada
@@ -0,0 +1,187 @@
+-- CE3601A.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 GET (FOR STRINGS AND CHARACTERS), PUT (FOR STRINGS AND
+--     CHARACTERS), GET_LINE, AND PUT_LINE RAISE STATUS_ERROR WHEN
+--     CALLED WITH AN UNOPEN FILE PARAMETER.  ALSO CHECK NAMES OF FORMAL
+--     PARAMETERS.
+
+-- HISTORY:
+--     SPS 08/27/82
+--     VKG 02/15/83
+--     JBG 03/30/83
+--     JLH 09/04/87  ADDED CASE WHICH ATTEMPTS TO CREATE FILE AND THEN
+--                   RETESTED OBJECTIVE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3601A IS
+
+BEGIN
+
+     TEST ("CE3601A", "STATUS_ERROR RAISED BY GET, PUT, GET_LINE, " &
+                      "PUT_LINE WHEN FILE IS NOT OPEN");
+
+     DECLARE
+          FILE1, FILE2 : FILE_TYPE;
+          CH: CHARACTER := '%';
+          LST: NATURAL;
+          ST: STRING (1 .. 10);
+          LN : STRING (1 .. 80);
+     BEGIN
+          BEGIN
+               GET (FILE => FILE1, ITEM => CH);
+               FAILED ("STATUS_ERROR NOT RAISED - GET CHARACTER");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET CHARACTER");
+          END;
+
+          BEGIN
+               GET (FILE => FILE1, ITEM => ST);
+               FAILED ("STATUS_ERROR NOT RAISED - GET STRING");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET STRING");
+          END;
+
+          BEGIN
+               GET_LINE (FILE => FILE1, ITEM => LN, LAST => LST);
+               FAILED ("STATUS_ERROR NOT RAISED - GET_LINE");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET_LINE");
+          END;
+
+          BEGIN
+               PUT (FILE => FILE1, ITEM => CH);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT CHARACTER");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT CHARACTER");
+          END;
+
+          BEGIN
+               PUT (FILE => FILE1, ITEM => ST);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT STRING");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT STRING");
+          END;
+
+          BEGIN
+               PUT_LINE (FILE => FILE1, ITEM => LN);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT_LINE");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT_LINE");
+          END;
+
+          BEGIN
+               CREATE (FILE2, OUT_FILE);   -- THIS IS ONLY AN ATTEMPT TO
+               CLOSE (FILE2);              -- CREATE A FILE. OK, WHETHER
+          EXCEPTION                        -- SUCCESSFUL OR NOT.
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          BEGIN
+               GET (FILE => FILE2, ITEM => CH);
+               FAILED ("STATUS_ERROR NOT RAISED - GET CHARACTER");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET CHARACTER");
+          END;
+
+          BEGIN
+               GET (FILE => FILE2, ITEM => ST);
+               FAILED ("STATUS_ERROR NOT RAISED - GET STRING");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET STRING");
+          END;
+
+          BEGIN
+               GET_LINE (FILE => FILE2, ITEM => LN, LAST => LST);
+               FAILED ("STATUS_ERROR NOT RAISED - GET_LINE");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET_LINE");
+          END;
+
+          BEGIN
+               PUT (FILE => FILE2, ITEM => CH);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT CHARACTER");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT CHARACTER");
+          END;
+
+          BEGIN
+               PUT (FILE => FILE2, ITEM => ST);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT STRING");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT STRING");
+          END;
+
+          BEGIN
+               PUT_LINE (FILE => FILE2, ITEM => LN);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT_LINE");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT_LINE");
+          END;
+
+     END;
+
+     RESULT;
+
+END CE3601A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602a.ada
new file mode 100644
index 000000000..ff0280303
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602a.ada
@@ -0,0 +1,189 @@
+-- CE3602A.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 GET FOR CHARACTERS AND STRINGS ALLOW A STRING TO SPAN
+--     OVER MORE THAN ONE LINE, SKIPPING INTERVENING LINE AND PAGE
+--     TERMINATORS.  ALSO CHECK THAT GET ACCEPTS A NULL STRING ACTUAL
+--     PARAMETER AND A STRING SLICE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 08/30/82
+--     VKG 01/26/83
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/04/87  REMOVED DEPENDENCE ON RESET, CORRECTED EXCEPTION
+--                   HANDLING, AND ADDED NEW CASES FOR OBJECTIVE.
+
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3602A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3602A", "CHECK THAT GET FOR CHARACTERS AND STRINGS " &
+                      "ALLOWS A STRING TO SPAN OVER MORE THAN ONE " &
+                      "LINE, SKIPPING INTERVENING LINE AND PAGE " &
+                      "TERMINATORS.  ALSO CHECK THAT GET ACCEPTS " &
+                      "A NULL STRING ACTUAL PARAMETER AND A STRING " &
+                      "SLICE");
+
+     DECLARE
+          FILE1 : FILE_TYPE;
+          ST : STRING (1 .. 40);
+          STR: STRING (1 .. 100);
+          NST: STRING (1 .. 0);
+          ORIGINAL_LINE_LENGTH : COUNT;
+
+-- READ_CHARS RETURNS A STRING OF N CHARACTERS FROM A GIVEN FILE.
+
+          FUNCTION READ_CHARS (FILE : FILE_TYPE;
+                               N    : NATURAL )
+                               RETURN STRING IS
+          C: CHARACTER;
+          BEGIN
+               IF N = 0 THEN RETURN "";
+               ELSE
+                    GET (FILE,C);
+                    RETURN C&READ_CHARS (FILE,N-1);
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("ERROR ON READ_CHARS");
+          END READ_CHARS;
+
+
+     BEGIN
+
+-- CREATE AND INITIALIZE TEST DATA FILE
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "TEXT CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          ORIGINAL_LINE_LENGTH := LINE_LENGTH;
+
+-- LINE_LENGTH SET IN CASE IMPLEMENTATION REQUIRES BOUNDED LENGTH LINES
+
+          SET_LINE_LENGTH (16);
+          PUT (FILE1, "THIS LINE SHALL ");
+          SET_LINE_LENGTH (10);
+          PUT (FILE1, "SPAN OVER ");
+          SET_LINE_LENGTH (14);
+          PUT (FILE1, "SEVERAL LINES.");
+          CLOSE (FILE1);
+          SET_LINE_LENGTH (ORIGINAL_LINE_LENGTH);
+
+
+-- BEGIN TEST
+
+          BEGIN
+
+               BEGIN
+                    OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
+                                         "OPEN WITH IN_FILE MODE - 1");
+                         RAISE INCOMPLETE;
+               END;
+
+               STR(1..40) := READ_CHARS (FILE1, 40);
+               CLOSE (FILE1);
+
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+
+               GET (FILE1, ST);
+               IF STR(1..40) /= ST THEN
+                    FAILED ("GET FOR STRING INCORRECT");
+               END IF;
+
+               IF STR(1..40) /= "THIS LINE SHALL SPAN OVER SEVERAL " &
+                                "LINES." THEN
+                    FAILED ("INCORRECT VALUE READ");
+               END IF;
+
+-- GET NULL STRING
+
+               CLOSE (FILE1);
+
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+
+               BEGIN
+                    GET (FILE1, NST);
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED (" GET FAILED ON NULL STRING");
+               END;
+
+-- GET NULL SLICE
+
+               BEGIN
+                    GET (FILE1, STR (10 .. 1));
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("GET FAILED ON A NULL SLICE");
+               END;
+
+               BEGIN
+                    DELETE (FILE1);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3602A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602b.ada
new file mode 100644
index 000000000..71482425a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602b.ada
@@ -0,0 +1,215 @@
+-- CE3602B.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 GET (FOR CHARACTER AND STRINGS) PROPERLY SETS THE
+--     PAGE, LINE, AND COLUMN NUMBERS AFTER EACH OPERATION.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 08/30/82
+--     SPS 12/17/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/04/87  REMOVED DEPENDENCE ON UNBOUNDED LINE LENGTH AND
+--                   CORRECTED EXCEPTION HANDLING.
+--     BCB 11/13/87  GAVE SET_LINE_LENGTH PROCEDURE THE FILE VARIABLE
+--                   AS A PARAMETER.  REMOVED LINE WHICH SAVED AND
+--                   RESTORED THE LINE LENGTH.
+
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3602B IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3602B", "CHECK THAT GET PROPERLY SETS PAGE, LINE, AND " &
+                      "COLUMN NUMBERS");
+
+     DECLARE
+          FILE1 : FILE_TYPE;
+          LINE1 : CONSTANT STRING := "LINE ONE OF TEST DATA FILE";
+          LINE2 : CONSTANT STRING := "LINE TWO";
+          LINE3 : CONSTANT STRING := "LINE THREE";
+          CN, LN : POSITIVE_COUNT;
+          CH : CHARACTER;
+          ST: STRING (1 .. 5);
+          ORIGINAL_LINE_LENGTH : COUNT;
+
+     BEGIN
+
+-- CREATE AND INITIALIZE TEST DATA FILE
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "TEXT CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          ORIGINAL_LINE_LENGTH := LINE_LENGTH;
+          SET_LINE_LENGTH (FILE1, LINE1'LENGTH);
+
+          PUT (FILE1, LINE1);
+          SET_LINE_LENGTH (FILE1, LINE2'LENGTH);
+          PUT (FILE1, LINE2);
+          NEW_LINE (FILE1, 2);
+          NEW_PAGE (FILE1);
+          SET_LINE_LENGTH (FILE1, LINE3'LENGTH);
+          PUT (FILE1, LINE3);
+          CLOSE (FILE1);
+
+-- BEGIN TEST
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          IF COL (FILE1) /= 1 THEN
+               FAILED ("COLUMN NUMBER NOT INITIALLY ONE");
+          END IF;
+
+          IF LINE (FILE1) /= 1 THEN
+               FAILED ("LINE NUMBER NOT INITIALLY ONE");
+          END IF;
+
+          IF PAGE (FILE1) /= 1 THEN
+               FAILED ("PAGE NUMBER NOT INITIALLY ONE");
+          END IF;
+
+-- TEST COLUMN NUMBER FOR CHARACTER
+
+          GET (FILE1, CH);
+          IF CH /= 'L' THEN
+               FAILED ("CHARACTER NOT EQUAL TO L - 1");
+          END IF;
+          CN := COL (FILE1);
+          IF CN /= 2 THEN
+               FAILED ("COLUMN NUMBER NOT SET CORRECTLY " &
+                       "- GET CHARACTER.  COL NUMBER IS" &
+                       COUNT'IMAGE(CN));
+          END IF;
+
+-- TEST COLUMN NUMBER FOR STRING
+
+          GET (FILE1, ST);
+          CN := COL (FILE1);
+          IF CN /= 7 THEN
+               FAILED ("COLUMN NUMBER NOT SET CORRECTLY " &
+                       "- GET STRING.  COL NUMBER IS" &
+                       COUNT'IMAGE(CN));
+          END IF;
+
+-- POSITION CURRENT INDEX TO END OF LINE
+
+          WHILE NOT END_OF_LINE (FILE1) LOOP
+               GET (FILE1, CH);
+          END LOOP;
+
+          IF CH /= 'E' THEN
+               FAILED ("CHARACTER NOT EQUAL TO E");
+          END IF;
+
+-- TEST LINE NUMBER FOR CHARACTER
+
+          GET(FILE1, CH);
+          IF CH /= 'L' THEN
+               FAILED ("CHARACTER NOT EQUAL TO L - 2");
+          END IF;
+          LN := LINE (FILE1);
+          IF LN /= 2 THEN
+               FAILED ("LINE NUMBER NOT SET CORRECTLY " &
+                       "- GET CHARACTER.  LINE NUMBER IS" &
+                       COUNT'IMAGE(LN));
+          END IF;
+          IF PAGE (FILE1) /= POSITIVE_COUNT(IDENT_INT(1)) THEN
+               FAILED ("PAGE NUMBER NOT CORRECT - 1.  PAGE IS" &
+                       COUNT'IMAGE(PAGE(FILE1)));
+          END IF;
+
+-- TEST LINE NUMBER FOR STRING
+
+          WHILE NOT END_OF_LINE (FILE1) LOOP
+               GET (FILE1, CH);
+          END LOOP;
+          GET (FILE1, ST);
+          IF ST /= "LINE " THEN
+               FAILED ("INCORRECT VALUE READ - ST");
+          END IF;
+          LN := LINE (FILE1);
+          CN := COL (FILE1);
+          IF CN /= 6 THEN
+               FAILED ("COLUMN NUMBER NOT SET CORRECTLY " &
+                       "- GET STRING.  COL NUMBER IS" &
+                       COUNT'IMAGE(CN));
+          END IF;
+          IF LN /= 1 THEN
+               FAILED ("LINE NUMBER NOT SET CORRECTLY " &
+                       "- GET STRING.  LINE NUMBER IS" &
+                       COUNT'IMAGE(LN));
+          END IF;
+          IF PAGE (FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN
+               FAILED ("PAGE NUMBER NOT CORRECT - 2.  PAGE IS" &
+                       COUNT'IMAGE(PAGE(FILE1)));
+          END IF;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3602B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602c.ada
new file mode 100644
index 000000000..153fed7f8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602c.ada
@@ -0,0 +1,202 @@
+-- CE3602C.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 GET RAISES MODE_ERROR FOR FILES OF MODE OUT_FILE.
+
+-- APPLICABILITY CRITEIRA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 08/31/82
+--     SPS 12/17/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/08/87  CORRECTED EXCEPTION HANDLING AND CHECKED FOR
+--                   USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3602C IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3602C", "CHECK THAT MODE_ERROR IS RAISED BY GET FOR " &
+                      "FILES OF MODE OUT_FILE");
+
+     DECLARE
+          FILE1, FILE2 : FILE_TYPE;
+          CH : CHARACTER;
+          ST : STRING (1 .. 5);
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "FOR TEMPORARY FILE WITH " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "TEXT CREATE - 1");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
+                            "CREATE - 2");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               GET (FILE1, CH);
+               FAILED ("MODE_ERROR NOT RAISED - GET CHAR UN-NAMED " &
+                       "FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
+                            "UN-NAMED FILE");
+          END;
+
+          BEGIN
+               GET (FILE2, CH);
+               FAILED ("MODE_ERROR NOT RAISED - GET CHAR NAMED FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
+                            "NAMED FILE");
+          END;
+
+          BEGIN
+               GET (STANDARD_OUTPUT, CH);
+               FAILED ("MODE_ERROR NOT RAISED - GET CHAR " &
+                       "STANDARD_OUTPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
+                            "STANDARD_OUTPUT");
+          END;
+
+          BEGIN
+               GET (CURRENT_OUTPUT, CH);
+               FAILED ("MODE_ERROR NOT RAISED - GET CHAR " &
+                       "CURRENT_OUTPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
+                            "CURRENT_OUTPUT");
+          END;
+
+          BEGIN
+               GET (FILE1, ST);
+               FAILED ("MODE_ERROR NOT RAISED - GET STRING UN-NAMED " &
+                       "FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
+                            "UN-NAMED FILE");
+          END;
+
+          BEGIN
+               GET (FILE2, ST);
+               FAILED ("MODE_ERROR NOT RAISED - GET STRING NAMED FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
+                            "NAMED FILE");
+          END;
+
+          BEGIN
+               GET (STANDARD_OUTPUT, ST);
+               FAILED ("MODE_ERROR NOT RAISED - GET STRING " &
+                       "STANDARD_OUTPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
+                            "STANDARD_OUTPUT");
+          END;
+
+          BEGIN
+               GET (CURRENT_OUTPUT, ST);
+               FAILED ("MODE_ERROR NOT RAISED - GET STRING " &
+                       "CURRENT_OUTPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
+                            "CURRENT_OUTPUT");
+          END;
+
+          CLOSE (FILE1);
+
+          BEGIN
+               DELETE (FILE2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3602C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602d.ada
new file mode 100644
index 000000000..89b6a47ad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3602d.ada
@@ -0,0 +1,150 @@
+-- CE3602D.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 FILES ARE OF MODE IN_FILE AND THAT WHEN NO FILE IS
+--     SPECIFIED THAT CURRENT DEFAULT INPUT FILE IS USED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/06/82
+--     SPS 12/17/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/08/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3602D IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3602D", "CHECK THAT GET FOR STRINGS AND CHARACTERS " &
+                      "OPERATES ON IN_FILE FILES");
+
+     DECLARE
+          FT , FILE : FILE_TYPE;
+          X : CHARACTER;
+          ST: STRING (1 .. 3);
+     BEGIN
+
+-- CREATE AND INITIALIZE FILES
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "ABCE");
+          NEW_LINE (FT);
+          PUT (FT, "EFGHIJKLM");
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME(2));
+
+          PUT (FILE, "STRING");
+          NEW_LINE (FILE);
+          PUT (FILE, "END OF OUTPUT");
+
+          CLOSE (FILE);
+
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2));
+
+          SET_INPUT (FILE);
+
+-- BEGIN TEST
+
+          GET (FT, X);
+          IF X /= IDENT_CHAR ('A') THEN
+               FAILED ("CHARACTER FROM FILE INCORRECT, WAS '" &
+                       X & "'");
+          END IF;
+
+          GET (FT, ST);
+          IF ST /= "BCE" THEN
+               FAILED ("STRING FROM FILE INCORRECT; WAS """ &
+                       ST & """");
+          END IF;
+
+          GET (X);
+          IF X /= IDENT_CHAR ('S') THEN
+               FAILED ("CHARACTER FROM DEFAULT INCORRECT; WAS '" &
+                       X & "'");
+          END IF;
+
+          GET (ST);
+          IF ST /= "TRI" THEN
+               FAILED ("STRING FROM DEFAULT INCORRECT; WAS """ &
+                       ST & """");
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3602D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3603a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3603a.ada
new file mode 100644
index 000000000..d9d4f1e6d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3603a.ada
@@ -0,0 +1,217 @@
+-- CE3603A.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 END_ERROR IS NOT RAISED BY:
+--       GET FOR CHARACTERS UNTIL ONLY LINE AND PAGE TERMINATORS REMAIN;
+--       GET FROM STRING UNTIL FEWER CHARACTERS THAN NEEDED REMAIN;
+--       GET_LINE UNTIL THE FINAL PAGE TERMINATOR HAS BEEN SKIPPED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 08/31/82
+--     JBG 12/23/82
+--     EG  05/22/85
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/08/87  CORRECTED EXCEPTION HANDLING AND REMOVED
+--                   DEPENDENCE ON RESET.
+
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3603A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3603A", "CHECK THAT END_ERROR IS RAISED BY GET AFTER " &
+                      "THE LAST CHARACTER IN THE FILE HAS BEEN READ");
+
+     DECLARE
+          FILE1 : FILE_TYPE;
+          OLDCH, CH : CHARACTER;
+          ST        : STRING (1..10) := (1..10 => '.');
+          COUNT     : NATURAL;
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT" &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE1, "LINE ONE");
+          NEW_LINE (FILE1);
+          PUT (FILE1, "LINE TWO");
+          NEW_LINE (FILE1, 3);
+          NEW_PAGE (FILE1);
+          NEW_PAGE (FILE1);
+          CLOSE (FILE1);
+
+          BEGIN
+
+               BEGIN
+                    OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               SKIP_LINE (FILE1);
+               GET (FILE1, ST(1..7));
+               IF ST(1..7) /= "LINE TW" THEN
+                    FAILED ("NOT POSITIONED RIGHT - GET CHAR");
+               END IF;
+
+-- COUNT NUMBER OF CHARACTERS IN FIRST LINE (TO ALLOW FOR TRAILING
+--     BLANKS)
+
+               COUNT := 0;
+               WHILE NOT END_OF_LINE(FILE1)
+               LOOP
+                    GET (FILE1, CH);
+                    OLDCH := CH;
+                    COUNT := COUNT + 1;
+               END LOOP;
+
+               BEGIN
+                    GET (FILE1, CH);
+                    FAILED ("END_ERROR NOT RAISED - GET " &
+                            "CHARACTER");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         IF CH /= OLDCH THEN
+                              FAILED ("CH MODIFIED ON END_" &
+                                      "ERROR");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED " &
+                                 "- GET CHARACTER");
+               END;
+
+               CLOSE (FILE1);
+
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+
+               SKIP_LINE (FILE1);
+               GET (FILE1, ST(1..7));
+               IF ST(1..7) /= "LINE TW" THEN
+                    FAILED ("WRONG LINE 2. ACTUALLY READ '" & ST(1..7) &
+                            "'");
+               END IF;
+
+               BEGIN
+                    GET (FILE1, ST(8..8+COUNT));
+                    FAILED ("END_ERROR NOT RAISED - GET " &
+                            "STRING");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         IF ST(1..7) /= "LINE TW" THEN
+                              FAILED ("ST MODIFIED ON END_ERROR");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED " &
+                                 "- GET STRING");
+               END;
+
+               CLOSE (FILE1);
+
+          END;
+
+          DECLARE
+               LAST : NATURAL;
+          BEGIN
+
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+
+               SKIP_LINE (FILE1);
+               GET_LINE (FILE1, ST, LAST);
+               IF LAST < 8 THEN
+                    FAILED ("LAST < 8.  LAST IS" & INTEGER'IMAGE(LAST));
+               ELSIF ST(1..8) /= "LINE TWO" THEN
+                    FAILED ("GET_LINE FAILED. ACTUALLY READ '" &
+                            ST(1..8) & "'");
+               END IF;
+
+               SKIP_PAGE (FILE1);
+               SKIP_PAGE (FILE1);
+
+               BEGIN
+                    GET_LINE (FILE1, ST(1..1), LAST);
+                    FAILED ("END_ERROR NOT RAISED - GET_LINE - 1");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         IF LAST /= 8 THEN
+                              FAILED ("LAST MODIFIED BY GET_LINE " &
+                                      "ON END_ERROR.  LAST IS" &
+                                      INTEGER'IMAGE(LAST));
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION - GET_LINE - 1");
+               END;
+
+               BEGIN     -- NULL ITEM ARGUMENT
+                    GET_LINE (FILE1, ST(1..0), LAST);
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         FAILED ("GET_LINE ATTEMPTED TO READ INTO A " &
+                                 "NULL STRING");
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION - GET_LINE - 2");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3603A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3604a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3604a.ada
new file mode 100644
index 000000000..380791f09
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3604a.ada
@@ -0,0 +1,160 @@
+-- CE3604A.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 GET_LINE MAY BE CALLED TO RETURN AN ENTIRE LINE.  ALSO
+--     CHECK THAT GET_LINE MAY BE CALLED TO RETURN THE REMAINDER OF A
+--     PARTLY READ LINE.  ALSO CHECK THAT GET_LINE RETURNS IN THE
+--     PARAMETER LAST, THE INDEX VALUE OF THE LAST CHARACTER READ.
+--     WHEN NO CHARACTERS ARE READ, LAST IS ONE LESS THAN ITEM'S LOWER
+--     BOUND.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 09/25/87  COMPLETELY REVISED TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3604A IS
+
+BEGIN
+
+     TEST ("CE3604A", "CHECK THAT GET_LINE READS LINES APPROPRIATELY " &
+                      "AND CHECK THAT LAST RETURNS THE CORRECT INDEX " &
+                      "VALUE");
+
+     DECLARE
+          FILE : FILE_TYPE;
+          STR : STRING (1 .. 25);
+          LAST : NATURAL;
+          ITEM1 : STRING (2 .. 6);
+          ITEM2 : STRING (3 .. 6);
+          CH : CHARACTER;
+          INCOMPLETE : EXCEPTION;
+
+     BEGIN
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE, "FIRST LINE OF INPUT");
+          NEW_LINE (FILE);
+          PUT (FILE, "SECOND LINE OF INPUT");
+          NEW_LINE (FILE);
+          PUT (FILE, "THIRD LINE OF INPUT");
+          NEW_LINE (FILE);
+          NEW_LINE (FILE);
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET_LINE (FILE, STR, LAST);
+
+          BEGIN
+               IF STR(1..LAST) /= "FIRST LINE OF INPUT" THEN
+                    FAILED ("GET_LINE - RETURN OF ENTIRE LINE");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT_ERROR RAISED AFTER " &
+                            "GET_LINE - 1");
+          END;
+
+          GET (FILE, ITEM1);
+          GET_LINE (FILE, STR, LAST);
+
+          BEGIN
+               IF STR(1..LAST) /= "D LINE OF INPUT" THEN
+                    FAILED ("GET_LINE - REMAINDER OF PARTLY READ LINE");
+               END IF;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT_ERROR RAISED AFTER " &
+                            "GET_LINE - 2");
+          END;
+
+          GET_LINE (FILE, ITEM1, LAST);
+          IF LAST /= 6 THEN
+               FAILED ("INCORRECT VALUE FOR LAST PARAMETER - 1");
+          END IF;
+
+          WHILE NOT END_OF_LINE (FILE) LOOP
+               GET (FILE, CH);
+          END LOOP;
+
+          GET_LINE (FILE, ITEM1, LAST);
+          IF LAST /= 1 THEN
+               FAILED ("INCORRECT VALUE FOR LAST PARAMETER - 2");
+          END IF;
+
+          IF NOT END_OF_LINE (FILE) THEN
+               FAILED ("END_OF_LINE NOT TRUE");
+          END IF;
+
+          GET_LINE (FILE, ITEM2, LAST);
+          IF LAST /= 2 THEN
+               FAILED ("INCORRECT VALUE FOR LAST PARAMETER - 3");
+          END IF;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3604A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3604b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3604b.ada
new file mode 100644
index 000000000..5684b8af6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3604b.ada
@@ -0,0 +1,137 @@
+-- CE3604B.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 GET_LINE DOES NOT DO A SKIP_LINE AND NO CHARACTERS ARE
+--     READ WHEN THE INPUT IS AT THEN END OF A LINE AND THE STRING
+--     PARAMETER IS A NULL STRING.  ALSO CHECK THAT GET_LINE DOES NOT
+--     SKIP THE LINE TERMINATOR AFTER READING ALL THE CHARACTERS INTO
+--     A STRING WHICH IS EXACTLY EQUAL TO THE NUMBER OF CHARACTERS
+--     REMAINING ON THAT LINE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 10/13/87  CREATED ORIGINAL TEST.
+
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3604B IS
+
+BEGIN
+
+     TEST ("CE3604B", "CHECK THAT GET_LINE READS LINES APPROPRIATELY");
+
+     DECLARE
+          INCOMPLETE : EXCEPTION;
+          FILE : FILE_TYPE;
+          ITEM1 : STRING (1 .. 19);
+          ITEM2 : STRING (1 .. 20);
+          NULL_ITEM : STRING (2 .. 1);
+          LAST : NATURAL;
+
+     BEGIN
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
+                            "CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE, "FIRST LINE OF INPUT");
+          NEW_LINE (FILE);
+          PUT (FILE, "SECOND LINE OF INPUT");
+          NEW_LINE (FILE);
+          PUT (FILE, "THIRD LINE OF INPUT");
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FILE, ITEM1);
+          IF ITEM1 /= "FIRST LINE OF INPUT" THEN
+               FAILED ("INCORRECT VALUE FOR GET");
+          END IF;
+
+          GET_LINE (FILE, NULL_ITEM, LAST);
+
+          IF LINE (FILE) /= 1 THEN
+               FAILED ("INCORRECT LINE NUMBER AFTER GET_LINE - 1");
+          END IF;
+
+          IF COL (FILE) /= 20 THEN
+               FAILED ("INCORRECT COLUMN NUMBER AFTER GET_LINE - 1");
+          END IF;
+
+          SKIP_LINE (FILE);
+          GET_LINE (FILE, ITEM2, LAST);
+          IF ITEM2 /= "SECOND LINE OF INPUT" THEN
+               FAILED ("INCORRECT VALUE FOR GET_LINE");
+          END IF;
+
+          IF LINE (FILE) /= 2 THEN
+               FAILED ("INCORRECT LINE NUMBER AFTER GET_LINE - 2");
+          END IF;
+
+          IF COL (FILE) /= 21 THEN
+               FAILED ("INCORRECT COLUMN NUMBER AFTER GET_LINE - 2");
+          END IF;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3604B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605a.ada
new file mode 100644
index 000000000..41d1eae91
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605a.ada
@@ -0,0 +1,118 @@
+-- CE3605A.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 PUT FOR CHARACTER AND STRING PARAMETERS DOES NOT
+--     UPDATE THE LINE NUMBER WHEN THE LINE LENGTH IS UNBOUNDED,
+--     ONLY THE COLUMN NUMBER.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     SPS 09/02/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/08/87  CORRECTED EXCEPTION HANDLING AND ADDED CHECKS
+--                   FOR COLUMN NUMBER.
+--     RJW 03/28/90  REVISED NUMERIC LITERALS USED IN LOOPS.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3605A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3605A", "CHECK THAT PUT FOR CHARACTER AND STRING " &
+                      "PARAMETERS DOES NOT UPDATE THE LINE NUMBER " &
+                      "WHEN THE LINE LENGTH IS UNBOUNDED, ONLY THE " &
+                      "COLUMN NUMBER");
+
+     DECLARE
+          FILE1 : FILE_TYPE;
+          LN : POSITIVE_COUNT := 1;
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "FOR TEMPORARY FILES WITH " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          LN := LINE (FILE1);
+
+          IF LN /= 1 THEN
+               FAILED ("CURRENT LINE NUMBER NOT INITIALLY ONE");
+          END IF;
+
+          IF COL (FILE1) /= 1 THEN
+               FAILED ("CURRENT COLUMN NUMBER NOT INITIALLY ONE");
+          END IF;
+
+          FOR I IN 1 .. IDENT_INT(240) LOOP
+               PUT(FILE1, 'A');
+          END LOOP;
+          IF LINE (FILE1) /= LN THEN
+               FAILED ("PUT ALTERED LINE NUMBER - CHARACTER");
+          END IF;
+
+          IF COL(FILE1) /= 241 THEN
+               FAILED ("COLUMN NUMBER NOT UPDATED CORRECTLY - 1");
+          END IF;
+
+          NEW_LINE(FILE1);
+          LN := LINE (FILE1);
+
+          FOR I IN 1 .. IDENT_INT(40) LOOP
+               PUT (FILE1, "STRING");
+          END LOOP;
+          IF LN /= LINE (FILE1) THEN
+               FAILED ("PUT ALTERED LINE NUMBER - STRING");
+          END IF;
+
+          IF COL(FILE1) /= 241 THEN
+               FAILED ("COLUMN NUMBER NOT UPDATED CORRECTLY - 2");
+          END IF;
+
+          CLOSE (FILE1);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3605A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605b.ada
new file mode 100644
index 000000000..c0de3c571
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605b.ada
@@ -0,0 +1,142 @@
+-- CE3605B.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 PUT OUTPUTS A LINE TERMINATOR, RESETS THE COLUMN
+--     NUMBER AND INCREMENTS THE LINE NUMBER WHEN THE LINE LENGTH IS
+--     BOUNDED AND THE COLUMN NUMBER EQUALS THE LINE LENGTH WHEN PUT
+--     IS CALLED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/02/82
+--     JBG 12/28/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/08/87  GAVE FILE A NAME AND REMOVED CODE WHICH RESETS
+--                   THE FILE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+PROCEDURE CE3605B IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3605B", "CHECK THAT PUT PROPERLY MAINTAINS THE " &
+                      "LINE NUMBER AND COLUMN NUMBER WHEN THE " &
+                      "LINE LENGTH IS BOUNDED");
+
+     DECLARE
+          FILE1 : FILE_TYPE;
+          LN_CNT : POSITIVE_COUNT;
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "TEXT CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_LINE_LENGTH (FILE1, 5);
+          LN_CNT := LINE (FILE1);
+
+          FOR I IN 1 .. 5 LOOP
+               PUT (FILE1, 'X');
+          END LOOP;
+
+          IF COL(FILE1) /= 6 THEN
+               FAILED ("COLUMN NUMBER NOT INCREMENTED - PUT; " &
+                       "VALUE WAS" & COUNT'IMAGE(COL(FILE1)));
+          END IF;
+
+          IF LINE(FILE1) /= LN_CNT THEN
+               FAILED ("LINE COUNT MODIFIED - PUT CHARACTER; " &
+                       "VALUE WAS" & COUNT'IMAGE(LINE(FILE1)));
+          END IF;
+
+          PUT (FILE1, 'X');
+          IF COL(FILE1) /= 2 THEN
+               FAILED ("COLUMN NUMBER NOT RESET - PUT CHARACTER; " &
+                       "VALUE WAS" & COUNT'IMAGE(COL(FILE1)));
+          END IF;
+
+          IF LINE(FILE1) /= LN_CNT + 1 THEN
+               FAILED("LINE NUMBER NOT INCREMENTED - PUT CHARACTER; " &
+                       "VALUE WAS" & COUNT'IMAGE(LINE(FILE1)));
+          END IF;
+
+          NEW_LINE (FILE1);
+
+          SET_LINE_LENGTH (FILE1, 4);
+          LN_CNT := LINE (FILE1);
+
+          PUT (FILE1, "XXXX");
+
+          IF COL(FILE1) /= 5 THEN
+               FAILED ("COLUMN NUMBER NOT INCREMENTED - PUT STRING; " &
+                       "VALUE WAS" & COUNT'IMAGE(COL(FILE1)));
+          END IF;
+
+          IF LINE (FILE1) /= LN_CNT THEN
+               FAILED ("LINE NUMBER INCREMENTED - PUT STRING; " &
+                       "VALUE WAS" & COUNT'IMAGE(LINE (FILE1)));
+          END IF;
+
+          PUT (FILE1, "STR");
+
+          IF COL(FILE1) /= 4 THEN
+               FAILED ("COLUMN NUMBER NOT SET CORRECTLY - PUT" &
+                       "STRING; VALUE WAS" & COUNT'IMAGE(COL(FILE1)));
+          END IF;
+
+          IF LINE (FILE1) /= LN_CNT + 1 THEN
+               FAILED ("LINE NUMBER NOT INCREMENTED - PUT STRING; " &
+                       "VALUE WAS" & COUNT'IMAGE(LINE (FILE1)));
+          END IF;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3605B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605c.ada
new file mode 100644
index 000000000..7dca9781f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605c.ada
@@ -0,0 +1,159 @@
+-- CE3605C.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 PUT RAISES MODE_ERROR FOR FILES OF MODE IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/02/82
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/08/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
+--                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3605C IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3605C", "MODE_ERROR RAISED BY PUT FOR IN_FILES");
+
+     DECLARE
+          FILE1 : FILE_TYPE;
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "TEXT CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE1, 'A');
+          CLOSE (FILE1);
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
+                                    "OPEN FOR IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               PUT (FILE1, 'A');
+               FAILED ("MODE_ERROR NOT RAISED - 1");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               PUT (STANDARD_INPUT, 'A');
+               FAILED ("MODE_ERROR NOT RAISED - 2");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               PUT (CURRENT_INPUT, 'A');
+               FAILED ("MODE_ERROR NOT RAISED - 3");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 3");
+          END;
+
+          BEGIN
+               PUT (FILE1, "STRING");
+               FAILED ("MODE_ERROR NOT RAISED - 4");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 4");
+          END;
+
+          BEGIN
+               PUT (STANDARD_INPUT, "STRING");
+               FAILED ("MODE_ERROR NOT RAISED - 5");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 5");
+          END;
+
+          BEGIN
+               PUT (CURRENT_INPUT, "STRING");
+               FAILED ("MODE_ERROR NOT RAISED - 6");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 6");
+          END;
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3605C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605d.ada
new file mode 100644
index 000000000..1d52eae79
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605d.ada
@@ -0,0 +1,192 @@
+-- CE3605D.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 PUT DOES NOT RAISE LAYOUT_ERROR WHEN THE NUMBER OF
+--     CHARACTERS TO BE OUTPUT EXCEEDS THE LINE LENGTH.
+--     CHECK THAT PUT HAS THE EFFECT OF NEW_LINE (AS WELL AS
+--     OUTPUTTING THE ITEM) WHEN THE NUMBER OF CHARACTERS TO BE OUTPUT
+--     OVERFLOWS A BOUNDED LINE LENGTH.
+--     CHECK THAT PUT WITH A NULL STRING PERFORMS NO OPERATION.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/02/82
+--     JBG 12/28/82
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/08/87  CORRECTED EXCEPTION HANDLING.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+PROCEDURE CE3605D IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3605D", "CHECK THAT LAYOUT_ERROR IS NOT RAISED BY PUT " &
+                      "FOR STRING");
+
+     DECLARE
+          FT : FILE_TYPE;
+          LC : POSITIVE_COUNT;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
+                            "TEXT CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_LINE_LENGTH (FT, 5);
+
+          BEGIN
+               PUT (FT, "STRING");
+
+               IF LINE(FT) /= 2 THEN
+                    FAILED ("LINE COUNT WAS" & COUNT'IMAGE(LINE(FT)) &
+                            " INSTEAD OF 2");
+               END IF;
+
+               IF COL(FT) /= 2 THEN
+                    FAILED ("COLUMN COUNT WAS" & COUNT'IMAGE(COL(FT)) &
+                            " INSTEAD OF 2");
+               END IF;
+
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED - 1");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
+
+          END;
+
+          PUT (FT, "NEW");
+
+          IF LINE(FT) /= 2 THEN
+               FAILED ("LINE COUNT WRONG - 2; WAS" &
+                       COUNT'IMAGE(LINE(FT)) &
+                       " INSTEAD OF 2");
+          END IF;
+
+          IF COL(FT) /= 5 THEN
+               FAILED ("COL COUNT WRONG - 2; WAS" &
+                       COUNT'IMAGE(COL(FT)) &
+                       " INSTEAD OF 5");
+          END IF;
+
+          BEGIN
+               PUT (FT, "STR");
+               IF LINE (FT) /= 3 THEN
+                    FAILED ("PUT STRING WHEN IN MIDDLE OF " &
+                            "LINE DOES NOT HAVE EFFECT OF " &
+                            "NEW_LINE; LINE COUNT IS" &
+                            COUNT'IMAGE(LINE(FT)));
+               END IF;
+
+               IF COL(FT) /= 3 THEN
+                    FAILED ("COL COUNT WRONG - 3; WAS" &
+                            COUNT'IMAGE(COL(FT)) &
+                            " INSTEAD OF 3");
+               END IF;
+
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED - 2");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
+          END;
+
+          PUT (FT, "ING");
+
+          IF LINE(FT) /= 3 THEN
+               FAILED ("LINE COUNT WRONG - 3; WAS" &
+                       COUNT'IMAGE(LINE(FT)) &
+                       " INSTEAD OF 3");
+          END IF;
+
+          IF COL(FT) /= 6 THEN
+               FAILED ("COL COUNT WRONG - 3;  WAS" &
+                       COUNT'IMAGE(COL(FT)) &
+                       " INSTEAD OF 6");
+          END IF;
+
+          BEGIN
+               PUT (FT, "");
+
+               IF LINE(FT) /= 3 THEN
+                    FAILED ("LINE COUNT WRONG - 3; WAS" &
+                            COUNT'IMAGE(LINE(FT)) &
+                            " INSTEAD OF 3");
+               END IF;
+
+               IF COL(FT) /= 6 THEN
+                    FAILED ("COL COUNT WRONG - 3;  WAS" &
+                            COUNT'IMAGE(COL(FT)) &
+                            " INSTEAD OF 6");
+               END IF;
+
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED - 3");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
+          END;
+
+          CHECK_FILE (FT,
+                      "STRIN#" &
+                      "GNEWS#" &
+                      "TRING#@%");
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3605D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605e.ada
new file mode 100644
index 000000000..5ea6f236d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3605e.ada
@@ -0,0 +1,103 @@
+-- CE3605E.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 PUT CAN BE CALLED WITH CHARACTER AND STRING
+--     PARAMETERS.  CHECK THAT FILES OF MODE OUT_FILE ARE USED AND
+--     THAT WHEN NO FILE IS SPECIFIED THE CURRENT DEFAULT OUTPUT FILE
+--     IS USED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     SPS 10/06/82
+--     JBG 12/28/82
+--     VKG 02/15/83
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/08/87  REMOVED UNNECESSARY CODE AND CHECKED FOR
+--                   USE_ERROR ON DELETE.
+
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+PROCEDURE CE3605E IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3605E", "CHECK THAT PUT FOR STRINGS AND CHARACTERS " &
+                      "OPERATES ON OUT_FILE FILES");
+
+     DECLARE
+          FT , FILE : FILE_TYPE;
+          X : CHARACTER;
+     BEGIN
+
+          BEGIN
+               CREATE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "FOR TEMPORARY FILE WITH " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FILE);
+
+          SET_OUTPUT (FILE);
+
+          PUT (FT, 'O');
+
+          PUT (FT, "UTPUT STRING");
+
+          PUT ('X');
+
+          PUT ("UTPUT STRING");
+
+-- CHECK OUTPUT
+
+          SET_OUTPUT (STANDARD_OUTPUT);
+          COMMENT ("CHECKING FT");
+          CHECK_FILE (FT, "OUTPUT STRING#@%");
+          COMMENT ("CHECKING FILE");
+          CHECK_FILE (FILE, "XUTPUT STRING#@%");
+
+          CLOSE (FT);
+          CLOSE (FILE);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3605E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3606a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3606a.ada
new file mode 100644
index 000000000..18b2af8ca
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3606a.ada
@@ -0,0 +1,91 @@
+-- CE3606A.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 PUT_LINE WILL OUTPUT A LINE TERMINATOR WHEN THE
+--     STRING PARAMETER IS NULL.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEMPORARY TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/02/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/09/87  REMOVED UNNECESSARY CODE AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+PROCEDURE CE3606A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3606A", "PUT_LINE PUTS LINE TERMINATOR WHEN STRING " &
+                      "IS NULL");
+
+     DECLARE
+          FT : FILE_TYPE;
+          NS1 : STRING (1 .. 0);
+          NS2 : STRING (3 .. 1);
+          LC : POSITIVE_COUNT := 1;
+     BEGIN
+
+          BEGIN
+               CREATE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "FOR TEMP FILES WITH OUT_FILE " &
+                                    "MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT_LINE (FT, NS1);
+          IF LINE (FT) /= LC + 1 THEN
+               FAILED ("PUT_LINE OF NULL STRING 1; LINE " &
+                       "COUNT WAS" & COUNT'IMAGE(LINE(FT)));
+          END IF;
+
+          PUT_LINE (FT, NS2);
+          IF LINE (FT) /= LC + 2 THEN
+               FAILED ("PUT_LINE OF NULL STRING 2; LINE " &
+                       "COUNT WAS" & COUNT'IMAGE(LINE(FT)));
+          END IF;
+
+          CHECK_FILE (FT, "##@%");
+
+          CLOSE (FT);
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3606A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3606b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3606b.ada
new file mode 100644
index 000000000..728a256cd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3606b.ada
@@ -0,0 +1,97 @@
+-- CE3606B.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 PUT_LINE WILL OUTPUT A LINE ON MORE THAN ONE LINE
+--     WHEN THE LINE LENGTH IS BOUNDED, IF THE STRING IS GREATER
+--     THAN THE LINE LENGTH.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEMPORARY TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/02/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/09/87  REMOVED UNNECESSARY CODE AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+PROCEDURE CE3606B IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3606B", "CHECK THAT PUT_LINE WILL OUTPUT A LINE " &
+                      "ON MORE THAN ONE LINE WHEN THE LINE " &
+                      "LENGTH IS BOUNDED, IF THE STRING IS " &
+                      "GREATER THAN THE LINE LENGTH");
+
+     DECLARE
+          FT : FILE_TYPE;
+          LONG_LINE : CONSTANT STRING := "THIS LINE IS A LONG " &
+               "LINE WHICH WHEN OUTPUT SHOULD SPAN OVER SEVERAL " &
+               "LINES IN THE OUTPUT FILE";
+     BEGIN
+
+          BEGIN
+               CREATE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "FOR TEMP FILES WITH OUT_FILE " &
+                                    "MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_LINE_LENGTH (FT, 10);
+
+          PUT_LINE (FT, LONG_LINE);
+          PUT_LINE (FT, "AA");
+
+          CHECK_FILE (FT, "THIS LINE #" &
+                          "IS A LONG #" &
+                          "LINE WHICH#" &
+                          " WHEN OUTP#" &
+                          "UT SHOULD #" &
+                          "SPAN OVER #" &
+                          "SEVERAL LI#" &
+                          "NES IN THE#" &
+                          " OUTPUT FI#" &
+                          "LE#" &
+                          "AA#@%");
+
+          CLOSE (FT);
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3606B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3701a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3701a.ada
new file mode 100644
index 000000000..0f9c52f49
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3701a.ada
@@ -0,0 +1,109 @@
+-- CE3701A.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 GET AND PUT OF INTEGER_IO RAISE STATUS_ERROR IF
+--     THE FILE IS NOT OPEN.
+
+-- HISTORY:
+--     ABW 08/27/82
+--     JBG 08/30/83
+--     DWC 09/09/87  REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION
+--                   HANDLING, AND ATTEMPTED TO CREATE A FILE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3701A IS
+
+     PACKAGE INT_IO IS NEW INTEGER_IO (INTEGER);
+     USE INT_IO;
+     FILE : FILE_TYPE;
+     INT_ITEM : INTEGER := 7;
+
+BEGIN
+
+     TEST ("CE3701A", "CHECK THAT GET AND PUT RAISE " &
+                       "STATUS_ERROR IF THE FILE " &
+                       "IS NOT OPEN");
+
+     BEGIN
+          PUT (FILE, IDENT_INT(8));
+          FAILED ("STATUS_ERROR NOT RAISED WHEN PUT APPLIED " &
+                  "TO A NON-EXISTENT FILE");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED WHEN PUT " &
+                       "APPLIED TO A NON-EXISTENT FILE");
+     END;
+
+     BEGIN
+          GET (FILE, INT_ITEM);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN GET APPLIED " &
+                  "TO A NON-EXISTENT FILE");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED WHEN GET " &
+                       "APPLIED TO A NON-EXISTENT FILE");
+     END;
+
+     BEGIN
+          CREATE (FILE);     -- THIS IS JUST AN ATTEMPT TO CREATE
+          CLOSE (FILE);      -- A FILE.  WHETHER THIS IS SUCCESSFUL
+     EXCEPTION               -- OR NOT HAS NO EFFECT ON TEST
+          WHEN USE_ERROR =>  -- OBJECTIVE.
+               NULL;
+     END;
+
+     BEGIN
+          PUT (FILE, IDENT_INT(8));
+          FAILED ("STATUS_ERROR NOT RAISED WHEN PUT APPLIED " &
+                  "TO AN UNOPENED FILE");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED WHEN PUT " &
+                       "APPLIED TO AN UNOPENED FILE");
+     END;
+
+     BEGIN
+          GET (FILE, INT_ITEM);
+          FAILED ("STATUS_ERROR NOT RAISED WHEN GET APPLIED " &
+                  "TO AN UNOPENED FILE");
+     EXCEPTION
+          WHEN STATUS_ERROR =>
+               NULL;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED WHEN GET " &
+                       "APPLIED TO AN UNOPENED FILE");
+     END;
+
+     RESULT;
+
+END CE3701A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704a.ada
new file mode 100644
index 000000000..f2325c04b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704a.ada
@@ -0,0 +1,134 @@
+-- CE3704A.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:
+--     CHECK THAT GET FOR INTEGER_IO CAN OPERATE ON ANY FILE OF MODE
+--     IN_FILE AND THAT IF NO FILE IS SPECIFIED THE CURRENT DEFAULT
+--     INPUT FILE IS USED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/01/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/09/87  REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION
+--                   HANDLING, AND REMOVED DEPENDENCE ON RESET.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3704A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3704A", "CHECK THAT GET FOR INTEGER_IO CAN OPERATE " &
+                      "ON ANY FILE OF MODE IN_FILE AND THAT IF " &
+                      "NO FILE IS SPECIFIED THE CURRENT DEFAULT " &
+                      "INPUT FILE IS USED");
+
+     DECLARE
+          FT : FILE_TYPE;
+          FT2: FILE_TYPE;
+          TYPE NI IS NEW INTEGER RANGE 1 .. 700;
+          X : NI;
+          PACKAGE IIO IS NEW INTEGER_IO (NI);
+          USE IIO;
+     BEGIN
+
+-- CREATE AND INITIALIZE DATA FILES
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, '3');
+          PUT (FT, '6');
+          PUT (FT, '9');
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
+
+          PUT (FT2, '6');
+          PUT (FT2, '2');
+          PUT (FT2, '4');
+
+          CLOSE (FT2);
+          OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
+
+          SET_INPUT (FT2);
+
+          GET (FT, X);
+
+          IF X /= 369 THEN
+               FAILED ("GET RETURNED WRONG VALUE; VALUE WAS" &
+                       NI'IMAGE(X));
+          END IF;
+
+          GET (X);
+
+          IF X /= 624 THEN
+               FAILED ("GET FOR DEFAULT WAS WRONG; VALUE WAS" &
+                       NI'IMAGE(X));
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+               DELETE (FT2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3704A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704b.ada
new file mode 100644
index 000000000..59f60c4a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704b.ada
@@ -0,0 +1,107 @@
+-- CE3704B.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 INTEGER_IO GET RAISES MODE_ERROR FOR FILES OF MODE
+--     OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/04/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/09/87  CORRECTED EXCEPTION HANDLING.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3704B IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3704B", "CHECK THAT INTEGER_IO GET RAISES " &
+                      "MODE_ERROR FOR FILES OF MODE OUT_FILE");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE INT IS NEW INTEGER RANGE 1 .. 10;
+          PACKAGE IIO IS NEW INTEGER_IO (INT);
+          USE IIO;
+          X : INT := 10;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE);
+               PUT (FT, '3');
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "FOR TEMP FILE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("MODE_ERROR NOT RAISED - FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FILE");
+          END;
+
+          BEGIN
+               GET (STANDARD_OUTPUT, X);
+               FAILED ("MODE_ERROR NOT RAISED - STANDARD_OUTPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - STANDARD_OUTPUT");
+          END;
+
+          BEGIN
+               GET (CURRENT_OUTPUT, X);
+               FAILED ("MODE_ERROR NOT RAISED - CURRENT_OUTPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CURRENT_OUTPUT");
+          END;
+
+          CLOSE (FT);
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3704B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704c.ada
new file mode 100644
index 000000000..b3567fae7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704c.ada
@@ -0,0 +1,176 @@
+-- CE3704C.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 INTEGER_IO GET RAISES CONSTRAINT_ERROR IF THE
+--     WIDTH PARAMETER IS NEGATIVE, IF THE WIDTH PARAMETER IS
+--     GREATER THAN FIELD'LAST WHEN FIELD'LAST IS LESS THAN
+--     INTEGER'LAST, OR THE VALUE READ IS OUT OF THE RANGE OF
+--     THE ITEM PARAMETER BUT WITHIN THE RANGE OF INSTANTIATED
+--     TYPE.
+
+-- HISTORY:
+--     SPS 10/04/82
+--     DWC 09/09/87  ADDED CASES FOR WIDTH BEING GREATER THAN
+--                   FIELD'LAST AND THE VALUE BEING READ IS OUT
+--                   OF ITEM'S RANGE BUT WITHIN INSTANTIATED
+--                   RANGE.
+--     JRL 06/07/96  Added call to Ident_Int in expressions involving
+--                   Field'Last, to make the expressions non-static and
+--                   prevent compile-time rejection.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3704C IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3704C", "CHECK THAT INTEGER_IO GET RAISES " &
+                      "CONSTRAINT_ERROR IF THE WIDTH PARAMETER " &
+                      "IS NEGATIVE, IF THE WIDTH PARAMETER IS " &
+                      "GREATER THAN FIELD'LAST WHEN FIELD'LAST IS " &
+                      "LESS THAN INTEGER'LAST, OR THE VALUE READ " &
+                      "IS OUT OF THE RANGE OF THE ITEM PARAMETER " &
+                      "BUT WITHIN THE RANGE OF INSTANTIATED TYPE");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE INT IS NEW INTEGER RANGE 1 .. 10;
+          PACKAGE IIO IS NEW INTEGER_IO (INT);
+          X : INT RANGE 1 .. 5;
+          USE IIO;
+     BEGIN
+
+          BEGIN
+               GET (FT, X, IDENT_INT(-1));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - FILE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("RAISED STATUS_ERROR");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FILE");
+          END;
+
+          BEGIN
+               GET (X, IDENT_INT(-6));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - DEFAULT");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - DEFAULT");
+          END;
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, 1);
+          NEW_LINE (FT);
+          PUT (FT, 8);
+          NEW_LINE (FT);
+          PUT (FT, 2);
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR FOR OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               GET (FT, X, IDENT_INT(-1));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                       "NEGATIVE WIDTH WITH EXTERNAL FILE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - " &
+                            "NEGATIVE WIDTH WITH EXTERNAL FILE");
+          END;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                       "OUT OF RANGE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - " &
+                            "OUT OF RANGE");
+          END;
+
+          SKIP_LINE (FT);
+
+          IF FIELD'LAST < INTEGER'LAST THEN
+               BEGIN
+                    GET (FT, X, FIELD'LAST + Ident_Int(1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                            "FIELD'LAST + 1 WIDTH WITH " &
+                            "EXTERNAL FILE");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FIELD'LAST + 1 WIDTH WITH " &
+                                 "EXTERNAL FILE");
+               END;
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+END CE3704C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704d.ada
new file mode 100644
index 000000000..233b8642a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704d.ada
@@ -0,0 +1,169 @@
+-- CE3704D.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 INTEGER_IO GET READS AT MOST WIDTH CHARACTERS
+--     OR UP TO THE NEXT TERMINATOR; INCLUDING LEADING BLANKS
+--     AND HORIZONTAL TABULATION CHARACTERS, WHEN WIDTH IS
+--     NONZERO.
+
+--     CHECK THAT INPUT TERMINATES WHEN A LINE TERMINATOR IS
+--     ENCOUNTERED AND THAT DATA_ERROR IS RAISED IF THE DATA
+--     READ IS INVALID.
+
+-- APPLICABILITY CRITERIA:
+
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/04/82
+--     VKG 01/12/83
+--     SPS 02/08/83
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/09/87  ADDED CASES FOR TABS, REMOVED UNNECESSARY
+--                   CODE, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3704D IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3704D", "CHECK THAT INTEGER_IO GET READS AT MOST " &
+                      "WIDTH CHARACTERS OR UP TO THE NEXT " &
+                      "TERMINATOR; INCLUDING LEADING BLANKS AND " &
+                      "HORIZONTAL TABULATION CHARACTERS, WHEN WIDTH " &
+                      "IS NONZERO");
+
+     DECLARE
+          FT : FILE_TYPE;
+          X : INTEGER;
+          PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
+          USE IIO;
+     BEGIN
+
+-- CREATE AND INITIALIZE FILE
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "  123");
+          NEW_LINE (FT);
+          PUT (FT, "-5678");
+          NEW_LINE (FT);
+          PUT (FT, "  ");
+          NEW_PAGE (FT);
+          PUT (FT, ASCII.HT & "9");
+          NEW_PAGE (FT);
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+-- BEGIN TEST
+
+          GET (FT, X, 5);
+          IF X /= IDENT_INT (123) THEN
+               FAILED ("WIDTH CHARACTERS NOT READ - 1");
+          ELSE
+               BEGIN
+                    GET (FT, X, 2);
+                    FAILED ("DATA_ERROR NOT RAISED - 1");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED -1");
+               END;
+               SKIP_LINE (FT);
+               GET (FT, X, 6);
+               IF X /= IDENT_INT (-5678) THEN
+                    FAILED ("GET WITH WIDTH " &
+                            "INCORRECT - 2");
+               ELSE
+                    BEGIN
+                         GET (FT, X, 2);
+                         FAILED ("DATA_ERROR NOT RAISED - 2");
+                    EXCEPTION
+                         WHEN DATA_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION RAISED - 2");
+                    END;
+                    SKIP_LINE(FT);
+                    BEGIN
+                         GET (FT, X, 2);
+                         FAILED ("DATA_ERROR NOT RAISED - 3");
+                    EXCEPTION
+                         WHEN DATA_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION RAISED - 3");
+                    END;
+                    SKIP_LINE(FT);
+                    GET (FT, X, 2);
+                    IF X /= IDENT_INT (9) THEN
+                         FAILED ("GET WITH WIDTH " &
+                                 "INCORRECT - 3");
+                    END IF;
+               END IF;
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3704D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704e.ada
new file mode 100644
index 000000000..6fb043079
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704e.ada
@@ -0,0 +1,143 @@
+-- CE3704E.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 INTEGER_IO GET RAISES DATA_ERROR WHEN THE LEXICAL
+--     ELEMENT IS NOT OF THE INTEGER TYPE EXPECTED.  CHECK THAT ITEM
+--     IS UNAFFECTED AND READING CAN CONTINUE AFTER THE EXCEPTION
+--     HAS BEEN HANDLED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/04/82
+--     VKG 01/14/83
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/10/87  REMOVED UNNECCESSARY CODE, CORRECTED EXCEPTION
+--                   HANDLING, AND CHECKED FOR USE_ERROR ON DELETE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3704E IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3704E", "CHECK THAT INTEGER_IO GET RAISES DATA_ERROR " &
+                      "WHEN THE LEXICAL ELEMENT IS NOT OF THE " &
+                      "INTEGER TYPE EXPECTED.  CHECK THAT ITEM " &
+                      "IS UNAFFECTED AND READING CAN CONTINUE AFTER " &
+                      "THE EXCEPTION HAS BEEN HANDLED");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE INT IS NEW INTEGER RANGE 10 .. 20;
+          PACKAGE IIO IS NEW INTEGER_IO (INT);
+          USE IIO;
+          X : INT := 16;
+     BEGIN
+
+-- CREATE AND INITIALIZE FILE
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, " 101 12");
+          CLOSE(FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               GET (FT, X, 2);
+               FAILED ("DATA_ERROR NOT RAISED - 1");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    IF X /= 16 THEN
+                         FAILED ("ITEM AFFECTED BY GET WHEN DATA" &
+                                 "_ERROR IS RAISED");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               GET (FT, X, 3);
+               FAILED ("DATA_ERROR NOT RAISED - 2");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    IF X /= 16 THEN
+                         FAILED ("ITEM AFFECTED BY GET WHEN DATA" &
+                                 "_ERROR IS RAISED");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               GET (FT, X, 2);
+               IF X /= 12 THEN
+                    FAILED ("READING NOT CONTINUED CORRECTLY " &
+                            "AFTER EXCEPTION");
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("GET OF CORRECT DATA RAISED EXCEPTION");
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3704E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704f.ada
new file mode 100644
index 000000000..22f021712
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704f.ada
@@ -0,0 +1,365 @@
+-- CE3704F.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 INTEGER_IO GET DOES NOT ALLOW EMBEDDED BLANKS OR
+--     CONSECUTIVE UNDERSCORES TO BE INPUT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/04/82
+--     VKG 01/14/83
+--     CPP 07/30/84
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/10/87  REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION
+--                   HANDLING, AND ADDED MORE CHECKS OF THE VALUES
+--                   OF CHARACTERS READ.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3704F IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3704F", "INTEGER_IO GET DOES NOT ALLOW EMBEDDED " &
+                      "BLANKS OR CONSECUTIVE UNDERSCORES");
+
+     DECLARE
+          FT : FILE_TYPE;
+          X : INTEGER;
+          PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
+          USE IIO;
+          CH : CHARACTER;
+          P : POSITIVE;
+     BEGIN
+
+-- CREATE AND INITIALIZE FILE
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "12_345");
+          NEW_LINE (FT);
+          PUT (FT, "12 345");
+          NEW_LINE (FT);
+          PUT (FT, "1__345");
+          NEW_LINE (FT);
+          PUT (FT, "-56");
+          NEW_LINE (FT);
+          PUT (FT, "10E0");
+          NEW_LINE (FT);
+          PUT (FT, "10E-2X");
+          NEW_LINE (FT);
+          PUT (FT, "4E1__2");
+          NEW_LINE (FT);
+          PUT (FT, "1 0#99#");
+          NEW_LINE (FT);
+          PUT (FT, "1__0#99#");
+          NEW_LINE (FT);
+          PUT (FT, "10#9_9#");
+          NEW_LINE (FT);
+          PUT (FT, "10#9__9#");
+          NEW_LINE (FT);
+          PUT (FT, "10#9 9#");
+          NEW_LINE (FT);
+          PUT (FT, "16#E#E1");
+          NEW_LINE (FT);
+          PUT (FT, "2#110#E1_1");
+          NEW_LINE (FT);
+          PUT (FT, "2#110#E1__1");
+          CLOSE(FT);
+
+-- BEGIN TEST
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; " &
+                                    "TEXT OPEN WITH IN_FILE " &
+                                    "MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FT, X);
+          IF X /= 12345 THEN
+               FAILED ("GET WITH UNDERSCORE INCORRECT - (1)");
+          END IF;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X, 6);
+               FAILED ("DATA_ERROR NOT RAISED - (2)");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (2)");
+          END;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("DATA_ERROR NOT RAISED - (3)");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (3)");
+          END;
+
+          IF END_OF_LINE (FT) THEN
+               FAILED ("GET STOPPED AT END OF LINE - (3)");
+          ELSE
+               GET (FT, CH);
+               IF CH /= '_' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION - " &
+                            "(3): CHAR IS " & CH);
+               END IF;
+               GET (FT, CH);
+               IF CH /= '3' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION - " &
+                            "(3.5): CHAR IS " & CH);
+               END IF;
+          END IF;
+
+          SKIP_LINE (FT);
+          GET (FT, X);
+          IF X /= (-56) THEN
+               FAILED ("GET WITH GOOD CASE INCORRECT - (4)");
+          END IF;
+
+          SKIP_LINE (FT);
+          GET (FT, X, 4);
+          IF X /= 10 THEN
+               FAILED ("GET WITH ZERO EXPONENT INCORRECT - (5)");
+          END IF;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("DATA_ERROR NOT RAISED - (6)");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (6)");
+          END;
+
+          IF END_OF_LINE (FT) THEN
+               FAILED ("GET STOPPED AT END OF LINE - (6)");
+          ELSE
+               GET (FT, CH);
+               IF CH /= 'X' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION - " &
+                            "(6): CHAR IS " & CH);
+               END IF;
+          END IF;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("DATA_ERROR NOT RAISED - (7)");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (7)");
+          END;
+
+          IF END_OF_LINE (FT) THEN
+               FAILED ("GET STOPPED AT END OF LINE - (7)");
+          ELSE
+               GET (FT, CH);
+               IF CH /= '_' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION - " &
+                            "(7): CHAR IS " & CH);
+               END IF;
+               GET (FT, CH);
+               IF CH /= '2' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION - " &
+                            "(7.5): CHAR IS " & CH);
+               END IF;
+          END IF;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X, 7);
+               FAILED ("DATA_ERROR NOT RAISED - (8)");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (8)");
+          END;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("DATA_ERROR NOT RAISED - (9)");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (9)");
+          END;
+
+          IF END_OF_LINE (FT) THEN
+               FAILED ("GET STOPPED AT END OF LINE - (9)");
+          ELSE
+               GET (FT, CH);
+               IF CH /= '_' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION " &
+                            "- (9): CHAR IS " & CH);
+               END IF;
+               GET (FT, CH);
+               IF CH /= '0' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION " &
+                            "- (9.5): CHAR IS " & CH);
+               END IF;
+          END IF;
+
+          SKIP_LINE (FT);
+          GET (FT, X);
+          IF X /= 99 THEN
+               FAILED ("GET WITH UNDERSCORE IN " &
+                       "BASED LITERAL INCORRECT - (10)");
+          END IF;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("DATA_ERROR NOT RAISED - (11)");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (11)");
+          END;
+
+          IF END_OF_LINE (FT) THEN
+               FAILED ("GET STOPPED AT END OF LINE - (11)");
+          ELSE
+               GET (FT, CH);
+               IF CH /= '_' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION - " &
+                            "(11): CHAR IS " & CH);
+               END IF;
+               GET (FT, CH);
+               IF CH /= '9' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION - " &
+                            "(11.5): CHAR IS " & CH);
+               END IF;
+          END IF;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X, 6);
+               FAILED ("DATA_ERROR NOT RAISED - (12)");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (12)");
+          END;
+
+          SKIP_LINE (FT);
+          GET (FT, X, 7);
+          IF X /= 224 THEN
+               FAILED ("GET WITH GOOD CASE OF " &
+                       "BASED LITERAL INCORRECT - (13)");
+          END IF;
+
+          SKIP_LINE (FT);
+          GET (FT, X, 10);
+          IF X /= (6 * 2 ** 11) THEN
+               FAILED ("GET WITH UNDERSCORE IN EXPONENT" &
+                       "OF BASED LITERAL INCORRECT - (14)");
+          END IF;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("DATA_ERROR NOT RAISED - (15)");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - (15)");
+          END;
+
+          IF END_OF_LINE (FT) THEN
+               FAILED ("GET STOPPED AT END OF LINE - (15)");
+          ELSE
+               GET (FT, CH);
+               IF CH /= '_' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION - " &
+                            "(15): CHAR IS " & CH);
+               END IF;
+               GET (FT, CH);
+               IF CH /= '1' THEN
+                    FAILED ("GET STOPPED AT WRONG POSITION - " &
+                            "(15.5): CHAR IS " & CH);
+               END IF;
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3704F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704m.ada
new file mode 100644
index 000000000..2d6d3d4be
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704m.ada
@@ -0,0 +1,198 @@
+-- CE3704M.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 GET FOR INTEGER_IO RAISES DATA_ERROR WHEN
+--     THE INPUT CONTAINS
+--
+--     (1)  INTEGER_IO DECIMAL POINT
+--     (2)  INTEGER_IO LEADING OR TRAILING UNDERSCORES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     VKG 02/10/83
+--     CPP 07/30/84
+--     EG  05/22/85
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/11/87  REMOVED UNNECESSARY CODE, CORRECTED
+--                   EXCEPTION HANDLING, AND ADDED CASES WHICH
+--                   CHECK GET AT THE END_OF_FILE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3704M IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3704M", "CHECK THAT DATA_ERROR IS RAISED FOR " &
+                      "INTEGER_IO WHEN A DECIMAL POINT, OR " &
+                      "LEADING OR TRAILING UNDERSCORES " &
+                      "ARE DETECTED");
+
+     DECLARE
+          FT : FILE_TYPE;
+          CH : CHARACTER;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "3.14152");
+          NEW_LINE (FT);
+          PUT (FT, "2.15");
+          NEW_LINE (FT);
+          PUT (FT, "_312");
+          NEW_LINE (FT);
+          PUT (FT, "-312_");
+
+          CLOSE (FT);
+
+          DECLARE
+               PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER);
+               USE INT_IO;
+               X : INTEGER := 402;
+          BEGIN
+
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               BEGIN
+                    GET (FT, X, 3);
+                    FAILED ("DATA_ERROR NOT RAISED - (1)");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - (1)");
+               END;
+
+               IF END_OF_LINE (FT) THEN
+                    FAILED ("GET STOPPED AT END OF LINE - (1)");
+               ELSE
+                    GET (FT, CH);
+                    IF CH /= '4' THEN
+                         FAILED ("GET STOPPED AT WRONG " &
+                                 "POSITION - (1): CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    IF X /= 2 THEN
+                         FAILED ("WRONG VALUE READ - (2)");
+                    END IF;
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         FAILED ("DATA_ERROR RAISED - (2)");
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - (2)");
+               END;
+
+               IF END_OF_LINE (FT) THEN
+                    FAILED ("GET STOPPED AT END OF LINE - (2)");
+               ELSE
+                    GET (FT, CH);
+                    IF CH /= '.' THEN
+                         FAILED ("GET STOPPED AT WRONG " &
+                                 "POSITION - (2): CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - (3)");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - (3)");
+               END;
+
+               IF END_OF_LINE (FT) THEN
+                    FAILED ("GET STOPPED AT END OF LINE - (3)");
+               ELSE
+                    GET (FT, CH);
+                    IF CH /= '_' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION " &
+                                 "- (3): CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - (4)");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED - (4)");
+               END;
+
+               IF NOT END_OF_LINE (FT) THEN
+                    FAILED ("END_OF_LINE NOT TRUE AFTER (4)");
+               END IF;
+
+               BEGIN
+                    DELETE (FT);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3704M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704n.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704n.ada
new file mode 100644
index 000000000..656b45a96
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704n.ada
@@ -0,0 +1,229 @@
+-- CE3704N.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 GET FOR INTEGER_IO RAISES DATA_ERROR WHEN:
+--     (A) BASE LESS THAN 2 OR GREATER THAN 16
+--     (B) THE LETTERS IN BASE ARE OUT OF THE BASE RANGE
+--     (C) THERE IS NO CLOSING '#' SIGN FOR A BASED LITERAL
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     VKG 02/10/83
+--     SPS 03/16/83
+--     CPP 07/30/84
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/11/87  REMOVED UNNECESSARY CODE, CORRECTED
+--                   EXCEPTION HANDLING, AND CHECKED FOR
+--                   USE_ERROR ON DELETE.
+
+WITH TEXT_IO; USE TEXT_IO;
+WITH REPORT ; USE REPORT ;
+
+PROCEDURE CE3704N IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE3704N" ,"CHECK THAT DATA_ERROR IS RAISED WHEN " &
+                      "A BASED LITERAL DOES NOT HAVE ITS BASE " &
+                      "IN THE RANGE 2 .. 16, DIGIT IS OUTSIDE " &
+                      "THE BASE RANGE, OR THERE IS NO CLOSING " &
+                      "'#' SIGN");
+
+     DECLARE
+          FT : FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "1#0000#");
+          NEW_LINE (FT);
+          PUT (FT, "A#234567#");
+          NEW_LINE (FT);
+          PUT (FT, "17#123#1");
+          NEW_LINE (FT);
+          PUT (FT, "5#1253#2");
+          NEW_LINE (FT);
+          PUT (FT, "8#123");
+          CLOSE (FT);
+
+          DECLARE
+               PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER);
+               USE INT_IO;
+               X : INTEGER := 1003;
+               CH : CHARACTER;
+          BEGIN
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - (1)");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1003 THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - (1)");
+               END;
+
+               IF NOT END_OF_LINE (FT) THEN
+                    GET (FT, CH);
+                    FAILED ("GET STOPPED AT WRONG POSITION - " &
+                            "(1): CHAR IS " & CH);
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - (2)");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1003 THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - (2)");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - (2)");
+               END;
+
+               IF END_OF_LINE (FT) THEN
+                    FAILED ("GET STOPPED AT END OF LINE - (2)");
+               ELSE
+                    GET (FT, CH);
+                    IF CH /= 'A' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION " &
+                                 "- (2): CHAR IS " & CH);
+                         END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - (2A)");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1003 THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - (2A)");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - (2A)");
+               END;
+
+               IF NOT END_OF_LINE (FT) THEN
+                    GET (FT, CH);
+                    IF CH /= '1' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION " &
+                                 "- (2A): CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - (3)");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1003 THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - (3)");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - (3)");
+               END;
+
+               IF NOT END_OF_LINE (FT) THEN
+                    GET (FT, CH);
+                    IF CH /= '2' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION - " &
+                                 "(3): CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - (4)");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1003 THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - (4)");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - (4)");
+               END;
+
+               IF NOT END_OF_LINE (FT) THEN
+                    GET (FT, CH);
+                    IF CH /= ' ' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION " &
+                                 "- (4): CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3704N;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704o.ada
new file mode 100644
index 000000000..f38b1e9b7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3704o.ada
@@ -0,0 +1,161 @@
+-- CE3704O.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 GET WILL RAISE DATA_ERROR IF THE USE OF # AND :
+--     IN BASED LITERALS IS MIXED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     VKG 02/10/83
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/11/87  REMOVED UNNECESSARY CODE AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+WITH TEXT_IO; USE TEXT_IO;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CE3704O IS
+
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE3704O", "CHECK THAT MIXED USE OF # AND : " &
+                      "IN BASED LITERALS WILL RAISE DATA_ERROR");
+
+     DECLARE
+          FT : FILE_TYPE;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+
+          PUT_LINE (FT, "8#77#E+1");
+          PUT_LINE (FT, "2:110:");
+          PUT (FT, "2#11:");
+          NEW_LINE (FT);
+          PUT (FT, "4:223#");
+          NEW_LINE (FT);
+          CLOSE (FT);
+
+
+          DECLARE
+               PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER);
+               USE INT_IO;
+               X : INTEGER := 100;
+               CH : CHARACTER;
+          BEGIN
+
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               GET (FT, X);
+               IF X /= 8#77#E+1 THEN
+                    FAILED ("INCORRECT VALUE - 1");
+               END IF;
+
+               GET (FT, X);
+               IF X /= 2#110# THEN
+                    FAILED ("INCORRECT VALUE - 2");
+               END IF;
+
+               BEGIN
+                    X := 100;
+                    GET (FT,X);
+                    FAILED ("DATA_ERROR NOT RAISED - 1");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 100 THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 1");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED");
+               END;
+
+               IF NOT END_OF_LINE (FT) THEN
+                    GET (FT, CH);
+                    IF CH /= ':' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION - 1");
+                    END IF;
+               END IF;
+
+               BEGIN
+                    X := 100;
+                    GET (FT,X);
+                    FAILED ("DATA_ERROR NOT RAISED - 2");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 100 THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 2");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 2");
+               END;
+
+               IF NOT END_OF_LINE (FT) THEN
+                    GET (FT, CH);
+                         IF CH /='#' THEN
+                              FAILED ("GET STOPPED AT WRONG " &
+                                      "POSITION - 1");
+                         END IF;
+               END IF;
+
+               BEGIN
+                    DELETE (FT);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+     RESULT;
+
+END CE3704O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705a.ada
new file mode 100644
index 000000000..8cd848e4c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705a.ada
@@ -0,0 +1,109 @@
+-- CE3705A.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:
+--     FOR GET FROM A FILE, CHECK THAT IF ONLY THE FILE TERMINATOR
+--     REMAINS TO BE READ, THEN ANY CALL TO GET FOR AN INTEGER (EVEN
+--     WITH WIDTH = 0) RAISES END_ERROR.
+
+-- HISTORY:
+--     BCB 10/28/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3705A IS
+
+     FILE : FILE_TYPE;
+
+     INCOMPLETE : EXCEPTION;
+
+     I : INTEGER;
+
+     PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER); USE INT_IO;
+
+BEGIN
+     TEST ("CE3705A", "FOR GET FROM A FILE, CHECK THAT IF ONLY THE " &
+                      "FILE TERMINATOR REMAINS TO BE READ, THEN ANY " &
+                      "CALL TO GET FOR AN INTEGER (EVEN WITH WIDTH = " &
+                      "0) RAISES END_ERROR");
+
+     BEGIN
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE, 3);
+
+          CLOSE (FILE);
+
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+
+          GET (FILE, I);
+
+          BEGIN
+               GET (FILE, I);
+               FAILED ("END_ERROR NOT RAISED - 1");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               GET (FILE, I, WIDTH => 0);
+               FAILED ("END_ERROR NOT RAISED - 2");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("OTHER EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+END CE3705A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705b.ada
new file mode 100644
index 000000000..a0357e366
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705b.ada
@@ -0,0 +1,144 @@
+-- CE3705B.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:
+--     IF WIDTH IS ZERO, CHECK THAT END_ERROR IS RAISED IF THE ONLY
+--     REMAINING CHARACTERS IN THE FILE CONSIST OF LINE TERMINATORS,
+--     PAGE TERMINATORS, SPACES, AND HORIZONTAL TABULATION CHARACTERS.
+--     AFTER END_ERROR IS RAISED, THE FILE SHOULD BE POSITIONED BEFORE
+--     THE FILE TERMINATOR AND END_OF_FILE SHOULD BE TRUE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS THAT SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 07/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3705B IS
+
+     PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
+     USE IIO;
+
+     FILE : FILE_TYPE;
+     ITEM : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3705B", "IF WIDTH IS ZERO, CHECK THAT END_ERROR IS " &
+                      "RAISED IF THE ONLY REMAINING CHARACTERS IN " &
+                      "THE FILE CONSIST OF LINE TERMINATORS, PAGE " &
+                      "TERMINATORS, SPACES, AND HORIZONTAL TAB " &
+                      "CHARACTERS. AFTER END_ERROR IS RAISED, THE " &
+                      "FILE SHOULD BE POSITIONED BEFORE THE FILE " &
+                      "TERMINATOR AND END_OF_FILE SHOULD BE TRUE");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE, 2);
+          NEW_LINE (FILE);
+          PUT (FILE, 3);
+          NEW_LINE (FILE);
+          NEW_PAGE (FILE);
+          PUT (FILE, ASCII.HT);
+          NEW_LINE (FILE);
+          NEW_LINE (FILE);
+          NEW_PAGE (FILE);
+          PUT (FILE, ' ');
+          PUT (FILE, ASCII.HT);
+          PUT (FILE, ' ');
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                                    "MODE IN_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FILE, ITEM);
+          IF ITEM /= 2 THEN
+               FAILED ("INCORRECT VALUE READ - 1");
+          END IF;
+
+          GET (FILE, ITEM);
+          IF ITEM /= 3 THEN
+               FAILED ("INCORRECT VALUE READ - 2");
+          END IF;
+
+          BEGIN
+               GET (FILE, ITEM, WIDTH => 0);
+               FAILED ("END_ERROR NOT RAISED FOR GET");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
+          END;
+
+          IF NOT END_OF_FILE(FILE) THEN
+               FAILED ("END_OF_FILE NOT TRUE AFTER RAISING EXCEPTION");
+          END IF;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3705B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705c.ada
new file mode 100644
index 000000000..a9706da39
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705c.ada
@@ -0,0 +1,137 @@
+-- CE3705C.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 LAST CHARACTER IN A FILE MAY BE READ WITHOUT
+--     RAISING END_ERROR, AND THAT AFTER THE LAST CHARACTER OF THE
+--     FILE HAS BEEN READ, ANY ATTEMPT TO READ FURTHER CHARACTERS
+--     WILL RAISE END_ERROR.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 07/18/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3705C IS
+
+     PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
+     USE IIO;
+
+     FILE : FILE_TYPE;
+     ITEM : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3705C", "CHECK THAT THE LAST CHARACTER IN A FILE MAY " &
+                      "BE READ WITHOUT RAISING END_ERROR, AND THAT " &
+                      "AFTER THE LAST CHARACTER OF THE FILE HAS BEEN " &
+                      "READ, ANY ATTEMPT TO READ FURTHER CHARACTERS " &
+                      "WILL RAISE END_ERROR");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+
+          PUT (FILE, 2);
+          PUT (FILE, 3);
+          NEW_LINE (FILE);
+          NEW_PAGE (FILE);
+          PUT (FILE, 5);
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                                    "MODE IN_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FILE, ITEM);
+          GET (FILE, ITEM);
+
+          BEGIN
+               GET (FILE, ITEM);
+               IF ITEM /= 5 THEN
+                    FAILED ("INCORRECT VALUE READ");
+               END IF;
+               BEGIN
+                    GET (FILE, ITEM);
+                    FAILED ("END_ERROR NOT RAISED AFTER LAST " &
+                            "CHARACTER OF FILE HAS BEEN READ");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
+               END;
+          EXCEPTION
+               WHEN END_ERROR =>
+                    FAILED ("END_ERROR RAISED WHEN READING LAST " &
+                            "CHARACTER OF FILE");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON GET - 2");
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3705C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705d.ada
new file mode 100644
index 000000000..b9af594df
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705d.ada
@@ -0,0 +1,124 @@
+-- CE3705D.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 DATA_ERROR, NOT END_ERROR, IS RAISED WHEN WIDTH > 0,
+--     FEWER THAN WIDTH CHARACTERS REMAIN IN THE FILE, A BASED LITERAL
+--     IS BEING READ, AND THE CLOSING # OR : HAS NOT YET BEEN FOUND.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 07/19/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3705D IS
+
+     PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
+     USE IIO;
+
+     FILE : FILE_TYPE;
+     ITEM : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3705D", "CHECK THAT DATA_ERROR, NOT END_ERROR, IS " &
+                      "RAISED WHEN WIDTH > 0, FEWER THAN WIDTH " &
+                      "CHARACTERS REMAIN IN THE FILE, A BASED " &
+                      "LITERAL IS BEING READ, AND THE CLOSING # " &
+                      "OR : HAS NOT YET BEEN FOUND");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE, "2#1111_1111#");
+          NEW_LINE (FILE);
+          PUT (FILE, "16#FFF");
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN " &
+                                    "WITH MODE IN_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FILE, ITEM);
+          IF ITEM /= 255 THEN
+               FAILED ("INCORRECT VALUE READ");
+          END IF;
+
+          BEGIN
+               GET (FILE, ITEM, WIDTH => 7);
+               FAILED ("DATA_ERROR NOT RAISED");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    FAILED ("END_ERROR INSTEAD OF DATA_ERROR RAISED");
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3705D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705e.ada
new file mode 100644
index 000000000..22798b534
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3705e.ada
@@ -0,0 +1,124 @@
+-- CE3705E.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 DATA_ERROR, NOT END_ERROR, IS RAISED WHEN FEWER THAN
+--     WIDTH CHARACTERS REMAIN IN THE FILE, AND THE REMAINING CHARACTERS
+--     SATISFY THE SYNTAX FOR A REAL LITERAL.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 07/20/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3705E IS
+
+     PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
+     USE IIO;
+
+     FILE : FILE_TYPE;
+     ITEM : INTEGER;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3705E", "CHECK THAT DATA_ERROR, NOT END_ERROR, IS " &
+                      "RAISED WHEN FEWER THAN WIDTH CHARACTERS " &
+                      "REMAIN IN THE FILE, AND THE REMAINING " &
+                      "CHARACTERS SATISFY THE SYNTAX FOR A REAL " &
+                      "LITERAL");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE, "16#FFF#");
+          NEW_LINE (FILE);
+          PUT (FILE, "3.14159_26");
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN " &
+                                    "WITH MODE IN_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FILE, ITEM);
+          IF ITEM /= 4095 THEN
+               FAILED ("INCORRECT VALUE READ");
+          END IF;
+
+          BEGIN
+               GET (FILE, ITEM, WIDTH => 11);
+               FAILED ("DATA_ERROR NOT RAISED");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    FAILED ("END_ERROR INSTEAD OF DATA_ERROR RAISED");
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
+          END;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3705E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706c.ada
new file mode 100644
index 000000000..b7cdd1626
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706c.ada
@@ -0,0 +1,164 @@
+-- CE3706C.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 INTEGER_IO PUT RAISES CONSTRAINT_ERROR IF:
+--        A) THE BASE IS OUTSIDE THE RANGE 2..16.
+--        B) THE VALUE OF WIDTH IS NEGATIVE OR GREATER THAN FIELD'LAST,
+--           WHEN FIELD'LAST < INTEGER'LAST.
+--        C) THE VALUE OF ITEM IS OUTSIDE THE RANGE OF THE INSTANTIATED
+--           TYPE.
+
+-- HISTORY:
+--     SPS 10/05/82
+--     JBG 08/30/83
+--     JLH 09/10/87  ADDED CASES FOR THE VALUE OF THE WIDTH BEING LESS
+--                   THAN ZERO AND GREATER THAN FIELD'LAST AND CASES FOR
+--                   THE VALUE OF ITEM OUTSIDE THE RANGE OF THE
+--                   INSTANTIATED TYPE.
+--     JRL 06/07/96  Added call to Ident_Int in expressions involving
+--                   Field'Last, to make the expressions non-static and
+--                   prevent compile-time rejection.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3706C IS
+BEGIN
+
+     TEST ("CE3706C", "CHECK THAT INTEGER_IO PUT RAISES CONSTRAINT " &
+                      "ERROR APPROPRIATELY");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE INT IS NEW INTEGER RANGE 1 .. 10;
+          PACKAGE IIO IS NEW INTEGER_IO (INT);
+          USE IIO;
+          ST : STRING (1 .. 10);
+     BEGIN
+
+          BEGIN
+               PUT (FT, 2, 6, 1);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - FILE - 1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FILE - 1");
+          END;
+
+          BEGIN
+               PUT (3, 4, 17);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - DEFAULT - 1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - DEFAULT - 1");
+          END;
+
+          BEGIN
+               PUT (TO => ST, ITEM => 4, BASE => -3);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - STRING - 1");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - STRING - 1");
+          END;
+
+          BEGIN
+               PUT (ST, 5, 17);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - STRING - 2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - STRING - 2");
+          END;
+
+          BEGIN
+               PUT (FT, 5, -1);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - FILE - 2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FILE - 2");
+          END;
+
+          BEGIN
+               PUT (7, -3);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - DEFAULT - " &
+                       "2");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - DEFAULT - 2");
+          END;
+
+          IF FIELD'LAST < INTEGER'LAST THEN
+               BEGIN
+                    PUT (7, FIELD'LAST+Ident_Int(1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED FOR WIDTH " &
+                            "GREATER THAN FIELD'LAST");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED FOR WIDTH " &
+                                 "GREATER THAN FIELD'LAST");
+               END;
+
+          END IF;
+
+          BEGIN
+               PUT (FT, 11);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
+                       "RANGE - FILE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
+                            "RANGE - FILE");
+          END;
+
+          BEGIN
+               PUT (11);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
+                       "RANGE - DEFAULT");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
+                            "RANGE - DEFAULT");
+          END;
+
+     END;
+
+     RESULT;
+END CE3706C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706d.ada
new file mode 100644
index 000000000..3696af3e7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706d.ada
@@ -0,0 +1,127 @@
+-- CE3706D.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 INTEGER_IO PUT RAISES MODE_ERROR FOR FILES OF MODE
+--     IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/05/82
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/10/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
+--                   CODE, AND CORRECTED EXCEPTION HANDLING.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3706D IS
+
+BEGIN
+
+     TEST ("CE3706D", "CHECK THAT INTEGER_IO PUT RAISES MODE_ERROR " &
+                      "FOR FILES OF MODE IN_FILE");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE INT IS NEW INTEGER RANGE 1 .. 30;
+          PACKAGE IIO IS NEW INTEGER_IO (INT);
+          USE IIO;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+
+          BEGIN
+               PUT (STANDARD_INPUT, 26);
+               FAILED ("MODE_ERROR NOT RAISED - STANDARD_INPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - STANDARD_INPUT");
+          END;
+
+          BEGIN
+               PUT (CURRENT_INPUT, 26);
+               FAILED ("MODE_ERROR NOT RAISED - CURRENT_INPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CURRENT_INPUT");
+          END;
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, 'A');
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               PUT (FT, 26);
+               FAILED ("MODE_ERROR NOT RAISED - FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FILE");
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3706D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706f.ada
new file mode 100644
index 000000000..833332e3a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706f.ada
@@ -0,0 +1,119 @@
+-- CE3706F.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 INTEGER_IO PUT RAISES LAYOUT_ERROR WHEN THE NUMBER OF
+--     CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH.  CHECK
+--     THAT IT IS NOT RAISED WHEN THE NUMBER OF CHARACTERS TO BE OUTPUT
+--     ADDED TO THE CURRENT COLUMN NUMBER EXCEEDS THE MAXIMUM LINE
+--     LENGTH.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
+
+-- HISTORY:
+--     SPS 10/05/82
+--     VKG 01/14/83
+--     SPS 02/18/83
+--     JBG 08/30/83
+--     EG  05/22/85
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/10/87  REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION
+--                   HANDLING, AND ADDED CASE USING WIDTH OF FIVE.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3706F IS
+
+BEGIN
+
+     TEST ("CE3706F", "CHECK THAT LAYOUT_ERROR IS RAISED CORRECTLY");
+
+     DECLARE
+          FT : FILE_TYPE;
+          PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
+          USE IIO;
+          INCOMPLETE : EXCEPTION;
+     BEGIN
+
+          BEGIN
+               CREATE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "FOR TEMPORARY FILE WITH " &
+                                    "OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_LINE_LENGTH (FT, 4);
+
+          BEGIN
+               PUT (FT, 32_000, WIDTH => 0);
+               FAILED ("LAYOUT_ERROR NOT RAISED - 1");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               PUT (FT, 32_000, WIDTH => 5);
+               FAILED ("LAYOUT_ERROR NOT RAISED - 2");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 2");
+          END;
+
+          PUT (FT, 123, WIDTH => 0);  -- "123"
+
+          BEGIN
+               PUT (FT, 457, WIDTH => 0);  -- "123#457"
+               IF LINE (FT) /= 2 THEN
+                    FAILED ("OUTPUT INCORRECT");
+               END IF;
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED INCORRECTLY");
+          END;
+
+          CHECK_FILE (FT, "123#457#@%");
+
+          CLOSE (FT);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3706F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706g.ada
new file mode 100644
index 000000000..705c215ec
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3706g.ada
@@ -0,0 +1,111 @@
+-- CE3706G.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 INTEGER_IO PUT USES THE MINIMUM FIELD REQUIRED IF
+--     WIDTH IS TOO SMALL AND THE LINE LENGTH IS SUFFICIENTLY LARGE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/05/82
+--     JLH 09/17/87  COMPLETELY REVISED TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3706G IS
+
+BEGIN
+
+     TEST ("CE3706G", "CHECK THAT INTEGER_IO PUT USES THE MINIMUM " &
+                      "FIELD REQUIRED IF WIDTH IS TOO SMALL AND THE " &
+                      "LINE LENGTH IS SUFFICIENTLY LARGE");
+
+     DECLARE
+          FILE : FILE_TYPE;
+          PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
+          USE IIO;
+          INCOMPLETE : EXCEPTION;
+          NUM : INTEGER := 12345;
+          CH : CHARACTER;
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE, NUM, WIDTH => 3);
+          TEXT_IO.PUT (FILE, ' ');
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FILE, NUM);
+          GET (FILE, CH);
+          IF CH /= ' ' AND COL(FILE) /= 7 THEN
+               FAILED ("INTEGER_IO PUT DOES NOT USE MINIMUM FIELD " &
+                       "REQUIRED WHEN WIDTH IS TOO SMALL");
+          END IF;
+
+          IF NUM /= 12345 THEN
+               FAILED ("INCORREC VALUE READ");
+          END IF;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3706G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3707a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3707a.ada
new file mode 100644
index 000000000..a338fbf8d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3707a.ada
@@ -0,0 +1,130 @@
+-- CE3707A.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 INTEGER_IO GET CAN READ A VALUE FROM A STRING.  CHECK
+--     THAT IT TREATS THE END OF THE STRING AS A FILE TERMINATOR.  CHECK
+--     THAT LAST CONTAINS THE INDEX VALUE OF THE LAST CHARACTER READ
+--     FROM THE STRING.
+
+-- HISTORY:
+--     SPS 10/05/82
+--     VKG 01/13/83
+--     JLH 09/11/87  CORRECTED EXCEPTION HANDLING.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3707A IS
+
+     PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
+     USE IIO;
+     X : INTEGER;
+     L : POSITIVE;
+     STR : STRING(1..6) := "123456" ;
+
+BEGIN
+
+     TEST ("CE3707A", "CHECK THAT INTEGER_IO GET OPERATES CORRECTLY " &
+                      "ON STRINGS");
+
+-- LEFT JUSTIFIED STRING NON NULL
+
+     GET ("2362  ", X, L);
+     IF X /= 2362 THEN
+          FAILED ("VALUE FROM STRING INCORRECT - 1");
+     END IF;
+
+     IF L /= 4 THEN
+          FAILED ("VALUE OF LAST INCORRECT - 1");
+     END IF;
+
+-- STRING LITERAL WITH BLANKS
+
+     BEGIN
+          GET ("  ", X, L);
+          FAILED ("END_ERROR NOT RAISED - 2");
+     EXCEPTION
+          WHEN END_ERROR =>
+               IF L /= 4 THEN
+                    FAILED ("AFTER END ERROR VALUE OF LAST " &
+                            "INCORRECT - 2");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("WRONG EXCEPTION RAISED - 2");
+     END;
+
+-- NULL STRING
+
+     BEGIN
+          GET ("", X, L);
+          FAILED (" END_ERROR NOT RAISED - 3");
+     EXCEPTION
+          WHEN END_ERROR =>
+               IF L /= 4 THEN
+                    FAILED ("AFTER END_ERROR VALUE OF LAST " &
+                            "INCORRECT - 3");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("SOME EXCEPTION RAISED - 3");
+     END;
+
+-- NULL SLICE
+
+     BEGIN
+          GET(STR(5..IDENT_INT(2)), X, L);
+          FAILED ("END_ERROR NOT RAISED - 4");
+     EXCEPTION
+          WHEN END_ERROR =>
+               IF L /= 4 THEN
+                    FAILED ("AFTER END_ERROR VALUE OF LAST " &
+                            "INCORRECT - 4");
+               END IF;
+          WHEN OTHERS =>
+               FAILED ("SOME EXCEPTION RAISED - 4");
+     END;
+
+-- NON-NULL SLICE
+
+     GET (STR(2..3), X, L);
+     IF X /= 23 THEN
+           FAILED ("INTEGER VALUE INCORRECT - 5");
+     END IF;
+     IF L /= 3 THEN
+          FAILED ("LAST INCORRECT FOR SLICE - 5");
+     END IF;
+
+-- RIGHT JUSTIFIED NEGATIVE NUMBER
+
+     GET("   -2345",X,L);
+     IF X /= -2345 THEN
+          FAILED ("INTEGER VALUE INCORRECT - 6");
+     END IF;
+     IF L /= 8 THEN
+          FAILED ("LAST INCORRECT FOR NEGATIVE NUMBER - 6");
+     END IF;
+
+     RESULT;
+
+END CE3707A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3708a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3708a.ada
new file mode 100644
index 000000000..104bc20c7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3708a.ada
@@ -0,0 +1,87 @@
+-- CE3708A.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 INTEGER_IO PUT RAISES LAYOUT_ERROR WHEN THE MINIMUM
+--     WIDTH REQUIRED FOR THE OUTPUT VALUE IS GREATER THAN THE LENGTH
+--     OF THE STRING.  ALSO CHECK THAT INTEGER_IO PUT PADS THE OUTPUT
+--     ON THE LEFT WITH SPACES IF THE LENGTH OF THE STRING IS GREATER
+--     THAN THE MINIMUM WIDTH REQUIRED.
+
+-- HISTORY:
+--     SPS 10/05/82
+--     CPP 07/30/84
+--     JLH 09/11/87  ADDED CASES FOR PADDING OF OUTPUT STRING.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3708A IS
+BEGIN
+
+     TEST ("CE3708A", "CHECK THAT INTEGER_IO PUT RAISES LAYOUT_ERROR " &
+                      "WHEN THE MINIMUM WIDTH REQUIRED FOR THE " &
+                      "OUTPUT VALUE IS GREATER THAN THE LENGTH OF " &
+                      "THE STRING.  ALSO CHECK THAT INTEGER_IO PUT " &
+                      "PADS THE OUTPUT ON THE LEFT WITH SPACES IF " &
+                      "THE LENGTH OF THE STRING IS GREATER THAN THE " &
+                      "MINIMUM WIDTH REQUIRED.");
+
+     DECLARE
+          PACKAGE IIO IS NEW INTEGER_IO (INTEGER);
+          USE IIO;
+          ST1 : STRING (1 .. 4);
+          ST2 : STRING (1 .. 4);
+          ST : STRING (1 .. 4) := "6382";
+     BEGIN
+          PUT (ST1, IDENT_INT(6382));
+          IF ST1 /= ST THEN
+               FAILED ("PUT TO STRING INCORRECT");
+          END IF;
+
+          BEGIN
+               PUT (ST2, IDENT_INT(12345));
+               FAILED ("LAYOUT_ERROR NOT RAISED");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED");
+          END;
+
+          PUT (ST1, IDENT_INT(123));
+          IF ST1 /= " 123" THEN
+               FAILED ("PUT DID NOT PAD WITH BLANKS - 1");
+          END IF;
+
+          PUT (ST2, IDENT_INT(-2));
+          IF ST2 /= "  -2" THEN
+               FAILED ("PUT DID NOT PAD WITH BLANKS - 2");
+          END IF;
+
+     END;
+
+     RESULT;
+
+END CE3708A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3801a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3801a.ada
new file mode 100644
index 000000000..027093632
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3801a.ada
@@ -0,0 +1,112 @@
+-- CE3801A.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 EACH FLOAT_IO OPERATION RAISES STATUS_ERROR WHEN
+--     CALLED WITH A FILE PARAMETER DESIGNATING AN UN-OPEN FILE.
+
+-- HISTORY:
+--     SPS 09/07/82
+--     SPS 12/22/82
+--     DWC 09/11/87  CORRECTED EXCEPTION HANDLING AND REVISED IFS
+--                   TO CHECK FOR CASE WHEN VALUE IS NEGATIVE OF
+--                   WHAT IS EXPECTED.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3801A IS
+BEGIN
+
+     TEST ("CE3801A", "CHECK THAT EACH FLOAT_IO AND FIXED_IO " &
+                      "OPERATION RAISES STATUS_ERROR WHEN CALLED " &
+                      "WITH A FILE PARAMETER DESIGNATING AN " &
+                      "UN-OPEN FILE");
+
+     DECLARE
+          TYPE FLT IS NEW FLOAT RANGE 1.0 .. 10.0;
+          PACKAGE FLT_IO IS NEW FLOAT_IO (FLT);
+          USE FLT_IO;
+          X : FLT := FLT'FIRST;
+          FT : FILE_TYPE;
+     BEGIN
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("STATUS_ERROR NOT RAISED - GET FLOAT_IO - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET " &
+                            "FLOAT_IO - 1");
+          END;
+
+          BEGIN
+               PUT (FT, X);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT FLOAT_IO - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT " &
+                            "FLOAT_IO - 1");
+          END;
+
+          BEGIN
+               CREATE (FT, OUT_FILE);    -- THIS IS JUST AN ATTEMPT
+               CLOSE (FT);               -- TO CREATE A FILE.
+          EXCEPTION                      -- OBJECTIVE MET EITHER WAY.
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("STATUS_ERROR NOT RAISED - GET FLOAT_IO - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET " &
+                            "FLOAT_IO - 2");
+          END;
+
+          BEGIN
+               PUT (FT, X);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT FLOAT_IO - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT " &
+                            "FLOAT_IO - 2");
+          END;
+     END;
+
+     RESULT;
+
+END CE3801A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3801b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3801b.ada
new file mode 100644
index 000000000..1eb3a8e7a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3801b.ada
@@ -0,0 +1,108 @@
+-- CE3801B.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 EACH FIXED_IO OPERATION RAISES STATUS_ERROR
+--     WHEN CALLED WITH A FILE PARAMETER DESIGNATING AN UN-OPEN FILE.
+
+-- HISTORY:
+--     DWC 09/11/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3801B IS
+BEGIN
+
+     TEST ("CE3801B", "CHECK THAT EACH FIXED_IO " &
+                      "OPERATION RAISES STATUS_ERROR WHEN CALLED " &
+                      "WITH A FILE PARAMETER DESIGNATING AN " &
+                      "UN-OPEN FILE");
+
+     DECLARE
+          TYPE FIX IS DELTA 0.1 RANGE 1.0 .. 10.0;
+          PACKAGE FIX_IO IS NEW FIXED_IO (FIX);
+          USE FIX_IO;
+          X : FIX := FIX'LAST;
+          FT : FILE_TYPE;
+
+     BEGIN
+          BEGIN
+               GET (FT, X);
+               FAILED ("STATUS_ERROR NOT RAISED - GET FIXED_IO - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET " &
+                            "FIXED_IO - 1");
+          END;
+
+          BEGIN
+               PUT (FT, X);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT FIXED_IO - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT " &
+                            "FIXED_IO - 1");
+          END;
+
+          BEGIN
+               CREATE (FT, OUT_FILE);   -- THIS IS JUST AN ATTEMPT TO
+               CLOSE (FT);              -- CREATE A FILE.  OBJECTIVE
+          EXCEPTION                     -- IS MET EITHER WAY.
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("STATUS_ERROR NOT RAISED - GET FIXED_IO - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET " &
+                            "FIXED_IO - 2");
+          END;
+
+          BEGIN
+               PUT (FT, X);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT FIXED_IO - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT " &
+                            "FIXED_IO - 2");
+          END;
+     END;
+
+     RESULT;
+
+END CE3801B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804a.ada
new file mode 100644
index 000000000..c05a1ff1a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804a.ada
@@ -0,0 +1,157 @@
+-- CE3804A.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 GET FOR FLOAT_IO READS A PLUS OR MINUS SIGN
+--     IF PRESENT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/07/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/11/87  CORRECTED EXCEPTION HANDLING AND REVISED IFS
+--                   TO CHECK FOR CASE WHEN VALUE IS NEGATIVE OF WHAT
+--                   IS EXPECTED.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804A", "CHECK THAT GET FOR FLOAT_IO READS A PLUS OR " &
+                      "MINUS SIGN IF PRESENT");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE FL IS NEW FLOAT RANGE -3.0 .. 3.0;
+          X : FL;
+          ST1 : CONSTANT STRING := IDENT_STR ("-3.0");
+          ST2 : CONSTANT STRING := IDENT_STR ("+2.0");
+          ST3 : CONSTANT STRING := IDENT_STR ("1.0");
+     BEGIN
+
+-- CREATE AND INITIALIZE DATA FILE
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, ST1);
+          NEW_LINE(FT);
+          PUT (FT, ST2);
+          NEW_LINE(FT);
+          PUT (FT, ST3);
+          NEW_LINE(FT);
+          CLOSE (FT);
+
+-- BEGIN TEST
+
+          DECLARE
+               PACKAGE FL_IO IS NEW FLOAT_IO (FL);
+               USE FL_IO;
+               LST : POSITIVE;
+          BEGIN
+
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               GET (FT, X);
+               IF X = 3.0 THEN
+                    FAILED ("MINUS SIGN NOT READ - 1");
+               ELSIF X /= -3.0 THEN
+                    FAILED ("INCORRECT VALUE READ - 1");
+               END IF;
+
+               GET (FT, X);
+               IF X = -2.0 THEN
+                    FAILED ("PLUS SIGN NOT READ - 2");
+               ELSIF X /= +2.0 THEN
+                    FAILED ("INCORRECT VALUE READ - 2");
+               END IF;
+
+               GET (FT, X);
+               IF X /= 1.0 THEN
+                    FAILED ("INCORRECT VALUE READ - 3");
+               END IF;
+
+               GET (ST1, X, LST);
+               IF X = 3.0 THEN
+                    FAILED ("MINUS SIGN NOT READ - 4");
+               ELSIF X /= -3.0 THEN
+                    FAILED ("INCORRECT VALUE READ - 4");
+               END IF;
+
+               GET (ST2, X, LST);
+               IF X = -2.0 THEN
+                    FAILED ("PLUS SIGN NOT READ - 5");
+               ELSIF X /= +2.0 THEN
+                    FAILED ("INCORRECT VALUE READ - 5");
+               END IF;
+
+               GET (ST3, X, LST);
+               IF X /= 1.0 THEN
+                    FAILED ("INCORRECT VALUE READ - 6");
+               END IF;
+
+               BEGIN
+                    DELETE (FT);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804b.ada
new file mode 100644
index 000000000..c677d7ea3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804b.ada
@@ -0,0 +1,147 @@
+-- CE3804B.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 GET FOR FIXED_IO READS A PLUS OR MINUS SIGN IF
+--     PRESENT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/07/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/11/87  CORRECTED EXCEPTION HANDLING AND REVISED IFS
+--                   TO CHECK FOR CASE WHEN VALUE IS NEGATIVE OF
+--                   WHAT IS EXPECTED.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804B IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804B", "CHECK THAT GET FOR FIXED_IO READS A PLUS OR " &
+                      "MINUS SIGN IF PRESENT");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE FIX IS DELTA 0.01 RANGE -3.0 .. 3.0;
+          X : FIX;
+          ST1 : CONSTANT STRING := IDENT_STR("-3.0");
+          ST2 : CONSTANT STRING := IDENT_STR("+2.0");
+          ST3 : CONSTANT STRING := IDENT_STR("1.0");
+     BEGIN
+
+-- CREATE AND INITIALIZE DATA FILE
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, ST1);
+          NEW_LINE(FT);
+          PUT (FT, ST2);
+          NEW_LINE(FT);
+          PUT (FT, ST3);
+          NEW_LINE(FT);
+          CLOSE (FT);
+
+          DECLARE
+               PACKAGE FIX_IO IS NEW FIXED_IO (FIX);
+               USE FIX_IO;
+               LST : POSITIVE;
+          BEGIN
+
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               GET (FT, X);
+               IF X /= -3.0 THEN
+                    FAILED ("MINUS SIGN NOT READ - 1");
+               END IF;
+
+               GET (FT, X);
+               IF X /= +2.0 THEN
+                    FAILED ("PLUS SIGN NOT READ - 2");
+               END IF;
+
+               GET (FT, X);
+               IF X /= 1.0 THEN
+                    FAILED ("INCORRECT VALUE READ - 3");
+               END IF;
+
+               GET (ST1, X, LST);
+               IF X /= -3.0 THEN
+                    FAILED ("MINUS SIGN NOT READ - 4");
+               END IF;
+
+               GET (ST2, X, LST);
+               IF X /= +2.0 THEN
+                    FAILED ("PLUS SIGN NOT READ - 5");
+               END IF;
+
+               GET (ST3, X, LST);
+               IF X /= 1.0 THEN
+                    FAILED ("INCORRECT VALUE READ - 6");
+               END IF;
+
+               BEGIN
+                    DELETE (FT);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804c.ada
new file mode 100644
index 000000000..b2be751cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804c.ada
@@ -0,0 +1,121 @@
+-- CE3804C.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:
+--     CHECK THAT GET FOR FLOAT_IO RAISES MODE_ERROR WHEN THE
+--     MODE IS NOT IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/07/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/11/87  SPLIT CASE FOR FIXED_IO INTO CE3804O.ADA
+--                   AND CORRECTED EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804C IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804C", "CHECK THAT GET FOR FLOAT_IO RAISES " &
+                      "MODE_ERROR WHEN THE MODE IS NOT IN_FILE");
+
+     DECLARE
+          FT2 : FILE_TYPE;
+     BEGIN
+
+          BEGIN
+               CREATE (FT2, OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "FOR TEMP FILES WITH OUT_FILE " &
+                                    "MODE - 1");
+                    RAISE INCOMPLETE;
+          END;
+
+          DECLARE
+               PACKAGE FL_IO IS NEW FLOAT_IO (FLOAT);
+               USE FL_IO;
+               X : FLOAT;
+          BEGIN
+
+               BEGIN
+                    GET (FT2, X);
+                    FAILED ("MODE_ERROR NOT RAISED - FLOAT " &
+                            "UN-NAMED FILE");
+               EXCEPTION
+                    WHEN MODE_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FLOAT UN-NAMED FILE");
+               END;
+
+               BEGIN
+                    GET (STANDARD_OUTPUT, X);
+                    FAILED ("MODE_ERROR NOT RAISED - FLOAT " &
+                            "STANDARD_OUTPUT");
+               EXCEPTION
+                    WHEN MODE_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FLOAT STANDARD_OUTPUT");
+               END;
+
+               BEGIN
+                    GET (CURRENT_OUTPUT, X);
+                    FAILED ("MODE_ERROR NOT RAISED - FLOAT " &
+                            "CURRENT_OUTPUT");
+               EXCEPTION
+                    WHEN MODE_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FLOAT CURRENT_OUTPUT");
+               END;
+
+          END;
+
+          CLOSE (FT2);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804d.ada
new file mode 100644
index 000000000..5187f8ff7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804d.ada
@@ -0,0 +1,153 @@
+-- CE3804D.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 FLOAT_IO GET RAISES DATA_ERROR WHEN THE DATA
+--     READ IS OUT-OF-RANGE.  CHECK THAT ITEM IS LEFT UNAFFECTED
+--     AND THAT READING MAY CONTINUE AFTER THE EXCEPTION HAS
+--     BEEN HANDLED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/07/82
+--     SPS 02/10/83
+--     JBG 08/30/83
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/11/87  REMOVED UNNECESSARY CODE AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804D IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804D", "FLOAT_IO GET RAISES DATA_ERROR FOR " &
+                      "OUT-OF-RANGE DATA");
+
+     DECLARE
+          FT : FILE_TYPE;
+     BEGIN
+
+-- CREATE AND INITIALIZE TEST FILE
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "1.25");
+          NEW_LINE (FT);
+          PUT (FT, "-7.5");
+          NEW_LINE (FT);
+          PUT (FT, "3.5");
+          NEW_LINE (FT);
+          PUT (FT, "2.5");
+          NEW_LINE (FT);
+          CLOSE (FT);
+
+-- BEGIN TEST
+
+          DECLARE
+               TYPE FL IS NEW FLOAT RANGE 1.0 .. 3.0;
+               PACKAGE FL_IO IS NEW FLOAT_IO (FL);
+               X : FL;
+               USE FL_IO;
+          BEGIN
+
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               GET (FT, X);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - 1");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1.25 THEN
+                              FAILED ("ITEM ALTERED WHEN DATA_ERROR " &
+                                      "IS RAISED - 1");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 1");
+               END;
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - 2");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1.25 THEN
+                              FAILED ("ITEM ALTERED WHEN DATA_ERROR " &
+                                      "IS RAISED - 2");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 2");
+               END;
+
+               GET (FT, X);
+               IF X /= 2.5 THEN
+                    FAILED ("READING NOT CONTINUED CORRECTLY " &
+                            "AFTER DATA_ERROR");
+               END IF;
+
+               BEGIN
+                    DELETE (FT);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804e.ada
new file mode 100644
index 000000000..021baba2d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804e.ada
@@ -0,0 +1,154 @@
+-- CE3804E.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 FIXED_IO GET RAISES DATA_ERROR WHEN THE DATA READ IS
+--     OUT-OF-RANGE CHECK THAT ITEM IS LEFT UNAFFECTED AND THAT
+--     READING MAY CONTINUE AFTER THE EXCEPTION HAS BEEN HANDLED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/07/82
+--     SPS 02/10/83
+--     JBG 08/30/83
+--     EG  11/02/84
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/11/87  REMOVED UNNECESSARY CODE AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804E IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804E", "FIXED_IO GET RAISES DATA_ERROR FOR " &
+                      "OUT-OF-RANGE DATA");
+
+     DECLARE
+          FT : FILE_TYPE;
+     BEGIN
+
+-- CREATE AND INITIALIZE TEST FILE
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "1.25");
+          NEW_LINE (FT);
+          PUT (FT, "-7.5");
+          NEW_LINE (FT);
+          PUT (FT, "3.5");
+          NEW_LINE (FT);
+          PUT (FT, "2.5");
+          NEW_LINE (FT);
+          CLOSE (FT);
+
+-- BEGIN TEST
+
+          DECLARE
+               TYPE FX IS DELTA 0.001 RANGE 1.0 .. 3.0;
+               PACKAGE FX_IO IS NEW FIXED_IO (FX);
+               X : FX;
+               USE FX_IO;
+          BEGIN
+
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               GET (FT, X, 0);
+
+               BEGIN
+                    GET (FT, X, 0);
+                    FAILED ("DATA_ERROR NOT RAISED - 1");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1.25 THEN
+                              FAILED ("ITEM ALTERED WHEN DATA_ERROR " &
+                                      "IS RAISED - 1");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 1");
+               END;
+
+               BEGIN
+                    GET (FT, X, 0);
+                    FAILED ("DATA_ERROR NOT RAISED - 2");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1.25 THEN
+                              FAILED ("ITEM ALTERED WHEN DATA_ERROR " &
+                                      "IS RAISED - 2");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 2");
+               END;
+
+               GET (FT, X, 0);
+               IF X /= 2.5 THEN
+                    FAILED ("READING NOT CONTINUED CORRECTLY " &
+                            "AFTER DATA_ERROR");
+               END IF;
+
+               BEGIN
+                    DELETE (FT);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804f.ada
new file mode 100644
index 000000000..96a48d858
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804f.ada
@@ -0,0 +1,206 @@
+-- CE3804F.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 FLOAT_IO GET RAISES CONSTRAINT_ERROR WHEN THE VALUE
+--     SUPPLIED BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN FIELD'LAST
+--     WHEN FIELD'LAST IS LESS THAN INTEGER'LAST, OR THE VALUE READ IS
+--     OUT OF RANGE OF THE ITEM PARAMETER, BUT WITHIN THE RANGE OF THE
+--     SUBTYPE USED TO INSTANTIATE FLOAT_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/07/82
+--     JBG 08/30/83
+--     DWC 09/11/87  SPLIT CASE FOR FIXED_IO INTO CE3804P.ADA AND
+--                   CORRECTED EXCEPTION HANDLING.
+--     JRL 06/07/96  Added call to Ident_Int in expressions involving
+--                   Field'Last, to make the expressions non-static and
+--                   prevent compile-time rejection.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804F IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804F", "CHECK THAT FLOAT_IO GET RAISES " &
+                      "CONSTRAINT_ERROR WHEN THE VALUE SUPPLIED " &
+                      "BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN " &
+                      "FIELD'LAST WHEN FIELD'LAST IS LESS THAN " &
+                      "INTEGER'LAST, OR THE VALUE READ IS OUT OF " &
+                      "RANGE OF THE ITEM PARAMETER, BUT WITHIN THE " &
+                      "RANGE OF THE SUBTYPE USED TO INSTANTIATE " &
+                      "FLOAT_IO.");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE FLT IS NEW FLOAT RANGE 1.0 .. 10.0;
+          PACKAGE FL_IO IS NEW FLOAT_IO (FLT);
+          USE FL_IO;
+          X : FLT RANGE 1.0 .. 5.0;
+
+     BEGIN
+          BEGIN
+               GET (FT, X, IDENT_INT(-3));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE " &
+                       "WIDTH");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR FOR NEGATIVE WIDTH");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR NEGATIVE " &
+                            "WIDTH");
+          END;
+
+          IF FIELD'LAST < INTEGER'LAST THEN
+               BEGIN
+                    GET (X, FIELD'LAST + Ident_Int(1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                            "FIELD'LAST + 1 WIDTH - DEFAULT");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FIELD'LAST + 1 WIDTH - DEFAULT");
+               END;
+          END IF;
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "1.0");
+          NEW_LINE (FT);
+          PUT (FT, "8.0");
+          NEW_LINE (FT);
+          PUT (FT, "2.0");
+          NEW_LINE (FT);
+          PUT (FT, "3.0");
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                                    "FOR IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FT, X);
+          IF X /= 1.0 THEN
+               FAILED ("WRONG VALUE READ WITH EXTERNAL FILE");
+          END IF;
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                       "VALUE OUT OF RANGE WITH EXTERNAL FILE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - " &
+                            "VALUE OUT OF RANGE WITH EXTERNAL FILE");
+          END;
+
+          BEGIN
+               GET (FT, X, IDENT_INT(-1));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                       "NEGATIVE WIDTH WITH EXTERNAL FILE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - " &
+                            "NEGATIVE WIDTH WITH EXTERNAL FILE");
+          END;
+
+          SKIP_LINE (FT);
+
+          IF FIELD'LAST < INTEGER'LAST THEN
+               BEGIN
+                    GET (FT, X, FIELD'LAST + Ident_Int(1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                            "FIELD'LAST + 1 WIDTH WITH " &
+                            "EXTERNAL FILE");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FIELD'LAST + 1 WIDTH WITH " &
+                                 "EXTERNAL FILE");
+               END;
+          END IF;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X, 3);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT_ERROR RAISED - " &
+                            "OUT OF RANGE WITH EXTERNAL FILE");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - " &
+                            "OUT OF RANGE WITH EXTERNAL FILE");
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+END CE3804F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804g.ada
new file mode 100644
index 000000000..e88e9dc2f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804g.ada
@@ -0,0 +1,167 @@
+-- CE3804G.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 FLOAT_IO GET WHEN SUPPLIED WITH A WIDTH PARAMETER
+--     GREATER THAN ZERO READS ONLY THAT MANY CHARACTERS.  ALSO CHECK
+--     THAT INPUT TERMINATES WHEN A LINE TERMINATOR IS ENCOUNTERED AND
+--     THAT DATA_ERROR IS RAISED WHEN THE DATA IS INVALID.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/08/82
+--     SPS 12/14/82
+--     VKG 01/13/83
+--     SPS 02/08/83
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/14/87  SPLIT CASE FOR FIXED_IO INTO CE3804H.ADA AND
+--                   CORRECTED EXCEPTION HANDLING.
+--     LDC 06/01/88  CHANGED TEST VALUE FROM "3.525" TO "3.625".
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804G IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804G", "CHECK THAT FLOAT_IO GET WHEN SUPPLIED WITH " &
+                      "A WIDTH PARAMETER GREATER THAN ZERO READS " &
+                      "ONLY THAT MANY CHARACTERS.  ALSO CHECK THAT " &
+                      "INPUT TERMINATES WHEN A LINE TERMINATOR IS " &
+                      "ENCOUNTERED AND THAT DATA_ERROR IS RAISED " &
+                      "WHEN THE DATA IS INVALID.");
+
+     DECLARE
+          FT : FILE_TYPE;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT(FT, "3.259.5 8.52");
+          NEW_LINE (FT);
+          PUT (FT, "  ");
+          NEW_LINE (FT);
+          PUT (FT, ASCII.HT & "9.0");
+          NEW_LINE (FT);
+          PUT (FT, "-3.625");
+          NEW_LINE (FT);
+          CLOSE (FT);
+
+-- BEGIN TEST
+
+          DECLARE
+               TYPE FL IS DIGITS 4;
+               PACKAGE FL_IO IS NEW FLOAT_IO (FL);
+               USE FL_IO;
+               X : FL;
+          BEGIN
+
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT" &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               GET (FT, X, 4);
+               IF X /= 3.25 THEN
+                    FAILED ("WIDTH CHARACTERS NOT READ - FLOAT");
+               ELSE
+                    GET (FT, X, 3);
+                    IF X /= 9.5 THEN
+                         FAILED ("WIDTH CHARACTERS NOT READ - " &
+                                 "FLOAT 2");
+                    ELSE
+                         GET (FT, X, 4);
+                         IF X /= 8.5 THEN
+                              FAILED ("DIDN'T COUNT LEADING BLANKS " &
+                                      "- FLOAT");
+                         ELSE
+                              SKIP_LINE(FT);
+                              BEGIN
+                                   GET (FT, X, 2);
+                                   FAILED ("DATA_ERROR NOT RAISED - " &
+                                           "FLOAT");
+                              EXCEPTION
+                                   WHEN DATA_ERROR =>
+                                        NULL;
+                                   WHEN OTHERS =>
+                                        FAILED ("WRONG EXCEPTION RAISED"
+                                             & " - FLOAT");
+                              END;
+                              SKIP_LINE(FT);
+                              GET (FT, X, 4);
+                              IF X /= 9.0 THEN
+                                   FAILED ("GET WITH WIDTH " &
+                                           "INCORRECT - 3");
+                              END IF;
+
+                              SKIP_LINE (FT);
+                              GET (FT, X, 7);
+                              IF X /= -3.625 THEN
+                                   FAILED ("WIDTH CHARACTERS NOT " &
+                                           "READ - FLOAT 3");
+                              END IF;
+                         END IF;
+                    END IF;
+               END IF;
+
+               BEGIN
+                   DELETE (FT);
+               EXCEPTION
+                   WHEN USE_ERROR =>
+                        NULL;
+               END;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804h.ada
new file mode 100644
index 000000000..6f7d87cb2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804h.ada
@@ -0,0 +1,161 @@
+-- CE3804H.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 FIXED_IO GET WHEN SUPPLIED WITH A WIDTH PARAMETER
+--     GREATER THAN ZERO READS ONLY THAT MANY CHARACTERS.  ALSO CHECK
+--     THAT INPUT TERMINATES WHEN A LINE TERMINATOR IS ENCOUNTERED AND
+--     THAT DATA_ERROR IS RAISED WHEN THE DATA IS INVALID.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     DWC 09/14/87  CREATED ORIGINAL TEST.
+--     RJW 08/17/89  CHANGED THE VALUE '-3.525' TO '-3.625'.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804H IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804H", "CHECK THAT FIXED_IO GET WHEN SUPPLIED WITH " &
+                      "A WIDTH PARAMETER GREATER THAN ZERO READS " &
+                      "ONLY THAT MANY CHARACTERS.  ALSO CHECK THAT " &
+                      "INPUT TERMINATES WHEN A LINE TERMINATOR IS " &
+                      "ENCOUNTERED AND THAT DATA_ERROR IS RAISED " &
+                      "WHEN THE DATA IS INVALID");
+
+     DECLARE
+          FT : FILE_TYPE;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT(FT, "3.259.5 8.52");
+          NEW_LINE (FT);
+          PUT (FT, "  ");
+          NEW_LINE (FT);
+          PUT (FT, ASCII.HT & "9.0");
+          NEW_LINE (FT);
+          PUT (FT, "-3.625");
+          NEW_LINE (FT);
+
+          CLOSE (FT);
+
+-- BEGIN TEST
+
+          DECLARE
+               TYPE FIXED IS DELTA 0.001 RANGE -100.0 .. 100.0;
+               PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
+               USE FX_IO;
+               X : FIXED;
+
+          BEGIN
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT" &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               GET (FT, X, 4);
+               IF X /= 3.25 THEN
+                    FAILED ("WIDTH CHARACTERS NOT READ - FIXED - 1");
+               ELSE
+                    GET (FT, X, 3);
+                    IF X /= 9.5 THEN
+                         FAILED ("WIDTH CHARACTERS NOT READ - " &
+                                 "FIXED 2");
+                    ELSE
+                         GET (FT, X, 4);
+                         IF X /= 8.5 THEN
+                              FAILED ("DIDN'T COUNT LEADING BLANKS " &
+                                      "- FIXED");
+                         ELSE
+                              SKIP_LINE(FT);
+                              BEGIN
+                                   GET (FT, X, 2);
+                                   FAILED ("DATA_ERROR NOT RAISED - " &
+                                           "FIXED");
+                              EXCEPTION
+                                   WHEN DATA_ERROR =>
+                                        NULL;
+                                   WHEN OTHERS =>
+                                        FAILED ("WRONG EXCEPTION RAISED"
+                                             & " - FIXED");
+                              END;
+
+                              SKIP_LINE(FT);
+                              GET (FT, X, 4);
+                              IF X /= 9.0 THEN
+                                   FAILED ("GET WITH WIDTH " &
+                                           "INCORRECT");
+                              END IF;
+
+                              SKIP_LINE (FT);
+                              GET (FT, X, 7);
+                              IF X /= -3.625 THEN
+                                   FAILED ("WIDTH CHARACTERS NOT " &
+                                           "READ");
+                              END IF;
+                         END IF;
+                    END IF;
+               END IF;
+
+               BEGIN
+                   DELETE (FT);
+               EXCEPTION
+                   WHEN USE_ERROR =>
+                        NULL;
+               END;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804i.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804i.ada
new file mode 100644
index 000000000..19e292fd3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804i.ada
@@ -0,0 +1,141 @@
+-- CE3804I.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 FLOAT_IO GET OPERATES ON IN_FILE FILE AND WHEN
+--     NO FILE IS SPECIFIED THE CURRENT DEFAULT INPUT FILE IS USED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/06/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/14/87  SPLIT CASE FOR FIXED_IO INTO CE3804J.ADA AND
+--                   CORRECTED EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804I IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804I", "CHECK THAT FLOAT_IO GET OPERATES ON " &
+                      "IN_FILE FILE AND WHEN NO FILE IS " &
+                      "SPECIFIED THE CURRENT DEFAULT INPUT " &
+                      "FILE IS USED.");
+
+     DECLARE
+          FT1, FT2 : FILE_TYPE;
+     BEGIN
+
+-- CREATE AND INITIALIZE FILES
+
+          BEGIN
+               CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                    "CREATE WITH OUT_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " &
+                                    "CREATE WITH OUT_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
+
+          PUT (FT1, "1.0");
+          NEW_LINE (FT1);
+
+          CLOSE (FT1);
+
+          BEGIN
+               OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                                    "FOR IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT2, "2.0");
+          NEW_LINE (FT2);
+
+          CLOSE (FT2);
+          OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
+
+          SET_INPUT (FT2);
+
+          DECLARE
+               TYPE FL IS NEW FLOAT;
+               PACKAGE FLIO IS NEW FLOAT_IO (FL);
+               USE FLIO;
+               X : FL;
+          BEGIN
+               BEGIN
+                    GET (FT1, X);
+                    IF X /= 1.0 THEN
+                         FAILED ("FLOAT FILE VALUE INCORRECT");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED - FILE FLOAT");
+               END;
+
+               BEGIN
+                    GET (X);
+                    IF X /= 2.0 THEN
+                         FAILED ("FLOAT DEFAULT VALUE INCORRECT");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED - DEFAULT FLOAT");
+               END;
+          END;
+
+          BEGIN
+              DELETE (FT1);
+              DELETE (FT2);
+          EXCEPTION
+              WHEN USE_ERROR =>
+                   NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804I;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804j.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804j.ada
new file mode 100644
index 000000000..a7d4c841a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804j.ada
@@ -0,0 +1,137 @@
+-- CE3804J.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 FIXED_IO GET OPERATES ON IN_FILE FILE AND WHEN
+--     NO FILE IS SPECIFIED THE CURRENT DEFAULT INPUT FILE IS USED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     DWC 09/14/87  CREATED ORIGINAL TEST.
+--     JRL 02/28/96  Changed upper bound of type FX from 1000.0 to 250.0.
+--                   Corrected TEST string.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804J IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804J", "CHECK THAT FIXED_IO GET OPERATES ON " &
+                      "IN_FILE FILE AND WHEN NO FILE IS " &
+                      "SPECIFIED THE CURRENT DEFAULT INPUT " &
+                      "FILE IS USED");
+
+     DECLARE
+          FT1, FT2 : FILE_TYPE;
+     BEGIN
+
+-- CREATE AND INITIALIZE FILES
+
+          BEGIN
+               CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                    "CREATE WITH OUT_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " &
+                                    "CREATE WITH OUT_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
+
+          PUT (FT1, "1.0");
+          NEW_LINE (FT1);
+
+          CLOSE (FT1);
+
+          BEGIN
+               OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                                    "FOR IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT2, "2.0");
+          NEW_LINE (FT2);
+
+          CLOSE (FT2);
+          OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
+
+          SET_INPUT (FT2);
+
+          DECLARE
+               TYPE FX IS DELTA 0.0001 RANGE 1.0 .. 250.0;
+               PACKAGE FXIO IS NEW FIXED_IO (FX);
+               USE FXIO;
+               X : FX;
+          BEGIN
+               BEGIN
+                    GET (FT1, X);
+                    IF X /= 1.0 THEN
+                         FAILED ("FIXED FILE VALUE INCORRECT");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED - FILE FIXED");
+               END;
+
+               BEGIN
+                    GET (X);
+                    IF X /= 2.0 THEN
+                         FAILED ("FIXED DEFAULT VALUE INCORRECT");
+                    END IF;
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED - DEFAULT FIXED");
+               END;
+          END;
+
+          BEGIN
+               DELETE (FT1);
+               DELETE (FT2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804J;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804m.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804m.ada
new file mode 100644
index 000000000..d71d2fccc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804m.ada
@@ -0,0 +1,157 @@
+-- CE3804M.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 GET WILL RAISE DATA_ERROR IF THE USE OF # AND :
+--     IN BASED LITERALS IS MIXED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     VKG 02/07/83
+--     JBG 03/30/84
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/14/87  SPLIT CASE FOR FIXED_IO INTO CE3804N.ADA AND
+--                   CORRECTED EXCEPTION HANDLING.
+
+WITH TEXT_IO; USE TEXT_IO;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CE3804M IS
+
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE3804M", "CHECK THAT FLOAT_IO GET WILL RAISE " &
+                      "DATA_ERROR IF THE USE OF # AND : IN " &
+                      "BASED LITERALS IS MIXED");
+
+     DECLARE
+          FT : FILE_TYPE;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+
+          PUT_LINE (FT, "2#1.1#E+2");   -- 2#1.1#E+2
+          PUT_LINE (FT, "8:1.1:E-2");   -- 8:1.1:E-2
+          PUT (FT, "2#1.1:E+1");        -- 2#1.1:E+1
+          NEW_LINE (FT);
+          PUT (FT, "4:2.23#E+2");       -- 4:2.23#E+2
+          NEW_LINE (FT);
+          PUT (FT, "2#1.0#E+1");        -- 2#1.0#E+1
+          NEW_LINE (FT);
+          CLOSE (FT);
+
+          DECLARE
+               PACKAGE FL_IO IS NEW FLOAT_IO(FLOAT);
+               USE FL_IO;
+               X : FLOAT := 1.00E+10;
+          BEGIN
+
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               GET (FT, X);
+               IF X /= 2#1.1#E+2 THEN
+                    FAILED ("DID NOT GET RIGHT VALUE - 1");
+               END IF;
+
+               GET (FT, X);
+               IF X /= 8#1.1#E-2 THEN
+                    FAILED ("DID NOT GET RIGHT VALUE - 2");
+               END IF;
+
+               BEGIN
+                    X := 1.0E+10;
+                    GET (FT,X);
+                    FAILED ("DATA_ERROR NOT RAISED - 1");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1.00E+10 THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 1");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 1");
+               END;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT,X);
+                    FAILED ("DATA_ERROR NOT RAISED - 2");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= 1.00E+10 THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 2");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 2");
+               END;
+
+               SKIP_LINE (FT);
+
+               GET (FT, X);
+               IF X /= 2#1.0#E+1 THEN
+                    FAILED ("DID NOT GET RIGHT VALUE - 3");
+               END IF;
+
+               BEGIN
+                    DELETE (FT);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NULL;
+               END;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804M;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804o.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804o.ada
new file mode 100644
index 000000000..a08e2c972
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804o.ada
@@ -0,0 +1,121 @@
+-- CE3804O.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:
+--     CHECK THAT GET FOR FIXED_IO RAISES MODE_ERROR WHEN THE
+--     MODE IS NOT IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     DWC 09/14/87  CREATED ORIGINAL TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804O IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804O", "CHECK THAT GET FOR FIXED_IO RAISES " &
+                      "MODE_ERROR WHEN THE MODE IS NOT IN_FILE");
+
+     DECLARE
+          FT: FILE_TYPE;
+     BEGIN
+          BEGIN
+               CREATE (FT, OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                    "CREATE FOR TEMP FILES " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          DECLARE
+               TYPE FIXED IS DELTA 0.25 RANGE 1.0 .. 3.0;
+               PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
+               USE FX_IO;
+               X : FIXED;
+          BEGIN
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("MODE_ERROR NOT RAISED - FIXED " &
+                            "UN-NAMED FILE");
+               EXCEPTION
+                    WHEN MODE_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FIXED UN-NAMED FILE");
+               END;
+
+               BEGIN
+                    GET (STANDARD_OUTPUT, X);
+                    FAILED ("MODE_ERROR NOT RAISED - FIXED " &
+                            "STANDARD_OUTPUT");
+               EXCEPTION
+                    WHEN MODE_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FIXED STANDARD_OUTPUT");
+               END;
+
+               BEGIN
+                    GET (CURRENT_OUTPUT, X);
+                    FAILED ("MODE_ERROR NOT RAISED - FIXED " &
+                            "CURRENT_OUTPUT");
+               EXCEPTION
+                    WHEN MODE_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FIXED CURRENT_OUTPUT");
+               END;
+
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804O;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804p.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804p.ada
new file mode 100644
index 000000000..d4afd2a49
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3804p.ada
@@ -0,0 +1,206 @@
+-- CE3804P.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 FIXED_IO GET RAISES CONSTRAINT_ERROR WHEN THE VALUE
+--     SUPPLIED BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN FIELD'LAST
+--     WHEN FIELD'LAST IS LESS THAN INTEGER'LAST, OR THE VALUE READ IS
+--     OUT OF RANGE OF THE ITEM PARAMETER, BUT WITHIN THE RANGE OF THE
+--     SUBTYPE USED TO INSTANTIATE FIXED_IO.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     DWC 09/15/87  CREATED ORIGINAL TEST.
+--     JRL 06/07/96  Added call to Ident_Int in expressions involving
+--                   Field'Last, to make the expressions non-static and
+--                   prevent compile-time rejection. Corrected typo.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3804P IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3804P", "CHECK THAT FLOAT_IO GET RAISES " &
+                      "CONSTRAINT_ERROR WHEN THE VALUE SUPPLIED " &
+                      "BY WIDTH IS NEGATIVE, WIDTH IS GREATER THAN " &
+                      "FIELD'LAST WHEN FIELD'LAST IS LESS THAN " &
+                      "INTEGER'LAST, OR THE VALUE READ IS OUT OF " &
+                      "RANGE OF THE ITEM PARAMETER, BUT WITHIN THE " &
+                      "RANGE OF THE SUBTYPE USED TO INSTANTIATE " &
+                      "FLOAT_IO.");
+
+     DECLARE
+          TYPE FIXED IS DELTA 0.25 RANGE 0.0 .. 10.0;
+          FT : FILE_TYPE;
+          PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
+          USE FX_IO;
+          X : FIXED RANGE 0.0 .. 5.0;
+
+     BEGIN
+          BEGIN
+               GET (FT, X, IDENT_INT(-3));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED FOR NEGATIVE " &
+                       "WIDTH");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR FOR NEGATIVE WIDTH");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR NEGATIVE " &
+                            "WIDTH");
+          END;
+
+          IF FIELD'LAST < INTEGER'LAST THEN
+               BEGIN
+                    GET (X, FIELD'LAST + Ident_Int(1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                            "FIELD'LAST + 1 WIDTH - DEFAULT");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FIELD'LAST + 1 WIDTH - DEFAULT");
+               END;
+          END IF;
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "1.0");
+          NEW_LINE (FT);
+          PUT (FT, "8.0");
+          NEW_LINE (FT);
+          PUT (FT, "2.0");
+          NEW_LINE (FT);
+          PUT (FT, "3.0");
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FT, X);
+          IF X /= 1.0 THEN
+               FAILED ("WRONG VALUE READ WITH EXTERNAL FILE");
+          END IF;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X, 3);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                       "OUT OF RANGE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - " &
+                            "OUT OF RANGE");
+          END;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X, IDENT_INT(-1));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                       "NEGATIVE WIDTH WITH EXTERNAL FILE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - " &
+                            "NEGATIVE WIDTH WITH EXTERNAL FILE");
+          END;
+
+          IF FIELD'LAST < INTEGER'LAST THEN
+               BEGIN
+                    GET (FT, X, FIELD'LAST + Ident_Int(1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - " &
+                            "FIELD'LAST + 1 WIDTH WITH " &
+                            "EXTERNAL FILE");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - " &
+                                 "FIELD'LAST + 1 WIDTH WITH " &
+                                 "EXTERNAL FILE");
+               END;
+          END IF;
+
+          SKIP_LINE (FT);
+
+          BEGIN
+               GET (FT, X, 3);
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    FAILED ("CONSTRAINT_ERROR RAISED; VALID WIDTH " &
+                            "WITH EXTERNAL FILE");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED; VALID WIDTH " &
+                            "WITH EXTERNAL FILE");
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3804P;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3805a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3805a.ada
new file mode 100644
index 000000000..74c8aff09
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3805a.ada
@@ -0,0 +1,162 @@
+-- CE3805A.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 FLOAT_IO GET MAY READ THE LAST CHARACTER IN THE FILE
+--     WITHOUT RAISNG END_ERROR AND THAT SUBSEQUENT READING WILL RAISE
+--     END_ERROR.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATAIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/08/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/15/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
+--                   HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3805A IS
+
+BEGIN
+
+     TEST ("CE3805A", "CHECK THAT FLOAT_IO GET MAY READ THE LAST " &
+                      "CHARACTER IN THE FILE WITHOUT RAISING " &
+                      "END_ERROR AND THAT SUBSEQUENT READING WILL " &
+                      "RAISE END_ERROR");
+
+     DECLARE
+          FT1, FT2 : FILE_TYPE;
+          PACKAGE FL_IO IS NEW FLOAT_IO (FLOAT);
+          X : FLOAT;
+          USE FL_IO;
+          INCOMPLETE : EXCEPTION;
+
+     BEGIN
+
+-- CREATE AND INITIALIZE TEST FILES
+
+          BEGIN
+               CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
+
+          PUT (FT1, "2.25");
+          CLOSE (FT1);
+
+          PUT (FT2, "2.50");
+          NEW_LINE (FT2, 3);
+          NEW_PAGE (FT2);
+          NEW_LINE (FT2, 3);
+          CLOSE (FT2);
+
+-- BEGIN TEST
+
+          BEGIN
+               OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
+                                    "OPEN WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
+
+          BEGIN
+               GET (FT1, X);
+               IF X /= 2.25 THEN
+                    FAILED ("INCORRECT VALUE READ");
+               END IF;
+               BEGIN
+                    GET (FT1, X);
+                    FAILED ("END_ERROR NOT RAISED - 1");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         NULL;
+                    WHEN  OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 1");
+               END;
+          EXCEPTION
+               WHEN END_ERROR =>
+                    FAILED ("END_ERROR RAISED PREMATURELY - 1");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED - 1");
+          END;
+
+          BEGIN
+               GET (FT2, X);
+               IF X /= 2.50 THEN
+                    FAILED ("INCORRECT VALUE READ");
+               END IF;
+               BEGIN
+                    GET (FT2, X);
+                    FAILED ("END_ERROR NOT RAISED - 2");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         NULL;
+                    WHEN  OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 2");
+               END;
+          EXCEPTION
+               WHEN END_ERROR =>
+                    FAILED ("END_ERROR RAISED PREMATURELY - 2");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED - 2");
+          END;
+
+          BEGIN
+               DELETE (FT1);
+               DELETE (FT2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3805A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3805b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3805b.ada
new file mode 100644
index 000000000..80919630e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3805b.ada
@@ -0,0 +1,163 @@
+-- CE3805B.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 FIXED_IO GET MAY READ THE LAST CHARACTER IN THE FILE
+--     WITHOUT RAISING END_ERROR AND THAT SUBSEQUENT READING WILL RAISE
+--     END_ERROR.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/08/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/15/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
+--                   HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3805B IS
+
+BEGIN
+
+     TEST ("CE3805B", "CHECK THAT FIXED_IO GET MAY READ THE LAST "&
+                      "CHARACTER IN THE FILE WITHOUT RAISING " &
+                      "END_ERROR AND THAT SUBSEQUENT READING WILL " &
+                      "RAISE END_ERROR");
+
+     DECLARE
+          FT1, FT2 : FILE_TYPE;
+          TYPE FIXED IS DELTA 0.02 RANGE 0.0 .. 50.0;
+          PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
+          X : FIXED;
+          USE FX_IO;
+          INCOMPLETE : EXCEPTION;
+
+     BEGIN
+
+-- CREATE AND INITIALIZE TEST FILES
+
+          BEGIN
+               CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
+
+          PUT (FT1, "2.25");
+          CLOSE (FT1);
+
+          PUT (FT2, "2.50");
+          NEW_LINE (FT2, 3);
+          NEW_PAGE (FT2);
+          NEW_LINE (FT2, 3);
+          CLOSE (FT2);
+
+-- BEGIN TEST
+
+          BEGIN
+               OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "FOR IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
+
+          BEGIN
+               GET (FT1, X);
+               IF X /= 2.25 THEN
+                    FAILED ("INCORRECT VALUE READ");
+               END IF;
+               BEGIN
+                    GET (FT1, X);
+                    FAILED ("END_ERROR NOT RAISED - 1");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         NULL;
+                    WHEN  OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 1");
+               END;
+          EXCEPTION
+               WHEN END_ERROR =>
+                    FAILED ("END_ERROR RAISED PREMATURELY - 1");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED - 1");
+          END;
+
+          BEGIN
+               GET (FT2, X);
+               IF X /= 2.50 THEN
+                    FAILED ("INCORRECT VALUE READ");
+               END IF;
+               BEGIN
+                    GET (FT2, X);
+                    FAILED ("END_ERROR NOT RAISED - 2");
+               EXCEPTION
+                    WHEN END_ERROR =>
+                         NULL;
+                    WHEN  OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 2");
+               END;
+          EXCEPTION
+               WHEN END_ERROR =>
+                    FAILED ("END_ERROR RAISED PREMATURELY - 2");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED ERROR RAISED - 2");
+          END;
+
+          BEGIN
+               DELETE (FT1);
+               DELETE (FT2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3805B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806a.ada
new file mode 100644
index 000000000..09762f319
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806a.ada
@@ -0,0 +1,132 @@
+-- CE3806A.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 PUT FOR FLOAT_IO RAISES MODE_ERROR FOR FILES OF
+--     MODE IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 09/10/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/11/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3806A IS
+
+BEGIN
+
+     TEST ("CE3806A", "CHECK THAT PUT FOR FLOAT_IO RAISES MODE_ERROR " &
+                      "FOR FILES OF MODE IN_FILE");
+
+     DECLARE
+          FT1 : FILE_TYPE;
+          PACKAGE FL_IO IS NEW FLOAT_IO (FLOAT);
+          USE FL_IO;
+          INCOMPLETE : EXCEPTION;
+          X : FLOAT := -34.267/19.2;
+
+     BEGIN
+
+          BEGIN
+               CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT1, 'A');
+          CLOSE (FT1);
+
+          BEGIN
+               OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               PUT (FT1, X);
+               FAILED ("MODE_ERROR NOT RAISED - 1");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               PUT (STANDARD_INPUT, X);
+               FAILED ("MODE_ERROR NOT RAISED - 2");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               PUT (CURRENT_INPUT, X);
+               FAILED ("MODE_ERROR NOT RAISED - 3");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 3");
+          END;
+
+          BEGIN
+               DELETE (FT1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3806A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806b.ada
new file mode 100644
index 000000000..194f1a971
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806b.ada
@@ -0,0 +1,124 @@
+-- CE3806B.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 PUT FOR FIXED_IO RAISES MODE_ERROR FOR FILES OF
+--     MODE IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 09/11/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3806B IS
+
+BEGIN
+     TEST ("CE3806B", "CHECK THAT PUT FOR FIXED_IO RAISES MODE_ERROR " &
+                      "FOR FILES OF MODE IN_FILE");
+
+     DECLARE
+          FT1 : FILE_TYPE;
+          TYPE FIXED IS DELTA 0.01 RANGE 0.0 .. 1.0;
+          PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
+          USE FX_IO;
+          INCOMPLETE : EXCEPTION;
+          X : FIXED := 0.2;
+
+     BEGIN
+
+          BEGIN
+               CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT1, 'A');
+          CLOSE (FT1);
+
+          BEGIN
+               OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               PUT (FT1, X);
+               FAILED ("MODE_ERROR NOT RAISED - 1");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               PUT (STANDARD_INPUT, X);
+               FAILED ("MODE_ERROR NOT RAISED - 2");
+           EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 2");
+          END;
+
+          BEGIN
+               PUT (CURRENT_INPUT, X);
+               FAILED ("MODE_ERROR NOT RAISED - 3");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 3");
+          END;
+
+          BEGIN
+               DELETE (FT1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3806B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806c.ada
new file mode 100644
index 000000000..6a7a79338
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806c.ada
@@ -0,0 +1,197 @@
+-- CE3806C.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 PUT FOR FLOAT_IO RAISES CONSTRAINT_ERROR WHEN THE
+--     VALUES SUPPLIED BY FORE, AFT, OR EXP ARE NEGATIVE OR GREATER
+--     THAN FIELD'LAST WHEN FIELD'LAST < FIELD'BASE'LAST.  ALSO CHECK
+--     THAT PUT FOR FLOAT_IO RAISES CONSTRAINT_ERROR WHEN THE VALUE OF
+--     ITEM IS OUTSIDE THE RANGE OF THE TYPE USED TO INSTANTIATE
+--     FLOAT_IO.
+
+-- HISTORY:
+--     SPS 09/10/82
+--     JBG 08/30/83
+--     JLH 09/14/87  ADDED CASES FOR COMPLETE OBJECTIVE.
+--     KAS 11/24/95  DELETED DIGITS CONSTRAINT FROM SUBTYPE
+--                   CHANGED STATIC EXPRESSIONS INVOLVING 'LAST
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3806C IS
+
+     FIELD_LAST : TEXT_IO.FIELD := TEXT_IO.FIELD'LAST;
+
+BEGIN
+
+     TEST ("CE3806C", "CHECK THAT PUT FOR FLOAT_IO RAISES " &
+                      "CONSTRAINT_ERROR APPROPRIATELY");
+
+     DECLARE
+          TYPE FLOAT IS DIGITS 5 RANGE 0.0 .. 2.0;
+          SUBTYPE MY_FLOAT IS FLOAT RANGE 0.0 .. 1.0;
+          PACKAGE NFL_IO IS NEW FLOAT_IO (MY_FLOAT);
+          USE NFL_IO;
+          FT : FILE_TYPE;
+          Y : FLOAT := 1.8;
+          X : MY_FLOAT := 26.3 / 26.792;
+
+     BEGIN
+          BEGIN
+               PUT (FT, X, FORE => IDENT_INT(-6));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE FORE " &
+                       "FLOAT");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 1");
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 1");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - NEGATIVE FORE " &
+                            "FLOAT");
+          END;
+
+          BEGIN
+               PUT (FT, X, AFT => IDENT_INT(-2));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE AFT " &
+                       "FLOAT");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 2");
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 2");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - NEGATIVE AFT " &
+                            "FLOAT");
+          END;
+
+          BEGIN
+               PUT (FT, X, EXP => IDENT_INT(-1));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE EXP " &
+                       "FLOAT");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 3");
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 3");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - NEGATIVE EXP " &
+                            "FLOAT");
+          END;
+
+          IF FIELD_LAST < FIELD'BASE'LAST THEN
+
+               BEGIN
+                    PUT (FT, X, FORE => IDENT_INT(FIELD_LAST+1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - FORE FLOAT");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN STATUS_ERROR =>
+                         FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 4");
+                    WHEN USE_ERROR =>
+                         FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 4");
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - FORE FLOAT");
+               END;
+
+               BEGIN
+                    PUT (FT, X, AFT => IDENT_INT(FIELD_LAST+1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - AFT FLOAT");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN STATUS_ERROR =>
+                         FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 5");
+                    WHEN USE_ERROR =>
+                         FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 5");
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - AFT FLOAT");
+               END;
+
+               BEGIN
+                    PUT (FT, X, EXP => IDENT_INT(FIELD_LAST+1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - EXP FLOAT");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN STATUS_ERROR =>
+                         FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 6");
+                    WHEN USE_ERROR =>
+                         FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 6");
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - EXP FLOAT");
+               END;
+           END IF;
+
+           BEGIN
+               PUT (FT, Y);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
+                       "RANGE - FILE");
+           EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
+                            "RANGE - FILE");
+          END;
+
+          BEGIN
+               PUT (Y);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
+                       "RANGE - DEFAULT");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
+                            "RANGE - DEFAULT");
+          END;
+
+     END;
+
+     RESULT;
+
+END CE3806C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806d.ada
new file mode 100644
index 000000000..6189ef14f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806d.ada
@@ -0,0 +1,129 @@
+-- CE3806D.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 FLOAT_IO PUT OPERATES ON FILES OF MODE OUT_FILE AND
+--     IF NO FILE IS SPECIFIED THE CURRENT DEFAULT OUTPUT FILE IS USED.
+
+--- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/06/82
+--     VKG 02/15/83
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/14/87  REMOVED DEPENDENCE ON RESET AND CORRECT EXCEPTION
+--                   HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3806D IS
+
+BEGIN
+
+     TEST ("CE3806D", "CHECK THAT FLOAT_IO OPERATES ON FILES OF MODE " &
+                      "OUT_FILE AND IF NO FILE IS SPECIFIED THE " &
+                      "CURRENT DEFAULT OUTPUT FILE IS USED");
+
+     DECLARE
+          FT1, FT2 : FILE_TYPE;
+          TYPE FL IS DIGITS 3;
+          PACKAGE FLIO IS NEW FLOAT_IO (FL);
+          USE FLIO;
+          INCOMPLETE : EXCEPTION;
+          X : FL := -1.5;
+
+     BEGIN
+
+          BEGIN
+               CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
+
+          SET_OUTPUT (FT2);
+
+          BEGIN
+               PUT (FT1, X);
+               PUT (X + 1.0);
+               CLOSE (FT1);
+
+               BEGIN
+                    OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               SET_OUTPUT (STANDARD_OUTPUT);
+
+               CLOSE (FT2);
+               OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
+
+               X := 0.0;
+               GET (FT1, X);
+               IF X /= -1.5 THEN
+                    FAILED ("VALUE INCORRECT - FLOAT FROM FILE");
+               END IF;
+               X := 0.0;
+               GET (FT2, X);
+               IF X /= -0.5 THEN
+                    FAILED (" VVALUE INCORRECT - FLOAT FROM DEFAULT");
+               END IF;
+          END;
+
+          BEGIN
+               DELETE (FT1);
+               DELETE (FT2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3806D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806e.ada
new file mode 100644
index 000000000..4865020f7
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806e.ada
@@ -0,0 +1,159 @@
+-- CE3806E.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 FLOAT_IO PUT RAISE LAYOUT_ERROR WHEN THE NUMBER
+--     OF CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH.
+--     CHECK THAT IT IS NOT RAISED, BUT RATHER NEW_LINE IS CALLED,
+--     WHEN THE NUMBER DOES NOT EXCEED THE MAX, BUT WHEN ADDED TO
+--     THE CURRENT COLUMN NUMBER, THE TOTAL EXCEEDS THE MAX.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/07/82
+--     SPS 12/14/82
+--     VKG 01/13/83
+--     SPS 02/18/83
+--     JBG 08/30/83
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 09/14/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3806E IS
+
+BEGIN
+
+     TEST ("CE3806E", "CHECK THAT FLOAT_IO PUT RAISES " &
+                      "LAYOUT_ERROR CORRECTLY");
+
+     DECLARE
+          TYPE FL IS DIGITS 3 RANGE 100.0 .. 200.0;
+          PACKAGE FLIO IS NEW FLOAT_IO (FL);
+          USE FLIO;
+          X : FL := 126.0;
+          Y : FL := 134.0;
+          Z : FL := 120.0;
+          INCOMPLETE : EXCEPTION;
+          FT : FILE_TYPE;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_LINE_LENGTH (FT, 8);
+
+          BEGIN
+               PUT (FT, X);        -- " 1.26E+02"
+               FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT");
+
+          END;
+
+          BEGIN
+               PUT (FT, Y, FORE => 1); -- "1.34E+02"
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED SECOND PUT " &
+                            "- FLOAT");
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED SECOND PUT - FLOAT");
+          END;
+
+          BEGIN
+               PUT (FT,Z, FORE => 1, AFT => 0); -- "1.2E+02"
+               IF LINE (FT) /= 2 THEN
+                    FAILED ("NEW_LINE NOT CALLED - FLOAT");
+               END IF;
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED THIRD " &
+                            "PUT - FLOAT");
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED THIRD PUT - FLOAT");
+          END;
+
+          SET_LINE_LENGTH ( FT,7);
+
+          BEGIN
+               PUT (FT, "X");
+               PUT (FT, Y, FORE => 1, AFT => 2,
+                    EXP => 1);          -- 1.34E+2
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED - 3 FLOAT");
+          END;
+
+          BEGIN
+               PUT (FT, "Z");
+               PUT (FT, Z, FORE => 1);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT 2");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("SOME EXCEPTION RAISED - 3 FLOAT");
+          END;
+
+          CHECK_FILE (FT, "1.34E+02#1.2E+02#X#1.34E+2#Z#@%");
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3806E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806f.ada
new file mode 100644
index 000000000..e013bbb5e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806f.ada
@@ -0,0 +1,194 @@
+-- CE3806F.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 PUT FOR FIXED_IO RAISES CONSTRAINT_ERROR WHEN THE
+--     VALUES SUPPLIED BY FORE, AFT, OR EXP ARE NEGATIVE OR GREATER
+--     THAN FIELD'LAST WHEN FIELD'LAST < FIELD'BASE'LAST.  ALSO CHECK
+--     THAT PUT FOR FIXED_IO RAISES CONSTRAINT_ERROR WHEN THE VALUE
+--     OF ITEM IS OUTSIDE THE RANGE OF THE TYPE USED TO INSTANTIATE
+--     FIXED_IO.
+
+-- HISTORY:
+--     JLH 09/15/87  CREATED ORIGINAL TEST.
+--     JRL 06/07/96  Added call to Ident_Int in expressions involving
+--                   Field'Last, to make the expressions non-static and
+--                   prevent compile-time rejection.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3806F IS
+
+BEGIN
+
+     TEST ("CE3806F", "CHECK THAT PUT FOR FIXED_IO RAISES " &
+                      "CONSTRAINT_ERROR APPROPRIATELY");
+
+     DECLARE
+          TYPE FIXED IS DELTA 0.01 RANGE 1.0 .. 2.0;
+          SUBTYPE MY_FIXED IS FIXED DELTA 0.01 RANGE 1.0 .. 1.5;
+          PACKAGE NFX_IO IS NEW FIXED_IO (MY_FIXED);
+          USE NFX_IO;
+          FT : FILE_TYPE;
+          Y : FIXED := 1.8;
+          X : MY_FIXED := 1.3;
+
+     BEGIN
+
+          BEGIN
+               PUT (FT, X, FORE => IDENT_INT(-6));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE FORE " &
+                       "FIXED");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 1");
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 1");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - NEGATIVE FORE " &
+                            "FIXED");
+          END;
+
+          BEGIN
+               PUT (FT, X, AFT => IDENT_INT(-2));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE AFT " &
+                       "FIXED");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 2");
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 2");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - NEGATIVE AFT " &
+                            "FIXED");
+          END;
+
+          BEGIN
+               PUT (FT, X, EXP => IDENT_INT(-1));
+               FAILED ("CONSTRAINT_ERROR NOT RAISED - NEGATIVE EXP " &
+                       "FIXED");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 3");
+               WHEN USE_ERROR =>
+                    FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                            "CONSTRAINT_ERROR - 3");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - NEGATIVE EXP " &
+                            "FIXED");
+          END;
+
+          IF FIELD'LAST < FIELD'BASE'LAST THEN
+
+               BEGIN
+                    PUT (FT, X, FORE => IDENT_INT(FIELD'LAST+Ident_Int(1)));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - FORE FIXED");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN STATUS_ERROR =>
+                         FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 4");
+                    WHEN USE_ERROR =>
+                         FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 4");
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - FORE FIXED");
+               END;
+
+               BEGIN
+                    PUT (FT, X, AFT => IDENT_INT(FIELD'LAST+Ident_Int(1)));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - AFT FIXED");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN STATUS_ERROR =>
+                         FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 5");
+                    WHEN USE_ERROR =>
+                         FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 5");
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - AFT FIXED");
+               END;
+
+               BEGIN
+                    PUT (FT, X, EXP => IDENT_INT(FIELD'LAST+Ident_Int(1)));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED - EXP FIXED");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN STATUS_ERROR =>
+                         FAILED ("STATUS_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 6");
+                    WHEN USE_ERROR =>
+                         FAILED ("USE_ERROR RAISED INSTEAD OF " &
+                                 "CONSTRAINT_ERROR - 6");
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - EXP FIXED");
+               END;
+
+          END IF;
+
+          BEGIN
+               PUT (FT, Y);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
+                       "RANGE - FILE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
+                            "RANGE - FILE");
+          END;
+
+          BEGIN
+               PUT (Y);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED FOR ITEM OUTSIDE " &
+                       "RANGE - DEFAULT");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED FOR ITEM OUTSIDE " &
+                            "RANGE - DEFAULT");
+          END;
+
+     END;
+
+     RESULT;
+
+END CE3806F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806g.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806g.ada
new file mode 100644
index 000000000..edfcf6a4b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806g.ada
@@ -0,0 +1,125 @@
+-- CE3806G.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 FIXED_IO PUT OPERATES ON FILES OF MODE OUT_FILE AND
+--     IF NO FILE IS SPECIFIED THE CURRENT DEFAULT OUTPUT FILE IS USED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 09/13/87  CREATED ORIGINAL TEST.
+--     BCB 10/03/90  ADDED THE STATEMENT "RAISE INCOMPLETE;" TO
+--                   NAME_ERROR EXCEPTION HANDLER.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3806G IS
+
+BEGIN
+
+     TEST ("CE3806G", "CHECK THAT FIXED_IO PUT OPERATES ON FILES " &
+                      "OF MODE OUT_FILE AND IF NO FILE IS SPECIFIED " &
+                      "THE CURRENT DEFAULT OUTPUT FILE IS USED");
+
+     DECLARE
+          FT1, FT2 : FILE_TYPE;
+          TYPE FX IS DELTA 0.5 RANGE -10.0 .. 10.0;
+          PACKAGE FXIO IS NEW FIXED_IO (FX);
+          USE FXIO;
+          INCOMPLETE : EXCEPTION;
+          X : FX := -1.5;
+
+     BEGIN
+
+          BEGIN
+               CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2));
+
+          SET_OUTPUT (FT2);
+
+          BEGIN
+               PUT (FT1, X);
+               PUT (X + 1.0);
+
+               CLOSE (FT1);
+
+               BEGIN
+                    OPEN (FT1, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               SET_OUTPUT (STANDARD_OUTPUT);
+
+               CLOSE (FT2);
+
+               OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2));
+
+               X := 0.0;
+               GET (FT1, X);
+               IF X /= -1.5 THEN
+                    FAILED ("VALUE INCORRECT - FIXED FROM FILE");
+               END IF;
+               X := 0.0;
+               GET (FT2, X);
+               IF X /= -0.5 THEN
+                    FAILED ("VALUE INCORRECT - FIXED FROM DEFAULT");
+               END IF;
+          END;
+
+          BEGIN
+               DELETE (FT1);
+               DELETE (FT2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3806G;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806h.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806h.ada
new file mode 100644
index 000000000..daaef6a9e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3806h.ada
@@ -0,0 +1,144 @@
+-- CE3806H.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 FIXED_IO PUT RAISES LAYOUT_ERROR WHEN THE NUMBER OF
+--     CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH.  CHECK
+--     THAT IT IS NOT RAISED, BUT RATHER NEW_LINE IS CALLED, WHEN THE
+--     NUMBER DOES NOT EXCEED THE MAX, BUT WHEN ADDED TO THE CURRENT
+--     COLUMN NUMBER, THE TOTAL EXCEEDS THE MAX.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 09/15/87  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3806H IS
+
+BEGIN
+
+     TEST ("CE3806H", "CHECK THAT FIXED_IO PUT RAISES " &
+                      "LAYOUT_ERROR CORRECTLY");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE FX IS DELTA 0.01 RANGE -200.0 .. 200.0;
+          PACKAGE FXIO IS NEW FIXED_IO (FX);
+          USE FXIO;
+          INCOMPLETE : EXCEPTION;
+          X : FX := 126.5;
+          Y : FX := -134.0;
+          Z : FX := 120.0;
+
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_LINE_LENGTH (FT, 4);
+
+          BEGIN
+               PUT (FT, X, FORE => 3, AFT => 1);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FIXED");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED");
+          END;
+
+          SET_LINE_LENGTH (FT,7);
+
+          BEGIN
+               PUT (FT, Y, FORE => 3, AFT => 2);
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED SECOND PUT - " &
+                            "FIXED");
+               WHEN OTHERS =>
+                    FAILED ("SOME EXCEPTION RAISED SECOND PUT - " &
+                            "FIXED");
+          END;
+
+          BEGIN
+               PUT (FT,Z, FORE => 4, AFT => 2);
+               IF LINE (FT) /= 2 THEN
+                    FAILED ("NEW_LINE NOT CALLED - FIXED");
+               END IF;
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED THIRD PUT - " &
+                            "FIXED");
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED THIRD PUT - FIXED");
+          END;
+
+          BEGIN
+               PUT (FT, "Y");
+               PUT (FT, Z, FORE => 3, AFT => 0);
+               NEW_LINE (FT);
+               PUT (FT, "Z");
+               PUT (FT, Y, FORE => 3, AFT => 2);
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED LAST PUT - " &
+                            "FIXED");
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED LAST PUT - FIXED ");
+          END;
+
+          CHECK_FILE (FT, "-134.00# 120.00#Y120.0#Z#-134.00#@%");
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+
+     END;
+
+     RESULT;
+
+END CE3806H;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3809a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3809a.ada
new file mode 100644
index 000000000..f854553fd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3809a.ada
@@ -0,0 +1,239 @@
+-- CE3809A.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 FLOAT I/O GET CAN READ A VALUE FROM A STRING.
+--     CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING
+--     OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION
+--     CHARACTERS.  CHECK THAT LAST CONTAINS THE INDEX OF THE LAST
+--     CHARACTER READ FROM THE STRING.
+
+-- HISTORY:
+--     SPS 10/07/82
+--     SPS 12/14/82
+--     JBG 12/21/82
+--     DWC 09/15/87  ADDED CASE TO INCLUDE ONLY TABS IN STRING AND
+--                   CHECKED THAT END_ERROR IS RAISED.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3809A IS
+BEGIN
+
+     TEST ("CE3809A", "CHECK THAT FLOAT_IO GET " &
+                      "OPERATES CORRECTLY ON STRINGS");
+
+     DECLARE
+          TYPE FL IS DIGITS 4;
+          PACKAGE FLIO IS NEW FLOAT_IO (FL);
+          USE FLIO;
+          X : FL;
+          STR : STRING (1..10) := "   10.25  ";
+          L : POSITIVE;
+     BEGIN
+
+-- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT
+          BEGIN
+               GET ("896.5  ", X, L);
+               IF X /= 896.5 THEN
+                    FAILED ("FLOAT VALUE FROM STRING INCORRECT");
+               END IF;
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FLOAT - 1");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - FLOAT - 1");
+          END;
+
+          IF L /= IDENT_INT (5) THEN
+               FAILED ("VALUE OF LAST INCORRECT - FLOAT - 1.  LAST IS" &
+                       INTEGER'IMAGE(L));
+          END IF;
+
+-- STRING LITERAL WITH BLANKS
+          BEGIN
+               GET ("   ", X, L);
+               FAILED ("END_ERROR NOT RAISED - FLOAT - 2");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= 5 THEN
+                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
+                                 "INCORRECT - 2.  LAST IS" &
+                                 INTEGER'IMAGE(L));
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FLOAT - 2");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 2");
+          END;
+
+-- NULL STRING LITERAL
+          BEGIN
+               GET ("", X, L);
+               FAILED ("END_ERROR NOT RAISED - FLOAT - 3");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= 5 THEN
+                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
+                                 "INCORRECT - 3.  LAST IS" &
+                                 INTEGER'IMAGE(L));
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FLOAT - 3");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 3");
+          END;
+
+-- NULL SLICE
+          BEGIN
+               GET (STR(5..IDENT_INT(2)), X, L);
+               FAILED ("END_ERROR NOT RAISED - FLOAT - 4");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= 5 THEN
+                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
+                                 "INCORRECT - 4.  LAST IS" &
+                                 INTEGER'IMAGE(L));
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FLOAT - 4");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 4");
+          END;
+
+-- SLICE WITH BLANKS
+          BEGIN
+               GET (STR(IDENT_INT(9)..10), X, L);
+               FAILED ("END_ERROR NOT RAISED - FLOAT - 5");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= IDENT_INT(5) THEN
+                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
+                                 "INCORRECT - 5.  LAST IS" &
+                                 INTEGER'IMAGE(L));
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FLOAT - 5");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 5");
+          END;
+
+-- NON-NULL SLICE
+          BEGIN
+               GET (STR(2..IDENT_INT(8)), X, L);
+               IF X /= 10.25 THEN
+                    FAILED ("FLOAT VALUE INCORRECT - 6");
+               END IF;
+               IF L /= 8 THEN
+                    FAILED ("LAST INCORRECT FOR SLICE - 6.  LAST IS" &
+                            INTEGER'IMAGE(L));
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - 6");
+          END;
+
+-- LEFT-JUSTIFIED, POSITIVE EXPONENT
+          BEGIN
+               GET ("1.34E+02", X, L);
+               IF X /= 134.0 THEN
+                    FAILED ("FLOAT WITH EXP FROM STRING INCORRECT - 7");
+               END IF;
+
+               IF L /= 8 THEN
+                    FAILED ("VALUE OF LAST INCORRECT - FLOAT - 7.  " &
+                            "LAST IS" & INTEGER'IMAGE(L));
+               END IF;
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_EROR RAISED - FLOAT - 7");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - FLOAT - 7");
+          END;
+
+-- RIGHT-JUSTIFIED, NEGATIVE EXPONENT
+          BEGIN
+               GET (" 25.0E-2", X, L);
+               IF X /= 0.25 THEN
+                    FAILED ("NEG EXPONENT INCORRECT - 8");
+               END IF;
+               IF L /= 8 THEN
+                    FAILED ("LAST INCORRECT - 8.  LAST IS" &
+                            INTEGER'IMAGE(L));
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - 8");
+          END;
+
+-- RIGHT-JUSTIFIED, NEGATIVE
+          GET ("  -1.50", X, L);
+          IF X /= -1.5 THEN
+               FAILED ("FLOAT IN RIGHT JUSTIFIED STRING INCORRECT - 9");
+          END IF;
+          IF L /= 7 THEN
+               FAILED ("LAST INCORRECT - 9.  LAST IS" &
+                       INTEGER'IMAGE(L));
+          END IF;
+
+-- HORIZONTAL TAB WITH BLANKS
+          BEGIN
+               GET (" " & ASCII.HT & "2.3E+2", X, L);
+               IF X /= 230.0 THEN
+                    FAILED ("FLOAT WITH TAB IN STRING INCORRECT - 10");
+               END IF;
+               IF L /= 8 THEN
+                    FAILED ("LAST INCORRECT FOR TAB - 10.  LAST IS" &
+                            INTEGER'IMAGE(L));
+               END IF;
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR FOR STRING WITH TAB - 10");
+               WHEN OTHERS =>
+                    FAILED ("SOME EXCEPTION RAISED FOR STRING WITH " &
+                            "TAB - 10");
+          END;
+
+-- HORIZONTAL TABS ONLY
+          BEGIN
+               GET (ASCII.HT & ASCII.HT, X, L);
+               FAILED ("END_ERROR NOT RAISED - FLOAT - 11");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= IDENT_INT(8) THEN
+                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
+                                 "INCORRECT - 11.  LAST IS" &
+                                 INTEGER'IMAGE(L));
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FLOAT - 11");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 11");
+          END;
+     END;
+
+     RESULT;
+
+END CE3809A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3809b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3809b.ada
new file mode 100644
index 000000000..45aca867e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3809b.ada
@@ -0,0 +1,239 @@
+-- CE3809B.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:
+--     CHECK THAT FIXED I/O GET CAN READ A VALUE FROM A STRING.
+--     CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING
+--     OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION
+--     CHARACTERS.  CHECK THAT LAST CONTAINS THE INDEX OF THE LAST
+--     CHARACTER READ FROM THE STRING.
+
+-- HISTORY:
+--     SPS 10/07/82
+--     SPS 12/14/82
+--     JBG 12/21/82
+--     DWC 09/15/87  ADDED CASE TO INCLUDE ONLY TABS IN STRING AND
+--                   CHECKED THAT END_ERROR IS RAISED.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3809B IS
+BEGIN
+
+     TEST ("CE3809B", "CHECK THAT FIXED_IO GET " &
+                      "OPERATES CORRECTLY ON STRINGS");
+
+     DECLARE
+          TYPE FX IS DELTA 0.001 RANGE -2.0 .. 1000.0;
+          PACKAGE FXIO IS NEW FIXED_IO (FX);
+          USE FXIO;
+          X : FX;
+          L : POSITIVE;
+          STR : STRING (1..10) := "   10.25  ";
+     BEGIN
+
+-- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT
+          BEGIN
+               GET ("896.5  ", X, L);
+               IF X /= 896.5 THEN
+                    FAILED ("FIXED VALUE FROM STRING INCORRECT");
+               END IF;
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FIXED - 1");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 1");
+          END;
+
+          IF L /= IDENT_INT (5) THEN
+               FAILED ("VALUE OF LAST INCORRECT - FIXED - 1.  " &
+                       "LAST IS" & INTEGER'IMAGE(L));
+          END IF;
+
+-- STRING LITERAL WITH BLANKS
+          BEGIN
+               GET ("   ", X, L);
+               FAILED ("END_ERROR NOT RAISED - FIXED - 2");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= 5 THEN
+                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
+                                 "INCORRECT - 2.  LAST IS"  &
+                                 INTEGER'IMAGE(L));
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FIXED - 2");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 2");
+          END;
+
+-- NULL STRING LITERAL
+          BEGIN
+               GET ("", X, L);
+               FAILED ("END_ERROR NOT RAISED - FIXED - 3");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= 5 THEN
+                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
+                                 "INCORRECT - 3.  LAST IS"  &
+                                 INTEGER'IMAGE(L));
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FIXED - 3");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 3");
+          END;
+
+-- NULL SLICE
+          BEGIN
+               GET (STR(5..IDENT_INT(2)), X, L);
+               FAILED ("END_ERROR NOT RAISED - FIXED - 4");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= 5 THEN
+                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
+                                 "INCORRECT - 4.  LAST IS"  &
+                                 INTEGER'IMAGE(L));
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FIXED - 4");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 4");
+          END;
+
+-- SLICE WITH BLANKS
+          BEGIN
+               GET (STR(IDENT_INT(9)..10), X, L);
+               FAILED ("END_ERROR NOT RAISED - FIXED - 5");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= IDENT_INT(5) THEN
+                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
+                                 "INCORRECT - 5.  LAST IS"  &
+                                 INTEGER'IMAGE(L));
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FIXED - 5");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 5");
+          END;
+
+-- NON-NULL SLICE
+          BEGIN
+               GET (STR(2..IDENT_INT(8)), X, L);
+               IF X /= 10.25 THEN
+                    FAILED ("FIXED VALUE INCORRECT - 6");
+               END IF;
+               IF L /= 8 THEN
+                    FAILED ("LAST INCORRECT FOR SLICE - 6.  " &
+                            "LAST IS" & INTEGER'IMAGE(L));
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - 6");
+          END;
+
+-- LEFT-JUSTIFIED, POSITIVE EXPONENT
+          BEGIN
+               GET ("1.34E+02", X, L);
+               IF X /= 134.0 THEN
+                    FAILED ("FIXED WITH EXP FROM STRING INCORRECT - 7");
+               END IF;
+
+               IF L /= 8 THEN
+                    FAILED ("VALUE OF LAST INCORRECT - FIXED - 7.  " &
+                            "LAST IS" & INTEGER'IMAGE(L));
+               END IF;
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_EROR RAISED - FIXED - 7");
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 7");
+          END;
+
+-- RIGHT-JUSTIFIED, NEGATIVE EXPONENT
+          BEGIN
+               GET (" 25.0E-2", X, L);
+               IF X /= 0.25 THEN
+                    FAILED ("NEG EXPONENT INCORRECT - 8");
+               END IF;
+               IF L /= 8 THEN
+                    FAILED ("LAST INCORRECT - 8.  " &
+                            "LAST IS" & INTEGER'IMAGE(L));
+               END IF;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION RAISED - 8");
+          END;
+
+-- RIGHT-JUSTIFIED, NEGATIVE
+          GET ("  -1.50", X, L);
+          IF X /= -1.5 THEN
+               FAILED ("FIXED IN RIGHT JUSTIFIED STRING INCORRECT - 9");
+          END IF;
+          IF L /= 7 THEN
+               FAILED ("LAST INCORRECT - 9.  " &
+                       "LAST IS" & INTEGER'IMAGE(L));
+          END IF;
+
+-- HORIZONTAL TAB WITH BLANK
+          BEGIN
+               GET (" " & ASCII.HT & "2.3E+2", X, L);
+               IF X /= 230.0 THEN
+                    FAILED ("FIXED WITH TAB IN STRING INCORRECT - 10");
+               END IF;
+               IF L /= 8 THEN
+                    FAILED ("LAST INCORRECT FOR TAB - 10.  " &
+                            "LAST IS" & INTEGER'IMAGE(L));
+               END IF;
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR FOR STRING WITH TAB - 10");
+               WHEN OTHERS =>
+                    FAILED ("EXCEPTION FOR STRING WITH TAB - 10");
+          END;
+
+-- HORIZONTAL TABS ONLY
+
+          BEGIN
+               GET (ASCII.HT & ASCII.HT, X, L);
+               FAILED ("END_ERROR NOT RAISED - FIXED - 11");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= IDENT_INT(8) THEN
+                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
+                                 "INCORRECT - 11.  LAST IS"  &
+                                 INTEGER'IMAGE(L));
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED - FIXED - 11");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 11");
+          END;
+     END;
+
+     RESULT;
+
+END CE3809B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3810a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3810a.ada
new file mode 100644
index 000000000..f51728c43
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3810a.ada
@@ -0,0 +1,114 @@
+-- CE3810A.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 FLOAT_IO PUT CAN OPERATE ON STRINGS.  ALSO CHECK THAT
+--     LAYOUT_ERROR IS RAISED WHEN THE STRING IS INSUFFICIENTLY LONG.
+
+-- HISTORY:
+--     SPS 10/07/82
+--     VKG 01/20/83
+--     SPS 02/18/83
+--     DWC 09/15/87  SPLIT CASE FOR FIXED_IO INTO CE3810B.ADA AND
+--                   ADDED CASED FOR AFT AND EXP TO RAISE LAYOUT_ERROR.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3810A IS
+BEGIN
+
+     TEST ("CE3810A", "CHECK THAT FLOAT_IO PUT " &
+                      "OPERATES ON STRINGS CORRECTLY");
+
+     DECLARE
+          TYPE FL IS DIGITS 4;
+          PACKAGE FLIO IS NEW FLOAT_IO (FL);
+          USE FLIO;
+          ST  : STRING (1 .. 2 + (FL'DIGITS-1) + 3 + 2);
+          ST1 : STRING (1 .. 10) := " 2.345E+02";
+          ST2 : STRING (1 .. 2);
+     BEGIN
+          PUT (ST, 234.5);
+          IF ST /= ST1 THEN
+               FAILED ("PUT FLOAT TO STRING INCORRECT; OUTPUT WAS """ &
+                        ST & """");
+          END IF;
+
+          BEGIN
+               PUT (ST(1 .. 8), 234.5);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 1");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 1");
+          END;
+
+          BEGIN
+               PUT (ST, 2.3, 9, 0);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 2");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 2");
+          END;
+
+          BEGIN
+               PUT (ST2, 2.0, 0, 0);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 3");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 3");
+          END;
+
+          BEGIN
+               PUT (ST, 2.345, 6, 2);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 4");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 4");
+          END;
+
+          BEGIN
+               PUT (ST, 2.0, 0, 7);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT - 5");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FLOAT - 5");
+          END;
+     END;
+
+     RESULT;
+
+END CE3810A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3810b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3810b.ada
new file mode 100644
index 000000000..dfdbd56c0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3810b.ada
@@ -0,0 +1,122 @@
+-- CE3810B.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 FIXED_IO PUT CAN OPERATE ON STRINGS.  ALSO CHECK THAT
+--     LAYOUT_ERROR IS RAISED WHEN THE STRING IS INSUFFICIENTLY LONG.
+
+-- HISTORY:
+--     DWC 09/15/87  CREATE ORIGINAL TEST.
+--     JRL 02/28/96  Changed upper bound of type FX from 1000.0 to 250.0.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3810B IS
+BEGIN
+
+     TEST ("CE3810B", "CHECK THAT FIXED_IO PUT CAN OPERATE ON " &
+                      "STRINGS.  ALSO CHECK THAT LAYOUT_ERROR IS " &
+                      "RAISED WHEN THE STRING IS INSUFFICIENTLY LONG");
+
+     DECLARE
+          TYPE FX IS DELTA 0.0001 RANGE 0.0 .. 250.0;
+          PACKAGE FXIO IS NEW FIXED_IO (FX);
+          USE FXIO;
+          ST1 : CONSTANT STRING  := "  234.5000";
+          ST : STRING (ST1'RANGE);
+          ST2 : STRING (1 .. 2);
+
+     BEGIN
+          BEGIN
+               PUT (ST, 234.5);
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    FAILED ("LAYOUT_ERROR RAISED ON PUT" &
+                            "TO STRING - FIXED");
+               WHEN OTHERS =>
+                    FAILED ("SOME EXCEPTION RAISED ON PUT" &
+                            "TO STRING -FIXED");
+          END;
+
+          IF ST /= ST1 THEN
+               FAILED ("PUT FIXED TO STRING INCORRECT; OUTPUT " &
+                       "WAS """ & ST & """");
+          END IF;
+
+          BEGIN
+               PUT (ST (1..7), 234.5000);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 1");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 1");
+          END;
+
+          BEGIN
+               PUT (ST, 2.3, 9, 0);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 2");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 2");
+          END;
+
+          BEGIN
+               PUT (ST2, 2.0, 0, 0);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 3");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 3");
+          END;
+
+          BEGIN
+               PUT (ST, 2.345, 6, 2);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 4");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 4");
+          END;
+
+          BEGIN
+               PUT (ST, 2.0, 0, 7);
+               FAILED ("LAYOUT_ERROR NOT RAISED - FIXED - 5");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 5");
+          END;
+     END;
+
+     RESULT;
+END CE3810B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3815a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3815a.ada
new file mode 100644
index 000000000..196ff86cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3815a.ada
@@ -0,0 +1,103 @@
+-- CE3815A.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 OPERATIONS IN GENERIC PACKAGE FLOAT_IO ALL HAVE
+--     THE CORRECT PARAMETER NAMES.
+
+-- HISTORY:
+--     JET 10/28/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+PROCEDURE CE3815A IS
+
+     STR : STRING(1..20) := (OTHERS => ' ');
+     FIN, FOUT : FILE_TYPE;
+     F : FLOAT;
+     L : POSITIVE;
+     FILE_OK : BOOLEAN := FALSE;
+
+     PACKAGE FIO IS NEW FLOAT_IO(FLOAT);
+     USE FIO;
+
+BEGIN
+     TEST ("CE3815A", "CHECK THAT THE OPERATIONS IN GENERIC PACKAGE " &
+                      "FLOAT_IO ALL HAVE THE CORRECT PARAMETER NAMES");
+
+     PUT (TO => STR, ITEM => 1.0, AFT => 3, EXP => 3);
+     GET (FROM => STR, ITEM => F, LAST => L);
+
+     BEGIN
+          CREATE(FOUT, OUT_FILE, LEGAL_FILE_NAME);
+          FILE_OK := TRUE;
+     EXCEPTION
+          WHEN OTHERS =>
+               COMMENT("OUTPUT FILE COULD NOT BE CREATED");
+     END;
+
+     IF FILE_OK THEN
+          BEGIN
+               PUT (FILE => FOUT, ITEM => 1.0, FORE => 3, AFT => 3,
+                    EXP => 3);
+               NEW_LINE(FOUT);
+
+               CLOSE(FOUT);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED("OUTPUT FILE COULD NOT BE WRITTEN");
+                    FILE_OK := FALSE;
+          END;
+     END IF;
+
+     IF FILE_OK THEN
+          BEGIN
+               OPEN(FIN, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED("INPUT FILE COULD NOT BE OPENED");
+                    FILE_OK := FALSE;
+          END;
+     END IF;
+
+     IF FILE_OK THEN
+          BEGIN
+               GET (FILE => FIN, ITEM => F, WIDTH => 10);
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED ("DATA COULD NOT BE READ FROM FILE");
+          END;
+
+          BEGIN
+               DELETE(FIN);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    COMMENT("FILE COULD NOT BE DELETED");
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED ERROR AT DELETION");
+          END;
+     END IF;
+
+     RESULT;
+END CE3815A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3901a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3901a.ada
new file mode 100644
index 000000000..1760dd976
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3901a.ada
@@ -0,0 +1,106 @@
+-- CE3901A.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 GET AND PUT FOR ENUMERATED TYPES RAISE STATUS ERROR
+--     IF THE FILE IS NOT OPEN.
+
+-- HISTORY:
+--     SPS 10/07/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     DWC 09/16/87  ADDED AN ATTEMPT TO CREATE A FILE AND THEN
+--                   RETESTED OBJECTIVE.
+--     BCB 10/03/90  ADDED NAME_ERROR AS A CHOICE TO THE EXCEPTION
+--                   HANDLER FOR CREATE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3901A IS
+BEGIN
+
+     TEST ("CE3901A", "CHECK THAT GET AND PUT FOR ENUMERATED TYPES " &
+                      "RAISE STATUS ERROR IF THE FILE IS NOT OPEN.");
+
+     DECLARE
+          TYPE COLOR IS (RED, BLUE, GREEN, ORANGE, YELLOW);
+          FT : FILE_TYPE;
+          PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
+          USE COLOR_IO;
+          X : COLOR;
+     BEGIN
+          BEGIN
+               PUT (FT, RED);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT - 1");
+          END;
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("STATUS_ERROR NOT RAISED - GET - 1");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET - 1");
+          END;
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);  -- THIS IS JUST
+               CLOSE (FT);                   -- AN ATTEMPT TO CREATE A
+          EXCEPTION                          -- FILE.  OBJECTIVE IS MET
+               WHEN USE_ERROR                -- EITHER WAY.
+                  | NAME_ERROR =>  NULL;
+          END;
+
+          BEGIN
+               PUT (FT, RED);
+               FAILED ("STATUS_ERROR NOT RAISED - PUT - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PUT - 2");
+          END;
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("STATUS_ERROR NOT RAISED - GET - 2");
+          EXCEPTION
+               WHEN STATUS_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - GET - 2");
+          END;
+     END;
+
+     RESULT;
+
+END CE3901A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3902b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3902b.ada
new file mode 100644
index 000000000..9f5359949
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3902b.ada
@@ -0,0 +1,117 @@
+-- CE3902B.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 OPERATIONS IN GENERIC PACKAGE ENUMERATION_IO
+--     ALL HAVE THE CORRECT PARAMETER NAMES.
+
+-- HISTORY:
+--     JLH 08/25/88  CREATED ORIGINAL TEST.
+--     RJW 02/28/90  ADDED CODE TO PREVENT MODE_ERROR FROM BEING RAISED.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3902B IS
+
+     TYPE COLOR IS (RED, BLUE, GREEN);
+     PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
+     USE COLOR_IO;
+
+     FILE1 : FILE_TYPE;
+     CRAYON : COLOR := RED;
+     INDEX : POSITIVE;
+     NUM : FIELD := 5;
+     COLOR_STRING : STRING (1..5);
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3902B", "CHECK THAT THE OPERATIONS IN GENERIC PACKAGE " &
+                      "ENUMERATION_IO ALL HAVE THE CORRECT PARAMETER " &
+                      "NAMES");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_OUTPUT (FILE1);
+
+          PUT (FILE => FILE1, ITEM => CRAYON, WIDTH => NUM,
+               SET => UPPER_CASE);
+
+          PUT (ITEM => GREEN, WIDTH => 5, SET => LOWER_CASE);
+
+          PUT (TO => COLOR_STRING, ITEM => BLUE, SET => UPPER_CASE);
+
+          CLOSE (FILE1);
+
+          SET_OUTPUT (STANDARD_OUTPUT);
+
+          BEGIN
+               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                                    "MODE IN_FILE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_INPUT (FILE1);
+
+          GET (FILE => FILE1, ITEM => CRAYON);
+
+          GET (ITEM => CRAYON);
+
+          GET (FROM => COLOR_STRING, ITEM => CRAYON, LAST => INDEX);
+
+          BEGIN
+               DELETE (FILE1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3902B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3904a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3904a.ada
new file mode 100644
index 000000000..7fe900b6d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3904a.ada
@@ -0,0 +1,117 @@
+-- CE3904A.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 LAST NONBLANK CHARACTER IN A FILE MAY BE READ BY
+--     'GET' IN ENUMERATION_IO WITHOUT RAISING END_ERROR, AND THAT AFTER
+--     THE LAST CHARACTER OF THE FILE HAS BEEN READ, ANY ATTEMPT TO READ
+--     FURTHER CHARACTERS WILL RAISE END_ERROR.
+
+-- HISTORY:
+--     JET 08/19/88  CREATED ORIGINAL TEST.
+
+WITH REPORT, TEXT_IO;  USE REPORT, TEXT_IO;
+PROCEDURE CE3904A IS
+
+     TYPE ENUM IS (THE, QUICK, BROWN, X);
+     E : ENUM;
+
+     PACKAGE EIO IS NEW ENUMERATION_IO(ENUM);
+     USE EIO;
+
+     F : FILE_TYPE;
+
+     FILE_OK : BOOLEAN := FALSE;
+
+BEGIN
+     TEST ("CE3904A", "CHECK THAT THE LAST NONBLANK CHARACTER IN A " &
+                      "FILE MAY BE READ BY 'GET' IN ENUMERATION_IO " &
+                      "WITHOUT RAISING END_ERROR, AND THAT AFTER THE " &
+                      "LAST CHARACTER OF THE FILE HAS BEEN READ, ANY " &
+                      "ATTEMPT TO READ FURTHER CHARACTERS WILL RAISE " &
+                      "END_ERROR");
+
+     BEGIN
+          CREATE(F, OUT_FILE, LEGAL_FILE_NAME);
+          FILE_OK := TRUE;
+     EXCEPTION
+          WHEN OTHERS =>
+               NOT_APPLICABLE("DATA FILE COULD NOT BE OPENED FOR " &
+                              "WRITING");
+     END;
+
+     IF FILE_OK THEN
+          BEGIN
+               PUT(F, THE); NEW_LINE(F);
+               PUT(F, QUICK); NEW_LINE(F);
+               PUT(F, BROWN); NEW_LINE(F);
+               PUT(F, X); NEW_LINE(F);
+               CLOSE(F);
+          EXCEPTION
+               WHEN OTHERS =>
+                    NOT_APPLICABLE("DATA FILE COULD NOT BE WRITTEN");
+                    FILE_OK := FALSE;
+          END;
+     END IF;
+
+     IF FILE_OK THEN
+          BEGIN
+               OPEN(F, IN_FILE, LEGAL_FILE_NAME);
+               FOR I IN 0..3 LOOP
+                    GET(F, E);
+                    IF E /= ENUM'VAL(I) THEN
+                         FAILED("INCORRECT VALUE READ -" &
+                                INTEGER'IMAGE(I));
+                    END IF;
+               END LOOP;
+          EXCEPTION
+               WHEN OTHERS =>
+                    FAILED("UNEXPECTED EXCEPTION RAISED BEFORE END " &
+                           "OF FILE");
+                    FILE_OK := FALSE;
+          END;
+     END IF;
+
+     IF FILE_OK THEN
+          BEGIN
+               GET(F, E);
+               FAILED("NO EXCEPTION RAISED AFTER END OF FILE");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED("INCORRECT EXCEPTION RAISED AFTER END OF " &
+                           "FILE");
+          END;
+
+          BEGIN
+               DELETE(F);
+          EXCEPTION
+               WHEN OTHERS =>
+                    COMMENT("DATA FILE COULD NOT BE DELETED");
+          END;
+     END IF;
+
+     RESULT;
+END CE3904A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3904b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3904b.ada
new file mode 100644
index 000000000..408e5909c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3904b.ada
@@ -0,0 +1,142 @@
+-- CE3904B.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 END_ERROR IS RAISED BY GET WITH AN ENUMERATION TYPE
+--     WHEN THE ONLY REMAINING CHARACTERS IN THE FILE ARE SPACES,
+--     HORIZONTAL TABULATION CHARACTERS, LINE TERMINATORS, AND PAGE
+--     TERMINATORS.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS THAT SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     JLH 07/15/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE CE3904B IS
+
+     TYPE COLOR IS (RED, BLUE, GREEN);
+     PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
+     USE COLOR_IO;
+
+     FILE : FILE_TYPE;
+     ITEM : COLOR;
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3904B", "CHECK THAT END_ERROR IS RAISED BY GET WITH " &
+                      "AN ENUMERATION TYPE WHEN THE ONLY REMAINING " &
+                      "CHARACTERS IN THE FILE ARE SPACES, HORIZONTAL " &
+                      "TABULATION CHARACTERS, LINE TERMINATORS, AND " &
+                      "PAGE TERMINATORS");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FILE, RED);
+          NEW_LINE (FILE);
+          NEW_LINE (FILE);
+          NEW_PAGE (FILE);
+          PUT (FILE, ASCII.HT);
+          PUT (FILE, GREEN);
+          NEW_LINE (FILE);
+          NEW_LINE (FILE);
+          NEW_PAGE (FILE);
+          PUT (FILE, ' ');
+          PUT (FILE, ASCII.HT);
+          PUT (FILE, ' ');
+
+          CLOSE (FILE);
+
+          BEGIN
+               OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                                    "MODE IN_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON OPEN");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FILE, ITEM);
+          IF ITEM /= RED THEN
+               FAILED ("INCORRECT VALUE READ - 1");
+          END IF;
+
+          GET (FILE, ITEM);
+          IF ITEM /= GREEN THEN
+               FAILED ("INCORRECT VALUE READ - 2");
+          END IF;
+
+          BEGIN
+               GET (FILE, ITEM);
+               FAILED ("END_ERROR NOT RAISED FOR GET");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON GET");
+          END;
+
+          IF NOT END_OF_FILE (FILE) THEN
+               FAILED ("END_OF_FILE NOT TRUE AFTER RAISING EXCEPTION");
+          END IF;
+
+          BEGIN
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3904B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905a.ada
new file mode 100644
index 000000000..4fa69ef61
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905a.ada
@@ -0,0 +1,145 @@
+-- CE3905A.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 GET FOR ENUMERATION TYPES OPERATES ON FILE OF MODE
+--     IN_FILE AND THAT WHEN NO FILE IS SPECIFIED IT OPERATES ON THE
+--     CURRENT DEFAULT INPUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/07/82
+--     SPS 12/22/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST.
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/16/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3905A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3905A", "CHECK THAT GET FOR ENUMERATION TYPES " &
+                      "OPERATES ON FILE OF MODE IN_FILE AND THAT " &
+                      "WHEN NO FILE IS SPECIFIED IT OPERATES ON " &
+                      "THE CURRENT DEFAULT INPUT_FILE");
+
+     DECLARE
+          TYPE DAY IS (MONDAY, TUESDAY, WEDNESDAY, THURSDAY, FRIDAY);
+          PACKAGE DAY_IO IS NEW ENUMERATION_IO (DAY);
+          FT : FILE_TYPE;
+          FILE : FILE_TYPE;
+          USE DAY_IO;
+          X : DAY;
+     BEGIN
+
+-- CREATE AND INITIALIZE DATA FILES.
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "WEDNESDAY");
+          NEW_LINE (FT);
+          PUT (FT, "FRIDAY");
+
+          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME(2));
+
+          PUT (FILE, "TUESDAY");
+          NEW_LINE (FILE);
+          PUT (FILE, "THURSDAY");
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                                    "FOR IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          CLOSE (FILE);
+          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME(2));
+
+          SET_INPUT (FILE);
+
+-- BEGIN TEST
+
+          GET (FT, X);
+          IF X /= WEDNESDAY THEN
+               FAILED ("VALUE FROM FILE INCORRECT");
+          END IF;
+
+          GET (X);
+          IF X /= TUESDAY THEN
+               FAILED ("VALUE FROM DEFAULT INCORRECT");
+          END IF;
+
+          GET (FT, X);
+          IF X /= FRIDAY THEN
+               FAILED ("VALUE FROM FILE INCORRECT");
+          END IF;
+
+          GET (FILE, X);
+          IF X /= THURSDAY THEN
+               FAILED ("VALUE FROM DEFAULT INCORRECT");
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+               DELETE (FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3905A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905b.ada
new file mode 100644
index 000000000..5823f2962
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905b.ada
@@ -0,0 +1,111 @@
+-- CE3905B.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 GET FOR ENUMERATION TYPES RAISE MODE_ERROR WHEN THE
+--     MODE OF THE FILE SPECIFIED IS OUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT CREATE FOR TEMP FILES WITH OUT_FILE.
+
+-- HISTORY:
+--     SPS 10/07/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST.
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/16/87  CORRECTED EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3905B IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3905B", "CHECK THAT ENUMERATION_IO GET RAISES " &
+                      "MODE_ERROR WHEN THE MODE OF THE FILE IS " &
+                      "OUT_FILE");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE COLOR IS (RED, BLUE, GREEN, YELLOW);
+          X : COLOR;
+          PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
+          USE COLOR_IO;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "FOR TEMP FILES WITH OUT_FILE " &
+                                    "MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               GET (FT, X);
+               FAILED ("MODE_ERROR NOT RAISED - FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FILE");
+          END;
+
+          BEGIN
+               GET (STANDARD_OUTPUT, X);
+               FAILED ("MODE_ERROR NOT RAISED - STANDARD_OUTPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - STANDARD_OUTPUT");
+          END;
+
+          BEGIN
+               GET (CURRENT_OUTPUT, X);
+               FAILED ("MODE_ERROR NOT RAISED - CURRENT_OUTPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CURRENT_OUTPUT");
+          END;
+
+          CLOSE (FT);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3905B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905c.ada
new file mode 100644
index 000000000..226abb9bc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905c.ada
@@ -0,0 +1,202 @@
+-- CE3905C.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 GET FOR ENUMERATION TYPES RAISES DATA_ERROR WHEN THE
+--     ELEMENT RETRIEVED IS NOT OF THE TYPE EXPECTED OR IS OUT OF THE
+--     RANGE OF A SUBTYPE.  ALSO CHECK THAT CONSTRAINT_ERROR IS RAISED
+--     IF THE VALUE READ IS OUT OF RANGE OF THE ITEM PARAMETER, BUT
+--     WITHIN THE RANGE OF THE INSTANTIATED TYPE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/08/82
+--     SPS 12/14/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST.
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/16/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3905C IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3905C", "CHECK THAT GET FOR ENUMERATION TYPES RAISES " &
+                      "DATA_ERROR WHEN THE ELEMENT RETRIEVED IS NOT " &
+                      "OF THE TYPE EXPECTED OR IS OUT OF THE RANGE " &
+                      "OF A SUBTYPE.  ALSO CHECK THAT " &
+                      "CONSTRAINT_ERROR IS RAISED IF THE VALUE READ " &
+                      "IS OUT OF RANGE OF THE ITEM PARAMETER, BUT " &
+                      "WITHIN THE RANGE OF THE INSTANTIATED TYPE");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE COLOR IS (RED, BLUE, YELLOW, WHITE, ORANGE, GREEN,
+                         PURPLE, BLACK);
+          SUBTYPE P_COLOR IS COLOR RANGE RED .. YELLOW;
+          CRAYON : COLOR := BLACK;
+          PAINT : P_COLOR := BLUE;
+          ST : STRING (1 .. 2);
+          PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
+          USE COLOR_IO;
+     BEGIN
+
+-- CREATE AND INITIALIZE DATA FILE
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "BROWN");
+          NEW_LINE (FT);
+          PUT (FT, "ORANGE");
+          NEW_LINE (FT);
+          PUT (FT, "GREEN");
+          NEW_LINE (FT);
+          PUT (FT, "WHITE");
+          NEW_LINE (FT);
+          PUT (FT, "WHI");
+          NEW_LINE (FT);
+          PUT (FT, "TE");
+          NEW_LINE (FT);
+          PUT (FT, "RED");
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; OPEN WITH " &
+                             "IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+-- START TEST
+
+          BEGIN
+               GET (FT, CRAYON);                  -- BROWN
+               FAILED ("DATA_ERROR NOT RAISED - 1");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    IF CRAYON /= BLACK THEN
+                         FAILED ("ITEM CRAYON AFFECTED - 1");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 1");
+          END;
+
+          BEGIN
+               GET (FT, PAINT);                   -- ORANGE
+               FAILED ("CONSTRAINT_ERROR NOT RAISED");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    IF PAINT /= BLUE THEN
+                         FAILED ("ITEM PAINT AFFECTED - 2");
+                    END IF;
+               WHEN DATA_ERROR =>
+                    FAILED ("DATA_ERROR RAISED FOR ITEM SUBTYPE");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 2");
+          END;
+
+          DECLARE
+               PACKAGE P_COLOR_IO IS NEW ENUMERATION_IO (P_COLOR);
+               USE P_COLOR_IO;
+          BEGIN
+               BEGIN
+                    P_COLOR_IO.GET (FT, PAINT);   -- GREEN
+                    FAILED ("DATA_ERROR NOT RAISED - 3");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF PAINT /= BLUE THEN
+                              FAILED ("ITEM PAINT AFFECTED - 3");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 3");
+               END;
+
+               BEGIN
+                    P_COLOR_IO.GET (FT, PAINT);   -- WHITE
+                    FAILED ("DATA_ERROR NOT RAISED - 3A");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 3A");
+               END;
+          END;
+
+          BEGIN
+               GET (FT, CRAYON);                  -- WHI
+               FAILED ("DATA_ERROR NOT RAISED - 4");
+          EXCEPTION
+               WHEN DATA_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 4");
+          END;
+
+          GET (FT, ST);                 -- TE
+
+          GET (FT, CRAYON);                  -- RED
+          IF CRAYON /= RED THEN
+               FAILED ("READING NOT CONTINUED CORRECTLY AFTER" &
+                       "DATA_ERROR EXCEPTION");
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3905C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905l.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905l.ada
new file mode 100644
index 000000000..759c7de6f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3905l.ada
@@ -0,0 +1,311 @@
+-- CE3905L.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 DATA_ERROR IS RAISED, BY GET, WHEN THE INPUT CONTAINS
+--
+--     1. EMBEDDED BLANKS.
+--     2. SINGLY QUOTED CHARACTER LITERALS.
+--     3. IDENTIFIERS BEGINNING WITH NON LETTERS.
+--     4. IDENTIFIERS CONTAINING SPECIAL CHARACTERS.
+--     5. CONSECUTIVE UNDERSCORES.
+--     6. LEADING OR TRAILING UNDERSCORES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     VKG 02/14/83
+--     SPS 03/16/83
+--     CPP 07/30/84
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/16/87  REMOVED UNNECESSARY CODE AND CORRECTED
+--                   EXCEPTION HANDLING.
+
+WITH TEXT_IO; USE TEXT_IO;
+WITH REPORT; USE REPORT;
+
+PROCEDURE CE3905L IS
+
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+     TEST ("CE3905L", "CHECK GET FOR ENUMERATION_IO " &
+                      "WITH LEXICAL ERRORS");
+     DECLARE
+          FT : FILE_TYPE;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, "RED ISH");
+          NEW_LINE (FT);
+          PUT (FT, "'A ");
+          NEW_LINE (FT);
+          PUT (FT, "2REDISH");
+          NEW_LINE (FT);
+          PUT (FT, "BLUE$%ISH");
+          NEW_LINE (FT);
+          PUT (FT, "RED__ISH");
+          NEW_LINE (FT);
+          PUT (FT, "_YELLOWISH");
+          NEW_LINE (FT);
+          PUT  (FT, "GREENISH_");
+          NEW_LINE (FT);
+
+          CLOSE (FT);
+
+          DECLARE
+               TYPE COLOUR IS
+                    ( GREYISH,
+                      REDISH ,
+                      BLUEISH,
+                      YELLOWISH,
+                      GREENISH, 'A');
+               PACKAGE COLOUR_IO IS NEW ENUMERATION_IO(COLOUR);
+               USE COLOUR_IO;
+               X : COLOUR := GREYISH;
+               CH : CHARACTER;
+          BEGIN
+
+               BEGIN
+                    OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+               EXCEPTION
+                    WHEN USE_ERROR =>
+                         NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                         "OPEN WITH IN_FILE MODE");
+                         RAISE INCOMPLETE;
+               END;
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - 1");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= GREYISH THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 1");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 1");
+               END;
+
+               IF END_OF_LINE (FT) THEN
+                    FAILED ("GET STOPPED AT END OF LINE - 1");
+               ELSE
+                    GET (FT, CH);
+                    IF CH /= ' ' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION " &
+                                 "- 1: CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - 2");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= GREYISH THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 2");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 2");
+               END;
+
+               IF END_OF_LINE (FT) THEN
+                    FAILED ("GET STOPPED AT END OF LINE - 2");
+               ELSE
+                    GET (FT, CH);
+                    IF CH /= ' ' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION " &
+                                 "- 2: CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - 3");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= GREYISH THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 3");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 3");
+               END;
+
+               IF END_OF_LINE (FT) THEN
+                    FAILED ("GET STOPPED AT END OF LINE - 3");
+               ELSE
+                    GET (FT, CH);
+                    IF CH /= '2' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION " &
+                                 "- 3: CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - 4");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= GREYISH THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 4");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 4");
+               END;
+
+               IF END_OF_LINE (FT) THEN
+                    FAILED ("GET STOPPED AT END OF LINE - 4");
+               ELSE
+                    GET (FT, CH);
+                    IF CH /= '$' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION " &
+                                 "- 4: CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - 5");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= GREYISH THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 5");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 5");
+               END;
+
+               IF END_OF_LINE (FT) THEN
+                    FAILED ("GET STOPPED AT END OF LINE - 5");
+               ELSE
+                    GET (FT, CH);
+                    IF CH /= '_' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION " &
+                                 "- 5: CHAR IS " & CH);
+                    ELSE
+                         GET (FT, CH);
+                         IF CH /= 'I' THEN
+                              FAILED ("ERROR READING DATA - 5");
+                         END IF;
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - 6");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= GREYISH THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 6");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 6");
+               END;
+
+               IF END_OF_LINE (FT) THEN
+                    FAILED ("GET STOPPED AT END OF LINE - 6");
+               ELSE
+                    GET (FT, CH);
+                    IF CH /= '_' THEN
+                         FAILED ("GET STOPPED AT WRONG POSITION " &
+                                 "- 6: CHAR IS " & CH);
+                    END IF;
+               END IF;
+
+               SKIP_LINE (FT);
+
+               BEGIN
+                    GET (FT, X);
+                    FAILED ("DATA_ERROR NOT RAISED - 7");
+               EXCEPTION
+                    WHEN DATA_ERROR =>
+                         IF X /= GREYISH THEN
+                              FAILED ("ACTUAL PARAMETER TO GET " &
+                                      "AFFECTED ON DATA_ERROR - 7");
+                         END IF;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED - 7");
+               END;
+
+               IF NOT END_OF_LINE (FT) THEN
+                    BEGIN
+                         GET (FT, X);
+                         FAILED ("GET STOPPED AT WRONG  POSITION " &
+                                 "- 7");
+                    EXCEPTION
+                         WHEN END_ERROR =>
+                              NULL;
+                         WHEN OTHERS =>
+                              FAILED ("WRONG EXCEPTION RAISED FOR " &
+                                      "EMPTY FILE - 7");
+                    END;
+               END IF;
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3905L;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906a.ada
new file mode 100644
index 000000000..a2dc87925
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906a.ada
@@ -0,0 +1,110 @@
+-- CE3906A.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 PUT FOR ENUMERATION TYPES CAN OPERATE ON FILES OF
+--     MODE OUT_FILE AND THAT WHEN NO FILE PARAMETER IS SPECIFIED
+--     THE CURRENT DEFAULT OUTPUT FILE IS USED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEMPORARY TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/08/82
+--     SPS 01/03/83
+--     SPS 02/18/83
+--     JBG 02/22/84  CHANGED TO .ADA TEST.
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/17/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
+--                   HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3906A IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3906A", "CHECK THAT PUT FOR ENUMERATION TYPES CAN " &
+                      "OPERATE ON FILES OF MODE OUT_FILE AND THAT " &
+                      "WHEN NO FILE PARAMETER IS SPECIFIED THE " &
+                      "CURRENT DEFAULT OUTPUT FILE IS USED. CHECK " &
+                      "THAT ENUMERATION_IO PUT OPERATES ON OUT_FILE " &
+                      "FILES");
+
+     DECLARE
+          FT1, FT2 : FILE_TYPE;
+          TYPE COLOR IS (ROSE, VANILLA, CHARCOAL, CHOCOLATE);
+          CRAYON : COLOR := ROSE;
+          PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
+          USE COLOR_IO;
+     BEGIN
+
+          BEGIN
+               CREATE (FT1, OUT_FILE);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "FOR TEMP FILES WITH OUT_FILE " &
+                                    "MODE - 1");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FT2, OUT_FILE);
+
+          SET_OUTPUT (FT2);
+
+          PUT (FT1, CRAYON);
+          NEW_LINE (FT1);
+          PUT (FT1, CHOCOLATE);
+
+          CRAYON := CHARCOAL;
+
+          PUT (CRAYON);
+          NEW_LINE;
+          PUT (VANILLA);
+
+-- CHECK OUTPUT
+
+          SET_OUTPUT (STANDARD_OUTPUT);
+          COMMENT ("CHECKING FT1");
+          CHECK_FILE (FT1, "ROSE#CHOCOLATE#@%");
+
+          COMMENT ("CHECKING FT2");
+          CHECK_FILE (FT2, "CHARCOAL#VANILLA#@%");
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3906A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906b.ada
new file mode 100644
index 000000000..3e0234084
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906b.ada
@@ -0,0 +1,133 @@
+-- CE3906B.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 PUT FOR ENUMERATION TYPES RAISES MODE_ERROR WHEN
+--     APPLIED TO FILES OF MODE IN_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/08/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST.
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/17/87  REMOVED DEPENDENCY ON RESET AND CORRECTED
+--                   EXCEPTION HANDLERS.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3906B IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3906B", "CHECK THAT PUT FOR ENUMERATION TYPES RAISES " &
+                      "MODE_ERROR WHEN APPLIED TO FILES OF MODE " &
+                      "IN_FILE");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE FLOWER IS (ROSE, DAISY, SNAPDRAGON, VIOLET, CARNATION);
+          PACKAGE FLOWER_IO IS NEW ENUMERATION_IO (FLOWER);
+          USE FLOWER_IO;
+          X : FLOWER := DAISY;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          PUT (FT, X);
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          BEGIN
+               PUT (FT, X);
+               FAILED ("MODE_ERROR NOT RAISED - FILE");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - FILE");
+          END;
+
+          BEGIN
+               PUT (STANDARD_INPUT, X);
+               FAILED ("MODE_ERROR NOT RAISED - STANDARD_INPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - STANDARD_INPUT");
+          END;
+
+          BEGIN
+               PUT (CURRENT_INPUT, X);
+               FAILED ("MODE_ERROR NOT RAISED - CURRENT_INPUT");
+          EXCEPTION
+               WHEN MODE_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - CURRENT_INPUT");
+          END;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3906B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906c.ada
new file mode 100644
index 000000000..0cf93a451
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906c.ada
@@ -0,0 +1,177 @@
+-- CE3906C.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 PUT FOR ENUMERATION TYPES OUTPUTS THE ENUMERATION
+--      LITERAL WITH NO TRAILING OR PRECEDING BLANKS WHEN WIDTH IS
+--      NOT SPECIFIED OR IS SPECIFIED TO BE LESS THAN OR EQUAL TO THE
+--      LENGTH OF THE STRING.  CHECK THAT WHEN WIDTH IS SPECIFIED TO
+--      BE GREATER THAN THE LENGTH OF THE STRING, TRAILING BLANKS ARE
+--      OUTPUT.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/08/82
+--     SPS 01/03/83
+--     VKG 01/07/83
+--     JBG 02/22/84  CHANGED TO .ADA TEST.
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/18/87  REMOVED CALL TO CHECKFILE.  CLOSED AND REOPENED
+--                   FILE AND CHECKED CONTENTS OF FILE USING
+--                   ENUMERATION_IO GETS.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3906C IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3906C", "CHECK THAT ENUMERATION_IO PUT OUTPUTS " &
+                      "ENUMERATION LITERALS CORRECTLY WITH AND " &
+                      "WITHOUT WIDTH PARAMETERS");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE MOOD IS (ANGRY, HAPPY, BORED, SAD);
+          X : MOOD := BORED;
+          PACKAGE MOOD_IO IS NEW ENUMERATION_IO (MOOD);
+          CH : CHARACTER;
+          USE MOOD_IO;
+     BEGIN
+
+          BEGIN
+               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          DEFAULT_WIDTH := FIELD(IDENT_INT(5));
+
+          IF DEFAULT_WIDTH /= FIELD(IDENT_INT(5)) THEN
+               FAILED ("DEFAULT_WIDTH NOT SET CORRECTLY");
+          END IF;
+
+          PUT (FT, X, 3);                             -- BORED
+          X := HAPPY;
+          NEW_LINE(FT);
+          PUT (FILE => FT, ITEM => X, WIDTH => 5);    -- HAPPY
+          NEW_LINE (FT);
+          PUT (FT, SAD, 5);                           -- SAD
+          DEFAULT_WIDTH := FIELD(IDENT_INT(6));
+          PUT (FT, X);                                -- HAPPY
+          PUT (FT, SAD, 3);                           -- SAD
+          NEW_LINE(FT);
+          DEFAULT_WIDTH := FIELD(IDENT_INT(2));
+          PUT (FT, SAD);                              -- SAD
+
+          CLOSE (FT);
+
+          BEGIN
+               OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN FOR " &
+                                    "IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          GET (FT, X);
+          IF X /= BORED THEN
+               FAILED ("BORED NOT READ CORRECTLY");
+          END IF;
+
+          GET (FT, X);
+          IF X /= HAPPY THEN
+               FAILED ("HAPPY NOT READ CORRECTLY - 1");
+          END IF;
+
+          SKIP_LINE (FT);
+
+          GET (FT, X);
+          IF X /= SAD THEN
+               FAILED ("SAD NOT READ CORRECTLY - 1");
+          END IF;
+
+          GET (FT, CH);
+          IF CH /= ' ' THEN
+               FAILED ("BLANKS NOT POSITIONED CORRECTLY - 1");
+          END IF;
+
+          GET (FT, CH);
+          IF CH /= ' ' THEN
+               FAILED ("BLANKS NOT POSITIONED CORRECTLY - 2");
+          END IF;
+
+          GET (FT, X);
+          IF X /= HAPPY THEN
+               FAILED ("HAPPY NOT READ CORRECTLY - 2");
+          END IF;
+
+          GET (FT, CH);
+          IF CH /= ' ' THEN
+               FAILED ("BLANKS NOT POSITIONED CORRECTLY - 3");
+          END IF;
+
+          GET (FT, X);
+          IF X /= SAD THEN
+               FAILED ("SAD NOT READ CORRECTLY - 2");
+          END IF;
+
+          SKIP_LINE (FT);
+
+          GET (FT, X);
+          IF X /= SAD THEN
+               FAILED ("SAD NOT READ CORRECTLY - 3");
+          END IF;
+
+          BEGIN
+               DELETE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3906C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906d.ada
new file mode 100644
index 000000000..954b4f8df
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906d.ada
@@ -0,0 +1,152 @@
+-- CE3906D.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 CONSTRAINT_ERROR IS RAISED BY PUT FOR ENUMERATION
+--     TYPES WHEN THE VALUE OF WIDTH IS NEGATIVE, WHEN WIDTH IS
+--     GREATER THAN FIELD'LAST, OR WHEN THE VALUE OF ITEM IS OUTSIDE
+--     THE RANGE OF THE SUBTYPE USED TO INSTANTIATE ENUMERATION_IO.
+
+-- HISTORY:
+--     SPS 10/08/82
+--     DWC 09/17/87  ADDED CASES FOR CONSTRAINT_ERROR.
+--     JRL 06/07/96  Added call to Ident_Int in expressions involving
+--                   Field'Last, to make the expressions non-static and
+--                   prevent compile-time rejection.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3906D IS
+BEGIN
+
+     TEST ("CE3906D", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY PUT " &
+                      "FOR ENUMERATION TYPES WHEN THE VALUE OF " &
+                      "WIDTH IS NEGATIVE, WHEN WIDTH IS GREATER " &
+                      "THAN FIELD'LAST, OR WHEN THE VALUE OF ITEM " &
+                      "IS OUTSIDE THE RANGE OF THE SUBTYPE USED TO " &
+                      "INSTANTIATE ENUMERATION_IO");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE DAY IS (SUNDAY, MONDAY, TUESDAY, WEDNESDAY,
+                       THURSDAY, FRIDAY, SATURDAY);
+          TODAY : DAY := FRIDAY;
+          SUBTYPE WEEKDAY IS DAY RANGE MONDAY .. FRIDAY;
+          PACKAGE DAY_IO IS NEW ENUMERATION_IO (WEEKDAY);
+          USE DAY_IO;
+     BEGIN
+
+          BEGIN
+               PUT (FT, TODAY, -1);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED; NEGATIVE " &
+                       "WIDTH - FILE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("RAISED STATUS_ERROR");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED; NEGATIVE " &
+                            "WIDTH - FILE");
+          END;
+
+          IF FIELD'LAST < INTEGER'LAST THEN
+               BEGIN
+                    PUT (FT, TODAY, FIELD'LAST + Ident_Int(1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED; WIDTH " &
+                            "GREATER THAN FIELD'LAST + 1- FILE");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED; WIDTH " &
+                                 "GREATER THAN FIELD'LAST + 1 - FILE");
+               END;
+
+               BEGIN
+                    PUT (TODAY, FIELD'LAST + Ident_Int(1));
+                    FAILED ("CONSTRAINT_ERROR NOT RAISED; WIDTH " &
+                            "GREATER THAN FIELD'LAST + 1 - DEFAULT");
+               EXCEPTION
+                    WHEN CONSTRAINT_ERROR =>
+                         NULL;
+                    WHEN OTHERS =>
+                         FAILED ("WRONG EXCEPTION RAISED; WIDTH " &
+                                 "GREATER THAN FIELD'LAST + 1 " &
+                                 "- DEFAULT");
+          END;
+
+          END IF;
+
+          TODAY := SATURDAY;
+
+          BEGIN
+               PUT (FT, TODAY);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED; ITEM VALUE " &
+                       "OUT OF RANGE - FILE");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED; ITEM VALUE " &
+                            "OUT OF RANGE - FILE");
+          END;
+
+          TODAY := FRIDAY;
+
+          BEGIN
+               PUT (TODAY, -3);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED; NEGATIVE " &
+                       "WIDTH - DEFAULT");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN STATUS_ERROR =>
+                    FAILED ("RAISED STATUS_ERROR");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED; NEGATIVE " &
+                            "WIDTH - DEFAULT");
+          END;
+
+          TODAY := SATURDAY;
+
+          BEGIN
+               PUT (TODAY);
+               FAILED ("CONSTRAINT_ERROR NOT RAISED; ITEM VALUE " &
+                       "OUT OF RANGE - DEFAULT");
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED; ITEM VALUE " &
+                            "OUT OF RANGE - DEFAULT");
+          END;
+     END;
+
+     RESULT;
+
+END CE3906D;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906e.ada
new file mode 100644
index 000000000..29ac3ea7b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906e.ada
@@ -0,0 +1,109 @@
+-- CE3906E.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:
+--     CHECK THAT PUT FOR ENUMERATION TYPES RAISES LAYOUT_ERROR WHEN
+--     THE NUMBER OF CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE
+--     LENGTH. CHECK THAT LAYOUT_ERROR IS NOT RAISED WHEN THE NUMBER
+--     OF CHARACTERS TO BE OUTPUT DOES NOT EXCEED THE MAXIMUM LINE
+--     LENGTH, BUT WHEN ADDED TO THE CURRENT COLUMN NUMBER, THE TOTAL
+--     EXCEEDS THE MAXIMUM LINE LENGTH.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMETATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     SPS 10/11/82
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/18/87  CORRECTED EXCEPTION HANDLING.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CE3906E IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("CE3906E", "CHECK THAT ENUMERATION_IO PUT RAISES " &
+                      "LAYOUT_ERROR CORRECTLY");
+
+     DECLARE
+          FT : FILE_TYPE;
+          TYPE COLOR IS (RED, BLU, YELLOW, ORANGE, RD);
+          PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
+          USE COLOR_IO;
+          CRAYON : COLOR := ORANGE;
+     BEGIN
+
+          BEGIN
+               CREATE (FT);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                                    "CREATE FOR TEMP FILES WITH " &
+                                    "OUT_FILE MODE - 1");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_LINE_LENGTH (FT, 5);
+
+          BEGIN
+               PUT (FT, CRAYON);
+               FAILED("LAYOUT_ERROR NOT RAISED");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED");
+          END;
+
+          PUT (FT, RED);
+
+          PUT (FT, BLU);
+          IF LINE (FT) /= 2 THEN
+               FAILED ("PUT DID NOT CAUSE NEW_LINE EFFECT");
+          END IF;
+
+          PUT (FT, RD);
+
+          CHECK_FILE (FT, "RED#" &
+                          "BLURD#@%");
+
+          CLOSE (FT);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END CE3906E;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906f.ada
new file mode 100644
index 000000000..484514b73
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3906f.ada
@@ -0,0 +1,102 @@
+-- CE3906F.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 SET PARAMETER AFFECTS THE CASE OF IDENTIFIERS,
+--     BUT NOT CHARACTER LITERALS.  CHECK THAT CHARACTER LITERALS ARE
+--     ENCLOSED IN APOSTROPHES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
+--     SUPPORT TEXT FILES.
+
+-- HISTORY:
+--     JBG 12/30/82
+--     VKG 01/12/83
+--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 09/18/87  CORRECTED EXCEPTION HANDLING.
+
+WITH TEXT_IO; USE TEXT_IO;
+WITH REPORT; USE REPORT;
+WITH CHECK_FILE;
+
+PROCEDURE CE3906F IS
+
+     TYPE ENUM IS (REDISH,GREENISH,YELLOWISH);
+     PACKAGE ENUM_IO IS NEW ENUMERATION_IO(ENUM);
+     PACKAGE CHAR_IO IS NEW ENUMERATION_IO(CHARACTER);
+     USE ENUM_IO; USE CHAR_IO;
+     INCOMPLETE : EXCEPTION;
+     FT : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CE3906F", "CHECK THE CASE OF ENUMERATION IO OUTPUT");
+
+     BEGIN
+          CREATE (FT);
+      EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
+                               "CREATE FOR TEMP FILE WITH " &
+                               "OUT_FILE MODE - 1");
+               RAISE INCOMPLETE;
+     END;
+
+     IF ENUM_IO.DEFAULT_WIDTH /= 0 THEN
+          FAILED ("INITIAL DEFAULT WIDTH INCORRECT");
+     END IF;
+
+     IF CHAR_IO.DEFAULT_SETTING /= UPPER_CASE THEN
+          FAILED ("INITIAL DEFAULT_SETTING INCORRECT");
+     END IF;
+
+     PUT (FT, 'A', SET => LOWER_CASE);
+     NEW_LINE (FT);
+     PUT (FT, 'a', SET => LOWER_CASE);
+     NEW_LINE (FT);
+     PUT (FT, REDISH, SET => LOWER_CASE);
+     NEW_LINE (FT);
+     ENUM_IO.DEFAULT_SETTING := LOWER_CASE;
+     CHAR_IO.PUT (FT, 'C');
+     NEW_LINE  (FT);
+     CHAR_IO.PUT (FT, 'b');
+     NEW_LINE (FT);
+     PUT (FT, REDISH);
+     NEW_LINE (FT);
+     PUT (FT, GREENISH, SET => LOWER_CASE);
+     NEW_LINE (FT);
+     PUT (FT, YELLOWISH, SET => UPPER_CASE);
+
+     CHECK_FILE (FT, "'A'#'a'#redish#'C'#'b'#redish#greenish#"
+                   & "YELLOWISH#@%");
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END CE3906F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3907a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3907a.ada
new file mode 100644
index 000000000..0765c4277
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3907a.ada
@@ -0,0 +1,75 @@
+-- CE3907A.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 PUT FOR ENUMERATION TYPES CAN BE APPLIED TO A STRING.
+-- CHECK THAT IT RAISES LAYOUT_ERROR WHEN THE ENUMERATION LITERAL TO BE
+-- PLACED IN THE STRING IS LONGER THAN THE STRING.
+
+-- SPS 10/11/82
+-- JBG 2/22/84  CHANGED TO .ADA TEST 
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3907A IS
+BEGIN
+
+     TEST ("CE3907A", "CHECK THAT ENUMERATION_IO PUT OPERATES ON " &
+                      "STRINGS CORRECTLY");
+
+     DECLARE
+          TYPE COLOR IS (RED, BLUE, GREEN);
+          ST : STRING (1..4);
+          PACKAGE COLOR_IO IS NEW ENUMERATION_IO (COLOR);
+          USE COLOR_IO;
+          CRAYON : COLOR := GREEN;
+     BEGIN
+          PUT (ST, RED);
+          IF ST /= "RED " THEN
+               FAILED ("PUT TO STRING, LENGTH LESS THAN STRING " &
+                       "INCORRECT");
+          END IF;
+
+          PUT (ST, BLUE);
+          IF ST /= "BLUE" THEN
+               FAILED ("PUT TO STRING, LENGTH EQUAL TO STRING " &
+                       "INCORRECT");
+          END IF;
+
+          BEGIN
+               PUT (ST, CRAYON);
+               FAILED ("LAYOUT_ERROR NOT RAISED");
+          EXCEPTION
+               WHEN LAYOUT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED");
+          END;
+
+     END;
+
+     RESULT;
+END CE3907A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3908a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3908a.ada
new file mode 100644
index 000000000..44c3954da
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/ce/ce3908a.ada
@@ -0,0 +1,140 @@
+-- CE3908A.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 GET FOR ENUMERATION TYPES CAN OPERATE ON STRINGS.
+--     CHECK THAT IT RAISES END_ERROR WHEN THE STRING IS NULL OR
+--     EMPTY.  CHECK THAT LAST CONTAINS THE INDEX VALUE OF THE LAST
+--     CHARACTER READ FROM THE STRING.
+
+-- HISTORY:
+--     SPS 10/11/82
+--     VKG 01/06/83
+--     JBG 02/22/84  CHANGED TO .ADA TEST
+--     DWC 09/18/87  ADDED CASES WHICH CONTAIN TABS WITH AND WITHOUT
+--                   ENUMERATION LITERALS.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE CE3908A IS
+BEGIN
+
+     TEST ("CE3908A", "CHECK THAT GET FOR ENUMERATION TYPES CAN " &
+                      "OPERATE ON STRINGS.  CHECK THAT IT RAISES " &
+                      "END_ERROR WHEN THE STRING IS NULL OR EMPTY.  " &
+                      "CHECK THAT LAST CONTAINS THE INDEX VALUE OF " &
+                      "THE LAST CHARACTER READ FROM THE STRING");
+
+     DECLARE
+          TYPE FRUIT IS (APPLE, PEAR, ORANGE, STRAWBERRY);
+          DESSERT : FRUIT;
+          PACKAGE FRUIT_IO IS NEW ENUMERATION_IO (FRUIT);
+          USE FRUIT_IO;
+          L : POSITIVE;
+     BEGIN
+          GET ("APPLE  ", DESSERT, L);
+          IF DESSERT /= APPLE THEN
+               FAILED ("ENUMERATION VALUE FROM STRING INCORRECT - 1");
+          END IF;
+
+          IF L /= IDENT_INT (5) THEN
+               FAILED ("LAST CONTAINS INCORRECT VALUE AFTER GET - 1");
+          END IF;
+
+          GET ("APPLE", DESSERT, L);
+          IF DESSERT /= APPLE THEN
+               FAILED ("ENUMERATION VALUE FROM STRING INCORRECT - 2");
+          END IF;
+
+          IF L /= IDENT_INT (5) THEN
+               FAILED ("LAST CONTAINS INCORRECT VALUE AFTER GET - 2");
+          END IF;
+
+          BEGIN
+               GET (ASCII.HT & "APPLE", DESSERT, L);
+               IF DESSERT /= APPLE THEN
+                    FAILED ("ENUMERATION VALUE FROM STRING " &
+                            "INCORRECT - 3");
+               END IF;
+               IF L /= IDENT_INT(6) THEN
+                    FAILED ("LAST CONTAINS INCORRECT VALUE AFTER " &
+                            "GET - 3");
+               END IF;
+          EXCEPTION
+               WHEN END_ERROR =>
+                    FAILED ("GET DID NOT SKIP LEADING TABS");
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 3");
+          END;
+
+-- NULL STRING LITERAL.
+
+          BEGIN
+               GET ("", DESSERT, L);
+               FAILED ("END_ERROR NOT RAISED - 4");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= IDENT_INT(6) THEN
+                         FAILED ("LAST CONTAINS INCORRECT VALUE " &
+                                 "AFTER GET - 4");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 4");
+          END;
+
+          BEGIN
+               GET (ASCII.HT & "", DESSERT, L);
+               FAILED ("END_ERROR NOT RAISED - 5");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= IDENT_INT(6) THEN
+                         FAILED ("LAST CONTAINS INCORRECT VALUE " &
+                                 "AFTER GET - 5");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 5");
+          END;
+
+-- STRING LITERAL WITH BLANKS.
+
+          BEGIN
+               GET("     ", DESSERT, L);
+               FAILED ("END ERROR NOT RAISED - 6");
+          EXCEPTION
+               WHEN END_ERROR =>
+                    IF L /= IDENT_INT(6) THEN
+                         FAILED ("LAST CONTAINS INCORRECT VALUE " &
+                                 "AFTER GET - 6");
+                    END IF;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - 6");
+          END;
+
+     END;
+
+     RESULT;
+END CE3908A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa3001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa3001.a
new file mode 100644
index 000000000..9c7e25b97
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa3001.a
@@ -0,0 +1,507 @@
+-- CXA3001.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 character classification functions defined in 
+--      package Ada.Characters.Handling produce correct results when provided 
+--      constant arguments from package Ada.Characters.Latin_1.
+--
+-- TEST DESCRIPTION:
+--      This test checks the character classification functions of package
+--      Ada.Characters.Handling.  In the evaluation of each function, loops
+--      are constructed to examine the function with as many values of type
+--      Character (Ada.Characters.Latin_1 constants) as possible in an 
+--      amount of code that is about equal to the amount of code required
+--      to examine the function with a few representative input values and
+--      endpoint values.
+--      The usage paradigm being demonstrated by this test is that of the
+--      functions being used to assign to boolean variables, as well as
+--      serving as boolean conditions.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      29 Apr 95   SAIC    Fixed subtest checking Is_Graphic function.
+--
+--!
+
+with Ada.Characters.Latin_1;
+with Ada.Characters.Handling;
+with Report;
+
+procedure CXA3001 is
+
+begin
+
+   Report.Test ("CXA3001", "Check that the character classification "      &
+                           "functions defined in package "                 &
+                           "Ada.Characters.Handling produce "              &
+                           "correct results when provided constant "       &
+                           "arguments from package Ada.Characters.Latin_1");
+
+   Test_Block:
+   declare
+
+      package AC  renames Ada.Characters;
+      package ACH renames Ada.Characters.Handling;
+
+      TC_Boolean : Boolean := False;
+
+   begin 
+
+      -- Over the next six statements/blocks of code, evaluate functions 
+      -- Is_Control and Is_Graphic with control character and non-control 
+      -- character values.
+
+      for i in Character'Pos(AC.Latin_1.NUL) .. 
+               Character'Pos(AC.Latin_1.US)  loop
+         if not ACH.Is_Control(Character'Val(i)) then
+            Report.Failed ("Incorrect result from function Is_Control - 1");
+         end if;
+         if ACH.Is_Graphic(Character'Val(i)) then
+            Report.Failed ("Incorrect result from function Is_Graphic - 1");
+         end if;
+      end loop;
+
+
+      for i in Character'Pos(AC.Latin_1.Space) ..
+               Character'Pos(AC.Latin_1.Tilde) loop
+         if not ACH.Is_Graphic(Character'Val(i)) then    
+            Report.Failed ("Incorrect result from function Is_Graphic - 2");
+         end if;
+         if ACH.Is_Control(Character'Val(i)) then
+            Report.Failed ("Incorrect result from function Is_Control - 2");
+         end if;
+      end loop;
+
+
+      for i in Character'Pos(AC.Latin_1.Reserved_128) .. 
+               Character'Pos(AC.Latin_1.APC)  loop
+         if not ACH.Is_Control(Character'Val(i)) then
+            Report.Failed ("Incorrect result from function Is_Control - 3");
+         end if;
+         TC_Boolean := ACH.Is_Graphic(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect result from function Is_Graphic - 3");
+            TC_Boolean := False;
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.No_Break_Space) ..
+               Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop
+         TC_Boolean := ACH.Is_Control(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect result from function Is_Control - 4");
+            TC_Boolean := False;
+         end if;
+         if not ACH.Is_Graphic(Character'Val(i)) then
+            Report.Failed ("Incorrect result from function Is_Graphic - 4");
+         end if;
+      end loop;
+
+      -- Check renamed constants.
+
+      if not (ACH.Is_Control(AC.Latin_1.IS4) and
+              ACH.Is_Control(AC.Latin_1.IS3) and 
+              ACH.Is_Control(AC.Latin_1.IS2) and 
+              ACH.Is_Control(AC.Latin_1.IS1))       or
+         (ACH.Is_Control(AC.Latin_1.NBSP)           or
+          ACH.Is_Control(AC.Latin_1.Paragraph_Sign) or
+          ACH.Is_Control(AC.Latin_1.Minus_Sign)     or
+          ACH.Is_Control(AC.Latin_1.Ring_Above))
+      then
+         Report.Failed ("Incorrect result from function Is_Control - 5");
+      end if;
+
+      if (ACH.Is_Graphic(AC.Latin_1.IS4)  or
+          ACH.Is_Graphic(AC.Latin_1.IS3)  or
+          ACH.Is_Graphic(AC.Latin_1.IS2)  or
+          ACH.Is_Graphic(AC.Latin_1.IS1)) or
+         not (ACH.Is_Graphic(AC.Latin_1.NBSP)           and
+              ACH.Is_Graphic(AC.Latin_1.Paragraph_Sign) and
+              ACH.Is_Graphic(AC.Latin_1.Minus_Sign)     and
+              ACH.Is_Graphic(AC.Latin_1.Ring_Above))
+      then
+         Report.Failed ("Incorrect result from function Is_Graphic - 5");
+      end if;
+
+
+      -- Evaluate function Is_Letter with letter/non-letter inputs.
+      
+      for i in Character'Pos('A') .. Character'Pos('Z') loop
+         if not ACH.Is_Letter(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Letter result - 1");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.LC_A) .. 
+               Character'Pos(AC.Latin_1.LC_Z) loop
+         if not ACH.Is_Letter(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Letter result - 2");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.UC_A_Grave) .. 
+               Character'Pos(AC.Latin_1.UC_O_Diaeresis) loop
+         if not ACH.Is_Letter(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Letter result - 3");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.UC_O_Oblique_Stroke) .. 
+               Character'Pos(AC.Latin_1.LC_O_Diaeresis) loop
+         if not ACH.Is_Letter(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Letter result - 4");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.LC_O_Oblique_Stroke) .. 
+               Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop
+         if not ACH.Is_Letter(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Letter result - 5");
+         end if;
+      end loop;
+
+      -- Check for rejection of non-letters.
+      for i in Character'Pos(AC.Latin_1.NUL) .. 
+               Character'Pos(AC.Latin_1.Commercial_At) loop
+         if ACH.Is_Letter(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Letter result - 6");
+         end if;
+      end loop;
+
+
+      -- Evaluate function Is_Lower with lower case/non-lower case inputs.
+
+      for i in Character'Pos(AC.Latin_1.LC_A) .. 
+               Character'Pos(AC.Latin_1.LC_Z) loop
+         if not ACH.Is_Lower(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Lower result - 1");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.LC_A_Grave) .. 
+               Character'Pos(AC.Latin_1.LC_O_Diaeresis) loop
+         if not ACH.Is_Lower(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Lower result - 2");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.LC_O_Oblique_Stroke) .. 
+               Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop
+         if not ACH.Is_Lower(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Lower result - 3");
+         end if;
+      end loop;
+
+      if ACH.Is_Lower('A')                         or
+         ACH.Is_Lower(AC.Latin_1.UC_Icelandic_Eth) or
+         ACH.Is_Lower(AC.Latin_1.Number_Sign)      or
+         ACH.Is_Lower(AC.Latin_1.Cedilla)          or
+         ACH.Is_Lower(AC.Latin_1.SYN)              or
+         ACH.Is_Lower(AC.Latin_1.ESA) 
+      then
+         Report.Failed ("Incorrect Is_Lower result - 4");
+      end if;
+
+
+      -- Evaluate function Is_Upper with upper case/non-upper case inputs.
+
+      for i in Character'Pos('A') .. Character'Pos('Z') loop
+         if not ACH.Is_Upper(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Upper result - 1");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.UC_A_Grave) .. 
+               Character'Pos(AC.Latin_1.UC_O_Diaeresis) loop
+         if not ACH.Is_Upper(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Upper result - 2");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.UC_O_Oblique_Stroke) .. 
+               Character'Pos(AC.Latin_1.UC_Icelandic_Thorn) loop
+         if not ACH.Is_Upper(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Upper result - 3");
+         end if;
+      end loop;
+
+      if ACH.Is_Upper('8')                    or
+         ACH.Is_Upper(AC.Latin_1.LC_A_Ring  ) or
+         ACH.Is_Upper(AC.Latin_1.Dollar_Sign) or
+         ACH.Is_Upper(AC.Latin_1.Broken_Bar)  or
+         ACH.Is_Upper(AC.Latin_1.ETB)         or
+         ACH.Is_Upper(AC.Latin_1.VTS) 
+      then
+         Report.Failed ("Incorrect Is_Upper result - 4");
+      end if;
+
+
+      for i in Character'Pos('a') .. Character'Pos('z') loop
+         if ACH.Is_Upper(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Upper result - 5");
+         end if;
+      end loop;
+
+
+      -- Evaluate function Is_Basic with basic/non-basic inputs.
+      -- (Note: Basic letters are those without diacritical marks.)
+
+      for i in Character'Pos('A') .. Character'Pos('Z') loop
+         if not ACH.Is_Basic(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Basic result - 1");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.LC_A) .. 
+               Character'Pos(AC.Latin_1.LC_Z) loop
+         if not ACH.Is_Basic(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Basic result - 2");
+         end if;
+      end loop;
+
+
+      if not (ACH.Is_Basic(AC.Latin_1.UC_AE_Diphthong)     and  
+              ACH.Is_Basic(AC.Latin_1.LC_AE_Diphthong)     and
+              ACH.Is_Basic(AC.Latin_1.LC_German_Sharp_S)   and
+              ACH.Is_Basic(AC.Latin_1.LC_Icelandic_Eth)    and
+              ACH.Is_Basic(AC.Latin_1.LC_Icelandic_Thorn)  and
+              ACH.Is_Basic(AC.Latin_1.UC_Icelandic_Eth)    and
+              ACH.Is_Basic(AC.Latin_1.UC_Icelandic_Thorn))
+      then
+         Report.Failed ("Incorrect Is_Basic result - 3");
+      end if;
+
+      -- Check for rejection of non-basics.
+      if ACH.Is_Basic(AC.Latin_1.UC_A_Tilde) or
+         ACH.Is_Basic(AC.Latin_1.LC_A_Grave) or
+         ACH.Is_Basic(AC.Latin_1.Ampersand)  or
+         ACH.Is_Basic(AC.Latin_1.Yen_Sign)   or
+         ACH.Is_Basic(AC.Latin_1.NAK)        or
+         ACH.Is_Basic(AC.Latin_1.SS2) 
+      then
+         Report.Failed ("Incorrect Is_Basic result - 4");
+      end if;
+
+
+
+      for i in Character'Pos(AC.Latin_1.NUL) .. 
+               Character'Pos(AC.Latin_1.Commercial_At) loop
+         if ACH.Is_Basic(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Basic result - 5");
+         end if;
+      end loop;
+
+
+      -- Evaluate functions Is_Digit and Is_Decimal_Digit (a rename of
+      -- Is_Digit) with decimal digit/non-digit inputs.
+
+
+      if not (ACH.Is_Digit('0')          and
+              ACH.Is_Decimal_Digit('9')) or
+         ACH.Is_Digit ('a')              or     -- Hex digits.
+         ACH.Is_Decimal_Digit ('f')      or
+         ACH.Is_Decimal_Digit ('A')      or
+         ACH.Is_Digit ('F')
+      then
+         Report.Failed ("Incorrect Is_Digit/Is_Decimal_Digit result - 1");
+      end if;
+
+      if ACH.Is_Digit         (AC.Latin_1.Full_Stop)         or
+         ACH.Is_Decimal_Digit (AC.Latin_1.Dollar_Sign)       or
+         ACH.Is_Digit         (AC.Latin_1.Number_Sign)       or
+         ACH.Is_Decimal_Digit (AC.Latin_1.Left_Parenthesis)  or
+         ACH.Is_Digit         (AC.Latin_1.Right_Parenthesis) 
+      then
+         Report.Failed ("Incorrect Is_Digit/Is_Decimal_Digit result - 2");
+      end if;
+
+
+      -- Evaluate functions Is_Hexadecimal_Digit with hexadecimal digit and 
+      -- non-hexadecimal digit inputs.
+
+      for i in Character'Pos('0') .. Character'Pos('9') loop
+         if not ACH.Is_Hexadecimal_Digit(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Hexadecimal_Digit result - 1");
+         end if;
+      end loop;
+
+      for i in Character'Pos('A') .. Character'Pos('F') loop
+         if not ACH.Is_Hexadecimal_Digit(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Hexadecimal_Digit result - 2");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.LC_A) .. 
+               Character'Pos(AC.Latin_1.LC_F) loop
+         if not ACH.Is_Hexadecimal_Digit(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Hexadecimal_Digit result - 3");
+         end if;
+      end loop;
+
+
+      if ACH.Is_Hexadecimal_Digit (AC.Latin_1.Minus_Sign)        or
+         ACH.Is_Hexadecimal_Digit (AC.Latin_1.Hyphen)            or
+         ACH.Is_Hexadecimal_Digit (AC.Latin_1.LC_G)              or
+         ACH.Is_Hexadecimal_Digit (AC.Latin_1.LC_Z)              or
+         ACH.Is_Hexadecimal_Digit ('G')                          or
+         ACH.Is_Hexadecimal_Digit (AC.Latin_1.Cent_Sign)         or
+         ACH.Is_Hexadecimal_Digit (AC.Latin_1.Pound_Sign)
+      then
+         Report.Failed ("Incorrect Is_HexaDecimal_Digit result - 4");
+      end if;
+
+
+      -- Evaluate functions Is_Alphanumeric and Is_Special with 
+      -- letters, digits, and non-alphanumeric inputs.
+
+      for i in Character'Pos(AC.Latin_1.NUL) .. 
+               Character'Pos(AC.Latin_1.US)  loop
+         if ACH.Is_Alphanumeric(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Alphanumeric result - 1");
+         end if;
+         TC_Boolean := ACH.Is_Special(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect Is_Special result - 1");
+            TC_Boolean := False;
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.Reserved_128) .. 
+               Character'Pos(AC.Latin_1.APC)  loop
+         TC_Boolean := ACH.Is_Alphanumeric(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect Is_Alphanumeric result - 2");
+            TC_Boolean := False;
+         end if;
+         if ACH.Is_Special(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Special result - 2");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.Space) ..
+               Character'Pos(AC.Latin_1.Solidus) loop
+         TC_Boolean := ACH.Is_Alphanumeric(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect Is_Alphanumeric result - 3");
+            TC_Boolean := False;
+         end if;
+         if not ACH.Is_Special(Character'Val(i)) then  
+            Report.Failed ("Incorrect Is_Special result - 3");
+         end if;
+      end loop;
+
+      for i in Character'Pos('A') .. Character'Pos('Z') loop
+         if not ACH.Is_Alphanumeric(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Alphanumeric result - 4");
+         end if;
+         TC_Boolean := ACH.Is_Special(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect Is_Special result - 4");
+            TC_Boolean := False;
+         end if;
+      end loop;
+
+      for i in Character'Pos('0') .. Character'Pos('9') loop
+         if not ACH.Is_Alphanumeric(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Alphanumeric result - 5");
+         end if;
+         TC_Boolean := ACH.Is_Special(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect Is_Special result - 5");
+            TC_Boolean := False;
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.LC_A) ..
+               Character'Pos(AC.Latin_1.LC_Z) loop
+         if not ACH.Is_Alphanumeric(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Alphanumeric result - 6");
+         end if;
+         TC_Boolean := ACH.Is_Special(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect Is_Special result - 6");
+            TC_Boolean := False;
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.No_Break_Space) ..
+               Character'Pos(AC.Latin_1.Inverted_Question) loop
+         TC_Boolean := ACH.Is_Alphanumeric(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect Is_Alphanumeric result - 7");
+            TC_Boolean := False;
+         end if;
+         if not ACH.Is_Special(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Special result - 7");
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.UC_A_Grave) ..
+               Character'Pos(AC.Latin_1.UC_O_Diaeresis) loop
+         if not ACH.Is_Alphanumeric(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Alphanumeric result - 8");
+         end if;
+         TC_Boolean := ACH.Is_Special(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect Is_Special result - 8");
+            TC_Boolean := False;
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.UC_O_Oblique_Stroke) ..
+               Character'Pos(AC.Latin_1.LC_O_Diaeresis) loop
+         if not ACH.Is_Alphanumeric(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Alphanumeric result - 9");
+         end if;
+         TC_Boolean := ACH.Is_Special(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect Is_Special result - 9");
+            TC_Boolean := False;
+         end if;
+      end loop;
+
+      for i in Character'Pos(AC.Latin_1.LC_O_Oblique_Stroke) ..
+               Character'Pos(AC.Latin_1.LC_Y_Diaeresis) loop
+         if not ACH.Is_Alphanumeric(Character'Val(i)) then
+            Report.Failed ("Incorrect Is_Alphanumeric result - 10");
+         end if;
+         TC_Boolean := ACH.Is_Special(Character'Val(i)); 
+         if TC_Boolean then
+            Report.Failed ("Incorrect Is_Special result - 10");
+            TC_Boolean := False;
+         end if;
+      end loop;
+
+
+   exception
+      when others => Report.Failed ("Exception raised during processing");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA3001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa3002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa3002.a
new file mode 100644
index 000000000..12d98fdfe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa3002.a
@@ -0,0 +1,318 @@
+-- CXA3002.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 conversion functions for Characters and Strings
+--      defined in package Ada.Characters.Handling provide correct results
+--      when given character/string input parameters.
+--
+-- TEST DESCRIPTION:
+--      This test checks the output of the To_Lower, To_Upper, and
+--      To_Basic functions for both Characters and Strings.  Each function
+--      is called with input parameters that are within the appropriate
+--      range of values, and also with values outside the specified 
+--      range (i.e., lower case 'a' to To_Lower).  The functions are also
+--      used in combination with one another, with the result of one function
+--      providing the actual input parameter value to another.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      22 Dec 94   SAIC    Corrected evaluations of Functions In Combination.
+--
+--!
+
+with Ada.Characters.Latin_1;
+with Ada.Characters.Handling;
+with Report;
+
+procedure CXA3002 is
+
+   package AC  renames Ada.Characters;
+   package ACH renames Ada.Characters.Handling;
+
+begin
+
+   Report.Test ("CXA3002", "Check that the conversion functions for "   &
+                           "Characters and Strings defined in package " &
+                           "Ada.Characters.Handling provide correct "   &
+                           "results when given character/string input " &
+                           "parameters");
+
+
+   Character_Block:
+   declare
+      Offset : constant Integer := Character'Pos('a') - Character'Pos('A');
+   begin 
+
+      -- Function To_Lower for Characters
+
+      if ACH.To_Lower('A') /= 'a' or  ACH.To_Lower('Z') /= 'z' then
+         Report.Failed ("Incorrect operation of function To_Lower - 1");
+      end if;
+
+
+      for i in Character'Pos('A') .. Character'Pos('Z') loop
+         if ACH.To_Lower(Character'Val(i)) /= Character'Val(i + Offset) then
+            Report.Failed ("Incorrect operation of function To_Lower - 2");
+         end if;
+      end loop;
+
+
+      if (ACH.To_Lower(AC.Latin_1.UC_A_Grave)         /= 
+          AC.Latin_1.LC_A_Grave)                     or
+         (ACH.To_Lower(AC.Latin_1.UC_Icelandic_Thorn) /=
+          AC.Latin_1.LC_Icelandic_Thorn)
+      then
+         Report.Failed ("Incorrect operation of function To_Lower - 3");
+      end if;
+
+
+      if ACH.To_Lower('c')                 /= 'c'                 or  
+         ACH.To_Lower('w')                 /= 'w'                 or
+         ACH.To_Lower(AC.Latin_1.CR)       /= AC.Latin_1.CR       or
+         ACH.To_Lower(AC.Latin_1.LF)       /= AC.Latin_1.LF       or
+         ACH.To_Lower(AC.Latin_1.Comma)    /= AC.Latin_1.Comma    or
+         ACH.To_Lower(AC.Latin_1.Question) /= AC.Latin_1.Question or
+         ACH.To_Lower('0')                 /= '0'                 or
+         ACH.To_Lower('9')                 /= '9'                
+      then
+         Report.Failed ("Incorrect operation of function To_Lower - 4");
+      end if;
+
+    
+      --- Function To_Upper for Characters
+      
+
+      if not (ACH.To_Upper('b') = 'B') and (ACH.To_Upper('y') = 'Y') then
+         Report.Failed ("Incorrect operation of function To_Upper - 1");
+      end if;
+
+
+      for i in Character'Pos(AC.Latin_1.LC_A) .. 
+               Character'Pos(AC.Latin_1.LC_Z) loop
+         if ACH.To_Upper(Character'Val(i)) /= Character'Val(i - Offset) then
+            Report.Failed ("Incorrect operation of function To_Upper - 2");
+         end if;
+      end loop;
+
+
+      if (ACH.To_Upper(AC.Latin_1.LC_U_Diaeresis) /= 
+          AC.Latin_1.UC_U_Diaeresis)                 or
+         (ACH.To_Upper(AC.Latin_1.LC_A_Ring)      /=
+          AC.Latin_1.UC_A_Ring) 
+      then
+         Report.Failed ("Incorrect operation of function To_Upper - 3");
+      end if;
+     
+
+      if not (ACH.To_Upper('F') = 'F'                       and 
+              ACH.To_Upper('U') = 'U'                       and
+              ACH.To_Upper(AC.Latin_1.LC_German_Sharp_S) =
+                AC.Latin_1.LC_German_Sharp_S                and
+              ACH.To_Upper(AC.Latin_1.LC_Y_Diaeresis) =
+                AC.Latin_1.LC_Y_Diaeresis) 
+      then
+         Report.Failed ("Incorrect operation of function To_Upper - 4");
+      end if;
+
+
+      --- Function To_Basic for Characters
+      
+
+      if ACH.To_Basic(AC.Latin_1.LC_A_Circumflex) /=       
+         ACH.To_Basic(AC.Latin_1.LC_A_Tilde)         or       
+         ACH.To_Basic(AC.Latin_1.LC_E_Grave)      /=       
+         ACH.To_Basic(AC.Latin_1.LC_E_Acute)         or      
+         ACH.To_Basic(AC.Latin_1.LC_I_Circumflex) /=       
+         ACH.To_Basic(AC.Latin_1.LC_I_Diaeresis)     or          
+         ACH.To_Basic(AC.Latin_1.UC_O_Tilde)      /=       
+         ACH.To_Basic(AC.Latin_1.UC_O_Acute)         or      
+         ACH.To_Basic(AC.Latin_1.UC_U_Grave)      /=       
+         ACH.To_Basic(AC.Latin_1.UC_U_Acute)         or      
+         ACH.To_Basic(AC.Latin_1.LC_Y_Acute)      /=       
+         ACH.To_Basic(AC.Latin_1.LC_Y_Diaeresis)
+      then
+         Report.Failed ("Incorrect operation of function To_Basic - 1");
+      end if;
+
+
+      if ACH.To_Basic('Y') /= 'Y'                   or 
+         ACH.To_Basic(AC.Latin_1.LC_E_Acute) /= 'e' or
+         ACH.To_Basic('6') /= '6'                   or
+         ACH.To_Basic(AC.Latin_1.LC_R) /= 'r' 
+      then
+         Report.Failed ("Incorrect operation of function To_Basic - 2");
+      end if;
+ 
+
+      -- Using Functions (for Characters) in Combination
+
+
+      if (ACH.To_Upper(ACH.To_Lower('A')) /= 'A' ) or
+         (ACH.To_Upper(ACH.To_Lower(AC.Latin_1.UC_A_Acute)) /=
+          AC.Latin_1.UC_A_Acute )
+      then 
+         Report.Failed("Incorrect operation of functions in combination - 1");
+      end if;
+
+
+      if ACH.To_Basic(ACH.To_Lower(ACH.To_Upper(AC.Latin_1.LC_U_Grave))) /= 
+         'u'
+      then
+         Report.Failed("Incorrect operation of functions in combination - 2");
+      end if;
+       
+
+      if ACH.To_Lower (ACH.To_Basic 
+                         (ACH.To_Upper(AC.Latin_1.LC_O_Diaeresis))) /= 'o'
+      then
+         Report.Failed("Incorrect operation of functions in combination - 3");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Character_Block");
+   end Character_Block;
+
+
+   String_Block:
+   declare
+
+      LC_String : constant String := "az" & 
+                                      AC.Latin_1.LC_A_Grave &
+                                      AC.Latin_1.LC_C_Cedilla;
+
+      UC_String : constant String := "AZ" & 
+                                      AC.Latin_1.UC_A_Grave &
+                                      AC.Latin_1.UC_C_Cedilla;
+
+      LC_Basic_String    : constant String := "aei" & 'o' & 'u';
+
+      LC_NonBasic_String : constant String := AC.Latin_1.LC_A_Diaeresis  &
+                                              AC.Latin_1.LC_E_Circumflex &
+                                              AC.Latin_1.LC_I_Acute      &
+                                              AC.Latin_1.LC_O_Tilde      &
+                                              AC.Latin_1.LC_U_Grave;
+
+      UC_Basic_String    : constant String := "AEIOU";
+
+      UC_NonBasic_String : constant String := AC.Latin_1.UC_A_Tilde      &
+                                              AC.Latin_1.UC_E_Acute      &
+                                              AC.Latin_1.UC_I_Grave      &
+                                              AC.Latin_1.UC_O_Diaeresis  &
+                                              AC.Latin_1.UC_U_Circumflex;
+
+      LC_Special_String  : constant String := "ab"                         &
+                                              AC.Latin_1.LC_German_Sharp_S &
+                                              AC.Latin_1.LC_Y_Diaeresis;
+
+      UC_Special_String  : constant String := "AB"                         &
+                                              AC.Latin_1.LC_German_Sharp_S &
+                                              AC.Latin_1.LC_Y_Diaeresis;
+
+   begin
+
+      -- Function To_Lower for Strings
+      
+
+      if ACH.To_Lower (UC_String) /= LC_String  or
+         ACH.To_Lower (LC_String) /= LC_String  
+      then
+         Report.Failed ("Incorrect result from To_Lower for strings - 1");
+      end if;
+
+
+      if ACH.To_Lower (UC_Basic_String) /= LC_Basic_String then
+         Report.Failed ("Incorrect result from To_Lower for strings - 2");
+      end if;
+
+
+      -- Function To_Upper for Strings
+      
+
+      if not (ACH.To_Upper (LC_String) = UC_String) then
+         Report.Failed ("Incorrect result from To_Upper for strings - 1");
+      end if;
+
+
+      if ACH.To_Upper (LC_Basic_String) /= UC_Basic_String or
+         ACH.To_Upper (UC_String)       /= UC_String
+      then
+         Report.Failed ("Incorrect result from To_Upper for strings - 2");
+      end if;
+
+
+      if ACH.To_Upper (LC_Special_String) /= UC_Special_String then
+         Report.Failed ("Incorrect result from To_Upper for strings - 3");
+      end if;
+      
+
+
+      -- Function To_Basic for Strings
+      
+
+      if (ACH.To_Basic (LC_String) /= "azac") or
+         (ACH.To_Basic (UC_String) /= "AZAC")
+      then
+         Report.Failed ("Incorrect result from To_Basic for Strings - 1");
+      end if;
+
+
+      if ACH.To_Basic (LC_NonBasic_String) /= LC_Basic_String then
+         Report.Failed ("Incorrect result from To_Basic for Strings - 2");
+      end if;
+
+
+      if ACH.To_Basic (UC_NonBasic_String) /= UC_Basic_String then
+         Report.Failed ("Incorrect result from To_Basic for Strings - 3");
+      end if;
+
+
+      -- Using Functions (for Strings) in Combination
+
+
+      if ACH.To_Upper(ACH.To_Lower(UC_Basic_String)) /= UC_Basic_String or
+         ACH.To_Lower(ACH.To_Upper(LC_Basic_String)) /= LC_Basic_String
+      then
+         Report.Failed ("Incorrect operation of functions in combination - 4");
+      end if;
+
+
+      if (ACH.To_Basic(ACH.To_Lower(UC_NonBasic_String)) /= LC_Basic_String) or
+         (ACH.To_Basic(ACH.To_Upper(LC_NonBasic_String)) /= UC_Basic_String)
+      then
+         Report.Failed ("Incorrect operation of functions in combination - 5");
+      end if;
+        
+
+   exception
+      when others => Report.Failed ("Exception raised in String_Block");
+   end String_Block;
+
+
+   Report.Result;
+
+end CXA3002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a
new file mode 100644
index 000000000..f469ef8b5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa3003.a
@@ -0,0 +1,243 @@
+-- CXA3003.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 functions defined in package Ada.Characters.Handling
+--      for use in classifying and converting characters between the ISO 646
+--      and type Character sets produce the correct results with both
+--      Character and String input values.
+--
+-- TEST DESCRIPTION:
+--      This test is designed to exercise the classification and conversion
+--      functions (between Character and ISO_646 types) found in package 
+--      Ada.Characters.Handling.  Two subprograms are defined, a procedure for
+--      characters, a function for strings, that will utilize these functions
+--      to validate and change characters in variables.  In the procedure, if
+--      a character argument is found to be outside the subtype ISO_646, this 
+--      character is evaluated to determine whether it is also a letter.  
+--      If it is a letter, the character is converted to a basic character and 
+--      returned.  If it is not a letter, the character is exchanged with an 
+--      asterisk.  In the case of the function subprogram designed for strings, 
+--      if a character component of a string argument is outside the subtype
+--      ISO_646, that character is substituted with an asterisk.
+--      
+--      Arguments for the defined subprograms consist of ISO_646 characters,
+--      non-ISO_646 characters, strings with only ISO_646 characters, and
+--      strings with non-ISO_646 characters. The character and string values 
+--      are then validated to determine that the expected results were 
+--      obtained.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      29 Apr 95   SAIC    Modified identifier string lengths.
+--      31 Oct 95   SAIC    Update and repair for ACVC 2.0.1.
+--
+--!
+
+with Ada.Characters.Latin_1;
+with Ada.Characters.Handling;
+with Report;
+
+procedure CXA3003 is
+
+begin
+
+   Report.Test ("CXA3003", "Check that the functions defined in package " &
+                           "Ada.Characters.Handling for use in "          &
+                           "classifying and converting characters "       &
+                           "between the ISO 646 and type Character sets " &
+                           "produce the correct results with both "       &
+                           "Character and String input values" );
+
+   Test_Block:
+   declare
+
+      -- ISO_646 Characters
+
+      Char_1,
+      TC_Char_1  : Character := Ada.Characters.Latin_1.NUL;    -- Control Char
+      Char_2,
+      TC_Char_2  : Character := Ada.Characters.Latin_1.Colon;  -- Graphic Char
+      Char_3,
+      TC_Char_3  : Character := '4';
+      Char_4,
+      TC_Char_4  : Character := 'Z';
+      Char_5,
+      TC_Char_5  : Character := Ada.Characters.Latin_1.LC_W;   -- w
+
+      New_ISO_646_Char : Character := '*';
+
+
+      -- Non-ISO_646 Characters
+
+      Char_Array : array (6..10) of Character := 
+                                       (Ada.Characters.Latin_1.SSA,
+                                        Ada.Characters.Latin_1.Cent_Sign,
+                                        Ada.Characters.Latin_1.Cedilla,
+                                        Ada.Characters.Latin_1.UC_A_Ring,
+                                        Ada.Characters.Latin_1.LC_A_Ring);
+
+      TC_Char : constant Character := '*';
+
+      -- ISO_646 Strings
+
+      Str_1, 
+      TC_Str_1 : String (1..5) := "ABCDE";
+
+      Str_2,
+      TC_Str_2 : String (1..5) := "#$%^&";
+
+
+      -- Non-ISO_646 Strings
+
+      Str_3    : String (1..8) := "$123.45" & 
+                                  Ada.Characters.Latin_1.Cent_Sign;
+      TC_Str_3 : String (1..8) := "$123.45*";
+
+      Str_4    : String (1..7) := "abc" & 
+                                  Ada.Characters.Latin_1.Cedilla &
+                                  "efg";
+      TC_Str_4 : String (1..7) := "abc*efg";
+
+      Str_5    : String (1..3) := Ada.Characters.Latin_1.LC_E_Grave & 
+                                  Ada.Characters.Latin_1.LC_T       &
+                                  Ada.Characters.Latin_1.LC_E_Acute;
+      TC_Str_5 : String (1..3) := "*t*";
+
+      ---
+
+      procedure Validate_Character (Char : in out Character) is
+         -- If parameter Char is an ISO_646 character, Char will be returned,
+         -- otherwise the following constant will be returned.
+         Star : constant Ada.Characters.Handling.ISO_646 := 
+           Ada.Characters.Latin_1.Asterisk;                    
+      begin
+         if Ada.Characters.Handling.Is_ISO_646(Char) then
+            -- Check that the Is_ISO_646 function provide a correct result.
+            if Character'Pos(Char) > 127 then
+               Report.Failed("Is_ISO_646 returns a false positive result");
+            end if;
+         else
+            if Character'Pos(Char) < 128 then
+               Report.Failed("Is_ISO_646 returns a false negative result");
+            end if;
+         end if;
+         -- Cross-check Is_ISO_646 with To_ISO_646.  '*' will be returned
+         -- if Char is not in the ISO_646 set.
+         Char := Ada.Characters.Handling.To_ISO_646(Char, Star);
+      exception
+         when others => Report.Failed ("Exception in Validate_Character");
+      end Validate_Character;
+
+      ---
+
+      function Validate_String (Str : String) return String is
+         New_ISO_646_Char : constant Ada.Characters.Handling.ISO_646 := 
+           Ada.Characters.Latin_1.Asterisk;                    
+      begin
+         -- Checking that the string contains non-ISO_646 characters at this
+         -- point is not strictly necessary, since the function To_ISO_646
+         -- will perform that check as part of its processing, and would 
+         -- return the original string if no modification were necessary.  
+         -- However, this format allows for the testing of both functions.
+
+         if not Ada.Characters.Handling.Is_ISO_646(Str) then
+            return Ada.Characters.Handling.To_ISO_646
+                     (Item => Str, Substitute => New_ISO_646_Char);
+         else
+            return Str;
+         end if;
+      exception
+         when others => Report.Failed ("Exception in Validate_String");
+                        return Str;
+      end Validate_String;
+
+
+   begin
+
+      -- Check each character in turn, and if the character does not belong
+      -- to the ISO_646 subset of type Character, replace it with an
+      -- asterisk.  If the character is a member of the subset, the character
+      -- should be returned unchanged.
+
+      Validate_Character (Char_1);
+      Validate_Character (Char_2);
+      Validate_Character (Char_3);
+      Validate_Character (Char_4);
+      Validate_Character (Char_5);
+
+      if Char_1 /= TC_Char_1 or Char_2 /= TC_Char_2 or
+         Char_3 /= TC_Char_3 or Char_4 /= TC_Char_4 or
+         Char_5 /= TC_Char_5
+      then
+         Report.Failed ("Incorrect ISO_646 character substitution");
+      end if;
+
+      -- Non-ISO_646 characters
+
+      for i in 6..10 loop
+         Validate_Character (Char_Array(i));
+      end loop;
+
+      for i in 6..10 loop
+         if Char_Array(i) /= TC_Char then
+            Report.Failed ("Character position " & Integer'Image(i) &
+                           " not replaced correctly");
+         end if;
+      end loop;
+
+
+
+      -- Check each string, and if the string contains characters that do not
+      -- belong to the ISO_646 subset of type Character, replace that character
+      -- in the string with an asterisk.  If the string is comprised of only
+      -- ISO_646 characters, the string should be returned unchanged.
+
+
+      Str_1 := Validate_String (Str_1);
+      Str_2 := Validate_String (Str_2);
+      Str_3 := Validate_String (Str_3);
+      Str_4 := Validate_String (Str_4);
+      Str_5 := Validate_String (Str_5);
+
+
+      if Str_1 /= TC_Str_1 or
+         Str_2 /= TC_Str_2 or
+         Str_3 /= TC_Str_3 or
+         Str_4 /= TC_Str_4 or
+         Str_5 /= TC_Str_5
+      then
+         Report.Failed ("Incorrect ISO_646 character substitution in string");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA3003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a
new file mode 100644
index 000000000..d850acd4a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a
@@ -0,0 +1,218 @@
+-- CXA4001.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 types, operations, and other entities defined within
+--      the package Ada.Strings.Maps are available and/or produce correct
+--      results.
+--
+-- TEST DESCRIPTION:
+--      This test demonstrates the availability and function of the types and
+--      operations defined in package Ada.Strings.Maps.  It demonstrates the
+--      use of these types and functions as they would be used in common
+--      programming practice.
+--      Character set creation, assignment, and comparison are evaluated
+--      in this test.  Each of the functions provided in package
+--      Ada.Strings.Maps is utilized in creating or manipulating set objects,
+--      and the function results are evaluated for correctness.
+--      Character sequences are examined using the functions provided for 
+--      manipulating objects of this type.  Likewise, character maps are
+--      created, and their contents evaluated.  Exception raising conditions
+--      from the function To_Mapping are also created.
+--      Note: Throughout this test, the set logical operators are printed in
+--      capital letters to enhance their visibility.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Ada.Strings.Maps;
+with Report;
+
+procedure CXA4001 is
+
+   use Ada.Strings;
+   use type Maps.Character_Set;
+  
+begin
+
+   Report.Test ("CXA4001", "Check that the types, operations, and other "   &
+                           "entities defined within the package "           &
+                           "Ada.Strings.Maps are available and/or produce " &
+                           "correct results");
+
+   Test_Block:
+   declare
+
+      MidPoint_Letter  : constant := 13;
+      Last_Letter      : constant := 26;
+
+      Vowels           : constant Maps.Character_Sequence := "aeiou";
+      Quasi_Vowel      : constant Character := 'y';
+
+      Alphabet         :  Maps.Character_Sequence (1..Last_Letter);
+      Half_Alphabet    :  Maps.Character_Sequence (1..MidPoint_Letter);
+      Inverse_Alphabet :  Maps.Character_Sequence (1..Last_Letter);
+
+      Alphabet_Set,
+      Consonant_Set,
+      Vowel_Set,
+      Full_Vowel_Set,
+      First_Half_Set,
+      Second_Half_Set  : Maps.Character_Set;
+
+   begin
+
+      -- Load the alphabet string for use in creating sets.
+
+
+      for i in 0..12 loop
+         Half_Alphabet(i+1) := Character'Val(Character'Pos('a') + i);
+      end loop;
+
+      for i in 0..25 loop
+         Alphabet(i+1) := Character'Val(Character'Pos('a') + i);
+      end loop;
+
+
+      -- Initialize a series of Character_Set objects.
+      
+      Alphabet_Set    := Maps.To_Set(Alphabet);
+      Vowel_Set       := Maps.To_Set(Vowels);
+      Full_Vowel_Set  := Vowel_Set   OR  Maps.To_Set(Quasi_Vowel);
+      Consonant_Set   := Vowel_Set  XOR  Alphabet_Set;
+
+      First_Half_Set  := Maps.To_Set(Half_Alphabet);
+      Second_Half_Set := Alphabet_Set  XOR  First_Half_Set;
+
+
+      -- Evaluation of Set objects, operators, and functions.
+
+      if Alphabet_Set /= (Vowel_Set OR Consonant_Set) then
+         Report.Failed("Incorrect set combinations using OR operator");
+      end if;
+
+
+      for i in 1..5 loop
+         if not Maps.Is_In(Vowels(i), Vowel_Set)    or
+            not Maps.Is_In(Vowels(i), Alphabet_Set) or
+            Maps.Is_In(Vowels(i), Consonant_Set) 
+         then
+            Report.Failed("Incorrect function Is_In use with set " &
+                          "combinations - " & Integer'Image(i));
+         end if;
+      end loop;
+
+
+      if Maps.Is_Subset(Vowel_Set, First_Half_Set)    or
+         Maps."<="(Vowel_Set, Second_Half_Set)        or
+         not Maps.Is_Subset(Vowel_Set, Alphabet_Set)
+      then
+         Report.Failed("Incorrect set evaluation using Is_Subset function");
+      end if;
+
+     
+      if not (Full_Vowel_Set = Maps.To_Set("aeiouy")) then
+         Report.Failed("Incorrect result for ""="" set operator");
+      end if;
+
+
+      if not ((Vowel_Set AND First_Half_Set) OR 
+              (Full_Vowel_Set AND Second_Half_Set)) = Full_Vowel_Set then
+         Report.Failed
+           ("Incorrect result for AND, OR, or ""="" set operators");
+      end if;
+
+
+      if (Alphabet_Set AND Maps.Null_Set) /= Maps.Null_Set  or
+         (Alphabet_Set OR  Maps.Null_Set) /= Alphabet_Set
+      then
+         Report.Failed("Incorrect result for AND or OR set operators");
+      end if;
+
+
+      Vowel_Set := Full_Vowel_Set;
+      Vowel_Set := Vowel_Set AND (NOT Maps.To_Set(Quasi_Vowel));
+      
+      if not (Vowels = Maps.To_Sequence(Vowel_Set)) then
+         Report.Failed("Incorrect Set to Sequence translation");
+      end if;
+
+      
+      for i in 1..26 loop
+         Inverse_Alphabet(i) := Alphabet(27-i);
+      end loop;
+
+      declare
+         Inverse_Map : Maps.Character_Mapping :=
+                         Maps.To_Mapping(Alphabet, Inverse_Alphabet);
+      begin
+         if Maps.Value(Maps.Identity, 'b') /= Maps.Value(Inverse_Map,'y') 
+         then
+            Report.Failed("Incorrect Inverse mapping");
+         end if;
+      end;
+
+
+      -- Check that Translation_Error is raised when a character is
+      -- repeated in the parameter "From" string.
+      declare
+         Bad_Map : Maps.Character_Mapping;
+      begin
+         Bad_Map := Maps.To_Mapping(From => "aa", To => "yz");
+         Report.Failed("Exception not raised with repeated character");
+      exception
+         when Translation_Error => null;  -- OK
+         when others            => 
+            Report.Failed("Incorrect exception raised in To_Mapping with " &
+                          "a repeated character");
+      end;
+
+
+      -- Check that Translation_Error is raised when the parameters of the
+      -- function To_Mapping are of unequal lengths.
+      declare
+         Bad_Map : Maps.Character_Mapping;
+      begin
+         Bad_Map := Maps.To_Mapping("abc", "yz");
+         Report.Failed("Exception not raised with unequal parameter lengths");
+      exception
+         when Translation_Error => null;  -- OK
+         when others            => 
+            Report.Failed("Incorrect exception raised in To_Mapping with " &
+                          "unequal parameter lengths");
+      end;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4002.a
new file mode 100644
index 000000000..583621ab4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4002.a
@@ -0,0 +1,182 @@
+-- CXA4002.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 subprograms defined in package Ada.Strings.Fixed are
+--      available, and that they produce correct results.  Specifically, 
+--      check the subprograms Index, "*" (string constructor function), 
+--      Count, Trim, and Replace_Slice.
+--
+-- TEST DESCRIPTION:
+--      This test demonstrates how certain Fixed string functions are used
+--      to eliminate specific substrings from portions of text.  A procedure
+--      is defined that will take as parameters a source string along with
+--      a substring that is to be completely removed from the source string.
+--      The source string is parsed using the Index function, and any substring
+--      slices are replaced in the source string by a series of X's (based on
+--      the length of the substring.)  
+--      Three lines of text are provided to this procedure, and the resulting
+--      substitutions are compared with expected results to validate the 
+--      string processing.
+--      A global accumulator is updated with the number of occurrences of the
+--      substring in the source string.  
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Ada.Strings;
+with Ada.Strings.Fixed;
+with Ada.Strings.Maps;
+with Report;
+
+procedure CXA4002 is
+
+begin
+
+   Report.Test ("CXA4002", "Check that the subprograms defined in package "  &
+                           "Ada.Strings.Fixed are available, and that "      &
+                           "they produce correct results");
+
+   Test_Block:
+   declare
+
+      TC_Total : Natural := 0;
+      Number_Of_Lines : constant := 3;
+
+      type Restricted_Words_Array_Type is array (1..10) of String (1..10);
+
+      Restricted_Words : Restricted_Words_Array_Type := 
+                           ("   platoon", " marines  ", "  Marines ",
+                            "north     ", "south     ", "      east", 
+                            "  beach   ", "   airport", "airfield  ", 
+                            "     road ");
+
+      subtype Line_Of_Text_Type is String(1..25);
+      type    Page_Of_Text_Type is array (1..Number_Of_Lines) 
+        of Line_Of_Text_Type;
+
+      Text_Page : Page_Of_Text_Type := ("The platoon of Marines   ",
+                                        "moved south on the south ",
+                                        "road to the airfield.    ");
+
+      TC_Revised_Line_1 : constant String := "The XXXXXXX of XXXXXXX   ";
+      TC_Revised_Line_2 : constant String := "moved XXXXX on the XXXXX ";
+      TC_Revised_Line_3 : constant String := "XXXX to the XXXXXXXX.    ";
+
+      ---
+
+      procedure Censor (Source_String  : in out String;
+                        Pattern_String : in     String) is
+                        
+         -- Create a replacement string that is the same length as the
+         -- pattern string being removed.
+         Replacement : constant String :=                              -- "*"
+                         Ada.Strings.Fixed."*"(Pattern_String'Length, 'X');
+
+         Going       : Ada.Strings.Direction := Ada.Strings.Forward;
+         Map         : constant Ada.Strings.Maps.Character_Mapping :=
+                         Ada.Strings.Maps.Identity;
+         Start_Pos,
+         Index       : Natural := Source_String'First;
+
+
+      begin  -- Censor
+
+         -- Accumulate count of total replacement operations.
+
+         TC_Total := TC_Total +                                     -- Count
+                       Ada.Strings.Fixed.Count (Source  => Source_String,
+                                                Pattern => Pattern_String,
+                                                Mapping => Map);
+         loop
+
+            Index := Ada.Strings.Fixed.Index                        -- Index
+                       (Source_String(Start_Pos..Source_String'Last),
+                        Pattern_String, 
+                        Going, 
+                        Map);
+
+            exit when Index = 0;   -- No matches, exit loop.
+
+            -- if a match was found, modify the substring.
+            Ada.Strings.Fixed.Replace_Slice                   -- Replace_Slice
+                                (Source_String,
+                                 Index,
+                                 Index + Pattern_String'Length - 1,
+                                 Replacement);
+            Start_Pos := Index + Pattern_String'Length;
+
+         end loop;
+
+      end Censor;
+
+
+   begin
+
+      -- Invoke Censor subprogram to cleanse text.
+      -- Loop through each line of text, and check for the presence of each
+      -- restricted word.
+      -- Use the Trim function to eliminate leading or trailing blanks from
+      -- the restricted word parameters.
+
+      for Line in 1..Number_Of_Lines loop
+         for Word in Restricted_Words'Range loop
+             Censor (Text_Page(Line), 
+                     Ada.Strings.Fixed.Trim(Restricted_Words(Word),   -- Trim
+                                            Ada.Strings.Both));
+         end loop;
+      end loop;
+
+
+      -- Validate results.
+
+      if TC_Total /= 6 then
+         Report.Failed ("Incorrect number of substitutions performed");
+      end if;
+
+      if Text_Page(1) /= TC_Revised_Line_1 then
+         Report.Failed ("Incorrect substitutions on Line 1");
+      end if;
+
+      if Text_Page(2) /= TC_Revised_Line_2 then
+         Report.Failed ("Incorrect substitutions on Line 2");
+      end if;
+
+      if Text_Page(3) /= TC_Revised_Line_3 then
+         Report.Failed ("Incorrect substitutions on Line 3");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4003.a
new file mode 100644
index 000000000..cd57a9296
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4003.a
@@ -0,0 +1,326 @@
+-- CXA4003.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 subprograms defined in package Ada.Strings.Fixed are
+--      available, and that they produce correct results.  Specifically, 
+--      check the subprograms Index, Index_Non_Blank, Head, Tail, Translate, 
+--      Find_Token, Move, Overwrite, and Replace_Slice.
+--
+-- TEST DESCRIPTION:
+--      This test demonstrates how certain fixed string operations could be
+--      used in string information processing.  A procedure is defined that
+--      will extract portions of a 50 character string that correspond to
+--      certain data items (i.e., name, address, state, zip code). These
+--      parsed items will then be added to the appropriate fields of data
+--      base elements.  These data base elements are then compared for
+--      accuracy against a similar set of predefined data base elements.
+--
+--      A variety of fixed string processing subprograms are used in this
+--      test.  Each parsing operation uses a different combination
+--      of the available subprograms to accomplish the same goal, therefore
+--      continuity of approach to string parsing is not seen in this test.
+--      However, a wide variety of possible approaches are demonstrated, while
+--      exercising a large number of the total predefined subprograms of
+--      package Ada.Strings.Fixed.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Ada.Strings.Fixed;
+with Ada.Strings.Maps;
+with Report;
+
+procedure CXA4003 is
+
+begin
+
+   Report.Test ("CXA4003", "Check that the subprograms defined in package "  &
+                           "Ada.Strings.Fixed are available, and that they " &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      Number_Of_Info_Strings : constant Natural := 3;
+      DB_Size                : constant Natural := Number_Of_Info_Strings;
+      Count                  : Natural          := 0;
+      Finished_Processing    : Boolean          := False;
+      Blank_String           : constant String  := " ";
+
+      subtype Info_String_Type         is String (1..50);
+      type    Info_String_Storage_Type is 
+        array (1..Number_Of_Info_Strings) of Info_String_Type;
+
+
+      subtype Name_Type                is String (1..10);
+      subtype Street_Number_Type       is String (1..5);
+      subtype Street_Name_Type         is String (1..10);
+      subtype City_Type                is String (1..10);
+      subtype State_Type               is String (1..2);
+      subtype Zip_Code_Type            is String (1..5);
+
+      type Data_Base_Element_Type is
+         record
+            Name          : Name_Type          := (others => ' ');
+            Street_Number : Street_Number_Type := (others => ' ');
+            Street_Name   : Street_Name_Type   := (others => ' ');
+            City          : City_Type          := (others => ' ');
+            State         : State_Type         := (others => ' ');
+            Zip_Code      : Zip_Code_Type      := (others => ' ');
+         end record;
+
+      type Data_Base_Type is array (1..DB_Size) of Data_Base_Element_Type;
+
+      Data_Base : Data_Base_Type;
+
+      ---
+
+      Info_String_1 : Info_String_Type := 
+        "Joe_Jones 123   Sixth_St   San_Diego    CA   98765"; 
+
+      Info_String_2 : Info_String_Type := 
+        "Sam_Smith 56789  S._Seventh   Carlsbad  CA   92177";
+
+      Info_String_3 : Info_String_Type := 
+        "Jane_Brown 1219   Info_Lane  Tuscon     AZ   85643";
+
+
+      Info_Strings : Info_String_Storage_Type := (1 => Info_String_1,
+                                                  2 => Info_String_2,
+                                                  3 => Info_String_3);
+
+
+
+      TC_DB_Element_1 : Data_Base_Element_Type := 
+        ("Joe Jones ", "123  ", "Sixth St  ", "San Diego ", "CA", "98765");
+
+      TC_DB_Element_2 : Data_Base_Element_Type := 
+        ("Sam Smith ", "56789", "S. Seventh", "Carlsbad  ", "CA", "92177");
+
+      TC_DB_Element_3 : Data_Base_Element_Type := 
+        ("Jane Brown", "1219 ", "Info Lane ", "Tuscon    ", "AZ", "85643");
+
+      TC_Data_Base : Data_Base_Type := (TC_DB_Element_1,
+                                        TC_DB_Element_2,
+                                        TC_DB_Element_3);
+
+      ---
+
+
+      procedure Store_Information 
+         (Info_String : in     Info_String_Type;
+          DB_Record   : in out Data_Base_Element_Type) is
+
+         package AS renames Ada.Strings;
+         use type AS.Maps.Character_Set;
+
+         UnderScore  : AS.Maps.Character_Sequence := "_";
+         Blank       : AS.Maps.Character_Sequence := " ";
+
+         Start,
+         Stop  : Natural := 0;
+
+         Underscore_to_Blank_Map : constant AS.Maps.Character_Mapping := 
+                            AS.Maps.To_Mapping(From => UnderScore, 
+                                               To   => Blank);
+
+         Numeric_Set    : constant AS.Maps.Character_Set :=
+                            AS.Maps.To_Set("0123456789");
+
+         Cal            : constant AS.Maps.Character_Sequence := "CA";
+         California_Set : constant AS.Maps.Character_Set := 
+                            AS.Maps.To_Set(Cal);
+         Arizona_Set    : constant AS.Maps.Character_Set := 
+                            AS.Maps.To_Set("AZ");
+         Nevada_Set     : constant AS.Maps.Character_Set := 
+                            AS.Maps.To_Set("NV");
+
+      begin
+
+         -- Find the starting position of the name field (first non-blank),
+         -- then, from that position, find the end of the name field (first
+         -- blank).
+
+         Start := AS.Fixed.Index_Non_Blank(Info_String); 
+         Stop  := AS.Fixed.Index (Info_String(Start..Info_String'Length),
+                                  AS.Maps.To_Set(' '),
+                                  AS.Inside,
+                                  AS.Forward) - 1 ;
+
+         -- Store the name field in the data base element field for "Name".
+
+         DB_Record.Name := AS.Fixed.Head(Info_String(1..Stop), 
+                                         DB_Record.Name'Length);
+
+         -- Replace any underscore characters in the name field
+         -- that were used to separate first/middle/last names.
+
+         AS.Fixed.Translate (DB_Record.Name, Underscore_to_Blank_Map);
+
+         
+         -- Continue the extraction process; now find the position of
+         -- the street number in the string.
+
+         Start := Stop + 1;
+
+         AS.Fixed.Find_Token(Info_String(Start..Info_String'Length),
+                             Numeric_Set,
+                             AS.Inside,
+                             Start,
+                             Stop);
+
+         -- Store the street number field in the appropriate data base 
+         -- element.
+         -- No modification of the default parameters of procedure Move
+         -- is required.
+
+         AS.Fixed.Move(Source => Info_String(Start..Stop),
+                       Target => DB_Record.Street_Number);
+
+
+         -- Continue the extraction process; find the street name in the
+         -- info string.  Skip blanks to the start of the street name, then
+         -- search for the index of the next blank character in the string.
+
+         Start :=
+           AS.Fixed.Index_Non_Blank(Info_String(Stop+1..Info_String'Length)); 
+
+         Stop := 
+           AS.Fixed.Index(Info_String(Start..Info_String'Length),
+                          Blank_String) - 1; 
+
+         -- Store the street name in the appropriate data base element field.
+
+         AS.Fixed.Overwrite(DB_Record.Street_Name, 
+                            1, 
+                            Info_String(Start..Stop));
+                           
+         -- Replace any underscore characters in the street name field
+         -- that were used as word separation.
+
+         DB_Record.Street_Name := AS.Fixed.Translate(DB_Record.Street_Name, 
+                                                     Underscore_to_Blank_Map);
+
+
+         -- Continue the extraction; remove the city name from the string.
+
+         Start :=
+           AS.Fixed.Index_Non_Blank(Info_String(Stop+1..Info_String'Length)); 
+
+         Stop := 
+           AS.Fixed.Index(Info_String(Start..Info_String'Length), 
+                          Blank_String) - 1; 
+
+         -- Store the city name field in the appropriate data base element.
+
+         AS.Fixed.Replace_Slice(DB_Record.City, 
+                                1,
+                                DB_Record.City'Length,
+                                Info_String(Start..Stop));
+                           
+         -- Replace any underscore characters in the city name field
+         -- that were used as word separation.
+
+         AS.Fixed.Translate (DB_Record.City, Underscore_to_Blank_Map);
+
+
+         -- Continue the extraction; remove the state identifier from the 
+         -- info string.
+
+         Start := Stop + 1;
+
+         AS.Fixed.Find_Token(Info_String(Start..Info_String'Length),
+                             AS.Maps."OR"(California_Set,
+                               AS.Maps."OR"(Nevada_Set, Arizona_Set)),
+                             AS.Inside,
+                             Start,
+                             Stop);
+
+         -- Store the state indicator into the data base element.
+
+         AS.Fixed.Move(Source  => Info_String(Start..Stop),
+                       Target  => DB_Record.State,
+                       Drop    => Ada.Strings.Right,
+                       Justify => Ada.Strings.Left,
+                       Pad     => AS.Space);
+
+
+         -- Continue the extraction process; remove the final data item in 
+         -- the info string, the zip code, and place it into the 
+         -- corresponding data base element.
+
+         DB_Record.Zip_Code := AS.Fixed.Tail(Info_String, 
+                                             DB_Record.Zip_Code'Length);
+
+      exception 
+         when AS.Length_Error      =>
+            Report.Failed ("Length_Error raised in procedure");
+         when AS.Pattern_Error     =>
+            Report.Failed ("Pattern_Error raised in procedure");
+         when AS.Translation_Error =>
+            Report.Failed ("Translation_Error raised in procedure");
+         when others            =>
+            Report.Failed ("Exception raised in procedure");
+      end Store_Information;
+
+
+   begin
+
+      -- Loop thru the information strings, extract the name and address
+      -- information, place this info into elements of the data base.
+
+      while not Finished_Processing loop
+
+         Count := Count + 1;
+
+         Store_Information (Info_Strings(Count), Data_Base(Count));
+
+         Finished_Processing := (Count = Number_Of_Info_Strings);
+
+      end loop;
+
+
+      -- Verify that the string processing was successful.
+
+      for i in 1..DB_Size loop
+         if Data_Base(i) /= TC_Data_Base(i) then
+            Report.Failed 
+              ("Data processing error on record " & Integer'Image(i));
+         end if;
+      end loop;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a
new file mode 100644
index 000000000..ec11f7d50
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4004.a
@@ -0,0 +1,431 @@
+-- CXA4004.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 subprograms defined in package Ada.Strings.Fixed are
+--      available, and that they produce correct results. Specifically, check 
+--      the subprograms Count, Find_Token, Index, Index_Non_Blank, and Move.
+--      
+-- TEST DESCRIPTION:
+--      This test, when combined with tests CXA4002,3, and 5 will provide 
+--      thorough coverage of the functionality found in Ada.Strings.Fixed.  
+--      This test contains many small, specific test cases, situations that 
+--      although common in user environments, are often difficult to generate 
+--      in large numbers in a application-based test.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Apr 95   SAIC    Corrected subtest for Move, Drop=Right.
+--
+--!
+
+with Report;
+with Ada.Strings;
+with Ada.Strings.Fixed;
+with Ada.Strings.Maps;
+
+procedure CXA4004 is
+begin
+
+   Report.Test("CXA4004", "Check that the subprograms defined in "    &
+                          "package Ada.Strings.Fixed are available, " &
+                          "and that they produce correct results");
+
+   Test_Block:
+   declare
+
+      package ASF  renames Ada.Strings.Fixed;
+      package Maps renames Ada.Strings.Maps;
+
+      Result_String  : String(1..10) := (others => Ada.Strings.Space);
+
+      Source_String1 : String(1..5)  := "abcde";        -- odd length string
+      Source_String2 : String(1..6)  := "abcdef";       -- even length string
+      Source_String3 : String(1..12) := "abcdefghijkl";   
+      Source_String4 : String(1..12) := "abcdefghij  "; -- last two ch pad
+      Source_String5 : String(1..12) := "  cdefghijkl"; -- first two ch pad
+      Source_String6 : String(1..12) := "abcdefabcdef";   
+                                                                              
+      Location       : Natural := 0;
+      Slice_Start    : Positive;
+      Slice_End,
+      Slice_Count    : Natural := 0;
+
+      CD_Set         : Maps.Character_Set := Maps.To_Set("cd");  
+      ABCD_Set       : Maps.Character_Set := Maps.To_Set("abcd");
+      A_to_F_Set     : Maps.Character_Set := Maps.To_Set("abcdef");
+                  
+      CD_to_XY_Map   : Maps.Character_Mapping :=
+                         Maps.To_Mapping(From => "cd",  To => "xy");
+
+   begin
+
+      -- Procedure Move
+
+      -- Evaluate the Procedure Move with various combinations of
+      -- parameters.
+
+      -- Justify = Left (default case)
+     
+      ASF.Move(Source => Source_String1,       -- "abcde"
+               Target => Result_String);
+      
+      if Result_String /= "abcde     " then
+         Report.Failed("Incorrect result from Move with Justify = Left");
+      end if;
+ 
+      -- Justify = Right
+ 
+      ASF.Move(Source  => Source_String2,      -- "abcdef"
+               Target  => Result_String,
+               Drop    => Ada.Strings.Error,
+               Justify => Ada.Strings.Right);
+
+      if Result_String /= "    abcdef" then
+         Report.Failed("Incorrect result from Move with Justify = Right");
+      end if;
+
+      -- Justify = Center (two cases, odd and even pad lengths)
+ 
+      ASF.Move(Source_String1,                 -- "abcde"
+               Result_String,
+               Ada.Strings.Error,
+               Ada.Strings.Center,
+               'x');                           -- non-default padding.
+
+      if Result_String /= "xxabcdexxx" then  -- Unequal padding added right
+         Report.Failed("Incorrect result from Move with Justify = Center-1");
+      end if;
+
+      ASF.Move(Source_String2,                 -- "abcdef"
+               Result_String,
+               Ada.Strings.Error,
+               Ada.Strings.Center);
+
+      if Result_String /= "  abcdef  " then  -- Equal padding added on L/R.
+         Report.Failed("Incorrect result from Move with Justify = Center-2");
+      end if;
+
+      -- When the source string is longer than the target string, several
+      -- cases can be examined, with the results depending on the value of
+      -- the Drop parameter.
+
+      -- Drop = Left
+
+      ASF.Move(Source => Source_String3,       -- "abcdefghijkl"
+               Target => Result_String,
+               Drop   => Ada.Strings.Left);
+
+      if Result_String /= "cdefghijkl" then
+         Report.Failed("Incorrect result from Move with Drop = Left");
+      end if;
+
+      -- Drop = Right
+     
+      ASF.Move(Source_String3, Result_String, Ada.Strings.Right);
+
+      if Result_String /= "abcdefghij" then
+         Report.Failed("Incorrect result from Move with Drop = Right");
+      end if;
+
+      -- Drop = Error
+      -- The effect in this case depends on the value of the justify
+      -- parameter, and on whether any characters in Source other than 
+      -- Pad would fail to be copied.
+
+      -- Drop = Error, Justify = Left, right overflow characters are pad.
+
+      ASF.Move(Source  => Source_String4,      -- "abcdefghij  "
+               Target  => Result_String,
+               Drop    => Ada.Strings.Error,
+               Justify => Ada.Strings.Left);
+
+      if not(Result_String = "abcdefghij") then  -- leftmost 10 characters
+          Report.Failed("Incorrect result from Move with Drop = Error - 1");
+      end if;
+
+      -- Drop = Error, Justify = Right, left overflow characters are pad.
+
+      ASF.Move(Source_String5,                 -- "  cdefghijkl"
+               Result_String, 
+               Ada.Strings.Error, 
+               Ada.Strings.Right);
+
+      if Result_String /= "cdefghijkl" then  -- rightmost 10 characters
+         Report.Failed("Incorrect result from Move with Drop = Error - 2");
+      end if;
+
+      -- In other cases of Drop=Error, Length_Error is propagated, such as:
+
+      begin
+
+         ASF.Move(Source_String3,     -- 12 characters, no Pad.
+                  Result_String,      -- 10 characters
+                  Ada.Strings.Error,  
+                  Ada.Strings.Left);  
+
+         Report.Failed("Length_Error not raised by Move - 1");
+
+      exception
+         when Ada.Strings.Length_Error => null;   -- OK
+         when others => 
+            Report.Failed("Incorrect exception raised by Move - 1");
+      end;
+
+
+
+      -- Function Index
+      -- (Other usage examples of this function found in CXA4002-3.)
+      -- Check when the pattern is not found in the source.
+
+      if ASF.Index("abcdef", "gh")       /= 0 or
+         ASF.Index("abcde",  "abcdef")   /= 0 or  -- pattern > source
+         ASF.Index("xyz", 
+                   "abcde", 
+                   Ada.Strings.Backward) /= 0 or
+         ASF.Index("",      "ab")        /= 0 or  -- null source string.
+         ASF.Index("abcde", "  ")        /= 0     -- blank pattern.
+      then
+         Report.Failed("Incorrect result from Index, no pattern match");
+      end if;
+
+      -- Check that Pattern_Error is raised when the pattern is the 
+      -- null string.
+      begin
+         Location := ASF.Index(Source_String6,    -- "abcdefabcdef"
+                               "",                -- null pattern string.
+                               Ada.Strings.Forward);
+         Report.Failed("Pattern_Error not raised by Index");
+      exception
+         when Ada.Strings.Pattern_Error => null;  -- OK, expected exception.
+         when others                    =>
+           Report.Failed("Incorrect exception raised by Index, null pattern");
+      end;
+
+      -- Use the search direction "backward" to locate the particular
+      -- pattern within the source string.
+
+      Location := ASF.Index(Source_String6,         -- "abcdefabcdef"
+                            "de",                   -- slice 4..5, 10..11
+                            Ada.Strings.Backward);  -- search from right end.
+
+      if Location /= 10  then
+         Report.Failed("Incorrect result from Index going Backward");
+      end if;
+
+      -- Using the version of Index testing character set membership, 
+      -- check combinations of forward/backward, inside/outside parameter
+      -- configurations.
+
+      if ASF.Index(Source => Source_String1,      -- "abcde"
+                   Set    => CD_Set,
+                   Test   => Ada.Strings.Inside,
+                   Going  => Ada.Strings.Forward) /= 3 or -- 'c' at pos 3.
+         ASF.Index(Source_String6,                -- "abcdefabcdef"
+                   CD_Set,
+                   Ada.Strings.Outside,
+                   Ada.Strings.Backward)  /=  12  or   -- 'f' at position 12
+         ASF.Index(Source_String6,                -- "abcdefabcdef"
+                   CD_Set,
+                   Ada.Strings.Inside,
+                   Ada.Strings.Backward)  /=   10  or  -- 'd' at position 10
+         ASF.Index("cdcdcdcdacdcdcdcd",               
+                   CD_Set,
+                   Ada.Strings.Outside,
+                   Ada.Strings.Forward)   /=    9      -- 'a' at position 9
+      then
+         Report.Failed("Incorrect result from function Index for sets - 1");
+      end if;
+
+      -- Additional interesting uses/combinations using Index for sets.
+
+      if ASF.Index("cd",                               -- same size, str-set
+                   CD_Set,
+                   Ada.Strings.Inside,
+                   Ada.Strings.Forward)   /=    1  or  -- 'c' at position 1
+         ASF.Index("abcd",                             -- same size, str-set,
+                   Maps.To_Set("efgh"),                -- different contents.
+                   Ada.Strings.Outside,                
+                   Ada.Strings.Forward)   /=    1  or
+         ASF.Index("abccd",                            -- set > string
+                   Maps.To_Set("acegik"),
+                   Ada.Strings.Inside,
+                   Ada.Strings.Backward)  /=    4  or  -- 'c' at position 4
+         ASF.Index("abcde",
+                   Maps.Null_Set)         /=    0  or
+         ASF.Index("",                                 -- Null string.
+                   CD_Set)                /=    0  or
+         ASF.Index("abc ab",                           -- blank included
+                   Maps.To_Set("e "),                  -- in string and set.
+                   Ada.Strings.Inside,
+                   Ada.Strings.Backward)  /=    4      -- blank in string.
+      then
+         Report.Failed("Incorrect result from function Index for sets - 2");
+      end if;
+
+
+
+      -- Function Index_Non_Blank.                      
+      -- (Other usage examples of this function found in CXA4002-3.)
+                                                         
+
+      if ASF.Index_Non_Blank(Source => Source_String4,  -- "abcdefghij  "
+                             Going  => Ada.Strings.Backward)  /= 10  or
+         ASF.Index_Non_Blank("abc def ghi jkl  ",
+                             Ada.Strings.Backward)            /= 15  or
+         ASF.Index_Non_Blank("  abcdef")                      /=  3  or
+         ASF.Index_Non_Blank("        ")                      /=  0
+      then
+          Report.Failed("Incorrect result from Index_Non_Blank");
+      end if;
+
+
+
+      -- Function Count
+      -- (Other usage examples of this function found in CXA4002-3.)
+
+      if ASF.Count("abababa",   "aba")            /=  2  or
+         ASF.Count("abababa",   "ab" )            /=  3  or
+         ASF.Count("babababa",  "ab")             /=  3  or
+         ASF.Count("abaabaaba", "aba")            /=  3  or
+         ASF.Count("xxxxxxxxxxxxxxxxxxxy", "xy")  /=  1  or
+         ASF.Count("xxxxxxxxxxxxxxxxxxxx", "x")   /= 20
+      then
+         Report.Failed("Incorrect result from Function Count");
+      end if;
+
+      -- Determine the number of slices of Source that when mapped to a 
+      -- non-identity map, match the pattern string.
+
+      Slice_Count := ASF.Count(Source_String6, -- "abcdefabcdef"
+                               "xy",
+                               CD_to_XY_Map);  -- maps 'c' to 'x', 'd' to 'y'
+
+      if Slice_Count /= 2 then  -- two slices "xy" in "mapped" Source_String6
+         Report.Failed("Incorrect result from Count with non-identity map");
+      end if;
+
+      -- If the pattern supplied to Function Count is the null string, then
+      -- Pattern_Error is propagated.
+
+      declare
+         The_Null_String : constant String := "";
+      begin
+         Slice_Count := ASF.Count(Source_String6, The_Null_String);
+         Report.Failed("Pattern_Error not raised by Function Count");
+      exception
+         when Ada.Strings.Pattern_Error => null;   -- OK
+         when others =>
+           Report.Failed("Incorrect exception from Count with null pattern");
+      end;
+
+
+      -- Function Count returning the number of characters in a particular
+      -- set that are found in source string.
+
+      if ASF.Count(Source_String6, CD_Set) /= 4 then  -- 2 'c' and 'd' chars.
+         Report.Failed("Incorrect result from Count with set");
+      end if;
+
+
+ 
+      -- Function Find_Token.                            
+      -- (Other usage examples of this function found in CXA4002-3.)
+
+      ASF.Find_Token(Source  => Source_String6,      -- First slice with no 
+                     Set     => ABCD_Set,            -- 'a', 'b', 'c', or 'd'
+                     Test    => Ada.Strings.Outside, -- is "ef" at 5..6.
+                     First   => Slice_Start,
+                     Last    => Slice_End);
+
+      if Slice_Start /= 5  or Slice_End /= 6 then
+         Report.Failed("Incorrect result from Find_Token - 1");
+      end if;
+
+      -- If no appropriate slice is contained by the source string, then the 
+      -- value returned in Last is zero, and the value in First is 
+      -- Source'First.
+
+      ASF.Find_Token(Source_String6,      -- "abcdefabcdef"
+                     A_to_F_Set,          -- Set of characters 'a' thru 'f'.
+                     Ada.Strings.Outside, -- No characters outside this set.
+                     Slice_Start,
+                     Slice_End);
+      
+      if Slice_Start /= Source_String6'First  or Slice_End /= 0 then
+         Report.Failed("Incorrect result from Find_Token - 2");
+      end if;
+
+      -- Additional testing of Find_Token.
+
+      ASF.Find_Token("eabcdabcddcab", 
+                     ABCD_Set, 
+                     Ada.Strings.Inside,
+                     Slice_Start,
+                     Slice_End);
+
+      if Slice_Start /= 2  or Slice_End /= 13 then
+         Report.Failed("Incorrect result from Find_Token - 3");
+      end if;
+
+      ASF.Find_Token("efghijklabcdabcd",
+                     ABCD_Set,
+                     Ada.Strings.Outside,
+                     Slice_Start,
+                     Slice_End);
+
+      if Slice_Start /= 1  or Slice_End /= 8 then
+         Report.Failed("Incorrect result from Find_Token - 4");
+      end if;
+
+      ASF.Find_Token("abcdefgabcdabcd",
+                     ABCD_Set,
+                     Ada.Strings.Outside,
+                     Slice_Start,
+                     Slice_End);
+
+      if Slice_Start /= 5  or Slice_End /= 7 then
+         Report.Failed("Incorrect result from Find_Token - 5");
+      end if;
+
+      ASF.Find_Token("abcdcbabcdcba",
+                     ABCD_Set,
+                     Ada.Strings.Inside,
+                     Slice_Start,
+                     Slice_End);
+
+      if Slice_Start /= 1  or Slice_End /= 13 then
+         Report.Failed("Incorrect result from Find_Token - 6");
+      end if;
+
+
+   exception
+      when others => Report.Failed("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a
new file mode 100644
index 000000000..d61f853ca
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4005.a
@@ -0,0 +1,683 @@
+-- CXA4005.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 subprograms defined in package Ada.Strings.Fixed are
+--      available, and that they produce correct results.  Specifically,
+--      check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice,
+--      Tail, Trim, and "*".
+--
+-- TEST DESCRIPTION:
+--      This test, when combined with tests CXA4002-4 will provide coverage
+--      of the functionality found in Ada.Strings.Fixed.
+--      This test contains many small, specific test cases, situations that
+--      although common in user environments, are often difficult to generate
+--      in large numbers in a application-based test.  They represent
+--      individual usage paradigms in-the-small.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      11 Apr 95   SAIC    Corrected acceptance conditions of certain
+--                          subtests.
+--	06 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1.
+--      22 Feb 01   PHL     Check that the lower bound of the result is 1.
+--      13 Mar 01   RLB     Fixed a couple of ACATS style violations;
+--                          removed pointless checks of procedures.
+--                          Added checks of other functions. These changes
+--                          were made to test Defect Report 8652/0049, as
+--                          reflected in Technical Corrigendum 1.
+--
+--!
+
+with Report;
+with Ada.Strings;
+with Ada.Strings.Fixed;
+with Ada.Strings.Maps;
+
+procedure CXA4005 is
+
+    type TC_Name_Holder is access String;
+    Name : TC_Name_Holder;
+
+    function TC_Check (S : String) return String is
+    begin
+        if S'First /= 1 then
+            Report.Failed ("Lower bound of result of function " & Name.all &
+                           " is" & Integer'Image (S'First));
+        end if;
+        return S;
+    end TC_Check;
+
+    procedure TC_Set_Name (N : String) is
+    begin
+        Name := new String'(N);
+    end TC_Set_Name;
+
+begin
+
+   Report.Test("CXA4005", "Check that the subprograms defined in "    &
+                          "package Ada.Strings.Fixed are available, " &
+                          "and that they produce correct results");
+
+   Test_Block:
+   declare
+
+      package ASF  renames Ada.Strings.Fixed;
+      package Maps renames Ada.Strings.Maps;
+
+      Result_String,
+      Delete_String,
+      Insert_String,
+      Trim_String,
+      Overwrite_String  : String(1..10) := (others => Ada.Strings.Space);
+
+      Source_String1    : String(1..5)  := "abcde";     -- odd length string
+      Source_String2    : String(1..6)  := "abcdef";    -- even length string
+      Source_String3    : String(1..12) := "abcdefghijkl";
+      Source_String4    : String(1..12) := "abcdefghij  "; -- last two ch pad
+      Source_String5    : String(1..12) := "  cdefghijkl"; -- first two ch pad
+      Source_String6    : String(1..12) := "abcdefabcdef";
+
+      Location     : Natural := 0;
+      Slice_Start  : Positive;
+      Slice_End,
+      Slice_Count  : Natural := 0;
+
+      CD_Set       : Maps.Character_Set := Maps.To_Set("cd");
+      X_Set        : Maps.Character_Set := Maps.To_Set('x');
+      ABCD_Set     : Maps.Character_Set := Maps.To_Set("abcd");
+      A_to_F_Set   : Maps.Character_Set := Maps.To_Set("abcdef");
+
+      CD_to_XY_Map : Maps.Character_Mapping :=
+                                 Maps.To_Mapping(From => "cd",  To => "xy");
+
+   begin
+
+      -- Procedure Replace_Slice
+      -- The functionality of this procedure
+      -- is similar to procedure Move, and
+      -- is tested here in the same manner, evaluated
+      -- with various combinations of parameters.
+
+      -- Index_Error propagation when Low > Source'Last + 1
+
+      begin
+         ASF.Replace_Slice(Result_String,
+                           Result_String'Last + 2, -- should raise exception
+                           Result_String'Last,
+                           "xxxxxxx");
+         Report.Failed("Index_Error not raised by Replace_Slice - 1");
+      exception
+         when Ada.Strings.Index_Error => null; -- OK, expected exception.
+         when others                  =>
+            Report.Failed("Incorrect exception from Replace_Slice - 1");
+      end;
+
+      -- Index_Error propagation when High < Source'First - 1
+
+      begin
+         ASF.Replace_Slice(Result_String(5..10),
+                           5,
+                           3, -- should raise exception since < 'First - 1.
+                           "xxxxxxx");
+         Report.Failed("Index_Error not raised by Replace_Slice - 2");
+      exception
+         when Ada.Strings.Index_Error => null; -- OK, expected exception.
+         when others                  =>
+            Report.Failed("Incorrect exception from Replace_Slice - 2");
+      end;
+
+      -- Justify = Left (default case)
+
+      Result_String := "XXXXXXXXXX";
+
+      ASF.Replace_Slice(Source => Result_String,
+                        Low    =>  1,
+                        High   => 10,
+                        By     => Source_String1);   -- "abcde"
+
+      if Result_String /= "abcde     " then
+         Report.Failed("Incorrect result from Replace_Slice - Justify = Left");
+      end if;
+
+      -- Justify = Right
+
+      ASF.Replace_Slice(Source  => Result_String,
+                        Low     => 1,
+                        High    => Result_String'Last,
+                        By      => Source_String2,      -- "abcdef"
+                        Drop    => Ada.Strings.Error,
+                        Justify => Ada.Strings.Right);
+
+      if Result_String /= "    abcdef" then
+         Report.Failed("Incorrect result from Replace_Slice - Justify=Right");
+      end if;
+
+      -- Justify = Center (two cases, odd and even pad lengths)
+
+      ASF.Replace_Slice(Result_String,
+                        1,
+                        Result_String'Last,
+                        Source_String1,      -- "abcde"
+                        Ada.Strings.Error,
+                        Ada.Strings.Center,
+                        'x');                -- non-default padding.
+
+      if Result_String /= "xxabcdexxx" then  -- Unequal padding added right
+         Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1");
+      end if;
+
+      ASF.Replace_Slice(Result_String,
+                        1,
+                        Result_String'Last,
+                        Source_String2,        -- "abcdef"
+                        Ada.Strings.Error,
+                        Ada.Strings.Center);
+
+      if Result_String /= "  abcdef  " then    -- Equal padding added on L/R.
+         Report.Failed("Incorrect result from Replace_Slice with " &
+                       "Justify = Center - 2");
+      end if;
+
+      -- When the source string is longer than the target string, several
+      -- cases can be examined, with the results depending on the value of
+      -- the Drop parameter.
+
+      -- Drop = Left
+
+      ASF.Replace_Slice(Result_String,
+                        1,
+                        Result_String'Last,
+                        Source_String3,            -- "abcdefghijkl"
+                        Drop => Ada.Strings.Left);
+
+      if Result_String /= "cdefghijkl" then
+         Report.Failed("Incorrect result from Replace_Slice - Drop=Left");
+      end if;
+
+      -- Drop = Right
+
+      ASF.Replace_Slice(Result_String,
+                        1,
+                        Result_String'Last,
+                        Source_String3,        -- "abcdefghijkl"
+                        Ada.Strings.Right);
+
+      if Result_String /= "abcdefghij" then
+         Report.Failed("Incorrect result, Replace_Slice with Drop=Right");
+      end if;
+
+      -- Drop = Error
+
+      -- The effect in this case depends on the value of the justify
+      -- parameter, and on whether any characters in Source other than
+      -- Pad would fail to be copied.
+
+      -- Drop = Error, Justify = Left, right overflow characters are pad.
+
+      ASF.Replace_Slice(Result_String,
+                        1,
+                        Result_String'Last,
+                        Source_String4,               -- "abcdefghij  "
+                        Drop    => Ada.Strings.Error,
+                        Justify => Ada.Strings.Left);
+
+      if not(Result_String = "abcdefghij") then  -- leftmost 10 characters
+          Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1");
+      end if;
+
+      -- Drop = Error, Justify = Right, left overflow characters are pad.
+
+      ASF.Replace_Slice(Source   => Result_String,
+                        Low      => 1,
+                        High     => Result_String'Last,
+                        By       => Source_String5,     -- "  cdefghijkl"
+                        Drop     => Ada.Strings.Error,
+                        Justify  => Ada.Strings.Right);
+
+      if Result_String /= "cdefghijkl" then  -- rightmost 10 characters
+         Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2");
+      end if;
+
+      -- In other cases of Drop=Error, Length_Error is propagated, such as:
+
+      begin
+
+         ASF.Replace_Slice(Source   => Result_String,
+                           Low      => 1,
+                           High     => Result_String'Last,
+                           By       => Source_String3,    -- "abcdefghijkl"
+                           Drop     => Ada.Strings.Error);
+
+          Report.Failed("Length_Error not raised by Replace_Slice - 1");
+
+      exception
+         when Ada.Strings.Length_Error => null;   -- OK
+         when others =>
+            Report.Failed("Incorrect exception from Replace_Slice - 3");
+      end;
+
+
+      -- Function Replace_Slice
+
+      TC_Set_Name ("Replace_Slice");
+
+      if TC_Check (ASF.Replace_Slice("abcde", 3, 3, "x"))
+                                           /= "abxde"  or -- High = Low
+         TC_Check (ASF.Replace_Slice("abc",   2, 3, "xyz")) /= "axyz"   or
+         TC_Check (ASF.Replace_Slice("abcd",  4, 1, "xy"))
+                                           /= "abcxyd" or -- High < Low
+         TC_Check (ASF.Replace_Slice("abc",   2, 3, "x"))   /= "ax"     or
+         TC_Check (ASF.Replace_Slice("a",     1, 1, "z"))   /= "z"
+      then
+         Report.Failed("Incorrect result from Function Replace_Slice - 1");
+      end if;
+
+      if TC_Check (ASF.Replace_Slice("abcde", 5, 5, "z"))
+                                           /= "abcdz" or  -- By length 1
+         TC_Check (ASF.Replace_Slice("abc",   1, 3, "xyz"))
+                                           /= "xyz"   or  -- High > Low
+         TC_Check (ASF.Replace_Slice("abc",   3, 2, "xy"))
+                                           /= "abxyc" or  -- insert
+         TC_Check (ASF.Replace_Slice("a",     1, 1, "xyz")) /= "xyz"
+      then
+         Report.Failed("Incorrect result from Function Replace_Slice - 2");
+      end if;
+
+
+
+      -- Function Insert.
+
+      TC_Set_Name ("Insert");
+
+      declare
+         New_String : constant String :=
+           TC_Check (
+              ASF.Insert(Source   => Source_String1(2..5),    -- "bcde"
+                         Before   => 3,
+                         New_Item => Source_String2));         -- "abcdef"
+      begin
+         if New_String /= "babcdefcde" then
+            Report.Failed("Incorrect result from Function Insert - 1");
+         end if;
+      end;
+
+      if TC_Check (ASF.Insert("a",   1, "z")) /= "za"   or
+         TC_Check (ASF.Insert("abc", 3, ""))  /= "abc"  or
+         TC_Check (ASF.Insert("abc", 1, "z")) /= "zabc"
+      then
+         Report.Failed("Incorrect result from Function Insert - 2");
+      end if;
+
+      begin
+         if TC_Check (ASF.Insert(Source   => Source_String1(2..5), -- "bcde"
+                         Before   => Report.Ident_Int(7),
+                         New_Item => Source_String2))         -- "abcdef"
+                /= "babcdefcde" then
+            Report.Failed("Index_Error not raised by Insert - 3A");
+         else
+            Report.Failed("Index_Error not raised by Insert - 3B");
+         end if;
+      exception
+         when Ada.Strings.Index_Error => null; -- OK, expected exception.
+         when others                  =>
+            Report.Failed("Incorrect exception from Insert - 3");
+      end;
+
+
+      -- Procedure Insert
+
+      -- Drop = Right
+
+      ASF.Insert(Source   => Insert_String,
+                 Before   => 6,
+                 New_Item => Source_String2,       -- "abcdef"
+                 Drop     => Ada.Strings.Right);
+
+      if Insert_String /= "     abcde" then  -- last char of New_Item dropped.
+         Report.Failed("Incorrect result from Insert with Drop = Right");
+      end if;
+
+      -- Drop = Left
+
+      ASF.Insert(Source   => Insert_String,     -- 10 char string
+                 Before   => 2,                 -- 9 chars, 2..10 available
+                 New_Item => Source_String3,    -- 12 characters long.
+                 Drop     => Ada.Strings.Left); -- truncate from Left.
+
+      if Insert_String /= "l    abcde" then     -- 10 chars, leading blank.
+          Report.Failed("Incorrect result from Insert with Drop=Left");
+      end if;
+
+      -- Drop = Error
+
+      begin
+         ASF.Insert(Source   => Result_String,       -- 10 chars
+                    Before   => Result_String'Last,
+                    New_Item => "abcdefghijk",
+                    Drop     => Ada.Strings.Error);
+         Report.Failed("Exception not raised by Procedure Insert");
+      exception
+         when Ada.Strings.Length_Error => null; -- OK, expected exception
+         when others                   =>
+           Report.Failed("Incorrect exception raised by Procedure Insert");
+      end;
+
+
+
+      -- Function Overwrite
+
+      TC_Set_Name ("Overwrite");
+
+      Overwrite_String := TC_Check (
+          ASF.Overwrite(Result_String,  -- 10 chars
+                        1,              -- starting at pos=1
+                        Source_String3(1..10)));
+
+      if Overwrite_String /= Source_String3(1..10) then
+         Report.Failed("Incorrect result from Function Overwrite - 1");
+      end if;
+
+
+      if TC_Check (ASF.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or
+         TC_Check (ASF.Overwrite("a",      1, "xyz"))
+                                           /= "xyz"    or  -- chars appended
+         TC_Check (ASF.Overwrite("abc",    3, "   "))
+                                           /= "ab   "  or  -- blanks appended
+         TC_Check (ASF.Overwrite("abcde",  1, "z"  )) /= "zbcde"
+      then
+         Report.Failed("Incorrect result from Function Overwrite - 2");
+      end if;
+
+
+
+      -- Procedure Overwrite, with truncation.
+
+      ASF.Overwrite(Source   => Overwrite_String,    -- 10 characters.
+                    Position => 1,
+                    New_Item => Source_String3,      -- 12 characters.
+                    Drop     => Ada.Strings.Left);
+
+      if Overwrite_String /= "cdefghijkl" then
+         Report.Failed("Incorrect result from Overwrite with Drop=Left");
+      end if;
+
+      -- The default drop value is Right, used here.
+
+      ASF.Overwrite(Source   => Overwrite_String,    -- 10 characters.
+                    Position => 1,
+                    New_Item => Source_String3);     -- 12 characters.
+
+      if Overwrite_String /= "abcdefghij" then
+         Report.Failed("Incorrect result from Overwrite with Drop=Right");
+      end if;
+
+      -- Drop = Error
+
+      begin
+         ASF.Overwrite(Source   => Overwrite_String,    -- 10 characters.
+                       Position => 1,
+                       New_Item => Source_String3,      -- 12 characters.
+                       Drop     => Ada.Strings.Error);
+         Report.Failed("Exception not raised by Procedure Overwrite");
+      exception
+         when Ada.Strings.Length_Error => null; -- OK, expected exception.
+         when others                   =>
+            Report.Failed
+              ("Incorrect exception raised by Procedure Overwrite");
+      end;
+
+      Overwrite_String := "ababababab";
+      ASF.Overwrite(Overwrite_String, Overwrite_String'Last, "z");
+      ASF.Overwrite(Overwrite_String, Overwrite_String'First,"z");
+      ASF.Overwrite(Overwrite_String, 5, "zz");
+
+      if Overwrite_String /= "zbabzzabaz" then
+         Report.Failed("Incorrect result from Procedure Overwrite");
+      end if;
+
+
+
+      -- Function Delete
+
+      TC_Set_Name ("Delete");
+
+      declare
+         New_String1 : constant String :=    -- This returns a 4 char string.
+           TC_Check (ASF.Delete(Source  => Source_String3,
+                                From    => 3,
+                                Through => 10));
+         New_String2 : constant String :=    -- This returns Source.
+           TC_Check (ASF.Delete(Source_String3, 10, 3));
+      begin
+           if New_String1 /= "abkl"  or
+              New_String2 /= Source_String3
+           then
+               Report.Failed("Incorrect result from Function Delete - 1");
+           end if;
+      end;
+
+      if TC_Check (ASF.Delete("a",   1, 1))
+                              /= ""    or     -- Source length = 1
+         TC_Check (ASF.Delete("abc", 1, 2))
+                              /= "c"   or     -- From = Source'First
+         TC_Check (ASF.Delete("abc", 3, 3))
+                              /= "ab"  or     -- From = Source'Last
+         TC_Check (ASF.Delete("abc", 3, 1))
+                              /= "abc"        -- From > Through
+      then
+         Report.Failed("Incorrect result from Function Delete - 2");
+      end if;
+
+
+
+      -- Procedure Delete
+
+      -- Justify = Left
+
+      Delete_String := Source_String3(1..10);  -- Initialize to "abcdefghij"
+
+      ASF.Delete(Source  => Delete_String,
+                 From    => 6,
+                 Through => Delete_String'Last,
+                 Justify => Ada.Strings.Left,
+                 Pad     => 'x');              -- pad with char 'x'
+
+      if Delete_String /= "abcdexxxxx" then
+          Report.Failed("Incorrect result from Delete - Justify = Left");
+      end if;
+
+      -- Justify = Right
+
+      ASF.Delete(Source  => Delete_String,      -- Remove x"s from end and
+                 From    => 6,                  -- shift right.
+                 Through => Delete_String'Last,
+                 Justify => Ada.Strings.Right,
+                 Pad     => 'x');               -- pad with char 'x' on left.
+
+      if Delete_String /= "xxxxxabcde" then
+          Report.Failed("Incorrect result from Delete - Justify = Right");
+      end if;
+
+      -- Justify = Center
+
+      ASF.Delete(Source  => Delete_String,
+                 From    => 1,
+                 Through => 5,
+                 Justify => Ada.Strings.Center,
+                 Pad     => 'z');
+
+      if Delete_String /= "zzabcdezzz" then  -- extra pad char on right side.
+          Report.Failed("Incorrect result from Delete - Justify = Center");
+      end if;
+
+
+
+      -- Function Trim
+      -- Use non-identity character sets to perform the trim operation.
+
+      TC_Set_Name ("Trim");
+
+      Trim_String := "cdabcdefcd";
+
+      -- Remove the "cd" from each end of the string.  This will not effect
+      -- the "cd" slice at 5..6.
+
+      declare
+         New_String : constant String :=
+           TC_Check (ASF.Trim(Source => Trim_String,
+                              Left => CD_Set, Right => CD_Set));
+      begin
+         if New_String /= Source_String2 then    -- string "abcdef"
+            Report.Failed("Incorrect result from Trim with character sets");
+         end if;
+      end;
+
+      if TC_Check (ASF.Trim("abcdef", Maps.Null_Set, Maps.Null_Set))
+             /= "abcdef" then
+         Report.Failed("Incorrect result from Trim with Null sets");
+      end if;
+
+      if TC_Check (ASF.Trim("cdxx", CD_Set, X_Set)) /= "" then
+         Report.Failed("Incorrect result from Trim, string removal");
+      end if;
+
+
+      -- Procedure Trim
+
+      -- Justify = Right
+
+      ASF.Trim(Source  => Trim_String,
+               Left    => CD_Set,
+               Right   => CD_Set,
+               Justify => Ada.Strings.Right,
+               Pad     => 'x');
+
+      if Trim_String /= "xxxxabcdef" then
+         Report.Failed("Incorrect result from Trim with Justify = Right");
+      end if;
+
+      -- Justify = Left
+
+      ASF.Trim(Source  => Trim_String,
+               Left    => X_Set,
+               Right   => Maps.Null_Set,
+               Justify => Ada.Strings.Left,
+               Pad     => Ada.Strings.Space);
+
+      if Trim_String /= "abcdef    " then  -- Padded with 4 blanks on right.
+         Report.Failed("Incorrect result from Trim with Justify = Left");
+      end if;
+
+      -- Justify = Center
+
+      ASF.Trim(Source  => Trim_String,
+               Left    => ABCD_Set,
+               Right   => CD_Set,
+               Justify => Ada.Strings.Center,
+               Pad     => 'x');
+
+      if Trim_String /= "xxef    xx" then  -- Padded with 2 pad chars on L/R
+         Report.Failed("Incorrect result from Trim with Justify = Center");
+      end if;
+
+
+
+      -- Function Head, demonstrating use of padding.
+
+      TC_Set_Name ("Head");
+
+      -- Use the characters of Source_String1 ("abcde") and pad the
+      -- last five characters of Result_String with 'x' characters.
+
+
+      Result_String := TC_CHeck (ASF.Head(Source_String1, 10, 'x'));
+
+      if Result_String /= "abcdexxxxx" then
+         Report.Failed("Incorrect result from Function Head with padding");
+      end if;
+
+      if TC_Check (ASF.Head("  ab  ", 2))        /= "  "     or
+         TC_Check (ASF.Head("a", 6, 'A'))        /= "aAAAAA" or
+         TC_Check (ASF.Head("abcdefgh", 3, 'x')) /= "abc"    or
+         TC_Check (ASF.Head(ASF.Head("abc  ", 7, 'x'), 10, 'X'))
+                   /= "abc  xxXXX"
+      then
+         Report.Failed("Incorrect result from Function Head");
+      end if;
+
+
+
+      -- Function Tail, demonstrating use of padding.
+
+      TC_Set_Name ("Tail");
+
+      -- Use the characters of Source_String1 ("abcde") and pad the
+      -- first five characters of Result_String with 'x' characters.
+
+      Result_String := TC_Check (ASF.Tail(Source_String1, 10, 'x'));
+
+      if Result_String /= "xxxxxabcde" then
+         Report.Failed("Incorrect result from Function Tail with padding");
+      end if;
+
+      if TC_Check (ASF.Tail("abcde  ", 5))
+                            /= "cde  "    or  -- blanks, back
+         TC_Check (ASF.Tail("  abc ",  8, ' '))
+                            /= "    abc " or  -- blanks, front/back
+         TC_Check (ASF.Tail("",        5, 'Z'))
+                            /= "ZZZZZ"    or  -- pad characters only
+         TC_Check (ASF.Tail("abc",     0))
+                            /= ""         or  -- null result
+         TC_Check (ASF.Tail("abcdefgh", 3))
+                            /= "fgh"      or
+         TC_Check (ASF.Tail(ASF.Tail(" abc ", 6, 'x'),
+                  10,
+                  'X'))              /= "XXXXx abc "
+      then
+         Report.Failed("Incorrect result from Function Tail");
+      end if;
+
+
+      -- Function "*"  - with (Natural, String) parameters
+
+      TC_Set_Name ("""*""");
+
+      if TC_Check (ASF."*"(3, Source_String1))       /= "abcdeabcdeabcde"  or
+         TC_Check (ASF."*"(2, Source_String2))       /= Source_String6     or
+         TC_Check (ASF."*"(4, Source_String1(1..2))) /= "abababab"         or
+         TC_Check (ASF."*"(0, Source_String1))       /= ""
+      then
+         Report.Failed("Incorrect result from Function ""*"" with strings");
+      end if;
+
+   exception
+      when others => Report.Failed("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4006.a
new file mode 100644
index 000000000..e1d7f46f5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4006.a
@@ -0,0 +1,319 @@
+-- CXA4006.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 subprograms defined in package Ada.Strings.Bounded are
+--      available, and that they produce correct results. Specifically, check 
+--      the subprograms Length, Slice, "&", To_Bounded_String, Append, Index, 
+--      To_String, Replace_Slice, Trim, Overwrite, Delete, Insert, and 
+--      Translate.
+--      
+-- TEST DESCRIPTION:
+--      This test demonstrates the uses of a variety of the string functions
+--      found in the package Ada.Strings.Bounded, simulating the operations
+--      found in a text processing package.  
+--      With bounded strings, the length of each "line" of text can vary up
+--      to the instantiated maximum, allowing one to view a page of text as
+--      a series of expandable lines.  This provides flexibility in text
+--      formatting of individual lines (strings).
+--      Several subprograms are defined, all of which attempt to take advantage
+--      of as many different bounded string utilities as possible.  Often, 
+--      an operation that is being performed in a subprogram using a certain
+--      bounded string utility could more efficiently be performed using a
+--      a different utility.  However, in the interest of including as broad
+--      coverage as possible, a mixture of utilities is invoked in this test.
+--      A simulated page of text is provided as a parameter to the test 
+--      defined subprograms, and the appropriate processing performed.  The
+--      processed page of text is then compared to a predefined "finished"
+--      page, and test passage/failure is based on the results of this 
+--      comparison.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Ada.Strings;
+with Ada.Strings.Bounded;
+with Ada.Strings.Maps;
+with Report;
+
+procedure CXA4006 is
+
+begin
+
+   Report.Test ("CXA4006", "Check that the subprograms defined in package "  &
+                           "Ada.Strings.Bounded are available, and that "    &
+                           "they produce correct results");
+
+   Test_Block:
+   declare
+
+      Characters_Per_Line : constant Positive := 40;
+      Lines_Per_Page      : constant Natural  :=  4;
+
+      package BS_40 is new 
+        Ada.Strings.Bounded.Generic_Bounded_Length(Characters_Per_Line);
+      use type BS_40.Bounded_String;
+
+      type Page_Type is array (1..Lines_Per_Page) of BS_40.Bounded_String;
+
+      -- Note: Misspellings below are intentional.
+
+      Line1 : BS_40.Bounded_String := 
+        BS_40.To_Bounded_String("ada is a progrraming language designed");
+      Line2 : BS_40.Bounded_String := 
+        BS_40.To_Bounded_String("to support the construction of long-");
+      Line3 : BS_40.Bounded_String := 
+        BS_40.To_Bounded_String("lived, highly reliabel software ");
+      Line4 : BS_40.Bounded_String := 
+        BS_40.To_Bounded_String("systems");
+
+      Page  : Page_Type := (1 => Line1, 2 => Line2, 3 => Line3, 4 => Line4);
+
+      Finished_Page : Page_Type :=  
+        (BS_40.To_Bounded_String("Ada is a programming language designed"),
+         BS_40.To_Bounded_String("to support the construction of long-"),
+         BS_40.To_Bounded_String("lived, HIGHLY RELIABLE software systems."),
+         BS_40.To_Bounded_String(""));
+
+      ---
+
+      procedure Compress (Page : in out Page_Type) is
+         Clear_Line : Natural := Lines_Per_Page;
+      begin
+         -- If two consecutive lines on the page are together less than the
+         -- maximum line length, then append those two lines, move up all
+         -- lower lines on the page, and blank out the last line.
+         for i in 1..Lines_Per_Page - 1 loop
+            if BS_40.Length(Page(i)) + BS_40.Length(Page(i+1)) <=
+               BS_40.Max_Length
+            then
+               Page(i) := BS_40."&"(Page(i), 
+                                    Page(i+1));       -- "&" (bounded, bounded)
+
+               for j in i+1..Lines_Per_Page - 1 loop
+                  Page(j) := 
+                    BS_40.To_Bounded_String
+                      (BS_40.Slice(Page(j+1), 
+                                   1, 
+                                   BS_40.Length(Page(j+1))));
+                  Clear_Line := j + 1;
+               end loop;
+               Page(Clear_Line) := BS_40.Null_Bounded_String;
+            end if;
+         end loop;
+      end Compress;
+
+      ---
+
+      procedure Format (Page : in out Page_Type) is
+         Sm_Ada   : BS_40.Bounded_String := BS_40.To_Bounded_String("ada");
+         Cap_Ada  : constant String      := "Ada";
+         Char_Pos : Natural := 0;
+         Finished : Boolean := False;
+         Line     : Natural := Page_Type'Last;
+      begin
+
+         -- Add a period to the end of the last line.
+         while Line >= Page_Type'First and not Finished loop
+            if Page(Line) /= BS_40.Null_Bounded_String      and
+               BS_40.Length(Page(Line)) <= BS_40.Max_Length
+            then
+               Page(Line) := BS_40.Append(Page(Line), '.');
+               Finished := True;
+            end if;
+            Line := Line - 1;
+         end loop;
+
+         -- Replace all occurrences of "ada" with "Ada".
+         for Line in Page_Type'First .. Page_Type'Last loop
+            Finished := False;
+            while not Finished loop
+               Char_Pos := BS_40.Index(Source  => Page(Line),
+                                       Pattern => BS_40.To_String(Sm_Ada),
+                                       Going   => Ada.Strings.Backward);
+               -- A zero is returned by function Index if no occurrences of
+               -- the pattern string are found.
+               Finished := (Char_Pos = 0);
+               if not Finished then
+                  BS_40.Replace_Slice
+                    (Source => Page(Line),
+                     Low    => Char_Pos,
+                     High   => Char_Pos + BS_40.Length(Sm_Ada) - 1,
+                     By     => Cap_Ada);
+               end if;
+            end loop;   -- while loop
+         end loop;      -- for loop
+
+      end Format;
+
+      ---
+
+      procedure Spell_Check (Page : in out Page_Type) is
+         type Spelling_Type is (Incorrect, Correct);
+         type Word_Array_Type is array (Spelling_Type) 
+           of BS_40.Bounded_String;
+         type Dictionary_Type is array (1..2) of Word_Array_Type;
+
+         -- Note that the "words" in the dictionary will require various
+         -- amounts of Trimming prior to their use in the string functions.
+         Dictionary : Dictionary_Type := 
+                      (1 => (BS_40.To_Bounded_String("  reliabel          "),  
+                             BS_40.To_Bounded_String("       reliable   ")),
+                       2 => (BS_40.To_Bounded_String("  progrraming  "),
+                             BS_40.To_Bounded_String(" programming ")));
+
+         Pos      : Natural := Natural'First;
+         Finished : Boolean := False;
+
+      begin
+
+         for Line in Page_Type'Range loop
+
+            -- Search for the first incorrectly spelled word in the Dictionary,
+            -- if it is found, replace it with the correctly spelled word,
+            -- using the Overwrite function.
+
+            while not Finished loop
+               Pos := 
+                 BS_40.Index(Page(Line),
+                             BS_40.To_String(
+                               BS_40.Trim(Dictionary(1)(Incorrect),
+                                          Ada.Strings.Both)),
+                             Ada.Strings.Forward);
+               Finished := (Pos = 0);
+               if not Finished then
+                  Page(Line) := 
+                    BS_40.Overwrite(Page(Line),
+                                    Pos,
+                                    BS_40.To_String
+                                      (BS_40.Trim(Dictionary(1)(Correct),
+                                                  Ada.Strings.Both)));
+               end if;
+            end loop;
+
+            Finished := False;
+
+            -- Search for the second incorrectly spelled word in the
+            -- Dictionary, if it is found, replace it with the correctly 
+            -- spelled word, using the Delete procedure and Insert function.
+
+            while not Finished loop
+               Pos := 
+                 BS_40.Index(Page(Line),
+                             BS_40.To_String(
+                               BS_40.Trim(Dictionary(2)(Incorrect),
+                                          Ada.Strings.Both)),
+                             Ada.Strings.Forward);
+
+               Finished := (Pos = 0);
+
+               if not Finished then
+                  BS_40.Delete
+                    (Page(Line),
+                     Pos,
+                     Pos + BS_40.To_String
+                             (BS_40.Trim(Dictionary(2)(Incorrect),
+                                         Ada.Strings.Both))'Length-1);
+                  Page(Line) := 
+                    BS_40.Insert(Page(Line),
+                                 Pos,
+                                 BS_40.To_String
+                                      (BS_40.Trim(Dictionary(2)(Correct),
+                                                  Ada.Strings.Both)));
+               end if;
+            end loop;
+
+            Finished := False;
+
+         end loop;
+      end Spell_Check;
+
+      ---
+
+      procedure Bold (Page : in out Page_Type) is
+         Key_Word     : constant String := "highly reliable";
+         Bold_Mapping : constant Ada.Strings.Maps.Character_Mapping :=
+           Ada.Strings.Maps.To_Mapping(From => " abcdefghijklmnopqrstuvwxyz",
+                                       To   => " ABCDEFGHIJKLMNOPQRSTUVWXYZ");
+         Pos      : Natural := Natural'First;
+         Finished : Boolean := False;
+      begin
+         -- This procedure is designed to change the case of the phrase
+         -- "highly reliable" into upper case (a type of "Bolding").
+         -- All instances of the phrase on all lines of the page will be
+         -- modified.
+
+         for Line in Page_Type'First .. Page_Type'Last loop
+            while not Finished loop
+               Pos := BS_40.Index(Page(Line), Key_Word);
+               Finished := (Pos = 0);
+               if not Finished then
+
+                  BS_40.Overwrite
+                         (Page(Line),
+                          Pos,
+                          BS_40.To_String
+                            (BS_40.Translate
+                               (BS_40.To_Bounded_String
+                                   (BS_40.Slice(Page(Line),
+                                                Pos,  
+                                                Pos + Key_Word'Length - 1)),
+                                Bold_Mapping)));
+
+               end if;
+            end loop;
+            Finished := False;
+         end loop;
+      end Bold;
+
+
+   begin
+
+      Compress(Page);
+      Format(Page); 
+      Spell_Check(Page);
+      Bold(Page);
+
+      for i in 1..Lines_Per_Page loop
+         if BS_40.To_String(Page(i)) /= BS_40.To_String(Finished_Page(i)) or
+            BS_40.Length(Page(i))    /= BS_40.Length(Finished_Page(i))
+         then
+            Report.Failed("Incorrect modification of Page, Line " &
+                           Integer'Image(i));
+         end if;
+      end loop;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4007.a
new file mode 100644
index 000000000..fca15d367
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4007.a
@@ -0,0 +1,334 @@
+-- CXA4007.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 subprograms defined in package Ada.Strings.Bounded are
+--      available, and that they produce correct results. Specifically, check 
+--      the subprograms Append, Count, Element, Find_Token, Head, 
+--      Index_Non_Blank, Replace_Element, Replicate, Tail, To_Bounded_String, 
+--      "&", ">", "<", ">=", "<=", and "*".
+--      
+-- TEST DESCRIPTION:
+--      This test, when taken in conjunction with tests CXA400[6,8,9], will 
+--      constitute a test of all the functionality contained in package
+--      Ada.Strings.Bounded.  This test uses a variety of the
+--      subprograms defined in the bounded string package in ways typical
+--      of common usage.  Different combinations of available subprograms
+--      are used to accomplish similar bounded string processing goals.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      22 Dec 94   SAIC    Changed obsolete constant to Ada.Strings.Space.
+--
+--!
+
+with Ada.Strings;
+with Ada.Strings.Bounded;
+with Ada.Strings.Maps;
+with Report;
+
+procedure CXA4007 is
+
+begin
+
+   Report.Test ("CXA4007", "Check that the subprograms defined in package " &
+                           "Ada.Strings.Bounded are available, and that "   &
+                           "they produce correct results");
+
+   Test_Block:
+   declare
+
+      package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80);
+      use type BS80.Bounded_String;
+
+      Part1 : constant String     := "Rum";
+      Part2 : Character           := 'p';
+      Part3 : BS80.Bounded_String := BS80.To_Bounded_String("el");
+      Part4 : Character           := 's';
+      Part5 : BS80.Bounded_String := BS80.To_Bounded_String("tilt");
+      Part6 : String(1..3)        := "ski";
+
+      Full_Catenate_String,
+      Full_Append_String,  
+      Constructed_String,   
+      Drop_String,
+      Replicated_String,     
+      Token_String         : BS80.Bounded_String;
+
+      CharA : Character := 'A';          
+      CharB : Character := 'B';
+      CharC : Character := 'C';   
+      CharD : Character := 'D';
+      CharE : Character := 'E';
+      CharF : Character := 'F';
+
+      ABStr : String(1..15) := "AAAAABBBBBBBBBB";
+      StrB  : String(1..2)  := "BB";
+      StrE  : String(1..2)  := "EE";
+
+
+   begin
+
+      -- Evaluation of the overloaded forms of the "&" operator defined
+      -- for instantiations of Bounded Strings.
+
+      Full_Catenate_String := 
+        BS80."&"(Part2,                            -- Char & Bnd Str
+                 BS80."&"(Part3,                   -- Bnd Str & Bnd Str
+                          BS80."&"(Part4,          -- Char & Bnd Str
+                                   BS80."&"(Part5, -- Bnd Str & Bnd Str
+                                           BS80.To_Bounded_String(Part6)))));  
+                                                 
+      Full_Catenate_String := 
+        Part1 &  Full_Catenate_String;             -- Str & Bnd Str
+      Full_Catenate_String := 
+        Full_Catenate_String & 'n';                -- Bnd Str & Char
+
+
+      -- Evaluation of the overloaded forms of function Append.
+
+      Full_Append_String := 
+        BS80.Append(Part2,                                      -- Char,Bnd
+               BS80.Append(Part3,                               -- Bnd, Bnd
+                      BS80.Append(Part4,                        -- Char,Bnd
+                             BS80.Append(BS80.To_String(Part5), -- Str,Bnd
+                                         BS80.To_Bounded_String(Part6)))));
+
+      Full_Append_String := 
+        BS80.Append(BS80.To_Bounded_String(Part1),            -- Bnd , Str
+                    BS80.To_String(Full_Append_String));
+
+      Full_Append_String := 
+        BS80.Append(Left  => Full_Append_String, 
+                    Right => 'n');                            -- Bnd, Char
+
+
+      -- Validate the resulting bounded strings.
+
+      if Full_Catenate_String < Full_Append_String or
+         Full_Catenate_String > Full_Append_String or
+         not (Full_Catenate_String  = Full_Append_String and
+              Full_Catenate_String <= Full_Append_String and
+              Full_Catenate_String >= Full_Append_String)
+      then
+         Report.Failed("Incorrect results from bounded string catenation" &
+                       " and comparison");
+      end if;
+
+
+      -- Evaluate the overloaded forms of the Constructor function "*" and 
+      -- the Replicate function.
+
+      Constructed_String := 
+        (2 * CharA) &                           -- "AA"
+        (2 * StrB)  &                           -- "AABBBB"
+        (3 * BS80."*"(2, CharC)) &              -- "AABBBBCCCCCC"
+        BS80.Replicate(3, 
+                   BS80.Replicate(2, CharD)) &  -- "AABBBBCCCCCCDDDDDD"
+        BS80.Replicate(2, StrE) &               -- "AABBBBCCCCCCDDDDDDEEEE"
+        BS80.Replicate(2, CharF);               -- "AABBBBCCCCCCDDDDDDEEEEFF"
+
+
+      -- Use of Function Replicate that involves dropping characters.  The
+      -- attempt to replicate the 15 character string six times will exceed
+      -- the 80 character bound of the string.  Therefore, the result should
+      -- be the catenation of 5 copies of the 15 character string, followed
+      -- by 5 'A' characters (the first five characters of the 6th
+      -- replication) with the remaining characters of the 6th replication 
+      -- dropped.
+
+      Drop_String := 
+         BS80.Replicate(Count => 6,                   
+                        Item  => ABStr,              -- "AAAAABBBBBBBBBB"
+                        Drop  => Ada.Strings.Right); 
+
+      if BS80.Element(Drop_String, 1)  /= 'A' or
+         BS80.Element(Drop_String, 6)  /= 'B' or
+         BS80.Element(Drop_String, 76) /= 'A' or
+         BS80.Element(Drop_String, 80) /= 'A' 
+      then
+         Report.Failed("Incorrect result from Replicate with Drop");
+      end if;
+
+
+      -- Use function Index_Non_Blank in the evaluation of the
+      -- Constructed_String.
+
+      if BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Forward)  /=
+         BS80.To_String(Constructed_String)'First                         or
+         BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Backward) /=
+         BS80.Length(Constructed_String)
+      then
+         Report.Failed("Incorrect results from constructor functions");
+      end if;
+
+
+
+      declare
+
+         -- Define character set objects for use with the Count function.
+         -- Constructed_String = "AABBBBCCCCCCDDDDDDEEEEFF" from above.
+
+         A_Set : Ada.Strings.Maps.Character_Set :=
+                 Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,1));
+         B_Set : Ada.Strings.Maps.Character_Set :=
+                 Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,3));
+         C_Set : Ada.Strings.Maps.Character_Set :=
+                 Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,7));
+         D_Set : Ada.Strings.Maps.Character_Set :=
+                 Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,13));
+         E_Set : Ada.Strings.Maps.Character_Set :=
+                 Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,19));
+         F_Set : Ada.Strings.Maps.Character_Set :=
+                 Ada.Strings.Maps.To_Set(BS80.Element(Constructed_String,23));
+
+
+         Start : Positive;
+         Stop  : Natural  := 0;
+
+      begin
+
+         -- Evaluate the results from function Count by comparing the number
+         -- of A's to the number of F's, B's to E's, and C's to D's in the
+         -- Constructed_String.  
+         -- There should be an equal number of each of the characters that 
+         -- are being compared (i.e., 2 A's and F's, 4 B's and E's, etc)
+
+         if BS80.Count(Constructed_String, A_Set)      /= 
+            BS80.Count(Constructed_String, F_Set)        or
+            BS80.Count(Constructed_String, B_Set)      /= 
+            BS80.Count(Constructed_String, E_Set)        or
+            not (BS80.Count(Constructed_String, C_Set)  =  
+                 BS80.Count(Constructed_String, D_Set))  
+         then
+            Report.Failed("Incorrect result from function Count");
+         end if;
+
+
+         -- Evaluate the functions Head, Tail, and Find_Token.
+         -- Create the Token_String from the Constructed_String above.
+
+         Token_String := 
+           BS80.Tail(BS80.Head(Constructed_String,  3), 2) &     -- "AB" &
+           BS80.Head(BS80.Tail(Constructed_String, 13), 2) &     -- "CD" &
+           BS80.Head(BS80.Tail(Constructed_String,  3), 2);      -- "EF"
+
+         if Token_String /= BS80.To_Bounded_String("ABCDEF") then
+            Report.Failed("Incorrect result from Catenation of Token_String");
+         end if;
+
+
+         -- Find the starting/ending position of the first A in the 
+         -- Token_String (both should be 1, only one A appears in string).
+         -- The Function Head uses the default pad character to return a
+         -- bounded string longer than its input parameter bounded string.
+
+         BS80.Find_Token(BS80.Head(Token_String, 10),  -- Default pad.
+                         A_Set,
+                         Ada.Strings.Inside,
+                         Start,
+                         Stop);
+
+         if Start /= 1 and Stop /= 1 then
+            Report.Failed("Incorrect result from Find_Token - 1");
+         end if;
+
+
+         -- Find the starting/ending position of the first non-AB slice in
+         -- the "head" five characters of Token_String (slice CDE at 
+         -- positions 3-5)
+
+         BS80.Find_Token(BS80.Head(Token_String, 5),            -- "ABCDE"
+                         Ada.Strings.Maps."OR"(A_Set, B_Set),   -- Set (AB)
+                         Ada.Strings.Outside,
+                         Start,
+                         Stop);
+
+         if Start /= 3 and Stop /= 5 then
+            Report.Failed("Incorrect result from Find_Token - 2");
+         end if;
+
+
+         -- Find the starting/ending position of the first CD slice in
+         -- the "tail" eight characters (including two pad characters) 
+         -- of Token_String (slice CD at positions 5-6 of the tail 
+         -- portion specified)
+
+         BS80.Find_Token(BS80.Tail(Token_String, 8, 
+                                   Ada.Strings.Space),         -- "  ABCDEF"
+                         Ada.Strings.Maps."OR"(C_Set, D_Set),  -- Set (CD)
+                         Ada.Strings.Inside,
+                         Start,
+                         Stop);
+
+         if Start /= 5 and Stop /= 6 then
+            Report.Failed("Incorrect result from Find_Token - 3");
+         end if;
+
+
+         -- Evaluate the Replace_Element procedure.
+
+         -- Token_String = "ABCDEF"
+
+         BS80.Replace_Element(Token_String, 3, BS80.Element(Token_String,4));
+
+         -- Token_String = "ABDDEF"
+
+         BS80.Replace_Element(Source => Token_String,
+                              Index  => 2,
+                              By     => BS80.Element(Token_String, 5));
+
+         -- Token_String = "AEDDEF"
+
+         BS80.Replace_Element(Token_String, 
+                              1, 
+                              BS80.Element(BS80.Tail(Token_String, 2), 2));
+
+         -- Token_String = "FEDDEF"
+         -- Evaluate this result.
+
+         if BS80.Element(Token_String, BS80.To_String(Token_String)'First) /=
+            BS80.Element(Token_String, BS80.To_String(Token_String)'Last)  or
+            BS80.Count(Token_String, D_Set)                                /=
+            BS80.Count(Token_String, E_Set)                                or
+            BS80.Index_Non_Blank(BS80.Head(Token_String,6))                /=
+            BS80.Index_Non_Blank(BS80.Tail(Token_String,6))                or
+            BS80.Head(Token_String, 1)                                     /=
+            BS80.Tail(Token_String, 1)
+         then
+            Report.Failed("Incorrect result from operations in combination");
+         end if;
+
+      end;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4008.a
new file mode 100644
index 000000000..629305f76
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4008.a
@@ -0,0 +1,662 @@
+-- CXA4008.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 subprograms defined in package Ada.Strings.Bounded are
+--      available, and that they produce correct results, especially under
+--      conditions where truncation of the result is required.  Specifically, 
+--      check the subprograms Append, Count with non-Identity maps, Index with 
+--      non-Identity maps, Index with Set parameters, Insert (function and
+--      procedure), Replace_Slice (function and procedure), To_Bounded_String, 
+--      and Translate.
+--
+-- TEST DESCRIPTION:
+--      This test, in conjunction with tests CXA4006, CXA4007, and CXA4009, 
+--      will provide coverage of the most common usages of the functionality
+--      found in the Ada.Strings.Bounded package.  It deals in large part
+--      with truncation effects and options.  This test contains many small, 
+--      specific test cases, situations that are often difficult to generate 
+--      in large numbers in an application-based test.  These cases represent 
+--      specific usage paradigms in-the-small.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Apr 95   SAIC    Corrected acceptance condition of subtest for
+--                          Function Append with Truncation = Left.
+--      31 Oct 95   SAIC    Update and repair for ACVC 2.0.1.
+--
+--!
+
+with Report;
+with Ada.Strings.Maps.Constants;
+with Ada.Strings.Bounded;
+with Ada.Strings.Maps;
+
+procedure CXA4008 is
+
+begin
+
+   Report.Test("CXA4008", "Check that the subprograms defined in "      &
+                          "package Ada.Strings.Bounded are available, " &
+                          "and that they produce correct results, "     &
+                          "especially under conditions where "          &
+                          "truncation of the result is required");
+
+   Test_Block:
+   declare
+
+      package AS   renames Ada.Strings;
+      package ASB  renames Ada.Strings.Bounded;
+      package ASC  renames Ada.Strings.Maps.Constants;
+      package Maps renames Ada.Strings.Maps;
+
+      package B10 is new ASB.Generic_Bounded_Length(Max => 10);
+      use type B10.Bounded_String;
+
+      Result_String : B10.Bounded_String;
+      Test_String   : B10.Bounded_String;
+      AtoE_Bnd_Str  : B10.Bounded_String := B10.To_Bounded_String("abcde");
+      FtoJ_Bnd_Str  : B10.Bounded_String := B10.To_Bounded_String("fghij");
+      AtoJ_Bnd_Str  : B10.Bounded_String := 
+                        B10.To_Bounded_String("abcdefghij");
+
+      Location     : Natural := 0;
+      Total_Count  : Natural := 0;
+
+      CD_Set       : Maps.Character_Set := Maps.To_Set("cd"); 
+
+      AB_to_YZ_Map : Maps.Character_Mapping :=
+                       Maps.To_Mapping(From =>  "ab",  To => "yz");
+
+      CD_to_XY_Map : Maps.Character_Mapping :=
+                       Maps.To_Mapping(From =>  "cd",  To => "xy");
+
+
+   begin
+      -- Function To_Bounded_String with Truncation
+      -- Evaluate the function Append with parameters that will 
+      -- cause the truncation of the result.
+
+      -- Drop = Error (default case, Length_Error will be raised)
+
+      begin
+         Test_String := 
+           B10.To_Bounded_String("Much too long for this bounded string");
+         Report.Failed("Length Error not raised by To_Bounded_String");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          =>
+           Report.Failed("Incorrect exception raised by To_Bounded_String");
+      end;
+
+      -- Drop = Left 
+
+      Test_String := B10.To_Bounded_String(Source => "abcdefghijklmn",
+                                           Drop   => Ada.Strings.Left);
+
+      if Test_String /= B10.To_Bounded_String("efghijklmn") then
+         Report.Failed
+           ("Incorrect result from To_Bounded_String, Drop = Left");
+      end if;
+
+      -- Drop = Right 
+
+      Test_String := B10.To_Bounded_String(Source => "abcdefghijklmn",
+                                           Drop   => Ada.Strings.Right);
+
+      if not(Test_String = AtoJ_Bnd_Str) then
+         Report.Failed
+           ("Incorrect result from To_Bounded_String, Drop = Right");
+      end if;
+
+
+
+
+      -- Function Append with Truncation
+      -- Evaluate the function Append with parameters that will 
+      -- cause the truncation of the result.
+
+      -- Drop = Error (default case, Length_Error will be raised)
+
+      begin
+         -- Append (Bnd Str, Bnd Str);
+         Result_String := 
+           B10.Append(B10.To_Bounded_String("abcde"),
+                      B10.To_Bounded_String("fghijk")); -- 11 char
+         Report.Failed("Length_Error not raised by Append - 1");
+      exception
+         when AS.Length_Error => null;   -- OK, correct exception raised.
+         when others          =>
+            Report.Failed("Incorrect exception raised by Append - 1");
+      end;
+
+      begin
+         -- Append (Str, Bnd Str);
+         Result_String := B10.Append(B10.To_String(AtoE_Bnd_Str),
+                                     B10.To_Bounded_String("fghijk"),
+                                     AS.Error); 
+         Report.Failed("Length_Error not raised by Append - 2");
+      exception
+         when AS.Length_Error => null;   -- OK, correct exception raised.
+         when others          =>
+            Report.Failed("Incorrect exception raised by Append - 2");
+      end;
+
+      begin
+         -- Append (Bnd Str, Char);
+         Result_String := 
+           B10.Append(B10.To_Bounded_String("abcdefghij"), 'k');
+         Report.Failed("Length_Error not raised by Append - 3");
+      exception
+         when AS.Length_Error => null;   -- OK, correct exception raised.
+         when others          =>
+            Report.Failed("Incorrect exception raised by Append - 3");
+      end;
+
+      -- Drop = Left 
+
+      -- Append (Bnd Str, Bnd Str)
+      Result_String := B10.Append(B10.To_Bounded_String("abcdefgh"), -- 8 chs
+                                  B10.To_Bounded_String("ijklmn"),   -- 6 chs
+                                  Ada.Strings.Left);
+
+      if Result_String /= B10.To_Bounded_String("efghijklmn") then -- 10 chars
+         Report.Failed("Incorrect truncation performed by Append - 4");
+      end if;
+
+      -- Append (Bnd Str, Str)
+      Result_String := 
+        B10.Append(B10.To_Bounded_String("abcdefghij"), 
+                   "xyz",
+                   Ada.Strings.Left);
+
+      if Result_String /= B10.To_Bounded_String("defghijxyz") then
+         Report.Failed("Incorrect truncation performed by Append - 5");
+      end if;
+
+      -- Append (Char, Bnd Str)
+
+      Result_String := B10.Append('A', 
+                                  B10.To_Bounded_String("abcdefghij"),
+                                  Ada.Strings.Left);
+
+      if Result_String /= B10.To_Bounded_String("abcdefghij") then
+         Report.Failed("Incorrect truncation performed by Append - 6");
+      end if;
+
+      -- Drop = Right 
+
+      -- Append (Bnd Str, Bnd Str)
+      Result_String := B10.Append(FtoJ_Bnd_Str, 
+                                  AtoJ_Bnd_Str,
+                                  Ada.Strings.Right);
+
+      if Result_String /= B10.To_Bounded_String("fghijabcde") then
+         Report.Failed("Incorrect truncation performed by Append - 7");
+      end if;
+
+      -- Append (Str, Bnd Str)
+      Result_String := B10.Append(B10.To_String(AtoE_Bnd_Str), 
+                                  AtoJ_Bnd_Str,
+                                  Ada.Strings.Right);
+
+      if Result_String /= B10.To_Bounded_String("abcdeabcde") then
+         Report.Failed("Incorrect truncation performed by Append - 8");
+      end if;
+
+      -- Append (Char, Bnd Str)
+      Result_String := B10.Append('A', AtoJ_Bnd_Str, Ada.Strings.Right);
+
+      if Result_String /= B10.To_Bounded_String("Aabcdefghi") then
+         Report.Failed("Incorrect truncation performed by Append - 9");
+      end if;
+
+
+      -- Function Index with non-Identity map.
+      -- Evaluate the function Index with a non-identity map 
+      -- parameter which will cause mapping of the source parameter 
+      -- prior to the evaluation of the index position search.
+
+      Location := B10.Index(Source  => AtoJ_Bnd_Str,   -- "abcdefghij"
+                            Pattern => "xy",
+                            Going   => Ada.Strings.Forward,
+                            Mapping => CD_to_XY_Map);  -- change "cd" to "xy"
+
+      if Location /= 3 then
+         Report.Failed("Incorrect result from Index, non-Identity map - 1");
+      end if;
+
+      Location := B10.Index(B10.To_Bounded_String("AND IF MAN"),
+                            "an",
+                            Ada.Strings.Backward,
+                            ASC.Lower_Case_Map); 
+
+      if Location /= 9 then
+         Report.Failed("Incorrect result from Index, non-Identity map - 2");
+      end if;
+
+      Location := B10.Index(Source  => B10.To_Bounded_String("The the"),
+                            Pattern => "the",
+                            Going   => Ada.Strings.Forward,
+                            Mapping => ASC.Lower_Case_Map); 
+
+      if Location /= 1 then
+         Report.Failed("Incorrect result from Index, non-Identity map - 3");
+      end if;
+
+
+      if B10.Index(B10.To_Bounded_String("abcd"),        -- Pattern = Source
+                   "abcd")                       /= 1 or
+         B10.Index(B10.To_Bounded_String("abc"),         -- Pattern < Source
+                   "abcd")                       /= 0 or
+         B10.Index(B10.Null_Bounded_String,              -- Source = Null
+                   "abc")                        /= 0 
+      then
+         Report.Failed("Incorrect result from Index with string patterns");
+      end if;
+
+
+      -- Function Index (for Sets).
+      -- This version of Index uses Sets as the basis of the search.
+
+      -- Test = Inside, Going = Forward  (Default case).
+      Location := 
+        B10.Index(Source => B10.To_Bounded_String("abcdeabcde"),
+                  Set    => CD_Set,  -- set containing 'c' and 'd'
+                  Test   => Ada.Strings.Inside,
+                  Going  => Ada.Strings.Forward);
+
+      if not (Location = 3) then     -- position of first 'c' in source.
+         Report.Failed("Incorrect result from Index using Sets - 1");
+      end if;
+
+      -- Test = Inside, Going = Backward.
+      Location := 
+        B10.Index(Source => B10."&"(AtoE_Bnd_Str, AtoE_Bnd_Str), 
+                  Set    => CD_Set,  -- set containing 'c' and 'd'
+                  Test   => Ada.Strings.Inside,
+                  Going  => Ada.Strings.Backward);
+
+      if not (Location = 9) then   -- position of last 'd' in source.
+         Report.Failed("Incorrect result from Index using Sets - 2");
+      end if;
+
+      -- Test = Outside, Going = Forward.
+      Location := B10.Index(B10.To_Bounded_String("deddacd"),  
+                            CD_Set,
+                            Test  => Ada.Strings.Outside,
+                            Going => Ada.Strings.Forward);
+
+      if Location /= 2  then  -- position of 'e' in source.
+         Report.Failed("Incorrect result from Index using Sets - 3");
+      end if;
+
+      -- Test = Outside, Going = Backward.
+      Location := B10.Index(B10.To_Bounded_String("deddacd"),
+                            CD_Set,
+                            Ada.Strings.Outside,
+                            Ada.Strings.Backward);
+
+      if Location /= 5 then                      -- correct position of 'a'.
+         Report.Failed("Incorrect result from Index using Sets - 4");
+      end if;
+
+      if B10.Index(B10.To_Bounded_String("cd"),        -- Source = Set
+                   CD_Set)                     /= 1 or
+         B10.Index(B10.To_Bounded_String("c"),         -- Source < Set
+                   CD_Set)                     /= 1 or
+         B10.Index(B10.Null_Bounded_String,            -- Source = Null
+                   CD_Set)                     /= 0 or
+         B10.Index(AtoE_Bnd_Str,                       -- "abcde"
+                   Maps.Null_Set)              /= 0 or -- Null set
+         B10.Index(AtoE_Bnd_Str,
+                   Maps.To_Set('x'))           /= 0    -- No match.
+      then
+         Report.Failed("Incorrect result from Index using Sets - 5");
+      end if;
+
+
+      -- Function Count with non-Identity mapping.
+      -- Evaluate the function Count with a non-identity map 
+      -- parameter which will cause mapping of the source parameter 
+      -- prior to the evaluation of the number of matching patterns.
+
+      Total_Count := 
+        B10.Count(Source  => B10.To_Bounded_String("abbabaabab"),
+                  Pattern => "yz",
+                  Mapping => AB_to_YZ_Map);
+
+      if Total_Count /= 4 then                                                 
+         Report.Failed
+           ("Incorrect result from function Count, non-Identity map - 1");
+      end if;
+
+      -- And a few with identity maps as well.
+
+      if B10.Count(B10.To_Bounded_String("ABABABABAB"),
+                   "ABA",
+                   Maps.Identity)                       /= 2 or
+         B10.Count(B10.To_Bounded_String("ADCBADABCD"),
+                   "AB",
+                   Maps.To_Mapping("CD", "AB"))         /= 5 or
+         B10.Count(B10.To_Bounded_String("aaaaaaaaaa"),
+                   "aaa")                               /= 3 or
+         B10.Count(B10.To_Bounded_String("XX"),         -- Source < Pattern
+                   "XXX",
+                   Maps.Identity)                       /= 0 or
+         B10.Count(AtoE_Bnd_Str,                        -- Source = Pattern
+                   "abcde")                             /= 1 or
+         B10.Count(B10.Null_Bounded_String,             -- Source = Null
+                   " ")                                 /= 0
+      then
+         Report.Failed
+           ("Incorrect result from function Count, w,w/o mapping");
+      end if;
+                                         
+
+      -- Procedure Translate
+
+      -- Partial mapping of source.
+
+      Test_String := B10.To_Bounded_String("abcdeabcab");
+
+      B10.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
+
+      if Test_String /= B10.To_Bounded_String("yzcdeyzcyz") then
+         Report.Failed("Incorrect result from procedure Translate - 1");
+      end if;
+
+      -- Total mapping of source.
+
+      Test_String := B10.To_Bounded_String("abbaaababb");
+
+      B10.Translate(Source => Test_String, Mapping => ASC.Upper_Case_Map);
+
+      if Test_String /= B10.To_Bounded_String("ABBAAABABB") then
+         Report.Failed("Incorrect result from procedure Translate - 2");
+      end if;
+
+      -- No mapping of source.
+
+      Test_String := B10.To_Bounded_String("xyzsypcc");
+
+      B10.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
+
+      if Test_String /= B10.To_Bounded_String("xyzsypcc") then
+         Report.Failed("Incorrect result from procedure Translate - 3");
+      end if;
+
+      -- Map > 2 characters, partial mapping.
+
+      Test_String := B10.To_Bounded_String("have faith");
+
+      B10.Translate(Test_String, 
+                    Maps.To_Mapping("aeiou", "AEIOU"));
+
+      if Test_String /= B10.To_Bounded_String("hAvE fAIth") then
+         Report.Failed("Incorrect result from procedure Translate - 4");
+      end if;
+
+
+      -- Function Replace_Slice
+      -- Evaluate function Replace_Slice with 
+      -- a variety of Truncation options.
+
+      -- Drop = Error (Default)
+
+      begin
+         Test_String   := AtoJ_Bnd_Str;
+         Result_String := 
+           B10.Replace_Slice(Source => Test_String,  -- "abcdefghij"
+                             Low    => 3,
+                             High   => 5,            -- 3-5, 3 chars.
+                             By     => "xxxxxx");    -- more than 3.
+         Report.Failed("Length_Error not raised by Function Replace_Slice");
+      exception
+         when AS.Length_Error => null;   -- Correct exception raised.
+         when others          =>
+            Report.Failed
+              ("Incorrect exception raised by Function Replace_Slice");
+      end;
+
+      -- Drop = Left                                                          
+
+      Result_String := 
+        B10.Replace_Slice(Source => Test_String,  -- "abcdefghij"
+                          Low    =>  7,
+                          High   => 10,           -- 7-10, 4 chars.
+                          By     => "xxxxxx",     --  6 chars.
+                          Drop   => Ada.Strings.Left);
+
+      if Result_String /= B10.To_Bounded_String("cdefxxxxxx") then -- drop a,b
+         Report.Failed
+           ("Incorrect result from Function Replace Slice, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Result_String := 
+        B10.Replace_Slice(Source => Test_String, -- "abcdefghij"
+                          Low    =>  2,
+                          High   =>  5,          -- 2-5, 4 chars.
+                          By     => "xxxxxx",    --  6 chars.
+                          Drop   => Ada.Strings.Right);
+
+      if Result_String /= B10.To_Bounded_String("axxxxxxfgh") then -- drop i,j
+         Report.Failed
+           ("Incorrect result from Function Replace Slice, Drop = Right");
+      end if;
+
+      -- Low = High = Source'Last, "By" length = 1.
+
+      if B10.Replace_Slice(AtoE_Bnd_Str,
+                           B10.To_String(AtoE_Bnd_Str)'Last,
+                           B10.To_String(AtoE_Bnd_Str)'Last,
+                           "X",
+                           Ada.Strings.Error)  /=
+         B10.To_Bounded_String("abcdX")
+      then
+         Report.Failed("Incorrect result from Function Replace_Slice");
+      end if;
+
+
+
+      -- Procedure Replace_Slice
+      -- Evaluate procedure Replace_Slice with 
+      -- a variety of Truncation options.
+
+      -- Drop = Error (Default)
+
+      begin
+         Test_String := AtoJ_Bnd_Str;
+         B10.Replace_Slice(Source => Test_String,  -- "abcdefghij"
+                           Low    => 3,
+                           High   => 5,            -- 3-5, 3 chars.
+                           By     => "xxxxxx");    -- more than 3.
+         Report.Failed("Length_Error not raised by Procedure Replace_Slice");
+      exception
+         when AS.Length_Error => null;   -- Correct exception raised.
+         when others          =>
+            Report.Failed
+              ("Incorrect exception raised by Procedure Replace_Slice");
+      end;
+
+      -- Drop = Left                                                          
+
+      Test_String := AtoJ_Bnd_Str;
+      B10.Replace_Slice(Source => Test_String,  -- "abcdefghij"
+                        Low    =>  7,
+                        High   =>  9,           -- 7-9, 3 chars.
+                        By     => "xxxxx",      --  5 chars.
+                        Drop   => Ada.Strings.Left);
+
+      if Test_String /= B10.To_Bounded_String("cdefxxxxxj") then -- drop a,b
+         Report.Failed
+           ("Incorrect result from Procedure Replace Slice, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Test_String := AtoJ_Bnd_Str;
+      B10.Replace_Slice(Source => Test_String,  -- "abcdefghij"
+                        Low    =>  1,
+                        High   =>  3,           -- 1-3, 3chars.
+                        By     => "xxxx",       --  4 chars.
+                        Drop   => Ada.Strings.Right);
+
+      if Test_String /= B10.To_Bounded_String("xxxxdefghi") then  -- drop j
+         Report.Failed
+           ("Incorrect result from Procedure Replace Slice, Drop = Right");
+      end if;
+
+      -- High = Source'First, Low > High (Insert before Low).
+
+      Test_String := AtoE_Bnd_Str;
+      B10.Replace_Slice(Source => Test_String,  -- "abcde"
+                        Low    => B10.To_String(Test_String)'Last,
+                        High   => B10.To_String(Test_String)'First,
+                        By     => "XXXX",       --  4 chars.
+                        Drop   => Ada.Strings.Right);
+
+      if Test_String /= B10.To_Bounded_String("abcdXXXXe") then 
+         Report.Failed
+           ("Incorrect result from Procedure Replace Slice");
+      end if;
+
+
+
+      -- Function Insert with Truncation
+      -- Drop = Error (Default).
+
+      begin
+         Result_String := 
+           B10.Insert(Source   => AtoJ_Bnd_Str,    -- "abcdefghij"
+                      Before   => 2,
+                      New_Item => "xyz");
+         Report.Failed("Length_Error not raised by Function Insert");
+      exception
+         when AS.Length_Error => null;  -- Correct exception raised.
+         when others          => 
+            Report.Failed("Incorrect exception raised by Function Insert");
+      end;
+
+      -- Drop = Left
+
+      Result_String :=
+        B10.Insert(Source   => AtoJ_Bnd_Str,      -- "abcdefghij"
+                   Before   => 5,
+                   New_Item => "xyz",             -- 3 additional chars.
+                   Drop     => Ada.Strings.Left);
+
+      if B10.To_String(Result_String) /= "dxyzefghij" then   -- drop a, b, c
+         Report.Failed("Incorrect result from Function Insert, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Result_String := 
+        B10.Insert(Source   => B10.To_Bounded_String("abcdef"),
+                   Before   => 2,
+                   New_Item => "vwxyz",             -- 5 additional chars.
+                   Drop     => Ada.Strings.Right);
+
+      if B10.To_String(Result_String) /= "avwxyzbcde" then     -- drop f.
+         Report.Failed("Incorrect result from Function Insert, Drop = Right");
+      end if;
+
+      -- Additional cases.
+
+      if B10.Insert(B10.To_Bounded_String("a"), 1, " B") /=   
+         B10.To_Bounded_String(" Ba")                       or
+         B10.Insert(B10.Null_Bounded_String, 1, "abcde") /=
+         AtoE_Bnd_Str                                       or
+         B10.Insert(B10.To_Bounded_String("ab"), 2, "")  /=
+         B10.To_Bounded_String("ab")
+      then
+         Report.Failed("Incorrect result from Function Insert");
+      end if;
+
+
+      -- Procedure Insert
+
+      -- Drop = Error (Default).
+      begin
+         Test_String := AtoJ_Bnd_Str;
+         B10.Insert(Source   => Test_String,    -- "abcdefghij"
+                    Before   => 9,
+                    New_Item => "wxyz",
+                    Drop     => Ada.Strings.Error);
+         Report.Failed("Length_Error not raised by Procedure Insert");
+      exception
+         when AS.Length_Error => null;  -- Correct exception raised.
+         when others          => 
+            Report.Failed("Incorrect exception raised by Procedure Insert");
+      end;
+
+      -- Drop = Left
+      
+      Test_String := AtoJ_Bnd_Str;
+      B10.Insert(Source   => Test_String,             -- "abcdefghij"
+                 Before   => B10.Length(Test_String), -- before last char
+                 New_Item => "xyz",                   -- 3 additional chars.
+                 Drop     => Ada.Strings.Left);
+
+      if B10.To_String(Test_String) /= "defghixyzj" then     -- drop a, b, c
+         Report.Failed("Incorrect result from Procedure Insert, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Test_String := AtoJ_Bnd_Str;
+      B10.Insert(Source   => Test_String,
+                 Before   => 4,
+                 New_Item => "yz",             -- 2 additional chars.
+                 Drop     => Ada.Strings.Right);
+
+      if B10.To_String(Test_String) /= "abcyzdefgh" then     -- drop i,j
+         Report.Failed
+           ("Incorrect result from Procedure Insert, Drop = Right");
+      end if;
+
+      -- Before = Source'First, New_Item length = 1.
+
+      Test_String := B10.To_Bounded_String(" abc ");
+      B10.Insert(Test_String, 
+                 B10.To_String(Test_String)'First,
+                 "Z");
+
+      if Test_String /= B10.To_Bounded_String("Z abc ") then
+         Report.Failed("Incorrect result from Procedure Insert");
+      end if;
+
+
+   exception
+      when others => Report.Failed("Exception raised in  Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4009.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4009.a
new file mode 100644
index 000000000..f02ef0365
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4009.a
@@ -0,0 +1,619 @@
+-- CXA4009.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 subprograms defined in package Ada.Strings.Bounded are
+--      available, and that they produce correct results, especially under
+--      conditions where truncation of the result is required.  Specifically, 
+--      check the subprograms Overwrite (function and procedure), Delete,
+--      Function Trim (blanks), Trim (Set characters, function and procedure),
+--      Head, Tail, and Replicate (characters and strings).
+--
+-- TEST DESCRIPTION:
+--      This test, in conjunction with tests CXA4006, CXA4007, and CXA4008, 
+--      will provide coverage of the most common usages of the functionality
+--      found in the Ada.Strings.Bounded package.  It deals in large part
+--      with truncation effects and options.  This test contains many small, 
+--      specific test cases, situations that are often difficult to generate 
+--      in large numbers in an application-based test.  These cases represent 
+--      specific usage paradigms in-the-small.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Apr 95   SAIC    Corrected errors in Procedure Overwrite subtests.
+--      01 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1.
+--
+--!
+
+with Report;
+with Ada.Strings.Bounded;
+with Ada.Strings.Maps;
+
+procedure CXA4009 is
+
+begin
+
+   Report.Test("CXA4009", "Check that the subprograms defined in "      &
+                          "package Ada.Strings.Bounded are available, " &
+                          "and that they produce correct results, "     &
+                          "especially under conditions where "          &
+                          "truncation of the result is required");
+
+   Test_Block:
+   declare
+
+      package AS   renames Ada.Strings;
+      package ASB  renames Ada.Strings.Bounded;
+      package Maps renames Ada.Strings.Maps;
+
+      package B10 is new ASB.Generic_Bounded_Length(Max => 10);
+      use type B10.Bounded_String;
+
+      Result_String : B10.Bounded_String;
+      Test_String   : B10.Bounded_String;
+      AtoE_Bnd_Str  : B10.Bounded_String := B10.To_Bounded_String("abcde");
+      FtoJ_Bnd_Str  : B10.Bounded_String := B10.To_Bounded_String("fghij");
+      AtoJ_Bnd_Str  : B10.Bounded_String := 
+                        B10.To_Bounded_String("abcdefghij");
+
+      Location     : Natural := 0;
+      Total_Count  : Natural := 0;
+
+      CD_Set       : Maps.Character_Set := Maps.To_Set("cd"); 
+      XY_Set       : Maps.Character_Set := Maps.To_Set("xy"); 
+
+
+   begin
+
+      -- Function Overwrite with Truncation                 
+      -- Drop = Error (Default).
+
+      begin
+         Test_String   := AtoJ_Bnd_Str;
+         Result_String := 
+           B10.Overwrite(Source   => Test_String, -- "abcdefghij"
+                         Position => 9,
+                         New_Item => "xyz",
+                         Drop     => AS.Error);
+         Report.Failed("Exception not raised by Function Overwrite");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+           Report.Failed("Incorrect exception raised by Function Overwrite");
+      end;
+
+      -- Drop = Left
+ 
+      Result_String :=
+        B10.Overwrite(Source   => Test_String,  -- "abcdefghij"
+                      Position => B10.Length(Test_String), -- 10
+                      New_Item => "xyz",
+                      Drop     => Ada.Strings.Left);
+
+      if B10.To_String(Result_String) /= "cdefghixyz" then   -- drop a,b
+         Report.Failed
+           ("Incorrect result from Function Overwrite, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Result_String := B10.Overwrite(Test_String,  -- "abcdefghij"
+                                     3,
+                                     "xxxyyyzzz",
+                                     Ada.Strings.Right);
+
+      if B10.To_String(Result_String) /= "abxxxyyyzz" then -- one 'z' dropped
+         Report.Failed
+           ("Incorrect result from Function Overwrite, Drop = Right");
+      end if;
+
+      -- Additional cases of function Overwrite.
+
+      if B10.Overwrite(B10.To_Bounded_String("a"),      -- Source length = 1
+                       1,
+                       "  abc  ")                 /= 
+         B10.To_Bounded_String("  abc  ")            or
+         B10.Overwrite(B10.Null_Bounded_String,         -- Null source
+                       1, 
+                       "abcdefghij")              /=
+         AtoJ_Bnd_Str                                or
+         B10.Overwrite(AtoE_Bnd_Str, 
+                       B10.To_String(AtoE_Bnd_Str)'First,
+                       " ")                       /=      -- New_Item = 1
+         B10.To_Bounded_String(" bcde")
+      then
+         Report.Failed("Incorrect result from Function Overwrite");
+      end if;
+
+
+
+      -- Procedure Overwrite                                 
+      -- Correct usage, no truncation.
+
+      Test_String := AtoE_Bnd_Str;   -- "abcde"
+      B10.Overwrite(Test_String, 2, "xyz");
+
+      if Test_String /= B10.To_Bounded_String("axyze") then
+         Report.Failed("Incorrect result from Procedure Overwrite - 1");
+      end if;
+
+      Test_String := B10.To_Bounded_String("abc");
+      B10.Overwrite(Test_String, 2, "");   -- New_Item is null string.
+
+      if Test_String /= B10.To_Bounded_String("abc") then
+         Report.Failed("Incorrect result from Procedure Overwrite - 2");
+      end if;
+
+      -- Drop = Error (Default).
+
+      begin
+         Test_String   := AtoJ_Bnd_Str;
+         B10.Overwrite(Source   => Test_String, -- "abcdefghij"
+                       Position => 8,
+                       New_Item => "uvwxyz");
+         Report.Failed("Exception not raised by Procedure Overwrite");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+           Report.Failed("Incorrect exception raised by Procedure Overwrite");
+      end;
+
+      -- Drop = Left
+ 
+      Test_String   := AtoJ_Bnd_Str;
+      B10.Overwrite(Source   => Test_String,  -- "abcdefghij"
+                    Position => B10.Length(Test_String) - 2, -- 8
+                    New_Item => "uvwxyz",
+                    Drop     => Ada.Strings.Left);
+
+      if B10.To_String(Test_String) /= "defguvwxyz" then   -- drop a-c
+         Report.Failed
+           ("Incorrect result from Procedure Overwrite, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Test_String   := AtoJ_Bnd_Str;
+      B10.Overwrite(Test_String,  -- "abcdefghij"
+                    3,
+                    "xxxyyyzzz",
+                    Ada.Strings.Right);
+
+      if B10.To_String(Test_String) /= "abxxxyyyzz" then -- one 'z' dropped
+         Report.Failed
+           ("Incorrect result from Procedure Overwrite, Drop = Right");
+      end if;
+
+
+
+      -- Function Delete                                     
+
+      if B10.Delete(Source  => AtoJ_Bnd_Str,   -- "abcdefghij"
+                    From    => 3,
+                    Through => 8)                               /=
+         B10."&"(B10.Head(AtoJ_Bnd_Str, 2), 
+                 B10.Tail(AtoJ_Bnd_Str, 2))                         or
+         B10.Delete(AtoJ_Bnd_Str, 6, B10.Length(AtoJ_Bnd_Str))  /=
+         AtoE_Bnd_Str                                               or
+         B10.Delete(AtoJ_Bnd_Str, 1, 5)                         /= 
+         FtoJ_Bnd_Str                                               or
+         B10.Delete(AtoE_Bnd_Str, 4, 5)                         /=
+         B10.Delete(AtoJ_Bnd_Str, 4, B10.Length(AtoJ_Bnd_Str)) 
+      then
+         Report.Failed("Incorrect result from Function Delete - 1");
+      end if;
+
+      if B10.Delete(B10.To_Bounded_String("a"), 1, 1)  /= 
+         B10.Null_Bounded_String                           or
+         B10.Delete(AtoE_Bnd_Str, 
+                    5, 
+                    B10.To_String(AtoE_Bnd_Str)'First) /=
+         AtoE_Bnd_Str                                      or
+         B10.Delete(AtoE_Bnd_Str,
+                    B10.To_String(AtoE_Bnd_Str)'Last,
+                    B10.To_String(AtoE_Bnd_Str)'Last)  /=
+         B10.To_Bounded_String("abcd")
+      then
+         Report.Failed("Incorrect result from Function Delete - 2");
+      end if;
+      
+
+
+      -- Function Trim                                       
+
+      declare
+
+         Text : B10.Bounded_String := B10.To_Bounded_String("Text");
+         type Bnd_Array_Type is array (1..5) of B10.Bounded_String;
+         Bnd_Array : Bnd_Array_Type :=
+           (B10.To_Bounded_String("  Text"),
+            B10.To_Bounded_String("Text    "),
+            B10.To_Bounded_String("   Text   "),
+            B10.To_Bounded_String("Text  Text"),   -- Ensure no inter-string
+            B10.To_Bounded_String(" Text Text"));  -- trimming of blanks.
+
+      begin
+
+         for i in Bnd_Array_Type'Range loop
+            case i is
+               when 4 =>
+                  if B10.Trim(Bnd_Array(i), AS.Both) /= 
+                     Bnd_Array(i) then  -- no change
+                     Report.Failed("Incorrect result from Function Trim - 4");
+                  end if;
+               when 5 =>
+                  if B10.Trim(Bnd_Array(i), AS.Both) /= 
+                     B10."&"(Text, B10."&"(' ', Text)) then
+                     Report.Failed("Incorrect result from Function Trim - 5");
+                  end if;
+               when others =>
+                  if B10.Trim(Bnd_Array(i), AS.Both) /= Text then
+                     Report.Failed("Incorrect result from Function Trim - " &
+                                    Integer'Image(i));
+                  end if;
+            end case;
+         end loop;
+
+      end;
+
+
+
+      -- Function Trim using Sets                            
+
+      -- Trim characters in sets from both sides of the bounded string.
+      if B10.Trim(Source => B10.To_Bounded_String("ddabbaxx"),
+                  Left   => CD_Set,
+                  Right  => XY_Set)  /=
+         B10.To_Bounded_String("abba")
+      then
+         Report.Failed
+           ("Incorrect result from Fn Trim - Sets, Left & Right side - 1");
+      end if;
+
+      -- Ensure that the characters in the set provided as the actual to
+      -- parameter Right are not trimmed from the left side of the bounded
+      -- string; likewise for the opposite side.  Only "cd" trimmed from left
+      -- side, and only "xy" trimmed from right side.
+
+      if B10.Trim(B10.To_Bounded_String("cdxyabcdxy"), CD_Set, XY_Set) /=
+         B10.To_Bounded_String("xyabcd")
+      then
+         Report.Failed
+           ("Incorrect result from Fn Trim - Sets, Left & Right side - 2");
+      end if;
+
+      -- Ensure that characters contained in the sets are not trimmed from
+      -- the "interior" of the bounded string, just the appropriate ends.
+
+      if B10.Trim(B10.To_Bounded_String("cdabdxabxy"), CD_Set, XY_Set) /=
+         B10.To_Bounded_String("abdxab")
+      then
+         Report.Failed
+           ("Incorrect result from Fn Trim - Sets, Left & Right side - 3");
+      end if;
+
+      -- Trim characters in set from right side only.  No change to Left side.
+
+      if B10.Trim(B10.To_Bounded_String("abxyzddcd"), XY_Set, CD_Set) /=
+         B10.To_Bounded_String("abxyz")
+      then
+         Report.Failed
+           ("Incorrect result from Fn Trim - Sets, Right side");
+      end if;
+
+      -- Trim no characters on either side of the bounded string.
+
+      Result_String := B10.Trim(AtoJ_Bnd_Str, CD_Set, XY_Set);
+      if Result_String /= AtoJ_Bnd_Str then
+         Report.Failed("Incorrect result from Fn Trim - Sets, Neither side");
+      end if;
+
+      if B10.Trim(AtoE_Bnd_Str, Maps.Null_Set, Maps.Null_Set) /=
+         AtoE_Bnd_Str                                            or
+         B10.Trim(B10.To_Bounded_String("dcddcxyyxx"),
+                  CD_Set,
+                  XY_Set)                                     /=
+         B10.Null_Bounded_String
+      then
+         Report.Failed("Incorrect result from Function Trim");
+      end if;
+
+
+
+      -- Procedure Trim using Sets                           
+
+      -- Trim characters in sets from both sides of the bounded string.
+
+      Test_String := B10.To_Bounded_String("dcabbayx");
+      B10.Trim(Source => Test_String,
+               Left   => CD_Set,
+               Right  => XY_Set);
+
+      if Test_String /= B10.To_Bounded_String("abba") then
+         Report.Failed
+           ("Incorrect result from Proc Trim - Sets, Left & Right side - 1");
+      end if;
+
+      -- Ensure that the characters in the set provided as the actual to
+      -- parameter Right are not trimmed from the left side of the bounded
+      -- string; likewise for the opposite side.  Only "cd" trimmed from left
+      -- side, and only "xy" trimmed from right side.
+
+      Test_String := B10.To_Bounded_String("cdxyabcdxy");
+      B10.Trim(Test_String, CD_Set, XY_Set);
+
+      if Test_String /= B10.To_Bounded_String("xyabcd") then
+         Report.Failed
+           ("Incorrect result from Proc Trim - Sets, Left & Right side - 2");
+      end if;
+
+      -- Ensure that characters contained in the sets are not trimmed from
+      -- the "interior" of the bounded string, just the appropriate ends.
+
+      Test_String := B10.To_Bounded_String("cdabdxabxy");
+      B10.Trim(Test_String, CD_Set, XY_Set);
+
+      if not (Test_String = B10.To_Bounded_String("abdxab")) then
+         Report.Failed
+           ("Incorrect result from Proc Trim - Sets, Left & Right side - 3");
+      end if;
+
+      -- Trim characters in set from Left side only.  No change to Right side.
+
+      Test_String := B10.To_Bounded_String("cccdabxyz");
+      B10.Trim(Test_String, CD_Set, XY_Set);
+
+      if Test_String /= B10.To_Bounded_String("abxyz") then
+         Report.Failed
+           ("Incorrect result from Proc Trim for Sets, Left side only");
+      end if;
+
+      -- Trim no characters on either side of the bounded string.
+
+      Test_String := AtoJ_Bnd_Str;
+      B10.Trim(Test_String, CD_Set, CD_Set);
+
+      if Test_String /= AtoJ_Bnd_Str then
+         Report.Failed("Incorrect result from Proc Trim-Sets, Neither side");
+      end if;
+
+
+
+      -- Function Head with Truncation                       
+      -- Drop = Error (Default).
+
+      begin
+         Result_String := B10.Head(Source => AtoJ_Bnd_Str,   -- max length
+                                   Count  => B10.Length(AtoJ_Bnd_Str) + 1,
+                                   Pad    => 'X');
+         Report.Failed("Length_Error not raised by Function Head");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+            Report.Failed("Incorrect exception raised by Function Head");
+      end;
+
+      -- Drop = Left
+
+      -- Pad characters (5) are appended to the right end of the string 
+      -- (which is initially at its maximum length), then the first five
+      -- characters of the intermediate result are dropped to conform to
+      -- the maximum size limit of the bounded string (10).
+
+      Result_String := B10.Head(B10.To_Bounded_String("ABCDEFGHIJ"),
+                                15,
+                                'x',
+                                Ada.Strings.Left);
+
+      if Result_String /= B10.To_Bounded_String("FGHIJxxxxx") then
+         Report.Failed("Incorrect result from Function Head, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      -- Pad characters (6) are appended to the left end of the string 
+      -- (which is initially at one less than its maximum length), then the 
+      -- last five characters of the intermediate result are dropped 
+      -- (which in this case are the pad characters) to conform to the 
+      -- maximum size limit of the bounded string (10).
+
+      Result_String := B10.Head(B10.To_Bounded_String("ABCDEFGHI"),
+                                15,
+                                'x',
+                                Ada.Strings.Right);
+
+      if Result_String /= B10.To_Bounded_String("ABCDEFGHIx") then
+         Report.Failed("Incorrect result from Function Head, Drop = Right");
+      end if;
+
+      -- Additional cases.
+
+      if B10.Head(B10.Null_Bounded_String, 5) /=
+         B10.To_Bounded_String("     ")          or
+         B10.Head(AtoE_Bnd_Str,
+                  B10.Length(AtoE_Bnd_Str))   /=
+         AtoE_Bnd_Str
+      then
+         Report.Failed("Incorrect result from Function Head");
+      end if;
+
+
+
+      -- Function Tail with Truncation                       
+      -- Drop = Error (Default Case)
+
+      begin
+         Result_String := B10.Tail(Source => AtoJ_Bnd_Str,   -- max length
+                                   Count  => B10.Length(AtoJ_Bnd_Str) + 1,
+                                   Pad    => Ada.Strings.Space,
+                                   Drop   => Ada.Strings.Error);
+         Report.Failed("Length_Error not raised by Function Tail");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+            Report.Failed("Incorrect exception raised by Function Tail");
+      end;
+
+      -- Drop = Left
+
+      -- Pad characters (5) are appended to the left end of the string 
+      -- (which is initially at two less than its maximum length), then 
+      -- the first three characters of the intermediate result (in this 
+      -- case, 3 pad characters) are dropped.
+
+      Result_String := B10.Tail(B10.To_Bounded_String("ABCDEFGH"), -- 8 ch
+                                13,
+                                'x',
+                                Ada.Strings.Left);
+
+      if Result_String /= B10.To_Bounded_String("xxABCDEFGH") then
+         Report.Failed("Incorrect result from Function Tail, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      -- Pad characters (3) are appended to the left end of the string 
+      -- (which is initially at its maximum length), then the last three
+      -- characters of the intermediate result are dropped.
+
+      Result_String := B10.Tail(B10.To_Bounded_String("ABCDEFGHIJ"),
+                                13,
+                                'x',
+                                Ada.Strings.Right);
+
+      if Result_String /= B10.To_Bounded_String("xxxABCDEFG") then
+         Report.Failed("Incorrect result from Function Tail, Drop = Right");
+      end if;
+
+      -- Additional cases.
+
+      if B10.Tail(B10.Null_Bounded_String, 3, ' ')    /=
+         B10.To_Bounded_String("   ")                    or
+         B10.Tail(AtoE_Bnd_Str, 
+                  B10.To_String(AtoE_Bnd_Str)'First)  /=
+         B10.To_Bounded_String("e")                      
+      then
+         Report.Failed("Incorrect result from Function Tail");
+      end if;
+
+
+
+      -- Function Replicate (#, Char) with Truncation        
+      -- Drop = Error (Default).
+
+      begin
+         Result_String := B10.Replicate(Count => B10.Max_Length + 5,
+                                        Item  => 'A',
+                                        Drop  => AS.Error);
+         Report.Failed
+           ("Length_Error not raised by Replicate for characters");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+           Report.Failed
+             ("Incorrect exception raised by Replicate for characters");
+      end;
+
+      -- Drop = Left, Right
+      -- Since this version of Replicate uses character parameters, the 
+      -- result after truncation from left or right will appear the same.
+      -- The result will be a 10 character bounded string, composed of 10
+      -- "Item" characters.
+
+      if B10.Replicate(Count => 20, Item => 'A', Drop => Ada.Strings.Left) /=
+         B10.Replicate(15, 'A', Ada.Strings.Right)
+      then
+         Report.Failed("Incorrect result from Replicate for characters - 1");
+      end if;
+
+      -- Blank-filled 10 character bounded strings.
+
+      if B10.Replicate(B10.Max_Length + 1, ' ', Drop => Ada.Strings.Left) /=
+         B10.Replicate(B10.Max_Length, Ada.Strings.Space)
+      then
+         Report.Failed("Incorrect result from Replicate for characters - 2");
+      end if;
+
+      -- Additional cases.
+
+      if B10.Replicate(0, 'a')  /= B10.Null_Bounded_String    or
+         B10.Replicate(1, 'a')  /= B10.To_Bounded_String("a")    
+      then
+         Report.Failed("Incorrect result from Replicate for characters - 3");
+      end if;
+
+
+
+      -- Function Replicate (#, String) with Truncation      
+      -- Drop = Error (Default).
+
+      begin
+         Result_String := B10.Replicate(Count => 5,  -- result would be 15.
+                                        Item  => "abc");
+         Report.Failed
+           ("Length_Error not raised by Replicate for strings");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+           Report.Failed
+             ("Incorrect exception raised by Replicate for strings");
+      end;
+
+      -- Drop = Left
+
+      Result_String := B10.Replicate(3, "abcd", Drop => Ada.Strings.Left);
+
+      if Result_String /= B10.To_Bounded_String("cdabcdabcd") then
+         Report.Failed
+           ("Incorrect result from Replicate for strings, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Result_String := B10.Replicate(3, "abcd", Drop => Ada.Strings.Right);
+
+      if Result_String /= B10.To_Bounded_String("abcdabcdab") then
+         Report.Failed
+           ("Incorrect result from Replicate for strings, Drop = Right");
+      end if;
+
+      -- Additional cases.
+      
+      if B10.Replicate(10, "X")  /= B10.To_Bounded_String("XXXXXXXXXX") or
+         B10.Replicate(10, "")   /= B10.Null_Bounded_String             or
+         B10.Replicate( 0, "ab") /= B10.Null_Bounded_String
+      then
+         Report.Failed("Incorrect result from Replicate for strings");
+      end if;
+
+
+   exception
+      when others => Report.Failed("Exception raised in  Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4009;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4010.a
new file mode 100644
index 000000000..8646b12b5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4010.a
@@ -0,0 +1,275 @@
+-- CXA4010.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 subprograms defined in package Ada.Strings.Unbounded
+--      are available, and that they produce correct results. Specifically, 
+--      check the subprograms To_String, To_Unbounded_String, Insert, "&", 
+--      "*", Length, Slice, Replace_Slice, Overwrite, Index, Index_Non_Blank,
+--      Head, Tail, and "=", "<=", ">=".
+--      
+-- TEST DESCRIPTION:
+--      This test demonstrates the uses of many of the subprograms defined
+--      in package Ada.Strings.Unbounded for use with unbounded strings.
+--      The test simulates how unbounded strings could be used
+--      to simulate paragraphs of text.  Modifications could be easily be
+--      performed using the provided subprograms (although in this test, the
+--      main modification performed was the addition of more text to the
+--      string).  One would not have to worry about the formatting of the 
+--      paragraph until it was finished and correct in content.  Then, once
+--      all required editing is complete, the unbounded strings can be divided
+--      up into the appropriate lengths based on particular formatting
+--      requirements.  The test then compares the formatted text product
+--      with a predefined "finished product".  
+--      
+--      This test uses a large number of the subprograms provided
+--      by package Ada.Strings.Unbounded.  Often, the processing involved
+--      could have been performed more efficiently using a minimum number
+--      of the subprograms, in conjunction with loops, etc.  However, for
+--      testing purposes, and in the interest of minimizing the number of
+--      tests developed, subprogram variety and feature mixing was stressed.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with Ada.Strings.Maps;
+with Ada.Strings.Unbounded;
+
+procedure CXA4010 is
+begin
+
+   Report.Test ("CXA4010", "Check that the subprograms defined in "        &
+                           "package Ada.Strings.Unbounded are available, " &
+                           "and that they produce correct results");
+
+   Test_Block:
+   declare
+
+      package ASUnb renames Ada.Strings.Unbounded;
+      use type ASUnb.Unbounded_String;
+      use Ada.Strings;
+
+      Pamphlet_Paragraph_Count : constant :=  2;
+      Lines                    : constant :=  4;
+      Line_Length              : constant := 40;
+
+      type Document_Type is array (Positive range <>) 
+        of ASUnb.Unbounded_String;
+
+      type Camera_Ready_Copy_Type is array (1..Lines) 
+        of String (1..Line_Length);
+
+      Pamphlet            : Document_Type (1..Pamphlet_Paragraph_Count);
+
+      Camera_Ready_Copy   : Camera_Ready_Copy_Type := 
+                              (others => (others => Ada.Strings.Space));
+
+      TC_Finished_Product : Camera_Ready_Copy_Type :=
+                          ( 1 => "Ada is a programming language designed  ",
+                            2 => "to support long-lived, reliable software",
+                            3 => " systems.                               ",
+                            4 => "Go with Ada!                            ");
+
+      -----
+
+
+      procedure Enter_Text_Into_Document (Document : in out Document_Type) is
+      begin
+
+         -- Fill in both "paragraphs" of the document.  Each unbounded string
+         -- functions as an individual paragraph, containing an unspecified
+         -- number of characters.
+         -- Use a variety of different unbounded string subprograms to load 
+         -- the data.
+
+         Document(1) := ASUnb.To_Unbounded_String("Ada is a language");
+
+         -- Insert the word "programming" prior to "language".
+         Document(1) := 
+           ASUnb.Insert(Document(1), 
+                        ASUnb.Index(Document(1),
+                                    "language"),
+                        ASUnb.To_String("progra" &           -- Str &
+                                        ASUnb."*"(2,'m') &   -- Unbd & 
+                                        "ing "));            -- Str
+
+
+         -- Overwrite the word "language" with "language" + additional text.
+         Document(1) :=
+           ASUnb.Overwrite(Document(1),
+                           ASUnb.Index(Document(1),
+                                       ASUnb.To_String(
+                                         ASUnb.Tail(Document(1), 8, ' ')),
+                                       Ada.Strings.Backward),
+                           "language designed to support long-lifed");
+
+
+         -- Replace the word "lifed" with "lived".
+         Document(1) :=
+           ASUnb.Replace_Slice(Document(1),
+                               ASUnb.Index(Document(1), "lifed"),
+                               ASUnb.Length(Document(1)),
+                               "lived");
+
+
+         -- Overwrite the word "lived" with "lived" + additional text.
+         Document(1) :=
+           ASUnb.Overwrite(Document(1),
+                           ASUnb.Index(Document(1),
+                                       ASUnb.To_String(
+                                         ASUnb.Tail(Document(1), 5, ' ')),
+                                       Ada.Strings.Backward),
+                               "lived, reliable software systems.");
+                              
+                              
+         -- Use several of the overloaded versions of "&" to form this
+         -- unbounded string.
+
+         Document(2) := 'G' &                               
+                        ASUnb.To_Unbounded_String("o ") & 
+                        ASUnb.To_Unbounded_String("with") &
+                        ' ' & 
+                        "Ada!";
+
+      end Enter_Text_Into_Document;
+
+
+      -----
+
+
+      procedure Create_Camera_Ready_Copy 
+                  (Document    : in     Document_Type;
+                   Camera_Copy :    out Camera_Ready_Copy_Type) is
+      begin
+         -- Break the unbounded strings into fixed lengths.
+
+         -- Search the first unbounded string for portions of text that
+         -- are less than or equal to the length of a string in the 
+         -- Camera_Ready_Copy_Type object.  
+
+         Camera_Copy(1) :=                 -- Take characters 1-39,
+           ASUnb.Slice(Document(1),        -- and append a blank space.
+                       1,
+                       ASUnb.Index(ASUnb.To_Unbounded_String(
+                                      ASUnb.Slice(Document(1),
+                                                  1,
+                                                  Line_Length)),
+                                   Ada.Strings.Maps.To_Set(' '),
+                                   Ada.Strings.Inside,
+                                   Ada.Strings.Backward)) & ' ';
+
+         Camera_Copy(2) :=                 -- Take characters 40-79.
+           ASUnb.Slice(Document(1),
+                       40,
+                       (ASUnb.Index_Non_Blank          -- Should return 79
+                          (ASUnb.To_Unbounded_String
+                             (ASUnb.Slice(Document(1), -- Slice (40..79)
+                                         40,
+                                         79)),
+                           Ada.Strings.Backward) + 39)); -- Increment since
+                                                         -- this slice starts
+                                                         -- at 40.
+
+         Camera_Copy(3)(1..9) := ASUnb.Slice(Document(1), -- Characters 80-88
+                                             80,
+                                             ASUnb.Length(Document(1))); 
+                                
+
+         -- Break the second unbounded string into the appropriate length.
+         -- It is only twelve characters in length, so the entire unbounded
+         -- string will be placed on one string of the output object.
+
+         Camera_Copy(4)(1..ASUnb.Length(Document(2))) :=
+           ASUnb.To_String(ASUnb.Head(Document(2),
+                                      ASUnb.Length(Document(2))));
+
+      end Create_Camera_Ready_Copy;
+
+
+      -----
+
+
+      function Valid_Proofread (Draft, Master : Camera_Ready_Copy_Type) 
+        return Boolean is
+      begin
+
+         -- Evaluate strings for equality, using the operators defined in
+         -- package Ada.Strings.Unbounded.  The less than/greater than or
+         -- equal comparisons should evaluate to "equals => True".
+
+         if ASUnb.To_Unbounded_String(Draft(1))   =       -- "="(Unb,Unb)
+            ASUnb.To_Unbounded_String(Master(1))   and    
+            ASUnb.To_Unbounded_String(Draft(2))  <=       -- "<="(Unb,Unb)
+            ASUnb.To_Unbounded_String(Master(2))   and
+            ASUnb.To_Unbounded_String(Draft(3))  >=       -- ">="(Unb,Unb)
+            ASUnb.To_Unbounded_String(Master(3))   and
+            ASUnb.To_Unbounded_String(Draft(4))   =       -- "="(Unb,Unb)
+            ASUnb.To_Unbounded_String(Master(4))
+         then
+            return True;
+         else
+            return False;
+         end if;
+
+      end Valid_Proofread;
+
+
+      -----
+
+
+   begin
+
+      -- Enter text into the unbounded string paragraphs of the document.
+
+      Enter_Text_Into_Document (Pamphlet);
+
+
+      -- Reformat the unbounded strings into fixed string format.
+
+      Create_Camera_Ready_Copy (Document    => Pamphlet,
+                                Camera_Copy => Camera_Ready_Copy);
+
+
+      -- Verify the conversion process.
+
+      if not Valid_Proofread (Draft  => Camera_Ready_Copy,
+                              Master => TC_Finished_Product)
+      then
+         Report.Failed ("Incorrect string processing result");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4011.a
new file mode 100644
index 000000000..05388a04b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4011.a
@@ -0,0 +1,376 @@
+-- CXA4011.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 subprograms defined in package Ada.Strings.Unbounded
+--      are available, and that they produce correct results. Specifically, 
+--      check the subprograms To_Unbounded_String, "&", ">", "<", Element, 
+--      Replace_Element, Count, Find_Token, Translate, Trim, Delete, and
+--      "*".
+--      
+-- TEST DESCRIPTION:
+--      This test demonstrates the uses of many of the subprograms defined
+--      in package Ada.Strings.Unbounded for use with unbounded strings.
+--      The test simulates how unbounded strings could be processed in a
+--      user environment, using the subprograms provided in this package.
+--
+--      This test uses a variety of the subprograms defined in the unbounded 
+--      string package in ways typical of common usage, with different 
+--      combinations of available subprograms being used to accomplish 
+--      similar unbounded string processing goals.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      27 Feb 95   SAIC    Test description modification.
+--      01 Nov 95   SAIC    Update and repair for ACVC 2.0.1.
+--
+--!
+
+with Report;
+with Ada.Strings.Maps;
+with Ada.Strings.Unbounded;
+
+procedure CXA4011 is
+begin
+
+   Report.Test ("CXA4011", "Check that the subprograms defined in "        &
+                           "package Ada.Strings.Unbounded are available, " &
+                           "and that they produce correct results");
+
+   Test_Block:
+   declare
+
+      package ASUnb renames Ada.Strings.Unbounded;
+      use Ada.Strings;
+      use type Maps.Character_Set;
+      use type ASUnb.Unbounded_String;
+
+      Cad_String        : ASUnb.Unbounded_String := 
+                            ASUnb.To_Unbounded_String("cad");
+
+      Complete_String   : ASUnb.Unbounded_String := 
+                            ASUnb.To_Unbounded_String("Incomplete") &
+                            Ada.Strings.Space &
+                            ASUnb.To_Unbounded_String("String");
+
+      Incomplete_String  : ASUnb.Unbounded_String :=
+                             ASUnb.To_Unbounded_String("ncomplete Strin");
+
+      Incorrect_Spelling : ASUnb.Unbounded_String :=
+                             ASUnb.To_Unbounded_String("Guob Dai");
+
+      Magic_String       : ASUnb.Unbounded_String :=
+                             ASUnb.To_Unbounded_String("abracadabra");
+
+      Incantation        : ASUnb.Unbounded_String := Magic_String;
+
+
+      A_Small_G : Character := 'g';
+      A_Small_D : Character := 'd';
+
+      ABCD_Set : Maps.Character_Set := Maps.To_Set("abcd");
+      B_Set    : Maps.Character_Set := Maps.To_Set('b');
+      AB_Set   : Maps.Character_Set := Maps."OR"(Maps.To_Set('a'), B_Set);
+
+      Code_Map         : Maps.Character_Mapping := 
+                           Maps.To_Mapping(From => "abcd", To => "wxyz");
+      Reverse_Code_Map : Maps.Character_Mapping :=
+                           Maps.To_Mapping(From => "wxyz", To => "abcd");
+      Non_Existent_Map : Maps.Character_Mapping :=
+                           Maps.To_Mapping(From => "jkl",  To => "mno");
+
+
+      Token_Start      : Positive;
+      Token_End        : Natural := 0;
+      Matching_Letters : Natural := 0;
+
+
+   begin
+
+      -- "&"
+
+      -- Prepend an 'I' and append a 'g' to the string.
+      Incomplete_String := ASUnb."&"('I', Incomplete_String);  -- Char & Unb
+      Incomplete_String := ASUnb."&"(Incomplete_String, 
+                                     A_Small_G);               -- Unb & Char
+
+      if Incomplete_String  < Complete_String  or
+         Incomplete_String  > Complete_String  or
+         Incomplete_String /= Complete_String
+      then
+         Report.Failed("Incorrect result from use of ""&"" operator");
+      end if;
+
+
+      -- Element
+
+      -- Last element of the unbounded string should be a 'g'.
+      if ASUnb.Element(Incomplete_String, ASUnb.Length(Incomplete_String)) /=
+         A_Small_G
+      then
+         Report.Failed("Incorrect result from use of Function Element - 1");
+      end if;
+
+      if ASUnb.Element(Incomplete_String, 2)                 /=
+         ASUnb.Element(ASUnb.Tail(Incomplete_String, 2), 1)     or
+         ASUnb.Element(ASUnb.Head(Incomplete_String, 4), 2)  /=
+         ASUnb.Element(ASUnb.To_Unbounded_String("wnqz"), 2)
+      then
+         Report.Failed("Incorrect result from use of Function Element - 2");
+      end if;
+    
+
+      -- Replace_Element
+
+      -- The unbounded string Incorrect_Spelling starts as "Guob Dai", and
+      -- is transformed by the following three procedure calls to "Good Day".
+
+      ASUnb.Replace_Element(Incorrect_Spelling, 2, 'o');
+
+      ASUnb.Replace_Element(Incorrect_Spelling, 
+                            ASUnb.Index(Incorrect_Spelling, B_Set),
+                            A_Small_D);
+
+      ASUnb.Replace_Element(Source => Incorrect_Spelling,
+                            Index  => ASUnb.Length(Incorrect_Spelling),
+                            By     => 'y');
+
+      if Incorrect_Spelling /= ASUnb.To_Unbounded_String("Good Day") then
+         Report.Failed("Incorrect result from Procedure Replace_Element");
+      end if;
+
+
+      -- Count
+
+      -- Determine the number of characters in the unbounded string that
+      -- are contained in the set.
+
+      Matching_Letters := ASUnb.Count(Source => Magic_String,
+                                      Set    => ABCD_Set);
+
+      if Matching_Letters /= 9 then
+         Report.Failed
+            ("Incorrect result from Function Count with Set parameter");
+      end if;
+
+      -- Determine the number of occurrences of the following pattern strings
+      -- in the unbounded string Magic_String.
+
+      if ASUnb.Count(Magic_String, "ab") /=
+         (ASUnb.Count(Magic_String, "ac") + ASUnb.Count(Magic_String, "ad")) or
+         ASUnb.Count(Magic_String, "ab") /= 2
+      then
+         Report.Failed
+            ("Incorrect result from Function Count with String parameter");
+      end if;
+
+
+      -- Find_Token
+
+      ASUnb.Find_Token(Magic_String,      -- Find location of first "ab".
+                       AB_Set,            -- Should be (1..2).
+                       Ada.Strings.Inside,
+                       Token_Start,
+                       Token_End);
+
+      if Natural(Token_Start) /= ASUnb.To_String(Magic_String)'First  or
+         Token_End            /= ASUnb.Index(Magic_String, B_Set)
+      then 
+         Report.Failed("Incorrect result from Procedure Find_Token - 1");
+      end if;
+
+
+      ASUnb.Find_Token(Source => Magic_String, -- Find location of char 'r'
+                       Set    => ABCD_Set,     -- in string, should be (3..3)
+                       Test   => Ada.Strings.Outside,
+                       First  => Token_Start,
+                       Last   => Token_End);
+
+      if Natural(Token_Start) /= 3 or
+         Token_End            /= 3 then
+         Report.Failed("Incorrect result from Procedure Find_Token - 2");
+      end if;
+
+
+      ASUnb.Find_Token(Magic_String,           -- No 'g' is in the string, so
+                       Maps.To_Set(A_Small_G), -- the result parameters should
+                       Ada.Strings.Inside,     -- be First = Source'First and
+                       First => Token_Start,   -- Last = 0.
+                       Last  => Token_End);
+
+      if Token_Start /= ASUnb.To_String(Magic_String)'First  or
+         Token_End   /= 0
+      then
+         Report.Failed("Incorrect result from Procedure Find_Token - 3");
+      end if;
+ 
+
+      -- Translate
+
+      -- Use a mapping ("abcd" -> "wxyz") to transform the contents of 
+      -- the unbounded string.
+      -- Magic_String = "abracadabra"
+
+      Incantation := ASUnb.Translate(Magic_String, Code_Map); 
+
+      if Incantation /= ASUnb.To_Unbounded_String("wxrwywzwxrw") then
+         Report.Failed("Incorrect result from Function Translate");
+      end if;
+
+      -- Use the inverse mapping of the one above to return the "translated"
+      -- unbounded string to its original form.
+
+      ASUnb.Translate(Incantation, Reverse_Code_Map);
+
+      -- The map contained in the following call to Translate contains one
+      -- element, and this element is not found in the unbounded string, so
+      -- this call to Translate should have no effect on the unbounded string.
+
+      if Incantation /= ASUnb.Translate(Magic_String, Non_Existent_Map) then
+         Report.Failed("Incorrect result from Procedure Translate");
+      end if;
+
+    
+      -- Trim
+
+      Trim_Block:
+      declare
+
+         XYZ_Set     : Maps.Character_Set := Maps.To_Set("xyz");
+         PQR_Set     : Maps.Character_Set := Maps.To_Set("pqr");
+
+         Pad         : constant ASUnb.Unbounded_String := 
+                                  ASUnb.To_Unbounded_String("Pad");
+
+         The_New_Ada : constant ASUnb.Unbounded_String :=
+                                  ASUnb.To_Unbounded_String("Ada9X");
+
+         Space_Array : array (1..4) of ASUnb.Unbounded_String :=
+                         (ASUnb.To_Unbounded_String("  Pad    "),
+                          ASUnb.To_Unbounded_String("Pad   "),
+                          ASUnb.To_Unbounded_String("     Pad"),
+                          Pad);
+
+         String_Array : array (1..5) of ASUnb.Unbounded_String := 
+                          (ASUnb.To_Unbounded_String("xyzxAda9Xpqr"),
+                           ASUnb.To_Unbounded_String("Ada9Xqqrp"),
+                           ASUnb.To_Unbounded_String("zxyxAda9Xqpqr"),
+                           ASUnb.To_Unbounded_String("xxxyAda9X"),
+                           The_New_Ada);
+           
+      begin
+
+         -- Examine the version of Trim that removes blanks from
+         -- the left and/or right of a string.
+
+         for i in 1..4 loop
+            if ASUnb.Trim(Space_Array(i), Ada.Strings.Both) /= Pad then
+               Report.Failed("Incorrect result from Trim for spaces - " &
+                             Integer'Image(i));
+            end if;
+         end loop;   
+
+         -- Examine the version of Trim that removes set characters from
+         -- the left and right of a string.
+
+         for i in 1..5 loop
+            if ASUnb.Trim(String_Array(i),
+                          Left   => XYZ_Set,
+                          Right  => PQR_Set) /= The_New_Ada then
+               Report.Failed
+                 ("Incorrect result from Trim for set characters - " &
+                  Integer'Image(i));
+            end if;
+         end loop;   
+
+      end Trim_Block;
+
+
+      -- Delete
+
+      -- Use the Delete function to remove the first four and last four
+      -- characters from the string.
+
+      if ASUnb.Delete(Source  => ASUnb.Delete(Magic_String,
+                                              8,
+                                              ASUnb.Length(Magic_String)),
+                      From    => ASUnb.To_String(Magic_String)'First,
+                      Through => 4)   /= 
+         Cad_String
+      then
+         Report.Failed("Incorrect results from Function Delete");
+      end if;
+
+
+      -- Constructors ("*")
+
+      Constructor_Block:
+      declare
+      
+         SOS      : ASUnb.Unbounded_String;
+
+         Dot      : constant ASUnb.Unbounded_String := 
+                               ASUnb.To_Unbounded_String("Dot_");
+         Dash     : constant String := "Dash_";
+
+         Distress : ASUnb.Unbounded_String := 
+                      ASUnb.To_Unbounded_String("Dot_Dot_Dot_")    &
+                      ASUnb.To_Unbounded_String("Dash_Dash_Dash_") &
+                      ASUnb.To_Unbounded_String("Dot_Dot_Dot");
+                      
+         Repeat        : constant Natural   := 3;
+         Separator     : constant Character := '_';
+
+         Separator_Set : Maps.Character_Set := Maps.To_Set(Separator);
+
+      begin
+
+         -- Use the following constructor forms to construct the string
+         -- "Dot_Dot_Dot_Dash_Dash_Dash_Dot_Dot_Dot".  Note that the 
+         -- trailing underscore in the string is removed in the call to 
+         -- Trim in the If statement condition.
+
+         SOS := ASUnb."*"(Repeat, Dot);        -- "*"(#, Unb Str)
+
+         SOS := SOS                     &
+                ASUnb."*"(Repeat, Dash) &      -- "*"(#, Str)
+                ASUnb."*"(Repeat, Dot);        -- "*"(#, Unb Str)
+
+         if ASUnb.Trim(SOS, Maps.Null_Set, Separator_Set) /= Distress then
+            Report.Failed("Incorrect results from Function ""*""");
+         end if;
+
+      end Constructor_Block;
+      
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a
new file mode 100644
index 000000000..5ab12b6df
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4012.a
@@ -0,0 +1,305 @@
+-- CXA4012.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 types, operations, and other entities defined within
+--      the package Ada.Strings.Wide_Maps are available and produce correct
+--      results.
+--
+-- TEST DESCRIPTION:
+--      This test demonstrates the availability and function of the types and
+--      operations defined in package Ada.Strings.Wide_Maps.  It demonstrates
+--      the use of these types and functions as they would be used in common
+--      programming practice.
+--      Wide_Character set creation, assignment, and comparison are evaluated
+--      in this test.  Each of the functions provided in package
+--      Ada.Strings.Wide_Maps is utilized in creating or manipulating set
+--      objects, and the function results are evaluated for correctness.
+--      Wide_Character sequences are examined using the functions provided for 
+--      manipulating objects of this type.  Likewise, Wide_Character maps are
+--      created, and their contents evaluated.  Exception raising conditions
+--      from the function To_Mapping are also created.
+--      Note: Throughout this test, the set logical operators are printed in
+--      capital letters to enhance their visibility.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      01 Nov 95   SAIC    Update and repair for ACVC 2.0.1.
+-- 
+--!
+
+with Ada.Characters.Handling;
+with Ada.Strings.Wide_Maps;
+
+package CXA40120 is
+
+   function Equiv (Ch : Character) return Wide_Character;
+   function Equiv (Str : String) 
+     return Ada.Strings.Wide_Maps.Wide_Character_Sequence;
+   function X_Map(From : Wide_Character) return Wide_Character;
+
+end CXA40120;
+
+package body CXA40120 is
+
+   -- The following two functions are used to translate character and string
+   -- values to "Wide" values.  They will be applied to certain Wide_Map
+   -- subprogram parameters to simulate the use of Wide_Characters and 
+   -- Wide_Character_Sequences in actual practice.
+   -- Note: These functions do not actually return "equivalent" wide
+   --       characters to their character inputs, just "non-character"
+   --       wide characters.
+
+   function Equiv (Ch : Character) return Wide_Character is
+      C : Character := Ch;
+   begin
+      if Ch = ' ' then
+         return Ada.Characters.Handling.To_Wide_Character(C);
+      else
+         return Wide_Character'Val(Character'Pos(Ch) + 
+                Character'Pos(Character'Last) + 1);
+      end if;
+   end Equiv;
+
+   function Equiv (Str : String) 
+     return Ada.Strings.Wide_Maps.Wide_Character_Sequence is
+      use Ada.Strings;
+      WS : Wide_Maps.Wide_Character_Sequence(Str'First..Str'Last);
+   begin
+      for i in Str'First..Str'Last loop
+         WS(i) := Equiv(Str(i));
+      end loop;
+      return WS;
+   end Equiv;
+
+   function X_Map(From : Wide_Character) return Wide_Character is
+   begin
+      return Equiv('X');
+   end X_Map;
+
+end CXA40120;
+
+
+
+with CXA40120;
+with Ada.Characters.Handling;
+with Ada.Strings.Wide_Maps;
+with Report;
+
+procedure CXA4012 is
+
+   use CXA40120;
+   use Ada.Strings;
+
+begin
+
+   Report.Test ("CXA4012", "Check that the types, operations, and other " &
+                           "entities defined within the package "         &
+                           "Ada.Strings.Wide_Maps are available and "     &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      use type Wide_Maps.Wide_Character_Set;
+  
+      MidPoint_Letter  : constant := 13;
+      Last_Letter      : constant := 26;
+
+      Vowels           : constant Wide_Maps.Wide_Character_Sequence := 
+                           Equiv("aeiou");
+      Quasi_Vowel      : constant Wide_Character := Equiv('y');
+
+      Alphabet         : Wide_Maps.Wide_Character_Sequence(1..Last_Letter);
+      Half_Alphabet    : Wide_Maps.Wide_Character_Sequence(1..MidPoint_Letter);
+      Inverse_Alphabet : Wide_Maps.Wide_Character_Sequence(1..Last_Letter);
+
+      Alphabet_Set,
+      Consonant_Set,
+      Vowel_Set,
+      Full_Vowel_Set,
+      First_Half_Set,
+      Second_Half_Set : Wide_Maps.Wide_Character_Set := Wide_Maps.Null_Set;
+
+   begin
+
+      -- Load the alphabet string for use in creating sets.
+
+      for i in 0..MidPoint_Letter-1 loop
+         Half_Alphabet(i+1) := 
+           Wide_Character'Val(Wide_Character'Pos(Equiv('a')) + i);
+      end loop;
+
+      for i in 0..Last_Letter-1 loop
+         Alphabet(i+1) := 
+           Wide_Character'Val(Wide_Character'Pos(Equiv('a')) + i);
+      end loop;
+
+
+      -- Initialize a series of Wide_Character_Set objects.
+      
+      Alphabet_Set    := Wide_Maps.To_Set(Alphabet);
+      Vowel_Set       := Wide_Maps.To_Set(Vowels);
+      Full_Vowel_Set  := Vowel_Set   OR  Wide_Maps.To_Set(Quasi_Vowel);
+      Consonant_Set   := Vowel_Set  XOR  Alphabet_Set;
+
+      First_Half_Set  := Wide_Maps.To_Set(Half_Alphabet);
+      Second_Half_Set := Alphabet_Set  XOR  First_Half_Set;
+
+
+      -- Evaluation of Set objects, operators, and functions.
+
+      if Alphabet_Set /= (Vowel_Set OR Consonant_Set) then
+         Report.Failed("Incorrect set combinations using OR operator");
+      end if;
+
+
+      for i in Vowels'First .. Vowels'Last loop
+         if not Wide_Maps.Is_In(Vowels(i), Vowel_Set)    or
+            not Wide_Maps.Is_In(Vowels(i), Alphabet_Set) or
+            Wide_Maps.Is_In(Vowels(i), Consonant_Set) 
+         then
+            Report.Failed("Incorrect function Is_In use with set " &
+                          "combinations - " & Integer'Image(i));
+         end if;
+      end loop;
+
+
+      if Wide_Maps.Is_Subset(Vowel_Set, First_Half_Set)    or
+         Wide_Maps."<="(Vowel_Set, Second_Half_Set)        or
+         not Wide_Maps.Is_Subset(Vowel_Set, Alphabet_Set)
+      then
+         Report.Failed
+           ("Incorrect set evaluation using Is_Subset function");
+      end if;
+
+     
+      if not (Full_Vowel_Set = Wide_Maps.To_Set(Equiv("aeiouy"))) then
+         Report.Failed("Incorrect result for ""="" set operator");
+      end if;
+
+
+      if not ((Vowel_Set AND First_Half_Set) OR 
+              (Full_Vowel_Set AND Second_Half_Set)) = Full_Vowel_Set then
+         Report.Failed
+           ("Incorrect result for AND, OR, or ""="" set operators");
+      end if;
+
+
+      if (Alphabet_Set AND Wide_Maps.Null_Set) /= Wide_Maps.Null_Set  or
+         (Alphabet_Set OR  Wide_Maps.Null_Set) /= Alphabet_Set
+      then
+         Report.Failed("Incorrect result for AND or OR set operators");
+      end if;
+
+
+      Vowel_Set := Full_Vowel_Set;
+      Vowel_Set := Vowel_Set AND (NOT Wide_Maps.To_Set(Quasi_Vowel));
+      
+      if not (Vowels = Wide_Maps.To_Sequence(Vowel_Set)) then
+         Report.Failed("Incorrect Set to Sequence translation");
+      end if;
+
+      
+      for i in 0..Last_Letter-1 loop
+         Inverse_Alphabet(i+1) := Alphabet(Last_Letter-i);
+      end loop;
+
+
+      -- Wide_Character_Mapping
+
+      declare
+         Inverse_Map : Wide_Maps.Wide_Character_Mapping :=
+                         Wide_Maps.To_Mapping(Alphabet, Inverse_Alphabet);
+      begin
+         if Wide_Maps.Value(Wide_Maps.Identity, Equiv('b')) /= 
+            Wide_Maps.Value(Inverse_Map, Equiv('y'))       
+         then
+            Report.Failed("Incorrect Inverse mapping");
+         end if;
+      end;
+
+
+      -- Check that Translation_Error is raised when a character is
+      -- repeated in the parameter "From" string.
+      declare
+         Bad_Map : Wide_Maps.Wide_Character_Mapping;
+      begin
+         Bad_Map := Wide_Maps.To_Mapping(From => Equiv("aa"), 
+                                         To   => Equiv("yz"));
+         Report.Failed("Exception not raised with repeated character");
+      exception
+         when Translation_Error => null;  -- OK
+         when others            => 
+            Report.Failed("Incorrect exception raised in To_Mapping with " &
+                          "a repeated character");
+      end;
+
+
+      -- Check that Translation_Error is raised when the parameters of the
+      -- function To_Mapping are of unequal lengths.
+      declare
+         Bad_Map : Wide_Maps.Wide_Character_Mapping;
+      begin
+         Bad_Map := Wide_Maps.To_Mapping(Equiv("abc"), Equiv("yz"));
+         Report.Failed
+           ("Exception not raised with unequal parameter lengths");
+      exception
+         when Translation_Error => null;  -- OK
+         when others            => 
+            Report.Failed("Incorrect exception raised in To_Mapping with " &
+                          "unequal parameter lengths");
+      end;
+
+
+      -- Check that the access-to-subprogram type is defined and available.
+      -- This provides for one Wide_Character mapping capability only.
+      -- The actual mapping functionality will be tested in conjunction with
+      -- the tests of subprograms defined for Wide_String handling.
+
+      declare
+
+         X_Map_Ptr : Wide_Maps.Wide_Character_Mapping_Function := 
+                       X_Map'Access;
+
+      begin
+         if X_Map_Ptr(Equiv('A')) /=    -- both return 'X'
+            X_Map_Ptr.all(Equiv('Q')) 
+         then  
+            Report.Failed
+              ("Incorrect result using access-to-subprogram values");
+         end if;
+      end;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a
new file mode 100644
index 000000000..0f93e9dc8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4013.a
@@ -0,0 +1,203 @@
+-- CXA4013.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 subprograms defined in package Ada.Strings.Wide_Fixed
+--      are available, and that they produce correct results.  Specifically,
+--      check the subprograms Index, "*" (Wide_String constructor function),
+--      Count, Trim, and Replace_Slice.
+--
+-- TEST DESCRIPTION:
+--      This test demonstrates how certain Wide_Fixed string functions
+--      are used to eliminate specific substrings from portions of text.  
+--      A procedure is defined that will take as parameters a source 
+--      Wide_String along with a substring that is to be completely removed
+--      from the source string.  The source Wide_String is parsed using the
+--      Index function, and any substring slices are replaced in the source
+--      Wide_String by a series of X's (based on the length of the substring.)  
+--      Three lines of text are provided to this procedure, and the resulting
+--      substitutions are compared with expected results to validate the 
+--      string processing.
+--      A global accumulator is updated with the number of occurrences of the
+--      substring in the source string.  
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Ada.Strings;
+with Ada.Strings.Wide_Fixed;
+with Ada.Strings.Wide_Maps;
+with Report;
+
+procedure CXA4013 is
+
+begin
+
+   Report.Test ("CXA4013", "Check that the subprograms defined in package "  &
+                           "Ada.Strings.Wide_Fixed are available, and that " &
+                           "they produce correct results");
+
+   Test_Block:
+   declare
+
+      TC_Total        : Natural  := 0;
+      Number_Of_Lines : constant := 3;
+      WC              : Wide_Character := 
+                          Wide_Character'Val(Character'Pos('X')            + 
+                                             Character'Pos(Character'Last) + 
+                                             1 );
+
+      subtype WS is Wide_String (1..25);
+
+      type Restricted_Words_Array_Type is 
+        array (1..10) of Wide_String (1..10);
+
+      Restricted_Words : Restricted_Words_Array_Type := 
+                           ("   platoon", " marines  ", "  Marines ",
+                            "north     ", "south     ", "      east", 
+                            "  beach   ", "   airport", "airfield  ", 
+                            "     road ");
+
+      type Page_Of_Text_Type is array (1..Number_Of_Lines) of WS;
+
+      Text_Page : Page_Of_Text_Type := ("The platoon of Marines   ",
+                                        "moved south on the south ",
+                                        "road to the airfield.    ");
+
+      TC_Revised_Line_1 : constant Wide_String := "The XXXXXXX of XXXXXXX   ";
+      TC_Revised_Line_2 : constant Wide_String := "moved XXXXX on the XXXXX ";
+      TC_Revised_Line_3 : constant Wide_String := "XXXX to the XXXXXXXX.    ";
+
+
+      function Equivalent (Left : WS;  Right : Wide_String) 
+        return Boolean is
+      begin
+         for i in WS'range loop
+            if Left(i) /= Right(i) then
+               if Left(i) /= WC   or  Right(i) /= 'X' then
+                  return False;
+               end if;
+            end if;
+         end loop;
+         return True;
+      end Equivalent;
+
+      ---
+
+      procedure Censor (Source_String  : in out Wide_String;
+                        Pattern_String : in     Wide_String) is
+                        
+         use Ada.Strings.Wide_Fixed; -- allows infix notation of "*" below.
+
+         -- Create a replacement string that is the same length as the
+         -- pattern string being removed.  Use the infix notation of the 
+         -- wide string constructor function.
+
+         Replacement : constant Wide_String :=                       
+                         Pattern_String'Length * WC;                 -- "*"
+
+         Going     : Ada.Strings.Direction := Ada.Strings.Forward;   
+         Start_Pos,
+         Index     : Natural := Source_String'First;
+
+      begin  -- Censor
+
+         -- Accumulate count of total replacement operations.
+
+         TC_Total := TC_Total +                                     
+                      Ada.Strings.Wide_Fixed.Count                  -- Count
+                        (Source  => Source_String,
+                         Pattern => Pattern_String,
+                         Mapping => Ada.Strings.Wide_Maps.Identity);
+         loop
+
+            Index := Ada.Strings.Wide_Fixed.Index                   -- Index
+                       (Source_String(Start_Pos..Source_String'Last),
+                        Pattern_String, 
+                        Going, 
+                        Ada.Strings.Wide_Maps.Identity);
+
+            exit when Index = 0;   -- No matches, exit loop.
+
+            -- if a match was found, modify the substring.
+            Ada.Strings.Wide_Fixed.Replace_Slice              -- Replace_Slice
+                                     (Source_String,
+                                      Index,
+                                      Index + Pattern_String'Length - 1,
+                                      Replacement);
+            Start_Pos := Index + Pattern_String'Length;
+
+         end loop;
+
+      end Censor;
+
+
+   begin
+
+      -- Invoke Censor subprogram to cleanse text.
+      -- Loop through each line of text, and check for the presence of each
+      -- restricted word.
+      -- Use the Trim function to eliminate leading or trailing blanks from
+      -- the restricted word parameters.
+
+      for Line in 1..Number_Of_Lines loop
+         for Word in Restricted_Words'Range loop
+             Censor (Text_Page(Line),                                 -- Trim
+                     Ada.Strings.Wide_Fixed.Trim(Restricted_Words(Word),
+                                                 Ada.Strings.Both));
+         end loop;
+      end loop;
+
+
+      -- Validate results.
+
+      if TC_Total /= 6 then
+         Report.Failed ("Incorrect number of substitutions performed");
+      end if;
+
+      if not Equivalent (Text_Page(1), TC_Revised_Line_1) then
+         Report.Failed ("Incorrect substitutions on Line 1");
+      end if;
+
+      if not Equivalent (Text_Page(2), TC_Revised_Line_2) then
+         Report.Failed ("Incorrect substitutions on Line 2");
+      end if;
+
+      if not Equivalent (Text_Page(3), TC_Revised_Line_3) then
+         Report.Failed ("Incorrect substitutions on Line 3");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4013;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4014.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4014.a
new file mode 100644
index 000000000..6e26a0330
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4014.a
@@ -0,0 +1,359 @@
+-- CXA4014.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 subprograms defined in package Ada.Strings.Wide_Fixed
+--      are available, and that they produce correct results.  Specifically, 
+--      check the subprograms Find_Token, Head, Index, Index_Non_Blank, Move,
+--      Overwrite, and Replace_Slice, Tail, and Translate. 
+--      Use the access-to-subprogram mapping version of Translate (function
+--      and procedure).
+--
+-- TEST DESCRIPTION:
+--      This test demonstrates how certain wide fixed string operations could
+--      be used in wide string information processing.  A procedure is defined
+--      that will extract portions of a 50 character string that correspond to
+--      certain data items (i.e., name, address, state, zip code). These
+--      parsed items will then be added to the appropriate fields of data
+--      base elements.  These data base elements are then compared for
+--      accuracy against a similar set of predefined data base
+--      elements.
+--      A variety of wide fixed string processing subprograms are used in this
+--      test.  Each parsing operation attempts to use a different combination
+--      of the available subprograms to accomplish the same goal, therefore
+--      continuity of approach to wide string parsing is not seen in this
+--      test.
+--      However, a wide variety of possible approaches are demonstrated, while
+--      exercising a large number of the total predefined subprograms of
+--      package Ada.Strings.Wide_Fixed.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      02 Nov 95   SAIC    Update and repair for ACVC 2.0.1.
+--
+--!
+
+package CXA40140 is
+
+   UnderScore  : Wide_Character := '_';
+   Blank       : Wide_Character := ' ';
+
+   -- Function providing a mapping to a blank Wide_Character.
+   function US_to_Blank_Map (From : Wide_Character) return Wide_Character;
+
+end CXA40140;
+
+package body CXA40140 is
+
+   function US_to_Blank_Map (From : Wide_Character) return Wide_Character is
+   begin
+      if From = UnderScore then
+         return Blank;
+      else
+         return From;
+      end if;
+   end US_to_Blank_Map;
+
+end CXA40140;
+
+
+with CXA40140;
+with Ada.Strings.Wide_Fixed;
+with Ada.Strings.Wide_Maps;
+with Report;
+
+procedure CXA4014 is
+   use CXA40140;
+begin
+
+   Report.Test ("CXA4014", "Check that the subprograms defined in package "  &
+                           "Ada.Strings.Wide_Fixed are available, and that " &
+                           "they produce correct results");
+
+   Test_Block:
+   declare
+
+      Number_Of_Info_Strings : constant Natural := 3;
+      DB_Size                : constant Natural := Number_Of_Info_Strings;
+      Count                  : Natural          := 0;
+      Finished_Processing    : Boolean          := False;
+      Blank_Wide_String      : constant Wide_String  := " ";
+
+      subtype Info_Wide_String_Type         is Wide_String (1..50);
+      type    Info_Wide_String_Storage_Type is 
+                array (1..Number_Of_Info_Strings) of Info_Wide_String_Type;
+
+
+      subtype Name_Type                is Wide_String (1..10);
+      subtype Street_Number_Type       is Wide_String (1..5);
+      subtype Street_Name_Type         is Wide_String (1..10);
+      subtype City_Type                is Wide_String (1..10);
+      subtype State_Type               is Wide_String (1..2);
+      subtype Zip_Code_Type            is Wide_String (1..5);
+
+      type Data_Base_Element_Type is
+         record
+            Name          : Name_Type          := (others => ' ');
+            Street_Number : Street_Number_Type := (others => ' ');
+            Street_Name   : Street_Name_Type   := (others => ' ');
+            City          : City_Type          := (others => ' ');
+            State         : State_Type         := (others => ' ');
+            Zip_Code      : Zip_Code_Type      := (others => ' ');
+         end record;
+
+      type Data_Base_Type is array (1..DB_Size) of Data_Base_Element_Type;
+
+      Data_Base : Data_Base_Type;
+
+      ---
+
+      Info_String_1 : Info_Wide_String_Type := 
+        "Joe_Jones 123   Sixth_St   San_Diego    CA   98765"; 
+
+      Info_String_2 : Info_Wide_String_Type := 
+        "Sam_Smith 56789  S._Seventh   Carlsbad  CA   92177";
+
+      Info_String_3 : Info_Wide_String_Type := 
+        "Jane_Brown 1219   Info_Lane  Tuscon     AZ   85643";
+
+
+      Info_Strings : Info_Wide_String_Storage_Type :=
+                       (1 => Info_String_1,
+                        2 => Info_String_2,
+                        3 => Info_String_3);
+
+
+
+      TC_DB_Element_1 : Data_Base_Element_Type := 
+        ("Joe Jones ", "123  ", "Sixth St  ", "San Diego ", "CA", "98765");
+
+      TC_DB_Element_2 : Data_Base_Element_Type := 
+        ("Sam Smith ", "56789", "S. Seventh", "Carlsbad  ", "CA", "92177");
+
+      TC_DB_Element_3 : Data_Base_Element_Type := 
+        ("Jane Brown", "1219 ", "Info Lane ", "Tuscon    ", "AZ", "85643");
+
+      TC_Data_Base : Data_Base_Type := (TC_DB_Element_1,
+                                        TC_DB_Element_2,
+                                        TC_DB_Element_3);
+
+      ---
+
+
+      procedure Store_Information 
+         (Info_String : in     Info_Wide_String_Type;
+          DB_Record   : in out Data_Base_Element_Type) is
+
+         package  AS renames Ada.Strings;
+         use type AS.Wide_Maps.Wide_Character_Set;
+
+         Start,
+         Stop        : Natural := 0;
+
+         Numeric_Set    : constant AS.Wide_Maps.Wide_Character_Set :=
+                            AS.Wide_Maps.To_Set("0123456789");
+
+         Cal            : constant 
+                            AS.Wide_Maps.Wide_Character_Sequence := "CA";
+         California_Set : constant AS.Wide_Maps.Wide_Character_Set := 
+                            AS.Wide_Maps.To_Set(Cal);
+         Arizona_Set    : constant AS.Wide_Maps.Wide_Character_Set := 
+                            AS.Wide_Maps.To_Set("AZ");
+         Nevada_Set     : constant AS.Wide_Maps.Wide_Character_Set := 
+                            AS.Wide_Maps.To_Set("NV");
+
+         Blank_Ftn_Ptr : AS.Wide_Maps.Wide_Character_Mapping_Function :=
+                           US_to_Blank_Map'Access;
+
+      begin
+
+         -- Find the starting position of the name field (first non-blank),
+         -- then, from that position, find the end of the name field (first
+         -- blank).
+
+         Start := AS.Wide_Fixed.Index_Non_Blank(Info_String); 
+         Stop  := AS.Wide_Fixed.Index (Info_String(Start..Info_String'Length),
+                                       AS.Wide_Maps.To_Set(Blank),
+                                       AS.Inside,
+                                       AS.Forward) - 1 ;
+
+         -- Store the name field in the data base element field for "Name".
+
+         DB_Record.Name := AS.Wide_Fixed.Head(Info_String(1..Stop), 
+                                         DB_Record.Name'Length);
+
+         -- Replace any underscore characters in the name field
+         -- that were used to separate first/middle/last names.
+         -- Use the overloaded version of Translate that takes an
+         -- access-to-subprogram value.
+
+         AS.Wide_Fixed.Translate (DB_Record.Name, Blank_Ftn_Ptr);
+
+         
+         -- Continue the extraction process; now find the position of
+         -- the street number in the string.
+
+         Start := Stop + 1;
+
+         AS.Wide_Fixed.Find_Token(Info_String(Start..Info_String'Length),
+                                  Numeric_Set,
+                                  AS.Inside,
+                                  Start,
+                                  Stop);
+
+         -- Store the street number field in the appropriate data base 
+         -- element.
+         -- No modification of the default parameters of procedure Move
+         -- is required.
+
+         AS.Wide_Fixed.Move(Source => Info_String(Start..Stop),
+                            Target => DB_Record.Street_Number);
+
+
+         -- Continue the extraction process; find the street name in the
+         -- info string.  Skip blanks to the start of the street name, then
+         -- search for the index of the next blank character in the string.
+
+         Start := AS.Wide_Fixed.Index_Non_Blank
+                                  (Info_String(Stop+1..Info_String'Length)); 
+
+         Stop := 
+           AS.Wide_Fixed.Index(Info_String(Start..Info_String'Length),
+                               Blank_Wide_String) - 1; 
+
+         -- Store the street name in the appropriate data base element field.
+
+         AS.Wide_Fixed.Overwrite(DB_Record.Street_Name, 
+                                 1, 
+                                 Info_String(Start..Stop));
+                           
+         -- Replace any underscore characters in the street name field
+         -- that were used as word separation with blanks.  Again, use the 
+         -- access-to-subprogram value to provide the mapping.
+         
+         DB_Record.Street_Name := 
+           AS.Wide_Fixed.Translate(DB_Record.Street_Name, 
+                                   Blank_Ftn_Ptr);
+
+
+         -- Continue the extraction; remove the city name from the string.
+
+         Start := AS.Wide_Fixed.Index_Non_Blank
+                                  (Info_String(Stop+1..Info_String'Length)); 
+
+         Stop := 
+           AS.Wide_Fixed.Index(Info_String(Start..Info_String'Length), 
+                               Blank_Wide_String) - 1; 
+
+         -- Store the city name field in the appropriate data base element.
+
+         AS.Wide_Fixed.Replace_Slice(DB_Record.City, 
+                                     1,
+                                     DB_Record.City'Length,
+                                     Info_String(Start..Stop));
+                           
+         -- Replace any underscore characters in the city name field
+         -- that were used as word separation.
+         
+         AS.Wide_Fixed.Translate (DB_Record.City, 
+                                  Blank_Ftn_Ptr);
+
+
+         -- Continue the extraction; remove the state identifier from the 
+         -- info string.
+
+         Start := Stop + 1;
+
+         AS.Wide_Fixed.Find_Token(Info_String(Start..Info_String'Length),
+                                  AS.Wide_Maps."OR"(California_Set,
+                                    AS.Wide_Maps."OR"(Nevada_Set,
+                                                      Arizona_Set)),
+                                  AS.Inside,
+                                  Start,
+                                  Stop);
+
+         -- Store the state indicator into the data base element.
+
+         AS.Wide_Fixed.Move(Source  => Info_String(Start..Stop),
+                            Target  => DB_Record.State,
+                            Drop    => Ada.Strings.Right,
+                            Justify => Ada.Strings.Left,
+                            Pad     => AS.Wide_Space);
+
+
+         -- Continue the extraction process; remove the final data item in 
+         -- the info string, the zip code, and place it into the 
+         -- corresponding data base element.
+
+         DB_Record.Zip_Code := 
+           AS.Wide_Fixed.Tail(Info_String, DB_Record.Zip_Code'Length);
+
+      exception 
+         when AS.Length_Error      =>
+            Report.Failed ("Length_Error raised in procedure");
+         when AS.Pattern_Error     =>
+            Report.Failed ("Pattern_Error raised in procedure");
+         when AS.Translation_Error =>
+            Report.Failed ("Translation_Error raised in procedure");
+         when others            =>
+            Report.Failed ("Exception raised in procedure");
+      end Store_Information;
+
+
+   begin
+
+      -- Loop thru the information strings, extract the name and address
+      -- information, place this info into elements of the data base.
+
+      while not Finished_Processing loop
+
+         Count := Count + 1;
+
+         Store_Information (Info_Strings(Count), Data_Base(Count));
+
+         Finished_Processing := (Count = Number_Of_Info_Strings);
+
+      end loop;
+
+
+      -- Verify that the string processing was successful.
+
+      for i in 1..DB_Size loop
+         if Data_Base(i) /= TC_Data_Base(i) then
+            Report.Failed 
+              ("Data processing error on record " & Integer'Image(i));
+         end if;
+      end loop;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4014;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4015.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4015.a
new file mode 100644
index 000000000..83fad3af8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4015.a
@@ -0,0 +1,580 @@
+-- CXA4015.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 subprograms defined in package Ada.Strings.Wide_Fixed
+--      are available, and that they produce correct results.  Specifically, 
+--      check the subprograms Count, Find_Token, Index, Index_Non_Blank, and
+--      Move.
+--      
+-- TEST DESCRIPTION:
+--      This test, when combined with tests CXA4013,14,16 will provide 
+--      coverage of the functionality found in Ada.Strings.Wide_Fixed.  
+--      This test contains many small, specific test cases, situations that 
+--      although common in user environments, are often difficult to generate 
+--      in large numbers in a application-based test.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      02 Nov 95   SAIC    Corrected various accesssibility problems and
+--                          expected result strings for ACVC 2.0.1.
+--
+--!
+
+package CXA40150 is
+
+   -- Wide Character mapping function defined for use with specific 
+   -- versions of functions Index and Count.
+
+   function AK_to_ZQ_Mapping (From : Wide_Character) return Wide_Character;
+
+end CXA40150;
+
+package body CXA40150 is
+
+   function AK_to_ZQ_Mapping (From : Wide_Character) 
+     return Wide_Character is
+   begin
+      if From = 'a' then
+         return 'z';
+      elsif From = 'k' then
+         return 'q';
+      else
+         return From;
+      end if;
+   end AK_to_ZQ_Mapping;
+
+end CXA40150;
+
+
+with CXA40150;
+with Report;
+with Ada.Strings;
+with Ada.Strings.Wide_Fixed;
+with Ada.Strings.Wide_Maps;
+
+procedure CXA4015 is
+begin
+
+   Report.Test("CXA4015", "Check that the subprograms defined in "         &
+                          "package Ada.Strings.Wide_Fixed are available, " &
+                          "and that they produce correct results");
+
+
+   Test_Block:
+   declare
+
+      use CXA40150;
+
+      package ASF  renames Ada.Strings.Wide_Fixed;
+      package Maps renames Ada.Strings.Wide_Maps;
+
+      Result_String  : Wide_String(1..10) := 
+                          (others => Ada.Strings.Wide_Space);
+
+      Source_String1 : Wide_String(1..5)  := "abcde";  -- odd len Wide_String
+      Source_String2 : Wide_String(1..6)  := "abcdef"; -- even len Wide_String
+      Source_String3 : Wide_String(1..12) := "abcdefghijkl";   
+      Source_String4 : Wide_String(1..12) := "abcdefghij  "; -- last 2 ch pad
+      Source_String5 : Wide_String(1..12) := "  cdefghijkl"; -- first 2 ch pad
+      Source_String6 : Wide_String(1..12) := "abcdefabcdef";   
+      
+      Location       : Natural := 0;
+      Slice_Start    : Positive;
+      Slice_End,
+      Slice_Count    : Natural := 0;
+
+      CD_Set         : Maps.Wide_Character_Set := Maps.To_Set("cd");  
+      ABCD_Set       : Maps.Wide_Character_Set := Maps.To_Set("abcd");
+      A_to_F_Set     : Maps.Wide_Character_Set := Maps.To_Set("abcdef");
+                  
+      CD_to_XY_Map   : Maps.Wide_Character_Mapping :=
+                         Maps.To_Mapping(From => "cd",  To => "xy");
+
+
+      -- Access-to-Subprogram object defined for use with specific versions of 
+      -- functions Index and Count.
+      
+      Map_Ptr : Maps.Wide_Character_Mapping_Function := 
+                  AK_to_ZQ_Mapping'Access;
+
+
+   begin
+
+
+      -- Procedure Move
+      -- Evaluate the Procedure Move with various combinations of
+      -- parameters.
+
+      -- Justify = Left (default case)
+
+      ASF.Move(Source => Source_String1,       -- "abcde"
+               Target => Result_String);
+      
+      if Result_String /= "abcde     " then
+         Report.Failed("Incorrect result from Move with Justify = Left");
+      end if;
+ 
+      -- Justify = Right
+ 
+      ASF.Move(Source  => Source_String2,      -- "abcdef"
+               Target  => Result_String,
+               Drop    => Ada.Strings.Error,
+               Justify => Ada.Strings.Right);
+
+      if Result_String /= "    abcdef" then
+         Report.Failed("Incorrect result from Move with Justify = Right");
+      end if;
+
+      -- Justify = Center (two cases, odd and even pad lengths)
+ 
+      ASF.Move(Source_String1,                 -- "abcde"
+               Result_String,
+               Ada.Strings.Error,
+               Ada.Strings.Center,
+               'x');                           -- non-default padding.
+
+      if Result_String /= "xxabcdexxx" then  -- Unequal padding added right
+         Report.Failed("Incorrect result from Move with Justify = Center-1");
+      end if;
+
+      ASF.Move(Source_String2,                 -- "abcdef"
+               Result_String,
+               Ada.Strings.Error,
+               Ada.Strings.Center);
+
+      if Result_String /= "  abcdef  " then  -- Equal padding added on L/R.
+         Report.Failed("Incorrect result from Move with Justify = Center-2");
+      end if;
+
+      -- When the source Wide_String is longer than the target Wide_String,
+      -- several cases can be examined, with the results depending on the 
+      -- value of the Drop parameter.
+
+      -- Drop = Left
+
+      ASF.Move(Source => Source_String3,       -- "abcdefghijkl"
+               Target => Result_String,
+               Drop   => Ada.Strings.Left);
+
+      if Result_String /= "cdefghijkl" then
+         Report.Failed("Incorrect result from Move with Drop = Left");
+      end if;
+
+      -- Drop = Right
+     
+      ASF.Move(Source_String3, Result_String, Ada.Strings.Right);
+
+      if Result_String /= "abcdefghij" then
+         Report.Failed("Incorrect result from Move with Drop = Right");
+      end if;
+
+      -- Drop = Error
+      -- The effect in this case depends on the value of the justify
+      -- parameter, and on whether any characters in Source other than 
+      -- Pad would fail to be copied.
+
+      -- Drop = Error, Justify = Left, right overflow characters are pad.
+
+      ASF.Move(Source  => Source_String4,      -- "abcdefghij  "
+               Target  => Result_String,
+               Drop    => Ada.Strings.Error,
+               Justify => Ada.Strings.Left);
+
+      if not(Result_String = "abcdefghij") then  -- leftmost 10 characters
+          Report.Failed("Incorrect result from Move with Drop = Error - 1");
+      end if;
+
+      -- Drop = Error, Justify = Right, left overflow characters are pad.
+
+      ASF.Move(Source_String5,                 -- "  cdefghijkl"
+               Result_String, 
+               Ada.Strings.Error, 
+               Ada.Strings.Right);
+
+      if Result_String /= "cdefghijkl" then  -- rightmost 10 characters
+         Report.Failed("Incorrect result from Move with Drop = Error - 2");
+      end if;
+
+      -- In other cases of Drop=Error, Length_Error is propagated, such as:
+
+      begin
+
+         ASF.Move(Source_String3,     -- 12 characters, no Pad.
+                  Result_String,      -- 10 characters
+                  Ada.Strings.Error,  
+                  Ada.Strings.Left);  
+
+         Report.Failed("Length_Error not raised by Move - 1");
+
+      exception
+         when Ada.Strings.Length_Error => null;   -- OK
+         when others => 
+            Report.Failed("Incorrect exception raised by Move - 1");
+      end;
+
+
+
+      -- Function Index
+      -- (Other usage examples of this function found in CXA4013-14.)
+      -- Check when the pattern is not found in the source.
+
+      if ASF.Index("abcdef", "gh")       /= 0 or
+         ASF.Index("abcde",  "abcdef")   /= 0 or  -- pattern > source
+         ASF.Index("xyz", 
+                   "abcde", 
+                   Ada.Strings.Backward) /= 0 or
+         ASF.Index("",      "ab")        /= 0 or  -- null source Wide_String.
+         ASF.Index("abcde", "  ")        /= 0     -- blank pattern.
+      then
+         Report.Failed("Incorrect result from Index, no pattern match");
+      end if;
+
+      -- Check that Pattern_Error is raised when the pattern is the 
+      -- null Wide_String.
+      begin
+         Location := ASF.Index(Source_String6,    -- "abcdefabcdef"
+                               "",                -- null pattern Wide_String.
+                               Ada.Strings.Forward);
+         Report.Failed("Pattern_Error not raised by Index");
+      exception
+         when Ada.Strings.Pattern_Error => null;  -- OK, expected exception.
+         when others                    =>
+           Report.Failed("Incorrect exception raised by Index, null pattern");
+      end;
+
+      -- Use the search direction "backward" to locate the particular
+      -- pattern within the source Wide_String.
+
+      Location := ASF.Index(Source_String6,         -- "abcdefabcdef"
+                            "de",                   -- slice 4..5, 10..11
+                            Ada.Strings.Backward);  -- search from right end.
+
+      if Location /= 10  then
+         Report.Failed("Incorrect result from Index going Backward");
+      end if;
+
+
+
+      -- Function Index
+      -- Use the version of Index that takes a Wide_Character_Mapping_Function
+      -- parameter.
+      -- Use the search directions Forward and Backward to locate the 
+      -- particular pattern wide string within the source wide string.
+      
+      Location := ASF.Index("akzqefakzqef",
+                            "qzq",                  -- slice 8..10
+                            Ada.Strings.Backward,
+                            Map_Ptr);      -- perform 'a' to 'z', 'k' to 'q'
+                                           -- translation. 
+      if Location /= 8  then
+         Report.Failed
+           ("Incorrect result from Index w/map ptr going Backward");
+      end if;
+
+      Location := ASF.Index("ddkkddakcdakdefcadckdfzaaqd",
+                            "zq",                  -- slice 7..8
+                            Ada.Strings.Forward,
+                            Map_Ptr);      -- perform 'a' to 'z', 'k' to 'q'
+                                           -- translation. 
+      if Location /= 7  then
+         Report.Failed
+           ("Incorrect result from Index w/map ptr going Forward");
+      end if;
+
+
+      if ASF.Index("aakkzq", "zq",   Ada.Strings.Forward,  Map_Ptr) /= 2 or
+         ASF.Index("qzedka", "qz",   Ada.Strings.Backward, Map_Ptr) /= 5 or
+         ASF.Index("zazaza", "zzzz", Ada.Strings.Backward, Map_Ptr) /= 3 or
+         ASF.Index("kka",    "qqz",  Ada.Strings.Forward,  Map_Ptr) /= 1
+      then
+         Report.Failed("Incorrect result from Index w/map ptr");
+      end if;
+
+
+      -- Check when the pattern wide string is not found in the source.
+
+      if ASF.Index("akzqef", "kzq",    Ada.Strings.Forward,  Map_Ptr) /= 0 or
+         ASF.Index("abcde",  "abcdef", Ada.Strings.Backward, Map_Ptr) /= 0 or
+         ASF.Index("xyz",    "akzde",  Ada.Strings.Backward, Map_Ptr) /= 0 or
+         ASF.Index("",       "zq",     Ada.Strings.Forward,  Map_Ptr) /= 0 or
+         ASF.Index("akcde",  "  ",     Ada.Strings.Backward, Map_Ptr) /= 0
+      then
+         Report.Failed
+           ("Incorrect result from Index w/map ptr, no pattern match");
+      end if;
+
+      -- Check that Pattern_Error is raised when the pattern is a 
+      -- null Wide_String.
+      begin
+         Location := ASF.Index("akzqefakqzef",
+                               "",                -- null pattern Wide_String.
+                               Ada.Strings.Forward,
+                               Map_Ptr);
+         Report.Failed("Pattern_Error not raised by Index w/map ptr");
+      exception
+         when Ada.Strings.Pattern_Error => null;  -- OK, expected exception.
+         when others                    =>
+           Report.Failed
+             ("Incorrect exception raised by Index w/map ptr, null pattern");
+      end;
+
+
+
+      -- Function Index
+      -- Using the version of Index testing wide character set membership, 
+      -- check combinations of forward/backward, inside/outside parameter
+      -- configurations.
+
+      if ASF.Index(Source => Source_String1,              -- "abcde"
+                   Set    => CD_Set,
+                   Test   => Ada.Strings.Inside,
+                   Going  => Ada.Strings.Forward) /= 3 or -- 'c' at pos 3.
+         ASF.Index(Source_String6,                        -- "abcdefabcdef"
+                   CD_Set,
+                   Ada.Strings.Outside,
+                   Ada.Strings.Backward)  /=  12  or   -- 'f' at position 12
+         ASF.Index(Source_String6,                     -- "abcdefabcdef"
+                   CD_Set,
+                   Ada.Strings.Inside,
+                   Ada.Strings.Backward)  /=   10  or  -- 'd' at position 10
+         ASF.Index("cdcdcdcdacdcdcdcd",               
+                   CD_Set,
+                   Ada.Strings.Outside,
+                   Ada.Strings.Forward)   /=    9      -- 'a' at position 9
+      then
+         Report.Failed("Incorrect result from function Index for sets - 1");
+      end if;
+
+      -- Additional interesting uses/combinations using Index for sets.
+
+      if ASF.Index("cd",                               -- same size, str-set
+                   CD_Set,
+                   Ada.Strings.Inside,
+                   Ada.Strings.Forward)   /=    1  or  -- 'c' at position 1
+         ASF.Index("abcd",                             -- same size, str-set,
+                   Maps.To_Set("efgh"),                -- different contents.
+                   Ada.Strings.Outside,                
+                   Ada.Strings.Forward)   /=    1  or
+         ASF.Index("abccd",                            -- set > Wide_String
+                   Maps.To_Set("acegik"),
+                   Ada.Strings.Inside,
+                   Ada.Strings.Backward)  /=    4  or  -- 'c' at position 4
+         ASF.Index("abcde",
+                   Maps.Null_Set)         /=    0  or
+         ASF.Index("",                                 -- Null string.
+                   CD_Set)                /=    0  or
+         ASF.Index("abc ab",                           -- blank included
+                   Maps.To_Set("e "),                  -- in Wide_String and
+                   Ada.Strings.Inside,                 -- set.
+                   Ada.Strings.Backward)  /=    4      -- blank in Wide_Str.
+      then
+         Report.Failed("Incorrect result from function Index for sets - 2");
+      end if;
+
+
+
+      -- Function Index_Non_Blank.
+      -- (Other usage examples of this function found in CXA4013-14.)
+                                                         
+
+      if ASF.Index_Non_Blank(Source => Source_String4,  -- "abcdefghij  "
+                             Going  => Ada.Strings.Backward)  /= 10  or
+         ASF.Index_Non_Blank("abc def ghi jkl  ",
+                             Ada.Strings.Backward)            /= 15  or
+         ASF.Index_Non_Blank("  abcdef")                      /=  3  or
+         ASF.Index_Non_Blank("        ")                      /=  0
+      then
+          Report.Failed("Incorrect result from Index_Non_Blank");
+      end if;
+
+
+
+      -- Function Count
+      -- (Other usage examples of this function found in CXA4013-14.)
+
+      if ASF.Count("abababa",   "aba")            /=  2  or
+         ASF.Count("abababa",   "ab" )            /=  3  or
+         ASF.Count("babababa",  "ab")             /=  3  or
+         ASF.Count("abaabaaba", "aba")            /=  3  or
+         ASF.Count("xxxxxxxxxxxxxxxxxxxy", "xy")  /=  1  or
+         ASF.Count("xxxxxxxxxxxxxxxxxxxx", "x")   /= 20
+      then
+         Report.Failed("Incorrect result from Function Count");
+      end if;
+
+      -- Determine the number of slices of Source that when mapped to a 
+      -- non-identity map, match the pattern Wide_String.
+
+      Slice_Count := ASF.Count(Source_String6, -- "abcdefabcdef"
+                               "xy",
+                               CD_to_XY_Map);  -- maps 'c' to 'x', 'd' to 'y'
+
+      if Slice_Count /= 2 then  -- two slices "xy" in "mapped" Source_String6
+         Report.Failed("Incorrect result from Count with non-identity map");
+      end if;
+
+      -- If the pattern supplied to Function Count is the null Wide_String,
+      -- then Pattern_Error is propagated.
+      declare
+         The_Null_Wide_String : constant Wide_String := "";
+      begin
+         Slice_Count := ASF.Count(Source_String6, The_Null_Wide_String);
+         Report.Failed("Pattern_Error not raised by Function Count");
+      exception
+         when Ada.Strings.Pattern_Error => null;   -- OK
+         when others =>
+           Report.Failed("Incorrect exception from Count with null pattern");
+      end;
+
+
+
+
+      -- Function Count
+      -- Use the version of Count that takes a Wide_Character_Mapping_Function
+      -- value as the basis of its source mapping.
+      
+      if ASF.Count("akakaka",      "zqz", Map_Ptr)          /=  2  or
+         ASF.Count("akakaka",      "qz",  Map_Ptr)          /=  3  or
+         ASF.Count("kakakaka",     "q",   Map_Ptr)          /=  4  or
+         ASF.Count("zzqaakzaqzzk", "zzq", Map_Ptr)          /=  4  or
+         ASF.Count("   ",          "z",   Map_Ptr)          /=  0  or
+         ASF.Count("",             "qz",  Map_Ptr)          /=  0  or
+         ASF.Count("abbababab",    "zq",  Map_Ptr)          /=  0  or
+         ASF.Count("aaaaaaaaaaaaaaaaaakk", "zqq", Map_Ptr)  /=  1  or
+         ASF.Count("azaazaazzzaaaaazzzza", "z",   Map_Ptr)  /= 20  
+      then
+         Report.Failed("Incorrect result from Function Count w/map ptr");
+      end if;
+
+      -- If the pattern supplied to Function Count is a null Wide_String,
+      -- then Pattern_Error is propagated.
+      declare
+         The_Null_Wide_String : constant Wide_String := "";
+      begin
+         Slice_Count := ASF.Count(Source_String6, 
+                                  The_Null_Wide_String, 
+                                  Map_Ptr);
+         Report.Failed
+           ("Pattern_Error not raised by Function Count w/map ptr");
+      exception
+         when Ada.Strings.Pattern_Error => null;   -- OK
+         when others =>
+           Report.Failed
+             ("Incorrect exception from Count w/map ptr, null pattern");
+      end;
+
+
+
+
+      -- Function Count returning the number of characters in a particular
+      -- set that are found in source Wide_String.
+
+      if ASF.Count(Source_String6, CD_Set) /=  4 or  -- 2 'c' and 'd' chars.
+         ASF.Count("cddaccdaccdd", CD_Set) /= 10
+      then
+         Report.Failed("Incorrect result from Count with set");
+      end if;
+
+
+ 
+      -- Function Find_Token.
+      -- (Other usage examples of this function found in CXA4013-14.)
+
+      ASF.Find_Token(Source  => Source_String6,      -- First slice with no 
+                     Set     => ABCD_Set,            -- 'a', 'b', 'c', or 'd'
+                     Test    => Ada.Strings.Outside, -- is "ef" at 5..6.
+                     First   => Slice_Start,
+                     Last    => Slice_End);
+
+      if Slice_Start /= 5  or Slice_End /= 6 then
+         Report.Failed("Incorrect result from Find_Token - 1");
+      end if;
+
+      -- If no appropriate slice is contained by the source Wide_String,
+      -- then the value returned in Last is zero, and the value in First is 
+      -- Source'First.
+
+      ASF.Find_Token(Source_String6,      -- "abcdefabcdef"
+                     A_to_F_Set,          -- Set of characters 'a' thru 'f'.
+                     Ada.Strings.Outside, -- No characters outside this set.
+                     Slice_Start,
+                     Slice_End);
+      
+      if Slice_Start /= Source_String6'First  or Slice_End /= 0 then
+         Report.Failed("Incorrect result from Find_Token - 2");
+      end if;
+
+      -- Additional testing of Find_Token.
+
+      ASF.Find_Token("eabcdabcddcab", 
+                     ABCD_Set, 
+                     Ada.Strings.Inside,
+                     Slice_Start,
+                     Slice_End);
+
+      if Slice_Start /= 2  or Slice_End /= 13 then
+         Report.Failed("Incorrect result from Find_Token - 3");
+      end if;
+
+      ASF.Find_Token("efghijklabcdabcd",
+                     ABCD_Set,
+                     Ada.Strings.Outside,
+                     Slice_Start,
+                     Slice_End);
+
+      if Slice_Start /= 1  or Slice_End /= 8 then
+         Report.Failed("Incorrect result from Find_Token - 4");
+      end if;
+
+      ASF.Find_Token("abcdefgabcdabcd",
+                     ABCD_Set,
+                     Ada.Strings.Outside,
+                     Slice_Start,
+                     Slice_End);
+
+      if Slice_Start /= 5  or Slice_End /= 7 then
+         Report.Failed("Incorrect result from Find_Token - 5");
+      end if;
+
+      ASF.Find_Token("abcdcbabcdcba",
+                     ABCD_Set,
+                     Ada.Strings.Inside,
+                     Slice_Start,
+                     Slice_End);
+
+      if Slice_Start /= 1  or Slice_End /= 13 then
+         Report.Failed("Incorrect result from Find_Token - 6");
+      end if;
+
+
+   exception
+      when others => Report.Failed("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4015;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4016.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4016.a
new file mode 100644
index 000000000..00dcdcdbd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4016.a
@@ -0,0 +1,685 @@
+-- CXA4016.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 subprograms defined in package Ada.Strings.Wide_Fixed
+--      are available, and that they produce correct results.  Specifically,
+--      check the subprograms Delete, Head, Insert, Overwrite, Replace_Slice,
+--      Tail, Trim, and "*".
+--
+-- TEST DESCRIPTION:
+--      This test, when combined with tests CXA4013-15 will provide
+--      coverage of the functionality found in package Ada.Strings.Wide_Fixed.
+--      This test contains many small, specific test cases, situations that
+--      although common in user environments, are often difficult to generate
+--      in large numbers in a application-based test.  They represent
+--      individual usage paradigms in-the-small.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      10 Apr 94   SAIC    Modified comments in a subtest failure message.
+--      06 Nov 95   SAIC    Corrected subtest results for ACVC 2.0.1
+--      14 Mar 01   RLB     Added checks that the lower bound is 1, similar
+--                          to CXA4005. These changes were made to test
+--                          Defect Report 8652/0049, as reflected in
+--                          Technical Corrigendum 1.
+--
+--!
+
+with Report;
+with Ada.Strings;
+with Ada.Strings.Wide_Fixed;
+with Ada.Strings.Wide_Maps;
+
+procedure CXA4016 is
+
+    type TC_Name_Holder is access String;
+    Name : TC_Name_Holder;
+
+    function TC_Check (S : Wide_String) return Wide_String is
+    begin
+        if S'First /= 1 then
+            Report.Failed ("Lower bound of result of function " & Name.all &
+                           " is" & Integer'Image (S'First));
+        end if;
+        return S;
+    end TC_Check;
+
+    procedure TC_Set_Name (N : String) is
+    begin
+        Name := new String'(N);
+    end TC_Set_Name;
+
+begin
+
+   Report.Test("CXA4016", "Check that the subprograms defined in "         &
+                          "package Ada.Strings.Wide_Fixed are available, " &
+                          "and that they produce correct results");
+
+   Test_Block:
+   declare
+
+      package ASW       renames Ada.Strings.Wide_Fixed;
+      package Wide_Maps renames Ada.Strings.Wide_Maps;
+
+      Result_String,
+      Delete_String,
+      Insert_String,
+      Trim_String,
+      Overwrite_String  : Wide_String(1..10) :=
+                            (others => Ada.Strings.Wide_Space);
+      Replace_String    : Wide_String(10..30) :=
+                            (others => Ada.Strings.Wide_Space);
+
+      Source_String1 : Wide_String(1..5)  := "abcde";     -- odd len wd str
+      Source_String2 : Wide_String(1..6)  := "abcdef";    -- even len wd str
+      Source_String3 : Wide_String(1..12) := "abcdefghijkl";
+      Source_String4 : Wide_String(1..12) := "abcdefghij  "; -- last two ch pad
+      Source_String5 : Wide_String(1..12) := "  cdefghijkl"; -- first two ch pad
+      Source_String6 : Wide_String(1..12) := "abcdefabcdef";
+
+      Location     : Natural := 0;
+      Slice_Start  : Positive;
+      Slice_End,
+      Slice_Count  : Natural := 0;
+
+      CD_Set       : Wide_Maps.Wide_Character_Set :=
+                       Wide_Maps.To_Set("cd");
+      X_Set        : Wide_Maps.Wide_Character_Set :=
+                       Wide_Maps.To_Set('x');
+      ABCD_Set     : Wide_Maps.Wide_Character_Set :=
+                       Wide_Maps.To_Set("abcd");
+      A_to_F_Set   : Wide_Maps.Wide_Character_Set :=
+                       Wide_Maps.To_Set("abcdef");
+
+      CD_to_XY_Map : Wide_Maps.Wide_Character_Mapping :=
+                       Wide_Maps.To_Mapping(From => "cd",  To => "xy");
+
+   begin
+
+      -- Procedure Replace_Slice
+      -- The functionality of this procedure is similar to procedure Move,
+      -- and is tested here in the same manner, evaluated with various
+      -- combinations of parameters.
+
+      -- Index_Error propagation when Low > Source'Last + 1
+
+      begin
+         ASW.Replace_Slice(Result_String,
+                           Result_String'Last + 2, -- should raise exception
+                           Result_String'Last,
+                           "xxxxxxx");
+         Report.Failed("Index_Error not raised by Replace_Slice - 1");
+      exception
+         when Ada.Strings.Index_Error => null; -- OK, expected exception.
+         when others                  =>
+            Report.Failed("Incorrect exception from Replace_Slice - 1");
+      end;
+
+      -- Index_Error propagation when High < Source'First - 1
+
+      begin
+         ASW.Replace_Slice(Replace_String(20..30),
+                           Replace_String'First,
+                           Replace_String'First - 2, -- should raise exception
+                           "xxxxxxx");
+         Report.Failed("Index_Error not raised by Replace_Slice - 2");
+      exception
+         when Ada.Strings.Index_Error => null; -- OK, expected exception.
+         when others                  =>
+            Report.Failed("Incorrect exception from Replace_Slice - 2");
+      end;
+
+      -- Justify = Left (default case)
+
+      Result_String := "XXXXXXXXXX";
+
+      ASW.Replace_Slice(Source => Result_String,
+                        Low    =>  1,
+                        High   => 10,
+                        By     => Source_String1);   -- "abcde"
+
+      if Result_String /= "abcde     " then
+         Report.Failed("Incorrect result from Replace_Slice - Justify = Left");
+      end if;
+
+      -- Justify = Right
+
+      ASW.Replace_Slice(Source  => Result_String,
+                        Low     => 1,
+                        High    => Result_String'Last,
+                        By      => Source_String2,      -- "abcdef"
+                        Drop    => Ada.Strings.Error,
+                        Justify => Ada.Strings.Right);
+
+      if Result_String /= "    abcdef" then
+         Report.Failed("Incorrect result from Replace_Slice - Justify=Right");
+      end if;
+
+      -- Justify = Center (two cases, odd and even pad lengths)
+
+      ASW.Replace_Slice(Result_String,
+                        1,
+                        Result_String'Last,
+                        Source_String1,      -- "abcde"
+                        Ada.Strings.Error,
+                        Ada.Strings.Center,
+                        'x');                -- non-default padding.
+
+      if Result_String /= "xxabcdexxx" then  -- Unequal padding added right
+         Report.Failed("Incorrect result, Replace_Slice - Justify=Center - 1");
+      end if;
+
+      ASW.Replace_Slice(Result_String,
+                        1,
+                        Result_String'Last,
+                        Source_String2,        -- "abcdef"
+                        Ada.Strings.Error,
+                        Ada.Strings.Center);
+
+      if Result_String /= "  abcdef  " then    -- Equal padding added on L/R.
+         Report.Failed("Incorrect result from Replace_Slice with " &
+                       "Justify = Center - 2");
+      end if;
+
+      -- When the source string is longer than the target string, several
+      -- cases can be examined, with the results depending on the value of
+      -- the Drop parameter.
+
+      -- Drop = Left
+
+      ASW.Replace_Slice(Result_String,
+                        1,
+                        Result_String'Last,
+                        Source_String3,            -- "abcdefghijkl"
+                        Drop => Ada.Strings.Left);
+
+      if Result_String /= "cdefghijkl" then
+         Report.Failed("Incorrect result from Replace_Slice - Drop=Left");
+      end if;
+
+      -- Drop = Right
+
+      ASW.Replace_Slice(Result_String,
+                        1,
+                        Result_String'Last,
+                        Source_String3,        -- "abcdefghijkl"
+                        Ada.Strings.Right);
+
+      if Result_String /= "abcdefghij" then
+         Report.Failed("Incorrect result, Replace_Slice with Drop=Right");
+      end if;
+
+      -- Drop = Error
+
+      -- The effect in this case depends on the value of the justify
+      -- parameter, and on whether any characters in Source other than
+      -- Pad would fail to be copied.
+
+      -- Drop = Error, Justify = Left, right overflow characters are pad.
+
+      ASW.Replace_Slice(Result_String,
+                        1,
+                        Result_String'Last,
+                        Source_String4,               -- "abcdefghij  "
+                        Drop    => Ada.Strings.Error,
+                        Justify => Ada.Strings.Left);
+
+      if not(Result_String = "abcdefghij") then  -- leftmost 10 characters
+          Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 1");
+      end if;
+
+      -- Drop = Error, Justify = Right, left overflow characters are pad.
+
+      ASW.Replace_Slice(Source   => Result_String,
+                        Low      => 1,
+                        High     => Result_String'Last,
+                        By       => Source_String5,     -- "  cdefghijkl"
+                        Drop     => Ada.Strings.Error,
+                        Justify  => Ada.Strings.Right);
+
+      if Result_String /= "cdefghijkl" then  -- rightmost 10 characters
+         Report.Failed("Incorrect result, Replace_Slice - Drop = Error - 2");
+      end if;
+
+      -- In other cases of Drop=Error, Length_Error is propagated, such as:
+
+      begin
+
+         ASW.Replace_Slice(Source   => Result_String,
+                           Low      => 1,
+                           High     => Result_String'Last,
+                           By       => Source_String3,    -- "abcdefghijkl"
+                           Drop     => Ada.Strings.Error);
+
+          Report.Failed("Length_Error not raised by Replace_Slice - 1");
+
+      exception
+         when Ada.Strings.Length_Error => null;   -- OK
+         when others =>
+            Report.Failed("Incorrect exception from Replace_Slice - 3");
+      end;
+
+
+      -- Function Replace_Slice
+
+      TC_Set_Name ("Replace_Slice");
+
+      if TC_Check (ASW.Replace_Slice("abcde", 3, 3, "x"))
+                                           /= "abxde"  or -- High = Low
+         TC_Check (ASW.Replace_Slice("abc",   2, 3, "xyz")) /= "axyz"   or
+         TC_Check (ASW.Replace_Slice("abcd",  4, 1, "xy"))
+                                           /= "abcxyd" or -- High < Low
+         TC_Check (ASW.Replace_Slice("abc",   2, 3, "x"))   /= "ax"     or
+         TC_Check (ASW.Replace_Slice("a",     1, 1, "z"))   /= "z"
+      then
+         Report.Failed("Incorrect result from Function Replace_Slice - 1");
+      end if;
+
+      if TC_Check (ASW.Replace_Slice("abcde", 5, 5, "z"))
+                                           /= "abcdz" or  -- By length 1
+         TC_Check (ASW.Replace_Slice("abc",   1, 3, "xyz"))
+                                           /= "xyz"   or  -- High > Low
+         TC_Check (ASW.Replace_Slice("abc",   3, 2, "xy"))
+                                           /= "abxyc" or  -- insert
+         TC_Check (ASW.Replace_Slice("a",     1, 1, "xyz")) /= "xyz"
+      then
+         Report.Failed("Incorrect result from Function Replace_Slice - 2");
+      end if;
+
+
+
+      -- Function Insert.
+
+      TC_Set_Name ("Insert");
+
+      declare
+         New_String : constant Wide_String :=
+           TC_Check (
+              ASW.Insert(Source   => Source_String1(2..5),    -- "bcde"
+                         Before   => 2,
+                         New_Item => Source_String2));         -- "abcdef"
+      begin
+         if New_String /= "abcdefbcde" then
+            Report.Failed("Incorrect result from Function Insert - 1");
+         end if;
+      end;
+
+      if TC_Check (ASW.Insert("a",   1, "z")) /= "za"   or
+         TC_Check (ASW.Insert("abc", 3, ""))  /= "abc"  or
+         TC_Check (ASW.Insert("abc", 4, "z")) /= "abcz"
+      then
+         Report.Failed("Incorrect result from Function Insert - 2");
+      end if;
+
+      begin
+         if TC_Check (ASW.Insert(Source   => Source_String1(2..5), -- "bcde"
+                         Before   => Report.Ident_Int(7),
+                         New_Item => Source_String2))         -- "abcdef"
+                /= "babcdefcde" then
+            Report.Failed("Index_Error not raised by Insert - 3A");
+         else
+            Report.Failed("Index_Error not raised by Insert - 3B");
+         end if;
+      exception
+         when Ada.Strings.Index_Error => null; -- OK, expected exception.
+         when others                  =>
+            Report.Failed("Incorrect exception from Insert - 3");
+      end;
+
+
+      -- Procedure Insert
+
+      -- Drop = Right
+
+      ASW.Insert(Source   => Insert_String,
+                 Before   => 6,
+                 New_Item => Source_String2,       -- "abcdef"
+                 Drop     => Ada.Strings.Right);
+
+      if Insert_String /= "     abcde" then  -- last char of New_Item dropped.
+         Report.Failed("Incorrect result from Insert with Drop = Right");
+      end if;
+
+      -- Drop = Left
+
+      ASW.Insert(Source   => Insert_String,     -- 10 char string
+                 Before   => 2,                 -- 9 chars, 2..10 available
+                 New_Item => Source_String3,    -- 12 characters long.
+                 Drop     => Ada.Strings.Left); -- truncate from Left.
+
+      if Insert_String /= "l    abcde" then     -- 10 chars, leading blank.
+          Report.Failed("Incorrect result from Insert with Drop=Left");
+      end if;
+
+      -- Drop = Error
+
+      begin
+         ASW.Insert(Source   => Result_String,       -- 10 chars
+                    Before   => Result_String'Last,
+                    New_Item => "abcdefghijk",
+                    Drop     => Ada.Strings.Error);
+         Report.Failed("Exception not raised by Procedure Insert");
+      exception
+         when Ada.Strings.Length_Error => null; -- OK, expected exception
+         when others                   =>
+           Report.Failed("Incorrect exception raised by Procedure Insert");
+      end;
+
+
+
+      -- Function Overwrite
+
+      TC_Set_Name ("Overwrite");
+
+      Overwrite_String := TC_Check (
+          ASW.Overwrite(Result_String,  -- 10 chars
+                        1,              -- starting at pos=1
+                        Source_String3(1..10)));
+
+      if Overwrite_String /= Source_String3(1..10) then
+         Report.Failed("Incorrect result from Function Overwrite - 1");
+      end if;
+
+
+      if TC_Check (ASW.Overwrite("abcdef", 4, "xyz")) /= "abcxyz" or
+         TC_Check (ASW.Overwrite("a",      1, "xyz"))
+                                           /= "xyz"    or  -- chars appended
+         TC_Check (ASW.Overwrite("abc",    3, "   "))
+                                           /= "ab   "  or  -- blanks appended
+         TC_Check (ASW.Overwrite("abcde",  1, "z"  )) /= "zbcde"
+      then
+         Report.Failed("Incorrect result from Function Overwrite - 2");
+      end if;
+
+
+
+      -- Procedure Overwrite, with truncation.
+
+      ASW.Overwrite(Source   => Overwrite_String,    -- 10 characters.
+                    Position => 1,
+                    New_Item => Source_String3,      -- 12 characters.
+                    Drop     => Ada.Strings.Left);
+
+      if Overwrite_String /= "cdefghijkl" then
+         Report.Failed("Incorrect result from Overwrite with Drop=Left");
+      end if;
+
+      -- The default drop value is Right, used here.
+
+      ASW.Overwrite(Source   => Overwrite_String,    -- 10 characters.
+                    Position => 1,
+                    New_Item => Source_String3);     -- 12 characters.
+
+      if Overwrite_String /= "abcdefghij" then
+         Report.Failed("Incorrect result from Overwrite with Drop=Right");
+      end if;
+
+      -- Drop = Error
+
+      begin
+         ASW.Overwrite(Source   => Overwrite_String,    -- 10 characters.
+                       Position => 1,
+                       New_Item => Source_String3,      -- 12 characters.
+                       Drop     => Ada.Strings.Error);
+         Report.Failed("Exception not raised by Procedure Overwrite");
+      exception
+         when Ada.Strings.Length_Error => null; -- OK, expected exception.
+         when others                   =>
+            Report.Failed
+              ("Incorrect exception raised by Procedure Overwrite");
+      end;
+
+      Overwrite_String := "ababababab";
+      ASW.Overwrite(Overwrite_String, Overwrite_String'Last, "z");
+      ASW.Overwrite(Overwrite_String, Overwrite_String'First,"z");
+      ASW.Overwrite(Overwrite_String, 5, "zz");
+
+      if Overwrite_String /= "zbabzzabaz" then
+         Report.Failed("Incorrect result from Procedure Overwrite");
+      end if;
+
+
+
+      -- Function Delete
+
+      TC_Set_Name ("Delete");
+
+      declare
+         New_String1 : constant Wide_String :=  -- Returns a 4 char wide str.
+           TC_Check (ASW.Delete(Source  => Source_String3,
+                                From    => 3,
+                                Through => 10));
+         New_String2 : constant Wide_String :=    -- This returns Source.
+           TC_Check (ASW.Delete(Source_String3, 10, 3));
+      begin
+           if New_String1 /= "abkl"  or
+              New_String2 /= Source_String3
+           then
+               Report.Failed("Incorrect result from Function Delete - 1");
+           end if;
+      end;
+
+      if TC_Check (ASW.Delete("a",   1, 1))
+                              /= ""    or     -- Source length = 1
+         TC_Check (ASW.Delete("abc", 1, 2))
+                              /= "c"   or     -- From = Source'First
+         TC_Check (ASW.Delete("abc", 3, 3))
+                              /= "ab"  or     -- From = Source'Last
+         TC_Check (ASW.Delete("abc", 3, 1))
+                              /= "abc"        -- From > Through
+      then
+         Report.Failed("Incorrect result from Function Delete - 2");
+      end if;
+
+
+
+      -- Procedure Delete
+
+      -- Justify = Left
+
+      Delete_String := Source_String3(1..10);  -- Initialize to "abcdefghij"
+
+      ASW.Delete(Source  => Delete_String,
+                 From    => 6,
+                 Through => Delete_String'Last,
+                 Justify => Ada.Strings.Left,
+                 Pad     => 'x');              -- pad with char 'x'
+
+      if Delete_String /= "abcdexxxxx" then
+          Report.Failed("Incorrect result from Delete - Justify = Left");
+      end if;
+
+      -- Justify = Right
+
+      ASW.Delete(Source  => Delete_String,      -- Remove x"s from end and
+                 From    => 6,                  -- shift right.
+                 Through => Delete_String'Last,
+                 Justify => Ada.Strings.Right,
+                 Pad     => 'x');               -- pad with char 'x' on left.
+
+      if Delete_String /= "xxxxxabcde" then
+          Report.Failed("Incorrect result from Delete - Justify = Right");
+      end if;
+
+      -- Justify = Center
+
+      ASW.Delete(Source  => Delete_String,
+                 From    => 1,
+                 Through => 5,
+                 Justify => Ada.Strings.Center,
+                 Pad     => 'z');
+
+      if Delete_String /= "zzabcdezzz" then  -- extra pad char on right side.
+          Report.Failed("Incorrect result from Delete - Justify = Center");
+      end if;
+
+
+
+      -- Function Trim
+      -- Use non-identity character sets to perform the trim operation.
+
+      TC_Set_Name ("Trim");
+
+      Trim_String := "cdabcdefcd";
+
+      -- Remove the "cd" from each end of the string.  This will not effect
+      -- the "cd" slice at 5..6.
+
+      declare
+         New_String : constant Wide_String :=
+           TC_Check (ASW.Trim(Source => Trim_String,
+                              Left => CD_Set, Right => CD_Set));
+      begin
+         if New_String /= Source_String2 then    -- string "abcdef"
+            Report.Failed
+              ("Incorrect result from Trim with wide character sets");
+         end if;
+      end;
+
+      if TC_Check (ASW.Trim("abcdef", Wide_Maps.Null_Set, Wide_Maps.Null_Set))
+             /= "abcdef" then
+         Report.Failed("Incorrect result from Trim with Null sets");
+      end if;
+
+      if TC_Check (ASW.Trim("cdxx", CD_Set, X_Set)) /= "" then
+         Report.Failed("Incorrect result from Trim, wide string removal");
+      end if;
+
+
+      -- Procedure Trim
+
+      -- Justify = Right
+
+      ASW.Trim(Source  => Trim_String,
+               Left    => CD_Set,
+               Right   => CD_Set,
+               Justify => Ada.Strings.Right,
+               Pad     => 'x');
+
+      if Trim_String /= "xxxxabcdef" then
+         Report.Failed("Incorrect result from Trim with Justify = Right");
+      end if;
+
+      -- Justify = Left
+
+      ASW.Trim(Source  => Trim_String,
+               Left    => X_Set,
+               Right   => Wide_Maps.Null_Set,
+               Justify => Ada.Strings.Left,
+               Pad     => ' ');
+
+      if Trim_String /= "abcdef    " then  -- Padded with 4 blanks on right.
+         Report.Failed("Incorrect result from Trim with Justify = Left");
+      end if;
+
+      -- Justify = Center
+
+      ASW.Trim(Source  => Trim_String,
+               Left    => ABCD_Set,
+               Right   => CD_Set,
+               Justify => Ada.Strings.Center,
+               Pad     => 'x');
+
+      if Trim_String /= "xxef    xx" then  -- Padded with 4 pad chars on L/R
+         Report.Failed("Incorrect result from Trim with Justify = Center");
+      end if;
+
+
+
+      -- Function Head, testing use of padding.
+
+      TC_Set_Name ("Head");
+
+      -- Use the wide characters of Source_String1 ("abcde") and pad the
+      -- last five wide characters of Result_String with 'x' wide characters.
+
+      Result_String := TC_CHeck (ASW.Head(Source_String1, 10, 'x'));
+
+      if Result_String /= "abcdexxxxx" then
+         Report.Failed("Incorrect result from Function Head with padding");
+      end if;
+
+      if TC_Check (ASW.Head("  ab  ", 2))        /= "  "     or
+         TC_Check (ASW.Head("a", 6, 'A'))        /= "aAAAAA" or
+         TC_Check (ASW.Head(ASW.Head("abc  ", 7, 'x'), 10, 'X'))
+                   /= "abc  xxXXX"
+      then
+         Report.Failed("Incorrect result from Function Head");
+      end if;
+
+
+
+      -- Function Tail, testing use of padding.
+
+      TC_Set_Name ("Tail");
+
+      -- Use the wide characters of Source_String1 ("abcde") and pad the
+      -- first five wide characters of Result_String with 'x' wide characters.
+
+      Result_String := TC_Check (ASW.Tail(Source_String1, 10, 'x'));
+
+      if Result_String /= "xxxxxabcde" then
+         Report.Failed("Incorrect result from Function Tail with padding");
+      end if;
+
+      if TC_Check (ASW.Tail("abcde  ", 5))
+                            /= "cde  "    or  -- blanks, back
+         TC_Check (ASW.Tail("  abc ",  8, ' '))
+                            /= "    abc " or  -- blanks, front/back
+         TC_Check (ASW.Tail("",        5, 'Z'))
+                            /= "ZZZZZ"    or  -- pad characters only
+         TC_Check (ASW.Tail("abc",     0))
+                            /= ""         or  -- null result
+         TC_Check (ASW.Tail(ASW.Tail(" abc ", 6, 'x'),
+                  10,
+                  'X'))     /= "XXXXx abc "
+      then
+         Report.Failed("Incorrect result from Function Tail");
+      end if;
+
+
+
+      -- Function "*"  - with (Natural, Wide_String) parameters
+
+      TC_Set_Name ("""*""");
+
+      if TC_Check (ASW."*"(3, Source_String1))       /= "abcdeabcdeabcde"  or
+         TC_Check (ASW."*"(2, Source_String2))       /= Source_String6     or
+         TC_Check (ASW."*"(4, Source_String1(1..2))) /= "abababab"         or
+         TC_Check (ASW."*"(0, Source_String1))       /= ""
+      then
+         Report.Failed
+           ("Incorrect result from Function ""*"" with wide strings");
+      end if;
+
+   exception
+      when others => Report.Failed("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4016;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4017.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4017.a
new file mode 100644
index 000000000..8d6886897
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4017.a
@@ -0,0 +1,337 @@
+-- CXA4017.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 subprograms defined in package Ada.Strings.Wide_Bounded
+--      are available, and that they produce correct results.  Specifically,
+--      check the subprograms Append, Delete, Index, Insert , Length, 
+--      Overwrite, Replace_Slice, Slice, "&", To_Bounded_Wide_String, 
+--      To_Wide_String, Translate, and Trim.
+--      
+-- TEST DESCRIPTION:
+--      This test demonstrates the uses of a variety of the Wide_String 
+--      functions found in the package Ada.Strings.Wide_Bounded, simulating
+--      the operations found in a text processing environment.  
+--      With bounded wide strings, the length of each "line" of text can vary 
+--      up to the instantiated maximum, allowing one to view a page of text as
+--      a series of expandable lines.  This provides flexibility in text
+--      formatting of individual lines (wide strings).
+--      Several subprograms are defined, all of which attempt to take 
+--      advantage of as many different bounded wide string utilities as 
+--      possible.  Often, an operation that is being performed in a subprogram
+--      using a certain bounded wide string utility could more efficiently be 
+--      performed using a different utility.  However, in the interest of 
+--      including as broad coverage as possible, a mixture of utilities is
+--      invoked in this test.  
+--      A simulated page of text is provided as a parameter to the test 
+--      defined subprograms, and the appropriate processing performed.  The
+--      processed page of text is then compared to a predefined "finished"
+--      page, and test passage/failure is based on the results of this 
+--      comparison.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      06 Nov 95   SAIC    Corrected initialization error for ACVC 2.0.1.
+--
+--!
+
+with Ada.Strings;
+with Ada.Strings.Wide_Bounded;
+with Ada.Strings.Wide_Maps;
+with Report;
+
+procedure CXA4017 is
+
+begin
+
+   Report.Test ("CXA4017", "Check that the subprograms defined in package "  &
+                           "Ada.Strings.Wide_Bounded are available, and "    &
+                           "that they produce correct results");
+
+   Test_Block:
+   declare
+
+      Characters_Per_Line : constant Positive := 40;
+      Lines_Per_Page      : constant Natural  :=  4;
+
+
+      package BS_40 is new 
+        Ada.Strings.Wide_Bounded.Generic_Bounded_Length(Characters_Per_Line);
+
+      use type BS_40.Bounded_Wide_String;
+
+      type Page_Type is array (1..Lines_Per_Page) of 
+        BS_40.Bounded_Wide_String;
+
+      -- Note: Misspellings below are intentional.
+
+      Line1 : BS_40.Bounded_Wide_String := 
+        BS_40.To_Bounded_Wide_String
+                ("ada is a progrraming language designed");
+      Line2 : BS_40.Bounded_Wide_String := 
+        BS_40.To_Bounded_Wide_String("to support the construction of long-");
+      Line3 : BS_40.Bounded_Wide_String := 
+        BS_40.To_Bounded_Wide_String("lived, highly reliabel software ");
+      Line4 : BS_40.Bounded_Wide_String := 
+        BS_40.To_Bounded_Wide_String("systems");
+
+      Page  : Page_Type := (1 => Line1, 2 => Line2, 3 => Line3, 4 => Line4);
+
+      Finished_Page : Page_Type :=  
+        (BS_40.To_Bounded_Wide_String
+                 ("Ada is a programming language designed"),
+         BS_40.To_Bounded_Wide_String("to support the construction of long-"),
+         BS_40.To_Bounded_Wide_String
+                 ("lived, HIGHLY RELIABLE software systems."),
+         BS_40.To_Bounded_Wide_String(""));
+
+      ---
+
+      procedure Compress (Page : in out Page_Type) is
+         Clear_Line : Natural := Lines_Per_Page;
+      begin
+         -- If two consecutive lines on the page are together less than the
+         -- maximum line length, then append those two lines, move up all
+         -- lower lines on the page, and blank out the last line.
+         -- This algorithm works one time through the page, does not perform
+         -- repetitive compression, and is designed for use with this test
+         -- program only.
+         for i in 1..Lines_Per_Page - 1 loop
+            if BS_40.Length(Page(i)) + BS_40.Length(Page(i+1)) <=
+               BS_40.Max_Length
+            then
+               Page(i) := BS_40."&"(Page(i), 
+                                    Page(i+1));     -- "&" (wd bnd, wd bnd)
+
+               for j in i+1..Lines_Per_Page - 1 loop
+                  Page(j) := 
+                    BS_40.To_Bounded_Wide_String
+                      (BS_40.Slice(Page(j+1), 
+                                   1, 
+                                   BS_40.Length(Page(j+1))));
+                  Clear_Line := j + 1;
+               end loop;
+               Page(Clear_Line) := BS_40.Null_Bounded_Wide_String;
+            end if;
+         end loop;
+      end Compress;
+
+      ---
+
+      procedure Format (Page : in out Page_Type) is
+         Sm_Ada   : BS_40.Bounded_Wide_String := 
+                      BS_40.To_Bounded_Wide_String("ada");
+         Cap_Ada  : constant Wide_String := "Ada";
+         Char_Pos : Natural := 0;
+         Finished : Boolean := False;
+         Line     : Natural := Page_Type'Last;
+      begin
+
+         -- Add a period to the end of the last line.
+         while Line >= Page_Type'First and not Finished loop
+            if Page(Line) /= BS_40.Null_Bounded_Wide_String  and
+               BS_40.Length(Page(Line)) <= BS_40.Max_Length
+            then
+               Page(Line) := BS_40.Append(Page(Line), '.');
+               Finished := True;
+            end if;
+            Line := Line - 1;
+         end loop;
+
+         -- Replace all occurrences of "ada" with "Ada".
+         for Line in Page_Type'First .. Page_Type'Last loop
+            Finished := False;
+            while not Finished loop
+               Char_Pos := 
+                 BS_40.Index (Source  => Page(Line),
+                              Pattern => BS_40.To_Wide_String(Sm_Ada),
+                              Going   => Ada.Strings.Backward);
+               -- A zero is returned by function Index if no occurrences of
+               -- the pattern wide string are found.
+               Finished := (Char_Pos = 0);
+               if not Finished then
+                  BS_40.Replace_Slice
+                          (Source => Page(Line),
+                           Low    => Char_Pos,
+                           High   => Char_Pos + BS_40.Length(Sm_Ada) - 1,
+                           By     => Cap_Ada);
+               end if;
+            end loop;   -- while loop
+         end loop;      -- for loop
+
+      end Format;
+
+      ---
+
+      procedure Spell_Check (Page : in out Page_Type) is
+         type Spelling_Type is (Incorrect, Correct);
+         type Word_Array_Type is array (Spelling_Type) 
+           of BS_40.Bounded_Wide_String;
+         type Dictionary_Type is array (1..2) of Word_Array_Type;
+
+         -- Note that the "words" in the dictionary will require various
+         -- amounts of Trimming prior to their use in the bounded wide string
+         -- functions.
+         Dictionary : Dictionary_Type := 
+           (1 => (BS_40.To_Bounded_Wide_String("  reliabel          "),  
+                  BS_40.To_Bounded_Wide_String("       reliable   ")),
+            2 => (BS_40.To_Bounded_Wide_String("  progrraming  "),
+                  BS_40.To_Bounded_Wide_String(" programming ")));
+
+         Pos      : Natural := Natural'First;
+         Finished : Boolean := False;
+
+      begin
+
+         for Line in Page_Type'Range loop
+
+            -- Search for the first incorrectly spelled word in the 
+            -- Dictionary, if it is found, replace it with the correctly 
+            -- spelled word, using the Overwrite function.
+
+            while not Finished loop
+               Pos := 
+                 BS_40.Index(Page(Line),
+                             BS_40.To_Wide_String
+                               (BS_40.Trim(Dictionary(1)(Incorrect),
+                                           Ada.Strings.Both)),
+                             Ada.Strings.Forward);
+               Finished := (Pos = 0);
+               if not Finished then
+                  Page(Line) := 
+                    BS_40.Overwrite(Page(Line),
+                                    Pos,
+                                    BS_40.To_Wide_String
+                                      (BS_40.Trim(Dictionary(1)(Correct),
+                                                  Ada.Strings.Both)));
+               end if;
+            end loop;
+
+            Finished := False;
+
+            -- Search for the second incorrectly spelled word in the
+            -- Dictionary, if it is found, replace it with the correctly 
+            -- spelled word, using the Delete procedure and Insert function.
+
+            while not Finished loop
+               Pos := 
+                 BS_40.Index(Page(Line),
+                             BS_40.To_Wide_String(
+                               BS_40.Trim(Dictionary(2)(Incorrect),
+                                          Ada.Strings.Both)),
+                             Ada.Strings.Forward);
+
+               Finished := (Pos = 0);
+
+               if not Finished then
+                  BS_40.Delete
+                    (Page(Line),
+                     Pos,
+                     Pos + BS_40.To_Wide_String
+                             (BS_40.Trim(Dictionary(2)(Incorrect),
+                                         Ada.Strings.Both))'Length-1);
+                  Page(Line) := 
+                    BS_40.Insert(Page(Line),
+                                 Pos,
+                                 BS_40.To_Wide_String
+                                   (BS_40.Trim(Dictionary(2)(Correct),
+                                               Ada.Strings.Both)));
+               end if;
+            end loop;
+
+            Finished := False;
+
+         end loop;
+      end Spell_Check;
+
+      ---
+
+      procedure Bold (Page : in out Page_Type) is
+         Key_Word     : constant Wide_String := "highly reliable";
+         Bold_Mapping : constant 
+           Ada.Strings.Wide_Maps.Wide_Character_Mapping :=
+             Ada.Strings.Wide_Maps.To_Mapping
+               (From => " abcdefghijklmnopqrstuvwxyz",
+                To   => " ABCDEFGHIJKLMNOPQRSTUVWXYZ");
+         Pos      : Natural := Natural'First;
+         Finished : Boolean := False;
+      begin
+         -- This procedure is designed to change the case of the phrase
+         -- "highly reliable" into upper case (a type of "Bolding").
+         -- All instances of the phrase on all lines of the page will be
+         -- modified.
+
+         for Line in Page_Type'First .. Page_Type'Last loop
+            while not Finished loop
+               Pos := BS_40.Index(Page(Line), Key_Word);
+               Finished := (Pos = 0);
+               if not Finished then
+
+                  BS_40.Overwrite
+                         (Page(Line),
+                          Pos,
+                          BS_40.To_Wide_String
+                            (BS_40.Translate
+                               (BS_40.To_Bounded_Wide_String
+                                   (BS_40.Slice(Page(Line),
+                                                Pos,  
+                                                Pos + Key_Word'Length - 1)),
+                                Bold_Mapping)));
+
+               end if;
+            end loop;
+            Finished := False;
+         end loop;
+      end Bold;
+
+
+   begin
+
+      Compress(Page);
+      Format(Page); 
+      Spell_Check(Page);
+      Bold(Page);
+
+      for i in 1..Lines_Per_Page loop
+         if BS_40.To_Wide_String(Page(i))          /= 
+            BS_40.To_Wide_String(Finished_Page(i))    or
+            BS_40.Length(Page(i))                  /= 
+            BS_40.Length(Finished_Page(i))            
+         then
+            Report.Failed("Incorrect modification of Page, Line " &
+                           Integer'Image(i));
+         end if;
+      end loop;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4017;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4018.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4018.a
new file mode 100644
index 000000000..98e0ded4a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4018.a
@@ -0,0 +1,379 @@
+-- CXA4018.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 subprograms defined in package 
+--      Ada.Strings.Wide_Bounded are available, and that they produce 
+--      correct results. Specifically, check the subprograms Append, 
+--      Count, Element, Find_Token, Head, Index_Non_Blank, Replace_Element, 
+--      Replicate, Tail, To_Bounded_Wide_String, "&", ">", "<", ">=", "<=", 
+--      and "*".
+--      
+-- TEST DESCRIPTION:
+--      This test, when taken in conjunction with test CXA40[17,19,20], will 
+--      constitute a test of all the functionality contained in package
+--      Ada.Strings.Wide_Bounded.  This test uses a variety of the
+--      subprograms defined in the wide bounded string package in ways typical
+--      of common usage.  Different combinations of available subprograms
+--      are used to accomplish similar wide bounded string processing goals.
+--
+--      
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      22 Dec 94   SAIC    Changed obsolete constant to Strings.Wide_Space.
+--      06 Nov 95   SAIC    Corrected evaluation string used in Head/Tail
+--                          subtests for ACVC 2.0.1.
+--
+--!
+
+with Ada.Strings;
+with Ada.Strings.Wide_Bounded;
+with Ada.Characters.Handling;
+with Ada.Strings.Wide_Maps;
+with Report;
+
+procedure CXA4018 is
+
+   -- The following two functions are used to translate character and string
+   -- values to "Wide" values.  They will be applied to all the Wide_Bounded
+   -- subprogram parameters to simulate the use of Wide_Characters and 
+   -- Wide_Strings in actual practice. Blanks are translated to Wide_Character
+   -- blanks and all other characters are translated into Wide_Characters with
+   -- position values 256 greater than their (narrow) character position
+   -- values.
+
+   function Translate (Ch : Character) return Wide_Character is
+      C : Character := Ch;
+   begin
+      if Ch = ' ' then
+         return Ada.Characters.Handling.To_Wide_Character(C);
+      else
+         return Wide_Character'Val(Character'Pos(Ch) + 
+                                   Character'Pos(Character'Last) + 1);
+      end if;
+   end Translate;
+
+   function Translate (Str : String) return Wide_String is
+      WS : Wide_String(Str'First..Str'Last);
+   begin
+      for i in Str'First..Str'Last loop
+         WS(i) := Translate(Str(i));
+      end loop;
+      return WS;
+   end Translate;
+
+
+begin
+
+   Report.Test ("CXA4018", "Check that the subprograms defined in package " &
+                           "Ada.Strings.Wide_Bounded are available, and "   &
+                           "that they produce correct results");
+
+   Test_Block:
+   declare
+
+      package BS80 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(80);
+      use type BS80.Bounded_Wide_String;
+
+      Part1 : constant Wide_String     := Translate("Rum");
+      Part2 : Wide_Character           := Translate('p');
+      Part3 : BS80.Bounded_Wide_String := 
+                BS80.To_Bounded_Wide_String(Translate("el"));
+      Part4 : Wide_Character           := Translate('s');
+      Part5 : BS80.Bounded_Wide_String := 
+                BS80.To_Bounded_Wide_String(Translate("tilt"));
+      Part6 : Wide_String(1..3)        := Translate("ski");
+
+      Full_Catenate_String,
+      Full_Append_String,  
+      Constructed_String,   
+      Drop_String,
+      Replicated_String,     
+      Token_String         : BS80.Bounded_Wide_String;
+
+      CharA : Wide_Character := Translate('A');
+      CharB : Wide_Character := Translate('B');
+      CharC : Wide_Character := Translate('C');
+      CharD : Wide_Character := Translate('D');
+      CharE : Wide_Character := Translate('E');
+      CharF : Wide_Character := Translate('F');
+
+      ABStr : Wide_String(1..15) := Translate("AAAAABBBBBBBBBB");
+      StrB  : Wide_String(1..2)  := Translate("BB");
+      StrE  : Wide_String(1..2)  := Translate("EE");
+
+
+   begin
+
+      -- Evaluation of the overloaded forms of the "&" operator.
+
+      Full_Catenate_String := 
+        BS80."&"(Part2,                            -- WChar & Bnd WStr
+                 BS80."&"(Part3,                   -- Bnd WStr & Bnd WStr
+                          BS80."&"(Part4,          -- WChar & Bnd WStr
+                                   BS80."&"(Part5, -- Bnd WStr & Bnd WStr
+                                            BS80.To_Bounded_Wide_String
+                                              (Part6)))));  
+                                                 
+      Full_Catenate_String := 
+        BS80."&"(Part1, Full_Catenate_String);     -- WStr & Bnd WStr
+      Full_Catenate_String := 
+        BS80."&"(Left  => Full_Catenate_String, 
+                 Right => Translate('n'));         -- Bnd WStr & WChar
+
+
+      -- Evaluation of the overloaded forms of function Append.
+
+      Full_Append_String := 
+        BS80.Append(Part2,                               -- WChar,Bnd WStr
+          BS80.Append(Part3,                             -- Bnd WStr, Bnd WStr
+            BS80.Append(Part4,                           -- WChar,Bnd WStr
+              BS80.Append(BS80.To_Wide_String(Part5),    -- WStr,Bnd WStr
+                BS80.To_Bounded_Wide_String(Part6)))));
+
+      Full_Append_String := 
+        BS80.Append(BS80.To_Bounded_Wide_String(Part1),  -- Bnd WStr, WStr
+                    BS80.To_Wide_String(Full_Append_String));
+
+      Full_Append_String := 
+        BS80.Append(Left  => Full_Append_String, 
+                    Right => Translate('n'));             -- Bnd WStr, WChar
+
+
+      -- Validate the resulting bounded wide strings.
+
+      if BS80."<"(Full_Catenate_String, Full_Append_String) or
+         BS80.">"(Full_Catenate_String, Full_Append_String) or
+         not (Full_Catenate_String  = Full_Append_String and
+              BS80."<="(Full_Catenate_String, Full_Append_String) and
+              BS80.">="(Full_Catenate_String, Full_Append_String))
+      then
+         Report.Failed
+           ("Incorrect results from bounded wide string catenation" &
+            " and comparison");
+      end if;
+
+
+      -- Evaluate the overloaded forms of the Constructor function "*" and 
+      -- the Replicate function.
+
+      Constructed_String := 
+        BS80."*"(2,CharA) &                     -- "AA"
+        BS80."*"(2,StrB) &                      -- "AABBBB"
+        BS80."*"(3, BS80."*"(2, CharC)) &       -- "AABBBBCCCCCC"
+        BS80.Replicate(3, 
+                   BS80.Replicate(2, CharD)) &  -- "AABBBBCCCCCCDDDDDD"
+        BS80.Replicate(2, StrE) &               -- "AABBBBCCCCCCDDDDDDEEEE"
+        BS80.Replicate(2, CharF);               -- "AABBBBCCCCCCDDDDDDEEEEFF"
+
+
+      -- Use of Function Replicate that involves dropping wide characters.
+      -- The attempt to replicate the 15 character wide string six times will
+      -- exceed the 80 wide character bound of the wide string.  Therefore, 
+      -- the result should be the catenation of 5 copies of the 15 character 
+      -- wide string, followed by 5 'A' wide characters (the first five wide 
+      -- characters of the 6th replication) with the remaining wide 
+      -- characters of the 6th replication dropped.
+
+      Drop_String := 
+         BS80.Replicate(Count => 6,                   
+                        Item  => ABStr,              -- "AAAAABBBBBBBBBB"
+                        Drop  => Ada.Strings.Right); 
+
+      if BS80.Element(Drop_String, 1)  /= Translate('A') or
+         BS80.Element(Drop_String, 6)  /= Translate('B') or
+         BS80.Element(Drop_String, 76) /= Translate('A') or
+         BS80.Element(Drop_String, 80) /= Translate('A') 
+      then
+         Report.Failed("Incorrect result from Replicate with Drop");
+      end if;
+
+
+      -- Use function Index_Non_Blank in the evaluation of the
+      -- Constructed_String.
+
+      if BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Forward)  /=
+         BS80.To_Wide_String(Constructed_String)'First                    or
+         BS80.Index_Non_Blank(Constructed_String, Ada.Strings.Backward) /=
+         BS80.Length(Constructed_String)
+      then
+         Report.Failed("Incorrect results from constructor functions");
+      end if;
+
+
+
+      declare
+
+         -- Define wide character set objects for use with the Count function.
+         -- Constructed_String = "AABBBBCCCCCCDDDDDDEEEEFF" from above.
+
+         A_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
+                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
+                                                           1));
+         B_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
+                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
+                                                           3));
+         C_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
+                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
+                                                           7));
+         D_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
+                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
+                                                           13));
+         E_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
+                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
+                                                           19));
+         F_Set : Ada.Strings.Wide_Maps.Wide_Character_Set :=
+                 Ada.Strings.Wide_Maps.To_Set(BS80.Element(Constructed_String,
+                                                           23));
+         Start : Positive;
+         Stop  : Natural  := 0;
+
+      begin
+
+         -- Evaluate the results from function Count by comparing the number
+         -- of A's to the number of F's, B's to E's, and C's to D's in the
+         -- Constructed_String.  
+         -- There should be an equal number of each of the wide characters that 
+         -- are being compared (i.e., 2 A's and F's, 4 B's and E's, etc)
+
+         if BS80.Count(Constructed_String, A_Set)      /= 
+            BS80.Count(Constructed_String, F_Set)        or
+            BS80.Count(Constructed_String, B_Set)      /= 
+            BS80.Count(Constructed_String, E_Set)        or
+            not (BS80.Count(Constructed_String, C_Set)  =  
+                 BS80.Count(Constructed_String, D_Set))  
+         then
+            Report.Failed("Incorrect result from function Count");
+         end if;
+
+
+         -- Evaluate the functions Head, Tail, and Find_Token.
+         -- Create the Token_String from the Constructed_String above.
+
+         Token_String := 
+           BS80.Tail(BS80.Head(Constructed_String,  3), 2) &     -- "AB" &
+           BS80.Head(BS80.Tail(Constructed_String, 13), 2) &     -- "CD" &
+           BS80.Head(BS80.Tail(Constructed_String,  3), 2);      -- "EF"
+
+         if Token_String /= 
+            BS80.To_Bounded_Wide_String(Translate("ABCDEF")) then
+            Report.Failed("Incorrect result from Catenation of Token_String");
+         end if;
+
+
+         -- Find the starting/ending position of the first A in the 
+         -- Token_String (both should be 1, only one A appears in string).
+         -- The Function Head uses the default pad character to return a
+         -- bounded wide string longer than its input parameter bounded 
+         -- wide string.
+
+         BS80.Find_Token(BS80.Head(Token_String, 10),  -- Default pad.
+                         A_Set,
+                         Ada.Strings.Inside,
+                         Start,
+                         Stop);
+
+         if Start /= 1 and Stop /= 1 then
+            Report.Failed("Incorrect result from Find_Token - 1");
+         end if;
+
+
+         -- Find the starting/ending position of the first non-AB slice in
+         -- the "head" five wide characters of Token_String (slice CDE at 
+         -- positions 3-5)
+
+         BS80.Find_Token(BS80.Head(Token_String, 5),               -- "ABCDE"
+                         Ada.Strings.Wide_Maps."OR"(A_Set, B_Set), -- Set (AB)
+                         Ada.Strings.Outside,
+                         Start,
+                         Stop);
+
+         if Start /= 3 and Stop /= 5 then
+            Report.Failed("Incorrect result from Find_Token - 2");
+         end if;
+
+
+         -- Find the starting/ending position of the first CD slice in
+         -- the "tail" eight wide characters (including two pad wide 
+         -- characters) of Token_String (slice CD at positions 5-6 of 
+         -- the tail portion specified)
+
+         BS80.Find_Token(BS80.Tail(Token_String, 8, 
+                                   Ada.Strings.Wide_Space), 
+                         Ada.Strings.Wide_Maps."OR"(C_Set, D_Set),
+                         Ada.Strings.Inside,
+                         Start,
+                         Stop);
+
+         if Start /= 5 and Stop /= 6 then
+            Report.Failed("Incorrect result from Find_Token - 3");
+         end if;
+
+
+         -- Evaluate the Replace_Element function.
+
+         -- Token_String = "ABCDEF"
+
+         BS80.Replace_Element(Token_String, 3, BS80.Element(Token_String,4));
+
+         -- Token_String = "ABDDEF"
+
+         BS80.Replace_Element(Source => Token_String,
+                              Index  => 2,
+                              By     => BS80.Element(Token_String, 5));
+
+         -- Token_String = "AEDDEF"
+
+         BS80.Replace_Element(Token_String, 
+                              1, 
+                              BS80.Element(BS80.Tail(Token_String, 2), 2));
+
+         -- Token_String = "FEDDEF"
+         -- Evaluate this result.
+
+         if BS80.Element(Token_String, 
+                         BS80.To_Wide_String(Token_String)'First)  /=
+            BS80.Element(Token_String, 
+                         BS80.To_Wide_String(Token_String)'Last)     or
+            BS80.Count(Token_String, D_Set)                        /=
+            BS80.Count(Token_String, E_Set)                          or
+            BS80.Index_Non_Blank(BS80.Head(Token_String,6))        /=
+            BS80.Index_Non_Blank(BS80.Tail(Token_String,6))          or
+            BS80.Head(Token_String, 1)                             /=
+            BS80.Tail(Token_String, 1)
+         then
+            Report.Failed("Incorrect result from operations in combination");
+         end if;
+
+      end;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4018;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4019.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4019.a
new file mode 100644
index 000000000..943e3e73b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4019.a
@@ -0,0 +1,1027 @@
+-- CXA4019.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 subprograms defined in package Ada.Strings.Wide_Bounded
+--      are available, and that they produce correct results, especially 
+--      under conditions where truncation of the result is required.  
+--      Specifically, check the subprograms Append, Count with non-Identity
+--      maps, Index with non-Identity maps, Index with Set parameters, 
+--      Insert (function and procedure), Replace_Slice (function and 
+--      procedure), To_Bounded_Wide_String, and Translate (function and 
+--      procedure).
+--
+-- TEST DESCRIPTION:
+--      This test, in conjunction with tests CXA4017, CXA4018, and CXA4020, 
+--      will provide coverage of the most common usages of the functionality
+--      found in the Ada.Strings.Wide_Bounded package.  It deals in large part
+--      with truncation effects and options.  This test contains many small, 
+--      specific test cases, situations that are often difficult to generate 
+--      in large numbers in an application-based test.  These cases represent 
+--      specific usage paradigms in-the-small.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      06 Nov 95   SAIC    Corrected expected result string in subtest for
+--                          ACVC 2.0.1.
+--                          Moved function Dog_to_Cat_Mapping to library
+--                          level to correct accessibility problem in test.
+--      22 Aug 96   SAIC    Corrected three subtests identified in reviewer
+--                          comments.
+--      17 Feb 97   PWB.CTA Corrected result strings for Translate and Insert
+--
+--!
+
+package CXA40190 is
+
+   -- Wide Character mapping function defined for use with specific 
+   -- versions of functions Index and Count.
+
+   function Dog_to_Cat_Mapping (From : Wide_Character) 
+        return Wide_Character;
+
+end CXA40190;
+
+package body CXA40190 is
+
+   -- Translates "dog" to "cat".
+   function Dog_to_Cat_Mapping (From : Wide_Character) 
+     return Wide_Character is
+   begin
+      if From = 'd' then
+         return 'c';
+      elsif From = 'o' then
+         return 'a';
+      elsif From = 'g' then
+         return 't';
+      else
+         return From;
+      end if;
+   end Dog_to_Cat_Mapping;
+
+end CXA40190;
+
+
+with CXA40190;
+with Report;
+with Ada.Characters.Handling;
+with Ada.Strings.Wide_Bounded;
+with Ada.Strings.Wide_Maps;
+with Ada.Strings.Wide_Maps.Wide_Constants;
+
+procedure CXA4019 is
+
+   -- The following two functions are used to translate character and string 
+   -- values to "Wide" values.  They will be applied to all the Wide_Bounded
+   -- subprogram parameters to simulate the use of Wide_Characters and 
+   -- Wide_Strings in actual practice.
+
+   function Equiv (Ch : Character) return Wide_Character is
+      C : Character := Ch;
+   begin
+      if Ch = ' ' then
+         return Ada.Characters.Handling.To_Wide_Character(C);
+      else
+         return Wide_Character'Val(Character'Pos(Ch) + 
+                Character'Pos(Character'Last) + 1);
+      end if;
+   end Equiv;
+
+
+   function Equiv (Str : String) return Wide_String is
+      WS : Wide_String(Str'First..Str'Last);
+   begin
+      for i in Str'First..Str'Last loop
+         WS(i) := Equiv(Str(i));
+      end loop;
+      return WS;
+   end Equiv;
+
+begin
+
+   Report.Test("CXA4019", "Check that the subprograms defined in "      &
+                          "package Ada.Strings.Wide_Bounded are "       &
+                          "available, and that they produce correct "   &
+                          "results, especially under conditions where " &
+                          "truncation of the result is required");
+
+   Test_Block:
+   declare
+
+      use CXA40190;
+
+      package AS   renames Ada.Strings;
+      package ASB  renames Ada.Strings.Wide_Bounded;
+      package ASWC renames Ada.Strings.Wide_Maps.Wide_Constants;
+      package Maps renames Ada.Strings.Wide_Maps;
+
+      package B10 is new ASB.Generic_Bounded_Length(Max => 10);
+      use type B10.Bounded_Wide_String;
+
+      Result_String : B10.Bounded_Wide_String;
+      Test_String   : B10.Bounded_Wide_String;
+      AtoE_Bnd_Str  : B10.Bounded_Wide_String := 
+                        B10.To_Bounded_Wide_String(Equiv("abcde"));
+      FtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
+                        B10.To_Bounded_Wide_String(Equiv("fghij"));
+      AtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
+                        B10.To_Bounded_Wide_String(Equiv("abcdefghij"));
+
+      Location     : Natural := 0;
+      Total_Count  : Natural := 0;
+
+      CD_Set       : Maps.Wide_Character_Set := Maps.To_Set("cd"); 
+      Wide_CD_Set  : Maps.Wide_Character_Set := Maps.To_Set(Equiv("cd")); 
+
+      AB_to_YZ_Map : Maps.Wide_Character_Mapping :=
+                     Maps.To_Mapping(From => "ab", To => "yz");
+
+      Wide_AB_to_YZ_Map : Maps.Wide_Character_Mapping :=
+                          Maps.To_Mapping(From => Equiv("ab"),  
+                                          To   => Equiv("yz"));
+
+      CD_to_XY_Map : Maps.Wide_Character_Mapping :=
+                       Maps.To_Mapping(From => "cd", To => "xy");
+
+      Wide_CD_to_XY_Map : Maps.Wide_Character_Mapping :=
+                          Maps.To_Mapping(From => Equiv("cd"),  
+                                          To   => Equiv("xy"));
+
+
+      -- Access-to-Subprogram object defined for use with specific versions of 
+      -- functions Index, Count Translate, and procedure Translate.
+
+      Map_Ptr : Maps.Wide_Character_Mapping_Function := 
+                  Dog_to_Cat_Mapping'Access;
+
+
+
+   begin
+
+      -- Function To_Bounded_Wide_String with Truncation 
+      -- Evaluate the function Append with parameters that will 
+      -- cause the truncation of the result.
+
+      -- Drop = Error (default case, Length_Error will be raised)
+
+      begin
+         Test_String := 
+           B10.To_Bounded_Wide_String
+             (Equiv("Much too long for this bounded wide string"));
+         Report.Failed("Length Error not raised by To_Bounded_Wide_String");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          =>
+           Report.Failed
+            ("Incorrect exception raised by To_Bounded_Wide_String");
+      end;
+
+      -- Drop = Left 
+
+      Test_String := 
+        B10.To_Bounded_Wide_String(Source => Equiv("abcdefghijklmn"),
+                                   Drop   => Ada.Strings.Left);
+
+      if Test_String /= B10.To_Bounded_Wide_String(Equiv("efghijklmn")) then
+         Report.Failed
+           ("Incorrect result from To_Bounded_Wide_String, Drop = Left");
+      end if;
+
+      -- Drop = Right 
+
+      Test_String := 
+        B10.To_Bounded_Wide_String(Source => Equiv("abcdefghijklmn"),
+                                   Drop   => Ada.Strings.Right);
+
+      if not(Test_String = AtoJ_Bnd_Str) then
+         Report.Failed
+           ("Incorrect result from To_Bounded_Wide_String, Drop = Right");
+      end if;
+
+
+
+
+      -- Function Append with Truncation 
+      -- Evaluate the function Append with parameters that will 
+      -- cause the truncation of the result.
+
+      -- Drop = Error (default case, Length_Error will be raised)
+
+      begin
+         -- Append (Bnd Str, Bnd Str);
+         Result_String := 
+           B10.Append(B10.To_Bounded_Wide_String(Equiv("abcde")),
+                      B10.To_Bounded_Wide_String(Equiv("fghijk"))); -- 11 char
+         Report.Failed("Length_Error not raised by Append - 1");
+      exception
+         when AS.Length_Error => null;   -- OK, correct exception raised.
+         when others          =>
+            Report.Failed("Incorrect exception raised by Append - 1");
+      end;
+
+      begin
+         -- Append (Str, Bnd Str);
+         Result_String := 
+           B10.Append(B10.To_Wide_String(AtoE_Bnd_Str),
+                      B10.To_Bounded_Wide_String(Equiv("fghijk")), 
+                      AS.Error); 
+         Report.Failed("Length_Error not raised by Append - 2");
+      exception
+         when AS.Length_Error => null;   -- OK, correct exception raised.
+         when others          =>
+            Report.Failed("Incorrect exception raised by Append - 2");
+      end;
+
+      begin
+         -- Append (Bnd Str, Char);
+         Result_String := 
+           B10.Append(B10.To_Bounded_Wide_String("abcdefghij"), 'k');
+         Report.Failed("Length_Error not raised by Append - 3");
+      exception
+         when AS.Length_Error => null;   -- OK, correct exception raised.
+         when others          =>
+            Report.Failed("Incorrect exception raised by Append - 3");
+      end;
+
+      -- Drop = Left 
+
+      -- Append (Bnd Str, Bnd Str)
+      Result_String := 
+        B10.Append(B10.To_Bounded_Wide_String(Equiv("abcdefgh")), -- 8 chs
+                   B10.To_Bounded_Wide_String(Equiv("ijklmn")),   -- 6 chs
+                   Ada.Strings.Left);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Equiv("efghijklmn"))  -- 10 chars
+      then
+         Report.Failed("Incorrect truncation performed by Append - 4");
+      end if;
+
+      -- Append (Bnd Str, Str)
+      Result_String := 
+        B10.Append(B10.To_Bounded_Wide_String("abcdefghij"), 
+                   "xyz",
+                   Ada.Strings.Left);
+
+      if Result_String /= B10.To_Bounded_Wide_String("defghijxyz") then
+         Report.Failed("Incorrect truncation performed by Append - 5");
+      end if;
+
+      -- Append (Char, Bnd Str)
+
+      Result_String := 
+        B10.Append(Equiv('A'), 
+                   B10.To_Bounded_Wide_String(Equiv("abcdefghij")),
+                   Ada.Strings.Left);
+
+      if Result_String /= B10.To_Bounded_Wide_String(Equiv("abcdefghij")) 
+      then
+         Report.Failed("Incorrect truncation performed by Append - 6");
+      end if;
+
+      -- Drop = Right 
+
+      -- Append (Bnd Str, Bnd Str)
+      Result_String := B10.Append(FtoJ_Bnd_Str, 
+                                  AtoJ_Bnd_Str,
+                                  Ada.Strings.Right);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Equiv("fghijabcde")) 
+      then
+         Report.Failed("Incorrect truncation performed by Append - 7");
+      end if;
+
+      -- Append (Str, Bnd Str)
+      Result_String := B10.Append(B10.To_Wide_String(AtoE_Bnd_Str), 
+                                  AtoJ_Bnd_Str,
+                                  Ada.Strings.Right);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Equiv("abcdeabcde")) 
+      then
+         Report.Failed("Incorrect truncation performed by Append - 8");
+      end if;
+
+      -- Append (Char, Bnd Str)
+      Result_String := B10.Append(Equiv('A'), AtoJ_Bnd_Str, Ada.Strings.Right);
+
+      if Result_String /= B10.To_Bounded_Wide_String(Equiv("Aabcdefghi")) then
+         Report.Failed("Incorrect truncation performed by Append - 9");
+      end if;
+
+
+
+      -- Function Index with non-Identity map. 
+      -- Evaluate the function Index with a non-identity map 
+      -- parameter which will cause mapping of the source parameter 
+      -- prior to the evaluation of the index position search.
+
+      Location := 
+        B10.Index(Source  => B10.To_Bounded_Wide_String("foxy fox 2"),
+                  Pattern => "FOX",
+                  Going   => Ada.Strings.Backward,
+                  Mapping => ASWC.Upper_Case_Map);
+
+      if Location /= 6 then
+         Report.Failed("Incorrect result from Index, non-Identity map - 1");
+      end if;
+
+      Location := 
+        B10.Index(B10.To_Bounded_Wide_String("THE QUICK "),
+                  "quick",
+                  Ada.Strings.Forward,
+                  Ada.Strings.Wide_Maps.Wide_Constants.Lower_Case_Map);
+
+      if Location /= 5 then
+         Report.Failed("Incorrect result from Index, non-Identity map - 2");
+      end if;
+
+      Location := B10.Index(Source  => B10.To_Bounded_Wide_String("The the"),
+                            Pattern => "the",
+                            Going   => Ada.Strings.Forward,
+                            Mapping => ASWC.Lower_Case_Map); 
+
+      if Location /= 1 then
+         Report.Failed("Incorrect result from Index, non-Identity map - 3");
+      end if;
+
+
+
+      if B10.Index(B10.To_Bounded_Wide_String("abcd"),   -- Pattern = Source
+                   "abcd")                       /= 1 or
+         B10.Index(B10.To_Bounded_Wide_String("abc"),    -- Pattern < Source
+                   "abcd")                       /= 0 or
+         B10.Index(B10.Null_Bounded_Wide_String,         -- Source = Null
+                   "abc")                        /= 0 
+      then
+         Report.Failed("Incorrect result from Index with string patterns");
+      end if;
+
+
+
+      -- Function Index with access-to-subprogram mapping value. 
+      -- Evaluate the function Index with a wide character mapping function
+      -- object that performs the mapping operation.
+
+      Location := B10.Index(Source  => B10.To_Bounded_Wide_String("My dog"),
+                            Pattern => "cat",
+                            Going   => Ada.Strings.Forward,
+                            Mapping => Map_Ptr);  -- change "dog" to "cat"
+
+      if Location /= 4 then
+         Report.Failed("Incorrect result from Index, w/map ptr - 1");
+      end if;
+
+      Location := B10.Index(B10.To_Bounded_Wide_String("cat or dog"),
+                            "cat",
+                            Ada.Strings.Backward,
+                            Map_Ptr);   
+
+      if Location /= 8 then
+         Report.Failed("Incorrect result from Index, w/map ptr - 2");
+      end if;
+
+      if B10.Index(B10.To_Bounded_Wide_String("dog"),   -- Pattern = Source
+                   "cat",
+                   Ada.Strings.Forward,
+                   Map_Ptr)                            /= 1 or
+         B10.Index(B10.To_Bounded_Wide_String("dog"),    -- Pattern < Source
+                   "cats",
+                   Ada.Strings.Backward,
+                   Map_Ptr)                            /= 0 or
+         B10.Index(B10.Null_Bounded_Wide_String,         -- Source = Null
+                   "cat",
+                   Ada.Strings.Forward,
+                   Map_Ptr)                            /= 0 or
+         B10.Index(B10.To_Bounded_Wide_String("hot dog"),
+                   "dog",
+                   Ada.Strings.Backward,
+                   Map_Ptr)                            /= 0 or
+         B10.Index(B10.To_Bounded_Wide_String(" cat dog "),
+                   " cat",
+                   Ada.Strings.Backward,
+                   Map_Ptr)                           /= 5 or
+         B10.Index(B10.To_Bounded_Wide_String("dog CatDog"),
+                   "cat",
+                   Ada.Strings.Backward,
+                   Map_Ptr)                           /= 1 or
+         B10.Index(B10.To_Bounded_Wide_String("CatandDog"),
+                   "cat",
+                   Ada.Strings.Forward,
+                   Map_Ptr)                           /= 0 or
+         B10.Index(B10.To_Bounded_Wide_String("dddd"),
+                   "ccccc",
+                   Ada.Strings.Backward,
+                   Map_Ptr)                           /= 0
+      then
+         Report.Failed("Incorrect result from Index w/map ptr - 3");
+      end if;
+
+
+
+      -- Function Index (for Sets).           
+      -- This version of Index uses Sets as the basis of the search.
+
+      -- Test = Inside, Going = Forward  (Default case).
+      Location := 
+        B10.Index(Source => B10.To_Bounded_Wide_String(Equiv("abcdeabcde")),
+                  Set    => Wide_CD_Set, 
+                  Test   => Ada.Strings.Inside,
+                  Going  => Ada.Strings.Forward);
+
+      if not (Location = 3) then -- position of first 'c' equivalent in source.
+         Report.Failed("Incorrect result from Index using Sets - 1");
+      end if;
+
+      -- Test = Inside, Going = Backward.
+      Location := 
+        B10.Index(Source => B10."&"(AtoE_Bnd_Str, AtoE_Bnd_Str), 
+                  Set    => Wide_CD_Set, 
+                  Test   => Ada.Strings.Inside,
+                  Going  => Ada.Strings.Backward);
+
+      if not (Location = 9) then   -- position of last 'd' in source.
+         Report.Failed("Incorrect result from Index using Sets - 2");
+      end if;
+
+      -- Test = Outside, Going = Forward.
+      Location := B10.Index(B10.To_Bounded_Wide_String("deddacd"),  
+                            CD_Set,
+                            Test  => Ada.Strings.Outside,
+                            Going => Ada.Strings.Forward);
+
+      if Location /= 2  then  -- position of 'e' in source.
+         Report.Failed("Incorrect result from Index using Sets - 3");
+      end if;
+
+      -- Test = Outside, Going = Backward.
+      Location := B10.Index(B10.To_Bounded_Wide_String(Equiv("deddacd")),
+                            Wide_CD_Set,
+                            Ada.Strings.Outside,
+                            Ada.Strings.Backward);
+
+      if Location /= 5 then    -- position of 'a', correct.
+         Report.Failed("Incorrect result from Index using Sets - 4");
+      end if;
+
+      if B10.Index(B10.To_Bounded_Wide_String("cd"),   -- Source = Set
+                   CD_Set)                     /= 1 or
+         B10.Index(B10.To_Bounded_Wide_String("c"),    -- Source < Set
+                   CD_Set)                     /= 1 or
+         B10.Index(B10.Null_Bounded_Wide_String,       -- Source = Null
+                   Wide_CD_Set)                /= 0 or
+         B10.Index(AtoE_Bnd_Str,
+                   Maps.To_Set('x'))           /= 0    -- No match.
+      then
+         Report.Failed("Incorrect result from Index using Sets - 5");
+      end if;
+
+
+
+      -- Function Count with non-Identity mapping. 
+      -- Evaluate the function Count with a non-identity map 
+      -- parameter which will cause mapping of the source parameter 
+      -- prior to the evaluation of the number of matching patterns.
+
+      Total_Count := 
+        B10.Count(Source  => B10.To_Bounded_Wide_String("THE THE TH"),
+                  Pattern => "th",
+                  Mapping => ASWC.Lower_Case_Map);
+
+      if Total_Count /= 3 then    
+         Report.Failed
+           ("Incorrect result from function Count, non-Identity map - 1");
+      end if;
+
+      -- And a few with identity maps as well.
+
+      if B10.Count(B10.To_Bounded_Wide_String(Equiv("ABABABABAB")),
+                   Equiv("ABA"),
+                   Maps.Identity)                       /= 2 or
+         B10.Count(B10.To_Bounded_Wide_String("ADCBADABCD"),
+                   "AB",
+                   Maps.To_Mapping("CD", "AB"))         /= 5 or
+         B10.Count(B10.To_Bounded_Wide_String(Equiv("aaaaaaaaaa")),
+                   Equiv("aaa"))                        /= 3 or
+         B10.Count(B10.To_Bounded_Wide_String(Equiv("XX")),
+                   Equiv("XXX"),
+                   Maps.Identity)                       /= 0 or
+         B10.Count(AtoE_Bnd_Str,                        -- Source = Pattern
+                   Equiv("abcde"))                      /= 1 or
+         B10.Count(B10.Null_Bounded_Wide_String,        -- Source = Null
+                   " ")                                 /= 0
+      then
+         Report.Failed
+           ("Incorrect result from function Count, w,w/o mapping");
+      end if;
+                                         
+
+
+
+
+      -- Function Count with access-to-subprogram mapping. 
+      -- Evaluate the version function Count that uses an access-to-subprogram
+      -- map parameter.
+
+      Total_Count := 
+        B10.Count(Source  => B10.To_Bounded_Wide_String("dogdogdo"),
+                  Pattern => "ca",
+                  Mapping => Map_Ptr);
+
+      if Total_Count /= 3 then    
+         Report.Failed
+           ("Incorrect result from function Count, w/map ptr - 1");
+      end if;
+
+
+      if B10.Count(B10.To_Bounded_Wide_String("DdOoGgod"),
+                   "c",
+                   Map_Ptr)                                 /= 2 or
+         B10.Count(B10.To_Bounded_Wide_String("dododododo"),
+                   "do",
+                   Map_Ptr)                                 /= 0 or
+         B10.Count(B10.To_Bounded_Wide_String("Dog or dog"),
+                   "cat",
+                   Map_Ptr)                                 /= 1 or
+         B10.Count(B10.To_Bounded_Wide_String("dddddddddd"),
+                   "ccccc",
+                   Map_Ptr)                                 /= 2 or
+         B10.Count(B10.To_Bounded_Wide_String("do"),    -- Source < Pattern
+                   "cat",
+                   Map_Ptr)                                 /= 0 or
+         B10.Count(B10.To_Bounded_Wide_String(" dog "), -- Source = Pattern
+                   " cat ",
+                   Map_Ptr)                                 /= 1 or
+         B10.Count(B10.Null_Bounded_Wide_String,        -- Source = Null
+                   " ",
+                   Map_Ptr)                                 /= 0
+      then
+         Report.Failed
+           ("Incorrect result from function Count, w/map ptr - 2");
+      end if;
+
+
+
+
+      -- Procedure Translate   
+
+      -- Partial mapping of source.
+
+      Test_String := B10.To_Bounded_Wide_String("abcdeabcab");
+
+      B10.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
+
+      if Test_String /= B10.To_Bounded_Wide_String("yzcdeyzcyz") then
+         Report.Failed("Incorrect result from procedure Translate - 1");
+      end if;
+
+      -- Total mapping of source.
+
+      Test_String := B10.To_Bounded_Wide_String("abbaaababb");
+
+      B10.Translate(Source => Test_String, Mapping => ASWC.Upper_Case_Map);
+
+      if Test_String /= B10.To_Bounded_Wide_String("ABBAAABABB") then
+         Report.Failed("Incorrect result from procedure Translate - 2");
+      end if;
+
+      -- No mapping of source.
+
+      Test_String := B10.To_Bounded_Wide_String(Equiv("xyzsypcc"));
+
+      B10.Translate(Source => Test_String, Mapping => Wide_AB_to_YZ_Map);
+
+      if Test_String /= B10.To_Bounded_Wide_String(Equiv("xyzsypcc")) then
+         Report.Failed("Incorrect result from procedure Translate - 3");
+      end if;
+
+      -- Map > 2 characters, partial mapping.
+
+      Test_String := B10.To_Bounded_Wide_String("opabcdelmn");
+
+      B10.Translate(Test_String, 
+                    Maps.To_Mapping("abcde", "lmnop"));
+
+      if Test_String /= B10.To_Bounded_Wide_String("oplmnoplmn") then
+         Report.Failed("Incorrect result from procedure Translate - 4");
+      end if;
+
+
+
+
+      -- Procedure Translate with access-to-subprogram mapping.
+      -- Use the version of Procedure Translate that takes an
+      -- access-to-subprogram parameter to perform the Source mapping.
+
+      -- Partial mapping of source.
+
+      Test_String := B10.To_Bounded_Wide_String("dogeatdog");
+
+      B10.Translate(Source => Test_String, Mapping => Map_Ptr);
+
+      if Test_String /= B10.To_Bounded_Wide_String("cateatcat") then
+         Report.Failed
+           ("Incorrect result from procedure Translate w/map ptr - 1");
+      end if;
+
+      Test_String := B10.To_Bounded_Wide_String("odogcatlmn");
+
+      B10.Translate(Test_String, Map_Ptr);
+
+      if Test_String /= B10.To_Bounded_Wide_String("acatcatlmn") then
+         Report.Failed
+           ("Incorrect result from procedure Translate w/map ptr - 2");
+      end if;
+
+
+      -- Total mapping of source.
+
+      Test_String := B10.To_Bounded_Wide_String("gggooooddd");
+
+      B10.Translate(Source => Test_String, Mapping => Map_Ptr);
+
+      if Test_String /= B10.To_Bounded_Wide_String("tttaaaaccc") then
+         Report.Failed
+           ("Incorrect result from procedure Translate w/map ptr- 3");
+      end if;
+
+      -- No mapping of source.
+
+      Test_String := B10.To_Bounded_Wide_String(" DOG cat ");
+
+      B10.Translate(Source => Test_String, Mapping => Map_Ptr);
+
+      if Test_String /= B10.To_Bounded_Wide_String(" DOG cat ") then
+         Report.Failed
+           ("Incorrect result from procedure Translate w/map ptr - 4");
+      end if;
+
+      Test_String := B10.Null_Bounded_Wide_String;
+
+      B10.Translate(Source => Test_String, Mapping => Map_Ptr);
+
+      if Test_String /= B10.To_Bounded_Wide_String("") then
+         Report.Failed
+           ("Incorrect result from procedure Translate w/map ptr - 5");
+      end if;
+
+
+
+
+      -- Function Translate with access-to-subprogram mapping.
+      -- Use the version of Function Translate that takes an
+      -- access-to-subprogram parameter to perform the Source mapping.
+
+      -- Partial mapping of source.
+
+      if B10.Translate(Source  => B10.To_Bounded_Wide_String("cateatdog"),
+                       Mapping => Map_Ptr) /= 
+         B10.To_Bounded_Wide_String("cateatcat") 
+      then
+         Report.Failed
+           ("Incorrect result from function Translate w/map ptr - 1");
+      end if;
+
+      if B10.Translate(B10.To_Bounded_Wide_String("cadogtac"),
+                       Map_Ptr) /= 
+         B10.To_Bounded_Wide_String("cacattac") 
+      then
+         Report.Failed
+           ("Incorrect result from function Translate w/map ptr - 2");
+      end if;
+
+      -- Total mapping of source.
+
+      if B10.Translate(Source  => B10.To_Bounded_Wide_String("dogodggdo"),
+                       Mapping => Map_Ptr) /= 
+         B10.To_Bounded_Wide_String("catacttca") 
+      then
+         Report.Failed
+           ("Incorrect result from function Translate w/map ptr- 3");
+      end if;
+
+      -- No mapping of source.
+
+      if B10.Translate(Source  => B10.To_Bounded_Wide_String(" DOG cat "),
+                       Mapping => Map_Ptr) /= 
+         B10.To_Bounded_Wide_String(" DOG cat ") 
+      then
+         Report.Failed
+           ("Incorrect result from function Translate w/map ptr - 4");
+      end if;
+
+      if B10.Translate(B10.To_Bounded_Wide_String("d "), Map_Ptr)         /=
+         B10.To_Bounded_Wide_String("c ")                                   or
+         B10.Translate(B10.To_Bounded_Wide_String("  god"), Map_Ptr)      /=
+         B10.To_Bounded_Wide_String("  tac")                                or
+         B10.Translate(B10.To_Bounded_Wide_String("d o g D og"), Map_Ptr) /=
+         B10.To_Bounded_Wide_String("c a t D at")                           or
+         B10.Translate(B10.To_Bounded_Wide_String("   "), Map_Ptr)        /=
+         B10.To_Bounded_Wide_String("   ")                                  or
+         B10.Translate(B10.To_Bounded_Wide_String("dddddddddd"), Map_Ptr) /=
+         B10.To_Bounded_Wide_String("cccccccccc") 
+      then
+         Report.Failed
+           ("Incorrect result from function Translate w/map ptr - 5");
+      end if;
+
+      if B10.Translate(Source  => B10.Null_Bounded_Wide_String,
+                       Mapping => Map_Ptr) /= 
+         B10.To_Bounded_Wide_String("") 
+      then
+         Report.Failed
+           ("Incorrect result from function Translate w/map ptr - 6");
+      end if;
+
+
+
+
+      -- Function Replace_Slice    
+      -- Evaluate function Replace_Slice with 
+      -- a variety of Truncation options.
+
+      -- Drop = Error (Default)
+
+      begin
+         Test_String   := AtoJ_Bnd_Str;
+         Result_String := 
+           B10.Replace_Slice(Source => Test_String, 
+                             Low    => 3,
+                             High   => 5,                   -- 3-5, 3 chars.
+                             By     => Equiv("xxxxxx"));    -- more than 3.
+         Report.Failed("Length_Error not raised by Function Replace_Slice");
+      exception
+         when AS.Length_Error => null;   -- Correct exception raised.
+         when others          =>
+            Report.Failed
+              ("Incorrect exception raised by Function Replace_Slice");
+      end;
+
+      -- Drop = Left                                                          
+
+      Result_String := 
+        B10.Replace_Slice(Source => Test_String, 
+                          Low    =>  7,
+                          High   => 10,                  -- 7-10, 4 chars.
+                          By     => Equiv("xxxxxx"),     --  6 chars.
+                          Drop   => Ada.Strings.Left);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Equiv("cdefxxxxxx")) -- drop a,b
+      then
+         Report.Failed
+           ("Incorrect result from Function Replace Slice, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Result_String := 
+        B10.Replace_Slice(Source => Test_String,
+                          Low    =>  2,
+                          High   =>  5,                 -- 2-5, 4 chars.
+                          By     => Equiv("xxxxxx"),    --  6 chars.
+                          Drop   => Ada.Strings.Right);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Equiv("axxxxxxfgh")) -- drop i,j
+      then
+         Report.Failed
+           ("Incorrect result from Function Replace Slice, Drop = Right");
+      end if;
+
+      -- Low = High = Source'Last, "By" length = 1.
+
+      if B10.Replace_Slice(AtoE_Bnd_Str,
+                           B10.To_Wide_String(AtoE_Bnd_Str)'Last,
+                           B10.To_Wide_String(AtoE_Bnd_Str)'Last,
+                           Equiv("X"),
+                           Ada.Strings.Error)  /=
+         B10.To_Bounded_Wide_String(Equiv("abcdX"))
+      then
+         Report.Failed("Incorrect result from Function Replace_Slice");
+      end if;
+
+      -- Index_Error raised when High < Source'First - 1.
+      begin
+         Test_String := 
+           B10.Replace_Slice(AtoE_Bnd_Str, 
+                             B10.To_Wide_String(AtoE_Bnd_Str)'First,
+                             B10.To_Wide_String(AtoE_Bnd_Str)'First - 2,
+                             Equiv("hijklm"));
+         Report.Failed("Index_Error not raised by Function Replace_Slice");
+      exception
+         when AS.Index_Error   => null;  -- OK, expected exception
+         when Constraint_Error => null;  -- Also OK, since RM is not clear
+         when others           =>
+            Report.Failed
+              ("Incorrect exception raised by Function Replace_Slice");
+      end;
+
+
+
+      -- Procedure Replace_Slice  
+      -- Evaluate procedure Replace_Slice with 
+      -- a variety of Truncation options.
+
+      -- Drop = Error (Default)
+
+      begin
+         Test_String := AtoJ_Bnd_Str;
+         B10.Replace_Slice(Source => Test_String, 
+                           Low    => 3,
+                           High   => 5,                   -- 3-5, 3 chars.
+                           By     => Equiv("xxxxxx"));    -- more than 3.
+         Report.Failed("Length_Error not raised by Procedure Replace_Slice");
+      exception
+         when AS.Length_Error => null;   -- Correct exception raised.
+         when others          =>
+            Report.Failed
+              ("Incorrect exception raised by Procedure Replace_Slice");
+      end;
+
+      -- Drop = Left                                                          
+
+      Test_String := AtoJ_Bnd_Str;
+      B10.Replace_Slice(Source => Test_String, 
+                        Low    =>  7,
+                        High   =>  9,                  -- 7-9, 3 chars.
+                        By     => Equiv("xxxxx"),      --  5 chars.
+                        Drop   => Ada.Strings.Left);
+
+      if Test_String /= 
+         B10.To_Bounded_Wide_String(Equiv("cdefxxxxxj")) -- drop a,b
+      then
+         Report.Failed
+           ("Incorrect result from Procedure Replace Slice, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Test_String := AtoJ_Bnd_Str;
+      B10.Replace_Slice(Source => Test_String, 
+                        Low    =>  1,
+                        High   =>  3,                  -- 1-3, 3chars.
+                        By     => Equiv("xxxx"),       --  4 chars.
+                        Drop   => Ada.Strings.Right);
+
+      if Test_String /= 
+         B10.To_Bounded_Wide_String(Equiv("xxxxdefghi"))  -- drop j
+      then
+         Report.Failed
+           ("Incorrect result from Procedure Replace Slice, Drop = Right");
+      end if;
+
+      -- High = Source'First, Low > High (Insert before Low).
+
+      Test_String := AtoE_Bnd_Str;
+      B10.Replace_Slice(Source => Test_String, 
+                        Low    => B10.To_Wide_String(Test_String)'Last,
+                        High   => B10.To_Wide_String(Test_String)'First,
+                        By     => Equiv("XXXX"),       --  4 chars.
+                        Drop   => Ada.Strings.Right);
+
+      if Test_String /= B10.To_Bounded_Wide_String(Equiv("abcdXXXXe")) then 
+         Report.Failed
+           ("Incorrect result from Procedure Replace Slice");
+      end if;
+
+
+
+
+      -- Function Insert with Truncation 
+      -- Drop = Error (Default).
+
+      begin
+         Result_String := 
+           B10.Insert(Source   => AtoJ_Bnd_Str,    -- "abcdefghij"
+                      Before   => 2,
+                      New_Item => Equiv("xyz"));
+         Report.Failed("Length_Error not raised by Function Insert");
+      exception
+         when AS.Length_Error => null;  -- Correct exception raised.
+         when others          => 
+            Report.Failed("Incorrect exception raised by Function Insert");
+      end;
+
+      -- Drop = Left
+
+      Result_String :=
+        B10.Insert(Source   => AtoJ_Bnd_Str,      -- "abcdefghij"
+                   Before   => 5,
+                   New_Item => Equiv("xyz"),      -- 3 additional chars.
+                   Drop     => Ada.Strings.Left);
+
+      if B10.To_Wide_String(Result_String) /= Equiv("dxyzefghij") then 
+         Report.Failed("Incorrect result from Function Insert, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Result_String := 
+        B10.Insert(Source   => B10.To_Bounded_Wide_String("abcdef"),
+                   Before   => 2,
+                   New_Item => "vwxyz",             -- 5 additional chars.
+                   Drop     => Ada.Strings.Right);
+
+      if B10.To_Wide_String(Result_String) /= "avwxyzbcde" then     -- drop f.
+         Report.Failed("Incorrect result from Function Insert, Drop = Right");
+      end if;
+
+      -- Additional cases.
+
+      if B10.Insert(B10.To_Bounded_Wide_String("a"), 1, " B")        /=   
+         B10.To_Bounded_Wide_String(" Ba")                              or
+         B10.Insert(B10.Null_Bounded_Wide_String, 1, Equiv("abcde")) /=
+         AtoE_Bnd_Str                                                   or
+         B10.Insert(B10.To_Bounded_Wide_String("ab"), 2, "")         /=
+         B10.To_Bounded_Wide_String("ab")
+      then
+         Report.Failed("Incorrect result from Function Insert");
+      end if;
+
+
+
+      -- Procedure Insert 
+
+      -- Drop = Error (Default).
+      begin
+         Test_String := AtoJ_Bnd_Str;
+         B10.Insert(Source   => Test_String,   
+                    Before   => 9,
+                    New_Item => Equiv("wxyz"),
+                    Drop     => Ada.Strings.Error);
+         Report.Failed("Length_Error not raised by Procedure Insert");
+      exception
+         when AS.Length_Error => null;  -- Correct exception raised.
+         when others          => 
+            Report.Failed("Incorrect exception raised by Procedure Insert");
+      end;
+
+      -- Drop = Left
+      
+      Test_String := AtoJ_Bnd_Str;
+      B10.Insert(Source   => Test_String,            
+                 Before   => B10.Length(Test_String), -- before last char
+                 New_Item => Equiv("xyz"),            -- 3 additional chars.
+                 Drop     => Ada.Strings.Left);
+
+      if B10.To_Wide_String(Test_String) /= Equiv("defghixyzj") then 
+         Report.Failed("Incorrect result from Procedure Insert, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Test_String := AtoJ_Bnd_Str;
+      B10.Insert(Source   => Test_String,
+                 Before   => 4,
+                 New_Item => Equiv("yz"),             -- 2 additional chars.
+                 Drop     => Ada.Strings.Right);
+
+      if B10.To_Wide_String(Test_String) /= Equiv("abcyzdefgh") then   
+         Report.Failed
+           ("Incorrect result from Procedure Insert, Drop = Right");
+      end if;
+
+      -- Before = Source'First, New_Item length = 1.
+
+      Test_String := B10.To_Bounded_Wide_String(" abc ");
+      B10.Insert(Test_String, 
+                 B10.To_Wide_String(Test_String)'First,
+                 "Z");
+
+      if Test_String /= B10.To_Bounded_Wide_String("Z abc ") then
+         Report.Failed("Incorrect result from Procedure Insert");
+      end if;
+
+
+   exception
+      when others => Report.Failed("Exception raised in  Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4019;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4020.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4020.a
new file mode 100644
index 000000000..24036f171
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4020.a
@@ -0,0 +1,688 @@
+-- CXA4020.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 subprograms defined in package Ada.Strings.Wide_Bounded
+--      are available, and that they produce correct results, especially under
+--      conditions where truncation of the result is required.  Specifically, 
+--      check the subprograms Overwrite (function and procedure), Delete,
+--      Function Trim (blanks), Trim (Set wide characters, function and
+--      procedure), Head, Tail, and Replicate (wide characters and wide 
+--      strings).
+--
+-- TEST DESCRIPTION:
+--      This test, in conjunction with tests CXA4017, CXA4018, CXA4019, 
+--      will provide coverage of the most common usages of the functionality
+--      found in the Ada.Strings.Wide_Bounded package.  It deals in large part
+--      with truncation effects and options.  This test contains many small, 
+--      specific test cases, situations that are often difficult to generate 
+--      in large numbers in an application-based test.  These cases represent 
+--      specific usage paradigms in-the-small.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      22 Dec 94   SAIC    Changed obsolete constant to Strings.Wide_Space.
+--      13 Apr 95   SAIC    Corrected certain subtest acceptance conditions.
+--
+--!
+
+with Report;
+with Ada.Characters.Handling;
+with Ada.Strings.Wide_Bounded;
+with Ada.Strings.Wide_Maps;
+
+procedure CXA4020 is
+
+   -- The following two functions are used to translate character and string
+   -- values to "Wide" values.  They will be applied to all the Wide_Bounded
+   -- subprogram parameters to simulate the use of Wide_Characters and 
+   -- Wide_Strings in actual practice. Blanks are translated to Wide_Character
+   -- blanks and all other characters are translated into Wide_Characters with
+   -- position values 256 greater than their (narrow) character position
+   -- values.
+
+   function Translate (Ch : Character) return Wide_Character is
+      C : Character := Ch;
+   begin
+      if Ch = ' ' then
+         return Ada.Characters.Handling.To_Wide_Character(C);
+      else
+         return Wide_Character'Val(Character'Pos(Ch) + 
+                Character'Pos(Character'Last) + 1);
+      end if;
+   end Translate;
+
+
+   function Translate (Str : String) return Wide_String is
+      WS : Wide_String(Str'First..Str'Last);
+   begin
+      for i in Str'First..Str'Last loop
+         WS(i) := Translate(Str(i));
+      end loop;
+      return WS;
+   end Translate;
+
+
+begin
+
+   Report.Test("CXA4020", "Check that the subprograms defined in "      &
+                          "package Ada.Strings.Wide_Bounded are "       &
+                          "available, and that they produce correct "   &
+                          "results, especially under conditions where " &
+                          "truncation of the result is required");
+
+   Test_Block:
+   declare
+
+      package AS   renames Ada.Strings;
+      package ASW  renames Ada.Strings.Wide_Bounded;
+      package Maps renames Ada.Strings.Wide_Maps;
+
+      package B10 is new ASW.Generic_Bounded_Length(Max => 10);
+      use type B10.Bounded_Wide_String;
+
+      Result_String : B10.Bounded_Wide_String;
+      Test_String   : B10.Bounded_Wide_String;
+      AtoE_Bnd_Str  : B10.Bounded_Wide_String := 
+                        B10.To_Bounded_Wide_String(Translate("abcde"));
+      FtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
+                        B10.To_Bounded_Wide_String(Translate("fghij"));
+      AtoJ_Bnd_Str  : B10.Bounded_Wide_String := 
+                        B10.To_Bounded_Wide_String(Translate("abcdefghij"));
+
+      Location     : Natural := 0;
+      Total_Count  : Natural := 0;
+
+      CD_Set       : Maps.Wide_Character_Set := Maps.To_Set(Translate("cd")); 
+      XY_Set       : Maps.Wide_Character_Set := Maps.To_Set(Translate("xy")); 
+
+
+   begin
+
+      -- Function Overwrite with Truncation                  
+      -- Drop = Error (Default).
+
+      begin
+         Test_String   := AtoJ_Bnd_Str;
+         Result_String := 
+           B10.Overwrite(Source   => Test_String, -- "abcdefghij"
+                         Position => 9,
+                         New_Item => Translate("xyz"),
+                         Drop     => AS.Error);
+         Report.Failed("Exception not raised by Function Overwrite");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+           Report.Failed("Incorrect exception raised by Function Overwrite");
+      end;
+
+      -- Drop = Left
+ 
+      Result_String :=
+        B10.Overwrite(Source   => Test_String,  -- "abcdefghij"
+                      Position => B10.Length(Test_String), -- 10
+                      New_Item => Translate("xyz"),
+                      Drop     => Ada.Strings.Left);
+
+      if B10.To_Wide_String(Result_String) /= 
+         Translate("cdefghixyz") then   -- drop a,b
+         Report.Failed
+           ("Incorrect result from Function Overwrite, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Result_String := B10.Overwrite(Test_String,  -- "abcdefghij"
+                                     3,
+                                     Translate("xxxyyyzzz"),
+                                     Ada.Strings.Right);
+
+      if B10.To_Wide_String(Result_String) /= 
+         Translate("abxxxyyyzz") 
+      then
+         Report.Failed
+           ("Incorrect result from Function Overwrite, Drop = Right");
+      end if;
+
+      -- Additional cases of function Overwrite.
+
+      if B10.Overwrite(B10.To_Bounded_Wide_String(Translate("a")),      
+                       1,                                 -- Source length = 1
+                       Translate("  abc  "))              /= 
+         B10.To_Bounded_Wide_String(Translate("  abc  "))       or
+         B10.Overwrite(B10.Null_Bounded_Wide_String,      -- Null source
+                       1, 
+                       Translate("abcdefghij"))           /=
+         AtoJ_Bnd_Str                                or
+         B10.Overwrite(AtoE_Bnd_Str, 
+                       B10.To_Wide_String(AtoE_Bnd_Str)'First,
+                       Translate(" "))                    /=  -- New_Item = 1
+         B10.To_Bounded_Wide_String(Translate(" bcde"))
+      then
+         Report.Failed("Incorrect result from Function Overwrite");
+      end if;
+
+
+
+      -- Procedure Overwrite                                 
+      -- Correct usage, no truncation.
+
+      Test_String := AtoE_Bnd_Str;   -- "abcde"
+      B10.Overwrite(Test_String, 2, Translate("xyz"));
+
+      if Test_String /= B10.To_Bounded_Wide_String(Translate("axyze")) then
+         Report.Failed("Incorrect result from Procedure Overwrite - 1");
+      end if;
+
+      Test_String := B10.To_Bounded_Wide_String(Translate("abc"));
+      B10.Overwrite(Test_String, 2, "");   -- New_Item is null string.
+
+      if Test_String /= B10.To_Bounded_Wide_String(Translate("abc")) then
+         Report.Failed("Incorrect result from Procedure Overwrite - 2");
+      end if;
+
+      -- Drop = Error (Default).
+
+      begin
+         Test_String   := AtoJ_Bnd_Str;
+         B10.Overwrite(Source   => Test_String, -- "abcdefghij"
+                       Position => 8,
+                       New_Item => Translate("uvwxyz"));
+         Report.Failed("Exception not raised by Procedure Overwrite");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+           Report.Failed("Incorrect exception raised by Procedure Overwrite");
+      end;
+
+      -- Drop = Left
+ 
+      Test_String   := AtoJ_Bnd_Str;
+      B10.Overwrite(Source   => Test_String,  -- "abcdefghij"
+                    Position => B10.Length(Test_String) - 2, -- 8
+                    New_Item => Translate("uvwxyz"),
+                    Drop     => Ada.Strings.Left);
+
+      if B10.To_Wide_String(Test_String) /= 
+         Translate("defguvwxyz")
+      then  
+         Report.Failed
+           ("Incorrect result from Procedure Overwrite, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Test_String   := AtoJ_Bnd_Str;
+      B10.Overwrite(Test_String,  -- "abcdefghij"
+                    3,
+                    Translate("xxxyyyzzz"),
+                    Ada.Strings.Right);
+
+      if B10.To_Wide_String(Test_String) /= Translate("abxxxyyyzz") then
+         Report.Failed                                         
+           ("Incorrect result from Procedure Overwrite, Drop = Right");
+      end if;
+
+
+
+      -- Function Delete                                     
+
+      if B10.Delete(Source  => AtoJ_Bnd_Str,   -- "abcdefghij"
+                    From    => 3,
+                    Through => 8)                               /=
+         B10."&"(B10.Head(AtoJ_Bnd_Str, 2), 
+                 B10.Tail(AtoJ_Bnd_Str, 2))                         or
+         B10.Delete(AtoJ_Bnd_Str, 6, B10.Length(AtoJ_Bnd_Str))  /=
+         AtoE_Bnd_Str                                               or
+         B10.Delete(AtoJ_Bnd_Str, 1, 5)                         /= 
+         FtoJ_Bnd_Str                                               
+      then
+         Report.Failed("Incorrect result from Function Delete - 1");
+      end if;
+
+      if B10.Delete(B10.To_Bounded_Wide_String(Translate("a")), 1, 1)  /= 
+         B10.Null_Bounded_Wide_String                                    or
+         B10.Delete(AtoE_Bnd_Str, 
+                    5, 
+                    B10.To_Wide_String(AtoE_Bnd_Str)'First) /=
+         AtoE_Bnd_Str                                           or
+         B10.Delete(AtoE_Bnd_Str,
+                    B10.To_Wide_String(AtoE_Bnd_Str)'Last,
+                    B10.To_Wide_String(AtoE_Bnd_Str)'Last)  /=
+         B10.To_Bounded_Wide_String(Translate("abcd"))
+      then
+         Report.Failed("Incorrect result from Function Delete - 2");
+      end if;
+      
+
+
+      -- Function Trim
+
+      declare
+
+         Text : B10.Bounded_Wide_String := 
+                  B10.To_Bounded_Wide_String(Translate("Text"));
+         type Bnd_Array_Type is array (1..5) of B10.Bounded_Wide_String;
+         Bnd_Array : Bnd_Array_Type :=
+           (B10.To_Bounded_Wide_String(Translate("  Text")),
+            B10.To_Bounded_Wide_String(Translate("Text    ")),
+            B10.To_Bounded_Wide_String(Translate("   Text   ")),
+            B10.To_Bounded_Wide_String(Translate("Text  Text")),
+            B10.To_Bounded_Wide_String(Translate(" Text Text")));
+
+      begin
+
+         for i in Bnd_Array_Type'Range loop
+            case i is
+               when 4 =>
+                  if B10.Trim(Bnd_Array(i), AS.Both) /= 
+                     Bnd_Array(i) then  -- no change
+                     Report.Failed("Incorrect result from Function Trim - 4");
+                  end if;
+               when 5 =>
+                  if B10.Trim(Bnd_Array(i), AS.Both) /= 
+                     B10."&"(Text, B10."&"(Translate(' '), Text)) 
+                  then
+                     Report.Failed("Incorrect result from Function Trim - 5");
+                  end if;
+               when others =>
+                  if B10.Trim(Bnd_Array(i), AS.Both) /= Text then
+                     Report.Failed("Incorrect result from Function Trim - " &
+                                    Integer'Image(i));
+                  end if;
+            end case;
+         end loop;
+
+      end;
+
+
+
+      -- Function Trim using Sets                            
+
+      -- Trim characters in sets from both sides of the bounded wide string.
+      if B10.Trim(Source => B10.To_Bounded_Wide_String(Translate("ddabbaxx")),
+                  Left   => CD_Set,
+                  Right  => XY_Set)  /=
+         B10.To_Bounded_Wide_String(Translate("abba"))
+      then
+         Report.Failed
+           ("Incorrect result from Fn Trim - Sets, Left & Right side - 1");
+      end if;
+
+      -- Ensure that the characters in the set provided as the actual to
+      -- parameter Right are not trimmed from the left side of the bounded
+      -- wide string; likewise for the opposite side.  Only "cd" trimmed 
+      -- from left side, and only "xy" trimmed from right side.
+
+      if B10.Trim(B10.To_Bounded_Wide_String(Translate("cdxyabcdxy")), 
+                  CD_Set, 
+                  XY_Set) /=
+         B10.To_Bounded_Wide_String(Translate("xyabcd"))
+      then
+         Report.Failed
+           ("Incorrect result from Fn Trim - Sets, Left & Right side - 2");
+      end if;
+
+      -- Ensure that characters contained in the sets are not trimmed from
+      -- the "interior" of the bounded wide string, just the appropriate ends.
+
+      if B10.Trim(B10.To_Bounded_Wide_String(Translate("cdabdxabxy")), 
+                  CD_Set, 
+                  XY_Set) /=
+         B10.To_Bounded_Wide_String(Translate("abdxab"))
+      then
+         Report.Failed
+           ("Incorrect result from Fn Trim - Sets, Left & Right side - 3");
+      end if;
+
+      -- Trim characters in set from right side only.  No change to Left side.
+
+      if B10.Trim(B10.To_Bounded_Wide_String(Translate("abxyzddcd")), 
+                  XY_Set, 
+                  CD_Set) /=
+         B10.To_Bounded_Wide_String(Translate("abxyz"))
+      then
+         Report.Failed
+           ("Incorrect result from Fn Trim - Sets, Right side");
+      end if;
+
+      -- Trim no characters on either side of the bounded string.
+
+      Result_String := B10.Trim(AtoJ_Bnd_Str, CD_Set, XY_Set);
+      if Result_String /= AtoJ_Bnd_Str then
+         Report.Failed("Incorrect result from Fn Trim - Sets, Neither side");
+      end if;
+
+      if B10.Trim(AtoE_Bnd_Str, Maps.Null_Set, Maps.Null_Set) /=
+         AtoE_Bnd_Str                                            or
+         B10.Trim(B10.To_Bounded_Wide_String(Translate("dcddcxyyxx")),
+                  CD_Set,
+                  XY_Set)                                     /=
+         B10.Null_Bounded_Wide_String
+      then
+         Report.Failed("Incorrect result from Function Trim");
+      end if;
+
+
+
+      -- Procedure Trim using Sets                           
+
+      -- Trim characters in sets from both sides of the bounded wide string.
+
+      Test_String := B10.To_Bounded_Wide_String(Translate("dcabbayx"));
+      B10.Trim(Source => Test_String,
+               Left   => CD_Set,
+               Right  => XY_Set);
+
+      if Test_String /= B10.To_Bounded_Wide_String(Translate("abba")) then
+         Report.Failed
+           ("Incorrect result from Proc Trim - Sets, Left & Right side - 1");
+      end if;
+
+      -- Ensure that the characters in the set provided as the actual to
+      -- parameter Right are not trimmed from the left side of the bounded
+      -- wide string; likewise for the opposite side.  Only "cd" trimmed 
+      -- from left side, and only "xy" trimmed from right side.
+
+      Test_String := B10.To_Bounded_Wide_String(Translate("cdxyabcdxy"));
+      B10.Trim(Test_String, CD_Set, XY_Set);
+
+      if Test_String /= B10.To_Bounded_Wide_String(Translate("xyabcd")) then
+         Report.Failed
+           ("Incorrect result from Proc Trim - Sets, Left & Right side - 2");
+      end if;
+
+      -- Ensure that characters contained in the sets are not trimmed from
+      -- the "interior" of the bounded wide string, just the appropriate ends.
+
+      Test_String := B10.To_Bounded_Wide_String(Translate("cdabdxabxy"));
+      B10.Trim(Test_String, CD_Set, XY_Set);
+
+      if not 
+        (Test_String = B10.To_Bounded_Wide_String(Translate("abdxab"))) then
+         Report.Failed
+           ("Incorrect result from Proc Trim - Sets, Left & Right side - 3");
+      end if;
+
+      -- Trim characters in set from Left side only.  No change to Right side.
+
+      Test_String := B10.To_Bounded_Wide_String(Translate("cccdabxyz"));
+      B10.Trim(Test_String, CD_Set, XY_Set);
+
+      if Test_String /= B10.To_Bounded_Wide_String(Translate("abxyz")) then
+         Report.Failed
+           ("Incorrect result from Proc Trim for Sets, Left side only");
+      end if;
+
+      -- Trim no characters on either side of the bounded wide string.
+
+      Test_String := AtoJ_Bnd_Str;
+      B10.Trim(Test_String, CD_Set, CD_Set);
+
+      if Test_String /= AtoJ_Bnd_Str then
+         Report.Failed("Incorrect result from Proc Trim-Sets, Neither side");
+      end if;
+
+
+
+      -- Function Head with Truncation                       
+      -- Drop = Error (Default).
+
+      begin
+         Result_String := B10.Head(Source => AtoJ_Bnd_Str,   -- max length
+                                   Count  => B10.Length(AtoJ_Bnd_Str) + 1,
+                                   Pad    => Translate('X'));
+         Report.Failed("Length_Error not raised by Function Head");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+            Report.Failed("Incorrect exception raised by Function Head");
+      end;
+
+      -- Drop = Left
+
+      -- Pad characters (5) are appended to the right end of the bounded
+      -- wide string (which is initially at its maximum length), then the 
+      -- first five characters of the intermediate result are dropped to 
+      -- conform to the maximum size limit of the bounded wide string (10).
+
+      Result_String := 
+        B10.Head(B10.To_Bounded_Wide_String(Translate("ABCDEFGHIJ")),
+                 15,
+                 Translate('x'),
+                 Ada.Strings.Left);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Translate("FGHIJxxxxx"))
+      then
+         Report.Failed("Incorrect result from Function Head, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      -- Pad characters (6) are appended to the left end of the bounded
+      -- wide string (which is initially at one less than its maximum length), 
+      -- then the last five characters of the intermediate result are dropped 
+      -- (which in this case are the pad characters) to conform to the 
+      -- maximum size limit of the bounded wide string (10).
+
+      Result_String := 
+        B10.Head(B10.To_Bounded_Wide_String(Translate("ABCDEFGHI")),
+                 15,
+                 Translate('x'),
+                 Ada.Strings.Right);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Translate("ABCDEFGHIx")) 
+      then
+         Report.Failed("Incorrect result from Function Head, Drop = Right");
+      end if;
+
+      -- Additional cases.
+
+      if B10.Head(B10.Null_Bounded_Wide_String, 5, Translate('a')) /=
+         B10.To_Bounded_Wide_String(Translate("aaaaa"))          or
+         B10.Head(AtoE_Bnd_Str,
+                  B10.Length(AtoE_Bnd_Str))   /=
+         AtoE_Bnd_Str
+      then
+         Report.Failed("Incorrect result from Function Head");
+      end if;
+
+
+
+      -- Function Tail with Truncation                       
+      -- Drop = Error (Default Case)
+
+      begin
+         Result_String := B10.Tail(Source => AtoJ_Bnd_Str,   -- max length
+                                   Count  => B10.Length(AtoJ_Bnd_Str) + 1,
+                                   Pad    => Ada.Strings.Wide_Space,
+                                   Drop   => Ada.Strings.Error);
+         Report.Failed("Length_Error not raised by Function Tail");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+            Report.Failed("Incorrect exception raised by Function Tail");
+      end;
+
+      -- Drop = Left
+
+      -- Pad characters (5) are appended to the left end of the bounded wide
+      -- string (which is initially at two less than its maximum length), 
+      -- then the first three characters of the intermediate result (in this 
+      -- case, 3 pad characters) are dropped.
+
+      Result_String := 
+        B10.Tail(B10.To_Bounded_Wide_String(Translate("ABCDEFGH")),
+                 13,
+                 Translate('x'),
+                 Ada.Strings.Left);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Translate("xxABCDEFGH")) 
+      then
+         Report.Failed("Incorrect result from Function Tail, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      -- Pad characters (3) are appended to the left end of the bounded wide 
+      -- string (which is initially at its maximum length), then the last
+      -- three characters of the intermediate result are dropped.
+
+      Result_String := 
+        B10.Tail(B10.To_Bounded_Wide_String(Translate("ABCDEFGHIJ")),
+                 13,
+                 Translate('x'),
+                 Ada.Strings.Right);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Translate("xxxABCDEFG"))
+      then
+         Report.Failed("Incorrect result from Function Tail, Drop = Right");
+      end if;
+
+      -- Additional cases.
+
+      if B10.Tail(B10.Null_Bounded_Wide_String, 3, Translate(' ')) /=
+         B10.To_Bounded_Wide_String(Translate("   "))                or
+         B10.Tail(AtoE_Bnd_Str, 
+                  B10.To_Wide_String(AtoE_Bnd_Str)'First)  /=
+         B10.To_Bounded_Wide_String(Translate("e"))
+      then
+         Report.Failed("Incorrect result from Function Tail");
+      end if;
+
+
+
+      -- Function Replicate (#, Char) with Truncation        
+      -- Drop = Error (Default).
+
+      begin
+         Result_String := B10.Replicate(Count => B10.Max_Length + 5,
+                                        Item  => Translate('A'),
+                                        Drop  => AS.Error);
+         Report.Failed
+           ("Length_Error not raised by Replicate for characters");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+           Report.Failed
+             ("Incorrect exception raised by Replicate for characters");
+      end;
+
+      -- Drop = Left, Right
+      -- Since this version of Replicate uses wide character parameters, the 
+      -- result after truncation from left or right will appear the same.
+      -- The result will be a 10 character bounded wide string, composed of
+      -- 10 "Item" wide characters.
+
+      if B10.Replicate(Count => 20, 
+                       Item => Translate('A'), 
+                       Drop => Ada.Strings.Left) /=
+         B10.Replicate(15, Translate('A'), Ada.Strings.Right)
+      then
+         Report.Failed("Incorrect result from Replicate for characters - 1");
+      end if;
+
+      -- Blank-filled, 10 character bounded wide strings.
+
+      if B10.Replicate(B10.Max_Length + 1, 
+                       Translate(' '), 
+                       Drop => Ada.Strings.Left) /=
+         B10.Replicate(B10.Max_Length, Ada.Strings.Wide_Space)
+      then
+         Report.Failed("Incorrect result from Replicate for characters - 2");
+      end if;
+
+      -- Additional cases.
+
+      if B10.Replicate(0, Translate('a')) /= B10.Null_Bounded_Wide_String or
+         B10.Replicate(1, Translate('a')) /= 
+         B10.To_Bounded_Wide_String(Translate("a"))
+      then
+         Report.Failed("Incorrect result from Replicate for characters - 3");
+      end if;
+
+
+
+      -- Function Replicate (#, String) with Truncation      
+      -- Drop = Error (Default).
+
+      begin
+         Result_String := B10.Replicate(Count => 5,  -- result would be 15.
+                                        Item  => Translate("abc"));
+         Report.Failed
+           ("Length_Error not raised by Replicate for wide strings");
+      exception
+         when AS.Length_Error => null;  -- Expected exception raised.
+         when others          => 
+           Report.Failed
+             ("Incorrect exception raised by Replicate for wide strings");
+      end;
+
+      -- Drop = Left
+
+      Result_String := B10.Replicate(3, Translate("abcd"), Ada.Strings.Left);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Translate("cdabcdabcd"))
+      then
+         Report.Failed
+           ("Incorrect result from Replicate for wide strings, Drop = Left");
+      end if;
+
+      -- Drop = Right
+
+      Result_String := B10.Replicate(3, Translate("abcd"), Ada.Strings.Right);
+
+      if Result_String /= 
+         B10.To_Bounded_Wide_String(Translate("abcdabcdab")) then
+         Report.Failed
+           ("Incorrect result from Replicate for wide strings, Drop = Right");
+      end if;
+
+      -- Additional cases.
+      
+      if B10.Replicate(5, Translate("X"))    /= 
+         B10.To_Bounded_Wide_String(Translate("XXXXX"))   or
+         B10.Replicate(10, "")               /= 
+         B10.Null_Bounded_Wide_String                     or
+         B10.Replicate(0, Translate("ab"))   /= 
+         B10.Null_Bounded_Wide_String
+      then
+         Report.Failed("Incorrect result from Replicate for wide strings");
+      end if;
+
+
+   exception
+      when others => Report.Failed("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4020;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4021.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4021.a
new file mode 100644
index 000000000..345a77c68
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4021.a
@@ -0,0 +1,311 @@
+-- CXA4021.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 subprograms defined in package 
+--      Ada.Strings.Wide_Unbounded are available, and that they produce 
+--      correct results. Specifically, check the subprograms Head, Index, 
+--      Index_Non_Blank, Insert, Length, Overwrite, Replace_Slice, Slice, 
+--      Tail, To_Wide_String, To_Unbounded_Wide_String, "*", "&", 
+--      and "=", "<=", ">=".
+--      
+-- TEST DESCRIPTION:
+--      This test demonstrates the uses of many of the subprograms defined
+--      in package Ada.Strings.Wide_Unbounded for use with unbounded wide
+--      strings.
+--      The test attempts to simulate how unbounded wide strings could be used
+--      to simulate paragraphs of text.  Modifications could be easily be
+--      performed using the provided subprograms (although in this test, the
+--      main modification performed was the addition of more text to the
+--      string).  One would not have to worry about the formatting of the 
+--      paragraph until it was finished and correct in content.  Then, once
+--      all required editing is complete, the unbounded strings can be divided
+--      up into the appropriate lengths based on particular formatting
+--      requirements.  The test then compares the formatted text product
+--      with a predefined "finished product".  
+--      
+--      This test attempts to use a large number of the subprograms provided
+--      by package Ada.Strings.Wide_Unbounded.  Often, the processing involved
+--      could have been performed more efficiently using a minimum number
+--      of the subprograms, in conjunction with loops, etc.  However, for
+--      testing purposes, and in the interest of minimizing the number of
+--      tests developed, subprogram variety and feature mixing was stressed.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with Ada.Characters.Handling;
+with Ada.Strings.Wide_Maps;
+with Ada.Strings.Wide_Unbounded;
+
+procedure CXA4021 is
+
+   -- The following two functions are used to translate character and string
+   -- values to "Wide" values.  They will be applied to all the Wide_Bounded
+   -- subprogram character and string parameters to simulate the use of non-
+   -- character Wide_Characters and Wide_Strings in actual practice.
+   -- Note: These functions do not actually return "equivalent" wide
+   --       characters to their character inputs, just "non-character"
+   --       wide characters.
+
+   function Equiv (Ch : Character) return Wide_Character is
+      C : Character := Ch;
+   begin
+      if Ch = ' ' then
+         return Ada.Characters.Handling.To_Wide_Character(C);
+      else
+         return Wide_Character'Val(Character'Pos(Ch) + 
+                Character'Pos(Character'Last) + 1);
+      end if;
+   end Equiv;
+
+
+   function Equiv (Str : String) return Wide_String is
+      WS : Wide_String(Str'First..Str'Last);
+   begin
+      for i in Str'First..Str'Last loop
+         WS(i) := Equiv(Str(i));
+      end loop;
+      return WS;
+   end Equiv;
+
+begin
+
+   Report.Test ("CXA4021", "Check that the subprograms defined in "     &
+                           "package Ada.Strings.Wide_Unbounded are "    &
+                           "available, and that they produce correct "  &
+                           "results");
+
+   Test_Block:
+   declare
+
+      package ASW renames Ada.Strings.Wide_Unbounded;
+      use type ASW.Unbounded_Wide_String;
+      use Ada.Strings;
+
+      Pamphlet_Paragraph_Count : constant :=  2;
+      Lines                    : constant :=  4;
+      Line_Length              : constant := 40;
+
+      type Document_Type is array (Positive range <>) 
+        of ASW.Unbounded_Wide_String;
+
+      type Camera_Ready_Copy_Type is array (1..Lines) 
+        of Wide_String (1..Line_Length);
+
+      Pamphlet            : Document_Type (1..Pamphlet_Paragraph_Count);
+
+      Camera_Ready_Copy   : Camera_Ready_Copy_Type := 
+                              (others => (others => Ada.Strings.Wide_Space));
+
+      TC_Finished_Product : Camera_Ready_Copy_Type :=
+                   ( 1 => Equiv("Ada is a programming language designed  "),
+                     2 => Equiv("to support long-lived, reliable software"),
+                     3 => Equiv(" systems.                               "),
+                     4 => Equiv("Go with Ada!                            "));
+
+      -----
+
+
+      procedure Enter_Text_Into_Document (Document : in out Document_Type) is
+      begin
+
+         -- Fill in both "paragraphs" of the document.  Each unbounded wide 
+         -- string functions as an individual paragraph, containing an 
+         -- unspecified number of characters.
+         -- Use a variety of different unbounded wide string subprograms to
+         -- load the data.
+
+         Document(1) := 
+           ASW.To_Unbounded_Wide_String(Equiv("Ada is a language"));
+
+         -- Insert the word "programming" prior to "language".
+         Document(1) := 
+           ASW.Insert(Document(1), 
+                      ASW.Index(Document(1),
+                                Equiv("language")),
+                      ASW.To_Wide_String(Equiv("progra") &       -- Wd Str &
+                                         ASW."*"(2,Equiv('m')) & -- Wd Unbd &
+                                         Equiv("ing ")));        -- Wd Str
+
+
+         -- Overwrite the word "language" with "language" + additional text.
+         Document(1) :=
+           ASW.Overwrite(Document(1),
+                         ASW.Index(Document(1),
+                                   ASW.To_Wide_String(
+                                     ASW.Tail(Document(1), 8, Equiv(' '))),
+                                   Ada.Strings.Backward),
+                         Equiv("language designed to support long-lifed"));
+
+
+         -- Replace the word "lifed" with "lived".
+         Document(1) :=
+           ASW.Replace_Slice(Document(1),
+                             ASW.Index(Document(1), Equiv("lifed")),
+                             ASW.Length(Document(1)),
+                             Equiv("lived"));
+
+
+         -- Overwrite the word "lived" with "lived" + additional text.
+         Document(1) :=
+           ASW.Overwrite(Document(1),
+                         ASW.Index(Document(1),
+                                   ASW.To_Wide_String
+                                     (ASW.Tail(Document(1), 5, Equiv(' '))),
+                                   Ada.Strings.Backward),
+                         Equiv("lived, reliable software systems."));
+                              
+                              
+         -- Use several of the overloaded versions of "&" to form this
+         -- unbounded wide string.
+
+         Document(2) := Equiv('G')                                  & 
+                        ASW.To_Unbounded_Wide_String(Equiv("o "))   & 
+                        ASW.To_Unbounded_Wide_String(Equiv("with")) &
+                        Equiv(' ')                                  & 
+                        Equiv("Ada!");
+
+      end Enter_Text_Into_Document;
+
+
+      -----
+
+
+      procedure Create_Camera_Ready_Copy 
+                  (Document    : in     Document_Type;
+                   Camera_Copy :    out Camera_Ready_Copy_Type) is
+      begin
+         -- Break the unbounded wide strings into fixed lengths.
+
+         -- Search the first unbounded wide string for portions of text that
+         -- are less than or equal to the length of a wide string in the 
+         -- Camera_Ready_Copy_Type object.  
+
+         Camera_Copy(1) :=               -- Take characters 1-39,
+           ASW.Slice(Document(1),        -- and append a blank space.
+                     1,
+                     ASW.Index(ASW.To_Unbounded_Wide_String
+                                 (ASW.Slice(Document(1),
+                                            1,
+                                            Line_Length)),
+                               Ada.Strings.Wide_Maps.To_Set(Equiv(' ')),
+                               Ada.Strings.Inside,
+                               Ada.Strings.Backward)) & Equiv(' ');
+
+         Camera_Copy(2) :=                 -- Take characters 40-79.
+           ASW.Slice(Document(1),
+                     40,
+                     (ASW.Index_Non_Blank              -- Should return 79
+                        (ASW.To_Unbounded_Wide_String
+                           (ASW.Slice(Document(1),     -- Slice (40..79)
+                                      40,
+                                      79)),
+                         Ada.Strings.Backward) + 39)); -- Increment since
+                                                       -- this slice starts
+                                                       -- at 40.
+
+         Camera_Copy(3)(1..9) := ASW.Slice(Document(1), -- Characters 80-88
+                                           80,
+                                           ASW.Length(Document(1))); 
+                                
+
+         -- Break the second unbounded wide string into the appropriate
+         -- length.  It is only twelve characters in length, so the entire 
+         -- unbounded wide string will be placed on one string of the output 
+         -- object.
+
+         Camera_Copy(4)(1..ASW.Length(Document(2))) :=
+           ASW.To_Wide_String(ASW.Head(Document(2),
+                                       ASW.Length(Document(2))));
+
+      end Create_Camera_Ready_Copy;
+
+
+      -----
+
+
+      function Valid_Proofread (Draft, Master : Camera_Ready_Copy_Type) 
+        return Boolean is
+      begin
+
+         -- Evaluate wide strings for equality, using the operators defined
+         -- in package Ada.Strings.Wide_Unbounded.  The less than/greater 
+         -- than or equal comparisons should evaluate to "equals => True".
+
+         if ASW.To_Unbounded_Wide_String(Draft(1))   =     -- "="(WUnb,WUnb)
+            ASW.To_Unbounded_Wide_String(Master(1))   and  
+            ASW.To_Unbounded_Wide_String(Draft(2))  <=     -- "<="(WUnb,WUnb)
+            ASW.To_Unbounded_Wide_String(Master(2))   and
+            ASW.To_Unbounded_Wide_String(Draft(3))  >=     -- ">="(WUnb,WUnb)
+            ASW.To_Unbounded_Wide_String(Master(3))   and
+            ASW.To_Unbounded_Wide_String(Draft(4))   =     -- "="(WUnb,WUnb)
+            ASW.To_Unbounded_Wide_String(Master(4))
+         then
+            return True;
+         else
+            return False;
+         end if;
+
+      end Valid_Proofread;
+
+
+      -----
+
+
+   begin
+
+      -- Enter text into the unbounded wide string paragraphs of the document.
+
+      Enter_Text_Into_Document (Pamphlet);
+
+
+      -- Reformat the unbounded wide strings into fixed wide string format.
+
+      Create_Camera_Ready_Copy (Document    => Pamphlet,
+                                Camera_Copy => Camera_Ready_Copy);
+
+
+      -- Verify the conversion process.
+
+      if not Valid_Proofread (Draft  => Camera_Ready_Copy,
+                              Master => TC_Finished_Product)
+      then
+         Report.Failed ("Incorrect unbounded wide string processing result");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4021;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4022.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4022.a
new file mode 100644
index 000000000..3c649a1a2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4022.a
@@ -0,0 +1,531 @@
+-- CXA4022.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 subprograms defined in package 
+--      Ada.Strings.Wide_Unbounded are available, and that they produce 
+--      correct results. Specifically, check the subprograms Count, Element,
+--      Index, Replace_Element, To_Unbounded_Wide_String, and "&", ">", "<".
+--      
+-- TEST DESCRIPTION:
+--      This test demonstrates the uses of many of the subprograms defined
+--      in package Ada.Strings.Wide_Unbounded for use with unbounded wide 
+--      strings.  The test simulates how unbounded wide strings 
+--      will be processed in a user environment, using the subprograms 
+--      provided in this package.
+--
+--      Taken in conjunction with tests CXA4021 and CXA4023, this test will 
+--      constitute a test of the functionality contained in package
+--      Ada.Strings.Wide Unbounded.  This test uses a variety
+--      of the subprograms defined in the unbounded wide string package
+--      in ways typical of common usage, with different combinations of
+--      available subprograms being used to accomplish similar 
+--      unbounded wide string processing goals.
+--      
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      08 Nov 95   SAIC    Corrected accessibility level, type visibility,
+--                          and subtest acceptance criteria problems for 
+--                          ACVC 2.0.1
+--
+--!
+
+with Ada.Characters.Handling;
+with Ada.Strings;
+
+package CXA40220 is
+
+   -- The following two functions are used to translate character and string
+   -- values to "Wide" values.  They will be applied to all the Wide_Bounded
+   -- subprogram character and string parameters to simulate the use of non-
+   -- character Wide_Characters and Wide_Strings in actual practice.
+   -- Note: These functions do not actually return "equivalent" wide
+   --       characters to their character inputs, just "non-character"
+   --       wide characters.
+
+   function Equiv (Ch : Character) return Wide_Character;
+
+   function Equiv (Str : String) return Wide_String;
+
+
+   -- Functions and access-to-subprogram value used to supply mapping
+   -- capability to the appropriate versions of Count, Index, and 
+   -- Translate.
+
+   function AB_to_US_Mapping_Function (From : Wide_Character) 
+     return Wide_Character;
+
+   function AB_to_Blank_Mapping_Function (From : Wide_Character) 
+     return Wide_Character;
+
+end CXA40220;
+
+package body CXA40220 is
+
+   function Equiv (Ch : Character) return Wide_Character is
+      C : Character := Ch;
+   begin
+      if Ch = ' ' then
+         return Ada.Characters.Handling.To_Wide_Character(C);
+      else
+         return Wide_Character'Val(Character'Pos(Ch) + 
+                Character'Pos(Character'Last) + 1);
+      end if;
+   end Equiv;
+
+
+   function Equiv (Str : String) return Wide_String is
+      WS : Wide_String(Str'First..Str'Last);
+   begin
+      for i in Str'First..Str'Last loop
+         WS(i) := Equiv(Str(i));
+      end loop;
+      return WS;
+   end Equiv;
+
+
+   function AB_to_US_Mapping_Function (From : Wide_Character) 
+     return Wide_Character is
+      UnderScore : constant Wide_Character := Equiv('_');
+   begin
+      if From = Equiv('a')  or  From = Equiv('b')  then
+         return UnderScore;
+      else
+         return From;
+      end if;
+   end AB_to_US_Mapping_Function;
+
+
+   function AB_to_Blank_Mapping_Function (From : Wide_Character) 
+     return Wide_Character is
+   begin
+      if From = Equiv('a')  or  From = Equiv('b') then
+         return Ada.Strings.Wide_Space;
+      else
+         return From;
+      end if;
+   end AB_to_Blank_Mapping_Function;
+
+end CXA40220;
+
+
+with CXA40220;
+with Report;
+with Ada.Characters.Handling;
+with Ada.Strings.Wide_Maps;
+with Ada.Strings.Wide_Unbounded;
+
+procedure CXA4022 is
+begin
+
+   Report.Test ("CXA4022", "Check that the subprograms defined in "    &
+                           "package Ada.Strings.Wide_Unbounded are "   &
+                           "available, and that they produce correct " &
+                           "results");
+
+   Test_Block:
+   declare
+
+      use CXA40220;
+
+      package ASW renames Ada.Strings.Wide_Unbounded;
+      use Ada.Strings;
+      use type Wide_Maps.Wide_Character_Set;
+      use type ASW.Unbounded_Wide_String;
+
+      Test_String       : ASW.Unbounded_Wide_String;
+      AtoE_Str          : ASW.Unbounded_Wide_String :=
+                            ASW.To_Unbounded_Wide_String(Equiv("abcde"));
+
+      Complete_String   : ASW.Unbounded_Wide_String := 
+            ASW."&"(ASW.To_Unbounded_Wide_String(Equiv("Incomplete")),
+                    ASW."&"(Ada.Strings.Wide_Space,
+                            ASW.To_Unbounded_Wide_String(Equiv("String"))));
+
+      Incomplete_String  : ASW.Unbounded_Wide_String :=
+                             ASW.To_Unbounded_Wide_String
+                               (Equiv("ncomplete Strin"));
+
+      Incorrect_Spelling : ASW.Unbounded_Wide_String :=
+                             ASW.To_Unbounded_Wide_String(Equiv("Guob Dai"));
+
+      Magic_String       : ASW.Unbounded_Wide_String :=
+           ASW.To_Unbounded_Wide_String(Equiv("abracadabra"));
+
+      Incantation        : ASW.Unbounded_Wide_String := Magic_String;
+
+
+      A_Small_G    : Wide_Character := Equiv('g');
+      A_Small_D    : Wide_Character := Equiv('d');
+
+      ABCD_Set     : Wide_Maps.Wide_Character_Set := 
+                       Wide_Maps.To_Set(Equiv("abcd"));
+      B_Set        : Wide_Maps.Wide_Character_Set := 
+                       Wide_Maps.To_Set(Equiv('b'));
+      CD_Set       : Wide_Maps.Wide_Character_Set := 
+                       Wide_Maps.To_Set(Equiv("cd"));
+
+      CD_to_XY_Map : Wide_Maps.Wide_Character_Mapping := 
+                       Wide_Maps.To_Mapping(From => Equiv("cd"), 
+                                            To   => Equiv("xy"));
+      AB_to_YZ_Map : Wide_Maps.Wide_Character_Mapping := 
+                       Wide_Maps.To_Mapping(Equiv("ab"), Equiv("yz"));
+
+
+      Matching_Letters : Natural := 0;
+      Location,
+      Total_Count      : Natural := 0;
+
+
+      Map_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
+                  AB_to_US_Mapping_Function'Access;
+
+
+   begin
+
+
+      -- Function "&"
+
+      -- Prepend an 'I' and append a 'g' to the wide string.
+      Incomplete_String := ASW."&"(Equiv('I'), 
+                                   Incomplete_String);       -- Ch & W Unb
+      Incomplete_String := ASW."&"(Incomplete_String, 
+                                   A_Small_G);               -- W Unb & Ch
+
+      if ASW."<"(Incomplete_String, Complete_String)  or
+         ASW.">"(Incomplete_String, Complete_String)  or
+         Incomplete_String /= Complete_String
+      then
+         Report.Failed("Incorrect result from use of ""&"" operator");
+      end if;
+
+
+
+      -- Function Element
+
+      -- Last element of the unbounded wide string should be a 'g'.
+      if ASW.Element(Incomplete_String, ASW.Length(Incomplete_String)) /=
+         A_Small_G
+      then
+         Report.Failed("Incorrect result from use of Function Element - 1");
+      end if;
+
+      if ASW.Element(Incomplete_String, 2)                 /=
+         ASW.Element(ASW.Tail(Incomplete_String, 2), 1)       or
+         ASW.Element(ASW.Head(Incomplete_String, 4), 2)    /=
+         ASW.Element(ASW.To_Unbounded_Wide_String(Equiv("wnqz")), 2)
+      then
+         Report.Failed("Incorrect result from use of Function Element - 2");
+      end if;
+    
+
+
+      -- Procedure Replace_Element
+
+      -- The unbounded wide string Incorrect_Spelling starts as "Guob Dai",
+      -- and is transformed by the following three procedure calls to
+      -- "Good Day".
+
+      ASW.Replace_Element(Incorrect_Spelling, 2, Equiv('o'));
+
+      ASW.Replace_Element(Incorrect_Spelling, 
+                          ASW.Index(Incorrect_Spelling, B_Set),
+                          A_Small_D);
+
+      ASW.Replace_Element(Source => Incorrect_Spelling,
+                          Index  => ASW.Length(Incorrect_Spelling),
+                          By     => Equiv('y'));
+
+      if Incorrect_Spelling /= 
+         ASW.To_Unbounded_Wide_String(Equiv("Good Day")) 
+      then
+         Report.Failed("Incorrect result from Procedure Replace_Element");
+      end if;
+
+
+
+      -- Function Index with non-Identity map.               
+      -- Evaluate the function Index with a non-identity map 
+      -- parameter which will cause mapping of the source parameter 
+      -- prior to the evaluation of the index position search.
+
+      Location := ASW.Index(Source  => ASW.To_Unbounded_Wide_String
+                                         (Equiv("abcdefghij")),
+                            Pattern => Equiv("xy"),
+                            Going   => Ada.Strings.Forward,
+                            Mapping => CD_to_XY_Map);  -- change "cd" to "xy"
+
+      if Location /= 3 then
+         Report.Failed("Incorrect result from Index, non-Identity map - 1");
+      end if;
+
+      Location := ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abcdabcdab")),
+                            Equiv("yz"),
+                            Ada.Strings.Backward,
+                            AB_to_YZ_Map);    -- change all "ab" to "yz"
+
+      if Location /= 9 then
+         Report.Failed("Incorrect result from Index, non-Identity map - 2");
+      end if;
+
+      -- A couple with identity maps (default) as well.
+
+      if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abcd")), -- Pat = Src
+                   Equiv("abcd"))                       /= 1 or
+         ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abc")),  -- Pat < Src
+                   Equiv("abcd"))                       /= 0 or
+         ASW.Index(ASW.Null_Unbounded_Wide_String,       -- Src = Null
+                   Equiv("abc"))                        /= 0 
+      then
+         Report.Failed
+           ("Incorrect result from Index with wide string patterns");
+      end if;
+
+
+
+      -- Function Index (for Sets).                         
+      -- This version of Index uses Sets as the basis of the search.
+
+      -- Test = Inside, Going = Forward  (Default case).
+      Location := 
+        ASW.Index(Source => ASW.To_Unbounded_Wide_String(Equiv("abcdeabcde")),
+                  Set    => CD_Set);  -- set containing 'c' and 'd'
+
+      if not (Location = 3) then     -- position of first 'c' in source.
+         Report.Failed("Incorrect result from Index using Sets - 1");
+      end if;
+
+      -- Test = Inside, Going = Backward.
+      Location := 
+        ASW.Index(Source => ASW."&"(AtoE_Str, AtoE_Str), 
+                  Set    => CD_Set,  -- set containing 'c' and 'd'
+                  Test   => Ada.Strings.Inside,
+                  Going  => Ada.Strings.Backward);
+
+      if not (Location = 9) then   -- position of last 'd' in source.
+         Report.Failed("Incorrect result from Index using Sets - 2");
+      end if;
+
+      -- Test = Outside, Going = Forward, Backward
+      if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("deddacd")),  
+                   Wide_Maps.To_Set(Equiv("xydcgf")),
+                   Test  => Ada.Strings.Outside,
+                   Going => Ada.Strings.Forward) /= 2 or
+         ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("deddacd")),  
+                   Wide_Maps.To_Set(Equiv("xydcgf")),
+                   Test  => Ada.Strings.Outside,
+                   Going => Ada.Strings.Backward) /= 5 or
+         ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("deddacd")),
+                   CD_Set,
+                   Ada.Strings.Outside,
+                   Ada.Strings.Backward) /= 5
+      then
+         Report.Failed("Incorrect result from Index using Sets - 3");
+      end if;
+
+      -- Default direction (forward) and mapping (identity).
+
+      if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("cd")), -- Source = Set
+                   CD_Set)                     /= 1 or
+         ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("c")), -- Source < Set
+                   CD_Set)                     /= 1 or 
+         ASW.Index(ASW.Null_Unbounded_Wide_String,           -- Source = Null
+                   CD_Set)                     /= 0 or
+         ASW.Index(AtoE_Str,                             
+                   Wide_Maps.Null_Set)         /= 0 or       -- Null set
+         ASW.Index(AtoE_Str,
+                   Wide_Maps.To_Set(Equiv('x')))      /= 0   -- No match.
+      then
+         Report.Failed("Incorrect result from Index using Sets - 4");
+      end if;
+
+
+
+      -- Function Index using access-to-subprogram mapping.
+      -- Evaluate the function Index with an access value that supplies the
+      -- mapping function for this version of Index.
+
+      Map_Ptr := AB_to_US_Mapping_Function'Access;
+
+      Location := ASW.Index(Source  => ASW.To_Unbounded_Wide_String
+                                         (Equiv("xAxabbxax xaax _cx")),
+                            Pattern => Equiv("_x"),
+                            Going   => Ada.Strings.Forward,
+                            Mapping => Map_Ptr);  -- change 'a'or 'b' to '_'
+
+      if Location /= 6 then   -- location of "bx" substring
+         Report.Failed("Incorrect result from Index, access value map - 1");
+      end if;
+
+      Map_Ptr := AB_to_Blank_Mapping_Function'Access;
+
+      Location := ASW.Index(ASW.To_Unbounded_Wide_String
+                              (Equiv("ccacdcbbcdacc")),
+                            Equiv("cd "),
+                            Ada.Strings.Backward,
+                            Map_Ptr);      -- change 'a' or 'b' to ' '
+
+      if Location /= 9 then
+         Report.Failed("Incorrect result from Index, access value map - 2");
+      end if;
+
+      if ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abcd")),
+                   Equiv("  cd"),                           
+                   Ada.Strings.Forward,
+                   Map_Ptr)            /= 1 or
+         ASW.Index(ASW.To_Unbounded_Wide_String(Equiv("abc")), 
+                   Equiv("  c "),                               -- No match
+                   Ada.Strings.Backward,
+                   Map_Ptr)            /= 0
+      then
+         Report.Failed("Incorrect result from Index, access value map - 3");
+      end if;
+
+
+
+      -- Function Count
+
+      -- Determine the number of characters in the unbounded wide string that
+      -- are contained in the set.
+
+      Matching_Letters := ASW.Count(Source => Magic_String,
+                                    Set    => ABCD_Set);
+
+      if Matching_Letters /= 9 then
+         Report.Failed
+            ("Incorrect result from Function Count with Set parameter");
+      end if;
+
+      -- Determine the number of occurrences of the following pattern wide
+      -- strings in the unbounded wide string Magic_String.
+
+      if  ASW.Count(Magic_String, Equiv("ab"))   /=
+          (ASW.Count(Magic_String, Equiv("ac")) + 
+           ASW.Count(Magic_String, Equiv("ad")))  or
+          ASW.Count(Magic_String, Equiv("ab"))   /= 2
+      then
+         Report.Failed
+            ("Incorrect result from Function Count, wide string parameter");
+      end if;
+
+
+
+      -- Function Count with non-Identity mapping.           
+      -- Evaluate the function Count with a non-identity map 
+      -- parameter which will cause mapping of the source parameter 
+      -- prior to the evaluation of the number of matching patterns.
+
+      Total_Count := 
+        ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("abbabbabbabba")),
+                  Pattern => Equiv("yz"),
+                  Mapping => AB_to_YZ_Map);
+
+      if Total_Count /= 4 then                                                 
+         Report.Failed
+           ("Incorrect result from function Count, non-Identity map - 1");
+      end if;
+
+      if  ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("ADCBADABCD")),
+                    Equiv("AB"),
+                    Wide_Maps.To_Mapping(Equiv("CD"), Equiv("AB")))  /= 5 or
+          ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("dcccddcdccdddccccd")),
+                    Equiv("xxy"),
+                    CD_to_XY_Map)                                    /= 3
+      then
+         Report.Failed
+           ("Incorrect result from function Count, non-Identity map - 2");
+      end if;
+
+      -- And a few with identity Wide_Maps as well.
+
+      if ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("ABABABABAB")),
+                   Equiv("ABA"),  
+                   Wide_Maps.Identity)                /= 2 or
+         ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("aaaaaaaaaa")),
+                   Equiv("aaa"))                      /= 3 or
+         ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("XX")),    -- Src < Pat
+                   Equiv("XXX"),
+                   Wide_Maps.Identity)                /= 0 or
+         ASW.Count(AtoE_Str,                              -- Source = Pattern
+                   Equiv("abcde"))                 /= 1 or
+         ASW.Count(ASW.Null_Unbounded_Wide_String,        -- Source = Null
+                   Equiv(" "))                     /= 0
+      then
+         Report.Failed
+           ("Incorrect result from function Count, w,w/o mapping");
+      end if;
+
+
+
+      -- Function Count using access-to-subprogram mapping.           
+      -- Evaluate the function Count with an access value specifying the 
+      -- mapping that is going to occur to Source.
+
+      Map_Ptr := AB_to_US_Mapping_Function'Access;
+
+      Total_Count := 
+        ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("abcbacbadbaAbbB")),
+                  Pattern => Equiv("__"),
+                  Mapping => Map_Ptr);  -- change 'a' and 'b' to '_'
+
+      if Total_Count /= 5 then                                                 
+         Report.Failed
+           ("Incorrect result from function Count, access value map - 1");
+      end if;
+
+      Map_Ptr := AB_to_Blank_Mapping_Function'Access;
+
+      if ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("cccaccBcbcaccacAc")),
+                   Equiv("c c"),  
+                   Map_Ptr)                /= 3 or
+         ASW.Count(ASW.To_Unbounded_Wide_String
+                    (Equiv("aBBAAABaBBBBAaBABBABaBBbBB")),
+                   Equiv(" BB"),
+                   Map_Ptr)                /= 4 or
+         ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("aaaaaaaaaa")),
+                   Equiv("   "),
+                   Map_Ptr)                /= 3 or
+         ASW.Count(ASW.To_Unbounded_Wide_String(Equiv("XX")),  -- Src < Pat
+                   Equiv("XX "),
+                   Map_Ptr)                /= 0 or
+         ASW.Count(AtoE_Str,               -- Source'Length = Pattern'Length
+                   Equiv("  cde"),
+                   Map_Ptr)                /= 1
+      then
+         Report.Failed
+           ("Incorrect result from function Count, access value map - 3");
+      end if;
+
+      
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4022;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4023.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4023.a
new file mode 100644
index 000000000..d0325fc88
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4023.a
@@ -0,0 +1,585 @@
+-- CXA4023.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 subprograms defined in package 
+--      Ada.Strings.Wide_Unbounded are available, and that they produce 
+--      correct results. Specifically, check the subprograms Delete, 
+--      Find_Token, Translate, Trim, and "*".
+--      
+-- TEST DESCRIPTION:
+--      This test demonstrates the uses of many of the subprograms defined
+--      in package Ada.Strings.Wide_Unbounded for use with unbounded wide 
+--      strings.  The test simulates how unbounded wide strings 
+--      will be processed in a user environment, using the subprograms 
+--      provided in this package.
+--
+--      This test, when taken in conjunction with tests CXA4021-22, will 
+--      constitute a test of the functionality contained in package
+--      Ada.Strings.Wide_Unbounded.  This test uses a variety
+--      of the subprograms defined in the unbounded wide string package
+--      in ways typical of common usage, with different combinations of
+--      available subprograms being used to accomplish similar 
+--      unbounded wide string processing goals.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      08 Nov 95   SAIC    Corrected accessibility level and type 
+--                          visibility problems for ACVC 2.0.1.
+--
+--!
+
+with Ada.Characters.Handling;
+with Ada.Strings;
+
+package CXA40230 is
+
+   -- The following two functions are used to translate character and string
+   -- values to non-character "Wide" values.  They will be applied to all the
+   -- Wide_Bounded subprogram character and string parameters to simulate the
+   -- use of Wide_Characters and Wide_Strings in actual practice.
+   -- Note: These functions do not actually return "equivalent" wide
+   --       characters to their character inputs, just "non-character"
+   --       wide characters.
+
+   function Equiv (Ch : Character) return Wide_Character;
+
+   function Equiv (Str : String) return Wide_String;
+
+   -- Functions and access-to-subprogram object used to supply mapping
+   -- capability to the appropriate versions of Translate.
+
+   function AB_to_US_Mapping_Function (From : Wide_Character) 
+     return Wide_Character;
+
+   function AB_to_Blank_Mapping_Function (From : Wide_Character) 
+     return Wide_Character;
+
+end CXA40230;
+
+
+package body CXA40230 is
+
+   function Equiv (Ch : Character) return Wide_Character is
+      C : Character := Ch;
+   begin
+      if Ch = ' ' then
+         return Ada.Characters.Handling.To_Wide_Character(C);
+      else
+         return Wide_Character'Val(Character'Pos(Ch) + 
+                Character'Pos(Character'Last) + 1);
+      end if;
+   end Equiv;
+
+
+   function Equiv (Str : String) return Wide_String is
+      WS : Wide_String(Str'First..Str'Last);
+   begin
+      for i in Str'First..Str'Last loop
+         WS(i) := Equiv(Str(i));
+      end loop;
+      return WS;
+   end Equiv;
+
+
+   function AB_to_US_Mapping_Function (From : Wide_Character) 
+     return Wide_Character is
+      UnderScore : constant Wide_Character := Equiv('_');
+   begin
+      if From = Equiv('a')  or  From = Equiv('b')  then
+         return UnderScore;
+      else
+         return From;
+      end if;
+   end AB_to_US_Mapping_Function;
+
+
+   function AB_to_Blank_Mapping_Function (From : Wide_Character) 
+     return Wide_Character is
+   begin
+      if From = Equiv('a')  or  From = Equiv('b') then
+         return Ada.Strings.Wide_Space;
+      else
+         return From;
+      end if;
+   end AB_to_Blank_Mapping_Function;
+
+end CXA40230;
+
+
+with CXA40230;
+with Report;
+with Ada.Characters.Handling;
+with Ada.Strings.Wide_Maps;
+with Ada.Strings.Wide_Unbounded;
+
+procedure CXA4023 is
+begin
+
+   Report.Test ("CXA4023", "Check that the subprograms defined in "    &
+                           "package Ada.Strings.Wide_Unbounded are "   &
+                           "available, and that they produce correct " &
+                           "results");
+
+   Test_Block:
+   declare
+
+      use CXA40230;
+
+      package ASW renames Ada.Strings.Wide_Unbounded;
+      use Ada.Strings;
+      use type Wide_Maps.Wide_Character_Set;
+      use type ASW.Unbounded_Wide_String;
+
+      Test_String   : ASW.Unbounded_Wide_String;
+      AtoE_Str      : ASW.Unbounded_Wide_String :=
+                        ASW.To_Unbounded_Wide_String(Equiv("abcde"));
+
+      Cad_String    : ASW.Unbounded_Wide_String := 
+                        ASW.To_Unbounded_Wide_String(Equiv("cad"));
+
+      Magic_String  : ASW.Unbounded_Wide_String := 
+                        ASW.To_Unbounded_Wide_String(Equiv("abracadabra"));
+
+      Incantation   : ASW.Unbounded_Wide_String := Magic_String;
+
+
+      A_Small_G : Wide_Character := Equiv('g');
+      
+      ABCD_Set  : Wide_Maps.Wide_Character_Set := 
+                    Wide_Maps.To_Set(Equiv("abcd"));
+      B_Set     : Wide_Maps.Wide_Character_Set := 
+                    Wide_Maps.To_Set(Equiv('b'));
+      AB_Set    : Wide_Maps.Wide_Character_Set := 
+                    Wide_Maps."OR"(Wide_Maps.To_Set(Equiv('a')), B_Set);
+
+
+      AB_to_YZ_Map     : Wide_Maps.Wide_Character_Mapping := 
+                           Wide_Maps.To_Mapping(From => Equiv("ab"), 
+                                                To   => Equiv("yz"));
+      Code_Map         : Wide_Maps.Wide_Character_Mapping := 
+                           Wide_Maps.To_Mapping(Equiv("abcd"), Equiv("wxyz"));
+      Reverse_Code_Map : Wide_Maps.Wide_Character_Mapping :=
+                           Wide_Maps.To_Mapping(Equiv("wxyz"), Equiv("abcd"));
+      Non_Existent_Map : Wide_Maps.Wide_Character_Mapping :=
+                           Wide_Maps.To_Mapping(Equiv("jkl"), Equiv("mno"));
+
+
+      Token_Start      : Positive;
+      Token_End        : Natural := 0;
+
+      Map_Ptr  : Wide_Maps.Wide_Character_Mapping_Function :=
+                   AB_to_US_Mapping_Function'Access;
+
+
+   begin
+
+      -- Find_Token
+
+      ASW.Find_Token(Magic_String,      -- Find location of first "ab" equiv.
+                     AB_Set,            -- Should be (1..2).
+                     Ada.Strings.Inside,
+                     Token_Start,
+                     Token_End);
+
+      if Natural(Token_Start) /= ASW.To_Wide_String(Magic_String)'First  or
+         Token_End            /= ASW.Index(Magic_String, B_Set)          or
+         Token_End            /= 2
+      then 
+         Report.Failed("Incorrect result from Procedure Find_Token - 1");
+      end if;
+
+
+      ASW.Find_Token(Source => Magic_String, -- Find location of char 'r'equiv
+                     Set    => ABCD_Set,     -- in wide str, should be (3..3)
+                     Test   => Ada.Strings.Outside,
+                     First  => Token_Start,
+                     Last   => Token_End);
+
+      if Natural(Token_Start) /= 3  or  Token_End /= 3 then
+         Report.Failed("Incorrect result from Procedure Find_Token - 2");
+      end if;
+
+
+      ASW.Find_Token(Magic_String,                -- No 'g' "equivalent in 
+                     Wide_Maps.To_Set(A_Small_G), -- the wide str, so the
+                     Ada.Strings.Inside,          -- result params should be 
+                     First => Token_Start,        -- First = Source'First and
+                     Last  => Token_End);         -- Last = 0.
+
+
+      if Token_Start /= ASW.To_Wide_String(Magic_String)'First  or
+         Token_End   /= 0
+      then
+         Report.Failed("Incorrect result from Procedure Find_Token - 3");
+      end if;
+ 
+
+      ASW.Find_Token(ASW.To_Unbounded_Wide_String(Equiv("abpqpqrttrcpqr")),
+                     Wide_Maps.To_Set(Equiv("trpq")),
+                     Ada.Strings.Inside,
+                     Token_Start,
+                     Token_End);
+
+      if Token_Start /= 3 or
+         Token_End   /= 10
+      then
+         Report.Failed("Incorrect result from Procedure Find_Token - 4");
+      end if;
+
+      ASW.Find_Token(ASW.To_Unbounded_Wide_String(Equiv("abpqpqrttrcpqr")),
+                     Wide_Maps.To_Set(Equiv("abpq")),
+                     Ada.Strings.Outside,
+                     Token_Start,
+                     Token_End);
+
+      if Token_Start /= 7 or
+         Token_End   /= 11
+      then
+         Report.Failed("Incorrect result from Procedure Find_Token - 5");
+      end if;
+
+
+
+      -- Translate
+
+      -- Use a mapping ("abcd" -> "wxyz") to transform the contents of 
+      -- the unbounded wide string.
+      -- Magic_String = "abracadabra"
+
+      Incantation := ASW.Translate(Magic_String, Code_Map); 
+
+      if Incantation /= 
+         ASW.To_Unbounded_Wide_String(Equiv("wxrwywzwxrw")) 
+      then
+         Report.Failed("Incorrect result from Function Translate - 1");
+      end if;
+
+      -- (Note: See below for additional testing of Function Translate)
+
+      -- Use the inverse mapping of the one above to return the "translated"
+      -- unbounded wide string to its original form.
+
+      ASW.Translate(Incantation, Reverse_Code_Map);
+
+      -- The map contained in the following call to Translate contains three
+      -- elements, and these elements are not found in the unbounded wide
+      -- string, so this call to Translate should have no effect on it.
+
+      if Incantation /= ASW.Translate(Magic_String, Non_Existent_Map) then
+         Report.Failed("Incorrect result from Procedure Translate - 1");
+      end if;
+
+      -- Partial mapping of source.
+
+      Test_String := ASW.To_Unbounded_Wide_String(Equiv("abcdeabcab"));
+
+      ASW.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
+
+      if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("yzcdeyzcyz")) then
+         Report.Failed("Incorrect result from Procedure Translate - 2");
+      end if;
+
+      -- Total mapping of source.
+
+      Test_String := ASW.To_Unbounded_Wide_String(Equiv("abbaaababb"));
+
+      ASW.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
+
+      if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("yzzyyyzyzz")) then
+         Report.Failed("Incorrect result from Procedure Translate - 3");
+      end if;
+
+      -- No mapping of source.
+
+      Test_String := ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc"));
+
+      ASW.Translate(Source => Test_String, Mapping => AB_to_YZ_Map);
+
+      if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc")) then
+         Report.Failed("Incorrect result from Procedure Translate - 4");
+      end if;
+
+      -- Map > 2 characters, partial mapping.
+
+      Test_String := ASW.To_Unbounded_Wide_String(Equiv("opabcdelmn"));
+
+      ASW.Translate(Test_String, 
+                    Wide_Maps.To_Mapping(Equiv("abcde"), Equiv("lmnop")));
+
+      if Test_String /= ASW.To_Unbounded_Wide_String(Equiv("oplmnoplmn")) then
+         Report.Failed("Incorrect result from Procedure Translate - 5");
+      end if;
+
+
+
+      -- Various degrees of mapping of source (full, partial, none) used 
+      -- with Function Translate.
+
+      if ASW.Translate(
+               ASW.To_Unbounded_Wide_String(Equiv("abcdeabcabbbaaacaa")), 
+                       AB_to_YZ_Map)                               /= 
+         ASW.To_Unbounded_Wide_String(Equiv("yzcdeyzcyzzzyyycyy"))   or
+
+         ASW.Translate(
+               ASW.To_Unbounded_Wide_String(Equiv("abbaaababbaaaaba")), 
+                       AB_to_YZ_Map)                               /= 
+         ASW.To_Unbounded_Wide_String(Equiv("yzzyyyzyzzyyyyzy"))     or
+
+         ASW.Translate(ASW.To_Unbounded_Wide_String(Equiv("cABcABBAc")),
+                       Mapping => AB_to_YZ_Map)                    /= 
+         ASW.To_Unbounded_Wide_String(Equiv("cABcABBAc"))            or
+
+         ASW.Translate(ASW.To_Unbounded_Wide_String("opabcdelmnddeaccabec"),
+                       Wide_Maps.To_Mapping("abcde", "lmnop"))     /=
+         ASW.To_Unbounded_Wide_String("oplmnoplmnooplnnlmpn") 
+      then
+         Report.Failed("Incorrect result from Function Translate - 2");
+      end if;
+
+
+
+      -- Procedure Translate using access-to-subprogram mapping.
+      -- Partial mapping of source.
+
+      Map_Ptr := AB_to_Blank_Mapping_Function'Access;
+
+      Test_String := ASW.To_Unbounded_Wide_String(Equiv("abABaABbaBAbba"));
+
+      ASW.Translate(Source  => Test_String, -- change equivalent of 'a' and
+                    Mapping => Map_Ptr);    -- 'b' to ' '
+
+      if Test_String /= 
+         ASW.To_Unbounded_Wide_String(Equiv("  AB AB  BA   ")) 
+      then
+         Report.Failed
+           ("Incorrect result from Proc Translate, w/ access value map - 1");
+      end if;
+
+      -- Total mapping of source to blanks.
+
+      Test_String := ASW.To_Unbounded_Wide_String(Equiv("abbbab"));
+
+      ASW.Translate(Source  => Test_String, 
+                    Mapping => Map_Ptr);
+
+      if Test_String /= 
+         ASW.To_Unbounded_Wide_String(Equiv("      ")) 
+      then
+         Report.Failed
+           ("Incorrect result from Proc Translate, w/ access value map - 2");
+      end if;
+
+      -- No mapping of source.
+
+      Map_Ptr := AB_to_US_Mapping_Function'Access;
+
+      Test_String := ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc"));
+
+      ASW.Translate(Source  => Test_String, 
+                    Mapping => Map_Ptr);
+
+      if Test_String /= 
+         ASW.To_Unbounded_Wide_String(Equiv("xyzsypcc"))   -- no change
+      then
+         Report.Failed
+           ("Incorrect result from Proc Translate, w/ access value map - 3");
+      end if;
+
+
+      -- Function Translate using access-to-subprogram mapping value.
+
+      Map_Ptr  := AB_to_Blank_Mapping_Function'Access;
+
+      Test_String := ASW.To_Unbounded_Wide_String(Equiv("abAbBBAabbacD"));
+
+      if ASW.Translate(ASW.Translate(Test_String, Map_Ptr), Map_Ptr)  /=
+         ASW.To_Unbounded_Wide_String(Equiv("  A BBA    cD")) 
+      then
+         Report.Failed
+           ("Incorrect result from Function Translate, access value map - 1");
+      end if;
+
+      if ASW.Translate(Source  => ASW.To_Unbounded_Wide_String(Equiv("a")), 
+                       Mapping => Map_Ptr)                            /= 
+         ASW.To_Unbounded_Wide_String(Equiv(" "))                       or
+         ASW.Translate(ASW.To_Unbounded_Wide_String
+                         (Equiv(" aa Aa A AAaaa a   aA")),
+                       Map_Ptr)                                       /=
+         ASW.To_Unbounded_Wide_String(Equiv("    A  A AA         A"))   or
+         ASW.Translate(Source  => ASW.To_Unbounded_Wide_String(Equiv("a ")), 
+                       Mapping => Map_Ptr)                            /= 
+         ASW.To_Unbounded_Wide_String(Equiv("  "))                      or
+         ASW.Translate(Source  => ASW.To_Unbounded_Wide_String(Equiv("xyz")),
+                       Mapping => Map_Ptr)                            /= 
+         ASW.To_Unbounded_Wide_String(Equiv("xyz"))
+      then
+         Report.Failed
+           ("Incorrect result from Function Translate, access value map - 2");
+      end if;
+
+
+
+      -- Trim
+
+      Trim_Block:
+      declare
+
+         XYZ_Set     : Wide_Maps.Wide_Character_Set :=
+                         Wide_Maps.To_Set(Equiv("xyz"));
+         PQR_Set     : Wide_Maps.Wide_Character_Set := 
+                         Wide_Maps.To_Set(Equiv("pqr"));
+
+         Pad         : constant ASW.Unbounded_Wide_String := 
+                                 ASW.To_Unbounded_Wide_String(Equiv("Pad"));
+
+         The_New_Ada : constant ASW.Unbounded_Wide_String :=
+                                 ASW.To_Unbounded_Wide_String(Equiv("Ada9X"));
+
+         Space_Array : array (1..4) of ASW.Unbounded_Wide_String :=
+                         (ASW.To_Unbounded_Wide_String(Equiv("  Pad    ")),
+                          ASW.To_Unbounded_Wide_String(Equiv("Pad   ")),
+                          ASW.To_Unbounded_Wide_String(Equiv("     Pad")),
+                          Pad);
+
+         String_Array : array (1..5) of ASW.Unbounded_Wide_String := 
+                        (ASW.To_Unbounded_Wide_String(Equiv("xyzxAda9Xpqr")),
+                         ASW.To_Unbounded_Wide_String(Equiv("Ada9Xqqrp")),
+                         ASW.To_Unbounded_Wide_String(Equiv("zxyxAda9Xqpqr")),
+                         ASW.To_Unbounded_Wide_String(Equiv("xxxyAda9X")),
+                         The_New_Ada);
+           
+      begin
+
+         -- Examine the version of Trim that removes blanks from
+         -- the left and/or right of a wide string.
+
+         for i in 1..4 loop
+            if ASW.Trim(Space_Array(i), Ada.Strings.Both) /= Pad then
+               Report.Failed("Incorrect result from Trim for spaces - " &
+                             Integer'Image(i));
+            end if;
+         end loop;   
+
+         -- Examine the version of Trim that removes set characters from
+         -- the left and right of a wide string.
+
+         for i in 1..5 loop
+            if ASW.Trim(String_Array(i),
+                        Left   => XYZ_Set,
+                        Right  => PQR_Set) /= The_New_Ada then
+               Report.Failed
+                 ("Incorrect result from Trim for set characters - " &
+                  Integer'Image(i));
+            end if;
+         end loop;   
+
+         -- No trimming.
+
+         if ASW.Trim(
+              ASW.To_Unbounded_Wide_String(Equiv("prqqprAda9Xyzzxyzzyz")),
+                     XYZ_Set,
+                     PQR_Set)  /=
+            ASW.To_Unbounded_Wide_String(Equiv("prqqprAda9Xyzzxyzzyz"))
+         then
+            Report.Failed
+              ("Incorrect result from Trim for set, no trimming");
+         end if;
+
+      end Trim_Block;
+
+
+
+      -- Delete
+
+      -- Use the Delete function to remove the first four and last four
+      -- characters from the wide string.
+
+      if ASW.Delete(Source  => ASW.Delete(Magic_String,
+                                          8,
+                                          ASW.Length(Magic_String)),
+                    From    => ASW.To_Wide_String(Magic_String)'First,
+                    Through => 4)   /= 
+         Cad_String
+      then
+         Report.Failed("Incorrect results from Function Delete");
+      end if;
+
+
+
+      -- Constructors ("*")
+
+      Constructor_Block:
+      declare
+      
+         SOS      : ASW.Unbounded_Wide_String;
+
+         Dot      : constant ASW.Unbounded_Wide_String := 
+                               ASW.To_Unbounded_Wide_String(Equiv("Dot_"));
+         Dash     : constant Wide_String := Equiv("Dash_");
+
+         Distress : ASW.Unbounded_Wide_String := 
+                      ASW."&"(ASW.To_Unbounded_Wide_String
+                                (Equiv("Dot_Dot_Dot_")),
+                              ASW."&"(ASW.To_Unbounded_Wide_String
+                                        (Equiv("Dash_Dash_Dash_")), 
+                                      ASW.To_Unbounded_Wide_String
+                                        (Equiv("Dot_Dot_Dot"))));
+                      
+         Repeat        : constant Natural        := 3;
+         Separator     : constant Wide_Character := Equiv('_');
+
+         Separator_Set : Wide_Maps.Wide_Character_Set := 
+                           Wide_Maps.To_Set(Separator);
+
+      begin
+
+         -- Use the following constructor forms to construct the wide string
+         -- "Dot_Dot_Dot_Dash_Dash_Dash_Dot_Dot_Dot".  Note that the 
+         -- trailing underscore in the wide string is removed in the call to 
+         -- Trim in the If statement condition.
+
+         SOS := ASW."*"(Repeat, Dot);                   -- "*"(#, W Unb Str)
+
+         SOS := ASW."&"(SOS,
+                        ASW."&"(ASW."*"(Repeat, Dash),  -- "*"(#, W Str)
+                                ASW."*"(Repeat, Dot))); -- "*"(#, W Unb Str)
+
+         if ASW.Trim(SOS, Wide_Maps.Null_Set, Separator_Set) /= Distress then
+            Report.Failed("Incorrect results from Function ""*""");
+         end if;
+
+      end Constructor_Block;
+      
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4023;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4024.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4024.a
new file mode 100644
index 000000000..1b0af9ce9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4024.a
@@ -0,0 +1,350 @@
+-- CXA4024.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 function "-", To_Ranges, To_Domain, and To_Range are
+--      available in the package Ada.Strings.Maps, and that they produce
+--      correct results based on the Character_Set/Character_Mapping input
+--      provided.
+--
+-- TEST DESCRIPTION:
+--      This test examines the operation of four functions from within the
+--      Ada.Strings.Maps package.  A variety of Character_Sequence, 
+--      Character_Set, and Character_Mapping objects are created and 
+--      initialized for use with these functions.  In each subtest of
+--      function operation, specific inputs are provided to the functions as
+--      input parameters, and the results are evaluated against expected
+--      values.  Wherever appropriate, additional characteristics of the
+--      function results are verified against the prescribed result
+--      characteristics.
+--
+--       
+-- CHANGE HISTORY:
+--      03 Feb 95   SAIC    Initial prerelease version
+--      10 Mar 95   SAIC    Incorporated reviewer comments.
+--      15 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      05 Oct 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--
+--!
+
+with Ada.Strings.Maps;
+with Ada.Strings.Maps.Constants;
+with Ada.Characters.Latin_1;
+with Report;
+
+procedure CXA4024 is
+
+begin
+
+   Report.Test ("CXA4024", "Check that the function ""-"", To_Ranges, " &
+                           "To_Domain, and To_Range are available in "  &
+                           "the package Ada.Strings.Maps, and that "    &
+                           "they produce correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Strings, Ada.Strings.Maps;
+      use type Maps.Character_Set;  -- To allow logical set operator 
+                                    -- infix notation.
+      package ACL1 renames Ada.Characters.Latin_1;
+  
+      MidPoint_Letter  : constant := 13;
+      Last_Letter      : constant := 26;
+
+      Vowels           : constant Maps.Character_Sequence := "aeiou";
+      Quasi_Vowel      : constant Character := 'y';
+
+      Alphabet         : Maps.Character_Sequence (1..Last_Letter);
+      Half_Alphabet    : Maps.Character_Sequence (1..MidPoint_Letter);
+
+      Alphabet_Set,
+      Consonant_Set,
+      Vowel_Set,
+      First_Half_Set,
+      Second_Half_Set  : Maps.Character_Set;
+
+
+   begin
+
+      -- Load the alphabet strings for use in creating sets.
+      for i in 0..12 loop
+         Half_Alphabet(i+1) := Character'Val(Character'Pos('a') + i);
+      end loop;
+
+      for i in 0..25 loop
+         Alphabet(i+1) := Character'Val(Character'Pos('a') + i);
+      end loop;
+
+      -- Initialize a series of Character_Set objects.
+      
+      Alphabet_Set    := Maps.To_Set(Alphabet);
+      Vowel_Set       := Maps.To_Set(Vowels);
+      Consonant_Set   := Vowel_Set  XOR  Alphabet_Set;
+      First_Half_Set  := Maps.To_Set(Half_Alphabet);
+      Second_Half_Set := Alphabet_Set  XOR  First_Half_Set;
+
+
+
+      -- Evaluation of Set operator "-".
+
+      if Consonant_Set  /= "-"(Alphabet_Set, Vowel_Set)       or
+         Vowel_Set      /= (Alphabet_Set - Consonant_Set)     or
+         Alphabet_Set   /= Alphabet_Set - Maps.Null_Set       or
+         First_Half_Set /= "-"(Alphabet_Set, Second_Half_Set) or
+         (Alphabet_Set - Vowel_Set) /= "AND"(Alphabet_Set, "NOT"(Vowel_Set)) 
+      then
+         Report.Failed("Incorrect result from ""-"" operator for sets");
+      end if;
+
+
+
+      -- Evaluation of Function "To_Ranges".
+
+      declare
+
+         use type Maps.Character_Range;
+         use type Maps.Character_Ranges;
+
+         Set_A_to_C   : Maps.Character_Set   := Maps.To_Set("ABC");
+         Set_J        : Maps.Character_Set   := Maps.To_Set("J");
+         Set_M_to_P   : Maps.Character_Set   := Maps.To_Set("MNOP");
+         Set_X_to_Z   : Maps.Character_Set   := Maps.To_Set("XYZ");
+         Set_Of_Five  : Maps.Character_Set   := Set_A_to_C OR  -- Union of the
+                                                Set_M_to_P OR  -- five sets.
+                                                Set_X_to_Z OR
+                                                Set_J      OR
+                                                Maps.Null_Set;
+
+         TC_Range_A_to_C : Maps.Character_Range := (Low => 'A', High => 'C');
+         TC_Range_J      : Maps.Character_Range := ('J', 'J');
+         TC_Range_M_to_P : Maps.Character_Range := ('M', 'P');
+         TC_Range_X_to_Z : Maps.Character_Range := (Low => 'X', High => 'Z');
+
+         TC_Ranges       : Maps.Character_Ranges (1..4) :=
+                             (1 => TC_Range_A_to_C, 
+                              2 => TC_Range_J,
+                              3 => TC_Range_M_to_P, 
+                              4 => TC_Range_X_to_Z);
+
+      begin
+
+         -- Based on input of a set containing four separate "spans" of
+         -- character sequences, Function To_Ranges is required to produce
+         -- the shortest array of contiguous ranges of Character values in
+         -- the input set, in increasing order of Low.
+
+         declare
+
+            -- This Character_Ranges constant should consist of array
+            -- components, each component being a Character_Range from Low
+            -- to High containing the appropriate characters.
+
+            Ranges_Result   : constant Maps.Character_Ranges :=
+                                Maps.To_Ranges(Set => Set_Of_Five);
+         begin
+
+            -- Check the structure and components of the Character_Ranges 
+            -- constant.
+
+            if Ranges_Result(1)      /= TC_Range_A_to_C   or
+               Ranges_Result(1).Low  /= TC_Ranges(1).Low  or
+               Ranges_Result(2)      /= TC_Range_J        or
+               Ranges_Result(2).High /= TC_Ranges(2).High or
+               Ranges_Result(3)      /= TC_Range_M_to_P   or
+               Ranges_Result(3).Low  /= TC_Ranges(3).Low  or   
+               Ranges_Result(3).High /= TC_Ranges(3).High or  
+               Ranges_Result(4)      /= TC_Range_X_To_Z   or
+               Ranges_Result(4).Low  /= TC_Ranges(4).Low  or   
+               Ranges_Result(4).High /= TC_Ranges(4).High
+            then
+               Report.Failed ("Incorrect structure or components in " &
+                              "Character_Ranges constant");
+            end if;
+            
+         exception
+            when others => 
+              Report.Failed("Exception raised using the Function To_Ranges " &
+                            "to initialize a Character_Ranges constant");
+         end;
+      end;
+
+
+
+      -- Evaluation of Functions To_Domain and To_Range.
+
+      declare
+
+         Null_Sequence          : constant Maps.Character_Sequence := "";
+
+         TC_Upper_Case_Sequence : constant Maps.Character_Sequence :=
+                                    "ZYXWVUTSRQPONMABCDEFGHIJKL";
+         TC_Lower_Case_Sequence : constant Maps.Character_Sequence :=
+                                    "zyxwvutsrqponmabcdefghijkl";
+         TC_Unordered_Sequence  : Maps.Character_Sequence(1..6) := 
+                                    "BxACzy";
+
+         TC_Upper_to_Lower_Map  : Maps.Character_Mapping :=
+                                    Maps.To_Mapping(TC_Upper_Case_Sequence,
+                                                    TC_Lower_Case_Sequence);
+
+         TC_Lower_to_Upper_Map  : Maps.Character_Mapping :=
+                                    Maps.To_Mapping(TC_Lower_Case_Sequence,
+                                                    TC_Upper_Case_Sequence);
+
+         TC_Unordered_Map       : Maps.Character_Mapping :=
+                                    Maps.To_Mapping(TC_Unordered_Sequence, 
+                                                    "ikglja");
+      begin
+
+         declare
+
+            TC_Domain_1 : constant Maps.Character_Sequence := 
+                              Maps.To_Domain(TC_Upper_to_Lower_Map);
+                              
+            TC_Domain_2 : constant Maps.Character_Sequence := 
+                              Maps.To_Domain(TC_Lower_to_Upper_Map);
+
+            TC_Domain_3 : Maps.Character_Sequence(1..6);
+
+            TC_Range_1  : constant Maps.Character_Sequence :=
+                              Maps.To_Range(TC_Upper_to_Lower_Map);
+
+            TC_Range_2  : constant Maps.Character_Sequence :=
+                              Maps.To_Range(TC_Lower_to_Upper_Map);
+
+            TC_Range_3  : Maps.Character_Sequence(1..6);
+
+         begin
+
+            -- Function To_Domain returns the shortest Character_Sequence
+            -- value such that each character not in the result maps to
+            -- itself, and all characters in the result are in ascending 
+            -- order.
+
+            TC_Domain_3 := Maps.To_Domain(TC_Unordered_Map);
+
+            -- Check contents of result of To_Domain, must be in ascending
+            -- order.
+
+            if TC_Domain_1 /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then
+               Report.Failed("Incorrect result from To_Domain with " &
+                             "TC_Upper_to_Lower_Map as input");
+            end if;
+
+            if TC_Domain_2 /= "abcdefghijklmnopqrstuvwxyz" then
+               Report.Failed("Incorrect result from To_Domain with " &
+                             "TC_Lower_to_Upper_Map as input");
+            end if;
+
+            if TC_Domain_3 /= "ABCxyz" then        
+               Report.Failed("Incorrect result from To_Domain with " &
+                             "an unordered mapping as input");
+            end if;
+
+
+            -- The lower bound on the returned Character_Sequence value
+            -- from To_Domain must be 1.
+
+            if TC_Domain_1'First /= 1 or 
+               TC_Domain_2'First /= 1 or
+               TC_Domain_3'First /= 1
+            then
+               Report.Failed("Incorrect lower bound returned from To_Domain");
+            end if;
+
+
+            -- Check contents of result of To_Range.
+
+            TC_Range_3 := Maps.To_Range(TC_Unordered_Map);
+
+            if TC_Range_1 /= "abcdefghijklmnopqrstuvwxyz" then
+               Report.Failed("Incorrect result from To_Range with " &
+                             "TC_Upper_to_Lower_Map as input");
+            end if;
+
+            if TC_Range_2 /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then
+               Report.Failed("Incorrect result from To_Range with " &
+                             "TC_Lower_to_Upper_Map as input");
+            end if;
+
+            if TC_Range_3 /= "gilkaj" then          
+               Report.Failed("Incorrect result from To_Range with " &
+                             "an unordered mapping as input");
+            end if;
+
+
+            -- The lower bound on the returned Character_Sequence value
+            -- must be 1.
+
+            if TC_Range_1'First /= 1 or 
+               TC_Range_2'First /= 1 or
+               TC_Range_3'First /= 1
+            then
+               Report.Failed("Incorrect lower bound returned from To_Range");
+            end if;
+
+
+            -- The upper bound on the returned Character_Sequence value
+            -- must be Map'Length.
+
+            if TC_Range_1'Last /= TC_Lower_Case_Sequence'Length or
+               TC_Range_2'Last /= TC_Upper_Case_Sequence'Length or
+               TC_Range_3'Last /= TC_Unordered_Sequence'Length 
+            then
+               Report.Failed("Incorrect upper bound returned from To_Range");
+            end if;
+
+         end;
+
+         -- Both function To_Domain and To_Range return the null string 
+         -- when provided the Identity character map as an input parameter.
+
+         if Maps.To_Domain(Maps.Identity) /= Null_Sequence then
+            Report.Failed("Function To_Domain did not return the null " &
+                          "string when provided the Identity map as "   &
+                          "input");
+         end if;
+
+         if Maps.To_Range(Maps.Identity) /= Null_Sequence then
+            Report.Failed("Function To_Range did not return the null " &
+                          "string when provided the Identity map as "  &
+                          "input");
+         end if;
+
+      exception
+         when others => 
+           Report.Failed("Exception raised during the evaluation of " &
+                         "Function To_Domain and To_Range");
+      end;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4024;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4025.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4025.a
new file mode 100644
index 000000000..1665f7a46
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4025.a
@@ -0,0 +1,376 @@
+-- CXA4025.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 functionality found in packages Ada.Strings.Wide_Maps,
+--      Ada.Strings.Wide_Fixed, and Ada.Strings.Wide_Maps.Wide_Constants
+--      is available and produces correct results.
+--
+-- TEST DESCRIPTION:
+--      This test validates the subprograms found in the various Wide_Map
+--      and Wide_String packages.  It is based on the tests CXA4024 and
+--      CXA4026, which are tests for the complementary "non-wide" packages.
+--      
+--      The functions found in CXA4025_0 provide mapping capability, when
+--      used in conjunction with Wide_Character_Mapping_Function objects.
+--
+--       
+-- CHANGE HISTORY:
+--      23 Jun 95   SAIC    Initial prerelease version.
+--      15 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--
+--!
+
+package CXA4025_0 is
+   -- Functions used to supply mapping capability.
+   function Map_To_Lower_Case (From : Wide_Character) return Wide_Character;
+   function Map_To_Upper_Case (From : Wide_Character) return Wide_Character;
+end CXA4025_0;
+
+with Ada.Characters.Handling;
+package body CXA4025_0 is
+      -- Function Map_To_Lower_Case will return the lower case form of 
+      -- Wide_Characters in the range 'A'..'Z' only, and return the input
+      -- wide_character otherwise.
+
+      function Map_To_Lower_Case (From : Wide_Character) 
+         return Wide_Character is
+      begin
+         return Ada.Characters.Handling.To_Wide_Character(
+                  Ada.Characters.Handling.To_Lower(
+                    Ada.Characters.Handling.To_Character(From)));
+      end Map_To_Lower_Case;
+
+      -- Function Map_To_Upper_Case will return the upper case form of 
+      -- Wide_Characters in the range 'a'..'z', or whose position is in one
+      -- of the ranges 223..246 or 248..255, provided the wide_character has
+      -- an upper case form.               
+
+      function Map_To_Upper_Case (From : Wide_Character) 
+        return Wide_Character is
+      begin
+         return Ada.Characters.Handling.To_Wide_Character(
+                  Ada.Characters.Handling.To_Upper(
+                    Ada.Characters.Handling.To_Character(From)));
+      end Map_To_Upper_Case;
+
+end CXA4025_0;
+
+
+with CXA4025_0;
+with Report;
+with Ada.Characters.Handling;
+with Ada.Characters.Latin_1;
+with Ada.Exceptions;
+with Ada.Strings;
+with Ada.Strings.Wide_Maps;
+with Ada.Strings.Wide_Maps.Wide_Constants;
+with Ada.Strings.Wide_Fixed;
+
+procedure CXA4025 is
+begin
+   Report.Test ("CXA4025",
+                "Check that subprograms defined in packages "       &
+                "Ada.Strings.Wide_Maps and Ada.Strings.Wide_Fixed " &
+                "produce correct results");
+
+   Test_Block:
+   declare
+
+      package ACL1 renames Ada.Characters.Latin_1;
+
+      use Ada.Characters, Ada.Strings;
+      use Ada.Exceptions;
+      use type Wide_Maps.Wide_Character_Set; 
+
+      subtype LC_Characters is Wide_Character range 'a'..'z';
+
+      Last_Letter    : constant := 26;
+      Vowels         : constant Wide_Maps.Wide_Character_Sequence := "aeiou";
+      TC_String      : constant Wide_String := "A Standard String";
+
+      Alphabet       : Wide_Maps.Wide_Character_Sequence (1..Last_Letter);
+      Alphabet_Set,
+      Consonant_Set,
+      Vowel_Set      : Wide_Maps.Wide_Character_Set;
+
+      String_20      : Wide_String(1..20)    := "ABCDEFGHIJKLMNOPQRST";
+      String_40      : Wide_String(1..40)    := "abcdefghijklmnopqrst" & 
+                                                String_20;
+      String_80      : Wide_String(1..80)    := String_40 & String_40;
+      TC_String_5    : Wide_String(1..5)     := "ABCDE";
+
+      -- The following strings are used in examination of the Translation
+      -- subprograms.
+      New_Character_String : Wide_String(1..12) :=
+        Handling.To_Wide_String( 
+          ACL1.LC_A_Grave          & ACL1.LC_A_Ring  & ACL1.LC_AE_Diphthong &
+          ACL1.LC_C_Cedilla        & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex &
+          ACL1.LC_Icelandic_Eth    & ACL1.LC_N_Tilde & 
+          ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn & 
+          ACL1.LC_German_Sharp_S   & ACL1.LC_Y_Diaeresis);  
+
+      -- Note that there is no upper case version of the last two
+      -- characters from above.
+ 
+      TC_New_Character_String : Wide_String(1..12) :=
+        Handling.To_Wide_String(
+          ACL1.UC_A_Grave          & ACL1.UC_A_Ring  & ACL1.UC_AE_Diphthong &
+          ACL1.UC_C_Cedilla        & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex &
+          ACL1.UC_Icelandic_Eth    & ACL1.UC_N_Tilde &
+          ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn &  
+          ACL1.LC_German_Sharp_S   & ACL1.LC_Y_Diaeresis);  
+
+      -- Access objects that will be provided as parameters to the 
+      -- subprograms.
+      Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
+                                CXA4025_0.Map_To_Lower_Case'Access;
+      Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
+                                CXA4025_0.Map_To_Upper_Case'Access;
+
+   begin
+
+      -- 
+      -- Testing of functionality found in Package Ada.Strings.Wide_Maps.
+      -- 
+
+      -- Load the alphabet strings for use in creating sets.
+      for i in 0..25 loop
+         Alphabet(i+1) := Wide_Character'Val(Wide_Character'Pos('a')+i);
+      end loop;
+
+      -- Initialize a series of Character_Set objects.
+      Alphabet_Set    := Wide_Maps.To_Set(Alphabet);
+      Vowel_Set       := Wide_Maps.To_Set(Vowels);
+      Consonant_Set   := Vowel_Set  XOR  Alphabet_Set;
+
+      -- Evaluation of Set operator "-".
+      if 
+         (Alphabet_Set - Consonant_Set) /=
+                                  "AND"(Alphabet_Set, "NOT"(Consonant_Set)) or
+         (Alphabet_Set - Vowel_Set) /= "AND"(Alphabet_Set, "NOT"(Vowel_Set)) 
+      then
+         Report.Failed("Incorrect result from ""-"" operator for sets");
+      end if;
+
+      -- Evaluation of Functions To_Domain and To_Range.
+      declare
+         Null_Sequence  : constant Wide_Maps.Wide_Character_Sequence := "";
+         TC_UC_Sequence : constant Wide_Maps.Wide_Character_Sequence :=
+                                     "ZYXWVUTSRQPONMABCDEFGHIJKL";
+         TC_LC_Sequence : constant Wide_Maps.Wide_Character_Sequence :=
+                                     "zyxwvutsrqponmabcdefghijkl";
+         TC_Upper_to_Lower_Map  : Wide_Maps.Wide_Character_Mapping :=
+                                    Wide_Maps.To_Mapping(TC_UC_Sequence,
+                                                         TC_LC_Sequence);
+         TC_Lower_to_Upper_Map  : Wide_Maps.Wide_Character_Mapping :=
+                                    Wide_Maps.To_Mapping(TC_LC_Sequence,
+                                                         TC_UC_Sequence);
+      begin
+         declare
+            TC_Domain : constant Wide_Maps.Wide_Character_Sequence := 
+                             Wide_Maps.To_Domain(TC_Upper_to_Lower_Map);
+            TC_Range  : constant Wide_Maps.Wide_Character_Sequence :=
+                             Wide_Maps.To_Range(TC_Lower_to_Upper_Map);
+         begin
+            -- Function To_Domain returns the shortest Wide_Character_Sequence
+            -- value such that each wide character not in the result maps to
+            -- itself, and all wide characters in the result are in ascending 
+            -- order.
+            if TC_Domain /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then
+               Report.Failed("Incorrect result from To_Domain with " &
+                             "TC_Upper_to_Lower_Map as input");
+            end if;
+
+            -- The lower bound on the returned Wide_Character_Sequence value
+            -- from To_Domain must be 1.
+            if TC_Domain'First /= 1 then
+               Report.Failed("Incorrect lower bound returned from To_Domain");
+            end if;
+
+            -- Check contents of result of To_Range.
+            if TC_Range /= "ABCDEFGHIJKLMNOPQRSTUVWXYZ" then
+               Report.Failed("Incorrect result from To_Range with " &
+                             "TC_Lower_to_Upper_Map as input");
+            end if;
+
+            -- The lower bound on the returned Character_Sequence value
+            -- must be 1.
+            if TC_Range'First /= 1 then
+               Report.Failed("Incorrect lower bound returned from To_Range");
+            end if;
+
+            if TC_Range'Last /= TC_LC_Sequence'Length then
+               Report.Failed("Incorrect upper bound returned from To_Range");
+            end if;
+         end;
+
+         -- Both function To_Domain and To_Range return the null string 
+         -- when provided the Identity character map as an input parameter.
+         if Wide_Maps.To_Domain(Wide_Maps.Identity) /= Null_Sequence or
+            Wide_Maps.To_Range(Wide_Maps.Identity)  /= Null_Sequence 
+         then
+            Report.Failed("Null sequence not returned from To_Domain or " &
+                          "To_Range when provided the Identity map as input");
+         end if;
+      exception
+         when others => 
+           Report.Failed("Exception raised during the evaluation of " &
+                         "Function To_Domain and To_Range");
+      end;
+
+      -- Testing of functionality found in Package Ada.Strings.Wide_Fixed.
+      -- 
+      -- Function Index, Forward direction search.
+
+      if Wide_Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg",
+                          "MIXED CASE STRING",
+                          Ada.Strings.Forward,
+                          Map_To_Upper_Case_Ptr)               /= 12 or
+         Wide_Fixed.Index("STRING WITH NO MATCHING PATTERNS",
+                          "WITH",
+                          Ada.Strings.Forward,
+                          Map_To_Lower_Case_Ptr)               /= 0  
+      then
+         Report.Failed("Incorrect results from Function Index, going "    &
+                       "in Forward direction, using a Character Mapping " &
+                       "Function parameter");
+      end if;
+
+      -- Function Index, Backward direction search.
+      if Wide_Fixed.Index("Case of a Mixed Case String", 
+                          "case", 
+                          Ada.Strings.Backward,
+                          Map_To_Lower_Case_Ptr)               /= 17   or
+         Wide_Fixed.Index("WOULD MATCH BUT FOR THE CASE",
+                          "WOULD MATCH BUT FOR THE CASE",
+                          Ada.Strings.Backward,
+                          Map_To_Lower_Case_Ptr)               /= 0
+      then
+         Report.Failed("Incorrect results from Function Index, going "     &
+                       "in Backward direction, using a Character Mapping " &
+                       "Function parameter");
+      end if;
+
+      -- Function Count.
+      if Wide_Fixed.Count("ABABABA", "ABA",   Map_To_Upper_Case_Ptr) /= 2 or
+         Wide_Fixed.Count("",        "match", Map_To_Lower_Case_Ptr) /= 0
+      then
+         Report.Failed("Incorrect results from Function Count, using " &
+                       "a Character Mapping Function parameter");
+      end if;
+
+      -- Function Translate.
+      if Wide_Fixed.Translate(Source  => "A Sample Mixed Case String",
+                              Mapping => Map_To_Lower_Case_Ptr) /= 
+         "a sample mixed case string"                             or
+         Wide_Fixed.Translate(New_Character_String,
+                              Map_To_Upper_Case_Ptr)            /=
+         TC_New_Character_String
+      then
+         Report.Failed("Incorrect results from Function Translate, using " &
+                       "a Wide_Character Mapping Function parameter");
+      end if;
+
+      -- Procedure Translate.
+      declare
+         use Ada.Strings.Wide_Fixed;
+         Str : Wide_String(1..19) := "A Mixed Case String";
+      begin
+         Translate(Source => Str, Mapping => Map_To_Lower_Case_Ptr);
+         if Str /= "a mixed case string" then
+            Report.Failed("Incorrect result from Procedure Translate - 1");
+         end if;
+
+         Translate(New_Character_String, Map_To_Upper_Case_Ptr);
+         if New_Character_String /= TC_New_Character_String then
+            Report.Failed("Incorrect result from Procedure Translate - 2");
+         end if;
+      end;
+
+      -- Procedure Trim.
+      declare
+         use Ada.Strings.Wide_Fixed;
+         Trim_String : Wide_String(1..30) := "    A string of characters    ";
+      begin
+         Trim(Trim_String, Ada.Strings.Left, Ada.Strings.Right, 'x');
+         if Trim_String /= "xxxxA string of characters    " then
+            Report.Failed("Incorrect result from Procedure Trim, trim " &
+                          "side = left, justify = right, pad = x");
+         end if;
+
+         Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center);
+         if Trim_String /= "  xxxxA string of characters  " then
+            Report.Failed("Incorrect result from Procedure Trim, trim " &
+                          "side = right, justify = center, default pad");
+         end if;
+      end;
+
+      -- Procedure Head.
+      declare
+         Fixed_String : Wide_String(1..20) := "A sample test string";
+      begin
+         Wide_Fixed.Head(Source => Fixed_String, Count => 14, 
+                         Justify => Ada.Strings.Center, Pad => '$');
+         if Fixed_String /= "$$$A sample test $$$" then
+            Report.Failed("Incorrect result from Procedure Head, " &
+                          "justify = center, pad = $");
+         end if;
+
+         Wide_Fixed.Head(Fixed_String, 11, Ada.Strings.Right);
+         if Fixed_String /= "         $$$A sample" then
+            Report.Failed("Incorrect result from Procedure Head, " &
+                          "justify = right, default pad");
+         end if;
+      end;
+
+      -- Procedure Tail.
+      declare
+         use Ada.Strings.Wide_Fixed;
+         Tail_String : Wide_String(1..20) := "ABCDEFGHIJKLMNOPQRST";
+      begin
+         -- Default left justify.
+         Tail(Source => Tail_String, Count => 10, Pad => '-'); 
+         if Tail_String /= "KLMNOPQRST----------" then
+            Report.Failed("Incorrect result from Procedure Tail, " &
+                          "default justify, pad = -");
+         end if;
+
+         Tail(Tail_String, 6, Ada.Strings.Center, 'a');
+         if Tail_String /= "aaaaaaa------aaaaaaa" then
+            Report.Failed("Incorrect result from Procedure Tail, " &
+                          "justify = center, pad = a");
+         end if;
+      end;
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4025;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a
new file mode 100644
index 000000000..766979ad0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4026.a
@@ -0,0 +1,526 @@
+-- CXA4026.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 Ada.Strings.Fixed procedures Head, Tail, and Trim, as well 
+--      as the versions of subprograms Translate (procedure and function), 
+--      Index, and Count, available in the package which use a 
+--      Maps.Character_Mapping_Function input parameter, produce correct 
+--      results.
+--
+-- TEST DESCRIPTION:
+--      This test examines the operation of several subprograms contained in
+--      the Ada.Strings.Fixed package.  
+--      This includes procedure versions of Head, Tail, and Trim, as well as
+--      four subprograms that use a Character_Mapping_Function as a parameter 
+--      to provide the mapping capability.
+--      
+--      Two functions are defined to provide the mapping.  Access values 
+--      are defined to refer to these functions.  One of the functions will
+--      map upper case characters in the range 'A'..'Z' to their lower case
+--      counterparts, while the other function will map lower case characters
+--      ('a'..'z', or a character whose position is in one of the ranges 
+--      223..246 or 248..255, provided the character has an upper case form)
+--      to their upper case form.
+--      
+--      Function Index uses the mapping function access value to map the input
+--      string prior to searching for the appropriate index value to return.
+--      Function Count uses the mapping function access value to map the input
+--      string prior to counting the occurrences of the pattern string.
+--      Both the Procedure and Function version of Translate use the mapping
+--      function access value to perform the translation.
+--
+--      Results of all subprograms are compared with expected results.
+--      
+--       
+-- CHANGE HISTORY:
+--      10 Feb 95   SAIC    Initial prerelease version
+--      21 Apr 95   SAIC    Modified definition of string variable Str_2.
+--
+--!
+
+
+package CXA4026_0 is
+
+   -- Function Map_To_Lower_Case will return the lower case form of 
+   -- Characters in the range 'A'..'Z' only, and return the input
+   -- character otherwise.
+
+   function Map_To_Lower_Case (From : Character) return Character;
+
+
+   -- Function Map_To_Upper_Case will return the upper case form of 
+   -- Characters in the range 'a'..'z', or whose position is in one
+   -- of the ranges 223..246 or 248..255, provided the character has
+   -- an upper case form.               
+
+   function Map_To_Upper_Case (From : Character) return Character;
+
+end CXA4026_0;
+
+
+with Ada.Characters.Handling;
+package body CXA4026_0 is
+
+   function Map_To_Lower_Case (From : Character) return Character is
+   begin
+      if From in 'A'..'Z' then
+         return Character'Val(Character'Pos(From) -
+                             (Character'Pos('A') - Character'Pos('a')));
+      else
+         return From;
+      end if;
+   end Map_To_Lower_Case;
+
+   function Map_To_Upper_Case (From : Character) return Character is
+   begin
+      return Ada.Characters.Handling.To_Upper(From);
+   end Map_To_Upper_Case;
+
+end CXA4026_0;
+
+
+with CXA4026_0;
+with Ada.Strings.Fixed;
+with Ada.Strings.Maps;
+with Ada.Characters.Handling;
+with Ada.Characters.Latin_1;
+with Report;
+
+procedure CXA4026 is
+
+begin
+
+   Report.Test ("CXA4026", "Check that procedures Trim, Head, and Tail, " &
+                           "as well as the versions of subprograms "      &
+                           "Translate, Index, and Count, which use the "  &
+                           "Character_Mapping_Function input parameter,"  &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Strings, CXA4026_0;
+
+      -- The following strings are used in examination of the Translation
+      -- subprograms.
+
+      New_Character_String : String(1..10) :=
+                               Ada.Characters.Latin_1.LC_A_Grave          &
+                               Ada.Characters.Latin_1.LC_A_Ring           &
+                               Ada.Characters.Latin_1.LC_AE_Diphthong     &
+                               Ada.Characters.Latin_1.LC_C_Cedilla        &
+                               Ada.Characters.Latin_1.LC_E_Acute          &
+                               Ada.Characters.Latin_1.LC_I_Circumflex     &
+                               Ada.Characters.Latin_1.LC_Icelandic_Eth    &
+                               Ada.Characters.Latin_1.LC_N_Tilde          &
+                               Ada.Characters.Latin_1.LC_O_Oblique_Stroke &
+                               Ada.Characters.Latin_1.LC_Icelandic_Thorn;  
+ 
+
+      TC_New_Character_String : String(1..10) :=
+                               Ada.Characters.Latin_1.UC_A_Grave          &
+                               Ada.Characters.Latin_1.UC_A_Ring           &
+                               Ada.Characters.Latin_1.UC_AE_Diphthong     &
+                               Ada.Characters.Latin_1.UC_C_Cedilla        &
+                               Ada.Characters.Latin_1.UC_E_Acute          &
+                               Ada.Characters.Latin_1.UC_I_Circumflex     &
+                               Ada.Characters.Latin_1.UC_Icelandic_Eth    &
+                               Ada.Characters.Latin_1.UC_N_Tilde          &
+                               Ada.Characters.Latin_1.UC_O_Oblique_Stroke &
+                               Ada.Characters.Latin_1.UC_Icelandic_Thorn;  
+
+
+      -- Functions used to supply mapping capability.
+
+
+      -- Access objects that will be provided as parameters to the 
+      -- subprograms.
+
+      Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
+                                Map_To_Lower_Case'Access;
+
+      Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
+                                Map_To_Upper_Case'Access;
+
+
+   begin
+
+      -- Function Index, Forward direction search.
+      -- Note: Several of the following cases use the default value
+      --       Forward for the Going parameter.
+
+      if Fixed.Index(Source => "The library package Strings.Fixed",
+                     Pattern => "fix",
+                     Going   => Ada.Strings.Forward,
+                     Mapping => Map_To_Lower_Case_Ptr)    /= 29   or
+         Fixed.Index("THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN",
+                     "ain",
+                     Mapping => Map_To_Lower_Case_Ptr)    /= 6    or
+         Fixed.Index("maximum number",
+                     "um",
+                     Ada.Strings.Forward,
+                     Map_To_Lower_Case_Ptr)               /= 6    or
+         Fixed.Index("CoMpLeTeLy MiXeD CaSe StRiNg",
+                     "MIXED CASE STRING",
+                     Ada.Strings.Forward,
+                     Map_To_Upper_Case_Ptr)               /= 12   or
+         Fixed.Index("STRING WITH NO MATCHING PATTERNS",
+                     "WITH",
+                     Ada.Strings.Forward,
+                     Map_To_Lower_Case_Ptr)               /= 0    or
+         Fixed.Index("THIS STRING IS IN UPPER CASE",
+                     "IS",
+                     Ada.Strings.Forward,
+                     Map_To_Upper_Case_Ptr)               /= 3    or
+         Fixed.Index("",  -- Null string.
+                     "is",
+                     Mapping => Map_To_Lower_Case_Ptr)    /= 0    or
+         Fixed.Index("AAABBBaaabbb",
+                     "aabb",
+                     Mapping => Map_To_Lower_Case_Ptr)    /= 2
+      then
+         Report.Failed("Incorrect results from Function Index, going "    &
+                       "in Forward direction, using a Character Mapping " &
+                       "Function parameter");
+      end if;
+
+
+
+      -- Function Index, Backward direction search.
+
+      if Fixed.Index("Case of a Mixed Case String", 
+                     "case", 
+                     Ada.Strings.Backward,
+                     Map_To_Lower_Case_Ptr)               /= 17   or
+         Fixed.Index("Case of a Mixed Case String", 
+                     "CASE", 
+                     Ada.Strings.Backward,
+                     Map_To_Upper_Case_Ptr)               /= 17   or
+         Fixed.Index("rain, Rain, and more RAIN",
+                     "rain",
+                     Ada.Strings.Backward,
+                     Map_To_Lower_Case_Ptr)               /= 22   or
+         Fixed.Index("RIGHT place, right time",
+                     "RIGHT",
+                     Ada.Strings.Backward,
+                     Map_To_Upper_Case_Ptr)               /= 14   or
+         Fixed.Index("WOULD MATCH BUT FOR THE CASE",
+                     "WOULD MATCH BUT FOR THE CASE",
+                     Ada.Strings.Backward,
+                     Map_To_Lower_Case_Ptr)               /= 0
+      then
+         Report.Failed("Incorrect results from Function Index, going "     &
+                       "in Backward direction, using a Character Mapping " &
+                       "Function parameter");
+      end if;
+
+
+
+      -- Function Index, Pattern_Error if Pattern = Null_String
+
+      declare
+         use Ada.Strings.Fixed;
+         Null_Pattern_String : constant String := "";
+         TC_Natural          : Natural         := 1000;
+      begin
+         TC_Natural := Index("A Valid String", 
+                             Null_Pattern_String,
+                             Ada.Strings.Forward,
+                             Map_To_Lower_Case_Ptr);
+         Report.Failed("Pattern_Error not raised by Function Index when " &
+                       "given a null pattern string");
+      exception
+         when Pattern_Error => null;   -- OK, expected exception.
+         when others        =>
+            Report.Failed("Incorrect exception raised by Function Index " &
+                          "using a Character Mapping Function parameter " &
+                          "when given a null pattern string");
+      end;
+
+
+
+      -- Function Count.
+
+      if Fixed.Count(Source  => "ABABABA",        
+                     Pattern => "aba",
+                     Mapping => Map_To_Lower_Case_Ptr)        /=  2   or
+         Fixed.Count("ABABABA", "ABA", Map_To_Lower_Case_Ptr) /=  0   or
+         Fixed.Count("This IS a MISmatched issue",
+                     "is",
+                     Map_To_Lower_Case_Ptr)                   /=  4   or
+         Fixed.Count("ABABABA", "ABA", Map_To_Upper_Case_Ptr) /=  2   or
+         Fixed.Count("This IS a MISmatched issue",
+                     "is",
+                     Map_To_Upper_Case_Ptr)                   /=  0   or
+         Fixed.Count("She sells sea shells by the sea shore",
+                     "s",
+                     Map_To_Lower_Case_Ptr)                   /=  8   or
+         Fixed.Count("",                       -- Null string.
+                     "match",
+                     Map_To_Upper_Case_Ptr)                   /=  0
+      then
+         Report.Failed("Incorrect results from Function Count, using " &
+                       "a Character Mapping Function parameter");
+      end if;
+
+
+
+      -- Function Count, Pattern_Error if Pattern = Null_String
+
+      declare
+         use Ada.Strings.Fixed;
+         Null_Pattern_String : constant String := "";
+         TC_Natural          : Natural         := 1000;
+      begin
+         TC_Natural := Count("A Valid String", 
+                             Null_Pattern_String,
+                             Map_To_Lower_Case_Ptr);
+         Report.Failed("Pattern_Error not raised by Function Count using " &
+                       "a Character Mapping Function parameter when "      &
+                       "given a null pattern string");
+      exception
+         when Pattern_Error => null;   -- OK, expected exception.
+         when others        =>
+            Report.Failed("Incorrect exception raised by Function Count " &
+                          "using a Character Mapping Function parameter " &
+                          "when given a null pattern string");
+      end;
+
+
+
+      -- Function Translate.
+
+      if Fixed.Translate(Source  => "A Sample Mixed Case String",
+                         Mapping => Map_To_Lower_Case_Ptr) /= 
+         "a sample mixed case string"                         or
+
+         Fixed.Translate("ALL LOWER CASE",
+                         Map_To_Lower_Case_Ptr)            /= 
+         "all lower case"                                     or
+
+         Fixed.Translate("end with lower case",
+                         Map_To_Lower_Case_Ptr)            /= 
+         "end with lower case"                                or
+
+         Fixed.Translate("", Map_To_Lower_Case_Ptr)        /=
+         ""                                                   or
+
+         Fixed.Translate("start with lower case",
+                         Map_To_Upper_Case_Ptr)            /= 
+         "START WITH LOWER CASE"                              or
+
+         Fixed.Translate("ALL UPPER CASE STRING",
+                         Map_To_Upper_Case_Ptr)            /=
+         "ALL UPPER CASE STRING"                              or
+
+         Fixed.Translate("LoTs Of MiXeD CaSe ChArAcTeRs",
+                         Map_To_Upper_Case_Ptr)            /=
+         "LOTS OF MIXED CASE CHARACTERS"                      or
+
+         Fixed.Translate("", Map_To_Upper_Case_Ptr)        /=
+         ""                                                   or
+
+         Fixed.Translate(New_Character_String,
+                         Map_To_Upper_Case_Ptr)            /=
+         TC_New_Character_String
+      then
+         Report.Failed("Incorrect results from Function Translate, using " &
+                       "a Character Mapping Function parameter");
+      end if;
+
+
+
+      -- Procedure Translate.
+
+      declare
+
+         use Ada.Strings.Fixed;
+
+         Str_1    : String(1..24)   := "AN ALL UPPER CASE STRING";
+         Str_2    : String(1..19)   := "A Mixed Case String";
+         Str_3    : String(1..32)   := "a string with lower case letters";
+         TC_Str_1 : constant String := Str_1;
+         TC_Str_3 : constant String := Str_3;
+
+      begin
+
+         Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr);
+
+         if Str_1 /= "an all upper case string" then
+            Report.Failed("Incorrect result from Procedure Translate - 1");
+         end if;
+
+         Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr);
+
+         if Str_1 /= TC_Str_1 then
+            Report.Failed("Incorrect result from Procedure Translate - 2");
+         end if;
+
+         Translate(Source => Str_2, Mapping => Map_To_Lower_Case_Ptr);
+
+         if Str_2 /= "a mixed case string" then
+            Report.Failed("Incorrect result from Procedure Translate - 3");
+         end if;
+
+         Translate(Source => Str_2, Mapping => Map_To_Upper_Case_Ptr);
+
+         if Str_2 /= "A MIXED CASE STRING" then
+            Report.Failed("Incorrect result from Procedure Translate - 4");
+         end if;
+
+         Translate(Source => Str_3, Mapping => Map_To_Lower_Case_Ptr);
+
+         if Str_3 /= TC_Str_3 then
+            Report.Failed("Incorrect result from Procedure Translate - 5");
+         end if;
+
+         Translate(Source => Str_3, Mapping => Map_To_Upper_Case_Ptr);
+
+         if Str_3 /= "A STRING WITH LOWER CASE LETTERS" then
+            Report.Failed("Incorrect result from Procedure Translate - 6");
+         end if;
+
+         Translate(New_Character_String, Map_To_Upper_Case_Ptr);
+
+         if New_Character_String /= TC_New_Character_String then
+            Report.Failed("Incorrect result from Procedure Translate - 6");
+         end if;
+
+      end;
+
+
+      -- Procedure Trim.
+
+      declare
+         Use Ada.Strings.Fixed;
+         Trim_String : String(1..30) := "    A string of characters    ";
+      begin
+
+         Trim(Source  => Trim_String,
+              Side    => Ada.Strings.Left,
+              Justify => Ada.Strings.Right,
+              Pad     => 'x');
+         
+         if Trim_String /= "xxxxA string of characters    " then
+            Report.Failed("Incorrect result from Procedure Trim, trim " &
+                          "side = left, justify = right, pad = x");
+         end if;
+
+         Trim(Trim_String, Ada.Strings.Right, Ada.Strings.Center);
+
+         if Trim_String /= "  xxxxA string of characters  " then
+            Report.Failed("Incorrect result from Procedure Trim, trim " &
+                          "side = right, justify = center, default pad");
+         end if;
+
+         Trim(Trim_String, Ada.Strings.Both, Pad => '*');
+
+         if Trim_String /= "xxxxA string of characters****" then
+            Report.Failed("Incorrect result from Procedure Trim, trim " &
+                          "side = both, default justify, pad = *");
+         end if;
+
+      end;
+
+
+      -- Procedure Head.
+
+      declare
+         Fixed_String : String(1..20) := "A sample test string";
+      begin
+
+         Fixed.Head(Source  => Fixed_String,
+                    Count   => 14,
+                    Justify => Ada.Strings.Center,
+                    Pad     => '$');
+
+         if Fixed_String /= "$$$A sample test $$$" then
+            Report.Failed("Incorrect result from Procedure Head, " &
+                          "justify = center, pad = $");
+         end if;
+
+         Fixed.Head(Fixed_String, 11, Ada.Strings.Right);
+
+         if Fixed_String /= "         $$$A sample" then
+            Report.Failed("Incorrect result from Procedure Head, " &
+                          "justify = right, default pad");
+         end if;
+
+         Fixed.Head(Fixed_String, 9, Pad => '*');
+ 
+         if Fixed_String /= "         ***********" then
+            Report.Failed("Incorrect result from Procedure Head, " &
+                          "default justify, pad = *");
+         end if;
+
+      end;
+
+
+      -- Procedure Tail.
+
+      declare
+         Use Ada.Strings.Fixed;
+         Tail_String : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
+      begin
+
+         Tail(Source => Tail_String, Count => 10, Pad => '-');
+
+         if Tail_String /= "KLMNOPQRST----------" then
+            Report.Failed("Incorrect result from Procedure Tail, " &
+                          "default justify, pad = -");
+         end if;
+
+         Tail(Tail_String, 6, Justify => Ada.Strings.Center, Pad => 'a');
+
+         if Tail_String /= "aaaaaaa------aaaaaaa" then
+            Report.Failed("Incorrect result from Procedure Tail, " &
+                          "justify = center, pad = a");
+         end if;
+
+         Tail(Tail_String, 1, Ada.Strings.Right);
+
+         if Tail_String /= "                   a" then
+            Report.Failed("Incorrect result from Procedure Tail, " &
+                          "justify = right, default pad");
+         end if;
+
+         Tail(Tail_String, 19, Ada.Strings.Right, 'A');
+
+         if Tail_String /= "A                  a" then
+            Report.Failed("Incorrect result from Procedure Tail, " &
+                          "justify = right, pad = A");
+         end if;
+
+      end;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+
+   Report.Result;
+
+end CXA4026;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a
new file mode 100644
index 000000000..05c66d4cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4027.a
@@ -0,0 +1,342 @@
+-- CXA4027.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 versions of Ada.Strings.Bounded subprograms Translate,
+--      (procedure and function), Index, and Count, which use the 
+--      Maps.Character_Mapping_Function input parameter, produce correct 
+--      results.
+--
+-- TEST DESCRIPTION:
+--      This test examines the operation of several subprograms from within 
+--      the Ada.Strings.Bounded package that use the 
+--      Character_Mapping_Function mapping parameter to provide a mapping
+--      capability.
+--      
+--      Two functions are defined to provide the mapping.  Access values 
+--      are defined to refer to these functions.  One of the functions will
+--      map upper case characters in the range 'A'..'Z' to their lower case
+--      counterparts, while the other function will map lower case characters
+--      ('a'..'z', or a character whose position is in one of the ranges 
+--      223..246 or 248..255, provided the character has an upper case form)
+--      to their upper case form.
+--      
+--      Function Index uses the mapping function access value to map the input
+--      string prior to searching for the appropriate index value to return.
+--      Function Count uses the mapping function access value to map the input
+--      string prior to counting the occurrences of the pattern string.
+--      Both the Procedure and Function version of Translate use the mapping
+--      function access value to perform the translation.
+--
+--      
+-- CHANGE HISTORY:
+--      16 FEB 95   SAIC    Initial prerelease version
+--      17 Jul 95   SAIC    Incorporated reviewer comments.  Replaced two 
+--                          internally declared functions with two library
+--                          level functions to eliminate accessibility
+--                          problems.
+--
+--!
+
+
+-- Function CXA4027_0 will return the lower case form of 
+-- the character input if it is in upper case, and return the input
+-- character otherwise.
+
+with Ada.Characters.Handling;
+function CXA4027_0 (From : Character) return Character;
+
+function CXA4027_0 (From : Character) return Character is
+begin
+   return Ada.Characters.Handling.To_Lower(From);
+end CXA4027_0;
+
+
+
+-- Function CXA4027_1 will return the upper case form of 
+-- Characters in the range 'a'..'z', or whose position is in one
+-- of the ranges 223..246 or 248..255, provided the character has
+-- an upper case form.
+
+with Ada.Characters.Handling;
+function CXA4027_1 (From : Character) return Character;
+
+function CXA4027_1 (From : Character) return Character is
+begin
+   return Ada.Characters.Handling.To_Upper(From);
+end CXA4027_1;
+
+
+with CXA4027_0, CXA4027_1;
+with Ada.Strings.Bounded;
+with Ada.Strings.Maps;
+with Ada.Characters.Handling;
+with Report;
+
+procedure CXA4027 is
+begin
+
+   Report.Test ("CXA4027", "Check that Ada.Strings.Bounded subprograms "  &
+                           "Translate, Index, and Count, which use the "  &
+                           "Character_Mapping_Function input parameter, " &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Strings;
+
+      -- Functions used to supply mapping capability.
+
+      function Map_To_Lower_Case (From : Character) return Character 
+        renames CXA4027_0; 
+
+      function Map_To_Upper_Case (From : Character) return Character
+        renames CXA4027_1; 
+
+      Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
+                                Map_To_Lower_Case'Access;
+
+      Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
+                                Map_To_Upper_Case'Access;
+
+
+      -- Instantiations of Bounded String generic package.
+
+      package BS1  is new Ada.Strings.Bounded.Generic_Bounded_Length(1);
+      package BS20 is new Ada.Strings.Bounded.Generic_Bounded_Length(20);
+      package BS40 is new Ada.Strings.Bounded.Generic_Bounded_Length(40);
+      package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80);
+
+      use type BS1.Bounded_String,  BS20.Bounded_String, 
+               BS40.Bounded_String, BS80.Bounded_String;
+
+      String_1   : String(1..1)  := "A";
+      String_20  : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
+      String_40  : String(1..40) := "abcdefghijklmnopqrst" & String_20;
+      String_80  : String(1..80) := String_40 & String_40;
+
+      BString_1  : BS1.Bounded_String  := BS1.Null_Bounded_String;
+      BString_20 : BS20.Bounded_String := BS20.Null_Bounded_String;
+      BString_40 : BS40.Bounded_String := BS40.Null_Bounded_String;
+      BString_80 : BS80.Bounded_String := BS80.Null_Bounded_String;
+
+
+   begin
+
+      -- Function Index.
+
+      if BS40.Index(BS40.To_Bounded_String("Package Strings.Bounded"),
+                    Pattern => "s.b",
+                    Going   => Ada.Strings.Forward,
+                    Mapping => Map_To_Lower_Case_Ptr)     /= 15  or
+         BS80.Index(BS80.To_Bounded_String("STRING TRANSLATIONS SUBPROGRAMS"),
+                    "tr",
+                    Mapping => Map_To_Lower_Case_Ptr)     /= 2   or
+         BS20.Index(BS20.To_Bounded_String("maximum number"),
+                    "um",
+                    Ada.Strings.Backward,
+                    Map_To_Lower_Case_Ptr)                /= 10  or
+         BS80.Index(BS80.To_Bounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"),
+                    "MIXED CASE STRING",
+                    Ada.Strings.Forward,
+                    Map_To_Upper_Case_Ptr)                /= 12  or
+         BS40.Index(BS40.To_Bounded_String("STRING WITH NO MATCHING PATTERN"),
+                    "WITH",
+                    Ada.Strings.Backward,
+                    Map_To_Lower_Case_Ptr)                /= 0   or
+         BS80.Index(BS80.To_Bounded_String("THIS STRING IS IN UPPER CASE"),
+                    "I",
+                    Ada.Strings.Backward,
+                    Map_To_Upper_Case_Ptr)                /= 16  or
+         BS1.Index(BS1.Null_Bounded_String,
+                   "i",
+                   Mapping => Map_To_Lower_Case_Ptr)      /= 0   or
+         BS40.Index(BS40.To_Bounded_String("AAABBBaaabbb"),
+                    "aabb",
+                    Mapping => Map_To_Lower_Case_Ptr)     /= 2   or
+         BS80.Index(BS80.To_Bounded_String("WOULD MATCH BUT FOR THE CASE"),
+                    "WOULD MATCH BUT FOR THE CASE",
+                    Ada.Strings.Backward,
+                    Map_To_Lower_Case_Ptr)                /= 0
+      then
+         Report.Failed("Incorrect results from Function Index, using a " &
+                       "Character Mapping Function parameter");
+      end if;
+
+
+      -- Function Index, Pattern_Error if Pattern = Null_String
+
+      declare
+         use BS20;
+         TC_Natural : Natural := 1000;
+      begin
+         TC_Natural := Index(To_Bounded_String("A Valid String"), 
+                             "",
+                             Ada.Strings.Forward,
+                             Map_To_Lower_Case_Ptr);
+         Report.Failed("Pattern_Error not raised by Function Index when " &
+                       "given a null pattern string");
+      exception
+         when Pattern_Error => null;   -- OK, expected exception.
+         when others        =>
+            Report.Failed("Incorrect exception raised by Function Index " &
+                          "using a Character_Mapping_Function parameter " &
+                          "when given a null pattern string");
+      end;
+
+
+      -- Function Count.
+
+      if BS20.Count(BS20.To_Bounded_String("ABABABA"), 
+                    Pattern => "aba",
+                    Mapping => Map_To_Lower_Case_Ptr)        /=  2   or
+         BS20.Count(BS20.To_Bounded_String("ABABABA"),
+                    "ABA", 
+                    Map_To_Lower_Case_Ptr)                   /=  0   or
+         BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),
+                    "is",
+                    Map_To_Lower_Case_Ptr)                   /=  4   or
+         BS80.Count(BS80.To_Bounded_String("ABABABA"), 
+                    "ABA", 
+                    Map_To_Upper_Case_Ptr)                   /=  2   or
+         BS40.Count(BS40.To_Bounded_String("This IS a MISmatched issue"),
+                    "is",
+                    Map_To_Upper_Case_Ptr)                   /=  0   or
+         BS80.Count(BS80.To_Bounded_String
+                           ("Peter Piper and his Pickled Peppers"),
+                    "p",
+                    Map_To_Lower_Case_Ptr)                   /=  7   or
+         BS20.Count(BS20.To_Bounded_String("She sells sea shells"),
+                    "s",
+                    Map_To_Upper_Case_Ptr)                   /=  0   or
+         BS80.Count(BS80.To_Bounded_String("No matches what-so-ever"),
+                    "matches",
+                    Map_To_Upper_Case_Ptr)                   /=  0
+      then
+         Report.Failed("Incorrect results from Function Count, using " &
+                       "a Character_Mapping_Function parameter");
+      end if;
+
+
+      -- Function Count, Pattern_Error if Pattern = Null_String
+
+      declare
+         use BS80;
+         TC_Natural : Natural := 1000;
+      begin
+         TC_Natural := Count(To_Bounded_String("A Valid String"), 
+                             "",
+                             Map_To_Lower_Case_Ptr);
+         Report.Failed("Pattern_Error not raised by Function Count using " &
+                       "a Character_Mapping_Function parameter when "      &
+                       "given a null pattern string");
+      exception
+         when Pattern_Error => null;   -- OK, expected exception.
+         when others        =>
+            Report.Failed("Incorrect exception raised by Function Count " &
+                          "using a Character_Mapping_Function parameter " &
+                          "when given a null pattern string");
+      end;
+
+
+      -- Function Translate.
+
+      if BS40.Translate(BS40.To_Bounded_String("A Mixed Case String"),
+                        Mapping => Map_To_Lower_Case_Ptr) /= 
+         BS40.To_Bounded_String("a mixed case string")      or
+
+         BS20."/="(BS20.Translate(BS20.To_Bounded_String("ALL LOWER CASE"),
+                                  Map_To_Lower_Case_Ptr),
+                   "all lower case")                        or
+
+         BS20."/="("end with lower case",
+                   BS20.Translate(
+                     BS20.To_Bounded_String("end with lower case"),
+                     Map_To_Lower_Case_Ptr))                or
+
+         BS1.Translate(BS1.Null_Bounded_String, 
+                       Map_To_Lower_Case_Ptr)             /=
+         BS1.Null_Bounded_String                            or
+
+         BS80."/="(BS80.Translate(BS80.To_Bounded_String
+                          ("start with lower case, end with upper case"),
+                        Map_To_Upper_Case_Ptr),
+                   "START WITH LOWER CASE, END WITH UPPER CASE") or
+
+         BS40.Translate(BS40.To_Bounded_String("ALL UPPER CASE STRING"),
+                        Map_To_Upper_Case_Ptr)            /=
+         BS40.To_Bounded_String("ALL UPPER CASE STRING")    or
+
+         BS80."/="(BS80.Translate(BS80.To_Bounded_String
+                          ("LoTs Of MiXeD CaSe ChArAcTeRs In ThE StRiNg"),
+                          Map_To_Upper_Case_Ptr),
+                   "LOTS OF MIXED CASE CHARACTERS IN THE STRING")
+
+      then
+         Report.Failed("Incorrect results from Function Translate, using " &
+                       "a Character_Mapping_Function parameter");
+      end if;
+
+
+      -- Procedure Translate.
+
+      BString_1 := BS1.To_Bounded_String("A");
+
+      BS1.Translate(Source => BString_1, Mapping => Map_To_Lower_Case_Ptr);
+
+      if not BS1."="(BString_1, "a") then    -- "=" for Bounded_String, String
+         Report.Failed("Incorrect result from Procedure Translate - 1");
+      end if;
+
+      BString_20 := BS20.To_Bounded_String(String_20);
+      BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr);
+
+      if BString_20 /= BS20.To_Bounded_String("abcdefghijklmnopqrst") then
+         Report.Failed("Incorrect result from Procedure Translate - 2");
+      end if;
+
+      BString_40 := BS40.To_Bounded_String("String needing highlighting");
+      BS40.Translate(BString_40, Map_To_Upper_Case_Ptr);
+
+      if not (BString_40 = "STRING NEEDING HIGHLIGHTING") then
+         Report.Failed("Incorrect result from Procedure Translate - 3");
+      end if;
+
+      BString_80 := BS80.Null_Bounded_String;
+      BS80.Translate(BString_80, Map_To_Upper_Case_Ptr);
+
+      if not (BString_80 = BS80.Null_Bounded_String) then
+         Report.Failed("Incorrect result from Procedure Translate - 4");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4027;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4028.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4028.a
new file mode 100644
index 000000000..bc6cac14c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4028.a
@@ -0,0 +1,331 @@
+-- CXA4028.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 Ada.Strings.Bounded procedures Append, Head, Tail, and 
+--      Trim, and relational operator functions "=", ">", ">=", "<", "<=" 
+--      with parameter combinations of type String and Bounded_String, 
+--      produce correct results.
+--
+-- TEST DESCRIPTION:
+--      This test examines the operation of several subprograms from within 
+--      the Ada.Strings.Bounded package.  Four different instantiations of
+--      Ada.Strings.Bounded.Generic_Bounded_Length provide packages defined
+--      to manipulate bounded strings of lengths 1, 20, 40, and 80.
+--      Examples of the above mentioned procedures and relational operators
+--      from each of these instantiations are tested, with results compared
+--      against expected output.
+--      
+--      Testing of the function versions of many of the subprograms tested
+--      here is performed in tests CXA4006-CXA4009.
+--      
+--       
+-- CHANGE HISTORY:
+--      16 Feb 95   SAIC    Initial prerelease version
+--      10 Mar 95   SAIC    Incorporated reviewer comments.
+--      15 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--
+--!
+
+with Ada.Exceptions;
+with Ada.Strings.Bounded;
+with Report;
+
+procedure CXA4028 is
+
+begin
+
+   Report.Test ("CXA4028", "Check that Ada.Strings.Bounded procedures "    &
+                           "Append, Head, Tail, and Trim, and relational " &
+                           "operator functions =, >, >=, <, <= with "      &
+                           "parameter combinations of type String and "    &
+                           "Bounded_String, produce correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+      use Ada.Strings;
+
+      -- Instantiations of Bounded String generic package.
+
+      package BS1  is new Ada.Strings.Bounded.Generic_Bounded_Length(1);
+      package BS20 is new Ada.Strings.Bounded.Generic_Bounded_Length(20);
+      package BS40 is new Ada.Strings.Bounded.Generic_Bounded_Length(40);
+      package BS80 is new Ada.Strings.Bounded.Generic_Bounded_Length(80);
+
+      use type BS1.Bounded_String,  BS20.Bounded_String, 
+               BS40.Bounded_String, BS80.Bounded_String;
+
+      String_1   : String(1..1)  := "A";
+      String_20  : String(1..20) := "ABCDEFGHIJKLMNOPQRST";
+      String_40  : String(1..40) := "abcdefghijklmnopqrst" & String_20;
+      String_80  : String(1..80) := String_40 & String_40;
+
+      BString_1  : BS1.Bounded_String  := BS1.Null_Bounded_String;
+      BString_20 : BS20.Bounded_String := BS20.Null_Bounded_String;
+      BString_40 : BS40.Bounded_String := BS40.Null_Bounded_String;
+      BString_80 : BS80.Bounded_String := BS80.Null_Bounded_String;
+
+   begin
+
+      -- Procedure Append.
+
+      declare
+         use BS1, BS20;
+      begin
+         Append(Source => BString_1, New_Item => To_Bounded_String("A"));
+         Append(BString_1, "B", Ada.Strings.Left);
+         Append(BString_1, 'C', Drop => Ada.Strings.Right); -- Drop appended
+                                                            -- character.
+         if BString_1 /= To_Bounded_String("B") then
+            Report.Failed("Incorrect results from BS1 versions of " &
+                          "procedure Append");
+         end if;
+
+         Append(BString_20, 'T');                      -- Character.
+         Append(BString_20, "his string");             -- String.
+         Append(BString_20, 
+                To_Bounded_String(" is complete."),    -- Bounded string.
+                Drop => Ada.Strings.Right);            -- Drop 4 characters.
+
+         if BString_20 /= To_Bounded_String("This string is compl") then
+            Report.Failed("Incorrect results from BS20 versions of " &
+                          "procedure Append");
+         end if;
+      end;
+
+
+      -- Operator "=".
+
+      BString_40 := BS40.To_Bounded_String(String_40);
+      BString_80 := BS80.To_Bounded_String(
+                           BS40.To_String(BString_40) &
+                           BS40.To_String(BString_40));
+
+      if not (BString_40 = String_40 and         -- (Bounded_String, String)
+              BS80."="(String_80, BString_80))   -- (String, Bounded_String)
+      then
+         Report.Failed("Incorrect results from function ""="" with " &
+                       "string - bounded string parameter combinations");
+      end if;
+
+
+      -- Operator "<". 
+
+      BString_1  := BS1.To_Bounded_String("cat",         -- string "c" only.
+                                          Drop => Ada.Strings.Right);
+      BString_20 := BS20.To_Bounded_String("Santa Claus");
+
+      if BString_1 < "C"        or               -- (Bounded_String, String)
+         BS1."<"(BString_1,"c") or               -- (Bounded_String, String)
+         "x"  < BString_1       or               -- (String, Bounded_String)
+         BString_20 < "Santa "  or               -- (Bounded_String, String)
+         "Santa and his Elves" < BString_20      -- (String, Bounded_String)
+      then
+         Report.Failed("Incorrect results from function ""<"" with " &
+                       "string - bounded string parameter combinations");
+      end if;
+
+
+      -- Operator "<=". 
+
+      BString_20 := BS20.To_Bounded_String("Sample string");
+
+      if BString_20          <= "Sample strin"  or -- (Bounded_String, String)
+         "sample string"     <= BString_20      or -- (String, Bounded_String)
+         not("Sample string" <= BString_20)        -- (String, Bounded_String)
+      then
+         Report.Failed("Incorrect results from function ""<="" with " &
+                       "string - bounded string parameter combinations");
+      end if;
+
+
+      -- Operator ">". 
+
+      BString_40 := BS40.To_Bounded_String("A MUCH LONGER SAMPLE STRING.");
+
+      if BString_40 > "A much longer sample string"     or  -- (Bnd_Str, Str)
+         String_20  > BS40.To_Bounded_String(String_40) or  -- (Str, Bnd_Str)
+         BS40.To_Bounded_String("ABCDEFGH") > "abcdefgh"    -- (Str, Bnd_Str)
+      then
+         Report.Failed("Incorrect results from function "">"" with " &
+                       "string - bounded string parameter combinations");
+      end if;
+
+
+      -- Operator ">=". 
+
+      BString_80 := BS80.To_Bounded_String(String_80);
+
+      if not (BString_80 >= String_80  and 
+              BS80.To_Bounded_String("Programming") >= "PROGRAMMING" and
+              "test" >= BS80.To_Bounded_String("tess"))
+      then
+         Report.Failed("Incorrect results from function "">="" with " &
+                       "string - bounded string parameter combinations");
+      end if;
+
+
+      -- Procedure Trim
+
+      BString_20 := BS20.To_Bounded_String("      Left Spaces  ");
+      BS20.Trim(Source => BString_20, 
+                Side   => Ada.Strings.Left);
+
+      if "Left Spaces  " /= BString_20 then
+         Report.Failed("Incorrect results from Procedure Trim with " &
+                       "Side = Left");
+      end if;
+
+      BString_40 := BS40.To_Bounded_String("    Right Spaces    ");
+      BS40.Trim(BString_40, Side => Ada.Strings.Right);
+
+      if BString_40 /= "    Right Spaces" then
+         Report.Failed("Incorrect results from Procedure Trim with " &
+                       "Side = Right");
+      end if;
+
+      BString_20 := BS20.To_Bounded_String("   Both Sides      ");
+      BS20.Trim(BString_20, Ada.Strings.Both);
+
+      if BString_20 /= BS20.To_Bounded_String("Both Sides") then
+         Report.Failed("Incorrect results from Procedure Trim with " &
+                       "Side = Both");
+      end if;
+
+      BString_80 := BS80.To_Bounded_String("Centered    Spaces");
+      BS80.Trim(BString_80, Ada.Strings.Both);
+
+      if BString_80 /= BS80.To_Bounded_String("Centered    Spaces") then
+         Report.Failed("Incorrect results from Procedure Trim with " &
+                       "no blank spaces on the ends of the string");
+      end if;
+
+
+      -- Procedure Head
+
+      BString_40 := BS40.To_Bounded_String("Test String");
+      BS40.Head(Source => BString_40,
+                Count  => 4);                       -- Count < Source'Length
+
+      if BString_40 /= BS40.To_Bounded_String("Test") then
+         Report.Failed("Incorrect results from Procedure Head with " &
+                       "the Count parameter less than Source'Length");
+      end if;
+
+      BString_1 := BS1.To_Bounded_String("X");
+      BS1.Head(BString_1, BS1.Length(BString_1));   -- Count = Source'Length
+
+      if BString_1 /= "X" then
+         Report.Failed("Incorrect results from Procedure Head with " &
+                       "the Count parameter equal to Source'Length");
+      end if;
+
+      BString_20 := BS20.To_Bounded_String("Sample string");
+      BS20.Head(BString_20, 
+                Count => BS20.Max_Length,           -- Count > Source'Length
+                Pad => '*');
+
+      if BString_20 /= BS20.To_Bounded_String("Sample string*******") then
+         Report.Failed("Incorrect results from Procedure Head with "    &
+                       "the Count parameter greater than Source'Length");
+      end if;
+
+      BString_20 := BS20.To_Bounded_String("Twenty Characters 20");
+      BS20.Head(BString_20, 22, Pad => '*', Drop => Ada.Strings.Left);
+
+      if BString_20 /= "enty Characters 20**" then
+         Report.Failed("Incorrect results from Procedure Head with "      &
+                       "the Count parameter greater than Source'Length, " &
+                       "and the Drop parameter = Left");
+      end if;
+
+      BString_20 := BS20.To_Bounded_String("Short String");
+      BS20.Head(BString_20, 23, '-', Ada.Strings.Right);
+
+      if ("Short String--------") /= BString_20 then
+         Report.Failed("Incorrect results from Procedure Head with " &
+                       "the Count parameter greater than Source'Length, " &
+                       "and the Drop parameter = Right");
+      end if;
+
+
+      -- Procedure Tail
+
+      BString_40 := BS40.To_Bounded_String("Test String");
+      BS40.Tail(Source => BString_40,
+                Count  => 6);                       -- Count < Source'Length
+
+      if BString_40 /= BS40.To_Bounded_String("String") then
+         Report.Failed("Incorrect results from Procedure Tail with " &
+                       "the Count parameter less than Source'Length");
+      end if;
+
+      BString_1 := BS1.To_Bounded_String("X");
+      BS1.Tail(BString_1, BS1.Length(BString_1));   -- Count = Source'Length
+
+      if BString_1 /= "X" then
+         Report.Failed("Incorrect results from Procedure Tail with " &
+                       "the Count parameter equal to Source'Length");
+      end if;
+
+      BString_20 := BS20.To_Bounded_String("Sample string");
+      BS20.Tail(BString_20, 
+                Count => BS20.Max_Length,           -- Count > Source'Length
+                Pad => '*');
+
+      if BString_20 /= BS20.To_Bounded_String("*******Sample string") then
+         Report.Failed("Incorrect results from Procedure Tail with "    &
+                       "the Count parameter greater than Source'Length");
+      end if;
+
+      BString_20 := BS20.To_Bounded_String("Twenty Characters");  -- Len = 17
+      BS20.Tail(BString_20, 22, Pad => '*', Drop => Ada.Strings.Left);
+
+      if BString_20 /= "***Twenty Characters" then
+         Report.Failed("Incorrect results from Procedure Tail with "      &
+                       "the Count parameter greater than Source'Length, " &
+                       "and the Drop parameter = Left");
+      end if;
+
+      BString_20 := BS20.To_Bounded_String("Maximum Length Chars");
+      BS20.Tail(BString_20, 23, '-', Ada.Strings.Right);
+
+      if ("---Maximum Length Ch") /= BString_20 then
+         Report.Failed("Incorrect results from Procedure Tail with " &
+                       "the Count parameter greater than Source'Length, " &
+                       "and the Drop parameter = Right");
+      end if;
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4028;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a
new file mode 100644
index 000000000..714067454
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4029.a
@@ -0,0 +1,333 @@
+-- CXA4029.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 functionality found in packages Ada.Strings.Wide_Maps,
+--      Ada.Strings.Wide_Bounded, and Ada.Strings.Wide_Maps.Wide_Constants 
+--      is available and produces correct results.
+--
+-- TEST DESCRIPTION:
+--      This test tests the subprograms found in the 
+--      Ada.Strings.Wide_Bounded package.  It is based on the tests
+--      CXA4027-28, which are tests for the complementary "non-wide" 
+--      packages.
+--      
+--      The functions found in CXA4029_0 provide mapping capability, when
+--      used in conjunction with Wide_Character_Mapping_Function objects.
+--
+--       
+-- CHANGE HISTORY:
+--      23 Jun 95   SAIC    Initial prerelease version.
+--      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--
+--!
+
+package CXA4029_0 is
+   -- Functions used to supply mapping capability.
+   function Map_To_Lower_Case (From : Wide_Character) return Wide_Character;
+   function Map_To_Upper_Case (From : Wide_Character) return Wide_Character;
+end CXA4029_0;
+
+with Ada.Characters.Handling;
+package body CXA4029_0 is
+      -- Function Map_To_Lower_Case will return the lower case form of 
+      -- Wide_Characters in the range 'A'..'Z' only, and return the input
+      -- wide_character otherwise.
+
+      function Map_To_Lower_Case (From : Wide_Character) 
+         return Wide_Character is
+      begin
+         return Ada.Characters.Handling.To_Wide_Character(
+                  Ada.Characters.Handling.To_Lower(
+                    Ada.Characters.Handling.To_Character(From)));
+      end Map_To_Lower_Case;
+
+      -- Function Map_To_Upper_Case will return the upper case form of 
+      -- Wide_Characters in the range 'a'..'z', or whose position is in one
+      -- of the ranges 223..246 or 248..255, provided the wide_character has
+      -- an upper case form.               
+
+      function Map_To_Upper_Case (From : Wide_Character) 
+        return Wide_Character is
+      begin
+         return Ada.Characters.Handling.To_Wide_Character(
+                  Ada.Characters.Handling.To_Upper(
+                    Ada.Characters.Handling.To_Character(From)));
+      end Map_To_Upper_Case;
+
+end CXA4029_0;
+
+
+with CXA4029_0;
+with Report;
+with Ada.Characters.Handling;
+with Ada.Characters.Latin_1;
+with Ada.Strings;
+with Ada.Strings.Wide_Maps;
+with Ada.Strings.Wide_Maps.Wide_Constants;
+with Ada.Strings.Wide_Fixed;
+with Ada.Strings.Wide_Bounded;
+
+procedure CXA4029 is
+begin
+   Report.Test ("CXA4029",
+                "Check that subprograms defined in package " &
+                "Ada.Strings.Wide_Bounded produce correct results");
+
+   Test_Block:
+   declare
+
+      package ACL1 renames Ada.Characters.Latin_1;
+      package BS1  is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(1);
+      package BS20 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(20);
+      package BS40 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(40);
+      package BS80 is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length(80);
+
+      subtype LC_Characters is Wide_Character range 'a'..'z';
+
+      use Ada.Characters, Ada.Strings;
+      use type Wide_Maps.Wide_Character_Set; 
+      use type BS1.Bounded_Wide_String,  BS20.Bounded_Wide_String, 
+               BS40.Bounded_Wide_String, BS80.Bounded_Wide_String;
+
+      TC_String      : constant Wide_String := "A Standard String";
+
+      BString_1      : BS1.Bounded_Wide_String  :=
+                              BS1.Null_Bounded_Wide_String;
+      BString_20     : BS20.Bounded_Wide_String := 
+                              BS20.Null_Bounded_Wide_String;
+      BString_40     : BS40.Bounded_Wide_String := 
+                              BS40.Null_Bounded_Wide_String;
+      BString_80     : BS80.Bounded_Wide_String := 
+                              BS80.Null_Bounded_Wide_String;
+      String_20      : Wide_String(1..20)    := "ABCDEFGHIJKLMNOPQRST";
+      String_40      : Wide_String(1..40)    := "abcdefghijklmnopqrst" & 
+                                                String_20;
+      String_80      : Wide_String(1..80)    := String_40 & String_40;
+      TC_String_5    : Wide_String(1..5)     := "ABCDE";
+
+      -- The following strings are used in examination of the Translation
+      -- subprograms.
+      New_Character_String : Wide_String(1..10) :=
+        Handling.To_Wide_String( 
+          ACL1.LC_A_Grave          & ACL1.LC_A_Ring  & ACL1.LC_AE_Diphthong &
+          ACL1.LC_C_Cedilla        & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex &
+          ACL1.LC_Icelandic_Eth    & ACL1.LC_N_Tilde & 
+          ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn);  
+ 
+      TC_New_Character_String : Wide_String(1..10) :=
+        Handling.To_Wide_String(
+          ACL1.UC_A_Grave          & ACL1.UC_A_Ring  & ACL1.UC_AE_Diphthong &
+          ACL1.UC_C_Cedilla        & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex &
+          ACL1.UC_Icelandic_Eth    & ACL1.UC_N_Tilde &
+          ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn);  
+
+      -- Access objects that will be provided as parameters to the 
+      -- subprograms.
+      Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
+                                CXA4029_0.Map_To_Lower_Case'Access;
+      Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
+                                CXA4029_0.Map_To_Upper_Case'Access;
+
+   begin
+
+      -- Testing of functionality found in Package Ada.Strings.Wide_Bounded.
+      -- 
+      -- Function Index.
+
+      if BS80.Index(BS80.To_Bounded_Wide_String("CoMpLeTeLy MiXeD CaSe"),
+                    "MIXED CASE",
+                    Ada.Strings.Forward,
+                    Map_To_Upper_Case_Ptr)                /= 12  or
+         BS1.Index(BS1.Null_Bounded_Wide_String,
+                   "i",
+                   Mapping => Map_To_Lower_Case_Ptr)      /= 0   
+      then
+         Report.Failed("Incorrect results from BND Function Index, going " &
+                       "in Forward direction, using a Character Mapping "  &
+                       "Function parameter");
+      end if;
+
+      -- Function Count.
+      if BS40.Count(BS40.To_Bounded_Wide_String("This IS a MISmatched issue"),
+                    "is",
+                    Map_To_Lower_Case_Ptr)                   /=  4   or
+         BS80.Count(BS80.To_Bounded_Wide_String("ABABABA"), 
+                    "ABA", 
+                    Map_To_Upper_Case_Ptr)                   /=  2 
+      then
+         Report.Failed("Incorrect results from BND Function Count, using " &
+                       "a Character_Mapping_Function parameter");
+      end if;
+
+      -- Function Translate.
+      if BS40.Translate(BS40.To_Bounded_Wide_String("A Mixed Case String"),
+                        Mapping => Map_To_Lower_Case_Ptr)   /= 
+         BS40.To_Bounded_Wide_String("a mixed case string")   or
+         BS20."/="("end with lower case",
+                   BS20.Translate(
+                     BS20.To_Bounded_Wide_String("end with lower case"),
+                     Map_To_Lower_Case_Ptr))                  
+      then
+         Report.Failed("Incorrect results from BND Function Translate, " &
+                       "using a Character_Mapping_Function parameter");
+      end if;
+
+      -- Procedure Translate.
+      BString_20 := BS20.To_Bounded_Wide_String(String_20);
+      BS20.Translate(BString_20, Mapping => Map_To_Lower_Case_Ptr);
+      if BString_20 /= BS20.To_Bounded_Wide_String("abcdefghijklmnopqrst") 
+      then
+         Report.Failed("Incorrect result from BND Procedure Translate - 1");
+      end if;
+
+      BString_80 := BS80.Null_Bounded_Wide_String;
+      BS80.Translate(BString_80, Map_To_Upper_Case_Ptr);
+      if not (BString_80 = BS80.Null_Bounded_Wide_String) then
+         Report.Failed("Incorrect result from BND Procedure Translate - 2");
+      end if;
+
+      -- Procedure Append.
+      declare
+         use BS20;
+      begin
+         BString_20 := BS20.Null_Bounded_Wide_String;
+         Append(BString_20, 'T');                     
+         Append(BString_20, "his string");            
+         Append(BString_20, 
+                To_Bounded_Wide_String(" is complete."),
+                Drop => Ada.Strings.Right);            -- Drop 4 characters.
+         if BString_20 /= To_Bounded_Wide_String("This string is compl") then
+            Report.Failed("Incorrect results from BS20 versions of " &
+                          "procedure Append");
+         end if;
+      exception
+         when others => Report.Failed("Exception raised in block checking " &
+                                      "BND Procedure Append");
+      end;
+
+      -- Operator "=".
+      BString_40 := BS40.To_Bounded_Wide_String(String_40);
+      BString_80 := BS80.To_Bounded_Wide_String(
+                           BS40.To_Wide_String(BString_40) & 
+                           BS40.To_Wide_String(BString_40));
+      if not (BString_40 = String_40 and        
+              BS80."="(String_80, BString_80)) then
+         Report.Failed("Incorrect results from BND Function ""="" with " &
+                       "string - bounded string parameter combinations");
+      end if;
+
+      -- Operator "<". 
+      BString_1  := BS1.To_Bounded_Wide_String("cat",
+                                               Drop => Ada.Strings.Right);
+      BString_20 := BS20.To_Bounded_Wide_String("Santa Claus");
+      if BString_1 < "C"                or              
+         BS1."<"(BString_1,"c")         or              
+         BS1."<"("x", BString_1)        or              
+         BS20."<"(BString_20,"Santa ")  or              
+         BS20."<"("Santa and his Elves", BString_20)     
+      then
+         Report.Failed("Incorrect results from BND Function ""<"" with " &
+                       "string - bounded string parameter combinations");
+      end if;
+
+      -- Operator "<=". 
+      BString_20 := BS20.To_Bounded_Wide_String("Sample string");
+      if BS20."<="(BString_20,"Sample strin")  or
+         not(BS20."<="("Sample string",BString_20))       
+      then
+         Report.Failed("Incorrect results from BND Function ""<="" with " &
+                       "string - bounded string parameter combinations");
+      end if;
+
+      -- Operator ">". 
+      BString_40 := BS40.To_Bounded_Wide_String(
+                           "A MUCH LONGER SAMPLE STRING.");
+      if BString_40 > "A much longer sample string"          or 
+         BS40.To_Bounded_Wide_String("ABCDEFGH") > "abcdefgh"   
+      then
+         Report.Failed("Incorrect results from BND Function "">"" with " &
+                       "string - bounded string parameter combinations");
+      end if;
+
+      -- Operator ">=". 
+      BString_80 := BS80.To_Bounded_Wide_String(String_80);
+      if not (BString_80 >= String_80  and 
+              BS80.To_Bounded_Wide_String("Programming") >= "PROGRAMMING" and
+              BS80.">="("test", BS80.To_Bounded_Wide_String("tess")))
+      then
+         Report.Failed("Incorrect results from BND Function "">="" with " &
+                       "string - bounded string parameter combinations");
+      end if;
+
+      -- Procedure Trim
+      BString_20 := BS20.To_Bounded_Wide_String("   Both Sides      ");
+      BS20.Trim(BString_20, Ada.Strings.Both);
+      if BString_20 /= BS20.To_Bounded_Wide_String("Both Sides") then
+         Report.Failed("Incorrect results from BND Procedure Trim with " &
+                       "Side = Both");
+      end if;
+
+      -- Procedure Head
+      BString_40 := BS40.To_Bounded_Wide_String("Test String");
+      BS40.Head(Source => BString_40,
+                Count  => 4);                       -- Count < Source'Length
+      if BString_40 /= BS40.To_Bounded_Wide_String("Test") then
+         Report.Failed("Incorrect results from BND Procedure Head with " &
+                       "the Count parameter less than Source'Length");
+      end if;
+
+      BString_20 := BS20.To_Bounded_Wide_String("Short String");
+      BS20.Head(BString_20, 23, '-', Ada.Strings.Right);
+      if BS20.To_Bounded_Wide_String("Short String--------") /= BString_20 then
+         Report.Failed("Incorrect results from BND Procedure Head with "  &
+                       "the Count parameter greater than Source'Length, " &
+                       "and the Drop parameter = Right");
+      end if;
+
+      -- Procedure Tail
+      BString_40 := BS40.To_Bounded_Wide_String("Test String");
+      BS40.Tail(Source => BString_40,
+                Count  => 6);                       
+      if BString_40 /= BS40.To_Bounded_Wide_String("String") then
+         Report.Failed("Incorrect results from BND Procedure Tail with " &
+                       "the Count parameter less than Source'Length");
+      end if;
+
+      BString_20 := BS20.To_Bounded_Wide_String("Maximum Length Chars");
+      BS20.Tail(BString_20, 23, '-', Ada.Strings.Right);
+      if BS20.To_Bounded_Wide_String("---Maximum Length Ch") /= BString_20 then
+         Report.Failed("Incorrect results from BND Procedure Tail with "  &
+                       "the Count parameter greater than Source'Length, " &
+                       "and the Drop parameter = Right");
+      end if;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4029;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4030.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4030.a
new file mode 100644
index 000000000..475d00899
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4030.a
@@ -0,0 +1,414 @@
+-- CXA4030.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 Ada.Strings.Unbounded versions of subprograms Translate 
+--      (procedure and function), Index, and Count, which use a 
+--      Maps.Character_Mapping_Function input parameter, produce correct 
+--      results.
+--
+-- TEST DESCRIPTION:
+--      This test examines the operation of the four subprograms contained
+--      in the Ada.Strings.Unbounded package that use a
+--      Character_Mapping_Function parameter to provide the mapping 
+--      capability.
+--      Two Character_Mapping_Function objects are defined that reference
+--      subprograms contained in the Ada.Characters.Handling package;
+--      To_Lower will return the lower-case form of the character provided
+--      as the input parameter, To_Upper will return the upper-case form
+--      of the character input parameter (provided there is an upper-case
+--      form).
+--      In several instances in this test, the character handling functions 
+--      are referenced directly in the parameter list of the subprograms
+--      under test, demonstrating another form of expected common usage.
+--      
+--      Results of all subprograms are compared with expected results.
+--      
+--      This test, when taken in conjunction with tests CXA4010, CXA4011,
+--      CXA4031, and CXA4032 will constitute a test of all the functionality 
+--      contained in package Ada.Strings.Unbounded.  This test uses a variety 
+--      of the subprograms defined in the unbounded string package in ways 
+--      typical of common usage.
+--      
+--       
+-- CHANGE HISTORY:
+--      21 Feb 95   SAIC    Initial prerelease version
+--      21 Apr 95   SAIC    Modified header commentary.
+--
+--!
+
+with Ada.Strings.Unbounded;
+with Ada.Strings.Maps;
+with Ada.Characters.Handling;
+with Ada.Characters.Latin_1;
+with Report;
+
+procedure CXA4030 is
+
+begin
+
+   Report.Test ("CXA4030", "Check that Ada.Strings.Unbounded versions " &
+                           "of subprograms Translate (procedure and "   &
+                           "function), Index, and Count, which use a "  &
+                           "Maps.Character_Mapping_Function input "     &
+                           "parameter, produce correct results");
+
+   Test_Block:
+   declare
+
+      package Unb renames Ada.Strings.Unbounded;
+      use type Unb.Unbounded_String;
+      use Ada.Strings;
+      use Ada.Characters;
+
+
+      -- The following strings are used in examination of the Translation
+      -- subprograms.
+
+      New_Character_String : Unb.Unbounded_String :=
+                               Unb.To_Unbounded_String(
+                                 Latin_1.LC_A_Grave          &
+                                 Latin_1.LC_A_Ring           &
+                                 Latin_1.LC_AE_Diphthong     &
+                                 Latin_1.LC_C_Cedilla        &
+                                 Latin_1.LC_E_Acute          &
+                                 Latin_1.LC_I_Circumflex     &
+                                 Latin_1.LC_Icelandic_Eth    &
+                                 Latin_1.LC_N_Tilde          &
+                                 Latin_1.LC_O_Oblique_Stroke &
+                                 Latin_1.LC_Icelandic_Thorn);  
+ 
+
+      TC_New_Character_String : Unb.Unbounded_String :=
+                                  Unb.To_Unbounded_String(
+                                    Latin_1.UC_A_Grave          &
+                                    Latin_1.UC_A_Ring           &
+                                    Latin_1.UC_AE_Diphthong     &
+                                    Latin_1.UC_C_Cedilla        &
+                                    Latin_1.UC_E_Acute          &
+                                    Latin_1.UC_I_Circumflex     &
+                                    Latin_1.UC_Icelandic_Eth    &
+                                    Latin_1.UC_N_Tilde          &
+                                    Latin_1.UC_O_Oblique_Stroke &
+                                    Latin_1.UC_Icelandic_Thorn);  
+                     
+
+      -- In this test, access objects are defined to refer to two functions
+      -- from the Ada.Characters.Handling package.  These access objects 
+      -- will be provided as parameters to the subprograms under test.
+      -- Note: There will be several examples in this test of these character 
+      --       handling functions being referenced directly within the 
+      --       parameter list of the subprograms under test.
+
+      Map_To_Lower_Case_Ptr : Maps.Character_Mapping_Function :=
+                                Handling.To_Lower'Access;
+
+      Map_To_Upper_Case_Ptr : Maps.Character_Mapping_Function :=
+                                Handling.To_Upper'Access;
+
+   begin
+
+      -- Function Index, Forward direction search.
+      -- Note: Several of the following cases use the default value
+      --       Forward for the Going parameter.
+
+      if Unb.Index(Source => Unb.To_Unbounded_String(
+                               "The library package Strings.Unbounded"),
+                   Pattern => "unb",
+                   Going   => Ada.Strings.Forward,
+                   Mapping => Map_To_Lower_Case_Ptr)    /= 29   or
+
+         Unb.Index(Unb.To_Unbounded_String(
+                     "THE RAIN IN SPAIN FALLS MAINLY ON THE PLAIN"),
+                   "ain",
+                   Mapping => Map_To_Lower_Case_Ptr)    /= 6    or
+
+         Unb.Index(Unb.To_Unbounded_String("maximum number"),
+                   "um",
+                   Ada.Strings.Forward,
+                   Handling.To_Lower'Access)            /= 6    or
+
+         Unb.Index(Unb.To_Unbounded_String("CoMpLeTeLy MiXeD CaSe StRiNg"),
+                   "MIXED CASE STRING",
+                   Ada.Strings.Forward,
+                   Map_To_Upper_Case_Ptr)               /= 12   or
+
+         Unb.Index(Unb.To_Unbounded_String(
+                     "STRING WITH NO MATCHING PATTERNS"),
+                   "WITH",
+                   Mapping => Map_To_Lower_Case_Ptr)    /= 0    or
+
+         Unb.Index(Unb.To_Unbounded_String("THIS STRING IS IN UPPER CASE"),
+                   "IS",
+                   Ada.Strings.Forward,
+                   Handling.To_Upper'Access)            /= 3    or
+
+         Unb.Index(Unb.Null_Unbounded_String,
+                   "is",
+                   Mapping => Map_To_Lower_Case_Ptr)    /= 0    or
+
+         Unb.Index(Unb.To_Unbounded_String("AAABBBaaabbb"),
+                   "aabb",
+                   Mapping => Handling.To_Lower'Access) /= 2
+      then
+         Report.Failed("Incorrect results from Function Index, going "    &
+                       "in Forward direction, using a Character Mapping " &
+                       "Function parameter");
+      end if;
+
+
+
+      -- Function Index, Backward direction search.
+
+      if Unb.Index(Unb.To_Unbounded_String("Case of a Mixed Case String"), 
+                   "case", 
+                   Ada.Strings.Backward,
+                   Map_To_Lower_Case_Ptr)               /= 17   or
+
+         Unb.Index(Unb.To_Unbounded_String("Case of a Mixed Case String"), 
+                   "CASE", 
+                   Ada.Strings.Backward,
+                   Mapping => Map_To_Upper_Case_Ptr)    /= 17   or
+
+         Unb.Index(Unb.To_Unbounded_String("rain, Rain, and more RAIN"),
+                   "rain",
+                   Ada.Strings.Backward,
+                   Handling.To_Lower'Access)            /= 22   or
+
+         Unb.Index(Unb.To_Unbounded_String("RIGHT place, right time"),
+                   "RIGHT",
+                   Ada.Strings.Backward,
+                   Handling.To_Upper'Access)            /= 14   or
+
+         Unb.Index(Unb.To_Unbounded_String("WOULD MATCH BUT FOR THE CASE"),
+                   "WOULD MATCH BUT FOR THE CASE",
+                   Going   => Ada.Strings.Backward,
+                   Mapping => Map_To_Lower_Case_Ptr)    /= 0
+      then
+         Report.Failed("Incorrect results from Function Index, going "     &
+                       "in Backward direction, using a Character Mapping " &
+                       "Function parameter");
+      end if;
+
+
+
+      -- Function Index, Pattern_Error if Pattern = Null_String
+
+      declare
+         use Unbounded;
+         Null_String : constant String := "";
+         TC_Natural  : Natural         := 1000;
+      begin
+         TC_Natural := Index(To_Unbounded_String("A Valid Unbounded String"), 
+                             Null_String,
+                             Going   => Ada.Strings.Forward,
+                             Mapping => Handling.To_Lower'Access);
+         Report.Failed("Pattern_Error not raised by Function Index when " &
+                       "given a null pattern string");
+      exception
+         when Pattern_Error => null;   -- OK, expected exception.
+         when others        =>
+            Report.Failed("Incorrect exception raised by Function Index " &
+                          "using a Character Mapping Function parameter " &
+                          "when given a null pattern string");
+      end;
+
+
+
+      -- Function Count.
+
+      if Unb.Count(Source  => Unb.To_Unbounded_String("ABABABA"),       
+                   Pattern => "aba",
+                   Mapping => Map_To_Lower_Case_Ptr)   /=  2   or
+
+         Unb.Count(Unb.To_Unbounded_String("ABABABA"), 
+                   "ABA", 
+                   Mapping => Map_To_Lower_Case_Ptr)   /=  0   or
+
+         Unb.Count(Unb.To_Unbounded_String("This IS a MISmatched issue"),
+                   "is",
+                   Handling.To_Lower'Access)           /=  4   or
+
+         Unb.Count(Unb.To_Unbounded_String("ABABABA"), 
+                   "ABA", 
+                   Map_To_Upper_Case_Ptr)              /=  2   or
+
+         Unb.Count(Unb.To_Unbounded_String("This IS a MISmatched issue"),
+                   "is",
+                   Mapping => Map_To_Upper_Case_Ptr)   /=  0   or
+
+         Unb.Count(Unb.To_Unbounded_String(
+                     "She sells sea shells by the sea shore"),
+                   "s",
+                   Handling.To_Lower'Access)           /=  8   or
+
+         Unb.Count(Unb.Null_Unbounded_String,      
+                   "match",
+                   Map_To_Upper_Case_Ptr)              /=  0
+      then
+         Report.Failed("Incorrect results from Function Count, using " &
+                       "a Character Mapping Function parameter");
+      end if;
+
+
+
+      -- Function Count, Pattern_Error if Pattern = Null_String
+
+      declare
+         use Ada.Strings.Unbounded;
+         Null_Pattern_String : constant String := "";
+         TC_Natural          : Natural         := 1000;
+      begin
+         TC_Natural := Count(To_Unbounded_String("A Valid String"), 
+                             Null_Pattern_String,
+                             Map_To_Lower_Case_Ptr);
+         Report.Failed("Pattern_Error not raised by Function Count using " &
+                       "a Character Mapping Function parameter when "      &
+                       "given a null pattern string");
+      exception
+         when Pattern_Error => null;   -- OK, expected exception.
+         when others        =>
+            Report.Failed("Incorrect exception raised by Function Count " &
+                          "using a Character Mapping Function parameter " &
+                          "when given a null pattern string");
+      end;
+
+
+
+      -- Function Translate.
+
+      if Unb.Translate(Source  => Unb.To_Unbounded_String(
+                                    "A Sample Mixed Case String"),
+                       Mapping => Map_To_Lower_Case_Ptr)           /= 
+         Unb.To_Unbounded_String("a sample mixed case string")       or
+
+         Unb.Translate(Unb.To_Unbounded_String("ALL LOWER CASE"),
+                       Handling.To_Lower'Access)                   /= 
+         Unb.To_Unbounded_String("all lower case")                   or
+
+         Unb.Translate(Unb.To_Unbounded_String("end with lower case"),
+                       Map_To_Lower_Case_Ptr)                      /= 
+         Unb.To_Unbounded_String("end with lower case")              or
+
+         Unb.Translate(Unb.Null_Unbounded_String,
+                       Handling.To_Lower'Access)                   /=
+         Unb.Null_Unbounded_String                                   or
+
+         Unb.Translate(Unb.To_Unbounded_String("start with lower case"),
+                       Map_To_Upper_Case_Ptr)                      /= 
+         Unb.To_Unbounded_String("START WITH LOWER CASE")            or
+
+         Unb.Translate(Unb.To_Unbounded_String("ALL UPPER CASE STRING"),
+                       Handling.To_Upper'Access)                   /=
+         Unb.To_Unbounded_String("ALL UPPER CASE STRING")            or
+
+         Unb.Translate(Unb.To_Unbounded_String(
+                         "LoTs Of MiXeD CaSe ChArAcTeRs"),
+                       Map_To_Upper_Case_Ptr)                      /=
+         Unb.To_Unbounded_String("LOTS OF MIXED CASE CHARACTERS")    or
+
+         Unb.Translate(New_Character_String, 
+                       Handling.To_Upper'Access)                   /=
+         TC_New_Character_String
+
+      then
+         Report.Failed("Incorrect results from Function Translate, using " &
+                       "a Character Mapping Function parameter");
+      end if;
+
+
+
+      -- Procedure Translate.
+
+      declare
+
+         use Ada.Strings.Unbounded;
+         use Ada.Characters.Handling;
+
+         Str_1    : Unbounded_String := 
+                      To_Unbounded_String("AN ALL UPPER CASE STRING");
+         Str_2    : Unbounded_String := 
+                      To_Unbounded_String("A Mixed Case String");
+         Str_3    : Unbounded_String := 
+                      To_Unbounded_String("a string with lower case letters");
+         TC_Str_1 : constant Unbounded_String := Str_1;
+         TC_Str_3 : constant Unbounded_String := Str_3;
+
+      begin
+
+         Translate(Source => Str_1, Mapping => Map_To_Lower_Case_Ptr);
+
+         if Str_1 /= To_Unbounded_String("an all upper case string") then
+            Report.Failed("Incorrect result from Procedure Translate - 1");
+         end if;
+
+         Translate(Source => Str_1, Mapping => Map_To_Upper_Case_Ptr);
+
+         if Str_1 /= TC_Str_1 then
+            Report.Failed("Incorrect result from Procedure Translate - 2");
+         end if;
+
+         Translate(Str_2, Mapping => Map_To_Lower_Case_Ptr);
+
+         if Str_2 /= To_Unbounded_String("a mixed case string") then
+            Report.Failed("Incorrect result from Procedure Translate - 3");
+         end if;
+
+         Translate(Str_2, Mapping => To_Upper'Access);
+
+         if Str_2 /= To_Unbounded_String("A MIXED CASE STRING") then
+            Report.Failed("Incorrect result from Procedure Translate - 4");
+         end if;
+
+         Translate(Str_3, To_Lower'Access);
+
+         if Str_3 /= TC_Str_3 then
+            Report.Failed("Incorrect result from Procedure Translate - 5");
+         end if;
+
+         Translate(Str_3, To_Upper'Access);
+
+         if Str_3 /= 
+            To_Unbounded_String("A STRING WITH LOWER CASE LETTERS")
+         then
+            Report.Failed("Incorrect result from Procedure Translate - 6");
+         end if;
+
+         Translate(New_Character_String, Map_To_Upper_Case_Ptr);
+
+         if New_Character_String /= TC_New_Character_String then
+            Report.Failed("Incorrect result from Procedure Translate - 6");
+         end if;
+
+      end;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4030;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4031.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4031.a
new file mode 100644
index 000000000..91bc68ce6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4031.a
@@ -0,0 +1,291 @@
+-- CXA4031.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 subprograms defined in package Ada.Strings.Unbounded
+--      are available, and that they produce correct results. Specifically, 
+--      check the functions To_Unbounded_String (version with Length
+--      parameter), "=", "<", "<=", ">", ">=" (all with String-Unbounded
+--      String parameter mix), as well as three versions of Procedure Append.
+--      
+-- TEST DESCRIPTION:
+--      This test demonstrates the uses of many of the subprograms defined
+--      in package Ada.Strings.Unbounded for use with unbounded strings.
+--      The test simulates how unbounded strings could be processed in a
+--      user environment, using the subprograms provided in this package.
+--
+--      This test, when taken in conjunction with tests CXA4010, CXA4011,
+--      CXA4030, and CXA4032 will constitute a test of all the functionality 
+--      contained in package Ada.Strings.Unbounded.  This test uses a variety 
+--      of the subprograms defined in the unbounded string package in ways 
+--      typical of common usage.
+--      
+--       
+-- CHANGE HISTORY:
+--      27 Feb 95   SAIC    Initial prerelease version.
+--      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--
+--!
+
+with Report;
+with Ada.Exceptions;
+with Ada.Strings.Maps;
+with Ada.Strings.Unbounded;
+
+procedure CXA4031 is
+begin
+
+   Report.Test ("CXA4031", "Check that the subprograms defined in "        &
+                           "package Ada.Strings.Unbounded are available, " &
+                           "and that they produce correct results");
+
+   Test_Block:
+   declare
+
+      package Unb renames Ada.Strings.Unbounded;
+      use Unb;
+      use Ada.Exceptions;
+ 
+      subtype LC_Characters is Character range 'a'..'z';
+
+      Null_String       : constant String := "";
+      TC_String         : constant String := "A Standard String";
+
+      TC_Unb_String,
+      TC_New_Unb_String : Unb.Unbounded_String := Unb.Null_Unbounded_String;
+
+   begin
+
+      -- Function To_Unbounded_String (version with Length parameter)
+      -- returns an unbounded string that represents an uninitialized String
+      -- whose length is Length.
+      -- Note: Unbounded_String length can vary conceptually between 0 and
+      --       Natural'Last.
+
+      if Unb.Length(Unb.To_Unbounded_String(Length => 10)) /= 10 or
+         Unb.Length(Unb.To_Unbounded_String(1))            /=  1 or
+         Unb.Length(Unb.To_Unbounded_String(0))            /=  0 or
+         Unb.Length(Unb."&"(Unb.To_Unbounded_String(Length => 10),
+                    Unb."&"(Unb.To_Unbounded_String(1),
+                            Unb.To_Unbounded_String(0) ))) /= 10+1+0
+      then
+         Report.Failed
+           ("Incorrect results from Function To_Unbounded_String with " &
+            "Length parameter");
+      end if;
+
+
+      -- Procedure Append (Unbounded - Unbounded)
+      -- Note: For each of the Append procedures, the resulting string 
+      --       represented by the Source parameter is given by the 
+      --       concatenation of the original value of Source and the value 
+      --       of New_Item.
+
+      TC_Unb_String := Unb.To_Unbounded_String("Sample string of length L");
+      TC_New_Unb_String := Unb.To_Unbounded_String(" and then some");
+
+      Unb.Append(Source => TC_Unb_String, New_Item => TC_New_Unb_String);
+      
+      if TC_Unb_String /= 
+         Unb.To_Unbounded_String("Sample string of length L and then some")
+      then
+         Report.Failed("Incorrect results from Procedure Append with " &
+                       "unbounded string parameters - 1");
+      end if;
+
+
+      TC_Unb_String := Unb.To_Unbounded_String("Sample string of length L");
+      TC_New_Unb_String := Unb.Null_Unbounded_String;
+
+      Unb.Append(TC_Unb_String, TC_New_Unb_String);
+      
+      if TC_Unb_String /= 
+         Unb.To_Unbounded_String("Sample string of length L")
+      then
+         Report.Failed("Incorrect results from Procedure Append with " &
+                       "unbounded string parameters - 2");
+      end if;
+
+
+      TC_Unb_String := Unb.Null_Unbounded_String;
+
+      Unb.Append(TC_Unb_String,
+                 Unb.To_Unbounded_String("New Unbounded String"));
+      
+      if TC_Unb_String /= 
+         Unb.To_Unbounded_String("New Unbounded String")
+      then
+         Report.Failed("Incorrect results from Procedure Append with " &
+                       "unbounded string parameters - 3");
+      end if;
+
+      
+      -- Procedure Append (Unbounded - String)
+
+      TC_Unb_String := Unb.To_Unbounded_String("An Unbounded String and ");
+
+      Unb.Append(Source => TC_Unb_String, New_Item => TC_String);
+      
+      if TC_Unb_String /= 
+         Unb.To_Unbounded_String("An Unbounded String and A Standard String")
+      then
+         Report.Failed("Incorrect results from Procedure Append with " &
+                       "an unbounded string parameter and a string "   &
+                       "parameter - 1");
+      end if;
+
+
+      TC_Unb_String := Unb.To_Unbounded_String("An Unbounded String");
+
+      Unb.Append(TC_Unb_String, New_Item => Null_String);
+      
+      if TC_Unb_String /= 
+         Unb.To_Unbounded_String("An Unbounded String")
+      then
+         Report.Failed("Incorrect results from Procedure Append with " &
+                       "an unbounded string parameter and a string "   &
+                       "parameter - 2");
+      end if;
+
+
+      TC_Unb_String := Unb.Null_Unbounded_String;
+
+      Unb.Append(TC_Unb_String, TC_String);
+      
+      if TC_Unb_String /= Unb.To_Unbounded_String("A Standard String") then
+         Report.Failed("Incorrect results from Procedure Append with " &
+                       "an unbounded string parameter and a string "   &
+                       "parameter - 3");
+      end if;
+
+
+      -- Procedure Append (Unbounded - Character)
+
+      TC_Unb_String := Unb.To_Unbounded_String("Lower Case = ");
+
+      for i in LC_Characters'Range loop
+         Unb.Append(Source => TC_Unb_String, New_Item => LC_Characters(i));
+      end loop;
+
+      if TC_Unb_String /= 
+         Unb.To_Unbounded_String("Lower Case = abcdefghijklmnopqrstuvwxyz")
+      then
+         Report.Failed("Incorrect results from Procedure Append with "  &
+                       "an unbounded string parameter and a character " &
+                       "parameter - 1");
+      end if;        
+
+      
+      TC_Unb_String := Unb.Null_Unbounded_String;
+
+      Unb.Append(TC_Unb_String, New_Item => 'a');
+      
+      if TC_Unb_String /= Unb.To_Unbounded_String("a") then
+         Report.Failed("Incorrect results from Procedure Append with "  &
+                       "an unbounded string parameter and a character " &
+                       "parameter - 2");
+      end if;        
+
+
+      -- Function "="
+
+      TC_Unb_String := Unb.To_Unbounded_String(TC_String);
+
+      if not (TC_Unb_String = TC_String)                 or  -- (Unb_Str, Str)
+         not Unb."="("A Standard String", TC_Unb_String) or  -- (Str, Unb_Str)
+         not ((Unb.Null_Unbounded_String = "") and           -- (Unb_Str, Str)
+              ("Test String" =                               -- (Str, Unb_Str)
+               Unb.To_Unbounded_String("Test String")))
+      then
+         Report.Failed("Incorrect results from function ""="" with " &
+                       "string - unbounded string parameter combinations");
+      end if;
+
+
+      -- Function "<"
+
+      if not ("Extra Space" < Unb.To_Unbounded_String("Extra Space ") and
+              Unb.To_Unbounded_String("tess") < "test"                and
+              Unb.To_Unbounded_String("best") < "test")                or
+         Unb.Null_Unbounded_String            < Null_String            or
+         " leading blank"  < Unb.To_Unbounded_String(" leading blank") or
+         "ending blank "   < Unb.To_Unbounded_String("ending blank ")  
+      then
+         Report.Failed("Incorrect results from function ""<"" with " &
+                       "string - unbounded string parameter combinations");
+      end if;
+
+
+      -- Function "<="
+
+      TC_Unb_String := Unb.To_Unbounded_String("Sample string");
+
+      if TC_Unb_String                 <= "Sample strin" or  -- (Unb_Str, Str)
+         "sample string"               <= TC_Unb_String  or  -- (Str, Unb_Str)
+         not(Unb.Null_Unbounded_String <= "")            or  -- (Unb_Str, Str)
+         not("Sample string"           <= TC_Unb_String)     -- (Str, Unb_Str)
+      then
+         Report.Failed("Incorrect results from function ""<="" with " &
+                       "string - unbounded string parameter combinations");
+      end if;
+
+
+      -- Function ">"
+
+      TC_Unb_String := Unb.To_Unbounded_String("A MUCH LONGER STRING");
+
+      if not ("A much longer string" > TC_Unb_String                  and 
+              Unb.To_Unbounded_String(TC_String) > "A Standard Strin" and
+              "abcdefgh" > Unb.To_Unbounded_String("ABCDEFGH"))        or
+         Unb.Null_Unbounded_String > Null_String    
+      then
+         Report.Failed("Incorrect results from function "">"" with " &
+                       "string - unbounded string parameter combinations");
+      end if;
+
+
+      -- Function ">=" 
+
+      TC_Unb_String := Unb.To_Unbounded_String(TC_String);
+
+      if not (TC_Unb_String >= TC_String                       and 
+              Null_String   >= Unb.Null_Unbounded_String       and
+              "test"        >= Unb.To_Unbounded_String("tess") and  
+              Unb.To_Unbounded_String("Programming") >= "PROGRAMMING")
+      then
+         Report.Failed("Incorrect results from function "">="" with " &
+                       "string - unbounded string parameter combinations");
+      end if;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4031;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4032.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4032.a
new file mode 100644
index 000000000..031d01c6c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4032.a
@@ -0,0 +1,457 @@
+-- CXA4032.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 procedures defined in package Ada.Strings.Unbounded
+--      are available, and that they produce correct results. Specifically, 
+--      check the procedures Replace_Slice, Insert, Overwrite, Delete,
+--      Trim (2 versions), Head, and Tail.
+--      
+-- TEST DESCRIPTION:
+--      This test demonstrates the uses of many of the procedures defined
+--      in package Ada.Strings.Unbounded for use with unbounded strings.
+--      The test simulates how unbounded strings could be processed in a
+--      user environment, using the procedures provided in this package.
+--
+--      This test, when taken in conjunction with tests CXA4010, CXA4011,
+--      CXA4030, and CXA4031 will constitute a test of all the functionality 
+--      contained in package Ada.Strings.Unbounded.  This test uses a variety 
+--      of the procedures defined in the unbounded string package in ways 
+--      typical of common usage.
+--      
+--       
+-- CHANGE HISTORY:
+--      02 Mar 95   SAIC    Initial prerelease version.
+--
+--!
+
+with Report;
+with Ada.Strings;
+with Ada.Strings.Maps;
+with Ada.Strings.Maps.Constants;
+with Ada.Strings.Unbounded;
+
+procedure CXA4032 is
+begin
+
+   Report.Test ("CXA4032", "Check that the subprograms defined in "        &
+                           "package Ada.Strings.Unbounded are available, " &
+                           "and that they produce correct results");
+
+   Test_Block:
+   declare
+
+      package Unb renames Ada.Strings.Unbounded;
+      use Unb;
+      use Ada.Strings;
+
+      TC_Null_String : constant String := "";
+      TC_String_5    : String(1..5)    := "ABCDE";
+
+      TC_Unb_String  : Unb.Unbounded_String := 
+                         Unb.To_Unbounded_String("Test String");
+
+   begin
+
+      -- Procedure Replace_Slice
+
+      begin                                           -- Low > Source'Last+1
+         Unb.Replace_Slice(Source => TC_Unb_String, 
+                           Low    => Unb.Length(TC_Unb_String) + 2,
+                           High   => Unb.Length(TC_Unb_String),
+                           By     => TC_String_5);
+         Report.Failed("Index_Error not raised by Replace_Slice when Low " &
+                       "> Source'Last+1");
+      exception
+         when Index_Error => null;  -- OK, expected exception.
+         when others      =>
+            Report.Failed("Unexpected exception raised by Replace_Slice" &
+                          "when Low > Source'Last+1");
+      end;
+
+      -- High >= Low
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      Unb.Replace_Slice(TC_Unb_String, 5, 5, TC_String_5);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("TestABCDEString") then
+         Report.Failed("Incorrect results from Replace_Slice - 1");
+      end if;
+
+      Unb.Replace_Slice(TC_Unb_String, 1, 4, TC_String_5);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("ABCDEABCDEString") then
+         Report.Failed("Incorrect results from Replace_Slice - 2");
+      end if;
+
+      Unb.Replace_Slice(TC_Unb_String, 
+                        11, 
+                        Unb.Length(TC_Unb_String),
+                        TC_Null_String);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("ABCDEABCDE") then
+         Report.Failed("Incorrect results from Replace_Slice - 3");
+      end if;
+
+      -- High < Low   
+
+      Unb.Replace_Slice(TC_Unb_String, Low => 4, High => 1, By => "xxx");
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("ABCxxxDEABCDE") then
+         Report.Failed("Incorrect results from Replace_Slice - 4");
+      end if;
+
+      Unb.Replace_Slice(TC_Unb_String, Low => 1, High => 0, By => "yyy");
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("yyyABCxxxDEABCDE") then
+         Report.Failed("Incorrect results from Replace_Slice - 5");
+      end if;
+
+      Unb.Replace_Slice(TC_Unb_String, 
+                        Unb.Length(TC_Unb_String) + 1, 
+                        Unb.Length(TC_Unb_String), 
+                        By => "zzz");
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("yyyABCxxxDEABCDEzzz") then
+         Report.Failed("Incorrect results from Replace_Slice - 6");
+      end if;
+
+
+      -- Procedure Insert
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      begin                  -- Before not in Source'First..Source'Last + 1
+         Unb.Insert(Source   => TC_Unb_String,
+                    Before   => Unb.Length(TC_Unb_String) + 2,
+                    New_Item => TC_String_5);
+         Report.Failed("Index_Error not raised by Insert when Before " &
+                       "not in the range Source'First..Source'Last+1");
+      exception
+         when Index_Error => null;  -- OK, expected exception.
+         when others      =>
+            Report.Failed
+              ("Unexpected exception raised by Insert when Before not in " &
+               "the range Source'First..Source'Last+1");
+      end;
+
+      Unb.Insert(TC_Unb_String, 1, "**");
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("**Test String") then
+         Report.Failed("Incorrect results from Insert - 1");
+      end if;
+
+      Unb.Insert(TC_Unb_String, Unb.Length(TC_Unb_String)+1, "**");
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("**Test String**") then
+         Report.Failed("Incorrect results from Insert - 2");
+      end if;
+
+      Unb.Insert(TC_Unb_String, 8, "---");
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("**Test ---String**") then
+         Report.Failed("Incorrect results from Insert - 3");
+      end if;
+
+      Unb.Insert(TC_Unb_String, 3, TC_Null_String);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("**Test ---String**") then
+         Report.Failed("Incorrect results from Insert - 4");
+      end if;
+
+
+      -- Procedure Overwrite
+
+      begin                -- Position not in Source'First..Source'Last + 1
+         Unb.Overwrite(Source   => TC_Unb_String,
+                       Position => Unb.Length(TC_Unb_String) + 2,
+                       New_Item => TC_String_5);
+         Report.Failed("Index_Error not raised by Overwrite when Position " &
+                       "not in the range Source'First..Source'Last+1");
+      exception
+         when Index_Error => null;  -- OK, expected exception.
+         when others      =>
+            Report.Failed
+              ("Unexpected exception raised by Overwrite when Position not " &
+               "in the range Source'First..Source'Last+1");
+      end;
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      Unb.Overwrite(Source   => TC_Unb_String,
+                    Position => 1,
+                    New_Item => "XXXX");
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("XXXX String") then
+         Report.Failed("Incorrect results from Overwrite - 1");
+      end if;
+
+      Unb.Overwrite(TC_Unb_String, Unb.Length(TC_Unb_String)+1, "**");
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("XXXX String**") then
+         Report.Failed("Incorrect results from Overwrite - 2");
+      end if;
+
+      Unb.Overwrite(TC_Unb_String, 3, TC_Null_String);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("XXXX String**") then
+         Report.Failed("Incorrect results from Overwrite - 3");
+      end if;
+
+      Unb.Overwrite(TC_Unb_String, 1, "abcdefghijklmn");
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("abcdefghijklmn") then
+         Report.Failed("Incorrect results from Overwrite - 4");
+      end if;
+
+
+      -- Procedure Delete
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      -- From > Through  (No change to Source)
+
+      Unb.Delete(Source  => TC_Unb_String, 
+                 From    => Unb.Length(TC_Unb_String),
+                 Through => Unb.Length(TC_Unb_String)-1);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then
+         Report.Failed("Incorrect results from Delete - 1");
+      end if;
+
+      Unb.Delete(TC_Unb_String, 1, 0);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then
+         Report.Failed("Incorrect results from Delete - 2");
+      end if;
+
+      -- From <= Through
+
+      Unb.Delete(TC_Unb_String, 1, 5);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("String") then
+         Report.Failed("Incorrect results from Delete - 3");
+      end if;
+
+      Unb.Delete(TC_Unb_String, 3, 3);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("Sting") then
+         Report.Failed("Incorrect results from Delete - 4");
+      end if;
+
+
+      -- Procedure Trim 
+
+      TC_Unb_String := Unb.To_Unbounded_String("No Spaces");
+
+      Unb.Trim(Source => TC_Unb_String, Side => Ada.Strings.Both);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("No Spaces") then
+         Report.Failed("Incorrect results from Trim - 1");
+      end if;
+
+      TC_Unb_String := Unb.To_Unbounded_String("   Leading Spaces   ");
+
+      Unb.Trim(TC_Unb_String, Ada.Strings.Left);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("Leading Spaces   ") then
+         Report.Failed("Incorrect results from Trim - 2");
+      end if;
+
+      TC_Unb_String := Unb.To_Unbounded_String("   Ending Spaces   ");
+
+      Unb.Trim(TC_Unb_String, Ada.Strings.Right);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("   Ending Spaces") then
+         Report.Failed("Incorrect results from Trim - 3");
+      end if;
+
+      TC_Unb_String := 
+        Unb.To_Unbounded_String("    Spaces   on  both  ends     ");
+
+      Unb.Trim(TC_Unb_String, Ada.Strings.Both);
+
+      if TC_Unb_String /= 
+         Unb.To_Unbounded_String("Spaces   on  both  ends") 
+      then
+         Report.Failed("Incorrect results from Trim - 4");
+      end if;
+
+
+      -- Procedure Trim (with Character Set parameters)
+
+      TC_Unb_String := Unb.To_Unbounded_String("lowerCASEletters");
+
+      Unb.Trim(Source => TC_Unb_String,
+               Left   => Ada.Strings.Maps.Constants.Lower_Set,
+               Right  => Ada.Strings.Maps.Constants.Lower_Set);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("CASE") then
+         Report.Failed("Incorrect results from Trim with Sets - 1");
+      end if;
+
+      TC_Unb_String := Unb.To_Unbounded_String("lowerCASEletters");
+
+      Unb.Trim(TC_Unb_String, 
+               Ada.Strings.Maps.Constants.Upper_Set,
+               Ada.Strings.Maps.Constants.Upper_Set);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("lowerCASEletters") then
+         Report.Failed("Incorrect results from Trim with Sets - 2");
+      end if;
+
+      TC_Unb_String := Unb.To_Unbounded_String("012abcdefghGFEDCBA789ab");
+
+      Unb.Trim(TC_Unb_String,
+               Ada.Strings.Maps.Constants.Hexadecimal_Digit_Set,
+               Ada.Strings.Maps.Constants.Hexadecimal_Digit_Set);
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("ghG") then
+         Report.Failed("Incorrect results from Trim with Sets - 3");
+      end if;
+
+
+      -- Procedure Head
+
+      -- Count <= Source'Length
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      Unb.Head(Source => TC_Unb_String,
+               Count  => 0,
+               Pad    => '*');
+
+      if TC_Unb_String /= Unb.Null_Unbounded_String then
+         Report.Failed("Incorrect results from Head - 1");
+      end if;
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      Unb.Head(Source => TC_Unb_String,
+               Count  => 4,
+               Pad    => '*');
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("Test") then
+         Report.Failed("Incorrect results from Head - 2");
+      end if;
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      Unb.Head(Source => TC_Unb_String,
+               Count  => Unb.Length(TC_Unb_String),
+               Pad    => '*');
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then
+         Report.Failed("Incorrect results from Head - 3");
+      end if;
+
+      -- Count > Source'Length
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      Unb.Head(Source => TC_Unb_String,
+               Count  => Unb.Length(TC_Unb_String) + 4,
+               Pad    => '*');
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("Test String****") then
+         Report.Failed("Incorrect results from Head - 4");
+      end if;
+
+      TC_Unb_String := Unb.Null_Unbounded_String;
+
+      Unb.Head(Source => TC_Unb_String,
+               Count  => Unb.Length(TC_Unb_String) + 3,
+               Pad    => '*');
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("***") then
+         Report.Failed("Incorrect results from Head - 5");
+      end if;
+
+
+      -- Procedure Tail
+
+      -- Count <= Source'Length
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      Unb.Tail(Source => TC_Unb_String,
+               Count  => 0,
+               Pad    => '*');
+
+      if TC_Unb_String /= Unb.Null_Unbounded_String then
+         Report.Failed("Incorrect results from Tail - 1");
+      end if;
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      Unb.Tail(Source => TC_Unb_String,
+               Count  => 6,
+               Pad    => '*');
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("String") then
+         Report.Failed("Incorrect results from Tail - 2");
+      end if;
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      Unb.Tail(Source => TC_Unb_String,
+               Count  => Unb.Length(TC_Unb_String),
+               Pad    => '*');
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("Test String") then
+         Report.Failed("Incorrect results from Tail - 3");
+      end if;
+
+      -- Count > Source'Length
+
+      TC_Unb_String := Unb.To_Unbounded_String("Test String");
+
+      Unb.Tail(Source => TC_Unb_String,
+               Count  => Unb.Length(TC_Unb_String) + 5,
+               Pad    => 'x');
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("xxxxxTest String") then
+         Report.Failed("Incorrect results from Tail - 4");
+      end if;
+
+      TC_Unb_String := Unb.Null_Unbounded_String;
+
+      Unb.Tail(Source => TC_Unb_String,
+               Count  => Unb.Length(TC_Unb_String) + 3,
+               Pad    => 'X');
+
+      if TC_Unb_String /= Unb.To_Unbounded_String("XXX") then
+         Report.Failed("Incorrect results from Tail - 5");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4032;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4033.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4033.a
new file mode 100644
index 000000000..8f39b4cff
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4033.a
@@ -0,0 +1,405 @@
+-- CXA4033.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 functionality found in packages Ada.Strings.Wide_Maps,
+--      Ada.Strings.Wide_Unbounded, and Ada.Strings.Wide_Maps.Wide_Constants 
+--      is available and produces correct results.
+--
+-- TEST DESCRIPTION:
+--      This test tests the subprograms found in the
+--      Ada.Strings.Wide_Unbounded package.  It is based on the tests 
+--      CXA4030-32, which are tests for the complementary "non-wide" 
+--      packages.
+--      
+--      The functions found in CXA4033_0 provide mapping capability, when
+--      used in conjunction with Wide_Character_Mapping_Function objects.
+--
+--       
+-- CHANGE HISTORY:
+--      23 Jun 95   SAIC    Initial prerelease version.
+--      24 Feb 97   PWB.CTA Removed attempt to create wide string of length
+--                          Natural'Last
+--!
+
+package CXA4033_0 is
+   -- Functions used to supply mapping capability.
+   function Map_To_Lower_Case (From : Wide_Character) return Wide_Character;
+   function Map_To_Upper_Case (From : Wide_Character) return Wide_Character;
+end CXA4033_0;
+
+with Ada.Characters.Handling;
+package body CXA4033_0 is
+      -- Function Map_To_Lower_Case will return the lower case form of 
+      -- Wide_Characters in the range 'A'..'Z' only, and return the input
+      -- wide_character otherwise.
+
+      function Map_To_Lower_Case (From : Wide_Character) 
+         return Wide_Character is
+      begin
+         return Ada.Characters.Handling.To_Wide_Character(
+                  Ada.Characters.Handling.To_Lower(
+                    Ada.Characters.Handling.To_Character(From)));
+      end Map_To_Lower_Case;
+
+      -- Function Map_To_Upper_Case will return the upper case form of 
+      -- Wide_Characters in the range 'a'..'z', or whose position is in one
+      -- of the ranges 223..246 or 248..255, provided the wide_character has
+      -- an upper case form.               
+
+      function Map_To_Upper_Case (From : Wide_Character) 
+        return Wide_Character is
+      begin
+         return Ada.Characters.Handling.To_Wide_Character(
+                  Ada.Characters.Handling.To_Upper(
+                    Ada.Characters.Handling.To_Character(From)));
+      end Map_To_Upper_Case;
+
+end CXA4033_0;
+
+
+with CXA4033_0;
+with Report;
+with Ada.Characters.Handling;
+with Ada.Characters.Latin_1;
+with Ada.Strings;
+with Ada.Strings.Wide_Maps;
+with Ada.Strings.Wide_Maps.Wide_Constants;
+with Ada.Strings.Wide_Fixed;
+with Ada.Strings.Wide_Unbounded;
+
+procedure CXA4033 is
+begin
+   Report.Test ("CXA4033", 
+                "Check that subprograms defined in the package " &
+                "Ada.Strings.Wide_Unbounded produce correct results");
+
+   Test_Block:
+   declare
+
+      package ACL1 renames Ada.Characters.Latin_1;
+      package Unb  renames Ada.Strings.Wide_Unbounded;
+
+      subtype LC_Characters is Wide_Character range 'a'..'z';
+
+      use Ada.Characters, Ada.Strings, Unb;
+      use type Wide_Maps.Wide_Character_Set; 
+
+      TC_String      : constant Wide_String := "A Standard String";
+
+      String_20      : Wide_String(1..20)    := "ABCDEFGHIJKLMNOPQRST";
+      String_40      : Wide_String(1..40)    := "abcdefghijklmnopqrst" & 
+                                                String_20;
+      String_80      : Wide_String(1..80)    := String_40 & String_40;
+      TC_String_5    : Wide_String(1..5)     := "ABCDE";
+      TC_Unb_String  : Unbounded_Wide_String := Null_Unbounded_Wide_String;
+
+      -- The following strings are used in examination of the Translation
+      -- subprograms.
+      New_Character_String : Wide_String(1..10) :=
+        Handling.To_Wide_String( 
+          ACL1.LC_A_Grave          & ACL1.LC_A_Ring  & ACL1.LC_AE_Diphthong &
+          ACL1.LC_C_Cedilla        & ACL1.LC_E_Acute & ACL1.LC_I_Circumflex &
+          ACL1.LC_Icelandic_Eth    & ACL1.LC_N_Tilde & 
+          ACL1.LC_O_Oblique_Stroke & ACL1.LC_Icelandic_Thorn);  
+ 
+      TC_New_Character_String : Wide_String(1..10) :=
+        Handling.To_Wide_String(
+          ACL1.UC_A_Grave          & ACL1.UC_A_Ring  & ACL1.UC_AE_Diphthong &
+          ACL1.UC_C_Cedilla        & ACL1.UC_E_Acute & ACL1.UC_I_Circumflex &
+          ACL1.UC_Icelandic_Eth    & ACL1.UC_N_Tilde &
+          ACL1.UC_O_Oblique_Stroke & ACL1.UC_Icelandic_Thorn);  
+
+      New_UB_Character_String : Unbounded_Wide_String :=
+                         To_Unbounded_Wide_String(New_Character_String);
+
+      TC_New_UB_Character_String : Unbounded_Wide_String :=
+                         To_Unbounded_Wide_String(TC_New_Character_String);
+                     
+      -- Access objects that will be provided as parameters to the 
+      -- subprograms.
+      Map_To_Lower_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
+                                CXA4033_0.Map_To_Lower_Case'Access;
+      Map_To_Upper_Case_Ptr : Wide_Maps.Wide_Character_Mapping_Function :=
+                                CXA4033_0.Map_To_Upper_Case'Access;
+
+   begin
+
+      -- Testing functionality found in Package Ada.Strings.Wide_Unbounded.
+      -- 
+      -- Function Index.
+
+      if Index(To_Unbounded_Wide_String("AAABBBaaabbb"),
+               "aabb",
+               Mapping => Map_To_Lower_Case_Ptr)                   /=  2 or
+         Index(To_Unbounded_Wide_String("Case of a Mixed Case String"), 
+               "case", 
+               Ada.Strings.Backward,
+               Map_To_Lower_Case_Ptr)                              /= 17 
+      then
+         Report.Failed("Incorrect results from Function Index, " &
+                       "using a Wide Character Mapping Function parameter");
+      end if;
+
+      -- Function Count.
+      if Count(Source  => To_Unbounded_Wide_String("ABABABA"),       
+               Pattern => "aba",
+               Mapping => Map_To_Lower_Case_Ptr)                      /= 2 or
+         Count(Null_Unbounded_Wide_String, "mat", Map_To_Upper_Case_Ptr) /= 0
+      then
+         Report.Failed("Incorrect results from Function Count, using " &
+                       "a Character Mapping Function parameter");
+      end if;
+
+      -- Function Translate.
+      if Translate(To_Unbounded_Wide_String("A Sample Mixed Case String"),
+                   Mapping => Map_To_Lower_Case_Ptr)               /= 
+         To_Unbounded_Wide_String("a sample mixed case string")      or
+         Translate(New_UB_Character_String, Map_To_Upper_Case_Ptr) /= 
+         TC_New_UB_Character_String
+      then
+         Report.Failed("Incorrect results from Function Translate, " &
+                       "using a Character Mapping Function parameter");
+      end if;
+
+      -- Procedure Translate.
+      declare
+         use Ada.Characters.Handling;
+         Str : Unbounded_Wide_String := 
+                 To_Unbounded_Wide_String("AN ALL UPPER CASE STRING");
+      begin
+         Translate(Source => Str, Mapping => Map_To_Lower_Case_Ptr);
+         if Str /= To_Unbounded_Wide_String("an all upper case string") then
+            Report.Failed("Incorrect result from Procedure Translate 1");
+         end if;
+
+         Translate(New_UB_Character_String, Map_To_Upper_Case_Ptr);
+         if New_UB_Character_String /= TC_New_UB_Character_String then
+            Report.Failed("Incorrect result from Procedure Translate 2");
+         end if;
+      end;
+
+      -- Function To_Unbounded_Wide_String (version with Length parameter)
+      if Length(To_Unbounded_Wide_String(Length => 10)) /= 10 or
+         Length(To_Unbounded_Wide_String(0))            /=  0 or
+         Length( To_Unbounded_Wide_String(10) &
+                 To_Unbounded_Wide_String(1) &
+                 To_Unbounded_Wide_String(0) ) /= 10 + 1 + 0
+      then
+         Report.Failed
+           ("Incorrect results from Function To_Unbounded_Wide_String " &
+            "with Length parameter");
+      end if;
+
+      -- Procedure Append (Wide_Unbounded - Wide_Unbounded)
+      TC_Unb_String := Null_Unbounded_Wide_String;
+      Append(TC_Unb_String, To_Unbounded_Wide_String("New Unbounded String"));
+      if TC_Unb_String /= To_Unbounded_Wide_String("New Unbounded String")
+      then
+         Report.Failed("Incorrect results from Procedure Append with " &
+                       "unbounded wide string parameters");
+      end if;
+
+      
+      -- Procedure Append (Wide_Unbounded - Wide_String)
+      TC_Unb_String := To_Unbounded_Wide_String("An Unbounded String and ");
+      Append(Source => TC_Unb_String, New_Item => TC_String);
+      if TC_Unb_String /= 
+         To_Unbounded_Wide_String("An Unbounded String and A Standard String")
+      then
+         Report.Failed("Incorrect results from Procedure Append with "  &
+                       "an unbounded wide string parameter and a wide " &
+                       "string parameter");
+      end if;
+
+      -- Procedure Append (Wide_Unbounded - Wide_Character)
+      TC_Unb_String := To_Unbounded_Wide_String("Lower Case = ");
+      for i in LC_Characters'Range loop
+         Append(Source => TC_Unb_String, New_Item => LC_Characters(i));
+      end loop;
+      if TC_Unb_String /= 
+         Unb.To_Unbounded_Wide_String
+           ("Lower Case = abcdefghijklmnopqrstuvwxyz")
+      then
+         Report.Failed("Incorrect results from Procedure Append with "  &
+                       "an unbounded wide string parameter and a wide " &
+                       "character parameter");
+      end if;        
+
+      -- Function "="
+      TC_Unb_String := To_Unbounded_Wide_String(TC_String);
+      if not (TC_Unb_String = TC_String)             or 
+         not "="("A Standard String", TC_Unb_String) or 
+         not ((Null_Unbounded_Wide_String = "") and          
+              ("Test String" = To_Unbounded_Wide_String("Test String")))
+      then
+         Report.Failed("Incorrect results from Function ""="" with " &
+                       "wide_string - unbounded wide string parameters");
+      end if;
+
+      -- Function "<"
+      if not ("Extra Space" < To_Unbounded_Wide_String("Extra Space ") and
+              To_Unbounded_Wide_String("tess") < "test"                and
+              To_Unbounded_Wide_String("best") < "test")                
+      then
+         Report.Failed("Incorrect results from Function ""<"" with " &
+                       "wide string - unbounded wide string parameters");
+      end if;
+
+      -- Function "<="
+      TC_Unb_String := To_Unbounded_Wide_String("Sample string");
+      if TC_Unb_String                  <= "Sample strin" or 
+         not("Sample string"            <= TC_Unb_String)
+      then
+         Report.Failed("Incorrect results from Function ""<="" with " &
+                       "wide string - unbounded wide string parameters");
+      end if;
+
+      -- Function ">"
+      TC_Unb_String := To_Unbounded_Wide_String("A MUCH LONGER STRING");
+      if not ("A much longer string" > TC_Unb_String                   and 
+              To_Unbounded_Wide_String(TC_String) > "A Standard Strin" and
+              "abcdefgh" > To_Unbounded_Wide_String("ABCDEFGH"))        
+      then
+         Report.Failed("Incorrect results from Function "">"" with " &
+                       "wide string - unbounded wide string parameters");
+      end if;
+
+      -- Function ">=" 
+      TC_Unb_String := To_Unbounded_Wide_String(TC_String);
+      if not (TC_Unb_String >= TC_String                        and 
+              "test"        >= To_Unbounded_Wide_String("tess") and  
+              To_Unbounded_Wide_String("Programming") >= "PROGRAMMING")
+      then
+         Report.Failed("Incorrect results from Function "">="" with " &
+                       "wide string - unbounded wide string parameters");
+      end if;
+
+      -- Procedure Replace_Slice
+      TC_Unb_String := To_Unbounded_Wide_String("Test String");
+      Replace_Slice(TC_Unb_String, 5, 5, TC_String_5);
+      if TC_Unb_String /= To_Unbounded_Wide_String("TestABCDEString") then
+         Report.Failed("Incorrect results from Replace_Slice - 1");
+      end if;
+
+      Replace_Slice(TC_Unb_String, 1, 4, TC_String_5);
+      if TC_Unb_String /= To_Unbounded_Wide_String("ABCDEABCDEString") then
+         Report.Failed("Incorrect results from Replace_Slice - 2");
+      end if;
+
+      -- Procedure Insert
+      TC_Unb_String := To_Unbounded_Wide_String("Test String");
+      Insert(TC_Unb_String, 1, "**");
+      if TC_Unb_String /= To_Unbounded_Wide_String("**Test String") then
+         Report.Failed("Incorrect results from Procedure Insert - 1");
+      end if;
+
+      Insert(TC_Unb_String, Length(TC_Unb_String)+1, "**");
+      if TC_Unb_String /= To_Unbounded_Wide_String("**Test String**") then
+         Report.Failed("Incorrect results from Procedure Insert - 2");
+      end if;
+
+      -- Procedure Overwrite
+      TC_Unb_String := To_Unbounded_Wide_String("Test String");
+      Overwrite(TC_Unb_String, 1, New_Item => "XXXX");
+      if TC_Unb_String /= To_Unbounded_Wide_String("XXXX String") then
+         Report.Failed("Incorrect results from Procedure Overwrite - 1");
+      end if;
+
+      Overwrite(TC_Unb_String, Length(TC_Unb_String)+1, "**");
+      if TC_Unb_String /= To_Unbounded_Wide_String("XXXX String**") then
+         Report.Failed("Incorrect results from Procedure Overwrite - 2");
+      end if;
+
+      -- Procedure Delete
+      TC_Unb_String := To_Unbounded_Wide_String("Test String");
+      Delete(TC_Unb_String, 1, 0);
+      if TC_Unb_String /= To_Unbounded_Wide_String("Test String") then
+         Report.Failed("Incorrect results from Procedure Delete - 1");
+      end if;
+
+      Delete(TC_Unb_String, 1, 5);
+      if TC_Unb_String /= To_Unbounded_Wide_String("String") then
+         Report.Failed("Incorrect results from Procedure Delete - 2");
+      end if;
+
+      -- Procedure Trim 
+      TC_Unb_String := To_Unbounded_Wide_String("   Leading Spaces   ");
+      Trim(TC_Unb_String, Ada.Strings.Left);
+      if TC_Unb_String /= To_Unbounded_Wide_String("Leading Spaces   ") then
+         Report.Failed("Incorrect results from Procedure Trim - 1");
+      end if;
+
+      TC_Unb_String := 
+        To_Unbounded_Wide_String("    Spaces   on  both  ends     ");
+      Trim(TC_Unb_String, Ada.Strings.Both);
+      if TC_Unb_String /= 
+         To_Unbounded_Wide_String("Spaces   on  both  ends") 
+      then
+         Report.Failed("Incorrect results from Procedure Trim - 2");
+      end if;
+
+      -- Procedure Trim (with Wide_Character_Set parameters)
+      TC_Unb_String := To_Unbounded_Wide_String("012abcdefghGFEDCBA789ab");
+      Trim(TC_Unb_String,
+           Ada.Strings.Wide_Maps.Wide_Constants.Hexadecimal_Digit_Set,
+           Ada.Strings.Wide_Maps.Wide_Constants.Hexadecimal_Digit_Set);
+      if TC_Unb_String /= To_Unbounded_Wide_String("ghG") then
+         Report.Failed("Incorrect results from Procedure Trim with Sets");
+      end if;
+
+      -- Procedure Head
+      TC_Unb_String := To_Unbounded_Wide_String("Test String");
+      Head(Source => TC_Unb_String, Count => 0, Pad => '*');
+      if TC_Unb_String /= Null_Unbounded_Wide_String then
+         Report.Failed("Incorrect results from Procedure Head - 1");
+      end if;
+
+      TC_Unb_String := To_Unbounded_Wide_String("Test String");
+      Head(Source => TC_Unb_String, Count => 4, Pad => '*');
+      if TC_Unb_String /= To_Unbounded_Wide_String("Test") then
+         Report.Failed("Incorrect results from Procedure Head - 2");
+      end if;
+
+      -- Procedure Tail
+      TC_Unb_String := To_Unbounded_Wide_String("Test String");
+      Tail(Source => TC_Unb_String, Count  => 0, Pad => '*');
+      if TC_Unb_String /= Null_Unbounded_Wide_String then
+         Report.Failed("Incorrect results from Procedure Tail - 1");
+      end if;
+
+      TC_Unb_String := To_Unbounded_Wide_String("Test String");
+      Tail(TC_Unb_String, Length(TC_Unb_String) + 5, 'x');
+      if TC_Unb_String /= To_Unbounded_Wide_String("xxxxxTest String") then
+         Report.Failed("Incorrect results from Procedure Tail - 2");
+      end if;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA4033;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4034.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4034.a
new file mode 100644
index 000000000..a1ed53de0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa4034.a
@@ -0,0 +1,281 @@
+-- CXA4034.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that Ada.Strings.Bounded.Slice raises Index_Error if
+--    High > Length (Source) or Low > Length (Source) + 1.
+--    (Defect Report 8652/0049).
+--
+--    Check that Ada.Strings.Wide_Bounded.Slice raises Index_Error if
+--    High > Length (Source) or Low > Length (Source) + 1.
+--
+-- CHANGE HISTORY:
+--    12 FEB 2001   PHL   Initial version
+--    14 MAR 2001   RLB   Added Wide_Bounded subtest.
+--
+--!
+with Ada.Exceptions;
+use Ada.Exceptions;
+with Ada.Strings.Bounded;
+with Ada.Strings.Wide_Bounded;
+use Ada.Strings;
+with Report;
+use Report;
+procedure CXA4034 is
+
+    package Bs is new Ada.Strings.Bounded.Generic_Bounded_Length (40);
+
+    package WBs is new Ada.Strings.Wide_Bounded.Generic_Bounded_Length (32);
+
+    Source : String (Ident_Int (1) .. Ident_Int (30));
+
+    Wide_Source : Wide_String (Ident_Int (1) .. Ident_Int (24));
+
+    X : Bs.Bounded_String;
+
+    WX : WBs.Bounded_Wide_String;
+
+begin
+    Test ("CXA4034",
+          "Check that Slice raises Index_Error if either Low or High is " &
+             "greater than the Length(Source) for Ada.Strings.Bounded and " &
+             "Ada.Strings.Wide_Bounded");
+
+    -- Fill Source with "ABC..."
+    for I in Source'Range loop
+        Source (I) := Ident_Char (Character'Val (I +
+                        Character'Pos ('A') - Source'First));
+    end loop;
+    -- and W with "ABC..."
+    for I in Wide_Source'Range loop
+        Wide_Source (I) := Ident_Wide_Char (Wide_Character'Val (I +
+                         Wide_Character'Pos ('A') - Wide_Source'First));
+    end loop;
+
+    X := Bs.To_Bounded_String (Source);
+
+    begin
+        declare
+            S : constant String :=
+               Bs.Slice (X, Low => Ident_Int (28), High => Ident_Int (41));
+        begin
+            Failed ("No exception raised by Slice - 1");
+            if S = Source then
+                Comment ("Don't optimize S");
+            end if;
+        end;
+    exception
+        when Index_Error =>
+            null; -- Expected exception.
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 1");
+    end;
+
+    begin
+        declare
+            S : constant String :=
+               Bs.Slice (X, Low => Ident_Int (8), High => Ident_Int (31));
+        begin
+            Failed ("No exception raised by Slice - 2");
+            if S = Source then
+                Comment ("Don't optimize S");
+            end if;
+        end;
+    exception
+        when Index_Error =>
+            null; -- Expected exception.
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 2");
+    end;
+
+    begin
+        declare
+            S : constant String :=
+               Bs.Slice (X, Low => Ident_Int (15), High => Ident_Int (30));
+        begin
+            if S /= Source(15..30) then
+                Failed ("Wrong result - 3");
+            end if;
+        end;
+    exception
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 3");
+    end;
+
+    begin
+        declare
+            S : constant String :=
+               Bs.Slice (X, Low => Ident_Int (42), High => Ident_Int (28));
+        begin
+            Failed ("No exception raised by Slice - 4");
+            if S = Source then
+                Comment ("Don't optimize S");
+            end if;
+        end;
+    exception
+        when Index_Error =>
+            null; -- Expected exception.
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 4");
+    end;
+
+    begin
+        declare
+            S : constant String :=
+               Bs.Slice (X, Low => Ident_Int (31), High => Ident_Int (28));
+        begin
+            if S /= "" then
+                Failed ("Wrong result - 5");
+            end if;
+        end;
+    exception
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 5");
+    end;
+
+    begin
+        declare
+            S : constant String :=
+               Bs.Slice (X, Low => Ident_Int (30), High => Ident_Int (30));
+        begin
+            if S /= Source(30..30) then
+                Failed ("Wrong result - 6");
+            end if;
+        end;
+    exception
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 6");
+    end;
+
+    WX := WBs.To_Bounded_Wide_String (Wide_Source);
+
+    begin
+        declare
+            W : constant Wide_String :=
+               WBs.Slice (WX, Low => Ident_Int (21), High => Ident_Int (33));
+        begin
+            Failed ("No exception raised by Slice - 7");
+            if W = Wide_Source then
+                Comment ("Don't optimize W");
+            end if;
+        end;
+    exception
+        when Index_Error =>
+            null; -- Expected exception.
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 7");
+    end;
+
+    begin
+        declare
+            W : constant Wide_String :=
+               WBs.Slice (WX, Low => Ident_Int (8), High => Ident_Int (25));
+        begin
+            Failed ("No exception raised by Slice - 8");
+            if W = Wide_Source then
+                Comment ("Don't optimize W");
+            end if;
+        end;
+    exception
+        when Index_Error =>
+            null; -- Expected exception.
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 8");
+    end;
+
+    begin
+        declare
+            W : constant Wide_String :=
+               WBs.Slice (WX, Low => Ident_Int (15), High => Ident_Int (24));
+        begin
+            if W /= Wide_Source(15..24) then
+                Failed ("Wrong result - 8");
+            end if;
+        end;
+    exception
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 9");
+    end;
+
+    begin
+        declare
+            W : constant Wide_String :=
+               WBs.Slice (WX, Low => Ident_Int (36), High => Ident_Int (20));
+        begin
+            Failed ("No exception raised by Slice - 10");
+            if W = Wide_Source then
+                Comment ("Don't optimize W");
+            end if;
+        end;
+    exception
+        when Index_Error =>
+            null; -- Expected exception.
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 10");
+    end;
+
+    begin
+        declare
+            W : constant Wide_String :=
+               WBs.Slice (WX, Low => Ident_Int (25), High => Ident_Int (21));
+        begin
+            if W /= "" then
+                Failed ("Wrong result - 11");
+            end if;
+        end;
+    exception
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 11");
+    end;
+
+    begin
+        declare
+            W : constant Wide_String :=
+               WBs.Slice (WX, Low => Ident_Int (24), High => Ident_Int (24));
+        begin
+            if W /= Wide_Source(24..24) then
+                Failed ("Wrong result - 12");
+            end if;
+        end;
+    exception
+        when E: others =>
+            Failed ("Exception raised - " & Exception_Name (E) &
+                    " - " & Exception_Message (E) & " - 12");
+    end;
+
+    Result;
+end CXA4034;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a
new file mode 100644
index 000000000..c9a007e52
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5011.a
@@ -0,0 +1,471 @@
+-- CXA5011.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, for both Float_Random and Discrete_Random packages,
+--      the following are true:
+--      1) two objects of type Generator are initialized to the same state.
+--      2) when the Function Reset is used to reset two generators
+--         to different time-dependent states, the resulting random values
+--         from each generator are different.
+--      3) when the Function Reset uses the same integer initiator
+--         to reset two generators to the same state, the resulting random
+--         values from each generator are identical.
+--      4) when the Function Reset uses different integer initiator
+--         values to reset two generators, the resulting random numbers are
+--         different.
+--
+-- TEST DESCRIPTION:
+--      This test evaluates components of the Ada.Numerics.Float_Random and
+--      Ada.Numerics.Discrete_Random packages.
+--      This test checks to see that objects of type Generator are initialized
+--      to the same state. In addition, the functionality of Function Reset is
+--      validated.
+--      For each of the objectives above, evaluation of the various generators
+--      is performed using each of the following techniques. When the states of
+--      two generators are to be compared, each state is saved, then
+--      transformed to a bounded-string variable.  The bounded-strings can
+--      then be compared for equality.  In this case, matching bounded-strings
+--      are evidence that the states of two generators are the same.
+--      In addition, two generators are compared by evaluating a series of
+--      random numbers they produce.  A matching series of random numbers
+--      implies that the generators were in the same state prior to producing
+--      the numbers.
+--
+--
+-- CHANGE HISTORY:
+--      20 Apr 95   SAIC    Initial prerelease version.
+--      07 Jul 95   SAIC    Incorporated reviewer comments/suggestions.
+--      22 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      17 Aug 96   SAIC    Deleted Subtest #2.
+--      09 Feb 01   RLB     Repaired to work on implementations with a 16-bit
+--                          Integer.
+
+--!
+
+with Ada.Exceptions;
+with Ada.Numerics.Float_Random;
+with Ada.Numerics.Discrete_Random;
+with Ada.Strings.Bounded;
+with ImpDef;
+with Report;
+
+procedure CXA5011 is
+begin
+
+   Report.Test ("CXA5011", "Check the effect of Function Reset on the " &
+                           "state of random number generators");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+      use Ada.Numerics;
+      use Ada.Strings.Bounded;
+
+      -- Declare an modular subtype, and use it to instantiate the discrete
+      -- random number generator generic package.
+
+      type    Discrete_Range   is mod 2**(Integer'Size-1);
+      package Discrete_Package is new Discrete_Random(Discrete_Range);
+
+      -- Declaration of random number generator objects.
+
+      Discrete_Generator_1,
+      Discrete_Generator_2  : Discrete_Package.Generator;
+      Float_Generator_1,
+      Float_Generator_2     : Float_Random.Generator;
+
+      -- Declaration of bounded string packages instantiated with the
+      -- value of Max_Image_Width constant from each random number generator
+      -- package, and bounded string variables used to hold the image of
+      -- random number generator states.
+
+      package Discrete_String_Pack is
+        new Generic_Bounded_Length(Discrete_Package.Max_Image_Width);
+
+      package Float_String_Pack is
+        new Generic_Bounded_Length(Float_Random.Max_Image_Width);
+
+      use Discrete_String_Pack, Float_String_Pack;
+
+      TC_Seed                  : Integer;
+      TC_Max_Loop_Count        : constant Natural := 1000;
+      Allowed_Matches          : constant Natural := 2;
+      --
+      -- In a sequence of TC_Max_Loop_Count random numbers that should
+      -- not match, some may match by chance.  Up to Allowed_Matches
+      -- numbers may match before the test is considered to fail.
+      --
+
+
+      procedure Check_Float_State (Gen_1, Gen_2 : Float_Random.Generator;
+                                   Sub_Test     : Integer;
+                                   States_Should_Match : Boolean) is
+
+         use type Float_Random.State;
+
+         State_1,
+         State_2         : Float_Random.State;
+
+         State_String_1,
+         State_String_2  : Float_String_Pack.Bounded_String :=
+                             Float_String_Pack.Null_Bounded_String;
+      begin
+
+         Float_Random.Save(Gen => Gen_1, To_State => State_1);
+         Float_Random.Save(Gen_2, State_2);
+
+         State_String_1 :=
+           Float_String_Pack.To_Bounded_String(Source =>
+             Float_Random.Image(Of_State => State_1));
+
+         State_String_2 :=
+           Float_String_Pack.To_Bounded_String(Float_Random.Image(State_2));
+
+         case States_Should_Match is
+            when True  =>
+               if State_1 /= State_2 then
+                  Report.Failed("Subtest #" & Integer'Image(Sub_Test)    &
+                                "   State values from Float generators " &
+                                "are not the same");
+               end if;
+               if State_String_1 /= State_String_2 then
+                  Report.Failed("Subtest #" & Integer'Image(Sub_Test)     &
+                                "   State strings from Float generators " &
+                                "are not the same");
+               end if;
+            when False =>
+               if State_1 = State_2 then
+                  Report.Failed("Subtest #" & Integer'Image(Sub_Test)    &
+                                "   State values from Float generators " &
+                                "are the same");
+               end if;
+               if State_String_1 = State_String_2 then
+                  Report.Failed("Subtest #" & Integer'Image(Sub_Test)     &
+                                "   State strings from Float generators " &
+                                "are the same");
+               end if;
+         end case;
+      end Check_Float_State;
+
+
+
+      procedure Check_Discrete_State (Gen_1,
+                                      Gen_2    : Discrete_Package.Generator;
+                                      Sub_Test : Integer;
+                                      States_Should_Match : Boolean) is
+
+         use type Discrete_Package.State;
+
+         State_1, State_2  : Discrete_Package.State;
+
+         State_String_1,
+         State_String_2    : Discrete_String_Pack.Bounded_String :=
+                               Discrete_String_Pack.Null_Bounded_String;
+      begin
+
+         Discrete_Package.Save(Gen      => Gen_1,
+                               To_State => State_1);
+         Discrete_Package.Save(Gen_2, To_State => State_2);
+
+         State_String_1 :=
+           Discrete_String_Pack.To_Bounded_String(Source =>
+             Discrete_Package.Image(Of_State => State_1));
+
+         State_String_2 :=
+           Discrete_String_Pack.To_Bounded_String(Source =>
+             Discrete_Package.Image(Of_State => State_2));
+
+         case States_Should_Match is
+            when True  =>
+               if State_1 /= State_2 then
+                  Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
+                                "   State values from Discrete "      &
+                                "generators are not the same");
+               end if;
+               if State_String_1 /= State_String_2 then
+                  Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
+                                "   State strings from Discrete "     &
+                                "generators are not the same");
+               end if;
+            when False =>
+               if State_1 = State_2 then
+                  Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
+                                "   State values from Discrete "      &
+                                "generators are the same");
+               end if;
+               if State_String_1 = State_String_2 then
+                  Report.Failed("Subtest #" & Integer'Image(Sub_Test) &
+                                "   State strings from Discrete "     &
+                                "generators are the same");
+               end if;
+         end case;
+      end Check_Discrete_State;
+
+
+
+      procedure Check_Float_Values (Gen_1, Gen_2 : Float_Random.Generator;
+                                    Sub_Test     : Integer;
+                                    Values_Should_Match : Boolean) is
+         Matches         : Natural := 0;
+         Check_Failed    : Boolean := False;
+      begin
+         case Values_Should_Match is
+            when True  =>
+               for i in 1..TC_Max_Loop_Count loop
+                  if Float_Random.Random(Gen_1) /= Float_Random.Random(Gen_2)
+                  then
+                     Check_Failed := True;
+                     exit;
+                  end if;
+               end loop;
+               if Check_Failed then
+                  Report.Failed("Sub_Test # " & Integer'Image(Sub_Test)    &
+                                "   Random numbers from Float generators " &
+                                "Failed check");
+               end if;
+            when False =>
+               for i in 1..TC_Max_Loop_Count loop
+                  if Float_Random.Random(Gen_1) = Float_Random.Random(Gen_2)
+                  then
+                     Matches := Matches + 1;
+                  end if;
+               end loop;
+         end case;
+
+         if (Values_Should_Match and Check_Failed) or
+            (not Values_Should_Match and Matches > Allowed_Matches)
+         then
+            Report.Failed("Sub_Test # " & Integer'Image(Sub_Test)    &
+                          "   Random numbers from Float generators " &
+                          "Failed check");
+         end if;
+
+      end Check_Float_Values;
+
+
+
+      procedure Check_Discrete_Values (Gen_1,
+                                       Gen_2    : Discrete_Package.Generator;
+                                       Sub_Test : Integer;
+                                       Values_Should_Match : Boolean) is
+         Matches         : Natural := 0;
+         Check_Failed    : Boolean := False;
+      begin
+         case Values_Should_Match is
+            when True  =>
+               for i in 1..TC_Max_Loop_Count loop
+                  if Discrete_Package.Random(Gen_1) /=
+                     Discrete_Package.Random(Gen_2)
+                  then
+                     Check_Failed := True;
+                     exit;
+                  end if;
+               end loop;
+            when False =>
+               for i in 1..TC_Max_Loop_Count loop
+                  if Discrete_Package.Random(Gen_1) =
+                     Discrete_Package.Random(Gen_2)
+                  then
+                     Matches := Matches + 1;
+                  end if;
+               end loop;
+         end case;
+
+         if (Values_Should_Match and Check_Failed) or
+            (not Values_Should_Match and Matches > Allowed_Matches)
+         then
+            Report.Failed("Sub_Test # " & Integer'Image(Sub_Test)    &
+                          "   Random numbers from Discrete generators " &
+                          "Failed check");
+         end if;
+
+      end Check_Discrete_Values;
+
+
+
+   begin
+
+      Sub_Test_1:
+         -- Check that two objects of type Generator are initialized to the
+         -- same state.
+      begin
+
+         -- Since the discrete and float random generators are in the initial
+         -- state, using Procedure Save to save the states of the generator
+         -- objects, and transforming these states into strings using
+         -- Function Image, should yield identical strings.
+
+         Check_Discrete_State (Discrete_Generator_1,
+                               Discrete_Generator_2,
+                               Sub_Test => 1,
+                               States_Should_Match => True);
+
+         Check_Float_State (Float_Generator_1,
+                            Float_Generator_2,
+                            Sub_Test => 1,
+                            States_Should_Match => True);
+
+         -- Since the two random generator objects are in their initial
+         -- state, the values produced from each (upon calls to Random)
+         -- should be identical.
+
+         Check_Discrete_Values (Discrete_Generator_1,
+                                Discrete_Generator_2,
+                                Sub_Test => 1,
+                                Values_Should_Match => True);
+
+         Check_Float_Values (Float_Generator_1,
+                             Float_Generator_2,
+                             Sub_Test => 1,
+                             Values_Should_Match => True);
+
+      end Sub_Test_1;
+
+
+
+      Sub_Test_3:
+         -- Check that when the Function Reset uses the same integer
+         -- initiator to reset two generators to the same state, the
+         -- resulting random values and the state from each generator
+         -- are identical.
+      declare
+         use Discrete_Package, Float_Random;
+      begin
+
+         -- Reset the generators to the same states, using the version of
+         -- Function Reset with both generator parameter and initiator
+         -- specified.
+
+         TC_Seed := Integer(Random(Discrete_Generator_1));
+         Reset(Gen => Discrete_Generator_1, Initiator => TC_Seed);
+         Reset(Discrete_Generator_2, Initiator => TC_Seed);
+         Reset(Float_Generator_1, TC_Seed);
+         Reset(Float_Generator_2, TC_Seed);
+
+         -- Since the random generators have been reset to identical states,
+         -- bounded string images of these states should yield identical
+         -- strings.
+
+         Check_Discrete_State (Discrete_Generator_1,
+                               Discrete_Generator_2,
+                               Sub_Test => 3,
+                               States_Should_Match => True);
+
+         Check_Float_State (Float_Generator_1,
+                            Float_Generator_2,
+                            Sub_Test => 3,
+                            States_Should_Match => True);
+
+         -- Since the random generators have been reset to identical states,
+         -- the values produced from each (upon calls to Random) should
+         -- be identical.
+
+         Check_Discrete_Values (Discrete_Generator_1,
+                                Discrete_Generator_2,
+                                Sub_Test => 3,
+                                Values_Should_Match => True);
+
+         Check_Float_Values (Float_Generator_1,
+                             Float_Generator_2,
+                             Sub_Test => 3,
+                             Values_Should_Match => True);
+
+      end Sub_Test_3;
+
+
+
+      Sub_Test_4:
+         -- Check that when the Function Reset uses different integer
+         -- initiator values to reset two generators, the resulting random
+         -- numbers and states are different.
+      begin
+
+         -- Reset the generators to different states.
+
+         TC_Seed :=
+           Integer(Discrete_Package.Random(Discrete_Generator_1));
+
+         Discrete_Package.Reset(Gen       => Discrete_Generator_1,
+                                Initiator => TC_Seed);
+
+         -- Set the seed value to a different value for the second call
+         -- to Reset.
+         -- Note: A second call to Random could be made, as above, but that
+         --       would not ensure that the resulting seed value was
+         --       different from the first.
+
+         if TC_Seed /= Integer'Last then
+            TC_Seed := TC_Seed + 1;
+         else
+            TC_Seed := TC_Seed - 1;
+         end if;
+
+         Discrete_Package.Reset(Gen       => Discrete_Generator_2,
+                                Initiator => TC_Seed);
+
+         Float_Random.Reset(Float_Generator_1, 16#FF#);             -- 255
+         Float_Random.Reset(Float_Generator_2, 2#1110_0000#);       -- 224
+
+         -- Since the two float random generators are in different
+         -- states, the bounded string images depicting their states should
+         -- differ.
+
+         Check_Discrete_State (Discrete_Generator_1,
+                               Discrete_Generator_2,
+                               Sub_Test => 4,
+                               States_Should_Match => False);
+
+         Check_Float_State (Float_Generator_1,
+                            Float_Generator_2,
+                            Sub_Test => 4,
+                            States_Should_Match => False);
+
+         -- Since the two discrete random generator objects were reset
+         -- to different states, the values produced from each (upon calls
+         -- to Random) should differ.
+
+         Check_Discrete_Values (Discrete_Generator_1,
+                                Discrete_Generator_2,
+                                Sub_Test => 4,
+                                Values_Should_Match => False);
+
+         Check_Float_Values (Float_Generator_1,
+                             Float_Generator_2,
+                             Sub_Test => 4,
+                             Values_Should_Match => False);
+
+      end Sub_Test_4;
+
+   exception
+      when The_Error : others =>
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5012.a
new file mode 100644
index 000000000..a286fa71e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5012.a
@@ -0,0 +1,536 @@
+-- CXA5012.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, for both Float_Random and Discrete_Random packages,
+--      the following are true:
+--      1) the procedures Save and Reset can be used to save the
+--         specific state of a random number generator, and then restore
+--         the specific state to the generator following some intermediate
+--         generator activity.
+--      2) the Function Image can be used to obtain a string
+--         representation of the state of a generator; and that the
+--         Function Value will transform a string representation of the
+--         state of a random number generator into the actual state object.
+--      3) a call to Function Value, with a string value that is
+--         not the image of any generator state, is a bounded error. This
+--         error either raises Constraint_Error or Program_Error, or is
+--         accepted. (See Technical Corrigendum 1).
+--
+-- TEST DESCRIPTION:
+--      This test evaluates components of the Ada.Numerics.Float_Random and
+--      Ada.Numerics.Discrete_Random packages.
+--      The first objective block of this test uses Procedure Save to
+--      save the particular state of a random number generator.  The random
+--      number generator then generates a series of random numbers.  The
+--      saved state variable is then used to reset (using Procedure Reset)
+--      the generator back to the state it was in at the point of the call
+--      to Save.  Random values are then generated from this restored
+--      generator, and compared with expected values.
+--      The second objective block of this test uses Function Image to
+--      provide a string representation of a state code.  This string is
+--      then transformed back to a state code value, and used to reset a
+--      random number generator to the saved state.  Random values are
+--      likewise generated from this restored generator, and compared with
+--      expected values.
+--
+--
+-- CHANGE HISTORY:
+--      25 Apr 95   SAIC    Initial prerelease version.
+--      17 Jul 95   SAIC    Incorporated reviewer comments.
+--      17 Dec 97   EDS     Change subtype upper limit from 100_000 to 10_000.
+--      16 Sep 99   RLB     Updated objective 3 for Technical Corrigendum 1
+--                          changes.
+
+--!
+
+with Ada.Numerics.Float_Random;
+with Ada.Numerics.Discrete_Random;
+with Ada.Strings.Bounded;
+with ImpDef;
+with Report;
+
+procedure CXA5012 is
+
+begin
+
+   Report.Test ("CXA5012", "Check the effect of Procedures Save and " &
+                           "Reset, and Functions Image and Value "    &
+                           "from the Ada.Numerics.Discrete_Random "   &
+                           "and Float_Random packages");
+
+   Test_Block:
+   declare
+
+      use Ada.Numerics, Ada.Strings.Bounded;
+
+      -- Declare an integer subtype and an enumeration subtype, and use them
+      -- to instantiate the discrete random number generator generic package.
+
+      subtype Discrete_Range is Integer range 1..10_000;
+      type    Suit_Of_Cards  is (Ace, One, Two, Three, Four, Five, Six,
+                                 Seven, Eight, Nine, Ten, Jack, Queen, King);
+      package Discrete_Pack is new Discrete_Random(Discrete_Range);
+      package Card_Pack     is new Discrete_Random(Suit_Of_Cards);
+
+      -- Declaration of random number generator objects.
+
+      DGen_1, DGen_2 : Discrete_Pack.Generator;
+      EGen_1, EGen_2 : Card_Pack.Generator;
+      FGen_1, FGen_2 : Float_Random.Generator;
+
+      -- Variables declared to hold random numbers over the inclusive range
+      -- of their corresponding type.
+
+      DVal_1, DVal_2 : Discrete_Range;
+      EVal_1, EVal_2 : Suit_Of_Cards;
+      FVal_1, FVal_2 : Float_Random.Uniformly_Distributed;
+
+      -- Declaration of State variables used to hold the state of the
+      -- random number generators.
+
+      DState_1, DState_2 : Discrete_Pack.State;
+      EState_1, EState_2 : Card_Pack.State;
+      FState_1, FState_2 : Float_Random.State;
+
+      -- Declaration of bounded string packages instantiated with the
+      -- value of Max_Image_Width constant, and bounded string variables
+      -- used to hold the image of random number generator states.
+
+      package DString_Pack is
+        new Generic_Bounded_Length(Discrete_Pack.Max_Image_Width);
+      package EString_Pack is
+        new Generic_Bounded_Length(Card_Pack.Max_Image_Width);
+      package FString_Pack is
+        new Generic_Bounded_Length(Float_Random.Max_Image_Width);
+
+      use DString_Pack, EString_Pack, FString_Pack;
+
+      DString_1, DString_2 : DString_Pack.Bounded_String :=
+                               DString_Pack.Null_Bounded_String;
+      EString_1, EString_2 : EString_Pack.Bounded_String :=
+                               EString_Pack.Null_Bounded_String;
+      FString_1, FString_2 : FString_Pack.Bounded_String :=
+                               FString_Pack.Null_Bounded_String;
+
+      -- Test variables.
+
+      TC_Count                  : Natural;
+      TC_Discrete_Check_Failed,
+      TC_Enum_Check_Failed,
+      TC_Float_Check_Failed     : Boolean := False;
+      TC_Seed                   : Integer;
+
+   begin
+
+      Objective_1:
+         -- Check that the procedures Save and Reset can be used to save the
+         -- specific state of a random number generator, and then restore the
+         -- specific state to the generator following some intermediate
+         -- generator activity.
+      declare
+
+         First_Row     : constant :=   1;
+         Second_Row    : constant :=   2;
+         TC_Max_Values : constant := 100;
+
+         TC_Discrete_Array : array (First_Row..Second_Row, 1..TC_Max_Values)
+                               of Discrete_Range;
+         TC_Enum_Array     : array (First_Row..Second_Row, 1..TC_Max_Values)
+                               of Suit_Of_Cards;
+         TC_Float_Array    : array (First_Row..Second_Row, 1..TC_Max_Values)
+                               of Float_Random.Uniformly_Distributed;
+      begin
+
+         -- The state of the random number generators are saved to state
+         -- variables using the procedure Save.
+
+         Discrete_Pack.Save(Gen => DGen_1, To_State => DState_1);
+         Card_Pack.Save    (Gen => EGen_1, To_State => EState_1);
+         Float_Random.Save (Gen => FGen_1, To_State => FState_1);
+
+         -- Random number generators are used to fill the first half of the
+         -- first row of the arrays with randomly generated values.
+
+         for i in 1..TC_Max_Values/2 loop
+            TC_Discrete_Array(First_Row, i) := Discrete_Pack.Random(DGen_1);
+            TC_Enum_Array(First_Row, i)     := Card_Pack.Random(EGen_1);
+            TC_Float_Array(First_Row, i)    := Float_Random.Random(FGen_1);
+         end loop;
+
+         -- The random number generators are reset to the states saved in the
+         -- state variables, using the procedure Reset.
+
+         Discrete_Pack.Reset(Gen => DGen_1, From_State => DState_1);
+         Card_Pack.Reset    (Gen => EGen_1, From_State => EState_1);
+         Float_Random.Reset (Gen => FGen_1, From_State => FState_1);
+
+         -- The same random number generators are used to fill the first half
+         -- of the second row of the arrays with randomly generated values.
+
+         for i in 1..TC_Max_Values/2 loop
+            TC_Discrete_Array(Second_Row, i) := Discrete_Pack.Random(DGen_1);
+            TC_Enum_Array(Second_Row, i)     := Card_Pack.Random(EGen_1);
+            TC_Float_Array(Second_Row, i)    := Float_Random.Random(FGen_1);
+         end loop;
+
+         -- Run the random number generators many times (not using results).
+
+         for i in Discrete_Range'Range loop
+             DVal_1 := Discrete_Pack.Random(DGen_1);
+             EVal_1 := Card_Pack.Random(EGen_1);
+             FVal_1 := Float_Random.Random(FGen_1);
+         end loop;
+
+         -- The states of the random number generators are saved to state
+         -- variables using the procedure Save.
+
+         Discrete_Pack.Save(Gen => DGen_1, To_State => DState_1);
+         Card_Pack.Save(Gen => EGen_1, To_State => EState_1);
+         Float_Random.Save (Gen => FGen_1, To_State => FState_1);
+
+         -- The last half of the first row of the arrays are filled with
+         -- values generated from the same random number generators.
+
+         for i in (TC_Max_Values/2 + 1)..TC_Max_Values loop
+            TC_Discrete_Array(First_Row, i) := Discrete_Pack.Random(DGen_1);
+            TC_Enum_Array(First_Row, i)     := Card_Pack.Random(EGen_1);
+            TC_Float_Array(First_Row, i)    := Float_Random.Random(FGen_1);
+         end loop;
+
+         -- The random number generators are reset to the states saved in the
+         -- state variables, using the procedure Reset.
+
+         Discrete_Pack.Reset(Gen => DGen_1, From_State => DState_1);
+         Card_Pack.Reset(Gen => EGen_1, From_State => EState_1);
+         Float_Random.Reset (Gen => FGen_1, From_State => FState_1);
+
+         -- The last half of the second row of the arrays are filled with
+         -- values generated from the same random number generator.
+         -- These values should exactly mirror the values in the last half
+         -- of the first row of the arrays that had been previously generated.
+
+         for i in (TC_Max_Values/2 + 1)..TC_Max_Values loop
+            TC_Discrete_Array(Second_Row, i) := Discrete_Pack.Random(DGen_1);
+            TC_Enum_Array(Second_Row, i)     := Card_Pack.Random(EGen_1);
+            TC_Float_Array(Second_Row, i)    := Float_Random.Random(FGen_1);
+         end loop;
+
+         -- Check that the values in the two rows of the arrays are identical.
+
+         for i in 1..TC_Max_Values loop
+            if TC_Discrete_Array(First_Row,i) /=
+               TC_Discrete_Array(Second_Row,i)
+            then
+               TC_Discrete_Check_Failed := True;
+               exit;
+            end if;
+         end loop;
+
+         for i in 1..TC_Max_Values loop
+            if TC_Enum_Array(First_Row,i) /= TC_Enum_Array(Second_Row,i) then
+               TC_Enum_Check_Failed := True;
+               exit;
+            end if;
+         end loop;
+
+         for i in 1..TC_Max_Values loop
+            if TC_Float_Array(First_Row,i) /= TC_Float_Array(Second_Row,i)
+            then
+               TC_Float_Check_Failed := True;
+               exit;
+            end if;
+         end loop;
+
+         if TC_Discrete_Check_Failed then
+            Report.Failed("Discrete random values generated following use " &
+                          "of procedures Save and Reset were not the same");
+            TC_Discrete_Check_Failed := False;
+         end if;
+
+         if TC_Enum_Check_Failed then
+            Report.Failed("Enumeration random values generated following " &
+                          "use of procedures Save and Reset were not the " &
+                          "same");
+            TC_Enum_Check_Failed := False;
+         end if;
+
+         if TC_Float_Check_Failed then
+            Report.Failed("Float random values generated following use " &
+                          "of procedures Save and Reset were not the same");
+            TC_Float_Check_Failed := False;
+         end if;
+
+      end Objective_1;
+
+
+
+      Objective_2:
+         -- Check that the Function Image can be used to obtain a string
+         -- representation of the state of a generator.
+         -- Check that the Function Value will transform a string
+         -- representation of the state of a random number generator
+         -- into the actual state object.
+      begin
+
+         -- Use two discrete and float random number generators to generate
+         -- a series of values (so that the generators are no longer in their
+         -- initial states, and they have generated the same number of
+         -- random values).
+
+         TC_Seed := Integer(Discrete_Pack.Random(DGen_1));
+         Discrete_Pack.Reset(DGen_1, TC_Seed);
+         Discrete_Pack.Reset(DGen_2, TC_Seed);
+         Card_Pack.Reset    (EGen_1, TC_Seed);
+         Card_Pack.Reset    (EGen_2, TC_Seed);
+         Float_Random.Reset (FGen_1,  TC_Seed);
+         Float_Random.Reset (FGen_2,  TC_Seed);
+
+         for i in 1..1000 loop
+            DVal_1 := Discrete_Pack.Random(DGen_1);
+            DVal_2 := Discrete_Pack.Random(DGen_2);
+            EVal_1 := Card_Pack.Random(EGen_1);
+            EVal_2 := Card_Pack.Random(EGen_2);
+            FVal_1 := Float_Random.Random(FGen_1);
+            FVal_2 := Float_Random.Random(FGen_2);
+         end loop;
+
+         -- Use the Procedure Save to save the states of the generators
+         -- to state variables.
+
+         Discrete_Pack.Save(Gen => DGen_1, To_State => DState_1);
+         Discrete_Pack.Save(DGen_2, To_State => DState_2);
+         Card_Pack.Save    (Gen => EGen_1, To_State => EState_1);
+         Card_Pack.Save    (EGen_2, To_State => EState_2);
+         Float_Random.Save (FGen_1, To_State => FState_1);
+         Float_Random.Save (FGen_2, FState_2);
+
+         -- Use the Function Image to produce a representation of the state
+         -- codes as (bounded) string objects.
+
+         DString_1 := DString_Pack.To_Bounded_String(
+                        Discrete_Pack.Image(Of_State => DState_1));
+         DString_2 := DString_Pack.To_Bounded_String(
+                        Discrete_Pack.Image(DState_2));
+         EString_1 := EString_Pack.To_Bounded_String(
+                        Card_Pack.Image(Of_State => EState_1));
+         EString_2 := EString_Pack.To_Bounded_String(
+                        Card_Pack.Image(EState_2));
+         FString_1 := FString_Pack.To_Bounded_String(
+                        Float_Random.Image(Of_State => FState_1));
+         FString_2 := FString_Pack.To_Bounded_String(
+                        Float_Random.Image(FState_2));
+
+         -- Compare the bounded string objects for equality.
+
+         if DString_1 /= DString_2 then
+            Report.Failed("String values returned from Function Image " &
+                          "depict different states of Discrete generators");
+         end if;
+         if EString_1 /= EString_2 then
+            Report.Failed("String values returned from Function Image " &
+                          "depict different states of Enumeration "     &
+                          "generators");
+         end if;
+         if FString_1 /= FString_2 then
+            Report.Failed("String values returned from Function Image " &
+                          "depict different states of Float generators");
+         end if;
+
+         -- The string representation of a state code is transformed back
+         -- to a state code variable using the Function Value.
+
+         DState_1 := Discrete_Pack.Value(Coded_State =>
+                                          DString_Pack.To_String(DString_1));
+         EState_1 := Card_Pack.Value(EString_Pack.To_String(EString_1));
+         FState_1 := Float_Random.Value(FString_Pack.To_String(FString_1));
+
+         -- One of the (pair of each type of ) generators is used to generate
+         -- a series of random values, getting them "out of synch" with the
+         -- specific generation sequence of the other generators.
+
+         for i in 1..100 loop
+            DVal_1 := Discrete_Pack.Random(DGen_1);
+            EVal_1 := Card_Pack.Random(EGen_1);
+            FVal_1 := Float_Random.Random (FGen_1);
+         end loop;
+
+         -- The "out of synch" generators are reset to the previous state they
+         -- had when their states were saved, and they should now have the same
+         -- states as the generators that did not generate the values above.
+
+         Discrete_Pack.Reset(Gen => DGen_1, From_State => DState_1);
+         Card_Pack.Reset    (Gen => EGen_1, From_State => EState_1);
+         Float_Random.Reset (Gen => FGen_1, From_State => FState_1);
+
+         -- All generators should now be in the same state, so the
+         -- random values they produce should be the same.
+
+         for i in 1..1000 loop
+            if Discrete_Pack.Random(DGen_1) /= Discrete_Pack.Random(DGen_2)
+            then
+               TC_Discrete_Check_Failed := True;
+               exit;
+            end if;
+         end loop;
+
+         for i in 1..1000 loop
+            if Card_Pack.Random(EGen_1) /= Card_Pack.Random(EGen_2) then
+               TC_Enum_Check_Failed := True;
+               exit;
+            end if;
+         end loop;
+
+         for i in 1..1000 loop
+            if Float_Random.Random(FGen_1) /= Float_Random.Random(FGen_2)
+            then
+               TC_Float_Check_Failed := True;
+               exit;
+            end if;
+         end loop;
+
+         if TC_Discrete_Check_Failed then
+            Report.Failed("Random values generated following use of "     &
+                          "procedures Image and Value were not the same " &
+                          "for Discrete generator");
+         end if;
+         if TC_Enum_Check_Failed then
+            Report.Failed("Random values generated following use of "     &
+                          "procedures Image and Value were not the same " &
+                          "for Enumeration generator");
+         end if;
+         if TC_Float_Check_Failed then
+            Report.Failed("Random values generated following use of "     &
+                          "procedures Image and Value were not the same " &
+                          "for Float generator");
+         end if;
+
+      end Objective_2;
+
+
+
+      Objective_3:
+         -- Check that a call to Function Value, with a string value that is
+         -- not the image of any generator state, is a bounded error. This
+         -- error either raises Constraint_Error or Program_Error, or is
+         -- accepted. (See Technical Corrigendum 1).
+      declare
+         Not_A_State : constant String := ImpDef.Non_State_String;
+      begin
+
+         begin
+            DState_1 := Discrete_Pack.Value(Not_A_State);
+            if Not_A_State /= "**NONE**" then
+               Report.Failed("Exception not raised by Function " &
+                             "Ada.Numerics.Discrete_Random.Value when " &
+                             "provided a string input that does not "   &
+                             "represent the state of a random number "  &
+                             "generator");
+            else
+               Report.Comment("All strings represent states for Function " &
+                             "Ada.Numerics.Discrete_Random.Value");
+            end if;
+            Discrete_Pack.Reset(DGen_1, DState_1);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+               Report.Comment("Constraint_Error raised by Function " &
+                             "Ada.Numerics.Discrete_Random.Value when " &
+                             "provided a string input that does not "   &
+                             "represent the state of a random number "  &
+                             "generator");
+            when Program_Error => -- OK, expected exception.
+               Report.Comment("Program_Error raised by Function " &
+                             "Ada.Numerics.Discrete_Random.Value when " &
+                             "provided a string input that does not "   &
+                             "represent the state of a random number "  &
+                             "generator");
+            when others =>
+               Report.Failed("Unexpected exception raised by Function " &
+                             "Ada.Numerics.Discrete_Random.Value when " &
+                             "provided a string input that does not "   &
+                             "represent the state of a random number "  &
+                             "generator");
+         end;
+
+         begin
+            EState_1 := Card_Pack.Value(Not_A_State);
+            if Not_A_State /= "**NONE**" then
+               Report.Failed("Exception not raised by Function " &
+                             "Ada.Numerics.Discrete_Random.Value when " &
+                             "provided a string input that does not "   &
+                             "represent the state of an enumeration "   &
+                             "random number generator");
+            else
+               Report.Comment("All strings represent states for Function " &
+                             "Ada.Numerics.Discrete_Random.Value");
+            end if;
+            Card_Pack.Reset(EGen_1, EState_1);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when Program_Error => null; -- OK, expected exception.
+            when others =>
+               Report.Failed("Unexpected exception raised by Function " &
+                             "Ada.Numerics.Discrete_Random.Value when " &
+                             "provided a string input that does not "   &
+                             "represent the state of an enumeration "   &
+                             "random number generator");
+         end;
+
+         begin
+            FState_1 := Float_Random.Value(Not_A_State);
+            if Not_A_State /= "**NONE**" then
+               Report.Failed("Exception not raised by an "      &
+                             "instantiated version of "                &
+                             "Ada.Numerics.Float_Random.Value when "   &
+                             "provided a string input that does not "  &
+                             "represent the state of a random number " &
+                             "generator");
+            else
+               Report.Comment("All strings represent states for Function " &
+                             "Ada.Numerics.Float_Random.Value");
+            end if;
+            Float_Random.Reset(FGen_1, FState_1);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when Program_Error => null; -- OK, expected exception.
+            when others =>
+               Report.Failed("Unexpected exception raised by an "      &
+                             "instantiated version of "                &
+                             "Ada.Numerics.Float_Random.Value when "   &
+                             "provided a string input that does not "  &
+                             "represent the state of a random number " &
+                             "generator");
+         end;
+
+      end Objective_3;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5015.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5015.a
new file mode 100644
index 000000000..e1035db27
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5015.a
@@ -0,0 +1,342 @@
+-- CXA5015.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 following representation-oriented attributes are 
+--      available and that the produce correct results: 
+--      'Denorm, 'Signed_Zeros, 'Exponent 'Fraction, 'Compose, 'Scaling, 
+--      'Floor, 'Ceiling, 'Rounding, 'Unbiased_Rounding, 'Truncation, 
+--      'Remainder, 'Adjacent, 'Copy_Sign, 'Leading_Part, 'Machine, and 
+--      'Model_Small.
+--      
+-- TEST DESCRIPTION:
+--      This test checks whether certain attributes of floating point types
+--      are available from an implementation.  Where attribute correctness 
+--      can be verified in a straight forward manner, the appropriate checks 
+--      are included here.  However, this test is not intended to ensure the 
+--      correctness of the results returned from all of the attributes 
+--      examined in this test; that process will occur in the tests of the 
+--      Numerics_Annex. 
+--      
+--       
+-- CHANGE HISTORY:
+--      26 Jun 95   SAIC    Initial prerelease version.
+--      29 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      01 DEC 97   EDS     Fix value for checking the S'Adjacent attribute
+--!
+
+with Report;
+
+procedure CXA5015 is
+
+   subtype Float_Subtype   is Float range -10.0..10.0;
+   type    Derived_Float_1 is digits  8;
+   type    Derived_Float_2 is new Derived_Float_1 range -10.0..10.0E10;
+
+   use type Float, Float_Subtype, Derived_Float_1, Derived_Float_2;
+
+   TC_Boolean   : Boolean;
+   TC_Float     : Float;
+   TC_SFloat    : Float_Subtype;
+   TC_DFloat_1  : Derived_Float_1;
+   TC_DFloat_2  : Derived_Float_2;
+   TC_Tolerance : Float := 0.001;
+
+   function Not_Equal (Actual_Result, Expected_Result, Tolerance : Float)
+     return Boolean is
+   begin
+      return abs(Actual_Result - Expected_Result) > Tolerance;
+   end Not_Equal;
+
+
+begin
+
+   Report.Test ("CXA5015", "Check that certain representation-oriented " &
+                           "attributes are available and that they "     &
+                           "produce correct results");
+
+   -- New Representation-Oriented Attributes.
+   --
+   -- Check the S'Denorm attribute.
+
+   TC_Boolean := Float'Denorm;
+   TC_Boolean := Float_Subtype'Denorm;
+   TC_Boolean := Derived_Float_1'Denorm;
+   TC_Boolean := Derived_Float_2'Denorm;
+
+
+   -- Check the S'Signed_Zeroes attribute.
+
+   TC_Boolean := Float'Signed_Zeros;
+   TC_Boolean := Float_Subtype'Signed_Zeros;
+   TC_Boolean := Derived_Float_1'Signed_Zeros;
+   TC_Boolean := Derived_Float_2'Signed_Zeros;
+
+
+   -- New Primitive Function Attributes.
+   --
+   -- Check the S'Exponent attribute.
+
+   TC_Float    := 0.5;
+   TC_SFloat   := 0.99;
+   TC_DFloat_1 := 2.45;
+   TC_DFloat_2 := 2.65;
+
+   if Float'Exponent(TC_Float) > Float_Subtype'Exponent(TC_SFloat) or
+      Float'Exponent(TC_Float) > 2
+   then
+      Report.Failed("Incorrect result from the 'Exponent attribute");
+   end if;
+
+
+   -- Check the S'Fraction attribute.
+
+   if Not_Equal 
+        (Float'Fraction(TC_Float), 
+         TC_Float * Float(Float'Machine_Radix)**(-Float'Exponent(TC_Float)),
+         TC_Tolerance)
+   then
+      Report.Failed("Incorrect result from the 'Fraction attribute - 1");
+   end if;
+
+   if Float'Fraction(TC_Float) < 
+      (1.0/Float(Float'Machine_Radix)) - TC_Tolerance  or
+      Float'Fraction(TC_Float) >= 1.0 - TC_Tolerance    
+   then
+      Report.Failed("Incorrect result from the 'Fraction attribute - 2");
+   end if;
+
+
+   -- Check the S'Compose attribute.
+
+   if Not_Equal 
+       (Float'Compose(TC_Float, 3),
+        TC_Float * Float(Float'Machine_Radix)**(3-Float'Exponent(TC_Float)),
+        TC_Tolerance)
+   then
+      Report.Failed("Incorrect result from the 'Compose attribute");
+   end if;
+
+
+   -- Check the S'Scaling attribute.
+
+   if Not_Equal 
+        (Float'Scaling(TC_Float, 2),
+         TC_Float * Float(Float'Machine_Radix)**2,
+         TC_Tolerance)
+   then
+      Report.Failed("Incorrect result from the 'Scaling attribute");
+   end if;
+
+
+   -- Check the S'Floor attribute.
+
+   TC_Float    :=  0.99;
+   TC_SFloat   :=  1.00;
+   TC_DFloat_1 :=  2.50;
+   TC_DFloat_2 := -2.50;
+
+   if Float'Floor(TC_Float)               /=  0.0  or
+      Float_Subtype'Floor(TC_SFloat)      /=  1.0  or
+      Derived_Float_1'Floor(TC_DFloat_1)  /=  2.0  or
+      Derived_Float_2'Floor(TC_DFloat_2)  /= -3.0
+   then
+      Report.Failed("Incorrect result from the 'Floor attribute");
+   end if;
+
+
+   -- Check the S'Ceiling attribute.
+
+   TC_Float    :=  0.99;
+   TC_SFloat   :=  1.00;
+   TC_DFloat_1 :=  2.50;
+   TC_DFloat_2 := -2.99;
+
+   if Float'Ceiling(TC_Float)               /=  1.0  or
+      Float_Subtype'Ceiling(TC_SFloat)      /=  1.0  or
+      Derived_Float_1'Ceiling(TC_DFloat_1)  /=  3.0  or
+      Derived_Float_2'Ceiling(TC_DFloat_2)  /= -2.0
+   then
+      Report.Failed("Incorrect result from the 'Ceiling attribute");
+   end if;
+
+
+   -- Check the S'Rounding attribute.
+
+   TC_Float    :=  0.49;
+   TC_SFloat   :=  1.00;
+   TC_DFloat_1 :=  2.50;
+   TC_DFloat_2 := -2.50;
+
+   if Float'Rounding(TC_Float)               /=  0.0  or
+      Float_Subtype'Rounding(TC_SFloat)      /=  1.0  or
+      Derived_Float_1'Rounding(TC_DFloat_1)  /=  3.0  or
+      Derived_Float_2'Rounding(TC_DFloat_2)  /= -3.0
+   then
+      Report.Failed("Incorrect result from the 'Rounding attribute");
+   end if;
+
+
+   -- Check the S'Unbiased_Rounding attribute.
+
+   TC_Float    :=  0.50;
+   TC_SFloat   :=  1.50;
+   TC_DFloat_1 :=  2.50;
+   TC_DFloat_2 := -2.50;
+
+   if Float'Unbiased_Rounding(TC_Float)               /=  0.0  or
+      Float_Subtype'Unbiased_Rounding(TC_SFloat)      /=  2.0  or
+      Derived_Float_1'Unbiased_Rounding(TC_DFloat_1)  /=  2.0  or
+      Derived_Float_2'Unbiased_Rounding(TC_DFloat_2)  /= -2.0
+   then
+      Report.Failed("Incorrect result from the 'Unbiased_Rounding " &
+                    "attribute");
+   end if;
+
+
+   -- Check the S'Truncation attribute.
+
+   TC_Float    := -0.99;
+   TC_SFloat   :=  1.50;
+   TC_DFloat_1 :=  2.99;
+   TC_DFloat_2 := -2.50;
+
+   if Float'Truncation(TC_Float)               /=  0.0  or
+      Float_Subtype'Truncation(TC_SFloat)      /=  1.0  or
+      Derived_Float_1'Truncation(TC_DFloat_1)  /=  2.0  or
+      Derived_Float_2'Truncation(TC_DFloat_2)  /= -2.0
+   then
+      Report.Failed("Incorrect result from the 'Truncation attribute");
+   end if;
+
+
+   -- Check the S'Remainder attribute.
+
+   TC_Float    :=  9.0;
+   TC_SFloat   :=  7.5;
+   TC_DFloat_1 :=  5.0;
+   TC_DFloat_2 :=  8.0;
+
+   if Float'Remainder(TC_Float, 2.0)                /=  1.0  or
+      Float_Subtype'Remainder(TC_SFloat, 3.0)       /=  1.5  or
+      Derived_Float_1'Remainder(TC_DFloat_1, 2.0)   /=  1.0  or
+      Derived_Float_2'Remainder(TC_DFloat_2, 4.0)   /=  0.0
+   then
+      Report.Failed("Incorrect result from the 'Remainder attribute");
+   end if;
+
+
+   -- Check the S'Adjacent attribute.
+
+   TC_Float    :=  4.0;
+   TC_SFloat   := -1.0;
+
+   if Float'Adjacent(TC_Float, TC_Float)           /=  TC_Float  or
+      Float_Subtype'Adjacent(TC_SFloat, -1.0)      /=  TC_SFloat 
+   then
+      Report.Failed("Incorrect result from the 'Adjacent attribute");
+   end if;
+
+
+   -- Check the S'Copy_Sign attribute.
+
+   TC_Float    :=  0.0;
+   TC_SFloat   := -1.0;
+   TC_DFloat_1 :=  5.0;
+   TC_DFloat_2 := -2.5;
+
+   if Float'Copy_Sign(TC_Float, -2.0)               /=  0.0  or
+      Float_Subtype'Copy_Sign(TC_SFloat, 4.0)       /=  1.0  or
+      Derived_Float_1'Copy_Sign(TC_DFloat_1, -2.0)  /= -5.0  or
+      Derived_Float_2'Copy_Sign(TC_DFloat_2, -2.0)  /= -2.5
+   then
+      Report.Failed("Incorrect result from the 'Copy_Sign attribute");
+   end if;
+
+
+   -- Check the S'Leading_Part attribute.
+
+   TC_Float    :=  0.0;
+   TC_SFloat   := -1.0;
+   TC_DFloat_1 :=  5.88;
+   TC_DFloat_2 := -2.52;
+
+   -- Leading part obtained in the variables.
+   TC_Float    :=  Float'Leading_Part(TC_Float, 2);
+   TC_SFloat   :=  Float_Subtype'Leading_Part(TC_SFloat, 2);
+   TC_DFloat_1 :=  Derived_Float_1'Leading_Part(TC_DFloat_1, 2);
+   TC_DFloat_2 :=  Derived_Float_2'Leading_Part(TC_DFloat_2, 2);
+
+   -- Checking for the leading part of the variables at this point should
+   -- produce the same values.
+   if Float'Leading_Part(TC_Float, 2)              /= TC_Float    or
+      Float_Subtype'Leading_Part(TC_SFloat, 2)     /= TC_SFloat   or
+      Derived_Float_1'Leading_Part(TC_DFloat_1, 2) /= TC_DFloat_1 or
+      Derived_Float_2'Leading_Part(TC_DFloat_2, 2) /= TC_DFloat_2
+   then
+      Report.Failed("Incorrect result from the 'Leading_Part attribute");
+   end if;
+
+
+   -- Check the S'Machine attribute.
+
+   TC_Float    :=  0.0;
+   TC_SFloat   := -1.0;
+   TC_DFloat_1 :=  5.88;
+   TC_DFloat_2 := -2.52;
+
+   -- Closest machine number obtained in the variables.
+   TC_Float    :=  Float'Machine(TC_Float);
+   TC_SFloat   :=  Float_Subtype'Machine(TC_SFloat);
+   TC_DFloat_1 :=  Derived_Float_1'Machine(TC_DFloat_1);
+   TC_DFloat_2 :=  Derived_Float_2'Machine(TC_DFloat_2);
+
+   -- Checking for the closest machine number to each of the variables at 
+   -- this point should produce the same values.
+   if Float'Machine(TC_Float)              /= TC_Float    or
+      Float_Subtype'Machine(TC_SFloat)     /= TC_SFloat   or
+      Derived_Float_1'Machine(TC_DFloat_1) /= TC_DFloat_1 or
+      Derived_Float_2'Machine(TC_DFloat_2) /= TC_DFloat_2
+   then
+      Report.Failed("Incorrect result from the 'Machine attribute");
+   end if;
+
+
+   -- New Model-Oriented Attributes.
+   --
+   -- Check the S'Model_Small attribute.
+
+   if Not_Equal 
+        (Float'Model_Small,
+         Float(Float'Machine_Radix)**(Float'Model_Emin-1),
+         TC_Tolerance)
+   then
+      Report.Failed("Incorrect result from the 'Model_Small attribute");
+   end if;
+
+
+   Report.Result;
+
+end CXA5015;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a
new file mode 100644
index 000000000..12db5e7e1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a01.a
@@ -0,0 +1,338 @@
+-- CXA5A01.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 functions Sin and Sinh provide correct results.
+--
+-- TEST DESCRIPTION:
+--      This test examines both the version of Sin and Sinh resulting from
+--      the instantiation of the Ada.Numerics.Generic_Elementary_Functions 
+--      with a type derived from type Float, as well as the preinstantiated 
+--      version of this package for type Float.
+--      Prescribed results, as well as instances prescribed to raise 
+--      exceptions, are examined in the test cases.  In addition, 
+--      certain evaluations are performed where the actual function result 
+--      is compared with the expected result (within an epsilon range of 
+--      accuracy).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXA5A00.A   (foundation code)
+--         CXA5A01.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Mar 95   SAIC    Initial prerelease version.
+--      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
+--                          use of Result_Within_Range function overloaded for
+--                          FXA5A00.New_Float_Type.
+--      26 Jun 98   EDS     Protected exception tests by first testing
+--                          for 'Machine_Overflows
+--!
+
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Elementary_Functions;
+with FXA5A00;
+with Report;
+
+procedure CXA5A01 is
+begin
+
+   Report.Test ("CXA5A01", "Check that the functions Sin and Sinh provide " &
+                           "correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Numerics;
+      use FXA5A00;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
+      package  EF renames Ada.Numerics.Elementary_Functions;
+
+      The_Result       : Float;
+      New_Float_Result : New_Float;
+
+      procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
+      procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
+
+   begin
+
+      -- Testing of Sin Function, both instantiated and pre-instantiated
+      -- version.
+      
+      -- Check that no exception occurs on computing the Sin with very
+      -- large (positive and negative) input values.
+
+      begin 
+         New_Float_Result := GEF.Sin (New_Float(FXA5A00.Large));
+         Dont_Optimize_New_Float(New_Float_Result, 1);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on GEF.Sin with large " &
+                         "positive value");
+      end;
+
+      begin 
+         The_Result := EF.Sin (FXA5A00.Minus_Large);
+         Dont_Optimize_Float(The_Result, 2);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on GEF.Sin with large " &
+                         "negative value");
+      end;
+
+
+      -- Test of Sin for prescribed result at zero.
+
+      if GEF.Sin (0.0) /= 0.0 or
+          EF.Sin (0.0) /= 0.0
+      then
+         Report.Failed("Incorrect value returned from Sin(0.0)");
+      end if;
+
+
+      -- Test of Sin with expected result value between 0.0 and 1.0.
+
+      if not (GEF.Sin (Ada.Numerics.Pi/4.0) < 1.0)                    or
+         not ( EF.Sin (Ada.Numerics.Pi/4.0) < 1.0)                    or
+         not FXA5A00.Result_Within_Range(GEF.Sin(0.35), 0.343, 0.001) or
+         not FXA5A00.Result_Within_Range( EF.Sin(1.18), 0.924, 0.001)
+      then
+         Report.Failed("Incorrect value returned from Sin function when " &
+                       "the expected result is between 0.0 and 1.0");
+      end if;
+
+
+      -- Test of Sin with expected result value between -1.0 and 0.0.
+
+      if not (GEF.Sin (-Ada.Numerics.Pi/4.0) > -1.0)                    or
+         not ( EF.Sin (-Ada.Numerics.Pi/4.0) > -1.0)                    or
+         not FXA5A00.Result_Within_Range(GEF.Sin(-0.24), -0.238, 0.001) or
+         not FXA5A00.Result_Within_Range( EF.Sin(-1.00), -0.841, 0.001)
+      then
+         Report.Failed("Incorrect value returned from Sin function when " &
+                       "the expected result is between -1.0 and 0.0");
+      end if;
+
+
+      -- Testing of the Sin function with Cycle parameter.
+ 
+      -- Check that Argument_Error is raised when the value of the Cycle
+      -- parameter is zero.
+
+      begin 
+         New_Float_Result := GEF.Sin (X => 1.0, Cycle => 0.0);
+         Report.Failed("Argument_Error not raised by GEF.Sin function " &
+                       "when the Cycle parameter is zero");
+         Dont_Optimize_New_Float(New_Float_Result, 3);
+      exception
+         when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Unexpected exception raised by GEF.Sin function " &
+                          "when the Cycle parameter is zero");
+      end;
+
+      begin 
+         The_Result := EF.Sin (X => 0.34, Cycle => 0.0);
+         Report.Failed("Argument_Error not raised by EF.Sin function when " &
+                       "the Cycle parameter is zero");
+         Dont_Optimize_Float(The_Result, 4);
+      exception
+         when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Unexpected exception raised by EF.Sin function " &
+                          "when the Cycle parameter is zero");
+      end;
+
+      -- Check that Argument_Error is raised when the value of the Cycle
+      -- parameter is negative.
+
+      begin 
+         New_Float_Result := GEF.Sin (X => 0.45, Cycle => -1.0);
+         Report.Failed("Argument_Error not raised by GEF.Sin function " &
+                       "when the Cycle parameter is negative");
+         Dont_Optimize_New_Float(New_Float_Result, 5);
+      exception
+         when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Unexpected exception raised by GEF.Sin function " &
+                          "when the Cycle parameter is negative");
+      end;
+
+      begin 
+         The_Result := EF.Sin (X => 0.10, Cycle => -4.0);
+         Report.Failed("Argument_Error not raised by EF.Sin function when " &
+                       "the Cycle parameter is negative");
+         Dont_Optimize_Float(The_Result, 6);
+      exception
+         when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Unexpected exception raised by EF.Sin function " &
+                          "when the Cycle parameter is negative");
+      end;
+
+
+      -- Check that no exception occurs on computing the Sin with very
+      -- large (positive and negative) input values and Cycle parameter.
+
+      begin 
+         New_Float_Result := GEF.Sin (New_Float(FXA5A00.Large), 360.0);
+         Dont_Optimize_New_Float(New_Float_Result, 7);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on GEF.Sin with large " &
+                         "positive value and Cycle parameter");
+      end;
+
+      begin 
+         The_Result := EF.Sin (FXA5A00.Minus_Large, 720.0);
+         Dont_Optimize_Float(The_Result, 8);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on EF.Sin with large " &
+                         "negative value and Cycle parameter");
+      end;
+
+
+      -- Test of Sin with Cycle parameter for prescribed result at zero.
+
+      if GEF.Sin (0.0, 360.0) /= 0.0 or
+          EF.Sin (0.0, 180.0) /= 0.0
+      then
+         Report.Failed("Incorrect value returned from Sin function with " &
+                       "cycle parameter for a zero input parameter value");
+      end if;
+
+
+      -- Tests of Sin function with Cycle parameter for prescribed results.
+
+      if GEF.Sin(0.0,   360.0) /=  0.0 or 
+          EF.Sin(180.0, 360.0) /=  0.0 or
+         GEF.Sin(90.0,  360.0) /=  1.0 or 
+          EF.Sin(450.0, 360.0) /=  1.0 or 
+         GEF.Sin(270.0, 360.0) /= -1.0 or 
+          EF.Sin(630.0, 360.0) /= -1.0    
+      then
+         Report.Failed("Incorrect result from the Sin function with " &
+                       "various cycle values for prescribed results");
+      end if;
+
+
+      -- Testing of Sinh Function, both instantiated and pre-instantiated
+      -- version.
+      
+      -- Test for Constraint_Error on parameter with large positive magnitude.
+
+      begin
+
+         if New_Float'Machine_Overflows then
+            New_Float_Result := GEF.Sinh (New_Float(FXA5A00.Large));
+            Report.Failed("Constraint_Error not raised when the GEF.Sinh " &
+                          "function is provided a parameter with a large " &
+                          "positive value");
+            Dont_Optimize_New_Float(New_Float_Result, 9);
+         end if;
+
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Constraint_Error not raised when the GEF.Sinh " &
+                          "function is provided a parameter with a large " &
+                          "positive value");
+      end;
+
+      -- Test for Constraint_Error on parameter with large negative magnitude.
+
+      begin 
+
+         if Float'Machine_Overflows then
+            The_Result := EF.Sinh (FXA5A00.Minus_Large);
+            Report.Failed("Constraint_Error not raised when the EF.Sinh " &
+                          "function is provided a parameter with a "      &
+                          "large negative value");
+            Dont_Optimize_Float(The_Result, 10);
+         end if;
+
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Constraint_Error not raised when the EF.Sinh " &
+                          "function is provided a parameter with a "      &
+                          "large negative value");
+      end;
+
+
+      -- Test that no exception occurs when the Sinh function is provided a
+      -- very small positive or negative value.
+
+      begin 
+         New_Float_Result := GEF.Sinh (New_Float(FXA5A00.Small));
+         Dont_Optimize_New_Float(New_Float_Result, 11);
+      exception
+         when others =>
+            Report.Failed("Unexpected exception on GEF.Sinh with a very" &
+                          "small positive value");
+      end;
+
+      begin 
+         The_Result := EF.Sinh (-FXA5A00.Small);
+         Dont_Optimize_Float(The_Result, 12);
+      exception
+         when others =>
+            Report.Failed("Unexpected exception on EF.Sinh with a very" &
+                          "small negative value");
+      end;
+
+
+      -- Test for prescribed 0.0 result of Function Sinh with 0.0 parameter.
+
+      if GEF.Sinh (0.0) /= 0.0 or
+          EF.Sinh (0.0) /= 0.0
+      then
+         Report.Failed("Incorrect value returned from Sinh(0.0)");
+      end if;
+
+
+      -- Test of Sinh function with various input parameters.
+
+      if not FXA5A00.Result_Within_Range(GEF.Sinh(0.01),  0.010, 0.001) or
+         not FXA5A00.Result_Within_Range( EF.Sinh(0.61),  0.649, 0.001) or
+         not FXA5A00.Result_Within_Range(GEF.Sinh(1.70),  2.65,  0.01) or
+         not FXA5A00.Result_Within_Range( EF.Sinh(3.15), 11.65,  0.01) 
+      then 
+         Report.Failed("Incorrect result returned from Sinh function " &
+                       "with various input parameters");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a
new file mode 100644
index 000000000..9e6c575dd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a02.a
@@ -0,0 +1,328 @@
+-- CXA5A02.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 functions Cos and Cosh provide correct results.
+--
+-- TEST DESCRIPTION:
+--      This test examines both the version of Cos and Cosh resulting from
+--      the instantiation of the Ada.Numerics.Generic_Elementary_Functions
+--      with type derived from type Float, as well as the pre-instantiated 
+--      version of this package for type Float.
+--      Prescribed results, including instances prescribed to raise 
+--      exceptions, are examined in the test cases.  In addition, 
+--      certain evaluations are performed where the actual function result 
+--      is compared with the expected result (within an epsilon range of 
+--      accuracy).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXA5A00.A   (foundation code)
+--         CXA5A02.A
+--
+--
+-- CHANGE HISTORY:
+--      09 Mar 95   SAIC    Initial prerelease version.
+--      03 Apr 95   SAIC    Removed reference to derived type.
+--      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
+--                          use of Result_Within_Range function overloaded for
+--                          FXA5A00.New_Float_Type.
+--      28 Feb 97   PWB.CTA Removed checks specifying Cycle => 2.0 * Pi
+--      26 Jun 98   EDS     Protected exception checks by first testing
+--                          for 'Machine_Overflows.  Removed code deleted
+--                          by comment.
+-- CHANGE NOTE:
+--      According to Ken Dritz, author of the Numerics Annex of the RM,
+--      one should never specify the cycle 2.0*Pi for the trigonometric
+--      functions.  In particular, if the machine number for the first
+--      argument is not an exact multiple of the machine number for the
+--      explicit cycle, then the specified exact results cannot be
+--      reasonably expected.  The affected checks have been deleted.
+--!
+
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Elementary_Functions;
+with FXA5A00;
+with Report;
+
+procedure CXA5A02 is
+begin
+
+   Report.Test ("CXA5A02", "Check that the functions Cos and Cosh provide " &
+                           "correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Numerics;
+      use FXA5A00;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
+      package  EF renames Ada.Numerics.Elementary_Functions;
+
+      The_Result       : Float;
+      New_Float_Result : New_Float;
+
+      procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
+      procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
+
+   begin
+
+      -- Testing of Cos Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that no exception occurs on computing the Cos with very
+      -- large (positive and negative) input values.
+
+      begin 
+         New_Float_Result := GEF.Cos (New_Float(FXA5A00.Large));
+         Dont_Optimize_New_Float(New_Float_Result, 1);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on GEF.Cos with large " &
+                         "positive value");
+      end;
+
+      begin 
+         The_Result := EF.Cos (FXA5A00.Minus_Large);
+         Dont_Optimize_Float(The_Result, 2);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on GEF.Cos with large " &
+                         "negative value");
+      end;
+
+
+      -- Test of Cos for prescribed result at zero.
+
+      if GEF.Cos (0.0) /= 1.0 or
+          EF.Cos (0.0) /= 1.0
+      then
+         Report.Failed("Incorrect value returned from Cos(0.0)");
+      end if;
+
+
+      -- Test of Cos with expected result value between 1.0 and -1.0.
+
+      if not (Result_Within_Range( EF.Cos(Ada.Numerics.Pi/3.0),
+                                          0.500, 
+                                          0.001)                       and
+              Result_Within_Range(GEF.Cos(0.6166), 0.816, 0.001)       and
+              Result_Within_Range(GEF.Cos(0.1949), 0.981, 0.001)       and
+              Result_Within_Range( EF.Cos(Ada.Numerics.Pi/2.0),
+                                          0.00,
+                                          0.001)                       and
+              Result_Within_Range( EF.Cos(2.0*Ada.Numerics.Pi/3.0),
+                                          -0.500,
+                                          0.001)                       and
+              Result_Within_Range(GEF.Cos(New_Float(Ada.Numerics.Pi)),
+                                          -1.00,
+                                           0.001))
+      then
+         Report.Failed("Incorrect value returned from Cos function when " &
+                       "the expected result is between 1.0 and -1.0");
+      end if;
+
+
+      -- Testing of the Cos function with Cycle parameter.
+
+      -- Check that Argument_Error is raised when the value of the Cycle
+      -- parameter is zero.
+
+      begin 
+         New_Float_Result := GEF.Cos (X => 1.0, Cycle => 0.0);
+         Report.Failed("Argument_Error not raised by GEF.Cos function " &
+                       "when the Cycle parameter is zero");
+         Dont_Optimize_New_Float(New_Float_Result, 3);
+      exception
+         when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Unexpected exception raised by GEF.cos function " &
+                          "when the Cycle parameter is zero");
+      end;
+
+      begin 
+         The_Result := EF.Cos (X => 0.55, Cycle => 0.0);
+         Report.Failed("Argument_Error not raised by EF.Cos function when " &
+                       "the Cycle parameter is zero");
+         Dont_Optimize_Float(The_Result, 4);
+      exception
+         when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Unexpected exception raised by EF.Cos function " &
+                          "when the Cycle parameter is zero");
+      end;
+
+      -- Check that Argument_Error is raised when the value of the Cycle
+      -- parameter is negative.
+
+      begin 
+         New_Float_Result := GEF.Cos (X => 0.45, Cycle => -2.0*Pi);
+         Report.Failed("Argument_Error not raised by GEF.Cos function " &
+                       "when the Cycle parameter is negative");
+         Dont_Optimize_New_Float(New_Float_Result, 5);
+      exception
+         when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Unexpected exception raised by GEF.Cos function " &
+                          "when the Cycle parameter is negative");
+      end;
+
+      begin 
+         The_Result := EF.Cos (X => 0.10, Cycle => -Pi/2.0);
+         Report.Failed("Argument_Error not raised by EF.Cos function when " &
+                       "the Cycle parameter is negative");
+         Dont_Optimize_Float(The_Result, 6);
+      exception
+         when Ada.Numerics.Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Unexpected exception raised by EF.Cos function " &
+                          "when the Cycle parameter is negative");
+      end;
+
+      -- Test of Cos with Cycle parameter for prescribed result at zero.
+
+      if GEF.Cos (0.0, 360.0) /= 1.0 or
+          EF.Cos (0.0, 360.0) /= 1.0
+      then
+         Report.Failed("Incorrect value returned from Cos function with " &
+                       "cycle parameter for a zero input parameter value");
+      end if;
+
+
+      -- Tests of Cos function with specified Cycle, using various input
+      -- parameter values for prescribed results.
+
+      if GEF.Cos(0.0,   360.0) /=  1.0 or 
+          EF.Cos(360.0, 360.0) /=  1.0 or 
+         GEF.Cos(90.0,  360.0) /=  0.0 or 
+          EF.Cos(270.0, 360.0) /=  0.0 or 
+         GEF.Cos(180.0, 360.0) /= -1.0 or 
+          EF.Cos(540.0, 360.0) /= -1.0    
+      then
+         Report.Failed("Incorrect result from the Cos function with " &
+                       "specified cycle for prescribed results");
+      end if;
+
+
+
+      -- Testing of Cosh Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Test for Constraint_Error on parameter with large positive magnitude.
+
+      begin
+
+         if New_Float'Machine_Overflows then
+
+            New_Float_Result := GEF.Cosh (New_Float(FXA5A00.Large));
+            Report.Failed("Constraint_Error not raised when the GEF.Cosh " &
+                          "function is provided a parameter with a large " &
+                          "positive value");
+            Dont_Optimize_New_Float(New_Float_Result, 9);
+         end if;
+
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Constraint_Error not raised when the GEF.Cosh " &
+                          "function is provided a parameter with a large " &
+                          "positive value");
+      end;
+
+      -- Test for Constraint_Error on parameter with large negative magnitude.
+
+      begin
+
+         if Float'Machine_Overflows then
+            The_Result := EF.Cosh (FXA5A00.Minus_Large);
+            Report.Failed("Constraint_Error not raised when the EF.Cosh " &
+                          "function is provided a parameter with a "      &
+                          "large negative value");
+            Dont_Optimize_Float(The_Result, 10);
+         end if;
+
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Constraint_Error not raised when the EF.Cosh " &
+                          "function is provided a parameter with a "      &
+                          "large negative value");
+      end;
+
+
+      -- Test that no exception occurs when the Cosh function is provided a
+      -- very small positive or negative value.
+
+      begin 
+         New_Float_Result := GEF.Cosh (New_Float(FXA5A00.Small));
+         Dont_Optimize_New_Float(New_Float_Result, 11);
+      exception
+         when others =>
+            Report.Failed("Unexpected exception on GEF.Cosh with a very" &
+                          "small positive value");
+      end;
+
+      begin 
+         The_Result := EF.Cosh (-FXA5A00.Small);
+         Dont_Optimize_Float(The_Result, 12);
+      exception
+         when others =>
+            Report.Failed("Unexpected exception on EF.Cosh with a very" &
+                          "small negative value");
+      end;
+
+
+      -- Test for prescribed 1.0 result of Function Cosh with 0.0 parameter.
+
+      if GEF.Cosh (0.0) /= 1.0 or
+          EF.Cosh (0.0) /= 1.0
+      then
+         Report.Failed("Incorrect value returned from Cosh(0.0)");
+      end if;
+
+
+      -- Test of Cosh function with various input parameters.
+
+      if not FXA5A00.Result_Within_Range(GEF.Cosh(0.24), 1.029, 0.001) or
+         not FXA5A00.Result_Within_Range( EF.Cosh(0.59), 1.179, 0.001) or
+         not FXA5A00.Result_Within_Range(GEF.Cosh(1.06), 1.616, 0.001) or
+         not FXA5A00.Result_Within_Range( EF.Cosh(1.50), 2.352, 0.001) or
+         not FXA5A00.Result_Within_Range(GEF.Cosh(1.84), 3.228, 0.001) or
+         not FXA5A00.Result_Within_Range( EF.Cosh(3.40), 14.99, 0.01) 
+      then
+         Report.Failed("Incorrect result from Cosh function with " &
+                       "various input parameters");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a
new file mode 100644
index 000000000..d99ba9bdc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a03.a
@@ -0,0 +1,426 @@
+-- CXA5A03.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 functions Tan, Tanh, and Arctanh provide correct 
+--      results.
+--
+-- TEST DESCRIPTION:
+--      This test examines both the version of Tan, Tanh, and Arctanh 
+--      the instantiation of the Ada.Numerics.Generic_Elementary_Functions 
+--      with a type derived from type Float, as well as the preinstantiated 
+--      version of this package for type Float.
+--      Prescribed results, including instances prescribed to raise 
+--      exceptions, are examined in the test cases.  In addition, 
+--      certain evaluations are performed where the actual function result 
+--      is compared with the expected result (within an epsilon range of 
+--      accuracy).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXA5A00.A   (foundation code)
+--         CXA5A03.A
+--
+--
+-- CHANGE HISTORY:
+--      14 Mar 95   SAIC    Initial prerelease version.
+--      06 Apr 95   SAIC    Corrected errors in context clause references
+--                          and usage of Cycle parameter.
+--      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
+--                          use of Result_Within_Range function overloaded for
+--                          FXA5A00.New_Float_Type.
+--      29 Jun 98   EDS     Protected exception tests by first testing
+--                          for 'Machine_Overflows
+--
+--!
+
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Elementary_Functions;
+with FXA5A00;
+with Report;
+
+procedure CXA5A03 is
+begin
+
+   Report.Test ("CXA5A03", "Check that the functions Tan, Tanh, and " &
+                           "Arctanh provide correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Numerics;
+      use FXA5A00;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
+      package  EF renames Ada.Numerics.Elementary_Functions;
+
+      The_Result       : Float;
+      New_Float_Result : New_Float;
+
+      procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
+      procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
+
+   begin
+
+      -- Testing of Tan Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that no exception occurs on computing the Tan with very
+      -- large (positive and negative) input values.
+
+      begin 
+         New_Float_Result := GEF.Tan (New_Float(FXA5A00.Large));
+         Dont_Optimize_New_Float(New_Float_Result, 1);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on GEF.Tan with large " &
+                         "positive value");
+      end;
+
+      begin 
+         The_Result := EF.Tan (FXA5A00.Minus_Large);
+         Dont_Optimize_Float(The_Result, 2);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on EF.Tan with large " &
+                         "negative value");
+      end;
+
+
+      -- Check that no exception occurs on computing the Tan with very
+      -- small (positive and negative) input values.
+
+      begin 
+         New_Float_Result := GEF.Tan (New_Float(FXA5A00.Small));
+         Dont_Optimize_New_Float(New_Float_Result, 3);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on GEF.Tan with small " &
+                         "positive value");
+      end;
+
+      begin 
+         The_Result := EF.Tan (-FXA5A00.Small);
+         Dont_Optimize_Float(The_Result, 4);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on EF.Tan with small " &
+                         "negative value");
+      end;
+
+
+      -- Check prescribed result from Tan function.  When the parameter X 
+      -- has the value zero, the Tan function yields a result of zero.
+
+      if GEF.Tan(0.0) /= 0.0 or
+          EF.Tan(0.0) /= 0.0 
+      then
+         Report.Failed("Incorrect result from Tan function with zero " &
+                       "value input parameter");
+      end if;
+
+ 
+      -- Check the results of the Tan function with various input parameters.
+
+      if not (Result_Within_Range(GEF.Tan(0.7854), 1.0,   0.001)  and
+              Result_Within_Range(GEF.Tan(0.8436), 1.124, 0.001)  and
+              Result_Within_Range( EF.Tan(Pi),     0.0,   0.001)  and
+              Result_Within_Range( EF.Tan(-Pi),    0.0,   0.001)  and 
+              Result_Within_Range(GEF.Tan(0.5381), 0.597, 0.001)  and
+              Result_Within_Range( EF.Tan(0.1978), 0.200, 0.001))
+      then
+         Report.Failed("Incorrect result from Tan function with various " &
+                       "input parameters");
+      end if;
+
+ 
+      -- Testing of Tan function with cycle parameter.
+
+      -- Check that Constraint_Error is raised by the Tan function with 
+      -- specified cycle, when the value of the parameter X is an odd
+      -- multiple of the quarter cycle.
+
+      if New_Float'Machine_Overflows = True then
+         begin
+            New_Float_Result := GEF.Tan(270.0, 360.0);                  
+            Report.Failed("Constraint_Error not raised by GEF.Tan on odd " &
+                          "multiple of the quarter cycle");
+            Dont_Optimize_New_Float(New_Float_Result, 5);
+         exception
+            when Constraint_Error => null; -- OK, expected exception.
+            when others =>
+            Report.Failed("Unexpected exception raised by GEF.Tan on odd " &
+                          "multiple of the quarter cycle");
+         end;
+      end if;
+
+      -- Check that the exception Numerics.Argument_Error is raised, when
+      -- the value of the parameter Cycle is zero or negative.
+
+      begin
+         New_Float_Result := GEF.Tan(X => 1.0, Cycle => -360.0);
+         Report.Failed("Argument_Error not raised by GEF.Tan when Cycle " &
+                       "parameter has negative value");
+         Dont_Optimize_New_Float(New_Float_Result, 6);
+      exception
+         when Argument_Error => null; -- OK, expected exception.
+         when others =>
+         Report.Failed("Unexpected exception raised by GEF.Tan when Cycle " &
+                       "parameter has negative value");
+      end;
+
+      begin
+         The_Result := EF.Tan(1.0, Cycle => 0.0);                 
+         Report.Failed("Argument_Error not raised by GEF.Tan when Cycle " &
+                       "parameter has a zero value");
+         Dont_Optimize_Float(The_Result, 7);
+      exception
+         when Argument_Error => null; -- OK, expected exception.
+         when others =>
+         Report.Failed("Unexpected exception raised by EF.Tan when Cycle " &
+                       "parameter has a zero value");
+      end;
+
+
+      -- Check that no exception occurs on computing the Tan with very
+      -- large (positive and negative) input values.
+
+      begin 
+         New_Float_Result := GEF.Tan (New_Float(FXA5A00.Large), 360.0);
+         Dont_Optimize_New_Float(New_Float_Result, 8);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on GEF.Tan with large " &
+                         "positive value");
+      end;
+
+      begin 
+         The_Result := EF.Tan (FXA5A00.Minus_Large, Cycle => 360.0);
+         Dont_Optimize_Float(The_Result, 9);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on EF.Tan with large " &
+                         "negative value");
+      end;
+
+
+      -- Check prescribed result from Tan function with Cycle parameter.  
+
+      if GEF.Tan(0.0, 360.0)          /= 0.0 or
+          EF.Tan(0.0, Cycle => 360.0) /= 0.0 
+      then
+         Report.Failed("Incorrect result from Tan function with cycle " &
+                       "parameter, using a zero value input parameter");
+      end if;
+
+
+      -- Check the Tan function, with specified Cycle parameter, with a 
+      -- variety of input parameters.
+
+      if not Result_Within_Range(GEF.Tan(30.0,  360.0),  0.577, 0.001) or 
+         not Result_Within_Range( EF.Tan(57.0,  360.0),  1.540, 0.001) or 
+         not Result_Within_Range(GEF.Tan(115.0, 360.0), -2.145, 0.001) or 
+         not Result_Within_Range( EF.Tan(299.0, 360.0), -1.804, 0.001) or 
+         not Result_Within_Range(GEF.Tan(390.0, 360.0),  0.577, 0.001) or 
+         not Result_Within_Range( EF.Tan(520.0, 360.0), -0.364, 0.001)
+      then
+         Report.Failed("Incorrect result from the Tan function with "   &
+                       "cycle parameter, with various input parameter " &
+                       "values");
+      end if;
+
+      
+
+      -- Testing of Tanh Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that no exception occurs on computing the Tan with very
+      -- large (positive and negative) input values.
+
+      begin 
+         New_Float_Result := GEF.Tanh (New_Float(FXA5A00.Large));
+         Dont_Optimize_New_Float(New_Float_Result, 10);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on GEF.Tanh with large " &
+                         "positive value");
+      end;
+
+      begin 
+         The_Result := EF.Tanh (FXA5A00.Minus_Large);
+         Dont_Optimize_Float(The_Result, 11);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on EF.Tanh with large " &
+                         "negative value");
+      end;
+
+
+      -- Check for prescribed result of Tanh with zero value input parameter.   
+
+      if GEF.Tanh (0.0) /= 0.0 or
+          EF.Tanh (0.0) /= 0.0
+      then 
+         Report.Failed("Incorrect result from Tanh with zero parameter");
+      end if;
+
+
+      -- Check the results of the Tanh function with various input 
+      -- parameters.
+
+      if not (FXA5A00.Result_Within_Range(GEF.Tanh(2.99),   0.995, 0.001)  and
+              FXA5A00.Result_Within_Range(GEF.Tanh(0.130),  0.129, 0.001)  and
+              FXA5A00.Result_Within_Range( EF.Tanh(Pi),     0.996, 0.001)  and
+              FXA5A00.Result_Within_Range( EF.Tanh(-Pi),   -0.996, 0.001)  and
+              FXA5A00.Result_Within_Range(GEF.Tanh(0.60),   0.537, 0.001)  and
+              FXA5A00.Result_Within_Range( EF.Tanh(1.04),   0.778, 0.001)  and
+              FXA5A00.Result_Within_Range(GEF.Tanh(1.55),   0.914, 0.001)  and
+              FXA5A00.Result_Within_Range( EF.Tanh(-2.14), -0.973, 0.001))
+      then
+         Report.Failed("Incorrect result from Tanh function with various " &
+                       "input parameters");
+      end if;
+
+ 
+
+      -- Testing of Arctanh Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that Constraint_Error is raised by the Arctanh function
+      -- when the absolute value of the parameter X is one.
+
+      if New_Float'Machine_Overflows = True then
+         begin
+            New_Float_Result := GEF.Arctanh(X =>  1.0);
+            Report.Failed("Constraint_Error not raised by Function Arctanh " &
+                          "when provided a parameter value of 1.0");
+            Dont_Optimize_New_Float(New_Float_Result, 12);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by Function Arctanh "
+                             & "when provided a parameter value of 1.0");
+         end;
+      end if;
+
+      if Float'Machine_Overflows = True then
+         begin
+            The_Result := EF.Arctanh(-1.0);
+            Report.Failed("Constraint_Error not raised by Function Arctanh " &
+                          "when provided a parameter value of -1.0");
+            Dont_Optimize_Float(The_Result, 13);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by Function Arctanh "
+                             & "when provided a parameter value of -1.0");
+         end;
+      end if;
+
+      -- Check that Function Arctanh raises Argument_Error when the absolute
+      -- value of the parameter X exceeds one.
+
+      begin
+         New_Float_Result := GEF.Arctanh(New_Float(FXA5A00.One_Plus_Delta));
+         Report.Failed("Argument_Error not raised by Function Arctanh " &
+                       "when provided a parameter value greater than 1.0");
+         Dont_Optimize_New_Float(New_Float_Result, 14);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Unexpected exception raised by Function Arctanh " &
+                          "when provided a parameter value greater than 1.0");
+      end;
+
+ 
+      begin
+         The_Result := EF.Arctanh(FXA5A00.Minus_One_Minus_Delta);
+         Report.Failed("Argument_Error not raised by Function Arctanh " &
+                       "when provided a parameter value less than -1.0");
+         Dont_Optimize_Float(The_Result, 15);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Unexpected exception raised by Function Arctanh " &
+                          "when provided a parameter value less than -1.0");
+      end;
+
+
+      begin
+         New_Float_Result := GEF.Arctanh(New_Float(FXA5A00.Large));
+         Report.Failed("Argument_Error not raised by Function Arctanh " &
+                       "when provided a large positive parameter value");
+         Dont_Optimize_New_Float(New_Float_Result, 16);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Unexpected exception raised by Function Arctanh " &
+                          "when provided a large positive parameter value");
+      end;
+
+ 
+      begin
+         The_Result := EF.Arctanh(FXA5A00.Minus_Large);
+         Report.Failed("Argument_Error not raised by Function Arctanh " &
+                       "when provided a large negative parameter value");
+         Dont_Optimize_Float(The_Result, 17);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Unexpected exception raised by Function Arctanh " &
+                          "when provided a large negative parameter value");
+      end;
+
+
+      -- Prescribed results for Function Arctanh with zero input value.
+
+      if GEF.Arctanh(0.0) /= 0.0 or
+          EF.Arctanh(0.0) /= 0.0
+      then
+         Report.Failed("Incorrect result from Function Arctanh with a " &
+                       "parameter value of zero");
+      end if;
+
+ 
+      -- Check the results of the Arctanh function with various input 
+      -- parameters.
+
+      if not (Result_Within_Range(GEF.Arctanh(0.15), 0.151, 0.001)  and
+              Result_Within_Range( EF.Arctanh(0.44), 0.472, 0.001)  and
+              Result_Within_Range(GEF.Arctanh(0.81), 1.127, 0.001)  and
+              Result_Within_Range( EF.Arctanh(0.99), 2.647, 0.001))
+      then
+         Report.Failed("Incorrect result from Arctanh function with " &
+                       "various input parameters");
+      end if;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5A03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a
new file mode 100644
index 000000000..9b590a23c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a04.a
@@ -0,0 +1,434 @@
+-- CXA5A04.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 functions Cot, Coth, and Arccoth provide correct 
+--      results.
+--
+-- TEST DESCRIPTION:
+--      This test examines both the version of Cot, Coth, and Arccoth 
+--      the instantiation of the Ada.Numerics.Generic_Elementary_Functions 
+--      with a type derived from type Float, as well as the preinstantiated 
+--      version of this package for type Float.
+--      Prescribed results, including instances prescribed to raise 
+--      exceptions, are examined in the test cases.  In addition, 
+--      certain evaluations are performed where the actual function result 
+--      is compared with the expected result (within an epsilon range of 
+--      accuracy).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXA5A00.A   (foundation code)
+--         CXA5A04.A
+--
+--
+-- CHANGE HISTORY:
+--      15 Mar 95   SAIC    Initial prerelease version.
+--      07 Apr 95   SAIC    Corrected errors in context clause reference, 
+--                          added trigonometric relationship checks.
+--      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
+--                          use of Result_Within_Range function overloaded for
+--                          FXA5A00.New_Float_Type.
+--      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      28 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
+--      29 Jun 98   EDS     Protected exception tests by first testing
+--                          for 'Machine_Overflows
+--
+-- CHANGE NOTE:
+--      According to Ken Dritz, author of the Numerics Annex of the RM,
+--      one should never specify the cycle 2.0*Pi for the trigonometric
+--      functions.  In particular, if the machine number for the first
+--      argument is not an exact multiple of the machine number for the
+--      explicit cycle, then the specified exact results cannot be
+--      reasonably expected.  The affected checks in this test have been
+--      marked as comments, with the additional notation "pwb-math".
+--      Phil Brashear
+--!
+
+with Ada.Exceptions;
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Elementary_Functions;
+with FXA5A00;
+with Report;
+
+procedure CXA5A04 is
+begin
+
+   Report.Test ("CXA5A04", "Check that the functions Cot, Coth, and " &
+                           "Arccoth provide correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+      use Ada.Numerics;
+      use FXA5A00;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
+      package  EF renames Ada.Numerics.Elementary_Functions;
+
+      The_Result       : Float;
+      New_Float_Result : New_Float;
+
+      procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
+      procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
+
+   begin
+
+      -- Testing of Cot Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that Constraint_Error is raised with the Cot function is
+      -- given a parameter input value of 0.0.
+
+      if New_Float'Machine_Overflows = True then
+         begin
+            New_Float_Result := GEF.Cot (0.0);
+            Report.Failed("Constraint_Error not raised by Function Cot " &
+                          "when provided a zero input parameter value");
+            Dont_Optimize_New_Float(New_Float_Result, 1);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           => 
+            Report.Failed("Unexpected exception raised by Function Cot " &
+                          "when provided a zero input parameter value");
+         end;
+      end if;
+
+      -- Check that no exception occurs on computing the Cot with very
+      -- large (positive and negative) input values.
+
+      begin 
+         New_Float_Result := GEF.Cot (New_Float(FXA5A00.Large));
+         Dont_Optimize_New_Float(New_Float_Result, 2);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on GEF.Cot with large " &
+                         "positive value");
+      end;
+
+      begin 
+         The_Result := EF.Cot (FXA5A00.Minus_Large);
+         Dont_Optimize_Float(The_Result, 3);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on EF.Cot with large " &
+                         "negative value");
+      end;
+
+
+      -- Check the results of the Cot function with various input parameters.
+
+      if not (FXA5A00.Result_Within_Range(GEF.Cot(Pi/4.0),     1.0, 0.001) and
+              FXA5A00.Result_Within_Range( EF.Cot(Pi/2.0),     0.0, 0.001) and
+              FXA5A00.Result_Within_Range(GEF.Cot(3.0*Pi/4.0),-1.0, 0.001) and
+              FXA5A00.Result_Within_Range( EF.Cot(3.0*Pi/2.0), 0.0, 0.001))
+      then
+         Report.Failed("Incorrect result from Cot function with various " &
+                       "input parameters");
+      end if;
+
+ 
+      -- Check the results of the Cot function against the results of 
+      -- various trigonometric relationships.
+
+      if not FXA5A00.Result_Within_Range(GEF.Cot(New_Float(Pi/4.0)),
+                                         1.0/EF.Tan(Pi/4.0),
+                                         0.001)           or
+         not FXA5A00.Result_Within_Range(EF.Cot(Pi/4.0),
+                                         EF.Cos(Pi/4.0)/EF.Sin(Pi/4.0),
+                                         0.001) or
+         not FXA5A00.Result_Within_Range(EF.Cot(EF.Arccot(Pi/4.0)),
+                                         Pi/4.0,
+                                         0.001) 
+      then
+         Report.Failed("Incorrect result from Cot function with respect " &
+                       "to various trigonometric relationship expected "  &
+                       "results");
+      end if;
+
+
+      -- Testing of Cot with Cycle parameter.
+
+      -- Check that Argument_Error is raised by the Cot function when the
+      -- value of the Cycle parameter is zero or negative.
+
+      begin
+         New_Float_Result := GEF.Cot (1.0, Cycle => 0.0);
+         Report.Failed("Argument_Error not raised by the Cot Function " &
+                       "with a specified cycle value of 0.0");
+         Dont_Optimize_New_Float(New_Float_Result, 4);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed
+              ("Unexpected exception raised by the Cot Function with " &
+               "a specified cycle value of 0.0");
+      end;
+
+      begin
+         The_Result := EF.Cot (X => 1.0, Cycle => -360.0);
+         Report.Failed("Argument_Error not raised by the Cot Function " &
+                       "with a specified cycle value of -360.0");
+         Dont_Optimize_Float(The_Result, 5);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed
+              ("Unexpected exception raised by the Cot Function with " &
+               "a specified cycle value of -360.0");
+      end;
+
+
+      -- Check that Constraint_Error is raised by the Cot Function with
+      -- specified cycle, when the value of the parameter X is 0.0.
+
+      if New_Float'Machine_Overflows = True then
+         begin
+            New_Float_Result := GEF.Cot (0.0, 360.0);
+            Report.Failed("Constraint_Error not raised by Function Cot "   &
+                          "with specified cycle, when value of parameter " &
+                          "X is 0.0");
+            Dont_Optimize_New_Float(New_Float_Result, 6);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by Function Cot "   &
+                             "with specified cycle, when value of parameter " &
+                             "X is 0.0");
+         end;
+      end if;
+
+      -- Check that Constraint_Error is raised by the Cot Function with
+      -- specified cycle, when the value of the parameter X is a multiple
+      -- of the half cycle.
+
+      if New_Float'Machine_Overflows = True then
+         begin
+            New_Float_Result := GEF.Cot (180.0, 360.0);
+            Report.Failed("Constraint_Error not raised by Function Cot "   &
+                          "with specified cycle, when value of parameter " &
+                          "X is a multiple of the half cycle (180.0, 360.0)");
+            Dont_Optimize_New_Float(New_Float_Result, 7);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by Function Cot "   &
+                             "with specified cycle, when value of parameter " &
+                             "X is a multiple of the half cycle" & 
+                             " (180.0, 360.0)");
+         end;
+      end if;
+
+      if Float'Machine_Overflows = True then
+         begin
+            The_Result := EF.Cot (540.0, 360.0);
+            Report.Failed("Constraint_Error not raised by Function Cot "   &
+                          "with specified cycle, when value of parameter " &
+                          "X is a multiple of the half cycle (540.0, 360.0)");
+            Dont_Optimize_Float(The_Result, 8);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by Function Cot "   &
+                             "with specified cycle, when value of parameter " &
+                             "X is a multiple of the half cycle (540.0, 360.0)");
+         end;
+      end if;      
+      
+--pwb-math      -- Check that no exception occurs on computing the Cot with very
+--pwb-math      -- large (positive and negative) input values.
+--pwb-math
+--pwb-math      begin 
+--pwb-math         New_Float_Result := GEF.Cot (New_Float(FXA5A00.Large), 2.0*Pi);
+--pwb-math         Dont_Optimize_New_Float(New_Float_Result, 9);
+--pwb-math      exception
+--pwb-math         when others =>
+--pwb-math           Report.Failed("Unexpected exception on GEF.Cot with large " &
+--pwb-math                         "positive value");
+--pwb-math      end;
+--pwb-math
+--pwb-math      begin 
+--pwb-math         The_Result := EF.Cot (FXA5A00.Minus_Large, Cycle => 2.0*Pi);
+--pwb-math         Dont_Optimize_Float(The_Result, 10);
+--pwb-math      exception
+--pwb-math         when others =>
+--pwb-math           Report.Failed("Unexpected exception on EF.Cot with large " &
+--pwb-math                         "negative value");
+--pwb-math      end;
+--pwb-math
+--pwb-math
+--pwb-math      -- Check prescribed result from Cot function with Cycle parameter.  
+--pwb-math
+--pwb-math      if not FXA5A00.Result_Within_Range
+--pwb-math               (GEF.Cot(New_Float(FXA5A00.Half_Pi), 2.0*Pi), 0.0, 0.001) or
+--pwb-math         not FXA5A00.Result_Within_Range
+--pwb-math               (EF.Cot(3.0*Pi/2.0, Cycle => 2.0*Pi), 0.0, 0.001)
+--pwb-math      then
+--pwb-math         Report.Failed("Incorrect result from Cot function with cycle " &
+--pwb-math                       "parameter, using a multiple of Pi/2 as the "    &
+--pwb-math                       "input parameter");
+--pwb-math      end if;
+
+
+      -- Testing of Coth Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that no exception occurs on computing the Coth with very
+      -- large (positive and negative) input values.
+
+      begin 
+         The_Result := EF.Coth (FXA5A00.Large);
+         if The_Result > 1.0 then
+            Report.Failed("Result of Coth function with large positive " &
+                          "value greater than 1.0");
+         end if;
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on EF.Coth with large " &
+                         "positive value");
+      end;
+
+      begin 
+         The_Result := EF.Coth (FXA5A00.Minus_Large);
+         if The_Result < -1.0 then
+            Report.Failed("Result of Coth function with large negative " &
+                          "value less than -1.0");
+         end if;
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on EF.Coth with large " &
+                         "negative value");
+      end;
+
+
+      -- Check that Constraint_Error is raised by the Coth function, when
+      -- the value of the parameter X is 0.0.
+
+      if New_Float'Machine_Overflows = True then
+         begin
+            New_Float_Result := GEF.Coth (X => 0.0);
+            Report.Failed("Constraint_Error not raised by the Coth function " &
+                          "when the value of parameter X is 0.0");
+            Dont_Optimize_New_Float(New_Float_Result, 11);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by the Coth " &
+                             "function when the value of parameter X is 0.0");
+         end;
+      end if;
+
+
+      -- Testing of Arccoth Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that Constraint_Error is raised by the Arccoth function
+      -- when the absolute value of the parameter X is 1.0.
+
+      if New_Float'Machine_Overflows = True then
+         begin
+            New_Float_Result := GEF.Arccoth (X => 1.0);
+            Report.Failed("Constraint_Error not raised by the Arccoth " &
+                          "function when the value of parameter X is 1.0");
+            Dont_Optimize_New_Float(New_Float_Result, 12);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by the Arccoth " &
+                             "function when the value of parameter X is 1.0");
+         end;
+      end if;
+      
+      if Float'Machine_Overflows = True then
+         begin
+            The_Result := EF.Arccoth (-1.0);
+            Report.Failed("Constraint_Error not raised by the Arccoth " &
+                          "function when the value of parameter X is -1.0");
+            Dont_Optimize_Float(The_Result, 13);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by the Arccoth " &
+                             "function when the value of parameter X is -1.0");
+         end;
+      end if;
+
+      -- Check that Argument_Error is raised by the Arccoth function when
+      -- the absolute value of the parameter X is less than 1.0.
+
+      begin
+         New_Float_Result := GEF.Arccoth (X => New_Float(One_Minus_Delta));
+         Report.Failed("Argument_Error not raised by the Arccoth " &
+                       "function with parameter value less than 1.0");
+         Dont_Optimize_New_Float(New_Float_Result, 14);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccoth " &
+                          "function with parameter value less than 1.0");
+      end;
+
+      begin
+         The_Result := EF.Arccoth (X => FXA5A00.Minus_One_Plus_Delta);
+         Report.Failed("Argument_Error not raised by the Arccoth function " &
+                       "with parameter value between 0.0 and -1.0");
+         Dont_Optimize_Float(The_Result, 15);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccoth " &
+                          "function with parameter value between 0.0 "  &
+                          "and -1.0");
+      end;
+
+
+      -- Check the results of the Arccoth function with various input 
+      -- parameters.
+
+      if not (Result_Within_Range(GEF.Arccoth(1.01), 2.652, 0.01)  and
+              Result_Within_Range( EF.Arccoth(1.25), 1.099, 0.01)  and
+              Result_Within_Range(GEF.Arccoth(1.56), 0.760, 0.001) and
+              Result_Within_Range( EF.Arccoth(1.97), 0.560, 0.001) and
+              Result_Within_Range(GEF.Arccoth(2.40), 0.444, 0.001) and
+              Result_Within_Range( EF.Arccoth(4.30), 0.237, 0.001) and
+              Result_Within_Range(GEF.Arccoth(5.80), 0.174, 0.001) and
+              Result_Within_Range( EF.Arccoth(7.00), 0.144, 0.001))
+      then
+         Report.Failed("Incorrect result from Arccoth function with various " &
+                       "input parameters");
+      end if;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5A04;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a
new file mode 100644
index 000000000..b50da3a6a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a05.a
@@ -0,0 +1,338 @@
+-- CXA5A05.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 functions Arcsin and Arcsinh provide correct 
+--      results.
+--
+-- TEST DESCRIPTION:
+--      This test examines both the version of Arcsin and Arcsinh 
+--      the instantiation of the Ada.Numerics.Generic_Elementary_Functions 
+--      with a type derived from type Float, as well as the preinstantiated 
+--      version of this package for type Float.
+--      Prescribed results, including instances prescribed to raise 
+--      exceptions, are examined in the test cases.  In addition, 
+--      certain evaluations are performed where the actual function result 
+--      is compared with the expected result (within an epsilon range of 
+--      accuracy).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXA5A00.A   (foundation code)
+--         CXA5A05.A
+--
+--
+-- CHANGE HISTORY:
+--      20 Mar 95   SAIC    Initial prerelease version.
+--      06 Apr 95   SAIC    Corrected errors in context clause reference and
+--                          use of Cycle parameter.
+--      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
+--                          use of Result_Within_Range function overloaded for
+--                          FXA5A00.New_Float_Type.
+--      28 Feb 97   PWB.CTA Removed checks with explict Cycle => 2.0*Pi
+--
+-- CHANGE NOTE:
+--      According to Ken Dritz, author of the Numerics Annex of the RM,
+--      one should never specify the cycle 2.0*Pi for the trigonometric
+--      functions.  In particular, if the machine number for the first
+--      argument is not an exact multiple of the machine number for the
+--      explicit cycle, then the specified exact results cannot be
+--      reasonably expected.  The affected checks in this test have been
+--      marked as comments, with the additional notation "pwb-math".
+--      Phil Brashear
+--!
+
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Elementary_Functions;
+with FXA5A00;
+with Report;
+
+procedure CXA5A05 is
+begin
+
+   Report.Test ("CXA5A05", "Check that the functions Arcsin and Arcsinh " &
+                           "provide correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Numerics;
+      use FXA5A00;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
+      package  EF renames Ada.Numerics.Elementary_Functions;
+
+      The_Result       : Float;
+      New_Float_Result : New_Float;
+
+      procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
+      procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
+
+   begin
+
+      -- Testing of Function Arcsin, both instantiated and pre-instantiated
+      -- versions.
+
+      -- Check that Argument_Error is raised by the Arcsin function when
+      -- the absolute value of the parameter X is greater than 1.0.
+
+      begin
+         New_Float_Result := GEF.Arcsin(New_Float(FXA5A00.One_Plus_Delta));
+         Report.Failed("Argument_Error not raised by Arcsin function " &
+                       "when provided a parameter value larger than 1.0");
+         Dont_Optimize_New_Float(New_Float_Result, 1);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by Arcsin function " &
+                          "when provided a parameter value larger than 1.0");
+      end;
+
+      begin
+         The_Result := EF.Arcsin(FXA5A00.Minus_Large);
+         Report.Failed("Argument_Error not raised by Arcsin function " &
+                       "when provided a large negative parameter value");
+         Dont_Optimize_Float(The_Result, 2);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by Arcsin function " &
+                          "when provided a large negative parameter value");
+      end;
+
+
+      -- Check the prescribed result of function Arcsin with parameter 0.0.
+
+      if GEF.Arcsin(X => 0.0) /= 0.0 or
+          EF.Arcsin(0.0)      /= 0.0
+      then
+         Report.Failed("Incorrect result from Function Arcsin when the " &
+                       "value of the parameter X is 0.0");
+      end if;
+
+
+      -- Check the results of the Arcsin function with various input 
+      -- parameters.
+
+      if not Result_Within_Range(GEF.Arcsin(1.0),    1.571, 0.001) or
+         not Result_Within_Range( EF.Arcsin(0.62),   0.669, 0.001) or
+         not Result_Within_Range(GEF.Arcsin(0.01),   0.010, 0.001) or
+         not Result_Within_Range( EF.Arcsin(-0.29), -0.294, 0.001) or
+         not Result_Within_Range(GEF.Arcsin(-0.50), -0.524, 0.001) or
+         not Result_Within_Range( EF.Arcsin(-1.0),  -1.571, 0.001)
+      then
+         Report.Failed("Incorrect result from Function Arcsin with " &
+                       "various input parameters");
+      end if;
+
+
+      -- Testing of Function Arcsin with specified Cycle parameter.
+
+--pwb-math      -- Check that Argument_Error is raised by the Arcsin function with 
+--pwb-math      -- specified cycle, whenever the absolute value of the parameter X 
+--pwb-math      -- is greater than 1.0.
+--pwb-math
+--pwb-math      begin
+--pwb-math         New_Float_Result := GEF.Arcsin(New_Float(FXA5A00.Large), 2.0*Pi);
+--pwb-math         Report.Failed("Argument_Error not raised by Function Arcsin " &
+--pwb-math                       "with specified cycle, when provided a large "  &
+--pwb-math                       "positive input parameter");
+--pwb-math         Dont_Optimize_New_Float(New_Float_Result, 3);
+--pwb-math      exception
+--pwb-math         when Argument_Error => null;  -- OK, expected exception.
+--pwb-math         when others         =>
+--pwb-math            Report.Failed("Unexpected exception raised by Function Arcsin " &
+--pwb-math                          "with specified cycle, when provided a large "    &
+--pwb-math                          "positive input parameter");
+--pwb-math      end;
+--pwb-math
+--pwb-math      begin
+--pwb-math         The_Result := EF.Arcsin(FXA5A00.Minus_One_Minus_Delta, 2.0*Pi);
+--pwb-math         Report.Failed("Argument_Error not raised by Function Arcsin " &
+--pwb-math                       "with specified cycle, when provided an input " &
+--pwb-math                       "parameter less than -1.0");
+--pwb-math         Dont_Optimize_Float(The_Result, 4);
+--pwb-math      exception
+--pwb-math         when Argument_Error => null;  -- OK, expected exception.
+--pwb-math         when others         =>
+--pwb-math            Report.Failed("Unexpected exception raised by Function Arcsin " &
+--pwb-math                          "with specified cycle, when provided an input "   &
+--pwb-math                          "parameter less than -1.0");
+--pwb-math      end;
+--pwb-math
+      -- Check that Argument_Error is raised by the Arcsin function with 
+      -- specified cycle, whenever the Cycle parameter is zero or negative.
+
+      begin
+         New_Float_Result := GEF.Arcsin(2.0, 0.0);
+         Report.Failed("Argument_Error not raised by Function Arcsin " &
+                       "with specified cycle of 0.0");
+         Dont_Optimize_New_Float(New_Float_Result, 5);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by Function Arcsin " &
+                          "with specified cycle of 0.0");
+      end;
+
+      begin
+         The_Result := EF.Arcsin(2.0, -2.0*Pi);
+         Report.Failed("Argument_Error not raised by Function Arcsin " &
+                       "with specified negative cycle parameter");
+         Dont_Optimize_Float(The_Result, 6);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by Function Arcsin " &
+                          "with specified negative cycle parameter");
+      end;
+
+
+--pwb-math      -- Check the prescribed result of function Arcsin with specified Cycle
+--pwb-math      -- parameter, when the value of parameter X is 0.0.
+--pwb-math
+--pwb-math      if GEF.Arcsin(X => 0.0, Cycle => 2.0*Pi) /= 0.0 or
+--pwb-math          EF.Arcsin(0.0, 2.0*Pi)               /= 0.0
+--pwb-math      then
+--pwb-math         Report.Failed("Incorrect result from Function Arcsin with " &
+--pwb-math                       "specified Cycle parameter, when the value "  &
+--pwb-math                       "of parameter X is 0.0");
+--pwb-math      end if;
+--pwb-math
+--pwb-math
+--pwb-math      -- Test of the Arcsin function with specified Cycle parameter with 
+--pwb-math      -- various input parameters.
+--pwb-math
+--pwb-math      if not FXA5A00.Result_Within_Range(GEF.Arcsin( 0.01, 2.0*Pi),  
+--pwb-math                                         0.010,
+--pwb-math                                         0.001)                    or
+--pwb-math         not FXA5A00.Result_Within_Range( EF.Arcsin( 0.14, 2.0*Pi),  
+--pwb-math                                         0.141,
+--pwb-math                                         0.001)                    or
+--pwb-math         not FXA5A00.Result_Within_Range(GEF.Arcsin( 0.37, 2.0*Pi),  
+--pwb-math                                         0.379,
+--pwb-math                                         0.001)                    or
+--pwb-math         not FXA5A00.Result_Within_Range( EF.Arcsin( 0.55, 2.0*Pi),  
+--pwb-math                                         0.582,
+--pwb-math                                         0.001)                    or
+--pwb-math         not FXA5A00.Result_Within_Range(GEF.Arcsin(-0.22, 2.0*Pi), 
+--pwb-math                                         -0.222,
+--pwb-math                                         0.001)                    or
+--pwb-math         not FXA5A00.Result_Within_Range( EF.Arcsin(-0.99, 2.0*Pi), 
+--pwb-math                                         -1.43,
+--pwb-math                                          0.01)                    or
+--pwb-math         not FXA5A00.Result_Within_Range( EF.Arcsin(1.0, 360.0), 
+--pwb-math                                         90.0,
+--pwb-math                                         0.1)                      or
+--pwb-math         not FXA5A00.Result_Within_Range( EF.Arcsin(1.0, 100.0), 
+--pwb-math                                         25.0,
+--pwb-math                                         0.1)
+--pwb-math      then
+--pwb-math         Report.Failed("Incorrect result from Arcsin with specified " &
+--pwb-math                       "cycle parameter with various input parameters");
+--pwb-math      end if;
+
+      -- Testing of Arcsinh Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that no exception occurs on computing the Arcsinh with very
+      -- large (positive and negative) input values.
+
+      begin 
+         New_Float_Result := GEF.Arcsinh(New_Float(FXA5A00.Large));
+         Dont_Optimize_New_Float(New_Float_Result, 7);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on Arcsinh with large " &
+                         "positive value");
+      end;
+
+      begin 
+         The_Result := EF.Arcsinh(FXA5A00.Minus_Large);
+         Dont_Optimize_Float(The_Result, 8);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on Arcsinh with large " &
+                         "negative value");
+      end;
+
+ 
+      -- Check that no exception occurs on computing the Arcsinh with very
+      -- small (positive and negative) input values.
+
+      begin 
+         New_Float_Result := GEF.Arcsinh(New_Float(FXA5A00.Small));
+         Dont_Optimize_New_Float(New_Float_Result, 9);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on Arcsinh with small " &
+                         "positive value");
+      end;
+
+      begin 
+         The_Result := EF.Arcsinh(-FXA5A00.Small);
+         Dont_Optimize_Float(The_Result, 10);
+      exception
+         when others =>
+           Report.Failed("Unexpected exception on Arcsinh with small " &
+                         "negative value");
+      end;
+
+ 
+      -- Check function Arcsinh for prescribed result with parameter 0.0.
+
+      if GEF.Arcsinh(X => 0.0) /= 0.0 or
+          EF.Arcsinh(X => 0.0) /= 0.0
+      then
+         Report.Failed("Incorrect result from Function Arcsinh when " &
+                       "provided a 0.0 input parameter");
+      end if;
+
+ 
+      -- Check the results of the Arcsinh function with various input 
+      -- parameters.
+
+      if not Result_Within_Range(GEF.Arcsinh(0.15),  0.149, 0.001) or
+         not Result_Within_Range( EF.Arcsinh(0.82),  0.748, 0.001) or
+         not Result_Within_Range(GEF.Arcsinh(1.44),  1.161, 0.001) or
+         not Result_Within_Range(GEF.Arcsinh(6.70),  2.601, 0.001) or
+         not Result_Within_Range( EF.Arcsinh(Pi),    1.862, 0.001) or
+         not Result_Within_Range( EF.Arcsinh(-Pi),  -1.862, 0.001) or
+         not Result_Within_Range(GEF.Arcsinh(-1.0), -0.881, 0.001) or
+         not Result_Within_Range( EF.Arcsinh(-5.5), -2.406, 0.001)
+      then
+         Report.Failed("Incorrect result from Function Arcsin with " &
+                       "various input parameters");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5A05;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a
new file mode 100644
index 000000000..191a96d75
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a06.a
@@ -0,0 +1,334 @@
+-- CXA5A06.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 functions Arccos and Arccosh provide correct 
+--      results.
+--
+-- TEST DESCRIPTION:
+--      This test examines both the version of Arccos and Arccosh 
+--      the instantiation of the Ada.Numerics.Generic_Elementary_Functions 
+--      with a type derived from type Float, as well as the preinstantiated 
+--      version of this package for type Float.
+--      Prescribed results, including instances prescribed to raise 
+--      exceptions, are examined in the test cases.  In addition, 
+--      certain evaluations are performed where the actual function result 
+--      is compared with the expected result (within an epsilon range of 
+--      accuracy).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXA5A00.A   (foundation code)
+--         CXA5A06.A
+--
+--
+-- CHANGE HISTORY:
+--      27 Mar 95   SAIC    Initial prerelease version.
+--      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
+--                          use of Result_Within_Range function overloaded for
+--                          FXA5A00.New_Float_Type.
+--      28 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
+--
+-- CHANGE NOTE:
+--      According to Ken Dritz, author of the Numerics Annex of the RM,
+--      one should never specify the cycle 2.0*Pi for the trigonometric
+--      functions.  In particular, if the machine number for the first
+--      argument is not an exact multiple of the machine number for the
+--      explicit cycle, then the specified exact results cannot be
+--      reasonably expected.  The affected checks in this test have been
+--      marked as comments, with the additional notation "pwb-math".
+--      Phil Brashear
+--!
+
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Elementary_Functions;
+with FXA5A00;
+with Report;
+
+procedure CXA5A06 is
+begin
+
+   Report.Test ("CXA5A06", "Check that the functions Arccos and Arccosh " &
+                           "provide correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Numerics;
+      use FXA5A00;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
+      package  EF renames Ada.Numerics.Elementary_Functions;
+
+      The_Result       : Float;
+      New_Float_Result : New_Float;
+
+      procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
+      procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
+
+   begin
+
+      -- Testing of Arccos Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that Argument_Error is raised by the Arccos function when the
+      -- absolute value of the input parameter is greater than 1.0.
+
+      begin
+         New_Float_Result := GEF.Arccos(New_Float(FXA5A00.One_Plus_Delta));
+         Report.Failed("Argument_Error not raised by the Arccos function " &
+                       "when the input parameter is greater than 1.0");
+         Dont_Optimize_New_Float(New_Float_Result, 1);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccos "    &
+                          "function when the input parameter is greater " &
+                          "than 1.0");
+      end;
+
+      begin
+         The_Result := EF.Arccos(-FXA5A00.Large);
+         Report.Failed("Argument_Error not raised by the Arccos function " &
+                       "when the input parameter is a large negative value");
+         Dont_Optimize_Float(The_Result, 2);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccos " &
+                          "function when the input parameter is a "    &
+                          "large negative value");
+      end;
+
+
+      -- Check the prescribed results of the Arccos function.
+
+      if GEF.Arccos(X => 1.0) /= 0.0 or
+          EF.Arccos(1.0)      /= 0.0
+      then
+         Report.Failed("Incorrect result returned by the Arccos function " &
+                       "when provided a parameter value of 0.0");
+      end if;
+
+
+      -- Check the results of the Arccos function with various input 
+      -- parameters.
+ 
+      if not Result_Within_Range(GEF.Arccos(0.77),  0.692,  0.001) or
+         not Result_Within_Range( EF.Arccos(0.37),  1.19,   0.01)  or
+         not Result_Within_Range(GEF.Arccos(0.0),   Pi/2.0, 0.01)  or
+         not Result_Within_Range( EF.Arccos(-0.11), 1.68,   0.01)  or
+         not Result_Within_Range(GEF.Arccos(-0.67), 2.31,   0.01)  or
+         not Result_Within_Range( EF.Arccos(-0.94), 2.79,   0.01)  or
+         not Result_Within_Range(GEF.Arccos(-1.0),  Pi,     0.01) 
+      then
+         Report.Failed("Incorrect result returned from the Arccos " &
+                       "function when provided a variety of input " &
+                       "parameters");
+      end if;
+
+
+      -- Testing of the Arccos function with specified Cycle parameter.
+
+      -- Check that Argument_Error is raised by the Arccos function, with
+      -- specified Cycle parameter, when the absolute value of the input
+      -- parameter is greater than 1.0.
+
+      begin
+--pwb-math: Next line: Changed 2.0*Pi to 360.0
+         New_Float_Result := GEF.Arccos(New_Float(Large), Cycle => 360.0);
+         Report.Failed("Argument_Error not raised by the Arccos function " &
+                       "with specified Cycle parameter, when the input "   &
+                       "parameter is a large positive value");
+         Dont_Optimize_New_Float(New_Float_Result, 3);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccos "     &
+                          "function with specified Cycle parameter, when " &
+                          "the input parameter is a large positive value");
+      end;
+
+      begin
+--pwb-math: Next line: Changed 2.0*Pi to 360.0
+         The_Result := EF.Arccos(FXA5A00.Minus_One_Minus_Delta, 360.0);
+         Report.Failed("Argument_Error not raised by the Arccos function " &
+                       "with specified Cycle parameter, when the input "   &
+                       "parameter is less than -1.0");
+         Dont_Optimize_Float(The_Result, 4);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccos " &
+                          "function with specified Cycle parameter, "  &
+                          "when the input parameter is less than -1.0");
+      end;
+
+
+      -- Check that Argument_Error is raised by the Arccos function with
+      -- specified cycle when the value of the Cycle parameter is zero or
+      -- negative.
+
+      begin
+         New_Float_Result := GEF.Arccos(X => 1.0, Cycle => 0.0 );
+         Report.Failed("Argument_Error not raised by the Arccos function " &
+                       "with specified Cycle parameter, when the Cycle "   &
+                       "parameter is 0.0");
+         Dont_Optimize_New_Float(New_Float_Result, 5);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccos "     &
+                          "function with specified Cycle parameter, when " &
+                          "the Cycle parameter is 0.0");
+      end;
+
+      begin
+         The_Result := EF.Arccos(1.0, Cycle => -2.0*Pi);
+         Report.Failed("Argument_Error not raised by the Arccos function " &
+                       "with specified Cycle parameter, when the Cycle "   &
+                       "parameter is negative");
+         Dont_Optimize_Float(The_Result, 6);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccos "     &
+                          "function with specified Cycle parameter, when " &
+                          "the Cycle parameter is negative");
+      end;
+
+      
+      -- Check the prescribed result of the Arccos function with specified
+      -- Cycle parameter.
+
+--pwb-math: Next two lines: Changed 2.0*Pi to 360.0
+      if GEF.Arccos(X => 1.0, Cycle => 360.0) /= 0.0 or
+          EF.Arccos(1.0, 360.0)               /= 0.0
+      then 
+         Report.Failed("Incorrect result from the Arccos function with " &
+                       "specified Cycle parameter, when the input "      &
+                       "parameter value is 1.0");
+      end if;
+
+
+      -- Check the results of the Arccos function, with specified Cycle
+      -- parameter, with various input parameters.
+ 
+      if --pwb-math not Result_Within_Range(GEF.Arccos( 0.04, 2.0*Pi), 1.53, 0.01) or
+--pwb-math         not Result_Within_Range( EF.Arccos( 0.14, 2.0*Pi), 1.43, 0.01) or
+--pwb-math         not Result_Within_Range(GEF.Arccos( 0.57, 2.0*Pi), 0.96, 0.01) or
+--pwb-math         not Result_Within_Range( EF.Arccos( 0.99, 2.0*Pi), 0.14, 0.01) or
+         not Result_Within_Range(GEF.Arccos(-1.0, 360.0), 180.0,  0.1)  or
+         not Result_Within_Range(GEF.Arccos(-1.0, 100.0),  50.0,  0.1)  or
+         not Result_Within_Range(GEF.Arccos( 0.0, 360.0),  90.0,  0.1)  or
+         not Result_Within_Range(GEF.Arccos( 0.0, 100.0),  25.0,  0.1)
+      then
+         Report.Failed("Incorrect result returned from the Arccos " &
+                       "function with specified Cycle parameter, "  &
+                       "when provided a variety of input parameters");
+      end if;
+
+
+
+      -- Testing of Arccosh Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that Argument_Error is raised by the Arccosh function when
+      -- the value of the parameter X is less than 1.0.
+
+      begin 
+         New_Float_Result := GEF.Arccosh(New_Float(FXA5A00.One_Minus_Delta));
+         Report.Failed("Argument_Error not raised by the Arccosh function " &
+                       "when the parameter value is less than 1.0");
+         Dont_Optimize_New_Float(New_Float_Result, 7);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccosh " &
+                          "function when given a parameter value less " &
+                          "than 1.0");
+      end;
+                    
+      begin 
+         The_Result := EF.Arccosh(0.0);
+         Report.Failed("Argument_Error not raised by the Arccosh function " &
+                       "when the parameter value is 0.0");
+         Dont_Optimize_Float(The_Result, 8);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccosh " &
+                          "function when given a parameter value of 0.0");
+      end;
+                    
+      begin 
+         New_Float_Result := GEF.Arccosh(New_Float(-FXA5A00.Large));
+         Report.Failed("Argument_Error not raised by the Arccosh function " &
+                       "when the large negative parameter value");
+         Dont_Optimize_New_Float(New_Float_Result, 9);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Arccosh "     &
+                          "function when given a large negative parameter " & 
+                          "value");
+      end;
+                    
+
+      -- Check the prescribed results of the Arccosh function.
+
+      if GEF.Arccosh(X => 1.0) /= 0.0 or
+          EF.Arccosh(1.0)      /= 0.0
+      then
+         Report.Failed("Incorrect result returned by the Arccosh " &
+                       "function when provided a parameter value of 0.0");
+      end if;
+
+
+      -- Check the results of the Arccosh function with various input 
+      -- parameters.
+ 
+      if not Result_Within_Range(GEF.Arccosh(1.03), 0.244, 0.001) or
+         not Result_Within_Range( EF.Arccosh(1.28), 0.732, 0.001) or
+         not Result_Within_Range(GEF.Arccosh(1.50), 0.962, 0.001) or
+         not Result_Within_Range( EF.Arccosh(1.77), 1.17,  0.01)  or
+         not Result_Within_Range(GEF.Arccosh(2.00), 1.32,  0.01)  or
+         not Result_Within_Range( EF.Arccosh(4.30), 2.14,  0.01)  or
+         not Result_Within_Range(GEF.Arccosh(6.90), 2.62,  0.01) 
+      then
+         Report.Failed("Incorrect result returned from the Arccosh " &
+                       "function when provided a variety of input "  &
+                       "parameters");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5A06;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a
new file mode 100644
index 000000000..179d54c44
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a07.a
@@ -0,0 +1,413 @@
+-- CXA5A07.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 function Arctan provides correct results.
+--
+-- TEST DESCRIPTION:
+--      This test examines both the version of Arctan resulting from the 
+--      instantiation of the Ada.Numerics.Generic_Elementary_Functions with 
+--      a type derived from type Float, as well as the preinstantiated 
+--      version of this package for type Float.
+--      Prescribed results, including instances prescribed to raise 
+--      exceptions, are examined in the test cases.  In addition, 
+--      certain evaluations are performed where the actual function result 
+--      is compared with the expected result (within an epsilon range of 
+--      accuracy).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXA5A00.A   (foundation code)
+--         CXA5A07.A
+--
+--
+-- CHANGE HISTORY:
+--      04 Apr 95   SAIC    Initial prerelease version.
+--      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
+--                          use of Result_Within_Range function overloaded for
+--                          FXA5A00.New_Float_Type.
+--      28 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
+--
+-- CHANGE NOTE:
+--      According to Ken Dritz, author of the Numerics Annex of the RM,
+--      one should never specify the cycle 2.0*Pi for the trigonometric
+--      functions.  In particular, if the machine number for the first
+--      argument is not an exact multiple of the machine number for the
+--      explicit cycle, then the specified exact results cannot be
+--      reasonably expected.  The affected checks in this test have been
+--      marked as comments, with the additional notation "pwb-math".
+--      Phil Brashear
+--!
+
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Elementary_Functions;
+with FXA5A00;
+with Report;
+
+procedure CXA5A07 is
+begin
+
+   Report.Test ("CXA5A07", "Check that the Arctan function provides " &
+                           "correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Numerics;
+      use FXA5A00;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
+      package  EF renames Ada.Numerics.Elementary_Functions;
+
+      Float_Result     : Float;
+      New_Float_Result : New_Float;
+
+      procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
+      procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
+
+   begin
+
+      -- Testing of Arctan Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that Argument_Error is raised by the Arctan function when
+      -- provided parameter values of 0.0, 0.0.
+
+      begin
+         New_Float_Result := GEF.Arctan(Y => 0.0, X => 0.0);
+         Report.Failed("Argument_Error not raised when the Arctan " &
+                       "function is provided input of 0.0, 0.0");
+         Dont_Optimize_New_Float(New_Float_Result, 1);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Incorrect exception raised by the Arctan " &
+                          "function when provided 0.0, 0.0 input parameters");
+      end;
+
+
+      -- Check that no exception is raised by the Arctan function when
+      -- provided a large positive or negative Y parameter value, when 
+      -- using the default value for parameter X.
+
+      begin
+         Float_Result := EF.Arctan(Y => FXA5A00.Large);
+         Dont_Optimize_Float(Float_Result, 2);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function is " &
+                          "provided a large positive Y parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arctan(Y => New_Float(-FXA5A00.Large));
+         Dont_Optimize_New_Float(New_Float_Result, 3);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function is " &
+                          "provided a large negative Y parameter value");
+      end;
+
+
+      -- Check that no exception is raised by the Arctan function when
+      -- provided a small positive or negative Y parameter value, when
+      -- using the default value for parameter X.
+
+      begin
+         Float_Result := EF.Arctan(Y => FXA5A00.Small);
+         Dont_Optimize_Float(Float_Result, 4);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function is " &
+                          "provided a small positive Y parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arctan(Y => New_Float(-FXA5A00.Small));
+         Dont_Optimize_New_Float(New_Float_Result, 5);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function is " &
+                          "provided a small negative Y parameter value");
+      end;
+
+
+      -- Check that no exception is raised by the Arctan function when
+      -- provided combinations of large and small positive or negative 
+      -- parameter values for both Y and X input parameters. 
+
+      begin
+         Float_Result := EF.Arctan(Y => FXA5A00.Large, X => FXA5A00.Large);
+         Dont_Optimize_Float(Float_Result, 6);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function is " &
+                          "provided large positive X and Y parameter values");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arctan(New_Float(-FXA5A00.Large), 
+                                        X => New_Float(FXA5A00.Small));
+         Dont_Optimize_New_Float(New_Float_Result, 7);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function is " &
+                          "provided a large negative Y parameter value "  &
+                          "and a small positive X parameter value");
+      end;
+
+
+      begin
+         Float_Result := EF.Arctan(Y => FXA5A00.Small, X => FXA5A00.Large);
+         Dont_Optimize_Float(Float_Result, 8);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function is " &
+                          "provided a small positive Y parameter value "  &
+                          "and a large positive X parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arctan(New_Float(-FXA5A00.Small), 
+                                        New_Float(-FXA5A00.Large));
+         Dont_Optimize_New_Float(New_Float_Result, 9);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function is " &
+                          "provided a small negative Y parameter value "  &
+                          "and a large negative parameter value");
+      end;
+
+
+      -- Check that when the Arctan function is provided a Y parameter value
+      -- of 0.0 and a positive X parameter input value, the prescribed result
+      -- of zero is returned.
+
+      if GEF.Arctan(Y => 0.0)                     /= 0.0 or -- Default X value
+          EF.Arctan(Y => 0.0, X => FXA5A00.Large) /= 0.0 or
+--pwb-math: Next line: changed 2.0*Pi to 360.0
+         GEF.Arctan(0.0, 360.0)                  /= 0.0 or
+          EF.Arctan(0.0, FXA5A00.Small)           /= 0.0
+      then 
+         Report.Failed("Incorrect results from the Arctan function when " &
+                       "provided a Y parameter value of 0.0 and various " &
+                       "positive X parameter values");
+      end if;
+
+
+      -- Check that the Arctan function provides correct results when provided
+      -- a variety of Y parameter values.  
+
+      if not FXA5A00.Result_Within_Range(EF.Arctan(Pi),    1.26,  0.01)  or
+         not FXA5A00.Result_Within_Range(EF.Arctan(-Pi),  -1.26,  0.01)  or
+         not FXA5A00.Result_Within_Range(GEF.Arctan(1.0),  0.785, 0.001) or
+         not FXA5A00.Result_Within_Range(EF.Arctan(-1.0), -0.785, 0.001) or
+         not FXA5A00.Result_Within_Range(GEF.Arctan(0.25), 0.245, 0.001) or
+         not FXA5A00.Result_Within_Range(EF.Arctan(0.92),  0.744, 0.001) 
+      then
+         Report.Failed("Incorrect results from the Arctan function when " &
+                       "provided a variety of Y parameter values");
+      end if;
+
+
+
+      -- Check the results of the Arctan function with specified cycle
+      -- parameter.
+
+      -- Check that the Arctan function with specified Cycle parameter 
+      -- raises Argument_Error when the value of the Cycle parameter is zero
+      -- or negative.
+
+      begin
+         Float_Result := EF.Arctan(Y => Pi, Cycle => 0.0);  -- Default X value
+         Report.Failed("Argument_Error not raised by the Arctan function " &
+                       "with default X parameter value, when the Cycle "   &
+                       "parameter is 0.0");
+         Dont_Optimize_Float(Float_Result, 10);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Incorrect exception raised by the Arctan "      &
+                          "function with default X parameter value, when " &
+                          "provided a 0.0 cycle parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arctan(Y => Pi, X => 1.0, Cycle => 0.0);
+         Report.Failed("Argument_Error not raised by the Arctan function " &
+                       "when the Cycle parameter is 0.0");
+         Dont_Optimize_New_Float(New_Float_Result, 11);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Incorrect exception raised by the Arctan "     &
+                          "function when provided a 0.0 cycle parameter " &
+                          "value");
+      end;
+
+      begin
+         Float_Result := EF.Arctan(Y => Pi, Cycle => -360.0); 
+         Report.Failed("Argument_Error not raised by the Arctan function " &
+                       "with a default X parameter value, when the Cycle " &
+                       "parameter is -360.0");
+         Dont_Optimize_Float(Float_Result, 12);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Incorrect exception raised by the Arctan "        &
+                          "function with a default X parameter value, when " & 
+                          "provided a -360.0 cycle parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arctan(Y => Pi, X => 1.0, Cycle => -Pi);
+         Report.Failed("Argument_Error not raised by the Arctan function " &
+                       "when the Cycle parameter is -Pi");
+         Dont_Optimize_New_Float(New_Float_Result, 13);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Incorrect exception raised by the Arctan "     &
+                          "function when provided a -Pi cycle parameter " &
+                          "value");
+      end;
+
+
+      -- Check that no exception is raised by the Arctan function with 
+      -- specified Cycle parameter, when provided large and small positive
+      -- or negative parameter values for both Y and X input parameters. 
+
+      begin
+         Float_Result := EF.Arctan(Y     => -FXA5A00.Large, 
+                                   X     => -FXA5A00.Large,
+--pwb-math: Next line: changed 2.0*Pi to 360.0
+                                   Cycle => 360.0);
+         Dont_Optimize_Float(Float_Result, 14);
+      exception
+         when others =>  
+            Report.Failed("Exception raised when the Arctan function with " &
+                          "specified Cycle parameter, when provided large " & 
+                          "negative X and Y parameter values");
+      end;
+
+
+      begin
+         New_Float_Result := GEF.Arctan(New_Float(FXA5A00.Large), 
+                                        X     => New_Float(-FXA5A00.Small),
+--pwb-math: Next line: changed 2.0*Pi to 360.0
+                                        Cycle => 360.0);
+         Dont_Optimize_New_Float(New_Float_Result, 15);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function with "  &
+                          "specified Cycle parameter, when provided large "  & 
+                          "positive Y parameter value and a small negative " &
+                          "X parameter value");
+      end;
+
+
+      begin
+         Float_Result := EF.Arctan(Y     => -FXA5A00.Small, 
+                                   X     => -FXA5A00.Large,
+--pwb-math: Next line: changed 2.0*Pi to 360.0
+                                   Cycle => 360.0);
+         Dont_Optimize_Float(Float_Result, 16);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function with "  &
+                          "specified Cycle parameter, when provided large "  & 
+                          "negative Y parameter value and a large negative " &
+                          "X parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arctan(New_Float(FXA5A00.Small), 
+                                        New_Float(FXA5A00.Large), 
+--pwb-math: Next line: changed 2.0*Pi to 360.0
+                                        360.0);
+         Dont_Optimize_New_Float(New_Float_Result, 17);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arctan function with " &
+                          "specified Cycle parameter, when provided a "     & 
+                          "small negative Y parameter value and a large "   &
+                          "positive X parameter value");
+      end;
+
+
+      -- Check that the Arctan function with specified Cycle parameter 
+      -- provides correct results when provided a variety of Y parameter
+      -- input values.
+
+--pwb-math      if not FXA5A00.Result_Within_Range(EF.Arctan(Pi,    Cycle => 2.0*Pi),
+--pwb-math                                         1.26, 
+--pwb-math                                         0.01)                            or
+--pwb-math         not FXA5A00.Result_Within_Range(EF.Arctan(-Pi,   Cycle => 2.0*Pi),
+--pwb-math                                         -1.26,
+--pwb-math                                         0.01)                            or
+--pwb-math         not FXA5A00.Result_Within_Range(GEF.Arctan(1.0,  Cycle => 2.0*Pi),
+--pwb-math                                         0.785,
+--pwb-math                                         0.001)                           or
+--pwb-math         not FXA5A00.Result_Within_Range(EF.Arctan(-1.0,  Cycle => 2.0*Pi),
+--pwb-math                                         -0.785, 
+--pwb-math                                         0.001)                           or
+--pwb-math         not FXA5A00.Result_Within_Range(GEF.Arctan(0.16, Cycle => 2.0*Pi),
+--pwb-math                                         0.159,
+--pwb-math                                         0.001)                           or
+--pwb-math         not FXA5A00.Result_Within_Range(EF.Arctan(1.0,   Cycle => 360.0),
+--pwb-math                                         45.0,
+--pwb-math                                         0.1)                             or
+--pwb-math         not FXA5A00.Result_Within_Range(GEF.Arctan(1.0,  Cycle => 100.0),
+--pwb-math                                         12.5,
+--pwb-math                                         0.1) 
+
+--pwb-math  Next 12 lines are replacements for 21 commented lines above
+      if not FXA5A00.Result_Within_Range(GEF.Arctan(1.0,  Cycle => 2.0*180.0),
+                                         45.0,
+                                         0.001)                           or
+         not FXA5A00.Result_Within_Range(EF.Arctan(-1.0,  Cycle => 2.0*180.0),
+                                         -45.0, 
+                                         0.001)                           or
+         not FXA5A00.Result_Within_Range(EF.Arctan(1.0,   Cycle => 360.0),
+                                         45.0,
+                                         0.1)                             or
+         not FXA5A00.Result_Within_Range(GEF.Arctan(1.0,  Cycle => 100.0),
+                                         12.5,
+                                         0.1) 
+      then
+         Report.Failed("Incorrect results from the Arctan function with "   &
+                       "specified Cycle parameter when provided a variety " &
+                       "of Y parameter values");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5A07;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a
new file mode 100644
index 000000000..ae2b85a6d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a08.a
@@ -0,0 +1,474 @@
+-- CXA5A08.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 function Arccot provides correct results.
+--
+-- TEST DESCRIPTION:
+--      This test examines both the version of Arccot resulting from the 
+--      instantiation of the Ada.Numerics.Generic_Elementary_Functions 
+--      with a type derived from type Float, as well as the preinstantiated 
+--      version of this package for type Float.
+--      Prescribed results, including instances prescribed to raise 
+--      exceptions, are examined in the test cases.  In addition, 
+--      certain evaluations are performed where the actual function result 
+--      is compared with the expected result (within an epsilon range of 
+--      accuracy).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXA5A00.A   (foundation code)
+--         CXA5A08.A
+--
+--
+-- CHANGE HISTORY:
+--      06 Apr 95   SAIC    Initial prerelease version.
+--      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
+--                          use of Result_Within_Range function overloaded for
+--                          FXA5A00.New_Float_Type.
+--      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      28 Feb 97   CTA.PWB Removed checks with explicit Cycle => 2.0*Pi
+--
+-- CHANGE NOTE:
+--      According to Ken Dritz, author of the Numerics Annex of the RM,
+--      one should never specify the cycle 2.0*Pi for the trigonometric
+--      functions.  In particular, if the machine number for the first
+--      argument is not an exact multiple of the machine number for the
+--      explicit cycle, then the specified exact results cannot be
+--      reasonably expected.  The affected checks in this test have been
+--      marked as comments, with the additional notation "pwb-math".
+--      Phil Brashear
+--!
+
+with Ada.Exceptions;
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Elementary_Functions;
+with FXA5A00;
+with Report;
+
+procedure CXA5A08 is
+begin
+
+   Report.Test ("CXA5A08", "Check that the Arccot function provides " &
+                           "correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+      use Ada.Numerics;
+      use FXA5A00;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
+      package  EF renames Ada.Numerics.Elementary_Functions;
+
+      Float_Result      : Float;
+      Angle             : Float;
+      New_Float_Result  : New_Float;
+      New_Float_Angle   : New_Float;
+      Incorrect_Inverse : Boolean := False;
+
+      procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
+      procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
+
+   begin
+
+      -- Testing of Arccot Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that Argument_Error is raised by the Arccot function when
+      -- provided parameter values of 0.0, 0.0.
+
+      begin
+         New_Float_Result := GEF.Arccot(X => 0.0, Y => 0.0);
+         Report.Failed("Argument_Error not raised when the Arccot " &
+                       "function is provided input of 0.0, 0.0");
+         Dont_Optimize_New_Float(New_Float_Result, 1);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Incorrect exception raised by the Arccot " &
+                          "function when provided 0.0, 0.0 input parameters");
+      end;
+
+
+      -- Check that no exception is raised by the Arccot function when
+      -- provided a large positive or negative X parameter value, when 
+      -- using the default value for parameter Y.
+
+      begin
+         Float_Result := EF.Arccot(X => FXA5A00.Large);
+         Dont_Optimize_Float(Float_Result, 2);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function is " &
+                          "provided a large positive X parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arccot(X => New_Float(-FXA5A00.Large));
+         Dont_Optimize_New_Float(New_Float_Result, 3);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function is " &
+                          "provided a large negative X parameter value");
+      end;
+
+
+      -- Check that no exception is raised by the Arccot function when
+      -- provided a small positive or negative X parameter value, when
+      -- using the default value for parameter Y.
+
+      begin
+         Float_Result := EF.Arccot(X => FXA5A00.Small);
+         Dont_Optimize_Float(Float_Result, 4);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function is " &
+                          "provided a small positive X parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arccot(X => New_Float(-FXA5A00.Small));
+         Dont_Optimize_New_Float(New_Float_Result, 5);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function is " &
+                          "provided a small negative X parameter value");
+      end;
+
+
+      -- Check that no exception is raised by the Arccot function when
+      -- provided combinations of large and small positive or negative 
+      -- parameter values for both X and Y input parameters. 
+
+      begin
+         Float_Result := EF.Arccot(X => FXA5A00.Large, Y => FXA5A00.Large);
+         Dont_Optimize_Float(Float_Result, 6);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function is " &
+                          "provided large positive X and Y parameter values");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arccot(New_Float(-FXA5A00.Large), 
+                                        Y => New_Float(FXA5A00.Small));
+         Dont_Optimize_New_Float(New_Float_Result, 7);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function is " &
+                          "provided a large negative X parameter value "  &
+                          "and a small positive Y parameter value");
+      end;
+
+
+      begin
+         Float_Result := EF.Arccot(X => FXA5A00.Small, Y => FXA5A00.Large);
+         Dont_Optimize_Float(Float_Result, 8);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function is " &
+                          "provided a small positive X parameter value "  &
+                          "and a large positive Y parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arccot(New_Float(-FXA5A00.Small), 
+                                        New_Float(-FXA5A00.Large));
+         Dont_Optimize_New_Float(New_Float_Result, 9);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function is " &
+                          "provided a small negative X parameter value "  &
+                          "and a large negative Y parameter value");
+      end;
+
+
+      -- Check that when the Arccot function is provided a Y parameter value
+      -- of 0.0 and a positive X parameter input value, the prescribed result
+      -- of zero is returned.
+
+      if  EF.Arccot(X => FXA5A00.Large, Y => 0.0)                 /= 0.0 or
+         GEF.Arccot(2.0*Pi, Y => 0.0)                             /= 0.0 or
+          EF.Arccot(FXA5A00.Small, 0.0)                           /= 0.0 or
+          EF.Arccot(X => FXA5A00.Large, Y => 0.0, Cycle => 360.0) /= 0.0 or
+         GEF.Arccot(2.0*Pi, Y => 0.0, Cycle => 360.0)             /= 0.0 or
+          EF.Arccot(FXA5A00.Small, 0.0, Cycle => 360.0)           /= 0.0
+      then 
+         Report.Failed("Incorrect results from the Arccot function when " &
+                       "provided a Y parameter value of 0.0 and various " &
+                       "positive X parameter values");
+      end if;
+
+
+      -- Check that the Arccot function provides correct results when
+      -- provided a variety of X parameter values.  
+
+      if not Result_Within_Range( EF.Arccot( 1.0), Pi/4.0, 0.001)     or
+         not Result_Within_Range(GEF.Arccot( 0.0), Pi/2.0, 0.001)     or
+         not Result_Within_Range( EF.Arccot(-1.0), 3.0*Pi/4.0, 0.001) 
+      then
+         Report.Failed("Incorrect results from the Arccot function when " &
+                       "provided a variety of Y parameter values");
+      end if;
+
+
+      -- Check the results of the Arccot function with specified cycle
+      -- parameter.
+
+      -- Check that the Arccot function with specified Cycle parameter 
+      -- raises Argument_Error when the value of the Cycle parameter is zero
+      -- or negative.
+
+      begin
+         Float_Result := EF.Arccot(X => Pi, Cycle => 0.0);  -- Default Y value
+         Report.Failed("Argument_Error not raised by the Arccot function " &
+                       "with default Y parameter value, when the Cycle "   &
+                       "parameter is 0.0");
+         Dont_Optimize_Float(Float_Result, 10);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Incorrect exception raised by the Arccot "      &
+                          "function with default Y parameter value, when " &
+                          "provided a 0.0 cycle parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arccot(X => Pi, Y => 1.0, Cycle => 0.0);
+         Report.Failed("Argument_Error not raised by the Arccot function " &
+                       "when the Cycle parameter is 0.0");
+         Dont_Optimize_New_Float(New_Float_Result, 11);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Incorrect exception raised by the Arccot "     &
+                          "function when provided a 0.0 cycle parameter " &
+                          "value");
+      end;
+
+      begin
+         Float_Result := EF.Arccot(X => Pi, Cycle => -360.0); 
+         Report.Failed("Argument_Error not raised by the Arccot function " &
+                       "with a default Y parameter value, when the Cycle " &
+                       "parameter is -360.0");
+         Dont_Optimize_Float(Float_Result, 12);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Incorrect exception raised by the Arccot "        &
+                          "function with a default Y parameter value, when " & 
+                          "provided a -360.0 cycle parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arccot(X => Pi, Y => 1.0, Cycle => -Pi);
+         Report.Failed("Argument_Error not raised by the Arccot function " &
+                       "when the Cycle parameter is -Pi");
+         Dont_Optimize_New_Float(New_Float_Result, 13);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Incorrect exception raised by the Arccot "     &
+                          "function when provided a -Pi cycle parameter " &
+                          "value");
+      end;
+
+
+      -- Check that no exception is raised by the Arccot function with 
+      -- specified Cycle parameter, when provided large and small positive
+      -- or negative parameter values for both X and Y input parameters. 
+
+      begin
+         Float_Result := EF.Arccot(X     => -FXA5A00.Large, 
+                                   Y     => -FXA5A00.Large,
+--pwb-math  Next line: changed 2.0*Pi to 360.0
+                                   Cycle => 360.0);
+         Dont_Optimize_Float(Float_Result, 14);
+      exception
+         when others =>  
+            Report.Failed("Exception raised when the Arccot function with " &
+                          "specified Cycle parameter, when provided large " & 
+                          "negative X and Y parameter values");
+      end;
+
+
+      begin
+         New_Float_Result := GEF.Arccot(New_Float(FXA5A00.Large), 
+                                        Y     => New_Float(-FXA5A00.Small),
+--pwb-math  Next line: changed 2.0*Pi to 360.0
+                                        Cycle => 360.0);
+         Dont_Optimize_New_Float(New_Float_Result, 15);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function with "  &
+                          "specified Cycle parameter, when provided large "  & 
+                          "positive X parameter value and a small negative " &
+                          "Y parameter value");
+      end;
+
+
+      begin
+         Float_Result := EF.Arccot(X     => -FXA5A00.Small, 
+                                   Y     => -FXA5A00.Large,
+--pwb-math  Next line: changed 2.0*Pi to 360.0
+                                   Cycle => 360.0);
+         Dont_Optimize_Float(Float_Result, 16);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function with "  &
+                          "specified Cycle parameter, when provided small "  & 
+                          "negative X parameter value and a large negative " &
+                          "Y parameter value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Arccot(New_Float(FXA5A00.Small), 
+                                        New_Float(FXA5A00.Large), 
+--pwb-math  Next line: changed 2.0*Pi to 360.0
+                                        360.0);
+         Dont_Optimize_New_Float(New_Float_Result, 17);
+      exception
+         when others => 
+            Report.Failed("Exception raised when the Arccot function with " &
+                          "specified Cycle parameter, when provided a "     & 
+                          "small positive X parameter value and a large "   &
+                          "positive Y parameter value");
+      end;
+
+
+      -- Check that the Arccot function with specified Cycle parameter 
+      -- provides correct results when provided a variety of X parameter
+      -- input values.
+
+      if not FXA5A00.Result_Within_Range(GEF.Arccot( 0.0, Cycle => 360.0),
+                                         90.0, 
+                                         0.001) or
+         not FXA5A00.Result_Within_Range(EF.Arccot( 0.0, Cycle => 100.0),
+                                         25.0,
+                                         0.001) or
+         not FXA5A00.Result_Within_Range(GEF.Arccot( 1.0, Cycle => 360.0),
+                                         45.0,
+                                         0.001) or
+         not FXA5A00.Result_Within_Range(EF.Arccot( 1.0, Cycle => 100.0),
+                                         12.5,
+                                         0.001) or
+         not FXA5A00.Result_Within_Range(GEF.Arccot(-1.0, Cycle => 360.0),
+                                         135.0,
+                                         0.001) or
+         not FXA5A00.Result_Within_Range(EF.Arccot(-1.0, Cycle => 100.0),
+                                         37.5,
+                                         0.001)
+      then
+         Report.Failed("Incorrect results from the Arccot function with "   &
+                       "specified Cycle parameter when provided a variety " &
+                       "of X parameter values");
+      end if;
+
+
+      if not FXA5A00.Result_Within_Range(EF.Arccot(0.2425355, 0.9701420),
+                                         EF.Arccot(0.25),
+                                         0.01) or
+         not FXA5A00.Result_Within_Range(EF.Arccot(0.3162277, 0.9486831),
+                                         Ef.Arccot(0.33),
+                                         0.01)
+      then
+         Report.Failed("Incorrect results from the Arccot function with " &
+                       "comparison to other Arccot function results");
+      end if;
+
+
+      if not FXA5A00.Result_Within_Range(EF.Cot(EF.Arccot(0.4472135,
+                                                          0.8944270)),
+                                         0.5,
+                                         0.01) or
+         not FXA5A00.Result_Within_Range(EF.Cot(EF.Arccot(0.9987380, 
+                                                          0.0499369)),
+                                         20.0,
+                                         0.1)
+      then
+         Report.Failed("Incorrect results from the Arccot function when " &
+                       "used as argument to Cot function");
+      end if;
+
+
+      -- Check that inverse function results are correct.
+      -- Default Cycle test.
+
+      Angle := 0.001;
+      while Angle < Pi and not Incorrect_Inverse loop
+         if not Result_Within_Range(EF.Arccot(EF.Cot(Angle)), Angle, 0.001)
+         then
+            Incorrect_Inverse := True;
+         end if;
+         Angle := Angle + 0.001;
+      end loop;
+
+      if Incorrect_Inverse then
+         Report.Failed("Incorrect results returned from the Inverse "    &
+                       "comparison of Cot and Arccot using the default " &
+                       "cycle value");
+         Incorrect_Inverse := False;
+      end if;
+
+      -- Non-Default Cycle test.
+
+      New_Float_Angle := 0.01;
+      while New_Float_Angle < 180.0 and not Incorrect_Inverse loop
+         if not Result_Within_Range(EF.Arccot(EF.Cot(Float(New_Float_Angle), 
+                                                     Cycle => 360.0), 
+                                              Cycle => 360.0),
+                                    Float(New_Float_Angle),
+                                    0.01)  or
+            not Result_Within_Range(GEF.Arccot(
+                                       New_Float(GEF.Cot(New_Float_Angle, 
+                                                         Cycle => 360.0)), 
+                                       Cycle => 360.0),
+                                    Float(New_Float_Angle),
+                                    0.01)  
+         then
+            Incorrect_Inverse := True;
+         end if;
+         New_Float_Angle := New_Float_Angle + 0.01;
+      end loop;
+
+      if Incorrect_Inverse then
+         Report.Failed("Incorrect results returned from the Inverse "    &
+                       "comparison of Cot and Arccot using non-default " &
+                       "cycle value");
+      end if;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5A08;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a
new file mode 100644
index 000000000..22bd2f890
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a09.a
@@ -0,0 +1,400 @@
+-- CXA5A09.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 function Log provides correct results.
+--
+-- TEST DESCRIPTION:
+--      This test examines both the version of Log resulting from the 
+--      instantiation of the Ada.Numerics.Generic_Elementary_Functions with 
+--      with a type derived from type Float,as well as the preinstantiated
+--      version of this package for type Float.
+--      Prescribed results, including instances prescribed to raise 
+--      exceptions, are examined in the test cases.  In addition, 
+--      certain evaluations are performed where the actual function result 
+--      is compared with the expected result (within an epsilon range of 
+--      accuracy).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXA5A00.A   (foundation code)
+--         CXA5A09.A
+--
+--
+-- CHANGE HISTORY:
+--      11 Apr 95   SAIC    Initial prerelease version.
+--      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
+--                          use of Result_Within_Range function overloaded for
+--                          FXA5A00.New_Float_Type.
+--      29 Jun 98   EDS     Protected exception tests by first testing
+--                          for 'Machine_Overflows
+--
+--!
+
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Elementary_Functions;
+with FXA5A00;
+with Report;
+
+procedure CXA5A09 is
+begin
+
+   Report.Test ("CXA5A09", "Check that the Log function provides " &
+                           "correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Numerics;
+      use FXA5A00;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
+      package  EF renames Ada.Numerics.Elementary_Functions;
+
+      Arg,
+      Float_Result     : Float     := 0.0;
+      New_Float_Result : New_Float := 0.0;
+
+      Incorrect_Inverse,
+      Incorrect_Inverse_Base_2,
+      Incorrect_Inverse_Base_8,
+      Incorrect_Inverse_Base_10,
+      Incorrect_Inverse_Base_16  : Boolean   := False;
+
+      procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
+      procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
+
+   begin
+
+      -- Testing of Log Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that Argument_Error is raised when the parameter X is negative.
+
+      begin
+         New_Float_Result := GEF.Log(X => -1.0);
+         Report.Failed("Argument_Error not raised by the Log function " &
+                       "when the input parameter is negative");
+         Dont_Optimize_New_Float(New_Float_Result, 1);
+      exception
+         when Argument_Error => null; -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Log function " &
+                          "when the input parameter is negative");
+      end;
+
+      begin
+         Float_Result := EF.Log(X => -FXA5A00.Large);
+         Report.Failed("Argument_Error not raised by the Log function " &
+                       "when the input parameter is negative");
+         Dont_Optimize_Float(Float_Result, 2);
+      exception
+         when Argument_Error => null; -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the Log function " &
+                          "when the input parameter is negative");
+      end;
+
+
+      -- Check that Constraint_Error is raised when the Log function is 
+      -- provided an input parameter of zero.
+
+      if New_Float'Machine_Overflows = True then
+         begin
+            New_Float_Result := GEF.Log(X => 0.0);
+            Report.Failed("Constraint_Error not raised by the Log function " &
+                          "when the input parameter is zero");
+            Dont_Optimize_New_Float(New_Float_Result, 3);
+         exception
+            when Constraint_Error => null; -- OK, expected exception.
+            when others         =>
+               Report.Failed("Unexpected exception raised by the Log function "
+                             & "when the input parameter is zero");
+         end;
+      end if;
+      
+
+      -- Check for the reference manual prescribed results of the Log function.
+
+      if GEF.Log(X => 1.0) /= 0.0 or
+          EF.Log(X => 1.0) /= 0.0
+      then
+         Report.Failed("Incorrect result from Function Log when provided " &
+                       "an input parameter value of 1.0");
+      end if;
+
+
+      -- Check that the Log function provides correct results when provided
+      -- a variety of input parameters.
+
+      if not FXA5A00.Result_Within_Range(GEF.Log(0.015),   -4.20,  0.01)  or
+         not FXA5A00.Result_Within_Range(GEF.Log(0.592),   -0.524, 0.001) or
+         not FXA5A00.Result_Within_Range(GEF.Log(0.997),   -0.003, 0.001) or
+         not FXA5A00.Result_Within_Range(GEF.Log(1.341),    0.293, 0.001) or
+         not FXA5A00.Result_Within_Range( EF.Log(2.826),    1.04,  0.01)  or
+         not FXA5A00.Result_Within_Range( EF.Log(10.052),   2.31,  0.01)  or
+         not FXA5A00.Result_Within_Range( EF.Log(2569.143), 7.85,  0.01)
+      then
+         Report.Failed("Incorrect results from Function Log when provided " &
+                       "a variety of input parameter values");
+      end if;
+
+      Arg := 0.001;
+      while Arg < 1.0 and not Incorrect_Inverse loop
+         if not Result_Within_Range(EF."**"(e,EF.Log(Arg)), Arg, 0.001) then
+            Incorrect_Inverse := True;
+         end if;
+         Arg := Arg + 0.001;
+      end loop;
+
+      if Incorrect_Inverse then
+         Report.Failed("Incorrect inverse result comparing ""**"" and " &
+                       "Log function over argument range 0.001..1.0");
+         Incorrect_Inverse := False;
+      end if;
+
+      Arg := 1.0;
+      while Arg < 10.0 and not Incorrect_Inverse loop
+         if not Result_Within_Range(EF."**"(e,EF.Log(Arg)), Arg, 0.01) then
+            Incorrect_Inverse := True;
+         end if;
+         Arg := Arg + 0.01;
+      end loop;
+
+      if Incorrect_Inverse then
+         Report.Failed("Incorrect inverse result comparing ""**"" and " &
+                       "Log function over argument range 1.0..10.0");
+         Incorrect_Inverse := False;
+      end if;
+
+      Arg := 1.0;
+      while Arg < 1000.0 and not Incorrect_Inverse loop
+         if not Result_Within_Range(EF."**"(e,EF.Log(Arg)), Arg, 0.1) then
+            Incorrect_Inverse := True;
+         end if;
+         Arg := Arg + 1.0;
+      end loop;
+
+      if Incorrect_Inverse then
+         Report.Failed("Incorrect inverse result comparing ""**"" and " &
+                       "Log function over argument range 1.0..1000.0");
+      end if;
+
+
+      -- Testing of Log Function, with specified Base parameter, both 
+      -- instantiated and pre-instantiated versions.
+
+      -- Check that Argument_Error is raised by the Log function with 
+      -- specified Base parameter, when the X parameter value is negative.
+
+      begin
+         New_Float_Result := GEF.Log(X => -1.0, Base => 16.0);
+         Report.Failed("Argument_Error not raised by the Log function " &
+                       "with Base parameter, when the input parameter " &
+                       "value is -1.0");
+         Dont_Optimize_New_Float(New_Float_Result, 4);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         => 
+            Report.Failed("Unexpected exception raised by the Log function " &
+                          "with Base parameter, when the X parameter value " &
+                          "is -1.0");
+      end;
+
+      begin
+         Float_Result := EF.Log(X => -FXA5A00.Large, Base => 8.0);
+         Report.Failed("Argument_Error not raised by the Log function " &
+                       "with Base parameter, when the X parameter "     &
+                       "value is a large negative value");
+         Dont_Optimize_Float(Float_Result, 5);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         => 
+            Report.Failed("Unexpected exception raised by the Log function " &
+                          "with Base parameter, when the X parameter "       &
+                          "value is a large negative value");
+      end;
+
+
+      -- Check that Argument_Error is raised by the Log function when 
+      -- the specified Base parameter is zero.
+
+      begin
+         New_Float_Result := GEF.Log(X => 10.0, Base => 0.0);
+         Report.Failed("Argument_Error not raised by the Log function " &
+                       "with Base parameter of 0.0");
+         Dont_Optimize_New_Float(New_Float_Result, 6);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         => 
+            Report.Failed("Unexpected exception raised by the Log function " &
+                          "with Base parameter of 0.0");
+      end;
+
+
+      -- Check that Argument_Error is raised by the Log function when 
+      -- the specified Base parameter is one.
+
+      begin
+         Float_Result := EF.Log(X => 12.3, Base => 1.0);
+         Report.Failed("Argument_Error not raised by the Log function " &
+                       "with Base parameter of 1.0");
+         Dont_Optimize_Float(Float_Result, 7);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         => 
+            Report.Failed("Unexpected exception raised by the Log function " &
+                          "with Base parameter of 1.0");
+      end;
+
+
+      -- Check that Argument_Error is raised by the Log function when 
+      -- the specified Base parameter is negative.
+
+      begin
+         New_Float_Result := GEF.Log(X => 12.3, Base => -10.0);
+         Report.Failed("Argument_Error not raised by the Log function " &
+                       "with negative Base parameter");
+         Dont_Optimize_New_Float(New_Float_Result, 8);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         => 
+            Report.Failed("Unexpected exception raised by the Log function " &
+                          "with negative Base parameter");
+      end;
+
+
+      -- Check that Constraint_Error is raised by the Log function when the
+      -- input X parameter value is 0.0.
+
+      if New_Float'Machine_Overflows = True then
+         begin
+            New_Float_Result := GEF.Log(X => 0.0, Base => 16.0);
+            Report.Failed("Constraint_Error not raised by the Log function "  &
+                          "with specified Base parameter, when the value of " &
+                          "the parameter X is 0.0");
+            Dont_Optimize_New_Float(New_Float_Result, 9);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by Function Log"    &
+                             "with specified Base parameter, when the value " &
+                             "of the parameter X is 0.0");
+         end;
+      end if;
+
+      -- Check for the prescribed results of the Log function with specified
+      -- Base parameter.
+
+      if GEF.Log(X => 1.0, Base => 16.0) /= 0.0 or
+          EF.Log(X => 1.0, Base => 10.0) /= 0.0 or
+         GEF.Log(1.0, Base => 8.0)       /= 0.0 or
+          EF.Log(1.0, 2.0)               /= 0.0
+      then
+         Report.Failed("Incorrect result from Function Log with specified " &
+                       "Base parameter when provided an parameter X input " &
+                       "value of 1.0");
+      end if;
+
+
+      -- Check that the Log function with specified Base parameter provides 
+      -- correct results when provided a variety of input parameters.
+
+      if not Result_Within_Range(GEF.Log( 10.0,  e),     2.30,  0.01)  or
+         not Result_Within_Range( EF.Log(  8.0,  2.0),   3.0,   0.01)  or
+         not Result_Within_Range(GEF.Log(256.0,  2.0),   8.0,   0.01)  or
+         not Result_Within_Range( EF.Log(512.0,  8.0),   3.0,   0.01)  or
+         not Result_Within_Range(GEF.Log(0.5649, e),    -0.57,  0.01)  or
+         not Result_Within_Range( EF.Log(1.7714, e),     0.57,  0.01)  or
+         not Result_Within_Range(GEF.Log(0.5718, 10.0), -0.243, 0.001) or
+         not Result_Within_Range( EF.Log(466.25, 10.0),  2.67,  0.01) 
+      then
+         Report.Failed("Incorrect results from Function Log with specified " &
+                       "Base parameter, when provided a variety of input "   &
+                       "parameter values");
+      end if;
+
+
+      Arg := 1.0;
+      while Arg < 1000.0 and 
+            not (Incorrect_Inverse_Base_2  and Incorrect_Inverse_Base_8 and
+                 Incorrect_Inverse_Base_10 and Incorrect_Inverse_Base_16) 
+      loop
+         if not FXA5A00.Result_Within_Range(EF."**"(2.0,EF.Log(Arg,2.0)),
+                                            Arg,
+                                            0.001) 
+         then
+            Incorrect_Inverse_Base_2 := True;
+         end if;
+         if not FXA5A00.Result_Within_Range(EF."**"(8.0,EF.Log(Arg,8.0)),
+                                            Arg,
+                                            0.001) 
+         then
+            Incorrect_Inverse_Base_8 := True;
+         end if;
+         if not FXA5A00.Result_Within_Range(EF."**"(10.0,EF.Log(Arg,10.0)),
+                                            Arg,
+                                            0.001) 
+         then
+            Incorrect_Inverse_Base_10 := True;
+         end if;
+         if not FXA5A00.Result_Within_Range(EF."**"(16.0,EF.Log(Arg,16.0)), 
+                                            Arg,
+                                            0.001) 
+         then
+            Incorrect_Inverse_Base_16 := True;
+         end if;
+         Arg := Arg + 1.0;
+      end loop;
+
+      if Incorrect_Inverse_Base_2 then
+         Report.Failed("Incorrect inverse result comparing ""**"" and " &
+                       "Log function for Base 2");
+      end if;
+
+      if Incorrect_Inverse_Base_8 then
+         Report.Failed("Incorrect inverse result comparing ""**"" and " &
+                       "Log function for Base 8");
+      end if;
+
+      if Incorrect_Inverse_Base_10 then
+         Report.Failed("Incorrect inverse result comparing ""**"" and " &
+                       "Log function for Base 10");
+      end if;
+
+      if Incorrect_Inverse_Base_16 then
+         Report.Failed("Incorrect inverse result comparing ""**"" and " &
+                       "Log function for Base 16");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5A09;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a
new file mode 100644
index 000000000..4804d6729
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa5a10.a
@@ -0,0 +1,551 @@
+-- CXA5A10.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 functions Exp and Sqrt, and the exponentiation
+--      operator "**" provide correct results.
+--
+-- TEST DESCRIPTION:
+--      This test examines both the versions of Exp, Sqrt, and "**"
+--      resulting from the instantiation of the
+--      Ada.Numerics.Generic_Elementary_Functions with a type derived from
+--      type Float, as well as the preinstantiated version of this package
+--      for type Float.
+--      Prescribed results (stated as such in the reference manual),
+--      including instances prescribed to raise exceptions, are examined
+--      in the test cases.  In addition, certain evaluations are performed
+--      for the preinstantiated package where the actual function result is
+--      compared with the expected result (within an epsilon range of
+--      accuracy).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXA5A00.A   (foundation code)
+--         CXA5A10.A
+--
+--
+-- CHANGE HISTORY:
+--      17 Apr 95   SAIC    Initial prerelease version.
+--      13 Jun 95   SAIC    Incorporated use of Dont_Optimize procedure, and
+--                          use of Result_Within_Range function overloaded for
+--                          FXA5A00.New_Float_Type.
+--      18 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      01 Oct 01   RLB     Protected Constraint_Error exception tests by
+--                          first testing for 'Machine_Overflows.
+--
+--!
+
+with Ada.Exceptions;
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Elementary_Functions;
+with FXA5A00;
+with Report;
+
+procedure CXA5A10 is
+begin
+
+   Report.Test ("CXA5A10", "Check that Exp, Sqrt, and the ""**"" operator " &
+                           "provide correct results");
+
+   Test_Block:
+   declare
+
+      use FXA5A00, Ada.Numerics;
+      use Ada.Exceptions;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions(New_Float);
+      package  EF renames Ada.Numerics.Elementary_Functions;
+
+      use GEF, EF;
+
+      Arg,
+      Float_Result     : Float;
+      New_Float_Result : New_Float;
+
+      Flag_1, Flag_2, Flag_3, Flag_4,
+      Incorrect_Inverse_Base_e,
+      Incorrect_Inverse_Base_2,
+      Incorrect_Inverse_Base_8,
+      Incorrect_Inverse_Base_10,
+      Incorrect_Inverse_Base_16        : Boolean := False;
+
+      procedure Dont_Optimize_Float     is new Dont_Optimize(Float);
+      procedure Dont_Optimize_New_Float is new Dont_Optimize(New_Float);
+
+   begin
+
+      -- Testing of the "**" operator, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that Argument_Error is raised by the exponentiation operator
+      -- when the value of the Left parameter (operand) is negative.
+
+      begin
+         New_Float_Result := GEF."**"(Left  => -10.0,
+                                      Right =>   2.0);
+         Report.Failed("Argument_Error not raised by the instantiated "   &
+                       "version of the exponentiation operator when the " &
+                       "value of the Left parameter is negative");
+         Dont_Optimize_New_Float(New_Float_Result, 1);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the "            &
+                          "instantiated version of the exponentiation "    &
+                          "operator when the value of the Left parameter " &
+                          "is negative");
+      end;
+
+      begin
+         Float_Result := (-FXA5A00.Small) ** 4.0;
+         Report.Failed("Argument_Error not raised by the preinstantiated " &
+                       "version of the exponentiation operator when the "  &
+                       "value of the Left parameter is negative");
+         Dont_Optimize_Float(Float_Result, 2);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the "            &
+                          "preinstantiated version of the exponentiation " &
+                          "operator when the value of the Left parameter " &
+                          "is negative");
+      end;
+
+
+      -- Check that Argument_Error is raised by the exponentiation operator
+      -- when both parameters (operands) have the value 0.0.
+
+      begin
+         New_Float_Result := GEF."**"(0.0, Right => 0.0);
+         Report.Failed("Argument_Error not raised by the instantiated " &
+                       "version of the exponentiation operator when "   &
+                       "both operands are zero");
+         Dont_Optimize_New_Float(New_Float_Result, 3);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the "         &
+                          "instantiated version of the exponentiation " &
+                          "operator when both operands are zero");
+      end;
+
+      begin
+         Float_Result := 0.0**0.0;
+         Report.Failed("Argument_Error not raised by the preinstantiated " &
+                       "version of the exponentiation operator when both " &
+                       "operands are zero");
+         Dont_Optimize_Float(Float_Result, 4);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by the "            &
+                          "preinstantiated version of the exponentiation " &
+                          "operator when both operands are zero");
+      end;
+
+
+      -- Check that Constraint_Error is raised by the exponentiation
+      -- operator when the value of the left parameter (operand) is zero,
+      -- and the value of the right parameter (exponent) is negative.
+      -- This check applies only if Machine_Overflows is true [A.5.1(28, 30)].
+
+      if New_Float'Machine_Overflows = True then
+         begin
+            New_Float_Result := GEF."**"(0.0, Right => -2.0);
+            Report.Failed("Constraint_Error not raised by the instantiated " &
+                          "version of the exponentiation operator when "     &
+                          "the left parameter is 0.0, and the right "        &
+                          "parameter is negative");
+            Dont_Optimize_New_Float(New_Float_Result, 5);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by the "         &
+                             "instantiated version of the exponentiation " &
+                             "operator when the left parameter is 0.0, "   &
+                             "and the right parameter is negative");
+         end;
+      end if;
+
+      if Float'Machine_Overflows = True then
+         begin
+            Float_Result := 0.0 ** (-FXA5A00.Small);
+            Report.Failed("Constraint_Error not raised by the " &
+                          "preinstantiated version of the exponentiation " &
+                          "operator when the left parameter is 0.0, and the " &
+                          "right parameter is negative");
+            Dont_Optimize_Float(Float_Result, 6);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Unexpected exception raised by the "            &
+                             "preinstantiated version of the exponentiation " &
+                             "operator when the left parameter is 0.0, and "  &
+                             "the right parameter is negative");
+         end;
+      end if;
+
+      -- Prescribed results.
+      -- Check that exponentiation by a 0.0 exponent yields the value one.
+
+      if GEF."**"(Left => 10.0,  Right => 0.0) /= 1.0 or
+          EF."**"(FXA5A00.Large, Right => 0.0) /= 1.0 or
+         GEF."**"(3.0, 0.0)                    /= 1.0 or
+          FXA5A00.Small ** 0.0                 /= 1.0
+      then
+         Report.Failed("Incorrect results returned from the ""**"" " &
+                       "operator when the value of the exponent is 0.0");
+      end if;
+
+
+      -- Check that exponentiation by a unit exponent yields the value
+      -- of the left operand.
+
+      if GEF."**"(Left => 50.0,  Right => 1.0) /= 50.0          or
+          EF."**"(FXA5A00.Large, Right => 1.0) /= FXA5A00.Large or
+         GEF."**"(6.0, 1.0)                    /= 6.0           or
+          FXA5A00.Small ** 1.0                 /= FXA5A00.Small
+      then
+         Report.Failed("Incorrect results returned from the ""**"" " &
+                       "operator when the value of the exponent is 1.0");
+      end if;
+
+
+      -- Check that exponentiation of the value 1.0 yields the value 1.0.
+
+      if GEF."**"(Left => 1.0, Right => 16.0)   /=  1.0 or
+          EF."**"(1.0, Right => FXA5A00.Large)  /=  1.0 or
+         GEF."**"(1.0, 3.0)                     /=  1.0 or
+          1.0 ** FXA5A00.Small                  /=  1.0
+      then
+         Report.Failed("Incorrect results returned from the ""**"" " &
+                       "operator when the value of the operand is 1.0");
+      end if;
+
+
+      -- Check that exponentiation of the value 0.0 yields the value 0.0.
+
+      if GEF."**"(Left => 0.0, Right => 10.0)   /=  0.0 or
+          EF."**"(0.0, Right => FXA5A00.Large)  /=  0.0 or
+         GEF."**"(0.0, 4.0)                     /=  0.0 or
+          0.0 ** FXA5A00.Small                  /=  0.0
+      then
+         Report.Failed("Incorrect results returned from the ""**"" " &
+                       "operator when the value of the operand is 0.0");
+      end if;
+
+
+      -- Check that exponentiation of various operands with a variety of
+      -- of exponent values yield correct results.
+
+      if not Result_Within_Range(GEF."**"(5.0,   2.0),  25.0,   0.01)  or
+         not Result_Within_Range(GEF."**"(1.225, 1.5),   1.36,  0.01)  or
+         not Result_Within_Range(GEF."**"(0.26,  2.0),   0.068, 0.001) or
+         not Result_Within_Range( EF."**"(e,     5.0), 148.4,   0.1)   or
+         not Result_Within_Range( EF."**"(10.0,  e),   522.7,   0.1)   or
+         not Result_Within_Range( EF."**"(e,   (-3.0)),  0.050, 0.001) or
+         not Result_Within_Range(GEF."**"(10.0,(-2.0)),  0.010, 0.001)
+      then
+         Report.Failed("Incorrect results returned from the ""**"" "       &
+                       "operator with a variety of  operand and exponent " &
+                       "values");
+      end if;
+
+
+      -- Use the following loops to check for internal consistency between
+      -- inverse functions.
+
+      declare
+         -- Use the relative error value to account for non-exact
+         -- computations.
+         TC_Relative_Error: Float := 0.005;
+      begin
+         for i in 1..5 loop
+            for j in 0..5 loop
+               if not Incorrect_Inverse_Base_e and
+                  not FXA5A00.Result_Within_Range
+                        (Float(i)**Float(j),
+                         e**(Float(j)*EF.Log(Float(i))),
+                         TC_Relative_Error)
+               then
+                  Incorrect_Inverse_Base_e := True;
+                  Report.Failed("Incorrect Log-** Inverse calc for Base e " &
+                                "with i= " & Integer'Image(i) & "  and j= " &
+                                Integer'Image(j));
+               end if;
+               if not Incorrect_Inverse_Base_2 and
+                  not FXA5A00.Result_Within_Range
+                        (Float(i)**Float(j),
+                         2.0**(Float(j)*EF.Log(Float(i),2.0)),
+                         TC_Relative_Error)
+               then
+                  Incorrect_Inverse_Base_2 := True;
+                  Report.Failed("Incorrect Log-** Inverse calc for Base 2 " &
+                                "with i= " & Integer'Image(i) & "  and j= " &
+                                Integer'Image(j));
+               end if;
+               if not Incorrect_Inverse_Base_8 and
+                  not FXA5A00.Result_Within_Range
+                        (Float(i)**Float(j),
+                         8.0**(Float(j)*EF.Log(Float(i),8.0)),
+                         TC_Relative_Error)
+               then
+                  Incorrect_Inverse_Base_8 := True;
+                  Report.Failed("Incorrect Log-** Inverse calc for Base 8 " &
+                                "with i= " & Integer'Image(i) & "  and j= " &
+                                Integer'Image(j));
+               end if;
+               if not Incorrect_Inverse_Base_10 and
+                  not FXA5A00.Result_Within_Range
+                        (Float(i)**Float(j),
+                         10.0**(Float(j)*EF.Log(Float(i),10.0)),
+                         TC_Relative_Error)
+               then
+                  Incorrect_Inverse_Base_10 := True;
+                  Report.Failed("Incorrect Log-** Inverse calc for Base 10 " &
+                                "with i= " & Integer'Image(i) & "   and j= " &
+                                Integer'Image(j));
+               end if;
+               if not Incorrect_Inverse_Base_16 and
+                  not FXA5A00.Result_Within_Range
+                        (Float(i)**Float(j),
+                         16.0**(Float(j)*EF.Log(Float(i),16.0)),
+                         TC_Relative_Error)
+               then
+                  Incorrect_Inverse_Base_16 := True;
+                  Report.Failed("Incorrect Log-** Inverse calc for Base 16 " &
+                                "with i= " & Integer'Image(i) & "   and j= " &
+                                Integer'Image(j));
+               end if;
+            end loop;
+         end loop;
+      end;
+
+      -- Reset Flags.
+      Incorrect_Inverse_Base_e  := False;
+      Incorrect_Inverse_Base_2  := False;
+      Incorrect_Inverse_Base_8  := False;
+      Incorrect_Inverse_Base_10 := False;
+      Incorrect_Inverse_Base_16 := False;
+
+
+      -- Testing of Exp Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that the result of the Exp Function, when provided an X
+      -- parameter value of 0.0, is 1.0.
+
+      if GEF.Exp(X => 0.0) /= 1.0 or
+          EF.Exp(0.0)      /= 1.0
+      then
+         Report.Failed("Incorrect result returned by Function Exp when " &
+                       "given a parameter value of 0.0");
+      end if;
+
+
+      -- Check that the Exp Function provides correct results when provided
+      -- a variety of input parameter values.
+
+      if not Result_Within_Range(GEF.Exp(0.001),    1.01,  0.01)  or
+         not Result_Within_Range( EF.Exp(0.1),      1.11,  0.01)  or
+         not Result_Within_Range(GEF.Exp(1.2697),   3.56,  0.01)  or
+         not Result_Within_Range( EF.Exp(3.2525),  25.9,   0.1)   or
+         not Result_Within_Range(GEF.Exp(-0.2198),  0.803, 0.001) or
+         not Result_Within_Range( EF.Exp(-1.6621),  0.190, 0.001) or
+         not Result_Within_Range(GEF.Exp(-2.3888),  0.092, 0.001) or
+         not Result_Within_Range( EF.Exp(-5.4415),  0.004, 0.001)
+      then
+         Report.Failed("Incorrect result from Function Exp when provided " &
+                       "a variety of input parameter values");
+      end if;
+
+      -- Use the following loops to check for internal consistency between
+      -- inverse functions.
+
+      Arg := 0.01;
+      while Arg < 10.0 loop
+         if not Incorrect_Inverse_Base_e and
+            FXA5A00.Result_Within_Range(EF.Exp(Arg),
+                                        e**(Arg*EF.Log(Arg)),
+                                        0.001)
+         then
+            Incorrect_Inverse_Base_e := True;
+            Report.Failed("Incorrect Exp-** Inverse calc for Base e");
+         end if;
+         if not Incorrect_Inverse_Base_2 and
+            FXA5A00.Result_Within_Range(EF.Exp(Arg),
+                                        2.0**(Arg*EF.Log(Arg,2.0)),
+                                        0.001)
+         then
+            Incorrect_Inverse_Base_2 := True;
+            Report.Failed("Incorrect Exp-** Inverse calc for Base 2");
+         end if;
+         if not Incorrect_Inverse_Base_8 and
+            FXA5A00.Result_Within_Range(EF.Exp(Arg),
+                                        8.0**(Arg*EF.Log(Arg,8.0)),
+                                        0.001)
+         then
+            Incorrect_Inverse_Base_8 := True;
+            Report.Failed("Incorrect Exp-** Inverse calc for Base 8");
+         end if;
+         if not Incorrect_Inverse_Base_10 and
+            FXA5A00.Result_Within_Range(EF.Exp(Arg),
+                                        10.0**(Arg*EF.Log(Arg,10.0)),
+                                        0.001)
+         then
+            Incorrect_Inverse_Base_10 := True;
+            Report.Failed("Incorrect Exp-** Inverse calc for Base 10");
+         end if;
+         if not Incorrect_Inverse_Base_16 and
+            FXA5A00.Result_Within_Range(EF.Exp(Arg),
+                                        16.0**(Arg*EF.Log(Arg,16.0)),
+                                        0.001)
+         then
+            Incorrect_Inverse_Base_16 := True;
+            Report.Failed("Incorrect Exp-** Inverse calc for Base 16");
+         end if;
+         Arg := Arg + 0.01;
+      end loop;
+
+
+      -- Testing of Sqrt Function, both instantiated and pre-instantiated
+      -- version.
+
+      -- Check that Argument_Error is raised by the Sqrt Function when
+      -- the value of the input parameter X is negative.
+
+      begin
+         Float_Result := EF.Sqrt(X => -FXA5A00.Small);
+         Report.Failed("Argument_Error not raised by Function Sqrt "     &
+                       "when provided a small negative input parameter " &
+                       "value");
+         Dont_Optimize_Float(Float_Result, 7);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by Function Sqrt "   &
+                          "when provided a small negative input parameter " &
+                          "value");
+      end;
+
+      begin
+         New_Float_Result := GEF.Sqrt(X => -64.0);
+         Report.Failed("Argument_Error not raised by Function Sqrt "     &
+                       "when provided a large negative input parameter " &
+                       "value");
+         Dont_Optimize_New_Float(New_Float_Result, 8);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others         =>
+            Report.Failed("Unexpected exception raised by Function Sqrt "   &
+                          "when provided a large negative input parameter " &
+                          "value");
+      end;
+
+
+      -- Check that the Sqrt Function, when given an X parameter value of 0.0,
+      -- returns a result of 0.0.
+
+      if GEF.Sqrt(X => 0.0) /= 0.0 or
+          EF.Sqrt(0.0)      /= 0.0
+      then
+         Report.Failed("Incorrect result from Function Sqrt when provided " &
+                       "an input parameter value of 0.0");
+      end if;
+
+
+      -- Check that the Sqrt Function, when given an X parameter input value
+      -- of 1.0, returns a result of 1.0.
+
+      if GEF.Sqrt(X => 1.0) /= 1.0 or
+          EF.Sqrt(1.0)      /= 1.0
+      then
+         Report.Failed("Incorrect result from Function Sqrt when provided " &
+                       "an input parameter value of 1.0");
+      end if;
+
+
+      -- Check that the Sqrt Function provides correct results when provided
+      -- a variety of input parameter values.
+
+      if not FXA5A00.Result_Within_Range(GEF.Sqrt(0.0327),     0.181, 0.001) or
+         not FXA5A00.Result_Within_Range( EF.Sqrt(0.1808),     0.425, 0.001) or
+         not FXA5A00.Result_Within_Range(GEF.Sqrt(1.0556),     1.03,  0.01)  or
+         not FXA5A00.Result_Within_Range( EF.Sqrt(32.8208),    5.73,  0.01)  or
+         not FXA5A00.Result_Within_Range( EF.Sqrt(27851.0),  166.9,   0.1)   or
+         not FXA5A00.Result_Within_Range( EF.Sqrt(61203.4),  247.4,   0.1)   or
+         not FXA5A00.Result_Within_Range( EF.Sqrt(655891.0), 809.9,   0.1)
+      then
+         Report.Failed("Incorrect result from Function Sqrt when provided " &
+                       "a variety of input parameter values");
+      end if;
+
+      -- Check internal consistency between functions.
+
+      Arg := 0.01;
+      while Arg < 10.0 loop
+         if not Flag_1 and
+            not FXA5A00.Result_Within_Range(Arg,
+                                            EF.Sqrt(Arg)*EF.Sqrt(Arg),
+                                            0.01)
+         then
+            Report.Failed("Inconsistency found in Case 1");
+            Flag_1 := True;
+         end if;
+         if not Flag_2 and
+            not FXA5A00.Result_Within_Range(Arg, EF.Sqrt(Arg)**2.0, 0.01)
+         then
+            Report.Failed("Inconsistency found in Case 2");
+            Flag_2 := True;
+         end if;
+         if not Flag_3 and
+            not FXA5A00.Result_Within_Range(EF.Log(Arg),
+                                            EF.Log(Sqrt(Arg)**2.0), 0.01)
+         then
+            Report.Failed("Inconsistency found in Case 3");
+            Flag_3 := True;
+         end if;
+         if not Flag_4 and
+            not FXA5A00.Result_Within_Range(EF.Log(Arg),
+                                            2.00*EF.Log(EF.Sqrt(Arg)),
+                                            0.01)
+         then
+            Report.Failed("Inconsistency found in Case 4");
+            Flag_4 := True;
+         end if;
+         Arg := Arg + 1.0;
+      end loop;
+
+
+   exception
+      when The_Error : others =>
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXA5A10;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa8001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa8001.a
new file mode 100644
index 000000000..16f30752d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa8001.a
@@ -0,0 +1,243 @@
+-- CXA8001.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 all elements to be transferred to a sequential file of
+--      mode Append_File will be placed following the last element currently
+--      in the file.  
+--      Check that it is possible to append data to a file that has been 
+--      previously appended to.
+--      Check that the predefined procedure Write will place an element after
+--      the last element in the file in mode Append_File.
+--
+-- TEST DESCRIPTION:
+--      This test implements a sequential file system that has the capability
+--      to store data records at the end of a file.  Initially, the file is 
+--      opened with mode Out_File, and data is written to the file.  The file
+--      is closed, then reopened with mode Append_File.  An additional record
+--      is written, and again the file is closed.  The file is then reopened,
+--      again with mode Append_File, and another record is written to the 
+--      file.
+--      The file is closed again, the reopened with mode In_File, and the data
+--      in the file is read and checked for proper ordering within the file.
+--
+--      An expected common usage of Append_File mode would be in the opening
+--      of a file that currently contains data.  Likewise, the reopening of
+--      files in Append_Mode that have been previously appended to for the
+--      addition of more data would be frequently encountered.  This test
+--      attempts to simulate both situations.  (Of course, in an actual user
+--      environment, the open/write/close processing would be performed using
+--      looping structures, rather than the straight-line processing displayed
+--      here.)
+--
+-- APPLICABILITY CRITERIA: 
+--      Applicable to all systems capable of supporting IO operations on 
+--      external Sequential_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Sequential_IO;
+with Report;
+
+procedure CXA8001 is
+
+   -- Declare data types and objects to be stored in the file.
+   subtype Name_Type is String (1 .. 10);
+   type    Tickets   is range 0 .. 1000;
+
+   type Order_Type is record
+      Name          : Name_Type;
+      No_of_Tickets : Tickets;
+   end record;
+   
+   package Order_IO is new Sequential_IO (Order_Type); -- Declare Seq_IO 
+                                                       -- package,
+   Order_File     : Order_IO.File_Type;                -- and file object.
+   Order_Filename : constant String := 
+                           Report.Legal_File_Name ( Nam => "CXA8001" );
+   Incomplete : exception;
+
+begin
+
+   Report.Test ("CXA8001", "Check that all elements to be transferred to a " &
+                           "sequential file of mode Append_File will be "    &
+                           "placed following the last element currently "    &
+                           "in the file");
+
+   Test_for_Sequential_IO_Support:
+   begin
+
+      -- An implementation that does not support Sequential_IO in a particular
+      -- environment will raise Use_Error or Name_Error on calls to various
+      -- Sequential_IO operations.  This block statement encloses a call to
+      -- Create, which should produce an exception in a non-supportive 
+      -- environment.  These exceptions will be handled to produce a
+      -- Not_Applicable result.
+
+      Order_IO.Create (File => Order_File,        -- Create Sequential_IO file 
+                       Mode => Order_IO.Out_File, -- with mode Out_File.
+                       Name => Order_Filename);
+
+   exception
+
+       when Order_IO.Use_Error | Order_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Sequential_IO" );
+          raise Incomplete;
+
+   end Test_for_Sequential_IO_Support;
+
+   Operational_Test_Block:
+   declare
+      -- Assign values into the component fields of the data objects.
+      Buyer_1 : constant Order_Type := ("John Smith", 3);
+      Buyer_2 : constant Order_Type := 
+                  (Name => "Jane Jones", No_of_Tickets => 2);
+      Buyer_3 : Order_Type := ("Mike Brown", 5);
+
+   begin
+      Order_IO.Write (File => Order_File,      -- Write initial data item 
+                      Item => Buyer_1);        -- to file.
+
+      Order_IO.Close (File => Order_File);     -- Close file.
+
+      --
+      -- Enter additional data records into the file.  (Append to a file of
+      -- previous mode Out_File).
+      --
+      Order_IO.Open (Order_File,               -- Open Sequential_IO file 
+                     Order_IO.Append_File,     -- with mode Append_File.
+                     Order_Filename);
+                                               
+      Order_IO.Write (Order_File, Buyer_2);    -- Write second data item 
+                                               -- to file.
+      Order_IO.Close (File => Order_File);     -- Close file.
+
+      -- Check to determine whether file is actually closed.
+      begin
+         Order_IO.Write (Order_File, Buyer_2);   
+         Report.Failed("Exception not raised on Write to Closed file");
+      exception
+         when Order_IO.Status_Error => null;   -- Expected exception.
+         when others                => 
+           Report.Failed("Incorrect exception on Write to Closed file");
+      end;
+
+      --
+      -- The following code segment demonstrates appending data to a file 
+      -- that has been previously appended to.
+      --
+
+      Order_IO.Open (Order_File,               -- Open Sequential_IO file 
+                     Order_IO.Append_File,     -- with mode Append_File.
+                     Order_Filename );
+
+      Order_IO.Write (Order_File, Buyer_3);    -- Write third data item 
+                                               -- to file.
+      Order_IO.Close (File => Order_File);     -- Close file.
+
+
+      Test_Verification_Block:
+      declare
+         TC_Order1, TC_Order2, TC_Order3 : Order_Type;
+      begin
+      
+         Order_IO.Open (Order_File,            -- Open Sequential_IO file 
+                        Order_IO.In_File,      -- with mode In_File.
+                        Order_Filename );
+
+         Order_IO.Read (File => Order_File,    -- Read records from file.
+                        Item => TC_Order1);       
+         Order_IO.Read (Order_File, TC_Order2);   
+         Order_IO.Read (Order_File, TC_Order3);   
+
+         -- Compare the contents of each with the individual data items.
+         -- If items read from file do not match the items placed into 
+         -- the file, in the appropriate order, then fail.
+
+         if ((TC_Order1 /= Buyer_1)               or
+             (TC_Order2.Name /= Buyer_2.Name)     or
+             (TC_Order2.No_of_Tickets /= Buyer_2.No_of_Tickets) or
+             not ((TC_Order3.Name = "Mike Brown") and
+                  (TC_Order3.No_of_Tickets = 5))) then
+            Report.Failed ("Incorrect appending of record data in file");
+         end if;
+
+         -- Check to determine that no more than three data records were
+         -- actually written to the file.
+         if not Order_IO.End_Of_File (Order_File) then
+            Report.Failed("File not empty after three reads");
+         end if;
+
+      exception
+      
+         when Order_IO.End_Error =>            -- If three items not in 
+                                               -- file (data overwritten),
+                                               -- then fail.
+            Report.Failed ("Incorrect number of record elements in file");
+
+         when others => 
+            Report.Failed ("Error raised during data verification");
+
+      end Test_Verification_Block;
+
+   exception
+
+      when others => 
+         Report.Failed("Exception raised during Sequential_IO processing");
+
+   end Operational_Test_Block;
+
+   Deletion:
+   begin
+      -- Check that file is open prior to deleting it.
+      if Order_IO.Is_Open(Order_File) then
+         Order_IO.Delete (Order_File);         
+      else
+         Order_IO.Open(Order_File, Order_IO.In_File, Order_Filename);
+         Order_IO.Delete (Order_File);          
+      end if;
+
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Sequential_IO" );
+
+   end Deletion;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXA8001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa8002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa8002.a
new file mode 100644
index 000000000..8670e98ba
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa8002.a
@@ -0,0 +1,285 @@
+-- CXA8002.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 resetting a file using mode Append_File allows for the 
+--      writing of elements to the file starting after the last element in
+--      the file.  
+--      Check that the result of function Name can be used on a subsequent
+--      reopen of the file.
+--      Check that a mode change occurs on reset of a file to/from mode 
+--      Append_File.
+--
+-- TEST DESCRIPTION:
+--      This test simulates the read/write of data from/to an individual 
+--      sequential file. New data can be appended to the end of the existing 
+--      file, and the same file can be reset to allow reading of data from 
+--      the file.  This process can occur multiple times.
+--      When the mode of the file is changed with a Reset, the current mode
+--      value assigned to the file is checked using the result of function
+--      Mode.  This, in conjunction with the read/write operations, verifies
+--      that a mode change has taken place on Reset.
+--      
+--      An expected common usage of the scenarios found in this test would
+--      be a case where a single data file is kept open continuously, being
+--      reset for read/append of data.  For systems that do not support a
+--      direct form of I/O, this would allow for efficient use of a sequential
+--      I/O file.
+--
+-- APPLICABILITY CRITERIA: 
+--      Applicable to all systems capable of supporting IO operations on 
+--      external Sequential_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Feb 97   PWB.CTA Fixed handling for file non-support and Reset
+--                          non-support.
+--!
+
+with Sequential_IO;
+with Report;
+
+procedure CXA8002 is
+   subtype Employee_Data is String (1 .. 11);
+   package Data_IO       is new Sequential_IO (Employee_Data); 
+
+   Employee_Data_File : Data_IO.File_Type;
+   Employee_Filename  : constant String := 
+     Report.Legal_File_Name (Nam => "CXA8002");
+
+   Incomplete         : exception;
+
+begin
+
+   Report.Test ("CXA8002", "Check that resetting a file using mode "  &
+                           "Append_File allows for the writing of "   &
+                           "elements to the file starting after the " &
+                           "last element in the file");  
+
+   Test_for_Sequential_IO_Support:
+   begin
+
+      -- An implementation that does not support Sequential_IO in a particular
+      -- environment will raise Use_Error or Name_Error on calls to various
+      -- Sequential_IO operations.  This block statement encloses a call to
+      -- Create, which should produce an exception in a non-supportive 
+      -- environment.  These exceptions will be handled to produce a
+      -- Not_Applicable result.
+
+      Data_IO.Create (File => Employee_Data_File,    -- Create file in 
+                      Mode => Data_IO.Append_File,   -- mode Append_File.
+                      Name => Employee_Filename);
+
+      --
+      -- The following portion of code demonstrates the fact that a sequential
+      -- file can be created in Append_File mode, and that data can be written
+      -- to the file.
+      --
+
+   exception
+      when Data_IO.Use_Error | Data_IO.Name_Error =>
+         Report.Not_Applicable
+            ( "Sequential files not supported - Create as Append_File");
+         raise Incomplete;
+   end Test_for_Sequential_IO_Support;
+      Operational_Test_Block:
+      declare
+         Blank_Data         : constant Employee_Data := "           ";
+         Employee_1         : constant Employee_Data := "123-45-6789";
+         Employee_2         :          Employee_Data := "987-65-4321";
+
+         -- Note: Artificial numerical data chosen above to prevent any
+         --       unintended similarity with persons alive or dead.
+
+         TC_Employee_Data   :          Employee_Data := Blank_Data;
+
+
+         function TC_Mode_Selection (Selector : Integer) 
+           return Data_IO.File_Mode is
+         begin
+            case Report.Ident_Int(Selector) is
+               when 1       => return Data_IO.In_File;
+               when 2       => return Data_IO.Out_File;
+               when others  => return Data_IO.Append_File;
+            end case;
+         end TC_Mode_Selection;
+
+         Employee_Filename : constant String :=       -- Use function Name to 
+           Data_IO.Name (File => Employee_Data_File); -- store filename in 
+                                                      -- string variable.
+      begin
+
+         Data_IO.Write (File => Employee_Data_File,   -- Write initial data 
+                        Item => Employee_1);          -- entry to file.
+
+         --
+         -- The following portion of code demonstrates that a sequential file
+         -- can be reset to various file modes, including Append_File mode, 
+         -- allowing data to be added to the end of the file.
+         --
+         begin
+           Data_IO.Reset (File => Employee_Data_File,   -- Reset file with 
+                          Mode => Data_IO.In_File);     -- mode In_File.
+         exception
+           when Data_IO.Use_Error =>
+              Report.Not_Applicable
+                ("Reset to In_File not supported for Sequential_IO");
+              raise Incomplete;
+           when others =>
+              Report.Failed 
+                ("Unexpected exception on Reset to In_File (Sequential_IO)");
+              raise Incomplete;
+         end;
+         if Data_IO."="(Data_IO.Mode (Employee_Data_File), 
+                        TC_Mode_Selection (1)) then   -- Compare In_File mode
+                                                      -- Reset successful, 
+            Data_IO.Read (File => Employee_Data_File, -- now verify file data.
+                          Item => TC_Employee_Data);
+      
+            if ((TC_Employee_Data (1 .. 7)  /= "123-45-") or
+                (TC_Employee_Data (5 .. 11) /= "45-6789")) then
+               Report.Failed ("Data read error");
+            end if;
+
+         else
+            Report.Failed ("File mode not changed by Reset");
+         end if;
+
+         --
+         -- Simulate appending data to a file that has previously been written 
+         -- to and read from.
+         --
+         begin
+           Data_IO.Reset (File => Employee_Data_File,   -- Reset file with 
+                          Mode => Data_IO.Append_File); -- mode Append_File.
+         exception
+           when Data_IO.Use_Error =>
+             Report.Not_Applicable
+               ("Reset to Append_File not supported for Sequential_IO");
+             raise Incomplete;
+           when others =>
+             Report.Failed 
+              ("Unexpected exception on Reset to Append_File (Sequential_IO)");
+              raise Incomplete;
+         end;
+
+         if Data_IO.Is_Open (Employee_Data_File) then -- File remains open
+                                                      -- following Reset to 
+                                                      -- Append_File mode?
+
+            if Data_IO."=" (Data_IO.Mode (Employee_Data_File), 
+                            TC_Mode_Selection (3)) then   -- Compare to
+                                                          -- Append_File mode.
+               Data_IO.Write (File => Employee_Data_File, -- Write additional
+                              Item => Employee_2);        -- data to file.
+            else
+               Report.Failed ("File mode not changed by Reset");
+            end if;
+
+         else
+            Report.Failed 
+              ("File status not Open following Reset to Append mode");
+         end if;
+
+         Data_IO.Close (Employee_Data_File);
+
+
+         Test_Verification_Block:
+         begin
+
+            Data_IO.Open (File => Employee_Data_File, -- Reopen file, using 
+                          Mode => Data_IO.In_File,    -- previous result of
+                          Name => Employee_Filename); -- function Name.
+
+            TC_Employee_Data := Blank_Data;           -- Clear record field.
+            Data_IO.Read (Employee_Data_File,         -- Read first record,
+                          TC_Employee_Data);          -- check ordering of 
+                                                      -- records.
+
+            if not ((TC_Employee_Data (1 .. 3)  = "123") and then
+                    (TC_Employee_Data (4 .. 11) = "-45-6789")) then
+               Report.Failed ("Data read error - first record");
+            end if;
+
+            TC_Employee_Data := Blank_Data;           -- Clear record field.
+            Data_IO.Read (Employee_Data_File,         -- Read second record,
+                          TC_Employee_Data);          -- check for ordering of 
+                                                      -- records.
+
+            if ((TC_Employee_Data (1 .. 6)  /= "987-65") or else
+                not (TC_Employee_Data (3 .. 11) = "7-65-4321")) then
+               Report.Failed ("Data read error - second record");
+            end if;
+
+            -- Check that only two items were written to the file.
+            if not Data_IO.End_Of_File(Employee_Data_File) then
+               Report.Failed("Incorrect number of records in file");
+            end if;
+
+         exception
+      
+            when Data_IO.End_Error =>             -- If two items not in 
+                                                  -- file (data overwritten),
+                                                  -- then fail.
+               Report.Failed ("Incorrect number of record elements in file");
+
+            when others => 
+               Report.Failed ("Error raised during data verification");
+
+         end Test_Verification_Block;
+
+      exception
+
+         when others => 
+            Report.Failed("Exception raised during Sequential_IO processing");
+
+      end Operational_Test_Block;
+
+      Final_Block:
+      begin
+        -- Check that file is open prior to deleting it.
+        if Data_IO.Is_Open(Employee_Data_File) then
+           Data_IO.Delete (Employee_Data_File);         
+        else
+           Data_IO.Open(Employee_Data_File, 
+                        Data_IO.In_File, 
+                        Employee_Filename);
+           Data_IO.Delete (Employee_Data_File);          
+        end if;
+      exception
+         when others =>
+            Report.Failed ("Sequential_IO Delete not properly supported");
+      end Final_Block;
+
+   Report.Result;
+
+exception
+  when Incomplete =>
+    Report.Result;
+  when others =>
+    Report.Failed ("Unexpected exception");
+    Report.Result;
+end CXA8002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa8003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa8003.a
new file mode 100644
index 000000000..cf9b5e075
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa8003.a
@@ -0,0 +1,214 @@
+-- CXA8003.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 Append_File mode has not been added to package Direct_IO.
+--
+-- TEST DESCRIPTION:
+--      This test uses a procedure to change the mode of an existing Direct_IO
+--      file.  The file descriptor is passed as a parameter, along with a
+--      numeric indicator for the new mode.  Based on the numeric parameter,
+--      a Direct_IO.Reset is performed using a File_Mode'Value transformation
+--      of a string constant into a File_Mode value.  An attempt to reset a 
+--      Direct_IO file to mode Append_File should cause an Constraint_Error
+--      to be raised, as Append_File mode has not been added to Direct_IO in
+--      Ada 9X.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations supporting Direct_IO
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      19 Feb 97   PWB.CTA Allowed for non-support of Reset for certain 
+--                  modes.
+--!
+
+with Direct_IO;
+with Report;
+
+procedure CXA8003 is
+   Incomplete : exception;
+      begin
+
+         Report.Test ("CXA8003", "Check that Append_File mode has not " &
+                                 "been added to package Direct_IO");
+
+         Test_for_Direct_IO_Support:
+         declare
+
+            subtype String_Data_Type    is String (1 .. 20);
+            type    Numeric_Data_Type   is range 1 .. 512;
+            type    Composite_Data_Type is array (1 .. 3) of String_Data_Type;
+
+            type File_Data_Type is record
+               Data_Field_1 : String_Data_Type;
+               Data_Field_2 : Numeric_Data_Type;
+               Data_Field_3 : Composite_Data_Type;
+            end record;
+
+            package Dir_IO is new Direct_IO (File_Data_Type);
+
+            Data_File    : Dir_IO.File_Type;
+            Dir_Filename : constant String := Report.Legal_File_Name;
+
+         begin
+
+            -- An application creates a text file with mode Out_File.  
+            -- Use_Error will be raised if Direct_IO operations or external 
+            -- files are not supported.
+
+            Dir_IO.Create (Data_File, 
+                           Dir_IO.Out_File, 
+                           Dir_Filename);
+
+            Change_File_Mode:
+            declare
+
+               TC_Append_Test_Executed : Boolean := False;
+
+               type Mode_Selection_Type is ( A, I, IO, O );
+
+      
+               procedure Change_Mode (File : in out Dir_IO.File_Type;
+                                      To   : in     Mode_Selection_Type) is
+               begin
+                  case To is
+                     when A  => 
+                        TC_Append_Test_Executed := True;
+                        Dir_IO.Reset 
+                          (File, Dir_IO.File_Mode'Value("Append_File"));
+                     when I  => 
+                        begin
+                          Dir_IO.Reset 
+                            (File, Dir_IO.File_Mode'Value("In_File"));
+                        exception
+                          when Dir_IO.Use_Error =>
+                            Report.Not_Applicable
+                              ("Reset to In_File not supported: Direct_IO");
+                            raise Incomplete;
+                        end;
+                     when IO => 
+                        begin
+                          Dir_IO.Reset 
+                            (File, Dir_IO.File_Mode'Value("Inout_File"));
+                        exception
+                          when Dir_IO.Use_Error =>
+                            Report.Not_Applicable
+                              ("Reset to InOut_File not supported: Direct_IO");
+                            raise Incomplete;
+                        end;
+                     when O  => 
+                       begin
+                         Dir_IO.Reset 
+                           (File, Dir_IO.File_Mode'Value("Out_File"));
+                        exception
+                          when Dir_IO.Use_Error =>
+                            Report.Not_Applicable
+                              ("Reset to Out_File not supported: Direct_IO");
+                            raise Incomplete;
+                        end;
+                  end case;
+               end Change_Mode;
+
+
+            begin
+
+              -- At some point in the processing, the application may call a 
+              -- procedure to change the mode of the file (perhaps for 
+              -- additional data entry, data verification, etc.).  It is at 
+              -- this point that a use of Append_File mode for a Direct_IO 
+              -- file would cause an exception.
+
+               for I in reverse Mode_Selection_Type loop
+                  Change_Mode (Data_File, I);
+                  Report.Comment 
+                    ("Mode changed to " & 
+                     Dir_IO.File_Mode'Image (Dir_IO.Mode (Data_File)));
+               end loop;
+
+               Report.Failed("No error raised on change to Append_File mode");
+
+            exception
+
+               -- A handler has been provided in the application, which 
+               -- handles the constraint error, allowing processing to 
+               -- continue.
+
+               when Constraint_Error => 
+
+                  if TC_Append_Test_Executed then 
+                     Report.Comment ("Constraint_Error correctly raised on " &
+                                     "attempted Append_File mode selection " &
+                                     "for a Direct_IO file");
+                  else
+                     Report.Failed ("Append test was not executed");
+                  end if;
+
+               when Incomplete => raise;
+
+               when others  => Report.Failed ("Unexpected exception raised");
+
+            end Change_File_Mode;
+
+            Final_Block:
+            begin
+              if Dir_IO.Is_Open (Data_File) then
+                 Dir_IO.Delete (Data_File);
+              else
+                 Dir_IO.Open (Data_File, Dir_IO.In_File, Dir_Filename);
+                 Dir_IO.Delete (Data_File);
+              end if;
+            exception
+              when others =>
+                Report.Failed ("Delete not properly supported: Direct_IO");
+            end Final_Block;
+
+         exception
+
+            -- Since Use_Error or Name_Error can be raised if, for the 
+            -- specified mode, the environment does not support Direct_IO 
+            -- operations, the following handlers are included:
+
+            when Dir_IO.Name_Error =>
+               Report.Not_Applicable("Name_Error raised on Direct IO Create");
+
+            when Dir_IO.Use_Error  =>
+               Report.Not_Applicable("Use_Error raised on Direct IO Create");
+
+            when others            =>
+               Report.Failed 
+                 ("Unexpected exception raised on Direct IO Create");
+
+         end Test_for_Direct_IO_Support;
+
+         Report.Result;
+
+exception
+  when Incomplete =>
+    Report.Result;
+
+end CXA8003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a
new file mode 100644
index 000000000..4fe9c3576
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa9001.a
@@ -0,0 +1,287 @@
+-- CXA9001.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 operations defined in the generic package 
+--      Ada.Storage_IO provide the ability to store and retrieve objects 
+--      which may include implicit levels of indirection in their 
+--      implementation, from an in-memory buffer.
+--
+-- TEST DESCRIPTION:
+--      The following scenario demonstrates how an object of a type with 
+--      (potential) levels of indirection (based on the implementation) 
+--      can be "flattened" and written/read to/from a Direct_IO file.
+--      In this small example, we have attempted to simulate the situation 
+--      where two independent programs are using a particular Direct_IO file,
+--      one writing data to the file, and the second program reading that file.
+--      The Storage_IO Read and Write procedures are used to "flatten" 
+--      and reconstruct objects of the record type. 
+--
+-- APPLICABILITY CRITERIA: 
+--      Applicable to implementations capable of supporting external
+--      Direct_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      07 Jun 95   SAIC    Modified to constrain type used with Storage_IO.
+--      20 Nov 95   SAIC    Corrected and enhanced for ACVC 2.0.1.
+--      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Report;
+with Ada.Storage_IO;
+with Ada.Direct_IO;
+
+procedure CXA9001 is
+   package Dir_IO is new Ada.Direct_IO (Integer);
+   Test_File  : Dir_IO.File_Type;
+   Incomplete : exception;
+begin
+
+   Report.Test ("CXA9001", "Check that the operations defined in the "      &
+                           "generic package Ada.Storage_IO provide the "    &
+                           "ability to store and retrieve objects which "   &
+                           "may include implicit levels of indirection in " &
+                           "their implementation, from an in-memory buffer");
+
+
+   Test_For_Direct_IO_Support:
+   begin
+
+      -- The following Create does not have any bearing on the test scenario,
+      -- but is included to check that the implementation supports Direct_IO
+      -- files.  An exception on this Create statement will raise a Name_Error
+      -- or Use_Error, which will be handled to produce a Not_Applicable
+      -- result. If created, the file is immediately deleted, as it is not 
+      -- needed for the program scenario.
+
+      Dir_IO.Create (Test_File, Dir_IO.Out_File, Report.Legal_File_Name(1));
+
+   exception
+
+       when Dir_IO.Use_Error | Dir_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Direct_IO" );
+          raise Incomplete;
+
+   end Test_for_Direct_IO_Support;
+
+   Deletion1:
+   begin
+      Dir_IO.Delete (Test_File);
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Direct_IO - 1" );
+   end Deletion1;
+
+
+   Test_Block:
+   declare
+
+      The_Filename : constant String := Report.Legal_File_Name(2);
+
+      -- The following type is the basic unit used in this test. It is
+      -- incorporated into the definition of the Unit_Array_Type.
+
+      type Unit_Type is
+         record
+            Position     : Natural := 19;
+            String_Value : String (1..9) := (others => 'X');
+         end record;
+
+      TC_Size : Natural := Natural'First;
+
+      procedure Data_Storage (Number_Of_Units  : in     Natural;
+                              Result           :    out Natural) is
+
+         -- Type based on input parameter.  Uses type Unit_Type 
+         -- as the array element.
+         type Unit_Array_Type is array (1..Number_Of_Units) 
+           of Unit_Type; 
+
+         -- This type definition is the ultimate storage type used
+         -- in this test; uses type Unit_Array_Type as a record
+         -- component field.
+         -- This record type contains a component that is an array of
+         -- records, with each of these records containing a Natural
+         -- and a String value (i.e., a record containing an array of
+         -- records).
+
+         type Data_Storage_Type is
+            record
+               Data_Value : Natural := Number_Of_Units;
+               Unit_Array : Unit_Array_Type;
+            end record;
+
+         -- The instantiation of the following generic package is a
+         -- central point in this test.  Storage_IO is instantiated for
+         -- a specific data type, and will be used to "flatten" objects
+         -- of that type into buffers.  Direct_IO is instantiated for
+         -- these Storage_IO buffers.
+
+         package Flat_Storage_IO is 
+           new Ada.Storage_IO (Data_Storage_Type);
+         package Buffer_IO is 
+           new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
+
+         Buffer_File      : Buffer_IO.File_Type;
+         Outbound_Buffer  : Flat_Storage_IO.Buffer_Type;
+         Storage_Item     : Data_Storage_Type;
+
+      begin  -- procedure Data_Storage
+
+         Buffer_IO.Create (Buffer_File, 
+                           Buffer_IO.Out_File, 
+                           The_Filename);
+
+         Flat_Storage_IO.Write (Buffer => Outbound_Buffer, 
+                                Item   => Storage_Item);
+
+         -- At this point, any levels of indirection have been removed
+         -- by the Storage_IO procedure, and the buffered data can be
+         -- written to a file.
+
+         Buffer_IO.Write (Buffer_File, Outbound_Buffer);
+         Buffer_IO.Close (Buffer_File);
+         Result := Storage_Item.Unit_Array'Last +           -- 5 +
+                   Storage_Item.Unit_Array                  -- 9
+                     (Storage_Item.Unit_Array'First).String_Value'Length;
+
+      exception
+         when others => 
+            Report.Failed ("Data storage error");
+            if Buffer_IO.Is_Open (Buffer_File) then
+               Buffer_IO.Close (Buffer_File);
+            end if;       
+      end Data_Storage;
+
+      procedure Data_Retrieval (Number_Of_Units  : in     Natural;
+                                Result           :    out Natural) is
+         type Unit_Array_Type is array (1..Number_Of_Units) 
+           of Unit_Type;
+
+         type Data_Storage_Type is
+            record
+               Data_Value : Natural := Number_Of_Units;
+               Unit_Array : Unit_Array_Type;
+            end record;
+
+         package Flat_Storage_IO is 
+           new Ada.Storage_IO (Data_Storage_Type);
+         package Reader_IO is 
+           new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
+
+         Reader_File      : Reader_IO.File_Type;
+         Inbound_Buffer   : Flat_Storage_IO.Buffer_Type;
+         Storage_Item     : Data_Storage_Type; 
+         TC_Item          : Data_Storage_Type; 
+
+      begin  -- procedure Data_Retrieval
+
+         Reader_IO.Open (Reader_File, Reader_IO.In_File, The_Filename);
+         Reader_IO.Read (Reader_File, Inbound_Buffer);
+
+         Flat_Storage_IO.Read (Inbound_Buffer, Storage_Item);
+
+         -- Validate the reconstructed value against an "unflattened"
+         -- value.
+
+         if Storage_Item.Data_Value /= TC_Item.Data_Value 
+         then
+            Report.Failed ("Data_Retrieval Error - 1");
+         end if;
+
+         for i in 1..Number_Of_Units loop
+            if Storage_Item.Unit_Array(i).String_Value'Length  /=
+               TC_Item.Unit_Array(i).String_Value'Length      or
+               Storage_Item.Unit_Array(i).Position     /=
+               TC_Item.Unit_Array(i).Position             or
+               Storage_Item.Unit_Array(i).String_Value /=
+               TC_Item.Unit_Array(i).String_Value      
+            then
+               Report.Failed ("Data_Retrieval Error - 2");
+            end if;
+         end loop;
+
+         Result := Storage_Item.Unit_Array'Last +           -- 5 +
+                   Storage_Item.Unit_Array                  -- 9
+                     (Storage_Item.Unit_Array'First).String_Value'Length;
+
+         if Reader_IO.Is_Open (Reader_File) then
+            Reader_IO.Delete (Reader_File);
+         else
+            Reader_IO.Open (Reader_File, 
+                            Reader_IO.In_File, 
+                            The_Filename);
+            Reader_IO.Delete (Reader_File);
+         end if;       
+
+      exception
+         when others => 
+            Report.Failed ("Exception raised in Data_Retrieval");
+            if Reader_IO.Is_Open (Reader_File) then
+               Reader_IO.Delete (Reader_File);
+            else
+               Reader_IO.Open (Reader_File, 
+                               Reader_IO.In_File, 
+                               The_Filename);
+               Reader_IO.Delete (Reader_File);
+            end if;       
+      end Data_Retrieval;
+
+
+   begin  -- Test_Block
+
+      -- The number of Units is provided in this call to Data_Storage.
+      Data_Storage (Number_Of_Units  => Natural(Report.Ident_Int(5)), 
+                    Result           => TC_Size);
+
+      if TC_Size /= 14 then
+         Report.Failed ("Data_Storage error in Data_Storage");
+      end if;
+
+      Data_Retrieval (Number_Of_Units  => Natural(Report.Ident_Int(5)), 
+                      Result           => TC_Size);
+
+      if TC_Size /= 14 then
+         Report.Failed ("Data retrieval error in Data_Retrieval");
+      end if;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXA9001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa9002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa9002.a
new file mode 100644
index 000000000..415a56630
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxa9002.a
@@ -0,0 +1,482 @@
+-- CXA9002.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 operations defined in the generic package 
+--      Ada.Storage_IO provide the ability to store and retrieve objects 
+--      of tagged types from in-memory buffers.
+--
+-- TEST DESCRIPTION:
+--      The following scenario demonstrates how objects of a tagged type, 
+--      extended types, and twice extended types can be written/read
+--      to/from Direct_IO files. The Storage_IO subprograms, Read and Write, 
+--      demonstrated in this scenario, perform tag "fixing" prior to/following
+--      transfer to the Direct_IO files.
+--      This method is especially important for those implementations that 
+--      represent tags as pointers, or for cases where the tagged objects
+--      are read in by a program other than the one that wrote them.  
+--
+--      In this small example, we have attempted to simulate the situation 
+--      where two independent programs are using a series of Direct_IO files,
+--      one writing data to the files, and the second program reading the 
+--      data from those files.  Two procedures are defined, the first
+--      simulating the program responsible for writing, the second simulating 
+--      a separate program opening and reading the data from the files.  
+--      
+--      The hierarchy of types used in this test can be displayed as follows:
+--      
+--                                Account_Type
+--                                 /       \
+--                                /         \
+--                               /           \
+--                  Cash_Account_Type       Investment_Account_Type
+--                     /         \
+--                    /           \
+--                   /             \
+--      Checking_Account_Type    Savings_Account_Type
+--      
+-- APPLICABILITY CRITERIA: 
+--      Applicable to implementations capable of supporting external
+--      Direct_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      08 Nov 95   SAIC    Corrected incorrect prefix of 'Tag for ACVC 2.0.1,
+--                          and mode of files in Procedure Read_Data.
+--                          Added verification of objects reconstructed from
+--                          files.
+--      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+package CXA9002_0 is
+
+   type Investment_Type is (Stocks, Bonds, Mutual_Funds);
+   type Savings_Type    is (Standard, Business, Impound);
+
+   type Account_Type is tagged 
+      record
+         Num : String (1..3);
+      end record;
+
+   type Cash_Account_Type is new Account_Type with
+      record
+         Years_As_Customer : Natural := 1;
+      end record;
+
+   type Investment_Account_Type is new Account_Type with
+      record
+         Investment_Vehicle : Investment_Type := Stocks;
+      end record;
+
+   type Checking_Account_Type is new Cash_Account_Type with
+      record
+         Checks_Per_Year  : Positive := 200;
+         Interest_Bearing : Boolean  := False;
+      end record;
+
+   type Savings_Account_Type is new Cash_Account_Type with
+      record
+         Kind : Savings_Type := Standard;
+      end record;
+
+end CXA9002_0;
+
+---
+
+with Report;
+with Ada.Storage_IO;
+with Ada.Direct_IO;
+with Ada.Tags;
+with CXA9002_0;
+
+procedure CXA9002 is
+   package Dir_IO is new Ada.Direct_IO (Integer);
+   Test_File : Dir_IO.File_Type;
+   Incomplete : exception;
+begin
+
+   Report.Test ("CXA9002", "Check that the operations defined in the "   &
+                           "generic package Ada.Storage_IO provide the " &
+                           "ability to store and retrieve objects of "   &
+                           "tagged types from in-memory buffers");
+
+
+   Test_For_Direct_IO_Support:
+   begin
+
+      -- The following Create does not have any bearing on the test scenario,
+      -- but is included to check that the implementation supports Direct_IO
+      -- files.  An exception on this Create statement will raise a Name_Error
+      -- or Use_Error, which will be handled to produce a Not_Applicable
+      -- result. If created, the file is immediately deleted, as it is not 
+      -- needed for the program scenario.
+
+      Dir_IO.Create (Test_File, 
+                     Dir_IO.Out_File, 
+                     Report.Legal_File_Name(1));
+   exception
+
+       when Dir_IO.Use_Error | Dir_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Direct_IO" );
+          raise Incomplete;
+
+   end Test_for_Direct_IO_Support;
+
+   Deletion:
+   begin
+      Dir_IO.Delete (Test_File);
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Direct_IO" );
+   end Deletion;
+
+   Test_Block:
+   declare
+
+      use CXA9002_0; 
+
+      Acct_Filename : constant String := Report.Legal_File_Name(1);
+      Cash_Filename : constant String := Report.Legal_File_Name(2);
+      Inv_Filename  : constant String := Report.Legal_File_Name(3);
+      Chk_Filename  : constant String := Report.Legal_File_Name(4);
+      Sav_Filename  : constant String := Report.Legal_File_Name(5);
+
+      type Tag_Pointer_Type is access String;
+
+      TC_Account_Type_Tag,           
+      TC_Cash_Account_Type_Tag,      
+      TC_Investment_Account_Type_Tag,
+      TC_Checking_Account_Type_Tag,  
+      TC_Savings_Account_Type_Tag    : Tag_Pointer_Type;
+
+      TC_Account            : Account_Type            := 
+                                (Num => "123");
+
+      TC_Cash_Account       : Cash_Account_Type       := 
+                                (Num               => "234", 
+                                 Years_As_Customer => 3);
+
+      TC_Investment_Account : Investment_Account_Type := 
+                                (Num                => "456", 
+                                 Investment_Vehicle => Bonds);
+
+      TC_Checking_Account   : Checking_Account_Type   :=
+                                (Num               => "567", 
+                                 Years_As_Customer => 2,  
+                                 Checks_Per_Year   => 300,
+                                 Interest_Bearing  => True);
+
+      TC_Savings_Account    : Savings_Account_Type    :=
+                                (Num               => "789", 
+                                 Years_As_Customer => 14, 
+                                 Kind              => Business);
+              
+      procedure Buffer_Data is
+
+         Account            : Account_Type            := 
+                                TC_Account;
+         Cash_Account       : Cash_Account_Type       := 
+                                TC_Cash_Account;
+         Investment_Account : Investment_Account_Type :=
+                                TC_Investment_Account;
+         Checking_Account   : Checking_Account_Type   :=
+                                TC_Checking_Account;
+         Savings_Account    : Savings_Account_Type    :=
+                                TC_Savings_Account;
+
+         -- The instantiations below are a central point in this test. 
+         -- Storage_IO is instantiated for each of the specific tagged
+         -- type. These instantiated packages will be used to compress 
+         -- tagged objects of these various types into buffers that will 
+         -- be written to the Direct_IO files declared below.
+
+         package Acct_SIO is new Ada.Storage_IO (Account_Type);
+         package Cash_SIO is new Ada.Storage_IO (Cash_Account_Type);
+         package Inv_SIO  is new Ada.Storage_IO (Investment_Account_Type);
+         package Chk_SIO  is new Ada.Storage_IO (Checking_Account_Type);
+         package Sav_SIO  is new Ada.Storage_IO (Savings_Account_Type);
+
+         -- Direct_IO is instantiated for the buffer types defined in the
+         -- instantiated Storage_IO packages.
+
+         package Acct_DIO is new Ada.Direct_IO (Acct_SIO.Buffer_Type);
+         package Cash_DIO is new Ada.Direct_IO (Cash_SIO.Buffer_Type);
+         package Inv_DIO  is new Ada.Direct_IO (Inv_SIO.Buffer_Type);
+         package Chk_DIO  is new Ada.Direct_IO (Chk_SIO.Buffer_Type);
+         package Sav_DIO  is new Ada.Direct_IO (Sav_SIO.Buffer_Type);
+
+         Acct_Buffer : Acct_SIO.Buffer_Type;
+         Cash_Buffer : Cash_SIO.Buffer_Type;
+         Inv_Buffer  : Inv_SIO.Buffer_Type;
+         Chk_Buffer  : Chk_SIO.Buffer_Type;
+         Sav_Buffer  : Sav_SIO.Buffer_Type;
+
+         Acct_File   : Acct_DIO.File_Type;
+         Cash_File   : Cash_DIO.File_Type;
+         Inv_File    : Inv_DIO.File_Type;
+         Chk_File    : Chk_DIO.File_Type;
+         Sav_File    : Sav_DIO.File_Type;
+
+      begin 
+
+         Acct_DIO.Create (Acct_File, Acct_DIO.Out_File, Acct_Filename);
+         Cash_DIO.Create (Cash_File, Cash_DIO.Out_File, Cash_Filename);
+         Inv_DIO.Create  (Inv_File,  Inv_DIO.Out_File,  Inv_Filename);
+         Chk_DIO.Create  (Chk_File,  Chk_DIO.Out_File,  Chk_Filename);
+         Sav_DIO.Create  (Sav_File,  Sav_DIO.Out_File,  Sav_Filename);
+
+         -- Store the tag values of the objects declared above for 
+         -- comparison with tag values of objects following processing.
+
+         TC_Account_Type_Tag := 
+           new String'(Ada.Tags.External_Tag(Account_Type'Tag));
+
+         TC_Cash_Account_Type_Tag := 
+           new String'(Ada.Tags.External_Tag(Cash_Account_Type'Tag));
+
+         TC_Investment_Account_Type_Tag := 
+           new String'(Ada.Tags.External_Tag(Investment_Account_Type'Tag));
+
+         TC_Checking_Account_Type_Tag := 
+           new String'(Ada.Tags.External_Tag(Checking_Account_Type'Tag));
+
+         TC_Savings_Account_Type_Tag := 
+           new String'(Ada.Tags.External_Tag(Savings_Account_Type'Tag));
+
+         -- Prepare tagged data for writing to the Direct_IO files using
+         -- Storage_IO procedure to place data in buffers.
+
+         Acct_SIO.Write (Buffer => Acct_Buffer, Item => Account);
+         Cash_SIO.Write (Cash_Buffer, Cash_Account);
+         Inv_SIO.Write  (Inv_Buffer, Item => Investment_Account);  
+         Chk_SIO.Write  (Buffer => Chk_Buffer, Item => Checking_Account);
+         Sav_SIO.Write  (Sav_Buffer, Savings_Account);
+
+         -- At this point, the data and associated tag values have been
+         -- buffered by the Storage_IO procedure, and the buffered data 
+         -- can be written to the appropriate Direct_IO file.
+
+         Acct_DIO.Write (File => Acct_File, Item => Acct_Buffer);
+         Cash_DIO.Write (Cash_File, Cash_Buffer);
+         Inv_DIO.Write  (Inv_File, Item => Inv_Buffer);
+         Chk_DIO.Write  (File => Chk_File, Item =>Chk_Buffer);
+         Sav_DIO.Write  (Sav_File, Sav_Buffer);
+
+         -- Close all Direct_IO files.
+
+         Acct_DIO.Close (Acct_File);
+         Cash_DIO.Close (Cash_File);
+         Inv_DIO.Close  (Inv_File); 
+         Chk_DIO.Close  (Chk_File); 
+         Sav_DIO.Close  (Sav_File); 
+
+      exception
+         when others => Report.Failed("Exception raised in Buffer_Data");
+      end Buffer_Data;
+
+      procedure Read_Data is
+
+         Account            : Account_Type;
+         Cash_Account       : Cash_Account_Type;
+         Investment_Account : Investment_Account_Type;
+         Checking_Account   : Checking_Account_Type;
+         Savings_Account    : Savings_Account_Type;
+
+         -- Storage_IO is instantiated for each of the specific tagged
+         -- type. 
+
+         package Acct_SIO is new Ada.Storage_IO (Account_Type);
+         package Cash_SIO is new Ada.Storage_IO (Cash_Account_Type);
+         package Inv_SIO  is new Ada.Storage_IO (Investment_Account_Type);
+         package Chk_SIO  is new Ada.Storage_IO (Checking_Account_Type);
+         package Sav_SIO  is new Ada.Storage_IO (Savings_Account_Type);
+
+         -- Direct_IO is instantiated for the buffer types defined in the
+         -- instantiated Storage_IO packages.
+
+         package Acct_DIO is new Ada.Direct_IO (Acct_SIO.Buffer_Type);
+         package Cash_DIO is new Ada.Direct_IO (Cash_SIO.Buffer_Type);
+         package Inv_DIO  is new Ada.Direct_IO (Inv_SIO.Buffer_Type);
+         package Chk_DIO  is new Ada.Direct_IO (Chk_SIO.Buffer_Type);
+         package Sav_DIO  is new Ada.Direct_IO (Sav_SIO.Buffer_Type);
+
+         Acct_Buffer : Acct_SIO.Buffer_Type;
+         Cash_Buffer : Cash_SIO.Buffer_Type;
+         Inv_Buffer  : Inv_SIO.Buffer_Type;
+         Chk_Buffer  : Chk_SIO.Buffer_Type;
+         Sav_Buffer  : Sav_SIO.Buffer_Type;
+
+         Acct_File   : Acct_DIO.File_Type;
+         Cash_File   : Cash_DIO.File_Type;
+         Inv_File    : Inv_DIO.File_Type;
+         Chk_File    : Chk_DIO.File_Type;
+         Sav_File    : Sav_DIO.File_Type;
+
+      begin
+
+         -- Open the Direct_IO files.
+
+         Acct_DIO.Open (Acct_File, Acct_DIO.In_File, Acct_Filename);
+         Cash_DIO.Open (Cash_File, Cash_DIO.In_File, Cash_Filename);
+         Inv_DIO.Open  (Inv_File,  Inv_DIO.In_File,  Inv_Filename);
+         Chk_DIO.Open  (Chk_File,  Chk_DIO.In_File,  Chk_Filename);
+         Sav_DIO.Open  (Sav_File,  Sav_DIO.In_File,  Sav_Filename);
+
+         -- Read the buffer data from the files using Direct_IO.
+
+         Acct_DIO.Read (File => Acct_File, Item => Acct_Buffer);
+         Cash_DIO.Read (Cash_File, Cash_Buffer);
+         Inv_DIO.Read  (Inv_File, Item => Inv_Buffer);
+         Chk_DIO.Read  (File => Chk_File, Item =>Chk_Buffer);
+         Sav_DIO.Read  (Sav_File, Sav_Buffer);
+
+         -- At this point, the data and associated tag values are stored
+         -- in buffers. Use the Storage_IO procedure Read to recreate the
+         -- tagged objects from the buffers.
+
+         Acct_SIO.Read (Buffer => Acct_Buffer, Item => Account);
+         Cash_SIO.Read (Cash_Buffer, Cash_Account);
+         Inv_SIO.Read  (Inv_Buffer, Item => Investment_Account);  
+         Chk_SIO.Read  (Buffer => Chk_Buffer, Item => Checking_Account);
+         Sav_SIO.Read  (Sav_Buffer, Savings_Account);
+
+         -- Delete all Direct_IO files.
+
+         Acct_DIO.Delete (Acct_File);
+         Cash_DIO.Delete (Cash_File);
+         Inv_DIO.Delete  (Inv_File); 
+         Chk_DIO.Delete  (Chk_File); 
+         Sav_DIO.Delete  (Sav_File); 
+
+         Data_Verification_Block:
+         begin
+
+            if Account /= TC_Account then
+               Report.Failed("Incorrect Account object reconstructed");
+            end if;
+
+            if Cash_Account /= TC_Cash_Account then
+               Report.Failed
+                 ("Incorrect Cash_Account object reconstructed");
+            end if;   
+
+            if Investment_Account /= TC_Investment_Account then
+               Report.Failed
+                 ("Incorrect Investment_Account object reconstructed");
+            end if;   
+
+            if Checking_Account /= TC_Checking_Account then
+               Report.Failed
+                 ("Incorrect Checking_Account object reconstructed");
+            end if;   
+
+            if Savings_Account /= TC_Savings_Account then
+               Report.Failed
+                 ("Incorrect Savings_Account object reconstructed");
+            end if;   
+               
+         exception
+            when others =>
+              Report.Failed
+                ("Exception raised during Data_Verification Block");
+         end Data_Verification_Block;
+
+
+         -- To ensure that the tags of the values reconstructed by 
+         -- Storage_IO were properly preserved, object tag values following 
+         -- object reconstruction are compared with tag values of objects
+         -- stored prior to processing.
+
+         Tag_Verification_Block:
+         begin
+
+            if TC_Account_Type_Tag.all /= 
+               Ada.Tags.External_Tag(Account_Type'Class(Account)'Tag)
+            then
+               Report.Failed("Incorrect Account tag");
+            end if;
+
+            if TC_Cash_Account_Type_Tag.all       /= 
+               Ada.Tags.External_Tag(
+                 Cash_Account_Type'Class(Cash_Account)'Tag)
+            then
+               Report.Failed("Incorrect Cash_Account tag");
+            end if;
+
+            if TC_Investment_Account_Type_Tag.all /=                 
+               Ada.Tags.External_Tag(
+                 Investment_Account_Type'Class(Investment_Account)'Tag)
+            then
+               Report.Failed("Incorrect Investment_Account tag");
+            end if;
+
+            if TC_Checking_Account_Type_Tag.all   /=
+               Ada.Tags.External_Tag(
+                 Checking_Account_Type'Class(Checking_Account)'Tag)
+            then
+               Report.Failed("Incorrect Checking_Account tag");
+            end if;
+
+            if TC_Savings_Account_Type_Tag.all    /=
+               Ada.Tags.External_Tag(
+                 Savings_Account_Type'Class(Savings_Account)'Tag)
+            then
+               Report.Failed("Incorrect Savings_Account tag");
+            end if;
+
+         exception
+            when others => 
+              Report.Failed ("Exception raised during tag evaluation");
+         end Tag_Verification_Block;
+
+      exception
+         when others => Report.Failed ("Exception in Read_Data");
+      end Read_Data;
+
+      begin  -- Test_Block
+
+      -- Enter the data into the appropriate files.
+      Buffer_Data;
+
+      -- Reconstruct the data from files, and verify the results.
+      Read_Data;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXA9002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa001.a
new file mode 100644
index 000000000..6c2af9870
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa001.a
@@ -0,0 +1,279 @@
+-- CXAA001.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 Line_Length and Page_Length maximums for a Text_IO
+--      file of mode Append_File are initially zero (unbounded) after a
+--      Create, Open, or Reset, and that these values can be modified using
+--      the procedures Set_Line_Length and Set_Page_Length.
+--      Check that setting the Line_Length and Page_Length attributes to zero
+--      results in an unbounded Text_IO file.
+--      Check that setting the line length when in Append_Mode doesn't 
+--      change the length of lines previously written to the Text_IO file.
+--
+-- TEST DESCRIPTION:
+--      This test attempts to simulate a possible text processing environment.
+--      String values, from a number of different string types, are written to 
+--      a Text_IO file.  Prior to the writing of each, the line length is set 
+--      to the particular length of the data being written.  In addition, the 
+--      default line and page lengths are checked, to determine whether they 
+--      are unbounded (length = 0) following a create, reset, or open of a 
+--      Text_IO file with mode Append_File.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA001 is
+   use Ada;
+   Data_File      : Text_IO.File_Type;
+   Data_Filename  : constant String :=
+                              Report.Legal_File_Name ( Nam => "CXAA001" );
+   Incomplete : exception;
+begin
+
+   Report.Test ("CXAA001","Check that the Line_Length and Page_Length "      &
+                          "maximums for a Text_IO file of mode Append_File " &
+                          "are initially zero (unbounded) after a Create, "  &
+                          "Open, or Reset, and that these values can be "    &
+                          "modified using the procedures Set_Line_Length "   &
+                          "and Set_Page_Length");
+
+   Test_for_Text_IO_Support:
+   begin
+
+      -- An implementation that does not support Text_IO in a particular
+      -- environment will raise Use_Error on calls to various
+      -- Text_IO operations.  This block statement encloses a call to
+      -- Create, which should raise an exception in a non-supportive 
+      -- environment.  This exception will be handled to produce a
+      -- Not_Applicable result.
+
+      Text_IO.Create (File => Data_File,
+                      Mode => Text_IO.Append_File,
+                      Name => Data_Filename);
+
+   exception
+
+       when Text_IO.Use_Error | Text_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Append_File for Text_IO" );
+          raise Incomplete;
+
+   end Test_for_Text_IO_Support;
+
+   Operational_Test_Block:
+   declare
+
+      subtype Confidential_Data_Type is string (1 .. 10);
+      subtype Secret_Data_Type       is string (1 .. 20);
+      subtype Top_Secret_Data_Type   is string (1 .. 30);
+
+      Zero                   : constant Text_IO.Count :=  0;
+      Confidential_Data_Size : constant Text_IO.Count := 10;
+      Secret_Data_Size       : constant Text_IO.Count := 20;
+      Top_Secret_Data_Size   : constant Text_IO.Count := 30;
+
+      -- The following generic procedure is designed to simulate a text
+      -- processing environment where line and page sizes are set and 
+      -- verified prior to the writing of data to a file.
+
+      generic
+         Data_Size : Text_IO.Count;
+      procedure Write_Data_To_File (Data_Item : in String);
+
+      procedure Write_Data_To_File (Data_Item : in String) is
+         use Text_IO;  -- Used to provide visibility to the "/=" operator.
+      begin
+         if (Text_IO.Line_Length (Data_File) /= Zero) then -- Check default
+            Report.Failed("Line not of unbounded length"); -- line length,
+         elsif (Text_IO.Page_Length (Data_File) /= Zero) then -- default
+            Report.Failed ("Page not of unbounded length"); -- page length.
+         end if;
+      
+         Text_IO.Set_Line_Length (File => Data_File,    -- Set the line
+                                  To   => Data_Size);   -- length.
+         Text_IO.Set_Page_Length (File => Data_File,    -- Set the page
+                                  To   => Data_Size);   -- length.
+         -- Verify the lengths set.
+         if (Integer(Text_IO.Line_Length (Data_File)) /= 
+             Report.Ident_Int(Integer(Data_Size))) then
+            Report.Failed ("Line length not set to appropriate length");
+         elsif (Integer(Text_IO.Page_Length (Data_File)) /= 
+                Report.Ident_Int(Integer(Data_Size))) then
+            Report.Failed ("Page length not set to appropriate length");
+         end if;
+
+         Text_IO.Put_Line (File => Data_File,           -- Write data to
+                           Item => Data_Item);          -- file.
+
+      end Write_Data_To_File;
+
+      -- Instantiation for the three data types/sizes.
+
+      procedure Write_Confidential_Data is 
+        new Write_Data_To_File (Data_Size => Confidential_Data_Size);
+
+      procedure Write_Secret_Data is 
+        new Write_Data_To_File (Data_Size => Secret_Data_Size);
+
+      procedure Write_Top_Secret_Data is 
+        new Write_Data_To_File (Data_Size => Top_Secret_Data_Size);
+
+      Confidential_Item : Confidential_Data_Type := "Confidenti";
+      Secret_Item       : Secret_Data_Type       := "Secret Data Values  ";
+      Top_Secret_Item   : Top_Secret_Data_Type   := 
+        "Extremely Top Secret Data     ";
+
+   begin
+
+      -- The following call simulates processing occurring after the create
+      -- of a Text_IO file with mode Append_File.
+
+      Write_Confidential_Data (Confidential_Item);
+    
+      -- The following call simulates processing occurring after the reset
+      -- of a Text_IO file with mode Append_File.
+
+      Reset1:
+      begin
+         Text_IO.Reset (Data_File, Text_IO.Append_File); -- Reset to
+                                                         -- Append_File mode.
+      exception
+         when Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to Append_File not supported for Text_IO" );
+            raise Incomplete;
+      end Reset1;
+
+      Write_Secret_Data (Data_Item    => Secret_Item);
+
+      Text_IO.Close (Data_File);                      -- Close file.
+
+      -- The following processing simulates processing occurring after the
+      -- opening of an existing file with mode Append_File.
+
+      Text_IO.Open (Data_File,                        -- Open file in
+                    Text_IO.Append_File,              -- Append_File mode.
+                    Data_Filename);  
+                                                         
+      Write_Top_Secret_Data (Top_Secret_Item); 
+
+      Test_Verification_Block:
+      declare
+         TC_String1,
+         TC_String2,
+         TC_String3  : String (1..80) := (others => ' ');
+         TC_Length1,
+         TC_Length2,
+         TC_Length3  : Natural := 0;
+      begin
+
+         Reset2:
+         begin
+            Text_IO.Reset (Data_File, Text_IO.In_File); -- Reset for reading.
+         exception
+            when Text_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Text_IO" );
+               raise Incomplete;
+         end Reset2;
+
+         Text_IO.Get_Line (Data_File, TC_String1, TC_Length1); 
+         Text_IO.Get_Line (Data_File, TC_String2, TC_Length2); 
+         Text_IO.Get_Line (Data_File, TC_String3, TC_Length3); 
+
+         -- Verify that the line lengths of each line were accurate.
+         -- Note: Each data line was written to the file after the
+         -- particular line length had been set (to the data length).
+
+         if not ((TC_Length1 = Natural(Confidential_Data_Size)) and 
+                 (TC_Length2 = Natural(Secret_Data_Size))       and 
+                 (TC_Length3 = Natural(Top_Secret_Data_Size)))  then
+            Report.Failed ("Inaccurate line lengths read from file");
+         end if;
+
+         -- Verify that the data read from the file are accurate.
+ 
+         if (TC_String1(1..TC_Length1) /= Confidential_Item) or else
+            (TC_String2(1..TC_Length2) /= Secret_Item)       or else
+            (TC_String3(1..TC_Length3) /= Top_Secret_Item)   then
+            Report.Failed ("Corrupted data items read from file");
+         end if;
+
+      exception
+      
+         when Incomplete =>
+            raise; 
+
+         when others => 
+               Report.Failed ("Error raised during data verification");
+
+      end Test_Verification_Block;
+
+   exception
+
+         when Incomplete =>
+            raise; 
+
+         when others => 
+            Report.Failed ("Exception raised during Text_IO processing");
+
+      end Operational_Test_Block;
+
+      Deletion:
+      begin
+         -- Check that the file is open prior to deleting it.
+         if Text_IO.Is_Open(Data_File) then
+            Text_IO.Delete(Data_File);
+         else
+            Text_IO.Open(Data_File, Text_IO.In_File, Data_Filename);
+            Text_IO.Delete(Data_File);
+         end if;
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Text_IO" );
+   end Deletion;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa002.a
new file mode 100644
index 000000000..953d33f1d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa002.a
@@ -0,0 +1,257 @@
+-- CXAA002.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 procedures New_Page, Set_Line, Set_Col, and New_Line
+--      subprograms perform properly on a text file created with mode
+--      Append_File.
+--      Check that the attributes Page, Line, and Column are all set to 1
+--      following the creation of a text file with mode Append_File.
+--      Check that the functions Page, Line, and Col perform properly on a
+--      text file created with mode Append_File.
+--      Check that the procedures Put and Put_Line perform properly on text
+--      files created with mode Append_File.
+--      Check that the procedure Set_Line sets the current line number to
+--      the value specified by the parameter "To" for text files created with
+--      mode Append_File.  
+--      Check that the procedure Set_Col sets the current column number to
+--      the value specified by the parameter "To" for text files created with
+--      mode Append_File.
+--
+-- TEST DESCRIPTION:
+--      This test is designed to simulate the text processing that could
+--      occur with files that have been created in Append_File mode. Various
+--      calls to Text_IO formatting subprograms are called to properly
+--      position text appended to a document.  The text content and position
+--      are subsequently verified for accuracy.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA002 is
+   use Ada;
+      Data_File        : Text_IO.File_Type;
+      Data_Filename    : constant String := 
+                             Report.Legal_File_Name ( Nam => "CXAA002" );
+   Incomplete : exception;
+begin
+
+   Report.Test ("CXAA002", "Check that page, line, and column formatting " &
+                           "subprograms perform properly on text files "   &
+                           "created with mode Append_File");
+
+   Test_for_Text_IO_Support:
+   begin
+
+      -- An implementation that does not support Text_IO in a particular
+      -- environment will raise Use_Error on calls to various
+      -- Text_IO operations.  This block statement encloses a call to
+      -- Create, which should raise the exception in a non-supportive 
+      -- environment.  This exception will be handled to produce a
+      -- Not_Applicable result.
+
+      Text_IO.Create (File => Data_File,
+                      Mode => Text_IO.Append_File,
+                      Name => Data_Filename);
+
+   exception
+
+      when Text_IO.Use_Error | Text_IO.Name_Error =>
+         Report.Not_Applicable
+           ( "Files not supported - Create as Append_File for Text_IO" );
+         raise Incomplete;
+
+   end Test_for_Text_IO_Support;
+
+   Operational_Test_Block:
+   declare
+      Default_Position : constant Text_IO.Positive_Count := 1;
+      Section_Header   : constant String := "VII.  ";
+      Appendix_Title   : constant String := "Appendix A";
+      Appendix_Content : constant String := "TBD";
+
+      -- The following procedure simulates the addition of an Appendix page
+      -- to an existing text file.
+      procedure Position_Appendix_Text is
+         use Text_IO;   -- To provide visibility to the "/=" operator.
+      begin
+
+         -- Test control code.
+         -- Verify initial page, line, column number.
+         if "/="(Text_IO.Page (Data_File), Default_Position) then
+            Report.Failed ("Incorrect default page number");   
+         end if;
+         if Text_IO.Line (Data_File) /= Default_Position then
+            Report.Failed ("Incorrect default line number");     
+         end if;   
+         if "/="(Text_IO.Col (Data_File), Default_Position) then
+            Report.Failed ("Incorrect default column number");  
+         end if;   
+
+         -- Simulated usage code.
+         -- Set new page/line positions.
+         Text_IO.Put_Line
+           (Data_File, "Add some optional data to the file here");
+         Text_IO.New_Page (Data_File);      
+         Text_IO.New_Line (File => Data_File, Spacing => 2);
+      
+         -- Test control code.
+         if Integer(Text_IO.Page (Data_File)) /= Report.Ident_Int(2) or else
+            Integer(Text_IO.Line (Data_File)) /= Report.Ident_Int(3) then
+            Report.Failed ("Incorrect results from page/line positioning");
+         end if;
+
+         -- Simulated usage code.
+         Text_IO.Put      (Data_File, Section_Header);     -- Position title 
+         Text_IO.Put_Line (Data_File, Appendix_Title);     -- of Appendix.
+
+         Text_IO.Set_Line (File => Data_File, To => 5);    -- Set new 
+         Text_IO.Set_Col  (File => Data_File, To => 8);    -- position.
+
+         -- Test control code.
+         if (Integer(Text_IO.Line (Data_File)) /= Report.Ident_Int(5)) or  
+            (Integer(Text_IO.Col  (Data_File)) /= Report.Ident_Int(8)) then
+            Report.Failed ("Incorrect results from line/column positioning");
+         end if;
+                                                              
+         -- Simulated usage code.                          -- Position 
+         Text_IO.Put_Line (Data_File, Appendix_Content);   -- content of 
+                                                           -- Appendix.
+      end Position_Appendix_Text;
+
+   begin
+
+      -- This code section simulates a scenario that could occur in a 
+      -- text processing environment:
+      --    A document is created/modified/edited Then...
+      --    Text is to be appended to the document.
+      --    A procedure is called to perform that operation.  
+      --    The position on the appended page is set, verified, and text is 
+      --    appended to the existing file.  
+      -- 
+      -- Note: The text file has been originally created in Append_File
+      -- mode, and has not been closed prior to this processing.
+
+      Position_Appendix_Text;
+
+      Test_Verification_Block:
+      declare
+         TC_Page, 
+         TC_Line, 
+         TC_Column   : Text_IO.Positive_Count;
+         TC_Position : Natural := 0;
+         Blanks      : constant String  := "                 ";
+         TC_String   : String (1 .. 17) := Blanks;
+      begin   
+                                       
+         Reset1:
+         begin
+            Text_IO.Reset     (Data_File, Text_IO.In_File);
+         exception
+            when Text_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Text_IO" );
+               raise Incomplete;
+         end Reset1;
+
+         Text_IO.Skip_Page (Data_File);
+                                                 -- Loop to the third line
+         for I in 1 .. 3 loop                    -- and read the contents.
+            Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
+         end loop;
+
+         if (TC_Position /= 16) or else          -- Verify the title line.
+            (TC_String (1..4)  /= "VII.") or else             
+            (TC_String (3..16) /= ("I.  " & Appendix_Title)) then
+            Report.Failed ("Incorrect positioning of title line");
+         end if;
+
+         TC_String := Blanks;                    -- Clear string.
+                                                 -- Loop to the fifth line
+         for I in 4 .. 5 loop                    -- and read the contents.
+            Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
+         end loop;
+
+         if (TC_Position /= 10) or               -- Verify the contents.
+            (TC_String (8..10) /= Appendix_Content) then     
+            Report.Failed ("Incorrect positioning of contents line");
+         end if;
+
+      exception
+      
+         when Incomplete =>
+            raise; 
+
+         when others => 
+               Report.Failed ("Error raised during data verification");
+
+      end Test_Verification_Block;
+
+   exception
+
+         when Incomplete =>
+            raise; 
+
+         when others => 
+            Report.Failed ("Exception raised during Text_IO processing");
+
+   end Operational_Test_Block;
+
+   Deletion:
+   begin
+      -- Delete the external file.
+      if Text_IO.Is_Open(Data_File) then
+         Text_IO.Delete(Data_File);
+      else
+         Text_IO.Open(Data_File, Text_IO.In_File, Data_Filename);
+         Text_IO.Delete(Data_File);
+      end if;
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Text_IO" );
+   end Deletion;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa003.a
new file mode 100644
index 000000000..c9580dfb3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa003.a
@@ -0,0 +1,293 @@
+-- CXAA003.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 procedures New_Page, Set_Line, Set_Col, and New_Line
+--      subprograms perform properly on a text file reset (from Out_File) 
+--      with mode Append_File.
+--      Check that the attributes Page, Line, and Column are all set to 1
+--      following the reset of a text file with mode Append_File.
+--      Check that the functions Page, Line, and Col perform properly on a
+--      text file reset with mode Append_File.
+--      Check that the procedures Put and Put_Line perform properly on text
+--      files reset with mode Append_File.
+--      Check that the procedure Set_Line sets the current line number to
+--      the value specified by the parameter "To" for text files reset with
+--      mode Append_File.  Check that Set_Line has no effect if the specified
+--      line equals the current line.
+--      Check that the procedure Set_Col sets the current column number to
+--      the value specified by the parameter "To" for text files reset with
+--      mode Append_File.
+--
+-- TEST DESCRIPTION:
+--      This test is designed to simulate the text processing that could
+--      occur with files that have been created in Out_File mode,
+--      and then reset to Append_File mode. 
+--      Various calls to Text_IO formatting subprograms are called to properly
+--      position text appended to a document.  The text content and position
+--      are subsequently verified for accuracy.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      24 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA003 is
+   use Ada;  
+   Data_File        : Text_IO.File_Type;
+   Data_Filename    : constant String :=
+                      Report.Legal_File_Name ( Nam => "CXAA003" );
+   Incomplete       : exception;
+
+begin
+
+   Report.Test ("CXAA003", "Check that page, line, and column formatting " &
+                           "subprograms perform properly on text files "   &
+                           "reset with mode Append_File");
+
+   Test_for_Text_IO_Support:
+   begin
+
+      -- An implementation that does not support Text_IO in a particular
+      -- environment will raise Use_Error on calls to various
+      -- Text_IO operations.  This block statement encloses a call to
+      -- Create, which should raise the exception in a non-supportive 
+      -- environment.  This exception will be handled to produce a
+      -- Not_Applicable result.
+
+      Text_IO.Create (File => Data_File,
+                      Mode => Text_IO.Out_File,
+                      Name => Data_Filename);
+   exception
+      when Text_IO.Use_Error | Text_IO.Name_Error =>
+        Report.Not_Applicable
+          ( "Text files not supported - Create as Out_File" );
+        raise Incomplete;
+   end Test_for_Text_IO_Support;
+
+   Operational_Test_Block:
+   declare
+
+      Default_Position : constant Text_IO.Positive_Count := 1;
+
+      Section_Header   : constant String := "IX.  ";
+      Glossary_Title   : constant String := "GLOSSARY";
+      Glossary_Content : constant String := "TBD";
+
+      -- The following procedure simulates the addition of a Glossary page
+      -- to an existing text file that has been reset with mode 
+      -- Append_File.
+
+      procedure Position_Glossary_Text 
+        (The_File : in out Text_IO.File_Type) is
+         use Text_IO;   -- To provide visibility to the "/=" operator.
+      begin
+
+         -- Test control code.
+         -- Verify initial page value.
+         if (Text_IO.Page (The_File) /= Default_Position) then
+            Report.Failed ("Incorrect default page number");  
+         end if;
+         -- Verify initial line number.
+         if (Text_IO.Line (The_File) /= Default_Position) then
+            Report.Failed ("Incorrect default line number");  
+         end if;   
+         -- Verify initial column number.
+         if (Text_IO.Col (The_File) /= Default_Position) then 
+            Report.Failed ("Incorrect default column number");
+         end if;   
+         -- Simulated usage code.  Set new page/line positions.
+         Text_IO.New_Page (The_File);                           
+         Text_IO.New_Page (The_File);                       
+         Text_IO.New_Line (File => The_File, Spacing => 1); 
+
+         -- Test control code.
+         if (Integer(Text_IO.Page(The_File))  /= 
+             Report.Ident_Int(3))                or else
+            (Integer(Text_IO.Line (The_File)) /= 
+             Report.Ident_Int(2)) then 
+            Report.Failed ("Incorrect results from page/line positioning");
+         end if;
+
+         -- Simulated usage code.  Position title of Glossary.
+         Text_IO.Put      (The_File, Section_Header);        
+         Text_IO.Put_Line (The_File, Glossary_Title);        
+         -- Set line to the current line.
+         Text_IO.Set_Line (File => The_File, To => 3);       
+
+         -- Test control code.
+         if (Integer(Text_IO.Page (The_File)) /= Report.Ident_Int(3)) or
+            (Integer(Text_IO.Line (The_File)) /= Report.Ident_Int(3)) or
+            (Integer(Text_IO.Col (The_File))  /= Report.Ident_Int(1)) then
+            Report.Failed ("Set_Line failed for current line");
+         end if;
+
+         -- Simulated usage code.
+         Text_IO.Set_Line (File => The_File, To => 4);        -- Set new 
+         Text_IO.Set_Col  (File => The_File, To => 10);       -- position.
+
+         -- Test control code.
+         if (Integer(Text_IO.Line (The_File)) /= Report.Ident_Int(4))  or
+            (Integer(Text_IO.Col  (The_File)) /= Report.Ident_Int(10)) then
+            Report.Failed 
+              ("Incorrect results from line/column positioning");
+         end if;
+
+         -- Simulated usage code.                          -- Position 
+         Text_IO.Put_Line (The_File, Glossary_Content);    -- content of 
+                                                           -- Glossary.
+      end Position_Glossary_Text;
+
+
+   begin
+
+      -- In the scenario, data is added to the file here.
+      Text_IO.Put_Line (File => Data_File, Item => "Some optional data");
+
+      -- This code section simulates a scenario that could occur in a 
+      -- text processing environment.  Text is to be appended to an 
+      -- existing document: 
+      --   The file is reset to append mode.
+      --   A procedure is called to perform the positioning and placement
+      --   of text.
+      --   The position on the appended page is set, verified, and text is
+      --   placed in the file.  
+      -- 
+      -- Note: The text file has been originally created in Out_File
+      -- mode, and has subsequently been reset to Append_File mode.
+
+      Reset1:
+      begin
+         -- Reset has effect of calling New_Page.
+         Text_IO.Reset  (Data_File, Text_IO.Append_File);
+      exception
+         when Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to Append_File not supported for Text_IO" );
+            raise Incomplete;
+      end Reset1;
+
+      Position_Glossary_Text (The_File => Data_File);
+
+      Test_Verification_Block:
+      declare
+         TC_Page, TC_Line, TC_Column  : Text_IO.Positive_Count;
+         TC_Position                  : Natural := 0;
+         Blanks                       : constant String  :=
+           "               ";
+         TC_String                    : String (1 .. 15) := Blanks;
+      begin                                          
+         Reset2:
+         begin
+            Text_IO.Reset     (Data_File, Text_IO.In_File);
+         exception
+           when Text_IO.Use_Error =>
+             Report.Not_Applicable
+               ( "Reset to In_File not supported for Text_IO" );
+             raise Incomplete;
+         end Reset2;
+
+         Text_IO.Skip_Page (Data_File);
+         Text_IO.Skip_Page (Data_File);
+
+         -- If the Reset to Append_File mode actually put a page terminator
+         -- on the file, as allowed (but not required) by RM A.10.2(4), then
+         -- we are now on page 3, an empty page.  We'll need to skip one more.
+
+         if Text_IO.End_Of_Page (Data_File) then
+            Text_IO.Skip_Page (Data_File);
+         end if;
+
+         -- Now we're on the Glossary page.
+
+                                                -- Loop to the second line
+         for I in 1 .. 2 loop                   -- and read the contents.
+            Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
+         end loop;
+            if (TC_Position /= 13) or else         -- Verify the title line.
+               (TC_String (1..2)  /= "IX") or else             
+               (TC_String (3..13) /= (".  " & Glossary_Title)) then
+               Report.Failed ("Incorrect positioning of title line");
+            end if;
+
+            TC_String := Blanks;                   -- Clear string.
+                                                   -- Loop to the fourth line
+            for I in 3 .. 4 loop                   -- and read the contents.
+               Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
+            end loop;
+
+            if (TC_Position /= 12) or              -- Verify the contents.
+               (TC_String (8..12) /= "  " & Glossary_Content) then     
+               Report.Failed ("Incorrect positioning of contents line");
+            end if;
+
+         exception
+            when Incomplete =>
+               raise;
+            when others => 
+               Report.Failed ("Error raised during data verification");
+
+         end Test_Verification_Block;
+
+      exception
+         when Incomplete =>
+            raise;
+         when others => 
+            Report.Failed ("Exception raised during Text_IO processing");
+
+      end Operational_Test_Block;
+
+      Final_Block:
+      begin
+         -- Delete the external file.
+         if Text_IO.Is_Open (Data_File) then
+            Text_IO.Delete (Data_File);        
+         else
+            Text_IO.Open (Data_File, Text_IO.In_File, Data_Filename);
+            Text_IO.Delete (Data_File);        
+         end if;
+      exception
+         when others =>
+            Report.Failed ( "Delete not properly implemented for Text_IO" );
+      end Final_Block;
+
+   Report.Result;
+
+   exception
+     when Incomplete =>
+       Report.Result;
+     when others     =>
+       Report.Failed ( "Unexpected exception" );
+       Report.Result;
+
+end CXAA003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa004.a
new file mode 100644
index 000000000..f3ea17eba
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa004.a
@@ -0,0 +1,260 @@
+-- CXAA004.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 procedures New_Page, Set_Line, Set_Col, and New_Line
+--      perform properly on a text file opened with mode Append_File.
+--      Check that the attributes Page, Line, and Column are all set to 1
+--      following the opening of a text file with mode Append_File.
+--      Check that the functions Page, Line, and Col perform properly on a
+--      text file opened with mode Append_File.
+--      Check that the procedures Put and Put_Line perform properly on text
+--      files opened with mode Append_File.
+--      Check that the procedure Set_Line sets the current line number to
+--      the value specified by the parameter "To" for text files opened with
+--      mode Append_File. 
+--      Check that the procedure Set_Col sets the current column number to
+--      the value specified by the parameter "To" for text files reset with
+--      mode Append_File.
+--
+-- TEST DESCRIPTION:
+--      This test is designed to simulate the text processing that could
+--      occur with files that have been created in Out_File mode,
+--      and then reset to Append_File mode. 
+--      Various calls to Text_IO formatting subprograms are called to properly
+--      position text appended to a document.  The text content and position
+--      are subsequently verified for accuracy.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      24 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA004 is
+   use Ada;   
+   Data_File         : Text_IO.File_Type;
+   Data_Filename     : constant String :=
+                          Report.Legal_File_Name ( Nam => "CXAA004" );
+   Incomplete        : exception;
+
+begin
+
+   Report.Test ("CXAA004", "Check that page, line, and column formatting " &
+                           "subprograms perform properly on text files "   &
+                           "opened with mode Append_File");
+
+   Test_for_Text_IO_Support:
+   begin
+
+      -- An implementation that does not support Text_IO in a particular
+      -- environment will raise Use_Error on calls to various
+      -- Text_IO operations.  This block statement encloses a call to
+      -- Create, which should raise the exception in a non-supportive 
+      -- environment.  This exception will be handled to produce a
+      -- Not_Applicable result.
+
+      Text_IO.Create (File => Data_File,
+                      Mode => Text_IO.Out_File,
+                      Name => Data_Filename);
+
+   exception
+      when Text_IO.Use_Error | Text_IO.Name_Error =>
+         Report.Not_Applicable
+            ( "Files not supported - Create for Text_IO" );
+         raise Incomplete;
+   end Test_for_Text_IO_Support;
+
+   Operational_Test_Block:
+   declare
+      use Text_IO;  -- To provide visibility to the "/=" operator.
+
+      Default_Position  : constant Text_IO.Positive_Count := 1;
+
+      Section_Header    : constant String := "X.  ";
+      Reference_Title   : constant String := "REFERENCES";
+      Reference_Content : constant String := "Available Upon Request";
+
+   begin
+
+      -- Some amount of text processing would occur here in the scenario
+      -- following file creation, prior to file closure.
+      Text_IO.Put_Line (File => Data_File, Item => "Some optional data");
+
+      -- Close has the effect of a call to New_Page (adding a page
+      -- terminator).  
+      Text_IO.Close (Data_File);
+
+      -- This code section simulates a scenario that could occur in a 
+      -- text processing environment:
+      --     Certain text is to be appended to a document. 
+      --     The file is opened in Append_File mode.
+      --     The position on the appended page is set, verified, and text 
+      --     is placed in the file.  
+      --
+      -- Note: The text file has been originally created in Out_File
+      -- mode, has been subsequently closed and is now being reopened in
+      -- Append_File mode for further processing.
+
+         Text_IO.Open   (Data_File, Text_IO.Append_File, Data_Filename);
+
+      -- Test control code.
+      if (Text_IO.Page(Data_File) /= Default_Position) then -- Verify init.
+         Report.Failed ("Incorrect default page number");   -- page value.
+      end if;
+      if (Text_IO.Line(Data_File) /= Default_Position) then -- Verify init.
+         Report.Failed ("Incorrect default line number");   -- line number.
+      end if;   
+      if (Text_IO.Col (Data_File) /= Default_Position) then -- Verify init.
+         Report.Failed ("Incorrect default column number"); -- column no.
+      end if;   
+
+      -- Simulated usage code.
+      Text_IO.New_Page (Data_File);                        -- Set new page/
+      Text_IO.New_Line (File => Data_File, Spacing => 2);  -- line pos.
+      Text_IO.Put      (Data_File, Section_Header);        -- Position  
+      Text_IO.Put_Line (Data_File, Reference_Title);       -- title.
+
+      -- Test control code.                                -- Verify new
+      if (Integer(Text_IO.Page (Data_File)) /=             -- page and
+          Report.Ident_Int(2)) or else                     -- line.
+         (Integer(Text_IO.Line (Data_File)) /= 
+          Report.Ident_Int(4)) then                  
+         Report.Failed ("Incorrect results from page/line positioning");
+      end if;
+
+      -- Simulated usage code.                               
+      Text_IO.Set_Line (File => Data_File, To => 8);       -- Set new 
+      Text_IO.Set_Col  (File => Data_File, To => 30);      -- position.
+      Text_IO.Put_Line (Data_File, Reference_Content);      
+                                                             
+      -- Test control code.
+      if (Integer(Text_IO.Line (Data_File)) /= 
+          Report.Ident_Int(9))                   or         -- Verify new 
+         (Integer(Text_IO.Col  (Data_File)) /=              -- position.
+          Report.Ident_Int(1))                   then         
+         Report.Failed ("Incorrect results from line/column positioning");
+      end if;
+
+      Test_Verification_Block:
+      declare
+         TC_Page, TC_Line, TC_Column : Text_IO.Positive_Count;
+         TC_Position                 : Natural := 0;
+         TC_String                   : String (1 .. 55) := (others => ' ');
+      begin                                          
+
+         Reset1:
+         begin
+            Text_IO.Reset     (Data_File, Text_IO.In_File);
+         exception
+            when Text_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Text_IO" );
+               raise Incomplete;
+         end Reset1;
+
+         Text_IO.Skip_Page (Data_File);
+
+         -- If the Reset to Append_File mode actually put a page terminator
+         -- in the file, as allowed (but not required) by RM A.10.2(4), then
+         -- we are now on page 2, an empty page.  Therefore, we need to skip
+         -- one more page.
+
+         if Text_IO.End_Of_Page (Data_File) then
+            Text_IO.Skip_Page (Data_File);
+         end if;
+
+         -- Now we're on the reference page.
+
+                                                 -- Loop to the third line
+         for I in 1 .. 3 loop                    -- and read the contents.
+            Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
+         end loop;
+
+         if (TC_Position /= 14) or else          -- Verify the title line.
+            (TC_String (1..6)  /= "X.  RE") or else             
+            (TC_String (2..14) /= (".  " & Reference_Title)) then
+            Report.Failed ("Incorrect positioning of title line");
+         end if;
+                                                 -- Loop to the eighth line
+         for I in 4 .. 8 loop                    -- and read the contents.
+            Text_IO.Get_Line (Data_File, TC_String, TC_Position); 
+         end loop;
+
+         if (TC_Position /= 51) or               -- Verify the contents.
+            (TC_String (30..51) /= "Available Upon Request") then     
+            Report.Failed ("Incorrect positioning of contents line");
+         end if;
+
+      exception
+
+            when Incomplete =>
+               raise;      
+            when others => 
+               Report.Failed ("Error raised during data verification");
+
+      end Test_Verification_Block;
+
+   exception
+
+      when Incomplete =>
+         raise;
+      when others => 
+         Report.Failed ("Exception raised during Text_IO processing");
+
+   end Operational_Test_Block;
+
+   Final_Block:
+   begin
+      -- Delete the external file.
+      if Text_IO.Is_Open (Data_File) then
+         Text_IO.Delete (Data_File);        
+      else
+         Text_IO.Open (Data_File, Text_IO.In_File, Data_Filename);
+         Text_IO.Delete (Data_File);        
+      end if;
+   exception
+      when others =>
+         Report.Failed ( "Delete not properly implemented - Text_IO" );
+   end Final_Block;
+
+   Report.Result;
+
+exception
+
+   when Incomplete =>
+      Report.Result;
+   when others =>
+      Report.Failed ("Unexpected exception");
+      Report.Result;
+
+end CXAA004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa005.a
new file mode 100644
index 000000000..7b2a0bc39
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa005.a
@@ -0,0 +1,292 @@
+-- CXAA005.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 procedure Put, when called with string parameters, does
+--      not update the line number of a text file of mode Append_File, when
+--      the line length is unbounded (i.e., only the column number is 
+--      updated).
+--      Check that a call to the procedure Put with a null string argument
+--      has no measurable effect on a text file of mode Append_File.
+--      
+-- TEST DESCRIPTION:
+--      This test is designed to ensure that when a string is appended to an
+--      unbounded text file, it is placed following the last element currently
+--      in the file.  For an unbounded text file written with Put procedures
+--      only (not Put_Line), the line number should not be incremented by
+--      subsequent calls to Put in Append_File mode.  Only the column number
+--      should be incremented based on the length of the string parameter 
+--      placed in the file.  If a call to Put with a null string argument is
+--      made, no change to the line or column number should occur, and no
+--      element(s) should be added to the file, so that there would be no 
+--      measurable change to the file.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that support Text_IO
+--      processing and external files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      24 Feb 97   CTA.PWB Allowed for non-support of some IO operations.
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA005 is
+   An_Unbounded_File   : Ada.Text_IO.File_Type;
+   Unbounded_File_Name : constant String := 
+                            Report.Legal_File_Name ( Nam => "CXAA005" ); 
+   Incomplete          : exception;
+
+begin
+
+   Report.Test ("CXAA005", "Check that the procedure Put does not " &
+                           "increment line numbers when used with " &
+                           "unbounded text files of mode Append_File");
+
+   Test_for_Text_IO_Support:
+   begin
+
+   -- An application creates a text file in mode Out_File, with the intention
+   -- of entering string data packets into the file as appropriate.  In the 
+   -- event that the particular environment where the application is running 
+   -- does not support Text_IO, Use_Error will be raised on calls to Text_IO 
+   -- operations.  
+   -- This exception will be handled to produce a Not_Applicable result.
+
+      Ada.Text_IO.Create (File => An_Unbounded_File,
+                          Mode => Ada.Text_IO.Out_File,
+                          Name => Unbounded_File_Name);
+   exception
+      when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
+         Report.Not_Applicable
+            ( "Files not supported - Create for Text_IO" );
+         raise Incomplete;
+   end Test_For_Text_IO_Support;
+
+   Operational_Test_Block:
+   declare
+      subtype String_Sequence_Type is string (1 .. 20);
+      type    String_Pointer_Type  is access String_Sequence_Type;
+
+-- During the course of processing, the application creates a variety of data
+-- pointers that refer to particular data items.  The possibility of having
+-- null data values in this environment exists.
+
+      Data_Packet_1     : String_Pointer_Type := 
+        new String_Sequence_Type'("One Data Sequence 01");
+
+      Data_Packet_2     : String_Pointer_Type :=
+        new String_Sequence_Type'("New Data Sequence 02");
+          
+      Blank_Data_Packet : String_Pointer_Type :=
+        new String_Sequence_Type'("                    ");
+
+      Null_Data_Packet  : constant String     := "";
+
+      TC_Line, TC_Col   : Natural := 0;
+
+      function TC_Mode_Selection (Selector : Integer) 
+         return Ada.Text_IO.File_Mode is
+      begin
+         case Selector is
+            when 1       => return Ada.Text_IO.In_File;
+            when 2       => return Ada.Text_IO.Out_File;
+            when others  => return Ada.Text_IO.Append_File;
+         end case;
+      end TC_Mode_Selection;
+
+   begin                                         
+
+-- The application places some data into the file, using the Put subroutine.
+-- This operation can occur one-to-many times.
+
+       Ada.Text_IO.Put (An_Unbounded_File, Data_Packet_1.all);
+   
+       -- Test control code.
+       if (Integer(Ada.Text_IO.Col (An_Unbounded_File))  /=
+           Report.Ident_Int(21))                            or
+          (Integer(Ada.Text_IO.Line (An_Unbounded_File)) /=
+           Report.Ident_Int(1))                             then
+          Report.Failed ("Incorrect Col position after 1st Put");
+       end if;
+
+-- The application may close the file at some point following its initial 
+-- entry of data.
+
+      Ada.Text_IO.Close (An_Unbounded_File);
+
+-- At some later point in the processing, more data needs to be added to the
+-- file, so the application opens the file in Append_File mode.
+
+      Ada.Text_IO.Open (File => An_Unbounded_File,
+                        Mode => Ada.Text_IO.Append_File,
+                        Name => Unbounded_File_Name);
+
+      -- Test control code.
+      -- Store line/column number for later comparison.
+      TC_Line := Natural(Ada.Text_IO.Line(An_Unbounded_File));
+      TC_Col  := Natural(Ada.Text_IO.Col(An_Unbounded_File));
+
+-- Additional data items can then be appended to the file.
+
+      Ada.Text_IO.Put (An_Unbounded_File, Blank_Data_Packet.all);
+
+      -- Test control code.
+      if (Natural(Ada.Text_IO.Col (An_Unbounded_File))  /=
+          (TC_Col + 20))                                   or
+         (Natural(Ada.Text_IO.Line (An_Unbounded_File)) /=
+          TC_Line)                                         then
+         Report.Failed ("Incorrect Col position after 2nd Put");
+      end if;
+
+-- In order to accommodate various scenarios, the application may have changed
+-- the mode of the data file to In_File in order to retrieve/verify some of 
+-- the data contained there.  However, with the need to place more data into 
+-- the file, the file can be reset to Append_File mode.
+
+      Reset1:
+      begin
+         Ada.Text_IO.Reset (An_Unbounded_File, 
+                            TC_Mode_Selection (Report.Ident_Int(3)));
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to Append_File not supported for Text_IO" );
+            raise Incomplete;
+      end Reset1;
+
+      -- Test control code.
+      -- Store line/column number for later comparison.
+      TC_Line := Natural(Ada.Text_IO.Line(An_Unbounded_File));
+      TC_Col  := Natural(Ada.Text_IO.Col(An_Unbounded_File));
+
+-- Additional data can then be appended to the file.  On some occasions, an
+-- attempt to enter a null string value into the file may occur.  This should
+-- have no effect on the file, leaving it unchanged.
+
+      -- No measurable effect from Put with null string.
+      Ada.Text_IO.Put (An_Unbounded_File, Null_Data_Packet);
+
+      -- Test control code.
+      -- There should be no change following the Put above.
+      if (Natural(Ada.Text_IO.Col (An_Unbounded_File))  /= 
+          TC_Col)                                          or
+         (Natural(Ada.Text_IO.Line (An_Unbounded_File)) /= 
+          TC_Line)                                         then
+         Report.Failed ("Incorrect Col position after 3rd Put");
+      end if;
+
+-- Additional data can be appended to the file.
+
+      Ada.Text_IO.Put (An_Unbounded_File, Data_Packet_2.all);
+
+      -- Test control code.
+      if (Natural(Ada.Text_IO.Col (An_Unbounded_File))  /=
+          (TC_Col + 20))                                    or
+         (Integer(Ada.Text_IO.Line (An_Unbounded_File)) /=
+          TC_Line)                                         then
+         Report.Failed ("Incorrect Col position after 4th Put");
+      end if;
+
+      Test_Verification_Block:                  
+      declare                                   
+         File_Data : String (1 .. 80);
+         TC_Width  : Natural;
+      begin                                                
+   
+-- The application has the capability to reset the file to In_File mode to
+-- verify some of the data that is contained there.
+
+      Reset2:
+      begin
+         Ada.Text_IO.Reset (An_Unbounded_File, Ada.Text_IO.In_File);
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to In_File not supported - Text_IO" );
+            raise Incomplete;
+      end Reset2;
+
+      Ada.Text_IO.Get_Line (An_Unbounded_File,
+                            File_Data, 
+                            TC_Width);
+
+      -- Test control code.
+      -- Since it is implementation defined whether a page
+      -- terminator separates preexisting text from new text 
+      -- following an open in append mode (as occurred above), 
+      -- verify only that the first data item written to the
+      -- file was not overwritten by any subsequent call to Put.
+
+      if (File_Data (File_Data'First) /= 'O') or
+          (File_Data (20)              /= '1') then
+         Report.Failed ("Data placed incorrectly in file");
+      end if;
+
+      exception
+         when Incomplete =>
+            raise;
+         when others => 
+            Report.Failed ("Error raised during data verification");
+      end Test_Verification_Block;
+
+   exception
+      when Incomplete =>
+         raise;
+      when others => 
+         Report.Failed ("Exception in Text_IO processing");
+   end Operational_Test_Block;
+
+   Final_Block:
+   begin
+      -- Delete the external file.
+      if Ada.Text_IO.Is_Open(An_Unbounded_File) then
+         Ada.Text_IO.Delete (An_Unbounded_File);
+      else
+         Ada.Text_IO.Open(An_Unbounded_File, 
+                          Ada.Text_IO.In_File,
+                          Unbounded_File_Name);
+         Ada.Text_IO.Delete (An_Unbounded_File);
+      end if;
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented -- Text_IO" );
+   end Final_Block;
+
+   Report.Result;
+
+exception
+
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa006.a
new file mode 100644
index 000000000..518d43b89
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa006.a
@@ -0,0 +1,285 @@
+-- CXAA006.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 for a bounded line length text file of mode Append_File,
+--      when the number of characters to be output exceeds the number of 
+--      columns remaining on the current line, a call to Put will output 
+--      characters of the string sufficient to fill the remaining columns of 
+--      the line (up to line length), then output a line terminator, reset the 
+--      column number, increment the line number, then output the balance of 
+--      the item.
+--      
+--      Check that the procedure Put does not raise Layout_Error when the 
+--      number of characters to be output exceeds the line length of a bounded
+--      text file of mode Append_File.
+--      
+-- TEST DESCRIPTION:
+--      This test demonstrates the situation where an application intends to 
+--      output variable length string elements to a text file in the most
+--      efficient manner possible.  This is the case in a typesetting 
+--      environment where text is compressed and split between lines of a 
+--      bounded length.
+--
+--      The procedure Put will break string parameters placed in the file at
+--      the point of the line length.  Two examples are demonstrated in this
+--      test, one being the case where only one column remains on a line, and
+--      the other being the case where a larger portion of the line remains
+--      unfilled, but still not sufficient to contain the entire output
+--      string.
+--
+--      During the course of the test, the file is reset to Append_File mode,
+--      and the bounded line length is modified for different lines of the
+--      file.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that support Text_IO
+--      processing and external files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA006 is
+
+   A_Bounded_File    : Ada.Text_IO.File_Type;
+   Bounded_File_Name : constant String := 
+                       Report.Legal_File_Name ( Nam => "CXAA006" );
+   Incomplete : exception;
+
+begin
+
+   Report.Test ("CXAA006", "Check that procedure Put will correctly " &
+                           "output string items to a bounded line "   &
+                           "length text file of mode Append_File");
+
+   Test_for_Text_IO_Support:
+   begin
+
+-- An application creates a text file in mode Append_File, with the intention 
+-- of using the procedure Put to compress variable length string data into the 
+-- file in the most efficient manner possible.  
+
+     Ada.Text_IO.Create (File => A_Bounded_File,
+                         Mode => Ada.Text_IO.Append_File,
+                         Name => Bounded_File_Name);
+   exception
+      when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
+         Report.Not_Applicable
+            ( "Files not supported - Create with Append_File for Text_IO" );
+         raise Incomplete;
+   end Test_For_Text_IO_Support;
+
+   Operational_Test_Block:
+   declare
+      Twelve_Characters   : constant String := "12Characters";
+      Nineteen_Characters : constant String := "Nineteen_Characters";
+      TC_Line             : Natural := 0;
+
+      function TC_Mode_Selection (Selector : Integer) 
+      return Ada.Text_IO.File_Mode is
+      begin
+         case Selector is
+            when 1       => return Ada.Text_IO.In_File;
+            when 2       => return Ada.Text_IO.Out_File;
+            when others  => return Ada.Text_IO.Append_File;
+         end case;
+      end TC_Mode_Selection;
+
+   begin
+
+-- The application sets the line length of the file to be bound at 20.  All
+-- lines in this file will be limited to that length.
+
+      Ada.Text_IO.Set_Line_Length (A_Bounded_File, 20);
+
+      Ada.Text_IO.Put (A_Bounded_File, Nineteen_Characters);
+
+      -- Test control code.
+      if (Integer(Ada.Text_IO.Line (A_Bounded_File)) /=
+          Report.Ident_Int(1))                         or
+         (Integer(Ada.Text_IO.Col (A_Bounded_File))  /=
+          Report.Ident_Int(20))                        then
+         Report.Failed ("Incorrect position after 1st Put");
+      end if;
+
+-- The application finds that there is only one column available on the
+-- current line, so the next string item to be output must be broken at 
+-- the appropriate place (following the first character).
+
+      Ada.Text_IO.Put (File => A_Bounded_File, 
+                       Item => Twelve_Characters);
+
+      -- Test control code.
+      if (Integer(Ada.Text_IO.Line (A_Bounded_File)) /=
+          Report.Ident_Int(2))                         or
+         (Integer(Ada.Text_IO.Col (A_Bounded_File))  /=
+          Report.Ident_Int(12))                        then
+         Report.Failed ("Incorrect position after 2nd Put");
+      end if;
+
+-- The application subsequently modifies the processing, resetting the file
+-- at this point to In_File mode in order to verify data that has been written 
+-- to the file. Following this, the application resets the file to Append_File
+-- mode in order to continue the placement of data into the file, but modifies
+-- the original bounded line length for subsequent lines to be appended.
+
+      -- Reset to Append mode; call outputs page terminator and
+      -- resets line length to Unbounded.
+      Reset1:
+      begin
+         Ada.Text_IO.Reset (A_Bounded_File, 
+                            TC_Mode_Selection (Report.Ident_Int(3)));
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to Append_File not supported for Text_IO" );
+            raise Incomplete;
+      end Reset1;
+
+      Ada.Text_IO.Set_Line_Length (A_Bounded_File, 15);
+
+      -- Store line number for later comparison.
+      TC_Line := Natural(Ada.Text_IO.Line(A_Bounded_File));
+
+-- The application finds that fifteen columns are available on the current
+-- line but that the string item to be output exceeds this available space.
+-- It must be split at the end of the line, and the balance placed on the
+-- next file line.
+
+      Ada.Text_IO.Put (File => A_Bounded_File, 
+                       Item => Nineteen_Characters);
+
+      -- Test control code.
+      -- Positioned on new line at col 5.
+      if (Natural(Ada.Text_IO.Line (A_Bounded_File)) /=
+          (TC_Line + 1))                                 or
+         (Integer(Ada.Text_IO.Col (A_Bounded_File))  /=
+          Report.Ident_Int(5))                          then
+         Report.Failed ("Incorrect position after 3rd Put");
+      end if;
+
+
+      Test_Verification_Block:                  
+      declare                                   
+         First_String  : String (1 .. 80);
+         Second_String : String (1 .. 80);
+         Third_String  : String (1 .. 80);
+         Fourth_String : String (1 .. 80);
+         TC_Width1     : Natural;
+         TC_Width2     : Natural;
+         TC_Width3     : Natural;
+         TC_Width4     : Natural;
+      begin  
+
+-- The application has the capability to reset the file to In_File mode to
+-- verify some or all of the data that is contained there.
+
+         Reset2:
+         begin
+            Ada.Text_IO.Reset    (A_Bounded_File, Ada.Text_IO.In_File);
+         exception
+            when others =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Text_IO" );
+               raise Incomplete;
+         end Reset2;
+
+         Ada.Text_IO.Get_Line 
+            (A_Bounded_File, First_String,  TC_Width1);
+         Ada.Text_IO.Get_Line 
+            (A_Bounded_File, Second_String, TC_Width2);
+         Ada.Text_IO.Get_Line 
+            (A_Bounded_File, Third_String,  TC_Width3);
+         Ada.Text_IO.Get_Line 
+            (A_Bounded_File, Fourth_String, TC_Width4);
+
+         -- Test control code.
+         if (First_String (1..TC_Width1) /= Nineteen_Characters & "1")  or
+            (Second_String (1..TC_Width2) /= "2Characters")             or
+            (Third_String (1..TC_Width3)  /= 
+             Nineteen_Characters(1..15))                                or
+            (Fourth_String (1..TC_Width4) /= "ters")
+         then
+            Report.Failed ("Data placed incorrectly in file");
+         end if;
+
+      exception
+
+         when Incomplete =>
+            raise;
+
+         when Ada.Text_IO.End_Error =>
+            Report.Failed ("Incorrect number of lines in file");
+
+         when others            => 
+            Report.Failed ("Error raised during data verification");
+
+      end Test_Verification_Block;
+
+   exception
+
+      when Ada.Text_IO.Layout_Error => 
+         Report.Failed ("Layout Error raised when positioning text");
+
+      when others               => 
+         Report.Failed ("Exception in Text_IO processing");
+
+   end Operational_Test_Block;
+
+   Final_Block:
+   begin
+      -- Delete the external file.
+      if Ada.Text_IO.Is_Open(A_Bounded_File) then
+         Ada.Text_IO.Delete (A_Bounded_File);
+      else
+         Ada.Text_IO.Open (A_Bounded_File, 
+                           Ada.Text_IO.In_File,
+                           Bounded_File_Name);
+         Ada.Text_IO.Delete (A_Bounded_File);
+      end if;
+
+   exception
+      when others =>
+         Report.Failed 
+            ( "Delete not properly implemented for Text_IO" );
+   end Final_Block;
+
+   Report.Result;
+
+exception
+
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa007.a
new file mode 100644
index 000000000..fe79c2d7a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa007.a
@@ -0,0 +1,263 @@
+-- CXAA007.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 capabilities of Text_IO.Integer_IO perform correctly
+--      on files of Append_File mode, for instantiations with integer and
+--      user-defined subtypes.
+--      Check that the formatting parameters available in the package can
+--      be used and modified successfully in the storage and retrieval of
+--      data.
+--      
+-- TEST DESCRIPTION:
+--      This test simulates a receiving department inventory system.  Data on
+--      items received is entered into an inventory database. This information
+--      consists of integer entry number, item number, and bar code.  
+--      One item is placed into the inventory file immediately following file
+--      creation, subsequent items are entered following file opening in 
+--      Append_File mode.  Data items are validated by reading all data from
+--      the file and comparing against known values (those used to enter the
+--      data originally).  
+--      
+--      This test verifies issues of create in Append_File mode, appending to
+--      a file previously appended to, opening in Append_File mode, resetting
+--      from Append_File mode to In_File mode, as well as a variety of Text_IO
+--      and Integer_IO predefined subprograms.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA007 is
+   use Ada;
+
+   Inventory_File     : Text_IO.File_Type;
+   Inventory_Filename : constant String :=
+                           Report.Legal_File_Name ( Nam => "CXAA007" );
+   Incomplete         : exception;
+
+begin
+
+   Report.Test ("CXAA007", "Check that the capabilities of "                 &
+                           "Text_IO.Integer_IO operate correctly for files " &
+                           "with mode Append_File");
+
+   Test_for_Text_IO_Support:
+   begin
+
+      -- An implementation that does not support Text_IO in a particular
+      -- environment will raise Use_Error on calls to various
+      -- Text_IO operations.  This block statement encloses a call to
+      -- Create, which should raise the exception in a non-supportive 
+      -- environment.  This exception will be handled to produce a
+      -- Not_Applicable result.
+
+      Text_IO.Create (File => Inventory_File,
+                      Mode => Text_IO.Append_File,
+                      Name => Inventory_Filename);
+   exception
+      when Text_IO.Use_Error | Text_IO.Name_Error =>
+         Report.Not_Applicable
+            ( "Files not supported - Create with Append_File for Text_IO" );
+         raise Incomplete;
+   end Test_for_Text_IO_Support;
+
+   Operational_Test_Block:
+   declare
+
+      Max_Entries_Per_Order : constant Natural := 4;
+
+      type Bar_Code_Type is range 0 .. 127; -- Values to be stored as base
+                                            -- two numbers in file.
+      type Item_Type is record
+         Entry_Number : Natural        := 0;
+         Item_Number  : Integer        := 0;
+         Bar_Code     : Bar_Code_Type  := 0;
+      end record;   
+
+      type Inventory_Type is 
+        array (1 .. Max_Entries_Per_Order) of Item_Type;
+
+      Inventory_List : Inventory_Type := ((1, 119,  87), -- Items received
+                                          (2, 206,  44), -- this order.
+                                          (3, -25, 126),
+                                          (4, -18, 31));
+
+      Daily_Order        : constant := 1;
+      Entry_Field_Width  : constant Natural :=  1;
+      Item_Base          : constant Natural := 16;
+      Items_Inventoried  : Natural := 1;
+      Items_To_Inventory : Natural := 4;
+
+      package Entry_IO    is new Text_IO.Integer_IO (Natural);
+      package Item_IO     is new Text_IO.Integer_IO (Integer);
+      package Bar_Code_IO is new Text_IO.Integer_IO (Bar_Code_Type);
+
+
+      -- The following procedure simulates the addition of inventory item 
+      -- information into a data file.
+
+      procedure Update_Inventory (The_Item : in Item_Type) is
+         Spacer : constant String := "   ";
+      begin
+         -- Enter all the incoming data into the inventory file.
+         Entry_IO.Put   (Inventory_File, The_Item.Entry_Number);
+         Text_IO.Put    (Inventory_File, Spacer);
+         Item_IO.Put    (Inventory_File, The_Item.Item_Number); 
+         Text_IO.Put    (Inventory_File, Spacer);
+         Bar_Code_IO.Put(File  => Inventory_File, 
+                         Item  => The_Item.Bar_Code,
+                         Width => 13,
+                         Base  =>  2);
+         Text_IO.New_Line(Inventory_File);
+      end Update_Inventory;
+
+
+   begin
+
+      -- This code section simulates a receiving department maintaining a
+      -- data file containing information on items that have been ordered
+      -- and received.  
+      --
+      -- As new orders are received, the file is opened in Append_File
+      -- mode.
+      -- Data is taken from the inventory list and entered into the file, 
+      -- in specific format.
+      -- Enter the order into the inventory file.  This is item 1 in
+      -- the inventory list.  
+      -- The data entry process can be repeated numerous times as required.
+
+      Entry_IO.Put     (Inventory_File, 
+                        Inventory_List(Daily_Order).Entry_Number);    
+      Item_IO.Put      (Inventory_File, 
+                        Inventory_List(Daily_Order).Item_Number);
+      Bar_Code_IO.Put  (File  => Inventory_File, 
+                        Item  => Inventory_List(Daily_Order).Bar_Code); 
+      Text_IO.New_Line (Inventory_File);
+     
+      Text_IO.Close    (Inventory_File);
+
+
+      Entry_IO.Default_Width := Entry_Field_Width;  -- Modify the default
+                                                    -- width of Entry_IO.
+      Item_IO.Default_Base   := Item_Base;          -- Modify the default
+                                                    -- number base of
+                                                    -- Item_IO
+      Text_IO.Open (Inventory_File, 
+                    Text_IO.Append_File,            -- Open in Append mode.
+                    Inventory_Filename);
+                                                          -- Enter items
+      while (Items_Inventoried < Items_To_Inventory) loop -- 2-4 into the
+         Items_Inventoried := Items_Inventoried + 1;     -- inventory file.
+         Update_Inventory (The_Item => Inventory_List (Items_Inventoried));
+      end loop;
+
+      Test_Verification_Block:                           -- Read and check
+      declare                                            -- all the data
+         TC_Entry      : Natural;                        -- values that
+         TC_Item       : Integer;                        -- have been
+         TC_Bar_Code   : Bar_Code_Type;                  -- entered in the
+         TC_Item_Count : Natural := 0;                   -- data file.
+      begin                                                
+
+         Reset1:
+         begin
+            Text_IO.Reset (Inventory_File, Text_IO.In_File);  -- Reset for
+                                                              -- reading.
+         exception
+            when Text_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to mode In_File not supported for Text_IO" );
+               raise Incomplete;
+         end Reset1;
+
+         while not Text_IO.End_Of_File (Inventory_File) loop
+            Entry_IO.Get      (Inventory_File, TC_Entry);
+            Item_IO.Get       (Inventory_File, TC_Item);
+            Bar_Code_IO.Get   (Inventory_File, TC_Bar_Code);
+            Text_IO.Skip_Line (Inventory_File);
+            TC_Item_Count := TC_Item_Count + 1;
+
+            if (TC_Item     /= Inventory_List(TC_Entry).Item_Number) or
+               (TC_Bar_Code /= Inventory_List(TC_Entry).Bar_Code)    then
+               Report.Failed ("Error in integer data read from file");
+            end if;
+         end loop;
+
+         if (TC_Item_Count /= Max_Entries_Per_Order) then
+            Report.Failed ("Incorrect number of records read from file");
+         end if;
+
+      exception
+         when Incomplete =>
+            raise; 
+        when others => 
+            Report.Failed ("Error raised during data verification");
+      end Test_Verification_Block;
+        
+   exception
+      when Incomplete =>
+         raise;
+      when others => 
+         Report.Failed ("Exception in Text_IO.Integer_IO processing");
+   end Operational_Test_Block;
+
+   Final_Block:
+   begin
+      -- Delete the external file.
+      if Text_IO.Is_Open(Inventory_File) then
+         Text_IO.Delete (Inventory_File);      
+      else
+         Text_IO.Open (Inventory_File, Text_IO.In_File, Inventory_Filename);
+         Text_IO.Delete (Inventory_File);
+      end if;
+
+   exception
+
+      when others =>
+         Report.Failed ( "Delete not properly implemented for Text_IO" );
+
+   end Final_Block;
+
+   Report.Result;
+
+exception
+
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa008.a
new file mode 100644
index 000000000..c21d07ea9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa008.a
@@ -0,0 +1,271 @@
+-- CXAA008.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 capabilities provided in instantiations of the 
+--      Ada.Text_IO.Fixed_IO package operate correctly when the mode of
+--      the file is Append_File.  Check that Fixed_IO procedures Put and Get 
+--      properly transfer fixed point data to/from data files that are in
+--      Append_File mode.  Check that the formatting parameters available in 
+--      the package can be used and modified successfully in the appending and 
+--      retrieval of data.
+--      
+-- TEST DESCRIPTION:
+--      This test simulates order processing, with data values being written
+--      to a file, in a specific format, using Fixed_IO.  Validation is done
+--      on this process by reading the data values from the file, and 
+--      comparing them for equality with the values originally written to 
+--      the file.
+--      
+--      This test verifies issues of create in Append_File mode, appending to
+--      a file previously appended to, resetting to Append_File mode, 
+--      resetting from Append_File mode to In_File mode, as well as a 
+--      variety of Text_IO and Fixed_IO predefined subprograms.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA008 is
+   use Ada;
+
+   Inventory_File     : Text_IO.File_Type;
+   Inventory_Filename : constant String :=
+                          Report.Legal_File_Name ( Nam => "CXAA008" );
+   Incomplete         : exception;
+
+begin
+
+   Report.Test ("CXAA008", "Check that the capabilities of "               &
+                           "Text_IO.Fixed_IO operate correctly for files " &
+                           "with mode Append_File");
+
+   Test_for_Text_IO_Support:
+   begin
+
+      -- An implementation that does not support Text_IO in a particular
+      -- environment will raise Use_Error on calls to various
+      -- Text_IO operations.  This block statement encloses a call to
+      -- Create, which should raise the exception in a non-supportive 
+      -- environment.  This exception will be handled to produce a
+      -- Not_Applicable result.
+
+      Text_IO.Create (File => Inventory_File,
+                      Mode => Text_IO.Append_File,
+                      Name => Inventory_Filename);
+
+   exception
+      when Text_IO.Use_Error | Text_IO.Name_Error =>
+         Report.Not_Applicable
+            ( "Files not supported - Create with Append_File for Text_IO" );
+         raise Incomplete;
+   end Test_For_Text_IO_Support;
+
+   Operational_Test_Block:
+   declare
+
+      Daily_Orders_Received : constant Natural := 4;
+
+      type Item_Type   is delta 0.1  range    0.0 .. 5000.0;
+      type Cost_Type   is delta 0.01 range    0.0 .. 10_000.0;
+      type Profit_Type is delta 0.01 range -100.0 .. 1000.0;
+
+      type Product_Type is record
+         Item_Number    : Item_Type   := 0.0;
+         Unit_Cost      : Cost_Type   := 0.00;
+         Percent_Markup : Profit_Type := 0.00;
+      end record;   
+
+      type Inventory_Type is 
+        array (1 .. Daily_Orders_Received) of Product_Type;
+
+      Daily_Inventory   : Inventory_Type := ((   1.0,   1.75,  50.00),  
+                                             ( 155.0,  20.00,  -5.50),  
+                                             (3343.5,   2.50, 126.50),
+                                             (4986.0, 180.00,  31.75));
+
+      package Item_IO   is new Text_IO.Fixed_IO (Item_Type);
+      package Cost_IO   is new Text_IO.Fixed_IO (Cost_Type);
+      package Markup_IO is new Text_IO.Fixed_IO (Profit_Type);
+
+
+      function TC_Mode_Selection (Selector : Integer) 
+        return Text_IO.File_Mode is
+      begin
+         case Selector is
+            when 1       => return Text_IO.In_File;
+            when 2       => return Text_IO.Out_File;
+            when others  => return Text_IO.Append_File;
+         end case;
+      end TC_Mode_Selection;
+
+
+      -- The following function simulates the addition of inventory item 
+      -- information into a data file.  Boolean status of True is returned
+      -- if all of the data entry was successful, False otherwise.
+
+      function Update_Inventory (The_List : Inventory_Type) 
+        return Boolean is
+      begin
+         for I in 1 .. Daily_Orders_Received loop
+            Item_IO.Put  (Inventory_File, The_List(I).Item_Number);    
+            Cost_IO.Put  (Inventory_File, The_List(I).Unit_Cost, 10, 4, 0);
+            Markup_IO.Put(File => Inventory_File, 
+                          Item => The_List(I).Percent_Markup,
+                          Fore => 6,
+                          Aft  => 3,
+                          Exp  => 2);
+            Text_IO.New_Line (Inventory_File);
+         end loop;
+         return (True);                         -- Return a Status value.
+      exception
+         when others => return False;
+      end Update_Inventory;
+
+
+   begin
+
+      -- This code section simulates a receiving department maintaining a
+      -- data file containing information on items that have been ordered
+      -- and received. 
+
+      -- Whenever items are received, the file is reset to Append_File
+      -- mode.  Data is taken from an inventory list and entered into the
+      -- file, in specific format.  
+
+      Reset1:
+      begin                                                -- Reset to 
+         Text_IO.Reset (Inventory_File,                    -- Append mode.
+                        TC_Mode_Selection (Report.Ident_Int(3))); 
+      exception
+         when Text_IO.Use_Error =>
+            Report.Not_Applicable 
+               ( "Reset to Append_File not supported for Text_IO" );
+      end Reset1;
+
+                                                           -- Enter data.
+      if not Update_Inventory (The_List => Daily_Inventory) then
+         Report.Failed ("Exception occurred during inventory update");
+         raise Incomplete;
+      end if;
+
+      Test_Verification_Block:                             
+      declare                                              
+         TC_Item       : Item_Type;
+         TC_Cost       : Cost_Type;
+         TC_Markup     : Profit_Type;
+         TC_Item_Count : Natural := 0;                     
+      begin                                                
+
+         Reset2:
+         begin
+            Text_IO.Reset (Inventory_File, Text_IO.In_File);  -- Reset for
+                                                              -- reading.
+         exception
+            when Text_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Text_IO" );
+               raise Incomplete;
+         end Reset2;
+
+         while not Text_IO.End_Of_File (Inventory_File) loop
+            Item_IO.Get   (Inventory_File, TC_Item);    
+            Cost_IO.Get   (Inventory_File, TC_Cost);
+            Markup_IO.Get (File  => Inventory_File, 
+                           Item  => TC_Markup,
+                           Width => 0);
+            Text_IO.Skip_Line (Inventory_File);
+            TC_Item_Count := TC_Item_Count + 1;
+
+            -- Verify all of the data fields read from the file.  Compare
+            -- with the values that were originally entered into the file.
+
+            if (TC_Item /= Daily_Inventory(TC_Item_Count).Item_Number) then
+               Report.Failed ("Error in Item_Number read from file");
+            end if;
+            if (TC_Cost /= Daily_Inventory(TC_Item_Count).Unit_Cost) then
+               Report.Failed ("Error in Unit_Cost read from file");
+            end if;
+            if not (TC_Markup = 
+                    Daily_Inventory(TC_Item_Count).Percent_Markup) then
+               Report.Failed ("Error in Percent_Markup read from file");
+            end if;
+
+         end loop;
+
+         if (TC_Item_Count /= Daily_Orders_Received) then
+            Report.Failed ("Incorrect number of records read from file");
+         end if;
+
+      exception
+         when Incomplete =>
+            raise;
+         when others => 
+            Report.Failed ("Error raised during data verification");
+      end Test_Verification_Block;
+
+   exception
+      when Incomplete =>
+         raise;
+      when others => 
+         Report.Failed ("Exception in Text_IO.Fixed_IO processing");
+   end Operational_Test_Block;
+
+   Final_Block:
+   begin
+      -- Delete the external file.
+      if Text_IO.Is_Open (Inventory_File) then
+         Text_IO.Delete (Inventory_File); 
+      else
+         Text_IO.Open (Inventory_File, Text_IO.In_File, Inventory_Filename);
+         Text_IO.Delete (Inventory_File); 
+      end if;
+
+   exception
+
+      when others =>
+         Report.Failed ( "Delete not properly implemented for Text_IO" );
+
+   end Final_Block;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa009.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa009.a
new file mode 100644
index 000000000..d47806080
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa009.a
@@ -0,0 +1,290 @@
+-- CXAA009.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 capabilities provided in instantiations of the
+--      Ada.Text_IO.Float_IO package operate correctly when the mode of 
+--      the file is Append_File. Check that Float_IO procedures Put and Get 
+--      properly transfer floating point data to/from data files that are in
+--      Append_File mode. Check that the formatting parameters available in 
+--      the package can be used and modified successfully in the appending and 
+--      retrieval of data.
+--      
+-- TEST DESCRIPTION:
+--      This test is designed to simulate an environment where a data file
+--      that holds floating point information is created, written to, and 
+--      closed.  In the future, the file can be reopened in Append_File mode,
+--      additional data can be appended to it, and then closed.  This process
+--      of Open/Append/Close can be repeated as necessary.  All data written
+--      to the file is verified for accuracy when retrieved from the file.
+--      
+--      This test verifies issues of create in Append_File mode, appending to
+--      a file previously appended to, opening in Append_File mode, resetting
+--      from Append_File mode to In_File mode, as well as a variety of Text_IO
+--      and Float_IO predefined subprograms.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA009 is
+
+   use Ada;
+   Loan_File : Text_IO.File_Type;
+   Loan_Filename : constant String :=
+                              Report.Legal_File_Name ( Nam => "CXAA009" );
+   Incomplete : exception;
+
+begin
+
+   Report.Test ("CXAA009", "Check that the capabilities of "               &
+                           "Text_IO.Float_IO operate correctly for files " &
+                           "with mode Append_File");
+
+   Test_for_Text_IO_Support:
+   begin
+
+      -- An implementation that does not support Text_IO in a particular
+      -- environment will raise Use_Error on calls to various
+      -- Text_IO operations.  This block statement encloses a call to
+      -- Create, which should raise the exception in a non-supportive 
+      -- environment.  This exception will be handled to produce a
+      -- Not_Applicable result.
+
+      Text_IO.Create (File => Loan_File,                    -- Create in
+                      Mode => Text_IO.Out_File,             -- Out_File mode.
+                      Name => Loan_Filename);
+
+   exception
+
+       when Text_IO.Use_Error | Text_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Text_IO" );
+          raise Incomplete;
+
+   end Test_for_Text_IO_Support;
+
+   Operational_Test_Block:
+   declare
+      Total_Loans_Outstanding : constant Natural := 3;
+      Transaction_Status      :          Boolean := False;
+
+      type Account_Balance_Type is digits 6 range 0.0 .. 1.0E6;
+      type Loan_Balance_Type    is digits 6; 
+      type Interest_Rate_Type   is digits 4 range 0.0 .. 30.00;
+
+      type Loan_Info_Type is record
+         Account_Balance    : Account_Balance_Type := 0.00;
+         Loan_Balance       : Loan_Balance_Type    := 0.00;
+         Loan_Interest_Rate : Interest_Rate_Type   := 0.00;
+      end record;   
+
+      Home_Refinance_Loan : Loan_Info_Type := 
+                              (14_500.00, 135_000.00, 6.875);
+      Line_Of_Credit_Loan : Loan_Info_Type := 
+                              (  5490.00,   -3000.00, 13.75);
+      Small_Business_Loan : Loan_Info_Type := 
+                              (Account_Balance    => 45_000.00,
+                               Loan_Balance       => 10_500.00,
+                               Loan_Interest_Rate =>     5.875);
+
+      package Acct_IO is new Text_IO.Float_IO (Account_Balance_Type);
+      package Loan_IO is new Text_IO.Float_IO (Loan_Balance_Type);
+      package Rate_IO is new Text_IO.Float_IO (Interest_Rate_Type);
+
+
+      -- The following procedure performs the addition of loan information
+      -- into a data file.  Boolean status of True is returned if all of
+      -- the data entry was successful, False otherwise.
+      -- This demonstrates use of Float_IO using a variety of data formats.
+
+      procedure Update_Loan_Info (The_File : in out Text_IO.File_Type;
+                                  The_Loan : in     Loan_Info_Type;
+                                  Status   :    out Boolean ) is
+      begin
+         Acct_IO.Put (The_File, The_Loan.Account_Balance);    
+         Loan_IO.Put (The_File, The_Loan.Loan_Balance, 15, 2, 0);
+         Rate_IO.Put (File => The_File, 
+                      Item => The_Loan.Loan_Interest_Rate,
+                      Fore => 6,
+                      Aft  => 3,
+                      Exp  => 0);
+         Text_IO.New_Line (The_File);
+         Status := True;
+      exception
+         when others => Status := False;
+      end Update_Loan_Info;
+
+
+   begin
+
+      -- This code section simulates a bank maintaining a data file 
+      -- containing information on loans that have been made.
+      -- The scenario:
+      --    The loan file was created in Out_File mode. 
+      --    Some number of data records are added.
+      --    The file is closed.
+      --    The file is subsequently reopened in Append_File mode.
+      --    Data is appended to the file.
+      --    The file is closed.
+      --    Repeat the Open/Append/Close process as required.
+      --    Verify data in the file.
+      --    etc.
+
+      Update_Loan_Info(Loan_File, Home_Refinance_Loan, Transaction_Status);
+
+      if not Transaction_Status then
+         Report.Failed ("Failure in update of first loan data");
+      end if;
+
+      Text_IO.Close (Loan_File);
+
+      -- When subsequent data items are to be added to the file, the file
+      -- is opened in Append_File mode.
+
+      Text_IO.Open (Loan_File,                            -- Open with
+                    Text_IO.Append_File,                  -- Append mode.
+                    Loan_Filename);
+                                                             
+      Update_Loan_Info(Loan_File, Line_Of_Credit_Loan, Transaction_Status);
+
+      if not Transaction_Status then
+         Report.Failed("Failure in update of first loan data");
+      end if;
+
+      Text_IO.Close(Loan_File);
+
+      -- To add additional data to the file, the file
+      -- is again opened in Append_File mode (appending to a file
+      -- previously appended to).
+
+      Text_IO.Open (Loan_File,                            -- Open with
+                    Text_IO.Append_File,                  -- Append mode.
+                    Loan_Filename);
+                                                             
+      Update_Loan_Info(Loan_File, Small_Business_Loan, Transaction_Status);
+
+      if not Transaction_Status then
+         Report.Failed("Failure in update of first loan data");
+      end if;
+
+      Test_Verification_Block:                             
+      declare
+         type Ledger_Type is 
+           array (1 .. Total_Loans_Outstanding) of Loan_Info_Type;
+         TC_Bank_Ledger : Ledger_Type;
+         TC_Item_Count  : Natural := 0;
+      begin                                                
+
+         Reset1:
+         begin
+            Text_IO.Reset (Loan_File, Text_IO.In_File);       -- Reset for
+                                                              -- reading.
+         exception
+            when Text_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Text_IO" );
+               raise Incomplete;
+         end Reset1;
+
+         while not Text_IO.End_Of_File (Loan_File) loop
+            TC_Item_Count := TC_Item_Count + 1;               
+            Acct_IO.Get (Loan_File, 
+                         TC_Bank_Ledger(TC_Item_Count).Account_Balance);    
+            Loan_IO.Get (Loan_File, 
+                         TC_Bank_Ledger(TC_Item_Count).Loan_Balance, 
+                         0);
+            Rate_IO.Get(File  => Loan_File, 
+                        Item  => 
+                          TC_Bank_Ledger(TC_Item_Count).Loan_Interest_Rate,
+                        Width => 0);
+            Text_IO.Skip_Line(Loan_File);
+
+         end loop;
+
+         -- Verify all of the data fields read from the file.  Compare
+         -- with the values that were originally entered into the file.
+
+         if (TC_Bank_Ledger(1) /= Home_Refinance_Loan) or
+            (TC_Bank_Ledger(2) /= Line_Of_Credit_Loan) or
+            (TC_Bank_Ledger(3) /= Small_Business_Loan) then
+            Report.Failed("Error in data read from file");
+         end if;
+
+         if (TC_Item_Count /= Total_Loans_Outstanding) then
+            Report.Failed ("Incorrect number of records read from file");
+         end if;
+
+      exception
+           when Incomplete =>
+              raise; 
+           when others => 
+               Report.Failed ("Error raised during data verification");
+      end Test_Verification_Block;
+
+   exception
+      when Incomplete =>
+         raise;
+      when others => 
+            Report.Failed ("Exception in Text_IO.Float_IO processing");
+   end Operational_Test_Block;
+
+   Final_Block:
+   begin
+      -- Delete the external file.
+      if Text_IO.Is_Open(Loan_File) then
+         Text_IO.Delete(Loan_File);
+      else
+         Text_IO.Open(Loan_File, Text_IO.In_File, Loan_Filename);
+         Text_IO.Delete(Loan_File);
+      end if;
+
+   exception
+
+      when Text_IO.Use_Error =>
+         Report.Failed
+            ( "Delete not properly implemented for Text_IO" );
+
+   end Final_Block;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA009;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a
new file mode 100644
index 000000000..5678aee6b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a
@@ -0,0 +1,335 @@
+-- CXAA010.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 operations defined in package Ada.Text_IO.Decimal_IO
+--      are available, and that they function correctly when used for the
+--      input/output of Decimal types.
+--
+-- TEST DESCRIPTION:
+--      This test demonstrates the Put and Get procedures found in the
+--      generic package Ada.Text_IO.Decimal_IO.  Both Put and Get are
+--      overloaded to allow placement or extraction of decimal values 
+--      to/from a text file or a string.  This test demonstrates both forms
+--      of each subprogram.  
+--      The test defines an array of records containing decimal value
+--      and string component fields.  All component values are placed in a 
+--      Text_IO file, with the decimal values being placed there using the 
+--      version of Put defined for files, and using user-specified formatting 
+--      parameters.  The data is later extracted from the file, with the 
+--      decimal values being removed using the version of Get defined for
+--      files.  Decimal values are then written to strings, using the 
+--      appropriate Put procedure.  Finally, extraction of the decimal data
+--      from the strings completes the evaluation of the Decimal_IO package
+--      subprograms.
+--      The reconstructed data is verified at the end of the test against the
+--      data originally written to the file.
+--
+-- APPLICABILITY CRITERIA: 
+--      Applicable to all implementations capable of supporting external
+--      Text_IO files and Decimal Fixed Point Types
+-- 
+--      All implementations must attempt to compile this test.
+--
+--      For implementations validating against Information Systems Annex (F):
+--        this test must execute and report PASSED.
+--
+--      For implementations not validating against Annex F:
+--        this test may report compile time errors at one or more points
+--        indicated by "-- ANX-F RQMT", in which case it may be graded as inapplicable.
+--        Otherwise, the test must execute and report PASSED.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      20 Feb 95   SAIC    Modified test to allow for Use_Error/Name_Error
+--                          generation by an implementation not supporting
+--                          Text_IO operations.
+--      14 Nov 95   SAIC    Corrected string indexing for ACVC 2.0.1.
+--      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--      16 FEB 98   EDS     Modified documentation.
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA010 is
+   use Ada.Text_IO;
+   Tax_Roll      : Ada.Text_IO.File_Type;
+   Tax_Roll_Name : constant String :=
+                           Report.Legal_File_Name ( Nam => "CXAA010" );
+   Incomplete : exception;
+begin
+
+   Report.Test ("CXAA010", "Check that the operations defined in package " &
+                           "Ada.Text_IO.Decimal_IO are available, and "    &
+                           "that they function correctly when used for "   &
+                           "the input/output of Decimal types");
+
+   Test_for_Decimal_IO_Support:
+   begin
+
+      -- An implementation that does not support Text_IO creation or naming
+      -- of external files in a particular environment will raise Use_Error 
+      -- or Name_Error on a call to Text_IO Create. This block statement 
+      -- encloses a call to Create, which should produce an exception in a 
+      -- non-supportive environment.  Either of these exceptions will be 
+      -- handled to produce a Not_Applicable result.
+
+      Ada.Text_IO.Create (Tax_Roll, Ada.Text_IO.Out_File, Tax_Roll_Name);
+
+   exception
+
+       when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Text_IO" );
+          raise Incomplete;
+
+   end Test_for_Decimal_IO_Support;
+
+   Taxation:
+   declare
+
+      ID_Length           : constant :=  5;
+      Price_String_Length : constant :=  5;
+      Value_String_Length : constant :=  6;
+      Total_String_Length : constant := 20;
+      Spacer              : constant String := "  ";  -- Two blanks.
+
+      type Price_Type     is delta 0.1  digits 4;              -- ANX-F RQMT
+      type Value_Type     is delta 0.01 digits 5;              -- ANX-F RQMT
+
+      type Property_Type  is 
+         record
+            Parcel_ID      : String (1..ID_Length);
+            Purchase_Price : Price_Type;
+            Assessed_Value : Value_Type;
+         end record;
+     
+      type    City_Block_Type     is array (1..4) of Property_Type;
+
+      subtype Tax_Bill_Type       is string (1..Total_String_Length);
+      type    Tax_Bill_Array_Type is array (1..4) of Tax_Bill_Type;
+
+      Neighborhood : City_Block_Type := 
+        (("X9254", 123.0, 135.00), ("X3569", 345.0, 140.50),
+         ("X3434", 234.0, 179.50), ("X8838", 456.0, 158.00));
+      
+      Neighborhood_Taxes : Tax_Bill_Array_Type;
+
+      package Price_IO is new Ada.Text_IO.Decimal_IO (Price_Type);
+      package Value_IO is new Ada.Text_IO.Decimal_IO (Value_Type);
+
+   begin  -- Taxation
+
+      Assessors_Office:
+      begin
+
+         for Parcel in City_Block_Type'Range loop
+            -- Note: All data in the file will be separated with a 
+            --       two-character blank spacer.
+            Ada.Text_IO.Put(Tax_Roll, Neighborhood(Parcel).Parcel_ID);
+            Ada.Text_IO.Put(Tax_Roll, Spacer);
+
+            -- Use Decimal_IO.Put with non-default format parameters to
+            -- place decimal data into file.
+            Price_IO.Put   (Tax_Roll, Neighborhood(Parcel).Purchase_Price,
+                            Fore => 3, Aft =>1, Exp => 0);
+            Ada.Text_IO.Put(Tax_Roll, Spacer);
+
+            Value_IO.Put   (Tax_Roll, Neighborhood(Parcel).Assessed_Value,
+                            Fore => 3, Aft =>2, Exp => 0);
+            Ada.Text_IO.New_Line(Tax_Roll);
+         end loop;
+
+         Ada.Text_IO.Close (Tax_Roll);
+
+      exception
+         when others => 
+            Report.Failed ("Exception raised in Assessor's Office");
+      end Assessors_Office;
+
+
+      Twice_A_Year:
+      declare
+
+         procedure Collect_Tax(Index     : in     Integer;
+                               Tax_Array : in out Tax_Bill_Array_Type) is
+            ID            : String (1..ID_Length);
+            Price         : Price_Type := 0.0; 
+            Value         : Value_Type := 0.00;
+            Price_String  : String (1..Price_String_Length);
+            Value_String  : String (1..Value_String_Length);
+         begin  
+
+            -- Extract information from the Text_IO file; one string, two
+            -- decimal values.
+            -- Note that the Spacers that were put in the file above are
+            -- not individually read here, due to the fact that each call
+            -- to Decimal_IO.Get below uses a zero in the Width field,
+            -- which allows each Get procedure to skip these leading blanks
+            -- prior to extracting the numeric value.
+               
+            Ada.Text_IO.Get (Tax_Roll, ID);
+
+            -- A zero value of Width is provided, so the following
+            -- two calls to Decimal_IO.Get will skip the leading blanks,
+            -- (from the Spacer variable above), then read the numeric
+            -- literals.
+
+            Price_IO.Get    (Tax_Roll, Price, 0);
+            Value_IO.Get    (Tax_Roll, Value, 0);
+            Ada.Text_IO.Skip_Line (Tax_Roll);
+
+            -- Convert the values read from the file into string format,
+            -- using user-specified format parameters.
+            -- Format of the Price_String should be "nnn.n"
+            -- Format of the Value_String should be "nnn.nn"
+
+            Price_IO.Put (To   => Price_String,
+                          Item => Price,
+                          Aft  => 1);
+            Value_IO.Put (Value_String, Value, 2);
+
+            -- Construct a string of length 20 that contains the Parcel_ID,
+            -- the Purchase_Price, and the Assessed_Value, separated by
+            -- two-character blank data spacers.  Store this string
+            -- into the string array out parameter.
+            -- Format of each Tax_Array element should be 
+            -- "Xnnnn  nnn.n  nnn.nn" (with an 'n' signifying a digit).
+
+            Tax_Array(Index) := ID           & Spacer &
+                                Price_String & Spacer &
+                                Value_String;            
+         exception
+            when Data_Error =>
+               Report.Failed("Data Error raised during the extraction " &
+                             "of decimal data from the file");
+            when others     => 
+              Report.Failed("Exception in Collect_Tax procedure");
+         end Collect_Tax;
+
+  
+      begin  -- Twice_A_Year
+      
+         Ada.Text_IO.Open (Tax_Roll, Ada.Text_IO.In_File, Tax_Roll_Name);
+
+         -- Determine property tax bills for the entire neighborhood from
+         -- the information that is stored in the file. Store information
+         -- in the Neighborhood_Taxes string array.
+
+         for Parcel in City_Block_Type'Range loop
+            Collect_Tax (Parcel, Neighborhood_Taxes);
+         end loop;
+
+      exception
+         when others => 
+           Report.Failed ("Exception in Twice_A_Year Block");
+      end Twice_A_Year;
+
+      -- Use Decimal_IO Get procedure to extract information from a string.
+      -- Verify data against original values.
+      Validation_Block:
+      declare
+         TC_ID     : String (1..ID_Length);    -- 1..5
+         TC_Price  : Price_Type;
+         TC_Value  : Value_Type;
+         Length    : Positive;
+         Front,
+         Rear      : Integer := 0;
+      begin
+
+         for Parcel in City_Block_Type'Range loop
+            -- Extract values from the strings of the string array.
+            -- Each element of the string array is 20 characters long; the
+            -- first five characters are the Parcel_ID, two blank characters
+            -- separate data, the next five characters contain the Price 
+            -- decimal value, two blank characters separate data, the last 
+            -- six characters contain the Value decimal value.  
+            -- Extract each of these components in turn.
+
+            Front := 1;                                        --  1
+            Rear  := ID_Length;                                --  5
+            TC_ID := Neighborhood_Taxes(Parcel)(Front..Rear);
+
+            -- Extract the decimal value from the next slice of the string.
+            Front := Rear + 3;                                 --  8
+            Rear  := Front + Price_String_Length - 1;          -- 12
+            Price_IO.Get (Neighborhood_Taxes(Parcel)(Front..Rear),
+                          Item => TC_Price,
+                          Last => Length);
+
+            -- Extract next decimal value from slice of string, based on 
+            -- length of preceding strings read from string array element.
+            Front := Rear + 3;                                 -- 15  
+            Rear  := Total_String_Length;                      -- 20
+            Value_IO.Get (Neighborhood_Taxes(Parcel)(Front..Rear),
+                          Item => TC_Value,
+                          Last => Length);
+
+            if TC_ID    /= Neighborhood(Parcel).Parcel_ID       or
+               TC_Price /= Neighborhood(Parcel).Purchase_Price  or
+               TC_Value /= Neighborhood(Parcel).Assessed_Value  
+            then
+               Report.Failed ("Incorrect data validation");
+            end if;
+
+         end loop;
+
+      exception
+         when others => Report.Failed ("Exception in Validation Block");
+      end Validation_Block;
+
+      -- Check that the Text_IO file is open, then delete.
+
+      if not Ada.Text_IO.Is_Open (Tax_Roll) then
+         Report.Failed ("File not left open after processing");
+         Ada.Text_IO.Open (Tax_Roll, Ada.Text_IO.Out_File, Tax_Roll_Name);
+      end if;
+
+      Ada.Text_IO.Delete (Tax_Roll);
+
+   exception
+      when others => 
+         Report.Failed ("Exception in Taxation block");
+         -- Check that the Text_IO file is open, then delete.
+         if not Ada.Text_IO.Is_Open (Tax_Roll) then
+            Ada.Text_IO.Open (Tax_Roll, 
+                              Ada.Text_IO.Out_File, 
+                              Tax_Roll_Name);
+         end if;
+         Ada.Text_IO.Delete (Tax_Roll);
+   end Taxation;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa011.a
new file mode 100644
index 000000000..8cc136d35
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa011.a
@@ -0,0 +1,266 @@
+-- CXAA011.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 operations of Text_IO.Enumeration_IO perform correctly
+--      on files of Append_File mode, for instantiations using 
+--      enumeration types.  Check that Enumeration_IO procedures Put and Get 
+--      properly transfer enumeration data to/from data files.
+--      Check that the formatting parameters available in the package can
+--      be used and modified successfully in the storage and retrieval of data.
+--      
+-- TEST DESCRIPTION:
+--      This test is designed to simulate an environment where a data file
+--      that holds enumeration type information is reset from it current mode
+--      to allow the appending of data to the end of the   This process
+--      of Reset/Write can be repeated as necessary.  All data written
+--      to the file is verified for accuracy when retrieved from the file.
+--
+--      This test verifies issues of resetting a file created in Out_File mode
+--      to Append_File mode, resetting from Append_File mode to In_File mode, 
+--      as well as a variety of Text_IO and Enumeration_IO predefined 
+--      subprograms.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA011 is
+   use Ada;
+
+   Status_Log          : Text_IO.File_Type;
+   Status_Log_Filename : constant String :=
+                           Report.Legal_File_Name ( Nam => "CXAA011" );
+   Incomplete : exception;
+
+begin
+
+   Report.Test ("CXAA011", "Check that the operations of "                 &
+                           "Text_IO.Enumeration_IO operate correctly for " &
+                           "files with mode Append_File");
+
+   Test_for_Text_IO_Support:
+   begin
+
+      -- An implementation that does not support Text_IO in a particular
+      -- environment will raise Use_Error on calls to various
+      -- Text_IO operations.  This block statement encloses a call to
+      -- Create, which should raise the exception in a non-supportive 
+      -- environment.  This exception will be handled to produce a
+      -- Not_Applicable result.
+
+      Text_IO.Create (File => Status_Log,
+                      Mode => Text_IO.Out_File,
+                      Name => Status_Log_Filename);
+   exception
+
+       when Text_IO.Use_Error | Text_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Text_IO" );
+          raise Incomplete;
+
+   end Test_for_Text_IO_Support;
+
+
+   Operational_Test_Block:
+   declare
+
+      type Days_In_Week is (Monday, Tuesday, Wednesday, Thursday, Friday, 
+                            Saturday, Sunday);
+      type Hours_In_Day is (A0000, A0600, P1200, P0600); -- Six hour 
+                                                         -- blocks.
+      type Status_Type  is (Operational, Off_Line);
+
+      type Status_Record_Type is record
+         Day    : Days_In_Week;
+         Hour   : Hours_In_Day;
+         Status : Status_Type;
+      end record;
+
+      Morning_Reading : Status_Record_Type := 
+                          (Wednesday, A0600, Operational);
+      Evening_Reading : Status_Record_Type := 
+                          (Saturday,  P0600, Off_Line);
+
+      package Day_IO    is new Text_IO.Enumeration_IO (Days_In_Week);
+      package Hours_IO  is new Text_IO.Enumeration_IO (Hours_In_Day);
+      package Status_IO is new Text_IO.Enumeration_IO (Status_Type);
+
+
+      -- The following function simulates the hourly recording of equipment
+      -- status.
+
+      function Record_Status (Reading : Status_Record_Type) 
+      return Boolean is
+         use Text_IO;  -- To provide visibility to type Type_Set and
+                       -- enumeration literal Upper_Case.
+      begin
+         Day_IO.Put       (File => Status_Log, 
+                           Item => Reading.Day, 
+                           Set  => Type_Set'(Upper_Case));
+         Hours_IO.Put     (Status_Log, Reading.Hour, 7);
+         Status_IO.Put    (Status_Log, Reading.Status, 
+                           Width => 8, Set => Lower_Case);
+         Text_IO.New_Line (Status_Log);
+         return (True);
+      exception
+         when others => return False;
+      end Record_Status;
+
+   begin
+
+      -- The usage scenario intended is as follows:
+      --    File is created.
+      --    Unrelated/unknown file processing occurs.
+      --    On six hour intervals, file is reset to Append_File mode.
+      --    Data is appended to file.
+      --    Unrelated/unknown file processing resumes.
+      --    Reset/Append process is repeated.
+
+      Reset1:
+      begin 
+        Text_IO.Reset (Status_Log,                           -- Reset to 
+                        Text_IO.Append_File);                 -- Append mode.
+      exception
+         when Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to Append_File not supported for Text_IO" );
+            raise Incomplete;
+      end Reset1;
+
+      Day_IO.Default_Width := Days_In_Week'Width + 5;      -- Default values
+                                                           -- are modifiable.
+
+      if not Record_Status (Morning_Reading) then          -- Enter data.
+         Report.Failed ("Exception occurred during data file update");
+      end if;
+
+      Reset2:
+      begin
+         Text_IO.Reset (Status_Log,                           -- Reset to 
+                        Text_IO.Append_File);                 -- Append mode.
+      exception
+         when Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to Append_File not supported for Text_IO" );
+            raise Incomplete;
+      end Reset2;
+
+      if not Record_Status (Evening_Reading) then          -- Enter data.
+         Report.Failed ("Exception occurred during data file update");
+      end if;
+
+      Test_Verification_Block:                             
+      declare                                              
+         TC_Reading1   : Status_Record_Type;
+         TC_Reading2   : Status_Record_Type;
+      begin                                                
+
+         Reset3:
+         begin
+            Text_IO.Reset (Status_Log, Text_IO.In_File);      -- Reset for
+                                                              -- reading.
+         exception
+            when Text_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Text_IO" );
+               raise Incomplete;
+         end Reset3;
+
+         Day_IO.Get    (Status_Log, TC_Reading1.Day);      -- Read data from
+         Hours_IO.Get  (Status_Log, TC_Reading1.Hour);     -- first record.
+         Status_IO.Get (Status_Log, TC_Reading1.Status);
+         Text_IO.Skip_Line (Status_Log);
+
+         -- Verify the data read from the file.  Compare with the 
+         -- record that was originally entered into the file.
+
+         if (TC_Reading1 /= Morning_Reading) then
+            Report.Failed ("Data error on reading first record");
+         end if;
+
+         Day_IO.Get    (Status_Log, TC_Reading2.Day);      -- Read data from
+         Hours_IO.Get  (Status_Log, TC_Reading2.Hour);     -- second record.
+         Status_IO.Get (Status_Log, TC_Reading2.Status);
+         Text_IO.Skip_Line (Status_Log);
+
+         -- Verify all of the data fields read from the file.  Compare
+         -- with the values that were originally entered into the file.
+
+         if (TC_Reading2.Day    /= Evening_Reading.Day)    or
+            (TC_Reading2.Hour   /= Evening_Reading.Hour)   or
+            (TC_Reading2.Status /= Evening_Reading.Status) then
+            Report.Failed ("Data error on reading second record");
+         end if;
+
+      exception
+        when Incomplete =>
+           raise; 
+         when others => 
+            Report.Failed ("Error raised during data verification");
+      end Test_Verification_Block;
+
+   exception
+      when Incomplete =>
+         raise; 
+      when others => 
+         Report.Failed ("Exception in Text_IO.Enumeration_IO processing");
+   end Operational_Test_Block;
+
+   Final_Block:
+   begin
+      -- Delete the external file.
+      if Text_IO.Is_Open (Status_Log) then
+         Text_IO.Delete (Status_Log);   
+      else
+         Text_IO.Open (Status_Log, Text_IO.Out_File, Status_Log_Filename);
+         Text_IO.Delete (Status_Log);   
+      end if;             
+   exception
+      when Text_IO.Use_Error =>
+         Report.Failed
+            ( "Delete not properly implemented for Text_IO" );
+
+   end Final_Block;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa012.a
new file mode 100644
index 000000000..07523b441
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa012.a
@@ -0,0 +1,167 @@
+-- CXAA012.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 exception Mode_Error is raised when an attempt is made
+--      to read from (perform a Get_Line) or use the predefined End_Of_File 
+--      function on a text file with mode Append_File.
+--      
+-- TEST DESCRIPTION:
+--      A scenario is created that demonstrates the potential for the 
+--      incorrect usage of predefined text processing subprograms, resulting 
+--      from their use with files of the wrong Mode.  This results in the 
+--      raising of Mode_Error exceptions, which is handled within blocks
+--      embedded in the test.
+--      A count is kept to ensure that each anticipated exception is in fact
+--      raised and handled properly.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA012 is
+   use Ada;
+   Text_File     : Text_IO.File_Type;
+   Text_Filename : constant String :=
+                      Report.Legal_File_Name ( Nam => "CXAA012" );
+   Incomplete : exception;
+begin
+
+        Report.Test ("CXAA012", "Check that the exception Mode_Error is " &
+                                "raised when an attempt is made to read " &
+                                "from (perform a Get_Line) or use the "   &
+                                "predefined End_Of_File function on a "   &
+                                "text file with mode Append_File");
+
+        Test_for_Text_IO_Support:
+        begin
+
+        -- Use_Error or Name_Error will be raised if Text_IO operations 
+        -- or external files are not supported.
+
+           Text_IO.Create (Text_File, Text_IO.Out_File, Text_Filename);
+
+      exception
+          when Text_IO.Use_Error | Text_IO.Name_Error =>
+             Report.Not_Applicable
+                ( "Files not supported - Create as Out_File for Text_IO" );
+             raise Incomplete;
+      end Test_for_Text_IO_Support;
+
+      -- The application writes some amount of data to the file.
+
+           Text_IO.Put_Line (Text_File, "Data entered into the file");
+
+           Text_IO.Close (Text_File);
+
+           Operational_Test_Block:
+           declare
+              TC_Number_Of_Forced_Mode_Errors : constant Natural := 2;
+              TC_Mode_Errors : Natural := 0;
+           begin
+
+              Text_IO.Open (Text_File, Text_IO.Append_File, Text_Filename);
+
+              Test_for_Reading:
+              declare
+                 TC_Data   : String (1..80);
+                 TC_Length : Natural := 0;
+              begin
+
+-- During the course of its processing, the application may become confused
+-- and erroneously attempt to read data from the file that is currently in
+-- Append_File mode (instead of the anticipated In_File mode).
+-- This would result in the raising of Mode_Error.
+
+                 Text_IO.Get_Line (Text_File, TC_Data, TC_Length);
+                 Report.Failed ("Exception not raised by Get_Line");
+
+-- An exception handler present within the application handles the exception
+-- and processing can continue.
+
+              exception
+                 when Text_IO.Mode_Error => 
+                    TC_Mode_Errors := TC_Mode_Errors + 1;
+                 when others             => 
+                    Report.Failed ("Exception in Get_Line processing");
+              end Test_for_Reading;
+
+
+              Test_for_End_Of_File:
+              declare
+                 TC_End_Of_File : Boolean;
+              begin
+
+-- Again, during the course of its processing, the application attempts to 
+-- call the End_Of_File function for the file that is currently in
+-- Append_File mode (instead of the anticipated In_File mode).
+
+                 TC_End_Of_File := Text_IO.End_Of_File (Text_File);
+                 Report.Failed ("Exception not raised by End_Of_File");
+
+-- Once again, an exception handler present within the application handles 
+-- the exception and processing continues.
+
+              exception
+                 when Text_IO.Mode_Error => 
+                    TC_Mode_Errors := TC_Mode_Errors + 1;
+                 when others             => 
+                    Report.Failed("Exception in End_Of_File processing");
+              end Test_for_End_Of_File;
+
+
+              if (TC_Mode_Errors /= TC_Number_Of_Forced_Mode_Errors) then
+                 Report.Failed ("Incorrect number of exceptions handled");
+              end if;
+
+           end Operational_Test_Block;
+     
+           -- Delete the external file.
+           if Text_IO.Is_Open (Text_File) then
+              Text_IO.Delete (Text_File);     
+           else
+              Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename);
+              Text_IO.Delete (Text_File);     
+           end if;
+         
+        Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa013.a
new file mode 100644
index 000000000..be658ca13
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa013.a
@@ -0,0 +1,167 @@
+-- CXAA013.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 exception Mode_Error is raised when an attempt is made
+--      to skip a line or page using the predefined Skip_Line and Skip_Page
+--      procedures on a text file with mode Append_File.
+--      
+-- TEST DESCRIPTION:
+--      A scenario is created that demonstrates the potential for the 
+--      incorrect usage of predefined text processing subprograms, which 
+--      results in the raising of a Mode_Error exception.
+--      A count is kept to ensure that each anticipated exception is in fact
+--      raised and handled properly.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      28 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA013 is
+   use Ada;
+   Text_File     : Text_IO.File_Type;
+   Text_Filename : constant String := 
+                              Report.Legal_File_Name ( Nam => "CXAA013" );
+   Incomplete : exception;
+
+begin
+
+         Report.Test ("CXAA013", "Check that the exception Mode_Error is " &
+                                 "raised when an attempt is made to skip " &
+                                 "a line or page using the predefined "    &
+                                 "Skip_Line and Skip_Page procedures on "  &
+                                 "a text file with mode Append_File");
+
+         Test_for_Text_IO_Support:
+         begin
+
+-- An application creates a text file with mode Append_File.
+-- Use_Error will be raised if Text_IO operations or external files are not
+-- supported.
+
+            Text_IO.Create (Text_File, Text_IO.Append_File, Text_Filename);
+
+   exception
+
+       when Text_IO.Use_Error | Text_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Append_File for Text_IO" );
+          raise Incomplete;
+
+   end Test_for_Text_IO_Support;
+
+-- The application writes some amount of data to the file.
+
+   Text_IO.Put_Line (Text_File, "Data entered into the file");
+
+   Operational_Test_Block:
+   declare
+      TC_Number_Of_Forced_Mode_Errors : constant Natural := 2;
+      TC_Mode_Errors : Natural := 0;
+   begin
+
+      Test_for_Skip_Line:
+      declare
+         TC_Spacing : constant Text_IO.Count := 3;
+      begin
+
+-- During the course of its processing, the application may attempt to 
+-- invoke the Skip_Line procedure on a file that is currently in Append_File 
+-- mode (instead of the anticipated In_File mode).  This results in the 
+-- raising of Mode_Error.
+
+         Text_IO.Skip_Line (Text_File, TC_Spacing);
+         Report.Failed ("Exception not raised by Skip_Line");
+
+-- An exception handler present within the application handles the exception
+-- and processing can continue.
+
+      exception
+         when Text_IO.Mode_Error => 
+            TC_Mode_Errors := TC_Mode_Errors + 1;
+         when others => 
+            Report.Failed("Exception in Skip_Line processing");
+      end Test_for_Skip_Line;
+
+      Test_for_Skip_Page:
+      begin
+
+-- Again, during the course of its processing, the application incorrectly
+-- assumes that the file mode is In_File, this time attempting to call the 
+-- Skip_Page procedure for the file (that is currently in Append_File mode).
+
+         Text_IO.Skip_Page (Text_File);
+         Report.Failed ("Exception not raised by Skip_Page");
+
+-- Once again, an exception handler present within the application handles 
+-- the exception and processing continues.
+
+      exception
+         when Text_IO.Mode_Error => 
+            TC_Mode_Errors := TC_Mode_Errors + 1;
+         when others => 
+            Report.Failed("Exception in Skip_Page processing");
+      end Test_for_Skip_Page;
+
+      if (TC_Mode_Errors /= TC_Number_Of_Forced_Mode_Errors) then
+         Report.Failed ("Incorrect number of exceptions handled");
+      end if;
+
+   end Operational_Test_Block;
+
+   Deletion:
+   begin
+      -- Delete the external file.
+      if Text_IO.Is_Open (Text_File) then
+         Text_IO.Delete (Text_File);     
+      else
+         Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename);
+         Text_IO.Delete (Text_File);     
+      end if;
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Text_IO" );
+   end Deletion;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA013;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa014.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa014.a
new file mode 100644
index 000000000..0b74c6169
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa014.a
@@ -0,0 +1,178 @@
+-- CXAA014.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 exception Mode_Error is raised when an attempt is made
+--      to check for the end of a line or page using the predefined functions
+--      End_Of_Line or End_Of_Page on a text file with mode Append_File.
+--      
+-- TEST DESCRIPTION:
+--      A scenario is created that demonstrates the potential for the 
+--      incorrect usage of predefined text processing subprograms, which 
+--      results in the raising of a Mode_Error exception.
+--      A count is kept to ensure that each anticipated exception is in fact
+--      raised and handled properly.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      28 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA014 is
+   use Ada;
+   Text_File     : Text_IO.File_Type;
+   Text_Filename : constant String := 
+                              Report.Legal_File_Name ( Nam => "CXAA014" );
+   Incomplete : exception;
+
+begin
+
+         Report.Test ("CXAA014", "Check that the exception Mode_Error is "  &
+                                 "raised when an attempt is made to check " &
+                                 "for the end of a line or page using the " &
+                                 "predefined functions End_Of_Line or "     &
+                                 "End_Of_Page on a text file with mode "    &
+                                 "Append_File");
+
+         Test_for_Text_IO_Support:
+         begin
+
+-- Use_Error will be raised if Text_IO operations or external files are not
+-- supported.
+
+            Text_IO.Create (Text_File, Text_IO.Out_File, Text_Filename);
+
+   exception
+
+       when Text_IO.Use_Error | Text_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Text_IO" );
+          raise Incomplete;
+
+   end Test_for_Text_IO_Support;
+
+
+-- The application writes some amount of data to the file.
+
+            for I in 1 .. 10 loop
+               Text_IO.Put_Line (Text_File, "Data entered into the file");
+            end loop;
+
+            Text_IO.Close (Text_File);
+
+            Operational_Test_Block:
+            declare
+               TC_Number_Of_Forced_Mode_Errors : constant Natural := 2;
+               TC_Mode_Errors : Natural := 0;
+            begin
+
+               Text_IO.Open (Text_File, Text_IO.Append_File, Text_Filename);
+
+               Test_for_End_Of_Line:
+               declare
+                  TC_End_Of_Line : Boolean;
+               begin
+
+-- During the course of its processing, the application may attempt to 
+-- invoke the End_Of_Line function on a file that is currently in Append_File 
+-- mode (instead of the anticipated In_File mode).  This results in the 
+-- raising of Mode_Error.
+
+                  TC_End_Of_Line := Text_IO.End_Of_Line (Text_File);
+                  Report.Failed ("Exception not raised by End_Of_Line");
+
+-- An exception handler present within the application handles the exception
+-- and processing can continue.
+
+               exception
+                  when Text_IO.Mode_Error => 
+                     TC_Mode_Errors := TC_Mode_Errors + 1;
+                  when others => 
+                     Report.Failed("Exception in End_Of_Line processing");
+               end Test_for_End_Of_Line;
+
+
+               Test_for_End_Of_Page:
+               declare
+                  TC_End_Of_Page : Boolean;
+               begin
+
+-- Again, during the course of its processing, the application incorrectly
+-- assumes that the file mode is In_File, this time attempting to call the 
+-- End_Of_Page function for the file (that is currently in Append_File mode).
+
+                  TC_End_Of_Page := Text_IO.End_Of_Page (Text_File);
+                  Report.Failed ("Exception not raised by End_Of_Page");
+
+-- Once again, an exception handler present within the application handles 
+-- the exception and processing continues.
+
+               exception
+                  when Text_IO.Mode_Error => 
+                     TC_Mode_Errors := TC_Mode_Errors + 1;
+                  when others => 
+                     Report.Failed("Exception in End_Of_Page processing");
+               end Test_for_End_Of_Page;
+
+
+               if (TC_Mode_Errors /= TC_Number_Of_Forced_Mode_Errors) then
+                  Report.Failed ("Incorrect number of exceptions handled");
+               end if;
+
+            end Operational_Test_Block;
+
+            Deletion:
+            begin
+               -- Delete the external file.
+               if Text_IO.Is_Open (Text_File) then
+                  Text_IO.Delete (Text_File);     
+               else
+                  Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename);
+                  Text_IO.Delete (Text_File);     
+               end if;
+            exception
+               when others =>
+                  Report.Failed
+                     ( "Delete not properly implemented for Text_IO" );
+            end Deletion;
+
+         Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA014;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa015.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa015.a
new file mode 100644
index 000000000..919ef05ca
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa015.a
@@ -0,0 +1,227 @@
+-- CXAA015.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 exception Status_Error is raised when an attempt is
+--      made to create or open a file in Append_File mode when the file is 
+--      already open.
+--      Check that the exception Name_Error is raised by procedure Open when
+--      attempting to open a file in Append_File mode when the name supplied
+--      as the filename does not correspond to an existing external file.
+--      
+-- TEST DESCRIPTION:
+--      A scenario is created that demonstrates the potential for the 
+--      inappropriate usage of text processing subprograms Create and Open, 
+--      resulting in the raising of Status_Error and Name_Error exceptions.
+--      A count is kept to ensure that each anticipated exception is in fact
+--      raised and handled properly.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support text
+--      files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      28 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--!
+
+with Ada.Text_IO;
+with Report;
+
+procedure CXAA015 is
+   use Ada;
+   Text_File     : Text_IO.File_Type;
+   Text_Filename : constant String := 
+                              Report.Legal_File_Name ( Nam => "CXAA015" );
+   Incomplete : exception;
+
+begin
+
+         Report.Test ("CXAA015", "Check that the appropriate exceptions "    &
+                                 "are raised when procedures Create and "    &
+                                 "Open are used to inappropriately operate " &
+                                 "on files of mode Append_File");
+
+         Test_for_Text_IO_Support:
+         begin
+
+-- An application creates a text file with mode Append_File.
+-- Use_Error will be raised if Text_IO operations or external files are not
+-- supported.
+
+            Text_IO.Create (Text_File, Text_IO.Append_File, Text_Filename);
+         exception
+
+             when Text_IO.Use_Error | Text_IO.Name_Error =>
+                Report.Not_Applicable
+                   ( "Files not supported - Create as Append_File for Text_IO" );
+                raise Incomplete;
+
+         end Test_for_Text_IO_Support;
+
+
+-- The application writes some amount of data to the file.
+
+            for I in 1 .. 5 loop
+               Text_IO.Put_Line (Text_File, "Data entered into the file");
+            end loop;
+
+            Operational_Test_Block:
+            declare
+               TC_Number_Of_Forced_Errors : constant Natural := 3;
+               TC_Errors                  :          Natural := 0;
+            begin
+
+
+               Test_for_Create:
+               begin
+
+-- During the course of its processing, the application may (erroneously) 
+-- attempt to create the same file already in existence in Append_File mode.  
+-- This results in the raising of Status_Error.
+
+                  Text_IO.Create (Text_File, 
+                                  Text_IO.Append_File, 
+                                  Text_Filename);
+                  Report.Failed ("Exception not raised by Create");
+
+-- An exception handler present within the application handles the exception
+-- and processing can continue.
+
+               exception
+                  when Text_IO.Status_Error => 
+                     TC_Errors := TC_Errors + 1;
+                  when others => 
+                     Report.Failed("Exception in Create processing");
+               end Test_for_Create;
+
+
+               First_Test_For_Open:
+               begin
+
+-- Again, during the course of its processing, the application incorrectly
+-- attempts to Open a file (in Append_File mode) that is already open.
+
+                  Text_IO.Open (Text_File, Text_IO.Append_File, Text_Filename);
+                  Report.Failed ("Exception not raised by improper Open - 1");
+
+-- Once again, an exception handler present within the application handles 
+-- the exception and processing continues.
+
+               exception
+                  when Text_IO.Status_Error => 
+                     TC_Errors := TC_Errors + 1;
+
+-- At some point in its processing, the application closes the file that is
+-- currently open.
+
+                     Text_IO.Close (Text_File);
+                  when others => 
+                     Report.Failed("Exception in Open processing - 1");
+               end First_Test_For_Open;
+
+
+               Open_With_Wrong_Filename:
+               declare
+                  TC_Wrong_Filename : constant String := 
+                    Report.Legal_File_Name(2);
+               begin
+
+-- At this point, the application attempts to Open (in Append_File mode) the
+-- file used in previous processing, but it attempts this Open using a name 
+-- string that does not correspond to any existing external file.
+-- First make sure the file doesn't exist.  (If it did, then the check
+-- for open in append mode wouldn't work.)
+
+                  Verify_No_File:
+                  begin
+                     Text_IO.Open (Text_File,
+                                   Text_IO.In_File,
+                                   TC_Wrong_Filename);
+                  exception
+                     when Text_IO.Name_Error =>
+                        null;
+                     when others =>
+                        Report.Failed ( "Unexpected exception on Open check" );
+                  end Verify_No_File;
+
+                  Delete_No_File:
+                  begin
+                     if Text_IO.Is_Open (Text_File) then
+                        Text_IO.Delete (Text_File);
+                     end if;
+                  exception
+                     when others =>
+                       Report.Failed ( "Unexpected exception - Delete check" );
+                  end Delete_No_File;
+
+                  Text_IO.Open (Text_File, 
+                                Text_IO.Append_File, 
+                                TC_Wrong_Filename);
+                  Report.Failed ("Exception not raised by improper Open - 2");
+
+-- An exception handler for the Name_Error, present within the application,
+-- catches the exception and processing continues.
+
+               exception
+                  when Text_IO.Name_Error => 
+                     TC_Errors := TC_Errors + 1;
+                  when others => 
+                     Report.Failed("Exception in Open processing - 2");
+               end Open_With_Wrong_Filename;
+
+
+               if (TC_Errors /= TC_Number_Of_Forced_Errors) then
+                  Report.Failed ("Incorrect number of exceptions handled");
+               end if;
+
+            end Operational_Test_Block;
+
+            Deletion:
+            begin
+               -- Delete the external file.
+               if Text_IO.Is_Open (Text_File) then
+                  Text_IO.Delete (Text_File);     
+               else
+                  Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename);
+                  Text_IO.Delete (Text_File);     
+               end if;
+            exception
+               when others =>
+                  Report.Failed
+                     ( "Delete not properly implemented for Text_IO" );
+            end Deletion;
+
+         Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAA015;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a
new file mode 100644
index 000000000..8ae69a126
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a
@@ -0,0 +1,462 @@
+-- CXAA016.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 type File_Access is available in Ada.Text_IO, and that
+--      objects of this type designate File_Type objects.
+--      Check that function Set_Error will set the current default error file.
+--      Check that versions of Ada.Text_IO functions Standard_Input,
+--      Standard_Output, Standard_Error return File_Access values designating
+--      the standard system input, output, and error files.
+--      Check that versions of Ada.Text_IO functions Current_Input,
+--      Current_Output, Current_Error return File_Access values designating
+--      the current system input, output, and error files.
+--      
+-- TEST DESCRIPTION:
+--      This test tests the use of File_Access objects in referring 
+--      to File_Type objects, as well as several new functions that return 
+--      File_Access objects as results.
+--      Four user-defined files are created.  These files will be set to 
+--      function as current system input, output, and error files.
+--      Data will be read from and written to these files during the
+--      time at which they function as the current system files.  
+--      An array of File_Access objects will be defined.  It will be 
+--      initialized using functions that return File_Access objects 
+--      referencing the Standard and Current Input, Output, and Error files.
+--      This "saves" the initial system environment, which will be modified
+--      to use the user-defined files as the current default Input, Output,
+--      and Error files.  At the end of the test, the data in this array 
+--      will be used to restore the initial system environment.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to implementations capable of supporting
+--      external Text_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      25 May 95   SAIC    Initial prerelease version.
+--      22 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
+--      18 Jan 99   RLB     Repaired to allow Not_Applicable systems to
+--                          fail delete.
+--!
+
+with Ada.Text_IO;
+package CXAA016_0 is
+   New_Input_File,
+   New_Output_File,
+   New_Error_File_1,
+   New_Error_File_2 : aliased Ada.Text_IO.File_Type;
+end CXAA016_0;
+
+
+with Report;
+with Ada.Exceptions;
+with Ada.Text_IO; use Ada.Text_IO;
+with CXAA016_0;   use CXAA016_0;
+
+procedure CXAA016 is
+   
+   Non_Applicable_System : exception;
+   No_Reset              : exception;
+   Not_Applicable_System : Boolean := False;
+
+   procedure Delete_File ( A_File : in out Ada.Text_IO.File_Type;
+                           ID_Num : in     Integer ) is
+   begin
+      if not Ada.Text_IO.Is_Open ( A_File ) then
+         Ada.Text_IO.Open ( A_File, 
+                            Ada.Text_IO.In_File, 
+                            Report.Legal_File_Name ( ID_Num ) );
+      end if;
+      Ada.Text_IO.Delete ( A_File );
+   exception
+      when Ada.Text_IO.Name_Error =>
+         if Not_Applicable_System then
+            null; -- File probably wasn't created.
+         else
+            Report.Failed ( "Can't open file for Text_IO" );
+         end if;
+      when Ada.Text_IO.Use_Error =>
+         if Not_Applicable_System then
+            null; -- File probably wasn't created.
+         else
+            Report.Failed ( "Delete not properly implemented for Text_IO" );
+         end if;
+      when others                =>
+         Report.Failed ( "Unexpected exception in Delete_File" );
+   end Delete_File;
+
+begin
+
+   Report.Test ("CXAA016", "Check that the type File_Access is available " &
+                           "in Ada.Text_IO, and that objects of this "     &
+                           "type designate File_Type objects");
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+
+      type System_File_Array_Type is 
+        array (Integer range <>) of File_Access;        
+
+      -- Fill the following array with the File_Access results of six
+      -- functions.
+
+      Initial_Environment : System_File_Array_Type(1..6) := 
+                              ( Standard_Input,
+                                Standard_Output,
+                                Standard_Error,
+                                Current_Input,    
+                                Current_Output,
+                                Current_Error );
+
+      New_Input_Ptr    : File_Access := New_Input_File'Access;
+      New_Output_Ptr   : File_Access := New_Output_File'Access;
+      New_Error_Ptr    : File_Access := New_Error_File_1'Access;
+
+      Line   : String(1..80);
+      Length : Natural := 0;
+
+      Line_1 : constant String := "This is the first line in the Output file";
+      Line_2 : constant String := "This is the next line in the Output file";
+      Line_3 : constant String := "This is the first line in Error file 1";
+      Line_4 : constant String := "This is the next line in Error file 1";
+      Line_5 : constant String := "This is the first line in Error file 2";
+      Line_6 : constant String := "This is the next line in Error file 2";
+
+
+
+      procedure New_File (The_File : in out File_Type;
+                          Mode     : in     File_Mode;
+                          Next     : in     Integer) is
+      begin
+         Create (The_File, Mode, Report.Legal_File_Name(Next));
+      exception
+         -- The following two exceptions may be raised if a system is not
+         -- capable of supporting external Text_IO files.  The handler will
+         -- raise a user-defined exception which will result in a 
+         -- Not_Applicable result for the test.
+         when Use_Error | Name_Error => raise Non_Applicable_System;
+      end New_File;
+
+
+
+      procedure Check_Initial_Environment (Env : System_File_Array_Type) is
+      begin
+        -- Check that the system has defined the following sources/
+        -- destinations for input/output/error, and that the six functions
+        -- returning File_Access values are available.
+        if not (Env(1) = Standard_Input  and
+                Env(2) = Standard_Output and
+                Env(3) = Standard_Error  and    
+                Env(4) = Current_Input   and
+                Env(5) = Current_Output  and
+                Env(6) = Current_Error) 
+        then
+           Report.Failed("At the start of the test, the Standard and " &
+                         "Current File_Access values associated with " &
+                         "system Input, Output, and Error files do "   &
+                         "not correspond");
+        end if;
+      end Check_Initial_Environment;
+
+
+
+      procedure Load_Input_File (Input_Ptr : in File_Access) is
+      begin
+         -- Load data into the file that will function as the user-defined
+         -- system input file.
+         Put_Line(Input_Ptr.all, Line_1);
+         Put_Line(Input_Ptr.all, Line_2);
+         Put_Line(Input_Ptr.all, Line_3);
+         Put_Line(Input_Ptr.all, Line_4);
+         Put_Line(Input_Ptr.all, Line_5);
+         Put_Line(Input_Ptr.all, Line_6);
+      end Load_Input_File;
+
+
+
+      procedure Restore_Initial_Environment 
+                  (Initial_Env : System_File_Array_Type) is 
+      begin
+         -- Restore the Current Input, Output, and Error files to their
+         -- original states.
+
+         Set_Input (Initial_Env(4).all);
+         Set_Output(Initial_Env(5).all);
+         Set_Error (Initial_Env(6).all);
+
+         -- At this point, the user-defined files that were functioning as
+         -- the Current Input, Output, and Error files have been replaced in
+         -- that capacity by the state of the original environment.
+
+         declare
+
+            -- Capture the state of the current environment.
+
+            Current_Env : System_File_Array_Type (1..6) := 
+                            (Standard_Input, Standard_Output, Standard_Error,
+                             Current_Input,  Current_Output,  Current_Error);
+         begin
+
+            -- Compare the current environment with that of the saved  
+            -- initial environment.
+
+            if Current_Env /= Initial_Env then
+               Report.Failed("Restored file environment was not the same " &
+                             "as the initial file environment");
+            end if;
+         end;
+      end Restore_Initial_Environment;
+
+
+
+      procedure Verify_Files (O_File, E_File_1, E_File_2 : in File_Type) is
+         Str_1, Str_2, Str_3, Str_4, Str_5, Str_6 : String (1..80);
+         Len_1, Len_2, Len_3, Len_4, Len_5, Len_6 : Natural;
+      begin
+         
+         -- Get the lines that are contained in all the files, and verify
+         -- them against the expected results.
+
+         Get_Line(O_File, Str_1, Len_1);  -- The user defined output file 
+         Get_Line(O_File, Str_2, Len_2);  -- should contain two lines of data.
+       
+         if Str_1(1..Len_1) /= Line_1 or
+            Str_2(1..Len_2) /= Line_2
+         then
+            Report.Failed("Incorrect results from Current_Output file");
+         end if;
+
+         Get_Line(E_File_1, Str_3, Len_3);  -- The first error file received 
+         Get_Line(E_File_1, Str_4, Len_4);  -- two lines of data originally,
+         Get_Line(E_File_1, Str_5, Len_5);  -- then had two additional lines
+         Get_Line(E_File_1, Str_6, Len_6);  -- appended from the second error
+                                            -- file.
+         if Str_3(1..Len_3) /= Line_3 or
+            Str_4(1..Len_4) /= Line_4 or
+            Str_5(1..Len_5) /= Line_5 or
+            Str_6(1..Len_6) /= Line_6 
+         then
+            Report.Failed("Incorrect results from first Error file");
+         end if;
+
+         Get_Line(E_File_2, Str_5, Len_5);  -- The second error file
+         Get_Line(E_File_2, Str_6, Len_6);  -- received two lines of data.
+
+         if Str_5(1..Len_5) /= Line_5 or
+            Str_6(1..Len_6) /= Line_6 
+         then
+            Report.Failed("Incorrect results from second Error file");
+         end if;
+
+      end Verify_Files;
+
+
+
+   begin
+
+      Check_Initial_Environment (Initial_Environment);
+
+      -- Create user-defined text files that will be set to serve as current
+      -- system input, output, and error files.
+
+      New_File (New_Input_File,   Out_File, 1); -- Will be reset prior to use.
+      New_File (New_Output_File,  Out_File, 2);
+      New_File (New_Error_File_1, Out_File, 3);
+      New_File (New_Error_File_2, Out_File, 4);
+
+      -- Enter several lines of text into the new input file.  This file will
+      -- be reset to mode In_File to function as the current system input file.
+      -- Note: File_Access value used as parameter to this procedure.
+      
+      Load_Input_File (New_Input_Ptr);
+
+      -- Reset the New_Input_File to mode In_File, to allow it to act as the
+      -- current system input file.
+
+      Reset1:
+      begin
+         Reset (New_Input_File, In_File);
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to In_File not supported for Text_IO - 1" );
+            raise No_Reset;
+      end Reset1;
+
+      -- Establish new files that will function as the current system Input,
+      -- Output, and Error files.
+      
+      Set_Input (New_Input_File);
+      Set_Output(New_Output_Ptr.all);
+      Set_Error (New_Error_Ptr.all);      
+
+      -- Perform various file processing tasks, exercising specific new
+      -- Text_IO functionality.
+      --
+      -- Read two lines from Current_Input and write them to Current_Output.
+
+      for i in 1..2 loop
+         Get_Line(Current_Input,  Line, Length);
+         Put_Line(Current_Output, Line(1..Length));
+      end loop;
+
+      -- Read two lines from Current_Input and write them to Current_Error.
+
+      for i in 1..2 loop
+         Get_Line(Current_Input, Line, Length);
+         Put_Line(Current_Error, Line(1..Length));
+      end loop;
+
+      -- Reset the Current system error file.
+
+      Set_Error (New_Error_File_2);      
+
+      -- Read two lines from Current_Input and write them to Current_Error.
+
+      for i in 1..2 loop
+         Get_Line(Current_Input, Line, Length);
+         Put_Line(Current_Error, Line(1..Length));
+      end loop;
+
+      -- At this point in the processing, the new Output file, and each of
+      -- the two Error files, contain two lines of data.
+      -- Note that New_Error_File_1 has been replaced by New_Error_File_2
+      -- as the current system error file, allowing New_Error_File_1 to be
+      -- reset (Mode_Error raised otherwise).
+      --
+      -- Reset the first Error file to Append_File mode, and then set it to 
+      -- function as the current system error file.
+
+      Reset2:
+      begin
+         Reset (New_Error_File_1, Append_File);
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to Append_File not supported for Text_IO - 2" );
+            raise No_Reset;
+      end Reset2;
+
+      Set_Error (New_Error_File_1);
+
+      -- Reset the second Error file to In_File mode, then set it to become
+      -- the current system input file.
+
+      Reset3:
+      begin
+         Reset (New_Error_File_2, In_File);
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to In_File not supported for Text_IO - 3" );
+            raise No_Reset;
+      end Reset3;
+
+      New_Error_Ptr := New_Error_File_2'Access; 
+      Set_Input (New_Error_Ptr.all);
+
+      -- Append all of the text lines (2) in the new current system input
+      -- file onto the current system error file.
+
+      while not End_Of_File(Current_Input) loop
+         Get_Line(Current_Input, Line, Length);
+         Put_Line(Current_Error, Line(1..Length));
+      end loop;
+
+      -- Restore the original system file environment, based upon the values
+      -- stored at the start of this test.
+      -- Check that the original environment has been restored.
+
+      Restore_Initial_Environment (Initial_Environment);
+
+      -- Reset all three files to In_File_Mode prior to verification.
+      -- Note: If these three files had still been the designated Current
+      --       Input, Output, or Error files for the system, a Reset 
+      --       operation at this point would raise Mode_Error.
+      --       However, at this point, the environment has been restored to
+      --       its original state, and these user-defined files are no longer
+      --       designated as current system files, allowing a Reset.
+
+      Reset4:
+      begin
+         Reset(New_Error_File_1, In_File);
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to In_File not supported for Text_IO - 4" );
+            raise No_Reset;
+      end Reset4;
+
+      Reset5:
+      begin
+         Reset(New_Error_File_2, In_File);
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to In_File not supported for Text_IO - 5" );
+            raise No_Reset;
+      end Reset5;
+
+      Reset6:
+      begin
+         Reset(New_Output_File,  In_File);
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to In_File not supported for Text_IO - 6" );
+            raise No_Reset;
+      end Reset6;
+
+      -- Check that all the files contain the appropriate data.
+
+      Verify_Files (New_Output_File, New_Error_File_1, New_Error_File_2);
+
+   exception
+      when No_Reset =>
+         null;
+      when Non_Applicable_System =>
+         Report.Not_Applicable("System not capable of supporting external " &
+                               "text files -- Name_Error/Use_Error raised " &
+                               "during text file creation");
+         Not_Applicable_System := True;
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Delete_Block:
+   begin
+      Delete_File ( New_Input_File, 1 );
+      Delete_File ( New_Output_File, 2 );
+      Delete_File ( New_Error_File_1, 3 );
+      Delete_File ( New_Error_File_2, 4 );
+   end Delete_Block;
+
+   Report.Result;
+
+end CXAA016;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a
new file mode 100644
index 000000000..17d0922cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a
@@ -0,0 +1,400 @@
+-- CXAA017.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 Ada.Text_IO function Look_Ahead sets parameter End_Of_Line
+--      to True if at the end of a line; otherwise check that it returns the
+--      next character from a file (without consuming it), while setting 
+--      End_Of_Line to False.  
+--      
+--      Check that Ada.Text_IO function Get_Immediate will return the next
+--      control or graphic character in parameter Item from the specified 
+--      file.  Check that the version of Ada.Text_IO function Get_Immediate 
+--      with the Available parameter will, if a character is available in the
+--      specified file, return the character in parameter Item, and set 
+--      parameter Available to True.
+--      
+-- TEST DESCRIPTION:
+--      This test exercises specific capabilities of two Text_IO subprograms, 
+--      Look_Ahead and Get_Immediate.  A file is prepared that contains a 
+--      variety of graphic and control characters on several lines.
+--      In processing this file, a call to Look_Ahead is performed to ensure
+--      that characters are available, then individual characters are 
+--      extracted from the current line using Get_Immediate.  The characters
+--      returned from both subprogram calls are compared with the expected
+--      character result.  Processing on each file line continues until
+--      Look_Ahead indicates that the end of the line is next.  Separate
+--      verification is performed to ensure that all characters of each line
+--      are processed, and that the Available and End_Of_Line parameters
+--      of the subprograms are properly set in the appropriate instances.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to implementations capable of supporting
+--      external Text_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      30 May 95   SAIC    Initial prerelease version.
+--      01 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
+--!
+
+with Ada.Text_IO;
+package CXAA017_0 is
+
+   User_Defined_Input_File : aliased Ada.Text_IO.File_Type;
+
+end CXAA017_0;
+
+
+with CXAA017_0; use CXAA017_0;
+with Ada.Characters.Latin_1;
+with Ada.Exceptions;
+with Ada.Text_IO;  
+with Report;
+
+procedure CXAA017 is
+   
+   use Ada.Characters.Latin_1;
+   use Ada.Exceptions;
+   use Ada.Text_IO;
+
+   Non_Applicable_System : exception;
+   No_Reset            : exception;
+
+begin
+
+   Report.Test ("CXAA017", "Check that Ada.Text_IO subprograms "         &
+                           "Look_Ahead and Get_Immediate are available " &
+                           "and produce correct results");
+
+   Test_Block:
+   declare
+
+      User_Input_Ptr    : File_Access := User_Defined_Input_File'Access;
+
+      UDLA_Char,          -- Acronym UDLA => "User Defined Look Ahead"
+      UDGI_Char,          -- Acronym UDGI => "User Defined Get Immediate"
+      TC_Char           : Character := Ada.Characters.Latin_1.NUL;
+
+      UDLA_End_Of_Line,
+      UDGI_Available    : Boolean   := False;
+
+      Char_Pos          : Natural;
+
+      -- This string contains five ISO 646 Control characters and six ISO 646 
+      -- Graphic characters:
+      TC_String_1  : constant String := STX       & 
+                                        SI        & 
+                                        DC2       & 
+                                        CAN       & 
+                                        US        & 
+                                        Space     & 
+                                        Ampersand & 
+                                        Solidus   & 
+                                        'A'       & 
+                                        LC_X      & 
+                                        DEL; 
+
+      -- This string contains two ISO 6429 Control and six ISO 6429 Graphic
+      -- characters:
+      TC_String_2  : constant String := IS4                         & 
+                                        SCI                         & 
+                                        Yen_Sign                    & 
+                                        Masculine_Ordinal_Indicator & 
+                                        UC_I_Grave                  & 
+                                        Multiplication_Sign         & 
+                                        LC_C_Cedilla                & 
+                                        LC_Icelandic_Thorn;
+
+      TC_Number_Of_Strings : constant := 2;
+
+      type String_Access_Type    is access constant String;
+      type String_Ptr_Array_Type is 
+        array (1..TC_Number_Of_Strings) of String_Access_Type;
+
+      TC_String_Ptr_Array : String_Ptr_Array_Type := 
+                              (new String'(TC_String_1),
+                               new String'(TC_String_2));
+
+
+
+      procedure Create_New_File (The_File : in out File_Type;
+                                 Mode     : in     File_Mode;
+                                 Next     : in     Integer) is
+      begin
+         Create (The_File, Mode, Report.Legal_File_Name(Next));
+      exception
+         -- The following two exceptions can be raised if a system is not
+         -- capable of supporting external Text_IO files.  The handler will
+         -- raise a user-defined exception which will result in a 
+         -- Not_Applicable result for the test.
+         when Use_Error | Name_Error => raise Non_Applicable_System;
+      end Create_New_File;
+
+
+
+      procedure Load_File (The_File : in out File_Type) is
+      -- This procedure will load several strings into the file denoted
+      -- by the input parameter.  A call to New_Line will add line/page
+      -- termination characters, which will be available  for processing
+      -- along with the text in the file.
+      begin
+         Put_Line (The_File, TC_String_Ptr_Array(1).all);
+         New_Line (The_File, Spacing => 1);
+         Put_Line (The_File, TC_String_Ptr_Array(2).all);
+      end Load_File;
+
+
+   begin
+
+      -- Create user-defined text file that will serve as the appropriate
+      -- sources of input to the procedures under test.
+
+      Create_New_File (User_Defined_Input_File, Out_File, 1);
+
+      -- Enter several lines of text into the new input file. 
+      -- The characters that make up these text strings will be processed 
+      -- using the procedures being exercised in this test.
+
+      Load_File (User_Defined_Input_File);
+
+      -- Check that Mode_Error is raised by Look_Ahead and Get_Immedidate 
+      -- if the mode of the file object is not In_File.
+      -- Currently, the file mode is Out_File.
+
+      begin
+         Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
+         Report.Failed("Mode_Error not raised by Look_Ahead");
+         Report.Comment("This char should never be printed: " & UDLA_Char); 
+      exception
+         when Mode_Error => null;  -- OK, expected exception.
+         when The_Error : others => 
+            Report.Failed ("The following exception was raised during the " &
+                           "check that Look_Ahead raised Mode_Error when "  &
+                           "provided a file object that is not in In_File " &
+                           "mode: " & Exception_Name(The_Error));
+      end;
+
+      begin
+         Get_Immediate(User_Defined_Input_File, UDGI_Char);
+         Report.Failed("Mode_Error not raised by Get_Immediate");
+         Report.Comment("This char should never be printed: " & UDGI_Char);
+      exception
+         when Mode_Error => null;  -- OK, expected exception.
+         when The_Error : others => 
+            Report.Failed ("The following exception was raised during the " &
+                           "check that Get_Immediate raised Mode_Error "    &
+                           "when provided a file object that is not in "    &
+                           "In_File mode: " & Exception_Name(The_Error));
+      end;
+
+
+      -- The file will then be reset to In_File mode to properly function as 
+      -- a source of input.
+
+      Reset1:
+      begin
+         Reset (User_Defined_Input_File, In_File);
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to In_File not supported for Text_IO" );
+            raise No_Reset;
+      end Reset1;
+
+      -- Process the input file, exercising various Text_IO
+      -- functionality, and validating the results at each step.
+      -- Note: The designated File_Access object is used in processing
+      --       the New_Default_Input_File in the second loop below.
+
+      -- Process characters in first line of text of each file.
+
+      Char_Pos := 1;
+
+      -- Check that the first line is not blank.
+
+      Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
+
+      while not UDLA_End_Of_Line loop
+
+         -- Use the Get_Immediate procedure on the file to get the next 
+         -- available character on the current line.
+
+         Get_Immediate(User_Defined_Input_File, UDGI_Char);
+
+         -- Check that the characters returned by both procedures are the
+         -- same, and that they match the expected character from the file.
+
+         if UDLA_Char /= TC_String_Ptr_Array(1).all(Char_Pos) or
+            UDGI_Char /= TC_String_Ptr_Array(1).all(Char_Pos) 
+         then
+            Report.Failed("Incorrect retrieval of character " &
+                          Integer'Image(Char_Pos) & " of first string");
+         end if;
+
+         -- Increment the character position counter.
+         Char_Pos := Char_Pos + 1;
+
+         -- Check the next character on the line.  If at the end of line,
+         -- the processing flow will exit the While loop.
+
+         Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
+
+      end loop;
+
+      -- Check to ensure that the "end of line" results returned from the 
+      -- Look_Ahead procedure (used to exit the above While loop) corresponds
+      -- with the result of Function End_Of_Line.
+
+      if not End_Of_Line(User_Defined_Input_File)
+      then
+         Report.Failed("Result of procedure Look_Ahead that indicated "    &
+                       "being at the end of the line does not correspond " &
+                       "with the result of function End_Of_Line");
+      end if;
+
+      -- Check that all characters in the string were processed.
+
+      if Char_Pos-1 /= TC_String_1'Length then
+         Report.Failed("Not all of the characters on the first line " &
+                       "were processed");
+      end if;
+
+
+      -- Call procedure Skip_Line to advance beyond the end of the first line.
+
+      Skip_Line(User_Defined_Input_File);
+
+
+      -- Process the second line in the file (a blank line).
+
+      Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
+
+      if not UDLA_End_Of_Line then
+         Report.Failed("Incorrect end of line determination from procedure " &
+                       "Look_Ahead when processing a blank line");
+      end if;
+
+      -- Call procedure Skip_Line to advance beyond the end of the second line.
+
+      Skip_Line(User_Input_Ptr.all);
+
+
+      -- Process characters in the third line of the file (second line 
+      -- of text)
+      -- Note: The version of Get_Immediate used in processing this line has 
+      --       the Boolean parameter Available.
+
+      Char_Pos := 1;
+
+      -- Check whether the line is blank (i.e., at end of line, page, or file).
+
+      Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
+
+      while not UDLA_End_Of_Line loop
+
+         -- Use the Get_Immediate procedure on the file to get access to the
+         -- next character on the current line.
+
+         Get_Immediate(User_Input_Ptr.all, UDGI_Char, UDGI_Available);
+
+         -- Check that the Available parameter of Get_Immediate was set
+         -- to indicate that a character was available in the file.
+         -- Check that the characters returned by both procedures are the 
+         -- same, and they all match the expected character from the file.
+
+         if not UDGI_Available                                or
+            UDLA_Char /= TC_String_Ptr_Array(2).all(Char_Pos) or
+            UDGI_Char /= TC_String_Ptr_Array(2).all(Char_Pos) 
+         then
+            Report.Failed("Incorrect retrieval of character " &
+                          Integer'Image(Char_Pos) & " of second string");
+         end if;
+
+         -- Increment the character position counter.
+
+         Char_Pos := Char_Pos + 1;
+
+         -- Check the next character on the line.  If at the end of line,
+         -- the processing flow will exit the While loop.
+
+         Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
+
+      end loop;
+
+      -- Check to ensure that the "end of line" results returned from the 
+      -- Look_Ahead procedure (used to exit the above While loop) corresponds
+      -- with the result of Function End_Of_Line.
+
+      if not End_Of_Line(User_Defined_Input_File)
+      then
+         Report.Failed("Result of procedure Look_Ahead that indicated "    &
+                       "being at the end of the line does not correspond " &
+                       "with the result of function End_Of_Line");
+      end if;
+
+      -- Check that all characters in the second string were processed.
+
+      if Char_Pos-1 /= TC_String_2'Length then
+         Report.Failed("Not all of the characters on the second line " &
+                       "were processed");
+      end if;
+
+
+      Deletion:
+      begin
+         -- Delete the user defined file.
+
+         if Is_Open(User_Defined_Input_File) then
+            Delete(User_Defined_Input_File);
+         else
+            Open(User_Defined_Input_File, Out_File, Report.Legal_File_Name(1));
+            Delete(User_Defined_Input_File);
+         end if;
+      exception
+         when others =>
+            Report.Failed
+               ( "Delete not properly implemented for Text_IO" );
+      end Deletion;
+
+
+   exception
+
+      when No_Reset =>
+         null;
+
+      when Non_Applicable_System =>
+         Report.Not_Applicable("System not capable of supporting external " &
+                               "text files -- Name_Error/Use_Error raised " &
+                               "during text file creation");
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXAA017;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a
new file mode 100644
index 000000000..53b16fea4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a
@@ -0,0 +1,277 @@
+-- CXAA018.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 subprograms defined in the package Text_IO.Modular_IO
+--      provide correct results.  
+--
+-- TEST DESCRIPTION:
+--      This test checks that the subprograms defined in the 
+--      Ada.Text_IO.Modular_IO package provide correct results.  
+--      A modular type is defined and used to instantiate the generic
+--      package Ada.Text_IO.Modular_IO.  Values of the modular type are
+--      written to a Text_IO file, and to a series of string variables, using
+--      different versions of the procedure Put from the instantiated IO
+--      package.  These modular data items are retrieved from the file and
+--      string variables using the appropriate instantiated version of
+--      procedure Get.  A variety of Base and Width parameter values are
+--      used in the procedure calls.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that support Text_IO
+--      processing and external files.
+--
+--       
+-- CHANGE HISTORY:
+--      03 Jul 95   SAIC    Initial prerelease version.
+--      01 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--
+--!
+
+with Ada.Text_IO;
+with System;
+with Report;
+
+procedure CXAA018 is
+begin
+
+   Report.Test ("CXAA018", "Check that the subprograms defined in "  &
+                           "the package Text_IO.Modular_IO provide " & 
+                           "correct results");
+
+   Test_for_Text_IO_Support:
+   declare
+      Data_File     : Ada.Text_IO.File_Type;
+      Data_Filename : constant String := Report.Legal_File_Name;
+   begin
+
+      -- An application creates a text file in mode Out_File, with the 
+      -- intention of entering modular data into the file as appropriate.  
+      -- In the event that the particular environment where the application 
+      -- is running does not support Text_IO, Use_Error or Name_Error will be 
+      -- raised on calls to Text_IO operations.  Either of these exceptions
+      -- will be handled to produce a Not_Applicable result.
+
+      Ada.Text_IO.Create (File => Data_File,
+                          Mode => Ada.Text_IO.Out_File,
+                          Name => Data_Filename);
+
+      Test_Block:
+      declare
+
+         type Mod_Type is mod System.Max_Binary_Modulus; 
+         -- Max_Binary_Modulus must be at least 2**16, which would result
+         -- in a base range of 0..65535 (zero to one less than the given
+         -- modulus) for this modular type.
+
+         package Mod_IO is new Ada.Text_IO.Modular_IO(Mod_Type);
+         use Ada.Text_IO, Mod_IO;
+         use type Mod_Type;
+
+         Number_Of_Modular_Items : constant := 6;
+         Number_Of_Error_Items   : constant := 1;
+
+         TC_Modular              : Mod_Type;
+         TC_Last_Character_Read  : Positive;
+
+         Modular_Array : array (1..Number_Of_Modular_Items) of Mod_Type := 
+                                   ( 0, 97, 255, 1025, 12097, 65535 );
+
+
+         procedure Load_File (The_File : in out Ada.Text_IO.File_Type) is
+         begin
+            -- This procedure does not create, open, or close the data file;
+            -- The_File file object must be Open at this point.
+            -- This procedure is designed to load Modular_Type data into a 
+            -- data file. 
+            --
+            -- Use the Modular_IO procedure Put to enter modular data items
+            -- into the data file.
+
+            for i in 1..Number_Of_Modular_Items loop
+               -- Use default Base parameter of 10.
+               Mod_IO.Put(File  => Data_File, 
+                          Item  => Modular_Array(i), 
+                          Width => 6, 
+                          Base  => Mod_IO.Default_Base);
+            end loop;
+
+            -- Enter data into the file such that on the corresponding "Get"
+            -- of this data, Data_Error must be raised.  This value is outside
+            -- the base range of Modular_Type.
+            -- Text_IO is used to enter the value in the file.
+
+            for i in 1..Number_Of_Error_Items loop
+               Ada.Text_IO.Put(The_File, "-10");  
+            end loop;
+
+         end Load_File;
+
+
+
+         procedure Process_File(The_File : in out Ada.Text_IO.File_Type) is
+         begin
+            -- This procedure does not create, open, or close the data file;
+            -- The_File file object must be Open at this point.
+            -- Use procedure Get (for Files) to extract the modular data from
+            -- the Text_IO file.  
+
+            for i in 1..Number_Of_Modular_Items loop
+               Mod_IO.Get(The_File, TC_Modular, Width => 6);
+
+               if TC_Modular /= Modular_Array(i) then
+                  Report.Failed("Incorrect modular data read from file " &
+                                "data item #" & Integer'Image(i));
+               end if;
+            end loop;
+
+            -- The final item in the Data_File is a modular value that is
+            -- outside the base range 0..Num'Last.  This value should raise
+            -- Data_Error on an attempt to "Get" it from the file.
+
+            for i in 1..Number_Of_Error_Items loop
+               begin
+                  Mod_IO.Get(The_File, TC_Modular, Mod_IO.Default_Width);
+                  Report.Failed
+                    ("Exception Data_Error not raised when Get "   &
+                     "was used to read modular data outside base " &
+                     "range of type, item # "                      & 
+                     Integer'Image(i));
+               exception
+                  when Ada.Text_IO.Data_Error => 
+                     null; -- OK, expected exception.
+                  when others =>
+                     Report.Failed("Unexpected exception raised when Get "  &
+                                   "was used to read modular data outside " &
+                                   "base range of type from Data_File, "    &
+                                   "data item #" & Integer'Image(i));
+               end;
+            end loop;
+       
+         exception
+            when others =>
+              Report.Failed
+                ("Unexpected exception raised in Process_File");
+         end Process_File;
+
+
+
+      begin  -- Test_Block.
+
+         -- Place modular values into data file.
+
+         Load_File(Data_File);
+         Ada.Text_IO.Close(Data_File);
+
+         -- Read modular values from data file.
+
+         Ada.Text_IO.Open(Data_File, Ada.Text_IO.In_File, Data_Filename);
+         Process_File(Data_File);
+
+         -- Verify versions of Modular_IO procedures Put and Get for Strings.
+
+         Modular_IO_in_Strings:
+         declare
+            TC_String_Array : array (1..Number_Of_Modular_Items) 
+                              of String(1..30) := (others =>(others => ' '));
+         begin
+
+            -- Place modular values into strings using the Procedure Put, 
+            -- Use a variety of different "Base" parameter values.
+            -- Note: This version of Put uses the length of the given
+            --       string as the value of the "Width" parameter.
+
+            for i in 1..2 loop
+               Mod_IO.Put(To   => TC_String_Array(i),
+                          Item => Modular_Array(i),
+                          Base => Mod_IO.Default_Base);
+            end loop;
+            for i in 3..4 loop
+               Mod_IO.Put(TC_String_Array(i),
+                          Modular_Array(i),
+                          Base => 2);
+            end loop;
+            for i in 5..6 loop
+               Mod_IO.Put(TC_String_Array(i), Modular_Array(i), 16);
+            end loop;
+
+            -- Get modular values from strings using the Procedure Get.
+            -- Compare with expected modular values.
+
+            for i in 1..Number_Of_Modular_Items loop
+
+               Mod_IO.Get(From => TC_String_Array(i),
+                          Item => TC_Modular,
+                          Last => TC_Last_Character_Read);
+
+               if TC_Modular /= Modular_Array(i) then
+                  Report.Failed("Incorrect modular data value obtained "   &
+                                "from String following use of Procedures " & 
+                                "Put and Get from Strings, Modular_Array " &
+                                "item #" & Integer'Image(i));
+               end if;
+            end loop;
+         
+         exception
+            when others => 
+               Report.Failed("Unexpected exception raised during the " &
+                             "evaluation of Put and Get for Strings");
+         end Modular_IO_in_Strings;
+
+      exception
+         when others => Report.Failed ("Exception raised in Test_Block");
+      end Test_Block;
+
+
+      -- Delete the external file.
+      if Ada.Text_IO.Is_Open(Data_File) then
+         Ada.Text_IO.Delete(Data_File);
+      else
+         Ada.Text_IO.Open(Data_File, 
+                          Ada.Text_IO.In_File,
+                          Data_Filename);
+         Ada.Text_IO.Delete(Data_File);
+      end if;
+
+   exception
+
+      -- Since Use_Error can be raised if, for the specified mode,
+      -- the environment does not support Text_IO operations, the 
+      -- following handlers are included:
+
+      when Ada.Text_IO.Use_Error  =>
+         Report.Not_Applicable ("Use_Error raised on Text_IO Create");
+
+      when Ada.Text_IO.Name_Error =>
+         Report.Not_Applicable ("Name_Error raised on Text_IO Create");
+
+      when others                 =>
+         Report.Failed ("Unexpected exception raised on text file Create");
+
+   end Test_for_Text_IO_Support;
+
+   Report.Result;
+
+end CXAA018;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa019.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa019.a
new file mode 100644
index 000000000..04c257e97
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaa019.a
@@ -0,0 +1,138 @@
+-- CXAA019.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that Standard_Output can be flushed.  Check that 'in' parameters of
+--    types Ada.Text_IO.File_Type and Ada.Streams.Stream_IO.File_Type can be
+--    flushed.  (Defect Report 8652/0051).
+--
+-- CHANGE HISTORY:
+--    12 FEB 2001   PHL   Initial version
+--    16 MAR 2001   RLB   Readied for release; fixed Not_Applicable check
+--                        to terminate test gracefully.
+--
+--!
+with Ada.Streams.Stream_Io;
+use Ada.Streams;
+with Ada.Text_Io;
+with Ada.Wide_Text_Io;
+with Report;
+use Report;
+procedure CXAA019 is
+
+    procedure Check (File : in Ada.Text_Io.File_Type) is
+    begin
+        Ada.Text_Io.Put_Line
+           (File, "   - CXAA019 About to flush a Text_IO file passed " &
+                  "as 'in' parameter");
+        Ada.Text_Io.Flush (File);
+    end Check;
+
+    procedure Check (File : in Ada.Wide_Text_Io.File_Type) is
+    begin
+        Ada.Wide_Text_Io.Put_Line
+           (File, "   - CXAA019 About to flush a Wide_Text_IO file passed " &
+                  "as 'in' parameter");
+        Ada.Wide_Text_Io.Flush (File);
+    end Check;
+
+    procedure Check (File : in Stream_Io.File_Type) is
+        S : Stream_Element_Array (1 .. 10);
+    begin
+        for I in S'Range loop
+            S (I) := Stream_Element (Character'Pos ('A') + I);
+        end loop;
+        Stream_Io.Write (File, S);
+        Comment ("About to flush a Stream_IO file passed as 'in' parameter");
+        Stream_Io.Flush (File);
+    end Check;
+
+
+begin
+    Test ("CXAA019",
+          "Check that Standard_Output can be flushed; check that " &
+             "'in' Ada.Text_IO.File_Type and Ada.Streams.Stream_IO.File_Type" &
+             "parameters can be flushed");
+
+    Ada.Text_Io.Put_Line (Ada.Text_Io.Standard_Output,
+                          "   - CXAA019 About to flush Standard_Output");
+    Ada.Text_Io.Flush (Ada.Text_Io.Standard_Output);
+
+    Check (Ada.Text_Io.Current_Output);
+
+    declare
+        TC_OK : Boolean := False;
+        F : Ada.Text_Io.File_Type;
+    begin
+        begin
+            Ada.Text_Io.Create (F, Name => Legal_File_Name (X => 1));
+            TC_OK := True;
+        exception
+            when others =>
+                Not_Applicable ("Unable to create Out mode Text_IO file");
+        end;
+        if TC_OK then
+            Check (F);
+            Ada.Text_Io.Delete (F);
+        end if;
+    end;
+
+    declare
+        TC_OK : Boolean := False;
+        F : Ada.Wide_Text_Io.File_Type;
+    begin
+        begin
+            Ada.Wide_Text_Io.Create (F, Name => Legal_File_Name (X => 2));
+            TC_OK := True;
+        exception
+            when others =>
+                Not_Applicable ("Unable to create Out mode Wide_Text_IO file");
+        end;
+        if TC_OK then
+            Check (F);
+            Ada.Wide_Text_Io.Delete (F);
+        end if;
+    end;
+
+    declare
+        TC_OK : Boolean := False;
+        F : Stream_Io.File_Type;
+    begin
+        begin
+            Stream_Io.Create (F, Name => Legal_File_Name (X => 3));
+            TC_OK := True;
+        exception
+            when others =>
+                Not_Applicable ("Unable to create Out mode Stream_IO file");
+        end;
+        if TC_OK then
+            Check (F);
+            Stream_Io.Delete (F);
+        end if;
+    end;
+
+    Result;
+end CXAA019;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxab001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxab001.a
new file mode 100644
index 000000000..483acd16c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxab001.a
@@ -0,0 +1,272 @@
+-- CXAB001.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 operations defined in package Wide_Text_IO allow for 
+--      the input/output of Wide_Character and Wide_String data.
+--
+-- TEST DESCRIPTION:
+--      This test is designed to exercise the components of the Wide_Text_IO
+--      package, including the Put/Get utilities for Wide_Characters and
+--      Wide_String objects.
+--      The test utilizes the Put and Get procedures defined for
+--      Wide_Characters, as well as the Put, Get, Put_Line, and Get_Line
+--      procedures defined for Wide_Strings.  In addition, many of the 
+--      additional subprograms found in package Wide_Text_IO are used in this
+--      test.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations capable of supporting
+--      external Wide_Text_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      26 Feb 97   CTA.PWB Allowed for non-support of some IO operations.
+--!
+
+with Ada.Wide_Text_IO;
+with Report;
+
+procedure CXAB001 is
+
+   Filter_File     : Ada.Wide_Text_IO.File_Type;
+   Filter_Filename : constant String :=
+                              Report.Legal_File_Name ( Nam => "CXAB001" );
+   Incomplete : exception;
+
+
+begin
+
+   Report.Test ("CXAB001", "Check that the operations defined in package " &
+                           "Wide_Text_IO allow for the input/output of "   &
+                           "Wide_Character and Wide_String data");
+
+
+   Test_for_Wide_Text_IO_Support:
+   begin
+
+      -- An implementation that does not support Wide_Text_IO in a particular
+      -- environment will raise Use_Error on calls to various
+      -- Wide_Text_IO operations.  This block statement encloses a call to
+      -- Create, which should raise an exception in a non-supportive 
+      -- environment.  This exception will be handled to produce a
+      -- Not_Applicable result.
+
+      Ada.Wide_Text_IO.Create (File => Filter_File,                 -- Create.
+                               Mode => Ada.Wide_Text_IO.Out_File,
+                               Name => Filter_Filename);
+
+   exception
+
+       when Ada.Wide_Text_IO.Use_Error | Ada.Wide_Text_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Wide_Text_IO" );
+          raise Incomplete;
+
+   end Test_for_Wide_Text_IO_Support;
+
+   Operational_Test_Block:
+   declare
+
+      First_String  : constant Wide_String := "Somewhere ";
+      Second_String : constant Wide_String := "Over The ";
+      Third_String  : constant Wide_String := "Rainbow";
+      Current_Char  : Wide_Character       := ' ';
+
+   begin
+
+      Enter_Data_In_File:
+      declare
+         Pos                 : Natural := 1;
+         Bad_Character_Found : Boolean := False;
+      begin
+         -- Use the Put procedure defined for Wide_Character data to 
+         -- write all of the wide characters of the First_String into 
+         -- the file individually, followed by a call to New_Line.
+
+         while Pos <= First_String'Length loop
+            Ada.Wide_Text_IO.Put (Filter_File, First_String (Pos));  -- Put.
+            Pos := Pos + 1;
+         end loop;
+         Ada.Wide_Text_IO.New_Line (Filter_File);               -- New_Line.
+
+         -- Reset to In_File mode and read file contents, using the Get
+         -- procedure defined for Wide_Character data.
+         Reset1:
+         begin
+            Ada.Wide_Text_IO.Reset (Filter_File,                      -- Reset.
+                                    Ada.Wide_Text_IO.In_File);   
+         exception
+            when Ada.Wide_Text_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Wide_Text_IO" );
+               raise Incomplete;
+         end Reset1;
+                                      
+         Pos := 1;
+         while Pos <= First_String'Length loop
+            Ada.Wide_Text_IO.Get (Filter_File, Current_Char);        -- Get.
+            -- Verify the wide character against the original string.
+            if Current_Char /= First_String(Pos) then
+               Bad_Character_Found := True;
+            end if;
+            Pos := Pos + 1;
+         end loop;
+
+         if Bad_Character_Found then
+            Report.Failed ("Incorrect Wide_Character read from file - 1");
+         end if;
+
+            -- Following user file/string processing, the Wide_String data 
+            -- of the Second_String and Third_String Wide_String objects are 
+            -- appended to the file.
+            -- The Put procedure defined for Wide_String data is used to 
+            -- transfer the Second_String, followed by a call to New_Line.  
+            -- The Put_Line procedure defined for Wide_String data is used 
+            -- to transfer the Third_String.
+         Reset2:
+         begin
+            Ada.Wide_Text_IO.Reset    (Filter_File,                   -- Reset.
+                                       Ada.Wide_Text_IO.Append_File);
+
+         exception
+            when Ada.Wide_Text_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to Append_File not supported for Wide_Text_IO" );
+               raise Incomplete;
+         end Reset2;
+
+         Ada.Wide_Text_IO.Put      (Filter_File, Second_String);     -- Put.
+         Ada.Wide_Text_IO.New_Line (Filter_File);               -- New_Line.
+
+         Ada.Wide_Text_IO.Put_Line (Filter_File, Third_String); -- Put_Line.
+         Ada.Wide_Text_IO.Close    (Filter_File);               -- Close.
+
+      exception
+
+         when Incomplete =>
+           raise; 
+
+         when others => 
+            Report.Failed ("Exception in Enter_Data_In_File block");
+            raise;
+ 
+      end Enter_Data_In_File;
+
+         ---
+
+      Filter_Block:
+      declare
+
+         Pos          : Positive := 1;
+         TC_String2   : Wide_String (1..Second_String'Length);
+         TC_String3   : Wide_String (1..Third_String'Length);
+         Last         : Natural  := Natural'First;
+
+      begin
+
+         Ada.Wide_Text_IO.Open (Filter_File,                       -- Open.
+                                Ada.Wide_Text_IO.In_File,
+                                Filter_Filename);
+
+
+         -- Read the data of the First_String from the file, using the
+         -- Get procedure defined for Wide_Character data.
+         -- Verify that the character corresponds to the data originally
+         -- written to the file.
+
+         while Pos <= First_String'Length loop
+            Ada.Wide_Text_IO.Get (Filter_File, Current_Char);       -- Get.
+            if Current_Char /= First_String(Pos) then
+               Report.Failed 
+                 ("Incorrect Wide_Character read from file - 2");
+            end if;
+            Pos := Pos + 1;
+         end loop;
+          
+         -- The first line of the file has been read, move to the second.
+         Ada.Wide_Text_IO.Skip_Line (Filter_File);             -- Skip_Line.
+
+         -- Read the Wide_String data from the second and third lines of
+         -- the file.
+         Ada.Wide_Text_IO.Get       (Filter_File, TC_String2); -- Get.
+         Ada.Wide_Text_IO.Skip_Line (Filter_File);             -- Skip_Line.
+         Ada.Wide_Text_IO.Get_Line  (Filter_File,              -- Get_Line.
+                                     TC_String3, Last);        
+
+         -- Verify data of second and third strings.
+         if TC_String2 /= Second_String then
+            Report.Failed ("Incorrect Wide_String read from file - 1");
+         end if;
+         if TC_String3 /= Third_String then
+            Report.Failed ("Incorrect Wide_String read from file - 2");
+         end if;
+
+         -- The file should now be at EOF.                 
+         if not Ada.Wide_Text_IO.End_Of_File (Filter_File) then      -- EOF.
+            Report.Failed ("File not empty following filtering");
+         end if;
+
+      exception
+         when others => 
+            Report.Failed ("Exception in Filter_Block");
+            raise;
+      end Filter_Block;
+
+   exception
+
+      when Incomplete =>
+         raise; 
+      when others => 
+         Report.Failed ("Exception raised in Operational Test Block");
+      
+   end Operational_Test_Block;
+
+   Deletion:
+   begin
+      if Ada.Wide_Text_IO.Is_Open (Filter_File) then            -- Is_Open.
+         Ada.Wide_Text_IO.Delete (Filter_File);                 -- Delete.
+      else
+         Ada.Wide_Text_IO.Open (Filter_File,                    -- Open.
+                                Ada.Wide_Text_IO.Out_File, 
+                                Filter_Filename);
+         Ada.Wide_Text_IO.Delete (Filter_File);                 -- Delete.
+      end if;
+   exception
+      when others =>
+         Report.Failed ("Delete not properly implemented for Wide_Text_IO");
+   end Deletion;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAB001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac001.a
new file mode 100644
index 000000000..a77d561f5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac001.a
@@ -0,0 +1,292 @@
+-- CXAC001.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 attribute T'Write will, for any specific non-limited
+--      type T, write an item of the subtype to the stream.
+--
+--      Check that the attribute T'Read will, for a specific non-limited
+--      type T, read a value of the subtype from the stream.
+--
+-- TEST DESCRIPTION:
+--      The scenario depicted in this test is that of an environment where 
+--      product data is stored in stream form, then reconstructed into the
+--      appropriate data structures.  Several records of product information
+--      are stored in an array; the array is passed as a parameter to a 
+--      procedure for storage in the stream.  A header is created based on the
+--      number of data records stored in the array.  The header is then written
+--      to the stream, followed by each record maintained in the array.
+--      In order to retrieve data from the stream, the header information is
+--      read from the stream, and the data stored in the header is used to 
+--      perform the appropriate number of read operations of record data from
+--      the stream.  All data read from the stream is validated against the
+---     values that were written to the stream.
+--
+-- APPLICABILITY CRITERIA: 
+--      Applicable to all systems capable of supporting IO operations on 
+--      external Stream_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      08 Nov 95   SAIC    Corrected call to Read in Procedure Retrieve_Data
+--                          for ACVC 2.0.1.
+--      27 Feb 08   PWB.CTA Allowed for non-support of certain IO operations.
+--!
+
+with Ada.Streams.Stream_IO;
+with Report;
+
+procedure CXAC001 is
+
+   package Strm_Pack renames Ada.Streams.Stream_IO;
+   The_File     : Strm_Pack.File_Type;
+   The_Filename : constant String :=
+                     Report.Legal_File_Name ( Nam => "CXAC001" );
+   Incomplete : exception;
+
+
+begin 
+
+   Report.Test ("CXAC001", "Check that the 'Read and 'Write attributes " &
+                           "will transfer an object of a specific, "     &
+                           "non-limited type to/from a stream");
+
+   Test_for_Stream_IO_Support:
+   begin
+
+      -- If an implementation does not support Stream_IO in a particular
+      -- environment, the exception Use_Error or Name_Error will be raised on 
+      -- calls to various Stream_IO operations.  This block statement 
+      -- encloses a call to Create, which should produce an exception in a 
+      -- non-supportive environment.  These exceptions will be handled to 
+      -- produce a Not_Applicable result.
+
+      Strm_Pack.Create (The_File, Strm_Pack.Out_File, The_Filename);
+
+   exception
+
+       when Ada.Streams.Stream_IO.Use_Error | 
+            Ada.Streams.Stream_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Stream_IO" );
+          raise Incomplete;
+
+   end Test_for_Stream_IO_Support;
+
+   Operational_Test_Block:
+   declare
+
+      The_Stream : Strm_Pack.Stream_Access;
+      Todays_Date : String (1 .. 6) := "271193";
+
+      type ID_Type   is range 1 .. 100;
+      type Size_Type is (Small, Medium, Large, XLarge);
+
+      type Header_Type is record
+         Number_of_Elements : Natural := 0;
+         Origination_Date   : String (1 .. 6);
+      end record;
+
+      type Data_Type is record
+         ID   : ID_Type;
+         Size : Size_Type;
+      end record;
+
+      type Data_Array_Type is array (Positive range <>) of Data_Type;
+
+      Product_Information_1 : Data_Array_Type (1 .. 3) := ((20, Large),
+                                                           (55, Small),
+                                                           (89, XLarge));
+
+      Product_Information_2 : Data_Array_Type (1 .. 4) := (( 5, XLarge),
+                                                           (27, Small),
+                                                           (79, Medium),
+                                                           (93, XLarge));
+
+      procedure Store_Data ( The_Stream : in Strm_Pack.Stream_Access;
+                             The_Array  : in Data_Array_Type ) is
+         Header     : Header_Type;
+      begin
+
+         -- Fill in header info.
+         Header.Number_of_Elements := The_Array'Length;
+         Header.Origination_Date := Todays_Date;       
+
+         -- Write header to stream.
+         Header_Type'Write (The_Stream, Header);   
+                                                      
+         -- Write each record in the array to the stream.
+         for I in 1 .. Header.Number_of_Elements loop
+           Data_Type'Write (The_Stream, The_Array (I));
+         end loop;                                     
+
+      end Store_Data;
+
+      procedure Retrieve_Data (The_Stream : in     Strm_Pack.Stream_Access;
+                               The_Header :    out Header_Type;
+                               The_Array  :    out Data_Array_Type ) is
+      begin
+
+         -- Read header from the stream.
+         Header_Type'Read (The_Stream, The_Header);  
+                                                   
+         -- Read the records from the stream into the array.
+         for I in 1 .. The_Header.Number_of_Elements loop    
+            Data_Type'Read (The_Stream, The_Array (I));  
+         end loop;                                       
+
+      end Retrieve_Data;
+
+   begin
+
+      -- Assign access value.
+      The_Stream := Strm_Pack.Stream (The_File);      
+
+      -- Product information is to be stored in the stream file.  These
+      -- data arrays are of different sizes (actually, the records
+      -- are stored individually, not as a single array).  Prior to the
+      -- record data being written, a header record is initialized with
+      -- information about the data to be written, then itself is written
+      -- to the stream.
+
+      Store_Data (The_Stream, Product_Information_1);
+      Store_Data (The_Stream, Product_Information_2);
+
+      Test_Verification_Block:
+      declare
+         Product_Header_1 : Header_Type;
+         Product_Header_2 : Header_Type;
+         Product_Array_1  : Data_Array_Type (1 .. 3);
+         Product_Array_2  : Data_Array_Type (1 .. 4);
+      begin
+
+         Reset1:
+         begin
+            Strm_Pack.Reset (The_File, Strm_Pack.In_File);
+         exception
+            when Ada.Streams.Stream_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Stream_IO" );
+               raise Incomplete;
+         end Reset1;
+
+         -- Data is read from the stream, first the appropriate header, 
+         -- then the associated data records, which are then reconstructed
+         -- into a data array of product information.
+
+         Retrieve_Data (The_Stream, Product_Header_1, Product_Array_1);
+
+         -- Validate a field in the header.
+         if (Product_Header_1.Origination_Date   /= Todays_Date) or
+            (Product_Header_1.Number_of_Elements /= 3)    
+         then
+            Report.Failed ("Incorrect Header_1 info read from stream");
+         end if;
+
+         -- Validate the data records read from the file.
+         for I in 1 .. Product_Header_1.Number_of_Elements loop
+            if (Product_Array_1(I) /= Product_Information_1(I)) then
+               Report.Failed ("Incorrect Product 1 info read from" &
+                              " record: " & Integer'Image (I));
+            end if;
+         end loop;
+
+         -- Repeat this read and verify operation for the next parcel of
+         -- data.  Again, header and data record information are read from
+         -- the same stream file.  
+         Retrieve_Data (The_Stream, Product_Header_2, Product_Array_2);
+
+         if (Product_Header_2.Origination_Date   /= Todays_Date) or
+            (Product_Header_2.Number_of_Elements /= 4)    
+         then 
+            Report.Failed ("Incorrect Header_2 info read from stream");
+         end if;
+
+         for I in 1 .. Product_Header_2.Number_of_Elements loop
+            if (Product_Array_2(I) /= Product_Information_2(I)) then
+               Report.Failed ("Incorrect Product_2 info read from" &
+                              " record: " & Integer'Image (I));
+            end if;
+         end loop;
+
+      exception
+
+         when Incomplete =>
+            raise; 
+
+         when Strm_Pack.End_Error =>           -- If correct number of 
+                                               -- items not in file (data 
+                                               -- overwritten), then fail.
+            Report.Failed ("Incorrect number of record elements in file");
+            if not Strm_Pack.Is_Open (The_File) then
+               Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename);
+            end if;
+
+         when others => 
+            Report.Failed ("Exception raised in Data Verification Block");
+            if not Strm_Pack.Is_Open (The_File) then
+               Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename);
+            end if;
+
+      end Test_Verification_Block;
+
+   exception
+
+      when Incomplete =>
+         raise; 
+
+      when others => 
+         Report.Failed ("Exception raised in Operational Test Block");
+
+   end Operational_Test_Block;
+
+   Deletion:
+   begin
+      -- Delete the file.
+      if Strm_Pack.Is_Open (The_File) then
+         Strm_Pack.Delete (The_File);
+      else
+         Strm_Pack.Open (The_File, Strm_Pack.Out_File, The_Filename);
+         Strm_Pack.Delete (The_File);
+      end if;
+
+   exception
+
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Stream_IO" );
+   end Deletion;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAC001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac002.a
new file mode 100644
index 000000000..e4b303c4b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac002.a
@@ -0,0 +1,426 @@
+-- CXAC002.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 subprograms defined in package Ada.Streams.Stream_IO
+--      are accessible, and that they provide the appropriate functionality.
+--
+-- TEST DESCRIPTION:
+--      This test simulates a user filter designed to capitalize the
+--      characters of a string.  It utilizes a variety of the subprograms
+--      contained in the package Ada.Streams.Stream_IO.
+--      Its purpose is to demonstrate the use of a variety of the capabilities
+--      found in the Ada.Streams.Stream_IO package.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations capable of supporting
+--      external Stream_IO files.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      14 Nov 95   SAIC    Corrected visibility problems; corrected
+--                          subtest validating result from function Name
+--                          for ACVC 2.0.1.
+--      05 Oct 96   SAIC    Removed calls to Close/Open in test and replaced
+--                          them with a single call to Reset (per AI95-0001)
+--      26 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
+--      09 Feb 01   RLB     Corrected non-support check to avoid unintended
+--                          failures.
+--!
+
+package CXAC002_0 is
+
+   -- This function searches for the first instance of a specified substring
+   -- within a specified string, returning boolean result. (Case insensitive
+   -- analysis)
+
+   function Find (Str : in String; Sub : in String) return Boolean;
+
+end CXAC002_0;
+
+package body CXAC002_0 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 CXAC002_0;
+
+
+with Ada.Streams.Stream_IO, CXAC002_0, Report;
+procedure CXAC002 is
+   Filter_File     : Ada.Streams.Stream_IO.File_Type;
+   Filter_Stream   : Ada.Streams.Stream_IO.Stream_Access;
+   Filter_Filename : constant String :=
+                              Report.Legal_File_Name ( Nam => "CXAC002" );
+   Incomplete : Exception;
+
+begin
+
+   Report.Test ("CXAC002", "Check that the subprograms defined in "         &
+                           "package Ada.Streams.Stream_IO are accessible, " &
+                           "and that they provide the appropriate "         &
+                           "functionality");
+
+   Test_for_Stream_IO_Support:
+
+   begin
+
+      -- If an implementation does not support Stream_IO in a particular
+      -- environment, the exception Use_Error or Name_Error will be raised on
+      -- calls to various Stream_IO operations.  This block statement
+      -- encloses a call to Create, which should produce an exception in a
+      -- non-supportive environment.  These exceptions will be handled to
+      -- produce a Not_Applicable result.
+
+      Ada.Streams.Stream_IO.Create (Filter_File,                    -- Create.
+                                    Ada.Streams.Stream_IO.Out_File,
+                                    Filter_Filename);
+   exception
+
+       when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Stream_IO" );
+          raise Incomplete;
+
+   end Test_for_Stream_IO_Support;
+
+   Operational_Test_Block:
+   declare
+
+      use CXAC002_0;
+      use type Ada.Streams.Stream_IO.File_Mode;
+      use type Ada.Streams.Stream_IO.Count;
+
+      File_Size  : Ada.Streams.Stream_IO.Count :=            -- Count.
+        Ada.Streams.Stream_IO.Count'First;                   -- (0)
+      File_Index : Ada.Streams.Stream_IO.Positive_Count :=   -- Pos. Count.
+        Ada.Streams.Stream_IO.Positive_Count'First;          -- (1)
+
+      First_String  : constant String := "this is going to be ";
+      Second_String : constant String := "the best year of your life";
+      Total_Length  : constant Natural := First_String'Length +
+                                          Second_String'Length;
+      Current_Char  : Character := ' ';
+
+      Cap_String    : String (1..Total_Length) := (others => ' ');
+
+      TC_Capital_String : constant String :=
+                "THIS IS GOING TO BE THE BEST YEAR OF YOUR LIFE";
+
+   begin
+
+      if not Ada.Streams.Stream_IO.Is_Open (Filter_File) then   -- Is_Open
+         Report.Failed ("File not open following Create");
+      end if;
+
+      -- Call function Find to determine if the filename (Sub) is contained
+      -- in the result of Function Name.
+
+      if not Find(Str => Ada.Streams.Stream_IO.Name(Filter_File), -- Name.
+                  Sub => Filter_Filename)
+      then
+         Report.Failed ("Function Name provided incorrect filename");
+      end if;
+                                                                 -- Stream.
+      Filter_Stream := Ada.Streams.Stream_IO.Stream (Filter_File);
+
+      ---
+
+      Enter_Data_In_Stream:
+      declare
+         Pos                 : Natural := 1;
+         Bad_Character_Found : Boolean := False;
+      begin
+
+         -- Enter data from the first string into the stream.
+         while Pos <= Natural(First_String'Length) loop
+            -- Write all characters of the First_String to the stream.
+            Character'Write (Filter_Stream, First_String (Pos));
+            Pos := Pos + 1;
+            -- Ensure data put in file on a regular basis.
+            if Pos mod 5 = 0 then
+               Ada.Streams.Stream_IO.Flush (Filter_File);         -- Flush.
+            end if;
+         end loop;
+
+         Ada.Streams.Stream_IO.Flush (Filter_File);               -- Flush.
+         -- Reset to In_File mode and read stream contents.
+         Reset1:
+         begin
+            Ada.Streams.Stream_IO.Reset (Filter_File,                -- Reset.
+                                         Ada.Streams.Stream_IO.In_File);
+         exception
+            when Ada.Streams.Stream_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Stream_IO" );
+               raise Incomplete;
+         end Reset1;
+
+         Pos := 1;
+         while Pos <= First_String'Length loop
+            -- Read one character from the stream.
+            Character'Read (Filter_Stream, Current_Char);         -- 'Read
+            -- Verify character against the original string.
+            if Current_Char /= First_String(Pos) then
+               Bad_Character_Found := True;
+            end if;
+            Pos := Pos + 1;
+         end loop;
+
+         if Bad_Character_Found then
+            Report.Failed ("Incorrect character read from stream");
+         end if;
+
+         -- Following user stream/string processing, the stream file is
+         -- appended to as follows:
+
+         Reset2:
+         begin
+            Ada.Streams.Stream_IO.Reset (Filter_File,                -- Reset.
+                                         Ada.Streams.Stream_IO.Append_File);
+         exception
+            when Ada.Streams.Stream_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to Append_File not supported for Stream_IO" );
+               raise Incomplete;
+         end Reset2;
+
+         if Ada.Streams.Stream_IO.Mode (Filter_File) /=           -- Mode.
+            Ada.Streams.Stream_IO.Append_File
+         then
+            Report.Failed ("Incorrect mode following Reset to Append");
+         end if;
+
+         Pos := 1;
+         while Pos <= Natural(Second_String'Length) loop
+            -- Write all characters of the Second_String to the stream.
+            Character'Write (Filter_Stream, Second_String (Pos)); -- 'Write
+            Pos := Pos + 1;
+         end loop;
+
+         Ada.Streams.Stream_IO.Flush (Filter_File);               -- Flush.
+
+         -- Record file statistics.
+         File_Size  := Ada.Streams.Stream_IO.Size  (Filter_File); -- Size.
+
+         Index_Might_Not_Be_Supported:
+         begin
+            File_Index := Ada.Streams.Stream_IO.Index (Filter_File); -- Index.
+         exception
+            when Ada.Streams.Stream_IO.Use_Error =>
+               Report.Not_Applicable ( "Index not supported for Stream_IO" );
+               raise Incomplete;
+         end Index_Might_Not_Be_Supported;
+
+      exception
+         when Incomplete =>
+            raise;
+         when others =>
+            Report.Failed ("Exception in Enter_Data_In_Stream block");
+            raise;
+      end Enter_Data_In_Stream;
+
+      ---
+
+      Filter_Block:
+      declare
+         Pos          : Positive := 1;
+         Full_String  : constant String := First_String & Second_String;
+
+         function Capitalize (Char : Character) return Character is
+         begin
+            if Char /= ' ' then
+               return Character'Val( Character'Pos(Char) -
+                      (Character'Pos('a') - Character'Pos('A')));
+            else
+               return Char;
+            end if;
+         end Capitalize;
+
+      begin
+
+         Reset3:
+         begin
+           Ada.Streams.Stream_IO.Reset (Filter_File,                -- Reset.
+                                         Ada.Streams.Stream_IO.In_File);
+         exception
+            when Ada.Streams.Stream_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Stream_IO" );
+               raise Incomplete;
+         end Reset3;
+
+         if Ada.Streams.Stream_IO.Mode (Filter_File) /=           -- Mode.
+            Ada.Streams.Stream_IO.In_File
+         then
+            Report.Failed ("Incorrect mode following Reset to In_File");
+         end if;
+
+         if not Ada.Streams.Stream_IO.Is_Open (Filter_File) then -- Is_Open
+            Report.Failed ( "Reset command did not leave file open" );
+         end if;
+
+         if Ada.Streams.Stream_IO.Size (Filter_File) /=            -- Size.
+            File_Size
+         then
+            Report.Failed ("Reset file is not correct size");
+         end if;
+
+         if Ada.Streams.Stream_IO.Index (Filter_File) /= 1 then    -- Index.
+            -- File position should have been reset to start of file.
+            Report.Failed ("Index of file not set to 1 following Reset");
+         end if;
+
+         while Pos <= Full_String'Length loop
+            -- Read one character from the stream.
+            Character'Read (Filter_Stream, Current_Char);          -- 'Read
+            -- Verify character against the original string.
+            if Current_Char /= Full_String(Pos) then
+               Report.Failed ("Incorrect character read from stream");
+            else
+               -- Capitalize the characters read from the stream, and
+               -- place them in a string variable.
+               Cap_String(Pos) := Capitalize (Current_Char);
+            end if;
+            Pos := Pos + 1;
+         end loop;
+
+         -- File index should now be set to the position following the final
+         -- character in the file (the same as the index value stored at
+         -- the completion of the Enter_Data_In_Stream block).
+         if Ada.Streams.Stream_IO.Index (Filter_File) /=           -- Index.
+            File_Index
+         then
+            Report.Failed ("Incorrect file index position");
+         end if;
+
+         -- The stream file should now be at EOF.                  -- EOF.
+         if not Ada.Streams.Stream_IO.End_Of_File (Filter_File) then
+            Report.Failed ("File not empty following filtering");
+         end if;
+
+      exception
+
+         when Incomplete =>
+            raise;
+         when others =>
+            Report.Failed ("Exception in Filter_Block");
+            raise;
+      end Filter_Block;
+
+         ---
+
+      Verification_Block:
+      begin
+
+         -- Verify that the entire string was examined, and that the
+         -- process of capitalizing the character data was successful.
+         if Cap_String /= TC_Capital_String then
+            Report.Failed ("Incorrect Capitalization");
+         end if;
+
+      exception
+         when others =>
+            Report.Failed ("Exception in Verification_Block");
+      end Verification_Block;
+
+
+   exception
+
+         when Incomplete =>
+            raise;
+         when others =>
+            Report.Failed ("Exception raised in Operational Test Block");
+
+   end Operational_Test_Block;
+
+   Deletion:
+   begin
+      if Ada.Streams.Stream_IO.Is_Open (Filter_File) then          -- Is_Open.
+         Ada.Streams.Stream_IO.Delete (Filter_File);               -- Delete.
+      else
+         Ada.Streams.Stream_IO.Open (Filter_File,                  -- Open.
+                                     Ada.Streams.Stream_IO.Out_File,
+                                     Filter_Filename);
+         Ada.Streams.Stream_IO.Delete (Filter_File);               -- Delete.
+      end if;
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Stream_IO" );
+   end Deletion;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAC002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac003.a
new file mode 100644
index 000000000..cc1e044d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac003.a
@@ -0,0 +1,376 @@
+-- CXAC003.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 correct exceptions are raised when improperly
+--      manipulating stream file objects.
+--
+-- TEST DESCRIPTION:
+--      This test is designed to focus on Stream_IO file manipulation
+--      exceptions.  Several potentially common user errors are examined in
+--      the test:
+--
+--      A Status_Error should be raised whenever an attempt is made to perform
+--      an operation on a file that is closed.
+--
+--      A Status_Error should be raised when an attempt is made to open a
+--      stream file that is currently open.
+--
+--      A Mode_Error should be raised when attempting to read from (use the
+--      'Read attribute) on an Out_File or Append_Mode file.
+--
+--      A Mode_Error should be raised when checking for End Of File on a
+--      file with mode Out_File or Append_Mode.
+--
+--      A Mode_Error should be raised when attempting to write to (use the
+--      'Output attribute) on a file with mode In_File.
+--
+--      A Name_Error should be raised when the string provided to the Name
+--      parameter of an Open operation does not allow association of an
+--      external file.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations capable of supporting
+--      external Stream_IO files.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
+--      02 Mar 01   PHL     Check that Ada.Streams.Stream_IO.Stream raises
+--                          Status_Error if the file is not open.  (DR 8652/
+--                          0056).
+--      15 Mar 01   RLB     Readied for release.
+--!
+
+with Ada.Streams.Stream_IO;
+with Report;
+
+procedure CXAC003 is
+
+   Stream_File_Object  : Ada.Streams.Stream_IO.File_Type;
+   Stream_Access_Value : Ada.Streams.Stream_IO.Stream_Access;
+   Stream_Filename     : constant String :=
+                              Report.Legal_File_Name ( Nam => "CXAC003" );
+   Incomplete : exception;
+
+begin
+
+   Report.Test ("CXAC003", "Check that the correct exceptions are "  &
+                           "raised when improperly manipulating stream " &
+                           "file objects");
+
+   Test_for_Stream_IO_Support:
+   begin
+      -- If an implementation does not support Stream_IO in a particular
+      -- environment, the exception Use_Error or Name_Error will be raised on
+      -- calls to various Stream_IO operations.  This block statement
+      -- encloses a call to Create, which should produce an exception in a
+      -- non-supportive environment.  These exceptions will be handled to
+      -- produce a Not_Applicable result.
+
+      Ada.Streams.Stream_IO.Create (Stream_File_Object,
+                                    Ada.Streams.Stream_IO.Out_File,
+                                    Stream_Filename);
+
+   exception
+
+       when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Stream_IO" );
+          raise Incomplete;
+
+   end Test_for_Stream_IO_Support;
+
+   Operational_Test_Block:
+   begin
+      -- A potentially common error in a file processing environment
+      -- is to attempt to perform an operation on a stream file that is
+      -- not currently open. Status_Error should be raised in this case.
+      Check_Status_Error:
+      begin
+         Ada.Streams.Stream_IO.Close (Stream_File_Object);
+         -- Attempt to reset a file that is closed.
+         Ada.Streams.Stream_IO.Reset (Stream_File_Object,
+                                      Ada.Streams.Stream_IO.Out_File);
+         Report.Failed ("Exception not raised on Reset of closed file");
+      exception
+         when Ada.Streams.Stream_IO.Status_Error =>
+            null;
+         when others       =>
+            Report.Failed ("Incorrect exception raised - 1");
+      end Check_Status_Error;
+
+      -- A similar error is to use Ada.Streams.Stream_IO.Stream
+      -- to attempt to perform an operation on a stream file that is
+      -- not currently open. Status_Error should be raised in this case.
+      -- (Defect Report 8652/0046, as reflected in Technical Corrigendum 1.)
+      Check_Status_Error2:
+      begin
+         -- Ensure that the file is not open.
+         if Ada.Streams.Stream_Io.Is_Open (Stream_File_Object) then
+            Ada.Streams.Stream_Io.Close (Stream_File_Object);
+         end if;
+         Stream_Access_Value :=
+            Ada.Streams.Stream_Io.Stream (Stream_File_Object);
+         Report.Failed ("Exception not raised on Stream of closed file");
+      exception
+         when Ada.Streams.Stream_Io.Status_Error =>
+            null;
+         when others =>
+            Report.Failed ("Incorrect exception raised - 2");
+      end Check_Status_Error2;
+
+      -- Another potentially common error in a file processing environment
+      -- is to attempt to Open a stream file that is currently open.
+      -- Status_Error should be raised in this case.
+      Check_Status_Error3:
+      begin
+         -- Ensure that the file is open.
+         if not Ada.Streams.Stream_IO.Is_Open (Stream_File_Object) then
+            Ada.Streams.Stream_IO.Open (Stream_File_Object,
+                                        Ada.Streams.Stream_IO.In_File,
+                                        Stream_Filename);
+         end if;
+         Ada.Streams.Stream_IO.Open (Stream_File_Object,
+                                     Ada.Streams.Stream_IO.In_File,
+                                     Stream_Filename);
+         Report.Failed ("Exception not raised on Open of open file");
+      exception
+         when Ada.Streams.Stream_IO.Status_Error =>
+            null;
+         when others       =>
+            Report.Failed ("Incorrect exception raised - 3");
+      end Check_Status_Error3;
+
+      -- Another example of a potential error occurring in a file
+      -- processing environment is to attempt to use the 'Read attribute
+      -- on a stream file that is currently in Out_File or Append_File
+      -- mode. Mode_Error should be raised in both of these cases.
+      Check_Mode_Error:
+      declare
+         Int_Var : Integer := -10;
+      begin
+
+         Reset1:
+         begin
+            Ada.Streams.Stream_IO.Reset (Stream_File_Object,
+                                         Ada.Streams.Stream_IO.Out_File);
+         exception
+            when Ada.Streams.Stream_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to Out_File not supported for Stream_IO - 1" );
+               raise Incomplete;
+         end Reset1;
+
+         Stream_Access_Value :=
+              Ada.Streams.Stream_IO.Stream (Stream_File_Object);
+         Integer'Write (Stream_Access_Value, Int_Var);
+
+         -- File contains an integer value, but is of mode Out_File.
+         Integer'Read (Stream_Access_Value, Int_Var);
+            Report.Failed ("Exception not raised by 'Read of Out_File");
+      exception
+         when Incomplete =>
+            raise;
+         when Ada.Streams.Stream_IO.Mode_Error =>
+            null;
+            Try_Read:
+            begin
+               Reset2:
+               begin
+                  Ada.Streams.Stream_IO.Reset
+                    (Stream_File_Object, Ada.Streams.Stream_IO.Append_File);
+               exception
+                  when Ada.Streams.Stream_IO.Use_Error =>
+                     Report.Not_Applicable
+                        ( "Reset to Append_File not supported " &
+                          "for Stream_IO - 2" );
+                     raise Incomplete;
+               end Reset2;
+
+               Integer'Write (Stream_Access_Value, Int_Var);
+               -- Attempt read from Append_File mode file.
+               Integer'Read (Stream_Access_Value, Int_Var);
+               Report.Failed
+                  ("Exception not raised by 'Read of Append file");
+            exception
+               when Incomplete =>
+                  null;
+               when Ada.Streams.Stream_IO.Mode_Error =>
+                  null;
+               when others     =>
+                  Report.Failed ("Incorrect exception raised - 4b");
+            end Try_Read;
+
+         when others => Report.Failed ("Incorrect exception raised - 4a");
+      end Check_Mode_Error;
+
+      -- Another example of a this type of potential error is to attempt
+      -- to check for End Of File on a stream file that is currently in
+      -- Out_File or Append_File mode. Mode_Error should also be raised
+      -- in both of these cases.
+      Check_End_File:
+      declare
+         Test_Boolean : Boolean := False;
+      begin
+         Reset3:
+         begin
+            Ada.Streams.Stream_IO.Reset (Stream_File_Object,
+                                         Ada.Streams.Stream_IO.Out_File);
+         exception
+            when Ada.Streams.Stream_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to Out_File not supported for Stream_IO - 3" );
+               raise Incomplete;
+         end Reset3;
+
+         Test_Boolean :=
+           Ada.Streams.Stream_IO.End_Of_File (Stream_File_Object);
+         Report.Failed ("Exception not raised by EOF on Out_File");
+      exception
+         when Incomplete =>
+            null;
+         when Ada.Streams.Stream_IO.Mode_Error =>
+            null;
+            EOF_For_Append_File:
+            begin
+               Reset4:
+               begin
+                  Ada.Streams.Stream_IO.Reset
+                    (Stream_File_Object, Ada.Streams.Stream_IO.Append_File);
+               exception
+                  when Ada.Streams.Stream_IO.Use_Error =>
+                     Report.Not_Applicable
+                        ( "Reset to Append_File not supported " &
+                          "for Stream_IO - 4" );
+                     raise Incomplete;
+               end Reset4;
+
+               Test_Boolean :=
+                 Ada.Streams.Stream_IO.End_Of_File (Stream_File_Object);
+               Report.Failed
+                 ("Exception not raised by EOF of Append file");
+            exception
+               when Incomplete =>
+                  raise;
+               when Ada.Streams.Stream_IO.Mode_Error =>
+                  null;
+               when others     =>
+                  Report.Failed ("Incorrect exception raised - 5b");
+            end EOF_For_Append_File;
+
+         when others => Report.Failed ("Incorrect exception raised - 5a");
+      end Check_End_File;
+
+
+
+      -- In a similar situation to the above cases for attribute 'Read,
+      -- an attempt to use the 'Output attribute on a stream file that
+      -- is currently in In_File mode should result in Mode_Error being
+      -- raised.
+         Check_Output_Mode_Error:
+         begin
+            Reset5:
+            begin
+               Ada.Streams.Stream_IO.Reset (Stream_File_Object,
+                                            Ada.Streams.Stream_IO.In_File);
+         exception
+            when Ada.Streams.Stream_IO.Use_Error =>
+               Report.Not_Applicable
+                  ( "Reset to In_File not supported for Stream_IO - 6" );
+               raise Incomplete;
+         end Reset5;
+
+         Stream_Access_Value :=
+           Ada.Streams.Stream_IO.Stream (Stream_File_Object);
+         String'Output (Stream_Access_Value, "User-Oriented String");
+         Report.Failed ("Exception not raised by 'Output to In_File");
+      exception
+         when Incomplete =>
+            null;
+         when Ada.Streams.Stream_IO.Mode_Error =>
+            null;
+         when others     =>
+            Report.Failed ("Incorrect exception raised - 6");
+      end Check_Output_Mode_Error;
+
+      -- Any case of attempting to Open a stream file with a string for
+      -- the parameter Name that does not allow the identification of an
+      -- external file will result in the exception Name_Error being
+      -- raised.
+      Check_Illegal_File_Name:
+      begin
+         if Ada.Streams.Stream_IO.Is_Open (Stream_File_Object) then
+            Ada.Streams.Stream_IO.Close (Stream_File_Object);
+         end if;
+         -- No external file exists with this filename, allowing no
+         -- association with an internal file object, resulting in the
+         -- raising of the exception Name_Error.
+         Ada.Streams.Stream_IO.Open(File => Stream_File_Object,
+                                    Mode => Ada.Streams.Stream_IO.Out_File,
+                                    Name => Report.Legal_File_Name(2));
+         Report.Failed ("Exception not raised by bad filename on Open");
+      exception
+         when Ada.Streams.Stream_IO.Name_Error =>
+            null;
+         when others     =>
+            Report.Failed ("Incorrect exception raised - 7");
+      end Check_Illegal_File_Name;
+
+   exception
+         when Incomplete =>
+            null;
+         when others =>
+            Report.Failed ("Unexpected exception in Operational Test Block");
+
+   end Operational_Test_Block;
+
+   Deletion:
+   begin
+      if Ada.Streams.Stream_IO.Is_Open (Stream_File_Object) then
+         Ada.Streams.Stream_IO.Delete (Stream_File_Object);
+      else
+         Ada.Streams.Stream_IO.Open (Stream_File_Object,
+                                     Ada.Streams.Stream_IO.Out_File,
+                                     Stream_Filename);
+         Ada.Streams.Stream_IO.Delete (Stream_File_Object);
+      end if;
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Stream_IO" );
+   end Deletion;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAC003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac004.a
new file mode 100644
index 000000000..9cc88b93c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac004.a
@@ -0,0 +1,310 @@
+-- CXAC004.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 Stream_Access type and Stream function found in package
+--      Ada.Text_IO.Text_Streams allows a text file to be processed with the 
+--      functionality of streams.
+--
+-- TEST DESCRIPTION:
+--      This test verifies that the package Ada.Text_IO.Text_Streams is 
+--      available and that the functionality it contains allows a text file to
+--      be manipulated as a stream.
+--      The test defines data objects of a variety of types that can be stored
+--      in a text file.  A text file and associated text stream are then 
+--      defined, and the 'Write attribute is used to enter the individual data
+--      items into the text stream.  Once all the individual data items have 
+--      been written to the stream, the 'Output attribute is used to write 
+--      arrays of these same data objects to the stream.
+--      The text file is reset to serve as an input file, and the 'Read 
+--      attribute is used to extract the individual data items from the 
+--      stream.  These items are then verified against the data originally 
+--      written to the stream. Finally, the 'Input attribute is used to 
+--      extract the data arrays from the stream. These arrays are then 
+--      verified against the original data written to the stream.
+--
+-- APPLICABILITY CRITERIA: 
+--      Applicable to implementations that support external text files.
+--       
+-- CHANGE HISTORY:
+--      06 Jul 95   SAIC    Initial prerelease version.
+--      26 Feb 97   PWB.CTA Allowed for non-support of some IO operations;
+--                          removed requirement for support of decimal types.
+--!
+
+with Report;
+with Ada.Text_IO;
+with Ada.Text_IO.Text_Streams;
+with Ada.Characters.Latin_1;
+with Ada.Strings.Unbounded;
+
+procedure CXAC004 is
+
+   Data_File     : Ada.Text_IO.File_Type;
+   Data_Filename : constant String := 
+                           Report.Legal_File_Name ( Nam => "CXAC004" );
+   Incomplete : exception;
+
+begin
+
+   Report.Test ("CXAC004", "Check that the Stream_Access type and Stream "   &
+                           "function found in package "                      &
+                           "Ada.Text_IO.Text_Streams allows a text file to " &
+                           "be processed with the functionality of streams");
+
+   Test_for_IO_Support:
+   begin
+
+      -- Check for Text_IO support in creating the data file.  If the 
+      -- implementation does not support external files, Name_Error or 
+      -- Use_Error will be raised at the point of the following call to 
+      -- Create, resulting in a Not_Applicable test result.
+
+      Ada.Text_IO.Create(Data_File, Ada.Text_IO.Out_File, Data_Filename);
+
+   exception
+
+       when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Text_IO" );
+          raise Incomplete;
+
+   end Test_for_IO_Support;
+
+   Test_Block:
+   declare
+      use Ada.Characters.Latin_1, Ada.Strings.Unbounded;
+      TC_Items  : constant := 3;
+
+      -- Declare types and objects that will be used as data values to be
+      -- written to and read from the text file/stream.
+
+      type Enum_Type          is (Red, Yellow, Green, Blue, Indigo);
+      type Fixed_Type         is delta 0.125 range 0.0..255.0;
+      type Float_Type         is digits 7 range 0.0..1.0E5;
+      type Modular_Type       is mod 256;  
+      subtype Str_Type        is String(1..4);
+
+      type Char_Array_Type    is array (1..TC_Items) of Character;
+      type Enum_Array_Type    is array (1..TC_Items) of Enum_Type;
+      type Fixed_Array_Type   is array (1..TC_Items) of Fixed_Type;
+      type Float_Array_Type   is array (1..TC_Items) of Float_Type;
+      type Int_Array_Type     is array (1..TC_Items) of Integer;
+      type Mod_Array_Type     is array (1..TC_Items) of Modular_Type;
+      type Str_Array_Type     is array (1..TC_Items) of Str_Type;
+      type Unb_Str_Array_Type is array (1..TC_Items) of Unbounded_String;
+
+      Char_Array      : Char_Array_Type    := ('A', 'z', Yen_Sign);
+      TC_Char_Array_1,
+      TC_Char_Array_2 : Char_Array_Type    := (others => Space);
+
+      Enum_Array      : Enum_Array_Type    := (Blue, Yellow, Indigo);
+      TC_Enum_Array_1,
+      TC_Enum_Array_2 : Enum_Array_Type    := (others => Red);
+
+      Fix_Array       : Fixed_Array_Type   := (0.125, 123.5, 250.750);
+      TC_Fix_Array_1,
+      TC_Fix_Array_2  : Fixed_Array_Type   := (others => 0.0);
+
+      Flt_Array       : Float_Array_Type   := (1.0, 150.0, 1500.0);
+      TC_Flt_Array_1,
+      TC_Flt_Array_2  : Float_Array_Type   := (others => 0.0);
+
+      Int_Array       : Int_Array_Type     := (124, 2349, -24_001);
+      TC_Int_Array_1,
+      TC_Int_Array_2  : Int_Array_Type     := (others => -99);
+
+      Mod_Array       : Mod_Array_Type     := (10, 127, 255);
+      TC_Mod_Array_1,
+      TC_Mod_Array_2  : Mod_Array_Type     := (others => 0);
+
+      Str_Array       : Str_Array_Type     := ("abcd", "klmn", "wxyz");
+      TC_Str_Array_1,
+      TC_Str_Array_2  : Str_Array_Type     := (others => "    ");
+
+      UStr_Array      : Unb_Str_Array_Type := 
+                                        (To_Unbounded_String("cat"),
+                                         To_Unbounded_String("testing"),
+                                         To_Unbounded_String("ACVC"));
+      TC_UStr_Array_1,
+      TC_UStr_Array_2 : Unb_Str_Array_Type := 
+                                        (others => Null_Unbounded_String);
+
+      -- Create a stream access object pointing to the data file.
+
+      Data_Stream : Ada.Text_IO.Text_Streams.Stream_Access := 
+                      Ada.Text_IO.Text_Streams.Stream(File => Data_File);
+
+   begin
+
+      -- Use the 'Write attribute to enter the three sets of data items
+      -- into the data stream.  
+      -- Note that the data will be mixed within the text file.
+
+      for i in 1..TC_Items loop
+         Character'Write       (Data_Stream, Char_Array(i));
+         Enum_Type'Write       (Data_Stream, Enum_Array(i));
+         Fixed_Type'Write      (Data_Stream, Fix_Array(i));
+         Float_Type'Write      (Data_Stream, Flt_Array(i));
+         Integer'Write         (Data_Stream, Int_Array(i));
+         Modular_Type'Write    (Data_Stream, Mod_Array(i));
+         Str_Type'Write        (Data_Stream, Str_Array(i));
+         Unbounded_String'Write(Data_Stream, UStr_Array(i));
+      end loop;
+
+      -- Use the 'Output attribute to enter the entire arrays of each 
+      -- type of data items into the data stream.  
+      -- Note that the array bounds will be written to the stream as part 
+      -- of the action of the 'Output attribute.
+
+      Char_Array_Type'Output    (Data_Stream, Char_Array);
+      Enum_Array_Type'Output    (Data_Stream, Enum_Array);
+      Fixed_Array_Type'Output   (Data_Stream, Fix_Array);
+      Float_Array_Type'Output   (Data_Stream, Flt_Array);
+      Int_Array_Type'Output     (Data_Stream, Int_Array);
+      Mod_Array_Type'Output     (Data_Stream, Mod_Array);
+      Str_Array_Type'Output     (Data_Stream, Str_Array);
+      Unb_Str_Array_Type'Output (Data_Stream, UStr_Array);
+
+      -- Reset the data file to mode In_File.  The data file will now serve
+      -- as the source of data which will be compared to the original data
+      -- written to the file above.
+      Reset1:
+      begin
+         Ada.Text_IO.Reset (File => Data_File, Mode => Ada.Text_IO.In_File);
+      exception
+         when Ada.Text_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to In_File not supported for Text_IO" );
+            raise Incomplete;
+      end Reset1;
+
+      -- Extract and validate all the single data items from the stream.
+
+      for i in 1..TC_Items loop
+         Character'Read        (Data_Stream, TC_Char_Array_1(i));
+         Enum_Type'Read        (Data_Stream, TC_Enum_Array_1(i));
+         Fixed_Type'Read       (Data_Stream, TC_Fix_Array_1(i));
+         Float_Type'Read       (Data_Stream, TC_Flt_Array_1(i));
+         Integer'Read          (Data_Stream, TC_Int_Array_1(i));
+         Modular_Type'Read     (Data_Stream, TC_Mod_Array_1(i));
+         Str_Type'Read         (Data_Stream, TC_Str_Array_1(i));
+         Unbounded_String'Read (Data_Stream, TC_UStr_Array_1(i));
+      end loop;
+
+      if TC_Char_Array_1 /= Char_Array then
+         Report.Failed("Character values do not match");
+      end if;
+      if TC_Enum_Array_1 /= Enum_Array then
+         Report.Failed("Enumeration values do not match");
+      end if;
+      if TC_Fix_Array_1 /= Fix_Array then
+         Report.Failed("Fixed point values do not match");
+      end if;
+      if TC_Flt_Array_1 /= Flt_Array then
+         Report.Failed("Floating point values do not match");
+      end if;
+      if TC_Int_Array_1 /= Int_Array then
+         Report.Failed("Integer values do not match");
+      end if;
+      if TC_Mod_Array_1 /= Mod_Array then
+         Report.Failed("Modular values do not match");
+      end if;
+      if TC_Str_Array_1 /= Str_Array then
+         Report.Failed("String values do not match");
+      end if;
+      if TC_UStr_Array_1 /= UStr_Array then
+         Report.Failed("Unbounded_String values do not match");
+      end if;
+
+      -- Extract and validate all data arrays from the data stream.
+      -- Note that the 'Input attribute denotes a function, whereas the
+      -- other stream oriented attributes in this test denote procedures.
+
+      TC_Char_Array_2 := Char_Array_Type'Input(Data_Stream);
+      TC_Enum_Array_2 := Enum_Array_Type'Input(Data_Stream);
+      TC_Fix_Array_2  := Fixed_Array_Type'Input(Data_Stream);
+      TC_Flt_Array_2  := Float_Array_Type'Input(Data_Stream);
+      TC_Int_Array_2  := Int_Array_Type'Input(Data_Stream);
+      TC_Mod_Array_2  := Mod_Array_Type'Input(Data_Stream);
+      TC_Str_Array_2  := Str_Array_Type'Input(Data_Stream);
+      TC_UStr_Array_2 := Unb_Str_Array_Type'Input(Data_Stream);
+
+      if TC_Char_Array_2 /= Char_Array then
+         Report.Failed("Character array values do not match");
+      end if;
+      if TC_Enum_Array_2 /= Enum_Array then
+         Report.Failed("Enumeration array values do not match");
+      end if;
+      if TC_Fix_Array_2 /= Fix_Array then
+         Report.Failed("Fixed point array values do not match");
+      end if;
+      if TC_Flt_Array_2 /= Flt_Array then
+         Report.Failed("Floating point array values do not match");
+      end if;
+      if TC_Int_Array_2 /= Int_Array then
+         Report.Failed("Integer array values do not match");
+      end if;
+      if TC_Mod_Array_2 /= Mod_Array then
+         Report.Failed("Modular array values do not match");
+      end if;
+      if TC_Str_Array_2 /= Str_Array then
+         Report.Failed("String array values do not match");
+      end if;
+      if TC_UStr_Array_2 /= UStr_Array then
+         Report.Failed("Unbounded_String array values do not match");
+      end if;
+
+   exception
+      when Incomplete =>
+         raise;
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Deletion:
+   begin
+      -- Delete the data file.
+      if not Ada.Text_IO.Is_Open(Data_File) then
+         Ada.Text_IO.Open(Data_File, Ada.Text_IO.In_File, Data_Filename);
+      end if;
+      Ada.Text_IO.Delete(Data_File);
+
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Text_IO" );
+
+   end Deletion;
+
+   Report.Result;
+
+exception
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXAC004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac005.a
new file mode 100644
index 000000000..34a971f7a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxac005.a
@@ -0,0 +1,343 @@
+-- CXAC005.A
+--
+--                             Grant of Unlimited Rights
+--
+--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
+--     rights in the software and documentation contained herein. Unlimited
+--     rights are the same as those granted by the U.S. Government for older
+--     parts of the Ada Conformity Assessment Test Suite, and are defined
+--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+--     intends to confer upon all recipients unlimited rights equal to those
+--     held by the ACAA. These rights include rights to use, duplicate,
+--     release or disclose the released technical data and computer software
+--     in whole or in part, in any manner and for any purpose whatsoever, and
+--     to have or permit others to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--    Check that stream file positioning work as specified.  (Defect Report
+--    8652/0055).
+--
+-- CHANGE HISTORY:
+--    12 FEB 2001   PHL   Initial version.
+--    14 MAR 2001   RLB   Readied for release; fixed Not_Applicable check
+--                        to terminate test gracefully.
+--
+--!
+with Ada.Streams.Stream_Io;
+use Ada.Streams;
+with Ada.Exceptions;
+use Ada.Exceptions;
+with Report;
+use Report;
+procedure CXAC005 is
+
+    Incomplete : exception;
+
+    procedure TC_Assert (Condition : Boolean; Message : String) is
+    begin
+        if not Condition then
+            Failed (Message);
+        end if;
+    end TC_Assert;
+
+    package Checked_Stream_Io is
+
+        type File_Type (Max_Size : Stream_Element_Count) is limited private;
+        function Stream_Io_File (File : File_Type) return Stream_Io.File_Type;
+
+        procedure Create (File : in out File_Type;
+                          Mode : in Stream_Io.File_Mode := Stream_Io.Out_File;
+                          Name : in String := "";
+                          Form : in String := "");
+
+        procedure Open (File : in out File_Type;
+                        Mode : in Stream_Io.File_Mode;
+                        Name : in String;
+                        Form : in String := "");
+
+        procedure Close (File : in out File_Type);
+        procedure Delete (File : in out File_Type);
+
+        procedure Reset (File : in out File_Type;
+                         Mode : in Stream_Io.File_Mode);
+        procedure Reset (File : in out File_Type);
+
+        procedure Read (File : in out File_Type;
+                        Item : out Stream_Element_Array;
+                        Last : out Stream_Element_Offset;
+                        From : in Stream_Io.Positive_Count);
+
+        procedure Read (File : in out File_Type;
+                        Item : out Stream_Element_Array;
+                        Last : out Stream_Element_Offset);
+
+        procedure Write (File : in out File_Type;
+                         Item : in Stream_Element_Array;
+                         To : in Stream_Io.Positive_Count);
+
+        procedure Write (File : in out File_Type;
+                         Item : in Stream_Element_Array);
+
+        procedure Set_Index (File : in out File_Type;
+                             To : in Stream_Io.Positive_Count);
+
+        function Index (File : in File_Type) return Stream_Io.Positive_Count;
+
+        procedure Set_Mode (File : in out File_Type;
+                            Mode : in Stream_Io.File_Mode);
+
+    private
+        type File_Type (Max_Size : Stream_Element_Count) is
+            record
+                File : Stream_Io.File_Type;
+                Index : Stream_Io.Positive_Count;
+                Contents :
+                   Stream_Element_Array
+                      (Stream_Element_Offset (Ident_Int (1)) .. Max_Size);
+            end record;
+    end Checked_Stream_Io;
+
+    package body Checked_Stream_Io is
+
+        use Stream_Io;
+
+        function Stream_Io_File (File : File_Type) return Stream_Io.File_Type is
+        begin
+            return File.File;
+        end Stream_Io_File;
+
+        procedure Create (File : in out File_Type;
+                          Mode : in Stream_Io.File_Mode := Stream_Io.Out_File;
+                          Name : in String := "";
+                          Form : in String := "") is
+        begin
+            Stream_Io.Create (File.File, Mode, Name, Form);
+            File.Index := Stream_Io.Index (File.File);
+            if Mode = Append_File then
+                TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
+                        "Index /= Size + 1 -- Create - Append_File");
+            else
+                TC_Assert (File.Index = 1, "Index /= 1 -- Create - " &
+                                           File_Mode'Image (Mode));
+            end if;
+        end Create;
+
+        procedure Open (File : in out File_Type;
+                        Mode : in Stream_Io.File_Mode;
+                        Name : in String;
+                        Form : in String := "") is
+        begin
+            Stream_Io.Open (File.File, Mode, Name, Form);
+            File.Index := Stream_Io.Index (File.File);
+            if Mode = Append_File then
+                TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
+                        "Index /= Size + 1 -- Open - Append_File");
+            else
+                TC_Assert (File.Index = 1, "Index /= 1 -- Open - " &
+                                           File_Mode'Image (Mode));
+            end if;
+        end Open;
+
+        procedure Close (File : in out File_Type) is
+        begin
+            Stream_Io.Close (File.File);
+        end Close;
+
+        procedure Delete (File : in out File_Type) is
+        begin
+            Stream_Io.Delete (File.File);
+        end Delete;
+
+        procedure Reset (File : in out File_Type;
+                         Mode : in Stream_Io.File_Mode) is
+        begin
+            Stream_Io.Reset (File.File, Mode);
+            File.Index := Stream_Io.Index (File.File);
+            if Mode = Append_File then
+                TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
+                        "Index /= Size + 1 -- Reset - Append_File");
+            else
+                TC_Assert (File.Index = 1, "Index /= 1 -- Reset - " &
+                                           File_Mode'Image (Mode));
+            end if;
+        end Reset;
+
+        procedure Reset (File : in out File_Type) is
+        begin
+            Reset (File, Stream_Io.Mode (File.File));
+        end Reset;
+
+
+        procedure Read (File : in out File_Type;
+                        Item : out Stream_Element_Array;
+                        Last : out Stream_Element_Offset;
+                        From : in Stream_Io.Positive_Count) is
+        begin
+            Set_Index (File, From);
+            Read (File, Item, Last);
+        end Read;
+
+        procedure Read (File : in out File_Type;
+                        Item : out Stream_Element_Array;
+                        Last : out Stream_Element_Offset) is
+            Index : constant Stream_Element_Offset :=
+               Stream_Element_Offset (File.Index);
+        begin
+            Stream_Io.Read (File.File, Item, Last);
+            if Last < Item'Last then
+                TC_Assert (Item (Item'First .. Last) =
+                        File.Contents (Index .. Index + Last - Item'First),
+                        "Incorrect data read from file - 1");
+                TC_Assert (Count (Index + Last - Item'First) =
+                        Stream_Io.Size (File.File),
+                        "Read stopped before end of file");
+                File.Index := Count (Index + Last - Item'First) + 1;
+            else
+                TC_Assert (Item = File.Contents (Index .. Index + Item'Length - 1),
+                        "Incorrect data read from file - 2");
+                File.Index := File.Index + Item'Length;
+            end if;
+        end Read;
+
+        procedure Write (File : in out File_Type;
+                         Item : in Stream_Element_Array;
+                         To : in Stream_Io.Positive_Count) is
+        begin
+            Set_Index (File, To);
+            Write (File, Item);
+        end Write;
+
+        procedure Write (File : in out File_Type;
+                         Item : in Stream_Element_Array) is
+            Index : constant Stream_Element_Offset :=
+               Stream_Element_Offset (File.Index);
+        begin
+            Stream_Io.Write (File.File, Item);
+            File.Contents (Index .. Index + Item'Length - 1) := Item;
+            File.Index := File.Index + Item'Length;
+            TC_Assert (File.Index = Stream_Io.Index (File.File),
+                    "Write failed to move the index");
+        end Write;
+
+        procedure Set_Index (File : in out File_Type;
+                             To : in Stream_Io.Positive_Count) is
+        begin
+            Stream_Io.Set_Index (File.File, To);
+            File.Index := Stream_Io.Index (File.File);
+            TC_Assert (File.Index = To, "Set_Index failed");
+        end Set_Index;
+
+        function Index (File : in File_Type) return Stream_Io.Positive_Count is
+            New_Index : constant Count := Stream_Io.Index (File.File);
+        begin
+            TC_Assert (New_Index = File.Index, "Index changed unexpectedly");
+            return New_Index;
+        end Index;
+
+        procedure Set_Mode (File : in out File_Type;
+                            Mode : in Stream_Io.File_Mode) is
+            Old_Index : constant Count := File.Index;
+        begin
+            Stream_Io.Set_Mode (File.File, Mode);
+            File.Index := Stream_Io.Index (File.File);
+            if Mode = Append_File then
+                TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
+                        "Index /= Size + 1 -- Set_Mode - Append_File");
+            else
+                TC_Assert (File.Index = Old_Index, "Set_Mode changed the index");
+            end if;
+        end Set_Mode;
+
+    end Checked_Stream_Io;
+
+    package Csio renames Checked_Stream_Io;
+
+    F : Csio.File_Type (100);
+    S : Stream_Element_Array (1 .. 10);
+    Last : Stream_Element_Offset;
+
+begin
+
+    Test ("CXAC005", "Check that stream file positioning work as specified");
+
+    declare
+        Name : constant String := Legal_File_Name;
+    begin
+        begin
+            Csio.Create (F, Name => Name);
+        exception
+            when others =>
+                Not_Applicable ("Files not supported - Creation with Out_File for Stream_IO");
+                raise Incomplete;
+        end;
+
+        for I in Stream_Element range 1 .. 10 loop
+            Csio.Write (F, ((1 => I + 2)));
+        end loop;
+        Csio.Write (F, (1 .. 15 => 11));
+        Csio.Write (F, (1 .. 15 => 12), To => 15);
+
+        Csio.Reset (F);
+
+        for I in Stream_Element range 1 .. 10 loop
+            Csio.Write (F, (1 => I));
+        end loop;
+        Csio.Write (F, (1 .. 15 => 13));
+        Csio.Write (F, (1 .. 15 => 14), To => 15);
+        Csio.Write (F, (1 => 90));
+
+        Csio.Set_Mode (F, Stream_Io.In_File);
+
+        Csio.Read (F, S, Last);
+        Csio.Read (F, S, Last, From => 3);
+        Csio.Read (F, S, Last, From => 28);
+
+        Csio.Set_Mode (F, Stream_Io.Append_File);
+        Csio.Write (F, (1 .. 5 => 88));
+
+        Csio.Close (F);
+
+        Csio.Open (F, Name => Name, Mode => Stream_Io.Append_File);
+        Csio.Write (F, (1 .. 3 => 33));
+
+        Csio.Set_Mode (F, Stream_Io.In_File);
+        Csio.Read (F, S, Last, From => 20);
+        Csio.Read (F, S, Last);
+        Csio.Reset (F, Stream_Io.Out_File);
+
+        Csio.Write (F, (1 .. 9 => 99));
+
+        -- Check the contents of the entire file.
+        declare
+            S : Stream_Element_Array
+                   (1 .. Stream_Element_Offset
+                            (Stream_Io.Size (Csio.Stream_Io_File (F))));
+        begin
+            Csio.Reset (F, Stream_Io.In_File);
+            Csio.Read (F, S, Last);
+        end;
+
+        Csio.Delete (F);
+    end;
+
+    Result;
+exception
+   when Incomplete =>
+      Report.Result;
+   when E:others     =>
+      Report.Failed ("Unexpected exception raised - " & Exception_Name (E) &
+                      " - " & Exception_Message (E));
+      Report.Result;
+
+end CXAC005;
+
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaca01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaca01.a
new file mode 100644
index 000000000..cda8776a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaca01.a
@@ -0,0 +1,291 @@
+-- CXACA01.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 default attributes 'Write and 'Read work properly when 
+--      used with objects of a variety of types, including records with 
+--      default discriminants, records without default discriminants, but 
+--      which have the discriminant described in a representation clause for 
+--      the type, and arrays.
+--
+-- TEST DESCRIPTION:
+--      This test simulates a basic sales record system, using Stream_IO to
+--      allow the storage of heterogeneous data in a single stream file.
+--      
+--      Four types of data are written to the stream file for each product.
+--      First, the "header" information on the product is written.  
+--      This is an object of a discriminated (with default) record
+--      type.  This is followed by an integer object containing a count of
+--      the number of sales data records to follow.  The corresponding number
+--      of sales records follow in the stream.  These are of a record type
+--      with a discriminant without a default, but where the discriminant is
+--      included in the representation clause for the type. Finally, an 
+--      array object with statistical sales information for the product is
+--      written to the stream.
+--      
+--      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.
+--
+-- APPLICABILITY CRITERIA: 
+--      Applicable to all implementations that support external
+--      Stream_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FXACA00;
+with Ada.Streams.Stream_IO;
+with Report;
+
+procedure CXACA01 is
+
+begin
+
+   Report.Test ("CXACA01", "Check that 'Write and 'Read work properly " &
+                           "when used with complex data types");
+
+   Test_for_Stream_IO_Support:
+   declare
+
+      Info_File    : Ada.Streams.Stream_IO.File_Type;
+      Info_Stream  : Ada.Streams.Stream_IO.Stream_Access;
+      The_Filename : constant String := Report.Legal_File_Name;
+
+   begin
+
+      -- If an implementation does not support Stream_IO in a particular
+      -- environment, the exception Use_Error or Name_Error will be raised on 
+      -- calls to various Stream_IO operations.  This block statement 
+      -- encloses a call to Create, which should produce an exception in a 
+      -- non-supportive environment.  These exceptions will be handled to 
+      -- produce a Not_Applicable result.
+
+      Ada.Streams.Stream_IO.Create (Info_File, 
+                                    Ada.Streams.Stream_IO.Out_File,
+                                    The_Filename);
+
+      Operational_Test_Block:
+      declare
+
+      begin
+
+         Info_Stream := Ada.Streams.Stream_IO.Stream (Info_File);
+
+         -- Write all of the product information (record, integer, and array 
+         -- objects) defined in package FXACA00 into the stream.
+
+         Store_Data_Block:
+         begin
+
+            -- Write information about first product to the stream.
+            FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_01);
+            Integer'Write (Info_Stream, FXACA00.Sale_Count_01);
+            FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_01);
+            FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_02);
+            FXACA00.Sales_Statistics_Type'Write 
+              (Info_Stream, FXACA00.Product_01_Stats);
+
+            -- Write information about second product to the stream.
+            -- Note: No Sales_Record_Type objects.
+            FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_02);
+            Integer'Write (Info_Stream, FXACA00.Sale_Count_02);
+            FXACA00.Sales_Statistics_Type'Write  
+              (Info_Stream, FXACA00.Product_02_Stats);
+
+            -- Write information about third product to the stream.
+            FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_03);
+            Integer'Write (Info_Stream, FXACA00.Sale_Count_03);
+            FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_03);
+            FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_04);
+            FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_05);
+            FXACA00.Sales_Statistics_Type'Write  
+              (Info_Stream, FXACA00.Product_03_Stats);
+
+         end Store_Data_Block;
+
+
+         Verify_Data_Block:
+         declare
+
+            use FXACA00;   -- Used within this block only.
+
+            type Domestic_Rec_Array_Type is  
+              array (Positive range <>) of Sales_Record_Type (Domestic);
+
+            type Foreign_Rec_Array_Type is  
+              array (Positive range <>) of Sales_Record_Type (Foreign);
+
+            TC_Rec1 : Domestic_Rec_Array_Type (1..2);
+            TC_Rec3 : Foreign_Rec_Array_Type  (1..3);
+
+            TC_Product1 : Product_Type;
+            TC_Product2, 
+            TC_Product3 : Product_Type (Foreign);
+
+            TC_Count1, 
+            TC_Count2, 
+            TC_Count3   : Integer := -10;  -- Initialized to dummy value.
+
+            TC_Stat1,
+            TC_Stat2,
+            TC_Stat3    : Sales_Statistics_Type := (others => 500);
+
+         begin
+
+            Ada.Streams.Stream_IO.Reset (Info_File, 
+                                         Ada.Streams.Stream_IO.In_File);
+
+            -- Read all of the data that is contained in the stream.
+            -- Compare all data with the original data in package FXACA00 
+            -- that was written to the stream.
+            -- The calls to the read attribute are in anticipated order, based
+            -- on the order of data written to the stream.  Possible errors,
+            -- such as data placement, overwriting, etc., will be manifest as 
+            -- exceptions raised by the attribute during an unsuccessful read 
+            -- attempt.
+
+            -- Extract data on first product.
+            Product_Type'Read          (Info_Stream, TC_Product1);
+            Integer'Read               (Info_Stream, TC_Count1);
+
+            -- Two "domestic" variant sales records will be read from the
+            -- stream.
+            for i in 1 .. TC_Count1 loop
+               Sales_Record_Type'Read     (Info_Stream, TC_Rec1(i) );
+            end loop;
+
+            Sales_Statistics_Type'Read (Info_Stream, TC_Stat1);
+
+
+            -- Extract data on second product.
+            Product_Type'Read          (Info_Stream, TC_Product2);
+            Integer'Read               (Info_Stream, TC_Count2);
+            Sales_Statistics_Type'Read (Info_Stream, TC_Stat2);
+
+
+            -- Extract data on third product.
+            Product_Type'Read          (Info_Stream, TC_Product3);
+            Integer'Read               (Info_Stream, TC_Count3);
+
+            -- Three "foreign" variant sales records will be read from the
+            -- stream.
+            for i in 1 .. TC_Count3 loop
+               Sales_Record_Type'Read     (Info_Stream, TC_Rec3(i) );
+            end loop;
+
+            Sales_Statistics_Type'Read (Info_Stream, TC_Stat3);
+
+
+            -- After all the data has been correctly extracted, the file 
+            -- should be empty.
+
+            if not Ada.Streams.Stream_IO.End_Of_File (Info_File) then
+               Report.Failed ("Stream file not empty");
+            end if;
+
+            -- Verify that the data values read from the stream are the same
+            -- as those written to the stream.
+
+            -- Verify the information of the first product.
+            if ((Product_01             /= TC_Product1)             or else
+                (Product_01.Manufacture /= TC_Product1.Manufacture) or else
+                (Sale_Count_01          /= TC_Count1)               or else
+                (Sale_Rec_01            /= TC_Rec1(1))              or else
+                (Sale_Rec_01.Buyer      /= TC_Rec1(1).Buyer)        or else
+                (Sale_Rec_02            /= TC_Rec1(2))              or else
+                (Sale_Rec_02.Buyer      /= TC_Rec1(2).Buyer)        or else
+                (Product_01_Stats       /= TC_Stat1))   
+            then
+               Report.Failed ("Product 1 information incorrect");
+            end if;
+
+            -- Verify the information of the second product.
+            if not ((Product_02       = TC_Product2) and then
+                    (Sale_Count_02    = TC_Count2)   and then
+                    (Product_02_Stats = TC_Stat2))
+            then
+               Report.Failed ("Product 2 information incorrect");
+            end if;
+
+            -- Verify the information of the third product.
+            if ((Product_03             /= TC_Product3)             or else
+                (Product_03.Manufacture /= TC_Product3.Manufacture) or else
+                (Sale_Count_03          /= TC_Count3)               or else
+                (Sale_Rec_03            /= TC_Rec3(1))              or else
+                (Sale_Rec_03.Buyer      /= TC_Rec3(1).Buyer)        or else
+                (Sale_Rec_04            /= TC_Rec3(2))              or else
+                (Sale_Rec_04.Buyer      /= TC_Rec3(2).Buyer)        or else
+                (Sale_Rec_05            /= TC_Rec3(3))              or else
+                (Sale_Rec_05.Buyer      /= TC_Rec3(3).Buyer)        or else
+                (Product_03_Stats       /= TC_Stat3))   
+            then
+               Report.Failed ("Product 3 information incorrect");
+            end if;
+
+         end Verify_Data_Block;
+
+      exception
+
+         when others => 
+            Report.Failed ("Exception raised in Operational Test Block");
+
+      end Operational_Test_Block;
+
+      if Ada.Streams.Stream_IO.Is_Open (Info_File) then
+         Ada.Streams.Stream_IO.Delete (Info_File);
+      else
+         Ada.Streams.Stream_IO.Open (Info_File,
+                                     Ada.Streams.Stream_IO.In_File, 
+                                     The_Filename);
+         Ada.Streams.Stream_IO.Delete (Info_File);
+      end if;
+
+   exception
+
+      -- Since Use_Error or Name_Error can be raised if, for the specified
+      -- mode, the environment does not support Stream_IO operations,
+      -- the following handlers are included:
+
+      when Ada.Streams.Stream_IO.Name_Error =>
+         Report.Not_Applicable ("Name_Error raised on Stream IO Create");
+
+      when Ada.Streams.Stream_IO.Use_Error  =>
+         Report.Not_Applicable ("Use_Error raised on Stream IO Create");
+
+      when others                           =>
+         Report.Failed ("Unexpected exception raised on Stream IO Create");
+
+   end Test_for_Stream_IO_Support;
+
+   Report.Result;
+
+end CXACA01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaca02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaca02.a
new file mode 100644
index 000000000..5106dd399
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaca02.a
@@ -0,0 +1,360 @@
+-- CXACA02.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 subprograms can override the default
+--      attributes 'Read and 'Write using attribute definition clauses.
+--      Use objects of record types. 
+--
+-- TEST DESCRIPTION:
+--      This test demonstrates that the default implementations of the
+--      'Read and 'Write attributes can be overridden by user specified 
+--      subprograms in conjunction with attribute definition clauses.
+--      These attributes have been overridden below, and in the user defined
+--      substitutes, values are added or subtracted to global variables.
+--      The global variables are evaluated to ensure that the user defined 
+--      subprograms were used in overriding the type-related default 
+--      attributes.
+--      
+-- APPLICABILITY CRITERIA: 
+--      Applicable to all implementations that support external
+--      Stream_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      21 Nov 95   SAIC    Corrected recursive attribute definitions 
+--                          for ACVC 2.0.1.
+--      24 Aug 96   SAIC    Corrected typo in test verification criteria.
+--
+--!
+
+with Report;
+with Ada.Streams.Stream_IO;
+
+procedure CXACA02 is
+begin
+
+   Report.Test ("CXACA02", "Check that user defined subprograms can "   &
+                           "override the default attributes 'Read and " &
+                           "'Write using attribute definition clauses");
+
+   Test_for_Stream_IO_Support:
+   declare
+
+      Data_File      : Ada.Streams.Stream_IO.File_Type;
+      Data_Stream    : Ada.Streams.Stream_IO.Stream_Access;
+      The_Filename   : constant String := Report.Legal_File_Name;
+          
+   begin
+
+      -- If an implementation does not support Stream_IO in a particular
+      -- environment, the exception Use_Error or Name_Error will be raised on 
+      -- calls to various Stream_IO operations.  This block statement 
+      -- encloses a call to Create, which should produce an exception in a 
+      -- non-supportive environment.  These exceptions will be handled to 
+      -- produce a Not_Applicable result.
+
+      Ada.Streams.Stream_IO.Create (Data_File, 
+                                    Ada.Streams.Stream_IO.Out_File,
+                                    The_Filename);
+
+      Operational_Test_Block:
+      declare
+
+         type Origin_Type is (Foreign, Domestic);
+         subtype String_Data_Type is String(1..8);
+
+         type Product_Type is
+            record
+               Item        : String_Data_Type;               
+               ID          : Natural range 1..100;
+               Manufacture : Origin_Type := Domestic;
+               Distributor : String_Data_Type;
+               Importer    : String_Data_Type;
+            end record;
+
+         type Sales_Record_Type is
+            record                                      
+               Name              : String_Data_Type;
+               Sale_Item         : Boolean := False;
+               Buyer             : Origin_Type;
+               Quantity_Discount : Boolean;
+               Cash_Discount     : Boolean;
+            end record;
+
+
+         -- Mode conformant, user defined subprograms that will override 
+         -- the type-related attributes.
+         -- In this test, the user defines these subprograms to add/subtract
+         -- specific values from global variables.
+
+         procedure Product_Read
+           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
+             The_Item : out Product_Type );
+
+         procedure Product_Write
+           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
+             The_Item : Product_Type );
+
+         procedure Sales_Read
+           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
+             The_Item : out Sales_Record_Type );
+
+         procedure Sales_Write
+           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
+             The_Item : Sales_Record_Type );
+
+         -- Attribute definition clauses.
+
+         for Product_Type'Read  use Product_Read;
+         for Product_Type'Write use Product_Write;
+
+         for Sales_Record_Type'Read  use Sales_Read;
+         for Sales_Record_Type'Write use Sales_Write;
+
+
+         -- Object Declarations
+
+         Product_01 : Product_Type := 
+           ("Product1", 1, Domestic, "Distrib1", "Import 1");
+         Product_02 : Product_Type := 
+           ("Product2", 2, Foreign,  "Distrib2", "Import 2");
+
+         Sale_Rec_01 : Sales_Record_Type := 
+           ("Buyer 01", False, Domestic, True, True);
+         Sale_Rec_02 : Sales_Record_Type := 
+           ("Buyer 02", True,  Domestic, True, False);
+         Sale_Rec_03 : Sales_Record_Type := (Name              => "Buyer 03", 
+                                             Sale_Item         => True, 
+                                             Buyer             => Foreign,  
+                                             Quantity_Discount => False, 
+                                             Cash_Discount     => True);
+         Sale_Rec_04 : Sales_Record_Type := 
+           ("Buyer 04", True,  Foreign,  False, False);
+         Sale_Rec_05 : Sales_Record_Type := 
+           ("Buyer 05", False, Foreign,  False, False);
+
+         TC_Read_Total  : Integer := 100;
+         TC_Write_Total : Integer :=   0;
+
+
+         -- Subprogram bodies.
+         -- These subprograms are designed to override the default attributes
+         -- 'Read and 'Write for the specified types.  Each adds/subtracts
+         -- a quantity to/from a program control variable, indicating its
+         -- activity.   In addition, each component of the record is
+         -- individually read from or written to the stream, using the 
+         -- appropriate 'Read or 'Write attribute for the component type.
+         -- The string components are moved to/from the stream using the
+         -- 'Input and 'Output attributes for the string subtype, so that
+         -- the bounds of the strings are also written/read.
+
+         procedure Product_Read
+           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
+             The_Item : out Product_Type ) is
+         begin
+            TC_Read_Total := TC_Read_Total - 10;
+
+            The_Item.Item := String_Data_Type'Input(Data_Stream); -- Field 1.
+            Natural'Read(Data_Stream, The_Item.ID);               -- Field 2.
+            Origin_Type'Read(Data_Stream,                         -- Field 3.
+                             The_Item.Manufacture);        
+            The_Item.Distributor :=                               -- Field 4.
+              String_Data_Type'Input(Data_Stream);
+            The_Item.Importer    :=                               -- Field 5.  
+              String_Data_Type'Input(Data_Stream);
+         end Product_Read;
+
+
+         procedure Product_Write
+           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
+             The_Item : Product_Type ) is
+         begin
+            TC_Write_Total := TC_Write_Total + 5;
+
+            String_Data_Type'Output(Data_Stream, The_Item.Item);  -- Field 1.
+            Natural'Write(Data_Stream, The_Item.ID);              -- Field 2.
+            Origin_Type'Write(Data_Stream,                        -- Field 3.
+                             The_Item.Manufacture);        
+            String_Data_Type'Output(Data_Stream,                  -- Field 4.
+                                    The_Item.Distributor);
+            String_Data_Type'Output(Data_Stream,                  -- Field 5.
+                                    The_Item.Importer);
+         end Product_Write;
+
+
+         procedure Sales_Read
+           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
+             The_Item : out Sales_Record_Type ) is
+         begin
+            TC_Read_Total := TC_Read_Total - 20;
+
+            The_Item.Name := String_Data_Type'Input(Data_Stream);  -- Field 1.
+            Boolean'Read(Data_Stream, The_Item.Sale_Item);         -- Field 2.
+            Origin_Type'Read(Data_Stream, The_Item.Buyer);         -- Field 3.
+            Boolean'Read(Data_Stream, The_Item.Quantity_Discount); -- Field 4.
+            Boolean'Read(Data_Stream, The_Item.Cash_Discount);     -- Field 5.
+         end Sales_Read;
+
+
+         procedure Sales_Write
+           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
+             The_Item : Sales_Record_Type ) is
+         begin
+            TC_Write_Total := TC_Write_Total + 10;
+
+            String_Data_Type'Output(Data_Stream, The_Item.Name);    -- Field 1.
+            Boolean'Write(Data_Stream, The_Item.Sale_Item);         -- Field 2.
+            Origin_Type'Write(Data_Stream, The_Item.Buyer);         -- Field 3.
+            Boolean'Write(Data_Stream, The_Item.Quantity_Discount); -- Field 4.
+            Boolean'Write(Data_Stream, The_Item.Cash_Discount);     -- Field 5.
+         end Sales_Write;
+
+
+
+      begin
+
+         Data_Stream := Ada.Streams.Stream_IO.Stream (Data_File);
+
+         -- Write product and sales data to the stream.
+
+         Product_Type'Write      (Data_Stream, Product_01);
+         Sales_Record_Type'Write (Data_Stream, Sale_Rec_01);
+         Sales_Record_Type'Write (Data_Stream, Sale_Rec_02);
+
+         Product_Type'Write      (Data_Stream, Product_02);
+         Sales_Record_Type'Write (Data_Stream, Sale_Rec_03);
+         Sales_Record_Type'Write (Data_Stream, Sale_Rec_04);
+         Sales_Record_Type'Write (Data_Stream, Sale_Rec_05);
+
+         -- Read data from the stream, and verify the use of the user specified
+         -- attributes.
+
+         Verify_Data_Block:
+         declare
+
+            TC_Product1,
+            TC_Product2 : Product_Type;
+
+            TC_Sale1, 
+            TC_Sale2,
+            TC_Sale3,
+            TC_Sale4,
+            TC_Sale5    : Sales_Record_Type;
+
+         begin
+
+            -- Reset the mode of the stream file so that Read/Input
+            -- operations may be performed.
+
+            Ada.Streams.Stream_IO.Reset (Data_File, 
+                                         Ada.Streams.Stream_IO.In_File);
+
+            -- Data is read/reconstructed from the stream, in the order that
+            -- the data was placed into the stream.
+
+            Product_Type'Read      (Data_Stream, TC_Product1);
+            Sales_Record_Type'Read (Data_Stream, TC_Sale1);
+            Sales_Record_Type'Read (Data_Stream, TC_Sale2);
+
+            Product_Type'Read      (Data_Stream, TC_Product2);
+            Sales_Record_Type'Read (Data_Stream, TC_Sale3);
+            Sales_Record_Type'Read (Data_Stream, TC_Sale4);
+            Sales_Record_Type'Read (Data_Stream, TC_Sale5);
+
+            -- Verify product data was correctly written to/read from stream.
+
+            if TC_Product1 /= Product_01 then
+               Report.Failed ("Data verification error, Product 1");
+            end if;
+            if TC_Product2 /= Product_02 then
+               Report.Failed ("Data verification error, Product 2");
+            end if;
+
+            if TC_Sale1 /= Sale_Rec_01 then
+               Report.Failed ("Data verification error, Sale_Rec_01");
+            end if;
+            if TC_Sale2 /= Sale_Rec_02 then
+               Report.Failed ("Data verification error, Sale_Rec_02");
+            end if;
+            if TC_Sale3 /= Sale_Rec_03 then
+               Report.Failed ("Data verification error, Sale_Rec_03");
+            end if;
+            if TC_Sale4 /= Sale_Rec_04 then
+               Report.Failed ("Data verification error, Sale_Rec_04");
+            end if;
+            if TC_Sale5 /= Sale_Rec_05 then
+               Report.Failed ("Data verification error, Sale_Rec_05");
+            end if;
+
+            -- Verify that the user defined subprograms were used to
+            -- override the default 'Read and 'Write attributes.
+            -- There were two "product" reads and two writes; there 
+            -- were five "sale record" reads and five writes.
+            
+            if (TC_Read_Total /= -20) or (TC_Write_Total /= 60) then
+               Report.Failed ("Incorrect use of user defined attributes");
+            end if;
+
+         end Verify_Data_Block;
+
+      exception
+
+         when others => 
+            Report.Failed ("Exception raised in Operational Test Block");
+      
+      end Operational_Test_Block;
+
+      if Ada.Streams.Stream_IO.Is_Open (Data_File) then
+         Ada.Streams.Stream_IO.Delete (Data_File);
+      else
+         Ada.Streams.Stream_IO.Open (Data_File,
+                                     Ada.Streams.Stream_IO.Out_File, 
+                                     The_Filename);
+         Ada.Streams.Stream_IO.Delete (Data_File);
+      end if;
+
+
+   exception
+
+      -- Since Use_Error or Name_Error can be raised if, for the specified
+      -- mode, the environment does not support Stream_IO operations,
+      -- the following handlers are included:
+
+      when Ada.Streams.Stream_IO.Name_Error =>
+         Report.Not_Applicable ("Name_Error raised on Stream IO Create");
+
+      when Ada.Streams.Stream_IO.Use_Error  =>
+         Report.Not_Applicable ("Use_Error raised on Stream IO Create");
+
+      when others                           =>
+         Report.Failed ("Unexpected exception raised");
+
+   end Test_for_Stream_IO_Support;
+
+   Report.Result;
+
+end CXACA02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxacb01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxacb01.a
new file mode 100644
index 000000000..ac4a905e8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxacb01.a
@@ -0,0 +1,264 @@
+-- CXACB01.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 default attributes 'Input and 'Output work properly when 
+--      used with objects of a variety of types, including two-dimensional 
+--      arrays and records without default discriminants.
+--
+-- TEST DESCRIPTION:
+--      This test simulates utility company service record storage, using 
+--      Stream_IO to allow the storage of heterogeneous data in a single 
+--      stream file.
+--      
+--      Three types of data are written to the stream file for each utility
+--      service customer.
+--      First, the general information on the customer is written.  
+--      This is an object of a discriminated (without default) record
+--      type.  This is followed by an integer object containing a count of
+--      the number of service months for the customer. Finally, a
+--      two-dimensional array object with monthly consumption information for 
+--      the customer is written to the stream.
+--      
+--      Objects of record types with discriminants without defaults should
+--      have their discriminants included in the stream when using 'Output. 
+--      Likewise, discriminants should be extracted 
+--      from the stream when using 'Input. Similarly, array bounds are written
+--      to and read from the stream when using 'Output and 'Input with array
+--      objects.
+--
+-- APPLICABILITY CRITERIA: 
+--      Applicable to all implementations that support external
+--      Stream_IO files.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FXACB00;
+with Ada.Streams.Stream_IO;
+with Report;
+
+procedure CXACB01 is
+begin
+
+   Report.Test ("CXACB01", "Check that the default attributes 'Input and " &
+                           "'Output work properly when used with objects " &
+                           "of record, natural, and array types" );
+
+   Test_for_Stream_IO_Support:
+   declare
+
+      Util_File                : Ada.Streams.Stream_IO.File_Type;
+      Util_Stream              : Ada.Streams.Stream_IO.Stream_Access;
+      Utility_Service_Filename : constant String := Report.Legal_File_Name;
+
+   begin
+
+      -- If an implementation does not support Stream_IO in a particular
+      -- environment, the exception Use_Error or Name_Error will be raised on 
+      -- calls to various Stream_IO operations.  This block statement 
+      -- encloses a call to Create, which should produce an exception in a 
+      -- non-supportive environment.  These exceptions will be handled to 
+      -- produce a Not_Applicable result.
+
+      Ada.Streams.Stream_IO.Create (Util_File, 
+                                    Ada.Streams.Stream_IO.Out_File,
+                                    Utility_Service_Filename);
+
+      Operational_Test_Block:
+      declare
+
+         -- The following procedure will store all of the customer specific
+         -- information into the stream.
+
+         procedure Store_Data_In_Stream
+           (Customer : in FXACB00.Service_Type;
+            Months   : in FXACB00.Months_In_Service_Type;
+            History  : in FXACB00.Service_History_Type) is
+         begin
+            FXACB00.Service_Type'Output           (Util_Stream, Customer);
+            FXACB00.Months_In_Service_Type'Output (Util_Stream, Months);
+            FXACB00.Service_History_Type'Output   (Util_Stream, History);
+         end Store_Data_In_Stream;
+
+
+         -- The following procedure will remove from the stream all of the 
+         -- customer related information.
+
+         procedure Retrieve_Data_From_Stream
+           (Customer : out FXACB00.Service_Type;
+            Months   : out FXACB00.Months_In_Service_Type;
+            History  : out FXACB00.Service_History_Type) is
+         begin
+            Customer := FXACB00.Service_Type'Input           (Util_Stream);
+            Months   := FXACB00.Months_In_Service_Type'Input (Util_Stream);
+            History  := FXACB00.Service_History_Type'Input   (Util_Stream);
+         end Retrieve_Data_From_Stream;
+
+
+      begin
+
+         Util_Stream := Ada.Streams.Stream_IO.Stream (Util_File);
+
+         -- Write all of the customer service information (record, numeric,
+         -- and array objects) defined in package FXACB00 into the stream.
+
+         Data_Storage_Block:
+         begin
+
+            Store_Data_In_Stream (Customer => FXACB00.Customer1,
+                                  Months   => FXACB00.C1_Months,
+                                  History  => FXACB00.C1_Service_History);
+
+            Store_Data_In_Stream (FXACB00.Customer2, 
+                                  FXACB00.C2_Months, 
+                                  History  => FXACB00.C2_Service_History);
+
+            Store_Data_In_Stream (Months   => FXACB00.C3_Months,
+                                  History  => FXACB00.C3_Service_History,
+                                  Customer => FXACB00.Customer3);
+         end Data_Storage_Block;
+
+
+         Data_Verification_Block:
+         declare
+
+            TC_Residence  : FXACB00.Service_Type (FXACB00.Residence);
+            TC_Apartment  : FXACB00.Service_Type (FXACB00.Apartment);
+            TC_Commercial : FXACB00.Service_Type (FXACB00.Commercial);
+
+
+            TC_Months1, 
+            TC_Months2, 
+            TC_Months3    : FXACB00.Months_In_Service_Type :=
+                              FXACB00.Months_In_Service_Type'First; 
+
+
+            TC_History1   : 
+              FXACB00.Service_History_Type (FXACB00.Quarterly_Period_Type,
+                                            FXACB00.Month_In_Quarter_Type) :=
+              (others => (others => FXACB00.Electric_Usage_Type'Last));
+
+            TC_History2   :
+              FXACB00.Service_History_Type 
+                (FXACB00.Quarterly_Period_Type range 
+                   FXACB00.Spring .. FXACB00.Summer,
+                 FXACB00.Month_In_Quarter_Type) :=
+              (others => (others => FXACB00.Electric_Usage_Type'Last));
+
+            TC_History3   :
+              FXACB00.Service_History_Type (FXACB00.Quarterly_Period_Type,
+                                            FXACB00.Month_In_Quarter_Type) :=
+              (others => (others => FXACB00.Electric_Usage_Type'Last));
+
+         begin
+
+            Ada.Streams.Stream_IO.Reset (Util_File, 
+                                         Ada.Streams.Stream_IO.In_File);
+
+            -- Input all of the data that is contained in the stream.
+            -- Compare all data with the original data in package FXACB00 
+            -- that was written to the stream.
+
+            Retrieve_Data_From_Stream (TC_Residence, TC_Months1, TC_History1);
+            Retrieve_Data_From_Stream (TC_Apartment, TC_Months2, TC_History2);
+            Retrieve_Data_From_Stream (Customer => TC_Commercial, 
+                                       Months   => TC_Months3, 
+                                       History  => TC_History3);
+
+            -- After all the data has been correctly extracted, the file 
+            -- should be empty.
+
+            if not Ada.Streams.Stream_IO.End_Of_File (Util_File) then
+               Report.Failed ("Stream file not empty");
+            end if;
+
+            -- Verify that the data values read from the stream are the same
+            -- as those written to the stream.
+
+            if ((FXACB00."/="(FXACB00.Customer1, TC_Residence)) or else
+                (FXACB00."/="(FXACB00.Customer2, TC_Apartment)) or else
+                (FXACB00."/="(FXACB00.Customer3, TC_Commercial)))
+            then
+               Report.Failed ("Customer information incorrect");
+            end if;
+
+            if ((FXACB00."/="(FXACB00.C1_Months, TC_Months1)) or
+                (FXACB00."/="(FXACB00.C2_Months, TC_Months2)) or
+                (FXACB00."/="(FXACB00.C3_Months, TC_Months3))) 
+            then
+               Report.Failed ("Number of Months information incorrect");
+            end if;
+
+            if not ((FXACB00."="(FXACB00.C1_Service_History, TC_History1)) and
+                    (FXACB00."="(FXACB00.C2_Service_History, TC_History2)) and 
+                    (FXACB00."="(FXACB00.C3_Service_History, TC_History3)))
+            then
+               Report.Failed ("Service history information incorrect");
+            end if;
+
+         end Data_Verification_Block;
+
+      exception
+
+         when others => 
+            Report.Failed ("Exception raised in Operational Test Block");
+
+      end Operational_Test_Block;
+
+      -- Delete the file.
+      if Ada.Streams.Stream_IO.Is_Open (Util_File) then
+         Ada.Streams.Stream_IO.Delete (Util_File);
+      else
+         Ada.Streams.Stream_IO.Open (Util_File,
+                                     Ada.Streams.Stream_IO.Out_File, 
+                                     Utility_Service_Filename);
+         Ada.Streams.Stream_IO.Delete (Util_File);
+      end if;
+
+
+   exception
+
+      -- Since Use_Error or Name_Error can be raised if, for the specified
+      -- mode, the environment does not support Stream_IO operations,
+      -- the following handlers are included:
+
+      when Ada.Streams.Stream_IO.Name_Error =>
+         Report.Not_Applicable ("Name_Error raised on Stream IO Create");
+
+      when Ada.Streams.Stream_IO.Use_Error  =>
+         Report.Not_Applicable ("Use_Error raised on Stream IO Create");
+
+      when others                           =>
+         Report.Failed ("Unexpected exception raised");
+
+   end Test_for_Stream_IO_Support;
+
+   Report.Result;
+
+end CXACB01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a
new file mode 100644
index 000000000..a0ade9ebe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxacb02.a
@@ -0,0 +1,421 @@
+-- CXACB02.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 subprograms can override the default
+--      attributes 'Input and 'Output using attribute definition clauses,
+--      when used with objects of discriminated record and multi-dimensional
+--      array types.
+--
+-- TEST DESCRIPTION:
+--      This test demonstrates that the default implementations of the
+--      'Input and 'Output attributes can be overridden by user specified 
+--      subprograms in conjunction with attribute definition clauses.
+--      These attributes have been overridden below, and in the user defined
+--      substitutes, values are added or subtracted to global variables.
+--      Following the completion of the writing/reading test, the global
+--      variables are evaluated to ensure that the user defined subprograms
+--      were used in overriding the type-related default attributes.
+--      
+-- APPLICABILITY CRITERIA: 
+--      Applicable to all implementations that support external
+--      Stream_IO files.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      14 Nov 95   SAIC    Corrected test errors for ACVC 2.0.1.
+--
+--!
+
+with Report;
+with Ada.Streams.Stream_IO;
+
+procedure CXACB02 is
+begin
+
+   Report.Test ("CXACB02", "Check that user defined subprograms can "    &
+                           "override the default attributes 'Input and " &
+                           "'Output using attribute definition clauses");
+
+   Test_for_Stream_IO_Support:
+   declare
+
+      Util_File        : Ada.Streams.Stream_IO.File_Type;
+      Util_Stream      : Ada.Streams.Stream_IO.Stream_Access;
+      Utility_Filename : constant String := Report.Legal_File_Name;
+
+   begin
+
+      -- If an implementation does not support Stream_IO in a particular
+      -- environment, the exception Use_Error or Name_Error will be raised on 
+      -- calls to various Stream_IO operations.  This block statement 
+      -- encloses a call to Create, which should produce an exception in a 
+      -- non-supportive environment.  These exceptions will be handled to 
+      -- produce a Not_Applicable result.
+
+      Ada.Streams.Stream_IO.Create (Util_File, 
+                                    Ada.Streams.Stream_IO.Out_File,
+                                    Utility_Filename);
+
+      Operational_Test_Block:
+      declare
+
+         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;
+
+
+         -- Mode conformant, user defined subprograms that will override 
+         -- the type-related attributes.
+         -- In this test, the user defines these subprograms to add/subtract
+         -- specific values from global variables.
+
+         function Service_Input 
+           (Stream : access Ada.Streams.Root_Stream_Type'Class) 
+           return Service_Type;
+
+         procedure Service_Output 
+           (Stream : access Ada.Streams.Root_Stream_Type'Class;
+            Item   : Service_Type);
+
+         function History_Input 
+           (Stream : access Ada.Streams.Root_Stream_Type'Class)
+           return Service_History_Type;
+
+         procedure History_Output
+           (Stream : access Ada.Streams.Root_Stream_Type'Class;
+            Item   : Service_History_Type);
+
+
+         -- Attribute definition clauses.
+
+         for Service_Type'Input  use Service_Input;
+         for Service_Type'Output use Service_Output;
+
+         for Service_History_Type'Input  use History_Input;
+         for Service_History_Type'Output use History_Output;
+
+
+         -- 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_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));
+
+   
+         TC_Input_Total  : Integer := 0;
+         TC_Output_Total : Integer := 0;
+
+
+         -- Subprogram bodies.
+         -- These subprograms are designed to override the default attributes
+         -- 'Input and 'Output for the specified types.  Each adds/subtracts
+         -- a quantity to/from a program control variable, indicating its
+         -- activity.  Each user defined "Input" function uses the 'Read
+         -- attribute for the type to accomplish the operation.  Likewise, 
+         -- each user defined "Output" subprogram uses the 'Write attribute 
+         -- for the type.
+
+         function Service_Input
+           ( Stream : access Ada.Streams.Root_Stream_Type'Class )
+           return Service_Type is
+            Customer : Customer_Type;
+         begin
+            TC_Input_Total := TC_Input_Total + 1;
+
+            -- Extract the discriminant value from the stream.
+            -- This discriminant would not otherwise be extracted from the
+            -- stream when the Service_Type'Read attribute is used below.
+            Customer_Type'Read (Stream, Customer);
+
+            declare
+               -- Declare a constant of Service_Type, using the value just
+               -- read from the stream as the discriminant value of the
+               -- object.
+               Service : Service_Type(Customer);
+            begin
+               Service_Type'Read (Stream, Service);
+               return Service;
+            end;
+         end Service_Input;
+
+
+        procedure Service_Output
+           ( Stream : access Ada.Streams.Root_Stream_Type'Class;
+             Item   : Service_Type ) is
+         begin
+            TC_Output_Total := TC_Output_Total + 2;
+            -- Write the discriminant value to the stream.
+            -- The attribute 'Write (for the record type) will not write the 
+            -- discriminant of the record object to the stream.  Therefore, it
+            -- must be explicitly written using the 'Write attribute of the
+            -- discriminant type.
+            Customer_Type'Write (Stream, Item.Customer);
+            -- Write the record component values (but not the discriminant) to 
+            -- the stream.
+            Service_Type'Write (Stream, Item);
+         end Service_Output;
+
+
+         function History_Input
+           ( Stream : access Ada.Streams.Root_Stream_Type'Class )
+           return Service_History_Type is
+           Quarter_Bound_Low  : Quarterly_Period_Type;
+           Quarter_Bound_High : Quarterly_Period_Type;
+           Month_Bound_Low    : Month_In_Quarter_Type;
+           Month_Bound_High   : Month_In_Quarter_Type;
+         begin
+            TC_Input_Total := TC_Input_Total + 3;
+
+            -- Read the value of the array bounds from the stream.
+            -- Use these bounds in the creation of an array object that will
+            -- be used to store data from the stream.
+            -- The array bound values would not otherwise be read from the 
+            -- stream by use of the Service_History_Type'Read attribute.
+            Quarterly_Period_Type'Read (Stream, Quarter_Bound_Low);
+            Quarterly_Period_Type'Read (Stream, Quarter_Bound_High);
+            Month_In_Quarter_Type'Read (Stream, Month_Bound_Low);
+            Month_In_Quarter_Type'Read (Stream, Month_Bound_High);
+
+            declare
+               Service_History_Array : 
+                 Service_History_Type 
+                 (Quarterly_Period_Type range
+                    Quarter_Bound_Low..Quarter_Bound_High, 
+                  Month_In_Quarter_Type range
+                    Month_Bound_Low .. Month_Bound_High);
+            begin
+               Service_History_Type'Read (Stream, Service_History_Array);
+               return Service_History_Array;
+            end;
+         end History_Input;
+
+
+         procedure History_Output
+           ( Stream : access Ada.Streams.Root_Stream_Type'Class;
+             Item   : Service_History_Type ) is
+         begin
+            TC_Output_Total := TC_Output_Total + 7;
+            -- Write the upper/lower bounds of the array object dimensions to 
+            -- the stream.
+            Quarterly_Period_Type'Write (Stream, Item'First(1));
+            Quarterly_Period_Type'Write (Stream, Item'Last(1));
+            Month_In_Quarter_Type'Write (Stream, Item'First(2));
+            Month_In_Quarter_Type'Write (Stream, Item'Last(2));
+            -- Write the array values to the stream in canonical order (last
+            -- dimension varying fastest).
+            Service_History_Type'Write (Stream, Item);
+         end History_Output;
+
+
+
+      begin
+
+         Util_Stream := Ada.Streams.Stream_IO.Stream (Util_File);
+
+         -- Write data to the stream. A customer service record is followed 
+         -- by a service history array.
+
+         Service_Type'Output (Util_Stream, Customer1);
+         Service_History_Type'Output (Util_Stream, C1_Service_History);
+
+         Service_Type'Output (Util_Stream, Customer2);
+         Service_History_Type'Output (Util_Stream, C2_Service_History);
+
+         Service_Type'Output (Util_Stream, Customer3);
+         Service_History_Type'Output (Util_Stream, C3_Service_History);
+
+
+         -- Read data from the stream, and verify the use of the user specified
+         -- attributes.
+
+         Verify_Data_Block:
+         declare
+
+            TC_Residence  : Service_Type (Residence);
+            TC_Apartment  : Service_Type (Apartment);
+            TC_Commercial : Service_Type (Commercial);
+
+            TC_History1   : Service_History_Type (Quarterly_Period_Type, 
+                                                  Month_In_Quarter_Type) :=
+              (others => (others => Electric_Usage_Type'First));
+
+            TC_History2   : Service_History_Type (Quarterly_Period_Type 
+                                                    range Spring .. Summer,
+                                                  Month_In_Quarter_Type) :=
+              (others => (others => Electric_Usage_Type'First));
+
+            TC_History3   : Service_History_Type (Quarterly_Period_Type,
+                                                  Month_In_Quarter_Type) :=
+              (others => (others => Electric_Usage_Type'First));
+
+         begin
+
+            -- Reset Stream file to mode In_File.
+
+            Ada.Streams.Stream_IO.Reset (Util_File, 
+                                         Ada.Streams.Stream_IO.In_File);
+
+            -- Read data from the stream.
+
+            TC_Residence  := Service_Type'Input (Util_Stream);
+            TC_History1   := Service_History_Type'Input (Util_Stream);
+
+            TC_Apartment  := Service_Type'Input (Util_Stream);
+            TC_History2   := Service_History_Type'Input (Util_Stream);
+
+            TC_Commercial := Service_Type'Input (Util_Stream);
+            TC_History3   := Service_History_Type'Input (Util_Stream);
+
+
+            -- Verify product data was correctly written to/read from stream,
+            -- including discriminants and array bounds.
+
+            if (TC_Residence          /= Customer1)                   or
+               (TC_Residence.Customer /= Customer1.Customer)          or 
+               (TC_History1'Last(1)   /= C1_Service_History'Last(1))  or
+               (TC_History1'First(1)  /= C1_Service_History'First(1)) or
+               (TC_History1'Last(2)   /= C1_Service_History'Last(2))  or
+               (TC_History1'First(2)  /= C1_Service_History'First(2)) 
+            then
+               Report.Failed ("Incorrect data from stream - 1");
+            end if;
+
+            if (TC_Apartment          /= Customer2)                   or
+               (TC_Apartment.Customer /= Customer2.Customer)          or 
+               (TC_History2           /= C2_Service_History)          or
+               (TC_History2'Last(1)   /= C2_Service_History'Last(1))  or
+               (TC_History2'First(1)  /= C2_Service_History'First(1)) or
+               (TC_History2'Last(2)   /= C2_Service_History'Last(2))  or
+               (TC_History2'First(2)  /= C2_Service_History'First(2)) 
+            then
+               Report.Failed ("Incorrect data from stream - 2");
+            end if;
+
+            if (TC_Commercial          /= Customer3)                   or
+               (TC_Commercial.Customer /= Customer3.Customer)          or 
+               (TC_History3            /= C3_Service_History)          or
+               (TC_History3'Last(1)    /= C3_Service_History'Last(1))  or
+               (TC_History3'First(1)   /= C3_Service_History'First(1)) or
+               (TC_History3'Last(2)    /= C3_Service_History'Last(2))  or
+               (TC_History3'First(2)   /= C3_Service_History'First(2)) 
+            then
+               Report.Failed ("Incorrect data from stream - 3");
+            end if;
+
+            -- Verify that the user defined subprograms were used to override
+            -- the default 'Input and 'Output attributes.
+            -- There were three calls on each of the user defined attributes.
+            
+            if (TC_Input_Total /= 12 ) or (TC_Output_Total /= 27 ) then
+               Report.Failed ("Incorrect use of user defined attributes");
+            end if;
+
+         end Verify_Data_Block;
+
+      exception
+
+         when others => 
+            Report.Failed ("Exception raised in Operational Test Block");
+
+      end Operational_Test_Block;
+
+      if Ada.Streams.Stream_IO.Is_Open (Util_File) then
+         Ada.Streams.Stream_IO.Delete (Util_File);
+      else
+         Ada.Streams.Stream_IO.Open (Util_File,
+                                     Ada.Streams.Stream_IO.Out_File, 
+                                     Utility_Filename);
+         Ada.Streams.Stream_IO.Delete (Util_File);
+      end if;
+
+
+   exception
+
+      -- Since Use_Error or Name_Error can be raised if, for the specified
+      -- mode, the environment does not support Stream_IO operations,
+      -- the following handlers are included:
+
+      when Ada.Streams.Stream_IO.Name_Error =>
+         Report.Not_Applicable ("Name_Error raised on Stream IO Create");
+
+      when Ada.Streams.Stream_IO.Use_Error  =>
+         Report.Not_Applicable ("Use_Error raised on Stream IO Create");
+
+      when others                           =>
+         Report.Failed ("Unexpected exception raised");
+
+   end Test_for_Stream_IO_Support;
+
+   Report.Result;
+
+end CXACB02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxacc01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxacc01.a
new file mode 100644
index 000000000..3ab88f40e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxacc01.a
@@ -0,0 +1,299 @@
+-- CXACC01.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 use of 'Class'Output and 'Class'Input allow stream 
+--      manipulation of objects of non-limited class-wide types.
+--
+-- TEST DESCRIPTION:
+--      This test demonstrates the uses of 'Class'Output and 'Class'Input
+--      in moving objects of a particular class to and from a stream file.
+--      A procedure uses a class-wide parameter to move objects of specific 
+--      types in the class to the stream, using the 'Class'Output attribute 
+--      of the root type of the class.  A function returns a class-wide object, 
+--      using the 'Class'Input attribute of the root type of the class to 
+--      extract the object from the stream.
+--      A field-by-field comparison of record objects is performed to validate
+--      the data read from the stream.  Operator precedence rules are used
+--      in the comparison rather than parentheses.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations capable of supporting
+--      external Stream_IO files.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      14 Nov 95   SAIC    Corrected prefix of 'Tag attribute for ACVC 2.0.1.
+--      24 Aug 96   SAIC    Changed a call to "Create" to "Reset".
+--      26 Feb 97   CTA.PWB Allowed for non-support of some IO operations.
+--!
+
+with FXACC00, Ada.Streams.Stream_IO, Ada.Tags, Report;
+
+procedure CXACC01 is
+
+   Order_File     : Ada.Streams.Stream_IO.File_Type;
+   Order_Stream   : Ada.Streams.Stream_IO.Stream_Access;
+   Order_Filename : constant String := 
+                           Report.Legal_File_Name ( Nam => "CXACC01" );
+   Incomplete : exception;
+
+begin
+
+   Report.Test ("CXACC01", "Check that the use of 'Class'Output "        &
+                           "and 'Class'Input allow stream manipulation " &
+                           "of objects of non-limited class-wide types");
+
+   Test_for_Stream_IO_Support:
+   begin
+
+      -- If an implementation does not support Stream_IO in a particular
+      -- environment, the exception Use_Error or Name_Error will be raised on 
+      -- calls to various Stream_IO operations.  This block statement 
+      -- encloses a call to Create, which should produce an exception in a 
+      -- non-supportive environment.  These exceptions will be handled to 
+      -- produce a Not_Applicable result.
+
+      Ada.Streams.Stream_IO.Create (Order_File, 
+                                    Ada.Streams.Stream_IO.Out_File,
+                                    Order_Filename);
+
+   exception
+
+       when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error =>
+          Report.Not_Applicable
+             ( "Files not supported - Create as Out_File for Stream_IO" );
+          raise Incomplete;
+
+   end Test_for_Stream_IO_Support;
+
+   Operational_Test_Block:
+   declare
+
+      -- Store tag values associated with objects of tagged types.
+
+      TC_Box_Office_Tag : constant String :=
+        Ada.Tags.External_Tag(FXACC00.Ticket_Request'Tag);
+
+      TC_Summer_Tag     : constant String :=
+        Ada.Tags.External_Tag(FXACC00.Subscriber_Request'Tag);
+
+      TC_Mayoral_Tag    : constant String :=
+        Ada.Tags.External_Tag(FXACC00.VIP_Request'Tag);
+
+      TC_Late_Tag       : constant String :=
+        Ada.Tags.External_Tag(FXACC00.Last_Minute_Request'Tag);
+
+         -- The following procedure will take an object of the Ticket_Request
+         -- class and output it to the stream.  Objects of any extended type
+         -- in the class can be output to the stream with this procedure.
+
+      procedure Order_Entry (Order : FXACC00.Ticket_Request'Class) is
+      begin
+         FXACC00.Ticket_Request'Class'Output (Order_Stream, Order);
+      end Order_Entry;
+
+
+      -- The following function will retrieve from the stream an object of
+      -- the Ticket_Request class.
+
+      function Order_Retrieval return FXACC00.Ticket_Request'Class is
+      begin
+         return FXACC00.Ticket_Request'Class'Input (Order_Stream);
+      end Order_Retrieval;
+
+   begin
+
+      Order_Stream := Ada.Streams.Stream_IO.Stream (Order_File);
+
+      -- Store the data objects in the stream.
+      -- Each of the objects is of a different type within the class.
+
+      Order_Entry (FXACC00.Box_Office_Request);     -- Object of root type
+      Order_Entry (FXACC00.Summer_Subscription);    -- Obj. of extended type
+      Order_Entry (FXACC00.Mayoral_Ticket_Request); -- Obj. of extended type
+      Order_Entry (FXACC00.Late_Request);           -- Object of twice 
+                                                    -- extended type.
+
+      -- Reset mode of stream to In_File prior to reading data from it.
+      Reset1:
+      begin
+         Ada.Streams.Stream_IO.Reset (Order_File, 
+                                      Ada.Streams.Stream_IO.In_File);
+      exception
+         when Ada.Streams.Stream_IO.Use_Error =>
+            Report.Not_Applicable
+               ( "Reset to In_File not supported for Stream_IO - 1" );
+            raise Incomplete;
+      end Reset1;
+
+      Process_Order_Block:
+      declare
+
+         use FXACC00;
+
+         -- Declare variables of the root type class,
+         -- and initialize them with class-wide objects returned from
+         -- the stream as function result.
+
+         Order_1 : Ticket_Request'Class := Order_Retrieval;
+         Order_2 : Ticket_Request'Class := Order_Retrieval;
+         Order_3 : Ticket_Request'Class := Order_Retrieval;
+         Order_4 : Ticket_Request'Class := Order_Retrieval;
+
+         -- Declare objects of the specific types from within the class
+         -- that correspond to the types of the data written to the
+         -- stream.  Perform a type conversion on the class-wide objects.
+
+         Ticket_Order      : Ticket_Request := 
+                                Ticket_Request(Order_1);
+         Subscriber_Order  : Subscriber_Request := 
+                                Subscriber_Request(Order_2);
+         VIP_Order         : VIP_Request := 
+                                VIP_Request(Order_3);
+         Last_Minute_Order : Last_Minute_Request := 
+                                Last_Minute_Request(Order_4);
+
+      begin
+
+         -- Perform a field-by-field comparison of all the class-wide 
+         -- objects input from the stream with specific type objects
+         -- originally written to the stream.
+
+         if Ticket_Order.Location                /= 
+            Box_Office_Request.Location          or
+            Ticket_Order.Number_Of_Tickets       /=
+            Box_Office_Request.Number_Of_Tickets 
+         then
+            Report.Failed ("Ticket_Request object validation failure");
+         end if;
+
+         if Subscriber_Order.Location               /=
+            Summer_Subscription.Location            or
+            Subscriber_Order.Number_Of_Tickets      /=
+            Summer_Subscription.Number_Of_Tickets   or
+            Subscriber_Order.Subscription_Number    /=
+            Summer_Subscription.Subscription_Number
+         then
+            Report.Failed ("Subscriber_Request object validation failure");
+         end if;
+
+         if VIP_Order.Location                       /=
+            Mayoral_Ticket_Request.Location          or
+            VIP_Order.Number_Of_Tickets              /=
+            Mayoral_Ticket_Request.Number_Of_Tickets or
+            VIP_Order.Rank                           /=
+            Mayoral_Ticket_Request.Rank              
+         then
+            Report.Failed ("VIP_Request object validation failure");
+         end if;
+
+         if Last_Minute_Order.Location               /=
+            Late_Request.Location                    or
+            Last_Minute_Order.Number_Of_Tickets      /=
+            Late_Request.Number_Of_Tickets           or
+            Last_Minute_Order.Rank                   /=
+            Late_Request.Rank                        or
+            Last_Minute_Order.Special_Consideration  /=
+            Late_Request.Special_Consideration       or
+            Last_Minute_Order.Donation               /=
+            Late_Request.Donation                    
+         then
+            Report.Failed ("Last_Minute_Request object validation failure");
+         end if;
+
+         -- Verify tag values from before and after processing.
+         -- The 'Tag attribute is used with objects of a class-wide type.
+   
+         if TC_Box_Office_Tag /= 
+            Ada.Tags.External_Tag(Order_1'Tag)
+         then
+            Report.Failed("Failed tag comparison - 1");
+         end if;
+     
+         if TC_Summer_Tag /=
+            Ada.Tags.External_Tag(Order_2'Tag)
+         then
+            Report.Failed("Failed tag comparison - 2");
+         end if;
+
+         if TC_Mayoral_Tag /=  
+            Ada.Tags.External_Tag(Order_3'Tag)
+         then
+            Report.Failed("Failed tag comparison - 3");
+         end if;
+
+         if TC_Late_Tag /=     
+            Ada.Tags.External_Tag(Order_4'Tag)
+         then
+            Report.Failed("Failed tag comparison - 4");
+         end if;
+
+      end Process_Order_Block;
+
+         -- After all the data has been correctly extracted, the file 
+         -- should be empty.
+
+      if not Ada.Streams.Stream_IO.End_Of_File (Order_File) then
+         Report.Failed ("Stream file not empty");
+      end if;
+
+   exception
+      when Incomplete =>
+         raise; 
+      when Constraint_Error =>
+         Report.Failed ("Constraint_Error raised in Operational Block");
+      when others => 
+         Report.Failed ("Exception raised in Operational Test Block");
+   end Operational_Test_Block;
+
+   Deletion:
+   begin
+      if Ada.Streams.Stream_IO.Is_Open (Order_File) then
+         Ada.Streams.Stream_IO.Delete (Order_File);
+      else
+         Ada.Streams.Stream_IO.Open (Order_File,
+                                     Ada.Streams.Stream_IO.Out_File, 
+                                     Order_Filename);
+         Ada.Streams.Stream_IO.Delete (Order_File);
+      end if;
+   exception
+      when others =>
+         Report.Failed
+            ( "Delete not properly implemented for Stream_IO" );
+   end Deletion;
+
+   Report.Result;
+
+exception
+
+   when Incomplete =>
+      Report.Result;
+   when others     =>
+      Report.Failed ( "Unexpected exception" );
+      Report.Result;
+
+end CXACC01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaf001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaf001.a
new file mode 100644
index 000000000..ae3497abd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxa/cxaf001.a
@@ -0,0 +1,199 @@
+-- CXAF001.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 an implementation supports the functionality defined
+--      in Package Ada.Command_Line.
+--
+-- TEST DESCRIPTION:
+--      This test verifies that an implementation supports the subprograms
+--      contained in package Ada.Command_Line.  Each of the subprograms
+--      is exercised in a general sense, to ensure that it is available,
+--      and that it provides the prescribed results in a known test 
+--      environment.  Function Argument_Count must return zero, or the 
+--      number of arguments passed to the program calling it.  Function
+--      Argument is called with a parameter value one greater than the
+--      actual number of arguments passed to the executing program, which
+--      must result in Constraint_Error being raised.  Function Command_Name
+--      should return the name of the executing program that called it
+--      (specifically, this test name).  Function Set_Exit_Status is called
+--      with two different parameter values, the constants Failure and 
+--      Success defined in package Ada.Command_Line.
+--
+--      The setting of the variable TC_Verbose allows for some additional
+--      output to be displayed during the running of the test as an aid in
+--      tracing the processing flow of the test.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to implementations that support the 
+--      declaration of package Command_Line as defined in the Ada Reference 
+--      manual. 
+--      An alternative declaration is allowed for package Command_Line if 
+--      different functionality is appropriate for the external execution
+--      environment.
+--
+--       
+-- CHANGE HISTORY:
+--      10 Jul 95   SAIC    Initial prerelease version.
+--      02 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      05 AUG 98   EDS     Allow Null string result to be returned from
+--                          Function Command
+--!
+
+with Ada.Command_Line;
+with Ada.Exceptions;
+with Report;
+
+procedure CXAF001 is
+begin
+
+   Report.Test ("CXAF001", "Check that an implementation supports the " &
+                           "functionality defined in Package "          &
+                           "Ada.Command_Line");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+
+      type String_Access is access all String;
+
+      TC_Verbose           : Boolean := False;
+      Number_Of_Arguments  : Natural := Natural'Last;
+      Name_Of_Command      : String_Access;
+
+   begin
+
+      -- Check the result of function Argument_Count.
+      -- Note: If the external environment does not support passing arguments
+      --       to the program invoking the function, the function result
+      --       will be zero.
+
+      Number_Of_Arguments := Ada.Command_Line.Argument_Count;
+      if Number_Of_Arguments = Natural'Last then
+         Report.Failed("Argument_Count did not provide a return result");
+      end if;
+      if TC_Verbose then
+         Report.Comment
+           ("Argument_Count = " & Integer'Image(Number_Of_Arguments));
+      end if;
+
+
+      -- Check that the result of Function Argument is Constraint_Error
+      -- when the Number argument is outside the range of 1..Argument_Count.
+
+      Test_Function_Argument_1 :
+      begin
+         declare
+
+            -- Define a value that will be outside the range of 
+            -- 1..Argument_Count. 
+            -- Note: If the external execution environment does not support
+            --       passing arguments to a program, then Argument(N) for 
+            --       any N will raise Constraint_Error, since 
+            --       Argument_Count = 0;
+
+            Arguments_Plus_One : Positive := 
+              Ada.Command_Line.Argument_Count + 1;
+
+            -- Using the above value in a call to Argument must result in
+            -- the raising of Constraint_Error.
+
+            Argument_String    : constant String := 
+              Ada.Command_Line.Argument(Arguments_Plus_One);
+
+         begin
+            Report.Failed("Constraint_Error not raised by Function "  &
+                          "Argument when provided a Number argument " &
+                          "out of range");
+         end;
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+            if TC_Verbose then
+              Report.Comment ("Argument_Count raised Constraint_Error");
+            end if;
+         when others => 
+            Report.Failed ("Unexpected exception raised by Argument " &
+                           "in Test_Function_Argument_1 block");
+      end Test_Function_Argument_1;
+
+
+      -- Check that Function Argument returns a string result.
+
+      Test_Function_Argument_2 :
+      begin
+         if Ada.Command_Line.Argument_Count > 0 then
+            Report.Comment
+              ("Last argument is: " &
+               Ada.Command_Line.Argument(Ada.Command_Line.Argument_Count));
+         elsif TC_Verbose then
+            Report.Comment("Argument_Count is zero, no test of Function " &
+                           "Argument for string result");
+         end if;
+      exception
+         when others => 
+            Report.Failed ("Unexpected exception raised by Argument " &
+                           "in Test_Function_Argument_2 block");
+      end Test_Function_Argument_2;
+
+
+      -- Check the result of Function Command_Name.
+
+      Name_Of_Command := new String'(Ada.Command_Line.Command_Name);
+
+      if Name_Of_Command = null  then
+         Report.Failed("Null string pointer returned from Function Command");
+      elsif Name_Of_Command.all = "" then
+         Report.Comment("Null string result returned from Function Command");
+      elsif TC_Verbose then
+         Report.Comment("Invoking command is " & Name_Of_Command.all);
+      end if;
+
+
+      -- Check that procedure Set_Exit_Status is available.
+      -- Note: If the external execution environment does not support
+      --       returning an exit value from a program, then Set_Exit_Status
+      --       does nothing.
+      
+      Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure);
+      if TC_Verbose then
+         Report.Comment("Exit status set to Failure");
+      end if;
+
+      Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success);
+      if TC_Verbose then
+         Report.Comment("Exit status set to Success");
+      end if;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXAF001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb2001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb2001.a
new file mode 100644
index 000000000..73f9209cd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb2001.a
@@ -0,0 +1,633 @@
+-- CXB2001.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 subprograms Shift_Left, Shift_Right, 
+--      Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right are available
+--      and produce correct results for values of signed and modular
+--      integer types of 8 bits. 
+--
+-- TEST DESCRIPTION:
+--      This test uses the shift and rotate functions of package Interfaces
+--      with a modular type representative of 8 bits.  The functions
+--      are used as the right hand of assignment statements, as part of
+--      conditional statements, and as arguments in other function calls.
+--
+--      A check is performed in the test to determine whether the bit 
+--      ordering method used by the machine/implementation is high-order
+--      first ("Big Endian") or low-order first ("Little Endian").  The
+--      specific subtests use this information to evaluate the results of
+--      each of the functions under test.
+--
+--      Note: In the string associated with each Report.Failed statement, the
+--            acronym BE refers to Big Endian, LE refers to Little Endian.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that support signed
+--      and modular integer types of 8 bits.
+--
+--       
+-- CHANGE HISTORY:
+--      21 Aug 95   SAIC    Initial prerelease version.
+--      07 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--
+--!
+
+with Report;
+with Interfaces;
+with Ada.Exceptions;
+
+procedure CXB2001 is
+begin
+
+   Report.Test ("CXB2001", 
+                "Check that subprograms Shift_Left, Shift_Right, "       &
+                "Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right " &
+                "produce correct results for values of signed and "      &
+                "modular integer types of 8 bits");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+      use Interfaces;
+
+      TC_Amount             : Natural     := Natural'First;
+      Big_Endian            : Boolean     := False;
+
+      -- Range of type Unsigned_8 is 0..255 (0..Modulus-1).
+      TC_Val_Unsigned_8,
+      TC_Result_Unsigned_8  : Unsigned_8  := Unsigned_8'First;
+
+   begin
+
+      -- Determine whether the machine uses high-order first or low-order
+      -- first bit ordering.
+      -- On a high-order first machine, bit zero of a storage element is
+      -- the most significant bit (interpreting the sequence of bits that
+      -- represent a component as an unsigned integer value).  
+      -- On a low-order first machine, bit zero is the least significant.
+      -- In this check, a right shift of one place on a Big Endian machine
+      -- will yield a result of one, while on a Little Endian machine the
+      -- result would be four.
+
+      TC_Val_Unsigned_8 := 2;
+      Big_Endian := (Shift_Right(TC_Val_Unsigned_8, 1) = 1);
+
+
+      -- Note: The shifting and rotating subprograms operate on a bit-by-bit
+      --       basis, using the binary representation of the value of the 
+      --       operands to yield a binary representation for the result.
+
+      -- Function Shift_Left.
+
+      if Big_Endian then   -- High-order first bit ordering.
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := Unsigned_8'Last;  -- 255.
+         TC_Result_Unsigned_8 := Shift_Left(Value  => TC_Val_Unsigned_8, 
+                                            Amount => TC_Amount);
+         if TC_Result_Unsigned_8 /= 254 then
+            Report.Failed("Incorrect result from BE Shift_Left - 1");
+         end if;
+
+         if Shift_Left(TC_Val_Unsigned_8, 2) /= 252  or
+            Shift_Left(TC_Val_Unsigned_8, 3) /= 248  or
+            Shift_Left(TC_Val_Unsigned_8, 5) /= 224  or
+            Shift_Left(TC_Val_Unsigned_8, 8) /=   0  or
+            Shift_Left(TC_Val_Unsigned_8, 9) /=   0  or
+            Shift_Left(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed("Incorrect result from BE Shift_Left - 2");
+         end if;
+
+         TC_Val_Unsigned_8 := 1;
+         if Shift_Left(TC_Val_Unsigned_8, 1)           /=  2 or
+            Shift_Left(TC_Val_Unsigned_8, Amount => 3) /=  8 
+         then
+            Report.Failed("Incorrect result from BE Shift_Left - 3");
+         end if;
+
+         TC_Val_Unsigned_8 := 7;
+         if Shift_Left(TC_Val_Unsigned_8, Amount => 4)      /= 112  or
+            Shift_Left(Shift_Left(TC_Val_Unsigned_8, 7), 1) /=   0
+         then
+            Report.Failed("Incorrect result from BE Shift_Left - 4");
+         end if;
+
+      else  -- Low-order first bit ordering.
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := Unsigned_8'Last;  -- 255.
+         TC_Result_Unsigned_8 := Shift_Left(TC_Val_Unsigned_8, TC_Amount);
+
+         if TC_Result_Unsigned_8 /= 127 then
+            Report.Failed("Incorrect result from LE Shift_Left - 1");
+         end if;
+
+         if Shift_Left(TC_Val_Unsigned_8, 2) /=  63  or
+            Shift_Left(TC_Val_Unsigned_8, 3) /=  31  or
+            Shift_Left(TC_Val_Unsigned_8, 5) /=   7  or
+            Shift_Left(TC_Val_Unsigned_8, 8) /=   0  or
+            Shift_Left(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed("Incorrect result from LE Shift_Left - 2");
+         end if;
+
+         TC_Val_Unsigned_8 := 1;
+         if Shift_Left(TC_Val_Unsigned_8, 1) /= 0 or
+            Shift_Left(TC_Val_Unsigned_8, 7) /= 0  
+         then
+            Report.Failed("Incorrect result from LE Shift_Left - 3");
+         end if;
+
+         TC_Val_Unsigned_8 := 129;
+         if Shift_Left(TC_Val_Unsigned_8, 4)                /= 8  or
+            Shift_Left(Shift_Left(TC_Val_Unsigned_8, 7), 1) /= 0
+         then
+            Report.Failed("Incorrect result from LE Shift_Left - 4");
+         end if;
+
+      end if;
+
+
+
+      -- Function Shift_Right.
+
+      if Big_Endian then   -- High-order first bit ordering.
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := Unsigned_8'Last;  -- 255.
+         TC_Result_Unsigned_8 := Shift_Right(TC_Val_Unsigned_8, TC_Amount);
+
+         if TC_Result_Unsigned_8 /= 127 then
+            Report.Failed("Incorrect result from BE Shift_Right - 1");
+         end if;
+
+         if Shift_Right(TC_Val_Unsigned_8, 2) /=  63  or
+            Shift_Right(TC_Val_Unsigned_8, 3) /=  31  or
+            Shift_Right(TC_Val_Unsigned_8, 5) /=   7  or
+            Shift_Right(TC_Val_Unsigned_8, 8) /=   0  or
+            Shift_Right(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed("Incorrect result from BE Shift_Right - 2");
+         end if;
+
+         TC_Val_Unsigned_8 := 1;
+         if Shift_Right(TC_Val_Unsigned_8, 1) /= 0 or
+            Shift_Right(TC_Val_Unsigned_8, 7) /= 0  
+         then
+            Report.Failed("Incorrect result from BE Shift_Right - 3");
+         end if;
+
+         TC_Val_Unsigned_8 := 129;
+         if Shift_Right(TC_Val_Unsigned_8, 4)                 /= 8  or
+            Shift_Right(Shift_Right(TC_Val_Unsigned_8, 7), 1) /= 0
+         then
+            Report.Failed("Incorrect result from BE Shift_Right - 4");
+         end if;
+
+      else  -- Low-order first bit ordering.
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := Unsigned_8'Last;  -- 255.
+         TC_Result_Unsigned_8 := Shift_Right(Value  => TC_Val_Unsigned_8, 
+                                             Amount => TC_Amount);
+         if TC_Result_Unsigned_8 /= 254 then
+            Report.Failed("Incorrect result from LE Shift_Right - 1");
+         end if;
+
+         if Shift_Right(TC_Val_Unsigned_8, 2) /= 252  or
+            Shift_Right(TC_Val_Unsigned_8, 3) /= 248  or
+            Shift_Right(TC_Val_Unsigned_8, 5) /= 224  or
+            Shift_Right(TC_Val_Unsigned_8, 8) /=   0  or
+            Shift_Right(TC_Val_Unsigned_8, 9) /=   0  or
+            Shift_Right(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed("Incorrect result from LE Shift_Right - 2");
+         end if;
+
+         TC_Val_Unsigned_8 := 1;
+         if Shift_Right(TC_Val_Unsigned_8, 1)           /=  2 or
+            Shift_Right(TC_Val_Unsigned_8, Amount => 3) /=  8 
+         then
+            Report.Failed("Incorrect result from LE Shift_Right - 3");
+         end if;
+
+         TC_Val_Unsigned_8 := 7;
+         if Shift_Right(TC_Val_Unsigned_8, Amount => 4)       /= 112  or
+            Shift_Right(Shift_Right(TC_Val_Unsigned_8, 7), 1) /=   0
+         then
+            Report.Failed("Incorrect result from LE Shift_Right - 4");
+         end if;
+
+      end if;
+
+
+
+      -- Tests of Shift_Left and Shift_Right in combination.
+
+      if Big_Endian then   -- High-order first bit ordering.
+
+         TC_Val_Unsigned_8  := 32;
+
+         if Shift_Left(Shift_Right(TC_Val_Unsigned_8, 2), 2) /= 
+            TC_Val_Unsigned_8                                       or
+            Shift_Left(Shift_Right(TC_Val_Unsigned_8, 1), 3) /= 128 or
+            Shift_Right(Shift_Left(TC_Val_Unsigned_8, 2), 6) /=   2 or
+            Shift_Right(Shift_Left(TC_Val_Unsigned_8, 2), 8) /=   0
+         then
+            Report.Failed("Incorrect result from BE Shift_Left - " &
+                          "Shift_Right functions used in combination");
+         end if;
+
+      else  -- Low-order first bit ordering.
+
+         TC_Val_Unsigned_8  := 32;
+
+         if Shift_Left(Shift_Right(TC_Val_Unsigned_8, 2), 2) /= 
+            TC_Val_Unsigned_8                                       or
+            Shift_Left(Shift_Right(TC_Val_Unsigned_8, 1), 3) /=   8 or
+            Shift_Right(Shift_Left(TC_Val_Unsigned_8, 2), 3) /=  64 or
+            Shift_Right(Shift_Left(TC_Val_Unsigned_8, 2), 4) /= 128
+         then
+            Report.Failed("Incorrect result from LE Shift_Left - " &
+                          "Shift_Right functions used in combination");
+         end if;
+
+      end if;
+
+
+
+      -- Function Shift_Right_Arithmetic.
+
+      if Big_Endian then   -- High-order first bit ordering.
+
+         -- Case where the parameter Value is less than
+         -- one half of the modulus.  Zero bits will be shifted in.
+         -- Modulus of type Unsigned_8 is 256; half of the modulus is 128.
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := 127;  -- Less than one half of modulus.
+         TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
+                                                        TC_Amount);
+         if TC_Result_Unsigned_8 /= 63 then
+            Report.Failed
+              ("Incorrect result from BE Shift_Right_Arithmetic - 1");
+         end if;
+
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 2) /=  31  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3) /=  15  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 5) /=   3  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 8) /=   0  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed
+              ("Incorrect result from BE Shift_Right_Arithmetic - 2");
+         end if;
+
+         TC_Val_Unsigned_8 := 1;
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_8, Amount => 1) /= 0 or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3)           /= 0  
+         then
+            Report.Failed
+              ("Incorrect result from BE Shift_Right_Arithmetic - 3");
+         end if;
+
+         -- Case where the parameter Value is greater than or equal to
+         -- one half of the modulus.  One bits will be shifted in.
+       
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := 128;  -- One half of modulus.
+         TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
+                                                        Amount => TC_Amount);
+         if TC_Result_Unsigned_8 /= 192 then
+            Report.Failed
+              ("Incorrect result from BE Shift_Right_Arithmetic - 4");
+         end if;
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := 129;  -- Greater than one half of modulus.
+         TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
+                                                        Amount => TC_Amount);
+         if TC_Result_Unsigned_8 /= 192 then
+            Report.Failed
+              ("Incorrect result from BE Shift_Right_Arithmetic - 5");
+         end if;
+
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 2) /= 224  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3) /= 240  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 5) /= 252  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 7) /= Unsigned_8'Last or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed
+              ("Incorrect result from BE Shift_Right_Arithmetic - 6");
+         end if;
+
+         TC_Val_Unsigned_8 := Unsigned_8'Last;
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 1) /= 
+            Unsigned_8'Last 
+         then
+            Report.Failed
+              ("Incorrect result from BE Shift_Right_Arithmetic - 7");
+         end if;
+
+      else  -- Low-order first bit ordering
+
+         -- Case where the parameter Value is less than 
+         -- one half of the modulus.  Zero bits will be shifted in.
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := 127;  -- Less than one half of modulus.
+         TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
+                                                        TC_Amount);
+         if TC_Result_Unsigned_8 /= 254 then
+            Report.Failed
+              ("Incorrect result from LE Shift_Right_Arithmetic - 1");
+         end if;
+
+         TC_Val_Unsigned_8 := 2;
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 2) /=   8  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3) /=  16  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 5) /=  64  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 8) /=   0  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed
+              ("Incorrect result from LE Shift_Right_Arithmetic - 2");
+         end if;
+
+         TC_Val_Unsigned_8 := 64;
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_8, Amount => 1) /= 128 or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3)           /=   0  
+         then
+            Report.Failed
+              ("Incorrect result from LE Shift_Right_Arithmetic - 3");
+         end if;
+
+         -- Case where the parameter Value is greater than or equal to
+         -- one half of the modulus.  One bits will be shifted in.
+       
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := 128;  -- One half of modulus.
+         TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
+                                                        Amount => TC_Amount);
+
+         if TC_Result_Unsigned_8 /= 3 then
+            Report.Failed
+              ("Incorrect result from LE Shift_Right_Arithmetic - 4");
+         end if;
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := 129;  -- Greater than one half of modulus.
+         TC_Result_Unsigned_8 := Shift_Right_Arithmetic(TC_Val_Unsigned_8,
+                                                        Amount => TC_Amount);
+
+         if TC_Result_Unsigned_8 /= 3 then
+            Report.Failed
+              ("Incorrect result from LE Shift_Right_Arithmetic - 5");
+         end if;
+
+         TC_Val_Unsigned_8    := 135;  -- Greater than one half of modulus.
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 2) /= 31  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 3) /= 63  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 5) /= Unsigned_8'Last or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 7) /= Unsigned_8'Last or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed
+              ("Incorrect result from LE Shift_Right_Arithmetic - 6");
+         end if;
+
+         TC_Val_Unsigned_8 := Unsigned_8'Last;
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_8, 1) /= 
+            Unsigned_8'Last 
+         then
+            Report.Failed
+              ("Incorrect result from LE Shift_Right_Arithmetic - 7");
+         end if;
+
+      end if;
+
+
+
+      -- Function Rotate_Left.
+
+      if Big_Endian then  -- High-order first bit ordering.
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := 129;  
+         TC_Result_Unsigned_8 := Rotate_Left(Value  => TC_Val_Unsigned_8, 
+                                             Amount => TC_Amount);
+         if TC_Result_Unsigned_8 /= 3 then
+            Report.Failed("Incorrect result from BE Rotate_Left - 1");
+         end if;
+
+         if Rotate_Left(TC_Val_Unsigned_8, 2) /=   6  or
+            Rotate_Left(TC_Val_Unsigned_8, 3) /=  12  or
+            Rotate_Left(TC_Val_Unsigned_8, 5) /=  48  or
+            Rotate_Left(TC_Val_Unsigned_8, 8) /= 129  or
+            Rotate_Left(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed("Incorrect result from BE Rotate_Left - 2");
+         end if;
+
+         TC_Val_Unsigned_8 := 1;
+         if Rotate_Left(Value => TC_Val_Unsigned_8, Amount => 1) /= 2 or
+            Rotate_Left(TC_Val_Unsigned_8, Amount => 3)          /= 8 
+         then 
+            Report.Failed("Incorrect result from BE Rotate_Left - 3");
+         end if;
+
+         TC_Val_Unsigned_8 := 82;
+         if Rotate_Left(TC_Val_Unsigned_8, Amount => 4)       /=  37  or
+            Rotate_Left(Rotate_Left(TC_Val_Unsigned_8, 7), 1) /=  82
+         then
+            Report.Failed("Incorrect result from BE Rotate_Left - 4");
+         end if;
+
+      else   -- Low-order first bit ordering.
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := 1;
+         TC_Result_Unsigned_8 := Rotate_Left(TC_Val_Unsigned_8, TC_Amount);
+
+         if TC_Result_Unsigned_8 /= 128 then
+            Report.Failed("Incorrect result from LE Rotate_Left - 1");
+         end if;
+
+         TC_Val_Unsigned_8    := 15;
+         if Rotate_Left(TC_Val_Unsigned_8, 2) /=  195  or
+            Rotate_Left(TC_Val_Unsigned_8, 3) /=  225  or
+            Rotate_Left(TC_Val_Unsigned_8, 5) /=  120  or
+            Rotate_Left(TC_Val_Unsigned_8, 8) /= TC_Val_Unsigned_8 or
+            Rotate_Left(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed("Incorrect result from LE Rotate_Left - 2");
+         end if;
+
+         TC_Val_Unsigned_8 := Unsigned_8'Last;
+         if Rotate_Left(TC_Val_Unsigned_8, 1) /= Unsigned_8'Last then
+            Report.Failed("Incorrect result from LE Rotate_Left - 3");
+         end if;
+
+         TC_Val_Unsigned_8 := 12;
+         if Rotate_Left(TC_Val_Unsigned_8, 1) /=   6 or
+            Rotate_Left(TC_Val_Unsigned_8, 3) /= 129  
+         then
+            Report.Failed("Incorrect result from LE Rotate_Left - 4");
+         end if;
+
+         TC_Val_Unsigned_8 := 129;
+         if Rotate_Left(TC_Val_Unsigned_8, 4)                 /=  24  or
+            Rotate_Left(Rotate_Left(TC_Val_Unsigned_8, 7), 1) /= 129
+         then
+            Report.Failed("Incorrect result from LE Rotate_Left - 5");
+         end if;
+
+      end if;
+
+
+
+      -- Function Rotate_Right.
+
+      if Big_Endian then  -- High-order first bit ordering.
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := 1;
+         TC_Result_Unsigned_8 := Rotate_Right(TC_Val_Unsigned_8, TC_Amount);
+
+         if TC_Result_Unsigned_8 /= 128 then
+            Report.Failed("Incorrect result from BE Rotate_Right - 1");
+         end if;
+
+         TC_Val_Unsigned_8    := 15;
+         if Rotate_Right(TC_Val_Unsigned_8, 2) /=  195  or
+            Rotate_Right(TC_Val_Unsigned_8, 3) /=  225  or
+            Rotate_Right(TC_Val_Unsigned_8, 5) /=  120  or
+            Rotate_Right(TC_Val_Unsigned_8, 8) /= TC_Val_Unsigned_8 or
+            Rotate_Right(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed("Incorrect result from BE Rotate_Right - 2");
+         end if;
+
+         TC_Val_Unsigned_8 := Unsigned_8'Last;
+         if Rotate_Right(TC_Val_Unsigned_8, 1) /= Unsigned_8'Last then
+            Report.Failed("Incorrect result from BE Rotate_Right - 3");
+         end if;
+
+         TC_Val_Unsigned_8 := 12;
+         if Rotate_Right(TC_Val_Unsigned_8, 1) /=   6 or
+            Rotate_Right(TC_Val_Unsigned_8, 3) /= 129  
+         then
+            Report.Failed("Incorrect result from BE Rotate_Right - 4");
+         end if;
+
+         TC_Val_Unsigned_8 := 129;
+         if Rotate_Right(TC_Val_Unsigned_8, 4)                  /=  24  or
+            Rotate_Right(Rotate_Right(TC_Val_Unsigned_8, 7), 1) /= 129
+         then
+            Report.Failed("Incorrect result from BE Rotate_Right - 5");
+         end if;
+
+      else  -- Low-order first bit ordering.
+
+         TC_Amount            := 1;
+         TC_Val_Unsigned_8    := 129;  
+         TC_Result_Unsigned_8 := Rotate_Right(Value  => TC_Val_Unsigned_8, 
+                                              Amount => TC_Amount);
+         if TC_Result_Unsigned_8 /= 3 then
+            Report.Failed("Incorrect result from LE Rotate_Right - 1");
+         end if;
+
+         if Rotate_Right(TC_Val_Unsigned_8, 2) /=   6  or
+            Rotate_Right(TC_Val_Unsigned_8, 3) /=  12  or
+            Rotate_Right(TC_Val_Unsigned_8, 5) /=  48  or
+            Rotate_Right(TC_Val_Unsigned_8, 8) /= 129  or
+            Rotate_Right(TC_Val_Unsigned_8, 0) /= TC_Val_Unsigned_8  
+         then
+            Report.Failed("Incorrect result from LE Rotate_Right - 2");
+         end if;
+
+         TC_Val_Unsigned_8 := 1;
+         if Rotate_Right(Value => TC_Val_Unsigned_8, Amount => 1) /= 2 or
+            Rotate_Right(TC_Val_Unsigned_8, Amount => 3)          /= 8 
+         then 
+            Report.Failed("Incorrect result from LE Rotate_Right - 3");
+         end if;
+
+         TC_Val_Unsigned_8 := 82;
+         if Rotate_Right(TC_Val_Unsigned_8, Amount => 4)        /=  37  or
+            Rotate_Right(Rotate_Right(TC_Val_Unsigned_8, 7), 1) /=  82
+         then
+            Report.Failed("Incorrect result from LE Rotate_Right - 4");
+         end if;
+
+      end if;
+
+
+
+      -- Tests of Rotate_Left and Rotate_Right in combination.
+
+      if Big_Endian then  -- High-order first bit ordering.
+
+         TC_Val_Unsigned_8  := 17;
+
+         if Rotate_Left(Rotate_Right(TC_Val_Unsigned_8, 2), 2) /= 
+            TC_Val_Unsigned_8                                        or
+            Rotate_Left(Rotate_Right(TC_Val_Unsigned_8, 1), 3) /= 68 or
+            Rotate_Right(Rotate_Left(TC_Val_Unsigned_8, 3), 7) /= 17 or
+            Rotate_Right(Rotate_Left(TC_Val_Unsigned_8, 2), 8) /= 68 
+         then
+            Report.Failed("Incorrect result from BE Rotate_Left - " &
+                          "Rotate_Right functions used in combination");
+         end if;
+
+      else  -- Low-order first bit ordering.
+
+         TC_Val_Unsigned_8 := 4;
+
+         if Rotate_Left(Rotate_Right(TC_Val_Unsigned_8, 2), 2) /= 
+            TC_Val_Unsigned_8                                        or
+            Rotate_Left(Rotate_Right(TC_Val_Unsigned_8, 1), 3) /=  1 or
+            Rotate_Right(Rotate_Left(TC_Val_Unsigned_8, 3), 7) /= 64 or
+            Rotate_Right(Rotate_Left(TC_Val_Unsigned_8, 2), 8) /=  1 
+         then
+            Report.Failed("Incorrect result from LE Rotate_Left - " &
+                          "Rotate_Right functions used in combination");
+         end if;
+
+      end if;
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB2001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb2002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb2002.a
new file mode 100644
index 000000000..945722295
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb2002.a
@@ -0,0 +1,259 @@
+-- CXB2002.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 subprograms Shift_Left, Shift_Right, 
+--      Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right are available
+--      and produce correct results for values of signed and modular
+--      integer types of 16 bits.  
+--
+-- TEST DESCRIPTION:
+--      This test uses the shift and rotate functions of package Interfaces
+--      with a modular type representative of 16 bits.  The functions
+--      are used as the right hand of assignment statements, as part of
+--      conditional statements, and as arguments in other function calls.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that support signed
+--      and modular integer types of 16 bits.
+--
+--       
+-- CHANGE HISTORY:
+--      21 Aug 95   SAIC    Initial prerelease version.
+--      07 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Removed subtests based on Big/Little Endian.
+--      17 Feb 97   PWB.CTA Corrected "-" to "+" in parenthesized expressions.
+--!
+
+with Report;
+with Interfaces;
+with Ada.Exceptions;
+
+procedure CXB2002 is
+begin
+
+   Report.Test ("CXB2002", 
+                "Check that subprograms Shift_Left, Shift_Right, "       &
+                "Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right " &
+                "produce correct results for values of signed and "      &
+                "modular integer types of 16 bits");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+      use Interfaces;
+
+      TC_Amount             : Natural     := Natural'First;
+
+      -- Range of type Unsigned_16 is 0..65535 (0..Modulus-1).
+      TC_Val_Unsigned_16,
+      TC_Result_Unsigned_16 : Unsigned_16 := Unsigned_16'First;
+
+   begin
+
+      -- Note: The shifting and rotating subprograms operate on a bit-by-bit
+      --       basis, using the binary representation of the value of the 
+      --       operands to yield a binary representation for the result.
+
+      -- Function Shift_Left.
+
+         TC_Amount             := 3;
+         TC_Val_Unsigned_16    := Unsigned_16'Last;  -- 65535.
+         TC_Result_Unsigned_16 := Shift_Left(TC_Val_Unsigned_16, TC_Amount);
+
+         if TC_Result_Unsigned_16 /= Unsigned_16'Last - (2**0 + 2**1 + 2**2)
+         then
+            Report.Failed("Incorrect result from Shift_Left - 1");
+         end if;
+
+         if Shift_Left(TC_Val_Unsigned_16,  0) /= Unsigned_16'Last  or
+            Shift_Left(TC_Val_Unsigned_16,  5) /= 
+            Unsigned_16'Last - (2**0 + 2**1 + 2**2 + 2**3 +2**4)    or
+            Shift_Left(TC_Val_Unsigned_16, 16) /=     0  
+         then
+            Report.Failed("Incorrect result from Shift_Left - 2");
+         end if;
+
+
+      -- Function Shift_Right.
+
+         TC_Amount             := 3;
+         TC_Val_Unsigned_16    := Unsigned_16'Last;  -- 65535.
+         TC_Result_Unsigned_16 := Shift_Right(Value  => TC_Val_Unsigned_16, 
+                                              Amount => TC_Amount);
+
+         if TC_Result_Unsigned_16 /= Unsigned_16'Last-(2**15 + 2**14 + 2**13)
+         then
+            Report.Failed("Incorrect result from Shift_Right - 1");
+         end if;
+
+         if Shift_Right(TC_Val_Unsigned_16,  0) /= Unsigned_16'Last  or
+            Shift_Right(TC_Val_Unsigned_16,  5) /= 
+            Unsigned_16'Last-(2**15 + 2**14 + 2**13 + 2**12 + 2**11) or
+            Shift_Right(TC_Val_Unsigned_16, 16) /=    0  
+         then
+            Report.Failed("Incorrect result from Shift_Right - 2");
+         end if;
+
+
+      -- Tests of Shift_Left and Shift_Right in combination.
+
+         TC_Val_Unsigned_16 := Unsigned_16'Last;
+
+         if Shift_Left(Shift_Right(TC_Val_Unsigned_16, 4),  4) /= 
+            Unsigned_16'Last-(2**0 + 2**1 + 2**2 + 2**3)         or
+            Shift_Left(Shift_Right(TC_Val_Unsigned_16, 1),  3) /= 
+            Unsigned_16'Last-(2**0 + 2**1 + 2**2)                or
+            Shift_Right(Shift_Left(TC_Val_Unsigned_16, 2),  4) /=  
+            Unsigned_16'Last-(2**15+ 2**14 + 2**13 + 2**12)      or
+            Shift_Right(Shift_Left(TC_Val_Unsigned_16, 2), 16) /= 0
+         then
+            Report.Failed("Incorrect result from Shift_Left - " &
+                          "Shift_Right functions used in combination");
+         end if;
+
+
+      -- Function Shift_Right_Arithmetic.
+
+         -- Case where the parameter Value is less than 
+         -- one half of the modulus.  Zero bits will be shifted in.
+         -- Modulus of type Unsigned_16 is 2**16; one half is 2**15.
+
+         TC_Amount             := 3;
+         TC_Val_Unsigned_16    := 2**15 - 1; -- Less than one half of modulus.
+         TC_Result_Unsigned_16 := Shift_Right_Arithmetic(TC_Val_Unsigned_16,
+                                                         TC_Amount);
+         if TC_Result_Unsigned_16 /= 
+            TC_Val_Unsigned_16 - (2**14 + 2**13 + 2**12) 
+         then
+            Report.Failed
+              ("Incorrect result from Shift_Right_Arithmetic - 1");
+         end if;
+
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_16, 0)  /= 
+            TC_Val_Unsigned_16                                           or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_16, 5)  /=
+            TC_Val_Unsigned_16 - (2**14 + 2**13 + 2**12 + 2**11 + 2**10) or 
+            Shift_Right_Arithmetic(TC_Val_Unsigned_16, 16) /=    0  
+         then
+            Report.Failed
+              ("Incorrect result from Shift_Right_Arithmetic - 2");
+         end if;
+
+         -- Case where the parameter Value is greater than or equal to
+         -- one half of the modulus.  One bits will be shifted in.
+
+         TC_Amount             := 1;
+         TC_Val_Unsigned_16    := 2**15;  -- One half of modulus.
+         TC_Result_Unsigned_16 := Shift_Right_Arithmetic(TC_Val_Unsigned_16,
+                                                         TC_Amount);
+         if TC_Result_Unsigned_16 /= TC_Val_Unsigned_16 + 2**14 then
+            Report.Failed
+              ("Incorrect result from Shift_Right_Arithmetic - 3");
+         end if;
+
+         TC_Amount             := 1;
+         TC_Val_Unsigned_16    := 2**15 + 1; -- Greater than half of modulus.
+         TC_Result_Unsigned_16 := Shift_Right_Arithmetic(TC_Val_Unsigned_16,
+                                                         TC_Amount);
+         if TC_Result_Unsigned_16 /= TC_Val_Unsigned_16 + 2**14 - 2**0 then
+            Report.Failed
+              ("Incorrect result from Shift_Right_Arithmetic - 4");
+         end if;
+
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_16, 0)  /= 
+            TC_Val_Unsigned_16                                        or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_16, 4)  /= 
+            TC_Val_Unsigned_16 - 2**0 + 2**14 + 2**13 + 2**12 + 2**11 or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_16, 16) /= Unsigned_16'Last
+         then
+            Report.Failed
+              ("Incorrect result from Shift_Right_Arithmetic - 5");
+         end if;
+
+
+      -- Function Rotate_Left.
+
+         TC_Amount             := 3;
+         TC_Val_Unsigned_16    := Unsigned_16'Last;  -- 65535.
+         TC_Result_Unsigned_16 := Rotate_Left(Value  => TC_Val_Unsigned_16, 
+                                              Amount => TC_Amount);
+         if TC_Result_Unsigned_16 /= Unsigned_16'Last then
+            Report.Failed("Incorrect result from Rotate_Left - 1");
+         end if;
+
+         TC_Val_Unsigned_16    := 2**15 + 2**14 + 2**1 + 2**0;
+         if Rotate_Left(TC_Val_Unsigned_16,  0) /= 
+            2**15 + 2**14 + 2**1 + 2**0            or
+            Rotate_Left(TC_Val_Unsigned_16,  5) /=    
+            2**6 + 2**5 + 2**4 + 2**3              or
+            Rotate_Left(TC_Val_Unsigned_16, 16) /= TC_Val_Unsigned_16  
+         then
+            Report.Failed("Incorrect result from Rotate_Left - 2");
+         end if;
+
+
+      -- Function Rotate_Right.
+
+         TC_Amount             := 1;
+         TC_Val_Unsigned_16    := 2**1 + 2**0;
+         TC_Result_Unsigned_16 := Rotate_Right(Value  => TC_Val_Unsigned_16, 
+                                               Amount => TC_Amount);
+         if TC_Result_Unsigned_16 /= 2**15 + 2**0 then
+            Report.Failed("Incorrect result from Rotate_Right - 1");
+         end if;
+
+         if Rotate_Right(TC_Val_Unsigned_16,  0) /= 2**1 + 2**0   or
+            Rotate_Right(TC_Val_Unsigned_16,  5) /= 2**12 + 2**11 or
+            Rotate_Right(TC_Val_Unsigned_16, 16) /= 2**1 + 2**0 
+         then
+            Report.Failed("Incorrect result from Rotate_Right - 2");
+         end if;
+
+
+      -- Tests of Rotate_Left and Rotate_Right in combination.
+
+         TC_Val_Unsigned_16 := 32769;
+
+         if Rotate_Left(Rotate_Right(TC_Val_Unsigned_16, 4),  3) /= 49152 or
+            Rotate_Left(Rotate_Right(TC_Val_Unsigned_16, 1),  3) /=     6 or
+            Rotate_Right(Rotate_Left(TC_Val_Unsigned_16, 3),  7) /=  6144 or
+            Rotate_Right(Rotate_Left(TC_Val_Unsigned_16, 1), 16) /=     3
+         then
+            Report.Failed("Incorrect result from Rotate_Left - " &
+                          "Rotate_Right functions used in combination");
+         end if;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB2002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb2003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb2003.a
new file mode 100644
index 000000000..ec3998ad8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb2003.a
@@ -0,0 +1,255 @@
+-- CXB2003.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 subprograms Shift_Left, Shift_Right, 
+--      Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right are available
+--      and produce correct results for values of signed and modular
+--      integer types of 32 bits.  
+--
+-- TEST DESCRIPTION:
+--      This test uses the shift and rotate functions of package Interfaces
+--      with a modular type representative of 32 bits.  The functions
+--      are used as the right hand of assignment statements, as part of
+--      conditional statements, and as arguments in other function calls.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that support signed
+--      and modular integer types of 32 bits.
+--
+--       
+-- CHANGE HISTORY:
+--      23 Aug 95   SAIC    Initial prerelease version.
+--      07 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Removed all references to Big/Little endian.
+--
+--!
+
+with Report;
+with Interfaces;
+with Ada.Exceptions;
+
+procedure CXB2003 is
+begin
+
+   Report.Test ("CXB2003", 
+                "Check that subprograms Shift_Left, Shift_Right, "       &
+                "Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right " &
+                "are available and produce correct results");
+
+   Test_Block:
+   declare
+
+      use Interfaces;
+      use Ada.Exceptions;
+
+      TC_Amount   : Natural  := Natural'First;
+
+      -- Range of type Unsigned_32 is 0..(2**32)-1    (0..Modulus-1).
+      TC_Val_Unsigned_32,
+      TC_Result_Unsigned_32 : Unsigned_32 := Unsigned_32'First;
+
+   begin
+
+      -- Note: The shifting and rotating subprograms operate on a bit-by-bit
+      --       basis, using the binary representation of the value of the 
+      --       operands to yield a binary representation for the result.
+
+
+      -- Function Shift_Left.
+
+         TC_Amount             := 2;
+         TC_Val_Unsigned_32    := Unsigned_32'Last; 
+         TC_Result_Unsigned_32 := Shift_Left(TC_Val_Unsigned_32, TC_Amount);
+
+         if TC_Result_Unsigned_32 /= Unsigned_32'Last - (2**0 + 2**1) then
+            Report.Failed("Incorrect result from Shift_Left - 1");
+         end if;
+
+         TC_Result_Unsigned_32 := Unsigned_32'Last - (2**0 + 2**1 + 2**2 +
+                                                      2**3 + 2**4);
+         if Shift_Left(TC_Val_Unsigned_32,  5) /= TC_Result_Unsigned_32  or
+            Shift_Left(TC_Val_Unsigned_32,  0) /= Unsigned_32'Last       
+         then
+            Report.Failed("Incorrect result from Shift_Left - 2");
+         end if;
+
+
+      -- Function Shift_Right.
+
+         TC_Amount             := 3;
+         TC_Val_Unsigned_32    := Unsigned_32'Last;  
+         TC_Result_Unsigned_32 := Shift_Right(Value  => TC_Val_Unsigned_32, 
+                                              Amount => TC_Amount);
+         if TC_Result_Unsigned_32 /= 
+            Unsigned_32'Last - (2**31 + 2**30 + 2**29) 
+         then
+            Report.Failed("Incorrect result from Shift_Right - 1");
+         end if;
+
+         if Shift_Right(TC_Val_Unsigned_32,  0) /= Unsigned_32'Last    or
+            Shift_Right(TC_Val_Unsigned_32,  2) /= Unsigned_32'Last - 
+                                                   (2**31 + 2**30)     
+         then
+            Report.Failed("Incorrect result from Shift_Right - 2");
+         end if;
+
+
+      -- Tests of Shift_Left and Shift_Right in combination.
+
+         TC_Val_Unsigned_32 := Unsigned_32'Last;
+
+         if Shift_Left(Shift_Right(TC_Val_Unsigned_32, 4),  4) /=
+            Unsigned_32'Last - (2**0 + 2**1 + 2**2 + 2**3)          or
+            Shift_Left(Shift_Right(TC_Val_Unsigned_32, 3),  1) /=
+            Unsigned_32'Last - (2**31 + 2**30 + 2**0)               or
+            Shift_Left(Shift_Right(TC_Val_Unsigned_32, 5),  3) /=
+            Unsigned_32'Last - (2**31 + 2**30 + 2**2 + 2**1 + 2**0) or
+            Shift_Right(Shift_Left(TC_Val_Unsigned_32, 2),  1) /=
+            Unsigned_32'Last - (2**31 + 2**0)                       
+         then
+            Report.Failed("Incorrect result from Shift_Left - " &
+                          "Shift_Right functions used in combination");
+         end if;
+
+
+      -- Function Shift_Right_Arithmetic.
+
+         -- Case where the parameter Value is less than 
+         -- one half of the modulus.  Zero bits will be shifted in.
+
+         TC_Amount             := 3;
+         TC_Val_Unsigned_32    := 2**15 + 2**10 + 2**1;
+         TC_Result_Unsigned_32 := Shift_Right_Arithmetic(TC_Val_Unsigned_32,
+                                                         TC_Amount);
+         if TC_Result_Unsigned_32 /= (2**12 + 2**7) then
+            Report.Failed
+              ("Incorrect result from Shift_Right_Arithmetic - 1");
+         end if;
+
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_32, 0)  /= 
+            TC_Val_Unsigned_32                                  or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_32, 5)  /= 
+            (2**10 + 2**5)                                      
+         then
+            Report.Failed
+              ("Incorrect result from Shift_Right_Arithmetic - 2");
+         end if;
+
+         -- Case where the parameter Value is greater than or equal to
+         -- one half of the modulus.  One bits will be shifted in.
+
+         TC_Amount             := 1;
+         TC_Val_Unsigned_32    := 2**31; -- One half of modulus
+         TC_Result_Unsigned_32 := Shift_Right_Arithmetic(TC_Val_Unsigned_32,
+                                                         TC_Amount);
+         if TC_Result_Unsigned_32 /= (2**31 + 2**30) then
+            Report.Failed
+              ("Incorrect result from Shift_Right_Arithmetic - 3");
+         end if;
+
+         TC_Amount             := 1;
+         TC_Val_Unsigned_32    := (2**31 + 2**1);
+         TC_Result_Unsigned_32 := Shift_Right_Arithmetic(TC_Val_Unsigned_32,
+                                                         TC_Amount);
+         if TC_Result_Unsigned_32 /= (2**31 + 2**30 + 2**0) then
+            Report.Failed
+              ("Incorrect result from Shift_Right_Arithmetic - 4");
+         end if;
+
+         if Shift_Right_Arithmetic(TC_Val_Unsigned_32, 0)  /= 
+            TC_Val_Unsigned_32                                or
+            Shift_Right_Arithmetic(TC_Val_Unsigned_32, 3)  /= 
+            (2**31 + 2**30 + 2**29 + 2**28)                   
+         then
+            Report.Failed
+              ("Incorrect result from Shift_Right_Arithmetic - 5");
+         end if;
+
+
+      -- Function Rotate_Left.
+
+         TC_Amount             := 3;
+         TC_Val_Unsigned_32    := Unsigned_32'Last; 
+         TC_Result_Unsigned_32 := Rotate_Left(Value  => TC_Val_Unsigned_32, 
+                                              Amount => TC_Amount);
+         if TC_Result_Unsigned_32 /= Unsigned_32'Last then
+            Report.Failed("Incorrect result from Rotate_Left - 1");
+         end if;
+
+         TC_Val_Unsigned_32    := 2**31 + 2**30;
+         if Rotate_Left(TC_Val_Unsigned_32,  1) /= (2**31 + 2**0)  or
+            Rotate_Left(TC_Val_Unsigned_32,  5) /= (2**4  + 2**3)  or
+            Rotate_Left(TC_Val_Unsigned_32, 32) /= TC_Val_Unsigned_32  
+         then
+            Report.Failed("Incorrect result from Rotate_Left - 2");
+         end if;
+
+
+      -- Function Rotate_Right.
+
+         TC_Amount             := 2;
+         TC_Val_Unsigned_32    := (2**1 + 2**0);
+         TC_Result_Unsigned_32 := Rotate_Right(Value  => TC_Val_Unsigned_32, 
+                                               Amount => TC_Amount);
+         if TC_Result_Unsigned_32 /= (2**31 + 2**30) then
+            Report.Failed("Incorrect result from Rotate_Right - 1");
+         end if;
+
+         if Rotate_Right(TC_Val_Unsigned_32,  3) /=  (2**30 + 2**29)  or
+            Rotate_Right(TC_Val_Unsigned_32,  6) /=  (2**27 + 2**26)  or
+            Rotate_Right(TC_Val_Unsigned_32, 32) /=  (2**1  + 2**0) 
+         then
+            Report.Failed("Incorrect result from Rotate_Right - 2");
+         end if;
+
+
+      -- Tests of Rotate_Left and Rotate_Right in combination.
+
+         TC_Val_Unsigned_32 := (2**31 + 2**15 + 2**3);
+
+         if Rotate_Left(Rotate_Right(TC_Val_Unsigned_32, 4),  3) /= 
+            (2**30 + 2**14 + 2**2)                                   or
+            Rotate_Left(Rotate_Right(TC_Val_Unsigned_32, 1),  3) /= 
+            (2**17 + 2**5  + 2**1)                                   or
+            Rotate_Right(Rotate_Left(TC_Val_Unsigned_32, 3),  7) /= 
+            (2**31 + 2**27 + 2**11)                                  or
+            Rotate_Right(Rotate_Left(TC_Val_Unsigned_32, 1), 32) /= 
+            (2**16 + 2**4  + 2**0)
+         then
+            Report.Failed("Incorrect result from Rotate_Left - " &
+                          "Rotate_Right functions used in combination");
+         end if;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB2003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3001.a
new file mode 100644
index 000000000..4d79b24e1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3001.a
@@ -0,0 +1,179 @@
+-- CXB3001.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 specifications of the package Interfaces.C are
+--      available for use.
+--
+-- TEST DESCRIPTION: 
+--      This test verifies that the types and subprograms specified for the
+--      interface are present.  It just checks for the presence of
+--      the subprograms.  Other tests are designed to exercise the interface.
+--
+-- APPLICABILITY CRITERIA: 
+--      If an implementation provides package Interfaces.C, this test
+--      must compile, execute, and report "PASSED".
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Nov 95   SAIC    Corrected To_C parameter list for ACVC 2.0.1.
+--      28 Feb 96   SAIC    Added applicability criteria.
+--
+--!
+
+with Report;
+with Interfaces.C;                                             -- N/A => ERROR
+
+procedure CXB3001 is
+   package C renames Interfaces.C;
+   use type C.signed_char;
+   use type C.unsigned_char;
+   use type C.char;
+
+begin
+
+   Report.Test ("CXB3001", "Check the specification of Interfaces.C");
+
+   declare  -- encapsulate the test
+
+
+      tst_CHAR_BIT  : constant :=  C.CHAR_BIT;
+      tst_SCHAR_MIN : constant :=  C.SCHAR_MIN;
+      tst_SCHAR_MAX : constant :=  C.SCHAR_MAX;
+      tst_UCHAR_MAX : constant :=  C.UCHAR_MAX;
+
+      -- Signed and Unsigned Integers
+
+      tst_int   : C.int   := C.int'first;
+      tst_short : C.short := C.short'first;
+      tst_long  : C.long  := C.long'first;
+
+      tst_signed_char_min : C.signed_char :=  C.signed_char'first;
+      tst_signed_char_max : C.signed_char :=  C.signed_char'last;
+
+      tst_unsigned        : C.unsigned;
+      tst_unsigned_short  : C.unsigned_short;
+      tst_unsigned_long   : C.unsigned_long;
+
+      tst_unsigned_char :  C.unsigned_char;
+      tst_plain_char    :  C.plain_char;
+
+      tst_ptrdiff_t : C.ptrdiff_t;
+      tst_size_t    : C.size_t;
+
+      -- Floating-Point
+
+      tst_C_float     : C.C_float;
+      tst_double      : C.double;
+      tst_long_double : C.long_double; 
+
+      -- Characters and Strings
+
+      tst_char : C.char;
+      tst_nul  : C.char := C.nul;
+
+      -- Collect all the subprogram calls such that they are compiled
+      -- but not executed
+      --
+      procedure Collect_All_Calls is
+
+         CAC_char           : C.char;
+         CAC_Character      : Character;
+         CAC_String         : string (1..5);
+         CAC_Boolean        : Boolean := false;
+         CAC_char_array     : C.char_array(1..5);
+         CAC_Integer        : integer;
+         CAC_Natural        : natural;
+         CAC_wchar_t        : C.wchar_t;
+         CAC_Wide_Character : Wide_Character;
+         CAC_wchar_array    : C.wchar_array(1..5);
+         CAC_Wide_String    : Wide_String(1..5);
+         CAC_size_t         : C.size_t;
+
+      begin
+
+         CAC_char      := C.To_C (CAC_Character);
+         CAC_Character := C.To_Ada (CAC_char);
+
+         CAC_char_array :=  C.To_C (CAC_String, CAC_Boolean);
+         CAC_String     :=  C.To_Ada (CAC_char_array, CAC_Boolean); 
+
+         -- This call is out of LRM order so that we can use the 
+         -- array initialized above
+         CAC_Boolean  := C.Is_Nul_Terminated (CAC_char_array);
+
+         C.To_C   (CAC_String, CAC_char_array, CAC_size_t, CAC_Boolean);
+         C.To_Ada (CAC_char_array, CAC_String, CAC_Natural, CAC_Boolean); 
+
+         CAC_wchar_t        := C.To_C (CAC_Wide_Character);
+         CAC_Wide_Character := C.To_Ada (CAC_wchar_t); 
+         CAC_wchar_t        := C.wide_nul; 
+
+         CAC_wchar_array :=  C.To_C   (CAC_Wide_String, CAC_Boolean);
+         CAC_Wide_String :=  C.To_Ada (CAC_wchar_array, CAC_Boolean);
+
+         -- This call is out of LRM order so that we can use the 
+         -- array initialized above
+         CAC_Boolean  := C.Is_Nul_Terminated (CAC_wchar_array);
+
+         C.To_C   (CAC_Wide_String, CAC_wchar_array, CAC_size_t,  CAC_Boolean);
+         C.To_Ada (CAC_wchar_array, CAC_Wide_String, CAC_Natural, CAC_Boolean);
+
+         raise C.Terminator_Error;
+
+      end Collect_All_Calls;
+
+
+
+   begin    -- encapsulation
+
+      if  tst_signed_char_min /= C.SCHAR_MIN then
+         Report.Failed  ("tst_signed_char_min is incorrect");
+      end if;
+      if  tst_signed_char_max /= C.SCHAR_MAX then
+         Report.Failed  ("tst_signed_char_max is incorrect");
+      end if;
+      if C.signed_char'Size /= C.CHAR_BIT then
+         Report.Failed  ("C.signed_char'Size is incorrect");
+      end if;
+
+      if C.unsigned_char'first /= 0                or
+         C.unsigned_char'last  /= C.UCHAR_MAX      or
+         C.unsigned_char'size  /= C.CHAR_BIT       then
+
+            Report.Failed  ("unsigned_char is incorrectly defined");
+
+      end if;
+
+      if tst_nul /= C.char'first then
+         Report.Failed  ("tst_nul is incorrect");
+      end if;
+
+   end;     -- encapsulation
+
+   Report.Result;
+
+end CXB3001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3002.a
new file mode 100644
index 000000000..b543d467c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3002.a
@@ -0,0 +1,158 @@
+-- CXB3002.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 specifications of the package Interfaces.C.Strings
+--      are available for use.
+--
+-- TEST DESCRIPTION:
+--      This test verifies that the types and subprograms specified for the
+--      interface are present
+--
+-- APPLICABILITY CRITERIA: 
+--      If an implementation provides packages Interfaces.C and
+--      Interfaces.C.Strings, this test must compile, execute, and 
+--      report "PASSED".
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      28 Feb 96   SAIC    Added applicability criteria.
+--
+--!
+
+with Report;
+with Interfaces.C;                                            -- N/A => ERROR
+with Interfaces.C.Strings;                                    -- N/A => ERROR
+
+procedure CXB3002 is
+   package Strings renames Interfaces.C.Strings;              
+   package C renames Interfaces.C;                            
+
+begin
+
+   Report.Test ("CXB3002", "Check the specification of Interfaces.C.Strings");
+
+
+   declare  -- encapsulate the test
+
+      TC_Int_1      : integer := 1;
+      TC_Int_2      : integer := 1;
+      TC_String     : String := "ABCD";
+      TC_Boolean    : Boolean := true;
+      TC_char_array : C.char_array (1..5);
+      TC_size_t     : C.size_t := C.size_t'first;
+
+
+      --  Note In all of the following the Strings spec. being tested
+      --  is shown in comment lines
+      -- 
+      --    type char_array_access is access all char_array;
+      TST_char_array_access :  Strings.char_array_access := 
+                                       new Interfaces.C.char_array (1..5);
+
+      --    type chars_ptr is private;
+      --    Null_Ptr : constant chars_ptr;
+      TST_chars_ptr : Strings.chars_ptr := Strings.Null_ptr;
+
+      --  type chars_ptr_array is array (size_t range <>) of chars_ptr;
+      TST_chars_ptr_array : Strings.chars_ptr_array(1..5);
+
+   begin    -- encapsulation
+
+      -- Arrange that the calls to the subprograms are compiled but
+      -- not executed
+      -- 
+      if not Report.Equal ( TC_Int_1, TC_Int_2 ) then
+
+         --    function To_Chars_Ptr (Item      : in char_array_access;
+         --                           Nul_Check : in Boolean := False)
+         --       return chars_ptr;
+         TST_chars_ptr := Strings.To_Chars_Ptr 
+                                          (TST_char_array_access, TC_Boolean); 
+
+         --    This one is out of LRM order so that we can "initialize"
+         --    TC_char_array for the "in" parameter of the next one
+         -- 
+         --    function Value (Item : in chars_ptr) return char_array;
+         TC_char_array := Strings.Value (TST_chars_ptr);
+
+         --    function New_Char_Array (Chars   : in char_array) 
+         --       return chars_ptr;
+         TST_chars_ptr := Strings.New_Char_Array (TC_char_array); 
+
+         --    function New_String (Str : in String) return chars_ptr;
+         TST_chars_ptr := Strings.New_String ("TEST STRING");
+
+         --    procedure Free (Item : in out chars_ptr);
+         Strings.Free (TST_chars_ptr);
+
+         --    function Value (Item : in chars_ptr; Length : in size_t)
+         --       return char_array;
+         TC_char_array := Strings.Value (TST_chars_ptr, TC_size_t);
+
+         -- Use Report.Comment as a known procedure which takes a string as
+         -- a parameter (this does not actually get output)
+         --    function Value (Item : in chars_ptr) return String;
+         Report.Comment ( Strings.Value (TST_chars_ptr) );
+
+         --    function Value (Item : in chars_ptr; Length : in size_t) 
+         --       return String;
+         TC_String := Strings.Value (TST_chars_ptr, TC_size_t);
+
+         --    function Strlen (Item : in chars_ptr) return size_t;
+         TC_size_t := Strings.Strlen (TST_chars_ptr);
+
+         --    procedure Update (Item   : in chars_ptr;
+         --                      Offset : in size_t;
+         --                      Chars  : in char_array;
+         --                      Check  : in Boolean := True);
+         Strings.Update (TST_chars_ptr, TC_size_t, TC_char_array, TC_Boolean);
+
+         --    procedure Update (Item   : in chars_ptr;
+         --                      Offset : in size_t;
+         --                      Str    : in String;
+         --                      Check  : in Boolean := True);
+         Strings.Update (TST_chars_ptr, TC_size_t, TC_String, TC_Boolean);
+
+         --    Update_Error : exception;
+         raise Strings.Update_Error;
+         
+      end if;
+
+      if not Report.Equal ( TC_Int_2, TC_Int_1 ) then
+
+         -- This exception is out of LRM presentation order to avoid
+         -- compiler warnings about unreachable code
+         --    Dereference_Error : exception;
+         raise Strings.Dereference_Error;
+
+      end if;
+
+   end;     -- encapsulation
+
+   Report.Result;
+
+end CXB3002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3003.a
new file mode 100644
index 000000000..c39583748
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3003.a
@@ -0,0 +1,167 @@
+-- CXB3003.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 specifications of the package Interfaces.C.Pointers
+--      are available for use.
+--
+-- TEST DESCRIPTION:
+--      This test verifies that the types and subprograms specified for the
+--      interface are present
+--
+-- APPLICABILITY CRITERIA: 
+--      If an implementation provides package Interfaces.C.Pointers, this
+--      test must compile, execute, and report "PASSED".
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      28 Feb 96   SAIC    Added applicability criteria.
+--
+--!
+
+with Report;
+with Interfaces.C.Pointers;                                   -- N/A => ERROR
+
+procedure CXB3003 is
+   package C renames Interfaces.C;
+
+   package Test_Ptrs is new C.Pointers
+                        (Index               => C.size_t,
+                         Element             => C.Char,
+                         Element_Array       => C.Char_Array,
+                         Default_Terminator  => C.Nul);  
+   
+begin
+
+   Report.Test ("CXB3003", "Check the specification of Interfaces.C.Pointers");
+
+
+   declare  -- encapsulate the test
+
+      TC_Int        : integer := 1;
+
+      --  Note:  In all of the following the Pointers spec. being tested
+      --  is shown in comments
+      -- 
+      --    type Pointer is access all Element;
+      subtype TST_Pointer_Type is Test_Ptrs.Pointer;
+
+      TST_Element   : C.Char           := C.Char'First;
+      TST_Pointer   : TST_Pointer_Type := null;
+      TST_Pointer_2 : TST_Pointer_Type := null;  
+      TST_Array     : C.char_array (1..5);
+      TST_Index     : C.ptrdiff_t      := C.ptrdiff_t'First;
+
+   begin    -- encapsulation
+
+      -- Arrange that the calls to the subprograms are compiled but
+      -- not executed
+      -- 
+      if not Report.Equal ( TC_Int, TC_Int ) then
+         
+
+         --    function Value (Ref        : in Pointer;
+         --                    Terminator : in Element := Default_Terminator)
+         --      return Element_Array;
+
+         TST_Array := Test_Ptrs.Value ( TST_Pointer );  -- default
+         TST_Array := Test_Ptrs.Value ( TST_Pointer, TST_Element ); 
+
+         --    function Value (Ref    : in Pointer; Length : in ptrdiff_t)
+         --      return Element_Array;
+
+         TST_Array := Test_Ptrs.Value (TST_Pointer, TST_Index);
+
+         -- 
+         --    --  C-style Pointer arithmetic
+         -- 
+         --    function "+" (Left : in Pointer;   Right : in ptrdiff_t) 
+         --                                                 return Pointer;
+         TST_Pointer := Test_Ptrs."+" (TST_Pointer, TST_Index); 
+
+         --    function "+" (Left : in Ptrdiff_T; Right : in Pointer)   
+         --                                                 return Pointer;
+         TST_Pointer := Test_Ptrs."+" (TST_Index, TST_Pointer); 
+
+         --    function "-" (Left : in Pointer;   Right : in ptrdiff_t) 
+         --                                                 return Pointer;
+         TST_Pointer := Test_Ptrs."-" (TST_Pointer, TST_Index); 
+
+         --    function "-" (Left : in Pointer;   Right : in Pointer)  
+         --                                                 return ptrdiff_t;
+         TST_Index  := Test_Ptrs."-" (TST_Pointer, TST_Pointer);
+
+         --    procedure Increment (Ref : in out Pointer);
+         Test_Ptrs.Increment (TST_Pointer);
+
+         --    procedure Decrement (Ref : in out Pointer);
+         Test_Ptrs.Decrement (TST_Pointer);
+
+         --    function Virtual_Length 
+         --                 ( Ref        : in Pointer;
+         --                   Terminator : in Element := Default_Terminator)
+         --      return ptrdiff_t;
+         TST_Index := Test_Ptrs.Virtual_Length (TST_Pointer);
+         TST_Index := Test_Ptrs.Virtual_Length (TST_Pointer, TST_Element);
+
+         --    procedure Copy_Terminated_Array
+         --      (Source     : in Pointer;
+         --       Target     : in Pointer;
+         --       Limit      : in ptrdiff_t := ptrdiff_t'Last;  
+         --       Terminator : in Element := Default_Terminator);
+
+         Test_Ptrs.Copy_Terminated_Array (TST_Pointer, TST_Pointer_2);
+
+         Test_Ptrs.Copy_Terminated_Array (TST_Pointer,
+                                          TST_Pointer_2,
+                                          TST_Index);
+
+         Test_Ptrs.Copy_Terminated_Array (TST_Pointer, 
+                                          TST_Pointer_2,
+                                          TST_Index, 
+                                          TST_Element);
+
+
+         --    procedure Copy_Array
+         --      (Source  : in Pointer;
+         --       Target  : in Pointer;
+         --       Length  : in ptrdiff_t);
+         
+         Test_Ptrs.Copy_Array (TST_Pointer, TST_Pointer_2, TST_Index);
+
+         --    This is out of LRM order to avoid complaints from compilers 
+         --    about inaccessible code
+         --       Pointer_Error : exception;
+
+         raise Test_Ptrs.Pointer_Error;
+
+      end if;
+
+   end;     -- encapsulation
+
+   Report.Result;
+
+end CXB3003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30040.c b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30040.c
new file mode 100644
index 000000000..1e96e4a57
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30040.c
@@ -0,0 +1,172 @@
+/*
+-- CXB30040.C
+--
+--                             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.
+--*
+--
+-- FUNCTION NAME: CXB30040   ("char_gen")
+--
+-- FUNCTION DESCRIPTION:
+--      This C function returns the value of type char corresponding to the
+--      value of its parameter, where
+--          Val  0 ..  9 ==> '0' .. '9'
+--          Val 10 .. 19 ==> 'A' .. 'J'
+--          Val 20 .. 29 ==> 'k' .. 't'
+--          Val 30       ==> ' '
+--          Val 31       ==> '.'
+--          Val 32       ==> ','
+--
+-- INPUT:
+--      This function requires that one int parameter be passed to it.
+--
+-- OUTPUT:
+--      The function will return the appropriate value of type char.
+--
+-- CHANGE HISTORY:
+--      13 Sep 99   RLB     Created function to replace incorrect
+--                          Unchecked_Conversion.
+--
+--!
+*/
+
+char CXB30040 (int val)
+
+/* NOTE: The above function definition should be accepted by an ANSI-C   */
+/*       compiler.  Older C compilers may reject it; they may, however   */
+/*       accept the following two lines.  An implementation may comment  */
+/*       out the above function definition and uncomment the following   */
+/*       one.  Otherwise, an implementation must provide the necessary   */
+/*       modifications to this C code to satisfy the function            */
+/*       requirements (see Function Description).                        */
+/*                                                                       */
+/*  char CXB30040 (val)                                                  */
+/*     int     val;                                                      */
+/*                                                                       */
+
+{  char return_value = ';';
+
+   switch (val)
+   {
+      case 0:
+         return_value = '0';
+         break;
+      case 1:
+         return_value = '1';
+         break;
+      case 2:
+         return_value = '2';
+         break;
+      case 3:
+         return_value = '3';
+         break;
+      case 4:
+         return_value = '4';
+         break;
+      case 5:
+         return_value = '5';
+         break;
+      case 6:
+         return_value = '6';
+         break;
+      case 7:
+         return_value = '7';
+         break;
+      case 8:
+         return_value = '8';
+         break;
+      case 9:
+         return_value = '9';
+         break;
+      case 10:
+         return_value = 'A';
+         break;
+      case 11:
+         return_value = 'B';
+         break;
+      case 12:
+         return_value = 'C';
+         break;
+      case 13:
+         return_value = 'D';
+         break;
+      case 14:
+         return_value = 'E';
+         break;
+      case 15:
+         return_value = 'F';
+         break;
+      case 16:
+         return_value = 'G';
+         break;
+      case 17:
+         return_value = 'H';
+         break;
+      case 18:
+         return_value = 'I';
+         break;
+      case 19:
+         return_value = 'J';
+         break;
+      case 20:
+         return_value = 'k';
+         break;
+      case 21:
+         return_value = 'l';
+         break;
+      case 22:
+         return_value = 'm';
+         break;
+      case 23:
+         return_value = 'n';
+         break;
+      case 24:
+         return_value = 'o';
+         break;
+      case 25:
+         return_value = 'p';
+         break;
+      case 26:
+         return_value = 'q';
+         break;
+      case 27:
+         return_value = 'r';
+         break;
+      case 28:
+         return_value = 's';
+         break;
+      case 29:
+         return_value = 't';
+         break;
+      case 30:
+         return_value = ' ';
+         break;
+      case 31:
+         return_value = '.';
+         break;
+      case 32:
+         return_value = ',';
+         break;
+   }
+
+   return (return_value); /* Return character value */
+}
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30041.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30041.am
new file mode 100644
index 000000000..73b874e1f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30041.am
@@ -0,0 +1,377 @@
+-- CXB30041.AM
+--
+--                             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 functions To_C and To_Ada map between the Ada type
+--      Character and the C type char.
+--
+--      Check that the function Is_Nul_Terminated returns True if the
+--      char_array parameter contains nul, and otherwise False.
+--
+--      Check that the function To_C produces a correct char_array result,
+--      with lower bound of 0, and length dependent upon the Item and
+--      Append_Nul parameters.
+--
+--      Check that the function To_Ada produces a correct string result, with
+--      lower bound of 1, and length dependent upon the Item and Trim_Nul
+--      parameters.
+--
+--      Check that the function To_Ada raises Terminator_Error if the
+--      parameter Trim_Nul is set to True, but the actual Item parameter
+--      does not contain the nul char.
+--
+-- TEST DESCRIPTION:
+--      This test uses a variety of Character, char, String, and char_array
+--      objects to test versions of the To_C, To_Ada, and Is_Nul_Terminated
+--      functions.
+--
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', ',', '.', '0'..'9', 'a'..'z' and 'A'..'Z'.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations that provide
+--      package Interfaces.C.  If an implementation provides
+--      package Interfaces.C, this test must compile, execute, and
+--      report "PASSED".
+--
+-- SPECIAL REQUIREMENTS:
+--      The file CXB30040.C must be compiled with a C compiler.
+--      Implementation dialects of C may require alteration of
+--      the C program syntax (see individual C files).
+--
+--      Note that the compiled C code must be bound with the compiled Ada
+--      code to create an executable image.  An implementation must provide
+--      the necessary commands to accomplish this.
+--
+--      Note that the C code included in CXB30040.C conforms
+--      to ANSI-C.  Modifications to these files may be required for other
+--      C compilers.  An implementation must provide the necessary
+--      modifications to satisfy the function requirements.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         CXB30040.C
+--         CXB30041.AM
+--
+-- CHANGE HISTORY:
+--      30 Aug 95   SAIC    Initial prerelease version.
+--      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Incorporated reviewer comments.
+--      13 Sep 99   RLB     Replaced (bogus) Unchecked_Conversions with a
+--                          C function character generator.
+--
+--!
+
+with Report;
+with Interfaces.C;                                            -- N/A => ERROR
+with Ada.Characters.Latin_1;
+with Ada.Exceptions;
+with Ada.Strings.Fixed;
+with Impdef;
+
+procedure CXB30041 is
+begin
+
+   Report.Test ("CXB3004", "Check that the functions To_C and To_Ada " &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      use Interfaces, Interfaces.C;
+      use Ada.Characters, Ada.Characters.Latin_1;
+      use Ada.Exceptions;
+      use Ada.Strings.Fixed;
+
+      Start_Character,
+      Stop_Character,
+      TC_Character    : Character         := Character'First;
+      TC_char,
+      TC_Low_char,
+      TC_High_char    : char              := char'First;
+      TC_String       : String(1..8)      := (others => Latin_1.NUL);
+      TC_char_array   : char_array(0..7)  := (others => C.nul);
+
+      -- The function Char_Gen returns a character corresponding to its
+      -- argument.
+      --     Value   0 ..  9 ==> '0' .. '9'
+      --     Value  10 .. 19 ==> 'A' .. 'J'
+      --     Value  20 .. 29 ==> 'k' .. 't'
+      --     Value  30       ==> ' '
+      --     Value  31       ==> '.'
+      --     Value  32       ==> ','
+
+      function Char_Gen (Value   : in int) return char;
+
+      -- Use the user-defined C function char_gen as a completion to the
+      -- function specification above.
+
+      pragma Import (Convention    => C,
+                     Entity        => Char_Gen,
+                     External_Name => Impdef.CXB30040_External_Name);
+
+   begin
+
+      -- Check that the functions To_C and To_Ada map between the Ada type
+      -- Character and the C type char.
+
+      if To_C(Ada.Characters.Latin_1.NUL) /= Interfaces.C.nul then
+         Report.Failed("Incorrect result from To_C with NUL character input");
+      end if;
+
+      Start_Character := Report.Ident_Char('k');
+      Stop_Character  := Report.Ident_Char('t');
+      for TC_Character in Start_Character..Stop_Character loop
+         if To_C(Item => TC_Character) /=
+            Char_Gen(Character'Pos(TC_Character) - Character'Pos('k') + 20) then
+            Report.Failed("Incorrect result from To_C with lower case " &
+                          "alphabetic character input");
+         end if;
+      end loop;
+
+      Start_Character := Report.Ident_Char('A');
+      Stop_Character  := Report.Ident_Char('J');
+      for TC_Character in Start_Character..Stop_Character loop
+         if To_C(Item => TC_Character) /=
+            Char_Gen(Character'Pos(TC_Character) - Character'Pos('A') + 10) then
+            Report.Failed("Incorrect result from To_C with upper case " &
+                          "alphabetic character input");
+         end if;
+      end loop;
+
+      Start_Character := Report.Ident_Char('0');
+      Stop_Character  := Report.Ident_Char('9');
+      for TC_Character in Start_Character..Stop_Character loop
+         if To_C(Item => TC_Character) /=
+            Char_Gen(Character'Pos(TC_Character) - Character'Pos('0')) then
+            Report.Failed("Incorrect result from To_C with digit " &
+                          "character input");
+         end if;
+      end loop;
+      if To_C(Item => ' ') /= Char_Gen(30) then
+         Report.Failed("Incorrect result from To_C with space " &
+                       "character input");
+      end if;
+      if To_C(Item => '.') /= Char_Gen(31) then
+         Report.Failed("Incorrect result from To_C with dot " &
+                       "character input");
+      end if;
+      if To_C(Item => ',') /= Char_Gen(32) then
+         Report.Failed("Incorrect result from To_C with comma " &
+                       "character input");
+      end if;
+
+      if To_Ada(Interfaces.C.nul) /= Ada.Characters.Latin_1.NUL then
+         Report.Failed("Incorrect result from To_Ada with nul char input");
+      end if;
+
+      for Code in int range
+         int(Report.Ident_Int(20)) .. int(Report.Ident_Int(29)) loop
+            -- 'k' .. 't'
+         if To_Ada(Item => Char_Gen(Code)) /=
+	    Character'Val (Character'Pos('k') + (Code - 20)) then
+            Report.Failed("Incorrect result from To_Ada with lower case " &
+                          "alphabetic char input");
+         end if;
+      end loop;
+
+      for Code in int range
+         int(Report.Ident_Int(10)) .. int(Report.Ident_Int(19)) loop
+            -- 'A' .. 'J'
+         if To_Ada(Item => Char_Gen(Code)) /=
+	    Character'Val (Character'Pos('A') + (Code - 10)) then
+            Report.Failed("Incorrect result from To_Ada with upper case " &
+                          "alphabetic char input");
+         end if;
+      end loop;
+
+      for Code in int range
+         int(Report.Ident_Int(0)) .. int(Report.Ident_Int(9)) loop
+            -- '0' .. '9'
+         if To_Ada(Item => Char_Gen(Code)) /=
+	    Character'Val (Character'Pos('0') + (Code)) then
+            Report.Failed("Incorrect result from To_Ada with digit " &
+                          "char input");
+         end if;
+      end loop;
+
+      if To_Ada(Item => Char_Gen(30)) /= ' ' then
+         Report.Failed("Incorrect result from To_Ada with space " &
+                       "char input");
+      end if;
+      if To_Ada(Item => Char_Gen(31)) /= '.' then
+         Report.Failed("Incorrect result from To_Ada with dot " &
+                       "char input");
+      end if;
+      if To_Ada(Item => Char_Gen(32)) /= ',' then
+         Report.Failed("Incorrect result from To_Ada with comma " &
+                       "char input");
+      end if;
+
+      -- Check that the function Is_Nul_Terminated produces correct results
+      -- whether or not the char_array argument contains the
+      -- Ada.Interfaces.C.nul character.
+
+      TC_String := "abcdefgh";
+      if Is_Nul_Terminated(Item => To_C(TC_String, Append_Nul => False)) then
+         Report.Failed("Incorrect result from Is_Nul_Terminated when no " &
+                       "nul char is present");
+      end if;
+
+      if not Is_Nul_Terminated(To_C(TC_String, Append_Nul => True)) then
+         Report.Failed("Incorrect result from Is_Nul_Terminated when the " &
+                       "nul char is present");
+      end if;
+
+
+      -- Now that we've tested the character/char versions of To_Ada and To_C,
+      -- use them to test the string versions.
+
+      declare
+         i                    : size_t  := 0;
+         j                    : integer := 1;
+         Incorrect_Conversion : Boolean := False;
+
+         TC_No_nul       : constant char_array := To_C(TC_String, False);
+         TC_nul_Appended : constant char_array := To_C(TC_String, True);
+      begin
+
+         -- Check that the function To_C produces a char_array result with
+         -- lower bound of 0, and length dependent upon the Item and
+         -- Append_Nul parameters (if Append_Nul is True, length is
+         -- Item'Length + 1; if False, length is Item'Length).
+
+         if TC_No_nul'First /= 0 or TC_nul_Appended'First /= 0 then
+            Report.Failed("Incorrect lower bound from Function To_C");
+         end if;
+
+         if TC_No_nul'Length /= TC_String'Length then
+            Report.Failed("Incorrect length returned from Function To_C " &
+                          "when Append_Nul => False");
+         end if;
+
+         for TC_char in Report.Ident_Char('a')..Report.Ident_Char('h') loop
+            if TC_No_nul(i)       /= To_C(TC_char) or -- Single character To_C.
+               TC_nul_Appended(i) /= To_C(TC_char) then
+               Incorrect_Conversion := True;
+            end if;
+            i := i + 1;
+         end loop;
+
+         if Incorrect_Conversion then
+            Report.Failed("Incorrect result from To_C with string input " &
+                          "and char_array result");
+         end if;
+
+
+         if TC_nul_Appended'Length /= TC_String'Length + 1 then
+            Report.Failed("Incorrect length returned from Function To_C " &
+                          "when Append_Nul => True");
+         end if;
+
+         if not Is_Nul_Terminated(TC_nul_Appended) then
+            Report.Failed("No nul appended to the string parameter during " &
+                          "conversion to char_array by function To_C");
+         end if;
+
+
+         -- Check that the function To_Ada produces a string result with
+         -- lower bound of 1, and length dependent upon the Item and
+         -- Trim_Nul parameters (if Trim_Nul is False, length is Item'Length;
+         -- if True, length will be the length of the slice of Item prior to
+         -- the first nul).
+
+         declare
+            TC_No_NUL_String       : constant String :=
+                                       To_Ada(Item     => TC_nul_Appended,
+                                              Trim_Nul => True);
+            TC_NUL_Appended_String : constant String :=
+                                       To_Ada(TC_nul_Appended, False);
+         begin
+
+            if TC_No_NUL_String'First       /= 1 or
+               TC_NUL_Appended_String'First /= 1
+            then
+               Report.Failed("Incorrect lower bound from Function To_Ada");
+            end if;
+
+            if TC_No_NUL_String'Length /= TC_String'Length then
+               Report.Failed("Incorrect length returned from Function " &
+                             "To_Ada when Trim_Nul => True");
+            end if;
+
+            if TC_NUL_Appended_String'Length /= TC_String'Length + 1 then
+               Report.Failed("Incorrect length returned from Function " &
+                             "To_Ada when Trim_Nul => False");
+            end if;
+
+            Start_Character := Report.Ident_Char('a');
+            Stop_Character  := Report.Ident_Char('h');
+            for TC_Character in Start_Character..Stop_Character loop
+               if TC_No_NUL_String(j)       /= TC_Character or
+                  TC_NUL_Appended_String(j) /= TC_Character
+               then
+                  Report.Failed("Incorrect result from To_Ada with " &
+                                "char_array input, index = "         &
+                                Integer'Image(j));
+               end if;
+               j := j + 1;
+            end loop;
+
+         end;
+
+
+         -- Check that the function To_Ada raises Terminator_Error if the
+         -- parameter Trim_Nul is set to True, but the actual Item parameter
+         -- does not contain the nul char.
+
+         begin
+            TC_String := To_Ada(TC_No_nul, Trim_Nul => True);
+            Report.Failed("Terminator_Error not raised when Item "    &
+                          "parameter of To_Ada does not contain the " &
+                          "nul char, but parameter Trim_Nul => True");
+            Report.Comment(TC_String & " printed to defeat optimization");
+         exception
+            when Terminator_Error => null;  -- OK, expected exception.
+            when others           =>
+               Report.Failed("Incorrect exception raised by function "  &
+                             "To_Ada when the Item parameter does not " &
+                             "contain the nul char, but parameter "     &
+                             "Trim_Nul => True");
+         end;
+
+      end;
+
+   exception
+      when The_Error : others =>
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB30041;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a
new file mode 100644
index 000000000..30b940535
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3005.a
@@ -0,0 +1,396 @@
+-- CXB3005.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 procedure To_C converts the character elements of
+--      a string parameter into char elements of the char_array parameter
+--      Target, with nul termination if parameter Append_Nul is true.
+--
+--      Check that the out parameter Count of procedure To_C is set to the
+--      appropriate value for both the nul/no nul terminated cases.
+--
+--      Check that Constraint_Error is propagated by procedure To_C if the
+--      length of the char_array parameter Target is not sufficient to
+--      hold the converted string value.
+--
+--      Check that the Procedure To_Ada converts char elements of the
+--      char_array parameter Item to the corresponding character elements
+--      of string out parameter Target.
+--
+--      Check that Constraint_Error is propagated by Procedure To_Ada if the
+--      length of string parameter Target is not long enough to hold the
+--      converted char_array value.
+--
+--      Check that Terminator_Error is propagated by Procedure To_Ada if the
+--      parameter Trim_Nul is set to True, but the actual Item parameter
+--      contains no nul char.
+--
+-- TEST DESCRIPTION:
+--      This test uses a variety of String, and char_array objects to test
+--      versions of the To_C and To_Ada procedures.
+--
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', 'a'..'z', 'A'..'Z', '0'..'9', and '-'.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations that provide
+--      package Interfaces.C.  If an implementation provides
+--      package Interfaces.C, this test must compile, execute, and
+--      report "PASSED".
+--
+-- CHANGE HISTORY:
+--      01 Sep 95   SAIC    Initial prerelease version.
+--      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Incorporated reviewer comments.
+--      14 Sep 99   RLB     Removed incorrect and unnecessary
+--                          Unchecked_Conversion.
+--
+--!
+
+with Report;
+with Interfaces.C;                                            -- N/A => ERROR
+with Ada.Characters.Latin_1;
+with Ada.Exceptions;
+with Ada.Strings.Fixed;
+
+procedure CXB3005 is
+begin
+
+   Report.Test ("CXB3005", "Check that the procedures To_C and To_Ada " &
+                           "produce correct results");
+   Test_Block:
+   declare
+
+      use Interfaces, Interfaces.C;
+      use Ada.Characters;
+      use Ada.Exceptions;
+      use Ada.Strings.Fixed;
+
+      TC_Short_String  : String(1..4)     := (others => 'x');
+      TC_String        : String(1..8)     := (others => 'y');
+      TC_char_array    : char_array(0..7) := (others => char'Last);
+      TC_size_t_Count  : size_t           := size_t'First;
+      TC_Natural_Count : Natural          := Natural'First;
+
+
+      -- We can use the character forms of To_Ada and To_C here to check
+      -- the results; they were tested in CXB3004. We give them different
+      -- names to avoid confusion below.
+
+      function Character_to_char (Source : in Character) return char
+          renames To_C;
+      function char_to_Character (Source : in char) return Character
+          renames To_Ada;
+
+   begin
+
+      -- Check that the procedure To_C converts the character elements of
+      -- a string parameter into char elements of char_array out parameter
+      -- Target.
+      --
+      -- Case of nul termination.
+
+      TC_String(1..6) := "abcdef";
+
+      To_C (Item       => TC_String(1..6),  -- Source slice of length 6.
+            Target     => TC_char_array,    -- Length 8 will accommodate nul.
+            Count      => TC_size_t_Count,
+            Append_Nul => True);
+
+      -- Check that the out parameter Count is set to the appropriate value
+      -- for the nul terminated case.
+
+      if TC_size_t_Count /= 7 then
+         Report.Failed("Incorrect setting of out parameter Count by " &
+                       "Procedure To_C when Append_Nul => True");
+      end if;
+
+      for i in 1..TC_size_t_Count-1 loop
+         if char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
+         then
+            Report.Failed("Incorrect result from Procedure To_C when " &
+                          "checking individual char values, case of "  &
+                          "Append_Nul => True; "                       &
+                          "char position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if not Is_Nul_Terminated(TC_char_array) then
+         Report.Failed("No nul char appended to the char_array result " &
+                       "from Procedure To_C when Append_Nul => True");
+      end if;
+
+      if TC_char_array(0..6) /= To_C("abcdef", True) then
+         Report.Failed("Incorrect result from Procedure To_C when "   &
+                       "directly comparing char_array results, case " &
+                       "of Append_Nul => True");
+      end if;
+
+
+      -- Check Procedure To_C with no nul termination.
+
+      TC_char_array   := (others => Character_to_char('M')); -- Reinitialize.
+      TC_String(1..4) := "WXYZ";
+
+      To_C (Item       => TC_String(1..4),  -- Source slice of length 4.
+            Target     => TC_char_array,
+            Count      => TC_size_t_Count,
+            Append_Nul => False);
+
+      -- Check that the out parameter Count is set to the appropriate value
+      -- for the non-nul terminated case.
+
+      if TC_size_t_Count /= 4 then
+         Report.Failed("Incorrect setting of out parameter Count by " &
+                       "Procedure To_C when Append_Nul => False");
+      end if;
+
+      for i in 1..TC_size_t_Count loop
+         if char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
+         then
+            Report.Failed("Incorrect result from Procedure To_C when " &
+                          "checking individual char values, case of "  &
+                          "Append_Nul => False; "                      &
+                          "char position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if Is_Nul_Terminated(TC_char_array) then
+         Report.Failed("The nul char was appended to the char_array " &
+                       "result of Procedure To_C when Append_Nul => False");
+      end if;
+
+      if TC_char_array(0..3) /= To_C("WXYZ", False) then
+         Report.Failed("Incorrect result from Procedure To_C when "   &
+                       "directly comparing char_array results, case " &
+                       "of Append_Nul => False");
+      end if;
+
+
+
+      -- Check that Constraint_Error is raised by procedure To_C if the
+      -- length of the target char_array parameter is not sufficient to
+      -- hold the converted string value (plus nul if Append_Nul is True).
+
+      begin
+         To_C("A string too long",
+              TC_char_array,
+              TC_size_t_Count,
+              Append_Nul => True);
+
+         Report.Failed("Constraint_Error not raised when the Target " &
+                       "parameter of Procedure To_C is not long enough " &
+                       "to hold the converted string");
+         Report.Comment(char_to_Character(TC_char_array(0)) &
+                        " printed to defeat optimization");
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by Procedure "    &
+                          "To_C when the Target parameter is not long " &
+                          "enough to contain the char_array result");
+      end;
+
+
+
+      -- Check that the procedure To_Ada converts char elements of the
+      -- char_array parameter Item to the corresponding character elements
+      -- of string out parameter Target, with result string length based on
+      -- the Trim_Nul parameter.
+      --
+      -- Case of appended nul char on the char_array In parameter.
+
+      TC_char_array := To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.
+      TC_String     := (others => '*');                      -- Reinitialize.
+
+      To_Ada (Item     => TC_char_array,
+              Target   => TC_String,
+              Count    => TC_Natural_Count,
+              Trim_Nul => False);
+
+      if TC_Natural_Count /= 8 then
+         Report.Failed("Incorrect value returned in out parameter Count " &
+                       "by Procedure To_Ada, case of Trim_Nul => False");
+      end if;
+
+      for i in 1..TC_Natural_Count loop
+         if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
+         then
+            Report.Failed("Incorrect result from Procedure To_Ada when " &
+                          "checking individual char values, case of "    &
+                          "Trim_Nul => False, when a nul is present in " &
+                          "the char_array input parameter; "             &
+                          "position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if TC_String(TC_Natural_Count) /= Latin_1.Nul then
+         Report.Failed("Last character of String result of Procedure "     &
+                       "To_Ada is not Nul, even though a nul was present " &
+                       "in the char_array argument, and the Trim_Nul "     &
+                       "parameter was set to False");
+      end if;
+
+
+      TC_char_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
+      TC_String           := (others => '*');                  -- Reinit.
+
+      To_Ada (Item     => TC_char_array,
+              Target   => TC_String,
+              Count    => TC_Natural_Count,
+              Trim_Nul => True);
+
+      if TC_Natural_Count /= 3 then
+         Report.Failed("Incorrect value returned in out parameter Count " &
+                       "by Procedure To_Ada, case of Trim_Nul => True");
+      end if;
+
+      for i in 1..TC_Natural_Count loop
+         if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
+         then
+            Report.Failed("Incorrect result from Procedure To_Ada when " &
+                          "checking individual char values, case of "    &
+                          "Trim_Nul => True, when a nul is present in "  &
+                          "the char_array input parameter; "             &
+                          "position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if TC_String(TC_Natural_Count) = Latin_1.Nul then
+         Report.Failed("Last character of String result of Procedure " &
+                       "To_Ada is  Nul, even though the Trim_Nul "     &
+                       "parameter was set to True");
+      end if;
+
+      -- Check that TC_String(TC_Natural_Count+1) is unchanged by procedure
+      -- To_Ada.
+
+      if TC_String(TC_Natural_Count+1) /= '*' then
+         Report.Failed("Incorrect modification to TC_String at position " &
+                       Integer'Image(TC_Natural_Count+1) & " expected = " &
+                       "*, found = " & TC_String(TC_Natural_Count+1));
+      end if;
+
+
+      -- Case of no nul char being present in the char_array argument.
+
+      TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
+      TC_String     := (others => '*');                  -- Reinitialize.
+
+      To_Ada (Item     => TC_char_array,
+              Target   => TC_String,
+              Count    => TC_Natural_Count,
+              Trim_Nul => False);
+
+      if TC_Natural_Count /= 8 then
+         Report.Failed("Incorrect value returned in out parameter Count " &
+                       "by Procedure To_Ada, case of Trim_Nul => False, " &
+                       "with no nul char present in the parameter Item");
+      end if;
+
+      for i in 1..TC_Natural_Count loop
+         if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
+         then
+            Report.Failed("Incorrect result from Procedure To_Ada when "  &
+                          "checking individual char values, case of "     &
+                          "Trim_Nul => False, when a nul is not present " &
+                          "in the char_array input parameter; "           &
+                          "position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if TC_String(TC_Natural_Count) = Latin_1.Nul then
+         Report.Failed("Last character of String result of Procedure " &
+                       "To_Ada is Nul, even though the nul char was "  &
+                       "not present in the parameter Item, with the "  &
+                       "parameter Trim_Nul => False");
+      end if;
+
+
+
+      -- Check that the Procedure To_Ada raises Terminator_Error if the
+      -- parameter Trim_Nul is set to True, but the actual Item parameter
+      -- does not contain the nul char.
+
+      begin
+         TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
+         TC_String     := (others => '*');
+
+         To_Ada(TC_char_array,
+                TC_String,
+                Count    => TC_Natural_Count,
+                Trim_Nul => True);
+
+         Report.Failed("Terminator_Error not raised when Item "    &
+                       "parameter of To_Ada does not contain the " &
+                       "nul char, but parameter Trim_Nul => True");
+         Report.Comment(TC_String & " printed to defeat optimization");
+      exception
+         when Terminator_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by Procedure " &
+                          "To_Ada when the Item parameter does not " &
+                          "contain the nul char, but parameter "     &
+                          "Trim_Nul => True");
+      end;
+
+
+
+      -- Check that Constraint_Error is propagated by procedure To_Ada if the
+      -- length of string parameter Target is not long enough to hold the
+      -- converted char_array value (plus nul if Trim_Nul is False).
+
+      begin
+         TC_char_array(0..4) := To_C ("ABCD", Append_Nul => True);
+
+         To_Ada(TC_char_array(0..4),   -- 4 chars plus nul char.
+                TC_Short_String,       -- Length of 4.
+                Count    => TC_Natural_Count,
+                Trim_Nul => False);
+
+         Report.Failed("Constraint_Error not raised when string "     &
+                       "parameter Target of Procedure To_Ada is not " &
+                       "long enough to hold the converted chars");
+         Report.Comment(TC_Short_String & " printed to defeat optimization");
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by Procedure " &
+                          "To_Ada when string parameter Target is "  &
+                          "not long enough to hold the converted chars");
+      end;
+
+
+
+   exception
+      when The_Error : others =>
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30060.c b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30060.c
new file mode 100644
index 000000000..c4df00868
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30060.c
@@ -0,0 +1,174 @@
+/*
+-- CXB30060.C
+--
+--                             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.
+--*
+--
+-- FUNCTION NAME: CXB30060   ("wchar_gen")
+--
+-- FUNCTION DESCRIPTION:
+--      This C function returns the value of type wchar_t corresponding to the
+--      value of its parameter, where
+--          Val  0 ..  9 ==> '0' .. '9'
+--          Val 10 .. 19 ==> 'A' .. 'J'
+--          Val 20 .. 29 ==> 'k' .. 't'
+--          Val 30       ==> ' '
+--          Val 31       ==> '.'
+--          Val 32       ==> ','
+--
+-- INPUT:
+--      This function requires that one int parameter be passed to it.
+--
+-- OUTPUT:
+--      The function will return the appropriate value of type wchar_t.
+--
+-- CHANGE HISTORY:
+--      13 Sep 99   RLB     Created function to replace incorrect
+--                          Unchecked_Conversion.
+--
+--!
+*/
+
+#include <stddef.h>
+
+wchar_t CXB30060 (int val)
+
+/* NOTE: The above function definition should be accepted by an ANSI-C   */
+/*       compiler.  Older C compilers may reject it; they may, however   */
+/*       accept the following two lines.  An implementation may comment  */
+/*       out the above function definition and uncomment the following   */
+/*       one.  Otherwise, an implementation must provide the necessary   */
+/*       modifications to this C code to satisfy the function            */
+/*       requirements (see Function Description).                        */
+/*                                                                       */
+/*  wchar_t CXB30060 (val)                                               */
+/*     int     val;                                                      */
+/*                                                                       */
+
+{  wchar_t return_value = ';';
+
+   switch (val)
+   {
+      case 0:
+         return_value = '0';
+         break;
+      case 1:
+         return_value = '1';
+         break;
+      case 2:
+         return_value = '2';
+         break;
+      case 3:
+         return_value = '3';
+         break;
+      case 4:
+         return_value = '4';
+         break;
+      case 5:
+         return_value = '5';
+         break;
+      case 6:
+         return_value = '6';
+         break;
+      case 7:
+         return_value = '7';
+         break;
+      case 8:
+         return_value = '8';
+         break;
+      case 9:
+         return_value = '9';
+         break;
+      case 10:
+         return_value = 'A';
+         break;
+      case 11:
+         return_value = 'B';
+         break;
+      case 12:
+         return_value = 'C';
+         break;
+      case 13:
+         return_value = 'D';
+         break;
+      case 14:
+         return_value = 'E';
+         break;
+      case 15:
+         return_value = 'F';
+         break;
+      case 16:
+         return_value = 'G';
+         break;
+      case 17:
+         return_value = 'H';
+         break;
+      case 18:
+         return_value = 'I';
+         break;
+      case 19:
+         return_value = 'J';
+         break;
+      case 20:
+         return_value = 'k';
+         break;
+      case 21:
+         return_value = 'l';
+         break;
+      case 22:
+         return_value = 'm';
+         break;
+      case 23:
+         return_value = 'n';
+         break;
+      case 24:
+         return_value = 'o';
+         break;
+      case 25:
+         return_value = 'p';
+         break;
+      case 26:
+         return_value = 'q';
+         break;
+      case 27:
+         return_value = 'r';
+         break;
+      case 28:
+         return_value = 's';
+         break;
+      case 29:
+         return_value = 't';
+         break;
+      case 30:
+         return_value = ' ';
+         break;
+      case 31:
+         return_value = '.';
+         break;
+      case 32:
+         return_value = ',';
+         break;
+   }
+
+   return (return_value); /* Return character value */
+}
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3007.a
new file mode 100644
index 000000000..3837e0bae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3007.a
@@ -0,0 +1,408 @@
+-- CXB3007.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 procedure To_C converts the Wide_Character elements
+--      of a Wide_String parameter into wchar_t elements of the wchar_array
+--      parameter Target, with wide_nul termination if parameter Append_Nul
+--      is true.
+--
+--      Check that the out parameter Count of procedure To_C is set to the
+--      appropriate value for both the wide_nul/no wide_nul terminated cases.
+--
+--      Check that Constraint_Error is propagated by procedure To_C if the
+--      length of the wchar_array parameter Target is not sufficient to
+--      hold the converted Wide_String value.
+--
+--      Check that the Procedure To_Ada converts wchar_t elements of the
+--      wchar_array parameter Item to the corresponding Wide_Character
+--      elements of Wide_String out parameter Target.
+--
+--      Check that Constraint_Error is propagated by Procedure To_Ada if the
+--      length of Wide_String parameter Target is not long enough to hold the
+--      converted wchar_array value.
+--
+--      Check that Terminator_Error is propagated by Procedure To_Ada if the
+--      parameter Trim_Nul is set to True, but the actual Item parameter
+--      contains no wide_nul wchar_t.
+--
+-- TEST DESCRIPTION:
+--      This test uses a variety of Wide_String, and wchar_array objects to
+--      test versions of the To_C and To_Ada procedures.
+--
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.wchar_t:
+--      ' ', 'a'..'z', 'A'..'Z', and '-'.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations that provide
+--      package Interfaces.C.  If an implementation provides
+--      package Interfaces.C, this test must compile, execute, and
+--      report "PASSED".
+--
+-- CHANGE HISTORY:
+--      01 Sep 95   SAIC    Initial prerelease version.
+--      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Incorporated reviewer comments.
+--      14 Sep 99   RLB     Removed incorrect and unnecessary
+--                          Unchecked_Conversion.
+--
+--!
+
+with Report;
+with Interfaces.C;                                            -- N/A => ERROR
+with Ada.Characters.Latin_1;
+with Ada.Characters.Handling;
+with Ada.Exceptions;
+with Ada.Strings.Wide_Fixed;
+
+procedure CXB3007 is
+begin
+
+   Report.Test ("CXB3007", "Check that the procedures To_C and To_Ada " &
+                           "for wide strings produce correct results");
+   Test_Block:
+   declare
+
+      use Interfaces, Interfaces.C;
+      use Ada.Characters, Ada.Characters.Handling;
+      use Ada.Exceptions;
+      use Ada.Strings.Wide_Fixed;
+
+      TC_Short_Wide_String  : Wide_String(1..4) :=
+                                         (others => Wide_Character'First);
+      TC_Wide_String        : Wide_String(1..8) :=
+                                         (others => Wide_Character'First);
+      TC_wchar_array        : wchar_array(0..7) := (others => wchar_t'First);
+      TC_size_t_Count       : size_t            := size_t'First;
+      TC_Natural_Count      : Natural           := Natural'First;
+
+
+      -- We can use the wide character forms of To_Ada and To_C here to check
+      -- the results; they were tested in CXB3006. We give them different
+      -- names to avoid confusion below.
+
+      function Wide_Character_to_wchar_t (Source : in Wide_Character)
+          return wchar_t renames To_C;
+      function wchar_t_to_Wide_Character (Source : in wchar_t)
+          return Wide_Character renames To_Ada;
+
+   begin
+
+      -- Check that the procedure To_C converts the Wide_Character elements
+      -- of a Wide_String parameter into wchar_t elements of wchar_array out
+      -- parameter Target.
+      --
+      -- Case of wide_nul termination.
+
+      TC_Wide_String(1..6) := "abcdef";
+
+      To_C (Item       => TC_Wide_String(1..6),  -- Source slice of length 6.
+            Target     => TC_wchar_array,
+            Count      => TC_size_t_Count,
+            Append_Nul => True);
+
+      -- Check that the out parameter Count is set to the appropriate value
+      -- for the wide_nul terminated case.
+
+      if TC_size_t_Count /= 7 then
+         Report.Failed("Incorrect setting of out parameter Count by " &
+                       "Procedure To_C when Append_Nul => True");
+      end if;
+
+      for i in 1..TC_size_t_Count-1 loop
+         if wchar_t_to_Wide_Character(TC_wchar_array(i-1)) /=
+            TC_Wide_String(Integer(i))
+         then
+            Report.Failed("Incorrect result from Procedure To_C when "    &
+                          "checking individual wchar_t values, case of "  &
+                          "Append_Nul => True; "                          &
+                          "wchar_t position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if not Is_Nul_Terminated(TC_wchar_array) then
+         Report.Failed("No wide_nul wchar_t appended to the wchar_array " &
+                       "result from Procedure To_C when Append_Nul => True");
+      end if;
+
+      if TC_wchar_array(0..6) /= To_C("abcdef", True) then
+         Report.Failed("Incorrect result from Procedure To_C when "   &
+                       "directly comparing wchar_array results, case " &
+                       "of Append_Nul => True");
+      end if;
+
+
+      -- Check Procedure To_C with no wide_nul termination.
+
+      TC_wchar_array       := (others => Wide_Character_to_wchar_t('M'));
+      TC_Wide_String(1..4) := "WXYZ";
+
+      To_C (Item       => TC_Wide_String(1..4),  -- Source slice of length 4.
+            Target     => TC_wchar_array,
+            Count      => TC_size_t_Count,
+            Append_Nul => False);
+
+      -- Check that the out parameter Count is set to the appropriate value
+      -- for the non-wide_nul terminated case.
+
+      if TC_size_t_Count /= 4 then
+         Report.Failed("Incorrect setting of out parameter Count by " &
+                       "Procedure To_C when Append_Nul => False");
+      end if;
+
+      for i in 1..TC_size_t_Count loop
+         if wchar_t_to_Wide_Character(TC_wchar_array(i-1)) /=
+            TC_Wide_String(Integer(i))
+         then
+            Report.Failed("Incorrect result from Procedure To_C when "    &
+                          "checking individual wchar_t values, case of "  &
+                          "Append_Nul => False; "                         &
+                          "wchar_t position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if Is_Nul_Terminated(TC_wchar_array) then
+         Report.Failed
+           ("The wide_nul wchar_t was appended to the wchar_array " &
+            "result of Procedure To_C when Append_Nul => False");
+      end if;
+
+      if TC_wchar_array(0..3) /= To_C("WXYZ", False) then
+         Report.Failed("Incorrect result from Procedure To_C when "    &
+                       "directly comparing wchar_array results, case " &
+                       "of Append_Nul => False");
+      end if;
+
+
+
+      -- Check that Constraint_Error is raised by procedure To_C if the
+      -- length of the target wchar_array parameter is not sufficient to
+      -- hold the converted Wide_String value (plus wide_nul if Append_Nul
+      -- is True).
+
+      TC_wchar_array := (others => wchar_t'First);
+      begin
+         To_C("A string too long",
+              TC_wchar_array,
+              TC_size_t_Count,
+              Append_Nul => True);
+
+         Report.Failed("Constraint_Error not raised when the Target "    &
+                       "parameter of Procedure To_C is not long enough " &
+                       "to hold the converted Wide_String");
+         Report.Comment
+           (To_Character(wchar_t_to_Wide_Character(TC_wchar_array(0))) &
+            " printed to defeat optimization");
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by Procedure "    &
+                          "To_C when the Target parameter is not long " &
+                          "enough to contain the wchar_array result");
+      end;
+
+
+
+      -- Check that the procedure To_Ada converts wchar_t elements of the
+      -- wchar_array parameter Item to the corresponding Wide_Character
+      -- elements of Wide_String out parameter Target, with result wide
+      -- string length based on the Trim_Nul parameter.
+      --
+      -- Case of appended wide_nul wchar_t on the wchar_array In parameter.
+
+      TC_wchar_array :=
+        To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.
+
+      To_Ada (Item     => TC_wchar_array,
+              Target   => TC_Wide_String,
+              Count    => TC_Natural_Count,
+              Trim_Nul => False);
+
+      if TC_Natural_Count /= 8 then
+         Report.Failed("Incorrect value returned in out parameter Count " &
+                       "by Procedure To_Ada, case of Trim_Nul => False");
+      end if;
+
+      for i in 1..TC_Natural_Count loop
+         if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
+            TC_wchar_array(size_t(i-1))
+         then
+            Report.Failed("Incorrect result from Procedure To_Ada when "   &
+                          "checking individual wchar_t values, case of "   &
+                          "Trim_Nul => False, when a wide_nul is present " &
+                          "in the wchar_array input parameter; "           &
+                          "position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if TC_Wide_String(TC_Natural_Count) /= To_Wide_Character(Latin_1.Nul)
+      then
+         Report.Failed("Last Wide_Character of Wide_String result of "      &
+                       "Procedure To_Ada is not Nul, even though a "        &
+                       "wide_nul was present in the wchar_array argument, " &
+                       "and the Trim_Nul parameter was set to False");
+      end if;
+
+
+      TC_Wide_String       := (others => Wide_Character'First);
+      TC_wchar_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
+
+      To_Ada (Item     => TC_wchar_array,
+              Target   => TC_Wide_String,
+              Count    => TC_Natural_Count,
+              Trim_Nul => True);
+
+      if TC_Natural_Count /= 3 then
+         Report.Failed("Incorrect value returned in out parameter Count " &
+                       "by Procedure To_Ada, case of Trim_Nul => True");
+      end if;
+
+      for i in 1..TC_Natural_Count loop
+         if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
+            TC_wchar_array(size_t(i-1))
+         then
+            Report.Failed("Incorrect result from Procedure To_Ada when "  &
+                          "checking individual wchar_t values, case of "  &
+                          "Trim_Nul => True, when a wide_nul is present " &
+                          "in the wchar_array input parameter; "          &
+                          "position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
+      then
+         Report.Failed("Last Wide_Character of Wide_String result of " &
+                       "Procedure To_Ada is  Nul, even though the "    &
+                       "Trim_Nul parameter was set to True");
+      end if;
+
+      if TC_Wide_String(TC_Natural_Count+1) /= Wide_Character'First then
+         Report.Failed("Incorrect replacement from To_Ada");
+      end if;
+
+
+      -- Case of no wide_nul wchar_t present in the wchar_array argument.
+
+      TC_Wide_String := (others => Wide_Character'First);
+      TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);
+
+      To_Ada (Item     => TC_wchar_array,
+              Target   => TC_Wide_String,
+              Count    => TC_Natural_Count,
+              Trim_Nul => False);
+
+      if TC_Natural_Count /= 8 then
+         Report.Failed("Incorrect value returned in out parameter Count "   &
+                       "by Procedure To_Ada, case of Trim_Nul => False, "   &
+                       "with no wide_nul wchar_t present in the parameter " &
+                       "Item");
+      end if;
+
+      for i in 1..TC_Natural_Count loop
+         if Wide_Character_to_wchar_t(TC_Wide_String(i)) /=
+            TC_wchar_array(size_t(i-1))
+         then
+            Report.Failed("Incorrect result from Procedure To_Ada when " &
+                          "checking individual wchar_t values, case of " &
+                          "Trim_Nul => False, when a wide_nul is not "   &
+                          "present in the wchar_array input parameter; " &
+                          "position = " & Integer'Image(Integer(i)));
+         end if;
+      end loop;
+
+      if TC_Wide_String(TC_Natural_Count) = To_Wide_Character(Latin_1.Nul)
+      then
+         Report.Failed("Last Wide_Character of Wide_String result of "      &
+                       "Procedure To_Ada is Nul, even though the wide_nul " &
+                       "wchar_t was not present in the parameter Item, "    &
+                       "with the parameter Trim_Nul => False");
+      end if;
+
+
+
+      -- Check that the Procedure To_Ada raises Terminator_Error if the
+      -- parameter Trim_Nul is set to True, but the actual Item parameter
+      -- does not contain the wide_nul wchar_t.
+
+      begin
+         TC_Wide_String := (others => Wide_Character'First);
+         TC_wchar_array := To_C ("ABCDWXYZ", Append_Nul => False);
+
+         To_Ada(TC_wchar_array,
+                TC_Wide_String,
+                Count    => TC_Natural_Count,
+                Trim_Nul => True);
+
+         Report.Failed("Terminator_Error not raised when Item "    &
+                       "parameter of To_Ada does not contain the " &
+                       "wide_nul wchar_t, but parameter Trim_Nul => True");
+         Report.Comment(To_String(TC_Wide_String) &
+                        " printed to defeat optimization");
+      exception
+         when Terminator_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by Procedure "     &
+                          "To_Ada when the Item parameter does not "     &
+                          "contain the wide_nul wchar_t, but parameter " &
+                          "Trim_Nul => True");
+      end;
+
+
+
+      -- Check that Constraint_Error is propagated by procedure To_Ada if the
+      -- length of Wide_String parameter Target is not long enough to hold the
+      -- converted wchar_array value (plus wide_nul if Trim_Nul is False).
+
+      begin
+         TC_wchar_array(0..4) := To_C ("ABCD", Append_Nul => True);
+
+         To_Ada(TC_wchar_array(0..4),
+                TC_Short_Wide_String, -- Length of 4.
+                Count    => TC_Natural_Count,
+                Trim_Nul => False);
+
+         Report.Failed("Constraint_Error not raised when Wide_String " &
+                       "parameter Target of Procedure To_Ada is not "  &
+                       "long enough to hold the converted wchar_ts");
+         Report.Comment(To_String(TC_Short_Wide_String) &
+                        " printed to defeat optimization");
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by Procedure "      &
+                          "To_Ada when Wide_String parameter Target is "  &
+                          "not long enough to hold the converted wchar_ts");
+      end;
+
+   exception
+      when The_Error : others =>
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3008.a
new file mode 100644
index 000000000..9df19d814
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3008.a
@@ -0,0 +1,226 @@
+-- CXB3008.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 functions imported from the C language <string.h> and
+--      <stdlib.h> libraries can be called from an Ada program.
+--      
+-- TEST DESCRIPTION:
+--      This test checks that C language functions from the <string.h> and
+--      <stdlib.h> libraries can be used as completions of Ada subprograms.
+--      A pragma Import with convention identifier "C" is used to complete
+--      the Ada subprogram specifications.
+--      The three subprogram cases tested are as follows:
+--      1) A C function that returns an int value (strcpy) is used as the
+--         completion of an Ada procedure specification.  The return value
+--         is discarded; parameter modification is the desired effect.
+--      2) A C function that returns an int value (strlen) is used as the
+--         completion of an Ada function specification.
+--      3) A C function that returns a double value (strtod) is used as the
+--         completion of an Ada function specification.
+--
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', 'a'..'z', 'A'..'Z', '0'..'9', and '$'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      packages Interfaces.C and Interfaces.C.Strings.  If an 
+--      implementation provides these packages, this test must compile, 
+--      execute, and report "PASSED".
+--
+-- SPECIAL REQUIREMENTS:
+--      The C language library functions used by this test must be 
+--      available for importing into the test.
+--
+--       
+-- CHANGE HISTORY:
+--      12 Oct 95   SAIC    Initial prerelease version.
+--      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      01 DEC 97   EDS     Replaced all references of C function atof with
+--                          C function strtod.
+--      29 JUN 98   EDS     Give Ada function corresponding to strtod a 
+--                          second parameter.
+--!
+
+with Report;
+with Ada.Exceptions;
+with Interfaces.C;                                            -- N/A => ERROR
+with Interfaces.C.Strings;                                    -- N/A => ERROR
+with Interfaces.C.Pointers;
+
+procedure CXB3008 is
+begin
+
+   Report.Test ("CXB3008", "Check that functions imported from the " &
+                           "C language predefined libraries can be " &
+                           "called from an Ada program");
+
+   Test_Block:
+   declare
+
+      package IC  renames Interfaces.C;
+      package ICS renames Interfaces.C.Strings;
+      package ICP is new Interfaces.C.Pointers
+         ( Index => IC.size_t,
+           Element => IC.char,
+           Element_Array => IC.char_array,
+           Default_Terminator => IC.nul );
+      use Ada.Exceptions;
+
+      use type IC.char;
+      use type IC.char_array;
+      use type IC.size_t;
+      use type IC.double;
+
+      -- The String_Copy procedure copies the string pointed to by Source, 
+      -- including the terminating nul char, into the char_array pointed
+      -- to by Target.
+
+      procedure String_Copy (Target : out IC.char_array;
+                             Source : in  IC.char_array);
+
+      -- The String_Length function returns the length of the nul-terminated 
+      -- string pointed to by The_String.  The nul is not included in
+      -- the count.
+
+      function String_Length (The_String : in IC.char_array) 
+        return IC.size_t;
+
+      -- The String_To_Double function converts the char_array pointed to
+      -- by The_String into a double value returned through the function
+      -- name.  The_String must contain a valid floating-point number; if
+      -- not, the value returned is zero.
+
+--      type Acc_ptr is access IC.char_array;
+      function String_To_Double (The_String : in IC.char_array ; 
+                                 End_Ptr    : ICP.Pointer := null) 
+        return IC.double;
+
+
+      -- Use the <string.h> strcpy function as a completion to the procedure
+      -- specification.  Note that the Ada interface to this C function is
+      -- in the form of a procedure (C function return value is not used).
+
+      pragma Import (C, String_Copy, "strcpy");
+
+      -- Use the <string.h> strlen function as a completion to the
+      -- String_Length function specification.
+
+      pragma Import (C, String_Length, "strlen");
+
+      -- Use the <stdlib.h> strtod function as a completion to the 
+      -- String_To_Double function specification.
+
+      pragma Import (C, String_To_Double, "strtod");
+
+
+      TC_String     : constant String := "Just a Test";
+      Char_Source   : IC.char_array(0..30);
+      Char_Target   : IC.char_array(0..30);
+      Double_Result : IC.double;
+      Source_Ptr,
+      Target_Ptr    : ICS.chars_ptr;
+
+   begin
+
+      -- Check that the imported version of C function strcpy produces 
+      -- the correct results.
+
+      Char_Source(0..21) := "Test of Pragma Import" & IC.nul;
+
+      String_Copy(Char_Target, Char_Source);
+
+      if Char_Target(0..21) /= Char_Source(0..21) then
+         Report.Failed("Incorrect result from the imported version of " &
+                       "strcpy - 1");
+      end if;
+
+      if String_Length(Char_Target) /= 21 then
+         Report.Failed("Incorrect result from the imported version of " &
+                       "strlen - 1");
+      end if;
+
+      Char_Source(0) := IC.nul;
+
+      String_Copy(Char_Target, Char_Source);
+
+      if Char_Target(0) /= Char_Source(0) then
+         Report.Failed("Incorrect result from the imported version of " &
+                       "strcpy - 2");
+      end if;
+
+      if String_Length(Char_Target) /= 0 then
+         Report.Failed("Incorrect result from the imported version of " &
+                       "strlen - 2");
+      end if;
+
+      -- The following chars_ptr designates a char_array of 12 chars 
+      -- (including the terminating nul char).
+      Source_Ptr := ICS.New_Char_Array(IC.To_C(TC_String));  
+
+      String_Copy(Char_Target, ICS.Value(Source_Ptr));
+
+      Target_Ptr := ICS.New_Char_Array(Char_Target);
+
+      if ICS.Value(Target_Ptr) /= TC_String then
+         Report.Failed("Incorrect result from the imported version of " &
+                       "strcpy - 3");
+      end if;
+         
+      if String_Length(ICS.Value(Target_Ptr)) /= TC_String'Length then
+         Report.Failed("Incorrect result from the imported version of " &
+                       "strlen - 3");
+      end if;
+
+
+      Char_Source(0..9) := "100.00only";
+
+      Double_Result := String_To_Double(Char_Source);
+
+      Char_Source(0..13) := "5050.00$$$$$$$";
+
+      if Double_Result + String_To_Double(Char_Source) /= 5150.00 then
+         Report.Failed("Incorrect result returned from the imported " &
+                       "version of function strtod - 1");
+      end if;
+
+      Char_Source(0..9) := "xxx$10.00x";  -- String doesn't contain a
+                                          -- valid floating point value.
+      if String_To_Double(Char_Source) /= 0.0 then
+         Report.Failed("Incorrect result returned from the imported " &
+                       "version of function strtod - 2");
+      end if;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3009.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3009.a
new file mode 100644
index 000000000..3ea5a6204
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3009.a
@@ -0,0 +1,305 @@
+-- CXB3009.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 function To_Chars_Ptr will return a Null_Ptr value
+--      when the parameter Item is null.  If the parameter Item is not null,
+--      and references a chars_array object that does contain the char nul,
+--      and parameter Nul_Check is True, check that To_Chars_Ptr performs a
+--      pointer conversion from char_array_access type to chars_ptr type.
+--      Check that if parameter Item is not null, and references a
+--      chars_array object that does not contain nul, and parameter Nul_Check
+--      is True, the To_Chars_Ptr function will propagate Terminator_Error.
+--      Check that if parameter Item is not null, and parameter Nul_Check
+--      is False, check that To_Chars_Ptr performs a pointer conversion from
+--      char_array_access type to chars_ptr type.
+--
+--      Check that the New_Char_Array function will return a chars_ptr type
+--      pointer to an allocated object that has been initialized with
+--      the value of parameter Chars.
+--
+--      Check that the function New_String returns a chars_ptr initialized
+--      to a nul-terminated string having the value of the Str parameter.
+--
+-- TEST DESCRIPTION:
+--      This test uses a variety of of string, char_array,
+--      char_array_access and char_ptr values in order to validate the
+--      functions under test, and results are compared for both length
+--      and content.
+--
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', 'a'..'z', and 'A'.. 'Z'.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations that provide
+--      package Interfaces.C.Strings.  If an implementation provides
+--      package Interfaces.C.Strings, this test must compile, execute, and
+--      report "PASSED".
+--
+--
+-- CHANGE HISTORY:
+--      20 Sep 95   SAIC    Initial prerelease version.
+--      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      01 DEC 97   EDS     Remove incorrect block of code (previously
+--                          lines 264-287)
+--      14 Sep 99   RLB     Added check for behavior of To_Chars_Ptr when
+--                          Nul_Check => False. (From Technical
+--                          Corrigendum 1).
+--!
+
+with Report;
+with Interfaces.C.Strings;                                   -- N/A => ERROR
+with Ada.Characters.Latin_1;
+with Ada.Exceptions;
+with Ada.Strings.Fixed;
+
+procedure CXB3009 is
+begin
+
+   Report.Test ("CXB3009", "Check that functions To_Chars_Ptr, "      &
+                           "New_Chars_Array, and New_String produce " &
+                           "correct results");
+
+   Test_Block:
+   declare
+
+      package IC  renames Interfaces.C;
+      package ICS renames Interfaces.C.Strings;
+      use Ada.Exceptions;
+
+      use type IC.char_array;
+      use type IC.size_t;
+      use type ICS.chars_ptr;
+
+      Null_Char_Array_Access : constant ICS.char_array_access := null;
+
+      Test_String            : constant String := "Test String";
+      String_With_nul        : String(1..6)    := "Addnul";
+      String_Without_nul     : String(1..6)    := "No nul";
+
+      Char_Array_With_nul    : IC.char_array(0..6)   :=
+                                 IC.To_C(String_With_nul, True);
+      Char_Array_Without_nul : IC.char_array(0..5)   :=
+                                 IC.To_C(String_Without_nul, False);
+      Char_Array_W_nul_Ptr   : ICS.char_array_access :=
+                                 new IC.char_array'(Char_Array_With_nul);
+      Char_Array_WO_nul_Ptr  : ICS.char_array_access :=
+                                 new IC.char_array'(Char_Array_Without_nul);
+
+      TC_chars_ptr           : ICS.chars_ptr;
+
+      TC_size_t              : IC.size_t := IC.size_t'First;
+
+
+   begin
+
+      -- Check that the function To_Chars_Ptr will return a Null_Ptr value
+      -- when the parameter Item is null.
+
+      if ICS.To_Chars_Ptr(Item      => Null_Char_Array_Access,
+                          Nul_Check => False)     /= ICS.Null_Ptr   or
+         ICS.To_Chars_Ptr(Null_Char_Array_Access,
+                          Nul_Check => True)      /= ICS.Null_Ptr   or
+         ICS.To_Chars_Ptr(Null_Char_Array_Access) /= ICS.Null_Ptr
+      then
+         Report.Failed("Incorrect result from function To_Chars_Ptr " &
+                       "with parameter Item being a null value");
+      end if;
+
+
+      -- Check that if the parameter Item is not null, and references a
+      -- chars_array object that does contain the nul char, and parameter
+      -- Nul_Check is True, function To_Chars_Ptr performs a pointer
+      -- conversion from char_array_access type to chars_ptr type.
+
+      begin
+         TC_chars_ptr := ICS.To_Chars_Ptr(Item      => Char_Array_W_nul_Ptr,
+                                          Nul_Check => True);
+
+         if ICS.Value(TC_chars_ptr) /= String_With_nul     or
+            ICS.Value(TC_chars_ptr) /= Char_Array_With_nul
+         then
+            Report.Failed("Incorrect result from function To_Chars_Ptr " &
+                          "with parameter Item being non-null and "      &
+                          "containing the nul char");
+         end if;
+      exception
+         when IC.Terminator_Error =>
+           Report.Failed("Terminator_Error raised during the validation " &
+                         "of Function To_Chars_Ptr");
+         when others           =>
+           Report.Failed("Unexpected exception raised during the " &
+                         "validation of Function To_Chars_Ptr");
+      end;
+
+      -- Check that if parameter Item is not null, and references a
+      -- chars_array object that does not contain nul, and parameter
+      -- Nul_Check is True, the To_Chars_Ptr function will propagate
+      -- Terminator_Error.
+
+      begin
+         TC_chars_ptr   := ICS.To_Chars_Ptr(Char_Array_WO_nul_Ptr, True);
+         Report.Failed("Terminator_Error was not raised by function "   &
+                       "To_Chars_Ptr when given a parameter Item that " &
+                       "is non-null, and does not contain the nul "     &
+                       "char, but parameter Nul_Check is True");
+         TC_size_t := ICS.Strlen(TC_chars_ptr); -- Use TC_chars_ptr to
+                                                -- defeat optimization;
+      exception
+          when IC.Terminator_Error => null;     -- Expected exception.
+          when others              =>
+             Report.Failed("Incorrect exception raised when function "    &
+                           "To_Chars_Ptr is given a parameter Item that " &
+                           "is non-null, and does not contain the nul "   &
+                           "char, but parameter Nul_Check is True");
+      end;
+
+      -- Check that if the parameter Item is not null, and parameter
+      -- Nul_Check is False, function To_Chars_Ptr performs a pointer
+      -- conversion from char_array_access type to chars_ptr type.
+
+      begin
+         TC_chars_ptr := ICS.To_Chars_Ptr(Item      => Char_Array_WO_nul_Ptr,
+                                          Nul_Check => False);
+
+         if ICS.Value(TC_chars_ptr, 6) /= String_Without_nul     or
+            ICS.Value(TC_chars_ptr, 6) /= Char_Array_Without_nul
+         then
+            Report.Failed("Incorrect result from function To_Chars_Ptr " &
+                          "with parameter Item being non-null and "      &
+                          "Nul_Check False");
+         end if;
+      exception
+         when IC.Terminator_Error =>
+           Report.Failed("Terminator_Error raised during the validation " &
+                         "of Function To_Chars_Ptr");
+         when others           =>
+           Report.Failed("Unexpected exception raised during the " &
+                         "validation of Function To_Chars_Ptr");
+      end;
+
+
+      -- Check that the New_Char_Array function will return a chars_ptr type
+      -- pointer to an allocated object that has been initialized with
+      -- the value of parameter Chars.
+      TC_chars_ptr := ICS.New_String("");
+      ICS.Free(TC_chars_ptr);   -- Reset the chars_ptr to Null_Ptr;
+
+      if TC_chars_ptr /= ICS.Null_Ptr then
+         Report.Failed("Reset of TC_chars_ptr to Null not successful - 1");
+      end if;
+
+      TC_chars_ptr := ICS.New_Char_Array(Chars => Char_Array_With_nul);
+
+      if TC_chars_ptr = ICS.Null_Ptr then    -- Check allocation.
+         Report.Failed
+           ("No allocation took place in call to New_Char_Array " &
+            "with a non-null char_array parameter containing a "  &
+            "terminating nul char");
+      end if;
+
+      -- Length of allocated array is determined using Strlen since array
+      -- is nul terminated.  Contents of array are validated using Value.
+
+      if ICS.Value (TC_chars_ptr, Length => 7) /= Char_Array_With_nul  or
+         ICS.Strlen(Item => TC_chars_ptr)      /= 6
+      then
+         Report.Failed
+           ("Incorrect length of allocated char_array resulting " &
+            "from call of New_Char_Array with a non-null "        &
+            "char_array parameter containing a terminating nul char");
+      end if;
+
+      ICS.Free(TC_chars_ptr);   -- Reset the chars_ptr to Null_Ptr;
+      if TC_chars_ptr /= ICS.Null_Ptr then
+         Report.Failed("Reset of TC_chars_ptr to Null not successful - 2");
+      end if;
+
+      TC_chars_ptr := ICS.New_Char_Array(Chars => Char_Array_Without_nul);
+
+      if TC_chars_ptr = ICS.Null_Ptr then    -- Check allocation.
+         Report.Failed
+           ("No allocation took place in call to New_Char_Array " &
+            "with a non-null char_array parameter that did not "  &
+            "contain a terminating nul char");
+      end if;
+
+      -- Function Value is used with the total length of the
+      -- Char_Array_Without_nul as a parameter to verify the allocation.
+
+      if ICS.Value(Item => TC_chars_ptr, Length => 6) /=
+         Char_Array_Without_nul                            or
+         ICS.Strlen(Item => TC_chars_ptr)             /= 6
+      then
+         Report.Failed("Incorrect length of allocated char_array "     &
+                       "resulting from call of New_Char_Array with "   &
+                       "a non-null char_array parameter that did not " &
+                       "contain a terminating nul char");
+      end if;
+
+
+      -- Check that the function New_String returns a chars_ptr specifying
+      -- an allocated object initialized to the value of parameter Str.
+
+      ICS.Free(TC_chars_ptr);   -- Reset the chars_ptr to Null_Ptr;
+      if TC_chars_ptr /= ICS.Null_Ptr then
+         Report.Failed("Reset of TC_chars_ptr to Null not successful - 3");
+      end if;
+
+      TC_chars_ptr := ICS.New_String(Str => Test_String);
+
+      if ICS.Value(TC_chars_ptr) /= Test_String or
+         ICS.Value(ICS.New_Char_Array(IC.To_C(Test_String,True))) /=
+         Test_String
+      then
+         Report.Failed("Incorrect allocation resulting from function " &
+                       "New_String with a string parameter value");
+      end if;
+
+      ICS.Free(TC_chars_ptr);   -- Reset the chars_ptr to Null_Ptr;
+      if TC_chars_ptr /= ICS.Null_Ptr then
+         Report.Failed("Reset of TC_chars_ptr to Null not successful - 4");
+      end if;
+
+      if ICS.Value(ICS.New_String(String_Without_nul)) /=
+         String_Without_nul                               or
+         ICS.Value(ICS.New_Char_Array(IC.To_C(String_Without_nul,False))) /=
+         String_Without_nul
+      then
+         Report.Failed("Incorrect allocation resulting from function " &
+                       "New_String with parameter value String_Without_nul");
+      end if;
+
+
+   exception
+      when The_Error : others =>
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3009;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3010.a
new file mode 100644
index 000000000..25305b22f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3010.a
@@ -0,0 +1,320 @@
+-- CXB3010.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 Procedure Free resets the parameter Item to
+--      Null_Ptr.  Check that Free has no effect if Item is Null_Ptr.
+--
+--      Check that the version of Function Value with a chars_ptr parameter
+--      returning a char_array result returns the prefix of an array of
+--      chars.
+--
+--      Check that the version of Function Value with a chars_ptr parameter
+--      and a size_t parameter returning a char_array result returns
+--      the shorter of:
+--        1) the first size_t number of characters, or
+--        2) the characters up to and including the first nul.
+--
+--      Check that both of the above versions of Function Value propagate
+--      Dereference_Error if the Item parameter is Null_Ptr.
+--
+-- TEST DESCRIPTION:
+--      This test validates the Procedure Free and two versions of Function
+--      Value.  A variety of char_array and char_ptr values are provided as
+--      input, and results are compared for both length and content.
+--
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', 'a'..'z', and 'A'..'Z'.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations that provide
+--      package Interfaces.C.Strings.  If an implementation provides
+--      package Interfaces.C.Strings, this test must compile, execute,
+--      and report "PASSED".
+--
+--
+-- CHANGE HISTORY:
+--      27 Sep 95   SAIC    Initial prerelease version.
+--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Incorporated reviewer comments.
+--      01 DEC 97   EDS     Replicate line 199 at line 256, to ensure that
+--                          TC_chars_ptr has a valid pointer.
+--      08 JUL 99   RLB     Added a test case to check that Value raises
+--                          Constraint_Error when Length = 0. (From Technical
+--                          Corrigendum 1).
+--      25 JAN 01   RLB     Repaired previous test case to avoid raising
+--                          Constraint_Error in test case code.
+--      26 JAN 01   RLB     Added an Ident_Int to the test case to prevent
+--                          optimization.
+
+--!
+
+with Report;
+with Interfaces.C.Strings;                                    -- N/A => ERROR
+
+procedure CXB3010 is
+begin
+
+   Report.Test ("CXB3010", "Check that Procedure Free and versions of " &
+                           "Function Value produce correct results");
+
+   Test_Block:
+   declare
+
+      package IC  renames Interfaces.C;
+      package ICS renames Interfaces.C.Strings;
+
+      use type IC.char_array;
+      use type IC.size_t;
+      use type ICS.chars_ptr;
+      use type IC.char;
+
+      Null_Char_Array_Access : constant ICS.char_array_access := null;
+
+      TC_String_1            : constant String       := "Nonul";
+      TC_String_2            : constant String       := "AbCdE";
+      TC_Blank_String        : constant String(1..5) := (others => ' ');
+
+      -- The initialization of the following char_array objects
+      -- includes the appending of a terminating nul char, in order to
+      -- prevent the erroneous execution of Function Value.
+
+      TC_char_array          : IC.char_array :=
+                                 IC.To_C(TC_Blank_String, True);
+      TC_char_array_1        : constant IC.char_array :=
+                                          IC.To_C(TC_String_1, True);
+      TC_char_array_2        : constant IC.char_array :=
+                                          IC.To_C(TC_String_2, True);
+      TC_Blank_char_array    : constant IC.char_array :=
+                                          IC.To_C(TC_Blank_String, True);
+
+      -- This chars_ptr is initialized via the use of New_Chars_Array to
+      -- avoid erroneous execution of procedure Free.
+      TC_chars_ptr           : ICS.chars_ptr :=
+                                 ICS.New_Char_Array(TC_Blank_char_array);
+
+   begin
+
+      -- Check that the Procedure Free resets the parameter Item
+      -- to Null_Ptr.
+
+      if TC_chars_ptr = ICS.Null_Ptr then
+         Report.Failed("TC_chars_ptr is currently null; it should not be " &
+                       "null since it was given default initialization");
+      end if;
+
+      ICS.Free(TC_chars_ptr);
+
+      if TC_chars_ptr /= ICS.Null_Ptr then
+         Report.Failed("TC_chars_ptr was not set to Null_Ptr by " &
+                       "Procedure Free");
+      end if;
+
+      -- Check that Free has no effect if Item is Null_Ptr.
+
+      begin
+         TC_chars_ptr := ICS.Null_Ptr;  -- Ensure pointer is null.
+         ICS.Free(TC_chars_ptr);
+         if TC_chars_ptr /= ICS.Null_Ptr then
+            Report.Failed("TC_chars_ptr was set to a non-Null_Ptr value "  &
+                          "by Procedure Free.  It was provided as a null " &
+                          "parameter to Free, and there should have been " &
+                          "no effect from a call to Procedure Free");
+         end if;
+      exception
+         when others =>
+           Report.Failed("Unexpected exception raised by Procedure Free " &
+                         "when parameter Item is Null_Ptr");
+      end;
+
+
+      -- Check that the version of Function Value with a chars_ptr parameter
+      -- that returns a char_array result returns an array of chars (up to
+      -- and including the first nul).
+
+      TC_chars_ptr  := ICS.New_Char_Array(TC_char_array_1);
+      TC_char_array := ICS.Value(Item => TC_chars_ptr);
+
+      if TC_char_array                  /= TC_char_array_1            or
+         IC.To_Ada(TC_char_array, True) /= IC.To_Ada(TC_char_array_1)
+      then
+         Report.Failed("Incorrect result from Function Value - 1");
+      end if;
+
+      TC_chars_ptr  := ICS.New_Char_Array(TC_char_array_2);
+      TC_char_array := ICS.Value(Item => TC_chars_ptr);
+
+      if TC_char_array                  /= TC_char_array_2            or
+         IC.To_Ada(TC_char_array, True) /= IC.To_Ada(TC_char_array_2)
+      then
+         Report.Failed("Incorrect result from Function Value - 2");
+      end if;
+
+      if ICS.Value(Item => ICS.New_String("A little longer string")) /=
+         IC.To_C("A little longer string")
+      then
+         Report.Failed("Incorrect result from Function Value - 3");
+      end if;
+
+
+      -- Check that the version of Function Value with a chars_ptr parameter
+      -- and a size_t parameter that returns a char_array result returns
+      -- the shorter of:
+      --   1) the first size_t number of characters, or
+      --   2) the characters up to and including the first nul.
+
+      -- Case 1: the first size_t number of characters (less than the
+      --         total length).
+
+      begin
+         TC_chars_ptr        := ICS.New_Char_Array(TC_char_array_1);
+         TC_char_array(0..2) := ICS.Value(Item => TC_chars_ptr, Length => 3);
+
+         if TC_char_array(0..2) /= TC_char_array_1(0..2)
+         then
+            Report.Failed
+              ("Incorrect result from Function Value with Length " &
+               "parameter - 1");
+         end if;
+      exception
+         when others =>
+           Report.Failed("Exception raised during Case 1 evaluation");
+      end;
+
+      -- Case 2: the characters up to and including the first nul.
+
+      TC_chars_ptr  := ICS.New_Char_Array(TC_char_array_2);
+
+      -- The length supplied as a parameter exceeds the total length of
+      -- TC_char_array_2.  The result should be the entire TC_char_array_2
+      -- including the terminating nul.
+
+      TC_char_array := ICS.Value(Item => TC_chars_ptr, Length => 7);
+
+      if TC_char_array            /= TC_char_array_2            or
+         IC.To_Ada(TC_char_array) /= IC.To_Ada(TC_char_array_2) or
+         not (IC.Is_Nul_Terminated(TC_char_array))
+      then
+         Report.Failed("Incorrect result from Function Value with Length " &
+                       "parameter - 2");
+      end if;
+
+
+      -- Check that both of the above versions of Function Value propagate
+      -- Dereference_Error if the Item parameter is Null_Ptr.
+
+      declare
+
+         -- Declare a dummy function to demonstrate one way that a chars_ptr
+         -- variable could inadvertantly be set to Null_Ptr prior to a call
+         -- to Value (below).
+         function Freedom (Condition : Boolean := False;
+                           Ptr       : ICS.chars_ptr) return ICS.chars_ptr is
+            Pointer : ICS.chars_ptr := Ptr;
+         begin
+            if Condition then
+               ICS.Free(Pointer);
+            else
+               null; -- An activity that doesn't set the chars_ptr value to
+                     -- Null_Ptr.
+            end if;
+            return Pointer;
+         end Freedom;
+
+      begin
+
+         begin
+            TC_char_array := ICS.Value(Item => Freedom(True, TC_chars_ptr));
+            Report.Failed
+              ("Function Value (without Length parameter) did not " &
+               "raise Dereference_Error when provided a null Item " &
+               "parameter input value");
+            if TC_char_array(0) = '6' then   -- Defeat optimization.
+               Report.Comment("Should never be printed");
+            end if;
+         exception
+            when ICS.Dereference_Error => null;  -- OK, expected exception.
+            when others                =>
+              Report.Failed("Incorrect exception raised by Function Value " &
+                            "with Item parameter, when the Item parameter " &
+                            "is Null_Ptr");
+         end;
+
+         TC_chars_ptr  := ICS.New_Char_Array(TC_char_array_2);
+         begin
+            TC_char_array := ICS.Value(Item   => Freedom(True, TC_chars_ptr),
+                                       Length => 4);
+            Report.Failed
+              ("Function Value (with Length parameter) did not "    &
+               "raise Dereference_Error when provided a null Item " &
+               "parameter input value");
+            if TC_char_array(0) = '6' then   -- Defeat optimization.
+               Report.Comment("Should never be printed");
+            end if;
+         exception
+            when ICS.Dereference_Error => null;  -- OK, expected exception.
+            when others                =>
+              Report.Failed("Incorrect exception raised by Function Value " &
+                            "with both Item and Length parameters, when "   &
+                            "the Item parameter is Null_Ptr");
+         end;
+      end;
+
+      -- Check that Function Value with two parameters propagates
+      -- Constraint_Error if Length is 0.
+
+      begin
+         TC_chars_ptr        := ICS.New_Char_Array(TC_char_array_1);
+	 declare
+	    TC : IC.char_array := ICS.Value(Item => TC_chars_ptr, Length =>
+		IC.Size_T(Report.Ident_Int(0)));
+	 begin
+             Report.Failed
+                 ("Function Value (with Length parameter) did not "    &
+                  "raise Constraint_Error when Length = 0");
+             if TC'Length <= TC_char_array'Length then
+                TC_char_array(1..TC'Length) := TC; -- Block optimization of TC.
+             end if;
+         end;
+
+         Report.Failed
+              ("Function Value (with Length parameter) did not "    &
+               "raise Constraint_Error when Length = 0");
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by Function Value " &
+                          "with both Item and Length parameters, when "   &
+                          "Length = 0");
+      end;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3011.a
new file mode 100644
index 000000000..6930407ec
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3011.a
@@ -0,0 +1,282 @@
+-- CXB3011.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 version of Function Value with a chars_ptr parameter
+--      that returns a String result returns an Ada string containing the
+--      characters pointed to by the chars_ptr parameter, up to (but not 
+--      including) the terminating nul.
+--
+--      Check that the version of Function Value with a chars_ptr parameter
+--      and a size_t parameter that returns a String result returns the
+--      shorter of: 
+--        1) a String of the first size_t number of characters, or 
+--        2) a String of characters up to (but not including) the
+--           terminating nul.
+--
+--      Check that the Function Strlen returns a size_t result that
+--      corresponds to the number of chars in the array pointed to by Item,
+--      up to but not including the terminating nul.
+--
+--      Check that both of the above versions of Function Value and
+--      Function Strlen propagate Dereference_Error if the Item parameter
+--      is Null_Ptr.
+--      
+-- TEST DESCRIPTION:
+--      This test validates two versions of Function Value, and the Function
+--      Strlen.  A series of char_ptr values are provided as input, and 
+--      results are compared for length or content.  
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*' and '.'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.C.Strings.  If an implementation provides
+--      package Interfaces.C.Strings, this test must compile, execute, 
+--      and report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      28 Sep 95   SAIC    Initial prerelease version.
+--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Ada.Characters.Latin_1;
+with Interfaces.C.Strings;                                    -- N/A => ERROR
+
+procedure CXB3011 is
+begin
+
+   Report.Test ("CXB3011", "Check that the two versions of Function Value " &
+                           "returning a String result, and the Function "   &
+                           "Strlen, produce correct results");
+
+   Test_Block:
+   declare
+
+      package IC   renames Interfaces.C;
+      package ICS  renames Interfaces.C.Strings;
+      package ACL1 renames Ada.Characters.Latin_1;
+
+      use type IC.char_array;
+      use type IC.size_t;
+      use type ICS.chars_ptr;
+
+      Null_Char_Array_Access : constant ICS.char_array_access := null;
+
+      TC_String              : String(1..5)          := (others => 'X');
+      TC_String_1            : constant String       := "*.3*0";
+      TC_String_2            : constant String       := "Two";
+      TC_String_3            : constant String       := "Five5";
+      TC_Blank_String        : constant String(1..5) := (others => ' ');
+
+      TC_char_array          : IC.char_array := 
+                                 IC.To_C(TC_Blank_String, True);
+      TC_char_array_1        : constant IC.char_array := 
+                                 IC.To_C(TC_String_1, True);
+      TC_char_array_2        : constant IC.char_array := 
+                                 IC.To_C(TC_String_2, True);
+      TC_char_array_3        : constant IC.char_array := 
+                                 IC.To_C(TC_String_3, True);
+      TC_Blank_char_array    : constant IC.char_array := 
+                                 IC.To_C(TC_Blank_String, True);
+
+      TC_chars_ptr           : ICS.chars_ptr :=
+                                 ICS.New_Char_Array(TC_Blank_char_array); 
+
+      TC_size_t              : IC.size_t := IC.size_t'First;
+
+
+   begin
+
+      -- Check that the version of Function Value with a chars_ptr parameter
+      -- that returns a String result returns an Ada string containing the 
+      -- characters pointed to by the chars_ptr parameter, up to (but not 
+      -- including) the terminating nul.
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_1);
+      TC_String    := ICS.Value(Item => TC_chars_ptr);
+
+      if TC_String                 /= TC_String_1 or
+         TC_String(TC_String'Last)  = ACL1.NUL     
+      then
+         Report.Failed("Incorrect result from Function Value - 1");
+      end if;
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_2);
+
+      if ICS.Value(Item => TC_chars_ptr) /= 
+         IC.To_Ada(ICS.Value(TC_chars_ptr), Trim_Nul => True)
+      then
+         Report.Failed("Incorrect result from Function Value - 2");
+      end if;
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_3);
+      TC_String    := ICS.Value(TC_chars_ptr);
+
+      if TC_String                 /= TC_String_3 or
+         TC_String(TC_String'Last)  = ACL1.NUL    
+      then
+         Report.Failed("Incorrect result from Function Value - 3");
+      end if;
+
+
+      -- Check that the version of Function Value with a chars_ptr parameter
+      -- and a size_t parameter that returns a String result returns the
+      -- shorter of: 
+      --   1) a String of the first size_t number of characters, or 
+      --   2) a String of characters up to (but not including) the 
+      --      terminating nul.
+      --
+
+      -- Case 1 : Length parameter specifies a length shorter than total
+      --          length.
+
+      TC_chars_ptr    := ICS.New_Char_Array(TC_char_array_1);
+      TC_String       := "XXXXX";  -- Reinitialize all characters in string.
+      TC_String(1..5) := ICS.Value(Item => TC_chars_ptr, Length => 6);
+
+      if TC_String(1..4)           /= TC_String_1(1..4) or
+         TC_String(TC_String'Last)  = ACL1.NUL          
+      then
+         Report.Failed("Incorrect result from Function Value - 4");
+      end if;
+
+      -- Case 2 : Length parameter specifies total length.
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_2);
+
+      if ICS.Value(TC_chars_ptr, Length => 5) /= 
+         IC.To_Ada(ICS.Value(TC_chars_ptr), Trim_Nul => True)
+      then
+         Report.Failed("Incorrect result from Function Value - 5");
+      end if;
+
+      -- Case 3 : Length parameter specifies a length longer than total
+      --          length.
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_3);
+      TC_String    := "XXXXX";  -- Reinitialize all characters in string.
+      TC_String    := ICS.Value(TC_chars_ptr, 7);
+
+      if TC_String                 /= TC_String_3 or
+         TC_String(TC_String'Last)  = ACL1.NUL    
+      then
+         Report.Failed("Incorrect result from Function Value - 6");
+      end if;
+
+
+      -- Check that the Function Strlen returns a size_t result that
+      -- corresponds to the number of chars in the array pointed to by
+      -- parameter Item, up to but not including the terminating nul.
+
+      TC_chars_ptr := ICS.New_Char_Array(IC.To_C("A longer string value"));
+      TC_size_t    := ICS.Strlen(TC_chars_ptr);
+
+      if TC_size_t /= 21 then
+         Report.Failed("Incorrect result from Function Strlen - 1"); 
+      end if;
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_2);
+      TC_size_t    := ICS.Strlen(TC_chars_ptr);
+
+      if TC_size_t /= 3 then  -- Nul not included in length.
+         Report.Failed("Incorrect result from Function Strlen - 2"); 
+      end if;
+
+      TC_chars_ptr := ICS.New_Char_Array(IC.To_C(""));
+      TC_size_t    := ICS.Strlen(TC_chars_ptr);
+
+      if TC_size_t /= 0 then
+         Report.Failed("Incorrect result from Function Strlen - 3"); 
+      end if;
+
+
+      -- Check that both of the above versions of Function Value and
+      -- function Strlen propagate Dereference_Error if the Item parameter
+      -- is Null_Ptr.
+
+      begin
+         TC_chars_ptr := ICS.Null_Ptr;
+         TC_String    := ICS.Value(Item => TC_chars_ptr);
+         Report.Failed("Function Value (without Length parameter) did not " &
+                       "raise Dereference_Error when provided a null Item " &
+                       "parameter input value");
+         if TC_String(1) = '1' then   -- Defeat optimization.
+            Report.Comment("Should never be printed");
+         end if;
+      exception
+         when ICS.Dereference_Error => null;  -- OK, expected exception.
+         when others                => 
+           Report.Failed("Incorrect exception raised by Function Value " &
+                         "with Item parameter, when the Item parameter " &
+                         "is Null_Ptr");
+      end;
+
+      begin
+         TC_chars_ptr := ICS.Null_Ptr;
+         TC_String    := ICS.Value(Item => TC_chars_ptr, Length => 4);
+         Report.Failed("Function Value (with Length parameter) did not "    &
+                       "raise Dereference_Error when provided a null Item " &
+                       "parameter input value");
+         if TC_String(1) = '1' then   -- Defeat optimization.
+            Report.Comment("Should never be printed");
+         end if;
+      exception
+         when ICS.Dereference_Error => null;  -- OK, expected exception.
+         when others                => 
+           Report.Failed("Incorrect exception raised by Function Value " &
+                         "with both Item and Length parameters, when "   &
+                         "the Item parameter is Null_Ptr");
+      end;
+
+      begin
+         TC_chars_ptr := ICS.Null_Ptr;
+         TC_size_t    := ICS.Strlen(Item => TC_chars_ptr);
+         Report.Failed("Function Strlen did not raise Dereference_Error" &
+                       "when provided a null Item parameter input value");
+         if TC_size_t = 35 then   -- Defeat optimization.
+            Report.Comment("Should never be printed");
+         end if;
+      exception
+         when ICS.Dereference_Error => null;  -- OK, expected exception.
+         when others                => 
+           Report.Failed("Incorrect exception raised by Function Strlen " &
+                         "when the Item parameter is Null_Ptr");
+      end;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a
new file mode 100644
index 000000000..3771f6e68
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3012.a
@@ -0,0 +1,392 @@
+-- CXB3012.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 Procedure Update modifies the value pointed to by
+--      the chars_ptr parameter Item, starting at the position
+--      corresponding to parameter Offset, using the chars in
+--      char_array parameter Chars.
+--
+--      Check that the version of Procedure Update with a String parameter
+--      behaves in the manner described above, but with the character
+--      values in the String overwriting the char values in Item.
+--
+--      Check that both of the above versions of Procedure Update will
+--      propagate Update_Error if Check is True, and if the length of
+--      the new chars in Chars, when overlaid starting from position
+--      Offset, will overwrite the first nul in Item.
+--
+-- TEST DESCRIPTION:
+--      This test checks two versions of Procedure Update.  In the first
+--      version of the procedure, the parameter Chars indicates a char_array
+--      argument.  These char_array parameters are provided through the use
+--      of the To_C function (with String IN parameter), both with and
+--      without a terminating nul.  In the case below where a terminating nul
+--      char is appended, the effect of "updating" the value pointed to by the
+--      Item parameter will include its shortening, due to the insertion of
+--      this additional nul in the middle of the char_array.
+--
+--      In the second version of Procedure Update evaluated here, the string
+--      parameter Str is used to modify the char_array pointed to by Item.
+--
+--      Finally, both versions of the procedure are evaluated to ensure that
+--      they propagate Update_Error and Dereference_Error under the proper
+--      conditions.
+--
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '-' and '.'.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations that provide
+--      package Interfaces.C.Strings.  If an implementation provides
+--      package Interfaces.C.Strings, this test must compile, execute,
+--      and report "PASSED".
+--
+--
+-- CHANGE HISTORY:
+--      05 Oct 95   SAIC    Initial prerelease version.
+--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Incorporated reviewer comments.
+--      14 Sep 99   RLB     Removed incorrect and unnecessary
+--                          Unchecked_Conversion. Added check for raising
+--                          of Dereference_Error for Update (From Technical
+--                          Corrigendum 1).
+--      07 Jan 05   RLB     Modified to reflect change to Update by AI-242
+--                          (which is expected to be part of Amendment 1).
+--                          [This version allows either semantics.]
+
+--!
+
+with Report;
+with Ada.Exceptions;
+with Interfaces.C.Strings;                                    -- N/A => ERROR
+
+procedure CXB3012 is
+begin
+
+   Report.Test ("CXB3012", "Check that both versions of Procedure Update " &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      package IC  renames Interfaces.C;
+      package ICS renames Interfaces.C.Strings;
+      use Ada.Exceptions;
+
+      use type IC.char;
+      use type IC.char_array;
+      use type IC.size_t;
+      use type ICS.chars_ptr;
+
+      TC_String_1        : String(1..1)    := "J";
+      TC_String_2        : String(1..2)    := "Ab";
+      TC_String_3        : String(1..3)    := "xyz";
+      TC_String_4        : String(1..4)    := "ACVC";
+      TC_String_5        : String(1..5)    := "1a2b3";
+      TC_String_6        : String(1..6)    := "---...";
+      TC_String_7        : String(1..7)    := "AABBBAA";
+      TC_String_8        : String(1..8)    := "aBcDeFgH";
+      TC_String_9        : String(1..9)    := "JustATest";
+      TC_String_10       : String(1..10)   := "0123456789";
+
+      TC_Result_String_1 : constant String := "JXXXXXXXXX";
+      TC_Result_String_2 : constant String := "XXXXXXXXAb";
+      TC_Result_String_3 : constant String := "XXXxyz";
+      TC_Result_String_4 : constant String := "XACVC";
+      TC_Result_String_5 : constant String := "1a2b3";
+      TC_Result_String_6 : constant String := "XXX---...";
+
+      TC_Amd_Result_String_4 :
+                           constant String := "XACVCXXXXX";
+      TC_Amd_Result_String_5 :
+                           constant String := "1a2b3XXXXX";
+      TC_Amd_Result_String_6 :
+                           constant String := "XXX---...X";
+      TC_Amd_Result_String_9 :
+                           constant String := "JustATestX";
+
+      TC_char_array        : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX");
+      TC_Result_char_array : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX");
+      TC_chars_ptr         : ICS.chars_ptr;
+      TC_Length            : IC.size_t;
+
+   begin
+
+      -- Check that Procedure Update modifies the value pointed to by
+      -- the chars_ptr parameter Item, starting at the position
+      -- corresponding to parameter Offset, using the chars in
+      -- char_array parameter Chars.
+      -- Note: If parameter Chars contains a nul char (such as a
+      --       terminating nul), the result may be the overall shortening
+      --       of parameter Item.
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+
+      ICS.Update(Item   => TC_chars_ptr,
+                 Offset => 0,
+                 Chars  => IC.To_C(TC_String_1, False),  -- No nul char.
+                 Check  => True);
+
+      if ICS.Value(TC_chars_ptr) /= TC_Result_String_1 then
+         Report.Failed("Incorrect result from Procedure Update - 1");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr,
+                 Offset => ICS.Strlen(TC_chars_ptr) - 2,
+                 Chars  => IC.To_C(TC_String_2, False),  -- No nul char.
+                 Check  => True);
+
+      if ICS.Value(TC_chars_ptr) /= TC_Result_String_2 then
+         Report.Failed("Incorrect result from Procedure Update - 2");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr,
+                 3,
+                 Chars  => IC.To_C(TC_String_3),   -- Nul appended, shortens
+                 Check  => False);                 -- array.
+
+      if ICS.Value(TC_chars_ptr) /= TC_Result_String_3 then
+         Report.Failed("Incorrect result from Procedure Update - 3");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr,
+                 0,
+                 IC.To_C(TC_String_10), -- Complete replacement of array.
+                 Check  => False);
+
+      if ICS.Value(TC_chars_ptr) /= TC_String_10 then
+         Report.Failed("Incorrect result from Procedure Update - 4");
+      end if;
+
+      -- Perform a character-by-character comparison of the result of
+      -- Procedure Update. Note that char_array lower bound is 0, and
+      -- that the nul char is not compared with any character in the
+      -- string (since the string is not nul terminated).
+      begin
+         TC_Length := ICS.Strlen(TC_chars_ptr);
+         TC_Result_char_array(0..10) := ICS.Value(TC_chars_ptr);
+         for i in 0..TC_Length-1 loop
+            if TC_Result_char_array(i) /=
+               IC.To_C(TC_String_10(Integer(i+1)))
+            then
+               Report.Failed("Incorrect result from the character-by-" &
+                             "character evaluation of the result of "  &
+                             "Procedure Update");
+            end if;
+         end loop;
+      exception
+         when others =>
+           Report.Failed("Exception raised during the character-by-" &
+                         "character evaluation of the result of "    &
+                         "Procedure Update");
+      end;
+      ICS.Free(TC_chars_ptr);
+
+
+
+      -- Check that the version of Procedure Update with a String rather
+      -- than a char_array parameter behaves in the manner described above,
+      -- but with the character values in the String overwriting the char
+      -- values in Item.
+      --
+      -- Note: In Ada 95, In each of the cases below, the String parameter
+      --       Str is treated as if it were nul terminated, which means that
+      --       the char_array pointed to by TC_chars_ptr will be "shortened"
+      --       so that it ends after the last character of the Str
+      --       parameter. For Ada 2005, this rule is dropped, so the
+      --       number of characters remains the same.
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr, 1, TC_String_4, False);
+
+      if ICS.Value(TC_chars_ptr) = TC_Result_String_4 then
+         Report.Comment("Ada 95 result from Procedure Update - 5");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_4 then
+         Report.Comment("Amendment 1 result from Procedure Update - 5");
+      else
+         Report.Failed("Incorrect result from Procedure Update - 5");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(Item   => TC_chars_ptr,
+                 Offset => 0,
+                 Str    => TC_String_5);
+
+      if ICS.Value(TC_chars_ptr) = TC_Result_String_5 then
+         Report.Comment("Ada 95 result from Procedure Update - 6");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_5 then
+         Report.Comment("Amendment 1 result from Procedure Update - 6");
+      else
+         Report.Failed("Incorrect result from Procedure Update - 6");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr,
+                 3,
+                 Str    => TC_String_6,
+                 Check  => True);
+
+      if ICS.Value(TC_chars_ptr) = TC_Result_String_6 then
+         Report.Comment("Ada 95 result from Procedure Update - 7");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_6 then
+         Report.Comment("Amendment 1 result from Procedure Update - 7");
+      else
+         Report.Failed("Incorrect result from Procedure Update - 7");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+
+      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+      ICS.Update(TC_chars_ptr, 0, TC_String_9, True);
+
+      if ICS.Value(TC_chars_ptr) = TC_String_9 then
+         Report.Comment("Ada 95 result from Procedure Update - 8");
+      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_9 then
+         Report.Comment("Amendment 1 result from Procedure Update - 8");
+      else
+         Report.Failed("Incorrect result from Procedure Update - 8");
+      end if;
+      ICS.Free(TC_chars_ptr);
+
+      -- Check what happens if the string and array are the same size (this
+      -- is the case that caused the change made by the Amendment).
+      begin
+         TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => 0,
+                    Str    => TC_String_10,
+                    Check  => True);
+          if ICS.Value(TC_chars_ptr) = TC_String_10 then
+             Report.Comment("Amendment 1 result from Procedure Update - 9");
+          else
+             Report.Failed("Incorrect result from Procedure Update - 9");
+          end if;
+      exception
+         when ICS.Update_Error =>
+             Report.Comment("Ada 95 exception expected from Procedure Update - 9");
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Str parameter - 9");
+      end;
+      ICS.Free(TC_chars_ptr);
+
+
+      -- Check that both of the above versions of Procedure Update will
+      -- propagate Update_Error if Check is True, and if the length of
+      -- the new chars in Chars, when overlaid starting from position
+      -- Offset, will overwrite the first nul in Item.
+
+      begin
+         TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => 5,
+                    Chars  => IC.To_C(TC_String_7),
+                    Check  => True);
+         Report.Failed("Update_Error not raised by Procedure Update with " &
+                       "Chars parameter");
+         Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " &
+                        "optimization - should never be printed");
+      exception
+         when ICS.Update_Error => null;  -- OK, expected exception.
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Chars parameter");
+      end;
+
+      ICS.Free(TC_chars_ptr);
+
+      begin
+         TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => ICS.Strlen(TC_chars_ptr),
+                    Str    => TC_String_8); -- Default Check parameter value.
+         Report.Failed("Update_Error not raised by Procedure Update with " &
+                       "Str parameter");
+         Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " &
+                        "optimization - should never be printed");
+      exception
+         when ICS.Update_Error => null;  -- OK, expected exception.
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Str parameter");
+      end;
+
+      ICS.Free(TC_chars_ptr);
+
+      -- Check that both of the above versions of Procedure Update will
+      -- propagate Dereference_Error if Item is Null_Ptr.
+      -- Note: Free sets TC_chars_ptr to Null_Ptr.
+
+      begin
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => 5,
+                    Chars  => IC.To_C(TC_String_7),
+                    Check  => True);
+         Report.Failed("Dereference_Error not raised by Procedure Update with " &
+                       "Chars parameter");
+      exception
+         when ICS.Dereference_Error => null;  -- OK, expected exception.
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Chars parameter");
+      end;
+
+      begin
+         ICS.Update(Item   => TC_chars_ptr,
+                    Offset => ICS.Strlen(TC_chars_ptr),
+                    Str    => TC_String_8); -- Default Check parameter value.
+         Report.Failed("Dereference_Error not raised by Procedure Update with " &
+                       "Str parameter");
+      exception
+         when ICS.Dereference_Error => null;  -- OK, expected exception.
+         when others           =>
+           Report.Failed("Incorrect exception raised by Procedure Update " &
+                         "with Str parameter");
+      end;
+
+   exception
+      when The_Error : others =>
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30130.c b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30130.c
new file mode 100644
index 000000000..57662a323
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30130.c
@@ -0,0 +1,86 @@
+/*
+-- CXB30130.C                                                            
+--                                                                       
+--                             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.
+--*
+--                                                                       
+-- FUNCTION NAME: CXB30130   ("square_it")                               
+--                                                                       
+-- FUNCTION DESCRIPTION:                                                 
+--      This C function returns the square of num1 through the function  
+--      name, and returns the square of parameters num2, num3, and num4  
+--      through the argument list (modifying the objects pointed to by   
+--      the parameters).                         
+--
+-- INPUTS:
+--      This function requires that four parameters be passed to it.
+--      The types of these parameters are, in order: int, pointer to short, 
+--      pointer to float, and pointer to double.
+--
+-- PROCESSING:
+--      The function will calculate the square of the int parameter (num1),
+--      and return this value as the function result through the function
+--      name.  The function will also calculate the square of the values
+--      pointed to by the remaining three parameters (num2, num3, num4), 
+--      and will modify the referenced memory locations to contain the 
+--      squared values.
+--
+-- OUTPUTS:                        
+--      The square of num1 is returned through function name. 
+--      Parameters num2-num4 now point to values that are the squared results
+--      of the originally referenced values (i.e., the original values are
+--      modified as a result of this function).
+--                                                                       
+-- CHANGE HISTORY:                                                       
+--      12 Oct 95   SAIC    Initial prerelease version.                  
+--                                                                       
+--!
+*/
+                                                                         
+int CXB30130 (int num1, short* num2, float* num3, double* num4)          
+                                                                         
+/* NOTE: The above function definition should be accepted by an ANSI-C   */
+/*       compiler.  Older C compilers may reject it; they may, however   */
+/*       accept the following five lines.  An implementation may comment */
+/*       out the above function definition and uncomment the following   */
+/*       one.  Otherwise, an implementation must provide the necessary   */
+/*       modifications to this C code to satisfy the function            */
+/*       requirements (see Function Description).                        */
+/*                                                                       */
+/*  int CXB30130 (num1, num2, num3, num4)                                */
+/*     int     num1;                                                     */
+/*     short*  num2;                                                     */
+/*     float*  num3;                                                     */
+/*     double* num4;                                                     */
+/*                                                                       */
+
+{
+   int return_value = 0;
+
+   return_value = num1 * num1;
+   *num2 = *num2 * *num2; /* Return square of these parameters through   */
+   *num3 = *num3 * *num3; /* the parameter list.                         */
+   *num4 = *num4 * *num4;
+
+   return (return_value); /* Return square of num1 through function name */
+}
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30131.c b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30131.c
new file mode 100644
index 000000000..6cbbdd131
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30131.c
@@ -0,0 +1,104 @@
+/*
+-- CXB30131.C                                                           
+--                                                                      
+--                             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.
+--*
+--                                                                      
+-- FUNCTION NAME: CXB30131   ("combine_two_strings")                    
+--                                                                      
+-- FUNCTION DESCRIPTION:                                                
+--      This C function returns a pointer to the combination of two     
+--      input strings. 
+--                                                                      
+-- INPUTS:
+--      This function requires that two parameters be passed to it.
+--      The type of both of these parameters are pointer to char (which
+--      is used to reference an array of chars).
+--
+-- PROCESSING:
+--      The function will create a char array that is equal to the combined
+--      length of the char arrays referenced by the two input parameters.
+--      The char elements contained in the char arrays specified by the 
+--      parameters will be combined (in order) into this new char array.
+--
+-- OUTPUTS:                        
+--      The newly created char array will be returned as the function
+--      result through the function name.  The char arrays referenced by the
+--      two parameters will be unaffected.
+--                                                                       
+-- CHANGE HISTORY:                                                      
+--      12 Oct 95   SAIC    Initial prerelease version. 
+--      26 Oct 96   SAIC    Modified temp array initialization.                
+--      15 Feb 99   RLB     Repaired to remove non-standard function strdup.
+--!
+*/
+
+#include <string.h>
+#include <stdlib.h>
+
+char *stringdup (char *s)
+{
+  char *result = malloc(sizeof(char)*(strlen(s)+1));
+  return strcpy(result,s);
+}
+
+char *CXB30131 (char *string1, char *string2)
+
+/* NOTE: The above function definition should be accepted by an ANSI-C    */
+/*       compiler.  Older C compilers may reject it; they may, however    */
+/*       accept the following three lines.  An implementation may comment */
+/*       out the above function definition and uncomment the following    */
+/*       one.  Otherwise, an implementation must provide the necessary    */
+/*       modifications to this C code to satisfy the function             */
+/*       requirements (see Function Description).                         */
+/*                                                                        */
+/*   char *CXB30131 (string1, string2)                                    */
+/*      char *string1;                                                    */
+/*      char *string2;                                                    */
+
+{
+   char temp[100];  /* Local array that holds the combined strings */
+   int  index;      /* Loop counter */
+   int  length = 0; /* Variable that holds the length of the strings */
+
+   /* Initialize the local array */
+   for (index = 0; index < 100; index++)
+   { temp[index] = 0; }
+
+   /* Use the library function strcpy to copy the contents of string1 
+      into temp.  */
+   strcpy (temp, string1);
+
+   /* Use the library function strlen to determine the number of 
+      characters in the temp array (without the trailing nul). */
+   length = strlen (temp);
+
+   /* Add each character in string2 into the temp array, add nul 
+      to the end of the array. */
+   for (index = length; *string2 != '\0'; index++)
+   { temp[index] = *string2++; }
+   temp[index] = '\0';
+
+   /* Use the library function strdup to return a pointer to temp. */
+   return (stringdup(temp));
+}
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am
new file mode 100644
index 000000000..4cff400b8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb30132.am
@@ -0,0 +1,205 @@
+-- CXB30132.AM
+--
+--                             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 imported, user-defined C language functions can be 
+--      called from an Ada program.
+--      
+-- TEST DESCRIPTION:
+--      This test checks that user-defined C language functions can be
+--      imported and referenced from an Ada program.  Two C language
+--      functions are specified in files CXB30130.C and CXB30131.C.  
+--      These two functions are imported to this test program, using two
+--      calls to Pragma Import.  Each function is then called in this test,
+--      and the results of the call are verified.
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', 'a'..'z', and 'A'..'Z'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      packages Interfaces.C and Interfaces.C.Strings.  If an 
+--      implementation provides packages Interfaces.C and 
+--      Interfaces.C.Strings, this test must compile, execute, and 
+--      report "PASSED".
+--
+-- SPECIAL REQUIREMENTS:
+--      The files CXB30130.C and CXB30131.C must be compiled with a C 
+--      compiler.  Implementation dialects of C may require alteration of 
+--      the C program syntax (see individual C files).
+--     
+--      Note that the compiled C code must be bound with the compiled Ada
+--      code to create an executable image.  An implementation must provide
+--      the necessary commands to accomplish this.
+--     
+--      Note that the C code included in CXB30130.C and CXB30131.C conforms
+--      to ANSI-C.  Modifications to these files may be required for other
+--      C compilers.  An implementation must provide the necessary 
+--      modifications to satisfy the function requirements.
+--     
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         CXB30130.C
+--         CXB30131.C
+--         CXB30132.AM
+--
+--       
+-- CHANGE HISTORY:
+--      13 Oct 95   SAIC    Initial prerelease version.
+--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Impdef;
+with Interfaces.C;                                            -- N/A => ERROR
+with Interfaces.C.Strings;                                    -- N/A => ERROR
+
+procedure CXB30132 is
+begin
+
+   Report.Test ("CXB3013", "Check that user-defined C functions can " &
+                           "be imported into an Ada program");
+
+   Test_Block:
+   declare
+
+      package IC  renames Interfaces.C;
+      package ICS renames Interfaces.C.Strings;
+
+      use type IC.char_array;
+      use type IC.int;
+      use type IC.short;
+      use type IC.C_float;
+      use type IC.double;
+
+      type Short_Ptr          is access all IC.short;
+      type Float_Ptr          is access all IC.C_float;
+      type Double_Ptr         is access all IC.double;
+      subtype Char_Array_Type is IC.char_array(0..20);
+
+      TC_Default_int      : IC.int             :=   49;
+      TC_Default_short    : IC.short           :=    3;
+      TC_Default_float    : IC.C_float         :=   50.0;
+      TC_Default_double   : IC.double          := 1209.0; 
+
+      An_Int_Value        : IC.int             := TC_Default_int;
+      A_Short_Value       : aliased IC.short   := TC_Default_short;
+      A_Float_Value       : aliased IC.C_float := TC_Default_float; 
+      A_Double_Value      : aliased IC.double  := TC_Default_double;
+
+      A_Short_Int_Pointer : Short_Ptr          := A_Short_Value'access;
+      A_Float_Pointer     : Float_Ptr          := A_Float_Value'access;
+      A_Double_Pointer    : Double_Ptr         := A_Double_Value'access;
+
+      Char_Array_1        : Char_Array_Type;
+      Char_Array_2        : Char_Array_Type;
+      Char_Pointer        : ICS.chars_ptr;
+
+      TC_Char_Array       : constant Char_Array_Type := 
+                              "Look before you leap" & IC.nul;
+      TC_Return_int       : IC.int := 0;
+
+      -- The Square_It function returns the square of the value The_Int 
+      -- through the function name, and returns the square of the other
+      -- parameters through the parameter list (the last three parameters 
+      -- are access values).
+
+      function Square_It (The_Int    : in IC.int;
+                          The_Short  : in Short_Ptr;
+                          The_Float  : in Float_Ptr;
+                          The_Double : in Double_Ptr) return IC.int;
+
+      -- The Combine_Strings function returns the result of the catenation
+      -- of the two string parameters through the function name.
+
+      function Combine_Strings (First_Part  : in IC.char_array;
+                                Second_Part : in IC.char_array) 
+        return ICS.chars_ptr;
+
+
+      -- Use the user-defined C function square_it as a completion to the
+      -- function specification above.
+
+     pragma Import (Convention    => C, 
+                    Entity        => Square_It, 
+                    External_Name => Impdef.CXB30130_External_Name);
+
+      -- Use the user-defined C function combine_two_strings as a completion
+      -- to the function specification above.
+
+     pragma Import (C, Combine_Strings, Impdef.CXB30131_External_Name);
+
+
+   begin
+
+      -- Check that the imported version of C function CXB30130 produces 
+      -- the correct results.
+
+      TC_Return_int := Square_It (The_Int    => An_Int_Value,
+                                  The_Short  => A_Short_Int_Pointer,
+                                  The_Float  => A_Float_Pointer,
+                                  The_Double => A_Double_Pointer);
+
+      -- Compare the results with the expected results.  Note that in the
+      -- case of the three "pointer" parameters, the objects being pointed
+      -- to have been modified as a result of the function.
+
+      if TC_Return_int           /= An_Int_Value      * An_Int_Value      or
+         A_Short_Int_Pointer.all /= TC_Default_short  * TC_Default_Short  or
+         A_Short_Value           /= TC_Default_short  * TC_Default_Short  or
+         A_Float_Pointer.all     /= TC_Default_float  * TC_Default_float  or
+         A_Float_Value           /= TC_Default_float  * TC_Default_float  or
+         A_Double_Pointer.all    /= TC_Default_double * TC_Default_double or
+         A_Double_Value          /= TC_Default_double * TC_Default_double 
+      then
+         Report.Failed("Incorrect results returned from function square_it");
+      end if;
+
+
+      -- Check that two char_array values are combined by the imported 
+      -- C function CXB30131.
+
+      Char_Array_1(0..12) := "Look before " & IC.nul;
+      Char_Array_2(0..8)  := "you leap"     & IC.nul;
+
+      Char_Pointer := Combine_Strings (Char_Array_1, Char_Array_2);
+
+      if ICS.Value(Char_Pointer) /= TC_Char_Array then
+         Report.Failed("Incorrect value returned from imported function " &
+                       "combine_two_strings");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXB30132;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a
new file mode 100644
index 000000000..a9b386ffc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a
@@ -0,0 +1,254 @@
+-- CXB3014.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 Function Value with Pointer and Element 
+--      parameters will return an Element_Array result of correct size 
+--      and content (up to and including the first "terminator" Element). 
+--
+--      Check that the Function Value with Pointer and Length parameters 
+--      will return an Element_Array result of appropriate size and content
+--      (the first Length elements pointed to by the parameter Ref).
+--
+--      Check that both versions of Function Value will propagate 
+--      Interfaces.C.Strings.Dereference_Error when the value of
+--      the Ref pointer parameter is null.
+--
+-- TEST DESCRIPTION:
+--      This test tests that both versions of Function Value from the 
+--      generic package Interfaces.C.Pointers are available and produce
+--      correct results.  The generic package is instantiated with size_t,
+--      char, char_array, and nul as actual parameters, and subtests are
+--      performed on each of the Value functions resulting from this
+--      instantiation.
+--      For both function versions, a test is performed where a portion of
+--      a char_array is to be returned as the function result.  Likewise,
+--      a test is performed where each version of the function returns the
+--      entire char_array referenced by the in parameter Ref.
+--      Finally, both versions of Function Value are called with a null
+--      pointer reference, to ensure that Dereference_Error is raised in
+--      this case.
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', 'a'..'z', and 'A'..'Z'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      packages Interfaces.C.Strings and Interfaces.C.Pointers.  If an 
+--      implementation provides packages Interfaces.C.Strings and 
+--      Interfaces.C.Pointers, this test must compile, execute, and 
+--      report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      19 Oct 95   SAIC    Initial prerelease version.
+--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      23 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Interfaces.C.Strings;                                    -- N/A => ERROR
+with Interfaces.C.Pointers;                                   -- N/A => ERROR
+
+procedure CXB3014 is
+
+begin
+
+   Report.Test ("CXB3014", "Check that versions of the Value function "  &
+                           "from package Interfaces.C.Pointers produce " &
+                           "correct results");
+
+   Test_Block:
+   declare
+
+      use type Interfaces.C.char, Interfaces.C.size_t;
+
+      Char_a : constant Interfaces.C.char := 'a';
+      Char_j : constant Interfaces.C.char := 'j';
+      Char_z : constant Interfaces.C.char := 'z';
+
+      subtype Lower_Case_chars is Interfaces.C.char range Char_a..Char_z;
+      subtype Char_Range       is Interfaces.C.size_t range 0..26;
+
+      Local_nul       : aliased Interfaces.C.char := Interfaces.C.nul;
+      TC_Array_Size   : Interfaces.C.size_t := 20;
+
+      TC_String_1     : constant String := "abcdefghij";
+      TC_String_2     : constant String := "abcdefghijklmnopqrstuvwxyz";
+      TC_String_3     : constant String := "abcdefghijklmnopqrst";
+      TC_String_4     : constant String := "abcdefghijklmnopqrstuvwxyz";
+      TC_Blank_String : constant String := "                          ";
+
+      TC_Char_Array   : Interfaces.C.char_array(Char_Range) :=
+                          Interfaces.C.To_C(TC_String_2, True);
+
+      TC_Char_Array_1 : Interfaces.C.char_array(0..9);
+      TC_Char_Array_2 : Interfaces.C.char_array(Char_Range);
+      TC_Char_Array_3 : Interfaces.C.char_array(0..TC_Array_Size-1);
+      TC_Char_Array_4 : Interfaces.C.char_array(Char_Range);
+
+      package Char_Pointers is new 
+        Interfaces.C.Pointers (Index              => Interfaces.C.size_t,
+                               Element            => Interfaces.C.char,
+                               Element_Array      => Interfaces.C.char_array,
+                               Default_Terminator => Interfaces.C.nul);
+
+      Char_Ptr : Char_Pointers.Pointer;
+
+      use type Char_Pointers.Pointer;
+
+   begin
+
+      -- Check that the Function Value with Pointer and Terminator Element 
+      -- parameters will return an Element_Array result of appropriate size 
+      -- and content (up to and including the first "terminator" Element.) 
+
+      Char_Ptr := TC_Char_Array(0)'Access;
+
+      -- Provide a new Terminator char in the call of Function Value.
+      -- This call should return only a portion (the first 10 chars) of
+      -- the referenced char_array, up to and including the char 'j'.
+
+      TC_Char_Array_1 := Char_Pointers.Value(Ref        => Char_Ptr,
+                                             Terminator => Char_j);
+
+      if Interfaces.C.To_Ada(TC_Char_Array_1, False) /= TC_String_1 or
+         Interfaces.C.Is_Nul_Terminated(TC_Char_Array_1)
+      then
+         Report.Failed("Incorrect result from Function Value with Ref " &
+                       "and Terminator parameters, when supplied with " &
+                       "a non-default Terminator char");
+      end if;
+
+      -- Use the default Terminator char in the call of Function Value.
+      -- This call should return the entire char_array, including the 
+      -- terminating nul char.
+
+      TC_Char_Array_2 := Char_Pointers.Value(Char_Ptr);
+
+      if Interfaces.C.To_Ada(TC_Char_Array_2, True) /= TC_String_2 or
+         not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_2)
+      then
+         Report.Failed("Incorrect result from Function Value with Ref " &
+                       "and Terminator parameters, when using the "     &
+                       "default Terminator char");
+      end if;
+
+
+
+      -- Check that the Function Value with Pointer and Length parameters 
+      -- will return an Element_Array result of appropriate size and content
+      -- (the first Length elements pointed to by the parameter Ref).
+      
+      -- This call should return only a portion (the first 20 chars) of
+      -- the referenced char_array.
+
+      TC_Char_Array_3 := 
+        Char_Pointers.Value(Ref    => Char_Ptr,
+                            Length => Interfaces.C.ptrdiff_t(TC_Array_Size));
+
+      -- Verify the individual chars of the result.
+      for i in 0..TC_Array_Size-1 loop
+         if Interfaces.C.To_Ada(TC_Char_Array_3(i)) /= 
+            TC_String_3(Integer(i)+1)
+         then
+            Report.Failed("Incorrect result from Function Value with "  &
+                          "Ref and Length parameters, when specifying " &
+                          "a length less than the full array size");
+            exit;
+         end if;
+      end loop;
+
+      -- This call should return the entire char_array, including the 
+      -- terminating nul char.
+
+      TC_Char_Array_4 := Char_Pointers.Value(Char_Ptr, 27);
+
+      if Interfaces.C.To_Ada(TC_Char_Array_4, True) /= TC_String_4 or
+         not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_4)
+      then
+         Report.Failed("Incorrect result from Function Value with Ref " &
+                       "and Length parameters, when specifying the "    &
+                       "entire array size");
+      end if;
+
+
+
+      -- Check that both of the above versions of Function Value will 
+      -- propagate Interfaces.C.Strings.Dereference_Error when the value of
+      -- the Ref Pointer parameter is null.
+
+      Char_Ptr := null;
+
+      begin
+         TC_Char_Array_1 := Char_Pointers.Value(Ref        => Char_Ptr,
+                                                Terminator => Char_j);
+         Report.Failed("Dereference_Error not raised by Function " &
+                       "Value with Terminator parameter, when "    &
+                       "provided a null reference");
+         -- Call Report.Comment to ensure that the assignment to 
+         -- TC_Char_Array_1 is not "dead", and therefore can not be 
+         -- optimized away.
+         Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_1, False));
+      exception
+         when Interfaces.C.Strings.Dereference_Error => 
+           null;  -- OK, expected exception.
+         when others =>
+           Report.Failed("Incorrect exception raised by Function " &
+                         "Value with Terminator parameter, when "  &
+                         "provided a null reference");
+      end;
+
+
+      begin
+         TC_Char_Array_3 := 
+           Char_Pointers.Value(Char_Ptr,
+                               Interfaces.C.ptrdiff_t(TC_Array_Size));
+         Report.Failed("Dereference_Error not raised by Function "   &
+                       "Value with Length parameter, when provided " &
+                       "a null reference");
+         -- Call Report.Comment to ensure that the assignment to 
+         -- TC_Char_Array_3 is not "dead", and therefore can not be 
+         -- optimized away.
+         Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_3, False));
+      exception
+         when Interfaces.C.Strings.Dereference_Error => 
+           null;  -- OK, expected exception.
+         when others =>
+           Report.Failed("Incorrect exception raised by Function " &
+                         "Value with Length parameter, when "      &
+                         "provided a null reference");
+      end;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3014;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3015.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3015.a
new file mode 100644
index 000000000..24ec826fa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3015.a
@@ -0,0 +1,520 @@
+-- CXB3015.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 "+" and "-" functions with Pointer and ptrdiff_t
+--      parameters that return Pointer values produce correct results,
+--      based on the size of the array elements.
+--
+--      Check that the "-" function with two Pointer parameters that
+--      returns a ptrdiff_t type parameter produces correct results,
+--      based on the size of the array elements.
+--
+--      Check that each of the "+" and "-" functions above will
+--      propagate Pointer_Error if a Pointer parameter is null.
+--
+--      Check that the Increment and Decrement procedures provide the
+--      correct "pointer arithmetic" operations.
+--
+-- TEST DESCRIPTION:
+--      This test checks that the functions "+" and "-", and the procedures
+--      Increment and Decrement in the generic package Interfaces.C.Pointers
+--      will allow the user to perform "pointer arithmetic" operations on
+--      Pointer values.
+--      Package Interfaces.C.Pointers is instantiated three times, for
+--      short values, chars, and arrays of arrays.  Pointers from each
+--      instantiated package are then used to reference different elements
+--      of array objects.  Pointer arithmetic operations are performed on
+--      these pointers, and the results of these operations are verified
+--      against expected pointer positions along the referenced arrays.
+--      The propagation of Pointer_Error is checked for when the function
+--      Pointer parameter is null.
+--
+--      The following chart indicates the combinations of subprograms and
+--      parameter types used in this test.
+--
+--
+--                                 Short    Char    Array
+--                               --------------------------
+--      "+" Pointer, ptrdiff_t  |   X    |        |   X    |
+--                              |--------------------------|
+--      "+" ptrdiff_t, Pointer  |   X    |        |   X    |
+--                              |--------------------------|
+--      "-" Pointer, ptrdiff_t  |        |   X    |   X    |
+--                              |--------------------------|
+--      "-" Pointer, Pointer    |        |   X    |   X    |
+--                              |--------------------------|
+--      Increment (Pointer)     |   X    |        |   X    |
+--                              |--------------------------|
+--      Decrement (Pointer)     |   X    |        |   X    |
+--                               --------------------------
+--
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', and 'a'..'z'.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is applicable to all implementations that provide
+--      package Interfaces.C.Pointers.  If an implementation provides
+--      package Interfaces.C.Pointers, this test must compile, execute, and
+--      report "PASSED".
+--
+--
+-- CHANGE HISTORY:
+--      26 Oct 95   SAIC    Initial prerelease version.
+--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Incorporated reviewer comments.
+--      06 Mar 00   RLB     Repaired so that array of arrays component
+--                          type is statically constrained. (C does not have
+--                          an analog to an array of dynamically constrained
+--                          arrays.)
+
+with Report;
+with Ada.Exceptions;
+with Interfaces.C.Pointers;                                   -- N/A => ERROR
+
+procedure CXB3015 is
+begin
+
+   Report.Test ("CXB3015", "Check that +, -, Increment, and Decrement "    &
+                           "subprograms in Package Interfaces.C.Pointers " &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+      use type Interfaces.C.short;
+      use type Interfaces.C.size_t, Interfaces.C.ptrdiff_t;
+      use type Interfaces.C.char,   Interfaces.C.char_array;
+
+      TC_Count         : Interfaces.C.size_t;
+      TC_Increment     : Interfaces.C.ptrdiff_t;
+      TC_ptrdiff_t     : Interfaces.C.ptrdiff_t;
+      TC_Short         : Interfaces.C.short  :=   0;
+      TC_Verbose       : Boolean             := False;
+      Constant_Min_Array_Size   : constant Interfaces.C.size_t :=   0;
+      Constant_Max_Array_Size   : constant Interfaces.C.size_t :=  20;
+      Min_Array_Size   : Interfaces.C.size_t :=  Interfaces.C.size_t(
+                         Report.Ident_Int(Integer(Constant_Min_Array_Size)));
+      Max_Array_Size   : Interfaces.C.size_t :=  Interfaces.C.size_t(
+                         Report.Ident_Int(Integer(Constant_Max_Array_Size)));
+      Min_size_t,
+      Max_size_t       : Interfaces.C.size_t;
+      Short_Terminator : Interfaces.C.short  := Interfaces.C.short'Last;
+      Alphabet         : constant String     := "abcdefghijklmnopqrstuvwxyz";
+
+
+      type Short_Array_Type is
+        array (Interfaces.C.size_t range <>) of aliased Interfaces.C.short;
+
+      type Constrained_Array_Type is
+        array (Min_Array_Size..Max_Array_Size) of aliased Interfaces.C.short;
+
+      type Static_Constrained_Array_Type is
+        array (Constant_Min_Array_Size .. Constant_Max_Array_Size) of
+          aliased Interfaces.C.short;
+
+      type Array_of_Arrays_Type is
+        array (Interfaces.C.size_t range <>) of aliased
+        Static_Constrained_Array_Type;
+
+
+      Short_Array       : Short_Array_Type(Min_Array_Size..Max_Array_Size);
+
+      Constrained_Array : Constrained_Array_Type;
+
+      Terminator_Array  : Static_Constrained_Array_Type :=
+                            (others => Short_Terminator);
+
+      Ch_Array          : Interfaces.C.char_array
+                            (0..Interfaces.C.size_t(Alphabet'Length)) :=
+                              Interfaces.C.To_C(Alphabet, True);
+
+      Array_of_Arrays   : Array_of_Arrays_Type
+                            (Min_Array_Size..Max_Array_Size);
+
+
+      package Short_Pointers is new
+        Interfaces.C.Pointers (Index              => Interfaces.C.size_t,
+                               Element            => Interfaces.C.short,
+                               Element_Array      => Short_Array_Type,
+                               Default_Terminator => Short_Terminator);
+
+      package Char_Pointers is new
+        Interfaces.C.Pointers (Interfaces.C.size_t,
+                               Interfaces.C.char,
+                               Element_Array      => Interfaces.C.char_array,
+                               Default_Terminator => Interfaces.C.nul);
+
+      package Array_Pointers is new
+        Interfaces.C.Pointers (Interfaces.C.size_t,
+                               Static_Constrained_Array_Type,
+                               Array_of_Arrays_Type,
+                               Terminator_Array);
+
+
+      use Short_Pointers, Char_Pointers, Array_Pointers;
+
+      Short_Ptr       : Short_Pointers.Pointer := Short_Array(0)'Access;
+      Char_Ptr        : Char_Pointers.Pointer  := Ch_Array(0)'Access;
+      Start_Char_Ptr  : Char_Pointers.Pointer  := Ch_Array(1)'Access;
+      End_Char_Ptr    : Char_Pointers.Pointer  := Ch_Array(10)'Access;
+      Array_Ptr       : Array_Pointers.Pointer := Array_of_Arrays(0)'Access;
+      Start_Array_Ptr : Array_Pointers.Pointer := Array_of_Arrays(1)'Access;
+      End_Array_Ptr   : Array_Pointers.Pointer := Array_of_Arrays(10)'Access;
+
+   begin
+
+      -- Provide initial values for the arrays that hold short int values.
+
+      for i in Min_Array_Size..Max_Array_Size-1 loop
+         Short_Array(i) := Interfaces.C.short(i);
+         for j in Min_Array_Size..Max_Array_Size loop
+            -- Initialize this "array of arrays" so that element (i)(0)
+            -- is different for each value of i.
+            Array_of_Arrays(i)(j) := TC_Short;
+            TC_Short := TC_Short + 1;
+         end loop;
+      end loop;
+
+      -- Set the final element of each array object to be the "terminator"
+      -- element used in the instantiations above.
+
+      Short_Array(Max_Array_Size)     := Short_Terminator;
+      Array_of_Arrays(Max_Array_Size) := Terminator_Array;
+
+      -- Check starting pointer positions.
+
+      if Short_Ptr.all /= 0           or
+         Char_Ptr.all  /= Ch_Array(0) or
+         Array_Ptr.all /= Array_of_Arrays(0)
+      then
+         Report.Failed("Incorrect initial value for the first " &
+                       "Short_Array, Ch_Array, or Array_of_Array values");
+      end if;
+
+
+      -- Check that both versions of the "+" function with Pointer and
+      -- ptrdiff_t parameters, that return a Pointer value, produce correct
+      -- results, based on the size of the array elements.
+
+      for i in Min_Array_Size + 1 .. Max_Array_Size loop
+
+         if Integer(i)/2*2 /= Integer(i)  then -- Odd numbered loops.
+            -- Pointer + ptrdiff_t, increment by 1.
+            Short_Ptr := Short_Ptr + 1;
+         else                                  -- Even numbered loops.
+            -- ptrdiff_t + Pointer, increment by 1.
+            Short_Ptr := 1 + Short_Ptr;
+         end if;
+
+         if Short_Ptr.all /= Short_Array(i) then
+            Report.Failed("Incorrect value returned following use " &
+                          "of the function +, incrementing by 1, "  &
+                          "array position : " & Integer'Image(Integer(i)));
+            if not TC_Verbose then
+               exit;
+            end if;
+         end if;
+      end loop;
+
+      Array_Ptr    := Array_of_Arrays(Min_Array_Size)'Access;
+      TC_Count     := Min_Array_Size;
+      TC_Increment := 3;
+      while TC_Count+Interfaces.C.size_t(TC_Increment) < Max_Array_Size loop
+
+         if Integer(TC_Count)/2*2 /= Integer(TC_Count) then
+            -- Odd numbered loops.
+            -- Pointer + ptrdiff_t, increment by 3.
+            Array_Ptr := Array_Pointers."+"(Array_Ptr, TC_Increment);
+         else
+            -- Odd numbered loops.
+            -- ptrdiff_t + Pointer, increment by 3.
+            Array_Ptr := Array_Pointers."+"(Left  => TC_Increment,
+                                            Right => Array_Ptr);
+         end if;
+
+         if Array_Ptr.all /=
+            Array_of_Arrays(TC_Count+Interfaces.C.size_t(TC_Increment))
+         then
+            Report.Failed("Incorrect value returned following use " &
+                          "of the function +, incrementing by "     &
+                          Integer'Image(Integer(TC_Increment))      &
+                          ", array position : "                     &
+                          Integer'Image(Integer(TC_Count) +
+                                        Integer(TC_Increment)));
+            if not TC_Verbose then
+               exit;
+            end if;
+         end if;
+
+         TC_Count := TC_Count + Interfaces.C.size_t(TC_Increment);
+      end loop;
+
+
+
+      -- Check that the "-" function with Pointer and ptrdiff_t parameters,
+      -- that returns a Pointer result, produces correct results, based
+      -- on the size of the array elements.
+
+      -- Set the pointer to the last element in the char_array, which is a
+      -- nul char.
+      Char_Ptr := Ch_Array(Interfaces.C.size_t(Alphabet'Length))'Access;
+
+      if Char_Ptr.all /= Interfaces.C.nul then
+         Report.Failed("Incorrect initial value for the last " &
+                       "Ch_Array value");
+      end if;
+
+      Min_size_t := 1;
+      Max_size_t := Interfaces.C.size_t(Alphabet'Length);
+
+      for i in reverse Min_size_t..Max_size_t loop
+
+         -- Subtract 1 from the pointer; it should now point to the previous
+         -- element in the array.
+         Char_Ptr := Char_Ptr - 1;
+
+         if Char_Ptr.all /= Ch_Array(i-1) then
+            Report.Failed("Incorrect value returned following use "        &
+                          "of the function '-' with char element values, " &
+                          "array position : " & Integer'Image(Integer(i-1)));
+            if not TC_Verbose then
+               exit;
+            end if;
+         end if;
+      end loop;
+
+      Array_Ptr    := Array_of_Arrays(Max_Array_Size)'Access;
+      TC_Count     := Max_Array_Size;
+      TC_Increment := 3;
+      while TC_Count > Min_Array_Size+Interfaces.C.size_t(TC_Increment) loop
+
+         -- Decrement the pointer by 3.
+         Array_Ptr := Array_Pointers."-"(Array_Ptr, Right => 3);
+
+         if Array_Ptr.all /=
+            Array_of_Arrays(TC_Count - Interfaces.C.size_t(TC_Increment))
+         then
+            Report.Failed("Incorrect value returned following use " &
+                          "of the function -, decrementing by "     &
+                          Integer'Image(Integer(TC_Increment))      &
+                          ", array position : "                     &
+                          Integer'Image(Integer(TC_Count-3)));
+            if not TC_Verbose then
+               exit;
+            end if;
+         end if;
+
+         TC_Count := TC_Count - Interfaces.C.size_t(TC_Increment);
+      end loop;
+
+
+
+      -- Check that the "-" function with two Pointer parameters, that
+      -- returns a ptrdiff_t type result, produces correct results,
+      -- based on the size of the array elements.
+
+      TC_ptrdiff_t := 9;
+      if Char_Pointers."-"(Left  => End_Char_Ptr,
+                           Right => Start_Char_Ptr) /= TC_ptrdiff_t
+      then
+         Report.Failed("Incorrect result from pointer-pointer " &
+                       "subtraction - 1");
+      end if;
+
+      Start_Char_Ptr := Ch_Array(1)'Access;
+      End_Char_Ptr   := Ch_Array(25)'Access;
+
+      TC_ptrdiff_t := 24;
+      if Char_Pointers."-"(End_Char_Ptr,
+                           Right => Start_Char_Ptr) /= TC_ptrdiff_t
+      then
+         Report.Failed("Incorrect result from pointer-pointer " &
+                       "subtraction - 2");
+      end if;
+
+      TC_ptrdiff_t := 9;
+      if Array_Pointers."-"(End_Array_Ptr,
+                            Start_Array_Ptr) /= TC_ptrdiff_t
+      then
+         Report.Failed("Incorrect result from pointer-pointer " &
+                       "subtraction - 3");
+      end if;
+
+      Start_Array_Ptr := Array_of_Arrays(Min_Array_Size)'Access;
+      End_Array_Ptr   := Array_of_Arrays(Max_Array_Size)'Access;
+
+      TC_ptrdiff_t := Interfaces.C.ptrdiff_t(Max_Array_Size) -
+                      Interfaces.C.ptrdiff_t(Min_Array_Size);
+      if End_Array_Ptr - Start_Array_Ptr /= TC_ptrdiff_t then
+         Report.Failed("Incorrect result from pointer-pointer " &
+                       "subtraction - 4");
+      end if;
+
+
+
+      -- Check that the Increment procedure produces correct results,
+      -- based upon the size of the array elements.
+
+      Short_Ptr := Short_Array(0)'Access;
+
+      for i in Min_Array_Size + 1 .. Max_Array_Size loop
+         -- Increment the value of the Pointer; it should now point
+         -- to the next element in the array.
+         Increment(Ref => Short_Ptr);
+
+         if Short_Ptr.all /= Short_Array(i) then
+            Report.Failed("Incorrect value returned following use "      &
+                          "of the Procedure Increment on pointer to an " &
+                          "array of short values, array position : "     &
+                          Integer'Image(Integer(i)));
+            if not TC_Verbose then
+               exit;
+            end if;
+         end if;
+      end loop;
+
+      Array_Ptr := Array_of_Arrays(0)'Access;
+
+      for i in Min_Array_Size + 1 .. Max_Array_Size loop
+         -- Increment the value of the Pointer; it should now point
+         -- to the next element in the array.
+         Increment(Array_Ptr);
+
+         if Array_Ptr.all /= Array_of_Arrays(i) then
+            Report.Failed("Incorrect value returned following use "    &
+                          "of the Procedure Increment on an array of " &
+                          "arrays, array position : "                  &
+                          Integer'Image(Integer(i)));
+            if not TC_Verbose then
+               exit;
+            end if;
+         end if;
+      end loop;
+
+
+      -- Check that the Decrement procedure produces correct results,
+      -- based upon the size of the array elements.
+
+      Short_Ptr := Short_Array(Max_Array_Size)'Access;
+
+      for i in reverse Min_Array_Size .. Max_Array_Size - 1 loop
+         -- Decrement the value of the Pointer; it should now point
+         -- to the previous element in the array.
+         Decrement(Ref => Short_Ptr);
+
+         if Short_Ptr.all /= Short_Array(i) then
+            Report.Failed("Incorrect value returned following use "      &
+                          "of the Procedure Decrement on pointer to an " &
+                          "array of short values, array position : "     &
+                          Integer'Image(Integer(i)));
+            if not TC_Verbose then
+               exit;
+            end if;
+         end if;
+      end loop;
+
+      Array_Ptr := Array_of_Arrays(Max_Array_Size)'Access;
+
+      for i in reverse Min_Array_Size .. Max_Array_Size - 1 loop
+         -- Decrement the value of the Pointer; it should now point
+         -- to the previous array element.
+         Decrement(Array_Ptr);
+
+         if Array_Ptr.all /= Array_of_Arrays(i) then
+            Report.Failed("Incorrect value returned following use "    &
+                          "of the Procedure Decrement on an array of " &
+                          "arrays, array position : "                  &
+                          Integer'Image(Integer(i)));
+            if not TC_Verbose then
+               exit;
+            end if;
+         end if;
+      end loop;
+
+
+
+      -- Check that each of the "+" and "-" functions above will
+      -- propagate Pointer_Error if a Pointer parameter is null.
+
+      begin
+         Short_Ptr := null;
+         Short_Ptr := Short_Ptr + 4;
+         Report.Failed("Pointer_Error not raised by Function + when " &
+                       "the Pointer parameter is null");
+         if Short_Ptr /= null then  -- To avoid optimization.
+            Report.Comment("This should never be printed");
+         end if;
+      exception
+         when Short_Pointers.Pointer_Error => null; -- OK, expected exception.
+         when others =>
+           Report.Failed("Unexpected exception raised by Function + " &
+                         "when the Pointer parameter is null");
+      end;
+
+
+      begin
+         Char_Ptr := null;
+         Char_Ptr := Char_Ptr - 1;
+         Report.Failed("Pointer_Error not raised by Function - when " &
+                       "the Pointer parameter is null");
+         if Char_Ptr /= null then  -- To avoid optimization.
+            Report.Comment("This should never be printed");
+         end if;
+      exception
+         when Char_Pointers.Pointer_Error => null; -- OK, expected exception.
+         when others =>
+           Report.Failed("Unexpected exception raised by Function - " &
+                         "when the Pointer parameter is null");
+      end;
+
+
+      begin
+         Array_Ptr := null;
+         Decrement(Array_Ptr);
+         Report.Failed("Pointer_Error not raised by Procedure Decrement " &
+                       "when the Pointer parameter is null");
+         if Array_Ptr /= null then  -- To avoid optimization.
+            Report.Comment("This should never be printed");
+         end if;
+      exception
+         when Array_Pointers.Pointer_Error => null; -- OK, expected exception.
+         when others =>
+           Report.Failed("Unexpected exception raised by Procedure " &
+                         "Decrement when the Pointer parameter is null");
+      end;
+
+
+   exception
+      when The_Error : others =>
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3015;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3016.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3016.a
new file mode 100644
index 000000000..362a062ad
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb3016.a
@@ -0,0 +1,516 @@
+-- CXB3016.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 function Virtual_Length returns the number of elements
+--      in the array referenced by the Pointer parameter Ref, up to (but 
+--      not including) the (first) instance of the element specified in 
+--      the Terminator parameter.
+--
+--      Check that the procedure Copy_Terminated_Array copies the array of
+--      elements referenced by Pointer parameter Source, into the array 
+--      pointed to by parameter Target, based on which of the following 
+--      two scenarios occurs first:
+--        1) copying the Terminator element, or
+--        2) copying the number of elements specified in parameter Limit.
+--
+--      Check that procedure Copy_Terminated_Array will propagate
+--      Dereference_Error if either the Source or Target parameter is null.
+--
+--      Check that procedure Copy_Array will copy an array of elements
+--      of length specified in parameter Length, referenced by the 
+--      Pointer parameter Source, into the array pointed to by parameter
+--      Target.
+--
+--      Check that procedure Copy_Array will propagate Dereference_Error
+--      if either the Source or Target parameter is null.
+--
+-- TEST DESCRIPTION:
+--      This test checks that the function Virtual_Length and the procedures
+--      Copy_Terminated_Array and Copy_Array in the generic package 
+--      Interfaces.C.Pointers will allow the user to manipulate arrays of
+--      char and short values through the pointers that reference the
+--      arrays.
+--
+--      Package Interfaces.C.Pointers is instantiated twice, once for
+--      short values and once for chars. Pointers from each instantiated
+--      package are then used to reference arrays of the appropriate 
+--      element type.  The subprograms under test are used to determine the
+--      length, and to copy, either portions or the entire content of the
+--      arrays.  The results of these operations are then compared against
+--      expected results.
+--
+--      The propagation of Dereference_Error is checked for when either
+--      of the two procedures is supplied with a null Pointer parameter.
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', and 'a'..'z'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      packages Interfaces.C, Interfaces.C.Strings, and 
+--      Interfaces.C.Pointers. If an implementation provides these packages,
+--      this test must compile, execute, and report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      01 Feb 96   SAIC    Initial release for 2.1
+--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      26 Oct 96   SAIC    Incorporated reviewer comments.
+--      26 Feb 97   PWB.CTA Moved code using null pointer to avoid errors
+--!
+
+with Report;
+with Ada.Exceptions;
+with Interfaces.C;                                            -- N/A => ERROR
+with Interfaces.C.Pointers;                                   -- N/A => ERROR
+with Interfaces.C.Strings;                                    -- N/A => ERROR
+
+procedure CXB3016 is
+begin
+
+   Report.Test ("CXB3016", "Check that subprograms Virtual_Length, " &
+                           "Copy_Terminated_Array, and Copy_Array "  &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+      use Interfaces.C.Strings;
+
+      use type Interfaces.C.char,
+               Interfaces.C.char_array,
+               Interfaces.C.ptrdiff_t,
+               Interfaces.C.short,
+               Interfaces.C.size_t;
+
+      TC_char          : Interfaces.C.char   :=   'a';
+      TC_ptrdiff_t     : Interfaces.C.ptrdiff_t;
+      TC_Short         : Interfaces.C.short  :=     0;
+      Min_Array_Size   : Interfaces.C.size_t :=     0;
+      Max_Array_Size   : Interfaces.C.size_t :=    20;
+      Short_Terminator : Interfaces.C.short  := Interfaces.C.short'Last;
+      Alphabet         : constant String     := "abcdefghijklmnopqrstuvwxyz";
+      Blank_String     : constant String     := "                          ";
+
+      type Short_Array_Type is 
+        array (Interfaces.C.size_t range <>) of aliased Interfaces.C.short;
+
+      Ch_Array         : Interfaces.C.char_array
+                           (0..Interfaces.C.size_t(Alphabet'Length)) :=
+                             Interfaces.C.To_C(Alphabet, True);
+
+      TC_Ch_Array      : Interfaces.C.char_array
+                           (0..Interfaces.C.size_t(Blank_String'Length)) :=
+                             Interfaces.C.To_C(Blank_String, True);
+
+      Short_Array      : Short_Array_Type(Min_Array_Size..Max_Array_Size);
+      TC_Short_Array   : Short_Array_Type(Min_Array_Size..Max_Array_Size);
+
+
+      package Char_Pointers is new 
+        Interfaces.C.Pointers (Index              => Interfaces.C.size_t,
+                               Element            => Interfaces.C.char,
+                               Element_Array      => Interfaces.C.char_array,
+                               Default_Terminator => Interfaces.C.nul);
+
+      package Short_Pointers is new 
+        Interfaces.C.Pointers (Index              => Interfaces.C.size_t,
+                               Element            => Interfaces.C.short,
+                               Element_Array      => Short_Array_Type,
+                               Default_Terminator => Short_Terminator);
+
+      use Short_Pointers, Char_Pointers;
+
+      Short_Ptr    : Short_Pointers.Pointer := Short_Array(0)'Access;
+      TC_Short_Ptr : Short_Pointers.Pointer := TC_Short_Array(0)'Access;
+      Char_Ptr     : Char_Pointers.Pointer  := Ch_Array(0)'Access;
+      TC_Char_Ptr  : Char_Pointers.Pointer  := TC_Ch_Array(0)'Access;
+
+   begin
+
+      -- Provide initial values for the array that holds short int values.
+
+      for i in Min_Array_Size..Max_Array_Size loop
+         Short_Array(i)    := Interfaces.C.short(i);
+         TC_Short_Array(i) := 100;
+      end loop;
+
+      -- Set the final element of the short array object to be the "terminator"
+      -- element used in the instantiation above.
+
+      Short_Array(Max_Array_Size) := Short_Terminator;
+
+      -- Check starting pointer positions.
+
+      if Short_Ptr.all /= 0 or 
+         Char_Ptr.all  /= Ch_Array(0)
+      then
+         Report.Failed("Incorrect initial value for the first " &
+                       "Char_Array or Short_Array values");
+      end if;
+
+
+
+      -- Check that function Virtual_Length returns the number of elements
+      -- in the array referenced by the Pointer parameter Ref, up to (but 
+      -- not including) the (first) instance of the element specified in 
+      -- the Terminator parameter.
+
+      TC_char := 'j';
+      
+      TC_ptrdiff_t := Char_Pointers.Virtual_Length(Ref        => Char_Ptr,
+                                                   Terminator => TC_char);
+      if TC_ptrdiff_t /= 9 then
+         Report.Failed("Incorrect result from function Virtual_Length " &
+                       "with Char_ptr parameter - 1");
+      end if;
+
+      TC_char := Interfaces.C.nul;
+      
+      TC_ptrdiff_t := Char_Pointers.Virtual_Length(Char_Ptr,
+                                                   Terminator => TC_char);
+      if TC_ptrdiff_t /= Interfaces.C.ptrdiff_t(Alphabet'Length) then
+         Report.Failed("Incorrect result from function Virtual_Length " &
+                       "with Char_ptr parameter - 2");
+      end if;
+
+      TC_Short := 10;
+      
+      TC_ptrdiff_t := Short_Pointers.Virtual_Length(Short_Ptr, TC_Short);
+
+      if TC_ptrdiff_t /= 10 then
+         Report.Failed("Incorrect result from function Virtual_Length " &
+                       "with Short_ptr parameter - 1");
+      end if;
+
+      -- Replace an element of the Short_Array with the element used as the
+      -- terminator of the entire array; now there are two occurrences of the
+      -- terminator element in the array.  The call to Virtual_Length should
+      -- return the number of array elements prior to the first terminator.
+
+      Short_Array(5) := Short_Terminator;
+
+      if Short_Pointers.Virtual_Length(Short_Ptr, Short_Terminator) /= 5
+      then
+         Report.Failed("Incorrect result from function Virtual_Length " &
+                       "with Short_ptr parameter - 2");
+      end if;
+
+
+
+      -- Check that the procedure Copy_Terminated_Array copies the array of
+      -- elements referenced by Pointer parameter Source, into the array 
+      -- pointed to by parameter Target, based on which of the following 
+      -- two scenarios occurs first:
+      --   1) copying the Terminator element, or
+      --   2) copying the number of elements specified in parameter Limit.
+      -- Note: Terminator element must be copied to Target, as well as
+      --       all array elements prior to the terminator element.
+      
+      if TC_Ch_Array = Ch_Array then
+         Report.Failed("The two char arrays are equivalent prior to the " &
+                       "call to Copy_Terminated_Array - 1");
+      end if;
+
+
+      -- Case 1: Copying the Terminator Element.  (Default terminator)
+
+      Char_Pointers.Copy_Terminated_Array(Source => Char_Ptr,
+                                          Target => TC_Char_Ptr);
+
+      if TC_Ch_Array /= Ch_Array then
+         Report.Failed("The two char arrays are not equal following the " &
+                       "call to Copy_Terminated_Array, case of copying "  &
+                       "the Terminator Element, using default terminator");
+      end if;
+
+      -- Reset the Target Pointer array.
+
+      TC_Ch_Array := Interfaces.C.To_C(Blank_String, True);
+      TC_Char_Ptr := TC_Ch_Array(0)'Access;
+
+      if TC_Ch_Array = Ch_Array then
+         Report.Failed("The two char arrays are equivalent prior to the " &
+                       "call to Copy_Terminated_Array - 2");
+      end if;
+
+
+      -- Case 2: Copying the Terminator Element.  (Non-Default terminator)
+
+      TC_char := 'b';  -- Second char in char_array pointed to by Char_Ptr
+      Char_Pointers.Copy_Terminated_Array(Source     => Char_Ptr,
+                                          Target     => TC_Char_Ptr,
+                                          Terminator => TC_char);
+
+      if TC_Ch_Array(0) /= Ch_Array(0)  or  -- Initial value modified.
+         TC_Ch_Array(1) /= Ch_Array(1)  or  -- Initial value modified.
+         TC_Ch_Array(2)  = Ch_Array(2)  or  -- Initial value not modified.
+         TC_Ch_Array(5)  = Ch_Array(5)  or  -- Initial value not modified.
+         TC_Ch_Array(15) = Ch_Array(15) or  -- Initial value not modified.
+         TC_Ch_Array(25) = Ch_Array(25)     -- Initial value not modified.
+      then
+         Report.Failed("The appropriate portions of the two char arrays " &
+                       "are not equal following the call to "        &
+                       "Copy_Terminated_Array, case of copying the " &
+                       "Terminator Element, using non-default terminator");
+      end if;
+
+
+      if TC_Short_Array = Short_Array then
+         Report.Failed("The two short int arrays are equivalent prior " &
+                       "to the call to Copy_Terminated_Array - 1");
+      end if;
+
+      Short_Pointers.Copy_Terminated_Array(Source     => Short_Ptr,
+                                           Target     => TC_Short_Ptr,
+                                           Terminator => 2);
+
+      if TC_Short_Array(0) /= Short_Array(0) or
+         TC_Short_Array(1) /= Short_Array(1) or
+         TC_Short_Array(2) /= Short_Array(2) or
+         TC_Short_Array(3) /= 100  -- Initial value not modified.
+      then
+         Report.Failed("The appropriate portions of the two short int " &
+                       "arrays are not equal following the call to "    &
+                       "Copy_Terminated_Array, case of copying the "    &
+                       "Terminator Element, using non-default terminator");
+      end if;
+
+
+      -- Case 3: Copying the number of elements specified in parameter Limit.
+
+      if TC_Short_Array = Short_Array then
+         Report.Failed("The two short int arrays are equivalent prior " &
+                       "to the call to Copy_Terminated_Array - 2");
+      end if;
+
+      TC_ptrdiff_t := 5;
+
+      Short_Pointers.Copy_Terminated_Array(Source     => Short_Ptr,
+                                           Target     => TC_Short_Ptr,
+                                           Limit      => TC_ptrdiff_t,
+                                           Terminator => Short_Terminator);
+
+      if TC_Short_Array(0) /= Short_Array(0) or
+         TC_Short_Array(1) /= Short_Array(1) or
+         TC_Short_Array(2) /= Short_Array(2) or
+         TC_Short_Array(3) /= Short_Array(3) or
+         TC_Short_Array(4) /= Short_Array(4) or
+         TC_Short_Array(5) /= 100  -- Initial value not modified.
+      then
+         Report.Failed("The appropriate portions of the two Short arrays "  &
+                       "are not equal following the call to "               &
+                       "Copy_Terminated_Array, case of copying the number " &
+                       "of elements specified in parameter Limit");
+      end if;
+
+
+      -- Case 4: Copying the number of elements specified in parameter Limit,
+      --         which also happens to be the number of elements up to and 
+      --         including the first terminator.
+
+      -- Reset initial values for the array that holds short int values.
+
+      for i in Min_Array_Size..Max_Array_Size loop
+         Short_Array(i)    := Interfaces.C.short(i);
+         TC_Short_Array(i) := 100;
+      end loop;
+
+      if TC_Short_Array = Short_Array then
+         Report.Failed("The two short int arrays are equivalent prior " &
+                       "to the call to Copy_Terminated_Array - 3");
+      end if;
+
+      TC_ptrdiff_t     := 3;  -- Specifies three elements to be copied.
+      Short_Terminator := 2;  -- Value held in Short_Array third element,
+                              -- will serve as the "terminator" element.
+
+      Short_Pointers.Copy_Terminated_Array(Source     => Short_Ptr,
+                                           Target     => TC_Short_Ptr,
+                                           Limit      => TC_ptrdiff_t,
+                                           Terminator => Short_Terminator);
+
+      if TC_Short_Array(0) /= Short_Array(0) or  -- First element copied.
+         TC_Short_Array(1) /= Short_Array(1) or  -- Second element copied.
+         TC_Short_Array(2) /= Short_Array(2) or  -- Third element copied.
+         TC_Short_Array(3) /= 100  -- Initial value of fourth element 
+      then                         -- not modified.
+         Report.Failed("The appropriate portions of the two Short arrays "  &
+                       "are not equal following the call to "               &
+                       "Copy_Terminated_Array, case of copying the number " &
+                       "of elements specified in parameter "                &
+                       "Limit, which also happens to be the number of "     &
+                       "elements up to and including the first terminator");
+      end if;
+
+
+
+      -- Check that procedure Copy_Terminated_Array will propagate
+      -- Dereference_Error if either the Source or Target parameter is null.
+      
+      Char_Ptr := null;
+      begin
+         Char_Pointers.Copy_Terminated_Array(Char_Ptr, TC_Char_Ptr);
+         Report.Failed("Dereference_Error not raised by call to " &
+                       "Copy_Terminated_Array with null Source parameter");
+         if TC_Char_Ptr = null then  -- To avoid optimization.
+            Report.Comment("This should never be printed");
+         end if;
+      exception
+         when Dereference_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by call to " &
+                          "Copy_Terminated_Array with null Source parameter");
+      end;
+      
+      TC_Short_Ptr := null;
+      begin
+         Short_Pointers.Copy_Terminated_Array(Short_Ptr, TC_Short_Ptr);
+         Report.Failed("Dereference_Error not raised by call to " &
+                       "Copy_Terminated_Array with null Target parameter");
+         if Short_Ptr = null then  -- To avoid optimization.
+            Report.Comment("This should never be printed");
+         end if;
+      exception
+         when Dereference_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by call to " & 
+                          "Copy_Terminated_Array with null Target parameter");
+      end;
+
+
+
+      -- Check that the procedure Copy_Array will copy the array of 
+      -- elements of length specified in parameter Length, referenced by 
+      -- the Pointer parameter Source, into the array pointed to by 
+      -- parameter Target.
+      
+      -- Reinitialize Target arrays prior to test cases below.
+
+      TC_Ch_Array  := Interfaces.C.To_C(Blank_String, True);
+
+      for i in Min_Array_Size..Max_Array_Size loop
+         TC_Short_Array(i) := 100;
+      end loop;
+
+      Char_Ptr     := Ch_Array(0)'Access;
+      TC_Char_Ptr  := TC_Ch_Array(0)'Access;
+      Short_Ptr    := Short_Array(0)'Access;
+      TC_Short_Ptr := TC_Short_Array(0)'Access;
+
+      TC_ptrdiff_t := 4;
+
+      Char_Pointers.Copy_Array(Source => Char_Ptr,
+                               Target => TC_Char_Ptr,
+                               Length => TC_ptrdiff_t);
+
+      if TC_Ch_Array(0) /= Ch_Array(0) or
+         TC_Ch_Array(1) /= Ch_Array(1) or
+         TC_Ch_Array(2) /= Ch_Array(2) or
+         TC_Ch_Array(3) /= Ch_Array(3) or
+         TC_Ch_Array(4)  = Ch_Array(4) 
+      then
+         Report.Failed("Incorrect result from Copy_Array when using " &
+                       "char pointer arguments, partial array copied");
+      end if;
+
+
+      TC_ptrdiff_t := Interfaces.C.ptrdiff_t(Max_Array_Size) + 1;
+
+      Short_Pointers.Copy_Array(Short_Ptr, TC_Short_Ptr, TC_ptrdiff_t);
+
+      if TC_Short_Array /= Short_Array then
+         Report.Failed("Incorrect result from Copy_Array when using Short " &
+                       "pointer arguments, entire array copied");
+      end if;
+
+
+
+      -- Check that procedure Copy_Array will propagate Dereference_Error
+      -- if either the Source or Target parameter is null.
+      
+      Char_Ptr := null;
+      begin
+         Char_Pointers.Copy_Array(Char_Ptr, TC_Char_Ptr, TC_ptrdiff_t);
+         Report.Failed("Dereference_Error not raised by call to " &
+                       "Copy_Array with null Source parameter");
+         if TC_Char_Ptr = null then  -- To avoid optimization.
+            Report.Comment("This should never be printed");
+         end if;
+      exception
+         when Dereference_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by call to " &
+                          "Copy_Array with null Source parameter");
+      end;
+      
+      TC_Short_Ptr := null;
+      begin
+         Short_Pointers.Copy_Array(Short_Ptr, TC_Short_Ptr, TC_ptrdiff_t);
+         Report.Failed("Dereference_Error not raised by call to " &
+                       "Copy_Array with null Target parameter");
+         if Short_Ptr = null then  -- To avoid optimization.
+            Report.Comment("This should never be printed");
+         end if;
+      exception
+         when Dereference_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by call to " &
+                          "Copy_Array with null Target parameter");
+      end;
+
+
+      -- Check that function Virtual_Length will propagate Dereference_Error 
+      -- if the Source parameter is null.
+      
+      Char_Ptr := null;
+      begin
+         TC_ptrdiff_t := Char_Pointers.Virtual_Length(Char_Ptr,
+                                                      Terminator => TC_char);
+         Report.Failed("Dereference_Error not raised by call to " &
+                       "Virtual_Length with null Source parameter");
+         if TC_ptrdiff_t = 100 then    -- To avoid optimization.
+            Report.Comment("This should never be printed");
+         end if;
+      exception
+         when Dereference_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by call to " &
+                          "Virtual_Length with null Source parameter");
+      end;
+      
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3016;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4001.a
new file mode 100644
index 000000000..0c9ab1a62
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4001.a
@@ -0,0 +1,230 @@
+-- CXB4001.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 specifications of the package Interfaces.COBOL
+--      are available for use
+--
+-- TEST DESCRIPTION: 
+--      This test verifies that the type and the subprograms specified for
+--      the interface are present.
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.COBOL.  If an implementation provides
+--      package Interfaces.COBOL, this test must compile, execute, and 
+--      report "PASSED".
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Nov 95   SAIC    Corrected visibility errors for ACVC 2.0.1.
+--      28 Feb 96   SAIC    Added applicability criteria.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--      01 DEC 97   EDS     Change "To_Comp" to "To_Binary".
+--!
+
+with Report;
+with Interfaces.COBOL;                                        -- N/A => ERROR
+
+procedure CXB4001 is
+
+   package COBOL renames Interfaces.COBOL;
+   use type COBOL.Byte;
+   use type COBOL.Decimal_Element;
+
+begin
+
+   Report.Test ("CXB4001", "Check the specification of Interfaces.COBOL");
+
+
+   declare  -- encapsulate the test
+
+      --  Types and operations for internal data representations
+ 
+      TST_Floating : COBOL.Floating;
+      TST_Long_Floating : COBOL.Long_Floating;
+
+      TST_Binary        : COBOL.Binary;
+      TST_Long_Binary   : COBOL.Long_Binary;
+
+      TST_Max_Digits_Binary      : constant := COBOL.Max_Digits_Binary; 
+      TST_Max_Digits_Long_Binary : constant := COBOL.Max_Digits_Long_Binary;
+
+      TST_Decimal_Element : COBOL.Decimal_Element;
+
+      TST_Packed_Decimal : COBOL.Packed_Decimal (1..5) := 
+                                    (others => COBOL.Decimal_Element'First);
+
+      --  initialize it so it can reasonably be used later
+      TST_COBOL_Character : COBOL.COBOL_Character :=
+                                                COBOL.COBOL_Character'First;
+
+      TST_Ada_To_COBOL : COBOL.COBOL_Character :=  
+                                          COBOL.Ada_To_COBOL (Character'First);
+
+      TST_COBOL_To_Ada : Character :=  
+                              COBOL.COBOL_To_Ada (COBOL.COBOL_Character'First);
+
+      --  assignment to make sure it is an array of  COBOL_Character
+      TST_Alphanumeric : COBOL.Alphanumeric (1..5) := 
+                                             (others => TST_COBOL_Character);
+
+        
+      --  assignment to make sure it is an array of  COBOL_Character
+      TST_Numeric : COBOL.Numeric (1..5) := (others => TST_COBOL_Character);
+
+
+      procedure Collect_All_Calls is
+
+         CAC_Alphanumeric : COBOL.Alphanumeric(1..5) :=
+                              COBOL.To_COBOL("abcde");
+         CAC_String       : String (1..5) := "vwxyz";
+         CAC_Natural      : natural       := 0;
+
+      begin
+   
+         CAC_Alphanumeric := COBOL.To_COBOL (CAC_String);
+         CAC_String := COBOL.To_Ada  (CAC_Alphanumeric);
+
+         COBOL.To_COBOL (CAC_String, CAC_Alphanumeric, CAC_Natural);
+         COBOL.To_Ada (CAC_Alphanumeric, CAC_String, CAC_Natural);
+
+         raise COBOL.Conversion_Error;
+
+      end Collect_All_Calls;
+
+
+
+      --  Formats for COBOL data representations
+
+      TST_Unsigned   : COBOL.Display_Format := COBOL.Unsigned;
+      TST_Leading_Separate : COBOL.Display_Format := COBOL.Leading_Separate;
+      TST_Trailing_Separate : COBOL.Display_Format := COBOL.Trailing_Separate;
+      TST_Leading_Nonseparate  : COBOL.Display_Format :=  
+                                                   COBOL.Leading_Nonseparate;
+      TST_Trailing_Nonseparate : COBOL.Display_Format :=  
+                                                   COBOL.Trailing_Nonseparate;
+
+
+      TST_High_Order_First  : COBOL.Binary_Format := COBOL.High_Order_First;
+      TST_Low_Order_First   : COBOL.Binary_Format := COBOL.Low_Order_First;
+      TST_Native_Binary     : COBOL.Binary_Format := COBOL.Native_Binary;
+
+
+      TST_Packed_Unsigned   : COBOL.Packed_Format := COBOL.Packed_Unsigned;
+      TST_Packed_Signed     : COBOL.Packed_Format := COBOL.Packed_Signed;
+
+
+      --  Types for external representation of COBOL binary data
+
+      TST_Byte_Array : COBOL.Byte_Array(1..5) := (others => COBOL.Byte'First);
+
+      -- Now instantiate one version of the generic
+      --
+      type bx4001_Decimal is delta 0.1 digits 5;
+      package bx4001_conv is new COBOL.Decimal_Conversions (bx4001_Decimal);
+
+      procedure Collect_All_Generic_Calls is
+         CAGC_natural        : natural;
+         CAGC_Display_Format : COBOL.Display_Format;
+         CAGC_Boolean        : Boolean;
+         CAGC_Numeric        : COBOL.Numeric(1..5);
+         CAGC_Num            : bx4001_Decimal;
+         CAGC_Packed_Decimal : COBOL.Packed_Decimal (1..5);
+         CAGC_Packed_Format  : COBOL.Packed_Format; 
+         CAGC_Byte_Array     : COBOL.Byte_Array (1..5);
+         CAGC_Binary_Format  : COBOL.Binary_Format;
+         CAGC_Binary         : COBOL.Binary;
+         CAGC_Long_Binary    : COBOL.Long_Binary;
+      begin
+
+         --  Display Formats: data values are represented as Numeric
+         
+         CAGC_Boolean := bx4001_conv.Valid (CAGC_Numeric, CAGC_Display_Format);
+         CAGC_Natural := bx4001_conv.Length (CAGC_Display_Format);
+
+         CAGC_Num := bx4001_conv.To_Decimal 
+                                       (CAGC_Numeric, CAGC_Display_Format);
+         CAGC_Numeric := bx4001_conv.To_Display 
+                                       (CAGC_Num, CAGC_Display_Format);
+
+
+         --  Packed Formats: data values are represented as Packed_Decimal
+         
+         CAGC_Boolean := bx4001_conv.Valid 
+                                    (CAGC_Packed_Decimal, CAGC_Packed_Format);
+
+         CAGC_Natural := bx4001_conv.Length (CAGC_Packed_Format);
+
+         CAGC_Num := bx4001_conv.To_Decimal 
+                                    (CAGC_Packed_Decimal, CAGC_Packed_Format);
+
+         CAGC_Packed_Decimal := bx4001_conv.To_Packed 
+                                    (CAGC_Num, CAGC_Packed_Format);
+
+
+         --  Binary Formats: external data values are represented as 
+         --  Byte_Array
+
+         CAGC_Boolean := bx4001_conv.Valid 
+                                    (CAGC_Byte_Array, CAGC_Binary_Format);
+         
+         CAGC_Natural := bx4001_conv.Length (CAGC_Binary_Format);
+         CAGC_Num := bx4001_conv.To_Decimal 
+                                    (CAGC_Byte_Array, CAGC_Binary_Format);
+
+         CAGC_Byte_Array := bx4001_conv.To_Binary (CAGC_Num, CAGC_Binary_Format);
+
+
+         --  Internal Binary formats: data values are of type 
+         --  Binary/Long_Binary
+
+         CAGC_Num := bx4001_conv.To_Decimal (CAGC_Binary);
+         CAGC_Num := bx4001_conv.To_Decimal (CAGC_Long_Binary);
+
+         CAGC_Binary       := bx4001_conv.To_Binary (CAGC_Num);
+         CAGC_Long_Binary  := bx4001_conv.To_Long_Binary (CAGC_Num);
+         
+
+      end Collect_All_Generic_Calls;
+
+
+   begin    -- encapsulation
+
+      if COBOL.Byte'First /= 0     or
+         COBOL.Byte'Last  /=  (2 ** COBOL.COBOL_Character'Size) - 1 then
+            Report.Failed ("Byte is incorrectly defined");
+      end if;
+
+      if  COBOL.Decimal_Element'First /= 0 then
+         Report.Failed ("Decimal_Element is incorrectly defined");
+      end if;
+
+   end;     -- encapsulation
+
+   Report.Result;
+
+end CXB4001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4002.a
new file mode 100644
index 000000000..e3934a5ef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4002.a
@@ -0,0 +1,308 @@
+-- CXB4002.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 procedure To_COBOL converts the character elements 
+--      of the String parameter Item into COBOL_Character elements of the 
+--      Alphanumeric type parameter Target, using the Ada_to_COBOL mapping 
+--      as the basis of conversion.  
+--      Check that the parameter Last contains the index of the last element 
+--      of parameter Target that was assigned by To_COBOL.
+--
+--      Check that Constraint_Error is propagated by procedure To_COBOL 
+--      when the length of String parameter Item exceeds the length of 
+--      Alphanumeric parameter Target.
+--
+--      Check that the procedure To_Ada converts the COBOL_Character 
+--      elements of the Alphanumeric parameter Item into Character elements 
+--      of the String parameter Target, using the COBOL_to_Ada mapping array 
+--      as the basis of conversion.  
+--      Check that the parameter Last contains the index of the last element 
+--      of parameter Target that was assigned by To_Ada.
+--
+--      Check that Constraint_Error is propagated by procedure To_Ada when 
+--      the length of Alphanumeric parameter Item exceeds the length of 
+--      String parameter Target.
+--
+-- TEST DESCRIPTION:
+--      This test checks that the procedures To_COBOL and To_Ada produce
+--      the correct results, based on a variety of parameter input values.
+--      
+--      In the first series of subtests, the Out parameter results of 
+--      procedure To_COBOL are compared against expected results,
+--      which includes (in the parameter Last) the index in Target of the 
+--      last element assigned.  The situation where procedure To_COBOL raises
+--      Constraint_Error (when Item'Length exceeds Target'Length) is also
+--      verified.
+--
+--      In the second series of subtests, the Out parameter results of 
+--      procedure To_Ada are verified, in a similar manner as is done for
+--      procedure To_COBOL.  The case of procedure To_Ada raising 
+--      Constraint_Error is also verified.
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.COBOL.COBOL_Character:
+--      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*', '$', '-', '_', and '#'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.COBOL.  If an implementation provides
+--      package Interfaces.COBOL, this test must compile, execute, and 
+--      report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      12 Jan 96   SAIC    Initial prerelease version.
+--      30 May 96   SAIC    Added applicability criteria for ACVC 2.1.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Ada.Strings.Bounded;
+with Ada.Strings.Unbounded;
+with Interfaces.COBOL;                                          -- N/A => ERROR
+
+procedure CXB4002 is
+begin
+
+   Report.Test ("CXB4002", "Check that the procedures To_COBOL and " &
+                           "To_Ada produce correct results");
+
+   Test_Block:
+   declare
+
+      package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
+      package Unb renames Ada.Strings.Unbounded;
+
+      use Interfaces;
+      use Bnd, Unb;
+      use type Interfaces.COBOL.Alphanumeric;
+
+
+      Alphanumeric_1     : COBOL.Alphanumeric(1..1)  := " ";
+      Alphanumeric_5     : COBOL.Alphanumeric(1..5)  := "     ";
+      Alphanumeric_10    : COBOL.Alphanumeric(1..10) := "          ";
+      Alphanumeric_20    : COBOL.Alphanumeric(1..20) := "                    ";
+      TC_Alphanumeric_1  : COBOL.Alphanumeric(1..1)  := "A";
+      TC_Alphanumeric_5  : COBOL.Alphanumeric(1..5)  := "ab*de";
+      TC_Alphanumeric_10 : COBOL.Alphanumeric(1..10) := "$1a2b3C4D5";
+      TC_Alphanumeric_20 : COBOL.Alphanumeric(1..20) := "1234-ABCD_6789#fghij";
+
+      Bnd_String         : Bnd.Bounded_String   :=
+                             Bnd.To_Bounded_String("          ");
+      TC_Bnd_String      : Bounded_String       :=
+                             To_Bounded_String("$1a2b3C4D5");
+
+      Unb_String         : Unb.Unbounded_String :=
+                             Unb.To_Unbounded_String("     ");
+      TC_Unb_String      : Unbounded_String     :=
+                             To_Unbounded_String("ab*de");
+
+      String_1           : String(1..1)   := " ";
+      String_5           : String(1..5)   := "     ";
+      String_10          : String(1..10)  := "          ";
+      String_20          : String(1..20)  := "                    ";
+      TC_String_1        : String(1..1)   := "A";
+      TC_String_20       : String(1..20)  := "1234-ABCD_6789#fghij";
+
+      TC_Alphanumeric    : constant COBOL.Alphanumeric := ""; -- null array.
+      TC_String          : constant String := "";             -- null string.
+      TC_Natural         : Natural         := 0;
+
+
+   begin
+
+      -- Check that the procedure To_COBOL converts the character elements 
+      -- of the String parameter Item into COBOL_Character elements of the 
+      -- Alphanumeric type parameter Target, using the Ada_to_COBOL mapping 
+      -- as the basis of conversion.  
+      -- Check that the parameter Last contains the index of the last element 
+      -- of parameter Target that was assigned by To_COBOL.
+      
+      COBOL.To_COBOL(Item   => TC_String_1,
+                     Target => Alphanumeric_1,
+                     Last   => TC_Natural);
+
+      if Alphanumeric_1 /= TC_Alphanumeric_1        or
+         TC_Natural     /= TC_Alphanumeric_1'Length or
+         TC_Natural     /= 1
+      then
+         Report.Failed("Incorrect result from procedure To_COBOL - 1");
+      end if;
+
+      COBOL.To_COBOL(To_String(TC_Unb_String),
+                     Target => Alphanumeric_5,
+                     Last   => TC_Natural);
+
+      if Alphanumeric_5 /= TC_Alphanumeric_5        or
+         TC_Natural     /= TC_Alphanumeric_5'Length or
+         TC_Natural     /= 5
+      then
+         Report.Failed("Incorrect result from procedure To_COBOL - 2");
+      end if;
+
+      COBOL.To_COBOL(To_String(TC_Bnd_String),
+                     Alphanumeric_10,
+                     Last   => TC_Natural);
+
+      if Alphanumeric_10 /= TC_Alphanumeric_10        or
+         TC_Natural      /= TC_Alphanumeric_10'Length or
+         TC_Natural      /= 10
+      then
+         Report.Failed("Incorrect result from procedure To_COBOL - 3");
+      end if;
+
+      COBOL.To_COBOL(TC_String_20,
+                     Alphanumeric_20,
+                     TC_Natural);
+
+      if Alphanumeric_20 /= TC_Alphanumeric_20        or
+         TC_Natural      /= TC_Alphanumeric_20'Length or
+         TC_Natural      /= 20
+      then
+         Report.Failed("Incorrect result from procedure To_COBOL - 4");
+      end if;
+
+      COBOL.To_COBOL(Item   => TC_String,     -- null string
+                     Target => Alphanumeric_1,
+                     Last   => TC_Natural);
+
+      if TC_Natural /= 0 then
+         Report.Failed("Incorrect result from procedure To_COBOL, value "  &
+                       "returned in parameter Last should be zero, since " &
+                       "parameter Item is null array");
+      end if;
+
+
+
+      -- Check that Constraint_Error is propagated by procedure To_COBOL 
+      -- when the length of String parameter Item exceeds the length of 
+      -- Alphanumeric parameter Target.
+
+      begin
+
+         COBOL.To_COBOL(Item   => TC_String_20,
+                        Target => Alphanumeric_10,
+                        Last   => TC_Natural);
+         Report.Failed("Constraint_Error not raised by procedure To_COBOL " &
+                       "when Item'Length exceeds Target'Length");
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by procedure To_COBOL " &
+                          "when Item'Length exceeds Target'Length");
+      end;
+
+      
+      -- Check that the procedure To_Ada converts the COBOL_Character 
+      -- elements of the Alphanumeric parameter Item into Character elements 
+      -- of the String parameter Target, using the COBOL_to_Ada mapping array 
+      -- as the basis of conversion.  
+      -- Check that the parameter Last contains the index of the last element 
+      -- of parameter Target that was assigned by To_Ada.
+      
+      COBOL.To_Ada(Item   => TC_Alphanumeric_1,
+                   Target => String_1,
+                   Last   => TC_Natural);
+
+      if String_1   /= TC_String_1        or
+         TC_Natural /= TC_String_1'Length or
+         TC_Natural /= 1
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 1");
+      end if;
+
+      COBOL.To_Ada(TC_Alphanumeric_5,
+                   Target => String_5,
+                   Last   => TC_Natural);
+
+      if String_5   /= To_String(TC_Unb_String) or
+         TC_Natural /= Length(TC_Unb_String)    or
+         TC_Natural /= 5
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 2");
+      end if;
+
+      COBOL.To_Ada(TC_Alphanumeric_10,
+                   String_10,
+                   Last   => TC_Natural);
+
+      if String_10   /= To_String(TC_Bnd_String) or
+         TC_Natural  /= Length(TC_Bnd_String)    or
+         TC_Natural  /= 10
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 3");
+      end if;
+
+      COBOL.To_Ada(TC_Alphanumeric_20,
+                   String_20,
+                   TC_Natural);
+
+      if String_20   /= TC_String_20        or
+         TC_Natural  /= TC_String_20'Length or
+         TC_Natural  /= 20
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 4");
+      end if;
+
+      COBOL.To_Ada(Item   => TC_Alphanumeric,  -- null array.
+                   Target => String_20,
+                   Last   => TC_Natural);
+
+      if TC_Natural /= 0 then
+         Report.Failed("Incorrect result from procedure To_Ada, value "    &
+                       "returned in parameter Last should be zero, since " &
+                       "parameter Item is null array");
+      end if;
+
+
+
+      -- Check that Constraint_Error is propagated by procedure To_Ada when 
+      -- the length of Alphanumeric parameter Item exceeds the length of 
+      -- String parameter Target.
+
+      begin
+
+         COBOL.To_Ada(Item   => TC_Alphanumeric_10,
+                      Target => String_5,
+                      Last   => TC_Natural);
+         Report.Failed("Constraint_Error not raised by procedure To_Ada " &
+                       "when Item'Length exceeds Target'Length");
+      exception
+         when Constraint_Error => null;  -- OK, expected exception.
+         when others           =>
+            Report.Failed("Incorrect exception raised by procedure To_Ada " &
+                          "when Item'Length exceeds Target'Length");
+      end;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXB4002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4003.a
new file mode 100644
index 000000000..609dabc50
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4003.a
@@ -0,0 +1,310 @@
+-- CXB4003.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 function Valid, with the Display_Format parameter 
+--      set to Unsigned, will return True if Numeric parameter Item 
+--      comprises one or more decimal digit characters; check that it 
+--      returns False if the parameter Item is otherwise comprised.
+--
+--      Check that function Valid, with Display_Format parameter set to 
+--      Leading_Separate, will return True if Numeric parameter Item 
+--      comprises a single occurrence of a Plus_Sign or Minus_Sign 
+--      character, and then by one or more decimal digit characters; 
+--      check that it returns False if the parameter Item is otherwise 
+--      comprised.
+--
+--      Check that function Valid, with Display_Format parameter set to 
+--      Trailing_Separate, will return True if Numeric parameter Item 
+--      comprises one or more decimal digit characters, and then by a 
+--      single occurrence of the Plus_Sign or Minus_Sign character; 
+--      check that it returns False if the parameter Item is otherwise
+--      comprised.
+--
+-- TEST DESCRIPTION:
+--      This test checks that a version of function Valid, from an instance
+--      of the generic package Decimal_Conversions, will produce correct
+--      results based on the particular Numeric and Display_Format
+--      parameters provided.  Arrays of both valid and invalid Numeric
+--      data items have been created to correspond to a particular
+--      value of Display_Format.  The result of the function is compared
+--      against the expected result for each appropriate combination of
+--      Numeric and Display_Format parameter.
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.COBOL.COBOL_Character:
+--      ' ', 'A'..'Z', '+', '-', '.', '$'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.COBOL.  If an implementation provides
+--      package Interfaces.COBOL, this test must compile, execute, and 
+--      report "PASSED".
+--
+--      
+--       
+-- CHANGE HISTORY:
+--      18 Jan 96   SAIC    Initial version for 2.1. 
+--      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Ada.Exceptions;
+with Interfaces.COBOL;                                          -- N/A => ERROR
+
+procedure CXB4003 is
+begin
+
+   Report.Test ("CXB4003", "Check that function Valid, with various "     &
+                           "Display_Format parameters, produces correct " &
+                           "results");
+
+   Test_Block:
+   declare
+
+      use Interfaces;
+      use Ada.Exceptions;
+
+      type A_Numeric_Type     is delta 0.01 digits 16;
+      type Numeric_Access     is access COBOL.Numeric;
+      type Numeric_Items_Type is array(Integer range <>) of Numeric_Access;
+
+      package Display_Format is 
+        new COBOL.Decimal_Conversions(Num => A_Numeric_Type);
+
+
+      Number_Of_Valid_Unsigned_Items            : constant :=  5;
+      Number_Of_Invalid_Unsigned_Items          : constant := 21;
+      Number_Of_Valid_Leading_Separate_Items    : constant :=  5;
+      Number_Of_Invalid_Leading_Separate_Items  : constant := 23;
+      Number_Of_Valid_Trailing_Separate_Items   : constant :=  5;
+      Number_Of_Invalid_Trailing_Separate_Items : constant := 22;
+
+      Valid_Unsigned_Items :
+        Numeric_Items_Type(1..Number_Of_Valid_Unsigned_Items) :=
+          (new COBOL.Numeric'("0"),
+           new COBOL.Numeric'("1"),
+           new COBOL.Numeric'("0000000001"),
+           new COBOL.Numeric'("1234567890123456"),
+           new COBOL.Numeric'("0000"));
+
+      Invalid_Unsigned_Items :        
+        Numeric_Items_Type(1..Number_Of_Invalid_Unsigned_Items) :=
+          (new COBOL.Numeric'(" 12345"),
+           new COBOL.Numeric'("    12345"),
+           new COBOL.Numeric'("1234567890 "),
+           new COBOL.Numeric'("1234567890   "),
+           new COBOL.Numeric'("1.01"),
+           new COBOL.Numeric'(".0000000001"),
+           new COBOL.Numeric'("12345 6"),
+           new COBOL.Numeric'("MCXVIII"),
+           new COBOL.Numeric'("15F"),
+           new COBOL.Numeric'("+12345"),
+           new COBOL.Numeric'("$12.30"),
+           new COBOL.Numeric'("1234-"),
+           new COBOL.Numeric'("12--"),
+           new COBOL.Numeric'("+12-"),
+           new COBOL.Numeric'("++99--"),
+           new COBOL.Numeric'("-1.01"),
+           new COBOL.Numeric'("(1.01)"),
+           new COBOL.Numeric'("123,456"),
+           new COBOL.Numeric'("101."),
+           new COBOL.Numeric'(""),
+           new COBOL.Numeric'("1.0000"));
+
+      Valid_Leading_Separate_Items : 
+        Numeric_Items_Type(1..Number_Of_Valid_Leading_Separate_Items) :=
+          (new COBOL.Numeric'("+1000"),
+           new COBOL.Numeric'("-1"),
+           new COBOL.Numeric'("-0000000001"),
+           new COBOL.Numeric'("+1234567890123456"),
+           new COBOL.Numeric'("-0000"));
+
+      Invalid_Leading_Separate_Items :
+        Numeric_Items_Type(1..Number_Of_Invalid_Leading_Separate_Items) :=
+          (new COBOL.Numeric'("123456"),
+           new COBOL.Numeric'(" +12345"),
+           new COBOL.Numeric'("    +12345"),
+           new COBOL.Numeric'("- 0000000001"),
+           new COBOL.Numeric'("1234567890- "),
+           new COBOL.Numeric'("1234567890+   "),
+           new COBOL.Numeric'("123-456"),
+           new COBOL.Numeric'("+15F"),
+           new COBOL.Numeric'("++123"),
+           new COBOL.Numeric'("12--"),
+           new COBOL.Numeric'("+12-"),
+           new COBOL.Numeric'("+/-12"),
+           new COBOL.Numeric'("++99--"),
+           new COBOL.Numeric'("1.01"),
+           new COBOL.Numeric'("(1.01)"),
+           new COBOL.Numeric'("+123,456"),
+           new COBOL.Numeric'("+15FF"),
+           new COBOL.Numeric'("- 123"),
+           new COBOL.Numeric'("+$123"),
+           new COBOL.Numeric'(""),
+           new COBOL.Numeric'("-"),
+           new COBOL.Numeric'("-1.01"),
+           new COBOL.Numeric'("1.0000+"));
+
+      Valid_Trailing_Separate_Items : 
+        Numeric_Items_Type(1..Number_Of_Valid_Trailing_Separate_Items) :=
+          (new COBOL.Numeric'("1001-"),
+           new COBOL.Numeric'("1+"),
+           new COBOL.Numeric'("0000000001+"),
+           new COBOL.Numeric'("1234567890123456-"),
+           new COBOL.Numeric'("0000-"));
+
+      Invalid_Trailing_Separate_Items :
+        Numeric_Items_Type(1..Number_Of_Invalid_Trailing_Separate_Items) :=
+          (new COBOL.Numeric'("123456"),
+           new COBOL.Numeric'("+12345"),
+           new COBOL.Numeric'("12345 "),
+           new COBOL.Numeric'("123- "),
+           new COBOL.Numeric'("123-   "),
+           new COBOL.Numeric'("12345 +"),
+           new COBOL.Numeric'("12345+   "),
+           new COBOL.Numeric'("-0000000001"),
+           new COBOL.Numeric'("123-456"),
+           new COBOL.Numeric'("12--"),
+           new COBOL.Numeric'("+12-"),
+           new COBOL.Numeric'("99+-"),
+           new COBOL.Numeric'("12+/-"),
+           new COBOL.Numeric'("12.01-"),
+           new COBOL.Numeric'("$12.01+"),
+           new COBOL.Numeric'("(1.01)"),
+           new COBOL.Numeric'("DM12-"),
+           new COBOL.Numeric'("123,456+"),
+           new COBOL.Numeric'(""),
+           new COBOL.Numeric'("-"),
+           new COBOL.Numeric'("1.01-"),
+           new COBOL.Numeric'("+1.0000"));
+
+   begin
+
+      -- Check that function Valid, with the Display_Format parameter 
+      -- set to Unsigned, will return True if Numeric parameter Item 
+      -- comprises one or more decimal digit characters; check that it 
+      -- returns False if the parameter Item is otherwise comprised.
+
+      for i in 1..Number_of_Valid_Unsigned_Items loop
+         -- Fail if the Item parameter is _NOT_ considered Valid.
+         if not Display_Format.Valid(Item   => Valid_Unsigned_Items(i).all, 
+                                     Format => COBOL.Unsigned)
+         then
+            Report.Failed("Incorrect result from function Valid, with "  &
+                          "Format parameter set to Unsigned, for valid " &
+                          "format item number " & Integer'Image(i));
+         end if;
+      end loop;
+
+
+      for i in 1..Number_of_Invalid_Unsigned_Items loop
+         -- Fail if the Item parameter _IS_ considered Valid.
+         if Display_Format.Valid(Item   => Invalid_Unsigned_Items(i).all, 
+                                 Format => COBOL.Unsigned)
+         then
+            Report.Failed("Incorrect result from function Valid, with "    &
+                          "Format parameter set to Unsigned, for invalid " &
+                          "format item number " & Integer'Image(i));
+         end if;
+      end loop;
+
+
+
+      -- Check that function Valid, with Display_Format parameter set to 
+      -- Leading_Separate, will return True if Numeric parameter Item 
+      -- comprises a single occurrence of a Plus_Sign or Minus_Sign 
+      -- character, and then by one or more decimal digit characters; 
+      -- check that it returns False if the parameter Item is otherwise 
+      -- comprised.
+
+      for i in 1..Number_of_Valid_Leading_Separate_Items loop
+         -- Fail if the Item parameter is _NOT_ considered Valid.
+         if not Display_Format.Valid(Valid_Leading_Separate_Items(i).all, 
+                                     Format => COBOL.Leading_Separate)
+         then
+            Report.Failed("Incorrect result from function Valid, with " &
+                          "Format parameter set to Leading_Separate, "  &
+                          "for valid format item number " & Integer'Image(i));
+         end if;
+      end loop;
+
+
+      for i in 1..Number_of_Invalid_Leading_Separate_Items loop
+         -- Fail if the Item parameter _IS_ considered Valid.
+         if Display_Format.Valid(Invalid_Leading_Separate_Items(i).all, 
+                                 Format => COBOL.Leading_Separate)
+         then
+            Report.Failed("Incorrect result from function Valid, with " &
+                          "Format parameter set to Leading_Separate, "  &
+                          "for invalid format item number "             &
+                          Integer'Image(i));
+         end if;
+      end loop;
+
+
+
+      -- Check that function Valid, with Display_Format parameter set to 
+      -- Trailing_Separate, will return True if Numeric parameter Item 
+      -- comprises one or more decimal digit characters, and then by a 
+      -- single occurrence of the Plus_Sign or Minus_Sign character; 
+      -- check that it returns False if the parameter Item is otherwise
+      -- comprised.
+
+      for i in 1..Number_of_Valid_Trailing_Separate_Items loop
+         -- Fail if the Item parameter is _NOT_ considered Valid.
+         if not Display_Format.Valid(Valid_Trailing_Separate_Items(i).all, 
+                                     COBOL.Trailing_Separate)
+         then
+            Report.Failed("Incorrect result from function Valid, with " &
+                          "Format parameter set to Trailing_Separate, " &
+                          "for valid format item number " & Integer'Image(i));
+         end if;
+      end loop;
+
+
+      for i in 1..Number_of_Invalid_Trailing_Separate_Items loop
+         -- Fail if the Item parameter _IS_ considered Valid.
+         if Display_Format.Valid(Invalid_Trailing_Separate_Items(i).all, 
+                                 COBOL.Trailing_Separate)
+         then
+            Report.Failed("Incorrect result from function Valid, with " &
+                          "Format parameter set to Trailing_Separate, " &
+                          "for invalid format item number "             &
+                          Integer'Image(i));
+         end if;
+      end loop;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB4003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4004.a
new file mode 100644
index 000000000..0046c5e7c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4004.a
@@ -0,0 +1,443 @@
+-- CXB4004.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 function Length, with Display_Format parameter, will 
+--      return the minimal length of a Numeric value that will be required 
+--      to hold the largest value of type Num represented as Format. 
+--
+--      Check that function To_Decimal will produce a decimal type Num 
+--      result that corresponds to parameter Item as represented by 
+--      parameter Format.
+--
+--      Check that function To_Decimal propagates Conversion_Error when 
+--      the value represented by parameter Item is outside the range of 
+--      the Decimal_Type Num used to instantiate the package 
+--      Decimal_Conversions 
+--
+--      Check that function To_Display returns a Numeric type result that 
+--      represents Item under the specific Display_Format.
+--
+--      Check that function To_Display propagates Conversion_Error when 
+--      parameter Item is negative and the specified Display_Format 
+--      parameter is Unsigned.
+--
+-- TEST DESCRIPTION:
+--      This test checks the results from instantiated versions of three
+--      functions within generic package Interfaces.COBOL.Decimal_Conversions.
+--      This generic package is instantiated twice, with decimal types having
+--      four and ten digits representation. 
+--      The function Length is validated with the Unsigned, Leading_Separate,
+--      and Trailing_Separate Display_Format specifiers.
+--      The results of function To_Decimal are verified in cases where it
+--      is given a variety of Numeric and Display_Format type parameters.
+--      Function To_Decimal is also checked to propagate Conversion_Error
+--      when the value represented by parameter Item is outside the range 
+--      of the type used to instantiate the package.
+--      The results of function To_Display are verified in cases where it
+--      is given a variety of Num and Display_Format parameters.  It is also
+--      checked to ensure that it propagates Conversion_Error if parameter
+--      Num is negative and the Format parameter is Unsigned.
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.COBOL.COBOL_Character:
+--      ' ', '0'..'9', '+', '-', and '.'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.COBOL.  If an implementation provides
+--      package Interfaces.COBOL, this test must compile, execute, and 
+--      report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      06 Feb 96   SAIC    Initial release for 2.1.
+--      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Interfaces.COBOL;                                          -- N/A => ERROR
+with Ada.Exceptions;
+
+procedure CXB4004 is
+begin
+
+   Report.Test ("CXB4004", "Check that the functions Length, To_Decimal, " &
+                           "and To_Display produce correct results");
+
+   Test_Block:
+   declare
+
+      use Interfaces;
+      use Ada.Exceptions;
+      use type Interfaces.COBOL.Numeric;
+
+      Number_Of_Unsigned_Items          : constant := 6;
+      Number_Of_Leading_Separate_Items  : constant := 6;
+      Number_Of_Trailing_Separate_Items : constant := 6;
+      Number_Of_Decimal_Items           : constant := 9;
+
+      type Decimal_Type_1     is delta 0.01 digits  4;
+      type Decimal_Type_2     is delta 1.0 digits  10;
+      type Numeric_Access     is access COBOL.Numeric;
+      type Numeric_Items_Type is array(Integer range <>) of Numeric_Access;
+
+      Correct_Result : Boolean        := False;
+      TC_Num_1       : Decimal_Type_1 := 0.0;
+      TC_Num_2       : Decimal_Type_2 := 0.0;
+
+      package Package_1 is new COBOL.Decimal_Conversions(Decimal_Type_1);
+      package Package_2 is new COBOL.Decimal_Conversions(Decimal_Type_2);
+
+
+      Package_1_Numeric_Items :
+        Numeric_Items_Type(1..Number_Of_Decimal_Items) :=
+          (new COBOL.Numeric'("0"),
+           new COBOL.Numeric'("591"),
+           new COBOL.Numeric'("6342"),
+           new COBOL.Numeric'("+0"),
+           new COBOL.Numeric'("-1539"),
+           new COBOL.Numeric'("+9199"),
+           new COBOL.Numeric'("0-"),
+           new COBOL.Numeric'("8934+"),
+           new COBOL.Numeric'("9949-"));
+
+      Package_2_Numeric_Items :
+        Numeric_Items_Type(1..Number_Of_Decimal_Items) :=
+          (new COBOL.Numeric'("3"),
+           new COBOL.Numeric'("105"),
+           new COBOL.Numeric'("1234567899"),
+           new COBOL.Numeric'("+8"),
+           new COBOL.Numeric'("-12345601"),
+           new COBOL.Numeric'("+9123459999"),
+           new COBOL.Numeric'("1-"),
+           new COBOL.Numeric'("123456781+"),
+           new COBOL.Numeric'("9499999999-"));
+
+
+      Decimal_Type_1_Items : array (1..Number_Of_Decimal_Items) 
+                               of Decimal_Type_1 :=
+        (0.0,  5.91,  63.42, 0.0, -15.39,  91.99, 0.0,  89.34, -99.49);
+
+      Decimal_Type_2_Items : array (1..Number_Of_Decimal_Items) 
+                               of Decimal_Type_2 :=
+        ( 3.0,        105.0,  1234567899.0, 
+          8.0,  -12345601.0,  9123459999.0,
+         -1.0,  123456781.0, -9499999999.0);
+
+   begin
+
+      -- Check that function Length with Display_Format parameter will 
+      -- return the minimal length of a Numeric value (number of 
+      -- COBOL_Characters) that will be required to hold the largest 
+      -- value of type Num. 
+
+      if Package_1.Length(COBOL.Unsigned) /=  4 or
+         Package_2.Length(COBOL.Unsigned) /= 10
+      then
+         Report.Failed("Incorrect results from function Length when " &
+                       "used with Display_Format parameter Unsigned");
+      end if;
+
+      if Package_1.Length(Format => COBOL.Leading_Separate) /=  5 or
+         Package_2.Length(Format => COBOL.Leading_Separate) /= 11
+      then
+         Report.Failed("Incorrect results from function Length when " &
+                       "used with Display_Format parameter "          &
+                       "Leading_Separate");
+      end if;
+
+      if Package_1.Length(COBOL.Trailing_Separate) /=  5 or
+         Package_2.Length(COBOL.Trailing_Separate) /= 11
+      then
+         Report.Failed("Incorrect results from function Length when " &
+                       "used with Display_Format parameter "          &
+                       "Trailing_Separate");
+      end if;
+
+
+      -- Check that function To_Decimal with Numeric and Display_Format 
+      -- parameters will produce a decimal type Num result that corresponds 
+      -- to parameter Item as represented by parameter Format.
+
+      for i in 1..Number_Of_Decimal_Items loop
+         case i is
+            when 1..3 =>  -- Unsigned Display_Format parameter.
+
+               if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
+                                       Format => COBOL.Unsigned) /=
+                  Decimal_Type_1_Items(i)
+               then
+                  Report.Failed
+                    ("Incorrect result from function To_Decimal "    &
+                     "from an instantiation of Decimal_Conversions " &
+                     "using a four-digit Decimal type, with Format " &
+                     "parameter Unsigned, subtest index: "           &
+                     Integer'Image(i)); 
+               end if;
+
+               if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
+                                       Format => COBOL.Unsigned) /=
+                  Decimal_Type_2_Items(i)
+               then
+                  Report.Failed
+                    ("Incorrect result from function To_Decimal "    &
+                     "from an instantiation of Decimal_Conversions " &
+                     "using a ten-digit Decimal type, with Format "  &
+                     "parameter Unsigned, subtest index: "           &
+                     Integer'Image(i)); 
+               end if;
+
+            when 4..6 =>  -- Leading_Separate Display_Format parameter.
+
+               if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
+                                       Format => COBOL.Leading_Separate) /=
+                  Decimal_Type_1_Items(i)
+               then
+                  Report.Failed
+                    ("Incorrect result from function To_Decimal "    &
+                     "from an instantiation of Decimal_Conversions " &
+                     "using a four-digit Decimal type, with Format " &
+                     "parameter Leading_Separate, subtest index: "   &
+                     Integer'Image(i)); 
+               end if;
+
+               if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
+                                       Format => COBOL.Leading_Separate) /=
+                  Decimal_Type_2_Items(i)
+               then
+                  Report.Failed
+                    ("Incorrect result from function To_Decimal "    &
+                     "from an instantiation of Decimal_Conversions " &
+                     "using a ten-digit Decimal type, with Format "  &
+                     "parameter Leading_Separate, subtest index: "   &
+                     Integer'Image(i)); 
+               end if;
+
+            when 7..9 =>  -- Trailing_Separate Display_Format parameter.
+
+               if Package_1.To_Decimal(Package_1_Numeric_Items(i).all,
+                                       COBOL.Trailing_Separate) /=
+                  Decimal_Type_1_Items(i)
+               then
+                  Report.Failed
+                    ("Incorrect result from function To_Decimal "    &
+                     "from an instantiation of Decimal_Conversions " &
+                     "using a four-digit Decimal type, with Format " &
+                     "parameter Trailing_Separate, subtest index: "  &
+                     Integer'Image(i)); 
+               end if;
+
+               if Package_2.To_Decimal(Package_2_Numeric_Items(i).all,
+                                       COBOL.Trailing_Separate) /=
+                  Decimal_Type_2_Items(i)
+               then
+                  Report.Failed
+                    ("Incorrect result from function To_Decimal "    &
+                     "from an instantiation of Decimal_Conversions " &
+                     "using a ten-digit Decimal type, with Format "  &
+                     "parameter Trailing_Separate, subtest index: "  &
+                     Integer'Image(i)); 
+               end if;
+
+         end case;
+      end loop;
+
+
+      -- Check that function To_Decimal propagates Conversion_Error when 
+      -- the value represented by Numeric type parameter Item is outside 
+      -- the range of the Decimal_Type Num used to instantiate the package 
+      -- Decimal_Conversions.
+
+      declare
+         TC_Numeric_1 : Decimal_Type_1 := Decimal_Type_1_Items(1);
+      begin
+         -- The COBOL.Numeric type used as parameter Item represents a
+         -- Decimal value that is outside the range of the Decimal type 
+         -- used to instantiate Package_1.
+         TC_Numeric_1 := 
+           Package_1.To_Decimal(Item   => Package_2_Numeric_Items(8).all,
+                                Format => COBOL.Trailing_Separate);
+         Report.Failed("Conversion_Error not raised by To_Decimal "     &
+                       "when the value represented by parameter "       &
+                       "Item is outside the range of the Decimal_Type " &
+                       "used to instantiate the package "               &
+                       "Decimal_Conversions");
+         if TC_Numeric_1 = Decimal_Type_1_Items(1) then
+            Report.Comment("To Guard Against Dead Assignment Elimination " &
+                           "-- Should never be printed");
+         end if;
+      exception
+         when COBOL.Conversion_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by To_Decimal "      &
+                          "when the value represented by parameter "       &
+                          "Item is outside the range of the Decimal_Type " &
+                          "used to instantiate the package "               &
+                          "Decimal_Conversions");
+      end;
+
+
+      -- Check that function To_Display with decimal type Num and 
+      -- Display_Format parameters returns a Numeric type result that 
+      -- represents Item under the specific Display_Format.
+
+      -- Unsigned Display_Format parameter.
+      TC_Num_1       := 13.04;
+      Correct_Result := (Package_1.To_Display(TC_Num_1, COBOL.Unsigned) =
+                         "1304") AND
+                        (Package_1.To_Display(TC_Num_1, COBOL.Unsigned) /= 
+                         "13.04");
+      if not Correct_Result then
+         Report.Failed("Incorrect result from function To_Display with " &
+                       "Unsigned Display_Format parameter - 1");
+      end if;
+
+      TC_Num_2       := 1234567890.0;
+      Correct_Result := Package_2.To_Display(TC_Num_2, 
+                                             COBOL.Unsigned) = "1234567890";
+      if not Correct_Result then
+         Report.Failed("Incorrect result from function To_Display with " &
+                       "Unsigned Display_Format parameter - 2");
+      end if;
+
+      -- Leading_Separate Display_Format parameter.
+      TC_Num_1       := -34.29;
+      Correct_Result := (Package_1.To_Display(TC_Num_1, 
+                                              COBOL.Leading_Separate) = 
+                         "-3429") AND
+                        (Package_1.To_Display(TC_Num_1,
+                                              COBOL.Leading_Separate) /=
+                         "-34.29");
+      if not Correct_Result then
+         Report.Failed("Incorrect result from function To_Display with " &
+                       "Leading_Separate Display_Format parameter - 1");
+      end if;
+
+      TC_Num_1       := 19.01;
+      Correct_Result := Package_1.To_Display(TC_Num_1, 
+                                             COBOL.Leading_Separate) = 
+                        "+1901";
+      if not Correct_Result then
+         Report.Failed("Incorrect result from function To_Display with " &
+                       "Leading_Separate Display_Format parameter - 2");
+      end if;
+
+      TC_Num_2       := 1234567890.0;
+      Correct_Result := Package_2.To_Display(TC_Num_2, 
+                                             COBOL.Leading_Separate) = 
+                        "+1234567890";
+      if not Correct_Result then
+         Report.Failed("Incorrect result from function To_Display with " &
+                       "Leading_Separate Display_Format parameter - 3");
+      end if;
+
+      TC_Num_2       := -1234567890.0;
+      Correct_Result := Package_2.To_Display(TC_Num_2, 
+                                             COBOL.Leading_Separate) = 
+                        "-1234567890";
+      if not Correct_Result then
+         Report.Failed("Incorrect result from function To_Display with " &
+                       "Leading_Separate Display_Format parameter - 4");
+      end if;
+
+      -- Trailing_Separate Display_Format parameter.
+      TC_Num_1       := -99.91;
+      Correct_Result := (Package_1.To_Display(TC_Num_1, 
+                                             COBOL.Trailing_Separate) = 
+                         "9991-") AND
+                        (Package_1.To_Display(TC_Num_1,
+                                              COBOL.Trailing_Separate) /=
+                         "99.91-");
+      if not Correct_Result then
+         Report.Failed("Incorrect result from function To_Display with " &
+                       "Trailing_Separate Display_Format parameter - 1");
+      end if;
+
+      TC_Num_1       := 51.99;
+      Correct_Result := Package_1.To_Display(TC_Num_1, 
+                                             COBOL.Trailing_Separate) = 
+                        "5199+";
+      if not Correct_Result then
+         Report.Failed("Incorrect result from function To_Display with " &
+                       "Trailing_Separate Display_Format parameter - 2");
+      end if;
+
+      TC_Num_2       := 1234567890.0;
+      Correct_Result := Package_2.To_Display(TC_Num_2, 
+                                             COBOL.Trailing_Separate) = 
+                        "1234567890+";
+      if not Correct_Result then
+         Report.Failed("Incorrect result from function To_Display with " &
+                       "Trailing_Separate Display_Format parameter - 3");
+      end if;
+
+      TC_Num_2       := -1234567890.0;
+      Correct_Result := Package_2.To_Display(TC_Num_2, 
+                                             COBOL.Trailing_Separate) = 
+                        "1234567890-";
+      if not Correct_Result then
+         Report.Failed("Incorrect result from function To_Display with " &
+                       "Trailing_Separate Display_Format parameter - 4");
+      end if;
+
+
+      -- Check that function To_Display propagates Conversion_Error when
+      -- parameter Item is negative and the specified Display_Format 
+      -- parameter is Unsigned.
+
+      begin
+         if Package_2.To_Display(Item   => Decimal_Type_2_Items(9),
+                                 Format => COBOL.Unsigned) = 
+            Package_2_Numeric_Items(2).all 
+         then
+            Report.Comment("To Guard Against Dead Assignment Elimination " &
+                           "-- Should never be printed");
+         end if;
+         Report.Failed("Conversion_Error not raised by To_Display " &
+                       "when the value represented by parameter "   &
+                       "Item is negative and the Display_Format "   &
+                       "parameter is Unsigned");
+      exception
+         when COBOL.Conversion_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by To_Display " &
+                          "when the value represented by parameter "  &
+                          "Item is negative and the Display_Format "  &
+                          "parameter is Unsigned");
+      end;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB4004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4005.a
new file mode 100644
index 000000000..01f1ded1d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4005.a
@@ -0,0 +1,332 @@
+-- CXB4005.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 function To_COBOL will convert a String 
+--      parameter value into a type Alphanumeric array of 
+--      COBOL_Characters, with lower bound of one, and length 
+--      equal to length of the String parameter, based on the 
+--      mapping Ada_to_COBOL.
+--
+--      Check that the function To_Ada will convert a type 
+--      Alphanumeric parameter value into a String type result, 
+--      with lower bound of one, and length equal to the length 
+--      of the Alphanumeric parameter, based on the mapping 
+--      COBOL_to_Ada.
+--
+--      Check that the Ada_to_COBOL and COBOL_to_Ada mapping 
+--      arrays provide a mapping capability between Ada's type 
+--      Character and COBOL run-time character sets.
+--
+-- TEST DESCRIPTION:
+--      This test checks that the functions To_COBOL and To_Ada produce
+--      the correct results, based on a variety of parameter input values.
+--      
+--      In the first series of subtests, the results of the function
+--      To_COBOL are compared against expected Alphanumeric type results,
+--      and the length and lower bound of the alphanumeric result are
+--      also verified.  In the second series of subtests, the results of
+--      the function To_Ada are compared against expected String type
+--      results, and the length of the String result is also verified 
+--      against the Alphanumeric type parameter.
+--      
+--      This test also verifies that two mapping array variables defined 
+--      in package Interfaces.COBOL, Ada_To_COBOL and COBOL_To_Ada, are 
+--      available, and that they can be modified by a user at runtime.  
+--      Finally, the effects of user modifications on these mapping 
+--      variables is checked in the test.
+--      
+--      This test uses Fixed, Bounded, and Unbounded_Strings in combination
+--      with the functions under validation.
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.COBOL.COBOL_Character:
+--      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*', ',', '.', and '$'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.COBOL.  If an implementation provides
+--      package Interfaces.COBOL, this test must compile, execute, and 
+--      report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      11 Jan 96   SAIC    Initial prerelease version for ACVC 2.1
+--      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Ada.Exceptions;
+with Ada.Strings.Bounded;
+with Ada.Strings.Unbounded;
+with Interfaces.COBOL;                                          -- N/A => ERROR
+
+procedure CXB4005 is
+begin
+
+   Report.Test ("CXB4005", "Check that the functions To_COBOL and " &
+                           "To_Ada produce correct results");
+
+   Test_Block:
+   declare
+
+      package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(5);
+      package Unb renames Ada.Strings.Unbounded;
+
+      use Ada.Exceptions;
+      use Interfaces;
+      use Bnd;
+      use type Unb.Unbounded_String;
+      use type Interfaces.COBOL.Alphanumeric;
+
+      TC_Alphanumeric_1  : Interfaces.COBOL.Alphanumeric(1..1);
+      TC_Alphanumeric_5  : Interfaces.COBOL.Alphanumeric(1..5);
+      TC_Alphanumeric_10 : Interfaces.COBOL.Alphanumeric(1..10);
+      TC_Alphanumeric_20 : Interfaces.COBOL.Alphanumeric(1..20);
+
+      Bnd_String,
+      TC_Bnd_String      : Bnd.Bounded_String   :=
+                             Bnd.To_Bounded_String("     ");
+      Unb_String,
+      TC_Unb_String      : Unb.Unbounded_String :=
+                             Unb.To_Unbounded_String("                    ");
+
+      The_String,
+      TC_String          : String(1..20) := ("                    ");
+
+   begin
+
+      -- Check that the function To_COBOL will convert a String 
+      -- parameter value into a type Alphanumeric array of 
+      -- COBOL_Characters, with lower bound of one, and length 
+      -- equal to length of the String parameter, based on the 
+      -- mapping Ada_to_COBOL.
+
+      Unb_String         := Unb.To_Unbounded_String("A");
+      TC_Alphanumeric_1  := COBOL.To_COBOL(Unb.To_String(Unb_String));
+
+      if TC_Alphanumeric_1        /= "A"                    or
+         TC_Alphanumeric_1'Length /= Unb.Length(Unb_String) or
+         TC_Alphanumeric_1'Length /= 1                      or
+         COBOL.To_COBOL(Unb.To_String(Unb_String))'First  /= 1
+      then
+         Report.Failed("Incorrect result from function To_COBOL - 1");
+      end if;
+
+      Bnd_String         := Bnd.To_Bounded_String("abcde");
+      TC_Alphanumeric_5  := COBOL.To_COBOL(Bnd.To_String(Bnd_String));
+
+      if TC_Alphanumeric_5        /= "abcde"                or
+         TC_Alphanumeric_5'Length /= Bnd.Length(Bnd_String) or
+         TC_Alphanumeric_5'Length /= 5                      or
+         COBOL.To_COBOL(Bnd.To_String(Bnd_String))'First  /= 1
+      then
+         Report.Failed("Incorrect result from function To_COBOL - 2");
+      end if;
+
+      Unb_String         := Unb.To_Unbounded_String("1A2B3c4d5F");
+      TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
+
+      if TC_Alphanumeric_10        /= "1A2B3c4d5F"           or
+         TC_Alphanumeric_10'Length /= Unb.Length(Unb_String) or
+         TC_Alphanumeric_10'Length /= 10                     or
+         COBOL.To_COBOL(Unb.To_String(Unb_String))'First  /= 1
+      then
+         Report.Failed("Incorrect result from function To_COBOL - 3");
+      end if;
+
+      The_String         := "abcd  ghij" & "1234  7890";
+      TC_Alphanumeric_20 := COBOL.To_COBOL(The_String);
+
+      if TC_Alphanumeric_20                /= "abcd  ghij1234  7890" or
+         TC_Alphanumeric_20'Length         /= The_String'Length      or
+         TC_Alphanumeric_20'Length         /= 20                     or
+         COBOL.To_COBOL(The_String)'First  /= 1
+      then
+         Report.Failed("Incorrect result from function To_COBOL - 4");
+      end if;
+
+
+
+      -- Check that the function To_Ada will convert a type 
+      -- Alphanumeric parameter value into a String type result, 
+      -- with lower bound of one, and length equal to the length 
+      -- of the Alphanumeric parameter, based on the mapping 
+      -- COBOL_to_Ada.
+
+      TC_Unb_String := Unb.To_Unbounded_String 
+                         (COBOL.To_Ada(TC_Alphanumeric_1));
+
+      if TC_Unb_String             /= "A"                       or
+         TC_Alphanumeric_1'Length  /= Unb.Length(TC_Unb_String) or
+         Unb.Length(TC_Unb_String) /= 1                         or
+         COBOL.To_Ada(TC_Alphanumeric_1)'First /= 1
+      then
+         Report.Failed("Incorrect value returned from function To_Ada - 1");
+      end if;
+
+      TC_Bnd_String := Bnd.To_Bounded_String 
+                         (COBOL.To_Ada(TC_Alphanumeric_5));
+
+      if TC_Bnd_String             /= "abcde"                   or
+         TC_Alphanumeric_5'Length  /= Bnd.Length(TC_Bnd_String) or
+         Bnd.Length(TC_Bnd_String) /= 5                         or
+         COBOL.To_Ada(TC_Alphanumeric_5)'First /= 1
+      then
+         Report.Failed("Incorrect value returned from function To_Ada - 2");
+      end if;
+
+      TC_Unb_String := Unb.To_Unbounded_String 
+                         (COBOL.To_Ada(TC_Alphanumeric_10));
+
+      if TC_Unb_String             /= "1A2B3c4d5F"              or
+         TC_Alphanumeric_10'Length /= Unb.Length(TC_Unb_String) or
+         Unb.Length(TC_Unb_String) /= 10                        or
+         COBOL.To_Ada(TC_Alphanumeric_10)'First /= 1
+      then
+         Report.Failed("Incorrect value returned from function To_Ada - 3");
+      end if;
+
+      TC_String := COBOL.To_Ada(TC_Alphanumeric_20);
+
+      if TC_String                 /= "abcd  ghij1234  7890" or
+         TC_Alphanumeric_20'Length /= TC_String'Length       or
+         TC_String'Length          /= 20                     or
+         COBOL.To_Ada(TC_Alphanumeric_20)'First /= 1
+      then
+         Report.Failed("Incorrect value returned from function To_Ada - 4");
+      end if;
+
+
+      -- Check the two functions when used in combination.
+
+      if COBOL.To_COBOL(Item => COBOL.To_Ada("This is a test")) /=
+         "This is a test"                                         or
+         COBOL.To_COBOL(COBOL.To_Ada("1234567890abcdeFGHIJ"))   /=
+         "1234567890abcdeFGHIJ"
+      then
+         Report.Failed("Incorrect result returned when using the " &
+                       "functions To_Ada and To_COBOL in combination");
+      end if;
+
+
+
+      -- Check that the Ada_to_COBOL and COBOL_to_Ada mapping 
+      -- arrays provide a mapping capability between Ada's type 
+      -- Character and COBOL run-time character sets.
+
+      Interfaces.COBOL.Ada_To_COBOL('a') := 'A';
+      Interfaces.COBOL.Ada_To_COBOL('b') := 'B';
+      Interfaces.COBOL.Ada_To_COBOL('c') := 'C';
+      Interfaces.COBOL.Ada_To_COBOL('d') := '1';
+      Interfaces.COBOL.Ada_To_COBOL('e') := '2';
+      Interfaces.COBOL.Ada_To_COBOL('f') := '3';
+      Interfaces.COBOL.Ada_To_COBOL(' ') := '*';
+
+      Unb_String         := Unb.To_Unbounded_String("b");
+      TC_Alphanumeric_1  := COBOL.To_COBOL(Unb.To_String(Unb_String));
+
+      if TC_Alphanumeric_1 /= "B" then
+         Report.Failed("Incorrect result from function To_COBOL after " &
+                       "modification to Ada_To_COBOL mapping array - 1");
+      end if;
+
+      Bnd_String         := Bnd.To_Bounded_String("abcde");
+      TC_Alphanumeric_5  := COBOL.To_COBOL(Bnd.To_String(Bnd_String));
+
+      if TC_Alphanumeric_5 /= "ABC12" then
+         Report.Failed("Incorrect result from function To_COBOL after " &
+                       "modification to Ada_To_COBOL mapping array - 2");
+      end if;
+
+      Unb_String         := Unb.To_Unbounded_String("1a2B3c4d5e");
+      TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
+
+      if TC_Alphanumeric_10 /= "1A2B3C4152" then
+         Report.Failed("Incorrect result from function To_COBOL after " &
+                       "modification to Ada_To_COBOL mapping array - 3");
+      end if;
+
+      The_String         := "abcd  ghij" & "1234  7890";
+      TC_Alphanumeric_20 := COBOL.To_COBOL(The_String);
+
+      if TC_Alphanumeric_20 /= "ABC1**ghij1234**7890" then
+         Report.Failed("Incorrect result from function To_COBOL after " &
+                       "modification to Ada_To_COBOL mapping array - 4");
+      end if;
+
+
+      -- Reset the Ada_To_COBOL mapping array to its original state.
+
+      Interfaces.COBOL.Ada_To_COBOL('a') := 'a';
+      Interfaces.COBOL.Ada_To_COBOL('b') := 'b';
+      Interfaces.COBOL.Ada_To_COBOL('c') := 'c';
+      Interfaces.COBOL.Ada_To_COBOL('d') := 'd';
+      Interfaces.COBOL.Ada_To_COBOL('e') := 'e';
+      Interfaces.COBOL.Ada_To_COBOL('f') := 'f';
+      Interfaces.COBOL.Ada_To_COBOL(' ') := ' ';
+
+      -- Modify the COBOL_To_Ada mapping array to check its effect on
+      -- the function To_Ada.
+
+      Interfaces.COBOL.COBOL_To_Ada(' ') := '*';
+      Interfaces.COBOL.COBOL_To_Ada('$') := 'F';
+      Interfaces.COBOL.COBOL_To_Ada('1') := '7';
+      Interfaces.COBOL.COBOL_To_Ada('.') := ',';
+
+      Unb_String         := Unb.To_Unbounded_String("  $$100.00");
+      TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
+      TC_Unb_String      := Unb.To_Unbounded_String(
+                              COBOL.To_Ada(TC_Alphanumeric_10));
+
+      if Unb.To_String(TC_Unb_String) /= "**FF700,00" then
+         Report.Failed("Incorrect result from function To_Ada after " &
+                       "modification of COBOL_To_Ada mapping array - 1");
+      end if;
+
+      Interfaces.COBOL.COBOL_To_Ada('*') := ' ';
+      Interfaces.COBOL.COBOL_To_Ada('F') := '$';
+      Interfaces.COBOL.COBOL_To_Ada('7') := '1';
+      Interfaces.COBOL.COBOL_To_Ada(',') := '.';
+
+      if COBOL.To_Ada(COBOL.To_COBOL(Unb.To_String(TC_Unb_String))) /= 
+         Unb_String 
+      then
+         Report.Failed("Incorrect result from function To_Ada after " &
+                       "modification of COBOL_To_Ada mapping array - 2");
+      end if;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed ("The following exception was raised in the " &
+                        "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB4005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4006.a
new file mode 100644
index 000000000..6e491eebf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4006.a
@@ -0,0 +1,322 @@
+-- CXB4006.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 function Valid with Packed_Decimal and Packed_Format
+--      parameters returns True if Item (the Packed_Decimal parameter) has
+--      a value consistent with the Packed_Format parameter.
+--
+--      Check that the function Length with Packed_Format parameter returns
+--      the minimal length of a Packed_Decimal value sufficient to hold any
+--      value of type Num when represented according to parameter Format.
+--
+--      Check that the function To_Decimal with Packed_Decimal and 
+--      Packed_Format parameters produces a decimal type value corresponding 
+--      to the Packed_Decimal parameter value Item, under the conditions of 
+--      the Packed_Format parameter Format.
+--
+--      Check that the function To_Packed with Decimal (Num) and 
+--      Packed_Format parameters produces a Packed_Decimal result that 
+--      corresponds to the decimal parameter under conditions of the 
+--      Packed_Format parameter.
+--
+--      Check that Conversion_Error is propagated by function To_Packed if 
+--      the value of the decimal parameter Item is negative and the specified
+--      Packed_Format parameter is Packed_Unsigned.
+--
+--      
+-- TEST DESCRIPTION:
+--      This test checks the results from instantiated versions of 
+--      several functions that deal with parameters or results of type
+--      Packed_Decimal.  Since the rules for the formation of Packed_Decimal
+--      values are implementation defined, several of the subtests cannot
+--      directly check the accuracy of the results produced. Instead, they
+--      verify that the result is within a range of possible values, or
+--      that the result of one function can be converted back to the original 
+--      actual parameter using a "mirror image" conversion function.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.COBOL.  If an implementation provides
+--      package Interfaces.COBOL, this test must compile, execute, and 
+--      report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      12 Feb 96   SAIC    Initial release for 2.1.
+--      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Ada.Exceptions;
+with Interfaces.COBOL;                                          -- N/A => ERROR
+
+procedure CXB4006 is
+begin
+
+   Report.Test ("CXB4006", "Check that the functions Valid, Length, "   &
+                           "To_Decimal, and To_Packed specific to "     &
+                           "Packed_Decimal parameters produce correct " &
+                           "results");
+
+   Test_Block:
+   declare
+
+      use Interfaces.COBOL;
+      use Ada.Exceptions;
+      use type Interfaces.COBOL.Numeric;
+
+      type Decimal_Type_1 is delta 0.1    digits  6;
+      type Decimal_Type_2 is delta 0.01   digits  8;
+      type Decimal_Type_3 is delta 0.001  digits 10;
+      type Decimal_Type_4 is delta 0.0001 digits 12;
+
+      package Pack_1 is new Decimal_Conversions(Decimal_Type_1);
+      package Pack_2 is new Decimal_Conversions(Decimal_Type_2);
+      package Pack_3 is new Decimal_Conversions(Decimal_Type_3);
+      package Pack_4 is new Decimal_Conversions(Decimal_Type_4);
+
+      TC_Dec_1      : Decimal_Type_1 := 12345.6;
+      TC_Dec_2      : Decimal_Type_2 := 123456.78;
+      TC_Dec_3      : Decimal_Type_3 := 1234567.890;
+      TC_Dec_4      : Decimal_Type_4 := 12345678.9012;
+      TC_Min_Length : Natural        := 1;
+      TC_Max_Length : Natural        := 16;
+
+   begin
+
+      -- Check that the function Valid with Packed_Decimal and Packed_Format
+      -- parameters returns True if Item (the Packed_Decimal parameter) has 
+      -- a value consistent with the Packed_Format parameter.
+      -- Note: Since the formation rules for Packed_Decimal values are
+      --       implementation defined, the parameter values here are 
+      --       created by function To_Packed.
+
+      TC_Dec_1 := 1434.3;
+      if not Pack_1.Valid(Item   => Pack_1.To_Packed(TC_Dec_1, 
+                                                     Packed_Unsigned),
+                          Format => Packed_Unsigned)
+      then
+         Report.Failed("Incorrect result from function Valid - 1");
+      end if;
+
+      TC_Dec_2 := -4321.03;
+      if not Pack_2.Valid(Pack_2.To_Packed(TC_Dec_2, Packed_Signed),
+                          Format => Packed_Signed)                   or
+         Pack_2.Valid(Pack_2.To_Packed(TC_Dec_2, Packed_Signed),
+                      Format => Packed_Unsigned)
+      then
+         Report.Failed("Incorrect result from function Valid - 2");
+      end if;
+
+      TC_Dec_3 := 1234567.890;
+      if not Pack_3.Valid(Pack_3.To_Packed(TC_Dec_3, Packed_Unsigned),
+                          Packed_Unsigned)
+      then
+         Report.Failed("Incorrect result from function Valid - 3");
+      end if;
+
+      TC_Dec_4 := -234.6789;
+      if not Pack_4.Valid(Item   => Pack_4.To_Packed(TC_Dec_4, 
+                                                     Packed_Signed),
+                          Format => Packed_Signed)                        or
+         Pack_4.Valid(Item   => Pack_4.To_Packed(TC_Dec_4, Packed_Signed),
+                      Format => Packed_Unsigned)
+      then
+         Report.Failed("Incorrect result from function Valid - 4");
+      end if;
+
+
+
+      -- Check that the function Length with Packed_Format parameter returns
+      -- the minimal length of a Packed_Decimal value sufficient to hold any
+      -- value of type Num when represented according to parameter Format.
+
+      if NOT (Pack_1.Length(Packed_Signed)   >= TC_Min_Length AND
+              Pack_1.Length(Packed_Signed)   <= TC_Max_Length AND
+              Pack_1.Length(Packed_Unsigned) >= TC_Min_Length AND
+              Pack_1.Length(Packed_Unsigned) <= TC_Max_Length)
+      then
+         Report.Failed("Incorrect result from function Length - 1");
+      end if;
+
+      if NOT (Pack_2.Length(Packed_Signed)   >= TC_Min_Length AND
+              Pack_2.Length(Packed_Signed)   <= TC_Max_Length AND
+              Pack_2.Length(Packed_Unsigned) >= TC_Min_Length AND
+              Pack_2.Length(Packed_Unsigned) <= TC_Max_Length)
+      then
+         Report.Failed("Incorrect result from function Length - 2");
+      end if;
+
+      if NOT (Pack_3.Length(Packed_Signed)   >= TC_Min_Length AND
+              Pack_3.Length(Packed_Signed)   <= TC_Max_Length AND
+              Pack_3.Length(Packed_Unsigned) >= TC_Min_Length AND
+              Pack_3.Length(Packed_Unsigned) <= TC_Max_Length)
+      then
+         Report.Failed("Incorrect result from function Length - 3");
+      end if;
+
+      if NOT (Pack_4.Length(Packed_Signed)   >= TC_Min_Length AND
+              Pack_4.Length(Packed_Signed)   <= TC_Max_Length AND
+              Pack_4.Length(Packed_Unsigned) >= TC_Min_Length AND
+              Pack_4.Length(Packed_Unsigned) <= TC_Max_Length)
+      then
+         Report.Failed("Incorrect result from function Length - 4");
+      end if;
+
+
+
+      -- Check that the function To_Decimal with Packed_Decimal and 
+      -- Packed_Format parameters produces a decimal type value corresponding 
+      -- to the Packed_Decimal parameter value Item, under the conditions of 
+      -- the Packed_Format parameter Format.
+
+      begin
+         TC_Dec_1 := 1234.5;
+         if Pack_1.To_Decimal(Item   => Pack_1.To_Packed(TC_Dec_1,
+                                                         Packed_Unsigned),
+                              Format => Packed_Unsigned) /= TC_Dec_1
+         then
+            Report.Failed("Incorrect result from function To_Decimal - 1");
+         end if;
+      exception
+         when The_Error : others => 
+            Report.Failed("The following exception was raised in " &
+                          "subtest 1 of function To_Decimal: "     & 
+                          Exception_Name(The_Error));
+      end;
+
+      begin
+         TC_Dec_2 := -123456.50;
+         if Pack_2.To_Decimal(Pack_2.To_Packed(TC_Dec_2, Packed_Signed),
+                              Format => Packed_Signed) /= TC_Dec_2
+         then
+            Report.Failed("Incorrect result from function To_Decimal - 2");
+         end if;
+      exception
+         when The_Error : others => 
+            Report.Failed("The following exception was raised in " &
+                          "subtest 2 of function To_Decimal: "     & 
+                          Exception_Name(The_Error));
+      end;
+
+      begin
+         TC_Dec_3 := 1234567.809;
+         if Pack_3.To_Decimal(Pack_3.To_Packed(TC_Dec_3, Packed_Unsigned),
+                              Packed_Unsigned) /= TC_Dec_3
+         then
+            Report.Failed("Incorrect result from function To_Decimal - 3");
+         end if;
+      exception
+         when The_Error : others => 
+            Report.Failed("The following exception was raised in " &
+                          "subtest 3 of function To_Decimal: "     & 
+                          Exception_Name(The_Error));
+      end;
+
+      begin
+         TC_Dec_4 := -789.1234;
+         if Pack_4.To_Decimal(Item   => Pack_4.To_Packed(TC_Dec_4,
+                                                         Packed_Signed),
+                              Format => Packed_Signed) /= TC_Dec_4
+         then
+            Report.Failed("Incorrect result from function To_Decimal - 4");
+         end if;
+      exception
+         when The_Error : others => 
+            Report.Failed("The following exception was raised in " &
+                          "subtest 4 of function To_Decimal: "     & 
+                          Exception_Name(The_Error));
+      end;
+
+
+
+      -- Check that the function To_Packed with Decimal (Num) and 
+      -- Packed_Format parameters produces a Packed_Decimal result that 
+      -- corresponds to the decimal parameter under conditions of the 
+      -- Packed_Format parameter.
+
+      if Pack_1.To_Packed(Item =>  123.4, Format => Packed_Unsigned) =
+         Pack_1.To_Packed(Item => -123.4, Format => Packed_Signed)
+      then
+         Report.Failed("Incorrect result from function To_Packed - 1");
+      end if; 
+
+      if Pack_2.To_Packed( 123.45, Format => Packed_Unsigned) =
+         Pack_2.To_Packed(-123.45, Format => Packed_Signed)
+      then
+         Report.Failed("Incorrect result from function To_Packed - 2");
+      end if; 
+
+      if Pack_3.To_Packed(Item =>  123.456, Format => Packed_Unsigned) =
+         Pack_3.To_Packed(Item => -123.456, Format => Packed_Signed)
+      then
+         Report.Failed("Incorrect result from function To_Packed - 3");
+      end if; 
+
+      if (Pack_4.To_Packed( 123.4567, Packed_Unsigned)     =
+          Pack_4.To_Packed(-123.4567, Packed_Signed))       or
+         (Pack_4.To_Packed(12345678.9012, Packed_Unsigned) =
+          Pack_4.To_Packed(12345678.9013, Packed_Unsigned)) or
+         (Pack_4.To_Packed(12345678.9012, Packed_Unsigned) =
+          Pack_4.To_Packed(22345678.9012, Packed_Unsigned)) 
+      then
+         Report.Failed("Incorrect result from function To_Packed - 4");
+      end if; 
+
+
+      -- Check that Conversion_Error is propagated by function To_Packed if 
+      -- the value of the decimal parameter Item is negative and the 
+      -- specified Packed_Format parameter is Packed_Unsigned.
+
+      begin
+         if Pack_1.To_Packed(Item => -12.3, Format => Packed_Unsigned) =
+            Pack_1.To_Packed(Item =>  12.3, Format => Packed_Signed)
+         then
+            Report.Comment("Should never be printed");
+         end if;
+         Report.Failed("Conversion_Error not raised following call to " & 
+                       "function To_Packed with a negative parameter "  &  
+                       "Item and Packed_Format parameter Packed_Unsigned");
+      exception
+         when Conversion_Error   => null;  -- OK, expected exception.
+         when The_Error : others =>
+            Report.Failed(Exception_Name(The_Error) & " was incorrectly " &
+                          "raised following call to function To_Packed "  & 
+                          "with a negative parameter Item and "           &
+                          "Packed_Format parameter Packed_Unsigned"); 
+      end;
+
+   exception
+      when The_Error : others => 
+         Report.Failed("The following exception was raised in the " &
+                       "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB4006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4007.a
new file mode 100644
index 000000000..c4e064176
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4007.a
@@ -0,0 +1,271 @@
+-- CXB4007.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 function Valid with Byte_Array and Binary_Format 
+--      parameters returns True if the Byte_Array parameter corresponds 
+--      to any value inside the range of type Num.
+--      Check that function Valid returns False if the Byte_Array parameter
+--      corresponds to a value outside the range of Num. 
+--
+--      Check that function Length with Binary_Format parameter will return
+--      the minimum length of a Byte_Array value required to hold any value
+--      of decimal type Num.
+--
+--      Check that function To_Decimal with Byte_Array and Binary_Format
+--      parameters will return a decimal type value that corresponds to
+--      parameter Item (of type Byte_Array) under the specified Format.
+--
+--      Check that Conversion_Error is propagated by function To_Decimal if
+--      the Byte_Array parameter Item represents a decimal value outside the
+--      range of decimal type Num.
+--
+--      Check that function To_Binary will produce a Byte_Array result that
+--      corresponds to the decimal type parameter Item, under the specified
+--      Binary_Format.
+--      
+-- TEST DESCRIPTION:
+--      This test uses several instantiations of generic package 
+--      Decimal_Conversions to provide appropriate test material.
+--      This test uses the function To_Binary to create all Byte_Array 
+--      parameter values used in calls to functions Valid and To_Decimal.
+--      The function Valid is tested with parameters to provide both
+--      valid and invalid expected results.  This test also checks that
+--      Function To_Decimal produces expected results in cases where each
+--      of the three predefined Binary_Format constants are used in the
+--      function calls. In addition, the prescribed propagation of 
+--      Conversion_Error by function To_Decimal is verified.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.COBOL.  If an implementation provides
+--      package Interfaces.COBOL, this test must compile, execute, and 
+--      report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      14 Feb 96   SAIC    Initial release for 2.1.
+--      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--      05 JAN 98   EDS     Remove incorrect subtest.
+--!
+
+with Report;
+with Ada.Exceptions;
+with Interfaces.COBOL;                                          -- N/A => ERROR
+
+procedure CXB4007 is
+begin
+
+   Report.Test ("CXB4007", "Check that functions Valid, Length, To_Decimal " &
+                           "and To_Binary specific to Byte_Array and "       &
+                           "Binary_Format parameters produce correct results");
+
+   Test_Block:
+   declare
+
+      use Interfaces.COBOL;
+      use Ada.Exceptions;
+      use type Interfaces.COBOL.Numeric;
+
+      type Decimal_Type_1 is delta 0.1    digits  6;
+      type Decimal_Type_2 is delta 0.01   digits  8;
+      type Decimal_Type_3 is delta 0.001  digits 10;
+      type Decimal_Type_4 is delta 0.0001 digits 12;
+
+      package Pack_1 is new Decimal_Conversions(Decimal_Type_1);
+      package Pack_2 is new Decimal_Conversions(Decimal_Type_2);
+      package Pack_3 is new Decimal_Conversions(Decimal_Type_3);
+      package Pack_4 is new Decimal_Conversions(Decimal_Type_4);
+
+      TC_Dec_1      : Decimal_Type_1 := 12345.6;
+      TC_Dec_2      : Decimal_Type_2 := 123456.78;
+      TC_Dec_3      : Decimal_Type_3 := 1234567.890;
+      TC_Dec_4      : Decimal_Type_4 := 12345678.9012;
+      TC_Min_Length : Natural        := 1;
+      TC_Max_Length : Natural        := 16;
+      TC_Valid      : Boolean        := False;
+
+   begin
+
+      -- Check that the function Valid with Byte_Array and Binary_Format 
+      -- parameters returns True if the Byte_Array parameter corresponds to 
+      -- any value inside the range of type Num.
+
+      if not Pack_1.Valid(Item   => Pack_1.To_Binary(TC_Dec_1,
+                                                     High_Order_First),
+                          Format => High_Order_First)                   or
+         not Pack_1.Valid(Pack_1.To_Binary(0.0, Low_Order_First), 
+                          Format => Low_Order_First)                    
+      then
+         Report.Failed("Incorrect result from function Valid, using " &
+                       "parameters that should return a positive result - 1");
+      end if;
+
+      TC_Valid := (Pack_2.Valid(Pack_2.To_Binary(TC_Dec_2, High_Order_First),
+                                Format => High_Order_First)             and
+                   Pack_2.Valid(Pack_2.To_Binary(0.01, Low_Order_First), 
+                                Format => Low_Order_First));              
+      if not TC_Valid then
+         Report.Failed("Incorrect result from function Valid, using " &
+                       "parameters that should return a positive result - 2");
+      end if;
+
+      if not Pack_3.Valid(Item   => Pack_3.To_Binary(TC_Dec_3,
+                                                     Low_Order_First),
+                          Format => Low_Order_First)                  or
+         not Pack_3.Valid(Pack_3.To_Binary(0.001, High_Order_First), 
+                          Format => High_Order_First)                 or
+         not Pack_3.Valid(Pack_3.To_Binary(123.456, Native_Binary),
+                          Native_Binary)
+      then
+         Report.Failed("Incorrect result from function Valid, using " &
+                       "parameters that should return a positive result - 3");
+      end if;
+
+
+      -- Check that function Valid returns False if the Byte_Array parameter
+      -- corresponds to a value outside the range of Num. 
+      -- Note: use a Byte_Array value Item created by an instantiation of 
+      --       To_Binary with a larger Num type as the generic formal.
+
+      if Pack_1.Valid(Item   => Pack_2.To_Binary(TC_Dec_2, Low_Order_First),
+                      Format => Low_Order_First)                or
+         Pack_2.Valid(Pack_3.To_Binary(TC_Dec_3, High_Order_First), 
+                      Format => High_Order_First)               or
+         Pack_3.Valid(Pack_4.To_Binary(TC_Dec_4, Native_Binary),
+                      Native_Binary)
+      then
+         Report.Failed("Incorrect result from function Valid, using " &
+                       "parameters that should return a negative result");
+      end if;
+
+
+      -- Check that function Length with Binary_Format parameter will return
+      -- the minimum length of a Byte_Array value required to hold any value
+      -- of decimal type Num.
+
+      if not (Pack_1.Length(Native_Binary)    >= TC_Min_Length and
+              Pack_1.Length(Low_Order_First)  <= TC_Max_Length and
+              Pack_2.Length(High_Order_First) >= TC_Min_Length and
+              Pack_2.Length(Native_Binary)    <= TC_Max_Length and
+              Pack_3.Length(Low_Order_First)  >= TC_Min_Length and
+              Pack_3.Length(High_Order_First) <= TC_Max_Length and
+              Pack_4.Length(Native_Binary)    >= TC_Min_Length and
+              Pack_4.Length(Low_Order_First)  <= TC_Max_Length)
+      then
+         Report.Failed("Incorrect result from function Length");
+      end if;
+
+
+
+      -- Check that function To_Decimal with Byte_Array and Binary_Format
+      -- parameters will return a decimal type value that corresponds to
+      -- parameter Item (of type Byte_Array) under the specified Format.
+
+      if Pack_1.To_Decimal(Item   => Pack_1.To_Binary(Item   => TC_Dec_1, 
+                                                      Format => Native_Binary),
+                           Format => Native_Binary) /=
+         TC_Dec_1
+      then
+         Report.Failed("Incorrect result from function To_Decimal - 1");
+      end if;
+
+      if Pack_3.To_Decimal(Pack_3.To_Binary(TC_Dec_3, High_Order_First),
+                           Format => High_Order_First) /=
+         TC_Dec_3
+      then
+         Report.Failed("Incorrect result from function To_Decimal - 2");
+      end if;
+
+      if Pack_4.To_Decimal(Pack_4.To_Binary(TC_Dec_4, Low_Order_First),
+                           Low_Order_First) /=
+         TC_Dec_4
+      then
+         Report.Failed("Incorrect result from function To_Decimal - 3");
+      end if;
+
+
+
+      -- Check that Conversion_Error is propagated by function To_Decimal
+      -- if the Byte_Array parameter Item represents a decimal value outside
+      -- the range of decimal type Num.
+      -- Note: use a Byte_Array value Item created by an instantiation of 
+      --       To_Binary with a larger Num type as the generic formal.
+
+      begin
+         TC_Dec_4 := 99999.9001;
+         TC_Dec_1 := Pack_1.To_Decimal(Pack_4.To_Binary(TC_Dec_4,
+                                                        Native_Binary),
+                                       Format => Native_Binary); 
+         if TC_Dec_1 = 99999.9 then
+            Report.Comment("Minimize dead assignment optimization -- " &
+                           "Should never be printed");
+         end if;
+         Report.Failed("Conversion_Error not raised following call to "   &
+                       "function To_Decimal if the Byte_Array parameter " &
+                       "Item represents a decimal value outside the "     &
+                       "range of decimal type Num");
+      exception
+         when Conversion_Error   => null;  -- OK, expected exception.
+         when The_Error : others =>
+            Report.Failed(Exception_Name(The_Error) & " was incorrectly " &
+                          "raised following call to function To_Decimal " &
+                          "if the Byte_Array parameter Item represents "  &
+                          "a decimal value outside the range of decimal " &
+                          "type Num");
+      end;
+
+
+
+      -- Check that function To_Binary will produce a Byte_Array result that
+      -- corresponds to the decimal type parameter Item, under the specified
+      -- Binary_Format.
+
+      -- Different ordering.
+      TC_Dec_1 := 12345.6;
+      if Pack_1.To_Binary(TC_Dec_1, Low_Order_First)  =
+         Pack_1.To_Binary(TC_Dec_1, High_Order_First)
+      then
+         Report.Failed("Incorrect result from function To_Binary - 1");
+      end if;
+
+      -- Variable vs. literal.
+      TC_Dec_2 := 12345.00;
+      if Pack_2.To_Binary(TC_Dec_2, Native_Binary) /=
+         Pack_2.To_Binary(12345.00, Native_Binary)
+      then
+         Report.Failed("Incorrect result from function To_Binary - 2");
+      end if;
+
+   exception
+      when The_Error : others => 
+         Report.Failed("The following exception was raised in the " &
+                       "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB4007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4008.a
new file mode 100644
index 000000000..5ab8e6b03
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb4008.a
@@ -0,0 +1,248 @@
+-- CXB4008.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 function To_Decimal with Binary parameter will return
+--      the corresponding value of the decimal type Num.
+--
+--      Check that the function To_Decimal with Long_Binary parameter will 
+--      return the corresponding value of the decimal type Num.
+--
+--      Check that both of the To_Decimal functions described above will 
+--      propagate Conversion_Error if the converted value Item is outside 
+--      the range of type Num.
+--
+--      Check that the function To_Binary converts a value of the Ada 
+--      decimal type Num into a Binary type value.
+--
+--      Check that the function To_Long_Binary converts a value of the Ada 
+--      decimal type Num into a Long_Binary type value.
+--      
+-- TEST DESCRIPTION:
+--      This test uses several instantiations of generic package 
+--      Decimal_Conversions to provide appropriate test material.
+--      Two of the instantiations use decimal types as generic actuals
+--      that include the implementation defined constants Max_Digits_Binary 
+--      and Max_Digits_Long_Binary in their definition.
+--
+--      Subtests are included for both versions of function To_Decimal,
+--      (Binary and Long_Binary parameters), and include checks that
+--      Conversion_Error is propagated under the appropriate circumstances.
+--      Functions To_Binary and To_Long_Binary are "sanity" checked, to  
+--      ensure that the functions are available, and that the results are 
+--      appropriate based on their parameter input.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.COBOL.  If an implementation provides
+--      package Interfaces.COBOL, this test must compile, execute, and 
+--      report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      21 Feb 96   SAIC    Initial release for 2.1.
+--      10 Jun 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Ada.Exceptions;
+with Interfaces.COBOL;                                          -- N/A => ERROR
+
+procedure CXB4008 is
+begin
+
+   Report.Test ("CXB4008", "Check that functions To_Decimal, To_Binary, and " &
+                           "To_Long_Binary produce the correct results");
+
+   Test_Block:
+   declare
+
+      use Interfaces.COBOL;
+      use Ada.Exceptions;
+      use type Interfaces.COBOL.Numeric;
+
+      type Decimal_Type_1 is delta 0.1    digits  6;
+      type Decimal_Type_2 is delta 0.01   digits Max_Digits_Binary;
+      type Decimal_Type_3 is delta 0.001  digits 10;
+      type Decimal_Type_4 is delta 0.0001 digits Max_Digits_Long_Binary;
+
+      package Pack_1 is new Decimal_Conversions(Decimal_Type_1);
+      package Pack_2 is new Decimal_Conversions(Decimal_Type_2);
+      package Pack_3 is new Decimal_Conversions(Decimal_Type_3);
+      package Pack_4 is new Decimal_Conversions(Decimal_Type_4);
+
+      TC_Dec_1       : Decimal_Type_1 := 12345.0;
+      TC_Dec_2       : Decimal_Type_2 := 123456.00;
+      TC_Dec_3       : Decimal_Type_3 := 1234567.000;
+      TC_Dec_4       : Decimal_Type_4 := 12345678.0000;
+      TC_Binary      : Interfaces.COBOL.Binary;
+      TC_Long_Binary : Interfaces.COBOL.Long_Binary;
+
+   begin
+
+      -- Check that the function To_Decimal with Binary parameter will 
+      -- return the corresponding value of the decimal type Num.
+
+      if Pack_1.To_Decimal(Item => Pack_1.To_Binary(TC_Dec_1)) /= TC_Dec_1 or
+         Pack_2.To_Decimal(Pack_2.To_Binary(TC_Dec_2))         /= TC_Dec_2 
+      then
+         Report.Failed("Incorrect result from function To_Decimal with " &
+                       "Binary parameter - 1");
+      end if;
+
+      if Pack_1.To_Decimal(Item => Pack_1.To_Binary(1234.0)) /= 1234.0 then
+         Report.Failed("Incorrect result from function To_Decimal with " &
+                       "Binary parameter - 2");
+      end if;
+
+      TC_Binary := Pack_2.To_Binary(TC_Dec_2);
+      if Pack_2.To_Decimal(TC_Binary) /= TC_Dec_2 then
+         Report.Failed("Incorrect result from function To_Decimal with " &
+                       "Binary parameter - 3");
+      end if;
+
+
+
+      -- Check that the function To_Decimal with Long_Binary parameter 
+      -- will return the corresponding value of the decimal type Num.
+
+      if Pack_3.To_Decimal(Item => Pack_3.To_Long_Binary(TC_Dec_3)) /= 
+         TC_Dec_3                                                      or
+         Pack_4.To_Decimal(Pack_4.To_Long_Binary(TC_Dec_4))         /= 
+         TC_Dec_4 
+      then
+         Report.Failed("Incorrect result from function To_Decimal with " &
+                       "Long_Binary parameter - 1");
+      end if;
+
+      if Pack_3.To_Decimal(Pack_3.To_Long_Binary(1234567.0)) /= 1234567.0 then
+         Report.Failed("Incorrect result from function To_Decimal with " &
+                       "Long_Binary parameter - 2");
+      end if;
+
+      TC_Long_Binary := Pack_4.To_Long_Binary(TC_Dec_4);
+      if Pack_4.To_Decimal(TC_Long_Binary) /= TC_Dec_4 then
+         Report.Failed("Incorrect result from function To_Decimal with " &
+                       "Long_Binary parameter - 3");
+      end if;
+
+
+
+      -- Check that both of the To_Decimal functions described above 
+      -- will propagate Conversion_Error if the converted value Item is 
+      -- outside the range of type Num.
+      -- Note: Binary/Long_Binary parameter values are created by an 
+      --       instantiation of To_Binary/To_Long_Binary with a larger 
+      --       Num type as the generic formal.
+
+      Binary_Parameter:
+      begin
+         TC_Dec_1 := Pack_1.To_Decimal(Pack_2.To_Binary(123456.78));
+         Report.Failed("Conversion_Error was not raised by function " &
+                       "To_Decimal with Binary parameter, when the "  &
+                       "converted value Item was outside the range "  &
+                       "of type Num");
+         if TC_Dec_1 = 12345.6 then  -- Avoid dead assignment optimization.
+            Report.Comment("Should never be printed");
+         end if;
+      exception
+         when Conversion_Error   => null;  -- OK, expected exception.
+         when The_Error : others =>
+            Report.Failed(Ada.Exceptions.Exception_Name(The_Error) & " "   &
+                          "was incorrectly raised by function To_Decimal " &
+                          "with Binary parameter, when the converted "     &
+                          "value Item was outside the range of type Num");
+      end Binary_Parameter;
+
+      Long_Binary_Parameter:
+      begin
+         TC_Dec_3 := Pack_3.To_Decimal(Pack_4.To_Long_Binary(TC_Dec_4));
+         Report.Failed("Conversion_Error was not raised by function "     &
+                       "To_Decimal with Long_Binary parameter, when "     &
+                       "the converted value Item was outside the range "  &
+                       "of type Num");
+         if TC_Dec_3 = 123456.78 then  -- Avoid dead assignment optimization.
+            Report.Comment("Should never be printed");
+         end if;
+      exception
+         when Conversion_Error   => null;  -- OK, expected exception.
+         when The_Error : others =>
+            Report.Failed(Ada.Exceptions.Exception_Name(The_Error) & " "    &
+                          "was incorrectly raised by function To_Decimal "  &
+                          "with Long_Binary parameter, when the converted " &
+                          "value Item was outside the range of type Num");
+      end Long_Binary_Parameter;
+
+
+
+      -- Check that the function To_Binary converts a value of the Ada 
+      -- decimal type Num into a Binary type value.
+
+      TC_Dec_1 := 123.4;
+      TC_Dec_2 := 9.99;
+      if Pack_1.To_Binary(TC_Dec_1) = Pack_1.To_Binary(-TC_Dec_1) or
+         Pack_2.To_Binary(TC_Dec_2) = Pack_2.To_Binary(-TC_Dec_2) 
+      then
+         Report.Failed("Incorrect result from function To_Binary - 1");
+      end if;
+
+      if Pack_1.To_Binary(1.1)     = Pack_1.To_Binary(-1.1)      or
+         Pack_2.To_Binary(9999.99) = Pack_2.To_Binary(-9999.99) 
+      then
+         Report.Failed("Incorrect result from function To_Binary - 2");
+      end if;
+
+
+      -- Check that the function To_Long_Binary converts a value of the 
+      -- Ada decimal type Num into a Long_Binary type value.
+
+      TC_Dec_3 := 9.001;
+      TC_Dec_4 := 123.4567;
+      if Pack_3.To_Long_Binary(TC_Dec_3) = Pack_3.To_Long_Binary(-TC_Dec_3) or
+         Pack_4.To_Long_Binary(TC_Dec_4) = Pack_4.To_Long_Binary(-TC_Dec_4)
+      then
+         Report.Failed("Incorrect result from function To_Long_Binary - 1");
+      end if;
+
+      if Pack_3.To_Long_Binary(1.011)        = 
+         Pack_3.To_Long_Binary(-1.011)         or
+         Pack_4.To_Long_Binary(2345678.9012) = 
+         Pack_4.To_Long_Binary(-2345678.9012)
+      then
+         Report.Failed("Incorrect result from function To_Long_Binary - 2");
+      end if;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed("The following exception was raised in the " &
+                       "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB4008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb5001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb5001.a
new file mode 100644
index 000000000..a681c5f13
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb5001.a
@@ -0,0 +1,110 @@
+-- CXB5001.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 specification of the package Interfaces.Fortran
+--      are available for use.
+--
+-- TEST DESCRIPTION:
+--      This test verifies that the types and subprograms specified for the
+--      interface are present
+--
+-- APPLICABILITY CRITERIA: 
+--      If an implementation provides package Interfaces.Fortran, this test
+--      must compile, execute, and report "PASSED".
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      28 Feb 96   SAIC    Added applicability criteria.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Interfaces.Fortran;                                        -- N/A => ERROR
+
+procedure CXB5001 is
+   package Fortran renames Interfaces.FORTRAN;
+
+begin
+
+   Report.Test ("CXB5001", "Check the specification of Interfaces.Fortran");
+
+
+   declare  -- encapsulate the test
+
+
+         TC_Int     : integer := 1;
+         TC_Natural : natural;
+         TC_String  : String := "ABCD";
+         TC_Character : Character := 'a';
+
+         TST_Fortran_Integer   :  FORTRAN.Fortran_Integer;
+
+         TST_Real              : Fortran.Real;
+         TST_Double_Precision  : Fortran.Double_Precision;
+
+         TST_Logical : Fortran.Logical := FORTRAN.true;     
+                                                   -- verify it is a Boolean
+         TST_Complex : Fortran.Complex;
+
+         TST_Imaginary_i : Fortran.Imaginary := FORTRAN.i;
+         TST_Imaginary_j : Fortran.Imaginary := FORTRAN.j;
+
+
+         -- Initialize it so we can use it below
+         TST_Character_Set : Fortran.Character_Set :=   
+                                                Fortran.Character_Set'First;
+
+         TST_Fortran_Character : FORTRAN.Fortran_Character (1..5) := 
+                                       (others => TST_Character_Set);
+
+
+
+   begin    -- encapsulation
+
+      -- Arrange that the calls to the subprograms are compiled but
+      -- not executed
+      -- 
+      if not Report.Equal ( TC_Int, TC_Int ) then
+
+         TST_Character_Set := Fortran.To_Fortran (TC_Character);
+         TC_Character := Fortran.To_Ada (TST_Character_Set);
+      
+
+         TST_Fortran_Character := FORTRAN.To_Fortran ("TEST STRING");   
+         Report.Comment ( Fortran.To_Ada (TST_Fortran_Character) );
+
+         Fortran.To_Fortran ( TC_String, TST_Fortran_Character, TC_Natural );
+         Fortran.To_Ada ( TST_Fortran_Character, TC_String, TC_Natural );
+         
+      end if;
+
+   end;     -- encapsulation
+
+   Report.Result;
+
+end CXB5001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb5002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb5002.a
new file mode 100644
index 000000000..3da7cc9b1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb5002.a
@@ -0,0 +1,334 @@
+-- CXB5002.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 Function To_Fortran with a Character parameter will
+--      return the corresponding Fortran Character_Set value.
+--
+--      Check that the Function To_Ada with a Character_Set parameter will 
+--      return the corresponding Ada Character value.
+--
+--      Check that the Function To_Fortran with a String parameter will
+--      return the corresponding Fortran_Character value.
+--
+--      Check that the Function To_Ada with a Fortran_Character parameter
+--      will return the corresponding Ada String value.
+--
+-- TEST DESCRIPTION:
+--      This test checks that the functions To_Fortran and To_Ada produce
+--      the correct results, based on a variety of parameter input values.
+--      
+--      In the first series of subtests, the results of the function
+--      To_Fortran are compared against expected Character_Set type results.
+--      In the second series of subtests, the results of the function To_Ada
+--      are compared against expected String type results, and the length of
+--      the String result is also verified against the Fortran_Character type
+--      parameter.
+--      
+--      This test uses Fixed, Bounded, and Unbounded_Strings in combination
+--      with the functions under validation.
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.Fortran.Character_Set:
+--      ' ', 'a'..'z', 'A'..'Z', '1'..'9', '-', '_', '$', '#', and '*'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.Fortran.  If an implementation provides
+--      package Interfaces.Fortran, this test must compile, execute, and 
+--      report "PASSED".
+--
+--      This test does not apply to an implementation in which the Fortran
+--      character set ranges are not contiguous (e.g., EBCDIC).
+--      
+--
+--       
+-- CHANGE HISTORY:
+--      11 Mar 96   SAIC    Initial release for 2.1.
+--      10 Jun 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Ada.Characters.Latin_1;
+with Ada.Exceptions;
+with Ada.Strings.Bounded;
+with Ada.Strings.Unbounded;
+with Ada.Unchecked_Conversion;
+with Interfaces.Fortran;                                      -- N/A => ERROR
+with Report;
+
+procedure CXB5002 is
+begin
+
+   Report.Test ("CXB5002", "Check that functions To_Fortran and To_Ada " &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      package ACL renames Ada.Characters.Latin_1;
+      package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
+      package Unb renames Ada.Strings.Unbounded;
+
+      use Bnd, Unb;
+      use Interfaces.Fortran;
+      use Ada.Exceptions;
+
+      Null_Fortran_Character  : constant Fortran_Character := "";
+      Fortran_Character_1     : Fortran_Character(1..1)    := " ";
+      Fortran_Character_5     : Fortran_Character(1..5)    := "     ";
+      Fortran_Character_10    : Fortran_Character(1..10)   := "          ";
+      Fortran_Character_20    : Fortran_Character(1..20)   := 
+                                  "                    ";
+      TC_Fortran_Character_1  : Fortran_Character(1..1)    := "A";
+      TC_Fortran_Character_5  : Fortran_Character(1..5)    := "ab*de";
+      TC_Fortran_Character_10 : Fortran_Character(1..10)   := "$1a2b3C4D5";
+      TC_Fortran_Character_20 : Fortran_Character(1..20)   := 
+                                  "1234-ABCD_6789#fghij";
+
+      Bnd_String              : Bnd.Bounded_String   :=
+                                  Bnd.To_Bounded_String("          ");
+      TC_Bnd_String           : Bounded_String       :=
+                                  To_Bounded_String("$1a2b3C4D5");
+
+      Unb_String              : Unb.Unbounded_String :=
+                                  Unb.To_Unbounded_String("     ");
+      TC_Unb_String           : Unbounded_String     :=
+                                  To_Unbounded_String("ab*de");
+
+      String_1                : String(1..1)    := " ";
+      String_5                : String(1..5)    := "     ";
+      String_10               : String(1..10)   := "          ";
+      String_20               : String(1..20)   := "                    ";
+      TC_String_1             : String(1..1)    := "A";
+      TC_String_20            : String(1..20)   := "1234-ABCD_6789#fghij";
+      Null_String             : constant String := "";
+
+      Null_Character          : constant Character := ACL.Nul;
+      Character_A             : constant Character := Character'Val(65);
+      Character_Z             : constant Character := Character'Val(90);
+      TC_Character            : Character          := Character'First;
+
+      Null_Character_Set      : Character_Set      := To_Fortran(ACL.Nul);
+      TC_Character_Set,
+      TC_Low_Character_Set,
+      TC_High_Character_Set   : Character_Set      := Character_Set'First;
+
+
+      -- The following procedure checks the results of function To_Ada.
+
+      procedure Check_Length (Str : in String;
+                              Ftn : in Fortran_Character;
+                              Num : in Natural) is
+      begin
+         if Str'Length /= Ftn'Length or
+            Str'Length /= Num
+         then
+            Report.Failed("Incorrect result from Function To_Ada " &
+                          "with string length " & Integer'Image(Num));
+         end if;
+      end Check_Length;
+
+      -- To facilitate the conversion of Character-Character_Set data, the 
+      -- following functions have been instantiated.  
+
+      function Character_to_Character_Set is
+        new Ada.Unchecked_Conversion(Character, Character_Set);
+
+      function Character_Set_to_Character is
+        new Ada.Unchecked_Conversion(Character_Set, Character);
+
+   begin
+
+      -- Check that the Function To_Fortran with a Character parameter
+      -- will return the corresponding Fortran Character_Set value.
+
+      for TC_Character in ACL.LC_A..ACL.LC_Z loop
+         if To_Fortran(Item => TC_Character) /= 
+            Character_to_Character_Set(TC_Character) 
+         then
+            Report.Failed("Incorrect result from To_Fortran with lower " &
+                          "case alphabetic character input");
+         end if;
+      end loop;
+
+      for TC_Character in Character_A..Character_Z loop
+         if To_Fortran(TC_Character) /= 
+            Character_to_Character_Set(TC_Character) 
+         then
+            Report.Failed("Incorrect result from To_Fortran with upper " &
+                          "case alphabetic character input");
+         end if;
+      end loop;
+
+      if To_Fortran(Null_Character) /= 
+         Character_to_Character_Set(Null_Character)
+      then
+         Report.Failed
+           ("Incorrect result from To_Fortran with null character input");
+      end if;
+
+
+      -- Check that the Function To_Ada with a Character_Set parameter 
+      -- will return the corresponding Ada Character value.
+
+      TC_Low_Character_Set  := Character_to_Character_Set('a');
+      TC_High_Character_Set := Character_to_Character_Set('z');
+      for TC_Character_Set in TC_Low_Character_Set..TC_High_Character_Set loop
+         if To_Ada(Item => TC_Character_Set) /= 
+            Character_Set_to_Character(TC_Character_Set) 
+         then
+            Report.Failed("Incorrect result from To_Ada with lower case " &
+                          "alphabetic Character_Set input");
+         end if;
+      end loop;
+
+      TC_Low_Character_Set  := Character_to_Character_Set('A');
+      TC_High_Character_Set := Character_to_Character_Set('Z');
+      for TC_Character_Set in TC_Low_Character_Set..TC_High_Character_Set loop
+         if To_Ada(TC_Character_Set) /= 
+            Character_Set_to_Character(TC_Character_Set) 
+         then
+            Report.Failed("Incorrect result from To_Ada with upper case " &
+                          "alphabetic Character_Set input");
+         end if;
+      end loop;
+
+      if To_Ada(Character_to_Character_Set(Null_Character)) /=
+         Null_Character
+      then
+         Report.Failed("Incorrect result from To_Ada with a null " &
+                       "Character_Set input");
+      end if;
+
+
+      -- Check that the Function To_Fortran with a String parameter 
+      -- will return the corresponding Fortran_Character value.
+      -- Note: The type Fortran_Character is a character array type that
+      --       corresponds to Ada type String.
+
+      Fortran_Character_1 := To_Fortran(Item => TC_String_1);
+
+      if Fortran_Character_1 /= TC_Fortran_Character_1 then
+         Report.Failed("Incorrect result from procedure To_Fortran - 1");
+      end if;
+
+      Fortran_Character_5 := To_Fortran(To_String(TC_Unb_String));
+
+      if Fortran_Character_5 /= TC_Fortran_Character_5 then
+         Report.Failed("Incorrect result from procedure To_Fortran - 2");
+      end if;
+
+      Fortran_Character_10 := To_Fortran(To_String(TC_Bnd_String));
+
+      if Fortran_Character_10 /= TC_Fortran_Character_10 then
+         Report.Failed("Incorrect result from procedure To_Fortran - 3");
+      end if;
+
+      Fortran_Character_20 := To_Fortran(Item => TC_String_20);
+
+      if Fortran_Character_20 /= TC_Fortran_Character_20 then
+         Report.Failed("Incorrect result from procedure To_Fortran - 4");
+      end if;
+
+      if To_Fortran(Null_String) /= Null_Fortran_Character then
+         Report.Failed("Incorrect result from procedure To_Fortran - 5");
+      end if;
+
+
+      -- Check that the Function To_Ada with a Fortran_Character parameter
+      -- will return the corresponding Ada String value.
+
+      String_1 := To_Ada(TC_Fortran_Character_1);
+
+      if String_1 /= TC_String_1 then
+         Report.Failed("Incorrect value returned from function To_Ada - 1");
+      end if;
+
+      Check_Length(To_Ada(TC_Fortran_Character_1),
+                   TC_Fortran_Character_1,
+                   Num => 1);
+
+
+      Unb_String := Unb.To_Unbounded_String(To_Ada(TC_Fortran_Character_5));
+
+      if Unb_String /= TC_Unb_String then
+         Report.Failed("Incorrect value returned from function To_Ada - 2");
+      end if;
+
+      Check_Length(To_Ada(TC_Fortran_Character_5),
+                   TC_Fortran_Character_5,
+                   Num => 5);
+
+
+      Bnd_String := Bnd.To_Bounded_String 
+                         (To_Ada(TC_Fortran_Character_10));
+
+      if Bnd_String /= TC_Bnd_String then
+         Report.Failed("Incorrect value returned from function To_Ada - 3");
+      end if;
+
+      Check_Length(To_Ada(TC_Fortran_Character_10),
+                   TC_Fortran_Character_10,
+                   Num => 10);
+
+
+      String_20 := To_Ada(TC_Fortran_Character_20);
+
+      if String_20 /= TC_String_20 then
+         Report.Failed("Incorrect value returned from function To_Ada - 4");
+      end if;
+
+      Check_Length(To_Ada(TC_Fortran_Character_20),
+                   TC_Fortran_Character_20,
+                   Num => 20);
+
+      if To_Ada(Null_Character_Set) /= Null_Character then
+         Report.Failed("Incorrect value returned from function To_Ada - 5");
+      end if;
+
+
+      -- Check the two functions when used in combination.
+
+      if To_Ada(Item => To_Fortran("This is a test")) /=
+         "This is a test"                                or
+         To_Ada(To_Fortran("1234567890abcdeFGHIJ"))   /=
+         Report.Ident_Str("1234567890abcdeFGHIJ")
+      then
+         Report.Failed("Incorrect result returned when using the " &
+                       "functions To_Ada and To_Fortran in combination");
+      end if;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed("The following exception was raised in the " &
+                       "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB5002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb5003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb5003.a
new file mode 100644
index 000000000..1c2b1c537
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxb/cxb5003.a
@@ -0,0 +1,295 @@
+-- CXB5003.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 procedure To_Fortran converts the character elements
+--      of the String parameter Item into Character_Set elements of the
+--      Fortran_Character type parameter Target.  Check that the parameter 
+--      Last contains the index of the last element of parameter Target 
+--      that was assigned by To_Fortran.
+--
+--      Check that Constraint_Error is propagated by procedure To_Fortran
+--      when the length of String parameter Item exceeds the length of 
+--      Fortran_Character parameter Target.
+--
+--      Check that the procedure To_Ada converts the Character_Set
+--      elements of the Fortran_Character parameter Item into Character
+--      elements of the String parameter Target.  Check that the parameter
+--      Last contains the index of the last element of parameter Target 
+--      that was assigned by To_Ada.
+--
+--      Check that Constraint_Error is propagated by procedure To_Ada when
+--      the length of Fortran_Character parameter Item exceeds the length of 
+--      String parameter Target.
+--
+-- TEST DESCRIPTION:
+--      This test checks that the procedures To_Fortran and To_Ada produce
+--      the correct results, based on a variety of parameter input values.
+--      
+--      In the first series of subtests, the Out parameter results of 
+--      procedure To_Fortran are compared against expected results,
+--      which includes (in the parameter Last) the index in Target of the 
+--      last element assigned.  The situation where procedure To_Fortran
+--      raises Constraint_Error (when Item'Length exceeds Target'Length) 
+--      is also verified.
+--
+--      In the second series of subtests, the Out parameter results of 
+--      procedure To_Ada are verified, in a similar manner as is done for
+--      procedure To_Fortran.  The case of procedure To_Ada raising 
+--      Constraint_Error is also verified.
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.Fortran.Character_Set:
+--      ' ', 'a'..'j', 'A'..'D', '1'..'9', '-', '_', '$', '#', and '*'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.Fortran.  If an implementation provides
+--      package Interfaces.Fortran, this test must compile, execute, and 
+--      report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      14 Mar 96   SAIC    Initial release for 2.1.
+--      10 Jun 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Ada.Exceptions;
+with Ada.Strings.Bounded;
+with Ada.Strings.Unbounded;
+with Interfaces.Fortran;                                      -- N/A => ERROR
+with Report;
+
+procedure CXB5003 is
+begin
+
+   Report.Test ("CXB5003", "Check that procedures To_Fortran and To_Ada " &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
+      package Unb renames Ada.Strings.Unbounded;
+
+      use Bnd, Unb;
+      use Interfaces.Fortran;
+      use Ada.Exceptions;
+
+      Fortran_Character_1     : Fortran_Character(1..1)  := " ";
+      Fortran_Character_5     : Fortran_Character(1..5)  := "     ";
+      Fortran_Character_10    : Fortran_Character(1..10) := "          ";
+      Fortran_Character_20    : Fortran_Character(1..20) := 
+                                  "                    ";
+      TC_Fortran_Character_1  : Fortran_Character(1..1)  := "A";
+      TC_Fortran_Character_5  : Fortran_Character(1..5)  := "ab*de";
+      TC_Fortran_Character_10 : Fortran_Character(1..10) := "$1a2b3C4D5";
+      TC_Fortran_Character_20 : Fortran_Character(1..20) := 
+                                  "1234-ABCD_6789#fghij";
+
+      Bnd_String              : Bnd.Bounded_String   :=
+                                  Bnd.To_Bounded_String("          ");
+      TC_Bnd_String           : Bounded_String       :=
+                                  To_Bounded_String("$1a2b3C4D5");
+
+      Unb_String              : Unb.Unbounded_String :=
+                                  Unb.To_Unbounded_String("     ");
+      TC_Unb_String           : Unbounded_String     :=
+                                  To_Unbounded_String("ab*de");
+
+      String_1                : String(1..1)   := " ";
+      String_5                : String(1..5)   := "     ";
+      String_10               : String(1..10)  := "          ";
+      String_20               : String(1..20)  := "                    ";
+      TC_String_1             : String(1..1)   := "A";
+      TC_String_20            : String(1..20)  := "1234-ABCD_6789#fghij";
+
+      TC_Fortran_Character    : constant Fortran_Character := ""; 
+      TC_String               : constant String            := ""; 
+      TC_Natural              : Natural                    := 0;
+
+
+   begin
+
+      -- Check that the procedure To_Fortran converts the character elements
+      -- of the String parameter Item into Character_Set elements of the 
+      -- Fortran_Character type parameter Target.  
+      -- Check that the parameter Last contains the index of the last element
+      -- of parameter Target that was assigned by To_Fortran.
+
+      To_Fortran(Item   => TC_String_1,
+                 Target => Fortran_Character_1,
+                 Last   => TC_Natural);
+
+      if Fortran_Character_1 /= TC_Fortran_Character_1        or
+         TC_Natural          /= TC_Fortran_Character_1'Length 
+      then
+         Report.Failed("Incorrect result from procedure To_Fortran - 1");
+      end if;
+
+      To_Fortran(To_String(TC_Unb_String),
+                 Target => Fortran_Character_5,
+                 Last   => TC_Natural);
+
+      if Fortran_Character_5 /= TC_Fortran_Character_5        or
+         TC_Natural          /= TC_Fortran_Character_5'Length 
+      then
+         Report.Failed("Incorrect result from procedure To_Fortran - 2");
+      end if;
+
+      To_Fortran(To_String(TC_Bnd_String),
+                 Fortran_Character_10,
+                 Last   => TC_Natural);
+
+      if Fortran_Character_10 /= TC_Fortran_Character_10        or
+         TC_Natural           /= TC_Fortran_Character_10'Length
+      then
+         Report.Failed("Incorrect result from procedure To_Fortran - 3");
+      end if;
+
+      To_Fortran(TC_String_20, Fortran_Character_20, TC_Natural);
+
+      if Fortran_Character_20 /= TC_Fortran_Character_20        or
+         TC_Natural           /= TC_Fortran_Character_20'Length 
+      then
+         Report.Failed("Incorrect result from procedure To_Fortran - 4");
+      end if;
+
+      To_Fortran(Item   => TC_String,     -- null string
+                 Target => Fortran_Character_1,
+                 Last   => TC_Natural);
+
+      if TC_Natural /= 0 then
+         Report.Failed("Incorrect result from procedure To_Fortran, value "  &
+                       "returned in parameter Last should be zero, since " &
+                       "parameter Item is null array");
+      end if;
+
+
+      -- Check that Constraint_Error is propagated by procedure To_Fortran
+      -- when the length of String parameter Item exceeds the length of 
+      -- Fortran_Character parameter Target.
+
+      begin
+
+         To_Fortran(Item   => TC_String_20,
+                    Target => Fortran_Character_10,
+                    Last   => TC_Natural);
+         Report.Failed("Constraint_Error not raised by procedure " &
+                       "To_Fortran when Item'Length exceeds Target'Length");
+      exception
+         when Constraint_Error   => null;  -- OK, expected exception.
+         when The_Error : others =>
+            Report.Failed("The following exception was raised by procedure " &
+                          "To_Fortran when Item'Length exceeds "             &
+                          "Target'Length: " & Exception_Name(The_Error));
+      end;
+
+
+      -- Check that the procedure To_Ada converts the Character_Set 
+      -- elements of the Fortran_Character parameter Item into Character
+      -- elements of the String parameter Target.  
+      -- Check that the parameter Last contains the index of the last 
+      -- element of parameter Target that was assigned by To_Ada.
+
+      To_Ada(Item   => TC_Fortran_Character_1,
+             Target => String_1,
+             Last   => TC_Natural);
+
+      if String_1   /= TC_String_1        or
+         TC_Natural /= TC_String_1'Length 
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 1");
+      end if;
+
+      To_Ada(TC_Fortran_Character_5,
+             Target => String_5,
+             Last   => TC_Natural);
+
+      if String_5   /= To_String(TC_Unb_String) or
+         TC_Natural /= Length(TC_Unb_String)    
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 2");
+      end if;
+
+      To_Ada(TC_Fortran_Character_10,
+             String_10,
+             Last   => TC_Natural);
+
+      if String_10   /= To_String(TC_Bnd_String) or
+         TC_Natural  /= Length(TC_Bnd_String)   
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 3");
+      end if;
+
+      To_Ada(TC_Fortran_Character_20, String_20, TC_Natural);
+
+      if String_20   /= TC_String_20        or
+         TC_Natural  /= TC_String_20'Length 
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 4");
+      end if;
+
+      To_Ada(Item   => TC_Fortran_Character,  -- null array.
+             Target => String_20,
+             Last   => TC_Natural);
+
+      if TC_Natural /= 0 then
+         Report.Failed("Incorrect result from procedure To_Ada, value "    &
+                       "returned in parameter Last should be zero, since " &
+                       "parameter Item is null array");
+      end if;
+
+
+      -- Check that Constraint_Error is propagated by procedure To_Ada 
+      -- when the length of Fortran_Character parameter Item exceeds the 
+      -- length of String parameter Target.
+
+      begin
+
+         To_Ada(Item   => TC_Fortran_Character_10,
+                Target => String_5,
+                Last   => TC_Natural);
+         Report.Failed("Constraint_Error not raised by procedure To_Ada " &
+                       "when Item'Length exceeds Target'Length");
+      exception
+         when Constraint_Error   => null;  -- OK, expected exception.
+         when The_Error : others =>
+            Report.Failed("Incorrect exception raised by procedure To_Ada " &
+                          "when Item'Length exceeds Target'Length");
+      end;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed("The following exception was raised in the " &
+                       "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB5003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a
new file mode 100644
index 000000000..be7e50692
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf1001.a
@@ -0,0 +1,261 @@
+-- CXF1001.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 values of 2 and 10 are allowable values for Machine_Radix 
+--      of a decimal first subtype.
+--      Check that the value of Decimal.Max_Decimal_Digits is at least 18; 
+--      the value of Decimal.Max_Scale is at least 18; the value of 
+--      Decimal.Min_Scale is at most 0.
+--
+-- TEST DESCRIPTION:
+--      This test examines the Machine_Radix attribute definition clause
+--      and its effect on Decimal fixed point types, as well as several
+--      constants from the package Ada.Decimal.
+--      The first subtest checks that the Machine_Radix attribute will 
+--      return the value set for Machine_Radix by an attribute definition
+--      clause.  The second and third subtests examine differences between
+--      the binary and decimal scaling of a type, based on the radix 
+--      representation.  The final subtest examines the values
+--      assigned to constants Min_Scale, Max_Scale, and Max_Decimal_Digits,
+--      found in the package Ada.Decimal.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      29 Dec 94   SAIC    Restructured Radix 10 and Radix 2 test blocks.
+--
+--!
+
+with Report;
+with Ada.Decimal;
+
+procedure CXF1001 is
+begin
+
+   Report.Test ("CXF1001", "Check that values of 2 and 10 are allowable " &
+                           "values for Machine_Radix of a decimal first " &
+                           "subtype.  Check that the value of "           &
+                           "Decimal.Max_Decimal_Digits is at least 18; "  &
+                           "the value of Decimal.Max_Scale is at least "  &
+                           "18; the value of Decimal.Min_Scale is at "    &
+                           "most 0");
+
+   Attribute_Check_Block:
+   declare
+
+      Del          : constant := 1.0/10**2;
+      Const_Digits : constant :=  3;
+      Two          : constant :=  2;
+      Ten          : constant := 10;
+
+      type Radix_2_Type_1  is delta 0.01  digits 7;
+      type Radix_2_Type_2  is delta Ada.Decimal.Min_Delta digits 10;        
+      type Radix_2_Type_3  is
+        delta 0.000_1 digits Ada.Decimal.Max_Decimal_Digits;
+
+      type Radix_10_Type_1 is delta 10.0**(-Ada.Decimal.Max_Scale) digits 8;
+      type Radix_10_Type_2 is delta 10.0**(-Ada.Decimal.Min_Scale) digits 6;
+      type Radix_10_Type_3 is delta Ada.Decimal.Max_Delta digits 15;        
+        
+
+      -- Use an attribute definition clause to set the Machine_Radix for a
+      -- decimal first subtype to either 2 or 10.
+      for Radix_2_Type_1'Machine_Radix  use 2;                      
+      for Radix_2_Type_2'Machine_Radix  use Two;                    
+      for Radix_2_Type_3'Machine_Radix  use 10-8;                   
+
+      for Radix_10_Type_1'Machine_Radix use 2*15/Const_Digits;     
+      for Radix_10_Type_2'Machine_Radix use Ten;                             
+      for Radix_10_Type_3'Machine_Radix use Radix_10_Type_2'Machine_Radix;
+
+
+   begin
+
+      -- Check that the attribute 'Machine_Radix returns the value assigned
+      -- by the attribute definition clause.
+
+      if Radix_2_Type_1'Machine_Radix /= 2  or else
+         Radix_2_Type_2'Machine_Radix /= 2  or else
+         Radix_2_Type_3'Machine_Radix /= 2  
+      then
+         Report.Failed("Incorrect radix value returned, 2 expected");
+      end if;
+
+      if Radix_10_Type_1'Machine_Radix /= 10  or else
+         Radix_10_Type_2'Machine_Radix /= 10  or else
+         Radix_10_Type_3'Machine_Radix /= 10  
+      then
+         Report.Failed("Incorrect radix value returned, 10 expected");
+      end if;
+
+   exception
+      when others => Report.Failed ("Exception raised in Attr_Check_Block");
+   end Attribute_Check_Block;
+
+
+
+   Radix_Block:
+   -- Premises:
+   --   1) Choose several numbers, from types using either decimal scaling or
+   --      binary scaling.
+   --   1) Repetitively add these numbers to themselves.
+   --   3) Validate that the result is the expected result, regardless of the
+   --      scaling used in the definition of the type.
+   declare
+
+      Number_Of_Values : constant :=    3;
+      Loop_Count       : constant := 1000;
+
+      type Radix_2_Type  is delta 0.0001 digits 10;
+      type Radix_10_Type is delta 0.0001 digits 10;
+                                      
+      for Radix_2_Type'Machine_Radix  use  2;
+      for Radix_10_Type'Machine_Radix use 10;
+
+      type Result_Record_Type is record
+         Rad_2  : Radix_2_Type;
+         Rad_10 : Radix_10_Type;
+      end record;
+
+      type Result_Array_Type is array (1..Number_Of_Values) 
+        of Result_Record_Type;
+
+      Result_Array : Result_Array_Type := ((50.00,  50.00), 
+                                           (613.00, 613.00), 
+                                           (72.70,  72.70));
+
+      function Repetitive_Radix_2_Add (Value : in Radix_2_Type) 
+        return Radix_2_Type is
+         Result : Radix_2_Type := 0.0;
+      begin
+        for i in 1..Loop_Count loop
+           Result := Result + Value;
+        end loop;
+        return Result;
+      end Repetitive_Radix_2_Add;
+
+      function Repetitive_Radix_10_Add (Value : in Radix_10_Type) 
+        return Radix_10_Type is
+         Result : Radix_10_Type := 0.0;
+      begin
+        for i in 1..Loop_Count loop
+           Result := Result + Value;
+        end loop;
+        return Result;
+      end Repetitive_Radix_10_Add;
+
+   begin
+
+      -- Radix 2 Cases, three different values.
+      -- Compare the result of the repetitive addition with the expected
+      -- Radix 2 result, as well as with the Radix 10 value after type 
+      -- conversion.
+
+      if Repetitive_Radix_2_Add(0.05) /= Result_Array(1).Rad_2  or
+         Repetitive_Radix_2_Add(0.05) /= Radix_2_Type(Result_Array(1).Rad_10)
+      then
+         Report.Failed("Incorrect Radix 2 Result, Case 1");
+      end if;
+
+      if Repetitive_Radix_2_Add(0.613) /= 
+         Result_Array(2).Rad_2            or
+         Repetitive_Radix_2_Add(0.613) /= 
+         Radix_2_Type(Result_Array(2).Rad_10)
+      then
+         Report.Failed("Incorrect Radix 2 Result, Case 2");
+      end if;
+
+      if Repetitive_Radix_2_Add(0.0727)  /= 
+         Result_Array(3).Rad_2              or
+         Repetitive_Radix_2_Add(0.0727)  /= 
+         Radix_2_Type(Result_Array(3).Rad_10)
+      then
+         Report.Failed("Incorrect Radix 2 Result, Case 3");
+      end if;
+
+      -- Radix 10 Cases, three different values.
+      -- Compare the result of the repetitive addition with the expected
+      -- Radix 10 result, as well as with the Radix 2 value after type 
+      -- conversion.
+
+      if Repetitive_Radix_10_Add(0.05) /= Result_Array(1).Rad_10  or
+         Repetitive_Radix_10_Add(0.05) /= Radix_10_Type(Result_Array(1).Rad_2)
+      then
+         Report.Failed("Incorrect Radix 10 Result, Case 1");
+      end if;
+
+      if Repetitive_Radix_10_Add(0.613) /= 
+         Result_Array(2).Rad_10            or
+         Repetitive_Radix_10_Add(0.613) /= 
+         Radix_10_Type(Result_Array(2).Rad_2)
+      then
+         Report.Failed("Incorrect Radix 10 Result, Case 2");
+      end if;
+
+      if Repetitive_Radix_10_Add(0.0727) /= 
+         Result_Array(3).Rad_10             or
+         Repetitive_Radix_10_Add(0.0727) /= 
+         Radix_10_Type(Result_Array(3).Rad_2)
+      then
+         Report.Failed("Incorrect Radix 10 Result, Case 3");
+      end if;
+
+   exception
+      when others => Report.Failed ("Exception raised in Radix_Block");
+   end Radix_Block;
+
+
+
+   Size_Block:
+   -- Check the implementation max/min values of constants declared in
+   -- package Ada.Decimal.
+   declare
+      Minimum_Required_Size : constant := 18;
+      Maximum_Allowed_Size  : constant :=  0;
+   begin
+
+      -- Check that the Max_Decimal_Digits value is at least 18.
+      if not (Ada.Decimal.Max_Decimal_Digits >= Minimum_Required_Size) then
+         Report.Failed("Insufficient size provided for Max_Decimal_Digits");
+      end if;
+
+      -- Check that the Max_Scale value is at least 18.
+      if not (Ada.Decimal.Max_Scale >= Minimum_Required_Size) then
+         Report.Failed("Insufficient size provided for Max_Scale");
+      end if;
+
+      -- Check that the Min_Scale value is at most 0.
+      if not (Ada.Decimal.Min_Scale <= Maximum_Allowed_Size) then
+         Report.Failed("Too large a value provided for Min_Scale");
+      end if;
+
+   exception
+      when others => Report.Failed ("Exception raised in Size_Block");
+   end Size_Block;
+
+   Report.Result;
+
+end CXF1001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a
new file mode 100644
index 000000000..96d0a0a17
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2001.a
@@ -0,0 +1,755 @@
+-- CXF2001.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 Divide procedure provides the following results:
+--        Quotient = Dividend divided by Divisor  and
+--        Remainder = Dividend - (Divisor * Quotient)
+--      Check that the Remainder is calculated exactly.
+--
+-- TEST DESCRIPTION:
+--      This test is designed to test the generic procedure Divide found in
+--      package Ada.Decimal.  
+--
+--      The table below attempts to portray the design approach used in this 
+--      test.  There are three "dimensions" of concern:
+--        1) the delta value of the Quotient and Remainder types, shown as
+--           column headers,
+--        2) specific choices for the Dividend and Divisor numerical values
+--           (i.e., whether they yielded a repeating/non-terminating result,
+--            or a terminating result ["exact"]), displayed on the left side 
+--            of the tables, and
+--        3) the delta for the Dividend and Divisor.
+--      
+--      Each row in the tables indicates a specific test case, showing the
+--      specific quotient and remainder (under the appropriate Delta column)
+--      for each combination of dividend and divisor values.  Test cases
+--      follow the top-to-bottom sequence shown in the tables.
+--      
+--      Most of the test case sets (same dividend/divisor combinations -
+--      indicated by dashed horizontal lines in the tables) vary the 
+--      delta of the quotient and remainder types between test cases. This 
+--      allows for an examination of how different deltas for a quotient
+--      and/or remainder type can influence the results of a division with
+--      identical dividend and divisor.
+--      
+--      Note: Test cases are performed for both Radix 10 and Radix 2 types.
+--      
+--      
+--  Divid  Divis    Delta     Delta       Delta       Delta       Delta
+-- (Delta)(Delta)|  .1   |    .01    |   .001    |   .0001   |  .00001   |Test
+--               |---|---|-----|-----|-----|-----|-----|-----|-----|-----|Case
+--    quotient   | Q | R |  Q  |  R  |  Q  |  R  |  Q  |  R  |  Q  |  R  | No.
+-- ---------------------------------------------------------------------------
+--  .05     .3   |.1             .02                                       1,21
+-- (.01)   (.1)  |.1   0                                                   2,22
+--               |         .16               .002                          3,23
+--   0.166666..  |         .16   .00                                       4,24
+--               |                     .166             .0002              5,25
+-- ---------------------------------------------------------------------------
+--  .15     20   |         .00                          .1500              6,26
+-- (.01)    (1)  |         .00               .150                          7,27
+--               |         .00   .15                                       8,28
+--   0.0075      |               .01   .007                                9,29
+--               |                     .007  .010                         10,30
+--               |                                .0075 .0000             11,31
+-- ---------------------------------------------------------------------------
+--  .03125   .5  |                                .0625 .0000             12,32
+-- (.00001) (.1) |                     .062                        .00025 13,33
+--               |                     .062             .0002             14,34
+--   0.0625      |                     .062  .000                         15,35
+--               |               .00   .062                               16,36
+--               |         .06                                     .00125 17,37
+--               |         .06                          .0012             18,38
+--               |         .06               .001                         19,39
+--               |         .06   .00                                      20,40
+-- ---------------------------------------------------------------------------
+-- Divide by Zero| Raise Constraint_Error                                 41
+-- ---------------------------------------------------------------------------
+-- 
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      29 Dec 94   SAIC    Modified Radix 2 cases to match Radix 10 cases.
+--      03 Oct 95   RBKD    Modified to fix incorrect remainder results
+--      15 Nov 95   SAIC    Incorporated reviewer fixes for ACVC 2.0.1.
+--
+--!
+
+with Report;
+with Ada.Decimal;
+
+procedure CXF2001 is
+
+   TC_Verbose : Boolean := False;
+
+begin
+
+   Report.Test ("CXF2001", "Check that the Divide procedure provides "  &
+                           "correct results. Check that the Remainder " &
+                           "is calculated exactly");
+   Radix_10_Block:
+   declare
+
+
+      -- Declare all types and variables used in the various blocks below
+      -- for all Radix 10 evaluations.
+
+      type DT_1       is delta 1.0     digits 5; 
+      type DT_0_1     is delta 0.1     digits 10; 
+      type DT_0_01    is delta 0.01    digits 10; 
+      type DT_0_001   is delta 0.001   digits 10; 
+      type DT_0_0001  is delta 0.0001  digits 10; 
+      type DT_0_00001 is delta 0.00001 digits 10; 
+
+      for DT_1'Machine_Radix       use 10;
+      for DT_0_1'Machine_Radix     use 10;
+      for DT_0_01'Machine_Radix    use 10;
+      for DT_0_001'Machine_Radix   use 10;
+      for DT_0_0001'Machine_Radix  use 10;
+      for DT_0_00001'Machine_Radix use 10;
+
+      Dd_1,       Dv_1,       Quot_1,       Rem_1       : DT_1       := 0.0;
+      Dd_0_1,     Dv_0_1,     Quot_0_1,     Rem_0_1     : DT_0_1     := 0.0;
+      Dd_0_01,    Dv_0_01,    Quot_0_01,    Rem_0_01    : DT_0_01    := 0.0;
+      Dd_0_001,   Dv_0_001,   Quot_0_001,   Rem_0_001   : DT_0_001   := 0.0;
+      Dd_0_0001,  Dv_0_0001,  Quot_0_0001,  Rem_0_0001  : DT_0_0001  := 0.0;
+      Dd_0_00001, Dv_0_00001, Quot_0_00001, Rem_0_00001 : DT_0_00001 := 0.0;
+
+   begin 
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(Dividend_Type  => DT_0_01,
+                                   Divisor_Type   => DT_0_1,
+                                   Quotient_Type  => DT_0_1,
+                                   Remainder_Type => DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 1"); end if;
+         Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
+         Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_01);
+         if Quot_0_1 /= DT_0_1(0.1)  or  Rem_0_01 /= DT_0_01(0.02) then
+            Report.Failed("Incorrect values returned, Case 1");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_1, DT_0_1);
+      begin
+         if TC_Verbose then Report.Comment("Case 2"); end if;
+         Dd_0_01 := DT_0_01(0.05);   Dv_0_1 := DT_0_1(0.3);
+         Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_1);
+         if Quot_0_1 /= DT_0_1(0.1) or  Rem_0_1 /= DT_0_1(0.0) then
+            Report.Failed("Incorrect values returned, Case 2");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_001);
+      begin
+         if TC_Verbose then Report.Comment("Case 3"); end if;
+         Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
+         Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_001);
+         if Quot_0_01 /= DT_0_01(0.16) or  Rem_0_001 /= DT_0_001(0.002) then
+            Report.Failed("Incorrect values returned, Case 3");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 4"); end if;
+         Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
+         Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_01);
+         if Quot_0_01 /= DT_0_01(0.16) or  Rem_0_01 /= DT_0_01(0.0) then
+            Report.Failed("Incorrect values returned, Case 4");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_001, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 5"); end if;
+         Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
+         Div(Dd_0_01, Dv_0_1, Quot_0_001, Rem_0_0001);
+         if Quot_0_001 /= DT_0_001(0.166)   or 
+            Rem_0_0001 /= DT_0_0001(0.0002) 
+         then
+            Report.Failed("Incorrect values returned, Case 5");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 6"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_0001);
+         if Quot_0_01 /= DT_0_01(0.0) or Rem_0_0001 /= DT_0_0001(0.1500) then
+            Report.Failed("Incorrect values returned, Case 6");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_001);
+      begin
+         if TC_Verbose then Report.Comment("Case 7"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_001);
+         if Quot_0_01 /= DT_0_01(0.0) or Rem_0_001 /= DT_0_001(0.150) then
+            Report.Failed("Incorrect values returned, Case 7");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 8"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_01);
+         if Quot_0_01 /= DT_0_01(0.0) or Rem_0_01 /= DT_0_01(0.15) then
+            Report.Failed("Incorrect values returned, Case 8");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_001);
+      begin
+         if TC_Verbose then Report.Comment("Case 9"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_001);
+         if Quot_0_001 /= DT_0_001(0.007) or  Rem_0_001 /= DT_0_001(0.01) then
+            Report.Failed("Incorrect values returned, Case 9");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 10"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_01);
+         if Quot_0_001 /= DT_0_001(0.007) or  Rem_0_01 /= DT_0_01(0.01) then
+            Report.Failed("Incorrect values returned, Case 10");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_0001, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 11"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_0001, Rem_0_0001);
+         if Quot_0_0001 /= DT_0_0001(0.0075) or 
+            Rem_0_0001  /= DT_0_0001(0.0) 
+         then
+            Report.Failed("Incorrect values returned, Case 11");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_0001, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 12"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_0001, Rem_0_0001);
+         if Quot_0_0001 /= DT_0_0001(0.0625) or 
+            Rem_0_0001  /= DT_0_0001(0.0) 
+         then
+            Report.Failed("Incorrect values returned, Case 12");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_00001);
+      begin
+         if TC_Verbose then Report.Comment("Case 13"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_00001);
+         if Quot_0_001 /= DT_0_001(0.062) or 
+            Rem_0_00001  /= DT_0_00001(0.00025)
+         then
+            Report.Failed("Incorrect values returned, Case 13");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 14"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_0001);
+         if Quot_0_001 /= DT_0_001(0.062) or 
+            Rem_0_0001  /= DT_0_0001(0.0002)
+         then
+            Report.Failed("Incorrect values returned, Case 14");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_001);
+      begin
+         if TC_Verbose then Report.Comment("Case 15"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_001);
+         if Quot_0_001 /= DT_0_001(0.062) or Rem_0_001 /= DT_0_001(0.000)
+         then
+            Report.Failed("Incorrect values returned, Case 15");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 16"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_01);
+         if Quot_0_001 /= DT_0_001(0.062) or Rem_0_01 /= DT_0_01(0.00) then
+            Report.Failed("Incorrect values returned, Case 16");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_00001);
+      begin
+         if TC_Verbose then Report.Comment("Case 17"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_00001);
+         if Quot_0_01 /= DT_0_01(0.06) or Rem_0_00001 /= DT_0_00001(0.00125) 
+         then
+            Report.Failed("Incorrect values returned, Case 17");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 18"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_0001);
+         if Quot_0_01 /= DT_0_01(0.06) or Rem_0_0001 /= DT_0_0001(0.0012) 
+         then
+            Report.Failed("Incorrect values returned, Case 18");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_001);
+      begin
+         if TC_Verbose then Report.Comment("Case 19"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_001);
+         if Quot_0_01 /= DT_0_01(0.06) or Rem_0_001 /= DT_0_001(0.001) then
+            Report.Failed("Incorrect values returned, Case 19");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 20"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_01);
+         if Quot_0_01 /= DT_0_01(0.06) or Rem_0_01 /= DT_0_01(0.0) then
+            Report.Failed("Incorrect values returned, Case 20");
+         end if;
+      end;
+
+
+   exception
+      when others => Report.Failed("Exception raised in Radix_10_Block");
+   end Radix_10_Block;
+
+
+
+   Radix_2_Block:
+   declare
+
+      -- Declare all types and variables used in the various blocks below
+      -- for all Radix 2 evaluations.
+
+      type DT_1       is delta 1.0     digits 5; 
+      type DT_0_1     is delta 0.1     digits 10; 
+      type DT_0_01    is delta 0.01    digits 10; 
+      type DT_0_001   is delta 0.001   digits 10; 
+      type DT_0_0001  is delta 0.0001  digits 10; 
+      type DT_0_00001 is delta 0.00001 digits 10; 
+
+      for DT_1'Machine_Radix       use 2;
+      for DT_0_1'Machine_Radix     use 2;
+      for DT_0_01'Machine_Radix    use 2;
+      for DT_0_001'Machine_Radix   use 2;
+      for DT_0_0001'Machine_Radix  use 2;
+      for DT_0_00001'Machine_Radix use 2;
+
+      Dd_1,       Dv_1,       Quot_1,       Rem_1       : DT_1       := 0.0;
+      Dd_0_1,     Dv_0_1,     Quot_0_1,     Rem_0_1     : DT_0_1     := 0.0;
+      Dd_0_01,    Dv_0_01,    Quot_0_01,    Rem_0_01    : DT_0_01    := 0.0;
+      Dd_0_001,   Dv_0_001,   Quot_0_001,   Rem_0_001   : DT_0_001   := 0.0;
+      Dd_0_0001,  Dv_0_0001,  Quot_0_0001,  Rem_0_0001  : DT_0_0001  := 0.0;
+      Dd_0_00001, Dv_0_00001, Quot_0_00001, Rem_0_00001 : DT_0_00001 := 0.0;
+
+   begin 
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(Dividend_Type  => DT_0_01,
+                                   Divisor_Type   => DT_0_1,
+                                   Quotient_Type  => DT_0_1,
+                                   Remainder_Type => DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 21"); end if;
+         Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
+         Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_01);
+         if Quot_0_1 /= DT_0_1(0.1)  or  Rem_0_01 /= DT_0_01(0.02) then
+            Report.Failed("Incorrect values returned, Case 21");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_1, DT_0_1);
+      begin
+         if TC_Verbose then Report.Comment("Case 22"); end if;
+         Dd_0_01 := DT_0_01(0.05);   Dv_0_1 := DT_0_1(0.3);
+         Div(Dd_0_01, Dv_0_1, Quot_0_1, Rem_0_1);
+         if Quot_0_1 /= DT_0_1(0.1) or  Rem_0_1 /= DT_0_1(0.0) then
+            Report.Failed("Incorrect values returned, Case 22");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_001);
+      begin
+         if TC_Verbose then Report.Comment("Case 23"); end if;
+         Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
+         Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_001);
+         if Quot_0_01 /= DT_0_01(0.16) or  Rem_0_001 /= DT_0_001(0.002) then
+            Report.Failed("Incorrect values returned, Case 23");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_01, DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 24"); end if;
+         Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
+         Div(Dd_0_01, Dv_0_1, Quot_0_01, Rem_0_01);
+         if Quot_0_01 /= DT_0_01(0.16) or  Rem_0_01 /= DT_0_01(0.0) then
+            Report.Failed("Incorrect values returned, Case 24");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_0_1, DT_0_001, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 25"); end if;
+         Dd_0_01 := DT_0_01(0.05);  Dv_0_1 := DT_0_1(0.3);
+         Div(Dd_0_01, Dv_0_1, Quot_0_001, Rem_0_0001);
+         if Quot_0_001 /= DT_0_001(0.166)   or 
+            Rem_0_0001 /= DT_0_0001(0.0002) 
+         then
+            Report.Failed("Incorrect values returned, Case 25");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 26"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_0001);
+         if Quot_0_01 /= DT_0_01(0.0) or Rem_0_0001 /= DT_0_0001(0.1500) then
+            Report.Failed("Incorrect values returned, Case 26");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_001);
+      begin
+         if TC_Verbose then Report.Comment("Case 27"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_001);
+         if Quot_0_01 /= DT_0_01(0.0) or Rem_0_001 /= DT_0_001(0.150) then
+            Report.Failed("Incorrect values returned, Case 27");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_01, DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 28"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_01, Rem_0_01);
+         if Quot_0_01 /= DT_0_01(0.0) or Rem_0_01 /= DT_0_01(0.15) then
+            Report.Failed("Incorrect values returned, Case 28");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_001);
+      begin
+         if TC_Verbose then Report.Comment("Case 29"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_001);
+         if Quot_0_001 /= DT_0_001(0.007) or  Rem_0_001 /= DT_0_001(0.01) then
+            Report.Failed("Incorrect values returned, Case 29");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_001, DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 30"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_001, Rem_0_01);
+         if Quot_0_001 /= DT_0_001(0.007) or  Rem_0_01 /= DT_0_01(0.01) then
+            Report.Failed("Incorrect values returned, Case 30");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_01, DT_1, DT_0_0001, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 31"); end if;
+         Dd_0_01 := DT_0_01(0.15);  Dv_1 := DT_1(20);
+         Div(Dd_0_01, Dv_1, Quot_0_0001, Rem_0_0001);
+         if Quot_0_0001 /= DT_0_0001(0.0075) or 
+            Rem_0_0001  /= DT_0_0001(0.0) 
+         then
+            Report.Failed("Incorrect values returned, Case 31");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_0001, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 32"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_0001, Rem_0_0001);
+         if Quot_0_0001 /= DT_0_0001(0.0625) or 
+            Rem_0_0001  /= DT_0_0001(0.0) 
+         then
+            Report.Failed("Incorrect values returned, Case 32");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_00001);
+      begin
+         if TC_Verbose then Report.Comment("Case 33"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_00001);
+         if Quot_0_001 /= DT_0_001(0.062) or 
+            Rem_0_00001  /= DT_0_00001(0.00025)
+         then
+            Report.Failed("Incorrect values returned, Case 33");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 34"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_0001);
+         if Quot_0_001 /= DT_0_001(0.062) or 
+            Rem_0_0001  /= DT_0_0001(0.0002)
+         then
+            Report.Failed("Incorrect values returned, Case 34");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_001);
+      begin
+         if TC_Verbose then Report.Comment("Case 35"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_001);
+         if Quot_0_001 /= DT_0_001(0.062) or Rem_0_001 /= DT_0_001(0.000)
+         then
+            Report.Failed("Incorrect values returned, Case 35");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_001, DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 36"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_001, Rem_0_01);
+         if Quot_0_001 /= DT_0_001(0.062) or Rem_0_01 /= DT_0_01(0.00) then
+            Report.Failed("Incorrect values returned, Case 36");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_00001);
+      begin
+         if TC_Verbose then Report.Comment("Case 37"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_00001);
+         if Quot_0_01 /= DT_0_01(0.06) or Rem_0_00001 /= DT_0_00001(0.00125) 
+         then
+            Report.Failed("Incorrect values returned, Case 37");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 38"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_0001);
+         if Quot_0_01 /= DT_0_01(0.06) or Rem_0_0001 /= DT_0_0001(0.0012) 
+         then
+            Report.Failed("Incorrect values returned, Case 38");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_001);
+      begin
+         if TC_Verbose then Report.Comment("Case 39"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_001);
+         if Quot_0_01 /= DT_0_01(0.06) or Rem_0_001 /= DT_0_001(0.001) then
+            Report.Failed("Incorrect values returned, Case 39");
+         end if;
+      end;
+
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_00001, DT_0_1, DT_0_01, DT_0_01);
+      begin
+         if TC_Verbose then Report.Comment("Case 40"); end if;
+         Dd_0_00001 := DT_0_00001(0.03125);  Dv_0_1 := DT_0_1(0.5);
+         Div(Dd_0_00001, Dv_0_1, Quot_0_01, Rem_0_01);
+         if Quot_0_01 /= DT_0_01(0.06) or Rem_0_01 /= DT_0_01(0.0) then
+            Report.Failed("Incorrect values returned, Case 40");
+         end if;
+      end;
+
+      declare
+         procedure Div is 
+            new Ada.Decimal.Divide(DT_0_0001, DT_1, DT_0_0001, DT_0_0001);
+      begin
+         if TC_Verbose then Report.Comment("Case 41"); end if;
+         Dd_0_0001 := (DT_0_0001(6062.0) / DT_0_0001(16384.0));  
+         Dv_1 := DT_1(0.0);
+         Div(Dd_0_0001, Dv_1, Quot_0_0001, Rem_0_0001);
+         Report.Failed("Divide by Zero didn't raise Constraint_Error, " &
+                       "Case 41");
+      exception
+         when Constraint_Error =>  null;  -- OK, expected exception.
+         when others => 
+            Report.Failed("Unexpected exception raised by Divide by Zero," &
+                          "Case 41");
+      end;
+
+   exception
+      when others => Report.Failed("Exception raised in Radix_10_Block");
+   end Radix_2_Block;
+
+
+   Report.Result;
+
+end CXF2001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a
new file mode 100644
index 000000000..984daa97b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2002.a
@@ -0,0 +1,352 @@
+-- CXF2002.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 multiplying operators for a decimal fixed point type
+--      return values that are integral multiples of the small of the type.
+--      Check the case where the operand and result types are the same.
+--
+--      Check that if the mathematical result is between multiples of the
+--      small of the result type, the result is truncated toward zero.
+--      Check that if the attribute 'Round is applied to the mathematical
+--      result, however, the result is rounded to the nearest multiple of
+--      the small (away from zero if the result is midway between two
+--      multiples of the small).
+--    
+-- TEST DESCRIPTION:
+--      Two decimal fixed point types are declared, one with a Machine_Radix
+--      value of 2, and one with a value of 10. For each type, checks are
+--      performed on the following operations, where the operand and result
+--      types are the same:
+--
+--         - Multiplication.
+--         - Multiplication, where the attribute 'Round is applied to the
+--           result.
+--         - Division.
+--         - Division, where the attribute 'Round is applied to the result.
+--
+--      Each operation is performed within a loop, where one operand is
+--      always the same variable. After the loop completes, the cumulative
+--      total contained in this variable is compared with the expected
+--      result.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is only applicable for a compiler attempting validation
+--      for the Information Systems Annex.
+--
+--
+-- CHANGE HISTORY:
+--      27 Mar 96   SAIC    Prerelease version for ACVC 2.1.
+--
+--!
+
+generic
+   type Decimal_Fixed is delta <> digits <>;
+package CXF2002_0 is
+
+   procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed;
+                                    Factor  : in     Decimal_Fixed);
+
+   procedure Divide_And_Truncate   (Balance : in out Decimal_Fixed;
+                                    Divisor : in     Decimal_Fixed);
+
+   procedure Multiply_And_Round    (Balance : in out Decimal_Fixed;
+                                    Factor  : in     Decimal_Fixed);
+
+   procedure Divide_And_Round      (Balance : in out Decimal_Fixed;
+                                    Divisor : in     Decimal_Fixed);
+
+end CXF2002_0;
+
+
+     --==================================================================--
+
+
+package body CXF2002_0 is
+
+   procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed;
+                                    Factor  : in     Decimal_Fixed) is
+      Interest : Decimal_Fixed;
+   begin
+      Interest := Factor * Balance;      -- Fixed-fixed multiplication.
+      Balance  := Balance + Interest;
+   end Multiply_And_Truncate;
+
+
+   procedure Divide_And_Truncate (Balance : in out Decimal_Fixed;
+                                  Divisor : in     Decimal_Fixed) is
+      Interest : Decimal_Fixed;
+   begin
+      Interest := Balance / Divisor;     -- Fixed-fixed division.
+      Balance  := Balance + Interest;
+   end Divide_And_Truncate;
+
+
+   procedure Multiply_And_Round (Balance : in out Decimal_Fixed;
+                                 Factor  : in     Decimal_Fixed) is
+      Interest : Decimal_Fixed;
+   begin
+                                         -- Fixed-fixed multiplication.
+      Interest := Decimal_Fixed'Round ( Factor * Balance );
+      Balance  := Balance + Interest;
+   end Multiply_And_Round;
+
+
+   procedure Divide_And_Round (Balance : in out Decimal_Fixed;
+                               Divisor : in     Decimal_Fixed) is
+      Interest : Decimal_Fixed;
+   begin
+                                         -- Fixed-fixed division.
+      Interest := Decimal_Fixed'Round ( Balance / Divisor );
+      Balance  := Balance + Interest;
+   end Divide_And_Round;
+
+end CXF2002_0;
+
+
+     --==================================================================--
+
+
+package CXF2002_1 is
+
+   type Money_Radix2 is delta 0.01 digits 11;  -- range -999,999,999.99 ..
+   for Money_Radix2'Machine_Radix use 2;       --       +999,999,999.99
+
+
+   type Money_Radix10 is delta 0.01 digits 11; -- range -999,999,999.99 ..
+   for Money_Radix10'Machine_Radix use 10;     --       +999,999,999.99
+
+end CXF2002_1;
+
+
+     --==================================================================--
+
+
+with CXF2002_0;
+with CXF2002_1;
+
+with Report;
+procedure CXF2002 is
+
+   Loop_Count : constant := 300;
+   type Loop_Range is range 1 .. Loop_Count;
+
+begin
+
+   Report.Test ("CXF2002", "Check decimal multiplication and division, and " &
+                           "'Round, where the operand and result types are " &
+                           "the same");
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   RADIX_2_SUBTESTS:
+   declare
+      package Radix_2 is new CXF2002_0 (CXF2002_1.Money_Radix2);
+      use type CXF2002_1.Money_Radix2;
+   begin
+
+      RADIX_2_MULTIPLICATION:
+      declare
+         Rate           : constant CXF2002_1.Money_Radix2 := 0.12;
+         Period         : constant Integer                := 12;
+         Factor         :          CXF2002_1.Money_Radix2 := Rate / Period;
+
+         Initial        : constant CXF2002_1.Money_Radix2 :=   100_000.00;
+         Trunc_Expected : constant CXF2002_1.Money_Radix2 := 1_978_837.50;
+         Round_Expected : constant CXF2002_1.Money_Radix2 := 1_978_846.75;
+
+         Balance        : CXF2002_1.Money_Radix2;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Multiply_And_Truncate (Balance, Factor);
+         end loop;
+
+         if Balance /= Trunc_Expected then
+            Report.Failed ("Wrong result: Radix 2 multiply and truncate");
+         end if;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Multiply_And_Round (Balance, Factor);
+         end loop;
+
+         if Balance /= Round_Expected then
+            Report.Failed ("Wrong result: Radix 2 multiply and round");
+         end if;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_2_MULTIPLICATION;
+
+
+      RADIX_2_DIVISION:
+      declare
+         Rate           : constant CXF2002_1.Money_Radix2 := 0.25;
+         Period         : constant Integer                := 12;
+         Factor         :          CXF2002_1.Money_Radix2 := Rate / Period;
+         Divisor        : constant CXF2002_1.Money_Radix2 := 1.0 / Factor;
+
+         Initial        : constant CXF2002_1.Money_Radix2 :=     5_500.36;
+         Trunc_Expected : constant CXF2002_1.Money_Radix2 := 2_091_332.87;
+         Round_Expected : constant CXF2002_1.Money_Radix2 := 2_091_436.88;
+
+         Balance        : CXF2002_1.Money_Radix2;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Divide_And_Truncate (Balance, Divisor);
+         end loop;
+
+         if Balance /= Trunc_Expected then
+            Report.Failed ("Wrong result: Radix 2 divide and truncate");
+         end if;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Divide_And_Round (Balance, Divisor);
+         end loop;
+
+         if Balance /= Round_Expected then
+            Report.Failed ("Wrong result: Radix 2 divide and round");
+         end if;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_2_DIVISION;
+
+   end RADIX_2_SUBTESTS;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   RADIX_10_SUBTESTS:
+   declare
+      package Radix_10 is new CXF2002_0 (CXF2002_1.Money_Radix10);
+      use type CXF2002_1.Money_Radix10;
+   begin
+
+      RADIX_10_MULTIPLICATION:
+      declare
+         Rate           : constant CXF2002_1.Money_Radix10 := 0.37;
+         Period         : constant Integer                 := 12;
+         Factor         :          CXF2002_1.Money_Radix10 := Rate / Period;
+
+         Initial        : constant CXF2002_1.Money_Radix10 :=       459.33;
+         Trunc_Expected : constant CXF2002_1.Money_Radix10 := 3_259_305.54;
+         Round_Expected : constant CXF2002_1.Money_Radix10 := 3_260_544.11;
+
+         Balance        : CXF2002_1.Money_Radix10;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Multiply_And_Truncate (Balance, Factor);
+         end loop;
+
+         if Balance /= Trunc_Expected then
+            Report.Failed ("Wrong result: Radix 10 multiply and truncate");
+         end if;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Multiply_And_Round (Balance, Factor);
+         end loop;
+
+         if Balance /= Round_Expected then
+            Report.Failed ("Wrong result: Radix 10 multiply and round");
+         end if;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_10_MULTIPLICATION;
+
+
+      RADIX_10_DIVISION:
+      declare
+         Rate           : constant CXF2002_1.Money_Radix10 := 0.15;
+         Period         : constant Integer                 := 12;
+         Factor         :          CXF2002_1.Money_Radix10 := Rate / Period;
+         Divisor        : constant CXF2002_1.Money_Radix10 := 1.0 / Factor;
+
+         Initial        : constant CXF2002_1.Money_Radix10 :=    29_842.08;
+         Trunc_Expected : constant CXF2002_1.Money_Radix10 :=   590_519.47;
+         Round_Expected : constant CXF2002_1.Money_Radix10 :=   590_528.98;
+
+         Balance        : CXF2002_1.Money_Radix10;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Divide_And_Truncate (Balance, Divisor);
+         end loop;
+
+         if Balance /= Trunc_Expected then
+            Report.Failed ("Wrong result: Radix 10 divide and truncate");
+         end if;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Divide_And_Round (Balance, Divisor);
+         end loop;
+
+         if Balance /= Round_Expected then
+            Report.Failed ("Wrong result: Radix 10 divide and round");
+         end if;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_10_DIVISION;
+
+   end RADIX_10_SUBTESTS;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   Report.Result;
+
+end CXF2002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a
new file mode 100644
index 000000000..133dc48e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2003.a
@@ -0,0 +1,363 @@
+-- CXF2003.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 multiplying operators for a decimal fixed point type
+--      return values that are integral multiples of the small of the type.
+--      Check the case where the two operands are of different decimal
+--      fixed point types.
+--
+--      Check that if the mathematical result is between multiples of the
+--      small of the result type, the result is truncated toward zero.
+--      Check that if the attribute 'Round is applied to the mathematical
+--      result, however, the result is rounded to the nearest multiple of
+--      the small (away from zero if the result is midway between two
+--      multiples of the small).
+--    
+-- TEST DESCRIPTION:
+--      Two decimal fixed point types A and B are declared, one with a
+--      Machine_Radix value of 2, and one with a value of 10. A third decimal
+--      fixed point type C is declared with digits and delta values different
+--      from those of A and B. For type A (and B), checks are performed
+--      on the following operations, where one operand type is C, and the
+--      other operand type and the result type is A (or B):
+--
+--         - Multiplication.
+--         - Multiplication, where the attribute 'Round is applied to the
+--           result.
+--         - Division.
+--         - Division, where the attribute 'Round is applied to the result.
+--
+--      Each operation is performed within a loop, where one operand is
+--      always the same variable. After the loop completes, the cumulative
+--      total contained in this variable is compared with the expected
+--      result.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is only applicable for a compiler attempting validation
+--      for the Information Systems Annex.
+--
+--
+-- CHANGE HISTORY:
+--      22 Mar 96   SAIC    Prerelease version for ACVC 2.1.
+--
+--!
+
+generic
+   type Decimal_Fixed_1 is delta <> digits <>;
+   type Decimal_Fixed_2 is delta <> digits <>;
+package CXF2003_0 is
+
+   procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed_1;
+                                    Factor  : in     Decimal_Fixed_2);
+
+   procedure Divide_And_Truncate   (Balance : in out Decimal_Fixed_1;
+                                    Divisor : in     Decimal_Fixed_2);
+
+   procedure Multiply_And_Round    (Balance : in out Decimal_Fixed_1;
+                                    Factor  : in     Decimal_Fixed_2);
+
+   procedure Divide_And_Round      (Balance : in out Decimal_Fixed_1;
+                                    Divisor : in     Decimal_Fixed_2);
+
+end CXF2003_0;
+
+
+     --==================================================================--
+
+
+package body CXF2003_0 is
+
+   procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed_1;
+                                    Factor  : in     Decimal_Fixed_2) is
+      Interest : Decimal_Fixed_1;
+   begin
+      Interest := Factor * Balance;      -- Fixed-fixed multiplication.
+      Balance  := Balance + Interest;
+   end Multiply_And_Truncate;
+
+
+   procedure Divide_And_Truncate (Balance : in out Decimal_Fixed_1;
+                                  Divisor : in     Decimal_Fixed_2) is
+      Interest : Decimal_Fixed_1;
+   begin
+      Interest := Balance / Divisor;     -- Fixed-fixed division.
+      Balance  := Balance + Interest;
+   end Divide_And_Truncate;
+
+
+   procedure Multiply_And_Round (Balance : in out Decimal_Fixed_1;
+                                 Factor  : in     Decimal_Fixed_2) is
+      Interest : Decimal_Fixed_1;
+   begin
+                                         -- Fixed-fixed multiplication.
+      Interest := Decimal_Fixed_1'Round ( Factor * Balance );
+      Balance  := Balance + Interest;
+   end Multiply_And_Round;
+
+
+   procedure Divide_And_Round (Balance : in out Decimal_Fixed_1;
+                               Divisor : in     Decimal_Fixed_2) is
+      Interest : Decimal_Fixed_1;
+   begin
+                                         -- Fixed-fixed division.
+      Interest := Decimal_Fixed_1'Round ( Balance / Divisor );
+      Balance  := Balance + Interest;
+   end Divide_And_Round;
+
+end CXF2003_0;
+
+
+     --==================================================================--
+
+
+package CXF2003_1 is
+
+   type Money_Radix2 is delta 0.01 digits 11;    -- range -999,999,999.99 ..
+   for Money_Radix2'Machine_Radix use 2;         --       +999,999,999.99
+
+
+   type Money_Radix10 is delta 0.01 digits 11;   -- range -999,999,999.99 ..
+   for Money_Radix10'Machine_Radix use 10;       --       +999,999,999.99
+
+
+   type Interest_Rate is delta 0.00001 digits 9; -- range -9999.99999 ..
+                                                 --       +9999.99999
+
+end CXF2003_1;
+
+
+     --==================================================================--
+
+
+with CXF2003_0;
+with CXF2003_1;
+
+with Report;
+procedure CXF2003 is
+
+   Loop_Count : constant := 1825;
+   type Loop_Range is range 1 .. Loop_Count;
+
+begin
+
+   Report.Test ("CXF2003", "Check decimal multiplication and division, and " &
+                           "'Round, where the operand types are different");
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   RADIX_2_SUBTESTS:
+   declare
+      package Radix_2 is new CXF2003_0 (CXF2003_1.Money_Radix2,
+                                        CXF2003_1.Interest_Rate);
+      use type CXF2003_1.Money_Radix2;
+      use type CXF2003_1.Interest_Rate;
+   begin
+
+      RADIX_2_MULTIPLICATION:
+      declare
+         Rate           : CXF2003_1.Interest_Rate := 0.198;
+         Period         : Integer                 := 365;
+         Factor         : CXF2003_1.Interest_Rate := Rate / Period;
+
+         Initial        : constant CXF2003_1.Money_Radix2  := 1_000.00;
+         Trunc_Expected : constant CXF2003_1.Money_Radix2  := 2_662.94;
+         Round_Expected : constant CXF2003_1.Money_Radix2  := 2_678.34;
+
+         Balance        : CXF2003_1.Money_Radix2;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Multiply_And_Truncate (Balance, Factor);
+         end loop;
+
+         if Balance /= Trunc_Expected then
+            Report.Failed ("Wrong result: Radix 2 multiply and truncate");
+         end if;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Multiply_And_Round (Balance, Factor);
+         end loop;
+
+         if Balance /= Round_Expected then
+            Report.Failed ("Wrong result: Radix 2 multiply and round");
+         end if;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_2_MULTIPLICATION;
+
+
+      RADIX_2_DIVISION:
+      declare
+         Rate           : CXF2003_1.Interest_Rate := 0.129;
+         Period         : Integer                 := 365;
+         Factor         : CXF2003_1.Interest_Rate := Rate / Period;
+         Divisor        : CXF2003_1.Interest_Rate := 1.0 / Factor;
+
+         Initial        : constant CXF2003_1.Money_Radix2  := 14_626.52;
+         Trunc_Expected : constant CXF2003_1.Money_Radix2  := 27_688.26;
+         Round_Expected : constant CXF2003_1.Money_Radix2  := 27_701.12;
+
+         Balance        : CXF2003_1.Money_Radix2;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Divide_And_Truncate (Balance, Divisor);
+         end loop;
+
+         if Balance /= Trunc_Expected then
+            Report.Failed ("Wrong result: Radix 2 divide and truncate");
+         end if;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Divide_And_Round (Balance, Divisor);
+         end loop;
+
+         if Balance /= Round_Expected then
+            Report.Failed ("Wrong result: Radix 2 divide and round");
+         end if;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_2_DIVISION;
+
+   end RADIX_2_SUBTESTS;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   RADIX_10_SUBTESTS:
+   declare
+      package Radix_10 is new CXF2003_0 (CXF2003_1.Money_Radix10,
+                                         CXF2003_1.Interest_Rate);
+      use type CXF2003_1.Money_Radix10;
+      use type CXF2003_1.Interest_Rate;
+   begin
+
+      RADIX_10_MULTIPLICATION:
+      declare
+         Rate           : CXF2003_1.Interest_Rate := 0.063;
+         Period         : Integer                 := 365;
+         Factor         : CXF2003_1.Interest_Rate := Rate / Period;
+
+         Initial        : constant CXF2003_1.Money_Radix10 := 314_036.10;
+         Trunc_Expected : constant CXF2003_1.Money_Radix10 := 428_249.48;
+         Round_Expected : constant CXF2003_1.Money_Radix10 := 428_260.52;
+
+         Balance        : CXF2003_1.Money_Radix10;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Multiply_And_Truncate (Balance, Factor);
+         end loop;
+
+         if Balance /= Trunc_Expected then
+            Report.Failed ("Wrong result: Radix 10 multiply and truncate");
+         end if;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Multiply_And_Round (Balance, Factor);
+         end loop;
+
+         if Balance /= Round_Expected then
+            Report.Failed ("Wrong result: Radix 10 multiply and round");
+         end if;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_10_MULTIPLICATION;
+
+
+      RADIX_10_DIVISION:
+      declare
+         Rate           : CXF2003_1.Interest_Rate := 0.273;
+         Period         : Integer                 := 365;
+         Factor         : CXF2003_1.Interest_Rate := Rate / Period;
+         Divisor        : CXF2003_1.Interest_Rate := 1.0 / Factor;
+
+         Initial        : constant CXF2003_1.Money_Radix10 := 25.72;
+         Trunc_Expected : constant CXF2003_1.Money_Radix10 := 79.05;
+         Round_Expected : constant CXF2003_1.Money_Radix10 := 97.46;
+
+         Balance        : CXF2003_1.Money_Radix10;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Divide_And_Truncate (Balance, Divisor);
+         end loop;
+
+         if Balance /= Trunc_Expected then
+            Report.Failed ("Wrong result: Radix 10 divide and truncate");
+         end if;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Divide_And_Round (Balance, Divisor);
+         end loop;
+
+         if Balance /= Round_Expected then
+            Report.Failed ("Wrong result: Radix 10 divide and round");
+         end if;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_10_DIVISION;
+
+   end RADIX_10_SUBTESTS;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   Report.Result;
+
+end CXF2003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a
new file mode 100644
index 000000000..9651384ce
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2004.a
@@ -0,0 +1,513 @@
+-- CXF2004.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 multiplying operators for a decimal fixed point type
+--      return values that are integral multiples of the small of the type.
+--      Check the case where one operand is of an ordinary fixed point type.
+--
+--      Check that if the mathematical result is between multiples of the
+--      small of the result type, the result is truncated toward zero.
+--      Check that if the attribute 'Round is applied to the mathematical
+--      result, however, the result is rounded to the nearest multiple of
+--      the small (away from zero if the result is midway between two
+--      multiples of the small).
+--    
+-- TEST DESCRIPTION:
+--      Two decimal fixed point types A and B are declared, one with a
+--      Machine_Radix value of 2, and one with a value of 10. An ordinary
+--      fixed point type C is declared with a delta value different from
+--      those of A and B (although still a power of 10). For type A (and B),
+--      checks are performed on the following operations, where one operand
+--      type is C, and the other operand type and the result type is A (or B):
+--
+--         - Multiplication.
+--         - Multiplication, where the attribute 'Round is applied to the
+--           result.
+--         - Division.
+--         - Division, where the attribute 'Round is applied to the result.
+--
+--      Each operation is performed within a loop, where one operand is
+--      always the same variable. After the loop completes, the cumulative
+--      total contained in this variable is compared with the expected
+--      result.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is only applicable for a compiler attempting validation
+--      for the Information Systems Annex.
+--
+--
+-- CHANGE HISTORY:
+--      22 Mar 96   SAIC    Prerelease version for ACVC 2.1.
+--      11 Aug 96   SAIC    ACVC 2.1: In RADIX_2_MULTIPLICATION, corrected
+--                          value of Rate. Corrected associated commentary.
+--
+--!
+
+generic
+   type Decimal_Fixed  is delta <> digits <>;
+   type Ordinary_Fixed is delta <>;
+package CXF2004_0 is
+
+   procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed;
+                                    Factor  : in     Ordinary_Fixed);
+
+   procedure Divide_And_Truncate   (Balance : in out Decimal_Fixed;
+                                    Divisor : in     Ordinary_Fixed);
+
+   procedure Multiply_And_Round    (Balance : in out Decimal_Fixed;
+                                    Factor  : in     Ordinary_Fixed);
+
+   procedure Divide_And_Round      (Balance : in out Decimal_Fixed;
+                                    Divisor : in     Ordinary_Fixed);
+
+end CXF2004_0;
+
+
+     --==================================================================--
+
+
+package body CXF2004_0 is
+
+   procedure Multiply_And_Truncate (Balance : in out Decimal_Fixed;
+                                    Factor  : in     Ordinary_Fixed) is
+      Interest : Decimal_Fixed;
+   begin
+      Interest := Factor * Balance;      -- Fixed-fixed multiplication.
+      Balance  := Balance + Interest;
+   end Multiply_And_Truncate;
+
+
+   procedure Divide_And_Truncate (Balance : in out Decimal_Fixed;
+                                  Divisor : in     Ordinary_Fixed) is
+      Interest : Decimal_Fixed;
+   begin
+      Interest := Balance / Divisor;     -- Fixed-fixed division.
+      Balance  := Balance + Interest;
+   end Divide_And_Truncate;
+
+
+   procedure Multiply_And_Round (Balance : in out Decimal_Fixed;
+                                 Factor  : in     Ordinary_Fixed) is
+      Interest : Decimal_Fixed;
+   begin
+                                         -- Fixed-fixed multiplication.
+      Interest := Decimal_Fixed'Round ( Factor * Balance );
+      Balance  := Balance + Interest;
+   end Multiply_And_Round;
+
+
+   procedure Divide_And_Round (Balance : in out Decimal_Fixed;
+                               Divisor : in     Ordinary_Fixed) is
+      Interest : Decimal_Fixed;
+   begin
+                                         -- Fixed-fixed division.
+      Interest := Decimal_Fixed'Round ( Balance / Divisor );
+      Balance  := Balance + Interest;
+   end Divide_And_Round;
+
+end CXF2004_0;
+
+
+     --==================================================================--
+
+
+package CXF2004_1 is
+
+   type Money_Radix2 is delta 0.01 digits 11;    -- range -999,999,999.99 ..
+   for Money_Radix2'Machine_Radix use 2;         --       +999,999,999.99
+
+
+   type Money_Radix10 is delta 0.01 digits 11;   -- range -999,999,999.99 ..
+   for Money_Radix10'Machine_Radix use 10;       --       +999,999,999.99
+
+
+   type Interest_Rate is delta 0.001 range 0.0 .. 1_000.0;
+   for Interest_Rate'Small use 0.001;            -- Power of 10.
+
+end CXF2004_1;
+
+
+     --==================================================================--
+
+
+with CXF2004_0;
+with CXF2004_1;
+
+with Report;
+procedure CXF2004 is
+
+   Loop_Count : constant := 180;
+   type Loop_Range is range 1 .. Loop_Count;
+
+   type Rounding_Scheme is ( Rounds, Truncates );
+   Machine : Rounding_Scheme;
+
+begin
+
+   Report.Test ("CXF2004", "Check decimal multiplication and division, and " &
+                           "'Round, where one operand type is ordinary fixed");
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   if CXF2004_1.Interest_Rate'Machine_Rounds then  -- Determine machine's
+      Machine := Rounds;                           -- rounding scheme.
+   else
+      Machine := Truncates;
+   end if;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   RADIX_2_SUBTESTS:
+   declare
+      package Radix_2 is new CXF2004_0 (CXF2004_1.Money_Radix2,
+                                        CXF2004_1.Interest_Rate);
+      use type CXF2004_1.Money_Radix2;
+      use type CXF2004_1.Interest_Rate;
+   begin
+
+      RADIX_2_MULTIPLICATION:
+      declare
+         Rate           : constant CXF2004_1.Interest_Rate := 0.154;
+         Period         : constant Integer                 := 12;
+         Factor         :          CXF2004_1.Interest_Rate := Rate / Period;
+
+         -- The exact value of Factor is:
+         --
+         --    0.154/12 = 0.01283333...
+         --
+         -- The adjacent multiples of small are 0.012 and 0.013. Since
+         -- Factor is of an ordinary fixed point type, it may contain either
+         -- of these values. However, since "Rate / Period" is a static
+         -- expression, the value Factor contains is determined by the
+         -- value of CXF2004_1.Interest_Rate'Machine_Rounds:
+         --
+         --    If Machine_Rounds = FALSE : Factor = 0.012
+         --    If Machine_Rounds = TRUE  : Factor = 0.013
+
+         Initial                : constant CXF2004_1.Money_Radix2 :=  1_000.00;
+
+         Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 :=  8_557.07;
+         Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 :=  8_560.47;
+
+         Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 10_222.65;
+         Round_Expected_MachRnds: constant CXF2004_1.Money_Radix2 := 10_225.81;
+
+         Balance                : CXF2004_1.Money_Radix2;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Multiply_And_Truncate (Balance, Factor);
+         end loop;
+
+         case (Machine) is
+            when Rounds    => 
+               if Balance /= Trunc_Expected_MachRnds then
+                  Report.Failed ("Error (R): Radix 2 multiply and truncate");
+               end if;
+            when Truncates =>
+               if Balance /= Trunc_Expected_MachTrnc then
+                  Report.Failed ("Error (T): Radix 2 multiply and truncate");
+               end if;
+         end case;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Multiply_And_Round (Balance, Factor);
+         end loop;
+
+         case (Machine) is
+            when Rounds    => 
+               if Balance /= Round_Expected_MachRnds then
+                  Report.Failed ("Error (R): Radix 2 multiply and round");
+               end if;
+            when Truncates =>
+               if Balance /= Round_Expected_MachTrnc then
+                  Report.Failed ("Error (T): Radix 2 multiply and round");
+               end if;
+         end case;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_2_MULTIPLICATION;
+
+
+      RADIX_2_DIVISION:
+      declare
+         Rate           : constant CXF2004_1.Interest_Rate := 0.210;
+         Period         : constant Integer                 := 12;
+         Factor         : constant CXF2004_1.Interest_Rate := Rate / Period;
+         Divisor        :          CXF2004_1.Interest_Rate := 1.0 / Factor;
+
+         -- The exact value of Factor is:
+         --
+         --    0.210/12 = 0.0175
+         --
+         -- The adjacent multiples of small are 0.017 and 0.018. Since
+         -- Factor is of an ordinary fixed point type, it may contain either
+         -- of these values. However, since "Rate / Period" is a static
+         -- expression, the value Factor contains is determined by the
+         -- value of CXF2004_1.Interest_Rate'Machine_Rounds:
+         --
+         --    If Machine_Rounds = FALSE : Factor = 0.017
+         --    If Machine_Rounds = TRUE  : Factor = 0.018
+         --
+         -- The exact value of Divisor is one of the following values:
+         --
+         --    1.0/0.017 = 58.82352... (Adjacent smalls 58.823 and 58.824)
+         --    1.0/0.018 = 55.55555... (Adjacent smalls 55.555 and 55.556)
+         --
+         -- Again, since "1.0 / Factor" is static, the value Divisor contains
+         -- is determined by the value of CXF2004_1.Interest_Rate'Rounds:
+         --
+         --    If Machine_Rounds = FALSE : Divisor = 58.823
+         --    If Machine_Rounds = TRUE  : Divisor = 55.556
+
+         Initial                : constant CXF2004_1.Money_Radix2 :=    260.13;
+
+         Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 :=  5_401.46;
+         Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix2 :=  5_406.95;
+
+         Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix2 :=  6_446.56;
+         Round_Expected_MachRnds: constant CXF2004_1.Money_Radix2 :=  6_453.78;
+
+         Balance                : CXF2004_1.Money_Radix2;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Divide_And_Truncate (Balance, Divisor);
+         end loop;
+
+         case (Machine) is
+            when Rounds    => 
+               if Balance /= Trunc_Expected_MachRnds then
+                  Report.Failed ("Error (R): Radix 2 divide and truncate");
+               end if;
+            when Truncates =>
+               if Balance /= Trunc_Expected_MachTrnc then
+                  Report.Failed ("Error (T): Radix 2 divide and truncate");
+               end if;
+         end case;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_2.Divide_And_Round (Balance, Divisor);
+         end loop;
+
+         case (Machine) is
+            when Rounds    => 
+               if Balance /= Round_Expected_MachRnds then
+                  Report.Failed ("Error (R): Radix 2 divide and round");
+               end if;
+            when Truncates =>
+               if Balance /= Round_Expected_MachTrnc then
+                  Report.Failed ("Error (T): Radix 2 divide and round");
+               end if;
+         end case;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_2_DIVISION;
+
+   end RADIX_2_SUBTESTS;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   RADIX_10_SUBTESTS:
+   declare
+      package Radix_10 is new CXF2004_0 (CXF2004_1.Money_Radix10,
+                                         CXF2004_1.Interest_Rate);
+      use type CXF2004_1.Money_Radix10;
+      use type CXF2004_1.Interest_Rate;
+   begin
+
+      RADIX_10_MULTIPLICATION:
+      declare
+         Rate           : constant CXF2004_1.Interest_Rate := 0.095;
+         Period         : constant Integer                 := 12;
+         Factor         :          CXF2004_1.Interest_Rate := Rate / Period;
+
+         -- The exact value of Factor is:
+         --
+         --    0.095/12 = 0.00791666...
+         --
+         -- The adjacent multiples of small are 0.007 and 0.008. Since
+         -- Factor is of an ordinary fixed point type, it may contain either
+         -- of these values. However, since "Rate / Period" is a static
+         -- expression, the value Factor contains can be determined based
+         -- on the value of CXF2004_1.Interest_Rate'Machine_Rounds:
+         --
+         --    If Machine_Rounds = FALSE : Factor = 0.007
+         --    If Machine_Rounds = TRUE  : Factor = 0.008
+
+         Initial                : constant CXF2004_1.Money_Radix10 := 2_125.00;
+
+         Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 7_456.90;
+         Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 7_458.77;
+
+         Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 8_915.74;
+         Round_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 8_917.84;
+
+         Balance                : CXF2004_1.Money_Radix10;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Multiply_And_Truncate (Balance, Factor);
+         end loop;
+
+         case (Machine) is
+            when Rounds    => 
+               if Balance /= Trunc_Expected_MachRnds then
+                  Report.Failed ("Error (R): Radix 10 multiply and truncate");
+               end if;
+            when Truncates =>
+               if Balance /= Trunc_Expected_MachTrnc then
+                  Report.Failed ("Error (T): Radix 10 multiply and truncate");
+               end if;
+         end case;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Multiply_And_Round (Balance, Factor);
+         end loop;
+
+         case (Machine) is
+            when Rounds    => 
+               if Balance /= Round_Expected_MachRnds then
+                  Report.Failed ("Error (R): Radix 10 multiply and round");
+               end if;
+            when Truncates =>
+               if Balance /= Round_Expected_MachTrnc then
+                  Report.Failed ("Error (T): Radix 10 multiply and round");
+               end if;
+         end case;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_10_MULTIPLICATION;
+
+
+      RADIX_10_DIVISION:
+      declare
+         Rate           : constant CXF2004_1.Interest_Rate := 0.295;
+         Period         : constant Integer                 := 12;
+         Factor         : constant CXF2004_1.Interest_Rate := Rate / Period;
+         Divisor        :          CXF2004_1.Interest_Rate := 1.0 / Factor;
+
+         -- The exact value of Factor is:
+         --
+         --    0.295/12 = 0.02458333...
+         --
+         -- The adjacent multiples of small are 0.024 and 0.025. Thus, the
+         -- exact value of Divisor is one of the following:
+         --
+         --    1.0/0.024 = 41.66666... (Adjacent smalls 41.666 and 41.667)
+         --    1.0/0.025 = 40.0
+         --
+         -- The value of CXF2004_1.Interest_Rate'Machine_Rounds determines
+         -- what Divisor contains:
+         --
+         --    If Machine_Rounds = FALSE : Divisor = 41.666
+         --    If Machine_Rounds = TRUE  : Divisor = 40.000
+
+         Initial                : constant CXF2004_1.Money_Radix10 :=    72.19;
+
+         Trunc_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 5_144.60;
+         Round_Expected_MachTrnc: constant CXF2004_1.Money_Radix10 := 5_157.80;
+
+         Trunc_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 6_133.28;
+         Round_Expected_MachRnds: constant CXF2004_1.Money_Radix10 := 6_149.06;
+
+         Balance                : CXF2004_1.Money_Radix10;
+      begin
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Divide_And_Truncate (Balance, Divisor);
+         end loop;
+
+         case (Machine) is
+            when Rounds    => 
+               if Balance /= Trunc_Expected_MachRnds then
+                  Report.Failed ("Error (R): Radix 10 divide and truncate");
+               end if;
+            when Truncates =>
+               if Balance /= Trunc_Expected_MachTrnc then
+                  Report.Failed ("Error (T): Radix 10 divide and truncate");
+               end if;
+         end case;
+
+                       ---=---=---=---=---=---=---
+
+         Balance := Initial;
+
+         for I in Loop_Range loop
+            Radix_10.Divide_And_Round (Balance, Divisor);
+         end loop;
+
+         case (Machine) is
+            when Rounds    => 
+               if Balance /= Round_Expected_MachRnds then
+                  Report.Failed ("Error (R): Radix 10 divide and round");
+               end if;
+            when Truncates =>
+               if Balance /= Round_Expected_MachTrnc then
+                  Report.Failed ("Error (T): Radix 10 divide and round");
+               end if;
+         end case;
+
+                       ---=---=---=---=---=---=---
+      end RADIX_10_DIVISION;
+
+   end RADIX_10_SUBTESTS;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   Report.Result;
+
+end CXF2004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a
new file mode 100644
index 000000000..71cd5bb31
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2005.a
@@ -0,0 +1,293 @@
+-- CXF2005.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 multiplying operators for a decimal fixed point type
+--      return values that are integral multiples of the small of the type.
+--      Check the case where one operand is of the predefined type Integer.
+--
+-- TEST DESCRIPTION:
+--      Two decimal fixed point types A and B are declared, one with a
+--      Machine_Radix value of 2, and one with a value of 10. A variable of
+--      each type is multiplied repeatedly by a series of different Integer
+--      values. A cumulative result is kept and compared to an expected
+--      final result. Similar checks are performed for division.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is only applicable for a compiler attempting validation
+--      for the Information Systems Annex.
+--
+--
+-- CHANGE HISTORY:
+--      28 Mar 96   SAIC    Prerelease version for ACVC 2.1.
+--
+--!
+
+generic
+   type Decimal_Fixed  is delta <> digits <>;
+package CXF2005_0 is
+
+   function Multiply (Operand  : Decimal_Fixed;
+                      Interval : Integer) return Decimal_Fixed;
+
+   function Divide   (Operand  : Decimal_Fixed;
+                      Interval : Integer) return Decimal_Fixed;
+
+end CXF2005_0;
+
+
+     --==================================================================--
+
+
+package body CXF2005_0 is
+
+   function Multiply (Operand  : Decimal_Fixed;
+                      Interval : Integer) return Decimal_Fixed is
+   begin
+      return Operand * Interval;  -- Fixed-Integer multiplication.
+   end Multiply;
+
+
+   function Divide (Operand  : Decimal_Fixed;
+                    Interval : Integer) return Decimal_Fixed is
+   begin
+      return Operand / Interval;  -- Fixed-Integer division.
+   end Divide;
+
+end CXF2005_0;
+
+
+     --==================================================================--
+
+
+package CXF2005_1 is
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Interest_Rate is delta 0.001 range 0.0 .. 1_000.0;
+   for Interest_Rate'Small use 0.001;            -- Power of 10.
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Money_Radix2 is delta 0.01 digits 11;    -- range -999,999,999.99 ..
+   for Money_Radix2'Machine_Radix use 2;         --       +999,999,999.99
+
+   function Factor (Rate     : Interest_Rate;
+                    Interval : Integer) return Money_Radix2;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Money_Radix10 is delta 0.01 digits 11;   -- range -999,999,999.99 ..
+   for Money_Radix10'Machine_Radix use 10;       --       +999,999,999.99
+
+   function Factor (Rate   : Interest_Rate;
+                    Interval : Integer) return Money_Radix10;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+end CXF2005_1;
+
+
+     --==================================================================--
+
+
+package body CXF2005_1 is
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   function Factor (Rate   : Interest_Rate;
+                    Interval : Integer) return Money_Radix2 is
+   begin
+      return Money_Radix2( Rate / Interval );
+   end Factor;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   function Factor (Rate   : Interest_Rate;
+                    Interval : Integer) return Money_Radix10 is
+   begin
+      return Money_Radix10( Rate / Interval );
+   end Factor;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+end CXF2005_1;
+
+
+     --==================================================================--
+
+
+with CXF2005_0;
+with CXF2005_1;
+
+with Report;
+procedure CXF2005 is
+
+   Loop_Count : constant := 25_000;
+   type Loop_Range is range 1 .. Loop_Count;
+
+begin
+
+   Report.Test ("CXF2005", "Check decimal multiplication and division, " &
+                           "where one operand type is Integer");
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   RADIX_2_SUBTESTS:
+   declare
+      package Radix_2 is new CXF2005_0 (CXF2005_1.Money_Radix2);
+      use type CXF2005_1.Money_Radix2;
+   begin
+
+      RADIX_2_MULTIPLICATION:
+      declare
+         Rate           : constant CXF2005_1.Interest_Rate := 0.127;
+         Period         : constant Integer                 := 12;
+
+         Expected       : constant CXF2005_1.Money_Radix2  := 2_624.88;
+         Balance        :          CXF2005_1.Money_Radix2  := 1_000.00;
+
+         Operand        :          CXF2005_1.Money_Radix2;
+         Increment      :          CXF2005_1.Money_Radix2;
+         Interval       :          Integer;
+      begin
+
+         for I in Loop_Range loop
+            Interval  := (Integer(I) mod Period) + 1;  -- Range from 1 to 12.
+            Operand   := CXF2005_1.Factor (Rate, Period);
+            Increment := Radix_2.Multiply (Operand, Interval);
+            Balance   := Balance + Increment;
+         end loop;
+
+         if Balance /= Expected then
+            Report.Failed ("Error: Radix 2 multiply");
+         end if;
+
+      end RADIX_2_MULTIPLICATION;
+
+
+
+      RADIX_2_DIVISION:
+      declare
+         Rate           : constant CXF2005_1.Interest_Rate := 0.377;
+         Period         : constant Integer                 := 12;
+
+         Expected       : constant CXF2005_1.Money_Radix2  :=  36_215.58;
+         Balance        :          CXF2005_1.Money_Radix2  := 456_985.01;
+
+         Operand        :          CXF2005_1.Money_Radix2;
+         Increment      :          CXF2005_1.Money_Radix2;
+         Interval       :          Integer;
+      begin
+
+         for I in Loop_Range loop
+            Interval  := (Integer(I+1000) mod (200*Period)) + 1; -- 1 .. 2400.
+            Operand   := CXF2005_1.Factor (Rate, Period);
+            Increment := Radix_2.Divide (Balance, Interval);
+            Balance   := Balance - (Operand * Increment);
+         end loop;
+
+         if Balance /= Expected then
+            Report.Failed ("Error: Radix 2 divide");
+         end if;
+
+      end RADIX_2_DIVISION;
+
+   end RADIX_2_SUBTESTS;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   RADIX_10_SUBTESTS:
+   declare
+      package Radix_10 is new CXF2005_0 (CXF2005_1.Money_Radix10);
+      use type CXF2005_1.Money_Radix10;
+   begin
+
+      RADIX_10_MULTIPLICATION:
+      declare
+         Rate           : constant CXF2005_1.Interest_Rate := 0.721;
+         Period         : constant Integer                 := 12;
+
+         Expected       : constant CXF2005_1.Money_Radix10 := 9_875.62;
+         Balance        :          CXF2005_1.Money_Radix10 :=   126.34;
+
+         Operand        :          CXF2005_1.Money_Radix10;
+         Increment      :          CXF2005_1.Money_Radix10;
+         Interval       :          Integer;
+      begin
+
+         for I in Loop_Range loop
+            Interval  := (Integer(I) mod Period) + 1;  -- Range from 1 to 12.
+            Operand   := CXF2005_1.Factor (Rate, Period);
+            Increment := Radix_10.Multiply (Operand, Interval);
+            Balance   := Balance + Increment;
+         end loop;
+
+         if Balance /= Expected then
+            Report.Failed ("Error: Radix 10 multiply");
+         end if;
+
+      end RADIX_10_MULTIPLICATION;
+
+
+      RADIX_10_DIVISION:
+      declare
+         Rate           : constant CXF2005_1.Interest_Rate := 0.547;
+         Period         : constant Integer                 := 12;
+
+         Expected       : constant CXF2005_1.Money_Radix10 :=  26_116.37;
+         Balance        :          CXF2005_1.Money_Radix10 := 770_082.46;
+
+         Operand        :          CXF2005_1.Money_Radix10;
+         Increment      :          CXF2005_1.Money_Radix10;
+         Interval       :          Integer;
+      begin
+
+         for I in Loop_Range loop
+            Interval  := (Integer(I+1000) mod (200*Period)) + 1; -- 1 .. 2400.
+            Operand   := CXF2005_1.Factor (Rate, Period);
+            Increment := Radix_10.Divide (Balance, Interval);
+            Balance   := Balance - (Operand * Increment);
+         end loop;
+
+         if Balance /= Expected then
+            Report.Failed ("Error: Radix 10 divide");
+         end if;
+
+      end RADIX_10_DIVISION;
+
+   end RADIX_10_SUBTESTS;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   Report.Result;
+
+end CXF2005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a
new file mode 100644
index 000000000..002c59d6c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2a01.a
@@ -0,0 +1,448 @@
+-- CXF2A01.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 binary adding operators for a decimal fixed point type
+--      return values that are integral multiples of the small of the type.
+--    
+-- TEST DESCRIPTION:
+--      The test verifies that decimal addition and subtraction behave as
+--      expected for types with various digits, delta, and Machine_Radix
+--      values. Types with the minimum values for Decimal.Max_Digits and
+--      Decimal.Max_Scale (18) are included.
+--
+--      Two kinds of checks are performed for each type. In the first check,
+--      the iteration, operation, and operand counts in the foundation and
+--      the operation tables in this test are given values such that, when the
+--      operations loop is complete, each operand will have been added to and
+--      subtracted from the loop's cumulator variable the same number of times,
+--      albeit in varying order. Thus, the result returned by the operations
+--      loop should have the same value as that used to initialize the
+--      cumulator (in this test, zero).
+--
+--      In the second check, the same operation (addition for some types and
+--      subtraction for others) is performed during each loop iteration,
+--      resulting in a cumulative total which is checked against an expected
+--      value.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXF2A00.A
+--      -> CXF2A01.A
+--
+-- APPLICABILITY CRITERIA:
+--      This test is only applicable for a compiler attempting validation
+--      for the Information Systems Annex.
+--
+--
+-- CHANGE HISTORY:
+--      08 Apr 96   SAIC    Prerelease version for ACVC 2.1.
+--
+--!
+
+package CXF2A01_0 is
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Micro is delta 10.0**(-18) digits 18; -- range -0.999999999999999999 ..
+   for Micro'Machine_Radix use 10;     --              +0.999999999999999999
+
+   function Add      (Left, Right : Micro) return Micro;
+   function Subtract (Left, Right : Micro) return Micro;
+
+
+   type Micro_Optr_Ptr is access function (Left, Right : Micro) return Micro;
+
+   Micro_Add : Micro_Optr_Ptr := Add'Access;
+   Micro_Sub : Micro_Optr_Ptr := Subtract'Access;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Money is delta 0.01 digits 11; -- range -999,999,999.99 ..
+   for Money'Machine_Radix use 2;      --       +999,999,999.99
+
+   function Add      (Left, Right : Money) return Money;
+   function Subtract (Left, Right : Money) return Money;
+
+
+   type Money_Optr_Ptr is access function (Left, Right : Money) return Money;
+
+   Money_Add : Money_Optr_Ptr := Add'Access;
+   Money_Sub : Money_Optr_Ptr := Subtract'Access;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   -- Same as Money, but with Radix 10:
+
+   type Cash is delta 0.01 digits 11; -- range -999,999,999.99 ..
+   for Cash'Machine_Radix use 10;     --       +999,999,999.99
+
+   function Add      (Left, Right : Cash) return Cash;
+   function Subtract (Left, Right : Cash) return Cash;
+
+
+   type Cash_Optr_Ptr is access function (Left, Right : Cash) return Cash;
+
+   Cash_Add : Cash_Optr_Ptr := Add'Access;
+   Cash_Sub : Cash_Optr_Ptr := Subtract'Access;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Broad is delta 10.0**(-9) digits 18; -- range -999,999,999.999999999 ..
+   for Broad'Machine_Radix use 10;           --       +999,999,999.999999999
+
+   function Add      (Left, Right : Broad) return Broad;
+   function Subtract (Left, Right : Broad) return Broad;
+
+
+   type Broad_Optr_Ptr is access function (Left, Right : Broad) return Broad;
+
+   Broad_Add : Broad_Optr_Ptr := Add'Access;
+   Broad_Sub : Broad_Optr_Ptr := Subtract'Access;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+end CXF2A01_0;
+
+
+     --==================================================================--
+
+
+package body CXF2A01_0 is
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   function Add (Left, Right : Micro) return Micro is
+   begin
+      return (Left + Right); -- Decimal fixed addition.
+   end Add;
+
+   function Subtract (Left, Right : Micro) return Micro is
+   begin
+      return (Left - Right); -- Decimal fixed subtraction.
+   end Subtract;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   function Add (Left, Right : Money) return Money is
+   begin
+      return (Left + Right); -- Decimal fixed addition.
+   end Add;
+
+   function Subtract (Left, Right : Money) return Money is
+   begin
+      return (Left - Right); -- Decimal fixed subtraction.
+   end Subtract;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   function Add (Left, Right : Cash) return Cash is
+   begin
+      return (Left + Right); -- Decimal fixed addition.
+   end Add;
+
+   function Subtract (Left, Right : Cash) return Cash is
+   begin
+      return (Left - Right); -- Decimal fixed subtraction.
+   end Subtract;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   function Add (Left, Right : Broad) return Broad is
+   begin
+      return (Left + Right); -- Decimal fixed addition.
+   end Add;
+
+   function Subtract (Left, Right : Broad) return Broad is
+   begin
+      return (Left - Right); -- Decimal fixed subtraction.
+   end Subtract;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+end CXF2A01_0;
+
+
+     --==================================================================--
+
+
+with FXF2A00;
+package CXF2A01_0.CXF2A01_1 is
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Micro_Ops   is array (FXF2A00.Optr_Range) of Micro_Optr_Ptr;
+   type Micro_Opnds is array (FXF2A00.Opnd_Range) of Micro;
+
+   Micro_Optr_Table_Cancel : Micro_Ops   := ( Micro_Add, Micro_Sub,
+                                              Micro_Add, Micro_Sub,
+                                              Micro_Add, Micro_Sub );
+
+   Micro_Optr_Table_Cumul  : Micro_Ops   := ( others => Micro_Add );
+
+   Micro_Opnd_Table_Cancel : Micro_Opnds := ( 0.001025000235111997,
+                                              0.000000000000000003,
+                                              0.724902903219925400,
+                                              0.000459228020000011,
+                                              0.049832104921096533 );
+
+   Micro_Opnd_Table_Cumul  : Micro_Opnds := ( 0.000002309540000000,
+                                              0.000000278060000000,
+                                              0.000000000000070000,
+                                              0.000010003000000000,
+                                              0.000000023090000000 );
+
+   function Test_Micro_Ops is new FXF2A00.Operations_Loop
+     (Decimal_Fixed  => Micro,
+      Operator_Ptr   => Micro_Optr_Ptr,
+      Operator_Table => Micro_Ops,
+      Operand_Table  => Micro_Opnds);
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Money_Ops   is array (FXF2A00.Optr_Range) of Money_Optr_Ptr;
+   type Money_Opnds is array (FXF2A00.Opnd_Range) of Money;
+
+   Money_Optr_Table_Cancel : Money_Ops   := ( Money_Add, Money_Add,
+                                              Money_Sub, Money_Add,
+                                              Money_Sub, Money_Sub );
+
+   Money_Optr_Table_Cumul  : Money_Ops   := ( others => Money_Sub );
+
+   Money_Opnd_Table_Cancel  : Money_Opnds := (       127.10,
+                                                    5600.44,
+                                                       0.05,
+                                                  189662.78,
+                                               226900402.99  );
+
+   Money_Opnd_Table_Cumul   : Money_Opnds := (        17.99,
+                                                     500.41,
+                                                      92.78,
+                                                       0.38,
+                                                    2942.99  );
+
+   function Test_Money_Ops is new FXF2A00.Operations_Loop
+     (Decimal_Fixed  => Money,
+      Operator_Ptr   => Money_Optr_Ptr,
+      Operator_Table => Money_Ops,
+      Operand_Table  => Money_Opnds);
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Cash_Ops   is array (FXF2A00.Optr_Range) of Cash_Optr_Ptr;
+   type Cash_Opnds is array (FXF2A00.Opnd_Range) of Cash;
+
+   Cash_Optr_Table_Cancel : Cash_Ops   := ( Cash_Add, Cash_Add,
+                                            Cash_Sub, Cash_Add,
+                                            Cash_Sub, Cash_Sub );
+
+   Cash_Optr_Table_Cumul  : Cash_Ops   := ( others => Cash_Add );
+
+   Cash_Opnd_Table_Cancel : Cash_Opnds := (       127.10,
+                                                 5600.44,
+                                                    0.05,
+                                               189662.78,
+                                            226900402.99  );
+
+   Cash_Opnd_Table_Cumul  : Cash_Opnds := (         3.33,
+                                               100056.14,
+                                                   22.87,
+                                                 3901.55,
+                                                  111.21  );
+
+   function Test_Cash_Ops is new FXF2A00.Operations_Loop
+     (Decimal_Fixed  => Cash,
+      Operator_Ptr   => Cash_Optr_Ptr,
+      Operator_Table => Cash_Ops,
+      Operand_Table  => Cash_Opnds);
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Broad_Ops   is array (FXF2A00.Optr_Range) of Broad_Optr_Ptr;
+   type Broad_Opnds is array (FXF2A00.Opnd_Range) of Broad;
+
+   Broad_Optr_Table_Cancel : Broad_Ops   := ( Broad_Sub, Broad_Add,
+                                              Broad_Add, Broad_Sub,
+                                              Broad_Sub, Broad_Add );
+
+   Broad_Optr_Table_Cumul  : Broad_Ops   := ( others => Broad_Sub );
+
+   Broad_Opnd_Table_Cancel : Broad_Opnds := (         1.000009092,
+                                              732919479.445022293,
+                                                  89662.787000006,
+                                                    660.101010133,
+                                                1121127.999905594  );
+
+   Broad_Opnd_Table_Cumul  : Broad_Opnds := (        12.000450223,
+                                                    479.430320780,
+                                                      0.003492096,
+                                                      8.112888400,
+                                                   1002.994937800  );
+
+   function Test_Broad_Ops is new FXF2A00.Operations_Loop
+     (Decimal_Fixed  => Broad,
+      Operator_Ptr   => Broad_Optr_Ptr,
+      Operator_Table => Broad_Ops,
+      Operand_Table  => Broad_Opnds);
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+end CXF2A01_0.CXF2A01_1;
+
+
+     --==================================================================--
+
+
+with CXF2A01_0.CXF2A01_1;
+
+with Report;
+procedure CXF2A01 is
+   package Data renames CXF2A01_0.CXF2A01_1;
+
+   use type CXF2A01_0.Micro;
+   use type CXF2A01_0.Money;
+   use type CXF2A01_0.Cash;
+   use type CXF2A01_0.Broad;
+
+   Micro_Cancel_Expected : constant CXF2A01_0.Micro := 0.0;
+   Money_Cancel_Expected : constant CXF2A01_0.Money := 0.0;
+   Cash_Cancel_Expected  : constant CXF2A01_0.Cash  := 0.0;
+   Broad_Cancel_Expected : constant CXF2A01_0.Broad := 0.0;
+
+   Micro_Cumul_Expected  : constant CXF2A01_0.Micro :=  0.075682140420000000;
+   Money_Cumul_Expected  : constant CXF2A01_0.Money := -21327300.00;
+   Cash_Cumul_Expected   : constant CXF2A01_0.Cash  :=  624570600.00;
+   Broad_Cumul_Expected  : constant CXF2A01_0.Broad := -9015252.535794000;
+
+   Micro_Actual   : CXF2A01_0.Micro;
+   Money_Actual   : CXF2A01_0.Money;
+   Cash_Actual    : CXF2A01_0.Cash;
+   Broad_Actual   : CXF2A01_0.Broad;
+begin
+
+   Report.Test ("CXF2A01", "Check decimal addition and subtraction");
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   Micro_Actual := Data.Test_Micro_Ops (0.0,
+                                        Data.Micro_Optr_Table_Cancel,
+                                        Data.Micro_Opnd_Table_Cancel);
+
+   if Micro_Actual /= Micro_Cancel_Expected then
+      Report.Failed ("Wrong cancellation result for type Micro");
+   end if;
+
+                       ---=---=---=---=---=---=---
+
+
+   Micro_Actual := Data.Test_Micro_Ops (0.0,
+                                        Data.Micro_Optr_Table_Cumul,
+                                        Data.Micro_Opnd_Table_Cumul);
+
+   if Micro_Actual /= Micro_Cumul_Expected then
+      Report.Failed ("Wrong cumulation result for type Micro");
+   end if;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   Money_Actual := Data.Test_Money_Ops (0.0,
+                                        Data.Money_Optr_Table_Cancel,
+                                        Data.Money_Opnd_Table_Cancel);
+
+   if Money_Actual /= Money_Cancel_Expected then
+      Report.Failed ("Wrong cancellation result for type Money");
+   end if;
+
+                       ---=---=---=---=---=---=---
+
+
+   Money_Actual := Data.Test_Money_Ops (0.0,
+                                        Data.Money_Optr_Table_Cumul,
+                                        Data.Money_Opnd_Table_Cumul);
+
+   if Money_Actual /= Money_Cumul_Expected then
+      Report.Failed ("Wrong cumulation result for type Money");
+   end if;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   Cash_Actual := Data.Test_Cash_Ops (0.0,
+                                      Data.Cash_Optr_Table_Cancel,
+                                      Data.Cash_Opnd_Table_Cancel);
+
+   if Cash_Actual /= Cash_Cancel_Expected then
+      Report.Failed ("Wrong cancellation result for type Cash");
+   end if;
+
+
+                       ---=---=---=---=---=---=---
+
+
+   Cash_Actual := Data.Test_Cash_Ops (0.0,
+                                      Data.Cash_Optr_Table_Cumul,
+                                      Data.Cash_Opnd_Table_Cumul);
+
+   if Cash_Actual /= Cash_Cumul_Expected then
+      Report.Failed ("Wrong cumulation result for type Cash");
+   end if;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   Broad_Actual := Data.Test_Broad_Ops (0.0,
+                                        Data.Broad_Optr_Table_Cancel,
+                                        Data.Broad_Opnd_Table_Cancel);
+
+   if Broad_Actual /= Broad_Cancel_Expected then
+      Report.Failed ("Wrong cancellation result for type Broad");
+   end if;
+
+
+                       ---=---=---=---=---=---=---
+
+
+   Broad_Actual := Data.Test_Broad_Ops (0.0,
+                                        Data.Broad_Optr_Table_Cumul,
+                                        Data.Broad_Opnd_Table_Cumul);
+
+   if Broad_Actual /= Broad_Cumul_Expected then
+      Report.Failed ("Wrong cumulation result for type Broad");
+   end if;
+
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+
+   Report.Result;
+
+end CXF2A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
new file mode 100644
index 000000000..e9977b0f5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf2a02.a
@@ -0,0 +1,354 @@
+-- CXF2A02.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 multiplying operators for a decimal fixed point type
+--      return values that are integral multiples of the small of the type.
+--      Check the case where the operand and result types are the same.
+--
+--      Check that if the mathematical result is between multiples of the
+--      small of the result type, the result is truncated toward zero.
+--    
+-- TEST DESCRIPTION:
+--      The test verifies that decimal multiplication and division behave as
+--      expected for types with various digits, delta, and Machine_Radix
+--      values.
+--
+--      The iteration, operation, and operand counts in the foundation, and
+--      the operations and operand tables in the test, are given values such
+--      that, when the operations loop is complete, truncation of inexact
+--      results should cause the result returned by the operations loop to be
+--      the same as that used to initialize the loop's cumulator variable (in
+--      this test, one).
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--
+--         FXF2A00.A
+--      -> CXF2A02.A
+--
+-- APPLICABILITY CRITERIA:
+--      This test is only applicable for a compiler attempting validation
+--      for the Information Systems Annex.
+--
+--
+-- CHANGE HISTORY:
+--      13 Mar 96   SAIC    Prerelease version for ACVC 2.1.
+--      04 Aug 96   SAIC    Updated prologue.
+--
+--!
+
+package CXF2A02_0 is
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Micro is delta 10.0**(-5) digits 6; -- range -9.99999 ..
+   for Micro'Machine_Radix use 2;      --            +9.99999
+
+   function Multiply (Left, Right : Micro) return Micro;
+   function Divide   (Left, Right : Micro) return Micro;
+
+
+   type Micro_Optr_Ptr is access function (Left, Right : Micro) return Micro;
+
+   Micro_Mult : Micro_Optr_Ptr := Multiply'Access;
+   Micro_Div  : Micro_Optr_Ptr := Divide'Access;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Basic is delta 0.01 digits 11; -- range -999,999,999.99 ..
+   for Basic'Machine_Radix use 10;     --       +999,999,999.99
+
+   function Multiply (Left, Right : Basic) return Basic;
+   function Divide   (Left, Right : Basic) return Basic;
+
+
+   type Basic_Optr_Ptr is access function (Left, Right : Basic) return Basic;
+
+   Basic_Mult : Basic_Optr_Ptr := Multiply'Access;
+   Basic_Div  : Basic_Optr_Ptr := Divide'Access;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Broad is delta 10.0**(-3) digits 10; -- range -9,999,999.999 ..
+   for Broad'Machine_Radix use 2;            --       +9,999,999.999
+
+   function Multiply (Left, Right : Broad) return Broad;
+   function Divide   (Left, Right : Broad) return Broad;
+
+
+   type Broad_Optr_Ptr is access function (Left, Right : Broad) return Broad;
+
+   Broad_Mult : Broad_Optr_Ptr := Multiply'Access;
+   Broad_Div  : Broad_Optr_Ptr := Divide'Access;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+end CXF2A02_0;
+
+
+     --==================================================================--
+
+
+package body CXF2A02_0 is
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   function Multiply (Left, Right : Micro) return Micro is
+   begin
+      return (Left * Right); -- Decimal fixed multiplication.
+   end Multiply;
+
+   function Divide (Left, Right : Micro) return Micro is
+   begin
+      return (Left / Right); -- Decimal fixed division.
+   end Divide;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   function Multiply (Left, Right : Basic) return Basic is
+   begin
+      return (Left * Right); -- Decimal fixed multiplication.
+   end Multiply;
+
+   function Divide (Left, Right : Basic) return Basic is
+   begin
+      return (Left / Right); -- Decimal fixed division.
+   end Divide;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   function Multiply (Left, Right : Broad) return Broad is
+   begin
+      return (Left * Right); -- Decimal fixed multiplication.
+   end Multiply;
+
+   function Divide (Left, Right : Broad) return Broad is
+   begin
+      return (Left / Right); -- Decimal fixed division.
+   end Divide;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+end CXF2A02_0;
+
+
+     --==================================================================--
+
+
+with FXF2A00;
+package CXF2A02_0.CXF2A02_1 is
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Micro_Ops   is array (FXF2A00.Optr_Range) of Micro_Optr_Ptr;
+   type Micro_Opnds is array (FXF2A00.Opnd_Range) of Micro;
+
+   Micro_Mult_Operator_Table : Micro_Ops   := ( Micro_Mult, Micro_Mult,
+                                                Micro_Mult, Micro_Mult,
+                                                Micro_Mult, Micro_Mult );
+
+   Micro_Div_Operator_Table  : Micro_Ops   := ( Micro_Div, Micro_Div,
+                                                Micro_Div, Micro_Div,
+                                                Micro_Div, Micro_Div   );
+
+   Micro_Mult_Operand_Table  : Micro_Opnds := ( 2.35119,
+                                                0.05892,
+                                                9.58122,
+                                                0.80613,
+                                                0.93462 );
+
+   Micro_Div_Operand_Table   : Micro_Opnds := ( 0.58739,
+                                                4.90012,
+                                                0.08765,
+                                                0.71577,
+                                                5.53768 );
+
+   function Test_Micro_Ops is new FXF2A00.Operations_Loop
+     (Decimal_Fixed  => Micro,
+      Operator_Ptr   => Micro_Optr_Ptr,
+      Operator_Table => Micro_Ops,
+      Operand_Table  => Micro_Opnds);
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Basic_Ops   is array (FXF2A00.Optr_Range) of Basic_Optr_Ptr;
+   type Basic_Opnds is array (FXF2A00.Opnd_Range) of Basic;
+
+   Basic_Mult_Operator_Table : Basic_Ops   := ( Basic_Mult, Basic_Mult,
+                                                Basic_Mult, Basic_Mult,
+                                                Basic_Mult, Basic_Mult );
+
+   Basic_Div_Operator_Table  : Basic_Ops   := ( Basic_Div, Basic_Div,
+                                                Basic_Div, Basic_Div,
+                                                Basic_Div, Basic_Div   );
+
+   Basic_Mult_Operand_Table  : Basic_Opnds := (       127.10,
+                                                        0.02,
+                                                        0.87,
+                                                       45.67,
+                                                        0.01  );
+
+   Basic_Div_Operand_Table   : Basic_Opnds := (         0.03,
+                                                        0.08,
+                                                       23.57,
+                                                        0.11,
+                                                      159.11  );
+
+   function Test_Basic_Ops is new FXF2A00.Operations_Loop
+     (Decimal_Fixed  => Basic,
+      Operator_Ptr   => Basic_Optr_Ptr,
+      Operator_Table => Basic_Ops,
+      Operand_Table  => Basic_Opnds);
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   type Broad_Ops   is array (FXF2A00.Optr_Range) of Broad_Optr_Ptr;
+   type Broad_Opnds is array (FXF2A00.Opnd_Range) of Broad;
+
+   Broad_Mult_Operator_Table : Broad_Ops   := ( Broad_Mult, Broad_Mult,
+                                                Broad_Mult, Broad_Mult,
+                                                Broad_Mult, Broad_Mult );
+
+   Broad_Div_Operator_Table  : Broad_Ops   := ( Broad_Div,  Broad_Div,
+                                                Broad_Div,  Broad_Div,
+                                                Broad_Div,  Broad_Div  );
+
+   Broad_Mult_Operand_Table  : Broad_Opnds := (     589.720,
+                                                      0.106,
+                                                     21.018,
+                                                      0.002,
+                                                      0.381  );
+
+   Broad_Div_Operand_Table   : Broad_Opnds := (       0.008,
+                                                      0.793,
+                                                      9.092,
+                                                    214.300,
+                                                      0.080  );
+
+   function Test_Broad_Ops is new FXF2A00.Operations_Loop
+     (Decimal_Fixed  => Broad,
+      Operator_Ptr   => Broad_Optr_Ptr,
+      Operator_Table => Broad_Ops,
+      Operand_Table  => Broad_Opnds);
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+end CXF2A02_0.CXF2A02_1;
+
+
+     --==================================================================--
+
+
+with CXF2A02_0.CXF2A02_1;
+
+with Report;
+procedure CXF2A02 is
+   package Data renames CXF2A02_0.CXF2A02_1;
+
+   use type CXF2A02_0.Micro;
+   use type CXF2A02_0.Basic;
+   use type CXF2A02_0.Broad;
+
+   Micro_Expected : constant CXF2A02_0.Micro := 1.0;
+   Basic_Expected : constant CXF2A02_0.Basic := 1.0;
+   Broad_Expected : constant CXF2A02_0.Broad := 1.0;
+
+   Micro_Actual   : CXF2A02_0.Micro;
+   Basic_Actual   : CXF2A02_0.Basic;
+   Broad_Actual   : CXF2A02_0.Broad;
+begin
+
+   Report.Test ("CXF2A02", "Check decimal multiplication and division, " &
+                "where the operand and result types are the same");
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   Micro_Actual := 0.0;
+   Micro_Actual := Data.Test_Micro_Ops (1.0,
+                                        Data.Micro_Mult_Operator_Table,
+                                        Data.Micro_Mult_Operand_Table);
+
+   if Micro_Actual /= Micro_Expected then
+      Report.Failed ("Wrong result for type Micro multiplication");
+   end if;
+
+
+   Micro_Actual := 0.0;
+   Micro_Actual := Data.Test_Micro_Ops (1.0,
+                                        Data.Micro_Div_Operator_Table,
+                                        Data.Micro_Div_Operand_Table);
+
+   if Micro_Actual /= Micro_Expected then
+      Report.Failed ("Wrong result for type Micro division");
+   end if;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   Basic_Actual := 0.0;
+   Basic_Actual := Data.Test_Basic_Ops (1.0,
+                                        Data.Basic_Mult_Operator_Table,
+                                        Data.Basic_Mult_Operand_Table);
+
+   if Basic_Actual /= Basic_Expected then
+      Report.Failed ("Wrong result for type Basic multiplication");
+   end if;
+
+
+   Basic_Actual := 0.0;
+   Basic_Actual := Data.Test_Basic_Ops (1.0,
+                                        Data.Basic_Div_Operator_Table,
+                                        Data.Basic_Div_Operand_Table);
+
+   if Basic_Actual /= Basic_Expected then
+      Report.Failed ("Wrong result for type Basic division");
+   end if;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   Broad_Actual := 0.0;
+   Broad_Actual := Data.Test_Broad_Ops (1.0,
+                                        Data.Broad_Mult_Operator_Table,
+                                        Data.Broad_Mult_Operand_Table);
+
+   if Broad_Actual /= Broad_Expected then
+      Report.Failed ("Wrong result for type Broad multiplication");
+   end if;
+
+
+   Broad_Actual := 0.0;
+   Broad_Actual := Data.Test_Broad_Ops (1.0,
+                                        Data.Broad_Div_Operator_Table,
+                                        Data.Broad_Div_Operand_Table);
+
+   if Broad_Actual /= Broad_Expected then
+      Report.Failed ("Wrong result for type Broad division");
+   end if;
+
+               ---=---=---=---=---=---=---=---=---=---=---
+
+   Report.Result;
+
+end CXF2A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a
new file mode 100644
index 000000000..1b9abca15
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3001.a
@@ -0,0 +1,192 @@
+-- CXF3001.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 edited output string value returned by Function Image
+--      is correct.
+--
+-- TEST DESCRIPTION:
+--      This test is structured using tables of data, consisting of
+--      numerical values, picture strings, and expected image
+--      result strings.  
+--
+--      Each picture string is checked for validity, and an invalid picture 
+--      string will cause immediate test failure on its first pass through
+--      the evaluation loop.  Inside the evaluation loop, each decimal data 
+--      item is combined with each of the picture strings as parameters to a
+--      call to Image, and the result of each call is compared to an 
+--      expected edited output result string.
+--      
+--       
+-- CHANGE HISTORY:
+--      24 Feb 95   SAIC    Initial prerelease version.
+--      23 Jun 95   SAIC    Corrected call to functions Valid and To_Picture.
+--      22 Aug 95   SAIC    Test name changed to CXF3001 (from CXF3301) to
+--                          conform to naming conventions.
+--      24 Feb 97   CTA.PWB Corrected picture strings and expected results.
+--!
+
+with Ada.Text_IO.Editing;
+with Report;
+
+procedure CXF3001 is
+begin
+
+   Report.Test ("CXF3001", "Check that the string value returned by " &
+                           "Function Image is correct");
+
+   Test_Block:
+   declare
+
+      use Ada.Text_IO;
+
+      Number_Of_Decimal_Items    : constant := 5;
+      Number_Of_Picture_Strings  : constant := 4;
+      Number_Of_Expected_Results : constant := Number_Of_Decimal_Items *
+                                               Number_Of_Picture_Strings;
+
+      type String_Pointer_Type is access String;
+
+      -- Define a decimal data type, and instantiate the Decimal_Output 
+      -- generic package for the data type.
+
+      type Decimal_Data_Type is delta 0.01 digits 16;
+      package Ed_Out is new Editing.Decimal_Output (Decimal_Data_Type);
+
+      -- Define types for the arrays of data that will hold the decimal data 
+      -- values, picture strings, and expected edited output results.
+
+      type Decimal_Data_Array_Type is 
+        array (Integer range <>) of Decimal_Data_Type;
+
+      type Picture_String_Array_Type is 
+        array (Integer range <>) of String_Pointer_Type;
+
+      type Edited_Output_Results_Array_Type is 
+        array (Integer range <>) of String_Pointer_Type;
+
+      -- Define the data arrays for this test.
+
+      Decimal_Data : 
+        Decimal_Data_Array_Type(1..Number_Of_Decimal_Items) :=
+          ( 1 =>  5678.90,
+            2 => -6789.01,
+            3 =>     0.00,
+            4 =>     0.20,
+            5 =>     3.45
+          );
+
+      Picture_Strings : 
+        Picture_String_Array_Type(1..Number_Of_Picture_Strings) :=
+          ( 1 => new String'("-$$_$$9.99"),
+            2 => new String'("-$$_$$$.$$"),
+            3 => new String'("-ZZZZ.ZZ"),
+            4 => new String'("-$$$_999.99")
+          );
+
+      Edited_Output :
+        Edited_Output_Results_Array_Type(1..Number_Of_Expected_Results) := 
+          ( 1 => new String'(" $5,678.90"),    
+            2 => new String'(" $5,678.90"),
+            3 => new String'(" 5678.90"),     
+            4 => new String'("  $5,678.90"),  
+
+            5 => new String'("-$6,789.01"),
+            6 => new String'("-$6,789.01"),
+            7 => new String'("-6789.01"),
+            8 => new String'("- $6,789.01"),
+
+            9 => new String'("     $0.00"),
+           10 => new String'("          "),    
+           11 => new String'("        "),     
+           12 => new String'("   $ 000.00"),  
+
+           13 => new String'("     $0.20"),
+           14 => new String'("      $.20"),    
+           15 => new String'("     .20"),     
+           16 => new String'("   $ 000.20"),
+
+           17 => new String'("     $3.45"),
+           18 => new String'("     $3.45"),
+           19 => new String'("    3.45"),
+           20 => new String'("   $ 003.45")
+          );
+
+      TC_Picture    : Editing.Picture;
+      TC_Loop_Count : Natural := 0;
+
+   begin
+
+      -- Compare string result of Image with expected edited output string.  
+
+      Evaluate_Edited_Output:
+      for i in 1..Number_Of_Decimal_Items loop
+         for j in 1..Number_Of_Picture_Strings loop
+
+            TC_Loop_Count := TC_Loop_Count + 1;
+
+            -- Check on the validity of the picture strings prior to
+            -- processing.
+
+            if Editing.Valid(Picture_Strings(j).all) then
+
+               -- Create the picture object from the picture string.
+               TC_Picture := Editing.To_Picture(Picture_Strings(j).all);
+
+               -- Compare actual edited output result of Function Image with
+               -- the expected result.
+
+               if Ed_Out.Image(Decimal_Data(i), TC_Picture) /=
+                  Edited_Output(TC_Loop_Count).all
+               then
+                  Report.Failed("Incorrect result from Function Image, " &
+                                "when used with decimal data item # "    &
+                                Integer'Image(i)                         &
+                                " and picture string # "                  &
+                                Integer'Image(j));
+               end if;
+
+            else
+               Report.Failed("Picture String # " & Integer'Image(j) &
+                             "reported as being invalid");
+               -- Immediate test failure if a string is invalid.
+               exit Evaluate_Edited_Output;
+            end if;
+
+         end loop;
+      end loop Evaluate_Edited_Output;
+
+   exception
+      when Editing.Picture_Error =>
+         Report.Failed ("Picture_Error raised in Test_Block");
+      when Layout_Error          =>
+         Report.Failed ("Layout_Error raised in Test_Block");
+      when others                => 
+         Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a
new file mode 100644
index 000000000..8444244ef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3002.a
@@ -0,0 +1,231 @@
+-- CXF3002.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 functionality contained in package
+--      Ada.Wide_Text_IO.Editing is available and produces correct results.
+--
+-- TEST DESCRIPTION:
+--      This test is designed to validate the procedures and functions that
+--      are found in package Ada.Wide_Text_IO.Editing, the "wide" 
+--      complementary package to Ada.Text_IO.Editing.  The test is similar 
+--      to CXF3301, which tested a large portion of the Ada.Text_IO.Editing
+--      package.  Additional testing has been added here to cover the balance
+--      of the Wide_Text_IO.Editing child package.
+
+--      This test is structured using tables of data, consisting of
+--      numerical values, picture strings, and expected image
+--      result strings.  
+--
+--      Each picture string is checked for validity, and an invalid picture 
+--      string will cause immediate test failure on its first pass through
+--      the evaluation loop.  Inside the evaluation loop, each decimal data 
+--      item is combined with each of the picture strings as parameters to a
+--      call to Image, and the result of each call is compared to an 
+--      expected edited output result string.
+--
+--      Note: Each of the functions Valid, To_Picture, and Pic_String has
+--            String (rather than Wide_String) as its parameter or result
+--            subtype, since a picture String is not localizable.
+--      
+--       
+-- CHANGE HISTORY:
+--      22 Jun 95   SAIC    Initial prerelease version.
+--      22 Aug 95   SAIC    Test name changed to CXF3002 (from CXF3401) to 
+--                          conform with naming conventions.
+--      24 Feb 97   PWB.CTA Corrected picture strings and expected values.
+--!
+
+with Ada.Wide_Text_IO.Editing;
+with Report;
+
+procedure CXF3002 is
+begin
+
+   Report.Test ("CXF3002", "Check that the functionality contained " &
+                           "in package Ada.Wide_Text_IO.Editing is " &
+                           "available and produces correct results");
+
+   Test_Block:
+   declare
+
+      use Ada.Wide_Text_IO;
+
+      Number_Of_Decimal_Items    : constant := 5;
+      Number_Of_Picture_Strings  : constant := 4;
+      Number_Of_Expected_Results : constant := Number_Of_Decimal_Items *
+                                               Number_Of_Picture_Strings;
+
+      Def_Cur   : constant Wide_String    := "$";
+      Def_Fill  : constant Wide_Character := '*';
+      Def_Sep   : constant Wide_Character := Editing.Default_Separator;
+      Def_Radix : constant Wide_Character := Editing.Default_Radix_Mark;
+
+      type String_Pointer_Type      is access String;
+      type Wide_String_Pointer_Type is access Wide_String;
+
+      -- Define a decimal data type, and instantiate the Decimal_Output 
+      -- generic package for the data type.
+
+      type Decimal_Data_Type is delta 0.01 digits 16;
+
+      package Wide_Ed_Out is 
+        new Editing.Decimal_Output(Num                => Decimal_Data_Type,
+                                   Default_Currency   => Def_Cur,
+                                   Default_Fill       => Def_Fill,
+                                   Default_Separator  => Def_Sep,
+                                   Default_Radix_Mark => Def_Radix);
+
+      -- Define types for the arrays of data that will hold the decimal data 
+      -- values, picture strings, and expected edited output results.
+
+      type Decimal_Data_Array_Type is 
+        array (Integer range <>) of Decimal_Data_Type;
+
+      type Picture_String_Array_Type is 
+        array (Integer range <>) of String_Pointer_Type;
+
+      type Edited_Output_Results_Array_Type is 
+        array (Integer range <>) of Wide_String_Pointer_Type;
+
+      -- Define the data arrays for this test.
+
+      Decimal_Data : 
+        Decimal_Data_Array_Type(1..Number_Of_Decimal_Items) :=
+          ( 1 =>  5678.90,
+            2 => -6789.01,
+            3 =>     0.00,
+            4 =>     0.20,
+            5 =>     3.45
+          );
+
+      Picture_Strings : 
+        Picture_String_Array_Type(1..Number_Of_Picture_Strings) :=
+          ( 1 => new String'("-$$_$$9.99"),
+            2 => new String'("-$$_$$$.$$"),
+            3 => new String'("-ZZZZ.ZZ"),
+            4 => new String'("-$$$_999.99")
+          );
+
+
+      Edited_Output :
+        Edited_Output_Results_Array_Type(1..Number_Of_Expected_Results) := 
+          ( 1 => new Wide_String'(" $5,678.90"),    
+            2 => new Wide_String'(" $5,678.90"),    
+            3 => new Wide_String'(" 5678.90"),     
+            4 => new Wide_String'("  $5,678.90"),  
+
+            5 => new Wide_String'("-$6,789.01"),
+            6 => new Wide_String'("-$6,789.01"),
+            7 => new Wide_String'("-6789.01"),
+            8 => new Wide_String'("- $6,789.01"),
+
+            9 => new Wide_String'("     $0.00"),
+           10 => new Wide_String'("          "),    
+           11 => new Wide_String'("        "),     
+           12 => new Wide_String'("   $ 000.00"),  
+
+           13 => new Wide_String'("     $0.20"),
+           14 => new Wide_String'("      $.20"),    
+           15 => new Wide_String'("     .20"),     
+           16 => new Wide_String'("   $ 000.20"),
+
+           17 => new Wide_String'("     $3.45"),
+           18 => new Wide_String'("     $3.45"),
+           19 => new Wide_String'("    3.45"),
+           20 => new Wide_String'("   $ 003.45")
+          );
+
+      TC_Picture    : Editing.Picture;
+      TC_Loop_Count : Natural := 0;
+
+   begin
+
+      -- Compare string result of Image with expected edited output wide 
+      -- string.  
+
+      Evaluate_Edited_Output:
+      for i in 1..Number_Of_Decimal_Items loop
+         for j in 1..Number_Of_Picture_Strings loop
+
+            TC_Loop_Count := TC_Loop_Count + 1;
+
+            -- Check on the validity of the picture strings prior to
+            -- processing.
+
+            if Editing.Valid(Picture_Strings(j).all) then
+
+               -- Create the picture object from the picture string.
+               TC_Picture := Editing.To_Picture(Picture_Strings(j).all);
+
+               -- Check results of function Decimal_Output.Valid.
+               if not Wide_Ed_Out.Valid(Decimal_Data(i), TC_Picture) then
+                  Report.Failed("Incorrect result from function Valid "    &
+                                "when examining the picture string that "  &
+                                "was produced from string "                &
+                                Integer'Image(j) & " in conjunction with " &
+                                "decimal data item # " & Integer'Image(i));
+               end if;
+
+               -- Check results of function Editing.Pic_String.
+               if Editing.Pic_String(TC_Picture) /= Picture_Strings(j).all then
+                  Report.Failed("Incorrect result from To_Picture/"  &
+                                "Pic_String conversion for picture " &
+                                "string # " & Integer'Image(j));
+               end if;
+
+               -- Compare actual edited output result of Function Image with
+               -- the expected result.
+
+               if Wide_Ed_Out.Image(Decimal_Data(i), TC_Picture) /=
+                  Edited_Output(TC_Loop_Count).all
+               then
+                  Report.Failed("Incorrect result from Function Image, " &
+                                "when used with decimal data item # "    &
+                                Integer'Image(i)                         &
+                                " and picture string # "                  &
+                                Integer'Image(j));
+               end if;
+
+            else
+               Report.Failed("Picture String # " & Integer'Image(j) &
+                             "reported as being invalid");
+            end if;
+
+         end loop;
+      end loop Evaluate_Edited_Output;
+
+   exception
+      when Editing.Picture_Error =>
+         Report.Failed ("Picture_Error raised in Test_Block");
+      when Layout_Error          =>
+         Report.Failed ("Layout_Error raised in Test_Block");
+      when others                => 
+         Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a
new file mode 100644
index 000000000..7cfce618e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3003.a
@@ -0,0 +1,292 @@
+-- CXF3003.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 statically identifiable picture strings can be used to
+--      produce correctly formatted edited output.
+--      
+-- TEST DESCRIPTION:
+--      This test defines several picture strings that are statically
+--      identifiable, (i.e.,  Pic : Picture := To_Picture("..."); ).
+--      These picture strings are used in conjunction with decimal data
+--      as parameters in calls to functions Valid and Image.  These
+--      functions are created by an instantiation of the generic package
+--      Ada.Text_IO.Editing.Decimal_Output.
+--
+--       
+-- CHANGE HISTORY:
+--      04 Apr 96   SAIC    Initial release for 2.1.
+--      13 Feb 97   PWB.CTA corrected incorrect picture strings.
+--!
+
+with Report;
+with Ada.Text_IO.Editing;
+with Ada.Exceptions;
+
+procedure CXF3003 is
+begin
+
+   Report.Test ("CXF3003", "Check that statically identifiable "     &
+                           "picture strings can be used to produce " &
+                           "correctly formatted edited output");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+      use Ada.Text_IO.Editing;
+
+      Def_Cur   : constant String    := "$";
+      Def_Fill  : constant Character := '*';
+      Def_Sep   : constant Character := Default_Separator;
+      Def_Radix : constant Character := 
+                    Ada.Text_IO.Editing.Default_Radix_Mark;
+
+      type Str_Ptr is access String;
+      type Edited_Output_Array_Type is array (Integer range <>) of Str_Ptr;
+
+      -- Define a decimal data type, and instantiate the Decimal_Output 
+      -- generic package for the data type.
+
+      type Decimal_Data_Type is delta 0.01 digits 16;
+
+      package Image_IO is 
+        new Decimal_Output(Num                => Decimal_Data_Type,
+                           Default_Currency   => Def_Cur,
+                           Default_Fill       => '*',
+                           Default_Separator  => Default_Separator,
+                           Default_Radix_Mark => Def_Radix);
+
+
+      type Decimal_Data_Array_Type is 
+        array (Integer range <>) of Decimal_Data_Type;
+
+      Decimal_Data : Decimal_Data_Array_Type(1..5) :=
+          (1 =>  1357.99,
+           2 => -9029.01,
+           3 =>     0.00,
+           4 =>     0.20,
+           5 =>     3.45);
+
+      -- Statically identifiable picture strings.
+
+      Picture_1  : Picture := To_Picture("-$$_$$9.99"); 
+      Picture_2  : Picture := To_Picture("-$$_$$$.$$"); 
+      Picture_3  : Picture := To_Picture("-ZZZZ.ZZ");
+      Picture_5  : Picture := To_Picture("-$$$_999.99");
+      Picture_6  : Picture := To_Picture("-###**_***_**9.99");
+      Picture_7  : Picture := To_Picture("-$**_***_**9.99");
+      Picture_8  : Picture := To_Picture("-$$$$$$.$$");
+      Picture_9  : Picture := To_Picture("-$$$$$$.$$");
+      Picture_10 : Picture := To_Picture("+BBBZZ_ZZZ_ZZZ.ZZ");
+      Picture_11 : Picture := To_Picture("--_---_---_--9");
+      Picture_12 : Picture := To_Picture("-$_$$$_$$$_$$9.99");
+      Picture_14 : Picture := To_Picture("$_$$9.99");
+      Picture_15 : Picture := To_Picture("$$9.99");
+
+
+      Picture_1_Output : Edited_Output_Array_Type(1..5) :=
+          ( 1 => new String'(" $1,357.99"),      
+            2 => new String'("-$9,029.01"),    
+            3 => new String'("     $0.00"),
+            4 => new String'("     $0.20"),
+            5 => new String'("     $3.45"));
+
+      Picture_2_Output : Edited_Output_Array_Type(1..5) :=
+           (1 => new String'(" $1,357.99"),      
+            2 => new String'("-$9,029.01"),    
+            3 => new String'("          "),    
+            4 => new String'("      $.20"),    
+            5 => new String'("     $3.45"));
+
+      Picture_3_Output : Edited_Output_Array_Type(1..5) :=
+           (1 => new String'(" 1357.99"),       
+            2 => new String'("-9029.01"),
+            3 => new String'("        "),     
+            4 => new String'("     .20"),     
+            5 => new String'("    3.45"));
+
+      Picture_5_Output : Edited_Output_Array_Type(1..5) := 
+           (1 => new String'("  $1,357.99"),
+            2 => new String'("- $9,029.01"),
+            3 => new String'("   $ 000.00"),  
+            4 => new String'("   $ 000.20"),
+            5 => new String'("   $ 003.45"));
+
+   begin
+
+      -- Check the results of function Valid, using the first five decimal
+      -- data items and picture strings.
+
+      if not Image_IO.Valid(Decimal_Data(1), Picture_1) then
+         Report.Failed("Picture string 1 not valid");
+      elsif not Image_IO.Valid(Decimal_Data(2), Picture_2) then
+         Report.Failed("Picture string 2 not valid");
+      elsif not Image_IO.Valid(Decimal_Data(3), Picture_3) then
+         Report.Failed("Picture string 3 not valid");
+      elsif not Image_IO.Valid(Decimal_Data(5), Picture_5) then
+         Report.Failed("Picture string 5 not valid");
+      end if;
+
+
+      -- Check the results of function Image, using the picture strings
+      -- constructed above, with a variety of named vs. positional
+      -- parameter notation and defaulted parameters.
+
+      for i in 1..5 loop
+         if Image_IO.Image(Item => Decimal_Data(i), Pic => Picture_1) /=
+            Picture_1_Output(i).all
+         then
+            Report.Failed("Incorrect result from function Image with "    &
+                          "decimal data item #" & Integer'Image(i) & ", " &
+                          "combined with Picture_1 picture string."       &
+                          "Expected: " & Picture_1_Output(i).all & ", "   &
+                          "Found: " &
+                          Image_IO.Image(Decimal_Data(i),Picture_1));
+         end if;
+
+         if Image_IO.Image(Decimal_Data(i), Pic => Picture_2) /=
+            Picture_2_Output(i).all
+         then
+            Report.Failed("Incorrect result from function Image with "    &
+                          "decimal data item #" & Integer'Image(i) & ", " &
+                          "combined with Picture_2 picture string."       &
+                          "Expected: " & Picture_2_Output(i).all & ", "   &
+                          "Found: " &
+                          Image_IO.Image(Decimal_Data(i),Picture_2));
+         end if;
+
+         if Image_IO.Image(Decimal_Data(i), Picture_3) /=
+            Picture_3_Output(i).all
+         then
+            Report.Failed("Incorrect result from function Image with "    &
+                          "decimal data item #" & Integer'Image(i) & ", " &
+                          "combined with Picture_3 picture string."       &
+                          "Expected: " & Picture_3_Output(i).all & ", "   &
+                          "Found: " &
+                          Image_IO.Image(Decimal_Data(i),Picture_3));
+         end if;
+
+         if Image_IO.Image(Decimal_Data(i), Picture_5) /=
+            Picture_5_Output(i).all
+         then
+            Report.Failed("Incorrect result from function Image with "    &
+                          "decimal data item #" & Integer'Image(i) & ", " &
+                          "combined with Picture_5 picture string."       &
+                          "Expected: " & Picture_5_Output(i).all & ", "   &
+                          "Found: " &
+                          Image_IO.Image(Decimal_Data(i),Picture_5));
+         end if;
+      end loop;
+
+
+      if Image_IO.Image(Item       => 123456.78, 
+                        Pic        => Picture_6,
+                        Currency   => "$",
+                        Fill       => Def_Fill,
+                        Separator  => Def_Sep,
+                        Radix_Mark => Def_Radix) /= "   $***123,456.78"
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_6");
+      end if;
+
+      if Image_IO.Image(123456.78, 
+                        Pic        => Picture_7,
+                        Currency   => Def_Cur,
+                        Fill       => '*',
+                        Separator  => Def_Sep,
+                        Radix_Mark => Def_Radix) /= " $***123,456.78"
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_7");
+      end if;
+
+      if Image_IO.Image(0.0, 
+                        Picture_8,
+                        Currency   => "$",
+                        Fill       => '*',
+                        Separator  => Def_Sep,
+                        Radix_Mark => Def_Radix) /= "          "
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_8");
+      end if;
+
+      if Image_IO.Image(0.20, 
+                        Picture_9,
+                        Def_Cur,
+                        Fill       => Def_Fill,
+                        Separator  => Default_Separator,
+                        Radix_Mark => Default_Radix_Mark) /= "      $.20"
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_9");
+      end if;
+
+      if Image_IO.Image(123456.00,
+                        Picture_10,
+                        "$",
+                        '*',
+                        Separator  => Def_Sep,
+                        Radix_Mark => Def_Radix) /= "+      123,456.00"
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_10");
+      end if;
+
+      if Image_IO.Image(-123456.78,
+                        Picture_11,
+                        Default_Currency,
+                        Default_Fill,
+                        Default_Separator,
+                        Radix_Mark => Def_Radix) /= "      -123,457"
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_11");
+      end if;
+
+      if Image_IO.Image(123456.78, Picture_12, "$", '*', ',', '.') /= 
+         "      $123,456.78"
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_12");
+      end if;
+
+      if Image_IO.Image(1.23,
+                        Picture_14,
+                        Currency => Def_Cur,
+                        Fill     => Def_Fill) /= "   $1.23"
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_14");
+      end if;
+
+      if Image_IO.Image(12.34, Pic => Picture_15) /= "$12.34"
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_15");
+      end if;
+
+   exception
+      when The_Error : others => 
+         Report.Failed("The following exception was raised in the " &
+                       "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a
new file mode 100644
index 000000000..146047bc8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3004.a
@@ -0,0 +1,257 @@
+-- CXF3004.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 statically identifiable picture strings can be used
+--      in conjunction with function Image to produce output strings 
+--      appropriate to foreign currency representations.
+--
+--      Check that statically identifiable picture strings will cause
+--      function Image to raise Layout_Error under the appropriate 
+--      conditions.
+--      
+-- TEST DESCRIPTION:
+--      This test defines several picture strings that are statically
+--      identifiable, (i.e.,  Pic : Picture := To_Picture("..."); ).
+--      These picture strings are used in conjunction with decimal data
+--      as parameters in calls to function Image.  
+--
+--       
+-- CHANGE HISTORY:
+--      11 Apr 96   SAIC    Initial release for 2.1.
+--
+--!
+
+with Report;
+with Ada.Text_IO.Editing;
+with Ada.Exceptions;
+
+procedure CXF3004 is
+begin
+
+   Report.Test ("CXF3004", "Check that statically identifiable "        &
+                           "picture strings will cause function Image " &
+                           "to raise Layout_Error under appropriate "   &
+                           "conditions");
+
+   Test_Block:
+   declare
+
+      use Ada.Exceptions;
+      use Ada.Text_IO.Editing;
+
+      FF_Currency  : constant String    := "FF";
+      DM_Currency  : constant String    := "DM";
+      FF_Separator : constant Character := '.';
+      DM_Separator : constant Character := ',';
+      FF_Radix     : constant Character := ',';
+      DM_Radix     : constant Character := '.';
+      Blank_Fill   : constant Character := ' ';
+      Star_Fill    : constant Character := '*';
+
+
+      -- Define a decimal data type, and instantiate the Decimal_Output 
+      -- generic package for the data type.
+
+      type Decimal_Data_Type is delta 0.01 digits 16;
+
+      package Image_IO is 
+        new Decimal_Output(Num                => Decimal_Data_Type,
+                           Default_Currency   => "$",
+                           Default_Fill       => Star_Fill,
+                           Default_Separator  => Default_Separator,
+                           Default_Radix_Mark => DM_Radix);
+
+
+
+      -- The following decimal data items are used with picture strings 
+      -- in evaluating use of foreign currency symbols.
+
+      Dec_Data_1 : Decimal_Data_Type := 123456.78;
+      Dec_Data_2 : Decimal_Data_Type :=     32.10;
+      Dec_Data_3 : Decimal_Data_Type :=  -1234.57;
+      Dec_Data_4 : Decimal_Data_Type := 123456.78;
+      Dec_Data_5 : Decimal_Data_Type :=     12.34;
+      Dec_Data_6 : Decimal_Data_Type :=     12.34;
+      Dec_Data_7 : Decimal_Data_Type :=  12345.67;
+
+
+      -- Statically identifiable picture strings.
+      -- These strings are used in conjunction with non-default values 
+      -- for Currency string, Radix mark, and Separator in calls to
+      -- function Image.
+
+      Picture_1 : Picture := To_Picture("-###**_***_**9.99");    -- FF
+      Picture_2 : Picture := To_Picture("###z_ZZ9.99");          -- FF
+      Picture_3 : Picture := To_Picture("<<<<_<<<.<<###>");      -- DM
+      Picture_4 : Picture := To_Picture("-$_$$$_$$$_$$9.99");    -- DM
+      Picture_5 : Picture := To_Picture("$Zz9.99");              -- DM
+      Picture_6 : Picture := To_Picture("$$$9.99");              -- DM
+      Picture_7 : Picture := To_Picture("###_###_##9.99");       -- CHF
+
+
+      -- The following ten edited output strings correspond to the ten
+      -- foreign currency picture strings.
+
+      Output_1 : constant String := "  FF***123.456,78";
+      Output_2 : constant String := " FF   32,10";
+      Output_3 : constant String := "  (1,234.57DM )";
+      Output_4 : constant String := "      DM123,456.78"; 
+      Output_5 : constant String := "DM 12.34";
+      Output_6 : constant String := " DM12.34";
+      Output_7 : constant String := "  CHF12,345.67";
+
+
+   begin
+
+      -- Check the results of function Image, using the picture strings
+      -- constructed above, in creating foreign currency edited output
+      -- strings.
+
+      if Image_IO.Image(Item       => Dec_Data_1,
+                        Pic        => Picture_1,
+                        Currency   => FF_Currency,
+                        Fill       => Star_Fill,
+                        Separator  => FF_Separator,
+                        Radix_Mark => FF_Radix) /= Output_1
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_1");
+      end if;
+
+      if Image_IO.Image(Item       => Dec_Data_2,
+                        Pic        => Picture_2,
+                        Currency   => FF_Currency,
+                        Fill       => Blank_Fill,
+                        Separator  => FF_Separator,
+                        Radix_Mark => FF_Radix) /= Output_2
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_2");
+      end if;
+
+      if Image_IO.Image(Item       => Dec_Data_3,
+                        Pic        => Picture_3,
+                        Currency   => DM_Currency,
+                        Fill       => Blank_Fill,
+                        Separator  => DM_Separator,
+                        Radix_Mark => DM_Radix) /= Output_3
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_3");
+      end if;
+
+      if Image_IO.Image(Item       => Dec_Data_4,
+                        Pic        => Picture_4,
+                        Currency   => DM_Currency,
+                        Fill       => Blank_Fill,
+                        Separator  => DM_Separator,
+                        Radix_Mark => DM_Radix) /= Output_4
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_4");
+      end if;
+
+      if Image_IO.Image(Item       => Dec_Data_5,
+                        Pic        => Picture_5,
+                        Currency   => DM_Currency,
+                        Fill       => Blank_Fill,
+                        Separator  => DM_Separator,
+                        Radix_Mark => DM_Radix) /= Output_5
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_5");
+      end if;
+
+      if Image_IO.Image(Item       => Dec_Data_6,
+                        Pic        => Picture_6,
+                        Currency   => DM_Currency,
+                        Fill       => Blank_Fill,
+                        Separator  => DM_Separator,
+                        Radix_Mark => DM_Radix) /= Output_6
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_6");
+      end if;
+
+      if Image_IO.Image(Item       => Dec_Data_7,
+                        Pic        => Picture_7,
+                        Currency   => "CHF",
+                        Fill       => Blank_Fill,
+                        Separator  => ',',
+                        Radix_Mark => '.') /= Output_7
+      then
+         Report.Failed("Incorrect result from Fn. Image using Picture_7");
+      end if;
+
+
+      -- The following calls of Function Image, using the specific
+      -- decimal values and picture strings provided, will cause 
+      -- a Layout_Error to be raised.
+      -- Note: The data and the picture strings used in the following 
+      --       evaluations are not themselves erroneous, but when used in
+      --       combination will cause Layout_Error to be raised.
+
+      Exception_Block_1 :
+      declare
+         Erroneous_Data_1    : Decimal_Data_Type :=  12.34;
+         Erroneous_Picture_1 : Picture := To_Picture("9.99");
+         N         : constant Natural := Image_IO.Length(Erroneous_Picture_1);
+         TC_String : String(1..N);
+      begin
+         TC_String := Image_IO.Image(Erroneous_Data_1, Erroneous_Picture_1);
+         Report.Failed("Layout_Error not raised by combination of "  &
+                       "Erroneous_Picture_1 and Erroneous_Data_1");
+         Report.Comment("Should never be printed: " & TC_String);
+      exception
+         when Ada.Text_IO.Layout_Error => null; -- OK, expected exception.
+         when The_Error : others       => 
+            Report.Failed
+              ("The following exception was incorrectly raised in " &
+               "Exception_Block_1: " & Exception_Name(The_Error));
+      end Exception_Block_1;
+  
+      Exception_Block_2 :
+      declare
+         Erroneous_Data_2    : Decimal_Data_Type :=  -12.34;
+         Erroneous_Picture_2 : Picture := To_Picture("99.99");
+         N         : constant Natural := Image_IO.Length(Erroneous_Picture_2);
+         TC_String : String(1..N);
+      begin
+         TC_String := Image_IO.Image(Erroneous_Data_2, Erroneous_Picture_2);
+         Report.Failed("Layout_Error not raised by combination of "  &
+                       "Erroneous_Picture_2 and Erroneous_Data_2");
+         Report.Comment("Should never be printed: " & TC_String);
+      exception
+         when Ada.Text_IO.Layout_Error => null; -- OK, expected exception.
+         when The_Error : others       => 
+            Report.Failed
+              ("The following exception was incorrectly raised in " &
+               "Exception_Block_2: " & Exception_Name(The_Error));
+      end Exception_Block_2;
+  
+   exception
+      when The_Error : others => 
+         Report.Failed("The following exception was raised in the " &
+                       "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a
new file mode 100644
index 000000000..202a6996e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a01.a
@@ -0,0 +1,167 @@
+-- CXF3A01.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 function Ada.Text_IO.Editing.Valid returns False if
+--         a) Pic_String is not a well-formed Picture string, or
+--         b) the length of Pic_String exceeds Max_Picture_Length, or
+--         c) Blank_When_Zero is True and Pic_String contains '*';
+--      Check that Valid otherwise returns True.
+--
+-- TEST DESCRIPTION:
+--      This test validates the results of function Editing.Valid under a 
+--      variety of conditions.  Both valid and invalid picture strings are
+--      provided as input parameters to the function.  The use of the 
+--      Blank_When_Zero parameter is evaluated with strings that contain the
+--      zero suppression character '*'.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXF3A00.A   (foundation code)
+--      => CXF3A01.A
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FXF3A00;
+with Ada.Text_IO.Editing;
+with Report;
+
+procedure CXF3A01 is
+begin
+
+   Report.Test ("CXF3A01", "Check that the Valid function from package "    &
+                           "Ada.Text_IO.Editing returns False for strings " &
+                           "that fail to comply with the composition "      &
+                           "constraints defined for picture strings. "      &
+                           "Check that the Valid function returns True "    &
+                           "for strings that conform to the composition "   &
+                           "constraints defined for picture strings");
+
+   Test_Block:
+   declare
+      use FXF3A00;
+      use Ada.Text_IO;
+   begin
+
+      -- Use a series of picture strings that conform to the composition
+      -- constraints to validate the Ada.Text_IO.Editing.Valid function.
+      -- The result for each of these calls should be True.
+      -- In all the following cases, the default value of the Blank_When_Zero
+      -- parameter is used.
+
+      for i in 1..FXF3A00.Number_Of_Valid_Strings loop
+
+         if not Editing.Valid(Pic_String => FXF3A00.Valid_Strings(i).all) 
+         then
+            Report.Failed("Incorrect result from Function Valid using " &
+                          "Valid_String = " & FXF3A00.Valid_Strings(i).all); 
+         end if;
+
+      end loop;
+
+
+      for i in 1..FXF3A00.Number_Of_Foreign_Strings loop
+
+         if not Editing.Valid(Pic_String => FXF3A00.Foreign_Strings(i).all) 
+         then
+            Report.Failed("Incorrect result from Function Valid using " &
+                          "Foreign_String = " & 
+                          FXF3A00.Foreign_Strings(i).all);
+         end if;
+
+      end loop;
+
+
+      -- Use a series of picture strings that violate one or more of the 
+      -- composition constraints to validate the Ada.Text_IO.Editing.Valid
+      -- function.  The result for each of these calls should be False.
+      -- In all the following cases, the default value of the Blank_When_Zero
+      -- parameter is used.
+
+      for i in 1..FXF3A00.Number_Of_Invalid_Strings loop
+
+         if Editing.Valid(Pic_String => FXF3A00.Invalid_Strings(i).all) 
+         then
+            Report.Failed("Incorrect result from Function Valid using " &
+                          "Invalid_String = " & 
+                          FXF3A00.Invalid_Strings(i).all);
+         end if;
+
+      end loop;
+
+
+      -- In all the following cases, the default value of the Blank_When_Zero
+      -- parameter is overridden with a True actual parameter value.  Using
+      -- valid picture strings that contain the '*' zero suppression character 
+      -- when this parameter value is True must result in a False result
+      -- from function Valid.  Valid picture strings that do not contain the
+      -- '*' character should return a function result of True with True
+      -- provided as the actual parameter to Blank_When_Zero.
+
+      -- Check entries 1, 2, 25, 36 from the Valid_Strings array, all of
+      -- which contain the '*' zero suppression character.
+
+      if Editing.Valid(Valid_Strings(1).all,  Blank_When_Zero => True) or
+         Editing.Valid(Valid_Strings(2).all,  Blank_When_Zero => True) or
+         Editing.Valid(Valid_Strings(25).all, Blank_When_Zero => True) or
+         Editing.Valid(Valid_Strings(36).all, Blank_When_Zero => True) 
+      then
+         Report.Failed
+           ("Incorrect result from Function Valid when setting "   &
+            "the value of the Blank_When_Zero parameter to True, " &
+            "and using picture strings with the '*' character");
+      end if;
+
+
+      -- Check entries from the Valid_Strings array, none of
+      -- which contain the '*' zero suppression character.
+
+      for i in 3..24 loop
+
+         if not Editing.Valid(Pic_String      => Valid_Strings(i).all,  
+                              Blank_When_Zero => True)
+         then
+            Report.Failed("Incorrect result from Function Valid when "    &
+                          "setting the value of the Blank_When_Zero "     &
+                          "parameter to True, and using picture strings " &
+                          "without the '*' character, Valid_String = "    &
+                          FXF3A00.Valid_Strings(i).all);
+         end if;
+
+      end loop;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3A01;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a
new file mode 100644
index 000000000..4231b56aa
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a02.a
@@ -0,0 +1,267 @@
+-- CXF3A02.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 function Ada.Text_IO.Editing.To_Picture raises
+--      Picture_Error if the picture string provided as input parameter does
+--      not conform to the composition constraints defined for picture 
+--      strings.
+--      Check that when Pic_String is applied to To_Picture, the result
+--      is equivalent to the actual string parameter of To_Picture; 
+--      Check that when Blank_When_Zero is applied to To_Picture, the result
+--      is the same value as the Blank_When_Zero parameter of To_Picture.
+--      
+-- TEST DESCRIPTION:
+--      This test validates that function Editing.To_Picture returns a 
+--      Picture result when provided a valid picture string, and raises a
+--      Picture_Error exception when provided an invalid picture string
+--      input parameter.  In addition, the Picture result of To_Picture is
+--      converted back to a picture string value using function Pic_String,
+--      and the result of function Blank_When_Zero is validated based on the
+--      value of parameter Blank_When_Zero used in the formation of the Picture
+--      by function To_Picture.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXF3A00.A   (foundation code)
+--      => CXF3A02.A
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      11 Mar 97   PWB.CTA Corrected invalid picture string and uppercase
+--                          problem.
+--!
+
+with FXF3A00;
+with Ada.Text_IO.Editing;
+with Ada.Strings.Maps;
+with Ada.Strings.Fixed;
+with Report;
+
+procedure CXF3A02 is
+
+   Lower_Alpha : constant String := "abcdefghijklmnopqrstuvwxyz";
+   Upper_Alpha : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+   function UpperCase ( Source : String ) return String is
+   begin
+      return
+         Ada.Strings.Fixed.Translate
+            ( Source  => Source, 
+              Mapping => Ada.Strings.Maps.To_Mapping 
+                            ( From => Lower_Alpha, 
+                              To => Upper_Alpha ) );
+   end UpperCase;
+
+begin
+
+   Report.Test ("CXF3A02", "Check that the function "                       &
+                           "Ada.Text_IO.Editing.To_Picture raises "         &
+                           "Picture_Error if the picture string provided "  &
+                           "as input parameter does not conform to the "    &
+                           "composition constraints defined for picture "   &
+                           "strings");
+
+   Test_Block:
+   declare
+
+      use Ada.Text_IO;
+      use FXF3A00;
+
+      TC_Picture         : Editing.Picture;
+      TC_Blank_When_Zero : Boolean;
+
+   begin
+
+
+      -- Validate that function To_Picture does not raise Picture_Error when
+      -- provided a valid picture string as an input parameter.
+
+      for i in 1..FXF3A00.Number_Of_Valid_Strings loop
+         begin
+            TC_Picture := 
+              Editing.To_Picture(Pic_String      => Valid_Strings(i).all,
+                                 Blank_When_Zero => False );
+         exception
+            when Editing.Picture_Error => 
+              Report.Failed
+              ("Picture_Error raised by function To_Picture "     &
+               "with a valid picture string as input parameter, " &
+               "Valid_String = " & FXF3A00.Valid_Strings(i).all);
+            when others => 
+              Report.Failed("Unexpected exception raised - 1, " &
+                            "Valid_String = " & FXF3A00.Valid_Strings(i).all);
+         end;
+      end loop;
+
+
+
+      -- Validate that function To_Picture raises Picture_Error when an
+      -- invalid picture string is provided as an input parameter.
+      -- Default value used for parameter Blank_When_Zero.
+
+      for i in 1..FXF3A00.Number_Of_Invalid_Strings loop
+         begin
+            TC_Picture := 
+              Editing.To_Picture(Pic_String => FXF3A00.Invalid_Strings(i).all);
+            Report.Failed
+              ("Picture_Error not raised by function To_Picture "    &
+               "with an invalid picture string as input parameter, " &
+               "Invalid_String = " & FXF3A00.Invalid_Strings(i).all);
+         exception
+            when Editing.Picture_Error => null;  -- OK, expected exception.
+            when others                => 
+              Report.Failed("Unexpected exception raised, " & 
+                            "Invalid_String = "             &
+                            FXF3A00.Invalid_Strings(i).all);
+         end;
+      end loop;
+
+
+
+      -- Validate that To_Picture and Pic_String/Blank_When_Zero provide 
+      -- "inverse" results.
+
+      -- Use the default value of the Blank_When_Zero parameter (False) for 
+      -- these evaluations (some valid strings have the '*' zero suppression
+      -- character, which would result in an invalid string if used with a
+      -- True value for the Blank_When_Zero parameter).
+
+      for i in 1..FXF3A00.Number_Of_Valid_Strings loop
+         begin
+
+            -- Format a picture string using function To_Picture.
+
+            TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
+
+            -- Reconvert the Picture result from To_Picture to a string value
+            -- using function Pic_String, and compare to the original string.
+
+            if Editing.Pic_String(Pic => TC_Picture) /= 
+               Uppercase (FXF3A00.Valid_Strings(i).all)
+            then
+               Report.Failed
+                 ("Inverse result incorrect from Editing.Pic_String, " &
+                  "Valid_String = " & FXF3A00.Valid_Strings(i).all);
+            end if;
+
+            -- Ensure that function Blank_When_Zero returns the correct value
+            -- of the Blank_When_Zero parameter used in forming the Picture 
+            -- (default parameter value False used in call to To_Picture 
+            -- above).
+
+            if Editing.Blank_When_Zero(Pic => TC_Picture) then
+               Report.Failed
+                 ("Inverse result incorrect from Editing.Blank_When_Zero, " &
+                  "Valid_String = " & FXF3A00.Valid_Strings(i).all);
+            end if;
+
+         exception
+            when others => 
+              Report.Failed("Unexpected exception raised - 2, " &
+                            "Valid_String = " & FXF3A00.Valid_Strings(i).all);
+         end;
+      end loop;
+
+
+      -- Specifically check that any lower case letters in the original
+      -- picture string have been converted to upper case form following
+      -- the To_Picture/Pic_String conversion (as shown in previous loop).
+
+      declare
+         The_Picture         : Editing.Picture;
+         The_Picture_String  : constant String := "+bBbZz_zZz_Zz9.99";
+         The_Expected_Result : constant String := "+BBBZZ_ZZZ_ZZ9.99";
+      begin
+         -- Convert Picture String to Picture.
+         The_Picture := Editing.To_Picture(Pic_String => The_Picture_String);
+
+         declare
+            -- Reconvert the Picture to a Picture String.
+            The_Result : constant String := Editing.Pic_String(The_Picture);
+         begin
+            if The_Result /= The_Expected_Result then
+               Report.Failed("Conversion to Picture/Reconversion to String " &
+                             "did not produce expected result when Picture " &
+                             "String had lower case letters");
+            end if;
+         end;
+      end;
+
+
+      -- Use a value of True for the Blank_When_Zero parameter for the 
+      -- following evaluations (picture strings that do not have the '*' zero 
+      -- suppression character, which would result in an invalid string when 
+      -- used here with a True value for the Blank_When_Zero parameter).
+
+      for i in 3..24 loop
+         begin
+
+            -- Format a picture string using function To_Picture.
+
+            TC_Picture := 
+              Editing.To_Picture(Pic_String      => Valid_Strings(i).all,
+                                 Blank_When_Zero => True);
+
+            -- Reconvert the Picture result from To_Picture to a string value
+            -- using function Pic_String, and compare to the original string.
+
+            if Editing.Pic_String(Pic => TC_Picture) /= 
+               UpperCase (FXF3A00.Valid_Strings(i).all)
+            then
+               Report.Failed
+                 ("Inverse result incorrect from Editing.Pic_String, used "   &
+                  "on Picture formed with parameter Blank_When_Zero = True, " &
+                  "Valid_String = " & FXF3A00.Valid_Strings(i).all);
+            end if;
+
+            -- Ensure that function Blank_When_Zero returns the correct value
+            -- of the Blank_When_Zero parameter used in forming the Picture 
+            -- (default parameter value False overridden in call to 
+            -- To_Picture above).
+
+            if not Editing.Blank_When_Zero(Pic => TC_Picture) then
+               Report.Failed
+                 ("Inverse result incorrect from Editing.Blank_When_Zero, "  &
+                  "used on a Picture formed with parameter Blank_When_Zero " & 
+                  "= True, Valid_String = " & FXF3A00.Valid_Strings(i).all);
+            end if;
+
+         exception
+            when others => 
+              Report.Failed("Unexpected exception raised - 3, " &
+                            "Valid_String = " & FXF3A00.Valid_Strings(i).all);
+         end;
+      end loop;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3A02;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a
new file mode 100644
index 000000000..867096014
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a03.a
@@ -0,0 +1,429 @@
+-- CXF3A03.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 function Length in the generic package Decimal_Output
+--      returns the number of characters in the edited output string 
+--      produced by function Image, for a particular decimal type, 
+--      currency string, and radix mark.
+--      Check that function Valid in the generic package Decimal_Output 
+--      returns correct results based on the particular decimal value, 
+--      and the Picture and Currency string parameters.
+--      
+-- TEST DESCRIPTION:
+--      This test uses two instantiations of package Decimal_Output, one
+--      for decimal data with delta 0.01, the other for decimal data with
+--      delta 1.0. The functions Length and Valid found in this generic 
+--      package are evaluated for each instantiation.
+--      Function Length is examined with picture and currency string input
+--      parameters of different sizes.
+--      Function Valid is examined with a decimal type data item, picture
+--      object, and currency string, for cases that are both valid and
+--      invalid (Layout_Error would result from the particular items as
+--      input parameters to function Image).
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXF3A00.A   (foundation code)
+--      => CXF3A03.A
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with FXF3A00;
+with Ada.Text_IO.Editing;
+with Report;
+
+procedure CXF3A03 is
+begin
+
+   Report.Test ("CXF3A03", "Check that function Length returns the "     &
+                           "number of characters in the edited output "  &
+                           "string produced by function Image, for a "   &
+                           "particular decimal type, currency string, "  &
+                           "and radix mark.  Check that function Valid " &
+                           "returns correct results based on the "       &
+                           "particular decimal value, and the Picture "  &
+                           "and Currency string parameters");
+
+   Test_Block:
+   declare
+
+      use Ada.Text_IO;
+      use FXF3A00;
+
+      type Instantiation_Type is (NDP, TwoDP);
+
+      -- Defaults used for all other generic parameters in these
+      -- instantiations.
+      package Pack_NDP is new Editing.Decimal_Output (Decimal_Type_NDP);
+      package Pack_2DP is new Editing.Decimal_Output (Decimal_Type_2DP);
+
+      TC_Lower_Bound,
+      TC_Higher_Bound : Integer := 0;
+
+      TC_Picture      : Editing.Picture;
+      TC_US_String    : constant String := "$";
+      TC_FF_String    : constant String := "FF";
+      TC_DM_String    : constant String := "DM";
+      TC_CHF_String   : constant String := "CHF";
+
+
+      function Dollar_Sign_Present (Str : String) return Boolean is
+      begin
+         for i in 1..Str'Length loop
+            if Str(i) = '$' then
+               return True;
+            end if;
+         end loop;
+         return False;
+      end Dollar_Sign_Present;
+
+      function V_Present (Str : String) return Boolean is
+      begin
+         for i in 1..Str'Length loop
+            if Str(i) = 'V' or Str(i) = 'v' then
+               return True;
+            end if;
+         end loop;
+         return False;
+      end V_Present;
+
+
+      function Accurate_Length (Pict_Str        : String;
+                                Inst            : Instantiation_Type;
+                                Currency_String : String) 
+        return Boolean is
+
+         TC_Length                     : Natural := 0;
+         TC_Currency_Length_Adjustment : Natural := 0;
+         TC_Radix_Adjustment           : Natural := 0;
+      begin
+
+         -- Create the picture object from the picture string.
+         TC_Picture := Editing.To_Picture(Pict_Str);
+
+         -- Calculate the currency length adjustment.
+         if Dollar_Sign_Present (Editing.Pic_String(TC_Picture)) then
+            TC_Currency_Length_Adjustment := Currency_String'Length - 1;
+         end if;
+
+         -- Calculate the Radix adjustment.
+         if V_Present (Editing.Pic_String(TC_Picture)) then
+            TC_Radix_Adjustment := 1;
+         end if;
+
+         -- Calculate the length, using the version of Length that comes
+         -- from the appropriate instantiation of Decimal_Output, based
+         -- on the decimal type used in the instantiation.
+         if Inst = NDP then
+            TC_Length  := Pack_NDP.Length(TC_Picture,
+                                          Currency_String);
+         else
+            TC_Length  := Pack_2DP.Length(TC_Picture,
+                                          Currency_String);
+         end if;
+
+         return TC_Length = Editing.Pic_String(TC_Picture)'Length +
+                              TC_Currency_Length_Adjustment       -
+                              TC_Radix_Adjustment;
+      end Accurate_Length;
+
+
+   begin
+
+      Length_Block:
+      begin
+
+         -- The first 10 picture strings in the Valid_Strings array correspond
+         -- to data values of a decimal type with delta 0.01. 
+         -- Note: The appropriate instantiation of the Decimal_Output package 
+         --       (and therefore function Length) is used by function 
+         --       Accurate_Length to calculate length.
+
+         for i in 1..10 loop
+            if not Accurate_Length (FXF3A00.Valid_Strings(i).all, 
+                                    TwoDP, 
+                                    TC_US_String)
+            then
+               Report.Failed("Incorrect result from function Length, "       &
+                             "when used with a decimal type with delta .01 " &
+                             "and with the currency string " & TC_US_String  & 
+                             " in evaluating picture string "                &
+                             FXF3A00.Valid_Strings(i).all );
+            end if;
+         end loop;
+
+
+         -- Picture strings 17-20 in the Valid_Strings array correspond
+         -- to data values of a decimal type with delta 1.0.  Again, the
+         -- instantiation of Decimal_Output used is based on this particular
+         -- decimal type.
+
+         for i in 17..20 loop
+            if not Accurate_Length (FXF3A00.Valid_Strings(i).all, 
+                                    NDP, 
+                                    TC_US_String)
+            then
+               Report.Failed("Incorrect result from function Length, "       &
+                             "when used with a decimal type with delta 1.0 " &
+                             "and with the currency string " & TC_US_String  & 
+                             " in evaluating picture string "                &
+                             FXF3A00.Valid_Strings(i).all );
+            end if;
+         end loop;
+
+
+         -- The first 4 picture strings in the Foreign_Strings array
+         -- correspond to data values of a decimal type with delta 0.01, 
+         -- and to the currency string "FF" (two characters). 
+
+         for i in 1..FXF3A00.Number_of_FF_Strings loop
+            if not Accurate_Length (FXF3A00.Foreign_Strings(i).all, 
+                                    TwoDP, 
+                                    TC_FF_String)
+            then
+               Report.Failed("Incorrect result from function Length, "       &
+                             "when used with a decimal type with delta .01 " &
+                             "and with the currency string " & TC_FF_String  & 
+                             " in evaluating picture string "                &
+                             FXF3A00.Foreign_Strings(i).all );
+            end if;
+         end loop;
+
+
+         -- Picture strings 5-9 in the Foreign_Strings array correspond
+         -- to data values of a decimal type with delta 0.01, and to the
+         -- currency string "DM" (two characters). 
+
+         TC_Lower_Bound  := FXF3A00.Number_of_FF_Strings + 1;
+         TC_Higher_Bound := FXF3A00.Number_of_FF_Strings + 
+                            FXF3A00.Number_of_DM_Strings;
+
+         for i in TC_Lower_Bound..TC_Higher_Bound loop
+            if not Accurate_Length (FXF3A00.Foreign_Strings(i).all, 
+                                    TwoDP, 
+                                    TC_DM_String)
+            then
+               Report.Failed("Incorrect result from function Length, "       &
+                             "when used with a decimal type with delta .01 " &
+                             "and with the currency string " & TC_DM_String  & 
+                             " in evaluating picture string "                &
+                             FXF3A00.Foreign_Strings(i).all );
+            end if;
+         end loop;
+
+
+         -- Picture string #10 in the Foreign_Strings array corresponds
+         -- to a data value of a decimal type with delta 0.01, and to the
+         -- currency string "CHF" (three characters). 
+
+         if not Accurate_Length (FXF3A00.Foreign_Strings(10).all, 
+                                 TwoDP, 
+                                 TC_CHF_String)
+         then
+            Report.Failed("Incorrect result from function Length, "       &
+                          "when used with a decimal type with delta .01 " &
+                          "and with the currency string "                 & 
+                          TC_CHF_String);
+         end if;
+
+      exception
+         when others => 
+           Report.Failed("Unexpected exception raised in Length_Block");
+      end Length_Block;
+
+
+      Valid_Block:
+      declare
+
+         -- This offset value is used to align picture string and decimal
+         -- data values from package FXF3A00 for proper correspondence for
+         -- the evaluations below.  
+
+         TC_Offset : constant Natural := 10;
+
+      begin
+
+         -- The following four For Loops examine cases where the
+         -- decimal data/picture string/currency combinations used will 
+         -- generate valid Edited Output strings.  These combinations, when
+         -- provided to the Function Valid (from instantiations of 
+         -- Decimal_Output), should result in a return result of True.
+         -- The particular instantiated version of Valid used in these loops
+         -- is that for decimal data with delta 0.01.
+
+         -- The first 4 picture strings in the Foreign_Strings array
+         -- correspond to data values of a decimal type with delta 0.01, 
+         -- and to the currency string "FF" (two characters). 
+
+         for i in 1..FXF3A00.Number_of_FF_Strings loop
+            -- Create the picture object from the picture string.
+            TC_Picture := Editing.To_Picture(FXF3A00.Foreign_Strings(i).all);
+
+            if not Pack_2DP.Valid (FXF3A00.Data_With_2DP(TC_Offset + i),
+                                   TC_Picture,
+                                   TC_FF_String)
+            then
+               Report.Failed("Incorrect result from function Valid, "        &
+                             "when used with a decimal type with delta .01 " &
+                             "and with the currency string " & TC_FF_String  & 
+                             " in evaluating picture string "                &
+                             FXF3A00.Foreign_Strings(i).all );
+            end if;
+         end loop;
+
+
+         -- Picture strings 5-9 in the Foreign_Strings array correspond
+         -- to data values of a decimal type with delta 0.01, and to the
+         -- currency string "DM" (two characters). 
+
+         TC_Lower_Bound  := FXF3A00.Number_of_FF_Strings + 1; 
+         TC_Higher_Bound := FXF3A00.Number_of_FF_Strings + 
+                            FXF3A00.Number_of_DM_Strings;
+
+         for i in TC_Lower_Bound..TC_Higher_Bound loop
+            -- Create the picture object from the picture string.
+            TC_Picture := Editing.To_Picture(FXF3A00.Foreign_Strings(i).all);
+
+            if not Pack_2DP.Valid (FXF3A00.Data_With_2DP(TC_Offset + i),
+                                   TC_Picture,
+                                   TC_DM_String)
+            then
+               Report.Failed("Incorrect result from function Valid, "        &
+                             "when used with a decimal type with delta .01 " &
+                             "and with the currency string " & TC_DM_String  & 
+                             " in evaluating picture string "                &
+                             FXF3A00.Foreign_Strings(i).all );
+            end if;
+         end loop;
+
+
+         -- Picture string #10 in the Foreign_Strings array corresponds
+         -- to a data value of a decimal type with delta 0.01, and to the
+         -- currency string "CHF" (three characters). 
+
+         -- Create the picture object from the picture string.
+         TC_Picture := Editing.To_Picture(FXF3A00.Foreign_Strings(10).all);
+
+         if not Pack_2DP.Valid (FXF3A00.Data_With_2DP(TC_Offset + 10),
+                                TC_Picture,
+                                TC_CHF_String)
+         then
+            Report.Failed("Incorrect result from function Valid, "        &
+                          "when used with a decimal type with delta .01 " &
+                          "and with the currency string "                 & 
+                          TC_CHF_String);
+         end if;
+
+
+         -- The following For Loop examines cases where the
+         -- decimal data/picture string/currency combinations used will 
+         -- generate valid Edited Output strings.  
+         -- The particular instantiated version of Valid used in this loop
+         -- is that for decimal data with delta 1.0; the others above have
+         -- been for decimal data with delta 0.01.
+         -- Note: TC_Offset is used here to align picture strings from the
+         --       FXF3A00.Valid_Strings table with the appropriate decimal
+         --       data in the FXF3A00.Data_With_NDP table.
+
+         for i in 1..FXF3A00.Number_Of_NDP_Items loop
+            -- Create the picture object from the picture string.
+            TC_Picture := 
+               Editing.To_Picture(FXF3A00.Valid_Strings(TC_Offset + i).all);
+
+            if not Pack_NDP.Valid (FXF3A00.Data_With_NDP(i),
+                                   TC_Picture, 
+                                   TC_US_String)
+            then
+               Report.Failed("Incorrect result from function Valid, "        &
+                             "when used with a decimal type with delta .01 " &
+                             "and with the currency string " & TC_US_String  & 
+                             " in evaluating picture string "                &
+                             FXF3A00.Valid_Strings(i).all );
+            end if;
+         end loop;
+
+
+         -- The following three evaluations of picture strings, used in
+         -- conjunction with the specific decimal values provided, will cause 
+         -- Editing.Image to raise Layout_Error (to be examined in other
+         -- tests).  Function Valid should return a False result for these 
+         -- combinations.
+         -- The first two evaluations use the instantiation of Decimal_Output
+         -- with a decimal type with delta 0.01, while the last evaluation
+         -- uses the instantiation with decimal type with delta 1.0.
+
+         for i in 1..FXF3A00.Number_of_Erroneous_Conditions loop
+
+            -- Create the picture object from the picture string.
+            TC_Picture := 
+               Editing.To_Picture(FXF3A00.Erroneous_Strings(i).all);
+
+            if i < 3 then  -- Choose the appropriate instantiation.
+               if Pack_2DP.Valid(Item     => FXF3A00.Erroneous_Data(i),
+                                 Pic      => TC_Picture,
+                                 Currency => TC_US_String)
+               then
+                  Report.Failed("Incorrect result from function Valid, "    &
+                                "when used with a decimal type with delta " &
+                                "0.01 and with the currency string "        & 
+                                TC_US_String                                & 
+                                " in evaluating picture string "            &
+                                FXF3A00.Valid_Strings(i).all );
+               end if;
+            else
+               if Pack_NDP.Valid(Item     => FXF3A00.Decimal_Type_NDP(
+                                               FXF3A00.Erroneous_Data(i)),
+                                 Pic      => TC_Picture,
+                                 Currency => TC_US_String)
+               then
+                  Report.Failed("Incorrect result from function Valid, "    &
+                                "when used with a decimal type with delta " &
+                                "1.0 and with the currency string "         & 
+                                TC_US_String                                & 
+                                " in evaluating picture string "            &
+                                FXF3A00.Valid_Strings(i).all );
+               end if;
+            end if;
+         end loop;
+
+      exception
+         when others => 
+           Report.Failed("Unexpected exception raised in Valid_Block");
+      end Valid_Block;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3A03;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a
new file mode 100644
index 000000000..9eee39bb6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a04.a
@@ -0,0 +1,293 @@
+-- CXF3A04.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 edited output string value returned by Function Image
+--      is correct.
+--
+-- TEST DESCRIPTION:
+--      This test is structured using tables of data, consisting of
+--      numerical values, picture strings, and expected image
+--      result strings.  These data tables are found in package FXF3A00.
+--      
+--      The results of the Image function are examined under a number of 
+--      circumstances.  The generic package Decimal_Output is instantiated
+--      twice, for decimal data with delta 0.01 and delta 1.0.  Each version
+--      of Image is called with both default parameters and user-provided
+--      parameters.  The results of each call to Image are compared to an
+--      expected edited output result string.
+--      
+--      In addition, three calls to Image are designed to raise Layout_Error,
+--      due to the combination of decimal value and picture string provided
+--      as input parameters.  If Layout_Error is not raised, or an alternate
+--      exception is raised instead, test failure results.
+--      
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXF3A00.A   (foundation code)
+--      => CXF3A04.A
+--
+--       
+-- CHANGE HISTORY:
+--      22 JAN 95   SAIC    Initial prerelease version.
+--      11 MAR 97   PWB.CTA Corrected incorrect index expression
+--!
+
+with FXF3A00;
+with Ada.Text_IO.Editing;
+with Report;
+
+procedure CXF3A04 is
+begin
+
+   Report.Test ("CXF3A04", "Check that the string value returned by " &
+                           "Function Image is correct, based on the " &
+                           "numerical data and picture formatting "   &
+                           "parameters provided to the function");
+
+   Test_Block:
+   declare
+
+      use Ada.Text_IO;
+
+      -- Instantiate the Decimal_Output generic package for the two data
+      -- types, using the default values for the Default_Currency,
+      -- Default_Fill, Default_Separator, and Default_Radix_Mark 
+      -- parameters.
+
+      package Pack_NDP is 
+        new Editing.Decimal_Output (FXF3A00.Decimal_Type_NDP);
+
+      package Pack_2DP is 
+        new Editing.Decimal_Output (FXF3A00.Decimal_Type_2DP);
+
+      TC_Currency   : constant String    := "$";
+      TC_Fill       : constant Character := '*';
+      TC_Separator  : constant Character := ',';
+      TC_Radix_Mark : constant Character := '.';
+
+      TC_Picture    : Editing.Picture;
+
+
+   begin
+
+      Two_Decimal_Place_Data:
+      -- Use a decimal fixed point type with delta 0.01 (two decimal places) 
+      -- and valid picture strings. Evaluate the result of function Image 
+      -- with the expected edited output result string.
+      declare  
+
+         TC_Loop_End : constant :=                                     -- 10
+           FXF3A00.Number_Of_2DP_Items - FXF3A00.Number_Of_Foreign_Strings;
+
+      begin
+         -- The first 10 picture strings in the Valid_Strings array 
+         -- correspond to data values of a decimal type with delta 0.01. 
+
+         -- Compare string result of Image with expected edited output 
+         -- string.  Evaluate data using both default parameters of Image
+         -- and user-provided parameter values.
+         for i in 1..TC_Loop_End loop
+
+            -- Create the picture object from the picture string.
+            TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
+
+            -- Use the default parameters for this loop evaluation of Image.
+            if Pack_2DP.Image(FXF3A00.Data_With_2DP(i), TC_Picture) /=
+               FXF3A00.Edited_Output(i).all
+            then
+               Report.Failed("Incorrect result from Function Image, "    &
+                             "when used with a decimal type with delta " &
+                             "0.01, picture string "                     &
+                             FXF3A00.Valid_Strings(i).all                &
+                             ", and the default parameters of Image");
+            end if;
+
+            -- Use user-provided parameters for this loop evaluation of Image.
+
+            if Pack_2DP.Image(Item       => FXF3A00.Data_With_2DP(i), 
+                              Pic        => TC_Picture,
+                              Currency   => TC_Currency,
+                              Fill       => TC_Fill,
+                              Separator  => TC_Separator,
+                              Radix_Mark => TC_Radix_Mark) /=
+               FXF3A00.Edited_Output(i).all
+            then
+               Report.Failed("Incorrect result from Function Image, "    &
+                             "when used with a decimal type with delta " &
+                             "0.01, picture string "                     &
+                             FXF3A00.Valid_Strings(i).all                &
+                             ", and user-provided parameters");
+            end if;
+
+         end loop;
+
+      exception
+         when others => 
+           Report.Failed("Exception raised in Two_Decimal_Place_Data block");
+      end Two_Decimal_Place_Data;
+
+
+
+      No_Decimal_Place_Data:
+      -- Use a decimal fixed point type with delta 1.00 (no decimal places) 
+      -- and valid picture strings. Evaluate the result of function Image 
+      -- with the expected result string.
+      declare
+
+         use Editing, FXF3A00;
+
+         TC_Offset     : constant := 10;
+         TC_Loop_Start : constant := TC_Offset + 1;                   -- 11
+         TC_Loop_End   : constant := TC_Loop_Start +
+                                     Number_Of_NDP_Items - 1;         -- 22
+
+      begin
+         -- The following evaluations correspond to data values of a 
+         -- decimal type with delta 1.0. 
+
+         -- Compare string result of Image with expected edited output 
+         -- string.  Evaluate data using both default parameters of Image
+         -- and user-provided parameter values.
+         -- Note: TC_Offset is used to align corresponding data the various
+         --       data tables in foundation package FXF3A00.
+
+         for i in TC_Loop_Start..TC_Loop_End loop
+
+            -- Create the picture object from the picture string.
+            TC_Picture := To_Picture(Valid_Strings(i).all);
+
+            -- Use the default parameters for this loop evaluation of Image.
+            if not (Pack_NDP.Image(Data_With_NDP(i-TC_Offset), TC_Picture) =
+                    Edited_Output(TC_Offset+i).all)
+            then
+               Report.Failed("Incorrect result from Function Image, "    &
+                             "when used with a decimal type with delta " &
+                             "1.0, picture string "                      &
+                             Valid_Strings(i).all                        &
+                             ", and the default parameters of Image");
+            end if;
+
+            -- Use user-provided parameters for this loop evaluation of Image.
+            if Pack_NDP.Image(Item       => Data_With_NDP(i - TC_Offset), 
+                              Pic        => TC_Picture,
+                              Currency   => TC_Currency,
+                              Fill       => TC_Fill,
+                              Separator  => TC_Separator,
+                              Radix_Mark => TC_Radix_Mark) /=
+               Edited_Output(TC_Offset+i).all
+            then
+               Report.Failed("Incorrect result from Function Image, "    &
+                             "when used with a decimal type with delta " &
+                             "1.0, picture string "                      &
+                             Valid_Strings(i).all                        &
+                             ", and user-provided parameters");
+            end if;
+
+         end loop;
+
+      exception
+         when others => 
+           Report.Failed("Exception raised in No_Decimal_Place_Data block");
+      end No_Decimal_Place_Data;
+
+
+
+      Exception_Block:
+      -- The following three calls of Function Image, using the specific
+      -- decimal values and picture strings provided, will cause 
+      -- a Layout_Error to be raised.
+      -- The first two evaluations use the instantiation of Decimal_Output
+      -- with a decimal type with delta 0.01, while the last evaluation
+      -- uses the instantiation with decimal type with delta 1.0.
+
+      -- Note: The data and the picture strings used in the following 
+      --       evaluations are not themselves erroneous, but when used in
+      --       combination will cause Layout_Error to be raised.
+
+      begin
+
+         for i in 1..FXF3A00.Number_Of_Erroneous_Conditions loop    -- 1..3
+            begin
+               -- Create the picture object from the picture string.
+               TC_Picture :=
+                 Editing.To_Picture(FXF3A00.Erroneous_Strings(i).all);
+
+               -- Layout_Error must be raised by the following calls to
+               -- Function Image.
+
+               if i < 3 then  -- Choose the appropriate instantiation.
+                  declare
+                     N : constant Natural := Pack_2DP.Length(TC_Picture);
+                     TC_String : String(1..N);
+                  begin
+                     TC_String := Pack_2DP.Image(FXF3A00.Erroneous_Data(i),
+                                                 TC_Picture);
+                  end;
+               else
+                  declare
+                     use FXF3A00;
+                     N : constant Natural := Pack_NDP.Length(TC_Picture,
+                                                             TC_Currency);
+                     TC_String : String(1..N);
+                  begin
+                     TC_String := 
+                       Pack_NDP.Image(Item       => Decimal_Type_NDP(
+                                                      Erroneous_Data(i)),
+                                      Pic        => TC_Picture,
+                                      Currency   => TC_Currency,
+                                      Fill       => TC_Fill,
+                                      Separator  => TC_Separator,
+                                      Radix_Mark => TC_Radix_Mark);
+                  end;
+               end if;
+
+               Report.Failed("Layout_Error not raised by combination "  &
+                             "# " & Integer'Image(i) & " "              &
+                             "of decimal data and picture string");
+
+            exception
+               when Layout_Error => null;    -- Expected exception.
+               when others       =>
+                 Report.Failed("Incorrect exception raised by combination " &
+                               "# " & Integer'Image(i) & " "                &
+                               "of decimal data and picture string");
+            end;
+         end loop;
+
+      exception
+         when others => 
+           Report.Failed("Unexpected exception raised in Exception_Block");
+      end Exception_Block;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3A04;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a
new file mode 100644
index 000000000..3fb39332a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a05.a
@@ -0,0 +1,266 @@
+-- CXF3A05.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 Function Image produces correct results when provided
+--      non-default parameters for Currency, Fill, Separator, and 
+--      Radix_Mark at either the time of package Decimal_Output instantiation,
+--      or in a call to Image.  Check non-default parameters that are 
+--      appropriate for foreign currency representations.
+--
+-- TEST DESCRIPTION:
+--      This test is structured using tables of data, consisting of
+--      numerical values, picture strings, and expected image
+--      result strings.  These data tables are found in package FXF3A00.
+--      
+--      The results of the Image function, resulting from several different
+--      instantiations of Decimal_Output, are compared with expected
+--      edited output string results.  The primary focus of this test is to
+--      examine the effect of non-default parameters, provided during the 
+--      instantiation of package Decimal_Output, or provided as part of a
+--      call to Function Image (that resulted from an instantiation of
+--      Decimal_Output that used default parameters).  The non-default
+--      parameters provided correspond to foreign currency representations.
+--      
+--      For each picture string/decimal data combination examined, two
+--      evaluations of Image are performed.  These correspond to the two
+--      methods of providing the appropriate non-default parameters described
+--      above.  Both forms of Function Image should produce the same expected
+--      edited output string.
+--      
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXF3A00.A   (foundation code)
+--      => CXF3A05.A
+--
+--       
+-- CHANGE HISTORY:
+--      26 JAN 95   SAIC    Initial prerelease version.
+--      17 FEB 97   PWB.CTA Correct array indices for Foreign_Strings array
+--                          references.
+--!
+
+with FXF3A00;
+with Ada.Text_IO.Editing;
+with Report;
+
+procedure CXF3A05 is
+begin
+
+   Report.Test ("CXF3A05", "Check that Function Image produces "        &
+                           "correct results when provided non-default " &
+                           "parameters for Currency, Fill, Separator, " &
+                           "and Radix_Mark, appropriate to foreign "    &
+                           "currency representations");
+
+   Test_Block:
+   declare
+
+      use Ada.Text_IO;
+
+      -- Instantiate the Decimal_Output generic package for the several
+      -- combinations of Default_Currency, Default_Fill, Default_Separator,
+      -- and Default_Radix_Mark.
+
+      package Pack_Def is                   -- Uses default parameter values.
+        new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP);
+
+      package Pack_FF  is
+        new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP,
+                                   Default_Currency   => "FF",
+                                   Default_Fill       => '*',
+                                   Default_Separator  => '.',
+                                   Default_Radix_Mark => ',');
+
+      package Pack_DM  is
+        new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP,
+                                   Default_Currency   => "DM",
+                                   Default_Fill       => '*',
+                                   Default_Separator  => ',',
+                                   Default_Radix_Mark => '.');
+
+      package Pack_CHF  is
+        new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP,
+                                   Default_Currency   => "CHF",
+                                   Default_Fill       => '*',
+                                   Default_Separator  => ',',
+                                   Default_Radix_Mark => '.');
+
+
+      TC_Picture    : Editing.Picture;
+      TC_Start_Loop : constant := 11;
+      TC_End_Loop   : constant := TC_Start_Loop +                       -- 20
+                                  FXF3A00.Number_Of_Foreign_Strings - 1;
+
+   begin
+
+      -- In the case of each particular type of foreign string examined,
+      -- two versions of Function Image are examined.  First, a version of
+      -- the function that originated from an instantiation of Decimal_Output
+      -- with non-default parameters is checked.  This version of Image is 
+      -- called making use of default parameters in the actual function call.
+      -- In addition, a version of Function Image is checked that resulted 
+      -- from an instantiation of Decimal_Output using default parameters, 
+      -- but which uses non-default parameters in the function call.
+
+      for i in TC_Start_Loop..TC_End_Loop loop
+
+         -- Create the picture object from the picture string.
+
+         TC_Picture := Editing.To_Picture
+                         (FXF3A00.Foreign_Strings(i - TC_Start_Loop + 1).all);
+
+         -- Based on the ordering of the specific foreign picture strings
+         -- in the FXF3A00.Foreign_Strings table, the following conditional
+         -- is used to determine which type of currency is being examined
+         -- as the loop executes.
+
+         if i < TC_Start_Loop + FXF3A00.Number_Of_FF_Strings then -- (11-14)
+            -- Process the FF picture strings.
+
+            -- Check the result of Function Image from an instantiation
+            -- of Decimal_Output that provided non-default actual 
+            -- parameters at the time of package instantiation, and uses
+            -- default parameters in the call of Image.
+
+            if Pack_FF.Image(Item => FXF3A00.Data_With_2DP(i),
+                             Pic  => TC_Picture)  /=
+               FXF3A00.Edited_Output(i).all
+            then
+               Report.Failed("Incorrect output from Function Image "     &
+                             "from package instantiated with FF "        &
+                             "related parameters, using picture string " &
+                             FXF3A00.Foreign_Strings
+                               (i - TC_Start_Loop + 1).all);
+            end if;
+
+            -- Check the result of Function Image that originated from 
+            -- an instantiation of Decimal_Output where default parameters
+            -- were used at the time of package Instantiation, but where
+            -- non-default parameters are provided in the call of Image.
+
+            if Pack_Def.Image(Item       => FXF3A00.Data_With_2DP(i),
+                              Pic        => TC_Picture,
+                              Currency   => "FF",
+                              Fill       => '*',
+                              Separator  => '.',
+                              Radix_Mark => ',')  /=
+               FXF3A00.Edited_Output(i).all
+            then
+               Report.Failed("Incorrect output from Function Image "     &
+                             "from package instantiated with default "   &
+                             "parameters, using picture string "         &
+                             FXF3A00.Foreign_Strings
+                               (i - TC_Start_Loop + 1).all               &
+                             ", and FF related parameters in call to Image");
+            end if;
+
+
+         elsif i < TC_Start_Loop +                                -- (15-19)
+                   FXF3A00.Number_Of_FF_Strings + 
+                   FXF3A00.Number_Of_DM_Strings  then
+            -- Process the DM picture strings.
+
+            -- Non-default instantiation parameters, default function call
+            -- parameters.
+
+            if Pack_DM.Image(Item => FXF3A00.Data_With_2DP(i),
+                             Pic  => TC_Picture)  /=
+               FXF3A00.Edited_Output(i).all
+            then
+               Report.Failed("Incorrect output from Function Image "     &
+                             "from package instantiated with DM "        &
+                             "related parameters, using picture string " &
+                             FXF3A00.Foreign_Strings
+                               (i - TC_Start_Loop + 1).all);
+            end if;
+
+            -- Default instantiation parameters, non-default function call
+            -- parameters.
+
+            if Pack_Def.Image(Item       => FXF3A00.Data_With_2DP(i),
+                              Pic        => TC_Picture,
+                              Currency   => "DM",
+                              Fill       => '*',
+                              Separator  => ',',
+                              Radix_Mark => '.')  /=
+               FXF3A00.Edited_Output(i).all
+            then
+               Report.Failed("Incorrect output from Function Image "     &
+                             "from package instantiated with default "   &
+                             "parameters, using picture string "         &
+                             FXF3A00.Foreign_Strings
+                               (i - TC_Start_Loop + 1).all               &
+                             ", and DM related parameters in call to Image");
+            end if;
+
+
+         else                                                     -- (i=20)
+            -- Process the CHF string.
+
+            -- Non-default instantiation parameters, default function call
+            -- parameters.
+
+            if Pack_CHF.Image(FXF3A00.Data_With_2DP(i), TC_Picture)  /=
+               FXF3A00.Edited_Output(i).all
+            then
+               Report.Failed("Incorrect output from Function Image "     &
+                             "from package instantiated with CHF "       &
+                             "related parameters, using picture string " &
+                             FXF3A00.Foreign_Strings
+                               (i - TC_Start_Loop + 1).all);
+            end if;
+
+            -- Default instantiation parameters, non-default function call
+            -- parameters.
+
+            if Pack_Def.Image(FXF3A00.Data_With_2DP(i),
+                              TC_Picture,
+                              "CHF",
+                              '*',
+                              ',',
+                              '.')  /=
+               FXF3A00.Edited_Output(i).all
+            then
+               Report.Failed("Incorrect output from Function Image "     &
+                             "from package instantiated with default "   &
+                             "parameters, using picture string "         &
+                             FXF3A00.Foreign_Strings
+                               (i - TC_Start_Loop + 1).all               &
+                             ", and CHF related parameters in call to Image");
+            end if;
+
+         end if;
+
+      end loop;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3A05;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a
new file mode 100644
index 000000000..7b769ba96
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a06.a
@@ -0,0 +1,302 @@
+-- CXF3A06.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 Ada.Text_IO.Editing.Put and Ada.Text_IO.Put have the same
+--      effect.  
+--
+-- TEST DESCRIPTION:
+--      This test is structured using tables of data, consisting of
+--      numerical values, picture strings, and expected image
+--      result strings.  These data tables are found in package FXF3A00.
+--      
+--      The testing approach used in this test is that of writing edited
+--      output data to a text file, using two different approaches.  First,
+--      Ada.Text_IO.Put is used, with a call to an instantiated version of
+--      Function Image supplied as the actual for parameter Item.  The 
+--      second approach is to use a version of Function Put from an 
+--      instantiation of Ada.Text_IO.Editing.Decimal_Output, with the
+--      appropriate parameters for decimal data, picture, and format
+--      specific parameters.  A call to New_Line follows each Put, so that
+--      each entry is placed on a separate line in the text file.
+--      
+--      Edited output for decimal data with two decimal places is in the 
+--      first loop, and once the data has been written to the file, the 
+--      text file is closed, then opened in In_File mode.  The edited
+--      output data is read from the file, and data on successive lines
+--      is compared with the expected edited output result.  The edited
+--      output data produced by both of the Put procedures should be
+--      identical.
+--      
+--      This process is repeated for decimal data with no decimal places.
+--      The file is reopened in Append_File mode, and the edited output
+--      data is added to the file in the same manner as described above.
+--      The file is closed, and reopened to verify the data written.  
+--      The data written above (with two decimal places) is skipped, then
+--      the data to be verified is extracted as above and verified against
+--      the expected edited output string values.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable only to implementations that support
+--      external text files.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXF3A00.A   (foundation code)
+--      => CXF3A06.A
+--
+--       
+-- CHANGE HISTORY:
+--      26 JAN 95   SAIC    Initial prerelease version.
+--      26 FEB 97   PWB.CTA Made input buffers sufficiently long
+--                          and removed code depending on shorter buffers
+--!
+
+with FXF3A00;
+with Ada.Text_IO.Editing;
+with Report;
+
+procedure CXF3A06 is
+   use Ada;
+begin
+
+   Report.Test ("CXF3A06", "Check that Ada.Text_IO.Editing.Put and " &
+                           "Ada.Text_IO.Put have the same effect");
+
+   Test_for_Text_IO_Support:
+   declare
+      Text_File     : Ada.Text_IO.File_Type;
+      Text_Filename : constant String := Report.Legal_File_Name(1);
+   begin
+
+      -- Use_Error will be raised if Text_IO operations or external files
+      -- are not supported.
+
+      Text_IO.Create (Text_File, Text_IO.Out_File, Text_Filename);
+
+      Test_Block:
+      declare
+         use Ada.Text_IO;
+
+         -- Instantiate the Decimal_Output generic package for two
+         -- different decimal data types.
+
+         package Pack_2DP is          -- Uses decimal type with delta 0.01.
+           new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP);
+
+         package Pack_NDP is          -- Uses decimal type with delta 1.0.
+           new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_NDP,
+                                      Default_Currency   => "$",
+                                      Default_Fill       => '*',
+                                      Default_Separator  => ',',
+                                      Default_Radix_Mark => '.');
+
+         TC_Picture    : Editing.Picture;
+         TC_Start_Loop : constant :=  1;
+         TC_End_Loop_1 : constant := FXF3A00.Number_Of_2DP_Items -    -- 20-10
+                                     FXF3A00.Number_Of_Foreign_Strings;
+         TC_End_Loop_2 : constant := FXF3A00.Number_Of_NDP_Items;     -- 12
+         TC_Offset     : constant := FXF3A00.Number_Of_2DP_Items;     -- 20
+
+         TC_String_1, TC_String_2 : String(1..255) := (others => ' ');
+         TC_Last_1,   TC_Last_2   : Natural := 0;
+
+      begin
+
+         -- Use the two versions of Put, for data with two decimal points,
+         -- to write edited output strings to the text file.  Use a separate
+         -- line for each string entry.
+
+         for i in TC_Start_Loop..TC_End_Loop_1 loop               -- 1..10
+
+            -- Create the picture object from the picture string.
+
+            TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
+
+            -- Use the Text_IO version of Put to place an edited output 
+            -- string into a text file. Use default parameters in the call
+            -- to Image for Currency, Fill, Separator, and Radix_Mark.
+
+            Text_IO.Put(Text_File,
+                        Pack_2DP.Image(Item => FXF3A00.Data_With_2DP(i),
+                                       Pic  => TC_Picture));
+            Text_IO.New_Line(Text_File);
+
+            -- Use the version of Put from the instantiation of 
+            -- Decimal_Output to place an edited output string on a separate
+            -- line of the Text_File.  Use default parameters for Currency,
+            -- Fill, Separator, and Radix_Mark.
+
+            Pack_2DP.Put(File => Text_File,
+                         Item => FXF3A00.Data_With_2DP(i),
+                         Pic  => TC_Picture);
+            Text_IO.New_Line(Text_File);
+
+         end loop;
+
+         Text_IO.Close(Text_File);
+
+         -- Reopen the text file in In_File mode, and verify the edited
+         -- output found on consecutive lines of the file.
+
+         Text_IO.Open(Text_File, Text_IO.In_File, Text_Filename);
+
+         for i in TC_Start_Loop..TC_End_Loop_1 loop
+               -- Read successive lines in the text file.
+               Text_IO.Get_Line(Text_File, TC_String_1, TC_Last_1);
+               Text_IO.Get_Line(Text_File, TC_String_2, TC_Last_2);
+
+            -- Compare the two strings for equality with the expected edited
+            -- output result.  Failure results if strings don't match, or if
+            -- a reading error occurred from the attempted Get_Line resulting 
+            -- from an improperly formed edited output string.
+
+            if TC_String_1(1..TC_Last_1) /= FXF3A00.Edited_Output(i).all  or 
+               TC_String_2(1..TC_Last_2) /= FXF3A00.Edited_Output(i).all
+            then
+               Report.Failed("Failed comparison of two edited output "    &
+                             "strings from data with two decimal points " &
+                             ", loop number = " & Integer'Image(i));
+            end if;
+         end loop;
+
+         Text_IO.Close(Text_File);
+
+         -- Reopen the text file in Append_File mode.
+         -- Use the two versions of Put, for data with no decimal points,
+         -- to write edited output strings to the text file.  Use a separate
+         -- line for each string entry.
+
+         Text_IO.Open(Text_File, Text_IO.Append_File, Text_Filename);
+
+         for i in TC_Start_Loop..TC_End_Loop_2 loop               -- 1..12
+
+            -- Create the picture object from the picture string specific to
+            -- data with no decimal points.  Use appropriate offset into the
+            -- Valid_Strings array to account for the string data used above.
+
+            TC_Picture := 
+              Editing.To_Picture(FXF3A00.Valid_Strings(i+TC_End_Loop_1).all);
+
+            -- Use the Text_IO version of Put to place an edited output 
+            -- string into a text file.  Use non-default parameters in the
+            -- call to Image for Currency, Fill, Separator, and Radix_Mark.
+
+            Text_IO.Put(Text_File,
+                        Pack_NDP.Image(Item => FXF3A00.Data_With_NDP(i),
+                                       Pic  => TC_Picture,
+                                       Currency   => "$",
+                                       Fill       => '*',
+                                       Separator  => ',',
+                                       Radix_Mark => '.'));
+            Text_IO.New_Line(Text_File);
+
+            -- Use the version of Put from the instantiation of 
+            -- Decimal_Output to place an edited output string on a separate
+            -- line of the Text_File.  Use non-default parameters for
+            -- Currency, Fill, Separator, and Radix_Mark.
+
+            Pack_NDP.Put(File       => Text_File,
+                         Item       => FXF3A00.Data_With_NDP(i),
+                         Pic        => TC_Picture,
+                         Currency   => "$",
+                         Fill       => '*',
+                         Separator  => ',',
+                         Radix_Mark => '.');
+            Text_IO.New_Line(Text_File);
+
+         end loop;
+
+         Text_IO.Close(Text_File);
+
+         -- Reopen the text file in In_File mode, and verify the edited
+         -- output found on consecutive lines of the file.
+
+         Text_IO.Open(Text_File, Text_IO.In_File, Text_Filename);
+
+         -- Read past data that has been verified above, skipping two lines 
+         -- of the data file for each loop.
+
+         for i in TC_Start_Loop..TC_End_Loop_1 loop               -- 1..10
+            Text_IO.Skip_Line(Text_File, 2);
+         end loop;
+
+         -- Verify the last data set that was written to the file.
+
+         for i in TC_Start_Loop..TC_End_Loop_2 loop               -- 1..12
+               Text_IO.Get_Line(Text_File, TC_String_1, TC_Last_1);
+               Text_IO.Get_Line(Text_File, TC_String_2, TC_Last_2);
+
+            -- Compare the two strings for equality with the expected edited
+            -- output result.  Failure results if strings don't match, or if
+            -- a reading error occurred from the attempted Get_Line resulting 
+            -- from an improperly formed edited output string.
+
+            if TC_String_1(1..TC_Last_1)              /= 
+               FXF3A00.Edited_Output(i+TC_Offset).all    or 
+               TC_String_2(1..TC_Last_2)              /= 
+               FXF3A00.Edited_Output(i+TC_Offset).all
+            then
+               Report.Failed("Failed comparison of two edited output "   &
+                             "strings from data with no decimal points " &
+                             ", loop number = " & 
+                             Integer'Image(i));
+            end if;
+
+         end loop;
+
+      exception
+         when others => Report.Failed("Exception raised in Test_Block");
+      end Test_Block;
+
+      -- Delete the external file.
+      if Text_IO.Is_Open (Text_File) then
+         Text_IO.Delete (Text_File);
+      else
+         Text_IO.Open (Text_File, Text_IO.In_File, Text_Filename);
+         Text_IO.Delete (Text_File);
+      end if;
+
+   exception
+
+      -- Since Use_Error can be raised if, for the specified mode,
+      -- the environment does not support Text_IO operations, the 
+      -- following handlers are included:
+
+      when Text_IO.Use_Error  =>
+         Report.Not_Applicable ("Use_Error raised on Text_IO Create");
+
+      when Text_IO.Name_Error =>
+         Report.Not_Applicable ("Name_Error raised on Text_IO Create");
+
+      when others             =>
+         Report.Failed ("Unexpected exception raised in Create block");
+
+   end Test_for_Text_IO_Support;
+
+   Report.Result;
+
+end CXF3A06;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a
new file mode 100644
index 000000000..7cb2c360c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a07.a
@@ -0,0 +1,337 @@
+-- CXF3A07.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 Ada.Text_IO.Editing.Put and Ada.Strings.Fixed.Move
+--      have the same effect in putting edited output results into string
+--      variables.
+--
+-- TEST DESCRIPTION:
+--      This test is structured using tables of data, consisting of
+--      numerical values, picture strings, and expected image
+--      result strings.  These data tables are found in package FXF3A00.
+--      
+--      The operation of the two above subprograms are examined twice, first
+--      with the output of an edited output string to a receiving string
+--      object of equal size, the other to a receiving string object of 
+--      larger size, where justification and padding are considered.
+--      The procedure Editing.Put will place an edited output string into
+--      a larger receiving string with right justification and blank fill.
+--      Procedure Move has parameter control of justification and fill, and
+--      in this test will mirror Put by specifying right justification and
+--      blank fill.  
+--      
+--      In the cases where the edited output string is of shorter length 
+--      than the receiving string object, a blank-filled constant string
+--      will be catenated to the front of the expected edited output string
+--      for comparison with the receiving string object, enabling direct 
+--      string comparison for result verification.
+--      
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXF3A00.A   (foundation code)
+--      => CXF3A07.A
+--
+--       
+-- CHANGE HISTORY:
+--      30 JAN 95   SAIC    Initial prerelease version.
+--      11 MAR 97   PWB.CTA Fixed string lengths
+--!
+
+with FXF3A00;
+with Ada.Text_IO.Editing;
+with Ada.Strings.Fixed;
+with Report;
+
+procedure CXF3A07 is
+begin
+
+   Report.Test ("CXF3A07", "Check that Ada.Text_IO.Editing.Put and "  &
+                           "Ada.Strings.Fixed.Move have the same "    &
+                           "effect in putting edited output results " &
+                           "into string variables");
+   Test_Block:
+   declare
+
+      use Ada.Text_IO;
+
+      -- Instantiate the Decimal_Output generic package for two
+      -- different decimal data types.
+
+      package Pack_2DP is          -- Uses decimal type with delta 0.01.
+        new Editing.Decimal_Output(FXF3A00.Decimal_Type_2DP);
+
+      package Pack_NDP is          -- Uses decimal type with delta 1.0.
+        new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_NDP,
+                                   Default_Currency   => "$",
+                                   Default_Fill       => '*',
+                                   Default_Separator  => ',',
+                                   Default_Radix_Mark => '.');
+
+      TC_Picture     : Editing.Picture;
+      TC_Start_Loop  : Integer := 0;
+      TC_End_Loop    : Integer := 0;
+      TC_Offset      : Integer := 0;
+      TC_Length      : Natural := 0;
+
+      TC_Put_String_20,                   -- Longer than the longest edited
+      TC_Move_String_20 : String(1..20);  -- output string.
+
+      TC_Put_String_17,                   -- Exact length of longest edited
+      TC_Move_String_17 : String(1..17);  -- output string in 2DP-US data set.
+                                       
+      TC_Put_String_8,                    -- Exact length of longest edited
+      TC_Move_String_8  : String(1..8);   -- output string in NDP-US data set.
+      
+
+   begin
+
+      -- Examine cases where the output string is longer than the length
+      -- of the edited output result.  Use the instantiation of 
+      -- Decimal_Output specific to data with two decimal places.
+
+      TC_Start_Loop := 1;
+      TC_End_Loop   := FXF3A00.Number_of_2DP_Items -              -- 10
+                       FXF3A00.Number_Of_Foreign_Strings;
+
+      for i in TC_Start_Loop..TC_End_Loop loop                    -- 1..10
+
+         -- Create the picture object from the picture string.
+
+         TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all,
+                                          Blank_When_Zero => False);
+
+         -- Determine the actual length of the edited output string
+         -- that is expected from Put and Image.
+
+         TC_Length := Pack_2DP.Length(Pic      => TC_Picture,
+                                      Currency => "$");
+
+         -- Determine the difference in length between the receiving string
+         -- object and the expected length of the edited output string.
+         -- Define a blank filled string constant with length equal to this
+         -- length difference.
+
+         declare
+            TC_Length_Diff   : Integer := TC_Put_String_20'Length -
+                                          TC_Length;
+            TC_Buffer_String : constant String(1..TC_Length_Diff) := 
+                                          (others => ' ');
+         begin
+
+            -- Fill the two receiving string objects with edited output,
+            -- using the two different methods (Put and Move).
+
+            Pack_2DP.Put(To         => TC_Put_String_20,
+                         Item       => FXF3A00.Data_With_2DP(i),
+                         Pic        => TC_Picture,
+                         Currency   => "$",
+                         Fill       => '*',
+                         Separator  => ',',
+                         Radix_Mark => '.');
+
+
+            Ada.Strings.Fixed.Move
+              (Source  => Pack_2DP.Image(Item => FXF3A00.Data_With_2DP(i),
+                                         Pic        => TC_Picture,
+                                         Currency   => "$",
+                                         Fill       => '*',
+                                         Separator  => ',',
+                                         Radix_Mark => '.'),
+               Target  => TC_Move_String_20,
+               Drop    => Ada.Strings.Error,
+               Justify => Ada.Strings.Right,
+               Pad     => Ada.Strings.Space);
+
+            -- Each receiving string object is now filled with the edited
+            -- output result, right justified.
+            -- Compare these two string objects with the expected edited
+            -- output value, which is appended to the blank filled string
+            -- whose length is the difference between the expected edited
+            -- output length and the length of the receiving strings.
+
+            if TC_Buffer_String & FXF3A00.Edited_Output(i).all  /=
+               TC_Put_String_20                                    or
+               TC_Buffer_String & FXF3A00.Edited_Output(i).all  /=
+               TC_Move_String_20
+            then
+               Report.Failed("Failed case where the output string is " &
+                             "longer than the length of the edited "   &
+                             "output result, loop #" & Integer'Image(i));
+            end if;
+
+         exception
+            when Layout_Error =>
+               Report.Failed("Layout_Error raised when the output string " &
+                             "is longer than the length of the edited "    &
+                             "output result, loop #" & Integer'Image(i));
+            when others       =>
+               Report.Failed("Exception raised when the output string is " &
+                             "longer than the length of the edited "       &
+                             "output result, loop #" & Integer'Image(i));
+         end;
+      end loop;
+
+
+      -- Repeat the above loop, but only evaluate three cases - those where
+      -- the length of the expected edited output string is the exact length 
+      -- of the receiving strings (no justification will be required within
+      -- the string.  This series of evaluations again uses decimal data
+      -- with two decimal places.
+
+      for i in TC_Start_Loop..TC_End_Loop loop                    -- 1..10
+
+         case i is
+            when 1 | 5 | 7 =>
+
+               -- Create the picture object from the picture string.
+               TC_Picture := 
+                 Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
+
+               -- Fill the two receiving string objects with edited output,
+               -- using the two different methods (Put and Move).
+               -- Use default parameters in the various calls where possible.
+
+               Pack_2DP.Put(To         => TC_Put_String_17,
+                            Item       => FXF3A00.Data_With_2DP(i),
+                            Pic        => TC_Picture);
+
+
+               Ada.Strings.Fixed.Move
+                 (Source  => Pack_2DP.Image(Item => FXF3A00.Data_With_2DP(i),
+                                            Pic  => TC_Picture),
+                  Target  => TC_Move_String_17);
+
+               -- Each receiving string object is now filled with the edited
+               -- output result. Compare these two string objects with the 
+               -- expected edited output value. 
+
+               if FXF3A00.Edited_Output(i).all  /= TC_Put_String_17  or
+                  FXF3A00.Edited_Output(i).all  /= TC_Move_String_17
+               then
+                  Report.Failed("Failed case where the output string is " &
+                                "the exact length of the edited output "  &
+                                "result, loop #" & Integer'Image(i));
+               end if;
+
+            when others => null;
+         end case;
+      end loop;
+
+
+      -- Evaluate a mix of cases, where the expected edited output string
+      -- length is either exactly as long or shorter than the receiving
+      -- output string parameter.  This series of evaluations uses decimal
+      -- data with no decimal places.
+
+      TC_Start_Loop := TC_End_Loop + 1;                           -- 11
+      TC_End_Loop   := TC_Start_Loop +                            -- 22
+                       FXF3A00.Number_of_NDP_Items - 1;               
+      TC_Offset     := FXF3A00.Number_of_Foreign_Strings;         -- 10
+      -- This offset is required due to the arrangement of data within the
+      -- tables found in FXF3A00.
+
+      for i in TC_Start_Loop..TC_End_Loop loop                    -- 11..22
+
+         -- Create the picture object from the picture string.
+
+         TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
+
+         -- Determine the actual length of the edited output string
+         -- that is expected from Put and Image.
+
+         TC_Length := Pack_NDP.Length(TC_Picture);
+
+         -- Fill the two receiving string objects with edited output,
+         -- using the two different methods (Put and Move).
+
+         Pack_NDP.Put(TC_Put_String_8,
+                      FXF3A00.Data_With_NDP(i-TC_Offset),
+                      TC_Picture);
+
+         Ada.Strings.Fixed.Move
+           (Pack_NDP.Image(FXF3A00.Data_With_NDP(i-TC_Offset), TC_Picture),
+            TC_Move_String_8,
+            Ada.Strings.Error,
+            Ada.Strings.Right,
+            Ada.Strings.Space);
+
+         -- Determine if there is a difference in length between the 
+         -- receiving string object and the expected length of the edited 
+         -- output string.  If so, then define a blank filled string constant 
+         -- with length equal to this length difference.
+
+         if TC_Length < TC_Put_String_8'Length then
+            declare
+               TC_Length_Diff   : Integer := TC_Put_String_8'Length -
+                                             TC_Length;
+               TC_Buffer_String : constant String(1..TC_Length_Diff) := 
+                                          (others => ' ');
+            begin
+
+               -- Each receiving string object is now filled with the edited
+               -- output result, right justified.
+               -- Compare these two string objects with the expected edited
+               -- output value, which is appended to the blank filled string
+               -- whose length is the difference between the expected edited
+               -- output length and the length of the receiving strings.
+
+               if TC_Buffer_String & FXF3A00.Edited_Output(i+TC_Offset).all /=
+                  TC_Put_String_8                                           or
+                  TC_Buffer_String & FXF3A00.Edited_Output(i+TC_Offset).all /=
+                  TC_Move_String_8
+               then
+                  Report.Failed("Failed case where the output string is "  &
+                                "longer than the length of the edited "    &
+                                "output result, loop #" & Integer'Image(i) &
+                                ", using data with no decimal places");
+               end if;
+            end;
+         else
+
+            -- Compare these two string objects with the expected edited
+            -- output value, which is appended to the blank filled string
+            -- whose length is the difference between the expected edited
+            -- output length and the length of the receiving strings.
+
+            if FXF3A00.Edited_Output(i+TC_Offset).all /= TC_Put_String_8 or
+               FXF3A00.Edited_Output(i+TC_Offset).all /= TC_Move_String_8
+            then
+               Report.Failed("Failed case where the output string is "  &
+                             "the same length as the edited output "    &
+                             "result, loop #" & Integer'Image(i)        &
+                             ", using data with no decimal places");
+            end if;
+         end if;
+      end loop;
+
+   exception
+      when others => Report.Failed("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3A07;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a
new file mode 100644
index 000000000..871ab5600
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxf/cxf3a08.a
@@ -0,0 +1,289 @@
+-- CXF3A08.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 version of Ada.Text_IO.Editing.Put with an out 
+--      String parameter propagates Layout_Error if the edited output string 
+--      result of Put exceeds the length of the out String parameter.
+--      
+-- TEST DESCRIPTION:
+--      This test is structured using tables of data, consisting of
+--      numerical values, picture strings, and expected image
+--      result strings.  These data tables are found in package FXF3A00.
+--      
+--      This test examines the case of the out string parameter to Procedure
+--      Put being insufficiently long to hold the entire edited output
+--      string result of the procedure.  In this case, Layout_Error is to be
+--      raised.  Test failure results if Layout_Error is not raised, or if an
+--      exception other than Layout_Error is raised.
+--      
+--      A number of data combinations are examined, using instantiations 
+--      of Package Decimal_Output with different decimal data types and 
+--      both default and non-default parameters as generic actual parameters.
+--      In addition, calls to Procedure Put are performed using default 
+--      parameters, non-default parameters, and non-default parameters that 
+--      override the generic actual parameters provided at the time of 
+--      instantiation of Decimal_Output.
+--      
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         FXF3A00.A   (foundation code)
+--      => CXF3A08.A
+--
+--       
+-- CHANGE HISTORY:
+--      31 JAN 95   SAIC    Initial prerelease version.
+--
+--!
+
+with FXF3A00;
+with Ada.Text_IO.Editing;
+with Report;
+
+procedure CXF3A08 is
+begin
+
+   Report.Test ("CXF3A08", "Check that the version of "                &
+                           "Ada.Text_IO.Editing.Put with an out "      &
+                           "String parameter propagates Layout_Error " &
+                           "if the output string exceeds the length "  &
+                           "of the out String parameter");
+
+   Test_Block:
+   declare
+
+      use Ada.Text_IO;
+
+      -- Instantiate the Decimal_Output generic package for two
+      -- different decimal data types.
+                                   -- Uses decimal type with delta 0.01 and
+      package Pack_2DP is          -- non-default generic actual parameters.
+        new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_2DP,
+                                   Default_Currency   => "$",
+                                   Default_Fill       => '*',
+                                   Default_Separator  => ',',
+                                   Default_Radix_Mark => '.');
+
+      package Pack_NDP is          -- Uses decimal type with delta 1.0.
+        new Editing.Decimal_Output(FXF3A00.Decimal_Type_NDP);
+
+      TC_Picture       : Editing.Picture;
+      TC_Start_Loop    : Integer := 0;
+      TC_End_Loop      : Integer := 0;
+      TC_Offset        : Integer := 0;
+
+      TC_Short_String  : String(1..4);   -- Shorter than the shortest edited
+                                         -- output string result.
+
+   begin
+
+      -- Examine cases where the out string parameter is shorter than 
+      -- the length of the edited output result.  Use the instantiation of 
+      -- Decimal_Output specific to data with two decimal places.
+
+      TC_Start_Loop := 1;
+      TC_End_Loop   := FXF3A00.Number_of_2DP_Items -              -- 10
+                       FXF3A00.Number_Of_Foreign_Strings;
+
+      for i in TC_Start_Loop..TC_End_Loop loop                    -- 1..10
+
+         -- Create the picture object from the picture string.
+
+         TC_Picture := 
+           Editing.To_Picture(Pic_String => FXF3A00.Valid_Strings(i).all,
+                              Blank_When_Zero => False);
+
+         -- The out parameter string provided in the call to Put is 
+         -- shorter than the edited output result of the procedure.  
+         -- This will result in a Layout_Error being raised and handled.
+         -- Test failure results from no exception being raised, or from
+         -- the wrong exception being raised.
+
+         begin
+
+            -- Use the instantiation of Decimal_Output specific to decimal
+            -- data with two decimal places, as well as non-default 
+            -- parameters and named parameter association.
+
+            Pack_2DP.Put(To         => TC_Short_String,
+                         Item       => FXF3A00.Data_With_2DP(i),
+                         Pic        => TC_Picture,
+                         Currency   => "$",
+                         Fill       => '*',
+                         Separator  => ',',
+                         Radix_Mark => '.');
+
+            -- Test failure if exception not raised.
+
+            Report.Failed
+              ("Layout_Error not raised, decimal data with two decimal " &
+               "places, loop #" & Integer'Image(i));
+
+         exception
+            when Layout_Error => null;  -- OK, expected exception.
+            when others       =>
+               Report.Failed
+                 ("Incorrect exception raised, Layout_Error expected, " &
+                  "decimal data with two decimal places, loop #"        &
+                  Integer'Image(i));
+         end;
+      end loop;
+
+
+      -- Perform similar evaluations as above, but use the instantiation
+      -- of Decimal_Output specific to decimal data with no decimal places.
+
+      TC_Start_Loop := TC_End_Loop + 1;                           -- 11
+      TC_End_Loop   := TC_Start_Loop +                            -- 22
+                       FXF3A00.Number_of_NDP_Items - 1;               
+      TC_Offset     := FXF3A00.Number_of_Foreign_Strings;         -- 10
+      -- This offset is required due to the arrangement of data within the
+      -- tables found in FXF3A00.
+
+      for i in TC_Start_Loop..TC_End_Loop loop                    -- 11..22
+
+         -- Create the picture object from the picture string.
+
+         TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);
+
+         begin
+
+            -- Use the instantiation of Decimal_Output specific to decimal
+            -- data with no decimal places, as well as default parameters
+            -- and positional parameter association.
+
+            Pack_NDP.Put(TC_Short_String,
+                         FXF3A00.Data_With_NDP(i-TC_Offset),
+                         TC_Picture);
+
+            -- Test failure if exception not raised.
+
+            Report.Failed
+              ("Layout_Error not raised, decimal data with no decimal " &
+               "places, loop #" & Integer'Image(i));
+
+         exception
+            when Layout_Error => null;  -- OK, expected exception.
+            when others       =>
+               Report.Failed
+                 ("Incorrect exception raised, Layout_Error expected, " &
+                  "decimal data with no decimal places, loop #"         &
+                  Integer'Image(i));
+         end;
+
+      end loop;
+
+
+      -- Check that Layout_Error is raised by Put resulting from an
+      -- instantiation of Decimal_Output specific to foreign currency
+      -- representations. 
+      -- Note: Both of the following evaluation sets use decimal data with 
+      --       two decimal places.
+
+      declare
+
+         package Pack_FF is 
+           new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_2DP,
+                                      Default_Currency   => "FF",
+                                      Default_Fill       => '*',
+                                      Default_Separator  => '.',
+                                      Default_Radix_Mark => ',');
+
+      begin
+
+         TC_Offset := FXF3A00.Number_Of_2DP_Items -                 -- 10
+                      FXF3A00.Number_Of_Foreign_Strings;
+
+         for i in 1..FXF3A00.Number_Of_FF_Strings loop              -- 1..4
+            begin
+
+               -- Create the picture object from the picture string.
+               TC_Picture := 
+                 Editing.To_Picture(FXF3A00.Foreign_Strings(i).all);
+
+               Pack_FF.Put(To   => TC_Short_String,
+                           Item => FXF3A00.Data_With_2DP(i+TC_Offset),
+                           Pic  => TC_Picture);
+
+               Report.Failed("Layout_Error was not raised by Put from "  &
+                             "an instantiation of Decimal_Output using " &
+                             "non-default parameters specific to FF "    &
+                             "currency, loop #" & Integer'Image(i));
+
+            exception
+               when Layout_Error => null;  -- OK, expected exception.
+               when others       =>
+                  Report.Failed("Incorrect exception raised by Put from "   &
+                                "an instantiation of Decimal_Output using " &
+                                "non-default parameters specific to FF "    &
+                                "currency, loop #" & Integer'Image(i));
+            end;
+         end loop;
+
+
+         -- These evaluations use a version of Put resulting from a 
+         -- non-default instantiation of Decimal_Output, but which has 
+         -- specific foreign currency parameters provided in the call that
+         -- override the generic actual parameters provided at instantiation.
+
+         TC_Offset := TC_Offset + FXF3A00.Number_Of_FF_Strings;      -- 14
+
+         for i in 1..FXF3A00.Number_Of_DM_Strings loop               -- 1..5
+            begin
+               TC_Picture := 
+                 Editing.To_Picture(FXF3A00.Foreign_Strings
+                                      (i+FXF3A00.Number_Of_FF_Strings).all);
+
+               Pack_2DP.Put(To         => TC_Short_String,
+                            Item       => FXF3A00.Data_With_2DP(i+TC_Offset),
+                            Pic        => TC_Picture,
+                            Currency   => "DM",
+                            Fill       => '*',
+                            Separator  => ',',
+                            Radix_Mark => '.');
+
+               Report.Failed("Layout_Error was not raised by Put using " &
+                             "non-default parameters specific to DM "    &
+                             "currency, loop #" & Integer'Image(i));
+
+            exception
+               when Layout_Error => null;  -- OK, expected exception.
+               when others       =>
+                  Report.Failed("Incorrect exception raised by Put using " &
+                                "non-default parameters specific to DM "   &
+                                "currency, loop #" & Integer'Image(i));
+            end;
+         end loop;
+
+      end;
+
+   exception
+      when others => Report.Failed("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXF3A08;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1001.a
new file mode 100644
index 000000000..01a0f061e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1001.a
@@ -0,0 +1,276 @@
+-- CXG1001.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 subprograms defined in the package
+--      Ada.Numerics.Generic_Complex_Types provide correct results.  
+--      Specifically, check the functions Re, Im (both versions), procedures
+--      Set_Re, Set_Im (both versions), functions Compose_From_Cartesian (all
+--      versions), Compose_From_Polar, Modulus, Argument, and "abs".
+--
+-- TEST DESCRIPTION:
+--      The generic package Generic_Complex_Types 
+--      is instantiated with a real type (new Float), and the results
+--      produced by the specified subprograms are verified.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Nov 95   SAIC    Corrected visibility problems for ACVC 2.0.1.
+--                          Modified subtest for Compose_From_Polar.
+--      29 Sep 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Ada.Numerics.Generic_Complex_Types;
+with Report;
+
+procedure CXG1001 is
+
+begin
+
+   Report.Test ("CXG1001", "Check that the subprograms defined in " &
+                           "the package Ada.Numerics.Generic_Complex_Types " & 
+                           "provide correct results");
+
+   Test_Block:
+   declare
+
+      type Real_Type is new Float;
+
+      package Complex_Pack is new 
+        Ada.Numerics.Generic_Complex_Types(Real_Type);
+
+      use type Complex_Pack.Complex;
+
+      -- Declare a zero valued complex number.
+      Complex_Zero : constant Complex_Pack.Complex := (0.0, 0.0);
+
+      TC_Complex   : Complex_Pack.Complex := Complex_Zero;
+      TC_Imaginary : Complex_Pack.Imaginary;    
+
+   begin
+
+      -- Check that the procedures Set_Re and Set_Im (both versions) provide
+      -- correct results.
+
+      declare
+         TC_Complex_Real_Field : Complex_Pack.Complex := (5.0, 0.0);
+         TC_Complex_Both_Fields : Complex_Pack.Complex := (5.0, 7.0);
+      begin
+
+         Complex_Pack.Set_Re(X => TC_Complex, Re => 5.0);
+
+         if TC_Complex /= TC_Complex_Real_Field then
+            Report.Failed("Incorrect results from Procedure Set_Re");
+         end if;
+
+         Complex_Pack.Set_Im(X => TC_Complex, Im => 7.0);
+
+         if TC_Complex.Re /= 5.0 or
+            TC_Complex.Im /= 7.0 or
+            TC_Complex    /= TC_Complex_Both_Fields 
+         then
+            Report.Failed("Incorrect results from Procedure Set_Im " &
+                          "with Complex argument");
+         end if;
+
+         Complex_Pack.Set_Im(X => TC_Imaginary, Im => 3.0);
+
+
+         if Complex_Pack.Im(TC_Imaginary) /= 3.0 then
+            Report.Failed("Incorrect results returned following the use " &
+                          "of Procedure Set_Im with Imaginary argument");
+         end if;
+
+      end;
+
+
+      -- Check that the functions Re and Im (both versions) provide
+      -- correct results.
+
+      declare
+         TC_Complex_1 : Complex_Pack.Complex := (1.0, 0.0);
+         TC_Complex_2 : Complex_Pack.Complex := (0.0, 2.0);
+         TC_Complex_3 : Complex_Pack.Complex := (4.0, 3.0);
+      begin
+
+         -- Function Re.
+
+         if Complex_Pack.Re(X => TC_Complex_1) /= 1.0  or
+            Complex_Pack.Re(X => TC_Complex_2) /= 0.0  or
+            Complex_Pack.Re(X => TC_Complex_3) /= 4.0 
+         then
+            Report.Failed("Incorrect results from Function Re");
+         end if;
+
+         -- Function Im; version with Complex argument.
+
+         if Complex_Pack.Im(X => TC_Complex_1) /= 0.0  or
+            Complex_Pack.Im(X => TC_Complex_2) /= 2.0  or
+            Complex_Pack.Im(X => TC_Complex_3) /= 3.0 
+         then
+            Report.Failed("Incorrect results from Function Im " &
+                          "with Complex argument");
+         end if;
+
+
+         -- Function Im; version with Imaginary argument.
+
+         if Complex_Pack.Im(Complex_Pack.i) /= 1.0  or
+            Complex_Pack.Im(Complex_Pack.j) /= 1.0
+         then
+            Report.Failed("Incorrect results from use of Function Im " &
+                          "when used with an Imaginary argument");
+         end if;
+
+      end;
+
+
+      -- Verify the results of the three versions of Function
+      -- Compose_From_Cartesian
+
+      declare
+
+         Zero  : constant Real_Type := 0.0;
+         Six   : constant Real_Type := 6.0;
+
+         TC_Complex_1 : Complex_Pack.Complex := (3.0, 8.0);
+         TC_Complex_2 : Complex_Pack.Complex := (Six, Zero);
+         TC_Complex_3 : Complex_Pack.Complex := (Zero, 1.0);
+
+      begin
+
+         TC_Complex := Complex_Pack.Compose_From_Cartesian(3.0, 8.0);
+
+         if TC_Complex /= TC_Complex_1 then
+            Report.Failed("Incorrect results from Function " &
+                          "Compose_From_Cartesian - 1");
+         end if;
+
+         -- If only one component is given, the other component is 
+         -- implicitly zero (Both components are set by the following two
+         -- function calls).
+
+         TC_Complex := Complex_Pack.Compose_From_Cartesian(Re => 6.0);
+
+         if TC_Complex /= TC_Complex_2 then
+            Report.Failed("Incorrect results from Function " &
+                          "Compose_From_Cartesian - 2");
+         end if;
+
+         TC_Complex := 
+           Complex_Pack.Compose_From_Cartesian(Im => Complex_Pack.i);
+
+         if TC_Complex /= TC_Complex_3 then
+            Report.Failed("Incorrect results from Function " &
+                          "Compose_From_Cartesian - 3");
+         end if;
+
+      end; 
+
+
+      -- Verify the results of Function Compose_From_Polar, Modulus, "abs",
+      -- and Argument.
+
+      declare
+
+         use Complex_Pack;
+
+         TC_Modulus,
+         TC_Argument : Real_Type := 0.0;
+
+
+         Angle_0     : constant Real_Type :=   0.0;
+         Angle_90    : constant Real_Type :=  90.0;
+         Angle_180   : constant Real_Type := 180.0;
+         Angle_270   : constant Real_Type := 270.0;
+         Angle_360   : constant Real_Type := 360.0;
+
+      begin
+
+         -- Verify the result of Function Compose_From_Polar.
+         -- When the value of the parameter Modulus is zero, the 
+         -- Compose_From_Polar function yields a result of zero.
+
+         if Compose_From_Polar(0.0, 30.0, 360.0) /= Complex_Zero
+         then
+            Report.Failed("Incorrect result from Function " &
+                          "Compose_From_Polar - 1");
+         end if;
+
+         -- When the value of the parameter Argument is equal to a multiple
+         -- of the quarter cycle, the result of the Compose_From_Polar
+         -- function with specified cycle lies on one of the axes.
+
+         if Compose_From_Polar( 5.0,  Angle_0,   Angle_360) /= (5.0,  0.0) or
+            Compose_From_Polar( 5.0,  Angle_90,  Angle_360) /= (0.0,  5.0) or
+            Compose_From_Polar(-5.0,  Angle_180, Angle_360) /= (5.0,  0.0) or
+            Compose_From_Polar(-5.0,  Angle_270, Angle_360) /= (0.0,  5.0) or
+            Compose_From_Polar(-5.0,  Angle_90,  Angle_360) /= (0.0, -5.0) or
+            Compose_From_Polar( 5.0,  Angle_270, Angle_360) /= (0.0, -5.0) 
+         then
+            Report.Failed("Incorrect result from Function " &
+                          "Compose_From_Polar - 2");
+         end if;
+
+         -- When the parameter to Function Argument represents a point on 
+         -- the non-negative real axis, the function yields a zero result.
+
+         if Argument(Complex_Zero, Angle_360) /= 0.0 then
+            Report.Failed("Incorrect result from Function Argument");
+         end if;
+
+         -- Function Modulus
+
+         if Modulus(Complex_Zero) /= 0.0  or
+            Modulus(Compose_From_Polar( 5.0, Angle_90,  Angle_360)) /= 5.0 or
+            Modulus(Compose_From_Polar(-5.0, Angle_180, Angle_360)) /= 5.0 
+         then
+            Report.Failed("Incorrect results from Function Modulus");
+         end if;
+
+         -- Function "abs", a rename of Function Modulus.
+
+         if "abs"(Complex_Zero) /= 0.0  or
+            "abs"(Compose_From_Polar( 5.0, Angle_90,  Angle_360)) /= 5.0 or
+            "abs"(Compose_From_Polar(-5.0, Angle_180, Angle_360)) /= 5.0 
+         then
+            Report.Failed("Incorrect results from Function abs");
+         end if;
+
+      end;
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXG1001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1002.a
new file mode 100644
index 000000000..39f5f00db
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1002.a
@@ -0,0 +1,198 @@
+-- CXG1002.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 subprograms defined in the package
+--      Ada.Numerics.Generic_Complex_Types provide the prescribed results.  
+--      Specifically, check the various versions of functions "+" and "-".
+--
+-- TEST DESCRIPTION:
+--      This test checks that the subprograms "+" and "-" defined in the 
+--      Generic_Complex_Types package provide the results prescribed for the
+--      evaluation of these complex arithmetic operations.  The functions
+--      Re and Im are used to extract the appropriate component of the 
+--      complex result, in order that the prescribed result component can be
+--      verified.
+--      The generic package is instantiated with a real type (new Float), 
+--      and the results produced by the specified subprograms are verified.
+--
+-- SPECIAL REQUIREMENTS:
+--      This test can be run in either "relaxed" or "strict" mode.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Ada.Numerics.Generic_Complex_Types;
+with Report;
+
+procedure CXG1002 is
+
+begin
+
+   Report.Test ("CXG1002", "Check that the subprograms defined in " &
+                           "the package Ada.Numerics.Generic_Complex_Types " & 
+                           "provide the prescribed results");
+
+   Test_Block:
+   declare
+
+      type Real_Type is new Float;
+
+      package Complex_Pack is new 
+        Ada.Numerics.Generic_Complex_Types(Real_Type);
+      use Complex_Pack;
+
+      -- Declare a zero valued complex number using the record
+      -- aggregate approach.
+
+      Complex_Zero : constant Complex_Pack.Complex := (0.0, 0.0);
+
+      TC_Complex,
+      TC_Complex_Right,
+      TC_Complex_Left   : Complex_Pack.Complex := Complex_Zero;
+
+      TC_Real           : Real_Type := 0.0;
+
+      TC_Imaginary      : Complex_Pack.Imaginary;
+
+   begin
+
+
+      -- Check that the imaginary component of the result of a binary addition
+      -- operator that yields a result of complex type is exact when either
+      -- of its operands is of pure-real type.
+
+      TC_Complex := Compose_From_Cartesian(2.0, 3.0);
+      TC_Real    := 3.0;
+
+      if Im("+"(Left => TC_Complex, Right => TC_Real))  /=  3.0 or
+         Im("+"(TC_Complex, 6.0))                       /=  3.0 or
+         Im(TC_Complex + TC_Real)                       /=  3.0 or
+         Im(TC_Complex + 5.0)                           /=  3.0 or
+         Im((7.0, 2.0) + 1.0)                           /=  2.0 or
+         Im((7.0, 5.0) + (-2.0))                        /=  5.0 or
+         Im((-7.0, -2.0) + 1.0)                         /= -2.0 or
+         Im((-7.0, -3.0) + (-3.0))                      /= -3.0
+      then 
+         Report.Failed("Incorrect results from Function ""+"" with " &
+                       "one Complex and one Real argument - 1");
+      end if;
+
+      if Im("+"(Left => TC_Real, Right => TC_Complex))  /=   3.0  or
+         Im("+"(4.0, TC_Complex))                       /=   3.0  or
+         Im(TC_Real + TC_Complex)                       /=   3.0  or
+         Im(9.0 + TC_Complex)                           /=   3.0  or
+         Im(1.0 + (7.0, -9.0))                          /=  -9.0  or
+         Im((-2.0) + (7.0, 2.0))                        /=   2.0  or
+         Im(1.0 + (-7.0, -5.0))                         /=  -5.0  or
+         Im((-3.0) + (-7.0, 16.0))                      /=  16.0
+      then 
+         Report.Failed("Incorrect results from Function ""+"" with " &
+                       "one Complex and one Real argument - 2");
+      end if;
+
+
+      -- Check that the imaginary component of the result of a binary 
+      -- subtraction operator that yields a result of complex type is exact
+      -- when its right operand is of pure-real type.
+
+      TC_Complex := (8.0, -4.0);
+      TC_Real    := 2.0;
+
+      if Im("-"(Left => TC_Complex, Right => TC_Real))  /=  -4.0  or
+         Im("-"(TC_Complex, 5.0))                       /=  -4.0  or
+         Im(TC_Complex - TC_Real)                       /=  -4.0  or
+         Im(TC_Complex - 4.0)                           /=  -4.0  or
+         Im((6.0, 5.0) - 1.0)                           /=   5.0  or
+         Im((6.0, 13.0) - 7.0)                          /=  13.0  or
+         Im((-5.0, 3.0) - (2.0))                        /=   3.0  or
+         Im((-5.0, -6.0) - (-3.0))                      /=  -6.0 
+      then 
+         Report.Failed("Incorrect results from Function ""-"" with " &
+                       "one Complex and one Real argument");
+      end if;
+
+
+      -- Check that the real component of the result of a binary addition
+      -- operator that yields a result of complex type is exact when either
+      -- of its operands is of pure-imaginary type.
+
+      TC_Complex := (5.0, 0.0);
+
+      if Re("+"(Left => TC_Complex, Right => i))  /=   5.0 or
+         Re("+"(Complex_Pack.j, TC_Complex))      /=   5.0 or
+         Re((-8.0,  5.0) + ( 2.0*i))              /=  -8.0 or
+         Re((2.0,  5.0) + (-2.0*i))               /=   2.0 or
+         Re((-20.0, -5.0) + ( 3.0*i))             /= -20.0 or
+         Re((6.0, -5.0) + (-3.0*i))               /=   6.0
+      then
+         Report.Failed("Incorrect results from Function ""+"" with " &
+                       "one Complex and one Imaginary argument");
+      end if;
+
+
+      -- Check that the real component of the result of a binary 
+      -- subtraction operator that yields a result of complex type is exact
+      -- when its right operand is of pure-imaginary type.
+
+      TC_Complex := TC_Complex + i;    -- Should produce (5.0, 1.0)
+
+      if Re("-"(TC_Complex, i))                   /=  5.0 or
+         Re((-4.0,  4.0) - ( 2.0*i))              /= -4.0 or
+         Re((9.0,  4.0) - ( 5.0*i))               /=  9.0 or
+         Re((16.0, -5.0) - ( 3.0*i))              /= 16.0 or
+         Re((-3.0, -5.0) - (-4.0*i))              /= -3.0
+      then
+         Report.Failed("Incorrect results from Function ""-"" with " &
+                       "one Complex and one Imaginary argument");
+      end if;
+
+
+      -- Check that the result of a binary addition operation is exact when
+      -- one of its operands is of real type and the other is of 
+      -- pure-imaginary type; the operator is analogous to the 
+      -- Compose_From_Cartesian function; it performs no arithmetic.
+
+      TC_Complex := Complex_Pack."+"(5.0, Complex_Pack.i);
+
+      if TC_Complex                   /= (5.0, 1.0) or
+         (4.0 + i)                    /= (4.0, 1.0) or
+         "+"(Left => j, Right => 3.0) /= (3.0, 1.0) 
+      then
+         Report.Failed("Incorrect results from Function ""+"" with " &
+                       "one Real and one Imaginary argument");
+      end if;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXG1002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1003.a
new file mode 100644
index 000000000..c3885136b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1003.a
@@ -0,0 +1,478 @@
+-- CXG1003.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 subprograms defined in the package Text_IO.Complex_IO
+--      provide correct results.  
+--
+-- TEST DESCRIPTION:
+--      The generic package Ada.Numerics.Generic_Complex_Types is instantiated 
+--      with a real type (new Float). The resulting new package is used as
+--      the generic actual to package Complex_IO.
+--      Two different versions of Put and Get are examined in this test, 
+--      those that input/output complex data values from/to Text_IO files,
+--      and those that input/output complex data values from/to strings.
+--      Two procedures are defined to perform the file data manipulations;
+--      one to place complex data into the file, and one to retrieve the data
+--      from the file and verify its correctness.
+--      Complex data is also put into string variables using the Procedure
+--      Put for strings, and this data is then retrieved and reconverted into
+--      complex values using the Get procedure.
+--
+--
+-- APPLICABILITY CRITERIA: 
+--      This test is only applicable to implementations that:
+--         support Annex G,
+--         support Text_IO and external files
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      29 Dec 94   SAIC    Modified Width parameter in Get function calls.
+--      16 Nov 95   SAIC    Corrected visibility problems for ACVC 2.0.1.
+--      29 Sep 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Ada.Text_IO.Complex_IO;
+with Ada.Numerics.Generic_Complex_Types;
+with Report;
+
+procedure CXG1003 is
+begin
+
+   Report.Test ("CXG1003", "Check that the subprograms defined in " &
+                           "the package Text_IO.Complex_IO " & 
+                           "provide correct results");
+
+   Test_for_Text_IO_Support:
+   declare
+      use Ada;
+
+      Data_File     : Ada.Text_IO.File_Type;
+      Data_Filename : constant String := Report.Legal_File_Name;
+
+   begin
+
+      -- An application creates a text file in mode Out_File, with the 
+      -- intention of entering complex data into the file as appropriate.  
+      -- In the event that the particular environment where the application 
+      -- is running does not support Text_IO, Use_Error or Name_Error will be 
+      -- raised on calls to Text_IO operations.  Either of these exceptions
+      -- will be handled to produce a Not_Applicable result.
+
+      Text_IO.Create (File => Data_File,
+                      Mode => Ada.Text_IO.Out_File,
+                      Name => Data_Filename);
+
+      Test_Block:
+      declare
+
+         TC_Verbose : Boolean := False;
+
+         type Real_Type is new Float;
+
+         package Complex_Pack is new 
+           Ada.Numerics.Generic_Complex_Types(Real_Type);
+
+         package C_IO is new Ada.Text_IO.Complex_IO(Complex_Pack);
+
+         use Ada.Text_IO, C_IO;
+         use type Complex_Pack.Complex;
+
+         Number_Of_Complex_Items : constant := 6;
+         Number_Of_Error_Items   : constant := 2;
+
+         TC_Complex              : Complex_Pack.Complex;
+         TC_Last_Character_Read  : Positive;
+
+         Complex_Array : array (1..Number_Of_Complex_Items) 
+           of Complex_Pack.Complex := ( (3.0, 9.0),
+                                        (4.0, 7.0),
+                                        (5.0, 6.0),
+                                        (6.0, 3.0),
+                                        (2.0, 5.0),
+                                        (3.0, 7.0) );
+
+
+         procedure Load_Data_File (The_File : in out Text_IO.File_Type) is
+            use Ada.Text_IO;
+         begin
+            -- This procedure does not create, open, or close the data file;
+            -- The_File file object must be Open at this point.
+            -- This procedure is designed to load complex data into a data 
+            -- file twice, first using Text_IO, then Complex_IO.  In this
+            -- first case, the complex data values are entered as strings,
+            -- assuming a variety of legal formats, as provided in the 
+            -- reference manual.
+
+            Put_Line(The_File, "(3.0, 9.0)");
+            Put_Line(The_File, "+4. +7.");    -- Relaxed real literal format.
+            Put_Line(The_File, "(5.0 6.)");
+            Put_Line(The_File, "6., 3.0");
+            Put_Line(The_File, "  (  2.0  ,  5.0  )  ");
+            Put_Line(The_File, "(");           -- Complex data separated over
+            Put_Line(The_File, "3.0");         -- several (5) lines.
+            Put_Line(The_File, " , ");        
+            Put_Line(The_File, "7.0  ");
+            Put_Line(The_File, ")");
+
+            if TC_Verbose then
+               Report.Comment("Complex values entered into data file using " &
+                              "Text_IO, Procedure Load_Data_File");
+            end if;
+
+            -- Use the Complex_IO procedure Put to enter Complex data items
+            -- into the data file.
+            -- Note: Data is being entered into the file for the *second* time
+            --       at this point. (Using Complex_IO here, Text_IO above)
+
+            for i in 1..Number_Of_Complex_Items loop
+               C_IO.Put(File => The_File, 
+                        Item => Complex_Array(i), 
+                        Fore => 1, 
+                        Aft  => 1, 
+                        Exp  => 0);
+            end loop;
+
+            if TC_Verbose then
+               Report.Comment("Complex values entered into data file using " &
+                              "Complex_IO, Procedure Load_Data_File");
+            end if;
+
+            Put_Line(The_File, "(5A,3)");      -- data to raise Data_Error.
+            Put_Line(The_File, "(3.0,,8.0)");  -- data to raise Data_Error.
+
+         end Load_Data_File;
+
+
+
+         procedure Process_Data_File (The_File : in out Text_IO.File_Type) is
+             TC_Complex : Complex_Pack.Complex := (0.0, 0.0);
+             TC_Width   : Integer := 0;
+         begin
+            -- This procedure does not create, open, or close the data file;
+            -- The_File file object must be Open at this point.
+            -- Use procedure Get (for Files) to extract the complex data from
+            -- the Text_IO file.  This data was placed into the file using
+            -- Text_IO.
+
+
+            for i in 1..Number_Of_Complex_Items loop
+           
+               C_IO.Get(The_File, TC_Complex, TC_Width);
+
+               if TC_Complex /= Complex_Array(i) then
+                  Report.Failed("Incorrect complex data read from file " &
+                                "when using Text_IO procedure Get, "     &
+                                "data item #" & Integer'Image(i));
+               end if;
+            end loop;
+
+            if TC_Verbose then
+               Report.Comment("First set of complex values extracted " &
+                              "from data file using Complex_IO, "      &
+                              "Procedure Process_Data_File");
+            end if;
+
+            -- Use procedure Get (for Files) to extract the complex data from
+            -- the Text_IO file.  This data was placed into the file using
+            -- procedure Complex_IO.Put.
+            -- Note: Data is being extracted from the file for the *second*
+            --       time at this point (Using Complex_IO here, Text_IO above)
+
+            for i in 1..Number_Of_Complex_Items loop
+    
+               C_IO.Get(The_File, TC_Complex, TC_Width);
+          
+               if TC_Complex /= Complex_Array(i) then
+                  Report.Failed("Incorrect complex data read from file " &
+                                "when using Complex_IO procedure Get, "  &
+                                "data item #" & Integer'Image(i));
+               end if;
+            end loop;
+
+            if TC_Verbose then
+               Report.Comment("Second set of complex values extracted " &
+                              "from data file using Complex_IO, "       &
+                              "Procedure Process_Data_File");
+            end if;
+
+            -- The final items in the Data_File are complex values with 
+            -- incorrect syntax, which should raise Data_Error on an attempt
+            -- to read them from the file.
+            TC_Width := 10;
+            for i in 1..Number_Of_Error_Items loop
+               begin
+                  C_IO.Get(The_File, TC_Complex, TC_Width);
+                  Report.Failed
+                    ("Exception Data_Error not raised when Complex_IO.Get " &
+                     "was used to read complex data with incorrect "        &
+                     "syntax from the Data_File, data item #"               &
+                     Integer'Image(i));
+               exception
+                  when Ada.Text_IO.Data_Error => -- OK, expected exception.
+                     Text_IO.Skip_Line(The_File);
+                  when others =>
+                     Report.Failed
+                       ("Unexpected exception raised when Complex_IO.Get " &
+                        "was used to read complex data with incorrect "    &
+                        "syntax from the Data_File, data item #"           &
+                         Integer'Image(i));
+               end;
+            end loop;
+
+            if TC_Verbose then
+               Report.Comment("Erroneous set of complex values extracted " &
+                              "from data file using Complex_IO, "          &
+                              "Procedure Process_Data_File");
+            end if;
+
+
+         exception
+            when others =>
+              Report.Failed
+                ("Unexpected exception raised in Process_Data_File");
+         end Process_Data_File;
+
+
+
+      begin  -- Test_Block.
+
+         -- Place complex values into data file.
+
+         Load_Data_File(Data_File);
+         Text_IO.Close(Data_File);
+
+         if TC_Verbose then
+            Report.Comment("Data file loaded with Complex values");
+         end if;
+
+         -- Read complex values from data file.
+
+         Text_IO.Open(Data_File, Text_IO.In_File, Data_Filename);
+         Process_Data_File(Data_File);
+
+         if TC_Verbose then
+            Report.Comment("Complex values extracted from data file");
+         end if;
+
+
+
+         -- Verify versions of Procedures Put and Get for Strings.
+
+         declare
+            TC_String_Array : array (1..Number_Of_Complex_Items) 
+                              of String(1..15) := (others =>(others => ' '));
+         begin
+
+            -- Place complex values into strings using the Procedure Put.
+
+            for i in 1..Number_Of_Complex_Items loop
+               C_IO.Put(To   => TC_String_Array(i),
+                        Item => Complex_Array(i),
+                        Aft  => 1,
+                        Exp  => 0);
+            end loop;
+
+            if TC_Verbose then
+               Report.Comment("Complex values placed into string array");
+            end if;
+
+            -- Check the format of the strings containing a complex number.
+            -- The resulting strings are of 15 character length, with the
+            -- real component left justified within the string, followed by
+            -- a comma, and with the imaginary component and closing 
+            -- parenthesis right justified in the string, with blank fill
+            -- for the balance of the string.
+
+            if TC_String_Array(1) /= "(3.0,      9.0)" or
+               TC_String_Array(2) /= "(4.0,      7.0)" or
+               TC_String_Array(3) /= "(5.0,      6.0)" or
+               TC_String_Array(4) /= "(6.0,      3.0)" or
+               TC_String_Array(5) /= "(2.0,      5.0)" or
+               TC_String_Array(6) /= "(3.0,      7.0)" 
+            then
+               Report.Failed("Incorrect format for complex values that " &
+                             "have been placed into string variables "   &
+                             "using the Complex_IO.Put procedure for "   &
+                             "strings");
+            end if;
+
+            if TC_Verbose then
+               Report.Comment("String format of Complex values verified");
+            end if;
+
+            -- Get complex values from strings using the Procedure Get.
+            -- Compare with expected complex values.
+
+            for i in 1..Number_Of_Complex_Items loop
+
+               C_IO.Get(From => TC_String_Array(i),
+                        Item => TC_Complex,
+                        Last => TC_Last_Character_Read);
+
+               if TC_Complex /= Complex_Array(i) then
+                  Report.Failed("Incorrect complex data value obtained "   &
+                                "from String following use of Procedures " &
+                                "Put and Get from Strings, Complex_Array " &
+                                "item #" & Integer'Image(i));
+               end if;
+            end loop;
+         
+            if TC_Verbose then
+               Report.Comment("Complex values removed from String array");
+            end if;
+
+            -- Verify that Layout_Error is raised if the given string is
+            -- too short to hold the formatted output.
+            Layout_Error_On_Put:
+            declare
+               Much_Too_Short : String(1..2);
+               Complex_Value  : Complex_Pack.Complex := (5.0, 0.0);
+            begin
+               C_IO.Put(Much_Too_Short, Complex_Value);
+               Report.Failed("Layout_Error not raised by Procedure Put " &
+                             "when the given string was too short to "   &
+                             "hold the formatted output");
+            exception
+               when Layout_Error => null;  -- OK, expected exception.
+               when others =>
+                  Report.Failed
+                    ("Unexpected exception raised by Procedure Put when " &
+                     "the given string was too short to hold the "        &
+                     "formatted output");
+            end Layout_Error_On_Put;
+
+            if TC_Verbose then
+               Report.Comment("Layout Errors verified");
+            end if;
+
+         exception
+            when others => 
+               Report.Failed("Unexpected exception raised during the " &
+                             "evaluation of Put and Get for Strings");
+         end;
+
+
+         -- Place complex values into strings using a variety of legal
+         -- complex data formats.
+         declare
+
+            type String_Ptr is access String;
+
+            TC_Complex_String_Array : 
+              array (1..Number_Of_Complex_Items) of String_Ptr := 
+              (new String'( "(3.0, 9.0  )"           ), 
+               new String'( "+4.0  +7.0"             ),
+               new String'( "(5.0 6.0)"              ),
+               new String'( "6.0, 3.0"               ),
+               new String'( "  (   2.0   , 5.0  )  " ),
+               new String'( "(3.0              7.0)" ));
+
+            -- The following array contains Positive values that correspond
+            -- to the last character that will be read by Procedure Get when
+            -- given each of the above strings as input.
+
+            TC_Last_Char_Array : array (1..Number_Of_Complex_Items) 
+               of Positive := (12,10,9,8,20,22);
+
+         begin
+
+            -- Get complex values from strings using the Procedure Get.
+            -- Compare with expected complex values.
+
+            for i in 1..Number_Of_Complex_Items loop
+
+               C_IO.Get(TC_Complex_String_Array(i).all, 
+                        TC_Complex,
+                        TC_Last_Character_Read);
+
+               if TC_Complex /= Complex_Array(i) then
+                  Report.Failed
+                    ("Incorrect complex data value obtained from " &
+                     "Procedure Get with complex data input of: "  & 
+                     TC_Complex_String_Array(i).all);
+               end if;
+
+               if TC_Last_Character_Read /= TC_Last_Char_Array(i) then
+                  Report.Failed
+                    ("Incorrect value returned as the last character of " &
+                     "the input string processed by Procedure Get, "      &
+                     "string value : " & TC_Complex_String_Array(i).all   &
+                     "  expected last character value read : "            & 
+                     Positive'Image(TC_Last_Char_Array(i))                &
+                     "  last character value read : "                     &
+                     Positive'Image(TC_Last_Character_Read));
+               end if;
+
+            end loop;
+
+            if TC_Verbose then
+               Report.Comment("Complex values removed from strings and " &
+                              "verified against expected values");
+            end if;
+
+         exception
+            when others => 
+               Report.Failed("Unexpected exception raised during the " &
+                             "evaluation of Get for Strings");
+         end;
+
+      exception
+         when others => Report.Failed ("Exception raised in Test_Block");
+      end Test_Block;
+
+
+      -- Delete the external file.
+      if Ada.Text_IO.Is_Open(Data_File) then
+         Ada.Text_IO.Delete(Data_File);
+      else
+         Ada.Text_IO.Open(Data_File, 
+                          Ada.Text_IO.In_File,
+                          Data_Filename);
+         Ada.Text_IO.Delete(Data_File);
+      end if;
+
+   exception
+
+      -- Since Use_Error can be raised if, for the specified mode,
+      -- the environment does not support Text_IO operations, the 
+      -- following handlers are included:
+
+      when Ada.Text_IO.Use_Error  =>
+         Report.Not_Applicable ("Use_Error raised on Text_IO Create");
+
+      when Ada.Text_IO.Name_Error  =>
+         Report.Not_Applicable ("Name_Error raised on Text_IO Create");
+
+      when others             =>
+         Report.Failed ("Unexpected exception raised on text file Create");
+
+   end Test_for_Text_IO_Support;
+
+   Report.Result;
+
+end CXG1003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1004.a
new file mode 100644
index 000000000..f026eae70
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1004.a
@@ -0,0 +1,360 @@
+-- CXG1004.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 specified exceptions are raised by the subprograms
+--      defined in package Ada.Numerics.Generic_Complex_Elementary_Functions
+--      given the prescribed input parameter values.
+--
+-- TEST DESCRIPTION:
+--      This test checks that specific subprograms defined in the 
+--      package Ada.Numerics.Generic_Complex_Elementary_Functions raise the
+--      exceptions Argument_Error and Constraint_Error when their input
+--      parameter value are those specified as causing each exception.
+--      In the case of Constraint_Error, the exception will be raised in
+--      each test case, provided that the value of the attribute
+--      'Machine_Overflows (for the actual type of package 
+--      Generic_Complex_Type) is True.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test only applies to implementations supporting the 
+--      numerics annex.
+--
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      16 Nov 95   SAIC    Corrected visibility problems for ACVC 2.0.1.
+--      29 Sep 96   SAIC    Incorporated reviewer comments.
+--      02 Jun 98   EDS     Replace "_i" with "_One".
+--!
+
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Generic_Complex_Elementary_Functions;
+with Report;
+
+procedure CXG1004 is
+begin
+
+   Report.Test ("CXG1004", "Check that the specified exceptions are "      &
+                           "raised by the subprograms defined in package " &
+                           "Ada.Numerics.Generic_Complex_Elementary_"      &
+                           "Functions given the prescribed input "         &
+                           "parameter values");
+
+   Test_Block:
+   declare
+
+      type Real_Type is new Float;
+
+      TC_Overflows : Boolean := Real_Type'Machine_Overflows;
+
+      package Complex_Pack is 
+        new Ada.Numerics.Generic_Complex_Types(Real_Type);
+
+      package CEF is 
+        new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pack);
+
+      use Ada.Numerics, Complex_Pack, CEF;
+
+      Complex_Zero : constant Complex := Compose_From_Cartesian(0.0, 0.0);
+      Plus_One     : constant Complex := Compose_From_Cartesian(1.0, 0.0);
+      Minus_One    : constant Complex := Compose_From_Cartesian(-1.0, 0.0);
+      Plus_i       : constant Complex := Compose_From_Cartesian(i);
+      Minus_i      : constant Complex := Compose_From_Cartesian(-i);
+
+      Complex_Negative_Real      : constant Complex := 
+                                            Compose_From_Cartesian(-4.0, 2.0);
+      Complex_Negative_Imaginary : constant Complex := 
+                                            Compose_From_Cartesian(3.0, -5.0);
+
+      TC_Complex   : Complex;
+
+
+      -- This procedure is used in "Exception Raising" calls below in an
+      -- attempt to avoid elimination of the subtest through optimization.
+
+      procedure No_Optimize (The_Complex_Number : Complex) is
+      begin
+         Report.Comment("No Optimize: Should never be printed " &
+                        Integer'Image(Integer(The_Complex_Number.Im)));
+      end No_Optimize;
+
+
+   begin
+
+      -- Check that the exception Numerics.Argument_Error is raised by the
+      -- exponentiation operator when the value of the left operand is zero,
+      -- and the real component of the exponent (or the exponent itself) is
+      -- zero.
+
+      begin
+         TC_Complex := "**"(Left => Complex_Zero, Right => Complex_Zero);
+         Report.Failed("Argument_Error not raised by exponentiation "  &
+                       "operator, left operand = complex zero, right " &
+                       "operand = complex zero");
+         No_Optimize(TC_Complex);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by exponentiation " &
+                          "operator, left operand = complex zero, right " &
+                          "operand = complex zero");
+      end;
+
+      begin
+         TC_Complex := Complex_Zero**0.0;
+         Report.Failed("Argument_Error not raised by exponentiation "  &
+                       "operator, left operand = complex zero, right " &
+                       "operand = real zero");
+         No_Optimize(TC_Complex);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by exponentiation " &
+                          "operator, left operand = complex zero, right " &
+                          "operand = real zero");
+      end;
+
+
+      begin
+         TC_Complex := "**"(Left => 0.0, Right => Complex_Zero);
+         Report.Failed("Argument_Error not raised by exponentiation " &
+                       "operator, left operand = real zero, right "   &
+                       "operand = complex zero");
+         No_Optimize(TC_Complex);
+      exception
+         when Argument_Error => null;  -- OK, expected exception.
+         when others =>
+            Report.Failed("Incorrect exception raised by exponentiation " &
+                          "operator, left operand = real zero, right "    &
+                          "operand = complex zero");
+      end;
+
+
+      -- Check that the exception Constraint_Error is raised under the 
+      -- specified circumstances, provided that
+      -- Complex_Types.Real'Machine_Overflows is True.
+
+      if TC_Overflows then
+
+         -- Raised by Log, when the value of the parameter X is zero.
+         begin
+            TC_Complex := Log (X => Complex_Zero);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Log given parameter value of complex zero");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Log given parameter value of complex zero");
+         end;
+
+         -- Raised by Cot, when the value of the parameter X is zero.
+         begin
+            TC_Complex := Cot (X => Complex_Zero);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Cot given parameter value of complex zero");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Cot given parameter value of complex zero");
+         end;
+
+         -- Raised by Coth, when the value of the parameter X is zero.
+         begin
+            TC_Complex := Coth (Complex_Zero);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Coth given parameter value of complex zero");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Coth given parameter value of complex zero");
+         end;
+
+         -- Raised by the exponentiation operator, when the value of the 
+         -- left operand is zero and the real component of the exponent
+         -- is negative.
+         begin
+            TC_Complex := Complex_Zero**Complex_Negative_Real;
+            Report.Failed("Constraint_Error not raised when the "    &
+                          "exponentiation operator left operand is " &
+                          "complex zero, and the real component of " &
+                          "the exponent is negative");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when the "     &
+                             "exponentiation operator left operand is " &
+                             "complex zero, and the real component of " &
+                             "the exponent is negative");
+         end;
+
+         -- Raised by the exponentiation operator, when the value of the 
+         -- left operand is zero and the exponent itself (when it is of
+         -- type real) is negative.
+         declare
+            Negative_Exponent : constant Real_Type := -4.0;
+         begin
+            TC_Complex := Complex_Zero**Negative_Exponent;
+            Report.Failed("Constraint_Error not raised when the "    &
+                          "exponentiation operator left operand is " &
+                          "complex zero, and the real exponent is "  &
+                          "negative");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when the "     &
+                             "exponentiation operator left operand is " &
+                             "complex zero, and the real exponent is "  &
+                             "negative");
+         end;
+
+         -- Raised by Arctan, when the value of the parameter is +i.
+         begin
+            TC_Complex := Arctan (Plus_i);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Arctan is given parameter value +i");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Arctan is given parameter value +i");
+         end;
+
+         -- Raised by Arctan, when the value of the parameter is -i.
+         begin
+            TC_Complex := Arctan (Minus_i);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Arctan is given parameter value -i");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Arctan is given parameter value -i");
+         end;
+
+         -- Raised by Arccot, when the value of the parameter is +i.
+         begin
+            TC_Complex := Arccot (Plus_i);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Arccot is given parameter value +i");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Arccot is given parameter value +i");
+         end;
+
+         -- Raised by Arccot, when the value of the parameter is -i.
+         begin
+            TC_Complex := Arccot (Minus_i);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Arccot is given parameter value -i");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Arccot is given parameter value -i");
+         end;
+
+         -- Raised by Arctanh, when the value of the parameter is +1.
+         begin
+            TC_Complex := Arctanh (Plus_One);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Arctanh is given parameter value +1");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Arctanh is given parameter value +1");
+         end;
+
+         -- Raised by Arctanh, when the value of the parameter is -1.
+         begin
+            TC_Complex := Arctanh (Minus_One);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Arctanh is given parameter value -1");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Arctanh is given parameter value -1");
+         end;
+
+         -- Raised by Arccoth, when the value of the parameter is +1.
+         begin
+            TC_Complex := Arccoth (Plus_One);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Arccoth is given parameter value +1");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Arccoth is given parameter value +1");
+         end;
+
+         -- Raised by Arccoth, when the value of the parameter is -1.
+         begin
+            TC_Complex := Arccoth (Minus_One);
+            Report.Failed("Constraint_Error not raised when Function " &
+                          "Arccoth is given parameter value -1");
+            No_Optimize(TC_Complex);
+         exception
+            when Constraint_Error => null;  -- OK, expected exception.
+            when others =>
+               Report.Failed("Incorrect exception raised when Function " &
+                             "Arccoth is given parameter value -1");
+         end;
+
+      else
+         Report.Comment
+           ("Attribute Complex_Pack.Real'Machine_Overflows is False; " &
+            "evaluation of the complex elementary functions under "    &
+            "specified circumstances was not performed");
+      end if;
+
+
+   exception
+      when others => 
+        Report.Failed ("Unexpected exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXG1004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1005.a
new file mode 100644
index 000000000..6faad4e13
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg1005.a
@@ -0,0 +1,393 @@
+-- CXG1005.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 subprograms defined in the package
+--      Ada.Numerics.Generic_Complex_Elementary_Functions provide correct
+--      results.
+--      
+-- TEST DESCRIPTION:
+--      This test checks that specific subprograms defined in the generic
+--      package Generic_Complex_Elementary_Functions are available, and that
+--      they provide prescribed results given specific input values.
+--      The generic package Ada.Numerics.Generic_Complex_Types is instantiated 
+--      with a real type (new Float). The resulting new package is used as
+--      the generic actual to package Complex_IO.
+--      
+-- SPECIAL REQUIREMENTS:
+--      Implementations for which Float'Signed_Zeros is True must provide
+--      a body for ImpDef.Annex_G.Negative_Zero which returns a negative 
+--      zero.
+--
+-- APPLICABILITY CRITERIA
+--      This test only applies to implementations that support the
+--      numerics annex.
+--
+--         
+--       
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      16 Nov 95   SAIC    Corrected visibility problems for ACVC 2.0.1.
+--      21 Feb 96   SAIC    Incorporated new structure for package Impdef.
+--      29 Sep 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Generic_Complex_Elementary_Functions;
+with ImpDef.Annex_G;
+with Report;
+
+procedure CXG1005 is
+begin
+
+   Report.Test ("CXG1005", "Check that the subprograms defined in "  &
+                           "the package Generic_Complex_Elementary_" & 
+                           "Functions provide correct results");
+
+   Test_Block:
+   declare
+
+      type Real_Type is new Float;
+
+      TC_Signed_Zeros : Boolean := Real_Type'Signed_Zeros; 
+
+      package Complex_Pack is new 
+        Ada.Numerics.Generic_Complex_Types(Real_Type);
+
+      package CEF is 
+        new Ada.Numerics.Generic_Complex_Elementary_Functions(Complex_Pack);
+
+      use Ada.Numerics, Complex_Pack, CEF;
+
+      Complex_Zero : constant Complex := Compose_From_Cartesian( 0.0, 0.0);
+      Plus_One     : constant Complex := Compose_From_Cartesian( 1.0, 0.0);
+      Minus_One    : constant Complex := Compose_From_Cartesian(-1.0, 0.0);
+      Plus_i       : constant Complex := Compose_From_Cartesian(i);
+      Minus_i      : constant Complex := Compose_From_Cartesian(-i);
+
+      Complex_Positive_Real      : constant Complex := 
+                                         Compose_From_Cartesian(4.0, 2.0);
+      Complex_Positive_Imaginary : constant Complex := 
+                                         Compose_From_Cartesian(3.0, 5.0);
+      Complex_Negative_Real      : constant Complex := 
+                                         Compose_From_Cartesian(-4.0, 2.0);
+      Complex_Negative_Imaginary : constant Complex := 
+                                         Compose_From_Cartesian(3.0, -5.0);
+
+
+      function A_Zero_Result (Z : Complex) return Boolean is
+      begin
+         return (Re(Z) = 0.0 and Im(Z) = 0.0);
+      end A_Zero_Result;
+
+
+      -- In order to evaluate complex elementary functions that are
+      -- prescribed to return a "real" result (meaning that the imaginary
+      -- component is zero), the Function A_Real_Result is defined.
+
+      function A_Real_Result (Z : Complex) return Boolean is
+      begin
+         return Im(Z) = 0.0;
+      end A_Real_Result;
+
+
+      -- In order to evaluate complex elementary functions that are
+      -- prescribed to return an "imaginary" result (meaning that the real
+      -- component of the complex number is zero, and the imaginary
+      -- component is non-zero), the Function An_Imaginary_Result is defined.
+
+      function An_Imaginary_Result (Z : Complex) return Boolean is
+      begin
+         return  (Re(Z) = 0.0 and Im(Z) /= 0.0);
+      end An_Imaginary_Result;
+
+
+   begin
+
+      -- Check that when the input parameter value is zero, the following
+      -- functions yield a zero result.
+
+      if not A_Zero_Result( Sqrt(Complex_Zero) ) then
+         Report.Failed("Non-zero result from Function Sqrt with zero input");
+      end if;
+
+      if not A_Zero_Result( Sin(Complex_Zero) ) then
+         Report.Failed("Non-zero result from Function Sin with zero input");
+      end if;
+
+      if not A_Zero_Result( Arcsin(Complex_Zero) ) then
+         Report.Failed("Non-zero result from Function Arcsin with zero " &
+                       "input");
+      end if;
+
+      if not A_Zero_Result( Tan(Complex_Zero) ) then
+         Report.Failed("Non-zero result from Function Tan with zero input");
+      end if;
+
+      if not A_Zero_Result( Arctan(Complex_Zero) ) then
+         Report.Failed("Non-zero result from Function Arctan with zero " &
+                       "input");
+      end if;
+
+      if not A_Zero_Result( Sinh(Complex_Zero) ) then
+         Report.Failed("Non-zero result from Function Sinh with zero input");
+      end if;
+
+      if not A_Zero_Result( Arcsinh(Complex_Zero) ) then
+         Report.Failed("Non-zero result from Function Arcsinh with zero " &
+                       "input");
+      end if;
+
+      if not A_Zero_Result( Tanh(Complex_Zero) ) then
+         Report.Failed("Non-zero result from Function Tanh with zero input");
+      end if;
+
+      if not A_Zero_Result( Arctanh(Complex_Zero) ) then
+         Report.Failed("Non-zero result from Function Arctanh with zero " &
+                       "input");
+      end if;
+
+
+      -- Check that when the input parameter value is zero, the following
+      -- functions yield a result of one.
+
+      if Exp(Complex_Zero) /= Plus_One 
+      then
+         Report.Failed("Non-zero result from Function Exp with zero input");
+      end if;
+
+      if Cos(Complex_Zero) /= Plus_One 
+      then
+         Report.Failed("Non-zero result from Function Cos with zero input");
+      end if;
+
+      if Cosh(Complex_Zero) /= Plus_One 
+      then
+         Report.Failed("Non-zero result from Function Cosh with zero input");
+      end if;
+
+
+      -- Check that when the input parameter value is zero, the following
+      -- functions yield a real result.
+
+      if not A_Real_Result( Arccos(Complex_Zero) ) then
+        Report.Failed("Non-real result from Function Arccos with zero input");
+      end if;
+
+      if not A_Real_Result( Arccot(Complex_Zero) ) then
+        Report.Failed("Non-real result from Function Arccot with zero input");
+      end if;
+
+
+      -- Check that when the input parameter value is zero, the following
+      -- functions yield an imaginary result.
+
+      if not An_Imaginary_Result( Arccoth(Complex_Zero) ) then
+        Report.Failed("Non-imaginary result from Function Arccoth with " &
+                      "zero input");
+      end if;
+
+
+      -- Check that when the input parameter value is one, the Sqrt function 
+      -- yields a result of one.
+
+      if Sqrt(Plus_One) /= Plus_One then
+         Report.Failed("Incorrect result from Function Sqrt with input " &
+                       "value of one");
+      end if;
+
+
+      -- Check that when the input parameter value is one, the following 
+      -- functions yield a result of zero.
+
+      if not A_Zero_Result( Log(Plus_One) ) then
+         Report.Failed("Non-zero result from Function Log with input " &
+                       "value of one");
+      end if;
+
+      if not A_Zero_Result( Arccos(Plus_One) ) then
+         Report.Failed("Non-zero result from Function Arccos with input " &
+                       "value of one");
+      end if;
+
+      if not A_Zero_Result( Arccosh(Plus_One) ) then
+         Report.Failed("Non-zero result from Function Arccosh with input " &
+                       "value of one");
+      end if;
+
+
+      -- Check that when the input parameter value is one, the Arcsin 
+      -- function yields a real result.
+
+      if not A_Real_Result( Arcsin(Plus_One) ) then
+         Report.Failed("Non-real result from Function Arcsin with input " &
+                       "value of one");
+      end if;
+
+
+      -- Check that when the input parameter value is minus one, the Sqrt 
+      -- function yields a result of "i", when the sign of the imaginary
+      -- component of the input parameter is positive (and yields "-i", if 
+      -- the sign on the imaginary component is negative), and the 
+      -- Complex_Types.Real'Signed_Zeros attribute is True.
+
+      if TC_Signed_Zeros then
+
+         declare
+            Minus_One_With_Pos_Zero_Im_Component : Complex := 
+                                  Compose_From_Cartesian(-1.0, +0.0);
+            Minus_One_With_Neg_Zero_Im_Component : Complex := 
+              Compose_From_Cartesian
+                (-1.0, Real_Type(ImpDef.Annex_G.Negative_Zero));
+         begin
+
+            if Sqrt(Minus_One_With_Pos_Zero_Im_Component) /= Plus_i then
+               Report.Failed("Incorrect result from Function Sqrt, when " &
+                             "input value is minus one with a positive "  &
+                             "imaginary component, Signed_Zeros being True");
+            end if;
+
+            if Sqrt(Minus_One_With_Neg_Zero_Im_Component) /= Minus_i then
+               Report.Failed("Incorrect result from Function Sqrt, when " &
+                             "input value is minus one with a negative "  &
+                             "imaginary component, Signed_Zeros being True");
+            end if;
+         end;
+
+      else   -- Signed_Zeros is False.
+
+         -- Check that when the input parameter value is minus one, the Sqrt 
+         -- function yields a result of "i", when the 
+         -- Complex_Types.Real'Signed_Zeros attribute is False.
+
+         if Sqrt(Minus_One) /= Plus_i then
+            Report.Failed("Incorrect result from Function Sqrt, when "    &
+                          "input value is minus one, Signed_Zeros being " & 
+                          "False");
+         end if;
+
+      end if;
+
+
+      -- Check that when the input parameter value is minus one, the Log
+      -- function yields an imaginary result.
+
+      if not An_Imaginary_Result( Log(Minus_One) ) then
+         Report.Failed("Non-imaginary result from Function Log with a " &
+                       "minus one input value");
+      end if;
+
+      -- Check that when the input parameter is minus one, the following 
+      -- functions yield a real result.
+
+      if not A_Real_Result( Arcsin(Minus_One) ) then
+         Report.Failed("Non-real result from Function Arcsin with a " &
+                       "minus one input value");
+      end if;
+
+      if not A_Real_Result( Arccos(Minus_One) ) then
+         Report.Failed("Non-real result from Function Arccos with a " &
+                       "minus one input value");
+      end if;
+
+
+      -- Check that when the input parameter has a value of +i or -i, the
+      -- Log function yields an imaginary result.
+
+      if not An_Imaginary_Result( Log(Plus_i) ) then
+         Report.Failed("Non-imaginary result from Function Log with an " &
+                       "input value of ""+i""");
+      end if;
+
+      if not An_Imaginary_Result( Log(Minus_i) ) then
+         Report.Failed("Non-imaginary result from Function Log with an " &
+                       "input value of ""-i""");
+      end if;
+
+
+      -- Check that exponentiation by a zero exponent yields the value one.
+
+      if "**"(Left  => Compose_From_Cartesian(5.0, 3.0), 
+              Right => Complex_Zero)                     /= Plus_One  or
+         Complex_Negative_Real**0.0                      /= Plus_One  or
+         15.0**Complex_Zero                              /= Plus_One
+      then
+         Report.Failed("Incorrect result from exponentiation with a zero " &
+                       "exponent");
+      end if;
+
+
+      -- Check that exponentiation by a unit exponent yields the value of 
+      -- the left operand (as a complex value).
+      -- Note: a "unit exponent" is considered the complex number (1.0, 0.0)
+
+      if "**"(Complex_Negative_Real, Plus_One) /= 
+         Complex_Negative_Real                    or
+         Complex_Negative_Imaginary**Plus_One  /= 
+         Complex_Negative_Imaginary               or
+         4.0**Plus_One                         /= 
+         Compose_From_Cartesian(4.0, 0.0)
+      then
+         Report.Failed("Incorrect result from exponentiation with a unit " &
+                       "exponent");
+      end if;
+
+
+      -- Check that exponentiation of the value one yields the value one.
+
+      if "**"(Plus_One, Complex_Negative_Imaginary) /= Plus_One  or
+         Plus_One**9.0                              /= Plus_One  or
+         1.0**Complex_Negative_Real                 /= Plus_One
+      then
+         Report.Failed("Incorrect result from exponentiation of the value " &
+                       "One");
+      end if;
+
+
+      -- Check that exponentiation of the value zero yields the value zero.
+      begin
+         if not A_Zero_Result("**"(Complex_Zero, 
+                                   Complex_Positive_Imaginary)) or
+            not A_Zero_Result(Complex_Zero**4.0)                or
+            not A_Zero_Result(0.0**Complex_Positive_Real)
+         then
+            Report.Failed("Incorrect result from exponentiation of the " &
+                          "value zero");
+         end if;
+      exception
+         when others =>
+           Report.Failed("Exception raised during the exponentiation of " &
+                         "the complex value zero");
+      end;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXG1005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a
new file mode 100644
index 000000000..0d7afa460
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2001.a
@@ -0,0 +1,322 @@
+-- CXG2001.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 floating point attributes Model_Mantissa,
+--      Machine_Mantissa, Machine_Radix, and Machine_Rounds
+--      are properly reported.
+--
+-- TEST DESCRIPTION:
+--      This test uses a generic package to compute and check the
+--      values of the Machine_  attributes listed above.  The
+--      generic package is instantiated with the standard FLOAT 
+--      type and a floating point type for the maximum number
+--      of digits of precision.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--
+--
+-- CHANGE HISTORY:
+--      26 JAN 96   SAIC    Initial Release for 2.1
+--
+--!
+
+-- References:
+--
+--    "Algorithms To Reveal Properties of Floating-Point Arithmetic"
+--    Michael A. Malcolm;  CACM November 1972;  pgs 949-951.
+--
+--    Software Manual for Elementary Functions; W. J. Cody and W. Waite;
+--    Prentice-Hall; 1980
+-----------------------------------------------------------------------
+-- 
+-- This test relies upon the fact that
+-- (A+2.0)-A is not necessarily 2.0.  If A is large enough then adding 
+-- a small value to A does not change the value of A.  Consider the case
+-- where we have a decimal based floating point representation with 4
+-- digits of precision.  A floating point number would logically be 
+-- represented as "DDDD * 10 ** exp" where D is a value in the range 0..9.
+-- The first loop of the test starts A at 2.0 and doubles it until
+-- ((A+1.0)-A)-1.0 is no longer zero.  For our decimal floating point
+-- number this will be 1638 * 10**1  (the value 16384 rounded or truncated
+-- to fit in 4 digits).
+-- The second loop starts B at 2.0 and keeps doubling B until (A+B)-A is
+-- no longer 0.  This will keep looping until B is 8.0 because that is
+-- the first value where rounding (assuming our machine rounds and addition
+-- employs a guard digit) will change the upper 4 digits of the result:
+--       1638_
+--     +     8
+--      -------
+--       1639_
+-- Without rounding the second loop will continue until
+-- B is 16:
+--       1638_
+--     +    16
+--      -------
+--       1639_
+-- 
+-- The radix is then determined by (A+B)-A which will give 10.
+-- 
+-- The use of Tmp and ITmp in the test is to force values to be 
+-- stored into memory in the event that register precision is greater
+-- than the stored precision of the floating point values.
+--      
+-- 
+-- The test for rounding is (ignoring the temporary variables used to 
+-- get the stored precision) is 
+--       Rounds := A + Radix/2.0 - A /= 0.0 ;
+-- where A is the value determined in the first step that is the smallest
+-- power of 2 such that A + 1.0 = A.  This means that the true value of
+-- A has one more digit in its value than 'Machine_Mantissa.
+-- This check will detect the case where a value is always rounded.
+-- There is an additional case where values are rounded to the nearest
+-- even value.  That is referred to as IEEE style rounding in the test.
+-- 
+-----------------------------------------------------------------------
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+procedure CXG2001 is
+   Verbose : constant Boolean := False;
+
+   -- if one of the attribute computation loops exceeds Max_Iterations
+   -- it is most likely due to the compiler reordering an expression
+   -- that should not be reordered.
+   Illegal_Optimization : exception;
+   Max_Iterations : constant := 10_000;
+
+   generic
+      type Real is digits <>;
+   package Chk_Attrs is
+      procedure Do_Test;
+   end Chk_Attrs;
+
+   package body Chk_Attrs is
+      package EF is new Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Log (X : Real) return Real renames EF.Log;
+
+
+                                   -- names used in paper
+      Radix : Integer;             -- Beta
+      Mantissa_Digits : Integer;   -- t
+      Rounds : Boolean;            -- RND
+
+      -- made global to Determine_Attributes to help thwart optimization
+      A, B : Real := 2.0;
+      Tmp, Tmpa, Tmp1 : Real;
+      ITmp : Integer;
+      Half_Radix : Real;
+
+      -- special constants - not declared as constants so that 
+      -- the "stored" precision will be used instead of a "register"
+      -- precision.
+      Zero : Real := 0.0;
+      One  : Real := 1.0;
+      Two  : Real := 2.0;
+
+
+      procedure Thwart_Optimization is
+      -- the purpose of this procedure is to reference the
+      -- global variables used by Determine_Attributes so
+      -- that the compiler is not likely to keep them in
+      -- a higher precision register for their entire lifetime.
+      begin
+	 if Report.Ident_Bool (False) then
+	    -- never executed
+	    A := A + 5.0;
+	    B := B + 6.0;
+	    Tmp := Tmp + 1.0;
+	    Tmp1 := Tmp1 + 2.0;
+	    Tmpa := Tmpa + 2.0;
+            One := 12.34;   Two := 56.78;  Zero := 90.12;
+	 end if;
+      end Thwart_Optimization;
+
+
+      -- determines values for Radix, Mantissa_Digits, and Rounds
+      -- This is mostly a straight translation of the C code.
+      -- The only significant addition is the iteration count
+      -- to prevent endless looping if things are really screwed up.
+      procedure Determine_Attributes is
+         Iterations : Integer;
+      begin
+         Rounds := True;
+
+         Iterations := 0;
+         Tmp := Real'Machine (((A + One) - A) - One);
+         while Tmp = Zero loop
+            A := Real'Machine(A + A);
+            Tmp := Real'Machine(A + One);
+            Tmp1 := Real'Machine(Tmp - A);
+	    Tmp := Real'Machine(Tmp1 - One);
+
+            Iterations := Iterations + 1;
+            if Iterations > Max_Iterations then
+               raise Illegal_Optimization;
+            end if;
+         end loop;
+
+         Iterations := 0;
+	 Tmp := Real'Machine(A + B);
+	 ITmp := Integer (Tmp - A);
+         while ITmp = 0 loop
+            B := Real'Machine(B + B);
+	    Tmp := Real'Machine(A + B);
+	    ITmp := Integer (Tmp - A);
+
+            Iterations := Iterations + 1;
+            if Iterations > Max_Iterations then
+               raise Illegal_Optimization;
+            end if;
+         end loop;
+
+         Radix := ITmp;
+
+         Mantissa_Digits := 0;
+         B := 1.0;
+	 Tmp := Real'Machine(((B + One) - B) - One);
+         Iterations := 0;
+         while (Tmp = Zero) loop
+            Mantissa_Digits := Mantissa_Digits + 1;
+            B := B * Real (Radix);
+	    Tmp := Real'Machine(B + One);
+	    Tmp1 := Real'Machine(Tmp - B);
+	    Tmp := Real'Machine(Tmp1 - One);
+
+            Iterations := Iterations + 1;
+            if Iterations > Max_Iterations then
+               raise Illegal_Optimization;
+            end if;
+         end loop;
+
+	 Rounds := False;
+	 Half_Radix := Real (Radix) / Two;
+	 Tmp := Real'Machine(A + Half_Radix);
+	 Tmp1 := Real'Machine(Tmp - A);
+	 if (Tmp1 /= Zero) then
+	    Rounds := True;
+	 end if;
+	 Tmpa := Real'Machine(A + Real (Radix));
+	 Tmp := Real'Machine(Tmpa + Half_Radix);
+	 if not Rounds and (Tmp - TmpA /= Zero) then
+	    Rounds := True;
+            if Verbose then
+	       Report.Comment ("IEEE style rounding");
+            end if;
+	 end if;
+
+      exception
+	 when others =>
+	    Thwart_Optimization;
+	    raise;
+      end Determine_Attributes;
+
+
+      procedure Do_Test is
+         Show_Results : Boolean := Verbose;
+         Min_Mantissa_Digits : Integer;
+      begin
+         -- compute the actual Machine_* attribute values
+         Determine_Attributes;
+
+         if Real'Machine_Radix /= Radix then
+            Report.Failed ("'Machine_Radix incorrectly reports" &
+                           Integer'Image (Real'Machine_Radix));
+            Show_Results := True;
+         end if;
+
+         if Real'Machine_Mantissa /= Mantissa_Digits then
+            Report.Failed ("'Machine_Mantissa incorrectly reports" &
+                           Integer'Image (Real'Machine_Mantissa));
+            Show_Results := True;
+         end if;
+
+         if Real'Machine_Rounds /= Rounds then
+            Report.Failed ("'Machine_Rounds incorrectly reports " &
+                           Boolean'Image (Real'Machine_Rounds));
+            Show_Results := True;
+         end if;
+
+         if Show_Results then
+            Report.Comment ("computed Machine_Mantissa is" & 
+                            Integer'Image (Mantissa_Digits));
+            Report.Comment ("computed Radix is" &
+                            Integer'Image (Radix));
+            Report.Comment ("computed Rounds is " &
+                            Boolean'Image (Rounds));
+         end if;
+
+         -- check the model attributes against the machine attributes
+	 -- G.2.2(3)/3;6.0
+         if Real'Model_Mantissa > Real'Machine_Mantissa then
+	    Report.Failed ("model mantissa > machine mantissa");
+	 end if;
+
+         -- G.2.2(3)/2;6.0
+         --  'Model_Mantissa >= ceiling(d*log(10)/log(radix))+1
+         Min_Mantissa_Digits := 
+           Integer (
+              Real'Ceiling (
+                 Real(Real'Digits) * Log(10.0) / Log(Real(Real'Machine_Radix))
+                   )       ) + 1;
+         if Real'Model_Mantissa < Min_Mantissa_Digits then
+            Report.Failed ("Model_Mantissa [" &
+                           Integer'Image (Real'Model_Mantissa) &
+                           "] < minimum mantissa digits [" &
+                           Integer'Image (Min_Mantissa_Digits) &
+                           "]");
+         end if;
+
+      exception
+         when Illegal_Optimization =>
+             Report.Failed ("illegal optimization of" &
+                            " floating point expression");
+      end Do_Test;
+   end Chk_Attrs;
+
+   package Chk_Float is new Chk_Attrs (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package Chk_A_Long_Float is new Chk_Attrs (A_Long_Float);
+begin
+   Report.Test ("CXG2001",
+                "Check the attributes Model_Mantissa," &
+                " Machine_Mantissa, Machine_Radix," &
+                " and Machine_Rounds");
+
+   Report.Comment ("checking Standard.Float");
+   Chk_Float.Do_Test;
+
+   Report.Comment ("checking a digits" & 
+                   Integer'Image (System.Max_Digits) &
+                   " floating point type");
+   Chk_A_Long_Float.Do_Test;
+
+   Report.Result;
+end CXG2001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2002.a
new file mode 100644
index 000000000..6a1f322e8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2002.a
@@ -0,0 +1,468 @@
+-- CXG2002.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 complex "abs" or modulus function returns
+--      results that are within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test uses a generic package to compute and check the
+--      values of the modulus function.  In addition, a non-generic
+--      copy of this package is used to check the non-generic package
+--      Ada.Numerics.Complex_Types.
+--      Of special interest is the case where either the real or
+--      the imaginary part of the argument is very large while the
+--      other part is very small or 0. 
+--      We want to check that the value is computed such that
+--      an overflow does not occur.  If computed directly from the
+--      definition 
+--        abs (x+yi) = sqrt(x**2 + y**2)
+--      then overflow or underflow is much more likely than if the
+--      argument is normalized first.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      31 JAN 96   SAIC    Initial release for 2.1
+--      02 JUN 98   EDS     Add parens to intermediate calculations.
+--!
+
+--
+-- Reference:
+-- Problems and Methodologies in Mathematical Software Production;
+-- editors: P. C. Messina and A Murli;
+-- Lecture Notes in Computer Science
+-- Volume 142
+-- Springer Verlag 1982
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Complex_Types;
+procedure CXG2002 is
+   Verbose : constant Boolean := False;
+   Maximum_Relative_Error : constant := 3.0;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Complex_Types is new 
+           Ada.Numerics.Generic_Complex_Types (Real);
+      use Complex_Types;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real := Maximum_Relative_Error) is
+         Rel_Error,
+         Abs_Error,
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & 
+                           Real'Image (Expected - Actual) &
+                           " max_err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Do_Test is
+         Z : Complex;
+         X : Real;
+         T : Real;
+      begin
+
+         --- test 1 ---
+         begin
+            T := Real'Safe_Last;
+            Z := T + 0.0*i;
+            X := abs Z;
+            Check (X, T, "test 1 -- abs(bigreal + 0i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+	 --- test 2 ---
+         begin
+            T := Real'Safe_Last;
+	    Z := 0.0 + T*i;
+	    X := Modulus (Z);
+            Check (X, T, "test 2 -- abs(0 + bigreal*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+	 --- test 3 ---
+         begin
+	    Z := 3.0 + 4.0*i;
+	    X := abs Z;
+            Check (X, 5.0 , "test 3 -- abs(3 + 4*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 3");
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+	 --- test 4 ---
+         declare
+            S : Real;
+         begin
+            S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3);
+	    Z := 3.0 * S + 4.0*S*i;
+	    X := abs Z;
+            Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S", 
+                   5.0*Real'Model_Epsilon);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 4");
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+	 --- test 5 --- 
+         begin
+            T := Real'Model_Small;
+	    Z := T + 0.0*i;
+	    X := abs Z;
+            Check (X, T , "test 5 -- abs(small + 0*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 5");
+            when others =>
+               Report.Failed ("exception in test 5");
+         end;
+
+	 --- test 6 ---
+         begin
+            T := Real'Model_Small;
+	    Z := 0.0 + T*i;
+	    X := abs Z;
+            Check (X, T , "test 6 -- abs(0 + small*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 6");
+            when others =>
+               Report.Failed ("exception in test 6");
+         end;
+
+	 --- test 7 ---
+         declare
+            S : Real;
+         begin
+            S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3);
+	    Z := 3.0 * S + 4.0*S*i;
+	    X := abs Z;
+            Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S", 
+                   5.0*Real'Model_Epsilon);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 7");
+            when others =>
+               Report.Failed ("exception in test 7");
+         end;
+
+	 --- test 8 ---
+         declare
+            -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+            Sqrt2 : constant := 
+              1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+         begin
+	    Z := 1.0 + 1.0*i;
+	    X := abs Z;
+            Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 8");
+            when others =>
+               Report.Failed ("exception in test 8");
+         end;
+
+	 --- test 9 --- 
+         begin
+            T := 0.0;
+	    Z := T + 0.0*i;
+	    X := abs Z;
+            Check (X, T , "test 5 -- abs(0 + 0*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 9");
+            when others =>
+               Report.Failed ("exception in test 9");
+         end;
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   --- non generic copy of the above generic package
+   -----------------------------------------------------------------------
+
+   package Non_Generic_Check is
+      subtype Real is Float;
+      procedure Do_Test;
+   end Non_Generic_Check;
+
+   package body Non_Generic_Check is
+      use Ada.Numerics.Complex_Types;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real := Maximum_Relative_Error) is
+         Rel_Error,
+         Abs_Error,
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & 
+                           Real'Image (Expected - Actual) &
+                           " max_err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Do_Test is
+         Z : Complex;
+         X : Real;
+         T : Real;
+      begin
+
+         --- test 1 ---
+         begin
+            T := Real'Safe_Last;
+            Z := T + 0.0*i;
+            X := abs Z;
+            Check (X, T, "test 1 -- abs(bigreal + 0i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+	 --- test 2 ---
+         begin
+            T := Real'Safe_Last;
+	    Z := 0.0 + T*i;
+	    X := Modulus (Z);
+            Check (X, T, "test 2 -- abs(0 + bigreal*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+	 --- test 3 ---
+         begin
+	    Z := 3.0 + 4.0*i;
+	    X := abs Z;
+            Check (X, 5.0 , "test 3 -- abs(3 + 4*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 3");
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+	 --- test 4 ---
+         declare
+            S : Real;
+         begin
+            S := Real(Real'Machine_Radix) ** (Real'Machine_EMax - 3);
+	    Z := 3.0 * S + 4.0*S*i;
+	    X := abs Z;
+            Check (X, 5.0*S, "test 4 -- abs(3S + 4S*i) for large S", 
+                   5.0*Real'Model_Epsilon);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 4");
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+	 --- test 5 --- 
+         begin
+            T := Real'Model_Small;
+	    Z := T + 0.0*i;
+	    X := abs Z;
+            Check (X, T , "test 5 -- abs(small + 0*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 5");
+            when others =>
+               Report.Failed ("exception in test 5");
+         end;
+
+	 --- test 6 ---
+         begin
+            T := Real'Model_Small;
+	    Z := 0.0 + T*i;
+	    X := abs Z;
+            Check (X, T , "test 6 -- abs(0 + small*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 6");
+            when others =>
+               Report.Failed ("exception in test 6");
+         end;
+
+	 --- test 7 ---
+         declare
+            S : Real;
+         begin
+            S := Real(Real'Machine_Radix) ** (Real'Model_EMin + 3);
+	    Z := 3.0 * S + 4.0*S*i;
+	    X := abs Z;
+            Check (X, 5.0*S, "test 7 -- abs(3S + 4S*i) for small S", 
+                   5.0*Real'Model_Epsilon);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 7");
+            when others =>
+               Report.Failed ("exception in test 7");
+         end;
+
+	 --- test 8 ---
+         declare
+            -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+            Sqrt2 : constant := 
+              1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+         begin
+	    Z := 1.0 + 1.0*i;
+	    X := abs Z;
+            Check (X, Sqrt2 , "test 8 -- abs(1 + 1*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 8");
+            when others =>
+               Report.Failed ("exception in test 8");
+         end;
+
+	 --- test 9 --- 
+         begin
+            T := 0.0;
+	    Z := T + 0.0*i;
+	    X := abs Z;
+            Check (X, T , "test 5 -- abs(0 + 0*i)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 9");
+            when others =>
+               Report.Failed ("exception in test 9");
+         end;
+      end Do_Test;
+   end Non_Generic_Check;
+
+   -----------------------------------------------------------------------
+   --- end of "manual instantiation" 
+   -----------------------------------------------------------------------
+   package Chk_Float is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package Chk_A_Long_Float is new Generic_Check (A_Long_Float);
+begin
+   Report.Test ("CXG2002",
+                "Check the accuracy of the complex modulus" &
+                " function");
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+   Chk_Float.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+   Chk_A_Long_Float.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking non-generic package");
+   end if;
+   Non_Generic_Check.Do_Test;
+   Report.Result;
+end CXG2002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2003.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2003.a
new file mode 100644
index 000000000..d1a225a50
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2003.a
@@ -0,0 +1,701 @@
+-- CXG2003.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 sqrt function returns
+--      results that are within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test contains three test packages that are almost
+--      identical.  The first two packages differ only in the 
+--      floating point type that is being tested.  The first
+--      and third package differ only in whether the generic
+--      elementary functions package or the pre-instantiated
+--      package is used.
+--      The test package is not generic so that the arguments
+--      and expected results for some of the test values
+--      can be expressed as universal real instead of being
+--      computed at runtime.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--       2 FEB 96   SAIC    Initial release for 2.1
+--      18 AUG 96   SAIC    Made Check consistent with other tests.
+--
+--!
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+with Ada.Numerics.Elementary_Functions;
+procedure CXG2003 is
+   Verbose : constant Boolean := False;
+
+   package Float_Check is
+      subtype Real is Float;
+      procedure Do_Test;
+   end Float_Check;
+
+   package body Float_Check is
+      package Elementary_Functions is new 
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Sqrt (X : Real) return Real renames
+           Elementary_Functions.Sqrt;
+      function Log (X : Real) return Real renames
+           Elementary_Functions.Log;
+      function Exp (X : Real) return Real renames
+           Elementary_Functions.Exp;
+
+      -- The default Maximum Relative Error is the value specified
+      -- in the LRM.
+      Default_MRE : constant Real := 2.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real := Default_MRE) is
+         Rel_Error : Real;
+         Abs_Error : Real;
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & 
+                           Real'Image (Actual - Expected) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+ 
+     procedure Argument_Range_Check (A, B : Real;
+                                      Test : String) is
+         -- test a logarithmically distributed selection of 
+         -- arguments selected from the range A to B. 
+         X : Real;
+         Expected : Real;
+         Y : Real;
+         C : Real := Log(B/A);
+         Max_Samples : constant := 1000;
+
+      begin
+         for I in 1..Max_Samples loop
+            Expected :=  A * Exp(C * Real (I) / Real (Max_Samples));
+            X := Expected * Expected;
+            Y := Sqrt (X);
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+            Check (Y, Expected, 
+                   "test " & Test & " -" &
+                   Integer'Image (I) &
+                   " of argument range",
+                   3.0);
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in argument range check");
+         when others =>
+            Report.Failed ("exception in argument range check");
+      end Argument_Range_Check;
+
+      procedure Do_Test is
+      begin
+
+         --- test 1 ---
+         declare
+            T : constant := (Real'Machine_EMax - 1) / 2;
+            X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
+	    Expected : constant := (1.0 * Real'Machine_Radix) ** T;
+	    Y : Real;
+         begin
+            Y := Sqrt (X);
+            Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+         --- test 2 ---
+	 declare
+            T : constant := (Real'Model_EMin + 1) / 2;
+            X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
+	    Expected : constant := (1.0 * Real'Machine_Radix) ** T;
+	    Y : Real;
+         begin
+            Y := Sqrt (X);
+            Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+         --- test 3 ---
+	 declare
+	    X : constant := 1.0;
+	    Expected : constant := 1.0;
+            Y : Real;
+         begin
+            Y := Sqrt(X);
+            Check (Y, Expected, "test 3 -- sqrt(1.0)", 
+                 0.0);   -- no error allowed
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 3");
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+         --- test 4 ---
+	 declare
+	    X : constant := 0.0;
+	    Expected : constant := 0.0;
+            Y : Real;
+         begin
+            Y := Sqrt(X);
+            Check (Y, Expected, "test 4 -- sqrt(0.0)", 
+                 0.0);   -- no error allowed
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 4");
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+         --- test 5 ---
+	 declare
+	    X : constant := -1.0;
+            Y : Real;
+         begin
+            Y := Sqrt(X);
+            -- the following code should not be executed.
+            -- The call to Check is to keep the call to Sqrt from
+            -- appearing to be dead code.
+            Check (Y, -1.0, "test 5 -- sqrt(-1)" );
+            Report.Failed ("test 5 - argument_error expected");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 5");
+            when Ada.Numerics.Argument_Error =>
+               if Verbose then
+                  Report.Comment ("test 5 correctly got argument_error");
+               end if;
+            when others =>
+               Report.Failed ("exception in test 5");
+         end;
+
+         --- test 6 ---
+	 declare
+            X : constant := Ada.Numerics.Pi ** 2;
+	    Expected : constant := Ada.Numerics.Pi;
+	    Y : Real;
+         begin
+            Y := Sqrt (X);
+            Check (Y, Expected, "test 6 -- sqrt(pi**2)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 6");
+            when others =>
+               Report.Failed ("exception in test 6");
+         end;
+
+         --- test 7 & 8 ---
+         Argument_Range_Check (1.0/Sqrt(Real(Real'Machine_Radix)), 
+                                1.0, 
+                                "7");
+         Argument_Range_Check (1.0, 
+                                Sqrt(Real(Real'Machine_Radix)), 
+                                "8");
+      end Do_Test;
+   end Float_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+
+
+   package A_Long_Float_Check is
+      subtype Real is A_Long_Float;
+      procedure Do_Test;
+   end A_Long_Float_Check;
+
+   package body A_Long_Float_Check is
+      package Elementary_Functions is new 
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Sqrt (X : Real) return Real renames
+           Elementary_Functions.Sqrt;
+      function Log (X : Real) return Real renames
+           Elementary_Functions.Log;
+      function Exp (X : Real) return Real renames
+           Elementary_Functions.Exp;
+
+      -- The default Maximum Relative Error is the value specified
+      -- in the LRM.
+      Default_MRE : constant Real := 2.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real := Default_MRE) is
+         Rel_Error : Real;
+         Abs_Error : Real;
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & 
+                           Real'Image (Actual - Expected) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Argument_Range_Check (A, B : Real;
+                                      Test : String) is
+         -- test a logarithmically distributed selection of 
+         -- arguments selected from the range A to B. 
+         X : Real;
+         Expected : Real;
+         Y : Real;
+         C : Real := Log(B/A);
+         Max_Samples : constant := 1000;
+
+      begin
+         for I in 1..Max_Samples loop
+            Expected :=  A * Exp(C * Real (I) / Real (Max_Samples));
+            X := Expected * Expected;
+            Y := Sqrt (X);
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+            Check (Y, Expected, 
+                   "test " & Test & " -" &
+                   Integer'Image (I) &
+                   " of argument range",
+                   3.0);
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in argument range check");
+         when others =>
+            Report.Failed ("exception in argument range check");
+      end Argument_Range_Check;
+
+
+      procedure Do_Test is
+      begin
+
+         --- test 1 ---
+         declare
+            T : constant := (Real'Machine_EMax - 1) / 2;
+            X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
+	    Expected : constant := (1.0 * Real'Machine_Radix) ** T;
+	    Y : Real;
+         begin
+            Y := Sqrt (X);
+            Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+         --- test 2 ---
+	 declare
+            T : constant := (Real'Model_EMin + 1) / 2;
+            X : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
+	    Expected : constant := (1.0 * Real'Machine_Radix) ** T;
+	    Y : Real;
+         begin
+            Y := Sqrt (X);
+            Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+         --- test 3 ---
+	 declare
+	    X : constant := 1.0;
+	    Expected : constant := 1.0;
+            Y : Real;
+         begin
+            Y := Sqrt(X);
+            Check (Y, Expected, "test 3 -- sqrt(1.0)", 
+                 0.0);   -- no error allowed
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 3");
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+         --- test 4 ---
+	 declare
+	    X : constant := 0.0;
+	    Expected : constant := 0.0;
+            Y : Real;
+         begin
+            Y := Sqrt(X);
+            Check (Y, Expected, "test 4 -- sqrt(0.0)", 
+                 0.0);   -- no error allowed
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 4");
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+         --- test 5 ---
+	 declare
+	    X : constant := -1.0;
+            Y : Real;
+         begin
+            Y := Sqrt(X);
+            -- the following code should not be executed.
+            -- The call to Check is to keep the call to Sqrt from
+            -- appearing to be dead code.
+            Check (Y, -1.0, "test 5 -- sqrt(-1)" );
+            Report.Failed ("test 5 - argument_error expected");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 5");
+            when Ada.Numerics.Argument_Error =>
+               if Verbose then
+                  Report.Comment ("test 5 correctly got argument_error");
+               end if;
+            when others =>
+               Report.Failed ("exception in test 5");
+         end;
+
+         --- test 6 ---
+	 declare
+            X : constant := Ada.Numerics.Pi ** 2;
+	    Expected : constant := Ada.Numerics.Pi;
+	    Y : Real;
+         begin
+            Y := Sqrt (X);
+            Check (Y, Expected, "test 6 -- sqrt(pi**2)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 6");
+            when others =>
+               Report.Failed ("exception in test 6");
+         end;
+
+         --- test 7 & 8 ---
+         Argument_Range_Check (1.0/Sqrt(Real(Real'Machine_Radix)), 
+                                1.0, 
+                                "7");
+         Argument_Range_Check (1.0, 
+                                Sqrt(Real(Real'Machine_Radix)), 
+                                "8");
+      end Do_Test;
+   end A_Long_Float_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+   package Non_Generic_Check is
+      procedure Do_Test;
+   end Non_Generic_Check;
+
+   package body Non_Generic_Check is
+      package EF renames
+           Ada.Numerics.Elementary_Functions;
+      subtype Real is Float;
+
+      -- The default Maximum Relative Error is the value specified
+      -- in the LRM.
+      Default_MRE : constant Real := 2.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real := Default_MRE) is
+         Rel_Error : Real;
+         Abs_Error : Real;
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & 
+                           Real'Image (Actual - Expected) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+
+      procedure Argument_Range_Check (A, B : Float;
+                                      Test : String) is
+         -- test a logarithmically distributed selection of 
+         -- arguments selected from the range A to B. 
+         X : Float;
+         Expected : Float;
+         Y : Float;
+         C : Float := EF.Log(B/A);
+         Max_Samples : constant := 1000;
+
+      begin
+         for I in 1..Max_Samples loop
+            Expected :=  A * EF.Exp(C * Float (I) / Float (Max_Samples));
+            X := Expected * Expected;
+            Y := EF.Sqrt (X);
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+            Check (Y, Expected, 
+                   "test " & Test & " -" &
+                   Integer'Image (I) &
+                   " of argument range",
+                   3.0);
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in argument range check");
+         when others =>
+            Report.Failed ("exception in argument range check");
+      end Argument_Range_Check;
+
+
+      procedure Do_Test is
+      begin
+
+         --- test 1 ---
+         declare
+            T : constant := (Float'Machine_EMax - 1) / 2;
+            X : constant := (1.0 * Float'Machine_Radix) ** (2 * T);
+	    Expected : constant := (1.0 * Float'Machine_Radix) ** T;
+	    Y : Float;
+         begin
+            Y := EF.Sqrt (X);
+            Check (Y, Expected, "test 1 -- sqrt(radix**((emax-1)/2))");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+         --- test 2 ---
+	 declare
+            T : constant := (Float'Model_EMin + 1) / 2;
+            X : constant := (1.0 * Float'Machine_Radix) ** (2 * T);
+	    Expected : constant := (1.0 * Float'Machine_Radix) ** T;
+	    Y : Float;
+         begin
+            Y := EF.Sqrt (X);
+            Check (Y, Expected, "test 2 -- sqrt(radix**((emin+1)/2))");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+         --- test 3 ---
+	 declare
+	    X : constant := 1.0;
+	    Expected : constant := 1.0;
+            Y : Float;
+         begin
+            Y := EF.Sqrt(X);
+            Check (Y, Expected, "test 3 -- sqrt(1.0)", 
+                 0.0);   -- no error allowed
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 3");
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+         --- test 4 ---
+	 declare
+	    X : constant := 0.0;
+	    Expected : constant := 0.0;
+            Y : Float;
+         begin
+            Y := EF.Sqrt(X);
+            Check (Y, Expected, "test 4 -- sqrt(0.0)", 
+                 0.0);   -- no error allowed
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 4");
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+         --- test 5 ---
+	 declare
+	    X : constant := -1.0;
+            Y : Float;
+         begin
+            Y := EF.Sqrt(X);
+            -- the following code should not be executed.
+            -- The call to Check is to keep the call to Sqrt from
+            -- appearing to be dead code.
+            Check (Y, -1.0, "test 5 -- sqrt(-1)" );
+            Report.Failed ("test 5 - argument_error expected");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 5");
+            when Ada.Numerics.Argument_Error =>
+               if Verbose then
+                  Report.Comment ("test 5 correctly got argument_error");
+               end if;
+            when others =>
+               Report.Failed ("exception in test 5");
+         end;
+
+         --- test 6 ---
+	 declare
+            X : constant := Ada.Numerics.Pi ** 2;
+	    Expected : constant := Ada.Numerics.Pi;
+	    Y : Float;
+         begin
+            Y := EF.Sqrt (X);
+            Check (Y, Expected, "test 6 -- sqrt(pi**2)");
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 6");
+            when others =>
+               Report.Failed ("exception in test 6");
+         end;
+
+         --- test 7 & 8 ---
+         Argument_Range_Check (1.0/EF.Sqrt(Float(Float'Machine_Radix)), 
+                                1.0, 
+                                "7");
+         Argument_Range_Check (1.0, 
+                                EF.Sqrt(Float(Float'Machine_Radix)), 
+                                "8");
+      end Do_Test;
+   end Non_Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+begin
+   Report.Test ("CXG2003",
+                "Check the accuracy of the sqrt function"); 
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking non-generic package");
+   end if;
+
+   Non_Generic_Check.Do_Test;
+
+   Report.Result;
+end CXG2003;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2004.a
new file mode 100644
index 000000000..2df296d3d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2004.a
@@ -0,0 +1,499 @@
+-- CXG2004.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 sin and cos functions return
+--      results that are within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is 
+--      instantiated to check both float and a long float type.
+--      The test for each floating point type is divided into
+--      the following parts:
+--         Special value checks where the result is a known constant.
+--         Checks using an identity relationship.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      13 FEB 96   SAIC    Initial release for 2.1
+--      22 APR 96   SAIC    Changed to generic implementation.
+--      18 AUG 96   SAIC    Improvements to commentary.
+--      23 OCT 96   SAIC    Exact results are not required unless the
+--                          cycle is specified.  
+--      28 FEB 97   PWB.CTA Removed checks where cycle 2.0*Pi is specified
+--      02 JUN 98   EDS     Revised calculations to ensure that X is exactly
+--                          three times Y per advice of numerics experts.
+--
+-- CHANGE NOTE:
+--      According to Ken Dritz, author of the Numerics Annex of the RM,
+--      one should never specify the cycle 2.0*Pi for the trigonometric
+--      functions.  In particular, if the machine number for the first
+--      argument is not an exact multiple of the machine number for the
+--      explicit cycle, then the specified exact results cannot be
+--      reasonably expected.  The affected checks in this test have been
+--      marked as comments, with the additional notation "pwb-math".
+--      Phil Brashear
+--!
+
+--
+-- References:
+--
+-- Software Manual for the Elementary Functions
+-- William J. Cody, Jr. and William Waite
+-- Prentice-Hall, 1980
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition 
+--
+-- Implementation and Testing of Function Software
+-- W. J. Cody
+-- Problems and Methodologies in Mathematical Software Production
+-- editors P. C. Messina and A. Murli
+-- Lecture Notes in Computer Science   Volume 142
+-- Springer Verlag, 1982
+--
+-- The sin and cos checks are translated directly from 
+-- the netlib FORTRAN code that was written by W. Cody.
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+with Ada.Numerics.Elementary_Functions;
+procedure CXG2004 is
+   Verbose : constant Boolean := False;
+   Number_Samples : constant := 1000;
+
+   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+   Sqrt2 : constant := 
+        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+   Sqrt3 : constant :=
+        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
+
+   Pi : constant := Ada.Numerics.Pi;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Elementary_Functions is new 
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+
+      function Sin (X : Real) return Real renames
+           Elementary_Functions.Sin;
+      function Cos (X : Real) return Real renames
+           Elementary_Functions.Cos;
+      function Sin (X, Cycle : Real) return Real renames
+           Elementary_Functions.Sin;
+      function Cos (X, Cycle : Real) return Real renames
+           Elementary_Functions.Cos;
+
+      Accuracy_Error_Reported : Boolean := False;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Rel_Error,
+         Abs_Error,
+         Max_Error : Real;
+      begin
+
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+
+         -- in addition to the relative error checks we apply the
+         -- criteria of G.2.4(16)
+         if abs (Actual) > 1.0 then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & " result > 1.0");
+         elsif abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " &
+                           Real'Image (Actual - Expected) &
+                           " mre:" & 
+                           Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Sin_Check (A, B : Real;
+                           Arg_Range : String) is
+         -- test a selection of 
+         -- arguments selected from the range A to B. 
+         --
+         -- This test uses the identity
+	 --   sin(x) = sin(x/3)*(3 - 4 * sin(x/3)**2)
+	 --
+         -- Note that in this test we must take into account the
+         -- error in the calculation of the expected result so
+         -- the maximum relative error is larger than the
+         -- accuracy required by the ARM.
+
+         X, Y, ZZ : Real;
+	 Actual, Expected : Real;
+	 MRE : Real;
+	 Ran : Real;
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1 .. Number_Samples loop
+	    -- Evenly distributed selection of arguments
+	    Ran := Real (I) / Real (Number_Samples);
+
+	    -- make sure x and x/3 are both exactly representable
+	    -- on the machine.  See "Implementation and Testing of
+            -- Function Software" page 44.
+            X := (B - A) * Ran + A;
+            Y := Real'Leading_Part 
+                      ( X/3.0, 
+                        Real'Machine_Mantissa - Real'Exponent (3.0) );
+            X := Y * 3.0;
+
+	    Actual := Sin (X);
+
+	    ZZ := Sin(Y);
+	    Expected := ZZ * (3.0 - 4.0 * ZZ * ZZ);
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+            -- See Cody pp 139-141.
+	    MRE := 4.0;
+
+            Check (Actual, Expected,
+                   "sin test of range" & Arg_Range &
+                      Integer'Image (I),
+                   MRE);
+            exit when Accuracy_Error_Reported;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in sin check");
+         when others =>
+            Report.Failed ("exception in sin check");
+      end Sin_Check;
+
+
+
+      procedure Cos_Check (A, B : Real;
+                                  Arg_Range : String) is
+         -- test a selection of 
+         -- arguments selected from the range A to B. 
+         --
+         -- This test uses the identity
+	 --   cos(x) = cos(x/3)*(4 * cos(x/3)**2 - 3)
+	 --
+         -- Note that in this test we must take into account the
+         -- error in the calculation of the expected result so
+         -- the maximum relative error is larger than the
+         -- accuracy required by the ARM.
+
+         X, Y, ZZ : Real;
+	 Actual, Expected : Real;
+	 MRE : Real;
+	 Ran : Real;
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1 .. Number_Samples loop
+	    -- Evenly distributed selection of arguments
+	    Ran := Real (I) / Real (Number_Samples);
+
+	    -- make sure x and x/3 are both exactly representable
+	    -- on the machine.  See "Implementation and Testing of
+            -- Function Software" page 44.
+            X := (B - A) * Ran + A;
+            Y := Real'Leading_Part 
+                      ( X/3.0, 
+                        Real'Machine_Mantissa - Real'Exponent (3.0) );
+            X := Y * 3.0;
+
+	    Actual := Cos (X);
+
+	    ZZ := Cos(Y);
+	    Expected := ZZ * (4.0 * ZZ * ZZ - 3.0);
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+            -- See Cody pp 141-143.
+	    MRE := 6.0;
+
+            Check (Actual, Expected,
+                   "cos test of range" & Arg_Range &
+                      Integer'Image (I),
+                   MRE);
+            exit when Accuracy_Error_Reported;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in cos check");
+         when others =>
+            Report.Failed ("exception in cos check");
+      end Cos_Check;
+
+
+      procedure Special_Angle_Checks is
+         type Data_Point is 
+            record
+               Degrees,
+               Radians,
+               Sine,
+               Cosine         : Real;
+               Sin_Result_Error,
+               Cos_Result_Error : Boolean;
+            end record;
+
+         type Test_Data_Type is array (Positive range <>) of Data_Point;
+
+         -- the values in the following table only involve static
+         -- expressions to minimize any loss of precision.  However,
+         -- there are two sources of error that must be accounted for
+         -- in the following tests.
+         -- First, when a cycle is not specified there can be a roundoff
+         -- error in the value of Pi used.  This error does not apply
+         -- when a cycle of 2.0 * Pi is explicitly provided.
+         -- Second, the expected results that involve sqrt values also
+         -- have a potential roundoff error.
+         -- The amount of error due to error in the argument is computed
+         -- as follows:
+         --   sin(x+err) = sin(x)*cos(err) + cos(x)*sin(err)
+         --              ~= sin(x) + err * cos(x)
+         -- similarly for cos the error due to error in the argument is
+         -- computed as follows:
+         --   cos(x+err) = cos(x)*cos(err) - sin(x)*sin(err)
+         --              ~= cos(x) - err * sin(x)
+         -- In both cases the term "err" is bounded by 0.5 * argument.
+
+         Test_Data : constant Test_Data_Type := (
+--  degrees      radians          sine       cosine  sin_er cos_er    test #
+  (  0.0,           0.0,          0.0,         1.0,  False, False ),    -- 1
+  ( 30.0,        Pi/6.0,          0.5,   Sqrt3/2.0,  False, True  ),    -- 2
+  ( 60.0,        Pi/3.0,    Sqrt3/2.0,         0.5,  True,  False ),    -- 3
+  ( 90.0,        Pi/2.0,          1.0,         0.0,  False, False ),    -- 4
+  (120.0,    2.0*Pi/3.0,    Sqrt3/2.0,        -0.5,  True,  False ),    -- 5
+  (150.0,    5.0*Pi/6.0,          0.5,  -Sqrt3/2.0,  False, True  ),    -- 6
+  (180.0,            Pi,          0.0,        -1.0,  False, False ),    -- 7
+  (210.0,    7.0*Pi/6.0,         -0.5,  -Sqrt3/2.0,  False, True  ),    -- 8
+  (240.0,    8.0*Pi/6.0,   -Sqrt3/2.0,        -0.5,  True,  False ),    -- 9
+  (270.0,    9.0*Pi/6.0,         -1.0,         0.0,  False, False ),    -- 10
+  (300.0,   10.0*Pi/6.0,   -Sqrt3/2.0,         0.5,  True,  False ),    -- 11
+  (330.0,   11.0*Pi/6.0,         -0.5,   Sqrt3/2.0,  False, True  ),    -- 12
+  (360.0,        2.0*Pi,          0.0,         1.0,  False, False ),    -- 13
+  ( 45.0,        Pi/4.0,    Sqrt2/2.0,   Sqrt2/2.0,  True,  True  ),    -- 14
+  (135.0,    3.0*Pi/4.0,    Sqrt2/2.0,  -Sqrt2/2.0,  True,  True  ),    -- 15
+  (225.0,    5.0*Pi/4.0,   -Sqrt2/2.0,  -Sqrt2/2.0,  True,  True  ),    -- 16
+  (315.0,    7.0*Pi/4.0,   -Sqrt2/2.0,   Sqrt2/2.0,  True,  True  ),    -- 17
+  (405.0,    9.0*Pi/4.0,    Sqrt2/2.0,   Sqrt2/2.0,  True,  True  ) );  -- 18
+            
+     
+         Y : Real;
+         Sin_Arg_Err,
+         Cos_Arg_Err,
+         Sin_Result_Err,
+         Cos_Result_Err  : Real;
+      begin
+         for I in Test_Data'Range loop
+            -- compute error components
+            Sin_Arg_Err := abs Test_Data (I).Cosine * 
+                           abs Test_Data (I).Radians / 2.0;
+            Cos_Arg_Err := abs Test_Data (I).Sine * 
+                           abs Test_Data (I).Radians / 2.0;
+
+            if Test_Data (I).Sin_Result_Error then
+               Sin_Result_Err := 0.5;
+            else 
+               Sin_Result_Err := 0.0;
+            end if;
+
+            if Test_Data (I).Cos_Result_Error then
+               Cos_Result_Err := 1.0;
+            else 
+               Cos_Result_Err := 0.0;
+            end if;
+
+
+
+            Y := Sin (Test_Data (I).Radians);
+            Check (Y, Test_Data (I).Sine,
+                   "test" & Integer'Image (I) & " sin(r)",
+                   2.0 + Sin_Arg_Err + Sin_Result_Err); 
+            Y := Cos (Test_Data (I).Radians);
+            Check (Y, Test_Data (I).Cosine,
+                   "test" & Integer'Image (I) & " cos(r)",
+                   2.0 + Cos_Arg_Err + Cos_Result_Err); 
+            Y := Sin (Test_Data (I).Degrees, 360.0);
+            Check (Y, Test_Data (I).Sine,
+                   "test" & Integer'Image (I) & " sin(d,360)",
+                   2.0 + Sin_Result_Err); 
+            Y := Cos (Test_Data (I).Degrees, 360.0);
+            Check (Y, Test_Data (I).Cosine,
+                   "test" & Integer'Image (I) & " cos(d,360)",
+                   2.0 + Cos_Result_Err); 
+--pwb-math            Y := Sin (Test_Data (I).Radians, 2.0*Pi);
+--pwb-math            Check (Y, Test_Data (I).Sine,
+--pwb-math                   "test" & Integer'Image (I) & " sin(r,2pi)",
+--pwb-math                   2.0 + Sin_Result_Err); 
+--pwb-math            Y := Cos (Test_Data (I).Radians, 2.0*Pi);
+--pwb-math            Check (Y, Test_Data (I).Cosine,
+--pwb-math                   "test" & Integer'Image (I) & " cos(r,2pi)",
+--pwb-math                   2.0 + Cos_Result_Err); 
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in special angle test");
+         when others =>
+            Report.Failed ("exception in special angle test");
+      end Special_Angle_Checks;
+
+
+      -- check the rule of A.5.1(41);6.0 which requires that the
+      -- result be exact if the mathematical result is 0.0, 1.0,
+      -- or -1.0
+      procedure Exact_Result_Checks is
+         type Data_Point is 
+            record
+               Degrees,
+               Sine,
+               Cosine         : Real;
+            end record;
+
+         type Test_Data_Type is array (Positive range <>) of Data_Point;
+         Test_Data : constant Test_Data_Type := (
+            -- degrees       sine       cosine       test #
+              (  0.0,         0.0,         1.0  ),    -- 1
+              ( 90.0,         1.0,         0.0  ),    -- 2
+              (180.0,         0.0,        -1.0  ),    -- 3
+              (270.0,        -1.0,         0.0  ),    -- 4
+              (360.0,         0.0,         1.0  ),    -- 5
+              ( 90.0 + 360.0, 1.0,         0.0  ),    -- 6
+              (180.0 + 360.0, 0.0,        -1.0  ),    -- 7
+              (270.0 + 360.0,-1.0,         0.0  ),    -- 8
+              (360.0 + 360.0, 0.0,         1.0  ) );  -- 9
+         
+         Y : Real;   
+      begin
+         for I in Test_Data'Range loop
+            Y := Sin (Test_Data(I).Degrees, 360.0);
+            if Y /= Test_Data(I).Sine then
+               Report.Failed ("exact result for sin(" &
+                  Real'Image (Test_Data(I).Degrees) & 
+                  ", 360.0) is not" &
+                  Real'Image (Test_Data(I).Sine) &
+                  "  Difference is " &
+                  Real'Image (Y - Test_Data(I).Sine) );
+            end if;
+
+            Y := Cos (Test_Data(I).Degrees, 360.0);
+            if Y /= Test_Data(I).Cosine then
+               Report.Failed ("exact result for cos(" &
+                  Real'Image (Test_Data(I).Degrees) & 
+                  ", 360.0) is not" &
+                  Real'Image (Test_Data(I).Cosine) &
+                  "  Difference is " &
+                  Real'Image (Y - Test_Data(I).Cosine) );
+            end if;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in exact result check");
+         when others =>
+            Report.Failed ("exception in exact result check");
+      end Exact_Result_Checks;
+
+
+      procedure Do_Test is
+      begin
+         Special_Angle_Checks;
+         Sin_Check (0.0, Pi/2.0, "0..pi/2");
+         Sin_Check (6.0*Pi, 6.5*Pi, "6pi..6.5pi");
+         Cos_Check (7.0*Pi, 7.5*Pi, "7pi..7.5pi");
+         Exact_Result_Checks;
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+   package Float_Check is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2004",
+                "Check the accuracy of the sin and cos functions"); 
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+   Report.Result;
+end CXG2004;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2005.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2005.a
new file mode 100644
index 000000000..4054b83d8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2005.a
@@ -0,0 +1,204 @@
+-- CXG2005.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 floating point addition and multiplication
+--      have the required accuracy.
+--
+-- TEST DESCRIPTION:
+--      The check for the required precision is essentially a
+--      check that a guard digit is used for the operations.
+--      This test uses a generic package to check the addition
+--      and multiplication results.  The
+--      generic package is instantiated with the standard FLOAT
+--      type and a floating point type for the maximum number
+--      of digits of precision.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--
+--
+-- CHANGE HISTORY:
+--      14 FEB 96   SAIC    Initial Release for 2.1
+--      16 SEP 99   RLB     Repaired to avoid printing thousands of (almost)
+--                          identical failure messages.
+--!
+
+-- References:
+--
+--    Basic Concepts for Computational Software
+--    W. J. Cody
+--    Problems and Methodologies in Mathematical Software Production
+--    editors P. C. Messina and A. Murli
+--    Lecture Notes in Computer Science   Vol 142
+--    Springer Verlag,  1982
+--
+--    Software Manual for the Elementary Functions
+--    William J. Cody and William Waite
+--    Prentice-Hall, 1980
+--
+
+with System;
+with Report;
+procedure CXG2005 is
+   Verbose : constant Boolean := False;
+
+   generic
+      type Real is digits <>;
+   package Guard_Digit_Check is
+      procedure Do_Test;
+   end Guard_Digit_Check;
+
+   package body Guard_Digit_Check is
+      -- made global so that the compiler will be more likely
+      -- to keep the values in memory instead of in higher
+      -- precision registers.
+      X, Y, Z : Real;
+      OneX : Real;
+      Eps, BN : Real;
+
+      -- special constants - not declared as constants so that
+      -- the "stored" precision will be used instead of a "register"
+      -- precision.
+      Zero : Real := 0.0;
+      One  : Real := 1.0;
+      Two  : Real := 2.0;
+
+      Failure_Count : Natural := 0;
+
+      procedure Thwart_Optimization is
+      -- the purpose of this procedure is to reference the
+      -- global variables used by the test so
+      -- that the compiler is not likely to keep them in
+      -- a higher precision register for their entire lifetime.
+      begin
+	 if Report.Ident_Bool (False) then
+	    -- never executed
+	    X := X + 5.0;
+	    Y := Y + 6.0;
+	    Z := Z + 1.0;
+	    Eps := Eps + 2.0;
+	    BN := BN + 2.0;
+            OneX := X + Y;
+            One := 12.34;   Two := 56.78;  Zero := 90.12;
+	 end if;
+      end Thwart_Optimization;
+
+
+      procedure Addition_Test is
+      begin
+         for K in 1..10 loop
+	    Eps := Real (K) * Real'Model_Epsilon;
+	    for N in 1.. Real'Machine_EMax - 1 loop
+	       BN := Real(Real'Machine_Radix) ** N;
+	       X := (One + Eps) * BN;
+	       Y := (One - Eps) * BN;
+	       Z := X - Y; -- true value for Z is 2*Eps*BN
+
+	       if Z /= Eps*BN + Eps*BN then
+		  Report.Failed ("addition check failed.  K=" &
+		     Integer'Image (K) &
+		     "  N=" & Integer'Image (N) &
+		     "  difference=" & Real'Image (Z - 2.0*Eps*BN) &
+		     "  Eps*BN=" & Real'Image (Eps*BN) );
+                  Failure_Count := Failure_Count + 1;
+                  exit when Failure_Count > K*4; -- Avoid displaying dozens of messages.
+	       end if;
+	    end loop;
+	 end loop;
+      exception
+	 when others =>
+	    Thwart_Optimization;
+            Report.Failed ("unexpected exception in addition test");
+      end Addition_Test;
+
+
+      procedure Multiplication_Test is
+      begin
+	  X := Real (Real'Machine_Radix) ** (Real'Machine_EMax - 1);
+	  OneX := One * X;
+	  Thwart_Optimization;
+	  if OneX /= X then
+	     Report.Failed ("multiplication for large values");
+	  end if;
+
+	  X := Real (Real'Machine_Radix) ** (Real'Model_EMin + 1);
+	  OneX := One * X;
+	  Thwart_Optimization;
+	  if OneX /= X then
+	     Report.Failed ("multiplication for small values");
+	  end if;
+
+	  -- selection of "random" values between 1/radix and radix
+          Y := One / Real (Real'Machine_Radix);
+          Z := Real(Real'Machine_Radix) - One/Real(Real'Machine_Radix);
+	  for I in 0..100 loop
+	     X := Y + Real (I) / 100.0 * Z;
+	     OneX := One * X;
+	     Thwart_Optimization;
+	     if OneX /= X then
+                Report.Failed ("multiplication for case" & Integer'Image (I));
+                exit when Failure_Count > 40+8; -- Avoid displaying dozens of messages.
+	     end if;
+	  end loop;
+      exception
+	 when others =>
+	    Thwart_Optimization;
+            Report.Failed ("unexpected exception in multiplication test");
+      end Multiplication_Test;
+
+
+      procedure Do_Test is
+      begin
+         Addition_Test;
+         Multiplication_Test;
+      end Do_Test;
+   end Guard_Digit_Check;
+
+   package Chk_Float is new Guard_Digit_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package Chk_A_Long_Float is new Guard_Digit_Check (A_Long_Float);
+begin
+   Report.Test ("CXG2005",
+                "Check the accuracy of floating point" &
+                " addition and multiplication");
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+   Chk_Float.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" &
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+   Chk_A_Long_Float.Do_Test;
+
+   Report.Result;
+end CXG2005;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a
new file mode 100644
index 000000000..da15dc3be
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2006.a
@@ -0,0 +1,281 @@
+-- CXG2006.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 complex Argument function returns
+--      results that are within the error bound allowed.
+--      Check that Argument_Error is raised if the Cycle parameter
+--      is less than or equal to zero.
+--
+-- TEST DESCRIPTION:
+--      This test uses a generic package to compute and check the
+--      values of the Argument function.  
+--      Of special interest is the case where either the real or
+--      the imaginary part of the parameter is very large while the
+--      other part is very small or 0. 
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      15 FEB 96   SAIC    Initial release for 2.1
+--      03 MAR 97   PWB.CTA Removed checks involving explicit cycle => 2.0*Pi
+--
+-- CHANGE NOTE:
+--      According to Ken Dritz, author of the Numerics Annex of the RM,
+--      one should never specify the cycle 2.0*Pi for the trigonometric
+--      functions.  In particular, if the machine number for the first
+--      argument is not an exact multiple of the machine number for the
+--      explicit cycle, then the specified exact results cannot be
+--      reasonably expected.  The affected checks in this test have been
+--      marked as comments, with the additional notation "pwb-math".
+--      Phil Brashear
+--!
+
+--
+-- Reference:
+-- Problems and Methodologies in Mathematical Software Production;
+-- editors: P. C. Messina and A Murli;
+-- Lecture Notes in Computer Science
+-- Volume 142
+-- Springer Verlag 1982
+--
+
+with System;
+with Report;
+with ImpDef.Annex_G;
+with Ada.Numerics;
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Complex_Types;
+procedure CXG2006 is
+   Verbose : constant Boolean := False;
+
+
+   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+   Sqrt2 : constant := 
+        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+   Sqrt3 : constant :=
+        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
+
+   Pi : constant := Ada.Numerics.Pi;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Complex_Types is new 
+           Ada.Numerics.Generic_Complex_Types (Real);
+      use Complex_Types;
+
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Rel_Error : Real;
+         Abs_Error : Real;
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & 
+                           Real'Image (Actual - Expected) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Special_Cases is
+         type Data_Point is 
+            record
+               Re,
+               Im,
+               Radians,
+               Degrees,
+               Error_Bound   : Real;
+            end record;
+
+         type Test_Data_Type is array (Positive range <>) of Data_Point;
+
+         -- the values in the following table only involve static
+         -- expressions to minimize errors in precision introduced by the
+         -- test.  For cases where Pi is used in the argument we must
+         -- allow an extra 1.0*MRE to account for roundoff error in the
+         -- argument.  Where the result involves a square root we allow
+         -- an extra 0.5*MRE to allow for roundoff error.
+         Test_Data : constant Test_Data_Type := (
+--    Re               Im                     Radians  Degrees  Err    Test #
+    (0.0,               0.0,                       0.0,   0.0,  4.0 ),  -- 1
+    (1.0,               0.0,                       0.0,   0.0,  4.0 ),  -- 2
+    (Real'Safe_Last,    0.0,                       0.0,   0.0,  4.0 ),  -- 3
+    (Real'Model_Small,  0.0,                       0.0,   0.0,  4.0 ),  -- 4
+    (1.0,               1.0,                    Pi/4.0,  45.0,  5.0 ),  -- 5
+    (1.0,              -1.0,                   -Pi/4.0, -45.0,  5.0 ),  -- 6
+    (-1.0,             -1.0,               -3.0*Pi/4.0,-135.0,  5.0 ),  -- 7 
+    (-1.0,              1.0,                3.0*Pi/4.0, 135.0,  5.0 ),  -- 8 
+    (Sqrt3,             1.0,                    Pi/6.0,  30.0,  5.5 ),  -- 9
+    (-Sqrt3,            1.0,                5.0*Pi/6.0, 150.0,  5.5 ),  -- 10
+    (Sqrt3,            -1.0,                   -Pi/6.0, -30.0,  5.5 ),  -- 11
+    (-Sqrt3,           -1.0,               -5.0*Pi/6.0,-150.0,  5.5 ),  -- 12
+    (Real'Model_Small,  Real'Model_Small,       Pi/4.0,  45.0,  5.0 ),  -- 13
+    (-Real'Safe_Last,   0.0,                        Pi, 180.0,  5.0 ),  -- 14
+    (-Real'Safe_Last,  -Real'Model_Small,          -Pi,-180.0,  5.0 ),  -- 15
+    (100000.0,          100000.0,               Pi/4.0,  45.0,  5.0 )); -- 16
+    
+         X : Real;
+         Z : Complex;
+      begin
+         for I in Test_Data'Range loop
+            begin
+               Z := (Test_Data(I).Re, Test_Data(I).Im);
+               X := Argument (Z);
+	       Check (X, Test_Data(I).Radians, 
+                   "test" & Integer'Image (I) & " argument(z)",
+                   Test_Data (I).Error_Bound); 
+--pwb-math               X := Argument (Z, 2.0*Pi);
+--pwb-math	       Check (X, Test_Data(I).Radians, 
+--pwb-math                   "test" & Integer'Image (I) & " argument(z, 2pi)",
+--pwb-math                   Test_Data (I).Error_Bound); 
+               X := Argument (Z, 360.0);
+	       Check (X, Test_Data(I).Degrees, 
+                   "test" & Integer'Image (I) & " argument(z, 360)",
+                   Test_Data (I).Error_Bound); 
+
+            exception
+               when Constraint_Error => 
+                  Report.Failed ("Constraint_Error raised in test" &
+                      Integer'Image (I));
+               when others =>
+                  Report.Failed ("exception in test" &
+                      Integer'Image (I));
+            end;
+         end loop;
+        
+	 if Real'Signed_Zeros then
+	    begin
+	      X := Argument ((-1.0, Real(ImpDef.Annex_G.Negative_Zero)));
+	      Check (X, -Pi, "test of arg((-1,-0)", 4.0);
+	    exception
+	       when others =>
+		  Report.Failed ("exception in signed zero test");
+	    end;
+	 end if;
+      end Special_Cases;
+
+
+      procedure Exception_Cases is
+      -- check that Argument_Error is raised if Cycle is <= 0
+	 Z : Complex := (1.0, 1.0);
+	 X : Real;
+	 Y : Real;
+      begin
+	 begin
+	   X := Argument (Z, Cycle => 0.0);
+	   Report.Failed ("no exception for cycle = 0.0");
+	 exception
+	    when Ada.Numerics.Argument_Error => null;
+	    when others =>
+	       Report.Failed ("wrong exception for cycle = 0.0");
+	 end;
+
+	 begin
+	   Y := Argument (Z, Cycle => -3.0);
+	   Report.Failed ("no exception for cycle < 0.0");
+	 exception
+	    when Ada.Numerics.Argument_Error => null;
+	    when others =>
+	       Report.Failed ("wrong exception for cycle < 0.0");
+	 end;
+
+         if Report.Ident_Int (2) = 1 then
+            -- optimization thwarting code - never executed
+            Report.Failed("2=1" & Real'Image (X+Y));
+         end if;
+      end Exception_Cases;
+
+
+      procedure Do_Test is
+      begin
+	 Special_Cases;
+	 Exception_Cases;
+      end Do_Test;
+   end Generic_Check;
+
+   package Chk_Float is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package Chk_A_Long_Float is new Generic_Check (A_Long_Float);
+begin
+   Report.Test ("CXG2006",
+                "Check the accuracy of the complex argument" &
+                " function");
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Chk_Float.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   Chk_A_Long_Float.Do_Test;
+
+   Report.Result;
+end CXG2006;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a
new file mode 100644
index 000000000..ba07df29d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2007.a
@@ -0,0 +1,291 @@
+-- CXG2007.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 complex Compose_From_Polar function returns
+--      results that are within the error bound allowed.
+--      Check that Argument_Error is raised if the Cycle parameter
+--      is less than or equal to zero.
+--
+-- TEST DESCRIPTION:
+--      This test uses a generic package to compute and check the
+--      values of the Compose_From_Polar function.  
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      23 FEB 96   SAIC    Initial release for 2.1
+--      23 APR 96   SAIC    Fixed error checking
+--      03 MAR 97   PWB.CTA Deleted checks with explicit Cycle => 2.0*Pi
+--
+-- CHANGE NOTE:
+--      According to Ken Dritz, author of the Numerics Annex of the RM,
+--      one should never specify the cycle 2.0*Pi for the trigonometric
+--      functions.  In particular, if the machine number for the first
+--      argument is not an exact multiple of the machine number for the
+--      explicit cycle, then the specified exact results cannot be
+--      reasonably expected.  The affected checks in this test have been
+--      marked as comments, with the additional notation "pwb-math".
+--      Phil Brashear
+--!
+
+with System;
+with Report;
+with Ada.Numerics;
+with Ada.Numerics.Generic_Complex_Types;
+procedure CXG2007 is
+   Verbose : constant Boolean := False;
+
+
+   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+   Sqrt2 : constant := 
+        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+   Sqrt3 : constant :=
+        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
+
+   Pi : constant := Ada.Numerics.Pi;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Complex_Types is new 
+           Ada.Numerics.Generic_Complex_Types (Real);
+      use Complex_Types;
+
+      Maximum_Relative_Error : constant Real := 3.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real;
+                       Arg_Error : Real) is
+         -- Arg_Error is additional absolute error that is allowed beyond
+         -- the MRE to account for error in the result that can be
+         -- attributed to error in the arguments.
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Small instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+         Max_Error := Max_Error + Arg_Error;
+
+         if abs (Actual - Expected) > Max_Error then
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Check (Actual, Expected : Complex;
+                       Test_Name : String;
+                       MRE : Real;
+                       Arg_Error : Real) is
+         -- Arg_Error is additional absolute error that is allowed beyond
+         -- the MRE to account for error in the result that can be
+         -- attributed to error in the arguments.
+      begin
+         Check (Actual.Re, Expected.Re, 
+                Test_Name & " real part",
+                MRE, Arg_Error);
+         Check (Actual.Im, Expected.Im, 
+                Test_Name & " imaginary part",
+                MRE, Arg_Error);
+      end Check;
+
+
+      procedure Special_Cases is
+         type Data_Point is 
+            record
+               Re,
+               Im,
+	       Modulus,
+               Radians,
+               Degrees,
+	       Arg_Error : Real;
+            end record;
+
+	 -- shorthand names for various constants
+	 P4 : constant := Pi/4.0;
+	 P6 : constant := Pi/6.0;
+
+	 MER2 : constant Real := Real'Model_Epsilon * Sqrt2;
+
+         type Test_Data_Type is array (Positive range <>) of Data_Point;
+
+         -- the values in the following table only involve static
+         -- expressions so no loss of precision occurs.
+         Test_Data : constant Test_Data_Type := (
+         --Re          Im   Modulus     Radians  Degrees  Arg_Err
+         ( 0.0,        0.0, 0.0,            0.0,   0.0,    0.0 ),    -- 1
+         ( 0.0,        0.0, 0.0,             Pi, 180.0,    0.0 ),    -- 2
+         
+         ( 1.0,        0.0, 1.0,            0.0,   0.0,    0.0 ),    -- 3
+         (-1.0,        0.0, -1.0,           0.0,   0.0,    0.0 ),    -- 4
+         
+         ( 1.0,        1.0,  Sqrt2,          P4,  45.0,    MER2),    -- 5
+         (-1.0,        1.0, -Sqrt2,         -P4, -45.0,    MER2),    -- 6
+         ( 1.0,       -1.0,  Sqrt2,         -P4, -45.0,    MER2),    -- 7
+         (-1.0,       -1.0, -Sqrt2,          P4,  45.0,    MER2),    -- 8
+         (-1.0,       -1.0,  Sqrt2,     -3.0*P4,-135.0,    MER2),    -- 9 
+         (-1.0,        1.0,  Sqrt2,      3.0*P4, 135.0,    MER2),    -- 10
+         ( 1.0,       -1.0, -Sqrt2,      3.0*P4, 135.0,    MER2),    -- 11
+         
+         (-1.0,        0.0, 1.0,             Pi, 180.0,    0.0 ),    -- 12
+         ( 1.0,        0.0, -1.0,            Pi, 180.0,    0.0 ) );  -- 13
+
+    
+         Z : Complex;
+	 Exp : Complex;
+      begin
+         for I in Test_Data'Range loop
+            begin
+	       Exp := (Test_Data (I).Re, Test_Data (I).Im);
+
+               Z := Compose_From_Polar (Test_Data (I).Modulus,
+					Test_Data (I).Radians);
+	       Check (Z, Exp,
+                 "test" & Integer'Image (I) & " compose_from_polar(m,r)",
+		 Maximum_Relative_Error, Test_Data (I).Arg_Error); 
+
+--pwb-math               Z := Compose_From_Polar (Test_Data (I).Modulus, 
+--pwb-math					Test_Data (I).Radians,
+--pwb-math					2.0*Pi);
+--pwb-math	       Check (Z, Exp,
+--pwb-math                 "test" & Integer'Image (I) & " compose_from_polar(m,r,2pi)",
+--pwb-math		 Maximum_Relative_Error, Test_Data (I).Arg_Error); 
+
+               Z := Compose_From_Polar (Test_Data (I).Modulus, 
+					Test_Data (I).Degrees,
+					360.0);
+	       Check (Z, Exp,
+                 "test" & Integer'Image (I) & " compose_from_polar(m,d,360)",
+		 Maximum_Relative_Error, Test_Data (I).Arg_Error);
+
+            exception
+               when Constraint_Error => 
+                  Report.Failed ("Constraint_Error raised in test" &
+                      Integer'Image (I));
+               when others =>
+                  Report.Failed ("exception in test" &
+                      Integer'Image (I));
+            end;
+         end loop;
+      end Special_Cases;
+
+
+      procedure Exception_Cases is
+      -- check that Argument_Error is raised if Cycle is <= 0
+	 Z : Complex; 
+	 W : Complex; 
+      begin
+	 begin
+	   Z := Compose_From_Polar (3.0, 0.0, Cycle => 0.0);
+	   Report.Failed ("no exception for cycle = 0.0");
+	 exception
+	    when Ada.Numerics.Argument_Error => null;
+	    when others =>
+	       Report.Failed ("wrong exception for cycle = 0.0");
+	 end;
+
+	 begin
+	   W := Compose_From_Polar (6.0, 1.0, Cycle => -10.0);
+	   Report.Failed ("no exception for cycle < 0.0");
+	 exception
+	    when Ada.Numerics.Argument_Error => null;
+	    when others =>
+	       Report.Failed ("wrong exception for cycle < 0.0");
+	 end;
+
+	 if Report.Ident_Int (1) = 2 then
+	     -- not executed - used to make it appear that we use the
+	     -- results of the above computation
+	     Z := Z * W;
+	     Report.Failed(Real'Image (Z.Re + Z.Im));
+	 end if;
+      end Exception_Cases;
+
+
+      procedure Do_Test is
+      begin
+	 Special_Cases;
+	 Exception_Cases;
+      end Do_Test;
+   end Generic_Check;
+
+   package Chk_Float is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package Chk_A_Long_Float is new Generic_Check (A_Long_Float);
+begin
+   Report.Test ("CXG2007",
+                "Check the accuracy of the Compose_From_Polar" &
+                " function");
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+   Chk_Float.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+   Chk_A_Long_Float.Do_Test;
+
+   Report.Result;
+end CXG2007;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2008.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2008.a
new file mode 100644
index 000000000..58cf367f6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2008.a
@@ -0,0 +1,948 @@
+-- CXG2008.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 complex multiplication and division
+--      operations return results that are within the allowed
+--      error bound.
+--      Check that all the required pure Numerics packages are pure.
+--
+-- TEST DESCRIPTION:
+--      This test contains three test packages that are almost
+--      identical.  The first two packages differ only in the
+--      floating point type that is being tested.  The first
+--      and third package differ only in whether the generic
+--      complex types package or the pre-instantiated
+--      package is used.
+--      The test package is not generic so that the arguments
+--      and expected results for some of the test values
+--      can be expressed as universal real instead of being
+--      computed at runtime.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      24 FEB 96   SAIC    Initial release for 2.1
+--      03 JUN 98   EDS     Correct the test program's incorrect assumption
+--                          that Constraint_Error must be raised by complex
+--                          division by zero, which is contrary to the
+--                          allowance given by the Ada 95 standard G.1.1(40).
+--      13 MAR 01   RLB     Replaced commented out Pure check on non-generic
+--                          packages, as required by Defect Report
+--                          8652/0020 and as reflected in Technical
+--                          Corrigendum 1.
+--!
+
+------------------------------------------------------------------------------
+-- Check that the required pure packages are pure by withing them from a
+-- pure package. The non-generic versions of those packages are required to
+-- be pure by Defect Report 8652/0020, Technical Corrigendum 1 [A.5.1(9/1) and
+-- G.1.1(25/1)].
+with Ada.Numerics.Generic_Elementary_Functions;
+with Ada.Numerics.Elementary_Functions;
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Complex_Types;
+with Ada.Numerics.Generic_Complex_Elementary_Functions;
+with Ada.Numerics.Complex_Elementary_Functions;
+package CXG2008_0 is
+  pragma Pure;
+   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+   Sqrt2 : constant :=
+        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+   Sqrt3 : constant :=
+        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
+end CXG2008_0;
+
+------------------------------------------------------------------------------
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Complex_Types;
+with CXG2008_0;  use CXG2008_0;
+procedure CXG2008 is
+   Verbose : constant Boolean := False;
+
+   package Float_Check is
+      subtype Real is Float;
+      procedure Do_Test;
+   end Float_Check;
+
+   package body Float_Check is
+      package Complex_Types is new
+           Ada.Numerics.Generic_Complex_Types (Real);
+      use Complex_Types;
+
+      -- keep track if an accuracy failure has occurred so the test
+      -- can be short-circuited to avoid thousands of error messages.
+      Failure_Detected : Boolean := False;
+
+      Mult_MBE : constant Real := 5.0;
+      Divide_MBE : constant Real := 13.0;
+
+
+      procedure Check (Actual, Expected : Complex;
+                       Test_Name : String;
+                       MBE : Real) is
+         Rel_Error : Real;
+         Abs_Error : Real;
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MBE * abs Expected.Re * Real'Model_Epsilon;
+         Abs_Error := MBE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if;
+
+         if abs (Actual.Re - Expected.Re) > Max_Error then
+            Failure_Detected := True;
+            Report.Failed (Test_Name &
+                           " actual.re: " & Real'Image (Actual.Re) &
+                           " expected.re: " & Real'Image (Expected.Re) &
+                           " difference.re " &
+                           Real'Image (Actual.Re - Expected.Re) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & " exact result for real part");
+	    else
+	       Report.Comment (Test_Name & " passed for real part");
+	    end if;
+         end if;
+
+         Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if;
+         if abs (Actual.Im - Expected.Im) > Max_Error then
+            Failure_Detected := True;
+            Report.Failed (Test_Name &
+                           " actual.im: " & Real'Image (Actual.Im) &
+                           " expected.im: " & Real'Image (Expected.Im) &
+                           " difference.im " &
+                           Real'Image (Actual.Im - Expected.Im) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & " exact result for imaginary part");
+	    else
+	       Report.Comment (Test_Name & " passed for imaginary part");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Special_Values is
+      begin
+
+         --- test 1 ---
+         declare
+            T : constant := (Real'Machine_EMax - 1) / 2;
+            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
+	    Expected : Complex := (0.0, 0.0);
+            X : Complex := (0.0, 0.0);
+	    Y : Complex := (Big, Big);
+            Z : Complex;
+         begin
+            Z := X * Y;
+            Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)",
+                   Mult_MBE);
+            Z := Y * X;
+            Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+         --- test 2 ---
+	 declare
+            T : constant := Real'Model_EMin + 1;
+            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
+	    U : Complex := (Tiny, Tiny);
+            X : Complex := (0.0, 0.0);
+	    Expected : Complex := (0.0, 0.0);
+	    Z : Complex;
+         begin
+            Z := U * X;
+            Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+         --- test 3 ---
+	 declare
+            T : constant := (Real'Machine_EMax - 1) / 2;
+            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
+	    B : Complex := (Big, Big);
+            X : Complex := (0.0, 0.0);
+	    Z : Complex;
+         begin
+            if Real'Machine_Overflows then
+               Z := B / X;
+               Report.Failed ("test 3 - Constraint_Error not raised");
+               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
+            end if;
+         exception
+            when Constraint_Error => null;  -- expected
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+         --- test 4 ---
+	 declare
+            T : constant := Real'Model_EMin + 1;
+            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
+	    U : Complex := (Tiny, Tiny);
+            X : Complex := (0.0, 0.0);
+	    Z : Complex;
+         begin
+            if Real'Machine_Overflows then
+               Z := U / X;
+               Report.Failed ("test 4 - Constraint_Error not raised");
+               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
+            end if;
+         exception
+            when Constraint_Error => null;  -- expected
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+
+         --- test 5 ---
+	 declare
+	    X : Complex := (Sqrt2, Sqrt2);
+            Z : Complex;
+            Expected : constant Complex := (0.0, 4.0);
+         begin
+            Z := X * X;
+            Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 5");
+            when others =>
+               Report.Failed ("exception in test 5");
+         end;
+
+         --- test 6 ---
+	 declare
+	    X : Complex := Sqrt3 - Sqrt3 * i;
+            Z : Complex;
+            Expected : constant Complex := (0.0, -6.0);
+         begin
+            Z := X * X;
+            Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 6");
+            when others =>
+               Report.Failed ("exception in test 6");
+         end;
+
+         --- test 7 ---
+	 declare
+	    X : Complex := Sqrt2 + Sqrt2 * i;
+	    Y : Complex := Sqrt2 - Sqrt2 * i;
+            Z : Complex;
+            Expected : constant Complex := 0.0 + i;
+         begin
+            Z := X / Y;
+            Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)",
+                   Divide_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 7");
+            when others =>
+               Report.Failed ("exception in test 7");
+         end;
+      end Special_Values;
+
+
+      procedure Do_Mult_Div (X, Y : Complex) is
+	 Z : Complex;
+	 Args : constant String :=
+	   "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " &
+	   "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ;
+      begin
+	 Z := (X * X) / X;
+	 Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE);
+	 Z := (X * Y) / X;
+	 Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE);
+	 Z := (X * Y) / Y;
+	 Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE);
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args);
+         when others =>
+            Report.Failed ("exception in Do_Mult_Div for " & Args);
+      end Do_Mult_Div;
+
+      -- select complex values X and Y where the real and imaginary
+      -- parts are selected from the ranges (1/radix..1) and
+      -- (1..radix).  This translates into quite a few combinations.
+      procedure Mult_Div_Check is
+         Samples : constant := 17;
+	 Radix : constant Real := Real(Real'Machine_Radix);
+	 Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix);
+	 Low_Sample : Real;  -- (1/radix .. 1)
+	 High_Sample : Real; -- (1 .. radix)
+	 Sample : array (1..2) of Real;
+	 X, Y : Complex;
+      begin
+         for I in 1 .. Samples loop
+            Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) +
+			  Inv_Radix;
+	    Sample (1) := Low_Sample;
+	    for J in 1 .. Samples loop
+               High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) +
+			      Radix;
+	       Sample (2) := High_Sample;
+	       for K in 1 .. 2 loop
+		  for L in 1 .. 2 loop
+		     X := Complex'(Sample (K), Sample (L));
+		     Y := Complex'(Sample (L), Sample (K));
+		     Do_Mult_Div (X, Y);
+                     if Failure_Detected then
+                        return;   -- minimize flood of error messages
+                     end if;
+		  end loop;
+	       end loop;
+            end loop;  -- J
+         end loop;  -- I
+      end Mult_Div_Check;
+
+
+      procedure Do_Test is
+      begin
+         Special_Values;
+         Mult_Div_Check;
+      end Do_Test;
+   end Float_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   -- check the floating point type with the most digits
+
+   package A_Long_Float_Check is
+      type A_Long_Float is digits System.Max_Digits;
+      subtype Real is A_Long_Float;
+      procedure Do_Test;
+   end A_Long_Float_Check;
+
+   package body A_Long_Float_Check is
+
+      package Complex_Types is new
+           Ada.Numerics.Generic_Complex_Types (Real);
+      use Complex_Types;
+
+      -- keep track if an accuracy failure has occurred so the test
+      -- can be short-circuited to avoid thousands of error messages.
+      Failure_Detected : Boolean := False;
+
+      Mult_MBE : constant Real := 5.0;
+      Divide_MBE : constant Real := 13.0;
+
+
+      procedure Check (Actual, Expected : Complex;
+                       Test_Name : String;
+                       MBE : Real) is
+         Rel_Error : Real;
+         Abs_Error : Real;
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MBE * abs Expected.Re * Real'Model_Epsilon;
+         Abs_Error := MBE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if;
+
+         if abs (Actual.Re - Expected.Re) > Max_Error then
+            Failure_Detected := True;
+            Report.Failed (Test_Name &
+                           " actual.re: " & Real'Image (Actual.Re) &
+                           " expected.re: " & Real'Image (Expected.Re) &
+                           " difference.re " &
+                           Real'Image (Actual.Re - Expected.Re) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & " exact result for real part");
+	    else
+	       Report.Comment (Test_Name & " passed for real part");
+	    end if;
+         end if;
+
+         Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if;
+         if abs (Actual.Im - Expected.Im) > Max_Error then
+            Failure_Detected := True;
+            Report.Failed (Test_Name &
+                           " actual.im: " & Real'Image (Actual.Im) &
+                           " expected.im: " & Real'Image (Expected.Im) &
+                           " difference.im " &
+                           Real'Image (Actual.Im - Expected.Im) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & " exact result for imaginary part");
+	    else
+	       Report.Comment (Test_Name & " passed for imaginary part");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Special_Values is
+      begin
+
+         --- test 1 ---
+         declare
+            T : constant := (Real'Machine_EMax - 1) / 2;
+            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
+	    Expected : Complex := (0.0, 0.0);
+            X : Complex := (0.0, 0.0);
+	    Y : Complex := (Big, Big);
+            Z : Complex;
+         begin
+            Z := X * Y;
+            Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)",
+                   Mult_MBE);
+            Z := Y * X;
+            Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+         --- test 2 ---
+	 declare
+            T : constant := Real'Model_EMin + 1;
+            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
+	    U : Complex := (Tiny, Tiny);
+            X : Complex := (0.0, 0.0);
+	    Expected : Complex := (0.0, 0.0);
+	    Z : Complex;
+         begin
+            Z := U * X;
+            Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+         --- test 3 ---
+	 declare
+            T : constant := (Real'Machine_EMax - 1) / 2;
+            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
+	    B : Complex := (Big, Big);
+            X : Complex := (0.0, 0.0);
+	    Z : Complex;
+         begin
+            if Real'Machine_Overflows then
+               Z := B / X;
+               Report.Failed ("test 3 - Constraint_Error not raised");
+               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
+            end if;
+         exception
+            when Constraint_Error => null;  -- expected
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+         --- test 4 ---
+	 declare
+            T : constant := Real'Model_EMin + 1;
+            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
+	    U : Complex := (Tiny, Tiny);
+            X : Complex := (0.0, 0.0);
+	    Z : Complex;
+         begin
+            if Real'Machine_Overflows then
+               Z := U / X;
+               Report.Failed ("test 4 - Constraint_Error not raised");
+               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
+            end if;
+         exception
+            when Constraint_Error => null;  -- expected
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+
+         --- test 5 ---
+	 declare
+	    X : Complex := (Sqrt2, Sqrt2);
+            Z : Complex;
+            Expected : constant Complex := (0.0, 4.0);
+         begin
+            Z := X * X;
+            Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 5");
+            when others =>
+               Report.Failed ("exception in test 5");
+         end;
+
+         --- test 6 ---
+	 declare
+	    X : Complex := Sqrt3 - Sqrt3 * i;
+            Z : Complex;
+            Expected : constant Complex := (0.0, -6.0);
+         begin
+            Z := X * X;
+            Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 6");
+            when others =>
+               Report.Failed ("exception in test 6");
+         end;
+
+         --- test 7 ---
+	 declare
+	    X : Complex := Sqrt2 + Sqrt2 * i;
+	    Y : Complex := Sqrt2 - Sqrt2 * i;
+            Z : Complex;
+            Expected : constant Complex := 0.0 + i;
+         begin
+            Z := X / Y;
+            Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)",
+                   Divide_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 7");
+            when others =>
+               Report.Failed ("exception in test 7");
+         end;
+      end Special_Values;
+
+
+      procedure Do_Mult_Div (X, Y : Complex) is
+	 Z : Complex;
+	 Args : constant String :=
+	   "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " &
+	   "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ;
+      begin
+	 Z := (X * X) / X;
+	 Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE);
+	 Z := (X * Y) / X;
+	 Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE);
+	 Z := (X * Y) / Y;
+	 Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE);
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args);
+         when others =>
+            Report.Failed ("exception in Do_Mult_Div for " & Args);
+      end Do_Mult_Div;
+
+      -- select complex values X and Y where the real and imaginary
+      -- parts are selected from the ranges (1/radix..1) and
+      -- (1..radix).  This translates into quite a few combinations.
+      procedure Mult_Div_Check is
+         Samples : constant := 17;
+	 Radix : constant Real := Real(Real'Machine_Radix);
+	 Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix);
+	 Low_Sample : Real;  -- (1/radix .. 1)
+	 High_Sample : Real; -- (1 .. radix)
+	 Sample : array (1..2) of Real;
+	 X, Y : Complex;
+      begin
+         for I in 1 .. Samples loop
+            Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) +
+			  Inv_Radix;
+	    Sample (1) := Low_Sample;
+	    for J in 1 .. Samples loop
+               High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) +
+			      Radix;
+	       Sample (2) := High_Sample;
+	       for K in 1 .. 2 loop
+		  for L in 1 .. 2 loop
+		     X := Complex'(Sample (K), Sample (L));
+		     Y := Complex'(Sample (L), Sample (K));
+		     Do_Mult_Div (X, Y);
+                     if Failure_Detected then
+                        return;   -- minimize flood of error messages
+                     end if;
+		  end loop;
+	       end loop;
+            end loop;  -- J
+         end loop;  -- I
+      end Mult_Div_Check;
+
+
+      procedure Do_Test is
+      begin
+         Special_Values;
+         Mult_Div_Check;
+      end Do_Test;
+   end A_Long_Float_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+   package Non_Generic_Check is
+      subtype Real is Float;
+      procedure Do_Test;
+   end Non_Generic_Check;
+
+   package body Non_Generic_Check is
+
+      use Ada.Numerics.Complex_Types;
+
+      -- keep track if an accuracy failure has occurred so the test
+      -- can be short-circuited to avoid thousands of error messages.
+      Failure_Detected : Boolean := False;
+
+      Mult_MBE : constant Real := 5.0;
+      Divide_MBE : constant Real := 13.0;
+
+
+      procedure Check (Actual, Expected : Complex;
+                       Test_Name : String;
+                       MBE : Real) is
+         Rel_Error : Real;
+         Abs_Error : Real;
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MBE * abs Expected.Re * Real'Model_Epsilon;
+         Abs_Error := MBE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if;
+
+         if abs (Actual.Re - Expected.Re) > Max_Error then
+            Failure_Detected := True;
+            Report.Failed (Test_Name &
+                           " actual.re: " & Real'Image (Actual.Re) &
+                           " expected.re: " & Real'Image (Expected.Re) &
+                           " difference.re " &
+                           Real'Image (Actual.Re - Expected.Re) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & " exact result for real part");
+	    else
+	       Report.Comment (Test_Name & " passed for real part");
+	    end if;
+         end if;
+
+         Rel_Error := MBE * abs Expected.Im * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if;
+         if abs (Actual.Im - Expected.Im) > Max_Error then
+            Failure_Detected := True;
+            Report.Failed (Test_Name &
+                           " actual.im: " & Real'Image (Actual.Im) &
+                           " expected.im: " & Real'Image (Expected.Im) &
+                           " difference.im " &
+                           Real'Image (Actual.Im - Expected.Im) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & " exact result for imaginary part");
+	    else
+	       Report.Comment (Test_Name & " passed for imaginary part");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Special_Values is
+      begin
+
+         --- test 1 ---
+         declare
+            T : constant := (Real'Machine_EMax - 1) / 2;
+            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
+	    Expected : Complex := (0.0, 0.0);
+            X : Complex := (0.0, 0.0);
+	    Y : Complex := (Big, Big);
+            Z : Complex;
+         begin
+            Z := X * Y;
+            Check (Z, Expected, "test 1a -- (0+0i) * (big+big*i)",
+                   Mult_MBE);
+            Z := Y * X;
+            Check (Z, Expected, "test 1b -- (big+big*i) * (0+0i)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+         --- test 2 ---
+	 declare
+            T : constant := Real'Model_EMin + 1;
+            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
+	    U : Complex := (Tiny, Tiny);
+            X : Complex := (0.0, 0.0);
+	    Expected : Complex := (0.0, 0.0);
+	    Z : Complex;
+         begin
+            Z := U * X;
+            Check (Z, Expected, "test 2 -- (tiny,tiny) * (0,0)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+         --- test 3 ---
+	 declare
+            T : constant := (Real'Machine_EMax - 1) / 2;
+            Big : constant := (1.0 * Real'Machine_Radix) ** (2 * T);
+	    B : Complex := (Big, Big);
+            X : Complex := (0.0, 0.0);
+	    Z : Complex;
+         begin
+            if Real'Machine_Overflows then
+               Z := B / X;
+               Report.Failed ("test 3 - Constraint_Error not raised");
+               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
+            end if;
+         exception
+            when Constraint_Error => null;  -- expected
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+         --- test 4 ---
+	 declare
+            T : constant := Real'Model_EMin + 1;
+            Tiny : constant := (1.0 * Real'Machine_Radix) ** T;
+	    U : Complex := (Tiny, Tiny);
+            X : Complex := (0.0, 0.0);
+	    Z : Complex;
+         begin
+            if Real'Machine_Overflows then
+               Z := U / X;
+               Report.Failed ("test 4 - Constraint_Error not raised");
+               Check (Z, Z, "not executed - optimizer thwarting", 0.0);
+            end if;
+         exception
+            when Constraint_Error => null;  -- expected
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+
+         --- test 5 ---
+	 declare
+	    X : Complex := (Sqrt2, Sqrt2);
+            Z : Complex;
+            Expected : constant Complex := (0.0, 4.0);
+         begin
+            Z := X * X;
+            Check (Z, Expected, "test 5 -- (sqrt2,sqrt2) * (sqrt2,sqrt2)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 5");
+            when others =>
+               Report.Failed ("exception in test 5");
+         end;
+
+         --- test 6 ---
+	 declare
+	    X : Complex := Sqrt3 - Sqrt3 * i;
+            Z : Complex;
+            Expected : constant Complex := (0.0, -6.0);
+         begin
+            Z := X * X;
+            Check (Z, Expected, "test 6 -- (sqrt3,-sqrt3) * (sqrt3,-sqrt3)",
+                   Mult_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 6");
+            when others =>
+               Report.Failed ("exception in test 6");
+         end;
+
+         --- test 7 ---
+	 declare
+	    X : Complex := Sqrt2 + Sqrt2 * i;
+	    Y : Complex := Sqrt2 - Sqrt2 * i;
+            Z : Complex;
+            Expected : constant Complex := 0.0 + i;
+         begin
+            Z := X / Y;
+            Check (Z, Expected, "test 7 -- (sqrt2,sqrt2) / (sqrt2,-sqrt2)",
+                   Divide_MBE);
+         exception
+            when Constraint_Error =>
+               Report.Failed ("Constraint_Error raised in test 7");
+            when others =>
+               Report.Failed ("exception in test 7");
+         end;
+      end Special_Values;
+
+
+      procedure Do_Mult_Div (X, Y : Complex) is
+	 Z : Complex;
+	 Args : constant String :=
+	   "X=(" & Real'Image (X.Re) & "," & Real'Image (X.Im) & ") " &
+	   "Y=(" & Real'Image (Y.Re) & "," & Real'Image (Y.Im) & ") " ;
+      begin
+	 Z := (X * X) / X;
+	 Check (Z, X, "X*X/X " & Args, Mult_MBE + Divide_MBE);
+	 Z := (X * Y) / X;
+	 Check (Z, Y, "X*Y/X " & Args, Mult_MBE + Divide_MBE);
+	 Z := (X * Y) / Y;
+	 Check (Z, X, "X*Y/Y " & Args, Mult_MBE + Divide_MBE);
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error in Do_Mult_Div for " & Args);
+         when others =>
+            Report.Failed ("exception in Do_Mult_Div for " & Args);
+      end Do_Mult_Div;
+
+      -- select complex values X and Y where the real and imaginary
+      -- parts are selected from the ranges (1/radix..1) and
+      -- (1..radix).  This translates into quite a few combinations.
+      procedure Mult_Div_Check is
+         Samples : constant := 17;
+	 Radix : constant Real := Real(Real'Machine_Radix);
+	 Inv_Radix : constant Real := 1.0 / Real(Real'Machine_Radix);
+	 Low_Sample : Real;  -- (1/radix .. 1)
+	 High_Sample : Real; -- (1 .. radix)
+	 Sample : array (1..2) of Real;
+	 X, Y : Complex;
+      begin
+         for I in 1 .. Samples loop
+            Low_Sample := (1.0 - Inv_Radix) / Real (Samples) * Real (I) +
+			  Inv_Radix;
+	    Sample (1) := Low_Sample;
+	    for J in 1 .. Samples loop
+               High_Sample := (Radix - 1.0) / Real (Samples) * Real (I) +
+			      Radix;
+	       Sample (2) := High_Sample;
+	       for K in 1 .. 2 loop
+		  for L in 1 .. 2 loop
+		     X := Complex'(Sample (K), Sample (L));
+		     Y := Complex'(Sample (L), Sample (K));
+		     Do_Mult_Div (X, Y);
+                     if Failure_Detected then
+                        return;   -- minimize flood of error messages
+                     end if;
+		  end loop;
+	       end loop;
+            end loop;  -- J
+         end loop;  -- I
+      end Mult_Div_Check;
+
+
+      procedure Do_Test is
+      begin
+         Special_Values;
+         Mult_Div_Check;
+      end Do_Test;
+   end Non_Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+begin
+   Report.Test ("CXG2008",
+                "Check the accuracy of the complex multiplication and" &
+                " division operators");
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" &
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking non-generic package");
+   end if;
+
+   Non_Generic_Check.Do_Test;
+
+   Report.Result;
+end CXG2008;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2009.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2009.a
new file mode 100644
index 000000000..0b11ca538
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2009.a
@@ -0,0 +1,421 @@
+-- CXG2009.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 real sqrt and complex modulus functions
+--      return results that are within the allowed
+--      error bound.
+--
+-- TEST DESCRIPTION:
+--      This test checks the accuracy of the sqrt and modulus functions 
+--      by computing the norm of various vectors where the result
+--      is known in advance.
+--      This test uses real and complex math together as would an 
+--      actual application.  Considerable use of generics is also
+--      employed.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      26 FEB 96   SAIC    Initial release for 2.1
+--      22 AUG 96   SAIC    Revised Check procedure
+--
+--!
+
+------------------------------------------------------------------------------
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Generic_Elementary_Functions;
+procedure CXG2009 is
+   Verbose : constant Boolean := False;
+
+   --=====================================================================
+
+   generic
+      type Real is digits <>;
+   package Generic_Real_Norm_Check is
+      procedure Do_Test;
+   end Generic_Real_Norm_Check;
+
+   -----------------------------------------------------------------------
+
+   package body Generic_Real_Norm_Check is
+      type Vector is array (Integer range <>) of Real;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Sqrt (X : Real) return Real renames GEF.Sqrt;
+
+      function One_Norm (V : Vector) return Real is
+      -- sum of absolute values of the elements of the vector
+	 Result : Real := 0.0;
+      begin
+	 for I in V'Range loop
+	    Result := Result + abs V(I);
+	 end loop;
+	 return Result;
+      end One_Norm;
+
+      function Inf_Norm (V : Vector) return Real is
+      -- greatest absolute vector element
+	 Result : Real := 0.0;
+      begin
+	 for I in V'Range loop
+	    if abs V(I) > Result then
+	       Result := abs V(I);
+	    end if;
+	 end loop;
+	 return Result;
+      end Inf_Norm;
+
+      function Two_Norm (V : Vector) return Real is
+      -- if greatest absolute vector element is 0 then return 0
+      -- else return greatest * sqrt (sum((element / greatest) ** 2)))
+      --   where greatest is Inf_Norm of the vector
+	 Inf_N : Real;
+	 Sum_Squares : Real;
+	 Term : Real;
+      begin
+	 Inf_N := Inf_Norm (V);
+	 if Inf_N = 0.0 then
+	    return 0.0;
+	 end if;
+         Sum_Squares := 0.0;
+	 for I in V'Range loop
+	    Term := V (I) / Inf_N;
+	    Sum_Squares := Sum_Squares + Term * Term;
+	 end loop;
+	 return Inf_N * Sqrt (Sum_Squares);
+      end Two_Norm;
+
+
+      procedure Check (Actual, Expected : Real;
+		       Test_Name : String;
+		       MRE : Real;
+		       Vector_Length : Integer) is
+         Rel_Error : Real;
+         Abs_Error : Real;
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Report.Failed (Test_Name & 
+	                     "  VectLength:" & 
+                           Integer'Image (Vector_Length) &
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & 
+                           Real'Image (Actual - Expected) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+            Report.Comment (Test_Name & " vector length" &
+                            Integer'Image (Vector_Length));
+	  end if;
+      end Check;
+
+
+      procedure Do_Test is
+      begin
+	 for Vector_Length in 1 .. 10 loop
+	    declare
+	       V  : Vector (1..Vector_Length) := (1..Vector_Length => 0.0);
+	       V1 : Vector (1..Vector_Length) := (1..Vector_Length => 1.0);
+	    begin
+	       Check (One_Norm (V), 0.0, "one_norm (z)", 0.0, Vector_Length);
+	       Check (Inf_Norm (V), 0.0, "inf_norm (z)", 0.0, Vector_Length);
+
+	       for J in 1..Vector_Length loop
+		 V := (1..Vector_Length => 0.0);
+		 V (J) := 1.0;
+	         Check (One_Norm (V), 1.0, "one_norm (010)", 
+			0.0, Vector_Length);
+	         Check (Inf_Norm (V), 1.0, "inf_norm (010)", 
+			0.0, Vector_Length);
+	         Check (Two_Norm (V), 1.0, "two_norm (010)", 
+			0.0, Vector_Length);
+	       end loop;
+
+	       Check (One_Norm (V1), Real (Vector_Length), "one_norm (1)", 
+		      0.0, Vector_Length);
+	       Check (Inf_Norm (V1), 1.0, "inf_norm (1)", 
+		      0.0, Vector_Length);
+
+               -- error in computing Two_Norm and expected result
+               -- are as follows  (ME is Model_Epsilon * Expected_Value):
+               --   2ME from expected Sqrt
+               --   2ME from Sqrt in Two_Norm times the error in the
+               --   vector calculation.
+               --   The vector calculation contains the following error
+               --   based upon the length N of the vector:
+               --      N*1ME from squaring terms in Two_Norm
+               --      N*1ME from the division of each term in Two_Norm
+               --      (N-1)*1ME from the sum of the terms
+               -- This gives (2 + 2 * (N + N + (N-1)) ) * ME
+               -- which simplifies to (2 + 2N + 2N + 2N - 2) * ME
+               -- or 6*N*ME
+	       Check (Two_Norm (V1), Sqrt (Real(Vector_Length)), 
+                      "two_norm (1)", 
+		      (Real (6 * Vector_Length)), 
+		      Vector_Length);
+	    exception
+	       when others => Report.Failed ("exception for vector length" &
+				Integer'Image (Vector_Length) );
+	    end;
+	 end loop;
+      end Do_Test;
+   end Generic_Real_Norm_Check;
+
+   --=====================================================================
+
+   generic
+      type Real is digits <>;
+   package Generic_Complex_Norm_Check is
+      procedure Do_Test;
+   end Generic_Complex_Norm_Check;
+
+   -----------------------------------------------------------------------
+
+   package body Generic_Complex_Norm_Check is
+      package Complex_Types is new Ada.Numerics.Generic_Complex_Types (Real);
+      use Complex_Types;
+      type Vector is array (Integer range <>) of Complex;
+
+      package GEF is new Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Sqrt (X : Real) return Real renames GEF.Sqrt;
+
+      function One_Norm (V : Vector) return Real is
+	 Result : Real := 0.0;
+      begin
+	 for I in V'Range loop
+	    Result := Result + abs V(I);
+	 end loop;
+	 return Result;
+      end One_Norm;
+
+      function Inf_Norm (V : Vector) return Real is
+	 Result : Real := 0.0;
+      begin
+	 for I in V'Range loop
+	    if abs V(I) > Result then
+	       Result := abs V(I);
+	    end if;
+	 end loop;
+	 return Result;
+      end Inf_Norm;
+
+      function Two_Norm (V : Vector) return Real is
+	 Inf_N : Real;
+	 Sum_Squares : Real;
+	 Term : Real;
+      begin
+	 Inf_N := Inf_Norm (V);
+	 if Inf_N = 0.0 then
+	    return 0.0;
+	 end if;
+         Sum_Squares := 0.0;
+	 for I in V'Range loop
+	    Term := abs (V (I) / Inf_N );
+	    Sum_Squares := Sum_Squares + Term * Term;
+	 end loop;
+	 return Inf_N * Sqrt (Sum_Squares);
+      end Two_Norm;
+
+
+      procedure Check (Actual, Expected : Real;
+		       Test_Name : String;
+		       MRE : Real;
+		       Vector_Length : Integer) is
+         Rel_Error : Real;
+         Abs_Error : Real;
+         Max_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Report.Failed (Test_Name & 
+	                     "  VectLength:" & 
+                           Integer'Image (Vector_Length) &
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & 
+                           Real'Image (Actual - Expected) &
+                           " mre:" & Real'Image (Max_Error) );
+         elsif Verbose then
+            Report.Comment (Test_Name & " vector length" &
+                            Integer'Image (Vector_Length));
+	  end if;
+      end Check;
+
+
+      procedure Do_Test is
+      begin
+	 for Vector_Length in 1 .. 10 loop
+	    declare
+	       V  : Vector (1..Vector_Length) := 
+                      (1..Vector_Length => (0.0, 0.0));
+               X, Y : Vector (1..Vector_Length);
+	    begin
+	       Check (One_Norm (V), 0.0, "one_norm (z)", 0.0, Vector_Length);
+	       Check (Inf_Norm (V), 0.0, "inf_norm (z)", 0.0, Vector_Length);
+
+	       for J in 1..Vector_Length loop
+		 X := (1..Vector_Length => (0.0, 0.0) );
+                 Y := X;   -- X and Y are now both zeroed
+		 X (J).Re := 1.0;
+                 Y (J).Im := 1.0;
+	         Check (One_Norm (X), 1.0, "one_norm (0x0)", 
+			0.0, Vector_Length);
+	         Check (Inf_Norm (X), 1.0, "inf_norm (0x0)", 
+			0.0, Vector_Length);
+	         Check (Two_Norm (X), 1.0, "two_norm (0x0)", 
+			0.0, Vector_Length);
+	         Check (One_Norm (Y), 1.0, "one_norm (0y0)", 
+			0.0, Vector_Length);
+	         Check (Inf_Norm (Y), 1.0, "inf_norm (0y0)", 
+			0.0, Vector_Length);
+	         Check (Two_Norm (Y), 1.0, "two_norm (0y0)", 
+			0.0, Vector_Length);
+	       end loop;
+
+               V := (1..Vector_Length => (3.0, 4.0));
+
+               -- error in One_Norm is 3*N*ME for abs computation +
+               --  (N-1)*ME for the additions
+               -- which gives (4N-1) * ME
+	       Check (One_Norm (V), 5.0 * Real (Vector_Length), 
+		      "one_norm ((3,4))", 
+		      Real (4*Vector_Length - 1), 
+		      Vector_Length);
+
+               -- error in Inf_Norm is from abs of single element (3ME)
+	       Check (Inf_Norm (V), 5.0, 
+		      "inf_norm ((3,4))", 
+		      3.0, 
+		      Vector_Length);
+
+               -- error in following comes from:
+               --   2ME in sqrt of expected result
+               --   3ME in Inf_Norm calculation
+               --   2ME in sqrt of vector calculation
+               --   vector calculation has following error
+               --      3N*ME for abs
+               --       N*ME for squaring
+               --       N*ME for division
+               --       (N-1)ME for sum
+               -- this results in [2 + 3 + 2(6N-1) ] * ME
+               -- or (12N + 3)ME
+	       Check (Two_Norm (V), 5.0 * Sqrt (Real(Vector_Length)), 
+                      "two_norm ((3,4))", 
+		      (12.0 * Real (Vector_Length) + 3.0), 
+		      Vector_Length);
+	    exception
+	       when others => Report.Failed ("exception for complex " &
+                                             "vector length" &
+	                                     Integer'Image (Vector_Length) );
+	    end;
+	 end loop;
+      end Do_Test;
+   end Generic_Complex_Norm_Check;
+
+   --=====================================================================
+
+   generic
+      type Real is digits <>;
+   package Generic_Norm_Check is
+      procedure Do_Test;
+   end Generic_Norm_Check;
+
+   -----------------------------------------------------------------------
+
+   package body Generic_Norm_Check is
+      package RNC is new Generic_Real_Norm_Check (Real);
+      package CNC is new Generic_Complex_Norm_Check (Real);
+      procedure Do_Test is
+      begin
+         RNC.Do_Test;
+         CNC.Do_Test;
+      end Do_Test;
+   end Generic_Norm_Check;
+
+   --=====================================================================
+
+   package Float_Check is new Generic_Norm_Check (Float);
+
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Norm_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+
+begin
+   Report.Test ("CXG2009",
+                "Check the accuracy of the real sqrt and complex " &
+                " modulus functions"); 
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+   Report.Result;
+end CXG2009;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2010.a
new file mode 100644
index 000000000..4140a4875
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2010.a
@@ -0,0 +1,892 @@
+-- CXG2010.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 exp function returns
+--      results that are within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test contains three test packages that are almost
+--      identical.  The first two packages differ only in the 
+--      floating point type that is being tested.  The first
+--      and third package differ only in whether the generic
+--      elementary functions package or the pre-instantiated
+--      package is used.
+--      The test package is not generic so that the arguments
+--      and expected results for some of the test values
+--      can be expressed as universal real instead of being
+--      computed at runtime.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex and where the Machine_Radix is 2, 4, 8, or 16.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--       1 Mar 96   SAIC    Initial release for 2.1
+--       2 Sep 96   SAIC    Improved check routine 
+--
+--!
+
+--
+-- References:
+--
+-- Software Manual for the Elementary Functions
+-- William J. Cody, Jr. and William Waite
+-- Prentice-Hall, 1980
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition 
+--
+-- Implementation and Testing of Function Software
+-- W. J. Cody
+-- Problems and Methodologies in Mathematical Software Production
+-- editors P. C. Messina and A. Murli
+-- Lecture Notes in Computer Science   Volume 142
+-- Springer Verlag, 1982
+--
+
+--
+-- Notes on derivation of error bound for exp(p)*exp(-p)
+--
+-- Let a = true value of exp(p) and ac be the computed value.
+-- Then a = ac(1+e1), where |e1| <= 4*Model_Epsilon.
+-- Similarly, let b = true value of exp(-p) and bc be the computed value.
+-- Then b = bc(1+e2), where |e2| <= 4*ME.
+-- 
+-- The product of x and y is (x*y)(1+e3), where |e3| <= 1.0ME
+-- 
+-- Hence, the computed ab is [ac(1+e1)*bc(1+e2)](1+e3) =
+-- (ac*bc)[1 + e1 + e2 + e3 + e1e2 + e1e3 + e2e3 + e1e2e3).
+-- 
+-- Throwing away the last four tiny terms, we have (ac*bc)(1 + eta),
+-- 
+-- where |eta| <= (4+4+1)ME = 9.0Model_Epsilon.
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+with Ada.Numerics.Elementary_Functions;
+procedure CXG2010 is
+   Verbose : constant Boolean := False;
+   Max_Samples : constant := 1000;
+   Accuracy_Error_Reported : Boolean := False;
+
+   package Float_Check is
+      subtype Real is Float;
+      procedure Do_Test;
+   end Float_Check;
+
+   package body Float_Check is
+      package Elementary_Functions is new 
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Sqrt (X : Real) return Real renames
+           Elementary_Functions.Sqrt;
+      function Exp (X : Real) return Real renames
+           Elementary_Functions.Exp;
+
+
+      -- The following value is a lower bound on the accuracy
+      -- required.  It is normally 0.0 so that the lower bound
+      -- is computed from Model_Epsilon.  However, for tests
+      -- where the expected result is only known to a certain
+      -- amount of precision this bound takes on a non-zero 
+      -- value to account for that level of precision.
+      Error_Low_Bound : Real := 0.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon 
+         -- instead of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         -- take into account the low bound on the error
+         if Max_Error < Error_Low_Bound then
+            Max_Error := Error_Low_Bound;
+         end if;
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Argument_Range_Check_1 (A, B : Real;
+                                        Test : String) is
+         -- test a evenly distributed selection of 
+         -- arguments selected from the range A to B. 
+	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
+	 -- The parameter One_Minus_Exp_Minus_V is the value
+	 --   1.0 - Exp (-V) 
+	 -- accurate to machine precision.
+         -- This procedure is a translation of part of Cody's test 
+         X : Real;
+         Y : Real;
+	 ZX, ZY : Real;
+         V : constant := 1.0 / 16.0;
+         One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2;
+
+      begin
+         Accuracy_Error_Reported := False;
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            Y := X - V;
+	    if Y < 0.0 then 
+	       X := Y + V;
+	    end if;
+
+	    ZX := Exp (X);
+	    ZY := Exp (Y);
+
+	    -- ZX := Exp(X) - Exp(X) * (1 - Exp(-V);
+	    -- which simplifies to ZX := Exp (X-V);
+	    ZX := ZX - ZX * One_Minus_Exp_Minus_V;
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+          Check (ZY, ZX, 
+                 "test " & Test & " -" &
+                 Integer'Image (I) &
+	     	     " exp (" & Real'Image (X) & ")",
+                 9.0);
+           exit when Accuracy_Error_Reported;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in argument range check 1");
+         when others =>
+            Report.Failed ("exception in argument range check 1");
+      end Argument_Range_Check_1;
+
+
+
+      procedure Argument_Range_Check_2 (A, B : Real;
+                                        Test : String) is
+         -- test a evenly distributed selection of 
+         -- arguments selected from the range A to B. 
+	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
+	 -- The parameter One_Minus_Exp_Minus_V is the value
+	 --   1.0 - Exp (-V) 
+	 -- accurate to machine precision.
+         -- This procedure is a translation of part of Cody's test 
+         X : Real;
+         Y : Real;
+	 ZX, ZY : Real;
+         V : constant := 45.0 / 16.0;
+            -- 1/16 - Exp(45/16)
+         Coeff : constant := 2.4453321046920570389E-3;
+
+      begin
+         Accuracy_Error_Reported := False;
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            Y := X - V;
+	    if Y < 0.0 then 
+	       X := Y + V;
+	    end if;
+
+	    ZX := Exp (X);
+	    ZY := Exp (Y);
+
+	    -- ZX := Exp(X) * 1/16 - Exp(X) * Coeff;
+            -- where Coeff is 1/16 - Exp(45/16)
+	    -- which simplifies to ZX := Exp (X-V);
+	    ZX := ZX * 0.0625 - ZX * Coeff;
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+          Check (ZY, ZX, 
+                 "test " & Test & " -" &
+                 Integer'Image (I) &
+                 " exp (" & Real'Image (X) & ")",
+                 9.0);
+           exit when Accuracy_Error_Reported;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in argument range check 2");
+         when others =>
+            Report.Failed ("exception in argument range check 2");
+      end Argument_Range_Check_2;
+
+
+      procedure Do_Test is
+      begin
+
+         --- test 1 ---
+         declare
+	    Y : Real;
+         begin
+            Y := Exp(1.0);
+            -- normal accuracy requirements
+            Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+         --- test 2 ---
+	 declare
+	    Y : Real;
+         begin
+            Y := Exp(16.0) * Exp(-16.0);
+            Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+         --- test 3 ---
+	 declare
+            Y : Real;
+         begin
+            Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi);
+            Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 3");
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+         --- test 4 ---
+	 declare
+            Y : Real;
+         begin
+            Y := Exp(0.0);
+            Check (Y, 1.0, "test 4 -- exp(0.0)", 
+                   0.0);   -- no error allowed
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 4");
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+         --- test 5 ---
+         -- constants used here only have 19 digits of precision
+         if Real'Digits > 19 then
+            Error_Low_Bound := 0.00000_00000_00000_0001;
+            Report.Comment ("exp accuracy checked to 19 digits");
+         end if;
+
+         Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), 
+                                  1.0, 
+                                  "5");
+         Error_Low_Bound := 0.0;  -- reset
+
+	 --- test 6 ---
+         -- constants used here only have 19 digits of precision
+         if Real'Digits > 19 then
+            Error_Low_Bound := 0.00000_00000_00000_0001;
+            Report.Comment ("exp accuracy checked to 19 digits");
+         end if;
+
+         Argument_Range_Check_2 (1.0, 
+                                 Sqrt(Real(Real'Machine_Radix)), 
+                                 "6");
+         Error_Low_Bound := 0.0;  -- reset
+
+      end Do_Test;
+   end Float_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+
+
+   package A_Long_Float_Check is
+      subtype Real is A_Long_Float;
+      procedure Do_Test;
+   end A_Long_Float_Check;
+
+   package body A_Long_Float_Check is
+      package Elementary_Functions is new 
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Sqrt (X : Real) return Real renames
+           Elementary_Functions.Sqrt;
+      function Exp (X : Real) return Real renames
+           Elementary_Functions.Exp;
+
+
+      -- The following value is a lower bound on the accuracy
+      -- required.  It is normally 0.0 so that the lower bound
+      -- is computed from Model_Epsilon.  However, for tests
+      -- where the expected result is only known to a certain
+      -- amount of precision this bound takes on a non-zero 
+      -- value to account for that level of precision.
+      Error_Low_Bound : Real := 0.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon 
+         -- instead of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         -- take into account the low bound on the error
+         if Max_Error < Error_Low_Bound then
+            Max_Error := Error_Low_Bound;
+         end if;
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Argument_Range_Check_1 (A, B : Real;
+                                        Test : String) is
+         -- test a evenly distributed selection of 
+         -- arguments selected from the range A to B. 
+	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
+	 -- The parameter One_Minus_Exp_Minus_V is the value
+	 --   1.0 - Exp (-V) 
+	 -- accurate to machine precision.
+         -- This procedure is a translation of part of Cody's test 
+         X : Real;
+         Y : Real;
+	 ZX, ZY : Real;
+         V : constant := 1.0 / 16.0;
+         One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2;
+
+      begin
+         Accuracy_Error_Reported := False;
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            Y := X - V;
+	    if Y < 0.0 then 
+	       X := Y + V;
+	    end if;
+
+	    ZX := Exp (X);
+	    ZY := Exp (Y);
+
+	    -- ZX := Exp(X) - Exp(X) * (1 - Exp(-V);
+	    -- which simplifies to ZX := Exp (X-V);
+	    ZX := ZX - ZX * One_Minus_Exp_Minus_V;
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+          Check (ZY, ZX, 
+                 "test " & Test & " -" &
+                 Integer'Image (I) &
+                 " exp (" & Real'Image (X) & ")",
+                 9.0);
+           exit when Accuracy_Error_Reported;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in argument range check 1");
+         when others =>
+            Report.Failed ("exception in argument range check 1");
+      end Argument_Range_Check_1;
+
+
+
+      procedure Argument_Range_Check_2 (A, B : Real;
+                                        Test : String) is
+         -- test a evenly distributed selection of 
+         -- arguments selected from the range A to B. 
+	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
+	 -- The parameter One_Minus_Exp_Minus_V is the value
+	 --   1.0 - Exp (-V) 
+	 -- accurate to machine precision.
+         -- This procedure is a translation of part of Cody's test 
+         X : Real;
+         Y : Real;
+	 ZX, ZY : Real;
+         V : constant := 45.0 / 16.0;
+            -- 1/16 - Exp(45/16)
+         Coeff : constant := 2.4453321046920570389E-3;
+
+      begin
+         Accuracy_Error_Reported := False;
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            Y := X - V;
+	    if Y < 0.0 then 
+	       X := Y + V;
+	    end if;
+
+	    ZX := Exp (X);
+	    ZY := Exp (Y);
+
+	    -- ZX := Exp(X) * 1/16 - Exp(X) * Coeff;
+            -- where Coeff is 1/16 - Exp(45/16)
+	    -- which simplifies to ZX := Exp (X-V);
+	    ZX := ZX * 0.0625 - ZX * Coeff;
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+          Check (ZY, ZX, 
+                 "test " & Test & " -" &
+                 Integer'Image (I) &
+                 " exp (" & Real'Image (X) & ")",
+                 9.0);
+           exit when Accuracy_Error_Reported;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in argument range check 2");
+         when others =>
+            Report.Failed ("exception in argument range check 2");
+      end Argument_Range_Check_2;
+
+
+      procedure Do_Test is
+      begin
+
+         --- test 1 ---
+         declare
+	    Y : Real;
+         begin
+            Y := Exp(1.0);
+            -- normal accuracy requirements
+            Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+         --- test 2 ---
+	 declare
+	    Y : Real;
+         begin
+            Y := Exp(16.0) * Exp(-16.0);
+            Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+         --- test 3 ---
+	 declare
+            Y : Real;
+         begin
+            Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi);
+            Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 3");
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+         --- test 4 ---
+	 declare
+            Y : Real;
+         begin
+            Y := Exp(0.0);
+            Check (Y, 1.0, "test 4 -- exp(0.0)", 
+                   0.0);   -- no error allowed
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 4");
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+         --- test 5 ---
+         -- constants used here only have 19 digits of precision
+         if Real'Digits > 19 then
+            Error_Low_Bound := 0.00000_00000_00000_0001;
+            Report.Comment ("exp accuracy checked to 19 digits");
+         end if;
+
+         Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), 
+                                  1.0, 
+                                  "5");
+         Error_Low_Bound := 0.0;  -- reset
+
+	 --- test 6 ---
+         -- constants used here only have 19 digits of precision
+         if Real'Digits > 19 then
+            Error_Low_Bound := 0.00000_00000_00000_0001;
+            Report.Comment ("exp accuracy checked to 19 digits");
+         end if;
+
+         Argument_Range_Check_2 (1.0, 
+                                 Sqrt(Real(Real'Machine_Radix)), 
+                                 "6");
+         Error_Low_Bound := 0.0;  -- reset
+
+      end Do_Test;
+   end A_Long_Float_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+   package Non_Generic_Check is
+      procedure Do_Test;
+      subtype Real is Float;
+   end Non_Generic_Check;
+
+   package body Non_Generic_Check is
+
+      package Elementary_Functions renames 
+           Ada.Numerics.Elementary_Functions;
+      function Sqrt (X : Real) return Real renames
+           Elementary_Functions.Sqrt;
+      function Exp (X : Real) return Real renames
+           Elementary_Functions.Exp;
+
+
+      -- The following value is a lower bound on the accuracy
+      -- required.  It is normally 0.0 so that the lower bound
+      -- is computed from Model_Epsilon.  However, for tests
+      -- where the expected result is only known to a certain
+      -- amount of precision this bound takes on a non-zero 
+      -- value to account for that level of precision.
+      Error_Low_Bound : Real := 0.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon 
+         -- instead of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         -- take into account the low bound on the error
+         if Max_Error < Error_Low_Bound then
+            Max_Error := Error_Low_Bound;
+         end if;
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Argument_Range_Check_1 (A, B : Real;
+                                        Test : String) is
+         -- test a evenly distributed selection of 
+         -- arguments selected from the range A to B. 
+	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
+	 -- The parameter One_Minus_Exp_Minus_V is the value
+	 --   1.0 - Exp (-V) 
+	 -- accurate to machine precision.
+         -- This procedure is a translation of part of Cody's test 
+         X : Real;
+         Y : Real;
+	 ZX, ZY : Real;
+         V : constant := 1.0 / 16.0;
+         One_Minus_Exp_Minus_V : constant := 6.058693718652421388E-2;
+
+      begin
+         Accuracy_Error_Reported := False;
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            Y := X - V;
+	    if Y < 0.0 then 
+	       X := Y + V;
+	    end if;
+
+	    ZX := Exp (X);
+	    ZY := Exp (Y);
+
+	    -- ZX := Exp(X) - Exp(X) * (1 - Exp(-V);
+	    -- which simplifies to ZX := Exp (X-V);
+	    ZX := ZX - ZX * One_Minus_Exp_Minus_V;
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+          Check (ZY, ZX, 
+                 "test " & Test & " -" &
+                 Integer'Image (I) &
+                 " exp (" & Real'Image (X) & ")",
+                 9.0);
+           exit when Accuracy_Error_Reported;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in argument range check 1");
+         when others =>
+            Report.Failed ("exception in argument range check 1");
+      end Argument_Range_Check_1;
+
+
+
+      procedure Argument_Range_Check_2 (A, B : Real;
+                                        Test : String) is
+         -- test a evenly distributed selection of 
+         -- arguments selected from the range A to B. 
+	 -- Test using identity: EXP(X-V) = EXP(X) * EXP (-V)
+	 -- The parameter One_Minus_Exp_Minus_V is the value
+	 --   1.0 - Exp (-V) 
+	 -- accurate to machine precision.
+         -- This procedure is a translation of part of Cody's test 
+         X : Real;
+         Y : Real;
+	 ZX, ZY : Real;
+         V : constant := 45.0 / 16.0;
+            -- 1/16 - Exp(45/16)
+         Coeff : constant := 2.4453321046920570389E-3;
+
+      begin
+         Accuracy_Error_Reported := False;
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            Y := X - V;
+	    if Y < 0.0 then 
+	       X := Y + V;
+	    end if;
+
+	    ZX := Exp (X);
+	    ZY := Exp (Y);
+
+	    -- ZX := Exp(X) * 1/16 - Exp(X) * Coeff;
+            -- where Coeff is 1/16 - Exp(45/16)
+	    -- which simplifies to ZX := Exp (X-V);
+	    ZX := ZX * 0.0625 - ZX * Coeff;
+
+            -- note that since the expected value is computed, we
+            -- must take the error in that computation into account.
+          Check (ZY, ZX, 
+                 "test " & Test & " -" &
+                 Integer'Image (I) &
+                 " exp (" & Real'Image (X) & ")",
+                 9.0);
+           exit when Accuracy_Error_Reported;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in argument range check 2");
+         when others =>
+            Report.Failed ("exception in argument range check 2");
+      end Argument_Range_Check_2;
+
+
+      procedure Do_Test is
+      begin
+
+         --- test 1 ---
+         declare
+	    Y : Real;
+         begin
+            Y := Exp(1.0);
+            -- normal accuracy requirements
+            Check (Y, Ada.Numerics.e, "test 1 -- exp(1)", 4.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+         --- test 2 ---
+	 declare
+	    Y : Real;
+         begin
+            Y := Exp(16.0) * Exp(-16.0);
+            Check (Y, 1.0, "test 2 -- exp(16)*exp(-16)", 9.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+         --- test 3 ---
+	 declare
+            Y : Real;
+         begin
+            Y := Exp (Ada.Numerics.Pi) * Exp (-Ada.Numerics.Pi);
+            Check (Y, 1.0, "test 3 -- exp(pi)*exp(-pi)", 9.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 3");
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+         --- test 4 ---
+	 declare
+            Y : Real;
+         begin
+            Y := Exp(0.0);
+            Check (Y, 1.0, "test 4 -- exp(0.0)", 
+                   0.0);   -- no error allowed
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 4");
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+
+         --- test 5 ---
+         -- constants used here only have 19 digits of precision
+         if Real'Digits > 19 then
+            Error_Low_Bound := 0.00000_00000_00000_0001;
+            Report.Comment ("exp accuracy checked to 19 digits");
+         end if;
+
+         Argument_Range_Check_1 ( 1.0/Sqrt(Real(Real'Machine_Radix)), 
+                                  1.0, 
+                                  "5");
+         Error_Low_Bound := 0.0;  -- reset
+
+	 --- test 6 ---
+         -- constants used here only have 19 digits of precision
+         if Real'Digits > 19 then
+            Error_Low_Bound := 0.00000_00000_00000_0001;
+            Report.Comment ("exp accuracy checked to 19 digits");
+         end if;
+
+         Argument_Range_Check_2 (1.0, 
+                                 Sqrt(Real(Real'Machine_Radix)), 
+                                 "6");
+         Error_Low_Bound := 0.0;  -- reset
+
+      end Do_Test;
+   end Non_Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+begin
+   Report.Test ("CXG2010",
+                "Check the accuracy of the exp function"); 
+
+   -- the test only applies to machines with a radix of 2,4,8, or 16
+   case Float'Machine_Radix is
+      when 2 | 4 | 8 | 16 => null;
+      when others =>
+	     Report.Not_Applicable ("only applicable to binary radix");
+	     Report.Result;
+	     return;
+   end case;
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking non-generic package");
+   end if;
+
+   Non_Generic_Check.Do_Test;
+
+   Report.Result;
+end CXG2010;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2011.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2011.a
new file mode 100644
index 000000000..2c018b132
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2011.a
@@ -0,0 +1,490 @@
+-- CXG2011.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 log function returns
+--      results that are within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is 
+--      instantiated to check both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Checks in a range where a Taylor series can be used to compute 
+--            the expected result.
+--         Checks that use an identity for determining the result.
+--         Exception checks.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--       1 Mar 96   SAIC    Initial release for 2.1
+--      22 Aug 96   SAIC    Improved Check routine
+--      02 DEC 97   EDS     Log (0.0) must raise Constraint_Error, 
+--                          not Argument_Error
+--!
+
+--
+-- References:
+--
+-- Software Manual for the Elementary Functions
+-- William J. Cody, Jr. and William Waite
+-- Prentice-Hall, 1980
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition 
+--
+-- Implementation and Testing of Function Software
+-- W. J. Cody
+-- Problems and Methodologies in Mathematical Software Production
+-- editors P. C. Messina and A. Murli
+-- Lecture Notes in Computer Science   Volume 142
+-- Springer Verlag, 1982
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+procedure CXG2011 is
+   Verbose : constant Boolean := False;
+   Max_Samples : constant := 1000;
+
+   -- CRC Handbook Page 738
+   Ln10 : constant := 2.30258_50929_94045_68401_79914_54684_36420_76011_01489;
+   Ln2  : constant := 0.69314_71805_59945_30941_72321_21458_17656_80755_00134;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Elementary_Functions is new 
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Sqrt (X : Real'Base) return Real'Base renames
+           Elementary_Functions.Sqrt;
+      function Exp (X : Real'Base) return Real'Base renames
+           Elementary_Functions.Exp;
+      function Log (X : Real'Base) return Real'Base renames
+           Elementary_Functions.Log;
+      function Log (X, Base : Real'Base) return Real'Base renames
+           Elementary_Functions.Log;
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+
+      -- The following value is a lower bound on the accuracy
+      -- required.  It is normally 0.0 so that the lower bound
+      -- is computed from Model_Epsilon.  However, for tests
+      -- where the expected result is only known to a certain
+      -- amount of precision this bound takes on a non-zero 
+      -- value to account for that level of precision.
+      Error_Low_Bound : Real := 0.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon 
+         -- instead of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         -- take into account the low bound on the error
+         if Max_Error < Error_Low_Bound then
+            Max_Error := Error_Low_Bound;
+         end if;
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+            if Actual = Expected then
+               Report.Comment (Test_Name & "  exact result");
+            else
+               Report.Comment (Test_Name & "  passed");
+            end if;
+         end if;
+      end Check;
+
+
+      procedure Special_Value_Test is
+      begin
+
+         --- test 1 ---
+         declare
+            Y : Real;
+         begin
+            Y := Log(1.0);
+            Check (Y, 0.0, "special value test 1 -- log(1)",
+                   0.0);  -- no error allowed
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 1");
+            when others =>
+               Report.Failed ("exception in test 1");
+         end;
+
+         --- test 2 ---
+         declare
+            Y : Real;
+         begin
+            Y := Log(10.0);
+            Check (Y, Ln10, "special value test 2 -- log(10)", 4.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 2");
+            when others =>
+               Report.Failed ("exception in test 2");
+         end;
+
+         --- test 3 ---
+         declare
+            Y : Real;
+         begin
+            Y := Log (2.0);
+            Check (Y, Ln2, "special value test 3 -- log(2)", 4.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 3");
+            when others =>
+               Report.Failed ("exception in test 3");
+         end;
+
+         --- test 4 ---
+         declare
+            Y : Real;
+         begin
+            Y := Log (2.0 ** 18, 2.0);
+            Check (Y, 18.0, "special value test 4 -- log(2**18,2)", 4.0);
+         exception
+            when Constraint_Error => 
+               Report.Failed ("Constraint_Error raised in test 4");
+            when others =>
+               Report.Failed ("exception in test 4");
+         end;
+      end Special_Value_Test;
+
+
+      procedure Taylor_Series_Test is
+      -- Use a 4 term taylor series expansion to check a selection of
+      -- arguments very near 1.0.
+      -- The range is chosen so that the 4 term taylor series will
+      -- provide accuracy to machine precision.   Cody pg 49-50.
+         Half_Range : constant Real := Real'Model_Epsilon * 50.0;
+         A : constant Real := 1.0 - Half_Range;
+         B : constant Real := 1.0 + Half_Range;
+         X : Real;
+         Xm1 : Real;
+         Expected : Real;
+         Actual : Real;
+
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            
+            Xm1 := X - 1.0;
+            -- The following is the first 4 terms of the taylor series
+            -- that has been rearranged to minimize error in the calculation
+            Expected := (Xm1 * (1.0/3.0 - Xm1/4.0) - 0.5) * Xm1 * Xm1 + Xm1;
+
+            Actual := Log (X);
+            Check (Actual, Expected,
+                   "Taylor Series Test -" &
+                   Integer'Image (I) &
+                   " log (" & Real'Image (X) & ")",
+                   4.0);
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Taylor Series Test");
+         when others =>
+            Report.Failed ("exception in Taylor Series Test");
+      end Taylor_Series_Test;
+
+
+
+      procedure Log_Difference_Identity is
+      -- Check using the identity ln(x) = ln(17x/16) - ln(17/16)
+      -- over the range A to B.
+      -- The selected range assures that both X and 17x/16 will
+      -- have the same exponents and neither argument gets too close
+      -- to 1.    Cody pg 50.
+         A : constant Real := 1.0 / Sqrt (2.0);
+         B : constant Real := 15.0 / 16.0;
+         X : Real;
+         Expected : Real;
+         Actual : Real;
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            -- magic argument purification
+            X := Real'Machine (Real'Machine (X+8.0) - 8.0);
+            
+            Expected := Log (X + X / 16.0) - Log (17.0/16.0);
+
+            Actual := Log (X);
+            Check (Actual, Expected,
+                   "Log Difference Identity -" &
+                   Integer'Image (I) &
+                   " log (" & Real'Image (X) & ")",
+                   4.0);
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Log Difference Identity Test");
+         when others =>
+            Report.Failed ("exception in Log Difference Identity Test");
+      end Log_Difference_Identity;
+
+
+      procedure Log_Product_Identity is
+      -- Check using the identity ln(x**2) = 2ln(x)
+      -- over the range A to B.
+      -- This large range is chosen to minimize the possibility of
+      -- undetected systematic errors.   Cody pg 53.
+         A : constant Real := 16.0;
+         B : constant Real := 240.0;
+         X : Real;
+         Expected : Real;
+         Actual : Real;
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            -- magic argument purification
+            X := Real'Machine (Real'Machine (X+8.0) - 8.0);
+            
+            Expected := 2.0 * Log (X);
+
+            Actual := Log (X*X);
+            Check (Actual, Expected,
+                   "Log Product Identity -" &
+                   Integer'Image (I) &
+                   " log (" & Real'Image (X) & ")",
+                   4.0);
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+         end loop;
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Log Product Identity Test");
+         when others =>
+            Report.Failed ("exception in Log Product Identity Test");
+      end Log_Product_Identity;
+
+
+      procedure Log10_Test is
+      -- Check using the identity log(x) = log(11x/10) - log(1.1)
+      -- over the range A to B.  See Cody pg 52.
+         A : constant Real := 1.0 / Sqrt (10.0);
+         B : constant Real := 0.9;
+         X : Real;
+         Expected : Real;
+         Actual : Real;
+      begin
+         if Real'Digits > 17 then
+             -- constant used below is accuract to 17 digits
+            Error_Low_Bound := 0.00000_00000_00000_01;
+            Report.Comment ("log accuracy checked to 19 digits");
+         end if;
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            
+            Expected := Log (X + X/10.0, 10.0)
+                     - 3.77060_15822_50407_5E-4 - 21.0 / 512.0;
+
+            Actual := Log (X, 10.0);
+            Check (Actual, Expected,
+                   "Log 10 Test -" &
+                   Integer'Image (I) &
+                   " log (" & Real'Image (X) & ")",
+                   4.0);
+
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+            exit when Accuracy_Error_Reported;
+         end loop;
+         Error_Low_Bound := 0.0;   -- reset
+
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Log 10 Test");
+         when others =>
+            Report.Failed ("exception in Log 10 Test");
+      end Log10_Test;
+
+
+      procedure Exception_Test is
+         X1, X2, X3, X4 : Real;
+      begin
+         begin
+            X1 := Log (0.0);
+            Report.Failed ("exception not raised for LOG(0)");
+         exception
+            -- Log (0.0) must raise Constraint_Error, not Argument_Error,
+            -- as per A.5.1(28,29).  Was incorrect in ACVC 2.1 release.
+            when Ada.Numerics.Argument_Error =>
+               Report.Failed ("Argument_Error raised instead of" &
+                              " Constraint_Error for LOG(0)--A.5.1(28,29)");
+            when Constraint_Error =>  null;  -- ok
+            when others =>
+               Report.Failed ("wrong exception raised for LOG(0)");
+         end;
+
+         begin
+            X2 := Log ( 1.0, 0.0);
+            Report.Failed ("exception not raised for LOG(1,0)");
+         exception
+            when Ada.Numerics.Argument_Error =>  null;  -- ok
+            when Constraint_Error => 
+               Report.Failed ("constraint_error raised instead of" &
+                              " argument_error for LOG(1,0)");
+            when others =>
+               Report.Failed ("wrong exception raised for LOG(1,0)");
+         end;
+
+         begin
+            X3 := Log (1.0, 1.0);
+            Report.Failed ("exception not raised for LOG(1,1)");
+         exception
+            when Ada.Numerics.Argument_Error =>  null;  -- ok
+            when Constraint_Error => 
+               Report.Failed ("constraint_error raised instead of" &
+                              " argument_error for LOG(1,1)");
+            when others =>
+               Report.Failed ("wrong exception raised for LOG(1,1)");
+         end;
+
+         begin
+            X4 := Log (1.0, -10.0);
+            Report.Failed ("exception not raised for LOG(1,-10)");
+         exception
+            when Ada.Numerics.Argument_Error =>  null;  -- ok
+            when Constraint_Error => 
+               Report.Failed ("constraint_error raised instead of" &
+                              " argument_error for LOG(1,-10)");
+            when others =>
+               Report.Failed ("wrong exception raised for LOG(1,-10)");
+         end;
+
+         -- optimizer thwarting
+         if Report.Ident_Bool (False) then
+            Report.Comment (Real'Image (X1+X2+X3+X4));
+         end if;
+      end Exception_Test;
+
+
+      procedure Do_Test is
+      begin
+         Special_Value_Test;
+         Taylor_Series_Test;
+         Log_Difference_Identity;
+         Log_Product_Identity;
+         Log10_Test;
+         Exception_Test;
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   package Float_Check is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2011",
+                "Check the accuracy of the log function"); 
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2012.a
new file mode 100644
index 000000000..6a665d0e0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2012.a
@@ -0,0 +1,438 @@
+-- CXG2012.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 exponentiation operator returns
+--      results that are within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is
+--      instantiated to check both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Checks that use an identity for determining the result.
+--         Exception checks.
+--      While this test concentrates on the "**" operator
+--      defined in Generic_Elementary_Functions, a check is also
+--      performed on the standard "**" operator.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--       7 Mar 96   SAIC    Initial release for 2.1
+--       2 Sep 96   SAIC    Improvements as suggested by reviewers
+--	 3 Jun 98   EDS     Add parens to ensure that the expression is not
+--                          evaluated by multiplying its two large terms
+--                          together and overflowing.
+--       3 Dec 01   RLB     Added 'Machine to insure that equality tests
+--                          are certain to work.
+--
+--!
+
+--
+-- References:
+--
+-- Software Manual for the Elementary Functions
+-- William J. Cody, Jr. and William Waite
+-- Prentice-Hall, 1980
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition
+--
+-- Implementation and Testing of Function Software
+-- W. J. Cody
+-- Problems and Methodologies in Mathematical Software Production
+-- editors P. C. Messina and A. Murli
+-- Lecture Notes in Computer Science   Volume 142
+-- Springer Verlag, 1982
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+procedure CXG2012 is
+   Verbose : constant Boolean := False;
+   Max_Samples : constant := 1000;
+
+   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+   Sqrt2 : constant :=
+        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+   Sqrt3 : constant :=
+        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
+
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Elementary_Functions is new
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Sqrt (X : Real) return Real renames
+           Elementary_Functions.Sqrt;
+      function Exp (X : Real) return Real renames
+           Elementary_Functions.Exp;
+      function Log (X : Real) return Real renames
+           Elementary_Functions.Log;
+      function "**" (L, R : Real) return Real renames
+           Elementary_Functions."**";
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon
+         -- instead of Model_Epsilon and Expected.
+         Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if;
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name &
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      -- the following version of Check computes the allowed error bound
+      -- using the operands
+      procedure Check (Actual, Expected : Real;
+                       Left, Right : Real;
+                       Test_Name : String;
+                       MRE_Factor : Real := 1.0) is
+         MRE : Real;
+      begin
+         MRE := MRE_Factor * (4.0 + abs (Right * Log(Left)) / 32.0);
+         Check (Actual, Expected, Test_Name, MRE);
+      end Check;
+
+
+      procedure Real_To_Integer_Test is
+         type Int_Check is
+	    record
+	       Left : Real;
+	       Right : Integer;
+	       Expected : Real;
+	    end record;
+	 type Int_Checks is array (Positive range <>) of Int_Check;
+
+         -- the following tests use only model numbers so the result
+         -- is expected to be exact.
+	 IC : constant Int_Checks :=
+         ( (  2.0,   5,       32.0),
+           ( -2.0,   5,      -32.0),
+           (  0.5,  -5,       32.0),
+           (  2.0,   0,        1.0),
+           (  0.0,   0,        1.0) );
+      begin
+	 for I in IC'Range loop
+            declare
+	       Y : Real;
+            begin
+               Y := IC (I).Left ** IC (I).Right;
+               Check (Y, IC (I).Expected,
+		      "real to integer test" &
+		      Real'Image (IC (I).Left) & " ** " &
+		      Integer'Image (IC (I).Right),
+		      0.0);  -- no error allowed
+            exception
+               when Constraint_Error =>
+                  Report.Failed ("Constraint_Error raised in rtoi test " &
+		     Integer'Image (I));
+               when others =>
+                  Report.Failed ("exception in rtoi test " &
+		     Integer'Image (I));
+            end;
+         end loop;
+      end Real_To_Integer_Test;
+
+
+      procedure Special_Value_Test is
+         No_Error : constant := 0.0;
+      begin
+         Check (0.0 ** 1.0, 0.0, "0**1", No_Error);
+         Check (1.0 ** 0.0, 1.0, "1**0", No_Error);
+
+         Check ( 2.0 **  5.0,  32.0,  2.0,  5.0,  "2**5");
+         Check ( 0.5**(-5.0),  32.0,  0.5, -5.0,  "0.5**-5");
+
+         Check (Sqrt2 ** 4.0,   4.0,  Sqrt2, 4.0,  "Sqrt2**4");
+         Check (Sqrt3 ** 6.0,  27.0,  Sqrt3, 6.0,  "Sqrt3**6");
+
+         Check (2.0 ** 0.5,   Sqrt2,    2.0, 0.5,  "2.0**0.5");
+
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised in Special Value Test");
+         when others =>
+            Report.Failed ("exception in Special Value Test");
+      end Special_Value_Test;
+
+
+      procedure Small_Range_Test is
+      -- Several checks over the range 1/radix .. 1
+         A : constant Real := 1.0 / Real (Real'Machine_Radix);
+         B : constant Real := 1.0;
+         X : Real;
+         -- In the cases below where the expected result is
+         -- inexact we allow an additional error amount of
+         -- 1.0 * Model_Epsilon to account for that error.
+         -- This is accomplished by the factor of 1.25 times
+         -- the computed error bound (which is > 4.0) thus
+         -- increasing the error bound by at least
+         -- 1.0 * Model_Epsilon
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 0..Max_Samples loop
+            X :=  Real'Machine((B - A) * Real (I) / Real (Max_Samples) + A);
+
+            Check (X ** 1.0, X,  -- exact result required
+                   "Small range" & Integer'Image (I) & ": " &
+                   Real'Image (X) & " ** 1.0",
+                   0.0);
+
+            Check ((X*X) ** 1.5, X**3,  X*X, 1.5,
+                   "Small range" & Integer'Image (I) & ": " &
+                   Real'Image (X*X) & " ** 1.5",
+                   1.25);
+
+            Check (X ** 13.5, 1.0 / (X ** (-13.5)),  X, 13.5,
+                   "Small range" & Integer'Image (I) & ": " &
+                   Real'Image (X) & " ** 13.5",
+                   2.0);   -- 2 ** computations
+
+            Check ((X*X) ** 1.25, X**(2.5),  X*X, 1.25,
+                   "Small range" & Integer'Image (I) & ": " &
+                   Real'Image (X*X) & " ** 1.25",
+                   2.0);   -- 2 ** computations
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+
+         end loop;
+
+      exception
+         when Constraint_Error =>
+            Report.Failed
+               ("Constraint_Error raised in Small Range Test");
+         when others =>
+            Report.Failed ("exception in Small Range Test");
+      end Small_Range_Test;
+
+
+      procedure Large_Range_Test is
+      -- Check over the range A to B where A is 1.0 and
+      -- B is a large value.
+         A : constant Real := 1.0;
+         B : Real;
+         X : Real;
+         Iteration : Integer := 0;
+         Subtest : Character := 'X';
+      begin
+         -- upper bound of range should be as large as possible where
+         -- B**3 is still valid.
+         B := Real'Safe_Last ** 0.333;
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 0..Max_Samples loop
+            Iteration := I;
+            Subtest := 'X';
+            X :=  Real'Machine((B - A) * (Real (I) / Real (Max_Samples)) + A);
+
+            Subtest := 'A';
+            Check (X ** 1.0, X,  -- exact result required
+                   "Large range" & Integer'Image (I) & ": " &
+                   Real'Image (X) & " ** 1.0",
+                   0.0);
+
+            Subtest := 'B';
+            Check ((X*X) ** 1.5, X**3,  X*X, 1.5,
+                   "Large range" & Integer'Image (I) & ": " &
+                   Real'Image (X*X) & " ** 1.5",
+                   1.25);   -- inexact expected result
+
+            Subtest := 'C';
+            Check ((X*X) ** 1.25, X**(2.5),  X*X, 1.25,
+                   "Large range" & Integer'Image (I) & ": " &
+                   Real'Image (X*X) & " ** 1.25",
+                   2.0);   -- two ** operators
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+
+         end loop;
+      exception
+         when Constraint_Error =>
+            Report.Failed
+               ("Constraint_Error raised in Large Range Test" &
+                Integer'Image (Iteration) & Subtest);
+         when others =>
+            Report.Failed ("exception in Large Range Test" &
+                Integer'Image (Iteration) & Subtest);
+      end Large_Range_Test;
+
+
+      procedure Exception_Test is
+         X1, X2, X3, X4 : Real;
+      begin
+         begin
+            X1 := 0.0 ** (-1.0);
+            Report.Failed ("exception not raised for 0**-1");
+         exception
+            when Ada.Numerics.Argument_Error =>
+               Report.Failed ("argument_error raised instead of" &
+                              " constraint_error for 0**-1");
+            when Constraint_Error => null;   -- ok
+            when others =>
+               Report.Failed ("wrong exception raised for 0**-1");
+         end;
+
+         begin
+            X2 := 0.0 ** 0.0;
+            Report.Failed ("exception not raised for 0**0");
+         exception
+            when Ada.Numerics.Argument_Error =>  null;  -- ok
+            when Constraint_Error =>
+               Report.Failed ("constraint_error raised instead of" &
+                              " argument_error for 0**0");
+            when others =>
+               Report.Failed ("wrong exception raised for 0**0");
+         end;
+
+         begin
+            X3 := (-1.0) ** 1.0;
+            Report.Failed ("exception not raised for -1**1");
+         exception
+            when Ada.Numerics.Argument_Error =>  null;  -- ok
+            when Constraint_Error =>
+               Report.Failed ("constraint_error raised instead of" &
+                              " argument_error for -1**1");
+            when others =>
+               Report.Failed ("wrong exception raised for -1**1");
+         end;
+
+         begin
+            X4 := (-2.0) ** 2.0;
+            Report.Failed ("exception not raised for -2**2");
+         exception
+            when Ada.Numerics.Argument_Error =>  null;  -- ok
+            when Constraint_Error =>
+               Report.Failed ("constraint_error raised instead of" &
+                              " argument_error for -2**2");
+            when others =>
+               Report.Failed ("wrong exception raised for -2**2");
+         end;
+
+         -- optimizer thwarting
+         if Report.Ident_Bool (False) then
+            Report.Comment (Real'Image (X1+X2+X3+X4));
+         end if;
+      end Exception_Test;
+
+
+      procedure Do_Test is
+      begin
+         Real_To_Integer_Test;
+         Special_Value_Test;
+         Small_Range_Test;
+         Large_Range_Test;
+         Exception_Test;
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   package Float_Check is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2012",
+                "Check the accuracy of the ** operator");
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" &
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2012;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2013.a
new file mode 100644
index 000000000..94f180b80
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2013.a
@@ -0,0 +1,367 @@
+-- CXG2013.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 TAN and COT functions return
+--      results that are within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is 
+--      instantiated to check both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Checks that use an identity for determining the result.
+--         Exception checks.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      11 Mar 96   SAIC    Initial release for 2.1
+--      17 Aug 96   SAIC    Commentary fixes.
+--      03 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
+--      02 DEC 97   EDS     Change Max_Samples constant to 1001.
+--      29 JUN 98   EDS     Deleted Special_Angle_Test as fatally flawed.
+
+--!
+
+--
+-- References:
+--
+-- Software Manual for the Elementary Functions
+-- William J. Cody, Jr. and William Waite
+-- Prentice-Hall, 1980
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition 
+--
+-- Implementation and Testing of Function Software
+-- W. J. Cody
+-- Problems and Methodologies in Mathematical Software Production
+-- editors P. C. Messina and A. Murli
+-- Lecture Notes in Computer Science   Volume 142
+-- Springer Verlag, 1982
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+procedure CXG2013 is
+   Verbose : constant Boolean := False;
+   Max_Samples : constant := 1001;
+
+   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+   Sqrt2 : constant := 
+        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+   Sqrt3 : constant :=
+        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
+   
+   Pi : constant := Ada.Numerics.Pi;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Elementary_Functions is new 
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Sqrt (X : Real) return Real renames
+           Elementary_Functions.Sqrt;
+      function Tan (X : Real) return Real renames
+           Elementary_Functions.Tan;
+      function Cot (X : Real) return Real renames
+           Elementary_Functions.Cot;
+      function Tan (X, Cycle : Real) return Real renames
+           Elementary_Functions.Tan;
+      function Cot (X, Cycle : Real) return Real renames
+           Elementary_Functions.Cot;
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+      -- factor to be applied in computing MRE
+      Maximum_Relative_Error : constant Real := 4.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+            if Actual = Expected then
+               Report.Comment (Test_Name & "  exact result");
+            else
+               Report.Comment (Test_Name & "  passed");
+            end if;
+         end if;
+      end Check;
+
+
+
+      procedure Exact_Result_Test is
+         No_Error : constant := 0.0;
+      begin
+         -- A.5.1(38);6.0
+         Check (Tan (0.0),  0.0, "tan(0)", No_Error);
+
+         -- A.5.1(41);6.0
+         Check (Tan (180.0, 360.0), 0.0, "tan(180,360)", No_Error);
+         Check (Tan (360.0, 360.0), 0.0, "tan(360,360)", No_Error);
+         Check (Tan (720.0, 360.0), 0.0, "tan(720,360)", No_Error);
+
+         -- A.5.1(41);6.0
+         Check (Cot ( 90.0, 360.0), 0.0, "cot( 90,360)", No_Error);
+         Check (Cot (270.0, 360.0), 0.0, "cot(270,360)", No_Error);
+         Check (Cot (810.0, 360.0), 0.0, "cot(810,360)", No_Error);
+
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in Exact_Result Test");
+         when others =>
+            Report.Failed ("exception in Exact_Result Test");
+      end Exact_Result_Test;
+
+
+      procedure Tan_Test (A, B : Real) is
+      -- Use identity Tan(X) = [2*Tan(x/2)]/[1-Tan(x/2) ** 2]
+      -- checks over the range -pi/4 .. pi/4 require no argument reduction
+      -- checks over the range 7pi/8 .. 9pi/8 require argument reduction
+         X, Y : Real;
+         Actual1, Actual2 : Real;
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            -- argument purification to insure x and x/2 are exact
+            -- See Cody page 170.
+            Y := Real'Machine (X*0.5);
+            X := Real'Machine (Y + Y);
+           
+            Actual1 := Tan(X);
+            Actual2 := (2.0 * Tan (Y)) / (1.0 - Tan (Y) ** 2);
+ 
+            if abs (X - Pi) > ( (B-A)/Real(2*Max_Samples) ) then
+              Check (Actual1, Actual2,
+                     "Tan_Test " & Integer'Image (I) & ": tan(" &
+                     Real'Image (X) & ") ",
+                     (1.0 + Sqrt2) * Maximum_Relative_Error);
+                     -- see Cody pg 165 for error bound info
+            end if;
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+
+         end loop;
+
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Tan_Test");
+         when others =>
+            Report.Failed ("exception in Tan_Test");
+      end Tan_Test;
+
+
+
+      procedure Cot_Test is
+      -- Use identity Cot(X) = [Cot(X/2)**2 - 1]/[2*Cot(X/2)]
+         A : constant := 6.0 * Pi;
+         B : constant := 25.0 / 4.0 * Pi;
+         X, Y : Real;
+         Actual1, Actual2 : Real;
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            -- argument purification to insure x and x/2 are exact.
+            -- See Cody page 170.
+            Y := Real'Machine (X*0.5);
+            X := Real'Machine (Y + Y);
+           
+            Actual1 := Cot(X);
+            Actual2 := (Cot (Y) ** 2 - 1.0) / (2.0 * Cot (Y));
+ 
+            Check (Actual1, Actual2,
+                   "Cot_Test " & Integer'Image (I) & ": cot(" &
+                   Real'Image (X) & ") ",
+                   (1.0 + Sqrt2) * Maximum_Relative_Error);
+                   -- see Cody pg 165 for error bound info
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+
+         end loop;
+
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Cot_Test");
+         when others =>
+            Report.Failed ("exception in Cot_Test");
+      end Cot_Test;
+
+
+      procedure Exception_Test is
+         X1, X2, X3, X4, X5 : Real := 0.0;
+      begin
+
+
+         begin  -- A.5.1(20);6.0
+           X1 := Tan (0.0, Cycle => 0.0);
+           Report.Failed ("no exception for cycle = 0.0");
+         exception
+            when Ada.Numerics.Argument_Error => null;
+            when others =>
+               Report.Failed ("wrong exception for cycle = 0.0");
+         end;
+
+         begin  -- A.5.1(20);6.0
+           X2 := Cot (1.0, Cycle => -3.0);
+           Report.Failed ("no exception for cycle < 0.0");
+         exception
+            when Ada.Numerics.Argument_Error => null;
+            when others =>
+               Report.Failed ("wrong exception for cycle < 0.0");
+         end;
+
+         -- the remaining tests only apply to machines that overflow
+         if Real'Machine_Overflows then    -- A.5.1(28);6.0
+
+            begin   -- A.5.1(29);6.0
+               X3 := Cot (0.0);
+               Report.Failed ("exception not raised for cot(0)");
+            exception
+               when Constraint_Error => null;   -- ok
+               when others =>
+                  Report.Failed ("wrong exception raised for cot(0)");
+            end;
+   
+            begin   -- A.5.1(31);6.0
+               X4 := Tan (90.0, 360.0);
+               Report.Failed ("exception not raised for tan(90,360)");
+            exception
+               when Constraint_Error => null;  -- ok
+               when others =>
+                  Report.Failed ("wrong exception raised for tan(90,360)");
+            end;
+
+            begin   -- A.5.1(32);6.0
+               X5 := Cot (180.0, 360.0);
+               Report.Failed ("exception not raised for cot(180,360)");
+            exception
+               when Constraint_Error => null;  -- ok
+               when others =>
+                  Report.Failed ("wrong exception raised for cot(180,360)");
+            end;
+         end if;
+
+         -- optimizer thwarting
+         if Report.Ident_Bool (False) then
+            Report.Comment (Real'Image (X1+X2+X3+X4+X5));
+         end if;
+      end Exception_Test;
+
+
+      procedure Do_Test is
+      begin
+         Exact_Result_Test;
+         Tan_Test (-Pi/4.0, Pi/4.0);
+         Tan_Test (7.0*Pi/8.0, 9.0*Pi/8.0);
+         Cot_Test;
+         Exception_Test;
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   package Float_Check is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2013",
+                "Check the accuracy of the TAN and COT functions"); 
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2013;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2014.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2014.a
new file mode 100644
index 000000000..48499a255
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2014.a
@@ -0,0 +1,399 @@
+-- CXG2014.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 SINH and COSH functions return
+--      results that are within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is 
+--      instantiated to check both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Checks that use an identity for determining the result.
+--         Exception checks.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      15 Mar 96   SAIC    Initial release for 2.1
+--      03 Jun 98   EDS     In line 80, change 1000 to 1024, making it a model
+--                          number.  Add Taylor Series terms in line 281.
+--      15 Feb 99   RLB     Repaired Subtraction_Error_Test to avoid precision
+--                          problems.
+--!
+
+--
+-- References:
+--
+-- Software Manual for the Elementary Functions
+-- William J. Cody, Jr. and William Waite
+-- Prentice-Hall, 1980
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition 
+--
+-- Implementation and Testing of Function Software
+-- W. J. Cody
+-- Problems and Methodologies in Mathematical Software Production
+-- editors P. C. Messina and A. Murli
+-- Lecture Notes in Computer Science   Volume 142
+-- Springer Verlag, 1982
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+procedure CXG2014 is
+   Verbose : constant Boolean := False;
+   Max_Samples : constant := 1024;
+
+   E  : constant := Ada.Numerics.E;
+   Cosh1 : constant := (E + 1.0 / E) / 2.0;    -- cosh(1.0) 
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Elementary_Functions is new 
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+      function Sinh (X : Real) return Real renames
+           Elementary_Functions.Sinh;
+      function Cosh (X : Real) return Real renames
+           Elementary_Functions.Cosh;
+      function Log (X : Real) return Real renames
+           Elementary_Functions.Log;
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Small instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Small;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Special_Value_Test is
+         -- In the following tests the expected result is accurate
+         -- to the machine precision so the minimum guaranteed error
+         -- bound can be used.
+         Minimum_Error : constant := 8.0;
+      begin
+         Check (Sinh (1.0),
+                (E - 1.0 / E) / 2.0,  
+                "sinh(1)",
+                Minimum_Error);
+         Check (Cosh (1.0),
+                Cosh1,
+                "cosh(1)",
+                Minimum_Error);
+         Check (Sinh (2.0),
+                (E * E - (1.0 / (E * E))) / 2.0,
+                "sinh(2)",
+                Minimum_Error);
+         Check (Cosh (2.0),
+                (E * E + (1.0 / (E * E))) / 2.0,
+                "cosh(2)",
+                Minimum_Error);
+         Check (Sinh (-1.0),
+                (1.0 / E - E) / 2.0,  
+                "sinh(-1)",
+                Minimum_Error);
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in special value test");
+         when others =>
+            Report.Failed ("exception in special value test");
+      end Special_Value_Test;
+
+
+
+      procedure Exact_Result_Test is
+         No_Error : constant := 0.0;
+      begin
+         -- A.5.1(38);6.0
+         Check (Sinh (0.0),  0.0, "sinh(0)", No_Error);
+         Check (Cosh (0.0),  1.0, "cosh(0)", No_Error);
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in Exact_Result Test");
+         when others =>
+            Report.Failed ("exception in Exact_Result Test");
+      end Exact_Result_Test;
+
+
+      procedure Identity_1_Test is
+      -- For the Sinh test use the identity
+      --    2 * Sinh(x) * Cosh(1) = Sinh(x+1) + Sinh (x-1)
+      -- which is transformed to
+      --    Sinh(x) = ((Sinh(x+1) + Sinh(x-1)) * C
+      -- where C = 1/(2*Cosh(1))
+      --
+      -- For the Cosh test use the identity
+      --    2 * Cosh(x) * Cosh(1) = Cosh(x+1) + Cosh(x-1)
+      -- which is transformed to
+      --    Cosh(x) = C * (Cosh(x+1) + Cosh(x-1))
+      -- where C is the same as above
+      --
+      -- see Cody pg 230-231 for details on the error analysis.
+      -- The net result is a relative error bound of 16 * Model_Epsilon.
+
+         A : constant := 3.0;
+            -- large upper bound but not so large as to cause Cosh(B)
+            -- to overflow
+         B : constant Real := Log(Real'Safe_Last) - 2.0;
+         X_Minus_1, X, X_Plus_1 : Real; 
+         Actual1, Actual2 : Real;
+         C : constant := 1.0 / (2.0 * Cosh1);
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            -- make sure there is no error in x-1, x, and x+1
+            X_Plus_1 :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            X_Plus_1  := Real'Machine (X_Plus_1);
+            X         := Real'Machine (X_Plus_1 - 1.0);
+            X_Minus_1 := Real'Machine (X - 1.0);
+           
+            -- Sinh(x) = ((Sinh(x+1) + Sinh(x-1)) * C
+            Actual1 := Sinh(X);
+            Actual2 := C * (Sinh(X_Plus_1) + Sinh(X_Minus_1));
+ 
+            Check (Actual1, Actual2,
+                   "Identity_1_Test " & Integer'Image (I) & ": sinh(" &
+		   Real'Image (X) & ") ",
+                   16.0);
+
+            -- Cosh(x) = C * (Cosh(x+1) + Cosh(x-1))
+            Actual1 := Cosh (X);
+            Actual2 := C * (Cosh(X_Plus_1) + Cosh (X_Minus_1));
+            Check (Actual1, Actual2,
+                   "Identity_1_Test " & Integer'Image (I) & ": cosh(" &
+		   Real'Image (X) & ") ",
+                   16.0);
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+
+         end loop;
+
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Identity_1_Test" &
+                " for X=" & Real'Image (X));
+         when others =>
+            Report.Failed ("exception in Identity_1_Test" &
+                " for X=" & Real'Image (X));
+      end Identity_1_Test;
+
+
+
+      procedure Subtraction_Error_Test is
+      -- This test detects the error resulting from subtraction if
+      -- the obvious algorithm was used for computing sinh.  That is,
+      -- it it is computed as (e**x - e**-x)/2.
+      -- We check the result by using a Taylor series expansion that
+      -- will produce a result accurate to the machine precision for
+      -- the range under test.
+      --
+      -- The maximum relative error bound for this test is 
+      --  8 for the sinh operation and 7 for the Taylor series
+      -- for a total of 15 * Model_Epsilon
+         A : constant := 0.0;
+         B : constant := 0.5;
+         X : Real;
+         X_Squared : Real;
+         Actual, Expected : Real;
+      begin
+         if Real'digits > 15 then
+             return; -- The approximation below is not accurate beyond
+                     -- 15 digits. Adding more terms makes the error
+                     -- larger, so it makes the test worse for more normal
+                     -- values. Thus, we skip this subtest for larger than
+                     -- 15 digits.
+         end if;
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            X_Squared := X * X;
+           
+            Actual := Sinh(X);
+
+            -- The Taylor series regrouped a bit
+            Expected := 
+               X * (1.0 + (X_Squared / 6.0) *
+                          (1.0 + (X_Squared/20.0) *
+                                 (1.0 + (X_Squared/42.0) *
+                                        (1.0 + (X_Squared/72.0) *
+                                               (1.0 + (X_Squared/110.0) *
+                                                      (1.0 + (X_Squared/156.0)
+                   ))))));
+ 
+            Check (Actual, Expected,
+                   "Subtraction_Error_Test " & Integer'Image (I) & ": sinh(" &
+		   Real'Image (X) & ") ",
+                   15.0);
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+
+         end loop;
+
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Subtraction_Error_Test");
+         when others =>
+            Report.Failed ("exception in Subtraction_Error_Test");
+      end Subtraction_Error_Test;
+
+
+      procedure Exception_Test is
+         X1, X2 : Real := 0.0;
+      begin
+         -- this part of the test is only applicable if 'Machine_Overflows
+         -- is true.
+         if Real'Machine_Overflows then
+
+	    begin
+	      X1 := Sinh (Real'Safe_Last / 2.0);
+	      Report.Failed ("no exception for sinh overflow");
+	    exception
+	       when Constraint_Error => null;
+	       when others =>
+	          Report.Failed ("wrong exception sinh overflow");
+	    end;
+
+	    begin
+	      X2 := Cosh (Real'Safe_Last / 2.0);
+	      Report.Failed ("no exception for cosh overflow");
+	    exception
+	       when Constraint_Error => null;
+	       when others =>
+	          Report.Failed ("wrong exception cosh overflow");
+	    end;
+
+         end if;
+
+         -- optimizer thwarting
+         if Report.Ident_Bool (False) then
+            Report.Comment (Real'Image (X1 + X2));
+         end if;
+      end Exception_Test;
+
+
+      procedure Do_Test is
+      begin
+         Special_Value_Test;
+         Exact_Result_Test;
+         Identity_1_Test;
+         Subtraction_Error_Test;
+         Exception_Test;
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   package Float_Check is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2014",
+                "Check the accuracy of the SINH and COSH functions"); 
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2014;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2015.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2015.a
new file mode 100644
index 000000000..50fda5e1f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2015.a
@@ -0,0 +1,686 @@
+-- CXG2015.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 ARCSIN and ARCCOS functions return
+--      results that are within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is
+--      instantiated to check both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Checks in a specific range where a Taylor series can be
+--         used to compute an accurate result for comparison.
+--         Exception checks.
+--      The Taylor series tests are a direct translation of the
+--      FORTRAN code found in the reference.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      18 Mar 96   SAIC    Initial release for 2.1
+--      24 Apr 96   SAIC    Fixed error bounds.
+--      17 Aug 96   SAIC    Added reference information and improved
+--                          checking for machines with more than 23
+--                          digits of precision.
+--      03 Feb 97   PWB.CTA Removed checks with explicit Cycle => 2.0*Pi
+--      22 Dec 99   RLB     Added model range checking to "exact" results,
+--                          in order to avoid too strictly requiring a specific
+--                          result, and too weakly checking results.
+--
+-- CHANGE NOTE:
+--      According to Ken Dritz, author of the Numerics Annex of the RM,
+--      one should never specify the cycle 2.0*Pi for the trigonometric
+--      functions.  In particular, if the machine number for the first
+--      argument is not an exact multiple of the machine number for the
+--      explicit cycle, then the specified exact results cannot be
+--      reasonably expected.  The affected checks in this test have been
+--      marked as comments, with the additional notation "pwb-math".
+--      Phil Brashear
+--!
+
+--
+-- References:
+--
+-- Software Manual for the Elementary Functions
+-- William J. Cody, Jr. and William Waite
+-- Prentice-Hall, 1980
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition
+--
+-- Implementation and Testing of Function Software
+-- W. J. Cody
+-- Problems and Methodologies in Mathematical Software Production
+-- editors P. C. Messina and A. Murli
+-- Lecture Notes in Computer Science   Volume 142
+-- Springer Verlag, 1982
+--
+-- CELEFUNT: A Portable Test Package for Complex Elementary Functions
+-- ACM Collected Algorithms number 714
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+procedure CXG2015 is
+   Verbose : constant Boolean := False;
+   Max_Samples : constant := 1000;
+
+
+   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+   Sqrt2 : constant :=
+        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+   Sqrt3 : constant :=
+        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
+
+   Pi : constant := Ada.Numerics.Pi;
+
+   -- relative error bound from G.2.4(7);6.0
+   Minimum_Error : constant := 4.0;
+
+   generic
+      type Real is digits <>;
+      Half_PI_Low : in Real; -- The machine number closest to, but not greater
+                             -- than PI/2.0.
+      Half_PI_High : in Real;-- The machine number closest to, but not less
+                             -- than PI/2.0.
+      PI_Low : in Real;      -- The machine number closest to, but not greater
+                             -- than PI.
+      PI_High : in Real;     -- The machine number closest to, but not less
+                             -- than PI.
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Elementary_Functions is new
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+
+      function Arcsin (X : Real) return Real renames
+           Elementary_Functions.Arcsin;
+      function Arcsin (X, Cycle : Real) return Real renames
+           Elementary_Functions.Arcsin;
+      function Arccos (X : Real) return Real renames
+           Elementary_Functions.ArcCos;
+      function Arccos (X, Cycle : Real) return Real renames
+           Elementary_Functions.ArcCos;
+
+      -- needed for support
+      function Log (X, Base : Real) return Real renames
+           Elementary_Functions.Log;
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+      -- The following value is a lower bound on the accuracy
+      -- required.  It is normally 0.0 so that the lower bound
+      -- is computed from Model_Epsilon.  However, for tests
+      -- where the expected result is only known to a certain
+      -- amount of precision this bound takes on a non-zero
+      -- value to account for that level of precision.
+      Error_Low_Bound : Real := 0.0;
+
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if;
+
+         -- take into account the low bound on the error
+         if Max_Error < Error_Low_Bound then
+            Max_Error := Error_Low_Bound;
+         end if;
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name &
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Special_Value_Test is
+         -- In the following tests the expected result is accurate
+         -- to the machine precision so the minimum guaranteed error
+         -- bound can be used.
+
+         type Data_Point is
+            record
+               Degrees,
+               Radians,
+               Argument,
+               Error_Bound : Real;
+            end record;
+
+         type Test_Data_Type is array (Positive range <>) of Data_Point;
+
+         -- the values in the following tables only involve static
+         -- expressions so no loss of precision occurs.  However,
+         -- rounding can be an issue with expressions involving Pi
+         -- and square roots.  The error bound specified in the
+         -- table takes the sqrt error into account but not the
+         -- error due to Pi.  The Pi error is added in in the
+         -- radians test below.
+
+         Arcsin_Test_Data : constant Test_Data_Type := (
+         --  degrees      radians          sine  error_bound   test #
+          --(  0.0,           0.0,          0.0,     0.0 ),    -- 1 - In Exact_Result_Test.
+            ( 30.0,        Pi/6.0,          0.5,     4.0 ),    -- 2
+            ( 60.0,        Pi/3.0,    Sqrt3/2.0,     5.0 ),    -- 3
+          --( 90.0,        Pi/2.0,          1.0,     4.0 ),    -- 4 - In Exact_Result_Test.
+          --(-90.0,       -Pi/2.0,         -1.0,     4.0 ),    -- 5 - In Exact_Result_Test.
+            (-60.0,       -Pi/3.0,   -Sqrt3/2.0,     5.0 ),    -- 6
+            (-30.0,       -Pi/6.0,         -0.5,     4.0 ),    -- 7
+            ( 45.0,        Pi/4.0,    Sqrt2/2.0,     5.0 ),    -- 8
+            (-45.0,       -Pi/4.0,   -Sqrt2/2.0,     5.0 ) );  -- 9
+
+         Arccos_Test_Data : constant Test_Data_Type := (
+         --  degrees      radians       cosine   error_bound   test #
+          --(  0.0,           0.0,         1.0,      0.0 ),    -- 1 - In Exact_Result_Test.
+            ( 30.0,        Pi/6.0,   Sqrt3/2.0,      5.0 ),    -- 2
+            ( 60.0,        Pi/3.0,         0.5,      4.0 ),    -- 3
+          --( 90.0,        Pi/2.0,         0.0,      4.0 ),    -- 4 - In Exact_Result_Test.
+            (120.0,    2.0*Pi/3.0,        -0.5,      4.0 ),    -- 5
+            (150.0,    5.0*Pi/6.0,  -Sqrt3/2.0,      5.0 ),    -- 6
+          --(180.0,            Pi,        -1.0,      4.0 ),    -- 7 - In Exact_Result_Test.
+            ( 45.0,        Pi/4.0,   Sqrt2/2.0,      5.0 ),    -- 8
+            (135.0,    3.0*Pi/4.0,  -Sqrt2/2.0,      5.0 ) );  -- 9
+
+         Cycle_Error,
+         Radian_Error : Real;
+      begin
+         for I in Arcsin_Test_Data'Range loop
+
+            -- note exact result requirements  A.5.1(38);6.0 and
+            -- G.2.4(12);6.0
+            if Arcsin_Test_Data (I).Error_Bound = 0.0 then
+               Cycle_Error := 0.0;
+               Radian_Error := 0.0;
+            else
+               Cycle_Error := Arcsin_Test_Data (I).Error_Bound;
+               -- allow for rounding error in the specification of Pi
+               Radian_Error := Cycle_Error + 1.0;
+            end if;
+
+            Check (Arcsin (Arcsin_Test_Data (I).Argument),
+                   Arcsin_Test_Data (I).Radians,
+                   "test" & Integer'Image (I) &
+                   " arcsin(" &
+                   Real'Image (Arcsin_Test_Data (I).Argument) &
+                   ")",
+                   Radian_Error);
+--pwb-math            Check (Arcsin (Arcsin_Test_Data (I).Argument, 2.0 * Pi),
+--pwb-math                   Arcsin_Test_Data (I).Radians,
+--pwb-math                   "test" & Integer'Image (I) &
+--pwb-math                   " arcsin(" &
+--pwb-math                   Real'Image (Arcsin_Test_Data (I).Argument) &
+--pwb-math                   ", 2pi)",
+--pwb-math                   Cycle_Error);
+            Check (Arcsin (Arcsin_Test_Data (I).Argument, 360.0),
+                   Arcsin_Test_Data (I).Degrees,
+                   "test" & Integer'Image (I) &
+                   " arcsin(" &
+                   Real'Image (Arcsin_Test_Data (I).Argument) &
+                   ", 360)",
+                   Cycle_Error);
+         end loop;
+
+
+         for I in Arccos_Test_Data'Range loop
+
+            -- note exact result requirements  A.5.1(39);6.0 and
+            -- G.2.4(12);6.0
+            if Arccos_Test_Data (I).Error_Bound = 0.0 then
+               Cycle_Error := 0.0;
+               Radian_Error := 0.0;
+            else
+               Cycle_Error := Arccos_Test_Data (I).Error_Bound;
+               -- allow for rounding error in the specification of Pi
+               Radian_Error := Cycle_Error + 1.0;
+            end if;
+
+            Check (Arccos (Arccos_Test_Data (I).Argument),
+                   Arccos_Test_Data (I).Radians,
+                   "test" & Integer'Image (I) &
+                   " arccos(" &
+                   Real'Image (Arccos_Test_Data (I).Argument) &
+                   ")",
+                   Radian_Error);
+--pwb-math            Check (Arccos (Arccos_Test_Data (I).Argument, 2.0 * Pi),
+--pwb-math                   Arccos_Test_Data (I).Radians,
+--pwb-math                   "test" & Integer'Image (I) &
+--pwb-math                   " arccos(" &
+--pwb-math                   Real'Image (Arccos_Test_Data (I).Argument) &
+--pwb-math                   ", 2pi)",
+--pwb-math                   Cycle_Error);
+            Check (Arccos (Arccos_Test_Data (I).Argument, 360.0),
+                   Arccos_Test_Data (I).Degrees,
+                   "test" & Integer'Image (I) &
+                   " arccos(" &
+                   Real'Image (Arccos_Test_Data (I).Argument) &
+                   ", 360)",
+                   Cycle_Error);
+         end loop;
+
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised in special value test");
+         when others =>
+            Report.Failed ("exception in special value test");
+      end Special_Value_Test;
+
+
+      procedure Check_Exact (Actual, Expected_Low, Expected_High : Real;
+	                     Test_Name : String) is
+         -- If the expected result is not a model number, then Expected_Low is
+         -- the first machine number less than the (exact) expected
+         -- result, and Expected_High is the first machine number greater than
+         -- the (exact) expected result. If the expected result is a model
+         -- number, Expected_Low = Expected_High = the result.
+         Model_Expected_Low  : Real := Expected_Low;
+         Model_Expected_High : Real := Expected_High;
+      begin
+         -- Calculate the first model number nearest to, but below (or equal)
+         -- to the expected result:
+         while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop
+            -- Try the next machine number lower:
+            Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0);
+         end loop;
+         -- Calculate the first model number nearest to, but above (or equal)
+         -- to the expected result:
+         while Real'Model (Model_Expected_High) /= Model_Expected_High loop
+            -- Try the next machine number higher:
+            Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0);
+         end loop;
+
+         if Actual < Model_Expected_Low or Actual > Model_Expected_High then
+            Accuracy_Error_Reported := True;
+            if Actual < Model_Expected_Low then
+               Report.Failed (Test_Name &
+                              " actual: " & Real'Image (Actual) &
+                              " expected low: " & Real'Image (Model_Expected_Low) &
+                              " expected high: " & Real'Image (Model_Expected_High) &
+                              " difference: " & Real'Image (Actual - Expected_Low));
+            else
+               Report.Failed (Test_Name &
+                              " actual: " & Real'Image (Actual) &
+                              " expected low: " & Real'Image (Model_Expected_Low) &
+                              " expected high: " & Real'Image (Model_Expected_High) &
+                              " difference: " & Real'Image (Expected_High - Actual));
+            end if;
+         elsif Verbose then
+            Report.Comment (Test_Name & "  passed");
+         end if;
+      end Check_Exact;
+
+
+      procedure Exact_Result_Test is
+      begin
+         --  A.5.1(38)
+         Check_Exact (Arcsin (0.0),       0.0, 0.0, "arcsin(0)");
+         Check_Exact (Arcsin (0.0, 45.0), 0.0, 0.0, "arcsin(0,45)");
+
+         --  A.5.1(39)
+         Check_Exact (Arccos (1.0),       0.0, 0.0, "arccos(1)");
+         Check_Exact (Arccos (1.0, 75.0), 0.0, 0.0, "arccos(1,75)");
+
+         --  G.2.4(11-13)
+         Check_Exact (Arcsin (1.0), Half_PI_Low, Half_PI_High, "arcsin(1)");
+         Check_Exact (Arcsin (1.0, 360.0), 90.0, 90.0, "arcsin(1,360)");
+
+         Check_Exact (Arcsin (-1.0), -Half_PI_High, -Half_PI_Low, "arcsin(-1)");
+         Check_Exact (Arcsin (-1.0, 360.0), -90.0, -90.0, "arcsin(-1,360)");
+
+         Check_Exact (Arccos (0.0), Half_PI_Low, Half_PI_High, "arccos(0)");
+         Check_Exact (Arccos (0.0, 360.0), 90.0, 90.0, "arccos(0,360)");
+
+         Check_Exact (Arccos (-1.0), PI_Low, PI_High, "arccos(-1)");
+         Check_Exact (Arccos (-1.0, 360.0), 180.0, 180.0, "arccos(-1,360)");
+
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised in Exact_Result Test");
+         when others =>
+            Report.Failed ("Exception in Exact_Result Test");
+      end Exact_Result_Test;
+
+
+      procedure Arcsin_Taylor_Series_Test is
+         -- the following range is chosen so that the Taylor series
+         -- used will produce a result accurate to machine precision.
+         --
+         -- The following formula is used for the Taylor series:
+         --  TS(x) =  x { 1 + (xsq/2) [ (1/3) + (3/4)xsq { (1/5) +
+         --                (5/6)xsq [ (1/7) + (7/8)xsq/9 ] } ] }
+         --   where xsq = x * x
+         --
+         A : constant := -0.125;
+         B : constant :=  0.125;
+         X : Real;
+         Y, Y_Sq : Real;
+         Actual, Sum, Xm : Real;
+         -- terms in Taylor series
+         K : constant Integer := Integer (
+                Log (
+                  Real (Real'Machine_Radix) ** Real'Machine_Mantissa,
+                  10.0)) + 1;
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            -- make sure there is no error in x-1, x, and x+1
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+
+            Y := X;
+            Y_Sq := Y * Y;
+            Sum := 0.0;
+            Xm := Real (K + K + 1);
+            for M in 1 .. K loop
+               Sum := Y_Sq * (Sum + 1.0/Xm);
+               Xm := Xm - 2.0;
+               Sum := Sum * (Xm /(Xm + 1.0));
+            end loop;
+            Sum := Sum * Y;
+            Actual := Y + Sum;
+            Sum := (Y - Actual) + Sum;
+            if not Real'Machine_Rounds then
+               Actual := Actual + (Sum + Sum);
+            end if;
+
+            Check (Actual, Arcsin (X),
+                   "Taylor Series test" & Integer'Image (I) & ": arcsin(" &
+		   Real'Image (X) & ") ",
+                   Minimum_Error);
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+
+         end loop;
+
+      exception
+         when Constraint_Error =>
+            Report.Failed
+               ("Constraint_Error raised in Arcsin_Taylor_Series_Test" &
+                " for X=" & Real'Image (X));
+         when others =>
+            Report.Failed ("exception in Arcsin_Taylor_Series_Test" &
+                " for X=" & Real'Image (X));
+      end Arcsin_Taylor_Series_Test;
+
+
+
+      procedure Arccos_Taylor_Series_Test is
+         -- the following range is chosen so that the Taylor series
+         -- used will produce a result accurate to machine precision.
+         --
+         -- The following formula is used for the Taylor series:
+         --  TS(x) =  x { 1 + (xsq/2) [ (1/3) + (3/4)xsq { (1/5) +
+         --                (5/6)xsq [ (1/7) + (7/8)xsq/9 ] } ] }
+         --  arccos(x) = pi/2 - TS(x)
+         A : constant := -0.125;
+         B : constant :=  0.125;
+         C1, C2 : Real;
+         X : Real;
+         Y, Y_Sq : Real;
+         Actual, Sum, Xm, S : Real;
+         -- terms in Taylor series
+         K : constant Integer := Integer (
+                Log (
+                  Real (Real'Machine_Radix) ** Real'Machine_Mantissa,
+                  10.0)) + 1;
+      begin
+         if Real'Digits > 23 then
+            -- constants in this section only accurate to 23 digits
+            Error_Low_Bound := 0.00000_00000_00000_00000_001;
+            Report.Comment ("arctan accuracy checked to 23 digits");
+         end if;
+
+         -- C1 + C2 equals Pi/2 accurate to 23 digits
+         if Real'Machine_Radix = 10 then
+            C1 := 1.57;
+            C2 := 7.9632679489661923132E-4;
+         else
+            C1 := 201.0 / 128.0;
+            C2 := 4.8382679489661923132E-4;
+         end if;
+
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            -- make sure there is no error in x-1, x, and x+1
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+
+            Y := X;
+            Y_Sq := Y * Y;
+            Sum := 0.0;
+            Xm := Real (K + K + 1);
+            for M in 1 .. K loop
+               Sum := Y_Sq * (Sum + 1.0/Xm);
+               Xm := Xm - 2.0;
+               Sum := Sum * (Xm /(Xm + 1.0));
+            end loop;
+            Sum := Sum * Y;
+
+            -- at this point we have arcsin(x).
+            -- We compute arccos(x) = pi/2 - arcsin(x).
+            -- The following code segment is translated directly from
+            -- the CELEFUNT FORTRAN implementation
+
+            S := C1 + C2;
+            Sum := ((C1 - S) + C2) - Sum;
+            Actual := S + Sum;
+            Sum := ((S - Actual) + Sum) - Y;
+            S := Actual;
+            Actual := S + Sum;
+            Sum := (S - Actual) + Sum;
+
+            if not Real'Machine_Rounds then
+               Actual := Actual + (Sum + Sum);
+            end if;
+
+            Check (Actual, Arccos (X),
+                   "Taylor Series test" & Integer'Image (I) & ": arccos(" &
+		   Real'Image (X) & ") ",
+                   Minimum_Error);
+
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+            exit when Accuracy_Error_Reported;
+         end loop;
+         Error_Low_Bound := 0.0;  -- reset
+      exception
+         when Constraint_Error =>
+            Report.Failed
+               ("Constraint_Error raised in Arccos_Taylor_Series_Test" &
+                " for X=" & Real'Image (X));
+         when others =>
+            Report.Failed ("exception in Arccos_Taylor_Series_Test" &
+                " for X=" & Real'Image (X));
+      end Arccos_Taylor_Series_Test;
+
+
+
+      procedure Identity_Test is
+         -- test the identity arcsin(-x) = -arcsin(x)
+         -- range chosen to be most of the valid range of the argument.
+         A : constant := -0.999;
+         B : constant :=  0.999;
+         X : Real;
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            -- make sure there is no error in x-1, x, and x+1
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+
+            Check (Arcsin(-X), -Arcsin (X),
+                   "Identity test" & Integer'Image (I) & ": arcsin(" &
+		   Real'Image (X) & ") ",
+                   8.0);   -- 2 arcsin evaluations => twice the error bound
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+         end loop;
+      end Identity_Test;
+
+
+      procedure Exception_Test is
+         X1, X2 : Real := 0.0;
+      begin
+	    begin
+	      X1 := Arcsin (1.1);
+	      Report.Failed ("no exception for Arcsin (1.1)");
+	    exception
+	       when Constraint_Error =>
+	          Report.Failed ("Constraint_Error instead of " &
+                     "Argument_Error for Arcsin (1.1)");
+               when Ada.Numerics.Argument_Error =>
+                  null;    -- expected result
+	       when others =>
+	          Report.Failed ("wrong exception for Arcsin(1.1)");
+	    end;
+
+	    begin
+	      X2 := Arccos (-1.1);
+	      Report.Failed ("no exception for Arccos (-1.1)");
+	    exception
+	       when Constraint_Error =>
+	          Report.Failed ("Constraint_Error instead of " &
+                     "Argument_Error for Arccos (-1.1)");
+               when Ada.Numerics.Argument_Error =>
+                  null;    -- expected result
+	       when others =>
+	          Report.Failed ("wrong exception for Arccos(-1.1)");
+	    end;
+
+
+         -- optimizer thwarting
+         if Report.Ident_Bool (False) then
+            Report.Comment (Real'Image (X1 + X2));
+         end if;
+      end Exception_Test;
+
+
+      procedure Do_Test is
+      begin
+         Special_Value_Test;
+         Exact_Result_Test;
+         Arcsin_Taylor_Series_Test;
+         Arccos_Taylor_Series_Test;
+         Identity_Test;
+         Exception_Test;
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   -- These expressions must be truly static, which is why we have to do them
+   -- outside of the generic, and we use the named numbers. Note that we know
+   -- that PI is not a machine number (it is irrational), and it should be
+   -- represented to more digits than supported by the target machine.
+   Float_Half_PI_Low  : constant := Float'Adjacent(PI/2.0,  0.0);
+   Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0);
+   Float_PI_Low       : constant := Float'Adjacent(PI,      0.0);
+   Float_PI_High      : constant := Float'Adjacent(PI,     10.0);
+   package Float_Check is new Generic_Check (Float,
+	Half_PI_Low  => Float_Half_PI_Low,
+	Half_PI_High => Float_Half_PI_High,
+	PI_Low  => Float_PI_Low,
+	PI_High => Float_PI_High);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   A_Long_Float_Half_PI_Low  : constant := A_Long_Float'Adjacent(PI/2.0,  0.0);
+   A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0);
+   A_Long_Float_PI_Low       : constant := A_Long_Float'Adjacent(PI,      0.0);
+   A_Long_Float_PI_High      : constant := A_Long_Float'Adjacent(PI,     10.0);
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float,
+	Half_PI_Low  => A_Long_Float_Half_PI_Low,
+	Half_PI_High => A_Long_Float_Half_PI_High,
+	PI_Low  => A_Long_Float_PI_Low,
+	PI_High => A_Long_Float_PI_High);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2015",
+                "Check the accuracy of the ARCSIN and ARCCOS functions");
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" &
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2015;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a
new file mode 100644
index 000000000..832b11822
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2016.a
@@ -0,0 +1,482 @@
+-- CXG2016.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 ARCTAN function returns a
+--      result that is within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is
+--      instantiated to check both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Exception checks.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      19 Mar 96   SAIC    Initial release for 2.1
+--      30 APR 96   SAIC    Fixed optimization issue
+--      17 AUG 96   SAIC    Incorporated Reviewer's suggestions.
+--      12 OCT 96   SAIC    Incorporated Reviewer's suggestions.
+--      02 DEC 97   EDS     Remove procedure Identity_1_Test and calls to
+--                          procedure.
+--      29 JUN 98   EDS     Replace -0.0 with call to ImpDef.Annex_G.Negative_Zero
+--      28 APR 99   RLB     Replaced comma accidentally deleted in above change.
+--      15 DEC 99   RLB     Added model range checking to "exact" results,
+--                          in order to avoid too strictly requiring a specific
+--                          result.
+--!
+
+--
+-- References:
+--
+-- Software Manual for the Elementary Functions
+-- William J. Cody, Jr. and William Waite
+-- Prentice-Hall, 1980
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition
+--
+-- Implementation and Testing of Function Software
+-- W. J. Cody
+-- Problems and Methodologies in Mathematical Software Production
+-- editors P. C. Messina and A. Murli
+-- Lecture Notes in Computer Science   Volume 142
+-- Springer Verlag, 1982
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+with Impdef.Annex_G;
+procedure CXG2016 is
+   Verbose : constant Boolean := False;
+   Max_Samples : constant := 1000;
+
+   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+   Sqrt2 : constant :=
+        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+   Sqrt3 : constant :=
+        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
+
+   Pi : constant := Ada.Numerics.Pi;
+
+   generic
+      type Real is digits <>;
+      Half_PI_Low : in Real; -- The machine number closest to, but not greater
+                             -- than PI/2.0.
+      Half_PI_High : in Real;-- The machine number closest to, but not less
+                             -- than PI/2.0.
+      PI_Low : in Real;      -- The machine number closest to, but not greater
+                             -- than PI.
+      PI_High : in Real;     -- The machine number closest to, but not less
+                             -- than PI.
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Elementary_Functions is new
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+
+      function Arctan (Y : Real;
+                       X : Real := 1.0) return Real renames
+           Elementary_Functions.Arctan;
+      function Arctan (Y : Real;
+                       X : Real := 1.0;
+                       Cycle : Real) return Real renames
+           Elementary_Functions.Arctan;
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+      -- The following value is a lower bound on the accuracy
+      -- required.  It is normally 0.0 so that the lower bound
+      -- is computed from Model_Epsilon.  However, for tests
+      -- where the expected result is only known to a certain
+      -- amount of precision this bound takes on a non-zero
+      -- value to account for that level of precision.
+      Error_Low_Bound : Real := 0.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon
+         -- instead of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if;
+
+         -- take into account the low bound on the error
+         if Max_Error < Error_Low_Bound then
+            Max_Error := Error_Low_Bound;
+         end if;
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name &
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+            if Actual = Expected then
+               Report.Comment (Test_Name & "  exact result");
+            else
+               Report.Comment (Test_Name & "  passed");
+            end if;
+         end if;
+      end Check;
+
+
+      procedure Special_Value_Test is
+      -- If eta is very small, arctan(x + eta) ~= arctan(x) + eta/(1+x*x).
+      --
+      -- For tests 4 and 5, there is an error of 4.0ME for arctan + an
+      -- additional error of 1.0ME because pi is not exact for a total of 5.0ME.
+      --
+      -- In test 3 there is the error for pi plus an additional error
+      -- of (1.0ME)/4 since sqrt3 is not exact, for a total of 5.25ME.
+      --
+      -- In test 2 there is the error for pi plus an additional error
+      -- of (3/4)(1.0ME) since sqrt3 is not exact, for a total of 5.75ME.
+
+
+         type Data_Point is
+            record
+               Degrees,
+               Radians,
+               Tangent,
+               Allowed_Error : Real;
+            end record;
+
+         type Test_Data_Type is array (Positive range <>) of Data_Point;
+
+         -- the values in the following table only involve static
+         -- expressions so no additional loss of precision occurs.
+         Test_Data : constant Test_Data_Type := (
+         --  degrees      radians       tangent   error     test #
+            (  0.0,           0.0,          0.0,   4.0 ),    -- 1
+            ( 30.0,        Pi/6.0,    Sqrt3/3.0,   5.75),    -- 2
+            ( 60.0,        Pi/3.0,        Sqrt3,   5.25),    -- 3
+            ( 45.0,        Pi/4.0,          1.0,   5.0 ),    -- 4
+            (-45.0,       -Pi/4.0,         -1.0,   5.0 ) );  -- 5
+
+      begin
+         for I in Test_Data'Range loop
+            Check (Arctan (Test_Data (I).Tangent),
+                   Test_Data (I).Radians,
+                   "special value test" & Integer'Image (I) &
+                      " arctan(" &
+                      Real'Image (Test_Data (I).Tangent) &
+                      ")",
+                   Test_Data (I).Allowed_Error);
+            Check (Arctan (Test_Data (I).Tangent, Cycle => 360.0),
+                   Test_Data (I).Degrees,
+                   "special value test" & Integer'Image (I) &
+                      " arctan(" &
+                      Real'Image (Test_Data (I).Tangent) &
+                      ", cycle=>360)",
+                   Test_Data (I).Allowed_Error);
+         end loop;
+
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised in special value test");
+         when others =>
+            Report.Failed ("exception in special value test");
+      end Special_Value_Test;
+
+
+
+      procedure Check_Exact (Actual, Expected_Low, Expected_High : Real;
+	                     Test_Name : String) is
+         -- If the expected result is not a model number, then Expected_Low is
+         -- the first machine number less than the (exact) expected
+         -- result, and Expected_High is the first machine number greater than
+         -- the (exact) expected result. If the expected result is a model
+         -- number, Expected_Low = Expected_High = the result.
+         Model_Expected_Low  : Real := Expected_Low;
+         Model_Expected_High : Real := Expected_High;
+      begin
+         -- Calculate the first model number nearest to, but below (or equal)
+         -- to the expected result:
+         while Real'Model (Model_Expected_Low) /= Model_Expected_Low loop
+            -- Try the next machine number lower:
+            Model_Expected_Low := Real'Adjacent(Model_Expected_Low, 0.0);
+         end loop;
+         -- Calculate the first model number nearest to, but above (or equal)
+         -- to the expected result:
+         while Real'Model (Model_Expected_High) /= Model_Expected_High loop
+            -- Try the next machine number higher:
+            Model_Expected_High := Real'Adjacent(Model_Expected_High, 100.0);
+         end loop;
+
+         if Actual < Model_Expected_Low or Actual > Model_Expected_High then
+            Accuracy_Error_Reported := True;
+            if Actual < Model_Expected_Low then
+               Report.Failed (Test_Name &
+                              " actual: " & Real'Image (Actual) &
+                              " expected low: " & Real'Image (Model_Expected_Low) &
+                              " expected high: " & Real'Image (Model_Expected_High) &
+                              " difference: " & Real'Image (Actual - Expected_Low));
+            else
+               Report.Failed (Test_Name &
+                              " actual: " & Real'Image (Actual) &
+                              " expected low: " & Real'Image (Model_Expected_Low) &
+                              " expected high: " & Real'Image (Model_Expected_High) &
+                              " difference: " & Real'Image (Expected_High - Actual));
+            end if;
+         elsif Verbose then
+            Report.Comment (Test_Name & "  passed");
+         end if;
+      end Check_Exact;
+
+
+      procedure Exact_Result_Test is
+      begin
+         --  A.5.1(40);6.0
+         Check_Exact (Arctan (0.0, 1.0),       0.0, 0.0, "arctan(0,1)");
+         Check_Exact (Arctan (0.0, 1.0, 27.0), 0.0, 0.0, "arctan(0,1,27)");
+
+         --  G.2.4(11-13);6.0
+
+         Check_Exact (Arctan (1.0, 0.0), Half_PI_Low, Half_PI_High,
+              "arctan(1,0)");
+         Check_Exact (Arctan (1.0, 0.0, 360.0), 90.0, 90.0, "arctan(1,0,360)");
+
+         Check_Exact (Arctan (-1.0, 0.0), -Half_PI_High, -Half_PI_Low,
+              "arctan(-1,0)");
+         Check_Exact (Arctan (-1.0, 0.0, 360.0), -90.0, -90.0,
+              "arctan(-1,0,360)");
+
+         if Real'Signed_Zeros then
+            Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(+0,-1)");
+            Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0,
+                  "arctan(+0,-1,360)");
+            Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0),
+                   -PI_High, -PI_Low, "arctan(-0,-1)");
+            Check_Exact (Arctan ( Real ( ImpDef.Annex_G.Negative_Zero ), -1.0,
+                   360.0), -180.0, -180.0, "arctan(-0,-1,360)");
+         else
+            Check_Exact (Arctan (0.0, -1.0), PI_Low, PI_High, "arctan(0,-1)");
+            Check_Exact (Arctan (0.0, -1.0, 360.0), 180.0, 180.0,
+                   "arctan(0,-1,360)");
+         end if;
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised in Exact_Result Test");
+         when others =>
+            Report.Failed ("Exception in Exact_Result Test");
+      end Exact_Result_Test;
+
+
+      procedure Taylor_Series_Test is
+      -- This test checks the Arctan by using a taylor series expansion that
+      -- will produce a result accurate to 19 decimal digits for
+      -- the range under test.
+      --
+      -- The maximum relative error bound for this test is
+      --  4 for the arctan operation and 2 for the Taylor series
+      -- for a total of 6 * Model_Epsilon
+
+         A : constant := -1.0/16.0;
+         B : constant :=  1.0/16.0;
+         X : Real;
+         Actual, Expected : Real;
+         Sum, Em, X_Squared : Real;
+      begin
+         if Real'Digits > 19 then
+            -- Taylor series calculation produces result accurate to 19
+            -- digits.  If type being tested has more digits then set
+            -- the error low bound to account for this.
+            -- The error low bound is conservatively set to 6*10**-19
+            Error_Low_Bound := 0.00000_00000_00000_0006;
+            Report.Comment ("arctan accuracy checked to 19 digits");
+         end if;
+
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 0..Max_Samples loop
+            X :=  (B - A) * Real (I) / Real (Max_Samples) + A;
+            X_Squared := X * X;
+            Em := 17.0;
+            Sum := X_Squared / Em;
+
+            for II in 1 .. 7 loop
+               Em := Em - 2.0;
+               Sum := (1.0 / Em - Sum) * X_Squared;
+            end loop;
+            Sum := -X * Sum;
+            Expected := X + Sum;
+            Sum := (X - Expected) + Sum;
+            if not Real'Machine_Rounds then
+               Expected := Expected + (Sum + Sum);
+            end if;
+
+            Actual := Arctan (X);
+
+            Check (Actual, Expected,
+                   "Taylor_Series_Test " & Integer'Image (I) & ": arctan(" &
+                   Real'Image (X) & ") ",
+                   6.0);
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+
+         end loop;
+         Error_Low_Bound := 0.0;  -- reset
+      exception
+         when Constraint_Error =>
+            Report.Failed
+               ("Constraint_Error raised in Taylor_Series_Test");
+         when others =>
+            Report.Failed ("exception in Taylor_Series_Test");
+      end Taylor_Series_Test;
+
+
+      procedure Exception_Test is
+         X1, X2, X3 : Real := 0.0;
+      begin
+
+         begin  -- A.5.1(20);6.0
+           X1 := Arctan(0.0, Cycle => 0.0);
+           Report.Failed ("no exception for cycle = 0.0");
+         exception
+            when Ada.Numerics.Argument_Error => null;
+            when others =>
+               Report.Failed ("wrong exception for cycle = 0.0");
+         end;
+
+         begin  -- A.5.1(20);6.0
+           X2 := Arctan (0.0, Cycle => -1.0);
+           Report.Failed ("no exception for cycle < 0.0");
+         exception
+            when Ada.Numerics.Argument_Error => null;
+            when others =>
+               Report.Failed ("wrong exception for cycle < 0.0");
+         end;
+
+         begin  -- A.5.1(25);6.0
+           X3 := Arctan (0.0, 0.0);
+           Report.Failed ("no exception for arctan(0,0)");
+         exception
+            when Ada.Numerics.Argument_Error => null;
+            when others =>
+               Report.Failed ("wrong exception for arctan(0,0)");
+         end;
+
+         -- optimizer thwarting
+         if Report.Ident_Bool (False) then
+            Report.Comment (Real'Image (X1 + X2 + X3));
+         end if;
+      end Exception_Test;
+
+
+      procedure Do_Test is
+      begin
+         Special_Value_Test;
+         Exact_Result_Test;
+         Taylor_Series_Test;
+         Exception_Test;
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   -- These expressions must be truly static, which is why we have to do them
+   -- outside of the generic, and we use the named numbers. Note that we know
+   -- that PI is not a machine number (it is irrational), and it should be
+   -- represented to more digits than supported by the target machine.
+   Float_Half_PI_Low  : constant := Float'Adjacent(PI/2.0,  0.0);
+   Float_Half_PI_High : constant := Float'Adjacent(PI/2.0, 10.0);
+   Float_PI_Low       : constant := Float'Adjacent(PI,      0.0);
+   Float_PI_High      : constant := Float'Adjacent(PI,     10.0);
+   package Float_Check is new Generic_Check (Float,
+	Half_PI_Low  => Float_Half_PI_Low,
+	Half_PI_High => Float_Half_PI_High,
+	PI_Low  => Float_PI_Low,
+	PI_High => Float_PI_High);
+
+   -- check the Floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   A_Long_Float_Half_PI_Low  : constant := A_Long_Float'Adjacent(PI/2.0,  0.0);
+   A_Long_Float_Half_PI_High : constant := A_Long_Float'Adjacent(PI/2.0, 10.0);
+   A_Long_Float_PI_Low       : constant := A_Long_Float'Adjacent(PI,      0.0);
+   A_Long_Float_PI_High      : constant := A_Long_Float'Adjacent(PI,     10.0);
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float,
+	Half_PI_Low  => A_Long_Float_Half_PI_Low,
+	Half_PI_High => A_Long_Float_Half_PI_High,
+	PI_Low  => A_Long_Float_PI_Low,
+	PI_High => A_Long_Float_PI_High);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2016",
+                "Check the accuracy of the ARCTAN function");
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" &
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2016;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2017.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2017.a
new file mode 100644
index 000000000..50add975f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2017.a
@@ -0,0 +1,296 @@
+-- CXG2017.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 TANH function returns
+--      a result that is within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is 
+--      instantiated to check both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Checks that use an identity for determining the result.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      20 Mar 96   SAIC    Initial release for 2.1
+--      17 Aug 96   SAIC    Incorporated reviewer comments.
+--      03 Jun 98   EDS     Add parens to remove the potential for overflow.
+--                          Remove the invocation of Identity_Test that checks
+--                          Tanh values that are too close to zero for the
+--                          test's error bounds.
+--!
+
+--
+-- References:
+--
+-- Software Manual for the Elementary Functions
+-- William J. Cody, Jr. and William Waite
+-- Prentice-Hall, 1980
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition 
+--
+-- Implementation and Testing of Function Software
+-- W. J. Cody
+-- Problems and Methodologies in Mathematical Software Production
+-- editors P. C. Messina and A. Murli
+-- Lecture Notes in Computer Science   Volume 142
+-- Springer Verlag, 1982
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Elementary_Functions;
+procedure CXG2017 is
+   Verbose : constant Boolean := False;
+   Max_Samples : constant := 1000;
+
+   E  : constant := Ada.Numerics.E;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Elementary_Functions is new 
+           Ada.Numerics.Generic_Elementary_Functions (Real);
+
+      function Tanh (X : Real) return Real renames
+           Elementary_Functions.Tanh;
+
+      function Log (X : Real) return Real renames
+           Elementary_Functions.Log;
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+
+      -- The following value is a lower bound on the accuracy
+      -- required.  It is normally 0.0 so that the lower bound
+      -- is computed from Model_Epsilon.  However, for tests
+      -- where the expected result is only known to a certain
+      -- amount of precision this bound takes on a non-zero 
+      -- value to account for that level of precision.
+      Error_Low_Bound : Real := 0.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Small instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Small;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+         -- take into account the low bound on the error
+         if Max_Error < Error_Low_Bound then
+            Max_Error := Error_Low_Bound;
+         end if;
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Special_Value_Test is
+         -- In the following tests the expected result is accurate
+         -- to the machine precision so the minimum guaranteed error
+         -- bound can be used.
+         Minimum_Error : constant := 8.0;
+         E2 : constant := E * E;
+      begin
+         Check (Tanh (1.0),
+                (E - 1.0 / E) / (E + 1.0 / E),  
+                "tanh(1)",
+                Minimum_Error);
+         Check (Tanh (2.0),
+                (E2 - 1.0 / E2) / (E2 + 1.0 / E2),  
+                "tanh(2)",
+                Minimum_Error);
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in special value test");
+         when others =>
+            Report.Failed ("exception in special value test");
+      end Special_Value_Test;
+
+
+
+      procedure Exact_Result_Test is
+         No_Error : constant := 0.0;
+      begin
+         -- A.5.1(38);6.0
+         Check (Tanh (0.0),  0.0, "tanh(0)", No_Error);
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in Exact_Result Test");
+         when others =>
+            Report.Failed ("exception in Exact_Result Test");
+      end Exact_Result_Test;
+
+
+      procedure Identity_Test (A, B : Real) is
+      -- For this test we use the identity
+      --    TANH(u+v) = [TANH(u) + TANH(v)] / [1 + TANH(u)*TANH(v)]
+      -- which is transformed to
+      --    TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C]
+      -- where C = TANH(1/8) and y = x - 1/8
+      --
+      -- see Cody pg 248-249 for details on the error analysis.
+      -- The net result is a relative error bound of 16 * Model_Epsilon.
+      --
+      -- The second part of this test checks the identity
+      --    TANH(-x) = -TANH(X)
+
+         X, Y : Real; 
+         Actual1, Actual2 : Real;
+         C : constant := 1.2435300177159620805e-1;
+      begin
+         if Real'Digits > 20 then
+            -- constant C is accurate to 20 digits.  Set the low bound
+            -- on the error to 16*10**-20
+            Error_Low_Bound := 0.00000_00000_00000_00016;
+            Report.Comment ("tanh accuracy checked to 20 digits");
+         end if;
+
+         Accuracy_Error_Reported := False;  -- reset
+         for I in 1..Max_Samples loop
+            X :=  (B - A) * (Real (I) / Real (Max_Samples)) + A;
+            Actual1 := Tanh(X);
+           
+            -- TANH(x) = [TANH(y)+C] / [1 + TANH(y) * C]
+            Y := X - (1.0 / 8.0);
+            Actual2 := (Tanh (Y) + C) / (1.0 + Tanh(Y) * C);
+ 
+            Check (Actual1, Actual2,
+                   "Identity_1_Test " & Integer'Image (I) & ": tanh(" &
+		   Real'Image (X) & ") ",
+                   16.0);
+
+            -- TANH(-x) = -TANH(X)
+            Actual2 := Tanh(-X);
+            Check (-Actual1, Actual2,
+                   "Identity_2_Test " & Integer'Image (I) & ": tanh(" &
+		   Real'Image (X) & ") ",
+                   16.0);
+
+            if Accuracy_Error_Reported then
+              -- only report the first error in this test in order to keep
+              -- lots of failures from producing a huge error log
+              return;
+            end if;
+
+         end loop;
+         Error_Low_Bound := 0.0;   -- reset
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Identity_Test" &
+                " for X=" & Real'Image (X));
+         when others =>
+            Report.Failed ("exception in Identity_Test" &
+                " for X=" & Real'Image (X));
+      end Identity_Test;
+
+
+
+      procedure Do_Test is
+      begin
+         Special_Value_Test;
+         Exact_Result_Test;
+            -- cover a large range
+         Identity_Test (1.0, Real'Safe_Last);
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   package Float_Check is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2017",
+                "Check the accuracy of the TANH function"); 
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2017;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2018.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2018.a
new file mode 100644
index 000000000..be4f1a82f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2018.a
@@ -0,0 +1,355 @@
+-- CXG2018.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 complex EXP function returns
+--      a result that is within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is
+--      instantiated to check complex numbers based upon
+--      both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Checks that use an identity for determining the result.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      21 Mar 96   SAIC    Initial release for 2.1
+--      17 Aug 96   SAIC    Incorporated reviewer comments.
+--      27 Aug 99   RLB     Repair on the error result of checks.
+--      02 Apr 03   RLB     Added code to discard excess precision in the
+--                          construction of the test value for the
+--                          Identity_Test.
+--
+--!
+
+--
+-- References:
+--
+-- W. J. Cody
+-- CELEFUNT: A Portable Test Package for Complex Elementary Functions
+-- Algorithm 714, Collected Algorithms from ACM.
+-- Published in Transactions On Mathematical Software,
+-- Vol. 19, No. 1, March, 1993, pp. 1-21.
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Generic_Complex_Elementary_Functions;
+procedure CXG2018 is
+   Verbose : constant Boolean := False;
+   -- Note that Max_Samples is the number of samples taken in
+   -- both the real and imaginary directions.  Thus, for Max_Samples
+   -- of 100 the number of values checked is 10000.
+   Max_Samples : constant := 100;
+
+   E  : constant := Ada.Numerics.E;
+   Pi : constant := Ada.Numerics.Pi;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Complex_Type is new
+           Ada.Numerics.Generic_Complex_Types (Real);
+      use Complex_Type;
+
+      package CEF is new
+           Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type);
+
+      function Exp (X : Complex) return Complex renames CEF.Exp;
+      function Exp (X : Imaginary) return Complex renames CEF.Exp;
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+
+      -- The following value is a lower bound on the accuracy
+      -- required.  It is normally 0.0 so that the lower bound
+      -- is computed from Model_Epsilon.  However, for tests
+      -- where the expected result is only known to a certain
+      -- amount of precision this bound takes on a non-zero
+      -- value to account for that level of precision.
+      Error_Low_Bound : Real := 0.0;
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Small instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Small;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if;
+
+         -- take into account the low bound on the error
+         if Max_Error < Error_Low_Bound then
+            Max_Error := Error_Low_Bound;
+         end if;
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name &
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Check (Actual, Expected : Complex;
+                       Test_Name : String;
+                       MRE : Real) is
+      begin
+         Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE);
+         Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE);
+      end Check;
+
+
+      procedure Special_Value_Test is
+         -- In the following tests the expected result is accurate
+         -- to the machine precision so the minimum guaranteed error
+         -- bound can be used.
+         --
+         -- The error bounds given assumed z is  exact.  When using
+         -- pi there is an extra error of 1.0ME.
+         -- The pi inside the exp call requires that the complex
+         -- component have an extra error allowance of 1.0*angle*ME.
+         -- Thus for pi/2,the Minimum_Error_I is
+         -- (2.0 + 1.0(pi/2))ME <= 3.6ME.
+         -- For pi, it is (2.0 + 1.0*pi)ME <= 5.2ME,
+         -- and for 2pi, it is (2.0 + 1.0(2pi))ME <= 8.3ME.
+
+         -- The addition of 1 or i to a result is so that neither of
+         -- the components of an expected result is 0.  This is so
+         -- that a reasonable relative error is allowed.
+         Minimum_Error_C : constant := 7.0;   -- for exp(Complex)
+         Minimum_Error_I : constant := 2.0;   -- for exp(Imaginary)
+      begin
+         Check (Exp (1.0 + 0.0*i) + i,
+                E + i,
+                "exp(1+0i)",
+                Minimum_Error_C);
+         Check (Exp ((Pi / 2.0) * i) + 1.0,
+                1.0 + 1.0*i,
+                "exp(pi/2*i)",
+                3.6);
+         Check (Exp (Pi * i) + i,
+                -1.0 + 1.0*i,
+                "exp(pi*i)",
+                5.2);
+         Check (Exp (Pi * 2.0 * i) + i,
+                1.0 + i,
+                "exp(2pi*i)",
+                8.3);
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised in special value test");
+         when others =>
+            Report.Failed ("exception in special value test");
+      end Special_Value_Test;
+
+
+
+      procedure Exact_Result_Test is
+         No_Error : constant := 0.0;
+      begin
+         -- G.1.2(36);6.0
+         Check (Exp(0.0 + 0.0*i),  1.0 + 0.0 * i, "exp(0+0i)", No_Error);
+         Check (Exp(      0.0*i),  1.0 + 0.0 * i, "exp(0i)", No_Error);
+      exception
+         when Constraint_Error =>
+            Report.Failed ("Constraint_Error raised in Exact_Result Test");
+         when others =>
+            Report.Failed ("exception in Exact_Result Test");
+      end Exact_Result_Test;
+
+
+      procedure Identity_Test (A, B : Real) is
+      -- For this test we use the identity
+      --    Exp(Z) = Exp(Z-W) * Exp (W)
+      -- where W = (1+i)/16
+      --
+      -- The second part of this test checks the identity
+      --    Exp(Z) * Exp(-Z)  = 1
+      --
+
+         X, Y : Complex;
+         Actual1, Actual2 : Complex;
+         W : constant Complex := (0.0625, 0.0625);
+         -- the following constant was taken from the CELEFUNC EXP test.
+         -- This is the value EXP(W) - 1
+         C : constant Complex := (6.2416044877018563681e-2,
+                                  6.6487597751003112768e-2);
+      begin
+         if Real'Digits > 20 then
+            -- constant ExpW is accurate to 20 digits.
+            -- The low bound is 19 * 10**-20
+            Error_Low_Bound := 0.00000_00000_00019;
+            Report.Comment ("complex exp accuracy checked to 20 digits");
+         end if;
+
+         Accuracy_Error_Reported := False;  -- reset
+         for II in 1..Max_Samples loop
+            X.Re :=  Real'Machine ((B - A) * Real (II) / Real (Max_Samples)
+                        + A);
+            for J in 1..Max_Samples loop
+               X.Im :=  Real'Machine ((B - A) * Real (J) / Real (Max_Samples)
+                           + A);
+
+               Actual1 := Exp(X);
+
+               -- Exp(X) = Exp(X-W) * Exp (W)
+               --        = Exp(X-W) * (1 - (1-Exp(W))
+               --        = Exp(X-W) * (1 + (Exp(W) - 1))
+               --        = Exp(X-W) * (1 + C)
+               Y := X - W;
+               Actual2 := Exp(Y);
+               Actual2 := Actual2 + Actual2 * C;
+
+               Check (Actual1, Actual2,
+                      "Identity_1_Test " & Integer'Image (II) &
+                         Integer'Image (J) & ": Exp((" &
+		         Real'Image (X.Re) & ", " &
+		         Real'Image (X.Im) & ")) ",
+                      20.0);   -- 2 exp and 1 multiply and 1 add = 2*7+1*5+1
+                    -- Note: The above is not strictly correct, as multiply
+                    -- has a box error, rather than a relative error.
+                    -- Supposedly, the interval is chosen to avoid the need
+                    -- to worry about this.
+
+               -- Exp(X) * Exp(-X) + i  = 1 + i
+               -- The addition of i is to allow a reasonable relative
+               -- error in the imaginary part
+               Actual2 := (Actual1 * Exp(-X)) + i;
+               Check (Actual2, (1.0, 1.0),
+                      "Identity_2_Test " & Integer'Image (II) &
+                         Integer'Image (J) & ": Exp((" &
+		         Real'Image (X.Re) & ", " &
+		         Real'Image (X.Im) & ")) ",
+                      20.0);   -- 2 exp and 1 multiply and one add = 2*7+1*5+1
+
+               if Accuracy_Error_Reported then
+                 -- only report the first error in this test in order to keep
+                 -- lots of failures from producing a huge error log
+                 return;
+               end if;
+            end loop;
+         end loop;
+         Error_Low_Bound := 0.0;
+      exception
+         when Constraint_Error =>
+            Report.Failed
+               ("Constraint_Error raised in Identity_Test" &
+                " for X=(" & Real'Image (X.Re) &
+                ", " & Real'Image (X.Im) & ")");
+         when others =>
+            Report.Failed ("exception in Identity_Test" &
+                " for X=(" & Real'Image (X.Re) &
+                ", " & Real'Image (X.Im) & ")");
+      end Identity_Test;
+
+
+
+      procedure Do_Test is
+      begin
+         Special_Value_Test;
+         Exact_Result_Test;
+            -- test regions where we can avoid cancellation error problems
+            -- See Cody page 10.
+         Identity_Test (0.0625, 1.0);
+         Identity_Test (15.0, 17.0);
+         Identity_Test (1.625, 3.0);
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   package Float_Check is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2018",
+                "Check the accuracy of the complex EXP function");
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" &
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2018;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2019.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2019.a
new file mode 100644
index 000000000..0a4dddcc9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2019.a
@@ -0,0 +1,338 @@
+-- CXG2019.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 complex LOG function returns
+--      a result that is within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is 
+--      instantiated to check complex numbers based upon 
+--      both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Checks that use an identity for determining the result.
+--         Exception conditions.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      22 Mar 96   SAIC    Initial release for 2.1
+--
+--!
+
+--
+-- References:
+--
+-- W. J. Cody
+-- CELEFUNT: A Portable Test Package for Complex Elementary Functions
+-- Algorithm 714, Collected Algorithms from ACM.
+-- Published in Transactions On Mathematical Software,
+-- Vol. 19, No. 1, March, 1993, pp. 1-21.
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition 
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Generic_Complex_Elementary_Functions;
+procedure CXG2019 is
+   Verbose : constant Boolean := False;
+   -- Note that Max_Samples is the number of samples taken in
+   -- both the real and imaginary directions.  Thus, for Max_Samples
+   -- of 100 the number of values checked is 10000.
+   Max_Samples : constant := 100;
+
+   E  : constant := Ada.Numerics.E;
+   Pi : constant := Ada.Numerics.Pi;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Complex_Type is new
+           Ada.Numerics.Generic_Complex_Types (Real);
+      use Complex_Type;
+
+      package CEF is new 
+           Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type);
+
+      function Log (X : Complex) return Complex renames CEF.Log;
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Small instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * abs Expected * Real'Model_Epsilon;
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Check (Actual, Expected : Complex;
+                       Test_Name : String;
+                       MRE : Real) is
+      begin
+         Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE);
+         Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE);
+      end Check;
+
+
+      procedure Special_Value_Test is
+         -- In the following tests the expected result is accurate
+         -- to the machine precision so the minimum guaranteed error
+         -- bound can be used if the argument is exact.
+         --
+         -- When using pi there is an extra error of 1.0ME.  
+         -- Although the real component has an error bound of 13.0, 
+         -- the complex component must take into account this error
+         -- in the value for Pi.
+         --
+         -- One or i is added to the actual and expected results in
+         -- order to prevent the expected result from having a 
+         -- real or imaginary part of 0.  This is to allow a reasonable
+         -- relative error for that component.
+         Minimum_Error : constant := 13.0; 
+      begin
+         Check (1.0 + Log (0.0 + i),
+                1.0 + Pi / 2.0 * i,
+                "1+log(0+i)",
+                Minimum_Error + 1.0);
+         Check (1.0 + Log ((-1.0, 0.0)),
+                1.0 + (Pi * i),
+                "log(-1+0i)+1 ",
+                Minimum_Error + 1.0);
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in special value test");
+         when others =>
+            Report.Failed ("exception in special value test");
+      end Special_Value_Test;
+
+
+
+      procedure Exact_Result_Test is
+         No_Error : constant := 0.0;
+      begin
+         -- G.1.2(37);6.0
+         Check (Log(1.0 + 0.0*i),  0.0 + 0.0 * i, "log(1+0i)", No_Error);
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in Exact_Result Test");
+         when others =>
+            Report.Failed ("exception in Exact_Result Test");
+      end Exact_Result_Test;
+
+
+      procedure Identity_Test (RA, RB, IA, IB : Real) is
+      -- Tests an identity over a range of values specified
+      -- by the 4 parameters.  RA and RB denote the range for the
+      -- real part while IA and IB denote the range for the 
+      -- imaginary part.
+      --
+      -- For this test we use the identity
+      --    Log(Z*Z) = 2 * Log(Z)
+      --
+
+         Scale : Real := Real (Real'Machine_Radix) ** (Real'Mantissa / 2 + 4);
+         W, X, Y, Z : Real;
+         CX, CY : Complex;
+         Actual1, Actual2 : Complex;
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for II in 1..Max_Samples loop
+            X :=  (RB - RA) * Real (II) / Real (Max_Samples) + RA;
+            for J in 1..Max_Samples loop
+               Y :=  (IB - IA) * Real (J) / Real (Max_Samples) + IA;
+               
+               -- purify the arguments to minimize roundoff error.
+               -- We construct the values so that the products X*X, 
+               -- Y*Y, and X*Y are all exact machine numbers.
+               -- See Cody page 7 and CELEFUNT code.
+               Z := X * Scale;
+               W := Z + X;
+               X := W - Z;
+               Z := Y * Scale;
+               W := Z + Y;
+               Y := W - Z;
+               CX := Compose_From_Cartesian(X,Y);
+               Z := X*X - Y*Y;
+               W := X*Y;
+               CY := Compose_From_Cartesian(Z,W+W);
+ 
+               -- The arguments are now ready so on with the 
+               -- identity computation.
+               Actual1 := Log(CX);
+           
+               Actual2 := Log(CY) * 0.5;
+ 
+               Check (Actual1, Actual2,
+                      "Identity_1_Test " & Integer'Image (II) & 
+                         Integer'Image (J) & ": Log((" &
+		         Real'Image (CX.Re) & ", " &
+		         Real'Image (CX.Im) & ")) ",
+                      26.0);   -- 2 logs = 2*13.  no error from this multiply
+
+               if Accuracy_Error_Reported then
+                 -- only report the first error in this test in order to keep
+                 -- lots of failures from producing a huge error log
+                 return;
+               end if;
+            end loop;
+         end loop;
+
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Identity_Test" &
+                " for X=(" & Real'Image (X) &
+                ", " & Real'Image (X) & ")");
+         when others =>
+            Report.Failed ("exception in Identity_Test" &
+                " for X=(" & Real'Image (X) &
+                ", " & Real'Image (X) & ")");
+      end Identity_Test;
+
+
+      procedure Exception_Test is
+      -- Check that log((0,0)) causes constraint_error.
+      -- G.1.2(29);
+
+         X : Complex := (0.0, 0.0);
+      begin
+         if not Real'Machine_Overflows then
+            -- not applicable:   G.1.2(28);6.0
+            return;
+         end if;
+
+         begin
+            X := Log ((0.0, 0.0));
+            Report.Failed ("exception not raised for log(0,0)");
+         exception
+            when Constraint_Error => null;  -- ok
+            when others =>
+               Report.Failed ("wrong exception raised for log(0,0)");
+         end;
+
+         -- optimizer thwarting
+         if Report.Ident_Bool(False) then
+            Report.Comment (Real'Image (X.Re + X.Im));
+         end if;
+      end Exception_Test;
+
+
+      procedure Do_Test is
+      begin
+         Special_Value_Test;
+         Exact_Result_Test;
+            -- test regions that do not include the unit circle so that
+            -- the real part of LOG(Z) does not vanish
+            -- See Cody page 9.
+         Identity_Test (   2.0,   10.0,       0.0,    10.0);
+         Identity_Test (1000.0, 2000.0,   -4000.0, -1000.0);
+         Identity_Test (Real'Model_Epsilon, 0.25,
+                        -0.25,              -Real'Model_Epsilon);
+         Exception_Test;
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   package Float_Check is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2019",
+                "Check the accuracy of the complex LOG function"); 
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2019;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2020.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2020.a
new file mode 100644
index 000000000..1aed4ca57
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2020.a
@@ -0,0 +1,351 @@
+-- CXG2020.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 complex SQRT function returns
+--      a result that is within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is 
+--      instantiated to check complex numbers based upon 
+--      both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Checks that use an identity for determining the result.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      24 Mar 96   SAIC    Initial release for 2.1 
+--      17 Aug 96   SAIC    Incorporated reviewer comments.
+--      03 Jun 98   EDS     Added parens to ensure that the expression is not
+--                          evaluated by multiplying its two large terms
+--                          together and overflowing.
+--!
+
+--
+-- References:
+--
+-- W. J. Cody
+-- CELEFUNT: A Portable Test Package for Complex Elementary Functions
+-- Algorithm 714, Collected Algorithms from ACM.
+-- Published in Transactions On Mathematical Software,
+-- Vol. 19, No. 1, March, 1993, pp. 1-21.
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition 
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Generic_Complex_Elementary_Functions;
+procedure CXG2020 is
+   Verbose : constant Boolean := False;
+   -- Note that Max_Samples is the number of samples taken in
+   -- both the real and imaginary directions.  Thus, for Max_Samples
+   -- of 100 the number of values checked is 10000.
+   Max_Samples : constant := 100;
+
+   E  : constant := Ada.Numerics.E;
+   Pi : constant := Ada.Numerics.Pi;
+
+   -- CRC Standard Mathematical Tables;  23rd Edition; pg 738
+   Sqrt2 : constant := 
+        1.41421_35623_73095_04880_16887_24209_69807_85696_71875_37695;
+   Sqrt3 : constant :=
+        1.73205_08075_68877_29352_74463_41505_87236_69428_05253_81039;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Complex_Type is new
+           Ada.Numerics.Generic_Complex_Types (Real);
+      use Complex_Type;
+
+      package CEF is new 
+           Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type);
+
+      function Sqrt (X : Complex) return Complex renames CEF.Sqrt;
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon 
+         -- instead of Model_Epsilon and Expected.
+         Rel_Error := MRE * (abs Expected * Real'Model_Epsilon);
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed");
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Check (Actual, Expected : Complex;
+                       Test_Name : String;
+                       MRE : Real) is
+      begin
+         Check (Actual.Re, Expected.Re, Test_Name & " real part", MRE);
+         Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", MRE);
+      end Check;
+
+
+      procedure Special_Value_Test is
+         -- In the following tests the expected result is accurate
+         -- to the machine precision so the minimum guaranteed error
+         -- bound can be used if the argument is exact.
+         --
+         -- One or i is added to the actual and expected results in
+         -- order to prevent the expected result from having a 
+         -- real or imaginary part of 0.  This is to allow a reasonable
+         -- relative error for that component.
+         Minimum_Error : constant := 6.0; 
+         Z1, Z2 : Complex;
+      begin
+         Check (Sqrt(9.0+0.0*i) + i,
+                3.0+1.0*i,
+                "sqrt(9+0i)+i",
+                Minimum_Error);
+         Check (Sqrt (-2.0 + 0.0 * i) + 1.0,
+                1.0 + Sqrt2 * i,
+                "sqrt(-2)+1 ",
+                Minimum_Error);
+
+         -- make sure no exception occurs when taking the sqrt of 
+         -- very large and very small values.
+
+         Z1 := (Real'Safe_Last * 0.9, Real'Safe_Last * 0.9);
+         Z2 := Sqrt (Z1);
+         begin
+            Check (Z2 * Z2,
+                   Z1,
+                   "sqrt((big,big))",
+                   Minimum_Error + 5.0);  -- +5 for multiply
+         exception
+            when others =>
+                Report.Failed ("unexpected exception in sqrt((big,big))");
+         end;
+        
+         Z1 := (Real'Model_Epsilon * 10.0, Real'Model_Epsilon * 10.0);
+         Z2 := Sqrt (Z1);
+         begin
+            Check (Z2 * Z2,
+                   Z1,
+                   "sqrt((little,little))",
+                   Minimum_Error + 5.0);  -- +5 for multiply
+         exception
+            when others =>
+                Report.Failed ("unexpected exception in " &
+                    "sqrt((little,little))");
+         end;
+        
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in special value test");
+         when others =>
+            Report.Failed ("exception in special value test");
+      end Special_Value_Test;
+
+
+
+      procedure Exact_Result_Test is
+         No_Error : constant := 0.0;
+      begin
+         -- G.1.2(36);6.0
+         Check (Sqrt(0.0 + 0.0*i),  0.0 + 0.0 * i, "sqrt(0+0i)", No_Error);
+
+         -- G.1.2(37);6.0
+         Check (Sqrt(1.0 + 0.0*i),  1.0 + 0.0 * i, "sqrt(1+0i)", No_Error);
+
+         -- G.1.2(38-39);6.0
+         Check (Sqrt(-1.0 + 0.0*i),  0.0 + 1.0 * i, "sqrt(-1+0i)", No_Error);
+
+         -- G.1.2(40);6.0
+         if Real'Signed_Zeros then
+            Check (Sqrt(-1.0-0.0*i), 0.0 - 1.0 * i, "sqrt(-1-0i)", No_Error);
+         end if;
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in Exact_Result Test");
+         when others =>
+            Report.Failed ("exception in Exact_Result Test");
+      end Exact_Result_Test;
+
+
+      procedure Identity_Test (RA, RB, IA, IB : Real) is
+      -- Tests an identity over a range of values specified
+      -- by the 4 parameters.  RA and RB denote the range for the
+      -- real part while IA and IB denote the range for the 
+      -- imaginary part of the result.
+      --
+      -- For this test we use the identity
+      --    Sqrt(Z*Z) = Z
+      --
+
+         Scale : Real := Real (Real'Machine_Radix) ** (Real'Mantissa / 2 + 4);
+         W, X, Y, Z : Real;
+         CX : Complex;
+         Actual, Expected : Complex;
+      begin
+         Accuracy_Error_Reported := False;  -- reset
+         for II in 1..Max_Samples loop
+            X :=  (RB - RA) * Real (II) / Real (Max_Samples) + RA;
+            for J in 1..Max_Samples loop
+               Y :=  (IB - IA) * Real (J) / Real (Max_Samples) + IA;
+               
+               -- purify the arguments to minimize roundoff error.
+               -- We construct the values so that the products X*X, 
+               -- Y*Y, and X*Y are all exact machine numbers.
+               -- See Cody page 7 and CELEFUNT code.
+               Z := X * Scale;
+               W := Z + X;
+               X := W - Z;
+               Z := Y * Scale;
+               W := Z + Y;
+               Y := W - Z;
+                 -- G.1.2(21);6.0 - real part of result is non-negative
+               Expected := Compose_From_Cartesian( abs X,Y);
+               Z := X*X - Y*Y;
+               W := X*Y;
+               CX := Compose_From_Cartesian(Z,W+W);
+ 
+               -- The arguments are now ready so on with the 
+               -- identity computation.
+               Actual := Sqrt(CX);
+           
+               Check (Actual, Expected,
+                      "Identity_1_Test " & Integer'Image (II) & 
+                         Integer'Image (J) & ": Sqrt((" &
+		         Real'Image (CX.Re) & ", " &
+		         Real'Image (CX.Im) & ")) ",
+                      8.5);   -- 6.0 from sqrt, 2.5 from argument.  
+               -- See Cody pg 7-8 for analysis of additional error amount.
+
+               if Accuracy_Error_Reported then
+                 -- only report the first error in this test in order to keep
+                 -- lots of failures from producing a huge error log
+                 return;
+               end if;
+            end loop;
+         end loop;
+
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Identity_Test" &
+                " for X=(" & Real'Image (X) &
+                ", " & Real'Image (X) & ")");
+         when others =>
+            Report.Failed ("exception in Identity_Test" &
+                " for X=(" & Real'Image (X) &
+                ", " & Real'Image (X) & ")");
+      end Identity_Test;
+
+
+      procedure Do_Test is
+      begin
+         Special_Value_Test;
+         Exact_Result_Test;
+         -- ranges where the sign is the same and where it 
+         -- differs.
+         Identity_Test (   0.0,   10.0,       0.0,    10.0);
+         Identity_Test (   0.0,  100.0,    -100.0,     0.0);
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   package Float_Check is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2020",
+                "Check the accuracy of the complex SQRT function"); 
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2020;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2021.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2021.a
new file mode 100644
index 000000000..db49fc845
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2021.a
@@ -0,0 +1,386 @@
+-- CXG2021.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 complex SIN and COS functions return
+--      a result that is within the error bound allowed.
+--
+-- TEST DESCRIPTION:
+--      This test consists of a generic package that is 
+--      instantiated to check complex numbers based upon 
+--      both Float and a long float type.
+--      The test for each floating point type is divided into
+--      several parts:
+--         Special value checks where the result is a known constant.
+--         Checks that use an identity for determining the result.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--      27 Mar 96   SAIC    Initial release for 2.1
+--      22 Aug 96   SAIC    No longer skips test for systems with
+--                          more than 20 digits of precision.
+--
+--!
+
+--
+-- References:
+--
+-- W. J. Cody
+-- CELEFUNT: A Portable Test Package for Complex Elementary Functions
+-- Algorithm 714, Collected Algorithms from ACM.
+-- Published in Transactions On Mathematical Software,
+-- Vol. 19, No. 1, March, 1993, pp. 1-21.
+--
+-- CRC Standard Mathematical Tables
+-- 23rd Edition 
+--
+
+with System;
+with Report;
+with Ada.Numerics.Generic_Complex_Types;
+with Ada.Numerics.Generic_Complex_Elementary_Functions;
+procedure CXG2021 is
+   Verbose : constant Boolean := False;
+   -- Note that Max_Samples is the number of samples taken in
+   -- both the real and imaginary directions.  Thus, for Max_Samples
+   -- of 100 the number of values checked is 10000.
+   Max_Samples : constant := 100;
+
+   E  : constant := Ada.Numerics.E;
+   Pi : constant := Ada.Numerics.Pi;
+
+   generic
+      type Real is digits <>;
+   package Generic_Check is
+      procedure Do_Test;
+   end Generic_Check;
+
+   package body Generic_Check is
+      package Complex_Type is new
+           Ada.Numerics.Generic_Complex_Types (Real);
+      use Complex_Type;
+
+      package CEF is new 
+           Ada.Numerics.Generic_Complex_Elementary_Functions (Complex_Type);
+
+      function Sin (X : Complex) return Complex renames CEF.Sin;
+      function Cos (X : Complex) return Complex renames CEF.Cos;
+
+      -- flag used to terminate some tests early
+      Accuracy_Error_Reported : Boolean := False;
+
+      -- The following value is a lower bound on the accuracy
+      -- required.  It is normally 0.0 so that the lower bound
+      -- is computed from Model_Epsilon.  However, for tests
+      -- where the expected result is only known to a certain
+      -- amount of precision this bound takes on a non-zero 
+      -- value to account for that level of precision.
+      Error_Low_Bound : Real := 0.0;
+
+      -- the E_Factor is an additional amount added to the Expected
+      -- value prior to computing the maximum relative error.
+      -- This is needed because the error analysis (Cody pg 17-20)
+      -- requires this additional allowance.
+      procedure Check (Actual, Expected : Real;
+                       Test_Name : String;
+                       MRE : Real;
+                       E_Factor : Real := 0.0) is
+         Max_Error : Real;
+         Rel_Error : Real;
+         Abs_Error : Real;
+      begin
+         -- In the case where the expected result is very small or 0
+         -- we compute the maximum error as a multiple of Model_Epsilon instead
+         -- of Model_Epsilon and Expected.
+         Rel_Error := MRE * Real'Model_Epsilon * (abs Expected + E_Factor);
+         Abs_Error := MRE * Real'Model_Epsilon;
+         if Rel_Error > Abs_Error then
+            Max_Error := Rel_Error;
+         else
+            Max_Error := Abs_Error;
+         end if; 
+
+         -- take into account the low bound on the error
+         if Max_Error < Error_Low_Bound then
+            Max_Error := Error_Low_Bound;
+         end if;
+
+         if abs (Actual - Expected) > Max_Error then
+            Accuracy_Error_Reported := True;
+            Report.Failed (Test_Name & 
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) &
+                           " efactor:" & Real'Image (E_Factor) );
+         elsif Verbose then
+	    if Actual = Expected then
+	       Report.Comment (Test_Name & "  exact result");
+	    else
+	       Report.Comment (Test_Name & "  passed" &
+                           " actual: " & Real'Image (Actual) &
+                           " expected: " & Real'Image (Expected) &
+                           " difference: " & Real'Image (Actual - Expected) &
+                           " max err:" & Real'Image (Max_Error) &
+                           " efactor:" & Real'Image (E_Factor) );
+	    end if;
+         end if;
+      end Check;
+
+
+      procedure Check (Actual, Expected : Complex;
+                       Test_Name : String;
+                       MRE : Real;
+                       R_Factor, I_Factor : Real := 0.0) is
+      begin
+         Check (Actual.Re, Expected.Re, Test_Name & " real part", 
+                MRE, R_Factor);
+         Check (Actual.Im, Expected.Im, Test_Name & " imaginary part", 
+                MRE, I_Factor);
+      end Check;
+
+
+      procedure Special_Value_Test is
+         -- In the following tests the expected result is accurate
+         -- to the machine precision so the minimum guaranteed error
+         -- bound can be used if the argument is exact.
+         -- Since the argument involves Pi, we must allow for this
+         -- inexact argument.
+         Minimum_Error : constant := 11.0; 
+      begin
+         Check (Sin (Pi/2.0 + 0.0*i),
+                1.0 + 0.0*i,
+                "sin(pi/2+0i)",
+                Minimum_Error + 1.0);
+         Check (Cos (Pi/2.0 + 0.0*i),
+                0.0 + 0.0*i,
+                "cos(pi/2+0i)",
+                Minimum_Error + 1.0);
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in special value test");
+         when others =>
+            Report.Failed ("exception in special value test");
+      end Special_Value_Test;
+
+
+
+      procedure Exact_Result_Test is
+         No_Error : constant := 0.0;
+      begin
+         -- G.1.2(36);6.0
+         Check (Sin(0.0 + 0.0*i),  0.0 + 0.0 * i, "sin(0+0i)", No_Error);
+         Check (Cos(0.0 + 0.0*i),  1.0 + 0.0 * i, "cos(0+0i)", No_Error);
+      exception
+         when Constraint_Error => 
+            Report.Failed ("Constraint_Error raised in Exact_Result Test");
+         when others =>
+            Report.Failed ("exception in Exact_Result Test");
+      end Exact_Result_Test;
+
+
+      procedure Identity_Test (RA, RB, IA, IB : Real) is
+      -- Tests an identity over a range of values specified
+      -- by the 4 parameters.  RA and RB denote the range for the
+      -- real part while IA and IB denote the range for the 
+      -- imaginary part.
+      --
+      -- For this test we use the identity
+      --    Sin(Z) = Sin(Z-W) * Cos(W) + Cos(Z-W) * Sin(W)
+      -- and
+      --    Cos(Z) = Cos(Z-W) * Cos(W) - Sin(Z-W) * Sin(W)
+      --
+
+         X, Y : Real;
+         Z   : Complex;
+         W : constant Complex := Compose_From_Cartesian(0.0625, 0.0625);
+         ZmW : Complex;  -- Z - W
+         Sin_ZmW,
+         Cos_ZmW : Complex;
+         Actual1, Actual2 : Complex;
+         R_Factor : Real;  -- additional real error factor
+         I_Factor : Real;  -- additional imaginary error factor
+         Sin_W : constant Complex := (6.2581348413276935585E-2,
+                                      6.2418588008436587236E-2);
+         -- numeric stability is enhanced by using Cos(W) - 1.0 instead of
+         -- Cos(W) in the computation.
+         Cos_W_m_1 : constant Complex := (-2.5431314180235545803E-6,
+                                            -3.9062493377261771826E-3);
+
+
+      begin
+         if Real'Digits > 20 then
+            -- constants used here accurate to 20 digits.  Allow 1
+            -- additional digit of error for computation.
+            Error_Low_Bound := 0.00000_00000_00000_0001;
+            Report.Comment ("accuracy checked to 19 digits");
+         end if;
+
+         Accuracy_Error_Reported := False;  -- reset
+         for II in 0..Max_Samples loop
+            X :=  (RB - RA) * Real (II) / Real (Max_Samples) + RA;
+            for J in 0..Max_Samples loop
+               Y :=  (IB - IA) * Real (J) / Real (Max_Samples) + IA;
+               
+               Z := Compose_From_Cartesian(X,Y);
+               ZmW := Z - W;
+               Sin_ZmW := Sin (ZmW);
+               Cos_ZmW := Cos (ZmW);
+
+               -- now for the first identity 
+               --    Sin(Z) = Sin(Z-W) * Cos(W) + Cos(Z-W) * Sin(W)
+               --           = Sin(Z-W) * (1+(Cos(W)-1)) + Cos(Z-W) * Sin(W)
+               --           = Sin(Z-W) + Sin(Z-W)*(Cos(W)-1) + Cos(Z-W)*Sin(W)
+
+
+               Actual1 := Sin (Z);
+               Actual2 := Sin_ZmW + (Sin_ZmW * Cos_W_m_1 + Cos_ZmW * Sin_W);
+
+               -- The computation of the additional error factors are taken
+               -- from Cody pages 17-20.
+
+               R_Factor := abs (Re (Sin_ZmW) * Re (1.0 - Cos_W_m_1)) +
+                           abs (Im (Sin_ZmW) * Im (1.0 - Cos_W_m_1)) +
+                           abs (Re (Cos_ZmW) * Re (Sin_W)) +
+                           abs (Re (Cos_ZmW) * Re (1.0 - Cos_W_m_1));
+ 
+               I_Factor := abs (Re (Sin_ZmW) * Im (1.0 - Cos_W_m_1)) +
+                           abs (Im (Sin_ZmW) * Re (1.0 - Cos_W_m_1)) +
+                           abs (Re (Cos_ZmW) * Im (Sin_W)) +
+                           abs (Im (Cos_ZmW) * Re (1.0 - Cos_W_m_1));
+ 
+               Check (Actual1, Actual2,
+                      "Identity_1_Test " & Integer'Image (II) & 
+                         Integer'Image (J) & ": Sin((" &
+		         Real'Image (Z.Re) & ", " &
+		         Real'Image (Z.Im) & ")) ",
+                      11.0, R_Factor, I_Factor); 
+
+               -- now for the second identity 
+               --    Cos(Z) = Cos(Z-W) * Cos(W) - Sin(Z-W) * Sin(W)
+               --           = Cos(Z-W) * (1+(Cos(W)-1) - Sin(Z-W) * Sin(W)
+               Actual1 := Cos (Z);
+               Actual2 := Cos_ZmW + (Cos_ZmW * Cos_W_m_1 - Sin_ZmW * Sin_W);
+
+               -- The computation of the additional error factors are taken
+               -- from Cody pages 17-20.
+
+               R_Factor := abs (Re (Sin_ZmW) * Re (Sin_W)) +
+                           abs (Im (Sin_ZmW) * Im (Sin_W)) +
+                           abs (Re (Cos_ZmW) * Re (1.0 - Cos_W_m_1)) +
+                           abs (Im (Cos_ZmW) * Im (1.0 - Cos_W_m_1));
+ 
+               I_Factor := abs (Re (Sin_ZmW) * Im (Sin_W)) +
+                           abs (Im (Sin_ZmW) * Re (Sin_W)) +
+                           abs (Re (Cos_ZmW) * Im (1.0 - Cos_W_m_1)) +
+                           abs (Im (Cos_ZmW) * Re (1.0 - Cos_W_m_1));
+ 
+               Check (Actual1, Actual2,
+                      "Identity_2_Test " & Integer'Image (II) & 
+                         Integer'Image (J) & ": Cos((" &
+		         Real'Image (Z.Re) & ", " &
+		         Real'Image (Z.Im) & ")) ",
+                      11.0, R_Factor, I_Factor); 
+
+               if Accuracy_Error_Reported then
+                 -- only report the first error in this test in order to keep
+                 -- lots of failures from producing a huge error log
+                 Error_Low_Bound := 0.0;  -- reset
+                 return;
+               end if;
+            end loop;
+         end loop;
+
+         Error_Low_Bound := 0.0;  -- reset
+      exception
+         when Constraint_Error => 
+            Report.Failed 
+               ("Constraint_Error raised in Identity_Test" &
+                " for Z=(" & Real'Image (X) &
+                ", " & Real'Image (Y) & ")");
+         when others =>
+            Report.Failed ("exception in Identity_Test" &
+                " for Z=(" & Real'Image (X) &
+                ", " & Real'Image (Y) & ")");
+      end Identity_Test;
+
+
+      procedure Do_Test is
+      begin
+         Special_Value_Test;
+         Exact_Result_Test;
+            -- test regions where sin and cos have the same sign and
+            -- about the same magnitude.  This will minimize subtraction
+            -- errors in the identities.
+            -- See Cody page 17.
+         Identity_Test (0.0625,   10.0,    0.0625,    10.0);
+         Identity_Test (  16.0,   17.0,      16.0,    17.0);
+      end Do_Test;
+   end Generic_Check;
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+   package Float_Check is new Generic_Check (Float);
+
+   -- check the floating point type with the most digits
+   type A_Long_Float is digits System.Max_Digits;
+   package A_Long_Float_Check is new Generic_Check (A_Long_Float);
+
+   -----------------------------------------------------------------------
+   -----------------------------------------------------------------------
+
+
+begin
+   Report.Test ("CXG2021",
+                "Check the accuracy of the complex SIN and COS functions"); 
+
+   if Verbose then
+      Report.Comment ("checking Standard.Float");
+   end if;
+
+   Float_Check.Do_Test;
+
+   if Verbose then
+      Report.Comment ("checking a digits" & 
+                      Integer'Image (System.Max_Digits) &
+                      " floating point type");
+   end if;
+
+   A_Long_Float_Check.Do_Test;
+
+
+   Report.Result;
+end CXG2021;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2022.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2022.a
new file mode 100644
index 000000000..f9e4d1cae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2022.a
@@ -0,0 +1,309 @@
+-- CXG2022.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 multiplication and division of binary fixed point 
+--      numbers with compatible 'small values produce exact results.
+--
+-- TEST DESCRIPTION:
+--      Signed, unsigned, and a mixture of signed and unsigned
+--      binary fixed point values are multiplied and divided.
+--      The result is checked against the expected "perfect result set"
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--
+--
+-- CHANGE HISTORY:
+--       1 Apr 96   SAIC    Initial release for 2.1
+--      29 Jan 1998 EDS     Repaired fixed point errors ("**" and 
+--                          assumptions about 'Small)
+--!
+
+with System;
+with Report;
+procedure CXG2022 is
+   Verbose : constant Boolean := False;
+
+procedure Check_Signed is
+   type Pairs is delta 2.0 range -2.0 ** (System.Max_Mantissa) ..
+                                  2.0 ** (System.Max_Mantissa) - 1.0;
+   type Halves is delta 0.5 range -2.0 ** (System.Max_Mantissa-2) ..
+                                   2.0 ** (System.Max_Mantissa-2) - 1.0;
+   P1, P2, P3, P4 : Pairs;
+   H1, H2, H3, H4 : Halves;
+
+   procedure Dont_Opt is
+   -- keep optimizer from knowing the constant value of expressions
+   begin
+      if Report.Ident_Bool (False) then
+         P1 :=  2.0;  P2 := 4.0;  P3 := 6.0;
+         H1 := -2.0;  H2 := 9.0;  H3 := 3.0;
+      end if;
+   end Dont_Opt;
+
+begin
+   H1 := -0.5;
+   H2 := Halves'First;
+   H3 := 1.0;
+   P1 := 12.0;
+   P2 := Pairs'First;
+   P3 := Pairs'Last;
+   Dont_Opt;
+
+   P4 := Pairs (P1 * H1);     -- 12.0 * -0.5
+   if P4 /= -6.0 then
+      Report.Failed ("12.0 * -0.5 = " & Pairs'Image (P4));
+   end if;
+
+   H4 := Halves (P1 / H1);     -- 12.0 / -0.5
+   if H4 /= -24.0 then
+      Report.Failed ("12.0 / -0.5 = " & Halves'Image (H4));
+   end if;
+
+   P4 := P3 * H3;     -- Pairs'Last * 1.0
+   if P4 /= Pairs'Last then
+      Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4));
+   end if;
+
+   P4 := P3 / H3;     -- Pairs'Last / 1.0
+   if P4 /= Pairs'Last then
+      Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4));
+   end if;
+
+   P4 := P2 * 0.25;     -- Pairs'First * 0.25
+   if P4 /= Pairs (-2.0 ** (System.Max_Mantissa - 2)) then
+      Report.Failed ("Pairs'First * 0.25 = " & Pairs'Image (P4));
+   end if;
+
+   P4 := 100.5 / H1;   -- 100.5 / -0.5
+   if P4 = -201.0 then
+      null;   -- Perfect result
+   elsif Pairs'Small = 2.0 and ( P4 = -200.0 or P4 = -202.0 ) then
+      null;   -- Allowed variation
+   else
+      Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) &
+                     " and 100.5/-0.5 = " & Pairs'Image (P4) );
+   end if;
+
+   H4 := H1 * H2;   --  -0.5 * Halves'First
+   if H4 /= Halves (2.0 ** (System.Max_Mantissa-3)) then
+      Report.Failed ("-0.5 * Halves'First =" & Halves'Image (H4) &
+                     " instead of " &
+                     Halves'Image( Halves(2.0 ** (System.Max_Mantissa-3)))); 
+   end if;
+
+exception
+   when others =>
+      Report.Failed ("unexpected exception in Check_Signed");
+end Check_Signed;
+
+
+
+procedure Check_Unsigned is
+   type Pairs is delta 2.0 range 0.0 .. 2.0 ** (System.Max_Mantissa+1) - 1.0;
+   type Halves is delta 0.5 range 0.0 .. 2.0 ** (System.Max_Mantissa-1) - 1.0;
+   P1, P2, P3, P4 : Pairs;
+   H1, H2, H3, H4 : Halves;
+
+   procedure Dont_Opt is
+   -- keep optimizer from knowing the constant value of expressions
+   begin
+      if Report.Ident_Bool (False) then
+         P1 :=  2.0;  P2 := 4.0;  P3 := 6.0;
+         H1 :=  2.0;  H2 := 9.0;  H3 := 3.0;
+      end if;
+   end Dont_Opt;
+
+begin
+   H1 := 10.5;
+   H2 := Halves(2.0 ** (System.Max_Mantissa - 6));
+   H3 := 1.0;
+   P1 := 12.0;
+   P2 := Pairs'Last / 2;
+   P3 := Pairs'Last;
+   Dont_Opt;
+
+   P4 := Pairs (P1 * H1);     -- 12.0 * 10.5
+   if P4 /= 126.0 then
+      Report.Failed ("12.0 * 10.5 = " & Pairs'Image (P4));
+   end if;
+
+   H4 := Halves (P1 / H1);     -- 12.0 / 10.5
+   if H4 /= 1.0 and H4 /= 1.5 then
+      Report.Failed ("12.0 / 10.5 = " & Halves'Image (H4));
+   end if;
+
+   P4 := P3 * H3;     -- Pairs'Last * 1.0
+   if P4 /= Pairs'Last then
+      Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4));
+   end if;
+
+   P4 := P3 / H3;     -- Pairs'Last / 1.0
+   if P4 /= Pairs'Last then
+      Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4));
+   end if;
+
+   P4 := P1 * 0.25;     -- 12.0 * 0.25
+   if P4 /= 2.0 and P4 /= 4.0 then
+      Report.Failed ("12.0 * 0.25 = " & Pairs'Image (P4));
+   end if;
+
+   P4 := 100.5 / H1;   -- 100.5 / 10.5    = 9.571...
+   if P4 /= 8.0 and P4 /= 10.0 then
+      Report.Failed ("100.5/10.5 = " & Pairs'Image (P4));
+   end if;
+
+   H4 := H2 * 2;   --  2**(max_mantissa-6) * 2
+   if H4 /= Halves(2.0 ** (System.Max_Mantissa-5)) then
+      Report.Failed ("2**(System.Max_Mantissa-6) * 2=" & Halves'Image (H4) &
+                     " instead of " &
+                     Halves'Image( Halves(2.0 ** (System.Max_Mantissa-5)))); 
+   end if;
+
+exception
+   when others =>
+      Report.Failed ("unexpected exception in Check_Unsigned");
+end Check_Unsigned;
+
+
+
+procedure Check_Mixed is
+   type Pairs is delta 2.0 range -2.0 ** (System.Max_Mantissa) ..
+                                  2.0 ** (System.Max_Mantissa) - 1.0;
+   type Halves is delta 0.5 range 0.0 .. 2.0 ** (System.Max_Mantissa-1) - 1.0;
+   P1, P2, P3, P4 : Pairs;
+   H1, H2, H3, H4 : Halves;
+
+   procedure Dont_Opt is
+   -- keep optimizer from knowing the constant value of expressions
+   begin
+      if Report.Ident_Bool (False) then
+         P1 :=  2.0;  P2 := 4.0;  P3 := 6.0;
+         H1 :=  2.0;  H2 := 9.0;  H3 := 3.0;
+      end if;
+   end Dont_Opt;
+
+begin
+   H1 := 10.5;
+   H2 := Halves(2.0 ** (System.Max_Mantissa - 6));
+   H3 := 1.0;
+   P1 := 12.0;
+   P2 := -4.0;
+   P3 := Pairs'Last;
+   Dont_Opt;
+
+   P4 := Pairs (P1 * H1);     -- 12.0 * 10.5
+   if P4 /= 126.0 then
+      Report.Failed ("12.0 * 10.5 = " & Pairs'Image (P4));
+   end if;
+
+   H4 := Halves (P1 / H1);     -- 12.0 / 10.5
+   if H4 /= 1.0 and H4 /= 1.5 then
+      Report.Failed ("12.0 / 10.5 = " & Halves'Image (H4));
+   end if;
+
+   P4 := P3 * H3;     -- Pairs'Last * 1.0
+   if P4 /= Pairs'Last then
+      Report.Failed ("Pairs'Last * 1.0 = " & Pairs'Image (P4));
+   end if;
+
+   P4 := P3 / H3;     -- Pairs'Last / 1.0
+   if P4 /= Pairs'Last then
+      Report.Failed ("Pairs'Last / 1.0 = " & Pairs'Image (P4));
+   end if;
+
+   P4 := P1 * 0.25;   -- 12.0 * 0.25
+   if P4 = 3.0 then
+      null;    -- Perfect result
+   elsif Pairs'Small = 2.0 and then ( P4 = 2.0 or P4 = 4.0 ) then
+      null;    -- Allowed deviation
+   else
+      Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) &
+                     "and 12.0 * 0.25 = " & Pairs'Image (P4) );
+   end if;
+
+   P4 := 100.5 / H1;   -- 100.5 / 10.5    = 9.571...
+   if P4 = 9.0 then
+      null;    -- Perfect result
+   elsif Pairs'Small = 2.0 and then ( P4 = 8.0 or P4 = 10.0 ) then
+      null;    -- Allowed values
+   else
+     Report.Failed ("Pairs'Small =" & Pairs'Image (Pairs'Small) &
+                    "and 100.5/10.5 = " & Pairs'Image (P4) );
+   end if;
+
+   H4 := H2 * 2;   --  2**(max_mantissa-6) * 2
+   if H4 /= Halves(2.0 ** (System.Max_Mantissa-5)) then
+      Report.Failed ("2**(System.Max_Mantissa-6) * 2=" & Halves'Image (H4) &
+                     " instead of " &
+                     Halves'Image( Halves(2.0 ** (System.Max_Mantissa-5)))); 
+   end if;
+
+   P4 := Pairs(P1 * 6) / P2;    -- 12 * 6 / -4
+   if (P4 /= -18.0)  then
+      Report.Failed ("12*6/-4 = " & Pairs'Image(P4));
+   end if;
+
+   P4 := Halves(P1 * 6.0) / P2;    -- 12 * 6 / -4
+   if (P4 /= -18.0)  then
+      Report.Failed ("Halves(12*6)/-4 = " & Pairs'Image(P4));
+   end if;
+
+exception
+   when others =>
+      Report.Failed ("unexpected exception in Check_Mixed");
+end Check_Mixed;
+
+
+begin  -- main
+   Report.Test ("CXG2022",
+                "Check the accuracy of multiplication and division" &
+                " of binary fixed point numbers"); 
+   if Verbose then
+      Report.Comment ("starting signed test");
+   end if;
+   Check_Signed;
+
+   if Verbose then
+      Report.Comment ("starting unsigned test");
+   end if;
+   Check_Unsigned;
+
+   if Verbose then
+      Report.Comment ("starting mixed sign test");
+   end if;
+   Check_Mixed;
+
+   Report.Result;
+end CXG2022;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2023.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2023.a
new file mode 100644
index 000000000..0cdd5574e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2023.a
@@ -0,0 +1,351 @@
+-- CXG2023.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 multiplication and division of decimal fixed point 
+--      numbers produce exact results.
+--
+-- TEST DESCRIPTION:
+--      Check that multiplication and division of decimal fixed point 
+--      numbers produce exact results.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--      This test applies only to implementations supporting
+--      decimal fixed point types of at least 9 digits.
+--
+--
+-- CHANGE HISTORY:
+--       3 Apr 96   SAIC    Initial release for 2.1
+--
+--!
+
+with System;
+with Report;
+procedure CXG2023 is
+   Verbose : constant Boolean := False;
+
+procedure Check_1 is
+   Num_Digits : constant := 6;
+   type Pennies is delta 0.01 digits Num_Digits;
+   type Franklins is delta 100.0 digits Num_Digits;
+   type Dollars is delta 1.0 digits Num_Digits;
+
+   P1 : Pennies;
+   F1 : Franklins;
+   D1 : Dollars;
+
+   -- optimization thwarting functions
+
+   function P (X : Pennies) return Pennies is
+   begin
+      if Report.Ident_Bool (True) then
+          return X;
+      else
+          return 3.21;    -- never executed
+      end if;
+   end P;
+
+
+   function F (X : Franklins) return Franklins is
+   begin
+      if Report.Ident_Bool (True) then
+          return X;
+      else
+          return 32100.0;    -- never executed
+      end if;
+   end F;
+
+
+   function D (X : Dollars) return Dollars is
+   begin
+      if Report.Ident_Bool (True) then
+          return X;
+      else
+          return 321.0;    -- never executed
+      end if;
+   end D;
+
+
+begin
+   -- multiplication where one operand is universal real
+
+   P1 := P(0.05) * 200.0;
+   if P1 /= 10.00 then
+      Report.Failed ("1 - expected 10.00  got " & Pennies'Image (P1));
+   end if;
+
+   D1 := P(0.05) * 100.0;
+   if D1 /= 5.00 then
+      Report.Failed ("2 - expected 5.00  got " & Dollars'Image (D1));
+   end if;
+
+   F1 := P(0.05) * 50_000.0;
+   if F1 /= 2500.00 then
+      Report.Failed ("3 - expected 2500.0  got " & Franklins'Image (F1));
+   end if;
+
+   -- multiplication where both operands are decimal fixed
+
+   P1 := P(0.05) * D(-200.0);
+   if P1 /= -10.00 then
+      Report.Failed ("4 - expected -10.00  got " & Pennies'Image (P1));
+   end if;
+
+   D1 := P(0.05) * P(-100.0);
+   if D1 /= -5.00 then
+      Report.Failed ("5 - expected -5.00  got " & Dollars'Image (D1));
+   end if;
+
+   F1 := P(-0.05) * F(50_000.0);
+   if F1 /= -2500.00 then
+      Report.Failed ("6 - expected -2500.0  got " & Franklins'Image (F1));
+   end if;
+
+   -- division where one operand is universal real
+
+   P1 := P(0.05) / 0.001;
+   if P1 /= 50.00 then
+      Report.Failed ("7 - expected 50.00  got " & Pennies'Image (P1));
+   end if;
+
+   D1 := D(1000.0) / 3.0;
+   if D1 /= 333.00 then
+      Report.Failed ("8 - expected 333.00  got " & Dollars'Image (D1));
+   end if;
+
+   F1 := P(1234.56) / 0.0001;
+   if F1 /= 12345600.00 then
+      Report.Failed ("9 - expected 12345600.0  got " & Franklins'Image (F1));
+   end if;
+
+
+   -- division where both operands are decimal fixed
+
+   P1 := P(0.05) / D(1.0);
+   if P1 /= 0.05 then
+      Report.Failed ("10 - expected 0.05  got " & Pennies'Image (P1));
+   end if;
+
+       -- check for truncation toward 0
+   D1 := P(-101.00) / P(2.0);
+   if D1 /= -50.00 then
+      Report.Failed ("11 - expected -50.00  got " & Dollars'Image (D1));
+   end if;
+
+   P1 := P(-102.03) / P(-0.5);
+   if P1 /= 204.06 then
+      Report.Failed ("12 - expected 204.06  got " & Pennies'Image (P1));
+   end if;
+
+   F1 := P(876.54) / P(0.03);
+   if F1 /= 29200.00 then
+      Report.Failed ("13 - expected 29200.0  got " & Franklins'Image (F1));
+   end if;
+
+exception
+   when others =>
+      Report.Failed ("unexpected exception in Check_1");
+end Check_1;
+
+generic
+   type Pennies   is delta<> digits<>;
+   type Dollars   is delta<> digits<>;
+   type Franklins is delta<> digits<>;
+procedure Generic_Check;
+procedure Generic_Check is
+
+   -- the following code is copied directly from the
+   -- above procedure Check_1
+
+   P1 : Pennies;
+   F1 : Franklins;
+   D1 : Dollars;
+
+   -- optimization thwarting functions
+
+   function P (X : Pennies) return Pennies is
+   begin
+      if Report.Ident_Bool (True) then
+          return X;
+      else
+          return 3.21;    -- never executed
+      end if;
+   end P;
+
+
+   function F (X : Franklins) return Franklins is
+   begin
+      if Report.Ident_Bool (True) then
+          return X;
+      else
+          return 32100.0;    -- never executed
+      end if;
+   end F;
+
+
+   function D (X : Dollars) return Dollars is
+   begin
+      if Report.Ident_Bool (True) then
+          return X;
+      else
+          return 321.0;    -- never executed
+      end if;
+   end D;
+
+
+begin
+   -- multiplication where one operand is universal real
+
+   P1 := P(0.05) * 200.0;
+   if P1 /= 10.00 then
+      Report.Failed ("1 - expected 10.00  got " & Pennies'Image (P1));
+   end if;
+
+   D1 := P(0.05) * 100.0;
+   if D1 /= 5.00 then
+      Report.Failed ("2 - expected 5.00  got " & Dollars'Image (D1));
+   end if;
+
+   F1 := P(0.05) * 50_000.0;
+   if F1 /= 2500.00 then
+      Report.Failed ("3 - expected 2500.0  got " & Franklins'Image (F1));
+   end if;
+
+   -- multiplication where both operands are decimal fixed
+
+   P1 := P(0.05) * D(-200.0);
+   if P1 /= -10.00 then
+      Report.Failed ("4 - expected -10.00  got " & Pennies'Image (P1));
+   end if;
+
+   D1 := P(0.05) * P(-100.0);
+   if D1 /= -5.00 then
+      Report.Failed ("5 - expected -5.00  got " & Dollars'Image (D1));
+   end if;
+
+   F1 := P(-0.05) * F(50_000.0);
+   if F1 /= -2500.00 then
+      Report.Failed ("6 - expected -2500.0  got " & Franklins'Image (F1));
+   end if;
+
+   -- division where one operand is universal real
+
+   P1 := P(0.05) / 0.001;
+   if P1 /= 50.00 then
+      Report.Failed ("7 - expected 50.00  got " & Pennies'Image (P1));
+   end if;
+
+   D1 := D(1000.0) / 3.0;
+   if D1 /= 333.00 then
+      Report.Failed ("8 - expected 333.00  got " & Dollars'Image (D1));
+   end if;
+
+   F1 := P(1234.56) / 0.0001;
+   if F1 /= 12345600.00 then
+      Report.Failed ("9 - expected 12345600.0  got " & Franklins'Image (F1));
+   end if;
+
+
+   -- division where both operands are decimal fixed
+
+   P1 := P(0.05) / D(1.0);
+   if P1 /= 0.05 then
+      Report.Failed ("10 - expected 0.05  got " & Pennies'Image (P1));
+   end if;
+
+       -- check for truncation toward 0
+   D1 := P(-101.00) / P(2.0);
+   if D1 /= -50.00 then
+      Report.Failed ("11 - expected -50.00  got " & Dollars'Image (D1));
+   end if;
+
+   P1 := P(-102.03) / P(-0.5);
+   if P1 /= 204.06 then
+      Report.Failed ("12 - expected 204.06  got " & Pennies'Image (P1));
+   end if;
+
+   F1 := P(876.54) / P(0.03);
+   if F1 /= 29200.00 then
+      Report.Failed ("13 - expected 29200.0  got " & Franklins'Image (F1));
+   end if;
+
+end Generic_Check;
+
+
+procedure Check_G6 is
+   Num_Digits : constant := 6;
+   type Pennies is delta 0.01 digits Num_Digits;
+   type Franklins is delta 100.0 digits Num_Digits;
+   type Dollars is delta 1.0 digits Num_Digits;
+
+   procedure G is new Generic_Check (Pennies, Dollars, Franklins);
+begin
+   G;
+end Check_G6;
+
+
+procedure Check_G9 is
+   Num_Digits : constant := 9;
+   type Pennies is delta 0.01 digits Num_Digits;
+   type Franklins is delta 100.0 digits Num_Digits;
+   type Dollars is delta 1.0 digits Num_Digits;
+
+   procedure G is new Generic_Check (Pennies, Dollars, Franklins);
+begin
+   G;
+end Check_G9;
+
+
+begin  -- main
+   Report.Test ("CXG2023",
+                "Check the accuracy of multiplication and division" &
+                " of decimal fixed point numbers"); 
+
+   if Verbose then
+      Report.Comment ("starting Check_1");
+   end if;
+   Check_1;
+
+   if Verbose then
+      Report.Comment ("starting Check_G6");
+   end if;
+   Check_G6;
+
+   if Verbose then
+      Report.Comment ("starting Check_G9");
+   end if;
+   Check_G9;
+
+   Report.Result;
+end CXG2023;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2024.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2024.a
new file mode 100644
index 000000000..55648283e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxg/cxg2024.a
@@ -0,0 +1,191 @@
+-- CXG2024.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 multiplication and division of decimal 
+--      and binary fixed point numbers that result in a
+--      decimal fixed point type produce acceptable results.
+--
+-- TEST DESCRIPTION:
+--      Multiplication and division of mixed binary and decimal
+--      values are performed.  Identity functions are used so 
+--      that the operands of the expressions will not be seen
+--      as static by the compiler.
+--
+-- SPECIAL REQUIREMENTS
+--      The Strict Mode for the numerical accuracy must be
+--      selected.  The method by which this mode is selected
+--      is implementation dependent.
+--
+-- APPLICABILITY CRITERIA:
+--      This test applies only to implementations supporting the
+--      Numerics Annex.
+--      This test only applies to the Strict Mode for numerical
+--      accuracy.
+--      This test applies only to implementations supporting
+--      decimal fixed point types of at least 9 digits.
+--
+--
+-- CHANGE HISTORY:
+--       4 Apr 96   SAIC    Initial release for 2.1
+--      17 Aug 96   SAIC    Removed checks for close results
+--
+--!
+
+with System;
+with Report;
+procedure CXG2024 is
+
+procedure Do_Check is
+   Num_Digits : constant := 9;
+   type Pennies is delta 0.01 digits Num_Digits;
+   type Dollars is delta 1.0 digits Num_Digits;
+
+   type Signed_Sixteenths is delta 0.0625 
+          range -2.0 ** (System.Max_Mantissa-5) ..
+                 2.0 ** (System.Max_Mantissa-5) - 1.0;
+   type Unsigned_Sixteenths is delta 0.0625 
+          range 0.0 .. 2.0 ** (System.Max_Mantissa-4) - 1.0;
+
+   P1 : Pennies;
+   D1 : Dollars;
+
+   -- optimization thwarting functions
+
+   function P (X : Pennies) return Pennies is
+   begin
+      if Report.Ident_Bool (True) then
+          return X;
+      else
+          return 3.21;    -- never executed
+      end if;
+   end P;
+
+
+   function D (X : Dollars) return Dollars is
+   begin
+      if Report.Ident_Bool (True) then
+          return X;
+      else
+          return 321.0;    -- never executed
+      end if;
+   end D;
+
+
+   function US (X : Unsigned_Sixteenths) return Unsigned_Sixteenths is
+   begin
+      if Report.Ident_Bool (True) then
+          return X;
+      else
+          return 321.0;    -- never executed
+      end if;
+   end US;
+
+
+   function SS (X : Signed_Sixteenths) return Signed_Sixteenths is
+   begin
+      if Report.Ident_Bool (True) then
+          return X;
+      else
+          return 321.0;    -- never executed
+      end if;
+   end SS;
+
+
+begin
+
+   P1 := P(0.05) * SS(-200.0);
+   if P1 /= -10.00 then
+         Report.Failed ("1 - expected -10.00  got " & Pennies'Image (P1));
+   end if;
+
+   D1 := P(0.05) * SS(-100.0);
+   if D1 /= -5.00 then
+         Report.Failed ("2 - expected -5.00  got " & Dollars'Image (D1));
+   end if;
+
+   P1 := P(0.05) * US(200.0);
+   if P1 /= 10.00 then
+         Report.Failed ("3 - expected 10.00  got " & Pennies'Image (P1));
+   end if;
+
+   D1 := P(-0.05) * US(100.0);
+   if D1 /= -5.00 then
+         Report.Failed ("4 - expected -5.00  got " & Dollars'Image (D1));
+   end if;
+
+
+
+   P1 := P(0.05) / US(1.0);
+   if P1 /= 0.05 then
+         Report.Failed ("6 - expected 0.05  got " & Pennies'Image (P1));
+   end if;
+
+  
+   -- check rounding
+
+   D1 := Dollars'Round (Pennies (P(-101.00) / US(2.0)));
+   if D1 /= -51.00 then
+         Report.Failed ("11 - expected -51.00  got " & Dollars'Image (D1));
+   end if;
+
+   D1 := Dollars'Round (Pennies (P(101.00) / US(2.0)));
+   if D1 /= 51.00 then
+         Report.Failed ("12 - expected 51.00  got " & Dollars'Image (D1));
+   end if;
+
+   D1 := Dollars'Round (Pennies (SS(-101.00) / P(2.0)));
+   if D1 /= -51.00 then
+         Report.Failed ("13 - expected -51.00  got " & Dollars'Image (D1));
+   end if;
+
+   D1 := Dollars'Round (Pennies (US(101.00) / P(2.0)));
+   if D1 /= 51.00 then
+         Report.Failed ("14 - expected 51.00  got " & Dollars'Image (D1));
+   end if;
+
+
+
+   P1 := P(-102.03) / SS(-0.5);
+   if P1 /= 204.06 then
+         Report.Failed ("15 - expected 204.06  got " & Pennies'Image (P1));
+   end if;
+
+
+exception
+   when others =>
+      Report.Failed ("unexpected exception in Do_Check");
+end Do_Check;
+
+
+begin  -- main
+   Report.Test ("CXG2024",
+                "Check the accuracy of multiplication and division" &
+                " of mixed decimal and binary fixed point numbers"); 
+
+   Do_Check;
+
+   Report.Result;
+end CXG2024;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh3001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh3001.a
new file mode 100644
index 000000000..4ed41b4d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh3001.a
@@ -0,0 +1,243 @@
+-- CXH3001.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 pragma Reviewable.
+--     Check that pragma Reviewable is accepted as a configuration pragma.
+--
+-- TEST DESCRIPTION
+--     The test requires that the configuration pragma Reviewable
+--     be processed.  The following package contains a simple "one of each
+--     construct in the language" to check that the configuration pragma has
+--     not disallowed some feature of the language.  This test should generate
+--     no errors.
+--
+-- APPLICABILITY CRITERIA:
+--      This test is only applicable for a compiler attempting validation
+--      for the Safety and Security Annex.
+--
+-- PASS/FAIL CRITERIA:
+--      This test passes if it correctly compiles, executes, and reports PASS.
+--      It fails if the pragma is rejected.  The effect of the pragma should
+--      be to produce a listing with information, including warnings, as
+--      required in H.3.1. Specific form and contents of this listing are not
+--      required by this test and are not part of the PASS/FAIL criteria.
+--
+-- SPECIAL REQUIREMENTS
+--      The implementation must process a configuration pragma which is not
+--      part of any Compilation Unit; the method employed is implementation
+--      defined.
+--
+--      Pragma Reviewable requires that the implementation provide the
+--      following information for the compilation units in this test:
+--
+--        o Where compiler-generated run-time checks remain (6)
+--
+--        o Identification of any construct with a language-defined check
+--          that is recognized prior to runtime as certain to fail if
+--          executed (7)
+--
+--        o For each reference to a scalar object, an identification of
+--          the reference as either "known to be initialized,"
+--          or "possibly uninitialized" (8)
+--
+--        o Where run-time support routines are implicitly invoked (9)
+--
+--        o An object code listing including: (10)
+--
+--          o Machine instructions with relative offsets (11)
+--
+--          o Where each data object is stored during its lifetime (12)
+--
+--          o Correspondence with the source program (13)
+--
+--        o Identification of each construct for which the implementation
+--          detects the possibility of erroneous execution (14)
+--
+--        o For each subprogram, block, task or other construct implemented by
+--          reserving and subsequently freezing an area of the run-time stack,
+--          an identification of the length of the fixed-size portion of
+--          the area and an indication of whether the non-fixed size portion
+--          is reserved on the stack or in a dynamically managed storage
+--          region (15)
+--
+--
+-- CHANGE HISTORY:
+--      26 OCT 95   SAIC   Initial version
+--      12 NOV 96   SAIC   Revised for 2.1
+--      27 AUG 99   RLB    Removed result dependence on uninitialized object.
+--      30 AUG 99   RLB    Repaired the above.
+--
+--!
+
+---------------------------- CONFIGURATION PRAGMAS -----------------------
+
+pragma Reviewable;                                                -- OK
+                                                -- configuration pragma
+
+------------------------ END OF CONFIGURATION PRAGMAS --------------------
+
+
+----------------------------------------------------------------- CXH3001_0
+
+package CXH3001_0 is
+
+  type Enum is (Item,Stuff,Things);
+
+  type Int is range 0..256;
+
+  type Unt is mod 256;
+
+  type Flt is digits 5;
+
+  type Fix is delta 0.5 range -1.0..1.0;
+
+  type Root(Disc: Enum) is tagged record
+    I: Int; U:Unt;
+  end record;
+
+  type List is array(Unt) of Root(Stuff);
+
+  type A_List is access List;
+  type A_Proc is access procedure(R:Root);
+
+  procedure P(R:Root);
+
+  function F return A_Proc;
+
+  protected PT is
+    entry Set(Switch: Boolean);
+    function Enquire return Boolean;
+  private
+    Toggle : Boolean;
+  end PT;
+
+  task TT is
+    entry Release;
+  end TT;
+
+  Global_Variable : Boolean := False;
+
+end CXH3001_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+with Report;
+package body CXH3001_0 is
+
+ procedure P(R:Root) is
+    Warnable : Positive := 0; -- (7)                      -- OPTIONAL WARNING
+    -- this would raise Constraint_Error if P were ever called, however
+    -- this test never calls P.
+  begin
+    case R.Disc is
+      when Item   => Report.Comment("Got Item");
+      when Stuff  => Report.Comment("Got Stuff");
+      when Things => Report.Comment("Got Things");
+    end case;
+    if Report.Ident_Int( Warnable ) = 0 then
+      Global_Variable := not Global_Variable; -- (8) known to be initialized
+    end if;
+  end P;
+
+  function F return A_Proc is
+  begin
+    return P'Access;
+  end F;
+
+  protected body PT is
+
+    entry Set(Switch: Boolean) when True is
+    begin
+      Toggle := Switch;
+    end Set;
+
+    function Enquire return Boolean is
+    begin
+      return Toggle;
+    end Enquire;
+
+  end PT;
+
+  task body TT is
+  begin
+    loop
+      accept Release;
+      exit when Global_Variable;
+    end loop;
+  end TT;
+
+  -- (9) TT activation
+end CXH3001_0;
+
+------------------------------------------------------------------- CXH3001
+
+with Report;
+with CXH3001_0;
+procedure CXH3001 is
+begin
+  Report.Test("CXH3001", "Check pragma Reviewable as a configuration pragma");
+
+  Block: declare
+    A_Truth : Boolean;
+    Message : String := Report.Ident_Str( "Bad value encountered" );
+  begin
+    begin
+      A_Truth := Report.Ident_Bool( True ) or A_Truth;  -- (8) not initialized
+      if not A_Truth then
+        Report.Comment ("True or Uninit = False");
+        A_Truth := Report.Ident_Bool (True);
+      else
+        A_Truth := Report.Ident_Bool (True);
+          -- We do this separately on each branch in order to insure that a
+          -- clever optimizer can find out little about this value. Ident_Bool
+          -- is supposed to be opaque to any optimizer.
+      end if;
+    exception
+      when Constraint_Error | Program_Error =>
+           -- Possible results of accessing an uninitialized object.
+        A_Truth := Report.Ident_Bool (True);
+    end;
+
+    CXH3001_0.PT.Set( A_Truth );
+
+    CXH3001_0.Global_Variable := A_Truth;
+
+    CXH3001_0.TT.Release;  -- (9) rendezvous with TT
+
+    while CXH3001_0.TT'Callable loop
+      delay 1.0; -- wait for TT to become non-callable
+    end loop;
+
+    if   not CXH3001_0.PT.Enquire
+      or not CXH3001_0.Global_Variable
+      or CXH3001_0.TT'Callable then
+      Report.Failed(Message);
+    end if;
+
+  end Block;
+
+  Report.Result;
+end CXH3001;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a
new file mode 100644
index 000000000..5e9f7b9cc
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a
@@ -0,0 +1,343 @@
+-- CXH3002.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 pragma Inspection_Point is allowed whereever a declarative
+--     item or statement is allowed.  Check that pragma Inspection_Point may
+--     have zero or more arguments.  Check that the execution of pragma
+--     Inspection_Point has no effect.
+--
+-- TEST DESCRIPTION
+--     Check pragma Inspection_Point applied to:
+--       A no objects,
+--       B one object,
+--       C multiple objects.
+--     Check pragma Inspection_Point applied to:
+--       D Enumeration type objects,
+--       E Integer type objects (signed and unsigned),
+--       F access type objects,
+--       G Floating Point type objects,
+--       H Fixed point type objects,
+--       I array type objects,
+--       J record type objects,
+--       K tagged type objects,
+--       L protected type objects,
+--       M controlled type objects,
+--       N task type objects.
+--     Check pragma Inspection_Point applied in:
+--       O declarations (package, procedure)
+--       P statements (incl package elaboration)
+--       Q subprogram (procedure, function, finalization)
+--       R package
+--       S specification
+--       T body (PO entry, task body, loop body, accept body, select body)
+--       U task
+--       V protected object
+--
+--
+-- APPLICABILITY CRITERIA:
+--      This test is only applicable for a compiler attempting validation
+--      for the Safety and Security Annex.
+--
+--
+-- CHANGE HISTORY:
+--      26 OCT 95   SAIC   Initial version
+--      12 NOV 96   SAIC   Revised for 2.1
+--
+--!
+
+----------------------------------------------------------------- CXH3002_0
+
+package CXH3002_0 is
+
+  type Enum is (Item,Stuff,Things);
+
+  type Int  is range 0..256;
+
+  type Unt  is mod 256;
+
+  type Flt  is digits 5;
+
+  type Fix  is delta 0.5 range -1.0..1.0;
+
+  type Root(Disc: Enum) is record
+    I: Int;
+    U: Unt;
+  end record;
+
+  type List   is array(Unt) of Root(Stuff);
+
+  type A_List is access all List;
+  type A_Proc is access procedure(R:Root);
+
+  procedure Proc(R:Root);
+  function  Func return A_Proc;
+
+  protected type PT is
+    entry Prot_Entry(Switch: Boolean);
+  private
+    Toggle : Boolean := False;
+  end PT;
+
+  task type TT is
+    entry Task_Entry(Items: in A_List);
+  end TT;
+
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+  pragma Inspection_Point;                                          -- AORS
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+
+end CXH3002_0;
+
+----------------------------------------------------------------- CXH3002_1
+
+with Ada.Finalization;
+package CXH3002_0.CXH3002_1 is
+
+  type Final is new Ada.Finalization.Controlled with 
+    record
+      Value : Natural;
+    end record;
+
+  procedure Initialize( F: in out Final );
+  procedure Adjust( F: in out Final );
+  procedure Finalize( F: in out Final );
+
+end CXH3002_0.CXH3002_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- CXH3002_0
+
+package body CXH3002_0 is
+
+  Global_Variable : Character := 'A';
+
+  procedure Proc(R:Root) is
+  begin
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+    pragma Inspection_Point( Global_Variable );                     -- BDPQT
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+    case R.Disc is
+      when Item   => Global_Variable := 'I';
+      when Stuff  => Global_Variable := 'S';
+      when Things => Global_Variable := 'T';
+    end case;
+ end Proc;
+
+  function Func return A_Proc is
+  begin
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+    pragma Inspection_Point;                                        -- APQT
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+    return Proc'Access;
+  end Func;
+
+  protected body PT is
+    entry Prot_Entry(Switch: Boolean) when True is
+      begin
+        Toggle := Switch;
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+        pragma Inspection_Point;                                    -- APVT
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+      end Prot_Entry;
+  end PT;
+
+  task body TT is
+    List_Copy : A_List;
+  begin
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+    pragma Inspection_Point;                                        -- APUT
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+    loop
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+      pragma Inspection_Point;                                      -- APUT
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+      select
+        accept Task_Entry(Items: in A_List) do
+          List_Copy := Items;
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+          pragma Inspection_Point( List_Copy );                     -- BFPUT
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+        end Task_Entry;
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+        pragma Inspection_Point;                                    -- APUT
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+      or terminate;
+      end select;
+    end loop;
+  end TT;
+
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+  pragma Inspection_Point;                                           -- ARTO
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+
+end CXH3002_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- CXH3002_1
+
+with Report;
+package body CXH3002_0.CXH3002_1 is
+
+  Embedded_Final_Object : Final
+                        := (Ada.Finalization.Controlled with Value => 1);
+                        -- attempt to call Initialize here would P_E!
+
+  procedure Initialize( F: in out Final ) is
+  begin
+    F.Value := 1;
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+    pragma Inspection_Point( Embedded_Final_Object );                -- BKQP
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+  end Initialize;
+
+  procedure Adjust( F: in out Final ) is
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+    pragma Inspection_Point;                                          -- AQO
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+  begin
+    F.Value := 2;
+  end Adjust;
+
+  procedure Finalize( F: in out Final ) is
+  begin
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+    pragma Inspection_Point;                                         -- AQP
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+    if F.Value not in 1..10 then
+      Report.Failed("Bad value in controlled object at finalization");
+    end if;
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+    pragma Inspection_Point;                                         -- AQP
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====
+  end Finalize;
+
+begin
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---======
+  pragma Inspection_Point( Embedded_Final_Object );                  -- BKRTP
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---======
+  null;
+end CXH3002_0.CXH3002_1;
+
+------------------------------------------------------------------- CXH3002
+
+with Report;
+with CXH3002_0.CXH3002_1;
+procedure CXH3002 is
+
+  use type CXH3002_0.Enum, CXH3002_0.Int, CXH3002_0.Unt, CXH3002_0.Flt,
+           CXH3002_0.Fix,  CXH3002_0.Root;
+
+  Main_Enum  : CXH3002_0.Enum := CXH3002_0.Item;
+  Main_Int   : CXH3002_0.Int;
+  Main_Unt   : CXH3002_0.Unt;
+  Main_Flt   : CXH3002_0.Flt;
+  Main_Fix   : CXH3002_0.Fix;
+  Main_Rec   : CXH3002_0.Root(CXH3002_0.Stuff) 
+               := (CXH3002_0.Stuff, I => 1, U => 2);
+
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+  pragma Inspection_Point( Main_Rec );                               -- BJQO
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---=====
+
+  Main_List   : CXH3002_0.List := ( others => Main_Rec );
+
+  Main_A_List : CXH3002_0.A_List := new CXH3002_0.List'( others => Main_Rec );
+  Main_A_Proc : CXH3002_0.A_Proc := CXH3002_0.Func;
+                                 -- CXH3002_0.Proc'Access
+  Main_PT     : CXH3002_0.PT;
+  Main_TT     : CXH3002_0.TT;
+
+  type Test_Range is (First, Second);
+
+  procedure Assert( Truth : Boolean; Message : String ) is
+  begin
+    if not Truth then
+      Report.Failed( "Unexpected value found in " & Message );
+    end if;
+  end Assert;
+
+begin  -- Main test procedure.
+
+  Report.Test ("CXH3002", "Check pragma Inspection_Point" );
+   
+ Enclosure:declare
+   Main_Final : CXH3002_0.CXH3002_1.Final;
+   Xtra_Final : CXH3002_0.CXH3002_1.Final;
+ begin
+  for Test_Case in Test_Range loop
+
+
+    case Test_Case is
+      when First  =>
+        Main_Final.Value := 5;
+        Xtra_Final := Main_Final; -- call Adjust
+        Main_Enum  := CXH3002_0.Things;
+        Main_Int   := CXH3002_0.Int'First;
+        Main_Unt   := CXH3002_0.Unt'Last;
+        Main_Flt   := 3.14;
+        Main_Fix   := 0.5;
+        Main_Rec   := (CXH3002_0.Stuff, I => 3, U => 4);
+        Main_List(Main_Unt) := Main_Rec;
+        Main_A_List(CXH3002_0.Unt'First) := (CXH3002_0.Stuff, I => 5, U => 6);
+        Main_A_Proc( Main_A_List(2) );
+        Main_PT.Prot_Entry(True);
+        Main_TT.Task_Entry( null );
+
+      when Second =>
+        Assert( Main_Final.Value = 5, "Main_Final" );
+        Assert( Xtra_Final.Value = 2, "Xtra_Final" );
+        Assert( Main_Enum = CXH3002_0.Things, "Main_Enum" );
+        Assert( Main_Int = CXH3002_0.Int'First, "Main_Int" );
+        Assert( Main_Unt = CXH3002_0.Unt'Last, "Main_Unt" );
+        Assert( Main_Flt in 3.0..3.5, "Main_Flt" );
+        Assert( Main_Fix = 0.5, "Main_Fix" );
+        Assert( Main_Rec = (CXH3002_0.Stuff, I => 3, U => 4), "Main_Rec" );
+        Assert( Main_List(Main_Unt) = Main_Rec, "Main_List" );
+        Assert( Main_A_List(CXH3002_0.Unt'First)
+                  = (CXH3002_0.Stuff, I => 5, U => 6), "Main_A_List" );
+
+   end case; 
+
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==
+    pragma Inspection_Point(                                       -- CQP
+                      Main_Final,                                    -- M
+                      Main_Enum,                                     -- D
+                      Main_Int,                                      -- E
+                      Main_Unt,                                      -- E
+                      Main_Flt,                                      -- G
+                      Main_Fix,                                      -- H
+                      Main_Rec,                                      -- J
+                      Main_List,                                     -- I
+                      Main_A_List,                                   -- F
+                      Main_A_Proc,                                   -- F
+                      Main_PT,                                       -- L
+                      Main_TT );                                     -- N
+  -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==
+
+  end loop;
+ end Enclosure;
+
+  Report.Result;
+
+end CXH3002;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh30030.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh30030.a
new file mode 100644
index 000000000..1b1399c59
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh30030.a
@@ -0,0 +1,54 @@
+-- CXH30030.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
+--     See CHX30031.AM
+--
+-- TEST DESCRIPTION
+--     See CHX30031.AM
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--      => CXH30030.A
+--         CXH30031.AM
+--
+-- APPLICABILITY CRITERIA:
+--     See CHX30031.AM
+--
+-- SPECIAL REQUIREMENTS
+--     See CHX30031.AM
+--
+-- CHANGE HISTORY:
+--      26 OCT 95   SAIC   Initial version for 2.1
+--      07 JUN 96   SAIC   Revised by reviewer request, split to multifile
+--
+--!
+
+  pragma Reviewable;
+
+-- This test requires that this configuration pragma be applied to all
+-- following compilation units in the environment; specifically the ones
+-- in file CXH30031.AM
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh30031.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh30031.am
new file mode 100644
index 000000000..91bf3e8a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cxh/cxh30031.am
@@ -0,0 +1,215 @@
+-- CXH30031.AM
+--
+--                             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 pragma Reviewable.
+--     Check that pragma Reviewable is accepted as a configuration pragma.
+--
+-- TEST DESCRIPTION
+--     This test checks that pragma Reviewable is processed as a
+--     configuration pragma.  See CXH3001 for testing pragma Reviewable as
+--     other than a configuration pragma.
+--
+-- TEST FILES:
+--      The following files comprise this test:
+--
+--         CXH30030.A
+--      => CXH30031.AM
+--
+-- APPLICABILITY CRITERIA:
+--      This test is only applicable for a compiler attempting validation
+--      for the Safety and Security Annex.
+--
+-- SPECIAL REQUIREMENTS
+--      The implementation must process a configuration pragma which is not
+--      part of any Compilation Unit; the method employed is implementation
+--      defined.
+--
+--
+-- CHANGE HISTORY:
+--      26 OCT 95   SAIC   Initial version for 2.1
+--      07 JUN 96   SAIC   Revised by reviewer request
+--      03 NOV 96   SAIC   Documentation revision
+--
+--      03 NOV 96   Keith  Documentation revision
+--      27 AUG 99   RLB    Removed result dependence on uninitialized object.
+--      30 AUG 99   RLB    Repaired the above.
+--
+--!
+
+  pragma Reviewable;
+
+----------------------------------------------------------------- CXH3003_0
+
+package CXH3003_0 is
+
+  type Enum is (Item,Stuff,Things);
+
+  type Int is range 0..256;
+
+  type Unt is mod 256;
+
+  type Flt is digits 5;
+
+  type Fix is delta 0.5 range -1.0..1.0;
+
+  type Root(Disc: Enum) is tagged record
+    I: Int; U:Unt;
+  end record;
+
+  type List is array(Unt) of Root(Stuff);
+
+  type A_List is access List;
+  type A_Proc is access procedure(R:Root);
+
+  procedure P(R:Root);
+
+  function F return A_Proc;
+
+  Global_Variable : Boolean := False;
+
+end CXH3003_0;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+with Report;
+package body CXH3003_0 is
+
+ procedure P(R:Root) is
+    Warnable : Positive := 0;                             -- OPTIONAL WARNING
+  begin
+    case R.Disc is
+      when Item   => Report.Comment("Got Item");
+      when Stuff  => Report.Comment("Got Stuff");
+      when Things => Report.Comment("Got Things");
+    end case;
+    if Report.Ident_Int( Warnable ) = 0 then
+      Global_Variable := not Global_Variable;     -- known to be initialized
+    end if;
+  end P;
+
+  function F return A_Proc is
+  begin
+    return P'Access;
+  end F;
+
+end CXH3003_0;
+
+----------------------------------------------------------------- CXH3003_1
+
+package CXH3003_0.CXH3003_1 is
+
+  protected PT is
+    entry Set(Switch: Boolean);
+    function Enquire return Boolean;
+  private
+    Toggle : Boolean;
+  end PT;
+
+  task TT is
+    entry Release;
+  end TT;
+
+end CXH3003_0.CXH3003_1;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+package body CXH3003_0.CXH3003_1 is
+
+  protected body PT is
+
+    entry Set(Switch: Boolean) when True is
+    begin
+      Toggle := Switch;
+    end Set;
+
+    function Enquire return Boolean is
+    begin
+      return Toggle;
+    end Enquire;
+
+  end PT;
+
+  task body TT is
+  begin
+    loop
+      accept Release;
+      exit when Global_Variable;
+    end loop;
+  end TT;
+
+ -- TT activation
+
+end CXH3003_0.CXH3003_1;
+
+------------------------------------------------------------------- CXH3003
+
+with Report;
+with CXH3003_0.CXH3003_1;
+procedure CXH30031 is
+begin
+
+  Report.Test("CXH3003", "Check pragma Reviewable as a configuration pragma");
+
+  Block: declare
+    A_Truth : Boolean;
+    Message : String := Report.Ident_Str( "Bad value encountered" );
+  begin
+    begin
+      A_Truth := Report.Ident_Bool( True ) or A_Truth;  -- not initialized
+      if not A_Truth then
+        Report.Comment ("True or Uninit = False");
+        A_Truth := Report.Ident_Bool (True);
+      else
+        A_Truth := Report.Ident_Bool (True);
+          -- We do this separately on each branch in order to insure that a
+          -- clever optimizer can find out little about this value. Ident_Bool
+          -- is supposed to be opaque to any optimizer.
+      end if;
+    exception
+      when Constraint_Error | Program_Error =>
+           -- Possible results of accessing an uninitialized object.
+        A_Truth := Report.Ident_Bool (True);
+    end;
+
+    CXH3003_0.CXH3003_1.PT.Set( A_Truth );
+
+    CXH3003_0.Global_Variable := A_Truth;
+
+    CXH3003_0.CXH3003_1.TT.Release;  -- rendezvous with TT
+
+    while CXH3003_0.CXH3003_1.TT'Callable loop  -- wait for TT to complete
+      delay 1.0;
+    end loop;
+
+    if   not CXH3003_0.CXH3003_1.PT.Enquire
+      or not CXH3003_0.Global_Variable then
+      Report.Failed(Message);
+    end if;
+
+  end Block;
+
+  Report.Result;
+
+end CXH30031;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cz/cz1101a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cz/cz1101a.ada
new file mode 100644
index 000000000..394575fed
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cz/cz1101a.ada
@@ -0,0 +1,111 @@
+-- CZ1101A.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 REPORT ROUTINES OF THE REPORT PACKAGE WORK
+--     CORRECTLY.
+--
+-- PASS/FAIL CRITERIA:
+--     THIS TEST PASSES IF THE OUTPUT MATCHES THAT SUPPLIED IN THE
+--     APPLICABLE VERSION OF THE ACVC USERS' GUIDE.  THE EXPECTED
+--     TEST RESULT IS "TENTATIVELY PASSED."
+
+-- HISTORY:
+--     JRK 08/07/81  CREATED ORIGINAL TEST.
+--     JRK 10/27/82
+--     JRK 06/01/84
+--     JET 01/13/88  ADDED TESTS OF SPECIAL_ACTION AND UPDATED HEADER.
+--     PWB 06/24/88  CORRECTED LENGTH OF ONE OUTPUT STRING AND ADDED
+--                   PASS/FAIL CRITERIA.
+--     BCB 05/17/90  CORRECTED LENGTH OF 'MAX_LEN LONG' OUTPUT STRING.
+--                   ADDED CODE TO CREATE REPFILE.
+--     LDC 05/17/90  REMOVED DIRECT_IO REFERENCES.
+--     PWN 12/03/94  REMOVED ADA 9X INCOMPATIBILITIES.
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CZ1101A IS
+
+
+     DATE_AND_TIME : STRING(1..17);
+
+     DATE, TIME : STRING(1..7);
+
+BEGIN
+
+     COMMENT ("(CZ1101A) CHECK REPORT ROUTINES");
+     COMMENT ("   INITIAL VALUES SHOULD BE 'NO_NAME' AND 'FAILED'");
+     RESULT;
+
+     TEST ("PASS_TEST", "CHECKING 'TEST' AND 'RESULT' FOR 'PASSED'");
+     COMMENT ("THIS LINE IS EXACTLY 'MAX_LEN' LONG. " &
+              "...5...60....5...70");
+     COMMENT ("THIS COMMENT HAS A WORD THAT SPANS THE FOLD " &
+              "POINT. THIS COMMENT FITS EXACTLY ON TWO LINES. " &
+              "..5...60....5...70");
+     COMMENT ("THIS_COMMENT_IS_ONE_VERY_LONG_WORD_AND_SO_" &
+              "IT_SHOULD_BE_SPLIT_AT_THE_FOLD_POINT");
+     RESULT;
+
+     COMMENT ("CHECK THAT 'RESULT' RESETS VALUES TO 'NO_NAME' " &
+              "AND 'FAILED'");
+     RESULT;
+
+     TEST ("FAIL_TEST", "CHECKING 'FAILED' AND 'RESULT' FOR 'FAILED'");
+     FAILED ("'RESULT' SHOULD NOW BE 'FAILED'");
+     RESULT;
+
+     TEST ("NA_TEST", "CHECKING 'NOT-APPLICABLE'");
+     NOT_APPLICABLE ("'RESULT' SHOULD NOW BE 'NOT-APPLICABLE'");
+     RESULT;
+
+     TEST ("FAIL_NA_TEST", "CHECKING 'NOT_APPLICABLE', 'FAILED', " &
+                           "'NOT_APPLICABLE'");
+     NOT_APPLICABLE ("'RESULT' BECOMES 'NOT-APPLICABLE'");
+     FAILED ("'RESULT' BECOMES 'FAILED'");
+     NOT_APPLICABLE ("CALLING 'NOT_APPLICABLE' DOESN'T CHANGE " &
+                     "'RESULT'");
+     RESULT;
+
+     TEST ("SPEC_NA_TEST", "CHECKING 'SPEC_ACT', 'NOT_APPLICABLE', " &
+                           "'SPEC_ACT'");
+     SPECIAL_ACTION("'RESULT' BECOMES 'TENTATIVELY PASSED'");
+     NOT_APPLICABLE ("'RESULT' BECOMES 'NOT APPLICABLE'");
+     SPECIAL_ACTION("CALLING 'SPECIAL_ACTION' DOESN'T CHANGE 'RESULT'");
+     RESULT;
+
+     TEST ("SPEC_FAIL_TEST", "CHECKING 'SPEC_ACT', 'FAILED', " &
+                             "'SPEC_ACT'");
+     SPECIAL_ACTION("'RESULT' BECOMES 'TENTATIVELY PASSED'");
+     FAILED ("'RESULT' BECOMES 'FAILED'");
+     SPECIAL_ACTION("CALLING 'SPECIAL_ACTION' DOESN'T CHANGE 'RESULT'");
+     RESULT;
+
+     TEST ("CZ1101A", "CHECKING 'SPECIAL_ACTION' ALONE");
+     SPECIAL_ACTION("'RESULT' BECOMES 'TENTATIVELY PASSED'");
+     RESULT;
+
+END CZ1101A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cz/cz1102a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cz/cz1102a.ada
new file mode 100644
index 000000000..0255bb440
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cz/cz1102a.ada
@@ -0,0 +1,75 @@
+-- CZ1102A.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 DYNAMIC VALUE ROUTINES OF THE REPORT PACKAGE WORK
+--   CORRECTLY.
+
+-- JRK 8/7/81
+-- JRK 10/27/82
+-- RLB 03/20/00 - Added checks for Integer'First and Integer'Last.
+
+WITH REPORT;
+USE REPORT;
+
+PROCEDURE CZ1102A IS
+
+BEGIN
+
+     TEST ("CZ1102A", "CHECK THAT THE DYNAMIC VALUE ROUTINES OF " &
+                         "THE REPORT PACKAGE WORK CORRECTLY");
+
+     IF NOT EQUAL (0, 0) OR
+        EQUAL (0, 1) OR
+        NOT EQUAL (1, 1) OR
+        NOT EQUAL (3, 3) OR
+        NOT EQUAL (4, 4) OR
+        NOT EQUAL (-1, -1) OR
+        NOT EQUAL (INTEGER'FIRST, INTEGER'FIRST) OR
+        NOT EQUAL (INTEGER'LAST, INTEGER'LAST) OR
+        EQUAL (-1, 0) THEN
+          FAILED ("'EQUAL' NOT WORKING");
+     END IF;
+
+     IF IDENT_INT (5) /= 5 THEN
+          FAILED ("'IDENT_INT' NOT WORKING");
+     END IF;
+
+     IF IDENT_CHAR ('E') /= 'E' THEN
+          FAILED ("'IDENT_CHAR' NOT WORKING");
+     END IF;
+
+     IF IDENT_BOOL (TRUE) /= TRUE THEN
+          FAILED ("'IDENT_BOOL' NOT WORKING");
+     END IF;
+
+     IF IDENT_STR ("") /= "" OR
+        IDENT_STR ("K") /= "K" OR
+        IDENT_STR ("PQRS") /= "PQRS" THEN
+          FAILED ("'IDENT_STR' NOT WORKING");
+     END IF;
+
+     RESULT;
+
+END CZ1102A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cz/cz1103a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cz/cz1103a.ada
new file mode 100644
index 000000000..87756c88f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cz/cz1103a.ada
@@ -0,0 +1,232 @@
+-- CZ1103A.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 PROCEDURE CHECK_FILE WORKS CORRECTLY, IN
+--     PARTICULAR, THAT IT WILL REPORT INCORRECT FILE CONTENTS
+--     AS TEST FAILURES.
+
+--     THIS TEST INTENTIONALLY CONTAINS MISMATCHES BETWEEN FILE
+--     CONTENTS AND THE 'CONTENTS' STRING PARAMETER OF PROCEDURE
+--     CHECK_FILE.
+
+-- PASS/FAIL CRITERIA:
+--     IF AN IMPLEMENTATION SUPPORTS EXTERNAL FILES, IT PASSES THIS TEST
+--     IF TEST EXECUTION REPORTS THE FOLLOWING FOUR FAILURES, REPORTS AN
+--     INTERMEDIATE "FAILED" RESULT, REPORTS A FINAL "TENTATIVELY PASSED"
+--     RESULT, AND REPORTS NO OTHER FAILURES.
+--        * CZ1103A FROM CHECK_FILE: END OF LINE EXPECTED - E
+--                     ENCOUNTERED.
+--        * CZ1103A FROM CHECK_FILE: END_OF_PAGE NOT WHERE EXPECTED.
+--        * CZ1103A FROM CHECK_FILE: END_OF_FILE NOT WHERE EXPECTED.
+--        * CZ1103A FROM CHECK_FILE: FILE DOES NOT CONTAIN CORRECT
+--                      OUTPUT - EXPECTED C - GOT I.
+--
+--     IF AN IMPLEMENTATION DOES NOT SUPPORT EXTERNAL FILES, IT PASSES THIS
+--     TEST IF TEST EXECUTION REPORTS NINE FAILURES FOR INCOMPLETE SUBTESTS
+--     SIMILAR TO THE SAMPLE BELOW, REPORTS AN INTERMEDIATE "FAILED" RESULT,
+--     REPORTS A FINAL "TENTATIVELY PASSED" RESULT, AND REPORTS NO OTHER
+--     FAILURES.
+--        * CZ1103A TEST WITH EMPTY FILE INCOMPLETE.
+
+-- HISTORY:
+--     SPS 12/09/82  CREATED ORIGINAL TEST.
+--     JRK 11/18/85  ADDED COMMENTS ABOUT PASS/FAIL CRITERIA.
+--     JET 01/13/88  UPDATED HEADER FORMAT, ADDED FINAL CALL TO
+--                   SPECIAL_ACTION.
+--     PWB 06/24/88  CORRECTED PASS/FAIL CRITERIA TO INDICATE THE
+--                   EXPECTED RESULT (TENTATIVELY PASSED).
+--     RLB 03/20/00  CORRECTED PASS/FAIL CRITERIA TO REFLECT PROPER RESULT
+--                   FOR AN IMPLEMENTATION THAT DOES NOT SUPPORT EXTERNAL FILES.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE CZ1103A IS
+
+     NULL_FILE : FILE_TYPE;
+     FILE_WITH_BLANK_LINES : FILE_TYPE;
+     FILE_WITH_BLANK_PAGES : FILE_TYPE;
+     FILE_WITH_TRAILING_BLANKS : FILE_TYPE;
+     FILE_WITHOUT_TRAILING_BLANKS : FILE_TYPE;
+     FILE_WITH_END_OF_LINE_ERROR : FILE_TYPE;
+     FILE_WITH_END_OF_PAGE_ERROR : FILE_TYPE;
+     FILE_WITH_END_OF_FILE_ERROR : FILE_TYPE;
+     FILE_WITH_DATA_ERROR : FILE_TYPE;
+
+BEGIN
+
+     TEST ("CZ1103A", "CHECK THAT PROCEDURE CHECK_FILE WORKS");
+
+-- THIS SECTION TESTS CHECK_FILE WITH AN EMPTY FILE.
+
+     BEGIN
+          COMMENT ("BEGIN TEST WITH AN EMPTY FILE");
+          CREATE (NULL_FILE, OUT_FILE);
+          CHECK_FILE (NULL_FILE, "#@%");
+          CLOSE (NULL_FILE);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TEST WITH EMPTY FILE INCOMPLETE");
+
+     END;
+
+-- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH BLANK LINES.
+
+     BEGIN
+          COMMENT ("BEGIN TEST WITH A FILE WITH BLANK LINES");
+          CREATE (FILE_WITH_BLANK_LINES, OUT_FILE);
+          NEW_LINE (FILE_WITH_BLANK_LINES, 20);
+          CHECK_FILE (FILE_WITH_BLANK_LINES, "####################@%");
+          CLOSE (FILE_WITH_BLANK_LINES);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TEST WITH FILE WITH BLANK LINES INCOMPLETE");
+     END;
+
+-- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH BLANK LINES AND PAGES.
+
+     BEGIN
+          COMMENT ("BEGIN TEST WITH A FILE WITH BLANK LINES " &
+                   "AND PAGES");
+          CREATE (FILE_WITH_BLANK_PAGES, OUT_FILE);
+          NEW_LINE (FILE_WITH_BLANK_PAGES, 3);
+          NEW_PAGE (FILE_WITH_BLANK_PAGES);
+          NEW_LINE (FILE_WITH_BLANK_PAGES, 2);
+          NEW_PAGE (FILE_WITH_BLANK_PAGES);
+          NEW_PAGE (FILE_WITH_BLANK_PAGES);
+          CHECK_FILE (FILE_WITH_BLANK_PAGES, "###@##@#@%");
+          CLOSE (FILE_WITH_BLANK_PAGES);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TEST WITH FILE WITH BLANK PAGES INCOMPLETE");
+     END;
+
+-- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH TRAILING BLANKS.
+
+     BEGIN
+          COMMENT ("BEGIN TEST WITH A FILE WITH TRAILING BLANKS");
+          CREATE (FILE_WITH_TRAILING_BLANKS, OUT_FILE);
+          FOR I IN 1 .. 3 LOOP
+               PUT_LINE (FILE_WITH_TRAILING_BLANKS,
+                         "LINE WITH TRAILING BLANKS    ");
+          END LOOP;
+          CHECK_FILE(FILE_WITH_TRAILING_BLANKS, "LINE WITH TRAILING" &
+                    " BLANKS#LINE WITH TRAILING BLANKS#LINE" &
+                    " WITH TRAILING BLANKS#@%");
+          CLOSE (FILE_WITH_TRAILING_BLANKS);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TEST WITH FILE WITH TRAILING BLANKS " &
+                       "INCOMPLETE");
+     END;
+
+-- THIS SECTION TESTS CHECK_FILE WITH A FILE WITHOUT TRAILING BLANKS.
+
+     BEGIN
+          COMMENT ("BEGIN TEST WITH A FILE WITHOUT TRAILING BLANKS");
+          CREATE (FILE_WITHOUT_TRAILING_BLANKS, OUT_FILE);
+          FOR I IN 1 .. 3 LOOP
+               PUT_LINE (FILE_WITHOUT_TRAILING_BLANKS,
+                         "LINE WITHOUT TRAILING BLANKS");
+          END LOOP;
+          CHECK_FILE(FILE_WITHOUT_TRAILING_BLANKS, "LINE WITHOUT " &
+                    "TRAILING BLANKS#LINE WITHOUT TRAILING BLANKS#" &
+                    "LINE WITHOUT TRAILING BLANKS#@%");
+          CLOSE (FILE_WITHOUT_TRAILING_BLANKS);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TEST WITH FILE WITHOUT TRAILING BLANKS " &
+                       "INCOMPLETE");
+     END;
+
+-- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH AN END OF LINE ERROR.
+
+     BEGIN
+          COMMENT ("BEGIN TEST WITH A FILE WITH AN END OF LINE ERROR");
+          CREATE (FILE_WITH_END_OF_LINE_ERROR, OUT_FILE);
+          PUT_LINE (FILE_WITH_END_OF_LINE_ERROR, "THIS LINE WILL " &
+                    "CONTAIN AN END OF LINE IN THE WRONG PLACE");
+          CHECK_FILE (FILE_WITH_END_OF_LINE_ERROR, "THIS LINE WILL " &
+               "CONTAIN AN # IN THE WRONG PLACE#@%");
+          CLOSE (FILE_WITH_END_OF_LINE_ERROR);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TEST WITH END_OF_LINE ERROR INCOMPLETE");
+     END;
+
+-- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH AN END OF PAGE ERROR.
+
+     BEGIN
+          COMMENT ("BEGIN TEST WITH FILE WITH END OF PAGE ERROR");
+          CREATE (FILE_WITH_END_OF_PAGE_ERROR, OUT_FILE);
+          PUT_LINE (FILE_WITH_END_OF_PAGE_ERROR, "THIS LINE WILL " &
+                    "CONTAIN AN END OF PAGE IN THE WRONG PLACE");
+          CHECK_FILE (FILE_WITH_END_OF_PAGE_ERROR, "THIS LINE WILL " &
+               "CONTAIN AN @ IN THE WRONG PLACE#@%");
+          CLOSE (FILE_WITH_END_OF_PAGE_ERROR);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TEST WITH END_OF_PAGE ERROR INCOMPLETE");
+     END;
+
+-- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH AN END OF FILE ERROR.
+
+     BEGIN
+          COMMENT ("BEGIN TEST WITH FILE WITH END OF FILE ERROR");
+          CREATE (FILE_WITH_END_OF_FILE_ERROR, OUT_FILE);
+          PUT_LINE (FILE_WITH_END_OF_FILE_ERROR, "THIS LINE WILL " &
+                    "CONTAIN AN END OF FILE IN THE WRONG PLACE");
+          CHECK_FILE (FILE_WITH_END_OF_FILE_ERROR, "THIS LINE WILL " &
+               "CONTAIN AN % IN THE WRONG PLACE#@%");
+          CLOSE (FILE_WITH_END_OF_FILE_ERROR);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TEST WITH END_OF_FILE ERROR INCOMPLETE");
+     END;
+
+-- THIS SECTION TESTS CHECK_FILE WITH A FILE WITH INCORRECT DATA.
+
+     BEGIN
+          COMMENT ("BEGIN TEST WITH FILE WITH INCORRECT DATA");
+          CREATE (FILE_WITH_DATA_ERROR, OUT_FILE);
+          PUT_LINE (FILE_WITH_DATA_ERROR, "LINE WITH INCORRECT " &
+                    "DATA");
+          CHECK_FILE (FILE_WITH_DATA_ERROR, "LINE WITH CORRECT " &
+                      "DATA#@%");
+          CLOSE (FILE_WITH_DATA_ERROR);
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("TEST WITH INCORRECT DATA INCOMPLETE");
+     END;
+
+     RESULT;
+
+     TEST ("CZ1103A", "THE LINE ABOVE SHOULD REPORT FAILURE");
+     SPECIAL_ACTION ("COMPARE THIS OUTPUT TO THE EXPECTED RESULT");
+     RESULT;
+
+END CZ1103A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a002a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a002a.ada
new file mode 100644
index 000000000..a2ec008fb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a002a.ada
@@ -0,0 +1,54 @@
+-- D4A002A.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.
+--*
+-- LARGE LITERALS IN NUMBER DECLARATIONS, BUT WITH RESULTING
+-- SMALLER VALUE OBTAINED BY SUBTRACTION. THIS TEST LIMITS VALUES
+-- TO 32 BINARY PLACES.
+
+-- BAW 29 SEPT 80
+-- JBG 12/6/84
+
+WITH REPORT;
+PROCEDURE D4A002A IS
+
+     USE REPORT;
+
+     X : CONSTANT := 1_034_567_890 - 1_034_567_891;
+     Y : CONSTANT := 107 * (10 ** 7) - 1_069_999_999;
+     Z : CONSTANT := (1024 ** 3) - (2 ** 30);
+     D : CONSTANT := 1_073_741_823 / 32_769;
+     E : CONSTANT := 536_870_912 REM 2_304_167;
+     F : CONSTANT := (-134_217_728) MOD (-262_657);
+
+BEGIN TEST("D4A002A","LARGE INTEGER RANGE (WITH CANCELLATION) IN " &
+           "NUMBER DECLARATIONS; LONGEST INTEGER IS 32 BITS");
+
+      IF X /= -1 OR Y /= 1 OR Z /= 0 OR D /= 32_767 OR E /= 1 OR F /= -1
+      THEN FAILED("EXPRESSIONS WITH A LARGE INTEGER RANGE (WITH " &
+                  "CANCELLATION) ARE NOT EXACT ");
+      END IF;
+
+      RESULT;
+
+END D4A002A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a002b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a002b.ada
new file mode 100644
index 000000000..6278254b3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a002b.ada
@@ -0,0 +1,56 @@
+-- D4A002B.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.
+--*
+-- LARGER LITERALS IN NUMBER DECLARATIONS, BUT WITH RESULTING
+-- SMALLER VALUE OBTAINED BY SUBTRACTION. THIS TEST LIMITS VALUES
+-- TO 64 BINARY PLACES.
+
+-- BAW 29 SEPT 80
+-- JBG 05/02/85     RENAMED TO -B.  REVISED SO THAT ALL RESULTS FIT IN
+--                  16 BITS.
+
+WITH REPORT;
+PROCEDURE D4A002B IS
+
+     USE REPORT;
+
+     X : CONSTANT := 4123456789012345678 - 4123456789012345679;
+     Y : CONSTANT := 4 * (10 ** 18) - 3999999999999999999;
+     Z : CONSTANT := (1024 ** 6) - (2 ** 60);
+     D : CONSTANT := 9_223_372_036_854_775_807 / 994_862_694_084_217;
+     E : CONSTANT := 36_028_790_976_242_271 REM 17_600_175_361;
+     F : CONSTANT := ( - 2 ** 51 ) MOD ( - 131_071 );
+
+BEGIN TEST("D4A002B","LARGE INTEGER RANGE (WITH CANCELLATION) IN " &
+           "NUMBER DECLARATIONS; LONGEST INTEGER IS 64 BITS ");
+
+      IF X /= -1 OR Y /= 1 OR Z /= 0
+         OR D /= 9271 OR E /= 1 OR F /= -1
+      THEN FAILED("EXPRESSIONS WITH A LARGE INTEGER RANGE (WITH " &
+                  "CANCELLATION) ARE NOT EXACT ");
+      END IF;
+
+      RESULT;
+
+END D4A002B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a004a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a004a.ada
new file mode 100644
index 000000000..7c744d756
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a004a.ada
@@ -0,0 +1,59 @@
+-- D4A004A.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.
+--*
+-- 32 BIT INTEGERS IN NUMBER DECLARATIONS. UNLIKE TEST D4A002A,
+-- NO CANCELLATION IS INVOLVED.
+
+-- A COMPILER MAY REFUSE TO COMPILE THIS TEST BECAUSE THE NUMBERS
+-- INVOLVED ARE TOO BIG.
+
+-- BAW 29 SEPT 80
+-- JBG 12/6/84
+
+WITH REPORT;
+PROCEDURE D4A004A IS
+
+     USE REPORT;
+
+     X : CONSTANT := 511_111_111 + 501_111_111;
+     Y : CONSTANT := -599_999_999 - 411_111_112;
+     Z : CONSTANT := 10 * (10 ** 8);
+     D : CONSTANT := 2 ** 30 / 1;
+     E : CONSTANT := ( 2 ** 29 - 1) REM 233;
+     F : CONSTANT := ABS(( - 2 ** 27 + 1) MOD 511);
+
+BEGIN TEST("D4A004A","LARGE INTEGER VALUES IN NUMBER DECLARATIONS; " &
+           "LONGEST INTEGER IS 32 BITS ");
+
+      IF X /= 1_012_222_222 OR Y /= -1_011_111_111
+      THEN FAILED("ADDITION OR SUBTRACTION NOT EXACT");
+      END IF;
+
+      IF Z /= 1_000_000_000  OR D /= 1_073_741_824 OR E /= 0 OR F /= 0
+      THEN FAILED("INTEGER ** IS NOT EXACT");
+      END IF;
+
+      RESULT;
+
+END D4A004A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a004b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a004b.ada
new file mode 100644
index 000000000..f2e2b75cd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/d/d4a004b.ada
@@ -0,0 +1,72 @@
+-- D4A004B.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.
+--*
+-- INTEGERS TO 64 BITS IN NUMBER DECLARATIONS. UNLIKE TEST C4A002B,
+-- NO CANCELLATION IS INVOLVED.
+
+-- BAW 29 SEPT 80
+-- JWC 7/8/85   RENAMED TO -AB
+
+WITH REPORT;
+PROCEDURE D4A004B IS
+
+     USE REPORT;
+
+     X : CONSTANT := 2200000000000000000 + 2199999999999999999;
+     Y : CONSTANT := -2200000000000000001 - 2199999999999999998;
+     Z : CONSTANT := 4 * (10 ** 18);
+     D : CONSTANT := 2 ** 63 / 1;
+     E : CONSTANT := ( 2 ** 63 - 1 ) REM 454_279;
+     F : CONSTANT := ABS(( -2 ** 55 + 1 ) MOD 2047 );
+
+BEGIN TEST("D4A004B","LARGE INTEGER VALUES IN NUMBER DECLARATIONS; " &
+           "LONGEST INTEGER IS 64 BITS ");
+
+      IF X /= 4399999999999999999 THEN
+          FAILED ("ERROR X");
+      END IF;
+
+      IF Y /= -4399999999999999999 THEN
+          FAILED ("ERROR Y");
+      END IF;
+
+      IF Z /= 4000000000000000000 THEN
+          FAILED ("ERROR Z");
+      END IF;
+
+      IF E /= 0 THEN
+          FAILED ("ERROR E");
+      END IF;
+
+      IF F /= 0 THEN
+          FAILED ("ERROR F");
+      END IF;
+
+      IF D /= 9_223_372_036_854_775_808 THEN
+          FAILED ("ERROR D");
+      END IF;
+
+      RESULT;
+
+END D4A004B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/e28002b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/e28002b.ada
new file mode 100644
index 000000000..d7c7869e4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/e28002b.ada
@@ -0,0 +1,111 @@
+-- E28002B.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 PREDEFINED OR AN UNRECOGNIZED PRAGMA MAY HAVE
+--     ARGUMENTS INVOLVING OVERLOADED IDENTIFIERS WITHOUT ENOUGH
+--     CONTEXTUAL INFORMATION TO RESOLVE THE OVERLOADING.
+
+-- PASS/FAIL CRITERIA:
+--     THIS TEST IS PASSED IF IT REPORTS "TENTATIVELY PASSED" AND
+--     THE STARRED COMMENT DOES NOT APPEAR IN THE LISTING.
+
+--     AN IMPLEMENTATION FAILS THIS TEST IF THE STARRED COMMENT
+--     LINE APPEARS IN THE COMPILATION LISTING.
+
+-- HISTORY:
+--     TBN 02/24/86  CREATED ORIGINAL TEST.
+--     JET 01/13/88  ADDED CALLS TO SPECIAL_ACTION AND UPDATED HEADER.
+--     EDS 10/28/97  ADDED DECLARATIONS FOR PROCEDURES XYZ.
+
+WITH REPORT, SYSTEM; USE REPORT, SYSTEM;
+PROCEDURE E28002B IS
+
+     FUNCTION OFF RETURN INTEGER IS
+     BEGIN
+          RETURN 1;
+     END OFF;
+
+     FUNCTION OFF RETURN BOOLEAN IS
+     BEGIN
+          RETURN TRUE;
+     END OFF;
+
+     PRAGMA LIST (OFF);
+--***** THIS LINE MUST NOT APPEAR IN COMPILATION LISTING.
+     PRAGMA LIST (ON);
+
+     FUNCTION ELABORATION_CHECK RETURN INTEGER IS
+     BEGIN
+          RETURN 1;
+     END ELABORATION_CHECK;
+
+     FUNCTION ELABORATION_CHECK RETURN BOOLEAN IS
+     BEGIN
+          RETURN TRUE;
+     END ELABORATION_CHECK;
+
+     PRAGMA SUPPRESS (ELABORATION_CHECK, ELABORATION_CHECK);
+
+     FUNCTION TIME RETURN INTEGER IS
+     BEGIN
+          RETURN 1;
+     END TIME;
+
+     FUNCTION TIME RETURN BOOLEAN IS
+     BEGIN
+          RETURN TRUE;
+     END TIME;
+
+     PRAGMA OPTIMIZE (TIME);
+
+     PROCEDURE XYZ;
+     PROCEDURE XYZ (COUNT : INTEGER);
+
+     PRAGMA INLINE (XYZ);
+     PRAGMA PHIL_BRASHEAR (XYZ);
+
+     PROCEDURE XYZ IS
+     BEGIN
+          NULL;
+     END XYZ;
+
+     PROCEDURE XYZ (COUNT : INTEGER) IS
+     BEGIN
+          NULL;
+     END XYZ;
+
+BEGIN
+     TEST ("E28002B", "CHECK THAT A PREDEFINED OR AN UNRECOGNIZED " &
+                      "PRAGMA MAY HAVE ARGUMENTS INVOLVING " &
+                      "OVERLOADED IDENTIFIERS WITHOUT ENOUGH " &
+                      "CONTEXTUAL INFORMATION TO RESOLVE THE " &
+                      "OVERLOADING");
+
+     SPECIAL_ACTION ("CHECK THAT THE COMPILATION LISTING DOES NOT " &
+                     "SHOW THE STARRED COMMENT LINE");
+
+     RESULT;
+
+END E28002B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/e28005d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/e28005d.ada
new file mode 100644
index 000000000..a6632d65f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/e28005d.ada
@@ -0,0 +1,55 @@
+PRAGMA PAGE;
+-- E28005D.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 PRAGMA PAGE IS USED AT THE BEGINNING OR END OF A
+--     COMPILATION, THERE IS NO PROBLEM.
+
+-- PASS/FAIL CRITERIA:
+--     THE TEST MUST COMPILE TO EXECUTE WITH A 'TENTATIVELY PASSED'
+--     RESULT.  THERE IS A PAGE BREAK BEFORE THE TEST NAME AND A
+--     PAGE BREAK AFTER THE END OF THE TEST.
+
+-- HISTORY:
+--     RJW 04/16/86  CREATED ORIGINAL TEST.
+--     JET 01/13/88  ADDED CALLS TO SPECIAL_ACTION AND UPDATED HEADER.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE E28005D IS
+BEGIN
+     TEST ( "E28005D", "CHECK THAT WHEN PRAGMA PAGE IS USED AT THE " &
+                       "BEGINNING OR END OF A COMPILATION, THERE " &
+                       "IS NO PROBLEM");
+
+     SPECIAL_ACTION ("CHECK THAT THE PAGE PRAGMAS AT THE BEGINNING " &
+                     "AND END OF THE PROGRAM CAUSE THE TEXT " &
+                     "FOLLOWING THE PRAGMAS TO APPEAR AT THE START " &
+                     "OF A NEW PAGE OF THE COMPILATION LISTING");
+     RESULT;
+
+END E28005D;
+
+PRAGMA PAGE;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/e52103y.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/e52103y.ada
new file mode 100644
index 000000000..e2a7a95a0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/e52103y.ada
@@ -0,0 +1,132 @@
+-- E52103Y.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 WHETHER A NULL ARRAY WITH ONE DIMENSION OF LENGTH GREATER THAN
+-- INTEGER'LAST RAISES CONSTRAINT_ERROR OR NO EXCEPTION,
+-- EITHER WHEN DECLARED OR  ASSIGNED.
+
+-- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
+--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
+--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
+--    ARE PERFORMED CORRECTLY.
+--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
+--    ARE TREATED ELSEWHERE.)
+
+
+-- THIS IS A SPECIAL CASE IN
+
+--    DIVISION  D :  NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
+--                   STATICALLY
+
+-- WHICH (THE SPECIAL CASE) TREATS TWO-DIMENSIONAL ARRAYS WHOSE LENGTH
+--    ALONG ONE DIMENSION IS GREATER THAN  INTEGER'LAST  AND WHOSE
+--    LENGTH ALONG THE OTHER DIMENSION IS  0 .
+
+
+-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
+-- ***       remove incompatibilities associated with the transition   -- 9X
+-- ***       to Ada 9X.                                                -- 9X
+-- ***                                                                 -- 9X
+
+-- RM  07/31/81
+-- SPS 03/22/83
+-- JBG 05/02/83
+-- JBG 06/01/85
+-- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
+--               AI-00387.
+-- LDC 06/01/88  CHANGED HEADER COMMENT TO INDICATE CONSTRAINT_ERROR
+--               IS ALLOWED.  ADDED CODE TO PREVENT DEAD VARIABLE
+--               OPTIMIZATION.
+-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
+
+WITH REPORT;
+PROCEDURE  E52103Y  IS
+
+     USE  REPORT ;
+
+BEGIN
+
+     TEST( "E52103Y","CHECK WHETHER CONSTRAINT_ERROR " &
+                     "OR NO EXCEPTION IS RAISED WHEN DIMENSION OF " &
+                     "AN ARRAY HAS LENGTH > INTEGER'LAST");
+     BEGIN
+
+          DECLARE
+
+               TYPE  TA42  IS  ARRAY(
+                    INTEGER RANGE IDENT_INT( 13 )..IDENT_INT( 12 ),
+                    INTEGER RANGE IDENT_INT(-2)..IDENT_INT(INTEGER'LAST)
+                                    )  OF BOOLEAN ;
+
+               SUBTYPE  TA41  IS  TA42 ;
+
+               ARR41  :  TA41 ;
+               ARR42  :  TA42 ;
+
+          BEGIN
+
+               COMMENT ("NO EXCEPTION FOR ARRAY DECLARATION");
+
+               -- NULL ARRAY ASSIGNMENT:
+
+               ARR42 := ARR41 ;
+               IF ARR42'LENGTH(1) /= 0 THEN
+                    FOR I IN TA42'RANGE(2) LOOP
+                         ARR41(13,I) := IDENT_BOOL(ARR42(13,I));
+                    END LOOP;
+               END IF;
+
+               COMMENT ("NO EXCEPTION RAISED FOR NULL ARRAY " &
+                        "ASSIGNMENT");
+
+          EXCEPTION
+
+               WHEN CONSTRAINT_ERROR =>
+                    COMMENT ("CONSTRAINT_ERROR RAISED IN LENGTH " &
+                             "COMPARISON");
+
+               WHEN  OTHERS  =>
+                    FAILED( "OTHER EXCEPTION RAISED  -  SUBTEST 2" );
+
+          END ;
+
+     EXCEPTION
+
+          WHEN CONSTRAINT_ERROR =>
+               COMMENT ("CONSTRAINT_ERROR RAISED BY DECLARATION OF " &
+                        "NULL ARRAY TYPE WITH ONE DIMENSION > " &
+                        "INTEGER'LAST");
+
+          WHEN OTHERS =>
+               FAILED ("SOME OTHER EXCEPTION RAISED");
+
+     END;
+
+     -------------------------------------------------------------------
+
+
+     RESULT ;
+
+
+END E52103Y;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/eb4011a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/eb4011a.ada
new file mode 100644
index 000000000..24705ba5f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/eb4011a.ada
@@ -0,0 +1,79 @@
+-- EB4011A.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 UNHANDLED EXCEPTIONS RAISED IN PACKAGE SUBUNITS ARE
+--     PROPAGATED TO THE ENVIRONMENT STATICALLY ENCLOSING THE
+--     CORRESPONDING BODY STUB (DECLARER OF THE PARENT UNIT).
+
+-- PASS/FAIL CRITERIA:
+--     THIS TEST MUST EXECUTE AND REPORT "TENTATIVELY PASSED". IN
+--     ADDITION, THE OUTPUT/LOG FILE MUST INDICATE THAT THE PROGRAM
+--     TERMINATED WITH AN UNHANDLED EXCEPTION.
+
+-- HISTORY:
+--     DHH 03/29/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE EB4011A IS
+
+     PACKAGE EB4011A_OUTSIDE IS
+     END EB4011A_OUTSIDE;
+
+     PACKAGE EB4011A1 IS
+     END EB4011A1;
+
+     PACKAGE BODY EB4011A1 IS
+     BEGIN
+
+          TEST("EB4011A", "CHECK THAT UNHANDLED EXCEPTIONS RAISED IN " &
+                          "PACKAGE SUBUNITS ARE PROPAGATED TO THE " &
+                          "ENVIRONMENT STATICALLY ENCLOSING THE" &
+                          "CORRESPONDING BODY STUB (DECLARER OF THE " &
+                          "PARENT UNIT)");
+
+          SPECIAL_ACTION("CHECK THE OUTPUT FILE TO SEE IF THIS " &
+                         "PROGRAM TERMINATED WITH AN UNHANDLED " &
+                         "EXCEPTION");
+
+          RESULT;
+
+     END EB4011A1;
+
+     PACKAGE BODY EB4011A_OUTSIDE IS SEPARATE;
+
+BEGIN
+
+     TEST("EB4011A", "THIS LINE SHOULD NOT PRINT OUT");
+
+     FAILED("EXCEPTION DID NOT CAUSE MAIN PROGRAM TERMINATION");
+     RESULT;
+
+END EB4011A;
+
+SEPARATE (EB4011A)
+PACKAGE BODY EB4011A_OUTSIDE IS
+BEGIN
+     RAISE CONSTRAINT_ERROR;
+END EB4011A_OUTSIDE;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/eb4012a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/eb4012a.ada
new file mode 100644
index 000000000..7166c0b08
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/eb4012a.ada
@@ -0,0 +1,59 @@
+-- EB4012A.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 AN UNHANDLED EXCEPTION IS RAISED IN THE MAIN
+--     PROGRAM, THE MAIN PROGRAM IS ABANDONED.
+
+-- PASS/FAIL CRITERIA:
+--     THIS TEST MUST EXECUTE AND PRINT "TENTATIVELY PASSED". IN
+--     ADDITION, THE OUTPUT/LOG FILE MUST SHOW THAT THE PROGRAM
+--     WAS ABANDONED DUE TO AN UNHANDLED EXCEPTION.
+
+-- HISTORY:
+--     DHH 03/29/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE EB4012A IS
+
+BEGIN
+     TEST("EB4012A", "CHECK THAT WHEN AN UNHANDLED EXCEPTION IS " &
+                     "RAISED IN THE MAIN PROGRAM, THE MAIN PROGRAM " &
+                     "IS ABANDONED");
+     SPECIAL_ACTION("CHECK THE OUTPUT/LOG FILE TO SEE THAT THIS " &
+                    "PROGRAM WAS ABANDONED BECAUSE OF AN UNHANDLED " &
+                    "EXCEPTION");
+
+     RESULT;
+
+     IF EQUAL(3,3) THEN
+          RAISE CONSTRAINT_ERROR;
+     END IF;
+
+     TEST("EB4012A", "SHOULD NOT PRINT OUT");
+     FAILED("CONSTRAINT_ERROR NOT RAISED");
+
+     RESULT;
+
+END EB4012A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/eb4014a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/eb4014a.ada
new file mode 100644
index 000000000..d520bd054
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/eb4014a.ada
@@ -0,0 +1,87 @@
+-- EB4014A.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 EXCEPTIONS ARE RAISED DURING THE ELABORATION OF
+--     A LIBRARY UNIT, EXECUTION OF THE MAIN PROGRAM IS ABANDONED.
+
+-- PASS/FAIL CRITERIA:
+--     THIS TEST MUST EXECUTE AND REPORT "TENTATIVELY PASSED". IN
+--     ADDITION, THE OUTPUT/LOG FILE MUST INDICATE THAT THE PROGRAM
+--     TERMINATED WITH AN UNHANDLED EXCEPTION.
+
+-- HISTORY:
+--     DHH 03/29/88 CREATED ORIGINAL TEST.
+--     PWN 05/25/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
+
+WITH REPORT; USE REPORT;
+FUNCTION EB4014A1 RETURN INTEGER IS
+BEGIN
+
+     TEST("EB4014A", "THIS LINE SHOULD NOT BE PRINTED");
+
+     FAILED("THE MAIN PROGRAM BODY WAS ENTERED");
+     RESULT;
+
+     RETURN IDENT_INT(1);
+
+END EB4014A1;
+
+WITH REPORT; USE REPORT;
+PRAGMA ELABORATE (REPORT);
+PACKAGE EB4014A_OUTSIDE IS
+     PROCEDURE REQUIRE_BODY;
+END EB4014A_OUTSIDE;
+
+PACKAGE BODY EB4014A_OUTSIDE IS
+     PROCEDURE REQUIRE_BODY IS
+     BEGIN
+          NULL;
+     END;
+BEGIN
+     TEST("EB4014A", "CHECK THAT WHEN EXCEPTIONS ARE RAISED DURING " &
+                     "THE ELABORATION OF A LIBRARY UNIT, EXECUTION " &
+                     "OF THE MAIN PROGRAM IS ABANDONED");
+
+     SPECIAL_ACTION("CHECK THE OUTPUT/LOG FILE TO SEE IF THIS " &
+                    "PROGRAM TERMINATED WITH AN UNHANDLED " &
+                    "EXCEPTION");
+
+     RESULT;
+
+     RAISE CONSTRAINT_ERROR;
+END EB4014A_OUTSIDE;
+
+WITH EB4014A1; WITH EB4014A_OUTSIDE;
+WITH REPORT; USE REPORT;
+PROCEDURE EB4014A IS
+     X : INTEGER := EB4014A1;
+BEGIN
+
+     TEST("EB4014A", "THIS LINE SHOULD NOT PRINT OUT");
+
+     FAILED("EXCEPTION DID NOT CAUSE MAIN PROGRAM TERMINATION");
+     RESULT;
+     X := IDENT_INT(X);
+END EB4014A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3203a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3203a.ada
new file mode 100644
index 000000000..a31887d96
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3203a.ada
@@ -0,0 +1,168 @@
+-- EE3203A.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 SET_INPUT AND SET_OUTPUT CAN BE USED, AND THAT THEY
+--     DO NOT REDEFINE OR CLOSE THE CORRESPONDING STANDARD FILES.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- PASS/FAIL CRITERIA:
+--     THIS TEST IS PASSED IF IT EXECUTES AND THE STANDARD OUTPUT FILE
+--     CONTAINS THE LINE "INITIAL TEXT OF STANDARD_OUTPUT".
+
+-- HISTORY:
+--     ABW 08/25/82
+--     SPS 11/19/82
+--     VKG 02/15/83
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/19/87  CORRECTED EXCEPTION HANDLING, REMOVED DEPENDENCE
+--                   ON RESET, AND ADDED CHECKS FOR USE_ERROR ON DELETE.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE EE3203A IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE_IN, FILE_OUT : FILE_TYPE;
+     LST : NATURAL;
+     IN_STR : STRING (1 .. 50);
+
+BEGIN
+
+     TEST ("EE3203A", "CHECK THAT SET_INPUT AND SET_OUTPUT " &
+                      "CAN BE USED, AND THAT CORRESPONDING " &
+                      "STANDARD FILES ARE UNCHANGED");
+
+     BEGIN
+          CREATE (FILE_IN, OUT_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "OUT_FILE MODE - 1");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE - 1");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     BEGIN
+          CREATE (FILE_OUT, OUT_FILE, LEGAL_FILE_NAME(2));
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
+                               "OUT_FILE MODE - 2");
+               RAISE INCOMPLETE;
+          WHEN NAME_ERROR =>
+               NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
+                               "WITH OUT_FILE MODE - 2");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     PUT (FILE_IN, "INITIAL TEXT OF FILE_IN");
+     PUT (FILE_OUT, "INITIAL TEXT OF FILE_OUT");
+     PUT ("INITIAL TEXT OF STANDARD_OUTPUT");
+
+     CLOSE (FILE_IN);
+
+     BEGIN
+          OPEN (FILE_IN, IN_FILE, LEGAL_FILE_NAME);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
+                               "IN_FILE MODE");
+               RAISE INCOMPLETE;
+     END;
+
+     SET_INPUT (FILE_IN);
+     SET_OUTPUT (FILE_OUT);
+
+     IF NOT IS_OPEN (STANDARD_INPUT) THEN
+          FAILED ("STANDARD_INPUT NOT OPEN");
+     END IF;
+
+     IF NOT IS_OPEN (FILE_IN) THEN
+          FAILED ("FILE_IN NOT OPEN");
+     END IF;
+
+     IF NOT IS_OPEN (STANDARD_OUTPUT) THEN
+          FAILED ("STANDARD_OUTPUT NOT OPEN");
+     END IF;
+
+     IF NOT IS_OPEN (FILE_OUT) THEN
+          FAILED ("FILE_OUT NOT OPEN");
+     END IF;
+
+     NEW_LINE;
+     PUT ("SECOND LINE OF OUTPUT");
+
+     GET_LINE (IN_STR, LST);
+     IF IN_STR (1 .. LST) /= "INITIAL TEXT OF FILE_IN" THEN
+          FAILED ("DEFAULT INPUT INCORRECT");
+     END IF;
+
+     CHECK_FILE (FILE_IN, "INITIAL TEXT OF FILE_IN#@%");
+     SET_OUTPUT (FILE => STANDARD_OUTPUT);
+     SET_INPUT (FILE => STANDARD_INPUT);
+     CHECK_FILE (FILE_OUT, "INITIAL TEXT OF FILE_OUT#" &
+                           "SECOND LINE OF OUTPUT#@%");
+
+     SPECIAL_ACTION ("THE STANDARD OUTPUT FILE SHOULD CONTAIN " &
+                     "THE LINE : INITIAL TEXT OF STANDARD_OUTPUT");
+
+     BEGIN
+          DELETE (FILE_IN);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     BEGIN
+          DELETE (FILE_OUT);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NULL;
+     END;
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END EE3203A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3204a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3204a.ada
new file mode 100644
index 000000000..2482b1940
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3204a.ada
@@ -0,0 +1,128 @@
+-- EE3204A.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 AFTER THE DEFAULT FILES HAVE BEEN REDEFINED,
+--     OUTPUT ON THE STANDARD FILES IS STILL PROPERLY HANDLED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- PASS/FAIL CRITERIA:
+--     THIS TEST IS PASSED IF IT EXECUTES, PRINTS TENTATIVELY PASSED,
+--     AND THE CONTENTS OF THE STANDARD OUTPUT FILE ARE CORRECT.
+
+-- HISTORY:
+--     JLH 07/08/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+WITH TEXT_IO; USE TEXT_IO;
+
+PROCEDURE EE3204A IS
+
+     FILE1, FILE2 : FILE_TYPE;
+     ITEM : CHARACTER := 'B';
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("EE3204A", "CHECK THAT AFTER THE DEFAULT FILES HAVE BEEN " &
+                      "REDEFINED, OUTPUT ON THE STANDARD " &
+                      "FILES IS STILL PROPERLY HANDLED");
+
+     BEGIN
+
+          BEGIN
+               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
+                                    "WITH MODE OUT_FILE");
+                    RAISE INCOMPLETE;
+               WHEN OTHERS =>
+                    FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME(2));
+          PUT (FILE2, 'A');
+          NEW_LINE (FILE2);
+          PUT (FILE2, 'B');
+
+          CLOSE (FILE2);
+
+          BEGIN
+               OPEN (FILE2, IN_FILE, LEGAL_FILE_NAME(2));
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
+                                    "WITH MODE IN_FILE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_INPUT (FILE2);
+
+          GET (ITEM);
+          IF ITEM /= 'A' THEN
+               FAILED ("INCORRECT VALUE READ FROM DEFAULT FILE");
+          END IF;
+
+          SET_OUTPUT (FILE1);
+
+          PUT ("THIS TEST FAILS IF THIS APPEARS IN STANDARD OUTPUT");
+          NEW_LINE;
+          PUT ("THIS TEST FAILS IF THIS APPEARS IN STANDARD OUTPUT");
+
+          PUT (STANDARD_OUTPUT, "FIRST LINE OF INPUT");
+          NEW_LINE (STANDARD_OUTPUT);
+          PUT (STANDARD_OUTPUT, "SECOND LINE OF INPUT");
+
+          SPECIAL_ACTION ("CHECK THAT THE CONTENTS OF THE STANDARD " &
+                          "OUTPUT FILE ARE CORRECT");
+          SPECIAL_ACTION ("IT SHOULD CONTAIN:");
+          SPECIAL_ACTION ("TEST HEADER LINES");
+          SPECIAL_ACTION ("FIRST LINE OF INPUT");
+          SPECIAL_ACTION ("SECOND LINE OF INPUT");
+
+          BEGIN
+               DELETE (FILE1);
+               DELETE (FILE2);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END EE3204A;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3402b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3402b.ada
new file mode 100644
index 000000000..ee6660b1d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3402b.ada
@@ -0,0 +1,118 @@
+-- EE3402B.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 NEW_LINE HAS AN OPTIONAL SPACING PARAMETER WITH
+--     DEFAULT VALUE ONE, AND CHECK THAT NEW_LINE OPERATES ON THE
+--     CURRENT DEFAULT OUTPUT FILE IF NO FILE IS SPECIFIED.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- PASS/FAIL CRITERIA:
+--     THIS TEST IS PASSED IF IT EXECUTES, PRINTS TENTATIVELY PASSED,
+--     AND THE CONTENTS OF THE STANDARD OUTPUT FILE ARE CORRECT.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/16/82
+--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     DWC 08/19/87  ADDED SPECIAL ACTION FUNCTION AND REMOVED
+--                   EXCEPTION HANDLERS.  CHANGED TO AN E TEST.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+WITH CHECK_FILE;
+
+PROCEDURE EE3402B IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE, FILE_OUT : FILE_TYPE;
+     SPAC : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
+     TWO : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
+     FOUR : CONSTANT POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
+     CUR_LINE : COUNT;
+
+BEGIN
+
+     TEST ("EE3402B", "CHECK THAT NEW_LINE HAS AN OPTIONAL " &
+                      "SPACING PARAMETER WITH DEFAULT VALUE ONE, " &
+                      "AND CHECK THAT NEW_LINE OPERATES ON THE " &
+                      "CURRENT DEFAULT OUTPUT FILE IF NO FILE IS " &
+                      "SPECIFIED.");
+
+     BEGIN
+          CREATE (FILE);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
+                               "WITH OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE - 1");
+               RAISE INCOMPLETE;
+     END;
+
+     CREATE (FILE_OUT);
+
+     SPECIAL_ACTION ("CHECK OUTPUT FOR FOUR BLANK LINES");
+
+     NEW_LINE (FILE);
+     IF LINE (FILE) /= TWO THEN
+          FAILED ("SPACING DEFAULT NOT ONE");
+     END IF;
+
+     SPECIAL_ACTION ("FOUR BLANK LINES SHOULD FOLLOW THIS COMMENT");
+     CUR_LINE := LINE (STANDARD_OUTPUT);
+     NEW_LINE (SPAC);
+     IF LINE (STANDARD_OUTPUT) /= CUR_LINE + 4 THEN
+          FAILED ("FILE DEFAULT NOT CORRECT FOR STANDARD_OUTPUT");
+     END IF;
+
+     SET_OUTPUT (FILE_OUT);
+     NEW_LINE (SPAC);
+     IF LINE (CURRENT_OUTPUT) /= FOUR + 1 THEN
+          FAILED ("FILE DEFAULT NOT CORRECT FOR CURRENT_OUTPUT");
+     END IF;
+
+     SET_OUTPUT (STANDARD_OUTPUT);      -- RESET STANDARD OUTPUT
+     COMMENT ("CHECKING FILE");
+     CHECK_FILE (FILE, "#@%");
+     COMMENT ("CHECKING FILE_OUT");
+     CHECK_FILE (FILE_OUT, "####@%");
+
+     CLOSE (FILE);
+     CLOSE (FILE_OUT);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END EE3402B;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3409f.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3409f.ada
new file mode 100644
index 000000000..8460c4665
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3409f.ada
@@ -0,0 +1,103 @@
+-- EE3409F.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 FILE PARAMETER FOR SET_COL IS OPTIONAL, AND
+--     THAT THE FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT
+--     OUTPUT FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     CREATION OF TEMPORARY TEXT FILES WITH OUT_FILE MODE.
+
+-- PASS/FAIL CRITERIA:
+--     THIS TEST IS PASSED IF IT EXECUTES, PRINTS TENTATIVELY PASSED,
+--     AND THE CONTENTS OF THE STANDARD OUTPUT FILE ARE CORRECT.
+
+-- HISTORY:
+--     ABW 08/26/82
+--     SPS 09/20/82
+--     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
+--                   RESULT WHEN FILES ARE NOT SUPPORTED.
+--     JLH 08/31/87  CORRECTED EXCEPTION HANDLING, CHECKED FOR
+--                   USE_ERROR ON DELETE, AND RENAMED FROM
+--                   CE3409F.ADA.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE EE3409F IS
+
+     INCOMPLETE : EXCEPTION;
+     FILE_OUT : FILE_TYPE;
+     TWO   : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
+     THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
+
+BEGIN
+
+     TEST ("EE3409F", "CHECK DEFAULT FILE FOR SET_COL");
+
+     BEGIN
+          CREATE (FILE_OUT);
+     EXCEPTION
+          WHEN USE_ERROR =>
+               NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                               "FOR TEMPORARY FILES WITH " &
+                               "OUT_FILE MODE");
+               RAISE INCOMPLETE;
+          WHEN OTHERS =>
+               FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
+               RAISE INCOMPLETE;
+     END;
+
+     SPECIAL_ACTION ("THE NEXT LINE SHOULD BEGIN IN COLUMN TWO");
+
+     SET_COL (TWO);
+     PUT ("SHOULD BEGIN IN COLUMN TWO");
+
+     IF COL (STANDARD_OUTPUT) /= 28 THEN
+          FAILED ("SET_COL DOES NOT OPERATE ON THE DEFAULT " &
+                  "STANDARD_OUTPUT");
+     END IF;
+
+     NEW_LINE;
+
+     SET_OUTPUT (FILE_OUT);
+     SET_COL (THREE);
+     IF COL (CURRENT_OUTPUT) /= THREE THEN
+          FAILED ("SET_COL DOES NOT OPERATE ON THE DEFAULT " &
+                  "CURRENT_OUTPUT");
+     END IF;
+
+     CLOSE (FILE_OUT);
+
+     RESULT;
+
+EXCEPTION
+     WHEN INCOMPLETE =>
+          RESULT;
+
+END EE3409F;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3412c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3412c.ada
new file mode 100644
index 000000000..b5c10ab49
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/e/ee3412c.ada
@@ -0,0 +1,144 @@
+-- EE3412C.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 LINE OPERATES ON THE CURRENT DEFAULT OUTPUT FILE WHEN
+--     NO FILE IS SPECIFIED.  CHECK THAT LINE CAN OPERATE ON FILES OF
+--     MODE IN_FILE AND OUT_FILE, INCLUDING THE CURRENT DEFAULT
+--     INPUT_FILE.
+
+-- APPLICABILITY CRITERIA:
+--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
+--     TEXT FILES.
+
+-- PASS/FAIL CRITERIA:
+--     THIS TEST IS PASSED IF IT EXECUTES, PRINTS TENTATIVELY PASSED,
+--     AND THE CONTENTS OF THE STANDARD OUTPUT FILE ARE CORRECT.
+
+-- HISTORY:
+--     SPS 09/29/82
+--     JBG 08/30/83
+--     JLH 09/02/87  REMOVED DEPENDENCE ON RESET, REMOVED UNNECESSARY
+--                   CODE, CHECKED FOR USE_ERROR ON DELETE, AND RENAMED
+--                   FROM CE3412C.ADA.
+
+WITH REPORT;
+USE REPORT;
+WITH TEXT_IO;
+USE TEXT_IO;
+
+PROCEDURE EE3412C IS
+     INCOMPLETE : EXCEPTION;
+
+BEGIN
+
+     TEST ("EE3412C", "CHECK THAT LINE OPERATES ON DEFAULT IN_FILE " &
+                      "AND OUT_FILE FILES");
+
+     DECLARE
+          F1, F2 : FILE_TYPE;
+          C : POSITIVE_COUNT;
+          X : CHARACTER;
+          ITEM : STRING (1..6);
+     BEGIN
+          C := LINE (STANDARD_OUTPUT);
+          NEW_LINE (STANDARD_OUTPUT);
+          SPECIAL_ACTION ("ONE BLANK LINE SHOULD PRECEDE THIS COMMENT");
+          IF LINE /= C+2 THEN
+               FAILED ("DEFAULT FOR LINE NOT STANDARD_OUTPUT");
+          END IF;
+
+          BEGIN
+               CREATE (F1, OUT_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
+                                    "WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+               WHEN NAME_ERROR =>
+                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
+                                    "CREATE WITH OUT_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          CREATE (F2, OUT_FILE);
+
+          SET_OUTPUT (F2);
+
+          FOR I IN 1 .. 6 LOOP
+               PUT (F1, "STRING");
+               NEW_LINE (F1);
+          END LOOP;
+          IF LINE (F1) /= 7 THEN
+               FAILED ("LINE INCORRECT SUBTEST 1");
+          END IF;
+
+          SET_LINE_LENGTH (3);
+          PUT ("OUTPUT STRING");
+          IF LINE /= LINE(F2) THEN
+               FAILED ("LINE INCORRECT SUBTEST 2");
+          END IF;
+
+          CLOSE (F1);
+
+          BEGIN
+               OPEN (F1, IN_FILE, LEGAL_FILE_NAME);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
+                                    "WITH IN_FILE MODE");
+                    RAISE INCOMPLETE;
+          END;
+
+          SET_INPUT (F1);
+
+          GET (F1, ITEM);
+          IF ITEM /= "STRING" THEN
+               FAILED ("INCORRECT VALUE READ");
+          END IF;
+
+          SKIP_LINE(F1);
+          SKIP_LINE(F1);
+          SKIP_LINE(F1);
+          IF LINE (CURRENT_INPUT) /= 4 AND LINE (F1) /= 4 THEN
+               FAILED ("LINE INCORRECT SUBTEST 3");
+          END IF;
+
+          BEGIN
+               DELETE (F1);
+          EXCEPTION
+               WHEN USE_ERROR =>
+                    NULL;
+          END;
+
+          CLOSE (F2);
+
+     EXCEPTION
+          WHEN INCOMPLETE =>
+               NULL;
+     END;
+
+     RESULT;
+
+END EE3412C;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140010.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140010.a
new file mode 100644
index 000000000..58ba66195
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140010.a
@@ -0,0 +1,51 @@
+-- LA140010.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:
+--      See LA140011.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140011.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140011.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140010.A
+--         LA140011.AM
+--         LA140012.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140011.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+package LA140010_0 is
+     TC_Var : integer := 100;
+end LA140010_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140011.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140011.am
new file mode 100644
index 000000000..7fd722def
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140011.am
@@ -0,0 +1,104 @@
+-- LA140011.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a library level function body depends
+--      on a unit that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a package, a function that withs the
+--      package, and a procedure that withs the function.  Then, 
+--      a new version of the package is compiled (in a separate
+--      file, simulating an editing modification to the package).
+--      Unless automatic recompilation is supported, this 
+--      test should fail to link.  Otherwise, the test should 
+--      recompile and link the correct version of the withed package 
+--      and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140010 (and include the results in the
+--            program library).
+--         2) Compile the file LA140011 (and include the results in the
+--            program library).
+--         3) Compile the file LA140012 (and include the results in the
+--            program library).
+--         4) Attempt to build an executable image.
+--         5) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140010.A
+--      -> LA140011.AM
+--         LA140012.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA140011_0 is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007I baseline version
+--     08 MAY 95   SAIC        Initial version
+--     16 NOV 96   SAIC        Changed unit and file names to conform to
+--                             coding standards. Modified prologue.
+--     07 DEC 96   SAIC        Moved LA140010_0 to a separate file.
+--
+--!
+
+function LA140011_0 return integer;
+
+with LA140010_0;
+function LA140011_0 return integer is
+begin
+     return LA140010_0.TC_Var;
+end LA140011_0;
+
+with Report; use Report;
+with LA140011_0;
+procedure LA140011 is
+     TC_Val : integer := 0;
+begin
+     Test ("LA14001", "Check that a compilation unit " &
+                      "may not depend semantically on " &
+                      "two different versions of the same " &
+                      "compilation unit.  Check the case " &
+                      "where a library level function body " &
+                      "depends on a unit that is changed");
+
+     TC_Val := LA140011_0;
+     if TC_Val = 100 then
+          Failed ("Revised package not used");
+     elsif TC_Val /= -10 then
+          Failed ("Incorrect test value returned");
+     end if;
+
+     Result;
+end LA140011;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140012.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140012.a
new file mode 100644
index 000000000..1dc8a7c92
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140012.a
@@ -0,0 +1,55 @@
+-- LA140012.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:
+--      See LA140011.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140011.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140011.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140010.A
+--         LA140011.AM
+--      -> LA140012.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140011.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007I baseline version
+--     08 MAY 95   SAIC        Initial version
+--     16 NOV 96   SAIC        Modified prologue to conform to standards.
+--     07 DEC 96   SAIC        Modified prologue to reflect new test
+--                             file organization.
+--
+--!
+
+package LA140010_0 is
+     TC_Var : integer := -10;
+end LA140010_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140020.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140020.a
new file mode 100644
index 000000000..6b49ca2d1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140020.a
@@ -0,0 +1,60 @@
+-- LA140020.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:
+--      See LA140021.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140021.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140021.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140020.A
+--         LA140021.AM
+--         LA140022.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140021.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+package LA140020_0 is
+     procedure P (TC_change : out integer);
+
+     TC_Var : integer := 100;
+end LA140020_0;
+
+package body LA140020_0 is
+     procedure P (TC_change : out integer) is 
+     begin 
+          TC_change := TC_Var;
+     end P;
+end LA140020_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140021.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140021.am
new file mode 100644
index 000000000..963e17137
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140021.am
@@ -0,0 +1,98 @@
+-- LA140021.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a unit depends on a package whose
+--      declaration is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles the specification of a package containing
+--      the specification of a procedure.  Then it compiles the body 
+--      of the package containing the body of the procedure and the 
+--      main test procedure.  The main procedure withs the first 
+--      package and calls the procedure in the first package.  Then, 
+--      the withed package specification is changed and recompiled.  
+--      Unless automatic recompilation is supported, this test should 
+--      fail to link.  Otherwise, the test should recompile the package 
+--      body and main procedure, link the correct versions of the unit, 
+--      and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140020 (and include the results in the
+--            program library).
+--         2) Compile the file LA140021 (and include the results in the
+--            program library).
+--         3) Compile the file LA140022 (and include the results in the
+--            program library).
+--         4) Attempt to build an executable image.
+--         5) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140020.A
+--      -> LA140021.AM
+--         LA140022.A
+--
+-- PASS/FAIL CRITERIA:                
+--      The test passes if a link time error message reports that 
+--      LA140020_0 is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007J baseline version
+--     08 MAY 95   SAIC        Initial version
+--     16 NOV 96   SAIC        Changed unit and file names to conform to
+--                             coding conventions.
+--     07 DEC 96   SAIC        Moved LA140020_0 to a separate file.
+--
+--!
+
+with Report; use Report;
+with LA140020_0;
+
+procedure LA140021 is
+     TC_Val : integer := 0;
+begin
+     Test ("LA14002", "Check that a compilation unit may not depend " &
+                      "semantically on two different versions of " &
+                      "the same compilation unit.  Check the case " &
+                      "where a unit depends on a package whose " &
+                      "declaration is changed");
+
+     LA140020_0.P (TC_Val);
+     if TC_Val = 100 then
+          Failed ("Changed unit not used");
+     elsif TC_Val /= -10 then
+          Failed ("Incorrect test value");
+     end if;
+
+     Result;
+end LA140021;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140022.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140022.a
new file mode 100644
index 000000000..75a4c4483
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140022.a
@@ -0,0 +1,66 @@
+-- LA140022.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:
+--      See LA140021.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140021.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140021.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140020.A
+--         LA140021.AM
+--      -> LA140022.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140021.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007J baseline version
+--     08 MAY 95   SAIC        Initial version
+--     16 NOV 96   SAIC        Modified prologue to conform to coding
+--                             conventions.
+--     07 DEC 96   SAIC        Modified prologue to reflect new test
+--                             file organization. Added body for unit to
+--                             allow automatic recompilation.
+--
+--!
+
+package LA140020_0 is
+     procedure P (TC_change : out integer);
+
+     TC_Var : integer := -10;
+end LA140020_0;
+
+package body LA140020_0 is
+     procedure P (TC_change : out integer) is 
+     begin 
+          TC_change := TC_Var;
+     end P;
+end LA140020_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140030.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140030.a
new file mode 100644
index 000000000..82d97e787
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140030.a
@@ -0,0 +1,57 @@
+-- LA140030.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:
+--      See LA140032.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140032.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140032.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--    =>   LA140030.A
+--         LA140031.A
+--         LA140032.AM
+--         LA140033.A 
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140032.AM.
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007K baseline version
+--     09 MAY 95   SAIC        Initial version
+--     16 NOV 96   SAIC        Modified prologue to conform to coding
+--                             conventions.
+--
+--!
+
+package LA140030 is
+     TC_named_number : constant := 100;
+     TC_Var : integer := 100;
+end LA140030;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140031.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140031.a
new file mode 100644
index 000000000..250162b28
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140031.a
@@ -0,0 +1,66 @@
+-- LA140031.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:
+--      See LA140032.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140032.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140032.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140030.A
+--    =>   LA140031.A
+--         LA140032.AM
+--         LA140033.A 
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140032.AM.
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007K baseline version
+--     09 MAY 95   SAIC        Initial version
+--     16 NOV 96   SAIC        Modified prologue to conform to coding
+--                             conventions.
+--
+--!
+
+package LA140031 is
+     procedure P (TC_Change : out integer);
+end LA140031;
+
+with LA140030;     -- when LA140030 is revised and recompiled,
+                   -- this semantic dependency has to be handled
+
+package body LA140031 is
+     procedure P (TC_Change : out integer) is 
+     begin
+          TC_Change := LA140030.TC_Var;
+     end P;
+end LA140031;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140032.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140032.am
new file mode 100644
index 000000000..89984be12
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140032.am
@@ -0,0 +1,101 @@
+-- LA140032.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a package body depends on a package
+--      specification that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a package specification, then a second
+--      package specification and body that withs the first package, 
+--      followed by a procedure that makes a call to a procedure 
+--      contained inside the second package.  Then, the first 
+--      package specification is recompiled, making the body of 
+--      package LA140031 obsolete.  Unless automatic recompilation 
+--      is supported this test should fail to link.  Otherwise, the 
+--      test should recompile and link the correct version of the 
+--      withed package and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140030 (and include the results in the
+--            program library).
+--         2) Compile the file LA140031 (and include the results in the
+--            program library).
+--         3) Compile the file LA140032 (and include the results in the
+--            program library).
+--         4) Compile the file LA140033 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140030.A
+--         LA140031.A
+--    =>   LA140032.AM
+--         LA140033.A 
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA140031 is missing or obsolete, and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007K baseline version
+--     09 MAY 95   SAIC        Initial version
+--     16 NOV 96   SAIC        Changed main program name and prologue
+--                             to conform to coding conventions.
+--
+--!
+
+
+with Report; use Report;
+with LA140031;
+procedure LA140032 is
+     TC_Val : integer := 0;
+begin
+     Test ("LA14003", "Check that a compilation unit may not " &
+                      "depend semantically on two different " &
+                      "versions of the same compilation unit.  " &
+                      "Check the case where a package body " &
+                      "depends on a package specification that " &
+                      "is changed");
+
+     LA140031.P (TC_Val);
+
+     if TC_Val = 100 then
+          Failed ("Obsolete unit elaborated");
+     elsif TC_Val /= -10 then
+          Failed ("Incorrect test value");
+     end if;
+
+     Result;
+end LA140032;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140033.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140033.a
new file mode 100644
index 000000000..9d7f13366
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140033.a
@@ -0,0 +1,56 @@
+-- LA140033.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:
+--      See LA140032.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140032.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140032.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140030.A
+--         LA140031.A
+--         LA140032.AM
+--    =>   LA140033.A 
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140032.AM.
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007K baseline version
+--     09 MAY 95   SAIC        Initial version
+--     16 NOV 96   SAIC        Modified prologue to conform to coding
+--                             conventions.
+--
+--!
+
+package LA140030 is
+     TC_Var : integer := -10;
+end LA140030;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140040.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140040.a
new file mode 100644
index 000000000..eef6d9874
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140040.a
@@ -0,0 +1,52 @@
+-- LA140040.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:
+--      See LA140041.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140041.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140041.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140040.A
+--         LA140041.AM
+--         LA140042.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140041.AM.
+--
+-- CHANGE HISTORY:
+--     09 MAY 95   SAIC    Initial version
+--     10 DEC 96   SAIC    Reorganized to permit automatic recompilation.
+--
+--!
+
+package LA14004_0 is
+     TC_Var : integer := 100;
+end LA14004_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140041.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140041.am
new file mode 100644
index 000000000..00470b2e2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140041.am
@@ -0,0 +1,108 @@
+-- LA140041.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a generic function depends on a 
+--      library level package.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a package specification, then a generic 
+--      function specification and body that withs the package, 
+--      followed by a procedure that makes a call to an instance of
+--      the generic function.  Then, the package specification is
+--      recompiled, making the body of function LA14004_1 obsolete.
+--      Unless automatic recompilation is supported this test should fail
+--      to link.  Otherwise, the test should recompile and link 
+--      the correct version of the withed package and report
+--      "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140040 (and include the results in the
+--            program library).
+--         2) Compile the file LA140041 (and include the results in the
+--            program library).
+--         3) Compile the file LA140042 (and include the results in the
+--            program library).
+--         4) Attempt to build an executable image.
+--         5) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140040.A
+--      -> LA140041.AM
+--         LA140042.A
+--
+-- PASS/FAIL CRITERIA:                
+--      Expect a link-time error message that the body of generic 
+--      function LA14004_1 is missing or obsolete.  If automatic
+--      recompilation is supported, and an executable image is 
+--      built, expect a "PASSED" message from execution.
+--
+-- CHANGE HISTORY:
+--     09 MAY 95   SAIC    Initial version
+--     10 DEC 96   SAIC    Reorganized to permit automatic recompilation.
+--
+--!
+
+generic
+function LA14004_1 return integer;
+
+with LA14004_0;     -- Revision and recompilation of LA14004_0
+                    -- will require resolution of this semantic
+                    -- dependency
+function LA14004_1 return integer is
+begin
+     return LA14004_0.TC_Var;
+end LA14004_1;
+
+
+
+with Report; use Report;
+with LA14004_1;
+procedure LA140041 is
+     TC_Val : integer := 0;
+
+     function F_LA14004_1 is new LA14004_1;
+begin
+     Test ("LA14004", "Check that a compilation unit may " &
+                      "not depend semantically on two " &
+                      "different versions of the same " &
+                      "compilation unit.  Check the case " &
+                      "where a generic function depends on a "&
+                      "library level package");
+
+      TC_Val := F_LA14004_1;
+
+      if TC_Val = 100 then
+           Failed ("Obsolete unit used in elaboration");
+      elsif TC_Val /= -10 then
+           Failed ("Incorrect test value returned");
+      end if;
+
+     Result;
+end LA140041;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140042.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140042.a
new file mode 100644
index 000000000..bb4ba6c09
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140042.a
@@ -0,0 +1,53 @@
+-- LA140042.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:
+--      See LA140041.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140041.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140041.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140040.A
+--         LA140041.AM
+--      -> LA140042.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140041.AM.
+--
+-- CHANGE HISTORY:
+--     09 MAY 95   SAIC    Initial version
+--     10 DEC 96   SAIC    Reorganized to permit automatic recompilation.
+--
+--!
+
+package LA14004_0 is
+     Small_array : array (1..15) of integer;
+     TC_Var : integer := -10;
+end LA14004_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140050.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140050.a
new file mode 100644
index 000000000..542c1ffdd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140050.a
@@ -0,0 +1,60 @@
+-- LA140050.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:
+--     See LA140052.AM.
+--
+-- TEST DESCRIPTION:
+--     See LA140052.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--     See LA140052.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140050.A
+--         LA140051.A
+--         LA140052.AM
+--         LA140053.A
+--
+-- PASS/FAIL CRITERIA:
+--     See LA140052.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+generic
+     hi : integer;
+     lo : integer;
+     type flt is digits <>;
+package LA14005_0 is
+     TC_var : flt := flt(lo);
+     type gen_flt is new flt range flt(lo)..flt(hi);
+     max : integer := hi;
+     min : integer := lo;
+     avg : integer := (hi + lo)/ (integer(2.0));
+end LA14005_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140051.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140051.a
new file mode 100644
index 000000000..6af550a3a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140051.a
@@ -0,0 +1,56 @@
+-- LA140051.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:
+--     See LA140052.AM.
+--
+-- TEST DESCRIPTION:
+--     See LA140052.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--     See LA140052.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140050.A
+--      -> LA140051.A
+--         LA140052.AM
+--         LA140053.A
+--
+-- PASS/FAIL CRITERIA:
+--     See LA140052.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+with LA14005_0;
+generic 
+     with package types is new LA14005_0 (<>);
+package LA14005_1 is
+     TC_constant_flt : constant types.gen_flt := types.gen_flt(types.avg);
+     function return_flt return types.gen_flt;
+end LA14005_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140052.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140052.am
new file mode 100644
index 000000000..8e6c59eb8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140052.am
@@ -0,0 +1,110 @@
+-- LA140052.AM
+--
+--                             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 compilation unit may not depend semantically on two 
+--      different versions of the same compilation unit.  Check the case 
+--      where a generic package body depends on a generic package 
+--      specification.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a generic package specification and body, 
+--      followed by a procedure that makes a call to a procedure
+--      contained inside the generic package.  Then, the generic package
+--      specification is recompiled, making the body of the generic
+--      package obsolete.  Unless automatic recompilation is 
+--      supported this test should fail to link.  Otherwise, the test should 
+--      recompile and link the correct version of the units and report
+--      "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140050 (and include the results in the
+--            program library).
+--         2) Compile the file LA140051 (and include the results in the
+--            program library).
+--         3) Compile the file LA140052 (and include the results in the
+--            program library).
+--         4) Compile the file LA140053 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140050.A
+--         LA140051.A
+--      -> LA140052.AM
+--         LA140053.A
+--
+-- PASS/FAIL CRITERIA:                
+--      Expect a link-time error message that the body of generic
+--      package LA14005_1 is missing or obsolete.  If automatic
+--      recompilation is supported, and an executable image is 
+--      built, expect a "PASSED" message from execution.
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008I baseline version
+--     09 MAY 95   SAIC        Initial version
+--     08 NOV 96   SAIC        Unit naming correction
+--     07 DEC 96   SAIC        Moved spec of LA14005_1 to a separate file.
+--
+--!
+
+package body LA14005_1 is
+     function return_flt return types.gen_flt is
+     begin
+          return types.gen_flt(types.TC_var);
+     end return_flt;
+begin
+     types.TC_var := types.flt(TC_constant_flt);
+end LA14005_1;
+
+          ---------------------------------------------------------
+
+with Report; use Report;
+with LA14005_0;
+with LA14005_1;
+procedure LA140052 is
+     subtype TC_flt is float digits 5;
+
+     package Y is new LA14005_0 (integer(100.0), integer(0.0), TC_flt);
+     package inst is new LA14005_1 (Y);
+     TC_var : TC_flt;
+begin
+     Test ("LA14005", "Check that a compilation unit may not depend " &
+           "semantically on two different versions of the same " &
+           "compilation unit. Check the case where a generic package " &
+           "body depends on a generic package specification");
+
+     TC_var := TC_flt(inst.return_flt);
+
+     if TC_Var /= TC_flt(Y.min) then
+          Failed ("Obsolete unit used in elaboration");
+     end if;
+
+     Result;
+end LA140052;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140053.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140053.a
new file mode 100644
index 000000000..406b3abb0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140053.a
@@ -0,0 +1,60 @@
+-- LA140053.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:
+--     See LA140052.AM.
+--
+-- TEST DESCRIPTION:
+--     See LA140052.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--     See LA140052.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140050.A
+--         LA140051.A
+--         LA140052.AM
+--      -> LA140053.A
+--
+-- PASS/FAIL CRITERIA:
+--     See LA140052.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008I baseline version
+--     09 MAY 95   SAIC        Initial version
+--     07 DEC 96   SAIC        Modified prologue to reflect new test
+--                             file organization.
+--
+--!
+
+with LA14005_0;
+generic 
+     with package types is new LA14005_0 (<>);
+package LA14005_1 is
+     TC_constant_flt : constant 
+             types.gen_flt := types.gen_flt(types.min);  --changed line
+     function return_flt return types.gen_flt;
+end LA14005_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140060.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140060.a
new file mode 100644
index 000000000..4f54da1e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140060.a
@@ -0,0 +1,54 @@
+-- LA140060.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:
+--      See LA140062.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140062.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140062.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140060.A
+--         LA140061.A
+--         LA140062.AM
+--         LA140063.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140062.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+package LA14006_types is 
+     type t_type is tagged record
+          f : integer := 87;
+     end record;
+end LA14006_types;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140061.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140061.a
new file mode 100644
index 000000000..40ff151cb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140061.a
@@ -0,0 +1,66 @@
+-- LA140061.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:
+--      See LA140062.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140062.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140062.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140060.A
+--      -> LA140061.A
+--         LA140062.AM
+--         LA140063.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140062.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+with LA14006_types;
+use  LA14006_types;
+generic
+     type t is new t_type with private;
+package LA14006_0 is
+
+     type T2 is new t with record 
+          g : integer := 100;
+     end record;
+     
+     TC_var : T2;
+     
+private 
+     type type_t is new t with record
+          g2 : integer := 99;
+     end record;
+end LA14006_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140062.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140062.am
new file mode 100644
index 000000000..9cfb8ddf2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140062.am
@@ -0,0 +1,135 @@
+-- LA140062.AM
+--
+--                             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 compilation unit may not depend semantically 
+--      on two different versions of the same compilation unit.
+--      Check the case where a generic package depends on another
+--      generic package specification.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a generic package specification, then
+--      compiles a generic package specification and body, 
+--      followed by a procedure that makes a call to a procedure
+--      contained inside the second generic package.  Then, the
+--      first generic package specification is recompiled, 
+--      making the body of the generic package LA140060 obsolete.
+--      Unless automatic recompilation is supported this test should 
+--      fail to link.  Otherwise, the test should recompile and link 
+--      the correct version of the units and report "PASSED" at 
+--      execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140060 (and include the results in the
+--            program library).
+--         2) Compile the file LA140061 (and include the results in the
+--            program library).
+--         3) Compile the file LA140062 (and include the results in the
+--            program library).
+--         4) Compile the file LA140063 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140060.A
+--         LA140061.A
+--      -> LA140062.AM
+--         LA140063.A
+--
+-- PASS/FAIL CRITERIA:                
+--      Expect a link-time error message that the body of generic
+--      package LA14006_1 is missing or obsolete.  If automatic
+--      recompilation is supported, and an executable image is 
+--      built, expect a "PASSED" message from execution.
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008K baseline version
+--     09 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Moved LA14006_0 to a separate file. Added
+--                             pragma Elaborate to context clause of LA14006_2.
+--
+--!
+
+with LA14006_0;
+with LA14006_types;
+use  LA14006_types;
+generic
+     type additional is (<>);
+     add_val : additional;
+package LA14006_1 is
+     type T3 is new t_type with record
+          h: additional := add_val;
+     end record;
+ 
+     procedure P (TC_Change : out integer);
+
+     package inst is new LA14006_0 (T3);
+end LA14006_1;
+
+----------------------------------------------------------------
+
+package body LA14006_1 is
+     procedure P (TC_Change : out integer) is 
+     begin 
+           TC_Change := inst.TC_Var.g;
+     end P;
+end LA14006_1;
+
+----------------------------------------------------------------
+
+with LA14006_1;
+pragma Elaborate (LA14006_1);
+package LA14006_2 is new LA14006_1 (integer, 300);
+
+----------------------------------------------------------------
+
+with Report; use Report;
+with LA14006_2;
+procedure LA140062 is
+     TC_Val : integer := 0;
+begin
+     Test ("LA14006", "Check that a compilation unit may not " &
+                      "depend semantically on two different " &
+                      "versions of the same compilation unit. " &
+                      "Check the case where a generic package " &
+                      "depends on another generic package " &
+                      "specification");
+
+     LA14006_2.P (TC_Val);
+
+     if TC_Val = 100 then
+          Failed ("Obsolete unit used in elaboration");
+     elsif TC_Val /= -10 then
+          Failed ("Incorrect test value received");
+     end if;
+
+     Result;
+end LA140062;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140063.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140063.a
new file mode 100644
index 000000000..e4e6457d0
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140063.a
@@ -0,0 +1,70 @@
+-- LA140063.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:
+--      See LA140062.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140062.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140062.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140060.A
+--         LA140061.A
+--         LA140062.AM
+--      -> LA140063.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140062.AM.
+--
+-- CHANGE HISTORY:
+--     09 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Modified prologue to reflect new test
+--                             file organization.
+--
+--!
+
+with LA14006_types;
+use  LA14006_types;
+generic
+     type t is new t_type with private;
+package LA14006_0 is
+     type T2 is new t with record
+          g : integer := -10;
+     end record;
+ 
+     TC_var : T2;
+     Other_var : integer := 12;
+ 
+     private
+          type type_t is new t with record
+               g2 : integer := 88;
+          end record;
+end LA14006_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140070.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140070.a
new file mode 100644
index 000000000..e3c864ac4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140070.a
@@ -0,0 +1,62 @@
+-- LA140070.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:
+--      See LA140072.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140072.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140072.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140070.A
+--         LA140071.A
+--         LA140072.AM
+--         LA140073.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140072.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007L baseline version
+--     12 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+package LA14007_0 is        -- this will be modified and recompiled
+     type mod_16 is new integer;
+     type rec is tagged record
+          f: mod_16 := 12;
+     end record;
+     type t_rec is new rec with record
+          g : mod_16 := -2;
+     end record;
+     TC_Var : t_rec;
+end LA14007_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140071.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140071.a
new file mode 100644
index 000000000..e895b8744
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140071.a
@@ -0,0 +1,72 @@
+-- LA140071.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:
+--      See LA140072.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140072.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140072.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140070.A
+--      -> LA140071.A
+--         LA140072.AM
+--         LA140073.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140072.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007L baseline version
+--     12 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform to coding
+--                             conventions. Deleted extraneous procedure
+--                             specification.
+--
+--!
+
+procedure LA14007_1 (TC_Parent : in out integer);
+
+     --================================================================--
+
+procedure LA14007_1 (TC_Parent : in out integer) is
+     procedure LA14007_2 (TC_Local : in out integer) is separate;
+begin
+     LA14007_2 (TC_Parent);
+end LA14007_1;
+
+     --================================================================--
+
+with LA14007_0;
+
+separate (LA14007_1)
+procedure LA14007_2 (TC_Local : in out integer) is
+begin
+     TC_Local := integer (LA14007_0.TC_Var.f);
+end LA14007_2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140072.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140072.am
new file mode 100644
index 000000000..86ef201fe
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140072.am
@@ -0,0 +1,102 @@
+-- LA140072.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a separate procedure body depends on
+--      a non-generic package specification that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a package specification, a procedure,
+--      the separate procedure body and a main procedure that
+--      withs the first package.  Then, a new version of the
+--      first package specification is compiled (in a separate
+--      file, simulating editing and modification of the unit). 
+--      Unless automatic recompilation is supported, this test
+--      should fail to link.  Otherwise, the test should 
+--      recompile and link the correct version of the withed 
+--      package and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140070 (and include the results in the
+--            program library).
+--         2) Compile the file LA140071 (and include the results in the
+--            program library).
+--         3) Compile the file LA140072 (and include the results in the
+--            program library).
+--         4) Compile the file LA140073 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140070.A
+--         LA140071.A
+--      -> LA140072.AM
+--         LA140073.A 
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14007_1.LA14007_2 is missing or obsolete and no executable 
+--      image results.  The test also passes if an executable image is 
+--      produced and reports "PASSED" (in the case where the implementation
+--      supports automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007L baseline version
+--     12 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+
+with Report; use Report;
+with LA14007_1;
+
+procedure LA140072 is
+     TC_Val : integer := 0;
+begin
+     Test ("LA14007", "Check that a compilation unit may not " &
+                      "depend semantically on two different " &
+                      "versions of the same compilation unit.  " &
+                      "Check the case where a separate procedure " &
+                      "body depends on a non-generic package " &
+                      "specification that is changed");
+
+     LA14007_1 (TC_Val);
+
+     if TC_Val = 12 then
+          Failed ("Obsolete unit used in elaboration");
+     elsif TC_Val /= 3 then
+          Failed ("Incorrect test value returned");
+     end if;
+
+     Result;
+end LA140072;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140073.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140073.a
new file mode 100644
index 000000000..01e071519
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140073.a
@@ -0,0 +1,63 @@
+-- LA140073.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:
+--      See LA140072.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140072.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140072.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140070.A
+--         LA140071.A
+--         LA140072.AM
+--      -> LA140073.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140072.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007L baseline version
+--     12 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+package LA14007_0 is        -- this is the corrected version
+     extra_integer : integer;
+     type mod_16 is new integer;
+     type rec is tagged record
+          f: mod_16 := 3;
+     end record;
+     type t_rec is new rec with record
+          null;
+     end record;
+     TC_Var : t_rec;
+end LA14007_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140080.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140080.a
new file mode 100644
index 000000000..506c18251
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140080.a
@@ -0,0 +1,52 @@
+-- LA140080.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:
+--      See LA140082.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140082.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140082.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140080.A
+--         LA140081.A
+--         LA140082.AM
+--         LA140083.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140082.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12  LA5007M baseline version
+--     25 MAY 95   SAIC       Initial version
+--     10 DEC 96   SAIC       Reorganized to permit automatic recompilation.
+--
+--!
+
+function LA14008_0 return integer;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140081.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140081.a
new file mode 100644
index 000000000..b800da799
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140081.a
@@ -0,0 +1,63 @@
+-- LA140081.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:
+--      See LA140082.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140082.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140082.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140080.A
+--      -> LA140081.A
+--         LA140082.AM
+--         LA140083.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140082.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12  LA5007M baseline version
+--     25 MAY 95   SAIC       Initial version
+--     10 DEC 96   SAIC       Reorganized to permit automatic recompilation.
+--
+--!
+
+function LA14008_0 return integer is
+     TC_local : integer := 0;
+     TC_var   : integer := 100;
+
+     function LA14008_1 return integer is separate;  
+                             -- when LA14008_0 is revised and recompiled,
+                             -- this semantic dependency has to be 
+                             -- handled
+begin
+     TC_local := LA14008_1;
+     return TC_local;
+end LA14008_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140082.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140082.am
new file mode 100644
index 000000000..fc34a466c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140082.am
@@ -0,0 +1,106 @@
+-- LA140082.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a subunit function body depends
+--      on a unit that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a function, separate subunit function 
+--      body, and a procedure that withs the function.  Then, 
+--      a new version of the parent function is compiled (in a separate
+--      file, simulating and editing modification to the package).
+--      Unless automatic recompilation is supported, this 
+--      test should fail to link.  Otherwise, the test should 
+--      recompile and link the correct version of the withed package 
+--      and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140080 (and include the results in the
+--            program library).
+--         2) Compile the file LA140081 (and include the results in the
+--            program library).
+--         3) Compile the file LA140082 (and include the results in the
+--            program library).
+--         4) Compile the file LA140083 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140080.A
+--         LA140081.A
+--      -> LA140082.AM
+--         LA140083.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14008_0.LA14008_1 is missing or obsolete and no executable image
+--      results.  The test passes if an executable image is produced
+--      and reports "PASSED" (in case the implementation supports
+--      automatic recompilation).            
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12  LA5007M baseline version
+--     25 MAY 95   SAIC       Initial version
+--     10 DEC 96   SAIC       Reorganized to permit automatic recompilation.
+--
+--!
+
+separate (LA14008_0)
+
+function LA14008_1 return integer is
+begin
+     return LA14008_0.TC_var;
+end LA14008_1;
+
+    --==================================================================--
+ 
+with Report; use Report;
+with LA14008_0;         
+     
+procedure LA140082 is
+     TC_val    : integer := 0;
+begin
+     Test ("LA14008", "Check that a compilation unit may not depend " &
+                      "semantically on two different versions of " &
+                      "the same compilation unit.  Check the case " &
+                      "where a subunit function body depends on a " &
+                      "unit that is changed");
+ 
+     TC_val := LA14008_0;
+ 
+     if TC_val = 100 then
+          Failed ("Revised unit not used");
+     elsif TC_val /= -10 then
+          Failed ("Incorrect value returned");
+     end if;
+ 
+     Result;
+end LA140082;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140083.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140083.a
new file mode 100644
index 000000000..cad1cf311
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140083.a
@@ -0,0 +1,61 @@
+-- LA140083.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:
+--      See LA140082.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140082.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140082.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140080.A
+--         LA140081.A
+--         LA140082.AM
+--      -> LA140083.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140082.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12  LA5007M baseline version
+--     25 MAY 95   SAIC       Initial version
+--     10 DEC 96   SAIC       Reorganized to permit automatic recompilation.
+--
+
+function LA14008_0 return integer is
+     Another_var : integer := 1000;
+     TC_local : integer := 0;
+     TC_var   : integer := -10;
+
+     function LA14008_1 return integer is separate;
+
+begin
+     TC_local := LA14008_1;
+     return TC_local;
+end LA14008_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140090.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140090.a
new file mode 100644
index 000000000..d2e02c714
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140090.a
@@ -0,0 +1,60 @@
+-- LA140090.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:
+--      See LA140092.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140092.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140092.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140090.A
+--         LA140091.A
+--         LA140092.AM
+--         LA140093.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140092.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007N baseline version
+--     25 MAY 95   SAIC        Initial version
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--
+--!
+
+package LA14009_0 is
+
+     package LA14009_1 is
+
+          procedure P (TC_local : in out integer);
+
+     end LA14009_1;
+
+end LA14009_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140091.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140091.a
new file mode 100644
index 000000000..550b908fb
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140091.a
@@ -0,0 +1,60 @@
+-- LA140091.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:
+--      See LA140092.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140092.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140092.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140090.A
+--      -> LA140091.A
+--         LA140092.AM
+--         LA140093.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140092.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007N baseline version
+--     25 MAY 95   SAIC        Initial version
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--
+--!
+
+package body LA14009_0 is
+     TC_var : integer := 100;
+
+     package body LA14009_1 is separate;
+                             -- when LA14009_0 is revised and recompiled,
+                             -- this semantic dependency has to be 
+                             -- handled
+
+end LA14009_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140092.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140092.am
new file mode 100644
index 000000000..a4f248f95
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140092.am
@@ -0,0 +1,110 @@
+-- LA140092.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a subunit package body depends
+--      on a unit that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a package, separate subunit package 
+--      body, and a procedure that withs the package.  Then, 
+--      a new version of the package is compiled (in a separate
+--      file, simulating and editing modification to the package).
+--      Unless automatic recompilation is supported, this 
+--      test should fail to link.  Otherwise, the test should 
+--      recompile and link the correct version of the withed package 
+--      and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140090 (and include the results in the
+--            program library).
+--         2) Compile the file LA140091 (and include the results in the
+--            program library).
+--         3) Compile the file LA140092 (and include the results in the
+--            program library).
+--         4) Compile the file LA140093 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140090.A
+--         LA140091.A
+--      -> LA140092.AM
+--         LA140093.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14009_0.LA14009_1 is missing or obsolete and no executable image
+--      results.  The test passes if an executable image is produced
+--      and reports "PASSED" (in case the implementation supports
+--      automatic recompilation).            
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007N baseline version
+--     25 MAY 95   SAIC        Initial version
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--
+--!
+
+separate (LA14009_0)
+
+package body LA14009_1 is
+
+     procedure P (TC_local : in out integer) is
+     begin 
+          TC_local := LA14009_0.TC_var;
+     end P;
+
+end LA14009_1;
+
+
+
+with Report; use Report;
+with LA14009_0;
+
+procedure LA140092 is
+     TC_val : integer := 0;
+begin
+     Test ("LA14009", "Check that a compilation unit may not depend " &
+                      "semantically on two different versions of the " &
+                      "same compilation unit.  Check the case where " &
+                      "a subunit package body depends on a unit that " &
+                      "is changed");
+ 
+     LA14009_0.LA14009_1.P(TC_Val);
+ 
+     if TC_val = 100 then
+          Failed ("Revised package body not used");
+     elsif TC_val /= -10 then
+          Failed ("Incorrect value returned");
+     end if;
+ 
+     Result;
+end LA140092;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140093.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140093.a
new file mode 100644
index 000000000..375570675
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140093.a
@@ -0,0 +1,59 @@
+-- LA140093.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:
+--      See LA140092.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140092.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140092.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140090.A
+--         LA140091.A
+--         LA140092.AM
+--      -> LA140093.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140092.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007N baseline version
+--     25 MAY 95   SAIC        Initial version
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--
+--!
+
+package body LA14009_0 is
+     New_TC_var : integer := 50;
+     Dummy_array : array (1..100) of boolean := (others => False);
+     TC_var : constant integer := -10;
+
+     package body LA14009_1 is separate;
+
+end LA14009_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140100.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140100.a
new file mode 100644
index 000000000..dfa786966
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140100.a
@@ -0,0 +1,56 @@
+-- LA140100.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:
+--      See LA140102.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140102.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140102.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140100.A
+--         LA140101.A
+--         LA140102.AM
+--         LA140103.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140102.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008O baseline version
+--     29 JUN 95   SAIC        Initial version
+--     29 FEB 96   SAIC        First revision after review
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+package LA14010_0 is
+     delta_v : integer := 1;
+end LA14010_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140101.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140101.a
new file mode 100644
index 000000000..332f5ff20
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140101.a
@@ -0,0 +1,89 @@
+-- LA140101.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:
+--      See LA140102.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140102.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140102.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140100.A
+--      -> LA140101.A
+--         LA140102.AM
+--         LA140103.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140102.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008O baseline version
+--     29 JUN 95   SAIC        Initial version
+--     29 FEB 96   SAIC        First revision after review
+--     17 NOV 96   SAIC        Modified prologue to conform to coding
+--                             conventions. Changed task to task type.
+--
+--!
+
+generic
+     type scalar is range <>;
+package LA14010_1 is
+     procedure inc (param : in out scalar);   
+end LA14010_1;
+
+with LA14010_0;
+use LA14010_0;
+
+package body LA14010_1 is
+     procedure inc (param : in out scalar) is
+     begin 
+          for i in 1..delta_v loop
+               param := param + 1;
+          end loop;
+     end inc;
+
+     task type inc_task is
+          entry increment (param : in out scalar);
+     end inc_task;
+
+     task body inc_task is separate;
+end LA14010_1;
+
+
+separate (LA14010_1)
+
+task body inc_task is
+     static_zero : integer := 0;
+begin
+     accept increment (param : in out scalar) do
+          static_zero := LA14010_0.delta_v + static_zero;
+          static_zero := static_zero - LA14010_0.delta_v;
+          inc (param);
+     end increment;
+end inc_task;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140102.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140102.am
new file mode 100644
index 000000000..7feb2efea
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140102.am
@@ -0,0 +1,104 @@
+-- LA140102.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a task body depends on a package 
+--      specification.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a package spec, a generic package 
+--      with a body containing a task with a body that withs the 
+--      first package spec, and a main procedure that withs the 
+--      generic package and calls the task.  Then, a new version 
+--      of the package spec is compiled (in a separate file, simulating 
+--      editing and modification of the unit).  Unless automatic 
+--      recompilation is supported, this test should fail to link.  
+--      Otherwise, the test should recompile and link the correct 
+--      version of the package spec and report "PASSED" at 
+--      execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140100 (and include the results in the
+--            program library).
+--         2) Compile the file LA140101 (and include the results in the
+--            program library).
+--         3) Compile the file LA140102 (and include the results in the
+--            program library).
+--         4) Compile the file LA140103 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140100.A
+--         LA140101.A
+--      -> LA140102.AM
+--         LA140103.A 
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14010_1.INC_TASK is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008O baseline version
+--     29 JUN 95   SAIC        Initial version
+--     29 FEB 96   SAIC        First revision after review
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+with Report; use Report;
+with LA14010_1;
+
+procedure LA140102 is
+     subtype scalar_type is integer range 0..100;
+     TC_val : scalar_type := 0;
+     package Gen_pack is new LA14010_1(scalar_type);
+begin
+     Test ("LA14010", "Check that a compilation unit may not " &
+                      "depend semantically on two different " &
+                      "versions of the same compilation unit.  " &
+                      "Check the case where a task body depends " &
+                      "on a package specification");
+
+     Gen_pack.inc(TC_val);
+
+     if TC_val = 1 then
+          Failed ("Old package specification used");
+     elsif TC_val /= 10 then
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140102;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140103.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140103.a
new file mode 100644
index 000000000..a16d7debf
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140103.a
@@ -0,0 +1,58 @@
+-- LA140103.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:
+--      See LA140102.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140102.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140102.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140100.A
+--         LA140101.A
+--         LA140102.AM
+--      -> LA140103.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140102.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008O baseline version
+--     29 JUN 95   SAIC        Initial version
+--     29 FEB 96   SAIC        First revision after review
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+package LA14010_0 is
+     New_var : integer := 100;
+     Local_array : array (1..51) of integer;
+     delta_v : constant integer := 10;
+end LA14010_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140110.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140110.a
new file mode 100644
index 000000000..3f69c92a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140110.a
@@ -0,0 +1,64 @@
+-- LA140110.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:
+--      See LA140112.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140112.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140112.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140110.A
+--         LA140111.A
+--         LA140112.AM
+--         LA140113.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140112.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007P baseline version
+--     25 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+
+procedure LA14011_0 (Change_this : in out integer);
+
+
+procedure LA14011_0 (Change_this : in out integer) is
+begin
+     if Change_this = 10 then
+          Change_this := 100;
+     else 
+          Change_this := 50;
+     end if;
+end LA14011_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140111.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140111.a
new file mode 100644
index 000000000..c3a1cf1a1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140111.a
@@ -0,0 +1,62 @@
+-- LA140111.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:
+--      See LA140112.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140112.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140112.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140110.A
+--      -> LA140111.A
+--         LA140112.AM
+--         LA140113.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140112.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007P baseline version
+--     25 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+
+with LA14011_0;
+
+procedure LA14011_1 (Change_this1 : in out integer);
+
+
+procedure LA14011_1 (Change_this1 : in out integer) is
+begin
+     LA14011_0(Change_this1);
+end LA14011_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140112.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140112.am
new file mode 100644
index 000000000..36dc8ff12
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140112.am
@@ -0,0 +1,103 @@
+-- LA140112.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a library procedure depends
+--      on a unit that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a procedure, a procedure that withs 
+--      the first procedure, and a procedure that withs the second
+--      procedure.  Then, a new version of the first procedure is 
+--      compiled (in a separate file, simulating an editing 
+--      modification to the package).  Unless automatic recompilation 
+--      is supported, this test should fail to link.  Otherwise, the 
+--      test should recompile and link the correct version of the 
+--      withed package and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140110 (and include the results in the
+--            program library).
+--         2) Compile the file LA140111 (and include the results in the
+--            program library).
+--         3) Compile the file LA140112 (and include the results in the
+--            program library).
+--         4) Compile the file LA140113 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140110.A
+--         LA140111.A
+--      -> LA140112.AM
+--         LA140113.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14011_1 is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007P baseline version
+--     25 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+
+with Report; use Report;
+with LA14011_1;              -- when LA14011_0 is revised and recompiled,
+                             -- this semantic dependency has to be 
+                             -- handled
+
+
+procedure LA140112 is
+     TC_val : integer := 10;
+begin
+     Test ("LA14011", "Check that a compilation unit may not depend " &
+                      "semantically on two different versions of " &
+                      "the same compilation unit.  Check the case " &
+                      "where a library procedure depends on a unit " &
+                      "that is changed");
+
+     LA14011_1(TC_val);
+
+     if TC_val = 100 then
+          Failed ("Revised procedure not used");
+     elsif TC_val /= -10 then
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140112;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140113.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140113.a
new file mode 100644
index 000000000..8dd9683e3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140113.a
@@ -0,0 +1,59 @@
+-- LA140113.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:
+--      See LA140112.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140112.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140112.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140110.A
+--         LA140111.A
+--         LA140112.AM
+--      -> LA140113.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140112.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007P baseline version
+--     25 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+procedure LA14011_0 (Change_this : in out integer);
+
+
+procedure LA14011_0 (Change_this : in out integer) is
+begin
+     Change_this := -Change_this;
+end LA14011_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140120.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140120.a
new file mode 100644
index 000000000..d21525ed4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140120.a
@@ -0,0 +1,63 @@
+-- LA140120.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:
+--      See LA140122.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140122.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140122.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140120.A
+--         LA140121.A
+--         LA140122.AM
+--         LA140123.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140122.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007Q baseline version
+--     25 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+function LA14012_0 (Parm_1 : integer) return integer;
+
+
+function LA14012_0 (Parm_1 : integer) return integer is
+begin
+     if Parm_1 >= 0 then
+          return 100;
+     else 
+          return 200;
+     end if;
+end LA14012_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140121.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140121.a
new file mode 100644
index 000000000..e4ea3ed9a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140121.a
@@ -0,0 +1,64 @@
+-- LA140121.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:
+--      See LA140122.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140122.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140122.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140120.A
+--      -> LA140121.A
+--         LA140122.AM
+--         LA140123.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140122.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007Q baseline version
+--     25 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+
+with LA14012_0;
+
+function LA14012_1 return integer;
+
+
+function LA14012_1 return integer is
+     Local_val : integer := 5;
+begin
+     Local_val := LA14012_0 (Parm_1 => Local_val);
+     return Local_val;
+end LA14012_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140122.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140122.am
new file mode 100644
index 000000000..06cacb3e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140122.am
@@ -0,0 +1,102 @@
+-- LA140122.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a library level function depends
+--      on a unit that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a function, a function that withs 
+--      the first function, and a procedure that withs the second
+--      function.  Then, a new version of the first function is 
+--      compiled (in a separate file, simulating an editing 
+--      modification to the package).  Unless automatic recompilation 
+--      is supported, this test should fail to link.  Otherwise, the 
+--      test should recompile and link the correct version of the 
+--      withed package and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140120 (and include the results in the
+--            program library).
+--         2) Compile the file LA140121 (and include the results in the
+--            program library).
+--         3) Compile the file LA140122 (and include the results in the
+--            program library).
+--         4) Compile the file LA140123 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140120.A
+--         LA140121.A
+--      -> LA140122.AM
+--         LA140123.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14012_1 is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007Q baseline version
+--     25 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+with Report; use Report;
+with LA14012_1;              -- when LA14012_0 is revised and recompiled,
+                             -- this semantic dependency has to be 
+                             -- handled
+
+
+procedure LA140122 is
+     TC_local : integer := 5;
+begin
+     Test ("LA14012", "Check that a compilation unit may not depend " &
+                      "semantically on two different versions of " &
+                      "the same compilation unit.  Check the case " &
+                      "where a library level function depends on a " &
+                      "unit that is changed");
+
+     TC_local := LA14012_1;
+
+     if TC_local = 100 then
+          Failed ("Revised function not used");
+     elsif TC_local /= -10 then
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140122;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140123.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140123.a
new file mode 100644
index 000000000..cacbf64e4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140123.a
@@ -0,0 +1,59 @@
+-- LA140123.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:
+--      See LA140122.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140122.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140122.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140120.A
+--         LA140121.A
+--         LA140122.AM
+--      -> LA140123.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140122.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007Q baseline version
+--     25 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+function LA14012_0 (Parm_1 : integer) return integer;
+
+
+function LA14012_0 (Parm_1 : integer) return integer is
+begin
+     return -(2 * Parm_1);
+end LA14012_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140130.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140130.a
new file mode 100644
index 000000000..a65ce8001
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140130.a
@@ -0,0 +1,57 @@
+-- LA140130.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:
+--      See LA140132.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140132.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140132.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140130.A
+--         LA140131.A
+--         LA140132.AM
+--         LA140133.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140132.AM.
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007R baseline version
+--     26 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+package LA140130 is
+     subtype TC_type is integer range 0..100;
+     TC_var : TC_type := TC_type'last;
+end LA140130;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140131.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140131.a
new file mode 100644
index 000000000..fe03f6705
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140131.a
@@ -0,0 +1,58 @@
+-- LA140131.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:
+--      See LA140132.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140132.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140132.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140130.A
+--      -> LA140131.A
+--         LA140132.AM
+--         LA140133.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140132.AM.
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007R baseline version
+--     26 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+with LA140130;
+
+package LA140131 is
+     TC_local : LA140130.TC_type := LA140130.TC_var;
+end LA140131;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140132.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140132.am
new file mode 100644
index 000000000..fe39257f2
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140132.am
@@ -0,0 +1,102 @@
+-- LA140132.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a library level package depends
+--      on a package specification that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a package spec., a package that withs 
+--      the first package, and a procedure that withs the second
+--      package.  Then, a new version of the first package spec. is 
+--      compiled (in a separate file, simulating an editing 
+--      modification to the package).  Unless automatic recompilation 
+--      is supported, this test should fail to link.  Otherwise, the 
+--      test should recompile and link the correct version of the 
+--      withed package and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140130 (and include the results in the
+--            program library).
+--         2) Compile the file LA140131 (and include the results in the
+--            program library).
+--         3) Compile the file LA140132 (and include the results in the
+--            program library).
+--         4) Compile the file LA140133 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140130.A
+--         LA140131.A
+--      -> LA140132.AM
+--         LA140133.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA140131 is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007R baseline version
+--     26 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+with Report; use Report;
+with LA140131;               -- when LA140130 is revised and recompiled,
+                             -- this semantic dependency has to be 
+                             -- handled
+
+
+procedure LA140132 is
+     TC_val : integer := 0;
+begin
+     Test ("LA14013", "Check that a compilation unit may not depend " &
+                      "semantically on two different versions of " &
+                      "the same compilation unit.  Check the case " &
+                      "where a library level package depends on a " &
+                      "package specification that is changed");
+
+     TC_val := LA140131.TC_local;
+
+     if TC_val = 100 then
+          Failed ("Revised package specification not used");
+     elsif TC_val /= -49 then
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140132;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140133.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140133.a
new file mode 100644
index 000000000..4d1451e4e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140133.a
@@ -0,0 +1,58 @@
+-- LA140133.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:
+--      See LA140132.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140132.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140132.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140130.A
+--         LA140131.A
+--         LA140132.AM
+--      -> LA140133.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140132.AM.
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007R baseline version
+--     26 MAY 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+package LA140130 is
+     subtype TC_type is integer range -49..50;
+     TC_const : constant TC_type := TC_type'first;
+     TC_var : TC_type := TC_const;
+end LA140130;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140140.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140140.a
new file mode 100644
index 000000000..21168913c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140140.a
@@ -0,0 +1,55 @@
+-- LA140140.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:
+--      See LA140142.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140142.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140142.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140140.A
+--         LA140141.A
+--         LA140142.AM
+--         LA140143.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140142.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007S baseline version
+--     26 MAY 95   SAIC        Initial version
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--
+--!
+
+procedure LA14014_0 (Change_one : in out integer) is
+begin
+     Change_one := Change_one * 5;
+end LA14014_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140141.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140141.a
new file mode 100644
index 000000000..d0406e6e5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140141.a
@@ -0,0 +1,57 @@
+-- LA140141.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:
+--      See LA140142.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140142.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140142.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140140.A
+--      -> LA140141.A
+--         LA140142.AM
+--         LA140143.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140142.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007S baseline version
+--     26 MAY 95   SAIC        Initial version
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--
+--!
+
+with LA14014_0;
+procedure LA14014_1 (Change_this : out integer) is
+begin
+     Change_this := 10;
+     LA14014_0(Change_one => Change_this);
+end LA14014_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140142.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140142.am
new file mode 100644
index 000000000..39b70dda1
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140142.am
@@ -0,0 +1,102 @@
+-- LA140142.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a library level procedure depends
+--      on another library level procedure that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a procedure, a procedure that withs 
+--      the first procedure, and a procedure that withs the second
+--      procedure.  Then, a new version of the first procedure is 
+--      compiled (in a separate file, simulating and editing 
+--      modification to the procedure).  Unless automatic recompilation 
+--      is supported, this test should fail to link.  Otherwise, the 
+--      test should recompile and link the correct version of the 
+--      withed package and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140140 (and include the results in the
+--            program library).
+--         2) Compile the file LA140141 (and include the results in the
+--            program library).
+--         3) Compile the file LA140142 (and include the results in the
+--            program library).
+--         4) Compile the file LA140143 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140140.A
+--         LA140141.A
+--      -> LA140142.AM
+--         LA140143.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14014_1 is missing or obsolete and no executable image
+--      results.  The test passes if an executable image is produced
+--      and reports "PASSED" (in case the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007S baseline version
+--     26 MAY 95   SAIC        Initial version
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--
+--!
+
+with Report; use Report;
+with LA14014_1;              -- when LA14014_0 is revised and recompiled,
+                             -- this semantic dependency has to be 
+                             -- handled
+
+procedure LA140142 is
+     TC_val : integer := 0;
+begin
+     Test ("LA14014", "Check that a compilation unit may not depend " &
+                      "semantically on two different versions of " &
+                      "the same compilation unit.  Check the case " &
+                      "where a library level procedure depends on " &
+                      "another library level procedure that is changed");
+
+     LA14014_1(TC_val);
+
+     if TC_val = 50 then
+          Failed ("Revised procedure not used");
+     elsif TC_val = 70 then
+          Failed ("Revised procedure not used");
+     elsif TC_val /= -10 then
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140142;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140143.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140143.a
new file mode 100644
index 000000000..2c21b1bef
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140143.a
@@ -0,0 +1,64 @@
+-- LA140143.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:
+--      See LA140142.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140142.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140142.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140140.A
+--         LA140141.A
+--         LA140142.AM
+--      -> LA140143.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140142.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007S baseline version
+--     26 MAY 95   SAIC        Initial version
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--
+--!
+
+procedure LA14014_0 (Change_two : in integer := 0;
+                     Change_one : out integer) is
+begin
+
+     if Change_two = 10 then
+          Change_one := 70;
+     elsif Change_two = 0 then
+          Change_one := -10;
+     else 
+          Change_one := 30;
+     end if;
+
+end LA14014_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140150.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140150.a
new file mode 100644
index 000000000..77a5a21a8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140150.a
@@ -0,0 +1,56 @@
+-- LA140150.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:
+--      See LA140152.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140152.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140152.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140150.A
+--         LA140151.A
+--         LA140152.AM
+--         LA140153.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140152.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007T baseline version
+--     06 JUN 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+function LA14015_0 (Param_1 : integer) return boolean is
+begin
+     return Param_1 = 5;
+end LA14015_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140151.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140151.a
new file mode 100644
index 000000000..6cd0d1a64
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140151.a
@@ -0,0 +1,65 @@
+-- LA140151.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:
+--      See LA140152.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140152.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140152.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140150.A
+--      -> LA140151.A
+--         LA140152.AM
+--         LA140153.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140152.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007T baseline version
+--     06 JUN 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+with LA14015_0;              -- when LA140150 is revised and recompiled,
+                             -- this semantic dependency has to be 
+                             -- handled
+
+
+function LA14015_1 (P : integer) return integer is
+begin
+     if LA14015_0 (Param_1 => P) then
+          return 100;
+     else 
+          return -10;
+     end if;
+end LA14015_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140152.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140152.am
new file mode 100644
index 000000000..bc9847050
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140152.am
@@ -0,0 +1,101 @@
+-- LA140152.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a library level function depends
+--      on another library level function that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a function, a function that withs and
+--      calls the first, and a procedure that withs the second
+--      function.  Then, a new version of the first function is 
+--      compiled (in a separate file, simulating an editing 
+--      modification to the function).  Unless automatic recompilation 
+--      is supported, this test should fail to link.  Otherwise, the 
+--      test should recompile and link the correct version of the 
+--      withed package and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140150 (and include the results in the
+--            program library).
+--         2) Compile the file LA140151 (and include the results in the
+--            program library).
+--         3) Compile the file LA140152 (and include the results in the
+--            program library).
+--         4) Compile the file LA140153 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140150.A
+--         LA140151.A
+--      -> LA140152.AM
+--         LA140153.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14015_1 is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007T baseline version
+--     06 JUN 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+with Report; use Report;
+with LA14015_1;
+
+procedure LA140152 is
+     TC_local : integer := 5;
+begin
+     Test ("LA14015", "Check that a compilation unit may " &
+                      "not depend semantically on two " &
+                      "different versions of the same " &
+                      "compilation unit.  Check the case " &
+                      "where a library level function " &
+                      "depends on another library level " &
+                      "function that is changed");
+
+     TC_local := LA14015_1 (5);
+
+     if TC_local = 100 then
+          Failed ("Revised unit not used");
+     elsif TC_local /= -10 then
+          Failed ("Incorrect value returned");
+     end if;
+     
+     Result;
+end LA140152;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140153.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140153.a
new file mode 100644
index 000000000..812644595
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140153.a
@@ -0,0 +1,61 @@
+-- LA140153.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:
+--      See LA140152.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140152.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140152.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140150.A
+--         LA140151.A
+--         LA140152.AM
+--      -> LA140153.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140152.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007T baseline version
+--     06 JUN 95   SAIC        Initial version
+--     17 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+function LA14015_0 (Param_2 : boolean := false;
+                    Param_1 : integer := 10) return boolean is
+begin
+     if Param_2 then
+          return true;
+     else
+          return Param_1 = 10;
+     end if;
+end LA14015_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140160.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140160.a
new file mode 100644
index 000000000..38c396d96
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140160.a
@@ -0,0 +1,54 @@
+-- LA140160.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:
+--      See LA140162.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140162.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140162.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140160.A
+--         LA140161.A
+--         LA140162.AM
+--         LA140163.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140162.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+package LA14016_0 is 
+     subtype status_code is integer range 0..10;
+     type tagged_type is abstract tagged null record;
+     function status (param : tagged_type) return status_code is abstract;
+end LA14016_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140161.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140161.a
new file mode 100644
index 000000000..4be9f1dfd
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140161.a
@@ -0,0 +1,63 @@
+-- LA140161.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:
+--      See LA140162.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140162.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140162.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140160.A
+--      -> LA140161.A
+--         LA140162.AM
+--         LA140162.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140162.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+with LA14016_0;
+generic 
+     type T is new LA14016_0.tagged_type with private;
+     type count_type is range <>;
+package LA14016_1 is
+     default_status : constant LA14016_0.status_code := 0;
+     type new_t is new T with 
+          record
+               count : count_type;
+          end record;
+     function status (param : new_t) return LA14016_0.status_code;
+
+     procedure inc (param : in out new_t);
+end LA14016_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140162.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140162.am
new file mode 100644
index 000000000..fd985c295
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140162.am
@@ -0,0 +1,196 @@
+-- LA140162.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a separate procedure depends
+--      on a withed generic package that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test declares a package which contains a generic procedure GP,
+--      the body of which is a subunit. The package also contains a procedure
+--      P which instantiates GP and calls the instance. The instance itself
+--      calls a procedure which is declared within the instance of a generic
+--      package X. The test compiles each of these compilation units and the
+--      main procedure, then compiles a new version of the generic package X
+--      (in a separate file, simulating an editing modification to the unit).
+--      Unless automatic recompilation is supported, this test should fail to
+--      link.  Otherwise, the test should recompile and link the correct
+--      version of the generic package X and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140160 (and include the results in the
+--            program library).
+--         2) Compile the file LA140161 (and include the results in the
+--            program library).
+--         3) Compile the file LA140162 (and include the results in the
+--            program library).
+--         4) Compile the file LA140163 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140160.A
+--         LA140161.A
+--      -> LA140162.AM
+--         LA140163.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14016_4.gen_def is missing or obsolete and no executable 
+--      image results.  The test also passes if an executable image is
+--      produced and reports "PASSED" (in the case where the implementation
+--      supports automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008L baseline version
+--     16 JUN 95   SAIC        Initial version
+--     07 DEC 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions. Restructured subunits
+--                             to prevent potential Program_Error due to
+--                             premature instantiation of gen_def. Moved
+--                             LA14016_1 to a separate file. Added pragma
+--                             Elaborate to context clause of LA14016_3.
+--
+--
+--!
+
+package body LA14016_1 is
+     procedure inc (param : in out new_t) is
+     begin
+          param.count := param.count + 1; 
+     end inc;
+     function status (param : new_t) return LA14016_0.status_code is
+     begin
+          return LA14016_0.status_code(param.count);
+     end status;
+end LA14016_1;
+
+---------------------------------------------------------
+
+with LA14016_0;
+package LA14016_2 is
+     type extended is new LA14016_0.tagged_type with
+          record
+               status : LA14016_0.status_code := 10;
+          end record;
+     function status (param : extended) return LA14016_0.status_code;
+end LA14016_2;
+
+---------------------------------------------------------
+
+package body LA14016_2 is
+     function status (param : extended) return LA14016_0.status_code is
+     begin
+          return param.status;
+     end status;
+end LA14016_2;
+
+---------------------------------------------------------
+
+with LA14016_0;
+with LA14016_1;
+with LA14016_2;
+pragma Elaborate (LA14016_1);
+package LA14016_3 is new LA14016_1 (LA14016_2.extended,
+                                    LA14016_0.status_code);
+
+---------------------------------------------------------
+
+with LA14016_3;
+package LA14016_4 is
+
+   procedure gen_caller (p1 : in out LA14016_3.new_t);
+
+   generic
+      new_max : integer;
+   procedure gen_def (param : in out LA14016_3.new_t);
+
+end LA14016_4;
+
+---------------------------------------------------------
+
+package body LA14016_4 is
+   procedure gen_def (param : in out LA14016_3.new_t) is separate;
+   procedure gen_caller (p1 : in out LA14016_3.new_t) is separate;
+end LA14016_4;
+
+---------------------------------------------------------
+
+separate (LA14016_4)
+procedure gen_def (param : in out LA14016_3.new_t) is
+begin
+     param.status := LA14016_3.default_status;  --originally 0
+                                                --later change to 5
+     param.count := param.status;
+     LA14016_3.inc (param);
+end gen_def;
+
+---------------------------------------------------------
+
+separate (LA14016_4)
+procedure gen_caller (p1 : in out LA14016_3.new_t) is
+   procedure default is new gen_def (101);
+begin
+   default (p1);
+end gen_caller;
+
+---------------------------------------------------------
+
+with Report; use Report;
+with LA14016_3;
+with LA14016_4;
+with LA14016_2;
+
+procedure LA140162 is
+     E : LA14016_3.new_t; --status defaults to 10
+begin
+     Test ("LA14016","Check that a compilation unit may not depend " &
+                     "semantically on two different versions of the " &
+                     "same compilation unit.  Check the case where a " &
+                     "separate procedure depends on a withed generic " &
+                     "package that is changed");
+
+     LA14016_4.gen_caller (E);
+ 
+     if E.status = 0 then
+          Failed ("Old generic used");
+     elsif E.status = 10 then
+          Failed ("Status not updated");
+     elsif E.status /= 5 then
+          Failed ("Wrong status value used");
+     end if;
+
+     if E.count /= 6 then
+          Failed ("Count not properly handled");
+     end if;
+
+     Result;
+end LA140162;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140163.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140163.a
new file mode 100644
index 000000000..d91923a6c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140163.a
@@ -0,0 +1,67 @@
+-- LA140163.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:
+--      See LA140162.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140162.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140162.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140160.A
+--         LA140161.A
+--         LA140162.AM
+--      -> LA140163.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140162.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008L baseline version
+--     16 JUN 95   SAIC        Initial version
+--     07 DEC 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions and to reflect new
+--                             test file organization.
+--
+--!
+
+with LA14016_0;
+generic 
+     type T is new LA14016_0.tagged_type with private;
+     type count_type is range <>;
+package LA14016_1 is
+     default_status : constant LA14016_0.status_code := 5;
+     type new_t is new T with 
+          record
+               count : count_type;
+          end record;
+     function status (param : new_t) return LA14016_0.status_code;
+
+     procedure inc (param : in out new_t);
+end LA14016_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140170.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140170.a
new file mode 100644
index 000000000..0c041d00a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140170.a
@@ -0,0 +1,64 @@
+-- LA140170.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:
+--      See LA140172.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140172.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140172.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140170.A
+--         LA140171.A
+--         LA140172.AM
+--         LA140173.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140172.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+package LA14017_0 is
+     type swap_type_ptr is record
+          p_all : integer;
+     end record;
+     subtype count_type is integer;
+end LA14017_0;
+
+-----------------------------------------------------
+
+with LA14017_0;
+use LA14017_0;
+generic
+     type swap_type is private;
+function LA14017_1 (P1, P2 : swap_type_ptr;
+                    count : count_type) return count_type;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140171.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140171.a
new file mode 100644
index 000000000..d7f37663c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140171.a
@@ -0,0 +1,69 @@
+-- LA140171.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:
+--      See LA140172.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140172.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140172.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140170.A
+--      -> LA140171.A
+--         LA140172.AM
+--         LA140173.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140172.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+function LA14017_1 (P1, P2 : swap_type_ptr;
+                    count : count_type) return count_type is
+     temp : integer := 0;
+     count_factor : count_type := 10;
+
+     function Inc (Param : integer) return integer;
+
+     function Inc (Param : integer) return integer is separate;     
+
+     procedure Swap_Ptrs (P1, P2 : in out swap_type_ptr) is
+          temp : integer := 0;
+     begin
+          temp := P1.p_all;
+          P1.p_all := P2.p_all;
+          P2.p_all := temp;
+     end Swap_Ptrs;
+
+begin
+     return count_type (Inc (integer(count)));
+end LA14017_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140172.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140172.am
new file mode 100644
index 000000000..67c970e5a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140172.am
@@ -0,0 +1,121 @@
+-- LA140172.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a separate function semantically 
+--      depends on a library level generic function that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a generic function, and a procedure that 
+--      withs the function.  Then, a new version of the generic 
+--      function body is compiled (in a separate file, simulating 
+--      and editing modification to the unit).  Unless automatic 
+--      recompilation is supported, this test should fail to link.  
+--      Otherwise, the test should recompile and link the correct 
+--      version of the withed function and report "PASSED" at 
+--      execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140170 (and include the results in the
+--            program library).
+--         2) Compile the file LA140171 (and include the results in the
+--            program library).
+--         3) Compile the file LA140172 (and include the results in the
+--            program library).
+--         4) Compile the file LA140173 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140170.A
+--         LA140171.A
+--      -> LA140172.AM
+--         LA140173.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14017_1.Inc is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008M baseline version
+--     16 JUN 95   SAIC        Initial version
+--     03 MAR 96   SAIC        First revision after review
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Moved LA14017_1 to a separate file.
+--
+--!
+
+separate (LA14017_1)     -- This dependency must be resolved 
+                         -- after LA140171.A is compiled.
+
+function Inc (Param : integer) return integer is
+begin
+     return Param + integer (count_factor);
+end Inc;
+
+-----------------------------------------------------
+
+
+with Report; use Report;
+with LA14017_1;
+with LA14017_0;
+
+procedure LA140172 is
+     type Access_integer is access integer;
+     TC_local : integer := 0;
+     P1, P2 : LA14017_0.swap_type_ptr;
+
+     function New_swap is new LA14017_1(swap_type => integer);
+begin
+     Test ("LA14017", "Check that a compilation unit may not " &
+                      "depend semantically on two different " &
+                      "versions of the same compilation unit. " &
+                      "Check the case where a separate " &
+                      "function semantically depends on a " &
+                      "library level generic function that is " &
+                      "changed");
+
+     P1.p_all := 0;
+     P2 := P1;
+     TC_local := integer (New_swap(P1,P2,0));
+
+     if TC_local = 10 then
+          Failed ("Revised library level function not used");
+     elsif TC_local /= -10 then
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140172;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140173.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140173.a
new file mode 100644
index 000000000..73f382e72
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140173.a
@@ -0,0 +1,75 @@
+-- LA140173.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:
+--      See LA140172.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140172.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140172.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140170.A
+--         LA140171.A
+--         LA140172.AM
+--      -> LA140173.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140172.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008M baseline version
+--     16 JUN 95   SAIC        Initial version
+--     03 MAR 96   SAIC        First revision after review
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Modified prologue to reflect new test
+--                             file organization.
+--
+--!
+
+function LA14017_1 (P1, P2 : swap_type_ptr;
+                    count : count_type) return count_type is
+     count_factor : count_type := -10;
+
+     procedure Swap_Ptrs (P1, P2 : in out swap_type_ptr) is
+          temp : integer := 0;
+     begin
+          temp := P1.p_all;
+          P1.p_all := P2.p_all;
+          P2.p_all := temp;
+     end Swap_Ptrs;
+
+     function Inc (Param : integer) return integer;
+
+     function Inc (Param : integer) return integer is separate;
+
+     temp : integer := 0;
+begin
+     return count_type (Inc (integer(count)));
+end LA14017_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140180.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140180.a
new file mode 100644
index 000000000..185ca21f4
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140180.a
@@ -0,0 +1,65 @@
+-- LA140180.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:
+--      See LA140182.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140182.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140182.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140180.A
+--         LA140181.A
+--         LA140182.AM
+--         LA140183.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140182.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+                  
+generic
+     type unsigned is mod <>;
+     mod_value : unsigned := 1;
+package LA14018_0 is
+     --types declared locally
+
+     generic
+          type discrete is (<>);
+     package utils_18 is
+          procedure Dec (Param : in out unsigned);
+
+          -- other utilities
+     end utils_18;
+
+     --routines that make this generic useful
+end LA14018_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140181.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140181.a
new file mode 100644
index 000000000..3d9847a98
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140181.a
@@ -0,0 +1,54 @@
+-- LA140181.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:
+--      See LA140182.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140182.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140182.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140180.A
+--      -> LA140181.A
+--         LA140182.AM
+--         LA140183.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140182.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+                  
+package body LA14018_0 is
+     offset : constant unsigned := mod_value;
+     
+     package body utils_18 is separate;
+end LA14018_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140182.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140182.am
new file mode 100644
index 000000000..c27bb541f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140182.am
@@ -0,0 +1,118 @@
+-- LA140182.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a separate generic package body depends
+--      on a library level generic package body that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a generic package and its body, and a
+--      procedure that withs the generic package.  Then a new 
+--      version of the generic package body is compiled (in a 
+--      separate file, simulating and editing modification to the
+--      unit).  Unless automatic recompilation is supported, this
+--      test should fail to link.  Otherwise, the test should 
+--      recompile and link the correct version of the with package
+--      withed package and report "PASSED" at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140180 (and include the results in the
+--            program library).
+--         2) Compile the file LA140181 (and include the results in the
+--            program library).
+--         3) Compile the file LA140182 (and include the results in the
+--            program library).
+--         4) Compile the file LA140183 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140180.A
+--         LA140181.A
+--      -> LA140182.AM
+--         LA140183.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14018_0.utils_18 is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008N baseline version
+--     16 JUN 95   SAIC        Initial version
+--     07 DEC 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions. Moved instantiation
+--                             of utils_18 to avoid potential Program_Error.
+--                             Moved LA14018_0 to a separate file.
+--
+--!
+                  
+separate (LA14018_0)        -- This dependency must be resolved
+                            -- after LA140181.A is compiled.
+package body utils_18 is
+     procedure Dec (Param : in out unsigned) is 
+     begin 
+          Param := Param - offset;
+     end Dec;
+end utils_18;
+
+--------------------------------------------------------
+
+with Report; use Report;
+with LA14018_0;
+procedure LA140182 is
+     type mod_4 is mod 4; -- 0, 1, 2, 3, 0, 1,...
+     TC_var : mod_4 := 2;
+
+     package Mod_stuff is new LA14018_0 (mod_4);
+     package unsigned_utils is new Mod_stuff.utils_18 (mod_4);
+begin
+     Test ("LA14018", "Check that a compilation unit may not " &
+                      "depend semantically on two different " &
+                      "versions of the same compilation unit. "&
+                      "Check the case where a separate package " &
+                      "body depends on a library level generic " &
+                      "package body that is changed");
+
+     unsigned_utils.Dec (TC_var);
+
+     if TC_var = 2 then
+          Failed ("Dec routine did not work");
+     elsif TC_var = 1 then
+          Failed ("New body for LA14018_0 not used");
+     elsif TC_var /= 3 then 
+          Failed ("Unexpected result produced");
+     end if;
+
+     Result;
+end LA140182;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140183.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140183.a
new file mode 100644
index 000000000..f50ae15ba
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140183.a
@@ -0,0 +1,60 @@
+-- LA140183.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:
+--      See LA140182.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140182.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140182.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140180.A
+--         LA140181.A
+--         LA140182.AM
+--      -> LA140183.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140182.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008N baseline version
+--     16 JUN 95   SAIC        Initial version
+--     07 DEC 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions, and to reflect new test
+--                             file organization.
+--
+--!
+
+package body LA14018_0 is
+     New_TC_var : integer := 101;
+     New_array : array (1..101) of integer := (others => 0);
+     offset : constant unsigned := mod_value + 2;
+     
+     package body utils_18 is separate;
+end LA14018_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140190.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140190.a
new file mode 100644
index 000000000..0c4c3a9d6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140190.a
@@ -0,0 +1,61 @@
+-- LA140190.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:
+--      See LA140192.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140192.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140192.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140190.A
+--         LA140191.A
+--         LA140192.AM
+--         LA140193.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140192.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008P baseline version
+--     23 JUN 95   SAIC        Initial version
+--     29 JAN 96   SAIC        First revision after review
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+procedure LA14019_0 (Param : in out integer);
+
+
+procedure LA14019_0 (Param : in out integer) is
+     TC_offset : constant integer := 1;
+begin
+     Param := Param + TC_offset;
+end LA14019_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140191.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140191.a
new file mode 100644
index 000000000..8b7af2e7c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140191.a
@@ -0,0 +1,74 @@
+-- LA140191.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:
+--      See LA140192.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140192.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140192.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140190.A
+--      -> LA140191.A
+--         LA140192.AM
+--         LA140193.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140192.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008P baseline version
+--     23 JUN 95   SAIC        Initial version
+--     29 JAN 96   SAIC        First revision after review
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+generic
+     type integer_type is range <>;
+procedure LA14019_1 (Test_val : in out integer);
+
+with LA14019_0;
+procedure LA14019_1 (Test_val : in out integer) is
+     arr : array (1..5) of integer;
+     sum : integer := 0;
+     temp_val : integer := 0;
+begin
+     arr(1) := Test_val;
+     for i in 2..arr'last loop
+          temp_val := arr(i-1);
+          LA14019_0 (temp_val);
+          arr(i) := temp_val;
+     end loop;
+     for i in 1..arr'last loop
+          sum := sum + arr(i);
+     end loop;
+     Test_val := sum;
+end LA14019_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140192.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140192.am
new file mode 100644
index 000000000..c5f32905d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140192.am
@@ -0,0 +1,107 @@
+-- LA140192.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a library level generic procedure
+--      depends on library level procedure that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a procedure, a generic procedure that 
+--      withs the first procedure and a main procedure that withs
+--      the generic procedure.  Then, a new version of the  
+--      procedure is compiled (in a separate file, simulating 
+--      and editing modification to the unit).  Unless automatic 
+--      recompilation is supported, this test should fail to link.  
+--      Otherwise, the test should recompile and link the correct 
+--      version of the withed function and report "PASSED" at 
+--      execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140190 (and include the results in the
+--            program library).
+--         2) Compile the file LA140191 (and include the results in the
+--            program library).
+--         3) Compile the file LA140192 (and include the results in the
+--            program library).
+--         4) Compile the file LA140193 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140190.A
+--         LA140191.A
+--      -> LA140192.AM
+--         LA140193.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA140192 is missing or obsolete, or that LA14019_1 is 
+--      missing or obsolete (optional) and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008P baseline version
+--     23 JUN 95   SAIC        Initial version
+--     29 JAN 96   SAIC        First revision after review
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+with Report; use Report;
+with LA14019_1;       -- This dependency must be resolved
+                      -- after LA140193 is compiled.
+
+procedure LA140192 is
+     subtype count is integer range 0..100;
+     procedure Gen_proc is new LA14019_1 (count);
+     TC_local : count := 0;
+begin
+     Test ("LA14019", "Check that a compilation unit may " &
+                      "not depend semantically on two " &
+                      "different versions of the same " &
+                      "compilation unit.  Check the case " &
+                      "where a library level generic " &
+                      "procedure depends on library level " &
+                      "procedure that is changed.");
+
+     Gen_proc (TC_local);
+
+     if TC_local = 10 then
+          Failed ("Revised library level procedure not used");
+     elsif TC_local /= 52 then
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140192;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140193.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140193.a
new file mode 100644
index 000000000..717cc633b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140193.a
@@ -0,0 +1,64 @@
+-- LA140193.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:
+--      See LA140192.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140192.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140192.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140190.A
+--         LA140191.A
+--         LA140192.AM
+--      -> LA140193.A 
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140192.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008P baseline version
+--     23 JUN 95   SAIC        Initial version
+--     29 JAN 96   SAIC        First revision after review
+--     17 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+procedure LA14019_0 (Param : in out integer);
+
+
+procedure LA14019_0 (Param : in out integer) is
+     Local_array : array (1..10) of float := (others => 0.0);
+     Local_var : integer := 0;
+     TC_var : constant integer := -9;
+
+begin
+     Param := (1 + Param) * 2;
+end LA14019_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140200.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140200.a
new file mode 100644
index 000000000..9adf75e67
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140200.a
@@ -0,0 +1,76 @@
+-- LA140200.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:
+--      See LA140202.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140202.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140202.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140200.A
+--         LA140201.A
+--         LA140202.AM
+--         LA140203.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140202.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008Q baseline version
+--     23 JUN 95   SAIC        Initial version
+--     29 FEB 96   SAIC        First revision after review
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--                             Reworded objective. Moved instance to
+--                             library-level and redesigned to use generic
+--                             formal function. Fixed arithmetic errors.
+--
+--!
+
+package LA14020_0 is
+
+     subtype apples is integer range 0..100;
+     subtype oranges is integer range 0..200;
+
+     type Fruit_Basket is tagged record
+        App : apples;
+        Ora : oranges;
+     end record;
+
+end LA14020_0;
+
+    --==================================================================--
+
+package LA14020_0.LA14020_1 is
+
+    type Bigger_Basket is new Fruit_Basket with record
+       Total : integer;
+    end record;
+
+end LA14020_0.LA14020_1;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140201.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140201.a
new file mode 100644
index 000000000..668225532
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140201.a
@@ -0,0 +1,71 @@
+-- LA140201.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:
+--      See LA140202.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140202.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140202.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140200.A
+--      -> LA140201.A
+--         LA140202.AM
+--         LA140203.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140202.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008Q baseline version
+--     23 JUN 95   SAIC        Initial version
+--     29 FEB 96   SAIC        First revision after review
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--                             Reworded objective. Moved instance to
+--                             library-level and redesigned to use generic
+--                             formal function. Fixed arithmetic errors.
+--
+--!
+
+with LA14020_0;
+generic
+     type Basket is new LA14020_0.Fruit_Basket with private;
+function LA14020_2 (Left, Right : Basket) return Basket;
+
+    --==================================================================--
+
+function LA14020_2 (Left, Right : Basket) return Basket is
+   Result : Basket;
+begin
+   Result.App := Left.App + Left.App;
+   Result.Ora := Right.Ora + Right.Ora;
+        -- wrong algorithm, to be corrected later
+
+   return Result;
+end LA14020_2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140202.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140202.am
new file mode 100644
index 000000000..1a4ed7676
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140202.am
@@ -0,0 +1,144 @@
+-- LA140202.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a library level instance depends on
+--      a library level generic function whose body is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a generic function, an instance of a generic
+--      function that withs the first function and a main procedure that 
+--      withs the instance.  Then a new version of the first generic function
+--      is compiled (in a separate file, simulating editing and modification
+--      of the unit).  Unless automatic recompilation is supported, this
+--      test should fail to link. Otherwise, the test should recompile and
+--      link the correct version of the withed function and report "PASSED"
+--      at execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140200 (and include the results in the
+--            program library).
+--         2) Compile the file LA140201 (and include the results in the
+--            program library).
+--         3) Compile the file LA140202 (and include the results in the
+--            program library).
+--         4) Compile the file LA140203 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140200.A
+--         LA140201.A
+--      -> LA140202.AM
+--         LA140203.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA140202 is missing or obsolete, or that LA14020_3 or LA14020_4
+--      is missing or obsolete (optional) and no executable image
+--      results.  The test passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation
+--      supports automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008Q baseline version
+--     23 JUN 95   SAIC        Initial version
+--     29 FEB 96   SAIC        First revision after review
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--                             Reworded objective. Moved instance to
+--                             library-level and redesigned to use generic
+--                             formal function. Fixed arithmetic errors.
+--
+--!
+
+with LA14020_0.LA14020_1;
+with LA14020_2;
+pragma Elaborate (LA14020_2);
+function LA14020_3 is new LA14020_2 (LA14020_0.LA14020_1.Bigger_Basket);
+
+    --==================================================================--
+
+with LA14020_0.LA14020_1;
+generic
+     type Market_Basket is new LA14020_0.LA14020_1.Bigger_Basket with private;
+     with function "+" (L,R: Market_Basket) return Market_Basket is <>;
+function LA14020_4 (B1, B2 : Market_Basket) return Market_Basket;
+
+    --==================================================================--
+
+with LA14020_3;
+function LA14020_4 (B1, B2 : Market_Basket) return Market_Basket is
+   Result : Market_Basket;
+begin
+   Result := B1 + B2;
+   Result.Total := integer (Result.App) + integer (Result.Ora);
+   return Result;
+end LA14020_4;
+
+    --==================================================================--
+
+with Report;
+
+with LA14020_0.LA14020_1;
+with LA14020_3;
+with LA14020_4;
+
+procedure LA140202 is
+   package Child renames LA14020_0.LA14020_1;
+
+   Basket_1 : Child.Bigger_Basket := (App => 5, Ora => 20, Total => 0);
+   Basket_2 : Child.Bigger_Basket := (App => 7, Ora =>  3, Total => 0);
+
+   function Total is new LA14020_4 (Child.Bigger_Basket, LA14020_3);
+begin
+     Report.Test ("LA14020", "Check that a compilation unit may "  &
+                             "not depend semantically on two "     &
+                             "different versions of the same "     &
+                             "compilation unit. Check the case "   &
+                             "where a library level instance "     &
+                             "depends on a library level generic " &
+                             "function whose body is changed");
+
+     Basket_1 := Total (Basket_1, Basket_2);
+
+     if    Basket_1.App    = 10 or
+           Basket_1.Ora    =  6 or
+           Basket_1.Total  = 16
+     then
+        Report.Failed ("Revised generic function not used");
+     elsif Basket_1.App   /= 12 or
+           Basket_1.Ora   /= 23 or
+           Basket_1.Total /= 35 then
+        Report.Failed ("Incorrect result returned");
+     end if;
+
+     Report.Result;
+end LA140202;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140203.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140203.a
new file mode 100644
index 000000000..f2965b407
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140203.a
@@ -0,0 +1,71 @@
+-- LA140203.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:
+--      See LA140202.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140202.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140202.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140200.A
+--         LA140201.A
+--         LA140202.AM
+--      -> LA140203.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140202.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008Q baseline version
+--     23 JUN 95   SAIC        Initial version
+--     29 FEB 96   SAIC        First revision after review
+--     12 DEC 96   SAIC        Reorganized to permit automatic recompilation.
+--                             Reworded objective. Moved instance to
+--                             library-level and redesigned to use generic
+--                             formal function. Fixed arithmetic errors.
+--
+--!
+
+with LA14020_0;
+generic
+     type Basket is new LA14020_0.Fruit_Basket with private;
+function LA14020_2 (Left, Right : Basket) return Basket;
+
+    --==================================================================--
+
+function LA14020_2 (Left, Right : Basket) return Basket is
+   Result : Basket;
+begin
+   Result.App := Left.App + Right.App;
+   Result.Ora := Left.Ora + Right.Ora;
+        -- correct algorithm
+
+   return Result;
+end LA14020_2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140210.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140210.a
new file mode 100644
index 000000000..ab3ad5f77
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140210.a
@@ -0,0 +1,69 @@
+-- LA140210.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:
+--      See LA140211.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140211.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140211.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140210.A
+--         LA140211.AM
+--         LA140212.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140211.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+generic
+     type swap_type is private;
+     type int_type is range <>;
+     times : int_type :=1;
+package LA14021_0 is
+     procedure swap (this, for_that : in out swap_type);
+end LA14021_0;
+
+---------------------------------------------------------
+
+package body LA14021_0 is
+     procedure swap (this, for_that : in out swap_type) is
+          temp : swap_type;
+     begin
+          for i in int_type'first..times loop
+               temp := this;
+               this := for_that;
+               for_that := temp;
+          end loop;
+     end swap;
+end LA14021_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140211.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140211.am
new file mode 100644
index 000000000..f6b17576d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140211.am
@@ -0,0 +1,134 @@
+-- LA140211.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a generic package depends on another
+--      generic package that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a generic package, a second generic 
+--      package that withs the first and a main procedure that  
+--      withs the second package.  Then, a new version of the  
+--      first package is compiled (in a separate file, simulating 
+--      editing and modification to the unit).  Unless automatic 
+--      recompilation is supported, this test should fail to link.  
+--      Otherwise, the test should recompile and link the correct 
+--      version of the withed function and report "PASSED" at 
+--      execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140210 (and include the results in the
+--            program library).
+--         2) Compile the file LA140211 (and include the results in the
+--            program library).
+--         3) Compile the file LA140212 (and include the results in the
+--            program library).
+--         4) Attempt to build an executable image.
+--         5) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140210.A
+--      -> LA140211.AM
+--         LA140212.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14021_1 is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008R baseline version
+--     23 JUN 95   SAIC        Initial version
+--     18 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Moved LA14021_0 to a separate file.
+--
+--!
+
+package LA14021_1 is
+     type data_record is tagged 
+          record
+          info : character;
+          end record;
+     subtype loop_count is integer range 1..100;
+     type data_type is new data_record  with
+          record
+                serial : integer := 0;
+          end record;
+end LA14021_1;
+
+---------------------------------------------------------
+
+with LA14021_1;
+with LA14021_0;
+generic     
+     type data_rec is new LA14021_1.data_record with private;
+package LA14021_2 is
+     package util is new LA14021_0 (character, LA14021_1.loop_count);
+     procedure flip_flop (rec1, rec2 : in out data_rec);
+end LA14021_2;
+
+---------------------------------------------------------
+
+package body LA14021_2 is
+     procedure flip_flop (rec1, rec2 : in out data_rec) is
+     begin
+          util.swap (rec1.info, rec2.info);
+    end flip_flop;
+end LA14021_2;
+
+---------------------------------------------------------
+
+with Report; use Report;
+with LA14021_1;
+with LA14021_2;
+
+procedure LA140211 is
+     package util is new LA14021_2 (LA14021_1.data_type);
+     datum_1 : LA14021_1.data_type := LA14021_1.data_type'('a', 1);
+     datum_2 : LA14021_1.data_type := LA14021_1.data_type'('b', 2);
+begin
+     Test ("LA14021", "Check that a compilation unit may " &
+                      "not depend semantically on two " &
+                      "different versions of the same " &
+                      "compilation unit.  Check the case " &
+                      "where a generic package depends on " &
+                      "another generic package that is changed");
+
+     util.flip_flop (datum_1, datum_2);
+     if datum_1.info = 'b' then
+          Failed ("Revised unit not used");
+     elsif datum_1.info /= 'a' then 
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140211;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140212.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140212.a
new file mode 100644
index 000000000..0c689b999
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140212.a
@@ -0,0 +1,74 @@
+-- LA140212.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:
+--      See LA140211.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140211.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140211.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140210.A
+--         LA140211.AM
+--      -> LA140212.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140211.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008R baseline version
+--     23 JUN 95   SAIC        Initial version
+--     18 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Modified prologue to reflect new test
+--                             file organization.
+--
+--!
+
+generic
+     type swap_type is private;
+     type int_type is range <>;
+     times : int_type :=2; --this line contains the change
+package LA14021_0 is
+     procedure swap (this, for_that : in out swap_type);
+end LA14021_0;
+
+---------------------------------------------------------
+
+package body LA14021_0 is
+     procedure swap (this, for_that : in out swap_type) is
+          temp : swap_type;
+     begin
+          for i in int_type'first..times loop
+               temp := this;
+               this := for_that;
+               for_that := temp;
+          end loop;
+     end swap;
+end LA14021_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140220.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140220.a
new file mode 100644
index 000000000..c5e4c6575
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140220.a
@@ -0,0 +1,64 @@
+-- LA140220.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:
+--      See LA140221.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140221.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140221.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140220.A
+--         LA140221.AM
+--         LA140222.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140221.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+generic
+     type stuff is private;
+     type ptr is access stuff;
+     type return_result is range <>;
+     delta_val : return_result := 1;
+procedure LA14022_0 (pointer : in out ptr;
+                      result : in out return_result);
+
+-------------------------------------------------------
+
+procedure LA14022_0 (pointer : in out ptr;
+                      result : in out return_result) is
+begin
+     pointer := new stuff;
+     result := result + delta_val;
+end LA14022_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140221.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140221.am
new file mode 100644
index 000000000..84003a62f
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140221.am
@@ -0,0 +1,128 @@
+-- LA140221.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a generic instantiation depends on
+--      a generic procedure that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a generic procedure, a second generic 
+--      procedure, a generic instantiation of the second procedure 
+--      that depends on both the first and second generic
+--      procedures, and a main procedure that withs the instantiated
+--      procedure.  Then, a new version of the first generic  
+--      procedure is compiled (in a separate file, simulating 
+--      editing and modification to the unit).  Unless automatic 
+--      recompilation is supported, this test should fail to link.  
+--      Otherwise, the test should recompile and link the correct 
+--      version of the withed function and report "PASSED" at 
+--      execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140220 (and include the results in the
+--            program library).
+--         2) Compile the file LA140221 (and include the results in the
+--            program library).
+--         3) Compile the file LA140222 (and include the results in the
+--            program library).
+--         4) Attempt to build an executable image.
+--         5) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140220.A
+--      -> LA140221.AM
+--         LA140222.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14022_2 is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008S baseline version
+--     23 JUN 95   SAIC        Initial version
+--     18 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Moved LA14022_0 to a separate file. Added
+--                             pragma Elaborate to context clause of
+--                             LA14022_2.
+--
+--!
+
+package LA14022_1 is
+     type rec_ptr; 
+     type rec is record
+          data : integer;
+     end record;
+     type rec_ptr is access rec;
+     subtype data_int is integer range 0..100;
+end LA14022_1;
+
+
+with LA14022_0;
+with LA14022_1;
+pragma Elaborate (LA14022_0);
+procedure LA14022_2 is new 
+     LA14022_0 (stuff => LA14022_1.rec,
+                ptr => LA14022_1.rec_ptr,
+                return_result => LA14022_1.data_int,
+                delta_val => 50);
+
+with Report;
+use Report;
+with LA14022_2;
+with LA14022_1;
+use LA14022_1;
+procedure LA140221 is
+     TC_val : LA14022_1.data_int := 10;
+     P, Q : LA14022_1.rec_ptr;
+begin
+     Test ("LA14022", "Check that a compilation unit may not " & 
+                      "depend semantically on two different " &
+                      "versions of the same compilation unit. " &
+                      "Check the case where a generic " &
+                      "instantiation depends on a generic " &
+                      "procedure that is changed");
+
+     Q := P;
+     LA14022_2 (Q, TC_val);
+
+     if Q /= P then
+          Failed ("Wrong procedure result");
+     end if;
+     if TC_val = 60 then
+          Failed ("Old instantiation used");
+     elsif TC_val /= 10 then
+          Failed ("Wrong result");
+     end if;
+
+     Result;
+end LA140221;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140222.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140222.a
new file mode 100644
index 000000000..424236b3e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140222.a
@@ -0,0 +1,69 @@
+-- LA140222.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:
+--      See LA140221.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140221.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140221.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140220.A
+--         LA140221.AM
+--      -> LA140222.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140221.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008S baseline version
+--     23 JUN 95   SAIC        Initial version
+--     18 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Modified prologue to reflect new test
+--                             file organization.
+--
+--!
+
+generic
+     type stuff is private;
+     type ptr is access stuff;
+     type return_result is range <>;
+     delta_val : return_result := 1;
+procedure LA14022_0 (pointer : in out ptr;
+                      result : in out return_result);
+
+-------------------------------------------------------
+
+procedure LA14022_0 (pointer : in out ptr;
+                      result : in out return_result) is
+begin
+     pointer := null;
+     result := result + return_result'first;
+end LA14022_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140240.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140240.a
new file mode 100644
index 000000000..e5541006e
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140240.a
@@ -0,0 +1,61 @@
+-- LA140240.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:
+--      See LA140242.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140242.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140242.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140240.A
+--         LA140241.A
+--         LA140242.AM
+--         LA140243.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140242.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008U baseline version
+--     29 JUN 95   SAIC        Initial version
+--     18 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+generic
+     Local_max : positive;
+     type Thing is private;
+package LA14024_0 is
+     type Goodies is tagged
+          record
+               X, Y : integer := 100;
+          end record;
+end LA14024_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140241.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140241.a
new file mode 100644
index 000000000..dde3b3db5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140241.a
@@ -0,0 +1,55 @@
+-- LA140241.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:
+--      See LA140242.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140242.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140242.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140240.A
+--      -> LA140241.A
+--         LA140242.AM
+--         LA140243.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140242.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008U baseline version
+--     29 JUN 95   SAIC        Initial version
+--     18 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+with LA14024_0;
+
+package LA14024_1 is new LA14024_0 (100, integer);
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140242.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140242.am
new file mode 100644
index 000000000..a156465a9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140242.am
@@ -0,0 +1,104 @@
+-- LA140242.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a generic instantiation depends on
+--      a generic package that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a generic package, a generic
+--      instantiation of the generic package, and a main
+--      procedure that withs the instantiated generic 
+--      package.  Then, a new version of the first generic  
+--      package is compiled (in a separate file, simulating 
+--      editing and modification to the unit).  Unless automatic 
+--      recompilation is supported, this test should fail to link.  
+--      Otherwise, the test should recompile and link the correct 
+--      version of the withed package and report "PASSED" at 
+--      execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140240 (and include the results in the
+--            program library).
+--         2) Compile the file LA140241 (and include the results in the
+--            program library).
+--         3) Compile the file LA140242 (and include the results in the
+--            program library).
+--         4) Compile the file LA140243 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140240.A
+--         LA140241.A
+--      -> LA140242.AM
+--         LA140243.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA140242 is missing or obsolete, or that LA14024_1 is 
+--      missing or obsolete (optional) and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008U baseline version
+--     29 JUN 95   SAIC        Initial version
+--     18 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+with Report; use Report;
+with LA14024_1;
+
+procedure LA140242 is
+     TC_val : integer := 0;
+     Local_goodies : LA14024_1.Goodies;
+begin
+     Test ("LA14024", "Check that a compilation unit may not " &
+                      "depend semantically on two different " &
+                      "versions of the same compilation unit.  " &
+                      "Check the case where a generic " &
+                      "instantiation depends on a generic " &
+                      "package that is changed");
+
+     TC_val := Local_goodies.X;
+
+     if TC_val = 100 then
+          Failed ("Revised generic package not used");
+     elsif TC_val /= -10 then 
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140242;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140243.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140243.a
new file mode 100644
index 000000000..98b03438b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140243.a
@@ -0,0 +1,61 @@
+-- LA140243.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:
+--      See LA140242.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140242.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140242.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140240.A
+--         LA140241.A
+--         LA140242.AM
+--      -> LA140243.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140242.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008U baseline version
+--     29 JUN 95   SAIC        Initial version
+--     18 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+generic
+     Local_max : positive;
+     type Thing is private;
+package LA14024_0 is
+     type Goodies is tagged
+          record
+               Y, X : integer := -10;
+          end record;
+end LA14024_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140250.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140250.a
new file mode 100644
index 000000000..44477df4d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140250.a
@@ -0,0 +1,56 @@
+-- LA140250.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:
+--     See LA140251.AM.
+--
+-- TEST DESCRIPTION:
+--     See LA140251.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--     See LA140251.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140050.A
+--         LA140051.AM
+--         LA140052.A
+--
+-- PASS/FAIL CRITERIA:
+--     See LA140251.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+package LA14025_0 is
+     subtype byte is integer range 0..511;
+     byte_val : constant byte := 128;
+     type Data_rec is tagged record
+          Id : integer := 1;
+          Val: byte := byte_val;
+     end record;
+end LA14025_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140251.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140251.am
new file mode 100644
index 000000000..7f7a4791d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140251.am
@@ -0,0 +1,141 @@
+-- LA140251.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a generic instantiation depends on
+--      a non-generic package that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a package, a generic package, a 
+--      generic instantiation that withs both of the first two
+--      packages, and a main procedure that withs the instantiated 
+--      generic package.  Then, a new version of the first   
+--      package is compiled (in a separate file, simulating 
+--      editing and modification to the unit).  Unless automatic 
+--      recompilation is supported, this test should fail to link.  
+--      Otherwise, the test should recompile and link the correct 
+--      version of the withed package and report "PASSED" at 
+--      execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140250 (and include the results in the
+--            program library).
+--         2) Compile the file LA140251 (and include the results in the
+--            program library).
+--         3) Compile the file LA140252 (and include the results in the
+--            program library).
+--         4) Attempt to build an executable image.
+--         5) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140250.A
+--      -> LA140251.AM
+--         LA140252.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14025 is missing or obsolete, or that LA14025_2 is 
+--      missing or obsolete (optional) and no executable image
+--      results.  The test passes if an executable image is produced
+--      and reports "PASSED" (in case the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008V baseline version
+--     06 JUL 95   SAIC        Initial version
+--     08 NOV 96   SAIC        Unit naming correction
+--     07 DEC 96   SAIC        Moved LA14025_0 to a separate file. Added
+--                             pragma Elaborate to context clause of
+--                             LA14025_2.
+--
+--!
+
+with LA14025_0;
+generic
+     type your_addition is (<>);
+package LA14025_1 is          --extensions, utilities
+     type extended_record is new LA14025_0.data_rec with record
+          new_data : your_addition;
+     end record;
+     procedure stuff (param : your_addition);
+     function fetch (param : LA14025_0.byte) return LA14025_0.byte;
+private
+     obj : extended_record;
+end LA14025_1;
+
+---------------------------------------------
+
+package body LA14025_1 is
+     procedure stuff (param : your_addition) is
+     begin
+          obj.new_data := param; 
+     end stuff;
+
+     function fetch (param : LA14025_0.byte) return LA14025_0.byte is
+     begin
+          return (param + obj.val);
+     end fetch;
+end LA14025_1;
+
+---------------------------------------------
+
+with LA14025_0;
+with LA14025_1;
+pragma Elaborate (LA14025_1);
+package LA14025_2 is new LA14025_1 (LA14025_0.byte);
+
+---------------------------------------------
+
+with Report; use Report;
+with LA14025_2;
+with LA14025_0;
+procedure LA140251 is
+     TC_val : LA14025_0.byte := 0;
+     Temp_var : LA14025_2.extended_record;
+begin
+     Test ("LA14025", "Check that a compilation unit may not " &
+                      "depend semantically on two different " &
+                      "versions of the same compilation unit.  " &
+                      "Check the case where a generic " &
+                      "instantiation depends on a non-generic " &
+                      "package that is changed");
+
+     LA14025_2.stuff(10);
+     
+     TC_val := LA14025_2.fetch (Temp_var.val);
+
+     if TC_val = 256 then
+          Failed ("Old version of package used");
+     elsif TC_val /= 128 then
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140251;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140252.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140252.a
new file mode 100644
index 000000000..2fce76cea
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140252.a
@@ -0,0 +1,59 @@
+-- LA140252.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:
+--     See LA140251.AM.
+--
+-- TEST DESCRIPTION:
+--     See LA140251.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--     See LA140251.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140050.A
+--         LA140051.AM
+--      -> LA140052.A
+--
+-- PASS/FAIL CRITERIA:
+--     See LA140251.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008V baseline version
+--     06 JUL 95   SAIC        Initial version
+--     07 DEC 96   SAIC        Modified prologue to reflect new test
+--                             file organization.
+--
+--!
+
+package LA14025_0 is
+     subtype byte is integer range 0..511;
+     byte_val : constant byte := 64;
+     type Data_rec is tagged record
+          Id : integer := 1;
+          Val: byte := byte_val;
+     end record;
+end LA14025_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140260.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140260.a
new file mode 100644
index 000000000..fae173667
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140260.a
@@ -0,0 +1,98 @@
+-- LA140260.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:
+--      See LA140262.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140262.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140262.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140260.A
+--         LA140261.A
+--         LA140262.AM
+--         LA140263.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140262.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+package LA14026_0 is
+     type basic_rec is tagged 
+          record 
+               null;
+          end record;
+end LA14026_0;
+
+---------------------------------------------------------
+
+with LA14026_0;
+generic
+     type data_type is private;
+     type serial_type is range <>;
+     serial_init : serial_type;
+package LA14026_1 is
+
+     pragma Elaborate_Body;
+
+     function get_serial_num return serial_type;
+
+     type node_type is new LA14026_0.basic_rec with 
+          record
+               data_field : data_type;
+               serial_no : serial_type := get_serial_num;
+          end record;
+end LA14026_1;
+
+---------------------------------------------------------
+
+package body LA14026_1 is
+     serial : serial_type := serial_init;
+     function get_serial_num return serial_type is
+     begin
+          serial := serial + 1;
+          return serial;
+     end;
+end LA14026_1;
+
+---------------------------------------------------------
+
+package LA14026_2 is
+     subtype serial_type is integer range 0..5;
+     subtype data_type is integer range 0..100;
+
+     type data_rec is record
+          F1 : data_type := data_type'first;
+          F2 : data_type := data_type'last;
+     end record;
+end LA14026_2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140261.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140261.a
new file mode 100644
index 000000000..73cd334ed
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140261.a
@@ -0,0 +1,52 @@
+-- LA140261.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:
+--      See LA140262.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140262.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140262.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140260.A
+--      -> LA140261.A
+--         LA140262.AM
+--         LA140263.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140262.AM.
+--
+-- CHANGE HISTORY:
+--     07 DEC 96   SAIC        ACVC 2.1: Initial version.
+--
+--!
+
+with LA14026_2, LA14026_1;
+package LA14026_3 is new LA14026_1 (LA14026_2.data_rec, 
+                                    LA14026_2.serial_type, 0);
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140262.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140262.am
new file mode 100644
index 000000000..115094717
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140262.am
@@ -0,0 +1,140 @@
+-- LA140262.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a generic instantiation depends on
+--      a generic package instantiation that is changed.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a generic package, a generic  
+--      instantiation of the generic package, another generic   
+--      package, a generic instantiation of the second generic  
+--      package that withs the first generic instantiation 
+--      packages, and a main procedure that withs the instantiated 
+--      generic package.  Then, a new version of the first generic  
+--      package is compiled (in a separate file, simulating 
+--      editing and modification to the unit).  Unless automatic 
+--      recompilation is supported, this test should fail to link.  
+--      Otherwise, the test should recompile and link the correct 
+--      version of the instantiation and report "PASSED" at 
+--      execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140260 (and include the results in the
+--            program library).
+--         2) Compile the file LA140261 (and include the results in the
+--            program library).
+--         3) Compile the file LA140262 (and include the results in the
+--            program library).
+--         4) Compile the file LA140263 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140260.A
+--         LA140261.A
+--      -> LA140262.AM
+--         LA140263.A
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA140260 is missing or obsolete, or that LA14026_5 is 
+--      missing or obsolete (optional) and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008W baseline version
+--     06 JUL 95   SAIC        Initial version
+--     18 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Moved LA14026_3 to a separate file. Added
+--                             pragma Elaborate to context clause of LA14026_5.
+--
+--!
+
+with LA14026_0;
+generic
+     type rec is new LA14026_0.basic_rec with private;
+package LA14026_4 is
+     type extended_node;
+     type extended_node_ptr is access extended_node;
+     type extended_node is new rec with 
+          record
+               next : extended_node_ptr := null;
+          end record;
+     procedure add_next (node : in out extended_node; ptr : extended_node_ptr);
+end LA14026_4;
+
+---------------------------------------------------------
+ 
+package body LA14026_4 is
+     procedure add_next (node : in out extended_node; 
+                         ptr : extended_node_ptr) is
+     begin
+          node.next := ptr;
+     end add_next;
+end LA14026_4;
+
+---------------------------------------------------------
+
+with LA14026_3, LA14026_4;
+pragma Elaborate (LA14026_4);
+package LA14026_5 is new LA14026_4 (LA14026_3.node_type);
+
+---------------------------------------------------------
+
+with Report;
+use Report;
+with LA14026_5;
+
+procedure LA140262 is
+     root : LA14026_5.extended_node_ptr := new LA14026_5.extended_node;
+     next : LA14026_5.extended_node_ptr := new LA14026_5.extended_node;
+begin
+     Test ("LA14026","Check that a compilation unit may not depend " &
+                     "semantically on two different versions of " &
+                     "the same compilation unit.  Check the case " &
+                     "where a generic instantiation depends on " &
+                     "a generic package instantiation that is " &
+                     "changed");
+
+     
+     LA14026_5.add_next (root.all, next);
+
+     if root.all.next.serial_no = 2 then
+          Failed ("Old version of unit used");
+     elsif root.all.next.serial_no /= 5 then
+          Failed ("Wrong value returned");
+     end if;
+
+     Result;
+end LA140262;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140263.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140263.a
new file mode 100644
index 000000000..c0224894d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140263.a
@@ -0,0 +1,57 @@
+-- LA140263.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:
+--      See LA140262.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140262.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140262.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140260.A
+--         LA140261.A
+--         LA140262.AM
+--      -> LA140263.A
+--
+-- PASS/FAIL CRITERIA:                
+--      See LA140262.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5008W baseline version
+--     06 JUL 95   SAIC        Initial version
+--     18 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--     07 DEC 96   SAIC        Modified prologue to reflect new test
+--                             file organization.
+--
+--!
+
+with LA14026_2, LA14026_1;
+package LA14026_3 is new LA14026_1 (LA14026_2.data_rec, 
+                                    LA14026_2.serial_type, 3);
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140270.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140270.a
new file mode 100644
index 000000000..dab574cd6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140270.a
@@ -0,0 +1,56 @@
+-- LA140270.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:
+--      See LA140272.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140272.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140272.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--      -> LA140270.A
+--         LA140271.A
+--         LA140272.AM
+--         LA140273.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140272.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007O baseline version
+--     28 JUL 95   SAIC        Initial version
+--     29 JAN 96   SAIC        First revision after review
+--     18 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+package LA14027_0 is
+     Sample_value : integer := 100;
+end LA14027_0;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140271.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140271.a
new file mode 100644
index 000000000..703b1b8ae
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140271.a
@@ -0,0 +1,93 @@
+-- LA140271.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:
+--      See LA140272.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140272.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140272.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140270.A
+--      -> LA140271.A
+--         LA140272.AM
+--         LA140273.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140272.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007O baseline version
+--     28 JUL 95   SAIC        Initial version
+--     29 JAN 96   SAIC        First revision after review
+--     18 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions. Removed loop from
+--                             task body to prevent hang.
+--
+--!
+
+package LA14027_1 is
+     procedure Random (Number : out integer);
+end LA14027_1;
+
+  --------------------------------------------
+
+package body LA14027_1 is
+     task LA14027_2 is
+          entry Get (Value : out integer);
+     end LA14027_2;
+
+     task body LA14027_2 is separate;
+
+     procedure Random (Number : out integer) is
+     begin
+          -- get a random number from sampling task
+          LA14027_2.Get (Number);
+          -- massage it
+          Number := Number + 10;
+          -- and return it
+     end;
+end LA14027_1;
+
+  --------------------------------------------
+
+with LA14027_0;  -- must resolve this
+
+separate (LA14027_1)
+
+task body LA14027_2 is
+     begin
+          select
+               accept Get (Value : out integer) do
+                    -- sample some random physical process
+                    Value := LA14027_0.Sample_value;
+                    -- and return it
+               end Get;
+          end select;
+end LA14027_2;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140272.am b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140272.am
new file mode 100644
index 000000000..a8cd1c958
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140272.am
@@ -0,0 +1,102 @@
+-- LA140272.AM
+--
+--                             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 compilation unit may not depend semantically
+--      on two different versions of the same compilation unit.
+--      Check the case where a task body depends on non-generic 
+--      package specification.
+--
+-- TEST DESCRIPTION:
+--      This test compiles a package spec, another package 
+--      with a body containing a task with a body that withs the 
+--      first package spec, and a main procedure that withs the 
+--      second package.  Then, a new version of the first package
+--      spec is compiled (in a separate file, simulating 
+--      editing and modification to the unit).  Unless automatic 
+--      recompilation is supported, this test should fail to link.  
+--      Otherwise, the test should recompile and link the correct 
+--      version of the package spec and report "PASSED" at 
+--      execution time.
+--
+-- SPECIAL REQUIREMENTS:
+--      To build this test:
+--         1) Compile the file LA140270 (and include the results in the
+--            program library).
+--         2) Compile the file LA140271 (and include the results in the
+--            program library).
+--         3) Compile the file LA140272 (and include the results in the
+--            program library).
+--         4) Compile the file LA140273 (and include the results in the
+--            program library).
+--         5) Attempt to build an executable image.
+--         6) If an executable image results, run it.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140270.A
+--         LA140271.A
+--      -> LA140272.AM
+--         LA140273.A 
+--
+-- PASS/FAIL CRITERIA:    
+--      The test passes if a link time error message reports that 
+--      LA14027_1.LA14027_2 is missing or obsolete and no executable image
+--      results.  The test also passes if an executable image is produced
+--      and reports "PASSED" (in the case where the implementation supports
+--      automatic recompilation).            
+--
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007O baseline version
+--     28 JUL 95   SAIC        Initial version
+--     29 JAN 96   SAIC        First revision after review
+--     18 NOV 96   SAIC        Modified unit names and prologue to conform
+--                             to coding conventions.
+--
+--!
+
+with Report; use Report;
+with LA14027_1;
+
+procedure LA140272 is
+     TC_val : integer := 0;
+begin
+     Test ("LA14027", "Check that a compilation unit may not depend " &
+                      "semantically on two different versions of the " &
+                      "same compilation unit.  Check the case where " &
+                      "a task body depends on non-generic package " &
+                      "specification");
+
+     LA14027_1.Random (TC_val);
+
+     if TC_val = 110 then
+          Failed ("Old version used");
+     elsif TC_val /= 0 then
+          Failed ("Incorrect value returned");
+     end if;
+
+     Result;
+end LA140272;
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140273.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140273.a
new file mode 100644
index 000000000..0e535f10c
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/l/la140273.a
@@ -0,0 +1,58 @@
+-- LA140273.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:
+--      See LA140272.AM.
+--
+-- TEST DESCRIPTION:
+--      See LA140272.AM.
+--
+-- SPECIAL REQUIREMENTS:
+--      See LA140272.AM.
+--
+-- TEST FILES:
+--      This test consists of the following files:
+--         LA140270.A
+--         LA140271.A
+--         LA140272.AM
+--      -> LA140273.A
+--
+-- PASS/FAIL CRITERIA:    
+--      See LA140272.AM.
+--
+-- CHANGE HISTORY:
+--     01 MAY 95   ACVC 1.12   LA5007O baseline version
+--     28 JUL 95   SAIC        Initial version
+--     29 JAN 96   SAIC        First revision after review
+--     18 NOV 96   SAIC        Modified prologue to conform
+--                             to coding conventions.
+--
+--!
+
+package LA14027_0 is
+     New_var : integer := 100;
+     Local_array : array (1..51) of integer;
+     Sample_value : constant integer := -10;
+end LA14027_0;